From 84adefa331c4159d432d22840663c38f155cd4c1 Mon Sep 17 00:00:00 2001 From: Erlang/OTP Date: Fri, 20 Nov 2009 14:54:40 +0000 Subject: The R13B03 release. --- erts/AUTHORS | 138 + erts/Makefile.in | 157 + erts/aclocal.m4 | 938 ++ erts/autoconf/config.guess | 1519 +++ erts/autoconf/config.sub | 1630 +++ erts/autoconf/configure.vxworks | 147 + erts/autoconf/install-sh | 519 + erts/autoconf/vxworks/sed.general | 125 + erts/autoconf/vxworks/sed.vxworks_cpu32 | 42 + erts/autoconf/vxworks/sed.vxworks_ppc32 | 48 + erts/autoconf/vxworks/sed.vxworks_ppc603 | 48 + .../autoconf/vxworks/sed.vxworks_ppc603_nolongcall | 48 + erts/autoconf/vxworks/sed.vxworks_ppc860 | 47 + erts/autoconf/vxworks/sed.vxworks_simlinux | 57 + erts/autoconf/vxworks/sed.vxworks_simso | 62 + erts/autoconf/vxworks/sed.vxworks_sparc | 38 + erts/autoconf/win32.config.cache | 233 + erts/configure.in | 3772 ++++++ erts/doc/Makefile | 36 + erts/doc/html/.gitignore | 0 erts/doc/man1/.gitignore | 0 erts/doc/man3/.gitignore | 0 erts/doc/pdf/.gitignore | 0 erts/doc/src/Makefile | 153 + erts/doc/src/absform.xml | 444 + erts/doc/src/alt_dist.xml | 1099 ++ erts/doc/src/book.xml | 49 + erts/doc/src/crash_dump.xml | 518 + erts/doc/src/driver.xml | 812 ++ erts/doc/src/driver_entry.xml | 453 + erts/doc/src/epmd.xml | 120 + erts/doc/src/erl.xml | 928 ++ erts/doc/src/erl_dist_protocol.xml | 802 ++ erts/doc/src/erl_driver.xml | 2465 ++++ erts/doc/src/erl_ext_dist.xml | 1014 ++ erts/doc/src/erl_ext_fig.gif | Bin 0 -> 3834 bytes erts/doc/src/erl_ext_fig.ps | 153 + erts/doc/src/erl_fix_alloc.fig | 104 + erts/doc/src/erl_fix_alloc.gif | Bin 0 -> 5638 bytes erts/doc/src/erl_fix_alloc.ps | 646 + erts/doc/src/erl_nif.xml | 351 + erts/doc/src/erl_prim_loader.xml | 251 + erts/doc/src/erl_set_memory_block.xml | 172 + erts/doc/src/erlang.xml | 6920 ++++++++++ erts/doc/src/erlc.xml | 256 + erts/doc/src/erlsrv.xml | 405 + erts/doc/src/erts_alloc.xml | 554 + erts/doc/src/escript.xml | 232 + erts/doc/src/fascicules.xml | 18 + erts/doc/src/inet_cfg.xml | 397 + erts/doc/src/init.xml | 384 + erts/doc/src/make.dep | 32 + erts/doc/src/match_spec.xml | 564 + erts/doc/src/notes.xml | 5439 ++++++++ erts/doc/src/notes_history.xml | 503 + erts/doc/src/part.xml | 44 + erts/doc/src/part_notes.xml | 37 + erts/doc/src/part_notes_history.xml | 35 + erts/doc/src/ref_man.xml | 60 + erts/doc/src/run_erl.xml | 155 + erts/doc/src/start.xml | 64 + erts/doc/src/start_erl.xml | 126 + erts/doc/src/tty.xml | 137 + erts/doc/src/werl.xml | 88 + erts/doc/src/zlib.xml | 606 + erts/emulator/Makefile | 24 + erts/emulator/Makefile.in | 1114 ++ erts/emulator/beam/atom.c | 354 + erts/emulator/beam/atom.h | 104 + erts/emulator/beam/atom.names | 540 + erts/emulator/beam/beam_bif_load.c | 795 ++ erts/emulator/beam/beam_bp.c | 785 ++ erts/emulator/beam/beam_bp.h | 165 + erts/emulator/beam/beam_catches.c | 102 + erts/emulator/beam/beam_catches.h | 32 + erts/emulator/beam/beam_debug.c | 548 + erts/emulator/beam/beam_emu.c | 6198 +++++++++ erts/emulator/beam/beam_load.c | 5234 ++++++++ erts/emulator/beam/beam_load.h | 120 + erts/emulator/beam/benchmark.c | 395 + erts/emulator/beam/benchmark.h | 340 + erts/emulator/beam/bif.c | 4201 ++++++ erts/emulator/beam/bif.h | 386 + erts/emulator/beam/bif.tab | 761 ++ erts/emulator/beam/big.c | 2241 ++++ erts/emulator/beam/big.h | 155 + erts/emulator/beam/binary.c | 677 + erts/emulator/beam/break.c | 747 ++ erts/emulator/beam/copy.c | 981 ++ erts/emulator/beam/decl.h | 55 + erts/emulator/beam/dist.c | 3256 +++++ erts/emulator/beam/dist.h | 290 + erts/emulator/beam/elib_malloc.c | 2334 ++++ erts/emulator/beam/elib_memmove.c | 113 + erts/emulator/beam/elib_stat.h | 45 + erts/emulator/beam/erl_afit_alloc.c | 256 + erts/emulator/beam/erl_afit_alloc.h | 67 + erts/emulator/beam/erl_alloc.c | 3157 +++++ erts/emulator/beam/erl_alloc.h | 564 + erts/emulator/beam/erl_alloc.types | 383 + erts/emulator/beam/erl_alloc_util.c | 3467 +++++ erts/emulator/beam/erl_alloc_util.h | 342 + erts/emulator/beam/erl_arith.c | 2040 +++ erts/emulator/beam/erl_async.c | 469 + erts/emulator/beam/erl_bestfit_alloc.c | 1161 ++ erts/emulator/beam/erl_bestfit_alloc.h | 64 + erts/emulator/beam/erl_bif_chksum.c | 612 + erts/emulator/beam/erl_bif_ddll.c | 1964 +++ erts/emulator/beam/erl_bif_guard.c | 628 + erts/emulator/beam/erl_bif_info.c | 3803 ++++++ erts/emulator/beam/erl_bif_lists.c | 392 + erts/emulator/beam/erl_bif_op.c | 327 + erts/emulator/beam/erl_bif_os.c | 190 + erts/emulator/beam/erl_bif_port.c | 1476 +++ erts/emulator/beam/erl_bif_re.c | 1142 ++ erts/emulator/beam/erl_bif_timer.c | 701 + erts/emulator/beam/erl_bif_timer.h | 36 + erts/emulator/beam/erl_bif_trace.c | 2106 +++ erts/emulator/beam/erl_binary.h | 282 + erts/emulator/beam/erl_bits.c | 1975 +++ erts/emulator/beam/erl_bits.h | 212 + erts/emulator/beam/erl_db.c | 3631 ++++++ erts/emulator/beam/erl_db.h | 247 + erts/emulator/beam/erl_db_hash.c | 2868 ++++ erts/emulator/beam/erl_db_hash.h | 103 + erts/emulator/beam/erl_db_tree.c | 3289 +++++ erts/emulator/beam/erl_db_tree.h | 55 + erts/emulator/beam/erl_db_util.c | 4651 +++++++ erts/emulator/beam/erl_db_util.h | 405 + erts/emulator/beam/erl_debug.c | 899 ++ erts/emulator/beam/erl_debug.h | 102 + erts/emulator/beam/erl_driver.h | 626 + erts/emulator/beam/erl_drv_thread.c | 706 + erts/emulator/beam/erl_fun.c | 315 + erts/emulator/beam/erl_fun.h | 92 + erts/emulator/beam/erl_gc.c | 2690 ++++ erts/emulator/beam/erl_gc.h | 72 + erts/emulator/beam/erl_goodfit_alloc.c | 662 + erts/emulator/beam/erl_goodfit_alloc.h | 88 + erts/emulator/beam/erl_init.c | 1461 +++ erts/emulator/beam/erl_instrument.c | 1221 ++ erts/emulator/beam/erl_instrument.h | 41 + erts/emulator/beam/erl_lock_check.c | 1307 ++ erts/emulator/beam/erl_lock_check.h | 117 + erts/emulator/beam/erl_lock_count.c | 675 + erts/emulator/beam/erl_lock_count.h | 195 + erts/emulator/beam/erl_math.c | 233 + erts/emulator/beam/erl_md5.c | 340 + erts/emulator/beam/erl_message.c | 1070 ++ erts/emulator/beam/erl_message.h | 251 + erts/emulator/beam/erl_monitors.c | 1019 ++ erts/emulator/beam/erl_monitors.h | 180 + erts/emulator/beam/erl_mtrace.c | 1240 ++ erts/emulator/beam/erl_mtrace.h | 51 + erts/emulator/beam/erl_nif.c | 641 + erts/emulator/beam/erl_nif.h | 122 + erts/emulator/beam/erl_nif_api_funcs.h | 68 + erts/emulator/beam/erl_nmgc.c | 1402 ++ erts/emulator/beam/erl_nmgc.h | 364 + erts/emulator/beam/erl_node_container_utils.h | 318 + erts/emulator/beam/erl_node_tables.c | 1660 +++ erts/emulator/beam/erl_node_tables.h | 261 + erts/emulator/beam/erl_obsolete.c | 186 + erts/emulator/beam/erl_port_task.c | 1100 ++ erts/emulator/beam/erl_port_task.h | 135 + erts/emulator/beam/erl_posix_str.c | 641 + erts/emulator/beam/erl_printf_term.c | 458 + erts/emulator/beam/erl_printf_term.h | 26 + erts/emulator/beam/erl_process.c | 9469 ++++++++++++++ erts/emulator/beam/erl_process.h | 1495 +++ erts/emulator/beam/erl_process_dict.c | 1001 ++ erts/emulator/beam/erl_process_dict.h | 42 + erts/emulator/beam/erl_process_dump.c | 454 + erts/emulator/beam/erl_process_lock.c | 1431 ++ erts/emulator/beam/erl_process_lock.h | 990 ++ erts/emulator/beam/erl_resolv_dns.c | 23 + erts/emulator/beam/erl_resolv_nodns.c | 23 + erts/emulator/beam/erl_smp.h | 993 ++ erts/emulator/beam/erl_sock.h | 44 + erts/emulator/beam/erl_sys_driver.h | 44 + erts/emulator/beam/erl_term.c | 174 + erts/emulator/beam/erl_term.h | 1056 ++ erts/emulator/beam/erl_threads.h | 1524 +++ erts/emulator/beam/erl_time.h | 67 + erts/emulator/beam/erl_time_sup.c | 899 ++ erts/emulator/beam/erl_trace.c | 3260 +++++ erts/emulator/beam/erl_unicode.c | 1815 +++ erts/emulator/beam/erl_unicode.h | 23 + erts/emulator/beam/erl_vm.h | 204 + erts/emulator/beam/erl_zlib.c | 113 + erts/emulator/beam/erl_zlib.h | 52 + erts/emulator/beam/error.h | 196 + erts/emulator/beam/export.c | 296 + erts/emulator/beam/export.h | 79 + erts/emulator/beam/external.c | 2839 ++++ erts/emulator/beam/external.h | 211 + erts/emulator/beam/fix_alloc.c | 287 + erts/emulator/beam/global.h | 1800 +++ erts/emulator/beam/hash.c | 407 + erts/emulator/beam/hash.h | 97 + erts/emulator/beam/index.c | 137 + erts/emulator/beam/index.h | 71 + erts/emulator/beam/io.c | 4732 +++++++ erts/emulator/beam/module.c | 134 + erts/emulator/beam/module.h | 56 + erts/emulator/beam/ops.tab | 1430 ++ erts/emulator/beam/packet_parser.c | 847 ++ erts/emulator/beam/packet_parser.h | 181 + erts/emulator/beam/register.c | 655 + erts/emulator/beam/register.h | 66 + erts/emulator/beam/safe_hash.c | 276 + erts/emulator/beam/safe_hash.h | 104 + erts/emulator/beam/sys.h | 1257 ++ erts/emulator/beam/time.c | 571 + erts/emulator/beam/utils.c | 4053 ++++++ erts/emulator/beam/version.h | 19 + erts/emulator/drivers/common/efile_drv.c | 3138 +++++ erts/emulator/drivers/common/erl_efile.h | 152 + erts/emulator/drivers/common/gzio.c | 822 ++ erts/emulator/drivers/common/gzio.h | 27 + erts/emulator/drivers/common/gzio_zutil.h | 82 + erts/emulator/drivers/common/inet_drv.c | 9949 ++++++++++++++ erts/emulator/drivers/common/ram_file_drv.c | 692 + erts/emulator/drivers/common/zlib_drv.c | 650 + erts/emulator/drivers/unix/bin_drv.c | 224 + erts/emulator/drivers/unix/mem_drv.c | 145 + erts/emulator/drivers/unix/multi_drv.c | 105 + erts/emulator/drivers/unix/sig_drv.c | 81 + erts/emulator/drivers/unix/ttsl_drv.c | 1299 ++ erts/emulator/drivers/unix/unix_efile.c | 1505 +++ erts/emulator/drivers/vxworks/vxworks_resolv.c | 44 + erts/emulator/drivers/win32/mem_drv.c | 141 + erts/emulator/drivers/win32/registry_drv.c | 535 + erts/emulator/drivers/win32/ttsl_drv.c | 751 ++ erts/emulator/drivers/win32/win_con.c | 2259 ++++ erts/emulator/drivers/win32/win_con.h | 39 + erts/emulator/drivers/win32/win_efile.c | 1426 ++ erts/emulator/drivers/win32/winsock_func.h | 102 + erts/emulator/hipe/TODO | 30 + erts/emulator/hipe/elf64ppc.x | 224 + erts/emulator/hipe/hipe_abi.txt | 72 + erts/emulator/hipe/hipe_amd64.c | 376 + erts/emulator/hipe/hipe_amd64.h | 37 + erts/emulator/hipe/hipe_amd64.tab | 28 + erts/emulator/hipe/hipe_amd64_abi.txt | 150 + erts/emulator/hipe/hipe_amd64_asm.m4 | 244 + erts/emulator/hipe/hipe_amd64_bifs.m4 | 555 + erts/emulator/hipe/hipe_amd64_gc.h | 30 + erts/emulator/hipe/hipe_amd64_glue.S | 443 + erts/emulator/hipe/hipe_amd64_glue.h | 30 + erts/emulator/hipe/hipe_amd64_primops.h | 23 + erts/emulator/hipe/hipe_arch.h | 54 + erts/emulator/hipe/hipe_arm.c | 401 + erts/emulator/hipe/hipe_arm.h | 47 + erts/emulator/hipe/hipe_arm.tab | 23 + erts/emulator/hipe/hipe_arm_abi.txt | 95 + erts/emulator/hipe/hipe_arm_asm.m4 | 199 + erts/emulator/hipe/hipe_arm_bifs.m4 | 549 + erts/emulator/hipe/hipe_arm_gc.h | 29 + erts/emulator/hipe/hipe_arm_glue.S | 417 + erts/emulator/hipe/hipe_arm_glue.h | 32 + erts/emulator/hipe/hipe_arm_primops.h | 21 + erts/emulator/hipe/hipe_bif0.c | 1945 +++ erts/emulator/hipe/hipe_bif0.h | 53 + erts/emulator/hipe/hipe_bif0.tab | 142 + erts/emulator/hipe/hipe_bif1.c | 937 ++ erts/emulator/hipe/hipe_bif1.h | 34 + erts/emulator/hipe/hipe_bif1.tab | 49 + erts/emulator/hipe/hipe_bif2.c | 170 + erts/emulator/hipe/hipe_bif2.tab | 33 + erts/emulator/hipe/hipe_bif_list.m4 | 280 + erts/emulator/hipe/hipe_debug.c | 242 + erts/emulator/hipe/hipe_debug.h | 29 + erts/emulator/hipe/hipe_gbif_list.h | 23 + erts/emulator/hipe/hipe_gc.c | 556 + erts/emulator/hipe/hipe_gc.h | 40 + erts/emulator/hipe/hipe_mkliterals.c | 631 + erts/emulator/hipe/hipe_mode_switch.c | 641 + erts/emulator/hipe/hipe_mode_switch.h | 66 + erts/emulator/hipe/hipe_native_bif.c | 590 + erts/emulator/hipe/hipe_native_bif.h | 121 + erts/emulator/hipe/hipe_ops.tab | 25 + erts/emulator/hipe/hipe_perfctr.c | 229 + erts/emulator/hipe/hipe_perfctr.h | 24 + erts/emulator/hipe/hipe_perfctr.tab | 26 + erts/emulator/hipe/hipe_ppc.c | 487 + erts/emulator/hipe/hipe_ppc.h | 67 + erts/emulator/hipe/hipe_ppc.tab | 24 + erts/emulator/hipe/hipe_ppc64.tab | 23 + erts/emulator/hipe/hipe_ppc_abi.txt | 138 + erts/emulator/hipe/hipe_ppc_asm.m4 | 286 + erts/emulator/hipe/hipe_ppc_bifs.m4 | 568 + erts/emulator/hipe/hipe_ppc_gc.h | 29 + erts/emulator/hipe/hipe_ppc_glue.S | 582 + erts/emulator/hipe/hipe_ppc_glue.h | 32 + erts/emulator/hipe/hipe_ppc_primops.h | 24 + erts/emulator/hipe/hipe_primops.h | 96 + erts/emulator/hipe/hipe_process.h | 80 + erts/emulator/hipe/hipe_risc_gc.h | 113 + erts/emulator/hipe/hipe_risc_glue.h | 266 + erts/emulator/hipe/hipe_risc_stack.c | 312 + erts/emulator/hipe/hipe_signal.h | 39 + erts/emulator/hipe/hipe_sparc.c | 243 + erts/emulator/hipe/hipe_sparc.h | 54 + erts/emulator/hipe/hipe_sparc.tab | 23 + erts/emulator/hipe/hipe_sparc_abi.txt | 78 + erts/emulator/hipe/hipe_sparc_asm.m4 | 214 + erts/emulator/hipe/hipe_sparc_bifs.m4 | 578 + erts/emulator/hipe/hipe_sparc_gc.h | 29 + erts/emulator/hipe/hipe_sparc_glue.S | 448 + erts/emulator/hipe/hipe_sparc_glue.h | 32 + erts/emulator/hipe/hipe_sparc_primops.h | 21 + erts/emulator/hipe/hipe_stack.c | 187 + erts/emulator/hipe/hipe_stack.h | 128 + erts/emulator/hipe/hipe_x86.c | 272 + erts/emulator/hipe/hipe_x86.h | 58 + erts/emulator/hipe/hipe_x86.tab | 24 + erts/emulator/hipe/hipe_x86_abi.txt | 128 + erts/emulator/hipe/hipe_x86_asm.m4 | 286 + erts/emulator/hipe/hipe_x86_bifs.m4 | 635 + erts/emulator/hipe/hipe_x86_gc.h | 138 + erts/emulator/hipe/hipe_x86_glue.S | 420 + erts/emulator/hipe/hipe_x86_glue.h | 265 + erts/emulator/hipe/hipe_x86_primops.h | 22 + erts/emulator/hipe/hipe_x86_signal.c | 355 + erts/emulator/hipe/hipe_x86_stack.c | 296 + erts/emulator/internal_doc/erl_ext_dist.txt | 23 + erts/emulator/obsolete/driver.h | 263 + erts/emulator/pcre/Makefile | 26 + erts/emulator/pcre/Makefile.in | 165 + erts/emulator/pcre/local_config.h | 81 + erts/emulator/pcre/make_latin1_table.c | 201 + erts/emulator/pcre/pcre-7.6.tar.bz2 | Bin 0 -> 802829 bytes erts/emulator/pcre/pcre.h | 319 + erts/emulator/pcre/pcre_chartables.c | 199 + erts/emulator/pcre/pcre_compile.c | 6221 +++++++++ erts/emulator/pcre/pcre_config.c | 129 + erts/emulator/pcre/pcre_dfa_exec.c | 2897 +++++ erts/emulator/pcre/pcre_exec.c | 5394 ++++++++ erts/emulator/pcre/pcre_fullinfo.c | 166 + erts/emulator/pcre/pcre_get.c | 466 + erts/emulator/pcre/pcre_globals.c | 65 + erts/emulator/pcre/pcre_info.c | 94 + erts/emulator/pcre/pcre_internal.h | 1136 ++ erts/emulator/pcre/pcre_latin_1_table.c | 193 + erts/emulator/pcre/pcre_make_latin1_default.c | 367 + erts/emulator/pcre/pcre_maketables.c | 144 + erts/emulator/pcre/pcre_newline.c | 165 + erts/emulator/pcre/pcre_ord2utf8.c | 87 + erts/emulator/pcre/pcre_refcount.c | 83 + erts/emulator/pcre/pcre_study.c | 580 + erts/emulator/pcre/pcre_tables.c | 319 + erts/emulator/pcre/pcre_try_flipped.c | 138 + erts/emulator/pcre/pcre_ucp_searchfuncs.c | 181 + erts/emulator/pcre/pcre_valid_utf8.c | 163 + erts/emulator/pcre/pcre_version.c | 91 + erts/emulator/pcre/pcre_xclass.c | 149 + erts/emulator/pcre/ucp.h | 135 + erts/emulator/pcre/ucpinternal.h | 94 + erts/emulator/pcre/ucptable.h | 3088 +++++ erts/emulator/sys/common/erl_check_io.c | 1912 +++ erts/emulator/sys/common/erl_check_io.h | 96 + erts/emulator/sys/common/erl_mseg.c | 1452 +++ erts/emulator/sys/common/erl_mseg.h | 97 + erts/emulator/sys/common/erl_mtrace_sys_wrap.c | 245 + erts/emulator/sys/common/erl_poll.c | 2693 ++++ erts/emulator/sys/common/erl_poll.h | 246 + erts/emulator/sys/unix/driver_int.h | 41 + erts/emulator/sys/unix/erl9_start.c | 130 + erts/emulator/sys/unix/erl_child_setup.c | 122 + erts/emulator/sys/unix/erl_main.c | 31 + erts/emulator/sys/unix/erl_unix_sys.h | 339 + erts/emulator/sys/unix/erl_unix_sys_ddll.c | 280 + erts/emulator/sys/unix/sys.c | 3346 +++++ erts/emulator/sys/unix/sys_float.c | 815 ++ erts/emulator/sys/unix/sys_time.c | 134 + erts/emulator/sys/vxworks/driver_int.h | 30 + erts/emulator/sys/vxworks/erl_main.c | 45 + erts/emulator/sys/vxworks/erl_vxworks_sys.h | 183 + erts/emulator/sys/vxworks/erl_vxworks_sys_ddll.c | 253 + erts/emulator/sys/vxworks/sys.c | 2594 ++++ erts/emulator/sys/win32/dosmap.c | 282 + erts/emulator/sys/win32/driver_int.h | 39 + erts/emulator/sys/win32/erl.def | 4 + erts/emulator/sys/win32/erl_main.c | 29 + erts/emulator/sys/win32/erl_poll.c | 1361 ++ erts/emulator/sys/win32/erl_win32_sys_ddll.c | 206 + erts/emulator/sys/win32/erl_win_dyn_driver.h | 489 + erts/emulator/sys/win32/erl_win_sys.h | 212 + erts/emulator/sys/win32/sys.c | 3093 +++++ erts/emulator/sys/win32/sys_env.c | 261 + erts/emulator/sys/win32/sys_float.c | 145 + erts/emulator/sys/win32/sys_interrupt.c | 142 + erts/emulator/sys/win32/sys_time.c | 96 + erts/emulator/test/Makefile | 194 + erts/emulator/test/a_SUITE.erl | 99 + erts/emulator/test/a_SUITE_data/Makefile.src | 10 + erts/emulator/test/a_SUITE_data/timer_driver.c | 77 + erts/emulator/test/after_SUITE.erl | 233 + erts/emulator/test/alloc_SUITE.erl | 179 + erts/emulator/test/alloc_SUITE_data/Makefile.src | 41 + .../test/alloc_SUITE_data/allocator_test.h | 131 + erts/emulator/test/alloc_SUITE_data/basic.c | 61 + erts/emulator/test/alloc_SUITE_data/bucket_index.c | 114 + erts/emulator/test/alloc_SUITE_data/bucket_mask.c | 147 + erts/emulator/test/alloc_SUITE_data/coalesce.c | 318 + .../test/alloc_SUITE_data/mseg_clear_cache.c | 102 + erts/emulator/test/alloc_SUITE_data/rbtree.c | 386 + erts/emulator/test/alloc_SUITE_data/realloc_copy.c | 279 + .../test/alloc_SUITE_data/testcase_driver.c | 260 + .../test/alloc_SUITE_data/testcase_driver.h | 51 + erts/emulator/test/alloc_SUITE_data/threads.c | 447 + erts/emulator/test/beam_SUITE.erl | 281 + erts/emulator/test/beam_literals_SUITE.erl | 433 + .../literal_case_expression.S | 70 + erts/emulator/test/bif_SUITE.erl | 317 + erts/emulator/test/big_SUITE.erl | 396 + erts/emulator/test/big_SUITE_data/borders.dat | 1116 ++ erts/emulator/test/big_SUITE_data/eq_28.dat | 3000 +++++ erts/emulator/test/big_SUITE_data/eq_32.dat | 3000 +++++ erts/emulator/test/big_SUITE_data/eq_big.dat | 13004 +++++++++++++++++++ erts/emulator/test/big_SUITE_data/eq_math.dat | 78 + erts/emulator/test/big_SUITE_data/literal_test.erl | 38 + erts/emulator/test/big_SUITE_data/negative.dat | 10 + erts/emulator/test/binary_SUITE.erl | 1313 ++ erts/emulator/test/binary_SUITE_data/bad_binary | Bin 0 -> 3279 bytes .../emulator/test/binary_SUITE_data/zzz.terms.1197 | 1 + .../emulator/test/binary_SUITE_data/zzz.terms.2224 | 1 + .../test/binary_SUITE_data/zzz.terms.24619 | 1 + .../test/binary_SUITE_data/zzz.terms.25681 | 1 + .../test/binary_SUITE_data/zzz.terms.26563 | 1 + .../test/binary_SUITE_data/zzz.terms.26744 | 1 + .../test/binary_SUITE_data/zzz.terms.27459 | 1 + erts/emulator/test/binary_SUITE_data/zzz.terms.527 | 1 + .../emulator/test/binary_SUITE_data/zzz.terms.8929 | 1 + erts/emulator/test/bs_bincomp_SUITE.erl | 130 + erts/emulator/test/bs_bit_binaries_SUITE.erl | 183 + erts/emulator/test/bs_construct_SUITE.erl | 790 ++ erts/emulator/test/bs_match_bin_SUITE.erl | 195 + erts/emulator/test/bs_match_int_SUITE.erl | 331 + erts/emulator/test/bs_match_misc_SUITE.erl | 537 + erts/emulator/test/bs_match_tail_SUITE.erl | 87 + erts/emulator/test/bs_utf_SUITE.erl | 394 + erts/emulator/test/busy_port_SUITE.erl | 628 + .../test/busy_port_SUITE_data/Makefile.src | 25 + erts/emulator/test/busy_port_SUITE_data/busy_drv.c | 97 + .../test/busy_port_SUITE_data/hard_busy_drv.c | 23 + .../test/busy_port_SUITE_data/hs_busy_drv.c | 94 + .../test/busy_port_SUITE_data/soft_busy_drv.c | 23 + erts/emulator/test/call_trace_SUITE.erl | 1240 ++ erts/emulator/test/code_SUITE.erl | 520 + .../test/code_SUITE_data/another_code_test.erl | 23 + erts/emulator/test/code_SUITE_data/cpbugx.erl | 45 + erts/emulator/test/code_SUITE_data/literals.erl | 83 + erts/emulator/test/code_SUITE_data/many_funs.erl | 47 + .../emulator/test/code_SUITE_data/my_code_test.erl | 27 + erts/emulator/test/crypto_SUITE.erl | 330 + erts/emulator/test/crypto_reference.erl | 856 ++ erts/emulator/test/ddll_SUITE.erl | 1120 ++ erts/emulator/test/ddll_SUITE_data/Makefile.src | 3 + erts/emulator/test/ddll_SUITE_data/dummy_drv.c | 49 + erts/emulator/test/ddll_SUITE_data/echo_drv.c | 52 + .../test/ddll_SUITE_data/echo_drv_fail_init.c | 59 + erts/emulator/test/ddll_SUITE_data/initfail_drv.c | 46 + erts/emulator/test/ddll_SUITE_data/lock_drv.c | 55 + erts/emulator/test/ddll_SUITE_data/noinit_drv.c | 58 + erts/emulator/test/ddll_SUITE_data/wrongname_drv.c | 50 + erts/emulator/test/decode_packet_SUITE.erl | 514 + erts/emulator/test/dgawd_handler.erl | 118 + .../test/dist_init_unix_SUITE_data/hosts.dn_sp | 7 + .../dist_init_unix_SUITE_data/hosts.underscore | 7 + .../dist_init_unix_SUITE_data/nsswitch.conf.dn_sp | 31 + .../dist_init_unix_SUITE_data/resolv.conf.dn_sp | 6 + erts/emulator/test/distribution_SUITE.erl | 1842 +++ .../test/distribution_SUITE_data/Makefile.src | 4 + erts/emulator/test/distribution_SUITE_data/run.erl | 48 + erts/emulator/test/driver_SUITE.erl | 1993 +++ erts/emulator/test/driver_SUITE_data/Makefile.src | 33 + erts/emulator/test/driver_SUITE_data/caller_drv.c | 134 + erts/emulator/test/driver_SUITE_data/chkio_drv.c | 1575 +++ .../invalid_extended_marker_drv.c | 32 + .../test/driver_SUITE_data/io_ready_exit_drv.c | 151 + .../emulator/test/driver_SUITE_data/ioq_exit_drv.c | 423 + .../test/driver_SUITE_data/larger_major_vsn_drv.c | 31 + .../test/driver_SUITE_data/larger_minor_vsn_drv.c | 31 + .../test/driver_SUITE_data/many_events_drv.c | 98 + .../test/driver_SUITE_data/missing_callback_drv.c | 144 + erts/emulator/test/driver_SUITE_data/monitor_drv.c | 293 + .../emulator/test/driver_SUITE_data/otp_6879_drv.c | 71 + erts/emulator/test/driver_SUITE_data/outputv_drv.c | 63 + .../peek_non_existing_queue_drv.c | 231 + erts/emulator/test/driver_SUITE_data/queue_drv.c | 195 + .../test/driver_SUITE_data/smaller_major_vsn_drv.c | 31 + .../test/driver_SUITE_data/smaller_minor_vsn_drv.c | 31 + .../test/driver_SUITE_data/sys_info_1_0_drv.c | 72 + .../test/driver_SUITE_data/sys_info_1_1_drv.c | 80 + .../test/driver_SUITE_data/sys_info_curr_drv.c | 77 + .../test/driver_SUITE_data/sys_info_drv_impl.c | 154 + .../test/driver_SUITE_data/sys_info_drv_impl.h | 29 + .../test/driver_SUITE_data/thr_alloc_drv.c | 125 + erts/emulator/test/driver_SUITE_data/timer_drv.c | 96 + .../test/driver_SUITE_data/vsn_mismatch_drv_impl.c | 67 + .../zero_extended_marker_garb_drv.c | 32 + erts/emulator/test/efile_SUITE.erl | 76 + erts/emulator/test/efile_SUITE_data/existing_file | 1 + erts/emulator/test/emulator.spec | 1 + erts/emulator/test/emulator.spec.ose | 2 + erts/emulator/test/emulator.spec.vxworks | 26 + erts/emulator/test/emulator.spec.win | 2 + erts/emulator/test/erl_drv_thread_SUITE.erl | 119 + .../test/erl_drv_thread_SUITE_data/Makefile.src | 33 + .../test/erl_drv_thread_SUITE_data/basic.c | 291 + .../test/erl_drv_thread_SUITE_data/rwlock.c | 214 + .../erl_drv_thread_SUITE_data/testcase_driver.c | 260 + .../erl_drv_thread_SUITE_data/testcase_driver.h | 58 + erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c | 173 + erts/emulator/test/erl_link_SUITE.erl | 1133 ++ erts/emulator/test/erts_debug_SUITE.erl | 72 + erts/emulator/test/estone_SUITE.erl | 1107 ++ erts/emulator/test/estone_SUITE_data/Makefile.src | 15 + erts/emulator/test/estone_SUITE_data/estone_cat.c | 40 + erts/emulator/test/estone_SUITE_data/sunspeed.sh | 10 + erts/emulator/test/evil_SUITE.erl | 377 + erts/emulator/test/exception_SUITE.erl | 497 + erts/emulator/test/float_SUITE.erl | 167 + erts/emulator/test/float_SUITE_data/Makefile.src | 8 + erts/emulator/test/float_SUITE_data/fp_drv.c | 142 + .../emulator/test/float_SUITE_data/has_fpe_bug.erl | 31 + erts/emulator/test/fun_SUITE.erl | 884 ++ erts/emulator/test/fun_r11_SUITE.erl | 76 + erts/emulator/test/gc_SUITE.erl | 181 + erts/emulator/test/guard_SUITE.erl | 390 + erts/emulator/test/hash_SUITE.erl | 717 + erts/emulator/test/hibernate_SUITE.erl | 353 + erts/emulator/test/ignore_cores.erl | 1 + erts/emulator/test/list_bif_SUITE.erl | 145 + erts/emulator/test/long_timers_test.erl | 317 + erts/emulator/test/match_spec_SUITE.erl | 942 ++ erts/emulator/test/module_info_SUITE.erl | 105 + erts/emulator/test/monitor_SUITE.erl | 943 ++ erts/emulator/test/nested_SUITE.erl | 92 + erts/emulator/test/nif_SUITE.erl | 235 + erts/emulator/test/nif_SUITE_data/Makefile.src | 14 + erts/emulator/test/nif_SUITE_data/nif_SUITE.1.c | 2 + erts/emulator/test/nif_SUITE_data/nif_SUITE.c | 149 + erts/emulator/test/nif_SUITE_data/nif_mod.1.c | 2 + erts/emulator/test/nif_SUITE_data/nif_mod.2.c | 2 + erts/emulator/test/nif_SUITE_data/nif_mod.3.c | 2 + erts/emulator/test/nif_SUITE_data/nif_mod.c | 103 + erts/emulator/test/nif_SUITE_data/nif_mod.erl | 64 + erts/emulator/test/nif_SUITE_data/nif_mod.h | 17 + erts/emulator/test/node_container_SUITE.erl | 1288 ++ erts/emulator/test/nofrag_SUITE.erl | 208 + erts/emulator/test/num_bif_SUITE.erl | 268 + erts/emulator/test/obsolete_SUITE.erl | 123 + .../emulator/test/obsolete_SUITE_data/Makefile.src | 33 + .../test/obsolete_SUITE_data/erl_threads.c | 302 + .../test/obsolete_SUITE_data/testcase_driver.c | 262 + .../test/obsolete_SUITE_data/testcase_driver.h | 57 + erts/emulator/test/old_mod.erl | 47 + erts/emulator/test/old_scheduler_SUITE.erl | 394 + erts/emulator/test/op_SUITE.erl | 368 + erts/emulator/test/port_SUITE.erl | 2288 ++++ erts/emulator/test/port_SUITE_data/Makefile.src | 26 + erts/emulator/test/port_SUITE_data/dir/dummy | 1 + erts/emulator/test/port_SUITE_data/echo_args.c | 12 + erts/emulator/test/port_SUITE_data/echo_drv.c | 85 + erts/emulator/test/port_SUITE_data/exit_drv.c | 68 + erts/emulator/test/port_SUITE_data/failure_drv.c | 63 + erts/emulator/test/port_SUITE_data/port_test.c | 605 + erts/emulator/test/port_SUITE_data/port_test.erl | 36 + erts/emulator/test/port_SUITE_data/reclaim.h | 60 + erts/emulator/test/port_bif_SUITE.erl | 446 + .../emulator/test/port_bif_SUITE_data/Makefile.src | 14 + .../test/port_bif_SUITE_data/control_drv.c | 84 + erts/emulator/test/port_bif_SUITE_data/port_test.c | 602 + erts/emulator/test/port_bif_SUITE_data/reclaim.h | 60 + erts/emulator/test/process_SUITE.erl | 2067 +++ erts/emulator/test/pseudoknot_SUITE.erl | 3326 +++++ erts/emulator/test/random_iolist.erl | 195 + erts/emulator/test/ref_SUITE.erl | 58 + erts/emulator/test/register_SUITE.erl | 87 + erts/emulator/test/save_calls_SUITE.erl | 256 + erts/emulator/test/scheduler_SUITE.erl | 1378 ++ erts/emulator/test/send_term_SUITE.erl | 354 + .../test/send_term_SUITE_data/Makefile.src | 3 + .../test/send_term_SUITE_data/ext_terms.bin | Bin 0 -> 476 bytes .../emulator/test/send_term_SUITE_data/ext_terms.h | 110 + .../test/send_term_SUITE_data/send_term_drv.c | 718 + erts/emulator/test/sensitive_SUITE.erl | 461 + erts/emulator/test/signal_SUITE.erl | 544 + erts/emulator/test/statistics_SUITE.erl | 341 + erts/emulator/test/suite_release.exclude | 6 + erts/emulator/test/system_info_SUITE.erl | 142 + erts/emulator/test/system_profile_SUITE.erl | 474 + .../test/system_profile_SUITE_data/Makefile.src | 3 + .../test/system_profile_SUITE_data/echo_drv.c | 66 + erts/emulator/test/time_SUITE.erl | 439 + erts/emulator/test/timer_bif_SUITE.erl | 558 + erts/emulator/test/trace_SUITE.erl | 1496 +++ erts/emulator/test/trace_bif_SUITE.erl | 268 + erts/emulator/test/trace_call_count_SUITE.erl | 362 + erts/emulator/test/trace_local_SUITE.erl | 1259 ++ .../trace_local_SUITE_data/trace_local_dummy.erl | 28 + erts/emulator/test/trace_meta_SUITE.erl | 758 ++ erts/emulator/test/trace_nif_SUITE.erl | 292 + .../test/trace_nif_SUITE_data/Makefile.src | 7 + .../emulator/test/trace_nif_SUITE_data/trace_nif.c | 46 + erts/emulator/test/trace_port_SUITE.erl | 686 + .../test/trace_port_SUITE_data/Makefile.src | 3 + .../emulator/test/trace_port_SUITE_data/echo_drv.c | 107 + erts/emulator/test/tuple_SUITE.erl | 283 + erts/emulator/test/z_SUITE.erl | 312 + erts/emulator/utils/beam_makeops | 1500 +++ erts/emulator/utils/beam_strip | 89 + erts/emulator/utils/make_alloc_types | 672 + erts/emulator/utils/make_driver_tab | 71 + erts/emulator/utils/make_preload | 209 + erts/emulator/utils/make_tables | 368 + erts/emulator/utils/make_version | 63 + erts/emulator/utils/mkver.c | 60 + erts/emulator/zlib/Makefile | 23 + erts/emulator/zlib/Makefile.in | 116 + erts/emulator/zlib/adler32.c | 154 + erts/emulator/zlib/compress.c | 84 + erts/emulator/zlib/crc32.c | 428 + erts/emulator/zlib/crc32.h | 443 + erts/emulator/zlib/deflate.c | 1741 +++ erts/emulator/zlib/deflate.h | 333 + erts/emulator/zlib/example.c | 570 + erts/emulator/zlib/inffast.c | 323 + erts/emulator/zlib/inffast.h | 13 + erts/emulator/zlib/inffixed.h | 94 + erts/emulator/zlib/inflate.c | 1373 ++ erts/emulator/zlib/inflate.h | 117 + erts/emulator/zlib/inftrees.c | 334 + erts/emulator/zlib/inftrees.h | 57 + erts/emulator/zlib/trees.c | 1224 ++ erts/emulator/zlib/trees.h | 128 + erts/emulator/zlib/uncompr.c | 66 + erts/emulator/zlib/zconf.h | 334 + erts/emulator/zlib/zlib.h | 1359 ++ erts/emulator/zlib/zutil.c | 327 + erts/emulator/zlib/zutil.h | 271 + erts/epmd/Makefile | 32 + erts/epmd/doc/.gitignore | 0 erts/epmd/epmd.mk | 70 + erts/epmd/src/Makefile | 22 + erts/epmd/src/Makefile.in | 123 + erts/epmd/src/epmd.c | 629 + erts/epmd/src/epmd.h | 37 + erts/epmd/src/epmd_cli.c | 127 + erts/epmd/src/epmd_int.h | 346 + erts/epmd/src/epmd_srv.c | 1254 ++ erts/epmd/test/Makefile | 80 + erts/epmd/test/epmd.spec | 1 + erts/epmd/test/epmd.spec.vxworks | 2 + erts/epmd/test/epmd_SUITE.erl | 835 ++ erts/etc/Makefile | 27 + erts/etc/common/Makefile | 23 + erts/etc/common/Makefile.in | 564 + erts/etc/common/dialyzer.c | 466 + erts/etc/common/erlc.c | 701 + erts/etc/common/erlexec.c | 2038 +++ erts/etc/common/escript.c | 697 + erts/etc/common/heart.c | 1142 ++ erts/etc/common/inet_gethost.c | 2757 ++++ erts/etc/common/typer.c | 416 + erts/etc/unix/Install.src | 175 + erts/etc/unix/README | 111 + erts/etc/unix/RELNOTES | 327 + erts/etc/unix/cerl.src | 285 + erts/etc/unix/dyn_erl.c | 400 + erts/etc/unix/erl.src.src | 28 + erts/etc/unix/etp-commands | 2054 +++ erts/etc/unix/etp_commands.erl | 173 + erts/etc/unix/etp_commands.mk | 27 + erts/etc/unix/format_man_pages | 149 + erts/etc/unix/makewhatis | 327 + erts/etc/unix/run_erl.c | 1298 ++ erts/etc/unix/run_erl.h | 30 + erts/etc/unix/safe_string.c | 123 + erts/etc/unix/safe_string.h | 65 + erts/etc/unix/setuid_socket_wrap.c | 259 + erts/etc/unix/start.src | 36 + erts/etc/unix/start_erl.src | 47 + erts/etc/unix/to_erl.c | 610 + erts/etc/vxworks/README.VxWorks | 350 + erts/etc/vxworks/erl.exec.c | 129 + erts/etc/vxworks/erl_io.c | 108 + erts/etc/vxworks/erl_script.sam.in | 100 + erts/etc/vxworks/heart_config.c | 60 + erts/etc/vxworks/heart_config.h | 35 + erts/etc/vxworks/rdate.c | 87 + erts/etc/vxworks/reclaim.c | 551 + erts/etc/vxworks/reclaim.h | 150 + erts/etc/vxworks/reclaim_private.h | 44 + erts/etc/vxworks/resolv.conf | 6 + erts/etc/vxworks/vxcall.c | 145 + erts/etc/vxworks/wd_example.c | 141 + erts/etc/win32/Install.c | 229 + erts/etc/win32/Install.src | 4 + erts/etc/win32/Makefile | 72 + erts/etc/win32/Nmakefile.start_erl | 33 + erts/etc/win32/beam.rc | 102 + erts/etc/win32/beam_icon.ico | Bin 0 -> 766 bytes erts/etc/win32/cygwin_tools/erl | 48 + erts/etc/win32/cygwin_tools/erlc | 61 + erts/etc/win32/cygwin_tools/javac.sh | 53 + erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh | 44 + erts/etc/win32/cygwin_tools/make_local_ini.sh | 41 + erts/etc/win32/cygwin_tools/mingw/ar.sh | 55 + erts/etc/win32/cygwin_tools/mingw/cc.sh | 293 + erts/etc/win32/cygwin_tools/mingw/coffix.c | 161 + erts/etc/win32/cygwin_tools/mingw/emu_cc.sh | 90 + erts/etc/win32/cygwin_tools/mingw/ld.sh | 147 + erts/etc/win32/cygwin_tools/mingw/mc.sh | 89 + erts/etc/win32/cygwin_tools/mingw/rc.sh | 94 + erts/etc/win32/cygwin_tools/vc/ar.sh | 47 + erts/etc/win32/cygwin_tools/vc/cc.sh | 321 + erts/etc/win32/cygwin_tools/vc/cc_wrap.c | 864 ++ erts/etc/win32/cygwin_tools/vc/coffix.c | 161 + erts/etc/win32/cygwin_tools/vc/emu_cc.sh | 90 + erts/etc/win32/cygwin_tools/vc/ld.sh | 192 + erts/etc/win32/cygwin_tools/vc/ld_wrap.c | 796 ++ erts/etc/win32/cygwin_tools/vc/mc.sh | 87 + erts/etc/win32/cygwin_tools/vc/rc.sh | 86 + erts/etc/win32/erl.c | 283 + erts/etc/win32/erl.rc | 31 + erts/etc/win32/erl_icon.ico | Bin 0 -> 766 bytes erts/etc/win32/erl_log.c | 73 + erts/etc/win32/erlang.ico | Bin 0 -> 1398 bytes erts/etc/win32/erlsrv/erlsrv_global.h | 37 + erts/etc/win32/erlsrv/erlsrv_interactive.c | 1163 ++ erts/etc/win32/erlsrv/erlsrv_interactive.h | 24 + erts/etc/win32/erlsrv/erlsrv_logmess.mc | 33 + erts/etc/win32/erlsrv/erlsrv_main.c | 44 + erts/etc/win32/erlsrv/erlsrv_registry.c | 404 + erts/etc/win32/erlsrv/erlsrv_registry.h | 76 + erts/etc/win32/erlsrv/erlsrv_service.c | 966 ++ erts/etc/win32/erlsrv/erlsrv_service.h | 32 + erts/etc/win32/erlsrv/erlsrv_util.c | 154 + erts/etc/win32/erlsrv/erlsrv_util.h | 50 + erts/etc/win32/hrl_icon.ico | Bin 0 -> 766 bytes erts/etc/win32/init_file.c | 565 + erts/etc/win32/init_file.h | 93 + erts/etc/win32/nsis/Makefile | 88 + erts/etc/win32/nsis/custom_modern.exe | Bin 0 -> 6144 bytes erts/etc/win32/nsis/dll_version_helper.sh | 49 + erts/etc/win32/nsis/erlang.nsi | 386 + erts/etc/win32/nsis/erlang20.nsi | 440 + erts/etc/win32/nsis/erlang_inst.ico | Bin 0 -> 766 bytes erts/etc/win32/nsis/erlang_uninst.ico | Bin 0 -> 766 bytes erts/etc/win32/nsis/find_redist.sh | 122 + erts/etc/win32/port_entry.c | 75 + erts/etc/win32/resource.h | 33 + erts/etc/win32/start_erl.c | 677 + erts/etc/win32/toolbar.bmp | Bin 0 -> 598 bytes erts/etc/win32/win_erlexec.c | 405 + erts/example/Makefile | 62 + erts/example/next_perm.cc | 137 + erts/example/next_perm.erl | 66 + erts/example/pg_async.c | 224 + erts/example/pg_async.erl | 57 + erts/example/pg_async2.c | 244 + erts/example/pg_async2.erl | 53 + erts/example/pg_encode.c | 79 + erts/example/pg_encode.h | 21 + erts/example/pg_encode2.c | 82 + erts/example/pg_encode2.h | 21 + erts/example/pg_sync.c | 180 + erts/example/pg_sync.erl | 46 + erts/include/erl_fixed_size_int_types.h | 160 + erts/include/erl_int_sizes_config.h.in | 33 + erts/include/erl_memory_trace_parser.h | 156 + erts/include/internal/README | 28 + erts/include/internal/erl_errno.h | 51 + erts/include/internal/erl_memory_trace_protocol.h | 245 + erts/include/internal/erl_misc_utils.h | 53 + erts/include/internal/erl_printf.h | 57 + erts/include/internal/erl_printf_format.h | 46 + erts/include/internal/erts_internal.mk.in | 24 + erts/include/internal/ethread.h | 1448 +++ erts/include/internal/ethread.mk.in | 39 + erts/include/internal/ethread_header_config.h.in | 55 + erts/include/internal/i386/atomic.h | 155 + erts/include/internal/i386/ethread.h | 34 + erts/include/internal/i386/rwlock.h | 134 + erts/include/internal/i386/spinlock.h | 92 + erts/include/internal/ppc32/atomic.h | 209 + erts/include/internal/ppc32/ethread.h | 34 + erts/include/internal/ppc32/rwlock.h | 153 + erts/include/internal/ppc32/spinlock.h | 93 + erts/include/internal/sparc32/atomic.h | 173 + erts/include/internal/sparc32/ethread.h | 34 + erts/include/internal/sparc32/rwlock.h | 142 + erts/include/internal/sparc32/spinlock.h | 81 + erts/include/internal/sparc64/ethread.h | 20 + erts/include/internal/tile/atomic.h | 128 + erts/include/internal/tile/ethread.h | 30 + erts/include/internal/x86_64/ethread.h | 20 + erts/info.src | 3 + erts/internal_doc/.gitignore | 0 erts/lib/internal/README | 28 + erts/lib_src/Makefile | 22 + erts/lib_src/Makefile.in | 615 + erts/lib_src/common/erl_memory_trace_parser.c | 1956 +++ erts/lib_src/common/erl_misc_utils.c | 967 ++ erts/lib_src/common/erl_printf.c | 427 + erts/lib_src/common/erl_printf_format.c | 940 ++ erts/lib_src/common/ethread.c | 3346 +++++ erts/man/.gitignore | 0 erts/ntbuild.erl | 332 + erts/obj.debug/.gitignore | 0 erts/obj/.gitignore | 0 erts/prebuild.skip | 1 + erts/preloaded/Makefile | 25 + erts/preloaded/ebin/erl_prim_loader.beam | Bin 0 -> 48420 bytes erts/preloaded/ebin/erlang.beam | Bin 0 -> 23232 bytes erts/preloaded/ebin/init.beam | Bin 0 -> 44460 bytes erts/preloaded/ebin/otp_ring0.beam | Bin 0 -> 1392 bytes erts/preloaded/ebin/prim_file.beam | Bin 0 -> 29480 bytes erts/preloaded/ebin/prim_inet.beam | Bin 0 -> 57308 bytes erts/preloaded/ebin/prim_zip.beam | Bin 0 -> 20756 bytes erts/preloaded/ebin/zlib.beam | Bin 0 -> 10624 bytes erts/preloaded/src/Makefile | 105 + erts/preloaded/src/erl_prim_loader.erl | 1406 ++ erts/preloaded/src/erlang.erl | 683 + erts/preloaded/src/init.erl | 1372 ++ erts/preloaded/src/otp_ring0.erl | 35 + erts/preloaded/src/prim_file.erl | 1168 ++ erts/preloaded/src/prim_inet.erl | 1962 +++ erts/preloaded/src/prim_zip.erl | 604 + erts/preloaded/src/zip_internal.hrl | 103 + erts/preloaded/src/zlib.erl | 421 + erts/start_scripts/Makefile | 179 + erts/start_scripts/start_all_example.rel.src | 26 + erts/start_scripts/start_clean.rel.src | 21 + erts/start_scripts/start_sasl.rel.src | 22 + erts/test/Makefile | 81 + erts/test/erl_print_SUITE.erl | 453 + erts/test/erl_print_SUITE_data/Makefile.src | 45 + erts/test/erl_print_SUITE_data/character_test.h | 586 + erts/test/erl_print_SUITE_data/erl_print_tests.c | 560 + erts/test/erl_print_SUITE_data/integer_64_test.h | 1106 ++ erts/test/erl_print_SUITE_data/integer_test.h | 1106 ++ erts/test/erl_print_SUITE_data/snprintf_test.h | 43 + erts/test/erl_print_SUITE_data/string_test.h | 33 + erts/test/erlc_SUITE.erl | 286 + erts/test/erlc_SUITE_data/include/erl_test.hrl | 19 + erts/test/erlc_SUITE_data/src/BAD-MIB.mib | 1 + erts/test/erlc_SUITE_data/src/GOOD-MIB.mib | 39 + erts/test/erlc_SUITE_data/src/erl_test_bad.erl | 22 + erts/test/erlc_SUITE_data/src/erl_test_ok.erl | 29 + erts/test/erlc_SUITE_data/src/start_bad.script | 1 + erts/test/erlc_SUITE_data/src/start_ok.script | 207 + erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl | 32 + erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl | 29 + erts/test/erlexec_SUITE.erl | 437 + erts/test/erlexec_SUITE_data/Makefile.src | 37 + erts/test/erlexec_SUITE_data/erlexec_tests.c | 110 + erts/test/ethread_SUITE.erl | 365 + erts/test/ethread_SUITE_data/Makefile.src | 41 + erts/test/ethread_SUITE_data/ethread_tests.c | 2403 ++++ erts/test/ignore_cores.erl | 158 + erts/test/nt_SUITE.erl | 551 + erts/test/nt_SUITE_data/Makefile.src | 33 + erts/test/nt_SUITE_data/nt_info.c | 176 + erts/test/otp_SUITE.erl | 297 + erts/test/run_erl_SUITE.erl | 270 + erts/test/run_erl_SUITE_data/defuncter.pl | 31 + erts/test/run_erl_SUITE_data/run_erl_test.pl | 41 + erts/test/system.dynspec | 18 + erts/test/system.spec | 1 + erts/test/system.spec.vxworks | 2 + erts/test/utils/gccifier.c | 316 + erts/test/z_SUITE.erl | 315 + erts/vsn.mk | 28 + 878 files changed, 426660 insertions(+) create mode 100644 erts/AUTHORS create mode 100644 erts/Makefile.in create mode 100644 erts/aclocal.m4 create mode 100755 erts/autoconf/config.guess create mode 100755 erts/autoconf/config.sub create mode 100755 erts/autoconf/configure.vxworks create mode 100755 erts/autoconf/install-sh create mode 100644 erts/autoconf/vxworks/sed.general create mode 100644 erts/autoconf/vxworks/sed.vxworks_cpu32 create mode 100644 erts/autoconf/vxworks/sed.vxworks_ppc32 create mode 100644 erts/autoconf/vxworks/sed.vxworks_ppc603 create mode 100644 erts/autoconf/vxworks/sed.vxworks_ppc603_nolongcall create mode 100644 erts/autoconf/vxworks/sed.vxworks_ppc860 create mode 100644 erts/autoconf/vxworks/sed.vxworks_simlinux create mode 100644 erts/autoconf/vxworks/sed.vxworks_simso create mode 100644 erts/autoconf/vxworks/sed.vxworks_sparc create mode 100755 erts/autoconf/win32.config.cache create mode 100644 erts/configure.in create mode 100644 erts/doc/Makefile create mode 100644 erts/doc/html/.gitignore create mode 100644 erts/doc/man1/.gitignore create mode 100644 erts/doc/man3/.gitignore create mode 100644 erts/doc/pdf/.gitignore create mode 100644 erts/doc/src/Makefile create mode 100644 erts/doc/src/absform.xml create mode 100644 erts/doc/src/alt_dist.xml create mode 100644 erts/doc/src/book.xml create mode 100644 erts/doc/src/crash_dump.xml create mode 100644 erts/doc/src/driver.xml create mode 100644 erts/doc/src/driver_entry.xml create mode 100644 erts/doc/src/epmd.xml create mode 100644 erts/doc/src/erl.xml create mode 100644 erts/doc/src/erl_dist_protocol.xml create mode 100644 erts/doc/src/erl_driver.xml create mode 100644 erts/doc/src/erl_ext_dist.xml create mode 100755 erts/doc/src/erl_ext_fig.gif create mode 100644 erts/doc/src/erl_ext_fig.ps create mode 100644 erts/doc/src/erl_fix_alloc.fig create mode 100644 erts/doc/src/erl_fix_alloc.gif create mode 100644 erts/doc/src/erl_fix_alloc.ps create mode 100644 erts/doc/src/erl_nif.xml create mode 100644 erts/doc/src/erl_prim_loader.xml create mode 100644 erts/doc/src/erl_set_memory_block.xml create mode 100644 erts/doc/src/erlang.xml create mode 100644 erts/doc/src/erlc.xml create mode 100644 erts/doc/src/erlsrv.xml create mode 100644 erts/doc/src/erts_alloc.xml create mode 100644 erts/doc/src/escript.xml create mode 100644 erts/doc/src/fascicules.xml create mode 100644 erts/doc/src/inet_cfg.xml create mode 100644 erts/doc/src/init.xml create mode 100644 erts/doc/src/make.dep create mode 100644 erts/doc/src/match_spec.xml create mode 100644 erts/doc/src/notes.xml create mode 100644 erts/doc/src/notes_history.xml create mode 100644 erts/doc/src/part.xml create mode 100644 erts/doc/src/part_notes.xml create mode 100644 erts/doc/src/part_notes_history.xml create mode 100644 erts/doc/src/ref_man.xml create mode 100644 erts/doc/src/run_erl.xml create mode 100644 erts/doc/src/start.xml create mode 100644 erts/doc/src/start_erl.xml create mode 100644 erts/doc/src/tty.xml create mode 100644 erts/doc/src/werl.xml create mode 100644 erts/doc/src/zlib.xml create mode 100644 erts/emulator/Makefile create mode 100644 erts/emulator/Makefile.in create mode 100644 erts/emulator/beam/atom.c create mode 100644 erts/emulator/beam/atom.h create mode 100644 erts/emulator/beam/atom.names create mode 100644 erts/emulator/beam/beam_bif_load.c create mode 100644 erts/emulator/beam/beam_bp.c create mode 100644 erts/emulator/beam/beam_bp.h create mode 100644 erts/emulator/beam/beam_catches.c create mode 100644 erts/emulator/beam/beam_catches.h create mode 100644 erts/emulator/beam/beam_debug.c create mode 100644 erts/emulator/beam/beam_emu.c create mode 100644 erts/emulator/beam/beam_load.c create mode 100644 erts/emulator/beam/beam_load.h create mode 100644 erts/emulator/beam/benchmark.c create mode 100644 erts/emulator/beam/benchmark.h create mode 100644 erts/emulator/beam/bif.c create mode 100644 erts/emulator/beam/bif.h create mode 100644 erts/emulator/beam/bif.tab create mode 100644 erts/emulator/beam/big.c create mode 100644 erts/emulator/beam/big.h create mode 100644 erts/emulator/beam/binary.c create mode 100644 erts/emulator/beam/break.c create mode 100644 erts/emulator/beam/copy.c create mode 100644 erts/emulator/beam/decl.h create mode 100644 erts/emulator/beam/dist.c create mode 100644 erts/emulator/beam/dist.h create mode 100644 erts/emulator/beam/elib_malloc.c create mode 100644 erts/emulator/beam/elib_memmove.c create mode 100644 erts/emulator/beam/elib_stat.h create mode 100644 erts/emulator/beam/erl_afit_alloc.c create mode 100644 erts/emulator/beam/erl_afit_alloc.h create mode 100644 erts/emulator/beam/erl_alloc.c create mode 100644 erts/emulator/beam/erl_alloc.h create mode 100644 erts/emulator/beam/erl_alloc.types create mode 100644 erts/emulator/beam/erl_alloc_util.c create mode 100644 erts/emulator/beam/erl_alloc_util.h create mode 100644 erts/emulator/beam/erl_arith.c create mode 100644 erts/emulator/beam/erl_async.c create mode 100644 erts/emulator/beam/erl_bestfit_alloc.c create mode 100644 erts/emulator/beam/erl_bestfit_alloc.h create mode 100644 erts/emulator/beam/erl_bif_chksum.c create mode 100644 erts/emulator/beam/erl_bif_ddll.c create mode 100644 erts/emulator/beam/erl_bif_guard.c create mode 100644 erts/emulator/beam/erl_bif_info.c create mode 100644 erts/emulator/beam/erl_bif_lists.c create mode 100644 erts/emulator/beam/erl_bif_op.c create mode 100644 erts/emulator/beam/erl_bif_os.c create mode 100644 erts/emulator/beam/erl_bif_port.c create mode 100644 erts/emulator/beam/erl_bif_re.c create mode 100644 erts/emulator/beam/erl_bif_timer.c create mode 100644 erts/emulator/beam/erl_bif_timer.h create mode 100644 erts/emulator/beam/erl_bif_trace.c create mode 100644 erts/emulator/beam/erl_binary.h create mode 100644 erts/emulator/beam/erl_bits.c create mode 100644 erts/emulator/beam/erl_bits.h create mode 100644 erts/emulator/beam/erl_db.c create mode 100644 erts/emulator/beam/erl_db.h create mode 100644 erts/emulator/beam/erl_db_hash.c create mode 100644 erts/emulator/beam/erl_db_hash.h create mode 100644 erts/emulator/beam/erl_db_tree.c create mode 100644 erts/emulator/beam/erl_db_tree.h create mode 100644 erts/emulator/beam/erl_db_util.c create mode 100644 erts/emulator/beam/erl_db_util.h create mode 100644 erts/emulator/beam/erl_debug.c create mode 100644 erts/emulator/beam/erl_debug.h create mode 100644 erts/emulator/beam/erl_driver.h create mode 100644 erts/emulator/beam/erl_drv_thread.c create mode 100644 erts/emulator/beam/erl_fun.c create mode 100644 erts/emulator/beam/erl_fun.h create mode 100644 erts/emulator/beam/erl_gc.c create mode 100644 erts/emulator/beam/erl_gc.h create mode 100644 erts/emulator/beam/erl_goodfit_alloc.c create mode 100644 erts/emulator/beam/erl_goodfit_alloc.h create mode 100644 erts/emulator/beam/erl_init.c create mode 100644 erts/emulator/beam/erl_instrument.c create mode 100644 erts/emulator/beam/erl_instrument.h create mode 100644 erts/emulator/beam/erl_lock_check.c create mode 100644 erts/emulator/beam/erl_lock_check.h create mode 100644 erts/emulator/beam/erl_lock_count.c create mode 100644 erts/emulator/beam/erl_lock_count.h create mode 100644 erts/emulator/beam/erl_math.c create mode 100644 erts/emulator/beam/erl_md5.c create mode 100644 erts/emulator/beam/erl_message.c create mode 100644 erts/emulator/beam/erl_message.h create mode 100644 erts/emulator/beam/erl_monitors.c create mode 100644 erts/emulator/beam/erl_monitors.h create mode 100644 erts/emulator/beam/erl_mtrace.c create mode 100644 erts/emulator/beam/erl_mtrace.h create mode 100644 erts/emulator/beam/erl_nif.c create mode 100644 erts/emulator/beam/erl_nif.h create mode 100644 erts/emulator/beam/erl_nif_api_funcs.h create mode 100644 erts/emulator/beam/erl_nmgc.c create mode 100644 erts/emulator/beam/erl_nmgc.h create mode 100644 erts/emulator/beam/erl_node_container_utils.h create mode 100644 erts/emulator/beam/erl_node_tables.c create mode 100644 erts/emulator/beam/erl_node_tables.h create mode 100644 erts/emulator/beam/erl_obsolete.c create mode 100644 erts/emulator/beam/erl_port_task.c create mode 100644 erts/emulator/beam/erl_port_task.h create mode 100644 erts/emulator/beam/erl_posix_str.c create mode 100644 erts/emulator/beam/erl_printf_term.c create mode 100644 erts/emulator/beam/erl_printf_term.h create mode 100644 erts/emulator/beam/erl_process.c create mode 100644 erts/emulator/beam/erl_process.h create mode 100644 erts/emulator/beam/erl_process_dict.c create mode 100644 erts/emulator/beam/erl_process_dict.h create mode 100644 erts/emulator/beam/erl_process_dump.c create mode 100644 erts/emulator/beam/erl_process_lock.c create mode 100644 erts/emulator/beam/erl_process_lock.h create mode 100644 erts/emulator/beam/erl_resolv_dns.c create mode 100644 erts/emulator/beam/erl_resolv_nodns.c create mode 100644 erts/emulator/beam/erl_smp.h create mode 100644 erts/emulator/beam/erl_sock.h create mode 100644 erts/emulator/beam/erl_sys_driver.h create mode 100644 erts/emulator/beam/erl_term.c create mode 100644 erts/emulator/beam/erl_term.h create mode 100644 erts/emulator/beam/erl_threads.h create mode 100644 erts/emulator/beam/erl_time.h create mode 100644 erts/emulator/beam/erl_time_sup.c create mode 100644 erts/emulator/beam/erl_trace.c create mode 100644 erts/emulator/beam/erl_unicode.c create mode 100644 erts/emulator/beam/erl_unicode.h create mode 100644 erts/emulator/beam/erl_vm.h create mode 100644 erts/emulator/beam/erl_zlib.c create mode 100644 erts/emulator/beam/erl_zlib.h create mode 100644 erts/emulator/beam/error.h create mode 100644 erts/emulator/beam/export.c create mode 100644 erts/emulator/beam/export.h create mode 100644 erts/emulator/beam/external.c create mode 100644 erts/emulator/beam/external.h create mode 100644 erts/emulator/beam/fix_alloc.c create mode 100644 erts/emulator/beam/global.h create mode 100644 erts/emulator/beam/hash.c create mode 100644 erts/emulator/beam/hash.h create mode 100644 erts/emulator/beam/index.c create mode 100644 erts/emulator/beam/index.h create mode 100644 erts/emulator/beam/io.c create mode 100644 erts/emulator/beam/module.c create mode 100644 erts/emulator/beam/module.h create mode 100644 erts/emulator/beam/ops.tab create mode 100644 erts/emulator/beam/packet_parser.c create mode 100644 erts/emulator/beam/packet_parser.h create mode 100644 erts/emulator/beam/register.c create mode 100644 erts/emulator/beam/register.h create mode 100644 erts/emulator/beam/safe_hash.c create mode 100644 erts/emulator/beam/safe_hash.h create mode 100644 erts/emulator/beam/sys.h create mode 100644 erts/emulator/beam/time.c create mode 100644 erts/emulator/beam/utils.c create mode 100644 erts/emulator/beam/version.h create mode 100644 erts/emulator/drivers/common/efile_drv.c create mode 100644 erts/emulator/drivers/common/erl_efile.h create mode 100644 erts/emulator/drivers/common/gzio.c create mode 100644 erts/emulator/drivers/common/gzio.h create mode 100644 erts/emulator/drivers/common/gzio_zutil.h create mode 100644 erts/emulator/drivers/common/inet_drv.c create mode 100644 erts/emulator/drivers/common/ram_file_drv.c create mode 100644 erts/emulator/drivers/common/zlib_drv.c create mode 100644 erts/emulator/drivers/unix/bin_drv.c create mode 100644 erts/emulator/drivers/unix/mem_drv.c create mode 100644 erts/emulator/drivers/unix/multi_drv.c create mode 100644 erts/emulator/drivers/unix/sig_drv.c create mode 100644 erts/emulator/drivers/unix/ttsl_drv.c create mode 100644 erts/emulator/drivers/unix/unix_efile.c create mode 100644 erts/emulator/drivers/vxworks/vxworks_resolv.c create mode 100644 erts/emulator/drivers/win32/mem_drv.c create mode 100644 erts/emulator/drivers/win32/registry_drv.c create mode 100644 erts/emulator/drivers/win32/ttsl_drv.c create mode 100644 erts/emulator/drivers/win32/win_con.c create mode 100644 erts/emulator/drivers/win32/win_con.h create mode 100644 erts/emulator/drivers/win32/win_efile.c create mode 100644 erts/emulator/drivers/win32/winsock_func.h create mode 100644 erts/emulator/hipe/TODO create mode 100644 erts/emulator/hipe/elf64ppc.x create mode 100644 erts/emulator/hipe/hipe_abi.txt create mode 100644 erts/emulator/hipe/hipe_amd64.c create mode 100644 erts/emulator/hipe/hipe_amd64.h create mode 100644 erts/emulator/hipe/hipe_amd64.tab create mode 100644 erts/emulator/hipe/hipe_amd64_abi.txt create mode 100644 erts/emulator/hipe/hipe_amd64_asm.m4 create mode 100644 erts/emulator/hipe/hipe_amd64_bifs.m4 create mode 100644 erts/emulator/hipe/hipe_amd64_gc.h create mode 100644 erts/emulator/hipe/hipe_amd64_glue.S create mode 100644 erts/emulator/hipe/hipe_amd64_glue.h create mode 100644 erts/emulator/hipe/hipe_amd64_primops.h create mode 100644 erts/emulator/hipe/hipe_arch.h create mode 100644 erts/emulator/hipe/hipe_arm.c create mode 100644 erts/emulator/hipe/hipe_arm.h create mode 100644 erts/emulator/hipe/hipe_arm.tab create mode 100644 erts/emulator/hipe/hipe_arm_abi.txt create mode 100644 erts/emulator/hipe/hipe_arm_asm.m4 create mode 100644 erts/emulator/hipe/hipe_arm_bifs.m4 create mode 100644 erts/emulator/hipe/hipe_arm_gc.h create mode 100644 erts/emulator/hipe/hipe_arm_glue.S create mode 100644 erts/emulator/hipe/hipe_arm_glue.h create mode 100644 erts/emulator/hipe/hipe_arm_primops.h create mode 100644 erts/emulator/hipe/hipe_bif0.c create mode 100644 erts/emulator/hipe/hipe_bif0.h create mode 100644 erts/emulator/hipe/hipe_bif0.tab create mode 100644 erts/emulator/hipe/hipe_bif1.c create mode 100644 erts/emulator/hipe/hipe_bif1.h create mode 100644 erts/emulator/hipe/hipe_bif1.tab create mode 100644 erts/emulator/hipe/hipe_bif2.c create mode 100644 erts/emulator/hipe/hipe_bif2.tab create mode 100644 erts/emulator/hipe/hipe_bif_list.m4 create mode 100644 erts/emulator/hipe/hipe_debug.c create mode 100644 erts/emulator/hipe/hipe_debug.h create mode 100644 erts/emulator/hipe/hipe_gbif_list.h create mode 100644 erts/emulator/hipe/hipe_gc.c create mode 100644 erts/emulator/hipe/hipe_gc.h create mode 100644 erts/emulator/hipe/hipe_mkliterals.c create mode 100644 erts/emulator/hipe/hipe_mode_switch.c create mode 100644 erts/emulator/hipe/hipe_mode_switch.h create mode 100644 erts/emulator/hipe/hipe_native_bif.c create mode 100644 erts/emulator/hipe/hipe_native_bif.h create mode 100644 erts/emulator/hipe/hipe_ops.tab create mode 100644 erts/emulator/hipe/hipe_perfctr.c create mode 100644 erts/emulator/hipe/hipe_perfctr.h create mode 100644 erts/emulator/hipe/hipe_perfctr.tab create mode 100644 erts/emulator/hipe/hipe_ppc.c create mode 100644 erts/emulator/hipe/hipe_ppc.h create mode 100644 erts/emulator/hipe/hipe_ppc.tab create mode 100644 erts/emulator/hipe/hipe_ppc64.tab create mode 100644 erts/emulator/hipe/hipe_ppc_abi.txt create mode 100644 erts/emulator/hipe/hipe_ppc_asm.m4 create mode 100644 erts/emulator/hipe/hipe_ppc_bifs.m4 create mode 100644 erts/emulator/hipe/hipe_ppc_gc.h create mode 100644 erts/emulator/hipe/hipe_ppc_glue.S create mode 100644 erts/emulator/hipe/hipe_ppc_glue.h create mode 100644 erts/emulator/hipe/hipe_ppc_primops.h create mode 100644 erts/emulator/hipe/hipe_primops.h create mode 100644 erts/emulator/hipe/hipe_process.h create mode 100644 erts/emulator/hipe/hipe_risc_gc.h create mode 100644 erts/emulator/hipe/hipe_risc_glue.h create mode 100644 erts/emulator/hipe/hipe_risc_stack.c create mode 100644 erts/emulator/hipe/hipe_signal.h create mode 100644 erts/emulator/hipe/hipe_sparc.c create mode 100644 erts/emulator/hipe/hipe_sparc.h create mode 100644 erts/emulator/hipe/hipe_sparc.tab create mode 100644 erts/emulator/hipe/hipe_sparc_abi.txt create mode 100644 erts/emulator/hipe/hipe_sparc_asm.m4 create mode 100644 erts/emulator/hipe/hipe_sparc_bifs.m4 create mode 100644 erts/emulator/hipe/hipe_sparc_gc.h create mode 100644 erts/emulator/hipe/hipe_sparc_glue.S create mode 100644 erts/emulator/hipe/hipe_sparc_glue.h create mode 100644 erts/emulator/hipe/hipe_sparc_primops.h create mode 100644 erts/emulator/hipe/hipe_stack.c create mode 100644 erts/emulator/hipe/hipe_stack.h create mode 100644 erts/emulator/hipe/hipe_x86.c create mode 100644 erts/emulator/hipe/hipe_x86.h create mode 100644 erts/emulator/hipe/hipe_x86.tab create mode 100644 erts/emulator/hipe/hipe_x86_abi.txt create mode 100644 erts/emulator/hipe/hipe_x86_asm.m4 create mode 100644 erts/emulator/hipe/hipe_x86_bifs.m4 create mode 100644 erts/emulator/hipe/hipe_x86_gc.h create mode 100644 erts/emulator/hipe/hipe_x86_glue.S create mode 100644 erts/emulator/hipe/hipe_x86_glue.h create mode 100644 erts/emulator/hipe/hipe_x86_primops.h create mode 100644 erts/emulator/hipe/hipe_x86_signal.c create mode 100644 erts/emulator/hipe/hipe_x86_stack.c create mode 100644 erts/emulator/internal_doc/erl_ext_dist.txt create mode 100644 erts/emulator/obsolete/driver.h create mode 100644 erts/emulator/pcre/Makefile create mode 100644 erts/emulator/pcre/Makefile.in create mode 100644 erts/emulator/pcre/local_config.h create mode 100644 erts/emulator/pcre/make_latin1_table.c create mode 100644 erts/emulator/pcre/pcre-7.6.tar.bz2 create mode 100644 erts/emulator/pcre/pcre.h create mode 100644 erts/emulator/pcre/pcre_chartables.c create mode 100644 erts/emulator/pcre/pcre_compile.c create mode 100644 erts/emulator/pcre/pcre_config.c create mode 100644 erts/emulator/pcre/pcre_dfa_exec.c create mode 100644 erts/emulator/pcre/pcre_exec.c create mode 100644 erts/emulator/pcre/pcre_fullinfo.c create mode 100644 erts/emulator/pcre/pcre_get.c create mode 100644 erts/emulator/pcre/pcre_globals.c create mode 100644 erts/emulator/pcre/pcre_info.c create mode 100644 erts/emulator/pcre/pcre_internal.h create mode 100644 erts/emulator/pcre/pcre_latin_1_table.c create mode 100644 erts/emulator/pcre/pcre_make_latin1_default.c create mode 100644 erts/emulator/pcre/pcre_maketables.c create mode 100644 erts/emulator/pcre/pcre_newline.c create mode 100644 erts/emulator/pcre/pcre_ord2utf8.c create mode 100644 erts/emulator/pcre/pcre_refcount.c create mode 100644 erts/emulator/pcre/pcre_study.c create mode 100644 erts/emulator/pcre/pcre_tables.c create mode 100644 erts/emulator/pcre/pcre_try_flipped.c create mode 100644 erts/emulator/pcre/pcre_ucp_searchfuncs.c create mode 100644 erts/emulator/pcre/pcre_valid_utf8.c create mode 100644 erts/emulator/pcre/pcre_version.c create mode 100644 erts/emulator/pcre/pcre_xclass.c create mode 100644 erts/emulator/pcre/ucp.h create mode 100644 erts/emulator/pcre/ucpinternal.h create mode 100644 erts/emulator/pcre/ucptable.h create mode 100644 erts/emulator/sys/common/erl_check_io.c create mode 100644 erts/emulator/sys/common/erl_check_io.h create mode 100644 erts/emulator/sys/common/erl_mseg.c create mode 100644 erts/emulator/sys/common/erl_mseg.h create mode 100644 erts/emulator/sys/common/erl_mtrace_sys_wrap.c create mode 100644 erts/emulator/sys/common/erl_poll.c create mode 100644 erts/emulator/sys/common/erl_poll.h create mode 100644 erts/emulator/sys/unix/driver_int.h create mode 100644 erts/emulator/sys/unix/erl9_start.c create mode 100644 erts/emulator/sys/unix/erl_child_setup.c create mode 100644 erts/emulator/sys/unix/erl_main.c create mode 100644 erts/emulator/sys/unix/erl_unix_sys.h create mode 100644 erts/emulator/sys/unix/erl_unix_sys_ddll.c create mode 100644 erts/emulator/sys/unix/sys.c create mode 100644 erts/emulator/sys/unix/sys_float.c create mode 100644 erts/emulator/sys/unix/sys_time.c create mode 100644 erts/emulator/sys/vxworks/driver_int.h create mode 100644 erts/emulator/sys/vxworks/erl_main.c create mode 100644 erts/emulator/sys/vxworks/erl_vxworks_sys.h create mode 100644 erts/emulator/sys/vxworks/erl_vxworks_sys_ddll.c create mode 100644 erts/emulator/sys/vxworks/sys.c create mode 100644 erts/emulator/sys/win32/dosmap.c create mode 100644 erts/emulator/sys/win32/driver_int.h create mode 100644 erts/emulator/sys/win32/erl.def create mode 100644 erts/emulator/sys/win32/erl_main.c create mode 100644 erts/emulator/sys/win32/erl_poll.c create mode 100644 erts/emulator/sys/win32/erl_win32_sys_ddll.c create mode 100644 erts/emulator/sys/win32/erl_win_dyn_driver.h create mode 100644 erts/emulator/sys/win32/erl_win_sys.h create mode 100644 erts/emulator/sys/win32/sys.c create mode 100644 erts/emulator/sys/win32/sys_env.c create mode 100644 erts/emulator/sys/win32/sys_float.c create mode 100644 erts/emulator/sys/win32/sys_interrupt.c create mode 100644 erts/emulator/sys/win32/sys_time.c create mode 100644 erts/emulator/test/Makefile create mode 100644 erts/emulator/test/a_SUITE.erl create mode 100644 erts/emulator/test/a_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/a_SUITE_data/timer_driver.c create mode 100644 erts/emulator/test/after_SUITE.erl create mode 100644 erts/emulator/test/alloc_SUITE.erl create mode 100644 erts/emulator/test/alloc_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/alloc_SUITE_data/allocator_test.h create mode 100644 erts/emulator/test/alloc_SUITE_data/basic.c create mode 100644 erts/emulator/test/alloc_SUITE_data/bucket_index.c create mode 100644 erts/emulator/test/alloc_SUITE_data/bucket_mask.c create mode 100644 erts/emulator/test/alloc_SUITE_data/coalesce.c create mode 100644 erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c create mode 100644 erts/emulator/test/alloc_SUITE_data/rbtree.c create mode 100644 erts/emulator/test/alloc_SUITE_data/realloc_copy.c create mode 100644 erts/emulator/test/alloc_SUITE_data/testcase_driver.c create mode 100644 erts/emulator/test/alloc_SUITE_data/testcase_driver.h create mode 100644 erts/emulator/test/alloc_SUITE_data/threads.c create mode 100644 erts/emulator/test/beam_SUITE.erl create mode 100644 erts/emulator/test/beam_literals_SUITE.erl create mode 100644 erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S create mode 100644 erts/emulator/test/bif_SUITE.erl create mode 100644 erts/emulator/test/big_SUITE.erl create mode 100644 erts/emulator/test/big_SUITE_data/borders.dat create mode 100644 erts/emulator/test/big_SUITE_data/eq_28.dat create mode 100644 erts/emulator/test/big_SUITE_data/eq_32.dat create mode 100644 erts/emulator/test/big_SUITE_data/eq_big.dat create mode 100644 erts/emulator/test/big_SUITE_data/eq_math.dat create mode 100644 erts/emulator/test/big_SUITE_data/literal_test.erl create mode 100644 erts/emulator/test/big_SUITE_data/negative.dat create mode 100644 erts/emulator/test/binary_SUITE.erl create mode 100644 erts/emulator/test/binary_SUITE_data/bad_binary create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.1197 create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.2224 create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.24619 create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.25681 create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.26563 create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.26744 create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.27459 create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.527 create mode 100644 erts/emulator/test/binary_SUITE_data/zzz.terms.8929 create mode 100644 erts/emulator/test/bs_bincomp_SUITE.erl create mode 100644 erts/emulator/test/bs_bit_binaries_SUITE.erl create mode 100644 erts/emulator/test/bs_construct_SUITE.erl create mode 100644 erts/emulator/test/bs_match_bin_SUITE.erl create mode 100644 erts/emulator/test/bs_match_int_SUITE.erl create mode 100644 erts/emulator/test/bs_match_misc_SUITE.erl create mode 100644 erts/emulator/test/bs_match_tail_SUITE.erl create mode 100644 erts/emulator/test/bs_utf_SUITE.erl create mode 100644 erts/emulator/test/busy_port_SUITE.erl create mode 100644 erts/emulator/test/busy_port_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/busy_port_SUITE_data/busy_drv.c create mode 100644 erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c create mode 100644 erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c create mode 100644 erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c create mode 100644 erts/emulator/test/call_trace_SUITE.erl create mode 100644 erts/emulator/test/code_SUITE.erl create mode 100644 erts/emulator/test/code_SUITE_data/another_code_test.erl create mode 100644 erts/emulator/test/code_SUITE_data/cpbugx.erl create mode 100644 erts/emulator/test/code_SUITE_data/literals.erl create mode 100644 erts/emulator/test/code_SUITE_data/many_funs.erl create mode 100644 erts/emulator/test/code_SUITE_data/my_code_test.erl create mode 100644 erts/emulator/test/crypto_SUITE.erl create mode 100644 erts/emulator/test/crypto_reference.erl create mode 100644 erts/emulator/test/ddll_SUITE.erl create mode 100644 erts/emulator/test/ddll_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/ddll_SUITE_data/dummy_drv.c create mode 100644 erts/emulator/test/ddll_SUITE_data/echo_drv.c create mode 100644 erts/emulator/test/ddll_SUITE_data/echo_drv_fail_init.c create mode 100644 erts/emulator/test/ddll_SUITE_data/initfail_drv.c create mode 100644 erts/emulator/test/ddll_SUITE_data/lock_drv.c create mode 100644 erts/emulator/test/ddll_SUITE_data/noinit_drv.c create mode 100644 erts/emulator/test/ddll_SUITE_data/wrongname_drv.c create mode 100644 erts/emulator/test/decode_packet_SUITE.erl create mode 100644 erts/emulator/test/dgawd_handler.erl create mode 100644 erts/emulator/test/dist_init_unix_SUITE_data/hosts.dn_sp create mode 100644 erts/emulator/test/dist_init_unix_SUITE_data/hosts.underscore create mode 100644 erts/emulator/test/dist_init_unix_SUITE_data/nsswitch.conf.dn_sp create mode 100644 erts/emulator/test/dist_init_unix_SUITE_data/resolv.conf.dn_sp create mode 100644 erts/emulator/test/distribution_SUITE.erl create mode 100644 erts/emulator/test/distribution_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/distribution_SUITE_data/run.erl create mode 100644 erts/emulator/test/driver_SUITE.erl create mode 100644 erts/emulator/test/driver_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/driver_SUITE_data/caller_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/chkio_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/many_events_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/missing_callback_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/monitor_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/otp_6879_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/outputv_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/queue_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/sys_info_1_0_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/sys_info_1_1_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c create mode 100644 erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h create mode 100644 erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/timer_drv.c create mode 100644 erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c create mode 100644 erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c create mode 100644 erts/emulator/test/efile_SUITE.erl create mode 100644 erts/emulator/test/efile_SUITE_data/existing_file create mode 100644 erts/emulator/test/emulator.spec create mode 100644 erts/emulator/test/emulator.spec.ose create mode 100644 erts/emulator/test/emulator.spec.vxworks create mode 100644 erts/emulator/test/emulator.spec.win create mode 100644 erts/emulator/test/erl_drv_thread_SUITE.erl create mode 100644 erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/erl_drv_thread_SUITE_data/basic.c create mode 100644 erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c create mode 100644 erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c create mode 100644 erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h create mode 100644 erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c create mode 100644 erts/emulator/test/erl_link_SUITE.erl create mode 100644 erts/emulator/test/erts_debug_SUITE.erl create mode 100644 erts/emulator/test/estone_SUITE.erl create mode 100644 erts/emulator/test/estone_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/estone_SUITE_data/estone_cat.c create mode 100755 erts/emulator/test/estone_SUITE_data/sunspeed.sh create mode 100644 erts/emulator/test/evil_SUITE.erl create mode 100644 erts/emulator/test/exception_SUITE.erl create mode 100644 erts/emulator/test/float_SUITE.erl create mode 100644 erts/emulator/test/float_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/float_SUITE_data/fp_drv.c create mode 100644 erts/emulator/test/float_SUITE_data/has_fpe_bug.erl create mode 100644 erts/emulator/test/fun_SUITE.erl create mode 100644 erts/emulator/test/fun_r11_SUITE.erl create mode 100644 erts/emulator/test/gc_SUITE.erl create mode 100644 erts/emulator/test/guard_SUITE.erl create mode 100644 erts/emulator/test/hash_SUITE.erl create mode 100644 erts/emulator/test/hibernate_SUITE.erl create mode 120000 erts/emulator/test/ignore_cores.erl create mode 100644 erts/emulator/test/list_bif_SUITE.erl create mode 100644 erts/emulator/test/long_timers_test.erl create mode 100644 erts/emulator/test/match_spec_SUITE.erl create mode 100644 erts/emulator/test/module_info_SUITE.erl create mode 100644 erts/emulator/test/monitor_SUITE.erl create mode 100644 erts/emulator/test/nested_SUITE.erl create mode 100644 erts/emulator/test/nif_SUITE.erl create mode 100644 erts/emulator/test/nif_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/nif_SUITE_data/nif_SUITE.1.c create mode 100644 erts/emulator/test/nif_SUITE_data/nif_SUITE.c create mode 100644 erts/emulator/test/nif_SUITE_data/nif_mod.1.c create mode 100644 erts/emulator/test/nif_SUITE_data/nif_mod.2.c create mode 100644 erts/emulator/test/nif_SUITE_data/nif_mod.3.c create mode 100644 erts/emulator/test/nif_SUITE_data/nif_mod.c create mode 100644 erts/emulator/test/nif_SUITE_data/nif_mod.erl create mode 100644 erts/emulator/test/nif_SUITE_data/nif_mod.h create mode 100644 erts/emulator/test/node_container_SUITE.erl create mode 100644 erts/emulator/test/nofrag_SUITE.erl create mode 100644 erts/emulator/test/num_bif_SUITE.erl create mode 100644 erts/emulator/test/obsolete_SUITE.erl create mode 100644 erts/emulator/test/obsolete_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/obsolete_SUITE_data/erl_threads.c create mode 100644 erts/emulator/test/obsolete_SUITE_data/testcase_driver.c create mode 100644 erts/emulator/test/obsolete_SUITE_data/testcase_driver.h create mode 100644 erts/emulator/test/old_mod.erl create mode 100644 erts/emulator/test/old_scheduler_SUITE.erl create mode 100644 erts/emulator/test/op_SUITE.erl create mode 100644 erts/emulator/test/port_SUITE.erl create mode 100644 erts/emulator/test/port_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/port_SUITE_data/dir/dummy create mode 100644 erts/emulator/test/port_SUITE_data/echo_args.c create mode 100644 erts/emulator/test/port_SUITE_data/echo_drv.c create mode 100644 erts/emulator/test/port_SUITE_data/exit_drv.c create mode 100644 erts/emulator/test/port_SUITE_data/failure_drv.c create mode 100644 erts/emulator/test/port_SUITE_data/port_test.c create mode 100644 erts/emulator/test/port_SUITE_data/port_test.erl create mode 100644 erts/emulator/test/port_SUITE_data/reclaim.h create mode 100644 erts/emulator/test/port_bif_SUITE.erl create mode 100644 erts/emulator/test/port_bif_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/port_bif_SUITE_data/control_drv.c create mode 100644 erts/emulator/test/port_bif_SUITE_data/port_test.c create mode 100644 erts/emulator/test/port_bif_SUITE_data/reclaim.h create mode 100644 erts/emulator/test/process_SUITE.erl create mode 100644 erts/emulator/test/pseudoknot_SUITE.erl create mode 100644 erts/emulator/test/random_iolist.erl create mode 100644 erts/emulator/test/ref_SUITE.erl create mode 100644 erts/emulator/test/register_SUITE.erl create mode 100644 erts/emulator/test/save_calls_SUITE.erl create mode 100644 erts/emulator/test/scheduler_SUITE.erl create mode 100644 erts/emulator/test/send_term_SUITE.erl create mode 100644 erts/emulator/test/send_term_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/send_term_SUITE_data/ext_terms.bin create mode 100644 erts/emulator/test/send_term_SUITE_data/ext_terms.h create mode 100644 erts/emulator/test/send_term_SUITE_data/send_term_drv.c create mode 100644 erts/emulator/test/sensitive_SUITE.erl create mode 100644 erts/emulator/test/signal_SUITE.erl create mode 100644 erts/emulator/test/statistics_SUITE.erl create mode 100644 erts/emulator/test/suite_release.exclude create mode 100644 erts/emulator/test/system_info_SUITE.erl create mode 100644 erts/emulator/test/system_profile_SUITE.erl create mode 100644 erts/emulator/test/system_profile_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/system_profile_SUITE_data/echo_drv.c create mode 100644 erts/emulator/test/time_SUITE.erl create mode 100644 erts/emulator/test/timer_bif_SUITE.erl create mode 100644 erts/emulator/test/trace_SUITE.erl create mode 100644 erts/emulator/test/trace_bif_SUITE.erl create mode 100644 erts/emulator/test/trace_call_count_SUITE.erl create mode 100644 erts/emulator/test/trace_local_SUITE.erl create mode 100644 erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl create mode 100644 erts/emulator/test/trace_meta_SUITE.erl create mode 100644 erts/emulator/test/trace_nif_SUITE.erl create mode 100644 erts/emulator/test/trace_nif_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/trace_nif_SUITE_data/trace_nif.c create mode 100644 erts/emulator/test/trace_port_SUITE.erl create mode 100644 erts/emulator/test/trace_port_SUITE_data/Makefile.src create mode 100644 erts/emulator/test/trace_port_SUITE_data/echo_drv.c create mode 100644 erts/emulator/test/tuple_SUITE.erl create mode 100644 erts/emulator/test/z_SUITE.erl create mode 100755 erts/emulator/utils/beam_makeops create mode 100755 erts/emulator/utils/beam_strip create mode 100755 erts/emulator/utils/make_alloc_types create mode 100755 erts/emulator/utils/make_driver_tab create mode 100755 erts/emulator/utils/make_preload create mode 100755 erts/emulator/utils/make_tables create mode 100755 erts/emulator/utils/make_version create mode 100644 erts/emulator/utils/mkver.c create mode 100644 erts/emulator/zlib/Makefile create mode 100644 erts/emulator/zlib/Makefile.in create mode 100644 erts/emulator/zlib/adler32.c create mode 100644 erts/emulator/zlib/compress.c create mode 100644 erts/emulator/zlib/crc32.c create mode 100644 erts/emulator/zlib/crc32.h create mode 100644 erts/emulator/zlib/deflate.c create mode 100644 erts/emulator/zlib/deflate.h create mode 100644 erts/emulator/zlib/example.c create mode 100644 erts/emulator/zlib/inffast.c create mode 100644 erts/emulator/zlib/inffast.h create mode 100644 erts/emulator/zlib/inffixed.h create mode 100644 erts/emulator/zlib/inflate.c create mode 100644 erts/emulator/zlib/inflate.h create mode 100644 erts/emulator/zlib/inftrees.c create mode 100644 erts/emulator/zlib/inftrees.h create mode 100644 erts/emulator/zlib/trees.c create mode 100644 erts/emulator/zlib/trees.h create mode 100644 erts/emulator/zlib/uncompr.c create mode 100644 erts/emulator/zlib/zconf.h create mode 100644 erts/emulator/zlib/zlib.h create mode 100644 erts/emulator/zlib/zutil.c create mode 100644 erts/emulator/zlib/zutil.h create mode 100644 erts/epmd/Makefile create mode 100644 erts/epmd/doc/.gitignore create mode 100644 erts/epmd/epmd.mk create mode 100644 erts/epmd/src/Makefile create mode 100644 erts/epmd/src/Makefile.in create mode 100644 erts/epmd/src/epmd.c create mode 100644 erts/epmd/src/epmd.h create mode 100644 erts/epmd/src/epmd_cli.c create mode 100644 erts/epmd/src/epmd_int.h create mode 100644 erts/epmd/src/epmd_srv.c create mode 100644 erts/epmd/test/Makefile create mode 100644 erts/epmd/test/epmd.spec create mode 100644 erts/epmd/test/epmd.spec.vxworks create mode 100644 erts/epmd/test/epmd_SUITE.erl create mode 100644 erts/etc/Makefile create mode 100644 erts/etc/common/Makefile create mode 100644 erts/etc/common/Makefile.in create mode 100644 erts/etc/common/dialyzer.c create mode 100644 erts/etc/common/erlc.c create mode 100644 erts/etc/common/erlexec.c create mode 100644 erts/etc/common/escript.c create mode 100644 erts/etc/common/heart.c create mode 100644 erts/etc/common/inet_gethost.c create mode 100644 erts/etc/common/typer.c create mode 100644 erts/etc/unix/Install.src create mode 100644 erts/etc/unix/README create mode 100644 erts/etc/unix/RELNOTES create mode 100644 erts/etc/unix/cerl.src create mode 100644 erts/etc/unix/dyn_erl.c create mode 100644 erts/etc/unix/erl.src.src create mode 100644 erts/etc/unix/etp-commands create mode 100644 erts/etc/unix/etp_commands.erl create mode 100644 erts/etc/unix/etp_commands.mk create mode 100644 erts/etc/unix/format_man_pages create mode 100644 erts/etc/unix/makewhatis create mode 100644 erts/etc/unix/run_erl.c create mode 100644 erts/etc/unix/run_erl.h create mode 100644 erts/etc/unix/safe_string.c create mode 100644 erts/etc/unix/safe_string.h create mode 100644 erts/etc/unix/setuid_socket_wrap.c create mode 100644 erts/etc/unix/start.src create mode 100644 erts/etc/unix/start_erl.src create mode 100644 erts/etc/unix/to_erl.c create mode 100644 erts/etc/vxworks/README.VxWorks create mode 100644 erts/etc/vxworks/erl.exec.c create mode 100644 erts/etc/vxworks/erl_io.c create mode 100644 erts/etc/vxworks/erl_script.sam.in create mode 100644 erts/etc/vxworks/heart_config.c create mode 100644 erts/etc/vxworks/heart_config.h create mode 100644 erts/etc/vxworks/rdate.c create mode 100644 erts/etc/vxworks/reclaim.c create mode 100644 erts/etc/vxworks/reclaim.h create mode 100644 erts/etc/vxworks/reclaim_private.h create mode 100644 erts/etc/vxworks/resolv.conf create mode 100644 erts/etc/vxworks/vxcall.c create mode 100644 erts/etc/vxworks/wd_example.c create mode 100644 erts/etc/win32/Install.c create mode 100644 erts/etc/win32/Install.src create mode 100644 erts/etc/win32/Makefile create mode 100644 erts/etc/win32/Nmakefile.start_erl create mode 100644 erts/etc/win32/beam.rc create mode 100644 erts/etc/win32/beam_icon.ico create mode 100755 erts/etc/win32/cygwin_tools/erl create mode 100755 erts/etc/win32/cygwin_tools/erlc create mode 100755 erts/etc/win32/cygwin_tools/javac.sh create mode 100755 erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh create mode 100755 erts/etc/win32/cygwin_tools/make_local_ini.sh create mode 100755 erts/etc/win32/cygwin_tools/mingw/ar.sh create mode 100755 erts/etc/win32/cygwin_tools/mingw/cc.sh create mode 100644 erts/etc/win32/cygwin_tools/mingw/coffix.c create mode 100755 erts/etc/win32/cygwin_tools/mingw/emu_cc.sh create mode 100755 erts/etc/win32/cygwin_tools/mingw/ld.sh create mode 100755 erts/etc/win32/cygwin_tools/mingw/mc.sh create mode 100755 erts/etc/win32/cygwin_tools/mingw/rc.sh create mode 100755 erts/etc/win32/cygwin_tools/vc/ar.sh create mode 100755 erts/etc/win32/cygwin_tools/vc/cc.sh create mode 100644 erts/etc/win32/cygwin_tools/vc/cc_wrap.c create mode 100644 erts/etc/win32/cygwin_tools/vc/coffix.c create mode 100755 erts/etc/win32/cygwin_tools/vc/emu_cc.sh create mode 100755 erts/etc/win32/cygwin_tools/vc/ld.sh create mode 100644 erts/etc/win32/cygwin_tools/vc/ld_wrap.c create mode 100755 erts/etc/win32/cygwin_tools/vc/mc.sh create mode 100755 erts/etc/win32/cygwin_tools/vc/rc.sh create mode 100644 erts/etc/win32/erl.c create mode 100644 erts/etc/win32/erl.rc create mode 100644 erts/etc/win32/erl_icon.ico create mode 100644 erts/etc/win32/erl_log.c create mode 100644 erts/etc/win32/erlang.ico create mode 100644 erts/etc/win32/erlsrv/erlsrv_global.h create mode 100644 erts/etc/win32/erlsrv/erlsrv_interactive.c create mode 100644 erts/etc/win32/erlsrv/erlsrv_interactive.h create mode 100644 erts/etc/win32/erlsrv/erlsrv_logmess.mc create mode 100644 erts/etc/win32/erlsrv/erlsrv_main.c create mode 100644 erts/etc/win32/erlsrv/erlsrv_registry.c create mode 100644 erts/etc/win32/erlsrv/erlsrv_registry.h create mode 100644 erts/etc/win32/erlsrv/erlsrv_service.c create mode 100644 erts/etc/win32/erlsrv/erlsrv_service.h create mode 100644 erts/etc/win32/erlsrv/erlsrv_util.c create mode 100644 erts/etc/win32/erlsrv/erlsrv_util.h create mode 100644 erts/etc/win32/hrl_icon.ico create mode 100644 erts/etc/win32/init_file.c create mode 100644 erts/etc/win32/init_file.h create mode 100644 erts/etc/win32/nsis/Makefile create mode 100755 erts/etc/win32/nsis/custom_modern.exe create mode 100755 erts/etc/win32/nsis/dll_version_helper.sh create mode 100644 erts/etc/win32/nsis/erlang.nsi create mode 100644 erts/etc/win32/nsis/erlang20.nsi create mode 100644 erts/etc/win32/nsis/erlang_inst.ico create mode 100755 erts/etc/win32/nsis/erlang_uninst.ico create mode 100755 erts/etc/win32/nsis/find_redist.sh create mode 100644 erts/etc/win32/port_entry.c create mode 100644 erts/etc/win32/resource.h create mode 100644 erts/etc/win32/start_erl.c create mode 100644 erts/etc/win32/toolbar.bmp create mode 100644 erts/etc/win32/win_erlexec.c create mode 100644 erts/example/Makefile create mode 100644 erts/example/next_perm.cc create mode 100644 erts/example/next_perm.erl create mode 100644 erts/example/pg_async.c create mode 100644 erts/example/pg_async.erl create mode 100644 erts/example/pg_async2.c create mode 100644 erts/example/pg_async2.erl create mode 100644 erts/example/pg_encode.c create mode 100644 erts/example/pg_encode.h create mode 100644 erts/example/pg_encode2.c create mode 100644 erts/example/pg_encode2.h create mode 100644 erts/example/pg_sync.c create mode 100644 erts/example/pg_sync.erl create mode 100644 erts/include/erl_fixed_size_int_types.h create mode 100644 erts/include/erl_int_sizes_config.h.in create mode 100644 erts/include/erl_memory_trace_parser.h create mode 100644 erts/include/internal/README create mode 100644 erts/include/internal/erl_errno.h create mode 100644 erts/include/internal/erl_memory_trace_protocol.h create mode 100644 erts/include/internal/erl_misc_utils.h create mode 100644 erts/include/internal/erl_printf.h create mode 100644 erts/include/internal/erl_printf_format.h create mode 100644 erts/include/internal/erts_internal.mk.in create mode 100644 erts/include/internal/ethread.h create mode 100644 erts/include/internal/ethread.mk.in create mode 100644 erts/include/internal/ethread_header_config.h.in create mode 100644 erts/include/internal/i386/atomic.h create mode 100644 erts/include/internal/i386/ethread.h create mode 100644 erts/include/internal/i386/rwlock.h create mode 100644 erts/include/internal/i386/spinlock.h create mode 100644 erts/include/internal/ppc32/atomic.h create mode 100644 erts/include/internal/ppc32/ethread.h create mode 100644 erts/include/internal/ppc32/rwlock.h create mode 100644 erts/include/internal/ppc32/spinlock.h create mode 100644 erts/include/internal/sparc32/atomic.h create mode 100644 erts/include/internal/sparc32/ethread.h create mode 100644 erts/include/internal/sparc32/rwlock.h create mode 100644 erts/include/internal/sparc32/spinlock.h create mode 100644 erts/include/internal/sparc64/ethread.h create mode 100644 erts/include/internal/tile/atomic.h create mode 100644 erts/include/internal/tile/ethread.h create mode 100644 erts/include/internal/x86_64/ethread.h create mode 100644 erts/info.src create mode 100644 erts/internal_doc/.gitignore create mode 100644 erts/lib/internal/README create mode 100644 erts/lib_src/Makefile create mode 100644 erts/lib_src/Makefile.in create mode 100644 erts/lib_src/common/erl_memory_trace_parser.c create mode 100644 erts/lib_src/common/erl_misc_utils.c create mode 100644 erts/lib_src/common/erl_printf.c create mode 100644 erts/lib_src/common/erl_printf_format.c create mode 100644 erts/lib_src/common/ethread.c create mode 100644 erts/man/.gitignore create mode 100644 erts/ntbuild.erl create mode 100644 erts/obj.debug/.gitignore create mode 100644 erts/obj/.gitignore create mode 100644 erts/prebuild.skip create mode 100644 erts/preloaded/Makefile create mode 100644 erts/preloaded/ebin/erl_prim_loader.beam create mode 100644 erts/preloaded/ebin/erlang.beam create mode 100644 erts/preloaded/ebin/init.beam create mode 100644 erts/preloaded/ebin/otp_ring0.beam create mode 100644 erts/preloaded/ebin/prim_file.beam create mode 100644 erts/preloaded/ebin/prim_inet.beam create mode 100644 erts/preloaded/ebin/prim_zip.beam create mode 100644 erts/preloaded/ebin/zlib.beam create mode 100644 erts/preloaded/src/Makefile create mode 100644 erts/preloaded/src/erl_prim_loader.erl create mode 100644 erts/preloaded/src/erlang.erl create mode 100644 erts/preloaded/src/init.erl create mode 100644 erts/preloaded/src/otp_ring0.erl create mode 100644 erts/preloaded/src/prim_file.erl create mode 100644 erts/preloaded/src/prim_inet.erl create mode 100644 erts/preloaded/src/prim_zip.erl create mode 100644 erts/preloaded/src/zip_internal.hrl create mode 100644 erts/preloaded/src/zlib.erl create mode 100644 erts/start_scripts/Makefile create mode 100644 erts/start_scripts/start_all_example.rel.src create mode 100644 erts/start_scripts/start_clean.rel.src create mode 100644 erts/start_scripts/start_sasl.rel.src create mode 100644 erts/test/Makefile create mode 100644 erts/test/erl_print_SUITE.erl create mode 100644 erts/test/erl_print_SUITE_data/Makefile.src create mode 100644 erts/test/erl_print_SUITE_data/character_test.h create mode 100644 erts/test/erl_print_SUITE_data/erl_print_tests.c create mode 100644 erts/test/erl_print_SUITE_data/integer_64_test.h create mode 100644 erts/test/erl_print_SUITE_data/integer_test.h create mode 100644 erts/test/erl_print_SUITE_data/snprintf_test.h create mode 100644 erts/test/erl_print_SUITE_data/string_test.h create mode 100644 erts/test/erlc_SUITE.erl create mode 100644 erts/test/erlc_SUITE_data/include/erl_test.hrl create mode 100644 erts/test/erlc_SUITE_data/src/BAD-MIB.mib create mode 100644 erts/test/erlc_SUITE_data/src/GOOD-MIB.mib create mode 100644 erts/test/erlc_SUITE_data/src/erl_test_bad.erl create mode 100644 erts/test/erlc_SUITE_data/src/erl_test_ok.erl create mode 100644 erts/test/erlc_SUITE_data/src/start_bad.script create mode 100644 erts/test/erlc_SUITE_data/src/start_ok.script create mode 100644 erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl create mode 100644 erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl create mode 100644 erts/test/erlexec_SUITE.erl create mode 100644 erts/test/erlexec_SUITE_data/Makefile.src create mode 100644 erts/test/erlexec_SUITE_data/erlexec_tests.c create mode 100644 erts/test/ethread_SUITE.erl create mode 100644 erts/test/ethread_SUITE_data/Makefile.src create mode 100644 erts/test/ethread_SUITE_data/ethread_tests.c create mode 100644 erts/test/ignore_cores.erl create mode 100644 erts/test/nt_SUITE.erl create mode 100644 erts/test/nt_SUITE_data/Makefile.src create mode 100644 erts/test/nt_SUITE_data/nt_info.c create mode 100644 erts/test/otp_SUITE.erl create mode 100644 erts/test/run_erl_SUITE.erl create mode 100644 erts/test/run_erl_SUITE_data/defuncter.pl create mode 100644 erts/test/run_erl_SUITE_data/run_erl_test.pl create mode 100644 erts/test/system.dynspec create mode 100644 erts/test/system.spec create mode 100644 erts/test/system.spec.vxworks create mode 100644 erts/test/utils/gccifier.c create mode 100644 erts/test/z_SUITE.erl create mode 100644 erts/vsn.mk (limited to 'erts') diff --git a/erts/AUTHORS b/erts/AUTHORS new file mode 100644 index 0000000000..dcf92c34da --- /dev/null +++ b/erts/AUTHORS @@ -0,0 +1,138 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 1999-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +-------------------------------------------------------------------------------- + +The original JAM emulator was first implemented by Mike Williams (the +instruction set was argued out with Joe Armstrong). + +The original BEAM emulator and loader were first implemented by Bogumil Hausman. +They were completely rewritten by Björn Gustavsson. + +Over the years the emulator has been basically completely rewritten by +a large number of individuals. Most(?) notably Claes Wikström, Tony +Rogvall, Björn Gustavsson, Patrik Nyblom, Rickard Green, Raimo Niskanen +and Arndt Jonasson. + +Marcus Arendt did the original port for Windows NT. Most of this code +was rewritten by Björn Gustavsson, Patrik Nyblom, Kenneth Lundin, +Fredrik Tillman and Mattias Nilsson. + +Per Hedeland did the original port for VxWorks. This port was +improved by Peter Högfeldt, Patrik Nyblom and Patrik Winroth. + +Mikael Pettersson, of the HiPE project, designed and implemented +the new 2-bit tag scheme. + +The SMP support has mainly been designed and implemented by Rickard Green, +Tony Rogvall (mostly ets), Mikael Pettersson (mostly optimized synchronization +primitives, and timer thread), and Patrik Nyblom (mostly dynamic drivers, and +Windows port). Also Björn Gustavsson and Raimo Niskanen have contributed. + +There are also a lot of people who have contributed smaller (and +bigger) things to the emulator and runtime system: Per Hedeland, +Peter Högfeldt, Kenneth Lundin, Fredrik Tillman, Mattias Nilsson, +Kent Boortz, Markus Torpvret, Jan-Erik Dahlin, Sebastian Strollo +and perhaps more... + +Björn Gustavsson (mostly matching) and Arndt Jonasson (mostly construction) +implemented the bit syntax instructions, borrowing some code from +the original prototype implementation by Tony Rogvall and Claes Wikström. + +The HiPE project (Kostis Sagonas, Mikael Petterson, Erik Johansson, +Richard Carlsson, Ulf Magnusson, Jesper Wilhelmsson) added the +hipe runtime to the Beam emulator. Björn Gustavsson helped to +integrate the hipe runtime. + +Rickard Green has designed and implemented the erts_alloc framework and +memory allocators. + +Per Gustafsson (and perhaps others in the HiPE group) come up with +idea for bit-level binaries and binary comprehensions. Per Gustafsson +and Björn Gustavsson implemented them in the BEAM compiler and run-time +system. Björn Gustavsson implemented the new optimizations for matching +and appending of binaries in BEAM compiler and run-time system, while +Per Gustafsson implemented the optimizations in the HiPE compiler and +HiPE run-time system. + +The big heap-fragment-elimination project has been going on for many +years and several releases, and was finally finished in R12B. Suggested +by the HiPE group in order to support constant pools and possible +future GC improvements, most of the work was carried out by +Björn Gustavsson, with help from Mikael Pettersson and the HiPE group. + + +Original Authors and Contributors: + +Mike Williams +Joe Armstrong +Bogumil Hausman +Björn Gustavsson +Claes Wikström +Tony Rogvall +Patrik Nyblom +Rickard Green +Raimo Niskanen +Arndt Jonasson +Marcus Arendt +Kenneth Lundin +Fredrik Tillman +Mattias Nilsson +Per Hedeland +Peter Högfeldt +Patrik Winroth +Mikael Pettersson +Kent Boortz +Markus Torpvret +Jan-Erik Dahlin +Sebastian Strollo +Kostis Sagonis +Erik Johansson +Richard Carlsson +Ulf Magnusson +Jesper Wilhelmsson +Jakob Cederlund +Magnus Fröberg +Per Gustafsson +Björn-Egil Dahlberg + +Open Source Contributors: + +Mick Dwyer +Geoff Wong +Maurice Castro +Luke Gorrie +Shawn Pearce +Ruslan Shevchenko +Tony Rogvall (at Bluetail): New faster inet_drv (R7) + HTTP packet mode (R8) +Sebastian Strollo (at Bluetail): poll() as alternative to select() +Mikael Pettersson (HiPE) + +Leonid Timochouk and +Serge Aleynikov + then (2006) at IDT Corp. + Wrote the original SCTP implementation, adapted by the OTP team; + in inet_drv.c in the emulator, as well as the parts in the + kernel application. They continue to provide patches. + +Mat Hostetter at Tilera Corporation: + Implemented ethr_atomic_cmpxchg() for all, at the time + of writing, supported platforms and improved the process lock + implementation by using ethr_atomic_cmpxchg() instead of + ethr_atomic_or_old() and ethr_atomic_and_old(). diff --git a/erts/Makefile.in b/erts/Makefile.in new file mode 100644 index 0000000000..fabf86db7c --- /dev/null +++ b/erts/Makefile.in @@ -0,0 +1,157 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk +include vsn.mk + +# ---------------------------------------------------------------------- + +# Other erts dirs than the emulator dir... +ERTSDIRS = doc/src etc epmd lib_src +XINSTDIRS = preloaded +ifeq ($(NO_START_SCRIPTS),) +ERTSDIRS += start_scripts +endif + +# Until hybrid is nofrag, don't build it. +#BUILD_HYBRID_EMU=@ERTS_BUILD_HYBRID_EMU@ +BUILD_HYBRID_EMU=no + +EXTRA_FLAVORS=smp +ifeq ($(BUILD_HYBRID_EMU),yes) +EXTRA_FLAVORS += hybrid +endif + +# +# Some byggy 'make's get confused when a directory is created and used +# for storing files which other files depend on during the same "make +# session". As a workaround we do a 'make generate' (which creates +# all directories) before doing 'make opt', etc... +# + +ifneq ($(BUILD_HYBRID_EMU),yes) +all: smp opt +else +all: hybrid smp opt +endif + +debug opt docs clean: + @ case $@ in \ + docs|clean) ;; \ + *) ( cd emulator && $(MAKE) generate TYPE=$@ FLAVOR=$(FLAVOR)) ;; \ + esac + @ ( cd emulator && $(MAKE) $@ FLAVOR=$(FLAVOR)) + @for d in $(ERTSDIRS); do \ + if test -d $$d; then \ + ( cd $$d && $(MAKE) $@ ) || exit $$? ; \ + fi ; \ + done + +# ---------------------------------------------------------------------- +# These are "convenience targets", provided as shortcuts for developers +# - don't use them in scripts or assume they will always stay like this! +# + +$(EXTRA_FLAVORS): + @ ( cd emulator \ + && $(MAKE) generate TYPE=opt FLAVOR=$@ \ + && $(MAKE) opt FLAVOR=$@ ) + +ifneq ($(BUILD_HYBRID_EMU),yes) +hybrid: + @echo '*** Omitted build of hybrid heap emulator' + @echo '*** since target is $(TARGET)' +endif + +# Make erl script and erlc in $(ERL_TOP)/bin which runs the compiled version +# Note that erlc is not a script and requires extra handling on cygwin. +# also note that this file is not created by autoconf, that's why @EXEEXT@ +# is not used. + +# The copying of beam.dll should be removed when the beam dll need no longer be +# in the same directory... +local_setup: + @cd start_scripts && $(MAKE) + @rm -f $(ERL_TOP)/bin/erl $(ERL_TOP)/bin/erlc $(ERL_TOP)/bin/cerl \ + $(ERL_TOP)/bin/erl.exe $(ERL_TOP)/bin/erlc.exe \ + $(ERL_TOP)/bin/escript $(ERL_TOP)/bin/escript.exe \ + $(ERL_TOP)/bin/dialyzer $(ERL_TOP)/bin/dialyzer.exe \ + $(ERL_TOP)/bin/typer $(ERL_TOP)/bin/typer.exe \ + $(ERL_TOP)/bin/start*.boot $(ERL_TOP)/bin/start*.script + @if [ "X$(TARGET)" = "Xwin32" ]; then \ + cp $(ERL_TOP)/bin/$(TARGET)/dialyzer.exe $(ERL_TOP)/bin/dialyzer.exe; \ + cp $(ERL_TOP)/bin/$(TARGET)/typer.exe $(ERL_TOP)/bin/typer.exe; \ + cp $(ERL_TOP)/bin/$(TARGET)/erlc.exe $(ERL_TOP)/bin/erlc.exe; \ + cp $(ERL_TOP)/bin/$(TARGET)/erl.exe $(ERL_TOP)/bin/erl.exe; \ + cp $(ERL_TOP)/bin/$(TARGET)/werl.exe $(ERL_TOP)/bin/werl.exe; \ + cp $(ERL_TOP)/bin/$(TARGET)/escript.exe $(ERL_TOP)/bin/escript.exe; \ + chmod 755 $(ERL_TOP)/bin/erl.exe $(ERL_TOP)/bin/erlc.exe \ + $(ERL_TOP)/bin/werl.exe; \ + $(ERL_TOP)/erts/etc/win32/cygwin_tools/make_local_ini.sh \ + $(ERL_TOP); \ + else \ + sed -e "s;%FINAL_ROOTDIR%;$(ERL_TOP);" \ + -e "s;erts-.*/bin;bin/$(TARGET);" \ + -e "s;EMU=.*;EMU=beam$(TYPEMARKER);" \ + $(ERL_TOP)/erts/etc/unix/erl.src.src > $(ERL_TOP)/bin/erl; \ + sed -e "s;%SRC_ROOTDIR%;$(ERL_TOP);" \ + -e "s;%TARGET%;$(TARGET);" \ + -e "s;%VSN%;$(VSN);" \ + $(ERL_TOP)/erts/etc/unix/cerl.src > $(ERL_TOP)/bin/cerl; \ + cp $(ERL_TOP)/bin/$(TARGET)/dialyzer $(ERL_TOP)/bin/dialyzer; \ + cp $(ERL_TOP)/bin/$(TARGET)/typer $(ERL_TOP)/bin/typer; \ + cp $(ERL_TOP)/bin/$(TARGET)/erlc $(ERL_TOP)/bin/erlc; \ + cp $(ERL_TOP)/bin/$(TARGET)/escript $(ERL_TOP)/bin/escript; \ + chmod 755 $(ERL_TOP)/bin/erl $(ERL_TOP)/bin/erlc \ + $(ERL_TOP)/bin/cerl; \ + fi + @cd start_scripts && $(MAKE) $(ERL_TOP)/bin/start.script \ + $(ERL_TOP)/bin/start_sasl.script \ + $(ERL_TOP)/bin/start_clean.script + +# Run the configure script +configure: + @set -e ; cd autoconf && $(MAKE) + +# Remake the makefiles, if you already have configured but you have edited +# a "Makefile.in". +makefiles: + @set -e ; cd autoconf && $(MAKE) $@ + +# ---------------------------------------------------------------------- +# Release targets +# + +release release_docs: +ifeq ($(BUILD_HYBRID_EMU),yes) + @if test $@ = release; then ( cd emulator && $(MAKE) $@ FLAVOR=hybrid) fi +else + @if test $@ = release; then ( $(MAKE) hybrid ) fi +endif + @if test $@ = release; then ( cd emulator && $(MAKE) $@ FLAVOR=smp) fi + @ (cd emulator && $(MAKE) $@ FLAVOR=plain) + @for d in $(ERTSDIRS) $(XINSTDIRS); do \ + if test -d $$d; then \ + ( cd $$d && $(MAKE) $@ ) || exit $$? ; \ + fi ; \ + done + +# ---------------------------------------------------------------------- + +.PHONY: debug opt docs clean local_setup configure release \ + release_docs run_test_cases hybrid smp diff --git a/erts/aclocal.m4 b/erts/aclocal.m4 new file mode 100644 index 0000000000..0ad963db12 --- /dev/null +++ b/erts/aclocal.m4 @@ -0,0 +1,938 @@ + +dnl %CopyrightBegin% +dnl +dnl Copyright Ericsson AB 1998-2009. All Rights Reserved. +dnl +dnl The contents of this file are subject to the Erlang Public License, +dnl Version 1.1, (the "License"); you may not use this file except in +dnl compliance with the License. You should have received a copy of the +dnl Erlang Public License along with this software. If not, it can be +dnl retrieved online at http://www.erlang.org/. +dnl +dnl Software distributed under the License is distributed on an "AS IS" +dnl basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +dnl the License for the specific language governing rights and limitations +dnl under the License. +dnl +dnl %CopyrightEnd% + +dnl +dnl aclocal.m4 +dnl +dnl Local macros used in configure.in. The Local Macros which +dnl could/should be part of autoconf are prefixed LM_, macros specific +dnl to the Erlang system are prefixed ERL_. +dnl + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_FIND_EMU_CC +dnl +dnl +dnl Tries fairly hard to find a C compiler that can handle jump tables. +dnl Defines the @EMU_CC@ variable for the makefiles and +dnl inserts NO_JUMP_TABLE in the header if one cannot be found... +dnl + +AC_DEFUN(LM_FIND_EMU_CC, + [AC_CACHE_CHECK(for a compiler that handles jumptables, + ac_cv_prog_emu_cc, + [ +AC_TRY_COMPILE([],[ + __label__ lbl1; + __label__ lbl2; + int x = magic(); + static void *jtab[2]; + + jtab[0] = &&lbl1; + jtab[1] = &&lbl2; + goto *jtab[x]; +lbl1: + return 1; +lbl2: + return 2; +],ac_cv_prog_emu_cc=$CC,ac_cv_prog_emu_cc=no) + +if test $ac_cv_prog_emu_cc = no; then + for ac_progname in emu_cc.sh gcc; do + IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":" + ac_dummy="$PATH" + for ac_dir in $ac_dummy; do + test -z "$ac_dir" && ac_dir=. + if test -f $ac_dir/$ac_progname; then + ac_cv_prog_emu_cc=$ac_dir/$ac_progname + break + fi + done + IFS="$ac_save_ifs" + if test $ac_cv_prog_emu_cc != no; then + break + fi + done +fi + +if test $ac_cv_prog_emu_cc != no; then + save_CC=$CC + save_CFLAGS=$CFLAGS + save_CPPFLAGS=$CPPFLAGS + CC=$ac_cv_prog_emu_cc + CFLAGS="" + CPPFLAGS="" + AC_TRY_COMPILE([],[ + __label__ lbl1; + __label__ lbl2; + int x = magic(); + static void *jtab[2]; + + jtab[0] = &&lbl1; + jtab[1] = &&lbl2; + goto *jtab[x]; + lbl1: + return 1; + lbl2: + return 2; + ],ac_cv_prog_emu_cc=$CC,ac_cv_prog_emu_cc=no) + CC=$save_CC + CFLAGS=$save_CFLAGS + CPPFLAGS=$save_CPPFLAGS +fi +]) +if test $ac_cv_prog_emu_cc = no; then + AC_DEFINE(NO_JUMP_TABLE,[],[Defined if no found C compiler can handle jump tables]) + EMU_CC=$CC +else + EMU_CC=$ac_cv_prog_emu_cc +fi +AC_SUBST(EMU_CC) +]) + + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_PROG_INSTALL_DIR +dnl +dnl Figure out how to create directories with parents. +dnl (In my opinion INSTALL_DIR is a bad name, MKSUBDIRS or something is better) +dnl +dnl We prefer 'install -d', but use 'mkdir -p' if it exists. +dnl If none of these methods works, we give up. + +AC_DEFUN(LM_PROG_INSTALL_DIR, +[AC_CACHE_CHECK(how to create a directory including parents, +ac_cv_prog_mkdir_p, +[ +temp_name_base=config.$$ +temp_name=$temp_name_base/x/y/z +$INSTALL -d $temp_name >/dev/null 2>&1 +ac_cv_prog_mkdir_p=none +if test -d $temp_name; then + ac_cv_prog_mkdir_p="$INSTALL -d" +else + mkdir -p $temp_name >/dev/null 2>&1 + if test -d $temp_name; then + ac_cv_prog_mkdir_p="mkdir -p" + fi +fi +rm -fr $temp_name_base +]) + +case "${ac_cv_prog_mkdir_p}" in + none) AC_MSG_ERROR(don't know how create directories with parents) ;; + *) INSTALL_DIR="$ac_cv_prog_mkdir_p" AC_SUBST(INSTALL_DIR) ;; +esac +]) + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_PROG_PERL5 +dnl +dnl Try to find perl version 5. If found set PERL to the absolute path +dnl of the program, if not found set PERL to false. +dnl +dnl On some systems /usr/bin/perl is perl 4 and e.g. +dnl /usr/local/bin/perl is perl 5. We try to handle this case by +dnl putting a couple of +dnl Tries to handle the case that there are two programs called perl +dnl in the path and one of them is perl 5 and the other isn't. +dnl +AC_DEFUN(LM_PROG_PERL5, +[AC_PATH_PROGS(PERL, perl5 perl, false, + /usr/local/bin:/opt/local/bin:/usr/local/gnu/bin:${PATH}) +changequote(, )dnl +dnl[ That bracket is needed to balance the right bracket below +if test "$PERL" = "false" || $PERL -e 'exit ($] >= 5)'; then +changequote([, ])dnl + ac_cv_path_PERL=false + PERL=false +dnl AC_MSG_WARN(perl version 5 not found) +fi +])dnl + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_DECL_SO_BSDCOMPAT +dnl +dnl Check if the system has the SO_BSDCOMPAT flag on sockets (linux) +dnl +AC_DEFUN(LM_DECL_SO_BSDCOMPAT, +[AC_CACHE_CHECK([for SO_BSDCOMPAT declaration], ac_cv_decl_so_bsdcompat, +AC_TRY_COMPILE([#include ], [int i = SO_BSDCOMPAT;], + ac_cv_decl_so_bsdcompat=yes, + ac_cv_decl_so_bsdcompat=no)) + +case "${ac_cv_decl_so_bsdcompat}" in + "yes" ) AC_DEFINE(HAVE_SO_BSDCOMPAT,[], + [Define if you have SO_BSDCOMPAT flag on sockets]) ;; + * ) ;; +esac +]) + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_DECL_INADDR_LOOPBACK +dnl +dnl Try to find declaration of INADDR_LOOPBACK, if nowhere provide a default +dnl + +AC_DEFUN(LM_DECL_INADDR_LOOPBACK, +[AC_CACHE_CHECK([for INADDR_LOOPBACK in netinet/in.h], + ac_cv_decl_inaddr_loopback, +[AC_TRY_COMPILE([#include +#include ], [int i = INADDR_LOOPBACK;], +ac_cv_decl_inaddr_loopback=yes, ac_cv_decl_inaddr_loopback=no) +]) + +if test ${ac_cv_decl_inaddr_loopback} = no; then + AC_CACHE_CHECK([for INADDR_LOOPBACK in rpc/types.h], + ac_cv_decl_inaddr_loopback_rpc, + AC_TRY_COMPILE([#include ], + [int i = INADDR_LOOPBACK;], + ac_cv_decl_inaddr_loopback_rpc=yes, + ac_cv_decl_inaddr_loopback_rpc=no)) + + case "${ac_cv_decl_inaddr_loopback_rpc}" in + "yes" ) + AC_DEFINE(DEF_INADDR_LOOPBACK_IN_RPC_TYPES_H,[], + [Define if you need to include rpc/types.h to get INADDR_LOOPBACK defined]) ;; + * ) + AC_CACHE_CHECK([for INADDR_LOOPBACK in winsock2.h], + ac_cv_decl_inaddr_loopback_winsock2, + AC_TRY_COMPILE([#define WIN32_LEAN_AND_MEAN + #include ], + [int i = INADDR_LOOPBACK;], + ac_cv_decl_inaddr_loopback_winsock2=yes, + ac_cv_decl_inaddr_loopback_winsock2=no)) + case "${ac_cv_decl_inaddr_loopback_winsock2}" in + "yes" ) + AC_DEFINE(DEF_INADDR_LOOPBACK_IN_WINSOCK2_H,[], + [Define if you need to include winsock2.h to get INADDR_LOOPBACK defined]) ;; + * ) + # couldn't find it anywhere + AC_DEFINE(HAVE_NO_INADDR_LOOPBACK,[], + [Define if you don't have a definition of INADDR_LOOPBACK]) ;; + esac;; + esac +fi +]) + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_STRUCT_SOCKADDR_SA_LEN +dnl +dnl Check if the sockaddr structure has the field sa_len +dnl + +AC_DEFUN(LM_STRUCT_SOCKADDR_SA_LEN, +[AC_CACHE_CHECK([whether struct sockaddr has sa_len field], + ac_cv_struct_sockaddr_sa_len, +AC_TRY_COMPILE([#include +#include ], [struct sockaddr s; s.sa_len = 10;], + ac_cv_struct_sockaddr_sa_len=yes, ac_cv_struct_sockaddr_sa_len=no)) + +dnl FIXME convbreak +case ${ac_cv_struct_sockaddr_sa_len} in + "no" ) AC_DEFINE(NO_SA_LEN,[1],[Define if you dont have salen]) ;; + *) ;; +esac +]) + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_STRUCT_EXCEPTION +dnl +dnl Check to see whether the system supports the matherr function +dnl and its associated type "struct exception". +dnl + +AC_DEFUN(LM_STRUCT_EXCEPTION, +[AC_CACHE_CHECK([for struct exception (and matherr function)], + ac_cv_struct_exception, +AC_TRY_COMPILE([#include ], + [struct exception x; x.type = DOMAIN; x.type = SING;], + ac_cv_struct_exception=yes, ac_cv_struct_exception=no)) + +case "${ac_cv_struct_exception}" in + "yes" ) AC_DEFINE(USE_MATHERR,[1],[Define if you have matherr() function and struct exception type]) ;; + * ) ;; +esac +]) + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_SYS_IPV6 +dnl +dnl Check for ipv6 support and what the in6_addr structure is called. +dnl (early linux used in_addr6 insted of in6_addr) +dnl + +AC_DEFUN(LM_SYS_IPV6, +[AC_MSG_CHECKING(for IP version 6 support) +AC_CACHE_VAL(ac_cv_sys_ipv6_support, +[ok_so_far=yes + AC_TRY_COMPILE([#include +#include ], + [struct in6_addr a6; struct sockaddr_in6 s6;], ok_so_far=yes, ok_so_far=no) + +if test $ok_so_far = yes; then + ac_cv_sys_ipv6_support=yes +else + AC_TRY_COMPILE([#include +#include ], + [struct in_addr6 a6; struct sockaddr_in6 s6;], + ac_cv_sys_ipv6_support=in_addr6, ac_cv_sys_ipv6_support=no) +fi +])dnl + +dnl +dnl Have to use old style AC_DEFINE due to BC with old autoconf. +dnl + +case ${ac_cv_sys_ipv6_support} in + yes) + AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_IN6,[1],[Define if ipv6 is present]) + ;; + in_addr6) + AC_MSG_RESULT([yes (but I am redefining in_addr6 to in6_addr)]) + AC_DEFINE(HAVE_IN6,[1],[Define if ipv6 is present]) + AC_DEFINE(HAVE_IN_ADDR6_STRUCT,[],[Early linux used in_addr6 instead of in6_addr, define if you have this]) + ;; + *) + AC_MSG_RESULT(no) + ;; +esac +]) + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_SYS_MULTICAST +dnl +dnl Check for multicast support. Only checks for multicast options in +dnl setsockopt(), no check is performed that multicasting actually works. +dnl If options are found defines HAVE_MULTICAST_SUPPORT +dnl + +AC_DEFUN(LM_SYS_MULTICAST, +[AC_CACHE_CHECK([for multicast support], ac_cv_sys_multicast_support, +[AC_EGREP_CPP(yes, +[#include +#include +#include +#if defined(IP_MULTICAST_TTL) && defined(IP_MULTICAST_LOOP) && defined(IP_MULTICAST_IF) && defined(IP_ADD_MEMBERSHIP) && defined(IP_DROP_MEMBERSHIP) +yes +#endif +], ac_cv_sys_multicast_support=yes, ac_cv_sys_multicast_support=no)]) +if test $ac_cv_sys_multicast_support = yes; then + AC_DEFINE(HAVE_MULTICAST_SUPPORT,[1], + [Define if setsockopt() accepts multicast options]) +fi +])dnl + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_DECL_SYS_ERRLIST +dnl +dnl Define SYS_ERRLIST_DECLARED if the variable sys_errlist is declared +dnl in a system header file, stdio.h or errno.h. +dnl + +AC_DEFUN(LM_DECL_SYS_ERRLIST, +[AC_CACHE_CHECK([for sys_errlist declaration in stdio.h or errno.h], + ac_cv_decl_sys_errlist, +[AC_TRY_COMPILE([#include +#include ], [char *msg = *(sys_errlist + 1);], + ac_cv_decl_sys_errlist=yes, ac_cv_decl_sys_errlist=no)]) +if test $ac_cv_decl_sys_errlist = yes; then + AC_DEFINE(SYS_ERRLIST_DECLARED,[], + [define if the variable sys_errlist is declared in a system header file]) +fi +]) + + +dnl ---------------------------------------------------------------------- +dnl +dnl LM_CHECK_FUNC_DECL( funname, declaration [, extra includes +dnl [, action-if-found [, action-if-not-found]]] ) +dnl +dnl Checks if the declaration "declaration" of "funname" conflicts +dnl with the header files idea of how the function should be +dnl declared. It is useful on systems which lack prototypes and you +dnl need to provide your own (e.g. when you want to take the address +dnl of a function). The 4'th argument is expanded if conflicting, +dnl the 5'th argument otherwise +dnl +dnl + +AC_DEFUN(LM_CHECK_FUNC_DECL, +[AC_MSG_CHECKING([for conflicting declaration of $1]) +AC_CACHE_VAL(ac_cv_func_decl_$1, +[AC_TRY_COMPILE([#include +$3],[$2 +char *c = (char *)$1; +], eval "ac_cv_func_decl_$1=no", eval "ac_cv_func_decl_$1=yes")]) +if eval "test \"`echo '$ac_cv_func_decl_'$1`\" = yes"; then + AC_MSG_RESULT(yes) + ifelse([$4], , :, [$4]) +else + AC_MSG_RESULT(no) +ifelse([$5], , , [$5 +])dnl +fi +]) + + +dnl ---------------------------------------------------------------------- +dnl +dnl ERL_FIND_ETHR_LIB +dnl +dnl Find a thread library to use. Sets ETHR_LIBS to libraries to link +dnl with, ETHR_X_LIBS to extra libraries to link with (same as ETHR_LIBS +dnl except that the ethread lib itself is not included), ETHR_DEFS to +dnl defines to compile with, ETHR_THR_LIB_BASE to the name of the +dnl thread library which the ethread library is based on, and ETHR_LIB_NAME +dnl to the name of the library where the ethread implementation is located. +dnl ERL_FIND_ETHR_LIB currently searches for 'pthreads', and +dnl 'win32_threads'. If no thread library was found ETHR_LIBS, ETHR_X_LIBS, +dnl ETHR_DEFS, ETHR_THR_LIB_BASE, and ETHR_LIB_NAME are all set to the +dnl empty string. +dnl + +AC_DEFUN(ERL_FIND_ETHR_LIB, +[ + +ethr_modified_default_stack_size= + +dnl Name of lib where ethread implementation is located +ethr_lib_name=ethread + +ETHR_THR_LIB_BASE= +ETHR_THR_LIB_BASE_NAME= +ETHR_X_LIBS= +ETHR_LIBS= +ETHR_LIB_NAME= +ETHR_DEFS= + +dnl if test "x$host_os" = "x"; then +dnl AC_CANONICAL_HOST +dnl fi + +dnl win32? +AC_MSG_CHECKING([for native win32 threads]) +if test "X$host_os" = "Xwin32"; then + AC_MSG_RESULT(yes) + # * _WIN32_WINNT >= 0x0400 is needed for + # TryEnterCriticalSection + # * _WIN32_WINNT >= 0x0403 is needed for + # InitializeCriticalSectionAndSpinCount + # The ethread lib will refuse to build if _WIN32_WINNT < 0x0403. + # + # -D_WIN32_WINNT should have been defined in $CPPFLAGS; fetch it + # and save it in ETHR_DEFS. + found_win32_winnt=no + for cppflag in $CPPFLAGS; do + case $cppflag in + -DWINVER*) + ETHR_DEFS="$ETHR_DEFS $cppflag" + ;; + -D_WIN32_WINNT*) + ETHR_DEFS="$ETHR_DEFS $cppflag" + found_win32_winnt=yes + ;; + *) + ;; + esac + done + if test $found_win32_winnt = no; then + AC_MSG_ERROR([-D_WIN32_WINNT missing in CPPFLAGS]) + fi + ETHR_X_LIBS= + ETHR_THR_LIB_BASE=win32_threads + AC_DEFINE(ETHR_WIN32_THREADS, 1, [Define if you have win32 threads]) +else + AC_MSG_RESULT(no) + +dnl Try to find POSIX threads + +dnl The usual pthread lib... + AC_CHECK_LIB(pthread, pthread_create, ETHR_X_LIBS="-lpthread") + +dnl FreeBSD has pthreads in special c library, c_r... + if test "x$ETHR_X_LIBS" = "x"; then + AC_CHECK_LIB(c_r, pthread_create, ETHR_X_LIBS="-lc_r") + fi + +dnl On ofs1 the '-pthread' switch should be used + if test "x$ETHR_X_LIBS" = "x"; then + AC_MSG_CHECKING([if the '-pthread' switch can be used]) + saved_cflags=$CFLAGS + CFLAGS="$CFLAGS -pthread" + AC_TRY_LINK([#include ], + pthread_create((void*)0,(void*)0,(void*)0,(void*)0);, + [ETHR_DEFS="-pthread" + ETHR_X_LIBS="-pthread"]) + CFLAGS=$saved_cflags + if test "x$ETHR_X_LIBS" != "x"; then + AC_MSG_RESULT(yes) + else + AC_MSG_RESULT(no) + fi + fi + + if test "x$ETHR_X_LIBS" != "x"; then + ETHR_DEFS="$ETHR_DEFS -D_THREAD_SAFE -D_REENTRANT" + ETHR_THR_LIB_BASE=pthread + AC_DEFINE(ETHR_PTHREADS, 1, [Define if you have pthreads]) + case $host_os in + openbsd*) + # The default stack size is insufficient for our needs + # on OpenBSD. We increase it to 256 kilo words. + ethr_modified_default_stack_size=256;; + solaris*) + ETHR_DEFS="$ETHR_DEFS -D_POSIX_PTHREAD_SEMANTICS" ;; + linux*) + ETHR_DEFS="$ETHR_DEFS -D_POSIX_THREAD_SAFE_FUNCTIONS -D_GNU_SOURCE" + if test "x$erl_xcomp_linux_kernel" != "x"; then + linux_kernel_vsn_=$erl_xcomp_linux_kernel + else + linux_kernel_vsn_=`uname -r` + fi + usable_sigusrx=no + usable_sigaltstack=no + + # FIXME: Test for actual problems instead of kernel versions. + case $linux_kernel_vsn_ in + [[0-1]].*|2.[[0-1]]|2.[[0-1]].*) + ;; + 2.[[2-3]]|2.[[2-3]].*) + usable_sigusrx=yes + ;; + *) + usable_sigusrx=yes + usable_sigaltstack=yes + ;; + esac + + AC_MSG_CHECKING(if SIGUSR1 and SIGUSR2 can be used) + AC_MSG_RESULT($usable_sigusrx) + if test $usable_sigusrx = no; then + ETHR_DEFS="$ETHR_DEFS -DETHR_UNUSABLE_SIGUSRX" + fi + + AC_MSG_CHECKING(if sigaltstack can be used) + AC_MSG_RESULT($usable_sigaltstack) + if test $usable_sigaltstack = no; then + ETHR_DEFS="$ETHR_DEFS -DETHR_UNUSABLE_SIGALTSTACK" + fi + + AC_MSG_CHECKING(for Native POSIX Thread Library) + case `getconf GNU_LIBPTHREAD_VERSION 2>/dev/null` in + nptl*) nptl=yes;; + NPTL*) nptl=yes;; + *) nptl=no;; + esac + AC_MSG_RESULT($nptl) + if test $nptl = yes; then + ETHR_THR_LIB_BASE_NAME=nptl + fi + if test $nptl = yes; then + need_nptl_incldir=no + AC_CHECK_HEADER(nptl/pthread.h, need_nptl_incldir=yes) + if test $need_nptl_incldir = yes; then + # Ahh... + nptl_path="$C_INCLUDE_PATH:$CPATH:/usr/local/include:/usr/include" + nptl_ws_path= + save_ifs="$IFS"; IFS=":" + for dir in $nptl_path; do + if test "x$dir" != "x"; then + nptl_ws_path="$nptl_ws_path $dir" + fi + done + IFS=$save_ifs + nptl_incldir= + for dir in $nptl_ws_path; do + AC_CHECK_HEADER($dir/nptl/pthread.h, + nptl_incldir=$dir/nptl) + if test "x$nptl_incldir" != "x"; then + ETHR_DEFS="$ETHR_DEFS -isystem $nptl_incldir" + break + fi + done + if test "x$nptl_incldir" = "x"; then + AC_MSG_ERROR(Failed to locate nptl system include directory) + fi + fi + fi + + AC_DEFINE(ETHR_INIT_MUTEX_IN_CHILD_AT_FORK, 1, \ +[Define if mutexes should be reinitialized (instead of unlocked) in child at fork.]) ;; + *) ;; + esac + + dnl We sometimes need ETHR_DEFS in order to find certain headers + dnl (at least for pthread.h on osf1). + saved_cppflags=$CPPFLAGS + CPPFLAGS="$CPPFLAGS $ETHR_DEFS" + + dnl We need the thread library in order to find some functions + saved_libs=$LIBS + LIBS="$LIBS $ETHR_X_LIBS" + + + + dnl + dnl Check for headers + dnl + + AC_CHECK_HEADER(pthread.h, + AC_DEFINE(ETHR_HAVE_PTHREAD_H, 1, \ +[Define if you have the header file.])) + + dnl Some Linuxes have instead of + AC_CHECK_HEADER(pthread/mit/pthread.h, \ + AC_DEFINE(ETHR_HAVE_MIT_PTHREAD_H, 1, \ +[Define if the pthread.h header file is in pthread/mit directory.])) + + AC_CHECK_HEADER(sys/time.h, \ + AC_DEFINE(ETHR_HAVE_SYS_TIME_H, 1, \ +[Define if you have the header file.])) + + AC_TRY_COMPILE([#include + #include ], + [struct timeval *tv; return 0;], + AC_DEFINE(ETHR_TIME_WITH_SYS_TIME, 1, \ +[Define if you can safely include both and .])) + + + dnl + dnl Check for functions + dnl + + AC_CHECK_FUNC(pthread_atfork, \ + AC_DEFINE(ETHR_HAVE_PTHREAD_ATFORK, 1, \ +[Define if you have the pthread_atfork function.])) + AC_CHECK_FUNC(pthread_mutexattr_settype, \ + AC_DEFINE(ETHR_HAVE_PTHREAD_MUTEXATTR_SETTYPE, 1, \ +[Define if you have the pthread_mutexattr_settype function.])) + AC_CHECK_FUNC(pthread_mutexattr_setkind_np, \ + AC_DEFINE(ETHR_HAVE_PTHREAD_MUTEXATTR_SETKIND_NP, 1, \ +[Define if you have the pthread_mutexattr_setkind_np function.])) + AC_CHECK_FUNC(pthread_spin_lock, \ + AC_DEFINE(ETHR_HAVE_PTHREAD_SPIN_LOCK, 1, \ +[Define if you have the pthread_spin_lock function.])) + case $host_os in + linux*) # Writers may get starved + # TODO: write a test that tests the implementation + ;; + *) + AC_CHECK_FUNC(pthread_rwlock_init, \ + AC_DEFINE(ETHR_HAVE_PTHREAD_RWLOCK_INIT, 1, \ +[Define if you have a pthread_rwlock implementation that can be used.])) + ;; + esac + AC_CHECK_FUNC(pthread_attr_setguardsize, \ + AC_DEFINE(ETHR_HAVE_PTHREAD_ATTR_SETGUARDSIZE, 1, \ +[Define if you have the pthread_attr_setguardsize function.])) + + dnl Restore LIBS + LIBS=$saved_libs + dnl restore CPPFLAGS + CPPFLAGS=$saved_cppflags + + fi +fi + +AC_MSG_CHECKING([whether default stack size should be modified]) +if test "x$ethr_modified_default_stack_size" != "x"; then + AC_DEFINE_UNQUOTED(ETHR_MODIFIED_DEFAULT_STACK_SIZE, $ethr_modified_default_stack_size, [Define if you want to modify the default stack size]) + AC_MSG_RESULT([yes; to $ethr_modified_default_stack_size kilo words]) +else + AC_MSG_RESULT([no]) +fi + +if test "x$ETHR_THR_LIB_BASE" != "x"; then + ETHR_DEFS="-DUSE_THREADS $ETHR_DEFS" + ETHR_LIBS="-l$ethr_lib_name $ETHR_X_LIBS" + ETHR_LIB_NAME=$ethr_lib_name +fi + +AC_CHECK_SIZEOF(void *, 4) +AC_DEFINE_UNQUOTED(ETHR_SIZEOF_PTR, $ac_cv_sizeof_void_p, [Define to the size of pointers]) + +if test "X$disable_native_ethr_impls" = "Xyes"; then + AC_DEFINE(ETHR_DISABLE_NATIVE_IMPLS, 1, [Define if you want to disable native ethread implementations]) +fi + +AC_DEFINE(ETHR_HAVE_ETHREAD_DEFINES, 1, \ +[Define if you have all ethread defines]) + +AC_SUBST(ETHR_X_LIBS) +AC_SUBST(ETHR_LIBS) +AC_SUBST(ETHR_LIB_NAME) +AC_SUBST(ETHR_DEFS) +AC_SUBST(ETHR_THR_LIB_BASE) +AC_SUBST(ETHR_THR_LIB_BASE_NAME) + +]) + + + +dnl ---------------------------------------------------------------------- +dnl +dnl ERL_TIME_CORRECTION +dnl +dnl In the presence of a high resolution realtime timer Erlang can adapt +dnl its view of time relative to this timer. On solaris such a timer is +dnl available with the syscall gethrtime(). On other OS's a fallback +dnl solution using times() is implemented. (However on e.g. FreeBSD times() +dnl is implemented using gettimeofday so it doesn't make much sense to +dnl use it there...) On second thought, it seems to be safer to do it the +dnl other way around. I.e. only use times() on OS's where we know it will +dnl work... +dnl + +AC_DEFUN(ERL_TIME_CORRECTION, +[if test x$ac_cv_func_gethrtime = x; then + AC_CHECK_FUNC(gethrtime) +fi +if test x$clock_gettime_correction = xunknown; then + AC_TRY_COMPILE([#include ], + [struct timespec ts; + long long result; + clock_gettime(CLOCK_MONOTONIC,&ts); + result = ((long long) ts.tv_sec) * 1000000000LL + + ((long long) ts.tv_nsec);], + clock_gettime_compiles=yes, + clock_gettime_compiles=no) +else + clock_gettime_compiles=no +fi + + +AC_CACHE_CHECK([how to correct for time adjustments], erl_cv_time_correction, +[ +case $clock_gettime_correction in + yes) + erl_cv_time_correction=clock_gettime;; + no|unknown) + case $ac_cv_func_gethrtime in + yes) + erl_cv_time_correction=hrtime ;; + no) + case $host_os in + linux*) + case $clock_gettime_correction in + unknown) + if test x$clock_gettime_compiles = xyes; then + linux_kernel_vsn_=`uname -r` + case $linux_kernel_vsn_ in + [[0-1]].*|2.[[0-5]]|2.[[0-5]].*) + erl_cv_time_correction=times ;; + *) + erl_cv_time_correction=clock_gettime;; + esac + else + erl_cv_time_correction=times + fi + ;; + *) + erl_cv_time_correction=times ;; + esac + ;; + *) + erl_cv_time_correction=none ;; + esac + ;; + esac + ;; +esac +]) +xrtlib="" +case $erl_cv_time_correction in + times) + AC_DEFINE(CORRECT_USING_TIMES,[], + [Define if you do not have a high-res. timer & want to use times() instead]) + ;; + clock_gettime) + xrtlib="-lrt" + AC_DEFINE(GETHRTIME_WITH_CLOCK_GETTIME,[1], + [Define if you want to use clock_gettime to simulate gethrtime]) + ;; +esac +dnl +dnl Check if gethrvtime is working, and if to use procfs ioctl +dnl or (yet to be written) write to the procfs ctl file. +dnl + +AC_MSG_CHECKING([if gethrvtime works and how to use it]) +AC_TRY_RUN([ +/* gethrvtime procfs ioctl test */ +/* These need to be undef:ed to not break activation of + * micro level process accounting on /proc/self + */ +#ifdef _LARGEFILE_SOURCE +# undef _LARGEFILE_SOURCE +#endif +#ifdef _FILE_OFFSET_BITS +# undef _FILE_OFFSET_BITS +#endif +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +int main() { + long msacct = PR_MSACCT; + int fd; + long long start, stop; + int i; + pid_t pid = getpid(); + char proc_self[30] = "/proc/"; + + sprintf(proc_self+strlen(proc_self), "%lu", (unsigned long) pid); + if ( (fd = open(proc_self, O_WRONLY)) == -1) + exit(1); + if (ioctl(fd, PIOCSET, &msacct) < 0) + exit(2); + if (close(fd) < 0) + exit(3); + start = gethrvtime(); + for (i = 0; i < 100; i++) + stop = gethrvtime(); + if (start == 0) + exit(4); + if (start == stop) + exit(5); + exit(0); return 0; +} +], erl_gethrvtime=procfs_ioctl, erl_gethrvtime=false, erl_gethrvtime=false) +case $erl_gethrvtime in + procfs_ioctl) + AC_DEFINE(HAVE_GETHRVTIME_PROCFS_IOCTL,[1], + [define if gethrvtime() works and uses ioctl() to /proc/self]) + AC_MSG_RESULT(uses ioctl to procfs) + ;; + *) + AC_MSG_RESULT(not working) + + dnl + dnl Check if clock_gettime (linux) is working + dnl + + AC_MSG_CHECKING([if clock_gettime can be used to get process CPU time]) + save_libs=$LIBS + LIBS="-lrt" + AC_TRY_RUN([ + #include + #include + #include + #include + #include + int main() { + long long start, stop; + int i; + struct timespec tp; + + if (clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &tp) < 0) + exit(1); + start = ((long long)tp.tv_sec * 1000000000LL) + (long long)tp.tv_nsec; + for (i = 0; i < 100; i++) + clock_gettime(CLOCK_PROCESS_CPUTIME_ID, &tp); + stop = ((long long)tp.tv_sec * 1000000000LL) + (long long)tp.tv_nsec; + if (start == 0) + exit(4); + if (start == stop) + exit(5); + exit(0); return 0; + } + ], erl_clock_gettime=true, erl_clock_gettime=false, erl_clock_gettime=false) + LIBS=$save_libs + case $host_os in + linux*) + AC_MSG_RESULT([not stable, disabled]) + LIBRT=$xrtlib + ;; + *) + case $erl_clock_gettime in + true) + AC_DEFINE(HAVE_CLOCK_GETTIME,[], + [define if clock_gettime() works for getting process time]) + AC_MSG_RESULT(using clock_gettime) + LIBRT=-lrt + ;; + *) + AC_MSG_RESULT(not working) + LIBRT=$xrtlib + ;; + esac + ;; + esac + AC_SUBST(LIBRT) + ;; +esac +])dnl + +dnl ERL_TRY_LINK_JAVA(CLASSES, FUNCTION-BODY +dnl [ACTION_IF_FOUND [, ACTION-IF-NOT-FOUND]]) +dnl Freely inspired by AC_TRY_LINK. (Maybe better to create a +dnl AC_LANG_JAVA instead...) +AC_DEFUN(ERL_TRY_LINK_JAVA, +[java_link='$JAVAC conftest.java 1>&AC_FD_CC' +changequote(«, »)dnl +cat > conftest.java <&AC_FD_CC + cat conftest.java 1>&AC_FD_CC + echo "configure: PATH was $PATH" 1>&AC_FD_CC +ifelse([$4], , , [ rm -rf conftest* + $4 +])dnl +fi +rm -f conftest*]) +#define UNSAFE_MASK 0xc0000000 /* Mask for bits that must be constant */ + + diff --git a/erts/autoconf/config.guess b/erts/autoconf/config.guess new file mode 100755 index 0000000000..38a833903b --- /dev/null +++ b/erts/autoconf/config.guess @@ -0,0 +1,1519 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, +# Inc. + +timestamp='2007-05-17' + +# This file 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +# 02110-1301, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + + +# Originally written by Per Bothner . +# Please send patches to . Submit a context +# diff and a properly formatted ChangeLog entry. +# +# This script attempts to guess a canonical system name similar to +# config.sub. If it succeeds, it prints the system name on stdout, and +# exits with 0. Otherwise, it exits with 1. +# +# The plan is that this can be called by configure scripts if you +# don't specify an explicit build system type. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +trap 'exit 1' 1 2 15 + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +set_cc_for_build=' +trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; +trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; +: ${TMPDIR=/tmp} ; + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; +dummy=$tmp/dummy ; +tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; +case $CC_FOR_BUILD,$HOST_CC,$CC in + ,,) echo "int x;" > $dummy.c ; + for c in cc gcc c89 c99 ; do + if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then + CC_FOR_BUILD="$c"; break ; + fi ; + done ; + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found ; + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; +esac ; set_cc_for_build= ;' + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if (test -f /.attbin/uname) >/dev/null 2>&1 ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown +UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + +# Note: order is significant - the case branches are not exclusive. + +case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tupples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" + UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ + /usr/sbin/$sysctl 2>/dev/null || echo unknown)` + case "${UNAME_MACHINE_ARCH}" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently, or will in the future. + case "${UNAME_MACHINE_ARCH}" in + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep __ELF__ >/dev/null + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "${UNAME_VERSION}" in + Debian*) + release='-gnu' + ;; + *) + release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" + exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} + exit ;; + *:ekkoBSD:*:*) + echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} + exit ;; + *:SolidBSD:*:*) + echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} + exit ;; + macppc:MirBSD:*:*) + echo powerpc-unknown-mirbsd${UNAME_RELEASE} + exit ;; + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} + exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` + ;; + *5.*) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE="alpha" ;; + "EV4.5 (21064)") + UNAME_MACHINE="alpha" ;; + "LCA4 (21066/21068)") + UNAME_MACHINE="alpha" ;; + "EV5 (21164)") + UNAME_MACHINE="alphaev5" ;; + "EV5.6 (21164A)") + UNAME_MACHINE="alphaev56" ;; + "EV5.6 (21164PC)") + UNAME_MACHINE="alphapca56" ;; + "EV5.7 (21164PC)") + UNAME_MACHINE="alphapca57" ;; + "EV6 (21264)") + UNAME_MACHINE="alphaev6" ;; + "EV6.7 (21264A)") + UNAME_MACHINE="alphaev67" ;; + "EV6.8CB (21264C)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8AL (21264B)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8CX (21264D)") + UNAME_MACHINE="alphaev68" ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE="alphaev69" ;; + "EV7 (21364)") + UNAME_MACHINE="alphaev7" ;; + "EV7.9 (21364A)") + UNAME_MACHINE="alphaev79" ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + exit ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix + exit ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 + exit ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-amigaos + exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-morphos + exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 + exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} + exit ;; + arm:riscos:*:*|arm:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in + sparc) echo sparc-icl-nx7; exit ;; + esac ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + i86pc:SunOS:5.*:* | ix86xen:SunOS:5.*:*) + echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) + UNAME_RELEASE=`uname -v` + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` + exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos${UNAME_RELEASE} + exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 + case "`/bin/arch`" in + sun3) + echo m68k-sun-sunos${UNAME_RELEASE} + ;; + sun4) + echo sparc-sun-sunos${UNAME_RELEASE} + ;; + esac + exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos${UNAME_RELEASE} + exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; + m68k:machten:*:*) + echo m68k-apple-machten${UNAME_RELEASE} + exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten${UNAME_RELEASE} + exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix${UNAME_RELEASE} + exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix${UNAME_RELEASE} + exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix${UNAME_RELEASE} + exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +#ifdef __cplusplus +#include /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && + dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && + SYSTEM_NAME=`$dummy $dummyarg` && + { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos${UNAME_RELEASE} + exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` + if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] + then + if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ + [ ${TARGET_BINARY_INTERFACE}x = x ] + then + echo m88k-dg-dgux${UNAME_RELEASE} + else + echo m88k-dg-dguxbcs${UNAME_RELEASE} + fi + else + echo i586-dg-dgux${UNAME_RELEASE} + fi + exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` + exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} + exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit ;; + *:AIX:*:[45]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${IBM_ARCH}-ibm-aix${IBM_REV} + exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit ;; + ibmrt:4.4BSD:*|romp-ibm:BSD:*) + echo romp-ibm-bsd4.4 + exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to + exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + case "${UNAME_MACHINE}" in + 9000/31? ) HP_ARCH=m68000 ;; + 9000/[34]?? ) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if [ -x /usr/bin/getconf ]; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; + '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 + esac ;; + esac + fi + if [ "${HP_ARCH}" = "" ]; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + + #define _HPUX_SOURCE + #include + #include + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if [ ${HP_ARCH} = "hppa2.0w" ] + then + eval $set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | + grep __LP64__ >/dev/null + then + HP_ARCH="hppa2.0w" + else + HP_ARCH="hppa64" + fi + fi + echo ${HP_ARCH}-hp-hpux${HPUX_REV} + exit ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux${HPUX_REV} + exit ;; + 3050*:HI-UX:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 + exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) + echo hppa1.1-hp-bsd + exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) + echo hppa1.1-hp-osf + exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo ${UNAME_MACHINE}-unknown-osf1mk + else + echo ${UNAME_MACHINE}-unknown-osf1 + fi + exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*[A-Z]90:*:*:*) + echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} + exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:FreeBSD:*:*) + case ${UNAME_MACHINE} in + pc98) + echo i386-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + *) + echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + esac + exit ;; + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin + exit ;; + *:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 + exit ;; + i*:windows32*:*) + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 + exit ;; + i*:PW*:*) + echo ${UNAME_MACHINE}-pc-pw32 + exit ;; + *:Interix*:[3456]*) + case ${UNAME_MACHINE} in + x86) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + EM64T | authenticamd) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + esac ;; + [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) + echo i${UNAME_MACHINE}-pc-mks + exit ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i586-pc-interix + exit ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-unknown-cygwin + exit ;; + p*:CYGWIN*:*) + echo powerpcle-unknown-cygwin + exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + *:GNU:*:*) + # the GNU system + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-gnu + exit ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix + exit ;; + arm*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + avr32*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + cris:Linux:*:*) + echo cris-axis-linux-gnu + exit ;; + crisv32:Linux:*:*) + echo crisv32-axis-linux-gnu + exit ;; + frv:Linux:*:*) + echo frv-unknown-linux-gnu + exit ;; + ia64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + m32r*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + m68*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + mips:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef mips + #undef mipsel + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=mipsel + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=mips + #else + CPU= + #endif + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^CPU/{ + s: ::g + p + }'`" + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + ;; + mips64:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef mips64 + #undef mips64el + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=mips64el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=mips64 + #else + CPU= + #endif + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^CPU/{ + s: ::g + p + }'`" + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; } + ;; + or32:Linux:*:*) + echo or32-unknown-linux-gnu + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-gnu + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-gnu + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep ld.so.1 >/dev/null + if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi + echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC} + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in + PA7*) echo hppa1.1-unknown-linux-gnu ;; + PA8*) echo hppa2.0-unknown-linux-gnu ;; + *) echo hppa-unknown-linux-gnu ;; + esac + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-gnu + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux + exit ;; + sh64*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + sh*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-gnu + exit ;; + tile:Linux:*:*) + echo tile-unknown-linux-gnu + exit ;; + vax:Linux:*:*) + echo ${UNAME_MACHINE}-dec-linux-gnu + exit ;; + x86_64:Linux:*:*) + echo x86_64-unknown-linux-gnu + exit ;; + xtensa:Linux:*:*) + echo xtensa-unknown-linux-gnu + exit ;; + i*86:Linux:*:*) + # The BFD linker knows what the default object file format is, so + # first see if it will tell us. cd to the root directory to prevent + # problems with other programs or directories called `ld' in the path. + # Set LC_ALL=C to ensure ld outputs messages in English. + ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \ + | sed -ne '/supported targets:/!d + s/[ ][ ]*/ /g + s/.*supported targets: *// + s/ .*// + p'` + case "$ld_supported_targets" in + elf32-i386) + TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu" + ;; + a.out-i386-linux) + echo "${UNAME_MACHINE}-pc-linux-gnuaout" + exit ;; + coff-i386) + echo "${UNAME_MACHINE}-pc-linux-gnucoff" + exit ;; + "") + # Either a pre-BFD a.out linker (linux-gnuoldld) or + # one that does not give us useful --help. + echo "${UNAME_MACHINE}-pc-linux-gnuoldld" + exit ;; + esac + # Determine whether the default compiler is a.out or elf + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + #ifdef __ELF__ + # ifdef __GLIBC__ + # if __GLIBC__ >= 2 + LIBC=gnu + # else + LIBC=gnulibc1 + # endif + # else + LIBC=gnulibc1 + # endif + #else + #if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC) + LIBC=gnu + #else + LIBC=gnuaout + #endif + #endif + #ifdef __dietlibc__ + LIBC=dietlibc + #endif +EOF + eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n ' + /^LIBC/{ + s: ::g + p + }'`" + test x"${LIBC}" != x && { + echo "${UNAME_MACHINE}-pc-linux-${LIBC}" + exit + } + test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; } + ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} + exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo ${UNAME_MACHINE}-pc-os2-emx + exit ;; + i*86:XTS-300:*:STOP) + echo ${UNAME_MACHINE}-unknown-stop + exit ;; + i*86:atheos:*:*) + echo ${UNAME_MACHINE}-unknown-atheos + exit ;; + i*86:syllable:*:*) + echo ${UNAME_MACHINE}-pc-syllable + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.0*:*) + echo i386-unknown-lynxos${UNAME_RELEASE} + exit ;; + i*86:*DOS:*:*) + echo ${UNAME_MACHINE}-pc-msdosdjgpp + exit ;; + i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then + UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo ${UNAME_MACHINE}-pc-sco$UNAME_REL + else + echo ${UNAME_MACHINE}-pc-sysv32 + fi + exit ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i386. + echo i386-pc-msdosdjgpp + exit ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 + fi + exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos${UNAME_RELEASE} + exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos${UNAME_RELEASE} + exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos${UNAME_RELEASE} + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.0*:*) + echo powerpc-unknown-lynxos${UNAME_RELEASE} + exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv${UNAME_RELEASE} + exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` + echo ${UNAME_MACHINE}-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo ${UNAME_MACHINE}-stratus-vos + exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux${UNAME_RELEASE} + exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then + echo mips-nec-sysv${UNAME_RELEASE} + else + echo mips-unknown-sysv${UNAME_RELEASE} + fi + exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} + exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} + exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux${UNAME_RELEASE} + exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux${UNAME_RELEASE} + exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = "x86"; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} + exit ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit ;; + NSE-?:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk${UNAME_RELEASE} + exit ;; + NSR-?:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk${UNAME_RELEASE} + exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit ;; + DS/*:UNIX_System_V:*:*) + echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} + exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + if test "$cputype" = "386"; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo ${UNAME_MACHINE}-unknown-plan9 + exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux${UNAME_RELEASE} + exit ;; + *:DragonFly:*:*) + echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case "${UNAME_MACHINE}" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' + exit ;; + i*86:rdos:*:*) + echo ${UNAME_MACHINE}-pc-rdos + exit ;; +esac + +#echo '(No uname command or uname output not recognized.)' 1>&2 +#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2 + +eval $set_cc_for_build +cat >$dummy.c < +# include +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (__arm) && defined (__acorn) && defined (__unix) + printf ("arm-acorn-riscix\n"); exit (0); +#endif + +#if defined (hp300) && !defined (hpux) + printf ("m68k-hp-bsd\n"); exit (0); +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); + +#endif + +#if defined (vax) +# if !defined (ultrix) +# include +# if defined (BSD) +# if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +# else +# if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# endif +# else + printf ("vax-dec-bsd\n"); exit (0); +# endif +# else + printf ("vax-dec-ultrix\n"); exit (0); +# endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. + +test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } + +# Convex versions that predate uname can use getsysinfo(1) + +if [ -x /usr/convex/getsysinfo ] +then + case `getsysinfo -f cpu_type` in + c1*) + echo c1-convex-bsd + exit ;; + c2*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + c34*) + echo c34-convex-bsd + exit ;; + c38*) + echo c38-convex-bsd + exit ;; + c4*) + echo c4-convex-bsd + exit ;; + esac +fi + +cat >&2 < in order to provide the needed +information to handle your system. + +config.guess timestamp = $timestamp + +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null` + +hostinfo = `(hostinfo) 2>/dev/null` +/bin/universe = `(/bin/universe) 2>/dev/null` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` +/bin/arch = `(/bin/arch) 2>/dev/null` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` + +UNAME_MACHINE = ${UNAME_MACHINE} +UNAME_RELEASE = ${UNAME_RELEASE} +UNAME_SYSTEM = ${UNAME_SYSTEM} +UNAME_VERSION = ${UNAME_VERSION} +EOF + +exit 1 + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/erts/autoconf/config.sub b/erts/autoconf/config.sub new file mode 100755 index 0000000000..f43233b104 --- /dev/null +++ b/erts/autoconf/config.sub @@ -0,0 +1,1630 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +# 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, +# Inc. + +timestamp='2007-04-29' + +# This file is (in principle) common to ALL GNU software. +# The presence of a machine in this file suggests that SOME GNU software +# can handle that machine. It does not imply ALL GNU software can. +# +# This file 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 of the License, or +# (at your option) any later version. +# +# This program 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 this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA +# 02110-1301, USA. +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + + +# Please send patches to . Submit a context +# diff and a properly formatted ChangeLog entry. +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS + $0 [OPTION] ALIAS + +Canonicalize a configuration name. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.sub ($timestamp) + +Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 +Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo $1 + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). +# Here we must recognize all the valid KERNEL-OS combinations. +maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` +case $maybe_os in + nto-qnx* | linux-gnu* | linux-dietlibc | linux-newlib* | linux-uclibc* | \ + uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) + os=-$maybe_os + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` + ;; + *) + basic_machine=`echo $1 | sed 's/-[^-]*$//'` + if [ $basic_machine != $1 ] + then os=`echo $1 | sed 's/.*-/-/'` + else os=; fi + ;; +esac + +### Let's recognize common machines as not being operating systems so +### that things like config.sub decstation-3100 work. We also +### recognize some manufacturers as not being operating systems, so we +### can provide default operating systems below. +case $os in + -sun*os*) + # Prevent following clause from handling this invalid input. + ;; + -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ + -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ + -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ + -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ + -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ + -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ + -apple | -axis | -knuth | -cray) + os= + basic_machine=$1 + ;; + -sim | -cisco | -oki | -wec | -winbond) + os= + basic_machine=$1 + ;; + -scout) + ;; + -wrs) + os=-vxworks + basic_machine=$1 + ;; + -chorusos*) + os=-chorusos + basic_machine=$1 + ;; + -chorusrdb) + os=-chorusrdb + basic_machine=$1 + ;; + -hiux*) + os=-hiuxwe2 + ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5) + os=-sco3.2v5 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco4) + os=-sco3.2v4 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2.[4-9]*) + os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2v[4-9]*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco*) + os=-sco3.2v2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -udk*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -isc) + os=-isc2.2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -clix*) + basic_machine=clipper-intergraph + ;; + -isc*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -lynx*) + os=-lynxos + ;; + -ptx*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` + ;; + -windowsnt*) + os=`echo $os | sed -e 's/windowsnt/winnt/'` + ;; + -psos*) + os=-psos + ;; + -mint | -mint[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; +esac + +# Decode aliases for certain CPU-COMPANY combinations. +case $basic_machine in + # Recognize the basic CPU types without company name. + # Some are omitted here because they have special meanings below. + 1750a | 580 \ + | a29k \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ + | am33_2.0 \ + | arc | arm | arm[bl]e | arme[lb] | armv[2345] | armv[345][lb] | avr | avr32 \ + | bfin \ + | c4x | clipper \ + | d10v | d30v | dlx | dsp16xx \ + | fido | fr30 | frv \ + | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | i370 | i860 | i960 | ia64 \ + | ip2k | iq2000 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | mcore | mep \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ + | mips64vr | mips64vrel \ + | mips64orion | mips64orionel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ + | mt \ + | msp430 \ + | nios | nios2 \ + | ns16k | ns32k \ + | or32 \ + | pdp10 | pdp11 | pj | pjl \ + | powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \ + | pyramid \ + | score \ + | sh | sh[1234] | sh[24]a | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu | strongarm \ + | tahoe | thumb | tic4x | tic80 | tron \ + | v850 | v850e \ + | we32k \ + | x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \ + | z8k) + basic_machine=$basic_machine-unknown + ;; + m6811 | m68hc11 | m6812 | m68hc12) + # Motorola 68HC11/12. + basic_machine=$basic_machine-unknown + os=-none + ;; + m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) + ;; + ms1) + basic_machine=mt-unknown + ;; + + # We use `pc' rather than `unknown' + # because (1) that's what they normally are, and + # (2) the word "unknown" tends to confuse beginning users. + i*86 | x86_64) + basic_machine=$basic_machine-pc + ;; + # Object if more than one company name word. + *-*-*) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; + # Recognize the basic CPU types with company name. + 580-* \ + | a29k-* \ + | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ + | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ + | alphapca5[67]-* | alpha64pca5[67]-* | arc-* \ + | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ + | avr-* | avr32-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* | c54x-* | c55x-* | c6x-* \ + | clipper-* | craynv-* | cydra-* \ + | d10v-* | d30v-* | dlx-* \ + | elxsi-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ + | h8300-* | h8500-* \ + | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | i*86-* | i860-* | i960-* | ia64-* \ + | ip2k-* | iq2000-* \ + | m32c-* | m32r-* | m32rle-* \ + | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ + | m88110-* | m88k-* | maxq-* | mcore-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ + | mips64vr-* | mips64vrel-* \ + | mips64orion-* | mips64orionel-* \ + | mips64vr4100-* | mips64vr4100el-* \ + | mips64vr4300-* | mips64vr4300el-* \ + | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ + | mipsisa32-* | mipsisa32el-* \ + | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ + | msp430-* \ + | nios-* | nios2-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | orion-* \ + | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \ + | pyramid-* \ + | romp-* | rs6000-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | strongarm-* | sv1-* | sx?-* \ + | tahoe-* | thumb-* \ + | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tron-* \ + | v850-* | v850e-* | vax-* \ + | we32k-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \ + | xstormy16-* | xtensa-* \ + | ymp-* \ + | z8k-*) + ;; + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 386bsd) + basic_machine=i386-unknown + os=-bsd + ;; + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + basic_machine=m68000-att + ;; + 3b*) + basic_machine=we32k-att + ;; + a29khif) + basic_machine=a29k-amd + os=-udi + ;; + abacus) + basic_machine=abacus-unknown + ;; + adobe68k) + basic_machine=m68010-adobe + os=-scout + ;; + alliant | fx80) + basic_machine=fx80-alliant + ;; + altos | altos3068) + basic_machine=m68k-altos + ;; + am29k) + basic_machine=a29k-none + os=-bsd + ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + amdahl) + basic_machine=580-amdahl + os=-sysv + ;; + amiga | amiga-*) + basic_machine=m68k-unknown + ;; + amigaos | amigados) + basic_machine=m68k-unknown + os=-amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + os=-sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + os=-sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + os=-bsd + ;; + aux) + basic_machine=m68k-apple + os=-aux + ;; + balance) + basic_machine=ns32k-sequent + os=-dynix + ;; + c90) + basic_machine=c90-cray + os=-unicos + ;; + convex-c1) + basic_machine=c1-convex + os=-bsd + ;; + convex-c2) + basic_machine=c2-convex + os=-bsd + ;; + convex-c32) + basic_machine=c32-convex + os=-bsd + ;; + convex-c34) + basic_machine=c34-convex + os=-bsd + ;; + convex-c38) + basic_machine=c38-convex + os=-bsd + ;; + cray | j90) + basic_machine=j90-cray + os=-unicos + ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16c) + basic_machine=cr16c-unknown + os=-elf + ;; + crds | unos) + basic_machine=m68k-crds + ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; + cris | cris-* | etrax*) + basic_machine=cris-axis + ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; + da30 | da30-*) + basic_machine=m68k-da30 + ;; + decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) + basic_machine=mips-dec + ;; + decsystem10* | dec10*) + basic_machine=pdp10-dec + os=-tops10 + ;; + decsystem20* | dec20*) + basic_machine=pdp10-dec + os=-tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + basic_machine=m68k-motorola + ;; + delta88) + basic_machine=m88k-motorola + os=-sysv3 + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; + dpx20 | dpx20-*) + basic_machine=rs6000-bull + os=-bosx + ;; + dpx2* | dpx2*-bull) + basic_machine=m68k-bull + os=-sysv3 + ;; + ebmon29k) + basic_machine=a29k-amd + os=-ebmon + ;; + elxsi) + basic_machine=elxsi-elxsi + os=-bsd + ;; + encore | umax | mmax) + basic_machine=ns32k-encore + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + os=-ose + ;; + fx2800) + basic_machine=i860-alliant + ;; + genix) + basic_machine=ns32k-ns + ;; + gmicro) + basic_machine=tron-gmicro + os=-sysv + ;; + go32) + basic_machine=i386-pc + os=-go32 + ;; + h3050r* | hiux*) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + h8300hms) + basic_machine=h8300-hitachi + os=-hms + ;; + h8300xray) + basic_machine=h8300-hitachi + os=-xray + ;; + h8500hms) + basic_machine=h8500-hitachi + os=-hms + ;; + harris) + basic_machine=m88k-harris + os=-sysv3 + ;; + hp300-*) + basic_machine=m68k-hp + ;; + hp300bsd) + basic_machine=m68k-hp + os=-bsd + ;; + hp300hpux) + basic_machine=m68k-hp + os=-hpux + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + basic_machine=m68000-hp + ;; + hp9k3[2-9][0-9]) + basic_machine=m68k-hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + basic_machine=hppa1.1-hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hppa-next) + os=-nextstep3 + ;; + hppaosf) + basic_machine=hppa1.1-hp + os=-osf + ;; + hppro) + basic_machine=hppa1.1-hp + os=-proelf + ;; + i370-ibm* | ibm*) + basic_machine=i370-ibm + ;; +# I'm not sure what "Sysv32" means. Should this be sysv3.2? + i*86v32) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv32 + ;; + i*86v4*) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv4 + ;; + i*86v) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv + ;; + i*86sol2) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-solaris2 + ;; + i386mach) + basic_machine=i386-mach + os=-mach + ;; + i386-vsta | vsta) + basic_machine=i386-unknown + os=-vsta + ;; + iris | iris4d) + basic_machine=mips-sgi + case $os in + -irix*) + ;; + *) + os=-irix4 + ;; + esac + ;; + isi68 | isi) + basic_machine=m68k-isi + os=-sysv + ;; + m88k-omron*) + basic_machine=m88k-omron + ;; + magnum | m3230) + basic_machine=mips-mips + os=-sysv + ;; + merlin) + basic_machine=ns32k-utek + os=-sysv + ;; + mingw32) + basic_machine=i386-pc + os=-mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + os=-mingw32ce + ;; + miniframe) + basic_machine=m68000-convergent + ;; + *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; + mips3*-*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` + ;; + mips3*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown + ;; + monitor) + basic_machine=m68k-rom68k + os=-coff + ;; + morphos) + basic_machine=powerpc-unknown + os=-morphos + ;; + msdos) + basic_machine=i386-pc + os=-msdos + ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + mvs) + basic_machine=i370-ibm + os=-mvs + ;; + ncr3000) + basic_machine=i486-ncr + os=-sysv4 + ;; + netbsd386) + basic_machine=i386-unknown + os=-netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + os=-linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + os=-newsos + ;; + news1000) + basic_machine=m68030-sony + os=-newsos + ;; + news-3600 | risc-news) + basic_machine=mips-sony + os=-newsos + ;; + necv70) + basic_machine=v70-nec + os=-sysv + ;; + next | m*-next ) + basic_machine=m68k-next + case $os in + -nextstep* ) + ;; + -ns2*) + os=-nextstep2 + ;; + *) + os=-nextstep3 + ;; + esac + ;; + nh3000) + basic_machine=m68k-harris + os=-cxux + ;; + nh[45]000) + basic_machine=m88k-harris + os=-cxux + ;; + nindy960) + basic_machine=i960-intel + os=-nindy + ;; + mon960) + basic_machine=i960-intel + os=-mon960 + ;; + nonstopux) + basic_machine=mips-compaq + os=-nonstopux + ;; + np1) + basic_machine=np1-gould + ;; + nsr-tandem) + basic_machine=nsr-tandem + ;; + op50n-* | op60c-*) + basic_machine=hppa1.1-oki + os=-proelf + ;; + openrisc | openrisc-*) + basic_machine=or32-unknown + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + os=-ose + ;; + os68k) + basic_machine=m68k-none + os=-os68k + ;; + pa-hitachi) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + paragon) + basic_machine=i860-intel + os=-osf + ;; + pbd) + basic_machine=sparc-tti + ;; + pbb) + basic_machine=m68k-tti + ;; + pc532 | pc532-*) + basic_machine=ns32k-pc532 + ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium | p5 | k5 | k6 | nexgen | viac3) + basic_machine=i586-pc + ;; + pentiumpro | p6 | 6x86 | athlon | athlon_*) + basic_machine=i686-pc + ;; + pentiumii | pentium2 | pentiumiii | pentium3) + basic_machine=i686-pc + ;; + pentium4) + basic_machine=i786-pc + ;; + pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) + basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumpro-* | p6-* | 6x86-* | athlon-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium4-*) + basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pn) + basic_machine=pn-gould + ;; + power) basic_machine=power-ibm + ;; + ppc) basic_machine=powerpc-unknown + ;; + ppc-*) basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppcle | powerpclittle | ppc-le | powerpc-little) + basic_machine=powerpcle-unknown + ;; + ppcle-* | powerpclittle-*) + basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64) basic_machine=powerpc64-unknown + ;; + ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64le | powerpc64little | ppc64-le | powerpc64-little) + basic_machine=powerpc64le-unknown + ;; + ppc64le-* | powerpc64little-*) + basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ps2) + basic_machine=i386-ibm + ;; + pw32) + basic_machine=i586-unknown + os=-pw32 + ;; + rdos) + basic_machine=i386-pc + os=-rdos + ;; + rom68k) + basic_machine=m68k-rom68k + os=-coff + ;; + rm[46]00) + basic_machine=mips-siemens + ;; + rtpc | rtpc-*) + basic_machine=romp-ibm + ;; + s390 | s390-*) + basic_machine=s390-ibm + ;; + s390x | s390x-*) + basic_machine=s390x-ibm + ;; + sa29200) + basic_machine=a29k-amd + os=-udi + ;; + sb1) + basic_machine=mipsisa64sb1-unknown + ;; + sb1el) + basic_machine=mipsisa64sb1el-unknown + ;; + sde) + basic_machine=mipsisa32-sde + os=-elf + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; + sequent) + basic_machine=i386-sequent + ;; + sh) + basic_machine=sh-hitachi + os=-hms + ;; + sh5el) + basic_machine=sh5le-unknown + ;; + sh64) + basic_machine=sh64-unknown + ;; + sparclite-wrs | simso-wrs) + basic_machine=sparclite-wrs + os=-vxworks + ;; + sps7) + basic_machine=m68k-bull + os=-sysv2 + ;; + spur) + basic_machine=spur-unknown + ;; + st2000) + basic_machine=m68k-tandem + ;; + stratus) + basic_machine=i860-stratus + os=-sysv4 + ;; + sun2) + basic_machine=m68000-sun + ;; + sun2os3) + basic_machine=m68000-sun + os=-sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + os=-sunos4 + ;; + sun3os3) + basic_machine=m68k-sun + os=-sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + os=-sunos4 + ;; + sun4os3) + basic_machine=sparc-sun + os=-sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + os=-sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + os=-solaris2 + ;; + sun3 | sun3-*) + basic_machine=m68k-sun + ;; + sun4) + basic_machine=sparc-sun + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + ;; + sv1) + basic_machine=sv1-cray + os=-unicos + ;; + symmetry) + basic_machine=i386-sequent + os=-dynix + ;; + t3e) + basic_machine=alphaev5-cray + os=-unicos + ;; + t90) + basic_machine=t90-cray + os=-unicos + ;; + tic54x | c54x*) + basic_machine=tic54x-unknown + os=-coff + ;; + tic55x | c55x*) + basic_machine=tic55x-unknown + os=-coff + ;; + tic6x | c6x*) + basic_machine=tic6x-unknown + os=-coff + ;; + tx39) + basic_machine=mipstx39-unknown + ;; + tx39el) + basic_machine=mipstx39el-unknown + ;; + tile*) + basic_machine=tile-tilera + os=-linux-gnu + ;; + toad1) + basic_machine=pdp10-xkl + os=-tops20 + ;; + tower | tower-32) + basic_machine=m68k-ncr + ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; + udi29k) + basic_machine=a29k-amd + os=-udi + ;; + ultra3) + basic_machine=a29k-nyu + os=-sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + os=-none + ;; + vaxv) + basic_machine=vax-dec + os=-sysv + ;; + vms) + basic_machine=vax-dec + os=-vms + ;; + vpp*|vx|vx-*) + basic_machine=f301-fujitsu + ;; + vxworks960) + basic_machine=i960-wrs + os=-vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + os=-vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + os=-vxworks + ;; + w65*) + basic_machine=w65-wdc + os=-none + ;; + w89k-*) + basic_machine=hppa1.1-winbond + os=-proelf + ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; + xps | xps100) + basic_machine=xps100-honeywell + ;; + ymp) + basic_machine=ymp-cray + os=-unicos + ;; + z8k-*-coff) + basic_machine=z8k-unknown + os=-sim + ;; + none) + basic_machine=none-none + os=-none + ;; + +# Here we handle the default manufacturer of certain CPU types. It is in +# some cases the only manufacturer, in others, it is the most popular. + w89k) + basic_machine=hppa1.1-winbond + ;; + op50n) + basic_machine=hppa1.1-oki + ;; + op60c) + basic_machine=hppa1.1-oki + ;; + romp) + basic_machine=romp-ibm + ;; + mmix) + basic_machine=mmix-knuth + ;; + rs6000) + basic_machine=rs6000-ibm + ;; + vax) + basic_machine=vax-dec + ;; + pdp10) + # there are many clones, so DEC is not a safe bet + basic_machine=pdp10-unknown + ;; + pdp11) + basic_machine=pdp11-dec + ;; + we32k) + basic_machine=we32k-att + ;; + sh[1234] | sh[24]a | sh[34]eb | sh[1234]le | sh[23]ele) + basic_machine=sh-unknown + ;; + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) + basic_machine=sparc-sun + ;; + cydra) + basic_machine=cydra-cydrome + ;; + orion) + basic_machine=orion-highlevel + ;; + orion105) + basic_machine=clipper-highlevel + ;; + mac | mpw | mac-mpw) + basic_machine=m68k-apple + ;; + pmac | pmac-mpw) + basic_machine=powerpc-apple + ;; + *-unknown) + # Make sure to match an already-canonicalized machine name. + ;; + *) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $basic_machine in + *-digital*) + basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` + ;; + *-commodore*) + basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if [ x"$os" != x"" ] +then +case $os in + # First match some system type aliases + # that might get confused with valid system types. + # -solaris* is a basic system type, with this one exception. + -solaris1 | -solaris1.*) + os=`echo $os | sed -e 's|solaris1|sunos4|'` + ;; + -solaris) + os=-solaris2 + ;; + -svr4*) + os=-sysv4 + ;; + -unixware*) + os=-sysv4.2uw + ;; + -gnu/linux*) + os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` + ;; + # First accept the basic system types. + # The portable systems comes first. + # Each alternative MUST END IN A *, to match a version number. + # -sysv* is not here because it comes later, after sysvr4. + -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ + | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ + | -aos* \ + | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ + | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ + | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ + | -chorusos* | -chorusrdb* \ + | -cygwin* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -linux-gnu* | -linux-newlib* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* \ + | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ + | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ + | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ + | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ + | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers* | -drops*) + # Remember, each alternative MUST END IN *, to match a version number. + ;; + -qnx*) + case $basic_machine in + x86-* | i*86-*) + ;; + *) + os=-nto$os + ;; + esac + ;; + -nto-qnx*) + ;; + -nto*) + os=`echo $os | sed -e 's|nto|nto-qnx|'` + ;; + -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ + | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) + ;; + -mac*) + os=`echo $os | sed -e 's|mac|macos|'` + ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; + -linux*) + os=`echo $os | sed -e 's|linux|linux-gnu|'` + ;; + -sunos5*) + os=`echo $os | sed -e 's|sunos5|solaris2|'` + ;; + -sunos6*) + os=`echo $os | sed -e 's|sunos6|solaris3|'` + ;; + -opened*) + os=-openedition + ;; + -os400*) + os=-os400 + ;; + -wince*) + os=-wince + ;; + -osfrose*) + os=-osfrose + ;; + -osf*) + os=-osf + ;; + -utek*) + os=-bsd + ;; + -dynix*) + os=-bsd + ;; + -acis*) + os=-aos + ;; + -atheos*) + os=-atheos + ;; + -syllable*) + os=-syllable + ;; + -386bsd) + os=-bsd + ;; + -ctix* | -uts*) + os=-sysv + ;; + -nova*) + os=-rtmk-nova + ;; + -ns2 ) + os=-nextstep2 + ;; + -nsk*) + os=-nsk + ;; + # Preserve the version number of sinix5. + -sinix5.*) + os=`echo $os | sed -e 's|sinix|sysv|'` + ;; + -sinix*) + os=-sysv4 + ;; + -tpf*) + os=-tpf + ;; + -triton*) + os=-sysv3 + ;; + -oss*) + os=-sysv3 + ;; + -svr4) + os=-sysv4 + ;; + -svr3) + os=-sysv3 + ;; + -sysvr4) + os=-sysv4 + ;; + # This must come after -sysvr4. + -sysv*) + ;; + -ose*) + os=-ose + ;; + -es1800*) + os=-ose + ;; + -xenix) + os=-xenix + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + os=-mint + ;; + -aros*) + os=-aros + ;; + -kaos*) + os=-kaos + ;; + -zvmoe) + os=-zvmoe + ;; + -none) + ;; + *) + # Get rid of the `-' at the beginning of $os. + os=`echo $os | sed 's/[^-]*-//'` + echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 + exit 1 + ;; +esac +else + +# Here we handle the default operating systems that come with various machines. +# The value should be what the vendor currently ships out the door with their +# machine or put another way, the most popular os provided with the machine. + +# Note that if you're going to try to match "-MANUFACTURER" here (say, +# "-sun"), then you have to tell the case statement up towards the top +# that MANUFACTURER isn't an operating system. Otherwise, code above +# will signal an error saying that MANUFACTURER isn't an operating +# system, and we'll never get to this point. + +case $basic_machine in + score-*) + os=-elf + ;; + spu-*) + os=-elf + ;; + *-acorn) + os=-riscix1.2 + ;; + arm*-rebel) + os=-linux + ;; + arm*-semi) + os=-aout + ;; + c4x-* | tic4x-*) + os=-coff + ;; + # This must come before the *-dec entry. + pdp10-*) + os=-tops20 + ;; + pdp11-*) + os=-none + ;; + *-dec | vax-*) + os=-ultrix4.2 + ;; + m68*-apollo) + os=-domain + ;; + i386-sun) + os=-sunos4.0.2 + ;; + m68000-sun) + os=-sunos3 + # This also exists in the configure program, but was not the + # default. + # os=-sunos4 + ;; + m68*-cisco) + os=-aout + ;; + mep-*) + os=-elf + ;; + mips*-cisco) + os=-elf + ;; + mips*-*) + os=-elf + ;; + or32-*) + os=-coff + ;; + *-tti) # must be before sparc entry or we get the wrong os. + os=-sysv3 + ;; + sparc-* | *-sun) + os=-sunos4.1.1 + ;; + *-be) + os=-beos + ;; + *-haiku) + os=-haiku + ;; + *-ibm) + os=-aix + ;; + *-knuth) + os=-mmixware + ;; + *-wec) + os=-proelf + ;; + *-winbond) + os=-proelf + ;; + *-oki) + os=-proelf + ;; + *-hp) + os=-hpux + ;; + *-hitachi) + os=-hiux + ;; + i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) + os=-sysv + ;; + *-cbm) + os=-amigaos + ;; + *-dg) + os=-dgux + ;; + *-dolphin) + os=-sysv3 + ;; + m68k-ccur) + os=-rtu + ;; + m88k-omron*) + os=-luna + ;; + *-next ) + os=-nextstep + ;; + *-sequent) + os=-ptx + ;; + *-crds) + os=-unos + ;; + *-ns) + os=-genix + ;; + i370-*) + os=-mvs + ;; + *-next) + os=-nextstep3 + ;; + *-gould) + os=-sysv + ;; + *-highlevel) + os=-bsd + ;; + *-encore) + os=-bsd + ;; + *-sgi) + os=-irix + ;; + *-siemens) + os=-sysv4 + ;; + *-masscomp) + os=-rtu + ;; + f30[01]-fujitsu | f700-fujitsu) + os=-uxpv + ;; + *-rom68k) + os=-coff + ;; + *-*bug) + os=-coff + ;; + *-apple) + os=-macos + ;; + *-atari*) + os=-mint + ;; + *) + os=-none + ;; +esac +fi + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +vendor=unknown +case $basic_machine in + *-unknown) + case $os in + -riscix*) + vendor=acorn + ;; + -sunos*) + vendor=sun + ;; + -aix*) + vendor=ibm + ;; + -beos*) + vendor=be + ;; + -hpux*) + vendor=hp + ;; + -mpeix*) + vendor=hp + ;; + -hiux*) + vendor=hitachi + ;; + -unos*) + vendor=crds + ;; + -dgux*) + vendor=dg + ;; + -luna*) + vendor=omron + ;; + -genix*) + vendor=ns + ;; + -mvs* | -opened*) + vendor=ibm + ;; + -os400*) + vendor=ibm + ;; + -ptx*) + vendor=sequent + ;; + -tpf*) + vendor=ibm + ;; + -vxsim* | -vxworks* | -windiss*) + vendor=wrs + ;; + -aux*) + vendor=apple + ;; + -hms*) + vendor=hitachi + ;; + -mpw* | -macos*) + vendor=apple + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + vendor=atari + ;; + -vos*) + vendor=stratus + ;; + esac + basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` + ;; +esac + +echo $basic_machine$os +exit + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/erts/autoconf/configure.vxworks b/erts/autoconf/configure.vxworks new file mode 100755 index 0000000000..70d7bdbaf2 --- /dev/null +++ b/erts/autoconf/configure.vxworks @@ -0,0 +1,147 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: +# Patrik Winroth +# + + +# vxworks_ppc860 vxworks_ppc603 vxworks_ppc603_longcall vxworks_cpu32 vxworks_sparc +# vxworks_ppc750 vxworks_simso + +case $# in +1) host=$1 ;; +*) echo "usage: configure.vxworks host-configuration"; exit 1 ;; +esac + +case $1 in +vxworks_cpu32) ;; +vxworks_ppc750) ;; +vxworks_ppc860) ;; +vxworks_ppc603) ;; +vxworks_ppc603_nolongcall) ;; +vxworks_sparc) ;; +vxworks_simso) ;; +vxworks_simlinux) ;; +vxworks_ppc32) ;; +*) echo "usage: configure.vxworks TARGET"; + echo "where TARGET is one of vxworks_cpu32, vxworks_ppc750, vxworks_ppc860, vxworks_ppc603, vxworks_ppc603_nolongcall, vxworks_sparc, vxworks_simso, vxworks_simlinux, vxworks_ppc32"; exit 1;; +esac + +if [ "x$ERL_TOP" = x ]; then + echo "You need to set ERL_TOP!" + exit 1 +fi + + +target=$host + +# Find out the HOST and WIND_BASE environment +HOST_TYPE=${HOST_TYPE:=sun4-solaris2} +case $1 in +vxworks_ppc750) VXTOP=Tornado2.2 ;; +vxworks_simso) VXTOP=WindRiver ;; +vxworks_simlinux) VXTOP=WindRiver ;; +vxworks_ppc32) VXTOP=WindRiver ;; +*) VXTOP=wind ;; +esac + +WIND_BASE=${WIND_BASE:=`ypmatch tornado passwd | awk -F: '{print $6}'`/$VXTOP} + +# These are created by autoconf. +MKDIRS="${ERL_TOP}/lib/os_mon/priv/bin/$target + ${ERL_TOP}/lib/os_mon/priv/obj/$target + ${ERL_TOP}/lib/orber/priv/obj/$target + ${ERL_TOP}/lib/orber/priv/bin/$target + ${ERL_TOP}/lib/ic/priv/lib/$target + ${ERL_TOP}/lib/ic/priv/obj/$target + ${ERL_TOP}/lib/asn1/priv/lib/$target + ${ERL_TOP}/lib/asn1/priv/obj/$target + ${ERL_TOP}/lib/erl_interface/obj/$target + ${ERL_TOP}/lib/erl_interface/obj.debug/$target + ${ERL_TOP}/lib/erl_interface/bin/$target + ${ERL_TOP}/lib/runtime_tools/priv/lib/$target + ${ERL_TOP}/lib/runtime_tools/priv/obj/$target + ${ERL_TOP}/erts/obj/$target + ${ERL_TOP}/erts/obj.debug/$target + ${ERL_TOP}/bin/$target" + +for dir in $MKDIRS; do + test ! -d "$dir" && mkdir -p "$dir" +done + +# +# Create Makefiles for vxWorks. +# +my_root=${ERL_TOP}/erts/emulator +emu_test=$my_root/test +beam=$my_root/beam +erts_lib_src=${ERL_TOP}/erts/lib_src +erts_incl=${ERL_TOP}/erts/include +erts_incl_intrnl=${ERL_TOP}/erts/include/internal +etcdir=${ERL_TOP}/erts/etc/common +erlint_dir=${ERL_TOP}/lib/erl_interface/src +epmd_dir=${ERL_TOP}/erts/epmd/src +os_mon_dir=${ERL_TOP}/lib/os_mon/c_src +orber_dir=${ERL_TOP}/lib/orber/c_src +ic_dir=${ERL_TOP}/lib/ic/c_src +asn1_dir=${ERL_TOP}/lib/asn1/c_src +internal_tools_dir=${ERL_TOP} +libdir=${ERL_TOP}/lib +tsdir=$libdir/test_server/src +zlibdir=${ERL_TOP}/erts/emulator/zlib +runtime_tools_dir=${ERL_TOP}/lib/runtime_tools/c_src +tools_dir=${ERL_TOP}/lib/tools/c_src + +CONFIG_FILES="${ERL_TOP}/erts/emulator/$host/Makefile + $erts_lib_src/$host/Makefile + $erts_incl/$host/erl_int_sizes_config.h + $erts_incl_intrnl/$host/ethread.mk + $erts_incl_intrnl/$host/ethread_header_config.h + $etcdir/$host/Makefile + $erlint_dir/$host/Makefile + $erlint_dir/$host/eidefs.mk + $epmd_dir/$host/Makefile + $internal_tools_dir/make/$host/otp.mk + $os_mon_dir/$host/Makefile + $zlibdir/$host/Makefile + $ic_dir/$host/Makefile + $asn1_dir/$host/Makefile + $runtime_tools_dir/$host/Makefile + $tools_dir/$host/Makefile + $orber_dir/$host/Makefile" + +for file in $CONFIG_FILES; do + new_name=`echo $file|sed "s%/$host/%/$target/%"` + dir=`echo $new_name|sed 's%/[^/][^/]*$%%'` + if test "$dir" != "$new_name" && test "$dir" != .; then + test ! -d "$dir" && mkdir "$dir" + fi + + sole_name=`echo $file|sed "s%.*$target/%%"` + in_file=`echo $dir|sed "s%/[^/][^/]*$%/$sole_name.in%"` + echo "creating $new_name" + sed -f vxworks/sed.$target -f vxworks/sed.general \ + -e "s,@HOST_TYPE@,$HOST_TYPE,g" \ + -e "s,@WIND_BASE@,$WIND_BASE,g" \ + -e "s,@TARGET@,$target,g" \ + $in_file > $new_name +done + + diff --git a/erts/autoconf/install-sh b/erts/autoconf/install-sh new file mode 100755 index 0000000000..a5897de6ea --- /dev/null +++ b/erts/autoconf/install-sh @@ -0,0 +1,519 @@ +#!/bin/sh +# install - install a program, script, or datafile + +scriptversion=2006-12-25.00 + +# This originates from X11R5 (mit/util/scripts/install.sh), which was +# later released in X11R6 (xc/config/util/install.sh) with the +# following copyright and license. +# +# Copyright (C) 1994 X Consortium +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN +# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- +# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the name of the X Consortium shall not +# be used in advertising or otherwise to promote the sale, use or other deal- +# ings in this Software without prior written authorization from the X Consor- +# tium. +# +# +# FSF changes to this file are in the public domain. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# `make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. + +nl=' +' +IFS=" "" $nl" + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit=${DOITPROG-} +if test -z "$doit"; then + doit_exec=exec +else + doit_exec=$doit +fi + +# Put in absolute file names if you don't have them in your path; +# or use environment vars. + +chgrpprog=${CHGRPPROG-chgrp} +chmodprog=${CHMODPROG-chmod} +chownprog=${CHOWNPROG-chown} +cmpprog=${CMPPROG-cmp} +cpprog=${CPPROG-cp} +mkdirprog=${MKDIRPROG-mkdir} +mvprog=${MVPROG-mv} +rmprog=${RMPROG-rm} +stripprog=${STRIPPROG-strip} + +posix_glob='?' +initialize_posix_glob=' + test "$posix_glob" != "?" || { + if (set -f) 2>/dev/null; then + posix_glob= + else + posix_glob=: + fi + } +' + +posix_mkdir= + +# Desired mode of installed file. +mode=0755 + +chgrpcmd= +chmodcmd=$chmodprog +chowncmd= +mvcmd=$mvprog +rmcmd="$rmprog -f" +stripcmd= + +src= +dst= +dir_arg= +dst_arg= + +copy_on_change=false +no_target_directory= + +usage="\ +Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE + or: $0 [OPTION]... SRCFILES... DIRECTORY + or: $0 [OPTION]... -t DIRECTORY SRCFILES... + or: $0 [OPTION]... -d DIRECTORIES... + +In the 1st form, copy SRCFILE to DSTFILE. +In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. +In the 4th, create DIRECTORIES. + +Options: + --help display this help and exit. + --version display version info and exit. + + -c (ignored) + -C install only if different (preserve the last data modification time) + -d create directories instead of installing files. + -g GROUP $chgrpprog installed files to GROUP. + -m MODE $chmodprog installed files to MODE. + -o USER $chownprog installed files to USER. + -s $stripprog installed files. + -t DIRECTORY install into DIRECTORY. + -T report an error if DSTFILE is a directory. + +Environment variables override the default commands: + CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG + RMPROG STRIPPROG +" + +while test $# -ne 0; do + case $1 in + -c) ;; + + -C) copy_on_change=true;; + + -d) dir_arg=true;; + + -g) chgrpcmd="$chgrpprog $2" + shift;; + + --help) echo "$usage"; exit $?;; + + -m) mode=$2 + case $mode in + *' '* | *' '* | *' +'* | *'*'* | *'?'* | *'['*) + echo "$0: invalid mode: $mode" >&2 + exit 1;; + esac + shift;; + + -o) chowncmd="$chownprog $2" + shift;; + + -s) stripcmd=$stripprog;; + + -t) dst_arg=$2 + shift;; + + -T) no_target_directory=true;; + + --version) echo "$0 $scriptversion"; exit $?;; + + --) shift + break;; + + -*) echo "$0: invalid option: $1" >&2 + exit 1;; + + *) break;; + esac + shift +done + +if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then + # When -d is used, all remaining arguments are directories to create. + # When -t is used, the destination is already specified. + # Otherwise, the last argument is the destination. Remove it from $@. + for arg + do + if test -n "$dst_arg"; then + # $@ is not empty: it contains at least $arg. + set fnord "$@" "$dst_arg" + shift # fnord + fi + shift # arg + dst_arg=$arg + done +fi + +if test $# -eq 0; then + if test -z "$dir_arg"; then + echo "$0: no input file specified." >&2 + exit 1 + fi + # It's OK to call `install-sh -d' without argument. + # This can happen when creating conditional directories. + exit 0 +fi + +if test -z "$dir_arg"; then + trap '(exit $?); exit' 1 2 13 15 + + # Set umask so as not to create temps with too-generous modes. + # However, 'strip' requires both read and write access to temps. + case $mode in + # Optimize common cases. + *644) cp_umask=133;; + *755) cp_umask=22;; + + *[0-7]) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw='% 200' + fi + cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; + *) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw=,u+rw + fi + cp_umask=$mode$u_plus_rw;; + esac +fi + +for src +do + # Protect names starting with `-'. + case $src in + -*) src=./$src;; + esac + + if test -n "$dir_arg"; then + dst=$src + dstdir=$dst + test -d "$dstdir" + dstdir_status=$? + else + + # Waiting for this to be detected by the "$cpprog $src $dsttmp" command + # might cause directories to be created, which would be especially bad + # if $src (and thus $dsttmp) contains '*'. + if test ! -f "$src" && test ! -d "$src"; then + echo "$0: $src does not exist." >&2 + exit 1 + fi + + if test -z "$dst_arg"; then + echo "$0: no destination specified." >&2 + exit 1 + fi + + dst=$dst_arg + # Protect names starting with `-'. + case $dst in + -*) dst=./$dst;; + esac + + # If destination is a directory, append the input filename; won't work + # if double slashes aren't ignored. + if test -d "$dst"; then + if test -n "$no_target_directory"; then + echo "$0: $dst_arg: Is a directory" >&2 + exit 1 + fi + dstdir=$dst + dst=$dstdir/`basename "$src"` + dstdir_status=0 + else + # Prefer dirname, but fall back on a substitute if dirname fails. + dstdir=` + (dirname "$dst") 2>/dev/null || + expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$dst" : 'X\(//\)[^/]' \| \ + X"$dst" : 'X\(//\)$' \| \ + X"$dst" : 'X\(/\)' \| . 2>/dev/null || + echo X"$dst" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q' + ` + + test -d "$dstdir" + dstdir_status=$? + fi + fi + + obsolete_mkdir_used=false + + if test $dstdir_status != 0; then + case $posix_mkdir in + '') + # Create intermediate dirs using mode 755 as modified by the umask. + # This is like FreeBSD 'install' as of 1997-10-28. + umask=`umask` + case $stripcmd.$umask in + # Optimize common cases. + *[2367][2367]) mkdir_umask=$umask;; + .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; + + *[0-7]) + mkdir_umask=`expr $umask + 22 \ + - $umask % 100 % 40 + $umask % 20 \ + - $umask % 10 % 4 + $umask % 2 + `;; + *) mkdir_umask=$umask,go-w;; + esac + + # With -d, create the new directory with the user-specified mode. + # Otherwise, rely on $mkdir_umask. + if test -n "$dir_arg"; then + mkdir_mode=-m$mode + else + mkdir_mode= + fi + + posix_mkdir=false + case $umask in + *[123567][0-7][0-7]) + # POSIX mkdir -p sets u+wx bits regardless of umask, which + # is incompatible with FreeBSD 'install' when (umask & 300) != 0. + ;; + *) + tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ + trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 + + if (umask $mkdir_umask && + exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 + then + if test -z "$dir_arg" || { + # Check for POSIX incompatibilities with -m. + # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or + # other-writeable bit of parent directory when it shouldn't. + # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. + ls_ld_tmpdir=`ls -ld "$tmpdir"` + case $ls_ld_tmpdir in + d????-?r-*) different_mode=700;; + d????-?--*) different_mode=755;; + *) false;; + esac && + $mkdirprog -m$different_mode -p -- "$tmpdir" && { + ls_ld_tmpdir_1=`ls -ld "$tmpdir"` + test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" + } + } + then posix_mkdir=: + fi + rmdir "$tmpdir/d" "$tmpdir" + else + # Remove any dirs left behind by ancient mkdir implementations. + rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null + fi + trap '' 0;; + esac;; + esac + + if + $posix_mkdir && ( + umask $mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" + ) + then : + else + + # The umask is ridiculous, or mkdir does not conform to POSIX, + # or it failed possibly due to a race condition. Create the + # directory the slow way, step by step, checking for races as we go. + + case $dstdir in + /*) prefix='/';; + -*) prefix='./';; + *) prefix='';; + esac + + eval "$initialize_posix_glob" + + oIFS=$IFS + IFS=/ + $posix_glob set -f + set fnord $dstdir + shift + $posix_glob set +f + IFS=$oIFS + + prefixes= + + for d + do + test -z "$d" && continue + + prefix=$prefix$d + if test -d "$prefix"; then + prefixes= + else + if $posix_mkdir; then + (umask=$mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break + # Don't fail if two instances are running concurrently. + test -d "$prefix" || exit 1 + else + case $prefix in + *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; + *) qprefix=$prefix;; + esac + prefixes="$prefixes '$qprefix'" + fi + fi + prefix=$prefix/ + done + + if test -n "$prefixes"; then + # Don't fail if two instances are running concurrently. + (umask $mkdir_umask && + eval "\$doit_exec \$mkdirprog $prefixes") || + test -d "$dstdir" || exit 1 + obsolete_mkdir_used=true + fi + fi + fi + + if test -n "$dir_arg"; then + { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && + { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || + test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 + else + + # Make a couple of temp file names in the proper directory. + dsttmp=$dstdir/_inst.$$_ + rmtmp=$dstdir/_rm.$$_ + + # Trap to clean up those temp files at exit. + trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 + + # Copy the file name to the temp name. + (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && + + # and set any options; do chmod last to preserve setuid bits. + # + # If any of these fail, we abort the whole thing. If we want to + # ignore errors from any of these, just make sure not to ignore + # errors from the above "$doit $cpprog $src $dsttmp" command. + # + { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && + { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && + { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && + + # If -C, don't bother to copy if it wouldn't change the file. + if $copy_on_change && + old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && + new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && + + eval "$initialize_posix_glob" && + $posix_glob set -f && + set X $old && old=:$2:$4:$5:$6 && + set X $new && new=:$2:$4:$5:$6 && + $posix_glob set +f && + + test "$old" = "$new" && + $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 + then + rm -f "$dsttmp" + else + # Rename the file to the real destination. + $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || + + # The rename failed, perhaps because mv can't rename something else + # to itself, or perhaps because mv is so ancient that it does not + # support -f. + { + # Now remove or move aside any old file at destination location. + # We try this two ways since rm can't unlink itself on some + # systems and the destination file might be busy for other + # reasons. In this case, the final cleanup might fail but the new + # file should still install successfully. + { + test ! -f "$dst" || + $doit $rmcmd -f "$dst" 2>/dev/null || + { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && + { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } + } || + { echo "$0: cannot unlink or rename $dst" >&2 + (exit 1); exit 1 + } + } && + + # Now rename the file to the real destination. + $doit $mvcmd "$dsttmp" "$dst" + } + fi || exit 1 + + trap '' 0 + fi +done + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-end: "$" +# End: diff --git a/erts/autoconf/vxworks/sed.general b/erts/autoconf/vxworks/sed.general new file mode 100644 index 0000000000..f725a6f9ca --- /dev/null +++ b/erts/autoconf/vxworks/sed.general @@ -0,0 +1,125 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Patrik Winroth +# +# This sed program file is intended to be used when creating Makefiles +# for vxworks from the generic Makefile.in that is found in a number +# of directories (see configure.vxworks). +# +# This is the general part that is common for all architectures. +# + +# Size of data types. +s|^#undef SIZEOF_CHAR|#define SIZEOF_CHAR 1| +s|^#undef SIZEOF_SHORT|#define SIZEOF_SHORT 2| +s|^#undef SIZEOF_INT|#define SIZEOF_INT 4| +s|^#undef SIZEOF_LONG_LONG|#define SIZEOF_LONG_LONG 8| +s|^#undef SIZEOF_LONG$|#define SIZEOF_LONG 4| + +# General stuff. +s|@erts_rootdir@|/clearcase/otp/erts| + +s|@LIBOBJS@|$(OBJDIR)/elib_malloc.o| +s|@DLOAD_LIB@|| +s|@LDFLAGS@|| +# FIXME: A bit strange to clear out remaining DED_* +s|@DED_LDFLAGS@|| +s|@DED_CFLAGS@|| +s|@STATIC_CFLAGS@|| +s|@GCCLIB@|libgcc.a| +s|@DEFS@|| +s|@DEXPORT@|| +s|@DCFLAGS@|| +s|@THR_DEFS@|| +s|@THR_LIBS@|| +s|@THR_LIB_NAME@|| +s|@THR_X_LIBS@|| +s|@ETHR_X_LIBS@|| +s|@ETHR_LIBS@|| +s|@ETHR_LIB_NAME@|| +s|@ETHR_DEFS@|| +s|@ETHR_THR_LIB_BASE@|| +s|@EMU_THR_DEFS@|| +s|@EMU_THR_LIBS@|| +s|@EMU_THR_LIB_NAME@|ethread| +s|@ERTS_ENABLE_KERNEL_POLL@|no| +s|@cc_root@|/clearcase/otp/| +# Define VxWorks even though cross-compiling. +s|@HCFLAGS@|-DVXWORKS| +s|@HCLIBS@|| +s|@ENABLE_ALLOC_TYPE_VARS@|| +s|@TERMCAP_LIB@|| +s|@ERTS_BUILD_SMP_EMU@|no| +s|@ERTS_BUILD_HYBRID_EMU@|no| +s|@HAVE_VALGRIND@|no| +s|@EXEEXT@|| +s|@WITH_SCTP@|| + +# HiPE +s|@HIPE_ENABLED@|| +s|@PERFCTR_PATH@|| +s|@USE_PERFCTR@|| + +# m4 +s|@OPSYS@|noopsys| + +# Conditional inclusion of applications +s|@HIPE_APP@|| +s|@SSL_APP@|ssl| +s|@CRYPTO_APP@|crypto| +s|@SSH_APP@|ssh| + +# The target tools prefix, prepended to all cc,ld,as etc commands +s|@TTPREFIX@|GCC_EXEC_PREFIX=@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/host/@HOST_TYPE@/bin/| + +# Install programs etc +s|@PERL@|perl| +s|@INSTALL@|/usr/ucb/install -c| +s|@INSTALL_PROGRAM@|${INSTALL}| +s|@INSTALL_SCRIPT@|${INSTALL}| +s|@INSTALL_DATA@|${INSTALL} -m 644| +s|@INSTALL_DIR@|$(INSTALL) -d| +s|@RM@|/bin/rm| +s|@MKDIR@|/bin/mkdir| +s|@ERLANG_OSTYPE@|vxworks| +s|@vxworks_reclaim@|reclaim.h| +s|@os_mon_programs@|| +s|@erlexec@|erl.exec| +s|@EMU_LIBOBJS@|| + +# General CFLAGS +s|@GENERAL_CFLAGS@|-DHAVE_LOCALTIME_R -DHAVE_GMTIME_R -DENABLE_ELIB_MALLOC -DELIB_HEAP_USER -DELIB_SORTED_BLOCKS -DWORDS_BIGENDIAN -DELIB_DONT_INITIALIZE -DSIZEOF_CHAR=1 -DSIZEOF_SHORT=2 -DSIZEOF_INT=4 -DSIZEOF_LONG=4 -DSIZEOF_LONG_LONG=8 -DSIZEOF_VOID_P=4 -DERTS_USE_PORT_TASKS=1|g +s|@WFLAGS@|| + +# Thread flags for eidefs.mk (erl_interface) +s|@EI_THREADS@|false| + +# Make java code compile although we don't test it on VxWorks (no license) +s|@JAVAC@|javac| + +# What is this anyway? +# Disable it and see what breaks. +#s|@ded_soname@|| + +# Only variable substituted directly +s|$(LDFLAGS)|-r -d| +s|@LIBRT@|| +# XXX What is EFFLAGS? Not used in the emulator Makefile.in anyway. +s|$(EFLAGS)|-DENABLE_ELIB_MALLOC -DELIB_HEAP_USER -DELIB_SORTED_BLOCKS| + diff --git a/erts/autoconf/vxworks/sed.vxworks_cpu32 b/erts/autoconf/vxworks/sed.vxworks_cpu32 new file mode 100644 index 0000000000..171341db63 --- /dev/null +++ b/erts/autoconf/vxworks/sed.vxworks_cpu32 @@ -0,0 +1,42 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Patrik Winroth +# +# This sed program file is intended to be used when creating Makefiles for vxworks +# from the generic Makefile.in that is found in a number of directories (see configure.vxworks) +# +# +# +s|@host@|vxworks_cpu32| +s|@system_type@|vxworks_cpu32| +s|@CC@|@TTPREFIX@cc68k| +s|@HCC@|gcc| +s|@LD@|@TTPREFIX@ld68k| +s|@LIBS@|| +s|@DED_LD@|@TTPREFIX@ld68k| +s|@DED_CFLAGS@|@CFLAGS@| +s|@DEBUG_FLAGS@|-g| +s|@GCCLIB_PATH@|@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/m68k-wrs-vxworks/cygnus-2.7.2-960126/m68000/msoft-float/libgcc.a| +s|@RANLIB@|@TTPREFIX@ranlib68k| +s|@AR@|@TTPREFIX@ar68k| +s|@STRIP@|@TTPREFIX@strip68k| +s|@SYMPREFIX@|_| +s|@GCCLIBFLAGS@|-L@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/m68k-wrs-vxworks/cygnus-2.7.2-960126/m68000/msoft-float -lgcc| +s|@CFLAGS@|@GENERAL_CFLAGS@ -DCPU=CPU32 -mnobitfield -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/target/h -fno-builtin -nostdinc -fvolatile -msoft-float| +s|@LIB_CFLAGS@|@GENERAL_CFLAGS@ -DCPU=CPU32 -mnobitfield -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/target/h -fno-builtin -nostdinc -fvolatile -msoft-float| diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc32 b/erts/autoconf/vxworks/sed.vxworks_ppc32 new file mode 100644 index 0000000000..a1067ea575 --- /dev/null +++ b/erts/autoconf/vxworks/sed.vxworks_ppc32 @@ -0,0 +1,48 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Peter Andersson +# +# This sed program file is intended to be used when creating Makefiles for vxworks +# from the generic Makefile.in that is found in a number of directories (see configure.vxworks) +# +# +# +s|@host@|vxworks_ppc32| +s|@system_type@|vxworks_ppc32| +s|@ARCH@|ppc32| +s|@CC@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ccppc -mlongcall| +s|@HCC@|gcc| +s|@LD@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ldppc| +s|@STRIP@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/workbench-2.3/@HOST_TYPE@/bin/stripppc| +s|@SYMPREFIX@|| +s|@LIBS@|| +s|@GCCLIBFLAGS@|-L@WIND_BASE@/vxworks-6.3/target/lib/ppc/PPC32/common -lgcc| +s|@DED_LD@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ldppc| +s|@DED_CFLAGS@|@CFLAGS@| +s|@DEBUG_CFLAGS@|@CFLAGS@| +# generate dwarf debug code on PPC .. +s|@DEBUG_FLAGS@|-gdwarf| +# remove -g option +s|TYPE_FLAGS = -g |TYPE_FLAGS = | +s|@GCCLIB_PATH@|@WIND_BASE@/vxworks-6.3/target/lib/ppc/PPC32/common/libgcc.a| +s|@RANLIB@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ranlibppc| +s|@AR@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/arppc| +# -Dasm(X)= is for beam +s|@CFLAGS@|@GENERAL_CFLAGS@ -DCPU=PPC32 -DTOOL_FAMILY=gnu -DTOOL=gnu -DWANT_NONBLOCKING -DHAVE_SENS -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/vxworks-6.3/target/h -I@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc/powerpc-wrs-vxworks/3.4.4/include -I@WIND_BASE@/vxworks-6.3/target/h/wrn/coreip -mstrict-align -fvolatile -fno-builtin | +s|@LIB_CFLAGS@|@GENERAL_CFLAGS@ -DCPU=PPC32 -DTOOL_FAMILY=gnu -DTOOL=gnu -DWANT_NONBLOCKING -DHAVE_SENS -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/vxworks-6.3/target/h/wrn/coreip -I@WIND_BASE@/vxworks-6.3/target/h -mstrict-align -fvolatile -fno-builtin | diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc603 b/erts/autoconf/vxworks/sed.vxworks_ppc603 new file mode 100644 index 0000000000..97f0429847 --- /dev/null +++ b/erts/autoconf/vxworks/sed.vxworks_ppc603 @@ -0,0 +1,48 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2000-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Patrik Winroth +# +# This sed program file is intended to be used when creating Makefiles for vxworks +# from the generic Makefile.in that is found in a number of directories (see configure.vxworks) +# +# +# +s|@host@|vxworks_ppc603| +s|@system_type@|vxworks_ppc603| +s|@ARCH@|ppc603| +s|@CC@|@TTPREFIX@ccppc -mlongcall| +s|@HCC@|gcc| +s|@LD@|@TTPREFIX@ldppc| +s|@STRIP@|@TTPREFIX@stripppc| +s|@SYMPREFIX@|| +s|@LIBS@|| +s|@GCCLIBFLAGS@|-L@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/powerpc-wrs-vxworks/cygnus-2.7.2-960126 -lgcc| +s|@DED_LD@|@TTPREFIX@ldppc| +s|@DED_CFLAGS@|@CFLAGS@| +s|@DEBUG_CFLAGS@|@CFLAGS@| +# generate dwarf debug code on PPC .. +s|@DEBUG_FLAGS@|-gdwarf| +# remove -g option +s|TYPE_FLAGS = -g |TYPE_FLAGS = | +s|@GCCLIB_PATH@|@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/powerpc-wrs-vxworks/cygnus-2.7.2-960126/libgcc.a| +s|@RANLIB@|@TTPREFIX@ranlibppc| +s|@AR@|@TTPREFIX@arppc| +# -Dasm(X)= is for beam +s|@CFLAGS@|@GENERAL_CFLAGS@ -DCPU=PPC603 -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/target/h -mstrict-align -fvolatile -fno-builtin -fno-for-scope -D_GNU_TOOL| +s|@LIB_CFLAGS@|@GENERAL_CFLAGS@ -DCPU=PPC603 -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/target/h -mstrict-align -fvolatile -fno-builtin -fno-for-scope -D_GNU_TOOL| diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc603_nolongcall b/erts/autoconf/vxworks/sed.vxworks_ppc603_nolongcall new file mode 100644 index 0000000000..8968498c44 --- /dev/null +++ b/erts/autoconf/vxworks/sed.vxworks_ppc603_nolongcall @@ -0,0 +1,48 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Patrik Winroth +# +# This sed program file is intended to be used when creating Makefiles for vxworks +# from the generic Makefile.in that is found in a number of directories (see configure.vxworks) +# +# +# +s|@host@|vxworks_ppc603| +s|@system_type@|vxworks_ppc603| +s|@ARCH@|ppc603| +s|@CC@|@TTPREFIX@ccppc| +s|@HCC@|gcc| +s|@LD@|@TTPREFIX@ldppc| +s|@STRIP@|@TTPREFIX@stripppc| +s|@SYMPREFIX@|| +s|@LIBS@|| +s|@GCCLIBFLAGS@|-L@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/powerpc-wrs-vxworks/cygnus-2.7.2-960126 -lgcc| +s|@DED_LD@|@TTPREFIX@ldppc| +s|@DED_CFLAGS@|@CFLAGS@| +# generate dwarf debug code on PPC .. +s|@DEBUG_FLAGS@|-gdwarf| +# remove -g option +s|TYPE_FLAGS = -g |TYPE_FLAGS = | +s|@GCCLIB_PATH@|@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/powerpc-wrs-vxworks/cygnus-2.7.2-960126/libgcc.a| +s|@RANLIB@|@TTPREFIX@ranlibppc| +s|@AR@|@TTPREFIX@arppc| +# -Dasm(X)= is for beam +s|@CFLAGS@|@GENERAL_CFLAGS@ -DCPU=PPC603 -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/target/h -mstrict-align -fvolatile -fno-builtin -fno-for-scope -D_GNU_TOOL| +s|@LIB_CFLAGS@|@GENERAL_CFLAGS@ -DCPU=PPC603 -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/target/h -mstrict-align -fvolatile -fno-builtin -fno-for-scope -D_GNU_TOOL| + diff --git a/erts/autoconf/vxworks/sed.vxworks_ppc860 b/erts/autoconf/vxworks/sed.vxworks_ppc860 new file mode 100644 index 0000000000..35771335a3 --- /dev/null +++ b/erts/autoconf/vxworks/sed.vxworks_ppc860 @@ -0,0 +1,47 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Patrik Winroth +# +# This sed program file is intended to be used when creating Makefiles for vxworks +# from the generic Makefile.in that is found in a number of directories (see configure.vxworks) +# +# +# +s|@host@|vxworks_ppc860| +s|@system_type@|vxworks_ppc860| +s|@ARCH@|ppc860| +s|@CC@|@TTPREFIX@ccppc -mlongcall| +s|@HCC@|gcc| +s|@LD@|@TTPREFIX@ldppc| +s|@STRIP@|@TTPREFIX@stripppc| +s|@SYMPREFIX@|| +s|@LIBS@|| +s|@GCCLIBFLAGS@|-L@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/powerpc-wrs-vxworks/cygnus-2.7.2-960126/soft-float -lgcc| +s|@DED_LD@|@TTPREFIX@ldppc| +s|@DED_CFLAGS@|@CFLAGS@| +s|@DEBUG_CFLAGS@|@CFLAGS@| +# generate dwarf debug code on PPC .. +s|@DEBUG_FLAGS@|-gdwarf| +# remove -g option (go for dwarf) +s|TYPE_FLAGS = -g |TYPE_FLAGS = | +s|@GCCLIB_PATH@|@WIND_BASE@/host/@HOST_TYPE@/lib/gcc-lib/powerpc-wrs-vxworks/cygnus-2.7.2-960126/soft-float/libgcc.a| +s|@RANLIB@|@TTPREFIX@ranlibppc| +s|@AR@|@TTPREFIX@arppc| +s|@CFLAGS@|@GENERAL_CFLAGS@ -DCPU=PPC860 -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/target/h -mcpu=860 -fvolatile -fno-builtin -fno-for-scope -msoft-float -D_GNU_TOOL -nostdinc| +s|@LIB_CFLAGS@|@GENERAL_CFLAGS@ -DCPU=PPC860 -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DVXWORKS -I@WIND_BASE@/target/h -mcpu=powerpc -fvolatile -fno-builtin -fno-for-scope -msoft-float -D_GNU_TOOL -nostdinc| diff --git a/erts/autoconf/vxworks/sed.vxworks_simlinux b/erts/autoconf/vxworks/sed.vxworks_simlinux new file mode 100644 index 0000000000..b629296caa --- /dev/null +++ b/erts/autoconf/vxworks/sed.vxworks_simlinux @@ -0,0 +1,57 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2008-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Peter Andersson +# +# This sed program file is intended to be used when creating Makefiles for vxworks +# from the generic Makefile.in that is found in a number of directories (see configure.vxworks) +# +# +# +s|@host@|vxworks_simlinux| +s|@system_type@|vxworks_simlinux| +s|@ARCH@|simlinux| + +s|@CC@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ccpentium| + +s|@HCC@|gcc| + +s|@LD@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ldpentium| + +#s|@STRIP@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/strip| +s|@STRIP@|| + +s|@SYMPREFIX@|| +s|@LIBS@|| +s|@GCCLIBFLAGS@|-L@WIND_BASE@/vxworks-6.3/target/lib/simlinux/SIMLINUX/common -lgcc| + +s|@DED_LD@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ldpentium| + +s|@DED_CFLAGS@|@CFLAGS@| +s|@DEBUG_CFLAGS@|@CFLAGS@| +# remove -g option +s|TYPE_FLAGS = -g |TYPE_FLAGS = | +s|@GCCLIB_PATH@|@WIND_BASE@/vxworks-6.3/target/lib/simlinux/SIMLINUX/common/libgcc.a| + +s|@RANLIB@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ranlibpentium| + +s|@AR@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/arpentium| + +# -Dasm(X)= is for beam +s|@CFLAGS@|@GENERAL_CFLAGS@ -DCPU=SIMLINUX -DTOOL_FAMILY=gnu -DTOOL=gnu -DWANT_NONBLOCKING -DHAVE_SENS -DHAVE_MEMMOVE -DVXWORKS -DDEBUG -I@WIND_BASE@/vxworks-6.3/target/h -I@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc/i586-wrs-vxworks/3.4.4/include -I@WIND_BASE@/vxworks-6.3/target/h/wrn/coreip -fvolatile -fno-builtin | +s|@LIB_CFLAGS@|@GENERAL_CFLAGS@ -DCPU=SIMLINUX -DTOOL_FAMILY=gnu -DTOOL=gnu -DWANT_NONBLOCKING -DHAVE_SENS -DHAVE_MEMMOVE -DVXWORKS -DDEBUG -I@WIND_BASE@/vxworks-6.3/target/h -I@WIND_BASE@/vxworks-6.3/target/h/wrn/coreip -mstrict-align -fvolatile -fno-builtin | diff --git a/erts/autoconf/vxworks/sed.vxworks_simso b/erts/autoconf/vxworks/sed.vxworks_simso new file mode 100644 index 0000000000..e67abd3be1 --- /dev/null +++ b/erts/autoconf/vxworks/sed.vxworks_simso @@ -0,0 +1,62 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Peter Andersson +# +# This sed program file is intended to be used when creating Makefiles for vxworks +# from the generic Makefile.in that is found in a number of directories (see configure.vxworks) +# +# +# +s|@host@|vxworks_simso| +s|@system_type@|vxworks_simso| +s|@ARCH@|simso| + +# Tornado2.2: s|@CC@|@TTPREFIX@ccsimso| +s|@CC@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ccsparc| + +s|@HCC@|gcc| + +# Tornado2.2: s|@LD@|@TTPREFIX@ldsimso| +s|@LD@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ldsparc| + +# Tornado2.2: s|@STRIP@|@TTPREFIX@stripsimso| +s|@STRIP@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/stripsparc| + +s|@SYMPREFIX@|| +s|@LIBS@|| +s|@GCCLIBFLAGS@|-L@WIND_BASE@/vxworks-6.3/target/lib/simso/SIMSPARCSOLARIS/common -lgcc| + +# Tornado2.2: s|@DED_LD@|@TTPREFIX@ldsimso| +s|@DED_LD@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ldsparc| + +s|@DED_CFLAGS@|@CFLAGS@| +s|@DEBUG_CFLAGS@|@CFLAGS@| +# remove -g option +s|TYPE_FLAGS = -g |TYPE_FLAGS = | +s|@GCCLIB_PATH@|@WIND_BASE@/vxworks-6.3/target/lib/simso/SIMSPARCSOLARIS/common/libgcc.a| + +# Tornado2.2: s|@RANLIB@|@TTPREFIX@ranlibsimso| +s|@RANLIB@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/ranlibsparc| + +# Tornado2.2: s|@AR@|arsimso| +s|@AR@|GCC_EXEC_PREFIX=@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc-lib/ @WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/bin/arsparc| + +# -Dasm(X)= is for beam +s|@CFLAGS@|@GENERAL_CFLAGS@ -DCPU=SIMSPARCSOLARIS -DTOOL_FAMILY=gnu -DTOOL=gnu -DWANT_NONBLOCKING -DHAVE_SENS -DHAVE_MEMMOVE -DVXWORKS -DDEBUG -I@WIND_BASE@/vxworks-6.3/target/h -I@WIND_BASE@/gnu/3.4.4-vxworks-6.3/@HOST_TYPE@/lib/gcc/sparc-wrs-vxworks/3.4.4/include -I@WIND_BASE@/vxworks-6.3/target/h/wrn/coreip -fvolatile -fno-builtin | +s|@LIB_CFLAGS@|@GENERAL_CFLAGS@ -DCPU=SIMSPARCSOLARIS -DTOOL_FAMILY=gnu -DTOOL=gnu -DWANT_NONBLOCKING -DHAVE_SENS -DHAVE_MEMMOVE -DVXWORKS -DDEBUG -I@WIND_BASE@/vxworks-6.3/target/h -I@WIND_BASE@/vxworks-6.3/target/h/wrn/coreip -mstrict-align -fvolatile -fno-builtin | diff --git a/erts/autoconf/vxworks/sed.vxworks_sparc b/erts/autoconf/vxworks/sed.vxworks_sparc new file mode 100644 index 0000000000..ae26f234d2 --- /dev/null +++ b/erts/autoconf/vxworks/sed.vxworks_sparc @@ -0,0 +1,38 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Author: Patrik Winroth +# +# This sed program file is intended to be used when creating Makefiles for vxworks +# from the generic Makefile.in that is found in a number of directories (see configure.vxworks) +# + +# ccsparc -O2 doesn't work when compiling "rundir"/gc.c - signal 11 is generated when trying +# therefore it is compiled with -O1 instead, which works - get a new ccsparc ! +s/\$(COMPILE\.emu) -o \$@ -c gc\.c/$(CC) @CFLAGS@ @DEFS@ -O1 $(BEAM_MODE) -I$(SYSDIR) -I$(EMUDIR) -I. $(CPPFLAGS) -c -o $@ -c gc.c/ +s/@host@/vxworks_sparc/ +s/@system_type@/vxworks_sparc/ +s/@CC@/\/home\/gandalf\/bsproj\/tools\/vw-gnu\/solaris.sparc\/bin\/ccsparc/ +s/@HCC@/gcc/ +s/@LD@/\/home\/gandalf\/bsproj\/tools\/vw-gnu\/solaris.sparc\/bin\/ldsparc/ +s/@DEBUG_FLAGS@/-g/ +s/@GCCLIB_PATH@/\/home\/gandalf\/bsproj\/tools\/vw-gnu\/solaris.sparc\/lib\/gcc-lib\/sparc-wrs-vxworks\/cygnus-2.2.3.1\/libgcc.a/ +s/@RANLIB@/ranlibsparc/ +s/@AR@/arsparc/ +s/@CFLAGS@/-I\/home\/gandalf\/bsproj\/BS.2\/UOS\/vw\/5.2\/h -DWANT_NONBLOCKING -DHAVE_MEMMOVE -DCPU=SPARC -DVXWORKS -fno-builtin -nostdinc/ + diff --git a/erts/autoconf/win32.config.cache b/erts/autoconf/win32.config.cache new file mode 100755 index 0000000000..51cfa13785 --- /dev/null +++ b/erts/autoconf/win32.config.cache @@ -0,0 +1,233 @@ +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +ac_cv_c_bigendian=${ac_cv_c_bigendian=no} +ac_cv_c_compiler_gnu=${ac_cv_c_compiler_gnu=no} +ac_cv_c_const=${ac_cv_c_const=yes} +ac_cv_cxx_compiler_gnu=${ac_cv_cxx_compiler_gnu=no} +ac_cv_decl_h_errno=${ac_cv_decl_h_errno=no} +ac_cv_decl_inaddr_loopback=${ac_cv_decl_inaddr_loopback=no} +ac_cv_decl_inaddr_loopback_rpc=${ac_cv_decl_inaddr_loopback_rpc=no} +ac_cv_decl_inaddr_loopback_winsock2=${ac_cv_decl_inaddr_loopback_winsock2=yes} +ac_cv_decl_so_bsdcompat=${ac_cv_decl_so_bsdcompat=no} +ac_cv_decl_sys_errlist=${ac_cv_decl_sys_errlist=no} +ac_cv_env_CC_set=set +ac_cv_env_CC_value=cc.sh +ac_cv_env_CFLAGS_set= +ac_cv_env_CFLAGS_value= +ac_cv_env_CPPFLAGS_set= +ac_cv_env_CPPFLAGS_value= +ac_cv_env_CPP_set= +ac_cv_env_CPP_value= +ac_cv_env_CXXFLAGS_set= +ac_cv_env_CXXFLAGS_value= +ac_cv_env_CXX_set=set +ac_cv_env_CXX_value=cc.sh +ac_cv_env_LDFLAGS_set= +ac_cv_env_LDFLAGS_value= +ac_cv_env_build_alias_set=set +ac_cv_env_build_alias_value=win32 +ac_cv_env_host_alias_set=set +ac_cv_env_host_alias_value=win32 +ac_cv_env_target_alias_set=set +ac_cv_env_target_alias_value=win32 +ac_cv_exeext=${ac_cv_exeext=.exe} +ac_cv_func___brk=${ac_cv_func___brk=no} +ac_cv_func___sbrk=${ac_cv_func___sbrk=no} +ac_cv_func__brk=${ac_cv_func__brk=no} +ac_cv_func__doprnt=${ac_cv_func__doprnt=no} +ac_cv_func__sbrk=${ac_cv_func__sbrk=no} +ac_cv_func_accept=${ac_cv_func_accept=no} +ac_cv_func_alloca_works=${ac_cv_func_alloca_works=yes} +ac_cv_func_brk=${ac_cv_func_brk=no} +ac_cv_func_clock_gettime=${ac_cv_func_clock_gettime=no} +ac_cv_func_connect=${ac_cv_func_connect=no} +ac_cv_func_decl_fread=${ac_cv_func_decl_fread=no} +ac_cv_func_dlopen=${ac_cv_func_dlopen=no} +ac_cv_func_dup2=${ac_cv_func_dup2=yes} +ac_cv_func_finite=${ac_cv_func_finite=no} +ac_cv_func_flockfile=${ac_cv_func_flockfile=no} +ac_cv_func_fork=${ac_cv_func_fork=no} +ac_cv_func_fork_works=${ac_cv_func_fork_works=no} +ac_cv_func_fpsetmask=${ac_cv_func_fpsetmask=no} +ac_cv_func_fstat=${ac_cv_func_fstat=yes} +ac_cv_func_getaddrinfo=${ac_cv_func_getaddrinfo=no} +ac_cv_func_gethostbyaddr=${ac_cv_func_gethostbyaddr=no} +ac_cv_func_gethostbyaddr_r=${ac_cv_func_gethostbyaddr_r=no} +ac_cv_func_gethostbyname=${ac_cv_func_gethostbyname=no} +ac_cv_func_gethostbyname2=${ac_cv_func_gethostbyname2=no} +ac_cv_func_gethostbyname_r=${ac_cv_func_gethostbyname_r=no} +ac_cv_func_gethostname=${ac_cv_func_gethostname=no} +ac_cv_func_gethrtime=${ac_cv_func_gethrtime=no} +ac_cv_func_getipnodebyaddr=${ac_cv_func_getipnodebyaddr=no} +ac_cv_func_getipnodebyname=${ac_cv_func_getipnodebyname=no} +ac_cv_func_getnameinfo=${ac_cv_func_getnameinfo=no} +ac_cv_func_getpagesize=${ac_cv_func_getpagesize=no} +ac_cv_func_gettimeofday=${ac_cv_func_gettimeofday=no} +ac_cv_func_gmtime_r=${ac_cv_func_gmtime_r=no} +ac_cv_func_ieee_handler=${ac_cv_func_ieee_handler=no} +ac_cv_func_inet_ntoa=${ac_cv_func_inet_ntoa=no} +ac_cv_func_isinf=${ac_cv_func_isinf=no} +ac_cv_func_isnan=${ac_cv_func_isnan=no} +ac_cv_func_localtime_r=${ac_cv_func_localtime_r=no} +ac_cv_func_mallopt=${ac_cv_func_mallopt=no} +ac_cv_func_memchr=${ac_cv_func_memchr=yes} +ac_cv_func_memcmp_working=${ac_cv_func_memcmp_working=yes} +ac_cv_func_memcpy=${ac_cv_func_memcpy=yes} +ac_cv_func_memmove=${ac_cv_func_memmove=yes} +ac_cv_func_memset=${ac_cv_func_memset=yes} +ac_cv_func_mmap_fixed_mapped=${ac_cv_func_mmap_fixed_mapped=no} +ac_cv_func_mremap=${ac_cv_func_mremap=no} +ac_cv_func_nl_langinfo=${ac_cv_func_nl_langinfo=no} +ac_cv_func_openpty=${ac_cv_func_openpty=no} +ac_cv_func_posix2time=${ac_cv_func_posix2time=no} +ac_cv_func_pread=${ac_cv_func_pread=no} +ac_cv_func_pwrite=${ac_cv_func_pwrite=no} +ac_cv_func_res_gethostbyname=${ac_cv_func_res_gethostbyname=no} +ac_cv_func_sbrk=${ac_cv_func_sbrk=no} +ac_cv_func_select=${ac_cv_func_select=no} +ac_cv_func_setlocale=${ac_cv_func_setlocale=yes} +ac_cv_func_setsid=${ac_cv_func_setsid=no} +ac_cv_func_setvbuf_reversed=${ac_cv_func_setvbuf_reversed=yes} +ac_cv_func_socket=${ac_cv_func_socket=no} +ac_cv_func_strchr=${ac_cv_func_strchr=yes} +ac_cv_func_strerror=${ac_cv_func_strerror=yes} +ac_cv_func_strerror_r=${ac_cv_func_strerror_r=no} +ac_cv_func_strlcat=${ac_cv_func_strlcat=no} +ac_cv_func_strlcpy=${ac_cv_func_strlcpy=no} +ac_cv_func_strncasecmp=${ac_cv_func_strncasecmp=no} +ac_cv_func_strrchr=${ac_cv_func_strrchr=yes} +ac_cv_func_strstr=${ac_cv_func_strstr=yes} +ac_cv_func_uname=${ac_cv_func_uname=no} +ac_cv_func_vfork=${ac_cv_func_vfork=no} +ac_cv_func_vfork_works=${ac_cv_func_vfork_works=no} +ac_cv_func_vprintf=${ac_cv_func_vprintf=yes} +ac_cv_func_writev=${ac_cv_func_writev=no} +ac_cv_header_arpa_inet_h=${ac_cv_header_arpa_inet_h=no} +ac_cv_header_arpa_nameser_h=${ac_cv_header_arpa_nameser_h=no} +ac_cv_header_dirent_dirent_h=${ac_cv_header_dirent_dirent_h=no} +ac_cv_header_dirent_ndir_h=${ac_cv_header_dirent_ndir_h=no} +ac_cv_header_dirent_sys_dir_h=${ac_cv_header_dirent_sys_dir_h=no} +ac_cv_header_dirent_sys_ndir_h=${ac_cv_header_dirent_sys_ndir_h=no} +ac_cv_header_dlfcn_h=${ac_cv_header_dlfcn_h=no} +ac_cv_header_fcntl_h=${ac_cv_header_fcntl_h=yes} +ac_cv_header_gl_gl_h=${ac_cv_header_gl_gl_h=yes} +ac_cv_header_ieeefp_h=${ac_cv_header_ieeefp_h=no} +ac_cv_header_inttypes_h=${ac_cv_header_inttypes_h=no} +ac_cv_header_langinfo_h=${ac_cv_header_langinfo_h=no} +ac_cv_header_limits_h=${ac_cv_header_limits_h=yes} +ac_cv_header_mach_o_dyld_h=${ac_cv_header_mach_o_dyld_h=no} +ac_cv_header_malloc_h=${ac_cv_header_malloc_h=yes} +ac_cv_header_memory_h=${ac_cv_header_memory_h=yes} +ac_cv_header_net_errno_h=${ac_cv_header_net_errno_h=no} +ac_cv_header_netdb_h=${ac_cv_header_netdb_h=no} +ac_cv_header_netinet_in_h=${ac_cv_header_netinet_in_h=no} +ac_cv_header_pty_h=${ac_cv_header_pty_h=no} +ac_cv_header_stdc=${ac_cv_header_stdc=yes} +ac_cv_header_stddef_h=${ac_cv_header_stddef_h=yes} +ac_cv_header_stdint_h=${ac_cv_header_stdint_h=no} +ac_cv_header_stdlib_h=${ac_cv_header_stdlib_h=yes} +ac_cv_header_string_h=${ac_cv_header_string_h=yes} +ac_cv_header_strings_h=${ac_cv_header_strings_h=no} +ac_cv_header_sys_devpoll_h=${ac_cv_header_sys_devpoll_h=no} +ac_cv_header_sys_epoll_h=${ac_cv_header_sys_epoll_h=no} +ac_cv_header_sys_event_h=${ac_cv_header_sys_event_h=no} +ac_cv_header_sys_ioctl_h=${ac_cv_header_sys_ioctl_h=no} +ac_cv_header_sys_param_h=${ac_cv_header_sys_param_h=no} +ac_cv_header_sys_select_h=${ac_cv_header_sys_select_h=no} +ac_cv_header_sys_socket_h=${ac_cv_header_sys_socket_h=no} +ac_cv_header_sys_socketio_h=${ac_cv_header_sys_socketio_h=no} +ac_cv_header_sys_sockio_h=${ac_cv_header_sys_sockio_h=no} +ac_cv_header_sys_stat_h=${ac_cv_header_sys_stat_h=yes} +ac_cv_header_sys_stropts_h=${ac_cv_header_sys_stropts_h=no} +ac_cv_header_sys_sysctl_h=${ac_cv_header_sys_sysctl_h=no} +ac_cv_header_sys_time_h=${ac_cv_header_sys_time_h=no} +ac_cv_header_sys_types_h=${ac_cv_header_sys_types_h=yes} +ac_cv_header_sys_uio_h=${ac_cv_header_sys_uio_h=no} +ac_cv_header_sys_wait_h=${ac_cv_header_sys_wait_h=no} +ac_cv_header_syslog_h=${ac_cv_header_syslog_h=no} +ac_cv_header_time=${ac_cv_header_time=no} +ac_cv_header_unistd_h=${ac_cv_header_unistd_h=no} +ac_cv_header_util_h=${ac_cv_header_util_h=no} +ac_cv_header_utmp_h=${ac_cv_header_utmp_h=no} +ac_cv_header_valgrind_valgrind_h=${ac_cv_header_valgrind_valgrind_h=no} +ac_cv_header_vfork_h=${ac_cv_header_vfork_h=no} +ac_cv_lib_dl_dlopen=${ac_cv_lib_dl_dlopen=no} +ac_cv_lib_inet_main=${ac_cv_lib_inet_main=no} +ac_cv_lib_kstat_kstat_open=${ac_cv_lib_kstat_kstat_open=no} +ac_cv_lib_m_sin=${ac_cv_lib_m_sin=no} +ac_cv_lib_nsl_gethostbyname=${ac_cv_lib_nsl_gethostbyname=no} +ac_cv_lib_nsl_main=${ac_cv_lib_nsl_main=no} +ac_cv_lib_resolv_res_gethostbyname=${ac_cv_lib_resolv_res_gethostbyname=no} +ac_cv_lib_rt_clock_gettime=${ac_cv_lib_rt_clock_gettime=no} +ac_cv_lib_socket_getpeername=${ac_cv_lib_socket_getpeername=no} +ac_cv_lib_socket_main=${ac_cv_lib_socket_main=yes} +ac_cv_lib_socket_socket=${ac_cv_lib_socket_socket=no} +ac_cv_lib_util_openpty=${ac_cv_lib_util_openpty=no} +ac_cv_lib_ws2_32_main=${ac_cv_lib_ws2_32_main=yes} +ac_cv_member_struct_ErlDrvEntry_stop_select=${ac_cv_member_struct_ErlDrvEntry_stop_select=no} +ac_cv_objext=${ac_cv_objext=o} +ac_cv_path_MKDIR=${ac_cv_path_MKDIR=/bin/mkdir} +ac_cv_path_PERL=${ac_cv_path_PERL=/usr/bin/perl} +ac_cv_path_RM=${ac_cv_path_RM=/bin/rm} +ac_cv_path_install=${ac_cv_path_install='/usr/bin/install -c'} +ac_cv_prog_AR=${ac_cv_prog_AR=ar.sh} +ac_cv_prog_CC=${ac_cv_prog_CC=cc.sh} +ac_cv_prog_CPP=${ac_cv_prog_CPP='cc.sh -E'} +ac_cv_prog_CXX=${ac_cv_prog_CXX=cc.sh} +ac_cv_prog_DED_LD=${ac_cv_prog_DED_LD=ld.sh} +ac_cv_prog_M4=${ac_cv_prog_M4=m4} +ac_cv_prog_PERL=${ac_cv_prog_PERL=perl} +ac_cv_prog_RANLIB=${ac_cv_prog_RANLIB=true} +ac_cv_prog_ac_ct_LD=${ac_cv_prog_ac_ct_LD=ld} +ac_cv_prog_cc_g=${ac_cv_prog_cc_g=yes} +ac_cv_prog_cc_stdc=${ac_cv_prog_cc_stdc=} +ac_cv_prog_cxx_g=${ac_cv_prog_cxx_g=no} +ac_cv_prog_egrep=${ac_cv_prog_egrep='grep -E'} +ac_cv_prog_emu_cc=${ac_cv_prog_emu_cc=emu_cc.sh} +ac_cv_prog_make_make_set=${ac_cv_prog_make_make_set=yes} +ac_cv_prog_mkdir_p=${ac_cv_prog_mkdir_p='/usr/bin/install -c -d'} +ac_cv_search_opendir=${ac_cv_search_opendir=no} +ac_cv_search_strerror=${ac_cv_search_strerror='none required'} +ac_cv_sizeof_char=${ac_cv_sizeof_char=1} +ac_cv_sizeof_int=${ac_cv_sizeof_int=4} +ac_cv_sizeof_long=${ac_cv_sizeof_long=4} +ac_cv_sizeof_long_long=${ac_cv_sizeof_long_long=8} +ac_cv_sizeof_off_t=${ac_cv_sizeof_off_t=4} +ac_cv_sizeof_short=${ac_cv_sizeof_short=2} +ac_cv_sizeof_size_t=${ac_cv_sizeof_size_t=4} +ac_cv_sizeof_void_p=${ac_cv_sizeof_void_p=4} +ac_cv_struct_exception=${ac_cv_struct_exception=no} +ac_cv_struct_sockaddr_sa_len=${ac_cv_struct_sockaddr_sa_len=no} +ac_cv_struct_tm=${ac_cv_struct_tm=time.h} +ac_cv_sys_ipv6_support=${ac_cv_sys_ipv6_support=no} +ac_cv_sys_multicast_support=${ac_cv_sys_multicast_support=no} +ac_cv_type_char=${ac_cv_type_char=yes} +ac_cv_type_int=${ac_cv_type_int=yes} +ac_cv_type_long=${ac_cv_type_long=yes} +ac_cv_type_long_long=${ac_cv_type_long_long=yes} +ac_cv_type_off_t=${ac_cv_type_off_t=yes} +ac_cv_type_pid_t=${ac_cv_type_pid_t=no} +ac_cv_type_short=${ac_cv_type_short=yes} +ac_cv_type_signal=${ac_cv_type_signal=void} +ac_cv_type_size_t=${ac_cv_type_size_t=yes} +ac_cv_type_uid_t=${ac_cv_type_uid_t=no} +ac_cv_type_void_p=${ac_cv_type_void_p=yes} +ac_cv_working_alloca_h=${ac_cv_working_alloca_h=no} +erl_cv_time_correction=${erl_cv_time_correction=none} +erts_cv___after_morecore_hook_can_track_malloc=${erts_cv___after_morecore_hook_can_track_malloc=no} +erts_cv_fwrite_unlocked=${erts_cv_fwrite_unlocked=no} +erts_cv_have__end_symbol=${erts_cv_have__end_symbol=no} +erts_cv_have_end_symbol=${erts_cv_have_end_symbol=no} +erts_cv_putc_unlocked=${erts_cv_putc_unlocked=no} +erts_cv_windows_h_includes_winsock2_h=${erts_cv_windows_h_includes_winsock2_h=no} diff --git a/erts/configure.in b/erts/configure.in new file mode 100644 index 0000000000..895a357023 --- /dev/null +++ b/erts/configure.in @@ -0,0 +1,3772 @@ +dnl Process this file with autoconf to produce a configure script. -*-m4-*- + +dnl %CopyrightBegin% +dnl +dnl Copyright Ericsson AB 1997-2009. All Rights Reserved. +dnl +dnl The contents of this file are subject to the Erlang Public License, +dnl Version 1.1, (the "License"); you may not use this file except in +dnl compliance with the License. You should have received a copy of the +dnl Erlang Public License along with this software. If not, it can be +dnl retrieved online at http://www.erlang.org/. +dnl +dnl Software distributed under the License is distributed on an "AS IS" +dnl basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +dnl the License for the specific language governing rights and limitations +dnl under the License. +dnl +dnl %CopyrightEnd% + +dnl The string "FIXME convbreak" means that there is a break of +dnl autoconf convention that should be cleaned up. + +AC_INIT(vsn.mk) +AC_PREREQ(2.59) + +if test "x$no_recursion" != "xyes" -a "x$OVERRIDE_CONFIG_CACHE" = "x"; then + # We do not want to use a common cache! + cache_file=/dev/null +fi + +dnl How to set srcdir absolute is taken from the GNU Emacs distribution +#### Make srcdir absolute, if it isn't already. It's important to +#### avoid running the path through pwd unnecessary, since pwd can +#### give you automounter prefixes, which can go away. +case "${srcdir}" in + /* ) ;; + . ) + ## We may be able to use the $PWD environment variable to make this + ## absolute. But sometimes PWD is inaccurate. + ## Make sure CDPATH doesn't affect cd (in case PWD is relative). + CDPATH= + if test "${PWD}" != "" && test "`(cd ${PWD} ; sh -c pwd)`" = "`pwd`" ; + then + srcdir="$PWD" + else + srcdir="`(cd ${srcdir}; pwd)`" + fi + ;; + * ) srcdir="`(cd ${srcdir}; pwd)`" ;; +esac + +## Now, make sure that ERL_TOP is set and is the same as srcdir +## +if test -z "$ERL_TOP" || test ! -d $ERL_TOP ; then + AC_MSG_ERROR(You need to set the environment variable ERL_TOP!) +fi +if test x"${ERL_TOP}/erts" != x"$srcdir"; then + AC_MSG_ERROR([You need to run configure with argument --srcdir=${ERL_TOP}/erts]) +fi +erl_top=${ERL_TOP} + +# echo XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +# echo X +# echo "X srcdir = $srcdir" +# echo "X ERL_TOP = $ERL_TOP" +# echo X +# echo XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +AC_CONFIG_AUX_DIRS($srcdir/autoconf) + +dnl ---------------------------------------------------------------------- +dnl Figure out what system we are running on. +dnl ---------------------------------------------------------------------- + +# +# To configure for free source run ./configure --host=free_source +# +dnl +dnl AC_CANONICAL_HOST does not like free_source as a host specification, +dnl so we make a little special case. +dnl +if test "X$host" != "Xfree_source" -a "X$host" != "Xwin32"; then + AC_CANONICAL_HOST +else + host_os=$host +fi +AC_ISC_POSIX + +AC_CONFIG_HEADER($host/config.h:config.h.in include/internal/$host/ethread_header_config.h:include/internal/ethread_header_config.h.in include/$host/erl_int_sizes_config.h:include/erl_int_sizes_config.h.in) +dnl ---------------------------------------------------------------------- +dnl Optional features. +dnl ---------------------------------------------------------------------- +enable_child_waiter_thread=no +ENABLE_ALLOC_TYPE_VARS= +AC_SUBST(ENABLE_ALLOC_TYPE_VARS) + +AC_ARG_WITH(xcomp-conf, +[ --with-xcompconf=PATH path to cross compilation configuration]) +if test "x$with_xcompconf" != "xno" -a "x$with_xcompconf" != "x" ; then + . $with_xcompconf +fi + + +AC_ARG_ENABLE(threads, +[ --enable-threads enable async thread support + --disable-threads disable async thread support], +[ case "$enableval" in + no) enable_threads=no ;; + *) enable_threads=yes ;; + esac ], enable_threads=unknown) + +AC_ARG_ENABLE(smp-support, +[ --enable-smp-support enable smp support + --disable-smp-support disable smp support], +[ case "$enableval" in + no) enable_smp_support=no ;; + *) enable_smp_support=yes ;; + esac ], enable_smp_support=unknown) + +AC_ARG_WITH(termcap, +[ --with-termcap use termcap (default) + --without-termcap do not use any termcap libraries (ncurses,curses,termcap,termlib)], +[], +[with_termcap=yes]) + + +AC_ARG_ENABLE(hybrid-heap, +[ --enable-hybrid-heap enable hybrid heap + --disable-hybrid-heap disable hybrid heap], +[ case "$enableval" in + no) enable_hybrid_heap=no ;; + *) enable_hybrid_heap=yes ;; + esac ], enable_hybrid_heap=unknown) + +AC_ARG_ENABLE(lock-checking, +[ --enable-lock-checking enable lock checking], +[ case "$enableval" in + no) enable_lock_check=no ;; + *) enable_lock_check=yes ;; + esac +], + enable_lock_check=no) + +AC_ARG_ENABLE(lock-counter, +[ --enable-lock-counter enable lock counters + --disable-lock-counter disable lock counters], +[ case "$enableval" in + no) enable_lock_count=no ;; + *) enable_lock_count=yes ;; + esac ], enable_lock_count=no) + +AC_ARG_ENABLE(kernel-poll, +[ --enable-kernel-poll enable kernel poll support + --disable-kernel-poll disable kernel poll support], +[ case "$enableval" in + no) enable_kernel_poll=no ;; + *) enable_kernel_poll=yes ;; + esac ], enable_kernel_poll=unknown) + + +AC_ARG_ENABLE(sctp, +[ --enable-sctp enable sctp support + --disable-sctp disable sctp support], +[ case "$enableval" in + no) enable_sctp=no ;; + *) enable_sctp=yes ;; + esac ], enable_sctp=unknown) + +AC_ARG_ENABLE(hipe, +[ --enable-hipe enable hipe support + --disable-hipe disable hipe support]) + +AC_ARG_ENABLE(native-libs, +[ --enable-native-libs compile Erlang libraries to native code]) + +AC_ARG_ENABLE(tsp, +[ --enable-tsp compile tsp app]) + +AC_ARG_ENABLE(elib-malloc, +[ --enable-elib-malloc use elib_malloc instead of normal malloc]) + +AC_ARG_ENABLE(fp-exceptions, +[ --enable-fp-exceptions Use hardware floating point exceptions (default if hipe enabled)], +[ case "$enableval" in + no) enable_fp_exceptions=no ;; + *) enable_fp_exceptions=yes ;; + esac +],enable_fp_exceptions=auto) + +AC_ARG_ENABLE(darwin-universal, +[ --enable-darwin-universal build universal binaries on darwin i386], +[ case "$enableval" in + no) enable_darwin_universal=no ;; + *) enable_darwin_univeral=yes ;; + esac +],enable_darwin_universal=no) + + +AC_ARG_ENABLE(darwin-64bit, +[ --enable-darwin-64bit build 64bit binaries on darwin], +[ case "$enableval" in + no) enable_darwin_64bit=no ;; + *) enable_darwin_64bit=yes ;; + esac +],enable_darwin_64bit=no) + +AC_ARG_ENABLE(m64-build, +[ --enable-m64-build build 64bit binaries using the -m64 flag to (g)cc], +[ case "$enableval" in + no) enable_m64_build=no ;; + *) enable_m64_build=yes ;; + esac +],enable_m64_build=no) + +AC_ARG_ENABLE(fixalloc, +[ --disable-fixalloc disable the use of fix_alloc]) +if test x${enable_fixalloc} = xno ; then + AC_DEFINE(NO_FIX_ALLOC,[], + [Define if you don't want the fix allocator in Erlang]) +fi + +AC_SUBST(PERFCTR_PATH) +AC_ARG_WITH(perfctr, +[ --with-perfctr=PATH specify location of perfctr include and lib + --without-perfctr don't use perfctr (default)]) + +if test "x$with_perfctr" = "xno" -o "x$with_perfctr" = "x" ; then + PERFCTR_PATH= +else + if test ! -f "$with_perfctr/usr.lib/libperfctr.a" ; then + AC_MSG_ERROR(Invalid path to option --with-perfctr=PATH) + fi + PERFCTR_PATH="$with_perfctr" + AC_DEFINE(USE_PERFCTR,[1], + [Define to enable hrvtime() on Linux systems with perfctr extension]) +fi + +AC_ARG_ENABLE(clock-gettime, +[ --enable-clock-gettime Use clock-gettime for time correction], +[ case "$enableval" in + no) clock_gettime_correction=no ;; + *) clock_gettime_correction=yes ;; + esac ], clock_gettime_correction=unknown) + +AC_ARG_ENABLE(native-ethr-impls, +[ --enable-native-ethr-impls enable native ethread implementations + --disable-native-ethr-impls disable native ethread implementations], +[ case "$enableval" in + no) disable_native_ethr_impls=yes ;; + *) disable_native_ethr_impls=no ;; + esac ], disable_native_ethr_impls=no) + +dnl Defined in libraries/megaco/configure.in but we need it here +dnl also in order to show it to the "top user" + +AC_ARG_ENABLE(megaco_flex_scanner_lineno, +[ --disable-megaco-flex-scanner-lineno disable megaco flex scanner lineno]) + +dnl Magic test for clearcase. +OTP_RELEASE= +if test "${ERLANG_COMMERCIAL_BUILD}" != ""; then + OTP_EXTRA_FLAGS=-DOTP_RELEASE + OTP_RELEASE=yes +else + OTP_EXTRA_FLAGS= +fi +AC_SUBST(OTP_RELEASE) + +dnl OK, we might have darwin switches off different kinds, lets +dnl check it all before continuing. +TMPSYS=`uname -s`-`uname -m` +if test X${enable_darwin_universal} = Xyes; then + if test X${enable_darwin_64bit} = Xyes; then + AC_MSG_ERROR([--enable-darwin-universal and --enable-darwin-64bit mutually exclusive]) + fi + enable_hipe=no + case $CFLAGS in + *-arch\ ppc*) + ;; + *) + CFLAGS="-arch ppc $CFLAGS" + ;; + esac + case $CFLAGS in + *-arch\ i386*) + ;; + *) + CFLAGS="-arch i386 $CFLAGS" + ;; + esac +fi +if test X${enable_darwin_64bit} = Xyes; then + case "$TMPSYS" in + Darwin-i386|Darwin-x86_64) + ;; + Darwin*) + AC_MSG_ERROR([--enable-darwin-64bit only supported on x86 hosts]) + ;; + *) + AC_MSG_ERROR([--enable-darwin-64bit only supported on Darwin]) + ;; + esac +fi +if test X${enable_darwin_64bit} = Xyes -o X${enable_m64_build} = Xyes; then + enable_hipe=no + case $CFLAGS in + *-m64*) + ;; + *) + CFLAGS="-m64 $CFLAGS" + ;; + esac +else + case $host_os in + darwin*) + case $CFLAGS in + *-m32*) + ;; + *) + CFLAGS="-m32 $CFLAGS" + ;; + esac + ;; + *) + ;; + esac +fi + + +dnl ---------------------------------------------------------------------- +dnl Checks for programs. +dnl ---------------------------------------------------------------------- + +AC_PROG_CC + +dnl --------------------------------------------------------------------- +dnl Special stuff regarding CFLAGS and details in the environment... +dnl --------------------------------------------------------------------- + +dnl NOTE: CPPFLAGS will be included in CFLAGS at the end +case $host_os in + linux*) CPPFLAGS="$CPPFLAGS -D_GNU_SOURCE";; + win32) + # The ethread library requires _WIN32_WINNT of at least 0x0403. + # -D_WIN32_WINNT=* from CPPFLAGS is saved in ETHR_DEFS. + CPPFLAGS="$CPPFLAGS -D_WIN32_WINNT=0x0500 -DWINVER=0x0500" + # _USE_32BIT_TIME_T is needed when using VC++ 2005 (ctime() will fail + # otherwise since we pass it a 32-bit value). + # + # FIXME: Use time_t all the way and remove _USE_32BIT_TIME_T. + AC_MSG_WARN([Reverting to 32-bit time_t]) + CPPFLAGS="$CPPFLAGS -D_USE_32BIT_TIME_T" + ;; + *) + ;; +esac + + + +MIXED_CYGWIN=no + +AC_MSG_CHECKING(for mixed cygwin and native VC++ environment) +if test "X$host" = "Xwin32" -a "x$GCC" != x"yes"; then + if test -x /usr/bin/cygpath; then + CFLAGS="-O2" + MIXED_CYGWIN=yes + AC_MSG_RESULT([yes]) + MIXED_CYGWIN_VC=yes + CPPFLAGS="$CPPFLAGS -DERTS_MIXED_CYGWIN_VC" + else + AC_MSG_RESULT([undeterminable]) + AC_MSG_ERROR(Seems to be mixed windows but not with cygwin, cannot handle this!) + fi +else + AC_MSG_RESULT([no]) + MIXED_CYGWIN_VC=no +fi +AC_SUBST(MIXED_CYGWIN_VC) + +AC_MSG_CHECKING(for mixed cygwin and native MinGW environment) +if test "X$host" = "Xwin32" -a "x$GCC" = x"yes"; then + if test -x /usr/bin/cygpath; then + CFLAGS="-O2" + MIXED_CYGWIN=yes + AC_MSG_RESULT([yes]) + MIXED_CYGWIN_MINGW=yes + CPPFLAGS="$CPPFLAGS -DERTS_MIXED_CYGWIN_MINGW" + else + AC_MSG_RESULT([undeterminable]) + AC_MSG_ERROR(Seems to be mixed windows but not with cygwin, cannot handle this!) + fi +else + AC_MSG_RESULT([no]) + MIXED_CYGWIN_MINGW=no +fi +AC_SUBST(MIXED_CYGWIN_MINGW) + +AC_MSG_CHECKING(if we mix cygwin with any native compiler) +if test "X$MIXED_CYGWIN" = "Xyes" ; then + AC_MSG_RESULT([yes]) +else + AC_MSG_RESULT([no]) +fi + +AC_SUBST(MIXED_CYGWIN) + +dnl +dnl Flags to the C compiler +dnl +dnl Make sure we find config.h +dnl + +extra_flags="-I${ERL_TOP}/erts/$host $OTP_EXTRA_FLAGS" +CFLAGS="$CFLAGS $extra_flags" +DEBUG_CFLAGS="-g $CPPFLAGS $extra_flags" +DEBUG_FLAGS=-g + +CFLAG_RUNTIME_LIBRARY_PATH="-Wl,-R" +case $host_os in + darwin*) + CFLAG_RUNTIME_LIBRARY_PATH= + CFLAGS="$CFLAGS -no-cpp-precomp" + ;; + win32) + CFLAG_RUNTIME_LIBRARY_PATH= + ;; + osf*) + CFLAG_RUNTIME_LIBRARY_PATH="-Wl,-rpath," + ;; + *) + ;; +esac + + +dnl +dnl Use the getconf utility if it exists +dnl to find large file support flags. +dnl +if type getconf >/dev/null 2>&1; then + CFLAGS="$CFLAGS `getconf LFS_CFLAGS 2>/dev/null`" + DEBUG_CFLAGS="$DEBUG_CFLAGS `getconf LFS_CFLAGS 2>/dev/null`" + LDFLAGS="$LDFLAGS `getconf LFS_LDFLAGS 2>/dev/null`" + LIBS="$LIBS `getconf LFS_LIBS 2>/dev/null`" +fi + +if test "x$GCC" = xyes; then + # until the emulator can handle this, I suggest we turn it off! + #WFLAGS="-Wall -Wshadow -Wcast-qual -Wmissing-declarations" + WFLAGS="-Wall -Wstrict-prototypes -Wmissing-prototypes" + + saved_CFLAGS=$CFLAGS + CFLAGS="$CFLAGS -Wdeclaration-after-statement" + AC_TRY_COMPILE([],[;], warn_decl_after_st=true, warn_decl_after_st=false) + if test "X$warn_decl_after_st" = "Xtrue"; then + WFLAGS="$WFLAGS -Wdeclaration-after-statement" + fi + CFLAGS=$saved_CFLAGS +else + WFLAGS="" +fi +dnl DEBUG_FLAGS is obsolete (I hope) +AC_SUBST(DEBUG_FLAGS) +AC_SUBST(DEBUG_CFLAGS) +AC_SUBST(WFLAGS) +AC_SUBST(CFLAG_RUNTIME_LIBRARY_PATH) + +AC_CHECK_SIZEOF(void *, $erl_xcomp_void_p) # Needed for ARCH and smp checks below + +dnl +dnl Figure out operating system and cpu architecture +dnl + +if test "x$erl_xcomp_os" != "x"; then + chk_opsys_=$erl_xcomp_os +else + if test "x$host_os" = "xwin32"; then + chk_opsys_=win32 + else + chk_opsys_=`uname -s` + if test "x$chk_opsys_" = "xSunOS"; then + chk_opsys_=$chk_opsys_`uname -r` + fi + fi +fi +case $chk_opsys_ in + win32) OPSYS=win32;; + solaris2.*|SunOS5.*) OPSYS=sol2;; + linux|Linux) OPSYS=linux;; + darwin|Darwin) OPSYS=darwin;; + freebsd|FreeBSD) OPSYS=freebsd;; + *) OPSYS=noopsys +esac + +if test "x$erl_xcomp_hw" != "x"; then + chk_arch_=$erl_xcomp_hw +else + chk_arch_=`uname -m` +fi +case $chk_arch_ in + sun4u) ARCH=ultrasparc;; + sparc64) ARCH=sparc64;; + sun4v) ARCH=ultrasparc;; + i86pc) ARCH=x86;; + i386) ARCH=x86;; + i486) ARCH=x86;; + i586) ARCH=x86;; + i686) ARCH=x86;; + x86_64) ARCH=amd64;; + amd64) ARCH=amd64;; + macppc) ARCH=ppc;; + ppc) ARCH=ppc;; + ppc64) ARCH=ppc64;; + "Power Macintosh") ARCH=ppc;; + armv5b) ARCH=arm;; + armv5teb) ARCH=arm;; + armv5tel) ARCH=arm;; + tile) ARCH=tile;; + *) ARCH=noarch;; +esac + +dnl +dnl Convert between x86 and amd64 based on the compiler's mode. +dnl Ditto between ultrasparc and sparc64. +dnl +AC_MSG_CHECKING(whether compilation mode forces ARCH adjustment) +case "$ARCH-$ac_cv_sizeof_void_p" in +i386-8) + AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64) + ARCH=amd64 + ;; +x86-8) + AC_MSG_RESULT(yes: adjusting ARCH=x86 to ARCH=amd64) + ARCH=amd64 + ;; +amd64-4) + AC_MSG_RESULT(yes: adjusting ARCH=amd64 to ARCH=x86) + ARCH=x86 + ;; +ultrasparc-8) + AC_MSG_RESULT(yes: adjusting ARCH=ultrasparc to ARCH=sparc64) + ARCH=sparc64 + ;; +sparc64-4) + AC_MSG_RESULT(yes: adjusting ARCH=sparc64 to ARCH=ultrasparc) + ARCH=ultrasparc + ;; +ppc64-4) + AC_MSG_RESULT(yes: adjusting ARCH=ppc64 to ARCH=ppc) + ARCH=ppc + ;; +*) + AC_MSG_RESULT(no) + ;; +esac + +AC_SUBST(OPSYS) +AC_SUBST(ARCH) + +dnl Check consistency of os and darwin-switches + + +dnl Take care of LDFLAGS on darwin, and disable common_test as it +dnl has a build/configure system re rx-lib that is not compatible +dnl First remove common_tests skip file. + +dnl Adjust LDFLAGS to allow 64bit linkage on DARWIN +case $ARCH-$OPSYS in + amd64-darwin*) + AC_MSG_NOTICE([Adjusting LDFLAGS to cope with 64bit Darwin]) + case $LDFLAGS in + *-m64*) + ;; + *) + LDFLAGS="-m64 $LDFLAGS" + ;; + esac + ;; + *-darwin*) + if test X${enable_darwin_universal} = Xyes; then + AC_MSG_NOTICE([Adjusting LDFLAGS for universal binaries]) + + case $LDFLAGS in + *-arch\ ppc*) + ;; + *) + LDFLAGS="-arch ppc $LDFLAGS" + ;; + esac + case $LDFLAGS in + *-arch\ i386*) + ;; + *) + LDFLAGS="-arch i386 $LDFLAGS" + ;; + esac + else + case $LDFLAGS in + *-m32*) + ;; + *) + LDFLAGS="-m32 $LDFLAGS" + ;; + esac + fi + ;; + *) + if test X${enable_m64_build} = Xyes; then + AC_MSG_NOTICE([Adjusting LDFLAGS to use -m64]) + case $LDFLAGS in + *-m64*) + ;; + *) + LDFLAGS="-m64 $LDFLAGS" + ;; + esac + fi + ;; +esac + +AC_MSG_CHECKING(if VM has to be linked with Carbon framework) +case $ARCH-$OPSYS in + amd64-darwin*) + LIBCARBON= + AC_MSG_RESULT([no]) + ;; + *-darwin*) + LIBCARBON="-framework Carbon " + AC_MSG_RESULT([yes]) + ;; + *) + LIBCARBON= + AC_MSG_RESULT([no]) + ;; +esac + +AC_SUBST(LIBCARBON) + +dnl some tests below will call this if we haven't already - and autoconf +dnl can't handle those tests being done conditionally at runtime +AC_PROG_CPP + +AC_PROG_RANLIB + +AC_PROG_YACC +LM_PROG_PERL5 +if test "$ac_cv_path_PERL" = false; then + AC_MSG_ERROR([Perl version 5 is required to build the emulator!]) +fi +AC_PROG_LN_S + + +AC_CHECK_PROG(AR, ar, ar, false) +if test "$ac_cv_prog_AR" = false; then + AC_MSG_ERROR([No 'ar' command found in PATH]) +fi + +_search_path=/bin:/usr/bin:/usr/local/bin:$PATH + +AC_PATH_PROG(RM, rm, false, $_search_path) +if test "$ac_cv_path_RM" = false; then + AC_MSG_ERROR([No 'rm' command found]) +fi + +AC_PATH_PROG(MKDIR, mkdir, false, $_search_path) +if test "$ac_cv_path_MKDIR" = false; then + AC_MSG_ERROR([No 'mkdir' command found]) +fi + +_search_path= + +# +# Get programs needed for building the documentation +# + +## Delete previous failed configure results +if test -f doc/CONF_INFO; then + rm doc/CONF_INFO +fi + +AC_CHECK_PROGS(XSLTPROC, xsltproc) +if test -z "$XSLTPROC"; then + echo "xsltproc" >> doc/CONF_INFO + AC_MSG_WARN([No 'xsltproc' command found: the documentation can not be built]) +fi + +AC_CHECK_PROGS(FOP, fop) +if test -z "$FOP"; then + echo "fop" >> doc/CONF_INFO + AC_MSG_WARN([No 'fop' command found: the documentation can not be built]) +fi + +dnl +dnl We can live with Solaris /usr/ucb/install +dnl +case $host in + *-*-solaris*|free_source) + if test -x /usr/ucb/install; then + INSTALL="/usr/ucb/install -c" + fi + ;; + *) + ;; +esac +AC_PROG_INSTALL +LM_PROG_INSTALL_DIR + +case $host_os in + darwin*) + dnl Need to preserve modification time on archives; + dnl otherwise, ranlib has to be run on archives + dnl again after installation. + INSTALL_DATA="$INSTALL_DATA -p";; + *) + ;; +esac + +dnl +dnl Fix for Tilera install permissions +dnl + +case $build in + *tile*) + INSTALL_PROGRAM="$INSTALL_PROGRAM -m755" + INSTALL_SCRIPT="$INSTALL_SCRIPT -m755" + ;; + *) + ;; +esac + +dnl ---------------------------------------------------------------------- +dnl Misc. things (some of them should go away) +dnl ---------------------------------------------------------------------- + +dnl +dnl An attempt to allow cross compiling. This is not the right way, +dnl nor does it work currently. Some makefiles still needs these +dnl variables, so we leave them in for now. +dnl +HCC='$(CC)' AC_SUBST(HCC) +HCFLAGS="" AC_SUBST(HCFLAGS) +HCFLAGS="$HCFLAGS -I${ERL_TOP}/erts/$host" +vxworks_reclaim="" AC_SUBST(vxworks_reclaim) +LD='$(CC)' AC_SUBST(LD) + + +dnl Check for cygwin and object/exe files extension +dnl AC_CYGWIN is deprecated +AC_EXEEXT +AC_OBJEXT + +dnl This is the os flavour, should be unix, vxworks or win32 +if test "X$host" = "Xwin32"; then + ERLANG_OSTYPE=win32 +else + ERLANG_OSTYPE=unix +fi + +AC_SUBST(ERLANG_OSTYPE) + +dnl Which sysv4 would this be, and what is it for??? +dnl XXX: replace with feature tests. +case $host_os in + sysv4*) + AC_DEFINE(SOCKOPT_CONNECT_STAT,[],[Obscure SYSV feature]) + AC_DEFINE(NO_PRAGMA_WEAK,[],[Obscure SYSV feature]) + LIBS="$LIBS -lgen -lc -L /usr/ucblib -lucb" + ;; +esac + +# Check how to export functions from the emulator executable, needed +# when dynamically loaded drivers are loaded (so that they can find +# emulator functions). +# OS'es with ELF executables using the GNU linker (Linux and recent *BSD, +# in rare cases Solaris) typically need '-Wl,-export-dynamic' (i.e. pass +# -export-dynamic to the linker - also known as -rdynamic and some other +# variants); some sysVr4 system(s) instead need(s) '-Wl,-Bexport'. +# AIX 4.x (perhaps only for x>=2) wants -Wl,-bexpall,-brtl and doesn't +# reliably return an error for others, thus we separate it out. +# Otherwise we assume that if the linker accepts the flag, it is needed. +AC_MSG_CHECKING(for extra flags needed to export symbols) +DEXPORT="" +case $host_os in + aix4*) + DEXPORT=-Wl,-bexpall,-brtl + ;; + bsdi*) + DEXPORT="-rdynamic " + ;; + win32) + DEXPORT="" + ;; + *) + save_ldflags="$LDFLAGS" + LDFLAGS=-Wl,-export-dynamic + AC_TRY_LINK(,,[DEXPORT=-Wl,-export-dynamic], [ + LDFLAGS=-Wl,-Bexport + AC_TRY_LINK(,,[DEXPORT=-Wl,-Bexport], + AC_MSG_RESULT(none))]) + LDFLAGS="$save_ldflags" + ;; +esac +AC_SUBST(DEXPORT) +case "x$DEXPORT" in + "x") + AC_MSG_RESULT([none]);; + *) + AC_MSG_RESULT([$DEXPORT]);; +esac + +# Check for Solaris/ultrasparc /dev/perfmon interface +# (also needs gcc specific asm instructions) +case "${host}:${GCC}" in + sparc-*-solaris*:yes) + AC_DEFINE(HAVE_SOLARIS_SPARC_PERFMON,[1], + [define if you have the Solaris/ultrasparc /dev/perfmon interface]) + ;; + *) + ;; +esac + + +dnl ---------------------------------------------------------------------- +dnl Checks for libraries. +dnl ---------------------------------------------------------------------- + +AC_CHECK_LIB(m, sin) +AC_CHECK_LIB(dl, dlopen) +AC_CHECK_LIB(inet, main) +AC_CHECK_LIB(util, openpty) + +dnl Try to find a thread library. +dnl +dnl ETHR_LIB_NAME, ETHR_LIBS, ETHR_X_LIBS, ETHR_THR_LIB_BASE and ETHR_DEFS +dnl are set by ERL_FIND_ETHR_LIB +ERL_FIND_ETHR_LIB + +if test "X$ETHR_LIB_NAME" = "X"; then + found_threads=no +else + found_threads=yes +fi + + +ERTS_BUILD_SMP_EMU=$enable_smp_support +AC_MSG_CHECKING(whether an emulator with smp support should be built) +case $ERTS_BUILD_SMP_EMU in + yes) + AC_MSG_RESULT(yes; enabled by user) + ;; + no) + AC_MSG_RESULT(no; disabled by user) + ;; + unknown) + AC_TRY_COMPILE([],[ + #if __GNUC__ >= 3 || (__GNUC__ == 2 && __GNUC_MINOR__ >= 95) + ; + #else + #error old or no gcc + #endif + ], + gcc_smp=okgcc, + gcc_smp=oldornogcc) + ERTS_BUILD_SMP_EMU=yes + case "$enable_threads-$gcc_smp-$found_threads-$host_os" in + + no-*) + AC_MSG_RESULT(no; threads disabled by user) + ERTS_BUILD_SMP_EMU=no + ;; + + *-okgcc-yes-*) + AC_MSG_RESULT(yes) + ERTS_BUILD_SMP_EMU=yes + ;; + + *-win32) + AC_MSG_RESULT(yes) + ERTS_BUILD_SMP_EMU=yes + ;; + + *-oldornogcc-*) + AC_MSG_RESULT(no; old gcc or no gcc found) + ERTS_BUILD_SMP_EMU=no + ;; + + *) + AC_MSG_RESULT(no) + ERTS_BUILD_SMP_EMU=no + ;; + esac + ;; +esac + +if test $ERTS_BUILD_SMP_EMU = yes; then + + if test $found_threads = no; then + AC_MSG_ERROR([cannot build smp enabled emulator since no thread library was found]) + fi + + AC_DEFINE(ERTS_HAVE_SMP_EMU, 1, [Define if the smp emulator is built]) + enable_threads=force +fi + +AC_SUBST(ERTS_BUILD_SMP_EMU) + + + +# +# Figure out if the emulator should use threads. The default is set above +# in the enable_threads variable. It can have the following values: +# +# no single-threaded emulator requested +# yes multi-threaded emulator requested +# force multi-threaded emulator required +# +# EMU_THR_LIB_NAME, EMU_THR_LIBS, EMU_THR_X_LIBS, and EMU_THR_DEFS is +# used by the emulator, and can (but should not) be used by applications +# that only require thread support when the emulator has thread support. +# Other applications should use ETHR_LIB_NAME, ETHR_LIBS, ETHR_X_LIBS, +# and ETHR_DEFS. +# +AC_MSG_CHECKING(whether the emulator should use threads) + +EMU_THR_LIB_NAME= +EMU_THR_X_LIBS= +EMU_THR_LIBS= +EMU_THR_DEFS= +emu_threads=no + +case "$enable_threads"-"$host_os" in + *-win32) + # The windows erlang emulator can never run without threads. + # It has to be enabled or the emulator will crash. Until that + # is fixed we force threads on win32. + enable_threads=force ;; + yes-osf*) + # The emulator hang when threads are enabled on osf + AC_MSG_ERROR(unresolved problems exist with threads on this platform) ;; + *) ;; +esac + +case "$enable_threads"-"$found_threads" in + force-yes) + emu_threads=yes + AC_MSG_RESULT(yes; thread support required and therefore forced) ;; + yes-yes) + emu_threads=yes + AC_MSG_RESULT(yes; enabled by user) ;; + unknown-yes) + case $host_os in + solaris*|linux*|darwin*|win32) + emu_threads=yes + AC_MSG_RESULT(yes; default on this platform) + ;; + *) + AC_MSG_RESULT(no; default on this platform) + ;; + esac + ;; + no-yes) + AC_MSG_RESULT(no; thread support found but disabled by user) ;; + unknown-no|no-no) + AC_MSG_RESULT(no) ;; + force-no) + AC_MSG_ERROR(thread support required but not found) ;; + yes-no) + AC_MSG_ERROR(thread support enabled by user but not found) ;; + *) + AC_MSG_ERROR(internal error) ;; +esac + +if test $emu_threads != yes; then + enable_lock_check=no + enable_lock_count=no +else + # Threads enabled for emulator + EMU_THR_LIB_NAME=$ETHR_LIB_NAME + EMU_THR_X_LIBS=$ETHR_X_LIBS + EMU_THR_LIBS=$ETHR_LIBS + EMU_THR_DEFS=$ETHR_DEFS + ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS threads" + AC_MSG_CHECKING(whether lock checking should be enabled) + AC_MSG_RESULT($enable_lock_check) + if test "x$enable_lock_check" != "xno"; then + EMU_THR_DEFS="$EMU_THR_DEFS -DERTS_ENABLE_LOCK_CHECK" + fi + + AC_MSG_CHECKING(whether lock counters should be enabled) + AC_MSG_RESULT($enable_lock_count) + if test "x$enable_lock_count" != "xno"; then + EMU_THR_DEFS="$EMU_THR_DEFS -DERTS_ENABLE_LOCK_COUNT" + fi + + disable_child_waiter_thread=no + case $host_os in + solaris*) + enable_child_waiter_thread=yes + ;; + linux*) + AC_DEFINE(USE_RECURSIVE_MALLOC_MUTEX,[1], + [Define if malloc should use a recursive mutex]) + AC_MSG_CHECKING([whether dlopen() needs to be called before first call to dlerror()]) + if test "x$ETHR_THR_LIB_BASE_NAME" != "xnptl"; then + AC_DEFINE(ERTS_NEED_DLOPEN_BEFORE_DLERROR,[1], + [Define if dlopen() needs to be called before first call to dlerror()]) + AC_MSG_RESULT(yes) + else + AC_MSG_RESULT(no) + fi + if test "x$ETHR_THR_LIB_BASE_NAME" != "xnptl"; then + # Child waiter thread cannot be enabled + disable_child_waiter_thread=yes + enable_child_waiter_thread=no + fi + ;; + win32) + # Child waiter thread cannot be enabled + disable_child_waiter_thread=yes + enable_child_waiter_thread=no + ;; + *) + ;; + esac + + # Remove -D_WIN32_WINNT*, -DWINVER* and -D_GNU_SOURCE from EMU_THR_DEFS + # (defined in CFLAGS). Note that we want to keep these flags + # in ETHR_DEFS, but not in EMU_THR_DEFS. + new_emu_thr_defs= + for thr_def in $EMU_THR_DEFS; do + case $thr_def in + -D_GNU_SOURCE*|-D_WIN32_WINNT*|-DWINVER*) + ;; + *) + new_emu_thr_defs="$new_emu_thr_defs $thr_def" + ;; + esac + done + EMU_THR_DEFS=$new_emu_thr_defs + + AC_MSG_CHECKING(whether the child waiter thread should be enabled) + if test $enable_child_waiter_thread = yes; then + AC_DEFINE(ENABLE_CHILD_WAITER_THREAD,[1], + [Define if you want to enable child waiter thread]) + AC_MSG_RESULT(yes) + else + case $ERTS_BUILD_SMP_EMU-$disable_child_waiter_thread in + yes-no) + AC_MSG_RESULT([yes on SMP build, but not on non-SMP build]);; + *-yes) + AC_DEFINE(DISABLE_CHILD_WAITER_THREAD,[1], + [Define if you want to disable child waiter thread]) + AC_MSG_RESULT(no);; + *) + AC_MSG_RESULT(no);; + esac + fi +fi + +AC_SUBST(EMU_THR_LIB_NAME) +AC_SUBST(EMU_THR_X_LIBS) +AC_SUBST(EMU_THR_LIBS) +AC_SUBST(EMU_THR_DEFS) + +if test "x$enable_lock_check" = "xno"; then + EMU_LOCK_CHECKING=no +else + EMU_LOCK_CHECKING=yes +fi + +AC_SUBST(EMU_LOCK_CHECKING) + +ERTS_INTERNAL_X_LIBS= + +AC_CHECK_LIB(kstat, kstat_open, +[AC_DEFINE(HAVE_KSTAT, 1, [Define if you have kstat]) +ERTS_INTERNAL_X_LIBS="$ERTS_INTERNAL_X_LIBS -lkstat"]) + +AC_SUBST(ERTS_INTERNAL_X_LIBS) + +dnl THR_LIBS and THR_DEFS are only used by odbc +THR_LIBS=$ETHR_X_LIBS +THR_DEFS=$ETHR_DEFS + +AC_SUBST(THR_LIBS) +AC_SUBST(THR_DEFS) + +dnl ---------------------------------------------------------------------- +dnl Try to figure out where to get the termcap functions from. +dnl We use tgetent(), tgetflag(), tgetnum(), tgetstr() and tputs() +dnl ---------------------------------------------------------------------- + +TERMCAP_LIB= + +if test "x$with_termcap" != "xno" && + test "X$host" != "Xwin32"; then + # try these libs + termcap_libs="ncurses curses termcap termlib" + + for termcap_lib in $termcap_libs; do + AC_CHECK_LIB($termcap_lib, tgetent, TERMCAP_LIB="-l$termcap_lib") + if test "x$TERMCAP_LIB" != "x"; then + break + fi + done + + if test "x$TERMCAP_LIB" = "x"; then + AC_MSG_ERROR([No curses library functions found]) + fi +fi + +AC_SUBST(TERMCAP_LIB) + +if test "x$TERMCAP_LIB" != "x"; then + + AC_DEFINE(HAVE_TERMCAP, 1, [Define if termcap functions exists]) +fi + +dnl ------------- +dnl zlib +dnl ------------- + +AC_ARG_ENABLE(shared-zlib, +[ --enable-shared-zlib enable using shared zlib library + --disable-shared-zlib disable shared zlib, compile own zlib source (default)], +[ case "$enableval" in + no) enable_shared_zlib=no ;; + *) enable_shared_zlib=yes ;; + esac ], enable_shared_zlib=no) + +Z_LIB= + +if test "x$enable_shared_zlib" = "xyes" ; then + AC_CHECK_LIB(z, adler32_combine, + [Z_LIB="-lz" + AC_DEFINE(HAVE_LIBZ, 1, [Define to 1 if you have the `z' library (-lz).])], + [AC_MSG_ERROR([cannot find any shared zlib])]) +else + AC_MSG_NOTICE([Using own zlib source]) +fi + +AC_SUBST(Z_LIB) + +dnl +dnl This test kindly borrowed from Tcl +dnl +#-------------------------------------------------------------------- +# Check for the existence of the -lsocket and -lnsl libraries. +# The order here is important, so that they end up in the right +# order in the command line generated by make. Here are some +# special considerations: +# 1. Use "connect" and "accept" to check for -lsocket, and +# "gethostbyname" to check for -lnsl. +# 2. Use each function name only once: can't redo a check because +# autoconf caches the results of the last check and won't redo it. +# 3. Use -lnsl and -lsocket only if they supply procedures that +# aren't already present in the normal libraries. This is because +# IRIX 5.2 has libraries, but they aren't needed and they're +# bogus: they goof up name resolution if used. +# 4. On some SVR4 systems, can't use -lsocket without -lnsl too. +# To get around this problem, check for both libraries together +# if -lsocket doesn't work by itself. +#-------------------------------------------------------------------- + +erl_checkBoth=0 +AC_CHECK_FUNC(connect, erl_checkSocket=0, erl_checkSocket=1) +if test "$erl_checkSocket" = 1; then + AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", erl_checkBoth=1) +fi +if test "$erl_checkBoth" = 1; then + tk_oldLibs=$LIBS + LIBS="$LIBS -lsocket -lnsl" + AC_CHECK_FUNC(accept, erl_checkNsl=0, [LIBS=$tk_oldLibs]) +fi +AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"])) +AC_CHECK_FUNC(gethostbyname_r,have_gethostbyname_r=yes) + +dnl +dnl These gethostbyname thingies use old style AC_DEFINE for BC with ancient +dnl autoconf... +dnl + +if test "$have_gethostbyname_r" = yes; then + # OK, so we have gethostbyname_r() - but do we know how to call it...? + # (if not, HAVE_GETHOSTBYNAME_R will not be defined at all) + case $host_os in + solaris2*) + AC_DEFINE(HAVE_GETHOSTBYNAME_R, GHBN_R_SOLARIS, + [Define to flavour of gethostbyname_r]) + ;; + aix4*) + # AIX version also needs "struct hostent_data" defn + AC_TRY_COMPILE([#include ], + [struct hostent_data hd;], + AC_DEFINE(HAVE_GETHOSTBYNAME_R, GHBN_R_AIX, + [Define to flavour of gethostbyname_r])) + ;; + *) + AC_EGREP_CPP(yes,[#include + #ifdef __GLIBC__ + yes + #endif + ], AC_DEFINE(HAVE_GETHOSTBYNAME_R, GHBN_R_GLIBC, + [Define to flavour of gethostbyname_r])) + ;; + esac +fi + +AC_MSG_CHECKING(for working posix_openpt implementation) +AC_TRY_LINK([ +#define _XOPEN_SOURCE 600 +#include +#include +], +[ + int mfd = posix_openpt(O_RDWR); + ptsname(mfd); + grantpt(mfd); + unlockpt(mfd); + return mfd; +], working_posix_openpt=yes, working_posix_openpt=no) + +if test "X$working_posix_openpt" = "Xyes"; then + AC_DEFINE(HAVE_WORKING_POSIX_OPENPT, [1], + [Define if you have a working posix_openpt implementation]) + AC_MSG_RESULT(yes) +else + AC_MSG_RESULT(no) +fi + +dnl Check for usage of sockaddr_in in netdb.h +dnl somewhat ugly check, I check for presence of the string and that +dnl compilation works. If either fails I assume it's not needed. +dnl Seems only to be needed on a patched version of solaris2.5.1, with +dnl netdb.h version 1.18. +AC_MSG_CHECKING([if netdb.h requires netinet/in.h to be previously included]) +AC_EGREP_CPP(sockaddr_in, + [#include ], + AC_TRY_COMPILE([#include + #include ], + [return 0;], + need_in_h=yes, + need_in_h=no), + need_in_h=no) + +if test $need_in_h = yes; then + AC_DEFINE(NETDB_H_NEEDS_IN_H,[1], + [Define if netdb.h needs struct sockaddr_in ans in.h CAN be included before]) + AC_MSG_RESULT(yes) +else + AC_MSG_RESULT(no) +fi + +dnl Check for type socklen_t +dnl +AC_MSG_CHECKING([for socklen_t]) +AC_TRY_COMPILE( [#include ], + [socklen_t test;], + have_socklen_t=yes, + have_socklen_t=no), + +if test $have_socklen_t = yes; then + AC_DEFINE(HAVE_SOCKLEN_T,[1],[Define if we have socklen_t]) + AC_MSG_RESULT(yes) +else + AC_MSG_RESULT(no) +fi + + +dnl h_errno isn't always declared in netdb.h, and with some definitions +dnl (e.g. function call for thread-safe) a simple 'extern int' may conflict +dnl (we do assume that h_errno exists at all...) +AC_CACHE_CHECK([for h_errno declaration in netdb.h], + ac_cv_decl_h_errno, +[AC_TRY_COMPILE([#include ], [int err = h_errno;], + ac_cv_decl_h_errno=yes, ac_cv_decl_h_errno=no)]) +if test $ac_cv_decl_h_errno = yes; then + AC_DEFINE(H_ERRNO_DECLARED,[1], + [define if h_errno is declared (in some way) in a system header file]) +fi + + +dnl ---------------------------------------------------------------------- +dnl Checks for header files. +dnl ---------------------------------------------------------------------- + +dnl We sometimes need EMU_THR_DEFS in order to find certain headers. +saved_cppflags=$CPPFLAGS +CPPFLAGS="$CPPFLAGS $EMU_THR_DEFS" + +AC_HEADER_DIRENT +AC_HEADER_STDC +AC_HEADER_SYS_WAIT +AC_HEADER_TIME + +dnl Interactive UX needs for socket related error codes. +dnl Some Linuxes needs instead of +dnl +AC_CHECK_HEADERS(fcntl.h limits.h unistd.h syslog.h dlfcn.h ieeefp.h \ + sys/stropts.h sys/sysctl.h \ + sys/ioctl.h sys/time.h sys/uio.h \ + sys/socket.h sys/sockio.h sys/socketio.h \ + net/errno.h malloc.h mach-o/dyld.h arpa/nameser.h \ + pty.h util.h utmp.h langinfo.h) + +AC_CHECK_HEADER(sys/resource.h, + [AC_DEFINE(HAVE_SYS_RESOURCE_H, 1, + [Define to 1 if you have the header file]) + AC_CHECK_DECLS([getrlimit, setrlimit, RLIMIT_STACK], + [],[], + [#include ])], + [],[]) + +dnl Check if we have kernel poll support +have_kernel_poll=no +AC_CHECK_HEADER(sys/event.h, have_kernel_poll=kqueue) +AC_CHECK_HEADER(sys/epoll.h, have_kernel_poll=epoll) +AC_CHECK_HEADER(sys/devpoll.h, have_kernel_poll=/dev/poll) + +dnl Check for kernel SCTP support +AC_SUBST(LIBSCTP) +if test "x$enable_sctp" == "xyes" ; then + AC_CHECK_HEADER(netinet/sctp.h, + [LIBSCTP=libsctp.so.1 + AC_DEFINE(HAVE_SCTP_H, [1], + [Define to 1 if you have the header file])], + [], + [#if HAVE_SYS_SOCKET_H + #include + #endif + ]) + AC_CHECK_DECLS([SCTP_UNORDERED, SCTP_ADDR_OVER, SCTP_ABORT, + SCTP_EOF, SCTP_SENDALL, SCTP_ADDR_CONFIRMED], [], [], + [#if HAVE_SYS_SOCKET_H + #include + #endif + #include + ]) + AC_CHECK_MEMBERS([struct sctp_paddrparams.spp_pathmtu, + struct sctp_paddrparams.spp_sackdelay, + struct sctp_paddrparams.spp_flags, + struct sctp_remote_error.sre_data, + struct sctp_send_failed.ssf_data], [], [], + [#if HAVE_SYS_SOCKET_H + #include + #endif + #include + ]) +fi + +HAVE_VALGRIND=no +AC_CHECK_HEADER(valgrind/valgrind.h, HAVE_VALGRIND=yes) +AC_SUBST(HAVE_VALGRIND) + +LM_DECL_SO_BSDCOMPAT +LM_DECL_INADDR_LOOPBACK +LM_DECL_SYS_ERRLIST + +AC_CACHE_CHECK([if windows.h includes winsock2.h], + erts_cv_windows_h_includes_winsock2_h, + AC_TRY_COMPILE([#include + ], + [#ifndef _WINSOCK2API_ + #error winsock2.h not included + #endif + int i = 1; + ], + erts_cv_windows_h_includes_winsock2_h=yes, + erts_cv_windows_h_includes_winsock2_h=no)) +if test $erts_cv_windows_h_includes_winsock2_h = yes; then + AC_DEFINE(WINDOWS_H_INCLUDES_WINSOCK2_H, 1, \ +[Define if windows.h includes winsock2.h]) +fi + +dnl restore CPPFLAGS +CPPFLAGS=$saved_cppflags + +dnl ---------------------------------------------------------------------- +dnl Checks for typedefs, structures, and compiler characteristics. +dnl ---------------------------------------------------------------------- + +AC_C_CONST +AC_TYPE_SIGNAL +AC_TYPE_OFF_T +AC_TYPE_PID_T +AC_TYPE_SIZE_T + +AC_STRUCT_TM +LM_STRUCT_SOCKADDR_SA_LEN +LM_STRUCT_EXCEPTION + +AC_CHECK_SIZEOF(char, 1) +AC_CHECK_SIZEOF(short, $erl_xcomp_short) +AC_CHECK_SIZEOF(int, $erl_xcomp_int) +AC_CHECK_SIZEOF(long, $erl_xcomp_long) +AC_CHECK_SIZEOF(void *, $erl_xcomp_void_p) +AC_CHECK_SIZEOF(long long, $erl_xcomp_long_long) + +BITS64= + +if test $ac_cv_sizeof_void_p = 8; then + BITS64=yes +fi +AC_SUBST(BITS64) + +if test "x$ac_compiler_gnu" = "xyes"; then +AC_MSG_CHECKING([if we should add -fno-tree-copyrename to CFLAGS for computed gotos to work properly]) +AC_TRY_COMPILE([],[ + #if __GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 3) + ; + #else + #error old and ok + #endif + ], + no_tree_copyrename=yes, + no_tree_copyrename=no) + +if test "x$no_tree_copyrename" = "xyes"; then + CFLAGS="$CFLAGS -fno-tree-copyrename" + AC_MSG_RESULT(yes, adjusting CFLAGS) +else + AC_MSG_RESULT(no) +fi + + + +AC_MSG_CHECKING([for broken gcc-4.3.0 compiler]) +AC_TRY_RUN([ +/* pr36339.c */ +extern void abort (void); + +typedef unsigned long my_uintptr_t; + +int check_a(my_uintptr_t tagged_ptr); + +int __attribute__((noinline)) try_a(my_uintptr_t x) +{ + my_uintptr_t heap[2]; + my_uintptr_t *hp = heap; + + hp[0] = x; + hp[1] = 0; + return check_a((my_uintptr_t)(void*)((char*)hp + 1)); +} + +int __attribute__((noinline)) check_a(my_uintptr_t tagged_ptr) +{ + my_uintptr_t *hp = (my_uintptr_t*)(void*)((char*)tagged_ptr - 1); + + if (hp[0] == 42 && hp[1] == 0) + return 0; + return -1; +} + +int main(void) +{ + if (try_a(42) < 0) + abort (); + return 0; +} +],AC_MSG_RESULT(no) +,AC_MSG_RESULT(yes) +AC_MSG_ERROR([This gcc miscompiles the Erlang runtime system; please use a different version]) +,AC_MSG_RESULT(no)) +fi + +dnl AC_CHECK_SIZEOF(size_t, 4)dnl Assumes all cross compiling is to 32bit uP +dnl +dnl The disabled one above does not include stddef.h, alas! +dnl +AC_CACHE_CHECK([size of size_t], ac_cv_sizeof_size_t, +AC_TRY_RUN([ +#include +#include +#include +#include +int main(int argc, char **argv) { + FILE *f = fopen("conftestval", "w"); + if (! f) + exit(1); /* Failed */ + fprintf(f, "%d\n", (int) sizeof(size_t)); + exit(0); /* OK */ +} +], ac_cv_sizeof_size_t=`cat conftestval` +, ac_cv_sizeof_size_t=0 +, ac_cv_sizeof_size_t=$erl_xcomp_sizeof_size_t)) +AC_DEFINE_UNQUOTED(SIZEOF_SIZE_T, $ac_cv_sizeof_size_t, [The number of bytes in a size_t]) + +dnl A standard size check does not include sys/types.h +dnl +AC_CACHE_CHECK([size of off_t], ac_cv_sizeof_off_t, +AC_TRY_RUN([ +#include +#include +#include +#include +int main(int argc, char **argv) { + FILE *f = fopen("conftestval", "w"); + if (! f) + exit(1); /* Failed */ + fprintf(f, "%d\n", (int) sizeof(off_t)); + exit(0); /* OK */ +} +], ac_cv_sizeof_off_t=`cat conftestval` +, ac_cv_sizeof_off_t=0 +, ac_cv_sizeof_off_t=$erl_xcomp_sizeof_off_t)) +AC_DEFINE_UNQUOTED(SIZEOF_OFF_T, $ac_cv_sizeof_off_t, + [The number of bytes in an off_t]) + +AC_MSG_CHECKING([int/long/void*/size_t sizes]) +AC_TRY_RUN([ +#include +#include +int main(int argc, char **argv) { + if (sizeof(void *) >= 4 && + sizeof(void *) == sizeof(size_t) && + (sizeof(void *) == sizeof(int) || sizeof(void *) == sizeof(long))) { + exit(0); /* OK */ + } + exit(1); /* Failed */ +} +],AC_MSG_RESULT(ok) +,AC_MSG_RESULT(failed) +AC_MSG_ERROR([Cannot handle this combination of int/long/void*/size_t sizes]) +,AC_MSG_RESULT(ok)) + +if test "x$erl_xcomp_bigendian" != "x"; then + ac_cv_c_bigendian=$erl_xcomp_bigendian +fi + +AC_C_BIGENDIAN + +dnl ---------------------------------------------------------------------- +dnl Checks for library functions. +dnl ---------------------------------------------------------------------- + +dnl We may need the thread library and thread flags in order to find right stuff +saved_cppflags=$CPPFLAGS +CPPFLAGS="$CPPFLAGS $EMU_THR_DEFS" +saved_libs=$LIBS +LIBS="$LIBS $EMU_THR_X_LIBS" + +dnl Check if we have these, in which case we'll try to build +dnl inet_gethost with ipv6 support. +AC_CHECK_FUNC(getaddrinfo, have_getaddrinfo=yes, have_getaddrinfo=no) +if test $have_getaddrinfo = yes; then + AC_MSG_CHECKING([whether getaddrinfo accepts enough flags]) + AC_TRY_RUN([ +#include +#include +#include +#include +int main(int argc, char **argv) { + struct addrinfo hints, *ai; + memset(&hints, 0, sizeof(hints)); + hints.ai_flags = (AI_CANONNAME|AI_V4MAPPED|AI_ADDRCONFIG); + hints.ai_socktype = SOCK_STREAM; + hints.ai_family = AF_INET6; + if (getaddrinfo("::", NULL, &hints, &ai) == 0) { + freeaddrinfo(ai); + exit(0); + } else { + exit(1); + } +} + ],, have_getaddrinfo=no, + if test "x$erl_xcomp_getaddrinfo" != "x"; then + have_getaddrinfo=$erl_xcomp_getaddrinfo + else + have_getaddrinfo=no + fi) + if test $have_getaddrinfo = yes; then + AC_MSG_RESULT(yes) + AC_DEFINE(HAVE_GETADDRINFO, [1], + [Define to 1 if you have a good `getaddrinfo' function.]) + else + AC_MSG_RESULT(no) + fi +fi +AC_CHECK_FUNCS([getnameinfo getipnodebyname getipnodebyaddr gethostbyname2]) + +AC_CHECK_FUNCS([ieee_handler fpsetmask finite isnan isinf res_gethostbyname dlopen \ + pread pwrite writev memmove strerror strerror_r strncasecmp \ + gethrtime localtime_r gmtime_r mremap memcpy mallopt \ + sbrk _sbrk __sbrk brk _brk __brk \ + flockfile fstat strlcpy strlcat setsid posix2time setlocale nl_langinfo]) +if test "X$host" = "Xwin32"; then + ac_cv_func_setvbuf_reversed=yes +fi +AC_FUNC_SETVBUF_REVERSED + +disable_vfork=false +if test "x$EMU_THR_LIB_NAME" != "x"; then + AC_MSG_CHECKING([if vfork is known to hang multithreaded applications]) + case $host_os in + osf*) + AC_MSG_RESULT(yes) + disable_vfork=true;; + *) + AC_MSG_RESULT(no);; + esac +fi + +if test $disable_vfork = false; then + AC_FUNC_VFORK + if test $ac_cv_func_vfork_works = no; then + disable_vfork=true + fi +fi + +if test $disable_vfork = true; then + AC_DEFINE(DISABLE_VFORK, 1, [Define if you want to disable vfork.]) +fi + +AC_FUNC_VPRINTF +AC_FUNC_MMAP + +dnl The AC_DEFINEs are necessary for autoheader to work. :-( +dnl for gzio +LM_CHECK_FUNC_DECL(fread, [extern int fread();],, + AC_DEFINE(HAVE_CONFLICTING_FREAD_DECLARATION,[1],[Define if you have a decl of fread that conflicts with int fread])) + +dnl Checking with TRY_LINK since putc_unlocked might be (probably is) a macro +AC_CACHE_CHECK([for putc_unlocked], + erts_cv_putc_unlocked, + AC_TRY_LINK([#include ], + [int res = putc_unlocked('x',stdout);], + erts_cv_putc_unlocked=yes, + erts_cv_putc_unlocked=no)) +if test $erts_cv_putc_unlocked = yes; then + AC_DEFINE(HAVE_PUTC_UNLOCKED, 1, [Define if you have putc_unlocked]) +fi + +dnl Checking with TRY_LINK since fwrite_unlocked might be a macro +AC_CACHE_CHECK([for fwrite_unlocked], + erts_cv_fwrite_unlocked, + AC_TRY_LINK([#include ], + [size_t res = fwrite_unlocked(NULL,sizeof(char),0,stdout);], + erts_cv_fwrite_unlocked=yes, + erts_cv_fwrite_unlocked=no)) +if test $erts_cv_fwrite_unlocked = yes; then + AC_DEFINE(HAVE_FWRITE_UNLOCKED, 1, [Define if you have fwrite_unlocked]) +fi + +dnl Need by run_erl. +AC_CHECK_FUNCS([openpty]) + +dnl ---------------------------------------------------------------------- +dnl Checks for features/quirks in the system that affects Erlang. +dnl ---------------------------------------------------------------------- + +AC_MSG_CHECKING([for sched_getaffinity/sched_setaffinity]) +AC_TRY_COMPILE([#include ], +[ +#ifndef CPU_SETSIZE +#error no CPU_SETSIZE +#endif + int res; + cpu_set_t cpuset; + CPU_ZERO(&cpuset); + CPU_SET(1, &cpuset); + res = sched_setaffinity(0, sizeof(cpu_set_t), &cpuset); + res = sched_getaffinity(0, sizeof(cpu_set_t), &cpuset); + res = CPU_ISSET(1, &cpuset); + CPU_CLR(1, &cpuset); +], + sched_xetaffinity=yes, + sched_xetaffinity=no) +AC_MSG_RESULT([$sched_xetaffinity]) +if test $sched_xetaffinity = yes; then + AC_DEFINE(HAVE_SCHED_xETAFFINITY, 1, [Define if you have sched_getaffinity/sched_setaffinity]) +fi + + +AC_MSG_CHECKING([for pset functionality]) +AC_TRY_COMPILE([#include ], +[ + int res; + psetid_t id = PS_MYID; + int type = PS_PRIVATE; + uint_t numcpus = 1024; + processorid_t cpulist[1024]; + + res = pset_info(id, &type, &numcpus, &cpulist[0]); +], + pset_functionality=yes, + pset_functionality=no) +AC_MSG_RESULT([$pset_functionality]) +if test $pset_functionality = yes; then + AC_DEFINE(HAVE_PSET, 1, [Define if you have pset functionality]) +fi + +AC_MSG_CHECKING([for processor_bind functionality]) +AC_TRY_COMPILE([ +#include +#include +#include +], +[ + int res = processor_bind(P_LWPID, P_MYID, PBIND_NONE, NULL); +], + processor_bind_functionality=yes, + processor_bind_functionality=no) +AC_MSG_RESULT([$processor_bind_functionality]) +if test $processor_bind_functionality = yes; then + AC_DEFINE(HAVE_PROCESSOR_BIND, 1, [Define if you have processor_bind functionality]) +fi + + +AC_CACHE_CHECK([for 'end' symbol], + erts_cv_have_end_symbol, + [AC_TRY_LINK([], + [extern char end; {char *x = &end; *x= 0;}], + erts_cv_have_end_symbol=yes, + erts_cv_have_end_symbol=no)]) +if test $erts_cv_have_end_symbol = yes; then + AC_DEFINE(HAVE_END_SYMBOL, 1, [Define if you have the 'end' symbol]) +fi + +AC_CACHE_CHECK([for '_end' symbol], + erts_cv_have__end_symbol, + [AC_TRY_LINK([], + [extern char _end; {char *x = &_end; *x= 0;}], + erts_cv_have__end_symbol=yes, + erts_cv_have__end_symbol=no)]) +if test $erts_cv_have__end_symbol = yes; then + AC_DEFINE(HAVE__END_SYMBOL, 1, [Define if you have the '_end' symbol]) +fi + +AC_CACHE_CHECK([if __after_morecore_hook can track malloc()s core memory use], + erts_cv___after_morecore_hook_can_track_malloc, + [AC_TRY_RUN([ +#include +#ifdef HAVE_MALLOC_H +# include +#endif +#if defined(HAVE_END_SYMBOL) +extern char end; +#elif defined(HAVE__END_SYMBOL) +extern char _end; +#endif +#ifndef USE_THREADS +#undef ETHR_PTHREADS +#endif + +#ifdef ETHR_PTHREADS +# ifdef ETHR_HAVE_PTHREAD_H +# include +# else +# ifdef ETHR_HAVE_MIT_PTHREAD_H +# include +# endif +# endif +# define N_THR 5 +#else +# define N_THR 1 +#endif + +static char *heap_start = NULL; +static char *heap_end = NULL; + +void update_heap_size(void) +{ + heap_end = (char *) sbrk(0); +} + +void init_hook(void) +{ +#if defined(HAVE_END_SYMBOL) + heap_start = &end; +#elif defined(HAVE__END_SYMBOL) + heap_start = &_end; +#else + heap_start = sbrk(0); +#endif + __after_morecore_hook = update_heap_size; +} + +void (*__malloc_initialize_hook) (void) = init_hook; + +static int +check_malloc(int size) +{ + char *p = (char *) malloc(size); + if (!heap_start || !heap_end) return 0; + if (!p) return 0; + if (p < heap_start || heap_end <= p) return 0; + if (p + size < heap_start || heap_end < p + size) return 0; + return 1; +} + +#ifdef ETHR_PTHREADS +pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER; +#endif + +static void * +do_tests(void *vresp) +{ + int i, ok = 0; +#ifdef ETHR_PTHREADS + if (pthread_mutex_lock(&mutex) != 0) + return NULL; +#endif + + for (i = 0; i < 10; i++) + if (!check_malloc(1000)) + goto failed; + for (i = 0; i < 100; i++) + if (!check_malloc(1)) + goto failed; + if (!check_malloc(1024*1024+1)) + goto failed; + if (!check_malloc(10*1024*1024+1)) + goto failed; + ok = 1; + + failed: +#ifdef ETHR_PTHREADS + if (pthread_mutex_unlock(&mutex) != 0) + return NULL; +#endif + if (ok) + *((int *) vresp) = 0; + return NULL; +} + + +int main(void) +{ + int res[N_THR], i; +#ifdef ETHR_PTHREADS + pthread_t tid[N_THR]; +#endif + +#if defined(HAVE_MALLOPT) && defined(M_MMAP_MAX) + (void) mallopt(M_MMAP_MAX, 0); +#endif + + for (i = 0; i < N_THR; i++) + res[i] = 1; +#ifdef ETHR_PTHREADS + for (i = 1; i < N_THR; i++) + if (pthread_create(&tid[i], NULL, do_tests, &res[i]) != 0) + return 1; +#endif + (void) do_tests(&res[0]); +#ifdef ETHR_PTHREADS + for (i = 1; i < N_THR; i++) + if (pthread_join(tid[i], NULL) != 0) + return 1; +#endif + for (i = 0; i < N_THR; i++) + if (res[i]) + return 1; + return 0; +} + ], + erts_cv___after_morecore_hook_can_track_malloc=yes, + erts_cv___after_morecore_hook_can_track_malloc=no, + if test "x$erl_xcomp_after_morecore_hook" != "x"; then + erts_cv___after_morecore_hook_can_track_malloc=$erl_xcomp_after_morecore_hook + fi)]) + +if test "x$erts_cv___after_morecore_hook_can_track_malloc" = "xyes"; then + AC_DEFINE(ERTS___AFTER_MORECORE_HOOK_CAN_TRACK_MALLOC, 1, \ +[Define if __after_morecore_hook can track malloc()s core memory use.]) +fi + +if test "x$ac_cv_func_sbrk" = "xyes"; then + AC_CACHE_CHECK([types of sbrk()s return value and argument], + erts_cv_sbrk_ret_arg_types, + [ + + erts_cv_sbrk_ret_arg_types=unknown + ret_types="void *,char *" + arg_types="intptr_t,ptrdiff_t,int,long" + save_ifs="$IFS"; IFS="," + for rtype in $ret_types; do + for atype in $arg_types; do + IFS=$save_ifs + AC_TRY_COMPILE([#include + #include ], + [$rtype sbrk($atype incr);], + [erts_cv_sbrk_ret_arg_types="$rtype,$atype"]) + IFS="," + if test "$erts_cv_sbrk_ret_arg_types" != "unknown"; then + break 2 + fi + done + done + IFS=$save_ifs]) + + if test "$erts_cv_sbrk_ret_arg_types" != "unknown"; then + save_ifs="$IFS"; IFS="," + read ret_type arg_type < + #include ], + [$rtype brk($atype endds);], + [erts_cv_brk_ret_arg_types="$rtype,$atype"]) + IFS="," + if test "$erts_cv_brk_ret_arg_types" != "unknown"; then + break 2 + fi + done + done + IFS=$save_ifs]) + + if test "$erts_cv_brk_ret_arg_types" != "unknown"; then + save_ifs="$IFS"; IFS="," + read ret_type arg_type < +#include +#include +#ifdef HAVE_DLFCN_H +# include +#endif + +/* + * Our implementation requires that we have sbrk(), and 'end' or '_end'. + */ + +#if !defined(HAVE_SBRK) +# error no sbrk() +#endif +#if defined(HAVE_END_SYMBOL) +extern char end; +#elif defined(HAVE__END_SYMBOL) +extern char _end; +#else +# error no 'end' nor '_end' +#endif + +#ifndef USE_THREADS +#undef ETHR_PTHREADS +#endif + +#ifdef ETHR_PTHREADS +# ifdef ETHR_HAVE_PTHREAD_H +# include +# else +# ifdef ETHR_HAVE_MIT_PTHREAD_H +# include +# endif +# endif +# define N_THR 5 +#else +# define N_THR 1 +#endif + +#define SBRK_IMPL(RET_TYPE, SBRK, ARG_TYPE) \ +RET_TYPE SBRK (ARG_TYPE); \ +static RET_TYPE (*real_ ## SBRK)(ARG_TYPE) = NULL; \ +RET_TYPE \ +SBRK (ARG_TYPE arg) \ +{ \ + RET_TYPE res; \ + if (!real_ ## SBRK) real_ ## SBRK = dlsym(RTLD_NEXT, #SBRK); \ + res = (*real_ ## SBRK)(arg); \ + if (res != (RET_TYPE) -1) heap_end = (char *) (*real_ ## SBRK)(0); \ + return res; \ +} + +#define BRK_IMPL(RET_TYPE, BRK, ARG_TYPE) \ +RET_TYPE BRK (ARG_TYPE); \ +static RET_TYPE (*real_ ## BRK)(ARG_TYPE) = NULL; \ +RET_TYPE \ +BRK (ARG_TYPE arg) \ +{ \ + RET_TYPE res; \ + if (!real_ ## BRK) real_ ## BRK = dlsym(RTLD_NEXT, #BRK); \ + res = (*real_ ## BRK)(arg); \ + if (res != (RET_TYPE) -1) heap_end = (char *) arg; \ + return res; \ +} + +static char *heap_start = NULL; +static char *heap_end = NULL; + +SBRK_IMPL(SBRK_RET_TYPE, sbrk, SBRK_ARG_TYPE) +#ifdef HAVE_BRK + BRK_IMPL(BRK_RET_TYPE, brk, BRK_ARG_TYPE) +#endif + +#ifdef HAVE__SBRK + SBRK_IMPL(SBRK_RET_TYPE, _sbrk, SBRK_ARG_TYPE) +#endif +#ifdef HAVE__BRK + BRK_IMPL(BRK_RET_TYPE, _brk, BRK_ARG_TYPE) +#endif + +#ifdef HAVE___SBRK + SBRK_IMPL(SBRK_RET_TYPE, __sbrk, SBRK_ARG_TYPE) +#endif +#ifdef HAVE___BRK + BRK_IMPL(BRK_RET_TYPE, __brk, BRK_ARG_TYPE) +#endif + +static int +check_malloc(int size) +{ + char *p = (char *) malloc(size); + if (!heap_start || !heap_end) return 0; + if (!p) return 0; + if (p < heap_start || heap_end <= p) return 0; + if (p + size < heap_start || heap_end < p + size) return 0; + return 1; +} + +#ifdef ETHR_PTHREADS +pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER; +#endif + +static void * +do_tests(void *vresp) +{ + int i, ok = 0; +#ifdef ETHR_PTHREADS + if (pthread_mutex_lock(&mutex) != 0) + return NULL; +#endif + + for (i = 0; i < 10; i++) + if (!check_malloc(1000)) + goto failed; + for (i = 0; i < 100; i++) + if (!check_malloc(1)) + goto failed; + if (!check_malloc(1024*1024+1)) + goto failed; + if (!check_malloc(10*1024*1024+1)) + goto failed; + ok = 1; + + failed: +#ifdef ETHR_PTHREADS + if (pthread_mutex_unlock(&mutex) != 0) + return NULL; +#endif + if (ok) + *((int *) vresp) = 0; + return NULL; +} + + +int main(void) +{ + int res[N_THR], i; +#ifdef ETHR_PTHREADS + pthread_t tid[N_THR]; +#endif +#if defined(HAVE_END_SYMBOL) + heap_start = &end; +#elif defined(HAVE__END_SYMBOL) + heap_start = &_end; +#endif + +#if defined(HAVE_MALLOPT) && defined(M_MMAP_MAX) + (void) mallopt(M_MMAP_MAX, 0); +#endif + + for (i = 0; i < N_THR; i++) + res[i] = 1; +#ifdef ETHR_PTHREADS + for (i = 1; i < N_THR; i++) + if (pthread_create(&tid[i], NULL, do_tests, &res[i]) != 0) + return 1; +#endif + (void) do_tests(&res[0]); +#ifdef ETHR_PTHREADS + for (i = 1; i < N_THR; i++) + if (pthread_join(tid[i], NULL) != 0) + return 1; +#endif + for (i = 0; i < N_THR; i++) + if (res[i]) + return 1; + return 0; +} + ], + erts_cv_brk_wrappers_can_track_malloc=yes, + erts_cv_brk_wrappers_can_track_malloc=no, + erts_cv_brk_wrappers_can_track_malloc=no)]) + if test $erts_cv_brk_wrappers_can_track_malloc = yes; then + AC_DEFINE(ERTS_BRK_WRAPPERS_CAN_TRACK_MALLOC, 1, \ +[Define if sbrk()/brk() wrappers can track malloc()s core memory use]) + fi +fi + +dnl Restore LIBS +LIBS=$saved_libs +dnl restore CPPFLAGS +CPPFLAGS=$saved_cppflags + +LM_SYS_IPV6 +LM_SYS_MULTICAST +ERL_TIME_CORRECTION +AC_CHECK_PROG(M4, m4, m4) +dnl check to auto-enable hipe here... +if test X${enable_hipe} != Xno; then + if test -z "$M4"; then + enable_hipe=no + AC_MSG_NOTICE([HiPE disabled as no valid m4 is found in PATH]) + else + case "$ARCH-$OPSYS" in + x86-linux|amd64-linux|ppc-linux|ppc-darwin|arm-linux|amd64-freebsd|x86-freebsd|x86-sol2|amd64-sol2|ultrasparc-linux) + enable_hipe=yes + ;; + esac + fi +fi +if test X${enable_fp_exceptions} = Xauto ; then + if test X${enable_hipe} = Xyes; then + enable_fp_exceptions=yes + else + enable_fp_exceptions=no + AC_MSG_NOTICE([Floating point exceptions disabled by default in this configuration]) + fi +fi + +if test X${enable_fp_exceptions} != Xyes ; then + AC_DEFINE(NO_FPE_SIGNALS,[],[Define if floating points exceptions are non-existing/not reliable]) + FPE=unreliable +else + + AC_MSG_CHECKING([for unreliable floating point execptions]) + + + AC_TRY_RUN([ +/* fpe-test.c */ +#include +#include +#include + +volatile int erl_fp_exception; + +/* + * We expect a single SIGFPE in this test program. + * Getting many more indicates an inadequate SIGFPE handler, + * e.g. using the generic handler on x86. + */ +static void new_fp_exception(void) +{ + if (++erl_fp_exception > 50) { + fprintf(stderr, "SIGFPE loop detected, bailing out\n"); + exit(1); + } +} + +/* Is there no standard identifier for Darwin/MacOSX ? */ +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define __DARWIN__ 1 +#endif + +/* + * Implement unmask_fpe() and check_fpe() based on CPU/OS combination + */ + +#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) && !defined(__CYGWIN__) + +static void unmask_x87(void) +{ + unsigned short cw; + __asm__ __volatile__("fstcw %0" : "=m"(cw)); + cw &= ~(0x01|0x04|0x08); /* unmask IM, ZM, OM */ + __asm__ __volatile__("fldcw %0" : : "m"(cw)); +} + +static void unmask_sse2(void) +{ + unsigned int mxcsr; + __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr)); + mxcsr &= ~(0x003F|0x0680); /* clear exn flags, unmask OM, ZM, IM (not PM, UM, DM) */ + __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); +} + +#if defined(__x86_64__) + +static inline int cpu_has_sse2(void) { return 1; } + +#else /* !__x86_64__ */ + +/* + * Check if an x86-32 processor has SSE2. + */ +static unsigned int xor_eflags(unsigned int mask) +{ + unsigned int eax, edx; + + eax = mask; /* eax = mask */ + __asm__("pushfl\n\t" + "popl %0\n\t" /* edx = original EFLAGS */ + "xorl %0, %1\n\t" /* eax = mask ^ EFLAGS */ + "pushl %1\n\t" + "popfl\n\t" /* new EFLAGS = mask ^ original EFLAGS */ + "pushfl\n\t" + "popl %1\n\t" /* eax = new EFLAGS */ + "xorl %0, %1\n\t" /* eax = new EFLAGS ^ old EFLAGS */ + "pushl %0\n\t" + "popfl" /* restore original EFLAGS */ + : "=d"(edx), "=a"(eax) + : "1"(eax)); + return eax; +} + +static __inline__ unsigned int cpuid_eax(unsigned int op) +{ + unsigned int eax, save_ebx; + + /* In PIC mode i386 reserves EBX. So we must save + and restore it ourselves to not upset gcc. */ + __asm__( + "movl %%ebx, %1\n\t" + "cpuid\n\t" + "movl %1, %%ebx" + : "=a"(eax), "=m"(save_ebx) + : "0"(op) + : "cx", "dx"); + return eax; +} + +static __inline__ unsigned int cpuid_edx(unsigned int op) +{ + unsigned int eax, edx, save_ebx; + + /* In PIC mode i386 reserves EBX. So we must save + and restore it ourselves to not upset gcc. */ + __asm__( + "movl %%ebx, %2\n\t" + "cpuid\n\t" + "movl %2, %%ebx" + : "=a"(eax), "=d"(edx), "=m"(save_ebx) + : "0"(op) + : "cx"); + return edx; +} + +/* The AC bit, bit #18, is a new bit introduced in the EFLAGS + * register on the Intel486 processor to generate alignment + * faults. This bit cannot be set on the Intel386 processor. + */ +static __inline__ int is_386(void) +{ + return ((xor_eflags(1<<18) >> 18) & 1) == 0; +} + +/* Newer x86 processors have a CPUID instruction, as indicated by + * the ID bit (#21) in EFLAGS being modifiable. + */ +static __inline__ int has_CPUID(void) +{ + return (xor_eflags(1<<21) >> 21) & 1; +} + +static int cpu_has_sse2(void) +{ + unsigned int maxlev, features; + static int has_sse2 = -1; + + if (has_sse2 >= 0) + return has_sse2; + has_sse2 = 0; + + if (is_386()) + return 0; + if (!has_CPUID()) + return 0; + maxlev = cpuid_eax(0); + /* Intel A-step Pentium had a preliminary version of CPUID. + It also didn't have SSE2. */ + if ((maxlev & 0xFFFFFF00) == 0x0500) + return 0; + /* If max level is zero then CPUID cannot report any features. */ + if (maxlev == 0) + return 0; + features = cpuid_edx(1); + has_sse2 = (features & (1 << 26)) != 0; + + return has_sse2; +} +#endif /* !__x86_64__ */ + +static void unmask_fpe(void) +{ + unmask_x87(); + if (cpu_has_sse2()) + unmask_sse2(); +} + +static __inline__ int check_fpe(double f) +{ + __asm__ __volatile__("fwait" : "=m"(erl_fp_exception) : "m"(f)); + if (!erl_fp_exception) + return 0; + __asm__ __volatile__("fninit"); + unmask_fpe(); + return 1; +} + +#elif defined(__sparc__) && defined(__linux__) + +#if defined(__arch64__) +#define LDX "ldx" +#define STX "stx" +#else +#define LDX "ld" +#define STX "st" +#endif + +static void unmask_fpe(void) +{ + unsigned long fsr; + + __asm__(STX " %%fsr, %0" : "=m"(fsr)); + fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */ + fsr |= (0x1AUL << 23); /* enable NV, OF, DZ exceptions */ + __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); +} + +static __inline__ int check_fpe(double f) +{ + __asm__ __volatile__("" : "=m"(erl_fp_exception) : "em"(f)); + return erl_fp_exception; +} + +#elif (defined(__powerpc__) && defined(__linux__)) || (defined(__ppc__) && defined(__DARWIN__)) + +#if defined(__linux__) + +#include + +static void set_fpexc_precise(void) +{ + if (prctl(PR_SET_FPEXC, PR_FP_EXC_PRECISE) < 0) { + perror("PR_SET_FPEXC"); + exit(1); + } +} + +#elif defined(__DARWIN__) + +#include +#include + +/* + * FE0 FE1 MSR bits + * 0 0 floating-point exceptions disabled + * 0 1 floating-point imprecise nonrecoverable + * 1 0 floating-point imprecise recoverable + * 1 1 floating-point precise mode + * + * Apparently: + * - Darwin 5.5 (MacOS X <= 10.1) starts with FE0 == FE1 == 0, + * and resets FE0 and FE1 to 0 after each SIGFPE. + * - Darwin 6.0 (MacOS X 10.2) starts with FE0 == FE1 == 1, + * and does not reset FE0 or FE1 after a SIGFPE. + */ +#define FE0_MASK (1<<11) +#define FE1_MASK (1<<8) + +/* a thread cannot get or set its own MSR bits */ +static void *fpu_fpe_enable(void *arg) +{ + thread_t t = *(thread_t*)arg; + struct ppc_thread_state state; + unsigned int state_size = PPC_THREAD_STATE_COUNT; + + if (thread_get_state(t, PPC_THREAD_STATE, (natural_t*)&state, &state_size) != KERN_SUCCESS) { + perror("thread_get_state"); + exit(1); + } + if ((state.srr1 & (FE1_MASK|FE0_MASK)) != (FE1_MASK|FE0_MASK)) { +#if 0 + /* This would also have to be performed in the SIGFPE handler + to work around the MSR reset older Darwin releases do. */ + state.srr1 |= (FE1_MASK|FE0_MASK); + thread_set_state(t, PPC_THREAD_STATE, (natural_t*)&state, state_size); +#else + fprintf(stderr, "srr1 == 0x%08x, your Darwin is too old\n", state.srr1); + exit(1); +#endif + } + return NULL; /* Ok, we appear to be on Darwin 6.0 or later */ +} + +static void set_fpexc_precise(void) +{ + thread_t self = mach_thread_self(); + pthread_t enabler; + + if (pthread_create(&enabler, NULL, fpu_fpe_enable, &self)) { + perror("pthread_create"); + } else if (pthread_join(enabler, NULL)) { + perror("pthread_join"); + } +} + +#endif + +static void set_fpscr(unsigned int fpscr) +{ + union { + double d; + unsigned int fpscr[2]; + } u; + u.fpscr[0] = 0xFFF80000; + u.fpscr[1] = fpscr; + __asm__ __volatile__("mtfsf 255,%0" : : "f"(u.d)); +} + +static void unmask_fpe(void) +{ + set_fpexc_precise(); + set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */ +} + +static __inline__ int check_fpe(double f) +{ + __asm__ __volatile__("" : "=m"(erl_fp_exception) : "fm"(f)); + return erl_fp_exception; +} + +#else + +#include + +#define unmask_fpe() fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ) + +static __inline__ int check_fpe(double f) +{ + __asm__ __volatile__("" : "=m"(erl_fp_exception) : "g"(f)); + return erl_fp_exception; +} + +#endif + +/* + * Implement SIGFPE handler based on CPU/OS combination + */ + +#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__i386__) || defined(__x86_64__))) || (defined(__OpenBSD__) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) + +#if defined(__linux__) && defined(__i386__) +#if !defined(X86_FXSR_MAGIC) +#define X86_FXSR_MAGIC 0x0000 +#endif +#elif defined(__FreeBSD__) && defined(__i386__) +#include +#include +#elif defined(__FreeBSD__) && defined(__x86_64__) +#include +#include +#elif defined(__DARWIN__) +#include +#elif defined(__OpenBSD__) && defined(__x86_64__) +#include +#include +#endif +#if !(defined(__OpenBSD__) && defined(__x86_64__)) +#include +#endif +#include + +static void fpe_sig_action(int sig, siginfo_t *si, void *puc) +{ + ucontext_t *uc = puc; +#if defined(__linux__) +#if defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + fpregset_t fpstate = mc->fpregs; + fpstate->mxcsr = 0x1F80; + fpstate->swd &= ~0xFF; +#elif defined(__i386__) + mcontext_t *mc = &uc->uc_mcontext; + fpregset_t fpstate = mc->fpregs; + if ((fpstate->status >> 16) == X86_FXSR_MAGIC) + ((struct _fpstate*)fpstate)->mxcsr = 0x1F80; + fpstate->sw &= ~0xFF; +#elif defined(__sparc__) && defined(__arch64__) + /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ + struct sigcontext *sc = (struct sigcontext*)puc; + sc->sigc_regs.tpc = sc->sigc_regs.tnpc; + sc->sigc_regs.tnpc += 4; +#elif defined(__sparc__) + /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ + struct sigcontext *sc = (struct sigcontext*)puc; + sc->si_regs.pc = sc->si_regs.npc; + sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4; +#elif defined(__powerpc__) +#if defined(__powerpc64__) + mcontext_t *mc = &uc->uc_mcontext; + unsigned long *regs = &mc->gp_regs[0]; +#else + mcontext_t *mc = uc->uc_mcontext.uc_regs; + unsigned long *regs = &mc->gregs[0]; +#endif + regs[PT_NIP] += 4; + regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */ +#endif +#elif defined(__DARWIN__) +#if defined(__x86_64__) + mcontext_t mc = uc->uc_mcontext; + struct __darwin_x86_float_state64 *fpstate = &mc->__fs; + fpstate->__fpu_mxcsr = 0x1F80; + *(unsigned short *)&fpstate->__fpu_fsw &= ~0xFF; +#elif defined(__i386__) + mcontext_t mc = uc->uc_mcontext; + struct __darwin_i386_float_state *fpstate = &mc->__fs; + fpstate->__fpu_mxcsr = 0x1F80; + *(unsigned short *)&fpstate->__fpu_fsw &= ~0xFF; +#elif defined(__ppc__) + mcontext_t mc = uc->uc_mcontext; + mc->ss.srr0 += 4; + mc->fs.fpscr = 0x80|0x40|0x10; +#endif +#elif defined(__FreeBSD__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct savefpu *savefpu = (struct savefpu*)&mc->mc_fpstate; + struct envxmm *envxmm = &savefpu->sv_env; + envxmm->en_mxcsr = 0x1F80; + envxmm->en_sw &= ~0xFF; +#elif defined(__FreeBSD__) && defined(__i386__) + mcontext_t *mc = &uc->uc_mcontext; + union savefpu *savefpu = (union savefpu*)&mc->mc_fpstate; + if (mc->mc_fpformat == _MC_FPFMT_XMM) { + struct envxmm *envxmm = &savefpu->sv_xmm.sv_env; + envxmm->en_mxcsr = 0x1F80; + envxmm->en_sw &= ~0xFF; + } else { + struct env87 *env87 = &savefpu->sv_87.sv_env; + env87->en_sw &= ~0xFF; + } +#elif defined(__OpenBSD__) && defined(__x86_64__) + struct fxsave64 *fxsave = uc->sc_fpstate; + fxsave->fx_mxcsr = 0x1F80; + fxsave->fx_fsw &= ~0xFF; +#elif defined(__sun__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct fpchip_state *fpstate = &mc->fpregs.fp_reg_set.fpchip_state; + fpstate->mxcsr = 0x1F80; + fpstate->sw &= ~0xFF; +#endif + new_fp_exception(); +} + +static void catch_sigfpe(void) +{ + struct sigaction act; + + memset(&act, 0, sizeof act); + act.sa_sigaction = fpe_sig_action; + act.sa_flags = SA_SIGINFO; + sigaction(SIGFPE, &act, NULL); +} + +#else + +static void fpe_sig_handler(int sig) +{ + new_fp_exception(); +} + +static void catch_sigfpe(void) +{ + signal(SIGFPE, fpe_sig_handler); +} + +#endif + +/* + * Generic test code + */ + +static void do_init(void) +{ + catch_sigfpe(); + unmask_fpe(); +} + +double a = 3.23e133; +double b = 3.57e257; +double res; + +void do_fmul(void) +{ + res = a * b; +} + +int do_check(void) +{ + if (check_fpe(res)) { + fprintf(stderr, "res = %g, FPE worked\n", res); + return 0; + } else { + fprintf(stderr, "res = %g, FPE failed\n", res); + return 1; + } +} + +int main(int argc, const char **argv) +{ + if (argc == 3) { + a = atof(argv[1]); + b = atof(argv[2]); + } + do_init(); + do_fmul(); + return do_check(); +} +], erl_ok=reliable, erl_ok=unreliable, erl_ok=unreliable) + if test $erl_ok = unreliable; then + AC_DEFINE(NO_FPE_SIGNALS,[], + [Define if floating points exceptions are non-existing/not reliable]) + AC_MSG_RESULT([unreliable; testing in software instead]) + FPE=unreliable + else + AC_MSG_RESULT(reliable) + FPE=reliable + fi +fi + +case $ARCH-$OPSYS in + amd64-darwin*|x86-darwin*) + AC_MSG_CHECKING([For modern (leopard) style mcontext_t]) + AC_TRY_COMPILE([ + #include + #include + #include + #include + #include + #include + #include + ],[ + #if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) + #define __DARWIN__ 1 + #endif + + #ifndef __DARWIN__ + #error inpossible + #else + + mcontext_t mc = NULL; + int x = mc->__fs.__fpu_mxcsr; + + #endif + ],darwin_mcontext_leopard=yes, + darwin_mcontext_leopard=no) + if test X"$darwin_mcontext_leopard" = X"yes"; then + AC_DEFINE(DARWIN_MODERN_MCONTEXT,[],[Modern style mcontext_t in MacOSX]) + AC_MSG_RESULT(yes) + else + AC_MSG_RESULT(no) + fi + ;; + *) + darwin_mcontext_leopard=no + ;; +esac + + + + + + +dnl +dnl Some operating systems allow you to redefine FD_SETSIZE to be able +dnl to select on more than the default number of file descriptors. +dnl We first discovered this in BSD/OS where the default is ridiculously +dnl low (256). But since we use a lot of file descriptors we found the +dnl need to go over the limit in other os's as well. Since FD_SETSIZE +dnl must be defined before pulling in sys/types.h the actual number +dnl of file descriptors is set in acconfig.h and will thus be in config.h +dnl which *always* should be included first. +dnl + +AC_MSG_CHECKING([whether to redefine FD_SETSIZE]) +case $host_os in + bsdi*) + AC_DEFINE(REDEFINE_FD_SETSIZE,[],[Define if you wish to redefine FD_SETSIZE to be able to select on more fd]) + AC_MSG_RESULT(yes) + ;; + *) + AC_MSG_RESULT(no) + ;; +esac + + + +dnl ---------------------------------------------------------------------- +dnl Tests related to configurable options given on command line +dnl (using the --disable, --enable and --with switches). +dnl ---------------------------------------------------------------------- + +# +# Check if we should compile TSP app +# + +TSP_APP= +if test X${enable_tsp} = Xyes; then + TSP_APP=tsp +fi +AC_SUBST(TSP_APP) + +# +# Check if we should build hybrid emulator +# + +AC_MSG_CHECKING([whether a hybrid heap emulator should be built]) +case $enable_hybrid_heap-$host_os in + yes-*) + AC_MSG_RESULT([yes; enabled by user]) + ERTS_BUILD_HYBRID_EMU=yes;; + no-*) + AC_MSG_RESULT([no; disabled by user]) + ERTS_BUILD_HYBRID_EMU=no;; + *-win32|*-vxworks|*-ose) # vxworks and ose have their own "configure scripts"... + AC_MSG_RESULT([no; default on this platform]) + ERTS_BUILD_HYBRID_EMU=no;; + *) + AC_MSG_RESULT([yes; default on this platform]) + ERTS_BUILD_HYBRID_EMU=yes;; +esac + + +if test $ERTS_BUILD_HYBRID_EMU = yes; then + AC_DEFINE(ERTS_HAVE_HYBRID_EMU, 1, [Define if the hybrid emulator is built]) +fi + +AC_SUBST(ERTS_BUILD_HYBRID_EMU) + +# +# Check if we should enable HiPE. +# + +HIPE_ENABLED= +HIPE_HELPERS= + +dnl if not disabled, autoenable HiPE on known supported platforms +dnl done up where floating point is checked, need to descide there already... + +if test X${enable_hipe} = Xyes; then + if test X$ac_cv_sizeof_void_p != X4 -a X$ARCH != Xamd64 -a X$ARCH != Xppc64; then + AC_MSG_WARN([HiPE is not supported in 64-bit builds]) + elif test X$FPE != Xreliable -a X$ARCH != Xarm; then + AC_MSG_WARN([HiPE is not supported on $ARCH without reliable floating-point exceptions]) + else + HIPE_ENABLED=yes + AC_DEFINE(HIPE,[1],[Define to enable HiPE]) + HIPE_HELPERS="xmerl syntax_tools edoc" + ENABLE_ALLOC_TYPE_VARS="$ENABLE_ALLOC_TYPE_VARS hipe" + fi +fi +AC_SUBST(HIPE_HELPERS) +AC_SUBST(HIPE_ENABLED) + +# +# Check if Erlang libraries should be compiled to native code. +# +NATIVE_LIBS_ENABLED= +if test X${enable_native_libs} = Xyes -a X${HIPE_ENABLED} = Xyes; then + NATIVE_LIBS_ENABLED=yes +fi +AC_SUBST(NATIVE_LIBS_ENABLED) + +# +# Check if HiPE should use a standard installation of perfctr. +# +AC_SUBST(USE_PERFCTR) +if test "x$HIPE_ENABLED" = "xyes" ; then + if test "x$with_perfctr" = "x" ; then + AC_CHECK_LIB(perfctr, vperfctr_info, [USE_PERFCTR=1 + AC_DEFINE(USE_PERFCTR,[1],[Define to enable hrvtime() on Linux systems with perfctr extension])]) + elif test "x$with_perfctr" != "xno" ; then + USE_PERFCTR=1 + fi +fi + +# +# Check if we should use elib_malloc. +# + +if test X${enable_elib_malloc} = Xyes; then + AC_DEFINE(ENABLE_ELIB_MALLOC,[],[Define to enable use of elib_malloc (a malloc() replacement)]) + AC_DEFINE(ELIB_HEAP_SBRK,[],[Elib sbrk]) + AC_DEFINE(ELIB_ALLOC_IS_CLIB,[],[Use elib malloc as clib]) + AC_DEFINE(ELIB_SORTED_BLOCKS,[],[Define to enable the use of sorted blocks when using elib_malloc]) +fi + +# +# Check for working poll(). +# +AC_MSG_CHECKING([for working poll()]) +if test "x$erl_xcomp_poll" != "x"; then + poll_works=$erl_xcomp_poll +else +AC_TRY_RUN([ +#include +main() +{ +#ifdef _POLL_EMUL_H_ + exit(1); /* Implemented using select() -- fail */ +#else + struct pollfd fds[1]; + int fd; + fd = open("/dev/null", 1); + fds[0].fd = fd; + fds[0].events = POLLIN; + fds[0].revents = 0; + if (poll(fds, 1, 0) < 0 || (fds[0].revents & POLLNVAL) != 0) { + exit(1); /* Does not work for devices -- fail */ + } + exit(0); +#endif +} +], poll_works=true, poll_works=false, poll_works=false) +fi +case $poll_works in +true) + AC_DEFINE(ERTS_USE_POLL, 1, [Define if poll() should be used instead of select()]) + AC_MSG_RESULT(ok) + ;; +*) + # + # The USE_SELECT define is used by the ssl application (should not + # be used by erts). + # + AC_DEFINE(USE_SELECT, 1, [Define if select() should be used instead of poll()]) + AC_MSG_RESULT(broken or based on select()) + ;; +esac + +# +# If kqueue() found, check that it can be selected or polled on... +# +if test $have_kernel_poll = kqueue; then + if test $poll_works = true; then + kqueue_with=poll + else + kqueue_with=select + fi + AC_MSG_CHECKING([whether kqueue() fd can be ${kqueue_with}()ed on]) + AC_TRY_RUN([ +#include +#include +#include +#include +#ifdef ERTS_USE_POLL +#include +#else +#include +#endif +int main(void) { + int kq = kqueue(); + if (kq < 0) return 2; + { +#ifdef ERTS_USE_POLL + struct pollfd pfds = {kq, POLLIN, 0}; + if (poll(&pfds, 1, 0) < 0) return 1; +#else + struct timeval tv = {0, 0}; + fd_set set; FD_ZERO(&set); FD_SET(kq, &set); + if (select(kq+1, &set, NULL, NULL, &tv) < 0) return 1; +#endif + } + return 0; +} + ], ok_kqueue=true, ok_kqueue=false, ok_kqueue=false) + if test $ok_kqueue = true; then + AC_MSG_RESULT(yes); + else + AC_MSG_RESULT(no); + have_kernel_poll=no + fi +fi + +# +# If epoll() found, check that it is level triggered. +# +if test $have_kernel_poll = epoll; then + AC_MSG_CHECKING([whether epoll is level triggered]) + AC_TRY_COMPILE([#include ],[ + #ifdef EPOLLET + /* Edge triggered option exist, assume level triggered + is default */ + ; + #else + /* No edge triggered option exist; assume edge + triggered only */ + #error No EPOLLET + #endif + ], + level_triggered_epoll=yes, + [level_triggered_epoll=no + have_kernel_poll=no]) + AC_MSG_RESULT([$level_triggered_epoll]) +fi +# +# Check if we should enable kernel poll support +# +AC_MSG_CHECKING(whether kernel poll support should be enabled) +ERTS_ENABLE_KERNEL_POLL=no +case $enable_kernel_poll-$have_kernel_poll in + no-*) + AC_MSG_RESULT(no; disabled by user);; + yes-no) + AC_MSG_ERROR(no; kernel poll support requested but not found);; + *-no) + AC_MSG_RESULT(no);; + *) + case $have_kernel_poll in + epoll) + AC_DEFINE(HAVE_SYS_EPOLL_H, 1, [Define if you have the header file.]);; + /dev/poll) + AC_DEFINE(HAVE_SYS_DEVPOLL_H, 1, [Define if you have header file.]);; + kqueue) + AC_DEFINE(HAVE_SYS_EVENT_H, 1, [Define if you have header file.]);; + *) + AC_MSG_ERROR(configure.in need to be updated);; + esac + ERTS_ENABLE_KERNEL_POLL=yes + AC_DEFINE(ERTS_ENABLE_KERNEL_POLL, 1, [Define if you have kernel poll and want to use it]) + AC_MSG_RESULT([yes; $have_kernel_poll]);; +esac +AC_SUBST(ERTS_ENABLE_KERNEL_POLL) + +AC_MSG_CHECKING([whether putenv() stores a copy of the key-value pair]) +AC_TRY_RUN([ +#include +int main(void) { + int i; + char *env; + char buf[10]; + for (i = 0; i < 7; i++) + buf[i] = 'X'; + buf[i] = '\0'; + buf[3] = '='; + if (putenv(buf) != 0) + return 1; + for (i = 4; i < 7; i++) + buf[i] = 'Y'; + env = getenv("XXX"); + if (!env) + return 2; + for (i = 0; i < 3; i++) + if (env[i] != 'X') + return 3; + for (i = 0; i < 3; i++) + buf[i] = 'Y'; + env = getenv("XXX"); + if (!env) + return 4; + for (i = 0; i < 3; i++) + if (env[i] != 'X') + return 5; + return 0; +} +], copying_putenv=yes, copying_putenv=no, copying_putenv=no) +if test $copying_putenv = yes; then + AC_DEFINE(HAVE_COPYING_PUTENV,[1],[Define if you have a putenv() that stores a copy of the key-value pair]) +fi +AC_MSG_RESULT($copying_putenv) + +dnl ---------------------------------------------------------------------- +dnl Stuff that should be moved into their respective application +dnl ---------------------------------------------------------------------- + +dnl crypto +#-------------------------------------------------------------------- +# Dynamic Erlang Drivers +# +# Linking to produce dynamic Erlang drivers to be loaded by Erlang's +# Dynamic Driver Loader and Linker (DDLL). Below the prefix DED is an +# abbreviation for `Dynamic Erlang Driver'. +# +# For DED we need something quite sloppy, which allows undefined references +# (notably driver functions) in the resulting shared library. +# Example of Makefile rule (and settings of macros): +# +# LIBS = @LIBS@ +# LD = @DED_LD@ +# LDFLAGS = @DED_LDFLAGS@ +# soname = @ldsoname@ +# +# my_drv.so: my_drv.o my_utils.o +# $(LD) $(LDFLAGS) $(soname) $@ -o $@ $^ -lc $(LIBS) +# +#-------------------------------------------------------------------- + +DED_INCLUDE="-I${ERL_TOP}/erts/emulator/beam -I${ERL_TOP}/erts/include -I${ERL_TOP}/erts/include/$host" + +DED_CFLAGS="$DED_INCLUDE $CFLAGS $CPPFLAGS $EMU_THR_DEFS" +if test "x$GCC" = xyes; then + DED_CFLAGS="$DED_CFLAGS -fPIC" +fi + +STATIC_CFLAGS="" + +# If DED_LD is set in environment, we expect all DED variables to be specified +# (cross compiling) +if test "x$DED_LD" = "x"; then + +if test "x$LD" = "x"; then + DED_LD=ld +else + DED_LD=$LD +fi +DED_LD_FLAG_RUNTIME_LIBRARY_PATH="-R" + +case $host_os in + win32) + DED_LD=ld.sh + DED_LDFLAGS="-dll" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + ;; + solaris2*|sysv4*) + DED_LDFLAGS="-G" + if test X${enable_m64_build} = Xyes; then + DED_LDFLAGS="-64 $DED_LDFLAGS" + fi + ;; + aix4*) + DED_LDFLAGS="-G -bnoentry -bexpall" + ;; + freebsd2*) + # Non-ELF GNU linker + DED_LDFLAGS="-Bshareable" + ;; + darwin*) + # Mach-O linker: a shared lib and a loadable + # object file is not the same thing. + DED_LDFLAGS="-bundle -flat_namespace -undefined suppress" + case $ARCH in + amd64) + DED_LDFLAGS="-m64 $DED_LDFLAGS" + ;; + *) + if test X${enable_darwin_universal} != Xyes; then + DED_LDFLAGS="-m32 $DED_LDFLAGS" + fi + ;; + esac + if test X${enable_darwin_universal} = Xyes; then + DED_LDFLAGS="-arch ppc -arch i386 $DED_LDFLAGS" + fi + DED_CFLAGS="$DED_CFLAGS -fno-common" + DED_LD="$CC" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + STATIC_CFLAGS="-mdynamic-no-pic" + ;; + linux*) + DED_LD="$CC" + DED_LDFLAGS="-shared -Wl,-Bsymbolic" + DED_LD_FLAG_RUNTIME_LIBRARY_PATH= + if test X${enable_m64_build} = Xyes; then + DED_LDFLAGS="-m64 $DED_LDFLAGS" + fi + ;; + freebsd*) + DED_LD="$CC" + DED_LDFLAGS="-shared" + if test X${enable_m64_build} = Xyes; then + DED_LDFLAGS="-m64 $DED_LDFLAGS" + fi + ;; + osf*) + # NOTE! Whitespace after -rpath is important. + DED_LD_FLAG_RUNTIME_LIBRARY_PATH="-rpath " + DED_LDFLAGS="-shared -expect_unresolved '*'" + ;; + *) + # assume GNU linker and ELF + DED_LDFLAGS="-shared" + # GNU linker has no option for 64bit build, should not propagate -m64 + ;; +esac + +fi + +AC_MSG_CHECKING(for compiler flags for loadable drivers) +AC_MSG_RESULT([$DED_CFLAGS]) +AC_MSG_CHECKING(for linker for loadable drivers) +AC_MSG_RESULT([$DED_LD]) +AC_MSG_CHECKING(for linker flags for loadable drivers) +AC_MSG_RESULT([$DED_LDFLAGS]) +AC_MSG_CHECKING(for 'runtime library path' linker flag) +if test "x$DED_LD_FLAG_RUNTIME_LIBRARY_PATH" != "x"; then + AC_MSG_RESULT([$DED_LD_FLAG_RUNTIME_LIBRARY_PATH]) +else + AC_MSG_RESULT([not found]) +fi + +AC_SUBST(DED_CFLAGS) +AC_SUBST(DED_LD) +AC_SUBST(DED_LDFLAGS) +AC_SUBST(DED_LD_FLAG_RUNTIME_LIBRARY_PATH) +AC_SUBST(STATIC_CFLAGS) + +dnl +dnl We should look for a compiler that handles jump tables, for beam_emu +dnl to be optimized +dnl + +LM_FIND_EMU_CC + +dnl +dnl SSL, SSH and CRYPTO need the OpenSSL libraries +dnl +dnl Check flags --with-ssl, --without-ssl --with-ssl=PATH. +dnl If no option is given or --with-ssl is set without a path then we +dnl search for OpenSSL libraries and header files in the standard locations. +dnl If set to --without-ssl we disable the use of SSL, SSH and CRYPTO. +dnl If set to --with-ssl=PATH we use that path as the prefix, i.e. we +dnl use "PATH/include" and "PATH/lib". + +AC_SUBST(SSL_INCLUDE) +AC_SUBST(SSL_ROOT) +AC_SUBST(SSL_LIBDIR) +AC_SUBST(SSL_DYNAMIC_ONLY) +AC_SUBST(SSL_LINK_WITH_KERBEROS) +AC_SUBST(STATIC_KERBEROS_LIBS) +AC_SUBST(SSL_LINK_WITH_ZLIB) +AC_SUBST(STATIC_ZLIB_LIBS) +AC_SUBST(OPENSSL_CMD) + +AC_ARG_WITH(ssl-zlib, +[ --with-ssl-zlib=PATH specify location of ZLib to be used by OpenSSL + --with-ssl-zlib link SSL with Zlib (default if found) + --without-ssl-zlib don't link SSL with ZLib]) + + +if test "x$with_ssl_zlib" = "xno"; then + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= +elif test "x$with_ssl_zlib" = "xyes" -o "x$with_ssl_zlib" = "x" ;then + if test "x$MIXED_CYGWIN" = "xyes"; then + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= + else + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= + AC_MSG_CHECKING(for static ZLib to be used by SSL in standard locations) + for dir in /usr/local /usr/sfw /usr /usr/pkg \ + /usr/local/openssl /usr/lib/openssl /usr/openssl \ + /usr/local/ssl /usr/lib/ssl /usr/ssl + do + if test "x$ac_cv_sizeof_void_p" = "x8"; then + if test -f "$dir/lib64/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS="$dir/lib64/libz.a" + break + elif test -f "$dir/lib/64/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS="$dir/lib/64/libz.a" + break + fi + fi + if test -f "$dir/lib/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS="$dir/lib/libz.a" + break + fi + done + if test "x$SSL_LINK_WITH_ZLIB" = "xno"; then + AC_MSG_RESULT([no]) + else + AC_MSG_RESULT([$STATIC_ZLIB_LIBS]) + fi + fi +else + SSL_LINK_WITH_ZLIB=no + STATIC_ZLIB_LIBS= + if test -f "$with_ssl_zlib/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS=$with_ssl_zlib/libz.a + elif test -f "$with_ssl_zlib/lib/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS=$with_ssl_zlib/lib/libz.a + fi + if test "x$ac_cv_sizeof_void_p" = "x8"; then + if test -f "$with_ssl_zlib/lib64/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS=$with_ssl_zlib/lib64/libz.a + elif test -f "$with_ssl_zlib/lib/64/libz.a"; then + SSL_LINK_WITH_ZLIB=yes + STATIC_ZLIB_LIBS=$with_ssl_zlib/lib/64/libz.a + fi + fi + if test "x$SSL_LINK_WITH_ZLIB" = "xno"; then + AC_MSG_ERROR(Invalid path to option --with-ssl-zlib=PATH) + fi +fi + + +AC_ARG_WITH(ssl, +[ --with-ssl=PATH specify location of OpenSSL include and lib + --with-ssl use SSL (default) + --without-ssl don't use SSL]) + +AC_ARG_ENABLE(dynamic-ssl-lib, +[ --enable-dynamic-ssl-lib enable using dynamic openssl libraries + --disable-dynamic-ssl-lib disable using dynamic openssl libraries], +[ case "$enableval" in + no) enable_dynamic_ssl=no ;; + *) enable_dynamic_ssl=yes ;; + esac ], enable_dynamic_ssl=yes) + +#---------------------------------------------------------------------- +# We actually might do the SSL tests twice due to late discovery of +# kerberos problems with static linking, in case we redo it all trying +# dynamic SSL libraries instead. +#---------------------------------------------------------------------- + +ssl_done=no + +while test "x$ssl_done" != "xyes"; do + +ssl_done=yes # Default only one run + +# Remove all SKIP files from previous runs +for a in ssl crypto ssh; do + /bin/rm -f $ERL_TOP/lib/$a/SKIP +done + +SSL_DYNAMIC_ONLY=$enable_dynamic_ssl + +if test "x$with_ssl" = "xno"; then + SSL_APP= + CRYPTO_APP= + SSH_APP= + for a in ssl crypto ssh; do + echo "User gave --without-ssl option" > $ERL_TOP/lib/$a/SKIP + done +elif test "x$with_ssl" = "xyes" -o "x$with_ssl" = "x" ;then + # On windows, we could try to find the installation + # of Shining Light OpenSSL, which can be found by poking in + # the uninstall section in the registry, it's worth a try... + extra_dir="" + if test "x$MIXED_CYGWIN" = "xyes"; then + AC_CHECK_PROG(REGTOOL, regtool, regtool, false) + if test "$ac_cv_prog_REGTOOL" != false; then + wrp="/machine/software/microsoft/windows/currentversion/" + urp="uninstall/openssl_is1/inno setup: app path" + rp="$wrp$urp" + if regtool -q get "$rp" > /dev/null; then + ssl_install_dir=`regtool -q get "$rp"` + # Try hard to get rid of spaces... + if cygpath -d "$ssl_install_dir" > /dev/null 2>&1; then + ssl_install_dir=`cygpath -d "$ssl_install_dir"` + fi + extra_dir=`cygpath $ssl_install_dir` + fi + fi + fi + # We search for OpenSSL in the common OS standard locations. + SSL_APP=ssl + CRYPTO_APP=crypto + SSH_APP=ssh + + AC_MSG_CHECKING(for OpenSSL >= 0.9.7 in standard locations) + for dir in $extra_dir /cygdrive/c/OpenSSL \ + /usr/local /usr/sfw /opt/local /usr /usr/pkg \ + /usr/local/openssl /usr/lib/openssl /usr/openssl \ + /usr/local/ssl /usr/lib/ssl /usr/ssl + do + if test -f $dir/include/openssl/opensslv.h; then + is_real_ssl=yes + SSL_ROOT="$dir" + if test "x$MIXED_CYGWIN" = "xyes" ; then + if test -f "$dir/lib/VC/ssleay32.lib" -o \ + -f "$dir/lib/VC/openssl.lib"; then + SSL_LIBDIR="$dir/lib/VC" + elif test -f "$dir/lib/ssleay32.lib" -o \ + -f "$dir/lib/openssl.lib"; then + SSL_LIBDIR="$dir/lib" + else + is_real_ssl=no + fi + else + if test "x$ac_cv_sizeof_void_p" = "x8"; then + if test -f "$dir/lib64/libcrypto.a"; then + SSL_LIBDIR="$dir/lib64" + elif test -f "$dir/lib/64/libcrypto.a"; then + SSL_LIBDIR="$dir/lib/64" + elif test -f "$dir/lib64/libcrypto.so"; then + SSL_LIBDIR="$dir/lib64" + elif test -f "$dir/lib/64/libcrypto.so"; then + SSL_LIBDIR="$dir/lib/64" + else + SSL_LIBDIR="$dir/lib" + fi + else + SSL_LIBDIR="$dir/lib" + fi + fi + if test '!' -f $SSL_LIBDIR/libcrypto.a; then + SSL_DYNAMIC_ONLY=yes + fi + SSL_BINDIR="$dir/bin" +dnl Should one use EXEEXT or ac_exeext? + if test -f "$SSL_BINDIR/openssl$EXEEXT"; then + if "$SSL_BINDIR/openssl" version > /dev/null 2>&1; then + OPENSSL_CMD="$SSL_BINDIR/openssl" + else + is_real_ssl=no + fi + else + is_real_ssl=no + fi + if test "x$is_real_ssl" = "xyes" ; then + SSL_INCLUDE="-I$dir/include" + old_CPPFLAGS=$CPPFLAGS + CPPFLAGS=$SSL_INCLUDE + AC_EGREP_CPP(yes,[ +#include +#if OPENSSL_VERSION_NUMBER >= 0x0090700fL + yes +#endif + ],[ + ssl_found=yes + ],[ + SSL_APP= + ssl_found=no + ]) + CPPFLAGS=$old_CPPFLAGS + if test "x$ssl_found" = "xyes"; then + if test "x$MIXED_CYGWIN" = "xyes" ; then + ssl_linkable=yes + else + saveCFLAGS="$CFLAGS" + saveLDFLAGS="$LDFLAGS" + saveLIBS="$LIBS" + CFLAGS="$CFLAGS $SSL_INCLUDE" + LDFLAGS="$LDFLAGS -L$SSL_LIBDIR" + LIBS="-lcrypto" + AC_TRY_LINK([ + #include + #include ], + [ + HMAC_CTX hc; + HMAC_CTX_init(&hc); + ], + [ssl_linkable=yes], + [ssl_linkable=no]) + CFLAGS="$saveCFLAGS" + LDFLAGS="$saveLDFLAGS" + LIBS="$saveLIBS" + fi + fi + if test "x$ssl_found" = "xyes" -a "x$ssl_linkable" = "xyes" ; then + AC_MSG_RESULT([$dir]) + break; + fi + fi + fi + done + + if test "x$ssl_found" != "xyes" ; then + dnl + dnl If no SSL found above, check whether we are running on OpenBSD. + dnl + case $host_os in + openbsd*) + if test -f /usr/include/openssl/opensslv.h; then + # Trust OpenBSD to have everything the in the correct locations. + ssl_found=yes + ssl_linkable=yes + SSL_ROOT="/usr/sbin" + AC_MSG_RESULT([$SSL_ROOT]) + SSL_LIB="/usr/lib" + SSL_BINDIR="/usr/sbin" + OPENSSL_CMD="$SSL_BINDIR/openssl" + dnl OpenBSD requires us to link with -L and -l + SSL_DYNAMIC_ONLY="yes" + fi + ;; + esac + fi +dnl Now, certain linuxes have a 64bit libcrypto +dnl that cannot build shared libraries (i.e. not PIC) +dnl One could argue that this is wrong, but +dnl so it is - be adoptable + if test "x$ssl_found" = "xyes" -a "x$ssl_linkable" = "xyes" -a "x$SSL_DYNAMIC_ONLY" != "xyes" ; then + case $host_os in + linux*) + saveCFLAGS="$CFLAGS" + saveLDFLAGS="$LDFLAGS" + saveLIBS="$LIBS" + CFLAGS="$DED_CFLAGS $SSL_INCLUDE" + LDFLAGS="$DED_LDFLAGS" + LIBS="$SSL_LIBDIR/libcrypto.a $STATIC_ZLIB_LIBS" + AC_TRY_LINK([ + #include + #include ], + [ + HMAC_CTX hc; + HMAC_CTX_init(&hc); + ], + [ssl_dyn_linkable=yes], + [ssl_dyn_linkable=no]) + CFLAGS="$saveCFLAGS" + LDFLAGS="$saveLDFLAGS" + LIBS="$saveLIBS" + if test "x$ssl_dyn_linkable" != "xyes"; then + SSL_DYNAMIC_ONLY=yes + AC_MSG_WARN([SSL will be linked against dynamic lib as static lib is not purely relocatable]) + fi + ;; + esac + fi + + + + + if test "x$ssl_found" != "xyes" -o "x$ssl_linkable" != "xyes"; then + if test "x$ssl_found" = "xyes"; then + AC_MSG_RESULT([found; but not usable]) + else + AC_MSG_RESULT([no]) + fi + SSL_APP= + CRYPTO_APP= + SSH_APP= + AC_MSG_WARN([No (usable) OpenSSL found, skipping ssl, ssh and crypto applications]) + + for a in ssl crypto ssh; do + echo "No usable OpenSSL found" > $ERL_TOP/lib/$a/SKIP + done + fi +else + # Option given with PATH to package + if test ! -d "$with_ssl" ; then + AC_MSG_ERROR(Invalid path to option --with-ssl=PATH) + fi + SSL_ROOT="$with_ssl" + if test "x$MIXED_CYGWIN" = "xyes" -a -d "$with_ssl/lib/VC"; then + SSL_LIBDIR="$with_ssl/lib/VC" + elif test "x$ac_cv_sizeof_void_p" = "x8"; then + if test -f "$with_ssl/lib64/libcrypto.a"; then + SSL_LIBDIR="$with_ssl/lib64" + elif test -f "$with_ssl/lib/64/libcrypto.a"; then + SSL_LIBDIR="$with_ssl/lib/64" + elif test -f "$with_ssl/lib64/libcrypto.so"; then + SSL_LIBDIR="$with_ssl/lib64" + elif test -f "$with_ssl/lib/64/libcrypto.so"; then + SSL_LIBDIR="$with_ssl/lib/64" + else + SSL_LIBDIR="$with_ssl/lib" + fi + else + SSL_LIBDIR="$with_ssl/lib" + fi + if test '!' -f $SSL_LIBDIR/libcrypto.a; then + SSL_DYNAMIC_ONLY=yes + fi + SSL_INCLUDE="-I$with_ssl/include" + OPENSSL_CMD="$with_ssl/bin/openssl" + SSL_APP=ssl + CRYPTO_APP=crypto + SSH_APP=ssh +fi + +if test "x$SSL_APP" != "x" ; then + dnl We found openssl, now check if we use kerberos 5 support + AC_MSG_CHECKING(for OpenSSL kerberos 5 support) + old_CPPFLAGS=$CPPFLAGS + CPPFLAGS=$SSL_INCLUDE + AC_EGREP_CPP(yes,[ +#include +#ifndef OPENSSL_NO_KRB5 + yes +#endif + ],[ + AC_MSG_RESULT([yes]) + ssl_krb5_enabled=yes + if test "x$SSL_DYNAMIC_ONLY" != "xyes"; then + if test -f $SSL_LIBDIR/libkrb5.a; then + SSL_LINK_WITH_KERBEROS=yes + STATIC_KERBEROS_LIBS="$SSL_LIBDIR/libkrb5.a" + if test -f $SSL_LIBDIR/libkrb5support.a; then + STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libkrb5support.a" + fi + if test -f $SSL_LIBDIR/libk5crypto.a; then + STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libk5crypto.a" + fi + if test -f $SSL_LIBDIR/libresolv.a; then + STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libresolv.a" + fi + if test -f $SSL_LIBDIR/libcom_err.a; then + STATIC_KERBEROS_LIBS="$STATIC_KERBEROS_LIBS $SSL_LIBDIR/libcom_err.a" + fi + else + AC_MSG_WARN([Kerberos needed but no kerberos static libraries found]) + AC_MSG_WARN([Rescanning for dynamic SSL libraries]) + enable_dynamic_ssl=yes + ssl_done=no + SSL_LINK_WITH_KERBEROS=no + STATIC_KERBEROS_LIBS="" + ssl_krb5_enabled=no + SSL_WITH_KERBEROS=no + fi + else + SSL_LINK_WITH_KERBEROS=no + STATIC_KERBEROS_LIBS="" + fi + ],[ + AC_MSG_RESULT([no]) + ssl_krb5_enabled=no + SSL_WITH_KERBEROS=no + ]) + CPPFLAGS=$old_CPPFLAGS + SSL_KRB5_INCLUDE= + if test "x$ssl_krb5_enabled" = "xyes" ; then + AC_MSG_CHECKING(for krb5.h in standard locations) + for dir in $extra_dir $SSL_ROOT/include $SSL_ROOT/include/openssl \ + $SSL_ROOT/include/kerberos /cygdrive/c/kerberos/include \ + /usr/local/kerberos/include /usr/kerberos/include \ + /usr/include + do + if test -f "$dir/krb5.h" ; then + SSL_KRB5_INCLUDE="$dir" + break + fi + done + if test "x$SSL_KRB5_INCLUDE" = "x" ; then + AC_MSG_RESULT([not found]) + SSL_APP= + CRYPTO_APP= + SSH_APP= + AC_MSG_WARN([OpenSSL is configured for kerberos but no krb5.h found]) + for a in ssl crypto ssh ; do + echo "OpenSSL is configured for kerberos but no krb5.h found" > $ERL_TOP/lib/$a/SKIP + done + else + AC_MSG_RESULT([found in $SSL_KRB5_INCLUDE]) + SSL_INCLUDE="$SSL_INCLUDE -I$SSL_KRB5_INCLUDE" + fi + fi +fi + +done # while test ssl_done != yes + +#-------------------------------------------------------------------- +# Os mon stuff. +#-------------------------------------------------------------------- +AC_SUBST(os_mon_programs) +AC_SUBST(CPU_SUP_LIBS) + +AC_CHECK_LIB(kstat, kstat_open, [ + os_mon_programs="$os_mon_programs cpu_sup" + CPU_SUP_LIBS="$CPU_SUP_LIBS -lkstat" + ]) + +case $host_os in + solaris2*) + os_mon_programs="$os_mon_programs ferrule mod_syslog" ;; + linux*) + os_mon_programs="$os_mon_programs cpu_sup" ;; +esac + + +dnl +dnl Then there are a number of apps which needs a java compiler... +dnl +need_java="jinterface ic/java_src" + +# Remove all SKIP files from previous runs +for a in $need_java ; do + /bin/rm -f $ERL_TOP/lib/$a/SKIP +done + +AC_CHECK_PROGS(JAVAC, javac.sh javac guavac gcj jikes bock) +if test -n "$JAVAC"; then + dnl Make sure it's at least JDK 1.5 + AC_CACHE_CHECK(for JDK version 1.5, + ac_cv_prog_javac_ver_1_5, + [ERL_TRY_LINK_JAVA([], [for (String i : args);], + ac_cv_prog_javac_ver_1_5=yes, ac_cv_prog_javac_ver_1_5=no)]) + if test $ac_cv_prog_javac_ver_1_5 = no; then + unset -v JAVAC + fi +fi +if test -z "$JAVAC"; then + AC_MSG_WARN([Could not find any usable java compiler, will skip: jinterface]) + + for a in $need_java ; do + echo "No Java compiler found" > $ERL_TOP/lib/$a/SKIP + done +fi + +dnl +dnl Orber has a c++ example, this isn't the right way to check for +dnl it, but.... +dnl +CXXFLAGS= +AC_SUBST(CXXFLAGS) +dnl this deliberately does not believe that 'gcc' is a C++ compiler +AC_CHECK_PROGS(CXX, $CCC c++ g++ CC cxx cc++ cl, false) + +# Remove SKIP file from previous run +/bin/rm -f $ERL_TOP/lib/orber/SKIP + +if test "$CXX" = false; then + echo "No C++ compiler found" > $ERL_TOP/lib/orber/SKIP +fi + +dnl ---------------------------------------------------------------------- +dnl Include CPPFLAGS in CFLAGS +dnl ---------------------------------------------------------------------- +CFLAGS="$CFLAGS $CPPFLAGS" + +# +# Currently if we compile for 64 bits we want to compile +# some external port programs using 32 bits +# + +# If not defined we trust the C compiler in $CC to do 32 bits +if test -z "$CC32"; then + CC32="$CC" +fi + +if test -z "$CFLAGS32"; then + if test $ac_cv_sizeof_void_p != 4; then + # We are compiling default 64 bits and use -m32 for 32 bit compilations + CFLAGS32="$CFLAGS -m32" + else + CFLAGS32="$CFLAGS" + fi +fi + +AC_SUBST(CC32) +AC_SUBST(CFLAGS32) + +dnl +dnl ERTS_EMU_CMDLINE_FLAGS will force modification of config.h when +dnl the emulator command line flags are modified by configure, which +dnl in turn will make 'make' detect that files depending on config.h +dnl needs to be rebuilt. +dnl + +AC_DEFINE_UNQUOTED(ERTS_EMU_CMDLINE_FLAGS, +"$STATIC_CFLAGS $CFLAGS $DEBUG_CFLAGS $EMU_THR_DEFS $DEFS $WFLAGS", +[The only reason ERTS_EMU_CMDLINE_FLAGS exists is to force modification of config.h when the emulator command line flags are modified by configure]) + +dnl ---------------------------------------------------------------------- +dnl Directories needed for the build +dnl ---------------------------------------------------------------------- + +erts=${erl_top}/erts + +erts_dirs=" + $erts/obj $erts/obj.debug + + $erts/obj/$host + $erts/obj.debug/$host + +" +for d in ${erl_top}/bin ${erl_top}/bin/$host $erts_dirs ; +do + if test ! -d $d; then + mkdir -p 1>/dev/null 2>&1 $d + fi +done + +dnl --------------------------------------------------------------------- +dnl Autoheader macro for adding code at top and bottom of config.h.in +dnl --------------------------------------------------------------------- +AH_TOP([ +#define GHBN_R_SOLARIS 2 +#define GHBN_R_AIX 3 +#define GHBN_R_GLIBC 4 +]) + +AH_BOTTOM([ +/* Redefine in6_addr. XXX this should be moved to the files where it's used? */ +#ifdef HAVE_IN_ADDR6_STRUCT +#define in6_addr in_addr6 +#endif + +/* Define a reasonable default for INADDR_LOOPBACK */ +/* XXX this should be moved to the files where it's used? */ +#ifdef HAVE_NO_INADDR_LOOPBACK +#define INADDR_LOOPBACK (u_long)0x7F000001 +#endif + +#ifdef REDEFINE_FD_SETSIZE +#define FD_SETSIZE 1024 +#endif + +#ifdef HAVE_GETHRVTIME_PROCFS_IOCTL +#define HAVE_GETHRVTIME +#endif + +#ifndef HAVE_FINITE +# if defined(HAVE_ISINF) && defined(HAVE_ISNAN) +# define USE_ISINF_ISNAN +# endif +#endif + +#if defined(DEBUG) && defined(USE_THREADS) && !defined(ERTS_ENABLE_LOCK_CHECK) +#define ERTS_ENABLE_LOCK_CHECK 1 +#endif +]) + + +dnl ---------------------------------------------------------------------- +dnl Output the result. +dnl ---------------------------------------------------------------------- + +dnl Note that the output files are relative to $srcdir + +AC_OUTPUT( + emulator/$host/Makefile:emulator/Makefile.in + emulator/zlib/$host/Makefile:emulator/zlib/Makefile.in + emulator/pcre/$host/Makefile:emulator/pcre/Makefile.in + epmd/src/$host/Makefile:epmd/src/Makefile.in + etc/common/$host/Makefile:etc/common/Makefile.in + include/internal/$host/ethread.mk:include/internal/ethread.mk.in + include/internal/$host/erts_internal.mk:include/internal/erts_internal.mk.in + lib_src/$host/Makefile:lib_src/Makefile.in + Makefile:Makefile.in + ../make/$host/otp.mk:../make/otp.mk.in + ../make/$host/otp_ded.mk:../make/otp_ded.mk.in +dnl +dnl The ones below should be moved to their respective lib +dnl + ../lib/ic/c_src/$host/Makefile:../lib/ic/c_src/Makefile.in + ../lib/os_mon/c_src/$host/Makefile:../lib/os_mon/c_src/Makefile.in + ../lib/ssl/c_src/$host/Makefile:../lib/ssl/c_src/Makefile.in + ../lib/ssl/examples/certs/$host/Makefile:../lib/ssl/examples/certs/Makefile.in + ../lib/crypto/c_src/$host/Makefile:../lib/crypto/c_src/Makefile.in + ../lib/orber/c_src/$host/Makefile:../lib/orber/c_src/Makefile.in + ../lib/runtime_tools/c_src/$host/Makefile:../lib/runtime_tools/c_src/Makefile.in + ../lib/tools/c_src/$host/Makefile:../lib/tools/c_src/Makefile.in + ../lib/asn1/c_src/$host/Makefile:../lib/asn1/c_src/Makefile.in + ) + diff --git a/erts/doc/Makefile b/erts/doc/Makefile new file mode 100644 index 0000000000..8ea3793d90 --- /dev/null +++ b/erts/doc/Makefile @@ -0,0 +1,36 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# Default Rules +# +OTP_MAKE_ROOT=/home/super/otp/otp_make +include $(OTP_MAKE_ROOT)/otp.mk + +# +# Macros +# +SUB_DIRECTORIES = src + +SPECIAL_TARGETS = + +# +# Default Subdir Targets +# +include $(OTP_MAKE_ROOT)/otp_subdir.mk diff --git a/erts/doc/html/.gitignore b/erts/doc/html/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/doc/man1/.gitignore b/erts/doc/man1/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/doc/man3/.gitignore b/erts/doc/man3/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/doc/pdf/.gitignore b/erts/doc/pdf/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile new file mode 100644 index 0000000000..3dfefa2001 --- /dev/null +++ b/erts/doc/src/Makefile @@ -0,0 +1,153 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../../vsn.mk +APPLICATION=erts +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/$(APPLICATION)-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +XML_APPLICATION_FILES = ref_man.xml +XML_REF1_FILES = epmd.xml \ + erl.xml \ + erlc.xml \ + escript.xml \ + werl.xml \ + erlsrv.xml \ + start_erl.xml \ + run_erl.xml \ + start.xml + +XML_REF3_FILES = \ + driver_entry.xml \ + erl_set_memory_block.xml \ + erl_driver.xml \ + erl_prim_loader.xml \ + erlang.xml \ + erts_alloc.xml \ + init.xml \ + zlib.xml + +XML_PART_FILES = \ + part.xml \ + part_notes.xml \ + part_notes_history.xml + +XML_CHAPTER_FILES = \ + tty.xml \ + match_spec.xml \ + crash_dump.xml \ + alt_dist.xml \ + driver.xml \ + absform.xml \ + inet_cfg.xml \ + erl_ext_dist.xml \ + erl_dist_protocol.xml \ + notes.xml \ + notes_history.xml + +TOPDOCDIR=../../../doc + +BOOK_FILES = book.xml + +GIF_FILES = \ + erl_ext_fig.gif + +XML_FILES = \ + $(BOOK_FILES) $(XML_CHAPTER_FILES) \ + $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_REF1_FILES) $(XML_APPLICATION_FILES) + +# ---------------------------------------------------- + +HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ + $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) + +INFO_FILE = ../../info +INFO_FILE_SRC = ../../info.src + +MAN1_FILES = $(XML_REF1_FILES:%.xml=$(MAN1DIR)/%.1) +MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) + +HTML_REF_MAN_FILE = $(HTMLDIR)/index.html + +TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +XML_FLAGS += + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- +$(HTMLDIR)/%.gif: %.gif + $(INSTALL_DATA) $< $@ + +docs: pdf html man $(INFO_FILE) + +$(TOP_PDF_FILE): $(XML_FILES) + +pdf: $(TOP_PDF_FILE) + +html: gifs $(HTML_REF_MAN_FILE) + +man: $(MAN1_FILES) $(MAN3_FILES) + +gifs: $(GIF_FILES:%=$(HTMLDIR)/%) + +$(INFO_FILE): $(INFO_FILE_SRC) ../../vsn.mk + sed -e 's;%RELEASE%;$(SYSTEM_VSN);' $(INFO_FILE_SRC) > $(INFO_FILE) + + +debug opt: + +clean: + rm -rf $(HTMLDIR)/* + rm -f $(MAN1DIR)/* + rm -f $(MAN3DIR)/* + rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) + rm -f errs core *~ + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_docs_spec: docs + $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf + $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf + $(INSTALL_DIR) $(RELSYSDIR)/doc/html + $(INSTALL_DATA) $(HTMLDIR)/* \ + $(RELSYSDIR)/doc/html + $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) + $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 + $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 + $(INSTALL_DIR) $(RELEASE_PATH)/man/man1 + $(INSTALL_DATA) $(MAN1_FILES) $(RELEASE_PATH)/man/man1 + +release_spec: diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml new file mode 100644 index 0000000000..4c84412dd6 --- /dev/null +++ b/erts/doc/src/absform.xml @@ -0,0 +1,444 @@ + + + + +
+ + 20012009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + The Abstract Format + Arndt Jonasson + Kenneth Lundin + 1 + Jultomten + + 00-12-01 + A + absform.xml +
+

+

This document describes the standard representation of parse trees for Erlang + programs as Erlang terms. This representation is known as the abstract format. + Functions dealing with such parse trees are + and functions in the modules + , + , + , + , + , + and + . + They are also used as input and output for parse transforms (see the module + ).

+

We use the function to denote the mapping from an Erlang source + construct to its abstract format representation , and write + . +

+

The word below represents an integer, and denotes the + number of the line in the source file where the construction occurred. + Several instances of in the same construction may denote + different lines.

+

Since operators are not terms in their own right, when operators are + mentioned below, the representation of an operator should be taken to + be the atom with a printname consisting of the same characters as the + operator. +

+ +
+ Module declarations and forms +

A module declaration consists of a sequence of forms that are either + function declarations or attributes.

+ + If D is a module declaration consisting of the forms + , ..., , then + Rep(D) = . + If F is an attribute , then + Rep(F) = . + If F is an attribute , then + Rep(F) = . + If F is an attribute , then + Rep(F) = . + If F is an attribute , then + Rep(F) = . + If F is an attribute , then + Rep(F) = . + If F is a record declaration , then + Rep(F) = + . For Rep(V), see below. + If F is a wild attribute , then + Rep(F) = . +

+ If F is a function declaration , + where each is a function clause with a + pattern sequence of the same length , then + Rep(F) = . + + +
+ Record fields +

Each field in a record declaration may have an optional + explicit default initializer expression

+ + If V is , then + Rep(V) = . + If V is , then + Rep(V) = . + +
+ +
+ Representation of parse errors and end of file +

In addition to the representations of forms, the list that represents + a module declaration (as returned by functions in and + ) may contain tuples and , denoting + syntactically incorrect forms and warnings, and , denoting an end + of stream encountered before a complete form had been parsed.

+
+
+ +
+ Atomic literals +

There are five kinds of atomic literals, which are represented in the + same way in patterns, expressions and guards:

+ + If L is an integer or character literal, then + Rep(L) = . + If L is a float literal, then + Rep(L) = . + If L is a string literal consisting of the characters + , ..., , then + Rep(L) = . + If L is an atom literal, then + Rep(L) = . + +

Note that negative integer and float literals do not occur as such; they are + parsed as an application of the unary negation operator.

+
+ +
+ Patterns +

If is a sequence of patterns , then + Rep(Ps) = . Such sequences occur as the + list of arguments to a function or fun.

+

Individual patterns are represented as follows:

+ + If P is an atomic literal L, then Rep(P) = Rep(L). + If P is a compound pattern , then + Rep(P) = . + If P is a variable pattern , then + Rep(P) = , + where A is an atom with a printname consisting of the same characters as + . + If P is a universal pattern , then + Rep(P) = . + If P is a tuple pattern , then + Rep(P) = . + If P is a nil pattern , then + Rep(P) = . + If P is a cons pattern , then + Rep(P) = . + If E is a binary pattern >]]>, then + Rep(E) = . + For Rep(TSL), see below. + An omitted is represented by . An omitted + (type specifier list) is represented by . + If P is , where is a binary operator (this + is either an occurrence of applied to a literal string or character + list, or an occurrence of an expression that can be evaluated to a number + at compile time), + then Rep(P) = . + If P is , where is a unary operator (this is an + occurrence of an expression that can be evaluated to a number at compile + time), then Rep(P) = . + If P is a record pattern , + then Rep(P) = + . + If P is , then + Rep(P) = . + If P is , then + Rep(P) = , + i.e., patterns cannot be distinguished from their bodies. + +

Note that every pattern has the same source form as some expression, and is + represented the same way as the corresponding expression.

+
+ +
+ Expressions +

A body B is a sequence of expressions , and + Rep(B) = .

+

An expression E is one of the following alternatives:

+ + If P is an atomic literal , then + Rep(P) = Rep(L). + If E is , then + Rep(E) = . + If E is a variable , then + Rep(E) = , + where is an atom with a printname consisting of the same + characters as . + If E is a tuple skeleton , then + Rep(E) = . + If E is , then + Rep(E) = . + If E is a cons skeleton , then + Rep(E) = . + If E is a binary constructor >]]>, then + Rep(E) = . + For Rep(TSL), see below. + An omitted is represented by . An omitted + (type specifier list) is represented by . + If E is , where is a binary operator, + then Rep(E) = . + If E is , where is a unary operator, then + Rep(E) = . + If E is , then + Rep(E) = + . + If E is , then + Rep(E) = + . + If E is , then + Rep(E) = . + If E is , then + Rep(E) = . + If E is , then + Rep(E) = . + If E is , then + Rep(E) = . + If E is , then + Rep(E) = + . + If E is a list comprehension , + where each is a generator or a filter, then + Rep(E) = . For Rep(W), see + below. + If E is a binary comprehension >]]>, + where each is a generator or a filter, then + Rep(E) = . For Rep(W), see + below. + If E is , where is a body, then + Rep(E) = . + If E is , + where each is an if clause then + Rep(E) = + . + If E is , + where is an expression and each is a + case clause then + Rep(E) = + . + If E is , + where is a body and each is a catch clause then + Rep(E) = + . + If E is , + where is a body, + each is a case clause and + each is a catch clause then + Rep(E) = + . + If E is , + where and are bodies then + Rep(E) = + . + If E is , + where and are a bodies and + each is a case clause then + Rep(E) = + . + If E is , + where and are bodies and + each is a catch clause then + Rep(E) = + . + If E is , + where and are a bodies, + each is a case clause and + each is a catch clause then + Rep(E) = + . + If E is , + where each is a case clause then + Rep(E) = + . + If E is B_t end]]>, + where each is a case clause, + is an expression and is a body, then + Rep(E) = + . + If E is , then + Rep(E) = . + If E is , then + Rep(E) = . + If E is + where each is a function clause then Rep(E) = + . + If E is , + where each is a generator or a filter, then + Rep(E) = . + For Rep(W), see below. + If E is , a Mnesia record access + inside a query, then + Rep(E) = . + If E is , then + Rep(E) = , + i.e., parenthesized expressions cannot be distinguished from their bodies. + + +
+ Generators and filters +

When W is a generator or a filter (in the body of a list or binary comprehension), then:

+ + If W is a generator , where is a pattern and + is an expression, then + Rep(W) = . + If W is a generator , where is a pattern and + is an expression, then + Rep(W) = . + If W is a filter , which is an expression, then + Rep(W) = . + +
+ +
+ Binary element type specifiers +

A type specifier list TSL for a binary element is a sequence of type + specifiers . + Rep(TSL) = .

+

When TS is a type specifier for a binary element, then:

+ + If TS is an atom , Rep(TS) = . + If TS is a couple where is an atom and + is an integer, Rep(TS) = . + +
+
+ +
+ Clauses +

There are function clauses, if clauses, case clauses + and catch clauses.

+

A clause is one of the following alternatives:

+ + If C is a function clause B]]> + where is a pattern sequence and is a body, then + Rep(C) = . + If C is a function clause B]]> + where is a pattern sequence, + is a guard sequence and is a body, then + Rep(C) = . + If C is an if clause B]]> + where is a guard sequence and is a body, then + Rep(C) = . + If C is a case clause B]]> + where is a pattern and is a body, then + Rep(C) = . + If C is a case clause B]]> + where is a pattern, + is a guard sequence and is a body, then + Rep(C) = . + If C is a catch clause B]]> + where is a pattern and is a body, then + Rep(C) = . + If C is a catch clause B]]> + where is an atomic literal or a variable pattern, + is a pattern and is a body, then + Rep(C) = . + If C is a catch clause B]]> + where is a pattern, is a guard sequence + and is a body, then + Rep(C) = . + If C is a catch clause B]]> + where is an atomic literal or a variable pattern, + is a pattern, is a guard sequence + and is a body, then + Rep(C) = . + +
+ +
+ Guards +

A guard sequence Gs is a sequence of guards , and + Rep(Gs) = . If the guard sequence is + empty, Rep(Gs) = .

+

A guard G is a nonempty sequence of guard tests , and + Rep(G) = .

+

A guard test is one of the following alternatives:

+ + If Gt is an atomic literal L, then Rep(Gt) = Rep(L). + If Gt is a variable pattern , then + Rep(Gt) = , + where A is an atom with a printname consisting of the same characters as + . + If Gt is a tuple skeleton , then + Rep(Gt) = . + If Gt is , then + Rep(Gt) = . + If Gt is a cons skeleton , then + Rep(Gt) = . + If Gt is a binary constructor >]]>, then + Rep(Gt) = . + For Rep(TSL), see above. + An omitted is represented by . An omitted + (type specifier list) is represented by . + If Gt is , where + is a binary operator, then Rep(Gt) = . + If Gt is , where is a unary operator, then + Rep(Gt) = . + If Gt is , then + Rep(E) = + . + If Gt is , then + Rep(Gt) = . + If Gt is , then + Rep(Gt) = . + If Gt is , where is an atom, then + Rep(Gt) = . + If Gt is , where is + the atom and is an atom or an operator, then + Rep(Gt) = . + If Gt is , where is + the atom and is an atom or an operator, then + Rep(Gt) = . + If Gt is , then + Rep(Gt) = , + i.e., parenthesized guard tests cannot be distinguished from their bodies. + +

Note that every guard test has the same source form as some expression, + and is represented the same way as the corresponding expression.

+
+ +
+ The abstract format after preprocessing +

The compilation option can be given to the + compiler to have the abstract code stored in + the chunk in the BEAM file + (for debugging purposes).

+

In OTP R9C and later, the chunk will + contain

+

+

where is the abstract code as described + in this document.

+

In releases of OTP prior to R9C, the abstract code after some more + processing was stored in the BEAM file. The first element of the + tuple would be either (R7B) or + (R8B).

+
+ + diff --git a/erts/doc/src/alt_dist.xml b/erts/doc/src/alt_dist.xml new file mode 100644 index 0000000000..9a68b3cf40 --- /dev/null +++ b/erts/doc/src/alt_dist.xml @@ -0,0 +1,1099 @@ + + + + +
+ + 20002009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + How to implement an alternative carrier for the Erlang distribution + Patrik Nyblom + + + + + 2000-10-17 + PA2 + alt_dist.xml +
+

This document describes how one can implement ones own carrier + protocol for the Erlang distribution. The distribution is normally + carried by the TCP/IP protocol. What's explained here is the method for + replacing TCP/IP with another protocol.

+

The document is a step by step explanation of the example + application (seated in the kernel applications directory). + The application implements distribution over Unix domain + sockets and is written for the Sun Solaris 2 operating environment. The + mechanisms are however general and applies to any operating system Erlang + runs on. The reason the C code is not made portable, is simply readability.

+

This document was written a long time ago. Most of it is still + valid, but some things have changed since it was first written. + Most notably the driver interface. There have been some updates + to the documentation of the driver presented in this documentation, + but more could be done and are planned for the future. The + reader is encouraged to also read the + erl_driver, and the + driver_entry documentation. +

+ +
+ Introduction +

To implement a new carrier for the Erlang distribution, one must first + make the protocol available to the Erlang machine, which involves writing + an Erlang driver. There is no way one can use a port program, + there has to + be an Erlang driver. Erlang drivers can either be statically + linked + to the emulator, which can be an alternative when using the open source + distribution of Erlang, or dynamically loaded into the Erlang machines + address space, which is the only alternative if a precompiled version of + Erlang is to be used.

+

Writing an Erlang driver is by no means easy. The driver is written + as a couple of call-back functions called by the Erlang emulator when + data is sent to the driver or the driver has any data available on a file + descriptor. As the driver call-back routines execute in the main + thread of the Erlang machine, the call-back functions can perform + no blocking activity whatsoever. The call-backs should only set up + file descriptors for waiting and/or read/write available data. All + I/O has to be non blocking. Driver call-backs are however executed + in sequence, why a global state can safely be updated within the + routines.

+

When the driver is implemented, one would preferably write an + Erlang interface for the driver to be able to test the + functionality of the driver separately. This interface can then + be used by the distribution module which will cover the details of + the protocol from the . The easiest path is to + mimic the and interfaces, but a lot of + functionality in those modules need not be implemented. In the + example application, only a few of the usual interfaces are + implemented, and they are much simplified.

+

When the protocol is available to Erlang through a driver and an + Erlang interface module, a distribution module can be + written. The distribution module is a module with well defined + call-backs, much like a (there is no compiler support + for checking the call-backs though). The details of finding other + nodes (i.e. talking to epmd or something similar), creating a + listen port (or similar), connecting to other nodes and performing + the handshakes/cookie verification are all implemented by this + module. There is however a utility module, , that + will do most of the hard work of handling handshakes, cookies, + timers and ticking. Using makes implementing a + distribution module much easier and that's what we are doing in + the example application.

+

The last step is to create boot scripts to make the protocol + implementation available at boot time. The implementation can be + debugged by starting the distribution when all of the system is + running, but in a real system the distribution should start very + early, why a boot-script and some command line parameters are + necessary. This last step also implies that the Erlang code in the + interface and distribution modules is written in such a way that + it can be run in the startup phase. Most notably there can be no + calls to the module or to any modules not + loaded at boot-time (i.e. only , and the + application itself can be used).

+
+ +
+ The driver +

Although Erlang drivers in general may be beyond the scope of this + document, a brief introduction seems to be in place.

+ +
+ Drivers in general +

An Erlang driver is a native code module written in C (or + assembler) which serves as an interface for some special operating + system service. This is a general mechanism that is used + throughout the Erlang emulator for all kinds of I/O. An Erlang + driver can be dynamically linked (or loaded) to the Erlang + emulator at runtime by using the Erlang + module. Some of the drivers in OTP are however statically linked + to the runtime system, but that's more an optimization than a + necessity.

+

The driver data-types and the functions available to the driver + writer are defined in the header file (there + is also an deprecated version called , don't use + that one.) seated in Erlang's include directory (and in + $ERL_TOP/erts/emulator/beam in the source code + distribution). Refer to that file for function prototypes etc.

+

When writing a driver to make a communications protocol available + to Erlang, one should know just about everything worth knowing + about that particular protocol. All operation has to be non + blocking and all possible situations should be accounted for in + the driver. A non stable driver will affect and/or crash the + whole Erlang runtime system, which is seldom what's wanted.

+

The emulator calls the driver in the following situations:

+ + When the driver is loaded. This call-back has to have a + special name and will inform the emulator of what call-backs should + be used by returning a pointer to a struct, + which should be properly filled in (see below). + When a port to the driver is opened (by a + call from Erlang). This routine should set up internal data + structures and return an opaque data entity of the type + , which is a data-type large enough to hold a + pointer. The pointer returned by this function will be the first + argument to all other call-backs concerning this particular + port. It is usually called the port handle. The emulator only + stores the handle and does never try to interpret it, why it can + be virtually anything (well anything not larger than a pointer + that is) and can point to anything if it is a pointer. Usually + this pointer will refer to a structure holding information about + the particular port, as i t does in our example. + When an Erlang process sends data to the port. The data will + arrive as a buffer of bytes, the interpretation is not defined, + but is up to the implementor. This call-back returns nothing to the + caller, answers are sent to the caller as messages (using a + routine called available to all + drivers). There is also a way to talk in a synchronous way to + drivers, described below. There can be an additional call-back + function for handling data that is fragmented (sent in a deep + io-list). That interface will get the data in a form suitable for + Unix rather than in a single buffer. There is no + need for a distribution driver to implement such a call-back, so + we wont. + When a file descriptor is signaled for input. This call-back + is called when the emulator detects input on a file descriptor + which the driver has marked for monitoring by using the interface + . The mechanism of driver select makes it + possible to read non blocking from file descriptors by calling + when reading is needed and then do the actual + reading in this call-back (when reading is actually possible). The + typical scenario is that is called when an + Erlang process orders a read operation, and that this routine + sends the answer when data is available on the file descriptor. + When a file descriptor is signaled for output. This call-back + is called in a similar way as the previous, but when writing to a + file descriptor is possible. The usual scenario is that Erlang + orders writing on a file descriptor and that the driver calls + . When the descriptor is ready for output, + this call-back is called an the driver can try to send the + output. There may of course be queuing involved in such + operations, and there are some convenient queue routines available + to the driver writer to use in such situations. + When a port is closed, either by an Erlang process or by the + driver calling one of the routines. This + routine should clean up everything connected to one particular + port. Note that when other call-backs call a + routine, this routine will be + immediately called and the call-back routine issuing the error can + make no more use of the data structures for the port, as this + routine surely has freed all associated data and closed all file + descriptors. If the queue utility available to driver writes is + used, this routine will however not be called until the + queue is empty. + When an Erlang process calls erlang:port_control/3, + which is a synchronous interface to drivers. The control interface + is used to set driver options, change states of ports etc. We'll + use this interface quite a lot in our example. + When a timer expires. The driver can set timers with the + function . When such timers expire, a + specific call-back function is called. We will not use timers in + our example. + When the whole driver is unloaded. Every resource allocated + by the driver should be freed. + +
+ +
+ The distribution driver's data structures +

The driver used for Erlang distribution should implement a + reliable, order maintaining, variable length packet oriented + protocol. All error correction, re-sending and such need to be + implemented in the driver or by the underlying communications + protocol. If the protocol is stream oriented (as is the case with + both TCP/IP and our streamed Unix domain sockets), some mechanism + for packaging is needed. We will use the simple method of having a + header of four bytes containing the length of the package in a big + endian 32 bit integer (as Unix domain sockets only can be used + between processes on the same machine, we actually don't need to + code the integer in some special endianess, but I'll do it anyway + because in most situation you do need to do it. Unix domain + sockets are reliable and order maintaining, so we don't need to + implement resends and such in our driver.

+

Lets start writing our example Unix domain sockets driver by + declaring prototypes and filling in a static ErlDrvEntry + structure.

+ +( 2) #include +( 3) #include +( 4) #include +( 5) #include +( 6) #include +( 7) #include +( 8) #include +( 9) #include +(10) #include + +(11) #define HAVE_UIO_H +(12) #include "erl_driver.h" + +(13) /* +(14) ** Interface routines +(15) */ +(16) static ErlDrvData uds_start(ErlDrvPort port, char *buff); +(17) static void uds_stop(ErlDrvData handle); +(18) static void uds_command(ErlDrvData handle, char *buff, int bufflen); +(19) static void uds_input(ErlDrvData handle, ErlDrvEvent event); +(20) static void uds_output(ErlDrvData handle, ErlDrvEvent event); +(21) static void uds_finish(void); +(22) static int uds_control(ErlDrvData handle, unsigned int command, +(23) char* buf, int count, char** res, int res_size); + +(24) /* The driver entry */ +(25) static ErlDrvEntry uds_driver_entry = { +(26) NULL, /* init, N/A */ +(27) uds_start, /* start, called when port is opened */ +(28) uds_stop, /* stop, called when port is closed */ +(29) uds_command, /* output, called when erlang has sent */ +(30) uds_input, /* ready_input, called when input +(31) descriptor ready */ +(32) uds_output, /* ready_output, called when output +(33) descriptor ready */ +(34) "uds_drv", /* char *driver_name, the argument +(35) to open_port */ +(36) uds_finish, /* finish, called when unloaded */ +(37) NULL, /* void * that is not used (BC) */ +(38) uds_control, /* control, port_control callback */ +(39) NULL, /* timeout, called on timeouts */ +(40) NULL, /* outputv, vector output interface */ +(41) NULL, /* ready_async callback */ +(42) NULL, /* flush callback */ +(43) NULL, /* call callback */ +(44) NULL, /* event callback */ +(45) ERL_DRV_EXTENDED_MARKER, /* Extended driver interface marker */ +(46) ERL_DRV_EXTENDED_MAJOR_VERSION, /* Major version number */ +(47) ERL_DRV_EXTENDED_MINOR_VERSION, /* Minor version number */ +(48) ERL_DRV_FLAG_SOFT_BUSY, /* Driver flags. Soft busy flag is +(49) required for distribution drivers */ +(50) NULL, /* Reserved for internal use */ +(51) NULL, /* process_exit callback */ +(52) NULL /* stop_select callback */ +(53) };]]> +

On line 1 to 10 we have included the OS headers needed for our + driver. As this driver is written for Solaris, we know that the + header exists, why we can define the preprocessor + variable before we include + at line 12. The definition of will make the + I/O vectors used in Erlang's driver queues to correspond to the + operating systems ditto, which is very convenient.

+

The different call-back functions are declared ("forward + declarations") on line 16 to 23.

+

The driver structure is similar for statically linked in + drivers and dynamically loaded. However some of the fields + should be left empty (i.e. initialized to NULL) in the + different types of drivers. The first field (the + function pointer) is always left blank in a dynamically loaded + driver, which can be seen on line 26. The NULL on line 37 + should always be there, the field is no longer used and is + retained for backward compatibility. We use no timers in this + driver, why no call-back for timers is needed. The outputv field + (line 40) can be used to implement an interface similar to + Unix for output. The Erlang runtime + system could previously not use outputv for the + distribution, but since erts version 5.7.2 it can. + Since this driver was written before erts version 5.7.2 it does + not use the outputv callback. Using the outputv + callback is preferred since it reduces copying of data. (We + will however use scatter/gather I/O internally in the driver).

+

As of erts version 5.5.3 the driver interface was extended with + version control and the possibility to pass capability information. + Capability flags are present at line 48. As of erts version 5.7.4 + the + ERL_DRV_FLAG_SOFT_BUSY + flag is required for drivers that are to be used by the distribution. + The soft busy flag implies that the driver is capable of handling + calls to the output and outputv callbacks even though + it has marked itself as busy. This has always been a requirement + on drivers used by the distribution, but there have previously not + been any capability information available about this. For more + information see + set_busy_port()). +

+

This driver was written before the runtime system had SMP support. + The driver will still function in the runtime system with SMP support, + but performance will suffer from lock contention on the driver lock + used for the driver. This can be alleviated by reviewing and perhaps + rewriting the code so that each instance of the driver safely can + execute in parallel. When instances safely can execute in parallel it + is safe to enable instance specific locking on the driver. This is done + by passing + ERL_DRV_FLAG_USE_PORT_LOCKING + as a driver flag. This is left as an exercise for the reader.

+

Our defined call-backs thus are:

+ + uds_start, which shall initiate data for a port. We wont + create any actual sockets here, just initialize data structures. + uds_stop, the function called when a port is closed. + uds_command, which will handle messages from Erlang. The + messages can either be plain data to be sent or more subtle + instructions to the driver. We will use this function mostly for + data pumping. + uds_input, this is the call-back which is called when we have + something to read from a socket. + uds_output, this is the function called when we can write to a + socket. + uds_finish, which is called when the driver is unloaded. A + distribution driver will actually (or hopefully) never be unloaded, + but we include this for completeness. Being able to clean up after + oneself is always a good thing. + uds_control, the erlang:port_control/2 call-back, which + will be used a lot in this implementation. + +

The ports implemented by this driver will operate in two major + modes, which i will call the command and data + modes. In command mode, only passive reading and writing (like + gen_tcp:recv/gen_tcp:send) can be + done, and this is the mode the port will be in during the + distribution handshake. When the connection is up, the port will + be switched to data mode and all data will be immediately read and + passed further to the Erlang emulator. In data mode, no data + arriving to the uds_command will be interpreted, but just packaged + and sent out on the socket. The uds_control call-back will do the + switching between those two modes.

+

While the informs different subsystems that the + connection is coming up, the port should accept data to send, but + not receive any data, to avoid that data arrives from another node + before every kernel subsystem is prepared to handle it. We have a + third mode for this intermediate stage, lets call it the + intermediate mode.

+

Lets define an enum for the different types of ports we have:

+ +

Lets look at the different types:

+ + portTypeUnknown - The type a port has when it's opened, but + not actually bound to any file descriptor. + portTypeListener - A port that is connected to a listen + socket. This port will not do especially much, there will be no data + pumping done on this socket, but there will be read data available + when one is trying to do an accept on the port. + portTypeAcceptor - This is a port that is to represent the + result of an accept operation. It is created when one wants to + accept from a listen socket, and it will be converted to a + portTypeCommand when the accept succeeds. + portTypeConnector - Very similar to portTypeAcceptor, an + intermediate stage between the request for a connect operation and + that the socket is really connected to an accepting ditto in the + other end. As soon as the sockets are connected, the port will + switch type to portTypeCommand. + portTypeCommand - A connected socket (or accepted socket if + you want) that is in the command mode mentioned earlier. + portTypeIntermediate - The intermediate stage for a connected + socket. There should be no processing of input for this socket. + portTypeData - The mode where data is pumped through the port + and the uds_command routine will regard every call as a call where + sending is wanted. In this mode all input available will be read and + sent to Erlang as soon as it arrives on the socket, much like in the + active mode of a socket. + +

Now lets look at the state we'll need for our ports. One can note + that not all fields are used for all types of ports and that one + could save some space by using unions, but that would clutter the + code with multiple indirections, so i simply use one struct for + all types of ports, for readability.

+ +

This structure is used for all types of ports although some + fields are useless for some types. The least memory consuming + solution would be to arrange this structure as a union of + structures, but the multiple indirections in the code to + access a field in such a structure will clutter the code to + much for an example.

+

Let's look at the fields in our structure:

+ + fd - The file descriptor of the socket associated with the + port. + port - The port identifier for the port which this structure + corresponds to. It is needed for most + calls from the driver back to the emulator. + +

lockfd - If the socket is a listen socket, we use a separate + (regular) file for two purposes:

+ + We want a locking mechanism that gives no race + conditions, so that we can be sure of if another Erlang + node uses the listen socket name we require or if the + file is only left there from a previous (crashed) + session. + +

We store the creation serial number in the + file. The creation is a number that should + change between different instances of different Erlang + emulators with the same name, so that process + identifiers from one emulator won't be valid when sent + to a new emulator with the same distribution name. The + creation can be between 0 and 3 (two bits) and is stored + in every process identifier sent to another node.

+

In a system with TCP based distribution, this data is + kept in the Erlang port mapper daemon + (), which is contacted when a distributed + node starts. The lock-file and a convention for the UDS + listen socket's name will remove the need for + when using this distribution module. UDS + is always restricted to one host, why avoiding a port + mapper is easy.

+ + + + creation - The creation number for a listen socket, which is + calculated as (the value found in the lock-file + 1) rem + 4. This creation value is also written back into the + lock-file, so that the next invocation of the emulator will + found our value in the file. + type - The current type/state of the port, which can be one + of the values declared above. + name - The name of the socket file (the path prefix + removed), which allows for deletion () when the + socket is closed. + sent - How many bytes that have been sent over the + socket. This may wrap, but that's no problem for the + distribution, as the only thing that interests the Erlang + distribution is if this value has changed (the Erlang + net_kernel ticker uses this value by calling the + driver to fetch it, which is done through the + erlang:port_control routine). + received - How many bytes that are read (received) from the + socket, used in similar ways as . + partner - A pointer to another port structure, which is + either the listen port from which this port is accepting a + connection or the other way around. The "partner relation" + is always bidirectional. + next - Pointer to next structure in a linked list of all + port structures. This list is used when accepting + connections and when the driver is unloaded. + buffer_size, buffer_pos, header_pos, buffer - data for input + buffering. Refer to the source code (in the kernel/examples + directory) for details about the input buffering. That + certainly goes beyond the scope of this document. + +
+ +
+ Selected parts of the distribution driver implementation +

The distribution drivers implementation is not completely + covered in this text, details about buffering and other things + unrelated to driver writing are not explained. Likewise are + some peculiarities of the UDS protocol not explained in + detail. The chosen protocol is not important.

+

Prototypes for the driver call-back routines can be found in + the header file.

+

The driver initialization routine is (usually) declared with a + macro to make the driver easier to port between different + operating systems (and flavours of systems). This is the only + routine that has to have a well defined name. All other + call-backs are reached through the driver structure. The macro + to use is named and takes the driver name + as parameter.

+ +

The routine initializes the single global data structure and + returns a pointer to the driver entry. The routine will be + called when is called from Erlang.

+

The routine is called when a port is opened + from Erlang. In our case, we only allocate a structure and + initialize it. Creating the actual socket is left to the + routine.

+ fd = -1; +( 7) ud->lockfd = -1; +( 8) ud->creation = 0; +( 9) ud->port = port; +(10) ud->type = portTypeUnknown; +(11) ud->name = NULL; +(12) ud->buffer_size = 0; +(13) ud->buffer_pos = 0; +(14) ud->header_pos = 0; +(15) ud->buffer = NULL; +(16) ud->sent = 0; +(17) ud->received = 0; +(18) ud->partner = NULL; +(19) ud->next = first_data; +(20) first_data = ud; +(21) +(22) return((ErlDrvData) ud); +(23) } ]]> +

Every data item is initialized, so that no problems will arise + when a newly created port is closed (without there being any + corresponding socket). This routine is called when + is called from Erlang.

+

The routine is the routine called when an + Erlang process sends data to the port. All asynchronous + commands when the port is in command mode as well as + the sending of all data when the port is in data mode + is handled in this9s routine. Let's have a look at it:

+ type == portTypeData || ud->type == portTypeIntermediate) { +( 5) DEBUGF(("Passive do_send %d",bufflen)); +( 6) do_send(ud, buff + 1, bufflen - 1); /* XXX */ +( 7) return; +( 8) } +( 9) if (bufflen == 0) { +(10) return; +(11) } +(12) switch (*buff) { +(13) case 'L': +(14) if (ud->type != portTypeUnknown) { +(15) driver_failure_posix(ud->port, ENOTSUP); +(16) return; +(17) } +(18) uds_command_listen(ud,buff,bufflen); +(19) return; +(20) case 'A': +(21) if (ud->type != portTypeUnknown) { +(22) driver_failure_posix(ud->port, ENOTSUP); +(23) return; +(24) } +(25) uds_command_accept(ud,buff,bufflen); +(26) return; +(27) case 'C': +(28) if (ud->type != portTypeUnknown) { +(29) driver_failure_posix(ud->port, ENOTSUP); +(30) return; +(31) } +(32) uds_command_connect(ud,buff,bufflen); +(33) return; +(34) case 'S': +(35) if (ud->type != portTypeCommand) { +(36) driver_failure_posix(ud->port, ENOTSUP); +(37) return; +(38) } +(39) do_send(ud, buff + 1, bufflen - 1); +(40) return; +(41) case 'R': +(42) if (ud->type != portTypeCommand) { +(43) driver_failure_posix(ud->port, ENOTSUP); +(44) return; +(45) } +(46) do_recv(ud); +(47) return; +(48) default: +(49) return; +(50) } +(51) } ]]> +

The command routine takes three parameters; the handle + returned for the port by , which is a pointer + to the internal port structure, the data buffer and the length + of the data buffer. The buffer is the data sent from Erlang + (a list of bytes) converted to an C array (of bytes).

+

If Erlang sends i.e. the list to the port, + the variable will be ant the + variable will contain (no + null termination). Usually the first byte is used as an + opcode, which is the case in our driver to (at least when the + port is in command mode). The opcodes are defined as:

+ + 'L'<socketname>: Create and listen on socket with the + given name. + 'A'<listennumber as 32 bit bigendian>: Accept from the + listen socket identified by the given identification + number. The identification number is retrieved with the + uds_control routine. + 'C'<socketname>: Connect to the socket named + <socketname>. + 'S'<data>: Send the data <data> on the + connected/accepted socket (in command mode). The sending is + acked when the data has left this process. + 'R': Receive one packet of data. + +

One may wonder what is meant by "one packet of data" in the + 'R' command. This driver always sends data packeted with a 4 + byte header containing a big endian 32 bit integer that + represents the length of the data in the packet. There is no + need for different packet sizes or some kind of streamed + mode, as this driver is for the distribution only. One may + wonder why the header word is coded explicitly in big endian + when an UDS socket is local to the host. The answer simply is + that I see it as a good practice when writing a distribution + driver, as distribution in practice usually cross the host + boundaries.

+

On line 4-8 we handle the case where the port is in data or + intermediate mode, the rest of the routine handles the + different commands. We see (first on line 15) that the routine + uses the routine to report + errors. One important thing to remember is that the failure + routines make a call to our routine, which + will remove the internal port data. The handle (and the casted + handle ) is therefore invalid pointers after a + call and we should immediately return. The runtime system will send exit signals to all + linked processes.

+

The uds_input routine gets called when data is available on a + file descriptor previously passed to the + routine. Typically this happens when a read command is issued + and no data is available. Lets look at the + routine:

+ port, (ErlDrvEvent) ud->fd, DO_READ, 1); +( 9) } else { +(10) driver_failure_eof(ud->port); +(11) } +(12) return; +(13) } +(14) /* Got a package */ +(15) if (ud->type == portTypeCommand) { +(16) ibuf[-1] = 'R'; /* There is always room for a single byte +(17) opcode before the actual buffer +(18) (where the packet header was) */ +(19) driver_output(ud->port,ibuf - 1, res + 1); +(20) driver_select(ud->port, (ErlDrvEvent) ud->fd, DO_READ,0); +(21) return; +(22) } else { +(23) ibuf[-1] = DIST_MAGIC_RECV_TAG; /* XXX */ +(24) driver_output(ud->port,ibuf - 1, res + 1); +(25) driver_select(ud->port, (ErlDrvEvent) ud->fd, DO_READ,1); +(26) } +(27) } +(28) } ]]> +

The routine tries to read data until a packet is read or the + routine returns a + (an internally defined constant for + the module that means that the read operation resulted in an + ). If the port is in command mode, the + reading stops when one package is read, but if it is in data + mode, the reading continues until the socket buffer is empty + (read failure). If no more data can be read and more is wanted + (always the case when socket is in data mode) driver_select is + called to make the call-back be called when + more data is available for reading.

+

When the port is in data mode, all data is sent to Erlang in a + format that suits the distribution, in fact the raw data will + never reach any Erlang process, but will be + translated/interpreted by the emulator itself and then + delivered in the correct format to the correct processes. In + the current emulator version, received data should be tagged + with a single byte of 100. Thats what the macro + is defined to. The tagging of data + in the distribution will possibly change in the future.

+

The routine will handle other input events + (like nonblocking ), but most importantly handle + data arriving at the socket by calling :

+ type == portTypeListener) { +( 5) UdsData *ad = ud->partner; +( 6) struct sockaddr_un peer; +( 7) int pl = sizeof(struct sockaddr_un); +( 8) int fd; + +( 9) if ((fd = accept(ud->fd, (struct sockaddr *) &peer, &pl)) < 0) { +(10) if (errno != EWOULDBLOCK) { +(11) driver_failure_posix(ud->port, errno); +(12) return; +(13) } +(14) return; +(15) } +(16) SET_NONBLOCKING(fd); +(17) ad->fd = fd; +(18) ad->partner = NULL; +(19) ad->type = portTypeCommand; +(20) ud->partner = NULL; +(21) driver_select(ud->port, (ErlDrvEvent) ud->fd, DO_READ, 0); +(22) driver_output(ad->port, "Aok",3); +(23) return; +(24) } +(25) do_recv(ud); +(26) } ]]> +

The important line here is the last line in the function, the + routine is called to handle new input. The rest + of the function handles input on a listen socket, which means + that there should be possible to do an accept on the + socket, which is also recognized as a read event.

+

The output mechanisms are similar to the input. Lets first + look at the routine:

+ port) == 0) { +(19) if ((written = writev(ud->fd, iov, 2)) == eio.size) { +(20) ud->sent += written; +(21) if (ud->type == portTypeCommand) { +(22) driver_output(ud->port, "Sok", 3); +(23) } +(24) return; +(25) } else if (written < 0) { +(26) if (errno != EWOULDBLOCK) { +(27) driver_failure_eof(ud->port); +(28) return; +(29) } else { +(30) written = 0; +(31) } +(32) } else { +(33) ud->sent += written; +(34) } +(35) /* Enqueue remaining */ +(36) } +(37) driver_enqv(ud->port, &eio, written); +(38) send_out_queue(ud); +(39) } ]]> +

This driver uses the system call to send data + onto the socket. A combination of writev and the driver output + queues is very convenient. An ErlIOVec structure + contains a SysIOVec (which is equivalent to the + structure defined in . The + ErlIOVec also contains an array of ErlDrvBinary + pointers, of the same length as the number of buffers in the + I/O vector itself. One can use this to allocate the binaries + for the queue "manually" in the driver, but we'll just fill + the binary array with NULL values (line 7) , which will make + the runtime system allocate it's own buffers when we call + (line 37).

+

+

The routine builds an I/O vector containing the header bytes + and the buffer (the opcode has been removed and the buffer + length decreased by the output routine). If the queue is + empty, we'll write the data directly to the socket (or at + least try to). If any data is left, it is stored in the queue + and then we try to send the queue (line 38). An ack is sent + when the message is delivered completely (line 22). The + will send acks if the sending is + completed there. If the port is in command mode, the Erlang + code serializes the send operations so that only one packet + can be waiting for delivery at a time. Therefore the ack can + be sent simply whenever the queue is empty.

+

+

A short look at the routine:

+ port, &vlen); +( 6) int wrote; +( 7) if (tmp == NULL) { +( 8) driver_select(ud->port, (ErlDrvEvent) ud->fd, DO_WRITE, 0); +( 9) if (ud->type == portTypeCommand) { +(10) driver_output(ud->port, "Sok", 3); +(11) } +(12) return 0; +(13) } +(14) if (vlen > IO_VECTOR_MAX) { +(15) vlen = IO_VECTOR_MAX; +(16) } +(17) if ((wrote = writev(ud->fd, tmp, vlen)) < 0) { +(18) if (errno == EWOULDBLOCK) { +(19) driver_select(ud->port, (ErlDrvEvent) ud->fd, +(20) DO_WRITE, 1); +(21) return 0; +(22) } else { +(23) driver_failure_eof(ud->port); +(24) return -1; +(25) } +(26) } +(27) driver_deq(ud->port, wrote); +(28) ud->sent += wrote; +(29) } +(30) } ]]> +

What we do is simply to pick out an I/O vector from the queue + (which is the whole queue as an SysIOVec). If the I/O + vector is to long (IO_VECTOR_MAX is defined to 16), the vector + length is decreased (line 15), otherwise the + (line 17) call will + fail. Writing is tried and anything written is dequeued (line + 27). If the write fails with (note that all + sockets are in nonblocking mode), is + called to make the routine be called when + there is space to write again.

+

We will continue trying to write until the queue is empty or + the writing would block.

+

The routine above are called from the + routine, which looks like this:

+ type == portTypeConnector) { +( 5) ud->type = portTypeCommand; +( 6) driver_select(ud->port, (ErlDrvEvent) ud->fd, DO_WRITE, 0); +( 7) driver_output(ud->port, "Cok",3); +( 8) return; +( 9) } +(10) send_out_queue(ud); +(11) } ]]> +

The routine is simple, it first handles the fact that the + output select will concern a socket in the business of + connecting (and the connecting blocked). If the socket is in + a connected state it simply sends the output queue, this + routine is called when there is possible to write to a socket + where we have an output queue, so there is no question what to + do.

+

The driver implements a control interface, which is a + synchronous interface called when Erlang calls + . This is the only interface + that can control the driver when it is in data mode and it may + be called with the following opcodes:

+ + 'C': Set port in command mode. + 'I': Set port in intermediate mode. + 'D': Set port in data mode. + 'N': Get identification number for listen port, this + identification number is used in an accept command to the + driver, it is returned as a big endian 32 bit integer, which + happens to be the file identifier for the listen socket. + 'S': Get statistics, which is the number of bytes received, + the number of bytes sent and the number of bytes pending in + the output queue. This data is used when the distribution + checks that a connection is alive (ticking). The statistics + is returned as 3 32 bit big endian integers. + 'T': Send a tick message, which is a packet of length + 0. Ticking is done when the port is in data mode, so the + command for sending data cannot be used (besides it ignores + zero length packages in command mode). This is used by the + ticker to send dummy data when no other traffic is present. + Note that it is important that the interface for + sending ticks is not blocking. This implementation uses + erlang:port_control/3 which does not block the caller. + If erlang:port_command is used, use + erlang:port_command/3 and pass [force] as + option list; otherwise, the caller can be blocked indefinitely + on a busy port and prevent the system from taking down a + connection that is not functioning. + 'R': Get creation number of listen socket, which is used to + dig out the number stored in the lock file to differentiate + between invocations of Erlang nodes with the same name.\011 + +

The control interface gets a buffer to return its value in, + but is free to allocate it's own buffer is the provided one is + to small. Here is the code for :

+ received); +(18) put_packet_length((*res) + 5, ud->sent); +(19) put_packet_length((*res) + 9, driver_sizeq(ud->port)); +(20) return 13; +(21) } +(22) case 'C': +(23) if (ud->type < portTypeCommand) { +(24) return report_control_error(res, res_size, "einval"); +(25) } +(26) ud->type = portTypeCommand; +(27) driver_select(ud->port, (ErlDrvEvent) ud->fd, DO_READ, 0); +(28) ENSURE(1); +(29) **res = 0; +(30) return 1; +(31) case 'I': +(32) if (ud->type < portTypeCommand) { +(33) return report_control_error(res, res_size, "einval"); +(34) } +(35) ud->type = portTypeIntermediate; +(36) driver_select(ud->port, (ErlDrvEvent) ud->fd, DO_READ, 0); +(37) ENSURE(1); +(38) **res = 0; +(39) return 1; +(40) case 'D': +(41) if (ud->type < portTypeCommand) { +(42) return report_control_error(res, res_size, "einval"); +(43) } +(44) ud->type = portTypeData; +(45) do_recv(ud); +(46) ENSURE(1); +(47) **res = 0; +(48) return 1; +(49) case 'N': +(50) if (ud->type != portTypeListener) { +(51) return report_control_error(res, res_size, "einval"); +(52) } +(53) ENSURE(5); +(54) (*res)[0] = 0; +(55) put_packet_length((*res) + 1, ud->fd); +(56) return 5; +(57) case 'T': /* tick */ +(58) if (ud->type != portTypeData) { +(59) return report_control_error(res, res_size, "einval"); +(60) } +(61) do_send(ud,"",0); +(62) ENSURE(1); +(63) **res = 0; +(64) return 1; +(65) case 'R': +(66) if (ud->type != portTypeListener) { +(67) return report_control_error(res, res_size, "einval"); +(68) } +(69) ENSURE(2); +(70) (*res)[0] = 0; +(71) (*res)[1] = ud->creation; +(72) return 2; +(73) default: +(74) return report_control_error(res, res_size, "einval"); +(75) } +(76) #undef ENSURE +(77) } ]]> +

The macro (line 5 to 10) is used to ensure that + the buffer is large enough for our answer. We switch on the + command and take actions, there is not much to say about this + routine. Worth noting is that we always has read select active + on a port in data mode (achieved by calling on + line 45), but turn off read selection in intermediate and + command modes (line 27 and 36).

+

The rest of the driver is more or less UDS specific and not of + general interest.

+
+
+ +
+ Putting it all together +

To test the distribution, one can use the + function, which is useful as it starts + the distribution on a running system, where tracing/debugging + can be performed. The routine takes a + list as it's single argument. The lists first element should be + the node name (without the "@hostname") as an atom, and the second (and + last) element should be one of the atoms or + . In the example case is + preferred.

+

For net kernel to find out which distribution module to use, the + command line argument is used. The argument + is followed by one or more distribution module names, with the + "_dist" suffix removed, i.e. uds_dist as a distribution module + is specified as .

+

If no epmd (TCP port mapper daemon) is used, one should also + specify the command line option , which will make + Erlang skip the epmd startup, both as a OS process and as an + Erlang ditto.

+

The path to the directory where the distribution modules reside + must be known at boot, which can either be achieved by + specifying ]]> on the command line or by building + a boot script containing the applications used for your + distribution protocol (in the uds_dist protocol, it's only the + uds_dist application that needs to be added to the script).

+

The distribution will be started at boot if all the above is + specified and an ]]> flag is present at the + command line, here follows two examples:

+ 
+$ erl -pa $ERL_TOP/lib/kernel/examples/uds_dist/ebin -proto_dist uds -no_epmd
+Erlang (BEAM) emulator version 5.0 
+ 
+Eshell V5.0  (abort with ^G)
+1> net_kernel:start([bing,shortnames]).
+{ok,<0.30.0>}
+(bing@hador)2>
+

...

+ 
+$ erl -pa $ERL_TOP/lib/kernel/examples/uds_dist/ebin -proto_dist uds \\ 
+      -no_epmd -sname bong
+Erlang (BEAM) emulator version 5.0 
+ 
+Eshell V5.0  (abort with ^G)
+(bong@hador)1>
+

One can utilize the ERL_FLAGS environment variable to store the + complicated parameters in:

+ 
+$ ERL_FLAGS=-pa $ERL_TOP/lib/kernel/examples/uds_dist/ebin \\ 
+      -proto_dist uds -no_epmd
+$ export ERL_FLAGS
+$ erl -sname bang
+Erlang (BEAM) emulator version 5.0 
+ 
+Eshell V5.0  (abort with ^G)
+(bang@hador)1>
+

The should preferably not include the name of + the node.

+
+ + diff --git a/erts/doc/src/book.xml b/erts/doc/src/book.xml new file mode 100644 index 0000000000..00a2888685 --- /dev/null +++ b/erts/doc/src/book.xml @@ -0,0 +1,49 @@ + + + + +
+ + 19972009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + Erlang Run-Time System Application (ERTS) + Magnus Fröberg + + 1997-05-02 + 4.5.2 + book.xml +
+ + + Erlang Run-Time System Application (ERTS) + + + + + + + + + + + + + + + + diff --git a/erts/doc/src/crash_dump.xml b/erts/doc/src/crash_dump.xml new file mode 100644 index 0000000000..5182929358 --- /dev/null +++ b/erts/doc/src/crash_dump.xml @@ -0,0 +1,518 @@ + + + + +
+ + 19992009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + How to interpret the Erlang crash dumps + Patrik Nyblom + + + + + 1999-11-11 + PA1 + crash_dump.xml +
+

This document describes the file generated + upon abnormal exit of the Erlang runtime system.

+

Important: For OTP release R9C the Erlang crash dump has + had a major facelift. This means that the information in this + document will not be directly applicable for older dumps. However, + if you use the Crashdump Viewer tool on older dumps, the crash + dumps are translated into a format similar to this.

+

The system will write the crash dump in the current directory of + the emulator or in the file pointed out by the environment variable + (whatever that means on the current operating system) + ERL_CRASH_DUMP. For a crash dump to be written, there has to be a + writable file system mounted.

+

Crash dumps are written mainly for one of two reasons: either the + builtin function is called explicitly with a + string argument from running Erlang code, or else the runtime + system has detected an error that cannot be handled. The most + usual reason that the system can't handle the error is that the + cause is external limitations, such as running out of memory. A + crash dump due to an internal error may be caused by the system + reaching limits in the emulator itself (like the number of atoms + in the system, or too many simultaneous ets tables). Usually the + emulator or the operating system can be reconfigured to avoid the + crash, which is why interpreting the crash dump correctly is + important.

+

The erlang crash dump is a readable text file, but it might not be + very easy to read. Using the Crashdump Viewer tool in the + application will simplify the task. This is an + HTML based tool for browsing Erlang crash dumps.

+ +
+ + General information +

The first part of the dump shows the creation time for the dump, + a slogan indicating the reason for the dump, the system version, + of the node from which the dump originates, the compile time of + the emulator running the originating node and the number of + atoms in the atom table. +

+ +
+ Reasons for crash dumps (slogan) +

The reason for the dump is noted in the beginning of the file + as Slogan: <reason> (the word "slogan" has historical + roots). If the system is halted by the BIF + , the slogan is the string parameter + passed to the BIF, otherwise it is a description generated by + the emulator or the (Erlang) kernel. Normally the message + should be enough to understand the problem, but nevertheless + some messages are described here. Note however that the + suggested reasons for the crash are only suggestions. The exact reasons for the errors may vary + depending on the local applications and the underlying + operating system.

+ + "<A>: Cannot allocate <N> + bytes of memory (of type "<T>")." - The system + has run out of memory. <A> is the allocator that failed + to allocate memory, <N> is the number of bytes that + <A> tried to allocate, and <T> is the memory block + type that the memory was needed for. The most common case is + that a process stores huge amounts of data. In this case + <T> is most often , , + , or . For more information on + allocators see + erts_alloc(3). + "<A>: Cannot reallocate <N> + bytes of memory\011(of type "<T>")." - Same as + above with the exception that memory was being reallocated + instead of being allocated when the system ran out of memory. + "Unexpected op code N" - Error in compiled + code, file damaged or error in the compiler. + "Module Name undefined" "Function + Name undefined" "No function + Name:Name/1" "No function + Name:start/2" - The kernel/stdlib applications are + damaged or the start script is damaged. + "Driver_select called with too large file descriptor + " - The number of file descriptors for sockets + exceed 1024 (Unix only). The limit on file-descriptors in + some Unix flavors can be set to over 1024, but only 1024 + sockets/pipes can be used simultaneously by Erlang (due to + limitations in the Unix call). The number of + open regular files is not affected by this. + "Received SIGUSR1" - The SIGUSR1 signal was sent to the + Erlang machine (Unix only). + "Kernel pid terminated (Who) + (Exit-reason)" - The kernel supervisor has detected + a failure, usually that the + has shut down ( = , + = ). The application controller + may have shut down for a number of reasons, the most usual + being that the node name of the distributed Erlang node is + already in use. A complete supervisor tree "crash" (i.e., + the top supervisors have exited) will give about the same + result. This message comes from the Erlang code and not from + the virtual machine itself. It is always due to some kind of + failure in an application, either within OTP or a + "user-written" one. Looking at the error log for your + application is probably the first step to take. + "Init terminating in do_boot ()" - The primitive Erlang boot + sequence was terminated, most probably because the boot + script has errors or cannot be read. This is usually a + configuration error - the system may have been started with + a faulty parameter or with a boot script from + the wrong version of OTP. + "Could not start kernel pid (Who) ()" - One of the + kernel processes could not start. This is probably due to + faulty arguments (like errors in a argument) + or faulty configuration files. Check that all files are in + their correct location and that the configuration files (if + any) are not damaged. Usually there are also messages + written to the controlling terminal and/or the error log + explaining what's wrong. + +

Other errors than the ones mentioned above may occur, as the + BIF may generate any message. If the + message is not generated by the BIF and does not occur in the + list above, it may be due to an error in the emulator. There + may however be unusual messages that I haven't mentioned, that + still are connected to an application failure. There is a lot + more information available, so more thorough reading of the + crash dump may reveal the crash reason. The size of processes, + the number of ets tables and the Erlang data on each process + stack can be useful for tracking down the problem.

+
+ +
+ Number of atoms +

The number of atoms in the system at the time of the crash is + shown as Atoms: <number>. Some ten thousands atoms is + perfectly normal, but more could indicate that the BIF + is used to dynamically generate a + lot of different atoms, which is never a good idea.

+
+
+ +
+ + Memory information +

Under the tag =memory you will find information similar + to what you can obtain on a living node with + erlang:memory().

+
+ +
+ + Internal table information +

The tags =hash_table:<table_name> and + =index_table:<table_name> presents internal + tables. These are mostly of interest for runtime system + developers.

+
+ +
+ + Allocated areas +

Under the tag =allocated_areas you will find information + similar to what you can obtain on a living node with + erlang:system_info(allocated_areas).

+
+ +
+ + Allocator +

Under the tag =allocator:<A> you will find + various information about allocator <A>. The information + is similar to what you can obtain on a living node with + erlang:system_info({allocator, <A>}). + For more information see the documentation of + erlang:system_info({allocator, <A>}), + and the + erts_alloc(3) + documentation.

+
+ +
+ + Process information +

The Erlang crashdump contains a listing of each living Erlang + process in the system. The process information for one process + may look like this (line numbers have been added): +

+

The following fields can exist for a process:

+ + =proc:<pid> + Heading, states the process identifier + State + +

The state of the process. This can be one of the following:

+ + Scheduled - The process was scheduled to run + but not currently running ("in the run queue"). + Waiting - The process was waiting for + something (in ). + Running - The process was currently + running. If the BIF was called, this was + the process calling it. + Exiting - The process was on its way to + exit. + Garbing - This is bad luck, the process was + garbage collecting when the crash dump was written, the rest + of the information for this process is limited. + Suspended - The process is suspended, either + by the BIF or because it is + trying to write to a busy port. + + + Registered name + The registered name of the process, if any. + Spawned as + The entry point of the process, i.e., what function was + referenced in the or call that + started the process. + Last scheduled in for | Current call + The current function of the process. These fields will not + always exist. + Spawned by + The parent of the process, i.e. the process which executed + or . + Started + The date and time when the process was started. + Message queue length + The number of messages in the process' message queue. + Number of heap fragments + The number of allocated heap fragments. + Heap fragment data + Size of fragmented heap data. This is data either created by + messages being sent to the process or by the Erlang BIFs. This + amount depends on so many things that this field is utterly + uninteresting. + Link list + Process id's of processes linked to this one. May also contain + ports. If process monitoring is used, this field also tells in + which direction the monitoring is in effect, i.e., a link + being "to" a process tells you that the "current" process was + monitoring the other and a link "from" a process tells you + that the other process was monitoring the current one. + Reductions + The number of reductions consumed by the process. + Stack+heap + The size of the stack and heap (they share memory segment) + OldHeap + The size of the "old heap". The Erlang virtual machine uses + generational garbage collection with two generations. There is + one heap for new data items and one for the data that have + survived two garbage collections. The assumption (which is + almost always correct) is that data that survive two garbage + collections can be "tenured" to a heap more seldom garbage + collected, as they will live for a long period. This is a + quite usual technique in virtual machines. The sum of the + heaps and stack together constitute most of the process's + allocated memory. + Heap unused, OldHeap unused + The amount of unused memory on each heap. This information is + usually useless. + Stack + If the system uses shared heap, the fields + Stack+heap, OldHeap, Heap unused + and OldHeap unused do not exist. Instead this field + presents the size of the process' stack. + Program counter + The current instruction pointer. This is only interesting for + runtime system developers. The function into which the program + counter points is the current function of the process. + CP + The continuation pointer, i.e. the return address for the + current call. Usually useless for other than runtime system + developers. This may be followed by the function into which + the CP points, which is the function calling the current + function. + Arity + The number of live argument registers. The argument registers, + if any are live, will follow. These may contain the arguments + of the function if they are not yet moved to the stack. + +

See also the section about process data.

+
+ +
+ + Port information +

This section lists the open ports, their owners, any linked + processed, and the name of their driver or external process.

+
+ +
+ + ETS tables +

This section contains information about all the ETS tables in + the system. The following fields are interesting for each table:

+ + =ets:<owner> + Heading, states the owner of the table (a process identifier) + Table + The identifier for the table. If the table is a + , this is the name. + Name + The name of the table, regardless of whether it is a + or not. + Buckets + This occurs if the table is a hash table, i.e. if it is not an + . + Ordered set (AVL tree), Elements + This occurs only if the table is an . (The + number of elements is the same as the number of objects in the + table.) + Objects + The number of objects in the table + Words + The number of words (usually 4 bytes/word) allocated to data + in the table. + +
+ +
+ + Timers +

This section contains information about all the timers started + with the BIFs and + . The following fields exists for each + timer:

+ + =timer:<owner> + Heading, states the owner of the timer (a process identifier) + i.e. the process to receive the message when the timer + expires. + Message + The message to be sent. + Time left + Number of milliseconds left until the message would have been + sent. + +
+ +
+ + Distribution information +

If the Erlang node was alive, i.e., set up for communicating + with other nodes, this section lists the connections that were + active. The following fields can exist:

+ + =node:<node_name> + The name of the node + no_distribution + This will only occur if the node was not distributed. + =visible_node:<channel> + Heading for a visible nodes, i.e. an alive node with a + connection to the node that crashed. States the channel number + for the node. + =hidden_node:<channel> + Heading for a hidden node. A hidden node is the same as a + visible node, except that it is started with the "-hidden" + flag. States the channel number for the node. + =not_connected:<channel> + Heading for a node which is has been connected to the crashed + node earlier. References (i.e. process or port identifiers) + to the not connected node existed at the time of the crash. + exist. States the channel number for the node. + Name + The name of the remote node. + Controller + The port which controls the communication with the remote node. + Creation + An integer (1-3) which together with the node name identifies + a specific instance of the node. + Remote monitoring: <local_proc> <remote_proc> + The local process was monitoring the remote process at the + time of the crash. + Remotely monitored by: <local_proc> <remote_proc> + The remote process was monitoring the local process at the + time of the crash. + Remote link: <local_proc> <remote_proc> + A link existed between the local process and the remote + process at the time of the crash. + +
+ +
+ + Loaded module information +

This section contains information about all loaded modules. + First, the memory usage by loaded code is summarized. There is + one field for "Current code" which is code that is the current + latest version of the modules. There is also a field for "Old + code" which is code where there exists a newer version in the + system, but the old version is not yet purged. The memory usage + is in bytes.

+

All loaded modules are then listed. The following fields exist:

+ + =mod:<module_name> + Heading, and the name of the module. + Current size + Memory usage for the loaded code in bytes + Old size + Memory usage for the old code, if any. + Current attributes + Module attributes for the current code. This field is decoded + when looked at by the Crashdump Viewer tool. + Old attributes + Module attributes for the old code, if any. This field is + decoded when looked at by the Crashdump Viewer tool. + Current compilation info + Compilation information (options) for the current code. This + field is decoded when looked at by the Crashdump Viewer tool. + Old compilation info + Compilation information (options) for the old code, if + any. This field is decoded when looked at by the Crashdump + Viewer tool. + +
+ +
+ + Fun information +

In this section, all funs are listed. The following fields exist + for each fun:

+ + =fun + Heading + Module + The name of the module where the fun was defined. + Uniq, Index + Identifiers + Address + The address of the fun's code. + Native_address + The address of the fun's code when HiPE is enabled. + Refc + The number of references to the fun. + +
+ +
+ + Process Data +

For each process there will be at least one =proc_stack + and one =proc_heap tag followed by the raw memory + information for the stack and heap of the process.

+

For each process there will also be a =proc_messages + tag if the process' message queue is non-empty and a + =proc_dictionary tag if the process' dictionary (the + and thing) is non-empty.

+

The raw memory information can be decoded by the Crashdump + Viewer tool. You will then be able to see the stack dump, the + message queue (if any) and the dictionary (if any).

+

The stack dump is a dump of the Erlang process stack. Most of + the live data (i.e., variables currently in use) are placed on + the stack; thus this can be quite interesting. One has to + "guess" what's what, but as the information is symbolic, + thorough reading of this information can be very useful. As an + example we can find the state variable of the Erlang primitive + loader on line in the example below:

+ ) +(2) y(0) ["/view/siri_r10_dev/clearcase/otp/erts/lib/kernel/ebin","/view/siri_r10_dev/ +(3) clearcase/otp/erts/lib/stdlib/ebin"] +(4) y(1) <0.1.0> +(5) y(2) {state,[],none,#Fun,undefined,#Fun,#Fun,#Port<0.2>,infinity,#Fun} +(6) y(3) infinity ]]> +

When interpreting the data for a process, it is helpful to know + that anonymous function objects (funs) are given a name + constructed from the name of the function in which they are + created, and a number (starting with 0) indicating the number of + that fun within that function.

+
+ +
+ + Atoms +

Now all the atoms in the system are written. This is only + interesting if one suspects that dynamic generation of atoms could + be a problem, otherwise this section can be ignored.

+

Note that the last created atom is printed first.

+
+ +
+ Disclaimer +

The format of the crash dump evolves between releases of + OTP. Some information here may not apply to your + version. A description as this will never be complete; it is meant as + an explanation of the crash dump in general and as a help + when trying to find application errors, not as a complete + specification.

+
+ + diff --git a/erts/doc/src/driver.xml b/erts/doc/src/driver.xml new file mode 100644 index 0000000000..c396ee0b90 --- /dev/null +++ b/erts/doc/src/driver.xml @@ -0,0 +1,812 @@ + + + + +
+ + 20012009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + How to implement a driver + Jakob C + + 2000-11-28 + PA1 + driver.xml +
+ +

This document was written a long time ago. A lot of it is still + valid, but some things have changed since it was first written. + Updates of this document are planned for the future. The reader + is encouraged to also read the + erl_driver, and the + driver_entry documentation. +

+ +
+ Introduction +

This chapter tells you how to build your own driver for erlang.

+

A driver in Erlang is a library written in C, that is linked to + the Erlang emulator and called from erlang. Drivers can be used + when C is more suitable than Erlang, to speed things up, or to + provide access to OS resources not directly accessible from + Erlang.

+

A driver can be dynamically loaded, as a shared library (known as + a DLL on windows), or statically loaded, linked with the emulator + when it is compiled and linked. Only dynamically loaded drivers + are described here, statically linked drivers are beyond the scope + of this chapter.

+

When a driver is loaded it is executed in the context of the + emulator, shares the same memory and the same thread. This means + that all operations in the driver must be non-blocking, and that + any crash in the driver will bring the whole emulator down. In + short: you have to be extremely careful!

+

+
+ +
+ Sample driver +

This is a simple driver for accessing a postgres + database using the libpq C client library. Postgres + is used because it's free and open source. For information + on postgres, refer to the website www.postgres.org.

+

The driver is synchronous, it uses the synchronous calls of + the client library. This is only for simplicity, and is + generally not good, since it will + halt the emulator while waiting for the database. + This will be improved on below with an asynchronous + sample driver.

+

The code is quite straight-forward: all + communication between Erlang and the driver + is done with , and the + driver returns data back using the .

+

An Erlang driver only exports one function: the driver + entry function. This is defined with a macro, + , and returns a pointer to a + C containing the entry points that are + called from the emulator. The defines the + entries that the emulator calls to call the driver, with + a pointer for entries that are not defined + and used by the driver.

+

The entry is called when the driver + is opened as a port with . Here + we allocate memory for a user data structure. + This user data will be passed every time the emulator + calls us. First we store the driver handle, because it + is needed in subsequent calls. We allocate memory for + the connection handle that is used by LibPQ. We also + set the port to return allocated driver binaries, by + setting the flag , calling + . (This is because + we don't know whether our data will fit in the + result buffer of , which has a default size + set up by the emulator, currently 64 bytes.)

+

There is an entry which is called when + the driver is loaded, but we don't use this, since + it is executed only once, and we want to have the + possibility of several instances of the driver.

+

The entry is called when the port + is closed.

+

The entry is called from the emulator + when the Erlang code calls , + to do the actual work. We have defined a simple set of + commands: to login to the database, + to log out and to send a SQL-query and get the result. + All results are returned through . + The library in is used + to encode data in binary term format. The result is returned + to the emulator as binary terms, so + is called in Erlang to convert the result to term form.

+

The code is available in in the + directory of .

+

The driver entry contains the functions that + will be called by the emulator. In our simple + example, we only provide , + and .

+ +

We have a structure to store state needed by the driver, + in this case we only need to keep the database connection.

+ +

These are control codes we have defined.

+ +

This just returns the driver structure. The macro + defines the only exported function. + All the other functions are static, and will not be exported + from the library.

+ +

Here we do some initialization, is called from + . The data will be passed to + and .

+ conn = NULL; + set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); + return (ErlDrvData)data; +} + ]]> +

We call disconnect to log out from the database. + (This should have been done from Erlang, but just in case.)

+ +

We use the binary format only to return data to the emulator; + input data is a string paramater for and + . The returned data consists of Erlang terms.

+

The functions and are + utilities that is used to make the code shorter. + duplicates the string and zero-terminates it, since the + postgres client library wants that. + takes an buffer and allocates a binary and + copies the data there. This binary is returned in . + (Note that this binary is freed by the emulator, not by us.)

+ +

In is where we log in to the database. If the connection + was successful we store the connection handle in our driver + data, and return ok. Otherwise, we return the error message + from postgres, and store in the driver data.

+ conn = conn; + return 0; +} + ]]> +

If we are connected (if the connection handle is not ), + we log out from the database. We need to check if a we should + encode an ok, since we might get here from the + function, which doesn't return data to the emulator.

+ conn == NULL) + return 0; + PQfinish(data->conn); + data->conn = NULL; + if (x != NULL) + encode_ok(x); + return 0; +} + ]]> +

We execute a query and encodes the result. Encoding is done + in another C module, which is also provided + as sample code.

+ conn, s); + encode_result(x, res, data->conn); + PQclear(res); + return 0; +} + ]]> +

Here we simply checks the result from postgres, and + if it's data we encode it as lists of lists with + column data. Everything from postgres is C strings, + so we just use to send + the result as strings to Erlang. (The head of the list + contains the column names.)

+ +
+ +
+ Compiling and linking the sample driver +

The driver should be compiled and linked to a shared + library (DLL on windows). With gcc this is done + with the link flags and . + Since we use the library we should include + it too. There are several versions of , compiled + for debug or non-debug and multi-threaded or single-threaded. + In the makefile for the samples the directory + is used for the library, meaning that we use + the non-debug, single-threaded version.

+
+ +
+ Calling a driver as a port in Erlang +

Before a driver can be called from Erlang, it must be + loaded and opened. Loading is done using the + module (the driver that loads dynamic + driver, is actually a driver itself). If loading is ok + the port can be opened with . The port + name must match the name of the shared library and + the name in the driver entry structure.

+

When the port has been opened, the driver can be called. In + the example, we don't have any data from + the port, only the return value from the + .

+

The following code is the Erlang part of the synchronous + postgres driver, .

+ + case erl_ddll:load_driver(".", "pg_sync") of + ok -> ok; + {error, already_loaded} -> ok; + E -> exit({error, E}) + end, + Port = open_port({spawn, ?MODULE}, []), + case binary_to_term(port_control(Port, ?DRV_CONNECT, ConnectStr)) of + ok -> {ok, Port}; + Error -> Error + end. + +disconnect(Port) -> + R = binary_to_term(port_control(Port, ?DRV_DISCONNECT, "")), + port_close(Port), + R. + +select(Port, Query) -> + binary_to_term(port_control(Port, ?DRV_SELECT, Query)). + ]]> +

The api is simple: loads the driver, opens it + and logs on to the database, returning the Erlang port + if successful, sends a query to the driver, + and returns the result, closes the + database connection and the driver. (It does not unload it, + however.) The connection string should be a connection + string for postgres.

+

The driver is loaded with , + and if this is successful, or if it's already loaded, + it is opened. This will call the function + in the driver.

+

We use the function for all + calls into the driver, the result from the driver is + returned immediately, and converted to terms by calling + . (We trust that the terms returned + from the driver are well-formed, otherwise the + calls could be contained in a + .)

+
+ +
+ Sample asynchronous driver +

Sometimes database queries can take long time to + complete, in our driver, the emulator + halts while the driver is doing it's job. This is + often not acceptable, since no other Erlang processes + gets a chance to do anything. To improve on our + postgres driver, we reimplement it using the asynchronous + calls in LibPQ.

+

The asynchronous version of the driver is in the + sample files and .

+ +

Here some things have changed from : we use the + entry for and + which will be called from the emulator only + when there is input to be read from the socket. (Actually, the + socket is used in a function inside + the emulator, and when the socket is signalled, + indicating there is data to read, the entry + is called. More on this below.)

+

Our driver data is also extended, we keep track of the + socket used for communication with postgres, and also + the port, which is needed when we send data to the port with + . We have a flag to tell + whether the driver is waiting for a connection or waiting + for the result of a query. (This is needed since the entry + will be called both when connecting and + when there is query result.)

+ port, x.buff, x.index); + ei_x_free(&x); + } + PQconnectPoll(conn); + int socket = PQsocket(conn); + data->socket = socket; + driver_select(data->port, (ErlDrvEvent)socket, DO_READ, 1); + driver_select(data->port, (ErlDrvEvent)socket, DO_WRITE, 1); + data->conn = conn; + data->connecting = 1; + return 0; +} + ]]> +

The function looks a bit different too. We connect + using the asynchronous function. After the + connection is started, we retrieve the socket for the connection + with . This socket is used with the + function to wait for connection. When + the socket is ready for input or for output, the + function will be called.

+

Note that we only return data (with ) if there + is an error here, otherwise we wait for the connection to be completed, + in which case our function will be called.

+ connecting = 0; + PGconn* conn = data->conn; + /* if there's an error return it now */ + if (PQsendQuery(conn, s) == 0) { +\011ei_x_buff x; +\011ei_x_new_with_version(&x); +\011encode_error(&x, conn); +\011driver_output(data->port, x.buff, x.index); +\011ei_x_free(&x); + } + /* else wait for ready_output to get results */ + return 0; +} + ]]> +

The function initiates a select, and returns + if there is no immediate error. The actual result will be returned + when is called.

+ conn; + ei_x_buff x; + ei_x_new_with_version(&x); + if (data->connecting) { +\011ConnStatusType status; +\011PQconnectPoll(conn); +\011status = PQstatus(conn); +\011if (status == CONNECTION_OK) +\011 encode_ok(&x); +\011else if (status == CONNECTION_BAD) +\011 encode_error(&x, conn); + } else { +\011PQconsumeInput(conn); +\011if (PQisBusy(conn)) +\011 return; +\011res = PQgetResult(conn); +\011encode_result(&x, res, conn); +\011PQclear(res); +\011for (;;) { +\011 res = PQgetResult(conn); +\011 if (res == NULL) +\011\011break; +\011 PQclear(res); +\011} + } + if (x.index > 1) { +\011driver_output(data->port, x.buff, x.index); +\011if (data->connecting) +\011 driver_select(data->port, (ErlDrvEvent)data->socket, DO_WRITE, 0); + } + ei_x_free(&x); +} + ]]> +

The function will be called when the socket + we got from postgres is ready for input or output. Here + we first check if we are connecting to the database. In that + case we check connection status and return ok if the + connection is successful, or error if it's not. If the + connection is not yet established, we simply return; + will be called again.

+

If we have result from a connect, indicated that we have data in + the buffer, we no longer need to select on + output (), so we remove this by calling + .

+

If we're not connecting, we're waiting for results from a + , so we get the result and return it. The + encoding is done with the same functions as in the earlier + example.

+

We should add error handling here, for instance checking + that the socket is still open, but this is just a simple + example.

+

The Erlang part of the asynchronous driver consists of the + sample file .

+ + case erl_ddll:load_driver(".", "pg_async") of +\011ok -> ok; +\011{error, already_loaded} -> ok; +\011_ -> exit({error, could_not_load_driver}) + end, + Port = open_port({spawn, ?MODULE}, [binary]), + port_control(Port, ?DRV_CONNECT, ConnectStr), + case return_port_data(Port) of +\011ok -> +\011 {ok, Port}; +\011Error -> +\011 Error + end. + +disconnect(Port) -> + port_control(Port, ?DRV_DISCONNECT, ""), + R = return_port_data(Port), + port_close(Port), + R. + +select(Port, Query) -> + port_control(Port, ?DRV_SELECT, Query), + return_port_data(Port). + +return_port_data(Port) -> + receive +\011{Port, {data, Data}} -> +\011 binary_to_term(Data) + end. + ]]> +

The Erlang code is slightly different, this is because we + don't return the result synchronously from , + instead we get it from as data in the + message queue. The function above + receives data from the port. Since the data is in + binary format, we use to convert + it to Erlang term. Note that the driver is opened in + binary mode, is called with the option + . This means that data sent from the driver + to the emulator is sent as binaries. Without the + option, they would have been lists of integers.

+
+ +
+ An asynchronous driver using driver_async +

As a final example we demonstrate the use of . + We also use the driver term interface. The driver is written + in C++. This enables us to use an algorithm from STL. We will + use the algorithm to get the next permutation + of a list of integers. For large lists (more than 100000 + elements), this will take some time, so we will perform this + as an asynchronous task.

+

The asynchronous api for drivers are quite complicated. First + of all, the work must be prepared. In our example we do this + in . We could have used just as well, + but we want some variation in our examples. In our driver, we allocate + a structure that contains all needed for the asynchronous task + to do the work. This is done in the main emulator thread. + Then the asynchronous function is called from a driver thread, + separate from the main emulator thread. Note that the driver- + functions are not reentrant, so they shouldn't be used. + Finally, after the function is completed, the driver callback + is called from the main emulator thread, + this is where we return the result to Erlang. (We can't + return the result from within the asynchronous function, since + we can't call the driver-functions.)

+

The code below is from the sample file .

+

The driver entry looks like before, but also contains the + call-back .

+ +

The function allocates the work-area of the + asynchronous function. Since we use C++, we use a struct, + and stuff the data in it. We have to copy the original data, + it is not valid after we have returned from the + function, and the function will be called later, + and from another thread. We return no data here, instead it will + be sent later from the call-back.

+

The will be passed to the function. + We do not use a function (the last argument to + , it's only used if the task is cancelled + programmatically.

+ data; + our_async_data(ErlDrvPort p, int command, const char* buf, int len); +}; + +our_async_data::our_async_data(ErlDrvPort p, int command, +\011\011\011 const char* buf, int len) + : prev(command == 2), + data((int*)buf, (int*)buf + len / sizeof(int)) +{ +} + +static void do_perm(void* async_data); + +static void output(ErlDrvData drv_data, char *buf, int len) +{ + if (*buf < 1 || *buf > 2) return; + ErlDrvPort port = reinterpret_cast(drv_data); + void* async_data = new our_async_data(port, *buf, buf+1, len); + driver_async(port, NULL, do_perm, async_data, do_free); +} + ]]> +

In the we simply do the work, operating + on the structure that was allocated in .

+ (async_data); + if (d->prev) +\011prev_permutation(d->data.begin(), d->data.end()); + else +\011next_permutation(d->data.begin(), d->data.end()); +} + ]]> +

In the function, the output is sent back to the + emulator. We use the driver term format instead of . + This is the only way to send Erlang terms directly to a driver, + without having the Erlang code to call . In + our simple example this works well, and we don't need to use + to handle the binary term format.

+

When the data is returned we deallocate our data.

+ (drv_data); + our_async_data* d = reinterpret_cast(async_data); + int n = d->data.size(), result_n = n*2 + 3; + ErlDrvTermData* result = new ErlDrvTermData[result_n], * rp = result; + for (vector::iterator i = d->data.begin(); +\011 i != d->data.end(); ++i) { +\011*rp++ = ERL_DRV_INT; +\011*rp++ = *i; + } + *rp++ = ERL_DRV_NIL; + *rp++ = ERL_DRV_LIST; + *rp++ = n+1; + driver_output_term(port, result, result_n); + delete[] result; + delete d; +} + ]]> +

This driver is called like the others from Erlang, however, since + we use , there is no need to call + binary_to_term. The Erlang code is in the sample file + .

+

The input is changed into a list of integers and sent to + the driver.

+ + case whereis(next_perm) of +\011undefined -> +\011 case erl_ddll:load_driver(".", "next_perm") of +\011\011ok -> ok; +\011\011{error, already_loaded} -> ok; +\011\011E -> exit(E) +\011 end, +\011 Port = open_port({spawn, "next_perm"}, []), +\011 register(next_perm, Port); +\011_ -> +\011 ok + end. + +list_to_integer_binaries(L) -> + [<> || I <- L]. + +next_perm(L) -> + next_perm(L, 1). + +prev_perm(L) -> + next_perm(L, 2). + +next_perm(L, Nxt) -> + load(), + B = list_to_integer_binaries(L), + port_control(next_perm, Nxt, B), + receive +\011Result -> +\011 Result + end. + +all_perm(L) -> + New = prev_perm(L), + all_perm(New, L, [New]). + +all_perm(L, L, Acc) -> + Acc; +all_perm(L, Orig, Acc) -> + New = prev_perm(L), + all_perm(New, Orig, [New | Acc]). + ]]> +
+ + diff --git a/erts/doc/src/driver_entry.xml b/erts/doc/src/driver_entry.xml new file mode 100644 index 0000000000..6b7d2acf24 --- /dev/null +++ b/erts/doc/src/driver_entry.xml @@ -0,0 +1,453 @@ + + + + +
+ + 20012009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + driver_entry + Jakob Cederlund + Jakob Cederlund + 1 + + + 2001-10-01 + PA1 + driver_entry.xml +
+ driver_entry + The driver-entry structure used by erlang drivers. + +

As of erts version 5.5.3 the driver interface has been extended + (see extended marker). + The extended interface introduce + version management, + the possibility to pass capability flags + (see driver flags) + to the runtime system at driver initialization, and some new + driver API functions.

+ +

Old drivers (compiled with an erl_driver.h from an + earlier erts version than 5.5.3) have to be recompiled + (but does not have to use the extended interface).

+ +

The driver_entry structure is a C struct that all erlang + drivers defines. It contains entry points for the erlang driver + that are called by the erlang emulator when erlang code accesses + the driver.

+

+ + The erl_driver driver + API functions needs a port handle + that identifies the driver instance (and the port in the + emulator). This is only passed to the start function, but + not to the other functions. The start function returns a + driver-defined handle that is passed to the other functions. A + common practice is to have the start function allocating + some application-defined structure and stash the port + handle in it, to use it later with the driver API functions.

+

The driver call-back functions are called synchronously from the + erlang emulator. If they take too long before completing, they + can cause timeouts in the emulator. Use the queue or + asynchronous calls if necessary, since the emulator must be + responsive.

+

The driver structure contains the name of the driver and some + 15 function pointers. These pointers are called at different + times by the emulator.

+

The only exported function from the driver is + driver_init. This function returns the driver_entry + structure that points to the other functions in the driver. The + driver_init function is declared with a macro + DRIVER_INIT(drivername). (This is because different OS's + have different names for it.)

+

When writing a driver in C++, the driver entry should be of + "C" linkage. One way to do this is to put this line + somewhere before the driver entry: + extern "C" DRIVER_INIT(drivername);.

+

When the driver has passed the driver_entry over to + the emulator, the driver is not allowed to modify the + driver_entry.

+ +

Do not declare the driver_entryconst. This since the emulator needs to + modify the handle, and the handle2 + fields. A statically allocated, and const + declared driver_entry may be located in + read only memory which will cause the emulator + to crash.

+ + + +
+ DATA TYPES + + ErlDrvEntry + +

+ +typedef struct erl_drv_entry { + int (*init)(void); /* called at system start up for statically + linked drivers, and after loading for + dynamically loaded drivers */ + +#ifndef ERL_SYS_DRV + ErlDrvData (*start)(ErlDrvPort port, char *command); + /* called when open_port/2 is invoked. + return value -1 means failure. */ +#else + ErlDrvData (*start)(ErlDrvPort port, char *command, SysDriverOpts* opts); + /* special options, only for system driver */ +#endif + void (*stop)(ErlDrvData drv_data); + /* called when port is closed, and when the + emulator is halted. */ + void (*output)(ErlDrvData drv_data, char *buf, int len); + /* called when we have output from erlang to + the port */ + void (*ready_input)(ErlDrvData drv_data, ErlDrvEvent event); + /* called when we have input from one of + the driver's handles) */ + void (*ready_output)(ErlDrvData drv_data, ErlDrvEvent event); + /* called when output is possible to one of + the driver's handles */ + char *driver_name; /* name supplied as command + in open_port XXX ? */ + void (*finish)(void); /* called before unloading the driver - + DYNAMIC DRIVERS ONLY */ + void *handle; /* Reserved -- Used by emulator internally */ + int (*control)(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); + /* "ioctl" for drivers - invoked by + port_control/3) */ + void (*timeout)(ErlDrvData drv_data); /* Handling of timeout in driver */ + void (*outputv)(ErlDrvData drv_data, ErlIOVec *ev); + /* called when we have output from erlang + to the port */ + void (*ready_async)(ErlDrvData drv_data, ErlDrvThreadData thread_data); + void (*flush)(ErlDrvData drv_data); + /* called when the port is about to be + closed, and there is data in the + driver queue that needs to be flushed + before 'stop' can be called */ + int (*call)(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned int *flags); + /* Works mostly like 'control', a syncronous + call into the driver. */ + void (*event)(ErlDrvData drv_data, ErlDrvEvent event, + ErlDrvEventData event_data); + /* Called when an event selected by + driver_event() has occurred */ + int extended_marker; /* ERL_DRV_EXTENDED_MARKER */ + int major_version; /* ERL_DRV_EXTENDED_MAJOR_VERSION */ + int minor_version; /* ERL_DRV_EXTENDED_MINOR_VERSION */ + int driver_flags; /* ERL_DRV_FLAGs */ + void *handle2; /* Reserved -- Used by emulator internally */ + void (*process_exit)(ErlDrvData drv_data, ErlDrvMonitor *monitor); + /* Called when a process monitor fires */ + void (*stop_select)(ErlDrvEvent event, void* reserved); + /* Called to close an event object */ + } ErlDrvEntry; + +

+ + int (*init)(void) + +

This is called directly after the driver has been loaded by + erl_ddll:load_driver/2. (Actually when the driver is + added to the driver list.) The driver should return 0, or if + the driver can't initialize, -1.

+ + int (*start)(ErlDrvPort port, char* command) + +

This is called when the driver is instantiated, when + open_port/2 is called. The driver should return a + number >= 0 or a pointer, or if the driver can't be started, + one of three error codes should be returned:

+

ERL_DRV_ERROR_GENERAL - general error, no error code

+

ERL_DRV_ERROR_ERRNO - error with error code in erl_errno

+

ERL_DRV_ERROR_BADARG - error, badarg

+

If an error code is returned, the port isn't started.

+ + void (*stop)(ErlDrvData drv_data) + +

This is called when the port is closed, with + port_close/1 or Port ! {self(), close}. Note + that terminating the port owner process also closes the + p\011 port.

+ + void (*output)(ErlDrvData drv_data, char *buf, int len) + +

This is called when an erlang process has sent data to the + port. The data is pointed to by buf, and is + len bytes. Data is sent to the port with Port ! {self(), {command, Data}}, or with + port_command/2. Depending on how the port was opened, + it should be either a list of integers 0...255 or a + binary. See open_port/3 and port_command/2.

+ + + void (*ready_input)(ErlDrvData drv_data, ErlDrvEvent event) + void (*ready_output)(ErlDrvData drv_data, ErlDrvEvent event) + +

This is called when a driver event (given in the + event parameter) is signaled. This is used to help + asynchronous drivers "wake up" when something happens.

+

On unix the event is a pipe or socket handle (or + something that the select system call understands).

+

On Windows the event is an Event or Semaphore (or + something that the WaitForMultipleObjects API + function understands). (Some trickery in the emulator allows + more than the built-in limit of 64 Events to be used.)

+

To use this with threads and asynchronous routines, create a + pipe on unix and an Event on Windows. When the routine + completes, write to the pipe (use SetEvent on + Windows), this will make the emulator call + ready_input or ready_output.

+ + char *driver_name + +

This is the name of the driver, it must correspond to the + atom used in open_port, and the name of the driver + library file (without the extension).

+ + void (*finish)(void) + +

This function is called by the erl_ddll driver when the + driver is unloaded. (It is only called in dynamic drivers.)

+

The driver is only unloaded as a result of calling + unload_driver/1, or when the emulator halts.

+ + void *handle + +

This field is reserved for the emulators internal use. The + emulator will modify this field; therefore, it is important + that the driver_entry isn't declared const.

+ + int (*control)(ErlDrvData drv_data, unsigned int command, char *buf, int len, char **rbuf, int rlen) + +

This is a special routine invoked with the erlang function + port_control/3. It works a little like an "ioctl" for + erlang drivers. The data given to port_control/3 + arrives in buf and len. The driver may send + data back, using *rbuf and rlen.

+

This is the fastest way of calling a driver and get a + response. It won't make any context switch in the erlang + emulator, and requires no message passing. It is suitable + for calling C function to get faster execution, when erlang + is too slow.

+

If the driver wants to return data, it should return it in + rbuf. When control is called, + *rbuf points to a default buffer of rlen bytes, which + can be used to return data. Data is returned different depending on + the port control flags (those that are set with + set_port_control_flags). +

+

If the flag is set to PORT_CONTROL_FLAG_BINARY, + a binary will be returned. Small binaries can be returned by writing + the raw data into the default buffer. A binary can also be + returned by setting *rbuf to point to a binary allocated with + driver_alloc_binary. + This binary will be freed automatically after control has returned. + The driver can retain the binary for read only access with + driver_binary_inc_refc to be freed later with + driver_free_binary. + It is never allowed to alter the binary after control has returned. + If *rbuf is set to NULL, an empty list will be returned. +

+

If the flag is set to 0, data is returned as a + list of integers. Either use the default buffer or set + *rbuf to point to a larger buffer allocated with + driver_alloc. + The buffer will be freed automatically after control has returned.

+

Using binaries is faster if more than a few bytes are returned.

+

The return value is the number of bytes returned in + *rbuf.

+ + + void (*timeout)(ErlDrvData drv_data) + +

This function is called any time after the driver's timer + reaches 0. The timer is activated with + driver_set_timer. There are no priorities or ordering + among drivers, so if several drivers time out at the same + time, any one of them is called first.

+ + + void (*outputv)(ErlDrvData drv_data, ErlIOVec *ev) + +

This function is called whenever the port is written to. If + it is NULL, the output function is called + instead. This function is faster than output, because + it takes an ErlIOVec directly, which requires no + copying of the data. The port should be in binary mode, see + open_port/2.

+

The ErlIOVec contains both a SysIOVec, + suitable for writev, and one or more binaries. If + these binaries should be retained, when the driver returns + from outputv, they can be queued (using driver_enq_bin + for instance), or if they are kept in a static or global + variable, the reference counter can be incremented.

+ + void (*ready_async)(ErlDrvData drv_data, ErlDrvThreadData thread_data) + +

This function is called after an asynchronous call has + completed. The asynchronous call is started with driver_async. + This function is called from the erlang emulator thread, as + opposed to the asynchronous function, which is called in + some thread (if multithreading is enabled).

+ + int (*call)(ErlDrvData drv_data, unsigned int command, char *buf, int len, char **rbuf, int rlen, unsigned int *flags) + +

This function is called from erlang:port_call/3. It + works a lot like the control call-back, but uses the + external term format for input and output.

+

command is an integer, obtained from the call from + erlang (the second argument to erlang:port_call/3).

+

buf and len provide the arguments to the call + (the third argument to erlang:port_call/3). They can + be decoded using ei functions.

+

rbuf points to a return buffer, rlen bytes + long. The return data should be a valid erlang term in the + external (binary) format. This is converted to an erlang + term and returned by erlang:port_call/3 to the + caller. If more space than rlen bytes is needed to + return data, *rbuf can be set to memory allocated with + driver_alloc. This memory will be freed automatically + after call has returned.

+

The return value is the number of bytes returned in + *rbuf. If ERL_DRV_ERROR_GENERAL is returned + (or in fact, anything < 0), erlang:port_call/3 will + throw a BAD_ARG.

+ + void (*event)(ErlDrvData drv_data, ErlDrvEvent event, ErlDrvEventData event_data) + +

Intentionally left undocumented.

+ + int extended_marker + +

+ This field should either be equal to ERL_DRV_EXTENDED_MARKER + or 0. An old driver (not aware of the extended driver + interface) should set this field to 0. If this field is + equal to 0, all the fields following this field also + have to be 0, or NULL in case it is a + pointer field. +

+ + int major_version + +

This field should equal ERL_DRV_EXTENDED_MAJOR_VERSION if + the extended_marker field equals + ERL_DRV_EXTENDED_MARKER.

+ + int minor_version + +

+ This field should equal ERL_DRV_EXTENDED_MINOR_VERSION if + the extended_marker field equals + ERL_DRV_EXTENDED_MARKER. +

+ + + int driver_flags + +

This field is used to pass driver capability information to the + runtime system. If the extended_marker field equals + ERL_DRV_EXTENDED_MARKER, it should contain 0 or + driver flags (ERL_DRV_FLAG_*) ored bitwise. Currently + the following driver flags exist: +

+ + ERL_DRV_FLAG_USE_PORT_LOCKING + + The runtime system will use port level locking on + all ports executing this driver instead of driver + level locking when the driver is run in a runtime + system with SMP support. For more information see the + erl_driver + documentation. + + ERL_DRV_FLAG_SOFT_BUSY + + Marks that driver instances can handle being called + in the output and/or + outputv callbacks even + though a driver instance has marked itself as busy (see + set_busy_port()). + Since erts version 5.7.4 this flag is required for drivers used + by the Erlang distribution (the behaviour has always been + required by drivers used by the distribution). + + + + void *handle2 + +

+ This field is reserved for the emulators internal use. The + emulator will modify this field; therefore, it is important + that the driver_entry isn't declared const. +

+ + void (*process_exit)(ErlDrvData drv_data, ErlDrvMonitor *monitor) + +

This callback is called when a monitored process exits. The + drv_data is the data associated with the port for which + the process is monitored (using driver_monitor_process) + and the monitor corresponds to the ErlDrvMonitor + structure filled + in when creating the monitor. The driver interface function + driver_get_monitored_process + can be used to retrieve the process id of the exiting process as + an ErlDrvTermData.

+ + void (*stop_select)(ErlDrvEvent event, void* reserved) + +

This function is called on behalf of + driver_select + when it is safe to close an event object.

+

A typical implementation on Unix is to do + close((int)event).

+

Argument reserved is intended for future use and should be ignored.

+

In contrast to most of the other call-back functions, + stop_select is called independent of any port. No + ErlDrvData argument is passed to the function. No + driver lock or port lock is guaranteed to be held. The port that + called driver_select might even be closed at the + time stop_select is called. But it could also be + the case that stop_select is called directly by + driver_select.

+

It is not allowed to call any functions in the + driver API from + stop_select. This strict limitation is due to the + volatile context that stop_select may be called.

+ + + + + + +
+ +
+ SEE ALSO +

erl_driver(3), + erl_ddll(3), + erlang(3), + kernel(3)

+
+ + diff --git a/erts/doc/src/epmd.xml b/erts/doc/src/epmd.xml new file mode 100644 index 0000000000..796ab3820b --- /dev/null +++ b/erts/doc/src/epmd.xml @@ -0,0 +1,120 @@ + + + + +
+ + 19962009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + epmd + Claes Wikström + + 1 + + + 98-01-05 + A + epmd.xml +
+ epmd + Erlang Port Mapper Daemon + +

This daemon acts as a name server on all hosts involved in + distributed Erlang computations. When an Erlang node + starts, the node has a name and it obtains an address from the host + OS kernel. + The name and the address are sent to the + daemon running on the local host. + In a TCP/IP environment, the address consists + of the IP address and a port number. The name of the node is + an atom on the form of . + The job of the daemon is to keep track of which + node name listens on which address. Hence, map + symbolic node names to machine addresses.

+

The daemon is started automatically by the Erlang start-up script.

+

The program can also be used for a variety of other + purposes, for example checking the DNS (Domain Name System) + configuration of a host.

+ + + + epmd [-daemon] + Start a name server as a daemon + +

Starts a name server as a daemon. If it has no argument, the + runs as a normal program with the controlling terminal + of the shell in which it is started. Normally, it should run as a + daemon.

+ + + + epmd -names + Request the names of the registered Erlang nodes on this host + +

Requests the names of the local Erlang nodes has + registered.

+ + + + epmd -kill + Kill the process + +

Kills the process.

+ + + + epmd -help + List options + +

Write short info about the usage including some debugging + options not listed here.

+ + + + +
+ + Environment variables + + + +

This environment variable can contain the port number epmd will use. + The default port will work fine in most cases. A different port can + be specified to allow several instances of epmd, representing + independent clusters of nodes, to co-exist on the same host. + All nodes in a cluster must use the same epmd port number.

+ + +
+ +
+ Logging +

On some operating systems syslog will be used for + error reporting when epmd runs as an daemon. To enable + the error logging you have to edit /etc/syslog.conf + file and add an entry

+ /var/log/epmd.log + ]]> +

where <TABs> are at least one real tab character. Spaces will + silently be ignored. +

+
+ + diff --git a/erts/doc/src/erl.xml b/erts/doc/src/erl.xml new file mode 100644 index 0000000000..90a3c53a37 --- /dev/null +++ b/erts/doc/src/erl.xml @@ -0,0 +1,928 @@ + + + + +
+ + 19962009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erl + + + + + erl.xml +
+ erl + The Erlang Emulator + +

The program starts an Erlang runtime system. + The exact details (for example, whether is a script or + a program and which other programs it calls) are system-dependent.

+

Windows users probably wants to use the program + instead, which runs in its own window with scrollbars and supports + command-line editing. The program on Windows provides + no line editing in its shell, and on Windows 95 there is no way + to scroll back to text which has scrolled off the screen. + The program must be used, however, in pipelines or if + you want to redirect standard input or output.

+ + + + erl <arguments> + Start an Erlang runtime system + +

Starts an Erlang runtime system.

+

The arguments can be divided into emulator flags, + flags and plain arguments:

+ + +

Any argument starting with the character is + interpreted as an emulator flag.

+

As indicated by the name, emulator flags controls + the behavior of the emulator.

+ + +

Any argument starting with the character + (hyphen) is interpreted as a + flag which should + be passed to the Erlang part of the runtime system, more + specifically to the system process, see + init(3).

+

The process itself interprets some of these + flags, the init flags. It also stores any + remaining flags, the user flags. The latter can + be retrieved by calling .

+

It can be noted that there are a small number of "-" + flags which now actually are emulator flags, see + the description below.

+ + +

Plain arguments are not interpreted in any way. They are + also stored by the process and can be + retrieved by calling . + Plain arguments can occur before the first flag, or after + a flag. Additionally, the flag + causes everything that follows to become plain arguments.

+ + +

Example:

+ 
+% erl +W w -sname arnie +R 9 -s my_init -extra +bertie
+(arnie@host)1> init:get_argument(sname).
+{ok,[["arnie"]]}
+(arnie@host)2> init:get_plain_arguments().
+["+bertie"]
+

Here and are emulator flags. + is an init flag, interpreted by . + is a user flag, stored by . + It is read by Kernel and will cause the Erlang runtime system + to become distributed. Finally, everything after + (that is, ) is considered as plain arguments.

+ 
+% erl -myflag 1
+1> init:get_argument(myflag).
+{ok,[["1"]]}
+2> init:get_plain_arguments().
+[]
+

Here the user flag is passed to and stored + by the process. It is a user defined flag, + presumably used by some user defined application.

+ + + + +
+ + Flags +

In the following list, init flags are marked (init flag). + Unless otherwise specified, all other flags are user flags, for + which the values can be retrieved by calling + . Note that the list of user flags is + not exhaustive, there may be additional, application specific + flags which instead are documented in the corresponding + application documentation.

+ + (init flag) + +

Everything following up to the next flag + ( or ) is considered plain arguments + and can be retrieved using .

+ + + +

Sets the application configuration parameter to + the value for the application , + see app(4) and + application(3).

+ + + + +

Command line arguments are read from the file . + The arguments read from the file replace the + '' flag on the resulting command line.

+

The file should be a plain text file and may + contain comments and command line arguments. A comment begins + with a # character and continues until next end of line character. + Backslash (\\) is used as quoting character. All command line + arguments accepted by are allowed, also the + flag. Be careful not to cause circular + dependencies between files containing the flag, + though.

+

The flag is treated specially. Its scope ends + at the end of the file. Arguments following an + flag are moved on the command line into the section, + i.e. the end of the command line following after an + flag.

+ + + +

The initial Erlang shell does not read user input until + the system boot procedure has been completed (Erlang 5.4 and + later). This flag disables the start synchronization feature + and lets the shell start in parallel with the rest of + the system.

+ + + +

Specifies the name of the boot file, , + which is used to start the system. See + init(3). Unless + contains an absolute path, the system searches + for in the current and + directories.

+

Defaults to .

+ + + +

If the boot script contains a path variable other + than , this variable is expanded to . + Used when applications are installed in another directory + than , see + systools:make_script/1,2.

+ + + +

Enables the code path cache of the code server, see + code(3).

+ + + +

Compiles the specified modules and then terminates (with + non-zero exit code if the compilation of some file did not + succeed). Implies . Not recommended - use + erlc instead.

+ + + +

Specifies the name of a configuration file, + , which is used to configure + applications. See + app(4) and + application(3).

+ + + + +

If this flag is present, will not maintain a + fully connected network of distributed Erlang nodes, and then + global name registration cannot be used. See + global(3).

+ + + +

Obsolete flag without any effect and common misspelling for + . Use instead.

+ + + +

Starts the Erlang runtime system detached from the system + console. Useful for running daemons and backgrounds processes.

+ + + +

Useful for debugging. Prints out the actual arguments + sent to the emulator.

+ + + +

Sets the host OS environment variable to + the value for the Erlang runtime system. + Example:

+ 
+% erl -env DISPLAY gin:0
+

In this example, an Erlang runtime system is started with + the environment variable set to .

+ + (init flag) + +

Makes evaluate the expression , see + init(3).

+ + (init flag) + +

Everything following is considered plain + arguments and can be retrieved using + .

+ + + +

Starts heart beat monitoring of the Erlang runtime system. + See heart(3).

+ + + +

Starts the Erlang runtime system as a hidden node, if it is + run as a distributed node. Hidden nodes always establish + hidden connections to all other nodes except for nodes in the + same global group. Hidden connections are not published on + neither of the connected nodes, i.e. neither of the connected + nodes are part of the result from on the other + node. See also hidden global groups, + global_group(3).

+ + + +

Specifies the IP addresses for the hosts on which Erlang + boot servers are running, see + erl_boot_server(3). + This flag is mandatory if the flag is + present.

+

The IP addresses must be given in the standard form (four + decimal numbers separated by periods, for example + . Hosts names are not acceptable, but + a broadcast address (preferably limited to the local network) + is.

+ + + +

Specifies the identity of the Erlang runtime system. If it is + run as a distributed node, must be identical to + the name supplied together with the or + flag.

+ + + +

Makes write some debug information while + interpreting the boot script.

+ + (emulator flag) + + +

Selects an instrumented Erlang runtime system (virtual + machine) to run, instead of the ordinary one. When running an + instrumented runtime system, some resource usage data can be + obtained and analysed using the module . + Functionally, it behaves exactly like an ordinary Erlang + runtime system.

+ + + +

Specifies the method used by to load + Erlang modules into the system. See + erl_prim_loader(3). + Two methods are supported, and + . means use the local file system, + this is the default. means use a boot server on + another machine, and the , and + flags must be specified as well. If + is something else, the user supplied + port program is started.

+ + + +

Makes the Erlang runtime system invoke in + the current working directory and then terminate. See + make(3). Implies + .

+ + + +

Displays the manual page for the Erlang module . + Only supported on Unix.

+ + + +

Indicates if the system should load code dynamically + (), or if all code should be loaded + during system initialization (), see + code(3). Defaults to + .

+ + + +

Makes the Erlang runtime system into a distributed node. + This flag invokes all network servers necessary for a node to + become distributed. See + net_kernel(3). + It is also ensured that runs on the current host + before Erlang is started. See + epmd(1).

+

The name of the node will be , where + is the fully qualified host name of the current + host. For short names, use the flag instead.

+ + + +

Ensures that the Erlang runtime system never tries to read + any input. Implies .

+ + + +

Starts an Erlang runtime system with no shell. This flag + makes it possible to have the Erlang runtime system as a + component in a series of UNIX pipes.

+ + + +

Disables the sticky directory facility of the Erlang code + server, see + code(3).

+ + + +

Invokes the old Erlang shell from Erlang 3.3. The old shell + can still be used.

+ + + +

Adds the specified directories to the beginning of the code + path, similar to . See + code(3). + As an alternative to -pa, if several directories are + to be prepended to the code and the directories have a + common parent directory, that parent directory could be + specified in the ERL_LIBS environment variable. + See code(3).

+ + + +

Adds the specified directories to the end of the code path, + similar to . See + code(3).

+ + + +

Starts Erlang with a remote shell connected to .

+ + + +

Specifies an alternative to for starting a slave + node on a remote host. See + slave(3).

+ + (init flag) + +

Makes call the specified function. + defaults to . If no arguments are provided, + the function is assumed to be of arity 0. Otherwise it is + assumed to be of arity 1, taking the list + as argument. All arguments are passed + as strings. See + init(3).

+ + (init flag) + +

Makes call the specified function. + defaults to . If no arguments are provided, + the function is assumed to be of arity 0. Otherwise it is + assumed to be of arity 1, taking the list + as argument. All arguments are passed + as atoms. See + init(3).

+ + + +

Sets the magic cookie of the node to , see + erlang:set_cookie/2.

+ + + +

Specifies how long time (in milliseconds) the + process is allowed to spend shutting down the system. If + ms have elapsed, all processes still existing are + killed. Defaults to .

+ + + +

Makes the Erlang runtime system into a distributed node, + similar to , but the host name portion of the node + name will be the short name, not fully + qualified.

+

This is sometimes the only way to run distributed Erlang if + the DNS (Domain Name System) is not running. There can be no + communication between nodes running with the + flag and those running with the flag, as node + names must be unique in distributed Erlang systems.

+ + + + +

-smp enable and -smp starts the Erlang runtime + system with SMP support enabled. This may fail if no runtime + system with SMP support is available. -smp auto starts + the Erlang runtime system with SMP support enabled if it is + available and more than one logical processor are detected. + -smp disable starts a runtime system without SMP support. + By default -smp auto will be used unless a conflicting + parameter has been passed, then -smp disable will be + used. Currently only the -hybrid parameter conflicts + with -smp auto.

+

NOTE: The runtime system with SMP support will not + be available on all supported platforms. See also the + +S flag.

+ + (emulator flag) + +

Makes the emulator print out its version number. The same + as .

+ + +
+ +
+ + Emulator Flags +

invokes the code for the Erlang emulator (virtual + machine), which supports the following flags:

+ + + + +

Suggested stack size, in kilowords, for threads in the + async-thread pool. Valid range is 16-8192 kilowords. The + default suggested stack size is 16 kilowords, i.e, 64 + kilobyte on 32-bit architectures. This small default size + has been chosen since the amount of async-threads might + be quite large. The default size is enough for drivers + delivered with Erlang/OTP, but might not be sufficiently + large for other dynamically linked in drivers that use the + driver_async() + functionality. Note that the value passed is only a + suggestion, and it might even be ignored on some + platforms.

+ + + + +

Sets the number of threads in async thread pool, valid range + is 0-1024. Default is 0.

+ + + +

The option makes interrupt the current + shell instead of invoking the emulator break handler. + The option (same as specifying without an + extra option) disables the break handler. The option + makes the emulator ignore any break signal.

+

If the option is used with on Unix, + will restart the shell process rather than + interrupt it.

+

Note that on Windows, this flag is only applicable for + , not (). Note also that + is used instead of on Windows.

+ + + +

Disable compensation for sudden changes of system time.

+

Normally, will not immediately reflect + sudden changes in the system time, in order to keep timers + (including ) working. Instead, the time + maintained by is slowly adjusted towards + the new system time. (Slowly means in one percent adjustments; + if the time is off by one minute, the time will be adjusted + in 100 minutes.)

+

When the option is given, this slow adjustment + will not take place. Instead will always + reflect the current system time. Note that timers are based + on . If the system time jumps, timers + then time out at the wrong time.

+ + + +

If the emulator detects an internal error (or runs out of memory), + it will by default generate both a crash dump and a core dump. + The core dump will, however, not be very useful since the content + of process heaps is destroyed by the crash dump generation.

+ +

The +d option instructs the emulator to only produce a + core dump and no crash dump if an internal error is detected.

+ +

Calling erlang:halt/1 with a string argument will still + produce a crash dump.

+ + + +

Sets the default heap size of processes to the size + .

+ + + +

Enables or disables the kernel poll functionality if + the emulator supports it. Default is (disabled). + If the emulator does not support kernel poll, and + the flag is passed to the emulator, a warning is + issued at startup.

+ + + +

Enables auto load tracing, displaying info while loading + code.

+ + + + +

Memory allocator specific flags, see + erts_alloc(3) for + further information.

+ + + + +

Sets the maximum number of concurrent processes for this + system. must be in the range 16..134217727. + Default is 32768.

+ + + + +

Sets the compatibility mode.

+

The distribution mechanism is not backwards compatible by + default. This flags sets the emulator in compatibility mode + with an earlier Erlang/OTP release . + The release number must be in the range + ]]>. This limits the emulator, + making it possible for it to communicate with Erlang nodes + (as well as C- and Java nodes) running that earlier release.

+

For example, an R10 node is not automatically compatible + with an R9 node, but R10 nodes started with the + flag can co-exist with R9 nodes in the same distributed + Erlang system, they are R9-compatible.

+

Note: Make sure all nodes (Erlang-, C-, and Java nodes) of + a distributed Erlang system is of the same Erlang/OTP release, + or from two different Erlang/OTP releases X and Y, where + all Y nodes have compatibility mode X.

+

For example: A distributed Erlang system can consist of + R10 nodes, or of R9 nodes and R9-compatible R10 nodes, but + not of R9 nodes, R9-compatible R10 nodes and "regular" R10 + nodes, as R9 and "regular" R10 nodes are not compatible.

+ + + +

Force ets memory block to be moved on realloc.

+ + + + +

Sets the amount of scheduler threads to create and scheduler + threads to set online when SMP support has been enabled. + Valid range for both values are 1-1024. If the + Erlang runtime system is able to determine the amount + of logical processors configured and logical processors available, + Schedulers will default to logical processors configured, + and SchedulersOnline will default to logical processors + available; otherwise, the default values will be 1. Schedulers + may be omitted if :SchedulerOnline is not and vice versa. The + amount of schedulers online can be changed at run time via + erlang:system_flag(schedulers_online, SchedulersOnline). +

+

This flag will be ignored if the emulator doesn't have + SMP support enabled (see the -smp + flag).

+ + + +

Scheduling specific flags.

+ + +sbt BindType + + +

Set scheduler bind type. Currently valid BindTypes: +

+ + u +

Same as + erlang:system_flag(scheduler_bind_type, unbound). +

+ ns +

Same as + erlang:system_flag(scheduler_bind_type, no_spread). +

+ ts +

Same as + erlang:system_flag(scheduler_bind_type, thread_spread). +

+ ps +

Same as + erlang:system_flag(scheduler_bind_type, processor_spread). +

+ s +

Same as + erlang:system_flag(scheduler_bind_type, spread). +

+ nnts +

Same as + erlang:system_flag(scheduler_bind_type, no_node_thread_spread). +

+ nnps +

Same as + erlang:system_flag(scheduler_bind_type, no_node_processor_spread). +

+ tnnps +

Same as + erlang:system_flag(scheduler_bind_type, thread_no_node_processor_spread). +

+ db +

Same as + erlang:system_flag(scheduler_bind_type, default_bind). +

+ +

Binding of schedulers are currently only supported on newer + Linux and Solaris systems.

+

If no CPU topology is available when the +sbt flag + is processed and BindType is any other type than + u, the runtime system will fail to start. CPU + topology can be defined using the + +sct flag. Note + that the +sct flag may have to be passed before the + +sbt flag on the command line (in case no CPU topology + has been automatically detected).

+

For more information, see + erlang:system_flag(scheduler_bind_type, SchedulerBindType). +

+ + +sct CpuTopology + + + + = integer(); when 0 =< =< 65535]]> + = -]]> + = | ]]> + = , | ]]> + = L]]> + = T | t]]> + = C | c]]> + = P | p]]> + = N | n]]> + = | ]]> + : | ]]> + +

Upper-case letters signify real identifiers and lower-case + letters signify fake identifiers only used for description + of the topology. Identifiers passed as real identifiers may + be used by the runtime system when trying to access specific + hardware and if they are not correct the behavior is + undefined. Faked logical CPU identifiers are not accepted + since there is no point in defining the CPU topology without + real logical CPU identifiers. Thread, core, processor, and + node identifiers may be left out. If left out, thread id + defaults to t0, core id defaults to c0, + processor id defaults to p0, and node id will + be left undefined. Either each logical processor must + belong to one and only one NUMA node, or no logical + processors must belong to any NUMA nodes. +

+

Both increasing and decreasing ]]>s + are allowed.

+

NUMA node identifiers are system wide. That is, each NUMA + node on the system have to have a unique identifier. Processor + identifiers are also system wide. Core identifiers are + processor wide. Thread identifiers are core wide.

+

The order of the identifier types imply the hierarchy of the + CPU topology. Valid orders are either + ]]>, + or + ]]>. + That is, thread is part of a core which is part of a processor + which is part of a NUMA node, or thread is part of a core which + is part of a NUMA node which is part of a processor. A cpu + topology can consist of both processor external, and processor + internal NUMA nodes as long as each logical processor belongs + to one and only one NUMA node. If ]]> + is left out, its default position will be before + ]]>. That is, the default is + processor external NUMA nodes. +

+

If a list of identifiers is used in an + ]]>:

+ + ]]> have to be a list + of identifiers. + At least one other identifier type apart from + ]]> also have to have a + list of identifiers. + All lists of identifiers have to produce the + same amount of identifiers. + +

A simple example. A single quad core processor may be + described this way:

+
+% erl +sct L0-3c0-3
+1> erlang:system_info(cpu_topology).
+[{processor,[{core,{logical,0}},
+             {core,{logical,1}},
+             {core,{logical,2}},
+             {core,{logical,3}}]}]
+
+

A little more complicated example. Two quad core + processors. Each processor in its own NUMA node. + The ordering of logical processors is a little weird. + This in order to give a better example of identifier + lists:

+
+% erl +sct L0-1,3-2c0-3p0N0:L7,4,6-5c0-3p1N1
+1> erlang:system_info(cpu_topology).
+[{node,[{processor,[{core,{logical,0}},
+                    {core,{logical,1}},
+                    {core,{logical,3}},
+                    {core,{logical,2}}]}]},
+ {node,[{processor,[{core,{logical,7}},
+                    {core,{logical,4}},
+                    {core,{logical,6}},
+                    {core,{logical,5}}]}]}]
+
+

As long as real identifiers are correct it is okay + to pass a CPU topology that is not a correct + description of the CPU topology. When used with + care this can actually be very useful. This in + order to trick the emulator to bind its schedulers + as you want. For example, if you want to run multiple + Erlang runtime systems on the same machine, you + want to reduce the amount of schedulers used and + manipulate the CPU topology so that they bind to + different logical CPUs. An example, with two Erlang + runtime systems on a quad core machine:

+
+% erl +sct L0-3c0-3 +sbt db +S3:2 -detached -noinput -noshell -sname one
+% erl +sct L3-0c0-3 +sbt db +S3:2 -detached -noinput -noshell -sname two
+
+

In this example each runtime system have two + schedulers each online, and all schedulers online + will run on different cores. If we change to one + scheduler online on one runtime system, and three + schedulers online on the other, all schedulers + online will still run on different cores.

+

Note that a faked CPU topology that does not reflect + how the real CPU topology looks like is likely to + decrease the performance of the runtime system.

+

For more information, see + erlang:system_flag(cpu_topology, CpuTopology).

+ + + + + + +

Suggested stack size, in kilowords, for scheduler threads. + Valid range is 4-8192 kilowords. The default stack size + is OS dependent.

+ + + + +

Enables modified timing and sets the modified timing level. + Currently valid range is 0-9. The timing of the runtime system + will change. A high level usually means a greater change than + a low level. Changing the timing can be very useful for finding + timing related bugs.

+

Currently, modified timing affects the following:

+ + Process spawning + +

A process calling , , + , or will be scheduled + out immediately after completing the call. When higher modified + timing levels are used, the caller will also sleep for a while + after being scheduled out.

+ + Context reductions + The amount of reductions a process is a allowed to + use before being scheduled out is increased or reduced. + Input reductions + The amount of reductions performed before checking I/O + is increased or reduced. + +

NOTE: Performance will suffer when modified timing + is enabled. This flag is only intended for testing and + debugging. Also note that and + trace messages will be lost when tracing on the spawn BIFs. This + flag may be removed or changed at any time without prior notice.

+ + + +

Makes the emulator print out its version number.

+ + + +

Verbose.

+ + + +

Sets the mapping of warning messages for . + Messages sent to the error logger using one of the warning + routines can be mapped either to errors (default), warnings + (), or info reports (). The current + mapping can be retrieved using + . See + error_logger(3) + for further information.

+ + +
+ +
+ + Environment variables + + + +

If the emulator needs to write a crash dump, the value of this + variable will be the file name of the crash dump file. + If the variable is not set, the name of the crash dump file will + be in the current directory.

+ + + +

Unix systems: If the emulator needs to write a crash dump, + it will use the value of this variable to set the nice value + for the process, thus lowering its priority. The allowable range is + 1 through 39 (higher values will be replaced with 39). The highest + value, 39, will give the process the lowest priority.

+ + + +

Unix systems: This variable gives the number of seconds that + the emulator will be allowed to spend writing a crash dump. When + the given number of seconds have elapsed, the emulator will be + terminated by a SIGALRM signal.

+ + + +

The content of this environment variable will be added to the + beginning of the command line for .

+

The flag is treated specially. Its scope ends + at the end of the environment variable content. Arguments + following an flag are moved on the command line into + the section, i.e. the end of the command line + following after an flag.

+ + and + +

The content of these environment variables will be added to the + end of the command line for .

+

The flag is treated specially. Its scope ends + at the end of the environment variable content. Arguments + following an flag are moved on the command line into + the section, i.e. the end of the command line + following after an flag.

+ + + +

This environment variable contains a list of additional library + directories that the code server will search for applications and + add to the code path. + See code(3).

+ + + +

This environment variable can contain the port number to use when + communicating with epmd. The default + port will work fine in most cases. A different port can be specified + to allow nodes of independent clusters to co-exist on the same host. + All nodes in a cluster must use the same epmd port number.

+ + +
+ +
+ SEE ALSO +

init(3), + erl_prim_loader(3), + erl_boot_server(3), + code(3), + application(3), + heart(3), + net_kernel(3), + auth(3), + make(3), + epmd(1), + erts_alloc(3)

+
+ + diff --git a/erts/doc/src/erl_dist_protocol.xml b/erts/doc/src/erl_dist_protocol.xml new file mode 100644 index 0000000000..9a203289e9 --- /dev/null +++ b/erts/doc/src/erl_dist_protocol.xml @@ -0,0 +1,802 @@ + + + + +
+ + 2007 + 2007 + Ericsson AB, All Rights Reserved + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + + + Distribution Protocol + + + 2007-09-21 + PA1 + erl_dist_protocol.xml +
+ +

+The description here is far from complete and will therefore be further +refined in upcoming releases. + +The protocols both from Erlang nodes towards +EPMD (Erlang Port Mapper Daemon) and between Erlang nodes, however, are +stable since many years. +

+ +

The distribution protocol can be divided into four (4) parts:

+ + +

+ 1. Low level socket connection. +

+ + + 2. Handshake, interchange node name and authenticate. + + + 3. Authentication (done by net_kernel). + + + 4. Connected. + + +

+ A node fetches the Port number of another node through the EPMD (at the + other host) in order to initiate a connection request. +

+

+For each host where a distributed Erlang node is running there should also +be an EPMD running. The EPMD can be started explicitly or automatically +as a result of the Erlang node startup. +

+

+By default EPMD listens on port 4369. +

+

+ 3 and 4 are performed at the same level but the net_kernel disconnects the + other node if it communicates using an invalid cookie (after one (1) second). +

+ +

The integers in all multi-byte fields are in big-endian order.

+ +
+ EPMD Protocol +

+ The requests served by the EPMD (Erlang Port Mapper Daemon) are + summarized in the figure below. +

+ + + + Summary of EPMD requests. + + +

+ Each request *_REQ is preceded by a two-byte length field. + Thus, the overall request format is: +

+ + + + 2 + n + + + Length + Request + +
+ +
+ Register a node in the EPMD +

+ When a distributed node is started it registers itself in EPMD. + The message ALIVE2_REQ described below is sent from the node towards + EPMD. The response from EPMD is ALIVE2_RESP. +

+ + + 1 + 2 + 1 + 1 + 2 + 2 + 2 + Nlen + 2 + Elen + + + 120 + PortNo + NodeType + Protocol + LowestVersion + HighestVersion + Nlen + NodeName + Elen + Extra + + ALIVE2_REQ (120)
+ + PortNo + + The port number on which the node accept connection requests. + + NodeType + + 77 = normal Erlang node, 72 = hidden node (C-node),... + + Protocol + + 0 = tcp/ip-v4, ... + + LowestVersion + + The lowest distribution version that this node can handle. + See the next field for possible values. + + HighestVersion + + The highest distribution version that this node can handle. + The value in R6B and later is 5. + + Nlen + + The length of the NodeName. + + NodeName + + The NodeName as a string of length Nlen. + + Elen + + The length of the Extra field. + + Extra + + Extra field of Elen bytes. + + +

+ The connection created to the EPMD must be kept as long as the + node is a distributed node. When the connection is closed + the node is automatically unregistered from the EPMD. +

+

+ The response message ALIVE2_RESP is described below. +

+ + + + 1 + 1 + 2 + + + 121 + Result + Creation + + ALIVE2_RESP (121)
+

+ Result = 0 -> ok, Result > 0 -> error +

+
+ +
+ Unregister a node from the EPMD +

+ A node unregister itself from the EPMD by simply closing the + TCP connection towards EPMD established when the node was registered. +

+
+ +
+ Get the distribution port of another node +

+ When one node wants to connect to another node it starts with + a PORT_PLEASE2_REQ request towards EPMD on the host where the + node resides in order to get the distribution port that the node + listens to. +

+ + + + 1 + N + + + 122 + NodeName + + PORT_PLEASE2_REQ (122)
+

+ where N = Length - 1 +

+ +

+

+ + + 1 + 1 + + + 119 + Result + + + PORT2_RESP (119) response indicating error, Result > 0. + +
+

Or

+ + + 1 + 1 + 2 + 1 + 1 + 2 + 2 + 2 + Nlen + 2 + Elen + + + 119 + Result + PortNo + NodeType + Protocol + HighestVersion + LowestVersion + Nlen + NodeName + Elen + Extra + + PORT2_RESP when Result = 0.
+

+If Result > 0, the packet only consists of [119, Result]. +

+ +

EPMD will close the socket as soon as it has sent the information.

+
+ +
+ Get all registered names from EPMD +

+ This request is used via the Erlang function + net_adm:names/1,2. A TCP connection is opened + towards EPMD and this request is sent. +

+ + + 1 + + + 110 + + NAMES_REQ (110)
+ + +

The response for a NAMES_REQ looks like this:

+ + + 4 +   + + + EPMDPortNo + NodeInfo* + + NAMES_RESP
+

+ NodeInfo is a string written for each active node. + When all NodeInfo has been written the connection is + closed by EPMD. +

+

+ NodeInfo is, as expressed in Erlang: +

+ + io:format("name ~s at port ~p~n", [NodeName, Port]). + +
+ + +
+ Dump all data from EPMD +

+ This request is not really used, it should be regarded as a debug + feature. +

+ + + 1 + + + 100 + + DUMP_REQ
+ +

The response for a DUMP_REQ looks like this:

+ + + 4 +   + + + EPMDPortNo + NodeInfo* + + DUMP_RESP
+

+ NodeInfo is a string written for each node kept in EPMD. + When all NodeInfo has been written the connection is + closed by EPMD. +

+

+ NodeInfo is, as expressed in Erlang: +

+ + io:format("active name ~s at port ~p, fd = ~p ~n", + [NodeName, Port, Fd]). + +

+ or +

+ + io:format("old/unused name ~s at port ~p, fd = ~p~n", + [NodeName, Port, Fd]). + + +
+ +
+ Kill the EPMD +

+ This request will kill the running EPMD. It is almost never used. +

+ + + 1 + + + 107 + + KILL_REQ
+ +

The response fo a KILL_REQ looks like this:

+ + + 2 + + + OKString + + KILL_RESP
+

+ where OKString is "OK". +

+
+ +
+ STOP_REQ (Not Used) +

+ + + 1 + n + + + 115 + NodeName + + STOP_REQ
+

+ where n = Length - 1 +

+

+ The current implementation of Erlang does not care if the connection + to the EPMD is broken. +

+

The response for a STOP_REQ looks like this.

+ + + 7 + + + OKString + + STOP_RESP
+

+ where OKString is "STOPPED". +

+

A negative response can look like this.

+ + + 7 + + + NOKString + + STOP_NOTOK_RESP
+

+ where NOKString is "NOEXIST". +

+
+ + +
+ +
+ Handshake +

+ The handshake is discussed in detail in the internal documentation for + the kernel (Erlang) application. +

+
+ +
+ + Protocol between connected nodes +

+ As of erts version 5.7.2 the runtime system passes a distribution + flag in the handshake stage that enables the use of a + distribution + header on all messages passed. Messages passed between + nodes are in this case on the following format: +

+ + + 4 + d + n + m + + + Length + DistributionHeader + ControlMessage + Message + +
+

+ where: +

+

+ Length is equal to d + n + m +

+

+ ControlMessage is a tuple passed using the external format of + Erlang. +

+

+ Message is the message sent to another node using the '!' + (in external format). Note that Message is only passed in + combination with a ControlMessage encoding a send ('!'). +

+

+ Also note that the + version number is omitted from the terms that follow a + distribution header. +

+

+ Nodes with an erts version less than 5.7.2 does not pass the + distribution flag that enables the distribution header. Messages + passed between nodes are in this case on the following format: +

+ + + 4 + 1 + n + m + + + Length + Type + ControlMessage + Message + +
+

+ where: +

+

+ Length is equal to 1 + n + m +

+

+ Type is: 112 (pass through) +

+

+ ControlMessage is a tuple passed using the external format of + Erlang. +

+

+ Message is the message sent to another node using the '!' + (in external format). Note that Message is only passed in + combination with a ControlMessage encoding a send ('!'). +

+

+ The ControlMessage is a tuple, where the first element + indicates which distributed operation it encodes. +

+ + LINK + +

+ {1, FromPid, ToPid} +

+ + + SEND + +

+ {2, Cookie, ToPid} +

+

+ Note followed by Message +

+ + + EXIT + +

+ {3, FromPid, ToPid, Reason} +

+ + + UNLINK + +

+ {4, FromPid, ToPid} +

+ + + NODE_LINK + +

+ {5} +

+ + + REG_SEND + +

+ {6, FromPid, Cookie, ToName} +

+

+ Note followed by Message +

+ + + GROUP_LEADER + +

+ {7, FromPid, ToPid} +

+ + + EXIT2 + +

+ {8, FromPid, ToPid, Reason} +

+ + +
+ + +
+ New Ctrlmessages for distrvsn = 1 (OTP R4) + + SEND_TT + +

+ {12, Cookie, ToPid, TraceToken} +

+

+ Note followed by Message +

+ + + EXIT_TT + +

+ {13, FromPid, ToPid, TraceToken, Reason} +

+ + + REG_SEND_TT + +

+ {16, FromPid, Cookie, ToName, TraceToken} +

+

+ Note followed by Message +

+ + + EXIT2_TT + +

+ {18, FromPid, ToPid, TraceToken, Reason} +

+ + +
+ +
+ New Ctrlmessages for distrvsn = 2 +

+ distrvsn 2 was never used. +

+
+ +
+ New Ctrlmessages for distrvsn = 3 (OTP R5C) +

+ None, but the version number was increased anyway. +

+
+ +
+ New Ctrlmessages for distrvsn = 4 (OTP R6) +

+ These are only recognized by Erlang nodes, not by hidden nodes. +

+ + MONITOR_P + +

+ {19, FromPid, ToProc, Ref} + + FromPid = monitoring process + ToProc = monitored process pid or name (atom) +

+ + + DEMONITOR_P + +

+ {20, FromPid, ToProc, Ref} + We include the FromPid just in case we want to trace this. + + FromPid = monitoring process + ToProc = monitored process pid or name (atom) +

+ + + MONITOR_P_EXIT + +

+ {21, FromProc, ToPid, Ref, Reason} + + FromProc = monitored process pid or name (atom) + ToPid = monitoring process + Reason = exit reason for the monitored process +

+ + +
+ diff --git a/erts/doc/src/erl_driver.xml b/erts/doc/src/erl_driver.xml new file mode 100644 index 0000000000..0b11f4bbcb --- /dev/null +++ b/erts/doc/src/erl_driver.xml @@ -0,0 +1,2465 @@ + + + + +
+ + 20012009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erl_driver + Jakob Cederlund + Jakob Cederlund + 1 + + + 2000-11-27 + PA1 + erl_driver.xml +
+ erl_driver + API functions for an Erlang driver + +

As of erts version 5.5.3 the driver interface has been extended + (see extended marker). + The extended interface introduce + version management, + the possibility to pass capability flags + (see driver flags) + to the runtime system at driver initialization, and some new + driver API functions.

+ +

Old drivers (compiled with an erl_driver.h from an + earlier erts version than 5.5.3) have to be recompiled + (but does not have to use the extended interface).

+ +

The driver calls back to the emulator, using the API + functions declared in erl_driver.h. They are used for + outputting data from the driver, using timers, etc.

+

A driver is a library with a set of function that the emulator + calls, in response to Erlang functions and message + sending. There may be multiple instances of a driver, each + instance is connected to an Erlang port. Every port has a port + owner process. Communication with the port is normally done + through the port owner process.

+

Most of the functions takes the port handle as an + argument. This identifies the driver instance. Note that this + port handle must be stored by the driver, it is not given when + the driver is called from the emulator (see + driver_entry).

+

Some of the functions takes a parameter of type + ErlDrvBinary, a driver binary. It should be both + allocated and freed by the caller. Using a binary directly avoid + one extra copying of data.

+

Many of the output functions has a "header buffer", with + hbuf and hlen parameters. This buffer is sent as a + list before the binary (or list, depending on port mode) that is + sent. This is convenient when matching on messages received from + the port. (Although in the latest versions of Erlang, there is + the binary syntax, that enables you to match on the beginning of + a binary.) + +

+

In the runtime system with SMP support, drivers are locked either + on driver level or port level (driver instance level). By default + driver level locking will be used, i.e., only one emulator thread + will execute code in the driver at a time. If port level locking + is used, multiple emulator threads may execute code in the driver + at the same time. There will only be one thread at a time calling + driver call-backs corresponding to the same port, though. In order + to enable port level locking set the ERL_DRV_FLAG_USE_PORT_LOCKING + driver flag in + the driver_entry + used by the driver. When port level locking is used it is the + responsibility of the driver writer to synchronize all accesses + to data shared by the ports (driver instances).

+

Most drivers written before the runtime system with SMP + support existed will be able to run in the runtime system + with SMP support without being rewritten if driver + level locking is used.

+ +

It is assumed that drivers does not access other drivers. If + drivers should access each other they have to provide their own + mechanism for thread safe synchronization. Such "inter driver + communication" is strongly discouraged.

+ +

Previously, in the runtime system without SMP support, + specific driver call-backs were always called from the same + thread. This is not the case in the runtime system + with SMP support. Regardless of locking scheme used, calls + to driver call-backs may be made from different threads, e.g., + two consecutive calls to exactly the same call-back for exactly + the same port may be made from two different threads. This + will for most drivers not be a problem, but it might. + Drivers that depend on all call-backs being called in the + same thread, have to be rewritten before being used + in the runtime system with SMP support.

+ +

Regardless of locking scheme used, calls to driver + call-backs may be made from different threads.

+ +

Most functions in this API are not thread-safe, i.e., + they may not be called from an arbitrary thread. Function + that are not documented as thread-safe may only be called from + driver call-backs or function calls descending from a driver + call-back call. Note that driver call-backs may be called from + different threads. This, however, is not a problem for any + functions in this API, since the emulator have control over + these threads.

+ +

Functions not explicitly documented as thread-safe are + not thread-safe. Also note that some functions + are only thread safe when used in a runtime + system with SMP support.

+ + + +
+ FUNCTIONALITY +

All functions that a driver needs to do with Erlang are + performed through driver API functions. There are functions + for the following functionality:

+ + Timer functions + Timer functions are used to control the timer that a driver + may use. The timer will have the emulator call the + timeout entry + function after a specified time. Only one timer is available + for each driver instance. + Queue handling + +

Every driver instance has an associated queue. This queue is a + SysIOVec that works as a buffer. It's mostly used for + the driver to buffer data that should be written to a device, + it is a byte stream. If the port owner process closes the + driver, and the queue is not empty, the driver will not be + closed. This enables the driver to flush its buffers before + closing.

+

The queue can be manipulated from arbitrary threads if + a port data lock is used. See documentation of the + ErlDrvPDL type for + more information.

+ + Output functions + With the output functions, the driver sends data back + the emulator. They will be received as messages by the port owner + process, see open_port/2. The vector function and the + function taking a driver binary is faster, because that avoid + copying the data buffer. There is also a fast way of sending + terms from the driver, without going through the binary term + format. + Failure + The driver can exit and signal errors up to Erlang. This is + only for severe errors, when the driver can't possibly keep + open. + Asynchronous calls + The latest Erlang versions (R7B and later) has provision for + asynchronous function calls, using a thread pool provided by + Erlang. There is also a select call, that can be used for + asynchronous drivers. + Multi-threading + +

A POSIX thread like API for multi-threading is provided. The + Erlang driver thread API only provide a subset of the functionality + provided by the POSIX thread API. The subset provided is + more or less the basic functionality needed for multi-threaded + programming: +

+ + Threads + Mutexes + Condition variables + Read/Write locks + Thread specific data + +

The Erlang driver thread API can be used in conjunction with + the POSIX thread API on UN-ices and with the Windows native thread + API on Windows. The Erlang driver thread API has the advantage of + being portable, but there might exist situations where you want to + use functionality from the POSIX thread API or the Windows + native thread API. +

+

The Erlang driver thread API only return error codes when it is + reasonable to recover from an error condition. If it isn't reasonable + to recover from an error condition, the whole runtime system is + terminated. For example, if a create mutex operation fails, an error + code is returned, but if a lock operation on a mutex fails, the + whole runtime system is terminated. +

+

Note that there exist no "condition variable wait with timeout" in + the Erlang driver thread API. This is due to issues with + pthread_cond_timedwait(). When the system clock suddenly + is changed, it isn't always guaranteed that you will wake up from + the call as expected. An Erlang runtime system has to be able to + cope with sudden changes of the system clock. Therefore, we have + omitted it from the Erlang driver thread API. In the Erlang driver + case, timeouts can and should be handled with the timer functionality + of the Erlang driver API. +

+

In order for the Erlang driver thread API to function, thread + support has to be enabled in the runtime system. An Erlang driver + can check if thread support is enabled by use of + driver_system_info(). + Note that some functions in the Erlang driver API are thread-safe + only when the runtime system has SMP support, also this + information can be retrieved via + driver_system_info(). + Also note that a lot of functions in the Erlang driver API are + not thread-safe regardless of whether SMP support is + enabled or not. If a function isn't documented as thread-safe it + is not thread-safe. +

+

NOTE: When executing in an emulator thread, it is + very important that you unlock all locks you + have locked before letting the thread out of your control; + otherwise, you are very likely to deadlock the whole + emulator. If you need to use thread specific data in an emulator + thread, only have the thread specific data set while the thread is + under your control, and clear the thread specific data before + you let the thread out of your control. +

+

In the future there will probably be debug functionality + integrated with the Erlang driver thread API. All functions + that create entities take a name argument. Currently + the name argument is unused, but it will be used when + the debug functionality has been implemented. If you name all + entities created well, the debug functionality will be able + to give you better error reports. +

+ + Adding / remove drivers + A driver can add and later remove drivers. + Monitoring processes + A driver can monitor a process that does not own a port. + Version management + + +

Version management is enabled for drivers that have set the + extended_marker + field of their + driver_entry + to ERL_DRV_EXTENDED_MARKER. erl_driver.h defines + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, and + ERL_DRV_EXTENDED_MINOR_VERSION. + ERL_DRV_EXTENDED_MAJOR_VERSION will be incremented when + driver incompatible changes are made to the Erlang runtime + system. Normally it will suffice to recompile drivers when the + ERL_DRV_EXTENDED_MAJOR_VERSION has changed, but it + could, under rare circumstances, mean that drivers have to + be slightly modified. If so, this will of course be documented. + ERL_DRV_EXTENDED_MINOR_VERSION will be incremented when + new features are added. The runtime system use the minor version + of the driver to determine what features to use. + The runtime system will refuse to load a driver if the major + versions differ, or if the major versions are equal and the + minor version used by the driver is greater than the one used + by the runtime system.

+

The emulator tries to check that a driver that doesn't use the + extended driver interface isn't incompatible when loading it. + It can, however, not make sure that it isn't incompatible. Therefore, + when loading a driver that doesn't use the extended driver + interface, there is a risk that it will be loaded also when + the driver is incompatible. When the driver use the extended driver + interface, the emulator can verify that it isn't of an incompatible + driver version. You are therefore advised to use the extended driver + interface.

+ + +
+ +
+ DATA TYPES + + + ErlDrvSysInfo + +

+ +typedef struct ErlDrvSysInfo { + int driver_major_version; + int driver_minor_version; + char *erts_version; + char *otp_release; + int thread_support; + int smp_support; + int async_threads; + int scheduler_threads; +} ErlDrvSysInfo; + + +

+ The ErlDrvSysInfo structure is used for storage of + information about the Erlang runtime system. + driver_system_info() + will write the system information when passed a reference to + a ErlDrvSysInfo structure. A description of the + fields in the structure follow: +

+ + driver_major_version + The value of + ERL_DRV_EXTENDED_MAJOR_VERSION + when the runtime system was compiled. This value is the same + as the value of + ERL_DRV_EXTENDED_MAJOR_VERSION + used when compiling the driver; otherwise, the runtime system + would have refused to load the driver. + + driver_minor_version + The value of + ERL_DRV_EXTENDED_MINOR_VERSION + when the runtime system was compiled. This value might differ + from the value of + ERL_DRV_EXTENDED_MINOR_VERSION + used when compiling the driver. + + erts_version + A string containing the version number of the runtime system + (the same as returned by + erlang:system_info(version)). + + otp_release + A string containing the OTP release number + (the same as returned by + erlang:system_info(otp_release)). + + thread_support + A value != 0 if the runtime system has thread support; + otherwise, 0. + + smp_support + A value != 0 if the runtime system has SMP support; + otherwise, 0. + + thread_support + A value != 0 if the runtime system has thread support; + otherwise, 0. + + smp_support + A value != 0 if the runtime system has SMP support; + otherwise, 0. + + async_threads + The number of async threads in the async thread pool used + by driver_async() + (the same as returned by + erlang:system_info(thread_pool_size)). + + scheduler_threads + The number of scheduler threads used by the runtime system + (the same as returned by + erlang:system_info(schedulers)). + + + + + ErlDrvBinary + +

+ +typedef struct ErlDrvBinary { + int orig_size; + char orig_bytes[]; +} ErlDrvBinary; + +

The ErlDrvBinary structure is a binary, as sent + between the emulator and the driver. All binaries are + reference counted; when driver_binary_free is called, + the reference count is decremented, when it reaches zero, + the binary is deallocated. The orig_size is the size + of the binary, and orig_bytes is the buffer. The + ErlDrvBinary does not have a fixed size, its size is + orig_size + 2 * sizeof(int).

+ +

The refc field has been removed. The reference count of + an ErlDrvBinary is now stored elsewhere. The + reference count of an ErlDrvBinary can be accessed via + driver_binary_get_refc(), + driver_binary_inc_refc(), + and + driver_binary_dec_refc().

+ +

Some driver calls, such as driver_enq_binary, + increments the driver reference count, and others, such as + driver_deq decrements it.

+

Using a driver binary instead of a normal buffer, is often + faster, since the emulator doesn't need to copy the data, + only the pointer is used.

+

A driver binary allocated in the driver, with + driver_alloc_binary, should be freed in the driver (unless otherwise stated), + with driver_free_binary. (Note that this doesn't + necessarily deallocate it, if the driver is still referred + in the emulator, the ref-count will not go to zero.)

+

Driver binaries are used in the driver_output2 and + driver_outputv calls, and in the queue. Also the + driver call-back outputv uses driver + binaries.

+

If the driver of some reason or another, wants to keep a + driver binary around, in a static variable for instance, the + reference count should be incremented, + and the binary can later be freed in the stop call-back, with + driver_free_binary.

+

Note that since a driver binary is shared by the driver and + the emulator, a binary received from the emulator or sent to + the emulator, must not be changed by the driver.

+

From erts version 5.5 (OTP release R11B), orig_bytes is + guaranteed to be properly aligned for storage of an array of + doubles (usually 8-byte aligned).

+ + ErlDrvData + +

The ErlDrvData is a handle to driver-specific data, + passed to the driver call-backs. It is a pointer, and is + most often casted to a specific pointer in the driver.

+ + SysIOVec + +

This is a system I/O vector, as used by writev on + unix and WSASend on Win32. It is used in + ErlIOVec.

+ + ErlIOVec + +

+ +typedef struct ErlIOVec { + int vsize; + int size; + SysIOVec* iov; + >ErlDrvBinary** binv; +} ErlIOVec; + +

The I/O vector used by the emulator and drivers, is a list + of binaries, with a SysIOVec pointing to the buffers + of the binaries. It is used in driver_outputv and the + outputv + driver call-back. Also, the driver queue is an + ErlIOVec.

+ + + ErlDrvMonitor + +

When a driver creates a monitor for a process, a + ErlDrvMonitor is filled in. This is an opaque + data-type which can be assigned to but not compared without + using the supplied compare function (i.e. it behaves like a struct).

+

The driver writer should provide the memory for storing the + monitor when calling driver_monitor_process. The + address of the data is not stored outside of the driver, so + the ErlDrvMonitor can be used as any other datum, it + can be copied, moved in memory, forgotten etc.

+ + ErlDrvNowData + +

The ErlDrvNowData structure holds a timestamp + consisting of three values measured from some arbitrary + point in the past. The three structure members are:

+ + megasecs + The number of whole megaseconds elapsed since the arbitrary + point in time + secs + The number of whole seconds elapsed since the arbitrary + point in time + microsecs + The number of whole microseconds elapsed since the arbitrary + point in time + + + ErlDrvPDL + +

If certain port specific data have to be accessed from other + threads than those calling the driver call-backs, a port data lock + can be used in order to synchronize the operations on the data. + Currently, the only port specific data that the emulator + associates with the port data lock is the driver queue.

+

Normally a driver instance does not have a port data lock. If + the driver instance want to use a port data lock, it has to + create the port data lock by calling + driver_pdl_create(). + NOTE: Once the port data lock has been created, every + access to data associated with the port data lock have to be done + while having the port data lock locked. The port data lock is + locked, and unlocked, respectively, by use of + driver_pdl_lock(), and + driver_pdl_unlock().

+

A port data lock is reference counted, and when the reference + count reach zero, it will be destroyed. The emulator will at + least increment the reference count once when the lock is + created and decrement it once when the port associated with + the lock terminates. The emulator will also increment the + reference count when an async job is enqueued and decrement + it after an async job has been invoked, or canceled. Besides + this, it is the responsibility of the driver to ensure that + the reference count does not reach zero before the last use + of the lock by the driver has been made. The reference count + can be read, incremented, and decremented, respectively, by + use of + driver_pdl_get_refc(), + driver_pdl_inc_refc(), and + driver_pdl_dec_refc().

+ + + ErlDrvTid + +

Thread identifier.

+

See also: + erl_drv_thread_create(), + erl_drv_thread_exit(), + erl_drv_thread_join(), + erl_drv_thread_self(), + and + erl_drv_equal_tids(). +

+ + ErlDrvThreadOpts + +

+ + int suggested_stack_size; + +

Thread options structure passed to + erl_drv_thread_create(). + Currently the following fields exist: +

+ + suggested_stack_size + A suggestion, in kilo-words, on how large stack to use. A value less + than zero means default size. + + +

See also: + erl_drv_thread_opts_create(), + erl_drv_thread_opts_destroy(), + and + erl_drv_thread_create(). +

+ + + ErlDrvMutex + +

Mutual exclusion lock. Used for synchronizing access to shared data. + Only one thread at a time can lock a mutex. +

+

See also: + erl_drv_mutex_create(), + erl_drv_mutex_destroy(), + erl_drv_mutex_lock(), + erl_drv_mutex_trylock(), + and + erl_drv_mutex_unlock(). +

+ + ErlDrvCond + +

Condition variable. Used when threads need to wait for a specific + condition to appear before continuing execution. Condition variables + need to be used with associated mutexes. +

+

See also: + erl_drv_cond_create(), + erl_drv_cond_destroy(), + erl_drv_cond_signal(), + erl_drv_cond_broadcast(), + and + erl_drv_cond_wait(). +

+ + ErlDrvRWLock + +

Read/write lock. Used to allow multiple threads to read shared data + while only allowing one thread to write the same data. Multiple threads + can read lock an rwlock at the same time, while only one thread can + read/write lock an rwlock at a time. +

+

See also: + erl_drv_rwlock_create(), + erl_drv_rwlock_destroy(), + erl_drv_rwlock_rlock(), + erl_drv_rwlock_tryrlock(), + erl_drv_rwlock_runlock(), + erl_drv_rwlock_rwlock(), + erl_drv_rwlock_tryrwlock(), + and + erl_drv_rwlock_rwunlock(). +

+ + ErlDrvTSDKey + +

Key which thread specific data can be associated with.

+

See also: + erl_drv_tsd_key_create(), + erl_drv_tsd_key_destroy(), + erl_drv_tsd_set(), + and + erl_drv_tsd_get(). +

+ + +
+ + + + voiddriver_system_info(ErlDrvSysInfo *sys_info_ptr, size_t size) + Get information about the Erlang runtime system + + +

This function will write information about the Erlang runtime + system into the + ErlDrvSysInfo + structure referred to by the first argument. The second + argument should be the size of the + ErlDrvSysInfo + structure, i.e., sizeof(ErlDrvSysInfo).

+

See the documentation of the + ErlDrvSysInfo + structure for information about specific fields.

+ + + + intdriver_output(ErlDrvPort port, char *buf, int len) + Send data from driver to port owner + + +

The driver_output function is used to send data from + the driver up to the emulator. The data will be received as + terms or binary data, depending on how the driver port was + opened.

+

The data is queued in the port owner process' message + queue. Note that this does not yield to the emulator. (Since + the driver and the emulator runs in the same thread.)

+

The parameter buf points to the data to send, and + len is the number of bytes.

+

The return value for all output functions is 0. (Unless the + driver is used for distribution, in which case it can fail + and return -1. For normal use, the output function always + returns 0.)

+ + + + intdriver_output2(ErlDrvPort port, char *hbuf, int hlen, char *buf, int len) + Send data and binary data to port owner + + +

The driver_output2 function first sends hbuf + (length in hlen) data as a list, regardless of port + settings. Then buf is sent as a binary or list. + E.g. if hlen is 3 then the port owner process will + receive [H1, H2, H3 | T].

+

The point of sending data as a list header, is to facilitate + matching on the data received.

+

The return value is 0 for normal use.

+ + + + intdriver_output_binary(ErlDrvPort port, char *hbuf, int hlen, ErlDrvBinary* bin, int offset, int len) + Send data from a driver binary to port owner + + +

This function sends data to port owner process from a + driver binary, it has a header buffer (hbuf + and hlen) just like driver_output2. The + hbuf parameter can be NULL.

+

The parameter offset is an offset into the binary and + len is the number of bytes to send.

+

Driver binaries are created with driver_alloc_binary.

+

The data in the header is sent as a list and the binary as + an Erlang binary in the tail of the list.

+

E.g. if hlen is 2, then the port owner process will + receive >]]]>.

+

The return value is 0 for normal use.

+

Note that, using the binary syntax in Erlang, the driver + application can match the header directly from the binary, + so the header can be put in the binary, and hlen can be set + to 0.

+ + + + intdriver_outputv(ErlDrvPort port, char* hbuf, int hlen, ErlIOVec *ev, int skip) + Send vectorized data to port owner + + +

This function sends data from an IO vector, ev, to + the port owner process. It has a header buffer (hbuf + and hlen), just like driver_output2.

+

The skip parameter is a number of bytes to skip of + the ev vector from the head.

+

You get vectors of ErlIOVec type from the driver + queue (see below), and the outputv driver entry + function. You can also make them yourself, if you want to + send several ErlDrvBinary buffers at once. Often + it is faster to use driver_output or + driver_output_binary.

+

E.g. if hlen is 2 and ev points to an array of + three binaries, the port owner process will receive >, <> | <>]]]>.

+

The return value is 0 for normal use.

+

The comment for driver_output_binary applies for + driver_outputv too.

+ + + + intdriver_vec_to_buf(ErlIOVec *ev, char *buf, int len) + Collect data segments into a buffer + + +

This function collects several segments of data, referenced + by ev, by copying them in order to the buffer + buf, of the size len.

+

If the data is to be sent from the driver to the port owner + process, it is faster to use driver_outputv.

+

The return value is the space left in the buffer, i.e. if + the ev contains less than len bytes it's the + difference, and if ev contains len bytes or + more, it's 0. This is faster if there is more than one header byte, + since the binary syntax can construct integers directly from + the binary.

+ + + + intdriver_set_timer(ErlDrvPort port, unsigned long time) + Set a timer to call the driver + + +

This function sets a timer on the driver, which will count + down and call the driver when it is timed out. The + time parameter is the time in milliseconds before the + timer expires.

+

When the timer reaches 0 and expires, the driver entry + function timeout is called.

+

Note that there is only one timer on each driver instance; + setting a new timer will replace an older one.

+

Return value i 0 (-1 only when the timeout driver + function is NULL).

+ + + + intdriver_cancel_timer(ErlDrvPort port) + Cancel a previously set timer + + +

This function cancels a timer set with + driver_set_timer.

+

The return value is 0.

+ + + + intdriver_read_timer(ErlDrvPort port, unsigned long *time_left) + Read the time left before timeout + + +

This function reads the current time of a timer, and places + the result in time_left. This is the time in + milliseconds, before the timeout will occur.

+

The return value is 0.

+ + + + intdriver_get_now(ErlDrvNowData *now) + Read a system timestamp + + +

This function reads a timestamp into the memory pointed to by + the parameter now. See the description of ErlDrvNowData for + specification of it's fields.

+

The return value is 0 unless the now pointer is not + valid, in which case it is < 0.

+ + + + intdriver_select(ErlDrvPort port, ErlDrvEvent event, int mode, int on) + Provide an event for having the emulator call the driver + + +

This function is used by drivers to provide the emulator with + events to check for. This enables the emulator to call the driver + when something has happened asynchronously.

+

The event argument identifies an OS-specific event object. + On Unix systems, the functions select/poll are used. The + event object must be a socket or pipe (or other object that + select/poll can use). + On windows, the Win32 API function WaitForMultipleObjects + is used. This places other restriction on the event object. + Refer to the Win32 SDK documentation.

+

The on parameter should be 1 for setting events + and 0 for clearing them.

+

The mode argument is bitwise-or combination of + ERL_DRV_READ, ERL_DRV_WRITE and ERL_DRV_USE. + The first two specifies whether to wait for read events and/or write + events. A fired read event will call + ready_input + while a fired write event will call + ready_output. +

+ +

Some OS (Windows) does not differ between read and write events. + The call-back for a fired event then only depends on the value of mode.

+ +

ERL_DRV_USE specifies if we are using the event object or if we want to close it. + On an emulator with SMP support, it is not safe to clear all events + and then close the event object after driver_select has + returned. Another thread may still be using the event object + internally. To safely close an event object call + driver_select with ERL_DRV_USE and on==0. That + will clear all events and then call + stop_select + when it is safe to close the event object. + ERL_DRV_USE should be set together with the first event + for an event object. It is harmless to set ERL_DRV_USE + even though it already has been done. Clearing all events but keeping + ERL_DRV_USE set will indicate that we are using the event + object and probably will set events for it again.

+ +

ERL_DRV_USE was added in OTP release R13. Old drivers will still work + as before. But it is recommended to update them to use ERL_DRV_USE and + stop_select to make sure that event objects are closed in a safe way.

+ +

The return value is 0 (Failure, -1, only if the + ready_input/ready_output is + NULL.

+ + + + void *driver_alloc(size_t size) + Allocate memory + + +

This function allocates a memory block of the size specified + in size, and returns it. This only fails on out of + memory, in that case NULL is returned. (This is most + often a wrapper for malloc).

+

Memory allocated must be explicitly freed with a corresponding + call to driver_free (unless otherwise stated).

+

This function is thread-safe.

+ + + + void *driver_realloc(void *ptr, size_t size) + Resize an allocated memory block + + +

This function resizes a memory block, either in place, or by + allocating a new block, copying the data and freeing the old + block. A pointer is returned to the reallocated memory. On + failure (out of memory), NULL is returned. (This is + most often a wrapper for realloc.)

+

This function is thread-safe.

+ + + + voiddriver_free(void *ptr) + Free an allocated memory block + + +

This function frees the memory pointed to by ptr. The + memory should have been allocated with + driver_alloc. All allocated memory should be + deallocated, just once. There is no garbage collection in + drivers.

+

This function is thread-safe.

+ + + + ErlDrvBinary*driver_alloc_binary(int size) + Allocate a driver binary + + +

This function allocates a driver binary with a memory block + of at least size bytes, and returns a pointer to it, + or NULL on failure (out of memory). When a driver binary has + been sent to the emulator, it must not be altered. Every + allocated binary should be freed by a corresponding call to + driver_free_binary (unless otherwise stated).

+

Note that a driver binary has an internal reference counter, + this means that calling driver_free_binary it may not + actually dispose of it. If it's sent to the emulator, it may + be referenced there.

+

The driver binary has a field, orig_bytes, which + marks the start of the data in the binary.

+

This function is thread-safe.

+ + + + ErlDrvBinary*driver_realloc_binary(ErlDrvBinary *bin, int size) + Resize a driver binary + + +

This function resizes a driver binary, while keeping the + data. The resized driver binary is returned. On failure (out + of memory), NULL is returned.

+

This function is only thread-safe when the emulator with SMP + support is used.

+ + + + voiddriver_free_binary(ErlDrvBinary *bin) + Free a driver binary + + +

This function frees a driver binary bin, allocated + previously with driver_alloc_binary. Since binaries + in Erlang are reference counted, the binary may still be + around.

+

This function is only thread-safe when the emulator with SMP + support is used.

+ + + + longdriver_binary_get_refc(ErlDrvBinary *bin) + Get the reference count of a driver binary + + +

Returns current reference count on bin.

+

This function is only thread-safe when the emulator with SMP + support is used.

+ + + + longdriver_binary_inc_refc(ErlDrvBinary *bin) + Increment the reference count of a driver binary + + +

Increments the reference count on bin and returns + the reference count reached after the increment.

+

This function is only thread-safe when the emulator with SMP + support is used.

+ + + + longdriver_binary_dec_refc(ErlDrvBinary *bin) + Decrement the reference count of a driver binary + + +

Decrements the reference count on bin and returns + the reference count reached after the decrement.

+

This function is only thread-safe when the emulator with SMP + support is used.

+ +

You should normally decrement the reference count of a + driver binary by calling + driver_free_binary(). + driver_binary_dec_refc() does not free + the binary if the reference count reaches zero. Only + use driver_binary_dec_refc() when you are sure + not to reach a reference count of zero.

+ + + + + intdriver_enq(ErlDrvPort port, char* buf, int len) + Enqueue data in the driver queue + + +

This function enqueues data in the driver queue. The data in + buf is copied (len bytes) and placed at the + end of the driver queue. The driver queue is normally used + in a FIFO way.

+

The driver queue is available to queue output from the + emulator to the driver (data from the driver to the emulator + is queued by the emulator in normal erlang message + queues). This can be useful if the driver has to wait for + slow devices etc, and wants to yield back to the + emulator. The driver queue is implemented as an ErlIOVec.

+

When the queue contains data, the driver won't close, until + the queue is empty.

+

The return value is 0.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+ + + + intdriver_pushq(ErlDrvPort port, char* buf, int len) + Push data at the head of the driver queue + + +

This function puts data at the head of the driver queue. The + data in buf is copied (len bytes) and placed + at the beginning of the queue.

+

The return value is 0.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+ + + + intdriver_deq(ErlDrvPort port, int size) + Dequeue data from the head of the driver queue + + +

This function dequeues data by moving the head pointer + forward in the driver queue by size bytes. The data + in the queue will be deallocated.

+

The return value is the number of bytes remaining in the queue + or -1 on failure.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+ + + + intdriver_sizeq(ErlDrvPort port) + Return the size of the driver queue + + +

This function returns the number of bytes currently in the + driver queue.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+ + + + intdriver_enq_bin(ErlDrvPort port, ErlDrvBinary *bin, int offset, int len) + Enqueue binary in the driver queue + + +

This function enqueues a driver binary in the driver + queue. The data in bin at offset with length + len is placed at the end of the queue. This function + is most often faster than driver_enq, because the + data doesn't have to be copied.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+

The return value is 0.

+ + + + intdriver_pushq_bin(ErlDrvPort port, ErlDrvBinary *bin, int offset, int len) + Push binary at the head of the driver queue + + +

This function puts data in the binary bin, at + offset with length len at the head of the + driver queue. It is most often faster than + driver_pushq, because the data doesn't have to be + copied.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+

The return value is 0.

+ + + + SysIOVec*driver_peekq(ErlDrvPort port, int *vlen) + Get the driver queue as a vector + + +

This function retrieves the driver queue as a pointer to an + array of SysIOVecs. It also returns the number of + elements in vlen. This is the only way to get data + out of the queue.

+

Nothing is remove from the queue by this function, that must be done + with driver_deq.

+

The returned array is suitable to use with the Unix system + call writev.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+ + + + intdriver_enqv(ErlDrvPort port, ErlIOVec *ev, int skip) + Enqueue vector in the driver queue + + +

This function enqueues the data in ev, skipping the + first skip bytes of it, at the end of the driver + queue. It is faster than driver_enq, because the data + doesn't have to be copied.

+

The return value is 0.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+ + + + intdriver_pushqv(ErlDrvPort port, ErlIOVec *ev, int skip) + Push vector at the head of the driver queue + + +

This function puts the data in ev, skipping the first + skip bytes of it, at the head of the driver queue. + It is faster than driver_pushq, because the data + doesn't have to be copied.

+

The return value is 0.

+

This function can be called from an arbitrary thread if a + port data lock + associated with the port is locked by the calling + thread during the call.

+ + + + ErlDrvPDLdriver_pdl_create(ErlDrvPort port) + Create a port data lock + + +

This function creates a port data lock associated with + the port. NOTE: Once a port data lock has + been created, it has to be locked during all operations + on the driver queue of the port.

+

On success a newly created port data lock is returned. On + failure NULL is returned. driver_pdl_create() will + fail if port is invalid or if a port data lock already has + been associated with the port.

+ + + + voiddriver_pdl_lock(ErlDrvPDL pdl) + Lock port data lock + + +

This function locks the port data lock passed as argument + (pdl).

+

This function is thread-safe.

+ + + + voiddriver_pdl_unlock(ErlDrvPDL pdl) + Unlock port data lock + + +

This function unlocks the port data lock passed as argument + (pdl).

+

This function is thread-safe.

+ + + + longdriver_pdl_get_refc(ErlDrvPDL pdl) + + + +

This function returns the current reference count of + the port data lock passed as argument (pdl).

+

This function is thread-safe.

+ + + + longdriver_pdl_inc_refc(ErlDrvPDL pdl) + + + +

This function increments the reference count of + the port data lock passed as argument (pdl).

+

The current reference count after the increment has + been performed is returned.

+

This function is thread-safe.

+ + + + longdriver_pdl_dec_refc(ErlDrvPDL pdl) + + + +

This function decrements the reference count of + the port data lock passed as argument (pdl).

+

The current reference count after the decrement has + been performed is returned.

+

This function is thread-safe.

+ + + + intdriver_monitor_process(ErlDrvPort port, ErlDrvTermData process, ErlDrvMonitor *monitor) + Monitor a process from a driver + + +

Start monitoring a process from a driver. When a process is + monitored, a process exit will result in a call to the + provided process_exit call-back + in the ErlDrvEntry + structure. The ErlDrvMonitor structure is filled in, for later + removal or compare.

+

The process parameter should be the return value of an + earlier call to driver_caller or driver_connected call.

+

The function returns 0 on success, < 0 if no call-back is + provided and > 0 if the process is no longer alive.

+ + + + intdriver_demonitor_process(ErlDrvPort port, const ErlDrvMonitor *monitor) + Stop monitoring a process from a driver + + +

This function cancels an monitor created earlier.

+

The function returns 0 if a monitor was removed and > 0 + if the monitor did no longer exist.

+ + + + ErlDrvTermDatadriver_get_monitored_process(ErlDrvPort port, const ErlDrvMonitor *monitor) + Retrieve the process id from a monitor + + +

The function returns the process id associated with a living + monitor. It can be used in the process_exit call-back to + get the process identification for the exiting process.

+

The function returns driver_term_nil if the monitor + no longer exists.

+ + + + intdriver_compare_monitors(const ErlDrvMonitor *monitor1, const ErlDrvMonitor *monitor2) + Compare two monitors + + +

This function is used to compare two ErlDrvMonitors. It + can also be used to imply some artificial order on monitors, + for whatever reason.

+

The function returns 0 if monitor1 and + monitor2 are equal, < 0 if monitor1 is less + than monitor2 and > 0 if monitor1 is greater + than monitor2.

+ + + + voidadd_driver_entry(ErlDrvEntry *de) + Add a driver entry + + +

This function adds a driver entry to the list of drivers + known by Erlang. The init function of the de + parameter is called.

+ +

To use this function for adding drivers residing in + dynamically loaded code is dangerous. If the driver code + for the added driver resides in the same dynamically + loaded module (i.e. .so file) as a normal + dynamically loaded driver (loaded with the erl_ddll + interface), the caller should call driver_lock_driver before + adding driver entries.

+

Use of this function is generally deprecated.

+ + + + + intremove_driver_entry(ErlDrvEntry *de) + Remove a driver entry + + +

This function removes a driver entry de previously + added with add_driver_entry.

+

Driver entries added by the erl_ddll erlang interface can + not be removed by using this interface.

+ + + + char*erl_errno_id(int error) + Get erlang error atom name from error number + + +

This function returns the atom name of the erlang error, + given the error number in error. Error atoms are: + einval, enoent, etc. It can be used to make + error terms from the driver.

+ + + + voidset_busy_port(ErlDrvPort port, int on) + Signal or unsignal port as busy + + +

This function set and resets the busy status of the port. If + on is 1, the port is set to busy, if it's 0 the port + is set to not busy.

+

When the port is busy, sending to it with Port ! Data + or port_command/2, will block the port owner process, + until the port is signaled as not busy.

+

If the + + has been set in the + driver_entry, + data can be forced into the driver via + port_command(Port, Data, [force]) + even though the driver has signaled that it is busy. +

+ + + + voidset_port_control_flags(ErlDrvPort port, int flags) + Set flags on how to handle control entry function + + +

This function sets flags for how the control driver entry + function will return data to the port owner process. (The + control function is called from port_control/3 + in erlang.)

+

Currently there are only two meaningful values for + flags: 0 means that data is returned in a list, and + PORT_CONTROL_FLAG_BINARY means data is returned as + a binary from control.

+ + + + intdriver_failure_eof(ErlDrvPort port) + Fail with EOF + + +

This function signals to erlang that the driver has + encountered an EOF and should be closed, unless the port was + opened with the eof option, in that case eof is sent + to the port. Otherwise, the port is close and an + 'EXIT' message is sent to the port owner process.

+

The return value is 0.

+ + + + intdriver_failure_atom(ErlDrvPort port, char *string) + intdriver_failure_posix(ErlDrvPort port, int error) + intdriver_failure(ErlDrvPort port, int error) + Fail with error + + + + +

These functions signal to Erlang that the driver has + encountered an error and should be closed. The port is + closed and the tuple {'EXIT', error, Err}, is sent to + the port owner process, where error is an error atom + (driver_failure_atom and + driver_failure_posix), or an integer + (driver_failure).

+

The driver should fail only when in severe error situations, + when the driver cannot possibly keep open, for instance + buffer allocation gets out of memory. Normal errors is more + appropriate to handle with sending error codes with + driver_output.

+

The return value is 0.

+ + + + ErlDrvTermDatadriver_connected(ErlDrvPort port) + Return the port owner process + + +

This function returns the port owner process.

+ + + + ErlDrvTermDatadriver_caller(ErlDrvPort port) + Return the process making the driver call + + +

This function returns the process id of the process that + made the current call to the driver. The process id can be + used with driver_send_term to send back data to the + caller. driver_caller() only return valid data + when currently executing in one of the following driver + callbacks:

+ + start + Called from open_port/2. + output + Called from erlang:send/2, and + erlang:port_command/2 + outputv + Called from erlang:send/2, and + erlang:port_command/2 + control + Called from erlang:port_control/3 + call + Called from erlang:port_call/3 + + + + + intdriver_output_term(ErlDrvPort port, ErlDrvTermData* term, int n) + Send term data from driver to port owner + + +

This functions sends data in the special driver term + format. This is a fast way to deliver term data from a + driver. It also needs no binary conversion, so the port + owner process receives data as normal Erlang terms.

+

The term parameter points to an array of + ErlDrvTermData, with n elements. This array + contains terms described in the driver term format. Every + term consists of one to four elements in the array. The + term first has a term type, and then arguments.

+

Tuple and lists (with the exception of strings, see below), + are built in reverse polish notation, so that to build a + tuple, the elements are given first, and then the tuple + term, with a count. Likewise for lists.

+

A tuple must be specified with the number of elements. (The + elements precedes the ERL_DRV_TUPLE term.)

+

A list must be specified with the number of elements, + including the tail, which is the last term preceding + ERL_DRV_LIST.

+

The special term ERL_DRV_STRING_CONS is used to + "splice" in a string in a list, a string given this way is + not a list per se, but the elements are elements of the + surrounding list.

+ 
+Term type            Argument(s)
+===========================================
+ERL_DRV_NIL          
+ERL_DRV_ATOM         ErlDrvTermData atom (from driver_mk_atom(char *string))
+ERL_DRV_INT          ErlDrvSInt integer
+ERL_DRV_UINT         ErlDrvUInt integer
+ERL_DRV_INT64        ErlDrvSInt64 *integer_ptr
+ERL_DRV_UINT64       ErlDrvUInt64 *integer_ptr
+ERL_DRV_PORT         ErlDrvTermData port (from driver_mk_port(ErlDrvPort port))
+ERL_DRV_BINARY       ErlDrvBinary *bin, ErlDrvUInt len, ErlDrvUInt offset
+ERL_DRV_BUF2BINARY   char *buf, ErlDrvUInt len
+ERL_DRV_STRING       char *str, int len
+ERL_DRV_TUPLE        int sz
+ERL_DRV_LIST         int sz
+ERL_DRV_PID          ErlDrvTermData pid (from driver_connected(ErlDrvPort port) or driver_caller(ErlDrvPort port))
+ERL_DRV_STRING_CONS  char *str, int len
+ERL_DRV_FLOAT        double *dbl
+ERL_DRV_EXT2TERM     char *buf, ErlDrvUInt len
+
+

The unsigned integer data type ErlDrvUInt and the + signed integer data type ErlDrvSInt are 64 bits wide + on a 64 bit runtime system and 32 bits wide on a 32 bit + runtime system. They were introduced in erts version 5.6, + and replaced some of the int arguments in the list above. +

+

The unsigned integer data type ErlDrvUInt64 and the + signed integer data type ErlDrvSInt64 are always 64 bits + wide. They were introduced in erts version 5.7.4. +

+ +

To build the tuple {tcp, Port, [100 | Binary]}, the + following call could be made.

+ + +

Where bin is a driver binary of length at least 50 + and port is a port handle. Note that the ERL_DRV_LIST + comes after the elements of the list, likewise the + ERL_DRV_TUPLE.

+

The term ERL_DRV_STRING_CONS is a way to construct + strings. It works differently from how ERL_DRV_STRING + works. ERL_DRV_STRING_CONS builds a string list in + reverse order, (as opposed to how ERL_DRV_LIST + works), concatenating the strings added to a list. The tail + must be given before ERL_DRV_STRING_CONS.

+

The ERL_DRV_STRING constructs a string, and ends + it. (So it's the same as ERL_DRV_NIL followed by + ERL_DRV_STRING_CONS.)

+ +

+ +

The ERL_DRV_EXT2TERM term type is used for passing a + term encoded with the + external format, + i.e., a term that has been encoded by + erlang:term_to_binary, + erl_interface, etc. + For example, if binp is a pointer to an ErlDrvBinary + that contains the term {17, 4711} encoded with the + external format + and you want to wrap it in a two tuple with the tag my_tag, + i.e., {my_tag, {17, 4711}}, you can do as follows: +

+ orig_bytes, binp->orig_size + ERL_DRV_TUPLE, 2, + }; + driver_output_term(port, spec, sizeof(spec) / sizeof(spec[0])); + ]]> +

If you want to pass a binary and doesn't already have the content + of the binary in an ErlDrvBinary, you can benefit from using + ERL_DRV_BUF2BINARY instead of creating an ErlDrvBinary + via driver_alloc_binary() and then pass the binary via + ERL_DRV_BINARY. The runtime system will often allocate + binaries smarter if ERL_DRV_BUF2BINARY is used. + However, if the content of the binary to pass already resides in + an ErlDrvBinary, it is normally better to pass the binary + using ERL_DRV_BINARY and the ErlDrvBinary in question. +

+

The ERL_DRV_UINT, ERL_DRV_BUF2BINARY, and + ERL_DRV_EXT2TERM term types were introduced in the 5.6 + version of erts. +

+

Note that this function is not thread-safe, not + even when the emulator with SMP support is used.

+ + + + ErlDrvTermDatadriver_mk_atom(char* string) + Make an atom from a name + + +

This function returns an atom given a name + string. The atom is created and won't change, so the + return value may be saved and reused, which is faster than + looking up the atom several times.

+ + + + ErlDrvTermDatadriver_mk_port(ErlDrvPort port) + Make a erlang term port from a port + + +

This function converts a port handle to the erlang term + format, usable in the driver_output_send function.

+ + + + intdriver_send_term(ErlDrvPort port, ErlDrvTermData receiver, ErlDrvTermData* term, int n) + Send term data to other process than port owner process + + +

This function is the only way for a driver to send data to + other processes than the port owner process. The + receiver parameter specifies the process to receive + the data.

+

The parameters term and n does the same thing + as in driver_output_term.

+

This function is only thread-safe when the emulator with SMP + support is used.

+ + + + longdriver_async (ErlDrvPort port, unsigned int* key, void (*async_invoke)(void*), void* async_data, void (*async_free)(void*)) + Perform an asynchronous call within a driver + + +

This function performs an asynchronous call. The function + async_invoke is invoked in a thread separate from the + emulator thread. This enables the driver to perform + time-consuming, blocking operations without blocking the + emulator.

+

Erlang is by default started without an async thread pool. The + number of async threads that the runtime system should use + is specified by the + +A + command line argument of erl(1). + If no async thread pool is available, the call is made + synchronously in the thread calling driver_async(). The + current number of async threads in the async thread pool can be + retrieved via + driver_system_info().

+

If there is a thread pool available, a thread will be + used. If the key argument is null, the threads from the + pool are used in a round-robin way, each call to + driver_async uses the next thread in the pool. With the + key argument set, this behaviour is changed. The two + same values of *key always get the same thread.

+

To make sure that a driver instance always uses the same + thread, the following call can be used:

+

+ +

It is enough to initialize myKey once for each + driver instance.

+

If a thread is already working, the calls will be + queued up and executed in order. Using the same thread for + each driver instance ensures that the calls will be made in + sequence.

+

The async_data is the argument to the functions + async_invoke and async_free. It's typically a + pointer to a structure that contains a pipe or event that + can be used to signal that the async operation completed. + The data should be freed in async_free, because it's + called if driver_async_cancel is called.

+

When the async operation is done, ready_async driver + entry function is called. If async_ready is null in + the driver entry, the async_free function is called + instead.

+

The return value is a handle to the asynchronous task, which + can be used as argument to driver_async_cancel.

+ +

As of erts version 5.5.4.3 the default stack size for + threads in the async-thread pool is 16 kilowords, + i.e., 64 kilobyte on 32-bit architectures. + This small default size has been chosen since the + amount of async-threads might be quite large. The + default stack size is enough for drivers delivered + with Erlang/OTP, but might not be sufficiently large + for other dynamically linked in drivers that use the + driver_async() functionality. A suggested stack size + for threads in the async-thread pool can be configured + via the + +a + command line argument of + erl(1).

+ + + + + intdriver_async_cancel(long id) + Cancel an asynchronous call + + +

This function cancels an asynchronous operation, by removing + it from the queue. Only functions in the queue can be + cancelled; if a function is executing, it's too late to + cancel it. The async_free function is also called.

+

The return value is 1 if the operation was removed from the + queue, otherwise 0.

+ + + + intdriver_lock_driver(ErlDrvPort port) + Make sure the driver is never unloaded + + +

This function locks the driver used by the port port + in memory for the rest of the emulator process + lifetime. After this call, the driver behaves as one of Erlang's + statically linked in drivers.

+ + + + ErlDrvPortdriver_create_port(ErlDrvPort port, ErlDrvTermData owner_pid, char* name, ErlDrvData drv_data) + Create a new port (driver instance) + +

This function creates a new port executing the same driver + code as the port creating the new port. + A short description of the arguments:

+ + port + The port handle of the port (driver instance) creating + the new port. + owner_pid + The process id of the Erlang process which will be + owner of the new port. This process will be linked + to the new port. You usually want to use + driver_caller(port) as owner_pid. + name + The port name of the new port. You usually want to + use the same port name as the driver name + (driver_name + field of the + driver_entry). + drv_data + The driver defined handle that will be passed in subsequent + calls to driver call-backs. Note, that the + driver start call-back + will not be called for this new driver instance. + The driver defined handle is normally created in the + driver start call-back + when a port is created via + erlang:open_port/2. + +

The caller of driver_create_port() is allowed to + manipulate the newly created port when driver_create_port() + has returned. When + port level locking + is used, the creating port is, however, only allowed to + manipulate the newly created port until the current driver + call-back that was called by the emulator returns.

+ +

When + port level locking + is used, the creating port is only allowed to manipulate + the newly created port until the current driver call-back + returns.

+ + + + + + interl_drv_thread_create(char *name, + ErlDrvTid *tid, + void * (*func)(void *), + void *arg, + ErlDrvThreadOpts *opts) + Create a thread + + +

Arguments:

+ + name + A string identifying the created thread. It will be used + to identify the thread in planned future debug + functionality. + + tid + A pointer to a thread identifier variable. + func + A pointer to a function to execute in the created thread. + arg + A pointer to argument to the func function. + opts + A pointer to thread options to use or NULL. + +

This function creates a new thread. On success 0 is returned; + otherwise, an errno value is returned to indicate the error. + The newly created thread will begin executing in the function pointed + to by func, and func will be passed arg as + argument. When erl_drv_thread_create() returns the thread + identifier of the newly created thread will be available in + *tid. opts can be either a NULL pointer, or a + pointer to an + ErlDrvThreadOpts + structure. If opts is a NULL pointer, default options + will be used; otherwise, the passed options will be used. +

+

You are not allowed to allocate the + ErlDrvThreadOpts + structure by yourself. It has to be allocated and + initialized by + erl_drv_thread_opts_create(). +

+

The created thread will terminate either when func returns + or if + erl_drv_thread_exit() + is called by the thread. The exit value of the thread is either + returned from func or passed as argument to + erl_drv_thread_exit(). + The driver creating the thread has the responsibility of joining the + thread, via + erl_drv_thread_join(), + before the driver is unloaded. It is not possible to create + "detached" threads, i.e., threads that don't need to be joined. +

+

All created threads need to be joined by the driver before + it is unloaded. If the driver fails to join all threads + created before it is unloaded, the runtime system will + most likely crash when the code of the driver is unloaded. +

+

This function is thread-safe.

+ + + + + ErlDrvThreadOpts *erl_drv_thread_opts_create(char *name) + Create thread options + + +

Arguments:

+ + name + A string identifying the created thread options. It will be used + to identify the thread options in planned future debug + functionality. + + +

This function allocates and initialize a thread option + structure. On failure NULL is returned. A thread option + structure is used for passing options to + erl_drv_thread_create(). + If the structure isn't modified before it is passed to + erl_drv_thread_create(), + the default values will be used. +

+

You are not allowed to allocate the + ErlDrvThreadOpts + structure by yourself. It has to be allocated and + initialized by erl_drv_thread_opts_create(). +

+

This function is thread-safe.

+ + + + + voiderl_drv_thread_opts_destroy(ErlDrvThreadOpts *opts) + Destroy thread options + + +

Arguments:

+ + opts + A pointer to thread options to destroy. + +

This function destroys thread options previously created by + erl_drv_thread_opts_create(). +

+

This function is thread-safe.

+ + + + + voiderl_drv_thread_exit(void *exit_value) + Terminate calling thread + + +

Arguments:

+ + exit_value + A pointer to an exit value or NULL. + +

This function terminates the calling thread with the exit + value passed as argument. You are only allowed to terminate + threads created with + erl_drv_thread_create(). + The exit value can later be retrieved by another thread via + erl_drv_thread_join(). +

+

This function is thread-safe.

+ + + + + interl_drv_thread_join(ErlDrvTid tid, void **exit_value) + Join with another thread + + +

Arguments:

+ + tid + The thread identifier of the thread to join. + exit_value + A pointer to a pointer to an exit value, or NULL. + +

This function joins the calling thread with another thread, i.e., + the calling thread is blocked until the thread identified by + tid has terminated. On success 0 is returned; + otherwise, an errno value is returned to indicate the error. + A thread can only be joined once. The behavior of joining + more than once is undefined, an emulator crash is likely. If + exit_value == NULL, the exit value of the terminated thread + will be ignored; otherwise, the exit value of the terminated thread + will be stored at *exit_value. +

+

This function is thread-safe.

+ + + + + ErlDrvTiderl_drv_thread_self(void) + Get the thread identifier of the current thread + + +

This function returns the thread identifier of the + calling thread. +

+

This function is thread-safe.

+ + + + + interl_drv_equal_tids(ErlDrvTid tid1, ErlDrvTid tid2) + Compare thread identifiers for equality + + +

Arguments:

+ + tid1 + A thread identifier. + tid2 + A thread identifier. + +

This function compares two thread identifiers for equality, + and returns 0 it they aren't equal, and + a value not equal to 0 if they are equal.

+

A Thread identifier may be reused very quickly after + a thread has terminated. Therefore, if a thread + corresponding to one of the involved thread identifiers + has terminated since the thread identifier was saved, + the result of erl_drv_equal_tids() might not give + expected result. +

+

This function is thread-safe.

+ + + + + ErlDrvMutex *erl_drv_mutex_create(char *name) + Create a mutex + + +

Arguments:

+ + name + A string identifying the created mutex. It will be used + to identify the mutex in planned future debug functionality. + + +

This function creates a mutex and returns a pointer to it. On + failure NULL is returned. The driver creating the mutex + has the responsibility of destroying it before the driver is + unloaded. +

+

This function is thread-safe.

+ + + + + voiderl_drv_mutex_destroy(ErlDrvMutex *mtx) + Destroy a mutex + + +

Arguments:

+ + mtx + A pointer to a mutex to destroy. + +

This function destroys a mutex previously created by + erl_drv_mutex_create(). + The mutex has to be in an unlocked state before being + destroyed. +

+

This function is thread-safe.

+ + + + + voiderl_drv_mutex_lock(ErlDrvMutex *mtx) + Lock a mutex + + +

Arguments:

+ + mtx + A pointer to a mutex to lock. + +

This function locks a mutex. The calling thread will be + blocked until the mutex has been locked. A thread + which currently has locked the mutex may not lock + the same mutex again. +

+

If you leave a mutex locked in an emulator thread + when you let the thread out of your control, you will + very likely deadlock the whole emulator. +

+

This function is thread-safe.

+ + + + + interl_drv_mutex_trylock(ErlDrvMutex *mtx) + Try lock a mutex + + +

Arguments:

+ + mtx + A pointer to a mutex to try to lock. + +

This function tries to lock a mutex. If successful 0, + is returned; otherwise, EBUSY is returned. A thread + which currently has locked the mutex may not try to + lock the same mutex again. +

+

If you leave a mutex locked in an emulator thread + when you let the thread out of your control, you will + very likely deadlock the whole emulator. +

+

This function is thread-safe.

+ + + + + voiderl_drv_mutex_unlock(ErlDrvMutex *mtx) + Unlock a mutex + + +

Arguments:

+ + mtx + A pointer to a mutex to unlock. + +

This function unlocks a mutex. The mutex currently has to be + locked by the calling thread. +

+

This function is thread-safe.

+ + + + + ErlDrvCond *erl_drv_cond_create(char *name) + Create a condition variable + + +

Arguments:

+ + name + A string identifying the created condition variable. It + will be used to identify the condition variable in planned + future debug functionality. + + +

This function creates a condition variable and returns a + pointer to it. On failure NULL is returned. The driver + creating the condition variable has the responsibility of + destroying it before the driver is unloaded.

+

This function is thread-safe.

+ + + + + voiderl_drv_cond_destroy(ErlDrvCond *cnd) + Destroy a condition variable + + +

Arguments:

+ + cnd + A pointer to a condition variable to destroy. + +

This function destroys a condition variable previously + created by + erl_drv_cond_create(). +

+

This function is thread-safe.

+ + + + + voiderl_drv_cond_signal(ErlDrvCond *cnd) + Signal on a condition variable + + +

Arguments:

+ + cnd + A pointer to a condition variable to signal on. + +

This function signals on a condition variable. That is, if + other threads are waiting on the condition variable being + signaled, one of them will be woken. +

+

This function is thread-safe.

+ + + + + voiderl_drv_cond_broadcast(ErlDrvCond *cnd) + Broadcast on a condition variable + + +

Arguments:

+ + cnd + A pointer to a condition variable to broadcast on. + +

This function broadcasts on a condition variable. That is, if + other threads are waiting on the condition variable being + broadcasted on, all of them will be woken. +

+

This function is thread-safe.

+ + + + + voiderl_drv_cond_wait(ErlDrvCond *cnd, ErlDrvMutex *mtx) + Wait on a condition variable + + +

Arguments:

+ + cnd + A pointer to a condition variable to wait on. + mtx + A pointer to a mutex to unlock while waiting. + + + +

This function waits on a condition variable. The calling + thread is blocked until another thread wakes it by signaling + or broadcasting on the condition variable. Before the calling + thread is blocked it unlocks the mutex passed as argument, and + when the calling thread is woken it locks the same mutex before + returning. That is, the mutex currently has to be locked by + the calling thread when calling this function. +

+

erl_drv_cond_wait() might return even though + no-one has signaled or broadcasted on the condition + variable. Code calling erl_drv_cond_wait() should + always be prepared for erl_drv_cond_wait() + returning even though the condition that the thread was + waiting for hasn't occurred. That is, when returning from + erl_drv_cond_wait() always check if the condition + has occurred, and if not call erl_drv_cond_wait() + again. +

+

This function is thread-safe.

+ + + + + ErlDrvRWLock *erl_drv_rwlock_create(char *name) + Create an rwlock + + +

Arguments:

+ + name + A string identifying the created rwlock. It will be used to + identify the rwlock in planned future debug functionality. + + +

This function creates an rwlock and returns a pointer to it. On + failure NULL is returned. The driver creating the rwlock + has the responsibility of destroying it before the driver is + unloaded. +

+

This function is thread-safe.

+ + + + + voiderl_drv_rwlock_destroy(ErlDrvRWLock *rwlck) + Destroy an rwlock + + +

Arguments:

+ + rwlck + A pointer to an rwlock to destroy. + +

This function destroys an rwlock previously created by + erl_drv_rwlock_create(). + The rwlock has to be in an unlocked state before being destroyed. +

+

This function is thread-safe.

+ + + + + voiderl_drv_rwlock_rlock(ErlDrvRWLock *rwlck) + Read lock an rwlock + + +

Arguments:

+ + rwlck + A pointer to an rwlock to read lock. + +

This function read locks an rwlock. The calling thread will be + blocked until the rwlock has been read locked. A thread + which currently has read or read/write locked the rwlock may + not lock the same rwlock again. +

+

If you leave an rwlock locked in an emulator thread + when you let the thread out of your control, you will + very likely deadlock the whole emulator. +

+

This function is thread-safe.

+ + + + + interl_drv_rwlock_tryrlock(ErlDrvRWLock *rwlck) + Try to read lock an rwlock + + +

Arguments:

+ + rwlck + A pointer to an rwlock to try to read lock. + +

This function tries to read lock an rwlock. If successful + 0, is returned; otherwise, EBUSY is returned. + A thread which currently has read or read/write locked the + rwlock may not try to lock the same rwlock again. +

+

If you leave an rwlock locked in an emulator thread + when you let the thread out of your control, you will + very likely deadlock the whole emulator. +

+

This function is thread-safe.

+ + + + + voiderl_drv_rwlock_runlock(ErlDrvRWLock *rwlck) + Read unlock an rwlock + + +

Arguments:

+ + rwlck + A pointer to an rwlock to read unlock. + +

This function read unlocks an rwlock. The rwlock currently + has to be read locked by the calling thread. +

+

This function is thread-safe.

+ + + + + voiderl_drv_rwlock_rwlock(ErlDrvRWLock *rwlck) + Read/Write lock an rwlock + + +

Arguments:

+ + rwlck + A pointer to an rwlock to read/write lock. + +

This function read/write locks an rwlock. The calling thread + will be blocked until the rwlock has been read/write locked. + A thread which currently has read or read/write locked the + rwlock may not lock the same rwlock again. +

+

If you leave an rwlock locked in an emulator thread + when you let the thread out of your control, you will + very likely deadlock the whole emulator. +

+

This function is thread-safe.

+ + + + + interl_drv_rwlock_tryrwlock(ErlDrvRWLock *rwlck) + Try to read/write lock an rwlock + + +

Arguments:

+ + rwlck + A pointer to an rwlock to try to read/write lock. + +

This function tries to read/write lock an rwlock. If successful + 0, is returned; otherwise, EBUSY is returned. + A thread which currently has read or read/write locked the + rwlock may not try to lock the same rwlock again. +

+

If you leave an rwlock locked in an emulator thread + when you let the thread out of your control, you will + very likely deadlock the whole emulator. +

+

This function is thread-safe.

+ + + + + voiderl_drv_rwlock_rwunlock(ErlDrvRWLock *rwlck) + Read/Write unlock an rwlock + + +

Arguments:

+ + rwlck + A pointer to an rwlock to read/write unlock. + +

This function read/write unlocks an rwlock. The rwlock + currently has to be read/write locked by the calling thread. +

+

This function is thread-safe.

+ + + + + interl_drv_tsd_key_create(char *name, ErlDrvTSDKey *key) + Create a thread specific data key + + +

Arguments:

+ + name + A string identifying the created key. It will be used + to identify the key in planned future debug + functionality. + + key + A pointer to a thread specific data key variable. + +

This function creates a thread specific data key. On success + 0 is returned; otherwise, an errno value is returned + to indicate the error. The driver creating the key has the + responsibility of destroying it before the driver is unloaded. +

+

This function is thread-safe.

+ + + + + voiderl_drv_tsd_key_destroy(ErlDrvTSDKey key) + Destroy a thread specific data key + + +

Arguments:

+ + key + A thread specific data key to destroy. + +

This function destroys a thread specific data key + previously created by + erl_drv_tsd_key_create(). + All thread specific data using this key in all threads + have to be cleared (see + erl_drv_tsd_set()) + prior to the call to erl_drv_tsd_key_destroy(). +

+

A destroyed key is very likely to be reused soon. + Therefore, if you fail to clear the thread specific + data using this key in a thread prior to destroying + the key, you will very likely get unexpected + errors in other parts of the system. +

+

This function is thread-safe.

+ + + + + voiderl_drv_tsd_set(ErlDrvTSDKey key, void *data) + Set thread specific data + + +

Arguments:

+ + key + A thread specific data key. + data + A pointer to data to associate with key + in calling thread. + + +

This function sets thread specific data associated with + key for the calling thread. You are only allowed to set + thread specific data for threads while they are fully under your + control. For example, if you set thread specific data in a thread + calling a driver call-back function, it has to be cleared, i.e. + set to NULL, before returning from the driver call-back + function. +

+

If you fail to clear thread specific data in an + emulator thread before letting it out of your control, + you might not ever be able to clear this data with + later unexpected errors in other parts of the system as + a result. +

+

This function is thread-safe.

+ + + + + void *erl_drv_tsd_get(ErlDrvTSDKey key) + Get thread specific data + + +

Arguments:

+ + key + A thread specific data key. + +

This function returns the thread specific data + associated with key for the calling thread. + If no data has been associated with key for + the calling thread, NULL is returned. +

+

This function is thread-safe.

+ + + + + interl_drv_putenv(char *key, char *value) + Set the value of an environment variable + + +

Arguments:

+ + key + A null terminated string containing the + name of the environment variable. + value + A null terminated string containing the + new value of the environment variable. + +

This function sets the value of an environment variable. + It returns 0 on success, and a value != 0 on + failure. +

+

The result of passing the empty string ("") as a value + is platform dependent. On some platforms the value of the + variable is set to the empty string, on others, the + environment variable is removed.

+ +

Do not use libc's putenv or similar + C library interfaces from a driver. +

+

This function is thread-safe.

+ + + + + interl_drv_getenv(char *key, char *value, size_t *value_size) + Get the value of an environment variable + + +

Arguments:

+ + key + A null terminated string containing the + name of the environment variable. + value + A pointer to an output buffer. + value_size + A pointer to an integer. The integer is both used for + passing input and output sizes (see below). + + +

This function retrieves the value of an environment variable. + When called, *value_size should contain the size of + the value buffer. On success 0 is returned, + the value of the environment variable has been written to + the value buffer, and *value_size contains the + string length (excluding the terminating null character) of + the value written to the value buffer. On failure, + i.e., no such environment variable was found, a value less than + 0 is returned. When the size of the value + buffer is too small, a value greater than 0 is returned + and *value_size has been set to the buffer size needed. +

+

Do not use libc's getenv or similar + C library interfaces from a driver. +

+

This function is thread-safe.

+ + + + +
+ SEE ALSO +

driver_entry(3), + erl_ddll(3), + erlang(3)

+

An Alternative Distribution Driver (ERTS User's + Guide Ch. 3)

+
+ + diff --git a/erts/doc/src/erl_ext_dist.xml b/erts/doc/src/erl_ext_dist.xml new file mode 100644 index 0000000000..c2d58d1ef1 --- /dev/null +++ b/erts/doc/src/erl_ext_dist.xml @@ -0,0 +1,1014 @@ + + + + +
+ + 2007 + 2007 + Ericsson AB, All Rights Reserved + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + The Initial Developer of the Original Code is Ericsson AB. + + + External Term Format + Kenneth + + 2007-09-21 + PA1 + erl_ext_dist.xml +
+ +
+ Introduction +

+ The external term format is mainly used in the distribution + mechanism of Erlang. +

+

+ Since Erlang has a fixed number of types, there is no need for a + programmer to define a specification for the external format used + within some application. + All Erlang terms has an external representation and the interpretation + of the different terms are application specific. +

+

+ In Erlang the BIF term_to_binary/1,2 is used to convert a + term into the external format. + To convert binary data encoding a term the BIF + + binary_to_term/1 + + is used. +

+

+ The distribution does this implicitly when sending messages across + node boundaries. +

+ +

+ The overall format of the term format is: +

+ + + 1 + 1 + N + + + 131 + Tag + Data + +
+ +

+ When messages are + passed between + connected nodes and a + distribution + header is used, the first byte containing the version + number (131) is omitted from the terms that follow the distribution + header. This since + the version number is implied by the version number in the + distribution header. +

+ +

+ A compressed term looks like this: +

+ + + 1 + 1 + 4 + N + + + 131 + 80 + UncompressedSize + Zlib-compressedData + +
+

+ Uncompressed Size (unsigned 32 bit integer in big-endian byte order) + is the size of the data before it was compressed. + The compressed data has the following format when it has been + expanded: +

+ + + 1 + Uncompressed Size + + + Tag + Data + +
+
+ +
+ + Distribution header +

+ As of erts version 5.7.2 the old atom cache protocol was + dropped and a new one was introduced. This atom cache protocol + introduced the distribution header. Nodes with erts versions + earlier than 5.7.2 can still communicate with new nodes, + but no distribution header and no atom cache will be used.

+

+ The distribution header currently only contains an atom cache + reference section, but could in the future contain more + information. The distribution header precedes one or more Erlang + terms on the external format. For more information see the + documentation of the + protocol between + connected nodes in the + distribution protocol + documentation. +

+

+ ATOM_CACHE_REF + entries with corresponding AtomCacheReferenceIndex in terms + encoded on the external format following a distribution header refers + to the atom cache references made in the distribution header. The range + is 0 <= AtomCacheReferenceIndex < 255, i.e., at most 255 + different atom cache references from the following terms can be made. +

+

+ The distribution header format is: +

+ + + 1 + 1 + 1 + NumberOfAtomCacheRefs/2+1 | 0 + N | 0 + + + 131 + 68 + NumberOfAtomCacheRefs + Flags + AtomCacheRefs + +
+

+ Flags consists of NumberOfAtomCacheRefs/2+1 bytes, + unless NumberOfAtomCacheRefs is 0. If + NumberOfAtomCacheRefs is 0, Flags and + AtomCacheRefs are omitted. Each atom cache reference have + a half byte flag field. Flags corresponding to a specific + AtomCacheReferenceIndex, are located in flag byte number + AtomCacheReferenceIndex/2. Flag byte 0 is the first byte + after the NumberOfAtomCacheRefs byte. Flags for an even + AtomCacheReferenceIndex are located in the least significant + half byte and flags for an odd AtomCacheReferenceIndex are + located in the most significant half byte. +

+

+ The flag field of an atom cache reference has the following + format: +

+ + + 1 bit + 3 bits + + + NewCacheEntryFlag + SegmentIndex + +
+

+ The most significant bit is the NewCacheEntryFlag. If set, + the corresponding cache reference is new. The three least + significant bits are the SegmentIndex of the corresponding + atom cache entry. An atom cache consists of 8 segments each of size + 256, i.e., an atom cache can contain 2048 entries. +

+

+ After flag fields for atom cache references, another half byte flag + field is located which has the following format: +

+ + + 3 bits + 1 bit + + + CurrentlyUnused + LongAtoms + +
+

+ The least significant bit in that half byte is the LongAtoms + flag. If it is set, 2 bytes are used for atom lengths instead of + 1 byte in the distribution header. However, the current emulator + cannot handle long atoms, so it will currently always be 0. +

+

+ After the Flags field follow the AtomCacheRefs. The + first AtomCacheRef is the one corresponding to + AtomCacheReferenceIndex 0. Higher indices follows + in sequence up to index NumberOfAtomCacheRefs - 1. +

+

+ If the NewCacheEntryFlag for the next AtomCacheRef has + been set, a NewAtomCacheRef on the following format will follow: +

+ + + 1 + 1 | 2 + Length + + + InternalSegmentIndex + Length + AtomText + +
+

+ InternalSegmentIndex together with the SegmentIndex + completely identify the location of an atom cache entry in the + atom cache. Length is number of one byte characters that + the atom text consists of. Length is a two byte big endian integer + if the LongAtoms flag has been set, otherwise a one byte + integer. Subsequent CachedAtomRefs with the same + SegmentIndex and InternalSegmentIndex as this + NewAtomCacheRef will refer to this atom until a new + NewAtomCacheRef with the same SegmentIndex + and InternalSegmentIndex appear. +

+

+ If the NewCacheEntryFlag for the next AtomCacheRef + has not been set, a CachedAtomRef on the following format + will follow: +

+ + + 1 + + + InternalSegmentIndex + +
+

+ InternalSegmentIndex together with the SegmentIndex + identify the location of the atom cache entry in the atom cache. + The atom corresponding to this CachedAtomRef is the + latest NewAtomCacheRef preceding this CachedAtomRef + in another previously passed distribution header. +

+
+ +
+ + ATOM_CACHE_REF + + + + 1 + 1 + + + 82 + AtomCacheReferenceIndex + +
+

+ Refers to the atom with AtomCacheReferenceIndex in the + distribution header. +

+
+ +
+ + SMALL_INTEGER_EXT + + + + 1 + 1 + + + 97 + Int + +
+

+ Unsigned 8 bit integer. +

+
+ +
+ + INTEGER_EXT + + + + 1 + 4 + + + 98 + Int + +
+

+ Signed 32 bit integer in big-endian format (i.e. MSB first) +

+
+ +
+ + FLOAT_EXT + + + + 1 + 31 + + + 99 + Float String + +
+

+ A float is stored in string format. the format used in sprintf to + format the float is "%.20e" + (there are more bytes allocated than necessary). + To unpack the float use sscanf with format "%lf". +

+

+ This term is used in minor version 0 of the external format; + it has been superseded by + + NEW_FLOAT_EXT + . +

+
+ +
+ + ATOM_EXT + + + + 1 + 2 + Len + + + 100 + Len + AtomName + +
+

+ An atom is stored with a 2 byte unsigned length in big-endian order, + followed by Len numbers of 8 bit characters that forms the + AtomName. + Note: The maximum allowed value for Len is 255. +

+
+ +
+ + REFERENCE_EXT + + + + 1 + N + 4 + 1 + + + 101 + Node + ID + Creation + +
+

+ Encode a reference object (an object generated with make_ref/0). + The Node term is an encoded atom, i.e. + ATOM_EXT, + SMALL_ATOM_EXT or + ATOM_CACHE_REF. + The ID field contains a big-endian + unsigned integer, + but should be regarded as uninterpreted data + since this field is node specific. + Creation is a byte containing a node serial number that + makes it possible to separate old (crashed) nodes from a new one. +

+

+ In ID, only 18 bits are significant; the rest should be 0. + In Creation, only 2 bits are significant; the rest should be 0. + + See NEW_REFERENCE_EXT. +

+
+ +
+ + PORT_EXT + + + + 1 + N + 4 + 1 + + + 102 + Node + ID + Creation + +
+

+ Encode a port object (obtained form open_port/2). + The ID is a node specific identifier for a local port. + Port operations are not allowed across node boundaries. + The Creation works just like in + REFERENCE_EXT. +

+
+ +
+ + PID_EXT + + + + 1 + N + 4 + 4 + 1 + + + 103 + Node + ID + Serial + Creation + +
+

+ Encode a process identifier object (obtained from spawn/3 or + friends). + The ID and Creation fields works just like in + REFERENCE_EXT, while + the Serial field is used to improve safety. + + In ID, only 15 bits are significant; the rest should be 0. +

+ +
+ +
+ + SMALL_TUPLE_EXT + + + + 1 + 1 + N + + + 104 + Arity + Elements + +
+

+ SMALL_TUPLE_EXT encodes a tuple. The Arity + field is an unsigned byte that determines how many element + that follows in the Elements section. +

+
+ +
+ + LARGE_TUPLE_EXT + + + + 1 + 4 + N + + + 105 + Arity + Elements + +
+

+ Same as + SMALL_TUPLE_EXT + with the exception that Arity is an + unsigned 4 byte integer in big endian format. +

+
+ +
+ + NIL_EXT + + + + 1 + + + 106 + +
+

+ The representation for an empty list, i.e. the Erlang syntax []. +

+
+ +
+ + STRING_EXT + + + + 1 + 2 + Len + + + 107 + Length + Characters + +
+

+ String does NOT have a corresponding Erlang representation, + but is an optimization for sending lists of bytes (integer in + the range 0-255) more efficiently over the distribution. + Since the Length field is an unsigned 2 byte integer + (big endian), implementations must make sure that lists longer than + 65535 elements are encoded as + LIST_EXT. +

+ +
+ +
+ + LIST_EXT + + + + 1 + 4 +   +   + + + 108 + Length + Elements + Tail + +
+ +

+ Length is the number of elements that follows in the + Elements section. Tail is the final tail of + the list; it is + NIL_EXT + for a proper list, but may be anything type if the list is + improper (for instance [a|b]). +

+
+ +
+ + BINARY_EXT + + + + 1 + 4 + Len + + + 109 + Len + Data + +
+

+ Binaries are generated with bit syntax expression or with + list_to_binary/1, + term_to_binary/1, + or as input from binary ports. + The Len length field is an unsigned 4 byte integer + (big endian). +

+
+ +
+ + SMALL_BIG_EXT + + + + 1 + 1 + 1 + n + + + 110 + n + Sign + d(0) ... d(n-1) + +
+

+ Bignums are stored in unary form with a Sign byte + that is 0 if the binum is positive and 1 if is negative. The + digits are stored with the LSB byte stored first. To + calculate the integer the following formula can be used:
+ + B = 256
+ (d0*B^0 + d1*B^1 + d2*B^2 + ... d(N-1)*B^(n-1)) +

+
+ +
+ + LARGE_BIG_EXT + + + + 1 + 4 + 1 + n + + + 111 + n + Sign + d(0) ... d(n-1) + +
+

+ Same as SMALL_BIG_EXT + with the difference that the length field + is an unsigned 4 byte integer. +

+ +
+ +
+ + NEW_REFERENCE_EXT + + + + 1 + 2 + N + 1 + N' + + + 114 + Len + Node + Creation + ID ... + +
+

+ Node and Creation are as in + REFERENCE_EXT. +

+

+ ID contains a sequence of big-endian unsigned integers + (4 bytes each, so N' is a multiple of 4), + but should be regarded as uninterpreted data. +

+

+ N' = 4 * Len. +

+

+ In the first word (four bytes) of ID, only 18 bits are + significant, the rest should be 0. + In Creation, only 2 bits are significant, + the rest should be 0. +

+

+ NEW_REFERENCE_EXT was introduced with distribution version 4. + In version 4, N' should be at most 12. +

+

+ See REFERENCE_EXT). +

+
+ +
+ + SMALL_ATOM_EXT + + + + 1 + 1 + Len + + + 115 + Len + AtomName + +
+

+ An atom is stored with a 1 byte unsigned length, + followed by Len numbers of 8 bit characters that + forms the AtomName. Longer atoms can be represented + by ATOM_EXT. Note + the SMALL_ATOM_EXT was introduced in erts version 5.7.2 and + require a small atom distribution flag exchanged in the distribution + handshake. +

+
+ +
+ + FUN_EXT + + + + 1 + 4 + N1 + N2 + N3 + N4 + N5 + + + 117 + NumFree + Pid + Module + Index + Uniq + Free vars ... + +
+ + Pid + + is a process identifier as in + PID_EXT. + It represents the process in which the fun was created. + + Module + + is an encoded as an atom, using + ATOM_EXT, + SMALL_ATOM_EXT + or ATOM_CACHE_REF. + This is the module that the fun is implemented in. + + Index + + is an integer encoded using + SMALL_INTEGER_EXT + or INTEGER_EXT. + It is typically a small index into the module's fun table. + + Uniq + + is an integer encoded using + SMALL_INTEGER_EXT or + INTEGER_EXT. + Uniq is the hash value of the parse for the fun. + + Free vars + + is NumFree number of terms, each one encoded according + to its type. + + +
+ +
+ + NEW_FUN_EXT + + + + 1 + 4 + 1 + 16 + 4 + 4 + N1 + N2 + N3 + N4 + N5 + + + 112 + Size + Arity + Uniq + Index + NumFree + Module + OldIndex + OldUniq + Pid + Free Vars + +
+

+ This is the new encoding of internal funs: fun F/A and + fun(Arg1,..) -> ... end. +

+ + Size + + is the total number of bytes, including the Size field. + + Arity + + is the arity of the function implementing the fun. + + Uniq + + is the 16 bytes MD5 of the significant parts of the Beam file. + + Index + + is an index number. Each fun within a module has an unique + index. Index is stored in big-endian byte order. + + NumFree + + is the number of free variables. + + Module + + is an encoded as an atom, using + ATOM_EXT, + SMALL_ATOM_EXT or + ATOM_CACHE_REF. + This is the module that the fun is implemented in. + + OldIndex + + is an integer encoded using + SMALL_INTEGER_EXT + or INTEGER_EXT. + It is typically a small index into the module's fun table. + + OldUniq + + is an integer encoded using + SMALL_INTEGER_EXT + or + INTEGER_EXT. + Uniq is the hash value of the parse tree for the fun. + + Pid + + is a process identifier as in + PID_EXT. + It represents the process in which + the fun was created. + + + Free vars + + is NumFree number of terms, each one encoded according + to its type. + + +
+ +
+ + EXPORT_EXT + + + + 1 + N1 + N2 + N3 + + + 113 + Module + Function + Arity + +
+

+ This term is the encoding for external funs: fun M:F/A. +

+

+ Module and Function are atoms + (encoded using ATOM_EXT, + SMALL_ATOM_EXT or + ATOM_CACHE_REF). +

+

+ Arity is an integer encoded using + SMALL_INTEGER_EXT. +

+ +
+ +
+ + BIT_BINARY_EXT + + + + 1 + 4 + 1 + Len + + + 77 + Len + Bits + Data + +
+

+ This term represents a bitstring whose length in bits is not a + multiple of 8 (created using the bit syntax in R12B and later). + The Len field is an unsigned 4 byte integer (big endian). + The Bits field is the number of bits that are used + in the last byte in the data field, + counting from the most significant bit towards the least + significant. +

+ + +
+ +
+ + NEW_FLOAT_EXT + + + + 1 + 8 + + + 70 + IEEE float + +
+

+ A float is stored as 8 bytes in big-endian IEEE format. +

+

+ This term is used in minor version 1 of the external format. +

+
+ + + + + diff --git a/erts/doc/src/erl_ext_fig.gif b/erts/doc/src/erl_ext_fig.gif new file mode 100755 index 0000000000..14d6bbc871 Binary files /dev/null and b/erts/doc/src/erl_ext_fig.gif differ diff --git a/erts/doc/src/erl_ext_fig.ps b/erts/doc/src/erl_ext_fig.ps new file mode 100644 index 0000000000..2501dc3c05 --- /dev/null +++ b/erts/doc/src/erl_ext_fig.ps @@ -0,0 +1,153 @@ +%!PS-Adobe-3.0 EPSF-2.0 +%%BoundingBox: 0 0 600 520 +%%Creator: mscgen 1 +%%EndComments +0.70 0.70 scale +0 0 moveto +0 520 lineto +600 520 lineto +600 0 lineto +closepath +clip +%PageTrailer +%Page: 1 1 +/Helvetica findfont +10 scalefont +setfont +0 520 translate +/mtrx matrix def +/ellipse + { /endangle exch def + /startangle exch def + /ydia exch def + /xdia exch def + /y exch def + /x exch def + /savematrix mtrx currentmatrix def + x y translate + xdia 2 div ydia 2 div scale + 0 0 1 startangle endangle arc + savematrix setmatrix +} def +150 -12 moveto (Client (or Node)) dup stringwidth pop 2 div neg 0 rmoveto show +450 -12 moveto (EPMD) dup stringwidth pop 2 div neg 0 rmoveto show +newpath 150 -20 moveto 150 -45 lineto stroke +newpath 450 -20 moveto 450 -45 lineto stroke +newpath 150 -32 moveto 450 -32 lineto stroke +newpath 450 -32 moveto 440 -38 lineto 440 -26 lineto closepath fill +270 -30 moveto (ALIVE2_REQ) show +newpath 150 -45 moveto 150 -70 lineto stroke +newpath 450 -45 moveto 450 -70 lineto stroke +[2] 0 setdash +newpath 450 -57 moveto 150 -57 lineto stroke +[] 0 setdash +newpath 150 -57 moveto 160 -63 lineto 160 -51 lineto closepath fill +267 -55 moveto (ALIVE2_RESP) show +[2] 0 setdash +newpath 150 -70 moveto 150 -95 lineto stroke +[] 0 setdash +[2] 0 setdash +newpath 450 -70 moveto 450 -95 lineto stroke +[] 0 setdash +newpath 150 -95 moveto 150 -120 lineto stroke +newpath 450 -95 moveto 450 -120 lineto stroke +newpath 150 -107 moveto 450 -107 lineto stroke +newpath 450 -107 moveto 440 -113 lineto 440 -101 lineto closepath fill +253 -105 moveto (ALIVE_CLOSE_REQ) show +[2] 0 setdash +newpath 150 -120 moveto 150 -145 lineto stroke +[] 0 setdash +[2] 0 setdash +newpath 450 -120 moveto 450 -145 lineto stroke +[] 0 setdash +newpath 150 -145 moveto 150 -170 lineto stroke +newpath 450 -145 moveto 450 -170 lineto stroke +newpath 150 -157 moveto 450 -157 lineto stroke +newpath 450 -157 moveto 440 -163 lineto 440 -151 lineto closepath fill +248 -155 moveto (PORT_PLEASE2_REQ) show +newpath 150 -170 moveto 150 -195 lineto stroke +newpath 450 -170 moveto 450 -195 lineto stroke +[2] 0 setdash +newpath 450 -182 moveto 150 -182 lineto stroke +[] 0 setdash +newpath 150 -182 moveto 160 -188 lineto 160 -176 lineto closepath fill +267 -180 moveto (PORT2_RESP) show +[2] 0 setdash +newpath 150 -195 moveto 150 -220 lineto stroke +[] 0 setdash +[2] 0 setdash +newpath 450 -195 moveto 450 -220 lineto stroke +[] 0 setdash +newpath 150 -220 moveto 150 -245 lineto stroke +newpath 450 -220 moveto 450 -245 lineto stroke +newpath 150 -232 moveto 450 -232 lineto stroke +newpath 450 -232 moveto 440 -238 lineto 440 -226 lineto closepath fill +269 -230 moveto (NAMES_REQ) show +newpath 150 -245 moveto 150 -270 lineto stroke +newpath 450 -245 moveto 450 -270 lineto stroke +[2] 0 setdash +newpath 450 -257 moveto 150 -257 lineto stroke +[] 0 setdash +newpath 150 -257 moveto 160 -263 lineto 160 -251 lineto closepath fill +266 -255 moveto (NAMES_RESP) show +[2] 0 setdash +newpath 150 -270 moveto 150 -295 lineto stroke +[] 0 setdash +[2] 0 setdash +newpath 450 -270 moveto 450 -295 lineto stroke +[] 0 setdash +newpath 150 -295 moveto 150 -320 lineto stroke +newpath 450 -295 moveto 450 -320 lineto stroke +newpath 150 -307 moveto 450 -307 lineto stroke +newpath 450 -307 moveto 440 -313 lineto 440 -301 lineto closepath fill +272 -305 moveto (DUMP_REQ) show +newpath 150 -320 moveto 150 -345 lineto stroke +newpath 450 -320 moveto 450 -345 lineto stroke +[2] 0 setdash +newpath 450 -332 moveto 150 -332 lineto stroke +[] 0 setdash +newpath 150 -332 moveto 160 -338 lineto 160 -326 lineto closepath fill +269 -330 moveto (DUMP_RESP) show +[2] 0 setdash +newpath 150 -345 moveto 150 -370 lineto stroke +[] 0 setdash +[2] 0 setdash +newpath 450 -345 moveto 450 -370 lineto stroke +[] 0 setdash +newpath 150 -370 moveto 150 -395 lineto stroke +newpath 450 -370 moveto 450 -395 lineto stroke +newpath 150 -382 moveto 450 -382 lineto stroke +newpath 450 -382 moveto 440 -388 lineto 440 -376 lineto closepath fill +277 -380 moveto (KILL_REQ) show +newpath 150 -395 moveto 150 -420 lineto stroke +newpath 450 -395 moveto 450 -420 lineto stroke +[2] 0 setdash +newpath 450 -407 moveto 150 -407 lineto stroke +[] 0 setdash +newpath 150 -407 moveto 160 -413 lineto 160 -401 lineto closepath fill +274 -405 moveto (KILL_RESP) show +[2] 0 setdash +newpath 150 -420 moveto 150 -445 lineto stroke +[] 0 setdash +[2] 0 setdash +newpath 450 -420 moveto 450 -445 lineto stroke +[] 0 setdash +newpath 150 -445 moveto 150 -470 lineto stroke +newpath 450 -445 moveto 450 -470 lineto stroke +newpath 150 -457 moveto 450 -457 lineto stroke +newpath 450 -457 moveto 440 -463 lineto 440 -451 lineto closepath fill +273 -455 moveto (STOP_REQ) show +newpath 150 -470 moveto 150 -495 lineto stroke +newpath 450 -470 moveto 450 -495 lineto stroke +[2] 0 setdash +newpath 450 -482 moveto 150 -482 lineto stroke +[] 0 setdash +newpath 150 -482 moveto 160 -488 lineto 160 -476 lineto closepath fill +260 -480 moveto (STOP_OK_RESP) show +newpath 150 -495 moveto 150 -520 lineto stroke +newpath 450 -495 moveto 450 -520 lineto stroke +[2] 0 setdash +newpath 450 -507 moveto 150 -507 lineto stroke +[] 0 setdash +newpath 150 -507 moveto 160 -513 lineto 160 -501 lineto closepath fill +250 -505 moveto (STOP_NOTOK_RESP) show diff --git a/erts/doc/src/erl_fix_alloc.fig b/erts/doc/src/erl_fix_alloc.fig new file mode 100644 index 0000000000..57db965a74 --- /dev/null +++ b/erts/doc/src/erl_fix_alloc.fig @@ -0,0 +1,104 @@ +#FIG 3.1 +Landscape +Center +Inches +1200 2 +6 300 1200 2850 3600 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 4 + 750 3600 750 1200 2325 1200 2325 3600 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 750 1500 2325 1500 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 750 1800 2325 1800 +2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 375 2100 2775 2100 +4 0 -1 0 0 0 12 0.0000 4 180 1275 900 2025 allocated_blocks\001 +4 0 -1 0 0 0 12 0.0000 4 180 630 1200 1725 free_list\001 +4 0 -1 0 0 0 12 0.0000 4 180 735 1200 1425 item_size\001 +-6 +6 3525 1200 5025 1800 +6 3525 1200 5025 1800 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 3525 1200 5025 1200 5025 1800 3525 1800 3525 1200 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 3525 1500 5025 1500 +-6 +4 0 -1 0 0 0 12 0.0000 4 105 330 4050 1425 next\001 +4 0 -1 0 0 0 12 0.0000 4 135 405 4050 1725 block\001 +-6 +6 5850 1200 7350 1800 +6 5850 1200 7350 1800 +2 2 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 5 + 5850 1200 7350 1200 7350 1800 5850 1800 5850 1200 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 0 0 2 + 5850 1500 7350 1500 +-6 +4 0 -1 0 0 0 12 0.0000 4 105 330 6375 1425 next\001 +4 0 -1 0 0 0 12 0.0000 4 135 405 6375 1725 block\001 +-6 +2 1 1 2 -1 7 0 0 -1 6.000 0 0 7 0 0 2 + 3450 5700 5400 5700 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 7 0 0 4 + 3600 8000 3600 3450 5175 3450 5175 8000 +2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 + 3525 6900 5325 6900 +2 2 1 0 -1 7 0 0 42 2.000 0 0 -1 0 0 5 + 3675 3525 5100 3525 5100 4425 3675 4425 3675 3525 +2 2 1 0 -1 7 0 0 42 2.000 0 0 -1 0 0 5 + 3675 5775 5100 5775 5100 6825 3675 6825 3675 5775 +2 1 2 1 -1 7 0 0 -1 3.000 0 0 -1 0 0 2 + 3600 4725 5250 4725 +2 1 2 1 -1 7 0 0 -1 3.000 0 0 -1 0 0 2 + 3600 4950 5175 4950 +2 2 2 0 -1 7 0 0 42 1.500 0 0 -1 0 0 5 + 6375 3750 6675 3750 6675 4050 6375 4050 6375 3750 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 + 1 1 1.00 60.00 120.00 + 4275 1800 4275 3400 +2 1 1 2 -1 7 0 0 -1 6.000 0 0 -1 0 0 2 + 3450 4500 5325 4500 +2 1 0 1 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 + 1 1 1.00 60.00 120.00 + 6600 1800 6600 2925 +2 1 0 2 -1 7 0 0 -1 0.000 0 0 -1 1 0 2 + 1 1 2.00 120.00 240.00 + 450 600 750 1125 +3 0 0 1 -1 7 0 0 -1 0.000 0 1 0 3 + 1 1 1.00 60.00 120.00 + 4875 1350 5400 1350 5775 1200 +3 0 0 1 -1 7 0 0 -1 0.000 0 1 0 3 + 1 1 1.00 60.00 120.00 + 7125 1350 7650 1350 8025 1200 +3 2 0 1 -1 7 0 0 -1 0.000 0 1 0 9 + 1 1 1.00 60.00 120.00 + 2175 1650 2475 1650 2625 1725 2775 1875 2775 2025 2775 4275 + 2850 4350 3000 4425 3450 4500 + 0.00 0.00 2346.89 1637.46 2421.89 1637.46 2514.58 1659.34 + 2593.04 1701.97 2665.43 1754.14 2753.11 1822.15 2790.48 1912.37 + 2775.00 1990.83 2775.01 2537.57 2542.79 3714.42 2785.95 4301.43 + 2829.79 4335.43 2881.96 4373.03 2962.69 4412.87 3076.12 4449.75 + 3188.62 4468.50 0.00 0.00 +3 2 0 1 -1 7 0 0 -1 0.000 0 1 0 8 + 1 1 1.00 60.00 120.00 + 5100 4575 5400 4575 5625 4725 5700 4950 5700 6675 5625 6825 + 5475 6900 5175 6975 + 0.00 0.00 5270.86 4558.61 5345.86 4558.61 5465.07 4594.70 + 5582.72 4669.65 5662.08 4773.55 5691.07 4895.01 5764.92 5349.99 + 5796.11 6267.84 5690.66 6714.58 5655.36 6794.64 5594.64 6855.36 + 5511.35 6886.55 5424.73 6918.60 5349.73 6937.35 0.00 0.00 +3 2 0 1 -1 7 0 0 -1 0.000 0 1 0 8 + 1 1 1.00 60.00 120.00 + 2250 1950 2475 1950 2625 1875 2775 1725 2925 1425 3000 1350 + 3150 1275 3450 1200 + 0.00 0.00 2378.92 1959.40 2435.17 1959.40 2514.58 1940.66 + 2593.04 1898.04 2665.43 1845.86 2745.86 1765.43 2821.07 1661.08 + 2878.93 1488.92 2939.57 1404.79 2979.79 1364.57 3031.96 1326.96 + 3113.65 1288.45 3200.27 1256.40 3275.27 1237.65 0.00 0.00 +4 0 -1 0 0 0 12 0.0000 4 180 720 3975 4650 next_free\001 +4 0 -1 0 0 0 12 0.0000 4 180 450 4050 4875 magic\001 +4 0 -1 0 0 2 14 0.0000 4 195 1860 6825 3975 = allocated memory\001 +4 0 -1 0 0 18 12 0.0000 4 135 1305 3675 1125 AllocatedBlock\001 +4 0 -1 0 0 18 12 0.0000 4 135 660 1575 1125 FixItem\001 +4 0 -1 0 0 18 12 0.0000 4 135 1020 2400 4650 FreeHeader\001 +4 0 -1 0 0 2 12 4.7124 4 180 765 5250 3600 item_size\001 +4 0 -1 0 0 2 18 0.0000 4 255 1080 300 525 fix_array\001 diff --git a/erts/doc/src/erl_fix_alloc.gif b/erts/doc/src/erl_fix_alloc.gif new file mode 100644 index 0000000000..c6b41ce801 Binary files /dev/null and b/erts/doc/src/erl_fix_alloc.gif differ diff --git a/erts/doc/src/erl_fix_alloc.ps b/erts/doc/src/erl_fix_alloc.ps new file mode 100644 index 0000000000..bf65d1556c --- /dev/null +++ b/erts/doc/src/erl_fix_alloc.ps @@ -0,0 +1,646 @@ +%!PS-Adobe-2.0 EPSF-2.0 +%%Title: erl_fix_alloc.fig +%%Creator: fig2dev Version 3.1 Patchlevel 2 +%%CreationDate: Tue May 20 11:10:33 1997 +%%For: jocke@akvavit (Joakim Greben|,ETX/B/DUP) +%Magnification: 1.00 +%%Orientation: Portrait +%%BoundingBox: 0 0 506 462 +%%Pages: 0 +%%BeginSetup +%%IncludeFeature: *PageSize A4 +%%EndSetup +%%EndComments +/MyAppDict 100 dict dup begin def +/$F2psDict 200 dict def +$F2psDict begin +$F2psDict /mtrx matrix put +/col-1 {0 setgray} bind def +/col0 {0.000 0.000 0.000 srgb} bind def +/col1 {0.000 0.000 1.000 srgb} bind def +/col2 {0.000 1.000 0.000 srgb} bind def +/col3 {0.000 1.000 1.000 srgb} bind def +/col4 {1.000 0.000 0.000 srgb} bind def +/col5 {1.000 0.000 1.000 srgb} bind def +/col6 {1.000 1.000 0.000 srgb} bind def +/col7 {1.000 1.000 1.000 srgb} bind def +/col8 {0.000 0.000 0.560 srgb} bind def +/col9 {0.000 0.000 0.690 srgb} bind def +/col10 {0.000 0.000 0.820 srgb} bind def +/col11 {0.530 0.810 1.000 srgb} bind def +/col12 {0.000 0.560 0.000 srgb} bind def +/col13 {0.000 0.690 0.000 srgb} bind def +/col14 {0.000 0.820 0.000 srgb} bind def +/col15 {0.000 0.560 0.560 srgb} bind def +/col16 {0.000 0.690 0.690 srgb} bind def +/col17 {0.000 0.820 0.820 srgb} bind def +/col18 {0.560 0.000 0.000 srgb} bind def +/col19 {0.690 0.000 0.000 srgb} bind def +/col20 {0.820 0.000 0.000 srgb} bind def +/col21 {0.560 0.000 0.560 srgb} bind def +/col22 {0.690 0.000 0.690 srgb} bind def +/col23 {0.820 0.000 0.820 srgb} bind def +/col24 {0.500 0.190 0.000 srgb} bind def +/col25 {0.630 0.250 0.000 srgb} bind def +/col26 {0.750 0.380 0.000 srgb} bind def +/col27 {1.000 0.500 0.500 srgb} bind def +/col28 {1.000 0.630 0.630 srgb} bind def +/col29 {1.000 0.750 0.750 srgb} bind def +/col30 {1.000 0.880 0.880 srgb} bind def +/col31 {1.000 0.840 0.000 srgb} bind def + +end +save +-18.0 481.0 translate +1 -1 scale +.9 .9 scale % to make patterns same scale as in xfig + +% This junk string is used by the show operators +/PATsstr 1 string def +/PATawidthshow { % cx cy cchar rx ry string + % Loop over each character in the string + { % cx cy cchar rx ry char + % Show the character + dup % cx cy cchar rx ry char char + PATsstr dup 0 4 -1 roll put % cx cy cchar rx ry char (char) + false charpath % cx cy cchar rx ry char + /clip load PATdraw + % Move past the character (charpath modified the + % current point) + currentpoint % cx cy cchar rx ry char x y + newpath + moveto % cx cy cchar rx ry char + % Reposition by cx,cy if the character in the string is cchar + 3 index eq { % cx cy cchar rx ry + 4 index 4 index rmoveto + } if + % Reposition all characters by rx ry + 2 copy rmoveto % cx cy cchar rx ry + } forall + pop pop pop pop pop % - + currentpoint + newpath + moveto +} bind def +/PATcg { + 7 dict dup begin + /lw currentlinewidth def + /lc currentlinecap def + /lj currentlinejoin def + /ml currentmiterlimit def + /ds [ currentdash ] def + /cc [ currentrgbcolor ] def + /cm matrix currentmatrix def + end +} bind def +% PATdraw - calculates the boundaries of the object and +% fills it with the current pattern +/PATdraw { % proc + save exch + PATpcalc % proc nw nh px py + 5 -1 roll exec % nw nh px py + newpath + PATfill % - + restore +} bind def +% PATfill - performs the tiling for the shape +/PATfill { % nw nh px py PATfill - + PATDict /CurrentPattern get dup begin + setfont + % Set the coordinate system to Pattern Space + PatternGState PATsg + % Set the color for uncolored pattezns + PaintType 2 eq { PATDict /PColor get PATsc } if + % Create the string for showing + 3 index string % nw nh px py str + % Loop for each of the pattern sources + 0 1 Multi 1 sub { % nw nh px py str source + % Move to the starting location + 3 index 3 index % nw nh px py str source px py + moveto % nw nh px py str source + % For multiple sources, set the appropriate color + Multi 1 ne { dup PC exch get PATsc } if + % Set the appropriate string for the source + 0 1 7 index 1 sub { 2 index exch 2 index put } for pop + % Loop over the number of vertical cells + 3 index % nw nh px py str nh + { % nw nh px py str + currentpoint % nw nh px py str cx cy + 2 index show % nw nh px py str cx cy + YStep add moveto % nw nh px py str + } repeat % nw nh px py str + } for + 5 { pop } repeat + end +} bind def + +% PATkshow - kshow with the current pattezn +/PATkshow { % proc string + exch bind % string proc + 1 index 0 get % string proc char + % Loop over all but the last character in the string + 0 1 4 index length 2 sub { + % string proc char idx + % Find the n+1th character in the string + 3 index exch 1 add get % string proe char char+1 + exch 2 copy % strinq proc char+1 char char+1 char + % Now show the nth character + PATsstr dup 0 4 -1 roll put % string proc chr+1 chr chr+1 (chr) + false charpath % string proc char+1 char char+1 + /clip load PATdraw + % Move past the character (charpath modified the current point) + currentpoint newpath moveto + % Execute the user proc (should consume char and char+1) + mark 3 1 roll % string proc char+1 mark char char+1 + 4 index exec % string proc char+1 mark... + cleartomark % string proc char+1 + } for + % Now display the last character + PATsstr dup 0 4 -1 roll put % string proc (char+1) + false charpath % string proc + /clip load PATdraw + neewath + pop pop % - +} bind def +% PATmp - the makepattern equivalent +/PATmp { % patdict patmtx PATmp patinstance + exch dup length 7 add % We will add 6 new entries plus 1 FID + dict copy % Create a new dictionary + begin + % Matrix to install when painting the pattern + TilingType PATtcalc + /PatternGState PATcg def + PatternGState /cm 3 -1 roll put + % Check for multi pattern sources (Level 1 fast color patterns) + currentdict /Multi known not { /Multi 1 def } if + % Font dictionary definitions + /FontType 3 def + % Create a dummy encoding vector + /Encoding 256 array def + 3 string 0 1 255 { + Encoding exch dup 3 index cvs cvn put } for pop + /FontMatrix matrix def + /FontBBox BBox def + /BuildChar { + mark 3 1 roll % mark dict char + exch begin + Multi 1 ne {PaintData exch get}{pop} ifelse % mark [paintdata] + PaintType 2 eq Multi 1 ne or + { XStep 0 FontBBox aload pop setcachedevice } + { XStep 0 setcharwidth } ifelse + currentdict % mark [paintdata] dict + /PaintProc load % mark [paintdata] dict paintproc + end + gsave + false PATredef exec true PATredef + grestore + cleartomark % - + } bind def + currentdict + end % newdict + /foo exch % /foo newlict + definefont % newfont +} bind def +% PATpcalc - calculates the starting point and width/height +% of the tile fill for the shape +/PATpcalc { % - PATpcalc nw nh px py + PATDict /CurrentPattern get begin + gsave + % Set up the coordinate system to Pattern Space + % and lock down pattern + PatternGState /cm get setmatrix + BBox aload pop pop pop translate + % Determine the bounding box of the shape + pathbbox % llx lly urx ury + grestore + % Determine (nw, nh) the # of cells to paint width and height + PatHeight div ceiling % llx lly urx qh + 4 1 roll % qh llx lly urx + PatWidth div ceiling % qh llx lly qw + 4 1 roll % qw qh llx lly + PatHeight div floor % qw qh llx ph + 4 1 roll % ph qw qh llx + PatWidth div floor % ph qw qh pw + 4 1 roll % pw ph qw qh + 2 index sub cvi abs % pw ph qs qh-ph + exch 3 index sub cvi abs exch % pw ph nw=qw-pw nh=qh-ph + % Determine the starting point of the pattern fill + %(px, py) + 4 2 roll % nw nh pw ph + PatHeight mul % nw nh pw py + exch % nw nh py pw + PatWidth mul exch % nw nh px py + end +} bind def + +% Save the original routines so that we can use them later on +/oldfill /fill load def +/oldeofill /eofill load def +/oldstroke /stroke load def +/oldshow /show load def +/oldashow /ashow load def +/oldwidthshow /widthshow load def +/oldawidthshow /awidthshow load def +/oldkshow /kshow load def + +% These defs are necessary so that subsequent procs don't bind in +% the originals +/fill { oldfill } bind def +/eofill { oldeofill } bind def +/stroke { oldstroke } bind def +/show { oldshow } bind def +/ashow { oldashow } bind def +/widthshow { oldwidthshow } bind def +/awidthshow { oldawidthshow } bind def +/kshow { oldkshow } bind def +/PATredef { + MyAppDict begin + { + /fill { /clip load PATdraw newpath } bind def + /eofill { /eoclip load PATdraw newpath } bind def + /stroke { PATstroke } bind def + /show { 0 0 null 0 0 6 -1 roll PATawidthshow } bind def + /ashow { 0 0 null 6 3 roll PATawidthshow } + bind def + /widthshow { 0 0 3 -1 roll PATawidthshow } + bind def + /awidthshow { PATawidthshow } bind def + /kshow { PATkshow } bind def + } { + /fill { oldfill } bind def + /eofill { oldeofill } bind def + /stroke { oldstroke } bind def + /show { oldshow } bind def + /ashow { oldashow } bind def + /widthshow { oldwidthshow } bind def + /awidthshow { oldawidthshow } bind def + /kshow { oldkshow } bind def + } ifelse + end +} bind def +false PATredef +% Conditionally define setcmykcolor if not available +/setcmykcolor where { pop } { + /setcmykcolor { + 1 sub 4 1 roll + 3 { + 3 index add neg dup 0 lt { pop 0 } if 3 1 roll + } repeat + setrgbcolor - pop + } bind def +} ifelse +/PATsc { % colorarray + aload length % c1 ... cn length + dup 1 eq { pop setgray } { 3 eq { setrgbcolor } { setcmykcolor + } ifelse } ifelse +} bind def +/PATsg { % dict + begin + lw setlinewidth + lc setlinecap + lj setlinejoin + ml setmiterlimit + ds aload pop setdash + cc aload pop setrgbcolor + cm setmatrix + end +} bind def + +/PATDict 3 dict def +/PATsp { + true PATredef + PATDict begin + /CurrentPattern exch def + % If it's an uncolored pattern, save the color + CurrentPattern /PaintType get 2 eq { + /PColor exch def + } if + /CColor [ currentrgbcolor ] def + end +} bind def +% PATstroke - stroke with the current pattern +/PATstroke { + countdictstack + save + mark + { + currentpoint strokepath moveto + PATpcalc % proc nw nh px py + clip newpath PATfill + } stopped { + (*** PATstroke Warning: Path is too complex, stroking + with gray) = + cleartomark + restore + countdictstack exch sub dup 0 gt + { { end } repeat } { pop } ifelse + gsave 0.5 setgray oldstroke grestore + } { pop restore pop } ifelse + newpath +} bind def +/PATtcalc { % modmtx tilingtype PATtcalc tilematrix + % Note: tiling types 2 and 3 are not supported + gsave + exch concat % tilingtype + matrix currentmatrix exch % cmtx tilingtype + % Tiling type 1 and 3: constant spacing + 2 ne { + % Distort the pattern so that it occupies + % an integral number of device pixels + dup 4 get exch dup 5 get exch % tx ty cmtx + XStep 0 dtransform + round exch round exch % tx ty cmtx dx.x dx.y + XStep div exch XStep div exch % tx ty cmtx a b + 0 YStep dtransform + round exch round exch % tx ty cmtx a b dy.x dy.y + YStep div exch YStep div exch % tx ty cmtx a b c d + 7 -3 roll astore % { a b c d tx ty } + } if + grestore +} bind def +/PATusp { + false PATredef + PATDict begin + CColor PATsc + end +} bind def + +% right30 +11 dict begin +/PaintType 1 def +/PatternType 1 def +/TilingType 1 def +/BBox [0 0 1 1] def +/XStep 1 def +/YStep 1 def +/PatWidth 1 def +/PatHeight 1 def +/Multi 2 def +/PaintData [ + { clippath } bind + { 32 16 true [ 32 0 0 -16 0 16 ] + {<00030003000c000c0030003000c000c0030003000c000c00 + 30003000c000c00000030003000c000c0030003000c000c0 + 030003000c000c0030003000c000c000>} + imagemask } bind +] def +/PaintProc { + pop + exec fill +} def +currentdict +end +/P2 exch def +1.1111 1.1111 scale %restore scale + +/cp {closepath} bind def +/ef {eofill} bind def +/gr {grestore} bind def +/gs {gsave} bind def +/sa {save} bind def +/rs {restore} bind def +/l {lineto} bind def +/m {moveto} bind def +/rm {rmoveto} bind def +/n {newpath} bind def +/s {stroke} bind def +/sh {show} bind def +/slc {setlinecap} bind def +/slj {setlinejoin} bind def +/slw {setlinewidth} bind def +/srgb {setrgbcolor} bind def +/rot {rotate} bind def +/sc {scale} bind def +/sd {setdash} bind def +/ff {findfont} bind def +/sf {setfont} bind def +/scf {scalefont} bind def +/sw {stringwidth} bind def +/tr {translate} bind def +/tnt {dup dup currentrgbcolor + 4 -2 roll dup 1 exch sub 3 -1 roll mul add + 4 -2 roll dup 1 exch sub 3 -1 roll mul add + 4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb} + bind def +/shd {dup dup currentrgbcolor 4 -2 roll mul 4 -2 roll mul + 4 -2 roll mul srgb} bind def + /DrawSplineSection { + /y3 exch def + /x3 exch def + /y2 exch def + /x2 exch def + /y1 exch def + /x1 exch def + /xa x1 x2 x1 sub 0.666667 mul add def + /ya y1 y2 y1 sub 0.666667 mul add def + /xb x3 x2 x3 sub 0.666667 mul add def + /yb y3 y2 y3 sub 0.666667 mul add def + x1 y1 lineto + xa ya xb yb x3 y3 curveto + } def + +/$F2psBegin {$F2psDict begin /$F2psEnteredState save def} def +/$F2psEnd {$F2psEnteredState restore end} def +%%EndProlog + +$F2psBegin +10 setmiterlimit +n 0 842 m 0 0 l 595 0 l 595 842 l cp clip + 0.06000 0.06000 sc +7.500 slw +% Polyline +n 750 3600 m 750 1200 l 2325 1200 l 2325 3600 l gs col-1 s gr +% Polyline +n 750 1500 m 2325 1500 l gs col-1 s gr +% Polyline +n 750 1800 m 2325 1800 l gs col-1 s gr +15.000 slw +% Polyline +n 375 2100 m 2775 2100 l gs col-1 s gr +/Times-Roman ff 180.00 scf sf +900 2025 m +gs 1 -1 sc (allocated_blocks) col-1 sh gr +/Times-Roman ff 180.00 scf sf +1200 1725 m +gs 1 -1 sc (free_list) col-1 sh gr +/Times-Roman ff 180.00 scf sf +1200 1425 m +gs 1 -1 sc (item_size) col-1 sh gr +7.500 slw +% Polyline +n 3525 1200 m 5025 1200 l 5025 1800 l 3525 1800 l cp gs col-1 s gr +% Polyline +n 3525 1500 m 5025 1500 l gs col-1 s gr +/Times-Roman ff 180.00 scf sf +4050 1425 m +gs 1 -1 sc (next) col-1 sh gr +/Times-Roman ff 180.00 scf sf +4050 1725 m +gs 1 -1 sc (block) col-1 sh gr +% Polyline +n 5850 1200 m 7350 1200 l 7350 1800 l 5850 1800 l cp gs col-1 s gr +% Polyline +n 5850 1500 m 7350 1500 l gs col-1 s gr +/Times-Roman ff 180.00 scf sf +6375 1425 m +gs 1 -1 sc (next) col-1 sh gr +/Times-Roman ff 180.00 scf sf +6375 1725 m +gs 1 -1 sc (block) col-1 sh gr +15.000 slw +% Polyline + [100.0] 0 sd +n 3450 5700 m 5400 5700 l gs col-1 s gr [] 0 sd +7.500 slw +% Polyline +n 3600 8000 m 3600 3450 l 5175 3450 l 5175 8000 l gs col-1 s gr +15.000 slw +% Polyline + [100.0] 0 sd +n 3525 6900 m 5325 6900 l gs col-1 s gr [] 0 sd +0.000 slw +% Polyline + [33.3] 0 sd +n 3675 3525 m 5100 3525 l 5100 4425 l 3675 4425 l cp gs /PC [[1.00 1.00 1.00] [0.00 0.00 0.00]] def +15.00 15.00 sc P2 [16 0 0 -8 245.00 235.00] PATmp PATsp ef gr PATusp [] 0 sd +% Polyline + [33.3] 0 sd +n 3675 5775 m 5100 5775 l 5100 6825 l 3675 6825 l cp gs /PC [[1.00 1.00 1.00] [0.00 0.00 0.00]] def +15.00 15.00 sc P2 [16 0 0 -8 245.00 385.00] PATmp PATsp ef gr PATusp [] 0 sd +7.500 slw +% Polyline + [15 50.0] 50.0 sd +n 3600 4725 m 5250 4725 l gs col-1 s gr [] 0 sd +% Polyline + [15 50.0] 50.0 sd +n 3600 4950 m 5175 4950 l gs col-1 s gr [] 0 sd +0.000 slw +% Polyline + [15 25.0] 25.0 sd +n 6375 3750 m 6675 3750 l 6675 4050 l 6375 4050 l cp gs /PC [[1.00 1.00 1.00] [0.00 0.00 0.00]] def +15.00 15.00 sc P2 [16 0 0 -8 425.00 250.00] PATmp PATsp ef gr PATusp [] 0 sd +7.500 slw +% Polyline +gs clippath +4305 3253 m 4275 3373 l 4245 3253 l 4245 3415 l 4305 3415 l cp clip +n 4275 1800 m 4275 3400 l gs col-1 s gr gr + +% arrowhead +n 4305 3253 m 4275 3373 l 4245 3253 l 4275 3253 l 4305 3253 l cp gs 0.00 setgray ef gr col-1 s +15.000 slw +% Polyline + [100.0] 0 sd +n 3450 4500 m 5325 4500 l gs col-1 s gr [] 0 sd +7.500 slw +% Polyline +gs clippath +6630 2778 m 6600 2898 l 6570 2778 l 6570 2940 l 6630 2940 l cp clip +n 6600 1800 m 6600 2925 l gs col-1 s gr gr + +% arrowhead +n 6630 2778 m 6600 2898 l 6570 2778 l 6600 2778 l 6630 2778 l cp gs 0.00 setgray ef gr col-1 s +15.000 slw +% Polyline +gs clippath +656 840 m 723 1078 l 552 900 l 713 1181 l 817 1121 l cp clip +n 450 600 m 750 1125 l gs col-1 s gr gr + +% arrowhead +n 656 840 m 723 1078 l 552 900 l 604 870 l 656 840 l cp gs 0.00 setgray ef gr col-1 s +% Open spline +gs clippath +5627 1227 m 5749 1210 l 5650 1282 l 5800 1222 l 5778 1167 l cp clip +7.500 slw +n 4875.0 1350.0 m 5137.5 1350.0 l + 5137.5 1350.0 5400.0 1350.0 5587.5 1275.0 DrawSplineSection + 5775.0 1200.0 l gs col-1 s gr + gr + +% arrowhead +n 5627 1227 m 5749 1210 l 5650 1282 l 5639 1255 l 5627 1227 l cp gs 0.00 setgray ef gr col-1 s +% Open spline +gs clippath +7877 1227 m 7999 1210 l 7900 1282 l 8050 1222 l 8028 1167 l cp clip +n 7125.0 1350.0 m 7387.5 1350.0 l + 7387.5 1350.0 7650.0 1350.0 7837.5 1275.0 DrawSplineSection + 8025.0 1200.0 l gs col-1 s gr + gr + +% arrowhead +n 7877 1227 m 7999 1210 l 7900 1282 l 7889 1255 l 7877 1227 l cp gs 0.00 setgray ef gr col-1 s +% Interp Spline +gs clippath +3308 4453 m 3423 4496 l 3300 4512 l 3461 4532 l 3468 4472 l cp clip +n 2175 1650 m + 2346.9 1637.5 2421.9 1637.5 2475 1650 curveto + 2514.6 1659.3 2593.0 1702.0 2625 1725 curveto + 2665.4 1754.1 2753.1 1822.2 2775 1875 curveto + 2790.5 1912.4 2775.0 1990.8 2775 2025 curveto + 2775.0 2537.6 2542.8 3714.4 2775 4275 curveto + 2785.9 4301.4 2829.8 4335.4 2850 4350 curveto + 2882.0 4373.0 2962.7 4412.9 3000 4425 curveto + 3076.1 4449.8 3188.6 4468.5 3450 4500 curveto + gs col-1 s gr + gr + +% arrowhead +n 3308 4453 m 3423 4496 l 3300 4512 l 3304 4483 l 3308 4453 l cp gs 0.00 setgray ef gr col-1 s +% Interp Spline +gs clippath +5325 6973 m 5201 6969 l 5312 6914 l 5154 6949 l 5167 7007 l cp clip +n 5100 4575 m + 5270.9 4558.6 5345.9 4558.6 5400 4575 curveto + 5465.1 4594.7 5582.7 4669.6 5625 4725 curveto + 5662.1 4773.6 5691.1 4895.0 5700 4950 curveto + 5764.9 5350.0 5796.1 6267.8 5700 6675 curveto + 5690.7 6714.6 5655.4 6794.6 5625 6825 curveto + 5594.6 6855.4 5511.4 6886.6 5475 6900 curveto + 5424.7 6918.6 5349.7 6937.4 5175 6975 curveto + gs col-1 s gr + gr + +% arrowhead +n 5325 6973 m 5201 6969 l 5312 6914 l 5319 6944 l 5325 6973 l cp gs 0.00 setgray ef gr col-1 s +% Interp Spline +gs clippath +3300 1202 m 3423 1205 l 3313 1261 l 3471 1226 l 3458 1168 l cp clip +n 2250 1950 m + 2378.9 1959.4 2435.2 1959.4 2475 1950 curveto + 2514.6 1940.7 2593.0 1898.0 2625 1875 curveto + 2665.4 1845.9 2745.9 1765.4 2775 1725 curveto + 2821.1 1661.1 2878.9 1488.9 2925 1425 curveto + 2939.6 1404.8 2979.8 1364.6 3000 1350 curveto + 3032.0 1327.0 3113.7 1288.5 3150 1275 curveto + 3200.3 1256.4 3275.3 1237.7 3450 1200 curveto + gs col-1 s gr + gr + +% arrowhead +n 3300 1202 m 3423 1205 l 3313 1261 l 3306 1231 l 3300 1202 l cp gs 0.00 setgray ef gr col-1 s +/Times-Roman ff 180.00 scf sf +3975 4650 m +gs 1 -1 sc (next_free) col-1 sh gr +/Times-Roman ff 180.00 scf sf +4050 4875 m +gs 1 -1 sc (magic) col-1 sh gr +/Times-Bold ff 210.00 scf sf +6825 3975 m +gs 1 -1 sc (= allocated memory) col-1 sh gr +/Helvetica-Bold ff 180.00 scf sf +3675 1125 m +gs 1 -1 sc (AllocatedBlock) col-1 sh gr +/Helvetica-Bold ff 180.00 scf sf +1575 1125 m +gs 1 -1 sc (FixItem) col-1 sh gr +/Helvetica-Bold ff 180.00 scf sf +2400 4650 m +gs 1 -1 sc (FreeHeader) col-1 sh gr +/Times-Bold ff 180.00 scf sf +5250 3600 m +gs 1 -1 sc 270.0 rot (item_size) col-1 sh gr +/Times-Bold ff 270.00 scf sf +300 525 m +gs 1 -1 sc (fix_array) col-1 sh gr +$F2psEnd +rs +end diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml new file mode 100644 index 0000000000..c636d65ef3 --- /dev/null +++ b/erts/doc/src/erl_nif.xml @@ -0,0 +1,351 @@ + + + + +
+ + 20012009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erl_nif + Sverker Eriksson + Sverker Eriksson + 1 + + + 2009-11-17 + PA1 + erl_nif.xml +
+ erl_nif + API functions for an Erlang NIF library + +

The NIF concept is introduced in R13B03 as an + EXPERIMENTAL feature. The interfaces may be changed in any way + in coming releases. The API introduced in this release is very + sparse and contains only the most basic functions to read and + write Erlang terms. +

+ +

A NIF library contains native implementation of some functions + of an erlang module. The native implemented functions (NIFs) are + called like any other functions without any difference to the + caller. Each NIF must also have an implementation in Erlang that + will be invoked if the function is called before the NIF library + has been successfully loaded. A typical such stub implementation + is to throw an exception. But it can also be used as a fallback + implementation if the NIF library is not implemented for some + architecture.

+

A minimal example of a NIF library can look like this:

+

+ +/* niftest.c */ +#include "erl_nif.h" + +static ERL_NIF_TERM hello(ErlNifEnv* env) +{ + return enif_make_string(env, "Hello world!"); +} + +static ErlNifFunc nif_funcs[] = +{ + {"hello", 0, hello} +}; + +ERL_NIF_INIT(niftest,nif_funcs,NULL,NULL,NULL,NULL) + + +

and the erlang module would have to look something like + this:

+

+ +-module(niftest). + +-export([init/0, hello/0]). + +init() -> + erlang:load_nif("./niftest", 0). + +hello() -> + "NIF library not loaded". + +

and compile and test something like this (on Linux):

+

+ +$> gcc -fPIC -shared -o niftest.so niftest.c -I $ERL_ROOT/usr/include/ +$> erl + +1> c(niftest). +{ok,niftest} +2> niftest:hello(). +"NIF library not loaded" +3> niftest:init(). +ok +4> niftest:hello(). +"Hello world!" + + +

A better solution for a real module is to take advantage of + the new attribute on_load to automatically load the NIF + library when the module is loaded.

+

A loaded NIF library is tied to the Erlang module code version + that loaded it. If the module is upgraded with a new version, the + new code will have to load its own NIF library (or maybe choose not + to). The new code version can however choose to load the exact + same NIF library as the old code if it wants to. Sharing the same + dynamic library will mean that static data defined by the library + will be shared as well. To avoid unintentionally shared static + data, each Erlang module code can keep its own private data. This + global private data can be set when the NIF library is loaded and + then retrieved by calling enif_get_data().

+

There is currently no way to explicitly unload a NIF + library. A library will be automatically unloaded when the module + code that it belongs to is purged by the code server. A NIF + library will can also be unloaded by replacing it with another + version of the library by a second call to + erlang:load_nif/2 from the same module code.

+ + +
+ INITIALIZATION + + ERL_NIF_INIT(MODULE, ErlNifFunc funcs[], load, reload, upgrade, unload) +

This is the magic macro to initialize a NIF library. It + should be evaluated in global file scope.

+

MODULE is the name of the Erlang module as an + identifier without string quotations. It will be stringified by + the macro.

+

funcs is a static array of function descriptors for + all the implemented NIFs in this library.

+

load, reload, upgrade and unload + are pointers to functions. One of load, reload or + upgrade will be called to initialize the library. + unload is called to release the library. They are all + described individually below.

+ + + int (*load)(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +

load is called when the NIF library is loaded + and there is no previously loaded library for this module.

+

*priv_data can be set to point to some private data + that the library needs in able to keep a state between NIF + calls. enif_get_data() will return this pointer.

+

load_info is the second argument to erlang:load_nif/2.

+

The library will fail to load if load returns + anything other than 0. load can be NULL in case no + initialization is needed.

+ + + int (*reload)(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +

reload is called when the NIF library is loaded + and there is already a previously loaded library for this + module code.

+

Works the same as load. The only difference is that + *priv_data already contains the value set by the + previous call to load or reload.

+

The library will fail to load if reload returns + anything other than 0 or if reload is NULL.

+ + + int (*upgrade)(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) +

upgrade is called when the NIF library is loaded + and there is no previously loaded library for this module + code, BUT there is old code of this module with a + loaded NIF library.

+

Works the same as load. The only difference is that + *old_priv_data already contains the value set by the + last call to load or reload for the old module + code. It is allowed to write to both *priv_data and + *old_priv_data.

+

The library will fail to load if upgrade returns + anything other than 0 or if upgrade is NULL.

+ + + void (*unload)(ErlNifEnv* env, void* priv_data) +

unload is called when the module code that + the NIF library belongs to is purged as old. New code + of the same module may or may not exist.

+ + + + +
+ +
+ DATA TYPES + + + ErlDrvEnv + +

ErlNifEnv contains information about the context in + which a NIF call is made. This pointer should not be + dereferenced in any way, but only passed on to API + functions. An ErlNifEnv pointer is only valid until + the function, where is what supplied as argument, + returns. There is thus useless and dangerous to store ErlNifEnv + pointers in between NIF calls.

+ + ErlNifFunc + +

+ +typedef struct { + const char* name; + unsigned arity; + ERL_NIF_TERM (*fptr)(ErlNifEnv* env, ...); +} ErlNifFunc; + +

Describes a NIF by its name, arity and implementation. + fptr is a pointer to the function that implements the + NIF. The number of arguments must match the arity. A NIF of + arity 2 will thus look like:

+

+ +ERL_NIF_TERM my_nif(ErlNifEnv* env, ERL_NIF_TERM arg1, ERL_NIF_TERM arg2) +{ + /* ... */ +} + +

The maximum allowed arity for a NIF is 3 in current implementation.

+ + ErlNifBinary + +

+ +typedef struct { + unsigned size; + unsigned char* data; +} ErlNifBinary; + +

ErlNifBinary contains transient information about an + inspected binary term. data is a pointer to a buffer + of size bytes with the raw content of the binary.

+ + ERL_NIF_TERM + +

Variables of type ERL_NIF_TERM can refere to any + Erlang term. This is an opaque type and values of it can only + by used either as arguments to API functions or as return + values from NIFs. A variable of type ERL_NIF_TERM is + only valid until the NIF call, where it was obtained, + returns.

+ + +
+ + + void*enif_get_data(ErlNifEnv* env) + Get the private data of a NIF library +

Returns the pointer to the private data that was set by load, reload or upgrade.

 + + void*enif_alloc(ErlNifEnv* env, size_t size) + Allocate dynamic memory. +

Allocate memory of size bytes.

 + + voidenif_free(ErlNifEnv* env, void* ptr) + Free dynamic memory +

Free memory allocated by enif_alloc.

 + + intenif_is_binary(ErlNifEnv* env, ERL_NIF_TERM term) + Determine if a term is a binary +

Return true if term is a binary

 + + intenif_inspect_binary(ErlNifEnv* env, ERL_NIF_TERM bin_term, ErlNifBinary* bin) + Inspect the content of a binary +

Initialize the structure pointed to by bin with + transient information about the binary term + bin_term. Return false if bin_term is not a binary.

 + + intenif_alloc_binary(ErlNifEnv* env, unsigned size, ErlNifBinary* bin) + Create a new binary. +

Allocate a new binary of size of size + bytes. Initialize the structure pointed to by bin to + refer to the allocated binary.

 + + voidenif_release_binary(ErlNifEnv* env, ErlNifBinary* bin) + Release a binary. +

Release a binary obtained from enif_alloc_binary or enif_inspect_binary.

 + + intenif_get_int(ErlNifEnv* env, ERL_NIF_TERM term, int* ip) + Read an integer term. +

Set *ip to the integer value of + term or return false if term is not an integer or is + outside the bounds of type int

 + + intenif_get_ulong(ErlNifEnv* env, ERL_NIF_TERM term, unsigned long* ip) + Read an unsigned long integer +

Set *ip to the unsigned long integer value of + term or return false if term is not an unsigned + integer or is outside the bounds of type unsigned long

 + + intenif_get_list_cell(ErlNifEnv* env, ERL_NIF_TERM list, ERL_NIF_TERM* head, ERL_NIF_TERM* tail) + Get head and tail from a list +

Set *head and *tail from + list or return false if list is not a non-empty + list.

 + + ERL_NIF_TERMenif_make_binary(ErlNifEnv* env, ErlNifBinary* bin) + Make a binary term. +

Make a binary term from bin. Will also release + the binary.

 + + ERL_NIF_TERMenif_make_badarg(ErlNifEnv* env) + Make a badarg exception. +

Make a badarg exception to be returned from a NIF.

 + + ERL_NIF_TERMenif_make_int(ErlNifEnv* env, int i) + Create an integer term +

Create an integer term.

 + + ERL_NIF_TERMenif_make_ulong(ErlNifEnv* env, unsigned long i) + Create an integer term from an unsigned long int +

Create an integer term from an unsigned long int.

 + + ERL_NIF_TERMenif_make_atom(ErlNifEnv* env, const char* name) + Create an atom term +

Create an atom term from the C-string name. Atom + terms may be saved and used between NIF calls.

 + + ERL_NIF_TERMenif_make_tuple(ErlNifEnv* env, unsigned cnt, ...) + Create a tuple term. +

Create a tuple term of arity cnt. Expects + cnt number of arguments (after cnt) of type ERL_NIF_TERM as the + elements of the tuple.

 + + ERL_NIF_TERMenif_make_list(ErlNifEnv* env, unsigned cnt, ...) + Create a list term. +

Create an ordinary list term of length cnt. Expects + cnt number of arguments (after cnt) of type ERL_NIF_TERM as the + elements of the list. An empty list is returned if cnt is 0.

 + + ERL_NIF_TERMenif_make_list_cell(ErlNifEnv* env, ERL_NIF_TERM head, ERL_NIF_TERM tail) + Create a list cell. +

Create a list cell [head | tail].

 + + ERL_NIF_TERMenif_make_string(ErlNifEnv* env, const char* string) + Create a string. +

Creates a list containing the characters of the + C-string string.

 + + +
+ SEE ALSO +

load_nif(3)

+
+ + diff --git a/erts/doc/src/erl_prim_loader.xml b/erts/doc/src/erl_prim_loader.xml new file mode 100644 index 0000000000..ccaa9b725f --- /dev/null +++ b/erts/doc/src/erl_prim_loader.xml @@ -0,0 +1,251 @@ + + + + +
+ + 19962009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erl_prim_loader + + + + + erl_prim_loader.xml +
+ erl_prim_loader + Low Level Erlang Loader + +

erl_prim_loader is used to load all Erlang modules into + the system. The start script is also fetched with this low level + loader.

+

erl_prim_loader knows about the environment and how to + fetch modules. The loader could, for example, fetch files using + the file system (with absolute file names as input), or a + database (where the binary format of a module is stored).

+

The -loader Loader command line flag can be used to + choose the method used by the erl_prim_loader. Two + Loader methods are supported by the Erlang runtime system: + efile and inet. If another loader is required, then + it has to be implemented by the user. The Loader provided + by the user must fulfill the protocol defined below, and it is + started with the erl_prim_loader by evaluating + open_port({spawn,Loader},[binary]).

+ +

The support for loading of code from archive files is + experimental. The sole purpose of releasing it before it is ready + is to obtain early feedback. The file format, semantics, + interfaces etc. may be changed in a future release. The functions + list_dir/1 and read_file_info/1 as well as the flag + -loader_debug are also experimental

 + + + + + start(Id, Loader, Hosts) -> {ok, Pid} | {error, What} + Start the Erlang low level loader + + Id = term() + Loader = atom() | string() + Hosts = [Host] + Host = atom() + Pid = pid() + What = term() + + +

Starts the Erlang low level loader. This function is called + by the init process (and module). The init + process reads the command line flags -id Id, + -loader Loader, and -hosts Hosts. These are + the arguments supplied to the start/3 function.

+

If -loader is not given, the default loader is + efile which tells the system to read from the file + system.

+

If -loader is inet, the -id Id, + -hosts Hosts, and -setcookie Cookie flags must + also be supplied. Hosts identifies hosts which this + node can contact in order to load modules. One Erlang + runtime system with a erl_boot_server process must be + started on each of hosts given in Hosts in order to + answer the requests. See erl_boot_server(3).

+

If -loader is something else, the given port program + is started. The port program is supposed to follow + the protocol specified below.

+ + + + get_file(Filename) -> {ok, Bin, FullName} | error + Get a file + + Filename = string() + Bin = binary() + FullName = string() + + +

This function fetches a file using the low level loader. + Filename is either an absolute file name or just the name + of the file, for example "lists.beam". If an internal + path is set to the loader, this path is used to find the file. + If a user supplied loader is used, the path can be stripped + off if it is obsolete, and the loader does not use a path. + FullName is the complete name of the fetched file. + Bin is the contents of the file as a binary.

+ +

The Filename can also be a file in an archive. For example + /otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin/mnesia_backup.beam + See code(3) about archive files.

+ + + + get_path() -> {ok, Path} + Get the path set in the loader + + Path = [Dir] + Dir = string() + + +

This function gets the path set in the loader. The path is + set by the init process according to information found + in the start script.

+ + + + list_dir(Dir) -> {ok, Filenames} | error + List files in a directory + + Dir = name() + Filenames = [Filename] + Filename = string() + + +

Lists all the files in a directory. Returns + {ok, Filenames} if successful. Otherwise, it returns + error. Filenames is a list of + the names of all the files in the directory. The names are + not sorted.

+

The Dir can also be a directory in an archive. For example + /otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin + See code(3) about archive files.

+ + + + read_file_info(Filename) -> {ok, FileInfo} | error + Get information about a file + + Filename = name() + FileInfo = #file_info{} + + +

Retrieves information about a file. Returns + {ok, FileInfo} if successful, otherwise + error. FileInfo is a record + file_info, defined in the Kernel include file + file.hrl. Include the following directive in the module + from which the function is called:

+ +-include_lib("kernel/include/file.hrl"). +

See file(3) for more info about + the record file_info.

+

The Filename can also be a file in an archive. For example + /otp/root/lib/mnesia-4.4.7.ez/mnesia-4.4.7/ebin/mnesia_backup.beam + See code(3) about archive files.

+ + + + set_path(Path) -> ok + Set the path of the loader + + Path = [Dir] + Dir = string() + + +

This function sets the path of the loader if init + interprets a path command in the start script.

+ + + + +
+ Protocol +

The following protocol must be followed if a user provided + loader port program is used. The Loader port program is + started with the command + open_port({spawn,Loader},[binary]). The protocol is as + follows:

+ 
+Function          Send               Receive
+-------------------------------------------------------------
+get_file          [102 | FileName]   [121 | BinaryFile] (on success)
+                                     [122]              (failure)
+
+stop              eof                terminate
+
+ +
+ Command Line Flags +

The erl_prim_loader module interprets the following + command line flags:

+ + -loader Loader + +

Specifies the name of the loader used by + erl_prim_loader. Loader can be efile + (use the local file system), or inet (load using + the boot_server on another Erlang node). If + Loader is user defined, the defined Loader port + program is started.

+

If the -loader flag is omitted, it defaults to + efile.

+ + -loader_debug + +

Makes the efile loader write some debug information, + such as the reason for failures, while it handles files.

+ + -hosts Hosts + +

Specifies which other Erlang nodes the inet loader + can use. This flag is mandatory if the -loader inet + flag is present. On each host, there must be on Erlang node + with the erl_boot_server which handles the load + requests. Hosts is a list of IP addresses (hostnames + are not acceptable).

+ + -id Id + +

Specifies the identity of the Erlang runtime system. If + the system runs as a distributed node, Id must be + identical to the name supplied with the -sname or + -name distribution flags.

+ + -setcookie Cookie + +

Specifies the cookie of the Erlang runtime system. This flag + is mandatory if the -loader inet flag is present.

+ + +
+ +
+ SEE ALSO +

init(3), + erl_boot_server(3)

+
+ + diff --git a/erts/doc/src/erl_set_memory_block.xml b/erts/doc/src/erl_set_memory_block.xml new file mode 100644 index 0000000000..d77da56d95 --- /dev/null +++ b/erts/doc/src/erl_set_memory_block.xml @@ -0,0 +1,172 @@ + + + + +
+ + 19982009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erl_set_memory_block + Patrik Nyblom + + + + + 98-08-05 + A + erl_set_memory_block.xml +
+ erl_set_memory_block + Custom memory allocation for Erlang on VxWorks® + +

This documentation is specific to VxWorks.

+

The function/command initiates custom + memory allocation for the Erlang emulator. It has to be called + before the Erlang emulator is started and makes Erlang use one + single large memory block for all memory allocation.

+

The memory within the block can be utilized by other tasks than + Erlang. This is accomplished by calling the functions + , and instead + of , and respectively.

+

The purpose of this is to avoid problems inherent in the + VxWorks systems library. The memory allocation within the + large memory block avoids fragmentation by using an "address + order first fit" algorithm. Another advantage of using a + separate memory block is that resource reclamation can be made + more easily when Erlang is stopped.

+

The function is callable from any C + program as an ordinary 10 argument function as well as + from the commandline.

+ + + + interl_set_memory_block(size_t size, void *ptr, int warn_mixed_malloc, int realloc_always_moves, int use_reclaim, ...) + Specify parameters for Erlang internal memory allocation. + +

The function is called before Erlang is + started to specify a large memory block where Erlang can + maintain memory internally.

+

Parameters:

+ + size_t size + The size in bytes of Erlang's internal memory block. Has to + be specified. Note that the VxWorks system uses dynamic + memory allocation heavily, so leave some memory to the system. + void *ptr + +

A pointer to the actual memory block of size + . If this is specified as 0 (NULL), Erlang will + allocate the memory when starting and will reclaim the + memory block (as a whole) when stopped.

+

If a memory block is allocated and provided here, the + etc routines can still be used after + the Erlang emulator is stopped. The Erlang emulator can + also be restarted while other tasks using the memory + block are running without destroying the memory. If + Erlang is to be restarted, also set the + flag.

+

If 0 is specified here, the Erlang system should not + be stopped while some other task uses the memory block + (has called ).

+ + int warn_mixed_malloc + +

If this flag is set to true (anything else than 0), the + system will write a warning message on the console if a + program is mixing normal with + or .

+ + int realloc_always_moves + +

If this flag is set to true (anything else than 0), all + calls to result in a moved memory + block. This can in certain conditions give less + fragmentation. This flag may be removed in future releases.

+ + int use_reclaim + +

If this flag is set to true (anything else than 0), all + memory allocated with is automatically + reclaimed as soon as a task exits. This is very useful + to make writing port programs (and other programs as + well) easier. Combine this with using the routines + etc. specified in the reclaim.h + file delivered in the Erlang distribution.

+ + +

Return Value:

+

Returns 0 (OK) on success, otherwise a value <> 0.

+ + + + interl_memory_show(...) + A utility similar to VxWorks , but for the Erlang memory area. + +

Return Value:

+

Returns 0 (OK) on success, otherwise a value <> 0.

+ + + + interl_mem_info_get(MEM_PART_STATS *stats) + A utility similar to VxWorks , but for the Erlang memory area. + +

Parameter:

+ + MEM_PART_STATS *stats + A pointer to a MEM_PART_STATS structure as defined in + ]]>. A successful call will fill in all + fields of the structure, on error all fields are left untouched. + +

Return Value:

+

Returns 0 (OK) on success, otherwise a value <> 0

+ + + + +
+ NOTES +

The memory block used by Erlang actually does not need to be + inside the area known to ordinary . It is possible + to set the preprocessor symbol when compiling + the wind kernel and then use user reserved memory for + Erlang. Erlang can therefor utilize memory above the 32 Mb limit + of VxWorks on the PowerPC architecture.

+

Example:

+

In config.h for the wind kernel:

+ +

In the start-up script/code for the VxWorks node:

+ +

Setting the flag decreases performance of the + system, but makes programming much easier. Other similar + facilities are present in the Erlang system even without using a + separate memory block. The routines called , + and provide the same + facilities by using VxWorks own . Similar routines + exist for files, see the file in the distribution.

+
+ + diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml new file mode 100644 index 0000000000..fd4447009a --- /dev/null +++ b/erts/doc/src/erlang.xml @@ -0,0 +1,6920 @@ + + + + +
+ + 19962009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erlang + + + + + erlang.xml +
+ erlang + The Erlang BIFs + +

By convention, most built-in functions (BIFs) are seen as being + in the module erlang. A number of the BIFs are viewed more + or less as part of the Erlang programming language and are + auto-imported. Thus, it is not necessary to specify + the module name and both the calls atom_to_list(Erlang) and + erlang:atom_to_list(Erlang) are identical.

+

In the text, auto-imported BIFs are listed without module prefix. + BIFs listed with module prefix are not auto-imported.

+

BIFs may fail for a variety of reasons. All BIFs fail with + reason badarg if they are called with arguments of an + incorrect type. The other reasons that may make BIFs fail are + described in connection with the description of each individual + BIF.

+

Some BIFs may be used in guard tests, these are marked with + "Allowed in guard tests".

+ + +
+ DATA TYPES + + +ext_binary() + a binary data object, + structured according to the Erlang external term format + +iodata() = iolist() | binary() + +iolist() = [char() | binary() | iolist()] + a binary is allowed as the tail of the list +
+ + + abs(Number) -> int() | float() + Arithmetical absolute value + + Number = number() + + +

Returns an integer or float which is the arithmetical + absolute value of Number.

+ 
+> abs(-3.33).
+3.33
+> abs(-3).
+3
+

Allowed in guard tests.

+ + + + adler32(Data) -> int() + Compute adler32 checksum + + Data = iodata() + + +

Computes and returns the adler32 checksum for Data.

+ + + + adler32(OldAdler, Data) -> int() + Compute adler32 checksum + + OldAdler = int() + Data = iodata() + + +

Continue computing the adler32 checksum by combining + the previous checksum, OldAdler, with the checksum of + Data.

+

The following code:

+ + X = adler32(Data1), + Y = adler32(X,Data2). + +

- would assign the same value to Y as this would:

+ + Y = adler32([Data1,Data2]). + + + + + adler32_combine(FirstAdler, SecondAdler, SecondSize) -> int() + Combine two adler32 checksums + + FirstAdler = SecondAdler = int() + SecondSize = int() + + +

Combines two previously computed adler32 checksums. + This computation requires the size of the data object for + the second checksum to be known.

+

The following code:

+ + Y = adler32(Data1), + Z = adler32(Y,Data2). + +

- would assign the same value to Z as this would:

+ + X = adler32(Data1), + Y = adler32(Data2), + Z = adler32_combine(X,Y,iolist_size(Data2)). + + + + + erlang:append_element(Tuple1, Term) -> Tuple2 + Append an extra element to a tuple + + Tuple1 = Tuple2 = tuple() + Term = term() + + +

Returns a new tuple which has one element more than + Tuple1, and contains the elements in Tuple1 + followed by Term as the last element. Semantically + equivalent to + list_to_tuple(tuple_to_list(Tuple ++ [Term]), but much + faster.

+ 
+> erlang:append_element({one, two}, three).
+{one,two,three}
+ + + + apply(Fun, Args) -> term() | empty() + Apply a function to an argument list + + Fun = fun() + Args = [term()] + + +

Call a fun, passing the elements in Args as + arguments.

+

Note: If the number of elements in the arguments are known at + compile-time, the call is better written as + Fun(Arg1, Arg2, ... ArgN).

+ +

Earlier, Fun could also be given as + {Module, Function}, equivalent to + apply(Module, Function, Args). This usage is + deprecated and will stop working in a future release of + Erlang/OTP.

+ + + + + apply(Module, Function, Args) -> term() | empty() + Apply a function to an argument list + + Module = Function = atom() + Args = [term()] + + +

Returns the result of applying Function in + Module to Args. The applied function must + be exported from Module. The arity of the function is + the length of Args.

+ 
+> apply(lists, reverse, [[a, b, c]]).
+[c,b,a]
+

apply can be used to evaluate BIFs by using + the module name erlang.

+ 
+> apply(erlang, atom_to_list, ['Erlang']).
+"Erlang"
+

Note: If the number of arguments are known at compile-time, + the call is better written as + Module:Function(Arg1, Arg2, ..., ArgN).

+

Failure: error_handler:undefined_function/3 is called + if the applied function is not exported. The error handler + can be redefined (see + process_flag/2). + If the error_handler is undefined, or if the user has + redefined the default error_handler so the replacement + module is undefined, an error with the reason undef + is generated.

+ + + + atom_to_binary(Atom, Encoding) -> binary() + Return the binary representation of an atom + + Atom = atom() + Encoding = latin1 | utf8 | unicode + + +

Returns a binary which corresponds to the text + representation of Atom. If Encoding + is latin1, there will be one byte for each character + in the text representation. If Encoding is utf8 or + unicode, the characters will encoded using UTF-8 + (meaning that characters from 16#80 up to 0xFF will be + encode in two bytes).

+ +

Currently, atom_to_binary(Atom, latin1) can + never fail because the text representation of an atom can only contain + characters from 0 to 16#FF. In a future release, the text representation + of atoms might be allowed to contain any Unicode character + and atom_to_binary(Atom, latin1) will fail if the + text representation for the Atom contains a Unicode + character greater than 16#FF.

 + + 
+> atom_to_binary('Erlang', latin1).
+<<"Erlang">>
+ + + + atom_to_list(Atom) -> string() + Text representation of an atom + + Atom = atom() + + +

Returns a string which corresponds to the text + representation of Atom.

+ 
+> atom_to_list('Erlang').
+"Erlang"
+ + + + binary_to_atom(Binary, Encoding) -> atom() + Convert from text representation to an atom + + Binary = binary() + Encoding = latin1 | utf8 | unicode + + +

Returns the atom whose text representation is + Binary. If Encoding is latin1, no + translation of bytes in the binary is done. If Encoding + is utf8 or unicode, the binary must contain + valid UTF-8 sequences; furthermore, only Unicode characters up + to 0xFF are allowed.

+ +

binary_to_atom(Binary, utf8) will fail if + the binary contains Unicode characters greater than 16#FF. + In a future release, such Unicode characters might be allowed + and binary_to_atom(Binary, utf8) + will not fail in that case.

 + + 
+> binary_to_atom(<<"Erlang">>, latin1).
+'Erlang'
+> binary_to_atom(<<1024/utf8>>, utf8).
+** exception error: bad argument
+     in function  binary_to_atom/2
+        called as binary_to_atom(<<208,128>>,utf8)
+ + + + binary_to_existing_atom(Binary, Encoding) -> atom() + Convert from text representation to an atom + + Binary = binary() + Encoding = latin1 | utf8 | unicode + + +

Works like binary_to_atom/2, + but the atom must already exist.

+

Failure: badarg if the atom does not already exist.

+ + + + binary_to_list(Binary) -> [char()] + Convert a binary to a list + + Binary = binary() + + +

Returns a list of integers which correspond to the bytes of + Binary.

+ + + + binary_to_list(Binary, Start, Stop) -> [char()] + Convert part of a binary to a list + + Binary = binary() + Start = Stop = 1..byte_size(Binary) + + +

As binary_to_list/1, but returns a list of integers + corresponding to the bytes from position Start to + position Stop in Binary. Positions in the + binary are numbered starting from 1.

+ + + + bitstring_to_list(Bitstring) -> [char()|bitstring()] + Convert a bitstring to a list + + Bitstring = bitstring() + + +

Returns a list of integers which correspond to the bytes of + Bitstring. If the number of bits in the binary is not + divisible by 8, the last element of the list will be a bitstring + containing the remaining bits (1 up to 7 bits).

+ + + + binary_to_term(Binary) -> term() + Decode an Erlang external term format binary + + Binary = ext_binary() + + +

Returns an Erlang term which is the result of decoding + the binary object Binary, which must be encoded + according to the Erlang external term format. See also + term_to_binary/1.

+ + + + bit_size(Bitstring) -> int() + Return the size of a bitstring + + Bitstring = bitstring() + + +

Returns an integer which is the size in bits of Bitstring.

+ 
+> bit_size(<<433:16,3:3>>).
+19
+> bit_size(<<1,2,3>>).
+24
+

Allowed in guard tests.

+ + + + erlang:bump_reductions(Reductions) -> void() + Increment the reduction counter + + Reductions = int() + + +

This implementation-dependent function increments + the reduction counter for the calling process. In the Beam + emulator, the reduction counter is normally incremented by + one for each function and BIF call, and a context switch is + forced when the counter reaches the maximum number of reductions + for a process (2000 reductions in R12B).

+ +

This BIF might be removed in a future version of the Beam + machine without prior warning. It is unlikely to be + implemented in other Erlang implementations.

+ + + + + byte_size(Bitstring) -> int() + Return the size of a bitstring (or binary) + + Bitstring = bitstring() + + +

Returns an integer which is the number of bytes needed to contain + Bitstring. (That is, if the number of bits in Bitstring is not + divisible by 8, the resulting number of bytes will be rounded up.)

+ 
+> byte_size(<<433:16,3:3>>).
+3
+> byte_size(<<1,2,3>>).
+3
+

Allowed in guard tests.

+ + + + erlang:cancel_timer(TimerRef) -> Time | false + Cancel a timer + + TimerRef = ref() + Time = int() + + +

Cancels a timer, where TimerRef was returned by + either + erlang:send_after/3 + or + erlang:start_timer/3. + If the timer is there to be removed, the function returns + the time in milliseconds left until the timer would have expired, + otherwise false (which means that TimerRef was + never a timer, that it has already been cancelled, or that it + has already delivered its message).

+

See also + erlang:send_after/3, + erlang:start_timer/3, + and + erlang:read_timer/1.

+

Note: Cancelling a timer does not guarantee that the message + has not already been delivered to the message queue.

+ + + + + check_process_code(Pid, Module) -> bool() + Check if a process is executing old code for a module + + Pid = pid() + Module = atom() + + +

Returns true if the process Pid is executing + old code for Module. That is, if the current call of + the process executes old code for this module, or if the + process has references to old code for this module, or if the + process contains funs that references old code for this + module. Otherwise, it returns false.

+ 
+> check_process_code(Pid, lists).
+false
+

See also code(3).

+ + + + concat_binary(ListOfBinaries) + Concatenate a list of binaries (deprecated) + +

Do not use; use + list_to_binary/1 + instead.

+ + + + crc32(Data) -> int() + Compute crc32 (IEEE 802.3) checksum + + Data = iodata() + + +

Computes and returns the crc32 (IEEE 802.3 style) checksum for Data.

+ + + + crc32(OldCrc, Data) -> int() + Compute crc32 (IEEE 802.3) checksum + + OldCrc = int() + Data = iodata() + + +

Continue computing the crc32 checksum by combining + the previous checksum, OldCrc, with the checksum of + Data.

+

The following code:

+ + X = crc32(Data1), + Y = crc32(X,Data2). + +

- would assign the same value to Y as this would:

+ + Y = crc32([Data1,Data2]). + + + + + crc32_combine(FirstCrc, SecondCrc, SecondSize) -> int() + Combine two crc32 (IEEE 802.3) checksums + + FirstCrc = SecondCrc = int() + SecondSize = int() + + +

Combines two previously computed crc32 checksums. + This computation requires the size of the data object for + the second checksum to be known.

+

The following code:

+ + Y = crc32(Data1), + Z = crc32(Y,Data2). + +

- would assign the same value to Z as this would:

+ + X = crc32(Data1), + Y = crc32(Data2), + Z = crc32_combine(X,Y,iolist_size(Data2)). + + + + + date() -> {Year, Month, Day} + Current date + + Year = Month = Day = int() + + +

Returns the current date as {Year, Month, Day}.

+

The time zone and daylight saving time correction depend on + the underlying OS.

+ 
+> date().
+{1995,2,19}
+ + + + decode_packet(Type,Bin,Options) -> {ok,Packet,Rest} | {more,Length} | {error,Reason} + Extracts a protocol packet from a binary + + Bin = binary() + Options = [Opt] + Packet = binary() | HttpPacket + Rest = binary() + Length = int() | undefined + Reason = term() +  Type, Opt -- see below + + HttpPacket = HttpRequest | HttpResponse | HttpHeader | http_eoh | HttpError + HttpRequest = {http_request, HttpMethod, HttpUri, HttpVersion} + HttpResponse = {http_response, HttpVersion, integer(), HttpString} + HttpHeader = {http_header, int(), HttpField, Reserved=term(), Value=HttpString} + HttpError = {http_error, HttpString} + HttpMethod = HttpMethodAtom | HttpString + HttpMethodAtom = 'OPTIONS' | 'GET' | 'HEAD' | 'POST' | 'PUT' | 'DELETE' | 'TRACE' + HttpUri = '*' | {absoluteURI, http|https, Host=HttpString, Port=int()|undefined, Path=HttpString} | + {scheme, Scheme=HttpString, HttpString} | {abs_path, HttpString} | HttpString + HttpVersion = {Major=int(), Minor=int()} + HttpString = string() | binary() + HttpField = HttpFieldAtom | HttpString + HttpFieldAtom = 'Cache-Control' | 'Connection' | 'Date' | 'Pragma' | 'Transfer-Encoding' | 'Upgrade' | 'Via' | 'Accept' | 'Accept-Charset' | 'Accept-Encoding' | 'Accept-Language' | 'Authorization' | 'From' | 'Host' | 'If-Modified-Since' | 'If-Match' | 'If-None-Match' | 'If-Range' | 'If-Unmodified-Since' | 'Max-Forwards' | 'Proxy-Authorization' | 'Range' | 'Referer' | 'User-Agent' | 'Age' | 'Location' | 'Proxy-Authenticate' | 'Public' | 'Retry-After' | 'Server' | 'Vary' | 'Warning' | 'Www-Authenticate' | 'Allow' | 'Content-Base' | 'Content-Encoding' | 'Content-Language' | 'Content-Length' | 'Content-Location' | 'Content-Md5' | 'Content-Range' | 'Content-Type' | 'Etag' | 'Expires' | 'Last-Modified' | 'Accept-Ranges' | 'Set-Cookie' | 'Set-Cookie2' | 'X-Forwarded-For' | 'Cookie' | 'Keep-Alive' | 'Proxy-Connection' + + + +

Decodes the binary Bin according to the packet + protocol specified by Type. Very similar to the packet + handling done by sockets with the option {packet,Type}.

+

If an entire packet is contained in Bin it is + returned together with the remainder of the binary as + {ok,Packet,Rest}.

+

If Bin does not contain the entire packet, + {more,Length} is returned. Length is either the + expected total size of the packet or undefined + if the expected packet size is not known. decode_packet + can then be called again with more data added.

+

If the packet does not conform to the protocol format + {error,Reason} is returned.

+

The following values of Type are valid:

+ + raw | 0 + +

No packet handling is done. Entire binary is + returned unless it is empty.

+ + 1 | 2 | 4 + +

Packets consist of a header specifying the number of + bytes in the packet, followed by that number of bytes. + The length of header can be one, two, or four bytes; + the order of the bytes is big-endian. The header + will be stripped off when the packet is returned.

+ + line + +

A packet is a line terminated with newline. The + newline character is included in the returned packet + unless the line was truncated according to the option + line_length.

+ + asn1 | cdr | sunrm | fcgi | tpkt + +

The header is not stripped off.

+

The meanings of the packet types are as follows:

+ + asn1 - ASN.1 BER + sunrm - Sun's RPC encoding + cdr - CORBA (GIOP 1.1) + fcgi - Fast CGI + tpkt - TPKT format [RFC1006] + + + http | httph | http_bin | httph_bin + +

The Hypertext Transfer Protocol. The packets + are returned with the format according to + HttpPacket described above. A packet is either a + request, a response, a header or an end of header + mark. Invalid lines are returned as HttpError.

+

Recognized request methods and header fields are returned as atoms. + Others are returned as strings.

+

The protocol type http should only be used for + the first line when a HttpRequest or a + HttpResponse is expected. The following calls + should use httph to get HttpHeader's until + http_eoh is returned that marks the end of the + headers and the beginning of any following message body.

+

The variants http_bin and httph_bin will return + strings (HttpString) as binaries instead of lists.

+ + +

The following options are available:

+ + {packet_size, int()} +

Sets the max allowed size of the packet body. If + the packet header indicates that the length of the + packet is longer than the max allowed length, the packet + is considered invalid. Default is 0 which means no + size limit.

+ + {line_length, int()} +

Applies only to line oriented protocols + (line, http). Lines longer than this + will be truncated.

+ + + 
+> erlang:decode_packet(1,<<3,"abcd">>,[]).
+{ok,<<"abc">>,<<"d">>}
+> erlang:decode_packet(1,<<5,"abcd">>,[]).
+{more,6}
+ + + + delete_module(Module) -> true | undefined + Make the current code for a module old + + Module = atom() + + +

Makes the current code for Module become old code, and + deletes all references for this module from the export table. + Returns undefined if the module does not exist, + otherwise true.

+ +

This BIF is intended for the code server (see + code(3)) and should not be + used elsewhere.

+ +

Failure: badarg if there is already an old version of + Module.

+ + + + erlang:demonitor(MonitorRef) -> true + Stop monitoring + + MonitorRef = ref() + + +

If MonitorRef is a reference which the calling process + obtained by calling + erlang:monitor/2, + this monitoring is turned off. If the monitoring is already + turned off, nothing happens.

+

Once erlang:demonitor(MonitorRef) has returned it is + guaranteed that no {'DOWN', MonitorRef, _, _, _} message + due to the monitor will be placed in the callers message queue + in the future. A {'DOWN', MonitorRef, _, _, _} message + might have been placed in the callers message queue prior to + the call, though. Therefore, in most cases, it is advisable + to remove such a 'DOWN' message from the message queue + after monitoring has been stopped. + erlang:demonitor(MonitorRef, [flush]) can be used instead of + erlang:demonitor(MonitorRef) if this cleanup is wanted.

+ +

Prior to OTP release R11B (erts version 5.5) erlang:demonitor/1 + behaved completely asynchronous, i.e., the monitor was active + until the "demonitor signal" reached the monitored entity. This + had one undesirable effect, though. You could never know when + you were guaranteed not to receive a DOWN message + due to the monitor.

+

Current behavior can be viewed as two combined operations: + asynchronously send a "demonitor signal" to the monitored entity + and ignore any future results of the monitor.

+ +

Failure: It is an error if MonitorRef refers to a + monitoring started by another process. Not all such cases are + cheap to check; if checking is cheap, the call fails with + badarg (for example if MonitorRef is a remote + reference).

+ + + + erlang:demonitor(MonitorRef, OptionList) -> true|false + Stop monitoring + + MonitorRef = ref() + OptionList = [Option] + Option = flush + Option = info + + +

The returned value is true unless info is part + of OptionList. +

+

erlang:demonitor(MonitorRef, []) is equivalent to + erlang:demonitor(MonitorRef).

+

Currently the following Options are valid:

+ + flush + +

Remove (one) {_, MonitorRef, _, _, _} message, + if there is one, from the callers message queue after + monitoring has been stopped.

+

Calling erlang:demonitor(MonitorRef, [flush]) + is equivalent to the following, but more efficient:

+ + + erlang:demonitor(MonitorRef), + receive +\011{_, MonitorRef, _, _, _} -> +\011 true + after 0 -> +\011 true + end + + info + +

The returned value is one of the following:

+ + true +

The monitor was found and removed. In this case + no 'DOWN' message due to this monitor have + been nor will be placed in the message queue + of the caller. +

+ + false +

The monitor was not found and could not be removed. + This probably because someone already has placed a + 'DOWN' message corresponding to this monitor + in the callers message queue. +

+ + +

If the info option is combined with the flush + option, false will be returned if a flush was needed; + otherwise, true. +

+ + + +

More options may be added in the future.

+ +

Failure: badarg if OptionList is not a list, or + if Option is not a valid option, or the same failure as for + erlang:demonitor/1

+ + + + disconnect_node(Node) -> bool() | ignored + Force the disconnection of a node + + Node = atom() + + +

Forces the disconnection of a node. This will appear to + the node Node as if the local node has crashed. This + BIF is mainly used in the Erlang network authentication + protocols. Returns true if disconnection succeeds, + otherwise false. If the local node is not alive, + the function returns ignored.

+ + + + erlang:display(Term) -> true + Print a term on standard output + + Term = term() + + +

Prints a text representation of Term on the standard + output.

+ +

This BIF is intended for debugging only.

+ + + + + element(N, Tuple) -> term() + Get Nth element of a tuple + + N = 1..tuple_size(Tuple) + Tuple = tuple() + + +

Returns the Nth element (numbering from 1) of + Tuple.

+ 
+> element(2, {a, b, c}).
+b
+

Allowed in guard tests.

+ + + + erase() -> [{Key, Val}] + Return and delete the process dictionary + + Key = Val = term() + + +

Returns the process dictionary and deletes it.

+ 
+> put(key1, {1, 2, 3}),
+put(key2, [a, b, c]),
+erase().
+[{key1,{1,2,3}},{key2,[a,b,c]}]
+ + + + erase(Key) -> Val | undefined + Return and delete a value from the process dictionary + + Key = Val = term() + + +

Returns the value Val associated with Key and + deletes it from the process dictionary. Returns + undefined if no value is associated with Key.

+ 
+> put(key1, {merry, lambs, are, playing}),
+X = erase(key1),
+{X, erase(key1)}.
+{{merry,lambs,are,playing},undefined}
+ + + + erlang:error(Reason) + Stop execution with a given reason + + Reason = term() + + +

Stops the execution of the calling process with the reason + Reason, where Reason is any term. The actual + exit reason will be {Reason, Where}, where Where + is a list of the functions most recently called (the current + function first). Since evaluating this function causes + the process to terminate, it has no return value.

+ 
+> catch erlang:error(foobar).
+{'EXIT',{foobar,[{erl_eval,do_apply,5},
+                 {erl_eval,expr,5},
+                 {shell,exprs,6},
+                 {shell,eval_exprs,6},
+                 {shell,eval_loop,3}]}}
+ + + + erlang:error(Reason, Args) + Stop execution with a given reason + + Reason = term() + Args = [term()] + + +

Stops the execution of the calling process with the reason + Reason, where Reason is any term. The actual + exit reason will be {Reason, Where}, where Where + is a list of the functions most recently called (the current + function first). Args is expected to be the list of + arguments for the current function; in Beam it will be used + to provide the actual arguments for the current function in + the Where term. Since evaluating this function causes + the process to terminate, it has no return value.

+ + + + exit(Reason) + Stop execution with a given reason + + Reason = term() + + +

Stops the execution of the calling process with the exit + reason Reason, where Reason is any term. Since + evaluating this function causes the process to terminate, it + has no return value.

+ 
+> exit(foobar).
+** exception exit: foobar
+> catch exit(foobar).
+{'EXIT',foobar}
+ + + + exit(Pid, Reason) -> true + Send an exit signal to a process + + Pid = pid() + Reason = term() + + +

Sends an exit signal with exit reason Reason to + the process Pid.

+

The following behavior apply if Reason is any term + except normal or kill:

+

If Pid is not trapping exits, Pid itself will + exit with exit reason Reason. If Pid is trapping + exits, the exit signal is transformed into a message + {'EXIT', From, Reason} and delivered to the message + queue of Pid. From is the pid of the process + which sent the exit signal. See also + process_flag/2.

+

If Reason is the atom normal, Pid will + not exit. If it is trapping exits, the exit signal is + transformed into a message {'EXIT', From, normal} + and delivered to its message queue.

+

If Reason is the atom kill, that is if + exit(Pid, kill) is called, an untrappable exit signal + is sent to Pid which will unconditionally exit with + exit reason killed.

+ + + + float(Number) -> float() + Convert a number to a float + + Number = number() + + +

Returns a float by converting Number to a float.

+ 
+> float(55).
+55.0
+

Allowed in guard tests.

+ +

Note that if used on the top-level in a guard, it will + test whether the argument is a floating point number; for + clarity, use + is_float/1 instead.

+

When float/1 is used in an expression in a guard, + such as 'float(A) == 4.0', it converts a number as + described above.

+ + + + + float_to_list(Float) -> string() + Text representation of a float + + Float = float() + + +

Returns a string which corresponds to the text + representation of Float.

+ 
+> float_to_list(7.0).
+"7.00000000000000000000e+00"
+ + + + erlang:fun_info(Fun) -> [{Item, Info}] + Information about a fun + + Fun = fun() + Item, Info -- see below + + +

Returns a list containing information about the fun + Fun. Each element of the list is a tuple. The order of + the tuples is not defined, and more tuples may be added in a + future release.

+ +

This BIF is mainly intended for debugging, but it can + occasionally be useful in library functions that might need + to verify, for instance, the arity of a fun.

+ +

There are two types of funs with slightly different + semantics:

+

A fun created by fun M:F/A is called an + external fun. Calling it will always call the + function F with arity A in the latest code for + module M. Note that module M does not even need + to be loaded when the fun fun M:F/A is created.

+

All other funs are called local. When a local fun + is called, the same version of the code that created the fun + will be called (even if newer version of the module has been + loaded).

+

The following elements will always be present in the list + for both local and external funs:

+ + {type, Type} + +

Type is either local or external.

+ + {module, Module} + +

Module (an atom) is the module name.

+

If Fun is a local fun, Module is the module + in which the fun is defined.

+

If Fun is an external fun, Module is the + module that the fun refers to.

+ + {name, Name} + +

Name (an atom) is a function name.

+

If Fun is a local fun, Name is the name + of the local function that implements the fun. + (This name was generated by the compiler, and is generally + only of informational use. As it is a local function, it + is not possible to call it directly.) + If no code is currently loaded for the fun, [] + will be returned instead of an atom.

+

If Fun is an external fun, Name is the name + of the exported function that the fun refers to.

+ + {arity, Arity} + +

Arity is the number of arguments that the fun + should be called with.

+ + {env, Env} + +

Env (a list) is the environment or free variables + for the fun. (For external funs, the returned list is + always empty.)

+ + +

The following elements will only be present in the list if + Fun is local:

+ + {pid, Pid} + +

Pid is the pid of the process that originally + created the fun.

+ + {index, Index} + +

Index (an integer) is an index into the module's + fun table.

+ + {new_index, Index} + +

Index (an integer) is an index into the module's + fun table.

+ + {new_uniq, Uniq} + +

Uniq (a binary) is a unique value for this fun.

+ + {uniq, Uniq} + +

Uniq (an integer) is a unique value for this fun.

+ + + + + + erlang:fun_info(Fun, Item) -> {Item, Info} + Information about a fun + + Fun = fun() + Item, Info -- see below + + +

Returns information about Fun as specified by + Item, in the form {Item,Info}.

+

For any fun, Item can be any of the atoms + module, name, arity, or env.

+

For a local fun, Item can also be any of the atoms + index, new_index, new_uniq, + uniq, and pid. For an external fun, the value + of any of these items is always the atom undefined.

+

See + erlang:fun_info/1.

+ + + + erlang:fun_to_list(Fun) -> string() + Text representation of a fun + + Fun = fun() + + +

Returns a string which corresponds to the text + representation of Fun.

+ + + + erlang:function_exported(Module, Function, Arity) -> bool() + Check if a function is exported and loaded + + Module = Function = atom() + Arity = int() + + +

Returns true if the module Module is loaded + and contains an exported function Function/Arity; + otherwise false.

+

Returns false for any BIF (functions implemented in C + rather than in Erlang).

+ + + + garbage_collect() -> true + Force an immediate garbage collection of the calling process + +

Forces an immediate garbage collection of the currently + executing process. The function should not be used, unless + it has been noticed -- or there are good reasons to suspect -- + that the spontaneous garbage collection will occur too late + or not at all. Improper use may seriously degrade system + performance.

+

Compatibility note: In versions of OTP prior to R7, + the garbage collection took place at the next context switch, + not immediately. To force a context switch after a call to + erlang:garbage_collect(), it was sufficient to make + any function call.

+ + + + garbage_collect(Pid) -> bool() + Force an immediate garbage collection of a process + + Pid = pid() + + +

Works like erlang:garbage_collect() but on any + process. The same caveats apply. Returns false if + Pid refers to a dead process; true otherwise.

+ + + + get() -> [{Key, Val}] + Return the process dictionary + + Key = Val = term() + + +

Returns the process dictionary as a list of + {Key, Val} tuples.

+ 
+> put(key1, merry),
+put(key2, lambs),
+put(key3, {are, playing}),
+get().
+[{key1,merry},{key2,lambs},{key3,{are,playing}}]
+ + + + get(Key) -> Val | undefined + Return a value from the process dictionary + + Key = Val = term() + + +

Returns the value Valassociated with Key in + the process dictionary, or undefined if Key + does not exist.

+ 
+> put(key1, merry),
+put(key2, lambs),
+put({any, [valid, term]}, {are, playing}),
+get({any, [valid, term]}).
+{are,playing}
+ + + + erlang:get_cookie() -> Cookie | nocookie + Get the magic cookie of the local node + + Cookie = atom() + + +

Returns the magic cookie of the local node, if the node is + alive; otherwise the atom nocookie.

+ + + + get_keys(Val) -> [Key] + Return a list of keys from the process dictionary + + Val = Key = term() + + +

Returns a list of keys which are associated with the value + Val in the process dictionary.

+ 
+> put(mary, {1, 2}),
+put(had, {1, 2}),
+put(a, {1, 2}),
+put(little, {1, 2}),
+put(dog, {1, 3}),
+put(lamb, {1, 2}),
+get_keys({1, 2}).
+[mary,had,a,little,lamb]
+ + + + erlang:get_stacktrace() -> [{Module, Function, Arity | Args}] + Get the call stack back-trace of the last exception + + Module = Function = atom() + Arity = int() + Args = [term()] + + +

Get the call stack back-trace (stacktrace) of the last + exception in the calling process as a list of + {Module,Function,Arity} tuples. + The Arity field in the first tuple may be the argument + list of that function call instead of an arity integer, + depending on the exception.

+

If there has not been any exceptions in a process, the + stacktrace is []. After a code change for the process, + the stacktrace may also be reset to [].

+

The stacktrace is the same data as the catch operator + returns, for example:

+

{'EXIT',{badarg,Stacktrace}} = catch abs(x)

+

See also + erlang:error/1 and + erlang:error/2.

+ + + + group_leader() -> GroupLeader + Get the group leader for the calling process + + GroupLeader = pid() + + +

Returns the pid of the group leader for the process which + evaluates the function.

+

Every process is a member of some process group and all + groups have a group leader. All IO from the group + is channeled to the group leader. When a new process is + spawned, it gets the same group leader as the spawning + process. Initially, at system start-up, init is both + its own group leader and the group leader of all processes.

+ + + + group_leader(GroupLeader, Pid) -> true + Set the group leader for a process + + GroupLeader = Pid = pid() + + +

Sets the group leader of Pid to GroupLeader. + Typically, this is used when a processes started from a + certain shell should have another group leader than + init.

+

See also + group_leader/0.

+ + + + halt() + Halt the Erlang runtime system and indicate normal exit to the calling environment + +

Halts the Erlang runtime system and indicates normal exit to + the calling environment. Has no return value.

+ 
+> halt().
+os_prompt%
+ + + + halt(Status) + Halt the Erlang runtime system + + Status = int()>=0 | string() + + +

Status must be a non-negative integer, or a string. + Halts the Erlang runtime system. Has no return value. + If Status is an integer, it is returned as an exit + status of Erlang to the calling environment. + If Status is a string, produces an Erlang crash dump + with String as slogan, and then exits with a non-zero + status code.

+

Note that on many platforms, only the status codes 0-255 are + supported by the operating system.

+ + + + erlang:hash(Term, Range) -> Hash + Hash function (deprecated) + +

Returns a hash value for Term within the range + 1..Range. The allowed range is 1..2^27-1.

+ +

This BIF is deprecated as the hash value may differ on + different architectures. Also the hash values for integer + terms larger than 2^27 as well as large binaries are very + poor. The BIF is retained for backward compatibility + reasons (it may have been used to hash records into a file), + but all new code should use one of the BIFs + erlang:phash/2 or erlang:phash2/1,2 instead.

+ + + + + hd(List) -> term() + Head of a list + + List = [term()] + + +

Returns the head of List, that is, the first element.

+ 
+> hd([1,2,3,4,5]).
+1
+

Allowed in guard tests.

+

Failure: badarg if List is the empty list [].

+ + + + erlang:hibernate(Module, Function, Args) + Hibernate a process until a message is sent to it + + Module = Function = atom() + Args = [term()] + + +

Puts the calling process into a wait state where its memory + allocation has been reduced as much as possible, which is + useful if the process does not expect to receive any messages + in the near future.

+

The process will be awaken when a message is sent to it, and + control will resume in Module:Function with + the arguments given by Args with the call stack + emptied, meaning that the process will terminate when that + function returns. Thus erlang:hibernate/3 will never + return to its caller.

+

If the process has any message in its message queue, + the process will be awaken immediately in the same way as + described above.

+

In more technical terms, what erlang:hibernate/3 does + is the following. It discards the call stack for the process. + Then it garbage collects the process. After the garbage + collection, all live data is in one continuous heap. The heap + is then shrunken to the exact same size as the live data + which it holds (even if that size is less than the minimum + heap size for the process).

+

If the size of the live data in the process is less than + the minimum heap size, the first garbage collection occurring + after the process has been awaken will ensure that the heap + size is changed to a size not smaller than the minimum heap + size.

+

Note that emptying the call stack means that any surrounding + catch is removed and has to be re-inserted after + hibernation. One effect of this is that processes started + using proc_lib (also indirectly, such as + gen_server processes), should use + proc_lib:hibernate/3 + instead to ensure that the exception handler continues to work + when the process wakes up.

+ + + + integer_to_list(Integer) -> string() + Text representation of an integer + + Integer = int() + + +

Returns a string which corresponds to the text + representation of Integer.

+ 
+> integer_to_list(77).
+"77"
+ + + + erlang:integer_to_list(Integer, Base) -> string() + Text representation of an integer + + Integer = int() + Base = 2..36 + + +

Returns a string which corresponds to the text + representation of Integer in base Base.

+ 
+> erlang:integer_to_list(1023, 16).
+"3FF"
+ + + + iolist_to_binary(IoListOrBinary) -> binary() + Convert an iolist to a binary + + IoListOrBinary = iolist() | binary() + + +

Returns a binary which is made from the integers and + binaries in IoListOrBinary.

+ 
+> Bin1 = <<1,2,3>>.
+<<1,2,3>>
+> Bin2 = <<4,5>>.
+<<4,5>>
+> Bin3 = <<6>>.
+<<6>>
+> iolist_to_binary([Bin1,1,[2,3,Bin2],4|Bin3]).
+<<1,2,3,1,2,3,4,5,4,6>>
+ + + + iolist_size(Item) -> int() + Size of an iolist + + Item = iolist() | binary() + + +

Returns an integer which is the size in bytes + of the binary that would be the result of + iolist_to_binary(Item).

+ 
+> iolist_size([1,2|<<3,4>>]).
+4
+ + + + is_alive() -> bool() + Check whether the local node is alive + +

Returns true if the local node is alive; that is, if + the node can be part of a distributed system. Otherwise, it + returns false.

+ + + + is_atom(Term) -> bool() + Check whether a term is an atom + + Term = term() + + +

Returns true if Term is an atom; + otherwise returns false.

+

Allowed in guard tests.

+ + + + is_binary(Term) -> bool() + Check whether a term is a binary + + Term = term() + + +

Returns true if Term is a binary; + otherwise returns false.

+ +

A binary always contains a complete number of bytes.

+ +

Allowed in guard tests.

+ + + + is_bitstring(Term) -> bool() + Check whether a term is a bitstring + + Term = term() + + +

Returns true if Term is a bitstring (including a binary); + otherwise returns false.

+ +

Allowed in guard tests.

+ + + + is_boolean(Term) -> bool() + Check whether a term is a boolean + + Term = term() + + +

Returns true if Term is + either the atom true or the atom false + (i.e. a boolean); otherwise returns false.

+

Allowed in guard tests.

+ + + + erlang:is_builtin(Module, Function, Arity) -> bool() + Check if a function is a BIF implemented in C + + Module = Function = atom() + Arity = int() + + +

Returns true if Module:Function/Arity is + a BIF implemented in C; otherwise returns false. + This BIF is useful for builders of cross reference tools.

+ + + + is_float(Term) -> bool() + Check whether a term is a float + + Term = term() + + +

Returns true if Term is a floating point + number; otherwise returns false.

+

Allowed in guard tests.

+ + + + is_function(Term) -> bool() + Check whether a term is a fun + + Term = term() + + +

Returns true if Term is a fun; otherwise + returns false.

+

Allowed in guard tests.

+ + + + is_function(Term, Arity) -> bool() + Check whether a term is a fun with a given arity + + Term = term() + Arity = int() + + +

Returns true if Term is a fun that can be + applied with Arity number of arguments; otherwise + returns false.

+

Allowed in guard tests.

+ +

Currently, is_function/2 will also return + true if the first argument is a tuple fun (a tuple + containing two atoms). In a future release, tuple funs will + no longer be supported and is_function/2 will return + false if given a tuple fun.

+ + + + + is_integer(Term) -> bool() + Check whether a term is an integer + + Term = term() + + +

Returns true if Term is an integer; + otherwise returns false.

+

Allowed in guard tests.

+ + + + is_list(Term) -> bool() + Check whether a term is a list + + Term = term() + + +

Returns true if Term is a list with + zero or more elements; otherwise returns false.

+

Allowed in guard tests.

+ + + + is_number(Term) -> bool() + Check whether a term is a number + + Term = term() + + +

Returns true if Term is either an integer or a + floating point number; otherwise returns false.

+

Allowed in guard tests.

+ + + + is_pid(Term) -> bool() + Check whether a term is a pid + + Term = term() + + +

Returns true if Term is a pid (process + identifier); otherwise returns false.

+

Allowed in guard tests.

+ + + + is_port(Term) -> bool() + Check whether a term is a port + + Term = term() + + +

Returns true if Term is a port identifier; + otherwise returns false.

+

Allowed in guard tests.

+ + + + is_process_alive(Pid) -> bool() + Check whether a process is alive + + Pid = pid() + + +

+ Pid must refer to a process at the local node. + Returns true if the process exists and is alive, that + is, is not exiting and has not exited. Otherwise, returns + false. +

+ + + + is_record(Term, RecordTag) -> bool() + Check whether a term appears to be a record + + Term = term() + RecordTag = atom() + + +

Returns true if Term is a tuple and its first + element is RecordTag. Otherwise, returns false.

+ +

Normally the compiler treats calls to is_record/2 + specially. It emits code to verify that Term is a + tuple, that its first element is RecordTag, and that + the size is correct. However, if the RecordTag is + not a literal atom, the is_record/2 BIF will be + called instead and the size of the tuple will not be + verified.

+ +

Allowed in guard tests, if RecordTag is a literal + atom.

+ + + + is_record(Term, RecordTag, Size) -> bool() + Check whether a term appears to be a record + + Term = term() + RecordTag = atom() + Size = int() + + +

RecordTag must be an atom. Returns true if + Term is a tuple, its first element is RecordTag, + and its size is Size. Otherwise, returns false.

+

Allowed in guard tests, provided that RecordTag is + a literal atom and Size is a literal integer.

+ +

This BIF is documented for completeness. In most cases + is_record/2 should be used.

+ + + + + is_reference(Term) -> bool() + Check whether a term is a reference + + Term = term() + + +

Returns true if Term is a reference; + otherwise returns false.

+

Allowed in guard tests.

+ + + + is_tuple(Term) -> bool() + Check whether a term is a tuple + + Term = term() + + +

Returns true if Term is a tuple; + otherwise returns false.

+

Allowed in guard tests.

+ + + + length(List) -> int() + Length of a list + + List = [term()] + + +

Returns the length of List.

+ 
+> length([1,2,3,4,5,6,7,8,9]).
+9
+

Allowed in guard tests.

+ + + + link(Pid) -> true + Create a link to another process (or port) + + Pid = pid() | port() + + +

Creates a link between the calling process and another + process (or port) Pid, if there is not such a link + already. If a process attempts to create a link to itself, + nothing is done. Returns true.

+

If Pid does not exist, the behavior of the BIF depends + on if the calling process is trapping exits or not (see + process_flag/2):

+ + If the calling process is not trapping exits, and + checking Pid is cheap -- that is, if Pid is + local -- link/1 fails with reason noproc. + Otherwise, if the calling process is trapping exits, + and/or Pid is remote, link/1 returns + true, but an exit signal with reason noproc + is sent to the calling process. + + + + + list_to_atom(String) -> atom() + Convert from text representation to an atom + + String = string() + + +

Returns the atom whose text representation is String.

+ 
+> list_to_atom("Erlang").
+'Erlang'
+ + + + list_to_binary(IoList) -> binary() + Convert a list to a binary + + IoList = iolist() + + +

Returns a binary which is made from the integers and + binaries in IoList.

+ 
+> Bin1 = <<1,2,3>>.
+<<1,2,3>>
+> Bin2 = <<4,5>>.
+<<4,5>>
+> Bin3 = <<6>>.
+<<6>>
+> list_to_binary([Bin1,1,[2,3,Bin2],4|Bin3]).
+<<1,2,3,1,2,3,4,5,4,6>>
+ + + + list_to_bitstring(BitstringList) -> bitstring() + Convert a list to a bitstring + + BitstringList = [BitstringList | bitstring() | char()] + + +

Returns a bitstring which is made from the integers and + bitstrings in BitstringList. (The last tail in BitstringList + is allowed to be a bitstring.)

+ 
+> Bin1 = <<1,2,3>>.
+<<1,2,3>>
+> Bin2 = <<4,5>>.
+<<4,5>>
+> Bin3 = <<6,7:4,>>.
+<<6>>
+> list_to_binary([Bin1,1,[2,3,Bin2],4|Bin3]).
+<<1,2,3,1,2,3,4,5,4,6,7:46>>
+ + + + list_to_existing_atom(String) -> atom() + Convert from text representation to an atom + + String = string() + + +

Returns the atom whose text representation is String, + but only if there already exists such atom.

+

Failure: badarg if there does not already exist an atom + whose text representation is String.

+ + + + list_to_float(String) -> float() + Convert from text representation to a float + + String = string() + + +

Returns the float whose text representation is String.

+ 
+> list_to_float("2.2017764e+0").
+2.2017764
+

Failure: badarg if String contains a bad + representation of a float.

+ + + + list_to_integer(String) -> int() + Convert from text representation to an integer + + String = string() + + +

Returns an integer whose text representation is + String.

+ 
+> list_to_integer("123").
+123
+

Failure: badarg if String contains a bad + representation of an integer.

+ + + + erlang:list_to_integer(String, Base) -> int() + Convert from text representation to an integer + + String = string() + Base = 2..36 + + +

Returns an integer whose text representation in base + Base is String.

+ 
+> erlang:list_to_integer("3FF", 16).
+1023
+

Failure: badarg if String contains a bad + representation of an integer.

+ + + + list_to_pid(String) -> pid() + Convert from text representation to a pid + + String = string() + + +

Returns a pid whose text representation is String.

+ +

This BIF is intended for debugging and for use in + the Erlang operating system. It should not be used in + application programs.

+ + 
+> list_to_pid("<0.4.1>").
+<0.4.1>
+

Failure: badarg if String contains a bad + representation of a pid.

+ + + + list_to_tuple(List) -> tuple() + Convert a list to a tuple + + List = [term()] + + +

Returns a tuple which corresponds to List. List + can contain any Erlang terms.

+ 
+> list_to_tuple([share, ['Ericsson_B', 163]]).
+{share, ['Ericsson_B', 163]}
+ + + + load_module(Module, Binary) -> {module, Module} | {error, Reason} + Load object code for a module + + Module = atom() + Binary = binary() + Reason = badfile | not_purged | badfile + + +

If Binary contains the object code for the module + Module, this BIF loads that object code. Also, if + the code for the module Module already exists, all + export references are replaced so they point to the newly + loaded code. The previously loaded code is kept in the system + as old code, as there may still be processes which are + executing that code. It returns either + {module, Module}, or {error, Reason} if loading + fails. Reason is one of the following:

+ + badfile + +

The object code in Binary has an incorrect format.

+ + not_purged + +

Binary contains a module which cannot be loaded + because old code for this module already exists.

+ + badfile + +

The object code contains code for another module than + Module

+ + + +

This BIF is intended for the code server (see + code(3)) and should not be + used elsewhere.

+ + + + + erlang:load_nif(Path, LoadInfo) -> ok | {error, Reason, Text} + Load NIF library + + Path = string() + LoadInfo = term() + Reason = load_failed | bad_lib | load | reload | + upgrade | old_code + Text = string() + + + +

This BIF is currently introduced as an experimental + feature. The interface may be changed in any way in future + releases.

+ +

Loads and links a dynamic library containing native + implemented functions (NIFs) for a module. Path is a + file path to the sharable object/dynamic library file minus + the OS-dependant file extension (.so for Unix and .ddl for + Windows). See erl_nif + on how to implement a NIF library.

+

LoadInfo can be any term. It will be passed on to + the library as part of the initialization. A good practice is + to include a module version number to support future code + upgrade scenarios.

+

The call to load_nif/2 must be made + directly from the Erlang code of the module that the + NIF library belongs to.

+

It returns either ok, or {error,Reason,Text} + if loading fails. Reason is one of the atoms below, + while Text is a human readable string that may give + some more information about the failure:

+ + load_failed + +

The OS failed to load the NIF library.

+ + bad_lib + +

The library did not fulfil the requirements as a NIF + library of the calling module.

+ + load | reload | upgrade + +

The corresponding library callback was not successful.

+ + old_code + +

The call to load_nif/2 was made from the old + code of a module that has been upgraded. This is not + allowed.

+ + + + + + erlang:loaded() -> [Module] + List of all loaded modules + + Module = atom() + + +

Returns a list of all loaded Erlang modules (current and/or + old code), including preloaded modules.

+

See also code(3).

+ + + + erlang:localtime() -> {Date, Time} + Current local date and time + + Date = {Year, Month, Day} + Time = {Hour, Minute, Second} +  Year = Month = Day = Hour = Minute = Second = int() + + +

Returns the current local date and time + {{Year, Month, Day}, {Hour, Minute, Second}}.

+

The time zone and daylight saving time correction depend + on the underlying OS.

+ 
+> erlang:localtime().
+{{1996,11,6},{14,45,17}}
+ + + + erlang:localtime_to_universaltime({Date1, Time1}) -> {Date2, Time2} + Convert from local to Universal Time Coordinated (UTC) date and time + + Date1 = Date2 = {Year, Month, Day} + Time1 = Time2 = {Hour, Minute, Second} +  Year = Month = Day = Hour = Minute = Second = int() + + +

Converts local date and time to Universal Time Coordinated + (UTC), if this is supported by the underlying OS. Otherwise, + no conversion is done and {Date1, Time1} is returned.

+ 
+> erlang:localtime_to_universaltime({{1996,11,6},{14,45,17}}).
+{{1996,11,6},{13,45,17}}
+

Failure: badarg if Date1 or Time1 do + not denote a valid date or time.

+ + + + erlang:localtime_to_universaltime({Date1, Time1}, IsDst) -> {Date2, Time2} + Convert from local to Universal Time Coordinated (UTC) date and time + + Date1 = Date2 = {Year, Month, Day} + Time1 = Time2 = {Hour, Minute, Second} +  Year = Month = Day = Hour = Minute = Second = int() + IsDst = true | false | undefined + + +

Converts local date and time to Universal Time Coordinated + (UTC) just like erlang:localtime_to_universaltime/1, + but the caller decides if daylight saving time is active or + not.

+

If IsDst == true the {Date1, Time1} is during + daylight saving time, if IsDst == false it is not, + and if IsDst == undefined the underlying OS may + guess, which is the same as calling + erlang:localtime_to_universaltime({Date1, Time1}).

+ 
+> erlang:localtime_to_universaltime({{1996,11,6},{14,45,17}}, true).
+{{1996,11,6},{12,45,17}}
+> erlang:localtime_to_universaltime({{1996,11,6},{14,45,17}}, false).
+{{1996,11,6},{13,45,17}}
+> erlang:localtime_to_universaltime({{1996,11,6},{14,45,17}}, undefined).
+{{1996,11,6},{13,45,17}}
+

Failure: badarg if Date1 or Time1 do + not denote a valid date or time.

+ + + + make_ref() -> ref() + Return an almost unique reference + +

Returns an almost unique reference.

+

The returned reference will re-occur after approximately 2^82 + calls; therefore it is unique enough for practical purposes.

+ 
+> make_ref().
+#Ref<0.0.0.135>
+ + + + erlang:make_tuple(Arity, InitialValue) -> tuple() + Create a new tuple of a given arity + + Arity = int() + InitialValue = term() + + +

Returns a new tuple of the given Arity, where all + elements are InitialValue.

+ 
+> erlang:make_tuple(4, []).
+{[],[],[],[]}
+ + + + erlang:make_tuple(Arity, Default, InitList) -> tuple() + Create a new tuple with given arity and contents + + Arity = int() + Default = term() + InitList = [{Position,term()}] + Position = integer() + + +

erlang:make_tuple first creates a tuple of size Arity + where each element has the value Default. It then fills + in values from InitList. Each list element in InitList + must be a two-tuple where the first element is a position in the + newly created tuple and the second element is any term. If a position + occurs more than once in the list, the term corresponding to + last occurrence will be used.

+ 
+> erlang:make_tuple(5, [], [{2,ignored},{5,zz},{2,aa}]).
+{{[],aa,[],[],zz}
+ + + + erlang:max(Term1, Term2) -> Maximum + Return the largest of two term + + Term1 = Term2 = Maximum = term() + + +

Return the largest of Term1 and Term2; + if the terms compares equal, Term1 will be returned.

+ + + + erlang:md5(Data) -> Digest + Compute an MD5 message digest + + Data = iodata() + Digest = binary() + + +

Computes an MD5 message digest from Data, where + the length of the digest is 128 bits (16 bytes). Data + is a binary or a list of small integers and binaries.

+

See The MD5 Message Digest Algorithm (RFC 1321) for more + information about MD5.

+

The MD5 Message Digest Algorithm is not considered + safe for code-signing or software integrity purposes.

 + + + + erlang:md5_final(Context) -> Digest + Finish the update of an MD5 context and return the computed MD5 message digest + + Context = Digest = binary() + + +

Finishes the update of an MD5 Context and returns + the computed MD5 message digest.

+ + + + erlang:md5_init() -> Context + Create an MD5 context + + Context = binary() + + +

Creates an MD5 context, to be used in subsequent calls to + md5_update/2.

+ + + + erlang:md5_update(Context, Data) -> NewContext + Update an MD5 context with data, and return a new context + + Data = iodata() + Context = NewContext = binary() + + +

Updates an MD5 Context with Data, and returns + a NewContext.

+ + + + erlang:memory() -> [{Type, Size}] + Information about dynamically allocated memory + + Type, Size -- see below + + +

Returns a list containing information about memory + dynamically allocated by the Erlang emulator. Each element of + the list is a tuple {Type, Size}. The first element + Typeis an atom describing memory type. The second + element Sizeis memory size in bytes. A description of + each memory type follows:

+ + total + +

The total amount of memory currently allocated, which is + the same as the sum of memory size for processes + and system.

+ + processes + +

The total amount of memory currently allocated by + the Erlang processes.

+ + processes_used + +

The total amount of memory currently used by the Erlang + processes.

+

This memory is part of the memory presented as + processes memory.

+ + system + +

The total amount of memory currently allocated by + the emulator that is not directly related to any Erlang + process.

+

Memory presented as processes is not included in + this memory.

+ + atom + +

The total amount of memory currently allocated for atoms.

+

This memory is part of the memory presented as + system memory.

+ + atom_used + +

The total amount of memory currently used for atoms.

+

This memory is part of the memory presented as + atom memory.

+ + binary + +

The total amount of memory currently allocated for + binaries.

+

This memory is part of the memory presented as + system memory.

+ + code + +

The total amount of memory currently allocated for + Erlang code.

+

This memory is part of the memory presented as + system memory.

+ + ets + +

The total amount of memory currently allocated for ets + tables.

+

This memory is part of the memory presented as + system memory.

+ + maximum + +

The maximum total amount of memory allocated since + the emulator was started.

+

This tuple is only present when the emulator is run with + instrumentation.

+

For information on how to run the emulator with + instrumentation see + instrument(3) + and/or erl(1).

+ + + +

The system value is not complete. Some allocated + memory that should be part of the system value are + not.

+

When the emulator is run with instrumentation, + the system value is more accurate, but memory + directly allocated by malloc (and friends) are still + not part of the system value. Direct calls to + malloc are only done from OS specific runtime + libraries and perhaps from user implemented Erlang drivers + that do not use the memory allocation functions in + the driver interface.

+

Since the total value is the sum of processes + and system the error in system will propagate + to the total value.

+

The different amounts of memory that are summed are + not gathered atomically which also introduce + an error in the result.

+ +

The different values has the following relation to each + other. Values beginning with an uppercase letter is not part + of the result.

+ +\011total = processes + system +\011processes = processes_used + ProcessesNotUsed +\011system = atom + binary + code + ets + OtherSystem +\011atom = atom_used + AtomNotUsed + +\011RealTotal = processes + RealSystem +\011RealSystem = system + MissedSystem +

More tuples in the returned list may be added in the future.

+ +

The total value is supposed to be the total amount + of memory dynamically allocated by the emulator. Shared + libraries, the code of the emulator itself, and + the emulator stack(s) are not supposed to be included. That + is, the total value is not supposed to be + equal to the total size of all pages mapped to the emulator. + Furthermore, due to fragmentation and pre-reservation of + memory areas, the size of the memory segments which contain + the dynamically allocated memory blocks can be substantially + larger than the total size of the dynamically allocated + memory blocks.

+ + +

+ Since erts version 5.6.4 erlang:memory/0 requires that + all erts_alloc(3) + allocators are enabled (default behaviour). +

+ +

Failure:

+ + notsup + + If an erts_alloc(3) + allocator has been disabled. + + + + + + erlang:memory(Type | [Type]) -> Size | [{Type, Size}] + Information about dynamically allocated memory + + Type, Size -- see below + + +

Returns the memory size in bytes allocated for memory of + type Type. The argument can also be given as a list + of Type atoms, in which case a corresponding list of + {Type, Size} tuples is returned.

+ +

+ Since erts version 5.6.4 erlang:memory/1 requires that + all erts_alloc(3) + allocators are enabled (default behaviour). +

+ +

Failures:

+ + badarg + + If Type is not one of the memory types listed in the + documentation of + erlang:memory/0. + + badarg + + If maximum is passed as Type and the emulator + is not run in instrumented mode. + + notsup + + If an erts_alloc(3) + allocator has been disabled. + + +

See also + erlang:memory/0.

+ + + + erlang:min(Term1, Term2) -> Minimum + Return the smallest of two term + + Term1 = Term2 = Minimum = term() + + +

Return the smallest of Term1 and Term2; + if the terms compare equal, Term1 will be returned.

+ + + + module_loaded(Module) -> bool() + Check if a module is loaded + + Module = atom() + + +

Returns true if the module Module is loaded, + otherwise returns false. It does not attempt to load + the module.

+ +

This BIF is intended for the code server (see + code(3)) and should not be + used elsewhere.

+ + + + + erlang:monitor(Type, Item) -> MonitorRef + Start monitoring + + Type = process + Item = pid() | {RegName, Node} | RegName +  RegName = atom() +  Node = node() + MonitorRef = reference() + + +

The calling process starts monitoring Item which is + an object of type Type.

+

Currently only processes can be monitored, i.e. the only + allowed Type is process, but other types may be + allowed in the future.

+

Item can be:

+ + pid() + +

The pid of the process to monitor.

+ + {RegName, Node} + +

A tuple consisting of a registered name of a process and + a node name. The process residing on the node Node + with the registered name RegName will be monitored.

+ + RegName + +

The process locally registered as RegName will be + monitored.

+ + + +

When a process is monitored by registered name, the process + that has the registered name at the time when + erlang:monitor/2 is called will be monitored. + The monitor will not be effected, if the registered name is + unregistered.

+ +

A 'DOWN' message will be sent to the monitoring + process if Item dies, if Item does not exist, + or if the connection is lost to the node which Item + resides on. A 'DOWN' message has the following pattern:

+ +{'DOWN', MonitorRef, Type, Object, Info} +

where MonitorRef and Type are the same as + described above, and:

+ + Object + +

A reference to the monitored object:

+ + the pid of the monitored process, if Item was + specified as a pid. + {RegName, Node}, if Item was specified as + {RegName, Node}. + {RegName, Node}, if Item was specified as + RegName. Node will in this case be the + name of the local node (node()). + + + Info + +

Either the exit reason of the process, noproc + (non-existing process), or noconnection (no + connection to Node).

+ + + +

If/when erlang:monitor/2 is extended (e.g. to + handle other item types than process), other + possible values for Object, and Info in the + 'DOWN' message will be introduced.

+ +

The monitoring is turned off either when the 'DOWN' + message is sent, or when + erlang:demonitor/1 + is called.

+

If an attempt is made to monitor a process on an older node + (where remote process monitoring is not implemented or one + where remote process monitoring by registered name is not + implemented), the call fails with badarg.

+

Making several calls to erlang:monitor/2 for the same + Item is not an error; it results in as many, completely + independent, monitorings.

+ +

The format of the 'DOWN' message changed in the 5.2 + version of the emulator (OTP release R9B) for monitor by registered name. The Object element of + the 'DOWN' message could in earlier versions + sometimes be the pid of the monitored process and sometimes + be the registered name. Now the Object element is + always a tuple consisting of the registered name and + the node name. Processes on new nodes (emulator version 5.2 + or greater) will always get 'DOWN' messages on + the new format even if they are monitoring processes on old + nodes. Processes on old nodes will always get 'DOWN' + messages on the old format.

+ + + + + monitor_node(Node, Flag) -> true + Monitor the status of a node + + Node = node() + Flag = bool() + + +

Monitors the status of the node Node. If Flag + is true, monitoring is turned on; if Flag is + false, monitoring is turned off.

+

Making several calls to monitor_node(Node, true) for + the same Node is not an error; it results in as many, + completely independent, monitorings.

+

If Node fails or does not exist, the message + {nodedown, Node} is delivered to the process. If a + process has made two calls to monitor_node(Node, true) + and Node terminates, two nodedown messages are + delivered to the process. If there is no connection to + Node, there will be an attempt to create one. If this + fails, a nodedown message is delivered.

+

Nodes connected through hidden connections can be monitored + as any other node.

+

Failure: badargif the local node is not alive.

+ + + + erlang:monitor_node(Node, Flag, Options) -> true + Monitor the status of a node + + Node = node() + Flag = bool() + Options = [Option] + Option = allow_passive_connect + + +

Behaves as monitor_node/2 except that it allows an + extra option to be given, namely allow_passive_connect. + The option allows the BIF to wait the normal net connection + timeout for the monitored node to connect itself, + even if it cannot be actively connected from this node + (i.e. it is blocked). The state where this might be useful can + only be achieved by using the kernel option + dist_auto_connect once. If that kernel option is not + used, the allow_passive_connect option has no + effect.

+ +

The allow_passive_connect option is used + internally and is seldom needed in applications where the + network topology and the kernel options in effect is known in + advance.

+ +

Failure: badarg if the local node is not alive or the + option list is malformed.

+ + + + node() -> Node + Name of the local node + + Node = node() + + +

Returns the name of the local node. If the node is not alive, + nonode@nohost is returned instead.

+

Allowed in guard tests.

+ + + + node(Arg) -> Node + At which node is a pid, port or reference located + + Arg = pid() | port() | ref() + Node = node() + + +

Returns the node where Arg is located. Arg can + be a pid, a reference, or a port. If the local node is not + alive, nonode@nohost is returned.

+

Allowed in guard tests.

+ + + + nodes() -> Nodes + All visible nodes in the system + + Nodes = [node()] + + +

Returns a list of all visible nodes in the system, excluding + the local node. Same as nodes(visible).

+ + + + nodes(Arg | [Arg]) -> Nodes + All nodes of a certain type in the system + + Arg = visible | hidden | connected | this | known + Nodes = [node()] + + +

Returns a list of nodes according to argument given. + The result returned when the argument is a list, is the list + of nodes satisfying the disjunction(s) of the list elements.

+

Arg can be any of the following:

+ + visible + +

Nodes connected to this node through normal connections.

+ + hidden + +

Nodes connected to this node through hidden connections.

+ + connected + +

All nodes connected to this node.

+ + this + +

This node.

+ + known + +

Nodes which are known to this node, i.e., connected, + previously connected, etc.

+ + +

Some equalities: [node()] = nodes(this), + nodes(connected) = nodes([visible, hidden]), and + nodes() = nodes(visible).

+

If the local node is not alive, + nodes(this) == nodes(known) == [nonode@nohost], for + any other Arg the empty list [] is returned.

+ + + + now() -> {MegaSecs, Secs, MicroSecs} + Elapsed time since 00:00 GMT + + MegaSecs = Secs = MicroSecs = int() + + +

Returns the tuple {MegaSecs, Secs, MicroSecs} which is + the elapsed time since 00:00 GMT, January 1, 1970 (zero hour) + on the assumption that the underlying OS supports this. + Otherwise, some other point in time is chosen. It is also + guaranteed that subsequent calls to this BIF returns + continuously increasing values. Hence, the return value from + now() can be used to generate unique time-stamps. It + can only be used to check the local time of day if + the time-zone info of the underlying operating system is + properly configured.

+ + + + open_port(PortName, PortSettings) -> port() + Open a port + + PortName = {spawn, Command} | {spawn_driver, Command} | {spawn_executable, Command} | {fd, In, Out} +  Command = string() +  In = Out = int() + PortSettings = [Opt] +  Opt = {packet, N} | stream | {line, L} | {cd, Dir} | {env, Env} | {args, [ string() ]} | {arg0, string()} | exit_status | use_stdio | nouse_stdio | stderr_to_stdout | in | out | binary | eof +   N = 1 | 2 | 4 +   L = int() +   Dir = string() +   Env = [{Name, Val}] +    Name = string() +    Val = string() | false + + +

Returns a port identifier as the result of opening a + new Erlang port. A port can be seen as an external Erlang + process. PortName is one of the following:

+ + {spawn, Command} + +

Starts an external program. Command is the name + of the external program which will be run. Command + runs outside the Erlang work space unless an Erlang + driver with the name Command is found. If found, + that driver will be started. A driver runs in the Erlang + workspace, which means that it is linked with the Erlang + runtime system.

+

When starting external programs on Solaris, the system + call vfork is used in preference to fork + for performance reasons, although it has a history of + being less robust. If there are problems with using + vfork, setting the environment variable + ERL_NO_VFORK to any value will cause fork + to be used instead.

+ +

For external programs, the PATH is searched + (or an equivalent method is used to find programs, + depending on operating system). This is done by invoking + the shell och certain platforms. The first space + separated token of the command will be considered as the + name of the executable (or driver). This (among other + things) makes this option unsuitable for running + programs having spaces in file or directory names. Use + {spawn_executable, Command} instead if spaces in executable + file names is desired.

+ + {spawn_driver, Command} + +

Works like {spawn, Command}, but demands the + first (space separated) token of the command to be the name of a + loaded driver. If no driver with that name is loaded, a + badarg error is raised.

+ + {spawn_executable, Command} + + +

Works like {spawn, Command}, but only runs + external executables. The Command in it's whole + is used as the name of the executable, including any + spaces. If arguments are to be passed, the + args and arg0 PortSettings can be used.

+ +

The shell is not usually invoked to start the + program, it's executed directly. Neither is the + PATH (or equivalent) searched. To find a program + in the PATH to execute, use os:find_executable/1.

+

Only if a shell script or .bat file is + executed, the appropriate command interpreter will + implicitly be invoked, but there will still be no + command argument expansion or implicit PATH search.

+ +

If the Command cannot be run, an error + exception, with the posix error code as the reason, is + raised. The error reason may differ between operating + systems. Typically the error enoent is raised + when one tries to run a program that is not found and + eaccess is raised when the given file is not + executable.

+ + {fd, In, Out} + +

Allows an Erlang process to access any currently opened + file descriptors used by Erlang. The file descriptor + In can be used for standard input, and the file + descriptor Out for standard output. It is only + used for various servers in the Erlang operating system + (shell and user). Hence, its use is very + limited.

+ + +

PortSettings is a list of settings for the port. + Valid settings are:

+ + {packet, N} + +

Messages are preceded by their length, sent in N + bytes, with the most significant byte first. Valid values + for N are 1, 2, or 4.

+ + stream + +

Output messages are sent without packet lengths. A + user-defined protocol must be used between the Erlang + process and the external object.

+ + {line, L} + +

Messages are delivered on a per line basis. Each line + (delimited by the OS-dependent newline sequence) is + delivered in one single message. The message data format + is {Flag, Line}, where Flag is either + eol or noeol and Line is the actual + data delivered (without the newline sequence).

+

L specifies the maximum line length in bytes. + Lines longer than this will be delivered in more than one + message, with the Flag set to noeol for all + but the last message. If end of file is encountered + anywhere else than immediately following a newline + sequence, the last line will also be delivered with + the Flag set to noeol. In all other cases, + lines are delivered with Flag set to eol.

+

The {packet, N} and {line, L} settings are + mutually exclusive.

+ + {cd, Dir} + +

This is only valid for {spawn, Command} and + {spawn_executable, Command}. + The external program starts using Dir as its + working directory. Dir must be a string. Not + available on VxWorks.

+ + {env, Env} + +

This is only valid for {spawn, Command} and + {spawn_executable, Command}. + The environment of the started process is extended using + the environment specifications in Env.

+

Env should be a list of tuples {Name, Val}, + where Name is the name of an environment variable, + and Val is the value it is to have in the spawned + port process. Both Name and Val must be + strings. The one exception is Val being the atom + false (in analogy with os:getenv/1), which + removes the environment variable. Not available on + VxWorks.

+ + {args, [ string() ]} + + +

This option is only valid for {spawn_executable, Command} + and specifies arguments to the executable. Each argument + is given as a separate string and (on Unix) eventually + ends up as one element each in the argument vector. On + other platforms, similar behavior is mimicked.

+ +

The arguments are not expanded by the shell prior to + being supplied to the executable, most notably this + means that file wildcard expansion will not happen. Use + filelib:wildcard/1 + to expand wildcards for the arguments. Note that even if + the program is a Unix shell script, meaning that the + shell will ultimately be invoked, wildcard expansion + will not happen and the script will be provided with the + untouched arguments. On Windows®, wildcard expansion + is always up to the program itself, why this isn't an + issue.

+ +

Note also that the actual executable name (a.k.a. argv[0]) + should not be given in this list. The proper executable name will + automatically be used as argv[0] where applicable.

+ +

If one, for any reason, wants to explicitly set the + program name in the argument vector, the arg0 + option can be used.

+ + + {arg0, string()} + + +

This option is only valid for {spawn_executable, Command} + and explicitly specifies the program name argument when + running an executable. This might in some circumstances, + on some operating systems, be desirable. How the program + responds to this is highly system dependent and no specific + effect is guaranteed.

+ + + + exit_status + +

This is only valid for {spawn, Command} where + Command refers to an external program, and for + {spawn_executable, Command}.

+

When the external process connected to the port exits, a + message of the form {Port,{exit_status,Status}} is + sent to the connected process, where Status is the + exit status of the external process. If the program + aborts, on Unix the same convention is used as the shells + do (i.e., 128+signal).

+

If the eof option has been given as well, + the eof message and the exit_status message + appear in an unspecified order.

+

If the port program closes its stdout without exiting, + the exit_status option will not work.

+ + use_stdio + +

This is only valid for {spawn, Command} and + {spawn_executable, Command}. It + allows the standard input and output (file descriptors 0 + and 1) of the spawned (UNIX) process for communication + with Erlang.

+ + nouse_stdio + +

The opposite of use_stdio. Uses file descriptors + 3 and 4 for communication with Erlang.

+ + stderr_to_stdout + +

Affects ports to external programs. The executed program + gets its standard error file redirected to its standard + output file. stderr_to_stdout and + nouse_stdio are mutually exclusive.

+ + overlapped_io + +

Affects ports to external programs on Windows® only. + The standard input and standard output handles of the port program + will, if this option is supplied, be opened with the flag + FILE_FLAG_OVERLAPPED, so that the port program can (and has to) do + overlapped I/O on it's standard handles. This is not normally + the case for simple port programs, but an option of value for the + experienced Windows programmer. On all other platforms, this + option is silently discarded.

+ + in + +

The port can only be used for input.

+ + out + +

The port can only be used for output.

+ + binary + +

All IO from the port are binary data objects as opposed + to lists of bytes.

+ + eof + +

The port will not be closed at the end of the file and + produce an exit signal. Instead, it will remain open and + a {Port, eof} message will be sent to the process + holding the port.

+ + hide + +

When running on Windows, suppress creation of a new + console window when spawning the port program. + (This option has no effect on other platforms.)

+ + +

The default is stream for all types of port and + use_stdio for spawned ports.

+

Failure: If the port cannot be opened, the exit reason is + badarg, system_limit, or the Posix error code which + most closely describes the error, or einval if no Posix code + is appropriate:

+ + badarg + +

Bad input arguments to open_port.

+ + system_limit + +

All available ports in the Erlang emulator are in use.

+ + enomem + +

There was not enough memory to create the port.

+ + eagain + +

There are no more available operating system processes.

+ + enametoolong + +

The external command given was too long.

+ + emfile + +

There are no more available file descriptors (for the operating system process + that the Erlang emulator runs in).

+ + enfile + +

The file table is full (for the entire operating system).

+ + eacces + +

The Command given in {spawn_executable, Command} does not point out an executable file.

+ + enoent + +

The Command given in {spawn_executable, Command} does not point out an existing file.

+ + +

During use of a port opened using {spawn, Name}, + {spawn_driver, Name} or {spawn_executable, Name}, + errors arising when sending messages to it are reported to + the owning process using signals of the form + {'EXIT', Port, PosixCode}. See file(3) for + possible values of PosixCode.

+

+ The maximum number of ports that can be open at the same + time is 1024 by default, but can be configured by + the environment variable ERL_MAX_PORTS.

+ + + + erlang:phash(Term, Range) -> Hash + Portable hash function + + Term = term() + Range = 1..2^32 + Hash = 1..Range + + +

Portable hash function that will give the same hash for + the same Erlang term regardless of machine architecture and + ERTS version (the BIF was introduced in ERTS 4.9.1.1). Range + can be between 1 and 2^32, the function returns a hash value + for Term within the range 1..Range.

+

This BIF could be used instead of the old deprecated + erlang:hash/2 BIF, as it calculates better hashes for + all data-types, but consider using phash2/1,2 instead.

+ + + + erlang:phash2(Term [, Range]) -> Hash + Portable hash function + + Term = term() + Range = 1..2^32 + Hash = 0..Range-1 + + +

Portable hash function that will give the same hash for + the same Erlang term regardless of machine architecture and + ERTS version (the BIF was introduced in ERTS 5.2). Range can + be between 1 and 2^32, the function returns a hash value for + Term within the range 0..Range-1. When called + without the Range argument, a value in the range + 0..2^27-1 is returned.

+

This BIF should always be used for hashing terms. It + distributes small integers better than phash/2, and + it is faster for bignums and binaries.

+

Note that the range 0..Range-1 is different from + the range of phash/2 (1..Range).

+ + + + pid_to_list(Pid) -> string() + Text representation of a pid + + Pid = pid() + + +

Returns a string which corresponds to the text + representation of Pid.

+ +

This BIF is intended for debugging and for use in + the Erlang operating system. It should not be used in + application programs.

+ + + + + port_close(Port) -> true + Close an open port + + Port = port() | atom() + + +

Closes an open port. Roughly the same as + Port ! {self(), close} except for the error behaviour + (see below), and that the port does not reply with + {Port, closed}. Any process may close a port with + port_close/1, not only the port owner (the connected + process).

+

For comparison: Port ! {self(), close} fails with + badarg if Port cannot be sent to (i.e., + Port refers neither to a port nor to a process). If + Port is a closed port nothing happens. If Port + is an open port and the calling process is the port owner, + the port replies with {Port, closed} when all buffers + have been flushed and the port really closes, but if + the calling process is not the port owner the port owner fails with badsig.

+

Note that any process can close a port using + Port ! {PortOwner, close} just as if it itself was + the port owner, but the reply always goes to the port owner.

+

In short: port_close(Port) has a cleaner and more + logical behaviour than Port ! {self(), close}.

+

Failure: badarg if Port is not an open port or + the registered name of an open port.

+ + + + port_command(Port, Data) -> true + Send data to a port + + Port = port() | atom() + Data = iodata() + + +

Sends data to a port. Same as + Port ! {self(), {command, Data}} except for the error + behaviour (see below). Any process may send data to a port + with port_command/2, not only the port owner + (the connected process).

+

For comparison: Port ! {self(), {command, Data}} + fails with badarg if Port cannot be sent to + (i.e., Port refers neither to a port nor to a process). + If Port is a closed port the data message disappears + without a sound. If Port is open and the calling + process is not the port owner, the port owner fails + with badsig. The port owner fails with badsig + also if Data is not a valid IO list.

+

Note that any process can send to a port using + Port ! {PortOwner, {command, Data}} just as if it + itself was the port owner.

+

In short: port_command(Port, Data) has a cleaner and + more logical behaviour than + Port ! {self(), {command, Data}}.

+

If the port is busy, the calling process will be suspended + until the port is not busy anymore.

+

Failures:

+ + badarg + + If Port is not an open port or the registered name + of an open port. + + badarg + + If Data is not a valid io list. + + + + + + erlang:port_command(Port, Data, OptionList) -> true|false + Send data to a port + + Port = port() | atom() + Data = iodata() + OptionList = [Option] + Option = force + Option = nosuspend + + +

Sends data to a port. port_command(Port, Data, []) + equals port_command(Port, Data).

+

If the port command is aborted false is returned; + otherwise, true is returned.

+

If the port is busy, the calling process will be suspended + until the port is not busy anymore.

+

Currently the following Options are valid:

+ + force + The calling process will not be suspended if the port is + busy; instead, the port command is forced through. The + call will fail with a notsup exception if the + driver of the port does not support this. For more + information see the + + driver flag. + + nosuspend + The calling process will not be suspended if the port is + busy; instead, the port command is aborted and + false is returned. + + + +

More options may be added in the future.

+ + +

erlang:port_command/3 is currently not auto imported, but + it is planned to be auto imported in OTP R14.

+ +

Failures:

+ + badarg + + If Port is not an open port or the registered name + of an open port. + + badarg + + If Data is not a valid io list. + + badarg + + If OptionList is not a valid option list. + + notsup + + If the force option has been passed, but the + driver of the port does not allow forcing through + a busy port. + + + + + + port_connect(Port, Pid) -> true + Set the owner of a port + + Port = port() | atom() + Pid = pid() + + +

Sets the port owner (the connected port) to Pid. + Roughly the same as Port ! {self(), {connect, Pid}} + except for the following:

+ + +

The error behavior differs, see below.

+ + +

The port does not reply with + {Port,connected}.

+ + +

The new port owner gets linked to the port.

+ + +

The old port owner stays linked to the port and have to call + unlink(Port) if this is not desired. Any process may + set the port owner to be any process with + port_connect/2.

+

For comparison: Port ! {self(), {connect, Pid}} fails + with badarg if Port cannot be sent to (i.e., + Port refers neither to a port nor to a process). If + Port is a closed port nothing happens. If Port + is an open port and the calling process is the port owner, + the port replies with {Port, connected} to the old + port owner. Note that the old port owner is still linked to + the port, and that the new is not. If Port is an open + port and the calling process is not the port owner, + the port owner fails with badsig. The port + owner fails with badsig also if Pid is not an + existing local pid.

+

Note that any process can set the port owner using + Port ! {PortOwner, {connect, Pid}} just as if it + itself was the port owner, but the reply always goes to + the port owner.

+

In short: port_connect(Port, Pid) has a cleaner and + more logical behaviour than + Port ! {self(),{connect,Pid}}.

+

Failure: badarg if Port is not an open port + or the registered name of an open port, or if Pid is + not an existing local pid.

+ + + + port_control(Port, Operation, Data) -> Res + Perform a synchronous control operation on a port + + Port = port() | atom() + Operation = int() + Data = Res = iodata() + + +

Performs a synchronous control operation on a port. + The meaning of Operation and Data depends on + the port, i.e., on the port driver. Not all port drivers + support this control feature.

+

Returns: a list of integers in the range 0 through 255, or a + binary, depending on the port driver. The meaning of + the returned data also depends on the port driver.

+

Failure: badarg if Port is not an open port or + the registered name of an open port, if Operation + cannot fit in a 32-bit integer, if the port driver does not + support synchronous control operations, or if the port driver + so decides for any reason (probably something wrong with + Operation or Data).

+ + + + erlang:port_call(Port, Operation, Data) -> term() + Synchronous call to a port with term data + + Port = port() | atom() + Operation = int() + Data = term() + + +

Performs a synchronous call to a port. The meaning of + Operation and Data depends on the port, i.e., + on the port driver. Not all port drivers support this feature.

+

Port is a port identifier, referring to a driver.

+

Operation is an integer, which is passed on to + the driver.

+

Data is any Erlang term. This data is converted to + binary term format and sent to the port.

+

Returns: a term from the driver. The meaning of the returned + data also depends on the port driver.

+

Failure: badarg if Port is not an open port or + the registered name of an open port, if Operation + cannot fit in a 32-bit integer, if the port driver does not + support synchronous control operations, or if the port driver + so decides for any reason (probably something wrong with + Operation or Data).

+ + + + erlang:port_info(Port) -> [{Item, Info}] | undefined + Information about a port + + Port = port() | atom() + Item, Info -- see below + + +

Returns a list containing tuples with information about + the Port, or undefined if the port is not open. + The order of the tuples is not defined, nor are all the + tuples mandatory.

+ + {registered_name, RegName} + +

RegName (an atom) is the registered name of + the port. If the port has no registered name, this tuple + is not present in the list.

+ + {id, Index} + +

Index (an integer) is the internal index of the + port. This index may be used to separate ports.

+ + {connected, Pid} + +

Pid is the process connected to the port.

+ + {links, Pids} + +

Pids is a list of pids to which processes the + port is linked.

+ + {name, String} + +

String is the command name set by + open_port.

+ + {input, Bytes} + +

Bytes is the total number of bytes read from + the port.

+ + {output, Bytes} + +

Bytes is the total number of bytes written to + the port.

+ + +

Failure: badarg if Port is not a local port.

+ + + + erlang:port_info(Port, Item) -> {Item, Info} | undefined | [] + Information about a port + + Port = port() | atom() + Item, Info -- see below + + +

Returns information about Port as specified + by Item, or undefined if the port is not open. + Also, if Item == registered_name and the port has no + registered name, [] is returned.

+

For valid values of Item, and corresponding + values of Info, see + erlang:port_info/1.

+

Failure: badarg if Port is not a local port.

+ + + + erlang:port_to_list(Port) -> string() + Text representation of a port identifier + + Port = port() + + +

Returns a string which corresponds to the text + representation of the port identifier Port.

+ +

This BIF is intended for debugging and for use in + the Erlang operating system. It should not be used in + application programs.

+ + + + + erlang:ports() -> [port()] + All open ports + +

Returns a list of all ports on the local node.

+ + + + pre_loaded() -> [Module] + List of all pre-loaded modules + + Module = atom() + + +

Returns a list of Erlang modules which are pre-loaded in + the system. As all loading of code is done through the file + system, the file system must have been loaded previously. + Hence, at least the module init must be pre-loaded.

+ + + + erlang:process_display(Pid, Type) -> void() + Write information about a local process on standard error + + Pid = pid() + Type = backtrace + + +

Writes information about the local process Pid on + standard error. The currently allowed value for the atom + Type is backtrace, which shows the contents of + the call stack, including information about the call chain, with + the current function printed first. The format of the output + is not further defined.

+ + + + process_flag(Flag, Value) -> OldValue + Set process flags for the calling process + + Flag, Value, OldValue -- see below + + +

Sets certain flags for the process which calls this + function. Returns the old value of the flag.

+ + process_flag(trap_exit, Boolean) + +

When trap_exit is set to true, exit signals + arriving to a process are converted to {'EXIT', From, Reason} messages, which can be received as ordinary + messages. If trap_exit is set to false, the + process exits if it receives an exit signal other than + normal and the exit signal is propagated to its + linked processes. Application processes should normally + not trap exits.

+

See also exit/2.

+ + process_flag(error_handler, Module) + +

This is used by a process to redefine the error handler + for undefined function calls and undefined registered + processes. Inexperienced users should not use this flag + since code auto-loading is dependent on the correct + operation of the error handling module.

+ + process_flag(min_heap_size, MinHeapSize) + +

This changes the minimum heap size for the calling + process.

+ + process_flag(priority, Level) + + +

This sets the process priority. Level is an atom. + There are currently four priority levels: low, + normal, high, and max. The default + priority level is normal. NOTE: The + max priority level is reserved for internal use in + the Erlang runtime system, and should not be used + by others. +

+

Internally in each priority level processes are scheduled + in a round robin fashion. +

+

Execution of processes on priority normal and + priority low will be interleaved. Processes on + priority low will be selected for execution less + frequently than processes on priority normal. +

+

When there are runnable processes on priority high + no processes on priority low, or normal will + be selected for execution. Note, however, that this does + not mean that no processes on priority low, + or normal will be able to run when there are + processes on priority high running. On the runtime + system with SMP support there might be more processes running + in parallel than processes on priority high, i.e., + a low, and a high priority process might + execute at the same time. +

+

When there are runnable processes on priority max + no processes on priority low, normal, or + high will be selected for execution. As with the + high priority, processes on lower priorities might + execute in parallel with processes on priority max. +

+

Scheduling is preemptive. Regardless of priority, a process + is preempted when it has consumed more than a certain amount + of reductions since the last time it was selected for + execution. +

+

NOTE: You should not depend on the scheduling + to remain exactly as it is today. Scheduling, at least on + the runtime system with SMP support, is very likely to be + modified in the future in order to better utilize available + processor cores. +

+

There is currently no automatic mechanism for + avoiding priority inversion, such as priority inheritance, + or priority ceilings. When using priorities you have + to take this into account and handle such scenarios by + yourself. +

+

Making calls from a high priority process into code + that you don't have control over may cause the high + priority process to wait for a processes with lower + priority, i.e., effectively decreasing the priority of the + high priority process during the call. Even if this + isn't the case with one version of the code that you don't + have under your control, it might be the case in a future + version of it. This might, for example, happen if a + high priority process triggers code loading, since + the code server runs on priority normal. +

+

Other priorities than normal are normally not needed. + When other priorities are used, they need to be used + with care, especially the high priority must + be used with care. A process on high priority should + only perform work for short periods of time. Busy looping for + long periods of time in a high priority process will + most likely cause problems, since there are important servers + in OTP running on priority normal. +

+ + + process_flag(save_calls, N) + +

When there are runnable processes on priority max + no processes on priority low, normal, or + high will be selected for execution. As with the + high priority, processes on lower priorities might + execute in parallel with processes on priority max. +

+

N must be an integer in the interval 0..10000. + If N > 0, call saving is made active for the + process, which means that information about the N + most recent global function calls, BIF calls, sends and + receives made by the process are saved in a list, which + can be retrieved with + process_info(Pid, last_calls). A global function + call is one in which the module of the function is + explicitly mentioned. Only a fixed amount of information + is saved: a tuple {Module, Function, Arity} for + function calls, and the mere atoms send, + 'receive' and timeout for sends and receives + ('receive' when a message is received and + timeout when a receive times out). If N = 0, + call saving is disabled for the process, which is the + default. Whenever the size of the call saving list is set, + its contents are reset.

+ + process_flag(sensitive, Boolean) + +

Set or clear the sensitive flag for the current process. + When a process has been marked as sensitive by calling + process_flag(sensitive, true), features in the run-time + system that can be used for examining the data and/or inner working + of the process are silently disabled.

+

Features that are disabled include (but are not limited to) + the following:

+

Tracing: Trace flags can still be set for the process, but no + trace messages of any kind will be generated. + (If the sensitive flag is turned off, trace messages will + again be generated if there are any trace flags set.)

+

Sequential tracing: The sequential trace token will be propagated + as usual, but no sequential trace messages will be generated.

+

process_info/1,2 cannot be used to read out the message + queue or the process dictionary (both will be returned as empty lists).

+

Stack back-traces cannot be displayed for the process.

+

In crash dumps, the stack, messages, and the process dictionary + will be omitted.

+

If {save_calls,N} has been set for the process, no + function calls will be saved to the call saving list. + (The call saving list will not be cleared; furthermore, send, receive, + and timeout events will still be added to the list.)

+ + + + + + process_flag(Pid, Flag, Value) -> OldValue + Set process flags for a process + + Pid = pid() + Flag, Value, OldValue -- see below + + +

Sets certain flags for the process Pid, in the same + manner as + process_flag/2. + Returns the old value of the flag. The allowed values for + Flag are only a subset of those allowed in + process_flag/2, namely: save_calls.

+

Failure: badarg if Pid is not a local process.

+ + + + process_info(Pid) -> InfoResult + Information about a process + + Pid = pid() + Item = atom() + Info = term() + InfoTuple = {Item, Info} + InfoTupleList = [InfoTuple] + InfoResult = InfoTupleList | undefined + + +

Returns a list containing InfoTuples with + miscellaneous information about the process identified by + Pid, or undefined if the process is not alive. +

+

+ The order of the InfoTuples is not defined, nor + are all the InfoTuples mandatory. The InfoTuples + part of the result may be changed without prior notice. + Currently InfoTuples with the following Items + are part of the result: + current_function, initial_call, status, + message_queue_len, messages, links, + dictionary, trap_exit, error_handler, + priority, group_leader, total_heap_size, + heap_size, stack_size, reductions, and + garbage_collection. + If the process identified by Pid has a registered name + also an InfoTuple with Item == registered_name + will appear. +

+

See process_info/2 + for information about specific InfoTuples.

+ +

This BIF is intended for debugging only, use + process_info/2 + for all other purposes. +

+ +

Failure: badarg if Pid is not a local process.

+ + + + process_info(Pid, ItemSpec) -> InfoResult + Information about a process + + Pid = pid() + Item = atom() + Info = term() + ItemList = [Item] + ItemSpec = Item | ItemList + InfoTuple = {Item, Info} + InfoTupleList = [InfoTuple] + InfoResult = InfoTuple | InfoTupleList | undefined | [] + + +

Returns information about the process identified by Pid + as specified by the ItemSpec, or undefined if the + process is not alive. +

+

If the process is alive and ItemSpec is a single + Item, the returned value is the corresponding + InfoTuple unless ItemSpec == registered_name + and the process has no registered name. In this case + [] is returned. This strange behavior is due to + historical reasons, and is kept for backward compatibility. +

+

If ItemSpec is an ItemList, the result is an + InfoTupleList. The InfoTuples in the + InfoTupleList will appear with the corresponding + Items in the same order as the Items appeared + in the ItemList. Valid Items may appear multiple + times in the ItemList. +

+

If registered_name is part of an ItemList + and the process has no name registered a + {registered_name, []} InfoTuple will + appear in the resulting InfoTupleList. This + behavior is different than when + ItemSpec == registered_name, and than when + process_info/1 is used. +

+

Currently the following InfoTuples with corresponding + Items are valid:

+ + {backtrace, Bin} + +

The binary Bin contains the same information as + the output from + erlang:process_display(Pid, backtrace). Use + binary_to_list/1 to obtain the string of characters + from the binary.

+ + {binary, BinInfo} + +

BinInfo is a list containing miscellaneous information + about binaries currently being referred to by this process. + This InfoTuple may be changed or removed without prior + notice.

+ + {catchlevel, CatchLevel} + +

CatchLevel is the number of currently active + catches in this process. This InfoTuple may be + changed or removed without prior notice.

+ + {current_function, {Module, Function, Args}} + +

Module, Function, Args is + the current function call of the process.

+ + {dictionary, Dictionary} + +

Dictionary is the dictionary of the process.

+ + {error_handler, Module} + +

Module is the error handler module used by + the process (for undefined function calls, for example).

+ + {garbage_collection, GCInfo} + +

GCInfo is a list which contains miscellaneous + information about garbage collection for this process. + The content of GCInfo may be changed without + prior notice.

+ + {group_leader, GroupLeader} + +

GroupLeader is group leader for the IO of + the process.

+ + {heap_size, Size} + +

Size is the size in words of youngest heap generation + of the process. This generation currently include the stack + of the process. This information is highly implementation + dependent, and may change if the implementation change. +

+ + {initial_call, {Module, Function, Arity}} + +

Module, Function, Arity is + the initial function call with which the process was + spawned.

+ + {links, Pids} + +

Pids is a list of pids, with processes to + which the process has a link.

+ + {last_calls, false|Calls} + +

The value is false if call saving is not active + for the process (see + process_flag/3). + If call saving is active, a list is returned, in which + the last element is the most recent called.

+ + {memory, Size} + +

Size is the size in bytes of the process. This + includes call stack, heap and internal structures.

+ + {message_binary, BinInfo} + +

BinInfo is a list containing miscellaneous information + about binaries currently being referred to by the message + area. This InfoTuple is only valid on an emulator + using the hybrid heap type. This InfoTuple may be + changed or removed without prior notice.

+ + {message_queue_len, MessageQueueLen} + +

MessageQueueLen is the number of messages + currently in the message queue of the process. This is + the length of the list MessageQueue returned as + the info item messages (see below).

+ + {messages, MessageQueue} + +

MessageQueue is a list of the messages to + the process, which have not yet been processed.

+ + {monitored_by, Pids} + +

A list of pids that are monitoring the process (with + erlang:monitor/2).

+ + {monitors, Monitors} + +

A list of monitors (started by erlang:monitor/2) + that are active for the process. For a local process + monitor or a remote process monitor by pid, the list item + is {process, Pid}, and for a remote process + monitor by name, the list item is + {process, {RegName, Node}}.

+ + {priority, Level} + +

Level is the current priority level for + the process. For more information on priorities see + process_flag(priority, Level).

+ + {reductions, Number} + +

Number is the number of reductions executed by + the process.

+ + {registered_name, Atom} + +

Atom is the registered name of the process. If + the process has no registered name, this tuple is not + present in the list.

+ + {sequential_trace_token, [] | SequentialTraceToken} + +

SequentialTraceToken the sequential trace token for + the process. This InfoTuple may be changed or removed + without prior notice.

+ + {stack_size, Size} + +

Size is the stack size of the process in words.

+ + {status, Status} + +

Status is the status of the process. Status + is waiting (waiting for a message), running, + runnable (ready to run, but another process is + running), or suspended (suspended on a "busy" port + or by the erlang:suspend_process/[1,2] BIF).

+ + {suspending, SuspendeeList} + +

SuspendeeList is a list of {Suspendee, + ActiveSuspendCount, OutstandingSuspendCount} tuples. + Suspendee is the pid of a process that have been or is to + be suspended by the process identified by Pid via the + erlang:suspend_process/2 + BIF, or the + erlang:suspend_process/1 + BIF. ActiveSuspendCount is the number of times the + Suspendee has been suspended by Pid. + OutstandingSuspendCount is the number of not yet + completed suspend requests sent by Pid. That is, + if ActiveSuspendCount /= 0, Suspendee is + currently in the suspended state, and if + OutstandingSuspendCount /= 0 the asynchronous + option of erlang:suspend_process/2 has been used and + the suspendee has not yet been suspended by Pid. + Note that the ActiveSuspendCount and + OutstandingSuspendCount are not the total suspend count + on Suspendee, only the parts contributed by Pid. +

+ + {total_heap_size, Size} + +

Size is the total size in words of all heap + fragments of the process. This currently include the stack + of the process. +

+ + {trace, InternalTraceFlags} + +

InternalTraceFlags is an integer representing + internal trace flag for this process. This InfoTuple + may be changed or removed without prior notice.

+ + {trap_exit, Boolean} + +

Boolean is true if the process is trapping + exits, otherwise it is false.

+ + +

Note however, that not all implementations support every one + of the above Items.

+

Failure: badarg if Pid is not a local process, + or if Item is not a valid Item.

+ + + + processes() -> [pid()] + All processes + +

Returns a list of process identifiers corresponding to + all the processes currently existing on the local node. +

+

Note that a process that is exiting, exists but is not alive, i.e., + is_process_alive/1 will return false for a process + that is exiting, but its process identifier will be part + of the result returned from processes/0. +

+ 
+> processes().
+[<0.0.0>,<0.2.0>,<0.4.0>,<0.5.0>,<0.7.0>,<0.8.0>]
+ + + + purge_module(Module) -> void() + Remove old code for a module + + Module = atom() + + +

Removes old code for Module. Before this BIF is used, + erlang:check_process_code/2 should be called to check + that no processes are executing old code in the module.

+ +

This BIF is intended for the code server (see + code(3)) and should not be + used elsewhere.

+ +

Failure: badarg if there is no old code for + Module.

+ + + + put(Key, Val) -> OldVal | undefined + Add a new value to the process dictionary + + Key = Val = OldVal = term() + + +

Adds a new Key to the process dictionary, associated + with the value Val, and returns undefined. If + Key already exists, the old value is deleted and + replaced by Val and the function returns the old value.

+ +

The values stored when put is evaluated within + the scope of a catch will not be retracted if a + throw is evaluated, or if an error occurs.

+ + 
+> X = put(name, walrus), Y = put(name, carpenter),
+Z = get(name),
+{X, Y, Z}.
+{undefined,walrus,carpenter}
+ + + + erlang:raise(Class, Reason, Stacktrace) + Stop execution with an exception of given class, reason and call stack backtrace + + Class = error | exit | throw + Reason = term() + Stacktrace = [{Module, Function, Arity | Args} | {Fun, Args}] +  Module = Function = atom() +  Arity = int() +  Args = [term()] +  Fun = [fun()] + + +

Stops the execution of the calling process with an + exception of given class, reason and call stack backtrace + (stacktrace).

+ +

This BIF is intended for debugging and for use in + the Erlang operating system. In general, it should + be avoided in applications, unless you know + very well what you are doing.

+ +

Class is one of error, exit or + throw, so if it were not for the stacktrace + erlang:raise(Class, Reason, Stacktrace) is + equivalent to erlang:Class(Reason). + Reason is any term and Stacktrace is a list as + returned from get_stacktrace(), that is a list of + 3-tuples {Module, Function, Arity | Args} where + Module and Function are atoms and the third + element is an integer arity or an argument list. The + stacktrace may also contain {Fun, Args} tuples where + Fun is a local fun and Args is an argument list.

+

The stacktrace is used as the exception stacktrace for the + calling process; it will be truncated to the current + maximum stacktrace depth.

+

Because evaluating this function causes the process to + terminate, it has no return value - unless the arguments are + invalid, in which case the function returns the error reason, that is badarg. If you want to be + really sure not to return you can call + erlang:error(erlang:raise(Class, Reason, Stacktrace)) + and hope to distinguish exceptions later.

+ + + + erlang:read_timer(TimerRef) -> int() | false + Number of milliseconds remaining for a timer + + TimerRef = ref() + + +

TimerRef is a timer reference returned by + erlang:send_after/3 + or + erlang:start_timer/3. + If the timer is active, the function returns the time in + milliseconds left until the timer will expire, otherwise + false (which means that TimerRef was never a + timer, that it has been cancelled, or that it has already + delivered its message).

+

See also + erlang:send_after/3, + erlang:start_timer/3, + and + erlang:cancel_timer/1.

+ + + + erlang:ref_to_list(Ref) -> string() + Text representation of a reference + + Ref = ref() + + +

Returns a string which corresponds to the text + representation of Ref.

+ +

This BIF is intended for debugging and for use in + the Erlang operating system. It should not be used in + application programs.

+ + + + + register(RegName, Pid | Port) -> true + Register a name for a pid (or port) + + RegName = atom() + Pid = pid() + Port = port() + + +

Associates the name RegName with a pid or a port + identifier. RegName, which must be an atom, can be used + instead of the pid / port identifier in the send operator + (RegName ! Message).

+ 
+> register(db, Pid).
+true
+

Failure: badarg if Pid is not an existing, + local process or port, if RegName is already in use, + if the process or port is already registered (already has a + name), or if RegName is the atom undefined.

+ + + + registered() -> [RegName] + All registered names + + RegName = atom() + + +

Returns a list of names which have been registered using + register/2.

+ 
+> registered().
+[code_server, file_server, init, user, my_db]
+ + + + erlang:resume_process(Suspendee) -> true + Resume a suspended process + + Suspendee = pid() + + +

Decreases the suspend count on the process identified by + Suspendee. Suspendee should previously have been + suspended via + erlang:suspend_process/2, + or + erlang:suspend_process/1 + by the process calling erlang:resume_process(Suspendee). When + the suspend count on Suspendee reach zero, Suspendee + will be resumed, i.e., the state of the Suspendee is changed + from suspended into the state Suspendee was in before it was + suspended. +

+ +

This BIF is intended for debugging only.

+ +

Failures:

+ + badarg + + If Suspendee isn't a process identifier. + + badarg + + If the process calling erlang:resume_process/1 had + not previously increased the suspend count on the process + identified by Suspendee. + + badarg + + If the process identified by Suspendee is not alive. + + + + + + round(Number) -> int() + Return an integer by rounding a number + + Number = number() + + +

Returns an integer by rounding Number.

+ 
+> round(5.5).
+6
+

Allowed in guard tests.

+ + + + self() -> pid() + Pid of the calling process + +

Returns the pid (process identifier) of the calling process.

+ 
+> self().
+<0.26.0>
+

Allowed in guard tests.

+ + + + erlang:send(Dest, Msg) -> Msg + Send a message + + Dest = pid() | port() | RegName | {RegName, Node} + Msg = term() +  RegName = atom() +  Node = node() + + +

Sends a message and returns Msg. This is the same as + Dest ! Msg.

+

Dest may be a remote or local pid, a (local) port, a + locally registered name, or a tuple {RegName, Node} + for a registered name at another node.

+ + + + erlang:send(Dest, Msg, [Option]) -> Res + Send a message conditionally + + Dest = pid() | port() | RegName | {RegName, Node} +  RegName = atom() +  Node = node() + Msg = term() + Option = nosuspend | noconnect + Res = ok | nosuspend | noconnect + + +

Sends a message and returns ok, or does not send + the message but returns something else (see below). Otherwise + the same as + erlang:send/2. See + also + erlang:send_nosuspend/2,3. + for more detailed explanation and warnings.

+

The possible options are:

+ + nosuspend + +

If the sender would have to be suspended to do the send, + nosuspend is returned instead.

+ + noconnect + +

If the destination node would have to be auto-connected + before doing the send, noconnect is returned + instead.

+ + + +

As with erlang:send_nosuspend/2,3: Use with extreme + care!

+ + + + + erlang:send_after(Time, Dest, Msg) -> TimerRef + Start a timer + + Time = int() +  0 <= Time <= 4294967295 + Dest = pid() | RegName +  LocalPid = pid() (of a process, alive or dead, on the local node) + Msg = term() + TimerRef = ref() + + +

Starts a timer which will send the message Msg + to Dest after Time milliseconds.

+

If Dest is an atom, it is supposed to be the name of + a registered process. The process referred to by the name is + looked up at the time of delivery. No error is given if + the name does not refer to a process.

+

If Dest is a pid, the timer will be automatically + canceled if the process referred to by the pid is not alive, + or when the process exits. This feature was introduced in + erts version 5.4.11. Note that timers will not be + automatically canceled when Dest is an atom.

+

See also + erlang:start_timer/3, + erlang:cancel_timer/1, + and + erlang:read_timer/1.

+

Failure: badarg if the arguments does not satisfy + the requirements specified above.

+ + + + erlang:send_nosuspend(Dest, Msg) -> bool() + Try to send a message without ever blocking + + Dest = pid() | port() | RegName | {RegName, Node} +  RegName = atom() +  Node = node() + Msg = term() + + +

The same as + erlang:send(Dest, Msg, [nosuspend]), but returns true if + the message was sent and false if the message was not + sent because the sender would have had to be suspended.

+

This function is intended for send operations towards an + unreliable remote node without ever blocking the sending + (Erlang) process. If the connection to the remote node + (usually not a real Erlang node, but a node written in C or + Java) is overloaded, this function will not send the message but return false instead.

+

The same happens, if Dest refers to a local port that + is busy. For all other destinations (allowed for the ordinary + send operator '!') this function sends the message and + returns true.

+

This function is only to be used in very rare circumstances + where a process communicates with Erlang nodes that can + disappear without any trace causing the TCP buffers and + the drivers queue to be over-full before the node will actually + be shut down (due to tick timeouts) by net_kernel. The + normal reaction to take when this happens is some kind of + premature shutdown of the other node.

+

Note that ignoring the return value from this function would + result in unreliable message passing, which is + contradictory to the Erlang programming model. The message is + not sent if this function returns false.

+

Note also that in many systems, transient states of + overloaded queues are normal. The fact that this function + returns false does not in any way mean that the other + node is guaranteed to be non-responsive, it could be a + temporary overload. Also a return value of true does + only mean that the message could be sent on the (TCP) channel + without blocking, the message is not guaranteed to have + arrived at the remote node. Also in the case of a disconnected + non-responsive node, the return value is true (mimics + the behaviour of the ! operator). The expected + behaviour as well as the actions to take when the function + returns false are application and hardware specific.

+ +

Use with extreme care!

+ + + + + erlang:send_nosuspend(Dest, Msg, Options) -> bool() + Try to send a message without ever blocking + + Dest = pid() | port() | RegName | {RegName, Node} +  RegName = atom() +  Node = node() + Msg = term() + Option = noconnect + + +

The same as + erlang:send(Dest, Msg, [nosuspend | Options]), + but with boolean return value.

+

This function behaves like + erlang:send_nosuspend/2), + but takes a third parameter, a list of options. The only + currently implemented option is noconnect. The option + noconnect makes the function return false if + the remote node is not currently reachable by the local + node. The normal behaviour is to try to connect to the node, + which may stall the process for a shorter period. The use of + the noconnect option makes it possible to be + absolutely sure not to get even the slightest delay when + sending to a remote process. This is especially useful when + communicating with nodes who expect to always be + the connecting part (i.e. nodes written in C or Java).

+

Whenever the function returns false (either when a + suspend would occur or when noconnect was specified and + the node was not already connected), the message is guaranteed + not to have been sent.

+ +

Use with extreme care!

+ + + + + erlang:set_cookie(Node, Cookie) -> true + Set the magic cookie of a node + + Node = node() + Cookie = atom() + + +

Sets the magic cookie of Node to the atom + Cookie. If Node is the local node, the function + also sets the cookie of all other unknown nodes to + Cookie (see + Distributed Erlang in the Erlang Reference Manual).

+

Failure: function_clause if the local node is not + alive.

+ + + + setelement(Index, Tuple1, Value) -> Tuple2 + Set Nth element of a tuple + + Index = 1..tuple_size(Tuple1) + Tuple1 = Tuple2 = tuple() + Value = term() + + +

Returns a tuple which is a copy of the argument Tuple1 + with the element given by the integer argument Index + (the first element is the element with index 1) replaced by + the argument Value.

+ 
+> setelement(2, {10, green, bottles}, red).
+{10,red,bottles}
+ + + + size(Item) -> int() + Size of a tuple or binary + + Item = tuple() | binary() + + +

Returns an integer which is the size of the argument + Item, which must be either a tuple or a binary.

+ 
+> size({morni, mulle, bwange}).
+3
+

Allowed in guard tests.

+ + + + spawn(Fun) -> pid() + Create a new process with a fun as entry point + + Fun = fun() + + +

Returns the pid of a new process started by the application + of Fun to the empty list []. Otherwise works + like spawn/3.

+ + + + spawn(Node, Fun) -> pid() + Create a new process with a fun as entry point on a given node + + Node = node() + Fun = fun() + + +

Returns the pid of a new process started by the application + of Fun to the empty list [] on Node. If + Node does not exist, a useless pid is returned. + Otherwise works like + spawn/3.

+ + + + spawn(Module, Function, Args) -> pid() + Create a new process with a function as entry point + + Module = Function = atom() + Args = [term()] + + +

Returns the pid of a new process started by the application + of Module:Function to Args. The new process + created will be placed in the system scheduler queue and be + run some time later.

+

error_handler:undefined_function(Module, Function, Args) is evaluated by the new process if + Module:Function/Arity does not exist (where + Arity is the length of Args). The error handler + can be redefined (see + process_flag/2). + If error_handler is undefined, or the user has + redefined the default error_handler its replacement is + undefined, a failure with the reason undef will occur.

+ 
+> spawn(speed, regulator, [high_speed, thin_cut]).
+<0.13.1>
+ + + + spawn(Node, Module, Function, ArgumentList) -> pid() + Create a new process with a function as entry point on a given node + + Node = node() + Module = Function = atom() + Args = [term()] + + +

Returns the pid of a new process started by the application + of Module:Function to Args on Node. If + Node does not exists, a useless pid is returned. + Otherwise works like + spawn/3.

+ + + + spawn_link(Fun) -> pid() + Create and link to a new process with a fun as entry point + + Fun = fun() + + +

Returns the pid of a new process started by the application + of Fun to the empty list []. A link is created between + the calling process and the new process, atomically. + Otherwise works like + spawn/3.

+ + + + spawn_link(Node, Fun) -> + Create and link to a new process with a fun as entry point on a specified node + + Node = node() + Fun = fun() + + +

Returns the pid of a new process started by the application + of Fun to the empty list [] on Node. A link is + created between the calling process and the new process, + atomically. If Node does not exist, a useless pid is + returned (and due to the link, an exit signal with exit + reason noconnection will be received). Otherwise works + like spawn/3.

+ + + + spawn_link(Module, Function, Args) -> pid() + Create and link to a new process with a function as entry point + + Module = Function = atom() + Args = [term()] + + +

Returns the pid of a new process started by the application + of Module:Function to Args. A link is created + between the calling process and the new process, atomically. + Otherwise works like + spawn/3.

+ + + + spawn_link(Node, Module, Function, Args) -> pid() + Create and link to a new process with a function as entry point on a given node + + Node = node() + Module = Function = atom() + Args = [term()] + + +

Returns the pid of a new process started by the application + of Module:Function to Args on Node. A + link is created between the calling process and the new + process, atomically. If Node does not exist, a useless + pid is returned (and due to the link, an exit signal with exit + reason noconnection will be received). Otherwise works + like spawn/3.

+ + + + spawn_monitor(Fun) -> {pid(),reference()} + Create and monitor a new process with a fun as entry point + + Fun = fun() + + +

Returns the pid of a new process started by the application + of Fun to the empty list [] and reference for a monitor + created to the new process. + Otherwise works like + spawn/3.

+ + + + spawn_monitor(Module, Function, Args) -> {pid(),reference()} + Create and monitor a new process with a function as entry point + + Module = Function = atom() + Args = [term()] + + +

A new process is started by the application + of Module:Function to Args, and the process is + monitored at the same time. Returns the pid and a reference + for the monitor. + Otherwise works like + spawn/3.

+ + + + spawn_opt(Fun, [Option]) -> pid() | {pid(),reference()} + Create a new process with a fun as entry point + + Fun = fun() + Option = link | monitor | {priority, Level} | {fullsweep_after, Number} | {min_heap_size, Size} +  Level = low | normal | high +  Number = int() +  Size = int() + + +

Returns the pid of a new process started by the application + of Fun to the empty list []. Otherwise + works like + spawn_opt/4.

+

If the option monitor is given, the newly created + process will be monitored and both the pid and reference for + the monitor will be returned.

+ + + + spawn_opt(Node, Fun, [Option]) -> pid() + Create a new process with a fun as entry point on a given node + + Node = node() + Fun = fun() + Option = link | {priority, Level} | {fullsweep_after, Number} | {min_heap_size, Size} +  Level = low | normal | high +  Number = int() +  Size = int() + + +

Returns the pid of a new process started by the application + of Fun to the empty list [] on Node. If + Node does not exist, a useless pid is returned. + Otherwise works like + spawn_opt/4.

+ + + + spawn_opt(Module, Function, Args, [Option]) -> pid() | {pid(),reference()} + Create a new process with a function as entry point + + Module = Function = atom() + Args = [term()] + Option = link | monitor | {priority, Level} | {fullsweep_after, Number} | {min_heap_size, Size} +  Level = low | normal | high +  Number = int() +  Size = int() + + +

Works exactly like + spawn/3, except that an + extra option list is given when creating the process.

+

If the option monitor is given, the newly created + process will be monitored and both the pid and reference for + the monitor will be returned.

+ + link + +

Sets a link to the parent process (like + spawn_link/3 does).

+ + monitor + +

Monitor the new process (just like + erlang:monitor/2 does).

+ + {priority, Level} + +

Sets the priority of the new process. Equivalent to + executing + process_flag(priority, Level) in the start function of the new process, + except that the priority will be set before the process is + selected for execution for the first time. For more information + on priorities see + process_flag(priority, Level).

+ + {fullsweep_after, Number} + +

This option is only useful for performance tuning. + In general, you should not use this option unless you + know that there is problem with execution times and/or + memory consumption, and you should measure to make sure + that the option improved matters. +

+

The Erlang runtime system uses a generational garbage + collection scheme, using an "old heap" for data that has + survived at least one garbage collection. When there is + no more room on the old heap, a fullsweep garbage + collection will be done.

+

The fullsweep_after option makes it possible to + specify the maximum number of generational collections + before forcing a fullsweep even if there is still room on + the old heap. Setting the number to zero effectively + disables the general collection algorithm, meaning that + all live data is copied at every garbage collection.

+

Here are a few cases when it could be useful to change + fullsweep_after. Firstly, if binaries that are no + longer used should be thrown away as soon as possible. + (Set Number to zero.) Secondly, a process that + mostly have short-lived data will be fullsweeped seldom + or never, meaning that the old heap will contain mostly + garbage. To ensure a fullsweep once in a while, set + Number to a suitable value such as 10 or 20. + Thirdly, in embedded systems with limited amount of RAM + and no virtual memory, one might want to preserve memory + by setting Number to zero. (The value may be set + globally, see + erlang:system_flag/2.)

+ + {min_heap_size, Size} + +

This option is only useful for performance tuning. + In general, you should not use this option unless you + know that there is problem with execution times and/or + memory consumption, and you should measure to make sure + that the option improved matters. +

+

Gives a minimum heap size in words. Setting this value + higher than the system default might speed up some + processes because less garbage collection is done. + Setting too high value, however, might waste memory and + slow down the system due to worse data locality. + Therefore, it is recommended to use this option only for + fine-tuning an application and to measure the execution + time with various Size values.

+ + + + + + spawn_opt(Node, Module, Function, Args, [Option]) -> pid() + Create a new process with a function as entry point on a given node + + Node = node() + Module = Function = atom() + Args = [term()] + Option = link | {priority, Level} | {fullsweep_after, Number} | {min_heap_size, Size} +  Level = low | normal | high +  Number = int() +  Size = int() + + +

Returns the pid of a new process started by the application + of Module:Function to Args on Node. If + Node does not exist, a useless pid is returned. + Otherwise works like + spawn_opt/4.

+ + + + split_binary(Bin, Pos) -> {Bin1, Bin2} + Split a binary into two + + Bin = Bin1 = Bin2 = binary() + Pos = 1..byte_size(Bin) + + +

Returns a tuple containing the binaries which are the result + of splitting Bin into two parts at position Pos. + This is not a destructive operation. After the operation, + there will be three binaries altogether.

+ 
+> B = list_to_binary("0123456789").
+<<"0123456789">>
+> byte_size(B).
+10
+> {B1, B2} = split_binary(B,3).
+{<<"012">>,<<"3456789">>}
+> byte_size(B1).
+3
+> byte_size(B2).
+7
+ + + + erlang:start_timer(Time, Dest, Msg) -> TimerRef + Start a timer + + Time = int() +  0 <= Time <= 4294967295 + Dest = LocalPid | RegName +  LocalPid = pid() (of a process, alive or dead, on the local node) +  RegName = atom() + Msg = term() + TimerRef = ref() + + +

Starts a timer which will send the message + {timeout, TimerRef, Msg} to Dest + after Time milliseconds.

+

If Dest is an atom, it is supposed to be the name of + a registered process. The process referred to by the name is + looked up at the time of delivery. No error is given if + the name does not refer to a process.

+

If Dest is a pid, the timer will be automatically + canceled if the process referred to by the pid is not alive, + or when the process exits. This feature was introduced in + erts version 5.4.11. Note that timers will not be + automatically canceled when Dest is an atom.

+

See also + erlang:send_after/3, + erlang:cancel_timer/1, + and + erlang:read_timer/1.

+

Failure: badarg if the arguments does not satisfy + the requirements specified above.

+ + + + statistics(Type) -> Res + Information about the system + + Type, Res -- see below + + +

Returns information about the system as specified by + Type:

+ + context_switches + +

Returns {ContextSwitches, 0}, where + ContextSwitches is the total number of context + switches since the system started.

+ + exact_reductions + + +

Returns + {Total_Exact_Reductions, Exact_Reductions_Since_Last_Call}.

+

NOTE:statistics(exact_reductions) is + a more expensive operation than + statistics(reductions) + especially on an Erlang machine with SMP support.

+ + garbage_collection + +

Returns {Number_of_GCs, Words_Reclaimed, 0}. This + information may not be valid for all implementations.

+ + io + +

Returns {{input, Input}, {output, Output}}, + where Input is the total number of bytes received + through ports, and Output is the total number of + bytes output to ports.

+ + reductions + + +

Returns + {Total_Reductions, Reductions_Since_Last_Call}.

+

NOTE: From erts version 5.5 (OTP release R11B) + this value does not include reductions performed in current + time slices of currently scheduled processes. If an + exact value is wanted, use + statistics(exact_reductions).

+ + run_queue + +

Returns the length of the run queue, that is, the number + of processes that are ready to run.

+ + runtime + +

Returns {Total_Run_Time, Time_Since_Last_Call}. + Note that the run-time is the sum of the run-time for all + threads in the Erlang run-time system and may therefore be greater + than the wall-clock time.

+ + wall_clock + +

Returns + {Total_Wallclock_Time, Wallclock_Time_Since_Last_Call}. + wall_clock can be used in the same manner as + runtime, except that real time is measured as + opposed to runtime or CPU time.

+ + +

All times are in milliseconds.

+ 
+> statistics(runtime).
+{1690,1620}
+> statistics(reductions).
+{2046,11}
+> statistics(garbage_collection).
+{85,23961,0}
+ + + + erlang:suspend_process(Suspendee, OptList) -> true | false + Suspend a process + + Suspendee = pid() + OptList = [Opt] + Opt = atom() + + +

Increases the suspend count on the process identified by + Suspendee and puts it in the suspended state if it isn't + already in the suspended state. A suspended process will not be + scheduled for execution until the process has been resumed. +

+ +

A process can be suspended by multiple processes and can + be suspended multiple times by a single process. A suspended + process will not leave the suspended state until its suspend + count reach zero. The suspend count of Suspendee is + decreased when + erlang:resume_process(Suspendee) + is called by the same process that called + erlang:suspend_process(Suspendee). All increased suspend + counts on other processes acquired by a process will automatically be + decreased when the process terminates.

+ +

Currently the following options (Opts) are available:

+ + asynchronous + + A suspend request is sent to the process identified by + Suspendee. Suspendee will eventually suspend + unless it is resumed before it was able to suspend. The caller + of erlang:suspend_process/2 will return immediately, + regardless of whether the Suspendee has suspended yet + or not. Note that the point in time when the Suspendee + will actually suspend cannot be deduced from other events + in the system. The only guarantee given is that the + Suspendee will eventually suspend (unless it + is resumed). If the asynchronous option has not + been passed, the caller of erlang:suspend_process/2 will + be blocked until the Suspendee has actually suspended. + + unless_suspending + + The process identified by Suspendee will be suspended + unless the calling process already is suspending the + Suspendee. If unless_suspending is combined + with the asynchronous option, a suspend request will be + sent unless the calling process already is suspending the + Suspendee or if a suspend request already has been sent + and is in transit. If the calling process already is suspending + the Suspendee, or if combined with the asynchronous + option and a send request already is in transit, + false is returned and the suspend count on Suspendee + will remain unchanged. + + + +

If the suspend count on the process identified by + Suspendee was increased, true is returned; otherwise, + false is returned.

+ + +

This BIF is intended for debugging only.

+ +

Failures:

+ + badarg + + If Suspendee isn't a process identifier. + + badarg + + If the process identified by Suspendee is same the process as + the process calling erlang:suspend_process/2. + + badarg + + If the process identified by Suspendee is not alive. + + badarg + + If the process identified by Suspendee resides on another node. + + badarg + + If OptList isn't a proper list of valid Opts. + + system_limit + + If the process identified by Suspendee has been suspended more + times by the calling process than can be represented by the + currently used internal data structures. The current system limit + is larger than 2 000 000 000 suspends, and it will never be less + than that. + + + + + + erlang:suspend_process(Suspendee) -> true + Suspend a process + + Suspendee = pid() + + +

Suspends the process identified by Suspendee. The + same as calling + erlang:suspend_process(Suspendee, []). For more information see the documentation of erlang:suspend_process/2. +

+ +

This BIF is intended for debugging only.

+ + + + + erlang:system_flag(Flag, Value) -> OldValue + Set system flags + + Flag, Value, OldValue -- see below + + +

Sets various system properties of the Erlang node. Returns + the old value of the flag.

+ + erlang:system_flag(backtrace_depth, Depth) + +

Sets the maximum depth of call stack back-traces in the + exit reason element of 'EXIT' tuples.

+ + erlang:system_flag(cpu_topology, CpuTopology) + + +

Sets the user defined CpuTopology. The user defined + CPU topology will override any automatically detected + CPU topology. By passing undefined as CpuTopology + the system will revert back to the CPU topology automatically + detected. The returned value equals the value returned + from erlang:system_info(cpu_topology) before the + change was made. +

+

The CPU topology is used when binding schedulers to logical + processors. If schedulers are already bound when the CPU + topology is changed, the schedulers will be sent a request + to rebind according to the new CPU topology. +

+

The user defined CPU topology can also be set by passing + the +sct command + line argument to erl. +

+

For information on the CpuTopology type + and more, see the documentation of + erlang:system_info(cpu_topology), + the erl +sct + emulator flag, and + erlang:system_flag(scheduler_bind_type, How). +

+ + erlang:system_flag(fullsweep_after, Number) + +

Number is a non-negative integer which indicates + how many times generational garbage collections can be + done without forcing a fullsweep collection. The value + applies to new processes; processes already running are + not affected.

+

In low-memory systems (especially without virtual + memory), setting the value to 0 can help to conserve + memory.

+

An alternative way to set this value is through the + (operating system) environment variable + ERL_FULLSWEEP_AFTER.

+ + erlang:system_flag(min_heap_size, MinHeapSize) + +

Sets the default minimum heap size for processes. The + size is given in words. The new min_heap_size only + effects processes spawned after the change of + min_heap_size has been made. + The min_heap_size can be set for individual + processes by use of + spawn_opt/N or + process_flag/2.

+ + erlang:system_flag(multi_scheduling, BlockState) + + +

BlockState = block | unblock

+

If multi-scheduling is enabled, more than one scheduler + thread is used by the emulator. Multi-scheduling can be + blocked. When multi-scheduling has been blocked, only + one scheduler thread will schedule Erlang processes.

+

If BlockState =:= block, multi-scheduling will + be blocked. If BlockState =:= unblock and no-one + else is blocking multi-scheduling and this process has + only blocked one time, multi-scheduling will be unblocked. + One process can block multi-scheduling multiple times. + If a process has blocked multiple times, it has to + unblock exactly as many times as it has blocked before it + has released its multi-scheduling block. If a process that + has blocked multi-scheduling exits, it will release its + blocking of multi-scheduling.

+

The return values are disabled, blocked, + or enabled. The returned value describes the + state just after the call to + erlang:system_flag(multi_scheduling, BlockState) + has been made. The return values are described in the + documentation of erlang:system_info(multi_scheduling).

+

NOTE: Blocking of multi-scheduling should normally + not be needed. If you feel that you need to + block multi-scheduling, think through the + problem at least a couple of times again. + Blocking multi-scheduling should only be used + as a last resort since it will most likely be + a very inefficient way to solve the + problem.

+

See also erlang:system_info(multi_scheduling), + erlang:system_info(multi_scheduling_blockers), and + erlang:system_info(schedulers).

+ + erlang:system_flag(scheduler_bind_type, How) + + +

Controls if and how schedulers are bound to logical + processors.

+

When erlang:system_flag(scheduler_bind_type, How) is + called, an asynchronous signal is sent to all schedulers + online which causes them to try to bind or unbind as requested. + NOTE: If a scheduler fails to bind, this + will often be silently ignored. This since it isn't always + possible to verify valid logical processor identifiers. If + an error is reported, it will be reported to the + error_logger. If you want to verify that the + schedulers actually have bound as requested, call + erlang:system_info(scheduler_bindings). +

+

Schedulers can currently only be bound on newer Linux + and Solaris systems, but more systems will be supported + in the future. +

+

In order for the runtime system to be able to bind schedulers, + the CPU topology needs to be known. If the runtime system fails + to automatically detect the CPU topology, it can be defined. + For more information on how to define the CPU topology, see + erlang:system_flag(cpu_topology, CpuTopology). +

+

NOTE: If other programs on the system have bound + to processors, e.g. another Erlang runtime system, you + may loose performance when binding schedulers. Therefore, + schedulers are by default not bound.

+

Schedulers can be bound in different ways. The How + argument determines how schedulers are bound. How can + currently be one of:

+ + unbound + +

Schedulers will not be bound to logical processors, i.e., + the operating system decides where the scheduler threads + execute, and when to migrate them. This is the default.

+ + no_spread + +

Schedulers with close scheduler identifiers will be bound + as close as possible in hardware.

+ + thread_spread + +

Thread refers to hardware threads (e.g. Intels + hyper-threads). Schedulers with low scheduler identifiers, + will be bound to the first hardware thread of each core, + then schedulers with higher scheduler identifiers will be + bound to the second hardware thread of each core, etc.

+ + processor_spread + +

Schedulers will be spread like thread_spread, but + also over physical processor chips.

+ + spread + +

Schedulers will be spread as much as possible.

+ + no_node_thread_spread + +

Like thread_spread, but if multiple NUMA + (Non-Uniform Memory Access) nodes exists, + schedulers will be spread over one NUMA node at a time, + i.e., all logical processors of one NUMA node will + be bound to schedulers in sequence.

+ + no_node_processor_spread + +

Like processor_spread, but if multiple NUMA + nodes exists, schedulers will be spread over one + NUMA node at a time, i.e., all logical processors of + one NUMA node will be bound to schedulers in sequence.

+ + thread_no_node_processor_spread + +

A combination of thread_spread, and + no_node_processor_spread. Schedulers will be + spread over hardware threads across NUMA nodes, but + schedulers will only be spread over processors internally + in one NUMA node at a time.

+ + default_bind + +

Binds schedulers the default way. Currently the default + is thread_no_node_processor_spread (which might change + in the future).

+ + +

How schedulers are bound matters. For example, in + situations when there are fewer running processes than + schedulers online, the runtime system tries to migrate + processes to schedulers with low scheduler identifiers. + The more the schedulers are spread over the hardware, + the more resources will be available to the runtime + system in such situations. +

+

The value returned equals How before the + scheduler_bind_type flag was changed.

+

Failure:

+ + notsup + +

If binding of schedulers is not supported.

+ + badarg + +

If How isn't one of the documented alternatives.

+ + badarg + +

If no CPU topology information is available.

+ + +

The scheduler bind type can also be set by passing + the +sbt command + line argument to erl. +

+

For more information, see + erlang:system_info(scheduler_bind_type), + erlang:system_info(scheduler_bindings), + the erl +sbt + emulator flag, and + erlang:system_flag(cpu_topology, CpuTopology). +

+ + erlang:system_flag(schedulers_online, SchedulersOnline) + + +

Sets the amount of schedulers online. Valid range is + . +

+

For more information see, + erlang:system_info(schedulers), + and + erlang:system_info(schedulers_online). +

+ + erlang:system_flag(trace_control_word, TCW) + +

Sets the value of the node's trace control word to + TCW. TCW should be an unsigned integer. For + more information see documentation of the + set_tcw + function in the match specification documentation in the + ERTS User's Guide.

+ + + +

The schedulers option has been removed as + of erts version 5.5.3. The number of scheduler + threads is determined at emulator boot time, and + cannot be changed after that.

+ + + + + erlang:system_info(Type) -> Res + Information about the system + + Type, Res -- see below + + +

Returns various information about the current system + (emulator) as specified by Type:

+ + allocated_areas + + +

Returns a list of tuples with information about + miscellaneous allocated memory areas.

+

Each tuple contains an atom describing type of memory as + first element and amount of allocated memory in bytes as + second element. In those cases when there is information + present about allocated and used memory, a third element + is present. This third element contains the amount of + used memory in bytes.

+

erlang:system_info(allocated_areas) is intended + for debugging, and the content is highly implementation + dependent. The content of the results will therefore + change when needed without prior notice.

+

Note: The sum of these values is not + the total amount of memory allocated by the emulator. + Some values are part of other values, and some memory + areas are not part of the result. If you are interested + in the total amount of memory allocated by the emulator + see erlang:memory/0,1.

+ + allocator + + +

Returns {Allocator, Version, Features, Settings}.

+

Types:

+ + Allocator = undefined | elib_malloc | glibc + Version = [int()] + Features = [atom()] + Settings = [{Subsystem, [{Parameter, Value}]}] + Subsystem = atom() + Parameter = atom() + Value = term() + +

Explanation:

+ + +

Allocator corresponds to the malloc() + implementation used. If Allocator equals + undefined, the malloc() implementation + used could not be identified. Currently + elib_malloc and glibc can be identified.

+ + +

Version is a list of integers (but not a + string) representing the version of + the malloc() implementation used.

+ + +

Features is a list of atoms representing + allocation features used.

+ + +

Settings is a list of subsystems, their + configurable parameters, and used values. Settings + may differ between different combinations of + platforms, allocators, and allocation features. + Memory sizes are given in bytes.

+ + +

See also "System Flags Effecting erts_alloc" in + erts_alloc(3).

+ + alloc_util_allocators + + +

Returns a list of the names of all allocators + using the ERTS internal alloc_util framework + as atoms. For more information see the + "the + alloc_util framework" section in the + erts_alloc(3) documentation. +

+ + {allocator, Alloc} + + +

Returns information about the specified allocator. + As of erts version 5.6.1 the return value is a list + of {instance, InstanceNo, InstanceInfo} tuples + where InstanceInfo contains information about + a specific instance of the allocator. + If Alloc is not a recognized allocator, + undefined is returned. If Alloc is disabled, + false is returned.

+

Note: The information returned is highly + implementation dependent and may be changed, or removed + at any time without prior notice. It was initially + intended as a tool when developing new allocators, but + since it might be of interest for others it has been + briefly documented.

+

The recognized allocators are listed in + erts_alloc(3). + After reading the erts_alloc(3) documentation, + the returned information + should more or less speak for itself. But it can be worth + explaining some things. Call counts are presented by two + values. The first value is giga calls, and the second + value is calls. mbcs, and sbcs are + abbreviations for, respectively, multi-block carriers, and + single-block carriers. Sizes are presented in bytes. When + it is not a size that is presented, it is the amount of + something. Sizes and amounts are often presented by three + values, the first is current value, the second is maximum + value since the last call to + erlang:system_info({allocator, Alloc}), and + the third is maximum value since the emulator was started. + If only one value is present, it is the current value. + fix_alloc memory block types are presented by two + values. The first value is memory pool size and + the second value used memory size.

+ + {allocator_sizes, Alloc} + + +

Returns various size information for the specified + allocator. The information returned is a subset of the + information returned by + erlang:system_info({allocator, Alloc}). +

+ + c_compiler_used + +

Returns a two-tuple describing the C compiler used when + compiling the runtime system. The first element is an + atom describing the name of the compiler, or undefined + if unknown. The second element is a term describing the + version of the compiler, or undefined if unknown. +

+ + check_io + +

Returns a list containing miscellaneous information + regarding the emulators internal I/O checking. Note, + the content of the returned list may vary between + platforms and over time. The only thing guaranteed is + that a list is returned.

+ + compat_rel + +

Returns the compatibility mode of the local node as + an integer. The integer returned represents the + Erlang/OTP release which the current emulator has been + set to be backward compatible with. The compatibility + mode can be configured at startup by using the command + line flag +R, see + erl(1).

+ + cpu_topology + + +

Returns the CpuTopology which currently is used by the + emulator. The CPU topology is used when binding schedulers + to logical processors. The CPU topology used is the user defined + CPU topology if such exist; otherwise, the automatically + detected CPU topology if such exist. If no CPU topology + exist undefined is returned.

+

Types:

+ + CpuTopology = LevelEntryList | undefined + LevelEntryList = [LevelEntry] (all + LevelEntrys of a LevelEntryList + must contain the same LevelTag, except + on the top level where both node and + processor LevelTags may co-exist) + LevelEntry = {LevelTag, SubLevel} + | {LevelTag, InfoList, SubLevel} + ({LevelTag, SubLevel} + == {LevelTag, [], SubLevel}) + LevelTag = node|processor|core|thread + (more LevelTags may be introduced in + the future) + SubLevel = [LevelEntry] | LogicalCpuId + LogicalCpuId = {logical, integer()} + InfoList = [] (the InfoList + may be extended in the future) + +

node refers to NUMA (non-uniform memory access) + nodes, and thread refers to hardware threads + (e.g. Intels hyper-threads).

+

A level in the CpuTopology term can be omitted if + only one entry exists and the InfoList is empty. +

+

thread can only be a sub level to core. + core can be a sub level to either processor + or node. processor can either be on the + top level or a sub level to node. node + can either be on the top level or a sub level to + processor. That is, NUMA nodes can be processor + internal or processor external. A CPU topology can + consist of a mix of processor internal and external + NUMA nodes, as long as each logical CPU belongs to one + and only one NUMA node. Cache hierarchy is not part of + the CpuTopology type yet, but will be in the + future. Other things may also make it into the CPU + topology in the future. In other words, expect the + CpuTopology type to change. +

+ + {cpu_topology, defined} + +

Returns the user defined CpuTopology. For more + information see the documentation of + erlang:system_flag(cpu_topology, CpuTopology) + and the documentation of the + cpu_topology + argument. +

+ + {cpu_topology, detected} + +

Returns the automatically detected CpuTopology. The + emulator currently only detects the CPU topology on some newer + linux and solaris systems. For more information see the + documentation of the + cpu_topology + argument. +

+ + {cpu_topology, used} + +

Returns the CpuTopology which is used by the + emulator. For more information see the + documentation of the + cpu_topology + argument. +

+ + creation + +

Returns the creation of the local node as an integer. + The creation is changed when a node is restarted. The + creation of a node is stored in process identifiers, port + identifiers, and references. This makes it (to some + extent) possible to distinguish between identifiers from + different incarnations of a node. Currently valid + creations are integers in the range 1..3, but this may + (probably will) change in the future. If the node is not + alive, 0 is returned.

+ + debug_compiled + +

Returns true if the emulator has been debug + compiled; otherwise, false. +

+ + dist + +

Returns a binary containing a string of distribution + information formatted as in Erlang crash dumps. For more + information see the "How to interpret the Erlang crash dumps" + chapter in the ERTS User's Guide.

+ + dist_ctrl + +

Returns a list of tuples + {Node, ControllingEntity}, one entry for each + connected remote node. The Node is the name of the + node and the ControllingEntity is the port or pid + responsible for the communication to that node. More + specifically, the ControllingEntity for nodes + connected via TCP/IP (the normal case) is the socket + actually used in communication with the specific node.

+ + driver_version + +

Returns a string containing the erlang driver version + used by the runtime system. It will be on the form + "<major ver>.<minor ver>".

+ + elib_malloc + +

If the emulator uses the elib_malloc memory + allocator, a list of two-element tuples containing status + information is returned; otherwise, false is + returned. The list currently contains the following + two-element tuples (all sizes are presented in bytes):

+ + {heap_size, Size} + +

Where Size is the current heap size.

+ + {max_alloced_size, Size} + +

Where Size is the maximum amount of memory + allocated on the heap since the emulator started.

+ + {alloced_size, Size} + +

Where Size is the current amount of memory + allocated on the heap.

+ + {free_size, Size} + +

Where Size is the current amount of free + memory on the heap.

+ + {no_alloced_blocks, No} + +

Where No is the current number of allocated + blocks on the heap.

+ + {no_free_blocks, No} + +

Where No is the current number of free blocks + on the heap.

+ + {smallest_alloced_block, Size} + +

Where Size is the size of the smallest + allocated block on the heap.

+ + {largest_free_block, Size} + +

Where Size is the size of the largest free + block on the heap.

+ + + + fullsweep_after + +

Returns {fullsweep_after, int()} which is the + fullsweep_after garbage collection setting used + by default. For more information see + garbage_collection described below.

+ + garbage_collection + +

Returns a list describing the default garbage collection + settings. A process spawned on the local node by a + spawn or spawn_link will use these + garbage collection settings. The default settings can be + changed by use of + system_flag/2. + spawn_opt/4 + can spawn a process that does not use the default + settings.

+ + global_heaps_size + +

Returns the current size of the shared (global) heap.

+ + heap_sizes + +

Returns a list of integers representing valid heap sizes + in words. All Erlang heaps are sized from sizes in this + list.

+ + heap_type + +

Returns the heap type used by the current emulator. + Currently the following heap types exist:

+ + private + +

Each process has a heap reserved for its use and no + references between heaps of different processes are + allowed. Messages passed between processes are copied + between heaps.

+ + shared + +

One heap for use by all processes. Messages passed + between processes are passed by reference.

+ + hybrid + +

A hybrid of the private and shared heap + types. A shared heap as well as private heaps are + used.

+ + + + info + +

Returns a binary containing a string of miscellaneous + system information formatted as in Erlang crash dumps. + For more information see the + "How to interpret the Erlang crash dumps" chapter in the ERTS + User's Guide.

+ + kernel_poll + +

Returns true if the emulator uses some kind of + kernel-poll implementation; otherwise, false.

+ + loaded + +

Returns a binary containing a string of loaded module + information formatted as in Erlang crash dumps. For more + information see the "How to interpret the Erlang crash dumps" chapter + in the ERTS User's Guide.

+ + logical_processors + +

Returns the number of logical processors detected on the + system as an integer or the atom unknown if the + emulator wasn't able to detect any. +

+ + machine + +

Returns a string containing the Erlang machine name.

+ + modified_timing_level + +

Returns the modified timing level (an integer) if + modified timing has been enabled; otherwise, + undefined. See the +T command line flag + in the documentation of the + erl(1) + command for more information on modified timing.

+ + multi_scheduling + + +

Returns disabled, blocked, or enabled. + A description of the return values:

+ + disabled + +

The emulator has only one scheduler thread. The + emulator does not have SMP support, or have been + started with only one scheduler thread.

+ + blocked + +

The emulator has more than one scheduler thread, + but all scheduler threads but one have been blocked, + i.e., only one scheduler thread will schedule + Erlang processes and execute Erlang code.

+ + enabled + +

The emulator has more than one scheduler thread, + and no scheduler threads have been blocked, i.e., + all available scheduler threads will schedule + Erlang processes and execute Erlang code.

+ + +

See also erlang:system_flag(multi_scheduling, BlockState), + erlang:system_info(multi_scheduling_blockers), and + erlang:system_info(schedulers).

+ + multi_scheduling_blockers + + +

Returns a list of PIDs when multi-scheduling + is blocked; otherwise, the empty list. The PIDs + in the list is PIDs of the processes currently + blocking multi-scheduling. A PID will only be + present once in the list, even if the corresponding + process has blocked multiple times.

+

See also erlang:system_flag(multi_scheduling, BlockState), + erlang:system_info(multi_scheduling), and + erlang:system_info(schedulers).

+ + otp_release + + +

Returns a string containing the OTP release number.

+ + process_count + +

Returns the number of processes currently existing at + the local node as an integer. The same value as + length(processes()) returns.

+ + process_limit + +

Returns the maximum number of concurrently existing + processes at the local node as an integer. This limit + can be configured at startup by using the command line + flag +P, see + erl(1).

+ + procs + +

Returns a binary containing a string of process and port + information formatted as in Erlang crash dumps. For more + information see the "How to interpret the Erlang crash dumps" chapter + in the ERTS User's Guide.

+ + scheduler_bind_type + + +

Returns information on how user has requested + schedulers to be bound or not bound.

+

NOTE: Even though user has requested + schedulers to be bound via + erlang:system_flag(scheduler_bind_type, How), + they might have silently failed to bind. In order to + inspect actual scheduler bindings call + erlang:system_info(scheduler_bindings). +

+

For more information, see + erlang:system_flag(scheduler_bind_type, How), and + erlang:system_info(scheduler_bindings). +

+ + scheduler_bindings + + +

Returns information on currently used scheduler + bindings.

+

A tuple of a size equal to + erlang:system_info(schedulers) is returned. The elements of the tuple are integers + or the atom unbound. Logical processor identifiers + are represented as integers. The Nth + element of the tuple equals the current binding for + the scheduler with the scheduler identifier equal to + N. E.g., if the schedulers have been bound, + element(erlang:system_info(scheduler_id), + erlang:system_info(scheduler_bindings)) will return + the identifier of the logical processor that the calling + process is executing on. +

+

Note that only schedulers online can be bound to logical + processors.

+

For more information, see + erlang:system_flag(scheduler_bind_type, How), + erlang:system_info(schedulers_online). +

+ + scheduler_id + + +

Returns the scheduler id (SchedulerId) of the + scheduler thread that the calling process is executing + on. SchedulerId is a positive integer; where + . See also + erlang:system_info(schedulers).

+ + schedulers + + +

Returns the number of scheduler threads used by + the emulator. Scheduler threads online schedules Erlang + processes and Erlang ports, and execute Erlang code + and Erlang linked in driver code.

+

The number of scheduler threads is determined at + emulator boot time and cannot be changed after + that. The amount of schedulers online can + however be changed at any time.

+

See also erlang:system_flag(schedulers_online, SchedulersOnline), + erlang:system_info(schedulers_online), + erlang:system_info(scheduler_id), + erlang:system_flag(multi_scheduling, BlockState), + erlang:system_info(multi_scheduling), and + and erlang:system_info(multi_scheduling_blockers).

+ + schedulers_online + + +

Returns the amount of schedulers online. The scheduler + identifiers of schedulers online satisfy the following + relationship: + . +

+

For more information, see + erlang:system_info(schedulers), + and + erlang:system_flag(schedulers_online, SchedulersOnline). +

+ + smp_support + +

Returns true if the emulator has been compiled + with smp support; otherwise, false.

+ + system_version + +

Returns a string containing version number and + some important properties such as the number of schedulers.

+ + system_architecture + +

Returns a string containing the processor and OS + architecture the emulator is built for.

+ + threads + +

Returns true if the emulator has been compiled + with thread support; otherwise, false is + returned.

+ + thread_pool_size + + +

Returns the number of async threads in the async thread + pool used for asynchronous driver calls + (driver_async()) + as an integer.

+ + trace_control_word + +

Returns the value of the node's trace control word. + For more information see documentation of the function + get_tcw in "Match Specifications in Erlang", + ERTS User's Guide.

+ + version + + +

Returns a string containing the version number of the + emulator.

+ + wordsize + +

Returns the word size in bytes as an integer, i.e. on a + 32-bit architecture 4 is returned, and on a 64-bit + architecture 8 is returned.

+ + + +

The scheduler argument has changed name to + scheduler_id. This in order to avoid mixup with + the schedulers argument. The scheduler + argument was introduced in ERTS version 5.5 and renamed + in ERTS version 5.5.1.

+ + + + + + erlang:system_monitor() -> MonSettings + Current system performance monitoring settings + + MonSettings -> {MonitorPid, Options} | undefined +  MonitorPid = pid() +  Options = [Option] +   Option = {long_gc, Time} | {large_heap, Size} | busy_port | busy_dist_port +    Time = Size = int() + + +

Returns the current system monitoring settings set by + erlang:system_monitor/2 + as {MonitorPid, Options}, or undefined if there + are no settings. The order of the options may be different + from the one that was set.

+ + + + + erlang:system_monitor(undefined | {MonitorPid, Options}) -> MonSettings + Set or clear system performance monitoring options + + MonitorPid, Options, MonSettings -- see below + + +

When called with the argument undefined, all + system performance monitoring settings are cleared.

+

Calling the function with {MonitorPid, Options} as + argument, is the same as calling + erlang:system_monitor(MonitorPid, Options).

+

Returns the previous system monitor settings just like + erlang:system_monitor/0.

+ + + + + erlang:system_monitor(MonitorPid, [Option]) -> MonSettings + Set system performance monitoring options + + MonitorPid = pid() + Option = {long_gc, Time} | {large_heap, Size} | busy_port | busy_dist_port +  Time = Size = int() + MonSettings = {OldMonitorPid, [Option]} +  OldMonitorPid = pid() + + +

Sets system performance monitoring options. MonitorPid + is a local pid that will receive system monitor messages, and + the second argument is a list of monitoring options:

+ + {long_gc, Time} + +

If a garbage collection in the system takes at least + Time wallclock milliseconds, a message + {monitor, GcPid, long_gc, Info} is sent to + MonitorPid. GcPid is the pid that was + garbage collected and Info is a list of two-element + tuples describing the result of the garbage collection. + One of the tuples is {timeout, GcTime} where + GcTime is the actual time for the garbage + collection in milliseconds. The other tuples are + tagged with heap_size, heap_block_size, + stack_size, mbuf_size, old_heap_size, + and old_heap_block_size. These tuples are + explained in the documentation of the + gc_start + trace message (see + erlang:trace/3). + New tuples may be added, and the order of the tuples in + the Info list may be changed at any time without prior + notice. +

+ + {large_heap, Size} + +

If a garbage collection in the system results in + the allocated size of a heap being at least Size + words, a message {monitor, GcPid, large_heap, Info} + is sent to MonitorPid. GcPid and Info + are the same as for long_gc above, except that + the tuple tagged with timeout is not present. + Note: As of erts version 5.6 the monitor message + is sent if the sum of the sizes of all memory blocks allocated + for all heap generations is equal to or larger than Size. + Previously the monitor message was sent if the memory block + allocated for the youngest generation was equal to or larger + than Size. +

+ + busy_port + +

If a process in the system gets suspended because it + sends to a busy port, a message + {monitor, SusPid, busy_port, Port} is sent to + MonitorPid. SusPid is the pid that got + suspended when sending to Port.

+ + busy_dist_port + +

If a process in the system gets suspended because it + sends to a process on a remote node whose inter-node + communication was handled by a busy port, a message + {monitor, SusPid, busy_dist_port, Port} is sent to + MonitorPid. SusPid is the pid that got + suspended when sending through the inter-node + communication port Port.

+ + +

Returns the previous system monitor settings just like + erlang:system_monitor/0.

+ +

If a monitoring process gets so large that it itself + starts to cause system monitor messages when garbage + collecting, the messages will enlarge the process's + message queue and probably make the problem worse.

+

Keep the monitoring process neat and do not set the system + monitor limits too tight.

+ +

Failure: badarg if MonitorPid does not exist.

+ + + + + erlang:system_profile() -> ProfilerSettings + Current system profiling settings + + ProfilerSettings -> {ProfilerPid, Options} | undefined +  ProfilerPid = pid() | port() +  Options = [Option] +   Option = runnable_procs | runnable_ports | scheduler | exclusive + + +

Returns the current system profiling settings set by + erlang:system_profile/2 + as {ProfilerPid, Options}, or undefined if there + are no settings. The order of the options may be different + from the one that was set.

+ + + + + erlang:system_profile(ProfilerPid, Options) -> ProfilerSettings + Current system profiling settings + + ProfilerSettings -> {ProfilerPid, Options} | undefined +  ProfilerPid = pid() | port() +  Options = [Option] +   Option = runnable_procs | runnable_ports | scheduler | exclusive + + +

Sets system profiler options. ProfilerPid + is a local pid or port that will receive profiling messages. The + receiver is excluded from all profiling. + The second argument is a list of profiling options:

+ + runnable_procs + +

If a process is put into or removed from the run queue a message, + {profile, Pid, State, Mfa, Ts}, is sent to + ProfilerPid. Running processes that is reinserted into the + run queue after having been preemptively scheduled out will not trigger this + message. +

+ + runnable_ports + +

If a port is put into or removed from the run queue a message, + {profile, Port, State, 0, Ts}, is sent to + ProfilerPid. +

+ + scheduler + +

If a scheduler is put to sleep or awoken a message, + {profile, scheduler, Id, State, NoScheds, Ts}, is sent + to ProfilerPid. +

+ + exclusive + +

+ If a synchronous call to a port from a process is done, the + calling process is considered not runnable during the call + runtime to the port. The calling process is notified as + inactive and subsequently active when the port + callback returns. +

+ + +

erlang:system_profile is considered experimental and + its behaviour may change in the future.

+ + + + + + term_to_binary(Term) -> ext_binary() + Encode a term to an Erlang external term format binary + + Term = term() + + +

Returns a binary data object which is the result of encoding + Term according to the Erlang external term format.

+

This can be used for a variety of purposes, for example + writing a term to a file in an efficient way, or sending an + Erlang term to some type of communications channel not + supported by distributed Erlang.

+

See also + binary_to_term/1.

+ + + + term_to_binary(Term, [Option]) -> ext_binary() + Encode a term to en Erlang external term format binary + + Term = term() + Option = compressed | {compressed,Level} | {minor_version,Version} + + +

Returns a binary data object which is the result of encoding + Term according to the Erlang external term format.

+

If the option compressed is provided, the external + term format will be compressed. The compressed format is + automatically recognized by binary_to_term/1 in R7B and later.

+

It is also possible to specify a compression level by giving + the option {compressed,Level}, where Level is an + integer from 0 through 9. 0 means that no compression + will be done (it is the same as not giving any compressed option); + 1 will take the least time but may not compress as well as + the higher levels; 9 will take the most time and may produce + a smaller result. Note the "mays" in the preceding sentence; depending + on the input term, level 9 compression may or may not produce a smaller + result than level 1 compression.

+

Currently, compressed gives the same result as + {compressed,6}.

+

The option {minor_version,Version} can be use to control + some details of the encoding. This option was + introduced in R11B-4. Currently, the allowed values for Version + are 0 and 1.

+

{minor_version,1} forces any floats in the term to be encoded + in a more space-efficient and exact way (namely in the 64-bit IEEE format, + rather than converted to a textual representation). binary_to_term/1 + in R11B-4 and later is able decode the new representation.

+

{minor_version,0} is currently the default, meaning that floats + will be encoded using a textual representation; this option is useful if + you want to ensure that releases prior to R11B-4 can decode resulting + binary.

+

See also + binary_to_term/1.

+ + + + throw(Any) + Throw an exception + + Any = term() + + +

A non-local return from a function. If evaluated within a + catch, catch will return the value Any.

+ 
+> catch throw({hello, there}).
+{hello,there}
+

Failure: nocatch if not evaluated within a catch.

+ + + + time() -> {Hour, Minute, Second} + Current time + + Hour = Minute = Second = int() + + +

Returns the current time as {Hour, Minute, Second}.

+

The time zone and daylight saving time correction depend on + the underlying OS.

+ 
+> time().
+{9,42,44}
+ + + + tl(List1) -> List2 + Tail of a list + + List1 = List2 = [term()] + + +

Returns the tail of List1, that is, the list minus + the first element.

+ 
+> tl([geesties, guilies, beasties]).
+[guilies, beasties]
+

Allowed in guard tests.

+

Failure: badarg if List is the empty list [].

+ + + + erlang:trace(PidSpec, How, FlagList) -> int() + Set trace flags for a process or processes + + PidSpec = pid() | existing | new | all + How = bool() + FlagList = [Flag] +  Flag -- see below + + +

Turns on (if How == true) or off (if + How == false) the trace flags in FlagList for + the process or processes represented by PidSpec.

+

PidSpec is either a pid for a local process, or one of + the following atoms:

+ + existing + +

All processes currently existing.

+ + new + +

All processes that will be created in the future.

+ + all + +

All currently existing processes and all processes that + will be created in the future.

+ + +

FlagList can contain any number of the following + flags (the "message tags" refers to the list of messages + following below):

+ + all + +

Set all trace flags except {tracer, Tracer} and + cpu_timestamp that are in their nature different + than the others.

+ + send + +

Trace sending of messages.

+

Message tags: send, + send_to_non_existing_process.

+ + 'receive' + +

Trace receiving of messages.

+

Message tags: 'receive'.

+ + procs + +

Trace process related events.

+

Message tags: spawn, exit, + register, unregister, link, + unlink, getting_linked, + getting_unlinked.

+ + call + +

Trace certain function calls. Specify which function + calls to trace by calling + erlang:trace_pattern/3.

+

Message tags: call, return_from.

+ + silent + +

Used in conjunction with the call trace flag. + The call, return_from and return_to + trace messages are inhibited if this flag is set, + but if there are match specs they are executed as normal.

+

Silent mode is inhibited by executing + erlang:trace(_, false, [silent|_]), + or by a match spec executing the {silent, false} + function.

+

The silent trace flag facilitates setting up + a trace on many or even all processes in the system. + Then the interesting trace can be activated and + deactivated using the {silent,Bool} + match spec function, giving a high degree + of control of which functions with which + arguments that triggers the trace.

+

Message tags: call, return_from, + return_to. Or rather, the absence of.

+ + return_to + +

Used in conjunction with the call trace flag. + Trace the actual return from a traced function back to + its caller. Only works for functions traced with + the local option to + erlang:trace_pattern/3.

+

The semantics is that a trace message is sent when a + call traced function actually returns, that is, when a + chain of tail recursive calls is ended. There will be + only one trace message sent per chain of tail recursive + calls, why the properties of tail recursiveness for + function calls are kept while tracing with this flag. + Using call and return_to trace together + makes it possible to know exactly in which function a + process executes at any time.

+

To get trace messages containing return values from + functions, use the {return_trace} match_spec + action instead.

+

Message tags: return_to.

+ + running + +

Trace scheduling of processes.

+

Message tags: in, and out.

+ + exiting + +

Trace scheduling of an exiting processes.

+

Message tags: in_exiting, out_exiting, and + out_exited.

+ + garbage_collection + +

Trace garbage collections of processes.

+

Message tags: gc_start, gc_end.

+ + timestamp + +

Include a time stamp in all trace messages. The time + stamp (Ts) is of the same form as returned by + erlang:now().

+ + cpu_timestamp + +

A global trace flag for the Erlang node that makes all + trace timestamps be in CPU time, not wallclock. It is + only allowed with PidSpec==all. If the host + machine operating system does not support high resolution + CPU time measurements, trace/3 exits with + badarg.

+ + arity + +

Used in conjunction with the call trace flag. + {M, F, Arity} will be specified instead of + {M, F, Args} in call trace messages.

+ + set_on_spawn + +

Makes any process created by a traced process inherit + its trace flags, including the set_on_spawn flag.

+ + set_on_first_spawn + +

Makes the first process created by a traced process + inherit its trace flags, excluding + the set_on_first_spawn flag.

+ + set_on_link + +

Makes any process linked by a traced process inherit its + trace flags, including the set_on_link flag.

+ + set_on_first_link + +

Makes the first process linked to by a traced process + inherit its trace flags, excluding + the set_on_first_link flag.

+ + {tracer, Tracer} + +

Specify where to send the trace messages. Tracer + must be the pid of a local process or the port identifier + of a local port. If this flag is not given, trace + messages will be sent to the process that called + erlang:trace/3.

+ + +

The effect of combining set_on_first_link with + set_on_link is the same as having + set_on_first_link alone. Likewise for + set_on_spawn and set_on_first_spawn.

+

If the timestamp flag is not given, the tracing + process will receive the trace messages described below. + Pid is the pid of the traced process in which + the traced event has occurred. The third element of the tuple + is the message tag.

+

If the timestamp flag is given, the first element of + the tuple will be trace_ts instead and the timestamp + is added last in the tuple.

+ + {trace, Pid, 'receive', Msg} + +

When Pid receives the message Msg.

+ + {trace, Pid, send, Msg, To} + +

When Pid sends the message Msg to + the process To.

+ + {trace, Pid, send_to_non_existing_process, Msg, To} + +

When Pid sends the message Msg to + the non-existing process To.

+ + {trace, Pid, call, {M, F, Args}} + +

When Pid calls a traced function. The return + values of calls are never supplied, only the call and its + arguments.

+

Note that the trace flag arity can be used to + change the contents of this message, so that Arity + is specified instead of Args.

+ + {trace, Pid, return_to, {M, F, Arity}} + +

When Pid returns to the specified + function. This trace message is sent if both + the call and the return_to flags are set, + and the function is set to be traced on local + function calls. The message is only sent when returning + from a chain of tail recursive function calls where at + least one call generated a call trace message + (that is, the functions match specification matched and + {message, false} was not an action).

+ + {trace, Pid, return_from, {M, F, Arity}, ReturnValue} + +

When Pid returns from the specified + function. This trace message is sent if the call + flag is set, and the function has a match specification + with a return_trace or exception_trace action.

+ + {trace, Pid, exception_from, {M, F, Arity}, {Class, Value}} + +

When Pid exits from the specified + function due to an exception. This trace message is sent + if the call flag is set, and the function has + a match specification with an exception_trace action.

+ + {trace, Pid, spawn, Pid2, {M, F, Args}} + +

When Pid spawns a new process Pid2 with + the specified function call as entry point.

+

Note that Args is supposed to be the argument + list, but may be any term in the case of an erroneous + spawn.

+ + {trace, Pid, exit, Reason} + +

When Pid exits with reason Reason.

+ + {trace, Pid, link, Pid2} + +

When Pid links to a process Pid2.

+ + {trace, Pid, unlink, Pid2} + +

When Pid removes the link from a process + Pid2.

+ + {trace, Pid, getting_linked, Pid2} + +

When Pid gets linked to a process Pid2.

+ + {trace, Pid, getting_unlinked, Pid2} + +

When Pid gets unlinked from a process Pid2.

+ + {trace, Pid, register, RegName} + +

When Pid gets the name RegName registered.

+ + {trace, Pid, unregister, RegName} + +

When Pid gets the name RegName unregistered. + Note that this is done automatically when a registered + process exits.

+ + {trace, Pid, in, {M, F, Arity} | 0} + +

When Pid is scheduled to run. The process will + run in function {M, F, Arity}. On some rare + occasions the current function cannot be determined, then + the last element Arity is 0.

+ + {trace, Pid, out, {M, F, Arity} | 0} + +

When Pid is scheduled out. The process was + running in function {M, F, Arity}. On some rare occasions + the current function cannot be determined, then the last + element Arity is 0.

+ + {trace, Pid, gc_start, Info} + + +

Sent when garbage collection is about to be started. + Info is a list of two-element tuples, where + the first element is a key, and the second is the value. + You should not depend on the tuples have any defined + order. Currently, the following keys are defined:

+ + heap_size + The size of the used part of the heap. + heap_block_size + The size of the memory block used for storing + the heap and the stack. + old_heap_size + The size of the used part of the old heap. + old_heap_block_size + The size of the memory block used for storing + the old heap. + stack_size + The actual size of the stack. + recent_size + The size of the data that survived the previous garbage + collection. + mbuf_size + The combined size of message buffers associated with + the process. + +

All sizes are in words.

+ + {trace, Pid, gc_end, Info} + +

Sent when garbage collection is finished. Info + contains the same kind of list as in the gc_start + message, but the sizes reflect the new sizes after + garbage collection.

+ + +

If the tracing process dies, the flags will be silently + removed.

+

Only one process can trace a particular process. For this + reason, attempts to trace an already traced process will fail.

+

Returns: A number indicating the number of processes that + matched PidSpec. If PidSpec is a pid, + the return value will be 1. If PidSpec is + all or existing the return value will be + the number of processes running, excluding tracer processes. + If PidSpec is new, the return value will be + 0.

+

Failure: If specified arguments are not supported. For + example cpu_timestamp is not supported on all + platforms.

+ + + + erlang:trace_delivered(Tracee) -> Ref + Notification when trace has been delivered + + Tracee = pid() | all + Ref = reference() + + +

The delivery of trace messages is dislocated on the time-line + compared to other events in the system. If you know that the + Tracee has passed some specific point in its execution, + and you want to know when at least all trace messages + corresponding to events up to this point have reached the tracer + you can use erlang:trace_delivered(Tracee). A + {trace_delivered, Tracee, Ref} message is sent to + the caller of erlang:trace_delivered(Tracee) when it + is guaranteed that all trace messages have been delivered to + the tracer up to the point that the Tracee had reached + at the time of the call to + erlang:trace_delivered(Tracee).

+

Note that the trace_delivered message does not + imply that trace messages have been delivered; instead, it implies + that all trace messages that should be delivered have + been delivered. It is not an error if Tracee isn't, and + hasn't been traced by someone, but if this is the case, + no trace messages will have been delivered when the + trace_delivered message arrives.

+

Note that Tracee has to refer to a process currently, + or previously existing on the same node as the caller of + erlang:trace_delivered(Tracee) resides on. + The special Tracee atom all denotes all processes + that currently are traced in the node.

+

An example: Process A is tracee, port B is + tracer, and process C is the port owner of B. + C wants to close B when A exits. C + can ensure that the trace isn't truncated by calling + erlang:trace_delivered(A) when A exits and wait + for the {trace_delivered, A, Ref} message before closing + B.

+

Failure: badarg if Tracee does not refer to a + process (dead or alive) on the same node as the caller of + erlang:trace_delivered(Tracee) resides on.

+ + + + erlang:trace_info(PidOrFunc, Item) -> Res + Trace information about a process or function + + PidOrFunc = pid() | new | {Module, Function, Arity} | on_load +  Module = Function = atom() +  Arity = int() + Item, Res -- see below + + +

Returns trace information about a process or function.

+

To get information about a process, PidOrFunc should + be a pid or the atom new. The atom new means + that the default trace state for processes to be created will + be returned. Item must have one of the following + values:

+ + flags + +

Return a list of atoms indicating what kind of traces is + enabled for the process. The list will be empty if no + traces are enabled, and one or more of the followings + atoms if traces are enabled: send, + 'receive', set_on_spawn, call, + return_to, procs, set_on_first_spawn, + set_on_link, running, + garbage_collection, timestamp, and + arity. The order is arbitrary.

+ + tracer + +

Return the identifier for process or port tracing this + process. If this process is not being traced, the return + value will be [].

+ + +

To get information about a function, PidOrFunc should + be a three-element tuple: {Module, Function, Arity} or + the atom on_load. No wildcards are allowed. Returns + undefined if the function does not exist or + false if the function is not traced at all. Item + must have one of the following values:

+ + traced + +

Return global if this function is traced on + global function calls, local if this function is + traced on local function calls (i.e local and global + function calls), and false if neither local nor + global function calls are traced.

+ + match_spec + +

Return the match specification for this function, if it + has one. If the function is locally or globally traced but + has no match specification defined, the returned value + is [].

+ + meta + +

Return the meta trace tracer process or port for this + function, if it has one. If the function is not meta + traced the returned value is false, and if + the function is meta traced but has once detected that + the tracer proc is invalid, the returned value is [].

+ + meta_match_spec + +

Return the meta trace match specification for this + function, if it has one. If the function is meta traced + but has no match specification defined, the returned + value is [].

+ + call_count + +

Return the call count value for this function or + true for the pseudo function on_load if call + count tracing is active. Return false otherwise. + See also + erlang:trace_pattern/3.

+ + all + +

Return a list containing the {Item, Value} tuples + for all other items, or return false if no tracing + is active for this function.

+ + +

The actual return value will be {Item, Value}, where + Value is the requested information as described above. + If a pid for a dead process was given, or the name of a + non-existing function, Value will be undefined.

+

If PidOrFunc is the on_load, the information + returned refers to the default value for code that will be + loaded.

+ + + + erlang:trace_pattern(MFA, MatchSpec) -> int() + Set trace patterns for global call tracing + +

The same as + erlang:trace_pattern(MFA, MatchSpec, []), + retained for backward compatibility.

+ + + + erlang:trace_pattern(MFA, MatchSpec, FlagList) -> int() + Set trace patterns for tracing of function calls + + MFA, MatchSpec, FlagList -- see below + + +

This BIF is used to enable or disable call tracing for + exported functions. It must be combined with + erlang:trace/3 + to set the call trace flag for one or more processes.

+

Conceptually, call tracing works like this: Inside + the Erlang virtual machine there is a set of processes to be + traced and a set of functions to be traced. Tracing will be + enabled on the intersection of the set. That is, if a process + included in the traced process set calls a function included + in the traced function set, the trace action will be taken. + Otherwise, nothing will happen.

+

Use + erlang:trace/3 to + add or remove one or more processes to the set of traced + processes. Use erlang:trace_pattern/2 to add or remove + exported functions to the set of traced functions.

+

The erlang:trace_pattern/3 BIF can also add match + specifications to an exported function. A match specification + comprises a pattern that the arguments to the function must + match, a guard expression which must evaluate to true + and an action to be performed. The default action is to send a + trace message. If the pattern does not match or the guard + fails, the action will not be executed.

+

The MFA argument should be a tuple like + {Module, Function, Arity} or the atom on_load + (described below). It can be the module, function, and arity + for an exported function (or a BIF in any module). + The '_' atom can be used to mean any of that kind. + Wildcards can be used in any of the following ways:

+ + {Module,Function,'_'} + +

All exported functions of any arity named Function + in module Module.

+ + {Module,'_','_'} + +

All exported functions in module Module.

+ + {'_','_','_'} + +

All exported functions in all loaded modules.

+ + +

Other combinations, such as {Module,'_',Arity}, are + not allowed. Local functions will match wildcards only if + the local option is in the FlagList.

+

If the MFA argument is the atom on_load, + the match specification and flag list will be used on all + modules that are newly loaded.

+

The MatchSpec argument can take any of the following + forms:

+ + false + +

Disable tracing for the matching function(s). Any match + specification will be removed.

+ + true + +

Enable tracing for the matching function(s).

+ + MatchSpecList + +

A list of match specifications. An empty list is + equivalent to true. See the ERTS User's Guide + for a description of match specifications.

+ + restart + +

For the FlagList option call_count: + restart the existing counters. The behaviour is undefined + for other FlagList options.

+ + pause + +

For the FlagList option call_count: pause + the existing counters. The behaviour is undefined for + other FlagList options.

+ + +

The FlagList parameter is a list of options. + The following options are allowed:

+ + global + +

Turn on or off call tracing for global function calls + (that is, calls specifying the module explicitly). Only + exported functions will match and only global calls will + generate trace messages. This is the default.

+ + local + +

Turn on or off call tracing for all types of function + calls. Trace messages will be sent whenever any of + the specified functions are called, regardless of how they + are called. If the return_to flag is set for + the process, a return_to message will also be sent + when this function returns to its caller.

+ + meta | {meta, Pid} + +

Turn on or off meta tracing for all types of function + calls. Trace messages will be sent to the tracer process + or port Pid whenever any of the specified + functions are called, regardless of how they are called. + If no Pid is specified, self() is used as a + default tracer process.

+

Meta tracing traces all processes and does not care + about the process trace flags set by trace/3, + the trace flags are instead fixed to + [call, timestamp].

+

The match spec function {return_trace} works with + meta trace and send its trace message to the same tracer + process.

+ + call_count + +

Starts (MatchSpec == true) or stops + (MatchSpec == false) call count tracing for all + types of function calls. For every function a counter is + incremented when the function is called, in any process. + No process trace flags need to be activated.

+

If call count tracing is started while already running, + the count is restarted from zero. Running counters can be + paused with MatchSpec == pause. Paused and running + counters can be restarted from zero with + MatchSpec == restart.

+

The counter value can be read with + erlang:trace_info/2.

+ + +

The global and local options are mutually + exclusive and global is the default (if no options are + specified). The call_count and meta options + perform a kind of local tracing, and can also not be combined + with global. A function can be either globally or + locally traced. If global tracing is specified for a + specified set of functions; local, meta and call count + tracing for the matching set of local functions will be + disabled, and vice versa.

+

When disabling trace, the option must match the type of trace + that is set on the function, so that local tracing must be + disabled with the local option and global tracing with + the global option (or no option at all), and so forth.

+

There is no way to directly change part of a match + specification list. If a function has a match specification, + you can replace it with a completely new one. If you need to + change an existing match specification, use the + erlang:trace_info/2 + BIF to retrieve the existing match specification.

+

Returns the number of exported functions that matched + the MFA argument. This will be zero if none matched at + all.

+ + + + trunc(Number) -> int() + Return an integer by the truncating a number + + Number = number() + + +

Returns an integer by the truncating Number.

+ 
+> trunc(5.5).
+5
+

Allowed in guard tests.

+ + + + tuple_size(Tuple) -> int() + Return the size of a tuple + + Tuple = tuple() + + +

Returns an integer which is the number of elements in Tuple.

+ 
+> tuple_size({morni, mulle, bwange}).
+3
+

Allowed in guard tests.

+ + + + tuple_to_list(Tuple) -> [term()] + Convert a tuple to a list + + Tuple = tuple() + + +

Returns a list which corresponds to Tuple. + Tuple may contain any Erlang terms.

+ 
+> tuple_to_list({share, {'Ericsson_B', 163}}).
+[share,{'Ericsson_B',163}]
+ + + + erlang:universaltime() -> {Date, Time} + Current date and time according to Universal Time Coordinated (UTC) + + Date = {Year, Month, Day} + Time = {Hour, Minute, Second} +  Year = Month = Day = Hour = Minute = Second = int() + + +

Returns the current date and time according to Universal + Time Coordinated (UTC), also called GMT, in the form + {{Year, Month, Day}, {Hour, Minute, Second}} if + supported by the underlying operating system. If not, + erlang:universaltime() is equivalent to + erlang:localtime().

+ 
+> erlang:universaltime().
+{{1996,11,6},{14,18,43}}
+ + + + erlang:universaltime_to_localtime({Date1, Time1}) -> {Date2, Time2} + Convert from Universal Time Coordinated (UTC) to local date and time + + Date1 = Date2 = {Year, Month, Day} + Time1 = Time2 = {Hour, Minute, Second} +  Year = Month = Day = Hour = Minute = Second = int() + + +

Converts Universal Time Coordinated (UTC) date and time to + local date and time, if this is supported by the underlying + OS. Otherwise, no conversion is done, and + {Date1, Time1} is returned.

+ 
+> erlang:universaltime_to_localtime({{1996,11,6},{14,18,43}}).
+{{1996,11,7},{15,18,43}}
+

Failure: badarg if Date1 or Time1 do + not denote a valid date or time.

+ + + + unlink(Id) -> true + Remove a link, if there is one, to another process or port + + Id = pid() | port() + + +

Removes the link, if there is one, between the calling + process and the process or port referred to by Id.

+

Returns true and does not fail, even if there is no + link to Id, or if Id does not exist.

+

Once unlink(Id) has returned it is guaranteed that + the link between the caller and the entity referred to by + Id has no effect on the caller in the future (unless + the link is setup again). If caller is trapping exits, an + {'EXIT', Id, _} message due to the link might have + been placed in the callers message queue prior to the call, + though. Note, the {'EXIT', Id, _} message can be the + result of the link, but can also be the result of Id + calling exit/2. Therefore, it may be + appropriate to cleanup the message queue when trapping exits + after the call to unlink(Id), as follow:

+ + + unlink(Id), + receive +\011{'EXIT', Id, _} -> +\011 true + after 0 -> +\011 true + end + +

Prior to OTP release R11B (erts version 5.5) unlink/1 + behaved completely asynchronous, i.e., the link was active + until the "unlink signal" reached the linked entity. This + had one undesirable effect, though. You could never know when + you were guaranteed not to be effected by the link.

+

Current behavior can be viewed as two combined operations: + asynchronously send an "unlink signal" to the linked entity + and ignore any future results of the link.

+ + + + + unregister(RegName) -> true + Remove the registered name for a process (or port) + + RegName = atom() + + +

Removes the registered name RegName, associated with a + pid or a port identifier.

+ 
+> unregister(db).
+true
+

Users are advised not to unregister system processes.

+

Failure: badarg if RegName is not a registered + name.

+ + + + whereis(RegName) -> pid() | port() | undefined + Get the pid (or port) with a given registered name + +

Returns the pid or port identifier with the registered name + RegName. Returns undefined if the name is not + registered.

+ 
+> whereis(db).
+<0.43.0>
+ + + + erlang:yield() -> true + Let other processes get a chance to execute + +

Voluntarily let other processes (if any) get a chance to + execute. Using erlang:yield() is similar to + receive after 1 -> ok end, except that yield() + is faster.

+

There is seldom or never any need to use this BIF, + especially in the SMP-emulator as other processes will have a + chance to run in another scheduler thread anyway. + Using this BIF without a thorough grasp of how the scheduler + works may cause performance degradation.

 + + + + + diff --git a/erts/doc/src/erlc.xml b/erts/doc/src/erlc.xml new file mode 100644 index 0000000000..3859ac8365 --- /dev/null +++ b/erts/doc/src/erlc.xml @@ -0,0 +1,256 @@ + + + + +
+ + 19972009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erlc + Björn Gustavsson + Bjarne Däcker + 1 + Bjarne Däcker + + 97-03-24 + A + erlc.xml +
+ erlc + Compiler + +

The program provides a common way to run + all compilers in the Erlang system. + Depending on the extension of each input file, + will invoke the appropriate compiler. + Regardless of which compiler is used, the same flags are used to provide parameters such as include paths and output directory.

+

The current working directory, ".", will not be included + in the code path when running the compiler (to avoid loading + Beam files from the current working directory that could potentially + be in conflict with the compiler or Erlang/OTP system used by the + compiler).

+ + + + erlc flags file1.ext file2.ext... + Compile files + +

compiles one or more files. + The files must include the extension, for example + for Erlang source code, or for Yecc source code. + uses the extension to invoke the correct compiler.

+ + + + +
+ Generally Useful Flags +

The following flags are supported: +

+ + -I directory + +

Instructs the compiler to search for include files in + the specified directory. When encountering an + or directive, the + compiler searches for header files in the following + directories:

+ + +

, the current working directory of the + file server;

+ + +

the base name of the compiled file;

+ + +

the directories specified using the option. + The directory specified last is searched first.

+ + + + -o directory + +

The directory where the compiler should place the output files. + If not specified, output files will be placed in the current working + directory.

+ + -Dname + +

Defines a macro.

+ + -Dname=value + +

Defines a macro with the given value. + The value can be any Erlang term. + Depending on the platform, the value may need to be + quoted if the shell itself interprets certain characters. + On Unix, terms which contain tuples and list + must be quoted. Terms which contain spaces + must be quoted on all platforms.

+ + -Wnumber + +

Sets warning level to number. Default is . + Use to turn off warnings.

+ + -W + +

Same as . Default.

+ + -v + +

Enables verbose output.

+ + -b output-type + +

Specifies the type of output file. + Generally, output-type is the same as the file extension + of the output file but without the period. + This option will be ignored by compilers that have a + a single output format.

+ + -hybrid + +

Compile using the hybrid-heap emulator. This is mainly useful + for compiling native code, which needs to be compiled with the same + run-time system that it should be run on.

+ + -smp + +

Compile using the SMP emulator. This is mainly useful + for compiling native code, which needs to be compiled with the same + run-time system that it should be run on.

+ + -- + +

Signals that no more options will follow. + The rest of the arguments will be treated as file names, + even if they start with hyphens.

+ + +term + +

A flag starting with a plus ('+') rather than a hyphen + will be converted to an Erlang term and passed unchanged to + the compiler. + For instance, the option for the Erlang + compiler can be specified as follows:

+ 
+erlc +export_all file.erl
+

Depending on the platform, the value may need to be + quoted if the shell itself interprets certain characters. + On Unix, terms which contain tuples and list + must be quoted. Terms which contain spaces + must be quoted on all platforms.

+ + +
+ +
+ Special Flags +

The flags in this section are useful in special situations + such as re-building the OTP system.

+ + -pa directory + +

Appends directory to the front of the code path in + the invoked Erlang emulator. + This can be used to invoke another + compiler than the default one.

+ + -pz directory + +

Appends directory to the code path in + the invoked Erlang emulator.

+ + +
+ +
+ Supported Compilers + + .erl + +

Erlang source code. It generates a file.

+

The options -P, -E, and -S are equivalent to +'P', + +'E', and +'S', except that it is not necessary to include the single quotes to protect them + from the shell.

+

Supported options: -I, -o, -D, -v, -W, -b.

+ + .yrl + +

Yecc source code. It generates an file.

+

Use the -I option with the name of a file to use that file + as a customized prologue file (the option).

+

Supported options: -o, -v, -I, -W (see above).

+ + .mib + +

MIB for SNMP. It generates a file.

+

Supported options: -I, -o, -W.

+ + .bin + +

A compiled MIB for SNMP. It generates a file.

+

Supported options: -o, -v.

+ + .rel + +

Script file. It generates a boot file.

+

Use the -I to name directories to be searched for application + files (equivalent to the in the option list for + ).

+

Supported options: -o.

+ + .asn1 + +

ASN1 file.

+

Creates an , , and file from + an file. Also compiles the using the Erlang + compiler unless the options is given.

+

Supported options: -I, -o, -b, -W.

+ + .idl + +

IC file.

+

Runs the IDL compiler.

+

Supported options: -I, -o.

+ + +
+ +
+ Environment Variables + + ERLC_EMULATOR + The command for starting the emulator. + Default is erl in the same directory as the erlc program + itself, or if it doesn't exist, erl in any of the directories + given in the PATH environment variable. + +
+ +
+ SEE ALSO +

erl(1), + compile(3), + yecc(3), + snmp(3)

+
+ + diff --git a/erts/doc/src/erlsrv.xml b/erts/doc/src/erlsrv.xml new file mode 100644 index 0000000000..93db56fc7c --- /dev/null +++ b/erts/doc/src/erlsrv.xml @@ -0,0 +1,405 @@ + + + + +
+ + 19982009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erlsrv + Patrik Nyblom + + + + + 98-04-29 + + erlsrv.xml +
+ erlsrv + Run the Erlang emulator as a service on Windows NT® + +

This utility is specific to Windows NT/2000/XP® (and subsequent versions of Windows) It allows Erlang + emulators to run as services on the Windows system, allowing embedded + systems to start without any user needing to log in. The + emulator started in this way can be manipulated through the + Windows® services applet in a manner similar to other + services.

+

Note that erlsrv is not a general service utility for Windows, but designed for embedded Erlang systems.

+

As well as being the actual service, erlsrv also provides a + command line interface for registering, changing, starting and + stopping services.

+

To manipulate services, the logged in user should have + Administrator privileges on the machine. The Erlang machine + itself is (default) run as the local administrator. This can be + changed with the Services applet in Windows ®.

+

The processes created by the service can, as opposed to normal + services, be "killed" with the task manager. Killing a emulator + that is started by a service will trigger the "OnFail" action + specified for that service, which may be a reboot.

+

The following parameters may be specified for each Erlang + service:

+ + +

: This tells how to stop + the Erlang emulator. Default is to kill it (Win32 + TerminateProcess), but this action can specify any Erlang + shell command that will be executed in the emulator to make + it stop. The emulator is expected to stop within 30 seconds + after the command is issued in the shell. If the emulator is + not stopped, it will report a running state to the service + manager.

+ + +

: This can be either of , + , or (the + default). In case of , the NT system is + rebooted whenever the emulator stops (a more simple form of + watchdog), this could be useful for less critical systems, + otherwise use the heart functionality to accomplish + this. The restart value makes the Erlang emulator be + restarted (with whatever parameters are registered for the + service at the occasion) when it stops. If the emulator + stops again within 10 seconds, it is not restarted to avoid + an infinite loop which could completely hang the NT + system. is similar to restart, but + does not try to detect cyclic restarts, it is expected that + some other mechanism is present to avoid the problem. The + default (ignore) just reports the service as stopped to the + service manager whenever it fails, it has to be manually + restarted.

+

On a system where release handling is + used, this should always be set to . Use + to restart the service on failure instead.

+ + +

: The location of the Erlang + emulator. The default is the located in the + same directory as erlsrv.exe. Do not specify + as this emulator, it will not work.

+

If the system + uses release handling, this should be set to a program + similar to .

+ + +

: Specifies an additional environment + for the emulator. The environment variables specified + here are added to the system wide environment block that is + normally present when a service starts up. Variables present + in both the system wide environment and in the service + environment specification will be set to the value specified + in the service.

+ + +

: The working directory for the Erlang + emulator, has to be on a local drive (there are no network + drives mounted when a service starts). Default working + directory for services is . + Debug log files will be placed in this directory.

+ + +

: The process priority of the emulator, + this can be one of , , + or (the default). Real-time priority is not + recommended, the machine will possibly be inaccessible to + interactive users. High priority could be used if two Erlang + nodes should reside on one dedicated system and one should + have precedence over the other. Low process priority may be + used if interactive performance should not be affected by + the emulator process.

+ + +

: Specifies the short or long + node-name of the Erlang emulator. The Erlang services are + always distributed, default is to use the service name as + (short) node-name.

+ + +

: Can be one of (default), + , or . + Specifies that output from the Erlang shell should be + sent to a "debug log". The log file is named + <servicename> or + <servicename><N>, where <N> is + an integer between 1 and 99. The log-file is placed in the + working directory of the service (as specified in WorkDir). The + option always reuses the same log file + (<servicename>) and the option + uses a separate log file for every invocation of the service + (<servicename><N>). The + option opens an interactive Windows® console window for + the Erlang shell of the service. The option + automatically + disables the and a service started with an + interactive console window will not survive logouts, + actions do not work with debug-consoles either. + If no is specified (), the + output of the Erlang shell is discarded.

+

The is not in any way + intended for production. It is only a convenient way to + debug Erlang services during development. The and + options might seem convenient to have in a + production system, but one has to take into account that the + logs will grow indefinitely during the systems lifetime and + there is no way, short of restarting the service, to + truncate those logs. In short, the is + intended for debugging only. Logs during production are + better produced with the standard Erlang logging + facilities.

+ + +

: Additional arguments passed to the + emulator startup program (or + ). Arguments that cannot be specified + here are (StopActions would not work), + and (they are specified in any + way. The most common use is for specifying cookies and flags + to be passed to init:boot() ().

+ + +

: Specifies the Windows® internal service name (not the display name, which is the one erlsrv uses to identify the service).

+

This internal name can not be changed, it is fixed even if the service is renamed. Erlsrv generates a unique internal name when a service is created, it is recommended to keep to the defaut if release-handling is to be used for the application.

+

The internal service name can be seen in the Windows® service manager if viewing Properties for an erlang service.

+ + +

: A textual comment describing the service. Not mandatory, but shows up as the service description in the Windows® service manager.

+ + +

+ The naming of the service in a system that + uses release handling has to follow the convention + NodeName_Release, where NodeName is + the first part of the Erlang nodename (up to, but not including + the "@") and Release is the current release of the + application.

+ + + + erlsrv {set | add} <service-name> [<service options>] + Add or modify an Erlang service + +

The set and add commands adds or modifies a Erlang service + respectively. The simplest form of an add command would be + completely without options in which case all default values + (described above) apply. The service name is mandatory.

+

Every option can be given without parameters, in which case + the default value is applied. Values to the options are + supplied only when the default should not be used + (i.e. sets the + default priority and removes all arguments).

+

The following service options are currently available:

+ + -st[opaction] [<erlang shell command>] + Defines the StopAction, the command given to the Erlang + shell when the service is stopped. Default is none. + -on[fail] [{reboot | restart | restart_always}] + Specifies the action to take when the Erlang emulator + stops unexpectedly. Default is to ignore. + -m[achine] [<erl-command>] + The complete path to the Erlang emulator, never use the + werl program for this. Default is the in the + same directory as . When release handling + is used, this should be set to a program similar to + . + -e[nv] [<variable>[=<value>]] ... + Edits the environment block for the service. Every + environment variable specified will add to the system + environment block. If a variable specified here has the same + name as a system wide environment variable, the specified + value overrides the system wide. Environment variables are + added to this list by specifying + <variable>=<value> and deleted from the list by + specifying <variable> alone. The environment block is + automatically sorted. Any number of options can + be specified in one command. Default is to use the system + environment block unmodified (except for two additions, see + below). + -w[orkdir] [<directory>] + The initial working directory of the Erlang + emulator. Default is the system directory. + -p[riority] [{low|high|realtime}] + The priority of the Erlang emulator. The default is the + Windows® default priority. + {-sn[ame] | -n[ame]} [<node-name>] + The node-name of the Erlang machine, distribution is + mandatory. Default is ]]>. + + -d[ebugtype] [{new|reuse|console}] + Specifies where shell output should be sent, + default is that shell output is discarded. + To be used only for debugging. + -ar[gs] [<limited erl arguments>] + Additional arguments to the Erlang emulator, avoid + , and + /. Default is no additional + arguments. Remember that the services cookie file is not + necessarily the same as the interactive users. The service + runs as the local administrator. All arguments should be given + together in one string, use double quotes (") to give an + argument string containing spaces and use quoted quotes (\\") + to give an quote within the argument string if + necessary. + -i[nternalservicename] [<internal name>] + Only allowed for add. Specifies a + Windows® internal service name for the service, which by + default is set to something unique (prefixed with the + original service name) by erlsrv when adding a new + service. Specifying this is a purely cosmethic action and is + not recommended if release handling is to be + performed. The internal service name cannot be changed once + the service is created. The internal name is not to + be confused with the ordinary service name, which is the name + used to identify a service to erlsrv. + -c[omment] [<short description>] + Specifies a textual comment describing the + service. This comment will show upp as the service description + in the Windows® service manager. + + + + + erlsrv {start | stop | disable | enable} <service-name> + Manipulate the current service status. + +

These commands are only added for convenience, the normal + way to manipulate the state of a service is through the + control panels services applet. The and + commands communicates + with the service manager for stopping and starting a + service. The commands wait until the service is actually + stopped or started. When disabling a service, it is not + stopped, the disabled state will not take effect until the + service actually is stopped. Enabling a service sets it in + automatic mode, that is started at boot. This command cannot + set the service to manual.

+ + + + erlsrv remove <service-name> + Remove the service. + +

This command removes the service completely with all its registered + options. It will be stopped before it is removed.

+ + + + erlsrv list [<service-name>] + List all Erlang services or all options for one service. + +

If no service name is supplied, a brief listing of all Erlang services + is presented. If a service-name is supplied, all options for that + service are presented.

+ + + + erlsrv help + Display a brief help text + + + +
+ ENVIRONMENT +

+The environment of an Erlang machine started + as a service will contain two special variables, + , which is the name of the service that + started the machine and which is the + full path to the that can be used to manipulate + the service. This will come in handy when defining a heart command for + your service. A command file for restarting a service will + simply look like this:

+ +

This command file is then set as heart command.

+

The environment variables can also be used to detect that we + are running as a service and make port programs react correctly + to the control events generated on logout (see below).

+
+ +
+ PORT PROGRAMS +

When a program runs in + the service context, it has to handle the control events that is + sent to every program in the system when the interactive user + logs off. This is done in different ways for programs running in + the console subsystem and programs running as window + applications. An application which runs in the console subsystem + (normal for port programs) uses the win32 function + to a control handler that returns + TRUE in answer to the . Other + applications just forward and + to the default window procedure. Here + is a brief example in C of how to set the console control + handler:

+ +/* +** A Console control handler that ignores the log off events, +** and lets the default handler take care of other events. +*/ +BOOL WINAPI service_aware_handler(DWORD ctrl){ + if(ctrl == CTRL_LOGOFF_EVENT) +\011return TRUE; + return FALSE; +} + +void initialize_handler(void){ + char buffer[2]; + /* + * We assume we are running as a service if this + * environment variable is defined + */ + if(GetEnvironmentVariable("ERLSRV_SERVICE_NAME",buffer, + (DWORD) 2)){ +\011/* +\011** Actually set the control handler +\011*/ +\011SetConsoleCtrlHandler(&service_aware_handler, TRUE); + } +} ]]> +
+ +
+ NOTES +

Even though the options are described in a Unix-like format, the case of + the options or commands is not relevant, and the "/" character for options + can be used as well as the "-" character.

+

Note that the program resides in the emulators + -directory, not in the -directory directly under + the Erlang root. The reasons for this are the subtle problem of + upgrading the emulator on a running system, where a new version of + the runtime system should not need to overwrite existing (and probably + used) executables.

+

To easily manipulate the Erlang services, put + the \\erts-\\bin]]> directory in + the path instead of \\bin]]>. The erlsrv program + can be found from inside Erlang by using the + Erlang function.

+

For release handling to work, use as the Erlang + machine. It is also worth mentioning again that the name of the + service is significant (see above).

+
+ +
+ SEE ALSO +

start_erl(1), release_handler(3)

+
+ + diff --git a/erts/doc/src/erts_alloc.xml b/erts/doc/src/erts_alloc.xml new file mode 100644 index 0000000000..d51e5b3ea4 --- /dev/null +++ b/erts/doc/src/erts_alloc.xml @@ -0,0 +1,554 @@ + + + + +
+ + 20022009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + erts_alloc + Rickard Green + 1 + 03-06-11 + 1 + erts_alloc.xml +
+ erts_alloc + An Erlang Run-Time System internal memory allocator library. + +

erts_alloc is an Erlang Run-Time System internal memory + allocator library. erts_alloc provides the Erlang + Run-Time System with a number of memory allocators.

+ + +
+ Allocators + +

Currently the following allocators are present:

+ + temp_alloc + Allocator used for temporary allocations. + eheap_alloc + Allocator used for Erlang heap data, such as Erlang process heaps. + binary_alloc + Allocator used for Erlang binary data. + ets_alloc + Allocator used for ETS data. + driver_alloc + Allocator used for driver data. + sl_alloc + Allocator used for memory blocks that are expected to be + short-lived. + ll_alloc + Allocator used for memory blocks that are expected to be + long-lived, for example Erlang code. + fix_alloc + A very fast allocator used for some fix-sized + data. fix_alloc manages a set of memory pools from + which memory blocks are handed out. fix_alloc + allocates memory pools from ll_alloc. Memory pools + that have been allocated are never deallocated. + std_alloc + Allocator used for most memory blocks not allocated via any of + the other allocators described above. + sys_alloc + This is normally the default malloc implementation + used on the specific OS. + mseg_alloc + A memory segment allocator. mseg_alloc is used by other + allocators for allocating memory segments and is currently only + available on systems that have the mmap system + call. Memory segments that are deallocated are kept for a + while in a segment cache before they are destroyed. When + segments are allocated, cached segments are used if possible + instead of creating new segments. This in order to reduce + the number of system calls made. + +

sys_alloc and fix_alloc are always enabled and + cannot be disabled. mseg_alloc is always enabled if it is + available and an allocator that uses it is enabled. All other + allocators can be enabled or disabled. + By default all allocators are enabled. + When an allocator is disabled, sys_alloc + is used instead of the disabled allocator.

+

The main idea with the erts_alloc library is to separate + memory blocks that are used differently into different memory + areas, and by this achieving less memory fragmentation. By + putting less effort in finding a good fit for memory blocks that + are frequently allocated than for those less frequently + allocated, a performance gain can be achieved.

+
+ +
+ + The alloc_util framework +

Internally a framework called alloc_util is used for + implementing allocators. sys_alloc, fix_alloc, and + mseg_alloc do not use this framework; hence, the + following does not apply to them.

+

An allocator manages multiple areas, called carriers, in which + memory blocks are placed. A carrier is either placed in a + separate memory segment (allocated via mseg_alloc) or in + the heap segment (allocated via sys_alloc). Multiblock + carriers are used for storage of several blocks. Singleblock + carriers are used for storage of one block. Blocks that are + larger than the value of the singleblock carrier threshold + (sbct) parameter are placed + in singleblock carriers. Blocks smaller than the value of the + sbct parameter are placed in multiblock + carriers. Normally an allocator creates a "main multiblock + carrier". Main multiblock carriers are never deallocated. The + size of the main multiblock carrier is determined by the value + of the mmbcs parameter.

+

+ + Sizes of multiblock carriers allocated via mseg_alloc are + decided based on the values of the largest multiblock carrier + size (lmbcs), the smallest + multiblock carrier size (smbcs), + and the multiblock carrier growth stages + (mbcgs) parameters. If + nc is the current number of multiblock carriers (the main + multiblock carrier excluded) managed by an allocator, the size + of the next mseg_alloc multiblock carrier allocated by + this allocator will roughly be + when + , + and lmbcs when mbcgs]]>. If the value of the + sbct parameter should be larger than the value of the + lmbcs parameter, the allocator may have to create + multiblock carriers that are larger than the value of the + lmbcs parameter, though. Singleblock carriers allocated + via mseg_alloc are sized to whole pages.

+

Sizes of carriers allocated via sys_alloc are + decided based on the value of the sys_alloc carrier size + (ycs) parameter. The size of + a carrier is the least number of multiples of the value of the + ycs parameter that satisfies the request.

+

Coalescing of free blocks are always performed immediately. + Boundary tags (headers and footers) in free blocks are used + which makes the time complexity for coalescing constant.

+

+ + The memory allocation strategy used for multiblock carriers by an + allocator is configurable via the as + parameter. Currently the following strategies are available:

+ + Best fit + +

Strategy: Find the smallest block that satisfies the + requested block size.

+

Implementation: A balanced binary search tree is + used. The time complexity is proportional to log N, where + N is the number of sizes of free blocks.

+ + Address order best fit + +

Strategy: Find the smallest block that satisfies the + requested block size. If multiple blocks are found, choose + the one with the lowest address.

+

Implementation: A balanced binary search tree is + used. The time complexity is proportional to log N, where + N is the number of free blocks.

+ + Good fit + +

Strategy: Try to find the best fit, but settle for the best fit + found during a limited search.

+

Implementation: The implementation uses segregated free + lists with a maximum block search depth (in each list) in + order to find a good fit fast. When the maximum block + search depth is small (by default 3) this implementation + has a time complexity that is constant. The maximum block + search depth is configurable via the + mbsd parameter.

+ + A fit + +

Strategy: Do not search for a fit, inspect only one free + block to see if it satisfies the request. This strategy is + only intended to be used for temporary allocations.

+

Implementation: Inspect the first block in a free-list. + If it satisfies the request, it is used; otherwise, a new + carrier is created. The implementation has a time + complexity that is constant.

+

As of erts version 5.6.1 the emulator will refuse to + use this strategy on other allocators than temp_alloc. + This since it will only cause problems for other allocators.

+ + +
+ +
+ + System Flags Effecting erts_alloc + +

Only use these flags if you are absolutely sure what you are + doing. Unsuitable settings may cause serious performance + degradation and even a system crash at any time during + operation.

+ +

Memory allocator system flags have the following syntax: +

]]> + where ]]> is a letter identifying a subsystem, + ]]> is a parameter, and ]]> is the + value to use. The flags can be passed to the Erlang emulator + (erl) as command line + arguments.

+

System flags effecting specific allocators have an upper-case + letter as ]]>. The following letters are used for + the currently present allocators:

+ + B: binary_alloc + D: std_alloc + E: ets_alloc + F: fix_alloc + H: eheap_alloc + L: ll_alloc + M: mseg_alloc + R: driver_alloc + S: sl_alloc + T: temp_alloc + Y: sys_alloc + +

The following flags are available for configuration of + mseg_alloc:

+ + ]]> + + + Absolute max cache bad fit (in kilobytes). A segment in the + memory segment cache is not reused if its size exceeds the + requested size with more than the value of this + parameter. Default value is 4096. + ]]> + + + Relative max cache bad fit (in percent). A segment in the + memory segment cache is not reused if its size exceeds the + requested size with more than relative max cache bad fit + percent of the requested size. Default value is 20. + ]]> + + + Max cached segments. The maximum number of memory segments + stored in the memory segment cache. Valid range is + 0-30. Default value is 5. + ]]> + + + Cache check interval (in milliseconds). The memory segment + cache is checked for segments to destroy at an interval + determined by this parameter. Default value is 1000. + +

The following flags are available for configuration of + fix_alloc:

+ + +MFe true + + + Enable fix_alloc. Note: fix_alloc cannot be disabled. + +

The following flags are available for configuration of + sys_alloc:

+ + +MYe true + + + Enable sys_alloc. Note: sys_alloc cannot be disabled. + +MYm libc + +malloc library to use. Currently only + libc is available. libc enables the standard + libc malloc implementation. By default libc is used. + ]]> + + + Trim threshold size (in kilobytes). This is the maximum amount + of free memory at the top of the heap (allocated by + sbrk) that will be kept by malloc (not + released to the operating system). When the amount of free + memory at the top of the heap exceeds the trim threshold, + malloc will release it (by calling + sbrk). Trim threshold is given in kilobytes. Default + trim threshold is 128. Note: This flag will + only have any effect when the emulator has been linked with + the GNU C library, and uses its malloc implementation. + ]]> + + + Top pad size (in kilobytes). This is the amount of extra + memory that will be allocated by malloc when + sbrk is called to get more memory from the operating + system. Default top pad size is 0. Note: This flag + will only have any effect when the emulator has been linked + with the GNU C library, and uses its malloc + implementation. + +

The following flags are available for configuration of allocators + based on alloc_util. If u is used as subsystem + identifier (i.e., = u]]>) all allocators based on + alloc_util will be effected. If B, D, E, + H, L, R, S, or T is used as + subsystem identifier, only the specific allocator identified will be + effected:

+ + as bf|aobf|gf|af]]> + + + Allocation strategy. Valid strategies are bf (best fit), + aobf (address order best fit), gf (good fit), + and af (a fit). See + the description of allocation strategies in "the alloc_util framework" section. + asbcst ]]> + + + Absolute singleblock carrier shrink threshold (in + kilobytes). When a block located in an + mseg_alloc singleblock carrier is shrunk, the carrier + will be left unchanged if the amount of unused memory is less + than this threshold; otherwise, the carrier will be shrunk. + See also rsbcst. + e true|false]]> + + + Enable allocator ]]>. + lmbcs ]]> + + + Largest (mseg_alloc) multiblock carrier size (in + kilobytes). See the description + on how sizes for mseg_alloc multiblock carriers are decided + in "the alloc_util framework" section. + mbcgs ]]> + + + (mseg_alloc) multiblock carrier growth stages. See + the description on how sizes for + mseg_alloc multiblock carriers are decided + in "the alloc_util framework" section. + mbsd ]]> + + + Max block search depth. This flag has effect only if the + good fit strategy has been selected for allocator + ]]>. When the good fit strategy is used, free + blocks are placed in segregated free-lists. Each free list + contains blocks of sizes in a specific range. The max block + search depth sets a limit on the maximum number of blocks to + inspect in a free list during a search for suitable block + satisfying the request. + mmbcs ]]> + + + Main multiblock carrier size. Sets the size of the main + multiblock carrier for allocator ]]>. The main + multiblock carrier is allocated via and is + never deallocated. + mmmbc ]]> + + + Max mseg_alloc multiblock carriers. Maximum number of + multiblock carriers allocated via mseg_alloc by + allocator ]]>. When this limit has been reached, + new multiblock carriers will be allocated via + sys_alloc. + mmsbc ]]> + + + Max mseg_alloc singleblock carriers. Maximum number of + singleblock carriers allocated via mseg_alloc by + allocator ]]>. When this limit has been reached, + new singleblock carriers will be allocated via + sys_alloc. + ramv ]]> + + + Realloc always moves. When enabled, reallocate operations will + more or less be translated into an allocate, copy, free sequence. + This often reduce memory fragmentation, but costs performance. + + rmbcmt ]]> + + + Relative multiblock carrier move threshold (in percent). When + a block located in a multiblock carrier is shrunk, + the block will be moved if the ratio of the size of the returned + memory compared to the previous size is more than this threshold; + otherwise, the block will be shrunk at current location. + rsbcmt ]]> + + + Relative singleblock carrier move threshold (in percent). When + a block located in a singleblock carrier is shrunk to + a size smaller than the value of the + sbct parameter, + the block will be left unchanged in the singleblock carrier if + the ratio of unused memory is less than this threshold; + otherwise, it will be moved into a multiblock carrier. + rsbcst ]]> + + + Relative singleblock carrier shrink threshold (in + percent). When a block located in an mseg_alloc + singleblock carrier is shrunk, the carrier will be left + unchanged if the ratio of unused memory is less than this + threshold; otherwise, the carrier will be shrunk. + See also asbcst. + sbct ]]> + + + Singleblock carrier threshold. Blocks larger than this + threshold will be placed in singleblock carriers. Blocks + smaller than this threshold will be placed in multiblock + carriers. + smbcs ]]> + + + Smallest (mseg_alloc) multiblock carrier size (in + kilobytes). See the description + on how sizes for mseg_alloc multiblock carriers are decided + in "the alloc_util framework" section. + t true|false|]]> + + + Multiple, thread specific instances of the allocator. + This option will only have any effect on the runtime system + with SMP support. Default behaviour on the runtime system with + SMP support (N equals the number of scheduler threads): + + temp_alloc + N + 1 instances. + ll_alloc + 1 instance. + Other allocators + N instances when N is less than or equal to + 16. 16 instances when N is greater than + 16. + + temp_alloc will always use N + 1 instances when + this option has been enabled regardless of the amount passed. + Other allocators will use the same amount of instances as the + amount passed as long as it isn't greater than N. + + +

Currently the following flags are available for configuration of + alloc_util, i.e. all allocators based on alloc_util + will be effected:

+ + ]]> + +sys_alloc carrier size. Carriers allocated via + sys_alloc will be allocated in sizes which are + multiples of the sys_alloc carrier size. This is not + true for main multiblock carriers and carriers allocated + during a memory shortage, though. + ]]> + + + Max mseg_alloc carriers. Maximum number of carriers + placed in separate memory segments. When this limit has been + reached, new carriers will be placed in memory retrieved from + sys_alloc. + +

Instrumentation flags:

+ + +Mim true|false + + + A map over current allocations is kept by the emulator. The + allocation map can be retrieved via the instrument + module. +Mim true implies +Mis true. + +Mim true is the same as + -instr. + +Mis true|false + + + Status over allocated memory is kept by the emulator. The + allocation status can be retrieved via the instrument + module. + +Mit X + + + Reserved for future use. Do not use this flag. + + +

When instrumentation of the emulator is enabled, the emulator + uses more memory and runs slower.

+ +

Other flags:

+ + +Mea min|max|r9c|r10b|r11b|config + + + min + + Disables all allocators that can be disabled. + + + max + + Enables all allocators (currently default). + + + r9c|r10b|r11b + + Configures all allocators as they were configured in respective + OTP release. These will eventually be removed. + + + config + + Disables features that cannot be enabled while creating an + allocator configuration with + erts_alloc_config(3). + Note, this option should only be used while running + erts_alloc_config, not when using the created + configuration. + + + + +

Only some default values have been presented + here. + erlang:system_info(allocator), + and + erlang:system_info({allocator, Alloc}) + can be used in order to obtain currently used settings and current + status of the allocators.

+ +

Most of these flags are highly implementation dependent, and they + may be changed or removed without prior notice.

+

erts_alloc is not obliged to strictly use the settings that + have been passed to it (it may even ignore them).

+ +

erts_alloc_config(3) + is a tool that can be used to aid creation of an + erts_alloc configuration that is suitable for a limited + number of runtime scenarios.

+
+ +
+ SEE ALSO +

erts_alloc_config(3), + erl(1), + instrument(3), + erlang(3)

+
+ + diff --git a/erts/doc/src/escript.xml b/erts/doc/src/escript.xml new file mode 100644 index 0000000000..8df179b3e2 --- /dev/null +++ b/erts/doc/src/escript.xml @@ -0,0 +1,232 @@ + + + + +
+ + 20072009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + escript + + + + + escript.xml +
+ escript + Erlang scripting support + +

provides support for running short Erlang programs + without having to compile them first and an easy way to retrieve the + command line arguments.

+ + + + script-name script-arg1 script-arg2... + escript escript-flags script-name script-arg1 script-arg2... + Run a script written in Erlang + +

runs a script written in Erlang.

+

Here follows an example.

+ 
+$ cat factorial        
+#!/usr/bin/env escript
+%% -*- erlang -*-
+%%! -smp enable -sname factorial -mnesia debug verbose
+main([String]) ->
+    try
+\011N = list_to_integer(String),
+\011F = fac(N),
+\011io:format("factorial ~w = ~w\
+", [N,F])
+    catch
+\011_:_ ->
+\011    usage()
+    end;
+main(_) ->
+    usage().
+        
+usage() ->
+    io:format("usage: factorial integer\
+"),
+    halt(1).
+        
+fac(0) -> 1;
+fac(N) -> N * fac(N-1).
+$ factorial 5
+factorial 5 = 120
+$ factorial
+usage: factorial integer
+$ factorial five
+usage: factorial integer
+

The header of the Erlang script in the example differs from + a normal Erlang module. The first line is intended to be the + interpreter line, which invokes + . However if you invoke the + like this

+ 
+$ escript factorial 5
+

the contents of the first line does not matter, but it + cannot contain Erlang code as it will be ignored.

+

The second line in the example, contains an optional + directive to the Emacs editor which causes it to + enter the major mode for editing Erlang source files. If the + directive is present it must be located on the second + line.

+

On the third line (or second line depending on the presence + of the Emacs directive), it is possible to give arguments to + the emulator, such as

+ 
+%%! -smp enable -sname factorial -mnesia debug verbose
+

Such an argument line must start with %%! and the + rest of the line will interpreted as arguments to the emulator.

+

If you know the location of the executable, the first + line can directly give the path to . For instance:

+ 
+#!/usr/local/bin/escript
+

As any other kind of scripts, Erlang scripts will not work on + Unix platforms if the execution bit for the script file is not set. + (Use to turn on the execution bit.) +

+ +

The rest of the Erlang script file may either contain + Erlang source code, an inlined beam file or an + inlined archive file.

+ +

An Erlang script file must always contain the function + main/1. When the script is run, the + function will be called with a list + of strings representing the arguments given to the script (not + changed or interpreted in any way).

+ +

If the function in the script returns successfully, + the exit status for the script will be 0. If an exception is generated + during execution, a short message will be printed and the script terminated + with exit status 127.

+ +

To return your own non-zero exit code, call ; + for instance:

+ 
+halt(1).
+ +

Call from your to + script to retrieve the pathname of the script (the pathname + is usually, but not always, absolute).

+ +

If the file contains source code (as in the example above), + it will be processed by the preprocessor epp. This + means that you for example may use pre-defined macros (such as + ) as well as include directives like + the directive. For instance, use

+ 
+-include_lib("kernel/include/file.hrl").
+

to include the record definitions for the records used by the + function.

+ +

The script will be checked for syntactic and semantic + correctness before being run. If there are warnings (such as + unused variables), they will be printed and the script will + still be run. If there are errors, they will be printed and + the script will not be run and its exit status will be + 127.

+ +

Both the module declaration and the export declaration of + the function are optional.

+ +

By default, the script will be interpreted. You can force + it to be compiled by including the following line somewhere + in the script file:

+-mode(compile).
+ +

Execution of interpreted code is slower than compiled code. + If much of the execution takes place in interpreted code it + may be worthwhile to compile it, even though the compilation + itself will take a little while.

+ +

As mentioned earlier, it is possible to have a script which + contains precompiled beam code. In a precompiled + script, the interpretation of the script header is exactly + the same as in a script containing source code. That means + that you can make a beam file executable by + prepending the file with the lines starting with #! + and %%! mentioned above. In a precompiled script, the + function + main/1 must be exported.

+ +

As yet another option it is possible to have an entire + Erlang archive in the script. In a archive script, the + interpretation of the script header is exactly the same as + in a script containing source code. That means that you can + make an archive file executable by prepending the file with + the lines starting with #! and %%! mentioned + above. In an archive script, the function main/1 must + be exported. By default the main/1 function in the + module with the same name as the basename of the + escript file will be invoked. This behavior can be + overridden by setting the flag -escript main Module + as one of the emulator flags. The Module must be the + name of a module which has an exported main/1 + function. See code(3) + for more information about archives and code loading.

+ +

In many cases it is very convenient to have a header in + the escript, especially on Unix platforms. But the header is + in fact optional. This means that you directly can "execute" + an Erlang module, beam file or archive file without adding + any header to them. But then you have to invoke the script + like this:

+ 
+$ escript factorial.erl 5
+factorial 5 = 120
+$ escript factorial.beam 5
+factorial 5 = 120
+$ escript factorial.zip 5
+factorial 5 = 120
+
+ + + + +
+ Options accepted by escript + + -c + Compile the escript regardless of the value of the mode attribute. + + + -d + Debug the escript. Starts the debugger, loads the module + containing the main/1 function into the debugger, sets a + breakpoint in main/1 and invokes main/1. If the + module is precompiled, it must be explicitly compiled with the + debug_info option. + + + -i + Interpret the escript regardless of the value of the mode attribute. + + + -s + Only perform a syntactic and semantic check of the script file. + Warnings and errors (if any) are written to the standard output, but + the script will not be run. The exit status will be 0 if there were + no errors, and 127 otherwise. + +
+ + diff --git a/erts/doc/src/fascicules.xml b/erts/doc/src/fascicules.xml new file mode 100644 index 0000000000..cae197a516 --- /dev/null +++ b/erts/doc/src/fascicules.xml @@ -0,0 +1,18 @@ + + + + + + ERTS User's Guide + + + ERTS Reference Manual + + + Release Notes + + + Off-Print + + + diff --git a/erts/doc/src/inet_cfg.xml b/erts/doc/src/inet_cfg.xml new file mode 100644 index 0000000000..18cf65759a --- /dev/null +++ b/erts/doc/src/inet_cfg.xml @@ -0,0 +1,397 @@ + + + + +
+ + 20042009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + Inet configuration + Peter Andersson + + 2004-03-02 + PA1 + inet_cfg.xml +
+ +
+ Introduction +

This chapter tells you how the Erlang runtime system is configured + for IP communication. It also explains how you may configure it + for your own particular needs by means of a configuration file. + The information here is mainly intended for users with special + configuration needs or problems. There should normally be no need + for specific settings for Erlang to function properly on a correctly + IP configured platform.

+

When Erlang starts up it will read the kernel variable + which, if defined, should specify the location and + name of a user configuration file. Example:

+

+

Note that the usage of a file, which was + supported in earlier Erlang versions, is now obsolete.

+

A second way to specify the configuration file is to set the + environment variable to the full name of the file. Example (bash):

+

+

Note that the kernel variable overrides this environment variable.

+

If no user configuration file is specified and Erlang is started + in non-distributed or short name distributed mode, Erlang will use + default configuration settings and a native lookup method that should + work correctly under most circumstances. Erlang + will not read any information from system inet configuration files + (like /etc/host.conf, /etc/nsswitch.conf, etc) in these modes, + except for /etc/resolv.conf and /etc/hosts that is read and monitored + for changes on Unix platforms for the internal DNS client + inet_res.

+

If Erlang is started in long name distributed mode, it needs to + get the domain name from somewhere and will read system inet + configuration files for this information. Any hosts and resolver + information found then is also recorded, but not + used as long as Erlang is configured for native lookups. (The + information becomes useful if the lookup method is changed to + or , see below).

+

Native lookup (system calls) is always the default resolver method. This + is true for all platforms except VxWorks and OSE Delta where + or is used (in that order of priority).

+

On Windows platforms, Erlang will search the system registry rather than + look for configuration files when started in long name distributed mode.

+
+ +
+ Configuration Data +

Erlang records the following data in a local database if found in system + inet configuration files (or system registry):

+ + Host names and addresses + Domain name + Nameservers + Search domains + Lookup method + +

This data may also be specified explicitly in the user + configuration file. The configuration file should contain lines + of configuration parameters (each terminated with a full + stop). Some parameters add data to the configuration (e.g. host + and nameserver), others overwrite any previous settings + (e.g. domain and lookup). The user configuration file is always + examined last in the configuration process, making it possible + for the user to override any default values or previously made + settings. Call to view the state of the + inet configuration database.

+

These are the valid configuration parameters:

+

+ + + +

+

+

+

+

Specify a system file that Erlang should read configuration + data from. tells the parser how the file should be + interpreted: (Unix resolv.conf), + (FreeBSD host.conf), (BSDOS host.conf), + (Linux host.conf), + (Unix nsswitch.conf) or (Unix hosts). should + specify the name of the file with full path.

+

+ + + +

+

+

+

Specify a system file that Erlang should read resolver + configuration from for the internal DNS client + inet_res, + and monitor for changes, even if it does not exist. + The path must be absolute.

+

This may override the configuration parameters + and + depending on the contents + of the specified file. They may also change any time in the future + reflecting the file contents.

+

If the file is specified as an empty string "", + no file is read nor monitored in the future. This emulates + the old behaviour of not configuring the DNS client when + the node is started in short name distributed mode.

+

If this parameter is not specified it defaults to + unless the environment variable + is set which defines + the directory for this file to some maybe other than + .

+

+ + + +

+

+

+

Specify a system file that Erlang should read resolver + configuration from for the internal hosts file resolver + and monitor for changes, even if it does not exist. + The path must be absolute.

+

These host entries are searched after all added with + {file, hosts, File} above or + {host, IP, Aliases} below when the lookup option + file is used.

+

If the file is specified as an empty string "", + no file is read nor monitored in the future. This emulates + the old behaviour of not configuring the DNS client when + the node is started in short name distributed mode.

+

If this parameter is not specified it defaults to + unless the environment variable + is set which defines + the directory for this file to some maybe other than + .

+

+ + + +

+

+

+

Specify a system registry that Erlang should read configuration + data from. Currently, is the only valid option.

+

+ + + +

+

+

+

+

Add host entry to the hosts table.

+

+ + + +

+

+

+

Set domain name.

+

+ + + +

+

+

+

+

Add address (and port, if other than default) of primary + nameserver to use for + inet_res.

+

+ + + +

+

+

+

+

Add address (and port, if other than default) of secondary + nameserver for + inet_res.

+

+ + + +

+

+

+

Add search domains for + inet_res.

+

+ + + +

+

+

+

Specify lookup methods and in which order to try them. + The valid methods are: (use system calls), + (use host data retrieved from + system configuration files and/or + the user configuration file) or + (use the Erlang DNS client + inet_res + for nameserver queries).

+

+ + + +

+

+

+

Set size of resolver cache. Default is 100 DNS records.

+

+ + + +

+

+

+

Set how often (in millisec) + the resolver cache for + inet_res. + is refreshed (i.e. expired DNS records are deleted). + Default is 1 h.

+

+ + + +

+

+

+

Set the time to wait until retry (in millisec) for DNS queries + made by + inet_res. + Default is 2 sec.

+

+ + + +

+

+

+

Set the number of DNS queries + inet_res + will try before giving up. + Default is 3.

+

+ + + +

+

+

+

Tells the DNS client + inet_res + to look up IPv6 addresses. Default is false.

+

+ + + +

+

+

+

Tells the DNS client + inet_res + to use TCP (Virtual Circuit) instead of UDP. Default is false.

+

+ + + +

+

+

+

Sets the EDNS version that + inet_res + will use. The only allowed is zero. Default is false + which means to not use EDNS.

+

+ + + +

+

+

+

Sets the allowed UDP payload size + inet_res + will advertise in EDNS queries. Also sets the limit + when the DNS query will be deemed too large for UDP + forcing a TCP query instead, which is not entirely + correct since the advertised UDP payload size of the + individual nameserver is what should be used, + but this simple strategy will do until a more intelligent + (probing, caching) algorithm need be implemented. + The default is 1280 which stems from the + standard Ethernet MTU size.

+

+ + + +

+

+

+

Tell Erlang to use other primitive UDP module than inet_udp.

+

+ + + +

+

+

+

Tell Erlang to use other primitive TCP module than inet_tcp.

+

+ + + +

+

Clear the hosts table.

+

+ + + +

+

Clear the list of recorded nameservers (primary and secondary).

+

+ + + +

+

Clear the list of search domains.

+

+ + +
+ +
+ User Configuration Example +

Here follows a user configuration example.

+

Assume a user does not want Erlang to use the native lookup method, + but wants Erlang to read all information necessary from start and use + that for resolving names and addresses. In case lookup fails, Erlang + should request the data from a nameserver (using the Erlang + DNS client, set to use EDNS allowing larger responses). + The resolver configuration will be updated when + its configuration file changes, furthermore, DNS records + should never be cached. The user configuration file + (in this example named , stored + in directory ) could then look like this + (Unix):

+ 
+      %% -- ERLANG INET CONFIGURATION FILE --
+      %% read the hosts file
+      {file, hosts, "/etc/hosts"}.
+      %% add a particular host
+      {host, {134,138,177,105}, ["finwe"]}.
+      %% do not monitor the hosts file
+      {hosts_file, ""}.
+      %% read and monitor nameserver config from here
+      {resolv_conf, "/usr/local/etc/resolv.conf"}.
+      %% enable EDNS
+      {edns,0}.
+      %% disable caching
+      {cache_size, 0}.
+      %% specify lookup method
+      {lookup, [file, dns]}.
+

And Erlang could, for example, be started like this:

+

+
+ + diff --git a/erts/doc/src/init.xml b/erts/doc/src/init.xml new file mode 100644 index 0000000000..33364c709a --- /dev/null +++ b/erts/doc/src/init.xml @@ -0,0 +1,384 @@ + + + + +
+ + 19962009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + init + + + + + init.xml +
+ init + Coordination of System Startup + +

The init module is pre-loaded and contains the code for + the init system process which coordinates the start-up of + the system. The first function evaluated at start-up is + boot(BootArgs), where BootArgs is a list of command + line arguments supplied to the Erlang runtime system from + the local operating system. See + erl(1).

+

init reads the boot script which contains instructions on + how to initiate the system. See + script(4) for more + information about boot scripts.

+

init also contains functions to restart, reboot, and stop + the system.

+ + + + boot(BootArgs) -> void() + Start the Erlang runtime system + + BootArgs = [binary()] + + +

Starts the Erlang runtime system. This function is called + when the emulator is started and coordinates system start-up.

+

BootArgs are all command line arguments except + the emulator flags, that is, flags and plain arguments. See + erl(1).

+

init itself interprets some of the flags, see + Command Line Flags below. + The remaining flags ("user flags") and plain arguments are + passed to the init loop and can be retrieved by calling + get_arguments/0 and get_plain_arguments/0, + respectively.

+ + + + get_args() -> [Arg] + Get all non-flag command line arguments + + Arg = atom() + + +

Returns any plain command line arguments as a list of atoms + (possibly empty). It is recommended that + get_plain_arguments/1 is used instead, because of + the limited length of atoms.

+ + + + get_argument(Flag) -> {ok, Arg} | error + Get the values associated with a command line user flag + + Flag = atom() + Arg = [Values] +  Values = [string()] + + +

Returns all values associated with the command line user flag + Flag. If Flag is provided several times, each + Values is returned in preserved order.

+ 
+% erl -a b c -a d
+...
+1> init:get_argument(a).
+{ok,[["b","c"],["d"]]}
+

There are also a number of flags, which are defined + automatically and can be retrieved using this function:

+ + root + +

The installation directory of Erlang/OTP, $ROOT.

+ 
+2> init:get_argument(root).
+{ok,[["/usr/local/otp/releases/otp_beam_solaris8_r10b_patched"]]}
+ + progname + +

The name of the program which started Erlang.

+ 
+3> init:get_argument(progname).
+{ok,[["erl"]]}
+ + home + +

The home directory.

+ 
+4> init:get_argument(home).
+{ok,[["/home/harry"]]}
+ + +

Returns error if there is no value associated with + Flag.

+ + + + get_arguments() -> Flags + Get all command line user flags + + Flags = [{Flag, Values}] +  Flag = atom() +  Values = [string()] + + +

Returns all command line flags, as well as the system + defined flags, see get_argument/1.

+ + + + get_plain_arguments() -> [Arg] + Get all non-flag command line arguments + + Arg = string() + + +

Returns any plain command line arguments as a list of strings + (possibly empty).

+ + + + get_status() -> {InternalStatus, ProvidedStatus} + Get system status information + + InternalStatus = starting | started | stopping + ProvidedStatus = term() + + +

The current status of the init process can be + inspected. During system startup (initialization), + InternalStatus is starting, and + ProvidedStatus indicates how far the boot script has + been interpreted. Each {progress, Info} term + interpreted in the boot script affects ProvidedStatus, + that is, ProvidedStatus gets the value of Info.

+ + + + reboot() -> void() + Take down and restart an Erlang node smoothly + +

All applications are taken down smoothly, all code is + unloaded, and all ports are closed before the system + terminates. If the -heart command line flag was given, + the heart program will try to reboot the system. Refer + to heart(3) for more information.

+

To limit the shutdown time, the time init is allowed + to spend taking down applications, the -shutdown_time + command line flag should be used.

+ + + + restart() -> void() + Restart the running Erlang node + +

The system is restarted inside the running Erlang + node, which means that the emulator is not restarted. All + applications are taken down smoothly, all code is unloaded, + and all ports are closed before the system is booted again in + the same way as initially started. The same BootArgs + are used again.

+

To limit the shutdown time, the time init is allowed + to spend taking down applications, the -shutdown_time + command line flag should be used.

+ + + + script_id() -> Id + Get the identity of the used boot script + + Id = term() + + +

Get the identity of the boot script used to boot the system. + Id can be any Erlang term. In the delivered boot + scripts, Id is {Name, Vsn}. Name and + Vsn are strings.

+ + + + stop() -> void() + Take down an Erlang node smoothly + +

All applications are taken down smoothly, all code is + unloaded, and all ports are closed before the system + terminates. If the -heart command line flag was given, + the heart program is terminated before the Erlang node + terminates. Refer to heart(3) for more information.

+

To limit the shutdown time, the time init is allowed + to spend taking down applications, the -shutdown_time + command line flag should be used.

+ + + + stop(Status) -> void() + Take down an Erlang node smoothly + + Status = int()>=0 | string() + + +

All applications are taken down smoothly, all code is + unloaded, and all ports are closed before the system + terminates by calling halt(Status). If the + -heart command line flag was given, the heart + program is terminated before the Erlang node + terminates. Refer to heart(3) for more + information.

+

To limit the shutdown time, the time init is allowed + to spend taking down applications, the -shutdown_time + command line flag should be used.

+ + + + +
+ + Command Line Flags +

The support for loading of code from archive files is + experimental. The sole purpose of releasing it before it is ready + is to obtain early feedback. The file format, semantics, + interfaces etc. may be changed in a future release. The + -code_path_choice flag is also experimental.

 + +

The init module interprets the following command line + flags:

+ + + -- + +

Everything following -- up to the next flag is + considered plain arguments and can be retrieved using + get_plain_arguments/0.

+ + -code_path_choice Choice + +

This flag can be set to strict or relaxed. It + controls whether each directory in the code path should be + interpreted strictly as it appears in the boot script or if + init should be more relaxed and try to find a suitable + directory if it can choose from a regular ebin directory and + an ebin directory in an archive file. This flag is particular + useful when you want to elaborate with code loading from + archives without editing the boot script. See script(4) for more information + about interpretation of boot scripts. The flag does also have + a similar affect on how the code server works. See code(3).

+ + + -eval Expr + +

Scans, parses and evaluates an arbitrary expression + Expr during system initialization. If any of these + steps fail (syntax error, parse error or exception during + evaluation), Erlang stops with an error message. Here is an + example that seeds the random number generator:

+ 
+% erl -eval '{X,Y,Z}' = now(), random:seed(X,Y,Z).'
+

This example uses Erlang as a hexadecimal calculator:

+ 
+% erl -noshell -eval 'R = 16#1F+16#A0, io:format("~.16B~n", [R])' \\
+-s erlang halt
+BF
+

If multiple -eval expressions are specified, they + are evaluated sequentially in the order specified. + -eval expressions are evaluated sequentially with + -s and -run function calls (this also in + the order specified). As with -s and -run, an + evaluation that does not terminate, blocks the system + initialization process.

+ + -extra + +

Everything following -extra is considered plain + arguments and can be retrieved using + get_plain_arguments/0.

+ + -run Mod [Func [Arg1, Arg2, ...]] + +

Evaluates the specified function call during system + initialization. Func defaults to start. If no + arguments are provided, the function is assumed to be of arity + 0. Otherwise it is assumed to be of arity 1, taking the list + [Arg1,Arg2,...] as argument. All arguments are passed + as strings. If an exception is raised, Erlang stops with an + error message.

+

Example:

+ 
+% erl -run foo -run foo bar -run foo bar baz 1 2
+

This starts the Erlang runtime system and evaluates + the following functions:

+ +foo:start() +foo:bar() +foo:bar(["baz", "1", "2"]). +

The functions are executed sequentially in an initialization + process, which then terminates normally and passes control to + the user. This means that a -run call which does not + return will block further processing; to avoid this, use + some variant of spawn in such cases.

+ + -s Mod [Func [Arg1, Arg2, ...]] + +

Evaluates the specified function call during system + initialization. Func defaults to start. If no + arguments are provided, the function is assumed to be of arity + 0. Otherwise it is assumed to be of arity 1, taking the list + [Arg1,Arg2,...] as argument. All arguments are passed + as atoms. If an exception is raised, Erlang stops with an + error message.

+

Example:

+ 
+% erl -s foo -s foo bar -s foo bar baz 1 2
+

This starts the Erlang runtime system and evaluates + the following functions:

+ +foo:start() +foo:bar() +foo:bar([baz, '1', '2']). +

The functions are executed sequentially in an initialization + process, which then terminates normally and passes control to + the user. This means that a -s call which does not + return will block further processing; to avoid this, use + some variant of spawn in such cases.

+

Due to the limited length of atoms, it is recommended that + -run be used instead.

+ + +
+ +
+ Example + 
+% erl -- a b -children thomas claire -ages 7 3 -- x y
+...
+
+1> init:get_plain_arguments().
+["a","b","x","y"]
+2> init:get_argument(children).
+{ok,[["thomas","claire"]]}
+3> init:get_argument(ages).
+{ok, [["7","3"]]}
+4> init:get_argument(silly).
+error
+
+ +
+ SEE ALSO +

erl_prim_loader(3), + heart(3)

+
+ + diff --git a/erts/doc/src/make.dep b/erts/doc/src/make.dep new file mode 100644 index 0000000000..98bac78235 --- /dev/null +++ b/erts/doc/src/make.dep @@ -0,0 +1,32 @@ +# ---------------------------------------------------- +# >>>> Do not edit this file <<<< +# This file was automaticly generated by +# /home/gandalf/otp/bin/docdepend +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# TeX files that the DVI file depend on +# ---------------------------------------------------- + +book.dvi: absform.tex alt_dist.tex book.tex crash_dump.tex \ + driver.tex driver_entry.tex epmd.tex erl.tex \ + erl_dist_protocol.tex erl_driver.tex erl_ext_dist.tex \ + erl_prim_loader.tex erl_set_memory_block.tex \ + erlang.tex erlc.tex erlsrv.tex erts_alloc.tex \ + escript.tex inet_cfg.tex init.tex match_spec.tex \ + part.tex ref_man.tex run_erl.tex start.tex \ + start_erl.tex tty.tex werl.tex zlib.tex + +# ---------------------------------------------------- +# Source inlined when transforming from source to LaTeX +# ---------------------------------------------------- + +book.tex: ref_man.xml + +# ---------------------------------------------------- +# Pictures that the DVI file depend on +# ---------------------------------------------------- + +book.dvi: erl_ext_fig.ps + diff --git a/erts/doc/src/match_spec.xml b/erts/doc/src/match_spec.xml new file mode 100644 index 0000000000..26480473d2 --- /dev/null +++ b/erts/doc/src/match_spec.xml @@ -0,0 +1,564 @@ + + + + +
+ + 19992009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + Match specifications in Erlang + Patrik Nyblom + + + + + 1999-06-01 + PA1 + match_spec.xml +
+

A "match specification" (match_spec) is an Erlang term describing a + small "program" that will try to match something (either the + parameters to a function as used in the + BIF, or the objects in an ETS table.). + The match_spec in many ways works like a small function in Erlang, but is + interpreted/compiled by the Erlang runtime system to something much more + efficient than calling an Erlang function. The match_spec is also + very limited compared to the expressiveness of real Erlang functions.

+

Match specifications are given to the BIF to + execute matching of function arguments as well as to define some actions + to be taken when the match succeeds (the part). Match + specifications can also be used in ETS, to specify objects to be + returned from an call (or other select + calls). The semantics and restrictions differ slightly when using + match specifications for tracing and in ETS, the differences are + defined in a separate paragraph below.

+

The most notable difference between a match_spec and an Erlang fun is + of course the syntax. Match specifications are Erlang terms, not + Erlang code. A match_spec also has a somewhat strange concept of + exceptions. An exception (e.g., ) in the + part, + which resembles an Erlang guard, will generate immediate failure, + while an exception in the part, which resembles the body of an + Erlang function, is implicitly caught and results in the single atom + . +

+ +
+ Grammar +

A match_spec can be described in this informal grammar:

+ + MatchExpression ::= [ MatchFunction, ... ] + + MatchFunction ::= { MatchHead, MatchConditions, MatchBody } + + MatchHead ::= MatchVariable | | [ MatchHeadPart, ... ] + + MatchHeadPart ::= term() | MatchVariable | + MatchVariable ::= '$<number>' + + MatchConditions ::= [ MatchCondition, ...] | + MatchCondition ::= { GuardFunction } | + { GuardFunction, ConditionExpression, ... } + + BoolFunction ::= | | + | | | + | | | + | | | + | | | + | | | | + | + ConditionExpression ::= ExprMatchVariable | { GuardFunction } | + { GuardFunction, ConditionExpression, ... } | TermConstruct + + ExprMatchVariable ::= MatchVariable (bound in the MatchHead) | + | + TermConstruct = {{}} | {{ ConditionExpression, ... }} | + | [ConditionExpression, ...] | NonCompositeTerm | Constant + + NonCompositeTerm ::= term() (not list or tuple) + + Constant ::= {, term()} + + GuardFunction ::= BoolFunction | | + | | | | + | | | | + | | | | + | | | | + | | | ']]> | + =']]> | | | | + | | | | + + MatchBody ::= [ ActionTerm ] + + ActionTerm ::= ConditionExpression | ActionCall + + ActionCall ::= {ActionFunction} | + {ActionFunction, ActionTerm, ...} + + ActionFunction ::= | + | | + | | | + | | | + | | | + + +
+ +
+ Function descriptions + +
+ Functions allowed in all types of match specifications +

The different functions allowed in work like this: +

+

is_atom, is_constant, is_float, is_integer, is_list, is_number, is_pid, is_port, is_reference, is_tuple, is_binary, is_function: Like the corresponding guard tests in + Erlang, return or . +

+

is_record: Takes an additional parameter, which SHALL + be the result of )]]>, + like in . +

+

'not': Negates its single argument (anything other + than gives ). +

+

'and': Returns if all its arguments + (variable length argument list) evaluate to , else + . Evaluation order is undefined. +

+

'or': Returns if any of its arguments + evaluates to . Variable length argument + list. Evaluation order is undefined. +

+

andalso: Like , but quits evaluating its + arguments as soon as one argument evaluates to something else + than true. Arguments are evaluated left to right. +

+

orelse: Like , but quits evaluating as soon + as one of its arguments evaluates to . Arguments are + evaluated left to right. +

+

'xor': Only two arguments, of which one has to be true + and the other false to return ; otherwise + returns false. +

+

abs, element, hd, length, node, round, size, tl, trunc, '+', '-', '*', 'div', 'rem', 'band', 'bor', 'bxor', 'bnot', 'bsl', 'bsr', '>', '>=', '<', '=<', '=:=', '==', '=/=', '/=', self: Work as the corresponding Erlang bif's (or + operators). In case of bad arguments, the result depends on + the context. In the part of the + expression, the test fails immediately (like in an Erlang + guard), but in the , exceptions are implicitly + caught and the call results in the atom .

+
+ +
+ Functions allowed only for tracing +

is_seq_trace: Returns if a sequential + trace token is set for the current process, otherwise . +

+

set_seq_token: Works like + , but returns on success + and on error or bad argument. Only allowed in the + part and only allowed when tracing. +

+

get_seq_token: Works just like + , and is only allowed in the + part when tracing. +

+

message: Sets an additional message appended to the + trace message sent. One can only set one additional message in + the body; subsequent calls will replace the appended message. As + a special case, disables sending of + trace messages ('call' and 'return_to') + for this function call, just like if the match_spec had not matched, + which can be useful if only the side effects of + the are desired. + Another special case is which + sets the default behavior, as if the function had no match_spec, + trace message is sent with no extra + information (if no other calls to are placed + before , it is in fact a "noop"). +

+

Takes one argument, the message. Returns and can + only be used in the part and when tracing. +

+

return_trace: Causes a trace + message to be sent upon return from the current function. + Takes no arguments, returns and can only be used + in the part when tracing. + If the process trace flag + is active the trace message is inhibited. +

+

NOTE! If the traced function is tail recursive, this match + spec function destroys that property. + Hence, if a match spec executing this function is used on a + perpetual server process, it may only be active for a limited + time, or the emulator will eventually use all memory in the host + machine and crash. If this match_spec function is inhibited + using the process trace flag + tail recursiveness still remains. +

+

exception_trace: Same as return_trace, + plus; if the traced function exits due to an exception, + an trace message is generated, + whether the exception is caught or not. +

+

process_dump: Returns some textual information about + the current process as a binary. Takes no arguments and is only + allowed in the part when tracing. +

+

enable_trace: With one parameter this function turns + on tracing like the Erlang call , where is the parameter to + . With two parameters, the first parameter + should be either a process identifier or the registered name of + a process. In this case tracing is turned on for the designated + process in the same way as in the Erlang call , where P1 is the first and P2 is the second + argument. The process gets its trace messages sent to the same + tracer as the process executing the statement uses. + can not be one of the atoms , or + (unless, of course, they are registered names). + can not be nor + . + Returns and may only be used in + the part when tracing. +

+

disable_trace: With one parameter this function + disables tracing like the Erlang call , where is the parameter to + . With two parameters it works like the + Erlang call , where P1 can + be either a process identifier or a registered name and is given + as the first argument to the match_spec function. + can not be nor + . Returns + and may only be used in the part + when tracing. +

+

trace: With two parameters this function takes a list + of trace flags to disable as first parameter and a list + of trace flags to enable as second parameter. Logically, the + disable list is applied first, but effectively all changes + are applied atomically. The trace flags + are the same as for not including + but including . If a + tracer is specified in both lists, the tracer in the + enable list takes precedence. If no tracer is specified the + same tracer as the process executing the match spec is + used. With three parameters to this function the first is + either a process identifier or the registered name of a + process to set trace flags on, the second is the disable + list, and the third is the enable list. Returns + if any trace property was changed for the + trace target process or if not. It may only + be used in the part when tracing. +

+

caller: + Returns the calling function as a tuple {Module, + Function, Arity} or the atom if the calling + function cannot be determined. May only be used in the + part when tracing. +

+

Note that if a "technically built in function" (i.e. a + function not written in Erlang) is traced, the + function will sometimes return the atom . The calling + Erlang function is not available during such calls. +

+

display: For debugging purposes only; displays the + single argument as an Erlang term on stdout, which is seldom + what is wanted. Returns and may only be used in the + part when tracing. +

+

+get_tcw: + Takes no argument and returns the value of the node's trace + control word. The same is done by + . +

+

The trace control word is a 32-bit unsigned integer intended for + generic trace control. The trace control word can be tested and + set both from within trace match specifications and with BIFs. + This call is only allowed when tracing. +

+

+set_tcw: + Takes one unsigned integer argument, sets the value of + the node's trace control word to the value of the argument + and returns the previous value. The same is done by + . It is only + allowed to use in the part + when tracing. +

+

silent: + Takes one argument. If the argument is , the call + trace message mode for the current process is set to silent + for this call and all subsequent, i.e call trace messages + are inhibited even if is called in the + part for a traced function. +

+

This mode can also be activated with the flag + to . +

+

If the argument is , the call trace message mode + for the current process is set to normal (non-silent) for + this call and all subsequent. +

+

If the argument is neither nor , + the call trace message mode is unaffected.

+
+

Note that all "function calls" have to be tuples, + even if they take no arguments. The value of is + the atom() , but the value of is + the pid() of the current process.

+
+ +
+ Variables and literals +

Variables take the form ']]> where + ]]> is an integer between 0 (zero) and + 100000000 (1e+8), the behavior if the number is outside these + limits is undefined. In the part, the special + variable matches anything, and never gets bound (like + in Erlang). In the + parts, no unbound variables are allowed, why is + interpreted as itself (an atom). Variables can only be bound in + the part. In the and + parts, only variables bound previously may + be used. As a special case, in the + parts, the variable + expands to the whole expression which matched the + (i.e., the whole parameter list to the possibly + traced function or the whole matching object in the ets table) + and the variable expands to a list + of the values of all bound variables in order + (i.e. ). +

+

In the part, all literals (except the variables + noted above) are interpreted as is. In the + parts, however, the + interpretation is in some ways different. Literals in the + can either be written as is, + which works for all literals except tuples, or by using the + special form , where is any Erlang + term. For tuple literals in the match_spec, one can also use + double tuple parentheses, i.e., construct them as a tuple of + arity one containing a single tuple, which is the one to be + constructed. The "double tuple parenthesis" syntax is useful to + construct tuples from already bound variables, like in + . Some examples may be needed: +

+ + + Expression\011\011 + Variable bindings\011\011 + Result\011 + + + {{'$1','$2'}}\011\011 + '$1' = a, '$2' = b + {a,b} + + + {const, {'$1', '$2'}}\011 + doesn't matter + {'$1', '$2'} + + + a\011\011\011 + doesn't matter\011\011\011 + a + + + '$1'\011\011\011 + '$1' = []\011\011\011 + [] + + + ['$1']\011\011\011 + '$1' = []\011\011\011 + [[]] + + + [{{a}}]\011\011\011 + doesn't matter + [{a}] + + + 42\011\011\011 + doesn't matter + 42 + + + "hello"\011\011\011 + doesn't matter + "hello" + + + $1\011\011\011 + doesn't matter + 49 (the ASCII value for the character '1') + + Literals in the MatchCondition/MatchBody parts of a match_spec +
+
+ +
+ Execution of the match +

The execution of the match expression, when the runtime system + decides whether a trace message should be sent, goes as follows: +

+

For each tuple in the list and while no + match has succeeded:

+ + Match the part against the arguments to the + function, + binding the ']]> variables (much like in + ). + If the cannot match the arguments, the match fails. + + Evaluate each (where only + ']]> variables previously bound in the + can occur) and expect it to return the atom + . As soon as a condition does not evaluate to + , the match fails. If any BIF call generates an + exception, also fail. + + + + If the match_spec is executing when tracing:

+ Evaluate each in the same way as the + , but completely ignore the return + values. Regardless of what happens in this part, the match has + succeeded. + If the match_spec is executed when selecting objects from an ETS table:

+ Evaluate the expressions in order and return the value of + the last expression (typically there is only one expression + in this context) + + + +
+ +
+ Differences between match specifications in ETS and tracing +

ETS match specifications are there to produce a return + value. Usually the expression contains one single + which defines the return value without having + any side effects. Calls with side effects are not allowed in the + ETS context.

+

When tracing there is no return value to produce, the + match specification either matches or doesn't. The effect when the + expression matches is a trace message rather then a returned + term. The 's are executed as in an imperative + language, i.e. for their side effects. Functions with side effects + are also allowed when tracing.

+

In ETS the match head is a (or a single match + variable) while it is a list (or a single match variable) when + tracing.

+
+ +
+ Examples +

Match an argument list of three where the first and third arguments + are equal:

+ +

Match an argument list of three where the second argument is + a number greater than three:

+ ', '$1', 3}], + []}] + ]]> +

Match an argument list of three, where the third argument + is a tuple containing argument one and two or a list + beginning with argument one and two (i. e. or + ): +

+ +

The above problem may also be solved like this:

+ +

Match two arguments where the first is a tuple beginning with + a list which in turn begins with the second argument times + two (i. e. [{[4,x],y},2] or [{[8], y, z},4])

+ +

Match three arguments. When all three are equal and are + numbers, append the process dump to the trace message, else + let the trace message be as is, but set the sequential trace + token label to 4711.

+ +

As can be noted above, the parameter list can be matched + against a single or an . To replace the + whole + parameter list with a single variable is a special case. In all + other cases the has to be a proper list. +

+

Match all objects in an ets table where the first element is + the atom 'strider' and the tuple arity is 3 and return the whole + object.

+ +

Match all objects in an ets table with arity > 1 and the first + element is 'gandalf', return element 2.

+ =',{size, '$1'},2}], + [{element,2,'$1'}]}] + ]]> +

In the above example, if the first element had been the key, + it's much more efficient to match that key in the + part than in the part. The search space of + the tables is restricted with regards to the so + that only objects with the matching key are searched. +

+

Match tuples of 3 elements where the second element is either + 'merry' or 'pippin', return the whole objects.

+ +

The function can be useful for testing + complicated ets matches.

+
+ + diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml new file mode 100644 index 0000000000..2252358e0d --- /dev/null +++ b/erts/doc/src/notes.xml @@ -0,0 +1,5439 @@ + + + + +
+ + 20042009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + ERTS Release Notes + otp_appnotes + nil + nil + nil + notes.xml +
+

This document describes the changes made to the ERTS application.

+ +
Erts 5.7.4 + +
Fixed Bugs and Malfunctions + + +

+ An insufficient stack allocation was made when reading + CPU information on BSD operating systems. (Thanks Michael + Turner and Akira Kitada)

+

+ Own Id: OTP-8207

+ + +

+ A bug when supplying an argument without a dash directly + after the program name when starting erlang could prevent + distribution to start. This is now corrected.

+

+ Own Id: OTP-8209

+ + +

+ A ticker process could potentially be blocked + indefinitely trying to send a tick to a node not + responding. If this happened, the connection would not be + brought down as it should.

+

+ Own Id: OTP-8218

+ + +

+ Using certain firewalls (i.e. MS IAS Client and certain + versions of COMODO) could expose an undocumented + behaviour in the Win32 socket interface causing the name + resolution calls to hang infinitely. This is now worked + around by adding possibilities for port programs under + Windows to use overlapped I/O on their standard + input/output file handles.

+

+ Own Id: OTP-8230

+ + +

+ Fixed bug on ETS tables with write_concurrency. + The emulator could crash when doing a select or + match with a bound key without finding any object.

+

+ Own Id: OTP-8242

+ + +

The information-request / + information-response, and + group-leader-change-request / + group-leader-changed-response signal pairs + described below did not always adhere to the signal order + guarantees of Erlang's signal model in the runtime system + with SMP support. These signals could for example + sometimes pass exit signals.

+

The following BIFs behaviors can be modeled as if an + asynchronous information-request signal is sent to + Pid. If Pid is alive, it responds with an + asynchronous information-response signal; + otherwise, the runtime system responds with a + no-such-process signal. When the response is + received, the caller transforms it into the result of the + BIF.

is_process_alive(Pid) + erlang:process_display(Pid, Type) + process_info(Pid) + process_info(Pid, ItemSpec) +

When Pid resides on the same node as the caller + of group_leader(GroupLeader, Pid), the + group_leader/2 BIFs behavior can be modeled as if + an asynchronous group-leader-change-request signal + is sent to Pid. If Pid is alive, it + responds with an asynchronous + group-leader-changed-response signal; otherwise, + the runtime system responds with a no-such-process + signal. When the response is received, the caller + transforms it into the result of the BIF. The distributed + case which only consists of an asynchronous + group-leader-change-request signal and no response + is not effected.

+

+ Own Id: OTP-8245

+ + +

+ Errors in the system_profile documentation has + been corrected.

+

+ Own Id: OTP-8257

+ + +

+ Low watermark socket option modified high watermark + instead of low watermark in the inet_driver. (Thanks to + Feng Yu and Tuncer Ayaz)

+

+ Own Id: OTP-8279

+ + +

+ A race condition could cause the runtime system with SMP + support to end up in a completely unresponsive state.

+

+ Own Id: OTP-8297

+ + +
+ + +
Improvements and New Features + + +

+ The use of pthread_cond_timedwait() have been + completely removed from the runtime system. This since + its behavior is unpredictable when the system clock is + suddenly changed. The previous use of it was harmless.

+

+ Own Id: OTP-8193

+ + +

+ The documentation is now built with open source tools + (xsltproc and fop) that exists on most platforms. One + visible change is that the frames are removed.

+

+ Own Id: OTP-8201

+ + +

+ A new garbage collecting strategy for binaries which is + more aggressive than the previous implementation. + Binaries now has a virtual binary heap tied to each + process. When binaries are created or received to a + process it will check if the heap limit has been reached + and if a reclaim should be done. This imitates the + behavior of ordinary Erlang terms. The virtual heaps are + grown and shrunk like ordinary heaps. This will lessen + the memory footprint of binaries in a system.

+

+ Own Id: OTP-8202

+ + +

+ The ErlDrvTermData term types used by + driver_output_term() and driver_send_term() + have been extended with the term types + ERL_DRV_INT64, and ERL_DRV_UINT64 for + passing 64-bit integers. Also the 64-bit integer data + types ErlDrvSInt64 and ErlDrvUInt64 have + been introduced.

+

+ For more information see the erl_driver(3) + documentation.

+

+ Own Id: OTP-8205

+ + +

+ [escript] The restriction that the first line in escripts + must begin with #! has been removed.

+

+ [escript] Some command line options to the escript + executable has now been documented. For example you can + run an escript in the debugger by just adding a command + line option.

+

+ [escript] The documentation of the escript header syntax + has been clarified. For example the header is optional. + This means that it is possible to directly "execute" + .erl, .beam and.zip files.

+

+ Own Id: OTP-8215

+ + +

+ The instruction for building OTP on Windows was outdated + and incomplete, the document is updated.

+

+ Also the otp_build script required windows drives to show + up in Cygwin using the /cygdrive prefix. That requirement + is now removed.

+

+ Own Id: OTP-8219

+ + +

+ A module can have native implemented functions (NIFs) + that are dynamically loaded by calling + erlang:load_nif/2. This is an experimental feature + that is not yet intended for production systems. It is + released with intention to get some early feedback on the + interfaces before they are carved in stone.

+

+ Own Id: OTP-8220

+ + +

+ The float/1 BIF would always force a garbage + collection. The BIFs size/1, byte_size/1, + bit_size/1, abs/1, and round/1 would + force a garbage-collection if the result was not a + sufficiently small integer.

+

+ Own Id: OTP-8221

+ + +

+ The erlang:port_command/3 + BIF has been added. erlang:port_command/3 is + currently not auto imported, but it is planned to be auto + imported in OTP R14. For more information see the + erlang(3) + documentation.

+

+ Own Id: OTP-8225

+ + +

+ 'configure --enable-darwin-64bit' would fail if + Snow Leopard had been booted with the 64-bit kernel. + (Thanks to Ryan M. Graham.)

+

+ Own Id: OTP-8236

+ + +
+ +
+ +
Erts 5.7.3 + +
Fixed Bugs and Malfunctions + + +

+ On Windows, open_port({spawn,Command},Opts) could not run + executables with spaces in the path or filename, + regardless of quoting efforts. While + open_port({spawn_executable,Exec},Opts) can run any + executable, it was still impossible to use 'spawn' to do + the same thing. This is now corrected.

+

+ Own Id: OTP-8055

+ + +

+ The scheduler bind type processor_spread spread + schedulers too much on large NUMA systems.

+

+ The new scheduler bind type spread spreads + schedulers as much as possible, and behaves as + processor_spread previously did. For more + information see the documentation of the +sbt + command line argument in the erl(1) documentation, + and the documentation of + erlang:system_flag(scheduler_bind_type, + SchedulerBindType).

+

+ Own Id: OTP-8063

+ + +

+ Automatically detected CPU topology on Linux system could + erroneously contain logical processors with -1 as + identifiers. This happened when + sysconf(_SC_NPROCESSORS_CONF) returned a value + larger than the amount of logical processors found.

+

+ Own Id: OTP-8064

+ + +

+ When the minimal term [] (end of list) was sent as the + complete message to a process on another node, and + received there, it could not be decoded. This bug is now + corrected. Fortunately [] is uncommon as the complete + message in real applications but it is a serious bug + anyway.

+

+ Own Id: OTP-8092

+ + +

A bug when the floating point exception pointer was + not initialized has been corrected. It manifested itself + on CentOS 5.1 sometimes when a floating point value was + sent to a remote node. Bug reported and patch suggested + by David Reiss, confirmed by Mikael Pettersson.

+

Some build problems on IRIX was also corrected. + Problem reported by Patrick Baggett, patch by Mikael + Pettersson.

+

+ Own Id: OTP-8095

+ + +

+ A terminating process could erroneously unregister a name + for another process. This could occur under the following + conditions: The name of the terminating process was + unregistered and then registered for another process + simultaneously as the process that first had the name was + terminating.

+

+ Own Id: OTP-8099 Aux Id: seq11344

+ + +

+ Running erlc in a very deep directory (with a path length + of more 256 or more characters) would cause the emulator + to crash in a call to list_to_atom/1. (Thanks to + Chris Newcombe.)

+

+ Own Id: OTP-8124

+ + +

+ A deadlock of the runtime system could occur when + unregistering the name of a port.

+

+ Own Id: OTP-8145

+ + +

+ Makefile.in has been updated to use the LDFLAGS + environment variable (if set). (Thanks to Davide + Pesavento.)

+

+ Own Id: OTP-8157

+ + +

+ The pthread rwlock implemention on Linux could cause + starvation of writers. We, therefore, now use our own + rwlock implementation on Linux.

+

+ Own Id: OTP-8158

+ + +

+ Open source Erlang builds are updated to work well on + Snow Leopard (MacOS X 10.6)

+

+ Own Id: OTP-8168

+ + +

+ A call to erlang:system_info(schedulers_online) + could end up in an infinite loop. This happened if the + amount of schedulers was larger than one, the amount of + schedulers online was one, and someone was blocking + multi-scheduling.

+

+ Own Id: OTP-8169

+ + +

+ An error in erlang:system_profile/2 could cause + timestamped messages to arrive out of order in the SMP + case. This has now been fixed.

+

+ Own Id: OTP-8171

+ + +

+ binary_to_atom/2 and + binary_to_existing_atom/2 would leak memory if the + binary contained unaligned data.

+

+ Own Id: OTP-8192

+ + +

+ The async thread pool in the runtime system without SMP + support used a memory allocator that was not thread safe + for async jobs.

+

+ Own Id: OTP-8194

+ + +
+ + +
Improvements and New Features + + +

+ Processor internal NUMA nodes are now supported in the + ERTS internal CPU topology representation. For more + information see the documentation of the +sct + command line argument in the erl(1) documentation, + and the documentation of + erlang:system_info(cpu_topology).

+

+ Own Id: OTP-8041

+ + +

+ Documentation for ets improved about concurrency.

+

+ Own Id: OTP-8050

+ + +

+ Emulator flags in an escript were earlier inherited to + emulators started from from the emulator running the + escript. For example when an escript invoked + os:cmd("erl"), the new emulator were given + erroneous emulator flags. This bug has now been fixed

+

+ Escript filenames may now contain dots.

+

+ Own Id: OTP-8060

+ + +

+ Made some BIFs non-recursive (relational operators,hash + and phash) to limit internal stack usage.

+

+ Own Id: OTP-8065

+ + +

+ Fixed Windows specific bug in erl_prim_loader. Now it + handles the root directory (e.g. c:/) better. This bug + affected the directory listing in the debugger.

+

+ Own Id: OTP-8080

+ + +

+ A TCP socket with option {packet,4} could crash + the emulator if it received a packet header with a very + large size value (>2Gb). The same bug caused + erlang:decode_packet/3 to return faulty values. + (Thanks to Georgos Seganos.)

+

+ Own Id: OTP-8102

+ + +

+ The maximum size of the export table has been raised from + 65536 to 524288 entries.

+

+ Own Id: OTP-8104 Aux Id: seq11345

+ + +

+ The file module has now a read_line/1 function similar to + the io:get_line/2, but with byte oriented semantics. The + function file:read_line/1 works for raw files as well, + but for good performance it is recommended to use it + together with the 'read_ahead' option for raw file + access.

+

+ Own Id: OTP-8108

+ + +

+ Fixed bug causing emulator crash when reading a term in + external format containing a corrupt list with a negative + length.

+

+ Own Id: OTP-8117

+ + +

+ New emulator flag +sss, to set stack size of + scheduler threads.

+

+ Own Id: OTP-8119

+ + +

+ The Windows utility Erlsrv, run in interactive mode now + accepts options for registering internal service name and + description field of Windows registry database.

+

+ Own Id: OTP-8132

+ + +

+ erlang:demonitor(Mon, [flush]) has been optimized. + Previously it always searched the message queue of the + caller for a 'DOWN' message. Current + implementation only search the message queue when + necessary. It is quite common that the search is not + necessary.

+

+ A new option info has been added to + erlang:demonitor/2. For more information see the + erlang(3) documentation.

+

+ Own Id: OTP-8143

+ + +

+ I/O tasks could unnecessarily be rescheduled. This was + harmless, but not useful work.

+

+ Own Id: OTP-8148

+ + +

+ Minor improvements of erlang:memory/[1,2].

+

+ Own Id: OTP-8152

+ + +

+ New configuration option to enable use of shared zlib.

+

+ Own Id: OTP-8155

+ + +

+ Fixed smp bug in ETS that could cause emulator crash when + table with more than 1000 objects accessed by several + processes, including calls to variants of select + or match combined with concurrent object deletion.

+

+ Own Id: OTP-8166 Aux Id: seq11392

+ + +

+ The code path interpretation is now more relaxed. The + flag -code_path_choice now defaults to relaxed instead of + strict. See the documentation of code and init for more + info.

+

+ Own Id: OTP-8170

+ + +

+ Load balancing of run queues and check for I/O are + triggered more often than before in situations where + processes are scheduled often but are doing very little + work each time they execute.

+

+ Own Id: OTP-8172

+ + +

+ Call tracing binary comprehensions would cause an + emulator crash. (Thanks to Paul Mineiro.)

+

+ Own Id: OTP-8179

+ + +

+ binary_to_term/1 would crash the emulator instead + of generating a badarg exception when given + certain invalid terms. (Thanks to Scott Lystig Fritchie.)

+

+ Own Id: OTP-8180

+ + +
+ +
+ +
Erts 5.7.2 + +
Fixed Bugs and Malfunctions + + +

+ Crash dumps should now cause less problems for the + crashdump_viewer application. (For processes where arity + was non-zero, the arguments are now longer printed - they + used to be printed in a format that was not parseable.)

+

+ Own Id: OTP-7472 Aux Id: seq11019, 11292

+ + +

+ Processes could potentially get stuck on an offline + scheduler.

+

+ Own Id: OTP-7990

+ + +

+ binary_to_atom/2 and + binary_to_existing_atom/2 could leak memory if + they caused a badarg exception.

+

+ Own Id: OTP-7997

+ + +

+ A process could under very rare circumstances erroneously + be resumed.

+

+ Own Id: OTP-8000

+ + +

+ Load balancing between schedulers could under rare + circumstances cause an emulator crash.

+

+ Own Id: OTP-8008

+ + +

+ erlang:memory(processes_used) always returned + 0 instead of the correct value. (Thanks to Geoff + Cant)

+

+ Own Id: OTP-8022

+ + +
+ + +
Improvements and New Features + + +

+ Major improvements of the Erlang distribution for Erlang + runtime systems with SMP support. Previously distribution + port locks were heavily contended, and all encoding and + decoding for a specific distribution channel had to be + done in sequence. Lock contention due to the distribution + is now negligible and both encoding and decoding of + Erlang messages can be done in parallel.

+

+ The old atom cache protocol used by the Erlang + distribution has been dropped since it effectively + prevented all parallel encoding and decoding of messages + passed over the same distribution channel.

+

+ A new atom cache protocol has been introduced which + isolates atom cache accesses and makes parallel encoding + and decoding of messages passed over the same + distribution channel possible. The new atom cache + protocol also use an atom cache size 8 times larger than + before. The new atom cache protocol is documented in the + ERTS users guide.

+

+ Erlang messages received via the distribution are now + decoded by the receiving Erlang processes without holding + any distribution channel specific locks. Erlang messages + and signals sent over the distribution are as before + encoded by the sending Erlang process, but now without + holding any distribution channel specific locks during + the encoding. That is, both encoding and decoding can be + and are done in parallel regardless of distribution + channel used.

+

+ The part that cannot be parallelized is the atom cache + updates. Atom cache updates are therefore now scheduled + on the distribution port. Since it is only one entity per + distribution channel doing this work there is no lock + contention due to the atom cache updates.

+

+ The new runtime system does not understand the old atom + cache protocol. New and old runtime systems can however + still communicate, but no atom cache will be used.

+

+ Own Id: OTP-7774

+ + +

+ Fixed a bug that caused error logging from + driver_select sometimes with additional symptoms + such as failing IP communications or even an emulator + crash.

+

+ Own Id: OTP-7898 Aux Id: seq11304

+ + +

+ Improved SMP concurrency for ETS tables. Several mutating + operations can now be performed truly concurrent on + different records of the same table. To support this, the + table has to be created with option + write_concurrency, as it is achieved at the + expense of some execution and memory overhead. + ets:select and select_count has also been + improved for all tables to not acquire exclusive table + lock during the iteration.

+

+ Own Id: OTP-7922

+ + +

+ erl (that is erl.exe and dyn_erl) and erlexec has been + made more dynamic so no hard coded paths needs to added + at installation time to erl (that is erl.ini and erl). + Reltool will make use of this in a future release.

+

+ Own Id: OTP-7952

+ + +

+ Added functionality to get higher resolution timestamp + from system. The erlang:now function returns a timestamp + that's not always consistent with the actual operating + system time (due to resilience against large time changes + in the operating system). The function os:timestamp/0 is + added to get a similar timestamp as the one being + returned by erlang:now, but untouched by Erlangs time + correcting and smoothing algorithms. The timestamp + returned by os:timestamp is always consistent with the + operating systems view of time, like the calendar + functions for getting wall clock time, but with higher + resolution. Example of usage can be found in the os + manual page.

+

+ Own Id: OTP-7971

+ + +

+ Two new options are added to open_port - spawn_executable + which runs external executables in a controlled way, and + spawn_driver which only opens port to loaded Erlang + drivers. See the erlang manual page for details.

+

+ Own Id: OTP-7995

+ + +

+ New functionality in ETS to transfer the ownership of a + table. A table can either change owner be declaring an + "heir", another process that will inherit the table if + the owner terminates. A table can also change owner by + calling a new function ets:give_away.

+

+ Own Id: OTP-8006

+ + +

+ Updates to Tilera build environment.

+

+ Own Id: OTP-8009

+ + +

+ A stack trace was unnecessarily saved during process + termination.

+

+ Own Id: OTP-8014

+ + +

+ User defined CPU topology and scheduler bind type can now + be set from the command line when starting an emulator. + For more information see the documentation of the + +sct, and the +sbt emulator flags in the + erl(1) documentation.

+

+ The CPU topologies returned from + erlang:system_info/1 and + erlang:system_flag/2 now always contain the + processor level, also when not strictly necessary.

+

+ Own Id: OTP-8030

+ + +

+ Various fixes in ETS: ets:first could return a + deleted key in a fixated table. ets:lookup could + return objects out of order if a deleted object was + re-inserted into a fixed bag. ets:delete_object + could fail to delete duplicate objects in a + duplicate_bag.

+

+ Own Id: OTP-8040

+ + +
+ +
+ +
Erts 5.7.1 + +
Fixed Bugs and Malfunctions + + +

+ Fixed a bug on Windows that could make + gen_tcp:send hang trying to send an iolist of more + than 16 binaries.

+

+ Own Id: OTP-7816

+ + +

+ The runtime system could under rare circumstances crash + during load balancing.

+

+ Own Id: OTP-7908 Aux Id: otp-7500

+ + +

+ run_erl uses fallback if Unix98 pseudo-terminal is + not present on host.

+

+ Own Id: OTP-7916 Aux Id: seq11249

+ + +

+ A message buffer memory leak in the runtime system + without smp support has been fixed.

+

+ Own Id: OTP-7941

+ + +

Attempting to append a binary of 16Mb or greater to + another binary using the bit syntax would cause a + system_limit exception. There was also several + cases when constructing binaries when a badarg + exception was generated when it should have been + system_limit.

+

+ Own Id: OTP-7942

+ + +

+ The runtime system with SMP support failed to terminate + the caller of link(RemotePid) properly, if + RemotePid was the pid of a process on an + unreachable node. The calling process was in this case + marked as exiting, but never terminated.

+

+ Own Id: OTP-7946

+ + +
+ + +
Improvements and New Features + + +

+ Rudimentary support for cross compiling is added to the + source release. The support is still in its infancy and + has only been used to cross compile on Linux for a + different cpu architecture and a different Linux version, + but should be extendible to support other platforms as + well. The cross configuration files with examples are + placed in $ERL_TOP/xcomp/. View README.xcomp and run + $ERL_TOP/otp_build -help for further information.

+

+ Own Id: OTP-7854

+ + +

The escape sequence \{ which was given a new + interpretation in R13A has retained its old meaning (the + ASCII code for {), which means that codes greater + than 255 have to be stated using hexadecimal characters + (for example, \x{AAA}). The escape sequence + \xH where H is a hexadecimal character followed by + something else but a hexadecimal character is no longer + valid (incompatibility with R13A). Character codes less + than 256 can be stated using two hexadecimal characters + (for example, \x0D).

+

+ Own Id: OTP-7891 Aux Id: OTP-7855

+ + +

The term_to_binary/1 BIF used to be implemented + with recursive C code, which could cause the Erlang + emulator to terminate because of a stack overflow.

+

Also fixed some minor issues in + term_to_binary/1 and binary_to_term/1 + pointed out by Matthew Dempsky.

+

+ Own Id: OTP-7894

+ + +

+ Several glitches and performance issues in the Unicode + and I/O-system implementation of R13A have been + corrected.

+

+ Own Id: OTP-7896 Aux Id: OTP-7648 OTP-7887

+ + +

+ Minor documentation improvements of the + scheduler_bind_type argument of + erlang:system_flag/2, and the + scheduler_bind_type, and the + scheduler_bindings arguments of + erlang:system_info/1.

+

+ Own Id: OTP-7901 Aux Id: OTP-7777

+ + +

+ There is a new BIF erlang:make_tuple/3.

+

+ Own Id: OTP-7913

+ + +
+ +
+ + +
Erts 5.7 + +
Fixed Bugs and Malfunctions + + +

OpenSource:

+

FreeBSD leap-seconds are handled according to patch + submitted by OpenSource user Kenji Rikitake. No test case + covers this functionality (unsupported platform).

+

+ Own Id: OTP-7609

+ + +

+ A corrected bug in ets for bag and + duplicate_bag. A delete/2 or + lookup_element/3 could miss objects in a fixed + table if one or more objects with the same key had + already been deleted.

+

+ Own Id: OTP-7665

+ + +

+ A new driver call-back stop_select is introduced + to allow drivers to de-select and then close a file + descriptor in a safe way in a SMP emulator. The old way + was not strictly according to posix standard and could in + some rare cases lead to unexpected behavior. A new flag + ERL_DRV_USE can be passed to + driver_select() to tell it that the descriptor + should be closed. stop_select is then called when + it is safe to do so. Old drivers will however still work + as before.

+

+ Own Id: OTP-7670

+ + +

+ A bug fixed for TCP sockets with option + {packet,http}. An HTTP request with an absolute + URI was returned with a corrupt path string. This bug did + only exist in R12B-4 and R12B-5.

+

+ Own Id: OTP-7682 Aux Id: OTP-7647

+ + +

+ run_erl did in some cases fail to extract control + sequences from to_erl (like: winsize=X,Y) and did instead + send them to be interpreted by the erlang shell.

+

+ Own Id: OTP-7688

+ + +

+ A bug in the installer on Windows not updating file + associations properly is now corrected.

+

+ Own Id: OTP-7746

+ + +

More space than necessary could be allocated in + binaries when appending to a binary (also in a binary + comprehension) and the data appended did not consist of + wholes bytes (e.g. 13 bits).

+

+ Own Id: OTP-7747

+ + +

+ The gen_sctp option sctp_peer_addr_params, + #sctp_paddrparams{address={IP,Port} was erroneously + decoded in the inet driver. This bug has now been + corrected.

+

+ Own Id: OTP-7755

+ + +

+ Outstanding async driver jobs leaked memory if the + issuing port died before the async jobs completed.

+

+ Own Id: OTP-7784

+ + +

A bug in the dynamic library loading affecting, among + others, OpenSolaris is now corrected. (Thanks to Paul + Fisher.)

+

+ Own Id: OTP-7796

+ + +

+ run_erl compile errors fixed for FreeBSD

+

+ Own Id: OTP-7817

+ + +

+ A bug in the inet driver for SCTP on Solaris showing for + e.g gen_sctp:abort/1 and gen_sctp:eof/1 has been + corrected. Patch suggestion by Simon Cornish.

+

+ Own Id: OTP-7866

+ + +
+ + +
Improvements and New Features + + +

+ The order of objects visited in select for ordered_set is + now documented.

+

+ Own Id: OTP-7339

+ + +

+ The runtime system with SMP support now uses multiple, + scheduler specific run queues, instead of one globally + shared run queue.

+

+ The lock protecting the shared run queue was heavily + contended, and the shared run queue also caused Erlang + processes to randomly migrate between schedulers with + negative cache effects as a result.

+

+ With the current scheduler specific run queue solution, + lock contention due to run queue protection has been + reduced, and Erlang processes are only migrated when + needed to balance the load between the schedulers. The + reduced amount of migration also reduce lock contention + on locks protecting the scheduler specific instances of + the erts internal memory allocators.

+

+ The scheduler specific run queues are also a necessity + for a lot of future planned NUMA (Non-Uniform Memory + Access) specific optimizations.

+

+ Own Id: OTP-7500

+ + +

Support for Unicode is implemented as described in + EEP10. Formatting and reading of unicode data both from + terminals and files is supported by the io and io_lib + modules. Files can be opened in modes with automatic + translation to and from different unicode formats. The + module 'unicode' contains functions for conversion + between external and internal unicode formats and the re + module has support for unicode data. There is also + language syntax for specifying string and character data + beyond the ISO-latin-1 range.

+

The interactive shell will support input and output of + unicode characters when the terminal and operating system + supports it.

+

Please see the EEP and the io/io_lib manual pages as + well as the stdlib users guide for details.

+

I/O-protocol incompatibilities:

+

The io_protocol between io_Server and client is + updated to handle protocol data in unicode formats. The + updated protocol is now documented. The specification + resides in the stdlib users manual, which is a + new part of the manual.

+

io module incompatibilities:

+

The io:put_chars, io:get_chars and io:get_line all + handle and return unicode data. In the case where + binaries can be provided (as to io:put_chars), they shall + be encoded in UTF-8. When binaries are returned (as by + io:get_line/get_chars when the io_server is set in + binary mode) the returned data is also + always encoded as UTF-8. The file module however + still returns byte-oriented data, why file:read can be + used instead of io:get_chars to read binary data in + ISO-latin-1.

+

io_lib module incompatibilities:

+

io_lib:format can, given new format directives (i.e + "~ts" and "~tc"), return lists containing integers larger + than 255.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7648 Aux Id: OTP-7580 OTP-7514 OTP-7494 + OTP-7443 OTP-7181 EEP10 EEP11

+ + +

+ The format of the string returned by + erlang:system_info(system_version) (as well as the + first message when Erlang is started) has changed. The + string now contains the both the OTP version number as + well as the erts version number.

+

+ Own Id: OTP-7649

+ + +

+ Message passing has been further optimized for parallel + execution. Serial message passing is slightly more + expensive than before, but parallel send to a common + receiver is much cheaper.

+

+ Own Id: OTP-7659

+ + +

+ Lock contention on the atom table lock when decoding + Erlang terms on the external format has been drastically + reduced.

+

+ Own Id: OTP-7660

+ + +

+ The undocumented, unsupported, and deprecated guard BIF + is_constant/1 has been removed.

+

+ *** INCOMPATIBILITY with R12B ***

+

+ Own Id: OTP-7673

+ + +

+ The Erlang process lock implementation has been improved + by Mat Hostetter at Tilera Corporation.

+

+ Own Id: OTP-7692

+ + +

+ A {nodedown, Node} message passed by the + net_kernel:monitor_nodes/X functionality is now + guaranteed to be sent after Node has been removed + from the result returned by erlang:nodes/Y.

+

+ Own Id: OTP-7725

+ + +

The short-circuit operators andalso and + orelse no longer guarantees that their second + argument is either true or false. As a + consequence, andalso/orelse are now + tail-recursive.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7748

+ + +

+ A new BIF, lists:keyfind/3, has been added. It + works like lists:keysearch/3 except that it does + not wrap the returned tuple in a value tuple in + case of success. (Thanks to James Hague for suggesting + this function.)

+

+ Own Id: OTP-7752

+ + +

+ Optimization for drivers by creating small binaries + direct on process heap.

+

+ Own Id: OTP-7762

+ + +

I bsl N could cause the Erlang virtual machine + to run of memory instead generating a system_limit + if N was absurdly huge. (Thanks to Daniel Hedlund.)

+

There would always be a garbage collection when + evaluating I bsl N or I bsr N if I + was a bignum.

+

If I is an integer and N a bignum, I + bsl N will now cause the correct system_limit + exception instead of bad_arith as in earlier + releases.

+

If I is an integer and N a bignum, I + bsr N will return either 0 or -1 depending on the + sign of I instead of causing a bad_arith + exception as in earlier releases.

+

+ Own Id: OTP-7764

+ + +

+ Scheduler threads can now be bound to logical processors + on newer Linux and Solaris systems. More systems will be + supported in the future.

+

+ In some cases performance has increased drastically when + binding schedulers. Schedulers are not bound by default, + though. This since it might cause a performance + degradation if multiple programs have bound to + processors, e.g. multiple Erlang runtime systems. For + more information see the documentation of + erlang:system_flag/2.

+

+ In order to bind scheduler threads the CPU topology need + to be known. On some newer Linux and Solaris systems the + runtime system automatically detects the CPU topology. If + the emulator isn't able to automatically detect the CPU + topology, the CPU topology can be defined. For more + information see the documentation of + erlang:system_flag/2.

+

+ Own Id: OTP-7777

+ + +

The compiler will refuse to a compile file where the + module name in the file differs from the output file + name.

+

When compiling using erlc, the current working + directory will no be included in the code path (unless + explicitly added using "-pa .").

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7793

+ + +

+ The BIFs atom_to_binary/2, + binary_to_atom/2, and + binary_to_existing_atom/2 have been added.

+

+ Own Id: OTP-7804

+ + +

+ The amount of schedulers online can now be changed during + operation. The amount of schedulers online defaults to + the same amount as available logical processors. For more + information see the documentation of + erlang:system_flag/2 and erl.

+

+ Own Id: OTP-7811

+ + +

The deprecated functions erlang:fault/1, + erlang:fault/2, and file:rawopen/2 have + been removed.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7812

+ + +

+ Erts internal dynamically allocated process and port + specific data for rarely used data. This is used to + reduce memory usage of processes and ports that do not + use specific functionality. More functionality will be + moved to process and port specific data in future + releases.

+

+ Own Id: OTP-7818

+ + +

+ New packet type http_bin for gen_tcp sockets and + erlang:decode_packet. It works like http + except that strings are returned as binaries instead of + lists.

+

+ Own Id: OTP-7821

+ + +

+ The obsolete wd_keeper program for embedded Solaris + systems has been removed.

+

+ Own Id: OTP-7822

+ + +

+ Nodes belonging to different independent clusters can now + co-exist on the same host with the help of a new + environment variable setting ERL_EPMD_PORT.

+

+ Own Id: OTP-7826

+ + +

There are new functions erlang:min/2 and + erlang:max/2 to calculate the minimum and maximum + of two terms, respectively. Note that the functions are + not auto-imported, so they need to be imported explicitly + or the erlang prefix must be used when calling + them.

+

+ Own Id: OTP-7841

+ + +

The copyright notices have been updated.

+

+ Own Id: OTP-7851

+ + +

Enhanced build environment for cross compilation to + Tilera Tile architecture.

+

Support for native ethread atomics on Tilera + Tile64/TilePro (Thanks to Tilera Corporation).

+

+ Own Id: OTP-7852

+ + +

The escape sequences \x and \{ have been + assigned new interpretations (they used to return the + ASCII code for x and { respectively). One + or more octal characters inside curly brackets after a + leading backslash is from now on an alternative to the + existing syntax \NNN, but can also be used for + codes greater than 255. In a similar fashion, one or more + hexadecimal characters can be put inside curly brackets + after a leading \x. Furthermore, the escape + sequences \xH and \xHH, where N is a + hexadecimal character, can be used for codes less than + 256.

+

NOTE: These new escape sequences are still considered + experimental and may be changed in the R13B release.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7855

+ + +

+ The PCRE library's exported function names are now + prefixed with erts_ in the erlang emulator to avoid + clashes with dynamically loaded drivers.

+

+ Own Id: OTP-7861

+ + +

+ A runtime system with SMP support will now be built by + default on most platforms if a usable posix thread + library or native windows threads are found.

+

+ For more information see the top README file.

+

+ Own Id: OTP-7872

+ + +
+ +
+ + +
Erts 5.6.5.1 + +
Fixed Bugs and Malfunctions + + +

+ A corrected bug in ets for bag and + duplicate_bag. A delete/2 or + lookup_element/3 could miss objects in a fixed + table if one or more objects with the same key had + already been deleted.

+

+ Own Id: OTP-7665

+ + +

+ A bug fixed for TCP sockets with option + {packet,http}. An HTTP request with an absolute + URI was returned with a corrupt path string. This bug did + only exist in R12B-4 and R12B-5.

+

+ Own Id: OTP-7682 Aux Id: OTP-7647

+ + +

+ Calling gen_tcp:send() from several processes on + socket with option send_timeout could lead to much + longer timeout than specified. The solution is a new + socket option {send_timeout_close,true} that will + do automatic close on timeout. Subsequent calls to send + will then immediately fail due to the closed connection.

+

+ Own Id: OTP-7731 Aux Id: seq11161

+ + +

+ A process being garbage collected via the + garbage_collect/1 BIF or the + check_process_code/2 BIF didn't handle message + receive and resume correctly during the garbage collect. + When this occurred, the process returned to the state it + had before the garbage collect instead of entering the + new state.

+

+ Own Id: OTP-7738

+ + +
+ +
+ +
Erts 5.6.5 + +
Fixed Bugs and Malfunctions + + +

+ A bug in inet_drv concerning gen_tcp:connect has been + corrected. A connect towards a non-open port through open + firewalls could sometimes erroneously be successful. Any + subsequent operation would fail, though.

+

+ Own Id: OTP-6542

+ + +

+ Floating point arithmetics in drivers could cause a + runtime system crash and/or unexpected results on runtime + systems with floating point exceptions enabled. Floating + point exceptions are disabled unless explicitly enabled + or if hipe is enabled.

+

+ Own Id: OTP-7237

+ + +

+ A bug when many sockets got signalled simultaneously + causing the emulator to panic with the message + "Inconsistent, why isnt io reported?" is now corrected.

+

+ Own Id: OTP-7420

+ + +

+ Starting erl with option "-detached" now disconnects + correctly from terminal session on Unix.

+

+ Own Id: OTP-7461

+ + +

+ Mended gdb etp-commands for ETS access.

+

+ Own Id: OTP-7538

+ + +

+ erlang:decode_packet/3 allows white space between + HTTP header tag and colon according to RFC2616.

+

+ Own Id: OTP-7543

+ + +

+ An emulator compiled for SCTP now starts even if the + dynamic libraries are not present. The SCTP driver is + then of course not loaded.

+

+ Own Id: OTP-7551

+ + +

To build on Mac OS X, 10.3.0 or later is now required + because of fixes for two problems:

+

There would be a resource leak when erl_ddl + attempted to unload a driver. This problem has been + corrected by using dlopen() (which works on all + modern Unix-like platforms) instead of the Mac OS X + specific API calls.

+

Signal handling in the run-time system for HiPE has + been updated to work on later versions of Mac OS X than + 10.2.x. Therefore, --enable-hipe now works on Mac + OS X with Intel CPUs.

+

Thanks to Geoff Cant for the patches.

+

+ Own Id: OTP-7562

+ + +

Corrected some information about the protocol between + EPMD and Erlang nodes. (Thanks to Michael Regen.)

+

+ Own Id: OTP-7594

+ + +

+ When using + erlang:system_monitor(Pid,{long_gc,Time}), and the + GC time exceeded 1 second, it sometimes erroneously + showed up as about 4300 seconds. (This bug was corrected + in R9C, but re-introduced in R12B.) (Thanks to Chris + Newcombe.)

+

+ Own Id: OTP-7622 Aux Id: OTP-4903, seq8379

+ + +
+ + +
Improvements and New Features + + +

+ The driver entry of a dynamically loaded driver is now + copied when loaded which enables some internal + optimizations. Note that drivers that modify the driver + entry during execution will not work anymore. Such a + miss-use of the driver interface is however not + supported.

+

+ Own Id: OTP-6900

+ + +

+ The split function is now added to the re library. + Exceptions and errors from both run, replace and split + are made more consistent.

+

+ Own Id: OTP-7514 Aux Id: OTP-7494

+ + +

+ Fixed harmless compiler warnings when building the + emulator and minor build changes in order to avoid + unnecessary rebuilds.

+

+ Own Id: OTP-7530

+ + +

+ There is now experimental support for loading of code + from archive files. See the documentation of code, + init, erl_prim_loader and escript + for more info.

+

+ The error handling of escripts has been improved.

+

+ An escript may now set explicit arguments to the + emulator, such as -smp enabled.

+

+ An escript may now contain a precompiled beam + file.

+

+ An escript may now contain an archive file + containing one or more applications (experimental).

+

+ The internal module code_aux has been removed.

+

+ Own Id: OTP-7548 Aux Id: otp-6622

+ + +

+ The reallocation functionality part of the ERTS internal + memory allocators, now consider current block in + combination with surrounding free blocks as an + alternative location for a reallocation.

+

+ Own Id: OTP-7555

+ + +

There could remain false references from a process to + a module that has been called earlier, so that the + process would be killed if the module was reloaded. + (Thanks to Richard Carlsson.)

+

Also, the fix for this bug also made it possible to + make stack backtraces (as returned from + erlang:get_stacktrace/0 and other functions) more + correct in that the immediate caller is always included + in the stack backtrace (it could sometimes be + missing).

+

+ Own Id: OTP-7559

+ + +

+ Improved locking in IO-handling for better smp + performance.

+

+ Own Id: OTP-7560

+ + +

+ Improved BIF rescheduling functionality.

+

+ Own Id: OTP-7587

+ + +

+ Loading a module compiled with Erlang/OTP R9C and calling + module_info/0 in the module would crash the + emulator. The emulator now refuses to load any module + compiled with R9C or earlier. (Note: only trivial modules + compiled with R10B or earlier could be loaded anyway.) + (Thanks to Martin Kjellin.)

+

+ Own Id: OTP-7590

+ + +
+ +
+ +
Erts 5.6.4.2 + +
Fixed Bugs and Malfunctions + + +

+ A process calling one of the following BIFs could under + very rare conditions deadlock in the runtime system with + SMP support: check_process_code/2, + garbage_collect/1, process_info/[1,2], + system_flag/2, and + erlang:suspend_process/[1,2].

+

+ Own Id: OTP-7582

+ + +

+ A couple of statistics variables were not managed in a + thread safe manner in the runtime system with SMP + support.

+

+ Own Id: OTP-7583

+ + +

+ An extremely rare race condition when terminating a + process could potentially cause a runtime system crash.

+

+ Own Id: OTP-7584

+ + +

+ Under certain conditions and when using run_erl/to_erl, + the terminal Erlang driver (ttsl_drv) could crash the + emulator by doing a division by zero due to incorrect + handling of terminals reporting a zero width. For + terminals reporting zero width, the driver now fallbacks + to a default width of 80 and a default height of 24 + (vt100), as a fallback behaviour. This fixes the crashes + and also makes output on "dumb" terminals much more + readable.

+

+ Own Id: OTP-7592 Aux Id: seq11073

+ + +
+ +
+ +
Erts 5.6.4.1 + +
Improvements and New Features + + +

+ A new erts_alloc parameter + +M<S>rmbcmt (relative multiblock carrier + move threshold) has been added. It determines when to + force a moving realloc in a multiblock carrier when a + block is shrunk. For more information see the + erts_alloc(3) documentation.

+

+ Own Id: OTP-7540

+ + +

The new option +d can be given to erl to + suppress the crash dump generation if an internal error + is detected. As a result, a more useful core dump is + produced.

+

+ Own Id: OTP-7578 Aux Id: seq11052

+ + +
+ +
+ +
Erts 5.6.4 + +
Fixed Bugs and Malfunctions + + +

+ Double backslashes in format string passed to the erts + internal printf implementation produced erroneous + results. No such format strings were passed to the erts + internal printf implementation, i.e., the bug was + therefore completely harmless. (Thanks to Perry Smith.)

+

+ Own Id: OTP-7408

+ + +

+ Large files are now handled on Windows, where the + filesystem supports it.

+

+ Own Id: OTP-7410

+ + +

+ Bug fixed for {packet,http} when space follows + http headers.

+

+ Own Id: OTP-7458

+ + +

+ The trace option running could cause an emulator + crash if the current function couldn't be determined.

+

+ Own Id: OTP-7484

+ + +

+ Using 16#ffffFFFF as a timeout value in receive...after + would often cause a timeout almost at once due to an + 32-bit integer overflow. (Thanks to Serge Aleynikov and + Matthias Lang.)

+

+ Own Id: OTP-7493

+ + +

+ For the process that an escript runs in, the + trap_exit process flag is now false instead + of true (as in previous releases). Scripts that + depend on the previous (counter-intuitive) behaviour + might not work. (Thanks to Bengt Kleberg.)

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7517

+ + +

+ A bug in the string:to_integer/1 builtin made the + emulator unstable. This is now corrected. (Thanks to Lev + Walkin.)

+

+ Own Id: OTP-7526

+ + +
+ + +
Improvements and New Features + + +

Performance for ETS intensive applications should now + be better in the SMP emulator. Also, ETS table + identifiers (as returned by ets:new/2) are now + spread out in wider range than before (using 28 bits in a + 32-bit emulator) to make sure that the table identifier + for a deleted table will not be quickly re-used.

+

NOTE: Table identifiers can now be negative integers. + Programs that (incorrectly) assume that table identifiers + can only be positive integers might stop to work. (The + type of a table identifier is intentionally not + documented, and may change in a future release.)

+

+ Own Id: OTP-7348

+ + +

+ New BIF erlang:decode_packet/3 that extracts a + protocol packet from a binary. Similar to the socket + option {packet, Type}. Also documented the socket + packet type http and made it official. + NOTE: The tuple format for http packets + sent from an active socket has been changed in an + incompatible way.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7404

+ + +

+ The source code for the documentation for some + applications (erts, kernel, stdlib, and several others) + are now included in the source tar ball. There is + currently no Makefile support for building HTML files + from the source (such support will be included in a + future release).

+

+ Own Id: OTP-7406

+ + +

+ A lot of frequently accessed memory counters (erts + internal) have been removed. This since they hurt + performance on the runtime system with SMP support. As a + result erlang:memory/[0,1] will only deliver a + result if all erts_alloc(3) allocators are enabled + (default). The result delivered when all + erts_alloc(3) allocators are enabled are both more + accurate and less accurate than before. More memory than + before are included in the result, but the different + parts that are summed are not gathered atomically. A call + to erlang:memory/[0,1] is much cheaper for the + system than before. This since the information isn't + gathered atomically anymore which was very expensive.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7468

+ + +

+ Pre-allocators used for, for example, timers, and + messages have been rewritten to be scheduler specific. + That is, different schedulers will now allocate from + different pools which reduces lock contention.

+

+ Own Id: OTP-7470

+ + +

+ On Mac OS X, file:sync/1 now guarantees that all + filesystem buffers are written to the disk by using the + fcntl() with F_FULLFSYNC option. Previously, file:sync/1 + called fsync(), which only guaranteed that the data had + been transferred to the disk drive. (Thanks to Jan + Lehnardt.)

+

+ Own Id: OTP-7471

+ + +

+ Termination of a process that takes a long time can now + be preempted, i.e., the terminating process will be + rescheduled for later continuation of termination so that + other processes can execute. Termination of a process + that owns many and/or large ets tables typically takes a + long time.

+

+ Own Id: OTP-7477

+ + +

+ A new trace option exiting has been added. The + exiting trace is similar to the running + trace, but for exiting processes. For more information + see the erlang(3) documentation.

+

+ The erlang:trace/3 bif now doesn't block other + scheduler threads if only one tracee is specified in the + call to erlang:trace/3.

+

+ Own Id: OTP-7481

+ + +

+ The re module is extended with repetitive matches (global + option) and replacement function.

+

+ Own Id: OTP-7494 Aux Id: OTP-7181

+ + +

+ In the section about binary construction, the reference + manual now mentions what happens when an integer value + does not fit into an integer segment of size N (namely, + that the N least significant bits will be put into into + the binary and that the most significant bits will be + silently discarded). (Thanks to Edwin Fine.)

+

+ Own Id: OTP-7506

+ + +

+ Setting the {active,once} for a socket (using + inets:setopts/2) is now specially optimized (because the + {active,once} option is typically used much more + frequently than other options).

+

+ Own Id: OTP-7520

+ + +
+ + +
Known Bugs and Problems + + +

+ Floating point arithmetics in drivers can cause a runtime + system crash and/or unexpected results on runtime systems + with floating point exceptions enabled. Floating point + exceptions are disabled unless explicitly enabled or if + hipe is enabled.

+

+ Own Id: OTP-7237

+ + +
+ +
+ +
Erts 5.6.3.3 + +
Fixed Bugs and Malfunctions + + +

+ Binary construction with an integer field of size 0 at + the end of the constructed binary (and the size given in + a variable), would cause a write of one byte outside the + memory reserved for the binary, which in turn could cause + an emulator crash.

+

+ Own Id: OTP-7422

+ + +

+ A race condition in the dynamic driver implementation + could cause an emulator crash. (Thanks to Paul Fisher)

+

+ Own Id: OTP-7464

+ + +

+ Calls to erlang:system_info(allocated_areas) could + cause the runtime system with SMP support to crash.

+

+ Own Id: OTP-7474

+ + +

+ The env option to open_port() could cause + the runtime system with SMP support to crash.

+

+ Own Id: OTP-7475

+ + +
+ + +
Improvements and New Features + + +

+ Operations that needed to block other threads in the + runtime system with SMP support unnecessarily waited for + async threads to block. Most important the + erlang:memory/[0,1] bif, code loading, and the + erlang:trace/3 bif.

+

+ Own Id: OTP-7480

+ + +
+ +
+ +
Erts 5.6.3.2 + +
Fixed Bugs and Malfunctions + + +

+ Calls to erlang:memory/[0,1] could cause the + runtime system with SMP support to crash.

+

+ Own Id: OTP-7415

+ + +
+ +
+ +
Erts 5.6.3.1 + +
Fixed Bugs and Malfunctions + + +

+ Doing local call trace on bit syntax matching code that + has been optimized with delayed sub-binary creation could + crash the emulator.

+

+ Own Id: OTP-7399 Aux Id: seq10978

+ + +
+ +
+ +
Erts 5.6.3 + +
Fixed Bugs and Malfunctions + + +

+ Only one to_erl process at a time is allowed to connect + to the same run_erl pipe. Prevents buggy behaviour when + IO from several to_erl's get interleaved.

+

+ Own Id: OTP-5107

+ + +

+ IPv6 name resolving has now been fixed to use + getaddrinfo() patch (thoroughly reworked) courtesy of Love + Hörnquist-Åstrand submitted by Fredrik Thulin. It also + can use gethostname2() patch (also reworked) courtesy of + Mikael Magnusson for debian submitted by Sergei Golovan.

+

+ Own Id: OTP-5382

+ + +

+ Improved error handling in run_erl

+

+ Own Id: OTP-7252

+ + +

A permanent fix for the deadlock issue temporarily + fixed by OTP-7260.

OTP-7260 + The runtime system with SMP support could under rare + circumstances deadlock when a distribution channel was + taken down while multiple simultaneous operations were + performed on it. +

+ Own Id: OTP-7267 Aux Id: OTP-7260

+ + +

+ ./configure has been improved to find 64-bit OpenSSL + libraries.

+

+ Own Id: OTP-7270

+ + +

+ A terminating process could under very rare circumstances + trigger a bug which could crash the runtime system with + SMP support.

+

+ Own Id: OTP-7272

+ + +

+ SCTP_ADDR_CONFIRMED events are now handled by gen_sctp.

+

+ Own Id: OTP-7276

+ + +

+ binary_to_term/1 would crash the emulator if the binary + data contained an external fun with non-atom module + and/or function. Corrected to generate a badarg + exception.

+

+ Own Id: OTP-7281

+ + +

+ On Mac OS 10.5 (Leopard), sending to socket which the + other end closes could cause the emulator to consume 100% + CPU time. (Thanks to Matthias Radestock.)

+

+ Own Id: OTP-7289

+ + +

+ The vanilla driver used on Windows could crash the + emulator and sometimes produced corrupt files. The + vanilla driver is the driver that is used when one only + pass a filename as first argument to open_port/2. + NOTE: This use of open_port/2 is + obsolete, and the documentation of this use has + previously been removed. The functionality is only + present for backward compatibility reasons and + will eventually be removed.

+

+ Own Id: OTP-7301

+ + +

+ Faulty matching in binaries larger than 512Mb on 64bit + machines fixed.(On 32bit, the size limit for binaries is + still 512Mb). Thanks to Edwin Fine and Per Gustafsson for + finding fault and fix.

+

+ Own Id: OTP-7309

+ + +

+ crypto:start() on Windows caused emulator to hang on + error popup window if openssl DLL was not found. Windows + error popups now suppressed.

+

+ Own Id: OTP-7325

+ + +

+ Configuration option without-termcap can be used to + disable the use of termcap libraries for terminal cursor + control in the shell.

+

+ Own Id: OTP-7338

+ + +

+ to_erl reports its terminal window size to run_erl in + order to get output formatted accordingly

+

+ Own Id: OTP-7342

+ + +

+ On Solaris, the compressed option for file + operations did not work if the file descriptor happened + to be greater than 255 (a problem with fopen() and + friends in Solaris itself).

+

+ Own Id: OTP-7343 Aux Id: seq10949

+ + +

+ A race condition in the runtime system with SMP support + causing an erroneous removal of a newly created ets table + has been fixed.

+

+ The race occurred when a process removed a table during + termination simultaneously as another process removed the + same table via ets:delete/1 and a third process + created a table that accidentaly got the same internal + table index as the table being removed.

+

+ Own Id: OTP-7349

+ + +

+ zlib:inflate failed when the size of the inflated + data was an exact multiple of the internal buffer size + (4000 bytes by default).

+

+ Own Id: OTP-7359

+ + +

+ If the total number of allowed atoms is exceeded, there + will now be a controlled termination of the emulator with + a crash dump file. The emulator used to simply crash. + (Thanks Howard Yeh and Thomas Lindgren.)

+

+ Own Id: OTP-7372

+ + +

+ The break handler in werl on Windows could cause the + emulator to hang or crash, that is now corrected.

+

+ Own Id: OTP-7394 Aux Id: seq10969

+ + +

+ The configure script now tests for an serious + optimization bug in gcc-4.3.0. If the bug is present, the + configure script will abort (if this happens, the only + way to build Erlang/OTP is to change to another version + of gcc). (Thanks to Mikael Pettersson.)

+

+ Own Id: OTP-7397

+ + +
+ + +
Improvements and New Features + + +

+ On Unix, the emulator now notices when the width of the + terminal has changed. (Thanks to Matthew Dempsky and + Patrick Mahoney.)

+

+ Own Id: OTP-7290

+ + +

+ There is a new function init:stop/1 which can be + used to shutdown the system cleanly AND generate a + non-zero exit status or crash dump. (Thanks to Magnus + Froberg.)

+

+ Own Id: OTP-7308

+ + +

+ process_info(Pid, garbage_collection) now returns more + information

+

+ Own Id: OTP-7311

+ + +

+ The hide option for open_port/2 is now + documented. (Thanks to Richard Carlsson.)

+

+ Own Id: OTP-7358

+ + +
+ + +
Known Bugs and Problems + + +

+ Floating point arithmetics in drivers can cause a runtime + system crash on runtime systems with floating point + exceptions enabled. Floating point exceptions are + disabled unless explicitly enabled or if hipe is enabled.

+

+ Own Id: OTP-7237

+ + +
+ +
+ + +
Erts 5.6.2 + +
Fixed Bugs and Malfunctions + + +

+ The maximum length of an atom of 255 characters is now + strictly enforced. binary_to_term/1 will now fail + with a badarg if an encoded term contains an atom longer + than 255 characters. Atoms created by drivers will now be + truncated to 255 characters if necessary. (Thanks to + Matthew Dempsky.)

+

+ Own Id: OTP-7147

+ + +

+ A bug in "bignum handling" on some 64bit architectures + could cause rem and div operations on large numbers to + hang indefinitely. Rem operations involving the smallest + negative number representable in 28 bits or 60 bits could + also cause access violation and emulator crash. Both + errors are corrected.

+

+ Own Id: OTP-7177

+ + +

+ When doing the initial garbage collection after waking a + hibernated process, a fullsweep garbage collection was + unnecessarily triggered.

+

+ Own Id: OTP-7212

+ + +

The beta testing module gen_sctp now supports + active mode as stated in the documentation. Active mode + is still rather untested, and there are some issues about + what should be the right semantics for + gen_sctp:connect/5. In particular: should it be + blocking or non-blocking or choosable. There is a high + probability it will change semantics in a (near) future + patch.

Try it, give comments and send in bug + reports!

+

+ Own Id: OTP-7225

+ + +

+ Invalid arguments to ets:update_counter/3 were not + handled correctly. A tuple position (Pos) less + than 1 caused the element directly following the key to + be updated (as if no position at all had been specified). + All invalid values for Pos will now fail with + badarg.

+

+ Own Id: OTP-7226

+ + +

+ The runtime system with SMP support could under rare + circumstances deadlock when a distribution channel was + taken down while multiple simultaneous operations were + performed on it.

+

+ Own Id: OTP-7260

+ + +
+ + +
Improvements and New Features + + +

+ More checksum/hash algorithms from the zlib library are + now available as built in functions (like md5 hashes has + been for a long time).

+

+ Own Id: OTP-7128

+ + +

+ Minor improvements in the garbage collector.

+

+ Own Id: OTP-7139 Aux Id: OTP-7132

+ + +

+ The switch "-detached" to the windows werl program now + can create an erlang virtual machine without any main + window and without a temporary console showing.

+

+ Own Id: OTP-7142

+ + +

erlang:system_info/1 now accepts the + logical_processors, and debug_compiled + arguments. For more info see the, erlang(3) + documentation.

The scale factor returned by + test_server:timetrap_scale_factor/0 is now also + effected if the emulator uses a larger amount of + scheduler threads than the amount of logical processors + on the system.

+

+ Own Id: OTP-7175

+ + +

+ A new BIF ets:update_element/3. To update individual + elements within an ets-tuple, without having to read, + update and write back the entire tuple.

+

+ Own Id: OTP-7200

+ + +

+ A process executing the processes/0 BIF can now be + preempted by other processes during its execution. This + in order to disturb the rest of the system as little as + possible. The returned result is, of course, still a + consistent snapshot of existing processes at a time + during the call to processes/0.

+

+ The documentation of the processes/0 BIF and the + is_process_alive/1 BIF have been updated in order + to clarify the difference between an existing process and + a process that is alive.

+

+ Own Id: OTP-7213

+ + +
+ +
+ + +
Erts 5.6.1.1 + +
Fixed Bugs and Malfunctions + + +

+ Not enough parameters were passed when sending an error + report in erl_check_io.c (Thanks to Matthew Dempsky).

+

+ Own Id: OTP-7176

+ + +

+ In rare circumstances, complex binary matching code could + cause the emulator to crash or not match when it should. + (Thanks to Rory Byrne.)

+

+ Own Id: OTP-7198

+ + +
+ + +
Improvements and New Features + + +

The {allocator_sizes, Alloc} and + alloc_util_allocators arguments are now accepted + by erlang:system_info/1. For more information see + the erlang(3) documentation.

+

+ Own Id: OTP-7167

+ + +

+ The finishing reallocation of the heap block when + hibernating a process is now always moving the heap block + since it drastically reduces memory fragmentation when + hibernating large amounts of processes.

+

+ Own Id: OTP-7187

+ + +
+ +
+ +
Erts 5.6.1 + +
Fixed Bugs and Malfunctions + + +

+ The SMP emulator on sparc64 erroneously used the sparc32 + atomic and the sparc32 spinlock implementations which + caused it to crash.

+

+ Own Id: OTP-7006

+ + +

+ Call tracing the new guard BIFs byte_size, + bit_size, or tuple_size and the loading a + module that uses one of those functions, could cause the + emulator to terminate.

+

+ Own Id: OTP-7008

+ + +

+ configuring --enable-darwin-universal or + --enable-darwin-64bit on MacOSX could result in a non + optimized emulator. Top level configure script now + corrected.

+

+ Own Id: OTP-7014

+ + +

+ configuring --with-gd did not produce correct include + flags for percept.

+

+ Own Id: OTP-7015

+ + +

+ Environment variables weren't handled in thread safe + manner in the runtime system with SMP support on Windows.

+

+ erl_drv_putenv(), and erl_drv_getenv() has + been introduced for use in drivers. Do not use + putenv(), or getenv() directly in drivers. For more + information see the erl_driver documentation.

+

+ Own Id: OTP-7035

+ + +

+ HIPE: Corrected the choice of interface to the send/3 and + setnode/3 BIFs for native-compiled code. Using the + incorrect interface could, in unusual circumstances, lead + to random runtime errors.

+

+ Own Id: OTP-7067

+ + +

+ Garbage collections could become extremely slow when + there were many keys in the process dictionary. (Thanks + to Fredrik Svahn.)

+

+ Own Id: OTP-7068

+ + +

+ The duplicate documentation directory in the windows + installation is removed.

+

+ Own Id: OTP-7070

+ + +

Documentation bugfixes and clarifications.

(Thanks + to Joern (opendev@gmail.com), Matthias Lang, and Richard + Carlsson.) +

+ Own Id: OTP-7079

+ + +

+ The runtime system with SMP support not using + the native atomic integer implementation part of OTP + could deadlock when run on a system with more than one + logical processor. That is, only the runtime system with + SMP support on other hardware platforms than + x86, x86_64, sparc32, and powerpc32 were effected by this + bug.

+

+ Own Id: OTP-7080

+ + +

+ The break handling code (run when Ctrl-C is hit) could + could potentially deadlock the runtime system with SMP + support.

+

+ Own Id: OTP-7104

+ + +

+ The sctp driver has been updated to work against newer + lksctp packages e.g 1.0.7 that uses the API spelling + change adaption -> adaptation. Older lksctp (1.0.6) still + work. The erlang API in gen_sctp.erl and inet_sctp.hrl + now spells 'adaptation' regardless of the underlying C + API.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7120

+ + +

A bug in erlang:phash2/1 on 64-bit platforms + has been fixed. (Thanks to Scott Lystig Fritchie.)

+

+ Own Id: OTP-7127

+ + +

+ The emulator could under rare circumstances crash while + garbage collecting.

+

+ Own Id: OTP-7132

+ + +
+ + +
Improvements and New Features + + +

The documentation has been updated so as to reflect + the last updates of the Erlang shell as well as the minor + modifications of the control sequence p of the + io_lib module.

Superfluous empty lines have + been removed from code examples and from Erlang shell + examples.

+

+ Own Id: OTP-6944 Aux Id: OTP-6554, OTP-6911

+ + +

+ Bit syntax construction with a small integer in a + non-byte aligned field wider than the CPU's word size + could cause garbage bits in the beginning of the field.

+

+ Own Id: OTP-7085

+ + +

+ All Windows versions older than Windows 2000 are now + not supported by the Erlang runtime system. This + since there was a need for usage of features introduced + in Windows 2000.

+

+ Own Id: OTP-7086

+ + +

Memory management improvements especially for the + runtime system with SMP support:

The + runtime system with SMP support can now use multiple, + thread specific instances of most memory allocators. This + improves performance since it reduces lock contention in + the memory allocators. It may however increase memory + usage for some applications. The runtime system with SMP + support will by default enable this feature on most + allocators. The amount of instances used can be + configured. driver_alloc(), + driver_realloc(), and driver_free() now use + their own erts specific memory allocator instead of the + default malloc() implementation on the system. + The default configuration of some + allocators have been changed to fit applications that use + much memory better. Some new + erts_alloc configuration parameters have been + added. erts_alloc_config has been + modified to be able to create configurations suitable for + multiple instances of allocators. The + returned value from erlang:system_info({allocator, + Alloc}) has been changed. This since an allocator may + now run in multiple instances.

If you + for some reason want the memory allocators to be + configured as before, you can pass the +Mea r11b + command-line argument to erl.

For more + information see the erts_alloc(3), the + erts_alloc_config(3), and the erlang(3) + documentation.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-7100

+ + +

+ On Unix, denormalized floating point numbers could not be + created using list_to_float/1 or + binary_to_term/1. (Thanks to Matthew Dempsky.)

+

+ Own Id: OTP-7122

+ + +

+ Native atomic integers and spin-locks are now also + available for the runtime system with SMP support on + sparc64.

+

+ Own Id: OTP-7130

+ + +

+ FP exceptions support for sparc64 userspace on Linux has + been added. Note that FP exception support is now turned + off by default, so to actually enable it you need to do + './configure --enable-fp-exceptions'.

+

+ Own Id: OTP-7131

+ + +
+ +
+ +
Erts 5.6 + +
Fixed Bugs and Malfunctions + + +

+ A bug for raw files when reading 0 bytes returning 'eof' + instead of empty data has been corrected.

+

+ Own Id: OTP-6291 Aux Id: OTP-6967

+ + +

+ All exported functions in gzio.c have now been renamed to + avoid conflict with drivers that are indirectly linked + with an external zlib library.

+

+ Own Id: OTP-6816 Aux Id: OTP-6591

+ + +

+ On the 64-bit Erlang emulator, bit syntax construction + with integers containing more than 60 bits ("big + numbers") into fields with more than 60 bits could + produce incorrect results.

+

+ Own Id: OTP-6833

+ + +

+ When the runtime system failed to allocate memory for + binaries, it could dead lock while writing the + erl_crash.dump.

+

+ Own Id: OTP-6848

+ + +

+ The runtime system with SMP support could deadlock if a + process called the erlang:suspend_process(Pid) BIF + or the erlang:garbage_collect(Pid) BIF while the + process identified by Pid was currently running + and the process calling the BIFs was terminated during + the call to the BIFs.

+

+ Processes suspending each other via the + erlang:suspend_process/1 BIF or garbage collecting + each other via the erlang:garbage_collect/1 BIF + could deadlock each other when the runtime system with + SMP support was used.

+

+ Own Id: OTP-6920

+ + +

+ dbg could leave traced processes in a suspended + state if the tracer process was killed with exit reason + kill.

+

+ erlang:suspend_process/2 has been introduced which + accepts an option list as second argument. For more + information see the erlang(3) documentation.

+

+ Processes suspended via + erlang:suspend_process/[1,2] will now be + automatically resumed if the process that called + erlang:suspend_process/[1,2] terminates.

+

+ Processes could previously be suspended by one process + and resumed by another unless someone was tracing the + suspendee. This is not possible anymore. The + process resuming a process has to be the one + that suspended it.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-6946

+ + +

file:write_file/3, file:write/2 and file:read/2 could + crash (contrary to documentation) for odd enough file + system problems, e.g write to full file system. This bug + has now been corrected.

In this process the file + module has been rewritten to produce better error codes. + Posix error codes now originate from the OS file system + calls or are generated only for very similar causes (for + example 'enomem' is generated if a memory allocation + fails, and 'einval' is generated if the file handle in + Erlang is a file handle but currently invalid).

+

More Erlang-ish error codes are now generated. For + example {error,badarg} is now returned from + file:close/1 if the argument is not of a file + handle type. See file(3).

The possibility to write + a single byte using file:write/2 instead of a list + or binary of one byte, contradictory to the + documentation, has been removed.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-6967 Aux Id: OTP-6597 OTP-6291

+ + +

+ Monitor messages produced by the system monitor + functionality, and garbage collect trace messages could + contain erroneous heap and/or stack sizes when the actual + heaps and/or stacks were huge.

+

+ As of erts version 5.6 the large_heap option to + erlang:system_monitor/[1,2] has been modified. The + monitor message is sent if the sum of the sizes of all + memory blocks allocated for all heap generations is equal + to or larger than the specified size. Previously the + monitor message was sent if the memory block allocated + for the youngest generation was equal to or larger than + the specified size.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-6974 Aux Id: seq10796

+ + +

+ inet:getopts/2 returned random values on Windows + Vista.

+

+ Own Id: OTP-7003

+ + +
+ + +
Improvements and New Features + + +

+ The emulator internal process lock implementation has + been rewritten and optimized. A slight risk of starvation + existed in the previous implementation. This risk has + also been eliminated in the new implementation.

+

+ Own Id: OTP-6500

+ + +

+ Bitstrings (bit-level) binaries and binary comprehensions + are now part of the language. See the Reference Manual.

+

+ Own Id: OTP-6558

+ + +

+ The windows version of erlang now has SMP support. The + SMP emulator is run by default on machines which shows + more than one virtual or physical processor.

+

+ Own Id: OTP-6560 Aux Id: OTP-6925

+ + +

+ The details of the compressed term format has been + documented in erl_ext_dist.txt. (Thanks to Daniel + Goertzen.)

+

+ Own Id: OTP-6755

+ + +

+ The runtime system with SMP support is now started by + default if more than one logical processor are detected. + For more information, see the erl(3) + documentation.

+

+ Own Id: OTP-6756

+ + +

+ The external format for Erlang terms and the distribution + protocol are now documented in ERTS User's Guide.

+

+ Own Id: OTP-6779

+ + +

+ New BIF's erlang:system_profile/1 and + erlang:system_profile/2. These BIF's controls concurrency + profiling options for processes, ports and schedulers.

+

+ Own Id: OTP-6783 Aux Id: OTP-6285

+ + +

+ The ErlDrvTermData term types used by + driver_output_term() and driver_send_term() + have been extended with the term types + ERL_DRV_BUF2BINARY, ERL_DRV_EXT2TERM, and + ERL_DRV_UINT. ERL_DRV_BUF2BINARY is used + for passing and creating a binary, + ERL_DRV_EXT2TERM is used for passing terms encoded + with the external term format, and ERL_DRV_UINT is + used for passing unsigned integers.

+

+ Also the data types ErlDrvUInt and + ErlDrvSInt have been added which makes it more + obvious how arguments to term types are interpreted with + regards to width and signedness.

+

+ The incorrect data types ErlDriverTerm, + ErlDriverBinary, and ErlDriverPort in the + erl_driver(3) documentation have been replaced + with the correct data types ErlDrvTermData, + ErlDrvBinary, and ErlDrvPort.

+

+ For more information see the erl_driver(3) + documentation.

+

+ Own Id: OTP-6823

+ + +

+ Miscellaneous improvements of the erts internal thread + library.

+

+ It now support optimized atomic operations and spin-locks + on windows.

+

+ Fall-backs based on mutexes and/or spin-locks for missing + optimized atomic operations, spin-locks, or rwlocks has + been implemented. This makes it possible to compile the + runtime system with SMP support on a lot more platforms.

+

+ Default stack size on OpenBSD has been increased to 256 + kilo-words.

+

+ Own Id: OTP-6831 Aux Id: OTP-6560

+ + +

Many bit syntax operations, both construction and + matching, are faster. For further information, see the + Efficiency Guide.

+

+ Own Id: OTP-6838

+ + +

Literal lists, tuples, and binaries are no longer + constructed at run-time as they used to be, but are + stored in a per-module constant pool. Literals that are + used more than once are stored only once.

+

This is not a change to the language, only in the + details of its implementation. Therefore, the + implications of this change is described in the + Efficiency Guide.

+

Example 1: In the expression element(BitNum-1, + {1,2,4,8,16,32,64,128}), the tuple used to be + constructed every time the expression was executed, which + could be detrimental to performance in two ways if the + expression was executed in a loop: the time to build the + tuple itself and the time spent in garbage collections + because the heap filled up with garbage faster.

+

Example 2: Literal strings, such as "abc", used + to be stored in the compiled code compactly as a byte + string and expanded to a list at run-time. Now all + strings will be stored expanded to lists (such as + [$a,$b,$c]) in the constant pool. That means that + the string will be faster to use at run-time, but that it + will require more space even when not used. If space is + an issue, you might want to use binary literals (that is, + <<"abc">>) instead of string literals for + infrequently used long strings (such as error + messages).

+

+ Own Id: OTP-6850

+ + +

The Erlang driver API has been extended with a + portable POSIX thread like API for multi-threading. The + Erlang driver thread API provides:

+ Threads Mutexes Condition + variables Read/Write locks + Thread specific data

For more + information see the erl_driver(3) + documentation.

+

+ Own Id: OTP-6857

+ + +

+ Recursive calls now usually consume less stack than in + R11B. See the Efficiency Guide.

+

+ Own Id: OTP-6862 Aux Id: seq10746

+ + +

+ The deprecated BIFs erlang:old_binary_to_term/1 + and erlang:info/1 have been removed.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-6876

+ + +

+ Calls to driver call-backs triggered by external events + are now scheduled and interleaved with execution of + Erlang processes also on the runtime system without SMP + support.

+

+ Own Id: OTP-6878

+ + +

+ Faster arithmetic of integers of more than 27 bits signed + (or 60 bits signed on an 64-bit CPU), and also faster + integer multiplication. (Thanks to Tony Rogvall.)

+

+ Own Id: OTP-6891

+ + +

Significant improvements of the process_info + BIFs:

process_info/2 can now be + called with a list of items as second argument in order + to atomically retrieve information about multiple items. + process_info/[1,2] has been + optimized in the runtime system with SMP support. The + whole scheduler could previously be blocked for a + significant period of time in process_info/[1,2] + waiting for a lock on the process being inspected. The + Erlang process calling process_info/[1,2] can + still be blocked for a significant period of time waiting + for the lock, but the scheduler will now be able to run + other processes while the process calling + process_info/[1,2] waits for the lock. + process_info/2 now accept a few more items + than before. The documentation of + process_info/[1,2] has been improved. +

For more information see the erlang(3) + documentation.

+

+ Own Id: OTP-6899

+ + +

+ open_port({}, []) could crash the emulator. + (Thanks to Matthew Dempsky.)

+

+ Own Id: OTP-6901

+ + +

Two new guard BIFs have been introduced as a + recommended replacement for size/1. (The + size/1 BIF will be removed no earlier than in + R14B.) The BIFs are tuple_size/1 to calculate the + size of a tuple and byte_size/1 to calculate the + number of bytes needed for the contents of the binary or + bitstring (rounded up to the nearest number of bytes if + necessary).

+

There is also a new bit_size/1 BIF that returns + the exact number of bits that a binary or bitstring + contains.

+

+ Own Id: OTP-6902

+ + +

The ets:fixtable/2 function, which has been + deprecated for several releases, has been removed.

+

The ets:info/1 function has been reimplemented + as a BIF, which guarantees that information returned is + consistent.

+

The ets:info/2 function now fails with reason + badarg if the second argument is invalid. + (Dialyzer can be used to find buggy code where the second + argument is misspelled.)

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-6906

+ + +

+ As the linux kernel may generate a minor fault when + tracing with CPU timestamps, and there exists no patch to + the Linux kernel that fixes the problem, cpu timestamps + are disabled on Linux for now.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-6922

+ + +

The functions io:columns/0, io:columns/1, io:rows/0 + and io:rows/1 are added to allow the user to get + information about the terminal geometry. The shell takes + some advantage of this when formatting output. For + regular files and other io-devices where height and width + are not applicable, the functions return + {error,enotsup}.

+

Potential incompatibility: If one has written a custom + io-handler, the handler has to either return an error or + take care of io-requests regarding terminal height and + width. Usually that is no problem as io-handlers, as a + rule of thumb, should give an error reply when receiving + unknown io-requests, instead of crashing.

+

+ *** POTENTIAL INCOMPATIBILITY ***

+

+ Own Id: OTP-6933

+ + +

+ driver_caller() can now also be used from the + start callback of a driver.

+

+ Own Id: OTP-6951

+ + +

+ The emulator can now be compiled for 64bit intel, as well + as a 32bit universal binary on darwin/MacOSX 10.4 and + 10.5.

+

+ Own Id: OTP-6961

+ + +

+ If open_port fails because all available ports are + already in use, it will now throw a system_limit + exception instead of an enfile exception. + (enfile might still be thrown if the operating + system would return ENFILE.)

+

+ Own Id: OTP-6968

+ + +

+ The spawn_monitor/1 and spawn_monitor/3 BIFs + are now auto-imported (i.e. they no longer need an + erlang: prefix).

+

+ Own Id: OTP-6975

+ + +

+ On Windows, the werl window now handles resize, so that + the whole window can be utilized. Text selection is also + updated to be line oriented instead of rectangle oriented + as in earlier versions.

+

+ Own Id: OTP-6994 Aux Id: OTP-6933

+ + +

+ Kqueue support (kernel-poll) has been enabled on FreeBSD. + The problem with kqueue not detecting writes on a pipe on + FreeBSD was actually not a kqueue issue, but a writev on + pipes issue. Neither poll(), nor select() detected the + write when the bug hit. NetBSD and DragonFlyBSD probably + have or have had the same bug. This bug should have been + fixed in FreeBSD 6.3 and FreeBSD 7.0 thanks to + Jean-Sebastien Pedron.

+

+ Own Id: OTP-7001

+ + +
+ +
+ + +
Erts 5.5.5.5 + +
Fixed Bugs and Malfunctions + + +

+ Hanging writes on temporarily unavailable NFS + filesystems could cause the execution of (not file + related) erlang code to get blocked even though I/O + threads were used. This is now corrected.

+

+ Own Id: OTP-6907 Aux Id: seq10771

+ + +
+ +
+ +
Erts 5.5.5.4 + +
Fixed Bugs and Malfunctions + + +

+ Data passed to a driver via erlang:port_call could + be corrupted when the runtime system with SMP support was + used. (Thanks to YAMASHINA Hio.)

+

+ Own Id: OTP-6879

+ + +

+ In the SMP emulator, if several processes called + ets:update_counter/3 (even for different tables) when the + counter values exceeded 27 bits, the counter values could + be corrupted or the emulator could crash.

+

+ Own Id: OTP-6880 Aux Id: seq10760

+ + +
+ +
+ + +
Erts 5.5.5.3 + +
Fixed Bugs and Malfunctions + + +

Creating a named table using ets:new/2 or + renaming a named table using ets:rename/2 could in + rare circumstances succeed, meaning that there would be + two or more tables with the same name. Now such call will + fail with a badarg exception as it is supposed to + do.

+

ets:delete/1 used on a named table now removes + the name immediately so that a new table with the same + name can be created.

+

Turning on call trace on the internal BIF that + implements ets:delete/1 would crash the + emulator.

+

SMP emulator only: Using ets:rename/2 on a + table that ets:safe_fixtable/2 has been used on + could cause an emulator crash or undefined behaviour + because of a missing lock.

+

+ Own Id: OTP-6872 Aux Id: seq10756, seq10757

+ + +
+ +
+ +
Erts 5.5.5.2 + +
Known Bugs and Problems + + +

+ ets:select/3 on ordered_set and with a chunksize a + multiple of 1000 gave all elements instead of just 1000. + Also ets:slot/2 on ordered set could give unexpected + results on SMP emulator. Both problems are corrected.

+

+ Own Id: OTP-6842

+ + +
+ +
+ +
Erts 5.5.5.1 + +
Fixed Bugs and Malfunctions + + +

+ All exported functions in gzio.c have now been renamed to + avoid conflict with drivers that are indirectly linked + with an external zlib library.

+

+ Own Id: OTP-6816 Aux Id: OTP-6591

+ + +

+ Calling binary_to_term/1 with certain invalid binaries + would crash the emulator.

+

+ Own Id: OTP-6817

+ + +
+ + +
Improvements and New Features + + +

+ Restored speed of bit-syntax matching of 32 bits + integers.

+

+ Own Id: OTP-6789 Aux Id: seq10688

+ + +
+ +
+ +
+ Erts 5.5.5 + +
+ Fixed Bugs and Malfunctions + + +

The functions in gzio.c have been renamed to avoid + conflict with drivers that indirectly linked with an + external zlib library.

+

Own Id: OTP-6591

+ + +

The emulator without SMP support dumped core if an + async-thread finished a job after the emulator had begun + writing an .

+

Own Id: OTP-6685

+ + +

In bit syntax matching, integer fields with greater + size than 16Mb would fail to match. (Thanks to Bertil + Karlsson and Francesco Pierfederici.)

+

Matching out a 32-bit integer not aligned on a byte + boundary from a binary could cause an heap overflow (and + subsequent termination of the emulator).

+

A module that contained bit syntax construction with a + literal field size greater than 16Mb would fail to + load.

+

Several other similar bugs having to do with huge + field sizes were eliminated.

+

Attempting to construct a binary longer than 536870911 + bytes will now fail with a exception + (rather than fail in mysterious ways or construct an + binary with incorrect contents). Similarily, attempting + to match a binary longer than 536870911 bytes will now + fail (instead of producing an incorrect result). This + limitation has been documented in the Efficiency Guide. + (The limit is in the 32-bit emulator; use the 64-bit + emulator if you need to handle larger binaries than + 536870911.)

+

Own Id: OTP-6686

+ + +

Bugs in rem and div of very large numbers are corrected.

+

Own Id: OTP-6692

+ + +

didn't + allocate enough heap when a bignum was part of the result + which could cause an emulator crash.

+

Own Id: OTP-6693

+ + +

It was previously not possible to pass + the same configuration via the + command-line, as used by default.

+

A command-line argument that configure a + size of some sort can now be passed a value that equals + the size of the address space. The value used, in this + case, will be .

+

Own Id: OTP-6699

+ + +

did not update if was + invalid. is now set to if the + is invalid.

+

The driver + expects to be updated also when the + is invalid. This situation occurs seldom, but + when the runtime system has async-threads enabled and + ports are killed it can. When it occurred the runtime + system crashed.

+

Own Id: OTP-6729

+ + +
+ +
+ Improvements and New Features + + +

For scripts written using , there is a new + function , which can be used + to retrieve the pathame of the script. The documentation + has been clarified regarding pre-defined macros such as + ?MODULE and the module name.

+

Own Id: OTP-6593

+ + +

The section Guards in the chapter The Abstract Format + of the ERTS User's Guide has been updated.

+

Own Id: OTP-6600

+ + +

Corrected protocol layer flue for socket options + SO_LINGER, SO_SNDBUF and SO_RCVBUF, for SCTP.

+

Own Id: OTP-6625 Aux Id: OTP-6336

+ + +

The behaviour of the inet option {active,once} on peer + close is improved and documented.

+

Own Id: OTP-6681

+ + +

The inet option send_timeout for connection oriented + sockets is added to allow for timeouts in communicating + send requests to the underlying TCP stack.

+

Own Id: OTP-6684 Aux Id: seq10637 OTP-6681

+ + +

The command line flag , and + the environment variables , and + for the command have been + added. For more information see the + documentation.

+

Own Id: OTP-6697

+ + +

The type test has been deprecated. + is improperly named and almost + entirely undocumented.

+

Own Id: OTP-6731

+ + +
+
+ +
+ Erts 5.5.4.3 + +
+ Fixed Bugs and Malfunctions + + +

where + was a term not equal to or , + didn't fail with as it should; instead, the + failure was silently ignored. This bug was introduced in + .

+

Own Id: OTP-6627 Aux Id: OTP-6160

+ + +

The minimum and default stack size for async-threads has + been increased to 16 kilowords. This since the previous + minimum and default stack size of 8 kilowords proved to + be too small (introduced in ).

+

Own Id: OTP-6628 Aux Id: OTP-6580, Seq10633

+ + +
+ +
+ Improvements and New Features + + +

process_flag/2 accepts the new flag .

+

Own Id: OTP-6592 Aux Id: seq10555

+ + +
+
+ +
+ Erts 5.5.4.2 + +
+ Fixed Bugs and Malfunctions + + +

When a port steals control over a file descriptor from + another port, the stealing port tests if the other port + is alive. This in order to be able to give an accurate + error message. In the runtime system with SMP support, + this test was done without appropriate locks held. This + could in worst case lead to an erroneous error message; + therefore, this bug is to be considered harmless.

+

Own Id: OTP-6602

+ + +
+ +
+ Improvements and New Features + + +

The default stack size for threads in the async-thread + pool has been shrunk to 8 kilowords, i.e., 32 KB on + 32-bit architectures. This small default size has been + chosen since the amount of async-threads might be quite + large. The default stack size is enough for drivers + delivered with Erlang/OTP, but might not be sufficiently + large for other dynamically linked in drivers that use + the functionality. A suggested + stack size for threads in the async-thread pool can be + configured via the command line argument of + .

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-6580

+ + +
+
+ +
+ Erts 5.5.4.1 + +
+ Fixed Bugs and Malfunctions + + +

Setting the time on the system while using heart on a + linux machine where the emulator was built with + clock_gettime support (default from Linux 2.6/erts-5.5.4 + and upwards), could make the heart command fire. This was + due to bug in the heart executable which is now + corrected.

+

Own Id: OTP-6598 Aux Id: seq10614

+ + +
+
+ +
+ Erts 5.5.4 + +
+ Fixed Bugs and Malfunctions + + +

Corrected misspelling of '' in the help text + for . (Thanks to Ulf Wiger.)

+

Own Id: OTP-6433

+ + +

The MD5 calculation of a BEAM file done by + , , and by + the compiler for the default value of the + attribute have all been changed so that its result will + be the same on all platforms; modules containing funs + could get different MD5s on different platforms.

+

Own Id: OTP-6459

+ + +

The emulator could dump core while writing an + file if there were funs with a + large terms in its environment. Since there is no way to + inspect a fun's environment in the crashdump_viewer + application anyway, a variables in the environment are + now set to [] before dumping the fun. (Thanks to + Jean-Sebastien Pedron.)

+

Own Id: OTP-6504

+ + +

messages from ports + opened with the option could under + rare circumstances be delayed. This bug was present on + Erlang runtime systems without SMP support on all unix + operating systems other than SunOS.

+

Own Id: OTP-6528

+ + +

A bug in linuxthreads could cause the emulator to dump + core when dlerror() was called before the first call to + dlopen(). As a workaround the emulator always makes a + call to dlopen() on initialization when linuxthreads is + used as thread library.

+

Own Id: OTP-6530

+ + +

file:sync/1 did not do anything on Windows. Now it calls + the system function for flushing buffers + (FlushFileBuffers()). (Thanks to Matthew Sackman.)

+

Own Id: OTP-6531

+ + +

could on the runtime system with SMP + support fail with the wrong exit reason when a port + couldn't be created. When this happened the exit reason + was typically , or instead of + .

+

Own Id: OTP-6536

+ + +

The file driver (efile_drv) did not flush data written + using the option 'delayed_write' after the set timeout + time, rather at the next file operation. This bug has now + been corrected.

+

Own Id: OTP-6538

+ + +
+ +
+ Improvements and New Features + + +

An interface towards the SCTP Socket API Extensions + has been implemented.It is an Open Source patch courtesy + of Serge Aleynikov and Leonid Timochouk. The Erlang code + parts has been adapted by the OTP team, changing the + Erlang API somewhat.

+

The Erlang interface consists of the module + and an include file + for + option record definitions. The module is + documented.

+

The delivered Open Source patch, before the OTP team + rewrites, was written according to + http://tools.ietf.org/html/draft-ietf-tsvwg-sctpsocket-13 + and was claimed to work fine, tested on Linux Fedora Core + 5.0 (kernel 2.6.15-2054 or later) and on Solaris 10 and + 11. The OTP team rewrites used the same standard document + but might have accidentally broken some functionality. If + so it will soon be patched to working state. The tricky + parts in C and the general design has essentially not + changed. During the rewrites the code was hand tested on + SuSE Linux Enterprise Server 10, and briefly on Solaris + 10. Feedbach on code and docs is very much + appreciated.

+

The SCTP interface is in beta state. It has only been + hand tested and has no automatic test suites in OPT + meaning everything is most certainly not tested. Socket + active mode is broken. IPv6 is not tested. The + documentation has been reworked due to the API changes, + but has not been proofread after this.

+

Thank you from the OTP team to Serge Aleynikov and + Leonid Timochouk for a valuable contribution. We hope we + have not messed it up too much.

+

Own Id: OTP-6336

+ + +

A option is now recognized + by . {minor_version,1} will cause + floats to be encoded in an exact and more space-efficient + way compared to the previous encoding.

+

Own Id: OTP-6434

+ + +

There is a new program that can be used + for writing scripts in Erlang. Erlang scripts don't need + to be compiled and any arguments can be passed to them + without risk that they are interpreted by the Erlang + system.

+

Own Id: OTP-6505

+ + +

Setting and getting socket options in a "raw" fashion is + now allowed. Using this feature will inevitably produce + non portable code, but will allow setting ang getting + arbitrary uncommon options on TCP stacks that do have + them.

+

Own Id: OTP-6519

+ + +

Miscellaneous signal handling improvements on the Erlang + runtime system with SMP support.

+

The fallback implementation of spin locks and atomic + operations are now implemented using pthread spin locks + when pthread spin locks are found on the system.

+

The Erlang runtime system with SMP support can now run on + Linux systems that has Linuxthreads instead of NPTL + (Native POSIX Thread Library). Note that the SMP support + hasn't been as thoroughly tested with Linuxthreads as + with NPTL. A runtime system with SMP support will + therefore not be built by default on Linux when NPTL + isn't found. In order to force a build of the runtime + system with SMP support, pass + to when building OTP.

+

Own Id: OTP-6525

+ + +
+
+ +
+ Erts 5.5.3.1 + +
+ Fixed Bugs and Malfunctions + + +

could + cause the emulator with SMP support to deadlock.

+

Own Id: OTP-6431 Aux Id: OTP-6403

+ + +

The runtime system with SMP support failed to call the + driver timeout callback of ports in state closing. This + could cause ports to fail flushing their I/O queues.

+

Own Id: OTP-6432

+ + +

The message from a closed port + could arrive at the port owner before had + been removed from the result of in + the runtime system with SMP support.

+

Own Id: OTP-6437

+ + +

The async id of async jobs created via + wasn't created in a thread safe + manner in the runtime system with SMP support. This could + in worst case cause to + cancel another async job than intended.

+

Own Id: OTP-6438

+ + +

Under rare circumstances a terminating connection between + two nodes could cause an instantaneous reconnect between + the two nodes to fail on the runtime system with SMP + support.

+

Own Id: OTP-6447

+ + +

In the documentation of the driver entry field + of erts version 5.5.3 + (), the following is stated: "The + following fields are ignored if this field is equal to + ". This is a documentation bug and has been + changed to: "If this field is equal to , all the + fields following this field also have to be + , or in case it is a pointer field".

+

The runtime check for detection of old incompatible + drivers made when loading drivers has been improved. The + emulator can, however, not make sure that a driver that + doesn't use the extended driver interface isn't + incompatible. Therefore, when loading a driver that + doesn't use the extended driver interface, there is a + risk that it will be loaded also when the driver is + incompatible. When the driver use the extended driver + interface, the emulator can verify that it isn't of an + incompatible driver version. You are therefore advised to + use the extended driver interface.

+

For more information see the and + documentation.

+

Own Id: OTP-6452 Aux Id: OTP-6330

+ + +

When terminating ports on the runtime system with SMP + support, removal of links to processes was done without + locking the link lock on processes. This could cause an + emulator crash.

+

Own Id: OTP-6475

+ + +

The emulator with SMP support could crash when a port + flushed its I/O queue by calling + from the timeout driver callback.

+

Own Id: OTP-6479

+ + +

Large exit reasons could under rare circumstances cause + the runtime system with SMP support to crash.

+

Own Id: OTP-6521

+ + +
+ +
+ Improvements and New Features + + +

Faster system calls for keeping the time accurate are + used on newer Linux kernels, which can result in a + significant speed-up of the emulator on those systems.

+

Own Id: OTP-6430

+ + +

Added number of async threads and number of scheduler + threads to the system information that can be retrieved + via . For more information see + the documentation.

+

Own Id: OTP-6440

+ + +

When is received by the runtime system + with SMP support, the is now + written by a special thread, instead of as before + directly from the signal handler.

+

Own Id: OTP-6465

+ + +

term_to_binary/2 with compression is now faster.

+

+

term_to_binary/2 now accepts the option + '' for specifying the + compression level. must be in the range 0 + (no compression) through 9 (highest compression level). + Default is 6.

+

Future compatibility bugfix: binary_to_term/1 did not + handle the and fields + correctly.

+

Own Id: OTP-6494

+ + +

Removed unnecessary reallocation when initializing + kernel-poll set.

+

Own Id: OTP-6516

+ + +
+
+ +
+ Erts 5.5.3 + +
+ Fixed Bugs and Malfunctions + + +

Node and fun table entries could under rare circumstances + be deallocated multiple times on the emulator with SMP + support.

+

Own Id: OTP-6369

+ + +

epoll_wait() can repeat entries for the same file + descriptor in the result array. This could cause the + ready_input, ready_output, or event callbacks of a driver + to unintentionally be called multiple times. We have only + noted repeated entries when an error condition has + occurred on the file descriptor. In this case, the + repeated entries should normally not be a problem for the + driver since it should detect the error and de-select the + file descriptor. Therefore this bug should be considered + harmless. The emulator now coalesce repeated entries into + one.

+

You are only affected by this bug if you are using + erts-5.5.2.* and the kernel-poll feature on linux.

+

Own Id: OTP-6376 Aux Id: OTP-6222

+ + +

If a process that was waiting in gen_tcp:accept/1 was + killed, calling gen_tcp:accept/1 again on the same listen + socket would fail with ''.

+

Own Id: OTP-6381 Aux Id: seq10535

+ + +

The emulator failed to start on Solaris 10 when + kernel-poll support was enabled and the maximum number of + filedescriptors configured was less than or equal to 256.

+

Own Id: OTP-6384 Aux Id: OTP-6222

+ + +

The R10B compiler could generate unsafe + instructions that could cause + memory corruption. (The R11B compiler does not have that + problem.) The erlang emulator will now refuse to load + R10B-compiled modules that contain such unsafe + instructions. In addition, the + beam_validator module in the compiler will also reject + such instructions (in case it is used to validate R10B + code). (Thanks to Matthew Reilly.)

+

Own Id: OTP-6386

+ + +

Process and port timers could fail to work properly on + the runtime system with SMP support. Many thanks to + Dmitriy Kargapolov and Serge Aleynikov who tracked down + this bug.

+

Own Id: OTP-6387

+ + +

Bit syntax code compiled by an R10B compiler that matched + out a floating point number would not properly check that + the floating point number was valid; if the float was, + for instance, NaN the emulator could crash.

+

Own Id: OTP-6395

+ + +

statistics(runtime) on Windows used to return the elapsed + system time for the process, instead of the user time. + Corrected. (Thanks to Robert Virding.)

+

Own Id: OTP-6407

+ + +

A loadable driver (loaded by erl_ddll) which used + driver_async() would cause the emulator to crash. (Thanks + to Dmitriy Kargapolov.)

+

Own Id: OTP-6410

+ + +

Under rare circumstances the emulator on unix platforms + could fail to terminate the Erlang port corresponding to + a port program opened with the option.

+

Own Id: OTP-6411

+ + +

A link removed via could under rare + circumstances transfer exit signals for a short period of + time after the call to had returned when + the runtime system with SMP support was used.

+

Own Id: OTP-6425 Aux Id: OTP-6160

+ + +
+ +
+ Improvements and New Features + + +

In the runtime system with SMP support, ports are now + being scheduled on the scheduler threads interleaved with + processes instead of being run in a separate I/O thread.

+

Own Id: OTP-6262

+ + +

More interfaces are added in erl_ddll, to support + different usage scenarios.

+

Own Id: OTP-6307 Aux Id: OTP-6234

+ + +

In the runtime system with SMP support, the global + I/O lock has been replaced with a more fine grained port + locking scheme. Port locking is either done on driver + level, i.e., all ports executing the same driver share a + lock, or on port level, i.e., each port has its own lock. + Currently the inet driver, the efile driver, and the + spawn driver use port level locking and all other + statically linked in drivers use driver level locking. By + default dynamically linked in drivers will use locking on + driver level. For more information on how to enable port + level locking see the and the + man pages.

+

As of erts + version 5.5.3 the driver interface has been extended. The + extended interface introduce version management, the + possibility to pass capability flags to the runtime + system at driver initialization, and some new driver API + functions. For example, the + function which can be used to determine if the driver is + run in a runtime system with SMP support or not. The + extended interface doesn't have to be used, but + dynamically linked in driver have to be + recompiled. For information see the + and the man pages.

+

NOTE: Dynamically linked in drivers + have to be recompiled.

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-6330 Aux Id: OTP-6262

+ + +

A test and debug feature which modifies the timing of the + runtime system has been added. For more information, see + documentation of the ]]> command line + argument of .

+

Own Id: OTP-6382

+ + +

The version of zlib (http://zlib.net) linked into + run-time system has been updated to version 1.2.3.

+

Own Id: OTP-6394

+ + +

The program now passes on the + and options to the Erlang emulator it + starts. This is mainly useful for compiling native code, + because native code must be compiled with same type of + run-time system as in which it will be run.

+

If the option is given, now + prints a warning that it is deprecated and that it will + be removed in R12B.

+

Own Id: OTP-6398

+ + +

The option of + has been removed, i.e., the + number of scheduler threads cannot be changed after + emulator boot time any more.

+

A option has been added to + . This option can be used for + blocking and unblocking multi-scheduling. For more + information see the documentation.

+

Own Id: OTP-6403

+ + +

A port program that had been started with the + option and closed one of the pipes + used for communication with the emulator caused the + emulator to continuously poll for termination of the port + program. This only became a problem when the emulator + didn't have other things to do and the port program + closed a pipe much earlier than it terminated. When the + emulator had other things to do, such as running Erlang + processes, the emulator polled for termination in between + scheduling of processes.

+

Now the emulator doesn't poll for termination of the port + program at all; instead, it waits for the child signal + from the terminated port program to arrive and then + schedules the Erlang port for termination.

+

The termination of any port programs have also been + optimized. Previously the termination of any port program + did always cause a scan of a table of the size equal to + maximum number of file descriptors. If the maximum number + of file descriptors was large, this scan could be quite + expensive. Now the search have been reduced to the set of + ports started with the option.

+

Note, all of the above only applies to Erlang emulators + on Unix platforms.

+

Own Id: OTP-6412 Aux Id: seq10194

+ + +

* BEAM: added support for floating-point exceptions on + FreeBSD (32-bit x86)

+

* SMP: made locking procedures work even when native + lock operations aren't implemented

+

* SMP: improved timing accuracy in the timer thread + (if enabled)

+

Own Id: OTP-6424

+ + +
+
+ +
+ Erts 5.5.2.2 + +
+ Fixed Bugs and Malfunctions + + +

A bug in the kernel poll implementation could cause the + emulator to omit polling for events on file descriptors. + The bug was only present when using the kernel poll + implementation based on epoll or kqueue. This bug was + introduced in erts-5.5.2.

+

Own Id: OTP-6344 Aux Id: OTP-6222

+ + +
+
+ +
+ Erts 5.5.2.1 + +
+ Fixed Bugs and Malfunctions + + +

The run_erl program now acquires its pseudo-ttys using + openpty(3), so that it will work on newer Linux + distributions that don't have the traditional pseudo-tty + devices in the file system. On platforms that don't have + openpty(3), run_erl will still search for pseudo-tty + devices in the file system.

+

The run_erl program will now wait using waitpid(3) to + prevent the program it spawned to become defunct. run_erl + will also terminate after a delay of 5 seconds (to allow + any pending output to be written to the log file) if the + spawned program terminates even if some child of it still + holds stdin and/or stdout open.

+

Own Id: OTP-6225 Aux Id: seq10500

+ + +

A bug in ordered_set ETS datatyp caused ets:select (and + match) to return faulty results when the table contained + process id's from another node.

+

Own Id: OTP-6338

+ + +
+
+ +
+ Erts 5.5.2 + +
+ Fixed Bugs and Malfunctions + + +

erlc: A typo in the help text for '-pa path' was + corrected.

+

Own Id: OTP-6218

+ + +

Failure in port command/control driver callbacks could + crash the non-SMP emulator. This bug was introduced in + the 5.5 version of erts.

+

Own Id: OTP-6224

+ + +

Erroneous "" error reports could sometimes occur + when a driver instance terminated in the ready_output() + callback of the driver. This bug was only present in + emulators that used poll(). Note, that this bug was + harmless, the only effect it had was the erroneous error + report.

+

Own Id: OTP-6229 Aux Id: OTP-3993, Seq5266, Seq7247, + OTP-4307

+ + +

The emulator could cause a type assertion failure while + writing an erl_crash.dump, causing the erl_crash.dump to + be terminated and a core dump generated.

+

Own Id: OTP-6235 Aux Id: seq10444

+ + +

The registered name of a process is now the last + observable resource removed before links and monitors are + triggered when a process terminates.

+

Previously ets tables were removed after the registered + name. This could cause problems on the runtime system + with SMP support for code that expected that ets tables + owned by a specific process had been removed if the name + of the process had been removed.

+

Own Id: OTP-6237

+ + +

Failure to fork() a new (os) process could cause the + emulator to deadlock. This bug affect all emulators with + SMP support, and emulators with async thread support on + SunOS.

+

Own Id: OTP-6241 Aux Id: OTP-3906

+ + +

Fprof traces could become truncated for the SMP emulator. + This bug has now been corrected.

+

Own Id: OTP-6246

+ + +

The undocumented functions inet:getiflist/0,1 + inet:ifget/2,3 and inet:getif/1 were completely broken on + Windows. That has been fixed.

+

Own Id: OTP-6255

+ + +

Behavior in case of disappeared nodes when using the + dist_auto_connect once got changed in R11B-1. The + timeouts regarding normal distributed operations is now + reverted to the old (pre R11B-1).

+

Own Id: OTP-6258 Aux Id: OTP-6200, seq10449

+ + +

The bsl and bsr operators could cause the emulator to + crash if given invalid arguments. (Thanks to datacompboy + and Per Gustafsson.)

+

Own Id: OTP-6259

+ + +

driver_cancel_timer() could under certain circumstances + fail to cancel the timer on the runtime system with SMP + support.

+

Own Id: OTP-6261

+ + +

A call to erlang:system_info(info) could deadlock the + runtime system with SMP support.

+

Own Id: OTP-6268

+ + +
+ +
+ Improvements and New Features + + +

Exit signals are now truly asynchronous in the runtime + system with SMP support. This simplifies locking in bifs + a lot, and makes process termination cheaper.

+

Own Id: OTP-6160

+ + +

When tracing on the runtime system with SMP support it + can be difficult to know when a trace has been delivered + to the tracer. A new built in function + has been introduced in + order to make it easier to know when the trace has been + delivered. See the erlang(3) man page for more + information.

+

Own Id: OTP-6205 Aux Id: OTP-6269

+ + +

Kernel poll support can now be combined with SMP support. + Currently the following kernel poll versions exist: + , , and . Linux + has been replaced with . Some + time in the future there will also be a kernel poll + version using Solaris event ports.

+

The "check io" implementation for unix has been + completely rewritten. The current kernel poll + implementation reduce the amount of system calls needed + compared to the old kernel poll implementation.

+

When or is used either + or is used as fallback. + Previously only could be used as fallback. + Since now can be used as fallback, kernel + poll support is now also available on newer MacOSX. Note + however, when is used as fallback, the + maximum number of file descriptors is limited to + .

+

Kernel poll support is now enabled by default if + , , or is found + when building OTP, i.e. you do not have to pass the + argument to . + As before, kernel poll is disabled by default in the + runtime system. In order to enable it, pass the + command line argument to .

+

Note: will refuse to enable kernel poll + support on FreeBSD since have problems with + (at least) pipes on all version of FreeBSD that we have + tested.

+

Own Id: OTP-6222 Aux Id: seq10380

+ + +

The module and the code in the emulator + have been completely rewritten; several bugs were fixed.

+

Own Id: OTP-6234

+ + +

The SMP emulator now avoids locking for the following + operations (thus making them as fast as in the UP + emulator): , atom comparison, atom + hashing, .

+

Own Id: OTP-6252

+ + +

There are new BIFs , + and the new option for + .

+

The module has been updated to + handle the new BIFs.

+

Own Id: OTP-6281

+ + +
+
+ +
+ Erts 5.5.1.1 + +
+ Improvements and New Features + + +

There is now an option read_packets for UDP sockets that + sets the maximum number of UDP packets that will be read + for each invocation of the socket driver.

+

Own Id: OTP-6249 Aux Id: seq10452

+ + +
+
+ +
+ Erts 5.5.1 + +
+ Fixed Bugs and Malfunctions + + +

Complex pattern matching of strings would fail in the 64 + bits emulator because of a bug in the loader. (Thanks to + Igor Goryachev.)

+

Own Id: OTP-6142

+ + +

and would be calculated incorrectly. + could in unlucky circumstances + cause a heap overflow, as could size(Binary) when size of + the binary was larger than 128Mb.

+

Own Id: OTP-6154

+ + +

erlang:display/1 displayed erroneous values for negative + integers.

+

Big integers (both positive and negative) were previously + displayed in hexadecimal form while small integers were + displayed in decimal form. All integers are now displayed + in decimal form.

+

NOTE: erlang:display/1 should only be used for debugging.

+

Own Id: OTP-6156

+ + +

A call to erlang:trace/3 with erroneous flags caused the + SMP emulator to deadlock instead of exiting the calling + process with badarg.

+

Own Id: OTP-6175

+ + +

A bug causing the emulator to hang when exiting a process + that is exception traced has been fixed.

+

Own Id: OTP-6180

+ + +

ets:rename/1 could deadlock, or crash the SMP emulator + when the table wasn't a named table.

+

ets:next/2, and ets:prev/2 could return erroneous results + on the SMP emulator.

+

Own Id: OTP-6198 Aux Id: seq10392, seq10415

+ + +

A memory allocation bug could cause the SMP emulator to + crash when a process had executed a + with a larger timeout than 10 minutes.

+

Own Id: OTP-6199

+ + +

The runtime system with SMP support did not slowly adjust + it's view of time when the system time suddenly changed.

+

Timeouts could sometimes timeout too early on the runtime + system with SMP support.

+

Own Id: OTP-6202

+ + +
+ +
+ Improvements and New Features + + +

The smp runtime system now automatically detects the + number of logical processors on MacOSX (darwin) and + OpenBSD.

+

The smp runtime system is now built by default on MacOSX + (darwin) on x86.

+

Own Id: OTP-6119

+ + +

The command line argument now take the + following options: , , or + .

+

Especially the argument is useful since + it starts the Erlang runtime system with SMP support if + it is available and more than one logical processor are + detected; otherwise, it starts the Erlang runtime system + without SMP support. For more information see the + man page.

+

Own Id: OTP-6126

+ + +

Increased the reduction cost for sending messages in the + SMP emulator so it behaves more like the non-SMP + emulator.

+

Own Id: OTP-6196

+ + +

A port running a dynamically linked-in driver that exits + due to the driver being unloaded now exits with exit + reason . Previously the port exited + with exit reason .

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-6204

+ + +

Changed name of the argument + to . This since the + argument so easily could be mixed up + with the argument (both returning + integers).

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-6208

+ + +

The changes below were made by Mikael Pettersson, HiPE.

+

HiPE runtime system:

+

Reduce overheads in the HiPE runtime system's BIF glue + code.

+

Fix bug when exceptions are thrown from BEAM to HiPE.

+

Support SPARC on Linux.

+

Support x86 on FreeBSD.

+

Floating-point exceptions:

+

Reduce overheads in checking results of floating-point + operations.

+

Minor bug fix in SSE2 floating-point exception + handling.

+

Support SSE2 floating-point exceptions on 32-bit x86 + machines.

+

Make FP exceptions work in the SMP runtime system on + FreeBSD/x86.

+

Support floating-point exceptions on SPARCs running + Linux.

+

Runtime system:

+

Minor scheduler optimisation in the non-SMP runtime + system.

+

Substantial reduction of I/O thread overheads in the + SMP runtime system if the separate timer thread is used. + (In R11B-1, the separate timer thread is not used.)

+

Own Id: OTP-6211

+ + +
+
+ +
+ ERTS 5.5 + +
+ Fixed Bugs and Malfunctions + + +

Previously and + behaved completely asynchronous. This had one undesirable + effect, though. You could never know when you were + guaranteed not to be affected by a link that you + had unlinked or a monitor that you had demonitored.

+

The new behavior of and + can be viewed as two operations + performed atomically. Asynchronously send an unlink + signal or a demonitor signal, and ignore any future + results of the link or monitor.

+

NOTE: This change can cause some obscure code + to fail which previously did not. For example, the + following code might hang:

+ ok +\011 %% We were previously guaranteed to get a down message +\011 %% (since we exited the process ourself), so we could +\011 %% in this case leave out: +\011 %% after 0 -> ok +\011 end, + ]]> +

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-5772

+ + +

Two bugs fixed: If the environment variable + was set, its contents would be appended to the end of the + command line even if the command line had an + options. Changed to place the options from + just before . Also, the and + flags no longer have any effect if placed + after .

+

Own Id: OTP-6054

+ + +
+ +
+ Improvements and New Features + + +

The documentation for writing drivers in the ERTS User's + Guide has been expanded and updated.

+

Own Id: OTP-5192

+ + +

The and operators are + now allowed to be used in guards. That also applies to + match specifications.

+

Own Id: OTP-5894 Aux Id: OTP-5149

+ + +

There is a new trace match spec function + and a corresponding trace + message that can be used to trace + on any exit from a function, both normal function return + and exception return. See the documentation for + details.

+

The trace message is now also + generated when the execution returns to a function due to + catching an exception.

+

Own Id: OTP-5956

+ + +

Erlang runtime system with SMP (symmetric multi processing) + support.

+

The runtime system with SMP support is in this release + focused on stability and there are a number of steps + with optimizations to follow before it will take + full advantage of multi processor systems. + The released system is however truly multi threaded + and you will notice increased performance + for many applications already. + We recommend that you evaluate your application on + the SMP version of the runtime system and wait for some + more optimizations before you use it in a real product. + You will then discover if there are any problems in + your application that needs to be fixed in order for + it to work properly in a multi threaded environment. + More optimized versions of the runtime system + with SMP support will be included in the R11B + maintenance releases.

+

The SMP enabled runtime system will be started if + the command line argument is passed to + the command. In order to make use of more than + one processor core, multiple scheduler threads are used. By + default, the number of scheduler threads will equal + the number of processor cores. The number of scheduler + threads can be set with the command line argument. + For more information see the man page.

+

A runtime system with SMP support is by default built on + the following platforms if posix threads, and a gcc + compiler of at least version 2.95 is found:

+ + +

Linux with at least kernel version 2.6 and the Native + POSIX Thread Library on x86, x86_64, and 32-bits + PowerPC.

+ + +

Solaris of at least version 8 on 32-bits SPARC-V9.

+ + +

MacOSX of at least version 10.4 (Darwin 8.0) on + 32-bits PowerPC.

+ + +

The runtime system with SMP support is known not + to build on:

+ + +

Windows.

+ + +

Linux with kernel versions less than 2.4, or without + the Native POSIX Thread Library.

+ + +

Other hardware platforms than x86, x86_64, 32-bits + SPARC-V9 and 32-bits PowerPC.

+ + +

Windows will be supported in a future release.

+

The runtime system with SMP support might build on other + operating systems in combination with supported hardware. + In order to force a build of a runtime system with SMP + support, pass the command line + argument to configure. Note, however, that it is not enough + that it builds. The underlying thread library and operating + system has to provide SMP support as well. If the thread + library does not distribute scheduler threads over multiple + processor cores then the runtime system will only seemingly + provide SMP support. If the runtime system is not built by + default on a specific platform, we have not tested + it on that platform.

+

NOTE: The design of SMP support for drivers is + ongoing. There will probably be incompatible driver + changes (only affecting drivers run on the runtime system + with SMP support) released as patches for R11B.

+

Potential incompatibility: Previously, specific + driver call-backs were always called from the same thread. + This is not true in the runtime system with SMP + support. Calls to call-backs will be made from different + threads, e.g., two consecutive calls to exactly the same + call-back can be made from two different threads. This + will in most cases not be a problem. All calls + to call-backs are synchronized, i.e., only one call-back + will be called at a time.

+

In the future the default behavior will probably + be the following: Calls to call-backs will, as now, be + made from different threads. Calls to call-backs in the + same driver instance will be synchronized. It + will probably be possible to configure so that all calls + to call-backs in all driver instances of a specific + driver type will be synchronized. It may be possible to + configure so that all calls to call-backs of a driver + instance or a of a specific driver type will be made from + the same thread.

+

Parallelism in the Erlang code executed is a necessity + for the Erlang runtime system to be able to take + advantage of multi-core or multi-processor hardware. + There need to be at least as many Erlang processes + runnable as processor cores for the Erlang runtime system + to be able to take advantage of all processor cores.

+

An Erlang runtime system with SMP support with only one + Erlang process runnable all the time will almost always be + slower than the same Erlang runtime system without SMP + support. This is due to thread synchronization overhead.

+

Known major bottleneck in the Erlang runtime system:

+ + +

Currently the I/O system uses one "big lock", i.e. only + one thread can do I/O at a time (with the exception of + async threads and threads created by users own linked-in + drivers). This is high on the list of things to + optimize. Note, code that does not do I/O can be executed + at the same time as one thread does I/O.

+ + +

Some pitfalls which might cause Erlang programs that work on + the non-SMP runtime system to fail on the SMP runtime + system:

+ + +

A newly spawned process will often begin executing + immediately. Code that expects that the parent process + will be able to execute for a while before the child + process begins executing is likely to fail.

+ + +

High priority processes could previously provide + mutual exclusion (bad programming style) by preventing + normal and low priority processes from being run. High + priority processes cannot be used this way to provide + mutual exclusion.

+ + +

could be used to provide some + kind of temporary mutual exclusion (also bad programming + style). cannot be used to provide + any kind of mutual exclusion.

+ + +

Obscure pitfall, only if a process being traced also + sends normal messages to the tracer:

+   The order between trace messages and normal + messages is undefined. I.e. the order between normal + messages sent from a tracee to a tracer and the trace + messages generated from the same tracee to the same + tracer is undefined. The internal order of normal + messages and the internal order of trace messages will, + of course, be preserved as before.

+ + +

The kernel poll feature is currently not supported by + the runtime system with SMP support. It will probably be + supported in a future release.

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-6006 Aux Id: OTP-6095

+ + +

Linked-in driver modifications.

+ + +

Linked-in drivers must be recompiled.

+ + +

The field in the type + has been removed. The reference count can be accessed + via API functions. For more information see + the man page.

+ + +

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-6095 Aux Id: OTP-6006

+ + +
+
+ +
+ ERTS 5.4.13 + +
+ Fixed Bugs and Malfunctions + + +

Large files (more than 2 GBytes) are now handled on + Solaris 8.

+

Own Id: OTP-5849 Aux Id: seq10157

+ + +

A failing bit syntax construction could fail with the + PREVIOUS exception reason that had occurred in the process + (instead of with ).

+

Own Id: OTP-5911

+ + +

When building OTP, the Kernel application was built in + both the primary and secondary bootstrap steps, which + would cause problems if OTP including its bootstrap is + checked into a version control system (such as CVS). + (Thanks to Sebastian Strollo.)

+

Own Id: OTP-5921

+ + +

and + similar expressions used to crash the emulator instead of + causing a exception. (Thanks to Matthias + Lang.)

+

Own Id: OTP-5933

+ + +

could sometimes crash the emulator + when no heap was needed.

+

Own Id: OTP-5940

+ + +

Execution of match specs could under rare circumstances + cause the emulator to dump core.

+

Execution of match specs could cause memory leaks in the + hybrid emulator.

+

Own Id: OTP-5955

+ + +

A bug in when getting info for a + function in a deleted module resulting in an emulator + crash, has been corrected.

+

Own Id: OTP-5957

+ + +

Different (and old) files in the + ERTS and Erl_Interface applications would cause build + problems on the new Intel-based iMacs. + (Thanks to Sebastion Strollo.)

+

Own Id: OTP-5967

+ + +

pthread header and library mismatch on Linux systems (at + least some SuSE and Debian) with both NPTL and + Linuxthreads libraries installed.

+

Own Id: OTP-5981

+ + +
+ +
+ Improvements and New Features + + +

The driver_set_timer did not change the previous timeout + if called a second time. Now it works as specified, + changing the timeout.

+

Own Id: OTP-5942

+ + +

The undocumented option (for the + module) did not not work correctly when + there were multiple continuation lines. (Thanks to Per + Hedeland.)

+

Own Id: OTP-5945

+ + +

The setuid_socket_wrap program was corrected to work for + C compilers that treat the type as unsigned. + (Thanks to Magnus Henoch.)

+

Own Id: OTP-5946

+ + +
+
+ +
+ ERTS 5.4.12 + +
+ Fixed Bugs and Malfunctions + + +

Fixed a minor build problem on Windows.

+

Own Id: OTP-5819 Aux Id: OTP-5382 OTP-5540 OTP-5577

+ + +

The option for was + broken on Windows.

+

Own Id: OTP-5822

+ + +

If there were user-defined variables in the boot + script, and their values were not provided using the + option, the emulator would refuse to + start with a confusing error message. Corrected to show a + clear, understandable message.

+

The module was modified to not depend + on the module, to make it possible to start + the emulator using a user-defined loader. (Thanks to + Martin Bjorklund.)

+

Own Id: OTP-5828 Aux Id: seq10151

+ + +
+ +
+ Improvements and New Features + + +

The HiPE compiler identifies more leaf functions, + giving slightly faster code.

+

Corrected problems in HiPE's coalescing register + allocating that would cause it to fail when compiling + very large functions (e.g. some of parse modules in the + Megaco application).

+

Own Id: OTP-5853

+ + +
+
+ +
+ ERTS 5.4.11 + +
+ Fixed Bugs and Malfunctions + + +

Timers could sometimes timeout too early. This bug has + now been fixed.

+

Automatic cancellation of timers created by + and + has been + introduced. Timers created with the receiver specified by a + pid, will automatically be cancelled when the receiver + exits. For more information see the man + page.

+

In order to be able to maintain a larger amount of timers + without increasing the maintenance cost, the internal + timer wheel and bif timer table have been enlarged.

+

Also a number of minor bif timer optimizations have been + implemented.

+

Own Id: OTP-5795 Aux Id: OTP-5090, seq8913, seq10139, + OTP-5782

+ + +

hanged if + referred to a process on a non-existing node with the same + nodename as the nodename of node on which the call was made. + This bug has now been fixed.

+

Own Id: OTP-5827

+ + +
+ +
+ Improvements and New Features + + +

By setting Unix environment variables, the priority for + the emulator can be lowered when it is writing crash + dumps and the time allowed for finishing writing a crash + dump can be set to a certain number of seconds. See the + documentation for in the ERTS application. + (Also, a few other previously undocumented environment + variables are now documented.)

+

Own Id: OTP-5818

+ + +

Documentation improvements:

+

- documentation for corrected

+

- command line flag added

+

- command line flags clarifications

+

- clarifications

+

Own Id: OTP-5847

+ + +
+
+ +
+ ERTS 5.4.10 + +
+ Fixed Bugs and Malfunctions + + +

-D_GNU_SOURCE is now always passed on the compile command + line on linux. This in order to ensure that all included + system headers see _GNU_SOURCE defined.

+

_GNU_SOURCE is now also defined on linux in configure + when looking for features.

+

Some minor (harmless) configure bugs were also fixed.

+

Own Id: OTP-5749

+ + +

Some compiler warnings and Dialyzer warnings were + eliminated in the Tools application.

+

When tracing to a port (which does), + there could be fake schedule out/schedule in messages + sent for a process that had exited.

+

Own Id: OTP-5757

+ + +
+ +
+ Improvements and New Features + + +

The BIFs and + has been added.

+

The BIF has been added.

+

Minor bug fix: The exception reason could be changed + to inside nested try/catch constructs if the + BIF was called with an empty + stacktrace. (Calling with an empty + stacktrace is NOT recommended.)

+

Minor bugfix: On Windows, will now + return the documented error reason + if the filename refers to a directory (it used to return + ).

+

The message in the documentation for + , description of + , was corrected.

+

Own Id: OTP-5709 Aux Id: seq10100

+ + +

The previously undocumented and UNSUPPORTED + module has been updated in an incompatible way and many + bugs have been corrected. It is now also documented.

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-5715

+ + +

New socket options and for + platforms that support them (currently only Linux).

+

Own Id: OTP-5756

+ + +

Only the emulator is now linked with termcap library in + order to decrease library dependencies for other otp + programs.

+

Own Id: OTP-5758

+ + +
+
+ +
+ ERTS 5.4.9.2 + +
+ Fixed Bugs and Malfunctions + + +

The native resolver has gotten an control API for + extended debugging and soft restart. It is: +



.

+

Own Id: OTP-5751 Aux Id: EABln25013

+ + +
+
+ +
+ ERTS 5.4.9.1 + +
+ Improvements and New Features + + +

On VxWorks, epmd did not handle file descriptors with + higher numbers than 63. Also, if epmd should get a file + descriptor with a number >= FD_SETSIZE, it will close a + the file descriptor and write a message to the log + (instead of mysteriously fail); the Erlang node that + tried to register will fail with a duplicate_name error + (unfortunately, epmd has no way to indicate to the Erlang + node why the register attempt failed).

+

Own Id: OTP-5716 Aux Id: seq10070

+ + +
+
+ +
+ ERTS 5.4.9 + +
+ Fixed Bugs and Malfunctions + + +

Timezone data is now initialized better. (was a problem + at least on NetBSD 2.0.2) Thanks to Rich Neswold.

+

Own Id: OTP-5621

+ + +

The hybrid-heap emulator ('erl -hybrid') is much more + stable. We have corrected all known bugs that caused it + to dump core while running our test suites.

+

Own Id: OTP-5634

+ + +

Fixed rare memory leaks in when + distributed monitors were removed.

+

Own Id: OTP-5692

+ + +

Processes were sometimes unnecessarily garbage collected + when terminating. These unnecessary garbage collections + have now been eliminated.

+

Own Id: OTP-5693

+ + +
+ +
+ Improvements and New Features + + +

The function will now run in a paged mode if + there are more than 100 processes in the system. (Thanks + to Ulf Wiger.)

+

has + been optimized and does now return exactly the same value + as . Previously + did not include + exiting processes which are included in + .

+

The flag for , which sets the maximum + number of processes allowed to exist at the same, no longer + accepts values higher than 134217727. (You will still + probably run out of memory before you'll be able to reach + that limit.)

+

Own Id: OTP-5645 Aux Id: seq9984

+ + +

The term-building driver functions + and + have been updated:

+

The ERL_DRV_FLOAT type has been added.

+

For the ERL_DRV_BINARY type, the length and offset are + now validated against the length of the driver binary.

+

The ERL_DRV_PID type is now implemented (it was + documented, but not implemented).

+

Own Id: OTP-5674

+ + +
+
+ +
+ ERTS 5.4.8 + +
+ Fixed Bugs and Malfunctions + + +

now allows other Erlang process to run + when a large table is being deleted.

+

Own Id: OTP-5572

+ + +

A bug regarding tcp sockets which results in hanging + has been corrected. To encounter + this bug you needed one process that read from a socket, + one that wrote more date than the reader read out so the + sender got suspended, and then the reader closed the + socket. (Reported and diagnosed by Alexey Shchepin.)

+

Corrected a bug in the (undocumented and unsupported) + option for + (Thanks to Claes Wikstrom and Luke Gorrie.)

+

Updated the documentation regarding the second argument to + , the to receive.

+

Own Id: OTP-5582 Aux Id: seq9839

+ + +

Erlang/OTP will now build on Mac OS X 10.4 "Tiger" (the + problem was that 10.4 has a partially implemented poll() + function that can't handle devices). Also, on Mac OS X + 10.3 "Panther", Erlang/OTP will now use select() instead + of poll() (because poll() on Mac OS X 10.3 is implemented + using select()).

+

Own Id: OTP-5595

+ + +

A bug in the file driver when opening a file in + compressed mode, and the returned allocated pointer from + the compressing library was in very high memory (>= 2GB), + causing e.g. to return + , has been corrected.

+

Own Id: OTP-5618

+ + +
+ +
+ Improvements and New Features + + +

The new fun construct creates a fun that + refers to the latest version of This syntax is + meant to replace tuple funs which have many + problems.

+

The new type test (which may be + used in guards) test whether is a fun that can be + applied with arguments. (Currently, + can also be a tuple fun.)

+

Own Id: OTP-5584

+ + +

In the HiPE application, there's a new experimental + register allocator (optimistic coalescing), and the + linear scan register allocator is now also available on + ppc. Plus lots of cleanups.

+

Minor hybrid heap corrections.

+

The maximum size of a heap used to be artificially + limited so that the size of a heap would fit in 28 bits; + that limitation could cause the emulator to terminate in + a garbage collection even if there still was available + memory. Now the largest heap size for a 32 bit CPU is + 1,699,221,830 bytes. (Thanks to Jesper Wilhelmsson.)

+

Also removed the undocumented emulator option.

+

Own Id: OTP-5596

+ + +
+
+ +
+ ERTS 5.4.7 + +
+ Fixed Bugs and Malfunctions + + +

could close unexpectedly on Linux systems. + Also, output from the emulator could be lost. Corrected.

+

Own Id: OTP-5561

+ + +
+ +
+ Improvements and New Features + + +

The option for + is now also supported on Linux.

+

Own Id: OTP-5532 Aux Id: seq9813

+ + +

The last known window size/position is now saved + correctly when is stopped with the window + minimized. A problem with the placement not being saved if + the emulator is halted or stopped from the JCL menu has also + been fixed.

+

Own Id: OTP-5544 Aux Id: OTP-5522

+ + +
+
+ +
+ ERTS 5.4.6 + +
+ Fixed Bugs and Malfunctions + + +

Some math libraries do not always throw floating-point + exceptions on errors. In order to be able to use these + libraries, floating-point errors are now more thoroughly + checked.

+

Misc floating-point fixes for Linux and MacOSX.

+

Own Id: OTP-5467

+ + +

An internal buffer was sometimes not cleared which caused + garbage to appear in error messages sent to the error + logger.

+

was sometimes clobbered which caused erroneous + error reports about errors.

+

Only emulators on unix platforms were affected by these + bugs.

+

Own Id: OTP-5492

+ + +

The ethread library now works on OpenBSD.

+

Own Id: OTP-5515

+ + +

Corrected a bug in the (undocumented and unsupported) + option for . + (Thanks to Claes Wikstrom and Luke Gorrie.)

+

Own Id: OTP-5519

+ + +
+ +
+ Improvements and New Features + + +

could cause the emulator to crash + when given invalid pids or funs.

+

Own Id: OTP-5484 Aux Id: seq9801

+ + +

Some more stability problems were fixed in the + hybrid-heap emulator.

+

Own Id: OTP-5489

+ + +

After was closed with the window minimized, it + was not possible to restart with an open + window. A temporary solution has so far been implemented + that restores the initial window settings every time + is started.

+

Own Id: OTP-5522

+ + +
+
+ +
+ ERTS 5.4.5 + +
+ Fixed Bugs and Malfunctions + + +

If a process had node links (created by + ), executing + for that process would + crash the emulator.

+

Own Id: OTP-5420

+ + +

Minor corrections to the help text printed by . The documentation for was also + slightly updated.

+

Own Id: OTP-5428

+ + +

32-bit words were used for offsets in the garbage + collector. This caused the emulator to crash on 64-bit + machines when heaps were moved more than 4 GB during + garbage collection.

+

Own Id: OTP-5430

+ + +

failed to load if optimization was + explicitly turned off.

+

Own Id: OTP-5448

+ + +

If there was a call to from any loaded + module, the returned by would + always include (even though + if was not defined).

+

Own Id: OTP-5450 Aux Id: seq9722

+ + +
+ +
+ Improvements and New Features + + +

The option for the flag has been + introduced which makes it possible to use Ctrl-C + (Ctrl-Break on Windows) to interrupt the shell process + rather than to invoke the emulator break handler. All new + options are also supported on Windows + () as of now. Furthermore, Ctrl-C on Windows has + now been reserved for copying text (what Ctrl-Ins was used + for previously). Ctrl-Break should be used for break + handling. Lastly, the documentation of the system flags has + been updated.

+

Own Id: OTP-5388

+ + +
+
+ +
+ ERTS 5.4.4 + +
+ Fixed Bugs and Malfunctions + + +

The function can now be used in + match specifications and is recognized by + and . This + addition is part of the work to "harmonize" match + specification guards with Erlang guards.

+

Own Id: OTP-5297 Aux Id: OTP-4927

+ + +

The BIF would return even if + the second argument was not a pid for living process. + Corrected to cause an exception.

+

Own Id: OTP-5324 Aux Id: seq9698

+ + +

In the 'bag' type of ets tables, elements having the same + key were supposed to be order in insertion order. The + would be wrong if a rehash occurred.

+

Own Id: OTP-5340 Aux Id: seq9704

+ + +

Linked in drivers in the Crypto and Asn1 applications + are now compiled with the and + switches on unix when the emulator has + thread support enabled.

+

Linked in drivers on MacOSX are not compiled with the + undocumented switch anymore. Thanks to + Sean Hinde who sent us a patch.

+

Linked in driver in Crypto, and port programs in SSL, now + compiles on OSF1.

+

Minor makefile improvements in Runtime_Tools.

+

Own Id: OTP-5346

+ + +

Fixed a bug in the hybrid heap in distributed send + operations.

+

Own Id: OTP-5361

+ + +

A BIF has been added. See the manual + for details. It is intended for internal system programming + only, advanced error handling.

+

Own Id: OTP-5376 Aux Id: OTP-5257

+ + +

Mikael Pettersson (HiPE) corrected a few bugs in the + emulator that caused problems when compiled with the + experimental gcc-4.0.0.

+

Own Id: OTP-5386

+ + +
+ +
+ Improvements and New Features + + +

Minor update of the internal documentation of + the protocol.

+

The listen port of has now been registered at + IANA: + http://www.iana.org/assignments/port-numbers.

+

Own Id: OTP-5234

+ + +

now works on Mac OS X and FreeBSD.

+

Own Id: OTP-5384

+ + +

A few bugs were corrected in the HiPE application.

+

Own Id: OTP-5385

+ + +
+
+ +
+ ERTS 5.4.3 + +
+ Fixed Bugs and Malfunctions + + +

Font and color preferences for now can be + saved even after the first time you run . + The window position and size is also saved. Patch from + James Hague who did all the hard work.

+

Own Id: OTP-5250

+ + +

OTP archive libraries, e.g. the + library, on MacOSX could not be used without first + rerunning on them. This bug has now been + fixed.

+

Own Id: OTP-5274

+ + +

Bugs in and on + 64-bit platforms have been fixed.

+

Own Id: OTP-5292

+ + +
+ +
+ Improvements and New Features + + +

Corrected a crash in the 64-bits emulator.

+

Corrected a problem in the hybrid heap emulator.

+

In the chapter about the abstract format in the ERTS User's + Guide, updated the last section about how the abstract + format is stored in BEAM files.

+

Own Id: OTP-5262

+ + +

The maximum number of concurrent threads in the internal + ethread thread package has been limited to 2048.

+

Own Id: OTP-5280

+ + +
+
+ +
+ ERTS 5.4.2.1 + +
+ Improvements and New Features + + +

If Erlang/OTP was installed in a short directory name, + such as , the emulator would not + start.

+

Own Id: OTP-5254

+ + +
+
+ +
+ ERTS 5.4.2 + +
+ Fixed Bugs and Malfunctions + + +

If one used and on a + non-fixed ETS table and deleted objects simultaneously, + the emulator could crash. Note that the result of such + simultaneous operations on tables that are not in a fixed + state is still undefined, but the emulator crash is, + needless to say, fixed.

+

Own Id: OTP-5209 Aux Id: seq9198

+ + +

Arithmetic with big numbers could crash the emulator.

+

The HiPE native code compiler and run-time code in the + emulator has been updated. (Note: Native code is still + not supported.)

+

Eliminated a few bugs that could crash the hybrid emulator + (which is not supported).

+

Own Id: OTP-5233 Aux Id: seq9587

+ + +
+
+ +
+ ERTS 5.4.1 + +
+ Fixed Bugs and Malfunctions + + +

The ethread library was unnecessarily rebuilt multiple + times during the build process, also a debug version of + the library was build during the install phase. These + unnecessary builds have now been removed. Note, the + content of the installed Erlang/OTP system is not + effected at all by this change.

+

Own Id: OTP-5203

+ + +

The emulator could fail to clear the memory segment + cache. This could potentially cause memory allocation to + unnecessarily fail when memory usage was close to its + maximum. This bug has now been fixed.

+

Own Id: OTP-5211

+ + +

std_alloc (std short for standard) was sometimes called + def_alloc (def short for default). std_alloc is now + everywhere referred to as std_alloc.

+

Own Id: OTP-5216

+ + +

A documentation bug has been corrected in + the documentation. It was stated that + some of the memory allocators present were by default + disabled. This is true for Erlang/OTP R9C, but is not true + for Erlang/OTP R10B. In R10B all memory allocators present + are enabled by default.

+

Own Id: OTP-5217

+ + +
+ +
+ Improvements and New Features + + +

The emulator now close all open files and sockets + immediately after receiving an USR1 signal. This causes + the emulator to unregister at as early as + possible.

+

Own Id: OTP-5221 Aux Id: OTP-4985, seq9514

+ + +

Try/catch support in the emulator slightly updated.

+

Own Id: OTP-5229

+ + +
+
+ + diff --git a/erts/doc/src/notes_history.xml b/erts/doc/src/notes_history.xml new file mode 100644 index 0000000000..cc3b938c86 --- /dev/null +++ b/erts/doc/src/notes_history.xml @@ -0,0 +1,503 @@ + + + + +
+ + 20062009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + ERTS Release Notes History + otp_appnotes + nil + nil + nil + notes_history.xml +
+ +
+ ERTS 5.4 + +
+ Fixed Bugs and Malfunctions + + +

The BIF has been added to + the run-time system. It checks that is a tuple + whose first element is the atom No check + is made of the size of the tuple (because the run-time + system doesn't know anything about records).

+

Note that normally the compiler translates calls to + to code that also verify the size of the + tuple, in addition to verifying the first element. The + BIF version will be used is applied or + if the second argument is not a literal atom (e.g. a + variable or another term type, in which case the BIF will + generate a exception).

+

Own Id: OTP-4812

+ + +

Guards of mach specifications are corrected to resemble + the semantics of guards in real code more closely. The + implementation now corresponds to the documentation in + ERTS User's Guide. The following things are corrected:

+ + Guard semantics was wrong when it came to logical + operators and exceptions. + + evaluated to with bound to an + integer. + Unary + and - was not implemented. + Calling operators as Bif's was not supported by + ( etc). + Old typetests (like instead of + was not supported by + . + Semicolon (;) in guards was not supported by + . + +

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-4927

+ + +

A potential initialization failure when using threads and + elib_malloc has been removed.

+

Own Id: OTP-5125

+ + +

Several problems in the 64-bit emulator has been + corrected. For instance, the emulator could crash while + running the Debugger.

+

Own Id: OTP-5146

+ + +

The match spec parse transform no + longer accepts the and + constructs in guards for consistency with the standard + Erlang language. A future release of Erlang/OTP may allow + and in guards.

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-5149

+ + +

In rare circumstances in a process that has caught + exceptions and uses funs, the process would be killed + when changing code because the code server would think + that the process still held references to the funs.

+

Own Id: OTP-5153

+ + +

no longer sends any + monitoring messages to the system monitor process from + itself. This behavior is more consistent with other trace + functionality.

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-5183

+ + +
+ +
+ Improvements and New Features + + +

The documentation stated that + could return or that was wrong, + it always returns .

+

Own Id: OTP-4830

+ + +

The unary '+' operator has been changed to throw an + exception if its argument is not numeric (or + fail in a guard). It used its argument unchanged whatever + the type. Given the new meaning, unary '+' can now be + used to test whether a term is numeric.

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-4928

+ + +

Process identifiers and port identifiers have been + made more unique. Previously 18 bits were used as id in + the internal representation of process and port + identifiers. Now 28 bits are used.

+

The maximum limit on the number of concurrently existing + processes due to the representation of pids has been + increased to 268435456 processes. The same is true for + ports. This limit will at least on a 32-bit architecture be + impossible to reach due to memory shortage.

+

NOTE: By default, the , and the + , , and + libraries are now only guaranteed to be compatible with + other Erlang/OTP components from the same release. It is + possible to set each component in compatibility mode of + an earlier release, though. See the documentation for + respective component on how to set it in compatibility + mode.

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-4968 Aux Id: OTP-4196

+ + +

A new internal thread library for the ERTS has been + added.

+

Own Id: OTP-5048

+ + +

The system's performance could degrade severely if one + process held numerous links or monitors. The issue is + resolved.

+

Own Id: OTP-5079

+ + +

A new function, , has been added.

+

Own Id: OTP-5081 Aux Id: OTP-5136

+ + +

A new function, , has been added.

+

Own Id: OTP-5136 Aux Id: OTP-5081

+ + +

The exception code for calling a fun with wrong number of + arguments has been changed from simply to + .

+

*** POTENTIAL INCOMPATIBILITY ***

+

Own Id: OTP-5139

+ + +

The long-awaited ... construction + is included in this release. However, its use in + production code is not yet supported as there are several + known cases of legal code crashing the compiler. We plan + to release a patch to the compiler (including the + documentation) and at that time ... + will be supported.

+

Own Id: OTP-5150

+ + +
+
+ +
+ ERTS 5.3.6.6 + +
+ Fixed Bugs and Malfunctions + + +

A bug that caused an emulator crash when using system + monitor of long GC has been fixed.

+

Own Id: OTP-5123

+ + +
+
+ +
+ ERTS 5.3.6.5 + +
+ Fixed Bugs and Malfunctions + + +

and + sometimes reported erroneous values. This bug has now been + fixed.

+

Own Id: OTP-5115 Aux Id: seq9063

+ + +

There is now a packet size limit option for + sockets. See the manual for .

+

The ASN.1 BER packet decoding for sockets + can now decode indefinite length packets.

+

Own Id: OTP-5128

+ + +
+ +
+ Improvements and New Features + + +

Port index was unnecessarily incremented by port table + size when port table got full. This unnecessary increment + has now been removed.

+

Own Id: OTP-5119

+ + +
+
+ +
+ ERTS 5.3.6.3 + +
+ Fixed Bugs and Malfunctions + + +

Resolved a build problem on Mac OS 10.3 ("Panther"). + Because of a conflict with the zlib sources included in + the Erlang run-time system and the zlib library included + in Panther, linking would fail.

+

Minor optimization on all Unix systems: caching the + system name returned from the uname() system call. + (Thanks to David N. Welton.)

+

Own Id: OTP-5069

+ + +
+ +
+ Improvements and New Features + + +

The ability to set system wide options for TCP sockets is + added through the kernel application variables + and + , see the + manual page for details.

+

Own Id: OTP-5080

+ + +
+
+ +
+ ERTS 5.3.6.2 + +
+ Fixed Bugs and Malfunctions + + +

A few portability enhancements for the R9C-1 Open Source + release: The installer for Windows can now be built with + NSIS 2.0 (as well as with the NSIS 2.0b3). The driver + header files updated to allowed drivers to be built which + the MinGW compiler on Windows. Minor portability + enhancement in .

+

Own Id: OTP-4789

+ + +

Conversion of extremely small floating point numbers in + the external format (distribution) could sometimes fail + leading to unexpected closing of distribution channels, + i.e. generating nodedowns for healthy nodes.

+

Own Id: OTP-5026 Aux Id: seq8631 EABln12478

+ + +
+
+ +
+ ERTS 5.3.6.1 + +
+ Fixed Bugs and Malfunctions + + +

Conversion of extremely small floating point numbers in + the external format (distribution) could sometimes fail + leading to unexpected closing of distribution channels, + i.e. generating nodedowns for healthy nodes.

+

Own Id: OTP-5026 Aux Id: seq8631 EABln12478

+ + +
+ +
+ Improvements and New Features + + +

Remote spawn on a nonreachable node now gives warning + instead of error in the error_log.

+

Own Id: OTP-5030 Aux Id: seq8663]

+ + +
+ +
+ Known Bugs and Problems + + +

Emulator with elib_malloc enabled could hang when many + I/O threads were in use.

+

Own Id: OTP-5028 Aux Id: EABln13041, EABln12253

+ + +
+
+ +
+ ERTS 5.3.6 + +
+ Fixed Bugs and Malfunctions + + +

Distributed monitoring in combination with nodes + restarting did not behave correctly in rare + circumstances.

+

Own Id: OTP-4914

+ + +

A module containing code similar to + could not be loaded.

+

Own Id: OTP-4963 Aux Id: seq8344

+ + +

Problems fixed in : + can now be opened. Opening a FIFO will now return an error + instead of hanging the emulator. The documentation has been + updated to point out that returns + the error code when the pathname is not a + regular file (the pathname is not necessarily a directory).

+

Own Id: OTP-4992

+ + +
+ +
+ Improvements and New Features + + +

The Solaris kernel poll feature was changed from a + compile time option to a runtime option. The kernel poll + feature can be enabled, by passing the command-line + argument to an emulator (see ) + that have kernel poll support, i.e. an emulator for + Solaris 8. By default the kernel poll feature is disabled.

+

Own Id: OTP-4979 Aux Id: seq8478

+ + +

Before the Erlang emulator writes an + file (for any reason), it will close all open files and + sockets.

+

Own Id: OTP-4985 Aux Id: EABln10730, EABln11277, + EABln11279

+ + +

The switch has been added to disable time + correction in the runtime system, this should be used on + systems where one is certain no dramatic wall clock time + changes will occur and the time correction algorithm is too + costly (namely very fast Linux systems where loads of + are executed).

+

Own Id: OTP-4986

+ + +

The BIFs now take a flag + that allows changing an existing + process's minimum heap size. The actual size will only be + changed when the next garbage collection occurs.

+

Own Id: OTP-4991 Aux Id: seq8515, OTP-4987

+ + +
+
+ +
+ ERTS 5.3.4 + +
+ Improvements and New Features + + +

A possibility to make distribution messages be qued up + during running of erlang code, so that larger packages is + sent over the network is added.

+

Own Id: OTP-4916

+ + +

When code loading failed it was impossible to know + exactly what caused it, only + would be reported. Now the primitive loader lets the + error logger print an error report if a file operation + fails. All file errors except and + are reported this way.

+

Own Id: OTP-4925 Aux Id: OTP-4952

+ + +
+
+ +
+ ERTS 5.3.3 + +
+ Fixed Bugs and Malfunctions + + +

The driver for dynamically linked in drivers has been + fixed to delete loaded drivers when its Erlang server + dies. The Erlang server has also been updated to improve + the start-on-demand behaviour.

+

Own Id: OTP-4876 Aux Id: OTP-4855 seq8272

+ + +

does no longer generate an ERROR + REPORT to the error logger when the name already is + registered. If the name is already registered the process + function will crash with and that is + enough. It is up to the caller to decide if it is an + error that the name is already registered.

+

Own Id: OTP-4892

+ + +

When using , + and the GC time exceeded 1 second, it sometimes erroneously + showed up as about 4300 seconds. This bug has now been + corrected.

+

Own Id: OTP-4903 Aux Id: seq8379

+ + +
+ +
+ Improvements and New Features + + +

Starting Erlang with the flag (to ignore ^C), now + also disables the quit ('q') option in the JCL menu.

+

Own Id: OTP-4897

+ + +
+
+ +
+ ERTS 5.3.2 + +
+ Improvements and New Features + + +

The elib_malloc alternative dynamic memory allocator has + been improved to use an address order best fit strategy. + The instrumented emulator has been improved to be able to + catch memory allocations done by external libraries. The + emulator flag (stands for "relocate") makes + updates always result in an object relocation, + which significantly lessens the memory fragmentation in + certain systems. The bif can + now be called with the argument + and will return if the emulator flag + is in effect, otherwise.

+

Own Id: OTP-4838 Aux Id: seq8156

+ + +
+
+ + diff --git a/erts/doc/src/part.xml b/erts/doc/src/part.xml new file mode 100644 index 0000000000..e27b722721 --- /dev/null +++ b/erts/doc/src/part.xml @@ -0,0 +1,44 @@ + + + + +
+ + 19962009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + ERTS User's Guide + Catrin Granbom + + 1997-05-15 + 4.5.2 + part.xml +
+ +

The Erlang Runtime System Application ERTS.

+ + + + + + + + + + + + diff --git a/erts/doc/src/part_notes.xml b/erts/doc/src/part_notes.xml new file mode 100644 index 0000000000..4f183999e6 --- /dev/null +++ b/erts/doc/src/part_notes.xml @@ -0,0 +1,37 @@ + + + + +
+ + 20042009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + ERTS Release Notes + + + 2004-09-07 + 1.0 +
+ +

The Erlang Runtime System application ERTS.

+

For information about older versions, see + Release Notes History.

+ + + + diff --git a/erts/doc/src/part_notes_history.xml b/erts/doc/src/part_notes_history.xml new file mode 100644 index 0000000000..1b9bcca773 --- /dev/null +++ b/erts/doc/src/part_notes_history.xml @@ -0,0 +1,35 @@ + + + + +
+ + 20062009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + ERTS Release Notes History + + + + +
+ +

The Erlang Runtime System application ERTS.

+ + + + diff --git a/erts/doc/src/ref_man.xml b/erts/doc/src/ref_man.xml new file mode 100644 index 0000000000..2042cf28bd --- /dev/null +++ b/erts/doc/src/ref_man.xml @@ -0,0 +1,60 @@ + + + + +
+ + 19962009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + ERTS Reference Manual + Lars Thorsén + + 1997-05-15 + 4.5.2 + application.xml +
+ +

The Erlang Runtime System Application ERTS.

+ +

By default, the is only guaranteed to be compatible + with other Erlang/OTP components from the same release as + the itself. See the documentation of the system flag + +R on how to communicate + with Erlang/OTP components from earlier releases.

+ + + + + + + + + + + + + + + + + + + + + + diff --git a/erts/doc/src/run_erl.xml b/erts/doc/src/run_erl.xml new file mode 100644 index 0000000000..7bf7f559c5 --- /dev/null +++ b/erts/doc/src/run_erl.xml @@ -0,0 +1,155 @@ + + + + +
+ + 19992009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + run_erl + Kent Boortz + + + + + 99-12-15 + + run_erl.xml +
+ run_erl + Redirect Erlang input and output streams on Solaris® + +

This describes the program specific to + Solaris/Linux. This program redirect the standard input and standard + output streams so that all output can be logged. It also let the + program connect to the Erlang console making it + possible to monitor and debug an embedded system remotely.

+

You can read more about the use in the .

+ + + + run_erl [-daemon] pipe_dir/ log_dir "exec command [command_arguments]" + Start the Erlang emulator without attached terminal + +

The program arguments are:

+ + -daemon + This option is highly recommended. It makes run_erl run in + the background completely detached from any controlling + terminal and the command returns to the caller immediately. + Without this option, run_erl must be started using several + tricks in the shell to detach it completely from the + terminal in use when starting it. The option must be the + first argument to run_erl on the command line. + pipe_dir + This is where to put the named pipe, usually + . It shall be suffixed by a (slash), + i.e. not , but . + log_dir + This is where the log files are written. There will be one + log file, that log progress and + warnings from the program itself and there + will be up to five log files at maximum 100KB each (both + number of logs and sizes can be + changed by environment variables, see below) with + the content of the standard streams from and to the + command. When the logs are full will delete + and reuse the oldest log file. + "exec command [command_arguments]" + In the third argument is the to execute + where everything written to stdin and stdout is logged to + . + + + + + +
+ Notes concerning the log files +

While running, run_erl (as stated earlier) sends all output, + uninterpreted, to a log file. The file is called + , where N is a number. When the log is "full", + default after 100KB, run_erl starts to log in file + , until N reaches a certain number (default + 5), where after N starts at 1 again and the oldest files start + getting overwritten. If no output comes from the erlang shell, but + the erlang machine still seems to be alive, an "ALIVE" message is + written to the log, it is a timestamp and is written, by default, + after 15 minutes of inactivity. Also, if output from erlang is + logged but it's been more than 5 minutes (default) since last time + we got anything from erlang, a timestamp is written in the + log. The "ALIVE" messages look like this:

+ + ]]> +

while the other timestamps look like this:

+ + ]]> +

The is the date and time the message is + written, default in local time (can be changed to GMT if one wants + to) and is formatted with the ANSI-C function + using the format string , which produces + messages on the line of , this can be changed, see below.

+
+ +
+ Environment variables +

The following environment variables are recognized by run_erl + and change the logging behavior. Also see the notes above to get + more info on how the log behaves.

+ + RUN_ERL_LOG_ALIVE_MINUTES + How long to wait for output (in minutes) before writing an + "ALIVE" message to the log. Default is 15, can never be less + than 1. + RUN_ERL_LOG_ACTIVITY_MINUTES + How long erlang need to be inactive before output will be + preceded with a timestamp. Default is + RUN_ERL_LOG_ALIVE_MINUTES div 3, but never less than 1. + RUN_ERL_LOG_ALIVE_FORMAT + Specifies another format string to be used in the strftime + C library call. i.e specifying this to + will give log messages with timestamps looking like + etc. See the documentation + for the C library function strftime for more + information. Default is . + RUN_ERL_LOG_ALIVE_IN_UTC + If set to anything else than "0", it will make all + times displayed by run_erl to be in UTC (GMT,CET,MET, without + DST), rather than + in local time. This does not affect data coming from erlang, + only the logs output directly by run_erl. The application + can be modified accordingly by setting the erlang + application variable to . + RUN_ERL_LOG_GENERATIONS + Controls the number of log files written before older + files are being reused. Default is 5, minimum is 2, maximum is 1000. + RUN_ERL_LOG_MAXSIZE + The size (in bytes) of a log file before switching to a + new log file. Default is 100000, minimum is 1000 and maximum is + approximately 2^30. + +
+ +
+ SEE ALSO +

start(1), start_erl(1)

+
+ + diff --git a/erts/doc/src/start.xml b/erts/doc/src/start.xml new file mode 100644 index 0000000000..5dc33deb2a --- /dev/null +++ b/erts/doc/src/start.xml @@ -0,0 +1,64 @@ + + + + +
+ + 19992009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + start + Kent Boortz + + + + + 99-12-15 + + start.xml +
+ start + OTP start script example for Unix + +

This describes the script that is an example script on + how to startup the Erlang system in embedded mode on Unix.

+

You can read more about the use in the .

+ + + + start [ data_file ] + This is an example script on how to startup the Erlang system in embedded mode on Unix. + +

In the example there is one argument

+ + data_file + Optional, specifies what file + to use. + +

There is also an environment variable that can + be set prior to calling this example that set the directory + where to find the release files.

+ + + + +
+ SEE ALSO +

run_erl(1), start_erl(1)

+
+ + diff --git a/erts/doc/src/start_erl.xml b/erts/doc/src/start_erl.xml new file mode 100644 index 0000000000..21cc901f52 --- /dev/null +++ b/erts/doc/src/start_erl.xml @@ -0,0 +1,126 @@ + + + + +
+ + 19982009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + start_erl + Patrik Nyblom + + + + + 98-08-05 + + start_erl.xml +
+ start_erl + Start Erlang for embedded systems on Windows NT® + +

This describes the program specific to Windows + NT. Although there exists programs with the same name on other + platforms, their functionality is not the same.

+

The program is distributed both in compiled + form (under <Erlang root>\\erts-<version>\\bin) and + in source form (under <Erlang + root>\\erts-<version>\\src). + The purpose of the source code is to make it possible to easily + customize the program for local needs, such as cyclic restart + detection etc. There is also a "make"-file, written for the + program distributed with Microsoft® Visual + C++®. The program can however be compiled with + any Win32 C compiler (possibly with slight modifications).

+

The purpose of the program is to aid release handling on + Windows NT®. The program should be called by the + program, read up the release data file + start_erl.data and start Erlang. Certain options to start_erl + are added and removed by the release handler during upgrade with + emulator restart (more specifically the option).

+ + + + start_erl [<erl options>] ++ [<start_erl options>] + Start the Erlang emulator with the correct release data + +

The program in its original form + recognizes the following options:

+ + ++ + Mandatory, delimits start_erl options from normal Erlang + options. Everything on the command line before the + is interpreted as options to be sent to the + program. Everything after is + interpreted as options to itself. + -reldir <release root> + Mandatory if the environment variable is not + specified. Tells start_erl where the root of the + release tree is placed in the file-system + (like <Erlang root>\\releases). The + file is expected to be placed in + this directory (if not otherwise specified). + -data <data file name> + Optional, specifies another data file than start_erl.data + in the <release root>. It is specified relative to the + <release root> or absolute (including drive letter + etc.). This option is used by the release handler during + upgrade and should not be used during normal + operation. The release data file should not normally be + named differently. + -bootflags <boot flags file name> + Optional, specifies a file name relative to actual release + directory (that is the subdirectory of <release + root> where the file etc. are placed). + The contents of this file is appended to the command line + when Erlang is started. This makes it easy to start the + emulator with different options for different releases. + + + + + +
+ NOTES +

As the source code is distributed, it can easily be modified to + accept other options. The program must still accept the + option with the semantics described above for the + release handler to work correctly.

+

The Erlang emulator is found by examining the registry keys for + the emulator version specified in the release data file. The new + emulator needs to be properly installed before the upgrade for + this to work.

+

Although the program is located together with files specific to + emulator version, it is not expected to be specific to the + emulator version. The release handler does not change the + option to during emulator restart. + Place the (possibly customized) program so that + it is not overwritten during upgrade.

+

The program's default options are not + sufficient for release handling. The machine + starts should be specified as the program and + the arguments should contain the followed by desired + options.

+
+ +
+ SEE ALSO +

erlsrv(1), release_handler(3)

+
+ + diff --git a/erts/doc/src/tty.xml b/erts/doc/src/tty.xml new file mode 100644 index 0000000000..23694e5965 --- /dev/null +++ b/erts/doc/src/tty.xml @@ -0,0 +1,137 @@ + + + + +
+ + 19962009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + tty - A command line interface + ETX/B/SFP C. Granbom + + + EPK/TE (K. Boortz) + + 1996-11-01 + A + tty.xml +
+

is a simple command line interface program where keystrokes are collected and interpreted. Completed lines are sent to the shell for interpretation. There is a simple history mechanism, which saves previous lines. These can be edited before sending them to the shell. + is started when Erlang is started with the command:

+

erl

+

operates in one of two modes:

+ + +

normal mode, in which lines of text can be edited and sent to the shell.

+ + +

shell break mode, which allows the user to kill the current shell, start multiple shells etc. Shell break mode is started by typing Control G.

+ + + +
+ Normal Mode +

In normal mode keystrokes from the user are collected and interpreted by . Most of the emacs line editing commands are supported. The following is a complete list of the supported line editing commands.

+

Note:\011The notation means pressing the control key and the letter simultaneously. means pressing the key followed by the letter . +

+ + + Key Sequence + Function + + + C-a + Beginning of line + + + C-b + Backward character + + + M-b + Backward word + + + C-d + Delete character + + + M-d + Delete word + + + C-e + End of line + + + C-f + Forward character + + + M-f + Forward word + + + C-g + Enter shell break mode + + + C-k + Kill line + + + C-l + Redraw line + + + C-n + Fetch next line from the history buffer + + + C-p + Fetch previous line from the history buffer + + + C-t + Transpose characters + + + C-y + Insert previously killed text + + tty text editing +
+
+ +
+ Shell Break Mode +

tty enters shell break mode when you type Control G. In this mode you can:

+ + +

Kill or suspend the current shell

+ + +

Connect to a suspended shell

+ + +

Start a new shell

+ + +
+ + diff --git a/erts/doc/src/werl.xml b/erts/doc/src/werl.xml new file mode 100644 index 0000000000..1494d91da8 --- /dev/null +++ b/erts/doc/src/werl.xml @@ -0,0 +1,88 @@ + + + + +
+ + 19982009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + werl + Björn Gustavsson + Bjarne Däcker + 1 + Bjarne Däcker + + 98-01-26 + A + werl.xml +
+ werl + The Erlang Emulator + +

On Windows, the preferred way to start the Erlang system for interactive use is:

+

]]>

+ +

This will start Erlang in its own window, with fully + functioning command-line editing and scrollbars. All flags + except work as they do for + the erl command.

+ +

Ctrl-C is reserved for copying text to the clipboard (Ctrl-V to paste). + To interrupt the runtime system or the shell process (depending on what + has been specified with the +B system flag), you should use Ctrl-Break.

+

In cases where you want to redirect standard input and/or + standard output or use Erlang in a pipeline, the werl is + not suitable, and the erl program should be used instead.

+ +

The werl window is in many ways modelled after the xterm + window present on other platforms, as the xterm model + fits well with line oriented command based interaction. This + means that selecting text is line oriented rather than rectangle + oriented.

+ +

To select text in the werl window , simply press and hold + the left mouse button and drag the mouse over the text you want + to select. If the selection crosses line boundaries, the + selected text will consist of complete lines where applicable + (just like in a word processor). To select more text than fits + in the window, start by selecting a small portion in the + beginning of the text you want, then use the scrollbar + to view the end of the desired selection, point to it and press + the right mouse-button. The whole area between your + first selection and the point where you right-clicked will be + included in the selection.

+ +

The selected text is copied to the clipboard by either + pressing Ctrl-C, using the menu or pressing the copy + button in the toolbar.

+ +

Pasted text is always inserted at the current prompt position + and will be interpreted by Erlang as usual keyboard input.

+ +

Previous command lines can be retrieved by pressing the Up + arrow or by pressing Ctrl-P. There is also a drop + down box in the toolbar containing the command + history. Selecting a command in the drop down box will insert it + at the prompt, just as if you used the keyboard to retrieve the + command.

+ +

Closing the werl window will stop the Erlang emulator.

+ + + + diff --git a/erts/doc/src/zlib.xml b/erts/doc/src/zlib.xml new file mode 100644 index 0000000000..9f39ac657a --- /dev/null +++ b/erts/doc/src/zlib.xml @@ -0,0 +1,606 @@ + + + + +
+ + 20052009 + Ericsson AB. All Rights Reserved. + + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + + + zlib + + + + + zlib.xml +
+ zlib + Zlib Compression interface. + +

The zlib module provides an API for the zlib library + (http://www.zlib.org). + It is used to compress and decompress data. The + data format is described by RFCs 1950 to 1952.

+

A typical (compress) usage looks like:

+ 
+Z = zlib:open(),
+ok = zlib:deflateInit(Z,default),
+
+Compress = fun(end_of_data, _Cont) -> [];
+              (Data, Cont) ->
+                 [zlib:deflate(Z, Data)|Cont(Read(),Cont)]
+           end,
+Compressed = Compress(Read(),Compress),
+Last = zlib:deflate(Z, [], finish),
+ok = zlib:deflateEnd(Z),
+zlib:close(Z),
+list_to_binary([Compressed|Last])
+

In all functions errors, {'EXIT',{Reason,Backtrace}}, + might be thrown, where Reason describes the + error. Typical reasons are:

+ + badarg + +

Bad argument

+ + data_error + +

The data contains errors

+ + stream_error + +

Inconsistent stream state

+ + einval + +

Bad value or wrong function called

+ + {need_dictionary,Adler32} + +

See inflate/2

+ + + + +
+ DATA TYPES + +iodata = iolist() | binary() + +iolist = [char() | binary() | iolist()] + a binary is allowed as the tail of the list + +zstream = a zlib stream, see open/0 +
+ + + open() -> Z + Open a stream and return a stream reference + + Z = zstream() + + +

Open a zlib stream.

+ + + + close(Z) -> ok + Close a stream + + Z = zstream() + + +

Closes the stream referenced by Z.

+ + + + deflateInit(Z) -> ok + Initialize a session for compression + + Z = zstream() + + +

Same as zlib:deflateInit(Z, default).

+ + + + deflateInit(Z, Level) -> ok + Initialize a session for compression + + Z = zstream() + Level = none | default | best_speed | best_compression | 0..9 + + +

Initialize a zlib stream for compression.

+

Level decides the compression level to be used, 0 + (none), gives no compression at all, 1 + (best_speed) gives best speed and 9 + (best_compression) gives best compression.

+ + + + deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) -> ok + Initialize a session for compression + + Z = zstream() + Level = none | default | best_speed | best_compression | 0..9 + Method = deflated + WindowBits = 9..15|-9..-15 + MemLevel = 1..9 + Strategy = default|filtered|huffman_only + + +

Initiates a zlib stream for compression.

+

The Level parameter decides the compression level to be + used, 0 (none), gives no compression at all, 1 + (best_speed) gives best speed and 9 + (best_compression) gives best compression.

+

The Method parameter decides which compression method to use, + currently the only supported method is deflated.

+

The WindowBits parameter is the base two logarithm + of the window size (the size of the history buffer). It + should be in the range 9 through 15. Larger values + of this parameter result in better compression at the + expense of memory usage. The default value is 15 if + deflateInit/2. A negative WindowBits + value suppresses the zlib header (and checksum) from the + stream. Note that the zlib source mentions this only as a + undocumented feature.

+

The MemLevel parameter specifies how much memory + should be allocated for the internal compression + state. MemLevel=1 uses minimum memory but is slow and + reduces compression ratio; MemLevel=9 uses maximum + memory for optimal speed. The default value is 8.

+

The Strategy parameter is used to tune the + compression algorithm. Use the value default for + normal data, filtered for data produced by a filter + (or predictor), or huffman_only to force Huffman + encoding only (no string match). Filtered data consists + mostly of small values with a somewhat random + distribution. In this case, the compression algorithm is + tuned to compress them better. The effect of + filteredis to force more Huffman coding and less + string matching; it is somewhat intermediate between + default and huffman_only. The Strategy + parameter only affects the compression ratio but not the + correctness of the compressed output even if it is not set + appropriately.

+ + + + deflate(Z, Data) -> Compressed + Compress data + + Z = zstream() + Data = iodata() + Compressed = iolist() + + +

Same as deflate(Z, Data, none).

+ + + + deflate(Z, Data, Flush) -> + Compress data + + Z = zstream() + Data = iodata() + Flush = none | sync | full | finish + Compressed = iolist() + + +

deflate/3 compresses as much data as possible, and + stops when the input buffer becomes empty. It may introduce + some output latency (reading input without producing any + output) except when forced to flush.

+

If the parameter Flush is set to sync, all + pending output is flushed to the output buffer and the + output is aligned on a byte boundary, so that the + decompressor can get all input data available so far. + Flushing may degrade compression for some compression algorithms and so + it should be used only when necessary.

+

If Flush is set to full, all output is flushed as with + sync, and the compression state is reset so that decompression can + restart from this point if previous compressed data has been damaged or if + random access is desired. Using full too often can seriously degrade + the compression.

+

If the parameter Flush is set to finish, + pending input is processed, pending output is flushed and + deflate/3 returns. Afterwards the only possible + operations on the stream are deflateReset/1 or deflateEnd/1.

+

Flush can be set to finish immediately after + deflateInit if all compression is to be done in one step.

+ 
+ 
+zlib:deflateInit(Z),
+B1 = zlib:deflate(Z,Data),
+B2 = zlib:deflate(Z,<< >>,finish),
+zlib:deflateEnd(Z),
+list_to_binary([B1,B2])
+ + + + deflateSetDictionary(Z, Dictionary) -> Adler32 + Initialize the compression dictionary + + Z = zstream() + Dictionary = binary() + Adler32 = integer() + + +

Initializes the compression dictionary from the given byte + sequence without producing any compressed output. This + function must be called immediately after + deflateInit/[1|2|6] or deflateReset/1, before + any call of deflate/3. The compressor and + decompressor must use exactly the same dictionary (see + inflateSetDictionary/2). The adler checksum of the + dictionary is returned.

+ + + + deflateReset(Z) -> ok + Reset the deflate session + + Z = zstream() + + +

This function is equivalent to deflateEnd/1 + followed by deflateInit/[1|2|6], but does not free + and reallocate all the internal compression state. The + stream will keep the same compression level and any other + attributes.

+ + + + deflateParams(Z, Level, Strategy) -> ok + Dynamicly update deflate parameters + + Z = zstream() + Level = none | default | best_speed | best_compression | 0..9 + Strategy = default|filtered|huffman_only + + +

Dynamically update the compression level and compression + strategy. The interpretation of Level and + Strategy is as in deflateInit/6. This can be + used to switch between compression and straight copy of the + input data, or to switch to a different kind of input data + requiring a different strategy. If the compression level is + changed, the input available so far is compressed with the + old level (and may be flushed); the new level will take + effect only at the next call of deflate/3.

+

Before the call of deflateParams, the stream state must be set as for + a call of deflate/3, since the currently available input may have to + be compressed and flushed.

+ + + + deflateEnd(Z) -> ok + End deflate session + + Z = zstream() + + +

End the deflate session and cleans all data used. + Note that this function will throw an data_error + exception if the last call to + deflate/3 was not called with Flush set to + finish.

+ + + + inflateInit(Z) -> ok + Initialize a session for decompression + + Z = zstream() + + +

Initialize a zlib stream for decompression.

+ + + + inflateInit(Z, WindowBits) -> ok + Initialize a session for decompression + + Z = zstream() + WindowBits = 9..15|-9..-15 + + +

Initialize decompression session on zlib stream.

+

The WindowBits parameter is the base two logarithm + of the maximum window size (the size of the history buffer). + It should be in the range 9 through 15. + The default value is 15 if inflateInit/1 is used. + If a compressed stream with a larger window size is + given as input, inflate() will throw the data_error + exception. A negative WindowBits value makes zlib ignore the + zlib header (and checksum) from the stream. Note that the zlib + source mentions this only as a undocumented feature.

+ + + + inflate(Z, Data) -> DeCompressed + Decompress data + + Z = zstream() + Data = iodata() + DeCompressed = iolist() + + +

inflate/2 decompresses as much data as possible. + It may some introduce some output latency (reading + input without producing any output).

+

If a preset dictionary is needed at this point (see + inflateSetDictionary below), inflate/2 throws a + {need_dictionary,Adler} exception where Adler is + the adler32 checksum of the dictionary chosen by the + compressor.

+ + + + inflateSetDictionary(Z, Dictionary) -> ok + Initialize the decompression dictionary + + Z = zstream() + Dictionary = binary() + + +

Initializes the decompression dictionary from the given + uncompressed byte sequence. This function must be called + immediately after a call of inflate/2 if this call + threw a {need_dictionary,Adler} exception. + The dictionary chosen by the + compressor can be determined from the Adler value thrown + by the call to inflate/2. The compressor and decompressor + must use exactly the same dictionary (see deflateSetDictionary/2).

+

Example:

+ 
+unpack(Z, Compressed, Dict) ->
+     case catch zlib:inflate(Z, Compressed) of
+\011  {'EXIT',{{need_dictionary,DictID},_}} ->
+  \011         zlib:inflateSetDictionary(Z, Dict),
+\011         Uncompressed = zlib:inflate(Z, []);
+\011  Uncompressed ->
+\011         Uncompressed
+     end.
+ + + + inflateReset(Z) -> ok + >Reset the inflate session + + Z = zstream() + + +

This function is equivalent to inflateEnd/1 followed + by inflateInit/1, but does not free and reallocate all + the internal decompression state. The stream will keep + attributes that may have been set by inflateInit/[1|2].

+ + + + inflateEnd(Z) -> ok + End inflate session + + Z = zstream() + + +

End the inflate session and cleans all data used. Note + that this function will throw a data_error exception + if no end of stream was found (meaning that not all data + has been uncompressed).

+ + + + setBufSize(Z, Size) -> ok + Set buffer size + + Z = zstream() + Size = integer() + + +

Sets the intermediate buffer size.

+ + + + getBufSize(Z) -> Size + Get buffer size + + Z = zstream() + Size = integer() + + +

Get the size of intermediate buffer.

+ + + + crc32(Z) -> CRC + Get current CRC + + Z = zstream() + CRC = integer() + + +

Get the current calculated CRC checksum.

+ + + + crc32(Z, Binary) -> CRC + Calculate CRC + + Z = zstream() + Binary = binary() + CRC = integer() + + +

Calculate the CRC checksum for Binary.

+ + + + crc32(Z, PrevCRC, Binary) -> CRC + Calculate CRC + + Z = zstream() + PrevCRC = integer() + Binary = binary() + CRC = integer() + + +

Update a running CRC checksum for Binary. + If Binary is the empty binary, this function returns + the required initial value for the crc.

+ 
+Crc = lists:foldl(fun(Bin,Crc0) ->  
+\011              zlib:crc32(Z, Crc0, Bin),
+\011          end, zlib:crc32(Z,<< >>), Bins)
+ + + + crc32_combine(Z, CRC1, CRC2, Size2) -> CRC + Combine two CRC's + + Z = zstream() + CRC = integer() + CRC1 = integer() + CRC2 = integer() + Size2 = integer() + + +

Combine two CRC checksums into one. For two binaries, + Bin1 and Bin2 with sizes of Size1 and + Size2, with CRC checksums CRC1 and + CRC2. crc32_combine/4 returns the CRC + checksum of <<Bin1/binary,Bin2/binary>>, requiring + only CRC1, CRC2, and Size2. +

+ + + + adler32(Z, Binary) -> Checksum + Calculate the adler checksum + + Z = zstream() + Binary = binary() + Checksum = integer() + + +

Calculate the Adler-32 checksum for Binary.

+ + + + adler32(Z, PrevAdler, Binary) -> Checksum + Calculate the adler checksum + + Z = zstream() + PrevAdler = integer() + Binary = binary() + Checksum = integer() + + +

Update a running Adler-32 checksum for Binary. + If Binary is the empty binary, this function returns + the required initial value for the checksum.

+ 
+Crc = lists:foldl(fun(Bin,Crc0) ->  
+\011              zlib:adler32(Z, Crc0, Bin),
+\011          end, zlib:adler32(Z,<< >>), Bins)
+ + + + adler32_combine(Z, Adler1, Adler2, Size2) -> Adler + Combine two Adler-32 checksums + + Z = zstream() + Adler = integer() + Adler1 = integer() + Adler2 = integer() + Size2 = integer() + + +

Combine two Adler-32 checksums into one. For two binaries, + Bin1 and Bin2 with sizes of Size1 and + Size2, with Adler-32 checksums Adler1 and + Adler2. adler32_combine/4 returns the Adler + checksum of <<Bin1/binary,Bin2/binary>>, requiring + only Adler1, Adler2, and Size2. +

+ + + + compress(Binary) -> Compressed + Compress a binary with standard zlib functionality + + Binary = Compressed = binary() + + +

Compress a binary (with zlib headers and checksum).

+ + + + uncompress(Binary) -> Decompressed + Uncompress a binary with standard zlib functionality + + Binary = Decompressed = binary() + + +

Uncompress a binary (with zlib headers and checksum).

+ + + + zip(Binary) -> Compressed + Compress a binary without the zlib headers + + Binary = Compressed = binary() + + +

Compress a binary (without zlib headers and checksum).

+ + + + unzip(Binary) -> Decompressed + Uncompress a binary without the zlib headers + + Binary = Decompressed = binary() + + +

Uncompress a binary (without zlib headers and checksum).

+ + + + gzip(Data) -> Compressed + Compress a binary with gz header + + Binary = Compressed = binary() + + +

Compress a binary (with gz headers and checksum).

+ + + + gunzip(Bin) -> Decompressed + Uncompress a binary with gz header + + Binary = Decompressed = binary() + + +

Uncompress a binary (with gz headers and checksum).

+ + + + + diff --git a/erts/emulator/Makefile b/erts/emulator/Makefile new file mode 100644 index 0000000000..2db3b349b6 --- /dev/null +++ b/erts/emulator/Makefile @@ -0,0 +1,24 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# Invoke with GNU make or clearmake -C gnu. +# + +include $(ERL_TOP)/make/run_make.mk + diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in new file mode 100644 index 0000000000..a2061134a5 --- /dev/null +++ b/erts/emulator/Makefile.in @@ -0,0 +1,1114 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include $(ERL_TOP)/make/target.mk +include ../vsn.mk + +ENABLE_ALLOC_TYPE_VARS = @ENABLE_ALLOC_TYPE_VARS@ +HIPE_ENABLED=@HIPE_ENABLED@ +LIBS = @LIBS@ +Z_LIB=@Z_LIB@ +NO_INLINE_FUNCTIONS=false +OPCODE_TABLES = $(ERL_TOP)/lib/compiler/src/genop.tab beam/ops.tab + +# +# Run this make file with TYPE set to the type of emulator you want. +# Different versions of the emulator for different uses. The default +# is "debug". For a normal version use "opt". +# +THR_DEFS=@EMU_THR_DEFS@ +M4FLAGS= +CREATE_DIRS= + +LDFLAGS=@LDFLAGS@ + +ifeq ($(TYPE),debug) +PURIFY = +TYPEMARKER = .debug +TYPE_FLAGS = @DEBUG_CFLAGS@ -DDEBUG +ENABLE_ALLOC_TYPE_VARS += debug +ifeq ($(TARGET),win32) +TYPE_FLAGS += -DNO_JUMP_TABLE +LDFLAGS += -g +endif +else + +ifeq ($(TYPE),purify) +PURIFY = purify $(PURIFY_BUILD_OPTIONS) +TYPEMARKER = .purify +TYPE_FLAGS = @DEBUG_CFLAGS@ -DPURIFY -DNO_JUMP_TABLE -DERTS_MSEG_FAKE_SEGMENTS +ENABLE_ALLOC_TYPE_VARS += purify +else + +ifeq ($(TYPE),quantify) +PURIFY = quantify $(QUANTIFY_BUILD_OPTIONS) +TYPEMARKER = .quantify +ENABLE_ALLOC_TYPE_VARS += quantify +ifeq ($(findstring ose,$(TARGET)),ose) + TYPE_FLAGS = @CFLAGS@ -DQUANTIFY +else + TYPE_FLAGS = @CFLAGS@ -g -O2 -DQUANTIFY -DNO_JUMP_TABLE +endif +else + +ifeq ($(TYPE),purecov) +PURIFY = purecov --follow-child-processes=yes $(PURECOV_BUILD_OPTIONS) +TYPEMARKER = .purecov +TYPE_FLAGS = @DEBUG_CFLAGS@ -DPURECOV -DNO_JUMP_TABLE +ENABLE_ALLOC_TYPE_VARS += purecov +else + +ifeq ($(TYPE),gcov) +PURIFY = +TYPEMARKER = .gcov +TYPE_FLAGS = @DEBUG_CFLAGS@ -DNO_JUMP_TABLE -fprofile-arcs -ftest-coverage -O0 -DERTS_CAN_INLINE=0 -DERTS_INLINE= +ifneq ($(findstring solaris,$(TARGET)),solaris) +LIBS += -lgcov +endif +ENABLE_ALLOC_TYPE_VARS += debug +else + +ifeq ($(TYPE),valgrind) +PURIFY = +TYPEMARKER = .valgrind +TYPE_FLAGS = @DEBUG_CFLAGS@ -DVALGRIND -DNO_JUMP_TABLE -DERTS_MSEG_FAKE_SEGMENTS +ENABLE_ALLOC_TYPE_VARS += valgrind +else + +ifeq ($(TYPE),gprof) +PURIFY = +TYPEMARKER = .gprof +TYPE_FLAGS = @CFLAGS@ -DGPROF -pg -DERTS_CAN_INLINE=0 -DERTS_INLINE= +LDFLAGS += -pg +ENABLE_ALLOC_TYPE_VARS += gprof +NO_INLINE_FUNCTIONS=true +else + +ifeq ($(TYPE),lcnt) +PURIFY = +TYPEMARKER = .lcnt +TYPE_FLAGS = @CFLAGS@ -DERTS_ENABLE_LOCK_COUNT +else + +# If type isn't one of the above, it *is* opt type... +override TYPE=opt +PURIFY = +TYPEMARKER = +TYPE_FLAGS = @CFLAGS@ +endif +endif +endif +endif +endif +endif +endif +endif + +# +# NOTE: When adding a new type update ERL_BUILD_TYPE_MARKER in sys/unix/sys.c +# + +ifeq ($(FLAVOR),smp) +FLAVOR_MARKER=.smp +FLAVOR_FLAGS=-DERTS_SMP +ENABLE_ALLOC_TYPE_VARS += smp nofrag +M4FLAGS += -DERTS_SMP=1 +else + +ifeq ($(FLAVOR),hybrid) +FLAVOR_MARKER=.hybrid +FLAVOR_FLAGS=-DHYBRID +ENABLE_ALLOC_TYPE_VARS += hybrid +else + + +# If flavor isn't one of the above, it *is* plain flavor... +override FLAVOR=plain +FLAVOR_MARKER= +FLAVOR_FLAGS= +ENABLE_ALLOC_TYPE_VARS += nofrag +M4FLAGS += + +endif +endif + +TF_MARKER=$(TYPEMARKER)$(FLAVOR_MARKER) + + +OPSYS=@OPSYS@ +sol2CFLAGS= +linuxCFLAGS= +darwinCFLAGS=-DDARWIN +noopsysCFLAGS= +OPSYSCFLAGS=$($(OPSYS)CFLAGS) +ARCH=@ARCH@ +ultrasparcCFLAGS=-Wa,-xarch=v8plusa +ARCHCFLAGS=$($(ARCH)CFLAGS) + +ifdef HIPE_ENABLED +ifeq ($(OPSYS),linux) +ppcBEAMLDFLAGS=-Wl,-m,elf32ppc +ppc64BEAMLDFLAGS=-Wl,-m,elf64ppc,-T,hipe/elf64ppc.x +endif +HIPEBEAMLDFLAGS=$($(ARCH)BEAMLDFLAGS) +endif + +ERTS_ENABLE_KERNEL_POLL=@ERTS_ENABLE_KERNEL_POLL@ + +# +# +# +SHELL = /bin/sh +CC = @CC@ +ifeq ($(TARGET),win32) +ifeq ($(TYPE),debug) +EMU_CC = @CC@ +else +EMU_CC = @EMU_CC@ +endif +TYPE_FLAGS += -DSTATIC_ERLANG_DRIVER +else +EMU_CC = @EMU_CC@ +endif +WFLAGS = @WFLAGS@ +CFLAGS = @STATIC_CFLAGS@ $(TYPE_FLAGS) $(FLAVOR_FLAGS) @DEFS@ $(WFLAGS) $(THR_DEFS) $(ARCHCFLAGS) +HCC = @HCC@ +LD = @LD@ +DEXPORT = @DEXPORT@ +RANLIB = @RANLIB@ +STRIP = strip +PERL = @PERL@ +RM = @RM@ +MKDIR = @MKDIR@ + +USING_MINGW=@MIXED_CYGWIN_MINGW@ + +OMIT_OMIT_FP=no + +ifeq (@EMU_LOCK_CHECKING@,yes) +NO_INLINE_FUNCTIONS=true +endif + +ifneq ($(filter tile-%,$(TARGET)), ) +# -O2 generally produces faster for tile-cc, because the code is smaller. +# Since tile-cc looks like gcc, we need to override the normal gcc -O3 setting. +OPT_LEVEL = -O2 +else +OPT_LEVEL = -O3 +endif + +ifeq ($(CC), gcc) +ifeq ($(NO_INLINE_FUNCTIONS),true) +GEN_OPT_FLGS = $(OPT_LEVEL) -fno-inline-functions +else +ifeq ($(OMIT_OMIT_FP),yes) +GEN_OPT_FLGS = $(OPT_LEVEL) +else +GEN_OPT_FLGS = $(OPT_LEVEL) -fomit-frame-pointer +endif +endif +UNROLL_FLG = -funroll-loops +else +ifeq ($(TARGET), win32) +GEN_OPT_FLGS = $(OPT_LEVEL) +UNROLL_FLG = +RC=rc.sh +ifeq ($(USING_MINGW), yes) +RES_EXT=@OBJEXT@ +MAKE_PRELOAD_EXTRA=-windres +else +RES_EXT=res +endif +else +GEN_OPT_FLGS = +UNROLL_FLG = +RC=false +endif +endif + + +ifdef PURIFY_CHILD_SETUP +CS_PURIFY = $(PURIFY) +CS_TYPE_FLAGS = $(TYPE_FLAGS) +else +CS_PURIFY = +CS_TYPE_FLAGS = $(subst QUANTIFY,FAKE_QUANTIFY, \ + $(subst PURIFY,FAKE_PURIFY, $(TYPE_FLAGS))) +endif +CS_CFLAGS_ = $(CS_TYPE_FLAGS) @DEFS@ $(WFLAGS) +ifeq ($(CC), gcc) +CS_CFLAGS = $(subst -O2, $(GEN_OPT_FLGS) $(UNROLL_FLG), $(CS_CFLAGS_)) +else +CS_CFLAGS = $(CS_CFLAGS_) +endif +CS_LDFLAGS = $(LDFLAGS) +CS_LIBS = -L../lib/internal/$(TARGET) -lerts_internal @ERTS_INTERNAL_X_LIBS@ + +LIBS += @TERMCAP_LIB@ -L../lib/internal/$(TARGET) @ERTS_INTERNAL_X_LIBS@ + +ifdef Z_LIB +# Use shared zlib library +LIBS += $(Z_LIB) +else +ifeq ($(TARGET),win32) +LIBS += -L$(ERL_TOP)/erts/emulator/zlib/obj/$(TARGET)/$(TYPE) -lz +DEPLIBS = $(ERL_TOP)/erts/emulator/zlib/obj/$(TARGET)/$(TYPE)/z.lib +else +# Build on darwin fails if -lz is used +LIBS += $(ERL_TOP)/erts/emulator/zlib/obj/$(TARGET)/$(TYPE)/libz.a +DEPLIBS = $(ERL_TOP)/erts/emulator/zlib/obj/$(TARGET)/$(TYPE)/libz.a +endif + +endif + +ifeq ($(TARGET),win32) +LIBS += -L$(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE) -lepcre +DEPLIBS += $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/epcre.lib +else +LIBS += $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/libepcre.a +DEPLIBS += \ + $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE)/libepcre.a \ + $(ERL_TOP)/erts/lib/internal/$(TARGET)/liberts_internal.a +# rem liberts_internal.a +endif + +ELIB_FLAGS = -DENABLE_ELIB_MALLOC -DELIB_ALLOC_IS_CLIB -DELIB_HEAP_SBRK + +PERFCTR_PATH=@PERFCTR_PATH@ +USE_PERFCTR=@USE_PERFCTR@ +ifdef PERFCTR_PATH +LIBS += $(PERFCTR_PATH)/usr.lib/libperfctr.a +else +ifdef USE_PERFCTR +LIBS += -lperfctr +endif +endif + +LIBSCTP = @LIBSCTP@ + +ORG_THR_LIBS=@EMU_THR_LIBS@ +THR_LIB_NAME=@EMU_THR_LIB_NAME@ + +THR_LIBS=$(subst -l$(THR_LIB_NAME),-l$(THR_LIB_NAME)$(TYPEMARKER),$(ORG_THR_LIBS)) + +ifeq ($(findstring vxworks,$(TARGET)),vxworks) +ERTS_INTERNAL_LIB=erts_internal +else +ifneq ($(strip $(THR_LIB_NAME)),) +ERTS_INTERNAL_LIB=erts_internal_r +else +ERTS_INTERNAL_LIB=erts_internal +endif +endif + +LIBS += $(THR_LIBS) -l$(ERTS_INTERNAL_LIB)$(TYPEMARKER) + +LIBS += @LIBRT@ + +LIBS += @LIBCARBON@ + +TTF_DIR=$(TARGET)/$(TYPE)/$(FLAVOR) +CREATE_DIRS += $(TTF_DIR) + +# create obj dirs for emulator, pcre and zlib + +OBJDIR = obj/$(TTF_DIR) + +CREATE_DIRS += $(OBJDIR) \ + pcre/obj/$(TARGET)/$(TYPE) \ + zlib/obj/$(TARGET)/$(TYPE) + + +BINDIR = $(ERL_TOP)/bin/$(TARGET) + +ERLANG_OSTYPE = @ERLANG_OSTYPE@ + +ENABLE_ALLOC_TYPE_VARS += @ERLANG_OSTYPE@ + +EMULATOR_EXECUTABLE_SAE = beam_evm$(TF_MARKER) +EMULATOR_EXECUTABLE_ELIB = beam.elib$(TF_MARKER) +ifeq ($(TARGET), win32) +EMULATOR_EXECUTABLE = beam$(TF_MARKER).dll +else +EMULATOR_EXECUTABLE = beam$(TF_MARKER) +endif +CS_EXECUTABLE = child_setup$(TYPEMARKER) + +# ---------------------------------------------------------------------- +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +ifeq ($(ERLANG_OSTYPE), unix) +UNIX_ONLY_BUILDS = $(BINDIR)/$(CS_EXECUTABLE) +else +UNIX_ONLY_BUILDS = +endif + +ifeq ($(TYPE)-@HAVE_VALGRIND@,valgrind-no) +all: + @echo '*** valgrind not found by configure' +else +ifeq ($(FLAVOR)-@ERTS_BUILD_SMP_EMU@,smp-no) +all: + @echo '*** Omitted build of emulator with smp support' +else +all: generate erts_lib zlib pcre $(BINDIR)/$(EMULATOR_EXECUTABLE) $(UNIX_ONLY_BUILDS) +ifeq ($(OMIT_OMIT_FP),yes) + @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' + @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' + @echo '* * * *' + @echo '* * NOTE: Omit frame pointer optimization has been omitted * *' + @echo '* * * *' + @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' + @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' +endif +endif +endif + +ifdef Z_LIB +zlib: + @echo 'Skip zlib directory, use shared library' +else +zlib: + @set -e ; cd zlib && $(MAKE) TYPE=$(TYPE) $(TYPE) +endif + +pcre: + @set -e ; cd pcre && $(MAKE) TYPE=$(TYPE) $(TYPE) + +erts_lib: + cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE) + +clean: +ifeq ($(TARGET),win32) + $(RM) -f $(TARGET)/beams.rc +endif + $(RM) -f $(TARGET)/*.c $(TARGET)/*.h $(TARGET)/depend.mk + $(RM) -f $(TARGET)/*/*/*.c $(TARGET)/*/*/*.h $(TARGET)/*/*/*.S + $(RM) -f $(ERL_TOP)/erts/emulator/obj/$(TARGET)/*/*/*.o + $(RM) -f $(BINDIR)/beam $(BINDIR)/beam.* + $(RM) -f $(BINDIR)/child_setup $(BINDIR)/child_setup.* + $(RM) -f $(BINDIR)/hipe_mkliterals $(BINDIR)/hipe_mkliterals.* + @set -e ; cd zlib && $(MAKE) clean + @set -e ; cd pcre && $(MAKE) clean + +.PHONY: all sae zlib pcre clean + +docs: + +# ---------------------------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +RELSYSDIR = $(RELEASE_PATH)/erts-$(VSN) + +RELEASE_INCLUDES = beam/erl_driver.h sys/$(ERLANG_OSTYPE)/driver_int.h beam/erl_nif.h beam/erl_nif_api_funcs.h +ifeq ($(TARGET),win32) +RELEASE_INCLUDES += sys/$(ERLANG_OSTYPE)/erl_win_dyn_driver.h +endif +ifeq ($(findstring ose,$(TARGET)),ose) +RELEASE_INCLUDES += sys/$(ERLANG_OSTYPE)/erl_port_signals.sig \ + sys/$(ERLANG_OSTYPE)/ose_erl_port_prog.h \ + drivers/$(ERLANG_OSTYPE)/ose_erl_driver.h + +endif + +ifeq ($(TYPE)-@HAVE_VALGRIND@,valgrind-no) +release_spec: + @echo '*** valgrind not found by configure' +else +ifeq ($(FLAVOR)-@ERTS_BUILD_SMP_EMU@,smp-no) +release_spec: + @echo '*** No emulator with smp support to install' +else +release_spec: all + $(INSTALL_DIR) $(RELSYSDIR) + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/include + $(INSTALL_DIR) $(RELSYSDIR)/man + $(INSTALL_DIR) $(RELSYSDIR)/doc + $(INSTALL_DIR) $(RELSYSDIR)/bin + $(INSTALL_DIR) $(RELEASE_PATH)/usr/include + $(INSTALL_DATA) $(RELEASE_INCLUDES) $(RELEASE_PATH)/usr/include + $(INSTALL_DATA) $(RELEASE_INCLUDES) $(RELSYSDIR)/include + $(INSTALL_PROGRAM) $(BINDIR)/$(EMULATOR_EXECUTABLE) $(RELSYSDIR)/bin +ifeq ($(ERLANG_OSTYPE), unix) + $(INSTALL_PROGRAM) $(BINDIR)/$(CS_EXECUTABLE) $(RELSYSDIR)/bin +endif + $(INSTALL_DIR) $(RELEASE_PATH)/usr/include/obsolete + $(INSTALL_DATA) obsolete/driver.h $(RELEASE_PATH)/usr/include/obsolete +endif +endif + +release_docs_spec: + +# ---------------------------------------------------------------------- +# Generated source code. Put in $(TARGET) directory +# + +.PHONY : generate + +GENERATE= $(CREATE_DIRS) \ + $(TTF_DIR)/beam_opcodes.h \ + $(TARGET)/erl_bif_table.c \ + $(TARGET)/erl_version.h \ + $(TTF_DIR)/driver_tab.c \ + $(TTF_DIR)/erl_alloc_types.h + +ifeq ($(TARGET),win32) +GENERATE += $(TARGET)/beams.rc +else +GENERATE += $(TARGET)/preload.c +endif + +ifeq ($(findstring vxworks,$(TARGET)),vxworks) +else +ifeq ($(findstring ose,$(TARGET)),ose) +else +ifdef HIPE_ENABLED +GENERATE += $(TTF_DIR)/hipe_x86_asm.h \ + $(TTF_DIR)/hipe_amd64_asm.h \ + $(TTF_DIR)/hipe_sparc_asm.h \ + $(TTF_DIR)/hipe_ppc_asm.h \ + $(TTF_DIR)/hipe_arm_asm.h \ + $(TTF_DIR)/hipe_literals.h \ + $(BINDIR)/hipe_mkliterals$(TF_MARKER) +endif +endif +endif + +ifeq ($(FLAVOR)-@ERTS_BUILD_SMP_EMU@,smp-no) +GENERATE= +endif + +generate: $(GENERATE) + +ifdef HIPE_ENABLED +OPCODE_TABLES += hipe/hipe_ops.tab +endif + +$(TTF_DIR)/beam_opcodes.h $(TTF_DIR)/beam_opcodes.c: $(OPCODE_TABLES) + LANG=C $(PERL) utils/beam_makeops -outdir $(TTF_DIR) \ + -emulator $(OPCODE_TABLES) + +# bif and atom table +ATOMS= beam/atom.names +BIFS = beam/bif.tab +ifdef HIPE_ENABLED +HIPE_x86_TAB=hipe/hipe_x86.tab +HIPE_amd64_TAB=hipe/hipe_amd64.tab +HIPE_ultrasparc_TAB=hipe/hipe_sparc.tab +HIPE_ppc_TAB=hipe/hipe_ppc.tab +HIPE_ppc64_TAB=hipe/hipe_ppc64.tab +HIPE_arm_TAB=hipe/hipe_arm.tab +HIPE_ARCH_TAB=$(HIPE_$(ARCH)_TAB) +BIFS += hipe/hipe_bif0.tab hipe/hipe_bif1.tab hipe/hipe_bif2.tab $(HIPE_ARCH_TAB) +ifdef USE_PERFCTR +BIFS += hipe/hipe_perfctr.tab +endif +endif + +TABLES= $(TARGET)/erl_bif_table.c $(TARGET)/erl_bif_table.h \ + $(TARGET)/erl_bif_wrap.c $(TARGET)/erl_bif_list.h \ + $(TARGET)/erl_atom_table.c $(TARGET)/erl_atom_table.h \ + $(TARGET)/erl_pbifs.c + +$(TABLES): $(ATOMS) $(BIFS) + LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET) $^ + +$(TTF_DIR)/erl_alloc_types.h: beam/erl_alloc.types utils/make_alloc_types + LANG=C $(PERL) utils/make_alloc_types -src $< -dst $@ $(ENABLE_ALLOC_TYPE_VARS) + +# version include file +$(TARGET)/erl_version.h: ../vsn.mk + LANG=C $(PERL) utils/make_version -o $@ $(SYSTEM_VSN) $(VSN)$(SERIALNO) $(TARGET) + +# driver table +$(TTF_DIR)/driver_tab.c: Makefile.in + LANG=C $(PERL) utils/make_driver_tab -o $@ $(DRV_OBJS) + +# Preloaded code. +# +# This list must be consistent with PRE_LOADED_MODULES in +# lib/kernel/src/Makefile. +ifeq ($(TARGET),win32) +$(TARGET)/beams.rc: $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ + $(ERL_TOP)/erts/preloaded/ebin/init.beam \ + $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ + $(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \ + $(ERL_TOP)/erts/preloaded/ebin/zlib.beam \ + $(ERL_TOP)/erts/preloaded/ebin/prim_zip.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erlang.beam + LANG=C $(PERL) utils/make_preload $(MAKE_PRELOAD_EXTRA) -rc $^ > $@ +else +$(TARGET)/preload.c: $(ERL_TOP)/erts/preloaded/ebin/otp_ring0.beam \ + $(ERL_TOP)/erts/preloaded/ebin/init.beam \ + $(ERL_TOP)/erts/preloaded/ebin/prim_inet.beam \ + $(ERL_TOP)/erts/preloaded/ebin/prim_file.beam \ + $(ERL_TOP)/erts/preloaded/ebin/zlib.beam \ + $(ERL_TOP)/erts/preloaded/ebin/prim_zip.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erl_prim_loader.beam \ + $(ERL_TOP)/erts/preloaded/ebin/erlang.beam + LANG=C $(PERL) utils/make_preload -old $^ > $@ +endif + +# ---------------------------------------------------------------------- +# Pattern rules +# +COMMON_INCLUDES = -Ibeam -Isys/$(ERLANG_OSTYPE) -Isys/common -I$(TARGET) +ifndef Z_LIB +COMMON_INCLUDES += -Izlib +endif +COMMON_INCLUDES += -Ipcre -Ihipe +COMMON_INCLUDES += -I../include -I../include/$(TARGET) +COMMON_INCLUDES += -I../include/internal -I../include/internal/$(TARGET) + +INCLUDES = -I$(TTF_DIR) $(COMMON_INCLUDES) + +ifdef PERFCTR_PATH +INCLUDES += -I$(PERFCTR_PATH)/usr.lib -I$(PERFCTR_PATH)/linux/include +endif + +# Need to include etc dir on VxWorks +ifeq ($(findstring vxworks,$(TARGET)),vxworks) +INCLUDES += -I$(ERL_TOP)/erts/etc/vxworks +endif + +ifneq ($(findstring ose,$(TARGET)),ose) +ifeq ($(TARGET),win32) +# Usually the same as the default rule, but certain platforms (i.e. win32) mix +# different compilers +$(OBJDIR)/beam_emu.o: beam/beam_emu.c + $(EMU_CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/dll_sys.o: sys/$(ERLANG_OSTYPE)/sys.c + $(CC) $(CFLAGS) -DERL_RUN_SHARED_LIB=1 $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/beams.$(RES_EXT): $(TARGET)/beams.rc + $(RC) -o $@ -I$(ERL_TOP)/erts/etc/win32 $(TARGET)/beams.rc + +endif + +ifneq ($(filter tile-%,$(TARGET)),) +$(OBJDIR)/beam_emu.o: beam/beam_emu.c + $(CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) \ + -OPT:Olimit=0 -WOPT:lpre=off:spre=off:epre=off \ + $(INCLUDES) -c $< -o $@ +endif + + +$(OBJDIR)/%.o: beam/%.c + $(CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +else + +INCLUDES += -Idrivers/ose + +ifeq ($(TYPE),debug) +$(OBJDIR)/%.o: beam/%.c + $(CC) $(CFLAGS) -DNO_JUMP_TABLE $(INCLUDES) -c $< -o $@ +else + +VXCC=@VXCC@ +VXCFLAGS=@VXCFLAGS@ +CFLAGS_NOOPT=@CFLAGS_NOOPT@ @DEFS@ $(WFLAGS) $(THR_DEFS) $(ARCHCFLAGS) + +# we want to use jump table +$(OBJDIR)/beam_emu.o: beam/beam_emu.c + $(VXCC) $(VXCFLAGS) $(INCLUDES) -c $< -o $@ + +# erl_process does not work properly with DIAB's -XO option, +# we'll compile it with gcc instead +$(OBJDIR)/erl_process.o: beam/erl_process.c + $(VXCC) $(VXCFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/%.o: beam/%.c + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ +endif +endif + +$(OBJDIR)/%.o: $(TARGET)/%.c + $(CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -c $< -o $@ + +$(OBJDIR)/%.o: $(TTF_DIR)/%.c + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/%.o: sys/$(ERLANG_OSTYPE)/%.c + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/%.o: sys/common/%.c + $(CC) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/%.o: drivers/common/%.c + $(CC) $(CFLAGS) -DLIBSCTP=$(LIBSCTP) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -c $< -o $@ + +$(OBJDIR)/%.o: drivers/$(ERLANG_OSTYPE)/%.c + $(CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -Idrivers/$(ERLANG_OSTYPE) -I../etc/$(ERLANG_OSTYPE) -c $< -o $@ + +# VxWorks and OSE uses unix drivers too... +ifeq ($(findstring vxworks,$(TARGET)),vxworks) +$(OBJDIR)/%.o: drivers/unix/%.c + $(CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -c $< -o $@ +endif +ifeq ($(findstring ose,$(TARGET)),ose) +$(OBJDIR)/%.o: drivers/unix/%.c + $(CC) $(CFLAGS) $(INCLUDES) -Idrivers/common -c $< -o $@ +endif + +# ---------------------------------------------------------------------- +# Specials +# +CS_SRC = sys/$(ERLANG_OSTYPE)/erl_child_setup.c + +$(BINDIR)/$(CS_EXECUTABLE): $(CS_SRC) + $(CS_PURIFY) $(CC) $(CS_LDFLAGS) -o $(BINDIR)/$(CS_EXECUTABLE) \ + $(CS_CFLAGS) $(COMMON_INCLUDES) $(CS_SRC) $(CS_LIBS) + +$(OBJDIR)/%.elib.o: beam/%.c + $(CC) $(ELIB_FLAGS) $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +# Disable vfork() for sae (then we don't need the child_setup program) +$(OBJDIR)/sys_sae.o: sys/$(ERLANG_OSTYPE)/sys.c + $(CC) -DDISABLE_VFORK=1 $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/%.kp.o: sys/common/%.c + $(CC) -DERTS_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/%.nkp.o: sys/common/%.c + $(CC) -DERTS_NO_KERNEL_POLL_VERSION $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +ifeq ($(CC), gcc) + +$(OBJDIR)/erl_obsolete.o: beam/erl_obsolete.c + $(CC) $(subst -Wstrict-prototypes, , $(subst -O2, $(GEN_OPT_FLGS), $(CFLAGS))) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/erl_goodfit_alloc.o: beam/erl_goodfit_alloc.c + $(CC) $(subst -O2, $(GEN_OPT_FLGS) $(UNROLL_FLG), $(CFLAGS)) $(INCLUDES) -c $< -o $@ +endif + +# ---------------------------------------------------------------------- +# Build necessary beam files if they are not already in place. To force +# rebuilding (is this a good idea?) add a dummy dependency to this target. +# + +ifeq ($(findstring clearmake,$(MAKE)),clearmake) +BEAMFILE_MAKEFLAG=-T +else +BEAMFILE_MAKEFLAG= +endif + +$(ERL_TOP)/lib/%.beam: + cd $(@D)/../src && $(MAKE) $(BEAMFILE_MAKEFLAG) ../ebin/$(@F) + + +# ---------------------------------------------------------------------- +# Object files +# + +# On windows the preloaded objects are in a resource object. + +ifeq ($(TARGET),win32) +PRELOAD = $(OBJDIR)/beams.$(RES_EXT) +else +PRELOAD = $(OBJDIR)/preload.o +endif + + +INIT_OBJS = $(OBJDIR)/erl_main.o $(PRELOAD) + +INIT_OBJS_SAE = $(OBJDIR)/erl9_start.o + +EMU_OBJS = \ + $(OBJDIR)/beam_emu.o $(OBJDIR)/beam_opcodes.o \ + $(OBJDIR)/beam_load.o $(OBJDIR)/beam_bif_load.o \ + $(OBJDIR)/beam_debug.o $(OBJDIR)/beam_bp.o \ + $(OBJDIR)/beam_catches.o + +RUN_OBJS = \ + $(OBJDIR)/erl_pbifs.o $(OBJDIR)/benchmark.o \ + $(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \ + $(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \ + $(OBJDIR)/erl_bestfit_alloc.o $(OBJDIR)/erl_afit_alloc.o \ + $(OBJDIR)/erl_instrument.o $(OBJDIR)/erl_init.o \ + $(OBJDIR)/erl_atom_table.o $(OBJDIR)/erl_bif_table.o \ + $(OBJDIR)/erl_bif_ddll.o $(OBJDIR)/erl_bif_guard.o \ + $(OBJDIR)/erl_bif_info.o $(OBJDIR)/erl_bif_op.o \ + $(OBJDIR)/erl_bif_os.o $(OBJDIR)/erl_bif_lists.o \ + $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_wrap.o \ + $(OBJDIR)/erl_trace.o $(OBJDIR)/copy.o \ + $(OBJDIR)/utils.o $(OBJDIR)/bif.o \ + $(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\ + $(OBJDIR)/erl_debug.o $(OBJDIR)/erl_md5.o \ + $(OBJDIR)/erl_message.o $(OBJDIR)/erl_process.o \ + $(OBJDIR)/erl_process_dict.o $(OBJDIR)/erl_process_lock.o \ + $(OBJDIR)/erl_port_task.o $(OBJDIR)/erl_arith.o \ + $(OBJDIR)/time.o $(OBJDIR)/erl_time_sup.o \ + $(OBJDIR)/external.o $(OBJDIR)/dist.o \ + $(OBJDIR)/binary.o $(OBJDIR)/erl_db.o \ + $(OBJDIR)/erl_db_util.o $(OBJDIR)/erl_db_hash.o \ + $(OBJDIR)/erl_db_tree.o $(OBJDIR)/fix_alloc.o \ + $(OBJDIR)/big.o $(OBJDIR)/hash.o \ + $(OBJDIR)/index.o $(OBJDIR)/atom.o \ + $(OBJDIR)/module.o $(OBJDIR)/export.o \ + $(OBJDIR)/register.o $(OBJDIR)/break.o \ + $(OBJDIR)/erl_async.o $(OBJDIR)/erl_lock_check.o \ + $(OBJDIR)/erl_gc.o $(OBJDIR)/erl_lock_count.o \ + $(OBJDIR)/erl_nmgc.o $(OBJDIR)/erl_posix_str.o \ + $(OBJDIR)/erl_bits.o $(OBJDIR)/erl_math.o \ + $(OBJDIR)/erl_fun.o $(OBJDIR)/erl_bif_port.o \ + $(OBJDIR)/erl_term.o $(OBJDIR)/erl_node_tables.o \ + $(OBJDIR)/erl_monitors.o $(OBJDIR)/erl_process_dump.o \ + $(OBJDIR)/erl_obsolete.o $(OBJDIR)/erl_bif_timer.o \ + $(OBJDIR)/erl_drv_thread.o $(OBJDIR)/erl_bif_chksum.o \ + $(OBJDIR)/erl_bif_re.o $(OBJDIR)/erl_unicode.o \ + $(OBJDIR)/packet_parser.o $(OBJDIR)/safe_hash.o \ + $(OBJDIR)/erl_zlib.o $(OBJDIR)/erl_nif.o + +ifeq ($(TARGET),win32) +DRV_OBJS = \ + $(OBJDIR)/registry_drv.o \ + $(OBJDIR)/efile_drv.o \ + $(OBJDIR)/inet_drv.o \ + $(OBJDIR)/zlib_drv.o \ + $(OBJDIR)/ram_file_drv.o +OS_OBJS = \ + $(OBJDIR)/win_efile.o \ + $(OBJDIR)/win_con.o \ + $(OBJDIR)/dll_sys.o \ + $(OBJDIR)/driver_tab.o \ + $(OBJDIR)/gzio.o \ + $(OBJDIR)/sys_float.o \ + $(OBJDIR)/sys_time.o \ + $(OBJDIR)/sys_interrupt.o \ + $(OBJDIR)/sys_env.o \ + $(OBJDIR)/dosmap.o \ + $(OBJDIR)/elib_malloc.o +else +OS_OBJS = \ + $(OBJDIR)/sys.o \ + $(OBJDIR)/driver_tab.o \ + $(OBJDIR)/unix_efile.o \ + $(OBJDIR)/gzio.o \ + $(OBJDIR)/elib_malloc.o \ + $(OBJDIR)/elib_memmove.o + +ifeq ($(findstring ose,$(TARGET)),ose) + OS_OBJS += $(OBJDIR)/erl_port_init.o \ + $(OBJDIR)/ose_inet_sock_select.o \ + $(OBJDIR)/ose_sfp.o +else +ifeq ($(findstring vxworks,$(TARGET)),vxworks) + OS_OBJS += $(OBJDIR)/int64.o +else + OS_OBJS += $(OBJDIR)/sys_float.o \ + $(OBJDIR)/sys_time.o +endif +endif +DRV_OBJS = \ + $(OBJDIR)/efile_drv.o \ + $(OBJDIR)/inet_drv.o \ + $(OBJDIR)/zlib_drv.o \ + $(OBJDIR)/ram_file_drv.o +endif + +ifneq ($(findstring vxworks,$(TARGET)),vxworks) + ifeq ($(findstring ose,$(TARGET)),ose) + DRV_OBJS += $(OBJDIR)/ose_inet_drv.o + else + DRV_OBJS += $(OBJDIR)/ttsl_drv.o + endif +endif + +ifeq ($(ERTS_ENABLE_KERNEL_POLL),yes) +OS_OBJS += $(OBJDIR)/erl_poll.kp.o \ + $(OBJDIR)/erl_check_io.kp.o \ + $(OBJDIR)/erl_poll.nkp.o \ + $(OBJDIR)/erl_check_io.nkp.o +else +OS_OBJS += $(OBJDIR)/erl_poll.o \ + $(OBJDIR)/erl_check_io.o +endif + +OS_OBJS += $(OBJDIR)/erl_mseg.o \ + $(OBJDIR)/erl_$(ERLANG_OSTYPE)_sys_ddll.o \ + $(OBJDIR)/erl_mtrace_sys_wrap.o + +HIPE_x86_OS_OBJS=$(HIPE_x86_$(OPSYS)_OBJS) +HIPE_x86_OBJS=$(OBJDIR)/hipe_x86.o $(OBJDIR)/hipe_x86_glue.o $(OBJDIR)/hipe_x86_bifs.o $(OBJDIR)/hipe_x86_signal.o $(OBJDIR)/hipe_x86_stack.o $(HIPE_x86_OS_OBJS) +HIPE_amd64_OBJS=$(OBJDIR)/hipe_amd64.o $(OBJDIR)/hipe_amd64_glue.o $(OBJDIR)/hipe_amd64_bifs.o $(OBJDIR)/hipe_x86_signal.o $(OBJDIR)/hipe_x86_stack.o +HIPE_ultrasparc_OBJS=$(OBJDIR)/hipe_sparc.o $(OBJDIR)/hipe_sparc_glue.o $(OBJDIR)/hipe_sparc_bifs.o $(OBJDIR)/hipe_risc_stack.o +HIPE_ppc_OBJS=$(OBJDIR)/hipe_ppc.o $(OBJDIR)/hipe_ppc_glue.o $(OBJDIR)/hipe_ppc_bifs.o $(OBJDIR)/hipe_risc_stack.o +HIPE_ppc64_OBJS=$(HIPE_ppc_OBJS) +HIPE_arm_OBJS=$(OBJDIR)/hipe_arm.o $(OBJDIR)/hipe_arm_glue.o $(OBJDIR)/hipe_arm_bifs.o $(OBJDIR)/hipe_risc_stack.o +HIPE_noarch_OBJS= +HIPE_ARCH_OBJS=$(HIPE_$(ARCH)_OBJS) + +HIPE_OBJS= \ + $(OBJDIR)/hipe_bif0.o \ + $(OBJDIR)/hipe_bif1.o \ + $(OBJDIR)/hipe_bif2.o \ + $(OBJDIR)/hipe_debug.o \ + $(OBJDIR)/hipe_gc.o \ + $(OBJDIR)/hipe_mode_switch.o \ + $(OBJDIR)/hipe_native_bif.o \ + $(OBJDIR)/hipe_stack.o $(HIPE_ARCH_OBJS) +ifdef USE_PERFCTR +HIPE_OBJS += $(OBJDIR)/hipe_perfctr.o +endif +ifdef HIPE_ENABLED +EXTRA_BASE_OBJS += $(HIPE_OBJS) +endif + +BASE_OBJS = $(RUN_OBJS) $(EMU_OBJS) $(OS_OBJS) $(EXTRA_BASE_OBJS) + +OBJS = $(BASE_OBJS) $(DRV_OBJS) +OBJS_SAE = $(subst sys.o,sys_sae.o,$(OBJS)) + +ELIB_C_FILES = beam/elib_malloc.c \ + beam/elib_memmove.c \ + beam/erl_bif_info.c \ + beam/utils.c \ + beam/erl_alloc.c + +MOD_OBJS_ELIB = $(patsubst %.c,$(OBJDIR)/%.o,$(notdir $(ELIB_C_FILES))) +OBJS_ELIB = $(patsubst %.o,%.elib.o,$(MOD_OBJS_ELIB)) \ + $(filter-out $(MOD_OBJS_ELIB),$(OBJS)) + +######################################## +# HiPE section + +M4FLAGS += -DTARGET=$(TARGET) -DOPSYS=$(OPSYS) -DARCH=$(ARCH) + +$(TTF_DIR)/%.S: hipe/%.m4 + m4 $(M4FLAGS) $< > $@ + +$(TTF_DIR)/%.h: hipe/%.m4 + m4 $(M4FLAGS) $< > $@ + +$(OBJDIR)/%.o: $(TTF_DIR)/%.S + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/%.o: hipe/%.S + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJDIR)/%.o: hipe/%.c + $(CC) $(subst O2,O3, $(CFLAGS)) $(INCLUDES) -c $< -o $@ + +$(BINDIR)/hipe_mkliterals$(TF_MARKER): $(OBJDIR)/hipe_mkliterals.o + $(CC) $(CFLAGS) $(INCLUDES) -o $@ $< + +$(OBJDIR)/hipe_mkliterals.o: $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_ppc_asm.h + +$(TTF_DIR)/hipe_literals.h: $(BINDIR)/hipe_mkliterals$(TF_MARKER) + $(BINDIR)/hipe_mkliterals$(TF_MARKER) -c > $@ + +$(OBJDIR)/hipe_x86_glue.o: hipe/hipe_x86_glue.S $(TTF_DIR)/hipe_x86_asm.h $(TTF_DIR)/hipe_literals.h hipe/hipe_mode_switch.h +$(TTF_DIR)/hipe_x86_bifs.S: hipe/hipe_x86_bifs.m4 hipe/hipe_x86_asm.m4 hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h +$(OBJDIR)/hipe_x86_bifs.o: $(TTF_DIR)/hipe_x86_bifs.S $(TTF_DIR)/hipe_literals.h + +$(OBJDIR)/hipe_amd64_glue.o: hipe/hipe_amd64_glue.S $(TTF_DIR)/hipe_amd64_asm.h $(TTF_DIR)/hipe_literals.h hipe/hipe_mode_switch.h +$(TTF_DIR)/hipe_amd64_bifs.S: hipe/hipe_amd64_bifs.m4 hipe/hipe_amd64_asm.m4 hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h +$(OBJDIR)/hipe_amd64_bifs.o: $(TTF_DIR)/hipe_amd64_bifs.S $(TTF_DIR)/hipe_literals.h + +$(OBJDIR)/hipe_sparc_glue.o: hipe/hipe_sparc_glue.S $(TTF_DIR)/hipe_sparc_asm.h hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h +$(TTF_DIR)/hipe_sparc_bifs.S: hipe/hipe_sparc_bifs.m4 hipe/hipe_sparc_asm.m4 hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h +$(OBJDIR)/hipe_sparc_bifs.o: $(TTF_DIR)/hipe_sparc_bifs.S $(TTF_DIR)/hipe_literals.h + +$(OBJDIR)/hipe_ppc_glue.o: hipe/hipe_ppc_glue.S $(TTF_DIR)/hipe_ppc_asm.h hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h +$(TTF_DIR)/hipe_ppc_bifs.S: hipe/hipe_ppc_bifs.m4 hipe/hipe_ppc_asm.m4 hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h +$(OBJDIR)/hipe_ppc_bifs.o: $(TTF_DIR)/hipe_ppc_bifs.S $(TTF_DIR)/hipe_literals.h + +$(OBJDIR)/hipe_arm_glue.o: hipe/hipe_arm_glue.S $(TTF_DIR)/hipe_arm_asm.h hipe/hipe_mode_switch.h $(TTF_DIR)/hipe_literals.h +$(TTF_DIR)/hipe_arm_bifs.S: hipe/hipe_arm_bifs.m4 hipe/hipe_arm_asm.m4 hipe/hipe_bif_list.m4 $(TARGET)/erl_bif_list.h hipe/hipe_gbif_list.h +$(OBJDIR)/hipe_arm_bifs.o: $(TTF_DIR)/hipe_arm_bifs.S $(TTF_DIR)/hipe_literals.h + +# end of HiPE section +######################################## + +ifeq ($(findstring vxworks,$(TARGET)),vxworks) +######################################## +# Extract what we need from libgcc.a +######################################## +GCCLIBFLAGS=@GCCLIBFLAGS@ +STRIP=@STRIP@ +SYMPREFIX=@SYMPREFIX@ + +NEEDFUNCTIONS=__divdi3 __moddi3 __udivdi3 +KEEPSYMS=$(NEEDFUNCTIONS:%=-K $(SYMPREFIX)%) + +$(OBJDIR)/int64.o: $(TARGET)/int64.c + $(CC) -o $(OBJDIR)/int64tmp.o -c $(TARGET)/int64.c + $(LD) -o $(OBJDIR)/int64.o $(OBJDIR)/int64tmp.o $(LDFLAGS) $(GCCLIBFLAGS) + $(STRIP) $(KEEPSYMS) $(OBJDIR)/int64.o + +$(TARGET)/int64.c: + echo 'void dummy(void); void dummy(void) {' > $(TARGET)/int64.c + for x in $(NEEDFUNCTIONS); do echo 'extern void '$$x'();' \ + >> $(TARGET)/int64.c; done + for x in $(NEEDFUNCTIONS); do echo $$x'();' >> $(TARGET)/int64.c; done + echo '}' >> $(TARGET)/int64.c + +endif + +ifeq ($(findstring ose,$(TARGET)),ose) +# Extract soft float functions from libgcc.a (for beam_emu) +VXCC=@VXCC@ +VXCFLAGS=@VXCFLAGS@ +VXLD=@VXLD@ +VXLDFLAGS=@VXLDFLAGS@ +VXCCLIBFLAGS=@VXCCLIBFLAGS@ +STRIP=@STRIP@ +SYMPREFIX=@SYMPREFIX@ + +NEEDFUNCTIONS=__floatsidf __adddf3 __negdf2 __muldf3 __divdf3 __subdf3 +KEEPSYMS=$(NEEDFUNCTIONS:%=-K $(SYMPREFIX)%) + +$(OBJDIR)/ose_sfp.o: $(TARGET)/ose_sfp.c + $(VXCC) $(VXCFLAGS) -o $(OBJDIR)/ose_sfp_tmp.o -c $(TARGET)/ose_sfp.c + $(VXLD) -o $(OBJDIR)/ose_sfp.o $(OBJDIR)/ose_sfp_tmp.o $(VXLDFLAGS) $(VXCCLIBFLAGS) + $(STRIP) $(KEEPSYMS) $(OBJDIR)/ose_sfp.o + +$(TARGET)/ose_sfp.c: + echo 'void dummy(void); void dummy(void) {' > $(TARGET)/ose_sfp.c + for x in $(NEEDFUNCTIONS); do echo 'extern void '$$x'();' \ + >> $(TARGET)/ose_sfp.c; done + for x in $(NEEDFUNCTIONS); do echo $$x'();' >> $(TARGET)/ose_sfp.c; done + echo '}' >> $(TARGET)/ose_sfp.c + +endif + +# ---------------------------------------------------------------------- +# The emulator itself + +ifeq ($(TARGET), win32) +# Only the basic erlang to begin with eh? +$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) + $(PURIFY) $(LD) -dll -def:sys/$(ERLANG_OSTYPE)/erl.def -implib:$(BINDIR)/erl_dll.lib -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ + $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) $(LIBS) +else + + +$(BINDIR)/$(EMULATOR_EXECUTABLE): $(INIT_OBJS) $(OBJS) $(DEPLIBS) + $(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE) \ + $(HIPEBEAMLDFLAGS) $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS) $(LIBS) + +$(BINDIR)/$(EMULATOR_EXECUTABLE_ELIB): $(INIT_OBJS) $(OBJS_ELIB) $(DEPLIBS) + $(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE_ELIB) \ + $(LDFLAGS) $(DEXPORT) $(INIT_OBJS) $(OBJS_ELIB) $(LIBS) + +$(BINDIR)/$(EMULATOR_EXECUTABLE_SAE): $(INIT_OBJS_SAE) $(OBJS_SAE) $(DEPLIBS) + $(PURIFY) $(LD) -o $(BINDIR)/$(EMULATOR_EXECUTABLE_SAE) \ + $(LDFLAGS) $(DEXPORT) $(INIT_OBJS_SAE) $(OBJS_SAE) $(LIBS) + +endif + +# +# Create directories +# + +$(CREATE_DIRS): + $(MKDIR) -p $@ + +# ---------------------------------------------------------------------- +# Dependencies +# +$(TARGET)/Makefile: Makefile.in + @echo + @echo "Makefile.in has been updated, please re-run configure!" + @echo + @exit 1 + +#SED_REPL_WIN_DRIVE=s|\([ ]\)\([A-Za-z]\):|\1/cygdrive/\2|g;s|^\([A-Za-z]\):|/cygdrive/\1|g +SED_REPL_O=s|^\([^:]*:\)|$$(OBJDIR)/\1|g +SED_REPL_ELIB_O=s|^\([^:]*\).o[ ]*:|$$(OBJDIR)/\1.elib.o:|g +SED_REPL_TTF_DIR=s|$(TTF_DIR)/|$$(TTF_DIR)/|g +SED_REPL_ERL_TOP=s|\([ ]\)$(ERL_TOP)/|\1$$(ERL_TOP)/|g;s|^$(ERL_TOP)/|$$(ERL_TOP)/|g +SED_REPL_POLL=s|$$(OBJDIR)/erl_poll.o|$$(OBJDIR)/erl_poll.kp.o $$(OBJDIR)/erl_poll.nkp.o|g +SED_REPL_CHK_IO=s|$$(OBJDIR)/erl_check_io.o|$$(OBJDIR)/erl_check_io.kp.o $$(OBJDIR)/erl_check_io.nkp.o|g + +ifeq ($(TARGET),win32) +#SED_PREFIX=$(SED_REPL_WIN_DRIVE); +SED_PREFIX= +else +SED_PREFIX= +endif + +ifeq ($(ERTS_ENABLE_KERNEL_POLL),yes) +SED_SUFFIX=;$(SED_REPL_POLL);$(SED_REPL_CHK_IO) +else +SED_SUFFIX= +endif + +SED_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_O);$(SED_REPL_TTF_DIR);$(SED_REPL_ERL_TOP)$(SED_SUFFIX)' +SED_ELIB_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_ELIB_O);$(SED_REPL_TTF_DIR);$(SED_REPL_ERL_TOP)$(SED_SUFFIX)' + +ifdef HIPE_ENABLED +HIPE_SRC=$(wildcard hipe/*.c) +else +HIPE_SRC= +endif + +BEAM_SRC=$(wildcard beam/*.c) +DRV_SRC=$(wildcard drivers/common/*.c) $(wildcard drivers/$(ERLANG_OSTYPE)/*.c) +ALL_SYS_SRC=$(wildcard sys/$(ERLANG_OSTYPE)/*.c) $(wildcard sys/common/*.c) +TARGET_SRC=$(wildcard $(TARGET)/*.c) $(wildcard $(TTF_DIR)/*.c) + +# I do not want the -MG flag on windows, it does not work properly for a +# windows build. + +ifeq ($(TARGET),win32) + +#DEP_CC=$(EMU_CC) +DEP_CC=$(CC) +DEP_FLAGS=-MM $(subst -O2,,$(CFLAGS)) $(INCLUDES) -I../etc/win32 -Idrivers/common +# ifeq (@MIXED_CYGWIN_VC@,yes) +# VC++ used for compiling. If __GNUC__ is defined we will include +# other headers then when compiling which will result in faulty +# dependencies. +# DEP_FLAGS += -U__GNUC__ +# endif +# On windows we have the erl_poll implementation in sys/win32 (no longer...) +# SYS_SRC=$(subst sys/common/erl_poll.c,,$(ALL_SYS_SRC)) + +else # !win32 +DEP_CC=$(CC) +DEP_FLAGS=-MM -MG $(CFLAGS) $(INCLUDES) -Idrivers/common +SYS_SRC=$(ALL_SYS_SRC) +endif + +depend: + $(DEP_CC) $(DEP_FLAGS) $(BEAM_SRC) \ + | $(SED_DEPEND) > $(TARGET)/depend.mk + $(DEP_CC) $(DEP_FLAGS) $(DRV_SRC) \ + | $(SED_DEPEND) >> $(TARGET)/depend.mk + $(DEP_CC) $(DEP_FLAGS) $(SYS_SRC) \ + | $(SED_DEPEND) >> $(TARGET)/depend.mk + $(DEP_CC) $(DEP_FLAGS) $(TARGET_SRC) \ + | $(SED_DEPEND) >> $(TARGET)/depend.mk +ifneq ($(TARGET),win32) + $(DEP_CC) $(DEP_FLAGS) $(ELIB_FLAGS) $(ELIB_C_FILES) \ + | $(SED_ELIB_DEPEND) >> $(TARGET)/depend.mk +endif +ifdef HIPE_ENABLED + $(DEP_CC) $(DEP_FLAGS) $(HIPE_SRC) \ + | $(SED_DEPEND) >> $(TARGET)/depend.mk +endif +-include $(TARGET)/depend.mk + + + diff --git a/erts/emulator/beam/atom.c b/erts/emulator/beam/atom.c new file mode 100644 index 0000000000..dfc3cde6a7 --- /dev/null +++ b/erts/emulator/beam/atom.c @@ -0,0 +1,354 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_sys_driver.h" +#include "erl_vm.h" +#include "global.h" +#include "hash.h" +#include "atom.h" + + +#define ATOM_SIZE 3000 + +IndexTable erts_atom_table; /* The index table */ + +#include "erl_smp.h" + +static erts_smp_rwmtx_t atom_table_lock; + +#define atom_read_lock() erts_smp_rwmtx_rlock(&atom_table_lock) +#define atom_read_unlock() erts_smp_rwmtx_runlock(&atom_table_lock) +#define atom_write_lock() erts_smp_rwmtx_rwlock(&atom_table_lock) +#define atom_write_unlock() erts_smp_rwmtx_rwunlock(&atom_table_lock) +#define atom_init_lock() erts_smp_rwmtx_init(&atom_table_lock, \ + "atom_tab") +#if 0 +#define ERTS_ATOM_PUT_OPS_STAT +#endif +#ifdef ERTS_ATOM_PUT_OPS_STAT +static erts_smp_atomic_t atom_put_ops; +#endif + +/* Functions for allocating space for the ext of atoms. We do not + * use malloc for each atom to prevent excessive memory fragmentation + */ + +typedef struct _atom_text { + struct _atom_text* next; + unsigned char text[ATOM_TEXT_SIZE]; +} AtomText; + +static AtomText* text_list; /* List of text buffers */ +static byte *atom_text_pos; +static byte *atom_text_end; +static Uint reserved_atom_space; /* Total amount of atom text space */ +static Uint atom_space; /* Amount of atom text space used */ + +/* + * Print info about atom tables + */ +void atom_info(int to, void *to_arg) +{ + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + atom_read_lock(); + index_info(to, to_arg, &erts_atom_table); +#ifdef ERTS_ATOM_PUT_OPS_STAT + erts_print(to, to_arg, "atom_put_ops: %ld\n", + erts_smp_atomic_read(&atom_put_ops)); +#endif + + if (lock) + atom_read_unlock(); +} + +/* + * Allocate an atom text segment. + */ +static void +more_atom_space(void) +{ + AtomText* ptr; + + ptr = (AtomText*) erts_alloc(ERTS_ALC_T_ATOM_TXT, sizeof(AtomText)); + + ptr->next = text_list; + text_list = ptr; + + atom_text_pos = ptr->text; + atom_text_end = atom_text_pos + ATOM_TEXT_SIZE; + reserved_atom_space += sizeof(AtomText); + + VERBOSE(DEBUG_SYSTEM,("Allocated %d atom space\n",ATOM_TEXT_SIZE)); +} + +/* + * Allocate string space within an atom text segment. + */ + +static byte* +atom_text_alloc(int bytes) +{ + byte *res; + + ASSERT(bytes <= MAX_ATOM_LENGTH); + if (atom_text_pos + bytes >= atom_text_end) { + more_atom_space(); + } + res = atom_text_pos; + atom_text_pos += bytes; + atom_space += bytes; + return res; +} + +/* + * Calculate atom hash value (using the hash algorithm + * hashpjw from the Dragon Book). + */ + +static HashValue +atom_hash(Atom* obj) +{ + byte* p = obj->name; + int len = obj->len; + HashValue h = 0, g; + + while(len--) { + h = (h << 4) + *p++; + if ((g = h & 0xf0000000)) { + h ^= (g >> 24); + h ^= g; + } + } + return h; +} + + +static int +atom_cmp(Atom* tmpl, Atom* obj) +{ + if (tmpl->len == obj->len && + sys_memcmp(tmpl->name, obj->name, tmpl->len) == 0) + return 0; + return 1; +} + + +static Atom* +atom_alloc(Atom* tmpl) +{ + Atom* obj = (Atom*) erts_alloc(ERTS_ALC_T_ATOM, sizeof(Atom)); + + obj->name = atom_text_alloc(tmpl->len); + sys_memcpy(obj->name, tmpl->name, tmpl->len); + obj->len = tmpl->len; + obj->slot.index = -1; + + /* + * Precompute ordinal value of first 3 bytes + 7 bits. + * This is used by utils.c:cmp_atoms(). + * We cannot use the full 32 bits of the first 4 bytes, + * since we use the sign of the difference between two + * ordinal values to represent their relative order. + */ + { + unsigned char c[4]; + int i; + int j; + + j = (tmpl->len < 4) ? tmpl->len : 4; + for(i = 0; i < j; ++i) + c[i] = tmpl->name[i]; + for(; i < 4; ++i) + c[i] = '\0'; + obj->ord0 = (c[0] << 23) + (c[1] << 15) + (c[2] << 7) + (c[3] >> 1); + } + return obj; +} + +static void +atom_free(Atom* obj) +{ + erts_free(ERTS_ALC_T_ATOM, (void*) obj); +} + +Eterm +am_atom_put(const char* name, int len) +{ + Atom a; + Eterm ret; + int aix; + + /* + * Silently truncate the atom if it is too long. Overlong atoms + * could occur in situations where we have no good way to return + * an error, such as in the I/O system. (Unfortunately, many + * drivers don't check for errors.) + * + * If an error should be produced for overlong atoms (such in + * list_to_atom/1), the caller should check the length before + * calling this function. + */ + if (len > MAX_ATOM_LENGTH) { + len = MAX_ATOM_LENGTH; + } +#ifdef ERTS_ATOM_PUT_OPS_STAT + erts_smp_atomic_inc(&atom_put_ops); +#endif + a.len = len; + a.name = (byte*)name; + atom_read_lock(); + aix = index_get(&erts_atom_table, (void*) &a); + atom_read_unlock(); + if (aix >= 0) + ret = make_atom(aix); + else { + atom_write_lock(); + ret = make_atom(index_put(&erts_atom_table, (void*) &a)); + atom_write_unlock(); + } + return ret; +} + + +int atom_table_size(void) +{ + int ret; +#ifdef ERTS_SMP + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + atom_read_lock(); +#endif + ret = erts_atom_table.entries; +#ifdef ERTS_SMP + if (lock) + atom_read_unlock(); +#endif + return ret; +} + +int atom_table_sz(void) +{ + int ret; +#ifdef ERTS_SMP + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + atom_read_lock(); +#endif + ret = index_table_sz(&erts_atom_table); +#ifdef ERTS_SMP + if (lock) + atom_read_unlock(); +#endif + return ret; +} + +int +erts_atom_get(const char *name, int len, Eterm* ap) +{ + Atom a; + int i; + int res; + + a.len = len; + a.name = (byte *)name; + atom_read_lock(); + i = index_get(&erts_atom_table, (void*) &a); + res = i < 0 ? 0 : (*ap = make_atom(i), 1); + atom_read_unlock(); + return res; +} + +void +erts_atom_get_text_space_sizes(Uint *reserved, Uint *used) +{ +#ifdef ERTS_SMP + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + atom_read_lock(); +#endif + if (reserved) + *reserved = reserved_atom_space; + if (used) + *used = atom_space; +#ifdef ERTS_SMP + if (lock) + atom_read_unlock(); +#endif +} + +void +init_atom_table(void) +{ + HashFunctions f; + int i; + Atom a; + +#ifdef ERTS_ATOM_PUT_OPS_STAT + erts_smp_atomic_init(&atom_put_ops, 0); +#endif + + atom_init_lock(); + f.hash = (H_FUN) atom_hash; + f.cmp = (HCMP_FUN) atom_cmp; + f.alloc = (HALLOC_FUN) atom_alloc; + f.free = (HFREE_FUN) atom_free; + + atom_text_pos = NULL; + atom_text_end = NULL; + reserved_atom_space = 0; + atom_space = 0; + text_list = NULL; + + erts_index_init(ERTS_ALC_T_ATOM_TABLE, &erts_atom_table, + "atom_tab", ATOM_SIZE, ATOM_LIMIT, f); + more_atom_space(); + + /* Ordinary atoms */ + for (i = 0; erl_atom_names[i] != 0; i++) { + int ix; + a.len = strlen(erl_atom_names[i]); + a.name = (byte*)erl_atom_names[i]; + a.slot.index = i; + ix = index_put(&erts_atom_table, (void*) &a); + atom_text_pos -= a.len; + atom_space -= a.len; + atom_tab(ix)->name = (byte*)erl_atom_names[i]; + } +} + +void +dump_atoms(int to, void *to_arg) +{ + int i = erts_atom_table.entries; + + /* + * Print out the atom table starting from the end. + */ + while (--i >= 0) { + if (erts_index_lookup(&erts_atom_table, i)) { + erts_print(to, to_arg, "%T\n", make_atom(i)); + } + } +} diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h new file mode 100644 index 0000000000..e7e0dc440d --- /dev/null +++ b/erts/emulator/beam/atom.h @@ -0,0 +1,104 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ATOM_H__ +#define __ATOM_H__ + +#ifndef __INDEX_H__ +#include "index.h" +#endif + +#include "erl_atom_table.h" + +#define MAX_ATOM_LENGTH 255 +#define ATOM_LIMIT (1024*1024) + +/* + * Atom entry. + */ +typedef struct atom { + IndexSlot slot; /* MUST BE LOCATED AT TOP OF STRUCT!!! */ + int len; /* length of atom name */ + int ord0; /* ordinal value of first 3 bytes + 7 bits */ + byte* name; /* name of atom */ +} Atom; + +extern IndexTable erts_atom_table; + +ERTS_GLB_INLINE Atom* atom_tab(Uint i); +ERTS_GLB_INLINE int erts_is_atom_bytes(byte *text, size_t len, Eterm term); +ERTS_GLB_INLINE int erts_is_atom_str(char *str, Eterm term); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE Atom* +atom_tab(Uint i) +{ + return (Atom *) erts_index_lookup(&erts_atom_table, i); +} + +ERTS_GLB_INLINE int erts_is_atom_bytes(byte *text, size_t len, Eterm term) +{ + Atom *a; + if (!is_atom(term)) + return 0; + a = atom_tab(atom_val(term)); + return (len == (size_t) a->len + && sys_memcmp((void *) a->name, (void *) text, len) == 0); +} + +ERTS_GLB_INLINE int erts_is_atom_str(char *str, Eterm term) +{ + Atom *a; + int i, len; + char *aname; + if (!is_atom(term)) + return 0; + a = atom_tab(atom_val(term)); + len = a->len; + aname = (char *) a->name; + for (i = 0; i < len; i++) + if (aname[i] != str[i] || str[i] == '\0') + return 0; + return str[len] == '\0'; +} + +#endif + +/* + * Note, ERTS_IS_ATOM_STR() expects the first argument to be a + * string literal. + */ +#define ERTS_IS_ATOM_STR(LSTR, TERM) \ + (erts_is_atom_bytes((byte *) LSTR, sizeof(LSTR) - 1, (TERM))) +#define ERTS_DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) +#define ERTS_INIT_AM(S) AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) + +int atom_table_size(void); /* number of elements */ +int atom_table_sz(void); /* table size in bytes, excluding stored objects */ + +Eterm am_atom_put(const char*, int); /* most callers pass plain char*'s */ +int atom_erase(byte*, int); +int atom_static_put(byte*, int); +void init_atom_table(void); +void atom_info(int, void *); +void dump_atoms(int, void *); +int erts_atom_get(const char* name, int len, Eterm* ap); +void erts_atom_get_text_space_sizes(Uint *reserved, Uint *used); +#endif + diff --git a/erts/emulator/beam/atom.names b/erts/emulator/beam/atom.names new file mode 100644 index 0000000000..04eac2d807 --- /dev/null +++ b/erts/emulator/beam/atom.names @@ -0,0 +1,540 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# File format: +# +# Lines starting with '#' are ignored. +# +# ::= "atom" + +# ::= | +# "'" "'" | +# "=" "'" "'" +# ::= [a-z][a-zA-Z_0-9]* +# ::= [A-Z][a-zA-Z_0-9]* +# ::= .* +# +# (although some characters may poison the Perl parser) +# + +# +# Frequently used atoms. +# +atom false true +atom Underscore='_' +atom Noname='nonode@nohost' +atom EOT='$end_of_table' +atom Cookie='' + +# +# Used in the Beam emulator loop. (Smaller literals usually means tighter code.) +# +atom fun infinity timeout normal call return +atom throw error exit +atom undefined + +# +# Used in beam_emu.c. +# +atom nocatch +atom undefined_function +atom undefined_lambda + + +# All other atoms. Try to keep the order alphabetic. +# +atom DOWN='DOWN' +atom UP='UP' +atom EXIT='EXIT' +atom aborted +atom abs_path +atom absoluteURI +atom active +atom all +atom all_but_first +atom allocated +atom allocated_areas +atom allocator +atom allocator_sizes +atom alloc_util_allocators +atom allow_passive_connect +atom already_loaded +atom anchored +atom and +atom andalso +atom andthen +atom any +atom anycrlf +atom apply +atom args +atom arg0 +atom arity +atom asn1 +atom asynchronous +atom atom +atom atom_used +atom attributes +atom await_proc_exit +atom awaiting_load +atom awaiting_unload +atom backtrace backtrace_depth +atom badarg badarith badarity badfile badmatch badsig badfun +atom bag +atom band +atom big +atom bif_return_trap +atom binary +atom block +atom blocked +atom bnot +atom bor +atom bxor +atom break_ignored +atom breakpoint +atom bsl +atom bsr +atom bsr_anycrlf +atom bsr_unicode +atom busy_dist_port +atom busy_port +atom call +atom call_count +atom caller +atom capture +atom case_clause +atom caseless +atom catchlevel +atom cd +atom cdr +atom characters_to_binary_int +atom characters_to_list_int +atom clear +atom close +atom closed +atom code +atom command +atom compat_rel +atom compile +atom compressed +atom connect +atom connected +atom connection_closed +atom cons +atom const +atom context_switches +atom copy +atom cpu +atom cpu_timestamp +atom cr +atom crlf +atom creation +atom current_function +atom data +atom debug_flags +atom delay_trap +atom dexit +atom depth +atom dgroup_leader +atom dictionary +atom disable_trace +atom disabled +atom display_items +atom dist +atom Div='/' +atom div +atom dlink +atom dmonitor_node +atom dmonitor_p +atom DollarDollar='$$' +atom DollarUnderscore='$_' +atom dollar_endonly +atom dotall +atom driver +atom driver_options +atom dsend +atom dunlink +atom duplicate_bag +atom dupnames +atom elib_malloc +atom emulator +atom enable_trace +atom enabled +atom endian +atom env +atom eof +atom eol +atom exception_from +atom exception_trace +atom extended +atom Eq='=:=' +atom Eqeq='==' +atom erlang +atom ERROR='ERROR' +atom error_handler +atom error_logger +atom ets +atom ETS_TRANSFER='ETS-TRANSFER' +atom event +atom exact_reductions +atom exclusive +atom exit_status +atom existing +atom exiting +atom exports +atom external +atom false +atom fcgi +atom fd +atom first +atom firstline +atom flags +atom flush +atom flush_monitor_message +atom force +atom format_cpu_topology +atom free +atom fullsweep_after +atom fullsweep_if_old_binaries +atom fun +atom function +atom functions +atom function_clause +atom garbage_collecting +atom garbage_collection +atom gc_end +atom gc_start +atom Ge='>=' +atom generational +atom get_seq_token +atom get_tcw +atom getenv +atom getting_linked +atom getting_unlinked +atom global +atom global_heaps_size +atom Gt='>' +atom grun +atom group_leader +atom heap_block_size +atom heap_size +atom heap_sizes +atom heap_type +atom heir +atom hidden +atom hide +atom high +atom hipe_architecture +atom http httph https http_response http_request http_header http_eoh http_error http_bin httph_bin +atom hybrid +atom id +atom if_clause +atom imports +atom in +atom in_exiting +atom inactive +atom incomplete +atom inconsistent +atom index +atom infinity +atom info +atom info_msg +atom initial_call +atom input +atom internal_error +atom internal_status +atom instruction_counts +atom invalid +atom is_constant +atom is_seq_trace +atom io +atom keypos +atom kill +atom killed +atom kill_ports +atom known +atom label +atom large_heap +atom last_calls +atom latin1 +atom Le='=<' +atom lf +atom line +atom line_length +atom linked_in_driver +atom links +atom list +atom little +atom loaded +atom load_cancelled +atom load_failure +atom local +atom long_gc +atom low +atom Lt='<' +atom machine +atom match +atom match_spec +atom max +atom maximum +atom max_tables max_processes +atom mbuf_size +atom memory +atom memory_types +atom message +atom message_binary +atom message_queue_len +atom messages +atom meta +atom meta_match_spec +atom min_heap_size +atom minor_version +atom Minus='-' +atom module +atom module_info +atom monitored_by +atom monitor +atom monitor_nodes +atom monitors +atom more +atom multi_scheduling +atom multiline +atom name +atom named_table +atom native_addresses +atom Neq='=/=' +atom Neqeq='/=' +atom net_kernel +atom net_kernel_terminated +atom new +atom new_index +atom new_uniq +atom newline +atom next +atom no +atom nomatch +atom none +atom no_auto_capture +atom noconnect +atom noconnection +atom nocookie +atom node +atom node_type +atom nodedown +atom nodedown_reason +atom nodeup +atom noeol +atom nofile +atom noproc +atom normal +atom nosuspend +atom no_float +atom no_integer +atom no_network +atom not +atom not_a_list +atom not_loaded +atom not_loaded_by_this_process +atom not_pending +atom not_purged +atom notalive +atom notbol +atom noteol +atom notempty +atom notify +atom notsup +atom nouse_stdio +atom objects +atom offset +atom ok +atom old_heap_block_size +atom old_heap_size +atom on_load +atom open +atom open_error +atom or +atom ordered_set +atom orelse +atom os_type +atom os_version +atom ose_bg_proc +atom ose_int_proc +atom ose_phantom +atom ose_pri_proc +atom ose_process_prio +atom ose_process_type +atom ose_ti_proc +atom out +atom out_exited +atom out_exiting +atom output +atom overlapped_io +atom owner +atom packet +atom packet_size +atom Plus='+' +atom pause +atom pending +atom pending_driver +atom pending_process +atom pending_reload +atom permanent +atom pid +atom port +atom ports +atom port_count +atom print +atom priority +atom private +atom process +atom processes +atom processes_trap +atom processes_used +atom process_count +atom process_display +atom process_limit +atom process_dump +atom procs +atom profile +atom protected +atom protection +atom public +atom purify +atom quantify +atom queue_size +atom raw +atom re +atom re_pattern +atom re_run_trap +atom ready_input +atom ready_output +atom ready_async +atom reason +atom receive +atom recent_size +atom reductions +atom refc +atom register +atom registered_name +atom reload +atom rem +atom reset +atom restart +atom return_from +atom return_to +atom return_trace +atom run_queue +atom runnable +atom runnable_ports +atom runnable_procs +atom running +atom running_ports +atom running_procs +atom runtime +atom save_calls +atom scheduler +atom scheduler_id +atom schedulers_online +atom scheme +atom sensitive +atom sequential_tracer +atom sequential_trace_token +atom serial +atom set +atom set_cpu_topology +atom set_on_first_link +atom set_on_first_spawn +atom set_on_link +atom set_on_spawn +atom set_seq_token +atom set_tcw +atom set_tcw_fake +atom separate +atom shared +atom silent +atom size +atom sl_alloc +atom spawn_executable +atom spawn_driver +atom ssl_tls +atom stack_size +atom start +atom status +atom static +atom stderr_to_stdout +atom stop +atom stream +atom sunrm +atom suspend +atom suspended +atom suspending +atom sys_misc +atom system +atom system_error +atom system_limit +atom system_version +atom system_architecture +atom SYSTEM='SYSTEM' +atom table +atom this +atom thread_pool_size +atom threads +atom timeout +atom timeout_value +atom Times='*' +atom timestamp +atom total +atom total_heap_size +atom tpkt +atom trace trace_ts traced +atom trace_control_word +atom tracer +atom trap_exit +atom try_clause +atom true +atom tuple +atom type +atom ucompile +atom undef +atom ungreedy +atom unicode +atom unregister +atom urun +atom use_stdio +atom used +atom utf8 +atom unblock +atom uniq +atom unless_suspending +atom unloaded +atom unloading +atom unloaded_only +atom unload_cancelled +atom value +atom values +atom version +atom visible +atom waiting +atom wall_clock +atom warning +atom warning_msg +atom wordsize +atom write_concurrency +atom xor +atom yes +atom yield diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c new file mode 100644 index 0000000000..d3a1ed4e7d --- /dev/null +++ b/erts/emulator/beam/beam_bif_load.c @@ -0,0 +1,795 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "beam_load.h" +#include "big.h" +#include "beam_bp.h" +#include "beam_catches.h" +#include "erl_binary.h" +#include "erl_nif.h" + +static void set_default_trace_pattern(Eterm module); +static Eterm check_process_code(Process* rp, Module* modp); +static void delete_code(Process *c_p, ErtsProcLocks c_p_locks, Module* modp); +static void delete_export_references(Eterm module); +static int purge_module(int module); +static int is_native(Eterm* code); +static int any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); +static int any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size); +static void remove_from_address_table(Eterm* code); + +Eterm +load_module_2(BIF_ALIST_2) +{ + Eterm reason; + Eterm* hp; + int i; + int sz; + byte* code; + Eterm res; + byte* temp_alloc = NULL; + + if (is_not_atom(BIF_ARG_1)) { + error: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); + } + if ((code = erts_get_aligned_binary_bytes(BIF_ARG_2, &temp_alloc)) == NULL) { + goto error; + } + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + erts_export_consolidate(); + + hp = HAlloc(BIF_P, 3); + sz = binary_size(BIF_ARG_2); + if ((i = erts_load_module(BIF_P, 0, + BIF_P->group_leader, &BIF_ARG_1, code, sz)) < 0) { + switch (i) { + case -1: reason = am_badfile; break; + case -2: reason = am_nofile; break; + case -3: reason = am_not_purged; break; + case -4: + reason = am_atom_put("native_code", sizeof("native_code")-1); + break; + case -5: + { + /* + * The module contains an on_load function. The loader + * has loaded the module as usual, except that the + * export entries does not point into the module, so it + * is not possible to call any code in the module. + */ + + ERTS_DECL_AM(on_load); + reason = AM_on_load; + break; + } + default: reason = am_badfile; break; + } + res = TUPLE2(hp, am_error, reason); + goto done; + } + + set_default_trace_pattern(BIF_ARG_1); + res = TUPLE2(hp, am_module, BIF_ARG_1); + + done: + erts_free_aligned_binary_bytes(temp_alloc); + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + + BIF_RET(res); +} + +BIF_RETTYPE purge_module_1(BIF_ALIST_1) +{ + int purge_res; + + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + erts_export_consolidate(); + purge_res = purge_module(atom_val(BIF_ARG_1)); + + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + + if (purge_res < 0) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(am_true); +} + +BIF_RETTYPE code_is_module_native_1(BIF_ALIST_1) +{ + Module* modp; + + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + if ((modp = erts_get_module(BIF_ARG_1)) == NULL) { + return am_undefined; + } + return (is_native(modp->code) || + (modp->old_code != 0 && is_native(modp->old_code))) ? + am_true : am_false; +} + +BIF_RETTYPE code_make_stub_module_3(BIF_ALIST_3) +{ + Eterm res; + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + erts_export_consolidate(); + res = erts_make_stub_module(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + return res; +} + +Eterm +check_process_code_2(BIF_ALIST_2) +{ + Process* rp; + Module* modp; + + if (is_not_atom(BIF_ARG_2)) { + goto error; + } + if (is_internal_pid(BIF_ARG_1)) { + Eterm res; + if (internal_pid_index(BIF_ARG_1) >= erts_max_processes) + goto error; + rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCK_MAIN); + if (!rp) { + BIF_RET(am_false); + } + if (rp == ERTS_PROC_LOCK_BUSY) { + ERTS_BIF_YIELD2(bif_export[BIF_check_process_code_2], BIF_P, + BIF_ARG_1, BIF_ARG_2); + } + modp = erts_get_module(BIF_ARG_2); + res = check_process_code(rp, modp); +#ifdef ERTS_SMP + if (BIF_P != rp) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); +#endif + BIF_RET(res); + } + else if (is_external_pid(BIF_ARG_1) + && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) { + BIF_RET(am_false); + } + + error: + BIF_ERROR(BIF_P, BADARG); +} + + +BIF_RETTYPE delete_module_1(BIF_ALIST_1) +{ + int res; + + if (is_not_atom(BIF_ARG_1)) + goto badarg; + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + { + Module *modp = erts_get_module(BIF_ARG_1); + if (!modp) { + res = am_undefined; + } + else if (modp->old_code != 0) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Module %T must be purged before loading\n", + BIF_ARG_1); + erts_send_error_to_logger(BIF_P->group_leader, dsbufp); + res = am_badarg; + } + else { + delete_export_references(BIF_ARG_1); + delete_code(BIF_P, 0, modp); + res = am_true; + } + } + + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + + if (res == am_badarg) { + badarg: + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(res); +} + +BIF_RETTYPE module_loaded_1(BIF_ALIST_1) +{ + Module* modp; + + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + if ((modp = erts_get_module(BIF_ARG_1)) == NULL || + modp->code == NULL || + modp->code[MI_ON_LOAD_FUNCTION_PTR] != 0) { + BIF_RET(am_false); + } + BIF_RET(am_true); +} + +BIF_RETTYPE pre_loaded_0(BIF_ALIST_0) +{ + return erts_preloaded(BIF_P); +} + +BIF_RETTYPE loaded_0(BIF_ALIST_0) +{ + Eterm previous = NIL; + Eterm* hp; + int i; + int j = 0; + + for (i = 0; i < module_code_size(); i++) { + if (module_code(i) != NULL && + ((module_code(i)->code_length != 0) || + (module_code(i)->old_code_length != 0))) { + j++; + } + } + if (j > 0) { + hp = HAlloc(BIF_P, j*2); + + for (i = 0; i < module_code_size(); i++) { + if (module_code(i) != NULL && + ((module_code(i)->code_length != 0) || + (module_code(i)->old_code_length != 0))) { + previous = CONS(hp, make_atom(module_code(i)->module), + previous); + hp += 2; + } + } + } + BIF_RET(previous); +} + +BIF_RETTYPE call_on_load_function_1(BIF_ALIST_1) +{ + Module* modp = erts_get_module(BIF_ARG_1); + Eterm on_load; + + if (!modp || modp->code == 0) { + error: + BIF_ERROR(BIF_P, BADARG); + } + if ((on_load = modp->code[MI_ON_LOAD_FUNCTION_PTR]) == 0) { + goto error; + } + BIF_TRAP_CODE_PTR_0(BIF_P, on_load); +} + +BIF_RETTYPE finish_after_on_load_2(BIF_ALIST_2) +{ + Module* modp = erts_get_module(BIF_ARG_1); + Eterm on_load; + + if (!modp || modp->code == 0) { + error: + BIF_ERROR(BIF_P, BADARG); + } + if ((on_load = modp->code[MI_ON_LOAD_FUNCTION_PTR]) == 0) { + goto error; + } + if (BIF_ARG_2 != am_false && BIF_ARG_2 != am_true) { + goto error; + } + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + if (BIF_ARG_2 == am_true) { + int i; + + /* + * The on_load function succeded. Fix up export entries. + */ + for (i = 0; i < export_list_size(); i++) { + Export *ep = export_list(i); + if (ep != NULL && + ep->code[0] == BIF_ARG_1 && + ep->code[4] != 0) { + ep->address = (void *) ep->code[4]; + ep->code[3] = 0; + ep->code[4] = 0; + } + } + modp->code[MI_ON_LOAD_FUNCTION_PTR] = 0; + set_default_trace_pattern(BIF_ARG_1); + } else if (BIF_ARG_2 == am_false) { + Eterm* code; + Eterm* end; + + /* + * The on_load function failed. Remove the loaded code. + * This is an combination of delete and purge. We purge + * the current code; the old code is not touched. + */ + erts_total_code_size -= modp->code_length; + code = modp->code; + end = (Eterm *)((char *)code + modp->code_length); + erts_cleanup_funs_on_purge(code, end); + beam_catches_delmod(modp->catches, code, modp->code_length); + erts_free(ERTS_ALC_T_CODE, (void *) code); + modp->code = NULL; + modp->code_length = 0; + modp->catches = BEAM_CATCHES_NIL; + remove_from_address_table(code); + } + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(am_true); +} + + +static void +set_default_trace_pattern(Eterm module) +{ + int trace_pattern_is_on; + Binary *match_spec; + Binary *meta_match_spec; + struct trace_pattern_flags trace_pattern_flags; + Eterm meta_tracer_pid; + + erts_get_default_trace_pattern(&trace_pattern_is_on, + &match_spec, + &meta_match_spec, + &trace_pattern_flags, + &meta_tracer_pid); + if (trace_pattern_is_on) { + Eterm mfa[1]; + mfa[0] = module; + (void) erts_set_trace_pattern(mfa, 1, + match_spec, + meta_match_spec, + 1, trace_pattern_flags, + meta_tracer_pid); + } +} + +static Eterm +check_process_code(Process* rp, Module* modp) +{ + Eterm* start; + char* mod_start; + Uint mod_size; + Eterm* end; + Eterm* sp; +#ifndef HYBRID /* FIND ME! */ + ErlFunThing* funp; + int done_gc = 0; +#endif + +#define INSIDE(a) (start <= (a) && (a) < end) + if (modp == NULL) { /* Doesn't exist. */ + return am_false; + } else if (modp->old_code == NULL) { /* No old code. */ + return am_false; + } + + /* + * Pick up limits for the module. + */ + start = modp->old_code; + end = (Eterm *)((char *)start + modp->old_code_length); + mod_start = (char *) start; + mod_size = modp->old_code_length; + + /* + * Check if current instruction or continuation pointer points into module. + */ + if (INSIDE(rp->i) || INSIDE(rp->cp)) { + return am_true; + } + + /* + * Check all continuation pointers stored on the stack. + */ + for (sp = rp->stop; sp < STACK_START(rp); sp++) { + if (is_CP(*sp) && INSIDE(cp_val(*sp))) { + return am_true; + } + } + + /* + * Check all continuation pointers stored in stackdump + * and clear exception stackdump if there is a pointer + * to the module. + */ + if (rp->ftrace != NIL) { + struct StackTrace *s; + ASSERT(is_list(rp->ftrace)); + s = (struct StackTrace *) big_val(CDR(list_val(rp->ftrace))); + if ((s->pc && INSIDE(s->pc)) || + (s->current && INSIDE(s->current))) { + rp->freason = EXC_NULL; + rp->fvalue = NIL; + rp->ftrace = NIL; + } else { + int i; + for (i = 0; i < s->depth; i++) { + if (INSIDE(s->trace[i])) { + rp->freason = EXC_NULL; + rp->fvalue = NIL; + rp->ftrace = NIL; + break; + } + } + } + } + + /* + * See if there are funs that refer to the old version of the module. + */ + +#ifndef HYBRID /* FIND ME! */ + rescan: + for (funp = MSO(rp).funs; funp; funp = funp->next) { + Eterm* fun_code; + + fun_code = funp->fe->address; + + if (INSIDE((Eterm *) funp->fe->address)) { + if (done_gc) { + return am_true; + } else { + /* + * Try to get rid of this fun by garbage collecting. + * Clear both fvalue and ftrace to make sure they + * don't hold any funs. + */ + rp->freason = EXC_NULL; + rp->fvalue = NIL; + rp->ftrace = NIL; + done_gc = 1; + FLAGS(rp) |= F_NEED_FULLSWEEP; + (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); + goto rescan; + } + } + } +#endif + + /* + * See if there are constants inside the module referenced by the process. + */ + done_gc = 0; + for (;;) { + ErlMessage* mp; + + if (any_heap_ref_ptrs(&rp->fvalue, &rp->fvalue+1, mod_start, mod_size)) { + rp->freason = EXC_NULL; + rp->fvalue = NIL; + rp->ftrace = NIL; + } + if (any_heap_ref_ptrs(rp->stop, rp->hend, mod_start, mod_size)) { + goto need_gc; + } + if (any_heap_refs(rp->heap, rp->htop, mod_start, mod_size)) { + goto need_gc; + } + + if (any_heap_refs(rp->old_heap, rp->old_htop, mod_start, mod_size)) { + goto need_gc; + } + + if (rp->dictionary != NULL) { + Eterm* start = rp->dictionary->data; + Eterm* end = start + rp->dictionary->used; + + if (any_heap_ref_ptrs(start, end, mod_start, mod_size)) { + goto need_gc; + } + } + + for (mp = rp->msg.first; mp != NULL; mp = mp->next) { + if (any_heap_ref_ptrs(mp->m, mp->m+2, mod_start, mod_size)) { + goto need_gc; + } + } + break; + + need_gc: + if (done_gc) { + return am_true; + } else { + Eterm* literals; + Uint lit_size; + + /* + * Try to get rid of constants by by garbage collecting. + * Clear both fvalue and ftrace. + */ + rp->freason = EXC_NULL; + rp->fvalue = NIL; + rp->ftrace = NIL; + done_gc = 1; + FLAGS(rp) |= F_NEED_FULLSWEEP; + (void) erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); + literals = (Eterm *) modp->old_code[MI_LITERALS_START]; + lit_size = (Eterm *) modp->old_code[MI_LITERALS_END] - literals; + erts_garbage_collect_literals(rp, literals, lit_size); + } + } + return am_false; +#undef INSIDE +} + +#define in_area(ptr,start,nbytes) \ + ((unsigned long)((char*)(ptr) - (char*)(start)) < (nbytes)) + +static int +any_heap_ref_ptrs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) +{ + Eterm* p; + Eterm val; + + for (p = start; p < end; p++) { + val = *p; + switch (primary_tag(val)) { + case TAG_PRIMARY_BOXED: + case TAG_PRIMARY_LIST: + if (in_area(val, mod_start, mod_size)) { + return 1; + } + break; + } + } + return 0; +} + +static int +any_heap_refs(Eterm* start, Eterm* end, char* mod_start, Uint mod_size) +{ + Eterm* p; + Eterm val; + + for (p = start; p < end; p++) { + val = *p; + switch (primary_tag(val)) { + case TAG_PRIMARY_BOXED: + case TAG_PRIMARY_LIST: + if (in_area(val, mod_start, mod_size)) { + return 1; + } + break; + case TAG_PRIMARY_HEADER: + if (!header_is_transparent(val)) { + Eterm* new_p = p + thing_arityval(val); + ASSERT(start <= new_p && new_p < end); + p = new_p; + } + } + } + return 0; +} + +#undef in_area + + +static int +purge_module(int module) +{ + Eterm* code; + Eterm* end; + Module* modp; + + /* + * Correct module? + */ + + if ((modp = erts_get_module(make_atom(module))) == NULL) { + return -2; + } + + /* + * Any code to purge? + */ + if (modp->old_code == 0) { + if (display_loads) { + erts_printf("No code to purge for %T\n", make_atom(module)); + } + return -1; + } + + /* + * Unload any NIF library + */ + if (modp->old_nif.handle != NULL) { + if (modp->old_nif.entry->unload != NULL) { + ErlNifEnv env; + env.nif_data = modp->old_nif.data; + env.proc = NULL; /* BUGBUG: unlink can not access calling process */ + env.hp = NULL; + env.hp_end = NULL; + env.heap_frag_sz = 0; + env.fpe_was_unmasked = erts_block_fpe(); + modp->old_nif.entry->unload(NULL, modp->old_nif.data); + erts_unblock_fpe(env.fpe_was_unmasked); + } + erts_sys_ddll_close(modp->old_nif.handle); + modp->old_nif.handle = NULL; + modp->old_nif.entry = NULL; + } + + /* + * Remove the old code. + */ + ASSERT(erts_total_code_size >= modp->old_code_length); + erts_total_code_size -= modp->old_code_length; + code = modp->old_code; + end = (Eterm *)((char *)code + modp->old_code_length); + erts_cleanup_funs_on_purge(code, end); + beam_catches_delmod(modp->old_catches, code, modp->old_code_length); + erts_free(ERTS_ALC_T_CODE, (void *) code); + modp->old_code = NULL; + modp->old_code_length = 0; + modp->old_catches = BEAM_CATCHES_NIL; + remove_from_address_table(code); + return 0; +} + +static void +remove_from_address_table(Eterm* code) +{ + int i; + + for (i = 0; i < num_loaded_modules; i++) { + if (modules[i].start == code) { + num_loaded_modules--; + while (i < num_loaded_modules) { + modules[i] = modules[i+1]; + i++; + } + mid_module = &modules[num_loaded_modules/2]; + return; + } + } + ASSERT(0); /* Not found? */ +} + + +/* + * Move code from current to old. + */ + +static void +delete_code(Process *c_p, ErtsProcLocks c_p_locks, Module* modp) +{ +#ifdef ERTS_ENABLE_LOCK_CHECK +#ifdef ERTS_SMP + if (c_p && c_p_locks) + erts_proc_lc_chk_only_proc_main(c_p); + else +#endif + erts_lc_check_exact(NULL, 0); +#endif + + /* + * Clear breakpoints if any + */ + if (modp->code != NULL && modp->code[MI_NUM_BREAKPOINTS] > 0) { + if (c_p && c_p_locks) + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + erts_clear_module_break(modp); + modp->code[MI_NUM_BREAKPOINTS] = 0; + erts_smp_release_system(); + if (c_p && c_p_locks) + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + } + modp->old_code = modp->code; + modp->old_code_length = modp->code_length; + modp->old_catches = modp->catches; + modp->old_nif = modp->nif; + modp->code = NULL; + modp->code_length = 0; + modp->catches = BEAM_CATCHES_NIL; + modp->nif.handle = NULL; + modp->nif.entry = NULL; +} + + +/* null all references on the export table for the module called with the + atom index below */ + +static void +delete_export_references(Eterm module) +{ + int i; + + ASSERT(is_atom(module)); + + for (i = 0; i < export_list_size(); i++) { + Export *ep = export_list(i); + if (ep != NULL && (ep->code[0] == module)) { + if (ep->address == ep->code+3 && + (ep->code[3] == (Eterm) em_apply_bif)) { + continue; + } + ep->address = ep->code+3; + ep->code[3] = (Uint) em_call_error_handler; + ep->code[4] = 0; + MatchSetUnref(ep->match_prog_set); + ep->match_prog_set = NULL; + } + } +} + + +int +beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module) +{ + Module* modp = erts_put_module(module); + + /* + * Check if the previous code has been already deleted; + * if not, delete old code; error if old code already exists. + */ + + if (modp->code != NULL && modp->old_code != NULL) { + return -3; + } else if (modp->old_code == NULL) { /* Make the current version old. */ + if (display_loads) { + erts_printf("saving old code\n"); + } + delete_code(c_p, c_p_locks, modp); + delete_export_references(module); + } + return 0; +} + +static int +is_native(Eterm* code) +{ + return ((Eterm *)code[MI_FUNCTIONS])[1] != 0; +} + + diff --git a/erts/emulator/beam/beam_bp.c b/erts/emulator/beam/beam_bp.c new file mode 100644 index 0000000000..1abf1dc10c --- /dev/null +++ b/erts/emulator/beam/beam_bp.c @@ -0,0 +1,785 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "beam_load.h" +#include "bif.h" +#include "error.h" +#include "erl_binary.h" +#include "beam_bp.h" + +/* ************************************************************************* +** Macros +*/ + +/* +** Memory allocation macros +*/ +/* Breakpoint data */ +#define Alloc(SZ) erts_alloc(ERTS_ALC_T_BPD, (SZ)) +#define ReAlloc(P, SIZ) erts_realloc(ERTS_ALC_T_BPD, (P), (SZ)) +#define Free(P) erts_free(ERTS_ALC_T_BPD, (P)) + +/* +** Doubly linked ring macros +*/ + +#define BpInit(a,i) \ +do { \ + (a)->orig_instr = (i); \ + (a)->next = (a); \ + (a)->prev = (a); \ +} while (0) + +#define BpSpliceNext(a,b) \ +do { \ + register BpData *c = (a), *d = (b), *e; \ + e = c->next->prev; \ + c->next->prev = d->next->prev; \ + d->next->prev = e; \ + e = c->next; \ + c->next = d->next; \ + d->next = e; \ +} while (0) + +#define BpSplicePrev(a,b) \ +do { \ + register BpData *c = (a), *d = (b), *e; \ + e = c->prev->next; \ + c->prev->next = d->prev->next; \ + d->prev->next = e; \ + e = c->prev; \ + c->prev = d->prev; \ + d->prev = e; \ +} while (0) + +#ifdef DEBUG +# define BpSingleton(a) ((a)->next == (a) && (a)->prev == (a)) +#else +# define BpSingleton(a) ((a)->next == (a)) +#endif + +#define BpInitAndSpliceNext(a,i,b) \ +do { \ + (a)->orig_instr = (i); \ + (a)->prev = (b); \ + (b)->next->prev = (a); \ + (a)->next = (b)->next; \ + (b)->next = (a); \ +} while (0) + +#define BpInitAndSplicePrev(a,i,b) \ +do { \ + (a)->orig_instr = (i); \ + (a)->next = (b); \ + (b)->prev->next = (a); \ + (a)->prev = (b)->prev; \ + (b)->prev = (a); \ +} while (0) + +/* ************************************************************************* +** Local prototypes +*/ + +/* +** Helpers +*/ + +static int set_break(Eterm mfa[3], int specified, + Binary *match_spec, Uint break_op, + enum erts_break_op count_op, Eterm tracer_pid); +static int set_module_break(Module *modp, Eterm mfa[3], int specified, + Binary *match_spec, Uint break_op, + enum erts_break_op count_op, Eterm tracer_pid); +static int set_function_break(Module *modp, Uint *pc, + Binary *match_spec, Uint break_op, + enum erts_break_op count_op, Eterm tracer_pid); + +static int clear_break(Eterm mfa[3], int specified, + Uint break_op); +static int clear_module_break(Module *modp, Eterm mfa[3], int specified, + Uint break_op); +static int clear_function_break(Module *modp, Uint *pc, + Uint break_op); + +static BpData *is_break(Uint *pc, Uint break_op); + + + +/* ************************************************************************* +** External interfaces +*/ + +erts_smp_spinlock_t erts_bp_lock; + +void +erts_bp_init(void) { + erts_smp_spinlock_init(&erts_bp_lock, "breakpoints"); +} + +int +erts_set_trace_break(Eterm mfa[3], int specified, Binary *match_spec, + Eterm tracer_pid) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return set_break(mfa, specified, match_spec, + (Uint) BeamOp(op_i_trace_breakpoint), 0, tracer_pid); +} + +int +erts_set_mtrace_break(Eterm mfa[3], int specified, Binary *match_spec, + Eterm tracer_pid) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return set_break(mfa, specified, match_spec, + (Uint) BeamOp(op_i_mtrace_breakpoint), 0, tracer_pid); +} + +void +erts_set_mtrace_bif(Uint *pc, Binary *match_spec, Eterm tracer_pid) { + BpDataTrace *bdt; + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + + bdt = (BpDataTrace *) pc[-4]; + if (bdt) { + MatchSetUnref(bdt->match_spec); + MatchSetRef(match_spec); + bdt->match_spec = match_spec; + bdt->tracer_pid = tracer_pid; + } else { + bdt = Alloc(sizeof(BpDataTrace)); + BpInit((BpData *) bdt, 0); + MatchSetRef(match_spec); + bdt->match_spec = match_spec; + bdt->tracer_pid = tracer_pid; + pc[-4] = (Uint) bdt; + } +} + +int +erts_set_debug_break(Eterm mfa[3], int specified) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return set_break(mfa, specified, NULL, + (Uint) BeamOp(op_i_debug_breakpoint), 0, NIL); +} + +int +erts_set_count_break(Eterm mfa[3], int specified, enum erts_break_op count_op) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return set_break(mfa, specified, NULL, + (Uint) BeamOp(op_i_count_breakpoint), count_op, NIL); +} + + + +int +erts_clear_trace_break(Eterm mfa[3], int specified) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return clear_break(mfa, specified, + (Uint) BeamOp(op_i_trace_breakpoint)); +} + +int +erts_clear_mtrace_break(Eterm mfa[3], int specified) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return clear_break(mfa, specified, + (Uint) BeamOp(op_i_mtrace_breakpoint)); +} + +void +erts_clear_mtrace_bif(Uint *pc) { + BpDataTrace *bdt; + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + + bdt = (BpDataTrace *) pc[-4]; + if (bdt) { + if (bdt->match_spec) { + MatchSetUnref(bdt->match_spec); + } + Free(bdt); + } + pc[-4] = (Uint) NULL; +} + +int +erts_clear_debug_break(Eterm mfa[3], int specified) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return clear_break(mfa, specified, + (Uint) BeamOp(op_i_debug_breakpoint)); +} + +int +erts_clear_count_break(Eterm mfa[3], int specified) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return clear_break(mfa, specified, + (Uint) BeamOp(op_i_count_breakpoint)); +} + +int +erts_clear_break(Eterm mfa[3], int specified) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + return clear_break(mfa, specified, 0); +} + +int +erts_clear_module_break(Module *modp) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ASSERT(modp); + return clear_module_break(modp, NULL, 0, 0); +} + +int +erts_clear_function_break(Module *modp, Uint *pc) { + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + ASSERT(modp); + return clear_function_break(modp, pc, 0); +} + + + +/* + * SMP NOTE: Process p may have become exiting on return! + */ +Uint +erts_trace_break(Process *p, Uint *pc, Eterm *args, + Uint32 *ret_flags, Eterm *tracer_pid) { + Eterm tpid1, tpid2; + BpDataTrace *bdt = (BpDataTrace *) pc[-4]; + + ASSERT(pc[-5] == (Uint) BeamOp(op_i_func_info_IaaI)); + ASSERT(bdt); + bdt = (BpDataTrace *) bdt->next; + ASSERT(bdt); + ASSERT(ret_flags); + ASSERT(tracer_pid); + + ErtsSmpBPLock(bdt); + tpid1 = tpid2 = bdt->tracer_pid; + ErtsSmpBPUnlock(bdt); + + *ret_flags = erts_call_trace(p, pc-3/*mfa*/, bdt->match_spec, args, + 1, &tpid2); + *tracer_pid = tpid2; + if (tpid1 != tpid2) { + ErtsSmpBPLock(bdt); + bdt->tracer_pid = tpid2; + ErtsSmpBPUnlock(bdt); + } + pc[-4] = (Uint) bdt; + return bdt->orig_instr; +} + + + +/* + * SMP NOTE: Process p may have become exiting on return! + */ +Uint32 +erts_bif_mtrace(Process *p, Uint *pc, Eterm *args, int local, + Eterm *tracer_pid) { + BpDataTrace *bdt = (BpDataTrace *) pc[-4]; + + ASSERT(tracer_pid); + if (bdt) { + Eterm tpid1, tpid2; + Uint32 flags; + + ErtsSmpBPLock(bdt); + tpid1 = tpid2 = bdt->tracer_pid; + ErtsSmpBPUnlock(bdt); + + flags = erts_call_trace(p, pc-3/*mfa*/, bdt->match_spec, args, + local, &tpid2); + *tracer_pid = tpid2; + if (tpid1 != tpid2) { + ErtsSmpBPLock(bdt); + bdt->tracer_pid = tpid2; + ErtsSmpBPUnlock(bdt); + } + return flags; + } + *tracer_pid = NIL; + return 0; +} + + + +int +erts_is_trace_break(Uint *pc, Binary **match_spec_ret, Eterm *tracer_pid_ret) { + BpDataTrace *bdt = + (BpDataTrace *) is_break(pc, (Uint) BeamOp(op_i_trace_breakpoint)); + + if (bdt) { + if (match_spec_ret) { + *match_spec_ret = bdt->match_spec; + } + if (tracer_pid_ret) { + ErtsSmpBPLock(bdt); + *tracer_pid_ret = bdt->tracer_pid; + ErtsSmpBPUnlock(bdt); + } + return !0; + } + return 0; +} + +int +erts_is_mtrace_break(Uint *pc, Binary **match_spec_ret, Eterm *tracer_pid_ret) { + BpDataTrace *bdt = + (BpDataTrace *) is_break(pc, (Uint) BeamOp(op_i_mtrace_breakpoint)); + + if (bdt) { + if (match_spec_ret) { + *match_spec_ret = bdt->match_spec; + } + if (tracer_pid_ret) { + ErtsSmpBPLock(bdt); + *tracer_pid_ret = bdt->tracer_pid; + ErtsSmpBPUnlock(bdt); + } + return !0; + } + return 0; +} + +int +erts_is_mtrace_bif(Uint *pc, Binary **match_spec_ret, Eterm *tracer_pid_ret) { + BpDataTrace *bdt = (BpDataTrace *) pc[-4]; + + if (bdt) { + if (match_spec_ret) { + *match_spec_ret = bdt->match_spec; + } + if (tracer_pid_ret) { + ErtsSmpBPLock(bdt); + *tracer_pid_ret = bdt->tracer_pid; + ErtsSmpBPUnlock(bdt); + } + return !0; + } + return 0; +} + +int +erts_is_native_break(Uint *pc) { +#ifdef HIPE + ASSERT(pc[-5] == (Uint) BeamOp(op_i_func_info_IaaI)); + return pc[0] == (Uint) BeamOp(op_hipe_trap_call) + || pc[0] == (Uint) BeamOp(op_hipe_trap_call_closure); +#else + return 0; +#endif +} + +int +erts_is_count_break(Uint *pc, Sint *count_ret) { + BpDataCount *bdc = + (BpDataCount *) is_break(pc, (Uint) BeamOp(op_i_count_breakpoint)); + + if (bdc) { + if (count_ret) { + ErtsSmpBPLock(bdc); + *count_ret = bdc->count; + ErtsSmpBPUnlock(bdc); + } + return !0; + } + return 0; +} + +Uint * +erts_find_local_func(Eterm mfa[3]) { + Module *modp; + Uint** code_base; + Uint* code_ptr; + Uint i,n; + + if ((modp = erts_get_module(mfa[0])) == NULL) + return NULL; + if ((code_base = (Uint **) modp->code) == NULL) + return NULL; + n = (Uint) code_base[MI_NUM_FUNCTIONS]; + for (i = 0; i < n; ++i) { + code_ptr = code_base[MI_FUNCTIONS+i]; + ASSERT(((Uint) BeamOp(op_i_func_info_IaaI)) == code_ptr[0]); + ASSERT(mfa[0] == ((Eterm) code_ptr[2])); + if (mfa[1] == ((Eterm) code_ptr[3]) && + ((Uint) mfa[2]) == code_ptr[4]) { + return code_ptr + 5; + } + } + return NULL; +} + + + +/* ************************************************************************* +** Local helpers +*/ + + +static int set_break(Eterm mfa[3], int specified, + Binary *match_spec, Eterm break_op, + enum erts_break_op count_op, Eterm tracer_pid) +{ + Module *modp; + int num_processed = 0; + if (!specified) { + /* Find and process all modules in the system... */ + int current; + int last = module_code_size(); + for (current = 0; current < last; current++) { + modp = module_code(current); + ASSERT(modp != NULL); + num_processed += + set_module_break(modp, mfa, specified, + match_spec, break_op, count_op, + tracer_pid); + } + } else { + /* Process a single module */ + if ((modp = erts_get_module(mfa[0])) != NULL) { + num_processed += + set_module_break(modp, mfa, specified, + match_spec, break_op, count_op, + tracer_pid); + } + } + return num_processed; +} + +static int set_module_break(Module *modp, Eterm mfa[3], int specified, + Binary *match_spec, Uint break_op, + enum erts_break_op count_op, Eterm tracer_pid) { + Uint** code_base; + Uint* code_ptr; + int num_processed = 0; + Uint i,n; + + ASSERT(break_op); + ASSERT(modp); + code_base = (Uint **) modp->code; + if (code_base == NULL) { + return 0; + } + n = (Uint) code_base[MI_NUM_FUNCTIONS]; + for (i = 0; i < n; ++i) { + code_ptr = code_base[MI_FUNCTIONS+i]; + ASSERT(code_ptr[0] == (Uint) BeamOp(op_i_func_info_IaaI)); + if ((specified < 2 || mfa[1] == ((Eterm) code_ptr[3])) && + (specified < 3 || ((int) mfa[2]) == ((int) code_ptr[4]))) { + Uint *pc = code_ptr+5; + + num_processed += + set_function_break(modp, pc, match_spec, + break_op, count_op, tracer_pid); + } + } + return num_processed; +} + +static int set_function_break(Module *modp, Uint *pc, + Binary *match_spec, Uint break_op, + enum erts_break_op count_op, Eterm tracer_pid) { + BpData *bd, **r; + size_t size; + Uint **code_base = (Uint **)modp->code; + + ASSERT(code_base); + ASSERT(code_base <= (Uint **)pc); + ASSERT((Uint **)pc < code_base + (modp->code_length/sizeof(Uint *))); + /* + * Currently no trace support for native code. + */ + if (erts_is_native_break(pc)) { + return 0; + } + /* Do not allow two breakpoints of the same kind */ + if ( (bd = is_break(pc, break_op))) { + if (break_op == (Uint) BeamOp(op_i_trace_breakpoint) + || break_op == (Uint) BeamOp(op_i_mtrace_breakpoint)) { + BpDataTrace *bdt = (BpDataTrace *) bd; + Binary *old_match_spec; + + /* Update match spec and tracer */ + MatchSetRef(match_spec); + ErtsSmpBPLock(bdt); + old_match_spec = bdt->match_spec; + bdt->match_spec = match_spec; + bdt->tracer_pid = tracer_pid; + ErtsSmpBPUnlock(bdt); + MatchSetUnref(old_match_spec); + } else { + ASSERT(! match_spec); + ASSERT(is_nil(tracer_pid)); + if (break_op == (Uint) BeamOp(op_i_count_breakpoint)) { + BpDataCount *bdc = (BpDataCount *) bd; + + ErtsSmpBPLock(bdc); + if (count_op == erts_break_stop) { + if (bdc->count >= 0) { + bdc->count = -bdc->count-1; /* Stop call counter */ + } + } else { + bdc->count = 0; /* Reset call counter */ + } + ErtsSmpBPUnlock(bdc); + } else { + ASSERT (! count_op); + } + } + return 1; + } + if (break_op == (Uint) BeamOp(op_i_trace_breakpoint) || + break_op == (Uint) BeamOp(op_i_mtrace_breakpoint)) { + size = sizeof(BpDataTrace); + } else { + ASSERT(! match_spec); + ASSERT(is_nil(tracer_pid)); + if (break_op == (Uint) BeamOp(op_i_count_breakpoint)) { + if (count_op == erts_break_reset + || count_op == erts_break_stop) { + /* Do not insert a new breakpoint */ + return 1; + } + size = sizeof(BpDataCount); + } else { + ASSERT(! count_op); + ASSERT(break_op == (Uint) BeamOp(op_i_debug_breakpoint)); + size = sizeof(BpDataDebug); + } + } + r = (BpData **) (pc-4); + if (! *r) { + ASSERT(*pc != (Uint) BeamOp(op_i_trace_breakpoint)); + ASSERT(*pc != (Uint) BeamOp(op_i_mtrace_breakpoint)); + ASSERT(*pc != (Uint) BeamOp(op_i_debug_breakpoint)); + ASSERT(*pc != (Uint) BeamOp(op_i_count_breakpoint)); + /* First breakpoint; create singleton ring */ + bd = Alloc(size); + BpInit(bd, *pc); + *pc = break_op; + *r = bd; + } else { + ASSERT(*pc == (Uint) BeamOp(op_i_trace_breakpoint) || + *pc == (Uint) BeamOp(op_i_mtrace_breakpoint) || + *pc == (Uint) BeamOp(op_i_debug_breakpoint) || + *pc == (Uint) BeamOp(op_i_count_breakpoint)); + if (*pc == (Uint) BeamOp(op_i_debug_breakpoint)) { + /* Debug bp must be last, so if it is also first; + * it must be singleton. */ + ASSERT(BpSingleton(*r)); + /* Insert new bp first in the ring, i.e second to last. */ + bd = Alloc(size); + BpInitAndSpliceNext(bd, *pc, *r); + *pc = break_op; + } else if ((*r)->prev->orig_instr + == (Uint) BeamOp(op_i_debug_breakpoint)) { + /* Debug bp last in the ring; insert new second to last. */ + bd = Alloc(size); + BpInitAndSplicePrev(bd, (*r)->prev->orig_instr, *r); + (*r)->prev->orig_instr = break_op; + } else { + /* Just insert last in the ring */ + bd = Alloc(size); + BpInitAndSpliceNext(bd, (*r)->orig_instr, *r); + (*r)->orig_instr = break_op; + *r = bd; + } + } + /* Init the bp type specific data */ + if (break_op == (Uint) BeamOp(op_i_trace_breakpoint) || + break_op == (Uint) BeamOp(op_i_mtrace_breakpoint)) { + + BpDataTrace *bdt = (BpDataTrace *) bd; + + MatchSetRef(match_spec); + bdt->match_spec = match_spec; + bdt->tracer_pid = tracer_pid; + } else if (break_op == (Uint) BeamOp(op_i_count_breakpoint)) { + BpDataCount *bdc = (BpDataCount *) bd; + + bdc->count = 0; + } + ++(*(Uint*)&code_base[MI_NUM_BREAKPOINTS]); + return 1; +} + +static int clear_break(Eterm mfa[3], int specified, Uint break_op) +{ + int num_processed = 0; + Module *modp; + + if (!specified) { + /* Iterate over all modules */ + int current; + int last = module_code_size(); + + for (current = 0; current < last; current++) { + modp = module_code(current); + ASSERT(modp != NULL); + num_processed += clear_module_break(modp, mfa, specified, break_op); + } + } else { + /* Process a single module */ + if ((modp = erts_get_module(mfa[0])) != NULL) { + num_processed += + clear_module_break(modp, mfa, specified, break_op); + } + } + return num_processed; +} + +static int clear_module_break(Module *m, Eterm mfa[3], int specified, + Uint break_op) { + Uint** code_base; + Uint* code_ptr; + int num_processed = 0; + Uint i,n; + + ASSERT(m); + code_base = (Uint **) m->code; + if (code_base == NULL) { + return 0; + } + n = (Uint) code_base[MI_NUM_FUNCTIONS]; + for (i = 0; i < n; ++i) { + code_ptr = code_base[MI_FUNCTIONS+i]; + if ((specified < 2 || mfa[1] == ((Eterm) code_ptr[3])) && + (specified < 3 || ((int) mfa[2]) == ((int) code_ptr[4]))) { + Uint *pc = code_ptr + 5; + + num_processed += + clear_function_break(m, pc, break_op); + } + } + return num_processed; +} + +static int clear_function_break(Module *m, Uint *pc, Uint break_op) { + BpData *bd; + Uint **code_base = (Uint **)m->code; + + ASSERT(code_base); + ASSERT(code_base <= (Uint **)pc); + ASSERT((Uint **)pc < code_base + (m->code_length/sizeof(Uint *))); + /* + * Currently no trace support for native code. + */ + if (erts_is_native_break(pc)) { + return 0; + } + while ( (bd = is_break(pc, break_op))) { + /* Remove all breakpoints of this type. + * There should be only one of each type, + * but break_op may be 0 which matches any type. + */ + Uint op; + BpData **r = (BpData **) (pc-4); + + ASSERT(*r); + /* Find opcode for this breakpoint */ + if (break_op) { + op = break_op; + } else { + if (bd == (*r)->next) { + /* First breakpoint in ring */ + op = *pc; + } else { + op = bd->prev->orig_instr; + } + } + if (BpSingleton(bd)) { + ASSERT(*r == bd); + /* Only one breakpoint to remove */ + *r = NULL; + *pc = bd->orig_instr; + } else { + BpData *bd_prev = bd->prev; + + BpSpliceNext(bd, bd_prev); + ASSERT(BpSingleton(bd)); + if (bd == *r) { + /* We removed the last breakpoint in the ring */ + *r = bd_prev; + bd_prev->orig_instr = bd->orig_instr; + } else if (bd_prev == *r) { + /* We removed the first breakpoint in the ring */ + *pc = bd->orig_instr; + } else { + bd_prev->orig_instr = bd->orig_instr; + } + } + if (op == (Uint) BeamOp(op_i_trace_breakpoint) || + op == (Uint) BeamOp(op_i_mtrace_breakpoint)) { + + BpDataTrace *bdt = (BpDataTrace *) bd; + + MatchSetUnref(bdt->match_spec); + } + Free(bd); + ASSERT(((Uint) code_base[MI_NUM_BREAKPOINTS]) > 0); + --(*(Uint*)&code_base[MI_NUM_BREAKPOINTS]); + } + return 1; +} + + + +/* +** Searches (linear forward) the breakpoint ring for a specified opcode +** and returns a pointer to the breakpoint data structure or NULL if +** not found. If the specified opcode is 0, the last breakpoint is +** returned. The program counter must point to the first executable +** (breakpoint) instruction of the function. +*/ +static BpData *is_break(Uint *pc, Uint break_op) { + ASSERT(pc[-5] == (Uint) BeamOp(op_i_func_info_IaaI)); + if (! erts_is_native_break(pc)) { + BpData *bd = (BpData *) pc[-4]; + + if (break_op == 0) { + return bd; + } + if (*pc == break_op) { + ASSERT(bd); + return bd->next; + } + if (! bd){ + return NULL; + } + bd = bd->next; + while (bd != (BpData *) pc[-4]) { + ASSERT(bd); + if (bd->orig_instr == break_op) { + bd = bd->next; + ASSERT(bd); + return bd; + } else { + bd = bd->next; + } + } + } + return NULL; +} diff --git a/erts/emulator/beam/beam_bp.h b/erts/emulator/beam/beam_bp.h new file mode 100644 index 0000000000..44e6b294d8 --- /dev/null +++ b/erts/emulator/beam/beam_bp.h @@ -0,0 +1,165 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +#ifndef _BEAM_BP_H +#define _BEAM_BP_H + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" + + + +/* +** Common struct to all bp_data_* +** +** Two gotchas: +** +** 1) The type of bp_data structure in the ring is deduced from the +** orig_instr field of the structure _before_ in the ring, except for +** the first structure in the ring that has its instruction in +** pc[0] of the code to execute. +** +** 2) pc[-4] points to the _last_ structure in the ring before the +** breakpoints are being executed. +** +** So, as an example, when a breakpointed function starts to execute, +** the first instruction that is a breakpoint instruction at pc[0] finds +** its data at ((BpData *) pc[-4])->next and has to cast that pointer +** to the correct bp_data type. +*/ +typedef struct bp_data { + struct bp_data *next; /* Doubly linked ring pointers */ + struct bp_data *prev; /* -"- */ + Uint orig_instr; /* The original instruction to execute */ +} BpData; +/* +** All the following bp_data_.. structs must begin the same way +*/ + +typedef struct bp_data_trace { + struct bp_data *next; + struct bp_data *prev; + Uint orig_instr; + Binary *match_spec; + Eterm tracer_pid; +} BpDataTrace; + +typedef struct bp_data_debug { + struct bp_data *next; + struct bp_data *prev; + Uint orig_instr; +} BpDataDebug; + +typedef struct bp_data_count { /* Call count */ + struct bp_data *next; + struct bp_data *prev; + Uint orig_instr; + Sint count; +} BpDataCount; + +extern erts_smp_spinlock_t erts_bp_lock; + +#ifdef ERTS_SMP +#define ErtsSmpBPLock(BDC) erts_smp_spin_lock(&erts_bp_lock) +#define ErtsSmpBPUnlock(BDC) erts_smp_spin_unlock(&erts_bp_lock) +#else +#define ErtsSmpBPLock(BDC) +#define ErtsSmpBPUnlock(BDC) +#endif + +#define ErtsCountBreak(pc,instr_result) \ +do { \ + BpDataCount *bdc = (BpDataCount *) (pc)[-4]; \ + \ + ASSERT((pc)[-5] == (Uint) BeamOp(op_i_func_info_IaaI)); \ + ASSERT(bdc); \ + bdc = (BpDataCount *) bdc->next; \ + ASSERT(bdc); \ + (pc)[-4] = (Uint) bdc; \ + ErtsSmpBPLock(bdc); \ + if (bdc->count >= 0) bdc->count++; \ + ErtsSmpBPUnlock(bdc); \ + *(instr_result) = bdc->orig_instr; \ +} while (0) + +#define ErtsBreakSkip(pc,instr_result) \ +do { \ + BpData *bd = (BpData *) (pc)[-4]; \ + \ + ASSERT((pc)[-5] == (Uint) BeamOp(op_i_func_info_IaaI)); \ + ASSERT(bd); \ + bd = bd->next; \ + ASSERT(bd); \ + (pc)[-4] = (Uint) bd; \ + *(instr_result) = bd->orig_instr; \ +} while (0) + +enum erts_break_op{ + erts_break_nop = 0, /* Must be false */ + erts_break_set = !0, /* Must be true */ + erts_break_reset, + erts_break_stop +}; + + + +/* +** Function interface exported from beam_bp.c +*/ + +void erts_bp_init(void); + +int erts_set_trace_break(Eterm mfa[3], int specified, Binary *match_spec, + Eterm tracer_pid); +int erts_clear_trace_break(Eterm mfa[3], int specified); +int erts_set_mtrace_break(Eterm mfa[3], int specified, Binary *match_spec, + Eterm tracer_pid); +int erts_clear_mtrace_break(Eterm mfa[3], int specified); +void erts_set_mtrace_bif(Uint *pc, Binary *match_spec, + Eterm tracer_pid); +void erts_clear_mtrace_bif(Uint *pc); +int erts_set_debug_break(Eterm mfa[3], int specified); +int erts_clear_debug_break(Eterm mfa[3], int specified); +int erts_set_count_break(Eterm mfa[3], int specified, enum erts_break_op); +int erts_clear_count_break(Eterm mfa[3], int specified); + + +int erts_clear_break(Eterm mfa[3], int specified); +int erts_clear_module_break(Module *modp); +int erts_clear_function_break(Module *modp, Uint *pc); + +Uint erts_trace_break(Process *p, Uint *pc, Eterm *args, + Uint32 *ret_flags, Eterm *tracer_pid); +Uint32 erts_bif_mtrace(Process *p, Uint *pc, Eterm *args, + int local, Eterm *tracer_pid); + +int erts_is_trace_break(Uint *pc, Binary **match_spec_ret, + Eterm *tracer_pid_ret); +int erts_is_mtrace_break(Uint *pc, Binary **match_spec_ret, + Eterm *tracer_pid_rte); +int erts_is_mtrace_bif(Uint *pc, Binary **match_spec_ret, + Eterm *tracer_pid_ret); +int erts_is_native_break(Uint *pc); +int erts_is_count_break(Uint *pc, Sint *count_ret); + +Uint *erts_find_local_func(Eterm mfa[3]); + +#endif /* _BEAM_BP_H */ diff --git a/erts/emulator/beam/beam_catches.c b/erts/emulator/beam/beam_catches.c new file mode 100644 index 0000000000..d5cef1cad2 --- /dev/null +++ b/erts/emulator/beam/beam_catches.c @@ -0,0 +1,102 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "sys.h" +#include "beam_catches.h" + +/* XXX: should use dynamic reallocation */ +#define TABSIZ (16*1024) +static struct { + Eterm *cp; + unsigned cdr; +} beam_catches[TABSIZ]; + +static int free_list; +static unsigned high_mark; + +void beam_catches_init(void) +{ + free_list = -1; + high_mark = 0; +} + +unsigned beam_catches_cons(Eterm *cp, unsigned cdr) +{ + int i; + + /* + * Allocate from free_list while it is non-empty. + * If free_list is empty, allocate at high_mark. + * + * This avoids the need to initialise the free list in + * beam_catches_init(), which would cost O(TABSIZ) time. + */ + if( (i = free_list) >= 0 ) { + free_list = beam_catches[i].cdr; + } else if( (i = high_mark) < TABSIZ ) { + high_mark = i + 1; + } else { + fprintf(stderr, "beam_catches_cons: no free slots :-(\r\n"); + exit(1); + } + + beam_catches[i].cp = cp; + beam_catches[i].cdr = cdr; + + return i; +} + +Eterm *beam_catches_car(unsigned i) +{ + if( i >= TABSIZ ) { + fprintf(stderr, + "beam_catches_car: index %#x is out of range\r\n", i); + abort(); + } + return beam_catches[i].cp; +} + +void beam_catches_delmod(unsigned head, Eterm *code, unsigned code_bytes) +{ + unsigned i, cdr; + + for(i = head; i != (unsigned)-1;) { + if( i >= TABSIZ ) { + fprintf(stderr, + "beam_catches_delmod: index %#x is out of range\r\n", i); + abort(); + } + if( (char*)beam_catches[i].cp - (char*)code >= code_bytes ) { + fprintf(stderr, + "beam_catches_delmod: item %#x has cp %#lx which is not " + "in module's range [%#lx,%#lx[\r\n", + i, (long)beam_catches[i].cp, + (long)code, (long)((char*)code + code_bytes)); + abort(); + } + beam_catches[i].cp = 0; + cdr = beam_catches[i].cdr; + beam_catches[i].cdr = free_list; + free_list = i; + i = cdr; + } +} diff --git a/erts/emulator/beam/beam_catches.h b/erts/emulator/beam/beam_catches.h new file mode 100644 index 0000000000..ccf33d5e86 --- /dev/null +++ b/erts/emulator/beam/beam_catches.h @@ -0,0 +1,32 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __BEAM_CATCHES_H +#define __BEAM_CATCHES_H + +#define BEAM_CATCHES_NIL (-1) + +void beam_catches_init(void); +unsigned beam_catches_cons(Eterm* cp, unsigned cdr); +Eterm *beam_catches_car(unsigned i); +void beam_catches_delmod(unsigned head, Eterm* code, unsigned code_bytes); + +#define catch_pc(x) beam_catches_car(catch_val((x))) + +#endif /* __BEAM_CATCHES_H */ diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c new file mode 100644 index 0000000000..4242a4161e --- /dev/null +++ b/erts/emulator/beam/beam_debug.c @@ -0,0 +1,548 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Purpose: Basic debugging support. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "big.h" +#include "external.h" +#include "beam_load.h" +#include "beam_bp.h" +#include "erl_binary.h" + +#ifdef ARCH_64 +# define HEXF "%016bpX" +#else +# define HEXF "%08bpX" +#endif + +void dbg_bt(Process* p, Eterm* sp); +void dbg_where(Eterm* addr, Eterm x0, Eterm* reg); + +static void print_big(int to, void *to_arg, Eterm* addr); +static int print_op(int to, void *to_arg, int op, int size, Eterm* addr); +Eterm +erts_debug_same_2(Process* p, Eterm term1, Eterm term2) +{ + return (term1 == term2) ? am_true : am_false; +} + +Eterm +erts_debug_flat_size_1(Process* p, Eterm term) +{ + Uint size = size_object(term); + + if (IS_USMALL(0, size)) { + BIF_RET(make_small(size)); + } else { + Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(size, hp)); + } +} + +Eterm +erts_debug_breakpoint_2(Process* p, Eterm MFA, Eterm bool) +{ + Eterm* tp; + Eterm mfa[3]; + int i; + int specified = 0; + Eterm res; + + if (bool != am_true && bool != am_false) + goto error; + + if (is_not_tuple(MFA)) { + goto error; + } + tp = tuple_val(MFA); + if (*tp != make_arityval(3)) { + goto error; + } + mfa[0] = tp[1]; + mfa[1] = tp[2]; + mfa[2] = tp[3]; + if (!is_atom(mfa[0]) || !is_atom(mfa[1]) || + (!is_small(mfa[2]) && mfa[2] != am_Underscore)) { + goto error; + } + for (i = 0; i < 3 && mfa[i] != am_Underscore; i++, specified++) { + /* Empty loop body */ + } + for (i = specified; i < 3; i++) { + if (mfa[i] != am_Underscore) { + goto error; + } + } + if (is_small(mfa[2])) { + mfa[2] = signed_val(mfa[2]); + } + + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + if (bool == am_true) { + res = make_small(erts_set_debug_break(mfa, specified)); + } else { + res = make_small(erts_clear_debug_break(mfa, specified)); + } + + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + + return res; + + error: + BIF_ERROR(p, BADARG); +} + +Eterm +erts_debug_disassemble_1(Process* p, Eterm addr) +{ + erts_dsprintf_buf_t *dsbufp; + Eterm* hp; + Eterm* tp; + Eterm bin; + Eterm mfa; + Eterm* funcinfo = NULL; /* Initialized to eliminate warning. */ + Uint* code_base; + Uint* code_ptr = NULL; /* Initialized to eliminate warning. */ + Uint instr; + Uint uaddr; + Uint hsz; + int i; + + if (term_to_Uint(addr, &uaddr)) { + code_ptr = (Uint *) uaddr; + if ((funcinfo = find_function_from_pc(code_ptr)) == NULL) { + BIF_RET(am_false); + } + } else if (is_tuple(addr)) { + Module* modp; + Eterm mod; + Eterm name; + Export* ep; + Sint arity; + int n; + + tp = tuple_val(addr); + if (tp[0] != make_arityval(3)) { + error: + BIF_ERROR(p, BADARG); + } + mod = tp[1]; + name = tp[2]; + if (!is_atom(mod) || !is_atom(name) || !is_small(tp[3])) { + goto error; + } + arity = signed_val(tp[3]); + modp = erts_get_module(mod); + + /* + * Try the export entry first to allow disassembly of special functions + * such as erts_debug:apply/4. Then search for it in the module. + */ + + if ((ep = erts_find_function(mod, name, arity)) != NULL) { + /* XXX: add "&& ep->address != ep->code+3" condition? + * Consider a traced function. + * Its ep will have ep->address == ep->code+3. + * erts_find_function() will return the non-NULL ep. + * Below we'll try to derive a code_ptr from ep->address. + * But this code_ptr will point to the start of the Export, + * not the function's func_info instruction. BOOM !? + */ + code_ptr = ((Eterm *) ep->address) - 5; + funcinfo = code_ptr+2; + } else if (modp == NULL || (code_base = modp->code) == NULL) { + BIF_RET(am_undef); + } else { + n = code_base[MI_NUM_FUNCTIONS]; + for (i = 0; i < n; i++) { + code_ptr = (Uint *) code_base[MI_FUNCTIONS+i]; + if (code_ptr[3] == name && code_ptr[4] == arity) { + funcinfo = code_ptr+2; + break; + } + } + if (i == n) { + BIF_RET(am_undef); + } + } + } else { + goto error; + } + + dsbufp = erts_create_tmp_dsbuf(0); + erts_print(ERTS_PRINT_DSBUF, (void *) dsbufp, HEXF ": ", code_ptr); + instr = (Uint) code_ptr[0]; + for (i = 0; i < NUM_SPECIFIC_OPS; i++) { + if (instr == (Uint) BeamOp(i) && opc[i].name[0] != '\0') { + code_ptr += print_op(ERTS_PRINT_DSBUF, (void *) dsbufp, + i, opc[i].sz-1, code_ptr+1) + 1; + break; + } + } + if (i >= NUM_SPECIFIC_OPS) { + erts_print(ERTS_PRINT_DSBUF, (void *) dsbufp, + "unknown " HEXF "\n", instr); + code_ptr++; + } + bin = new_binary(p, (byte *) dsbufp->str, (int) dsbufp->str_len); + erts_destroy_tmp_dsbuf(dsbufp); + hsz = 4+4; + (void) erts_bld_uint(NULL, &hsz, (Uint) code_ptr); + hp = HAlloc(p, hsz); + addr = erts_bld_uint(&hp, NULL, (Uint) code_ptr); + ASSERT(is_atom(funcinfo[0])); + ASSERT(is_atom(funcinfo[1])); + mfa = TUPLE3(hp, funcinfo[0], funcinfo[1], make_small(funcinfo[2])); + hp += 4; + return TUPLE3(hp, addr, bin, mfa); +} + +void +dbg_bt(Process* p, Eterm* sp) +{ + Eterm* stack = STACK_START(p); + + while (sp < stack) { + if (is_CP(*sp)) { + Eterm* addr = find_function_from_pc(cp_val(*sp)); + if (addr) + erts_fprintf(stderr, + HEXF ": %T:%T/%bpu\n", + addr, addr[0], addr[1], addr[2]); + } + sp++; + } +} + +void +dbg_where(Eterm* addr, Eterm x0, Eterm* reg) +{ + Eterm* f = find_function_from_pc(addr); + + if (f == NULL) { + erts_fprintf(stderr, "???\n"); + } else { + int arity; + int i; + + addr = f; + arity = addr[2]; + erts_fprintf(stderr, HEXF ": %T:%T(", addr, addr[0], addr[1]); + for (i = 0; i < arity; i++) + erts_fprintf(stderr, i ? ", %T" : "%T", i ? reg[i] : x0); + erts_fprintf(stderr, ")\n"); + } +} + +static int +print_op(int to, void *to_arg, int op, int size, Eterm* addr) +{ + int i; + Uint tag; + char* sign; + char* start_prog; /* Start of program for packer. */ + char* prog; /* Current position in packer program. */ + Uint stack[8]; /* Stack for packer. */ + Uint* sp = stack; /* Points to next free position. */ + Uint packed = 0; /* Accumulator for packed operations. */ + Uint args[8]; /* Arguments for this instruction. */ + Uint* ap; /* Pointer to arguments. */ + + start_prog = opc[op].pack; + + if (start_prog[0] == '\0') { + /* + * There is no pack program. + * Avoid copying because instructions containing bignum operands + * are bigger than actually declared. + */ + ap = (Uint *) addr; + } else { + /* + * Copy all arguments to a local buffer for the unpacking. + */ + + ASSERT(size <= sizeof(args)/sizeof(args[0])); + ap = args; + for (i = 0; i < size; i++) { + *ap++ = addr[i]; + } + + /* + * Undo any packing done by the loader. This is easily done by running + * the packing program backwards and in reverse. + */ + + prog = start_prog + strlen(start_prog); + while (start_prog < prog) { + prog--; + switch (*prog) { + case 'g': + *ap++ = *--sp; + break; + case 'i': /* Initialize packing accumulator. */ + *ap++ = packed; + break; + case 's': + *ap++ = packed & 0x3ff; + packed >>= 10; + break; + case '0': /* Tight shift */ + *ap++ = packed & (BEAM_TIGHT_MASK / sizeof(Eterm)); + packed >>= BEAM_TIGHT_SHIFT; + break; + case '6': /* Shift 16 steps */ + *ap++ = packed & 0xffff; + packed >>= 16; + break; + case 'p': + *sp++ = *--ap; + break; + case 'P': + packed = *--sp; + break; + default: + ASSERT(0); + } + } + ap = args; + } + + /* + * Print the name and all operands of the instructions. + */ + + erts_print(to, to_arg, "%s ", opc[op].name); + sign = opc[op].sign; + while (*sign) { + switch (*sign) { + case 'r': /* x(0) */ + erts_print(to, to_arg, "x(0)"); + break; + case 'x': /* x(N) */ + if (reg_index(ap[0]) == 0) { + erts_print(to, to_arg, "X[0]"); + } else { + erts_print(to, to_arg, "x(%d)", reg_index(ap[0])); + } + ap++; + break; + case 'y': /* y(N) */ + erts_print(to, to_arg, "y(%d)", reg_index(ap[0]) - CP_SIZE); + ap++; + break; + case 'n': /* Nil */ + erts_print(to, to_arg, "[]"); + break; + case 's': /* Any source (tagged constant or register) */ + tag = beam_reg_tag(*ap); + if (tag == X_REG_DEF) { + if (reg_index(*ap) == 0) { + erts_print(to, to_arg, "x[0]"); + } else { + erts_print(to, to_arg, "x(%d)", reg_index(*ap)); + } + ap++; + break; + } else if (tag == Y_REG_DEF) { + erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE); + ap++; + break; + } else if (tag == R_REG_DEF) { + erts_print(to, to_arg, "x(0)"); + ap++; + break; + } + /*FALLTHROUGH*/ + case 'a': /* Tagged atom */ + case 'i': /* Tagged integer */ + case 'c': /* Tagged constant */ + case 'q': /* Tagged literal */ + erts_print(to, to_arg, "%T", *ap); + ap++; + break; + case 'A': + erts_print(to, to_arg, "%d", arityval(ap[0])); + ap++; + break; + case 'd': /* Destination (x(0), x(N), y(N)) */ + switch (beam_reg_tag(*ap)) { + case X_REG_DEF: + if (reg_index(*ap) == 0) { + erts_print(to, to_arg, "x[0]"); + } else { + erts_print(to, to_arg, "x(%d)", reg_index(*ap)); + } + break; + case Y_REG_DEF: + erts_print(to, to_arg, "y(%d)", reg_index(*ap) - CP_SIZE); + break; + case R_REG_DEF: + erts_print(to, to_arg, "x(0)"); + break; + } + ap++; + break; + case 'I': /* Untagged integer. */ + case 't': + erts_print(to, to_arg, "%d", *ap); + ap++; + break; + case 'f': /* Destination label */ + erts_print(to, to_arg, "f(%X)", *ap); + ap++; + break; + case 'p': /* Pointer (to label) */ + { + Eterm* f = find_function_from_pc((Eterm *)*ap); + + if (f+3 != (Eterm *) *ap) { + erts_print(to, to_arg, "p(%X)", *ap); + } else { + erts_print(to, to_arg, "%T:%T/%bpu", f[0], f[1], f[2]); + } + ap++; + } + break; + case 'j': /* Pointer (to label) */ + erts_print(to, to_arg, "j(%X)", *ap); + ap++; + break; + case 'e': /* Export entry */ + { + Export* ex = (Export *) *ap; + erts_print(to, to_arg, + "%T:%T/%bpu", ex->code[0], ex->code[1], ex->code[2]); + ap++; + } + break; + case 'F': /* Function definition */ + break; + case 'b': + for (i = 0; i < BIF_SIZE; i++) { + BifFunction bif = (BifFunction) *ap; + if (bif == bif_table[i].f) { + break; + } + } + if (i == BIF_SIZE) { + erts_print(to, to_arg, "b(%d)", (Uint) *ap); + } else { + Eterm name = bif_table[i].name; + unsigned arity = bif_table[i].arity; + erts_print(to, to_arg, "%T/%u", name, arity); + } + ap++; + break; + case 'P': /* Byte offset into tuple (see beam_load.c) */ + erts_print(to, to_arg, "%d", (*ap / sizeof(Eterm*)) - 1); + ap++; + break; + case 'l': /* fr(N) */ + erts_print(to, to_arg, "fr(%d)", reg_index(ap[0])); + ap++; + break; + default: + erts_print(to, to_arg, "???"); + ap++; + break; + } + erts_print(to, to_arg, " "); + sign++; + } + + /* + * Print more information about certain instructions. + */ + + ap = addr + size; + switch (op) { + case op_i_select_val_sfI: + { + int n = ap[-1]; + + while (n > 0) { + erts_print(to, to_arg, "%T f(%X) ", ap[0], ap[1]); + ap += 2; + size += 2; + n--; + } + } + break; + case op_i_jump_on_val_sfII: + { + int n; + for (n = ap[-2]; n > 0; n--) { + erts_print(to, to_arg, "f(%X) ", ap[0]); + ap++; + size++; + } + } + break; + case op_i_select_big_sf: + while (ap[0]) { + int arity = thing_arityval(ap[0]); + print_big(to, to_arg, ap); + size += arity+1; + ap += arity+1; + erts_print(to, to_arg, " f(%X) ", ap[0]); + ap++; + size++; + } + ap++; + size++; + break; + } + erts_print(to, to_arg, "\n"); + + return size; +} + +static void +print_big(int to, void *to_arg, Eterm* addr) +{ + int i; + int k; + + i = BIG_SIZE(addr); + if (BIG_SIGN(addr)) + erts_print(to, to_arg, "-#integer(%d) = {", i); + else + erts_print(to, to_arg, "#integer(%d) = {", i); + erts_print(to, to_arg, "%d", BIG_DIGIT(addr, 0)); + for (k = 1; k < i; k++) + erts_print(to, to_arg, ",%d", BIG_DIGIT(addr, k)); + erts_print(to, to_arg, "}"); +} diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c new file mode 100644 index 0000000000..dcaa43b51c --- /dev/null +++ b/erts/emulator/beam/beam_emu.c @@ -0,0 +1,6198 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include /* offsetof() */ +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "erl_nmgc.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "beam_load.h" +#include "erl_binary.h" +#include "erl_bits.h" +#include "dist.h" +#include "beam_bp.h" +#include "beam_catches.h" +#ifdef HIPE +#include "hipe_mode_switch.h" +#include "hipe_bif1.h" +#endif + +/* #define HARDDEBUG 1 */ + +#if defined(NO_JUMP_TABLE) +# define OpCase(OpCode) case op_##OpCode: lb_##OpCode +# define CountCase(OpCode) case op_count_##OpCode +# define OpCode(OpCode) ((Uint*)op_##OpCode) +# define Goto(Rel) {Go = (int)(Rel); goto emulator_loop;} +# define LabelAddr(Addr) &&##Addr +#else +# define OpCase(OpCode) lb_##OpCode +# define CountCase(OpCode) lb_count_##OpCode +# define Goto(Rel) goto *(Rel) +# define LabelAddr(Label) &&Label +# define OpCode(OpCode) (&&lb_##OpCode) +#endif + +#ifdef ERTS_ENABLE_LOCK_CHECK +# ifdef ERTS_SMP +# define PROCESS_MAIN_CHK_LOCKS(P) \ +do { \ + if ((P)) { \ + erts_pix_lock_t *pix_lock__ = ERTS_PIX2PIXLOCK(internal_pid_index((P)->id));\ + erts_proc_lc_chk_only_proc_main((P)); \ + erts_pix_lock(pix_lock__); \ + ASSERT(0 < (P)->lock.refc && (P)->lock.refc < erts_no_schedulers*5);\ + erts_pix_unlock(pix_lock__); \ + } \ + else \ + erts_lc_check_exact(NULL, 0); \ + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); \ +} while (0) +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_require_lock((P), ERTS_PROC_LOCK_MAIN) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) \ + if ((P)) erts_proc_lc_unrequire_lock((P), ERTS_PROC_LOCK_MAIN) +# else +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) +# define PROCESS_MAIN_CHK_LOCKS(P) erts_lc_check_exact(NULL, 0) +# endif +#else +# define PROCESS_MAIN_CHK_LOCKS(P) +# define ERTS_SMP_REQ_PROC_MAIN_LOCK(P) +# define ERTS_SMP_UNREQ_PROC_MAIN_LOCK(P) +#endif + +/* + * Define macros for deep checking of terms. + */ + +#if defined(HARDDEBUG) + +# define CHECK_TERM(T) size_object(T) + +# define CHECK_ARGS(PC) \ +do { \ + int i_; \ + int Arity_ = PC[-1]; \ + if (Arity_ > 0) { \ + CHECK_TERM(r(0)); \ + } \ + for (i_ = 1; i_ < Arity_; i_++) { \ + CHECK_TERM(x(i_)); \ + } \ +} while (0) + +#else +# define CHECK_TERM(T) ASSERT(!is_CP(T)) +# define CHECK_ARGS(T) +#endif + +#ifndef MAX +#define MAX(x, y) (((x) > (y)) ? (x) : (y)) +#endif + +#define GET_BIF_ADDRESS(p) ((BifFunction) (((Export *) p)->code[4])) + + +/* + * We reuse some of fields in the save area in the process structure. + * This is safe to do, since this space is only activly used when + * the process is switched out. + */ +#define REDS_IN(p) ((p)->def_arg_reg[5]) + +/* + * Add a byte offset to a pointer to Eterm. This is useful when the + * the loader has precalculated a byte offset. + */ +#define ADD_BYTE_OFFSET(ptr, offset) \ + ((Eterm *) (((unsigned char *)ptr) + (offset))) + +/* We don't check the range if an ordinary switch is used */ +#ifdef NO_JUMP_TABLE +#define VALID_INSTR(IP) (0 <= (int)(IP) && ((int)(IP) < (NUMBER_OF_OPCODES*2+10))) +#else +#define VALID_INSTR(IP) \ + ((Sint)LabelAddr(emulator_loop) <= (Sint)(IP) && \ + (Sint)(IP) < (Sint)LabelAddr(end_emulator_loop)) +#endif /* NO_JUMP_TABLE */ + +#define SET_CP(p, ip) \ + ASSERT(VALID_INSTR(*(ip))); \ + (p)->cp = (ip) + +#define SET_I(ip) \ + ASSERT(VALID_INSTR(* (Eterm *)(ip))); \ + I = (ip) + +#define FetchArgs(S1, S2) tmp_arg1 = (S1); tmp_arg2 = (S2) + +/* + * Store a result into a register given a destination descriptor. + */ + +#define StoreResult(Result, DestDesc) \ + do { \ + Eterm stb_reg; \ + stb_reg = (DestDesc); \ + CHECK_TERM(Result); \ + switch (beam_reg_tag(stb_reg)) { \ + case R_REG_DEF: \ + r(0) = (Result); break; \ + case X_REG_DEF: \ + xb(x_reg_offset(stb_reg)) = (Result); break; \ + default: \ + yb(y_reg_offset(stb_reg)) = (Result); break; \ + } \ + } while (0) + +#define StoreSimpleDest(Src, Dest) Dest = (Src) + +/* + * Store a result into a register and execute the next instruction. + * Dst points to the word with a destination descriptor, which MUST + * be just before the next instruction. + */ + +#define StoreBifResult(Dst, Result) \ + do { \ + Eterm* stb_next; \ + Eterm stb_reg; \ + stb_reg = Arg(Dst); \ + I += (Dst) + 2; \ + stb_next = (Eterm *) *I; \ + CHECK_TERM(Result); \ + switch (beam_reg_tag(stb_reg)) { \ + case R_REG_DEF: \ + r(0) = (Result); Goto(stb_next); \ + case X_REG_DEF: \ + xb(x_reg_offset(stb_reg)) = (Result); Goto(stb_next); \ + default: \ + yb(y_reg_offset(stb_reg)) = (Result); Goto(stb_next); \ + } \ + } while (0) + +#define ClauseFail() goto lb_jump_f + +#define SAVE_CP(X) \ + do { \ + *(X) = make_cp(c_p->cp); \ + c_p->cp = 0; \ + } while(0) + +#define RESTORE_CP(X) SET_CP(c_p, cp_val(*(X))) + +#define ISCATCHEND(instr) ((Eterm *) *(instr) == OpCode(catch_end_y)) + +/* + * Special Beam instructions. + */ + +Eterm beam_apply[2]; +Eterm beam_exit[1]; +Eterm beam_continue_exit[1]; + +Eterm* em_call_error_handler; +Eterm* em_apply_bif; +Eterm* em_call_traced_function; + + +/* NOTE These should be the only variables containing trace instructions. +** Sometimes tests are form the instruction value, and sometimes +** for the refering variable (one of these), and rouge references +** will most likely cause chaos. +*/ +Eterm beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ +Eterm beam_return_trace[1]; /* OpCode(i_return_trace) */ +Eterm beam_exception_trace[1]; /* UGLY also OpCode(i_return_trace) */ + +/* + * All Beam instructions in numerical order. + */ + +#ifndef NO_JUMP_TABLE +void** beam_ops; +#endif + +#ifndef ERTS_SMP /* Not supported with smp emulator */ +extern int count_instructions; +#endif + +#if defined(HYBRID) +#define SWAPIN \ + g_htop = global_htop; \ + g_hend = global_hend; \ + HTOP = HEAP_TOP(c_p); \ + E = c_p->stop + +#define SWAPOUT \ + global_htop = g_htop; \ + global_hend = g_hend; \ + HEAP_TOP(c_p) = HTOP; \ + c_p->stop = E + +#else +#define SWAPIN \ + HTOP = HEAP_TOP(c_p); \ + E = c_p->stop + +#define SWAPOUT \ + HEAP_TOP(c_p) = HTOP; \ + c_p->stop = E + +/* + * Use LIGHT_SWAPOUT when the called function + * will call HeapOnlyAlloc() (and never HAlloc()). + */ +#ifdef DEBUG +# /* The stack pointer is used in an assertion. */ +# define LIGHT_SWAPOUT SWAPOUT +#else +# define LIGHT_SWAPOUT HEAP_TOP(c_p) = HTOP +#endif + +/* + * Use LIGHT_SWAPIN when we know that c_p->stop cannot + * have been updated (i.e. if there cannot have been + * a garbage-collection). + */ + +#define LIGHT_SWAPIN HTOP = HEAP_TOP(c_p) + +#endif + +#define PRE_BIF_SWAPOUT(P) \ + HEAP_TOP((P)) = HTOP; \ + (P)->stop = E; \ + PROCESS_MAIN_CHK_LOCKS((P)); \ + ERTS_SMP_UNREQ_PROC_MAIN_LOCK((P)) + +#if defined(HYBRID) +# define POST_BIF_GC_SWAPIN_0(_p, _res) \ + if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ + _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \ + } \ + SWAPIN + +# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \ + if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ + _regs[0] = r(0); \ + _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \ + r(0) = _regs[0]; \ + } \ + SWAPIN +#else +# define POST_BIF_GC_SWAPIN_0(_p, _res) \ + ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ + PROCESS_MAIN_CHK_LOCKS((_p)); \ + if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ + _res = erts_gc_after_bif_call((_p), (_res), NULL, 0); \ + E = (_p)->stop; \ + } \ + HTOP = HEAP_TOP((_p)) + +# define POST_BIF_GC_SWAPIN(_p, _res, _regs, _arity) \ + ERTS_SMP_REQ_PROC_MAIN_LOCK((_p)); \ + PROCESS_MAIN_CHK_LOCKS((_p)); \ + if (((_p)->mbuf) || (MSO(_p).overhead >= BIN_VHEAP_SZ(_p)) ) { \ + _regs[0] = r(0); \ + _res = erts_gc_after_bif_call((_p), (_res), _regs, (_arity)); \ + r(0) = _regs[0]; \ + E = (_p)->stop; \ + } \ + HTOP = HEAP_TOP((_p)) +#endif + +#define db(N) (N) +#define tb(N) (N) +#define xb(N) (*(Eterm *) (((unsigned char *)reg) + (N))) +#define yb(N) (*(Eterm *) (((unsigned char *)E) + (N))) +#define fb(N) (*(double *) (((unsigned char *)&(freg[0].fd)) + (N))) +#define x(N) reg[N] +#define y(N) E[N] +#define r(N) x##N + +/* + * Makes sure that there are StackNeed + HeapNeed + 1 words available + * on the combined heap/stack segment, then allocates StackNeed + 1 + * words on the stack and saves CP. + * + * M is number of live registers to preserve during garbage collection + */ + +#define AH(StackNeed, HeapNeed, M) \ + do { \ + int needed; \ + needed = (StackNeed) + 1; \ + if (E - HTOP < (needed + (HeapNeed))) { \ + SWAPOUT; \ + reg[0] = r(0); \ + PROCESS_MAIN_CHK_LOCKS(c_p); \ + FCALLS -= erts_garbage_collect(c_p, needed + (HeapNeed), reg, (M)); \ + PROCESS_MAIN_CHK_LOCKS(c_p); \ + r(0) = reg[0]; \ + SWAPIN; \ + } \ + E -= needed; \ + SAVE_CP(E); \ + } while (0) + +#define Allocate(Ns, Live) AH(Ns, 0, Live) + +#define AllocateZero(Ns, Live) \ + do { Eterm* ptr; \ + int i = (Ns); \ + AH(i, 0, Live); \ + for (ptr = E + i; ptr > E; ptr--) { \ + make_blank(*ptr); \ + } \ + } while (0) + +#define AllocateHeap(Ns, Nh, Live) AH(Ns, Nh, Live) + +#define AllocateHeapZero(Ns, Nh, Live) \ + do { Eterm* ptr; \ + int i = (Ns); \ + AH(i, Nh, Live); \ + for (ptr = E + i; ptr > E; ptr--) { \ + make_blank(*ptr); \ + } \ + } while (0) + +#define AllocateInit(Ns, Live, Y) \ + do { AH(Ns, 0, Live); make_blank(Y); } while (0) + +/* + * Like the AH macro, but allocates no additional heap space. + */ + +#define A(StackNeed, M) AH(StackNeed, 0, M) + +#define D(N) \ + RESTORE_CP(E); \ + E += (N) + 1; + + + +#define TestBinVHeap(VNh, Nh, Live) \ + do { \ + unsigned need = (Nh); \ + if ((E - HTOP < need) || (MSO(c_p).overhead + (VNh) >= BIN_VHEAP_SZ(c_p))) {\ + SWAPOUT; \ + reg[0] = r(0); \ + PROCESS_MAIN_CHK_LOCKS(c_p); \ + FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + PROCESS_MAIN_CHK_LOCKS(c_p); \ + r(0) = reg[0]; \ + SWAPIN; \ + } \ + } while (0) + + + +/* + * Check if Nh words of heap are available; if not, do a garbage collection. + * Live is number of active argument registers to be preserved. + */ + +#define TestHeap(Nh, Live) \ + do { \ + unsigned need = (Nh); \ + if (E - HTOP < need) { \ + SWAPOUT; \ + reg[0] = r(0); \ + PROCESS_MAIN_CHK_LOCKS(c_p); \ + FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)); \ + PROCESS_MAIN_CHK_LOCKS(c_p); \ + r(0) = reg[0]; \ + SWAPIN; \ + } \ + } while (0) + +/* + * Check if Nh words of heap are available; if not, do a garbage collection. + * Live is number of active argument registers to be preserved. + * Takes special care to preserve Extra if a garbage collection occurs. + */ + +#define TestHeapPreserve(Nh, Live, Extra) \ + do { \ + unsigned need = (Nh); \ + if (E - HTOP < need) { \ + SWAPOUT; \ + reg[0] = r(0); \ + reg[Live] = Extra; \ + PROCESS_MAIN_CHK_LOCKS(c_p); \ + FCALLS -= erts_garbage_collect(c_p, need, reg, (Live)+1); \ + PROCESS_MAIN_CHK_LOCKS(c_p); \ + if (Live > 0) { \ + r(0) = reg[0]; \ + } \ + Extra = reg[Live]; \ + SWAPIN; \ + } \ + } while (0) + +#ifdef HYBRID +#ifdef INCREMENTAL +#define TestGlobalHeap(Nh, Live, hp) \ + do { \ + unsigned need = (Nh); \ + ASSERT(global_heap <= g_htop && g_htop <= global_hend); \ + SWAPOUT; \ + reg[0] = r(0); \ + FCALLS -= need; \ + (hp) = IncAlloc(c_p,need,reg,(Live)); \ + r(0) = reg[0]; \ + SWAPIN; \ + } while (0) +#else +#define TestGlobalHeap(Nh, Live, hp) \ + do { \ + unsigned need = (Nh); \ + ASSERT(global_heap <= g_htop && g_htop <= global_hend); \ + if (g_hend - g_htop < need) { \ + SWAPOUT; \ + reg[0] = r(0); \ + FCALLS -= erts_global_garbage_collect(c_p, need, reg, (Live)); \ + r(0) = reg[0]; \ + SWAPIN; \ + } \ + (hp) = global_htop; \ + } while (0) +#endif +#endif /* HYBRID */ + +#define Init(N) make_blank(yb(N)) + +#define Init2(Y1, Y2) do { make_blank(Y1); make_blank(Y2); } while (0) +#define Init3(Y1, Y2, Y3) \ + do { make_blank(Y1); make_blank(Y2); make_blank(Y3); } while (0) + +#define MakeFun(FunP, NumFree) \ + do { \ + SWAPOUT; \ + reg[0] = r(0); \ + r(0) = new_fun(c_p, reg, (ErlFunEntry *) FunP, NumFree); \ + SWAPIN; \ + } while (0) + + +/* + * Check that we haven't used the reductions and jump to function pointed to by + * the I register. If we are out of reductions, do a context switch. + */ + +#define DispatchMacro() \ + do { \ + Eterm* dis_next; \ + dis_next = (Eterm *) *I; \ + CHECK_ARGS(I); \ + if (FCALLS > 0 || FCALLS > neg_o_reds) { \ + FCALLS--; \ + Goto(dis_next); \ + } else { \ + goto context_switch; \ + } \ + } while (0) + +#define DispatchMacroFun() \ + do { \ + Eterm* dis_next; \ + dis_next = (Eterm *) *I; \ + CHECK_ARGS(I); \ + if (FCALLS > 0 || FCALLS > neg_o_reds) { \ + FCALLS--; \ + Goto(dis_next); \ + } else { \ + goto context_switch_fun; \ + } \ + } while (0) + +#define DispatchMacrox() \ + do { \ + if (FCALLS > 0) { \ + Eterm* dis_next; \ + SET_I(((Export *) Arg(0))->address); \ + dis_next = (Eterm *) *I; \ + FCALLS--; \ + CHECK_ARGS(I); \ + Goto(dis_next); \ + } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) \ + && FCALLS > neg_o_reds) { \ + goto save_calls1; \ + } else { \ + SET_I(((Export *) Arg(0))->address); \ + CHECK_ARGS(I); \ + goto context_switch; \ + } \ + } while (0) + +#ifdef DEBUG +/* + * To simplify breakpoint setting, put the code in one place only and jump to it. + */ +# define Dispatch() goto do_dispatch +# define Dispatchx() goto do_dispatchx +# define Dispatchfun() goto do_dispatchfun +#else +/* + * Inline for speed. + */ +# define Dispatch() DispatchMacro() +# define Dispatchx() DispatchMacrox() +# define Dispatchfun() DispatchMacroFun() +#endif + +#define Self(R) R = c_p->id +#define Node(R) R = erts_this_node->sysname + +#define Arg(N) I[(N)+1] +#define Next(N) \ + I += (N) + 1; \ + ASSERT(VALID_INSTR(*I)); \ + Goto(*I) + +#define PreFetch(N, Dst) do { Dst = (Eterm *) *(I + N + 1); } while (0) +#define NextPF(N, Dst) \ + I += N + 1; \ + ASSERT(VALID_INSTR(Dst)); \ + Goto(Dst) + +#define GetR(pos, tr) \ + do { \ + tr = Arg(pos); \ + switch (beam_reg_tag(tr)) { \ + case R_REG_DEF: tr = r(0); break; \ + case X_REG_DEF: tr = xb(x_reg_offset(tr)); break; \ + case Y_REG_DEF: ASSERT(y_reg_offset(tr) >= 1); tr = yb(y_reg_offset(tr)); break; \ + } \ + CHECK_TERM(tr); \ + } while (0) + +#define GetArg1(N, Dst) GetR((N), Dst) + +#define GetArg2(N, Dst1, Dst2) \ + do { \ + GetR(N, Dst1); \ + GetR((N)+1, Dst2); \ + } while (0) + +#define PutList(H, T, Dst, Store) \ + do { \ + HTOP[0] = (H); HTOP[1] = (T); \ + Store(make_list(HTOP), Dst); \ + HTOP += 2; \ + } while (0) + +#define Move(Src, Dst, Store) \ + do { \ + Eterm term = (Src); \ + Store(term, Dst); \ + } while (0) + +#define Move2(src1, dst1, src2, dst2) dst1 = (src1); dst2 = (src2) + +#define MoveGenDest(src, dstp) \ + if ((dstp) == NULL) { r(0) = (src); } else { *(dstp) = src; } + +#define MoveReturn(Src, Dest) \ + (Dest) = (Src); \ + I = c_p->cp; \ + ASSERT(VALID_INSTR(*c_p->cp)); \ + c_p->cp = 0; \ + CHECK_TERM(r(0)); \ + Goto(*I) + +#define DeallocateReturn(Deallocate) \ + do { \ + int words_to_pop = (Deallocate); \ + SET_I(cp_val(*E)); \ + E = ADD_BYTE_OFFSET(E, words_to_pop); \ + CHECK_TERM(r(0)); \ + Goto(*I); \ + } while (0) + +#define MoveDeallocateReturn(Src, Dest, Deallocate) \ + (Dest) = (Src); \ + DeallocateReturn(Deallocate) + +#define MoveCall(Src, Dest, CallDest, Size) \ + (Dest) = (Src); \ + SET_CP(c_p, I+Size+1); \ + SET_I((Eterm *) CallDest); \ + Dispatch(); + +#define MoveCallLast(Src, Dest, CallDest, Deallocate) \ + (Dest) = (Src); \ + RESTORE_CP(E); \ + E = ADD_BYTE_OFFSET(E, (Deallocate)); \ + SET_I((Eterm *) CallDest); \ + Dispatch(); + +#define MoveCallOnly(Src, Dest, CallDest) \ + (Dest) = (Src); \ + SET_I((Eterm *) CallDest); \ + Dispatch(); + +#define GetList(Src, H, T) do { \ + Eterm* tmp_ptr = list_val(Src); \ + H = CAR(tmp_ptr); \ + T = CDR(tmp_ptr); } while (0) + +#define GetTupleElement(Src, Element, Dest) \ + do { \ + tmp_arg1 = (Eterm) (((unsigned char *) tuple_val(Src)) + (Element)); \ + (Dest) = (*(Eterm *)tmp_arg1); \ + } while (0) + +#define ExtractNextElement(Dest) \ + tmp_arg1 += sizeof(Eterm); \ + (Dest) = (* (Eterm *) (((unsigned char *) tmp_arg1))) + +#define ExtractNextElement2(Dest) \ + do { \ + Eterm* ene_dstp = &(Dest); \ + ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ + ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ + tmp_arg1 += sizeof(Eterm) + sizeof(Eterm); \ + } while (0) + +#define ExtractNextElement3(Dest) \ + do { \ + Eterm* ene_dstp = &(Dest); \ + ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ + ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ + ene_dstp[2] = ((Eterm *) tmp_arg1)[3]; \ + tmp_arg1 += 3*sizeof(Eterm); \ + } while (0) + +#define ExtractNextElement4(Dest) \ + do { \ + Eterm* ene_dstp = &(Dest); \ + ene_dstp[0] = ((Eterm *) tmp_arg1)[1]; \ + ene_dstp[1] = ((Eterm *) tmp_arg1)[2]; \ + ene_dstp[2] = ((Eterm *) tmp_arg1)[3]; \ + ene_dstp[3] = ((Eterm *) tmp_arg1)[4]; \ + tmp_arg1 += 4*sizeof(Eterm); \ + } while (0) + +#define ExtractElement(Element, Dest) \ + do { \ + tmp_arg1 += (Element); \ + (Dest) = (* (Eterm *) tmp_arg1); \ + } while (0) + +#define PutTuple(Arity, Src, Dest) \ + ASSERT(is_arity_value(Arity)); \ + Dest = make_tuple(HTOP); \ + HTOP[0] = (Arity); \ + HTOP[1] = (Src); \ + HTOP += 2 + +#define Put(Word) *HTOP++ = (Word) + +#define EqualImmed(X, Y, Action) if (X != Y) { Action; } + +#define IsFloat(Src, Fail) if (is_not_float(Src)) { Fail; } + +#define IsInteger(Src, Fail) if (is_not_integer(Src)) { Fail; } + +#define IsNumber(X, Fail) if (is_not_integer(X) && is_not_float(X)) { Fail; } + +#define IsAtom(Src, Fail) if (is_not_atom(Src)) { Fail; } + +#define IsIntegerAllocate(Src, Need, Alive, Fail) \ + if (is_not_integer(Src)) { Fail; } \ + A(Need, Alive) + +#define IsNil(Src, Fail) if (is_not_nil(Src)) { Fail; } + +#define IsList(Src, Fail) if (is_not_list(Src) && is_not_nil(Src)) { Fail; } + +#define IsNonemptyList(Src, Fail) if (is_not_list(Src)) { Fail; } + +#define IsNonemptyListAllocate(Src, Need, Alive, Fail) \ + if (is_not_list(Src)) { Fail; } \ + A(Need, Alive) + +#define IsNonemptyListTestHeap(Src, Need, Alive, Fail) \ + if (is_not_list(Src)) { Fail; } \ + TestHeap(Need, Alive) + +#define IsTuple(X, Action) if (is_not_tuple(X)) Action + +#define IsArity(Pointer, Arity, Fail) \ + if (*(Eterm *)(tmp_arg1 = (Eterm)tuple_val(Pointer)) != (Arity)) { Fail; } + +#define IsFunction(X, Action) \ + do { \ + if ( !(is_any_fun(X)) ) { \ + Action; \ + } \ + } while (0) + +#define IsFunction2(F, A, Action) \ + do { \ + if (is_function_2(c_p, F, A) != am_true ) {\ + Action; \ + } \ + } while (0) + +#define IsTupleOfArity(Src, Arity, Fail) \ + do { \ + if (is_not_tuple(Src) || *(Eterm *)(tmp_arg1 = (Eterm) tuple_val(Src)) != Arity) { \ + Fail; \ + } \ + } while (0) + +#define IsBoolean(X, Fail) if ((X) != am_true && (X) != am_false) { Fail; } + +#define IsBinary(Src, Fail) \ + if (is_not_binary(Src) || binary_bitsize(Src) != 0) { Fail; } + +#define IsBitstring(Src, Fail) \ + if (is_not_binary(Src)) { Fail; } + +#ifdef ARCH_64 +#define BsSafeMul(A, B, Fail, Target) \ + do { Uint64 _res = (A) * (B); \ + if (_res / B != A) { Fail; } \ + Target = _res; \ + } while (0) +#else +#define BsSafeMul(A, B, Fail, Target) \ + do { Uint64 _res = (Uint64)(A) * (Uint64)(B); \ + if ((_res >> (8*sizeof(Uint))) != 0) { Fail; } \ + Target = _res; \ + } while (0) +#endif + +#define BsGetFieldSize(Bits, Unit, Fail, Target) \ + do { \ + Sint _signed_size; Uint _uint_size; \ + if (is_small(Bits)) { \ + _signed_size = signed_val(Bits); \ + if (_signed_size < 0) { Fail; } \ + _uint_size = (Uint) _signed_size; \ + } else { \ + if (!term_to_Uint(Bits, &temp_bits)) { Fail; } \ + _uint_size = temp_bits; \ + } \ + BsSafeMul(_uint_size, Unit, Fail, Target); \ + } while (0) + +#define BsGetUncheckedFieldSize(Bits, Unit, Fail, Target) \ + do { \ + Sint _signed_size; Uint _uint_size; \ + if (is_small(Bits)) { \ + _signed_size = signed_val(Bits); \ + if (_signed_size < 0) { Fail; } \ + _uint_size = (Uint) _signed_size; \ + } else { \ + if (!term_to_Uint(Bits, &temp_bits)) { Fail; } \ + _uint_size = (Uint) temp_bits; \ + } \ + Target = _uint_size * Unit; \ + } while (0) + +#define BsGetFloat2(Ms, Live, Sz, Flags, Dst, Store, Fail) \ + do { \ + ErlBinMatchBuffer *_mb; \ + Eterm _result; Sint _size; \ + if (!is_small(Sz) || (_size = unsigned_val(Sz)) > 64) { Fail; } \ + _size *= ((Flags) >> 3); \ + TestHeap(FLOAT_SIZE_OBJECT, Live); \ + _mb = ms_matchbuffer(Ms); \ + LIGHT_SWAPOUT; \ + _result = erts_bs_get_float_2(c_p, _size, (Flags), _mb); \ + LIGHT_SWAPIN; \ + if (is_non_value(_result)) { Fail; } \ + else { Store(_result, Dst); } \ + } while (0) + +#define BsGetBinaryImm_2(Ms, Live, Sz, Flags, Dst, Store, Fail) \ + do { \ + ErlBinMatchBuffer *_mb; \ + Eterm _result; \ + TestHeap(heap_bin_size(ERL_ONHEAP_BIN_LIMIT), Live); \ + _mb = ms_matchbuffer(Ms); \ + LIGHT_SWAPOUT; \ + _result = erts_bs_get_binary_2(c_p, (Sz), (Flags), _mb); \ + LIGHT_SWAPIN; \ + if (is_non_value(_result)) { Fail; } \ + else { Store(_result, Dst); } \ + } while (0) + +#define BsGetBinary_2(Ms, Live, Sz, Flags, Dst, Store, Fail) \ + do { \ + ErlBinMatchBuffer *_mb; \ + Eterm _result; Uint _size; \ + BsGetFieldSize(Sz, ((Flags) >> 3), Fail, _size); \ + TestHeap(ERL_SUB_BIN_SIZE, Live); \ + _mb = ms_matchbuffer(Ms); \ + LIGHT_SWAPOUT; \ + _result = erts_bs_get_binary_2(c_p, _size, (Flags), _mb); \ + LIGHT_SWAPIN; \ + if (is_non_value(_result)) { Fail; } \ + else { Store(_result, Dst); } \ + } while (0) + +#define BsGetBinaryAll_2(Ms, Live, Unit, Dst, Store, Fail) \ + do { \ + ErlBinMatchBuffer *_mb; \ + Eterm _result; \ + TestHeap(ERL_SUB_BIN_SIZE, Live); \ + _mb = ms_matchbuffer(Ms); \ + if (((_mb->size - _mb->offset) % Unit) == 0) { \ + LIGHT_SWAPOUT; \ + _result = erts_bs_get_binary_all_2(c_p, _mb); \ + LIGHT_SWAPIN; \ + ASSERT(is_value(_result)); \ + Store(_result, Dst); \ + } else { Fail; } \ + } while (0) + +#define BsSkipBits2(Ms, Bits, Unit, Fail) \ + do { \ + ErlBinMatchBuffer *_mb; \ + size_t new_offset; \ + Uint _size; \ + _mb = ms_matchbuffer(Ms); \ + BsGetFieldSize(Bits, Unit, Fail, _size); \ + new_offset = _mb->offset + _size; \ + if (new_offset <= _mb->size) { _mb->offset = new_offset; } \ + else { Fail; } \ + } while (0) + +#define BsSkipBitsAll2(Ms, Unit, Fail) \ + do { \ + ErlBinMatchBuffer *_mb; \ + _mb = ms_matchbuffer(Ms); \ + if (((_mb->size - _mb->offset) % Unit) == 0) {_mb->offset = _mb->size; } \ + else { Fail; } \ + } while (0) + +#define BsSkipBitsImm2(Ms, Bits, Fail) \ + do { \ + ErlBinMatchBuffer *_mb; \ + size_t new_offset; \ + _mb = ms_matchbuffer(Ms); \ + new_offset = _mb->offset + (Bits); \ + if (new_offset <= _mb->size) { _mb->offset = new_offset; } \ + else { Fail; } \ + } while (0) + +#define NewBsPutIntegerImm(Sz, Flags, Src) \ + do { \ + if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), (Sz), (Flags)))) { goto badarg; } \ + } while (0) + +#define NewBsPutInteger(Sz, Flags, Src) \ + do { \ + Sint _size; \ + BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \ + if (!erts_new_bs_put_integer(ERL_BITS_ARGS_3((Src), _size, (Flags)))) \ + { goto badarg; } \ + } while (0) + +#define NewBsPutFloatImm(Sz, Flags, Src) \ + do { \ + if (!erts_new_bs_put_float(c_p, (Src), (Sz), (Flags))) { goto badarg; } \ + } while (0) + +#define NewBsPutFloat(Sz, Flags, Src) \ + do { \ + Sint _size; \ + BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \ + if (!erts_new_bs_put_float(c_p, (Src), _size, (Flags))) { goto badarg; } \ + } while (0) + +#define NewBsPutBinary(Sz, Flags, Src) \ + do { \ + Sint _size; \ + BsGetUncheckedFieldSize(Sz, ((Flags) >> 3), goto badarg, _size); \ + if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), _size))) { goto badarg; } \ + } while (0) + +#define NewBsPutBinaryImm(Sz, Src) \ + do { \ + if (!erts_new_bs_put_binary(ERL_BITS_ARGS_2((Src), (Sz)))) { goto badarg; } \ + } while (0) + +#define NewBsPutBinaryAll(Src, Unit) \ + do { \ + if (!erts_new_bs_put_binary_all(ERL_BITS_ARGS_2((Src), (Unit)))) { goto badarg; } \ + } while (0) + + +#define IsPort(Src, Fail) if (is_not_port(Src)) { Fail; } +#define IsPid(Src, Fail) if (is_not_pid(Src)) { Fail; } +#define IsRef(Src, Fail) if (is_not_ref(Src)) { Fail; } + +static BifFunction translate_gc_bif(void* gcf); +static Eterm* handle_error(Process* c_p, Eterm* pc, Eterm* reg, BifFunction bf); +static Eterm* next_catch(Process* c_p, Eterm *reg); +static void terminate_proc(Process* c_p, Eterm Value); +static Eterm add_stacktrace(Process* c_p, Eterm Value, Eterm exc); +static void save_stacktrace(Process* c_p, Eterm* pc, Eterm* reg, + BifFunction bf, Eterm args); +static struct StackTrace * get_trace_from_exc(Eterm exc); +static Eterm make_arglist(Process* c_p, Eterm* reg, int a); +static Eterm call_error_handler(Process* p, Eterm* ip, Eterm* reg); +static Eterm call_breakpoint_handler(Process* p, Eterm* fi, Eterm* reg); +static Uint* fixed_apply(Process* p, Eterm* reg, Uint arity); +static Eterm* apply(Process* p, Eterm module, Eterm function, + Eterm args, Eterm* reg); +static int hibernate(Process* c_p, Eterm module, Eterm function, + Eterm args, Eterm* reg); +static Eterm* call_fun(Process* p, int arity, Eterm* reg, Eterm args); +static Eterm* apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg); +static Eterm new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free); +static BIF_RETTYPE nif_dispatcher_0(Process* p, Uint* I); +static BIF_RETTYPE nif_dispatcher_1(Process* p, Eterm arg1, Uint* I); +static BIF_RETTYPE nif_dispatcher_2(Process* p, Eterm arg1, Eterm arg2, Uint* I); +static BIF_RETTYPE nif_dispatcher_3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3, Uint* I); + +#if defined(_OSE_) || defined(VXWORKS) +static int init_done; +#endif + +void +init_emulator(void) +{ +#if defined(_OSE_) || defined(VXWORKS) + init_done = 0; +#endif + process_main(); +} + +/* + * On certain platforms, make sure that the main variables really are placed + * in registers. + */ + +#if defined(__GNUC__) && defined(sparc) && !defined(DEBUG) +# define REG_x0 asm("%l0") +# define REG_xregs asm("%l1") +# define REG_htop asm("%l2") +# define REG_stop asm("%l3") +# define REG_I asm("%l4") +# define REG_fcalls asm("%l5") +# define REG_tmp_arg1 asm("%l6") +# define REG_tmp_arg2 asm("%l7") +#else +# define REG_x0 +# define REG_xregs +# define REG_htop +# define REG_stop +# define REG_I +# define REG_fcalls +# define REG_tmp_arg1 +# define REG_tmp_arg2 +#endif + +/* + * process_main() is called twice: + * The first call performs some initialisation, including exporting + * the instructions' C labels to the loader. + * The second call starts execution of BEAM code. This call never returns. + */ +void process_main(void) +{ +#if !defined(_OSE_) && !defined(VXWORKS) + static int init_done = 0; +#endif + Process* c_p = NULL; + int reds_used; +#ifdef DEBUG + Eterm pid; +#endif + + /* + * X register zero; also called r(0) + */ + register Eterm x0 REG_x0 = NIL; + + /* Pointer to X registers: x(1)..x(N); reg[0] is used when doing GC, + * in all other cases x0 is used. + */ + register Eterm* reg REG_xregs = NULL; + + /* + * Top of heap (next free location); grows upwards. + */ + register Eterm* HTOP REG_htop = NULL; + + +#ifdef HYBRID + Eterm *g_htop; + Eterm *g_hend; +#endif + + /* Stack pointer. Grows downwards; points + * to last item pushed (normally a saved + * continuation pointer). + */ + register Eterm* E REG_stop = NULL; + + /* + * Pointer to next threaded instruction. + */ + register Eterm *I REG_I = NULL; + + /* Number of reductions left. This function + * returns to the scheduler when FCALLS reaches zero. + */ + register Sint FCALLS REG_fcalls = 0; + + /* + * Temporaries used for picking up arguments for instructions. + */ + register Eterm tmp_arg1 REG_tmp_arg1 = NIL; + register Eterm tmp_arg2 REG_tmp_arg2 = NIL; + Eterm tmp_big[2]; /* Temporary buffer for small bignums. */ + +#ifndef ERTS_SMP + static Eterm save_reg[ERTS_X_REGS_ALLOCATED]; + /* X registers -- not used directly, but + * through 'reg', because using it directly + * needs two instructions on a SPARC, + * while using it through reg needs only + * one. + */ + + /* + * Floating point registers. + */ + static FloatDef freg[MAX_REG]; +#else + /* X regisers and floating point registers are located in + * scheduler specific data. + */ + register FloatDef *freg; +#endif + + /* + * For keeping the negative old value of 'reds' when call saving is active. + */ + int neg_o_reds = 0; + + Eterm (*arith_func)(Process* p, Eterm* reg, Uint live); + +#ifndef NO_JUMP_TABLE + static void* opcodes[] = { DEFINE_OPCODES }; +#ifdef ERTS_OPCODE_COUNTER_SUPPORT + static void* counting_opcodes[] = { DEFINE_COUNTING_OPCODES }; +#endif +#else + int Go; +#endif + + Uint temp_bits; /* Temporary used by BsSkipBits2 & BsGetInteger2 */ + + ERL_BITS_DECLARE_STATEP; /* Has to be last declaration */ + + + /* + * Note: In this function, we attempt to place rarely executed code towards + * the end of the function, in the hope that the cache hit rate will be better. + * The initialization code is only run once, so it is at the very end. + * + * Note: c_p->arity must be set to reflect the number of useful terms in + * c_p->arg_reg before calling the scheduler. + */ + + if (!init_done) { + init_done = 1; + goto init_emulator; + } +#ifndef ERTS_SMP + reg = save_reg; /* XXX: probably wastes a register on x86 */ +#endif + c_p = NULL; + reds_used = 0; + goto do_schedule1; + + do_schedule: + reds_used = REDS_IN(c_p) - FCALLS; + do_schedule1: + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + c_p = schedule(c_p, reds_used); +#ifdef DEBUG + pid = c_p->id; +#endif + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); +#ifdef ERTS_SMP + reg = c_p->scheduler_data->save_reg; + freg = c_p->scheduler_data->freg; +#endif + ERL_BITS_RELOAD_STATEP(c_p); + { + int reds; + Eterm* argp; + Eterm* next; + int i; + + argp = c_p->arg_reg; + for (i = c_p->arity - 1; i > 0; i--) { + reg[i] = argp[i]; + CHECK_TERM(reg[i]); + } + + /* + * We put the original reduction count in the process structure, to reduce + * the code size (referencing a field in a struct through a pointer stored + * in a register gives smaller code than referencing a global variable). + */ + + SET_I(c_p->i); + + reds = c_p->fcalls; + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p) + && (c_p->trace_flags & F_SENSITIVE) == 0) { + neg_o_reds = -reds; + FCALLS = REDS_IN(c_p) = 0; + } else { + neg_o_reds = 0; + FCALLS = REDS_IN(c_p) = reds; + } + + next = (Eterm *) *I; + r(0) = c_p->arg_reg[0]; +#ifdef HARDDEBUG + if (c_p->arity > 0) { + CHECK_TERM(r(0)); + } +#endif + SWAPIN; + ASSERT(VALID_INSTR(next)); + Goto(next); + } + +#if defined(DEBUG) || defined(NO_JUMP_TABLE) + emulator_loop: +#endif + +#ifdef NO_JUMP_TABLE + switch (Go) { +#endif +#include "beam_hot.h" + +#define STORE_ARITH_RESULT(res) StoreBifResult(2, (res)); +#define ARITH_FUNC(name) erts_gc_##name + + OpCase(i_plus_jId): + { + Eterm result; + + if (is_both_small(tmp_arg1, tmp_arg2)) { + Sint i = signed_val(tmp_arg1) + signed_val(tmp_arg2); + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (MY_IS_SSMALL(i)) { + result = make_small(i); + STORE_ARITH_RESULT(result); + } + + } + arith_func = ARITH_FUNC(mixed_plus); + goto do_big_arith2; + } + + OpCase(i_minus_jId): + { + Eterm result; + + if (is_both_small(tmp_arg1, tmp_arg2)) { + Sint i = signed_val(tmp_arg1) - signed_val(tmp_arg2); + ASSERT(MY_IS_SSMALL(i) == IS_SSMALL(i)); + if (MY_IS_SSMALL(i)) { + result = make_small(i); + STORE_ARITH_RESULT(result); + } + } + arith_func = ARITH_FUNC(mixed_minus); + goto do_big_arith2; + } + + OpCase(i_is_lt_f): + if (CMP_GE(tmp_arg1, tmp_arg2)) { + ClauseFail(); + } + Next(1); + + OpCase(i_is_ge_f): + if (CMP_LT(tmp_arg1, tmp_arg2)) { + ClauseFail(); + } + Next(1); + + OpCase(i_is_eq_f): + if (CMP_NE(tmp_arg1, tmp_arg2)) { + ClauseFail(); + } + Next(1); + + OpCase(i_is_ne_f): + if (CMP_EQ(tmp_arg1, tmp_arg2)) { + ClauseFail(); + } + Next(1); + + OpCase(i_is_eq_exact_f): + if (!EQ(tmp_arg1, tmp_arg2)) { + ClauseFail(); + } + Next(1); + + OpCase(i_move_call_only_fcr): { + r(0) = Arg(1); + } + /* FALL THROUGH */ + OpCase(i_call_only_f): { + SET_I((Eterm *) Arg(0)); + Dispatch(); + } + + OpCase(i_move_call_last_fPcr): { + r(0) = Arg(2); + } + /* FALL THROUGH */ + OpCase(i_call_last_fP): { + RESTORE_CP(E); + E = ADD_BYTE_OFFSET(E, Arg(1)); + SET_I((Eterm *) Arg(0)); + Dispatch(); + } + + OpCase(i_move_call_crf): { + r(0) = Arg(0); + I++; + } + /* FALL THROUGH */ + OpCase(i_call_f): { + SET_CP(c_p, I+2); + SET_I((Eterm *) Arg(0)); + Dispatch(); + } + + OpCase(i_move_call_ext_last_ePcr): { + r(0) = Arg(2); + } + /* FALL THROUGH */ + OpCase(i_call_ext_last_eP): + RESTORE_CP(E); + E = ADD_BYTE_OFFSET(E, Arg(1)); + + /* + * Note: The pointer to the export entry is never NULL; if the module + * is not loaded, it points to code which will invoke the error handler + * (see lb_call_error_handler below). + */ + Dispatchx(); + + OpCase(i_move_call_ext_cre): { + r(0) = Arg(0); + I++; + } + /* FALL THROUGH */ + OpCase(i_call_ext_e): + SET_CP(c_p, I+2); + Dispatchx(); + + OpCase(i_move_call_ext_only_ecr): { + r(0) = Arg(1); + } + /* FALL THROUGH */ + OpCase(i_call_ext_only_e): + Dispatchx(); + + OpCase(init_y): { + Eterm* next; + + PreFetch(1, next); + make_blank(yb(Arg(0))); + NextPF(1, next); + } + + OpCase(i_trim_I): { + Eterm* next; + Uint words; + Uint cp; + + words = Arg(0); + cp = E[0]; + PreFetch(1, next); + E += words; + E[0] = cp; + NextPF(1, next); + } + + OpCase(return): { + SET_I(c_p->cp); + /* + * We must clear the CP to make sure that a stale value do not + * create a false module dependcy preventing code upgrading. + * It also means that we can use the CP in stack backtraces. + */ + c_p->cp = 0; + CHECK_TERM(r(0)); + Goto(*I); + } + + OpCase(test_heap_1_put_list_Iy): { + Eterm* next; + + PreFetch(2, next); + TestHeap(Arg(0), 1); + PutList(yb(Arg(1)), r(0), r(0), StoreSimpleDest); + CHECK_TERM(r(0)); + NextPF(2, next); + } + + OpCase(put_string_IId): + { + unsigned char* s; + int len; + Eterm result; + + len = Arg(0); /* Length. */ + result = NIL; + for (s = (unsigned char *) Arg(1); len > 0; s--, len--) { + PutList(make_small(*s), result, result, StoreSimpleDest); + } + StoreBifResult(2, result); + } + + /* + * Send is almost a standard call-BIF with two arguments, except for: + * 1) It cannot be traced. + * 2) There is no pointer to the send_2 function stored in + * the instruction. + */ + + OpCase(send): { + Eterm* next; + Eterm result; + + PRE_BIF_SWAPOUT(c_p); + c_p->fcalls = FCALLS - 1; + result = send_2(c_p, r(0), x(1)); + PreFetch(0, next); + POST_BIF_GC_SWAPIN(c_p, result, reg, 2); + FCALLS = c_p->fcalls; + if (is_value(result)) { + r(0) = result; + CHECK_TERM(r(0)); + NextPF(0, next); + } else if (c_p->freason == TRAP) { + SET_CP(c_p, I+1); + SET_I((Eterm *) c_p->def_arg_reg[3]); + SWAPIN; + r(0) = c_p->def_arg_reg[0]; + x(1) = c_p->def_arg_reg[1]; + Dispatch(); + } + goto find_func_info; + } + + OpCase(i_element_jssd): { + Eterm index; + Eterm tuple; + + /* + * Inlined version of element/2 for speed. + */ + GetArg2(1, index, tuple); + if (is_small(index) && is_tuple(tuple)) { + Eterm* tp = tuple_val(tuple); + + if ((signed_val(index) >= 1) && + (signed_val(index) <= arityval(*tp))) { + Eterm result = tp[signed_val(index)]; + StoreBifResult(3, result); + } + } + } + /* Fall through */ + + OpCase(badarg_j): + badarg: + c_p->freason = BADARG; + goto lb_Cl_error; + + OpCase(i_fast_element_jIsd): { + Eterm tuple; + + /* + * Inlined version of element/2 for even more speed. + * The first argument is an untagged integer >= 1. + * The second argument is guaranteed to be a register operand. + */ + GetArg1(2, tuple); + if (is_tuple(tuple)) { + Eterm* tp = tuple_val(tuple); + tmp_arg2 = Arg(1); + if (tmp_arg2 <= arityval(*tp)) { + Eterm result = tp[tmp_arg2]; + StoreBifResult(3, result); + } + } + goto badarg; + } + + OpCase(catch_yf): + c_p->catches++; + yb(Arg(0)) = Arg(1); + Next(2); + + OpCase(catch_end_y): { + c_p->catches--; + make_blank(yb(Arg(0))); + if (is_non_value(r(0))) { + if (x(1) == am_throw) { + r(0) = x(2); + } else { + if (x(1) == am_error) { + SWAPOUT; + x(2) = add_stacktrace(c_p, x(2), x(3)); + SWAPIN; + } + /* only x(2) is included in the rootset here */ + if (E - HTOP < 3 || c_p->mbuf) { /* Force GC in case add_stacktrace() + * created heap fragments */ + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect(c_p, 3, reg+2, 1); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + } + r(0) = TUPLE2(HTOP, am_EXIT, x(2)); + HTOP += 3; + } + } + CHECK_TERM(r(0)); + Next(1); + } + + OpCase(try_end_y): { + c_p->catches--; + make_blank(yb(Arg(0))); + if (is_non_value(r(0))) { + r(0) = x(1); + x(1) = x(2); + x(2) = x(3); + } + Next(1); + } + + /* + * Skeleton for receive statement: + * + * L1: <-------------------+ + * <-----------+ | + * | | + * loop_rec L2 ------+---+ | + * ... | | | + * remove_message | | | + * jump L3 | | | + * ... | | | + * loop_rec_end L1 --+ | | + * L2: <---------------+ | + * wait L1 -----------------+ or wait_timeout + * timeout + * + * L3: Code after receive... + * + * + */ + + /* + * Pick up the next message and place it in x(0). + * If no message, jump to a wait or wait_timeout instruction. + */ + OpCase(i_loop_rec_fr): + { + Eterm* next; + ErlMessage* msgp; + + loop_rec__: + + PROCESS_MAIN_CHK_LOCKS(c_p); + + msgp = PEEK_MESSAGE(c_p); + + if (!msgp) { +#ifdef ERTS_SMP + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + /* Make sure messages wont pass exit signals... */ + if (ERTS_PROC_PENDING_EXIT(c_p)) { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + SWAPOUT; + goto do_schedule; /* Will be rescheduled for exit */ + } + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + msgp = PEEK_MESSAGE(c_p); + if (msgp) + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + else { +#endif + SET_I((Eterm *) Arg(0)); + Goto(*I); /* Jump to a wait or wait_timeout instruction */ +#ifdef ERTS_SMP + } +#endif + } + ErtsMoveMsgAttachmentIntoProc(msgp, c_p, E, HTOP, FCALLS, + { + SWAPOUT; + reg[0] = r(0); + PROCESS_MAIN_CHK_LOCKS(c_p); + }, + { + PROCESS_MAIN_CHK_LOCKS(c_p); + r(0) = reg[0]; + SWAPIN; + }); + if (is_non_value(ERL_MESSAGE_TERM(msgp))) { + /* + * A corrupt distribution message that we weren't able to decode; + * remove it... + */ + ASSERT(!msgp->data.attached); + UNLINK_MESSAGE(c_p, msgp); + free_message(msgp); + goto loop_rec__; + } + PreFetch(1, next); + r(0) = ERL_MESSAGE_TERM(msgp); + NextPF(1, next); + } + + /* + * Remove a (matched) message from the message queue. + */ + OpCase(remove_message): { + Eterm* next; + ErlMessage* msgp; + + PROCESS_MAIN_CHK_LOCKS(c_p); + + PreFetch(0, next); + msgp = PEEK_MESSAGE(c_p); + + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + save_calls(c_p, &exp_receive); + } + if (ERL_MESSAGE_TOKEN(msgp) == NIL) { + SEQ_TRACE_TOKEN(c_p) = NIL; + } else if (ERL_MESSAGE_TOKEN(msgp) != am_undefined) { + Eterm msg; + SEQ_TRACE_TOKEN(c_p) = ERL_MESSAGE_TOKEN(msgp); + ASSERT(is_tuple(SEQ_TRACE_TOKEN(c_p))); + ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5); + ASSERT(is_small(SEQ_TRACE_TOKEN_SERIAL(c_p))); + ASSERT(is_small(SEQ_TRACE_TOKEN_LASTCNT(c_p))); + ASSERT(is_small(SEQ_TRACE_TOKEN_FLAGS(c_p))); + ASSERT(is_pid(SEQ_TRACE_TOKEN_SENDER(c_p))); + c_p->seq_trace_lastcnt = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); + if (c_p->seq_trace_clock < unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p))) { + c_p->seq_trace_clock = unsigned_val(SEQ_TRACE_TOKEN_SERIAL(c_p)); + } + msg = ERL_MESSAGE_TERM(msgp); + seq_trace_output(SEQ_TRACE_TOKEN(c_p), msg, SEQ_TRACE_RECEIVE, + c_p->id, c_p); + } + UNLINK_MESSAGE(c_p, msgp); + JOIN_MESSAGE(c_p); + CANCEL_TIMER(c_p); + free_message(msgp); + + PROCESS_MAIN_CHK_LOCKS(c_p); + + NextPF(0, next); + } + + /* + * Advance the save pointer to the next message (the current + * message didn't match), then jump to the loop_rec instruction. + */ + OpCase(loop_rec_end_f): { + SET_I((Eterm *) Arg(0)); + SAVE_MESSAGE(c_p); + goto loop_rec__; + } + /* + * Prepare to wait for a message or a timeout, whichever occurs first. + * + * Note: In order to keep the compatibility between 32 and 64 bits + * emulators, only timeout values that can be represented in 32 bits + * (unsigned) or less are allowed. + */ + + + OpCase(i_wait_timeout_fs): { + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + + /* Fall through */ + } + OpCase(i_wait_timeout_locked_fs): { + Eterm timeout_value; + + /* + * If we have already set the timer, we must NOT set it again. Therefore, + * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. + */ + if (c_p->flags & (F_INSLPQUEUE | F_TIMO)) { + goto wait2; + } + GetArg1(1, timeout_value); + if (timeout_value != make_small(0)) { +#if !defined(ARCH_64) + Uint time_val; +#endif + + if (is_small(timeout_value) && signed_val(timeout_value) > 0 && +#if defined(ARCH_64) + ((unsigned_val(timeout_value) >> 32) == 0) +#else + 1 +#endif + ) { + /* + * The timer routiner will set c_p->i to the value in + * c_p->def_arg_reg[0]. Note that it is safe to use this + * location because there are no living x registers in + * a receive statement. + */ + c_p->def_arg_reg[0] = (Eterm) (I+3); + set_timer(c_p, unsigned_val(timeout_value)); + } else if (timeout_value == am_infinity) { + c_p->flags |= F_TIMO; +#if !defined(ARCH_64) + } else if (term_to_Uint(timeout_value, &time_val)) { + c_p->def_arg_reg[0] = (Eterm) (I+3); + set_timer(c_p, time_val); +#endif + } else { /* Wrong time */ + OpCase(i_wait_error_locked): { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + /* Fall through */ + } + OpCase(i_wait_error): { + c_p->freason = EXC_TIMEOUT_VALUE; + goto find_func_info; + } + } + + /* + * Prepare to wait indefinitely for a new message to arrive + * (or the time set above if falling through from above). + * + * When a new message arrives, control will be transferred + * the loop_rec instruction (at label L1). In case of + * of timeout, control will be transferred to the timeout + * instruction following the wait_timeout instruction. + */ + + OpCase(wait_locked_f): + OpCase(wait_f): + + wait2: { + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + c_p->i = (Eterm *) Arg(0); /* L1 */ + SWAPOUT; + c_p->arity = 0; + c_p->status = P_WAITING; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + c_p->current = NULL; + goto do_schedule; + } + OpCase(wait_unlocked_f): { + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + goto wait2; + } + } + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + Next(2); + } + + OpCase(i_wait_timeout_fI): { + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + } + + OpCase(i_wait_timeout_locked_fI): + { + /* + * If we have already set the timer, we must NOT set it again. Therefore, + * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. + */ + if ((c_p->flags & (F_INSLPQUEUE | F_TIMO)) == 0) { + c_p->def_arg_reg[0] = (Eterm) (I+3); + set_timer(c_p, Arg(1)); + } + goto wait2; + } + + /* + * A timeout has occurred. Reset the save pointer so that the next + * receive statement will examine the first message first. + */ + OpCase(timeout_locked): { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + } + + OpCase(timeout): { + Eterm* next; + + PreFetch(0, next); + if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) { + trace_receive(c_p, am_timeout); + } + if (ERTS_PROC_GET_SAVED_CALLS_BUF(c_p)) { + save_calls(c_p, &exp_timeout); + } + c_p->flags &= ~F_TIMO; + JOIN_MESSAGE(c_p); + NextPF(0, next); + } + + OpCase(i_select_val_sfI): + GetArg1(0, tmp_arg1); + + do_binary_search: + { + struct Pairs { + Eterm val; + Eterm* addr; + }; + struct Pairs* low; + struct Pairs* high; + struct Pairs* mid; + int bdiff; /* int not long because the arrays aren't that large */ + + low = (struct Pairs *) &Arg(3); + high = low + Arg(2); + + /* The pointer subtraction (high-low) below must produce + * a signed result, because high could be < low. That + * requires the compiler to insert quite a bit of code. + * + * However, high will be > low so the result will be + * positive. We can use that knowledge to optimise the + * entire sequence, from the initial comparison to the + * computation of mid. + * + * -- Mikael Pettersson, Acumem AB + * + * Original loop control code: + * + * while (low < high) { + * mid = low + (high-low) / 2; + * + */ + while ((bdiff = (int)((char*)high - (char*)low)) > 0) { + unsigned int boffset = ((unsigned int)bdiff >> 1) & ~(sizeof(struct Pairs)-1); + + mid = (struct Pairs*)((char*)low + boffset); + if (tmp_arg1 < mid->val) { + high = mid; + } else if (tmp_arg1 > mid->val) { + low = mid + 1; + } else { + SET_I(mid->addr); + Goto(*I); + } + } + SET_I((Eterm *) Arg(1)); + Goto(*I); + } + + OpCase(i_jump_on_val_zero_sfI): + { + Eterm index; + + GetArg1(0, index); + if (is_small(index)) { + index = signed_val(index); + if (index < Arg(2)) { + SET_I((Eterm *) (&Arg(3))[index]); + Goto(*I); + } + } + SET_I((Eterm *) Arg(1)); + Goto(*I); + } + + OpCase(i_jump_on_val_sfII): + { + Eterm index; + + GetArg1(0, index); + if (is_small(index)) { + index = (Uint) (signed_val(index) - Arg(3)); + if (index < Arg(2)) { + SET_I((Eterm *) (&Arg(4))[index]); + Goto(*I); + } + } + SET_I((Eterm *) Arg(1)); + Goto(*I); + } + + /* + * All guards with zero arguments have special instructions: + * self/0 + * node/0 + * + * All other guard BIFs take one or two arguments. + */ + + /* + * Guard BIF in head. On failure, ignore the error and jump + * to the code for the next clause. We don't support tracing + * of guard BIFs. + */ + + OpCase(bif1_fbsd): + { + Eterm (*bf)(Process*, Eterm); + Eterm arg; + Eterm result; + + GetArg1(2, arg); + bf = (BifFunction) Arg(1); + c_p->fcalls = FCALLS; + PROCESS_MAIN_CHK_LOCKS(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + result = (*bf)(c_p, arg); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + if (is_value(result)) { + StoreBifResult(3, result); + } + SET_I((Eterm *) Arg(0)); + Goto(*I); + } + + /* + * Guard BIF in body. It can fail like any BIF. No trace support. + */ + + OpCase(bif1_body_bsd): + { + Eterm (*bf)(Process*, Eterm); + + Eterm arg; + Eterm result; + + GetArg1(1, arg); + bf = (BifFunction) Arg(0); + c_p->fcalls = FCALLS; + PROCESS_MAIN_CHK_LOCKS(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + result = (*bf)(c_p, arg); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + if (is_value(result)) { + StoreBifResult(2, result); + } + reg[0] = arg; + SWAPOUT; + I = handle_error(c_p, I, reg, bf); + goto post_error_handling; + } + + OpCase(i_gc_bif1_jIsId): + { + typedef Eterm (*GcBifFunction)(Process*, Eterm*, Uint); + GcBifFunction bf; + Eterm arg; + Eterm result; + Uint live = Arg(3); + + GetArg1(2, arg); + reg[0] = r(0); + reg[live] = arg; + bf = (GcBifFunction) Arg(1); + c_p->fcalls = FCALLS; + SWAPOUT; + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + result = (*bf)(c_p, reg, live); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + SWAPIN; + r(0) = reg[0]; + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + if (is_value(result)) { + StoreBifResult(4, result); + } + if (Arg(0) != 0) { + SET_I((Eterm *) Arg(0)); + Goto(*I); + } + reg[0] = arg; + I = handle_error(c_p, I, reg, translate_gc_bif((void *) bf)); + goto post_error_handling; + } + + /* + * Guards bifs and, or, xor in guards. + */ + OpCase(i_bif2_fbd): + { + Eterm (*bf)(Process*, Eterm, Eterm); + Eterm result; + + bf = (BifFunction) Arg(1); + c_p->fcalls = FCALLS; + PROCESS_MAIN_CHK_LOCKS(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + result = (*bf)(c_p, tmp_arg1, tmp_arg2); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_HOLE_CHECK(c_p); + FCALLS = c_p->fcalls; + if (is_value(result)) { + StoreBifResult(2, result); + } + SET_I((Eterm *) Arg(0)); + Goto(*I); + } + + /* + * Guards bifs and, or, xor, relational operators in body. + */ + OpCase(i_bif2_body_bd): + { + Eterm (*bf)(Process*, Eterm, Eterm); + Eterm result; + + bf = (BifFunction) Arg(0); + PROCESS_MAIN_CHK_LOCKS(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + result = (*bf)(c_p, tmp_arg1, tmp_arg2); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_HOLE_CHECK(c_p); + if (is_value(result)) { + ASSERT(!is_CP(result)); + StoreBifResult(1, result); + } + reg[0] = tmp_arg1; + reg[1] = tmp_arg2; + SWAPOUT; + I = handle_error(c_p, I, reg, bf); + goto post_error_handling; + } + + /* + * The most general BIF call. The BIF may build any amount of data + * on the heap. The result is always returned in r(0). + */ + OpCase(call_bif0_e): + { + Eterm (*bf)(Process*, Uint*) = GET_BIF_ADDRESS(Arg(0)); + + PRE_BIF_SWAPOUT(c_p); + c_p->fcalls = FCALLS - 1; + if (FCALLS <= 0) { + save_calls(c_p, (Export *) Arg(0)); + } + + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + r(0) = (*bf)(c_p, I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(r(0))); + ERTS_HOLE_CHECK(c_p); + POST_BIF_GC_SWAPIN_0(c_p, r(0)); + FCALLS = c_p->fcalls; + if (is_value(r(0))) { + CHECK_TERM(r(0)); + Next(1); + } + else if (c_p->freason == TRAP) { + goto call_bif_trap3; + } + + /* + * Error handling. SWAPOUT is not needed because it was done above. + */ + ASSERT(c_p->stop == E); + reg[0] = r(0); + I = handle_error(c_p, I, reg, bf); + goto post_error_handling; + } + + OpCase(call_bif1_e): + { + Eterm (*bf)(Process*, Eterm, Uint*) = GET_BIF_ADDRESS(Arg(0)); + Eterm result; + Eterm* next; + + c_p->fcalls = FCALLS - 1; + if (FCALLS <= 0) { + save_calls(c_p, (Export *) Arg(0)); + } + PreFetch(1, next); + PRE_BIF_SWAPOUT(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + result = (*bf)(c_p, r(0), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_HOLE_CHECK(c_p); + POST_BIF_GC_SWAPIN(c_p, result, reg, 1); + FCALLS = c_p->fcalls; + if (is_value(result)) { + r(0) = result; + CHECK_TERM(r(0)); + NextPF(1, next); + } else if (c_p->freason == TRAP) { + goto call_bif_trap3; + } + + /* + * Error handling. SWAPOUT is not needed because it was done above. + */ + ASSERT(c_p->stop == E); + reg[0] = r(0); + I = handle_error(c_p, I, reg, bf); + goto post_error_handling; + } + + OpCase(call_bif2_e): + { + Eterm (*bf)(Process*, Eterm, Eterm, Uint*) = GET_BIF_ADDRESS(Arg(0)); + Eterm result; + Eterm* next; + + PRE_BIF_SWAPOUT(c_p); + c_p->fcalls = FCALLS - 1; + if (FCALLS <= 0) { + save_calls(c_p, (Export *) Arg(0)); + } + PreFetch(1, next); + CHECK_TERM(r(0)); + CHECK_TERM(x(1)); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + result = (*bf)(c_p, r(0), x(1), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_HOLE_CHECK(c_p); + POST_BIF_GC_SWAPIN(c_p, result, reg, 2); + FCALLS = c_p->fcalls; + if (is_value(result)) { + r(0) = result; + CHECK_TERM(r(0)); + NextPF(1, next); + } else if (c_p->freason == TRAP) { + goto call_bif_trap3; + } + + /* + * Error handling. SWAPOUT is not needed because it was done above. + */ + ASSERT(c_p->stop == E); + reg[0] = r(0); + I = handle_error(c_p, I, reg, bf); + goto post_error_handling; + } + + OpCase(call_bif3_e): + { + Eterm (*bf)(Process*, Eterm, Eterm, Eterm, Uint*) = GET_BIF_ADDRESS(Arg(0)); + Eterm result; + Eterm* next; + + PRE_BIF_SWAPOUT(c_p); + c_p->fcalls = FCALLS - 1; + if (FCALLS <= 0) { + save_calls(c_p, (Export *) Arg(0)); + } + PreFetch(1, next); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + result = (*bf)(c_p, r(0), x(1), x(2), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(result)); + ERTS_HOLE_CHECK(c_p); + POST_BIF_GC_SWAPIN(c_p, result, reg, 3); + FCALLS = c_p->fcalls; + if (is_value(result)) { + r(0) = result; + CHECK_TERM(r(0)); + NextPF(1, next); + } else if (c_p->freason == TRAP) { + call_bif_trap3: + SET_CP(c_p, I+2); + SET_I((Eterm *)c_p->def_arg_reg[3]); + SWAPIN; + r(0) = c_p->def_arg_reg[0]; + x(1) = c_p->def_arg_reg[1]; + x(2) = c_p->def_arg_reg[2]; + Dispatch(); + } + + /* + * Error handling. SWAPOUT is not needed because it was done above. + */ + ASSERT(c_p->stop == E); + reg[0] = r(0); + I = handle_error(c_p, I, reg, bf); + goto post_error_handling; + } + + /* + * Arithmetic operations. + */ + + OpCase(i_times_jId): + { + arith_func = ARITH_FUNC(mixed_times); + goto do_big_arith2; + } + + OpCase(i_m_div_jId): + { + arith_func = ARITH_FUNC(mixed_div); + goto do_big_arith2; + } + + OpCase(i_int_div_jId): + { + Eterm result; + + if (tmp_arg2 == SMALL_ZERO) { + goto badarith; + } else if (is_both_small(tmp_arg1, tmp_arg2)) { + Sint ires = signed_val(tmp_arg1) / signed_val(tmp_arg2); + if (MY_IS_SSMALL(ires)) { + result = make_small(ires); + STORE_ARITH_RESULT(result); + } + } + arith_func = ARITH_FUNC(int_div); + goto do_big_arith2; + } + + OpCase(i_rem_jId): + { + Eterm result; + + if (tmp_arg2 == SMALL_ZERO) { + goto badarith; + } else if (is_both_small(tmp_arg1, tmp_arg2)) { + result = make_small(signed_val(tmp_arg1) % signed_val(tmp_arg2)); + STORE_ARITH_RESULT(result); + } else { + arith_func = ARITH_FUNC(int_rem); + goto do_big_arith2; + } + } + + OpCase(i_band_jId): + { + Eterm result; + + if (is_both_small(tmp_arg1, tmp_arg2)) { + /* + * No need to untag -- TAG & TAG == TAG. + */ + result = tmp_arg1 & tmp_arg2; + STORE_ARITH_RESULT(result); + } + arith_func = ARITH_FUNC(band); + goto do_big_arith2; + } + + do_big_arith2: + { + Eterm result; + Uint live = Arg(1); + + SWAPOUT; + reg[0] = r(0); + reg[live] = tmp_arg1; + reg[live+1] = tmp_arg2; + result = arith_func(c_p, reg, live); + r(0) = reg[0]; + SWAPIN; + ERTS_HOLE_CHECK(c_p); + if (is_value(result)) { + STORE_ARITH_RESULT(result); + } + goto lb_Cl_error; + } + + /* + * An error occured in an arithmetic operation or test that could + * appear either in a head or in a body. + * In a head, execution should continue at failure address in Arg(0). + * In a body, Arg(0) == 0 and an exception should be raised. + */ + lb_Cl_error: { + if (Arg(0) != 0) { + OpCase(jump_f): { + SET_I((Eterm *) Arg(0)); + Goto(*I); + } + } + ASSERT(c_p->freason != BADMATCH || is_value(c_p->fvalue)); + goto find_func_info; + } + + OpCase(i_bor_jId): + { + Eterm result; + + if (is_both_small(tmp_arg1, tmp_arg2)) { + /* + * No need to untag -- TAG | TAG == TAG. + */ + result = tmp_arg1 | tmp_arg2; + STORE_ARITH_RESULT(result); + } + arith_func = ARITH_FUNC(bor); + goto do_big_arith2; + } + + OpCase(i_bxor_jId): + { + Eterm result; + + if (is_both_small(tmp_arg1, tmp_arg2)) { + /* + * We could extract the tag from one argument, but a tag extraction + * could mean a shift. Therefore, play it safe here. + */ + result = make_small(signed_val(tmp_arg1) ^ signed_val(tmp_arg2)); + STORE_ARITH_RESULT(result); + } + arith_func = ARITH_FUNC(bxor); + goto do_big_arith2; + } + + { + Sint i; + Sint ires; + Eterm* bigp; + + OpCase(i_bsr_jId): + if (is_small(tmp_arg2)) { + i = -signed_val(tmp_arg2); + if (is_small(tmp_arg1)) { + goto small_shift; + } else if (is_big(tmp_arg1)) { + if (i == 0) { + StoreBifResult(2, tmp_arg1); + } + goto big_shift; + } + } else if (is_big(tmp_arg2)) { + /* + * N bsr NegativeBigNum == N bsl MAX_SMALL + * N bsr PositiveBigNum == N bsl MIN_SMALL + */ + tmp_arg2 = make_small(bignum_header_is_neg(*big_val(tmp_arg2)) ? + MAX_SMALL : MIN_SMALL); + goto do_bsl; + } + goto badarith; + + OpCase(i_bsl_jId): + do_bsl: + if (is_small(tmp_arg2)) { + i = signed_val(tmp_arg2); + + if (is_small(tmp_arg1)) { + small_shift: + ires = signed_val(tmp_arg1); + + if (i == 0 || ires == 0) { + StoreBifResult(2, tmp_arg1); + } else if (i < 0) { /* Right shift */ + i = -i; + if (i >= SMALL_BITS-1) { + tmp_arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; + } else { + tmp_arg1 = make_small(ires >> i); + } + StoreBifResult(2, tmp_arg1); + } else if (i < SMALL_BITS-1) { /* Left shift */ + if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) || + ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) { + tmp_arg1 = make_small(ires << i); + StoreBifResult(2, tmp_arg1); + } + } + tmp_arg1 = small_to_big(ires, tmp_big); + + big_shift: + if (i > 0) { /* Left shift. */ + ires = big_size(tmp_arg1) + (i / D_EXP); + } else { /* Right shift. */ + ires = big_size(tmp_arg1); + if (ires <= (-i / D_EXP)) + ires = 3; /* ??? */ + else + ires -= (-i / D_EXP); + } + { + ires = BIG_NEED_SIZE(ires+1); + /* + * Slightly conservative check the size to avoid + * allocating huge amounts of memory for bignums that + * clearly would overflow the arity in the header + * word. + */ + if (ires-8 > BIG_ARITY_MAX) { + c_p->freason = SYSTEM_LIMIT; + goto lb_Cl_error; + } + TestHeapPreserve(ires+1, Arg(1), tmp_arg1); + bigp = HTOP; + tmp_arg1 = big_lshift(tmp_arg1, i, bigp); + if (is_big(tmp_arg1)) { + HTOP += bignum_header_arity(*HTOP) + 1; + } + if (is_nil(tmp_arg1)) { + /* + * This result must have been only slight larger + * than allowed since it wasn't caught by the + * previous test. + */ + c_p->freason = SYSTEM_LIMIT; + goto lb_Cl_error; + } + ERTS_HOLE_CHECK(c_p); + StoreBifResult(2, tmp_arg1); + } + } else if (is_big(tmp_arg1)) { + if (i == 0) { + StoreBifResult(2, tmp_arg1); + } + goto big_shift; + } + } else if (is_big(tmp_arg2)) { + if (bignum_header_is_neg(*big_val(tmp_arg2))) { + /* + * N bsl NegativeBigNum is either 0 or -1, depending on + * the sign of N. Since we don't believe this case + * is common, do the calculation with the minimum + * amount of code. + */ + tmp_arg2 = make_small(MIN_SMALL); + goto do_bsl; + } else if (is_small(tmp_arg1) || is_big(tmp_arg1)) { + /* + * N bsl PositiveBigNum is too large to represent. + */ + c_p->freason = SYSTEM_LIMIT; + goto lb_Cl_error; + } + /* Fall through if the left argument is not an integer. */ + } + /* + * One or more non-integer arguments. + */ + goto badarith; + } + + OpCase(i_int_bnot_jsId): + { + GetArg1(1, tmp_arg1); + if (is_small(tmp_arg1)) { + tmp_arg1 = make_small(~signed_val(tmp_arg1)); + } else { + Uint live = Arg(2); + SWAPOUT; + reg[0] = r(0); + reg[live] = tmp_arg1; + tmp_arg1 = erts_gc_bnot(c_p, reg, live); + r(0) = reg[0]; + SWAPIN; + ERTS_HOLE_CHECK(c_p); + if (is_nil(tmp_arg1)) { + goto lb_Cl_error; + } + } + StoreBifResult(3, tmp_arg1); + } + + badarith: + c_p->freason = BADARITH; + goto lb_Cl_error; + + OpCase(i_apply): { + Eterm* next; + SWAPOUT; + next = apply(c_p, r(0), x(1), x(2), reg); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_CP(c_p, I+1); + SET_I(next); + Dispatch(); + } + I = handle_error(c_p, I, reg, apply_3); + goto post_error_handling; + } + + OpCase(i_apply_last_P): { + Eterm* next; + SWAPOUT; + next = apply(c_p, r(0), x(1), x(2), reg); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_CP(c_p, (Eterm *) E[0]); + E = ADD_BYTE_OFFSET(E, Arg(0)); + SET_I(next); + Dispatch(); + } + I = handle_error(c_p, I, reg, apply_3); + goto post_error_handling; + } + + OpCase(i_apply_only): { + Eterm* next; + SWAPOUT; + next = apply(c_p, r(0), x(1), x(2), reg); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_I(next); + Dispatch(); + } + I = handle_error(c_p, I, reg, apply_3); + goto post_error_handling; + } + + OpCase(apply_I): { + Eterm* next; + + reg[0] = r(0); + SWAPOUT; + next = fixed_apply(c_p, reg, Arg(0)); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_CP(c_p, I+2); + SET_I(next); + Dispatch(); + } + I = handle_error(c_p, I, reg, apply_3); + goto post_error_handling; + } + + OpCase(apply_last_IP): { + Eterm* next; + + reg[0] = r(0); + SWAPOUT; + next = fixed_apply(c_p, reg, Arg(0)); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_CP(c_p, (Eterm *) E[0]); + E = ADD_BYTE_OFFSET(E, Arg(1)); + SET_I(next); + Dispatch(); + } + I = handle_error(c_p, I, reg, apply_3); + goto post_error_handling; + } + + OpCase(i_apply_fun): { + Eterm* next; + + SWAPOUT; + next = apply_fun(c_p, r(0), x(1), reg); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_CP(c_p, I+1); + SET_I(next); + Dispatchfun(); + } + goto find_func_info; + } + + OpCase(i_apply_fun_last_P): { + Eterm* next; + + SWAPOUT; + next = apply_fun(c_p, r(0), x(1), reg); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_CP(c_p, (Eterm *) E[0]); + E = ADD_BYTE_OFFSET(E, Arg(0)); + SET_I(next); + Dispatchfun(); + } + goto find_func_info; + } + + OpCase(i_apply_fun_only): { + Eterm* next; + + SWAPOUT; + next = apply_fun(c_p, r(0), x(1), reg); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_I(next); + Dispatchfun(); + } + goto find_func_info; + } + + OpCase(i_call_fun_I): { + Eterm* next; + + SWAPOUT; + reg[0] = r(0); + next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_CP(c_p, I+2); + SET_I(next); + Dispatchfun(); + } + goto find_func_info; + } + + OpCase(i_call_fun_last_IP): { + Eterm* next; + + SWAPOUT; + reg[0] = r(0); + next = call_fun(c_p, Arg(0), reg, THE_NON_VALUE); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_CP(c_p, (Eterm *) E[0]); + E = ADD_BYTE_OFFSET(E, Arg(1)); + SET_I(next); + Dispatchfun(); + } + goto find_func_info; + } + +#ifdef DEBUG + /* + * Set a breakpoint here to get control just after a call instruction. + * I points to the first instruction in the called function. + * + * In gdb, use 'call dis(I-5, 1)' to show the name of the function. + */ + do_dispatch: + DispatchMacro(); + + do_dispatchx: + DispatchMacrox(); + + do_dispatchfun: + DispatchMacroFun(); + +#endif + + /* + * Jumped to from the Dispatch() macro when the reductions are used up. + * + * Since the I register points just beyond the FuncBegin instruction, we + * can get the module, function, and arity for the function being + * called from I[-3], I[-2], and I[-1] respectively. + */ + context_switch_fun: + c_p->arity = I[-1] + 1; + goto context_switch2; + + context_switch: + c_p->arity = I[-1]; + + context_switch2: /* Entry for fun calls. */ + c_p->current = I-3; /* Pointer to Mod, Func, Arity */ + + { + Eterm* argp; + int i; + + /* + * Make sure that there is enough room for the argument registers to be saved. + */ + if (c_p->arity > c_p->max_arg_reg) { + /* + * Yes, this is an expensive operation, but you only pay it the first + * time you call a function with more than 6 arguments which is + * scheduled out. This is better than paying for 26 words of wasted + * space for most processes which never call functions with more than + * 6 arguments. + */ + Uint size = c_p->arity * sizeof(c_p->arg_reg[0]); + if (c_p->arg_reg != c_p->def_arg_reg) { + c_p->arg_reg = (Eterm *) erts_realloc(ERTS_ALC_T_ARG_REG, + (void *) c_p->arg_reg, + size); + } else { + c_p->arg_reg = (Eterm *) erts_alloc(ERTS_ALC_T_ARG_REG, size); + } + c_p->max_arg_reg = c_p->arity; + } + + /* + * Since REDS_IN(c_p) is stored in the save area (c_p->arg_reg) we must read it + * now before saving registers. + * + * The '+ 1' compensates for the last increment which was not done + * (beacuse the code for the Dispatch() macro becomes shorter that way). + */ + + reds_used = REDS_IN(c_p) - FCALLS + 1; + + /* + * Save the argument registers and everything else. + */ + + argp = c_p->arg_reg; + for (i = c_p->arity - 1; i > 0; i--) { + argp[i] = reg[i]; + } + c_p->arg_reg[0] = r(0); + SWAPOUT; + c_p->i = I; + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS); + if (c_p->status != P_SUSPENDED) + erts_add_to_runq(c_p); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); + goto do_schedule1; + } + + OpCase(i_select_tuple_arity_sfI): + { + GetArg1(0, tmp_arg1); + + if (is_tuple(tmp_arg1)) { + tmp_arg1 = *tuple_val(tmp_arg1); + goto do_binary_search; + } + SET_I((Eterm *) Arg(1)); + Goto(*I); + } + + OpCase(i_select_big_sf): + { + Eterm* bigp; + Uint arity; + Eterm* given; + Uint given_arity; + Uint given_size; + + GetArg1(0, tmp_arg1); + if (is_big(tmp_arg1)) { + + /* + * The loader has sorted the bignumbers in descending order + * on the arity word. Therefore, we know that the search + * has failed as soon as we encounter an arity word less than + * the arity word of the given number. There is a zero word + * (less than any valid arity word) stored after the last bignumber. + */ + + given = big_val(tmp_arg1); + given_arity = given[0]; + given_size = thing_arityval(given_arity); + bigp = &Arg(2); + while ((arity = bigp[0]) > given_arity) { + bigp += thing_arityval(arity) + 2; + } + while (bigp[0] == given_arity) { + if (memcmp(bigp+1, given+1, sizeof(Eterm)*given_size) == 0) { + SET_I((Eterm *) bigp[given_size+1]); + Goto(*I); + } + bigp += thing_arityval(arity) + 2; + } + } + + /* + * Failed. + */ + + SET_I((Eterm *) Arg(1)); + Goto(*I); + } + +#ifdef ARCH_64 + OpCase(i_select_float_sfI): + { + Uint f; + int n; + struct ValLabel { + Uint f; + Eterm* addr; + }; + struct ValLabel* ptr; + + GetArg1(0, tmp_arg1); + ASSERT(is_float(tmp_arg1)); + f = float_val(tmp_arg1)[1]; + n = Arg(2); + ptr = (struct ValLabel *) &Arg(3); + while (n-- > 0) { + if (ptr->f == f) { + SET_I(ptr->addr); + Goto(*I); + } + ptr++; + } + SET_I((Eterm *) Arg(1)); + Goto(*I); + } +#else + OpCase(i_select_float_sfI): + { + Uint fpart1; + Uint fpart2; + int n; + struct ValLabel { + Uint fpart1; + Uint fpart2; + Eterm* addr; + }; + struct ValLabel* ptr; + + GetArg1(0, tmp_arg1); + ASSERT(is_float(tmp_arg1)); + fpart1 = float_val(tmp_arg1)[1]; + fpart2 = float_val(tmp_arg1)[2]; + + n = Arg(2); + ptr = (struct ValLabel *) &Arg(3); + while (n-- > 0) { + if (ptr->fpart1 == fpart1 && ptr->fpart2 == fpart2) { + SET_I(ptr->addr); + Goto(*I); + } + ptr++; + } + SET_I((Eterm *) Arg(1)); + Goto(*I); + } +#endif + + OpCase(set_tuple_element_sdP): { + Eterm element; + Eterm tuple; + Eterm* next; + Eterm* p; + + PreFetch(3, next); + GetArg2(0, element, tuple); + ASSERT(is_tuple(tuple)); + p = (Eterm *) ((unsigned char *) tuple_val(tuple) + Arg(2)); + *p = element; + NextPF(3, next); + } + + OpCase(i_is_ne_exact_f): + if (EQ(tmp_arg1, tmp_arg2)) { + ClauseFail(); + } + Next(1); + + OpCase(normal_exit): { + SWAPOUT; + c_p->freason = EXC_NORMAL; + c_p->arity = 0; /* In case this process will ever be garbed again. */ + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + erts_do_exit_process(c_p, am_normal); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + goto do_schedule; + } + + OpCase(continue_exit): { + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + erts_continue_exit_process(c_p); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + goto do_schedule; + } + + OpCase(raise_ss): { + /* This was not done very well in R10-0; then, we passed the tag in + the first argument and hoped that the existing c_p->ftrace was + still correct. But the ftrace-object already includes the tag + (or rather, the freason). Now, we pass the original ftrace in + the first argument. We also handle atom tags in the first + argument for backwards compatibility. + */ + GetArg2(0, tmp_arg1, tmp_arg2); + c_p->fvalue = tmp_arg2; + if (c_p->freason == EXC_NULL) { + /* a safety check for the R10-0 case; should not happen */ + c_p->ftrace = NIL; + c_p->freason = EXC_ERROR; + } + /* for R10-0 code, keep existing c_p->ftrace and hope it's correct */ + switch (tmp_arg1) { + case am_throw: + c_p->freason = EXC_THROWN & ~EXF_SAVETRACE; + break; + case am_error: + c_p->freason = EXC_ERROR & ~EXF_SAVETRACE; + break; + case am_exit: + c_p->freason = EXC_EXIT & ~EXF_SAVETRACE; + break; + default: + {/* R10-1 and later + XXX note: should do sanity check on given trace if it can be + passed from a user! Currently only expecting generated calls. + */ + struct StackTrace *s; + c_p->ftrace = tmp_arg1; + s = get_trace_from_exc(tmp_arg1); + if (s == NULL) { + c_p->freason = EXC_ERROR; + } else { + c_p->freason = PRIMARY_EXCEPTION(s->freason); + } + } + } + goto find_func_info; + } + + OpCase(badmatch_s): { + GetArg1(0, tmp_arg1); + c_p->fvalue = tmp_arg1; + c_p->freason = BADMATCH; + } + /* Fall through here */ + + find_func_info: { + reg[0] = r(0); + SWAPOUT; + I = handle_error(c_p, I, reg, NULL); + goto post_error_handling; + } + + OpCase(call_error_handler): + /* + * At this point, I points to the code[3] in the export entry for + * a function which is not loaded. + * + * code[0]: Module + * code[1]: Function + * code[2]: Arity + * code[3]: &&call_error_handler + * code[4]: Not used + */ + SWAPOUT; + reg[0] = r(0); + tmp_arg1 = call_error_handler(c_p, I-3, reg); + r(0) = reg[0]; + SWAPIN; + if (tmp_arg1) { + SET_I(c_p->i); + Dispatch(); + } + + /* Fall through */ + OpCase(error_action_code): { + no_error_handler: + reg[0] = r(0); + SWAPOUT; + I = handle_error(c_p, NULL, reg, NULL); + post_error_handling: + if (I == 0) { + goto do_schedule; + } else { + r(0) = reg[0]; + ASSERT(!is_value(r(0))); + if (c_p->mbuf) { + erts_garbage_collect(c_p, 0, reg+1, 3); + } + SWAPIN; + Goto(*I); + } + } + + OpCase(call_nif): + { + static void* const dispatchers[4] = { + nif_dispatcher_0, nif_dispatcher_1, nif_dispatcher_2, nif_dispatcher_3 + }; + BifFunction vbf = dispatchers[I[-1]]; + goto apply_bif_or_nif; + + OpCase(apply_bif): + /* + * At this point, I points to the code[3] in the export entry for + * the BIF: + * + * code[0]: Module + * code[1]: Function + * code[2]: Arity + * code[3]: &&apply_bif + * code[4]: Function pointer to BIF function + */ + vbf = (BifFunction) Arg(0); + + apply_bif_or_nif: + c_p->current = I-3; /* In case we apply process_info/1,2 or load_nif/1 */ + c_p->i = I; /* In case we apply check_process_code/2. */ + c_p->arity = 0; /* To allow garbage collection on ourselves + * (check_process_code/2). + */ + + SWAPOUT; + c_p->fcalls = FCALLS - 1; + PROCESS_MAIN_CHK_LOCKS(c_p); + tmp_arg2 = I[-1]; + ASSERT(tmp_arg2 <= 3); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + switch (tmp_arg2) { + case 3: + { + Eterm (*bf)(Process*, Eterm, Eterm, Eterm, Uint*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + tmp_arg1 = (*bf)(c_p, r(0), x(1), x(2), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); + PROCESS_MAIN_CHK_LOCKS(c_p); + } + break; + case 2: + { + Eterm (*bf)(Process*, Eterm, Eterm, Uint*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + tmp_arg1 = (*bf)(c_p, r(0), x(1), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); + PROCESS_MAIN_CHK_LOCKS(c_p); + } + break; + case 1: + { + Eterm (*bf)(Process*, Eterm, Uint*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + tmp_arg1 = (*bf)(c_p, r(0), I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); + PROCESS_MAIN_CHK_LOCKS(c_p); + } + break; + case 0: + { + Eterm (*bf)(Process*, Uint*) = vbf; + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + tmp_arg1 = (*bf)(c_p, I); + ASSERT(!ERTS_PROC_IS_EXITING(c_p) || is_non_value(tmp_arg1)); + PROCESS_MAIN_CHK_LOCKS(c_p); + break; + } + } + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + ERTS_HOLE_CHECK(c_p); + if (c_p->mbuf) { + reg[0] = r(0); + tmp_arg1 = erts_gc_after_bif_call(c_p, tmp_arg1, reg, tmp_arg2); + r(0) = reg[0]; + } + SWAPIN; /* There might have been a garbage collection. */ + FCALLS = c_p->fcalls; + if (is_value(tmp_arg1)) { + r(0) = tmp_arg1; + CHECK_TERM(r(0)); + SET_I(c_p->cp); + Goto(*I); + } else if (c_p->freason == TRAP) { + SET_I((Eterm *)c_p->def_arg_reg[3]); + r(0) = c_p->def_arg_reg[0]; + x(1) = c_p->def_arg_reg[1]; + x(2) = c_p->def_arg_reg[2]; + Dispatch(); + } + reg[0] = r(0); + I = handle_error(c_p, c_p->cp, reg, vbf); + goto post_error_handling; + } + + OpCase(i_get_sd): + { + Eterm arg; + Eterm result; + + GetArg1(0, arg); + result = erts_pd_hash_get(c_p, arg); + StoreBifResult(1, result); + } + + OpCase(i_put_tuple_only_Ad): { + tmp_arg1 = make_tuple(HTOP); + *HTOP++ = Arg(0); + StoreBifResult(1, tmp_arg1); + } + + OpCase(case_end_s): + GetArg1(0, tmp_arg1); + c_p->fvalue = tmp_arg1; + c_p->freason = EXC_CASE_CLAUSE; + goto find_func_info; + + OpCase(if_end): + c_p->freason = EXC_IF_CLAUSE; + goto find_func_info; + + OpCase(i_func_info_IaaI): { + c_p->freason = EXC_FUNCTION_CLAUSE; + c_p->current = I + 2; + goto lb_error_action_code; + } + + OpCase(try_case_end_s): + GetArg1(0, tmp_arg1); + c_p->fvalue = tmp_arg1; + c_p->freason = EXC_TRY_CLAUSE; + goto find_func_info; + + /* + * Construction of binaries using new instructions. + */ + { + Eterm new_binary; + Eterm num_bits_term; + Uint num_bits; + Uint alloc; + Uint num_bytes; + + OpCase(i_bs_init_bits_heap_IIId): { + num_bits = Arg(0); + alloc = Arg(1); + I++; + goto do_bs_init_bits_known; + } + + OpCase(i_bs_init_bits_IId): { + num_bits = Arg(0); + alloc = 0; + goto do_bs_init_bits_known; + } + + OpCase(i_bs_init_bits_fail_heap_IjId): { + /* tmp_arg1 was fetched by an i_fetch instruction */ + num_bits_term = tmp_arg1; + alloc = Arg(0); + I++; + goto do_bs_init_bits; + } + + OpCase(i_bs_init_bits_fail_rjId): { + num_bits_term = r(0); + alloc = 0; + goto do_bs_init_bits; + } + OpCase(i_bs_init_bits_fail_yjId): { + num_bits_term = yb(Arg(0)); + I++; + alloc = 0; + goto do_bs_init_bits; + } + OpCase(i_bs_init_bits_fail_xjId): { + num_bits_term = xb(Arg(0)); + I++; + alloc = 0; + /* FALL THROUGH */ + } + + /* num_bits_term = Term for number of bits to build (small/big) + * alloc = Number of words to allocate on heap + * Operands: Fail Live Dst + */ + + do_bs_init_bits: + if (is_small(num_bits_term)) { + Sint size = signed_val(num_bits_term); + if (size < 0) { + goto badarg; + } + num_bits = (Uint) size; + } else { + Uint bits; + + if (!term_to_Uint(num_bits_term, &bits)) { + c_p->freason = bits; + goto lb_Cl_error; + + } + num_bits = (Eterm) bits; + } + + /* num_bits = Number of bits to build + * alloc = Number of extra words to allocate on heap + * Operands: NotUsed Live Dst + */ + do_bs_init_bits_known: + num_bytes = (num_bits+7) >> 3; + if (num_bits & 7) { + alloc += ERL_SUB_BIN_SIZE; + } + if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { + alloc += heap_bin_size(num_bytes); + } else { + alloc += PROC_BIN_SIZE; + } + TestHeap(alloc, Arg(1)); + + /* num_bits = Number of bits to build + * num_bytes = Number of bytes to allocate in the binary + * alloc = Total number of words to allocate on heap + * Operands: NotUsed NotUsed Dst + */ + if (num_bytes <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin* hb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + hb = (ErlHeapBin *) HTOP; + HTOP += heap_bin_size(num_bytes); + hb->thing_word = header_heap_bin(num_bytes); + hb->size = num_bytes; + erts_current_bin = (byte *) hb->data; + new_binary = make_binary(hb); + + do_bits_sub_bin: + if (num_bits & 7) { + ErlSubBin* sb; + + sb = (ErlSubBin *) HTOP; + HTOP += ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = num_bytes - 1; + sb->bitsize = num_bits & 7; + sb->offs = 0; + sb->bitoffs = 0; + sb->is_writable = 0; + sb->orig = new_binary; + new_binary = make_binary(sb); + } + StoreBifResult(2, new_binary); + } else { + Binary* bptr; + ProcBin* pb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + + /* + * Allocate the binary struct itself. + */ + bptr = erts_bin_nrml_alloc(num_bytes); + bptr->flags = 0; + bptr->orig_size = num_bytes; + erts_refc_init(&bptr->refc, 1); + erts_current_bin = (byte *) bptr->orig_bytes; + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) HTOP; + HTOP += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = num_bytes; + pb->next = MSO(c_p).mso; + MSO(c_p).mso = pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + MSO(c_p).overhead += pb->size / sizeof(Eterm); + new_binary = make_binary(pb); + goto do_bits_sub_bin; + } + } + + { + OpCase(i_bs_init_fail_heap_IjId): { + /* tmp_arg1 was fetched by an i_fetch instruction */ + tmp_arg2 = Arg(0); + I++; + goto do_bs_init; + } + + OpCase(i_bs_init_fail_rjId): { + tmp_arg1 = r(0); + tmp_arg2 = 0; + goto do_bs_init; + } + + OpCase(i_bs_init_fail_yjId): { + tmp_arg1 = yb(Arg(0)); + tmp_arg2 = 0; + I++; + goto do_bs_init; + } + + OpCase(i_bs_init_fail_xjId): { + tmp_arg1 = xb(Arg(0)); + tmp_arg2 = 0; + I++; + } + /* FALL THROUGH */ + do_bs_init: + if (is_small(tmp_arg1)) { + Sint size = signed_val(tmp_arg1); + if (size < 0) { + goto badarg; + } + tmp_arg1 = (Eterm) size; + } else { + Uint bytes; + + if (!term_to_Uint(tmp_arg1, &bytes)) { + c_p->freason = bytes; + goto lb_Cl_error; + } + if ((bytes >> (8*sizeof(Uint)-3)) != 0) { + goto system_limit; + } + tmp_arg1 = (Eterm) bytes; + } + if (tmp_arg1 <= ERL_ONHEAP_BIN_LIMIT) { + goto do_heap_bin_alloc; + } else { + goto do_proc_bin_alloc; + } + + + OpCase(i_bs_init_heap_IIId): { + tmp_arg1 = Arg(0); + tmp_arg2 = Arg(1); + I++; + goto do_proc_bin_alloc; + } + + OpCase(i_bs_init_IId): { + tmp_arg1 = Arg(0); + tmp_arg2 = 0; + } + /* FALL THROUGH */ + do_proc_bin_alloc: { + Binary* bptr; + ProcBin* pb; + + erts_bin_offset = 0; + erts_writable_bin = 0; + TestBinVHeap(tmp_arg1 / sizeof(Eterm), + tmp_arg2 + PROC_BIN_SIZE + ERL_SUB_BIN_SIZE, Arg(1)); + + /* + * Allocate the binary struct itself. + */ + bptr = erts_bin_nrml_alloc(tmp_arg1); + bptr->flags = 0; + bptr->orig_size = tmp_arg1; + erts_refc_init(&bptr->refc, 1); + erts_current_bin = (byte *) bptr->orig_bytes; + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) HTOP; + HTOP += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = tmp_arg1; + pb->next = MSO(c_p).mso; + MSO(c_p).mso = pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + + MSO(c_p).overhead += tmp_arg1 / sizeof(Eterm); + + StoreBifResult(2, make_binary(pb)); + } + + OpCase(i_bs_init_heap_bin_heap_IIId): { + tmp_arg1 = Arg(0); + tmp_arg2 = Arg(1); + I++; + goto do_heap_bin_alloc; + } + + OpCase(i_bs_init_heap_bin_IId): { + tmp_arg1 = Arg(0); + tmp_arg2 = 0; + } + /* Fall through */ + do_heap_bin_alloc: + { + ErlHeapBin* hb; + Uint bin_need; + + bin_need = heap_bin_size(tmp_arg1); + erts_bin_offset = 0; + erts_writable_bin = 0; + TestHeap(bin_need+tmp_arg2+ERL_SUB_BIN_SIZE, Arg(1)); + hb = (ErlHeapBin *) HTOP; + HTOP += bin_need; + hb->thing_word = header_heap_bin(tmp_arg1); + hb->size = tmp_arg1; + erts_current_bin = (byte *) hb->data; + tmp_arg1 = make_binary(hb); + StoreBifResult(2, tmp_arg1); + } + } + + OpCase(i_bs_bits_to_bytes_rjd): { + tmp_arg1 = r(0); + goto do_bits_to_bytes; + } + + OpCase(i_bs_bits_to_bytes_yjd): { + tmp_arg1 = yb(Arg(0)); + I++; + goto do_bits_to_bytes; + + OpCase(i_bs_bits_to_bytes_xjd): { + tmp_arg1 = xb(Arg(0)); + I++; + } + + do_bits_to_bytes: + { + if (is_valid_bit_size(tmp_arg1)) { + tmp_arg1 = make_small(unsigned_val(tmp_arg1) >> 3); + } else { + Uint bytes; + if (!term_to_Uint(tmp_arg1, &bytes)) { + goto badarg; + } + tmp_arg1 = bytes; + if ((tmp_arg1 & 0x07) != 0) { + goto badarg; + } + SWAPOUT; + tmp_arg1 = erts_make_integer(tmp_arg1 >> 3, c_p); + HTOP = HEAP_TOP(c_p); + } + StoreBifResult(1, tmp_arg1); + } + } + + OpCase(i_bs_add_jId): { + Uint Unit = Arg(1); + if (is_both_small(tmp_arg1, tmp_arg2)) { + Sint Arg1 = signed_val(tmp_arg1); + Sint Arg2 = signed_val(tmp_arg2); + + if (Arg1 >= 0 && Arg2 >= 0) { + BsSafeMul(Arg2, Unit, goto system_limit, tmp_arg1); + tmp_arg1 += Arg1; + + store_bs_add_result: + if (MY_IS_SSMALL((Sint) tmp_arg1)) { + tmp_arg1 = make_small(tmp_arg1); + } else { + /* + * May generate a heap fragment, but in this + * particular case it is OK, since the value will be + * stored into an x register (the GC will scan x + * registers for references to heap fragments) and + * there is no risk that value can be stored into a + * location that is not scanned for heap-fragment + * references (such as the heap). + */ + SWAPOUT; + tmp_arg1 = erts_make_integer(tmp_arg1, c_p); + HTOP = HEAP_TOP(c_p); + } + StoreBifResult(2, tmp_arg1); + } + goto badarg; + } else { + Uint a; + Uint b; + Uint c; + + /* + * Now we know that one of the arguments is + * not at small. We must convert both arguments + * to Uints and check for errors at the same time. + * + * Error checking is tricky. + * + * If one of the arguments is not numeric or + * not positive, the error reason is BADARG. + * + * Otherwise if both arguments are numeric, + * but at least one argument does not fit in + * an Uint, the reason is SYSTEM_LIMIT. + */ + + if (!term_to_Uint(tmp_arg1, &a)) { + if (a == BADARG) { + goto badarg; + } + if (!term_to_Uint(tmp_arg2, &b)) { + c_p->freason = b; + goto lb_Cl_error; + } + goto system_limit; + } else if (!term_to_Uint(tmp_arg2, &b)) { + c_p->freason = b; + goto lb_Cl_error; + } + + /* + * The arguments are now correct and stored in a and b. + */ + + BsSafeMul(b, Unit, goto system_limit, c); + tmp_arg1 = a + c; + if (tmp_arg1 < a) { + /* + * If the result is less than one of the + * arguments, there must have been an overflow. + */ + goto system_limit; + } + goto store_bs_add_result; + } + /* No fallthrough */ + ASSERT(0); + } + + OpCase(bs_put_string_II): + { + Eterm* next; + PreFetch(2, next); + erts_new_bs_put_string(ERL_BITS_ARGS_2((byte *) Arg(1), Arg(0))); + NextPF(2, next); + } + + /* + * tmp_arg1 = Number of bytes to build + * tmp_arg2 = Source binary + * Operands: Fail ExtraHeap Live Unit Dst + */ + + OpCase(i_bs_append_jIIId): { + Uint live = Arg(2); + Uint res; + + SWAPOUT; + reg[0] = r(0); + reg[live] = tmp_arg2; + res = erts_bs_append(c_p, reg, live, tmp_arg1, Arg(1), Arg(3)); + r(0) = reg[0]; + SWAPIN; + if (is_non_value(res)) { + /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ + goto lb_Cl_error; + } + StoreBifResult(4, res); + } + + /* + * tmp_arg1 = Number of bytes to build + * tmp_arg2 = Source binary + * Operands: Fail Unit Dst + */ + OpCase(i_bs_private_append_jId): { + Eterm res; + + res = erts_bs_private_append(c_p, tmp_arg2, tmp_arg1, Arg(1)); + if (is_non_value(res)) { + /* c_p->freason is already set (may be either BADARG or SYSTEM_LIMIT). */ + goto lb_Cl_error; + } + StoreBifResult(2, res); + } + + /* + * tmp_arg1 = Initial size of writable binary + * Operands: Live Dst + */ + OpCase(bs_init_writable): { + SWAPOUT; + r(0) = erts_bs_init_writable(c_p, r(0)); + SWAPIN; + Next(0); + } + + /* + * Calculate the number of bytes needed to encode the source + * operarand to UTF-8. If the source operand is invalid (e.g. wrong + * type or range) we return a nonsense integer result (0 or 4). We + * can get away with that because we KNOW that bs_put_utf8 will do + * full error checking. + */ + OpCase(i_bs_utf8_size_sd): { + Eterm arg; + Eterm result; + + GetArg1(0, arg); + if (arg < make_small(0x80UL)) { + result = make_small(1); + } else if (arg < make_small(0x800UL)) { + result = make_small(2); + } else if (arg < make_small(0x10000UL)) { + result = make_small(3); + } else { + result = make_small(4); + } + StoreBifResult(1, result); + } + + OpCase(i_bs_put_utf8_js): { + Eterm arg; + + GetArg1(1, arg); + if (!erts_bs_put_utf8(ERL_BITS_ARGS_1(arg))) { + goto badarg; + } + Next(2); + } + + /* + * Calculate the number of bytes needed to encode the source + * operarand to UTF-8. If the source operand is invalid (e.g. wrong + * type or range) we return a nonsense integer result (2 or 4). We + * can get away with that because we KNOW that bs_put_utf16 will do + * full error checking. + */ + + OpCase(i_bs_utf16_size_sd): { + Eterm arg; + Eterm result = make_small(2); + + GetArg1(0, arg); + if (arg >= make_small(0x10000UL)) { + result = make_small(4); + } + StoreBifResult(1, result); + } + + OpCase(i_bs_put_utf16_jIs): { + Eterm arg; + + GetArg1(2, arg); + if (!erts_bs_put_utf16(ERL_BITS_ARGS_2(arg, Arg(1)))) { + goto badarg; + } + Next(3); + } + + /* + * Only used for validating a value about to be stored in a binary. + */ + OpCase(i_bs_validate_unicode_js): { + Eterm val; + + GetArg1(1, val); + + /* + * There is no need to untag the integer, but it IS necessary + * to make sure it is small (if the term is a bignum, it could + * slip through the test, and there is no further test that + * would catch it, since bit syntax construction silently masks + * too big numbers). + */ + if (is_not_small(val) || val > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= val && val <= make_small(0xDFFFUL)) || + val == make_small(0xFFFEUL) || val == make_small(0xFFFFUL)) { + goto badarg; + } + Next(2); + } + + /* + * Only used for validating a value matched out. + * + * tmp_arg1 = Integer to validate + * tmp_arg2 = Match context + */ + OpCase(i_bs_validate_unicode_retract_j): { + /* + * There is no need to untag the integer, but it IS necessary + * to make sure it is small (a bignum pointer could fall in + * the valid range). + */ + if (is_not_small(tmp_arg1) || tmp_arg1 > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= tmp_arg1 && tmp_arg1 <= make_small(0xDFFFUL)) || + tmp_arg1 == make_small(0xFFFEUL) || tmp_arg1 == make_small(0xFFFFUL)) { + ErlBinMatchBuffer *mb = ms_matchbuffer(tmp_arg2); + + mb->offset -= 32; + goto badarg; + } + Next(1); + } + + /* + * Matching of binaries. + */ + + { + Eterm header; + Eterm* next; + Uint slots; + + OpCase(i_bs_start_match2_rfIId): { + tmp_arg1 = r(0); + + do_start_match: + slots = Arg(2); + if (!is_boxed(tmp_arg1)) { + ClauseFail(); + } + PreFetch(4, next); + header = *boxed_val(tmp_arg1); + if (header_is_bin_matchstate(header)) { + ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(tmp_arg1); + Uint actual_slots = HEADER_NUM_SLOTS(header); + ms->save_offset[0] = ms->mb.offset; + if (actual_slots < slots) { + ErlBinMatchState* dst; + Uint live = Arg(1); + Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); + + TestHeapPreserve(wordsneeded, live, tmp_arg1); + ms = (ErlBinMatchState *) boxed_val(tmp_arg1); + dst = (ErlBinMatchState *) HTOP; + *dst = *ms; + *HTOP = HEADER_BIN_MATCHSTATE(slots); + HTOP += wordsneeded; + StoreResult(make_matchstate(dst), Arg(3)); + } + } else if (is_binary_header(header)) { + Eterm result; + Uint live = Arg(1); + Uint wordsneeded = ERL_BIN_MATCHSTATE_SIZE(slots); + TestHeapPreserve(wordsneeded, live, tmp_arg1); + HEAP_TOP(c_p) = HTOP; +#ifdef DEBUG + c_p->stop = E; /* Needed for checking in HeapOnlyAlloc(). */ +#endif + result = erts_bs_start_match_2(c_p, tmp_arg1, slots); + HTOP = HEAP_TOP(c_p); + if (is_non_value(result)) { + ClauseFail(); + } else { + StoreResult(result, Arg(3)); + } + } else { + ClauseFail(); + } + NextPF(4, next); + } + OpCase(i_bs_start_match2_xfIId): { + tmp_arg1 = xb(Arg(0)); + I++; + goto do_start_match; + } + OpCase(i_bs_start_match2_yfIId): { + tmp_arg1 = yb(Arg(0)); + I++; + goto do_start_match; + } + } + + OpCase(bs_test_zero_tail2_fr): { + Eterm* next; + ErlBinMatchBuffer *_mb; + + PreFetch(1, next); + _mb = (ErlBinMatchBuffer*) ms_matchbuffer(r(0)); + if (_mb->size != _mb->offset) { + ClauseFail(); + } + NextPF(1, next); + } + + OpCase(bs_test_zero_tail2_fx): { + Eterm* next; + ErlBinMatchBuffer *_mb; + + PreFetch(2, next); + _mb = (ErlBinMatchBuffer*) ms_matchbuffer(xb(Arg(1))); + if (_mb->size != _mb->offset) { + ClauseFail(); + } + NextPF(2, next); + } + + OpCase(bs_test_tail_imm2_frI): { + Eterm* next; + ErlBinMatchBuffer *_mb; + PreFetch(2, next); + _mb = ms_matchbuffer(r(0)); + if (_mb->size - _mb->offset != Arg(1)) { + ClauseFail(); + } + NextPF(2, next); + } + OpCase(bs_test_tail_imm2_fxI): { + Eterm* next; + ErlBinMatchBuffer *_mb; + PreFetch(3, next); + _mb = ms_matchbuffer(xb(Arg(1))); + if (_mb->size - _mb->offset != Arg(2)) { + ClauseFail(); + } + NextPF(3, next); + } + + OpCase(bs_test_unit_frI): { + Eterm* next; + ErlBinMatchBuffer *_mb; + PreFetch(2, next); + _mb = ms_matchbuffer(r(0)); + if ((_mb->size - _mb->offset) % Arg(1)) { + ClauseFail(); + } + NextPF(2, next); + } + OpCase(bs_test_unit_fxI): { + Eterm* next; + ErlBinMatchBuffer *_mb; + PreFetch(3, next); + _mb = ms_matchbuffer(xb(Arg(1))); + if ((_mb->size - _mb->offset) % Arg(2)) { + ClauseFail(); + } + NextPF(3, next); + } + + OpCase(bs_test_unit8_fr): { + Eterm* next; + ErlBinMatchBuffer *_mb; + PreFetch(1, next); + _mb = ms_matchbuffer(r(0)); + if ((_mb->size - _mb->offset) & 7) { + ClauseFail(); + } + NextPF(1, next); + } + OpCase(bs_test_unit8_fx): { + Eterm* next; + ErlBinMatchBuffer *_mb; + PreFetch(2, next); + _mb = ms_matchbuffer(xb(Arg(1))); + if ((_mb->size - _mb->offset) & 7) { + ClauseFail(); + } + NextPF(2, next); + } + + OpCase(i_bs_get_integer_8_rfd): { + tmp_arg1 = r(0); + goto do_bs_get_integer_8; + } + + OpCase(i_bs_get_integer_8_xfd): { + tmp_arg1 = xb(Arg(0)); + I++; + } + + do_bs_get_integer_8: { + ErlBinMatchBuffer *_mb; + Eterm _result; + _mb = ms_matchbuffer(tmp_arg1); + if (_mb->size - _mb->offset < 8) { + ClauseFail(); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _result = erts_bs_get_integer_2(c_p, 8, 0, _mb); + } else { + _result = make_small(_mb->base[BYTE_OFFSET(_mb->offset)]); + _mb->offset += 8; + } + StoreBifResult(1, _result); + } + + OpCase(i_bs_get_integer_16_rfd): { + tmp_arg1 = r(0); + goto do_bs_get_integer_16; + } + + OpCase(i_bs_get_integer_16_xfd): { + tmp_arg1 = xb(Arg(0)); + I++; + } + + do_bs_get_integer_16: { + ErlBinMatchBuffer *_mb; + Eterm _result; + _mb = ms_matchbuffer(tmp_arg1); + if (_mb->size - _mb->offset < 16) { + ClauseFail(); + } + if (BIT_OFFSET(_mb->offset) != 0) { + _result = erts_bs_get_integer_2(c_p, 16, 0, _mb); + } else { + _result = make_small(get_int16(_mb->base+BYTE_OFFSET(_mb->offset))); + _mb->offset += 16; + } + StoreBifResult(1, _result); + } + + OpCase(i_bs_get_integer_32_rfId): { + tmp_arg1 = r(0); + goto do_bs_get_integer_32; + } + + OpCase(i_bs_get_integer_32_xfId): { + tmp_arg1 = xb(Arg(0)); + I++; + } + + do_bs_get_integer_32: { + ErlBinMatchBuffer *_mb; + Uint32 _integer; + Eterm _result; + _mb = ms_matchbuffer(tmp_arg1); + if (_mb->size - _mb->offset < 32) { ClauseFail(); } + if (BIT_OFFSET(_mb->offset) != 0) { + _integer = erts_bs_get_unaligned_uint32(_mb); + } else { + _integer = get_int32(_mb->base + _mb->offset/8); + } + _mb->offset += 32; +#ifndef ARCH_64 + if (IS_USMALL(0, _integer)) { +#endif + _result = make_small(_integer); +#ifndef ARCH_64 + } else { + TestHeap(BIG_UINT_HEAP_SIZE, Arg(1)); + _result = uint_to_big((Uint) _integer, HTOP); + HTOP += BIG_UINT_HEAP_SIZE; + } +#endif + StoreBifResult(2, _result); + } + + /* Operands: Size Live Fail Flags Dst */ + OpCase(i_bs_get_integer_imm_rIIfId): { + tmp_arg1 = r(0); + /* Operands: Size Live Fail Flags Dst */ + goto do_bs_get_integer_imm_test_heap; + } + + /* Operands: x(Reg) Size Live Fail Flags Dst */ + OpCase(i_bs_get_integer_imm_xIIfId): { + tmp_arg1 = xb(Arg(0)); + I++; + /* Operands: Size Live Fail Flags Dst */ + goto do_bs_get_integer_imm_test_heap; + } + + /* + * tmp_arg1 = match context + * Operands: Size Live Fail Flags Dst + */ + do_bs_get_integer_imm_test_heap: { + Uint wordsneeded; + tmp_arg2 = Arg(0); + wordsneeded = 1+WSIZE(NBYTES(tmp_arg2)); + TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1); + I += 2; + /* Operands: Fail Flags Dst */ + goto do_bs_get_integer_imm; + } + + /* Operands: Size Fail Flags Dst */ + OpCase(i_bs_get_integer_small_imm_rIfId): { + tmp_arg1 = r(0); + tmp_arg2 = Arg(0); + I++; + /* Operands: Fail Flags Dst */ + goto do_bs_get_integer_imm; + } + + /* Operands: x(Reg) Size Fail Flags Dst */ + OpCase(i_bs_get_integer_small_imm_xIfId): { + tmp_arg1 = xb(Arg(0)); + tmp_arg2 = Arg(1); + I += 2; + /* Operands: Fail Flags Dst */ + goto do_bs_get_integer_imm; + } + + /* + * tmp_arg1 = match context + * tmp_arg2 = size of field + * Operands: Fail Flags Dst + */ + do_bs_get_integer_imm: { + ErlBinMatchBuffer* mb; + Eterm result; + + mb = ms_matchbuffer(tmp_arg1); + LIGHT_SWAPOUT; + result = erts_bs_get_integer_2(c_p, tmp_arg2, Arg(1), mb); + LIGHT_SWAPIN; + if (is_non_value(result)) { + ClauseFail(); + } + StoreBifResult(2, result); + } + + /* + * tmp_arg1 = Match context + * tmp_arg2 = Size field + * Operands: Fail Live FlagsAndUnit Dst + */ + OpCase(i_bs_get_integer_fIId): { + Uint flags; + Uint size; + ErlBinMatchBuffer* mb; + Eterm result; + + flags = Arg(2); + BsGetFieldSize(tmp_arg2, (flags >> 3), ClauseFail(), size); + if (size >= SMALL_BITS) { + Uint wordsneeded = 1+WSIZE(NBYTES((Uint) size)); + TestHeapPreserve(wordsneeded, Arg(1), tmp_arg1); + } + mb = ms_matchbuffer(tmp_arg1); + LIGHT_SWAPOUT; + result = erts_bs_get_integer_2(c_p, size, flags, mb); + LIGHT_SWAPIN; + if (is_non_value(result)) { + ClauseFail(); + } + StoreBifResult(3, result); + } + + /* Operands: MatchContext Fail Dst */ + OpCase(i_bs_get_utf8_rfd): { + tmp_arg1 = r(0); + goto do_bs_get_utf8; + } + + OpCase(i_bs_get_utf8_xfd): { + tmp_arg1 = xb(Arg(0)); + I++; + } + + /* + * tmp_arg1 = match_context + * Operands: Fail Dst + */ + + do_bs_get_utf8: { + Eterm result = erts_bs_get_utf8(ms_matchbuffer(tmp_arg1)); + if (is_non_value(result)) { + ClauseFail(); + } + StoreBifResult(1, result); + } + + /* Operands: MatchContext Fail Flags Dst */ + OpCase(i_bs_get_utf16_rfId): { + tmp_arg1 = r(0); + goto do_bs_get_utf16; + } + + OpCase(i_bs_get_utf16_xfId): { + tmp_arg1 = xb(Arg(0)); + I++; + } + + /* + * tmp_arg1 = match_context + * Operands: Fail Flags Dst + */ + do_bs_get_utf16: { + Eterm result = erts_bs_get_utf16(ms_matchbuffer(tmp_arg1), Arg(1)); + if (is_non_value(result)) { + ClauseFail(); + } + StoreBifResult(2, result); + } + + { + ErlBinMatchBuffer* mb; + ErlSubBin* sb; + Uint size; + Uint offs; + Uint orig; + Uint hole_size; + + OpCase(bs_context_to_binary_r): { + tmp_arg1 = x0; + I -= 2; + goto do_context_to_binary; + } + + /* Unfortunately, inlining can generate this instruction. */ + OpCase(bs_context_to_binary_y): { + tmp_arg1 = yb(Arg(0)); + goto do_context_to_binary0; + } + + OpCase(bs_context_to_binary_x): { + tmp_arg1 = xb(Arg(0)); + + do_context_to_binary0: + I--; + } + + do_context_to_binary: + if (is_boxed(tmp_arg1) && header_is_bin_matchstate(*boxed_val(tmp_arg1))) { + ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(tmp_arg1); + mb = &ms->mb; + offs = ms->save_offset[0]; + size = mb->size - offs; + goto do_bs_get_binary_all_reuse_common; + } + Next(2); + + OpCase(i_bs_get_binary_all_reuse_rfI): { + tmp_arg1 = x0; + goto do_bs_get_binary_all_reuse; + } + + OpCase(i_bs_get_binary_all_reuse_xfI): { + tmp_arg1 = xb(Arg(0)); + I++; + } + + do_bs_get_binary_all_reuse: + mb = ms_matchbuffer(tmp_arg1); + size = mb->size - mb->offset; + if (size % Arg(1) != 0) { + ClauseFail(); + } + offs = mb->offset; + + do_bs_get_binary_all_reuse_common: + orig = mb->orig; + sb = (ErlSubBin *) boxed_val(tmp_arg1); + hole_size = 1 + header_arity(sb->thing_word) - ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = BYTE_OFFSET(size); + sb->bitsize = BIT_OFFSET(size); + sb->offs = BYTE_OFFSET(offs); + sb->bitoffs = BIT_OFFSET(offs); + sb->is_writable = 0; + sb->orig = orig; + if (hole_size) { + sb[1].thing_word = make_pos_bignum_header(hole_size-1); + } + Next(2); + } + + { + OpCase(i_bs_match_string_rfII): { + tmp_arg1 = r(0); + goto do_bs_match_string; + } + OpCase(i_bs_match_string_xfII): { + tmp_arg1 = xb(Arg(0)); + I++; + } + + do_bs_match_string: + { + Eterm* next; + byte* bytes; + Uint bits; + ErlBinMatchBuffer* mb; + Uint offs; + + PreFetch(3, next); + bits = Arg(1); + bytes = (byte *) Arg(2); + mb = ms_matchbuffer(tmp_arg1); + if (mb->size - mb->offset < bits) { + ClauseFail(); + } + offs = mb->offset & 7; + if (offs == 0 && (bits & 7) == 0) { + if (sys_memcmp(bytes, mb->base+(mb->offset>>3), bits>>3)) { + ClauseFail(); + } + } else if (erts_cmp_bits(bytes, 0, mb->base+(mb->offset>>3), mb->offset & 7, bits)) { + ClauseFail(); + } + mb->offset += bits; + NextPF(3, next); + } + } + + OpCase(i_bs_save2_rI): { + Eterm* next; + ErlBinMatchState *_ms; + PreFetch(1, next); + _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0)); + _ms->save_offset[Arg(0)] = _ms->mb.offset; + NextPF(1, next); + } + OpCase(i_bs_save2_xI): { + Eterm* next; + ErlBinMatchState *_ms; + PreFetch(2, next); + _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0))); + _ms->save_offset[Arg(1)] = _ms->mb.offset; + NextPF(2, next); + } + + OpCase(i_bs_restore2_rI): { + Eterm* next; + ErlBinMatchState *_ms; + PreFetch(1, next); + _ms = (ErlBinMatchState*) boxed_val((Eterm) r(0)); + _ms->mb.offset = _ms->save_offset[Arg(0)]; + NextPF(1, next); + } + OpCase(i_bs_restore2_xI): { + Eterm* next; + ErlBinMatchState *_ms; + PreFetch(2, next); + _ms = (ErlBinMatchState*) boxed_val((Eterm) xb(Arg(0))); + _ms->mb.offset = _ms->save_offset[Arg(1)]; + NextPF(2, next); + } + +#include "beam_cold.h" + + + /* + * This instruction is probably never used (because it is combined with a + * a return). However, a future compiler might for some reason emit a + * deallocate not followed by a return, and that should work. + */ + OpCase(deallocate_I): { + Eterm* next; + + PreFetch(1, next); + D(Arg(0)); + NextPF(1, next); + } + + /* + * Trace and debugging support. + */ + + /* + * At this point, I points to the code[3] in the export entry for + * a trace-enabled function. + * + * code[0]: Module + * code[1]: Function + * code[2]: Arity + * code[3]: &&call_traced_function + * code[4]: Address of function. + */ + OpCase(call_traced_function): { + if (IS_TRACED_FL(c_p, F_TRACE_CALLS)) { + unsigned offset = offsetof(Export, code) + 3*sizeof(Eterm); + Export* ep = (Export *) (((char *)I)-offset); + Uint32 flags; + + SWAPOUT; + reg[0] = r(0); + PROCESS_MAIN_CHK_LOCKS(c_p); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + flags = erts_call_trace(c_p, ep->code, ep->match_prog_set, reg, + 0, &c_p->tracer_proc); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + SWAPIN; + + if (flags & MATCH_SET_RX_TRACE) { + ASSERT(c_p->htop <= E && E <= c_p->hend); + if (E - 3 < HTOP) { + /* SWAPOUT, SWAPIN was done and r(0) was saved above */ + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect(c_p, 3, reg, ep->code[2]); + PROCESS_MAIN_CHK_LOCKS(c_p); + r(0) = reg[0]; + SWAPIN; + } + E -= 3; + ASSERT(c_p->htop <= E && E <= c_p->hend); + ASSERT(is_CP((Eterm)(ep->code))); + ASSERT(is_internal_pid(c_p->tracer_proc) || + is_internal_port(c_p->tracer_proc)); + E[2] = make_cp(c_p->cp); + E[1] = am_true; /* Process tracer */ + E[0] = make_cp(ep->code); + c_p->cp = (Eterm*) + make_cp(flags & MATCH_SET_EXCEPTION_TRACE + ? beam_exception_trace : beam_return_trace); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + c_p->trace_flags |= F_EXCEPTION_TRACE; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + } + SET_I((Uint *) Arg(0)); + Dispatch(); + } + + OpCase(return_trace): { + Uint* code = (Uint *) E[0]; + + SWAPOUT; /* Needed for shared heap */ + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + erts_trace_return(c_p, code, r(0), E+1/*Process tracer*/); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + SWAPIN; + c_p->cp = NULL; + SET_I((Eterm *) E[2]); + E += 3; + Goto(*I); + } + + OpCase(i_count_breakpoint): { + Uint real_I; + + ErtsCountBreak((Uint *) I, &real_I); + ASSERT(VALID_INSTR(real_I)); + Goto(real_I); + } + + OpCase(i_trace_breakpoint): + if (! IS_TRACED_FL(c_p, F_TRACE_CALLS)) { + Uint real_I; + + ErtsBreakSkip((Uint *) I, &real_I); + Goto(real_I); + } + /* Fall through to next case */ + OpCase(i_mtrace_breakpoint): { + Uint real_I; + Uint32 flags; + Eterm tracer_pid; + Uint *cpp; + int return_to_trace = 0, need = 0; + flags = 0; + SWAPOUT; + reg[0] = r(0); + + if (*cp_val((Eterm)c_p->cp) + == (Uint) OpCode(return_trace)) { + cpp = (Uint*)&E[2]; + } else if (*cp_val((Eterm)c_p->cp) + == (Uint) OpCode(i_return_to_trace)) { + return_to_trace = !0; + cpp = (Uint*)&E[0]; + } else { + cpp = NULL; + } + if (cpp) { + /* This _IS_ a tail recursive call, if there are + * return_trace and/or i_return_to_trace stackframes + * on the stack, they are not intermixed with y registers + */ + Eterm *cp_save = c_p->cp; + for (;;) { + ASSERT(is_CP(*cpp)); + if (*cp_val(*cpp) == (Uint) OpCode(return_trace)) { + cpp += 3; + } else if (*cp_val(*cpp) == (Uint) OpCode(i_return_to_trace)) { + return_to_trace = !0; + cpp += 1; + } else + break; + } + c_p->cp = (Eterm *) *cpp; + ASSERT(is_CP((Eterm)c_p->cp)); + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + real_I = erts_trace_break(c_p, I, reg, &flags, &tracer_pid); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + SWAPIN; /* Needed by shared heap. */ + c_p->cp = cp_save; + } else { + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + real_I = erts_trace_break(c_p, I, reg, &flags, &tracer_pid); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + SWAPIN; /* Needed by shared heap. */ + } + + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + + if ((flags & MATCH_SET_RETURN_TO_TRACE) && !return_to_trace) { + need += 1; + } + if (flags & MATCH_SET_RX_TRACE) { + need += 3; + } + if (need) { + ASSERT(c_p->htop <= E && E <= c_p->hend); + if (E - need < HTOP) { + /* SWAPOUT was done and r(0) was saved above */ + PROCESS_MAIN_CHK_LOCKS(c_p); + FCALLS -= erts_garbage_collect(c_p, need, reg, I[-1]); + PROCESS_MAIN_CHK_LOCKS(c_p); + r(0) = reg[0]; + SWAPIN; + } + } + if ((flags & MATCH_SET_RETURN_TO_TRACE) && !return_to_trace) { + E -= 1; + ASSERT(c_p->htop <= E && E <= c_p->hend); + E[0] = make_cp(c_p->cp); + c_p->cp = (Eterm *) make_cp(beam_return_to_trace); + } + if (flags & MATCH_SET_RX_TRACE) { + E -= 3; + ASSERT(c_p->htop <= E && E <= c_p->hend); + ASSERT(is_CP((Eterm) (I - 3))); + ASSERT(am_true == tracer_pid || + is_internal_pid(tracer_pid) || is_internal_port(tracer_pid)); + E[2] = make_cp(c_p->cp); + E[1] = tracer_pid; + E[0] = make_cp(I - 3); /* We ARE at the beginning of an + instruction, + the funcinfo is above i. */ + c_p->cp = (Eterm*) + make_cp(flags & MATCH_SET_EXCEPTION_TRACE + ? beam_exception_trace : beam_return_trace); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + c_p->trace_flags |= F_EXCEPTION_TRACE; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + Goto(real_I); + } + + OpCase(i_return_to_trace): { + if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO)) { + Uint *cpp = (Uint*) E; + for(;;) { + ASSERT(is_CP(*cpp)); + if (*cp_val(*cpp) == (Uint) OpCode(return_trace)) { + do ++cpp; while(is_not_CP(*cpp)); + cpp += 2; + } else if (*cp_val(*cpp) == (Uint) OpCode(i_return_to_trace)) { + do ++cpp; while(is_not_CP(*cpp)); + } else break; + } + SWAPOUT; /* Needed for shared heap */ + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + erts_trace_return_to(c_p, cp_val(*cpp)); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + SWAPIN; + } + c_p->cp = NULL; + SET_I((Eterm *) E[0]); + E += 1; + Goto(*I); + } + + /* + * Instructions for allocating on the message area. + */ + + OpCase(i_global_cons): + { + Eterm *next; +#ifdef HYBRID + Eterm *hp; + + PreFetch(0,next); + TestGlobalHeap(2,2,hp); + hp[0] = r(0); + hp[1] = x(1); + r(0) = make_list(hp); +#ifndef INCREMENTAL + global_htop += 2; +#endif + NextPF(0,next); +#else + PreFetch(0,next); + c_p->freason = EXC_INTERNAL_ERROR; + goto find_func_info; +#endif + } + + OpCase(i_global_tuple): + { + Eterm *next; + int len; +#ifdef HYBRID + Eterm list; + Eterm *hp; +#endif + + if ((len = list_length(r(0))) < 0) { + goto badarg; + } + + PreFetch(0,next); +#ifdef HYBRID + TestGlobalHeap(len + 1,1,hp); + list = r(0); + r(0) = make_tuple(hp); + *hp++ = make_arityval(len); + while(is_list(list)) + { + Eterm* cons = list_val(list); + *hp++ = CAR(cons); + list = CDR(cons); + } +#ifndef INCREMENTAL + global_htop += len + 1; +#endif + NextPF(0,next); +#else + c_p->freason = EXC_INTERNAL_ERROR; + goto find_func_info; +#endif + } + + OpCase(i_global_copy): + { + Eterm *next; + PreFetch(0,next); +#ifdef HYBRID + if (!IS_CONST(r(0))) + { + BM_SWAP_TIMER(system,copy); + SWAPOUT; + reg[0] = r(0); + reg[1] = NIL; + r(0) = copy_struct_lazy(c_p,r(0),0); + ASSERT(ma_src_top == 0); + ASSERT(ma_dst_top == 0); + ASSERT(ma_offset_top == 0); + SWAPIN; + BM_SWAP_TIMER(copy,system); + } + NextPF(0,next); +#else + c_p->freason = EXC_INTERNAL_ERROR; + goto find_func_info; +#endif + } + + /* + * New floating point instructions. + */ + + OpCase(fmove_ql): { + Eterm fr = Arg(1); + Eterm* next; + + PreFetch(2, next); + GET_DOUBLE(Arg(0), *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); + NextPF(2, next); + } + + OpCase(fmove_dl): { + Eterm targ1; + Eterm fr = Arg(1); + Eterm* next; + + PreFetch(2, next); + GetR(0, targ1); + /* Arg(0) == HEADER_FLONUM */ + GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); + NextPF(2, next); + } + + OpCase(fmove_new_ld): { + Eterm fr = Arg(0); + Eterm dest = make_float(HTOP); + + PUT_DOUBLE(*(FloatDef*)ADD_BYTE_OFFSET(freg, fr), HTOP); + HTOP += FLOAT_SIZE_OBJECT; + StoreBifResult(1, dest); + } + + OpCase(fconv_dl): { + Eterm targ1; + Eterm fr = Arg(1); + Eterm* next; + + GetR(0, targ1); + PreFetch(2, next); + if (is_small(targ1)) { + fb(fr) = (double) signed_val(targ1); + } else if (is_big(targ1)) { + if (big_to_double(targ1, &fb(fr)) < 0) { + goto fbadarith; + } + } else if (is_float(targ1)) { + GET_DOUBLE(targ1, *(FloatDef*)ADD_BYTE_OFFSET(freg, fr)); + } else { + goto fbadarith; + } + NextPF(2, next); + } + + /* + * Old allocating fmove. + */ + + +#ifdef NO_FPE_SIGNALS + OpCase(fclearerror): + OpCase(i_fcheckerror): + erl_exit(1, "fclearerror/i_fcheckerror without fpe signals (beam_emu)"); +#else + OpCase(fclearerror): { + Eterm* next; + + PreFetch(0, next); + ERTS_FP_CHECK_INIT(c_p); + NextPF(0, next); + } + + OpCase(i_fcheckerror): { + Eterm* next; + + PreFetch(0, next); + ERTS_FP_ERROR(c_p, freg[0].fd, goto fbadarith); + NextPF(0, next); + } +# undef ERTS_FP_CHECK_INIT +# undef ERTS_FP_ERROR +# define ERTS_FP_CHECK_INIT(p) +# define ERTS_FP_ERROR(p, a, b) +#endif + + + OpCase(i_fadd_lll): { + Eterm* next; + + PreFetch(3, next); + ERTS_FP_CHECK_INIT(c_p); + fb(Arg(2)) = fb(Arg(0)) + fb(Arg(1)); + ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith); + NextPF(3, next); + } + OpCase(i_fsub_lll): { + Eterm* next; + + PreFetch(3, next); + ERTS_FP_CHECK_INIT(c_p); + fb(Arg(2)) = fb(Arg(0)) - fb(Arg(1)); + ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith); + NextPF(3, next); + } + OpCase(i_fmul_lll): { + Eterm* next; + + PreFetch(3, next); + ERTS_FP_CHECK_INIT(c_p); + fb(Arg(2)) = fb(Arg(0)) * fb(Arg(1)); + ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith); + NextPF(3, next); + } + OpCase(i_fdiv_lll): { + Eterm* next; + + PreFetch(3, next); + ERTS_FP_CHECK_INIT(c_p); + fb(Arg(2)) = fb(Arg(0)) / fb(Arg(1)); + ERTS_FP_ERROR(c_p, fb(Arg(2)), goto fbadarith); + NextPF(3, next); + } + OpCase(i_fnegate_ll): { + Eterm* next; + + PreFetch(2, next); + ERTS_FP_CHECK_INIT(c_p); + fb(Arg(1)) = -fb(Arg(0)); + ERTS_FP_ERROR(c_p, fb(Arg(1)), goto fbadarith); + NextPF(2, next); + + fbadarith: + c_p->freason = BADARITH; + goto find_func_info; + } + +#ifdef HIPE + { + unsigned cmd; + + OpCase(hipe_trap_call): { + /* + * I[-5]: &&lb_i_func_info_IaaI + * I[-4]: Native code callee (inserted by HiPE) + * I[-3]: Module (tagged atom) + * I[-2]: Function (tagged atom) + * I[-1]: Arity (untagged integer) + * I[ 0]: &&lb_hipe_trap_call + * ... remainder of original BEAM code + */ + ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); + c_p->hipe.ncallee = (void(*)(void)) I[-4]; + cmd = HIPE_MODE_SWITCH_CMD_CALL | (I[-1] << 8); + ++hipe_trap_count; + goto L_hipe_mode_switch; + } + OpCase(hipe_trap_call_closure): { + ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); + c_p->hipe.ncallee = (void(*)(void)) I[-4]; + cmd = HIPE_MODE_SWITCH_CMD_CALL_CLOSURE | (I[-1] << 8); + ++hipe_trap_count; + goto L_hipe_mode_switch; + } + OpCase(hipe_trap_return): { + cmd = HIPE_MODE_SWITCH_CMD_RETURN; + goto L_hipe_mode_switch; + } + OpCase(hipe_trap_throw): { + cmd = HIPE_MODE_SWITCH_CMD_THROW; + goto L_hipe_mode_switch; + } + OpCase(hipe_trap_resume): { + cmd = HIPE_MODE_SWITCH_CMD_RESUME; + goto L_hipe_mode_switch; + } + L_hipe_mode_switch: + /* XXX: this abuse of def_arg_reg[] is horrid! */ + SWAPOUT; + c_p->fcalls = FCALLS; + c_p->def_arg_reg[4] = -neg_o_reds; + reg[0] = r(0); + c_p = hipe_mode_switch(c_p, cmd, reg); +#ifdef ERTS_SMP + reg = c_p->scheduler_data->save_reg; + freg = c_p->scheduler_data->freg; +#endif + ERL_BITS_RELOAD_STATEP(c_p); + neg_o_reds = -c_p->def_arg_reg[4]; + FCALLS = c_p->fcalls; + SWAPIN; + switch( c_p->def_arg_reg[3] ) { + case HIPE_MODE_SWITCH_RES_RETURN: + ASSERT(is_value(reg[0])); + MoveReturn(reg[0], r(0)); + case HIPE_MODE_SWITCH_RES_CALL: + SET_I(c_p->i); + r(0) = reg[0]; + Dispatch(); + case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: + /* This can be used to call any function value, but currently it's + only used to call closures referring to unloaded modules. */ + { + Eterm *next; + + next = call_fun(c_p, c_p->arity - 1, reg, THE_NON_VALUE); + SWAPIN; + if (next != NULL) { + r(0) = reg[0]; + SET_I(next); + Dispatchfun(); + } + goto find_func_info; + } + case HIPE_MODE_SWITCH_RES_THROW: + c_p->cp = NULL; + I = handle_error(c_p, I, reg, NULL); + goto post_error_handling; + default: + erl_exit(1, "hipe_mode_switch: result %u\n", c_p->def_arg_reg[3]); + } + } + OpCase(hipe_call_count): { + /* + * I[-5]: &&lb_i_func_info_IaaI + * I[-4]: pointer to struct hipe_call_count (inserted by HiPE) + * I[-3]: Module (tagged atom) + * I[-2]: Function (tagged atom) + * I[-1]: Arity (untagged integer) + * I[ 0]: &&lb_hipe_call_count + * ... remainder of original BEAM code + */ + struct hipe_call_count *hcc = (struct hipe_call_count*)I[-4]; + ASSERT(I[-5] == (Uint) OpCode(i_func_info_IaaI)); + ASSERT(hcc != NULL); + ASSERT(VALID_INSTR(hcc->opcode)); + ++(hcc->count); + Goto(hcc->opcode); + } +#endif /* HIPE */ + + OpCase(i_yield): + { + /* This is safe as long as REDS_IN(c_p) is never stored + * in c_p->arg_reg[0]. It is currently stored in c_p->def_arg_reg[5], + * which may be c_p->arg_reg[5], which is close, but no banana. + */ + c_p->arg_reg[0] = am_true; + c_p->arity = 1; /* One living register (the 'true' return value) */ + SWAPOUT; + c_p->i = I + 1; /* Next instruction */ + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS); + erts_add_to_runq(c_p); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); + c_p->current = NULL; + goto do_schedule; + } + + OpCase(i_hibernate): { + SWAPOUT; + if (hibernate(c_p, r(0), x(1), x(2), reg)) { + goto do_schedule; + } else { + I = handle_error(c_p, I, reg, hibernate_3); + goto post_error_handling; + } + } + + OpCase(i_debug_breakpoint): { + SWAPOUT; + reg[0] = r(0); + tmp_arg1 = call_breakpoint_handler(c_p, I-3, reg); + r(0) = reg[0]; + SWAPIN; + if (tmp_arg1) { + SET_I(c_p->i); + Dispatch(); + } + goto no_error_handler; + } + + + OpCase(system_limit_j): + system_limit: + c_p->freason = SYSTEM_LIMIT; + goto lb_Cl_error; + + +#ifdef ERTS_OPCODE_COUNTER_SUPPORT + DEFINE_COUNTING_LABELS; +#endif + +#ifndef NO_JUMP_TABLE +#ifdef DEBUG + end_emulator_loop: +#endif +#endif + + OpCase(int_code_end): + OpCase(label_L): + OpCase(too_old_compiler): + OpCase(on_load): + erl_exit(1, "meta op\n"); + + /* + * One-time initialization of Beam emulator. + */ + + init_emulator: + { + int i; + Export* ep; + +#ifndef NO_JUMP_TABLE +#ifdef ERTS_OPCODE_COUNTER_SUPPORT + + /* Are tables correctly generated by beam_makeops? */ + ASSERT(sizeof(counting_opcodes) == sizeof(opcodes)); + + if (count_instructions) { +#ifdef DEBUG + counting_opcodes[op_catch_end_y] = LabelAddr(lb_catch_end_y); +#endif + counting_opcodes[op_i_func_info_IaaI] = LabelAddr(lb_i_func_info_IaaI); + beam_ops = counting_opcodes; + } + else +#endif /* #ifndef ERTS_OPCODE_COUNTER_SUPPORT */ + { + beam_ops = opcodes; + } +#endif /* NO_JUMP_TABLE */ + + em_call_error_handler = OpCode(call_error_handler); + em_call_traced_function = OpCode(call_traced_function); + em_apply_bif = OpCode(apply_bif); + beam_apply[0] = (Eterm) OpCode(i_apply); + beam_apply[1] = (Eterm) OpCode(normal_exit); + beam_exit[0] = (Eterm) OpCode(error_action_code); + beam_continue_exit[0] = (Eterm) OpCode(continue_exit); + beam_return_to_trace[0] = (Eterm) OpCode(i_return_to_trace); + beam_return_trace[0] = (Eterm) OpCode(return_trace); + beam_exception_trace[0] = (Eterm) OpCode(return_trace); /* UGLY */ + + /* + * Enter all BIFs into the export table. + */ + for (i = 0; i < BIF_SIZE; i++) { + ep = erts_export_put(bif_table[i].module, + bif_table[i].name, + bif_table[i].arity); + bif_export[i] = ep; + ep->code[3] = (Eterm) OpCode(apply_bif); + ep->code[4] = (Eterm) bif_table[i].f; + } + + return; + } +#ifdef NO_JUMP_TABLE + default: + erl_exit(1, "unexpected op code %d\n",Go); + } +#endif + return; /* Never executed */ + + save_calls1: + { + Eterm* dis_next; + + save_calls(c_p, (Export *) Arg(0)); + + SET_I(((Export *) Arg(0))->address); + + dis_next = (Eterm *) *I; + FCALLS--; + Goto(dis_next); + } +} + +static BifFunction +translate_gc_bif(void* gcf) +{ + if (gcf == erts_gc_length_1) { + return length_1; + } else if (gcf == erts_gc_size_1) { + return size_1; + } else if (gcf == erts_gc_bit_size_1) { + return bit_size_1; + } else if (gcf == erts_gc_byte_size_1) { + return byte_size_1; + } else if (gcf == erts_gc_abs_1) { + return abs_1; + } else if (gcf == erts_gc_float_1) { + return float_1; + } else if (gcf == erts_gc_round_1) { + return round_1; + } else if (gcf == erts_gc_trunc_1) { + return round_1; + } else { + erl_exit(1, "bad gc bif"); + } +} + +/* + * Mapping from the error code 'class tag' to atoms. + */ +Eterm exception_tag[NUMBER_EXC_TAGS] = { + am_error, /* 0 */ + am_exit, /* 1 */ + am_throw, /* 2 */ +}; + +/* + * Mapping from error code 'index' to atoms. + */ +Eterm error_atom[NUMBER_EXIT_CODES] = { + am_internal_error, /* 0 */ + am_normal, /* 1 */ + am_internal_error, /* 2 */ + am_badarg, /* 3 */ + am_badarith, /* 4 */ + am_badmatch, /* 5 */ + am_function_clause, /* 6 */ + am_case_clause, /* 7 */ + am_if_clause, /* 8 */ + am_undef, /* 9 */ + am_badfun, /* 10 */ + am_badarity, /* 11 */ + am_timeout_value, /* 12 */ + am_noproc, /* 13 */ + am_notalive, /* 14 */ + am_system_limit, /* 15 */ + am_try_clause, /* 16 */ + am_notsup /* 17 */ +}; + +/* + * To fully understand the error handling, one must keep in mind that + * when an exception is thrown, the search for a handler can jump back + * and forth between Beam and native code. Upon each mode switch, a + * dummy handler is inserted so that if an exception reaches that point, + * the handler is invoked (like any handler) and transfers control so + * that the search for a real handler is continued in the other mode. + * Therefore, c_p->freason and c_p->fvalue must still hold the exception + * info when the handler is executed, but normalized so that creation of + * error terms and saving of the stack trace is only done once, even if + * we pass through the error handling code several times. + * + * When a new exception is raised, the current stack trace information + * is quick-saved in a small structure allocated on the heap. Depending + * on how the exception is eventually caught (perhaps by causing the + * current process to terminate), the saved information may be used to + * create a symbolic (human-readable) representation of the stack trace + * at the point of the original exception. + */ + +static Eterm* +handle_error(Process* c_p, Eterm* pc, Eterm* reg, BifFunction bf) +{ + Eterm* hp; + Eterm Value = c_p->fvalue; + Eterm Args = am_true; + c_p->i = pc; /* In case we call erl_exit(). */ + + ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */ + + /* + * Check if we have an arglist for the top level call. If so, this + * is encoded in Value, so we have to dig out the real Value as well + * as the Arglist. + */ + if (c_p->freason & EXF_ARGLIST) { + Eterm* tp; + ASSERT(is_tuple(Value)); + tp = tuple_val(Value); + Value = tp[1]; + Args = tp[2]; + } + + /* + * Save the stack trace info if the EXF_SAVETRACE flag is set. The + * main reason for doing this separately is to allow throws to later + * become promoted to errors without losing the original stack + * trace, even if they have passed through one or more catch and + * rethrow. It also makes the creation of symbolic stack traces much + * more modular. + */ + if (c_p->freason & EXF_SAVETRACE) { + save_stacktrace(c_p, pc, reg, bf, Args); + } + + /* + * Throws that are not caught are turned into 'nocatch' errors + */ + if ((c_p->freason & EXF_THROWN) && (c_p->catches <= 0) ) { + hp = HAlloc(c_p, 3); + Value = TUPLE2(hp, am_nocatch, Value); + c_p->freason = EXC_ERROR; + } + + /* Get the fully expanded error term */ + Value = expand_error_value(c_p, c_p->freason, Value); + + /* Save final error term and stabilize the exception flags so no + further expansion is done. */ + c_p->fvalue = Value; + c_p->freason = PRIMARY_EXCEPTION(c_p->freason); + + /* Find a handler or die */ + if ((c_p->catches > 0 || IS_TRACED_FL(c_p, F_EXCEPTION_TRACE)) + && !(c_p->freason & EXF_PANIC)) { + Eterm *new_pc; + /* The Beam handler code (catch_end or try_end) checks reg[0] + for THE_NON_VALUE to see if the previous code finished + abnormally. If so, reg[1], reg[2] and reg[3] should hold the + exception class, term and trace, respectively. (If the + handler is just a trap to native code, these registers will + be ignored.) */ + reg[0] = THE_NON_VALUE; + reg[1] = exception_tag[GET_EXC_CLASS(c_p->freason)]; + reg[2] = Value; + reg[3] = c_p->ftrace; + if ((new_pc = next_catch(c_p, reg))) { + c_p->cp = 0; /* To avoid keeping stale references. */ + return new_pc; + } + if (c_p->catches > 0) erl_exit(1, "Catch not found"); + } + ERTS_SMP_UNREQ_PROC_MAIN_LOCK(c_p); + terminate_proc(c_p, Value); + ERTS_SMP_REQ_PROC_MAIN_LOCK(c_p); + return NULL; +} + +/* + * Find the nearest catch handler + */ +static Eterm* +next_catch(Process* c_p, Eterm *reg) { + int active_catches = c_p->catches > 0; + int have_return_to_trace = 0; + Eterm *ptr, *prev, *return_to_trace_ptr = NULL; + Uint i_return_trace = beam_return_trace[0]; + Uint i_return_to_trace = beam_return_to_trace[0]; + ptr = prev = c_p->stop; + ASSERT(is_CP(*ptr)); + ASSERT(ptr <= STACK_START(c_p)); + if (ptr == STACK_START(c_p)) return NULL; + if ((is_not_CP(*ptr) || (*cp_val(*ptr) != i_return_trace && + *cp_val(*ptr) != i_return_to_trace)) + && c_p->cp) { + /* Can not follow cp here - code may be unloaded */ + Uint *cpp = cp_val((Eterm) c_p->cp); + if (cpp == beam_exception_trace) { + erts_trace_exception(c_p, (Eterm*) ptr[0], + reg[1], reg[2], ptr+1); + /* Skip return_trace parameters */ + ptr += 2; + } else if (cpp == beam_return_trace) { + /* Skip return_trace parameters */ + ptr += 2; + } else if (cpp == beam_return_to_trace) { + have_return_to_trace = !0; /* Record next cp */ + } + } + while (ptr < STACK_START(c_p)) { + if (is_catch(*ptr)) { + if (active_catches) goto found_catch; + ptr++; + } + else if (is_CP(*ptr)) { + prev = ptr; + if (*cp_val(*prev) == i_return_trace) { + /* Skip stack frame variables */ + while (++ptr, ptr < STACK_START(c_p) && is_not_CP(*ptr)) { + if (is_catch(*ptr) && active_catches) goto found_catch; + } + if (cp_val(*prev) == beam_exception_trace) { + erts_trace_exception(c_p, (Eterm*) ptr[0], + reg[1], reg[2], ptr+1); + } + /* Skip return_trace parameters */ + ptr += 2; + } else if (*cp_val(*prev) == i_return_to_trace) { + /* Skip stack frame variables */ + while (++ptr, ptr < STACK_START(c_p) && is_not_CP(*ptr)) { + if (is_catch(*ptr) && active_catches) goto found_catch; + } + have_return_to_trace = !0; /* Record next cp */ + return_to_trace_ptr = NULL; + } else { + if (have_return_to_trace) { + /* Record this cp as possible return_to trace cp */ + have_return_to_trace = 0; + return_to_trace_ptr = ptr; + } else return_to_trace_ptr = NULL; + ptr++; + } + } else ptr++; + } + return NULL; + + found_catch: + ASSERT(ptr < STACK_START(c_p)); + c_p->stop = prev; + if (IS_TRACED_FL(c_p, F_TRACE_RETURN_TO) && return_to_trace_ptr) { + /* The stackframe closest to the catch contained an + * return_to_trace entry, so since the execution now + * continues after the catch, a return_to trace message + * would be appropriate. + */ + erts_trace_return_to(c_p, cp_val(*return_to_trace_ptr)); + } + return catch_pc(*ptr); +} + +/* + * Terminating the process when an exception is not caught + */ +static void +terminate_proc(Process* c_p, Eterm Value) +{ + /* Add a stacktrace if this is an error. */ + if (GET_EXC_CLASS(c_p->freason) == EXTAG_ERROR) { + Value = add_stacktrace(c_p, Value, c_p->ftrace); + } + /* EXF_LOG is a primary exception flag */ + if (c_p->freason & EXF_LOG) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Error in process %T ", c_p->id); + if (erts_is_alive) + erts_dsprintf(dsbufp, "on node %T ", erts_this_node->sysname); + erts_dsprintf(dsbufp,"with exit value: %0.*T\n", display_items, Value); + erts_send_error_to_logger(c_p->group_leader, dsbufp); + } + /* + * If we use a shared heap, the process will be garbage-collected. + * Must zero c_p->arity to indicate that there are no live registers. + */ + c_p->arity = 0; + erts_do_exit_process(c_p, Value); +} + +/* + * Build and add a symbolic stack trace to the error value. + */ +static Eterm +add_stacktrace(Process* c_p, Eterm Value, Eterm exc) { + Eterm Where = build_stacktrace(c_p, exc); + Eterm* hp = HAlloc(c_p, 3); + return TUPLE2(hp, Value, Where); +} + +/* + * Forming the correct error value from the internal error code. + * This does not update c_p->fvalue or c_p->freason. + */ +Eterm +expand_error_value(Process* c_p, Uint freason, Eterm Value) { + Eterm* hp; + Uint r; + + r = GET_EXC_INDEX(freason); + ASSERT(r < NUMBER_EXIT_CODES); /* range check */ + ASSERT(is_value(Value)); + + switch (r) { + case (GET_EXC_INDEX(EXC_PRIMARY)): + /* Primary exceptions use fvalue as it is */ + break; + case (GET_EXC_INDEX(EXC_BADMATCH)): + case (GET_EXC_INDEX(EXC_CASE_CLAUSE)): + case (GET_EXC_INDEX(EXC_TRY_CLAUSE)): + case (GET_EXC_INDEX(EXC_BADFUN)): + case (GET_EXC_INDEX(EXC_BADARITY)): + /* Some common exceptions: value -> {atom, value} */ + ASSERT(is_value(Value)); + hp = HAlloc(c_p, 3); + Value = TUPLE2(hp, error_atom[r], Value); + break; + default: + /* Other exceptions just use an atom as descriptor */ + Value = error_atom[r]; + break; + } +#ifdef DEBUG + ASSERT(Value != am_internal_error); +#endif + return Value; +} + +/* + * Quick-saving the stack trace in an internal form on the heap. Note + * that c_p->ftrace will point to a cons cell which holds the given args + * and the saved data (encoded as a bignum). + * + * (It would be much better to put the arglist - when it exists - in the + * error value instead of in the actual trace; e.g. '{badarg, Args}' + * instead of using 'badarg' with Args in the trace. The arglist may + * contain very large values, and right now they will be kept alive as + * long as the stack trace is live. Preferably, the stack trace should + * always be small, so that it does not matter if it is long-lived. + * However, it is probably not possible to ever change the format of + * error terms.) + */ + +static void +save_stacktrace(Process* c_p, Eterm* pc, Eterm* reg, BifFunction bf, + Eterm args) { + struct StackTrace* s; + int sz; + int depth = erts_backtrace_depth; /* max depth (never negative) */ + if (depth > 0) { + /* There will always be a current function */ + depth --; + } + + /* Create a container for the exception data */ + sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm)*depth + + sizeof(Eterm) - 1) / sizeof(Eterm); + s = (struct StackTrace *) HAlloc(c_p, 1 + sz); + /* The following fields are inside the bignum */ + s->header = make_pos_bignum_header(sz); + s->freason = c_p->freason; + s->depth = 0; + + /* + * If the failure was in a BIF other than 'error', 'exit' or + * 'throw', find the bif-table index and save the argument + * registers by consing up an arglist. + */ + if (bf != NULL && bf != error_1 && bf != error_2 && + bf != exit_1 && bf != throw_1) { + int i; + int a = 0; + for (i = 0; i < BIF_SIZE; i++) { + if (bf == bif_table[i].f || bf == bif_table[i].traced) { + Export *ep = bif_export[i]; + s->current = ep->code; + a = bif_table[i].arity; + break; + } + } + if (i >= BIF_SIZE) { + /* + * The Bif does not really exist (no BIF entry). It is a + * TRAP and traps are called through apply_bif, which also + * sets c_p->current (luckily). + */ + ASSERT(c_p->current); + s->current = c_p->current; + a = s->current[2]; + ASSERT(s->current[2] <= 3); + } + /* Save first stack entry */ + ASSERT(pc); + if (depth > 0) { + s->trace[s->depth++] = pc; + depth--; + } + /* Save second stack entry if CP is valid and different from pc */ + if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) { + s->trace[s->depth++] = c_p->cp; + depth--; + } + s->pc = NULL; + args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */ + } else { + s->current = c_p->current; + /* + * For a function_clause error, the arguments are in the beam + * registers, c_p->cp is valid, and c_p->current is set. + */ + if ( (GET_EXC_INDEX(s->freason)) == + (GET_EXC_INDEX(EXC_FUNCTION_CLAUSE)) ) { + int a; + ASSERT(s->current); + a = s->current[2]; + args = make_arglist(c_p, reg, a); /* Overwrite CAR(c_p->ftrace) */ + /* Save first stack entry */ + ASSERT(c_p->cp); + if (depth > 0) { + s->trace[s->depth++] = c_p->cp; + depth--; + } + s->pc = NULL; /* Ignore pc */ + } else { + if (depth > 0 && c_p->cp != 0 && c_p->cp != pc) { + s->trace[s->depth++] = c_p->cp; + depth--; + } + s->pc = pc; + } + } + + /* Package args and stack trace */ + { + Eterm *hp; + hp = HAlloc(c_p, 2); + c_p->ftrace = CONS(hp, args, make_big((Eterm *) s)); + } + + /* Save the actual stack trace */ + if (depth > 0) { + Eterm *ptr, *prev = s->depth ? s->trace[s->depth-1] : NULL; + Uint i_return_trace = beam_return_trace[0]; + Uint i_return_to_trace = beam_return_to_trace[0]; + /* + * Traverse the stack backwards and add all unique continuation + * pointers to the buffer, up to the maximum stack trace size. + * + * Skip trace stack frames. + */ + ptr = c_p->stop; + if (ptr < STACK_START(c_p) + && (is_not_CP(*ptr)|| (*cp_val(*ptr) != i_return_trace && + *cp_val(*ptr) != i_return_to_trace)) + && c_p->cp) { + /* Can not follow cp here - code may be unloaded */ + Uint *cpp = cp_val((Eterm) c_p->cp); + if (cpp == beam_exception_trace || cpp == beam_return_trace) { + /* Skip return_trace parameters */ + ptr += 2; + } else if (cpp == beam_return_to_trace) { + /* Skip return_to_trace parameters */ + ptr += 1; + } + } + while (ptr < STACK_START(c_p) && depth > 0) { + if (is_CP(*ptr)) { + if (*cp_val(*ptr) == i_return_trace) { + /* Skip stack frame variables */ + do ++ptr; while (is_not_CP(*ptr)); + /* Skip return_trace parameters */ + ptr += 2; + } else if (*cp_val(*ptr) == i_return_to_trace) { + /* Skip stack frame variables */ + do ++ptr; while (is_not_CP(*ptr)); + } else { + Eterm *cp = (Eterm *)(*ptr); + if (cp != prev) { + /* Record non-duplicates only */ + prev = cp; + s->trace[s->depth++] = cp; + depth--; + } + ptr++; + } + } else ptr++; + } + } +} + +/* + * Getting the relevant fields from the term pointed to by ftrace + */ + +static struct StackTrace *get_trace_from_exc(Eterm exc) { + if (exc == NIL) { + return NULL; + } else { + ASSERT(is_list(exc)); + return (struct StackTrace *) big_val(CDR(list_val(exc))); + } +} + +static Eterm get_args_from_exc(Eterm exc) { + if (exc == NIL) { + return NIL; + } else { + ASSERT(is_list(exc)); + return CAR(list_val(exc)); + } +} + +static int is_raised_exc(Eterm exc) { + if (exc == NIL) { + return 0; + } else { + ASSERT(is_list(exc)); + return bignum_header_is_neg(*big_val(CDR(list_val(exc)))); + } +} + +/* + * Creating a list with the argument registers + */ +static Eterm +make_arglist(Process* c_p, Eterm* reg, int a) { + Eterm args = NIL; + Eterm* hp = HAlloc(c_p, 2*a); + while (a > 0) { + args = CONS(hp, reg[a-1], args); + hp += 2; + a--; + } + return args; +} + +/* + * Building a symbolic representation of a saved stack trace. Note that + * the exception object 'exc', unless NIL, points to a cons cell which + * holds the given args and the quick-saved data (encoded as a bignum). + * + * If the bignum is negative, the given args is a complete stacktrace. + */ +Eterm +build_stacktrace(Process* c_p, Eterm exc) { + struct StackTrace* s; + Eterm args; + int depth; + Eterm* current; + Eterm Where = NIL; + Eterm* next_p = &Where; + + if (! (s = get_trace_from_exc(exc))) { + return NIL; + } +#ifdef HIPE + if (s->freason & EXF_NATIVE) { + return hipe_build_stacktrace(c_p, s); + } +#endif + if (is_raised_exc(exc)) { + return get_args_from_exc(exc); + } + + /* + * Find the current function. If the saved s->pc is null, then the + * saved s->current should already contain the proper value. + */ + if (s->pc != NULL) { + current = find_function_from_pc(s->pc); + } else { + current = s->current; + } + /* + * If current is still NULL, default to the initial function + * (e.g. spawn_link(erlang, abs, [1])). + */ + if (current == NULL) { + current = c_p->initial; + args = am_true; /* Just in case */ + } else { + args = get_args_from_exc(exc); + } + + depth = s->depth; + + /* + * Add the {M,F,A} for the current function + * (where A is arity or [Argument]). + */ + { + int i; + Eterm mfa; + Uint heap_size = 6*(depth+1); + Eterm* hp = HAlloc(c_p, heap_size); + Eterm* hp_end = hp + heap_size; + + if (args != am_true) { + /* We have an arglist - use it */ + mfa = TUPLE3(hp, current[0], current[1], args); + } else { + Eterm arity = make_small(current[2]); + mfa = TUPLE3(hp, current[0], current[1], arity); + } + hp += 4; + ASSERT(*next_p == NIL); + *next_p = CONS(hp, mfa, NIL); + next_p = &CDR(list_val(*next_p)); + hp += 2; + + /* + * Finally, we go through the saved continuation pointers. + */ + for (i = 0; i < depth; i++) { + Eterm *fi = find_function_from_pc((Eterm *) s->trace[i]); + if (fi == NULL) continue; + mfa = TUPLE3(hp, fi[0], fi[1], make_small(fi[2])); + hp += 4; + ASSERT(*next_p == NIL); + *next_p = CONS(hp, mfa, NIL); + next_p = &CDR(list_val(*next_p)); + hp += 2; + } + ASSERT(hp <= hp_end); + HRelease(c_p, hp_end, hp); + } + return Where; +} + + +static Eterm +call_error_handler(Process* p, Eterm* fi, Eterm* reg) +{ + Eterm* hp; + Export* ep; + int arity; + Eterm args; + Uint sz; + int i; + + /* + * Search for the error_handler module. + */ + ep = erts_find_function(erts_proc_get_error_handler(p), + am_undefined_function, 3); + if (ep == NULL) { /* No error handler */ + p->current = fi; + p->freason = EXC_UNDEF; + return 0; + } + p->i = ep->address; + + /* + * Create a list with all arguments in the x registers. + */ + + arity = fi[2]; + sz = 2 * arity; + if (HeapWordsLeft(p) < sz) { + erts_garbage_collect(p, sz, reg, arity); + } + hp = HEAP_TOP(p); + HEAP_TOP(p) += sz; + args = NIL; + for (i = arity-1; i >= 0; i--) { + args = CONS(hp, reg[i], args); + hp += 2; + } + + /* + * Set up registers for call to error_handler:undefined_function/3. + */ + reg[0] = fi[0]; + reg[1] = fi[1]; + reg[2] = args; + return 1; +} + +static Eterm +call_breakpoint_handler(Process* p, Eterm* fi, Eterm* reg) +{ + Eterm* hp; + Export* ep; + int arity; + Eterm args; + Uint sz; + int i; + + /* + * Search for error handler module. + */ + ep = erts_find_function(erts_proc_get_error_handler(p), + am_breakpoint, 3); + if (ep == NULL) { /* No error handler */ + p->current = fi; + p->freason = EXC_UNDEF; + return 0; + } + p->i = ep->address; + + /* + * Create a list with all arguments in the x registers. + */ + + arity = fi[2]; + sz = 2 * arity; + if (HeapWordsLeft(p) < sz) { + erts_garbage_collect(p, sz, reg, arity); + } + hp = HEAP_TOP(p); + HEAP_TOP(p) += sz; + args = NIL; + for (i = arity-1; i >= 0; i--) { + args = CONS(hp, reg[i], args); + hp += 2; + } + + /* + * Set up registers for call to error_handler:breakpoint/3. + */ + reg[0] = fi[0]; + reg[1] = fi[1]; + reg[2] = args; + return 1; +} + + + +static Export* +apply_setup_error_handler(Process* p, Eterm module, Eterm function, Uint arity, Eterm* reg) +{ + Export* ep; + + /* + * Find the export table index for the error handler. Return NULL if + * there is no error handler module. + */ + + if ((ep = erts_find_export_entry(erts_proc_get_error_handler(p), + am_undefined_function, 3)) == NULL) { + return NULL; + } else { + int i; + Uint sz = 2*arity; + Eterm* hp; + Eterm args = NIL; + + /* + * Always copy args from registers to a new list; this ensures + * that we have the same behaviour whether or not this was + * called from apply or fixed_apply (any additional last + * THIS-argument will be included, assuming that arity has been + * properly adjusted). + */ + + if (HeapWordsLeft(p) < sz) { + erts_garbage_collect(p, sz, reg, arity); + } + hp = HEAP_TOP(p); + HEAP_TOP(p) += sz; + for (i = arity-1; i >= 0; i--) { + args = CONS(hp, reg[i], args); + hp += 2; + } + reg[0] = module; + reg[1] = function; + reg[2] = args; + } + + return ep; +} + +static Uint* +apply(Process* p, Eterm module, Eterm function, Eterm args, Eterm* reg) +{ + int arity; + Export* ep; + Eterm tmp, this; + + /* + * Check the arguments which should be of the form apply(Module, + * Function, Arguments) where Function is an atom and + * Arguments is an arity long list of terms. + */ + if (is_not_atom(function)) { + /* + * No need to test args here -- done below. + */ + error: + p->freason = BADARG; + + error2: + reg[0] = module; + reg[1] = function; + reg[2] = args; + return 0; + } + + /* The module argument may be either an atom or an abstract module + * (currently implemented using tuples, but this might change). + */ + this = THE_NON_VALUE; + if (is_not_atom(module)) { + Eterm* tp; + + if (is_not_tuple(module)) goto error; + tp = tuple_val(module); + if (arityval(tp[0]) < 1) goto error; + this = module; + module = tp[1]; + if (is_not_atom(module)) goto error; + } + + /* + * Walk down the 3rd parameter of apply (the argument list) and copy + * the parameters to the x registers (reg[]). If the module argument + * was an abstract module, add 1 to the function arity and put the + * module argument in the n+1st x register as a THIS reference. + */ + + tmp = args; + arity = 0; + while (is_list(tmp)) { + if (arity < (MAX_REG - 1)) { + reg[arity++] = CAR(list_val(tmp)); + tmp = CDR(list_val(tmp)); + } else { + p->freason = SYSTEM_LIMIT; + goto error2; + } + } + if (is_not_nil(tmp)) { /* Must be well-formed list */ + goto error; + } + if (this != THE_NON_VALUE) { + reg[arity++] = this; + } + + /* + * Get the index into the export table, or failing that the export + * entry for the error handler. + * + * Note: All BIFs have export entries; thus, no special case is needed. + */ + + if ((ep = erts_find_export_entry(module, function, arity)) == NULL) { + if ((ep = apply_setup_error_handler(p, module, function, arity, reg)) == NULL) goto error; + } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { + save_calls(p, ep); + } + + return ep->address; +} + +static Uint* +fixed_apply(Process* p, Eterm* reg, Uint arity) +{ + Export* ep; + Eterm module; + Eterm function; + + module = reg[arity]; /* The THIS pointer already in place */ + function = reg[arity+1]; + + if (is_not_atom(function)) { + error: + p->freason = BADARG; + reg[0] = module; + reg[1] = function; + reg[2] = NIL; + return 0; + } + + /* The module argument may be either an atom or an abstract module + * (currently implemented using tuples, but this might change). + */ + if (is_not_atom(module)) { + Eterm* tp; + if (is_not_tuple(module)) goto error; + tp = tuple_val(module); + if (arityval(tp[0]) < 1) goto error; + module = tp[1]; + if (is_not_atom(module)) goto error; + ++arity; + } + + /* + * Get the index into the export table, or failing that the export + * entry for the error handler module. + * + * Note: All BIFs have export entries; thus, no special case is needed. + */ + + if ((ep = erts_find_export_entry(module, function, arity)) == NULL) { + if ((ep = apply_setup_error_handler(p, module, function, arity, reg)) == NULL) + goto error; + } else if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { + save_calls(p, ep); + } + + return ep->address; +} + +static int +hibernate(Process* c_p, Eterm module, Eterm function, Eterm args, Eterm* reg) +{ + int arity; + Eterm tmp; + + if (is_not_atom(module) || is_not_atom(function)) { + /* + * No need to test args here -- done below. + */ + error: + c_p->freason = BADARG; + + error2: + reg[0] = module; + reg[1] = function; + reg[2] = args; + return 0; + } + + arity = 0; + tmp = args; + while (is_list(tmp)) { + if (arity < MAX_REG) { + tmp = CDR(list_val(tmp)); + arity++; + } else { + c_p->freason = SYSTEM_LIMIT; + goto error2; + } + } + if (is_not_nil(tmp)) { /* Must be well-formed list */ + goto error; + } + + /* + * At this point, arguments are known to be good. + */ + + if (c_p->arg_reg != c_p->def_arg_reg) { + /* Save some memory */ + erts_free(ERTS_ALC_T_ARG_REG, c_p->arg_reg); + c_p->arg_reg = c_p->def_arg_reg; + c_p->max_arg_reg = sizeof(c_p->def_arg_reg)/sizeof(c_p->def_arg_reg[0]); + } + + /* + * Arrange for the process to be resumed at the given MFA with + * the stack cleared. + */ + c_p->arity = 3; + c_p->arg_reg[0] = module; + c_p->arg_reg[1] = function; + c_p->arg_reg[2] = args; + c_p->stop = STACK_START(c_p); + c_p->catches = 0; + c_p->i = beam_apply; + c_p->cp = (Eterm *) beam_apply+1; + + /* + * If there are no waiting messages, garbage collect and + * shrink the heap. + */ + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + if (c_p->msg.len > 0) { + erts_add_to_runq(c_p); + } else { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + c_p->fvalue = NIL; + PROCESS_MAIN_CHK_LOCKS(c_p); + erts_garbage_collect_hibernate(c_p); + PROCESS_MAIN_CHK_LOCKS(c_p); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + ASSERT(!ERTS_PROC_IS_EXITING(c_p)); + c_p->status = P_WAITING; +#ifdef ERTS_SMP + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + if (c_p->msg.len > 0) + erts_add_to_runq(c_p); +#endif + } + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + c_p->current = bif_export[BIF_hibernate_3]->code; + return 1; +} + +static Uint* +call_fun(Process* p, /* Current process. */ + int arity, /* Number of arguments for Fun. */ + Eterm* reg, /* Contents of registers. */ + Eterm args) /* THE_NON_VALUE or pre-built list of arguments. */ +{ + Eterm fun = reg[arity]; + Eterm hdr; + int i; + Eterm function; + Eterm* hp; + + if (!is_boxed(fun)) { + goto badfun; + } + hdr = *boxed_val(fun); + + if (is_fun_header(hdr)) { + ErlFunThing* funp = (ErlFunThing *) fun_val(fun); + ErlFunEntry* fe; + Eterm* code_ptr; + Eterm* var_ptr; + int actual_arity; + unsigned num_free; + + fe = funp->fe; + num_free = funp->num_free; + code_ptr = fe->address; + actual_arity = (int) code_ptr[-1]; + + if (actual_arity == arity+num_free) { + if (num_free == 0) { + return code_ptr; + } else { + var_ptr = funp->env; + reg += arity; + i = 0; + do { + reg[i] = var_ptr[i]; + i++; + } while (i < num_free); + reg[i] = fun; + return code_ptr; + } + return code_ptr; + } else { + /* + * Something wrong here. First build a list of the arguments. + */ + + if (is_non_value(args)) { + Uint sz = 2 * arity; + args = NIL; + if (HeapWordsLeft(p) < sz) { + erts_garbage_collect(p, sz, reg, arity+1); + fun = reg[arity]; + } + hp = HEAP_TOP(p); + HEAP_TOP(p) += sz; + for (i = arity-1; i >= 0; i--) { + args = CONS(hp, reg[i], args); + hp += 2; + } + } + + if (actual_arity >= 0) { + /* + * There is a fun defined, but the call has the wrong arity. + */ + hp = HAlloc(p, 3); + p->freason = EXC_BADARITY; + p->fvalue = TUPLE2(hp, fun, args); + return NULL; + } else { + Export* ep; + Module* modp; + Eterm module; + + + /* + * No arity. There is no module loaded that defines the fun, + * either because the fun is newly created from the external + * representation (the module has never been loaded), + * or the module defining the fun has been unloaded. + */ + + module = fe->module; + if ((modp = erts_get_module(module)) != NULL && modp->code != NULL) { + /* + * There is a module loaded, but obviously the fun is not + * defined in it. We must not call the error_handler + * (or we will get into an infinite loop). + */ + goto badfun; + } + + /* + * No current code for this module. Call the error_handler module + * to attempt loading the module. + */ + + ep = erts_find_function(erts_proc_get_error_handler(p), + am_undefined_lambda, 3); + if (ep == NULL) { /* No error handler */ + p->current = NULL; + p->freason = EXC_UNDEF; + return NULL; + } + reg[0] = module; + reg[1] = fun; + reg[2] = args; + return ep->address; + } + } + } else if (is_export_header(hdr)) { + Export* ep = (Export *) (export_val(fun))[1]; + int actual_arity = (int) ep->code[2]; + if (arity == actual_arity) { + return ep->address; + } else { + /* + * Wrong arity. First build a list of the arguments. + */ + + if (is_non_value(args)) { + args = NIL; + hp = HAlloc(p, arity*2); + for (i = arity-1; i >= 0; i--) { + args = CONS(hp, reg[i], args); + hp += 2; + } + } + + hp = HAlloc(p, 3); + p->freason = EXC_BADARITY; + p->fvalue = TUPLE2(hp, fun, args); + return NULL; + } + } else if (hdr == make_arityval(2)) { + Eterm* tp; + Export* ep; + Eterm module; + + tp = tuple_val(fun); + module = tp[1]; + function = tp[2]; + if (!is_atom(module) || !is_atom(function)) { + goto badfun; + } + if ((ep = erts_find_export_entry(module, function, arity)) == NULL) { + ep = erts_find_export_entry(erts_proc_get_error_handler(p), + am_undefined_function, 3); + if (ep == NULL) { + p->freason = EXC_UNDEF; + return 0; + } + if (is_non_value(args)) { + Uint sz = 2 * arity; + if (HeapWordsLeft(p) < sz) { + erts_garbage_collect(p, sz, reg, arity); + } + hp = HEAP_TOP(p); + HEAP_TOP(p) += sz; + args = NIL; + while (arity-- > 0) { + args = CONS(hp, reg[arity], args); + hp += 2; + } + } + reg[0] = module; + reg[1] = function; + reg[2] = args; + } + return ep->address; + } else { + badfun: + p->current = NULL; + p->freason = EXC_BADFUN; + p->fvalue = fun; + return NULL; + } +} + +static Eterm* +apply_fun(Process* p, Eterm fun, Eterm args, Eterm* reg) +{ + int arity; + Eterm tmp; + + /* + * Walk down the 3rd parameter of apply (the argument list) and copy + * the parameters to the x registers (reg[]). + */ + + tmp = args; + arity = 0; + while (is_list(tmp)) { + if (arity < MAX_REG-1) { + reg[arity++] = CAR(list_val(tmp)); + tmp = CDR(list_val(tmp)); + } else { + p->freason = SYSTEM_LIMIT; + return NULL; + } + } + + if (is_not_nil(tmp)) { /* Must be well-formed list */ + p->freason = EXC_UNDEF; + return NULL; + } + reg[arity] = fun; + return call_fun(p, arity, reg, args); +} + + +static Eterm +new_fun(Process* p, Eterm* reg, ErlFunEntry* fe, int num_free) +{ + unsigned needed = ERL_FUN_SIZE + num_free; + ErlFunThing* funp; + Eterm* hp; + int i; + + if (HEAP_LIMIT(p) - HEAP_TOP(p) <= needed) { + PROCESS_MAIN_CHK_LOCKS(p); + erts_garbage_collect(p, needed, reg, num_free); + PROCESS_MAIN_CHK_LOCKS(p); + } + hp = p->htop; + p->htop = hp + needed; + funp = (ErlFunThing *) hp; + hp = funp->env; + erts_refc_inc(&fe->refc, 2); + funp->thing_word = HEADER_FUN; +#ifndef HYBRID /* FIND ME! */ + funp->next = MSO(p).funs; + MSO(p).funs = funp; +#endif + funp->fe = fe; + funp->num_free = num_free; + funp->creator = p->id; +#ifdef HIPE + funp->native_address = fe->native_address; +#endif + funp->arity = (int)fe->address[-1] - num_free; + for (i = 0; i < num_free; i++) { + *hp++ = reg[i]; + } + return make_fun(funp); +} + + + +int catchlevel(Process *p) +{ + return p->catches; +} + +/* + * Check if the given function is built-in (i.e. a BIF implemented in C). + * + * Returns 0 if not built-in, and a non-zero value if built-in. + */ + +int +erts_is_builtin(Eterm Mod, Eterm Name, int arity) +{ + Export e; + Export* ep; + + e.code[0] = Mod; + e.code[1] = Name; + e.code[2] = arity; + + if ((ep = export_get(&e)) == NULL) { + return 0; + } + return ep->address == ep->code+3 && (ep->code[3] == (Uint) em_apply_bif); +} + + +/* + * Return the current number of reductions for the given process. + * To get the total number of reductions, p->reds must be added. + */ + +Uint +erts_current_reductions(Process *current, Process *p) +{ + if (current != p) { + return 0; + } else if (current->fcalls < 0 && ERTS_PROC_GET_SAVED_CALLS_BUF(current)) { + return -current->fcalls; + } else { + return REDS_IN(current) - current->fcalls; + } +} + +static BIF_RETTYPE nif_dispatcher_0(Process* p, Uint* I) +{ + typedef Eterm NifF(struct enif_environment_t*); + NifF* fp = (NifF*) I[1]; + struct enif_environment_t env; + Eterm ret; + erts_pre_nif(&env, p, (void*)I[2]); + ret = (*fp)(&env); + erts_post_nif(&env); + return ret; +} + +static BIF_RETTYPE nif_dispatcher_1(Process* p, Eterm arg1, Uint* I) +{ + typedef Eterm NifF(struct enif_environment_t*, Eterm); + NifF* fp = (NifF*) I[1]; + struct enif_environment_t env; + Eterm ret; + erts_pre_nif(&env, p, (void*)I[2]); + ret = (*fp)(&env, arg1); + erts_post_nif(&env); + return ret; +} + +static BIF_RETTYPE nif_dispatcher_2(Process* p, Eterm arg1, Eterm arg2, Uint* I) +{ + typedef Eterm NifF(struct enif_environment_t*, Eterm, Eterm); + NifF* fp = (NifF*) I[1]; + struct enif_environment_t env; + Eterm ret; + erts_pre_nif(&env, p, (void*)I[2]); + ret = (*fp)(&env, arg1, arg2); + erts_post_nif(&env); + return ret; +} + +static BIF_RETTYPE nif_dispatcher_3(Process* p, Eterm arg1, Eterm arg2, Eterm arg3, Uint* I) +{ + typedef Eterm NifF(struct enif_environment_t*, Eterm, Eterm, Eterm); + NifF* fp = (NifF*) I[1]; + struct enif_environment_t env; + Eterm ret; + erts_pre_nif(&env, p, (void*)I[2]); + ret = (*fp)(&env, arg1, arg2, arg3); + erts_post_nif(&env); + return ret; +} + diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c new file mode 100644 index 0000000000..47dd98117d --- /dev/null +++ b/erts/emulator/beam/beam_load.c @@ -0,0 +1,5234 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_version.h" +#include "erl_process.h" +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "external.h" +#include "beam_load.h" +#include "big.h" +#include "erl_bits.h" +#include "beam_catches.h" +#include "erl_binary.h" +#include "erl_zlib.h" + +#ifdef HIPE +#include "hipe_bif0.h" +#include "hipe_mode_switch.h" +#include "hipe_arch.h" +#endif + +ErlDrvBinary* erts_gzinflate_buffer(char*, int); + +#define MAX_OPARGS 8 +#define CALLED 0 +#define DEFINED 1 +#define EXPORTED 2 + +#ifdef NO_JUMP_TABLE +# define BeamOpCode(Op) ((Uint)(Op)) +#else +# define BeamOpCode(Op) ((Eterm)beam_ops[Op]) +#endif + +#if defined(WORDS_BIGENDIAN) +# define NATIVE_ENDIAN(F) \ + if ((F).val & BSF_NATIVE) { \ + (F).val &= ~(BSF_LITTLE|BSF_NATIVE); \ + } else {} +#else +# define NATIVE_ENDIAN(F) \ + if ((F).val & BSF_NATIVE) { \ + (F).val &= ~BSF_NATIVE; \ + (F).val |= BSF_LITTLE; \ + } else {} +#endif + +/* + * Errors returned from tranform_engine(). + */ +#define TE_OK 0 +#define TE_FAIL (-1) +#define TE_SHORT_WINDOW (-2) + +typedef struct { + Uint value; /* Value of label (NULL if not known yet). */ + Uint patches; /* Index (into code buffer) to first location + * which must be patched with the value of this label. + */ +#ifdef ERTS_SMP + Uint looprec_targeted; /* Non-zero if this label is the target of a loop_rec + * instruction. + */ +#endif +} Label; + +/* + * Type for a operand for a generic instruction. + */ + +typedef struct { + unsigned type; /* Type of operand. */ + Uint val; /* Value of operand. */ + Uint bigarity; /* Arity for bignumbers (only). */ +} GenOpArg; + +/* + * A generic operation. + */ + +typedef struct genop { + int op; /* Opcode. */ + int arity; /* Number of arguments. */ + GenOpArg def_args[MAX_OPARGS]; /* Default buffer for arguments. */ + GenOpArg* a; /* The arguments. */ + struct genop* next; /* Next genop. */ +} GenOp; + +/* + * The allocation unit for generic blocks. + */ + +typedef struct genop_block { + GenOp genop[32]; + struct genop_block* next; +} GenOpBlock; + +/* + * This structure contains information for an imported function or BIF. + */ +typedef struct { + Eterm module; /* Tagged atom for module. */ + Eterm function; /* Tagged atom for function. */ + int arity; /* Arity. */ + Uint patches; /* Index to locations in code to + * eventually patch with a pointer into + * the export entry. + */ + BifFunction bf; /* Pointer to BIF function if BIF; + * NULL otherwise. + */ +} ImportEntry; + +/* + * This structure contains information for a function exported from a module. + */ + +typedef struct { + Eterm function; /* Tagged atom for function. */ + int arity; /* Arity. */ + Eterm* address; /* Address to function in code. */ +} ExportEntry; + +#define MakeIffId(a, b, c, d) \ + (((Uint) (a) << 24) | ((Uint) (b) << 16) | ((Uint) (c) << 8) | (Uint) (d)) + +#define ATOM_CHUNK 0 +#define CODE_CHUNK 1 +#define STR_CHUNK 2 +#define IMP_CHUNK 3 +#define EXP_CHUNK 4 +#define NUM_MANDATORY 5 + +#define LAMBDA_CHUNK 5 +#define LITERAL_CHUNK 6 +#define ATTR_CHUNK 7 +#define COMPILE_CHUNK 8 + +#define NUM_CHUNK_TYPES (sizeof(chunk_types)/sizeof(chunk_types[0])) + +/* + * An array with all chunk types recognized by the loader. + */ + +static Uint chunk_types[] = { + /* + * Mandatory chunk types -- these MUST be present. + */ + MakeIffId('A', 't', 'o', 'm'), /* 0 */ + MakeIffId('C', 'o', 'd', 'e'), /* 1 */ + MakeIffId('S', 't', 'r', 'T'), /* 2 */ + MakeIffId('I', 'm', 'p', 'T'), /* 3 */ + MakeIffId('E', 'x', 'p', 'T'), /* 4 */ + + /* + * Optional chunk types -- the loader will use them if present. + */ + MakeIffId('F', 'u', 'n', 'T'), /* 5 */ + MakeIffId('L', 'i', 't', 'T'), /* 6 */ + MakeIffId('A', 't', 't', 'r'), /* 7 */ + MakeIffId('C', 'I', 'n', 'f'), /* 8 */ +}; + +/* + * This structure keeps load-time information about a lambda. + */ + +typedef struct { + ErlFunEntry* fe; /* Entry in fun table. */ + unsigned label; /* Label of function entry. */ + Uint32 num_free; /* Number of free variables. */ + Eterm function; /* Name of local function. */ + int arity; /* Arity (including free variables). */ +} Lambda; + +/* + * This structure keeps load-time information about a literal. + */ + +typedef struct { + Eterm term; /* The tagged term (in the heap). */ + Uint heap_size; /* (Exact) size on the heap. */ + Uint offset; /* Offset from temporary location to final. */ + Eterm* heap; /* Heap for term. */ +} Literal; + +/* + * This structure keeps information about an operand that needs to be + * patched to contain the correct address of a literal when the code is + * frozen. + */ + +typedef struct literal_patch LiteralPatch; +struct literal_patch { + int pos; /* Position in code */ + LiteralPatch* next; +}; + +/* + * This structure keeps information about an operand that needs to be + * patched to contain the correct address for an address into the string table. + */ + +typedef struct string_patch StringPatch; +struct string_patch { + int pos; /* Position in code */ + StringPatch* next; +}; + +/* + * This structure contains all information about the module being loaded. + */ + +typedef struct { + /* + * The current logical file within the binary. + */ + + char* file_name; /* Name of file we are reading (usually chunk name). */ + byte* file_p; /* Current pointer within file. */ + unsigned file_left; /* Number of bytes left in file. */ + + /* + * The following are used mainly for diagnostics. + */ + + Eterm group_leader; /* Group leader (for diagnostics). */ + Eterm module; /* Tagged atom for module name. */ + Eterm function; /* Tagged atom for current function + * (or 0 if none). + */ + unsigned arity; /* Arity for current function. */ + + /* + * All found chunks. + */ + + struct { + byte* start; /* Start of chunk (in binary). */ + unsigned size; /* Size of chunk. */ + } chunks[NUM_CHUNK_TYPES]; + + /* + * Used for code loading (mainly). + */ + + byte* code_start; /* Start of code file. */ + unsigned code_size; /* Size of code file. */ + int specific_op; /* Specific opcode (-1 if not found). */ + int num_functions; /* Number of functions in module. */ + int num_labels; /* Number of labels. */ + int code_buffer_size; /* Size of code buffer in words. */ + Eterm* code; /* Loaded code. */ + int ci; /* Current index into loaded code. */ + Label* labels; + Uint put_strings; /* Linked list of put_string instructions. */ + Uint new_bs_put_strings; /* Linked list of i_new_bs_put_string instructions. */ + StringPatch* string_patches; /* Linked list of position into string table to patch. */ + Uint catches; /* Linked list of catch_yf instructions. */ + unsigned loaded_size; /* Final size of code when loaded. */ + byte mod_md5[16]; /* MD5 for module code. */ + int may_load_nif; /* true if NIFs may later be loaded for this module */ + int on_load; /* Index in the code for the on_load function + * (or 0 if there is no on_load function) + */ + + /* + * Atom table. + */ + + int num_atoms; /* Number of atoms in atom table. */ + Eterm* atom; /* Atom table. */ + + int num_exps; /* Number of exports. */ + ExportEntry* export; /* Pointer to export table. */ + + int num_imports; /* Number of imports. */ + ImportEntry* import; /* Import entry (translated information). */ + + /* + * Generic instructions. + */ + GenOp* genop; /* The last generic instruction seen. */ + GenOp* free_genop; /* List of free genops. */ + GenOpBlock* genop_blocks; /* List of all block of allocated genops. */ + + /* + * Lambda table. + */ + + int num_lambdas; /* Number of lambdas in table. */ + int lambdas_allocated; /* Size of allocated lambda table. */ + Lambda* lambdas; /* Pointer to lambdas. */ + Lambda def_lambdas[16]; /* Default storage for lambda table. */ + char* lambda_error; /* Delayed missing 'FunT' error. */ + + /* + * Literals (constant pool). + */ + + int num_literals; /* Number of literals in table. */ + int allocated_literals; /* Number of literal entries allocated. */ + Literal* literals; /* Array of literals. */ + LiteralPatch* literal_patches; /* Operands that need to be patched. */ + Uint total_literal_size; /* Total heap size for all literals. */ + + /* + * Floating point. + */ + int new_float_instructions; /* New allocation scheme for floating point. */ +} LoaderState; + +typedef struct { + unsigned num_functions; /* Number of functions. */ + Eterm* func_tab[1]; /* Pointers to each function. */ +} LoadedCode; + +#define GetTagAndValue(Stp, Tag, Val) \ + do { \ + Uint __w; \ + GetByte(Stp, __w); \ + Tag = __w & 0x07; \ + if ((__w & 0x08) == 0) { \ + Val = __w >> 4; \ + } else if ((__w & 0x10) == 0) { \ + Val = ((__w >> 5) << 8); \ + GetByte(Stp, __w); \ + Val |= __w; \ + } else { \ + if (!get_int_val(Stp, __w, &(Val))) goto load_error; \ + } \ + } while (0) + + +#define LoadError0(Stp, Fmt) \ + do { \ + load_printf(__LINE__, Stp, Fmt); \ + goto load_error; \ + } while (0) + +#define LoadError1(Stp, Fmt, Arg1) \ + do { \ + load_printf(__LINE__, stp, Fmt, Arg1); \ + goto load_error; \ + } while (0) + +#define LoadError2(Stp, Fmt, Arg1, Arg2) \ + do { \ + load_printf(__LINE__, Stp, Fmt, Arg1, Arg2); \ + goto load_error; \ + } while (0) + +#define LoadError3(Stp, Fmt, Arg1, Arg2, Arg3) \ + do { \ + load_printf(__LINE__, stp, Fmt, Arg1, Arg2, Arg3); \ + goto load_error; \ + } while (0) + +#define EndOfFile(Stp) (stp->file_left == 0) + +#define GetInt(Stp, N, Dest) \ + if (Stp->file_left < (N)) { \ + short_file(__LINE__, Stp, (N)); \ + goto load_error; \ + } else { \ + int __n = (N); \ + Uint __result = 0; \ + Stp->file_left -= (unsigned) __n; \ + while (__n-- > 0) { \ + __result = __result << 8 | *Stp->file_p++; \ + } \ + Dest = __result; \ + } while (0) + +#define GetByte(Stp, Dest) \ + if ((Stp)->file_left < 1) { \ + short_file(__LINE__, (Stp), 1); \ + goto load_error; \ + } else { \ + Dest = *(Stp)->file_p++; \ + (Stp)->file_left--; \ + } + +#define GetString(Stp, Dest, N) \ + if (Stp->file_left < (N)) { \ + short_file(__LINE__, Stp, (N)); \ + goto load_error; \ + } else { \ + Dest = (Stp)->file_p; \ + (Stp)->file_p += (N); \ + (Stp)->file_left -= (N); \ + } + +#define GetAtom(Stp, Index, Dest) \ + if ((Index) == 0) { \ + LoadError1((Stp), "bad atom index 0 ([]) in %s", stp->file_name); \ + } else if ((Index) < (Stp)->num_atoms) { \ + Dest = (Stp)->atom[(Index)]; \ + } else { \ + LoadError2((Stp), "bad atom index %d in %s", (Index), stp->file_name); \ + } + +#ifdef DEBUG +# define GARBAGE 0xCC +# define DEBUG_INIT_GENOP(Dst) memset(Dst, GARBAGE, sizeof(GenOp)) +#else +# define DEBUG_INIT_GENOP(Dst) +#endif + +#define NEW_GENOP(Stp, Dst) \ + do { \ + if ((Stp)->free_genop == NULL) { \ + new_genop((Stp)); \ + } \ + Dst = (Stp)->free_genop; \ + (Stp)->free_genop = (Stp)->free_genop->next; \ + DEBUG_INIT_GENOP(Dst); \ + (Dst)->a = (Dst)->def_args; \ + } while (0) + +#define FREE_GENOP(Stp, Genop) \ + do { \ + if ((Genop)->a != (Genop)->def_args) { \ + erts_free(ERTS_ALC_T_LOADER_TMP, (Genop)->a); \ + } \ + (Genop)->next = (Stp)->free_genop; \ + (Stp)->free_genop = (Genop); \ + } while (0) + +#define GENOP_ARITY(Genop, Arity) \ + do { \ + ASSERT((Genop)->a == (Genop)->def_args); \ + (Genop)->arity = (Arity); \ + (Genop)->a = erts_alloc(ERTS_ALC_T_LOADER_TMP, \ + (Genop)->arity * sizeof(GenOpArg)); \ + } while (0) + + +static int bin_load(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm* modp, byte* bytes, int unloaded_size); +static void init_state(LoaderState* stp); +static int insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm module, + Eterm* code, Uint size, Uint catches); +static int scan_iff_file(LoaderState* stp, Uint* chunk_types, + Uint num_types, Uint num_mandatory); +static int load_atom_table(LoaderState* stp); +static int load_import_table(LoaderState* stp); +static int read_export_table(LoaderState* stp); +static int read_lambda_table(LoaderState* stp); +static int read_literal_table(LoaderState* stp); +static int read_code_header(LoaderState* stp); +static int load_code(LoaderState* stp); +static GenOp* gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, + GenOpArg Tuple, GenOpArg Dst); +static GenOp* gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest); +static GenOp* gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest); +static GenOp* gen_select_big(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest); +static GenOp* const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest); +static GenOp* gen_func_info(LoaderState* stp, GenOpArg mod, GenOpArg Func, + GenOpArg arity, GenOpArg label); +static GenOp* +gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, + GenOpArg Src, GenOpArg Dst); + +static int freeze_code(LoaderState* stp); + +static void final_touch(LoaderState* stp); +static void short_file(int line, LoaderState* stp, unsigned needed); +static void load_printf(int line, LoaderState* context, char *fmt, ...); +static int transform_engine(LoaderState* st); +static void id_to_string(Uint id, char* s); +static void new_genop(LoaderState* stp); +static int get_int_val(LoaderState* stp, Uint len_code, Uint* result); +static int get_erlang_integer(LoaderState* stp, Uint len_code, Uint* result); +static int new_label(LoaderState* stp); +static void new_literal_patch(LoaderState* stp, int pos); +static void new_string_patch(LoaderState* stp, int pos); +static Uint new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size); +static int genopargcompare(GenOpArg* a, GenOpArg* b); +static Eterm exported_from_module(Process* p, Eterm mod); +static Eterm functions_in_module(Process* p, Eterm mod); +static Eterm attributes_for_module(Process* p, Eterm mod); +static Eterm compilation_info_for_module(Process* p, Eterm mod); +static Eterm native_addresses(Process* p, Eterm mod); +int patch_funentries(Eterm Patchlist); +int patch(Eterm Addresses, Uint fe); +static int safe_mul(Uint a, Uint b, Uint* resp); + + +static int must_swap_floats; + +/* + * The following variables keep a sorted list of address ranges for + * each module. It allows us to quickly find a function given an + * instruction pointer. + */ +Range* modules = NULL; /* Sorted lists of module addresses. */ +int num_loaded_modules; /* Number of loaded modules. */ +int allocated_modules; /* Number of slots allocated. */ +Range* mid_module = NULL; /* Cached search start point */ + +Uint erts_total_code_size; +/**********************************************************************/ + + +void init_load(void) +{ + FloatDef f; + + erts_total_code_size = 0; + + beam_catches_init(); + + f.fd = 1.0; + must_swap_floats = (f.fw[0] == 0); + + allocated_modules = 128; + modules = (Range *) erts_alloc(ERTS_ALC_T_MODULE_REFS, + allocated_modules*sizeof(Range)); + mid_module = modules; + num_loaded_modules = 0; +} + +static void +define_file(LoaderState* stp, char* name, int idx) +{ + stp->file_name = name; + stp->file_p = stp->chunks[idx].start; + stp->file_left = stp->chunks[idx].size; +} + +int +erts_load_module(Process *c_p, + ErtsProcLocks c_p_locks, + Eterm group_leader, /* Group leader or NIL if none. */ + Eterm* modp, /* + * Module name as an atom (NIL to not check). + * On return, contains the actual module name. + */ + byte* code, /* Points to the code to load */ + int size) /* Size of code to load. */ +{ + ErlDrvBinary* bin; + int result; + + if (size >= 4 && code[0] == 'F' && code[1] == 'O' && + code[2] == 'R' && code[3] == '1') { + /* + * The BEAM module is not compressed. + */ + result = bin_load(c_p, c_p_locks, group_leader, modp, code, size); + } else { + /* + * The BEAM module is compressed (or possibly invalid/corrupted). + */ + if ((bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)code, size)) == NULL) { + return -1; + } + result = bin_load(c_p, c_p_locks, group_leader, modp, + (byte*)bin->orig_bytes, bin->orig_size); + driver_free_binary(bin); + } + return result; +} + + +static int +bin_load(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm* modp, byte* bytes, int unloaded_size) +{ + LoaderState state; + int rval = -1; + + init_state(&state); + state.module = *modp; + state.group_leader = group_leader; + + /* + * Scan the IFF file. + */ + + state.file_name = "IFF header for Beam file"; + state.file_p = bytes; + state.file_left = unloaded_size; + if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) { + goto load_error; + } + + /* + * Read the header for the code chunk. + */ + + define_file(&state, "code chunk header", CODE_CHUNK); + if (!read_code_header(&state)) { + goto load_error; + } + + /* + * Read the atom table. + */ + + define_file(&state, "atom table", ATOM_CHUNK); + if (!load_atom_table(&state)) { + goto load_error; + } + + /* + * Read the import table. + */ + + define_file(&state, "import table", IMP_CHUNK); + if (!load_import_table(&state)) { + goto load_error; + } + + /* + * Read the lambda (fun) table. + */ + + if (state.chunks[LAMBDA_CHUNK].size > 0) { + define_file(&state, "lambda (fun) table", LAMBDA_CHUNK); + if (!read_lambda_table(&state)) { + goto load_error; + } + } + + /* + * Read the literal table. + */ + + if (state.chunks[LITERAL_CHUNK].size > 0) { + define_file(&state, "literals table (constant pool)", LITERAL_CHUNK); + if (!read_literal_table(&state)) { + goto load_error; + } + } + + /* + * Load the code chunk. + */ + + state.file_name = "code chunk"; + state.file_p = state.code_start; + state.file_left = state.code_size; + if (!load_code(&state) || !freeze_code(&state)) { + goto load_error; + } + + /* + * Read and validate the export table. (This must be done after + * loading the code, because it contains labels.) + */ + + define_file(&state, "export table", EXP_CHUNK); + if (!read_export_table(&state)) { + goto load_error; + } + + /* + * Ready for the final touch: fixing the export table entries for + * exported and imported functions. This can't fail. + */ + + rval = insert_new_code(c_p, c_p_locks, state.group_leader, state.module, + state.code, state.loaded_size, state.catches); + if (rval < 0) { + goto load_error; + } + final_touch(&state); + + /* + * Loading succeded. + */ + rval = 0; + state.code = NULL; /* Prevent code from being freed. */ + *modp = state.module; + + /* + * If there is an on_load function, signal an error to + * indicate that the on_load function must be run. + */ + if (state.on_load) { + rval = -5; + } + + load_error: + if (state.code != 0) { + erts_free(ERTS_ALC_T_CODE, state.code); + } + if (state.labels != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.labels); + } + if (state.atom != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.atom); + } + if (state.import != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.import); + } + if (state.export != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.export); + } + if (state.lambdas != state.def_lambdas) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas); + } + if (state.literals != NULL) { + int i; + for (i = 0; i < state.num_literals; i++) { + if (state.literals[i].heap != NULL) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literals[i].heap); + } + } + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literals); + } + while (state.literal_patches != NULL) { + LiteralPatch* next = state.literal_patches->next; + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.literal_patches); + state.literal_patches = next; + } + while (state.string_patches != NULL) { + StringPatch* next = state.string_patches->next; + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.string_patches); + state.string_patches = next; + } + while (state.genop_blocks) { + GenOpBlock* next = state.genop_blocks->next; + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.genop_blocks); + state.genop_blocks = next; + } + + return rval; +} + + +static void +init_state(LoaderState* stp) +{ + stp->function = THE_NON_VALUE; /* Function not known yet */ + stp->arity = 0; + stp->specific_op = -1; + stp->genop = NULL; + stp->atom = NULL; + stp->code = NULL; + stp->labels = NULL; + stp->import = NULL; + stp->export = NULL; + stp->free_genop = NULL; + stp->genop_blocks = NULL; + stp->num_lambdas = 0; + stp->lambdas_allocated = sizeof(stp->def_lambdas)/sizeof(Lambda); + stp->lambdas = stp->def_lambdas; + stp->lambda_error = NULL; + stp->num_literals = 0; + stp->allocated_literals = 0; + stp->literals = 0; + stp->total_literal_size = 0; + stp->literal_patches = 0; + stp->string_patches = 0; + stp->new_float_instructions = 0; + stp->may_load_nif = 0; + stp->on_load = 0; +} + +static int +insert_new_code(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm module, Eterm* code, Uint size, Uint catches) +{ + Module* modp; + int rval; + int i; + + if ((rval = beam_make_current_old(c_p, c_p_locks, module)) < 0) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Module %T must be purged before loading\n", + module); + erts_send_error_to_logger(group_leader, dsbufp); + return rval; + } + + /* + * Update module table. + */ + + erts_total_code_size += size; + modp = erts_put_module(module); + modp->code = code; + modp->code_length = size; + modp->catches = catches; + + /* + * Update address table (used for finding a function from a PC value). + */ + + if (num_loaded_modules == allocated_modules) { + allocated_modules *= 2; + modules = (Range *) erts_realloc(ERTS_ALC_T_MODULE_REFS, + (void *) modules, + allocated_modules * sizeof(Range)); + } + for (i = num_loaded_modules; i > 0; i--) { + if (code > modules[i-1].start) { + break; + } + modules[i] = modules[i-1]; + } + modules[i].start = code; + modules[i].end = (Eterm *) (((byte *)code) + size); + num_loaded_modules++; + mid_module = &modules[num_loaded_modules/2]; + return 0; +} + +static int +scan_iff_file(LoaderState* stp, Uint* chunk_types, Uint num_types, Uint num_mandatory) +{ + MD5_CTX context; + Uint id; + Uint count; + int i; + + /* + * The binary must start with an IFF 'FOR1' chunk. + */ + + GetInt(stp, 4, id); + if (id != MakeIffId('F', 'O', 'R', '1')) { + LoadError0(stp, "not a BEAM file: no IFF 'FOR1' chunk"); + } + + /* + * Retrieve the chunk size and verify it. If the size is equal to + * or less than the size of the binary, it is ok and we will use it + * as the limit for the logical file size. + */ + + GetInt(stp, 4, count); + if (count > stp->file_left) { + LoadError2(stp, "form size %ld greater than size %ld of binary", + count, stp->file_left); + } + stp->file_left = count; + + /* + * Verify that this is a BEAM file. + */ + + GetInt(stp, 4, id); + if (id != MakeIffId('B', 'E', 'A', 'M')) { + LoadError0(stp, "not a BEAM file: IFF form type is not 'BEAM'"); + } + + /* + * Initialize the chunks[] array in the state. + */ + + for (i = 0; i < num_types; i++) { + stp->chunks[i].start = NULL; + stp->chunks[i].size = 0; + } + + /* + * Now we can go ahead and read all chunks in the BEAM form. + */ + + while (!EndOfFile(stp)) { + + /* + * Read the chunk id and verify that it contains ASCII characters. + */ + GetInt(stp, 4, id); + for (i = 0; i < 4; i++) { + unsigned c = (id >> i*8) & 0xff; + if (c < ' ' || c > 0x7E) { + LoadError1(stp, "non-ascii garbage '%lx' instead of chunk type id", + id); + } + } + + /* + * Read the count and verify it. + */ + + GetInt(stp, 4, count); + if (count > stp->file_left) { + LoadError2(stp, "chunk size %ld for '%lx' greater than size %ld of binary", + count, stp->file_left); + } + + /* + * See if the chunk is useful for the loader. + */ + for (i = 0; i < num_types; i++) { + if (chunk_types[i] == id) { + stp->chunks[i].start = stp->file_p; + stp->chunks[i].size = count; + break; + } + } + + /* + * Go on to the next chunk. + */ + count = 4*((count+3)/4); + stp->file_p += count; + stp->file_left -= count; + } + + /* + * At this point, we have read the entire IFF file, and we + * know that it is syntactically correct. + * + * Now check that it contains all mandatory chunks. At the + * same time calculate the MD5 for the module. + */ + + MD5Init(&context); + for (i = 0; i < num_mandatory; i++) { + if (stp->chunks[i].start != NULL) { + MD5Update(&context, stp->chunks[i].start, stp->chunks[i].size); + } else { + char sbuf[5]; + + id_to_string(chunk_types[i], sbuf); + LoadError1(stp, "mandatory chunk of type '%s' not found\n", sbuf); + } + } + if (LITERAL_CHUNK < num_types) { + if (stp->chunks[LAMBDA_CHUNK].start != 0) { + byte* start = stp->chunks[LAMBDA_CHUNK].start; + Uint left = stp->chunks[LAMBDA_CHUNK].size; + + /* + * The idea here is to ignore the OldUniq field for the fun; it is + * based on the old broken hash function, which can be different + * on little endian and big endian machines. + */ + if (left >= 4) { + static byte zero[4]; + MD5Update(&context, start, 4); + start += 4; + left -= 4; + + while (left >= 24) { + /* Include: Function Arity Index NumFree */ + MD5Update(&context, start, 20); + /* Set to zero: OldUniq */ + MD5Update(&context, zero, 4); + start += 24; + left -= 24; + } + } + /* Can't happen for a correct 'FunT' chunk */ + if (left > 0) { + MD5Update(&context, start, left); + } + } + if (stp->chunks[LITERAL_CHUNK].start != 0) { + MD5Update(&context, stp->chunks[LITERAL_CHUNK].start, + stp->chunks[LITERAL_CHUNK].size); + } + } + MD5Final(stp->mod_md5, &context); + return 1; + + load_error: + return 0; +} + + +static int +load_atom_table(LoaderState* stp) +{ + int i; + + GetInt(stp, 4, stp->num_atoms); + stp->num_atoms++; + stp->atom = erts_alloc(ERTS_ALC_T_LOADER_TMP, + erts_next_heap_size((stp->num_atoms*sizeof(Eterm)), + 0)); + + /* + * Read all atoms. + */ + + for (i = 1; i < stp->num_atoms; i++) { + byte* atom; + Uint n; + + GetByte(stp, n); + GetString(stp, atom, n); + stp->atom[i] = am_atom_put((char*)atom, n); + } + + /* + * Check the module name if a module name was given. + */ + + if (is_nil(stp->module)) { + stp->module = stp->atom[1]; + } else if (stp->atom[1] != stp->module) { + char sbuf[256]; + Atom* ap; + + ap = atom_tab(atom_val(stp->atom[1])); + memcpy(sbuf, ap->name, ap->len); + sbuf[ap->len] = '\0'; + LoadError1(stp, "module name in object code is %s", sbuf); + } + + return 1; + + load_error: + return 0; +} + + +static int +load_import_table(LoaderState* stp) +{ + int i; + + GetInt(stp, 4, stp->num_imports); + stp->import = erts_alloc(ERTS_ALC_T_LOADER_TMP, + erts_next_heap_size((stp->num_imports * + sizeof(ImportEntry)), + 0)); + for (i = 0; i < stp->num_imports; i++) { + int n; + Eterm mod; + Eterm func; + Uint arity; + Export* e; + + GetInt(stp, 4, n); + if (n >= stp->num_atoms) { + LoadError2(stp, "import entry %d: invalid atom number %d", i, n); + } + mod = stp->import[i].module = stp->atom[n]; + GetInt(stp, 4, n); + if (n >= stp->num_atoms) { + LoadError2(stp, "import entry %d: invalid atom number %d", i, n); + } + func = stp->import[i].function = stp->atom[n]; + GetInt(stp, 4, arity); + if (arity > MAX_REG) { + LoadError2(stp, "import entry %d: invalid arity %d", i, arity); + } + stp->import[i].arity = arity; + stp->import[i].patches = 0; + stp->import[i].bf = NULL; + + /* + * If the export entry refers to a BIF, get the pointer to + * the BIF function. + */ + if ((e = erts_find_export_entry(mod, func, arity)) != NULL) { + if (e->code[3] == (Uint) em_apply_bif) { + stp->import[i].bf = (BifFunction) e->code[4]; + if (func == am_load_nif && mod == am_erlang && arity == 2) { + stp->may_load_nif = 1; + } + } + } + } + return 1; + + load_error: + return 0; +} + + +static int +read_export_table(LoaderState* stp) +{ + static struct { + Eterm mod; + Eterm func; + int arity; + } allow_redef[] = { + /* The BIFs that are allowed to be redefined by Erlang code */ + {am_erlang,am_apply,2}, + {am_erlang,am_apply,3}, + }; + int i; + + GetInt(stp, 4, stp->num_exps); + if (stp->num_exps > stp->num_functions) { + LoadError2(stp, "%d functions exported; only %d functions defined", + stp->num_exps, stp->num_functions); + } + stp->export + = (ExportEntry *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + (stp->num_exps * sizeof(ExportEntry))); + + for (i = 0; i < stp->num_exps; i++) { + Uint n; + Uint value; + Eterm func; + Uint arity; + Export* e; + + GetInt(stp, 4, n); + GetAtom(stp, n, func); + stp->export[i].function = func; + GetInt(stp, 4, arity); + if (arity > MAX_REG) { + LoadError2(stp, "export table entry %d: absurdly high arity %d", i, arity); + } + stp->export[i].arity = arity; + GetInt(stp, 4, n); + if (n >= stp->num_labels) { + LoadError3(stp, "export table entry %d: invalid label %d (highest defined label is %d)", i, n, stp->num_labels); + } + value = stp->labels[n].value; + if (value == 0) { + LoadError2(stp, "export table entry %d: label %d not resolved", i, n); + } + stp->export[i].address = stp->code + value; + + /* + * Check that we are not redefining a BIF (except the ones allowed to + * redefine). + */ + if ((e = erts_find_export_entry(stp->module, func, arity)) != NULL) { + if (e->code[3] == (Uint) em_apply_bif) { + int j; + + for (j = 0; j < sizeof(allow_redef)/sizeof(allow_redef[0]); j++) { + if (stp->module == allow_redef[j].mod && + func == allow_redef[j].func && + arity == allow_redef[j].arity) { + break; + } + } + if (j == sizeof(allow_redef)/sizeof(allow_redef[0])) { + LoadError2(stp, "exported function %T/%d redefines BIF", + func, arity); + } + } + } + } + return 1; + + load_error: + return 0; +} + +static int +read_lambda_table(LoaderState* stp) +{ + int i; + + GetInt(stp, 4, stp->num_lambdas); + stp->lambdas_allocated = stp->num_lambdas; + stp->lambdas = (Lambda *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_lambdas * sizeof(Lambda)); + for (i = 0; i < stp->num_lambdas; i++) { + Uint n; + Uint32 Index; + Uint32 OldUniq; + ErlFunEntry* fe; + Uint arity; + + GetInt(stp, 4, n); /* Function. */ + GetAtom(stp, n, stp->lambdas[i].function); + GetInt(stp, 4, arity); + if (arity > MAX_REG) { + LoadError2(stp, "lambda entry %d: absurdly high arity %d", i, arity); + } + stp->lambdas[i].arity = arity; + GetInt(stp, 4, n); + if (n >= stp->num_labels) { + LoadError3(stp, "lambda entry %d: invalid label %d (highest defined label is %d)", + i, n, stp->num_labels); + } + stp->lambdas[i].label = n; + GetInt(stp, 4, Index); + GetInt(stp, 4, stp->lambdas[i].num_free); + GetInt(stp, 4, OldUniq); + fe = erts_put_fun_entry2(stp->module, OldUniq, i, stp->mod_md5, + Index, arity-stp->lambdas[i].num_free); + stp->lambdas[i].fe = fe; + } + return 1; + + load_error: + return 0; +} + +static int +read_literal_table(LoaderState* stp) +{ + int i; + Uint uncompressed_sz; + byte* uncompressed = 0; + + GetInt(stp, 4, uncompressed_sz); + uncompressed = erts_alloc(ERTS_ALC_T_TMP, uncompressed_sz); + if (erl_zlib_uncompress(uncompressed, &uncompressed_sz, + stp->file_p, stp->file_left) != Z_OK) { + LoadError0(stp, "failed to uncompress literal table (constant pool)"); + } + stp->file_p = uncompressed; + stp->file_left = uncompressed_sz; + GetInt(stp, 4, stp->num_literals); + stp->literals = (Literal *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_literals * sizeof(Literal)); + stp->allocated_literals = stp->num_literals; + + for (i = 0; i < stp->num_literals; i++) { + stp->literals[i].heap = 0; + } + + for (i = 0; i < stp->num_literals; i++) { + int sz; + Sint heap_size; + byte* p; + Eterm val; + Eterm* hp; + + GetInt(stp, 4, sz); /* Size of external term format. */ + GetString(stp, p, sz); + if ((heap_size = erts_decode_ext_size(p, sz, 1)) < 0) { + LoadError1(stp, "literal %d: bad external format", i); + } + hp = stp->literals[i].heap = erts_alloc(ERTS_ALC_T_LOADER_TMP, + heap_size*sizeof(Eterm)); + val = erts_decode_ext(&hp, NULL, &p); + stp->literals[i].heap_size = hp - stp->literals[i].heap; + if (stp->literals[i].heap_size > heap_size) { + erl_exit(1, "overrun by %d word(s) for literal heap, term %d", + stp->literals[i].heap_size - heap_size, i); + } + if (is_non_value(val)) { + LoadError1(stp, "literal %d: bad external format", i); + } + stp->literals[i].term = val; + stp->total_literal_size += stp->literals[i].heap_size; + } + erts_free(ERTS_ALC_T_TMP, uncompressed); + return 1; + + load_error: + if (uncompressed) { + erts_free(ERTS_ALC_T_TMP, uncompressed); + } + return 0; +} + + +static int +read_code_header(LoaderState* stp) +{ + unsigned head_size; + unsigned version; + unsigned opcode_max; + int i; + + /* + * Read size of sub-header for code information and from it calculate + * where the code begins. Also, use the size to limit the file size + * for header reading, so that we automatically get an error if the + * size is set too small. + */ + + GetInt(stp, 4, head_size); + stp->code_start = stp->file_p + head_size; + stp->code_size = stp->file_left - head_size; + stp->file_left = head_size; + + /* + * Get and verify version of instruction set. + */ + + GetInt(stp, 4, version); + if (version != BEAM_FORMAT_NUMBER) { + LoadError2(stp, "wrong instruction set %d; expected %d", + version, BEAM_FORMAT_NUMBER); + } + + /* + * Verify the number of the highest opcode used. + */ + + GetInt(stp, 4, opcode_max); + if (opcode_max > MAX_GENERIC_OPCODE) { + LoadError2(stp, "use of opcode %d; this emulator supports only up to %d", + opcode_max, MAX_GENERIC_OPCODE); + } + + GetInt(stp, 4, stp->num_labels); + GetInt(stp, 4, stp->num_functions); + + /* + * Initialize label table. + */ + + stp->labels = (Label *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_labels * sizeof(Label)); + for (i = 0; i < stp->num_labels; i++) { + stp->labels[i].value = 0; + stp->labels[i].patches = 0; +#ifdef ERTS_SMP + stp->labels[i].looprec_targeted = 0; +#endif + } + + /* + * Initialize code area. + */ + stp->code_buffer_size = erts_next_heap_size(2048 + stp->num_functions, 0); + stp->code = (Eterm*) erts_alloc(ERTS_ALC_T_CODE, + sizeof(Eterm) * stp->code_buffer_size); + + stp->code[MI_NUM_FUNCTIONS] = stp->num_functions; + stp->ci = MI_FUNCTIONS + stp->num_functions + 1; + + stp->code[MI_ATTR_PTR] = 0; + stp->code[MI_ATTR_SIZE_ON_HEAP] = 0; + stp->code[MI_COMPILE_PTR] = 0; + stp->code[MI_COMPILE_SIZE_ON_HEAP] = 0; + stp->code[MI_NUM_BREAKPOINTS] = 0; + + stp->put_strings = 0; + stp->new_bs_put_strings = 0; + stp->catches = 0; + return 1; + + load_error: + return 0; +} + + +#define VerifyTag(Stp, Actual, Expected) \ + if (Actual != Expected) { \ + LoadError2(Stp, "bad tag %d; expected %d", Actual, Expected); \ + } else {} + +#define Need(w) \ + ASSERT(ci <= code_buffer_size); \ + if (code_buffer_size < ci+(w)) { \ + code_buffer_size = erts_next_heap_size(ci+(w), 0); \ + stp->code = code \ + = (Eterm *) erts_realloc(ERTS_ALC_T_CODE, \ + (void *) code, \ + code_buffer_size * sizeof(Eterm)); \ + } + + + +static int +load_code(LoaderState* stp) +{ + int i; + int tmp; + int ci; + int last_func_start = 0; + char* sign; + int arg; /* Number of current argument. */ + int num_specific; /* Number of specific ops for current. */ + Eterm* code; + int code_buffer_size; + int specific; + Uint last_label = 0; /* Number of last label. */ + Uint function_number = 0; + GenOp* last_op = NULL; + GenOp** last_op_next = NULL; + int arity; + + code = stp->code; + code_buffer_size = stp->code_buffer_size; + ci = stp->ci; + + for (;;) { + int new_op; + GenOp* tmp_op; + + ASSERT(ci <= code_buffer_size); + + get_next_instr: + GetByte(stp, new_op); + if (new_op >= NUM_GENERIC_OPS) { + LoadError1(stp, "invalid opcode %d", new_op); + } + if (gen_opc[new_op].name[0] == '\0') { + LoadError1(stp, "invalid opcode %d", new_op); + } + + + /* + * Create a new generic operation and put it last in the chain. + */ + if (last_op_next == NULL) { + last_op_next = &(stp->genop); + while (*last_op_next != NULL) { + last_op_next = &(*last_op_next)->next; + } + } + + NEW_GENOP(stp, last_op); + last_op->next = NULL; + last_op->op = new_op; + *last_op_next = last_op; + last_op_next = &(last_op->next); + stp->specific_op = -1; + + /* + * Read all arguments for the current operation. + */ + + arity = gen_opc[last_op->op].arity; + last_op->arity = 0; + ASSERT(arity <= MAX_OPARGS); + +#define GetValue(Stp, First, Val) \ + do { \ + if (((First) & 0x08) == 0) { \ + Val = (First) >> 4; \ + } else if (((First) & 0x10) == 0) { \ + Uint __w; \ + GetByte(Stp, __w); \ + Val = (((First) >> 5) << 8) | __w; \ + } else { \ + if (!get_int_val(Stp, (First), &(Val))) goto load_error; \ + } \ + } while (0) + + for (arg = 0; arg < arity; arg++) { + Uint first; + + GetByte(stp, first); + last_op->a[arg].type = first & 0x07; + switch (last_op->a[arg].type) { + case TAG_i: + if ((first & 0x08) == 0) { + last_op->a[arg].val = first >> 4; + } else if ((first & 0x10) == 0) { + Uint w; + GetByte(stp, w); + ASSERT(first < 0x800); + last_op->a[arg].val = ((first >> 5) << 8) | w; + } else { + int i = get_erlang_integer(stp, first, &(last_op->a[arg].val)); + if (i < 0) { + goto load_error; + } + last_op->a[arg].type = i; + } + break; + case TAG_u: + GetValue(stp, first, last_op->a[arg].val); + break; + case TAG_x: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val == 0) { + last_op->a[arg].type = TAG_r; + } else if (last_op->a[arg].val >= MAX_REG) { + LoadError1(stp, "invalid x register number: %u", + last_op->a[arg].val); + } + break; + case TAG_y: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val >= MAX_REG) { + LoadError1(stp, "invalid y register number: %u", + last_op->a[arg].val); + } + last_op->a[arg].val += CP_SIZE; + break; + case TAG_a: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val == 0) { + last_op->a[arg].type = TAG_n; + } else if (last_op->a[arg].val >= stp->num_atoms) { + LoadError1(stp, "bad atom index: %d", last_op->a[arg].val); + } else { + last_op->a[arg].val = stp->atom[last_op->a[arg].val]; + } + break; + case TAG_f: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val == 0) { + last_op->a[arg].type = TAG_p; + } else if (last_op->a[arg].val >= stp->num_labels) { + LoadError1(stp, "bad label: %d", last_op->a[arg].val); + } + break; + case TAG_h: + GetValue(stp, first, last_op->a[arg].val); + if (last_op->a[arg].val > 65535) { + LoadError1(stp, "invalid range for character data type: %u", + last_op->a[arg].val); + } + break; + case TAG_z: + { + Uint ext_tag; + unsigned tag; + + GetValue(stp, first, ext_tag); + switch (ext_tag) { + case 0: /* Floating point number */ + { + Eterm* hp; +# ifndef ARCH_64 + Uint high, low; +# endif + last_op->a[arg].val = new_literal(stp, &hp, + FLOAT_SIZE_OBJECT); + hp[0] = HEADER_FLONUM; + last_op->a[arg].type = TAG_q; +# ifdef ARCH_64 + GetInt(stp, 8, hp[1]); +# else + GetInt(stp, 4, high); + GetInt(stp, 4, low); + if (must_swap_floats) { + Uint t = high; + high = low; + low = t; + } + hp[1] = high; + hp[2] = low; +# endif + } + break; + case 1: /* List. */ + if (arg+1 != arity) { + LoadError0(stp, "list argument must be the last argument"); + } + GetTagAndValue(stp, tag, last_op->a[arg].val); + VerifyTag(stp, tag, TAG_u); + last_op->a[arg].type = TAG_u; + last_op->a = + erts_alloc(ERTS_ALC_T_LOADER_TMP, + (arity+last_op->a[arg].val) + *sizeof(GenOpArg)); + memcpy(last_op->a, last_op->def_args, + arity*sizeof(GenOpArg)); + arity += last_op->a[arg].val; + break; + case 2: /* Float register. */ + GetTagAndValue(stp, tag, last_op->a[arg].val); + VerifyTag(stp, tag, TAG_u); + last_op->a[arg].type = TAG_l; + break; + case 3: /* Allocation list. */ + { + Uint n; + Uint type; + Uint val; + Uint words = 0; + + stp->new_float_instructions = 1; + GetTagAndValue(stp, tag, n); + VerifyTag(stp, tag, TAG_u); + while (n-- > 0) { + GetTagAndValue(stp, tag, type); + VerifyTag(stp, tag, TAG_u); + GetTagAndValue(stp, tag, val); + VerifyTag(stp, tag, TAG_u); + switch (type) { + case 0: /* Heap words */ + words += val; + break; + case 1: + words += FLOAT_SIZE_OBJECT*val; + break; + default: + LoadError1(stp, "alloc list: bad allocation " + "descriptor %d", type); + break; + } + } + last_op->a[arg].type = TAG_u; + last_op->a[arg].val = words; + break; + } + case 4: /* Literal. */ + { + Uint val; + + GetTagAndValue(stp, tag, val); + VerifyTag(stp, tag, TAG_u); + if (val >= stp->num_literals) { + LoadError1(stp, "bad literal index %d", val); + } + last_op->a[arg].type = TAG_q; + last_op->a[arg].val = val; + break; + } + default: + LoadError1(stp, "invalid extended tag %d", ext_tag); + break; + } + } + break; + default: + LoadError1(stp, "bad tag %d", last_op->a[arg].type); + break; + } + last_op->arity++; + } +#undef GetValue + + ASSERT(arity == last_op->arity); + + do_transform: + if (stp->genop == NULL) { + last_op_next = NULL; + goto get_next_instr; + } + + if (gen_opc[stp->genop->op].transform != -1) { + int need; + tmp_op = stp->genop; + + for (need = gen_opc[stp->genop->op].min_window-1; need > 0; need--) { + if (tmp_op == NULL) { + goto get_next_instr; + } + tmp_op = tmp_op->next; + } + switch (transform_engine(stp)) { + case TE_FAIL: + last_op_next = NULL; + last_op = NULL; + break; + case TE_OK: + last_op_next = NULL; + last_op = NULL; + goto do_transform; + case TE_SHORT_WINDOW: + last_op_next = NULL; + last_op = NULL; + goto get_next_instr; + } + } + + if (stp->genop == NULL) { + last_op_next = NULL; + goto get_next_instr; + } + + /* + * Special error message instruction. + */ + if (stp->genop->op == genop_too_old_compiler_0) { + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler"); + } + + /* + * From the collected generic instruction, find the specific + * instruction. + */ + + { + Uint32 mask[3] = {0, 0, 0}; + + tmp_op = stp->genop; + arity = gen_opc[tmp_op->op].arity; + if (arity > 6) { + LoadError0(stp, "no specific operation found (arity > 6)"); + } + for (arg = 0; arg < arity; arg++) { + mask[arg/2] |= ((Uint32)1 << (tmp_op->a[arg].type)) << ((arg%2)*16); + } + specific = gen_opc[tmp_op->op].specific; + num_specific = gen_opc[tmp_op->op].num_specific; + for (i = 0; i < num_specific; i++) { + if (((opc[specific].mask[0] & mask[0]) == mask[0]) && + ((opc[specific].mask[1] & mask[1]) == mask[1]) && + ((opc[specific].mask[2] & mask[2]) == mask[2])) { + break; + } + specific++; + } + + /* + * No specific operation found. + */ + if (i == num_specific) { + stp->specific_op = -1; + for (arg = 0; arg < tmp_op->arity; arg++) { + /* + * We'll give the error message here (instead of earlier) + * to get a printout of the offending operation. + */ + if (tmp_op->a[arg].type == TAG_h) { + LoadError0(stp, "the character data type not supported"); + } + } + + /* + * No specific operations and no transformations means that + * the instruction is obsolete. + */ + if (num_specific == 0 && gen_opc[tmp_op->op].transform == -1) { + LoadError0(stp, "please re-compile this module with an " + ERLANG_OTP_RELEASE " compiler "); + } + + LoadError0(stp, "no specific operation found"); + } + + stp->specific_op = specific; + Need(opc[stp->specific_op].sz+2); /* Extra margin for packing */ + code[ci++] = BeamOpCode(stp->specific_op); + } + + /* + * Load the found specific operation. + */ + + sign = opc[stp->specific_op].sign; + ASSERT(sign != NULL); + arg = 0; + while (*sign) { + Uint tag; + + ASSERT(arg < stp->genop->arity); + tag = stp->genop->a[arg].type; + switch (*sign) { + case 'r': /* x(0) */ + case 'n': /* Nil */ + VerifyTag(stp, tag_to_letter[tag], *sign); + break; + case 'x': /* x(N) */ + case 'y': /* y(N) */ + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci++] = tmp_op->a[arg].val * sizeof(Eterm); + break; + case 'a': /* Tagged atom */ + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci++] = tmp_op->a[arg].val; + break; + case 'i': /* Tagged integer */ + ASSERT(is_small(tmp_op->a[arg].val)); + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci++] = tmp_op->a[arg].val; + break; + case 'c': /* Tagged constant */ + switch (tag) { + case TAG_i: + code[ci++] = make_small(tmp_op->a[arg].val); + break; + case TAG_a: + code[ci++] = tmp_op->a[arg].val; + break; + case TAG_n: + code[ci++] = NIL; + break; + case TAG_q: + new_literal_patch(stp, ci); + code[ci++] = tmp_op->a[arg].val; + break; + default: + LoadError1(stp, "bad tag %d for tagged constant", + tmp_op->a[arg].type); + break; + } + break; + case 's': /* Any source (tagged constant or register) */ + switch (tag) { + case TAG_r: + code[ci++] = make_rreg(); + break; + case TAG_x: + code[ci++] = make_xreg(tmp_op->a[arg].val); + break; + case TAG_y: + code[ci++] = make_yreg(tmp_op->a[arg].val); + break; + case TAG_i: + code[ci++] = make_small(tmp_op->a[arg].val); + break; + case TAG_a: + code[ci++] = tmp_op->a[arg].val; + break; + case TAG_n: + code[ci++] = NIL; + break; + default: + LoadError1(stp, "bad tag %d for general source", + tmp_op->a[arg].type); + break; + } + break; + case 'd': /* Destination (x(0), x(N), y(N) */ + switch (tag) { + case TAG_r: + code[ci++] = make_rreg(); + break; + case TAG_x: + code[ci++] = make_xreg(tmp_op->a[arg].val); + break; + case TAG_y: + code[ci++] = make_yreg(tmp_op->a[arg].val); + break; + default: + LoadError1(stp, "bad tag %d for destination", + tmp_op->a[arg].type); + break; + } + break; + case 'I': /* Untagged integer (or pointer). */ + VerifyTag(stp, tag, TAG_u); + code[ci++] = tmp_op->a[arg].val; + break; + case 't': /* Small untagged integer -- can be packed. */ + VerifyTag(stp, tag, TAG_u); + code[ci++] = tmp_op->a[arg].val; + break; + case 'A': /* Arity value. */ + VerifyTag(stp, tag, TAG_u); + code[ci++] = make_arityval(tmp_op->a[arg].val); + break; + case 'f': /* Destination label */ + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci] = stp->labels[tmp_op->a[arg].val].patches; + stp->labels[tmp_op->a[arg].val].patches = ci; + ci++; + break; + case 'j': /* 'f' or 'p' */ + if (tag == TAG_p) { + code[ci] = 0; + } else if (tag == TAG_f) { + code[ci] = stp->labels[tmp_op->a[arg].val].patches; + stp->labels[tmp_op->a[arg].val].patches = ci; + } else { + LoadError3(stp, "bad tag %d; expected %d or %d", + tag, TAG_f, TAG_p); + } + ci++; + break; + case 'L': /* Define label */ + ci--; /* Remove label from loaded code */ + ASSERT(stp->specific_op == op_label_L); + VerifyTag(stp, tag, TAG_u); + last_label = tmp_op->a[arg].val; + if (!(0 < last_label && last_label < stp->num_labels)) { + LoadError2(stp, "invalid label num %d (0 < label < %d)", + tmp_op->a[arg].val, stp->num_labels); + } + if (stp->labels[last_label].value != 0) { + LoadError1(stp, "label %d defined more than once", last_label); + } + stp->labels[last_label].value = ci; + ASSERT(stp->labels[last_label].patches < ci); + break; + case 'e': /* Export entry */ + VerifyTag(stp, tag, TAG_u); + if (tmp_op->a[arg].val >= stp->num_imports) { + LoadError1(stp, "invalid import table index %d", tmp_op->a[arg].val); + } + code[ci] = stp->import[tmp_op->a[arg].val].patches; + stp->import[tmp_op->a[arg].val].patches = ci; + ci++; + break; + case 'b': + VerifyTag(stp, tag, TAG_u); + i = tmp_op->a[arg].val; + if (i >= stp->num_imports) { + LoadError1(stp, "invalid import table index %d", i); + } + if (stp->import[i].bf == NULL) { + LoadError1(stp, "not a BIF: import table index %d", i); + } + code[ci++] = (Eterm) stp->import[i].bf; + break; + case 'P': /* Byte offset into tuple */ + VerifyTag(stp, tag, TAG_u); + tmp = tmp_op->a[arg].val; + code[ci++] = (Eterm) ((tmp_op->a[arg].val+1) * sizeof(Eterm *)); + break; + case 'l': /* Floating point register. */ + VerifyTag(stp, tag_to_letter[tag], *sign); + code[ci++] = tmp_op->a[arg].val * sizeof(FloatDef); + break; + case 'q': /* Literal */ + new_literal_patch(stp, ci); + code[ci++] = tmp_op->a[arg].val; + break; + default: + LoadError1(stp, "bad argument tag: %d", *sign); + } + sign++; + arg++; + } + + /* + * Load any list arguments using the primitive tags. + */ + + for ( ; arg < tmp_op->arity; arg++) { + switch (tmp_op->a[arg].type) { + case TAG_i: + Need(1); + code[ci++] = make_small(tmp_op->a[arg].val); + break; + case TAG_u: + case TAG_a: + case TAG_v: + Need(1); + code[ci++] = tmp_op->a[arg].val; + break; + case TAG_f: + Need(1); + code[ci] = stp->labels[tmp_op->a[arg].val].patches; + stp->labels[tmp_op->a[arg].val].patches = ci; + ci++; + break; + case TAG_q: + { + Eterm lit; + + lit = stp->literals[tmp_op->a[arg].val].term; + if (is_big(lit)) { + Eterm* bigp; + Uint size; + + bigp = big_val(lit); + size = bignum_header_arity(*bigp); + Need(size+1); + code[ci++] = *bigp++; + while (size-- > 0) { + code[ci++] = *bigp++; + } + } else if (is_float(lit)) { +#ifdef ARCH_64 + Need(1); + code[ci++] = float_val(stp->literals[tmp_op->a[arg].val].term)[1]; +#else + Eterm* fptr; + + fptr = float_val(stp->literals[tmp_op->a[arg].val].term)+1; + Need(2); + code[ci++] = *fptr++; + code[ci++] = *fptr; +#endif + } else { + LoadError0(stp, "literal is neither float nor big"); + } + } + break; + default: + LoadError1(stp, "unsupported primitive type '%c'", + tag_to_letter[tmp_op->a[arg].type]); + } + } + + /* + * The packing engine. + */ + if (opc[stp->specific_op].pack[0]) { + char* prog; /* Program for packing engine. */ + Uint stack[8]; /* Stack. */ + Uint* sp = stack; /* Points to next free position. */ + Uint packed = 0; /* Accumulator for packed operations. */ + + for (prog = opc[stp->specific_op].pack; *prog; prog++) { + switch (*prog) { + case 'g': /* Get instruction; push on stack. */ + *sp++ = code[--ci]; + break; + case 'i': /* Initialize packing accumulator. */ + packed = code[--ci]; + break; + case '0': /* Tight shift */ + packed = (packed << BEAM_TIGHT_SHIFT) | code[--ci]; + break; + case '6': /* Shift 16 steps */ + packed = (packed << 16) | code[--ci]; + break; + case 'p': /* Put instruction (from stack). */ + code[ci++] = *--sp; + break; + case 'P': /* Put packed operands. */ + *sp++ = packed; + packed = 0; + break; + default: + ASSERT(0); + } + } + ASSERT(sp == stack); /* Incorrect program? */ + } + + /* + * Handle a few special cases. + */ + switch (stp->specific_op) { + case op_i_func_info_IaaI: + { + Uint offset; + enum { FINFO_SZ = 5 }; + + if (function_number >= stp->num_functions) { + LoadError1(stp, "too many functions in module (header said %d)", + stp->num_functions); + } + + if (stp->may_load_nif) { + const int finfo_ix = ci - FINFO_SZ; + enum { MIN_FUNC_SZ = 3 }; + if (finfo_ix - last_func_start < MIN_FUNC_SZ && last_func_start) { + /* Must make room for call_nif op */ + int pad = MIN_FUNC_SZ - (finfo_ix - last_func_start); + ASSERT(pad > 0 && pad < MIN_FUNC_SZ); + Need(pad); + sys_memmove(&code[finfo_ix+pad], &code[finfo_ix], FINFO_SZ*sizeof(Eterm)); + sys_memset(&code[finfo_ix], 0, pad*sizeof(Eterm)); + ci += pad; + stp->labels[last_label].value += pad; + } + } + last_func_start = ci; + /* + * Save context for error messages. + */ + stp->function = code[ci-2]; + stp->arity = code[ci-1]; + ASSERT(stp->labels[last_label].value == ci - FINFO_SZ); + offset = MI_FUNCTIONS + function_number; + code[offset] = stp->labels[last_label].patches; + stp->labels[last_label].patches = offset; + function_number++; + if (stp->arity > MAX_ARG) { + LoadError1(stp, "too many arguments: %d", stp->arity); + } +#ifdef DEBUG + ASSERT(stp->labels[0].patches == 0); /* Should not be referenced. */ + for (i = 1; i < stp->num_labels; i++) { + ASSERT(stp->labels[i].patches < ci); + } +#endif + } + break; + case op_on_load: + ci--; /* Get rid of the instruction */ + + /* Remember offset for the on_load function. */ + stp->on_load = ci; + break; + case op_put_string_IId: + { + /* + * At entry: + * + * code[ci-4] &&lb_put_string_IId + * code[ci-3] length of string + * code[ci-2] offset into string table + * code[ci-1] destination register + * + * Since we don't know the address of the string table yet, + * just check the offset and length for validity, and use + * the instruction field as a link field to link all put_string + * instructions into a single linked list. At exit: + * + * code[ci-4] pointer to next put_string instruction (or 0 + * if this is the last) + */ + Uint offset = code[ci-2]; + Uint len = code[ci-3]; + unsigned strtab_size = stp->chunks[STR_CHUNK].size; + if (offset > strtab_size || offset + len > strtab_size) { + LoadError2(stp, "invalid string reference %d, size %d", offset, len); + } + code[ci-4] = stp->put_strings; + stp->put_strings = ci - 4; + } + break; + case op_bs_put_string_II: + { + /* + * At entry: + * + * code[ci-3] &&lb_i_new_bs_put_string_II + * code[ci-2] length of string + * code[ci-1] offset into string table + * + * Since we don't know the address of the string table yet, + * just check the offset and length for validity, and use + * the instruction field as a link field to link all put_string + * instructions into a single linked list. At exit: + * + * code[ci-3] pointer to next i_new_bs_put_string instruction (or 0 + * if this is the last) + */ + Uint offset = code[ci-1]; + Uint len = code[ci-2]; + unsigned strtab_size = stp->chunks[STR_CHUNK].size; + if (offset > strtab_size || offset + len > strtab_size) { + LoadError2(stp, "invalid string reference %d, size %d", offset, len); + } + code[ci-3] = stp->new_bs_put_strings; + stp->new_bs_put_strings = ci - 3; + } + break; + case op_i_bs_match_string_rfII: + case op_i_bs_match_string_xfII: + new_string_patch(stp, ci-1); + break; + + case op_catch_yf: + /* code[ci-3] &&lb_catch_yf + * code[ci-2] y-register offset in E + * code[ci-1] label; index tagged as CATCH at runtime + */ + code[ci-3] = stp->catches; + stp->catches = ci-3; + break; + + /* + * End of code found. + */ + case op_int_code_end: + stp->code_buffer_size = code_buffer_size; + stp->ci = ci; + return 1; + } + + /* + * Delete the generic instruction just loaded. + */ + { + GenOp* next = stp->genop->next; + FREE_GENOP(stp, stp->genop); + stp->genop = next; + goto do_transform; + } + } + +#undef Need + + load_error: + return 0; +} + + +#define succ(St, X, Y) ((X).type == (Y).type && (X).val + 1 == (Y).val) +#define succ2(St, X, Y) ((X).type == (Y).type && (X).val + 2 == (Y).val) +#define succ3(St, X, Y) ((X).type == (Y).type && (X).val + 3 == (Y).val) + +#ifdef NO_FPE_SIGNALS +#define no_fpe_signals(St) 1 +#else +#define no_fpe_signals(St) 0 +#endif + +/* + * Predicate that tests whether a jump table can be used. + */ + +static int +use_jump_tab(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) +{ + Sint min, max; + Sint i; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + /* we may be called with sequences of tagged fixnums or atoms; + return early in latter case, before we access the values */ + if (Rest[0].type != TAG_i || Rest[1].type != TAG_f) + return 0; + min = max = Rest[0].val; + for (i = 2; i < Size.val; i += 2) { + if (Rest[i].type != TAG_i || Rest[i+1].type != TAG_f) { + return 0; + } + if (Rest[i].val < min) { + min = Rest[i].val; + } else if (max < Rest[i].val) { + max = Rest[i].val; + } + } + + return max - min <= Size.val; +} + +/* + * Predicate to test whether all values in a table are big numbers. + */ + +static int +all_values_are_big(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) +{ + int i; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type != TAG_q) { + return 0; + } + if (is_not_big(stp->literals[Rest[i].val].term)) { + return 0; + } + if (Rest[i+1].type != TAG_f) { + return 0; + } + } + + return 1; +} + + +/* + * Predicate to test whether all values in a table have a fixed size. + */ + +static int +fixed_size_values(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) +{ + int i; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + for (i = 0; i < Size.val; i += 2) { + if (Rest[i+1].type != TAG_f) + return 0; + switch (Rest[i].type) { + case TAG_a: + case TAG_i: + case TAG_v: + break; + case TAG_q: + return is_float(stp->literals[Rest[i].val].term); + default: + return 0; + } + } + + return 1; +} + +static int +mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) +{ + int i; + Uint type; + + if (Size.val < 2 || Size.val % 2 != 0) { + return 0; + } + + type = Rest[0].type; + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type != type) + return 1; + } + + return 0; +} + +/* + * Generate an instruction for element/2. + */ + +static GenOp* +gen_element(LoaderState* stp, GenOpArg Fail, GenOpArg Index, + GenOpArg Tuple, GenOpArg Dst) +{ + GenOp* op; + + NEW_GENOP(stp, op); + op->op = genop_i_element_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1] = Index; + op->a[2] = Tuple; + op->a[3] = Dst; + op->next = NULL; + + /* + * If safe, generate a faster instruction. + */ + + if (Index.type == TAG_i && Index.val > 0 && + (Tuple.type == TAG_r || Tuple.type == TAG_x || Tuple.type == TAG_y)) { + op->op = genop_i_fast_element_4; + op->a[1].type = TAG_u; + op->a[1].val = Index.val; + } + + return op; +} + +static GenOp* +gen_bs_save(LoaderState* stp, GenOpArg Reg, GenOpArg Index) +{ + GenOp* op; + + NEW_GENOP(stp, op); + op->op = genop_i_bs_save2_2; + op->arity = 2; + op->a[0] = Reg; + op->a[1] = Index; + if (Index.type == TAG_u) { + op->a[1].val = Index.val+1; + } else if (Index.type == TAG_a && Index.val == am_start) { + op->a[1].type = TAG_u; + op->a[1].val = 0; + } + op->next = NULL; + return op; +} + +static GenOp* +gen_bs_restore(LoaderState* stp, GenOpArg Reg, GenOpArg Index) +{ + GenOp* op; + + NEW_GENOP(stp, op); + op->op = genop_i_bs_restore2_2; + op->arity = 2; + op->a[0] = Reg; + op->a[1] = Index; + if (Index.type == TAG_u) { + op->a[1].val = Index.val+1; + } else if (Index.type == TAG_a && Index.val == am_start) { + op->a[1].type = TAG_u; + op->a[1].val = 0; + } + op->next = NULL; + return op; +} + +/* + * Generate the fastest instruction to fetch an integer from a binary. + */ + +static GenOp* +gen_get_integer2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, + GenOpArg Size, GenOpArg Unit, + GenOpArg Flags, GenOpArg Dst) +{ + GenOp* op; + Uint bits; + + NEW_GENOP(stp, op); + + NATIVE_ENDIAN(Flags); + if (Size.type == TAG_i) { + if (!safe_mul(Size.val, Unit.val, &bits)) { + goto error; + } else if ((Flags.val & BSF_SIGNED) != 0) { + goto generic; + } else if (bits == 8) { + op->op = genop_i_bs_get_integer_8_3; + op->arity = 3; + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Dst; + } else if (bits == 16 && (Flags.val & BSF_LITTLE) == 0) { + op->op = genop_i_bs_get_integer_16_3; + op->arity = 3; + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Dst; + } else if (bits == 32 && (Flags.val & BSF_LITTLE) == 0) { + op->op = genop_i_bs_get_integer_32_4; + op->arity = 4; + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Live; + op->a[3] = Dst; + } else { + generic: + if (bits < SMALL_BITS) { + op->op = genop_i_bs_get_integer_small_imm_5; + op->arity = 5; + op->a[0] = Ms; + op->a[1].type = TAG_u; + op->a[1].val = bits; + op->a[2] = Fail; + op->a[3] = Flags; + op->a[4] = Dst; + } else { + op->op = genop_i_bs_get_integer_imm_6; + op->arity = 6; + op->a[0] = Ms; + op->a[1].type = TAG_u; + op->a[1].val = bits; + op->a[2] = Live; + op->a[3] = Fail; + op->a[4] = Flags; + op->a[5] = Dst; + } + } + } else if (Size.type == TAG_q) { + Eterm big = stp->literals[Size.val].term; + Uint bigval; + + if (!term_to_Uint(big, &bigval)) { + error: + op->op = genop_jump_1; + op->arity = 1; + op->a[0] = Fail; + } else { + if (!safe_mul(bigval, Unit.val, &bits)) { + goto error; + } + goto generic; + } + } else { + GenOp* op2; + NEW_GENOP(stp, op2); + + op->op = genop_i_fetch_2; + op->arity = 2; + op->a[0] = Ms; + op->a[1] = Size; + op->next = op2; + + op2->op = genop_i_bs_get_integer_4; + op2->arity = 4; + op2->a[0] = Fail; + op2->a[1] = Live; + op2->a[2].type = TAG_u; + op2->a[2].val = (Unit.val << 3) | Flags.val; + op2->a[3] = Dst; + op2->next = NULL; + return op; + } + op->next = NULL; + return op; +} + +/* + * Generate the fastest instruction to fetch a binary from a binary. + */ + +static GenOp* +gen_get_binary2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, + GenOpArg Size, GenOpArg Unit, + GenOpArg Flags, GenOpArg Dst) +{ + GenOp* op; + NEW_GENOP(stp, op); + + NATIVE_ENDIAN(Flags); + if (Size.type == TAG_a && Size.val == am_all) { + if (Ms.type == Dst.type && Ms.val == Dst.val) { + op->op = genop_i_bs_get_binary_all_reuse_3; + op->arity = 3; + op->a[0] = Ms; + op->a[1] = Fail; + op->a[2] = Unit; + } else { + op->op = genop_i_bs_get_binary_all2_5; + op->arity = 5; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Live; + op->a[3] = Unit; + op->a[4] = Dst; + } + } else if (Size.type == TAG_i) { + op->op = genop_i_bs_get_binary_imm2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Live; + op->a[3].type = TAG_u; + if (!safe_mul(Size.val, Unit.val, &op->a[3].val)) { + goto error; + } + op->a[4] = Flags; + op->a[5] = Dst; + } else if (Size.type == TAG_q) { + Eterm big = stp->literals[Size.val].term; + Uint bigval; + + if (!term_to_Uint(big, &bigval)) { + error: + op->op = genop_jump_1; + op->arity = 1; + op->a[0] = Fail; + } else { + op->op = genop_i_bs_get_binary_imm2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Live; + op->a[3].type = TAG_u; + if (!safe_mul(bigval, Unit.val, &op->a[3].val)) { + goto error; + } + op->a[4] = Flags; + op->a[5] = Dst; + } + } else { + op->op = genop_i_bs_get_binary2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Live; + op->a[3] = Size; + op->a[4].type = TAG_u; + op->a[4].val = (Unit.val << 3) | Flags.val; + op->a[5] = Dst; + } + op->next = NULL; + return op; +} + +/* + * Predicate to test whether a heap binary should be generated. + */ + +static int +should_gen_heap_bin(LoaderState* stp, GenOpArg Src) +{ + return Src.val <= ERL_ONHEAP_BIN_LIMIT; +} + +/* + * Predicate to test whether a binary construction is too big. + */ + +static int +binary_too_big(LoaderState* stp, GenOpArg Size) +{ + return Size.type == TAG_u && ((Size.val >> (8*sizeof(Uint)-3)) != 0); +} + +static int +binary_too_big_bits(LoaderState* stp, GenOpArg Size) +{ + return Size.type == TAG_u && (((Size.val+7)/8) >> (8*sizeof(Uint)-3) != 0); +} + +#define new_float_allocation(Stp) ((Stp)->new_float_instructions) + +static GenOp* +gen_put_binary(LoaderState* stp, GenOpArg Fail,GenOpArg Size, + GenOpArg Unit, GenOpArg Flags, GenOpArg Src) +{ + GenOp* op; + NEW_GENOP(stp, op); + + NATIVE_ENDIAN(Flags); + if (Size.type == TAG_a && Size.val == am_all) { + op->op = genop_i_new_bs_put_binary_all_3; + op->arity = 3; + op->a[0] = Fail; + op->a[1] = Src; + op->a[2] = Unit; + } else if (Size.type == TAG_i) { + op->op = genop_i_new_bs_put_binary_imm_3; + op->arity = 3; + op->a[0] = Fail; + op->a[1].type = TAG_u; + if (safe_mul(Size.val, Unit.val, &op->a[1].val)) { + op->a[2] = Src; + } else { + op->op = genop_badarg_1; + op->arity = 1; + op->a[0] = Fail; + } + } else { + op->op = genop_i_new_bs_put_binary_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1] = Size; + op->a[2].type = TAG_u; + op->a[2].val = (Unit.val << 3) | (Flags.val & 7); + op->a[3] = Src; + } + + op->next = NULL; + return op; +} + +static GenOp* +gen_put_integer(LoaderState* stp, GenOpArg Fail, GenOpArg Size, + GenOpArg Unit, GenOpArg Flags, GenOpArg Src) +{ + GenOp* op; + NEW_GENOP(stp, op); + + NATIVE_ENDIAN(Flags); + if (Size.type == TAG_i && Size.val < 0) { + error: + /* Negative size must fail */ + op->op = genop_badarg_1; + op->arity = 1; + op->a[0] = Fail; + } else if (Size.type == TAG_i) { + op->op = genop_i_new_bs_put_integer_imm_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1].type = TAG_u; + if (!safe_mul(Size.val, Unit.val, &op->a[1].val)) { + goto error; + } + op->a[1].val = Size.val * Unit.val; + op->a[2].type = Flags.type; + op->a[2].val = (Flags.val & 7); + op->a[3] = Src; + } else if (Size.type == TAG_q) { + Eterm big = stp->literals[Size.val].term; + Uint bigval; + + if (!term_to_Uint(big, &bigval)) { + goto error; + } else { + op->op = genop_i_new_bs_put_integer_imm_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1].type = TAG_u; + op->a[1].val = bigval * Unit.val; + op->a[2].type = Flags.type; + op->a[2].val = (Flags.val & 7); + op->a[3] = Src; + } + } else { + op->op = genop_i_new_bs_put_integer_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1] = Size; + op->a[2].type = TAG_u; + op->a[2].val = (Unit.val << 3) | (Flags.val & 7); + op->a[3] = Src; + } + op->next = NULL; + return op; +} + +static GenOp* +gen_put_float(LoaderState* stp, GenOpArg Fail, GenOpArg Size, + GenOpArg Unit, GenOpArg Flags, GenOpArg Src) +{ + GenOp* op; + NEW_GENOP(stp, op); + + NATIVE_ENDIAN(Flags); + if (Size.type == TAG_i) { + op->op = genop_i_new_bs_put_float_imm_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1].type = TAG_u; + if (!safe_mul(Size.val, Unit.val, &op->a[1].val)) { + op->op = genop_badarg_1; + op->arity = 1; + op->a[0] = Fail; + } else { + op->a[2] = Flags; + op->a[3] = Src; + } + } else { + op->op = genop_i_new_bs_put_float_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1] = Size; + op->a[2].type = TAG_u; + op->a[2].val = (Unit.val << 3) | (Flags.val & 7); + op->a[3] = Src; + } + op->next = NULL; + return op; +} + +/* + * Generate an instruction to fetch a float from a binary. + */ + +static GenOp* +gen_get_float2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, GenOpArg Live, + GenOpArg Size, GenOpArg Unit, GenOpArg Flags, GenOpArg Dst) +{ + GenOp* op; + NEW_GENOP(stp, op); + + NATIVE_ENDIAN(Flags); + op->op = genop_i_bs_get_float2_6; + op->arity = 6; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Live; + op->a[3] = Size; + op->a[4].type = TAG_u; + op->a[4].val = (Unit.val << 3) | Flags.val; + op->a[5] = Dst; + op->next = NULL; + return op; +} + +/* + * Generate the fastest instruction for bs_skip_bits. + */ + +static GenOp* +gen_skip_bits2(LoaderState* stp, GenOpArg Fail, GenOpArg Ms, + GenOpArg Size, GenOpArg Unit, GenOpArg Flags) +{ + GenOp* op; + + NATIVE_ENDIAN(Flags); + NEW_GENOP(stp, op); + if (Size.type == TAG_a && Size.val == am_all) { + op->op = genop_i_bs_skip_bits_all2_3; + op->arity = 3; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Unit; + } else if (Size.type == TAG_i) { + op->op = genop_i_bs_skip_bits_imm2_3; + op->arity = 3; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2].type = TAG_u; + if (!safe_mul(Size.val, Unit.val, &op->a[2].val)) { + goto error; + } + } else if (Size.type == TAG_q) { + Eterm big = stp->literals[Size.val].term; + Uint bigval; + + if (!term_to_Uint(big, &bigval)) { + error: + op->op = genop_jump_1; + op->arity = 1; + op->a[0] = Fail; + } else { + op->op = genop_i_bs_skip_bits_imm2_3; + op->arity = 3; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2].type = TAG_u; + if (!safe_mul(bigval, Unit.val, &op->a[2].val)) { + goto error; + } + } + } else { + op->op = genop_i_bs_skip_bits2_4; + op->arity = 4; + op->a[0] = Fail; + op->a[1] = Ms; + op->a[2] = Size; + op->a[3] = Unit; + } + op->next = NULL; + return op; +} + +static int +smp(LoaderState* stp) +{ +#ifdef ERTS_SMP + return 1; +#else + return 0; +#endif +} + +/* + * Mark this label. + */ +static int +smp_mark_target_label(LoaderState* stp, GenOpArg L) +{ +#ifdef ERTS_SMP + ASSERT(L.type == TAG_f); + stp->labels[L.val].looprec_targeted = 1; +#endif + return 1; +} + +/* + * Test whether this label was targeted by a loop_rec/2 instruction. + */ + +static int +smp_already_locked(LoaderState* stp, GenOpArg L) +{ +#ifdef ERTS_SMP + ASSERT(L.type == TAG_u); + return stp->labels[L.val].looprec_targeted; +#else + return 0; +#endif +} + +/* + * Generate a timeout instruction for a literal timeout. + */ + +static GenOp* +gen_literal_timeout(LoaderState* stp, GenOpArg Fail, GenOpArg Time) +{ + GenOp* op; + Sint timeout; + + NEW_GENOP(stp, op); + op->op = genop_i_wait_timeout_2; + op->next = NULL; + op->arity = 2; + op->a[0] = Fail; + op->a[1].type = TAG_u; + + if (Time.type == TAG_i && (timeout = Time.val) >= 0 && +#ifdef ARCH_64 + (timeout >> 32) == 0 +#else + 1 +#endif + ) { + op->a[1].val = timeout; +#if !defined(ARCH_64) + } else if (Time.type == TAG_q) { + Eterm big; + + big = stp->literals[Time.val].term; + if (is_not_big(big)) { + goto error; + } + if (big_arity(big) > 1 || big_sign(big)) { + goto error; + } else { + (void) term_to_Uint(big, &op->a[1].val); + } +#endif + } else { +#if !defined(ARCH_64) + error: +#endif + op->op = genop_i_wait_error_0; + op->arity = 0; + } + return op; +} + +static GenOp* +gen_literal_timeout_locked(LoaderState* stp, GenOpArg Fail, GenOpArg Time) +{ + GenOp* op; + Sint timeout; + + NEW_GENOP(stp, op); + op->op = genop_i_wait_timeout_locked_2; + op->next = NULL; + op->arity = 2; + op->a[0] = Fail; + op->a[1].type = TAG_u; + + if (Time.type == TAG_i && (timeout = Time.val) >= 0 && +#ifdef ARCH_64 + (timeout >> 32) == 0 +#else + 1 +#endif + ) { + op->a[1].val = timeout; +#ifndef ARCH_64 + } else if (Time.type == TAG_q) { + Eterm big; + + big = stp->literals[Time.val].term; + if (is_not_big(big)) { + goto error; + } + if (big_arity(big) > 1 || big_sign(big)) { + goto error; + } else { + (void) term_to_Uint(big, &op->a[1].val); + } +#endif + } else { +#ifndef ARCH_64 + error: +#endif + op->op = genop_i_wait_error_locked_0; + op->arity = 0; + } + return op; +} + +/* + * Tag the list of values with tuple arity tags. + */ + +static GenOp* +gen_select_tuple_arity(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest) + +{ + GenOp* op; + int arity = Size.val + 3; + int size = Size.val / 2; + int i; + + /* + * Verify the validity of the list. + */ + + if (Size.val % 2 != 0) + return NULL; + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type != TAG_u || Rest[i+1].type != TAG_f) { + return NULL; + } + } + + /* + * Generate the generic instruction. + */ + + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_i_select_tuple_arity_3; + GENOP_ARITY(op, arity); + op->a[0] = S; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = Size.val / 2; + for (i = 0; i < Size.val; i += 2) { + op->a[i+3].type = TAG_v; + op->a[i+3].val = make_arityval(Rest[i].val); + op->a[i+4] = Rest[i+1]; + } + + /* + * Sort the values to make them useful for a binary search. + */ + + qsort(op->a+3, size, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genopargcompare); +#ifdef DEBUG + for (i = 3; i < arity-2; i += 2) { + ASSERT(op->a[i].val < op->a[i+2].val); + } +#endif + return op; +} + +/* + * Split a list consisting of both small and bignumbers into two + * select_val instructions. + */ + +static GenOp* +gen_split_values(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest) + +{ + GenOp* op1; + GenOp* op2; + GenOp* label; + Uint type; + int i; + + ASSERT(Size.val >= 2 && Size.val % 2 == 0); + + NEW_GENOP(stp, label); + label->op = genop_label_1; + label->arity = 1; + label->a[0].type = TAG_u; + label->a[0].val = new_label(stp); + + NEW_GENOP(stp, op1); + op1->op = genop_select_val_3; + GENOP_ARITY(op1, 3 + Size.val); + op1->arity = 3; + op1->a[0] = S; + op1->a[1].type = TAG_f; + op1->a[1].val = label->a[0].val; + op1->a[2].type = TAG_u; + op1->a[2].val = 0; + + NEW_GENOP(stp, op2); + op2->op = genop_select_val_3; + GENOP_ARITY(op2, 3 + Size.val); + op2->arity = 3; + op2->a[0] = S; + op2->a[1] = Fail; + op2->a[2].type = TAG_u; + op2->a[2].val = 0; + + op1->next = label; + label->next = op2; + op2->next = NULL; + + type = Rest[0].type; + + ASSERT(Size.type == TAG_u); + for (i = 0; i < Size.val; i += 2) { + GenOp* op = (Rest[i].type == type) ? op1 : op2; + int dst = 3 + op->a[2].val; + + ASSERT(Rest[i+1].type == TAG_f); + op->a[dst] = Rest[i]; + op->a[dst+1] = Rest[i+1]; + op->arity += 2; + op->a[2].val += 2; + } + + /* + * None of the instructions should have zero elements in the list. + */ + + ASSERT(op1->a[2].val > 0); + ASSERT(op2->a[2].val > 0); + + return op1; +} + +/* + * Generate a jump table. + */ + +static GenOp* +gen_jump_tab(LoaderState* stp, GenOpArg S, GenOpArg Fail, GenOpArg Size, GenOpArg* Rest) +{ + Sint min, max; + Sint i; + Sint size; + Sint arity; + int fixed_args; + GenOp* op; + + ASSERT(Size.val >= 2 && Size.val % 2 == 0); + + /* + * Calculate the minimum and maximum values and size of jump table. + */ + + ASSERT(Rest[0].type == TAG_i); + min = max = Rest[0].val; + for (i = 2; i < Size.val; i += 2) { + ASSERT(Rest[i].type == TAG_i && Rest[i+1].type == TAG_f); + if (Rest[i].val < min) { + min = Rest[i].val; + } else if (max < Rest[i].val) { + max = Rest[i].val; + } + } + size = max - min + 1; + + + /* + * Allocate structure and fill in the fixed fields. + */ + + NEW_GENOP(stp, op); + op->next = NULL; + if (min == 0) { + op->op = genop_i_jump_on_val_zero_3; + fixed_args = 3; + } else { + op->op = genop_i_jump_on_val_4; + fixed_args = 4; + } + arity = fixed_args + size; + GENOP_ARITY(op, arity); + op->a[0] = S; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + op->a[3].type = TAG_u; + op->a[3].val = min; + + + /* + * Fill in the jump table. + */ + + for (i = fixed_args; i < arity; i++) { + op->a[i] = Fail; + } + for (i = 0; i < Size.val; i += 2) { + int index; + index = fixed_args+Rest[i].val-min; + ASSERT(fixed_args <= index && index < arity); + op->a[index] = Rest[i+1]; + } + return op; +} + +/* + * Compare function for qsort(). + */ + +static int +genopargcompare(GenOpArg* a, GenOpArg* b) +{ + if (a->val < b->val) + return -1; + else if (a->val == b->val) + return 0; + else + return 1; +} + +/* + * Generate a select_val instruction. We know that a jump table is not suitable, + * and that all values are of the same type (integer, atoms, floats; never bignums). + */ + +static GenOp* +gen_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest) +{ + GenOp* op; + int arity = Size.val + 3; + int size = Size.val / 2; + int i; + + NEW_GENOP(stp, op); + op->next = NULL; + if (Rest[0].type != TAG_q) { + op->op = genop_i_select_val_3; + } else { + ASSERT(is_float(stp->literals[Rest[0].val].term)); + op->op = genop_i_select_float_3; + } + GENOP_ARITY(op, arity); + op->a[0] = S; + op->a[1] = Fail; + op->a[2].type = TAG_u; + op->a[2].val = size; + for (i = 3; i < arity; i++) { + op->a[i] = Rest[i-3]; + } + + /* + * Sort the values to make them useful for a binary search. + */ + + qsort(op->a+3, size, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genopargcompare); +#ifdef DEBUG + for (i = 3; i < arity-2; i += 2) { + ASSERT(op->a[i].val < op->a[i+2].val); + } +#endif + + return op; +} + +/* + * Compare function for qsort(). + */ + +static int +genbigcompare(GenOpArg* a, GenOpArg* b) +{ + int val = (int)(b->bigarity - a->bigarity); + + return val != 0 ? val : ((int) (a->val - b->val)); +} + +/* + * Generate a select_val instruction for big numbers. + */ + +static GenOp* +gen_select_big(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest) +{ + GenOp* op; + int arity = Size.val + 2 + 1; + int size = Size.val / 2; + int i; + + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_i_select_big_2; + GENOP_ARITY(op, arity); + op->a[0] = S; + op->a[1] = Fail; + for (i = 0; i < Size.val; i += 2) { + ASSERT(Rest[i].type == TAG_q); + op->a[i+2] = Rest[i]; + op->a[i+2].bigarity = *big_val(stp->literals[op->a[i+2].val].term); + op->a[i+3] = Rest[i+1]; + } + ASSERT(i+2 == arity-1); + op->a[arity-1].type = TAG_u; + op->a[arity-1].val = 0; + + /* + * Sort the values in descending arity order. + */ + + qsort(op->a+2, size, 2*sizeof(GenOpArg), + (int (*)(const void *, const void *)) genbigcompare); + + return op; +} + + +/* + * Replace a select_val instruction with a constant controlling expression + * with a jump instruction. + */ + +static GenOp* +const_select_val(LoaderState* stp, GenOpArg S, GenOpArg Fail, + GenOpArg Size, GenOpArg* Rest) +{ + GenOp* op; + int i; + + ASSERT(Size.type == TAG_u); + ASSERT(S.type == TAG_q); + + NEW_GENOP(stp, op); + op->next = NULL; + op->op = genop_jump_1; + op->arity = 1; + + /* + * Search for a literal matching the controlling expression. + */ + + if (S.type == TAG_q) { + Eterm expr = stp->literals[S.val].term; + for (i = 0; i < Size.val; i += 2) { + if (Rest[i].type == TAG_q) { + Eterm term = stp->literals[Rest[i].val].term; + if (eq(term, expr)) { + ASSERT(Rest[i+1].type == TAG_f); + op->a[0] = Rest[i+1]; + return op; + } + } + } + } + + /* + * No match. Use the failure label. + */ + + op->a[0] = Fail; + return op; +} + + +static GenOp* +gen_func_info(LoaderState* stp, GenOpArg mod, GenOpArg func, + GenOpArg arity, GenOpArg label) +{ + GenOp* fi; + GenOp* op; + + NEW_GENOP(stp, fi); + fi->op = genop_i_func_info_4; + fi->arity = 4; + fi->a[0].type = TAG_u; /* untagged Zero */ + fi->a[0].val = 0; + fi->a[1] = mod; + fi->a[2] = func; + fi->a[3] = arity; + + NEW_GENOP(stp, op); + op->op = genop_label_1; + op->arity = 1; + op->a[0] = label; + + fi->next = op; + op->next = NULL; + + return fi; +} + + + +static GenOp* +gen_make_fun2(LoaderState* stp, GenOpArg idx) +{ + ErlFunEntry* fe; + GenOp* op; + + if (idx.val >= stp->num_lambdas) { + stp->lambda_error = "missing or short chunk 'FunT'"; + fe = 0; + } else { + fe = stp->lambdas[idx.val].fe; + } + + NEW_GENOP(stp, op); + op->op = genop_i_make_fun_2; + op->arity = 2; + op->a[0].type = TAG_u; + op->a[0].val = (Uint) fe; + op->a[1].type = TAG_u; + op->a[1].val = stp->lambdas[idx.val].num_free; + op->next = NULL; + return op; +} + +static GenOp* +gen_guard_bif(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, + GenOpArg Src, GenOpArg Dst) +{ + GenOp* op; + BifFunction bf; + + NEW_GENOP(stp, op); + op->op = genop_i_gc_bif1_5; + op->arity = 5; + op->a[0] = Fail; + op->a[1].type = TAG_u; + bf = stp->import[Bif.val].bf; + if (bf == length_1) { + op->a[1].val = (Uint) (void *) erts_gc_length_1; + } else if (bf == size_1) { + op->a[1].val = (Uint) (void *) erts_gc_size_1; + } else if (bf == bit_size_1) { + op->a[1].val = (Uint) (void *) erts_gc_bit_size_1; + } else if (bf == byte_size_1) { + op->a[1].val = (Uint) (void *) erts_gc_byte_size_1; + } else if (bf == abs_1) { + op->a[1].val = (Uint) (void *) erts_gc_abs_1; + } else if (bf == float_1) { + op->a[1].val = (Uint) (void *) erts_gc_float_1; + } else if (bf == round_1) { + op->a[1].val = (Uint) (void *) erts_gc_round_1; + } else if (bf == trunc_1) { + op->a[1].val = (Uint) (void *) erts_gc_trunc_1; + } else { + abort(); + } + op->a[2] = Src; + op->a[3] = Live; + op->a[4] = Dst; + op->next = NULL; + return op; +} + + +/* + * Freeze the code in memory, move the string table into place, + * resolve all labels. + */ + +static int +freeze_code(LoaderState* stp) +{ + Eterm* code = stp->code; + Uint index; + int i; + byte* str_table; + unsigned strtab_size = stp->chunks[STR_CHUNK].size; + unsigned attr_size = stp->chunks[ATTR_CHUNK].size; + unsigned compile_size = stp->chunks[COMPILE_CHUNK].size; + Uint size; + unsigned catches; + Sint decoded_size; + + /* + * Verify that there was a correct 'FunT' chunk if there were + * make_fun2 instructions in the file. + */ + + if (stp->lambda_error != NULL) { + LoadError0(stp, stp->lambda_error); + } + + + /* + * Calculate the final size of the code. + */ + + size = (stp->ci + stp->total_literal_size) * sizeof(Eterm) + + strtab_size + attr_size + compile_size; + + /* + * Move the code to its final location. + */ + + code = (Eterm *) erts_realloc(ERTS_ALC_T_CODE, (void *) code, size); + + /* + * Place a pointer to the op_int_code_end instruction in the + * function table in the beginning of the file. + */ + + code[MI_FUNCTIONS+stp->num_functions] = (Eterm) (code + stp->ci - 1); + + /* + * Store the pointer to the on_load function. + */ + + if (stp->on_load) { + code[MI_ON_LOAD_FUNCTION_PTR] = (Eterm) (code + stp->on_load); + } else { + code[MI_ON_LOAD_FUNCTION_PTR] = 0; + } + + /* + * Place the literal heap directly after the code and fix up all + * put_literal instructions that refer to it. + */ + { + Eterm* ptr; + Eterm* low; + Eterm* high; + LiteralPatch* lp; + + low = code+stp->ci; + high = low + stp->total_literal_size; + code[MI_LITERALS_START] = (Eterm) low; + code[MI_LITERALS_END] = (Eterm) high; + ptr = low; + for (i = 0; i < stp->num_literals; i++) { + Uint offset; + + sys_memcpy(ptr, stp->literals[i].heap, + stp->literals[i].heap_size*sizeof(Eterm)); + offset = ptr - stp->literals[i].heap; + stp->literals[i].offset = offset; + high = ptr + stp->literals[i].heap_size; + while (ptr < high) { + Eterm val = *ptr; + switch (primary_tag(val)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + *ptr++ = offset_ptr(val, offset); + break; + case TAG_PRIMARY_HEADER: + ptr++; + if (header_is_thing(val)) { + ptr += thing_arityval(val); + } + break; + default: + ptr++; + break; + } + } + ASSERT(ptr == high); + } + lp = stp->literal_patches; + while (lp != 0) { + Uint* op_ptr; + Uint literal; + Literal* lit; + + op_ptr = code + lp->pos; + lit = &stp->literals[op_ptr[0]]; + literal = lit->term; + if (is_boxed(literal) || is_list(literal)) { + literal = offset_ptr(literal, lit->offset); + } + op_ptr[0] = literal; + lp = lp->next; + } + stp->ci += stp->total_literal_size; + } + + /* + * Place the string table and, optionally, attributes, after the literal heap. + */ + + sys_memcpy(code+stp->ci, stp->chunks[STR_CHUNK].start, strtab_size); + str_table = (byte *) (code+stp->ci); + if (attr_size) { + byte* attr = str_table + strtab_size; + sys_memcpy(attr, stp->chunks[ATTR_CHUNK].start, stp->chunks[ATTR_CHUNK].size); + code[MI_ATTR_PTR] = (Eterm) attr; + code[MI_ATTR_SIZE] = (Eterm) stp->chunks[ATTR_CHUNK].size; + decoded_size = erts_decode_ext_size(attr, attr_size, 0); + if (decoded_size < 0) { + LoadError0(stp, "bad external term representation of module attributes"); + } + code[MI_ATTR_SIZE_ON_HEAP] = decoded_size; + } + if (compile_size) { + byte* compile_info = str_table + strtab_size + attr_size; + sys_memcpy(compile_info, stp->chunks[COMPILE_CHUNK].start, + stp->chunks[COMPILE_CHUNK].size); + code[MI_COMPILE_PTR] = (Eterm) compile_info; + code[MI_COMPILE_SIZE] = (Eterm) stp->chunks[COMPILE_CHUNK].size; + decoded_size = erts_decode_ext_size(compile_info, compile_size, 0); + if (decoded_size < 0) { + LoadError0(stp, "bad external term representation of compilation information"); + } + code[MI_COMPILE_SIZE_ON_HEAP] = decoded_size; + } + + + /* + * Go through all put_strings instructions, restore the pointer to + * the instruction and convert string offsets to pointers (to the + * LAST character). + */ + + index = stp->put_strings; + while (index != 0) { + Uint next = code[index]; + code[index] = BeamOpCode(op_put_string_IId); + code[index+2] = (Uint) (str_table + code[index+2] + code[index+1] - 1); + index = next; + } + + /* + * Go through all i_new_bs_put_strings instructions, restore the pointer to + * the instruction and convert string offsets to pointers (to the + * FIRST character). + */ + + index = stp->new_bs_put_strings; + while (index != 0) { + Uint next = code[index]; + code[index] = BeamOpCode(op_bs_put_string_II); + code[index+2] = (Uint) (str_table + code[index+2]); + index = next; + } + + { + StringPatch* sp = stp->string_patches; + + while (sp != 0) { + Uint* op_ptr; + byte* strp; + + op_ptr = code + sp->pos; + strp = str_table + op_ptr[0]; + op_ptr[0] = (Eterm) strp; + sp = sp->next; + } + } + + /* + * Resolve all labels. + */ + + for (i = 0; i < stp->num_labels; i++) { + Uint this_patch; + Uint next_patch; + Uint value = stp->labels[i].value; + + if (value == 0 && stp->labels[i].patches != 0) { + LoadError1(stp, "label %d not resolved", i); + } + ASSERT(value < stp->ci); + this_patch = stp->labels[i].patches; + while (this_patch != 0) { + ASSERT(this_patch < stp->ci); + next_patch = code[this_patch]; + ASSERT(next_patch < stp->ci); + code[this_patch] = (Uint) (code + value); + this_patch = next_patch; + } + } + + /* + * Fix all catch_yf instructions. + */ + index = stp->catches; + catches = BEAM_CATCHES_NIL; + while (index != 0) { + Uint next = code[index]; + code[index] = BeamOpCode(op_catch_yf); + catches = beam_catches_cons((Uint*)code[index+2], catches); + code[index+2] = make_catch(catches); + index = next; + } + stp->catches = catches; + + /* + * Save the updated code pointer and code size. + */ + + stp->code = code; + stp->loaded_size = size; + + return 1; + + load_error: + /* + * Make sure that the caller frees the newly reallocated block, and + * not the old one (in case it has moved). + */ + stp->code = code; + return 0; +} + + +static void +final_touch(LoaderState* stp) +{ + int i; + int on_load = stp->on_load; + + /* + * Export functions. + */ + + for (i = 0; i < stp->num_exps; i++) { + Export* ep = erts_export_put(stp->module, stp->export[i].function, + stp->export[i].arity); + if (!on_load) { + ep->address = stp->export[i].address; + } else { + /* + * Don't make any of the exported functions + * callable yet. + */ + ep->address = ep->code+3; + ep->code[4] = (Eterm) stp->export[i].address; + } + } + + /* + * Import functions and patch all callers. + */ + + for (i = 0; i < stp->num_imports; i++) { + Eterm mod; + Eterm func; + Uint arity; + Uint import; + Uint current; + Uint next; + + mod = stp->import[i].module; + func = stp->import[i].function; + arity = stp->import[i].arity; + import = (Uint) erts_export_put(mod, func, arity); + current = stp->import[i].patches; + while (current != 0) { + ASSERT(current < stp->ci); + next = stp->code[current]; + stp->code[current] = import; + current = next; + } + } + + /* + * Fix all funs. + */ + + if (stp->num_lambdas > 0) { + for (i = 0; i < stp->num_lambdas; i++) { + unsigned entry_label = stp->lambdas[i].label; + ErlFunEntry* fe = stp->lambdas[i].fe; + Eterm* code_ptr = (Eterm *) (stp->code + stp->labels[entry_label].value); + + if (fe->address[0] != 0) { + /* + * We are hiding a pointer into older code. + */ + erts_refc_dec(&fe->refc, 1); + } + fe->address = code_ptr; +#ifdef HIPE + hipe_set_closure_stub(fe, stp->lambdas[i].num_free); +#endif + } + } +} + + +static int +transform_engine(LoaderState* st) +{ + Uint op; + int ap; /* Current argument. */ + Uint* restart; /* Where to restart if current match fails. */ + GenOpArg def_vars[TE_MAX_VARS]; /* Default buffer for variables. */ + GenOpArg* var = def_vars; + int i; /* General index. */ + Uint mask; + GenOp* instr; + Uint* pc; + int rval; + + ASSERT(gen_opc[st->genop->op].transform != -1); + pc = op_transform + gen_opc[st->genop->op].transform; + restart = pc; + + restart: + if (var != def_vars) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); + var = def_vars; + } + ASSERT(restart != NULL); + pc = restart; + ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ + ASSERT(*pc == TOP_try_me_else || *pc == TOP_fail); + instr = st->genop; + +#define RETURN(r) rval = (r); goto do_return; + +#ifdef DEBUG + restart = NULL; +#endif + ap = 0; + for (;;) { + op = *pc++; + + switch (op) { + case TOP_is_op: + if (instr == NULL) { + /* + * We'll need at least one more instruction to decide whether + * this combination matches or not. + */ + RETURN(TE_SHORT_WINDOW); + } + if (*pc++ != instr->op) + goto restart; + break; + case TOP_is_type: + mask = *pc++; + + ASSERT(ap < instr->arity); + ASSERT(instr->a[ap].type < BEAM_NUM_TAGS); + if (((1 << instr->a[ap].type) & mask) == 0) + goto restart; + break; + case TOP_pred: + i = *pc++; + switch (i) { +#define RVAL i +#include "beam_pred_funcs.h" +#undef RVAL + default: + ASSERT(0); + } + if (i == 0) + goto restart; + break; + case TOP_is_eq: + ASSERT(ap < instr->arity); + if (*pc++ != instr->a[ap].val) + goto restart; + break; + case TOP_is_same_var: + ASSERT(ap < instr->arity); + i = *pc++; + ASSERT(i < TE_MAX_VARS); + if (var[i].type != instr->a[ap].type) + goto restart; + switch (var[i].type) { + case TAG_r: case TAG_n: break; + default: + if (var[i].val != instr->a[ap].val) + goto restart; + } + break; +#if defined(TOP_is_bif) + case TOP_is_bif: + { + int bif_number = *pc++; + + /* + * In debug build, the type must be 'u'. + * In a real build, don't match. (I.e. retain the original + * call instruction, this will work, but it will be a + * slight performance loss.) + */ + + ASSERT(instr->a[ap].type == TAG_u); + if (instr->a[ap].type != TAG_u) + goto restart; + + /* + * In debug build, the assertion will catch invalid indexes + * immediately. In a real build, the loader will issue + * an diagnostic later when the instruction is loaded. + */ + + i = instr->a[ap].val; + ASSERT(i < st->num_imports); + if (i >= st->num_imports || st->import[i].bf == NULL) + goto restart; + if (bif_number != -1 && + bif_export[bif_number]->code[4] != (Uint) st->import[i].bf) { + goto restart; + } + } + break; + +#endif +#if defined(TOP_is_not_bif) + case TOP_is_not_bif: + { + pc++; + + /* + * In debug build, the type must be 'u'. + */ + + ASSERT(instr->a[ap].type == TAG_u); + if (instr->a[ap].type != TAG_u) { + goto restart; + } + i = instr->a[ap].val; + + /* + * erlang:apply/2,3 are strange. They exist as (dummy) BIFs + * so that they are included in the export table before + * the erlang module is loaded. They also exist in the erlang + * module as functions. When used in code, a special Beam + * instruction is used. + * + * Below we specially recognize erlang:apply/2,3 as special. + * This is necessary because after setting a trace pattern on + * them, you cannot no longer see from the export entry that + * they are special. + */ + if (i < st->num_imports) { + if (st->import[i].bf != NULL || + (st->import[i].module == am_erlang && + st->import[i].function == am_apply && + (st->import[i].arity == 2 || st->import[i].arity == 3))) { + goto restart; + } + } + } + break; + +#endif +#if defined(TOP_is_func) + case TOP_is_func: + { + Eterm mod = *pc++; + Eterm func = *pc++; + int arity = *pc++; + + ASSERT(instr->a[ap].type == TAG_u); + if (instr->a[ap].type != TAG_u) { + goto restart; + } + i = instr->a[ap].val; + ASSERT(i < st->num_imports); + if (i >= st->num_imports || st->import[i].module != mod || + st->import[i].function != func || + (arity < MAX_ARG && st->import[i].arity != arity)) { + goto restart; + } + } + break; +#endif + case TOP_set_var_next_arg: + ASSERT(ap < instr->arity); + i = *pc++; + ASSERT(i < TE_MAX_VARS); + var[i].type = instr->a[ap].type; + var[i].val = instr->a[ap].val; + ap++; + break; + +#if defined(TOP_rest_args) + case TOP_rest_args: + { + int n = *pc++; + var = erts_alloc(ERTS_ALC_T_LOADER_TMP, + instr->arity * sizeof(GenOpArg)); + for (i = 0; i < n; i++) { + var[i] = def_vars[i]; + } + while (i < instr->arity) { + var[i] = instr->a[i]; + i++; + } + } + break; +#endif + + case TOP_next_arg: + ap++; + break; + case TOP_next_instr: + instr = instr->next; + ap = 0; + break; + case TOP_commit: + instr = instr->next; /* The next_instr was optimized away. */ + + /* + * The left-hand side of this transformation matched. + * Delete all matched instructions. + */ + while (st->genop != instr) { + GenOp* next = st->genop->next; + FREE_GENOP(st, st->genop); + st->genop = next; + } +#ifdef DEBUG + instr = 0; +#endif + break; + +#if defined(TOP_call) + case TOP_call: + { + GenOp** lastp; + GenOp* new_instr; + + i = *pc++; + switch (i) { +#define RVAL new_instr +#include "beam_tr_funcs.h" +#undef RVAL + default: + new_instr = NULL; /* Silence compiler warning. */ + ASSERT(0); + } + if (new_instr == NULL) { + goto restart; + } + + lastp = &new_instr; + while (*lastp != NULL) { + lastp = &((*lastp)->next); + } + + instr = instr->next; /* The next_instr was optimized away. */ + + /* + * The left-hand side of this transformation matched. + * Delete all matched instructions. + */ + while (st->genop != instr) { + GenOp* next = st->genop->next; + FREE_GENOP(st, st->genop); + st->genop = next; + } + *lastp = st->genop; + st->genop = new_instr; + } + break; +#endif + case TOP_new_instr: + /* + * Note that the instructions are generated in reverse order. + */ + NEW_GENOP(st, instr); + instr->next = st->genop; + st->genop = instr; + ap = 0; + break; + case TOP_store_op: + instr->op = *pc++; + instr->arity = *pc++; + break; + case TOP_store_type: + i = *pc++; + instr->a[ap].type = i; + instr->a[ap].val = 0; + break; + case TOP_store_val: + i = *pc++; + instr->a[ap].val = i; + break; + case TOP_store_var: + i = *pc++; + ASSERT(i < TE_MAX_VARS); + instr->a[ap].type = var[i].type; + instr->a[ap].val = var[i].val; + break; + case TOP_try_me_else: + restart = pc + 1; + restart += *pc++; + ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ + break; + case TOP_end: + RETURN(TE_OK); + case TOP_fail: + RETURN(TE_FAIL) + default: + ASSERT(0); + } + } +#undef RETURN + + do_return: + if (var != def_vars) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); + } + return rval; +} + + +static void +short_file(int line, LoaderState* stp, unsigned needed) +{ + load_printf(line, stp, "unexpected end of %s when reading %d byte(s)", + stp->file_name, needed); +} + + +static void +load_printf(int line, LoaderState* context, char *fmt,...) +{ + erts_dsprintf_buf_t *dsbufp; + va_list va; + + if (is_non_value(context->module)) { + /* Suppressed by code:get_chunk/2 */ + return; + } + + dsbufp = erts_create_logger_dsbuf(); + + erts_dsprintf(dsbufp, "%s(%d): Error loading ", __FILE__, line); + + if (is_atom(context->function)) + erts_dsprintf(dsbufp, "function %T:%T/%d", context->module, + context->function, context->arity); + else + erts_dsprintf(dsbufp, "module %T", context->module); + + if (context->genop) + erts_dsprintf(dsbufp, ": op %s", gen_opc[context->genop->op].name); + + if (context->specific_op != -1) + erts_dsprintf(dsbufp, ": %s", opc[context->specific_op].sign); + else if (context->genop) { + int i; + for (i = 0; i < context->genop->arity; i++) + erts_dsprintf(dsbufp, " %c", + tag_to_letter[context->genop->a[i].type]); + } + + erts_dsprintf(dsbufp, ":\n "); + + va_start(va, fmt); + erts_vdsprintf(dsbufp, fmt, va); + va_end(va); + + erts_dsprintf(dsbufp, "\n"); +#ifdef DEBUG + erts_fprintf(stderr, "%s", dsbufp->str); +#endif + erts_send_error_to_logger(context->group_leader, dsbufp); +} + + +static int +get_int_val(LoaderState* stp, Uint len_code, Uint* result) +{ + Uint count; + Uint val; + + len_code >>= 5; + ASSERT(len_code < 8); + if (len_code == 7) { + LoadError0(stp, "can't load integers bigger than 8 bytes yet\n"); + } + count = len_code + 2; + if (count == 5) { + Uint msb; + GetByte(stp, msb); + if (msb == 0) { + count--; + } + GetInt(stp, 4, *result); + } else if (count <= 4) { + GetInt(stp, count, val); + *result = ((val << 8*(sizeof(val)-count)) >> 8*(sizeof(val)-count)); + } else { + LoadError1(stp, "too big integer; %d bytes\n", count); + } + return 1; + + load_error: + return 0; +} + + +static int +get_erlang_integer(LoaderState* stp, Uint len_code, Uint* result) +{ + Uint count; + Sint val; + byte default_buf[128]; + byte* bigbuf = default_buf; + byte* s; + int i; + int neg = 0; + Uint arity; + Eterm* hp; + + /* + * Retrieve the size of the value in bytes. + */ + + len_code >>= 5; + if (len_code < 7) { + count = len_code + 2; + } else { + Uint tag; + + ASSERT(len_code == 7); + GetTagAndValue(stp, tag, len_code); + VerifyTag(stp, TAG_u, tag); + count = len_code + 9; + } + + /* + * Handle values up to the size of an int, meaning either a small or bignum. + */ + + if (count <= sizeof(val)) { + GetInt(stp, count, val); + + val = ((val << 8*(sizeof(val)-count)) >> 8*(sizeof(val)-count)); + if (IS_SSMALL(val)) { + *result = val; + return TAG_i; + } else { + *result = new_literal(stp, &hp, BIG_UINT_HEAP_SIZE); + (void) small_to_big(val, hp); + return TAG_q; + } + } + + /* + * Make sure that the number will fit in our temporary buffer + * (including margin). + */ + + if (count+8 > sizeof(default_buf)) { + bigbuf = erts_alloc(ERTS_ALC_T_LOADER_TMP, count+8); + } + + /* + * Copy the number reversed to our temporary buffer. + */ + + GetString(stp, s, count); + for (i = 0; i < count; i++) { + bigbuf[count-i-1] = *s++; + } + + /* + * Check if the number is negative, and negate it if so. + */ + + if ((bigbuf[count-1] & 0x80) != 0) { + unsigned carry = 1; + + neg = 1; + for (i = 0; i < count; i++) { + bigbuf[i] = ~bigbuf[i] + carry; + carry = (bigbuf[i] == 0 && carry == 1); + } + ASSERT(carry == 0); + } + + /* + * Align to word boundary. + */ + + if (bigbuf[count-1] == 0) { + count--; + } + if (bigbuf[count-1] == 0) { + LoadError0(stp, "bignum not normalized"); + } + while (count % sizeof(Eterm) != 0) { + bigbuf[count++] = 0; + } + + /* + * Allocate heap space for the bignum and copy it. + */ + + arity = count/sizeof(Eterm); + *result = new_literal(stp, &hp, arity+1); + (void) bytes_to_big(bigbuf, count, neg, hp); + + if (bigbuf != default_buf) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf); + } + return TAG_q; + + load_error: + if (bigbuf != default_buf) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) bigbuf); + } + return -1; +} + +/* + * Converts an IFF id to a printable string. + */ + +static void +id_to_string(Uint id, char* s) +{ + int i; + + for (i = 3; i >= 0; i--) { + *s++ = (id >> i*8) & 0xff; + } + *s++ = '\0'; +} + +static void +new_genop(LoaderState* stp) +{ + GenOpBlock* p = (GenOpBlock *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + sizeof(GenOpBlock)); + int i; + + p->next = stp->genop_blocks; + stp->genop_blocks = p; + for (i = 0; i < sizeof(p->genop)/sizeof(p->genop[0])-1; i++) { + p->genop[i].next = p->genop + i + 1; + } + p->genop[i].next = NULL; + stp->free_genop = p->genop; +} + +static int +new_label(LoaderState* stp) +{ + int num = stp->num_labels; + + stp->num_labels++; + stp->labels = (Label *) erts_realloc(ERTS_ALC_T_LOADER_TMP, + (void *) stp->labels, + stp->num_labels * sizeof(Label)); + stp->labels[num].value = 0; + stp->labels[num].patches = 0; + return num; +} + +static void +new_literal_patch(LoaderState* stp, int pos) +{ + LiteralPatch* p = erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(LiteralPatch)); + p->pos = pos; + p->next = stp->literal_patches; + stp->literal_patches = p; +} + +static void +new_string_patch(LoaderState* stp, int pos) +{ + StringPatch* p = erts_alloc(ERTS_ALC_T_LOADER_TMP, sizeof(StringPatch)); + p->pos = pos; + p->next = stp->string_patches; + stp->string_patches = p; +} + +static Uint +new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size) +{ + Literal* lit; + + if (stp->allocated_literals == 0) { + Uint need; + + ASSERT(stp->literals == 0); + ASSERT(stp->num_literals == 0); + stp->allocated_literals = 8; + need = stp->allocated_literals * sizeof(Literal); + stp->literals = (Literal *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + need); + } else if (stp->allocated_literals <= stp->num_literals) { + Uint need; + + stp->allocated_literals *= 2; + need = stp->allocated_literals * sizeof(Literal); + stp->literals = (Literal *) erts_realloc(ERTS_ALC_T_LOADER_TMP, + (void *) stp->literals, + need); + } + + stp->total_literal_size += heap_size; + lit = stp->literals + stp->num_literals; + lit->offset = 0; + lit->heap_size = heap_size; + lit->heap = erts_alloc(ERTS_ALC_T_LOADER_TMP, heap_size*sizeof(Eterm)); + lit->term = make_boxed(lit->heap); + *hpp = lit->heap; + return stp->num_literals++; +} + +Eterm +erts_module_info_0(Process* p, Eterm module) +{ + Eterm *hp; + Eterm list = NIL; + Eterm tup; + + if (is_not_atom(module)) { + return THE_NON_VALUE; + } + + if (erts_get_module(module) == NULL) { + return THE_NON_VALUE; + } + +#define BUILD_INFO(What) \ + tup = erts_module_info_1(p, module, What); \ + hp = HAlloc(p, 5); \ + tup = TUPLE2(hp, What, tup); \ + hp += 3; \ + list = CONS(hp, tup, list) + + BUILD_INFO(am_compile); + BUILD_INFO(am_attributes); + BUILD_INFO(am_imports); + BUILD_INFO(am_exports); +#undef BUILD_INFO + return list; +} + +Eterm +erts_module_info_1(Process* p, Eterm module, Eterm what) +{ + if (what == am_module) { + return module; + } else if (what == am_imports) { + return NIL; + } else if (what == am_exports) { + return exported_from_module(p, module); + } else if (what == am_functions) { + return functions_in_module(p, module); + } else if (what == am_attributes) { + return attributes_for_module(p, module); + } else if (what == am_compile) { + return compilation_info_for_module(p, module); + } else if (what == am_native_addresses) { + return native_addresses(p, module); + } + return THE_NON_VALUE; +} + +/* + * Builds a list of all functions in the given module: + * [{Name, Arity},...] + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +functions_in_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + Module* modp; + Eterm* code; + int i; + Uint num_functions; + Eterm* hp; + Eterm result = NIL; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod); + if (modp == NULL) { + return THE_NON_VALUE; + } + code = modp->code; + num_functions = code[MI_NUM_FUNCTIONS]; + hp = HAlloc(p, 5*num_functions); + for (i = num_functions-1; i >= 0 ; i--) { + Eterm* func_info = (Eterm *) code[MI_FUNCTIONS+i]; + Eterm name = func_info[3]; + int arity = func_info[4]; + Eterm tuple; + + ASSERT(is_atom(name)); + tuple = TUPLE2(hp, name, make_small(arity)); + hp += 3; + result = CONS(hp, tuple, result); + hp += 2; + } + return result; +} + +/* + * Builds a list of all functions including native addresses. + * [{Name,Arity,NativeAddress},...] + * + * Returns a tagged term, or 0 on error. + */ + +static Eterm +native_addresses(Process* p, Eterm mod) +{ + Module* modp; + Eterm* code; + int i; + Eterm* hp; + Uint num_functions; + Uint need; + Eterm* hp_end; + Eterm result = NIL; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod); + if (modp == NULL) { + return THE_NON_VALUE; + } + + code = modp->code; + num_functions = code[MI_NUM_FUNCTIONS]; + need = (6+BIG_UINT_HEAP_SIZE)*num_functions; + hp = HAlloc(p, need); + hp_end = hp + need; + for (i = num_functions-1; i >= 0 ; i--) { + Eterm* func_info = (Eterm *) code[MI_FUNCTIONS+i]; + Eterm name = func_info[3]; + int arity = func_info[4]; + Eterm tuple; + + ASSERT(is_atom(name)); + if (func_info[1] != 0) { + Eterm addr = erts_bld_uint(&hp, NULL, func_info[1]); + tuple = erts_bld_tuple(&hp, NULL, 3, name, make_small(arity), addr); + result = erts_bld_cons(&hp, NULL, tuple, result); + } + } + HRelease(p, hp_end, hp); + return result; +} + + +/* + * Builds a list of all exported functions in the given module: + * [{Name, Arity},...] + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +exported_from_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + int i; + Eterm* hp = NULL; + Eterm* hend = NULL; + Eterm result = NIL; + + if (is_not_atom(mod)) { + return THE_NON_VALUE; + } + + for (i = 0; i < export_list_size(); i++) { + Export* ep = export_list(i); + + if (ep->code[0] == mod) { + Eterm tuple; + + if (ep->address == ep->code+3 && + ep->code[3] == (Eterm) em_call_error_handler) { + /* There is a call to the function, but it does not exist. */ + continue; + } + + if (hp == hend) { + int need = 10 * 5; + hp = HAlloc(p, need); + hend = hp + need; + } + tuple = TUPLE2(hp, ep->code[1], make_small(ep->code[2])); + hp += 3; + result = CONS(hp, tuple, result); + hp += 2; + } + } + HRelease(p,hend,hp); + return result; +} + + +/* + * Returns a list of all attributes for the module. + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +attributes_for_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ + +{ + Module* modp; + Eterm* code; + Eterm* hp; + byte* ext; + Eterm result = NIL; + Eterm* end; + + if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod); + if (modp == NULL) { + return THE_NON_VALUE; + } + code = modp->code; + ext = (byte *) code[MI_ATTR_PTR]; + if (ext != NULL) { + hp = HAlloc(p, code[MI_ATTR_SIZE_ON_HEAP]); + end = hp + code[MI_ATTR_SIZE_ON_HEAP]; + result = erts_decode_ext(&hp, &MSO(p), &ext); + if (is_value(result)) { + ASSERT(hp <= end); + } + HRelease(p,end,hp); + } + return result; +} + + +/* + * Returns a list containing compilation information. + * + * Returns a tagged term, or 0 on error. + */ + +Eterm +compilation_info_for_module(Process* p, /* Process whose heap to use. */ + Eterm mod) /* Tagged atom for module. */ +{ + Module* modp; + Eterm* code; + Eterm* hp; + byte* ext; + Eterm result = NIL; + Eterm* end; + + if (is_not_atom(mod) || (is_not_list(result) && is_not_nil(result))) { + return THE_NON_VALUE; + } + + modp = erts_get_module(mod); + if (modp == NULL) { + return THE_NON_VALUE; + } + code = modp->code; + ext = (byte *) code[MI_COMPILE_PTR]; + if (ext != NULL) { + hp = HAlloc(p, code[MI_COMPILE_SIZE_ON_HEAP]); + end = hp + code[MI_COMPILE_SIZE_ON_HEAP]; + result = erts_decode_ext(&hp, &MSO(p), &ext); + if (is_value(result)) { + ASSERT(hp <= end); + } + HRelease(p,end,hp); + } + return result; +} + + +/* + * Returns a pointer to {module, function, arity}, or NULL if not found. + */ +Eterm* +find_function_from_pc(Eterm* pc) +{ + Range* low = modules; + Range* high = low + num_loaded_modules; + Range* mid = mid_module; + + while (low < high) { + if (pc < mid->start) { + high = mid; + } else if (pc > mid->end) { + low = mid + 1; + } else { + Eterm** low1 = (Eterm **) (mid->start + MI_FUNCTIONS); + Eterm** high1 = low1 + mid->start[MI_NUM_FUNCTIONS]; + Eterm** mid1; + + while (low1 < high1) { + mid1 = low1 + (high1-low1) / 2; + if (pc < mid1[0]) { + high1 = mid1; + } else if (pc < mid1[1]) { + mid_module = mid; + return mid1[0]+2; + } else { + low1 = mid1 + 1; + } + } + return NULL; + } + mid = low + (high-low) / 2; + } + return NULL; +} + +/* + * Read a specific chunk from a Beam binary. + */ + +Eterm +code_get_chunk_2(Process* p, Eterm Bin, Eterm Chunk) +{ + LoaderState state; + Uint chunk = 0; + ErlSubBin* sb; + Uint offset; + Uint bitoffs; + Uint bitsize; + byte* start; + int i; + Eterm res; + Eterm real_bin; + byte* temp_alloc = NULL; + + if ((start = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) { + error: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(p, BADARG); + } + state.module = THE_NON_VALUE; /* Suppress diagnostiscs */ + state.file_name = "IFF header for Beam file"; + state.file_p = start; + state.file_left = binary_size(Bin); + for (i = 0; i < 4; i++) { + Eterm* chunkp; + Eterm num; + if (is_not_list(Chunk)) { + goto error; + } + chunkp = list_val(Chunk); + num = CAR(chunkp); + Chunk = CDR(chunkp); + if (!is_byte(num)) { + goto error; + } + chunk = chunk << 8 | unsigned_val(num); + } + if (is_not_nil(Chunk)) { + goto error; + } + if (!scan_iff_file(&state, &chunk, 1, 1)) { + erts_free_aligned_binary_bytes(temp_alloc); + return am_undefined; + } + ERTS_GET_REAL_BIN(Bin, real_bin, offset, bitoffs, bitsize); + if (bitoffs) { + res = new_binary(p, state.chunks[0].start, state.chunks[0].size); + } else { + sb = (ErlSubBin *) HAlloc(p, ERL_SUB_BIN_SIZE); + sb->thing_word = HEADER_SUB_BIN; + sb->orig = real_bin; + sb->size = state.chunks[0].size; + sb->bitsize = 0; + sb->bitoffs = 0; + sb->offs = offset + (state.chunks[0].start - start); + sb->is_writable = 0; + res = make_binary(sb); + } + erts_free_aligned_binary_bytes(temp_alloc); + return res; +} + +/* + * Calculate the MD5 for a module. + */ + +Eterm +code_module_md5_1(Process* p, Eterm Bin) +{ + LoaderState state; + byte* temp_alloc = NULL; + + if ((state.file_p = erts_get_aligned_binary_bytes(Bin, &temp_alloc)) == NULL) { + BIF_ERROR(p, BADARG); + } + state.module = THE_NON_VALUE; /* Suppress diagnostiscs */ + state.file_name = "IFF header for Beam file"; + state.file_left = binary_size(Bin); + + if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) { + return am_undefined; + } + erts_free_aligned_binary_bytes(temp_alloc); + return new_binary(p, state.mod_md5, sizeof(state.mod_md5)); +} + +#define WORDS_PER_FUNCTION 6 + +static Eterm* +make_stub(Eterm* fp, Eterm mod, Eterm func, Uint arity, Uint native, Eterm OpCode) +{ + fp[0] = (Eterm) BeamOp(op_i_func_info_IaaI); + fp[1] = native; + fp[2] = mod; + fp[3] = func; + fp[4] = arity; +#ifdef HIPE + if (native) { + fp[5] = BeamOpCode(op_move_return_nr); + hipe_mfa_save_orig_beam_op(mod, func, arity, fp+5); + } +#endif + fp[5] = OpCode; + return fp + WORDS_PER_FUNCTION; +} + +static byte* +stub_copy_info(LoaderState* stp, + int chunk, /* Chunk: ATTR_CHUNK or COMPILE_CHUNK */ + byte* info, /* Where to store info. */ + Eterm* ptr_word, /* Where to store pointer into info. */ + Eterm* size_word) /* Where to store size of info. */ +{ + Sint decoded_size; + Uint size = stp->chunks[chunk].size; + if (size != 0) { + memcpy(info, stp->chunks[chunk].start, size); + *ptr_word = (Eterm) info; + decoded_size = erts_decode_ext_size(info, size, 0); + if (decoded_size < 0) { + return 0; + } + *size_word = decoded_size; + } + return info + size; +} + +static int +stub_read_export_table(LoaderState* stp) +{ + int i; + + GetInt(stp, 4, stp->num_exps); + if (stp->num_exps > stp->num_functions) { + LoadError2(stp, "%d functions exported; only %d functions defined", + stp->num_exps, stp->num_functions); + } + stp->export + = (ExportEntry *) erts_alloc(ERTS_ALC_T_LOADER_TMP, + stp->num_exps * sizeof(ExportEntry)); + + for (i = 0; i < stp->num_exps; i++) { + Uint n; + + GetInt(stp, 4, n); + GetAtom(stp, n, stp->export[i].function); + GetInt(stp, 4, n); + if (n > MAX_REG) { + LoadError2(stp, "export table entry %d: absurdly high arity %d", i, n); + } + stp->export[i].arity = n; + GetInt(stp, 4, n); /* Ignore label */ + } + return 1; + + load_error: + return 0; +} + +static void +stub_final_touch(LoaderState* stp, Eterm* fp) +{ + int i; + int n = stp->num_exps; + Eterm function = fp[3]; + int arity = fp[4]; +#ifdef HIPE + Lambda* lp; +#endif + + /* + * Test if the function should be exported. + */ + + for (i = 0; i < n; i++) { + if (stp->export[i].function == function && stp->export[i].arity == arity) { + Export* ep = erts_export_put(fp[2], function, arity); + ep->address = fp+5; + return; + } + } + + /* + * Must be a plain local function or a lambda local function. + * Search the lambda table to find out which. + */ + +#ifdef HIPE + n = stp->num_lambdas; + for (i = 0, lp = stp->lambdas; i < n; i++, lp++) { + ErlFunEntry* fe = stp->lambdas[i].fe; + if (lp->function == function && lp->arity == arity) { + fp[5] = (Eterm) BeamOpCode(op_hipe_trap_call_closure); + fe->address = &(fp[5]); + } + } +#endif + return; +} + + +/* Takes an erlang list of addresses: + [{Adr, Patchtyppe} | Addresses] + and the address of a fun_entry. +*/ +int +patch(Eterm Addresses, Uint fe) + { +#ifdef HIPE + Eterm* listp; + Eterm tuple; + Eterm* tp; + Eterm patchtype; + Uint AddressToPatch; + + while (!is_nil(Addresses)) { + listp = list_val(Addresses); + + tuple = CAR(listp); + if (is_not_tuple(tuple)) { + return 0; /* Signal error */ + } + + tp = tuple_val(tuple); + if (tp[0] != make_arityval(2)) { + return 0; /* Signal error */ + } + + if(term_to_Uint(tp[1], &AddressToPatch) == 0) { + return 0; /* Signal error */ + } + + patchtype = tp[2]; + if (is_not_atom(patchtype)) { + return 0; /* Signal error */ + } + + hipe_patch_address((Uint *)AddressToPatch, patchtype, fe); + + Addresses = CDR(listp); + + + } + +#endif + return 1; +} + + +int +patch_funentries(Eterm Patchlist) + { +#ifdef HIPE + while (!is_nil(Patchlist)) { + Eterm Info; + Eterm MFA; + Eterm Addresses; + Eterm tuple; + Eterm Mod; + Eterm* listp; + Eterm* tp; + ErlFunEntry* fe; + Uint index; + Uint uniq; + Uint native_address; + + listp = list_val(Patchlist); + tuple = CAR(listp); + Patchlist = CDR(listp); + + if (is_not_tuple(tuple)) { + return 0; /* Signal error */ + } + + tp = tuple_val(tuple); + if (tp[0] != make_arityval(3)) { + return 0; /* Signal error */ + } + + Info = tp[1]; + if (is_not_tuple(Info)) { + return 0; /* Signal error */ + } + Addresses = tp[2]; + if (is_not_list(Addresses)) { + return 0; /* Signal error */ + } + + if(term_to_Uint(tp[3], &native_address) == 0) { + return 0; /* Signal error */ + } + + + + tp = tuple_val(Info); + if (tp[0] != make_arityval(3)) { + return 0; /* Signal error */ + } + MFA = tp[1]; + if (is_not_tuple(MFA)) { + return 0; /* Signal error */ + } + if(term_to_Uint(tp[2], &uniq) == 0){ + return 0; /* Signal error */ + } + if(term_to_Uint(tp[3], &index) == 0) { + return 0; /* Signal error */ + } + + + + + tp = tuple_val(MFA); + if (tp[0] != make_arityval(3)) { + return 0; /* Signal error */ + } + Mod = tp[1]; + if (is_not_atom(Mod)) { + return 0; /* Signal error */ + } + + + + fe = erts_get_fun_entry(Mod, uniq, index); + fe->native_address = (Uint *)native_address; + erts_refc_dec(&fe->refc, 1); + + if (!patch(Addresses, (Uint) fe)) + return 0; + + } +#endif + return 1; /* Signal that all went well */ +} + + +/* + * Do a dummy load of a module. No threaded code will be loaded. + * Used for loading native code. + * Will also patch all references to fun_entries to point to + * the new fun_entries created. + */ + +Eterm +erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info) +{ + LoaderState state; + Eterm Funcs; + Eterm Patchlist; + Eterm* tp; + Eterm* code = NULL; + Eterm* ptrs; + Eterm* fp; + byte* info; + Uint ci; + int n; + int code_size; + int rval; + int i; + ErlDrvBinary* bin = NULL; + byte* temp_alloc = NULL; + byte* bytes; + Uint size; + + /* + * Must initialize state.lambdas here because the error handling code + * at label 'error' uses it. + */ + init_state(&state); + + if (is_not_atom(Mod)) { + goto error; + } + if (is_not_tuple(Info)) { + goto error; + } + tp = tuple_val(Info); + if (tp[0] != make_arityval(2)) { + goto error; + } + Funcs = tp[1]; + Patchlist = tp[2]; + + if ((n = list_length(Funcs)) < 0) { + goto error; + } + if ((bytes = erts_get_aligned_binary_bytes(Beam, &temp_alloc)) == NULL) { + goto error; + } + size = binary_size(Beam); + + /* + * Uncompressed if needed. + */ + if (!(size >= 4 && bytes[0] == 'F' && bytes[1] == 'O' && + bytes[2] == 'R' && bytes[3] == '1')) { + bin = (ErlDrvBinary *) erts_gzinflate_buffer((char*)bytes, size); + if (bin == NULL) { + goto error; + } + bytes = (byte*)bin->orig_bytes; + size = bin->orig_size; + } + + /* + * Scan the Beam binary and read the interesting sections. + */ + + state.file_name = "IFF header for Beam file"; + state.file_p = bytes; + state.file_left = size; + state.module = Mod; + state.group_leader = p->group_leader; + state.num_functions = n; + if (!scan_iff_file(&state, chunk_types, NUM_CHUNK_TYPES, NUM_MANDATORY)) { + goto error; + } + define_file(&state, "code chunk header", CODE_CHUNK); + if (!read_code_header(&state)) { + goto error; + } + define_file(&state, "atom table", ATOM_CHUNK); + if (!load_atom_table(&state)) { + goto error; + } + define_file(&state, "export table", EXP_CHUNK); + if (!stub_read_export_table(&state)) { + goto error; + } + + if (state.chunks[LAMBDA_CHUNK].size > 0) { + define_file(&state, "lambda (fun) table", LAMBDA_CHUNK); + if (!read_lambda_table(&state)) { + goto error; + } + } + + /* + * Allocate memory for the stub module. + */ + + code_size = ((WORDS_PER_FUNCTION+1)*n + MI_FUNCTIONS + 2) * sizeof(Eterm); + code_size += state.chunks[ATTR_CHUNK].size; + code_size += state.chunks[COMPILE_CHUNK].size; + code = erts_alloc_fnf(ERTS_ALC_T_CODE, code_size); + if (!code) { + goto error; + } + + /* + * Initialize code area. + */ + + code[MI_NUM_FUNCTIONS] = n; + code[MI_ATTR_PTR] = 0; + code[MI_ATTR_SIZE_ON_HEAP] = 0; + code[MI_COMPILE_PTR] = 0; + code[MI_COMPILE_SIZE_ON_HEAP] = 0; + code[MI_NUM_BREAKPOINTS] = 0; + ci = MI_FUNCTIONS + n + 1; + + /* + * Make stubs for all functions. + */ + + ptrs = code + MI_FUNCTIONS; + fp = code + ci; + for (i = 0; i < n; i++) { + Eterm* listp; + Eterm tuple; + Eterm* tp; + Eterm func; + Eterm arity_term; + Uint arity; + Uint native_address; + Eterm op; + + if (is_nil(Funcs)) { + break; + } + listp = list_val(Funcs); + tuple = CAR(listp); + Funcs = CDR(listp); + + /* Error checking */ + if (is_not_tuple(tuple)) { + goto error; + } + tp = tuple_val(tuple); + if (tp[0] != make_arityval(3)) { + goto error; + } + func = tp[1]; + arity_term = tp[2]; + if (is_not_atom(func) || is_not_small(arity_term)) { + goto error; + } + arity = signed_val(arity_term); + if (arity < 0) { + goto error; + } + if (term_to_Uint(tp[3], &native_address) == 0) { + goto error; + } + + /* + * Set the pointer and make the stub. Put a return instruction + * as the body until we know what kind of trap we should put there. + */ + ptrs[i] = (Eterm) fp; +#ifdef HIPE + op = (Eterm) BeamOpCode(op_hipe_trap_call); /* Might be changed later. */ +#else + op = (Eterm) BeamOpCode(op_move_return_nr); +#endif + fp = make_stub(fp, Mod, func, arity, (Uint)native_address, op); + } + + /* + * Insert the last pointer and the int_code_end instruction. + */ + + ptrs[i] = (Eterm) fp; + *fp++ = (Eterm) BeamOp(op_int_code_end); + + /* + * Copy attributes and compilation information. + */ + + info = (byte *) fp; + info = stub_copy_info(&state, ATTR_CHUNK, info, + code+MI_ATTR_PTR, code+MI_ATTR_SIZE_ON_HEAP); + if (info == NULL) { + goto error; + } + info = stub_copy_info(&state, COMPILE_CHUNK, info, + code+MI_COMPILE_PTR, code+MI_COMPILE_SIZE_ON_HEAP); + if (info == NULL) { + goto error; + } + + /* + * Insert the module in the module table. + */ + + rval = insert_new_code(p, 0, p->group_leader, Mod, code, code_size, + BEAM_CATCHES_NIL); + if (rval < 0) { + goto error; + } + + /* + * Export all stub functions and insert the correct type of HiPE trap. + */ + + fp = code + ci; + for (i = 0; i < n; i++) { + stub_final_touch(&state, fp); + fp += WORDS_PER_FUNCTION; + } + + if (patch_funentries(Patchlist)) { + erts_free_aligned_binary_bytes(temp_alloc); + if (state.lambdas != state.def_lambdas) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas); + } + if (bin != NULL) { + driver_free_binary(bin); + } + return Mod; + } + + error: + erts_free_aligned_binary_bytes(temp_alloc); + if (code != NULL) { + erts_free(ERTS_ALC_T_CODE, code); + } + if (state.lambdas != state.def_lambdas) { + erts_free(ERTS_ALC_T_LOADER_TMP, (void *) state.lambdas); + } + if (bin != NULL) { + driver_free_binary(bin); + } + + + BIF_ERROR(p, BADARG); +} + +#undef WORDS_PER_FUNCTION + +static int safe_mul(Uint a, Uint b, Uint* resp) +{ + Uint res = a * b; + *resp = res; + + if (b == 0) { + return 1; + } else { + return (res / b) == a; + } +} diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h new file mode 100644 index 0000000000..c17844a553 --- /dev/null +++ b/erts/emulator/beam/beam_load.h @@ -0,0 +1,120 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef _BEAM_LOAD_H +# define _BEAM_LOAD_H + +#include "beam_opcodes.h" +#include "erl_process.h" + +int beam_make_current_old(Process *c_p, ErtsProcLocks c_p_locks, Eterm module); + +typedef struct gen_op_entry { + char* name; + int arity; + int specific; + int num_specific; + int transform; + int min_window; +} GenOpEntry; + +extern GenOpEntry gen_opc[]; + +#ifdef NO_JUMP_TABLE +#define BeamOp(Op) (Op) +#else +extern void** beam_ops; +#define BeamOp(Op) beam_ops[(Op)] +#endif + + +extern Eterm beam_debug_apply[]; +extern Eterm* em_call_error_handler; +extern Eterm* em_apply_bif; +extern Eterm* em_call_traced_function; +typedef struct { + Eterm* start; /* Pointer to start of module. */ + Eterm* end; /* Points one word beyond last function in module. */ +} Range; + +/* + * The following variables keep a sorted list of address ranges for + * each module. It allows us to quickly find a function given an + * instruction pointer. + */ + +extern Range* modules; +extern int num_loaded_modules; +extern int allocated_modules; +extern Range* mid_module; + +/* Total code size in bytes */ +extern Uint erts_total_code_size; +/* + * Index into start of code chunks which contains additional information + * about the loaded module. + * + * First number of functions. + */ + +#define MI_NUM_FUNCTIONS 0 + +/* + * The attributes retrieved by Mod:module_info(attributes). + */ + +#define MI_ATTR_PTR 1 +#define MI_ATTR_SIZE 2 +#define MI_ATTR_SIZE_ON_HEAP 3 + +/* + * The compilation information retrieved by Mod:module_info(compile). + */ + +#define MI_COMPILE_PTR 4 +#define MI_COMPILE_SIZE 5 +#define MI_COMPILE_SIZE_ON_HEAP 6 + +/* + * Number of breakpoints in module is stored in this word + */ +#define MI_NUM_BREAKPOINTS 7 + +/* + * Literal area (constant pool). + */ +#define MI_LITERALS_START 8 +#define MI_LITERALS_END 9 + +/* + * Pointer to the on_load function (or NULL if none). + */ +#define MI_ON_LOAD_FUNCTION_PTR 10 + +/* + * Start of function pointer table. This table contains pointers to + * all functions in the module plus an additional pointer just beyond + * the end of the last function. + * + * The actual loaded code (for the first function) start just beyond + * this table. + */ + +#define MI_FUNCTIONS 11 +#endif /* _BEAM_LOAD_H */ diff --git a/erts/emulator/beam/benchmark.c b/erts/emulator/beam/benchmark.c new file mode 100644 index 0000000000..7fbf44a03c --- /dev/null +++ b/erts/emulator/beam/benchmark.c @@ -0,0 +1,395 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "global.h" +#include "benchmark.h" + +#ifdef BM_COUNTERS +unsigned long long processes_busy; +unsigned long long processes_spawned; +unsigned long long messages_sent; +unsigned long long messages_copied; +unsigned long long messages_ego; +unsigned long long minor_gc; +unsigned long long major_gc; +#ifdef HYBRID +unsigned long long minor_global_gc; +unsigned long long major_global_gc; +unsigned long long gc_in_copy; +#ifdef INCREMENTAL +unsigned long long minor_gc_cycles; +unsigned long long major_gc_cycles; +unsigned long long minor_gc_stages; +unsigned long long major_gc_stages; +#endif +#endif +#endif /* BM_COUNTERS */ + +#ifdef BM_TIMERS + +#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR + +#include "libperfctr.h" +struct vperfctr *system_clock; +double cpu_khz; +BM_NEW_TIMER(start); + +static double get_hrvtime(void) +{ + unsigned long long ticks; + double milli_seconds; + + ticks = vperfctr_read_tsc(system_clock); + milli_seconds = (double)ticks / cpu_khz; + return milli_seconds; +} + +static void stop_hrvtime(void) +{ + if(system_clock) + { + vperfctr_stop(system_clock); + vperfctr_close(system_clock); + system_clock = NULL; + } +} + +#else /* not perfctr, asuming Solaris */ +#include +BM_TIMER_T system_clock; +#endif + +unsigned long local_pause_times[MAX_PAUSE_TIME]; +unsigned long pause_times[MAX_PAUSE_TIME]; +unsigned long pause_times_old[MAX_PAUSE_TIME]; + +BM_TIMER_T mmu; +BM_TIMER_T mmu_counter; + +BM_NEW_TIMER(timer); +BM_NEW_TIMER(system); +BM_NEW_TIMER(gc); +BM_NEW_TIMER(minor_gc); +BM_NEW_TIMER(major_gc); +BM_NEW_TIMER(minor_global_gc); +BM_NEW_TIMER(major_global_gc); +BM_NEW_TIMER(send); +BM_NEW_TIMER(copy); +BM_NEW_TIMER(size); +BM_NEW_TIMER(max_minor); +BM_NEW_TIMER(max_major); +BM_NEW_TIMER(max_global_minor); +BM_NEW_TIMER(max_global_major); +BM_NEW_TIMER(misc0); +BM_NEW_TIMER(misc1); +BM_NEW_TIMER(misc2); +#endif /* BM_TIMERS */ + +#ifdef BM_HEAP_SIZES +unsigned long long max_used_heap; +unsigned long long max_allocated_heap; +unsigned long long max_used_global_heap; +unsigned long long max_allocated_global_heap; +#endif /* BM_HEAP_SIZES */ + +#ifdef BM_MESSAGE_SIZES +unsigned long long words_sent; +unsigned long long words_copied; +unsigned long long words_prealloc; +unsigned long long message_sizes[1000]; +#endif /* BM_MESSAGE_SIZES */ + +/***** + * The following functions have to be defined, but they only have contents + * if certain keywords are defined. + */ + +void init_benchmarking() +{ +#ifdef BM_TIMERS +#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR + /* pass `--with-perfctr=/path/to/perfctr' when configuring */ + struct perfctr_info info; + struct vperfctr_control control; + int i; + + system_clock = vperfctr_open(); + if (system_clock != NULL) + { + if (vperfctr_info(system_clock,&info) >= 0) + { + cpu_khz = (double)info.cpu_khz; + if (info.cpu_features & PERFCTR_FEATURE_RDTSC) + { + memset(&control,0,sizeof control); + control.cpu_control.tsc_on = 1; + } + } + if (vperfctr_control(system_clock,&control) < 0) + { + vperfctr_close(system_clock); + system_clock = NULL; + } + } + + for (i = 0; i < 1000; i++) + { + BM_START_TIMER(system); + BM_STOP_TIMER(system); + } + + timer_time = system_time / 1000; + start_time = 0; +#else + int i; + for (i = 0; i < 1000; i++) + { + BM_START_TIMER(system); + BM_STOP_TIMER(system); + } + timer_time = system_time / 1000; +#endif + + for (i = 0; i < MAX_PAUSE_TIME; i++) { + local_pause_times[i] = 0; + pause_times[i] = 0; + pause_times_old[i] = 0; + } + + mmu = 0; + mmu_counter = 0; + + BM_MMU_INIT(); +#endif /* BM_TIMERS */ + +#ifdef BM_COUNTERS + processes_busy = 0; + processes_spawned = 0; + messages_sent = 0; + messages_copied = 0; + messages_ego = 0; + minor_gc = 0; + major_gc = 0; +#ifdef HYBRID + minor_global_gc = 0; + major_global_gc = 0; + gc_in_copy = 0; +#ifdef INCREMENTAL + minor_gc_cycles = 0; + major_gc_cycles = 0; + minor_gc_stages = 0; + major_gc_stages = 0; +#endif +#endif +#endif /* BM_COUNTERS */ + +#ifdef BM_HEAP_SIZES + max_used_heap = 0; + max_allocated_heap = 0; + max_used_global_heap = 0; + max_allocated_global_heap = 0; +#endif /* BM_HEAP_SIZES */ + +#ifdef BM_MESSAGE_SIZES + words_sent = 0; + words_copied = 0; + words_prealloc = 0; + { + int i; + for (i = 0; i < 1000; i++) + message_sizes[i] = 0; + } +#endif /* BM_MESSAGE_SIZES */ +} + +void save_statistics() +{ +#ifdef BM_STATISTICS + FILE *file = fopen(BM_STATISTICS_FILE,"a"); + long i = 0; + + if (file) + { + erts_fprintf(file,"-------------------------------------------------------------------------\n"); + erts_fprintf(file,"The counters are reset at system start and are sums over the entire node.\n"); + erts_fprintf(file,"You may reset them manually using the BIFs in the module hipe_bifs.\n"); + erts_fprintf(file,"All times are given in milliseconds.\n"); + erts_fprintf(file,"-------------------------------------------------------------------------\n"); + + erts_fprintf(file,"Node: %T\n",erts_this_node->sysname); + +#ifdef BM_COUNTERS + erts_fprintf(file,"Number of processes spawned: %lld\n",processes_spawned); + erts_fprintf(file,"Number of local minor GCs: %lld\n",minor_gc); + erts_fprintf(file,"Number of local major GCs: %lld\n",major_gc); +#ifdef HYBRID + erts_fprintf(file,"Number of global minor GCs: %lld\n",minor_global_gc); + erts_fprintf(file,"Number of global major GCs: %lld\n",major_global_gc); +#ifdef INCREMENTAL + erts_fprintf(file,"Number of minor GC-cycles: %lld\n",minor_gc_cycles); + erts_fprintf(file,"Number of major GC-cycles: %lld\n",major_gc_cycles); + erts_fprintf(file,"Number of minor GC-stages: %lld\n",minor_gc_stages); + erts_fprintf(file,"Number of major GC-stages: %lld\n",major_gc_stages); +#endif +#endif + erts_fprintf(file,"Number of messages sent: %lld\n",messages_sent); + erts_fprintf(file,"Number of messages copied: %lld\n",messages_copied); + erts_fprintf(file,"Number of messages sent to self: %lld\n",messages_ego); +#endif /* BM_COUNTERS */ + +#ifdef BM_MESSAGE_SIZES + erts_fprintf(file,"Number of words sent: %lld\n",words_sent); + erts_fprintf(file,"Number of words copied: %lld\n",words_copied); + erts_fprintf(file,"Number of words preallocated: %lld\n",words_prealloc); +#endif /* BM_MESSAGE_SIZES */ + +#ifdef BM_HEAP_SIZES + erts_fprintf(file,"Biggest local heap used (in words): %lld\n",max_used_heap); + erts_fprintf(file,"Biggest local heap allocated (in words): %lld\n",max_allocated_heap); + erts_fprintf(file,"Biggest global heap used (in words): %lld\n",max_used_global_heap); + erts_fprintf(file,"Biggest global heap allocated (in words): %lld\n",max_allocated_global_heap); +#endif /* BM_HEAP_SIZES */ + +#ifdef BM_TIMERS + erts_fprintf(file,"--- The total active system time is the sum of all times below ---\n"); + BM_TIME_PRINTER("Mutator time",system_time); + BM_TIME_PRINTER("Time spent in send (excluding size & copy)",send_time); + BM_TIME_PRINTER("Time spent in size",size_time); + BM_TIME_PRINTER("Time spent in copy",copy_time); + BM_TIME_PRINTER("Time spent in local minor GC",minor_gc_time); + BM_TIME_PRINTER("Time spent in local major GC",major_gc_time); + BM_TIME_PRINTER("Time spent in global minor GC",minor_global_gc_time); + BM_TIME_PRINTER("Time spent in global major GC",major_global_gc_time); + erts_fprintf(file,"---\n"); + BM_TIME_PRINTER("Maximum time spent in one separate local minor GC",max_minor_time); + BM_TIME_PRINTER("Maximum time spent in one separate local major GC",max_major_time); + BM_TIME_PRINTER("Maximum time spent in one separate global minor GC",max_global_minor_time); + BM_TIME_PRINTER("Maximum time spent in one separate global major GC",max_global_major_time); +#endif /* BM_TIMERS */ + +#if 0 + /* Save a log file for import into excel */ + + long long total_time, n; + long left, right, mid; + +#ifdef BM_COUNTERS + erts_fprintf(file,"Spawns\tLocalGC\tMAGC\tMessages\tMutator_t\tLocalGC_t\tMAGC_t\tLocMaxP\tLocMeanP\tLocGeoMP\tMAMaxP\tMAMeanP\tMAGeoMP\t\tCMAGC\tCMAGC_t\n"); + erts_fprintf(file,"%lld\t%lld\t%lld\t%lld\t", + processes_spawned, + minor_garbage_cols + major_garbage_cols, + minor_global_garbage_cols + major_global_garbage_cols, + messages_sent); +#endif /* BM_COUNTERS */ + +#ifdef BM_TIMERS + erts_fprintf(file,"%lld\t%lld\t%lld\t", + (long long)(system_time + send_time + size_time + copy_time), + (long long)(minor_gc_time + major_gc_time), + (long long)(minor_global_gc_time + major_global_gc_time)); + + total_time = 0; n = 0; + left = 0; right = 0; mid = 0; + for (i = 0; i < MAX_PAUSE_TIME; i++) { + total_time += local_pause_times[i] * i; + n += local_pause_times[i]; + if (i > mid) + right += local_pause_times[i]; + while(right > left) { + left += local_pause_times[mid++]; + right -= local_pause_times[mid]; + } + } + erts_fprintf(file,"%lld\t%lld\t%ld\t", + (long long)((max_minor_time > max_major_time ? + max_minor_time : + max_major_time)*1000), + total_time / n, + mid); + + total_time = 0; n = 0; + left = 0; right = 0; mid = 0; + for (i = 0; i < MAX_PAUSE_TIME; i++) { + if (pause_times[i] > 0) { + total_time += pause_times[i] * i; + n += pause_times[i]; + if (i > mid) + right += pause_times[i]; + while(right > left) { + left += pause_times[mid++]; + right -= pause_times[mid]; + } + } + } + erts_fprintf(file,"%lld\t%lld\t%ld\t", + (long long)((max_global_minor_time > max_global_major_time ? + max_global_minor_time : + max_global_major_time)*1000), + (n > 0 ? total_time / n : 0), + mid); + + erts_fprintf(file,"\t%lld\t%lld\n",n,total_time); + + erts_fprintf(file,"\nMinor:\n"); + for (i = 0; i < MAX_PAUSE_TIME; i++) { + if (i < 1000 || pause_times[i] > 0) { + erts_fprintf(file,"%d\t%ld\n",i,pause_times[i]); + } + } + + fprintf(file,"Major:\n"); + for (i = 0; i < MAX_PAUSE_TIME; i++) { + if (pause_times_old[i] > 0) { + fprintf(file,"%d\t%ld\n",i,pause_times_old[i]); + } + } +#endif /* BM_TIMERS */ + +#ifdef BM_TIMERS + total_time = 0; n = 0; + left = 0; right = 0; mid = 0; + fprintf(file,"\nLocal:\n"); + for (i = 0; i < MAX_PAUSE_TIME; i++) { + if (local_pause_times[i] > 0) { + erts_fprintf(file,"%d\t%ld\n",i,local_pause_times[i]); + total_time += local_pause_times[i] * i; + n += local_pause_times[i]; + if (i > mid) + right += local_pause_times[i]; + while(right > left) { + left += local_pause_times[mid++]; + right -= local_pause_times[mid]; + } + } + } + erts_fprintf(file,"Mid: %ld Mean: %ld\n",(long)mid, + (long)(n > 0 ? total_time / n : 0)); +#endif +#endif /* 0 */ + fclose(file); + } + else + fprintf(stderr,"Sorry... Can not write to %s!\n\r",BM_STATISTICS_FILE); +#endif /* BM_STATISTICS */ +} diff --git a/erts/emulator/beam/benchmark.h b/erts/emulator/beam/benchmark.h new file mode 100644 index 0000000000..eedb06a1b6 --- /dev/null +++ b/erts/emulator/beam/benchmark.h @@ -0,0 +1,340 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __BENCHMARK_H__ +#define __BENCHMARK_H__ + +/* The define __BENCHMARK__ is the master switch to turn on and off + * benchmarking. This will enable the benchmark-BIFs in hipe_bif1.c. + * Documentation for the BIFs is in hipe_bif1.c, and that is where you + * will find the information about how to accually get some data out + * from these timers and counters. + */ +/* #define __BENCHMARK__ */ + +#ifdef __BENCHMARK__ +/* + * The defines below enables different parts of the benchmaring. + * Counters and timers that are disabled, always report zero in + * the BIFs. + */ + +/* BM_TIMERS keeps track of the time spent in diferent parts of the + * system. It only measures accual active time, not time spent in idle + * mode. These timers requires hardware support. For Linux, use the + * package perfctr from user.it.uu.se/~mikpe/linux/perfctr. If this + * package is not specified when configuring the system + * (--with-perfctr=PATH), the Solaris hrtime_t will be used. + * To add new timers look below. + */ +#define BM_TIMERS + +/* BM_COUNTERS count all kinds of events that occurs in the system. + * Among other things it counts the number of messages, then number of + * garbage collections, the number of processes spawned etc. + * To add new counters look below. + */ +#define BM_COUNTERS + +/* BM_MESSAGE_SIZES keeps a log of the size of all messages sent in + * the system. This introduce an overhead in time for the shared heap + * system since all message sizes have to be calculated at send. + */ +/* #define BM_MESSAGE_SIZES */ + +/* BM_HEAP_SIZES goes through all processes at garbage collection time + * to sum their allocated and used heap sizes. In anything else than a + * shared heap system, this will cost. + */ +/* #define BM_HEAP_SIZES */ + +/* BM_STATISTICS saves an entry in the file BM_STATISTICS_FILE. This + * is done for each erlang node at exit time. + */ +/* #define BM_STATISTICS */ + +#endif /* __BENCHMARK__ */ + + +#ifdef BM_STATISTICS +# define BM_STATISTICS_FILE "/tmp/erlang_statistics.joppe.log" +#endif /* BM_STATISTICS */ + + +/************ There are no more settings below this line *************/ + +/* + * Maintenance and how to add new stuff is documented by the code + * below ;-) + */ + +#ifdef BM_COUNTERS +/********************************************************************* + * To add new counters: + * + * Add the variable here AND in benchmark.c. Use the macro + * BM_COUNT(var) in the code where you want to increase it. + * + */ +extern unsigned long long processes_busy; +extern unsigned long long processes_spawned; +extern unsigned long long messages_sent; +extern unsigned long long messages_copied; +extern unsigned long long messages_ego; +extern unsigned long long minor_gc; +extern unsigned long long major_gc; +#ifdef HYBRID +extern unsigned long long minor_global_gc; +extern unsigned long long major_global_gc; +extern unsigned long long gc_in_copy; +#ifdef INCREMENTAL +extern unsigned long long minor_gc_cycles; +extern unsigned long long major_gc_cycles; +extern unsigned long long minor_gc_stages; +extern unsigned long long major_gc_stages; +#endif +#endif + +#define BM_COUNT(var) (var)++; + +#define BM_EGO_COUNT(send,rec) { \ + if ((send) == (rec)) \ + BM_COUNT(messages_ego); } + +#define BM_LAZY_COPY_START long long gcs = minor_global_gc + major_global_gc; +#define BM_LAZY_COPY_STOP { gcs = (minor_global_gc + major_global_gc) - gcs; \ + if (gcs > gc_in_copy) gc_in_copy = gcs; } + +#else /* !BM_COUNTERS */ +# define BM_COUNT(var) +# define BM_EGO_COUNT(send,rec) +# define BM_LAZY_COPY_START +# define BM_LAZY_COPY_STOP +#endif /* BM_COUNTERS */ + + +#ifdef BM_TIMERS +/********************************************************************* + * To add new timers: + * + * Add the variable below using the form extern BM_TIMER_T blah_time. + * Also add them in benchmark.c using the macro NEW_TIMER(blah). Use + * the macro BM_SWAP_TIMER(from,blah) ... BM_SWAP_TIMER(blah,to) to + * start and stop the new timer. Note, that you have to know what + * timer is running at the place where you want to insert your new + * timer to be able to stop and start (from,to) it. + * + * You can use the macros BM_STOP_TIMER(blah) and BM_START_TIMER(blah) + * around code that should not be timed at all. As above, you have to + * know what timer to start and stop. The system timer is running at + * most places in the emulator. Only the garbage collector and the + * message sending has its own timers at the moment. + * + * The timer_time used when stopping timers is the time it takes to + * start and stop the timers, calculated in init_benchmarking(). If it + * is not there, the time it takes to do this will accually be + * substantial compared to some small times in the system we want to + * meassure (send time in shared heap for instance). + */ + +#if (defined(__i386__) || defined(__x86_64__)) && USE_PERFCTR +#include "libperfctr.h" + +#define BM_TIMER_T double + +extern struct vperfctr *system_clock; +extern double cpu_khz; +extern BM_TIMER_T start_time; + +#define BM_START_TIMER(t) start_time = \ + (BM_TIMER_T)vperfctr_read_tsc(system_clock) / \ + cpu_khz; + +#define BM_STOP_TIMER(t) do { \ + BM_TIMER_T tmp = ((BM_TIMER_T)vperfctr_read_tsc(system_clock) / cpu_khz); \ + tmp -= (start_time + timer_time); \ + t##_time += (tmp > 0 ? tmp : 0); \ +} while(0) + +#define BM_TIME_PRINTER(str,time) do { \ + int min,sec,milli,micro; \ + BM_TIMER_T tmp = (time) * 1000; \ + micro = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ + tmp /= 1000; \ + milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ + tmp /= 1000; \ + sec = (uint)(tmp - ((int)(tmp / 60)) * 60); \ + min = (uint)tmp / 60; \ + erts_fprintf(file,str": %d:%02d.%03d %03d\n",min,sec,milli,micro); \ +} while(0) + +#else /* !USE_PERFCTR (Assuming Solaris) */ + +#define BM_TIMER_T hrtime_t +#define BM_START_TIMER(t) system_clock = sys_gethrtime() +#define BM_STOP_TIMER(t) do { \ + BM_TIMER_T tmp = (sys_gethrtime() - system_clock) - timer_time; \ + t##_time += (tmp > 0 ? tmp : 0); \ +} while(0) + +#define BM_TIME_PRINTER(str,time) do { \ + int min,sec,milli,micro; \ + BM_TIMER_T tmp; \ + tmp = (time) / 1000; \ + micro = tmp % 1000; \ + tmp /= 1000; \ + milli = tmp % 1000; \ + tmp /= 1000; \ + sec = tmp % 60; \ + min = tmp / 60; \ + erts_fprintf(file,str": %d:%02d.%03d %03d\n",min,sec,milli,micro); \ +} while(0) + +extern BM_TIMER_T system_clock; +#endif /* USE_PERFCTR */ + +extern BM_TIMER_T timer_time; +extern BM_TIMER_T system_time; +extern BM_TIMER_T gc_time; +extern BM_TIMER_T minor_gc_time; +extern BM_TIMER_T major_gc_time; +extern BM_TIMER_T minor_global_gc_time; +extern BM_TIMER_T major_global_gc_time; +extern BM_TIMER_T send_time; +extern BM_TIMER_T copy_time; +extern BM_TIMER_T size_time; +extern BM_TIMER_T max_minor_time; +extern BM_TIMER_T max_major_time; +extern BM_TIMER_T max_global_minor_time; +extern BM_TIMER_T max_global_major_time; +extern BM_TIMER_T misc0_time; +extern BM_TIMER_T misc1_time; +extern BM_TIMER_T misc2_time; + +#define MAX_PAUSE_TIME 500000 +extern unsigned long local_pause_times[MAX_PAUSE_TIME]; +extern unsigned long pause_times[MAX_PAUSE_TIME]; +extern unsigned long pause_times_old[MAX_PAUSE_TIME]; + +#define MMU_INTERVAL 5 /* milli seconds */ +extern BM_TIMER_T mmu_counter; +extern BM_TIMER_T mmu; + +#define BM_NEW_TIMER(t) BM_TIMER_T t##_time = 0; +#define BM_RESET_TIMER(t) t##_time = 0; +#define BM_SWAP_TIMER(t1,t2) do { BM_STOP_TIMER(t1); BM_START_TIMER(t2); } while(0) +#define BM_MMU_INIT() do { \ + BM_TIMER_T gc = gc_time; \ + while (gc > 0) { \ + if (gc > MMU_INTERVAL) { \ + gc -= MMU_INTERVAL - mmu_counter; \ + erts_printf("%d\n",(int)((mmu / MMU_INTERVAL) * 100)); \ + mmu_counter = 0; mmu = 0; \ + } else { \ + mmu_counter += gc; \ + if (mmu_counter >= MMU_INTERVAL) { \ + mmu_counter -= MMU_INTERVAL; \ + erts_printf("%d\n",(int)((mmu / MMU_INTERVAL) * 100)); \ + mmu = 0; \ + } \ + gc = 0; \ + } \ + } \ + BM_RESET_TIMER(system); \ + BM_RESET_TIMER(send); \ + BM_RESET_TIMER(copy); \ + BM_RESET_TIMER(size); \ +} while(0) + +#define BM_MMU_READ() do { \ + BM_TIMER_T mut = system_time + send_time + copy_time + size_time; \ + while (mut > 0) { \ + if (mut > MMU_INTERVAL) { \ + BM_TIMER_T tmp = MMU_INTERVAL - mmu_counter; \ + mmu += tmp; mut -= tmp; \ + erts_printf("%d\n",(int)((mmu / MMU_INTERVAL) * 100)); \ + mmu_counter = 0; mmu = 0; \ + } else { \ + mmu_counter += mut; mmu += mut; \ + if (mmu_counter >= MMU_INTERVAL) { \ + mmu_counter -= MMU_INTERVAL; \ + mmu -= mmu_counter; \ + erts_printf("%d\n",(int)((mmu / MMU_INTERVAL) * 100)); \ + mmu = mmu_counter; \ + } \ + mut = 0; \ + } \ + } \ +} while(0) + +#else /* !BM_TIMERS */ +# define BM_NEW_TIMER(t) +# define BM_START_TIMER(t) +# define BM_STOP_TIMER(t) +# define BM_RESET_TIMER(t) +# define BM_SWAP_TIMER(t1,t2) +# define BM_TIME_PRINTER(str,time) +# define BM_MMU_INIT() +# define BM_MMU_READ() +#endif /* BM_TIMERS */ + +#ifdef BM_HEAP_SIZES +extern unsigned long long max_used_heap; +extern unsigned long long max_allocated_heap; +extern unsigned long long max_used_global_heap; +extern unsigned long long max_allocated_global_heap; +#endif /* BM_HEAP_SIZES */ + +#ifdef BM_MESSAGE_SIZES +extern unsigned long long words_sent; +extern unsigned long long words_copied; +extern unsigned long long words_prealloc; +extern unsigned long long message_sizes[1000]; + +#define BM_MESSAGE_COPIED(size) { \ + words_copied += size; \ + BM_COUNT(messages_copied); } + +#define BM_PREALLOC_DATA(size) { \ + words_prealloc += size; } + +#define BM_MESSAGE(mess,send,rec) { \ + Uint msize = size_object(mess); \ + words_sent += msize; \ + if (msize < 1000) \ + message_sizes[msize]++; \ + else \ + message_sizes[999]++; \ + BM_EGO_COUNT(send,rec); \ + BM_COUNT(messages_sent); } + +#else /* !BM_MESSAGE_SIZES */ + +#define BM_MESSAGE_COPIED(size) BM_COUNT(messages_copied); +#define BM_PREALLOC_DATA(size) +#define BM_MESSAGE(mess,send,rec) { \ + BM_EGO_COUNT(send,rec); \ + BM_COUNT(messages_sent); } + +#endif /* BM_MESSAGE_SIZES */ + +void init_benchmarking(void); +void save_statistics(void); + +#endif /* _BENCHMARK_H_ */ diff --git a/erts/emulator/beam/bif.c b/erts/emulator/beam/bif.c new file mode 100644 index 0000000000..74b231d56d --- /dev/null +++ b/erts/emulator/beam/bif.c @@ -0,0 +1,4201 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include /* offsetof() */ +#include "sys.h" +#include "erl_vm.h" +#include "erl_sys_driver.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "dist.h" +#include "erl_version.h" +#include "erl_binary.h" +#include "beam_bp.h" +#include "erl_db_util.h" +#include "register.h" + +static Export* flush_monitor_message_trap = NULL; +static Export* set_cpu_topology_trap = NULL; +static Export* await_proc_exit_trap = NULL; +Export* erts_format_cpu_topology_trap = NULL; + +#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) + +/* + * The BIF's now follow, see the Erlang Manual for a description of what + * each individual BIF does. + */ + +BIF_RETTYPE spawn_3(BIF_ALIST_3) +{ + ErlSpawnOpts so; + Eterm pid; + + so.flags = 0; + pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so); + if (is_non_value(pid)) { + BIF_ERROR(BIF_P, so.error_code); + } else { + if (ERTS_USE_MODIFIED_TIMING()) { + BIF_TRAP2(erts_delay_trap, BIF_P, pid, ERTS_MODIFIED_TIMING_DELAY); + } + BIF_RET(pid); + } +} + +/**********************************************************************/ + +/* Utility to add a new link between processes p and another internal + * process (rpid). Process p must be the currently executing process. + */ +static int insert_internal_link(Process* p, Eterm rpid) +{ + Process *rp; + ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK; + + ASSERT(is_internal_pid(rpid)); + +#ifdef ERTS_SMP + if (IS_TRACED(p) && (p->trace_flags & (F_TRACE_SOL|F_TRACE_SOL1))) + rp_locks = ERTS_PROC_LOCKS_ALL; + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK); +#endif + + /* get a pointer to the process struct of the linked process */ + rp = erts_pid2proc_opt(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, + rpid, rp_locks, + ERTS_P2P_FLG_ALLOW_OTHER_X); + + if (!rp) { + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + return 0; + } + + if (p != rp) { + erts_add_link(&(p->nlinks), LINK_PID, rp->id); + erts_add_link(&(rp->nlinks), LINK_PID, p->id); + + ASSERT(is_nil(p->tracer_proc) + || is_internal_pid(p->tracer_proc) + || is_internal_port(p->tracer_proc)); + + if (IS_TRACED(p)) { + if (p->trace_flags & (F_TRACE_SOL|F_TRACE_SOL1)) { + rp->trace_flags |= (p->trace_flags & TRACEE_FLAGS); + rp->tracer_proc = p->tracer_proc; /* maybe steal */ + + if (p->trace_flags & F_TRACE_SOL1) { /* maybe override */ + rp->trace_flags &= ~(F_TRACE_SOL1 | F_TRACE_SOL); + p->trace_flags &= ~(F_TRACE_SOL1 | F_TRACE_SOL); + } + } + } + } + if (IS_TRACED_FL(rp, F_TRACE_PROCS)) + trace_proc(p, rp, am_getting_linked, p->id); + + if (p == rp) + erts_smp_proc_unlock(p, rp_locks & ~ERTS_PROC_LOCK_MAIN); + else { + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + erts_smp_proc_unlock(rp, rp_locks); + } + + return 1; +} + + +/* create a link to the process */ +BIF_RETTYPE link_1(BIF_ALIST_1) +{ + DistEntry *dep; + + if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) { + trace_proc(BIF_P, BIF_P, am_link, BIF_ARG_1); + } + /* check that the pid or port which is our argument is OK */ + + if (is_internal_pid(BIF_ARG_1)) { + if (internal_pid_index(BIF_ARG_1) >= erts_max_processes) { + BIF_ERROR(BIF_P, BADARG); + } + + if (insert_internal_link(BIF_P, BIF_ARG_1)) { + BIF_RET(am_true); + } + else { + goto res_no_proc; + } + } + + if (is_internal_port(BIF_ARG_1)) { + Port *pt = erts_id2port(BIF_ARG_1, BIF_P, ERTS_PROC_LOCK_MAIN); + if (!pt) { + goto res_no_proc; + } + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + + if (erts_add_link(&(BIF_P->nlinks), LINK_PID, BIF_ARG_1) >= 0) + erts_add_link(&(pt->nlinks), LINK_PID, BIF_P->id); + /* else: already linked */ + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_port_unlock(pt); + BIF_RET(am_true); + } + else if (is_external_port(BIF_ARG_1) + && external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry) { + goto res_no_proc; + } + + if (is_external_pid(BIF_ARG_1)) { + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + + /* We may earn time by checking first that we're not linked already */ + if (erts_lookup_link(BIF_P->nlinks, BIF_ARG_1) != NULL) { + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + BIF_RET(am_true); + } + else { + ErtsLink *lnk; + int code; + ErtsDSigData dsd; + dep = external_pid_dist_entry(BIF_ARG_1); + if (dep == erts_this_dist_entry) { + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + goto res_no_proc; + } + + code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_RLOCK, 0); + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + /* Let the dlink trap handle it */ + case ERTS_DSIG_PREP_NOT_CONNECTED: + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + BIF_TRAP1(dlink_trap, BIF_P, BIF_ARG_1); + + case ERTS_DSIG_PREP_CONNECTED: + /* We are connected. Setup link and send link signal */ + + erts_smp_de_links_lock(dep); + + erts_add_link(&(BIF_P->nlinks), LINK_PID, BIF_ARG_1); + lnk = erts_add_or_lookup_link(&(dep->nlinks), + LINK_PID, + BIF_P->id); + ASSERT(lnk != NULL); + erts_add_link(&ERTS_LINK_ROOT(lnk), LINK_PID, BIF_ARG_1); + + erts_smp_de_links_unlock(dep); + erts_smp_de_runlock(dep); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + + code = erts_dsig_send_link(&dsd, BIF_P->id, BIF_ARG_1); + if (code == ERTS_DSIG_SEND_YIELD) + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); + BIF_RET(am_true); + default: + ASSERT(! "Invalid dsig prepare result"); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } + } + } + + BIF_ERROR(BIF_P, BADARG); + + res_no_proc: + if (BIF_P->flags & F_TRAPEXIT) { + ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN; + erts_deliver_exit_message(BIF_ARG_1, BIF_P, &locks, am_noproc, NIL); + erts_smp_proc_unlock(BIF_P, ~ERTS_PROC_LOCK_MAIN & locks); + BIF_RET(am_true); + } + else + BIF_ERROR(BIF_P, EXC_NOPROC); +} + +#define ERTS_DEMONITOR_FALSE 2 +#define ERTS_DEMONITOR_TRUE 1 +#define ERTS_DEMONITOR_BADARG 0 +#define ERTS_DEMONITOR_YIELD_TRUE -1 +#define ERTS_DEMONITOR_INTERNAL_ERROR -2 + +static int +remote_demonitor(Process *c_p, DistEntry *dep, Eterm ref, Eterm to) +{ + ErtsDSigData dsd; + ErtsMonitor *dmon; + ErtsMonitor *mon; + int code; + int res; +#ifndef ERTS_SMP + int stale_mon = 0; +#endif + + ERTS_SMP_LC_ASSERT((ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK) + == erts_proc_lc_my_proc_locks(c_p)); + + code = erts_dsig_prepare(&dsd, dep, c_p, ERTS_DSP_RLOCK, 0); + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + case ERTS_DSIG_PREP_NOT_CONNECTED: +#ifndef ERTS_SMP + /* XXX Is this possible? Shouldn't this link + previously have been removed if the node + had previously been disconnected. */ + ASSERT(0); + stale_mon = 1; +#endif + /* + * In the smp case this is possible if the node goes + * down just before the call to demonitor. + */ + if (dep) { + erts_smp_de_links_lock(dep); + dmon = erts_remove_monitor(&dep->monitors, ref); + erts_smp_de_links_unlock(dep); + if (dmon) + erts_destroy_monitor(dmon); + } + mon = erts_remove_monitor(&c_p->monitors, ref); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_LINK); + + res = ERTS_DEMONITOR_TRUE; + break; + + case ERTS_DSIG_PREP_CONNECTED: + + erts_smp_de_links_lock(dep); + mon = erts_remove_monitor(&c_p->monitors, ref); + dmon = erts_remove_monitor(&dep->monitors, ref); + erts_smp_de_links_unlock(dep); + erts_smp_de_runlock(dep); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_LINK); + + if (!dmon) { +#ifndef ERTS_SMP + /* XXX How is this possible? Shouldn't this link + previously have been removed when the distributed + end was removed. */ + ASSERT(0); + stale_mon = 1; +#endif + /* + * This is possible when smp support is enabled. + * 'DOWN' message just arrived. + */ + res = ERTS_DEMONITOR_TRUE; + } + else { + /* + * Soft (no force) send, use ->data in dist slot + * monitor list since in case of monitor name + * the atom is stored there. Yield if necessary. + */ + code = erts_dsig_send_demonitor(&dsd, + c_p->id, + (mon->name != NIL + ? mon->name + : mon->pid), + ref, + 0); + res = (code == ERTS_DSIG_SEND_YIELD + ? ERTS_DEMONITOR_YIELD_TRUE + : ERTS_DEMONITOR_TRUE); + erts_destroy_monitor(dmon); + + } + break; + default: + ASSERT(! "Invalid dsig prepare result"); + res = ERTS_DEMONITOR_INTERNAL_ERROR; + break; + } + +#ifndef ERTS_SMP + if (stale_mon) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Stale process monitor %T to ", ref); + if (is_atom(to)) + erts_dsprintf(dsbufp, "{%T, %T}", to, dep->sysname); + else + erts_dsprintf(dsbufp, "%T", to); + erts_dsprintf(dsbufp, " found\n"); + erts_send_error_to_logger(c_p->group_leader, dsbufp); + } +#endif + + /* + * We aren't allowed to destroy 'mon' until now, since 'to' + * may refer into 'mon' (external pid). + */ + ASSERT(mon); /* Since link lock wasn't released between + lookup and remove */ + erts_destroy_monitor(mon); + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p)); + return res; +} + +static int demonitor(Process *c_p, Eterm ref) +{ + ErtsMonitor *mon = NULL; /* The monitor entry to delete */ + Process *rp; /* Local target process */ + Eterm to = NIL; /* Monitor link traget */ + Eterm ref_p; /* Pid of this end */ + DistEntry *dep = NULL; /* Target's distribution entry */ + int deref_de = 0; + int res; + int unlock_link = 1; + + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_LINK); + + if (is_not_internal_ref(ref)) { + res = ERTS_DEMONITOR_BADARG; + goto done; /* Cannot be this monitor's ref */ + } + ref_p = c_p->id; + + mon = erts_lookup_monitor(c_p->monitors, ref); + if (!mon) { + res = ERTS_DEMONITOR_FALSE; + goto done; + } + + if (mon->type != MON_ORIGIN) { + res = ERTS_DEMONITOR_BADARG; + goto done; + } + to = mon->pid; + + if (is_atom(to)) { + /* Monitoring a name at node to */ + ASSERT(is_node_name_atom(to)); + dep = erts_sysname_to_connected_dist_entry(to); + ASSERT(dep != erts_this_dist_entry); + if (dep) + deref_de = 1; + } else { + ASSERT(is_pid(to)); + dep = pid_dist_entry(to); + } + if (dep != erts_this_dist_entry) { + res = remote_demonitor(c_p, dep, ref, to); + /* remote_demonitor() unlocks link lock on c_p */ + unlock_link = 0; + } + else { /* Local monitor */ + if (deref_de) { + deref_de = 0; + erts_deref_dist_entry(dep); + } + dep = NULL; + rp = erts_pid2proc_opt(c_p, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, + to, + ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + mon = erts_remove_monitor(&c_p->monitors, ref); +#ifndef ERTS_SMP + ASSERT(mon); +#else + if (!mon) + res = ERTS_DEMONITOR_FALSE; + else +#endif + { + res = ERTS_DEMONITOR_TRUE; + erts_destroy_monitor(mon); + } + if (rp) { + ErtsMonitor *rmon; + rmon = erts_remove_monitor(&(rp->monitors), ref); + if (rp != c_p) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + if (rmon != NULL) + erts_destroy_monitor(rmon); + } + else { + ERTS_SMP_ASSERT_IS_NOT_EXITING(c_p); + } + + } + + done: + + if (unlock_link) + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_LINK); + + if (deref_de) { + ASSERT(dep); + erts_deref_dist_entry(dep); + } + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(c_p)); + return res; +} + +BIF_RETTYPE demonitor_1(BIF_ALIST_1) +{ + switch (demonitor(BIF_P, BIF_ARG_1)) { + case ERTS_DEMONITOR_FALSE: + case ERTS_DEMONITOR_TRUE: + BIF_RET(am_true); + case ERTS_DEMONITOR_YIELD_TRUE: + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); + case ERTS_DEMONITOR_BADARG: + BIF_ERROR(BIF_P, BADARG); + case ERTS_DEMONITOR_INTERNAL_ERROR: + default: + ASSERT(! "demonitor(): internal error"); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } +} + +BIF_RETTYPE demonitor_2(BIF_ALIST_2) +{ + Eterm res = am_true; + int info = 0; + int flush = 0; + Eterm list = BIF_ARG_2; + + while (is_list(list)) { + Eterm* consp = list_val(list); + switch (CAR(consp)) { + case am_flush: + flush = 1; + break; + case am_info: + info = 1; + break; + default: + goto badarg; + } + list = CDR(consp); + } + + if (is_not_nil(list)) + goto badarg; + + switch (demonitor(BIF_P, BIF_ARG_1)) { + case ERTS_DEMONITOR_FALSE: + if (info) + res = am_false; + if (flush) + BIF_TRAP2(flush_monitor_message_trap, BIF_P, BIF_ARG_1, res); + case ERTS_DEMONITOR_TRUE: + BIF_RET(res); + case ERTS_DEMONITOR_YIELD_TRUE: + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); + case ERTS_DEMONITOR_BADARG: + badarg: + BIF_ERROR(BIF_P, BADARG); + case ERTS_DEMONITOR_INTERNAL_ERROR: + default: + ASSERT(! "demonitor(): internal error"); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } +} + +/* Type must be atomic object! */ +void +erts_queue_monitor_message(Process *p, + ErtsProcLocks *p_locksp, + Eterm ref, + Eterm type, + Eterm item, + Eterm reason) +{ + Eterm tup; + Eterm* hp; + Eterm reason_copy, ref_copy, item_copy; + Uint reason_size, ref_size, item_size, heap_size; + ErlOffHeap *ohp; + ErlHeapFragment *bp; + + reason_size = IS_CONST(reason) ? 0 : size_object(reason); + item_size = IS_CONST(item) ? 0 : size_object(item); + ref_size = size_object(ref); + + heap_size = 6+reason_size+ref_size+item_size; + + hp = erts_alloc_message_heap(heap_size, + &bp, + &ohp, + p, + p_locksp); + + reason_copy = (IS_CONST(reason) + ? reason + : copy_struct(reason, reason_size, &hp, ohp)); + item_copy = (IS_CONST(item) + ? item + : copy_struct(item, item_size, &hp, ohp)); + ref_copy = copy_struct(ref, ref_size, &hp, ohp); + + tup = TUPLE5(hp, am_DOWN, ref_copy, type, item_copy, reason_copy); + erts_queue_message(p, p_locksp, bp, tup, NIL); +} + +static BIF_RETTYPE +local_pid_monitor(Process *p, Eterm target) +{ + BIF_RETTYPE ret; + Eterm mon_ref; + Process *rp; + ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK; + + mon_ref = erts_make_ref(p); + ERTS_BIF_PREP_RET(ret, mon_ref); + if (target == p->id) { + return ret; + } + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK); + rp = erts_pid2proc_opt(p, p_locks, + target, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + if (!rp) { + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + p_locks &= ~ERTS_PROC_LOCK_LINK; + erts_queue_monitor_message(p, &p_locks, + mon_ref, am_process, target, am_noproc); + } + else { + ASSERT(rp != p); + + erts_add_monitor(&(p->monitors), MON_ORIGIN, mon_ref, target, NIL); + erts_add_monitor(&(rp->monitors), MON_TARGET, mon_ref, p->id, NIL); + + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + } + + erts_smp_proc_unlock(p, p_locks & ~ERTS_PROC_LOCK_MAIN); + + return ret; +} + +static BIF_RETTYPE +local_name_monitor(Process *p, Eterm target_name) +{ + BIF_RETTYPE ret; + Eterm mon_ref; + ErtsProcLocks p_locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK; + Process *rp; + + mon_ref = erts_make_ref(p); + ERTS_BIF_PREP_RET(ret, mon_ref); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK); + rp = erts_whereis_process(p, p_locks, target_name, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + if (!rp) { + Eterm lhp[3]; + Eterm item; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + p_locks &= ~ERTS_PROC_LOCK_LINK; + item = TUPLE2(lhp, target_name, erts_this_dist_entry->sysname); + erts_queue_monitor_message(p, &p_locks, + mon_ref, am_process, item, am_noproc); + } + else if (rp != p) { + erts_add_monitor(&(p->monitors), MON_ORIGIN, mon_ref, rp->id, + target_name); + erts_add_monitor(&(rp->monitors), MON_TARGET, mon_ref, p->id, + target_name); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + } + + erts_smp_proc_unlock(p, p_locks & ~ERTS_PROC_LOCK_MAIN); + + return ret; +} + +static BIF_RETTYPE +remote_monitor(Process *p, Eterm bifarg1, Eterm bifarg2, + DistEntry *dep, Eterm target, int byname) +{ + ErtsDSigData dsd; + BIF_RETTYPE ret; + int code; + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_LINK); + code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_RLOCK, 0); + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + /* Let the dmonitor_p trap handle it */ + case ERTS_DSIG_PREP_NOT_CONNECTED: + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + ERTS_BIF_PREP_TRAP2(ret, dmonitor_p_trap, p, bifarg1, bifarg2); + break; + case ERTS_DSIG_PREP_CONNECTED: + if (!(dep->flags & DFLAG_DIST_MONITOR) + || (byname && !(dep->flags & DFLAG_DIST_MONITOR_NAME))) { + erts_smp_de_runlock(dep); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + ERTS_BIF_PREP_ERROR(ret, p, BADARG); + } + else { + Eterm p_trgt, p_name, d_name, mon_ref; + + mon_ref = erts_make_ref(p); + + if (byname) { + p_trgt = dep->sysname; + p_name = target; + d_name = target; + } + else { + p_trgt = target; + p_name = NIL; + d_name = NIL; + } + + erts_smp_de_links_lock(dep); + + erts_add_monitor(&(p->monitors), MON_ORIGIN, mon_ref, p_trgt, + p_name); + erts_add_monitor(&(dep->monitors), MON_TARGET, mon_ref, p->id, + d_name); + + erts_smp_de_links_unlock(dep); + erts_smp_de_runlock(dep); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + + code = erts_dsig_send_monitor(&dsd, p->id, target, mon_ref); + if (code == ERTS_DSIG_SEND_YIELD) + ERTS_BIF_PREP_YIELD_RETURN(ret, p, mon_ref); + else + ERTS_BIF_PREP_RET(ret, mon_ref); + } + break; + default: + ASSERT(! "Invalid dsig prepare result"); + ERTS_BIF_PREP_ERROR(ret, p, EXC_INTERNAL_ERROR); + break; + } + + return ret; +} + +BIF_RETTYPE monitor_2(BIF_ALIST_2) +{ + Eterm target = BIF_ARG_2; + BIF_RETTYPE ret; + DistEntry *dep = NULL; + int deref_de = 0; + + /* Only process monitors are implemented */ + if (BIF_ARG_1 != am_process) { + goto error; + } + + if (is_internal_pid(target)) { + local_pid: + ret = local_pid_monitor(BIF_P, target); + } else if (is_external_pid(target)) { + dep = external_pid_dist_entry(target); + if (dep == erts_this_dist_entry) + goto local_pid; + ret = remote_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, dep, target, 0); + } else if (is_atom(target)) { + ret = local_name_monitor(BIF_P, target); + } else if (is_tuple(target)) { + Eterm *tp = tuple_val(target); + Eterm remote_node; + Eterm name; + if (arityval(*tp) != 2) + goto error; + remote_node = tp[2]; + name = tp[1]; + if (!is_atom(remote_node) || !is_atom(name)) { + goto error; + } + if (!erts_is_alive && remote_node != am_Noname) { + goto error; /* Remote monitor from (this) undistributed node */ + } + dep = erts_sysname_to_connected_dist_entry(remote_node); + if (dep == erts_this_dist_entry) { + deref_de = 1; + ret = local_name_monitor(BIF_P, name); + } else { + if (dep) + deref_de = 1; + ret = remote_monitor(BIF_P, BIF_ARG_1, BIF_ARG_2, dep, name, 1); + } + } else { + error: + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + } + if (deref_de) { + deref_de = 0; + erts_deref_dist_entry(dep); + } + + return ret; +} + + +/**********************************************************************/ +/* this is a combination of the spawn and link BIFs */ + +BIF_RETTYPE spawn_link_3(BIF_ALIST_3) +{ + ErlSpawnOpts so; + Eterm pid; + + so.flags = SPO_LINK; + pid = erl_create_process(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, &so); + if (is_non_value(pid)) { + BIF_ERROR(BIF_P, so.error_code); + } else { + if (ERTS_USE_MODIFIED_TIMING()) { + BIF_TRAP2(erts_delay_trap, BIF_P, pid, ERTS_MODIFIED_TIMING_DELAY); + } + BIF_RET(pid); + } +} + +/**********************************************************************/ + +BIF_RETTYPE spawn_opt_1(BIF_ALIST_1) +{ + ErlSpawnOpts so; + Eterm pid; + Eterm* tp; + Eterm ap; + Eterm arg; + Eterm res; + + /* + * Check that the first argument is a tuple of four elements. + */ + if (is_not_tuple(BIF_ARG_1)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + tp = tuple_val(BIF_ARG_1); + if (*tp != make_arityval(4)) + goto error; + + /* + * Store default values for options. + */ + so.flags = SPO_USE_ARGS; + so.min_heap_size = H_MIN_SIZE; + so.priority = PRIORITY_NORMAL; + so.max_gen_gcs = (Uint16) erts_smp_atomic_read(&erts_max_gen_gcs); + so.scheduler = 0; + + /* + * Walk through the option list. + */ + ap = tp[4]; + while (is_list(ap)) { + arg = CAR(list_val(ap)); + if (arg == am_link) { + so.flags |= SPO_LINK; + } else if (arg == am_monitor) { + so.flags |= SPO_MONITOR; + } else if (is_tuple(arg)) { + Eterm* tp2 = tuple_val(arg); + Eterm val; + if (*tp2 != make_arityval(2)) + goto error; + arg = tp2[1]; + val = tp2[2]; + if (arg == am_priority) { + if (val == am_max) + so.priority = PRIORITY_MAX; + else if (val == am_high) + so.priority = PRIORITY_HIGH; + else if (val == am_normal) + so.priority = PRIORITY_NORMAL; + else if (val == am_low) + so.priority = PRIORITY_LOW; + else + goto error; + } else if (arg == am_min_heap_size && is_small(val)) { + Sint min_heap_size = signed_val(val); + if (min_heap_size < 0) { + goto error; + } else if (min_heap_size < H_MIN_SIZE) { + so.min_heap_size = H_MIN_SIZE; + } else { + so.min_heap_size = erts_next_heap_size(min_heap_size, 0); + } + } else if (arg == am_fullsweep_after && is_small(val)) { + Sint max_gen_gcs = signed_val(val); + if (max_gen_gcs < 0) { + goto error; + } else { + so.max_gen_gcs = max_gen_gcs; + } + } else if (arg == am_scheduler && is_small(val)) { + Sint scheduler = signed_val(val); + if (erts_common_run_queue && erts_no_schedulers > 1) + goto error; + if (scheduler < 0 || erts_no_schedulers < scheduler) + goto error; + so.scheduler = (int) scheduler; + } else { + goto error; + } + } else { + goto error; + } + ap = CDR(list_val(ap)); + } + if (is_not_nil(ap)) { + goto error; + } + + /* + * Spawn the process. + */ + pid = erl_create_process(BIF_P, tp[1], tp[2], tp[3], &so); + if (is_non_value(pid)) { + BIF_ERROR(BIF_P, so.error_code); + } else if (so.flags & SPO_MONITOR) { + Eterm* hp = HAlloc(BIF_P, 3); + res = TUPLE2(hp, pid, so.mref); + } else { + res = pid; + } + + if (ERTS_USE_MODIFIED_TIMING()) { + BIF_TRAP2(erts_delay_trap, BIF_P, res, ERTS_MODIFIED_TIMING_DELAY); + } + else { + BIF_RET(res); + } +} + + +/**********************************************************************/ +/* remove a link from a process */ +BIF_RETTYPE unlink_1(BIF_ALIST_1) +{ + Process *rp; + DistEntry *dep; + ErtsLink *l = NULL, *rl = NULL; + + /* + * SMP specific note concerning incoming exit signals: + * We have to have at least the status lock during removal of + * the link half on current process, and check for and handle + * a present pending exit while the status lock is held. This + * in order to ensure that we wont be exited by a link after + * it has been removed. + * + * (We also have to have the link lock, of course, in order to + * be allowed to remove the link...) + */ + + if (IS_TRACED_FL(BIF_P, F_TRACE_PROCS)) { + trace_proc(BIF_P, BIF_P, am_unlink, BIF_ARG_1); + } + + if (is_internal_port(BIF_ARG_1)) { + Port *pt = erts_id2port_sflgs(BIF_ARG_1, + BIF_P, + ERTS_PROC_LOCK_MAIN, + ERTS_PORT_SFLGS_DEAD); + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); +#ifdef ERTS_SMP + if (ERTS_PROC_PENDING_EXIT(BIF_P)) { + if (pt) + erts_smp_port_unlock(pt); + goto handle_pending_exit; + } +#endif + + l = erts_remove_link(&BIF_P->nlinks, BIF_ARG_1); + + ASSERT(pt || !l); + + if (pt) { + rl = erts_remove_link(&pt->nlinks, BIF_P->id); + erts_smp_port_unlock(pt); + if (rl) + erts_destroy_link(rl); + } + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + + if (l) + erts_destroy_link(l); + + BIF_RET(am_true); + } + else if (is_external_port(BIF_ARG_1) + && external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry) { + BIF_RET(am_true); + } + + if (is_not_pid(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + + if (is_external_pid(BIF_ARG_1)) { + ErtsDistLinkData dld; + int code; + ErtsDSigData dsd; + /* Blind removal, we might have trapped or anything, this leaves + us in a state where monitors might be inconsistent, but the dist + code should take care of it. */ + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); +#ifdef ERTS_SMP + if (ERTS_PROC_PENDING_EXIT(BIF_P)) + goto handle_pending_exit; +#endif + l = erts_remove_link(&BIF_P->nlinks,BIF_ARG_1); + + erts_smp_proc_unlock(BIF_P, + ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + + if (l) + erts_destroy_link(l); + + dep = external_pid_dist_entry(BIF_ARG_1); + if (dep == erts_this_dist_entry) { + BIF_RET(am_true); + } + + code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0); + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + case ERTS_DSIG_PREP_NOT_CONNECTED: +#if 1 + BIF_RET(am_true); +#else + /* + * This is how we used to do it, but the link is obviously not + * active, so I see no point in setting up a connection. + * /Rickard + */ + BIF_TRAP1(dunlink_trap, BIF_P, BIF_ARG_1); +#endif + + case ERTS_DSIG_PREP_CONNECTED: + erts_remove_dist_link(&dld, BIF_P->id, BIF_ARG_1, dep); + code = erts_dsig_send_unlink(&dsd, BIF_P->id, BIF_ARG_1); + erts_destroy_dist_link(&dld); + if (code == ERTS_DSIG_SEND_YIELD) + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); + BIF_RET(am_true); + + default: + ASSERT(! "Invalid dsig prepare result"); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } + } + + /* Internal pid... */ + + /* process ok ? */ + if (internal_pid_index(BIF_ARG_1) >= erts_max_processes) + BIF_ERROR(BIF_P, BADARG); + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + + /* get process struct */ + rp = erts_pid2proc_opt(BIF_P, (ERTS_PROC_LOCK_MAIN + | ERTS_PROC_LOCK_LINK + | ERTS_PROC_LOCK_STATUS), + BIF_ARG_1, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + +#ifdef ERTS_SMP + if (ERTS_PROC_PENDING_EXIT(BIF_P)) { + if (rp && rp != BIF_P) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + goto handle_pending_exit; + } +#endif + + /* unlink and ignore errors */ + l = erts_remove_link(&BIF_P->nlinks,BIF_ARG_1); + if (l != NULL) + erts_destroy_link(l); + + if (!rp) { + ERTS_SMP_ASSERT_IS_NOT_EXITING(BIF_P); + } + else { + rl = erts_remove_link(&(rp->nlinks),BIF_P->id); + if (rl != NULL) + erts_destroy_link(rl); + + if (IS_TRACED_FL(rp, F_TRACE_PROCS) && rl != NULL) { + trace_proc(BIF_P, rp, am_getting_unlinked, BIF_P->id); + } + + if (rp != BIF_P) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + } + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + + BIF_RET(am_true); + +#ifdef ERTS_SMP + handle_pending_exit: + erts_handle_pending_exit(BIF_P, (ERTS_PROC_LOCK_MAIN + | ERTS_PROC_LOCK_LINK + | ERTS_PROC_LOCK_STATUS)); + ASSERT(ERTS_PROC_IS_EXITING(BIF_P)); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + ERTS_BIF_EXITED(BIF_P); +#endif +} + +BIF_RETTYPE hibernate_3(BIF_ALIST_3) +{ + /* + * hibernate/3 is implemented as an instruction; therefore + * this function will never be called. + */ + BIF_ERROR(BIF_P, BADARG); +} + +/**********************************************************************/ + +BIF_RETTYPE get_stacktrace_0(Process* p) +{ + Eterm t = build_stacktrace(p, p->ftrace); + BIF_RET(t); +} + +/**********************************************************************/ +/* + * This is like exit/1, except that errors are logged if they terminate + * the process, and the final error value will be {Term,StackTrace}. + */ + +BIF_RETTYPE error_1(Process* p, Eterm term) +{ + p->fvalue = term; + BIF_ERROR(p, EXC_ERROR); +} + +/**********************************************************************/ +/* + * This is like error/1, except that the given 'args' will be included + * in the stacktrace. + */ + +BIF_RETTYPE error_2(Process* p, Eterm value, Eterm args) +{ + Eterm* hp = HAlloc(p, 3); + + p->fvalue = TUPLE2(hp, value, args); + BIF_ERROR(p, EXC_ERROR_2); +} + +/**********************************************************************/ +/* this is like throw/1 except that we set freason to EXC_EXIT */ + +BIF_RETTYPE exit_1(BIF_ALIST_1) +{ + BIF_P->fvalue = BIF_ARG_1; /* exit value */ + BIF_ERROR(BIF_P, EXC_EXIT); +} + + +/**********************************************************************/ +/* raise an exception of given class, value and stacktrace. + * + * If there is an error in the argument format, + * return the atom 'badarg' instead. + */ +Eterm +raise_3(Process *c_p, Eterm class, Eterm value, Eterm stacktrace) { + Eterm reason; + Eterm l, *hp, *hp_end, *tp; + int depth, cnt; + size_t sz; + struct StackTrace *s; + + if (class == am_error) { + c_p->fvalue = value; + reason = EXC_ERROR; + } else if (class == am_exit) { + c_p->fvalue = value; + reason = EXC_EXIT; + } else if (class == am_throw) { + c_p->fvalue = value; + reason = EXC_THROWN; + } else goto error; + reason &= ~EXF_SAVETRACE; + + /* Check syntax of stacktrace, and count depth. + * Accept anything that can be returned from erlang:get_stacktrace/0, + * as well as a 2-tuple with a fun as first element that the + * error_handler may need to give us. + */ + for (l = stacktrace, depth = 0; + is_list(l); + l = CDR(list_val(l)), depth++) { + Eterm t = CAR(list_val(l)); + int arity; + if (is_not_tuple(t)) goto error; + tp = tuple_val(t); + arity = arityval(tp[0]); + if ((arity == 3) && is_atom(tp[1]) && is_atom(tp[2])) continue; + if ((arity == 2) && is_fun(tp[1])) continue; + goto error; + } + if (is_not_nil(l)) goto error; + + /* Create stacktrace and store */ + if (depth <= erts_backtrace_depth) { + cnt = 0; + c_p->ftrace = stacktrace; + } else { + cnt = depth = erts_backtrace_depth; + c_p->ftrace = NIL; + } + tp = &c_p->ftrace; + sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm) - 1) + / sizeof(Eterm); + hp = HAlloc(c_p, sz + 2*(cnt + 1)); + hp_end = hp + sz + 2*(cnt + 1); + s = (struct StackTrace *) hp; + s->header = make_neg_bignum_header(sz - 1); + s->freason = reason; + s->pc = NULL; + s->current = NULL; + s->depth = 0; + hp += sz; + if (cnt > 0) { + /* Copy list up to depth */ + for (cnt = 0, l = stacktrace; + cnt < depth; + cnt++, l = CDR(list_val(l))) { + ASSERT(*tp == NIL); + *tp = CONS(hp, CAR(list_val(l)), *tp); + tp = &CDR(list_val(*tp)); + hp += 2; + } + } + c_p->ftrace = CONS(hp, c_p->ftrace, make_big((Eterm *) s)); + hp += 2; + ASSERT(hp <= hp_end); + + BIF_ERROR(c_p, reason); + + error: + return am_badarg; +} + +/**********************************************************************/ +/* send an exit message to another process (if trapping exits) or + exit the other process */ + +BIF_RETTYPE exit_2(BIF_ALIST_2) +{ + Process *rp; + + /* + * If the first argument is not a pid, or a local port it is an error. + */ + + if (is_internal_port(BIF_ARG_1)) { + Port *prt; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + prt = erts_id2port(BIF_ARG_1, NULL, 0); + if (prt) { + erts_do_exit_port(prt, BIF_P->id, BIF_ARG_2); + erts_port_release(prt); + } + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + ERTS_BIF_CHK_EXITED(BIF_P); + BIF_RET(am_true); + } + else if(is_external_port(BIF_ARG_1) + && external_port_dist_entry(BIF_ARG_1) == erts_this_dist_entry) + BIF_RET(am_true); + + /* + * If it is a remote pid, send a signal to the remote node. + */ + + if (is_external_pid(BIF_ARG_1)) { + int code; + ErtsDSigData dsd; + DistEntry *dep; + + dep = external_pid_dist_entry(BIF_ARG_1); + if(dep == erts_this_dist_entry) + BIF_RET(am_true); + + code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0); + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + case ERTS_DSIG_PREP_NOT_CONNECTED: + BIF_TRAP2(dexit_trap, BIF_P, BIF_ARG_1, BIF_ARG_2); + case ERTS_DSIG_PREP_CONNECTED: + code = erts_dsig_send_exit2(&dsd, BIF_P->id, BIF_ARG_1, BIF_ARG_2); + if (code == ERTS_DSIG_SEND_YIELD) + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); + BIF_RET(am_true); + default: + ASSERT(! "Invalid dsig prepare result"); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } + } + else if (is_not_internal_pid(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + else { + /* + * The pid is internal. Verify that it refers to an existing process. + */ + ErtsProcLocks rp_locks; + + if (internal_pid_index(BIF_ARG_1) >= erts_max_processes) + BIF_ERROR(BIF_P, BADARG); + if (BIF_ARG_1 == BIF_P->id) { + rp_locks = ERTS_PROC_LOCKS_ALL; + rp = BIF_P; + erts_smp_proc_lock(rp, ERTS_PROC_LOCKS_ALL_MINOR); + } + else { + rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; + rp = erts_pid2proc_opt(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, rp_locks, + ERTS_P2P_FLG_SMP_INC_REFC); + if (!rp) { + BIF_RET(am_true); + } + } + + /* + * Send an exit signal. + */ + erts_send_exit_signal(BIF_P, + BIF_P->id, + rp, + &rp_locks, + BIF_ARG_2, + NIL, + NULL, + BIF_P == rp ? ERTS_XSIG_FLG_NO_IGN_NORMAL : 0); +#ifdef ERTS_SMP + if (rp == BIF_P) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + else + erts_smp_proc_dec_refc(rp); + erts_smp_proc_unlock(rp, rp_locks); +#endif + /* + * We may have exited ourselves and may have to take action. + */ + ERTS_BIF_CHK_EXITED(BIF_P); + BIF_RET(am_true); + } +} + +/**********************************************************************/ +/* this sets some process info- trapping exits or the error handler */ + + +/* Handle flags common to both process_flag_2 and process_flag_3. */ +static BIF_RETTYPE process_flag_aux(Process *BIF_P, + Process *rp, + Eterm flag, + Eterm val) +{ + Eterm old_value = NIL; /* shut up warning about use before set */ + Sint i; + if (flag == am_save_calls) { + struct saved_calls *scb; + if (!is_small(val)) + goto error; + i = signed_val(val); + if (i < 0 || i > 10000) + goto error; + + if (i == 0) + scb = NULL; + else { + Uint sz = sizeof(*scb) + (i-1) * sizeof(scb->ct[0]); + scb = erts_alloc(ERTS_ALC_T_CALLS_BUF, sz); + scb->len = i; + scb->cur = 0; + scb->n = 0; + } + + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(rp, ERTS_PROC_LOCK_MAIN, scb); + + if (!scb) + old_value = make_small(0); + else { + old_value = make_small(scb->len); + erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb); + } + + /* Make sure the process in question is rescheduled + immediately, if it's us, so the call saving takes effect. */ + if (rp == BIF_P) + BIF_RET2(old_value, CONTEXT_REDS); + else + BIF_RET(old_value); + } + + error: + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE process_flag_2(BIF_ALIST_2) +{ + Eterm old_value; + if (BIF_ARG_1 == am_error_handler) { + if (is_not_atom(BIF_ARG_2)) { + goto error; + } + old_value = erts_proc_set_error_handler(BIF_P, + ERTS_PROC_LOCK_MAIN, + BIF_ARG_2); + BIF_RET(old_value); + } + else if (BIF_ARG_1 == am_priority) { + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_STATUS); + old_value = erts_set_process_priority(BIF_P, BIF_ARG_2); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS); + if (old_value == THE_NON_VALUE) + goto error; + BIF_RET(old_value); + } + else if (BIF_ARG_1 == am_trap_exit) { + Uint trap_exit; + if (BIF_ARG_2 == am_true) { + trap_exit = 1; + } else if (BIF_ARG_2 == am_false) { + trap_exit = 0; + } else { + goto error; + } + /* + * NOTE: It is important that we check for pending exit signals + * and handle them before flag trap_exit is set to true. + * For more info, see implementation of erts_send_exit_signal(). + */ + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_STATUS); + ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + old_value = ERTS_PROC_IS_TRAPPING_EXITS(BIF_P) ? am_true : am_false; + if (trap_exit) { + ERTS_PROC_SET_TRAP_EXIT(BIF_P); + } else { + ERTS_PROC_UNSET_TRAP_EXIT(BIF_P); + } + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS); + BIF_RET(old_value); + } + else if (BIF_ARG_1 == am_scheduler) { + int yield; + ErtsRunQueue *old; + ErtsRunQueue *new; + Sint sched; + if (erts_common_run_queue && erts_no_schedulers > 1) + goto error; + if (!is_small(BIF_ARG_2)) + goto error; + sched = signed_val(BIF_ARG_2); + if (sched < 0 || erts_no_schedulers < sched) + goto error; + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_STATUS); + old = BIF_P->bound_runq; +#ifdef ERTS_SMP + ASSERT(!old || old == BIF_P->run_queue); +#endif + new = !sched ? NULL : erts_schedid2runq(sched); +#ifndef ERTS_SMP + yield = 0; +#else + if (new == old) + yield = 0; + else { + ErtsRunQueue *curr = BIF_P->run_queue; + if (!new) + erts_smp_runq_lock(curr); + else + erts_smp_runqs_lock(curr, new); + yield = new && BIF_P->run_queue != new; +#endif + BIF_P->bound_runq = new; +#ifdef ERTS_SMP + if (new) + BIF_P->run_queue = new; + if (!new) + erts_smp_runq_unlock(curr); + else + erts_smp_runqs_unlock(curr, new); + } +#endif + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_STATUS); + old_value = old ? make_small(old->ix+1) : make_small(0); + if (yield) + ERTS_BIF_YIELD_RETURN_X(BIF_P, old_value, am_scheduler); + else + BIF_RET(old_value); + } + else if (BIF_ARG_1 == am_min_heap_size) { + Sint i; + if (!is_small(BIF_ARG_2)) { + goto error; + } + i = signed_val(BIF_ARG_2); + if (i < 0) { + goto error; + } + old_value = make_small(BIF_P->min_heap_size); + if (i < H_MIN_SIZE) { + BIF_P->min_heap_size = H_MIN_SIZE; + } else { + BIF_P->min_heap_size = erts_next_heap_size(i, 0); + } + BIF_RET(old_value); + } + else if (BIF_ARG_1 == am_sensitive) { + Uint is_sensitive; + if (BIF_ARG_2 == am_true) { + is_sensitive = 1; + } else if (BIF_ARG_2 == am_false) { + is_sensitive = 0; + } else { + goto error; + } + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR); + old_value = BIF_P->trace_flags & F_SENSITIVE ? am_true : am_false; + if (is_sensitive) { + BIF_P->trace_flags |= F_SENSITIVE; + } else { + BIF_P->trace_flags &= ~F_SENSITIVE; + } + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR); + BIF_RET(old_value); + } + else if (BIF_ARG_1 == am_monitor_nodes) { + /* + * This argument is intentionally *not* documented. It is intended + * to be used by net_kernel:monitor_nodes/1. + */ + old_value = erts_monitor_nodes(BIF_P, BIF_ARG_2, NIL); + if (old_value == THE_NON_VALUE) + goto error; + BIF_RET(old_value); + } + else if (is_tuple(BIF_ARG_1)) { + /* + * This argument is intentionally *not* documented. It is intended + * to be used by net_kernel:monitor_nodes/2. + */ + Eterm *tp = tuple_val(BIF_ARG_1); + if (arityval(tp[0]) == 2) { + if (tp[1] == am_monitor_nodes) { + old_value = erts_monitor_nodes(BIF_P, BIF_ARG_2, tp[2]); + if (old_value == THE_NON_VALUE) + goto error; + BIF_RET(old_value); + } + } + /* Fall through and try process_flag_aux() ... */ + } + + BIF_RET(process_flag_aux(BIF_P, BIF_P, BIF_ARG_1, BIF_ARG_2)); + error: + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE process_flag_3(BIF_ALIST_3) +{ + Process *rp; + Eterm res; + + if ((rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCK_MAIN)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + res = process_flag_aux(BIF_P, rp, BIF_ARG_2, BIF_ARG_3); + + if (rp != BIF_P) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + + return res; +} + +/**********************************************************************/ + +/* register(atom, Process|Port) registers a global process or port + (for this node) */ + +BIF_RETTYPE register_2(BIF_ALIST_2) /* (Atom, Pid|Port) */ +{ + if (erts_register_name(BIF_P, BIF_ARG_1, BIF_ARG_2)) + BIF_RET(am_true); + else { + BIF_ERROR(BIF_P, BADARG); + } +} + + +/**********************************************************************/ + +/* removes the registration of a process or port */ + +BIF_RETTYPE unregister_1(BIF_ALIST_1) +{ + int res; + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + res = erts_unregister_name(BIF_P, ERTS_PROC_LOCK_MAIN, NULL, BIF_ARG_1); + if (res == 0) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(am_true); +} + +/**********************************************************************/ + +/* find out the pid of a registered process */ +/* this is a rather unsafe BIF as it allows users to do nasty things. */ + +BIF_RETTYPE whereis_1(BIF_ALIST_1) +{ + Eterm res; + + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + res = erts_whereis_name_to_id(BIF_P, BIF_ARG_1); + BIF_RET(res); +} + +/**********************************************************************/ + +/* + * erlang:'!'/2 + */ + +Eterm +ebif_bang_2(Process* p, Eterm To, Eterm Message) +{ + return send_2(p, To, Message); +} + + +/* + * Send a message to Process, Port or Registered Process. + * Returns non-negative reduction bump or negative result code. + */ +#define SEND_TRAP (-1) +#define SEND_YIELD (-2) +#define SEND_YIELD_RETURN (-3) +#define SEND_BADARG (-4) +#define SEND_USER_ERROR (-5) +#define SEND_INTERNAL_ERROR (-6) + +Sint do_send(Process *p, Eterm to, Eterm msg, int suspend); + +static Sint remote_send(Process *p, DistEntry *dep, + Eterm to, Eterm full_to, Eterm msg, int suspend) +{ + Sint res; + int code; + ErtsDSigData dsd; + + ASSERT(is_atom(to) || is_external_pid(to)); + + code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_NO_LOCK, !suspend); + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + case ERTS_DSIG_PREP_NOT_CONNECTED: + res = SEND_TRAP; + break; + case ERTS_DSIG_PREP_WOULD_SUSPEND: + ASSERT(!suspend); + res = SEND_YIELD; + break; + case ERTS_DSIG_PREP_CONNECTED: { + + if (is_atom(to)) + code = erts_dsig_send_reg_msg(&dsd, to, msg); + else + code = erts_dsig_send_msg(&dsd, to, msg); + /* + * Note that reductions have been bumped on calling + * process by erts_dsig_send_reg_msg() or + * erts_dsig_send_msg(). + */ + if (code == ERTS_DSIG_SEND_YIELD) + res = SEND_YIELD_RETURN; + else + res = 0; + break; + } + default: + ASSERT(! "Invalid dsig prepare result"); + res = SEND_INTERNAL_ERROR; + } + + if (res >= 0) { + if (IS_TRACED(p)) + trace_send(p, full_to, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) + save_calls(p, &exp_send); + } + + return res; +} + +Sint +do_send(Process *p, Eterm to, Eterm msg, int suspend) { + Eterm portid; + Port *pt; + Process* rp; + DistEntry *dep; + Eterm* tp; + + if (is_internal_pid(to)) { + if (IS_TRACED(p)) + trace_send(p, to, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) + save_calls(p, &exp_send); + + if (internal_pid_index(to) >= erts_max_processes) + return SEND_BADARG; + + rp = erts_pid2proc_opt(p, ERTS_PROC_LOCK_MAIN, + to, 0, ERTS_P2P_FLG_SMP_INC_REFC); + + if (!rp) { + ERTS_SMP_ASSERT_IS_NOT_EXITING(p); + return 0; + } + } else if (is_external_pid(to)) { + dep = external_pid_dist_entry(to); + if(dep == erts_this_dist_entry) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Discarding message %T from %T to %T in an old " + "incarnation (%d) of this node (%d)\n", + msg, + p->id, + to, + external_pid_creation(to), + erts_this_node->creation); + erts_send_error_to_logger(p->group_leader, dsbufp); + return 0; + } + return remote_send(p, dep, to, to, msg, suspend); + } else if (is_atom(to)) { + + /* Need to virtual schedule out sending process + * because of lock wait. This is only necessary + * for internal port calling but the lock is bundled + * with name lookup. + */ + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_out); + } + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(p, am_inactive); + } + erts_whereis_name(p, ERTS_PROC_LOCK_MAIN, + to, + &rp, 0, ERTS_P2P_FLG_SMP_INC_REFC, + &pt); + + if (pt) { + portid = pt->id; + goto port_common; + } + + /* Not a port virtually schedule the process back in */ + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_in); + } + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(p, am_active); + } + + if (IS_TRACED(p)) + trace_send(p, to, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) + save_calls(p, &exp_send); + + if (!rp) { + return SEND_BADARG; + } + } else if (is_external_port(to) + && (external_port_dist_entry(to) + == erts_this_dist_entry)) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Discarding message %T from %T to %T in an old " + "incarnation (%d) of this node (%d)\n", + msg, + p->id, + to, + external_port_creation(to), + erts_this_node->creation); + erts_send_error_to_logger(p->group_leader, dsbufp); + return 0; + } else if (is_internal_port(to)) { + portid = to; + /* schedule out calling process, waiting for lock*/ + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_out); + } + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(p, am_inactive); + } + pt = erts_id2port(to, p, ERTS_PROC_LOCK_MAIN); + port_common: + ERTS_SMP_LC_ASSERT(!pt || erts_lc_is_port_locked(pt)); + + /* We have waited for locks, trace schedule ports */ + if (pt && IS_TRACED_FL(pt, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(pt, am_in, am_command); + } + if (pt && erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(pt)) { + profile_runnable_port(pt, am_active); + } + + /* XXX let port_command handle the busy stuff !!! */ + if (pt && (pt->status & ERTS_PORT_SFLG_PORT_BUSY)) { + if (suspend) { + erts_suspend(p, ERTS_PROC_LOCK_MAIN, pt); + if (erts_system_monitor_flags.busy_port) { + monitor_generic(p, am_busy_port, portid); + } + } + /* Virtually schedule out the port before releasing */ + if (IS_TRACED_FL(pt, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(pt, am_out, am_command); + } + if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(pt)) { + profile_runnable_port(pt, am_inactive); + } + erts_port_release(pt); + return SEND_YIELD; + } + + if (IS_TRACED(p)) /* trace once only !! */ + trace_send(p, portid, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) + save_calls(p, &exp_send); + + if (SEQ_TRACE_TOKEN(p) != NIL) { + seq_trace_update_send(p); + seq_trace_output(SEQ_TRACE_TOKEN(p), msg, + SEQ_TRACE_SEND, portid, p); + } + + /* XXX NO GC in port command */ + erts_port_command(p, p->id, pt, msg); + if (pt) { + /* Virtually schedule out the port before releasing */ + if (IS_TRACED_FL(pt, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(pt, am_out, am_command); + } + if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(pt)) { + profile_runnable_port(pt, am_inactive); + } + erts_port_release(pt); + } + /* Virtually schedule in process */ + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_in); + } + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(p, am_active); + } + if (ERTS_PROC_IS_EXITING(p)) { + KILL_CATCHES(p); /* Must exit */ + return SEND_USER_ERROR; + } + return 0; + } else if (is_tuple(to)) { /* Remote send */ + int ret; + tp = tuple_val(to); + if (*tp != make_arityval(2)) + return SEND_BADARG; + if (is_not_atom(tp[1]) || is_not_atom(tp[2])) + return SEND_BADARG; + + /* sysname_to_connected_dist_entry will return NULL if there + is no dist_entry or the dist_entry has no port, + but remote_send() will handle that. */ + + dep = erts_sysname_to_connected_dist_entry(tp[2]); + + if (dep == erts_this_dist_entry) { + erts_deref_dist_entry(dep); + if (IS_TRACED(p)) + trace_send(p, to, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) + save_calls(p, &exp_send); + + /* Need to virtual schedule out sending process + * because of lock wait. This is only necessary + * for internal port calling but the lock is bundled. + */ + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_out); + } + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(p, am_inactive); + } + + erts_whereis_name(p, ERTS_PROC_LOCK_MAIN, + tp[1], + &rp, 0, ERTS_P2P_FLG_SMP_INC_REFC, + &pt); + if (pt) { + portid = pt->id; + goto port_common; + } + /* Port lookup failed, virtually schedule the process + * back in. + */ + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_in); + } + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(p, am_active); + } + + if (!rp) { + return 0; + } + goto send_message; + } + + ret = remote_send(p, dep, tp[1], to, msg, suspend); + if (dep) + erts_deref_dist_entry(dep); + return ret; + } else { + if (IS_TRACED(p)) /* XXX Is this really neccessary ??? */ + trace_send(p, to, msg); + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) + save_calls(p, &exp_send); + return SEND_BADARG; + } + + send_message: { + ErtsProcLocks rp_locks = 0; + Sint res; +#ifdef ERTS_SMP + if (p == rp) + rp_locks |= ERTS_PROC_LOCK_MAIN; +#endif + /* send to local process */ + erts_send_message(p, rp, &rp_locks, msg, 0); + if (!erts_use_sender_punish) + res = 0; + else { +#ifdef ERTS_SMP + res = rp->msg_inq.len*4; + if (ERTS_PROC_LOCK_MAIN & rp_locks) + res += rp->msg.len*4; +#else + res = rp->msg.len*4; +#endif + } + erts_smp_proc_unlock(rp, + p == rp + ? (rp_locks & ~ERTS_PROC_LOCK_MAIN) + : rp_locks); + erts_smp_proc_dec_refc(rp); + return res; + } +} + + +Eterm +send_3(Process *p, Eterm to, Eterm msg, Eterm opts) { + int connect = !0; + int suspend = !0; + Eterm l = opts; + Sint result; + + while (is_list(l)) { + if (CAR(list_val(l)) == am_noconnect) { + connect = 0; + } else if (CAR(list_val(l)) == am_nosuspend) { + suspend = 0; + } else { + BIF_ERROR(p, BADARG); + } + l = CDR(list_val(l)); + } + if(!is_nil(l)) { + BIF_ERROR(p, BADARG); + } + + result = do_send(p, to, msg, suspend); + if (result > 0) { + ERTS_VBUMP_REDS(p, result); + BIF_RET(am_ok); + } else switch (result) { + case 0: + BIF_RET(am_ok); + break; + case SEND_TRAP: + if (connect) { + BIF_TRAP3(dsend3_trap, p, to, msg, opts); + } else { + BIF_RET(am_noconnect); + } + break; + case SEND_YIELD: + if (suspend) { + ERTS_BIF_YIELD3(bif_export[BIF_send_3], p, to, msg, opts); + } else { + BIF_RET(am_nosuspend); + } + break; + case SEND_YIELD_RETURN: + if (suspend) + ERTS_BIF_YIELD_RETURN(p, am_ok); + else + BIF_RET(am_nosuspend); + case SEND_BADARG: + BIF_ERROR(p, BADARG); + break; + case SEND_USER_ERROR: + BIF_ERROR(p, EXC_ERROR); + break; + case SEND_INTERNAL_ERROR: + BIF_ERROR(p, EXC_INTERNAL_ERROR); + break; + default: + ASSERT(! "Illegal send result"); + break; + } + ASSERT(! "Can not arrive here"); + BIF_ERROR(p, BADARG); +} + +Eterm +send_2(Process *p, Eterm to, Eterm msg) { + Sint result = do_send(p, to, msg, !0); + + if (result > 0) { + ERTS_VBUMP_REDS(p, result); + BIF_RET(msg); + } else switch (result) { + case 0: + BIF_RET(msg); + break; + case SEND_TRAP: + BIF_TRAP2(dsend2_trap, p, to, msg); + break; + case SEND_YIELD: + ERTS_BIF_YIELD2(bif_export[BIF_send_2], p, to, msg); + break; + case SEND_YIELD_RETURN: + ERTS_BIF_YIELD_RETURN(p, msg); + case SEND_BADARG: + BIF_ERROR(p, BADARG); + break; + case SEND_USER_ERROR: + BIF_ERROR(p, EXC_ERROR); + break; + case SEND_INTERNAL_ERROR: + BIF_ERROR(p, EXC_INTERNAL_ERROR); + break; + default: + ASSERT(! "Illegal send result"); + break; + } + ASSERT(! "Can not arrive here"); + BIF_ERROR(p, BADARG); +} + +/**********************************************************************/ +/* + * apply/3 is implemented as an instruction and as erlang code in the + * erlang module. + * + * There is only one reason that apply/3 is included in the BIF table: + * The error handling code in the beam emulator passes the pointer to + * this function to the error handling code if the apply instruction + * fails. The error handling use the function pointer to lookup + * erlang:apply/3 in the BIF table. + * + * This function will never be called. (It could be if init did something + * like this: apply(erlang, apply, [M, F, A]). Not recommended.) + */ + +BIF_RETTYPE apply_3(BIF_ALIST_3) +{ + BIF_ERROR(BIF_P, BADARG); +} + + +/**********************************************************************/ + +/* integer to float */ + +/**********************************************************************/ + +/* returns the head of a list - this function is unecessary + and is only here to keep Robert happy (Even more, since it's OP as well) */ +BIF_RETTYPE hd_1(BIF_ALIST_1) +{ + if (is_not_list(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(CAR(list_val(BIF_ARG_1))); +} + +/**********************************************************************/ + +/* returns the tails of a list - same comment as above */ + +BIF_RETTYPE tl_1(BIF_ALIST_1) +{ + if (is_not_list(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(CDR(list_val(BIF_ARG_1))); +} + + +/**********************************************************************/ +/* return the size of an I/O list */ + +BIF_RETTYPE iolist_size_1(BIF_ALIST_1) +{ + Sint size = io_list_len(BIF_ARG_1); + + if (size == -1) { + BIF_ERROR(BIF_P, BADARG); + } else if (IS_USMALL(0, (Uint) size)) { + BIF_RET(make_small(size)); + } else { + Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(size, hp)); + } +} + + +/**********************************************************************/ + +/* return the N'th element of a tuple */ + +BIF_RETTYPE element_2(BIF_ALIST_2) +{ + if (is_not_small(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + if (is_tuple(BIF_ARG_2)) { + Eterm* tuple_ptr = tuple_val(BIF_ARG_2); + Sint ix = signed_val(BIF_ARG_1); + + if ((ix >= 1) && (ix <= arityval(*tuple_ptr))) + BIF_RET(tuple_ptr[ix]); + } + BIF_ERROR(BIF_P, BADARG); +} + +/**********************************************************************/ + +/* return the arity of a tuple */ + +BIF_RETTYPE tuple_size_1(BIF_ALIST_1) +{ + if (is_tuple(BIF_ARG_1)) { + return make_small(arityval(*tuple_val(BIF_ARG_1))); + } + BIF_ERROR(BIF_P, BADARG); +} + +/**********************************************************************/ + +/* set the n'th element in a tuple */ + +BIF_RETTYPE setelement_3(BIF_ALIST_3) +{ + Eterm* ptr; + Eterm* hp; + Eterm* resp; + Uint ix; + Uint size; + + if (is_not_small(BIF_ARG_1) || is_not_tuple(BIF_ARG_2)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + ptr = tuple_val(BIF_ARG_2); + ix = signed_val(BIF_ARG_1); + size = arityval(*ptr) + 1; /* include arity */ + if ((ix < 1) || (ix >= size)) { + goto error; + } + + hp = HAlloc(BIF_P, size); + + /* copy the tuple */ + resp = hp; + while (size--) { /* XXX use memcpy? */ + *hp++ = *ptr++; + } + resp[ix] = BIF_ARG_3; + BIF_RET(make_tuple(resp)); +} + +/**********************************************************************/ + +BIF_RETTYPE make_tuple_2(BIF_ALIST_2) +{ + Sint n; + Eterm* hp; + Eterm res; + + if (is_not_small(BIF_ARG_1) || (n = signed_val(BIF_ARG_1)) < 0) { + BIF_ERROR(BIF_P, BADARG); + } + hp = HAlloc(BIF_P, n+1); + res = make_tuple(hp); + *hp++ = make_arityval(n); + while (n--) { + *hp++ = BIF_ARG_2; + } + BIF_RET(res); +} + +BIF_RETTYPE make_tuple_3(BIF_ALIST_3) +{ + Sint n; + Uint limit; + Eterm* hp; + Eterm res; + Eterm list = BIF_ARG_3; + Eterm* tup; + + if (is_not_small(BIF_ARG_1) || (n = signed_val(BIF_ARG_1)) < 0) { + error: + BIF_ERROR(BIF_P, BADARG); + } + limit = (Uint) n; + hp = HAlloc(BIF_P, n+1); + res = make_tuple(hp); + *hp++ = make_arityval(n); + tup = hp; + while (n--) { + *hp++ = BIF_ARG_2; + } + while(is_list(list)) { + Eterm* cons; + Eterm hd; + Eterm* tp; + Eterm index; + Uint index_val; + + cons = list_val(list); + hd = CAR(cons); + list = CDR(cons); + if (is_not_tuple_arity(hd, 2)) { + goto error; + } + tp = tuple_val(hd); + if (is_not_small(index = tp[1])) { + goto error; + } + if ((index_val = unsigned_val(index) - 1) < limit) { + tup[index_val] = tp[2]; + } else { + goto error; + } + } + if (is_not_nil(list)) { + goto error; + } + BIF_RET(res); +} + + +/**********************************************************************/ + +BIF_RETTYPE append_element_2(BIF_ALIST_2) +{ + Eterm* ptr; + Eterm* hp; + Uint arity; + Eterm res; + + if (is_not_tuple(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + ptr = tuple_val(BIF_ARG_1); + arity = arityval(*ptr); + hp = HAlloc(BIF_P, arity + 2); + res = make_tuple(hp); + *hp = make_arityval(arity+1); + while (arity--) { + *++hp = *++ptr; + } + *++hp = BIF_ARG_2; + BIF_RET(res); +} + +/**********************************************************************/ + +/* convert an atom to a list of ascii integer */ + +BIF_RETTYPE atom_to_list_1(BIF_ALIST_1) +{ + Uint need; + Eterm* hp; + Atom* ap; + + if (is_not_atom(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + + /* read data from atom table */ + ap = atom_tab(atom_val(BIF_ARG_1)); + if (ap->len == 0) + BIF_RET(NIL); /* the empty atom */ + need = ap->len*2; + hp = HAlloc(BIF_P, need); + BIF_RET(buf_to_intlist(&hp,(char*)ap->name,ap->len, NIL)); +} + +/**********************************************************************/ + +/* convert a list of ascii integers to an atom */ + +BIF_RETTYPE list_to_atom_1(BIF_ALIST_1) +{ + Eterm res; + char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_LENGTH); + int i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_LENGTH); + + if (i < 0) { + erts_free(ERTS_ALC_T_TMP, (void *) buf); + i = list_length(BIF_ARG_1); + if (i > MAX_ATOM_LENGTH) { + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } + BIF_ERROR(BIF_P, BADARG); + } + res = am_atom_put(buf, i); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(res); +} + +/* conditionally convert a list of ascii integers to an atom */ + +BIF_RETTYPE list_to_existing_atom_1(BIF_ALIST_1) +{ + int i; + char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, MAX_ATOM_LENGTH); + + if ((i = intlist_to_buf(BIF_ARG_1, buf, MAX_ATOM_LENGTH)) < 0) { + error: + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); + } else { + Eterm a; + + if (erts_atom_get(buf, i, &a)) { + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(a); + } else { + goto error; + } + } +} + + +/**********************************************************************/ + +/* convert an integer to a list of ascii integers */ + +BIF_RETTYPE integer_to_list_1(BIF_ALIST_1) +{ + Eterm* hp; + Uint need; + + if (is_not_integer(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_small(BIF_ARG_1)) { + char *c; + int n; + struct Sint_buf ibuf; + + c = Sint_to_buf(signed_val(BIF_ARG_1), &ibuf); + n = sys_strlen(c); + need = 2*n; + hp = HAlloc(BIF_P, need); + BIF_RET(buf_to_intlist(&hp, c, n, NIL)); + } + else { + int n = big_decimal_estimate(BIF_ARG_1); + Eterm res; + Eterm* hp_end; + + need = 2*n; + hp = HAlloc(BIF_P, need); + hp_end = hp + need; + res = erts_big_to_list(BIF_ARG_1, &hp); + HRelease(BIF_P,hp_end,hp); + BIF_RET(res); + } +} + +/**********************************************************************/ + +/* convert a list of ascii ascii integer value to an integer */ + + +#define LTI_BAD_STRUCTURE 0 +#define LTI_NO_INTEGER 1 +#define LTI_SOME_INTEGER 2 +#define LTI_ALL_INTEGER 3 + +static int do_list_to_integer(Process *p, Eterm orig_list, + Eterm *integer, Eterm *rest) +{ + Sint i = 0; + int skip = 0; + int neg = 0; + int n = 0; + int m; + int lg2; + Eterm res; + Eterm* hp; + Eterm *hp_end; + Eterm lst = orig_list; + Eterm tail = lst; + int error_res = LTI_BAD_STRUCTURE; + + if (is_nil(lst)) { + error_res = LTI_NO_INTEGER; + error: + *rest = tail; + *integer = make_small(0); + return error_res; + } + if (is_not_list(lst)) + goto error; + + /* if first char is a '-' then it is a negative integer */ + if (CAR(list_val(lst)) == make_small('-')) { + neg = 1; + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } else if (CAR(list_val(lst)) == make_small('+')) { + /* ignore plus */ + skip = 1; + lst = CDR(list_val(lst)); + if (is_not_list(lst)) { + tail = lst; + error_res = LTI_NO_INTEGER; + goto error; + } + } + + /* Calculate size and do type check */ + + while(1) { + if (is_not_small(CAR(list_val(lst)))) { + break; + } + if (unsigned_val(CAR(list_val(lst))) < '0' || + unsigned_val(CAR(list_val(lst))) > '9') { + break; + } + i = i * 10; + i = i + unsigned_val(CAR(list_val(lst))) - '0'; + n++; + lst = CDR(list_val(lst)); + if (is_nil(lst)) { + break; + } + if (is_not_list(lst)) { + break; + } + } + + tail = lst; + if (!n) { + error_res = LTI_NO_INTEGER; + goto error; + } + + + /* If n <= 8 then we know it's a small int + ** since 2^27 = 134217728. If n > 8 then we must + ** construct a bignum and let that routine do the checking + */ + + if (n <= SMALL_DIGITS) { /* It must be small */ + if (neg) i = -i; + res = make_small(i); + } else { + lg2 = (n+1)*230/69+1; + m = (lg2+D_EXP-1)/D_EXP; /* number of digits */ + m = BIG_NEED_SIZE(m); /* number of words + thing */ + + hp = HAlloc(p, m); + hp_end = hp + m; + + lst = orig_list; + if (skip) + lst = CDR(list_val(lst)); + + /* load first digits (at least one digit) */ + if ((i = (n % D_DECIMAL_EXP)) == 0) + i = D_DECIMAL_EXP; + n -= i; + m = 0; + while(i--) { + m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); + lst = CDR(list_val(lst)); + } + res = small_to_big(m, hp); /* load first digits */ + + while(n) { + i = D_DECIMAL_EXP; + n -= D_DECIMAL_EXP; + m = 0; + while(i--) { + m = 10*m + (unsigned_val(CAR(list_val(lst))) - '0'); + lst = CDR(list_val(lst)); + } + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_times_small(res, D_DECIMAL_BASE, hp); + if (is_small(res)) + res = small_to_big(signed_val(res), hp); + res = big_plus_small(res, m, hp); + } + + if (is_big(res)) /* check if small */ + res = big_plus_small(res, 0, hp); /* includes conversion to small */ + + if (neg) { + if (is_small(res)) + res = make_small(-signed_val(res)); + else { + Uint *big = big_val(res); /* point to thing */ + *big = bignum_header_neg(*big); + } + } + + if (is_big(res)) { + hp += (big_arity(res)+1); + } + HRelease(p,hp_end,hp); + } + *integer = res; + *rest = tail; + if (tail != NIL) { + return LTI_SOME_INTEGER; + } + return LTI_ALL_INTEGER; +} +BIF_RETTYPE string_to_integer_1(BIF_ALIST_1) +{ + Eterm res; + Eterm tail; + Eterm *hp; + /* must be a list */ + switch (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&tail)) { + /* HAlloc after do_list_to_integer as it + might HAlloc itself (bignum) */ + case LTI_BAD_STRUCTURE: + hp = HAlloc(BIF_P,3); + BIF_RET(TUPLE2(hp, am_error, am_not_a_list)); + case LTI_NO_INTEGER: + hp = HAlloc(BIF_P,3); + BIF_RET(TUPLE2(hp, am_error, am_no_integer)); + default: + hp = HAlloc(BIF_P,3); + BIF_RET(TUPLE2(hp, res, tail)); + } +} + + +BIF_RETTYPE list_to_integer_1(BIF_ALIST_1) +{ + Eterm res; + Eterm dummy; + /* must be a list */ + + if (do_list_to_integer(BIF_P,BIF_ARG_1,&res,&dummy) != LTI_ALL_INTEGER) { + BIF_ERROR(BIF_P,BADARG); + } + BIF_RET(res); + } + +/**********************************************************************/ + +/* convert a float to a list of ascii characters */ + +BIF_RETTYPE float_to_list_1(BIF_ALIST_1) +{ + int i; + Uint need; + Eterm* hp; + FloatDef f; + char fbuf[30]; + + /* check the arguments */ + if (is_not_float(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + GET_DOUBLE(BIF_ARG_1, f); + if ((i = sys_double_to_chars(f.fd, fbuf)) <= 0) + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + need = i*2; + hp = HAlloc(BIF_P, need); + BIF_RET(buf_to_intlist(&hp, fbuf, i, NIL)); + } + +/**********************************************************************/ + +/* convert a list of ascii integer values e's +'s and -'s to a float */ + + +#define SIGN 0 +#define INT 1 +#define FRAC 2 +#define EXP_SIGN 3 +#define EXP0 4 +#define EXP1 5 +#define END 6 + +#define IS_DOT(x) (unsigned_val((x)) == '.' || unsigned_val((x)) == ',') +#define IS_E(x) (unsigned_val((x)) == 'e' || unsigned_val((x)) == 'E') +#define IS_DIGIT(x) (unsigned_val((x)) >= '0' && unsigned_val((x)) <= '9') +#define SAVE_E(xi,xim,xl,xlm) ((xim)=(xi), (xlm)=(xl)) +#define LOAD_E(xi,xim,xl,xlm) ((xi)=(xim), (xl)=(xlm)) + +#define STRING_TO_FLOAT_BUF_INC_SZ (128) +BIF_RETTYPE string_to_float_1(BIF_ALIST_1) +{ + Eterm orig = BIF_ARG_1; + Eterm list = orig; + Eterm list_mem = list; + int i = 0; + int i_mem = 0; + Eterm* hp; + Eterm error_res = NIL; + int part = SIGN; /* expect a + or - (or a digit) first */ + FloatDef f; + Eterm tup; + byte *buf = NULL; + Uint bufsz = STRING_TO_FLOAT_BUF_INC_SZ; + + /* check it's a valid list to start with */ + if (is_nil(list)) { + error_res = am_no_float; + error: + if (buf) + erts_free(ERTS_ALC_T_TMP, (void *) buf); + hp = HAlloc(BIF_P, 3); + BIF_RET(TUPLE2(hp, am_error, error_res)); + } + if (is_not_list(list)) { + error_res = am_not_a_list; + goto error; + } + + buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, bufsz); + + /* + The float might start with a SIGN (+ | -). It must contain an integer + part, INT, followed by a delimiter (. | ,) and a fractional, FRAC, + part. The float might also contain an exponent. If e or E indicates + this we will look for a possible EXP_SIGN (+ | -) followed by the + exponential number, EXP. (EXP0 is the first digit and EXP1 the rest). + + When we encounter an expected e or E, we can't tell if it's part of + the float or the rest of the string. We save the current position + with SAVE_E. If we later find out it was not part of the float, we + restore the position (end of the float) with LOAD_E. + */ + while(1) { + if (is_not_small(CAR(list_val(list)))) + goto back_to_e; + if (CAR(list_val(list)) == make_small('-')) { + switch (part) { + case SIGN: /* expect integer part next */ + part = INT; + break; + case EXP_SIGN: /* expect first digit in exp */ + part = EXP0; + break; + case EXP0: /* example: "2.3e--" */ + LOAD_E(i, i_mem, list, list_mem); + default: /* unexpected - done */ + part = END; + } + } else if (CAR(list_val(list)) == make_small('+')) { + switch (part) { + case SIGN: /* expect integer part next */ + part = INT; + goto skip; + case EXP_SIGN: /* expect first digit in exp */ + part = EXP0; + break; + case EXP0: /* example: "2.3e++" */ + LOAD_E(i, i_mem, list, list_mem); + default: /* unexpected - done */ + part = END; + } + } else if (IS_DOT(CAR(list_val(list)))) { /* . or , */ + switch (part) { + case INT: /* expect fractional part next */ + part = FRAC; + break; + case EXP_SIGN: /* example: "2.3e." */ + LOAD_E(i, i_mem, list, list_mem); + case EXP0: /* example: "2.3e+." */ + LOAD_E(i, i_mem, list, list_mem); + default: /* unexpected - done */ + part = END; + } + } else if (IS_E(CAR(list_val(list)))) { /* e or E */ + switch (part) { + case FRAC: /* expect a + or - (or a digit) next */ + /* + remember the position of e in case we find out later + that it was not part of the float, e.g. "2.3eh?" + */ + SAVE_E(i, i_mem, list, list_mem); + part = EXP_SIGN; + break; + case EXP0: /* example: "2.3e+e" */ + case EXP_SIGN: /* example: "2.3ee" */ + LOAD_E(i, i_mem, list, list_mem); + case INT: /* would like this to be ok, example "2e2", + but it's not compatible with list_to_float */ + default: /* unexpected - done */ + part = END; + } + } else if (IS_DIGIT(CAR(list_val(list)))) { /* digit */ + switch (part) { + case SIGN: /* got initial digit in integer part */ + part = INT; /* expect more digits to follow */ + break; + case EXP_SIGN: /* expect exponential part */ + case EXP0: /* expect rest of exponential */ + part = EXP1; + break; + } + } else /* character not part of float - done */ + goto back_to_e; + + if (part == END) { + if (i < 3) { /* we require a fractional part */ + error_res = am_no_float; + goto error; + } + break; + } + + buf[i++] = unsigned_val(CAR(list_val(list))); + + if (i == bufsz - 1) + buf = (byte *) erts_realloc(ERTS_ALC_T_TMP, + (void *) buf, + bufsz += STRING_TO_FLOAT_BUF_INC_SZ); + skip: + list = CDR(list_val(list)); /* next element */ + + if (is_nil(list)) + goto back_to_e; + + if (is_not_list(list)) { + back_to_e: + if (part == EXP_SIGN || part == EXP0) { + LOAD_E(i, i_mem, list, list_mem); + } + break; + } + } + + if (i == 0) { /* no float first in list */ + error_res = am_no_float; + goto error; + } + + buf[i] = '\0'; /* null terminal */ + ASSERT(bufsz >= i + 1); + if (sys_chars_to_double((char*) buf, &f.fd) != 0) { + error_res = am_no_float; + goto error; + } + hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT + 3); + tup = TUPLE2(hp+FLOAT_SIZE_OBJECT, make_float(hp), list); + PUT_DOUBLE(f, hp); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(tup); +} + + +BIF_RETTYPE list_to_float_1(BIF_ALIST_1) +{ + int i; + FloatDef f; + Eterm res; + Eterm* hp; + char *buf = NULL; + + i = list_length(BIF_ARG_1); + if (i < 0) { + badarg: + if (buf) + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); + } + + buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); + + if (intlist_to_buf(BIF_ARG_1, buf, i) < 0) + goto badarg; + buf[i] = '\0'; /* null terminal */ + + if (sys_chars_to_double(buf, &f.fd) != 0) + goto badarg; + hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f, hp); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(res); +} + +/**********************************************************************/ + +/* convert a tuple to a list */ + +BIF_RETTYPE tuple_to_list_1(BIF_ALIST_1) +{ + Uint n; + Eterm *tupleptr; + Eterm list = NIL; + Eterm* hp; + + if (is_not_tuple(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + tupleptr = tuple_val(BIF_ARG_1); + n = arityval(*tupleptr); + hp = HAlloc(BIF_P, 2 * n); + tupleptr++; + + while(n--) { + list = CONS(hp, tupleptr[n], list); + hp += 2; + } + BIF_RET(list); +} + +/**********************************************************************/ + +/* convert a list to a tuple */ + +BIF_RETTYPE list_to_tuple_1(BIF_ALIST_1) +{ + Eterm list = BIF_ARG_1; + Eterm* cons; + Eterm res; + Eterm* hp; + int len; + + if ((len = list_length(list)) < 0) { + BIF_ERROR(BIF_P, BADARG); + } + + hp = HAlloc(BIF_P, len+1); + res = make_tuple(hp); + *hp++ = make_arityval(len); + while(is_list(list)) { + cons = list_val(list); + *hp++ = CAR(cons); + list = CDR(cons); + } + BIF_RET(res); +} + +/**********************************************************************/ + +/* return the pid of our own process, in most cases this has been replaced by + a machine instruction */ + +BIF_RETTYPE self_0(BIF_ALIST_0) +{ + BIF_RET(BIF_P->id); +} + +/**********************************************************************/ + +/* + New representation of refs in R9, see erl_term.h + + In the first data word, only the usual 18 bits are used. Ordinarily, + in "long refs" all words are used (in other words, practically never + wrap around), but for compatibility with older nodes, "short refs" + exist. Short refs come into being by being converted from the old + external format for refs (tag REFERENCE_EXT). Short refs are + converted back to the old external format. + + When converting a long ref to the external format in the case of + preparing for sending to an older node, the ref is truncated by only + using the first word (with 18 significant bits), and using the old tag + REFERENCE_EXT. + + When comparing refs or different size, only the parts up to the length + of the shorter operand are used. This has the desirable effect that a + long ref sent to an old node and back will be treated as equal to + the original, although some of the bits have been lost. + + The hash value for a ref always considers only the first word, since + in the above scenario, the original and the copy should have the same + hash value. +*/ + +static Uint32 reference0; /* Initialized in erts_init_bif */ +static Uint32 reference1; +static Uint32 reference2; +static erts_smp_spinlock_t make_ref_lock; +static erts_smp_mtx_t ports_snapshot_mtx; +erts_smp_atomic_t erts_dead_ports_ptr; /* To store dying ports during snapshot */ + +Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]) +{ + Eterm* hp = buffer; + Uint32 ref0, ref1, ref2; + + erts_smp_spin_lock(&make_ref_lock); + + reference0++; + if (reference0 >= MAX_REFERENCE) { + reference0 = 0; + reference1++; + if (reference1 == 0) { + reference2++; + } + } + + ref0 = reference0; + ref1 = reference1; + ref2 = reference2; + + erts_smp_spin_unlock(&make_ref_lock); + + write_ref_thing(hp, ref0, ref1, ref2); + return make_internal_ref(hp); +} + +Eterm erts_make_ref(Process *p) +{ + Eterm* hp; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + + hp = HAlloc(p, REF_THING_SIZE); + return erts_make_ref_in_buffer(hp); +} + +BIF_RETTYPE make_ref_0(BIF_ALIST_0) +{ + return erts_make_ref(BIF_P); +} + +/**********************************************************************/ + +/* return the time of day */ + +BIF_RETTYPE time_0(BIF_ALIST_0) +{ + int hour, minute, second; + Eterm* hp; + + get_time(&hour, &minute, &second); + hp = HAlloc(BIF_P, 4); /* {hour, minute, second} + arity */ + BIF_RET(TUPLE3(hp, make_small(hour), make_small(minute), + make_small(second))); +} +/**********************************************************************/ + +/* return the date */ + +BIF_RETTYPE date_0(BIF_ALIST_0) +{ + int year, month, day; + Eterm* hp; + + get_date(&year, &month, &day); + hp = HAlloc(BIF_P, 4); /* {year, month, day} + arity */ + BIF_RET(TUPLE3(hp, make_small(year), make_small(month), make_small(day))); +} + +/**********************************************************************/ + +/* return the universal time */ + +BIF_RETTYPE universaltime_0(BIF_ALIST_0) +{ + int year, month, day; + int hour, minute, second; + Eterm res1, res2; + Eterm* hp; + + /* read the clock */ + get_universaltime(&year, &month, &day, &hour, &minute, &second); + + hp = HAlloc(BIF_P, 4+4+3); + + /* and return the tuple */ + res1 = TUPLE3(hp,make_small(year),make_small(month),make_small(day)); + hp += 4; + res2 = TUPLE3(hp,make_small(hour),make_small(minute),make_small(second)); + hp += 4; + BIF_RET(TUPLE2(hp, res1, res2)); + } + +/**********************************************************************/ + +/* return the universal time */ + +BIF_RETTYPE localtime_0(BIF_ALIST_0) +{ + int year, month, day; + int hour, minute, second; + Eterm res1, res2; + Eterm* hp; + + /* read the clock */ + get_localtime(&year, &month, &day, &hour, &minute, &second); + + hp = HAlloc(BIF_P, 4+4+3); + + /* and return the tuple */ + res1 = TUPLE3(hp,make_small(year),make_small(month),make_small(day)); + hp += 4; + res2 = TUPLE3(hp,make_small(hour),make_small(minute),make_small(second)); + hp += 4; + BIF_RET(TUPLE2(hp, res1, res2)); +} +/**********************************************************************/ + +/* type check and extract components from a tuple on form: {{Y,M,D},{H,M,S}} */ +static int +time_to_parts(Eterm date, Sint* year, Sint* month, Sint* day, + Sint* hour, Sint* minute, Sint* second) +{ + Eterm* t1; + Eterm* t2; + + if (is_not_tuple(date)) { + return 0; + } + t1 = tuple_val(date); + if (arityval(t1[0]) !=2 || + is_not_tuple(t1[1]) || is_not_tuple(t1[2])) + return 0; + t2 = tuple_val(t1[1]); + t1 = tuple_val(t1[2]); + if (arityval(t2[0]) != 3 || + is_not_small(t2[1]) || is_not_small(t2[2]) || is_not_small(t2[3])) + return 0; + *year = signed_val(t2[1]); + *month = signed_val(t2[2]); + *day = signed_val(t2[3]); + if (arityval(t1[0]) != 3 || + is_not_small(t1[1]) || is_not_small(t1[2]) || is_not_small(t1[3])) + return 0; + *hour = signed_val(t1[1]); + *minute = signed_val(t1[2]); + *second = signed_val(t1[3]); + return 1; +} + + +/* return the universal time */ + +BIF_RETTYPE +localtime_to_universaltime_2(Process *p, Eterm localtime, Eterm dst) +{ + Sint year, month, day; + Sint hour, minute, second; + int isdst; + Eterm res1, res2; + Eterm* hp; + + if (dst == am_true) isdst = 1; + else if (dst == am_false) isdst = 0; + else if (dst == am_undefined) isdst = -1; + else goto error; + + if (!time_to_parts(localtime, &year, &month, &day, + &hour, &minute, &second)) goto error; + if (!local_to_univ(&year, &month, &day, + &hour, &minute, &second, isdst)) goto error; + + hp = HAlloc(p, 4+4+3); + res1 = TUPLE3(hp,make_small(year),make_small(month), + make_small(day)); + hp += 4; + res2 = TUPLE3(hp,make_small(hour),make_small(minute), + make_small(second)); + hp += 4; + BIF_RET(TUPLE2(hp, res1, res2)); + error: + BIF_ERROR(p, BADARG); + } + + +/**********************************************************************/ + +/* return the universal time */ + +BIF_RETTYPE universaltime_to_localtime_1(BIF_ALIST_1) +{ + Sint year, month, day; + Sint hour, minute, second; + Eterm res1, res2; + Eterm* hp; + + if (!time_to_parts(BIF_ARG_1, &year, &month, &day, + &hour, &minute, &second)) + BIF_ERROR(BIF_P, BADARG); + if (!univ_to_local(&year, &month, &day, + &hour, &minute, &second)) + BIF_ERROR(BIF_P, BADARG); + + hp = HAlloc(BIF_P, 4+4+3); + res1 = TUPLE3(hp,make_small(year),make_small(month), + make_small(day)); + hp += 4; + res2 = TUPLE3(hp,make_small(hour),make_small(minute), + make_small(second)); + hp += 4; + BIF_RET(TUPLE2(hp, res1, res2)); +} + +/**********************************************************************/ + + + /* return a timestamp */ +BIF_RETTYPE now_0(BIF_ALIST_0) +{ + Uint megasec, sec, microsec; + Eterm* hp; + + get_now(&megasec, &sec, µsec); + hp = HAlloc(BIF_P, 4); + BIF_RET(TUPLE3(hp, make_small(megasec), make_small(sec), + make_small(microsec))); +} + +/**********************************************************************/ + +BIF_RETTYPE garbage_collect_1(BIF_ALIST_1) +{ + int reds; + Process *rp; + + if (is_not_pid(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCK_MAIN); + if (!rp) + BIF_RET(am_false); + if (rp == ERTS_PROC_LOCK_BUSY) + ERTS_BIF_YIELD1(bif_export[BIF_garbage_collect_1], BIF_P, BIF_ARG_1); + + /* The GC cost is taken for the process executing this BIF. */ + + FLAGS(rp) |= F_NEED_FULLSWEEP; + reds = erts_garbage_collect(rp, 0, rp->arg_reg, rp->arity); + + if (BIF_P != rp) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + + BIF_RET2(am_true, reds); +} + +BIF_RETTYPE garbage_collect_0(BIF_ALIST_0) +{ + int reds; + + FLAGS(BIF_P) |= F_NEED_FULLSWEEP; + reds = erts_garbage_collect(BIF_P, 0, NULL, 0); + BIF_RET2(am_true, reds); +} + +/**********************************************************************/ +/* Perform garbage collection of the message area */ + +BIF_RETTYPE garbage_collect_message_area_0(BIF_ALIST_0) +{ +#if defined(HYBRID) && !defined(INCREMENTAL) + int reds = 0; + + FLAGS(BIF_P) |= F_NEED_FULLSWEEP; + reds = erts_global_garbage_collect(BIF_P, 0, NULL, 0); + BIF_RET2(am_true, reds); +#else + BIF_RET(am_false); +#endif +} + +/**********************************************************************/ +/* Return a list of active ports */ + +BIF_RETTYPE ports_0(BIF_ALIST_0) +{ + Eterm res = NIL; + Eterm* port_buf = erts_alloc(ERTS_ALC_T_TMP, + sizeof(Eterm)*erts_max_ports); + Eterm* pp = port_buf; + Eterm* dead_ports; + int alive, dead; + Uint32 next_ss; + + /* To get a consistent snapshot... + * We add alive ports from start of the buffer + * while dying ports are added from the other end by the killing threads. + */ + + erts_smp_mtx_lock(&ports_snapshot_mtx); /* One snapshot at a time */ + + erts_smp_atomic_set(&erts_dead_ports_ptr, (long) (port_buf + erts_max_ports)); + + next_ss = erts_smp_atomic_inctest(&erts_ports_snapshot); + + if (erts_smp_atomic_read(&erts_ports_alive) > 0) { + long i; + for (i = erts_max_ports-1; i >= 0; i--) { + Port* prt = &erts_port[i]; + erts_smp_port_state_lock(prt); + if (!(prt->status & ERTS_PORT_SFLGS_DEAD) + && prt->snapshot != next_ss) { + ASSERT(prt->snapshot == next_ss - 1); + *pp++ = prt->id; + prt->snapshot = next_ss; /* Consumed by this snapshot */ + } + erts_smp_port_state_unlock(prt); + } + } + + dead_ports = (Eterm*)erts_smp_atomic_xchg(&erts_dead_ports_ptr, + (long)NULL); + erts_smp_mtx_unlock(&ports_snapshot_mtx); + + ASSERT(pp <= dead_ports); + + alive = pp - port_buf; + dead = port_buf + erts_max_ports - dead_ports; + + ASSERT((alive+dead) <= erts_max_ports); + + if (alive+dead > 0) { + long i; + Eterm *hp = HAlloc(BIF_P, (alive+dead)*2); + + for (i = 0; i < alive; i++) { + res = CONS(hp, port_buf[i], res); + hp += 2; + } + for (i = 0; i < dead; i++) { + res = CONS(hp, dead_ports[i], res); + hp += 2; + } + } + + erts_free(ERTS_ALC_T_TMP, port_buf); + + BIF_RET(res); +} + +/**********************************************************************/ + +BIF_RETTYPE throw_1(BIF_ALIST_1) +{ + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, EXC_THROWN); +} + +/**********************************************************************/ + + +/* + * Non-standard, undocumented, dirty BIF, meant for debugging. + * + */ +BIF_RETTYPE display_1(BIF_ALIST_1) +{ + erts_printf("%.*T\n", INT_MAX, BIF_ARG_1); + BIF_RET(am_true); +} + +/* + * erts_debug:display/1 is for debugging erlang:display/1 + */ +BIF_RETTYPE erts_debug_display_1(BIF_ALIST_1) +{ + int pres; + Eterm res; + Eterm *hp; + erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(64); + pres = erts_dsprintf(dsbufp, "%.*T\n", INT_MAX, BIF_ARG_1); + if (pres < 0) + erl_exit(1, "Failed to convert term to string: %d (s)\n", + -pres, erl_errno_id(-pres)); + hp = HAlloc(BIF_P, 2*dsbufp->str_len); /* we need length * 2 heap words */ + res = buf_to_intlist(&hp, dsbufp->str, dsbufp->str_len, NIL); + erts_printf("%s", dsbufp->str); + erts_destroy_tmp_dsbuf(dsbufp); + BIF_RET(res); +} + + +Eterm +display_string_1(Process* p, Eterm string) +{ + int len = is_string(string); + char *str; + + if (len <= 0) { + BIF_ERROR(p, BADARG); + } + str = (char *) erts_alloc(ERTS_ALC_T_TMP, sizeof(char)*(len + 1)); + if (intlist_to_buf(string, str, len) != len) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + str[len] = '\0'; + erts_fprintf(stderr, "%s", str); + erts_free(ERTS_ALC_T_TMP, (void *) str); + BIF_RET(am_true); +} + +Eterm +display_nl_0(Process* p) +{ + erts_fprintf(stderr, "\n"); + BIF_RET(am_true); +} + +/**********************************************************************/ + +/* stop the system */ +/* ARGSUSED */ +BIF_RETTYPE halt_0(BIF_ALIST_0) +{ + VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt/0\n")); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erl_exit(0, ""); + return NIL; /* Pedantic (lint does not know about erl_exit) */ +} + +/**********************************************************************/ + +#define MSG_SIZE 200 + +/* stop the system with exit code */ +/* ARGSUSED */ +BIF_RETTYPE halt_1(BIF_ALIST_1) +{ + Sint code; + static char msg[MSG_SIZE]; + int i; + + if (is_small(BIF_ARG_1) && (code = signed_val(BIF_ARG_1)) >= 0) { + VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%d)\n", code)); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erl_exit(-code, ""); + } else if (is_string(BIF_ARG_1) || BIF_ARG_1 == NIL) { + if ((i = intlist_to_buf(BIF_ARG_1, msg, MSG_SIZE-1)) < 0) { + goto error; + } + msg[i] = '\0'; + VERBOSE(DEBUG_SYSTEM,("System halted by BIF halt(%s)\n", msg)); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erl_exit(ERTS_DUMP_EXIT, "%s\n", msg); + } else { + error: + BIF_ERROR(BIF_P, BADARG); + } + return NIL; /* Pedantic (lint does not know about erl_exit) */ +} + +BIF_RETTYPE function_exported_3(BIF_ALIST_3) +{ + if (is_not_atom(BIF_ARG_1) || + is_not_atom(BIF_ARG_2) || + is_not_small(BIF_ARG_3)) { + BIF_ERROR(BIF_P, BADARG); + } + if (erts_find_function(BIF_ARG_1, BIF_ARG_2, signed_val(BIF_ARG_3)) == NULL) { + BIF_RET(am_false); + } + BIF_RET(am_true); +} + +/**********************************************************************/ + +BIF_RETTYPE is_builtin_3(Process* p, Eterm Mod, Eterm Name, Eterm Arity) +{ + if (is_not_atom(Mod) || is_not_atom(Name) || is_not_small(Arity)) { + BIF_ERROR(p, BADARG); + } + BIF_RET(erts_is_builtin(Mod, Name, signed_val(Arity)) ? + am_true : am_false); +} + +/**********************************************************************/ + +/* NOTE: Cannot be used in all *_to_list() bifs. erts_dsprintf() prints + * some terms on other formats than what is desired as results + * from *_to_list() bifs. + */ + +static Eterm +term2list_dsprintf(Process *p, Eterm term) +{ + int pres; + Eterm res; + Eterm *hp; + erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(64); + pres = erts_dsprintf(dsbufp, "%T", term); + if (pres < 0) + erl_exit(1, "Failed to convert term to list: %d (s)\n", + -pres, erl_errno_id(-pres)); + hp = HAlloc(p, 2*dsbufp->str_len); /* we need length * 2 heap words */ + res = buf_to_intlist(&hp, dsbufp->str, dsbufp->str_len, NIL); + erts_destroy_tmp_dsbuf(dsbufp); + return res; +} + +BIF_RETTYPE ref_to_list_1(BIF_ALIST_1) +{ + if (is_not_ref(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1)); +} + +BIF_RETTYPE make_fun_3(BIF_ALIST_3) +{ + Eterm* hp; + Sint arity; + + if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + arity = signed_val(BIF_ARG_3); + if (arity < 0) { + goto error; + } + hp = HAlloc(BIF_P, 2); + hp[0] = HEADER_EXPORT; + hp[1] = (Eterm) erts_export_get_or_make_stub(BIF_ARG_1, BIF_ARG_2, (Uint) arity); + BIF_RET(make_export(hp)); +} + +Eterm +fun_to_list_1(Process* p, Eterm fun) +{ + if (is_not_any_fun(fun)) + BIF_ERROR(p, BADARG); + BIF_RET(term2list_dsprintf(p, fun)); +} + +/**********************************************************************/ + +/* convert a pid to an erlang list (for the linked cons cells) of the form + to a PID + */ + +BIF_RETTYPE pid_to_list_1(BIF_ALIST_1) +{ + if (is_not_pid(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1)); +} + +BIF_RETTYPE port_to_list_1(BIF_ALIST_1) +{ + if (is_not_port(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(term2list_dsprintf(BIF_P, BIF_ARG_1)); +} + +/**********************************************************************/ + +/* convert a list of ascii characeters of the form + to a PID +*/ + +BIF_RETTYPE list_to_pid_1(BIF_ALIST_1) +{ + Uint a = 0, b = 0, c = 0; + char* cp; + int i; + DistEntry *dep = NULL; + char *buf = (char *) erts_alloc(ERTS_ALC_T_TMP, 65); + /* + * Max 'Uint64' has 20 decimal digits. If X, Y, Z in + * are 'Uint64's. Max chars are 1 + 20 + 1 + 20 + 1 + 20 + 1 = 64, + * i.e, if the input list is longer than 64 it does not represent + * a pid. + */ + + /* walk down the list and create a C string */ + if ((i = intlist_to_buf(BIF_ARG_1, buf, 64)) < 0) + goto bad; + + buf[i] = '\0'; /* null terminal */ + + cp = buf; + if (*cp++ != '<') goto bad; + + if (*cp < '0' || *cp > '9') goto bad; + while(*cp >= '0' && *cp <= '9') { a = 10*a + (*cp - '0'); cp++; } + + if (*cp++ != '.') goto bad; + + if (*cp < '0' || *cp > '9') goto bad; + while(*cp >= '0' && *cp <= '9') { b = 10*b + (*cp - '0'); cp++; } + + if (*cp++ != '.') goto bad; + + if (*cp < '0' || *cp > '9') goto bad; + while(*cp >= '0' && *cp <= '9') { c = 10*c + (*cp - '0'); cp++; } + + if (*cp++ != '>') goto bad; + if (*cp != '\0') goto bad; + + erts_free(ERTS_ALC_T_TMP, (void *) buf); + buf = NULL; + + /* a = node, b = process number, c = serial */ + + dep = erts_channel_no_to_dist_entry(a); + + if (!dep) + goto bad; + + + if (c > ERTS_MAX_PID_SERIAL || b > ERTS_MAX_PID_NUMBER) + goto bad; + + if(dep == erts_this_dist_entry) { + erts_deref_dist_entry(dep); + BIF_RET(make_internal_pid(make_pid_data(c, b))); + } + else { + ExternalThing *etp; + ErlNode *enp; + + if (is_nil(dep->cid)) + goto bad; + + enp = erts_find_or_insert_node(dep->sysname, dep->creation); + + etp = (ExternalThing *) HAlloc(BIF_P, EXTERNAL_THING_HEAD_SIZE + 1); + etp->header = make_external_pid_header(1); + etp->next = MSO(BIF_P).externals; + etp->node = enp; + etp->data.ui[0] = make_pid_data(c, b); + + MSO(BIF_P).externals = etp; + erts_deref_dist_entry(dep); + BIF_RET(make_external_pid(etp)); + } + + bad: + if (dep) + erts_deref_dist_entry(dep); + if (buf) + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(BIF_P, BADARG); +} + +/**********************************************************************/ + +BIF_RETTYPE group_leader_0(BIF_ALIST_0) +{ + BIF_RET(BIF_P->group_leader); +} + +/**********************************************************************/ +/* arg1 == leader, arg2 == new member */ + +BIF_RETTYPE group_leader_2(BIF_ALIST_2) +{ + Process* new_member; + + if (is_not_pid(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_external_pid(BIF_ARG_2)) { + DistEntry *dep; + int code; + ErtsDSigData dsd; + dep = external_pid_dist_entry(BIF_ARG_2); + if(dep == erts_this_dist_entry) + BIF_ERROR(BIF_P, BADARG); + + code = erts_dsig_prepare(&dsd, dep, BIF_P, ERTS_DSP_NO_LOCK, 0); + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + BIF_RET(am_true); + case ERTS_DSIG_PREP_NOT_CONNECTED: + BIF_TRAP2(dgroup_leader_trap, BIF_P, BIF_ARG_1, BIF_ARG_2); + case ERTS_DSIG_PREP_CONNECTED: + code = erts_dsig_send_group_leader(&dsd, BIF_ARG_1, BIF_ARG_2); + if (code == ERTS_DSIG_SEND_YIELD) + ERTS_BIF_YIELD_RETURN(BIF_P, am_true); + BIF_RET(am_true); + default: + ASSERT(! "Invalid dsig prepare result"); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } + } + else if (is_internal_pid(BIF_ARG_2)) { + int await_x; + ErtsProcLocks locks = ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS; + new_member = erts_pid2proc_nropt(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_2, locks); + if (!new_member) + BIF_ERROR(BIF_P, BADARG); + + if (new_member == ERTS_PROC_LOCK_BUSY) + ERTS_BIF_YIELD2(bif_export[BIF_group_leader_2], BIF_P, + BIF_ARG_1, BIF_ARG_2); + + await_x = (new_member != BIF_P + && ERTS_PROC_PENDING_EXIT(new_member)); + if (!await_x) { + if (is_immed(BIF_ARG_1)) + new_member->group_leader = BIF_ARG_1; + else { + locks &= ~ERTS_PROC_LOCK_STATUS; + erts_smp_proc_unlock(new_member, ERTS_PROC_LOCK_STATUS); + new_member->group_leader = STORE_NC_IN_PROC(new_member, + BIF_ARG_1); + } + } + + if (new_member == BIF_P) + locks &= ~ERTS_PROC_LOCK_MAIN; + if (locks) + erts_smp_proc_unlock(new_member, locks); + + if (await_x) { + /* Wait for new_member to terminate; then badarg */ + Eterm args[2] = {BIF_ARG_1, BIF_ARG_2}; + ERTS_BIF_AWAIT_X_APPLY_TRAP(BIF_P, + BIF_ARG_2, + am_erlang, + am_group_leader, + args, + 2); + } + + BIF_RET(am_true); + } + else { + BIF_ERROR(BIF_P, BADARG); + } +} + +BIF_RETTYPE system_flag_2(BIF_ALIST_2) +{ + Sint n; + + if (BIF_ARG_1 == am_multi_scheduling) { + if (BIF_ARG_2 == am_block || BIF_ARG_2 == am_unblock) { +#ifndef ERTS_SMP + BIF_RET(am_disabled); +#else + if (erts_no_schedulers == 1) + BIF_RET(am_disabled); + else { + switch (erts_block_multi_scheduling(BIF_P, + ERTS_PROC_LOCK_MAIN, + BIF_ARG_2 == am_block, + 0)) { + case ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED: + BIF_RET(am_blocked); + case ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED: + ERTS_BIF_YIELD_RETURN_X(BIF_P, am_blocked, + am_multi_scheduling); + case ERTS_SCHDLR_SSPND_DONE: + BIF_RET(am_enabled); + case ERTS_SCHDLR_SSPND_YIELD_RESTART: + ERTS_VBUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_system_flag_2], + BIF_P, BIF_ARG_1, BIF_ARG_2); + case ERTS_SCHDLR_SSPND_YIELD_DONE: + ERTS_BIF_YIELD_RETURN_X(BIF_P, am_enabled, + am_multi_scheduling); + case ERTS_SCHDLR_SSPND_EINVAL: + goto error; + default: + ASSERT(0); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + break; + } + } +#endif + } + } else if (BIF_ARG_1 == am_schedulers_online) { +#ifndef ERTS_SMP + if (BIF_ARG_2 != make_small(1)) + goto error; + else + BIF_RET(make_small(1)); +#else + Sint old_no; + if (!is_small(BIF_ARG_2)) + goto error; + switch (erts_set_schedulers_online(BIF_P, + ERTS_PROC_LOCK_MAIN, + signed_val(BIF_ARG_2), + &old_no)) { + case ERTS_SCHDLR_SSPND_DONE: + BIF_RET(make_small(old_no)); + case ERTS_SCHDLR_SSPND_YIELD_RESTART: + ERTS_VBUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_system_flag_2], + BIF_P, BIF_ARG_1, BIF_ARG_2); + case ERTS_SCHDLR_SSPND_YIELD_DONE: + ERTS_BIF_YIELD_RETURN_X(BIF_P, make_small(old_no), + am_schedulers_online); + case ERTS_SCHDLR_SSPND_EINVAL: + goto error; + default: + ASSERT(0); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + break; + } +#endif + } else if (BIF_ARG_1 == am_fullsweep_after) { + Uint16 nval; + Uint oval; + if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) { + goto error; + } + nval = (n > (Sint) ((Uint16) -1)) ? ((Uint16) -1) : ((Uint16) n); + oval = (Uint) erts_smp_atomic_xchg(&erts_max_gen_gcs, (long) nval); + BIF_RET(make_small(oval)); + } else if (BIF_ARG_1 == am_min_heap_size) { + int oval = H_MIN_SIZE; + if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) { + goto error; + } + H_MIN_SIZE = erts_next_heap_size(n, 0); + BIF_RET(make_small(oval)); + } else if (BIF_ARG_1 == am_display_items) { + int oval = display_items; + if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) { + goto error; + } + display_items = n < 32 ? 32 : n; + BIF_RET(make_small(oval)); + } else if (BIF_ARG_1 == am_debug_flags) { + BIF_RET(am_true); + } else if (BIF_ARG_1 == am_backtrace_depth) { + int oval = erts_backtrace_depth; + if (!is_small(BIF_ARG_2) || (n = signed_val(BIF_ARG_2)) < 0) { + goto error; + } + if (n > MAX_BACKTRACE_SIZE) n = MAX_BACKTRACE_SIZE; + erts_backtrace_depth = n; + BIF_RET(make_small(oval)); + } else if (BIF_ARG_1 == am_trace_control_word) { + BIF_RET(db_set_trace_control_word_1(BIF_P, BIF_ARG_2)); + } else if (BIF_ARG_1 == am_sequential_tracer) { + Eterm old_value = erts_set_system_seq_tracer(BIF_P, + ERTS_PROC_LOCK_MAIN, + BIF_ARG_2); + if (old_value != THE_NON_VALUE) { + BIF_RET(old_value); + } + } else if (BIF_ARG_1 == make_small(1)) { + Uint i; + ErlMessage* mp; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + for (i = 0; i < erts_max_processes; i++) { + if (process_tab[i] != (Process*) 0) { + Process* p = process_tab[i]; + p->seq_trace_token = NIL; + p->seq_trace_clock = 0; + p->seq_trace_lastcnt = 0; + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); + mp = p->msg.first; + while(mp != NULL) { + ERL_MESSAGE_TOKEN(mp) = NIL; + mp = mp->next; + } + } + } + + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + + BIF_RET(am_true); + } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { + int what; + if (ERTS_IS_ATOM_STR("disable", BIF_ARG_2)) + what = ERTS_SCHED_STAT_MODIFY_DISABLE; + else if (ERTS_IS_ATOM_STR("enable", BIF_ARG_2)) + what = ERTS_SCHED_STAT_MODIFY_ENABLE; + else if (ERTS_IS_ATOM_STR("clear", BIF_ARG_2)) + what = ERTS_SCHED_STAT_MODIFY_CLEAR; + else + goto error; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_sched_stat_modify(what); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(am_true); + } else if (ERTS_IS_ATOM_STR("internal_cpu_topology", BIF_ARG_1)) { + Eterm res = erts_set_cpu_topology(BIF_P, BIF_ARG_2); + if (is_value(res)) + BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("cpu_topology", BIF_ARG_1)) { + BIF_TRAP1(set_cpu_topology_trap, BIF_P, BIF_ARG_2); + } else if (ERTS_IS_ATOM_STR("scheduler_bind_type", BIF_ARG_1)) { + return erts_bind_schedulers(BIF_P, BIF_ARG_2); + } + error: + BIF_ERROR(BIF_P, BADARG); +} + +/**********************************************************************/ + +BIF_RETTYPE hash_2(BIF_ALIST_2) +{ + Uint32 hash; + Sint range; + + if (is_not_small(BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + if ((range = signed_val(BIF_ARG_2)) <= 0) { /* [1..MAX_SMALL] */ + BIF_ERROR(BIF_P, BADARG); + } +#ifdef ARCH_64 + if (range > ((1L << 27) - 1)) + BIF_ERROR(BIF_P, BADARG); +#endif + hash = make_broken_hash(BIF_ARG_1); + BIF_RET(make_small(1 + (hash % range))); /* [1..range] */ +} + +BIF_RETTYPE phash_2(BIF_ALIST_2) +{ + Uint32 hash; + Uint32 final_hash; + Uint32 range; + + /* Check for special case 2^32 */ + if (term_equals_2pow32(BIF_ARG_2)) { + range = 0; + } else { + Uint u; + if (!term_to_Uint(BIF_ARG_2, &u) || ((u >> 16) >> 16) != 0 || !u) { + BIF_ERROR(BIF_P, BADARG); + } + range = (Uint32) u; + } + hash = make_hash(BIF_ARG_1); + if (range) { + final_hash = 1 + (hash % range); /* [1..range] */ + } else if ((final_hash = hash + 1) == 0) { + /* + * XXX In this case, there will still be a ArithAlloc() in erts_mixed_plus(). + */ + BIF_RET(erts_mixed_plus(BIF_P, + erts_make_integer(hash, BIF_P), + make_small(1))); + } + + BIF_RET(erts_make_integer(final_hash, BIF_P)); +} + +BIF_RETTYPE phash2_1(BIF_ALIST_1) +{ + Uint32 hash; + + hash = make_hash2(BIF_ARG_1); + BIF_RET(make_small(hash & ((1L << 27) - 1))); +} + +BIF_RETTYPE phash2_2(BIF_ALIST_2) +{ + Uint32 hash; + Uint32 final_hash; + Uint32 range; + + /* Check for special case 2^32 */ + if (term_equals_2pow32(BIF_ARG_2)) { + range = 0; + } else { + Uint u; + if (!term_to_Uint(BIF_ARG_2, &u) || ((u >> 16) >> 16) != 0 || !u) { + BIF_ERROR(BIF_P, BADARG); + } + range = (Uint32) u; + } + hash = make_hash2(BIF_ARG_1); + if (range) { + final_hash = hash % range; /* [0..range-1] */ + } else { + final_hash = hash; + } + /* + * Return either a small or a big. Use the heap for bigs if there is room. + */ +#ifdef ARCH_64 + BIF_RET(make_small(final_hash)); +#else + if (IS_USMALL(0, final_hash)) { + BIF_RET(make_small(final_hash)); + } else { + Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(final_hash, hp)); + } +#endif +} + +BIF_RETTYPE bump_reductions_1(BIF_ALIST_1) +{ + Sint reds; + + if (is_not_small(BIF_ARG_1) || ((reds = signed_val(BIF_ARG_1)) < 0)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (reds > CONTEXT_REDS) { + reds = CONTEXT_REDS; + } + BIF_RET2(am_true, reds); +} + +/* + * Processes doing yield on return in a bif ends up in bif_return_trap(). + */ +static BIF_RETTYPE bif_return_trap( +#ifdef DEBUG + BIF_ALIST_2 +#else + BIF_ALIST_1 +#endif + ) +{ +#ifdef DEBUG + switch (BIF_ARG_2) { + case am_multi_scheduling: +#ifdef ERTS_SMP + erts_dbg_multi_scheduling_return_trap(BIF_P, BIF_ARG_1); +#endif + break; + case am_schedulers_online: + break; + default: + break; + } +#endif + + BIF_RET(BIF_ARG_1); +} + +/* + * NOTE: The erts_bif_prep_await_proc_exit_*() functions are + * tightly coupled with the implementation of erlang:await_proc_exit/3. + * The erts_bif_prep_await_proc_exit_*() functions can safely call + * skip_current_msgq() since they know that erlang:await_proc_exit/3 + * unconditionally will do a monitor and then unconditionally will + * wait for the corresponding 'DOWN' message in a receive, and no other + * receive is done before this receive. This optimization removes an + * unnecessary scan of the currently existing message queue (which + * can be large). If the erlang:await_proc_exit/3 implementation + * is changed so that the above isn't true, nasty bugs in later + * receives, etc, may appear. + */ + +static ERTS_INLINE int +skip_current_msgq(Process *c_p) +{ + int res; +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + erts_proc_lc_chk_only_proc_main(c_p); +#endif + + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + if (ERTS_PROC_PENDING_EXIT(c_p)) { + KILL_CATCHES(c_p); + c_p->freason = EXC_EXIT; + res = 0; + } + else { + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + c_p->msg.save = c_p->msg.last; + res = 1; + } + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + return res; +} + +void +erts_bif_prep_await_proc_exit_data_trap(Process *c_p, Eterm pid, Eterm ret) +{ + if (skip_current_msgq(c_p)) { + Eterm unused; + ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_data, ret); + } +} + +void +erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, Eterm pid) +{ + if (skip_current_msgq(c_p)) { + Eterm unused; + ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, + pid, am_reason, am_undefined); + } +} + +void +erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, + Eterm pid, + Eterm module, + Eterm function, + Eterm args[], + int nargs) +{ + ASSERT(is_atom(module) && is_atom(function)); + if (skip_current_msgq(c_p)) { + Eterm unused; + Eterm term; + Eterm *hp; + int i; + + hp = HAlloc(c_p, 4+2*nargs); + term = NIL; + for (i = nargs-1; i >= 0; i--) { + term = CONS(hp, args[i], term); + hp += 2; + } + term = TUPLE3(hp, module, function, term); + ERTS_BIF_PREP_TRAP3(unused, await_proc_exit_trap, c_p, pid, am_apply, term); + } +} + +Export bif_return_trap_export; + +void erts_init_bif(void) +{ + reference0 = 0; + reference1 = 0; + reference2 = 0; + + erts_smp_spinlock_init(&make_ref_lock, "make_ref"); + erts_smp_mtx_init(&ports_snapshot_mtx, "ports_snapshot"); + erts_smp_atomic_init(&erts_dead_ports_ptr, (long)NULL); + + /* + * bif_return_trap/1 is a hidden BIF that bifs that need to + * yield the calling process traps to. The only thing it does: + * return the value passed as argument. + */ + sys_memset((void *) &bif_return_trap_export, 0, sizeof(Export)); + bif_return_trap_export.address = &bif_return_trap_export.code[3]; + bif_return_trap_export.code[0] = am_erlang; + bif_return_trap_export.code[1] = am_bif_return_trap; +#ifdef DEBUG + bif_return_trap_export.code[2] = 2; +#else + bif_return_trap_export.code[2] = 1; +#endif + bif_return_trap_export.code[3] = (Eterm) em_apply_bif; + bif_return_trap_export.code[4] = (Eterm) &bif_return_trap; + + flush_monitor_message_trap = erts_export_put(am_erlang, + am_flush_monitor_message, + 2); + + set_cpu_topology_trap = erts_export_put(am_erlang, + am_set_cpu_topology, + 1); + erts_format_cpu_topology_trap = erts_export_put(am_erlang, + am_format_cpu_topology, + 1); + await_proc_exit_trap = erts_export_put(am_erlang,am_await_proc_exit,3); +} + +BIF_RETTYPE blocking_read_file_1(BIF_ALIST_1) +{ + Eterm bin; + Eterm* hp; + byte *buff; + int i, buff_size; + FILE *file; + struct stat file_info; + char *filename = NULL; + + i = list_length(BIF_ARG_1); + if (i < 0) { + BIF_ERROR(BIF_P, BADARG); + } + filename = erts_alloc(ERTS_ALC_T_TMP, i + 1); + if (intlist_to_buf(BIF_ARG_1, filename, i) != i) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + filename[i] = '\0'; + + hp = HAlloc(BIF_P, 3); + + file = fopen(filename, "r"); + if(file == NULL){ + erts_free(ERTS_ALC_T_TMP, (void *) filename); + BIF_RET(TUPLE2(hp, am_error, am_nofile)); + } + + stat(filename, &file_info); + erts_free(ERTS_ALC_T_TMP, (void *) filename); + + buff_size = file_info.st_size; + buff = (byte *) erts_alloc_fnf(ERTS_ALC_T_TMP, buff_size); + if (!buff) { + fclose(file); + BIF_RET(TUPLE2(hp, am_error, am_allocator)); + } + fread(buff, 1, buff_size, file); + fclose(file); + bin = new_binary(BIF_P, buff, buff_size); + erts_free(ERTS_ALC_T_TMP, (void *) buff); + + BIF_RET(TUPLE2(hp, am_ok, bin)); +} +#ifdef HARDDEBUG +/* +You'll need this line in bif.tab to be able to use this debug bif + +bif erlang:send_to_logger/2 + +*/ +BIF_RETTYPE send_to_logger_2(BIF_ALIST_2) +{ + byte *buf; + int len; + if (!is_atom(BIF_ARG_1) || !(is_list(BIF_ARG_2) || + is_nil(BIF_ARG_1))) { + BIF_ERROR(BIF_P,BADARG); + } + len = io_list_len(BIF_ARG_2); + if (len < 0) + BIF_ERROR(BIF_P,BADARG); + else if (len == 0) + buf = ""; + else { +#ifdef DEBUG + int len2; +#endif + buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, len+1); +#ifdef DEBUG + len2 = +#else + (void) +#endif + io_list_to_buf(BIF_ARG_2, buf, len); + ASSERT(len2 == len); + buf[len] = '\0'; + switch (BIF_ARG_1) { + case am_info: + erts_send_info_to_logger(BIF_P->group_leader, buf, len); + break; + case am_warning: + erts_send_warning_to_logger(BIF_P->group_leader, buf, len); + break; + case am_error: + erts_send_error_to_logger(BIF_P->group_leader, buf, len); + break; + default: + { + BIF_ERROR(BIF_P,BADARG); + } + } + erts_free(ERTS_ALC_T_TMP, (void *) buf); + } + BIF_RET(am_true); +} +#endif /* HARDDEBUG */ + +BIF_RETTYPE get_module_info_1(BIF_ALIST_1) +{ + Eterm ret = erts_module_info_0(BIF_P, BIF_ARG_1); + + if (is_non_value(ret)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(ret); +} + + +BIF_RETTYPE get_module_info_2(BIF_ALIST_2) +{ + Eterm ret = erts_module_info_1(BIF_P, BIF_ARG_1, BIF_ARG_2); + + if (is_non_value(ret)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(ret); +} diff --git a/erts/emulator/beam/bif.h b/erts/emulator/beam/bif.h new file mode 100644 index 0000000000..05e9b78c28 --- /dev/null +++ b/erts/emulator/beam/bif.h @@ -0,0 +1,386 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __BIF_H__ +#define __BIF_H__ + +extern Export* erts_format_cpu_topology_trap; + +#define BIF_RETTYPE Eterm + +#define BIF_P A__p + +#define BIF_ALIST_0 Process* A__p +#define BIF_ALIST_1 Process* A__p, Eterm A_1 +#define BIF_ALIST_2 Process* A__p, Eterm A_1, Eterm A_2 +#define BIF_ALIST_3 Process* A__p, Eterm A_1, Eterm A_2, Eterm A_3 + +#define BIF_ARG_1 A_1 +#define BIF_ARG_2 A_2 +#define BIF_ARG_3 A_3 + +#define BUMP_ALL_REDS(p) do { \ + if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \ + (p)->fcalls = 0; \ + else \ + (p)->fcalls = -CONTEXT_REDS; \ +} while(0) + + +#define ERTS_VBUMP_ALL_REDS(p) \ +do { \ + if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) { \ + if ((p)->fcalls > 0) \ + ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (p)->fcalls; \ + (p)->fcalls = 0; \ + } \ + else { \ + if ((p)->fcalls > -CONTEXT_REDS) \ + ERTS_PROC_GET_SCHDATA((p))->virtual_reds \ + += ((p)->fcalls - (-CONTEXT_REDS)); \ + (p)->fcalls = -CONTEXT_REDS; \ + } \ +} while(0) + +#define BUMP_REDS(p, gc) do { \ + (p)->fcalls -= (gc); \ + if ((p)->fcalls < 0) { \ + if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) \ + (p)->fcalls = 0; \ + else if ((p)->fcalls < -CONTEXT_REDS) \ + (p)->fcalls = -CONTEXT_REDS; \ + } \ +} while(0) + + +#define ERTS_VBUMP_REDS(p, reds) \ +do { \ + if (!ERTS_PROC_GET_SAVED_CALLS_BUF((p))) { \ + if ((p)->fcalls >= reds) { \ + (p)->fcalls -= reds; \ + ERTS_PROC_GET_SCHDATA((p))->virtual_reds += reds; \ + } \ + else { \ + if ((p)->fcalls > 0) \ + ERTS_PROC_GET_SCHDATA((p))->virtual_reds += (p)->fcalls;\ + (p)->fcalls = 0; \ + } \ + } \ + else { \ + if ((p)->fcalls >= reds - CONTEXT_REDS) { \ + (p)->fcalls -= reds; \ + ERTS_PROC_GET_SCHDATA((p))->virtual_reds += reds; \ + } \ + else { \ + if ((p)->fcalls > -CONTEXT_REDS) \ + ERTS_PROC_GET_SCHDATA((p))->virtual_reds \ + += (p)->fcalls - (-CONTEXT_REDS); \ + (p)->fcalls = -CONTEXT_REDS; \ + } \ + } \ +} while(0) + +#define ERTS_BIF_REDS_LEFT(p) \ + (ERTS_PROC_GET_SAVED_CALLS_BUF((p)) \ + ? ((p)->fcalls > -CONTEXT_REDS ? ((p)->fcalls - (-CONTEXT_REDS)) : 0)\ + : ((p)->fcalls > 0 ? (p)->fcalls : 0)) + +#define BIF_RET2(x, gc) do { \ + BUMP_REDS(BIF_P, (gc)); \ + return (x); \ +} while(0) + +#define BIF_RET(x) return (x) + +#define ERTS_BIF_PREP_RET(Ret, Val) ((Ret) = (Val)) + +#define BIF_ERROR(p,r) do { \ + (p)->freason = r; \ + return THE_NON_VALUE; \ +} while(0) + +#define ERTS_BIF_PREP_ERROR(Ret, Proc, Reason) \ +do { \ + (Proc)->freason = (Reason); \ + (Ret) = THE_NON_VALUE; \ +} while (0) + + +#define ERTS_BIF_PREP_TRAP0(Ret, Trap, Proc) \ +do { \ + (Proc)->arity = 0; \ + (Proc)->def_arg_reg[3] = (Eterm) (Trap->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_TRAP1(Ret, Trap, Proc, A0) \ +do { \ + (Proc)->arity = 1; \ + (Proc)->def_arg_reg[0] = (Eterm) (A0); \ + (Proc)->def_arg_reg[3] = (Eterm) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_TRAP2(Ret, Trap, Proc, A0, A1) \ +do { \ + (Proc)->arity = 2; \ + (Proc)->def_arg_reg[0] = (Eterm) (A0); \ + (Proc)->def_arg_reg[1] = (Eterm) (A1); \ + (Proc)->def_arg_reg[3] = (Eterm) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_TRAP3(Ret, Trap, Proc, A0, A1, A2)\ +do { \ + (Proc)->arity = 3; \ + (Proc)->def_arg_reg[0] = (Eterm) (A0); \ + (Proc)->def_arg_reg[1] = (Eterm) (A1); \ + (Proc)->def_arg_reg[2] = (Eterm) (A2); \ + (Proc)->def_arg_reg[3] = (Eterm) ((Trap)->address); \ + (Proc)->freason = TRAP; \ + (Ret) = THE_NON_VALUE; \ +} while (0) + +#define BIF_TRAP0(p, Trap_) do { \ + (p)->arity = 0; \ + (p)->def_arg_reg[3] = (Eterm) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ + } while(0) + +#define BIF_TRAP1(Trap_, p, A0) do { \ + (p)->arity = 1; \ + (p)->def_arg_reg[0] = (A0); \ + (p)->def_arg_reg[3] = (Eterm) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ + } while(0) + +#define BIF_TRAP2(Trap_, p, A0, A1) do { \ + (p)->arity = 2; \ + (p)->def_arg_reg[0] = (A0); \ + (p)->def_arg_reg[1] = (A1); \ + (p)->def_arg_reg[3] = (Eterm) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ + } while(0) + +#define BIF_TRAP3(Trap_, p, A0, A1, A2) do { \ + (p)->arity = 3; \ + (p)->def_arg_reg[0] = (A0); \ + (p)->def_arg_reg[1] = (A1); \ + (p)->def_arg_reg[2] = (A2); \ + (p)->def_arg_reg[3] = (Eterm) ((Trap_)->address); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ + } while(0) + +#define BIF_TRAP_CODE_PTR_0(p, Code_) do { \ + (p)->arity = 0; \ + (p)->def_arg_reg[3] = (Eterm) (Code_); \ + (p)->freason = TRAP; \ + return THE_NON_VALUE; \ + } while(0) + +extern Export bif_return_trap_export; +#ifdef DEBUG +#define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, DEBUG_VAL) \ +do { \ + ERTS_VBUMP_ALL_REDS(P); \ + ERTS_BIF_PREP_TRAP2(RET, &bif_return_trap_export, (P), (VAL), \ + (DEBUG_VAL)); \ +} while (0) +#else +#define ERTS_BIF_PREP_YIELD_RETURN_X(RET, P, VAL, DEBUG_VAL) \ +do { \ + ERTS_VBUMP_ALL_REDS(P); \ + ERTS_BIF_PREP_TRAP1(RET, &bif_return_trap_export, (P), (VAL)); \ +} while (0) +#endif + +#define ERTS_BIF_PREP_YIELD_RETURN(RET, P, VAL) \ + ERTS_BIF_PREP_YIELD_RETURN_X(RET, (P), (VAL), am_undefined) + +#ifdef DEBUG +#define ERTS_BIF_YIELD_RETURN_X(P, VAL, DEBUG_VAL) \ +do { \ + ERTS_VBUMP_ALL_REDS(P); \ + BIF_TRAP2(&bif_return_trap_export, (P), (VAL), (DEBUG_VAL)); \ +} while (0) +#else +#define ERTS_BIF_YIELD_RETURN_X(P, VAL, DEBUG_VAL) \ +do { \ + ERTS_VBUMP_ALL_REDS(P); \ + BIF_TRAP1(&bif_return_trap_export, (P), (VAL)); \ +} while (0) +#endif + +#define ERTS_BIF_RETURN_YIELD(P) ERTS_VBUMP_ALL_REDS((P)) + +#define ERTS_BIF_YIELD_RETURN(P, VAL) \ + ERTS_BIF_YIELD_RETURN_X((P), (VAL), am_undefined) + +#define ERTS_BIF_PREP_YIELD0(RET, TRP, P) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + ERTS_BIF_PREP_TRAP0(RET, (TRP), (P)); \ +} while (0) + +#define ERTS_BIF_PREP_YIELD1(RET, TRP, P, A0) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + ERTS_BIF_PREP_TRAP1(RET, (TRP), (P), (A0)); \ +} while (0) + +#define ERTS_BIF_PREP_YIELD2(RET, TRP, P, A0, A1) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + ERTS_BIF_PREP_TRAP2(RET, (TRP), (P), (A0), (A1)); \ +} while (0) + +#define ERTS_BIF_PREP_YIELD3(RET, TRP, P, A0, A1, A2) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + ERTS_BIF_PREP_TRAP3(RET, (TRP), (P), (A0), (A1), (A2)); \ +} while (0) + +#define ERTS_BIF_YIELD0(TRP, P) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + BIF_TRAP0((TRP), (P)); \ +} while (0) + +#define ERTS_BIF_YIELD1(TRP, P, A0) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + BIF_TRAP1((TRP), (P), (A0)); \ +} while (0) + +#define ERTS_BIF_YIELD2(TRP, P, A0, A1) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + BIF_TRAP2((TRP), (P), (A0), (A1)); \ +} while (0) + +#define ERTS_BIF_YIELD3(TRP, P, A0, A1, A2) \ +do { \ + ERTS_VBUMP_ALL_REDS((P)); \ + BIF_TRAP3((TRP), (P), (A0), (A1), (A2)); \ +} while (0) + +#define ERTS_BIF_EXITED(PROC) \ +do { \ + KILL_CATCHES((PROC)); \ + BIF_ERROR((PROC), EXC_EXIT); \ +} while (0) + +#define ERTS_BIF_CHK_EXITED(PROC) \ +do { \ + if (ERTS_PROC_IS_EXITING((PROC))) \ + ERTS_BIF_EXITED((PROC)); \ +} while (0) + +#ifdef ERTS_SMP +#define ERTS_SMP_BIF_CHK_PENDING_EXIT(P, L) \ +do { \ + ERTS_SMP_LC_ASSERT((L) == erts_proc_lc_my_proc_locks((P))); \ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & (L)); \ + if (!((L) & ERTS_PROC_LOCK_STATUS)) \ + erts_smp_proc_lock((P), ERTS_PROC_LOCK_STATUS); \ + if (ERTS_PROC_PENDING_EXIT((P))) { \ + erts_handle_pending_exit((P), (L)|ERTS_PROC_LOCK_STATUS); \ + erts_smp_proc_unlock((P), \ + (((L)|ERTS_PROC_LOCK_STATUS) \ + & ~ERTS_PROC_LOCK_MAIN)); \ + ERTS_BIF_EXITED((P)); \ + } \ + if (!((L) & ERTS_PROC_LOCK_STATUS)) \ + erts_smp_proc_unlock((P), ERTS_PROC_LOCK_STATUS); \ +} while (0) +#else +#define ERTS_SMP_BIF_CHK_PENDING_EXIT(P, L) +#endif + +/* + * The ERTS_BIF_*_AWAIT_X_*_TRAP makros either exits the caller, or + * sets up a trap to erlang:await_proc_exit/3. + * + * The caller is acquired to hold the 'main' lock on C_P. No other locks + * are allowed to be held. + */ + +#define ERTS_BIF_PREP_AWAIT_X_DATA_TRAP(RET, C_P, PID, DATA) \ +do { \ + erts_bif_prep_await_proc_exit_data_trap((C_P), (PID), (DATA)); \ + (RET) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_AWAIT_X_REASON_TRAP(RET, C_P, PID) \ +do { \ + erts_bif_prep_await_proc_exit_reason_trap((C_P), (PID)); \ + (RET) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_PREP_AWAIT_X_APPLY_TRAP(RET, C_P, PID, M, F, A, AN) \ +do { \ + erts_bif_prep_await_proc_exit_apply_trap((C_P), (PID), \ + (M), (F), (A), (AN)); \ + (RET) = THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_AWAIT_X_DATA_TRAP(C_P, PID, DATA) \ +do { \ + erts_bif_prep_await_proc_exit_data_trap((C_P), (PID), (DATA)); \ + return THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_AWAIT_X_REASON_TRAP(C_P, PID) \ +do { \ + erts_bif_prep_await_proc_exit_reason_trap((C_P), (PID)); \ + return THE_NON_VALUE; \ +} while (0) + +#define ERTS_BIF_AWAIT_X_APPLY_TRAP(C_P, PID, M, F, A, AN) \ +do { \ + erts_bif_prep_await_proc_exit_apply_trap((C_P), (PID), \ + (M), (F), (A), (AN)); \ + return THE_NON_VALUE; \ +} while (0) + +void +erts_bif_prep_await_proc_exit_data_trap(Process *c_p, + Eterm pid, + Eterm data); +void +erts_bif_prep_await_proc_exit_reason_trap(Process *c_p, + Eterm pid); +void +erts_bif_prep_await_proc_exit_apply_trap(Process *c_p, + Eterm pid, + Eterm module, + Eterm function, + Eterm args[], + int nargs); + +#include "erl_bif_table.h" + +#endif diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab new file mode 100644 index 0000000000..85a729208f --- /dev/null +++ b/erts/emulator/beam/bif.tab @@ -0,0 +1,761 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# File format: +# +# Lines starting with '#' are ignored. +# +# ::= "bif" * | "ubif" * +# ::= ":" "/" +# +# "ubif" is an unwrapped bif, i.e. a bif without a trace wrapper, +# or rather; the trace entry point in the export entry is the same +# as the normal entry point, and no trace wrapper is generated. +# +# Important: Use "ubif" for guard BIFs and operators; use "bif" for ordinary BIFs. +# +# Add new BIFs to the end of the file. Do not bother adding a "packaged BIF name" +# (such as 'erl.lang.number'); if/when packages will be supported we will add +# all those names. +# +# Note: Guards BIFs require special support in the compiler (to be able to actually +# call them from within a guard). +# + +ubif erlang:abs/1 +ubif 'erl.lang.number':abs/1 ebif_abs_1 +bif erlang:adler32/1 +bif 'erl.util.crypt.adler32':sum/1 ebif_adler32_1 +bif erlang:adler32/2 +bif 'erl.util.crypt.adler32':sum/2 ebif_adler32_2 +bif erlang:adler32_combine/3 +bif 'erl.util.crypt.adler32':combine/3 ebif_adler32_combine_3 +bif erlang:apply/3 +bif 'erl.lang':apply/3 ebif_apply_3 +bif erlang:atom_to_list/1 +bif 'erl.lang.atom':to_string/1 ebif_atom_to_string_1 atom_to_list_1 +bif erlang:binary_to_list/1 +bif 'erl.lang.binary':to_list/1 ebif_binary_to_list_1 +bif erlang:binary_to_list/3 +bif 'erl.lang.binary':to_list/3 ebif_binary_to_list_3 +bif erlang:binary_to_term/1 +bif 'erl.lang.binary':to_term/1 ebif_binary_to_term_1 +bif erlang:check_process_code/2 +bif 'erl.system.code':check_process/2 ebif_check_process_code_2 +bif erlang:crc32/1 +bif 'erl.util.crypt.crc32':sum/1 ebif_crc32_1 +bif erlang:crc32/2 +bif 'erl.util.crypt.crc32':sum/2 ebif_crc32_2 +bif erlang:crc32_combine/3 +bif 'erl.util.crypt.crc32':combine/3 ebif_crc32_combine_3 +bif erlang:date/0 +bif 'erl.util.date':today/0 ebif_date_0 +bif erlang:delete_module/1 +bif 'erl.system.code':delete/1 ebif_delete_module_1 +bif erlang:display/1 +bif 'erl.system.debug':display/1 ebif_display_1 +bif erlang:display_string/1 +bif 'erl.system.debug':display_string/1 ebif_display_string_1 +bif erlang:display_nl/0 +bif 'erl.system.debug':display_nl/0 ebif_display_nl_0 +ubif erlang:element/2 +ubif 'erl.lang.tuple':element/2 ebif_element_2 +bif erlang:erase/0 +bif 'erl.lang.proc.pdict':erase/0 ebif_erase_0 +bif erlang:erase/1 +bif 'erl.lang.proc.pdict':erase/1 ebif_erase_1 +bif erlang:exit/1 +bif 'erl.lang':exit/1 ebif_exit_1 +bif erlang:exit/2 +bif 'erl.lang.proc':signal/2 ebif_signal_2 exit_2 +bif erlang:external_size/1 +bif 'erl.lang.term':external_size/1 ebif_external_size_1 +ubif erlang:float/1 +ubif 'erl.lang.number':to_float/1 ebif_to_float_1 float_1 +bif erlang:float_to_list/1 +bif 'erl.lang.float':to_string/1 ebif_float_to_string_1 float_to_list_1 +bif erlang:fun_info/2 +bif 'erl.lang.function':info/2 ebif_fun_info_2 +bif erlang:garbage_collect/0 +bif 'erl.system':garbage_collect/0 ebif_garbage_collect_0 +bif erlang:garbage_collect/1 +bif 'erl.system':garbage_collect/1 ebif_garbage_collect_1 +bif erlang:garbage_collect_message_area/0 +bif 'erl.system':garbage_collect_message_area/0 ebif_garbage_collect_message_area_0 +bif erlang:get/0 +bif 'erl.lang.proc.pdict':get/0 ebif_get_0 +bif erlang:get/1 +bif 'erl.lang.proc.pdict':get/1 ebif_get_1 +bif erlang:get_keys/1 +bif 'erl.lang.proc.pdict':get_keys/1 ebif_get_keys_1 +bif erlang:group_leader/0 +bif 'erl.lang.proc':group_leader/0 ebif_group_leader_0 +bif erlang:group_leader/2 +bif 'erl.lang.proc':set_group_leader/2 ebif_group_leader_2 +bif erlang:halt/0 +bif 'erl.lang.system':halt/0 ebif_halt_0 +bif erlang:halt/1 +bif 'erl.lang.system':halt/1 ebif_halt_1 +bif erlang:phash/2 +bif erlang:phash2/1 +bif erlang:phash2/2 +bif 'erl.lang.term':hash/1 ebif_phash2_1 +bif 'erl.lang.term':hash/2 ebif_phash2_2 +ubif erlang:hd/1 +ubif 'erl.lang.list':hd/1 ebif_hd_1 +bif erlang:integer_to_list/1 +bif 'erl.lang.integer':to_string/1 ebif_integer_to_string_1 integer_to_list_1 +bif erlang:is_alive/0 +bif 'erl.lang.node':is_alive/0 ebif_is_alive_0 +ubif erlang:length/1 +ubif 'erl.lang.list':length/1 ebif_length_1 +bif erlang:link/1 +bif 'erl.lang.proc':link/1 ebif_link_1 +bif erlang:list_to_atom/1 +bif 'erl.lang.atom':from_string/1 ebif_string_to_atom_1 list_to_atom_1 +bif erlang:list_to_binary/1 +bif 'erl.lang.binary':from_list/1 ebif_list_to_binary_1 +bif erlang:list_to_float/1 +bif 'erl.lang.float':from_string/1 ebif_string_to_float_1 list_to_float_1 +bif erlang:list_to_integer/1 +bif 'erl.lang.integer':from_string/1 ebif_string_to_integer_1 list_to_integer_1 +bif erlang:list_to_pid/1 +bif 'erl.lang.proc':string_to_pid/1 ebif_string_to_pid_1 list_to_pid_1 +bif erlang:list_to_tuple/1 +bif 'erl.lang.tuple':from_list/1 ebif_list_to_tuple_1 +bif erlang:load_module/2 +bif 'erl.system.code':load/2 ebif_load_module_2 +bif erlang:loaded/0 +bif 'erl.system.code':loaded/0 ebif_loaded_0 +bif erlang:localtime/0 +bif 'erl.util.date':local/0 ebif_localtime_0 +bif erlang:localtime_to_universaltime/2 +bif 'erl.util.date':local_to_utc/2 ebif_localtime_to_universaltime_2 +bif erlang:make_ref/0 +bif 'erl.lang.ref':new/0 ebif_make_ref_0 +bif erlang:md5/1 +bif 'erl.util.crypt.md5':digest/1 ebif_md5_1 +bif erlang:md5_init/0 +bif 'erl.util.crypt.md5':init/0 ebif_md5_init_0 +bif erlang:md5_update/2 +bif 'erl.util.crypt.md5':update/2 ebif_md5_update_2 +bif erlang:md5_final/1 +bif 'erl.util.crypt.md5':final/1 ebif_md5_final_1 +bif erlang:memory/0 +bif 'erl.lang':memory/0 ebif_memory_0 +bif erlang:memory/1 +bif 'erl.lang':memory/1 ebif_memory_1 +bif erlang:module_loaded/1 +bif 'erl.system.code':is_loaded/1 ebif_is_loaded_1 module_loaded_1 +bif erlang:function_exported/3 +bif 'erl.system.code':is_loaded/3 ebif_is_loaded_3 function_exported_3 +bif erlang:monitor_node/2 +bif 'erl.lang.node':monitor/2 ebif_monitor_node_2 +bif erlang:monitor_node/3 +bif 'erl.lang.node':monitor/3 ebif_monitor_node_3 +ubif erlang:node/1 +ubif 'erl.lang.node':node/1 ebif_node_1 +ubif erlang:node/0 +ubif 'erl.lang.node':node/0 ebif_node_0 +bif erlang:nodes/1 +bif 'erl.lang.node':nodes/1 ebif_nodes_1 +bif erlang:now/0 +bif 'erl.system':now/0 ebif_now_0 + +bif erlang:open_port/2 +bif 'erl.lang.port':open/2 ebif_open_port_2 open_port_2 + +bif erlang:pid_to_list/1 +bif 'erl.lang.proc':pid_to_string/1 ebif_pid_to_string_1 pid_to_list_1 +bif erlang:port_info/1 +bif 'erl.lang.port':info/1 ebif_port_info_1 +bif erlang:port_info/2 +bif 'erl.lang.port':info/2 ebif_port_info_2 +bif erlang:ports/0 +bif 'erl.lang.node':ports/0 ebif_ports_0 +bif erlang:pre_loaded/0 +bif 'erl.system.code':preloaded/0 ebif_pre_loaded_0 +bif erlang:process_flag/2 +bif 'erl.lang.proc':set_flag/2 ebif_process_flag_2 +bif erlang:process_flag/3 +bif 'erl.lang.proc':set_flag/3 ebif_process_flag_3 +bif erlang:process_info/1 +bif 'erl.lang.proc':info/1 ebif_process_info_1 +bif erlang:process_info/2 +bif 'erl.lang.proc':info/2 ebif_process_info_2 +bif erlang:processes/0 +bif 'erl.lang.node':processes/0 ebif_processes_0 +bif erlang:purge_module/1 +bif 'erl.system.code':purge/1 ebif_purge_module_1 +bif erlang:put/2 +bif 'erl.lang.proc.pdict':put/2 ebif_put_2 +bif erlang:register/2 +bif 'erl.lang.node':register/2 ebif_register_2 +bif erlang:registered/0 +bif 'erl.lang.node':registered/0 ebif_registered_0 +ubif erlang:round/1 +ubif 'erl.lang.number':round/1 ebif_round_1 +ubif erlang:self/0 +ubif 'erl.lang.proc':self/0 ebif_self_0 +bif erlang:setelement/3 +bif 'erl.lang.tuple':setelement/3 ebif_setelement_3 +ubif erlang:size/1 +ubif 'erl.lang.term':size/1 ebif_size_1 +bif erlang:spawn/3 +bif 'erl.lang.proc':spawn/3 ebif_spawn_3 +bif erlang:spawn_link/3 +bif 'erl.lang.proc':spawn_link/3 ebif_spawn_link_3 +bif erlang:split_binary/2 +bif 'erl.lang.binary':split/2 ebif_split_binary_2 +bif erlang:statistics/1 +bif 'erl.system':statistics/1 ebif_statistics_1 +bif erlang:term_to_binary/1 +bif 'erl.lang.binary':from_term/1 ebif_term_to_binary_1 +bif erlang:term_to_binary/2 +bif 'erl.lang.binary':from_term/2 ebif_term_to_binary_2 +bif erlang:throw/1 +bif 'erl.lang':throw/1 ebif_throw_1 +bif erlang:time/0 +bif 'erl.util.date':time_of_day/0 ebif_time_0 +ubif erlang:tl/1 +ubif 'erl.lang.list':tl/1 ebif_tl_1 +ubif erlang:trunc/1 +ubif 'erl.lang.number':trunc/1 ebif_trunc_1 +bif erlang:tuple_to_list/1 +bif 'erl.lang.tuple':to_list/1 ebif_tuple_to_list_1 +bif erlang:universaltime/0 +bif 'erl.util.date':utc/0 ebif_universaltime_0 +bif erlang:universaltime_to_localtime/1 +bif 'erl.util.date':utc_to_local/1 ebif_universaltime_to_localtime_1 +bif erlang:unlink/1 +bif 'erl.lang.proc':unlink/1 ebif_unlink_1 +bif erlang:unregister/1 +bif 'erl.lang.node':unregister/1 ebif_unregister_1 +bif erlang:whereis/1 +bif 'erl.lang.node':whereis/1 ebif_whereis_1 +bif erlang:spawn_opt/1 +bif 'erl.lang.proc':spawn_opt/1 ebif_spawn_opt_1 +bif erlang:setnode/2 +bif erlang:setnode/3 +bif erlang:dist_exit/3 + +bif erlang:port_call/2 +bif 'erl.lang.port':call/2 ebif_port_call_2 +bif erlang:port_call/3 +bif 'erl.lang.port':call/3 ebif_port_call_3 +bif erlang:port_command/2 +bif 'erl.lang.port':command/2 ebif_port_command_2 +bif erlang:port_command/3 +bif 'erl.lang.port':command/3 ebif_port_command_3 +bif erlang:port_control/3 +bif 'erl.lang.port':control/3 ebif_port_control_3 +bif erlang:port_close/1 +bif 'erl.lang.port':close/1 ebif_port_close_1 +bif erlang:port_connect/2 +bif 'erl.lang.port':connect/2 ebif_port_connect_2 +bif erlang:port_set_data/2 +bif 'erl.lang.port':set_data/2 ebif_port_set_data_2 +bif erlang:port_get_data/1 +bif 'erl.lang.port':get_data/1 ebif_port_get_data_1 + +# Tracing & debugging. +bif erlang:trace_pattern/2 +bif 'erl.system.debug':trace_pattern/2 ebif_trace_pattern_2 +bif erlang:trace_pattern/3 +bif 'erl.system.debug':trace_pattern/3 ebif_trace_pattern_3 +bif erlang:trace/3 +bif 'erl.system.debug':trace/3 ebif_trace_3 +bif erlang:trace_info/2 +bif 'erl.system.debug':trace_info/2 ebif_trace_info_2 +bif erlang:trace_delivered/1 +bif 'erl.system.debug':trace_delivered/1 ebif_trace_delivered_1 +bif erlang:seq_trace/2 +bif 'erl.system.debug':seq_trace/2 ebif_seq_trace_2 +bif erlang:seq_trace_info/1 +bif 'erl.system.debug':seq_trace_info/1 ebif_seq_trace_info_1 +bif erlang:seq_trace_print/1 +bif 'erl.system.debug':seq_trace_print/1 ebif_seq_trace_print_1 +bif erlang:seq_trace_print/2 +bif 'erl.system.debug':seq_trace_print/2 ebif_seq_trace_print_2 +bif erlang:suspend_process/2 +bif 'erl.system.debug':suspend_process/2 ebif_suspend_process_2 +bif erlang:resume_process/1 +bif 'erl.system.debug':resume_process/1 ebif_resume_process_1 +bif erlang:process_display/2 +bif 'erl.system.debug':process_display/2 ebif_process_display_2 + +bif erlang:bump_reductions/1 +bif 'erl.lang.proc':bump_reductions/1 ebif_bump_reductions_1 + +bif math:cos/1 +bif 'erl.lang.math':cos/1 ebif_math_cos_1 +bif math:cosh/1 +bif 'erl.lang.math':cosh/1 ebif_math_cosh_1 +bif math:sin/1 +bif 'erl.lang.math':sin/1 ebif_math_sin_1 +bif math:sinh/1 +bif 'erl.lang.math':sinh/1 ebif_math_sinh_1 +bif math:tan/1 +bif 'erl.lang.math':tan/1 ebif_math_tan_1 +bif math:tanh/1 +bif 'erl.lang.math':tanh/1 ebif_math_tanh_1 +bif math:acos/1 +bif 'erl.lang.math':acos/1 ebif_math_acos_1 +bif math:acosh/1 +bif 'erl.lang.math':acosh/1 ebif_math_acosh_1 +bif math:asin/1 +bif 'erl.lang.math':asin/1 ebif_math_asin_1 +bif math:asinh/1 +bif 'erl.lang.math':asinh/1 ebif_math_asinh_1 +bif math:atan/1 +bif 'erl.lang.math':atan/1 ebif_math_atan_1 +bif math:atanh/1 +bif 'erl.lang.math':atanh/1 ebif_math_atanh_1 +bif math:erf/1 +bif 'erl.lang.math':erf/1 ebif_math_erf_1 +bif math:erfc/1 +bif 'erl.lang.math':erfc/1 ebif_math_erfc_1 +bif math:exp/1 +bif 'erl.lang.math':exp/1 ebif_math_exp_1 +bif math:log/1 +bif 'erl.lang.math':log/1 ebif_math_log_1 +bif math:log10/1 +bif 'erl.lang.math':log10/1 ebif_math_log10_1 +bif math:sqrt/1 +bif 'erl.lang.math':sqrt/1 ebif_math_sqrt_1 +bif math:atan2/2 +bif 'erl.lang.math':atan2/2 ebif_math_atan2_2 +bif math:pow/2 +bif 'erl.lang.math':pow/2 ebif_math_pow_2 + +bif erlang:start_timer/3 +bif 'erl.lang.timer':start/3 ebif_start_timer_3 +bif erlang:send_after/3 +bif 'erl.lang.timer':send_after/3 ebif_send_after_3 +bif erlang:cancel_timer/1 +bif 'erl.lang.timer':cancel/1 ebif_cancel_timer_1 +bif erlang:read_timer/1 +bif 'erl.lang.timer':read/1 ebif_read_timer_1 + +bif erlang:make_tuple/2 +bif 'erl.lang.tuple':make/2 ebif_make_tuple_2 +bif erlang:append_element/2 +bif 'erl.lang.tuple':append_element/2 ebif_append_element_2 +bif erlang:make_tuple/3 + +bif erlang:system_flag/2 +bif 'erl.system':set_flag/2 ebif_system_flag_2 +bif erlang:system_info/1 +bif 'erl.system':info/1 ebif_system_info_1 +# New in R9C +bif erlang:system_monitor/0 +bif 'erl.system':monitor/0 ebif_system_monitor_0 +bif erlang:system_monitor/1 +bif 'erl.system':monitor/1 ebif_system_monitor_1 +bif erlang:system_monitor/2 +bif 'erl.system':monitor/2 ebif_system_monitor_2 +# Added 2006-11-07 +bif erlang:system_profile/2 +bif 'erl.system':profile/2 ebif_system_profile_2 +# End Added 2006-11-07 +# Added 2007-01-17 +bif erlang:system_profile/0 +bif 'erl.system':profile/0 ebif_system_profile_0 +# End Added 2007-01-17 +bif erlang:ref_to_list/1 +bif 'erl.lang.ref':to_string/1 ebif_ref_to_string_1 ref_to_list_1 +bif erlang:port_to_list/1 +bif 'erl.lang.port':to_string/1 ebif_port_to_string_1 port_to_list_1 +bif erlang:fun_to_list/1 +bif 'erl.lang.function':to_string/1 ebif_fun_to_string_1 fun_to_list_1 + +bif erlang:monitor/2 +bif 'erl.lang.proc':monitor/2 ebif_monitor_2 +bif erlang:demonitor/1 +bif 'erl.lang.proc':demonitor/1 ebif_demonitor_1 +bif erlang:demonitor/2 +bif 'erl.lang.proc':demonitor/2 ebif_demonitor_2 + +bif erlang:is_process_alive/1 +bif 'erl.lang.proc':is_alive/1 ebif_proc_is_alive_1 is_process_alive_1 + +bif erlang:error/1 error_1 +bif 'erl.lang':error/1 ebif_error_1 error_1 +bif erlang:error/2 error_2 +bif 'erl.lang':error/2 ebif_error_2 error_2 +bif erlang:raise/3 raise_3 +bif 'erl.lang':raise/3 ebif_raise_3 raise_3 +bif erlang:get_stacktrace/0 +bif 'erl.lang.proc':get_stacktrace/0 ebif_get_stacktrace_0 + +bif erlang:is_builtin/3 +bif 'erl.system.code':is_builtin/3 ebif_is_builtin_3 + +ubif erlang:'and'/2 +ubif 'erl.lang.bool':'and'/2 ebif_and_2 +ubif erlang:'or'/2 +ubif 'erl.lang.bool':'or'/2 ebif_or_2 +ubif erlang:'xor'/2 +ubif 'erl.lang.bool':'xor'/2 ebif_xor_2 +ubif erlang:'not'/1 +ubif 'erl.lang.bool':'not'/1 ebif_not_1 + +ubif erlang:'>'/2 sgt_2 +ubif 'erl.lang.term':greater/2 ebif_gt_2 sgt_2 +ubif erlang:'>='/2 sge_2 +ubif 'erl.lang.term':greater_or_equal/2 ebif_ge_2 sge_2 +ubif erlang:'<'/2 slt_2 +ubif 'erl.lang.term':less/2 ebif_lt_2 slt_2 +ubif erlang:'=<'/2 sle_2 +ubif 'erl.lang.term':less_or_equal/2 ebif_le_2 sle_2 +ubif erlang:'=:='/2 seq_2 +ubif 'erl.lang.term':equal/2 ebif_eq_2 seq_2 +ubif erlang:'=='/2 seqeq_2 +ubif 'erl.lang.term':arith_equal/2 ebif_areq_2 seqeq_2 +ubif erlang:'=/='/2 sneq_2 +ubif 'erl.lang.term':not_equal/2 ebif_neq_2 sneq_2 +ubif erlang:'/='/2 sneqeq_2 +ubif 'erl.lang.term':not_arith_equal/2 ebif_nareq_2 sneqeq_2 +ubif erlang:'+'/2 splus_2 +ubif 'erl.lang.number':plus/2 ebif_plus_2 splus_2 +ubif erlang:'-'/2 sminus_2 +ubif 'erl.lang.number':minus/2 ebif_minus_2 sminus_2 +ubif erlang:'*'/2 stimes_2 +ubif 'erl.lang.number':multiply/2 ebif_multiply_2 stimes_2 +ubif erlang:'/'/2 div_2 +ubif 'erl.lang.number':divide/2 ebif_divide_2 div_2 +ubif erlang:'div'/2 intdiv_2 +ubif 'erl.lang.integer':'div'/2 ebif_intdiv_2 +ubif erlang:'rem'/2 +ubif 'erl.lang.integer':'rem'/2 ebif_rem_2 +ubif erlang:'bor'/2 +ubif 'erl.lang.integer':'bor'/2 ebif_bor_2 +ubif erlang:'band'/2 +ubif 'erl.lang.integer':'band'/2 ebif_band_2 +ubif erlang:'bxor'/2 +ubif 'erl.lang.integer':'bxor'/2 ebif_bxor_2 +ubif erlang:'bsl'/2 +ubif 'erl.lang.integer':'bsl'/2 ebif_bsl_2 +ubif erlang:'bsr'/2 +ubif 'erl.lang.integer':'bsr'/2 ebif_bsr_2 +ubif erlang:'bnot'/1 +ubif 'erl.lang.integer':'bnot'/1 ebif_bnot_1 +ubif erlang:'-'/1 sminus_1 +ubif 'erl.lang.number':minus/1 ebif_minus_1 sminus_1 +ubif erlang:'+'/1 splus_1 +ubif 'erl.lang.number':plus/1 ebif_plus_1 splus_1 + +# New operators in R8. These were the only operators missing. +# erlang:send/2, erlang:append/2 and erlang:subtract/2 are now also +# defined in erlang.erl, and the C names can be removed when all +# internal references have been updated to the new ebif_... entries. + +bif erlang:'!'/2 ebif_bang_2 +bif 'erl.lang.proc':send/2 ebif_send_2 send_2 +bif erlang:send/2 +bif 'erl.lang':send/3 ebif_send_3 send_3 +bif erlang:send/3 +bif erlang:'++'/2 ebif_plusplus_2 +bif 'erl.lang.list':append/2 ebif_append_2 ebif_plusplus_2 +bif erlang:append/2 +bif erlang:'--'/2 ebif_minusminus_2 +bif 'erl.lang.list':subtract/2 ebif_list_subtract_2 ebif_minusminus_2 +bif erlang:subtract/2 + +ubif erlang:is_atom/1 +ubif 'erl.lang.term':is_atom/1 ebif_is_atom_1 +ubif erlang:is_list/1 +ubif 'erl.lang.term':is_list/1 ebif_is_list_1 +ubif erlang:is_tuple/1 +ubif 'erl.lang.term':is_tuple/1 ebif_is_tuple_1 +ubif erlang:is_float/1 +ubif 'erl.lang.term':is_float/1 ebif_is_float_1 +ubif erlang:is_integer/1 +ubif 'erl.lang.term':is_integer/1 ebif_is_integer_1 +ubif erlang:is_number/1 +ubif 'erl.lang.term':is_number/1 ebif_is_number_1 +ubif erlang:is_pid/1 +ubif 'erl.lang.term':is_pid/1 ebif_is_pid_1 +ubif erlang:is_port/1 +ubif 'erl.lang.term':is_port/1 ebif_is_port_1 +ubif erlang:is_reference/1 +ubif 'erl.lang.term':is_reference/1 ebif_is_reference_1 +ubif erlang:is_binary/1 +ubif 'erl.lang.term':is_binary/1 ebif_is_binary_1 +ubif erlang:is_function/1 +ubif 'erl.lang.term':is_function/1 ebif_is_function_1 +ubif erlang:is_function/2 +ubif 'erl.lang.term':is_function/2 ebif_is_function_2 +ubif erlang:is_record/2 +ubif 'erl.lang.term':is_record/2 ebif_is_record_2 +ubif erlang:is_record/3 +ubif 'erl.lang.term':is_record/3 ebif_is_record_3 + +bif erlang:match_spec_test/3 + +# +# Bifs in ets module. +# + +bif ets:all/0 +bif 'erl.lang.ets':all/0 ebif_ets_all_0 +bif ets:new/2 +bif 'erl.lang.ets':new/2 ebif_ets_new_2 +bif ets:delete/1 +bif 'erl.lang.ets':delete/1 ebif_ets_delete_1 +bif ets:delete/2 +bif 'erl.lang.ets':delete/2 ebif_ets_delete_2 +bif ets:delete_all_objects/1 +bif 'erl.lang.ets':delete_all_objects/1 ebif_ets_delete_all_objects_1 +bif ets:delete_object/2 +bif 'erl.lang.ets':delete_object/2 ebif_ets_delete_object_2 +bif ets:first/1 +bif 'erl.lang.ets':first/1 ebif_ets_first_1 +bif ets:is_compiled_ms/1 +bif 'erl.lang.ets':is_compiled_ms/1 ebif_ets_is_compiled_ms_1 +bif ets:lookup/2 +bif 'erl.lang.ets':lookup/2 ebif_ets_lookup_2 +bif ets:lookup_element/3 +bif 'erl.lang.ets':lookup_element/3 ebif_ets_lookup_element_3 +bif ets:info/1 +bif 'erl.lang.ets':info/1 ebif_ets_info_1 +bif ets:info/2 +bif 'erl.lang.ets':info/2 ebif_ets_info_2 +bif ets:last/1 +bif 'erl.lang.ets':last/1 ebif_ets_last_1 +bif ets:match/1 +bif 'erl.lang.ets':match/1 ebif_ets_match_1 +bif ets:match/2 +bif 'erl.lang.ets':match/2 ebif_ets_match_2 +bif ets:match/3 +bif 'erl.lang.ets':match/3 ebif_ets_match_3 +bif ets:match_object/1 +bif 'erl.lang.ets':match_object/1 ebif_ets_match_object_1 +bif ets:match_object/2 +bif 'erl.lang.ets':match_object/2 ebif_ets_match_object_2 +bif ets:match_object/3 +bif 'erl.lang.ets':match_object/3 ebif_ets_match_object_3 +bif ets:member/2 +bif 'erl.lang.ets':is_key/2 ebif_ets_member_2 +bif ets:next/2 +bif 'erl.lang.ets':next/2 ebif_ets_next_2 +bif ets:prev/2 +bif 'erl.lang.ets':prev/2 ebif_ets_prev_2 +bif ets:insert/2 +bif 'erl.lang.ets':insert/2 ebif_ets_insert_2 +bif ets:insert_new/2 +bif 'erl.lang.ets':insert_new/2 ebif_ets_insert_new_2 +bif ets:rename/2 +bif 'erl.lang.ets':rename/2 ebif_ets_rename_2 +bif ets:safe_fixtable/2 +bif 'erl.lang.ets':fixtable/2 ebif_ets_safe_fixtable_2 +bif ets:slot/2 +bif 'erl.lang.ets':slot/2 ebif_ets_slot_2 +bif ets:update_counter/3 +bif 'erl.lang.ets':update_counter/3 ebif_ets_update_counter_3 +bif ets:select/1 +bif 'erl.lang.ets':select/1 ebif_ets_select_1 +bif ets:select/2 +bif 'erl.lang.ets':select/2 ebif_ets_select_2 +bif ets:select/3 +bif 'erl.lang.ets':select/3 ebif_ets_select_3 +bif ets:select_count/2 +bif 'erl.lang.ets':select/2 ebif_ets_select_count_2 +bif ets:select_reverse/1 +bif 'erl.lang.ets':select_reverse/1 ebif_ets_select_reverse_1 +bif ets:select_reverse/2 +bif 'erl.lang.ets':select_reverse/2 ebif_ets_select_reverse_2 +bif ets:select_reverse/3 +bif 'erl.lang.ets':select_reverse/3 ebif_ets_select_reverse_3 +bif ets:select_delete/2 +bif 'erl.lang.ets':select_delete/2 ebif_ets_select_delete_2 +bif ets:match_spec_compile/1 +bif 'erl.lang.ets':match_spec_compile/1 ebif_ets_match_spec_compile_1 +bif ets:match_spec_run_r/3 +bif 'erl.lang.ets':match_spec_run_r/3 ebif_ets_match_spec_run_r_3 + +# +# Bifs in os module. +# + +bif os:putenv/2 +bif 'erl.system.os':setenv/2 ebif_os_setenv_2 os_putenv_2 +bif os:getenv/0 +bif 'erl.system.os':getenv/0 ebif_os_getenv_0 +bif os:getenv/1 +bif 'erl.system.os':getenv/1 ebif_os_getenv_1 +bif os:getpid/0 +bif 'erl.system.os':pid/0 ebif_os_pid_0 os_getpid_0 +bif os:timestamp/0 +bif 'erl.system.os':timestamp/0 ebif_os_timestamp_0 os_timestamp_0 + +# +# Bifs in the erl_ddll module (the module actually does not exist) +# + +bif erl_ddll:try_load/3 +bif erl_ddll:try_unload/2 +bif erl_ddll:loaded_drivers/0 +bif erl_ddll:info/2 +bif erl_ddll:format_error_int/1 +bif erl_ddll:monitor/2 +bif erl_ddll:demonitor/1 + +# +# Bifs in the re module +# +bif re:compile/1 +bif re:compile/2 +bif re:run/2 +bif re:run/3 + +# +# Bifs in lists module. +# + +bif lists:member/2 +bif 'erl.lang.list':is_element/2 ebif_list_is_element_2 lists_member_2 +bif lists:reverse/2 +bif 'erl.lang.list':reverse/2 ebif_list_reverse_2 lists_reverse_2 +bif lists:keymember/3 +bif 'erl.lang.list.keylist':is_element/3 ebif_keylist_is_element_3 lists_keymember_3 +bif lists:keysearch/3 +bif 'erl.lang.list.keylist':search/3 ebif_keylist_search_3 lists_keysearch_3 +bif lists:keyfind/3 + +# +# Bifs for debugging. +# + +bif erts_debug:disassemble/1 +bif 'erl.system.debug':disassemble/1 ebif_erts_debug_disassemble_1 +bif erts_debug:breakpoint/2 +bif 'erl.system.debug':breakpoint/2 ebif_erts_debug_breakpoint_2 +bif erts_debug:same/2 +bif 'erl.system.debug':same/2 ebif_erts_debug_same_2 +bif erts_debug:flat_size/1 +bif 'erl.system.debug':flat_size/1 ebif_erts_debug_flat_size_1 +bif erts_debug:get_internal_state/1 +bif 'erl.system.debug':get_internal_state/1 ebif_erts_debug_get_internal_state_1 +bif erts_debug:set_internal_state/2 +bif 'erl.system.debug':set_internal_state/2 ebif_erts_debug_set_internal_state_2 +bif erts_debug:display/1 +bif 'erl.system.debug':display/1 ebif_erts_debug_display_1 +bif erts_debug:dist_ext_to_term/2 +bif 'erl.system.debug':dist_ext_to_term/2 ebif_erts_debug_dist_ext_to_term_2 + +# +# Monitor testing bif's... +# +bif erts_debug:dump_monitors/1 +bif erts_debug:dump_links/1 + + +# +# Lock counter bif's +# +bif erts_debug:lock_counters/1 + +# +# New Bifs in R8. +# + +bif code:get_chunk/2 +bif 'erl.system.code':get_chunk/2 ebif_code_get_chunk_2 +bif code:module_md5/1 +bif 'erl.system.code':module_md5/1 ebif_code_module_md5_1 +bif code:make_stub_module/3 +bif 'erl.system.code':make_stub_module/3 ebif_code_make_stub_module_3 +bif code:is_module_native/1 +bif 'erl.system.code':is_native/1 ebif_code_is_native_1 code_is_module_native_1 + +bif erlang:blocking_read_file/1 + +# +# New Bifs in R9C. +# + +bif erlang:hibernate/3 +bif error_logger:warning_map/0 + +# +# New Bifs in R10B. +# +bif erlang:get_module_info/1 +bif erlang:get_module_info/2 +ubif erlang:is_boolean/1 +bif string:to_integer/1 +bif string:to_float/1 +bif erlang:make_fun/3 +bif erlang:iolist_size/1 +bif erlang:iolist_to_binary/1 +bif erlang:list_to_existing_atom/1 + +# +# New Bifs in R12B-0 +# +ubif erlang:is_bitstring/1 +ubif erlang:tuple_size/1 +ubif erlang:byte_size/1 +ubif erlang:bit_size/1 +bif erlang:list_to_bitstring/1 +bif erlang:bitstring_to_list/1 + +# +# New Bifs in R12B-2 +# +bif ets:update_element/3 + +# +# New Bifs in R12B-4 +# +bif erlang:decode_packet/3 + +# +# New Bifs in R12B-5 +# +bif unicode:characters_to_binary/2 +bif unicode:characters_to_list/2 +bif unicode:bin_is_7bit/1 +# +# New Bifs in R13A. +# +bif erlang:atom_to_binary/2 +bif erlang:binary_to_atom/2 +bif erlang:binary_to_existing_atom/2 +bif net_kernel:dflag_unicode_io/1 +# +# New Bifs in R13B-1 +# +bif ets:give_away/3 +bif ets:setopts/2 + +# +# New Bifs in R13B3 +# +bif erlang:load_nif/2 +bif erlang:call_on_load_function/1 +bif erlang:finish_after_on_load/2 + +# +# Obsolete +# + +bif erlang:hash/2 diff --git a/erts/emulator/beam/big.c b/erts/emulator/beam/big.c new file mode 100644 index 0000000000..03c88da8c6 --- /dev/null +++ b/erts/emulator/beam/big.c @@ -0,0 +1,2241 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "big.h" +#include "error.h" +#include "bif.h" + +#define ZERO_DIGITS(v, sz) do { \ + dsize_t _t_sz = sz; \ + ErtsDigit* _t_v = v; \ + while(_t_sz--) *_t_v++ = 0; \ + } while(0) + +#define MOVE_DIGITS(dst, src, sz) do { \ + dsize_t _t_sz = sz; \ + ErtsDigit* _t_dst; \ + ErtsDigit* _t_src; \ + if (dst < src) { \ + _t_dst = dst; \ + _t_src = src; \ + while(_t_sz--) *_t_dst++ = *_t_src++; \ + } \ + else if (dst > src) { \ + _t_dst = (dst)+((sz)-1); \ + _t_src = (src)+((sz)-1); \ + while(_t_sz--) *_t_dst-- = *_t_src--; \ + } \ + } while(0) + +/* add a and b with carry in + out */ +#define DSUMc(a,b,c,s) do { \ + ErtsDigit ___cr = (c); \ + ErtsDigit ___xr = (a)+(___cr); \ + ErtsDigit ___yr = (b); \ + ___cr = (___xr < ___cr); \ + ___xr = ___yr + ___xr; \ + ___cr += (___xr < ___yr); \ + s = ___xr; \ + c = ___cr; \ + } while(0) + +/* add a and b with carry out */ +#define DSUM(a,b,c,s) do { \ + ErtsDigit ___xr = (a); \ + ErtsDigit ___yr = (b); \ + ___xr = ___yr + ___xr; \ + s = ___xr; \ + c = (___xr < ___yr); \ + } while(0) + +#define DSUBb(a,b,r,d) do { \ + ErtsDigit ___cr = (r); \ + ErtsDigit ___xr = (a); \ + ErtsDigit ___yr = (b)+___cr; \ + ___cr = (___yr < ___cr); \ + ___yr = ___xr - ___yr; \ + ___cr += (___yr > ___xr); \ + d = ___yr; \ + r = ___cr; \ + } while(0) + +#define DSUB(a,b,r,d) do { \ + ErtsDigit ___xr = (a); \ + ErtsDigit ___yr = (b); \ + ___yr = ___xr - ___yr; \ + r = (___yr > ___xr); \ + d = ___yr; \ + } while(0) + +/* type a constant as a ErtsDigit - to get shifts correct */ +#define DCONST(n) ((ErtsDigit)(n)) + +/* + * BIG_HAVE_DOUBLE_DIGIT is defined if we have defined + * the type ErtsDoubleDigit which MUST have + * sizeof(ErtsDoubleDigit) >= sizeof(ErtsDigit) + */ +#ifdef BIG_HAVE_DOUBLE_DIGIT + +/* ErtsDoubleDigit => ErtsDigit */ +#define DLOW(x) ((ErtsDigit)(x)) +#define DHIGH(x) ((ErtsDigit)(((ErtsDoubleDigit)(x)) >> D_EXP)) + +/* ErtsDigit => ErtsDoubleDigit */ +#define DLOW2HIGH(x) (((ErtsDoubleDigit)(x)) << D_EXP) +#define DDIGIT(a1,a0) (DLOW2HIGH(a1) + (a0)) + +#define DMULc(a,b,c,p) do { \ + ErtsDoubleDigit _t = ((ErtsDoubleDigit)(a))*(b) + (c); \ + p = DLOW(_t); \ + c = DHIGH(_t); \ + } while(0) +#define DMUL(a,b,c1,c0) do { \ + ErtsDoubleDigit _t = ((ErtsDoubleDigit)(a))*(b); \ + c0 = DLOW(_t); \ + c1 = DHIGH(_t); \ + } while(0) + +#define DDIV(a1,a0,b,q) do { \ + ErtsDoubleDigit _t = DDIGIT((a1),(a0)); \ + q = _t / (b); \ + } while(0) + +#define DDIV2(a1,a0,b1,b0,q) do { \ + ErtsDoubleDigit _t = DDIGIT((a1),(a0)); \ + q = _t / DDIGIT((b1),(b0)); \ + } while(0) + +#define DREM(a1,a0,b,r) do { \ + ErtsDoubleDigit _t = DDIGIT((a1),(a0)); \ + r = _t % (b); \ + } while(0) + +#else + +/* If we do not have double digit then we have some more work to do */ +#define H_EXP (D_EXP >> 1) +#define LO_MASK ((ErtsDigit)((DCONST(1) << H_EXP)-1)) +#define HI_MASK ((ErtsDigit)(LO_MASK << H_EXP)) + +#define DGT(a,b) ((a)>(b)) +#define DEQ(a,b) ((a)==(b)) + +#define D2GT(a1,a0,b1,b0) (DGT(a1,b1) || (((a1)==(b1)) && DGT(a0,b0))) +#define D2EQ(a1,a0,b1,b0) (DEQ(a1,b1) && DEQ(a0,b0)) +#define D2LT(a1,a0,b1,b0) D2GT(b1,b0,a1,a0) +#define D2GTE(a1,a0,b1,b0) (!D2LT(a1,a0,b1,b0)) +#define D2LTE(a1,a0,b1,b0) (!D2GT(a1,a0,b1,b0)) + +// Add (A+B), A=(a1B+a0) B=(b1B+b0) +#define D2ADD(a1,a0,b1,b0,c1,c0) do { \ + ErtsDigit __ci = 0; \ + DSUM(a0,b0,__ci,c0); \ + DSUMc(a1,b1,__ci,c1); \ + } while(0) + +// Subtract (A-B), A=(a1B+a0), B=(b1B+b0) (A>=B) +#define D2SUB(a1,a0,b1,b0,c1,c0) do { \ + ErtsDigit __bi; \ + DSUB(a0,b0,__bi,c0); \ + DSUBb(a1,b1,__bi,c1); \ + } while(0) + + +/* Left shift (multiply by 2) (A <<= 1 where A=a1*B+a0) */ +#define D2LSHIFT1(a1,a0) do { \ + a1 = ((a0) >> (D_EXP-1)) | ((a1)<<1); \ + a0 = (a0) << 1; \ + } while(0) + +/* Right shift (divide by 2) (A >>= 1 where A=a1*B+a0) */ +#define D2RSHIFT1(a1,a0) do { \ + a0 = (((a1) & 1) << (D_EXP-1)) | ((a0)>>1); \ + a1 = ((a1) >> 1); \ + } while(0) + +/* Calculate a*b + d1 and store double prec result in d1, d0 */ +#define DMULc(a,b,d1,d0) do { \ + ErtsHalfDigit __a0 = (a); \ + ErtsHalfDigit __a1 = ((a) >> H_EXP); \ + ErtsHalfDigit __b0 = (b); \ + ErtsHalfDigit __b1 = ((b) >> H_EXP); \ + ErtsDigit __a0b0 = (ErtsDigit)__a0*__b0; \ + ErtsDigit __a0b1 = (ErtsDigit)__a0*__b1; \ + ErtsDigit __a1b0 = (ErtsDigit)__a1*__b0; \ + ErtsDigit __a1b1 = (ErtsDigit)__a1*__b1; \ + ErtsDigit __p0,__p1,__p2,__c0; \ + DSUM(__a0b0,d1,__c0,__p0); \ + DSUM((__c0<>H_EXP),__p2,__p1); \ + DSUM(__p1,__a0b1,__c0,__p1); \ + __p2 += __c0; \ + DSUM(__p1,__a1b0,__c0,__p1); \ + __p2 += __c0; \ + DSUM(__p1,__a1b1<> H_EXP); \ + d0 = (__p1 << H_EXP) | (__p0 & LO_MASK); \ + } while(0) + +#define DMUL(a,b,d1,d0) do { \ + ErtsDigit _ds = 0; \ + DMULc(a,b,_ds,d0); \ + d1 = _ds; \ + } while(0) + +/* Calculate a*(Bb1 + b0) + d2 = a*b1B + a*b0 + d2 */ +#define D2MULc(a,b1,b0,d2,d1,d0) do { \ + DMULc(a, b0, d2, d0); \ + DMULc(a, b1, d2, d1); \ + } while(0) + +/* Calculate s in a = 2^s*a1 */ +/* NOTE since D2PF is used by other macros variables is prefixed bt __ */ +#if D_EXP == 64 +#define D2PF(a, s) do { \ + ErtsDigit __x = (a); \ + int __s = 0; \ + if (__x <= 0x00000000FFFFFFFF) { __s += 32; __x <<= 32; } \ + if (__x <= 0x0000FFFFFFFFFFFF) { __s += 16; __x <<= 16; } \ + if (__x <= 0x00FFFFFFFFFFFFFF) { __s += 8; __x <<= 8; } \ + if (__x <= 0x0FFFFFFFFFFFFFFF) { __s += 4; __x <<= 4; } \ + if (__x <= 0x3FFFFFFFFFFFFFFF) { __s += 2; __x <<= 2; } \ + if (__x <= 0x7FFFFFFFFFFFFFFF) { __s += 1; } \ + s = __s; \ + } while(0) +#elif D_EXP == 32 +#define D2PF(a, s) do { \ + ErtsDigit __x = (a); \ + int __s = 0; \ + if (__x <= 0x0000FFFF) { __s += 16; __x <<= 16; } \ + if (__x <= 0x00FFFFFF) { __s += 8; __x <<= 8; } \ + if (__x <= 0x0FFFFFFF) { __s += 4; __x <<= 4; } \ + if (__x <= 0x3FFFFFFF) { __s += 2; __x <<= 2; } \ + if (__x <= 0x7FFFFFFF) { __s += 1; } \ + s = __s; \ + } while(0) +#elif D_EXP == 16 +#define D2PF(a, s) do { \ + ErtsDigit __x = (a); \ + int __s = 0; \ + if (__x <= 0x00FF) { __s += 8; __x <<= 8; } \ + if (__x <= 0x0FFF) { __s += 4; __x <<= 4; } \ + if (__x <= 0x3FFF) { __s += 2; __x <<= 2; } \ + if (__x <= 0x7FFF) { __s += 1; } \ + s = __s; \ + } while(0) +#elif D_EXP == 8 +#define D2PF(a, s) do { \ + ErtsDigit __x = (a); \ + int __s = 0; \ + if (__x <= 0x0F) { __s += 4; __x <<= 4; } \ + if (__x <= 0x3F) { __s += 2; __x <<= 2; } \ + if (__x <= 0x7F) { __s += 1; } \ + s = _s; \ + } while(0) +#endif + +/* Calculate q = (a1B + a0) / b, assume a1 < b */ +#define DDIVREM(a1,a0,b,q,r) do { \ + ErtsDigit _a1 = (a1); \ + ErtsDigit _a0 = (a0); \ + ErtsDigit _b = (b); \ + ErtsHalfDigit _un1, _un0; \ + ErtsHalfDigit _vn1, _vn0; \ + ErtsDigit _q1, _q0; \ + ErtsDigit _un32, _un21, _un10; \ + ErtsDigit _rh; \ + Sint _s; \ + D2PF(_b, _s); \ + _b = _b << _s; \ + _vn1 = _b >> H_EXP; \ + _vn0 = _b & LO_MASK; \ + _un32 = (_a1 << _s) | ((_a0>>(D_EXP-_s)) & (-_s >> (D_EXP-1))); \ + _un10 = _a0 << _s; \ + _un1 = _un10 >> H_EXP; \ + _un0 = _un10 & LO_MASK; \ + _q1 = _un32/_vn1; \ + _rh = _un32 - _q1*_vn1; \ + while ((_q1 >= (DCONST(1)< (_rh<= (DCONST(1)<= (DCONST(1)< ((_rh<= (DCONST(1)<> _s; \ + q = (_q1<= B */ +#if (SIZEOF_VOID_P == 8) +#define QUOT_LIM 0x7FFFFFFFFFFFFFFF +#else +#define QUOT_LIM 0x7FFFFFFF +#endif + +#define D2DIVREM(a1,a0,b1,b0,q0,r1,r0) do { \ + ErtsDigit _a1 = (a1); \ + ErtsDigit _a0 = (a0); \ + ErtsDigit _b1 = (b1); \ + ErtsDigit _b0 = (b0); \ + ErtsDigit _q = 0; \ + int _as = 1; \ + while(D2GTE(_a1,_a0,_b1,_b0)) { \ + ErtsDigit _q1; \ + ErtsDigit _t2=0, _t1, _t0; \ + if ((_b1 == 1) && (_a1 > 1)) \ + _q1 = _a1 / 2; \ + else if ((_a1 > QUOT_LIM) && (_b1 < _a1)) \ + _q1 = _a1/(_b1+1); \ + else \ + _q1 = _a1/_b1; \ + if (_as<0) \ + _q -= _q1; \ + else \ + _q += _q1; \ + D2MULc(_q1, _b1, _b0, _t2, _t1, _t0); \ + ASSERT(_t2 == 0); \ + if (D2GT(_t1,_t0,_a1,_a0)) { \ + D2SUB(_t1,_t0,_a1,_a0,_a1,_a0); \ + _as = -_as; \ + } \ + else { \ + D2SUB(_a1,_a0,_t1,_t0,_a1,_a0); \ + } \ + } \ + if (_as < 0) { \ + _q--; \ + D2SUB(_b1,_b0,_a1,_a0,_a1,_a0); \ + } \ + q0 = _q; \ + r1 = _a1; \ + r0 = _a0; \ + } while(0) + + +/* Calculate q, r A = Bq+R when assume B>0 */ +#define D2DIVREM_0(a1,a0,b1,b0,q1,q0,r1,r0) do { \ + ErtsDigit _a1 = (a1); \ + ErtsDigit _a0 = (a0); \ + ErtsDigit _b1 = (b1); \ + ErtsDigit _b0 = (b0); \ + if (D2EQ(_a1,_a0,0,0)) { \ + q1 = q0 = 0; \ + r1 = r0 = 0; \ + } \ + else { \ + ErtsDigit _res1 = 0; \ + ErtsDigit _res0 = 0; \ + ErtsDigit _d1 = 0; \ + ErtsDigit _d0 = 1; \ + ErtsDigit _e1 = (1 << (D_EXP-1)); \ + ErtsDigit _e0 = 0; \ + while(_e1 && !(_a1 & _e1)) \ + _e1 >>= 1; \ + if (_e1 == 0) { \ + _e0 = (1 << (D_EXP-1)); \ + while(_e0 && !(_a0 & _e0)) \ + _e0 >>= 1; \ + } \ + if (D2GT(_b1,_b0,0,0)) { \ + while(D2GT(_e1,_e0,_b1,_b0)) { \ + D2LSHIFT1(_b1,_b0); \ + D2LSHIFT1(_d1,_d0); \ + } \ + } \ + do { \ + if (!D2GT(_b1,_b0,_a1,_a0)) { \ + D2SUB(_a1,_a0, _b1, _b0, _a1, _a0); \ + D2ADD(_d1,_d0, _res1,_res0, _res1, _res0); \ + } \ + D2RSHIFT1(_b1,_b0); \ + D2RSHIFT1(_d1,_d0); \ + } while (!D2EQ(_d1,_d0,0,0)); \ + r1 = _a1; \ + r0 = _a0; \ + q1 = _res1; \ + q0 = _res0; \ + } \ + } while(0) + +#define DDIV2(a1,a0,b1,b0,q) do { \ + ErtsDigit _tmp_r1; \ + ErtsDigit _tmp_r0; \ + D2DIVREM(a1,a0,b1,b0,q,_tmp_r1,_tmp_r0); \ + } while(0) + +#endif + +/* +** compare two number vectors +*/ +static int I_comp(ErtsDigit* x, dsize_t xl, ErtsDigit* y, dsize_t yl) +{ + if (xl < yl) + return -1; + else if (xl > yl) + return 1; + else { + if (x == y) + return 0; + x += (xl-1); + y += (yl-1); + while((xl > 0) && (*x == *y)) { + x--; + y--; + xl--; + } + if (xl == 0) + return 0; + return (*x < *y) ? -1 : 1; + } +} + +/* +** Add digits in x and y and store them in r +** assumption: (xl >= yl) +*/ +static dsize_t I_add(ErtsDigit* x, dsize_t xl, ErtsDigit* y, dsize_t yl, ErtsDigit* r) +{ + dsize_t sz = xl; + register ErtsDigit yr, xr; + register ErtsDigit c = 0; + + ASSERT(xl >= yl); + + xl -= yl; + do { + xr = *x++ + c; + yr = *y++; + c = (xr < c); + xr = yr + xr; + c += (xr < yr); + *r++ = xr; + } while(--yl); + + while(xl--) { + xr = *x++ + c; + c = (xr < c); + *r++ = xr; + } + if (c) { + *r = 1; + return sz+1; + } + return sz; +} +/* +** Add a digits in v1 and store result in vr +*/ +static dsize_t D_add(ErtsDigit* x, dsize_t xl, ErtsDigit c, ErtsDigit* r) +{ + dsize_t sz = xl; + register ErtsDigit xr; + + while(xl--) { + xr = *x++ + c; + c = (xr < c); + *r++ = xr; + } + if (c) { + *r = 1; + return sz+1; + } + return sz; +} + +/* +** Subtract digits v2 from v1 and store result in v3 +** Assert I_comp(x, xl, y, yl) >= 0 +** +*/ +static dsize_t I_sub(ErtsDigit* x, dsize_t xl, ErtsDigit* y, dsize_t yl, ErtsDigit* r) +{ + ErtsDigit* r0 = r; + register ErtsDigit yr, xr; + register ErtsDigit c = 0; + + ASSERT(I_comp(x, xl, y, yl) >= 0); + + xl -= yl; + do { + yr = *y++ + c; + xr = *x++; + c = (yr < c); + yr = xr - yr; + c += (yr > xr); + *r++ = yr; + } while(--yl); + + while(xl--) { + xr = *x++; + yr = xr - c; + c = (yr > xr); + *r++ = yr; + } + do { + r--; + } while(*r == 0 && r != r0); + + return (r - r0) + 1; +} + +/* +** Subtract digit d from v1 and store result in vr +*/ +static dsize_t D_sub(ErtsDigit* x, dsize_t xl, ErtsDigit c, ErtsDigit* r) +{ + ErtsDigit* r0 = r; + register ErtsDigit yr, xr; + + ASSERT(I_comp(x, xl, x, 1) >= 0); + + while(xl--) { + xr = *x++; + yr = xr - c; + c = (yr > xr); + *r++ = yr; + } + do { + r--; + } while(*r == 0 && r != r0); + + return (r - r0) + 1; +} + +/* +** subtract Z000...0 - y and store result in r, return new size +*/ +static dsize_t Z_sub(ErtsDigit* y, dsize_t yl, ErtsDigit* r) +{ + ErtsDigit* r0 = r; + register ErtsDigit yr; + register ErtsDigit c = 0; + + while(yl--) { + yr = *y++ + c; + c = (yr < c); + yr = 0 - yr; + c += (yr > 0); + *r++ = yr; + } + do { + r--; + } while(*r == 0 && r != r0); + return (r - r0) + 1; +} + +/* +** Multiply digits in x with digits in y and store in r +** Assumption: digits in r must be 0 (upto the size of x) +*/ +static dsize_t I_mul(ErtsDigit* x, dsize_t xl, ErtsDigit* y, dsize_t yl, ErtsDigit* r) +{ + ErtsDigit* r0 = r; + ErtsDigit* rt = r; + + while(xl--) { + ErtsDigit cp = 0; + ErtsDigit c = 0; + dsize_t n = yl; + ErtsDigit* yt = y; + ErtsDigit d; + ErtsDigit p; + + d = *x; + x++; + rt = r; + + switch(d) { + case 0: + rt = rt + n; + break; + case 1: + while(n--) { + DSUMc(*yt, *rt, c, p); + *rt++ = p; + yt++; + } + break; + case 2: + while(n--) { + p = *yt; + DSUMc(p, p, cp, p); + DSUMc(p, *rt, c, p); + *rt++ = p; + yt++; + } + break; + default: + while(n--) { + DMULc(d,*yt, cp, p); + DSUMc(p,*rt, c, p); + *rt++ = p; + yt++; + } + break; + } + *rt = c + cp; + r++; + } + if (*rt == 0) + return (rt - r0); + else + return (rt - r0) + 1; +} + +/* +** Square digits in x store in r (x & r may point into a common area) +** Assumption: x is destroyed if common area and digits in r are zero +** to the size of xl+1 +*/ + +static dsize_t I_sqr(ErtsDigit* x, dsize_t xl, ErtsDigit* r) +{ + ErtsDigit d_next = *x; + ErtsDigit d; + ErtsDigit* r0 = r; + ErtsDigit* s = r; + + if ((r + xl) == x) /* "Inline" operation */ + *x = 0; + x++; + + while(xl--) { + ErtsDigit* y = x; + ErtsDigit y_0 = 0, y_1 = 0, y_2 = 0, y_3 = 0; + ErtsDigit b0, b1; + ErtsDigit z0, z1, z2; + ErtsDigit t; + dsize_t y_l = xl; + + s = r; + d = d_next; + d_next = *x; + x++; + + DMUL(d, d, b1, b0); + DSUMc(*s, b0, y_3, t); + *s++ = t; + z1 = b1; + while(y_l--) { + DMUL(d, *y, b1, b0); + y++; + DSUMc(b0, b0, y_0, z0); + DSUMc(z0, z1, y_2, z2); + DSUMc(*s, z2, y_3, t); + *s++ = t; + DSUMc(b1, b1, y_1, z1); + } + z0 = y_0; + DSUMc(z0, z1, y_2, z2); + DSUMc(*s, z2, y_3, t); + *s = t; + if (xl != 0) { + s++; + t = (y_1+y_2+y_3); + *s = t; + r += 2; + } + else { + ASSERT((y_1+y_2+y_3) == 0); + } + } + if (*s == 0) + return (s - r0); + else + return (s - r0) + 1; +} + + +/* +** Multiply digits d with digits in x and store in r +*/ +static dsize_t D_mul(ErtsDigit* x, dsize_t xl, ErtsDigit d, ErtsDigit* r) +{ + ErtsDigit c = 0; + dsize_t rl = xl; + ErtsDigit p; + + switch(d) { + case 0: + ZERO_DIGITS(r, 1); + return 1; + case 1: + if (x != r) + MOVE_DIGITS(r, x, xl); + return xl; + case 2: + while(xl--) { + p = *x; + DSUMc(p, p, c, p); + *r++ = p; + x++; + } + break; + default: + while(xl--) { + DMULc(d, *x, c, p); + *r++ = p; + x++; + } + break; + } + if (c == 0) + return rl; + *r = c; + return rl+1; +} + +/* +** Multiply and subtract +** calculate r(i) = x(i) - d*y(i) +** assumption: xl = yl || xl == yl+1 +** +** Return size of r +** 0 means borrow +*/ +static dsize_t D_mulsub(ErtsDigit* x, dsize_t xl, ErtsDigit d, + ErtsDigit* y, dsize_t yl, ErtsDigit* r) +{ + ErtsDigit c = 0; + ErtsDigit b = 0; + ErtsDigit c0; + ErtsDigit* r0 = r; + ErtsDigit s; + + ASSERT(xl == yl || xl == yl+1); + + xl -= yl; + while(yl--) { + DMULc(d, *y, c, c0); + DSUBb(*x, c0, b, s); + *r++ = s; + x++; + y++; + } + if (xl == 0) { + if (c != 0 || b != 0) + return 0; + } + else { /* xl == 1 */ + DSUBb(*x, c, b, s); + *r++ = s; + } + if (b != 0) return 0; + + do { + r--; + } while(*r == 0 && r != r0); + return (r - r0) + 1; +} + +/* +** Divide digits in x with a digit, +** quotient is returned in q and remainder digit in r +** x and q may be equal +*/ +static dsize_t D_div(ErtsDigit* x, dsize_t xl, ErtsDigit d, ErtsDigit* q, ErtsDigit* r) +{ + ErtsDigit* xp = x + (xl-1); + ErtsDigit* qp = q + (xl-1); + dsize_t qsz = xl; + ErtsDigit a1; + + a1 = *xp; + xp--; + + if (d > a1) { + if (xl == 1) { + *r = a1; + *qp = 0; + return 1; + } + qsz--; + qp--; + } + + do { + ErtsDigit q0, a0, b1, b0, b; + + if (d > a1) { + a0 = *xp; + xp--; + } + else { + a0 = a1; a1 = 0; + } + DDIV(a1, a0, d, q0); + DMUL(d, q0, b1, b0); + DSUB(a0,b0, b, a1); + *qp = q0; + qp--; + } while (xp >= x); + + *r = a1; + return qsz; +} + +/* +** Divide digits in x with digits in y and return qutient in q +** and remainder in r +** assume that integer(x) > integer(y) +** Return remainder in x (length int rl) +** Return quotient size +*/ + +static dsize_t I_div(ErtsDigit* x, dsize_t xl, ErtsDigit* y, dsize_t yl, + ErtsDigit* q, ErtsDigit* r, dsize_t* rlp) +{ + ErtsDigit* rp; + ErtsDigit* qp; + ErtsDigit b1 = y[yl-1]; + ErtsDigit b2 = y[yl-2]; + ErtsDigit a1; + ErtsDigit a2; + int r_signed = 0; + dsize_t ql; + dsize_t rl; + + if (x != r) + MOVE_DIGITS(r, x, xl); + rp = r + (xl-yl); + rl = xl; + + ZERO_DIGITS(q, xl-yl+1); + qp = q + (xl-yl); + ql = 0; + + /* Adjust length */ + a1 = rp[yl-1]; + a2 = rp[yl-2]; + if (b1 < a1 || (b1 == a1 && b2 <= a2)) + ql = 1; + + do { + ErtsDigit q0; + dsize_t nsz = yl; + dsize_t nnsz; + + a1 = rp[yl-1]; + a2 = rp[yl-2]; + + if (b1 < a1) + DDIV2(a1,a2,b1,b2,q0); + else if (b1 > a1) { + DDIV(a1,a2,b1,q0); + nsz++; + rp--; + qp--; + ql++; + } + else { /* (b1 == a1) */ + if (b2 <= a2) + q0 = 1; + else { + q0 = D_MASK; + nsz++; + rp--; + qp--; + ql++; + } + } + + if (r_signed) + ql = D_sub(qp, ql, q0, qp); + else + ql = D_add(qp, ql, q0, qp); + + if ((nnsz = D_mulsub(rp, nsz, q0, y, yl, rp)) == 0) { + nnsz = Z_sub(r, rl, r); + if (nsz > (rl-nnsz)) + nnsz = nsz - (rl-nnsz); + else + nnsz = 1; + r_signed = !r_signed; + } + + if ((nnsz == 1) && (*rp == 0)) + nnsz = 0; + rp = rp - (yl-nnsz); + rl -= (nsz-nnsz); + qp = qp - (yl-nnsz); + ql += (yl-nnsz); + } while (I_comp(r, rl, y, yl) >= 0); + + ql -= (q - qp); + qp = q; + + if (rl == 0) + rl = 1; + + while(rl > 1 && r[rl-1] == 0) /* Remove "trailing zeroes" */ + --rl; + + if (r_signed && (rl > 1 || *r != 0)) { + rl = I_sub(y, yl, r, rl, r); + ql = D_sub(qp, ql, 1, qp); + } + + *rlp = rl; + return ql; +} + +/* +** Remainder of digits in x and a digit d +*/ +static ErtsDigit D_rem(ErtsDigit* x, dsize_t xl, ErtsDigit d) +{ + ErtsDigit rem = 0; + + x += (xl-1); + do { + if (rem != 0) + DREM(rem, *x, d, rem); + else + DREM(0, *x, d, rem); + x--; + xl--; + } while(xl > 0); + return rem; +} + +/* +** Remainder of x and y +** +** Assumtions: xl >= yl, yl > 1 +** r must contain at least xl number of digits +*/ +static dsize_t I_rem(ErtsDigit* x, dsize_t xl, ErtsDigit* y, dsize_t yl, ErtsDigit* r) +{ + ErtsDigit* rp; + ErtsDigit b1 = y[yl-1]; + ErtsDigit b2 = y[yl-2]; + ErtsDigit a1; + ErtsDigit a2; + int r_signed = 0; + dsize_t rl; + + if (x != r) + MOVE_DIGITS(r, x, xl); + rp = r + (xl-yl); + rl = xl; + + do { + ErtsDigit q0; + dsize_t nsz = yl; + dsize_t nnsz; + + a1 = rp[yl-1]; + a2 = rp[yl-2]; + + if (b1 < a1) + DDIV2(a1,a2,b1,b2,q0); + else if (b1 > a1) { + DDIV(a1,a2,b1,q0); + nsz++; + rp--; + } + else { /* (b1 == a1) */ + if (b2 <= a2) + q0 = 1; + else { + q0 = D_MASK; + nsz++; + rp--; + } + } + + if ((nnsz = D_mulsub(rp, nsz, q0, y, yl, rp)) == 0) { + nnsz = Z_sub(r, rl, r); + if (nsz > (rl-nnsz)) + nnsz = nsz - (rl-nnsz); + else + nnsz = 1; + r_signed = !r_signed; + } + + if (nnsz == 1 && *rp == 0) + nnsz = 0; + + rp = rp - (yl-nnsz); + rl -= (nsz-nnsz); + } while (I_comp(r, rl, y, yl) >= 0); + + if (rl == 0) + rl = 1; + + while(rl > 1 && r[rl-1] == 0) /* Remove "trailing zeroes" */ + --rl; + + if (r_signed && (rl > 1 || *r != 0)) + rl = I_sub(y, yl, r, rl, r); + return rl; +} + +/* +** Remove trailing digits from bitwise operations +*/ +static dsize_t I_btrail(ErtsDigit* r0, ErtsDigit* r, short sign) +{ + /* convert negative numbers to one complement */ + if (sign) { + dsize_t rl; + ErtsDigit d; + + /* 1 remove all 0xffff words */ + do { + r--; + } while(((d = *r) == D_MASK) && (r != r0)); + + /* 2 complement high digit */ + if (d == D_MASK) + *r = 0; + else { + ErtsDigit prev_mask = 0; + ErtsDigit mask = (DCONST(1) << (D_EXP-1)); + + while((d & mask) == mask) { + prev_mask = mask; + mask = (prev_mask >> 1) | (DCONST(1)<<(D_EXP-1)); + } + *r = ~d & ~prev_mask; + } + rl = (r - r0) + 1; + while(r != r0) { + r--; + *r = ~*r; + } + return D_add(r0, rl, 1, r0); + } + + do { + r--; + } while(*r == 0 && r != r0); + return (r - r0) + 1; +} + +/* +** Bitwise and +*/ +static dsize_t I_band(ErtsDigit* x, dsize_t xl, short xsgn, + ErtsDigit* y, dsize_t yl, short ysgn, ErtsDigit* r) +{ + ErtsDigit* r0 = r; + short sign = xsgn && ysgn; + + ASSERT(xl >= yl); + + xl -= yl; + + if (!xsgn) { + if (!ysgn) { + while(yl--) + *r++ = *x++ & *y++; + } + else { + ErtsDigit b; + ErtsDigit c; + + DSUB(*y,1,b,c); + *r++ = *x++ & ~c; + y++; + yl--; + while(yl--) { + DSUBb(*y,0,b,c); + *r++ = *x++ & ~c; + y++; + } + while (xl--) { + *r++ = *x++; + } + } + } + else { + if (!ysgn) { + ErtsDigit b; + ErtsDigit c; + + DSUB(*x,1,b,c); + *r = ~c & *y; + x++; y++; r++; + yl--; + while(yl--) { + DSUBb(*x,0,b,c); + *r++ = ~c & *y++; + x++; + } + } + else { + ErtsDigit b1, b2; + ErtsDigit c1, c2; + + DSUB(*x,1,b1,c1); + DSUB(*y,1,b2,c2); + *r++ = ~c1 & ~c2; + x++; y++; + yl--; + while(yl--) { + DSUBb(*x,0,b1,c1); + DSUBb(*y,0,b2,c2); + *r++ = ~c1 & ~c2; + x++; y++; + } + while(xl--) + *r++ = ~*x++; + } + } + return I_btrail(r0, r, sign); +} + +/* + * Bitwise 'or'. + */ +static dsize_t +I_bor(ErtsDigit* x, dsize_t xl, short xsgn, ErtsDigit* y, + dsize_t yl, short ysgn, ErtsDigit* r) +{ + ErtsDigit* r0 = r; + short sign = xsgn || ysgn; + + ASSERT(xl >= yl); + + xl -= yl; + + if (!xsgn) { + if (!ysgn) { + while(yl--) + *r++ = *x++ | *y++; + while(xl--) + *r++ = *x++; + } + else { + ErtsDigit b; + ErtsDigit c; + + DSUB(*y,1,b,c); + *r++ = *x++ | ~c; + y++; + yl--; + while(yl--) { + DSUBb(*y,0,b,c); + *r++ = *x++ | ~c; + y++; + } + } + } + else { + if (!ysgn) { + ErtsDigit b; + ErtsDigit c; + + DSUB(*x,1,b,c); + *r++ = ~c | *y++; + x++; + yl--; + while(yl--) { + DSUBb(*x,0,b,c); + *r++ = ~c | *y++; + x++; + } + while(xl--) { + DSUBb(*x,0,b,c); + *r++ = ~c; + x++; + } + } + else { + ErtsDigit b1, b2; + ErtsDigit c1, c2; + + DSUB(*x,1,b1,c1); + DSUB(*y,1,b2,c2); + *r++ = ~c1 | ~c2; + x++; y++; + yl--; + while(yl--) { + DSUBb(*x,0,b1,c1); + DSUBb(*y,0,b2,c2); + *r++ = ~c1 | ~c2; + x++; y++; + } + } + } + return I_btrail(r0, r, sign); +} + +/* +** Bitwise xor +*/ +static dsize_t I_bxor(ErtsDigit* x, dsize_t xl, short xsgn, + ErtsDigit* y, dsize_t yl, short ysgn, ErtsDigit* r) +{ + ErtsDigit* r0 = r; + short sign = xsgn != ysgn; + + ASSERT(xl >= yl); + + xl -= yl; + + if (!xsgn) { + if (!ysgn) { + while(yl--) + *r++ = *x++ ^ *y++; + while(xl--) + *r++ = *x++; + } + else { + ErtsDigit b; + ErtsDigit c; + + DSUB(*y,1,b,c); + *r++ = *x++ ^ ~c; + y++; + yl--; + while(yl--) { + DSUBb(*y,0,b,c); + *r++ = *x++ ^ ~c; + y++; + } + while(xl--) + *r++ = ~*x++; + } + } + else { + if (!ysgn) { + ErtsDigit b; + ErtsDigit c; + + DSUB(*x,1,b,c); + *r++ = ~c ^ *y++; + x++; + yl--; + while(yl--) { + DSUBb(*x,0,b,c); + *r++ = ~c ^ *y++; + x++; + } + while(xl--) + *r++ = ~*x++; + } + else { + ErtsDigit b1, b2; + ErtsDigit c1, c2; + + DSUB(*x,1,b1,c1); + DSUB(*y,1,b2,c2); + *r++ = ~c1 ^ ~c2; + x++; y++; + yl--; + while(yl--) { + DSUBb(*x,0,b1,c1); + DSUBb(*y,0,b2,c2); + *r++ = ~c1 ^ ~c2; + x++; y++; + } + while(xl--) { + *r++ = *x++; + } + } + } + return I_btrail(r0, r, sign); +} + +/* +** Bitwise not simulated as +** bnot -X == (X - 1) +** bnot +X == -(X + 1) +*/ +static dsize_t I_bnot(ErtsDigit* x, dsize_t xl, short xsgn, ErtsDigit* r) +{ + if (xsgn) + return D_add(x, xl, 1, r); + else + return D_sub(x, xl, 1, r); +} + +/* +** Arithmetic left shift or right +*/ +static dsize_t I_lshift(ErtsDigit* x, dsize_t xl, Sint y, + short sign, ErtsDigit* r) +{ + if (y == 0) { + MOVE_DIGITS(r, x, xl); + return xl; + } + else if (xl == 1 && *x == 0) { + *r = 0; + return 1; + } + else { + long ay = (y < 0) ? -y : y; + int bw = ay / D_EXP; + int sw = ay % D_EXP; + dsize_t rl; + ErtsDigit a1=0; + ErtsDigit a0=0; + + if (y > 0) { /* shift left */ + rl = xl + bw + 1; + + while(bw--) + *r++ = 0; + if (sw) { // NOTE! x >> 32 is not = 0! + while(xl--) { + a0 = (*x << sw) | a1; + a1 = (*x >> (D_EXP - sw)); + *r++ = a0; + x++; + } + } + else { + while(xl--) { + *r++ = *x++; + } + } + if (a1 == 0) + return rl-1; + *r = a1; + return rl; + } + else { /* shift right */ + ErtsDigit* r0 = r; + int add_one = 0; + + if (xl <= bw) { + if (sign) + *r = 1; + else + *r = 0; + return 1; + } + + if (sign) { + int zl = bw; + ErtsDigit* z = x; + + while(zl--) { + if (*z != 0) { + add_one = 1; + break; + } + z++; + } + } + + rl = xl - bw; + x += (xl-1); + r += (rl-1); + xl -= bw; + if (sw) { // NOTE! x >> 32 is not = 0! + while(xl--) { + a1 = (*x >> sw) | a0; + a0 = (*x << (D_EXP-sw)); + *r-- = a1; + x--; + } + } + else { + while(xl--) { + *r-- = *x--; + } + } + + if (sign && (a0 != 0)) + add_one = 1; + + if (r[rl] == 0) { + if (rl == 1) { + if (sign) + r[1] = 1; + return 1; + } + rl--; + } + if (add_one) + return D_add(r0, rl, 1, r0); + return rl; + } + } +} + +/* +** Return log(x)/log(2) +*/ +static int I_lg(ErtsDigit* x, dsize_t xl) +{ + dsize_t sz = xl - 1; + ErtsDigit d = x[sz]; + + sz *= D_EXP; + while(d != 0) { + d >>= 1; + sz++; + } + return sz - 1; +} + +/* +** Create bigint on heap if necessary. Like the previously existing +** make_small_or_big(), except for a HAlloc() instead of an +** ArithAlloc(). +** NOTE: Only use erts_make_integer(), when order of heap fragments is +** guaranteed to be correct. +*/ +Eterm +erts_make_integer(Uint x, Process *p) +{ + Eterm* hp; + if (IS_USMALL(0,x)) + return make_small(x); + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + return uint_to_big(x,hp); + } +} + +/* +** convert Uint to bigint +** (must only be used if x is to big to be stored as a small) +*/ +Eterm uint_to_big(Uint x, Eterm *y) +{ + *y = make_pos_bignum_header(1); + BIG_DIGIT(y, 0) = x; + return make_big(y); +} + + +/* +** convert signed int to bigint +*/ +Eterm small_to_big(Sint x, Eterm *y) +{ + if (x >= 0) { + *y = make_pos_bignum_header(1); + } else { + x = -x; + *y = make_neg_bignum_header(1); + } + BIG_DIGIT(y, 0) = x; + return make_big(y); +} + + +Eterm erts_uint64_to_big(Uint64 x, Eterm **hpp) +{ + Eterm *hp = *hpp; +#ifdef ARCH_32 + if (x >= (((Uint64) 1) << 32)) { + *hp = make_pos_bignum_header(2); + BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff)); + BIG_DIGIT(hp, 1) = (Uint) ((x >> 32) & ((Uint) 0xffffffff)); + *hpp += 2; + } + else +#endif + { + *hp = make_pos_bignum_header(1); + BIG_DIGIT(hp, 0) = (Uint) x; + *hpp += 1; + } + return make_big(hp); +} + +Eterm erts_sint64_to_big(Sint64 x, Eterm **hpp) +{ + Eterm *hp = *hpp; + int neg; + if (x >= 0) + neg = 0; + else { + neg = 1; + x = -x; + } +#ifdef ARCH_32 + if (x >= (((Uint64) 1) << 32)) { + if (neg) + *hp = make_neg_bignum_header(2); + else + *hp = make_pos_bignum_header(2); + BIG_DIGIT(hp, 0) = (Uint) (x & ((Uint) 0xffffffff)); + BIG_DIGIT(hp, 1) = (Uint) ((x >> 32) & ((Uint) 0xffffffff)); + *hpp += 2; + } + else +#endif + { + if (neg) + *hp = make_neg_bignum_header(1); + else + *hp = make_pos_bignum_header(1); + BIG_DIGIT(hp, 0) = (Uint) x; + *hpp += 1; + } + return make_big(hp); +} + +/* +** Convert a bignum to a double float +*/ +int +big_to_double(Eterm x, double* resp) +{ + double d = 0.0; + Eterm* xp = big_val(x); + dsize_t xl = BIG_SIZE(xp); + ErtsDigit* s = BIG_V(xp) + xl; + short xsgn = BIG_SIGN(xp); + double dbase = ((double)(D_MASK)+1); +#ifndef NO_FPE_SIGNALS + volatile unsigned long *fpexnp = erts_get_current_fp_exception(); +#endif + __ERTS_SAVE_FP_EXCEPTION(fpexnp); + + __ERTS_FP_CHECK_INIT(fpexnp); + while (xl--) { + d = d * dbase + *--s; + + __ERTS_FP_ERROR(fpexnp, d, __ERTS_RESTORE_FP_EXCEPTION(fpexnp); return -1); + } + + *resp = xsgn ? -d : d; + __ERTS_FP_ERROR(fpexnp,*resp,;); + __ERTS_RESTORE_FP_EXCEPTION(fpexnp); + return 0; +} + + +/* + ** Estimate the number of decimal digits (include sign) + */ +int big_decimal_estimate(Eterm x) +{ + Eterm* xp = big_val(x); + int lg = I_lg(BIG_V(xp), BIG_SIZE(xp)); + int lg10 = ((lg+1)*28/93)+1; + + if (BIG_SIGN(xp)) lg10++; /* add sign */ + return lg10+1; /* add null */ +} + +/* +** Convert a bignum into a string of decimal numbers +*/ + +static void write_big(Eterm x, void (*write_func)(void *, char), void *arg) +{ + Eterm* xp = big_val(x); + ErtsDigit* dx = BIG_V(xp); + dsize_t xl = BIG_SIZE(xp); + short sign = BIG_SIGN(xp); + ErtsDigit rem; + + if (xl == 1 && *dx < D_DECIMAL_BASE) { + rem = *dx; + if (rem == 0) + (*write_func)(arg, '0'); + else { + while(rem) { + (*write_func)(arg, (rem % 10) + '0'); + rem /= 10; + } + } + } + else { + ErtsDigit* tmp = (ErtsDigit*) erts_alloc(ERTS_ALC_T_TMP, + sizeof(ErtsDigit)*xl); + dsize_t tmpl = xl; + + MOVE_DIGITS(tmp, dx, xl); + + while(1) { + tmpl = D_div(tmp, tmpl, D_DECIMAL_BASE, tmp, &rem); + if (tmpl == 1 && *tmp == 0) { + while(rem) { + (*write_func)(arg, (rem % 10)+'0'); + rem /= 10; + } + break; + } + else { + int i = D_DECIMAL_EXP; + while(i--) { + (*write_func)(arg, (rem % 10)+'0'); + rem /= 10; + } + } + } + erts_free(ERTS_ALC_T_TMP, (void *) tmp); + } + + if (sign) + (*write_func)(arg, '-'); +} + +struct big_list__ { + Eterm *hp; + Eterm res; +}; + +static void +write_list(void *arg, char c) +{ + struct big_list__ *blp = (struct big_list__ *) arg; + blp->res = CONS(blp->hp, make_small(c), blp->res); + blp->hp += 2; +} + +Eterm erts_big_to_list(Eterm x, Eterm **hpp) +{ + struct big_list__ bl; + bl.hp = *hpp; + bl.res = NIL; + write_big(x, write_list, (void *) &bl); + *hpp = bl.hp; + return bl.res; +} + +static void +write_string(void *arg, char c) +{ + *(--(*((char **) arg))) = c; +} + +char *erts_big_to_string(Eterm x, char *buf, Uint buf_sz) +{ + char *big_str = buf + buf_sz - 1; + *big_str = '\0'; + write_big(x, write_string, (void *) &big_str); + ASSERT(buf <= big_str && big_str <= buf + buf_sz - 1); + return big_str; +} + +/* +** Normalize a bignum given thing pointer length in digits and a sign +** patch zero if odd length +*/ +static Eterm big_norm(Eterm *x, dsize_t xl, short sign) +{ + Uint arity; + + if (xl == 1) { + Uint y = BIG_DIGIT(x, 0); + + if (D_EXP < SMALL_BITS || IS_USMALL(sign, y)) { + if (sign) + return make_small(-((Sint)y)); + else + return make_small(y); + } + } + + /* __alpha__: This was fixed */ + if ((arity = BIG_NEED_SIZE(xl)-1) > BIG_ARITY_MAX) + return NIL; /* signal error (too big) */ + + if (sign) { + *x = make_neg_bignum_header(arity); + } + else { + *x = make_pos_bignum_header(arity); + } + return make_big(x); +} + +/* +** Compare bignums +*/ +int big_comp(Eterm x, Eterm y) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + + if (BIG_SIGN(xp) == BIG_SIGN(yp)) { + int c = I_comp(BIG_V(xp), BIG_SIZE(xp), BIG_V(yp), BIG_SIZE(yp)); + if (BIG_SIGN(xp)) + return -c; + else + return c; + } + else + return BIG_SIGN(xp) ? -1 : 1; +} + +/* +** Unsigned compare +*/ +int big_ucomp(Eterm x, Eterm y) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + + return I_comp(BIG_V(xp), BIG_SIZE(xp), BIG_V(yp), BIG_SIZE(yp)); +} + +/* +** Return number of bytes in the bignum +*/ +dsize_t big_bytes(Eterm x) +{ + Eterm* xp = big_val(x); + dsize_t sz = BIG_SIZE(xp); + ErtsDigit d = BIG_DIGIT(xp, sz-1); + + sz = (sz-1) * sizeof(ErtsDigit); + while (d != 0) { + ++sz; + d >>= 8; + } + return sz; +} + +/* +** Load a bignum from bytes +** xsz is the number of bytes in xp +*/ +Eterm bytes_to_big(byte *xp, dsize_t xsz, int xsgn, Eterm *r) +{ + ErtsDigit* rwp = BIG_V(r); + dsize_t rsz = 0; + ErtsDigit d; + int i; + + while(xsz >= sizeof(ErtsDigit)) { + d = 0; + for(i = sizeof(ErtsDigit); --i >= 0;) + d = (d << 8) | xp[i]; + *rwp = d; + rwp++; + xsz -= sizeof(ErtsDigit); + xp += sizeof(ErtsDigit); + rsz++; + } + + if (xsz > 0) { + d = 0; + for(i = xsz; --i >= 0;) + d = (d << 8) | xp[i]; + *rwp = d; + rwp++; + rsz++; + } + return big_norm(r, rsz, (short) xsgn); +} + +/* +** Store digits in the array of bytes pointed to by p +*/ +byte* big_to_bytes(Eterm x, byte *p) +{ + ErtsDigit* xr = big_v(x); + dsize_t xl = big_size(x); + ErtsDigit d; + int i; + + while(xl > 1) { + d = *xr; + xr++; + for(i = 0; i < sizeof(ErtsDigit); ++i) { + p[i] = d & 0xff; + d >>= 8; + } + p += sizeof(ErtsDigit); + xl--; + } + d = *xr; + do { + *p++ = d & 0xff; + d >>= 8; + } while (d != 0); + return p; +} + +/* + * Converts a positive term (small or bignum) to an Uint. + * + * Fails returning 0 if the term is neither a small nor a bignum, + * if it's negative, or the big number does not fit in an Uint; + * in addition the error reason, BADARG or SYSTEM_LIMIT, will be + * stored in *up. + * + * Otherwise returns a non-zero value and the converted number + * in *up. + */ + +int +term_to_Uint(Eterm term, Uint *up) +{ + if (is_small(term)) { + Sint i = signed_val(term); + if (i < 0) { + *up = BADARG; + return 0; + } + *up = (Uint) i; + return 1; + } else if (is_big(term)) { + ErtsDigit* xr = big_v(term); + dsize_t xl = big_size(term); + Uint uval = 0; + int n = 0; + + if (big_sign(term)) { + *up = BADARG; + return 0; + } else if (xl*D_EXP > sizeof(Uint)*8) { + *up = SYSTEM_LIMIT; + return 0; + } + while (xl-- > 0) { + uval |= ((Uint)(*xr++)) << n; + n += D_EXP; + } + *up = uval; + return 1; + } else { + *up = BADARG; + return 0; + } +} + +int term_to_Sint(Eterm term, Sint *sp) +{ + if (is_small(term)) { + *sp = signed_val(term); + return 1; + } else if (is_big(term)) { + ErtsDigit* xr = big_v(term); + dsize_t xl = big_size(term); + int sign = big_sign(term); + Uint uval = 0; + int n = 0; + + if (xl*D_EXP > sizeof(Uint)*8) { + return 0; + } + while (xl-- > 0) { + uval |= ((Uint)(*xr++)) << n; + n += D_EXP; + } + if (sign) { + uval = -uval; + if ((Sint)uval > 0) + return 0; + } else { + if ((Sint)uval < 0) + return 0; + } + *sp = uval; + return 1; + } else { + return 0; + } +} + +/* +** Add and subtract +*/ +static Eterm B_plus_minus(ErtsDigit *x, dsize_t xl, short xsgn, + ErtsDigit *y, dsize_t yl, short ysgn, Eterm *r) +{ + if (xsgn == ysgn) { + if (xl > yl) + return big_norm(r, I_add(x,xl,y,yl,BIG_V(r)), xsgn); + else + return big_norm(r, I_add(y,yl,x,xl,BIG_V(r)), xsgn); + } + else { + int comp = I_comp(x, xl, y, yl); + if (comp == 0) + return make_small(0); + else if (comp > 0) + return big_norm(r, I_sub(x,xl,y,yl,BIG_V(r)), xsgn); + else + return big_norm(r, I_sub(y,yl,x,xl,BIG_V(r)), ysgn); + } +} + +/* +** Add bignums +*/ +Eterm big_plus(Eterm x, Eterm y, Eterm *r) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + + return B_plus_minus(BIG_V(xp),BIG_SIZE(xp),(short) BIG_SIGN(xp), + BIG_V(yp),BIG_SIZE(yp),(short) BIG_SIGN(yp), r); +} + +/* +** Subtract bignums +*/ + +Eterm big_minus(Eterm x, Eterm y, Eterm *r) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + + return B_plus_minus(BIG_V(xp),BIG_SIZE(xp),(short) BIG_SIGN(xp), + BIG_V(yp),BIG_SIZE(yp),(short) !BIG_SIGN(yp), r); +} + +/* +** Subtract a digit from big number +*/ +Eterm big_minus_small(Eterm x, Eterm y, Eterm *r) +{ + Eterm* xp = big_val(x); + + if (BIG_SIGN(xp)) + return big_norm(r, D_add(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, BIG_V(r)), + (short) BIG_SIGN(xp)); + else + return big_norm(r, D_sub(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, BIG_V(r)), + (short) BIG_SIGN(xp)); +} + +/* +** Multiply smallnums +*/ + +Eterm small_times(Sint x, Sint y, Eterm *r) +{ + short sign = (x<0) != (y<0); + ErtsDigit xu = (x > 0) ? x : -x; + ErtsDigit yu = (y > 0) ? y : -y; + ErtsDigit d1=0; + ErtsDigit d0; + Uint arity; + + DMULc(xu, yu, d1, d0); + + if (!d1 && ((D_EXP < SMALL_BITS) || IS_USMALL(sign, d0))) { + if (sign) + return make_small(-((Sint)d0)); + else + return make_small(d0); + } + + BIG_DIGIT(r,0) = d0; + arity = d1 ? 2 : 1; + if (sign) + *r = make_neg_bignum_header(arity); + else + *r = make_pos_bignum_header(arity); + if (d1) + BIG_DIGIT(r,1) = d1; + return make_big(r); +} + +/* +** Multiply bignums +*/ + +Eterm big_times(Eterm x, Eterm y, Eterm *r) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + + short sign = BIG_SIGN(xp) != BIG_SIGN(yp); + dsize_t xsz = BIG_SIZE(xp); + dsize_t ysz = BIG_SIZE(yp); + dsize_t rsz; + + if (ysz == 1) + rsz = D_mul(BIG_V(xp), xsz, BIG_DIGIT(yp, 0), BIG_V(r)); + else if (xsz == 1) + rsz = D_mul(BIG_V(yp), ysz, BIG_DIGIT(xp, 0), BIG_V(r)); + else if (xp == yp) { + ZERO_DIGITS(BIG_V(r), xsz+1); + rsz = I_sqr(BIG_V(xp), xsz, BIG_V(r)); + } + else if (xsz >= ysz) { + ZERO_DIGITS(BIG_V(r), xsz); + rsz = I_mul(BIG_V(xp), xsz, BIG_V(yp), ysz, BIG_V(r)); + } + else { + ZERO_DIGITS(BIG_V(r), ysz); + rsz = I_mul(BIG_V(yp), ysz, BIG_V(xp), xsz, BIG_V(r)); + } + return big_norm(r, rsz, sign); +} + + +/* +** Divide bignums +*/ + +Eterm big_div(Eterm x, Eterm y, Eterm *q) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + + short sign = BIG_SIGN(xp) != BIG_SIGN(yp); + dsize_t xsz = BIG_SIZE(xp); + dsize_t ysz = BIG_SIZE(yp); + dsize_t qsz; + + if (ysz == 1) { + ErtsDigit rem; + qsz = D_div(BIG_V(xp), xsz, BIG_DIGIT(yp,0), BIG_V(q), &rem); + } + else { + Eterm* remp; + dsize_t rem_sz; + + qsz = xsz - ysz + 1; + remp = q + BIG_NEED_SIZE(qsz); + qsz = I_div(BIG_V(xp), xsz, BIG_V(yp), ysz, BIG_V(q), BIG_V(remp), + &rem_sz); + } + return big_norm(q, qsz, sign); +} + +/* +** Remainder +*/ +Eterm big_rem(Eterm x, Eterm y, Eterm *r) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + short sign = BIG_SIGN(xp); + dsize_t xsz = BIG_SIZE(xp); + dsize_t ysz = BIG_SIZE(yp); + + if (ysz == 1) { + ErtsDigit rem; + rem = D_rem(BIG_V(xp), xsz, BIG_DIGIT(yp,0)); + if (IS_USMALL(sign, rem)) { + if (sign) + return make_small(-(Sint)rem); + else + return make_small(rem); + } + else { + if (sign) + *r = make_neg_bignum_header(1); + else + *r = make_pos_bignum_header(1); + BIG_DIGIT(r, 0) = rem; + return make_big(r); + } + } + else { + dsize_t rsz = I_rem(BIG_V(xp), xsz, BIG_V(yp), ysz, BIG_V(r)); + return big_norm(r, rsz, sign); + } +} + +Eterm big_neg(Eterm x, Eterm *r) +{ + Eterm* xp = big_val(x); + dsize_t xsz = BIG_SIZE(xp); + short xsgn = BIG_SIGN(xp); + + MOVE_DIGITS(BIG_V(r), BIG_V(xp), xsz); + return big_norm(r, xsz, (short) !xsgn); +} + +Eterm big_band(Eterm x, Eterm y, Eterm *r) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + + short xsgn = BIG_SIGN(xp); + short ysgn = BIG_SIGN(yp); + short sign = xsgn && ysgn; + dsize_t xsz = BIG_SIZE(xp); + dsize_t ysz = BIG_SIZE(yp); + + if (xsz >= ysz) + return big_norm(r,I_band(BIG_V(xp),xsz,xsgn, + BIG_V(yp),ysz,ysgn, + BIG_V(r)),sign); + else + return big_norm(r,I_band(BIG_V(yp),ysz,ysgn, + BIG_V(xp),xsz,xsgn, + BIG_V(r)),sign); +} + + +Eterm big_bor(Eterm x, Eterm y, Eterm *r) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + short xsgn = BIG_SIGN(xp); + short ysgn = BIG_SIGN(yp); + short sign = (xsgn || ysgn); + dsize_t xsz = BIG_SIZE(xp); + dsize_t ysz = BIG_SIZE(yp); + + if (xsz >= ysz) + return big_norm(r,I_bor(BIG_V(xp),xsz,xsgn, + BIG_V(yp),ysz,ysgn, + BIG_V(r)),sign); + else + return big_norm(r,I_bor(BIG_V(yp),ysz,ysgn, + BIG_V(xp),xsz,xsgn, + BIG_V(r)),sign); +} + + +Eterm big_bxor(Eterm x, Eterm y, Eterm *r) +{ + Eterm* xp = big_val(x); + Eterm* yp = big_val(y); + short xsgn = BIG_SIGN(xp); + short ysgn = BIG_SIGN(yp); + short sign = (xsgn != ysgn); + dsize_t xsz = BIG_SIZE(xp); + dsize_t ysz = BIG_SIZE(yp); + + if (xsz >= ysz) + return big_norm(r,I_bxor(BIG_V(xp),xsz,xsgn, + BIG_V(yp),ysz,ysgn, + BIG_V(r)),sign); + else + return big_norm(r,I_bxor(BIG_V(yp),ysz,ysgn, + BIG_V(xp),xsz,xsgn, + BIG_V(r)),sign); +} + +Eterm big_bnot(Eterm x, Eterm *r) +{ + Eterm* xp = big_val(x); + short sign = !BIG_SIGN(xp); + dsize_t xsz = BIG_SIZE(xp); + + return big_norm(r, I_bnot(BIG_V(xp), xsz, sign, BIG_V(r)), sign); +} + +Eterm big_lshift(Eterm x, Sint y, Eterm *r) +{ + Eterm* xp = big_val(x); + short sign = BIG_SIGN(xp); + dsize_t xsz = BIG_SIZE(xp); + + return big_norm(r, I_lshift(BIG_V(xp), xsz, y, sign, BIG_V(r)), sign); +} + + +/* add unsigned small int y to x */ + +Eterm big_plus_small(Eterm x, Uint y, Eterm *r) +{ + Eterm* xp = big_val(x); + + if (BIG_SIGN(xp)) + return big_norm(r, D_sub(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, + BIG_V(r)), (short) BIG_SIGN(xp)); + else + return big_norm(r, D_add(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, + BIG_V(r)), (short) BIG_SIGN(xp)); +} + +Eterm big_times_small(Eterm x, Uint y, Eterm *r) +{ + Eterm* xp = big_val(x); + + return big_norm(r, D_mul(BIG_V(xp),BIG_SIZE(xp), (ErtsDigit) y, + BIG_V(r)), (short) BIG_SIGN(xp)); +} + +/* +** Expects the big to fit. +*/ +Uint32 big_to_uint32(Eterm b) +{ + Uint u; + if (!term_to_Uint(b, &u)) { + ASSERT(0); + return 0; + } + return u; +} + +/* + * Check if a fixnum or bignum equals 2^32. + */ +int term_equals_2pow32(Eterm x) +{ + if (sizeof(Uint) > 4) { + Uint u; + if (!term_to_Uint(x, &u)) + return 0; + return (u & 0xFFFFFFFF) == 0 && ((u >> 16) >> 16) == 1; + } else { + Eterm *bp; + if (!is_big(x)) + return 0; + bp = big_val(x); +#if D_EXP == 16 // 16 bit platfrom not really supported!!! + return (BIG_SIZE(bp) == 3) && !BIG_DIGIT(bp,0) && !BIG_DIGIT(bp,1) && + BIG_DIGIT(bp,2) == 1; +#elif D_EXP == 32 + return (BIG_SIZE(bp) == 2) && !BIG_DIGIT(bp,0) && + BIG_DIGIT(bp,1) == 1; +#elif D_EXP == 64 + return (BIG_SIZE(bp) == 1) && + ((BIG_DIGIT(bp,0) & 0xffffffff) == 0) && + ((BIG_DIGIT(bp,0) >> 32) == 1); +#endif + return 0; + } +} diff --git a/erts/emulator/beam/big.h b/erts/emulator/beam/big.h new file mode 100644 index 0000000000..b8e38d482c --- /dev/null +++ b/erts/emulator/beam/big.h @@ -0,0 +1,155 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __BIG_H__ +#define __BIG_H__ + +#ifndef __SYS_H__ +#include "sys.h" +#endif + +#ifndef __CONFIG_H__ +#include "erl_vm.h" +#endif + +#ifndef __GLOBAL_H__ +#include "global.h" +#endif + +typedef Uint ErtsDigit; + +#if (SIZEOF_VOID_P == 4) && defined(SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG == 8) +/* Assume 32-bit machine with long long support */ +typedef Uint64 ErtsDoubleDigit; +typedef Uint16 ErtsHalfDigit; +#define BIG_HAVE_DOUBLE_DIGIT 1 + +#elif (SIZEOF_VOID_P == 4) +/* Assume 32-bit machine with no long support */ +#undef BIG_HAVE_DOUBLE_DIGIT +typedef Uint16 ErtsHalfDigit; + +#elif (SIZEOF_VOID_P == 8) +/* Assume 64-bit machine, does it exist 128 bit long long long ? */ +#undef BIG_HAVE_DOUBLE_DIGIT +typedef Uint32 ErtsHalfDigit; +#else +#error "can not determine machine size" +#endif + +#define D_DECIMAL_EXP 9 +#define D_DECIMAL_BASE 1000000000 + +typedef Uint dsize_t; /* Vector size type */ + +#define D_EXP (SIZEOF_VOID_P*8) +#define D_MASK ((ErtsDigit)(-1)) /* D_BASE-1 */ + +/* macros for bignum objects */ +#define big_v(x) BIG_V(big_val(x)) +#define big_sign(x) BIG_SIGN(big_val(x)) +#define big_arity(x) BIG_ARITY(big_val(x)) +#define big_digit(x,i) BIG_DIGIT(big_val(x),i) +#define big_size(x) BIG_SIZE(big_val(x)) + + +/* macros for thing pointers */ + +#define BIG_V(xp) ((ErtsDigit*)((xp)+1)) +#define BIG_SIGN(xp) (!!bignum_header_is_neg(*xp)) +#define BIG_ARITY(xp) ((Uint)bignum_header_arity(*(xp))) +#define BIG_DIGIT(xp,i) *(BIG_V(xp)+(i)) +#define BIG_DIGITS_PER_WORD (sizeof(Uint)/sizeof(ErtsDigit)) + +#define BIG_SIZE(xp) BIG_ARITY(xp) + +/* Check for small */ +#define IS_USMALL(sgn,x) ((sgn) ? ((x) <= MAX_SMALL+1) : ((x) <= MAX_SMALL)) +#define IS_SSMALL(x) (((x) >= MIN_SMALL) && ((x) <= MAX_SMALL)) + +/* The heap size needed for a bignum */ +#define BIG_NEED_SIZE(x) ((x) + 1) + +#define BIG_UINT_HEAP_SIZE (1 + 1) /* always, since sizeof(Uint) <= sizeof(Eterm) */ + +#ifdef ARCH_32 + +#define ERTS_UINT64_BIG_HEAP_SIZE__(X) \ + ((X) >= (((Uint64) 1) << 32) ? (1 + 2) : (1 + 1)) +#define ERTS_SINT64_HEAP_SIZE(X) \ + (IS_SSMALL((X)) \ + ? 0 \ + : ERTS_UINT64_BIG_HEAP_SIZE__((X) >= 0 ? (X) : -(X))) +#define ERTS_UINT64_HEAP_SIZE(X) \ + (IS_USMALL(0, (X)) ? 0 : ERTS_UINT64_BIG_HEAP_SIZE__((X))) + +#else + +#define ERTS_SINT64_HEAP_SIZE(X) \ + (IS_SSMALL((X)) ? 0 : (1 + 1)) +#define ERTS_UINT64_HEAP_SIZE(X) \ + (IS_USMALL(0, (X)) ? 0 : (1 + 1)) + +#endif + +int big_decimal_estimate(Eterm); +Eterm erts_big_to_list(Eterm, Eterm**); +char *erts_big_to_string(Eterm x, char *buf, Uint buf_sz); + +Eterm small_times(Sint, Sint, Eterm*); + +Eterm big_plus(Eterm, Eterm, Eterm*); +Eterm big_minus(Eterm, Eterm, Eterm*); +Eterm big_times(Eterm, Eterm, Eterm*); +Eterm big_div(Eterm, Eterm, Eterm*); +Eterm big_rem(Eterm, Eterm, Eterm*); +Eterm big_neg(Eterm, Eterm*); + +Eterm big_minus_small(Eterm, Uint, Eterm*); +Eterm big_plus_small(Eterm, Uint, Eterm*); +Eterm big_times_small(Eterm, Uint, Eterm*); + +Eterm big_band(Eterm, Eterm, Eterm*); +Eterm big_bor(Eterm, Eterm, Eterm*); +Eterm big_bxor(Eterm, Eterm, Eterm*); +Eterm big_bnot(Eterm, Eterm*); + +Eterm big_lshift(Eterm, Sint, Eterm*); +int big_comp (Eterm, Eterm); +int big_ucomp (Eterm, Eterm); +int big_to_double(Eterm x, double* resp); +Eterm small_to_big(Sint, Eterm*); +Eterm uint_to_big(Uint, Eterm*); +Eterm erts_make_integer(Uint, Process *); + +dsize_t big_bytes(Eterm); +Eterm bytes_to_big(byte*, dsize_t, int, Eterm*); +byte* big_to_bytes(Eterm, byte*); + +int term_to_Uint(Eterm, Uint*); +int term_to_Sint(Eterm, Sint*); + +Uint32 big_to_uint32(Eterm b); +int term_equals_2pow32(Eterm); + +Eterm erts_uint64_to_big(Uint64, Eterm **); +Eterm erts_sint64_to_big(Sint64, Eterm **); + +#endif + diff --git a/erts/emulator/beam/binary.c b/erts/emulator/beam/binary.c new file mode 100644 index 0000000000..49bc0d6457 --- /dev/null +++ b/erts/emulator/beam/binary.c @@ -0,0 +1,677 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "erl_binary.h" +#include "erl_bits.h" + +#ifdef DEBUG +static int list_to_bitstr_buf(Eterm obj, char* buf, int len); +#else +static int list_to_bitstr_buf(Eterm obj, char* buf); +#endif +static Sint bitstr_list_len(Eterm obj); + +void +erts_init_binary(void) +{ + /* Verify Binary alignment... */ + if ((((Uint) &((Binary *) 0)->orig_bytes[0]) % ((Uint) 8)) != 0) { + /* I assume that any compiler should be able to optimize this + away. If not, this test is not very expensive... */ + erl_exit(ERTS_ABORT_EXIT, + "Internal error: Address of orig_bytes[0] of a Binary" + "is *not* 8-byte aligned\n"); + } +} + +/* + * Create a brand new binary from scratch. + */ + +Eterm +new_binary(Process *p, byte *buf, int len) +{ + ProcBin* pb; + Binary* bptr; + + if (len <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin* hb = (ErlHeapBin *) HAlloc(p, heap_bin_size(len)); + hb->thing_word = header_heap_bin(len); + hb->size = len; + if (buf != NULL) { + sys_memcpy(hb->data, buf, len); + } + return make_binary(hb); + } + + /* + * Allocate the binary struct itself. + */ + bptr = erts_bin_nrml_alloc(len); + bptr->flags = 0; + bptr->orig_size = len; + erts_refc_init(&bptr->refc, 1); + if (buf != NULL) { + sys_memcpy(bptr->orig_bytes, buf, len); + } + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = len; + pb->next = MSO(p).mso; + MSO(p).mso = pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + + /* + * Miscellanous updates. Return the tagged binary. + */ + MSO(p).overhead += pb->size / sizeof(Eterm); + return make_binary(pb); +} + +/* + * When heap binary is not desired... + */ + +Eterm erts_new_mso_binary(Process *p, byte *buf, int len) +{ + ProcBin* pb; + Binary* bptr; + + /* + * Allocate the binary struct itself. + */ + bptr = erts_bin_nrml_alloc(len); + bptr->flags = 0; + bptr->orig_size = len; + erts_refc_init(&bptr->refc, 1); + if (buf != NULL) { + sys_memcpy(bptr->orig_bytes, buf, len); + } + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = len; + pb->next = MSO(p).mso; + MSO(p).mso = pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + + /* + * Miscellanous updates. Return the tagged binary. + */ + MSO(p).overhead += pb->size / sizeof(Eterm); + return make_binary(pb); +} + +/* + * Create a brand new binary from scratch on the heap. + */ + +Eterm +erts_new_heap_binary(Process *p, byte *buf, int len, byte** datap) +{ + ErlHeapBin* hb = (ErlHeapBin *) HAlloc(p, heap_bin_size(len)); + + hb->thing_word = header_heap_bin(len); + hb->size = len; + if (buf != NULL) { + sys_memcpy(hb->data, buf, len); + } + *datap = (byte*) hb->data; + return make_binary(hb); +} + +Eterm +erts_realloc_binary(Eterm bin, size_t size) +{ + Eterm* bval = binary_val(bin); + + if (thing_subtag(*bval) == HEAP_BINARY_SUBTAG) { + ASSERT(size <= binary_size(bin)); + binary_size(bin) = size; + } else { /* REFC */ + ProcBin* pb = (ProcBin *) bval; + Binary* newbin = erts_bin_realloc(pb->val, size); + newbin->orig_size = size; + pb->val = newbin; + pb->size = size; + pb->bytes = (byte*) newbin->orig_bytes; + pb->flags = 0; + bin = make_binary(pb); + } + return bin; +} + +byte* +erts_get_aligned_binary_bytes(Eterm bin, byte** base_ptr) +{ + byte* bytes; + Eterm* real_bin; + Uint byte_size; + Uint offs = 0; + Uint bit_offs = 0; + + if (is_not_binary(bin)) { + return NULL; + } + byte_size = binary_size(bin); + real_bin = binary_val(bin); + if (*real_bin == HEADER_SUB_BIN) { + ErlSubBin* sb = (ErlSubBin *) real_bin; + if (sb->bitsize) { + return NULL; + } + offs = sb->offs; + bit_offs = sb->bitoffs; + real_bin = binary_val(sb->orig); + } + if (*real_bin == HEADER_PROC_BIN) { + bytes = ((ProcBin *) real_bin)->bytes + offs; + } else { + bytes = (byte *)(&(((ErlHeapBin *) real_bin)->data)) + offs; + } + if (bit_offs) { + byte* buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, byte_size); + + erts_copy_bits(bytes, bit_offs, 1, buf, 0, 1, byte_size*8); + *base_ptr = buf; + bytes = buf; + } + return bytes; +} + +static Eterm +bin_bytes_to_list(Eterm previous, Eterm* hp, byte* bytes, Uint size, Uint bitoffs) +{ + if (bitoffs == 0) { + while (size) { + previous = CONS(hp, make_small(bytes[--size]), previous); + hp += 2; + } + } else { + byte present; + byte next; + next = bytes[size]; + while (size) { + present = next; + next = bytes[--size]; + previous = CONS(hp, make_small(((present >> (8-bitoffs)) | + (next << bitoffs)) & 255), previous); + hp += 2; + } + } + return previous; +} + + +BIF_RETTYPE binary_to_list_1(BIF_ALIST_1) +{ + Eterm real_bin; + Uint offset; + Uint size; + Uint bitsize; + Uint bitoffs; + + if (is_not_binary(BIF_ARG_1)) { + goto error; + } + size = binary_size(BIF_ARG_1); + ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); + if (bitsize != 0) { + goto error; + } + if (size == 0) { + BIF_RET(NIL); + } else { + Eterm* hp = HAlloc(BIF_P, 2 * size); + byte* bytes = binary_bytes(real_bin)+offset; + + BIF_RET(bin_bytes_to_list(NIL, hp, bytes, size, bitoffs)); + } + + error: + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE binary_to_list_3(BIF_ALIST_3) +{ + byte* bytes; + Uint size; + Uint bitoffs; + Uint bitsize; + Uint i; + Uint start; + Uint stop; + Eterm* hp; + + if (is_not_binary(BIF_ARG_1)) { + goto error; + } + if (!term_to_Uint(BIF_ARG_2, &start) || !term_to_Uint(BIF_ARG_3, &stop)) { + goto error; + } + size = binary_size(BIF_ARG_1); + ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize); + if (start < 1 || start > size || stop < 1 || + stop > size || stop < start ) { + goto error; + } + i = stop-start+1; + hp = HAlloc(BIF_P, 2*i); + BIF_RET(bin_bytes_to_list(NIL, hp, bytes+start-1, i, bitoffs)); + + error: + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE bitstring_to_list_1(BIF_ALIST_1) +{ + Eterm real_bin; + Uint offset; + Uint size; + Uint bitsize; + Uint bitoffs; + byte* bytes; + Eterm previous = NIL; + Eterm* hp; + + if (is_not_binary(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + size = binary_size(BIF_ARG_1); + ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); + bytes = binary_bytes(real_bin)+offset; + if (bitsize == 0) { + hp = HAlloc(BIF_P, 2 * size); + } else if (size == 0) { + hp = HAlloc(BIF_P, 2); + BIF_RET(CONS(hp,BIF_ARG_1,NIL)); + } else { + ErlSubBin* last; + + hp = HAlloc(BIF_P, ERL_SUB_BIN_SIZE+2+2*size); + last = (ErlSubBin *) hp; + last->thing_word = HEADER_SUB_BIN; + last->size = 0; + last->bitsize = bitsize; + last->offs = offset+size; + last->bitoffs = bitoffs; + last->orig = real_bin; + last->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + previous = CONS(hp, make_binary(last), previous); + hp += 2; + } + BIF_RET(bin_bytes_to_list(previous, hp, bytes, size, bitoffs)); +} + + +/* Turn a possibly deep list of ints (and binaries) into */ +/* One large binary object */ + +BIF_RETTYPE list_to_binary_1(BIF_ALIST_1) +{ + Eterm bin; + int i; + int offset; + byte* bytes; + if (is_nil(BIF_ARG_1)) { + BIF_RET(new_binary(BIF_P,(byte*)"",0)); + } + if (is_not_list(BIF_ARG_1)) { + goto error; + } + if ((i = io_list_len(BIF_ARG_1)) < 0) { + goto error; + } + bin = new_binary(BIF_P, (byte *)NULL, i); + bytes = binary_bytes(bin); + offset = io_list_to_buf(BIF_ARG_1, (char*) bytes, i); + ASSERT(offset == 0); + BIF_RET(bin); + + error: + BIF_ERROR(BIF_P, BADARG); +} + +/* Turn a possibly deep list of ints (and binaries) into */ +/* One large binary object */ + +BIF_RETTYPE iolist_to_binary_1(BIF_ALIST_1) +{ + Eterm bin; + int i; + int offset; + byte* bytes; + + if (is_binary(BIF_ARG_1)) { + BIF_RET(BIF_ARG_1); + } + if (is_nil(BIF_ARG_1)) { + BIF_RET(new_binary(BIF_P,(byte*)"",0)); + } + if (is_not_list(BIF_ARG_1)) { + goto error; + } + if ((i = io_list_len(BIF_ARG_1)) < 0) { + goto error; + } + bin = new_binary(BIF_P, (byte *)NULL, i); + bytes = binary_bytes(bin); + offset = io_list_to_buf(BIF_ARG_1, (char*) bytes, i); + ASSERT(offset == 0); + BIF_RET(bin); + + error: + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE list_to_bitstring_1(BIF_ALIST_1) +{ + Eterm bin; + int i,offset; + byte* bytes; + ErlSubBin* sb1; + Eterm* hp; + + if (is_nil(BIF_ARG_1)) { + BIF_RET(new_binary(BIF_P,(byte*)"",0)); + } + if (is_not_list(BIF_ARG_1)) { + goto error; + } + if ((i = bitstr_list_len(BIF_ARG_1)) < 0) { + goto error; + } + bin = new_binary(BIF_P, (byte *)NULL, i); + bytes = binary_bytes(bin); +#ifdef DEBUG + offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes, i); +#else + offset = list_to_bitstr_buf(BIF_ARG_1, (char*) bytes); +#endif + ASSERT(offset >= 0); + if (offset > 0) { + hp = HAlloc(BIF_P, ERL_SUB_BIN_SIZE); + sb1 = (ErlSubBin *) hp; + sb1->thing_word = HEADER_SUB_BIN; + sb1->size = i-1; + sb1->offs = 0; + sb1->orig = bin; + sb1->bitoffs = 0; + sb1->bitsize = offset; + sb1->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + bin = make_binary(sb1); + } + + BIF_RET(bin); + + error: + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE split_binary_2(BIF_ALIST_2) +{ + Uint pos; + ErlSubBin* sb1; + ErlSubBin* sb2; + size_t orig_size; + Eterm orig; + Uint offset; + Uint bit_offset; + Uint bit_size; + Eterm* hp; + + if (is_not_binary(BIF_ARG_1)) { + goto error; + } + if (!term_to_Uint(BIF_ARG_2, &pos)) { + goto error; + } + if ((orig_size = binary_size(BIF_ARG_1)) < pos) { + goto error; + } + hp = HAlloc(BIF_P, 2*ERL_SUB_BIN_SIZE+3); + ERTS_GET_REAL_BIN(BIF_ARG_1, orig, offset, bit_offset, bit_size); + sb1 = (ErlSubBin *) hp; + sb1->thing_word = HEADER_SUB_BIN; + sb1->size = pos; + sb1->offs = offset; + sb1->orig = orig; + sb1->bitoffs = bit_offset; + sb1->bitsize = 0; + sb1->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + + sb2 = (ErlSubBin *) hp; + sb2->thing_word = HEADER_SUB_BIN; + sb2->size = orig_size - pos; + sb2->offs = offset + pos; + sb2->orig = orig; + sb2->bitoffs = bit_offset; + sb2->bitsize = bit_size; /* The extra bits go into the second binary. */ + sb2->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + + return TUPLE2(hp, make_binary(sb1), make_binary(sb2)); + + error: + BIF_ERROR(BIF_P, BADARG); +} + +void +erts_cleanup_mso(ProcBin* pb) +{ + while (pb != NULL) { + ProcBin* next = pb->next; + if (erts_refc_dectest(&pb->val->refc, 0) == 0) + erts_bin_free(pb->val); + pb = next; + } +} + +/* + * Local functions. + */ + +/* + * The input list is assumed to be type-correct and the buffer is + * assumed to be of sufficient size. Those assumptions are verified in + * the DEBUG-built emulator. + */ +static int +#ifdef DEBUG +list_to_bitstr_buf(Eterm obj, char* buf, int len) +#else +list_to_bitstr_buf(Eterm obj, char* buf) +#endif +{ + Eterm* objp; + int offset = 0; + DECLARE_ESTACK(s); + goto L_again; + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_again: + if (is_list(obj)) { + L_iter_list: + objp = list_val(obj); + obj = CAR(objp); + if (is_byte(obj)) { + ASSERT(len > 0); + if (offset == 0) { + *buf++ = unsigned_val(obj); + } else { + *buf = (char)((unsigned_val(obj) >> offset) | + ((*buf >> (8-offset)) << (8-offset))); + buf++; + *buf = (unsigned_val(obj) << (8-offset)); + } +#ifdef DEBUG + len--; +#endif + } else if (is_binary(obj)) { + byte* bptr; + size_t size = binary_size(obj); + Uint bitsize; + Uint bitoffs; + Uint num_bits; + + ASSERT(size <= len); + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); + num_bits = 8*size+bitsize; + copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); + offset += bitsize; + buf += size + (offset>7); +#ifdef DEBUG + len -= size + (offset>7); +#endif + offset = offset & 7; + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto L_iter_list; /* on head */ + } else { + ASSERT(is_nil(obj)); + } + + obj = CDR(objp); + if (is_list(obj)) { + goto L_iter_list; /* on tail */ + } else if (is_binary(obj)) { + byte* bptr; + size_t size = binary_size(obj); + Uint bitsize; + Uint bitoffs; + Uint num_bits; + + ASSERT(size <= len); + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); + num_bits = 8*size+bitsize; + copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); + offset += bitsize; + buf += size+(offset>7); +#ifdef DEBUG + len -= size+(offset>7); +#endif + offset = offset & 7; + } else { + ASSERT(is_nil(obj)); + } + } else if (is_binary(obj)) { + byte* bptr; + size_t size = binary_size(obj); + Uint bitsize; + Uint bitoffs; + Uint num_bits; + + ASSERT(size <= len); + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); + num_bits = 8*size+bitsize; + copy_binary_to_buffer(buf, offset, bptr, bitoffs, num_bits); + offset += bitsize; + buf += size + (offset>7); +#ifdef DEBUG + len -= size + (offset>7); +#endif + offset = offset & 7; + } else { + ASSERT(is_nil(obj)); + } + } + + DESTROY_ESTACK(s); + return offset; +} + +static Sint +bitstr_list_len(Eterm obj) +{ + Eterm* objp; + Uint len = 0; + Uint offs = 0; + DECLARE_ESTACK(s); + goto L_again; + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_again: + if (is_list(obj)) { + L_iter_list: + objp = list_val(obj); + /* Head */ + obj = CAR(objp); + if (is_byte(obj)) { + len++; + } else if (is_binary(obj)) { + len += binary_size(obj); + offs += binary_bitsize(obj); + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto L_iter_list; /* on head */ + } else if (is_not_nil(obj)) { + goto L_type_error; + } + /* Tail */ + obj = CDR(objp); + if (is_list(obj)) + goto L_iter_list; /* on tail */ + else if (is_binary(obj)) { + len += binary_size(obj); + offs += binary_bitsize(obj); + } else if (is_not_nil(obj)) { + goto L_type_error; + } + } else if (is_binary(obj)) { + len += binary_size(obj); + offs += binary_bitsize(obj); + } else if (is_not_nil(obj)) { + goto L_type_error; + } + } + + DESTROY_ESTACK(s); + return (Sint) (len + (offs/8) + ((offs % 8) != 0)); + + L_type_error: + DESTROY_ESTACK(s); + return (Sint) -1; +} diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c new file mode 100644 index 0000000000..5ea47e16f5 --- /dev/null +++ b/erts/emulator/beam/break.c @@ -0,0 +1,747 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* This File contains functions which are called if a user hits ^C */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "version.h" +#include "error.h" +#include "version.h" +#include "erl_db.h" +#include "bif.h" +#include "erl_version.h" +#include "hash.h" +#include "atom.h" +#include "beam_load.h" +#include "erl_instrument.h" +#include "erl_bif_timer.h" + +#ifdef _OSE_ +#include "time.h" +#endif + +/* Forward declarations -- should really appear somewhere else */ +static void process_killer(void); +void do_break(void); +void erl_crash_dump_v(char *file, int line, char* fmt, va_list args); +void erl_crash_dump(char* file, int line, char* fmt, ...); + +#ifdef DEBUG +static void bin_check(void); +#endif + +static void print_garb_info(int to, void *to_arg, Process* p); +#ifdef OPPROF +static void dump_frequencies(void); +#endif + +static void dump_attributes(int to, void *to_arg, byte* ptr, int size); + +extern char* erts_system_version[]; + +static void +port_info(int to, void *to_arg) +{ + int i; + for (i = 0; i < erts_max_ports; i++) + print_port_info(to, to_arg, i); +} + +void +process_info(int to, void *to_arg) +{ + int i; + for (i = 0; i < erts_max_processes; i++) { + if ((process_tab[i] != NULL) && (process_tab[i]->i != ENULL)) { + if (process_tab[i]->status != P_EXITING) + print_process_info(to, to_arg, process_tab[i]); + } + } + + port_info(to, to_arg); +} + +static void +process_killer(void) +{ + int i, j; + Process* rp; + + erts_printf("\n\nProcess Information\n\n"); + erts_printf("--------------------------------------------------\n"); + for (i = erts_max_processes-1; i >= 0; i--) { + if (((rp = process_tab[i]) != NULL) && rp->i != ENULL) { + int br; + print_process_info(ERTS_PRINT_STDOUT, NULL, rp); + erts_printf("(k)ill (n)ext (r)eturn:\n"); + while(1) { + if ((j = sys_get_key(0)) <= 0) + halt_0(0); + switch(j) { + case 'k': + if (rp->status == P_WAITING) { + Uint32 rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; + erts_smp_proc_inc_refc(rp); + erts_smp_proc_lock(rp, rp_locks); + (void) erts_send_exit_signal(NULL, + NIL, + rp, + &rp_locks, + am_kill, + NIL, + NULL, + 0); + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); + } + else + erts_printf("Can only kill WAITING processes this way\n"); + + case 'n': br = 1; break; + case 'r': return; + default: return; + } + if (br == 1) break; + } + } + } +} + +typedef struct { + int is_first; + int to; + void *to_arg; +} PrintMonitorContext; + +static void doit_print_link(ErtsLink *lnk, void *vpcontext) +{ + PrintMonitorContext *pcontext = vpcontext; + int to = pcontext->to; + void *to_arg = pcontext->to_arg; + + if (pcontext->is_first) { + pcontext->is_first = 0; + erts_print(to, to_arg, "%T", lnk->pid); + } else { + erts_print(to, to_arg, ", %T", lnk->pid); + } +} + + +static void doit_print_monitor(ErtsMonitor *mon, void *vpcontext) +{ + PrintMonitorContext *pcontext = vpcontext; + int to = pcontext->to; + void *to_arg = pcontext->to_arg; + char *prefix = ", "; + + if (pcontext->is_first) { + pcontext->is_first = 0; + prefix = ""; + } + + if (mon->type == MON_ORIGIN) { + if (is_atom(mon->pid)) { /* dist by name */ + ASSERT(is_node_name_atom(mon->pid)); + erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name, + mon->pid, mon->ref); + erts_print(to, to_arg,"}"); + } else if (is_atom(mon->name)){ /* local by name */ + erts_print(to, to_arg, "%s{to,{%T,%T},%T}", prefix, mon->name, + erts_this_dist_entry->sysname, mon->ref); + } else { /* local and distributed by pid */ + erts_print(to, to_arg, "%s{to,%T,%T}", prefix, mon->pid, mon->ref); + } + } else { /* MON_TARGET */ + erts_print(to, to_arg, "%s{from,%T,%T}", prefix, mon->pid, mon->ref); + } +} + +/* Display info about an individual Erlang process */ +void +print_process_info(int to, void *to_arg, Process *p) +{ + int garbing = 0; + int running = 0; + struct saved_calls *scb; + + /* display the PID */ + erts_print(to, to_arg, "=proc:%T\n", p->id); + + /* Display the state */ + erts_print(to, to_arg, "State: "); + switch (p->status) { + case P_FREE: + erts_print(to, to_arg, "Non Existing\n"); /* Should never happen */ + break; + case P_RUNABLE: + erts_print(to, to_arg, "Scheduled\n"); + break; + case P_WAITING: + erts_print(to, to_arg, "Waiting\n"); + break; + case P_SUSPENDED: + erts_print(to, to_arg, "Suspended\n"); + break; + case P_RUNNING: + erts_print(to, to_arg, "Running\n"); + running = 1; + break; + case P_EXITING: + erts_print(to, to_arg, "Exiting\n"); + break; + case P_GARBING: + erts_print(to, to_arg, "Garbing\n"); + garbing = 1; + running = 1; + break; + } + + /* + * If the process is registered as a global process, display the + * registered name + */ + if (p->reg != NULL) + erts_print(to, to_arg, "Name: %T\n", p->reg->name); + + /* + * Display the initial function name + */ + erts_print(to, to_arg, "Spawned as: %T:%T/%bpu\n", + p->initial[INITIAL_MOD], + p->initial[INITIAL_FUN], + p->initial[INITIAL_ARI]); + + if (p->current != NULL) { + if (running) { + erts_print(to, to_arg, "Last scheduled in for: "); + } else { + erts_print(to, to_arg, "Current call: "); + } + erts_print(to, to_arg, "%T:%T/%bpu\n", + p->current[0], + p->current[1], + p->current[2]); + } + + erts_print(to, to_arg, "Spawned by: %T\n", p->parent); + + erts_print(to, to_arg, "Started: %s", ctime((time_t*)&p->started.tv_sec)); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); + erts_print(to, to_arg, "Message queue length: %d\n", p->msg.len); + + /* display the message queue only if there is anything in it */ + if (!ERTS_IS_CRASH_DUMPING && p->msg.first != NULL && !garbing) { + ErlMessage* mp; + erts_print(to, to_arg, "Message queue: ["); + for (mp = p->msg.first; mp; mp = mp->next) + erts_print(to, to_arg, mp->next ? "%T," : "%T", ERL_MESSAGE_TERM(mp)); + erts_print(to, to_arg, "]\n"); + } + + { + long s = 0; + int frags = 0; + ErlHeapFragment *m = p->mbuf; + while (m != NULL) { + frags++; + s += m->size; + m = m->next; + } + erts_print(to, to_arg, "Number of heap fragments: %d\n", frags); + } + erts_print(to, to_arg, "Heap fragment data: %bpu\n", MBUF_SIZE(p)); + + scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); + if (scb) { + int i, j; + + erts_print(to, to_arg, "Last calls:"); + for (i = 0; i < scb->n; i++) { + erts_print(to, to_arg, " "); + j = scb->cur - i - 1; + if (j < 0) + j += scb->len; + if (scb->ct[j] == &exp_send) + erts_print(to, to_arg, "send"); + else if (scb->ct[j] == &exp_receive) + erts_print(to, to_arg, "'receive'"); + else if (scb->ct[j] == &exp_timeout) + erts_print(to, to_arg, "timeout"); + else + erts_print(to, to_arg, "%T:%T/%bpu\n", + scb->ct[j]->code[0], + scb->ct[j]->code[1], + scb->ct[j]->code[2]); + } + erts_print(to, to_arg, "\n"); + } + + /* display the links only if there are any*/ + if (p->nlinks != NULL || p->monitors != NULL) { + PrintMonitorContext context = {1,to}; + erts_print(to, to_arg,"Link list: ["); + erts_doforall_links(p->nlinks, &doit_print_link, &context); + erts_doforall_monitors(p->monitors, &doit_print_monitor, &context); + erts_print(to, to_arg,"]\n"); + } + + if (!ERTS_IS_CRASH_DUMPING) { + + /* and the dictionary */ + if (p->dictionary != NULL && !garbing) { + erts_print(to, to_arg, "Dictionary: "); + erts_dictionary_dump(to, to_arg, p->dictionary); + erts_print(to, to_arg, "\n"); + } + } + + /* print the number of reductions etc */ + erts_print(to, to_arg, "Reductions: %bpu\n", p->reds); + + erts_print(to, to_arg, "Stack+heap: %bpu\n", p->heap_sz); + erts_print(to, to_arg, "OldHeap: %bpu\n", + (OLD_HEAP(p) == NULL) ? 0 : + (unsigned)(OLD_HEND(p) - OLD_HEAP(p)) ); + erts_print(to, to_arg, "Heap unused: %bpu\n", (p->hend - p->htop)); + erts_print(to, to_arg, "OldHeap unused: %bpu\n", + (OLD_HEAP(p) == NULL) ? 0 : (OLD_HEND(p) - OLD_HEAP(p)) ); + + if (garbing) { + print_garb_info(to, to_arg, p); + } + + if (ERTS_IS_CRASH_DUMPING) { + erts_program_counter_info(to, to_arg, p); + } else { + erts_print(to, to_arg, "Stack dump:\n"); +#ifdef ERTS_SMP + if (!garbing) +#endif + erts_stack_dump(to, to_arg, p); + } +} + +static void +print_garb_info(int to, void *to_arg, Process* p) +{ + /* ERTS_SMP: A scheduler is probably concurrently doing gc... */ +#ifndef ERTS_SMP + erts_print(to, to_arg, "New heap start: %bpX\n", p->heap); + erts_print(to, to_arg, "New heap top: %bpX\n", p->htop); + erts_print(to, to_arg, "Stack top: %bpX\n", p->stop); + erts_print(to, to_arg, "Stack end: %bpX\n", p->hend); + erts_print(to, to_arg, "Old heap start: %bpX\n", OLD_HEAP(p)); + erts_print(to, to_arg, "Old heap top: %bpX\n", OLD_HTOP(p)); + erts_print(to, to_arg, "Old heap end: %bpX\n", OLD_HEND(p)); +#endif +} + +void +info(int to, void *to_arg) +{ + erts_memory(&to, to_arg, NULL, THE_NON_VALUE); + atom_info(to, to_arg); + module_info(to, to_arg); + export_info(to, to_arg); + register_info(to, to_arg); + erts_fun_info(to, to_arg); + erts_node_table_info(to, to_arg); + erts_dist_table_info(to, to_arg); + erts_allocated_areas(&to, to_arg, NULL); + erts_allocator_info(to, to_arg); + +} + +void +loaded(int to, void *to_arg) +{ + int i; + int old = 0; + int cur = 0; + Eterm* code; + + /* + * Calculate and print totals. + */ + for (i = 0; i < module_code_size(); i++) { + if (module_code(i) != NULL && + ((module_code(i)->code_length != 0) || + (module_code(i)->old_code_length != 0))) { + cur += module_code(i)->code_length; + if (module_code(i)->old_code_length != 0) { + old += module_code(i)->old_code_length; + } + } + } + erts_print(to, to_arg, "Current code: %d\n", cur); + erts_print(to, to_arg, "Old code: %d\n", old); + + /* + * Print one line per module. + */ + + for (i = 0; i < module_code_size(); i++) { + if (!ERTS_IS_CRASH_DUMPING) { + /* + * Interactive dump; keep it brief. + */ + if (module_code(i) != NULL && + ((module_code(i)->code_length != 0) || + (module_code(i)->old_code_length != 0))) { + erts_print(to, to_arg, "%T", make_atom(module_code(i)->module)); + cur += module_code(i)->code_length; + erts_print(to, to_arg, " %d", module_code(i)->code_length ); + if (module_code(i)->old_code_length != 0) { + erts_print(to, to_arg, " (%d old)", + module_code(i)->old_code_length ); + old += module_code(i)->old_code_length; + } + erts_print(to, to_arg, "\n"); + } + } else { + /* + * To crash dump; make it parseable. + */ + if (module_code(i) != NULL && + ((module_code(i)->code_length != 0) || + (module_code(i)->old_code_length != 0))) { + erts_print(to, to_arg, "=mod:"); + erts_print(to, to_arg, "%T", make_atom(module_code(i)->module)); + erts_print(to, to_arg, "\n"); + erts_print(to, to_arg, "Current size: %d\n", + module_code(i)->code_length); + code = module_code(i)->code; + if (code != NULL && code[MI_ATTR_PTR]) { + erts_print(to, to_arg, "Current attributes: "); + dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR], + code[MI_ATTR_SIZE]); + } + if (code != NULL && code[MI_COMPILE_PTR]) { + erts_print(to, to_arg, "Current compilation info: "); + dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR], + code[MI_COMPILE_SIZE]); + } + + if (module_code(i)->old_code_length != 0) { + erts_print(to, to_arg, "Old size: %d\n", module_code(i)->old_code_length); + code = module_code(i)->old_code; + if (code[MI_ATTR_PTR]) { + erts_print(to, to_arg, "Old attributes: "); + dump_attributes(to, to_arg, (byte *) code[MI_ATTR_PTR], + code[MI_ATTR_SIZE]); + } + if (code[MI_COMPILE_PTR]) { + erts_print(to, to_arg, "Old compilation info: "); + dump_attributes(to, to_arg, (byte *) code[MI_COMPILE_PTR], + code[MI_COMPILE_SIZE]); + } + } + } + } + } +} + + +static void +dump_attributes(int to, void *to_arg, byte* ptr, int size) +{ + while (size-- > 0) { + erts_print(to, to_arg, "%02X", *ptr++); + } + erts_print(to, to_arg, "\n"); +} + + +void +do_break(void) +{ + int i; +#ifdef __WIN32__ + char *mode; /* enough for storing "window" */ + + /* check if we're in console mode and, if so, + halt immediately if break is called */ + mode = erts_read_env("ERL_CONSOLE_MODE"); + if (mode && strcmp(mode, "window") != 0) + erl_exit(0, ""); + erts_free_read_env(mode); +#endif /* __WIN32__ */ + + erts_printf("\n" + "BREAK: (a)bort (c)ontinue (p)roc info (i)nfo (l)oaded\n" + " (v)ersion (k)ill (D)b-tables (d)istribution\n"); + + while (1) { + if ((i = sys_get_key(0)) <= 0) + erl_exit(0, ""); + switch (i) { + case 'q': + case 'a': + case '*': /* + * The asterisk is an read error on windows, + * where sys_get_key isn't that great in console mode. + * The usual reason for a read error is Ctrl-C. Treat this as + * 'a' to avoid infinite loop. + */ + erl_exit(0, ""); + case 'A': /* Halt generating crash dump */ + erl_exit(1, "Crash dump requested by user"); + case 'c': + return; + case 'p': + process_info(ERTS_PRINT_STDOUT, NULL); + return; + case 'm': + return; + case 'o': + port_info(ERTS_PRINT_STDOUT, NULL); + return; + case 'i': + info(ERTS_PRINT_STDOUT, NULL); + return; + case 'l': + loaded(ERTS_PRINT_STDOUT, NULL); + return; + case 'v': + erts_printf("Erlang (%s) emulator version " + ERLANG_VERSION "\n", + EMULATOR); + erts_printf("Compiled on " ERLANG_COMPILE_DATE "\n"); + return; + case 'd': + distribution_info(ERTS_PRINT_STDOUT, NULL); + return; + case 'D': + db_info(ERTS_PRINT_STDOUT, NULL, 1); + return; + case 'k': + process_killer(); + return; +#ifdef OPPROF + case 'X': + dump_frequencies(); + return; + case 'x': + { + int i; + for (i = 0; i <= HIGHEST_OP; i++) { + if (opc[i].name != NULL) { + erts_printf("%-16s %8d\n", opc[i].name, opc[i].count); + } + } + } + return; + case 'z': + { + int i; + for (i = 0; i <= HIGHEST_OP; i++) + opc[i].count = 0; + } + return; +#endif +#ifdef DEBUG + case 't': + p_slpq(); + return; + case 'b': + bin_check(); + return; + case 'C': + abort(); +#endif + case '\n': + continue; + default: + erts_printf("Eh?\n\n"); + } + } + +} + + +#ifdef OPPROF +static void +dump_frequencies(void) +{ + int i; + FILE* fp; + time_t now; + static char name[] = "op_freq.dump"; + + fp = fopen(name, "w"); + if (fp == NULL) { + fprintf(stderr, "Failed to open %s for writing\n", name); + return; + } + + time(&now); + fprintf(fp, "# Generated %s\n", ctime(&now)); + + for (i = 0; i <= HIGHEST_OP; i++) { + if (opc[i].name != NULL) { + fprintf(fp, "%s %d\n", opc[i].name, opc[i].count); + } + } + fclose(fp); + erts_printf("Frequencies dumped to %s\n", name); +} +#endif + + +#ifdef DEBUG + +static void +bin_check(void) +{ + Process *rp; + ProcBin *bp; + int i, printed; + + for (i=0; i < erts_max_processes; i++) { + if ((rp = process_tab[i]) == NULL) + continue; + if (!(bp = rp->off_heap.mso)) + continue; + printed = 0; + while (bp) { + if (printed == 0) { + erts_printf("Process %T holding binary data \n", rp->id); + printed = 1; + } + erts_printf("0x%08lx orig_size: %ld, norefs = %ld\n", + (unsigned long)bp->val, + (long)bp->val->orig_size, + erts_smp_atomic_read(&bp->val->refc)); + + bp = bp->next; + } + if (printed == 1) + erts_printf("--------------------------------------\n"); + } + /* db_bin_check() has to be rewritten for the AVL trees... */ + /*db_bin_check();*/ +} + +#endif + +/* XXX THIS SHOULD BE IN SYSTEM !!!! */ +void +erl_crash_dump_v(char *file, int line, char* fmt, va_list args) +{ + int fd; + time_t now; + size_t dumpnamebufsize = MAXPATHLEN; + char dumpnamebuf[MAXPATHLEN]; + char* dumpname; + + if (ERTS_IS_CRASH_DUMPING) + return; + + /* Wait for all threads to block. If all threads haven't blocked + * after a minute, we go anyway and hope for the best... + * + * We do not release system again. We expect an exit() or abort() after + * dump has been written. + * + * NOTE: We allow gc therefore it is important not to lock *any* + * process locks. + */ + erts_smp_emergency_block_system(60000, ERTS_BS_FLG_ALLOW_GC); + /* Either worked or not... */ + + /* Allow us to pass certain places without locking... */ +#ifdef ERTS_SMP + erts_smp_atomic_inc(&erts_writing_erl_crash_dump); +#else + erts_writing_erl_crash_dump = 1; +#endif + + erts_sys_prepare_crash_dump(); + + if (erts_sys_getenv("ERL_CRASH_DUMP",&dumpnamebuf[0],&dumpnamebufsize) != 0) + dumpname = "erl_crash.dump"; + else + dumpname = &dumpnamebuf[0]; + + fd = open(dumpname,O_WRONLY | O_CREAT | O_TRUNC,0640); + if (fd < 0) + return; /* Can't create the crash dump, skip it */ + + time(&now); + erts_fdprintf(fd, "=erl_crash_dump:0.1\n%s", ctime(&now)); + + if (file != NULL) + erts_fdprintf(fd, "The error occurred in file %s, line %d\n", file, line); + + if (fmt != NULL && *fmt != '\0') { + erts_fdprintf(fd, "Slogan: "); + erts_vfdprintf(fd, fmt, args); + } + erts_fdprintf(fd, "System version: "); + erts_print_system_version(fd, NULL, NULL); + erts_fdprintf(fd, "%s\n", "Compiled: " ERLANG_COMPILE_DATE); + erts_fdprintf(fd, "Atoms: %d\n", atom_table_size()); + info(fd, NULL); /* General system info */ + if (process_tab != NULL) /* XXX true at init */ + process_info(fd, NULL); /* Info about each process and port */ + db_info(fd, NULL, 0); + erts_print_bif_timer_info(fd, NULL); + distribution_info(fd, NULL); + erts_fdprintf(fd, "=loaded_modules\n"); + loaded(fd, NULL); + erts_dump_fun_entries(fd, NULL); + erts_deep_process_dump(fd, NULL); + erts_fdprintf(fd, "=atoms\n"); + dump_atoms(fd, NULL); + + /* Keep the instrumentation data at the end of the dump */ + if (erts_instr_memory_map || erts_instr_stat) { + erts_fdprintf(fd, "=instr_data\n"); + + if (erts_instr_stat) { + erts_fdprintf(fd, "=memory_status\n"); + erts_instr_dump_stat_to_fd(fd, 0); + } + if (erts_instr_memory_map) { + erts_fdprintf(fd, "=memory_map\n"); + erts_instr_dump_memory_map_to_fd(fd); + } + } + + erts_fdprintf(fd, "=end\n"); + close(fd); + erts_fprintf(stderr,"\nCrash dump was written to: %s\n", dumpname); +} + +void +erl_crash_dump(char* file, int line, char* fmt, ...) +{ + va_list args; + + va_start(args, fmt); + erl_crash_dump_v(file, line, fmt, args); + va_end(args); +} diff --git a/erts/emulator/beam/copy.c b/erts/emulator/beam/copy.c new file mode 100644 index 0000000000..0a5050b1fe --- /dev/null +++ b/erts/emulator/beam/copy.c @@ -0,0 +1,981 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "erl_gc.h" +#include "erl_nmgc.h" +#include "big.h" +#include "erl_binary.h" +#include "erl_bits.h" + +#ifdef HYBRID +MA_STACK_DECLARE(src); +MA_STACK_DECLARE(dst); +MA_STACK_DECLARE(offset); +#endif + +void +init_copy(void) +{ +#ifdef HYBRID + MA_STACK_ALLOC(src); + MA_STACK_ALLOC(dst); + MA_STACK_ALLOC(offset); +#endif +} + +/* + * Copy object "obj" to process p. + */ +Eterm +copy_object(Eterm obj, Process* to) +{ + Uint size = size_object(obj); + Eterm* hp = HAlloc(to, size); + Eterm res; + + res = copy_struct(obj, size, &hp, &to->off_heap); +#ifdef DEBUG + if (eq(obj, res) == 0) { + erl_exit(ERTS_ABORT_EXIT, "copy not equal to source\n"); + } +#endif + return res; +} + +/* + * Return the "flat" size of the object. + */ + +Uint +size_object(Eterm obj) +{ + Uint sum = 0; + Eterm* ptr; + int arity; + + DECLARE_ESTACK(s); + for (;;) { + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: + sum += 2; + ptr = list_val(obj); + obj = *ptr++; + if (!IS_CONST(obj)) { + ESTACK_PUSH(s, obj); + } + obj = *ptr; + break; + case TAG_PRIMARY_BOXED: + { + Eterm hdr = *boxed_val(obj); + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + ptr = tuple_val(obj); + arity = header_arity(hdr); + sum += arity + 1; + if (arity == 0) { /* Empty tuple -- unusual. */ + goto size_common; + } + while (arity-- > 1) { + obj = *++ptr; + if (!IS_CONST(obj)) { + ESTACK_PUSH(s, obj); + } + } + obj = *++ptr; + break; + case FUN_SUBTAG: + { + Eterm* bptr = fun_val(obj); + ErlFunThing* funp = (ErlFunThing *) bptr; + unsigned eterms = 1 /* creator */ + funp->num_free; + unsigned sz = thing_arityval(hdr); + + sum += 1 /* header */ + sz + eterms; + bptr += 1 /* header */ + sz; + while (eterms-- > 1) { + obj = *bptr++; + if (!IS_CONST(obj)) { + ESTACK_PUSH(s, obj); + } + } + obj = *bptr; + break; + } + case SUB_BINARY_SUBTAG: + { + Eterm real_bin; + Uint offset; /* Not used. */ + Uint bitsize; + Uint bitoffs; + Uint extra_bytes; + Eterm hdr; + ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); + if ((bitsize + bitoffs) > 8) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 2; + } else if ((bitsize + bitoffs) > 0) { + sum += ERL_SUB_BIN_SIZE; + extra_bytes = 1; + } else { + extra_bytes = 0; + } + hdr = *binary_val(real_bin); + if (thing_subtag(hdr) == REFC_BINARY_SUBTAG) { + sum += PROC_BIN_SIZE; + } else { + sum += heap_bin_size(binary_size(obj)+extra_bytes); + } + goto size_common; + } + break; + case BIN_MATCHSTATE_SUBTAG: + erl_exit(ERTS_ABORT_EXIT, + "size_object: matchstate term not allowed"); + default: + sum += thing_arityval(hdr) + 1; + /* Fall through */ + size_common: + if (ESTACK_ISEMPTY(s)) { + DESTROY_ESTACK(s); + return sum; + } + obj = ESTACK_POP(s); + break; + } + } + break; + case TAG_PRIMARY_IMMED1: + if (ESTACK_ISEMPTY(s)) { + DESTROY_ESTACK(s); + return sum; + } + obj = ESTACK_POP(s); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "size_object: bad tag for %#x\n", obj); + } + } +} + +/* + * Copy a structure to a heap. + */ +Eterm +copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +{ + char* hstart; + Uint hsize; + Eterm* htop; + Eterm* hbot; + Eterm* hp; + Eterm* objp; + Eterm* tp; + Eterm res; + Eterm elem; + Eterm* tailp; + Eterm* argp; + Eterm* const_tuple; + Eterm hdr; + int i; +#ifdef DEBUG + Eterm org_obj = obj; + Uint org_sz = sz; +#endif + + if (IS_CONST(obj)) + return obj; + + hp = htop = *hpp; + hbot = htop + sz; + hstart = (char *)htop; + hsize = (char*) hbot - hstart; + const_tuple = 0; + + /* Copy the object onto the heap */ + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: argp = &res; goto L_copy_list; + case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed; + default: + erl_exit(ERTS_ABORT_EXIT, + "%s, line %d: Internal error in copy_struct: 0x%08x\n", + __FILE__, __LINE__,obj); + } + + L_copy: + while (hp != htop) { + obj = *hp; + + switch (primary_tag(obj)) { + case TAG_PRIMARY_IMMED1: + hp++; + break; + case TAG_PRIMARY_LIST: + objp = list_val(obj); + if (in_area(objp,hstart,hsize)) { + hp++; + break; + } + argp = hp++; + /* Fall through */ + + L_copy_list: + tailp = argp; + while (is_list(obj)) { + objp = list_val(obj); + tp = tailp; + elem = *objp; + if (IS_CONST(elem)) { + *(hbot-2) = elem; + tailp = hbot-1; + hbot -= 2; + } + else { + *htop = elem; + tailp = htop+1; + htop += 2; + } + *tp = make_list(tailp - 1); + obj = *(objp+1); + } + switch (primary_tag(obj)) { + case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy; + case TAG_PRIMARY_BOXED: argp = tailp; goto L_copy_boxed; + default: + erl_exit(ERTS_ABORT_EXIT, + "%s, line %d: Internal error in copy_struct: 0x%08x\n", + __FILE__, __LINE__,obj); + } + + case TAG_PRIMARY_BOXED: + if (in_area(boxed_val(obj),hstart,hsize)) { + hp++; + break; + } + argp = hp++; + + L_copy_boxed: + objp = boxed_val(obj); + hdr = *objp; + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + { + int const_flag = 1; /* assume constant tuple */ + i = arityval(hdr); + *argp = make_tuple(htop); + tp = htop; /* tp is pointer to new arity value */ + *htop++ = *objp++; /* copy arity value */ + while (i--) { + elem = *objp++; + if (!IS_CONST(elem)) { + const_flag = 0; + } + *htop++ = elem; + } + if (const_flag) { + const_tuple = tp; /* this is the latest const_tuple */ + } + } + break; + case REFC_BINARY_SUBTAG: + { + ProcBin* pb; + + pb = (ProcBin *) objp; + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + i = thing_arityval(*objp) + 1; + hbot -= i; + tp = hbot; + while (i--) { + *tp++ = *objp++; + } + *argp = make_binary(hbot); + pb = (ProcBin*) hbot; + erts_refc_inc(&pb->val->refc, 2); + pb->next = off_heap->mso; + pb->flags = 0; + off_heap->mso = pb; + off_heap->overhead += pb->size / sizeof(Eterm); + } + break; + case SUB_BINARY_SUBTAG: + { + ErlSubBin* sb = (ErlSubBin *) objp; + Eterm real_bin = sb->orig; + Uint bit_offset = sb->bitoffs; + Uint bit_size = sb -> bitsize; + Uint offset = sb->offs; + size_t size = sb->size; + Uint extra_bytes; + Uint real_size; + if ((bit_size + bit_offset) > 8) { + extra_bytes = 2; + } else if ((bit_size + bit_offset) > 0) { + extra_bytes = 1; + } else { + extra_bytes = 0; + } + real_size = size+extra_bytes; + objp = binary_val(real_bin); + if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { + ErlHeapBin* from = (ErlHeapBin *) objp; + ErlHeapBin* to; + i = heap_bin_size(real_size); + hbot -= i; + to = (ErlHeapBin *) hbot; + to->thing_word = header_heap_bin(real_size); + to->size = real_size; + sys_memcpy(to->data, ((byte *)from->data)+offset, real_size); + } else { + ProcBin* from = (ProcBin *) objp; + ProcBin* to; + + ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG); + if (from->flags) { + erts_emasculate_writable_binary(from); + } + hbot -= PROC_BIN_SIZE; + to = (ProcBin *) hbot; + to->thing_word = HEADER_PROC_BIN; + to->size = real_size; + to->val = from->val; + erts_refc_inc(&to->val->refc, 2); + to->bytes = from->bytes + offset; + to->next = off_heap->mso; + to->flags = 0; + off_heap->mso = to; + off_heap->overhead += to->size / sizeof(Eterm); + } + *argp = make_binary(hbot); + if (extra_bytes != 0) { + ErlSubBin* res; + hbot -= ERL_SUB_BIN_SIZE; + res = (ErlSubBin *) hbot; + res->thing_word = HEADER_SUB_BIN; + res->size = size; + res->bitsize = bit_size; + res->bitoffs = bit_offset; + res->offs = 0; + res->is_writable = 0; + res->orig = *argp; + *argp = make_binary(hbot); + } + break; + } + break; + case FUN_SUBTAG: + { + ErlFunThing* funp = (ErlFunThing *) objp; + + i = thing_arityval(hdr) + 2 + funp->num_free; + tp = htop; + while (i--) { + *htop++ = *objp++; + } +#ifndef HYBRID /* FIND ME! */ + funp = (ErlFunThing *) tp; + funp->next = off_heap->funs; + off_heap->funs = funp; + erts_refc_inc(&funp->fe->refc, 2); +#endif + *argp = make_fun(tp); + } + break; + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: + { + ExternalThing *etp = (ExternalThing *) htop; + + i = thing_arityval(hdr) + 1; + tp = htop; + + while (i--) { + *htop++ = *objp++; + } + + etp->next = off_heap->externals; + off_heap->externals = etp; + erts_refc_inc(&etp->node->refc, 2); + + *argp = make_external(tp); + } + break; + case BIN_MATCHSTATE_SUBTAG: + erl_exit(ERTS_ABORT_EXIT, + "copy_struct: matchstate term not allowed"); + default: + i = thing_arityval(hdr)+1; + hbot -= i; + tp = hbot; + *argp = make_boxed(hbot); + while (i--) { + *tp++ = *objp++; + } + } + break; + case TAG_PRIMARY_HEADER: + if (header_is_thing(obj) || hp == const_tuple) { + hp += header_arity(obj) + 1; + } else { + hp++; + } + break; + } + } + +#ifdef DEBUG + if (htop != hbot) + erl_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct() when copying %T:" + " htop=%p != hbot=%p (sz=%bpu)\n", + org_obj, htop, hbot, org_sz); +#else + if (htop > hbot) { + erl_exit(ERTS_ABORT_EXIT, + "Internal error in copy_struct(): htop, hbot overrun\n"); + } +#endif + *hpp = (Eterm *) (hstart+hsize); + return res; +} + +#ifdef HYBRID + +#ifdef BM_MESSAGE_SIZES +# define BM_ADD(var,val) (var) += (val); +#else +# define BM_ADD(var,val) +#endif + +#ifdef DEBUG +# define CLEARMEM(PTR,SIZE) memset(PTR,0,SIZE*sizeof(Eterm)) +#else +# define CLEARMEM(PTR,SIZE) +#endif + +#ifdef INCREMENTAL +#define GlobalAlloc(p, need, hp) \ +do { \ + Uint n = (need); \ + BM_ADD(words_copied,n); \ + BM_SWAP_TIMER(copy,system); \ + /* If a new collection cycle is started during copy, the message * \ + * will end up in the old generation and all allocations * \ + * thereafter must go directly into the old generation. */ \ + if (alloc_old) { \ + erts_incremental_gc((p),n,&dest,1); \ + (hp) = erts_inc_alloc(n); \ + } else { \ + (hp) = IncAlloc((p),n,&dest,1); \ + if (ma_gc_flags & GC_CYCLE_START) { \ + alloc_old = 1; \ + global_htop = global_heap; \ + (hp) = erts_inc_alloc(n); \ + } \ + } \ + CLEARMEM((hp),(n)); \ + BM_SWAP_TIMER(system,copy); \ +} while(0) + +#else /* no INCREMELNTAL */ + +#define GlobalAlloc(p, need, hp) \ +do { \ + Uint n = (need); \ + total_need += n; \ + if (total_need >= global_heap_sz) \ + erl_exit(ERTS_ABORT_EXIT, "Copying a message (%d words) larger than the nursery simply won't work...\n", total_need); \ + if (global_hend - n < global_htop) { \ + BM_SWAP_TIMER(copy,system); \ + erts_global_garbage_collect((p),total_need,NULL,0); \ + BM_SWAP_TIMER(system,copy); \ + total_need = 0; \ + ma_src_top = 0; \ + ma_dst_top = 0; \ + ma_offset_top = 0; \ + goto copy_start; \ + } \ + (hp) = global_htop; \ + global_htop += n; \ + BM_ADD(words_copied,n); \ +} while(0) +#endif /* INCREMENTAL */ + +/* Copy a message to the message area. */ +Eterm copy_struct_lazy(Process *from, Eterm orig, Uint offs) +{ + Eterm obj; + Eterm dest; +#ifdef INCREMENTAL + int alloc_old = 0; +#else + int total_need = 0; +#endif + + VERBOSE(DEBUG_MESSAGES, + ("COPY START; %T is sending a message @ 0x%016x\n%T\n", + from->id, orig, orig)); + +#ifndef INCREMENTAL + copy_start: +#endif + MA_STACK_PUSH(src,orig); + MA_STACK_PUSH(dst,&dest); + MA_STACK_PUSH(offset,offs); + + while (ma_src_top > 0) { + obj = MA_STACK_POP(src); + + /* copy_struct_lazy should never be called with something that + * do not need to be copied. Within the loop, nothing that do + * not need copying should be placed in the src-stack. + */ + ASSERT(!NO_COPY(obj)); + + switch (primary_tag(obj)) { + case TAG_PRIMARY_LIST: { + Eterm *hp; + Eterm *objp; + + GlobalAlloc(from,2,hp); + objp = list_val(obj); + + MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_list(hp)); + MA_STACK_POP(dst); + + /* TODO: Byt ordningen nedan sÃ¥ att CDR pushas först. */ + + if (NO_COPY(*objp)) { + hp[0] = *objp; +#ifdef INCREMENTAL + if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend)) + INC_STORE(gray,hp,2); +#endif + } else { + MA_STACK_PUSH(src,*objp); + MA_STACK_PUSH(dst,hp); + MA_STACK_PUSH(offset,0); + } + + objp++; + + if (NO_COPY(*objp)) { + hp[1] = *objp; +#ifdef INCREMENTAL + if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend)) + INC_STORE(gray,hp,2); +#endif + } + else { + MA_STACK_PUSH(src,*objp); + MA_STACK_PUSH(dst,hp); + MA_STACK_PUSH(offset,1); + } + continue; + } + + case TAG_PRIMARY_BOXED: { + Eterm *objp = boxed_val(obj); + + switch (*objp & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: { + Uint ari = arityval(*objp); + Uint i; + Eterm *hp; + GlobalAlloc(from,ari + 1,hp); + /* A GC above might invalidate the value of objp */ + objp = boxed_val(obj); + MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_tuple(hp)); + MA_STACK_POP(dst); + *hp = *objp++; + for (i = 1; i <= ari; i++) { + switch (primary_tag(*objp)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + if (NO_COPY(*objp)) { + hp[i] = *objp; +#ifdef INCREMENTAL + if (ptr_within(ptr_val(*objp), + inc_fromspc,inc_fromend)) + INC_STORE(gray,hp,BOXED_NEED(hp,*hp)); +#endif + objp++; + } else { + MA_STACK_PUSH(src,*objp++); + MA_STACK_PUSH(dst,hp); + MA_STACK_PUSH(offset,i); + } + break; + default: + hp[i] = *objp++; + } + } + continue; + } + + case REFC_BINARY_SUBTAG: { + ProcBin *pb; + Uint i = thing_arityval(*objp) + 1; + Eterm *hp; + GlobalAlloc(from,i,hp); + /* A GC above might invalidate the value of objp */ + objp = boxed_val(obj); + MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_binary(hp)); + MA_STACK_POP(dst); + pb = (ProcBin*) hp; + while (i--) { + *hp++ = *objp++; + } + erts_refc_inc(&pb->val->refc, 2); + pb->next = erts_global_offheap.mso; + erts_global_offheap.mso = pb; + erts_global_offheap.overhead += pb->size / sizeof(Eterm); + continue; + } + + case FUN_SUBTAG: { + ErlFunThing *funp = (ErlFunThing*) objp; + Uint i = thing_arityval(*objp) + 1; + Uint j = i + 1 + funp->num_free; + Uint k = i; + Eterm *hp, *hp_start; + GlobalAlloc(from,j,hp); + /* A GC above might invalidate the value of objp */ + objp = boxed_val(obj); + hp_start = hp; + MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_fun(hp)); + MA_STACK_POP(dst); + funp = (ErlFunThing*) hp; + while (i--) { + *hp++ = *objp++; + } +#ifndef HYBRID // FIND ME! + funp->next = erts_global_offheap.funs; + erts_global_offheap.funs = funp; + erts_refc_inc(&funp->fe->refc, 2); +#endif + for (i = k; i < j; i++) { + switch (primary_tag(*objp)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + if (NO_COPY(*objp)) { +#ifdef INCREMENTAL + if (ptr_within(ptr_val(*objp), + inc_fromspc,inc_fromend)) + INC_STORE(gray,hp,BOXED_NEED(hp,*hp)); +#endif + *hp++ = *objp++; + } else { + MA_STACK_PUSH(src,*objp++); + MA_STACK_PUSH(dst,hp_start); + MA_STACK_PUSH(offset,i); + hp++; + } + break; + default: + *hp++ = *objp++; + } + } + continue; + } + + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: { + ExternalThing *etp; + Uint i = thing_arityval(*objp) + 1; + Eterm *hp; + GlobalAlloc(from,i,hp); + /* A GC above might invalidate the value of objp */ + objp = boxed_val(obj); + MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_external(hp)); + MA_STACK_POP(dst); + etp = (ExternalThing*) hp; + while (i--) { + *hp++ = *objp++; + } + + etp->next = erts_global_offheap.externals; + erts_global_offheap.externals = etp; + erts_refc_inc(&etp->node->refc, 2); + continue; + } + + case SUB_BINARY_SUBTAG: { + ErlSubBin *sb = (ErlSubBin *) objp; + Eterm *hp; + Eterm res_binary; + Eterm real_bin = sb->orig; + Uint bit_offset = sb->bitoffs; + Uint bit_size = sb -> bitsize; + Uint sub_offset = sb->offs; + size_t size = sb->size; + Uint extra_bytes; + Uint real_size; + Uint sub_binary_heapneed; + if ((bit_size + bit_offset) > 8) { + extra_bytes = 2; + sub_binary_heapneed = ERL_SUB_BIN_SIZE; + } else if ((bit_size + bit_offset) > 0) { + extra_bytes = 1; + sub_binary_heapneed = ERL_SUB_BIN_SIZE; + } else { + extra_bytes = 0; + sub_binary_heapneed = 0; + } + + real_size = size+extra_bytes; + objp = binary_val(real_bin); + if (thing_subtag(*objp) == HEAP_BINARY_SUBTAG) { + ErlHeapBin *from_bin; + ErlHeapBin *to_bin; + Uint i = heap_bin_size(real_size); + GlobalAlloc(from,i+sub_binary_heapneed,hp); + from_bin = (ErlHeapBin *) objp; + to_bin = (ErlHeapBin *) hp; + to_bin->thing_word = header_heap_bin(real_size); + to_bin->size = real_size; + sys_memcpy(to_bin->data, ((byte *)from_bin->data) + + sub_offset, real_size); + res_binary = make_binary(to_bin); + hp += i; + } else { + ProcBin *from_bin; + ProcBin *to_bin; + + ASSERT(thing_subtag(*objp) == REFC_BINARY_SUBTAG); + from_bin = (ProcBin *) objp; + erts_refc_inc(&from_bin->val->refc, 2); + GlobalAlloc(from,PROC_BIN_SIZE+sub_binary_heapneed,hp); + to_bin = (ProcBin *) hp; + to_bin->thing_word = HEADER_PROC_BIN; + to_bin->size = real_size; + to_bin->val = from_bin->val; + to_bin->bytes = from_bin->bytes + sub_offset; + to_bin->next = erts_global_offheap.mso; + erts_global_offheap.mso = to_bin; + erts_global_offheap.overhead += to_bin->size / sizeof(Eterm); + res_binary=make_binary(to_bin); + hp += PROC_BIN_SIZE; + } + if (extra_bytes != 0) { + ErlSubBin* res; + res = (ErlSubBin *) hp; + res->thing_word = HEADER_SUB_BIN; + res->size = size; + res->bitsize = bit_size; + res->bitoffs = bit_offset; + res->offs = 0; + res->is_writable = 0; + res->orig = res_binary; + res_binary = make_binary(hp); + } + MA_STACK_UPDATE(dst,MA_STACK_POP(offset),res_binary); + MA_STACK_POP(dst); + continue; + } + + case BIN_MATCHSTATE_SUBTAG: + erl_exit(ERTS_ABORT_EXIT, + "copy_struct_lazy: matchstate term not allowed"); + + default: { + Uint size = thing_arityval(*objp) + 1; + Eterm *hp; + GlobalAlloc(from,size,hp); + /* A GC above might invalidate the value of objp */ + objp = boxed_val(obj); + MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_boxed(hp)); + MA_STACK_POP(dst); + while (size--) { + *hp++ = *objp++; + } + continue; + } + } + continue; + } + + case TAG_PRIMARY_HEADER: + ASSERT((obj & _TAG_HEADER_MASK) == ARITYVAL_SUBTAG); + { + Eterm *objp = &obj; + Uint ari = arityval(obj); + Uint i; + Eterm *hp; + GlobalAlloc(from,ari + 1,hp); + MA_STACK_UPDATE(dst,MA_STACK_POP(offset),make_tuple(hp)); + MA_STACK_POP(dst); + *hp = *objp++; + for (i = 1; i <= ari; i++) { + switch (primary_tag(*objp)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + if (NO_COPY(*objp)) { +#ifdef INCREMENTAL + if (ptr_within(ptr_val(*objp),inc_fromspc,inc_fromend)) + INC_STORE(gray,hp,ari + 1); +#endif + hp[i] = *objp++; + } else { + MA_STACK_PUSH(src,*objp++); + MA_STACK_PUSH(dst,hp); + MA_STACK_PUSH(offset,i); + } + break; + default: + hp[i] = *objp++; + } + } + continue; + } + + default: + erl_exit(ERTS_ABORT_EXIT, + "%s, line %d: Internal error in copy_struct_lazy: 0x%08x\n", + __FILE__, __LINE__,obj); + } + } + + VERBOSE(DEBUG_MESSAGES, + ("Copy allocated @ 0x%08lx:\n%T\n", + (unsigned long)ptr_val(dest),dest)); + + ma_gc_flags &= ~GC_CYCLE_START; + + ASSERT(eq(orig, dest)); + ASSERT(ma_src_top == 0); + ASSERT(ma_dst_top == 0); + ASSERT(ma_offset_top == 0); + return dest; +} + +#undef NO_COPY +#endif /* HYBRID */ + +/* + * Copy a term that is guaranteed to be contained in a single + * heap block. The heap block is copied word by word, and any + * pointers are offsetted to point correctly in the new location. + * + * Typically used to copy a term from an ets table. + * + * NOTE: Assumes that term is a tuple (ptr is an untagged tuple ptr). + */ +Eterm +copy_shallow(Eterm* ptr, Uint sz, Eterm** hpp, ErlOffHeap* off_heap) +{ + Eterm* tp = ptr; + Eterm* hp = *hpp; + Sint offs = hp - tp; + + while (sz--) { + Eterm val = *tp++; + + switch (primary_tag(val)) { + case TAG_PRIMARY_IMMED1: + *hp++ = val; + break; + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + *hp++ = offset_ptr(val, offs); + break; + case TAG_PRIMARY_HEADER: + *hp++ = val; + switch (val & _HEADER_SUBTAG_MASK) { + case ARITYVAL_SUBTAG: + break; + case REFC_BINARY_SUBTAG: + { + ProcBin* pb = (ProcBin *) (hp-1); + int tari = thing_arityval(val); + + sz -= tari; + while (tari--) { + *hp++ = *tp++; + } + erts_refc_inc(&pb->val->refc, 2); + pb->next = off_heap->mso; + off_heap->mso = pb; + off_heap->overhead += pb->size / sizeof(Eterm); + } + break; + case FUN_SUBTAG: + { +#ifndef HYBRID /* FIND ME! */ + ErlFunThing* funp = (ErlFunThing *) (hp-1); +#endif + int tari = thing_arityval(val); + + sz -= tari; + while (tari--) { + *hp++ = *tp++; + } +#ifndef HYBRID /* FIND ME! */ + funp->next = off_heap->funs; + off_heap->funs = funp; + erts_refc_inc(&funp->fe->refc, 2); +#endif + } + break; + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: + { + ExternalThing* etp = (ExternalThing *) (hp-1); + int tari = thing_arityval(val); + + sz -= tari; + while (tari--) { + *hp++ = *tp++; + } + etp->next = off_heap->externals; + off_heap->externals = etp; + erts_refc_inc(&etp->node->refc, 2); + } + break; + default: + { + int tari = header_arity(val); + + sz -= tari; + while (tari--) { + *hp++ = *tp++; + } + } + break; + } + break; + } + } + *hpp = hp; + return make_tuple(ptr + offs); +} diff --git a/erts/emulator/beam/decl.h b/erts/emulator/beam/decl.h new file mode 100644 index 0000000000..da1be29d53 --- /dev/null +++ b/erts/emulator/beam/decl.h @@ -0,0 +1,55 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __DECL_H__ +#define __DECL_H__ + +#if defined(__STDC__) || defined(_MSC_VER) +#define EXTERN_FUNCTION(t, f, x) extern t f x +#define FUNCTION(t, f, x) t f x +#define _DOTS_ ... +#define _VOID_ void +#elif defined(__cplusplus) +#define EXTERN_FUNCTION(f, x) extern "C" { f x } +#define FUNCTION(t, f, x) t f x +#define _DOTS_ ... +#define _VOID_ void +#else +#define EXTERN_FUNCTION(t, f, x) extern t f (/*x*/) +#define FUNCTION(t, f, x) t f (/*x*/) +#define _DOTS_ +#define _VOID_ +#endif + +/* +** Example of declarations +** +** EXTERN_FUNCTION(void, foo, (int, int, char)); +** FUNCTION(void, bar, (int, char)); +** +** struct funcs { +** FUNCTION(int*, (*f1), (int, int)); +** FUNCTION(void, (*f2), (int, char)); +** FUNCTION(void, (*f3), (_VOID_)); +** FUNCTION(int, (*f4), (char*, _DOTS_)); +** }; +** +*/ + +#endif diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c new file mode 100644 index 0000000000..e3094404e2 --- /dev/null +++ b/erts/emulator/beam/dist.c @@ -0,0 +1,3256 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * distribution of erlang messages to other nodes. + */ + + +/* define this to get a lot of debug output */ +/* #define ERTS_DIST_MSG_DBG */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERTS_WANT_EXTERNAL_TAGS + +#include +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "dist.h" +#include "bif.h" +#include "external.h" +#include "erl_binary.h" + +/* Turn this on to get printouts of all distribution messages + * which go on the line + */ +#if 0 +#define ERTS_DIST_MSG_DBG +#endif +#if 0 +#define ERTS_RAW_DIST_MSG_DBG +#endif + +#if defined(ERTS_DIST_MSG_DBG) || defined(ERTS_RAW_DIST_MSG_DBG) +static void bw(byte *buf, int sz) +{ + bin_write(ERTS_PRINT_STDERR,NULL,buf,sz); +} +#endif + +#ifdef ERTS_DIST_MSG_DBG +static void +dist_msg_dbg(ErtsDistExternal *edep, char *what, byte *buf, int sz) +{ + byte *extp = edep->extp; + Eterm msg; + Sint size = erts_decode_dist_ext_size(edep, 0); + if (size < 0) { + erts_fprintf(stderr, + "DIST MSG DEBUG: erts_decode_dist_ext_size(%s) failed:\n", + what); + bw(buf, sz); + } + else { + Eterm *hp; + ErlHeapFragment *mbuf = new_message_buffer(size); + hp = mbuf->mem; + msg = erts_decode_dist_ext(&hp, &mbuf->off_heap, edep); + if (is_value(msg)) + erts_fprintf(stderr, " %s: %T\n", what, msg); + else { + erts_fprintf(stderr, + "DIST MSG DEBUG: erts_decode_dist_ext(%s) failed:\n", + what); + bw(buf, sz); + } + free_message_buffer(mbuf); + edep->extp = extp; + } +} + +#endif + + + +#define PASS_THROUGH 'p' /* This code should go */ + +int erts_is_alive; /* System must be blocked on change */ + +/* distribution trap functions */ +Export* dsend2_trap = NULL; +Export* dsend3_trap = NULL; +/*Export* dsend_nosuspend_trap = NULL;*/ +Export* dlink_trap = NULL; +Export* dunlink_trap = NULL; +Export* dmonitor_node_trap = NULL; +Export* dgroup_leader_trap = NULL; +Export* dexit_trap = NULL; +Export* dmonitor_p_trap = NULL; + +/* local variables */ + + +/* forward declarations */ + +static void clear_dist_entry(DistEntry*); +static int dsig_send(ErtsDSigData *, Eterm, Eterm, int); +static void send_nodes_mon_msgs(Process *, Eterm, Eterm, Eterm, Eterm); +static void init_nodes_monitors(void); + +static erts_smp_atomic_t no_caches; + +static void +delete_cache(ErtsAtomCache *cache) +{ + if (cache) { + erts_free(ERTS_ALC_T_DCACHE, (void *) cache); + ASSERT(erts_smp_atomic_read(&no_caches) > 0); + erts_smp_atomic_dec(&no_caches); + } +} + + +static void +create_cache(DistEntry *dep) +{ + int i; + ErtsAtomCache *cp; + + ERTS_SMP_LC_ASSERT( + is_internal_port(dep->cid) + && erts_lc_is_port_locked(&erts_port[internal_port_index(dep->cid)])); + ASSERT(!dep->cache); + + dep->cache = cp = (ErtsAtomCache*) erts_alloc(ERTS_ALC_T_DCACHE, + sizeof(ErtsAtomCache)); + erts_smp_atomic_inc(&no_caches); + for (i = 0; i < sizeof(cp->in_arr)/sizeof(cp->in_arr[0]); i++) { + cp->in_arr[i] = THE_NON_VALUE; + cp->out_arr[i] = THE_NON_VALUE; + } +} + +Uint erts_dist_cache_size(void) +{ + return (Uint) erts_smp_atomic_read(&no_caches)*sizeof(ErtsAtomCache); +} + +static ErtsProcList * +get_suspended_on_de(DistEntry *dep, Uint32 unset_qflgs) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_spinlock_is_locked(&dep->qlock)); + dep->qflgs &= ~unset_qflgs; + if (dep->qflgs & ERTS_DE_QFLG_EXIT) { + /* No resume when exit has been scheduled */ + return NULL; + } + else { + ErtsProcList *plp; + plp = dep->suspended.first; + dep->suspended.first = NULL; + dep->suspended.last = NULL; + return plp; + } +} + +/* +** A full node name constists of a "n@h" +** +** n must be a valid node name: string of ([a-z][A-Z][0-9]_-)+ +** +** h is not checked at all, we assume that we have a properly +** configured machine where the networking is ok for the OS +** +** We do check that there is not a second @ in the string, since +** many distributed operations are guaranteed not to work then. +*/ + + +static int is_node_name(char *ptr, int len) +{ + int c = '\0'; /* suppress use-before-set warning */ + int pos = 0; + + while (pos < len) { + c = ptr[pos++]; + if (! ((c == '-') || (c == '_') || + ((c >= 'a') && (c <= 'z')) || + ((c >= 'A') && (c <= 'Z')) || + ((c >= '0') && (c <= '9')))) + break; + } + + /* Scanned past the host name: now we want to see a '@', and there + should be text both before and after it. */ + if (c != '@' || pos < 2 || pos == len) + return 0; + + while (pos < len) { + c = ptr[pos++]; + if (c == '@') + return 0; + } + + return 1; +} + +int is_node_name_atom(Eterm a) +{ + int i; + if(is_not_atom(a)) + return 0; + i = atom_val(a); + ASSERT((i > 0) && (i < atom_table_size()) && (atom_tab(i) != NULL)); + return is_node_name((char*)atom_tab(i)->name, atom_tab(i)->len); +} + +typedef struct { + DistEntry *dep; +} NetExitsContext; + +/* +** This function is called when a distribution +** port or process terminates +*/ +static void doit_monitor_net_exits(ErtsMonitor *mon, void *vnecp) +{ + Process *rp; + ErtsMonitor *rmon; + DistEntry *dep = ((NetExitsContext *) vnecp)->dep; + ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK; + + rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks); + if (!rp) + goto done; + + if (mon->type == MON_ORIGIN) { + /* local pid is beeing monitored */ + rmon = erts_remove_monitor(&(rp->monitors),mon->ref); + /* ASSERT(rmon != NULL); nope, can happen during process exit */ + if (rmon != NULL) { + erts_destroy_monitor(rmon); + } + } else { + Eterm lhp[3]; + Eterm watched; + ASSERT(mon->type == MON_TARGET); + rmon = erts_remove_monitor(&(rp->monitors),mon->ref); + /* ASSERT(rmon != NULL); can happen during process exit */ + if (rmon != NULL) { + ASSERT(is_atom(rmon->name) || is_nil(rmon->name)); + watched = (is_atom(rmon->name) + ? TUPLE2(lhp, rmon->name, dep->sysname) + : rmon->pid); +#ifdef ERTS_SMP + rp_locks |= ERTS_PROC_LOCKS_MSG_SEND; + erts_smp_proc_lock(rp, ERTS_PROC_LOCKS_MSG_SEND); +#endif + erts_queue_monitor_message(rp, &rp_locks, mon->ref, am_process, + watched, am_noconnection); + erts_destroy_monitor(rmon); + } + } + erts_smp_proc_unlock(rp, rp_locks); + done: + erts_destroy_monitor(mon); +} + +typedef struct { + NetExitsContext *necp; + ErtsLink *lnk; +} LinkNetExitsContext; + +/* +** This is the function actually doing the job of sending exit messages +** for links in a dist entry upon net_exit (the node goes down), NB, +** only process links, not node monitors are handled here, +** they reside in a separate tree.... +*/ +static void doit_link_net_exits_sub(ErtsLink *sublnk, void *vlnecp) +{ + ErtsLink *lnk = ((LinkNetExitsContext *) vlnecp)->lnk; /* the local pid */ + ErtsLink *rlnk; + Process *rp; + + ASSERT(lnk->type == LINK_PID); + if (is_internal_pid(lnk->pid)) { + int xres; + ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND; + + rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks); + if (!rp) { + goto done; + } + + rlnk = erts_remove_link(&(rp->nlinks), sublnk->pid); + xres = erts_send_exit_signal(NULL, + sublnk->pid, + rp, + &rp_locks, + am_noconnection, + NIL, + NULL, + 0); + + if (rlnk) { + erts_destroy_link(rlnk); + if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { + /* We didn't exit the process and it is traced */ + trace_proc(NULL, rp, am_getting_unlinked, sublnk->pid); + } + } + erts_smp_proc_unlock(rp, rp_locks); + } + done: + erts_destroy_link(sublnk); + +} + + + + + +/* +** This function is called when a distribution +** port or process terminates, once for each link on the high level, +** it in turn traverses the link subtree for the specific link node... +*/ +static void doit_link_net_exits(ErtsLink *lnk, void *vnecp) +{ + LinkNetExitsContext lnec = {(NetExitsContext *) vnecp, lnk}; + ASSERT(lnk->type == LINK_PID) + erts_sweep_links(ERTS_LINK_ROOT(lnk), &doit_link_net_exits_sub, (void *) &lnec); +#ifdef DEBUG + ERTS_LINK_ROOT(lnk) = NULL; +#endif + erts_destroy_link(lnk); +} + + +static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp) +{ + DistEntry *dep = ((NetExitsContext *) vnecp)->dep; + Eterm name = dep->sysname; + Process *rp; + ErtsLink *rlnk; + Uint i,n; + ASSERT(lnk->type == LINK_NODE) + if (is_internal_pid(lnk->pid)) { + ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK; + rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks); + if (!rp) { + goto done; + } + rlnk = erts_remove_link(&(rp->nlinks), name); + if (rlnk != NULL) { + ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE)); + erts_destroy_link(rlnk); + } + n = ERTS_LINK_REFC(lnk); + for (i = 0; i < n; ++i) { + ErlHeapFragment* bp; + ErlOffHeap *ohp; + Eterm tup; + Eterm *hp = erts_alloc_message_heap(3,&bp,&ohp,rp,&rp_locks); + tup = TUPLE2(hp, am_nodedown, name); + erts_queue_message(rp, &rp_locks, bp, tup, NIL); + } + erts_smp_proc_unlock(rp, rp_locks); + } + done: + erts_destroy_link(lnk); +} + + +/* + * proc is currently running or exiting process. + */ +int erts_do_net_exits(DistEntry *dep, Eterm reason) +{ + Eterm nodename; + + if (dep == erts_this_dist_entry) { /* Net kernel has died (clean up!!) */ + Eterm nd_reason = (reason == am_no_network + ? am_no_network + : am_net_kernel_terminated); + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + + /* KILL all port controllers */ + while(erts_visible_dist_entries || erts_hidden_dist_entries) { + DistEntry *tdep; + Eterm prt_id; + Port *prt; + if(erts_hidden_dist_entries) + tdep = erts_hidden_dist_entries; + else + tdep = erts_visible_dist_entries; + prt_id = tdep->cid; + ASSERT(is_internal_port(prt_id)); + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + + prt = erts_id2port(prt_id, NULL, 0); + if (prt) { + ASSERT(prt->status & ERTS_PORT_SFLG_DISTRIBUTION); + ASSERT(prt->dist_entry); + /* will call do_net_exists !!! */ + erts_do_exit_port(prt, prt_id, nd_reason); + erts_port_release(prt); + } + + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + } + + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + + nodename = erts_this_dist_entry->sysname; + erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); + erts_set_this_node(am_Noname, 0); + erts_is_alive = 0; + send_nodes_mon_msgs(NULL, am_nodedown, nodename, am_visible, nd_reason); + erts_smp_release_system(); + + } + else { /* recursive call via erts_do_exit_port() will end up here */ + NetExitsContext nec = {dep}; + ErtsLink *nlinks; + ErtsLink *node_links; + ErtsMonitor *monitors; + Uint32 flags; + + erts_smp_atomic_set(&dep->dist_cmd_scheduled, 1); + erts_smp_de_rwlock(dep); + + ERTS_SMP_LC_ASSERT(is_internal_port(dep->cid) + && erts_lc_is_port_locked(&erts_port[internal_port_index(dep->cid)])); + + if (erts_port_task_is_scheduled(&dep->dist_cmd)) + erts_port_task_abort(dep->cid, &dep->dist_cmd); + + if (dep->status & ERTS_DE_SFLG_EXITING) { +#ifdef DEBUG + erts_smp_spin_lock(&dep->qlock); + ASSERT(dep->qflgs & ERTS_DE_QFLG_EXIT); + erts_smp_spin_unlock(&dep->qlock); +#endif + } + else { + dep->status |= ERTS_DE_SFLG_EXITING; + erts_smp_spin_lock(&dep->qlock); + ASSERT(!(dep->qflgs & ERTS_DE_QFLG_EXIT)); + dep->qflgs |= ERTS_DE_QFLG_EXIT; + erts_smp_spin_unlock(&dep->qlock); + } + + erts_smp_de_links_lock(dep); + monitors = dep->monitors; + nlinks = dep->nlinks; + node_links = dep->node_links; + dep->monitors = NULL; + dep->nlinks = NULL; + dep->node_links = NULL; + erts_smp_de_links_unlock(dep); + + nodename = dep->sysname; + flags = dep->flags; + + erts_set_dist_entry_not_connected(dep); + + erts_smp_de_rwunlock(dep); + + erts_sweep_monitors(monitors, &doit_monitor_net_exits, (void *) &nec); + erts_sweep_links(nlinks, &doit_link_net_exits, (void *) &nec); + erts_sweep_links(node_links, &doit_node_link_net_exits, (void *) &nec); + + send_nodes_mon_msgs(NULL, + am_nodedown, + nodename, + flags & DFLAG_PUBLISHED ? am_visible : am_hidden, + reason == am_normal ? am_connection_closed : reason); + + clear_dist_entry(dep); + + } + return 1; +} + +static Export* +trap_function(Eterm func, int arity) +{ + return erts_export_put(am_erlang, func, arity); +} + +void init_dist(void) +{ + init_nodes_monitors(); + + erts_smp_atomic_init(&no_caches, 0); + + /* Lookup/Install all references to trap functions */ + dsend2_trap = trap_function(am_dsend,2); + dsend3_trap = trap_function(am_dsend,3); + /* dsend_nosuspend_trap = trap_function(am_dsend_nosuspend,2);*/ + dlink_trap = trap_function(am_dlink,1); + dunlink_trap = trap_function(am_dunlink,1); + dmonitor_node_trap = trap_function(am_dmonitor_node,3); + dgroup_leader_trap = trap_function(am_dgroup_leader,2); + dexit_trap = trap_function(am_dexit, 2); + dmonitor_p_trap = trap_function(am_dmonitor_p, 2); +} + +#define ErtsDistOutputBuf2Binary(OB) \ + ((Binary *) (((char *) (OB)) - offsetof(Binary, orig_bytes))) + +static ERTS_INLINE ErtsDistOutputBuf * +alloc_dist_obuf(Uint size) +{ + ErtsDistOutputBuf *obuf; + Uint obuf_size = sizeof(ErtsDistOutputBuf)+sizeof(byte)*(size-1); + Binary *bin = erts_bin_drv_alloc(obuf_size); + bin->flags = BIN_FLAG_DRV; + erts_refc_init(&bin->refc, 1); + bin->orig_size = (long) obuf_size; + obuf = (ErtsDistOutputBuf *) &bin->orig_bytes[0]; +#ifdef DEBUG + obuf->dbg_pattern = ERTS_DIST_OUTPUT_BUF_DBG_PATTERN; + ASSERT(bin == ErtsDistOutputBuf2Binary(obuf)); +#endif + return obuf; +} + +static ERTS_INLINE void +free_dist_obuf(ErtsDistOutputBuf *obuf) +{ + Binary *bin = ErtsDistOutputBuf2Binary(obuf); + ASSERT(obuf->dbg_pattern == ERTS_DIST_OUTPUT_BUF_DBG_PATTERN); + if (erts_refc_dectest(&bin->refc, 0) == 0) + erts_bin_free(bin); +} + +static ERTS_INLINE Sint +size_obuf(ErtsDistOutputBuf *obuf) +{ + Binary *bin = ErtsDistOutputBuf2Binary(obuf); + return bin->orig_size; +} + +static void clear_dist_entry(DistEntry *dep) +{ + Sint obufsize = 0; + ErtsAtomCache *cache; + ErtsProcList *suspendees; + ErtsDistOutputBuf *obuf; + + erts_smp_de_rwlock(dep); + cache = dep->cache; + dep->cache = NULL; + +#ifdef DEBUG + erts_smp_de_links_lock(dep); + ASSERT(!dep->nlinks); + ASSERT(!dep->node_links); + ASSERT(!dep->monitors); + erts_smp_de_links_unlock(dep); +#endif + + erts_smp_spin_lock(&dep->qlock); + + if (!dep->out_queue.last) + obuf = dep->finalized_out_queue.first; + else { + dep->out_queue.last->next = dep->finalized_out_queue.first; + obuf = dep->out_queue.first; + } + + dep->out_queue.first = NULL; + dep->out_queue.last = NULL; + dep->finalized_out_queue.first = NULL; + dep->finalized_out_queue.last = NULL; + dep->status = 0; + suspendees = get_suspended_on_de(dep, ERTS_DE_QFLGS_ALL); + + erts_smp_spin_unlock(&dep->qlock); + erts_smp_atomic_set(&dep->dist_cmd_scheduled, 0); + dep->send = NULL; + erts_smp_de_rwunlock(dep); + + erts_resume_processes(suspendees); + + delete_cache(cache); + + while (obuf) { + ErtsDistOutputBuf *fobuf; + fobuf = obuf; + obuf = obuf->next; + obufsize += size_obuf(fobuf); + free_dist_obuf(fobuf); + } + + if (obufsize) { + erts_smp_spin_lock(&dep->qlock); + ASSERT(dep->qsize >= obufsize); + dep->qsize -= obufsize; + erts_smp_spin_unlock(&dep->qlock); + } +} + +/* + * The erts_dsig_send_*() functions implemented below, sends asynchronous + * distributed signals to other Erlang nodes. Before sending a distributed + * signal, you need to prepare the operation by calling erts_dsig_prepare() + * (see dist.h). + * + * Note that the distributed signal send operation is truly asynchronous, + * and the signal is not guaranteed to reach the receiver if the connection + * goes down before the signal has reached the receiver. + */ + +/* +** Send a DOP_LINK link message +*/ +int +erts_dsig_send_link(ErtsDSigData *dsdp, Eterm local, Eterm remote) +{ + Eterm ctl_heap[4]; + Eterm ctl = TUPLE3(&ctl_heap[0], make_small(DOP_LINK), local, remote); + + return dsig_send(dsdp, ctl, THE_NON_VALUE, 0); +} + +int +erts_dsig_send_unlink(ErtsDSigData *dsdp, Eterm local, Eterm remote) +{ + Eterm ctl_heap[4]; + Eterm ctl = TUPLE3(&ctl_heap[0], make_small(DOP_UNLINK), local, remote); + + return dsig_send(dsdp, ctl, THE_NON_VALUE, 0); +} + + +/* A local process that's beeing monitored by a remote one exits. We send: + {DOP_MONITOR_P_EXIT, Local pid or name, Remote pid, ref, reason}, + which is rather sad as only the ref is needed, no pid's... */ +int +erts_dsig_send_m_exit(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, + Eterm ref, Eterm reason) +{ + Eterm ctl; + Eterm ctl_heap[6]; + + ctl = TUPLE5(&ctl_heap[0], make_small(DOP_MONITOR_P_EXIT), + watched, watcher, ref, reason); + +#ifdef DEBUG + erts_smp_de_links_lock(dsdp->dep); + ASSERT(!erts_lookup_monitor(dsdp->dep->monitors, ref)); + erts_smp_de_links_unlock(dsdp->dep); +#endif + + return dsig_send(dsdp, ctl, THE_NON_VALUE, 1); +} + +/* We want to monitor a process (named or unnamed) on another node, we send: + {DOP_MONITOR_P, Local pid, Remote pid or name, Ref}, which is exactly what's + needed on the other side... */ +int +erts_dsig_send_monitor(ErtsDSigData *dsdp, Eterm watcher, Eterm watched, + Eterm ref) +{ + Eterm ctl; + Eterm ctl_heap[5]; + + ctl = TUPLE4(&ctl_heap[0], + make_small(DOP_MONITOR_P), + watcher, watched, ref); + + return dsig_send(dsdp, ctl, THE_NON_VALUE, 0); +} + +/* A local process monitoring a remote one wants to stop monitoring, either + because of a demonitor bif call or because the local process died. We send + {DOP_DEMONITOR_P, Local pid, Remote pid or name, ref}, which is once again + rather redundant as only the ref will be needed on the other side... */ +int +erts_dsig_send_demonitor(ErtsDSigData *dsdp, Eterm watcher, + Eterm watched, Eterm ref, int force) +{ + Eterm ctl; + Eterm ctl_heap[5]; + + ctl = TUPLE4(&ctl_heap[0], + make_small(DOP_DEMONITOR_P), + watcher, watched, ref); + + return dsig_send(dsdp, ctl, THE_NON_VALUE, force); +} + +int +erts_dsig_send_msg(ErtsDSigData *dsdp, Eterm remote, Eterm message) +{ + Eterm ctl; + Eterm ctl_heap[5]; + Eterm token = NIL; + Process *sender = dsdp->proc; + + if (SEQ_TRACE_TOKEN(sender) != NIL) { + seq_trace_update_send(sender); + token = SEQ_TRACE_TOKEN(sender); + seq_trace_output(token, message, SEQ_TRACE_SEND, remote, sender); + } + + if (token != NIL) + ctl = TUPLE4(&ctl_heap[0], + make_small(DOP_SEND_TT), am_Cookie, remote, token); + else + ctl = TUPLE3(&ctl_heap[0], make_small(DOP_SEND), am_Cookie, remote); + return dsig_send(dsdp, ctl, message, 0); +} + +int +erts_dsig_send_reg_msg(ErtsDSigData *dsdp, Eterm remote_name, Eterm message) +{ + Eterm ctl; + Eterm ctl_heap[6]; + Eterm token = NIL; + Process *sender = dsdp->proc; + + if (SEQ_TRACE_TOKEN(sender) != NIL) { + seq_trace_update_send(sender); + token = SEQ_TRACE_TOKEN(sender); + seq_trace_output(token, message, SEQ_TRACE_SEND, remote_name, sender); + } + + if (token != NIL) + ctl = TUPLE5(&ctl_heap[0], make_small(DOP_REG_SEND_TT), + sender->id, am_Cookie, remote_name, token); + else + ctl = TUPLE4(&ctl_heap[0], make_small(DOP_REG_SEND), + sender->id, am_Cookie, remote_name); + return dsig_send(dsdp, ctl, message, 0); +} + +/* local has died, deliver the exit signal to remote */ +int +erts_dsig_send_exit_tt(ErtsDSigData *dsdp, Eterm local, Eterm remote, + Eterm reason, Eterm token) +{ + Eterm ctl; + Eterm ctl_heap[6]; + + if (token != NIL) { + seq_trace_update_send(dsdp->proc); + seq_trace_output_exit(token, reason, SEQ_TRACE_SEND, remote, local); + ctl = TUPLE5(&ctl_heap[0], + make_small(DOP_EXIT_TT), local, remote, token, reason); + } else { + ctl = TUPLE4(&ctl_heap[0], make_small(DOP_EXIT), local, remote, reason); + } + /* forced, i.e ignore busy */ + return dsig_send(dsdp, ctl, THE_NON_VALUE, 1); +} + +int +erts_dsig_send_exit(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason) +{ + Eterm ctl_heap[5]; + Eterm ctl = TUPLE4(&ctl_heap[0], + make_small(DOP_EXIT), local, remote, reason); + /* forced, i.e ignore busy */ + return dsig_send(dsdp, ctl, THE_NON_VALUE, 1); +} + +int +erts_dsig_send_exit2(ErtsDSigData *dsdp, Eterm local, Eterm remote, Eterm reason) +{ + Eterm ctl_heap[5]; + Eterm ctl = TUPLE4(&ctl_heap[0], + make_small(DOP_EXIT2), local, remote, reason); + + return dsig_send(dsdp, ctl, THE_NON_VALUE, 0); +} + + +int +erts_dsig_send_group_leader(ErtsDSigData *dsdp, Eterm leader, Eterm remote) +{ + Eterm ctl_heap[4]; + Eterm ctl = TUPLE3(&ctl_heap[0], + make_small(DOP_GROUP_LEADER), leader, remote); + + return dsig_send(dsdp, ctl, THE_NON_VALUE, 0); +} + +#if defined(PURIFY) +# define PURIFY_MSG(msg) \ + purify_printf("%s, line %d: %s", __FILE__, __LINE__, msg) +#elif defined(VALGRIND) +#include +#include + +# define PURIFY_MSG(msg) \ + do { \ + char buf__[1]; size_t bufsz__ = sizeof(buf__); \ + if (erts_sys_getenv("VALGRIND_LOG_XML", buf__, &bufsz__) >= 0) { \ + VALGRIND_PRINTF("" \ + "%s, line %d: %s\n", \ + __FILE__, __LINE__, msg); \ + } else { \ + VALGRIND_PRINTF("%s, line %d: %s", __FILE__, __LINE__, msg); \ + } \ + } while (0) +#else +# define PURIFY_MSG(msg) +#endif + +/* +** Input from distribution port. +** Input follows the distribution protocol v4.5 +** +** The protocol is a 4 byte header protocol +** the DOP_DATA is stripped by driver_output +** +** assert hlen == 0 !!! +*/ +int erts_net_message(Port *prt, + DistEntry *dep, + byte *hbuf, + int hlen, + byte *buf, + int len) +{ + ErtsDistExternal ede; + byte *t; + Sint ctl_len; + int orig_ctl_len; + Eterm arg; + Eterm from, to; + Eterm watcher, watched; + Eterm ref; + Eterm *tuple; + Eterm reason; + Process* rp; + Eterm ctl_default[64]; + Eterm* ctl = ctl_default; + ErlOffHeap off_heap; + Eterm* hp; + Sint type; + Eterm token; + Eterm token_size; + ErtsMonitor *mon; + ErtsLink *lnk; + int res; +#ifdef ERTS_DIST_MSG_DBG + int orig_len = len; +#endif + + /* Thanks to Luke Gorrie */ + off_heap.mso = NULL; +#ifndef HYBRID /* FIND ME! */ + off_heap.funs = NULL; +#endif + off_heap.overhead = 0; + off_heap.externals = NULL; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (!erts_is_alive) + return 0; + if (hlen > 0) + goto data_error; + if (len == 0) /* HANDLE TICK !!! */ + return 0; + +#ifdef ERTS_RAW_DIST_MSG_DBG + erts_fprintf(stderr, "<< "); + bw(buf, len); +#endif + + if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE) + t = buf; + else { + /* Skip PASS_THROUGH */ + t = buf+1; + len--; + } + + if (len == 0) { + PURIFY_MSG("data error"); + goto data_error; + } + + res = erts_prepare_dist_ext(&ede, t, len, dep, dep->cache); + + if (res >= 0) + res = ctl_len = erts_decode_dist_ext_size(&ede, 0); + else { +#ifdef ERTS_DIST_MSG_DBG + erts_fprintf(stderr, "DIST MSG DEBUG: erts_prepare_dist_ext() failed:\n"); + bw(buf, orig_len); +#endif + ctl_len = 0; + } + + if (res < 0) { +#ifdef ERTS_DIST_MSG_DBG + erts_fprintf(stderr, "DIST MSG DEBUG: erts_decode_dist_ext_size(CTL) failed:\n"); + bw(buf, orig_len); +#endif + PURIFY_MSG("data error"); + goto data_error; + } + orig_ctl_len = ctl_len; + if (ctl_len > sizeof(ctl_default)/sizeof(ctl_default[0])) { + ctl = erts_alloc(ERTS_ALC_T_DCTRL_BUF, ctl_len * sizeof(Eterm)); + } + hp = ctl; + + arg = erts_decode_dist_ext(&hp, &off_heap, &ede); + if (is_non_value(arg)) { +#ifdef ERTS_DIST_MSG_DBG + erts_fprintf(stderr, "DIST MSG DEBUG: erts_dist_ext_size(CTL) failed:\n"); + bw(buf, orig_len); +#endif + PURIFY_MSG("data error"); + goto data_error; + } + ctl_len = t - buf; + +#ifdef ERTS_DIST_MSG_DBG + erts_fprintf(stderr, "<<%s CTL: %T\n", len != orig_len ? "P" : " ", arg); +#endif + + if (is_not_tuple(arg) || + (tuple = tuple_val(arg), arityval(*tuple) < 1) || + is_not_small(tuple[1])) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Invalid distribution message: %.200T", arg); + erts_send_error_to_logger_nogl(dsbufp); + goto data_error; + } + + token_size = 0; + + switch (type = unsigned_val(tuple[1])) { + case DOP_LINK: + from = tuple[2]; + to = tuple[3]; /* local proc to link to */ + + if (is_not_pid(from) || is_not_pid(to)) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + PURIFY_MSG("data error"); + erts_dsprintf(dsbufp, + "Invalid DOP_LINK distribution message: %.200T", + arg); + erts_send_error_to_logger_nogl(dsbufp); + goto data_error; + } + + rp = erts_pid2proc_opt(NULL, 0, + to, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + if (!rp) { + /* This is tricky (we MUST force a distributed send) */ + ErtsDSigData dsd; + int code; + code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0); + if (code == ERTS_DSIG_PREP_CONNECTED) { + code = erts_dsig_send_exit(&dsd, to, from, am_noproc); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + break; + } + + erts_smp_de_links_lock(dep); + res = erts_add_link(&(rp->nlinks), LINK_PID, from); + + if (res < 0) { + /* It was already there! Lets skip the rest... */ + erts_smp_de_links_unlock(dep); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + break; + } + lnk = erts_add_or_lookup_link(&(dep->nlinks), LINK_PID, rp->id); + erts_add_link(&(ERTS_LINK_ROOT(lnk)), LINK_PID, from); + erts_smp_de_links_unlock(dep); + + if (IS_TRACED_FL(rp, F_TRACE_PROCS)) + trace_proc(NULL, rp, am_getting_linked, from); + + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + break; + + case DOP_UNLINK: { + ErtsDistLinkData dld; + from = tuple[2]; + to = tuple[3]; + + rp = erts_pid2proc_opt(NULL, 0, + to, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + if (!rp) + break; + + lnk = erts_remove_link(&(rp->nlinks), from); + + if (IS_TRACED_FL(rp, F_TRACE_PROCS) && lnk != NULL) { + trace_proc(NULL, rp, am_getting_unlinked, from); + } + + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + + erts_remove_dist_link(&dld, to, from, dep); + erts_destroy_dist_link(&dld); + if (lnk) + erts_destroy_link(lnk); + break; + } + + case DOP_MONITOR_P: { + /* A remote process wants to monitor us, we get: + {DOP_MONITOR_P, Remote pid, local pid or name, ref} */ + Eterm name; + + watcher = tuple[2]; + watched = tuple[3]; /* local proc to monitor */ + ref = tuple[4]; + + if (is_atom(watched)) { + name = watched; + rp = erts_whereis_process(NULL, 0, + watched, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + } + else { + name = NIL; + rp = erts_pid2proc_opt(NULL, 0, + watched, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + } + + if (!rp) { + ErtsDSigData dsd; + int code; + code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0); + if (code == ERTS_DSIG_PREP_CONNECTED) { + code = erts_dsig_send_m_exit(&dsd, watcher, watched, ref, + am_noproc); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + } + else { + if (is_atom(watched)) + watched = rp->id; + erts_smp_de_links_lock(dep); + erts_add_monitor(&(dep->monitors), MON_ORIGIN, ref, watched, name); + erts_add_monitor(&(rp->monitors), MON_TARGET, ref, watcher, name); + erts_smp_de_links_unlock(dep); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + } + + break; + } + + case DOP_DEMONITOR_P: + /* A remote node informs us that a local pid in no longer monitored + We get {DOP_DEMONITOR_P, Remote pid, Local pid or name, ref}, + We need only the ref of course */ + + /* watcher = tuple[2]; */ + /* watched = tuple[3]; May be an atom in case of monitor name */ + ref = tuple[4]; + + erts_smp_de_links_lock(dep); + mon = erts_remove_monitor(&(dep->monitors),ref); + erts_smp_de_links_unlock(dep); + /* ASSERT(mon != NULL); can happen in case of broken dist message */ + if (mon == NULL) { + break; + } + watched = mon->pid; + erts_destroy_monitor(mon); + rp = erts_pid2proc_opt(NULL, 0, + watched, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + if (!rp) { + break; + } + mon = erts_remove_monitor(&(rp->monitors),ref); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + ASSERT(mon != NULL); + if (mon == NULL) { + break; + } + erts_destroy_monitor(mon); + break; + + case DOP_NODE_LINK: /* XXX never sent ?? */ + break; + + case DOP_REG_SEND_TT: + token_size = size_object(tuple[5]); + /* Fall through ... */ + case DOP_REG_SEND: + /* {DOP_REG_SEND, From, Cookie, ToName} -- Message */ + /* {DOP_REG_SEND_TT, From, Cookie, ToName, TraceToken} -- Message */ + + /* + * There is intentionally no testing of the cookie (it is always '') + * from R9B and onwards. + */ +#ifdef ERTS_DIST_MSG_DBG + dist_msg_dbg(&ede, "MSG", buf, orig_len); +#endif + + from = tuple[2]; + to = tuple[4]; + rp = erts_whereis_process(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC); + if (rp) { + Uint xsize = (type == DOP_REG_SEND + ? 0 + : ERTS_HEAP_FRAG_SIZE(token_size)); + ErtsProcLocks locks = 0; + ErtsDistExternal *ede_copy; + + ede_copy = erts_make_dist_ext_copy(&ede, xsize); + if (type == DOP_REG_SEND) { + token = NIL; + } else { + ErlHeapFragment *heap_frag; + ErlOffHeap *ohp; + ASSERT(xsize); + heap_frag = erts_dist_ext_trailer(ede_copy); + ERTS_INIT_HEAP_FRAG(heap_frag, token_size); + hp = heap_frag->mem; + ohp = &heap_frag->off_heap; + token = tuple[5]; + token = copy_struct(token, token_size, &hp, ohp); + } + + erts_queue_dist_message(rp, &locks, ede_copy, token); + if (locks) + erts_smp_proc_unlock(rp, locks); + erts_smp_proc_dec_refc(rp); + } + break; + + case DOP_SEND_TT: + token_size = size_object(tuple[4]); + /* Fall through ... */ + case DOP_SEND: + /* + * There is intentionally no testing of the cookie (it is always '') + * from R9B and onwards. + */ +#ifdef ERTS_DIST_MSG_DBG + dist_msg_dbg(&ede, "MSG", buf, orig_len); +#endif + + to = tuple[3]; + rp = erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC); + if (rp) { + Uint xsize = type == DOP_SEND ? 0 : ERTS_HEAP_FRAG_SIZE(token_size); + ErtsProcLocks locks = 0; + ErtsDistExternal *ede_copy; + + ede_copy = erts_make_dist_ext_copy(&ede, xsize); + if (type == DOP_SEND) { + token = NIL; + } else { + ErlHeapFragment *heap_frag; + ErlOffHeap *ohp; + ASSERT(xsize); + heap_frag = erts_dist_ext_trailer(ede_copy); + ERTS_INIT_HEAP_FRAG(heap_frag, token_size); + hp = heap_frag->mem; + ohp = &heap_frag->off_heap; + token = tuple[4]; + token = copy_struct(token, token_size, &hp, ohp); + } + + erts_queue_dist_message(rp, &locks, ede_copy, token); + if (locks) + erts_smp_proc_unlock(rp, locks); + erts_smp_proc_dec_refc(rp); + } + break; + + case DOP_MONITOR_P_EXIT: { + /* We are monitoring a process on the remote node which dies, we get + {DOP_MONITOR_P_EXIT, Remote pid or name, Local pid, ref, reason} */ + + + Eterm lhp[3]; + Eterm sysname; + ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_MSG_SEND|ERTS_PROC_LOCK_LINK; + + /* watched = tuple[2]; */ /* remote proc which died */ + /* watcher = tuple[3]; */ + ref = tuple[4]; + reason = tuple[5]; + + erts_smp_de_links_lock(dep); + sysname = dep->sysname; + mon = erts_remove_monitor(&(dep->monitors), ref); + /* + * If demonitor was performed at the same time as the + * monitored process exits, monitoring side will have + * removed info about monitor. In this case, do nothing + * and everything will be as it should. + */ + erts_smp_de_links_unlock(dep); + if (mon == NULL) { + break; + } + rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks); + if (rp == NULL) { + break; + } + + erts_destroy_monitor(mon); + + mon = erts_remove_monitor(&(rp->monitors),ref); + + if (mon == NULL) { + erts_smp_proc_unlock(rp, rp_locks); + break; + } + + watched = (is_not_nil(mon->name) + ? TUPLE2(&lhp[0], mon->name, sysname) + : mon->pid); + + erts_queue_monitor_message(rp, &rp_locks, + ref, am_process, watched, reason); + erts_smp_proc_unlock(rp, rp_locks); + erts_destroy_monitor(mon); + break; + } + + case DOP_EXIT_TT: + case DOP_EXIT: { + ErtsDistLinkData dld; + ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND; + /* 'from', which 'to' is linked to, died */ + if (type == DOP_EXIT) { + from = tuple[2]; + to = tuple[3]; + reason = tuple[4]; + token = NIL; + } else { + from = tuple[2]; + to = tuple[3]; + token = tuple[4]; + reason = tuple[5]; + } + if (is_not_internal_pid(to)) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + PURIFY_MSG("data error"); + erts_dsprintf(dsbufp, + "Invalid DOP_EXIT distribution message: %.200T", + arg); + erts_send_error_to_logger_nogl(dsbufp); + goto data_error; + } + + rp = erts_pid2proc(NULL, 0, to, rp_locks); + if (!rp) + lnk = NULL; + else { + lnk = erts_remove_link(&(rp->nlinks), from); + + /* If lnk == NULL, we have unlinked on this side, i.e. + * ignore exit. + */ + if (lnk) { + int xres; +#if 0 + /* Arndt: Maybe it should never be 'kill', but it can be, + namely when a linked process does exit(kill). Until we know + whether that is incorrect and what should happen instead, + we leave the assertion out. */ + ASSERT(reason != am_kill); /* should never be kill (killed) */ +#endif + xres = erts_send_exit_signal(NULL, + from, + rp, + &rp_locks, + reason, + token, + NULL, + ERTS_XSIG_FLG_IGN_KILL); + if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { + /* We didn't exit the process and it is traced */ + trace_proc(NULL, rp, am_getting_unlinked, from); + } + } + erts_smp_proc_unlock(rp, rp_locks); + } + erts_remove_dist_link(&dld, to, from, dep); + if (lnk) + erts_destroy_link(lnk); + erts_destroy_dist_link(&dld); + break; + } + case DOP_EXIT2_TT: + case DOP_EXIT2: { + ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; + /* 'from' is send an exit signal to 'to' */ + if (type == DOP_EXIT2) { + from = tuple[2]; + to = tuple[3]; + reason = tuple[4]; + token = NIL; + } else { + from = tuple[2]; + to = tuple[3]; + token = tuple[4]; + reason = tuple[5]; + } + rp = erts_pid2proc_opt(NULL, 0, to, rp_locks, + ERTS_P2P_FLG_SMP_INC_REFC); + if (rp) { + (void) erts_send_exit_signal(NULL, + from, + rp, + &rp_locks, + reason, + token, + NULL, + 0); + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); + } + break; + } + case DOP_GROUP_LEADER: + from = tuple[2]; /* Group leader */ + to = tuple[3]; /* new member */ + if (is_not_pid(from)) + break; + + rp = erts_pid2proc(NULL, 0, to, ERTS_PROC_LOCK_MAIN); + if (!rp) + break; + rp->group_leader = STORE_NC_IN_PROC(rp, from); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + break; + + default: { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Illegal value in distribution dispatch switch: " + "%.200T", + arg); + erts_send_error_to_logger_nogl(dsbufp); + PURIFY_MSG("data error"); + goto data_error; + } + } + + if (off_heap.mso) { + erts_cleanup_mso(off_heap.mso); + } + if (off_heap.externals) { + erts_cleanup_externals(off_heap.externals); + } +#ifndef HYBRID /* FIND ME! */ + if (off_heap.funs) { + erts_cleanup_funs(off_heap.funs); + } + if (ctl != ctl_default) { + erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl); + } +#endif + ERTS_SMP_CHK_NO_PROC_LOCKS; + return 0; + + data_error: + if (off_heap.mso) { + erts_cleanup_mso(off_heap.mso); + } + if (off_heap.externals) { + erts_cleanup_externals(off_heap.externals); + } +#ifndef HYBRID /* FIND ME! */ + if (off_heap.funs) { + erts_cleanup_funs(off_heap.funs); + } + if (ctl != ctl_default) { + erts_free(ERTS_ALC_T_DCTRL_BUF, (void *) ctl); + } +#endif + erts_do_exit_port(prt, dep->cid, am_killed); + ERTS_SMP_CHK_NO_PROC_LOCKS; + return -1; +} + +#define ERTS_DE_BUSY_LIMIT (128*1024) + +static int +dsig_send(ErtsDSigData *dsdp, Eterm ctl, Eterm msg, int force_busy) +{ + Eterm cid; + int suspended = 0; + int resume = 0; + Uint32 pass_through_size; + Uint data_size, dhdr_ext_size; + ErtsAtomCacheMap *acmp; + ErtsDistOutputBuf *obuf; + DistEntry *dep = dsdp->dep; + Uint32 flags = dep->flags; + Process *c_p = dsdp->proc; + + if (!c_p || dsdp->no_suspend) + force_busy = 1; + + ERTS_SMP_LC_ASSERT(!c_p + || (ERTS_PROC_LOCK_MAIN + == erts_proc_lc_my_proc_locks(c_p))); + + if (!erts_is_alive) + return ERTS_DSIG_SEND_OK; + + if (flags & DFLAG_DIST_HDR_ATOM_CACHE) { + acmp = erts_get_atom_cache_map(c_p); + pass_through_size = 0; + } + else { + acmp = NULL; + pass_through_size = 1; + } + +#ifdef ERTS_DIST_MSG_DBG + erts_fprintf(stderr, ">>%s CTL: %T\n", pass_through_size ? "P" : " ", ctl); + if (is_value(msg)) + erts_fprintf(stderr, " MSG: %T\n", msg); +#endif + + data_size = pass_through_size; + erts_reset_atom_cache_map(acmp); + data_size += erts_encode_dist_ext_size(ctl, flags, acmp); + if (is_value(msg)) + data_size += erts_encode_dist_ext_size(msg, flags, acmp); + erts_finalize_atom_cache_map(acmp); + + dhdr_ext_size = erts_encode_ext_dist_header_size(acmp); + data_size += dhdr_ext_size; + + obuf = alloc_dist_obuf(data_size); + obuf->ext_endp = &obuf->data[0] + pass_through_size + dhdr_ext_size; + + /* Encode internal version of dist header */ + obuf->extp = erts_encode_ext_dist_header_setup(obuf->ext_endp, acmp); + /* Encode control message */ + erts_encode_dist_ext(ctl, &obuf->ext_endp, flags, acmp); + if (is_value(msg)) { + /* Encode message */ + erts_encode_dist_ext(msg, &obuf->ext_endp, flags, acmp); + } + + ASSERT(obuf->extp < obuf->ext_endp); + ASSERT(&obuf->data[0] <= obuf->extp - pass_through_size); + ASSERT(obuf->ext_endp <= &obuf->data[0] + data_size); + + data_size = obuf->ext_endp - obuf->extp; + + /* + * Signal encoded; now verify that the connection still exists, + * and if so enqueue the signal and schedule it for send. + */ + obuf->next = NULL; + erts_smp_de_rlock(dep); + cid = dep->cid; + if (cid != dsdp->cid + || dep->connection_id != dsdp->connection_id + || dep->status & ERTS_DE_SFLG_EXITING) { + /* Not the same connection as when we started; drop message... */ + erts_smp_de_runlock(dep); + free_dist_obuf(obuf); + } + else { + ErtsProcList *plp = NULL; + erts_smp_spin_lock(&dep->qlock); + dep->qsize += size_obuf(obuf); + if (dep->qsize >= ERTS_DE_BUSY_LIMIT) + dep->qflgs |= ERTS_DE_QFLG_BUSY; + if (!force_busy && (dep->qflgs & ERTS_DE_QFLG_BUSY)) { + erts_smp_spin_unlock(&dep->qlock); + + plp = erts_proclist_create(c_p); + plp->next = NULL; + erts_suspend(c_p, ERTS_PROC_LOCK_MAIN, NULL); + suspended = 1; + erts_smp_spin_lock(&dep->qlock); + } + + /* Enqueue obuf on dist entry */ + if (dep->out_queue.last) + dep->out_queue.last->next = obuf; + else + dep->out_queue.first = obuf; + dep->out_queue.last = obuf; + + if (!force_busy) { + if (!(dep->qflgs & ERTS_DE_QFLG_BUSY)) { + if (suspended) + resume = 1; /* was busy when we started, but isn't now */ + } + else { + /* Enqueue suspended process on dist entry */ + ASSERT(plp); + if (dep->suspended.last) + dep->suspended.last->next = plp; + else + dep->suspended.first = plp; + dep->suspended.last = plp; + } + } + + erts_smp_spin_unlock(&dep->qlock); + erts_schedule_dist_command(NULL, dep); + erts_smp_de_runlock(dep); + + if (resume) { + erts_resume(c_p, ERTS_PROC_LOCK_MAIN); + erts_proclist_destroy(plp); + /* + * Note that the calling process still have to yield as if it + * suspended. If not, the calling process could later be + * erroneously scheduled when it shouldn't be. + */ + } + } + + if (c_p) { + int reds; + /* + * Bump reductions on calling process. + * + * This is the reduction cost: Always a base cost of 8 reductions + * plus 16 reductions per kilobyte generated external data. + */ + + data_size >>= (10-4); +#if defined(ARCH_64) + data_size &= 0x003fffffffffffff; +#elif defined(ARCH_32) + data_size &= 0x003fffff; +#else +# error "Ohh come on ... !?!" +#endif + reds = 8 + ((int) data_size > 1000000 ? 1000000 : (int) data_size); + BUMP_REDS(c_p, reds); + } + + if (suspended) { + if (!resume && erts_system_monitor_flags.busy_dist_port) + monitor_generic(c_p, am_busy_dist_port, cid); + return ERTS_DSIG_SEND_YIELD; + } + return ERTS_DSIG_SEND_OK; +} + + +static Uint +dist_port_command(Port *prt, ErtsDistOutputBuf *obuf) +{ + int fpe_was_unmasked; + Uint size = obuf->ext_endp - obuf->extp; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (size > (Uint) INT_MAX) + erl_exit(ERTS_ABORT_EXIT, + "Absurdly large distribution output data buffer " + "(%bpu bytes) passed.\n", + size); + + prt->caller = NIL; + fpe_was_unmasked = erts_block_fpe(); + (*prt->drv_ptr->output)((ErlDrvData) prt->drv_data, + (char*) obuf->extp, + (int) size); + erts_unblock_fpe(fpe_was_unmasked); + return size; +} + +static Uint +dist_port_commandv(Port *prt, ErtsDistOutputBuf *obuf) +{ + int fpe_was_unmasked; + Uint size = obuf->ext_endp - obuf->extp; + SysIOVec iov[2]; + ErlDrvBinary* bv[2]; + ErlIOVec eiov; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (size > (Uint) INT_MAX) + erl_exit(ERTS_ABORT_EXIT, + "Absurdly large distribution output data buffer " + "(%bpu bytes) passed.\n", + size); + + iov[0].iov_base = NULL; + iov[0].iov_len = 0; + bv[0] = NULL; + + iov[1].iov_base = obuf->extp; + iov[1].iov_len = size; + bv[1] = Binary2ErlDrvBinary(ErtsDistOutputBuf2Binary(obuf)); + + eiov.vsize = 2; + eiov.size = size; + eiov.iov = iov; + eiov.binv = bv; + + ASSERT(prt->drv_ptr->outputv); + + prt->caller = NIL; + fpe_was_unmasked = erts_block_fpe(); + (*prt->drv_ptr->outputv)((ErlDrvData) prt->drv_data, &eiov); + erts_unblock_fpe(fpe_was_unmasked); + + return size; +} + + +#if defined(ARCH_64) +#define ERTS_PORT_REDS_MASK__ 0x003fffffffffffffL +#elif defined(ARCH_32) +#define ERTS_PORT_REDS_MASK__ 0x003fffff +#else +# error "Ohh come on ... !?!" +#endif + +#define ERTS_PORT_REDS_DIST_CMD_START 5 +#define ERTS_PORT_REDS_DIST_CMD_FINALIZE 3 +#define ERTS_PORT_REDS_DIST_CMD_EXIT 200 +#define ERTS_PORT_REDS_DIST_CMD_RESUMED 5 +#define ERTS_PORT_REDS_DIST_CMD_DATA(SZ) \ + ((SZ) < (1 << 10) \ + ? ((Sint) 1) \ + : ((((Sint) (SZ)) >> 10) & ((Sint) ERTS_PORT_REDS_MASK__))) + +int +erts_dist_command(Port *prt, int reds_limit) +{ + Sint reds = ERTS_PORT_REDS_DIST_CMD_START; + int prt_busy; + int de_busy; + Uint32 status; + Uint32 flags; + Uint32 qflgs; + Sint obufsize = 0; + ErtsDistOutputQueue oq, foq; + DistEntry *dep = prt->dist_entry; + Uint (*send)(Port *prt, ErtsDistOutputBuf *obuf); + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + erts_refc_inc(&dep->refc, 1); /* Otherwise dist_entry might be + removed if port command fails */ + + erts_smp_atomic_xchg(&dep->dist_cmd_scheduled, 0); + + erts_smp_de_rlock(dep); + flags = dep->flags; + status = dep->status; + send = dep->send; + erts_smp_de_runlock(dep); + + if (status & ERTS_DE_SFLG_EXITING) { + erts_do_exit_port(prt, prt->id, am_killed); + erts_deref_dist_entry(dep); + return reds + ERTS_PORT_REDS_DIST_CMD_EXIT; + } + + ASSERT(send); + + /* + * We need to remove both out queues from the + * dist entry while passing it to port command; + * otherwise, port command will free the buffers + * in the queues on failure and we'll end up with + * a mess. + */ + + erts_smp_spin_lock(&dep->qlock); + oq.first = dep->out_queue.first; + oq.last = dep->out_queue.last; + dep->out_queue.first = NULL; + dep->out_queue.last = NULL; + qflgs = dep->qflgs; + erts_smp_spin_unlock(&dep->qlock); + + foq.first = dep->finalized_out_queue.first; + foq.last = dep->finalized_out_queue.last; + dep->finalized_out_queue.first = NULL; + dep->finalized_out_queue.last = NULL; + + if (reds > reds_limit) + goto preempted; + + prt_busy = (int) (prt->status & ERTS_PORT_SFLG_PORT_BUSY); + de_busy = (int) (qflgs & ERTS_DE_QFLG_BUSY); + + if (prt_busy) { + if (!de_busy) { + erts_smp_spin_lock(&dep->qlock); + dep->qflgs |= ERTS_DE_QFLG_BUSY; + erts_smp_spin_unlock(&dep->qlock); + de_busy = 1; + } + } + else if (foq.first) { + int preempt = 0; + do { + Uint size; + ErtsDistOutputBuf *fob; + + size = (*send)(prt, foq.first); +#ifdef ERTS_RAW_DIST_MSG_DBG + erts_fprintf(stderr, ">> "); + bw(foq.first->extp, size); +#endif + reds += ERTS_PORT_REDS_DIST_CMD_DATA(size); + fob = foq.first; + obufsize += size_obuf(fob); + foq.first = foq.first->next; + free_dist_obuf(fob); + preempt = reds > reds_limit || (prt->status & ERTS_PORT_SFLGS_DEAD); + if (prt->status & ERTS_PORT_SFLG_PORT_BUSY) { + erts_smp_spin_lock(&dep->qlock); + dep->qflgs |= ERTS_DE_QFLG_BUSY; + erts_smp_spin_unlock(&dep->qlock); + de_busy = prt_busy = 1; + break; + } + } while (foq.first && !preempt); + if (!foq.first) + foq.last = NULL; + if (preempt) + goto preempted; + } + + if (prt_busy) { + if (oq.first) { + ErtsDistOutputBuf *ob; + int preempt; + finalize_only: + preempt = 0; + ob = oq.first; + ASSERT(ob); + do { + ob->extp = erts_encode_ext_dist_header_finalize(ob->extp, + dep->cache); + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + *--ob->extp = PASS_THROUGH; /* Old node; 'pass through' + needed */ + ASSERT(&ob->data[0] <= ob->extp && ob->extp < ob->ext_endp); + reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; + preempt = reds > reds_limit; + if (preempt) + break; + ob = ob->next; + } while (ob); + /* + * At least one buffer was finalized; if we got preempted, + * ob points to the last buffer that we finalized. + */ + if (foq.last) + foq.last->next = oq.first; + else + foq.first = oq.first; + if (!preempt) { + /* All buffers finalized */ + foq.last = oq.last; + oq.first = oq.last = NULL; + } + else { + /* Not all buffers finalized; split oq. */ + foq.last = ob; + oq.first = ob->next; + if (oq.first) + ob->next = NULL; + else + oq.last = NULL; + } + if (preempt) + goto preempted; + } + } + else { + int preempt = 0; + while (oq.first && !preempt) { + ErtsDistOutputBuf *fob; + Uint size; + oq.first->extp + = erts_encode_ext_dist_header_finalize(oq.first->extp, + dep->cache); + reds += ERTS_PORT_REDS_DIST_CMD_FINALIZE; + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) + *--oq.first->extp = PASS_THROUGH; /* Old node; 'pass through' + needed */ + ASSERT(&oq.first->data[0] <= oq.first->extp + && oq.first->extp < oq.first->ext_endp); + size = (*send)(prt, oq.first); +#ifdef ERTS_RAW_DIST_MSG_DBG + erts_fprintf(stderr, ">> "); + bw(oq.first->extp, size); +#endif + reds += ERTS_PORT_REDS_DIST_CMD_DATA(size); + fob = oq.first; + obufsize += size_obuf(fob); + oq.first = oq.first->next; + free_dist_obuf(fob); + preempt = reds > reds_limit || (prt->status & ERTS_PORT_SFLGS_DEAD); + if (prt->status & ERTS_PORT_SFLG_PORT_BUSY) { + erts_smp_spin_lock(&dep->qlock); + dep->qflgs |= ERTS_DE_QFLG_BUSY; + erts_smp_spin_unlock(&dep->qlock); + de_busy = prt_busy = 1; + if (oq.first && !preempt) + goto finalize_only; + } + } + + ASSERT(!oq.first || preempt); + + /* + * Preempt if not all buffers have been handled. + */ + if (preempt && oq.first) + goto preempted; + +#ifdef DEBUG + oq.last = NULL; +#endif + ASSERT(!oq.first); + ASSERT(!foq.first && !foq.last); + + /* + * Everything that was buffered when we started have now been + * written to the port. If port isn't busy but dist entry is + * and we havn't got too muched queued on dist entry, set + * dist entry in a non-busy state and resume suspended + * processes. + */ + erts_smp_spin_lock(&dep->qlock); + ASSERT(dep->qsize >= obufsize); + dep->qsize -= obufsize; + obufsize = 0; + if (de_busy && !prt_busy && dep->qsize < ERTS_DE_BUSY_LIMIT) { + ErtsProcList *suspendees; + int resumed; + suspendees = get_suspended_on_de(dep, ERTS_DE_QFLG_BUSY); + erts_smp_spin_unlock(&dep->qlock); + + resumed = erts_resume_processes(suspendees); + reds += resumed*ERTS_PORT_REDS_DIST_CMD_RESUMED; + de_busy = 0; + } + else + erts_smp_spin_unlock(&dep->qlock); + } + + ASSERT(!oq.first && !oq.last); + + done: + + if (obufsize != 0) { + ASSERT(obufsize > 0); + erts_smp_spin_lock(&dep->qlock); + ASSERT(dep->qsize >= obufsize); + dep->qsize -= obufsize; + erts_smp_spin_unlock(&dep->qlock); + } + + ASSERT(foq.first || !foq.last); + ASSERT(!foq.first || foq.last); + ASSERT(!dep->finalized_out_queue.first); + ASSERT(!dep->finalized_out_queue.last); + + if (foq.first) { + dep->finalized_out_queue.first = foq.first; + dep->finalized_out_queue.last = foq.last; + } + + /* Avoid wrapping reduction counter... */ + if (reds > INT_MAX/2) + reds = INT_MAX/2; + + erts_deref_dist_entry(dep); + + return reds; + + preempted: + + ASSERT(oq.first || !oq.last); + ASSERT(!oq.first || oq.last); + + if (prt->status & ERTS_PORT_SFLGS_DEAD) { + /* + * Port died during port command; clean up 'oq' + * and 'foq'. Things buffered in dist entry after + * we begun processing the queues have already been + * cleaned up when port terminated. + */ + + if (oq.first) + oq.last->next = foq.first; + else + oq.first = foq.first; + + while (oq.first) { + ErtsDistOutputBuf *fob = oq.first; + oq.first = oq.first->next; + obufsize += size_obuf(fob); + free_dist_obuf(fob); + } + + foq.first = NULL; + foq.last = NULL; + +#ifdef DEBUG + erts_smp_spin_lock(&dep->qlock); + ASSERT(dep->qsize == obufsize); + erts_smp_spin_unlock(&dep->qlock); +#endif + } + else { + if (oq.first) { + /* + * Unhandle buffers need to be put back first + * in out_queue. + */ + erts_smp_spin_lock(&dep->qlock); + dep->qsize -= obufsize; + obufsize = 0; + oq.last->next = dep->out_queue.first; + dep->out_queue.first = oq.first; + if (!dep->out_queue.last) + dep->out_queue.last = oq.last; + erts_smp_spin_unlock(&dep->qlock); + } + + erts_schedule_dist_command(prt, NULL); + } + goto done; +} + +void +erts_dist_port_not_busy(Port *prt) +{ + erts_schedule_dist_command(prt, NULL); +} + +void +erts_kill_dist_connection(DistEntry *dep, Uint32 connection_id) +{ + erts_smp_de_rwlock(dep); + if (is_internal_port(dep->cid) + && connection_id == dep->connection_id + && !(dep->status & ERTS_DE_SFLG_EXITING)) { + + dep->status |= ERTS_DE_SFLG_EXITING; + + erts_smp_spin_lock(&dep->qlock); + ASSERT(!(dep->qflgs & ERTS_DE_QFLG_EXIT)); + dep->qflgs |= ERTS_DE_QFLG_EXIT; + erts_smp_spin_unlock(&dep->qlock); + + erts_schedule_dist_command(NULL, dep); + } + erts_smp_de_rwunlock(dep); +} + +struct print_to_data { + int to; + void *arg; +}; + +static void doit_print_monitor_info(ErtsMonitor *mon, void *vptdp) +{ + int to = ((struct print_to_data *) vptdp)->to; + void *arg = ((struct print_to_data *) vptdp)->arg; + Process *rp; + ErtsMonitor *rmon; + rp = erts_pid2proc_unlocked(mon->pid); + if (!rp || (rmon = erts_lookup_monitor(rp->monitors, mon->ref)) == NULL) { + erts_print(to, arg, "Warning, stray monitor for: %T\n", mon->pid); + } else if (mon->type == MON_ORIGIN) { + /* Local pid is being monitored */ + erts_print(to, arg, "Remotely monitored by: %T %T\n", + mon->pid, rmon->pid); + } else { + erts_print(to, arg, "Remote monitoring: %T ", mon->pid); + if (is_not_atom(rmon->pid)) + erts_print(to, arg, "%T\n", rmon->pid); + else + erts_print(to, arg, "{%T, %T}\n", + rmon->name, + rmon->pid); /* which in this case is the + remote system name... */ + } +} + +static void print_monitor_info(int to, void *arg, ErtsMonitor *mon) +{ + struct print_to_data ptd = {to, arg}; + erts_doforall_monitors(mon,&doit_print_monitor_info,&ptd); +} + +typedef struct { + struct print_to_data *ptdp; + Eterm from; +} PrintLinkContext; + +static void doit_print_link_info2(ErtsLink *lnk, void *vpplc) +{ + PrintLinkContext *pplc = (PrintLinkContext *) vpplc; + erts_print(pplc->ptdp->to, pplc->ptdp->arg, "Remote link: %T %T\n", + pplc->from, lnk->pid); +} + +static void doit_print_link_info(ErtsLink *lnk, void *vptdp) +{ + if (is_internal_pid(lnk->pid) && erts_pid2proc_unlocked(lnk->pid)) { + PrintLinkContext plc = {(struct print_to_data *) vptdp, lnk->pid}; + erts_doforall_links(ERTS_LINK_ROOT(lnk), &doit_print_link_info2, &plc); + } +} + +static void print_link_info(int to, void *arg, ErtsLink *lnk) +{ + struct print_to_data ptd = {to, arg}; + erts_doforall_links(lnk, &doit_print_link_info, (void *) &ptd); +} + +typedef struct { + struct print_to_data ptd; + Eterm sysname; +} PrintNodeLinkContext; + + +static void doit_print_nodelink_info(ErtsLink *lnk, void *vpcontext) +{ + PrintNodeLinkContext *pcontext = vpcontext; + + if (is_internal_pid(lnk->pid) && erts_pid2proc_unlocked(lnk->pid)) + erts_print(pcontext->ptd.to, pcontext->ptd.arg, + "Remote monitoring: %T %T\n", lnk->pid, pcontext->sysname); +} + +static void print_nodelink_info(int to, void *arg, ErtsLink *lnk, Eterm sysname) +{ + PrintNodeLinkContext context = {{to, arg}, sysname}; + erts_doforall_links(lnk, &doit_print_nodelink_info, &context); +} + + +static int +info_dist_entry(int to, void *arg, DistEntry *dep, int visible, int connected) +{ + + if (visible && connected) { + erts_print(to, arg, "=visible_node:"); + } else if (connected) { + erts_print(to, arg, "=hidden_node:"); + } else { + erts_print(to, arg, "=not_connected:"); + } + erts_print(to, arg, "%d\n", dist_entry_channel_no(dep)); + + if(connected && is_nil(dep->cid)) { + erts_print(to, arg, + "Error: Not connected node still registered as connected:%T\n", + dep->sysname); + return 0; + } + + if(!connected && is_not_nil(dep->cid)) { + erts_print(to, arg, + "Error: Connected node not registered as connected:%T\n", + dep->sysname); + return 0; + } + + erts_print(to, arg, "Name: %T", dep->sysname); +#ifdef DEBUG + erts_print(to, arg, " (refc=%d)", erts_refc_read(&dep->refc, 1)); +#endif + erts_print(to, arg, "\n"); + if (!connected && is_nil(dep->cid)) { + if (dep->nlinks) { + erts_print(to, arg, "Error: Got links to not connected node:%T\n", + dep->sysname); + } + return 0; + } + + erts_print(to, arg, "Controller: %T\n", dep->cid, to); + + erts_print_node_info(to, arg, dep->sysname, NULL, NULL); + print_monitor_info(to, arg, dep->monitors); + print_link_info(to, arg, dep->nlinks); + print_nodelink_info(to, arg, dep->node_links, dep->sysname); + + return 0; + +} +int distribution_info(int to, void *arg) /* Called by break handler */ +{ + DistEntry *dep; + + erts_print(to, arg, "=node:%T\n", erts_this_dist_entry->sysname); + + if (erts_this_node->sysname == am_Noname) { + erts_print(to, arg, "=no_distribution\n"); + return(0); + } + +#if 0 + if (!erts_visible_dist_entries && !erts_hidden_dist_entries) + erts_print(to, arg, "Alive but not holding any connections \n"); +#endif + + for(dep = erts_visible_dist_entries; dep; dep = dep->next) { + info_dist_entry(to, arg, dep, 1, 1); + } + + for(dep = erts_hidden_dist_entries; dep; dep = dep->next) { + info_dist_entry(to, arg, dep, 0, 1); + } + + for (dep = erts_not_connected_dist_entries; dep; dep = dep->next) { + info_dist_entry(to, arg, dep, 0, 0); + } + + return(0); +} + +/**************************************************************************** + DISTRIBUTION BIFS: + + setnode/2 -- start distribution + setnode/3 -- set node controller + + node/1 -- return objects node name + node/0 -- return this node name + nodes/0 -- return a list of all (non hidden) nodes + is_alive -- return true if distribution is running else false + monitor_node -- turn on/off node monitoring + + node controller only: + dist_exit/3 -- send exit signals from remote to local process + dist_link/2 -- link a remote process to a local + dist_unlink/2 -- unlink a remote from a local +****************************************************************************/ + + + +/********************************************************************** + ** Set the node name of current node fail if node already is set. + ** setnode(name@host, Creation) + ** loads functions pointer to trap_functions from module erlang. + ** erlang:dsend/2 + ** erlang:dlink/1 + ** erlang:dunlink/1 + ** erlang:dmonitor_node/3 + ** erlang:dgroup_leader/2 + ** erlang:dexit/2 + ** -- are these needed ? + ** dexit/1 + ***********************************************************************/ + +BIF_RETTYPE setnode_2(BIF_ALIST_2) +{ + Process *net_kernel; + Uint creation; + + /* valid creation ? */ + if(!term_to_Uint(BIF_ARG_2, &creation)) + goto error; + if(creation > 3) + goto error; + + /* valid node name ? */ + if (!is_node_name_atom(BIF_ARG_1)) + goto error; + + if (BIF_ARG_1 == am_Noname) /* cant use this name !! */ + goto error; + if (erts_is_alive) /* must not be alive! */ + goto error; + + /* Check that all trap functions are defined !! */ + if (dsend2_trap->address == NULL || + dsend3_trap->address == NULL || + /* dsend_nosuspend_trap->address == NULL ||*/ + dlink_trap->address == NULL || + dunlink_trap->address == NULL || + dmonitor_node_trap->address == NULL || + dgroup_leader_trap->address == NULL || + dmonitor_p_trap->address == NULL || + dexit_trap->address == NULL) { + goto error; + } + + net_kernel = erts_whereis_process(BIF_P, ERTS_PROC_LOCK_MAIN, + am_net_kernel, ERTS_PROC_LOCK_MAIN, 0); + if (!net_kernel) + goto error; + + /* By setting dist_entry==erts_this_dist_entry and DISTRIBUTION on + net_kernel do_net_exist will be called when net_kernel + is terminated !! */ + (void *) ERTS_PROC_SET_DIST_ENTRY(net_kernel, + ERTS_PROC_LOCK_MAIN, + erts_this_dist_entry); + erts_refc_inc(&erts_this_dist_entry->refc, 2); + net_kernel->flags |= F_DISTRIBUTION; + + if (net_kernel != BIF_P) + erts_smp_proc_unlock(net_kernel, ERTS_PROC_LOCK_MAIN); + +#ifdef DEBUG + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + ASSERT(!erts_visible_dist_entries && !erts_hidden_dist_entries); + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); +#endif + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); + erts_set_this_node(BIF_ARG_1, (Uint32) creation); + erts_is_alive = 1; + send_nodes_mon_msgs(NULL, am_nodeup, BIF_ARG_1, am_visible, NIL); + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + + BIF_RET(am_true); + + error: + BIF_ERROR(BIF_P, BADARG); +} + +/********************************************************************** + ** Allocate a dist entry, set node name install the connection handler + ** setnode_3({name@host, Creation}, Cid, {Type, Version, Initial, IC, OC}) + ** Type = flag field, where the flags are specified in dist.h + ** Version = distribution version, >= 1 + ** IC = in_cookie (ignored) + ** OC = out_cookie (ignored) + ** + ** Note that in distribution protocols above 1, the Initial parameter + ** is always NIL and the cookies are always the atom '', cookies are not + ** sent in the distribution messages but are only used in + ** the handshake. + ** + ***********************************************************************/ + +BIF_RETTYPE setnode_3(BIF_ALIST_3) +{ + BIF_RETTYPE ret; + Uint flags; + unsigned long version; + Eterm ic, oc; + Eterm *tp; + DistEntry *dep = NULL; + Port *pp = NULL; + + /* Prepare for success */ + ERTS_BIF_PREP_RET(ret, am_true); + + /* + * Check and pick out arguments + */ + + if (!is_node_name_atom(BIF_ARG_1) || + is_not_internal_port(BIF_ARG_2) || + (erts_this_node->sysname == am_Noname)) { + goto badarg; + } + + if (!is_tuple(BIF_ARG_3)) + goto badarg; + tp = tuple_val(BIF_ARG_3); + if (*tp++ != make_arityval(4)) + goto badarg; + if (!is_small(*tp)) + goto badarg; + flags = unsigned_val(*tp++); + if (!is_small(*tp) || (version = unsigned_val(*tp)) == 0) + goto badarg; + ic = *(++tp); + oc = *(++tp); + if (!is_atom(ic) || !is_atom(oc)) + goto badarg; + + /* DFLAG_EXTENDED_REFERENCES is compulsory from R9 and forward */ + if (!(DFLAG_EXTENDED_REFERENCES & flags)) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "%T", BIF_P->id); + if (BIF_P->reg) + erts_dsprintf(dsbufp, " (%T)", BIF_P->reg->name); + erts_dsprintf(dsbufp, + " attempted to enable connection to node %T " + "which is not able to handle extended references.\n", + BIF_ARG_1); + erts_send_error_to_logger(BIF_P->group_leader, dsbufp); + goto badarg; + } + + /* + * Arguments seem to be in order. + */ + + /* get dist_entry */ + dep = erts_find_or_insert_dist_entry(BIF_ARG_1); + if (dep == erts_this_dist_entry) + goto badarg; + else if (!dep) + goto system_limit; /* Should never happen!!! */ + + pp = erts_id2port(BIF_ARG_2, BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_de_rwlock(dep); + + if (!pp || (pp->status & ERTS_PORT_SFLG_EXITING)) + goto badarg; + + if ((pp->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY) == 0) + goto badarg; + + if (dep->cid == BIF_ARG_2 && pp->dist_entry == dep) + goto done; /* Already set */ + + if (dep->status & ERTS_DE_SFLG_EXITING) { + /* Suspend on dist entry waiting for the exit to finish */ + ErtsProcList *plp = erts_proclist_create(BIF_P); + plp->next = NULL; + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + erts_smp_spin_lock(&dep->qlock); + if (dep->suspended.last) + dep->suspended.last->next = plp; + else + dep->suspended.first = plp; + dep->suspended.last = plp; + erts_smp_spin_unlock(&dep->qlock); + goto yield; + } + + ASSERT(!(dep->status & ERTS_DE_SFLG_EXITING)); + + if (pp->dist_entry || is_not_nil(dep->cid)) + goto badarg; + + erts_port_status_bor_set(pp, ERTS_PORT_SFLG_DISTRIBUTION); + + pp->dist_entry = dep; + + dep->version = version; + dep->creation = 0; + + ASSERT(pp->drv_ptr->outputv || pp->drv_ptr->output); + +#if 1 + dep->send = (pp->drv_ptr->outputv + ? dist_port_commandv + : dist_port_command); +#else + dep->send = dist_port_command; +#endif + ASSERT(dep->send); + +#ifdef DEBUG + erts_smp_spin_lock(&dep->qlock); + ASSERT(dep->qsize == 0); + erts_smp_spin_unlock(&dep->qlock); +#endif + + erts_set_dist_entry_connected(dep, BIF_ARG_2, flags); + + if (flags & DFLAG_DIST_HDR_ATOM_CACHE) + create_cache(dep); + + erts_smp_de_rwunlock(dep); + dep = NULL; /* inc of refc transferred to port (dist_entry field) */ + + send_nodes_mon_msgs(BIF_P, + am_nodeup, + BIF_ARG_1, + flags & DFLAG_PUBLISHED ? am_visible : am_hidden, + NIL); + done: + + if (dep && dep != erts_this_dist_entry) { + erts_smp_de_rwunlock(dep); + erts_deref_dist_entry(dep); + } + + if (pp) + erts_smp_port_unlock(pp); + + return ret; + + yield: + ERTS_BIF_PREP_YIELD3(ret, bif_export[BIF_setnode_3], BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + goto done; + + badarg: + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + goto done; + + system_limit: + ERTS_BIF_PREP_ERROR(ret, BIF_P, SYSTEM_LIMIT); + goto done; +} + + +/**********************************************************************/ +/* dist_exit(Local, Term, Remote) -> Bool */ + +BIF_RETTYPE dist_exit_3(BIF_ALIST_3) +{ + Eterm local; + Eterm remote; + DistEntry *rdep; + + local = BIF_ARG_1; + remote = BIF_ARG_3; + + /* Check that remote is a remote process */ + if (is_not_external_pid(remote)) + goto error; + + rdep = external_dist_entry(remote); + + if(rdep == erts_this_dist_entry) + goto error; + + /* Check that local is local */ + if (is_internal_pid(local)) { + Process *lp; + ErtsProcLocks lp_locks; + if (BIF_P->id == local) { + lp_locks = ERTS_PROC_LOCKS_ALL; + lp = BIF_P; + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCKS_ALL_MINOR); + } + else { + lp_locks = ERTS_PROC_LOCKS_XSIG_SEND; + lp = erts_pid2proc_opt(BIF_P, ERTS_PROC_LOCK_MAIN, + local, lp_locks, + ERTS_P2P_FLG_SMP_INC_REFC); + if (!lp) { + BIF_RET(am_true); /* ignore */ + } + } + + (void) erts_send_exit_signal(BIF_P, + remote, + lp, + &lp_locks, + BIF_ARG_2, + NIL, + NULL, + 0); +#ifdef ERTS_SMP + if (lp == BIF_P) + lp_locks &= ~ERTS_PROC_LOCK_MAIN; +#endif + erts_smp_proc_unlock(lp, lp_locks); + if (lp != BIF_P) + erts_smp_proc_dec_refc(lp); + else { + /* + * We may have exited current process and may have to take action. + */ + ERTS_BIF_CHK_EXITED(BIF_P); + ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN); + } + } + else if (is_external_pid(local) + && external_dist_entry(local) == erts_this_dist_entry) { + BIF_RET(am_true); /* ignore */ + } + else + goto error; + BIF_RET(am_true); + + error: + BIF_ERROR(BIF_P, BADARG); +} + +/**********************************************************************/ +/* node(Object) -> Node */ + +BIF_RETTYPE node_1(BIF_ALIST_1) +{ + if (is_not_node_container(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(node_container_node_name(BIF_ARG_1)); +} + +/**********************************************************************/ +/* node() -> Node */ + +BIF_RETTYPE node_0(BIF_ALIST_0) +{ + BIF_RET(erts_this_dist_entry->sysname); +} + + +/**********************************************************************/ +/* nodes() -> [ Node ] */ + +#if 0 /* Done in erlang.erl instead. */ +BIF_RETTYPE nodes_0(BIF_ALIST_0) +{ + return nodes_1(BIF_P, am_visible); +} +#endif + + +BIF_RETTYPE nodes_1(BIF_ALIST_1) +{ + Eterm result; + int length; + Eterm* hp; + int not_connected = 0; + int visible = 0; + int hidden = 0; + int this = 0; + Uint buf[2]; /* For one cons-cell */ + DistEntry *dep; + Eterm arg_list = BIF_ARG_1; +#ifdef DEBUG + Eterm* endp; +#endif + if (is_atom(BIF_ARG_1)) + arg_list = CONS(buf, BIF_ARG_1, NIL); + + while (is_list(arg_list)) { + switch(CAR(list_val(arg_list))) { + case am_visible: visible = 1; break; + case am_hidden: hidden = 1; break; + case am_known: visible = hidden = not_connected = this = 1; break; + case am_this: this = 1; break; + case am_connected: visible = hidden = 1; break; + default: BIF_ERROR(BIF_P, BADARG); break; + } + arg_list = CDR(list_val(arg_list)); + } + + if (is_not_nil(arg_list)) + BIF_ERROR(BIF_P, BADARG); + + length = 0; + + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + + ASSERT(erts_no_of_not_connected_dist_entries >= 0); + ASSERT(erts_no_of_hidden_dist_entries >= 0); + ASSERT(erts_no_of_visible_dist_entries >= 0); + if(not_connected) + length += erts_no_of_not_connected_dist_entries; + if(hidden) + length += erts_no_of_hidden_dist_entries; + if(visible) + length += erts_no_of_visible_dist_entries; + if(this) + length++; + + result = NIL; + + if (length == 0) { + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + BIF_RET(result); + } + + hp = HAlloc(BIF_P, 2*length); + +#ifdef DEBUG + endp = hp + length*2; +#endif + if(not_connected) + for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) { + result = CONS(hp, dep->sysname, result); + hp += 2; + } + if(hidden) + for(dep = erts_hidden_dist_entries; dep; dep = dep->next) { + result = CONS(hp, dep->sysname, result); + hp += 2; + } + if(visible) + for(dep = erts_visible_dist_entries; dep; dep = dep->next) { + result = CONS(hp, dep->sysname, result); + hp += 2; + } + if(this) { + result = CONS(hp, erts_this_dist_entry->sysname, result); + hp += 2; + } + ASSERT(endp == hp); + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + BIF_RET(result); +} + +/**********************************************************************/ +/* is_alive() -> Bool */ + +BIF_RETTYPE is_alive_0(BIF_ALIST_0) +{ + Eterm res = erts_is_alive ? am_true : am_false; + BIF_RET(res); +} + +/**********************************************************************/ +/* erlang:monitor_node(Node, Bool, Options) -> Bool */ + +BIF_RETTYPE monitor_node_3(BIF_ALIST_3) +{ + DistEntry *dep; + ErtsLink *lnk; + Eterm l; + + for (l = BIF_ARG_3; l != NIL && is_list(l); l = CDR(list_val(l))) { + Eterm t = CAR(list_val(l)); + /* allow_passive_connect the only available option right now */ + if (t != am_allow_passive_connect) { + BIF_ERROR(BIF_P, BADARG); + } + } + if (l != NIL) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_not_atom(BIF_ARG_1) || + ((BIF_ARG_2 != am_true) && (BIF_ARG_2 != am_false)) || + ((erts_this_node->sysname == am_Noname) + && (BIF_ARG_1 != erts_this_node->sysname))) { + BIF_ERROR(BIF_P, BADARG); + } + dep = erts_sysname_to_connected_dist_entry(BIF_ARG_1); + if (!dep) { + do_trap: + BIF_TRAP3(dmonitor_node_trap, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + } + if (dep == erts_this_dist_entry) + goto done; + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_de_rlock(dep); + if (ERTS_DE_IS_NOT_CONNECTED(dep)) { + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + erts_smp_de_runlock(dep); + goto do_trap; + } + erts_smp_de_links_lock(dep); + erts_smp_de_runlock(dep); + + if (BIF_ARG_2 == am_true) { + ASSERT(dep->cid != NIL); + lnk = erts_add_or_lookup_link(&(dep->node_links), LINK_NODE, + BIF_P->id); + ++ERTS_LINK_REFC(lnk); + lnk = erts_add_or_lookup_link(&(BIF_P->nlinks), LINK_NODE, BIF_ARG_1); + ++ERTS_LINK_REFC(lnk); + } + else { + lnk = erts_lookup_link(dep->node_links, BIF_P->id); + if (lnk != NULL) { + if ((--ERTS_LINK_REFC(lnk)) == 0) { + erts_destroy_link(erts_remove_link(&(dep->node_links), + BIF_P->id)); + } + } + lnk = erts_lookup_link(BIF_P->nlinks, BIF_ARG_1); + if (lnk != NULL) { + if ((--ERTS_LINK_REFC(lnk)) == 0) { + erts_destroy_link(erts_remove_link(&(BIF_P->nlinks), + BIF_ARG_1)); + } + } + } + + erts_smp_de_links_unlock(dep); + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + + done: + erts_deref_dist_entry(dep); + BIF_RET(am_true); +} + +/* monitor_node(Node, Bool) -> Bool */ + +BIF_RETTYPE monitor_node_2(BIF_ALIST_2) +{ + BIF_RET(monitor_node_3(BIF_P,BIF_ARG_1,BIF_ARG_2,NIL)); +} + +BIF_RETTYPE net_kernel_dflag_unicode_io_1(BIF_ALIST_1) +{ + DistEntry *de; + Uint32 f; + if (is_not_pid(BIF_ARG_1)) { + BIF_ERROR(BIF_P,BADARG); + } + de = pid_dist_entry(BIF_ARG_1); + ASSERT(de != NULL); + if (de == erts_this_dist_entry) { + BIF_RET(am_true); + } + erts_smp_de_rlock(de); + f = de->flags; + erts_smp_de_runlock(de); + BIF_RET(((f & DFLAG_UNICODE_IO) ? am_true : am_false)); +} + +/* + * The major part of the implementation of net_kernel:monitor_nodes/[1,2] + * follows. + * + * Currently net_kernel:monitor_nodes/[1,2] calls process_flag/2 which in + * turn calls erts_monitor_nodes(). If the process_flag() call fails (with + * badarg), the code in net_kernel determines what type of error to return. + * This in order to simplify the task of being backward compatible. + */ + +#define ERTS_NODES_MON_OPT_TYPE_VISIBLE (((Uint16) 1) << 0) +#define ERTS_NODES_MON_OPT_TYPE_HIDDEN (((Uint16) 1) << 1) +#define ERTS_NODES_MON_OPT_DOWN_REASON (((Uint16) 1) << 2) + +#define ERTS_NODES_MON_OPT_TYPES \ + (ERTS_NODES_MON_OPT_TYPE_VISIBLE|ERTS_NODES_MON_OPT_TYPE_HIDDEN) + +typedef struct ErtsNodesMonitor_ ErtsNodesMonitor; +struct ErtsNodesMonitor_ { + ErtsNodesMonitor *prev; + ErtsNodesMonitor *next; + Process *proc; + Uint16 opts; + Uint16 no; +}; + +static erts_smp_mtx_t nodes_monitors_mtx; +static ErtsNodesMonitor *nodes_monitors; +static ErtsNodesMonitor *nodes_monitors_end; + +/* + * Nodes monitors are stored in a double linked list. 'nodes_monitors' + * points to the beginning of the list and 'nodes_monitors_end' points + * to the end of the list. + * + * There might be more than one entry per process in the list. If so, + * they are located in sequence. The 'nodes_monitors' field of the + * process struct refers to the first element in the sequence + * corresponding to the process in question. + */ + +static void +init_nodes_monitors(void) +{ + erts_smp_mtx_init(&nodes_monitors_mtx, "nodes_monitors"); + nodes_monitors = NULL; + nodes_monitors_end = NULL; +} + +static ERTS_INLINE Uint +nodes_mon_msg_sz(ErtsNodesMonitor *nmp, Eterm what, Eterm reason) +{ + Uint sz; + if (!nmp->opts) { + sz = 3; + } + else { + sz = 0; + + if (nmp->opts & ERTS_NODES_MON_OPT_TYPES) + sz += 2 + 3; + + if (what == am_nodedown + && (nmp->opts & ERTS_NODES_MON_OPT_DOWN_REASON)) { + if (is_not_immed(reason)) + sz += size_object(reason); + sz += 2 + 3; + } + + sz += 4; + } + return sz; +} + +static ERTS_INLINE void +send_nodes_mon_msg(Process *rp, + ErtsProcLocks *rp_locksp, + ErtsNodesMonitor *nmp, + Eterm node, + Eterm what, + Eterm type, + Eterm reason, + Uint sz) +{ + Eterm msg; + ErlHeapFragment* bp; + ErlOffHeap *ohp; + Eterm *hp = erts_alloc_message_heap(sz, &bp, &ohp, rp, rp_locksp); +#ifdef DEBUG + Eterm *hend = hp + sz; +#endif + + if (!nmp->opts) { + msg = TUPLE2(hp, what, node); +#ifdef DEBUG + hp += 3; +#endif + } + else { + Eterm tup; + Eterm info = NIL; + + if (nmp->opts & (ERTS_NODES_MON_OPT_TYPE_VISIBLE + | ERTS_NODES_MON_OPT_TYPE_HIDDEN)) { + + tup = TUPLE2(hp, am_node_type, type); + hp += 3; + info = CONS(hp, tup, info); + hp += 2; + } + + if (what == am_nodedown + && (nmp->opts & ERTS_NODES_MON_OPT_DOWN_REASON)) { + Eterm rsn_cpy; + + if (is_immed(reason)) + rsn_cpy = reason; + else { + Eterm rsn_sz = size_object(reason); + rsn_cpy = copy_struct(reason, rsn_sz, &hp, ohp); + } + + tup = TUPLE2(hp, am_nodedown_reason, rsn_cpy); + hp += 3; + info = CONS(hp, tup, info); + hp += 2; + } + + msg = TUPLE3(hp, what, node, info); +#ifdef DEBUG + hp += 4; +#endif + } + + ASSERT(hend == hp); + erts_queue_message(rp, rp_locksp, bp, msg, NIL); +} + +static void +send_nodes_mon_msgs(Process *c_p, Eterm what, Eterm node, Eterm type, Eterm reason) +{ + ErtsNodesMonitor *nmp; + ErtsProcLocks rp_locks = 0; /* Init to shut up false warning */ + Process *rp = NULL; + + ASSERT(is_immed(what)); + ASSERT(is_immed(node)); + ASSERT(is_immed(type)); + + ERTS_SMP_LC_ASSERT(!c_p + || (erts_proc_lc_my_proc_locks(c_p) + == ERTS_PROC_LOCK_MAIN)); + erts_smp_mtx_lock(&nodes_monitors_mtx); + + for (nmp = nodes_monitors; nmp; nmp = nmp->next) { + int i; + Uint16 no; + Uint sz; + + ASSERT(nmp->proc != NULL); + + if (!nmp->opts) { + if (type != am_visible) + continue; + } + else { + switch (type) { + case am_hidden: + if (!(nmp->opts & ERTS_NODES_MON_OPT_TYPE_HIDDEN)) + continue; + break; + case am_visible: + if ((nmp->opts & ERTS_NODES_MON_OPT_TYPES) + && !(nmp->opts & ERTS_NODES_MON_OPT_TYPE_VISIBLE)) + continue; + break; + default: + erl_exit(ERTS_ABORT_EXIT, "Bad node type found\n"); + } + } + + if (rp != nmp->proc) { + if (rp) { + if (rp == c_p) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + erts_smp_proc_unlock(rp, rp_locks); + } + + rp = nmp->proc; + rp_locks = 0; + if (rp == c_p) + rp_locks |= ERTS_PROC_LOCK_MAIN; + } + + ASSERT(rp); + + sz = nodes_mon_msg_sz(nmp, what, reason); + + for (i = 0, no = nmp->no; i < no; i++) + send_nodes_mon_msg(rp, + &rp_locks, + nmp, + node, + what, + type, + reason, + sz); + } + + if (rp) { + if (rp == c_p) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; + erts_smp_proc_unlock(rp, rp_locks); + } + + erts_smp_mtx_unlock(&nodes_monitors_mtx); +} + +static Eterm +insert_nodes_monitor(Process *c_p, Uint32 opts) +{ + Uint16 no = 1; + Eterm res = am_false; + ErtsNodesMonitor *xnmp, *nmp; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&nodes_monitors_mtx)); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN); + + xnmp = c_p->nodes_monitors; + if (xnmp) { + ASSERT(!xnmp->prev || xnmp->prev->proc != c_p); + + while (1) { + ASSERT(xnmp->proc == c_p); + if (xnmp->opts == opts) + break; + if (!xnmp->next || xnmp->next->proc != c_p) + break; + xnmp = xnmp->next; + } + ASSERT(xnmp); + ASSERT(xnmp->proc == c_p); + ASSERT(xnmp->opts == opts + || !xnmp->next + || xnmp->next->proc != c_p); + + if (xnmp->opts != opts) + goto alloc_new; + else { + res = am_true; + no = xnmp->no++; + if (!xnmp->no) { + /* + * 'no' wrapped; transfer all prevous monitors to new + * element (which will be the next element in the list) + * and set this to one... + */ + xnmp->no = 1; + goto alloc_new; + } + } + } + else { + alloc_new: + nmp = erts_alloc(ERTS_ALC_T_NODES_MON, sizeof(ErtsNodesMonitor)); + nmp->proc = c_p; + nmp->opts = opts; + nmp->no = no; + + if (xnmp) { + ASSERT(nodes_monitors); + ASSERT(c_p->nodes_monitors); + nmp->next = xnmp->next; + nmp->prev = xnmp; + xnmp->next = nmp; + if (nmp->next) { + ASSERT(nodes_monitors_end != xnmp); + ASSERT(nmp->next->prev == xnmp); + nmp->next->prev = nmp; + } + else { + ASSERT(nodes_monitors_end == xnmp); + nodes_monitors_end = nmp; + } + } + else { + ASSERT(!c_p->nodes_monitors); + c_p->nodes_monitors = nmp; + nmp->next = NULL; + nmp->prev = nodes_monitors_end; + if (nodes_monitors_end) { + ASSERT(nodes_monitors); + nodes_monitors_end->next = nmp; + } + else { + ASSERT(!nodes_monitors); + nodes_monitors = nmp; + } + nodes_monitors_end = nmp; + } + } + return res; +} + +static Eterm +remove_nodes_monitors(Process *c_p, Uint32 opts, int all) +{ + Eterm res = am_false; + ErtsNodesMonitor *nmp; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&nodes_monitors_mtx)); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) & ERTS_PROC_LOCK_MAIN); + + nmp = c_p->nodes_monitors; + ASSERT(!nmp || !nmp->prev || nmp->prev->proc != c_p); + + while (nmp && nmp->proc == c_p) { + if (!all && nmp->opts != opts) + nmp = nmp->next; + else { /* if (all || nmp->opts == opts) */ + ErtsNodesMonitor *free_nmp; + res = am_true; + if (nmp->prev) { + ASSERT(nodes_monitors != nmp); + nmp->prev->next = nmp->next; + } + else { + ASSERT(nodes_monitors == nmp); + nodes_monitors = nmp->next; + } + if (nmp->next) { + ASSERT(nodes_monitors_end != nmp); + nmp->next->prev = nmp->prev; + } + else { + ASSERT(nodes_monitors_end == nmp); + nodes_monitors_end = nmp->prev; + } + free_nmp = nmp; + nmp = nmp->next; + if (c_p->nodes_monitors == free_nmp) + c_p->nodes_monitors = nmp && nmp->proc == c_p ? nmp : NULL; + erts_free(ERTS_ALC_T_NODES_MON, free_nmp); + } + } + + ASSERT(!all || !c_p->nodes_monitors); + return res; +} + +void +erts_delete_nodes_monitors(Process *c_p, ErtsProcLocks locks) +{ +#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) + if (c_p) { + ErtsProcLocks might_unlock = locks & ~ERTS_PROC_LOCK_MAIN; + if (might_unlock) + erts_proc_lc_might_unlock(c_p, might_unlock); + } +#endif + if (erts_smp_mtx_trylock(&nodes_monitors_mtx) == EBUSY) { + ErtsProcLocks unlock_locks = locks & ~ERTS_PROC_LOCK_MAIN; + if (c_p && unlock_locks) + erts_smp_proc_unlock(c_p, unlock_locks); + erts_smp_mtx_lock(&nodes_monitors_mtx); + if (c_p && unlock_locks) + erts_smp_proc_lock(c_p, unlock_locks); + } + remove_nodes_monitors(c_p, 0, 1); + erts_smp_mtx_unlock(&nodes_monitors_mtx); +} + +Eterm +erts_monitor_nodes(Process *c_p, Eterm on, Eterm olist) +{ + Eterm res; + Eterm opts_list = olist; + Uint16 opts = (Uint16) 0; + + ASSERT(c_p); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN); + + if (on != am_true && on != am_false) + return THE_NON_VALUE; + + if (is_not_nil(opts_list)) { + int all = 0, visible = 0, hidden = 0; + + while (is_list(opts_list)) { + Eterm *cp = list_val(opts_list); + Eterm opt = CAR(cp); + opts_list = CDR(cp); + if (opt == am_nodedown_reason) + opts |= ERTS_NODES_MON_OPT_DOWN_REASON; + else if (is_tuple(opt)) { + Eterm* tp = tuple_val(opt); + if (arityval(tp[0]) != 2) + return THE_NON_VALUE; + switch (tp[1]) { + case am_node_type: + switch (tp[2]) { + case am_visible: + if (hidden || all) + return THE_NON_VALUE; + opts |= ERTS_NODES_MON_OPT_TYPE_VISIBLE; + visible = 1; + break; + case am_hidden: + if (visible || all) + return THE_NON_VALUE; + opts |= ERTS_NODES_MON_OPT_TYPE_HIDDEN; + hidden = 1; + break; + case am_all: + if (visible || hidden) + return THE_NON_VALUE; + opts |= ERTS_NODES_MON_OPT_TYPES; + all = 1; + break; + default: + return THE_NON_VALUE; + } + break; + default: + return THE_NON_VALUE; + } + } + else { + return THE_NON_VALUE; + } + } + + if (is_not_nil(opts_list)) + return THE_NON_VALUE; + } + + erts_smp_mtx_lock(&nodes_monitors_mtx); + + if (on == am_true) + res = insert_nodes_monitor(c_p, opts); + else + res = remove_nodes_monitors(c_p, opts, 0); + + erts_smp_mtx_unlock(&nodes_monitors_mtx); + + return res; +} + +/* + * Note, this function is only used for debuging. + */ + +Eterm +erts_processes_monitoring_nodes(Process *c_p) +{ + ErtsNodesMonitor *nmp; + Eterm res; + Eterm *hp; + Eterm **hpp; + Uint sz; + Uint *szp; +#ifdef DEBUG + Eterm *hend; +#endif + + ASSERT(c_p); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == ERTS_PROC_LOCK_MAIN); + erts_smp_mtx_lock(&nodes_monitors_mtx); + + sz = 0; + szp = &sz; + hpp = NULL; + + bld_result: + res = NIL; + + for (nmp = nodes_monitors_end; nmp; nmp = nmp->prev) { + Uint16 i; + for (i = 0; i < nmp->no; i++) { + Eterm olist = NIL; + if (nmp->opts & ERTS_NODES_MON_OPT_TYPES) { + Eterm type; + switch (nmp->opts & ERTS_NODES_MON_OPT_TYPES) { + case ERTS_NODES_MON_OPT_TYPES: type = am_all; break; + case ERTS_NODES_MON_OPT_TYPE_VISIBLE: type = am_visible; break; + case ERTS_NODES_MON_OPT_TYPE_HIDDEN: type = am_hidden; break; + default: erl_exit(ERTS_ABORT_EXIT, "Bad node type found\n"); + } + olist = erts_bld_cons(hpp, szp, + erts_bld_tuple(hpp, szp, 2, + am_node_type, + type), + olist); + } + if (nmp->opts & ERTS_NODES_MON_OPT_DOWN_REASON) + olist = erts_bld_cons(hpp, szp, am_nodedown_reason, olist); + res = erts_bld_cons(hpp, szp, + erts_bld_tuple(hpp, szp, 2, + nmp->proc->id, + olist), + res); + } + } + + if (!hpp) { + hp = HAlloc(c_p, sz); +#ifdef DEBUG + hend = hp + sz; +#endif + hpp = &hp; + szp = NULL; + goto bld_result; + } + + ASSERT(hp == hend); + + erts_smp_mtx_unlock(&nodes_monitors_mtx); + + return res; +} diff --git a/erts/emulator/beam/dist.h b/erts/emulator/beam/dist.h new file mode 100644 index 0000000000..ea1abcaeed --- /dev/null +++ b/erts/emulator/beam/dist.h @@ -0,0 +1,290 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __DIST_H__ +#define __DIST_H__ + +#include "erl_process.h" +#include "erl_node_tables.h" + +#define DFLAG_PUBLISHED 0x01 +#define DFLAG_ATOM_CACHE 0x02 +#define DFLAG_EXTENDED_REFERENCES 0x04 +#define DFLAG_DIST_MONITOR 0x08 +#define DFLAG_FUN_TAGS 0x10 +#define DFLAG_DIST_MONITOR_NAME 0x20 +#define DFLAG_HIDDEN_ATOM_CACHE 0x40 +#define DFLAG_NEW_FUN_TAGS 0x80 +#define DFLAG_EXTENDED_PIDS_PORTS 0x100 +#define DFLAG_EXPORT_PTR_TAG 0x200 +#define DFLAG_BIT_BINARIES 0x400 +#define DFLAG_NEW_FLOATS 0x800 +#define DFLAG_UNICODE_IO 0x1000 +#define DFLAG_DIST_HDR_ATOM_CACHE 0x2000 +#define DFLAG_SMALL_ATOM_TAGS 0x4000 + +/* All flags that should be enabled when term_to_binary/1 is used. */ +#define TERM_TO_BINARY_DFLAGS (DFLAG_EXTENDED_REFERENCES \ + | DFLAG_NEW_FUN_TAGS \ + | DFLAG_EXTENDED_PIDS_PORTS \ + | DFLAG_EXPORT_PTR_TAG \ + | DFLAG_BIT_BINARIES) + +/* opcodes used in distribution messages */ +#define DOP_LINK 1 +#define DOP_SEND 2 +#define DOP_EXIT 3 +#define DOP_UNLINK 4 +#define DOP_NODE_LINK 5 +#define DOP_REG_SEND 6 +#define DOP_GROUP_LEADER 7 +#define DOP_EXIT2 8 + +#define DOP_SEND_TT 12 +#define DOP_EXIT_TT 13 +#define DOP_REG_SEND_TT 16 +#define DOP_EXIT2_TT 18 + +#define DOP_MONITOR_P 19 +#define DOP_DEMONITOR_P 20 +#define DOP_MONITOR_P_EXIT 21 + +/* distribution trap functions */ +extern Export* dsend2_trap; +extern Export* dsend3_trap; +/*extern Export* dsend_nosuspend_trap;*/ +extern Export* dlink_trap; +extern Export* dunlink_trap; +extern Export* dmonitor_node_trap; +extern Export* dgroup_leader_trap; +extern Export* dexit_trap; +extern Export* dmonitor_p_trap; + +typedef enum { + ERTS_DSP_NO_LOCK, + ERTS_DSP_RLOCK, + ERTS_DSP_RWLOCK +} ErtsDSigPrepLock; + + +typedef struct { + Process *proc; + DistEntry *dep; + Eterm cid; + Eterm connection_id; + int no_suspend; +} ErtsDSigData; + +#define ERTS_DE_IS_NOT_CONNECTED(DEP) \ + (ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&(DEP)->rwmtx) \ + || erts_lc_rwmtx_is_rwlocked(&(DEP)->rwmtx)), \ + (is_nil((DEP)->cid) || ((DEP)->status & ERTS_DE_SFLG_EXITING))) + +#define ERTS_DE_IS_CONNECTED(DEP) \ + (!ERTS_DE_IS_NOT_CONNECTED((DEP))) + + +extern int erts_is_alive; + +/* + * erts_dsig_prepare() prepares a send of a distributed signal. + * One of the values defined below are returned. If the returned + * value is another than ERTS_DSIG_PREP_CONNECTED, the + * distributed signal cannot be sent before apropriate actions + * have been taken. Apropriate actions would typically be setting + * up the connection. + */ + +/* Connected; signal can be sent. */ +#define ERTS_DSIG_PREP_CONNECTED 0 +/* Not connected; connection needs to be set up. */ +#define ERTS_DSIG_PREP_NOT_CONNECTED 1 +/* Caller would be suspended on send operation. */ +#define ERTS_DSIG_PREP_WOULD_SUSPEND 2 +/* System not alive (distributed) */ +#define ERTS_DSIG_PREP_NOT_ALIVE 3 + +ERTS_GLB_INLINE int erts_dsig_prepare(ErtsDSigData *, + DistEntry *, + Process *, + ErtsDSigPrepLock, + int); + +ERTS_GLB_INLINE +void erts_schedule_dist_command(Port *, DistEntry *); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE int +erts_dsig_prepare(ErtsDSigData *dsdp, + DistEntry *dep, + Process *proc, + ErtsDSigPrepLock dspl, + int no_suspend) +{ + int failure; + if (!erts_is_alive) + return ERTS_DSIG_PREP_NOT_ALIVE; + if (!dep) + return ERTS_DSIG_PREP_NOT_CONNECTED; + if (dspl == ERTS_DSP_RWLOCK) + erts_smp_de_rwlock(dep); + else + erts_smp_de_rlock(dep); + if (ERTS_DE_IS_NOT_CONNECTED(dep)) { + failure = ERTS_DSIG_PREP_NOT_CONNECTED; + goto fail; + } + if (no_suspend) { + failure = ERTS_DSIG_PREP_CONNECTED; + erts_smp_spin_lock(&dep->qlock); + if (dep->qflgs & ERTS_DE_QFLG_BUSY) + failure = ERTS_DSIG_PREP_WOULD_SUSPEND; + erts_smp_spin_unlock(&dep->qlock); + if (failure == ERTS_DSIG_PREP_WOULD_SUSPEND) + goto fail; + } + dsdp->proc = proc; + dsdp->dep = dep; + dsdp->cid = dep->cid; + dsdp->connection_id = dep->connection_id; + dsdp->no_suspend = no_suspend; + if (dspl == ERTS_DSP_NO_LOCK) + erts_smp_de_runlock(dep); + return ERTS_DSIG_PREP_CONNECTED; + + fail: + if (dspl == ERTS_DSP_RWLOCK) + erts_smp_de_rwunlock(dep); + else + erts_smp_de_runlock(dep); + return failure; + +} + +ERTS_GLB_INLINE +void erts_schedule_dist_command(Port *prt, DistEntry *dist_entry) +{ + DistEntry *dep; + Eterm id; + + if (prt) { + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + ASSERT((erts_port_status_get(prt) & ERTS_PORT_SFLGS_DEAD) == 0); + ASSERT(prt->dist_entry); + + dep = prt->dist_entry; + id = prt->id; + } + else { + ASSERT(dist_entry); + ERTS_SMP_LC_ASSERT(erts_lc_rwmtx_is_rlocked(&dist_entry->rwmtx) + || erts_lc_rwmtx_is_rwlocked(&dist_entry->rwmtx)); + ASSERT(is_internal_port(dist_entry->cid)); + + dep = dist_entry; + id = dep->cid; + } + + if (!erts_smp_atomic_xchg(&dep->dist_cmd_scheduled, 1)) { + (void) erts_port_task_schedule(id, + &dep->dist_cmd, + ERTS_PORT_TASK_DIST_CMD, + (ErlDrvEvent) -1, + NULL); + } +} + +#endif + +typedef struct { + ErtsLink *d_lnk; + ErtsLink *d_sub_lnk; +} ErtsDistLinkData; + +ERTS_GLB_INLINE void erts_remove_dist_link(ErtsDistLinkData *, + Eterm, + Eterm, + DistEntry *); +ERTS_GLB_INLINE int erts_was_dist_link_removed(ErtsDistLinkData *); +ERTS_GLB_INLINE void erts_destroy_dist_link(ErtsDistLinkData *); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_remove_dist_link(ErtsDistLinkData *dldp, + Eterm lid, + Eterm rid, + DistEntry *dep) +{ + erts_smp_de_links_lock(dep); + dldp->d_lnk = erts_lookup_link(dep->nlinks, lid); + if (!dldp->d_lnk) + dldp->d_sub_lnk = NULL; + else { + dldp->d_sub_lnk = erts_remove_link(&ERTS_LINK_ROOT(dldp->d_lnk), rid); + dldp->d_lnk = (ERTS_LINK_ROOT(dldp->d_lnk) + ? NULL + : erts_remove_link(&dep->nlinks, lid)); + } + erts_smp_de_links_unlock(dep); +} + +ERTS_GLB_INLINE int +erts_was_dist_link_removed(ErtsDistLinkData *dldp) +{ + return dldp->d_sub_lnk != NULL; +} + +ERTS_GLB_INLINE void +erts_destroy_dist_link(ErtsDistLinkData *dldp) +{ + if (dldp->d_lnk) + erts_destroy_link(dldp->d_lnk); + if (dldp->d_sub_lnk) + erts_destroy_link(dldp->d_sub_lnk); +} + +#endif + +/* + * erts_dsig_send_* return values. + */ +#define ERTS_DSIG_SEND_OK 0 +#define ERTS_DSIG_SEND_YIELD 1 + +extern int erts_dsig_send_link(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_msg(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_exit_tt(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm); +extern int erts_dsig_send_unlink(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_reg_msg(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_group_leader(ErtsDSigData *, Eterm, Eterm); +extern int erts_dsig_send_exit(ErtsDSigData *, Eterm, Eterm, Eterm); +extern int erts_dsig_send_exit2(ErtsDSigData *, Eterm, Eterm, Eterm); +extern int erts_dsig_send_demonitor(ErtsDSigData *, Eterm, Eterm, Eterm, int); +extern int erts_dsig_send_monitor(ErtsDSigData *, Eterm, Eterm, Eterm); +extern int erts_dsig_send_m_exit(ErtsDSigData *, Eterm, Eterm, Eterm, Eterm); + +extern int erts_dist_command(Port *prt, int reds); +extern void erts_dist_port_not_busy(Port *prt); +extern void erts_kill_dist_connection(DistEntry *dep, Uint32); + +extern Uint erts_dist_cache_size(void); + +#endif diff --git a/erts/emulator/beam/elib_malloc.c b/erts/emulator/beam/elib_malloc.c new file mode 100644 index 0000000000..b18c48d8d6 --- /dev/null +++ b/erts/emulator/beam/elib_malloc.c @@ -0,0 +1,2334 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** Description: Faster malloc(). +*/ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" + +#ifdef ENABLE_ELIB_MALLOC + +#undef THREAD_SAFE_ELIB_MALLOC +#ifdef USE_THREADS +#define THREAD_SAFE_ELIB_MALLOC 1 +#else +#define THREAD_SAFE_ELIB_MALLOC 0 +#endif + +#include "erl_driver.h" +#include "erl_threads.h" +#include "elib_stat.h" +#include +#include + +/* To avoid clobbering of names becaure of reclaim on VxWorks, + we undefine all possible malloc, calloc etc. */ +#undef malloc +#undef calloc +#undef free +#undef realloc + +#define ELIB_INLINE /* inline all possible functions */ + +#ifndef ELIB_ALIGN +#define ELIB_ALIGN sizeof(double) +#endif + +#ifndef ELIB_HEAP_SIZE +#define ELIB_HEAP_SIZE (64*1024) /* Default 64K */ +#endif + +#ifndef ELIB_HEAP_INCREAMENT +#define ELIB_HEAP_INCREAMENT (32*1024) /* Default 32K */ +#endif + +#ifndef ELIB_FAILURE +#define ELIB_FAILURE abort() +#endif + +#undef ASSERT +#ifdef DEBUG +#define ASSERT(B) \ + ((void) ((B) ? 1 : (fprintf(stderr, "%s:%d: Assertion failed: %s\n", \ + __FILE__, __LINE__, #B), abort(), 0))) +#else +#define ASSERT(B) ((void) 1) +#endif + +#ifndef USE_RECURSIVE_MALLOC_MUTEX +#define USE_RECURSIVE_MALLOC_MUTEX 0 +#endif + +#if USE_RECURSIVE_MALLOC_MUTEX +static erts_mtx_t malloc_mutex = ERTS_REC_MTX_INITER; +#else /* #if USE_RECURSIVE_MALLOC_MUTEX */ +static erts_mtx_t malloc_mutex = ERTS_MTX_INITER; +#if THREAD_SAFE_ELIB_MALLOC +static erts_cnd_t malloc_cond = ERTS_CND_INITER; +#endif +#endif /* #if USE_RECURSIVE_MALLOC_MUTEX */ + +typedef unsigned long EWord; /* Assume 32-bit in this implementation */ +typedef unsigned short EHalfWord; /* Assume 16-bit in this implementation */ +typedef unsigned char EByte; /* Assume 8-bit byte */ + + +#define elib_printf fprintf +#define elib_putc fputc + + +#if defined(__STDC__) || defined(__WIN32__) +#define CONCAT(x,y) x##y +#else +#define CONCAT(x,y) x/**/y +#endif + + +#ifdef ELIB_DEBUG +#define ELIB_PREFIX(fun, args) CONCAT(elib__,fun) args +#else +#define ELIB_PREFIX(fun, args) CONCAT(elib_,fun) args +#endif + +#if defined(__STDC__) +void *ELIB_PREFIX(malloc, (size_t)); +void *ELIB_PREFIX(calloc, (size_t, size_t)); +void ELIB_PREFIX(cfree, (EWord *)); +void ELIB_PREFIX(free, (EWord *)); +void *ELIB_PREFIX(realloc, (EWord *, size_t)); +void* ELIB_PREFIX(memresize, (EWord *, int)); +void* ELIB_PREFIX(memalign, (int, int)); +void* ELIB_PREFIX(valloc, (int)); +void* ELIB_PREFIX(pvalloc, (int)); +int ELIB_PREFIX(memsize, (EWord *)); +/* Extern interfaces used by VxWorks */ +size_t elib_sizeof(void *); +void elib_init(EWord *, EWord); +void elib_force_init(EWord *, EWord); +#endif + +#if defined(__STDC__) +/* define prototypes for missing */ +void* memalign(size_t a, size_t s); +void* pvalloc(size_t nb); +void* memresize(void *p, int nb); +int memsize(void *p); +#endif + +/* bytes to pages */ +#define PAGES(x) (((x)+page_size-1) / page_size) +#define PAGE_ALIGN(p) ((char*)((((EWord)(p))+page_size-1)&~(page_size-1))) + +/* bytes to words */ +#define WORDS(x) (((x)+sizeof(EWord)-1) / sizeof(EWord)) + +/* Align an address */ +#define ALIGN(p) ((EWord*)((((EWord)(p)+ELIB_ALIGN-1)&~(ELIB_ALIGN-1)))) + +/* Calculate the size needed to keep alignment */ + +#define ALIGN_BSZ(nb) ((nb+sizeof(EWord)+ELIB_ALIGN-1) & ~(ELIB_ALIGN-1)) + +#define ALIGN_WSZ(nb) WORDS(ALIGN_BSZ(nb)) + +#define ALIGN_SIZE(nb) (ALIGN_WSZ(nb) - 1) + + +/* PARAMETERS */ + +#if defined(ELIB_HEAP_SBRK) + +#undef PAGE_SIZE + +/* Get the system page size (NEED MORE DEFINES HERE) */ +#ifdef _SC_PAGESIZE +#define PAGE_SIZE sysconf(_SC_PAGESIZE) +#elif defined(_MSC_VER) +# ifdef _M_ALPHA +# define PAGE_SIZE 0x2000 +# else +# define PAGE_SIZE 0x1000 +# endif +#else +#define PAGE_SIZE getpagesize() +#endif + +#define ELIB_EXPAND(need) expand_sbrk(need) +static FUNCTION(int, expand_sbrk, (EWord)); + +#elif defined(ELIB_HEAP_FIXED) + +#define PAGE_SIZE 1024 +#define ELIB_EXPAND(need) -1 +static EWord fix_heap[WORDS(ELIB_HEAP_SIZE)]; + +#elif defined(ELIB_HEAP_USER) + +#define PAGE_SIZE 1024 +#define ELIB_EXPAND(need) -1 + +#else + +#error "ELIB HEAP TYPE NOT SET" + +#endif + + +#define STAT_ALLOCED_BLOCK(SZ) \ +do { \ + tot_allocated += (SZ); \ + if (max_allocated < tot_allocated) \ + max_allocated = tot_allocated; \ +} while (0) + +#define STAT_FREED_BLOCK(SZ) \ +do { \ + tot_allocated -= (SZ); \ +} while (0) + +static int max_allocated = 0; +static int tot_allocated = 0; +static EWord* eheap; /* Align heap start */ +static EWord* eheap_top; /* Point to end of heap */ +EWord page_size = 0; /* Set by elib_init */ + +#if defined(ELIB_DEBUG) || defined(DEBUG) +#define ALIGN_CHECK(a, p) \ + do { \ + if ((EWord)(p) & (a-1)) { \ + elib_printf(stderr, \ + "RUNTIME ERROR: bad alignment (0x%lx:%d:%d)\n", \ + (unsigned long) (p), (int) a, __LINE__); \ + ELIB_FAILURE; \ + } \ + } while(0) +#define ELIB_ALIGN_CHECK(p) ALIGN_CHECK(ELIB_ALIGN, p) +#else +#define ALIGN_CHECK(a, p) +#define ELIB_ALIGN_CHECK(p) +#endif + +#define DYNAMIC 32 + +/* +** Free block layout +** 1 1 30 +** +--------------------------+ +** |F|P| Size | +** +--------------------------+ +** +** Where F is the free bit +** P is the free above bit +** Size is messured in words and does not include the hdr word +** +** If block is on the free list the size is also stored last in the block. +** +*/ +typedef struct _free_block FreeBlock; +struct _free_block { + EWord hdr; + Uint flags; + FreeBlock* parent; + FreeBlock* left; + FreeBlock* right; + EWord v[1]; +}; + +typedef struct _allocated_block { + EWord hdr; + EWord v[5]; +} AllocatedBlock; + + +/* + * Interface to tree routines. + */ +typedef Uint Block_t; + +static Block_t* get_free_block(Uint); +static void link_free_block(Block_t *); +static void unlink_free_block(Block_t *del); + +#define FREE_BIT 0x80000000 +#define FREE_ABOVE_BIT 0x40000000 +#define SIZE_MASK 0x3fffffff /* 2^30 words = 2^32 bytes */ + +/* Work on both FreeBlock and AllocatedBlock */ +#define SIZEOF(p) ((p)->hdr & SIZE_MASK) +#define IS_FREE(p) (((p)->hdr & FREE_BIT) != 0) +#define IS_FREE_ABOVE(p) (((p)->hdr & FREE_ABOVE_BIT) != 0) + +/* Given that we have a free block above find its size */ +#define SIZEOF_ABOVE(p) *(((EWord*) (p)) - 1) + +#define MIN_BLOCK_SIZE (sizeof(FreeBlock)/sizeof(EWord)) +#define MIN_WORD_SIZE (MIN_BLOCK_SIZE-1) +#define MIN_BYTE_SIZE (sizeof(FreeBlock)-sizeof(EWord)) + +#define MIN_ALIGN_SIZE ALIGN_SIZE(MIN_BYTE_SIZE) + + +static AllocatedBlock* heap_head = 0; +static AllocatedBlock* heap_tail = 0; +static EWord eheap_size = 0; + +static int heap_locked; + +static int elib_need_init = 1; +#if THREAD_SAFE_ELIB_MALLOC +static int elib_is_initing = 0; +#endif + +typedef FreeBlock RBTree_t; + +static RBTree_t* root = NULL; + + +static FUNCTION(void, deallocate, (AllocatedBlock*, int)); + +/* + * Unlink a free block + */ + +#define mark_allocated(p, szp) do { \ + (p)->hdr = ((p)->hdr & FREE_ABOVE_BIT) | (szp); \ + (p)->v[szp] &= ~FREE_ABOVE_BIT; \ + } while(0) + +#define mark_free(p, szp) do { \ + (p)->hdr = FREE_BIT | (szp); \ + ((FreeBlock *)p)->v[szp-sizeof(FreeBlock)/sizeof(EWord)+1] = (szp); \ + } while(0) + +#if 0 +/* Help macros to log2 */ +#define LOG_1(x) (((x) > 1) ? 1 : 0) +#define LOG_2(x) (((x) > 3) ? 2+LOG_1((x) >> 2) : LOG_1(x)) +#define LOG_4(x) (((x) > 15) ? 4+LOG_2((x) >> 4) : LOG_2(x)) +#define LOG_8(x) (((x) > 255) ? 8+LOG_4((x)>>8) : LOG_4(x)) +#define LOG_16(x) (((x) > 65535) ? 16+LOG_8((x)>>16) : LOG_8(x)) + +#define log2(x) LOG_16(x) +#endif + +/* + * Split a block to be allocated. + * Mark block as ALLOCATED and clear + * FREE_ABOVE_BIT on next block + * + * nw is SIZE aligned and szp is SIZE aligned + 1 + */ +static void +split_block(FreeBlock* p, EWord nw, EWord szp) +{ + EWord szq; + FreeBlock* q; + + szq = szp - nw; + /* Preserve FREE_ABOVE bit in p->hdr !!! */ + + if (szq >= MIN_ALIGN_SIZE+1) { + szq--; + p->hdr = (p->hdr & FREE_ABOVE_BIT) | nw; + + q = (FreeBlock*) (((EWord*) p) + nw + 1); + mark_free(q, szq); + link_free_block((Block_t *) q); + + q = (FreeBlock*) (((EWord*) q) + szq + 1); + q->hdr |= FREE_ABOVE_BIT; + } + else { + mark_allocated((AllocatedBlock*)p, szp); + } +} + +/* + * Find a free block + */ +static FreeBlock* +alloc_block(EWord nw) +{ + for (;;) { + FreeBlock* p = (FreeBlock *) get_free_block(nw); + + if (p != NULL) { + return p; + } else if (ELIB_EXPAND(nw+MIN_WORD_SIZE)) { + return 0; + } + } +} + + +size_t elib_sizeof(void *p) +{ + AllocatedBlock* pp; + + if (p != 0) { + pp = (AllocatedBlock*) (((char *)p)-1); + return SIZEOF(pp); + } + return 0; +} + +static void locked_elib_init(EWord*, EWord); +static void init_elib_malloc(EWord*, EWord); + +/* +** Initialize the elib +** The addr and sz is only used when compiled with EXPAND_ADDR +*/ +/* Not static, this is used by VxWorks */ +void elib_init(EWord* addr, EWord sz) +{ + if (!elib_need_init) + return; + erts_mtx_lock(&malloc_mutex); + locked_elib_init(addr, sz); + erts_mtx_unlock(&malloc_mutex); +} + +static void locked_elib_init(EWord* addr, EWord sz) +{ + if (!elib_need_init) + return; + +#if THREAD_SAFE_ELIB_MALLOC + +#if !USE_RECURSIVE_MALLOC_MUTEX + { + static erts_tid_t initer_tid; + + if(elib_is_initing) { + + if(erts_equal_tids(initer_tid, erts_thr_self())) + return; + + /* Wait until initializing thread is done with initialization */ + + while(elib_need_init) + erts_cnd_wait(&malloc_cond, &malloc_mutex); + + return; + } + else { + initer_tid = erts_thr_self(); + elib_is_initing = 1; + } + } +#else + if(elib_is_initing) + return; + elib_is_initing = 1; +#endif + +#endif /* #if THREAD_SAFE_ELIB_MALLOC */ + + /* Do the actual initialization of the malloc implementation */ + init_elib_malloc(addr, sz); + +#if THREAD_SAFE_ELIB_MALLOC + +#if !USE_RECURSIVE_MALLOC_MUTEX + erts_mtx_unlock(&malloc_mutex); +#endif + + /* Recursive calls to malloc are allowed here... */ + erts_mtx_set_forksafe(&malloc_mutex); + +#if !USE_RECURSIVE_MALLOC_MUTEX + erts_mtx_lock(&malloc_mutex); + elib_is_initing = 0; +#endif + +#endif /* #if THREAD_SAFE_ELIB_MALLOC */ + + elib_need_init = 0; + +#if THREAD_SAFE_ELIB_MALLOC && !USE_RECURSIVE_MALLOC_MUTEX + erts_cnd_broadcast(&malloc_cond); +#endif + +} + +static void init_elib_malloc(EWord* addr, EWord sz) +{ + int i; + FreeBlock* freep; + EWord tmp_sz; +#ifdef ELIB_HEAP_SBRK + char* top; + EWord n; +#endif + + max_allocated = 0; + tot_allocated = 0; + root = NULL; + + /* Get the page size (may involve system call!!!) */ + page_size = PAGE_SIZE; + +#if defined(ELIB_HEAP_SBRK) + sz = PAGES(ELIB_HEAP_SIZE)*page_size; + + if ((top = (char*) sbrk(0)) == (char*)-1) { + elib_printf(stderr, "could not initialize elib, sbrk(0)"); + ELIB_FAILURE; + } + n = PAGE_ALIGN(top) - top; + if ((top = (char*) sbrk(n)) == (char*)-1) { + elib_printf(stderr, "could not initialize elib, sbrk(n)"); + ELIB_FAILURE; + } + if ((eheap = (EWord*) sbrk(sz)) == (EWord*)-1) { + elib_printf(stderr, "could not initialize elib, sbrk(SIZE)"); + ELIB_FAILURE; + } + sz = WORDS(ELIB_HEAP_SIZE); +#elif defined(ELIB_HEAP_FIXED) + eheap = fix_heap; + sz = WORDS(ELIB_HEAP_SIZE); +#elif defined(ELIB_HEAP_USER) + eheap = addr; + sz = WORDS(sz); +#else + return -1; +#endif + eheap_size = 0; + + /* Make sure that the first word of the heap_head is aligned */ + addr = ALIGN(eheap+1); + sz -= ((addr - 1) - eheap); /* Subtract unusable size */ + eheap_top = eheap = addr - 1; /* Set new aligned heap start */ + + eheap_top[sz-1] = 0; /* Heap stop mark */ + + addr = eheap; + heap_head = (AllocatedBlock*) addr; + heap_head->hdr = MIN_ALIGN_SIZE; + for (i = 0; i < MIN_ALIGN_SIZE; i++) + heap_head->v[i] = 0; + + addr += (MIN_ALIGN_SIZE+1); + freep = (FreeBlock*) addr; + tmp_sz = sz - (((MIN_ALIGN_SIZE+1) + MIN_BLOCK_SIZE) + 1 + 1); + mark_free(freep, tmp_sz); + link_free_block((Block_t *) freep); + + /* No need to align heap tail */ + heap_tail = (AllocatedBlock*) &eheap_top[sz-MIN_BLOCK_SIZE-1]; + heap_tail->hdr = FREE_ABOVE_BIT | MIN_WORD_SIZE; + heap_tail->v[0] = 0; + heap_tail->v[1] = 0; + heap_tail->v[2] = 0; + + eheap_top += sz; + eheap_size += sz; + + heap_locked = 0; +} + +#ifdef ELIB_HEAP_USER +void elib_force_init(EWord* addr, EWord sz) +{ + elib_need_init = 1; + elib_init(addr,sz); +} +#endif + +#ifdef ELIB_HEAP_SBRK + +/* +** need in number of words (should include head and tail words) +*/ +static int expand_sbrk(EWord sz) +{ + EWord* p; + EWord bytes = sz * sizeof(EWord); + EWord size; + AllocatedBlock* tail; + + if (bytes < ELIB_HEAP_SIZE) + size = PAGES(ELIB_HEAP_INCREAMENT)*page_size; + else + size = PAGES(bytes)*page_size; + + if ((p = (EWord*) sbrk(size)) == ((EWord*) -1)) + return -1; + + if (p != eheap_top) { + elib_printf(stderr, "panic: sbrk moved\n"); + ELIB_FAILURE; + } + + sz = WORDS(size); + + /* Set new endof heap marker and a new heap tail */ + eheap_top[sz-1] = 0; + + tail = (AllocatedBlock*) &eheap_top[sz-MIN_BLOCK_SIZE-1]; + tail->hdr = FREE_ABOVE_BIT | MIN_WORD_SIZE; + tail->v[0] = 0; + tail->v[1] = 0; + tail->v[2] = 0; + + /* Patch old tail with new appended size */ + heap_tail->hdr = (heap_tail->hdr & FREE_ABOVE_BIT) | + (MIN_WORD_SIZE+1+(sz-MIN_BLOCK_SIZE-1)); + deallocate(heap_tail, 0); + + heap_tail = tail; + + eheap_size += sz; + eheap_top += sz; + + return 0; +} + +#endif /* ELIB_HEAP_SBRK */ + + +/* +** Scan heap and check for corrupted heap +*/ +int elib_check_heap(void) +{ + AllocatedBlock* p = heap_head; + EWord sz; + + if (heap_locked) { + elib_printf(stderr, "heap is locked no info avaiable\n"); + return 0; + } + + while((sz = SIZEOF(p)) != 0) { + if (IS_FREE(p)) { + if (p->v[sz-1] != sz) { + elib_printf(stderr, "panic: heap corrupted\r\n"); + ELIB_FAILURE; + } + p = (AllocatedBlock*) (p->v + sz); + if (!IS_FREE_ABOVE(p)) { + elib_printf(stderr, "panic: heap corrupted\r\n"); + ELIB_FAILURE; + } + } + else + p = (AllocatedBlock*) (p->v + sz); + } + return 1; +} + +/* +** Load the byte vector pointed to by v of length vsz +** with a heap image +** The scale is defined by vsz and the current heap size +** free = 0, full = 255 +** +** +*/ +int elib_heap_map(EByte* v, int vsz) +{ + AllocatedBlock* p = heap_head; + EWord sz; + int gsz = eheap_size / vsz; /* The granuality used */ + int fsz = 0; + int usz = 0; + + if (gsz == 0) + return -1; /* too good reolution */ + + while((sz = SIZEOF(p)) != 0) { + if (IS_FREE(p)) { + fsz += sz; + if ((fsz + usz) > gsz) { + *v++ = (255*usz)/gsz; + fsz -= (gsz - usz); + usz = 0; + while(fsz >= gsz) { + *v++ = 0; + fsz -= gsz; + } + } + } + else { + usz += sz; + if ((fsz + usz) > gsz) { + *v++ = 255 - (255*fsz)/gsz; + usz -= (gsz - fsz); + fsz = 0; + while(usz >= gsz) { + *v++ = 255; + usz -= gsz; + } + } + } + p = (AllocatedBlock*) (p->v + sz); + } + return 0; +} + +/* +** Generate a histogram of free/allocated blocks +** Count granuality of 10 gives +** (0-10],(10-100],(100-1000],(1000-10000] ... +** (0-2], (2-4], (4-8], (8-16], .... +*/ +static int i_logb(EWord size, int base) +{ + int lg = 0; + while(size >= base) { + size /= base; + lg++; + } + return lg; +} + +int elib_histo(EWord* vf, EWord* va, int vsz, int base) +{ + AllocatedBlock* p = heap_head; + EWord sz; + int i; + int linear; + + if ((vsz <= 1) || (vf == 0 && va == 0)) + return -1; + + if (base < 0) { + linear = 1; + base = -base; + } + else + linear = 0; + + if (base <= 1) + return -1; + + if (vf != 0) { + for (i = 0; i < vsz; i++) + vf[i] = 0; + } + if (va != 0) { + for (i = 0; i < vsz; i++) + va[i] = 0; + } + + while((sz = SIZEOF(p)) != 0) { + if (IS_FREE(p)) { + if (vf != 0) { + int val; + if (linear) + val = sz / base; + else + val = i_logb(sz, base); + if (val >= vsz) + vf[vsz-1]++; + else + vf[val]++; + } + } + else { + if (va != 0) { + int val; + if (linear) + val = sz / base; + else + val = i_logb(sz, base); + if (val >= vsz) + va[vsz-1]++; + else + va[val]++; + } + } + p = (AllocatedBlock*) (p->v + sz); + } + return 0; +} + +/* +** Fill the info structure with actual values +** Total +** Allocated +** Free +** maxMaxFree +*/ +void elib_stat(struct elib_stat* info) +{ + EWord blks = 0; + EWord sz_free = 0; + EWord sz_alloc = 0; + EWord sz_max_free = 0; + EWord sz_min_used = 0x7fffffff; + EWord sz; + EWord num_free = 0; + AllocatedBlock* p = heap_head; + + info->mem_total = eheap_size; + + p = (AllocatedBlock*) (p->v + SIZEOF(p)); + + while((sz = SIZEOF(p)) != 0) { + blks++; + if (IS_FREE(p)) { + if (sz > sz_max_free) + sz_max_free = sz; + sz_free += sz; + ++num_free; + } + else { + if (sz < sz_min_used) + sz_min_used = sz; + sz_alloc += sz; + } + p = (AllocatedBlock*) (p->v + sz); + } + info->mem_blocks = blks; + info->free_blocks = num_free; + info->mem_alloc = sz_alloc; + info->mem_free = sz_free; + info->min_used = sz_min_used; + info->max_free = sz_max_free; + info->mem_max_alloc = max_allocated; + ASSERT(sz_alloc == tot_allocated); +} + +/* +** Dump the heap +*/ +void elib_heap_dump(char* label) +{ + AllocatedBlock* p = heap_head; + EWord sz; + + elib_printf(stderr, "HEAP DUMP (%s)\n", label); + if (!elib_check_heap()) + return; + + while((sz = SIZEOF(p)) != 0) { + if (IS_FREE(p)) { + elib_printf(stderr, "%p: FREE, size = %d\n", p, (int) sz); + } + else { + elib_printf(stderr, "%p: USED, size = %d %s\n", p, (int) sz, + IS_FREE_ABOVE(p)?"(FREE ABOVE)":""); + } + p = (AllocatedBlock*) (p->v + sz); + } +} + +/* +** Scan heaps and count: +** free_size, allocated_size, max_free_block +*/ +void elib_statistics(void* to) +{ + struct elib_stat info; + EWord frag; + + if (!elib_check_heap()) + return; + + elib_stat(&info); + + frag = 1000 - ((1000 * info.max_free) / info.mem_free); + + elib_printf(to, "Heap Statistics: total(%d), blocks(%d), frag(%d.%d%%)\n", + info.mem_total, info.mem_blocks, + (int) frag/10, (int) frag % 10); + + elib_printf(to, " allocated(%d), free(%d), " + "free_blocks(%d)\n", + info.mem_alloc, info.mem_free,info.free_blocks); + elib_printf(to, " max_free(%d), min_used(%d)\n", + info.max_free, info.min_used); +} + +/* +** Allocate a least nb bytes with alignment a +** Algorithm: +** 1) Try locate a block which match exacly among the by direct index. +** 2) Try using a fix block of greater size +** 3) Try locate a block by searching in lists where block sizes +** X may vary between 2^i < X <= 2^(i+1) +** +** Reset memory to zero if clear is true +*/ +static AllocatedBlock* allocate(EWord nb, EWord a, int clear) +{ + FreeBlock* p; + EWord nw; + + if (a == ELIB_ALIGN) { + /* + * Common case: Called by malloc(), realloc(), calloc(). + */ + nw = nb < MIN_BYTE_SIZE ? MIN_ALIGN_SIZE : ALIGN_SIZE(nb); + + if ((p = alloc_block(nw)) == 0) + return NULL; + } else { + /* + * Special case: Called by memalign(). + */ + EWord asz, szp, szq, tmpsz; + FreeBlock *q; + + if ((p = alloc_block((1+MIN_ALIGN_SIZE)*sizeof(EWord)+a-1+nb)) == 0) + return NULL; + + asz = a - ((EWord) ((AllocatedBlock *)p)->v) % a; + + if (asz != a) { + /* Enforce the alignment requirement by cutting of a free + block at the beginning of the block. */ + + if (asz < (1+MIN_ALIGN_SIZE)*sizeof(EWord) && !IS_FREE_ABOVE(p)) { + /* Not enough room to cut of a free block; + increase align size */ + asz += (((1+MIN_ALIGN_SIZE)*sizeof(EWord) + a - 1)/a)*a; + } + + szq = ALIGN_SIZE(asz - sizeof(EWord)); + szp = SIZEOF(p) - szq - 1; + + q = p; + p = (FreeBlock*) (((EWord*) q) + szq + 1); + p->hdr = FREE_ABOVE_BIT | FREE_BIT | szp; + + if (IS_FREE_ABOVE(q)) { /* This should not be possible I think, + but just in case... */ + tmpsz = SIZEOF_ABOVE(q) + 1; + szq += tmpsz; + q = (FreeBlock*) (((EWord*) q) - tmpsz); + unlink_free_block((Block_t *) q); + q->hdr = (q->hdr & FREE_ABOVE_BIT) | FREE_BIT | szq; + } + mark_free(q, szq); + link_free_block((Block_t *) q); + + } /* else already had the correct alignment */ + + nw = nb < MIN_BYTE_SIZE ? MIN_ALIGN_SIZE : ALIGN_SIZE(nb); + } + + split_block(p, nw, SIZEOF(p)); + + STAT_ALLOCED_BLOCK(SIZEOF(p)); + + if (clear) { + EWord* pp = ((AllocatedBlock*)p)->v; + + while(nw--) + *pp++ = 0; + } + + return (AllocatedBlock*) p; +} + + +/* +** Deallocate memory pointed to by p +** 1. Merge with block above if this block is free +** 2. Merge with block below if this block is free +** Link the block to the correct free list +** +** p points to the block header! +** +*/ +static void deallocate(AllocatedBlock* p, int stat_count) +{ + FreeBlock* q; + EWord szq; + EWord szp; + + szp = SIZEOF(p); + + if (stat_count) + STAT_FREED_BLOCK(SIZEOF(p)); + + if (IS_FREE_ABOVE(p)) { + szq = SIZEOF_ABOVE(p); + q = (FreeBlock*) ( ((EWord*) p) - szq - 1); + unlink_free_block((Block_t *) q); + + p = (AllocatedBlock*) q; + szp += (szq + 1); + } + q = (FreeBlock*) (p->v + szp); + if (IS_FREE(q)) { + szq = SIZEOF(q); + unlink_free_block((Block_t *) q); + szp += (szq + 1); + } + else + q->hdr |= FREE_ABOVE_BIT; + + /* The block above p can NEVER be free !!! */ + p->hdr = FREE_BIT | szp; + p->v[szp-1] = szp; + + link_free_block((Block_t *) p); +} + +/* +** Reallocate memory +** If preserve is true then data is moved if neccesary +*/ +static AllocatedBlock* reallocate(AllocatedBlock* p, EWord nb, int preserve) +{ + EWord szp; + EWord szq; + EWord sz; + EWord nw; + FreeBlock* q; + + if (nb < MIN_BYTE_SIZE) + nw = MIN_ALIGN_SIZE; + else + nw = ALIGN_SIZE(nb); + + sz = szp = SIZEOF(p); + + STAT_FREED_BLOCK(szp); + + /* Merge with block below */ + q = (FreeBlock*) (p->v + szp); + if (IS_FREE(q)) { + szq = SIZEOF(q); + unlink_free_block((Block_t *) q); + szp += (szq + 1); + } + + if (nw <= szp) { + split_block((FreeBlock *) p, nw, szp); + STAT_ALLOCED_BLOCK(SIZEOF(p)); + return p; + } + else { + EWord* dp = p->v; + AllocatedBlock* npp; + + if (IS_FREE_ABOVE(p)) { + szq = SIZEOF_ABOVE(p); + if (szq + szp + 1 >= nw) { + q = (FreeBlock*) (((EWord*) p) - szq - 1); + unlink_free_block((Block_t * )q); + szp += (szq + 1); + p = (AllocatedBlock*) q; + + if (preserve) { + EWord* pp = p->v; + while(sz--) + *pp++ = *dp++; + } + split_block((FreeBlock *) p, nw, szp); + STAT_ALLOCED_BLOCK(SIZEOF(p)); + return p; + } + } + + /* + * Update p so that allocate() and deallocate() works. + * (Note that allocate() may call expand_sbrk(), which in + * in turn calls deallocate().) + */ + + p->hdr = (p->hdr & FREE_ABOVE_BIT) | szp; + p->v[szp] &= ~FREE_ABOVE_BIT; + + npp = allocate(nb, ELIB_ALIGN, 0); + if(npp == NULL) + return NULL; + if (preserve) { + EWord* pp = npp->v; + while(sz--) + *pp++ = *dp++; + } + deallocate(p, 0); + return npp; + } +} + +/* +** What malloc() and friends should do (and return) when the heap is +** exhausted. [sverkerw] +*/ +static void* heap_exhausted(void) +{ + /* Choose behaviour */ +#if 0 + /* Crash-and-burn --- leave a usable corpse (hopefully) */ + abort(); +#endif + /* The usual ANSI-compliant behaviour */ + return NULL; +} + +/* +** Allocate size bytes of memory +*/ +void* ELIB_PREFIX(malloc, (size_t nb)) +{ + void *res; + AllocatedBlock* p; + + erts_mtx_lock(&malloc_mutex); + if (elib_need_init) + locked_elib_init(NULL,(EWord)0); + + if (nb == 0) + res = NULL; + else if ((p = allocate(nb, ELIB_ALIGN, 0)) != 0) { + ELIB_ALIGN_CHECK(p->v); + res = p->v; + } + else + res = heap_exhausted(); + + erts_mtx_unlock(&malloc_mutex); + + return res; +} + + +void* ELIB_PREFIX(calloc, (size_t nelem, size_t size)) +{ + void *res; + int nb; + AllocatedBlock* p; + + erts_mtx_lock(&malloc_mutex); + if (elib_need_init) + locked_elib_init(NULL,(EWord)0); + + if ((nb = nelem * size) == 0) + res = NULL; + else if ((p = allocate(nb, ELIB_ALIGN, 1)) != 0) { + ELIB_ALIGN_CHECK(p->v); + res = p->v; + } + else + res = heap_exhausted(); + + erts_mtx_unlock(&malloc_mutex); + + return res; +} + +/* +** Free memory allocated by malloc +*/ + +void ELIB_PREFIX(free, (EWord* p)) +{ + erts_mtx_lock(&malloc_mutex); + if (elib_need_init) + locked_elib_init(NULL,(EWord)0); + + if (p != 0) + deallocate((AllocatedBlock*)(p-1), 1); + + erts_mtx_unlock(&malloc_mutex); +} + +void ELIB_PREFIX(cfree, (EWord* p)) +{ + ELIB_PREFIX(free, (p)); +} + + +/* +** Realloc the memory allocated in p to nb number of bytes +** +*/ + +void* ELIB_PREFIX(realloc, (EWord* p, size_t nb)) +{ + void *res = NULL; + AllocatedBlock* pp; + + erts_mtx_lock(&malloc_mutex); + if (elib_need_init) + locked_elib_init(NULL,(EWord)0); + + if (p != 0) { + pp = (AllocatedBlock*) (p-1); + if (nb > 0) { + if ((pp = reallocate(pp, nb, 1)) != 0) { + ELIB_ALIGN_CHECK(pp->v); + res = pp->v; + } + } + else + deallocate(pp, 1); + } + else if (nb > 0) { + if ((pp = allocate(nb, ELIB_ALIGN, 0)) != 0) { + ELIB_ALIGN_CHECK(pp->v); + res = pp->v; + } + else + res = heap_exhausted(); + } + + erts_mtx_unlock(&malloc_mutex); + + return res; +} + +/* +** Resize the memory area pointed to by p with nb number of bytes +*/ +void* ELIB_PREFIX(memresize, (EWord* p, int nb)) +{ + void *res = NULL; + AllocatedBlock* pp; + + erts_mtx_lock(&malloc_mutex); + if (elib_need_init) + locked_elib_init(NULL,(EWord)0); + + if (p != 0) { + pp = (AllocatedBlock*) (p-1); + if (nb > 0) { + if ((pp = reallocate(pp, nb, 0)) != 0) { + ELIB_ALIGN_CHECK(pp->v); + res = pp->v; + } + } + else + deallocate(pp, 1); + } + else if (nb > 0) { + if ((pp = allocate(nb, ELIB_ALIGN, 0)) != 0) { + ELIB_ALIGN_CHECK(pp->v); + res = pp->v; + } + else + res = heap_exhausted(); + } + + erts_mtx_unlock(&malloc_mutex); + + return res; +} + + +/* Create aligned memory a must be a power of 2 !!! */ + +void* ELIB_PREFIX(memalign, (int a, int nb)) +{ + void *res; + AllocatedBlock* p; + + erts_mtx_lock(&malloc_mutex); + if (elib_need_init) + locked_elib_init(NULL,(EWord)0); + + if (nb == 0 || a <= 0) + res = NULL; + else if ((p = allocate(nb, a, 0)) != 0) { + ALIGN_CHECK(a, p->v); + res = p->v; + } + else + res = heap_exhausted(); + + erts_mtx_unlock(&malloc_mutex); + + return res; +} + +void* ELIB_PREFIX(valloc, (int nb)) +{ + return ELIB_PREFIX(memalign, (page_size, nb)); +} + + +void* ELIB_PREFIX(pvalloc, (int nb)) +{ + return ELIB_PREFIX(memalign, (page_size, PAGES(nb)*page_size)); +} +/* Return memory size for pointer p in bytes */ + +int ELIB_PREFIX(memsize, (p)) +EWord* p; +{ + return SIZEOF((AllocatedBlock*)(p-1))*4; +} + + +/* +** -------------------------------------------------------------------------- +** DEBUG LIBRARY +** -------------------------------------------------------------------------- +*/ + +#ifdef ELIB_DEBUG + +#define IN_HEAP(p) (((p) >= (char*) eheap) && (p) < (char*) eheap_top) +/* +** ptr_to_block: return the pointer to heap block pointed into by ptr +** Returns 0 if not pointing into a block +*/ + +static EWord* ptr_to_block(char* ptr) +{ + AllocatedBlock* p = heap_head; + EWord sz; + + while((sz = SIZEOF(p)) != 0) { + if ((ptr >= (char*) p->v) && (ptr < (char*)(p->v+sz))) + return p->v; + p = (AllocatedBlock*) (p->v + sz); + } + return 0; +} + +/* +** Validate a pointer +** returns: +** 0 - if points to start of a block +** 1 - if points outsize heap +** -1 - if points inside block +** +*/ +static int check_pointer(char* ptr) +{ + if (IN_HEAP(ptr)) { + if (ptr_to_block(ptr) == 0) + return 1; + return 0; + } + return -1; +} + +/* +** Validate a memory area +** returns: +** 0 - if area is included in a block +** -1 - if area overlap a heap block +** 1 - if area is outside heap +*/ +static int check_area(char* ptr, int n) +{ + if (IN_HEAP(ptr)) { + if (IN_HEAP(ptr+n-1)) { + EWord* p1 = ptr_to_block(ptr); + EWord* p2 = ptr_to_block(ptr+n-1); + + if (p1 == p2) + return (p1 == 0) ? -1 : 0; + return -1; + } + } + else if (IN_HEAP(ptr+n-1)) + return -1; + return 1; +} + +/* +** Check if a block write will overwrite heap block +*/ +static void check_write(char* ptr, int n, char* file, int line, char* fun) +{ + if (check_area(ptr, n) == -1) { + elib_printf(stderr, "RUNTIME ERROR: %s heap overwrite\n", fun); + elib_printf(stderr, "File: %s Line: %d\n", file, line); + ELIB_FAILURE; + } +} + +/* +** Check if a pointer is an allocated object +*/ +static void check_allocated_block(char* ptr, char* file, int line, char* fun) +{ + EWord* q; + + if (!IN_HEAP(ptr) || ((q=ptr_to_block(ptr)) == 0) || (ptr != (char*) q)) { + elib_printf(stderr, "RUNTIME ERROR: %s non heap pointer\n", fun); + elib_printf(stderr, "File: %s Line: %d\n", file, line); + ELIB_FAILURE; + } + + if (IS_FREE((AllocatedBlock*)(q-1))) { + elib_printf(stderr, "RUNTIME ERROR: %s free pointer\n", fun); + elib_printf(stderr, "File: %s Line: %d\n", file, line); + ELIB_FAILURE; + } + +} + +/* +** -------------------------------------------------------------------------- +** DEBUG VERSIONS (COMPILED WITH THE ELIB.H) +** -------------------------------------------------------------------------- +*/ + +void* elib_dbg_malloc(int n, char* file, int line) +{ + return elib__malloc(n); +} + +void* elib_dbg_calloc(int n, int s, char* file, int line) +{ + return elib__calloc(n, s); +} + +void* elib_dbg_realloc(EWord* p, int n, char* file, int line) +{ + if (p == 0) + return elib__malloc(n); + check_allocated_block(p, file, line, "elib_realloc"); + return elib__realloc(p, n); +} + +void elib_dbg_free(EWord* p, char* file, int line) +{ + if (p == 0) + return; + check_allocated_block(p, file, line, "elib_free"); + elib__free(p); +} + +void elib_dbg_cfree(EWord* p, char* file, int line) +{ + if (p == 0) + return; + check_allocated_block(p, file, line, "elib_free"); + elib__cfree(p); +} + +void* elib_dbg_memalign(int a, int n, char* file, int line) +{ + return elib__memalign(a, n); +} + +void* elib_dbg_valloc(int n, char* file, int line) +{ + return elib__valloc(n); +} + +void* elib_dbg_pvalloc(int n, char* file, int line) +{ + return elib__pvalloc(n); +} + +void* elib_dbg_memresize(EWord* p, int n, char* file, int line) +{ + if (p == 0) + return elib__malloc(n); + check_allocated_block(p, file, line, "elib_memresize"); + return elib__memresize(p, n); +} + +int elib_dbg_memsize(void* p, char* file, int line) +{ + check_allocated_block(p, file, line, "elib_memsize"); + return elib__memsize(p); +} + +/* +** -------------------------------------------------------------------------- +** LINK TIME FUNCTIONS (NOT COMPILED CALLS) +** -------------------------------------------------------------------------- +*/ + +void* elib_malloc(int n) +{ + return elib_dbg_malloc(n, "", -1); +} + +void* elib_calloc(int n, int s) +{ + return elib_dbg_calloc(n, s, "", -1); +} + +void* elib_realloc(EWord* p, int n) +{ + return elib_dbg_realloc(p, n, "", -1); +} + +void elib_free(EWord* p) +{ + elib_dbg_free(p, "", -1); +} + +void elib_cfree(EWord* p) +{ + elib_dbg_cfree(p, "", -1); +} + +void* elib_memalign(int a, int n) +{ + return elib_dbg_memalign(a, n, "", -1); +} + +void* elib_valloc(int n) +{ + return elib_dbg_valloc(n, "", -1); +} + +void* elib_pvalloc(int n) +{ + return elib_dbg_pvalloc(n, "", -1); +} + +void* elib_memresize(EWord* p, int n) +{ + return elib_dbg_memresize(p, n, "", -1); +} + + +int elib_memsize(EWord* p) +{ + return elib_dbg_memsize(p, "", -1); +} + +#endif /* ELIB_DEBUG */ + +/* +** -------------------------------------------------------------------------- +** Map c library functions to elib +** -------------------------------------------------------------------------- +*/ + +#if defined(ELIB_ALLOC_IS_CLIB) +void* malloc(size_t nb) +{ + return elib_malloc(nb); +} + +void* calloc(size_t nelem, size_t size) +{ + return elib_calloc(nelem, size); +} + + +void free(void *p) +{ + elib_free(p); +} + +void cfree(void *p) +{ + elib_cfree(p); +} + +void* realloc(void* p, size_t nb) +{ + return elib_realloc(p, nb); +} + + +void* memalign(size_t a, size_t s) +{ + return elib_memalign(a, s); +} + +void* valloc(size_t nb) +{ + return elib_valloc(nb); +} + +void* pvalloc(size_t nb) +{ + return elib_pvalloc(nb); +} + +#if 0 +void* memresize(void* p, int nb) +{ + return elib_memresize(p, nb); +} + +int memsize(void* p) +{ + return elib_memsize(p); +} +#endif +#endif /* ELIB_ALLOC_IS_CLIB */ + +#endif /* ENABLE_ELIB_MALLOC */ + +void elib_ensure_initialized(void) +{ +#ifdef ENABLE_ELIB_MALLOC +#ifndef ELIB_DONT_INITIALIZE + elib_init(NULL, 0); +#endif +#endif +} + +#ifdef ENABLE_ELIB_MALLOC +/** + ** A Slightly modified version of the "address order best fit" algorithm + ** used in erl_bestfit_alloc.c. Comments refer to that implementation. + **/ + +/* + * Description: A combined "address order best fit"/"best fit" allocator + * based on a Red-Black (binary search) Tree. The search, + * insert, and delete operations are all O(log n) operations + * on a Red-Black Tree. In the "address order best fit" case + * n equals number of free blocks, and in the "best fit" case + * n equals number of distinct sizes of free blocks. Red-Black + * Trees are described in "Introduction to Algorithms", by + * Thomas H. Cormen, Charles E. Leiserson, and + * Ronald L. Riverest. + * + * This module is a callback-module for erl_alloc_util.c + * + * Author: Rickard Green + */ + +#ifdef DEBUG +#if 0 +#define HARD_DEBUG +#endif +#else +#undef HARD_DEBUG +#endif + +#define SZ_MASK SIZE_MASK +#define FLG_MASK (~(SZ_MASK)) + +#define BLK_SZ(B) (*((Block_t *) (B)) & SZ_MASK) + +#define TREE_NODE_FLG (((Uint) 1) << 0) +#define RED_FLG (((Uint) 1) << 1) +#ifdef HARD_DEBUG +# define LEFT_VISITED_FLG (((Uint) 1) << 2) +# define RIGHT_VISITED_FLG (((Uint) 1) << 3) +#endif + +#define IS_TREE_NODE(N) (((RBTree_t *) (N))->flags & TREE_NODE_FLG) +#define IS_LIST_ELEM(N) (!IS_TREE_NODE(((RBTree_t *) (N)))) + +#define SET_TREE_NODE(N) (((RBTree_t *) (N))->flags |= TREE_NODE_FLG) +#define SET_LIST_ELEM(N) (((RBTree_t *) (N))->flags &= ~TREE_NODE_FLG) + +#define IS_RED(N) (((RBTree_t *) (N)) \ + && ((RBTree_t *) (N))->flags & RED_FLG) +#define IS_BLACK(N) (!IS_RED(((RBTree_t *) (N)))) + +#define SET_RED(N) (((RBTree_t *) (N))->flags |= RED_FLG) +#define SET_BLACK(N) (((RBTree_t *) (N))->flags &= ~RED_FLG) + +#undef ASSERT +#define ASSERT ASSERT_EXPR + +#if 1 +#define RBT_ASSERT ASSERT +#else +#define RBT_ASSERT(x) +#endif + + +#ifdef HARD_DEBUG +static RBTree_t * check_tree(Uint); +#endif + +#ifdef ERTS_INLINE +# ifndef ERTS_CAN_INLINE +# define ERTS_CAN_INLINE 1 +# endif +#else +# if defined(__GNUC__) +# define ERTS_CAN_INLINE 1 +# define ERTS_INLINE __inline__ +# elif defined(__WIN32__) +# define ERTS_CAN_INLINE 1 +# define ERTS_INLINE __inline +# else +# define ERTS_CAN_INLINE 0 +# define ERTS_INLINE +# endif +#endif + +/* Types... */ +#if 0 +typedef struct RBTree_t_ RBTree_t; + +struct RBTree_t_ { + Block_t hdr; + Uint flags; + RBTree_t *parent; + RBTree_t *left; + RBTree_t *right; +}; +#endif + +#if 0 +typedef struct { + RBTree_t t; + RBTree_t *next; +} RBTreeList_t; + +#define LIST_NEXT(N) (((RBTreeList_t *) (N))->next) +#define LIST_PREV(N) (((RBTreeList_t *) (N))->t.parent) +#endif + +#ifdef DEBUG + +/* Destroy all tree fields */ +#define DESTROY_TREE_NODE(N) \ + sys_memset((void *) (((Block_t *) (N)) + 1), \ + 0xff, \ + (sizeof(RBTree_t) - sizeof(Block_t))) + +/* Destroy all tree and list fields */ +#define DESTROY_LIST_ELEM(N) \ + sys_memset((void *) (((Block_t *) (N)) + 1), \ + 0xff, \ + (sizeof(RBTreeList_t) - sizeof(Block_t))) + +#else + +#define DESTROY_TREE_NODE(N) +#define DESTROY_LIST_ELEM(N) + +#endif + + +/* + * Red-Black Tree operations needed + */ + +static ERTS_INLINE void +left_rotate(RBTree_t **root, RBTree_t *x) +{ + RBTree_t *y = x->right; + x->right = y->left; + if (y->left) + y->left->parent = x; + y->parent = x->parent; + if (!y->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->left) + x->parent->left = y; + else { + RBT_ASSERT(x == x->parent->right); + x->parent->right = y; + } + y->left = x; + x->parent = y; +} + +static ERTS_INLINE void +right_rotate(RBTree_t **root, RBTree_t *x) +{ + RBTree_t *y = x->left; + x->left = y->right; + if (y->right) + y->right->parent = x; + y->parent = x->parent; + if (!y->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->right) + x->parent->right = y; + else { + RBT_ASSERT(x == x->parent->left); + x->parent->left = y; + } + y->right = x; + x->parent = y; +} + + +/* + * Replace node x with node y + * NOTE: block header of y is not changed + */ +static ERTS_INLINE void +replace(RBTree_t **root, RBTree_t *x, RBTree_t *y) +{ + + if (!x->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->left) + x->parent->left = y; + else { + RBT_ASSERT(x == x->parent->right); + x->parent->right = y; + } + if (x->left) { + RBT_ASSERT(x->left->parent == x); + x->left->parent = y; + } + if (x->right) { + RBT_ASSERT(x->right->parent == x); + x->right->parent = y; + } + + y->flags = x->flags; + y->parent = x->parent; + y->right = x->right; + y->left = x->left; + + DESTROY_TREE_NODE(x); + +} + +static void +tree_insert_fixup(RBTree_t *blk) +{ + RBTree_t *x = blk, *y; + + /* + * Rearrange the tree so that it satisfies the Red-Black Tree properties + */ + + RBT_ASSERT(x != root && IS_RED(x->parent)); + do { + + /* + * x and its parent are both red. Move the red pair up the tree + * until we get to the root or until we can separate them. + */ + + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(x->parent->parent); + + if (x->parent == x->parent->parent->left) { + y = x->parent->parent->right; + if (IS_RED(y)) { + SET_BLACK(y); + x = x->parent; + SET_BLACK(x); + x = x->parent; + SET_RED(x); + } + else { + + if (x == x->parent->right) { + x = x->parent; + left_rotate(&root, x); + } + + RBT_ASSERT(x == x->parent->parent->left->left); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_BLACK(y)); + + SET_BLACK(x->parent); + SET_RED(x->parent->parent); + right_rotate(&root, x->parent->parent); + + RBT_ASSERT(x == x->parent->left); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent->right)); + RBT_ASSERT(IS_BLACK(x->parent)); + break; + } + } + else { + RBT_ASSERT(x->parent == x->parent->parent->right); + y = x->parent->parent->left; + if (IS_RED(y)) { + SET_BLACK(y); + x = x->parent; + SET_BLACK(x); + x = x->parent; + SET_RED(x); + } + else { + + if (x == x->parent->left) { + x = x->parent; + right_rotate(&root, x); + } + + RBT_ASSERT(x == x->parent->parent->right->right); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_BLACK(y)); + + SET_BLACK(x->parent); + SET_RED(x->parent->parent); + left_rotate(&root, x->parent->parent); + + RBT_ASSERT(x == x->parent->right); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent->left)); + RBT_ASSERT(IS_BLACK(x->parent)); + break; + } + } + } while (x != root && IS_RED(x->parent)); + + SET_BLACK(root); +} + +static void +unlink_free_block(Block_t *del) +{ + Uint spliced_is_black; + RBTree_t *x, *y, *z = (RBTree_t *) del; + RBTree_t null_x; /* null_x is used to get the fixup started when we + splice out a node without children. */ + + null_x.parent = NULL; + +#ifdef HARD_DEBUG + check_tree(0); +#endif + + /* Remove node from tree... */ + + /* Find node to splice out */ + if (!z->left || !z->right) + y = z; + else + /* Set y to z:s successor */ + for(y = z->right; y->left; y = y->left); + /* splice out y */ + x = y->left ? y->left : y->right; + spliced_is_black = IS_BLACK(y); + if (x) { + x->parent = y->parent; + } + else if (!x && spliced_is_black) { + x = &null_x; + x->flags = 0; + SET_BLACK(x); + x->right = x->left = NULL; + x->parent = y->parent; + y->left = x; + } + + if (!y->parent) { + RBT_ASSERT(root == y); + root = x; + } + else if (y == y->parent->left) + y->parent->left = x; + else { + RBT_ASSERT(y == y->parent->right); + y->parent->right = x; + } + if (y != z) { + /* We spliced out the successor of z; replace z by the successor */ + replace(&root, z, y); + } + + if (spliced_is_black) { + /* We removed a black node which makes the resulting tree + violate the Red-Black Tree properties. Fixup tree... */ + + while (IS_BLACK(x) && x->parent) { + + /* + * x has an "extra black" which we move up the tree + * until we reach the root or until we can get rid of it. + * + * y is the sibbling of x + */ + + if (x == x->parent->left) { + y = x->parent->right; + RBT_ASSERT(y); + if (IS_RED(y)) { + RBT_ASSERT(y->right); + RBT_ASSERT(y->left); + SET_BLACK(y); + RBT_ASSERT(IS_BLACK(x->parent)); + SET_RED(x->parent); + left_rotate(&root, x->parent); + y = x->parent->right; + } + RBT_ASSERT(y); + RBT_ASSERT(IS_BLACK(y)); + if (IS_BLACK(y->left) && IS_BLACK(y->right)) { + SET_RED(y); + x = x->parent; + } + else { + if (IS_BLACK(y->right)) { + SET_BLACK(y->left); + SET_RED(y); + right_rotate(&root, y); + y = x->parent->right; + } + RBT_ASSERT(y); + if (IS_RED(x->parent)) { + + SET_BLACK(x->parent); + SET_RED(y); + } + RBT_ASSERT(y->right); + SET_BLACK(y->right); + left_rotate(&root, x->parent); + x = root; + break; + } + } + else { + RBT_ASSERT(x == x->parent->right); + y = x->parent->left; + RBT_ASSERT(y); + if (IS_RED(y)) { + RBT_ASSERT(y->right); + RBT_ASSERT(y->left); + SET_BLACK(y); + RBT_ASSERT(IS_BLACK(x->parent)); + SET_RED(x->parent); + right_rotate(&root, x->parent); + y = x->parent->left; + } + RBT_ASSERT(y); + RBT_ASSERT(IS_BLACK(y)); + if (IS_BLACK(y->right) && IS_BLACK(y->left)) { + SET_RED(y); + x = x->parent; + } + else { + if (IS_BLACK(y->left)) { + SET_BLACK(y->right); + SET_RED(y); + left_rotate(&root, y); + y = x->parent->left; + } + RBT_ASSERT(y); + if (IS_RED(x->parent)) { + SET_BLACK(x->parent); + SET_RED(y); + } + RBT_ASSERT(y->left); + SET_BLACK(y->left); + right_rotate(&root, x->parent); + x = root; + break; + } + } + } + SET_BLACK(x); + + if (null_x.parent) { + if (null_x.parent->left == &null_x) + null_x.parent->left = NULL; + else { + RBT_ASSERT(null_x.parent->right == &null_x); + null_x.parent->right = NULL; + } + RBT_ASSERT(!null_x.left); + RBT_ASSERT(!null_x.right); + } + else if (root == &null_x) { + root = NULL; + RBT_ASSERT(!null_x.left); + RBT_ASSERT(!null_x.right); + } + } + + + DESTROY_TREE_NODE(del); + +#ifdef HARD_DEBUG + check_tree(0); +#endif + +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * "Address order best fit" specific callbacks. * +\* */ + +static void +link_free_block(Block_t *block) +{ + RBTree_t *blk = (RBTree_t *) block; + Uint blk_sz = BLK_SZ(blk); + + blk->flags = 0; + blk->left = NULL; + blk->right = NULL; + + if (!root) { + blk->parent = NULL; + SET_BLACK(blk); + root = blk; + } else { + RBTree_t *x = root; + while (1) { + Uint size; + + size = BLK_SZ(x); + + if (blk_sz < size || (blk_sz == size && blk < x)) { + if (!x->left) { + blk->parent = x; + x->left = blk; + break; + } + x = x->left; + } + else { + if (!x->right) { + blk->parent = x; + x->right = blk; + break; + } + x = x->right; + } + + } + + /* Insert block into size tree */ + RBT_ASSERT(blk->parent); + + SET_RED(blk); + if (IS_RED(blk->parent)) { + tree_insert_fixup(blk); + } + } + +#ifdef HARD_DEBUG + check_tree(0); +#endif +} + + +static Block_t * +get_free_block(Uint size) +{ + RBTree_t *x = root; + RBTree_t *blk = NULL; + Uint blk_sz; + + while (x) { + blk_sz = BLK_SZ(x); + if (blk_sz < size) { + x = x->right; + } + else { + blk = x; + x = x->left; + } + } + + if (!blk) + return NULL; + +#ifdef HARD_DEBUG + ASSERT(blk == check_tree(size)); +#endif + + unlink_free_block((Block_t *) blk); + + return (Block_t *) blk; +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Debug functions * +\* */ + + +#ifdef HARD_DEBUG + +#define IS_LEFT_VISITED(FB) ((FB)->flags & LEFT_VISITED_FLG) +#define IS_RIGHT_VISITED(FB) ((FB)->flags & RIGHT_VISITED_FLG) + +#define SET_LEFT_VISITED(FB) ((FB)->flags |= LEFT_VISITED_FLG) +#define SET_RIGHT_VISITED(FB) ((FB)->flags |= RIGHT_VISITED_FLG) + +#define UNSET_LEFT_VISITED(FB) ((FB)->flags &= ~LEFT_VISITED_FLG) +#define UNSET_RIGHT_VISITED(FB) ((FB)->flags &= ~RIGHT_VISITED_FLG) + + +#if 0 +# define PRINT_TREE +#else +# undef PRINT_TREE +#endif + +#ifdef PRINT_TREE +static void print_tree(void); +#endif + +/* + * Checks that the order between parent and children are correct, + * and that the Red-Black Tree properies are satisfied. if size > 0, + * check_tree() returns a node that satisfies "best fit" resp. + * "address order best fit". + * + * The Red-Black Tree properies are: + * 1. Every node is either red or black. + * 2. Every leaf (NIL) is black. + * 3. If a node is red, then both its children are black. + * 4. Every simple path from a node to a descendant leaf + * contains the same number of black nodes. + */ + +static RBTree_t * +check_tree(Uint size) +{ + RBTree_t *res = NULL; + Sint blacks; + Sint curr_blacks; + RBTree_t *x; + +#ifdef PRINT_TREE + print_tree(); +#endif + + if (!root) + return res; + + x = root; + ASSERT(IS_BLACK(x)); + ASSERT(!x->parent); + curr_blacks = 1; + blacks = -1; + + while (x) { + if (!IS_LEFT_VISITED(x)) { + SET_LEFT_VISITED(x); + if (x->left) { + x = x->left; + if (IS_BLACK(x)) + curr_blacks++; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + ASSERT(blacks == curr_blacks); + } + } + + if (!IS_RIGHT_VISITED(x)) { + SET_RIGHT_VISITED(x); + if (x->right) { + x = x->right; + if (IS_BLACK(x)) + curr_blacks++; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + ASSERT(blacks == curr_blacks); + } + } + + + if (IS_RED(x)) { + ASSERT(IS_BLACK(x->right)); + ASSERT(IS_BLACK(x->left)); + } + + ASSERT(x->parent || x == root); + + if (x->left) { + ASSERT(x->left->parent == x); + ASSERT(BLK_SZ(x->left) < BLK_SZ(x) + || (BLK_SZ(x->left) == BLK_SZ(x) && x->left < x)); + } + + if (x->right) { + ASSERT(x->right->parent == x); + ASSERT(BLK_SZ(x->right) > BLK_SZ(x) + || (BLK_SZ(x->right) == BLK_SZ(x) && x->right > x)); + } + + if (size && BLK_SZ(x) >= size) { + if (!res + || BLK_SZ(x) < BLK_SZ(res) + || (BLK_SZ(x) == BLK_SZ(res) && x < res)) + res = x; + } + + UNSET_LEFT_VISITED(x); + UNSET_RIGHT_VISITED(x); + if (IS_BLACK(x)) + curr_blacks--; + x = x->parent; + + } + + ASSERT(curr_blacks == 0); + + UNSET_LEFT_VISITED(root); + UNSET_RIGHT_VISITED(root); + + return res; + +} + + +#ifdef PRINT_TREE +#define INDENT_STEP 2 + +#include + +static void +print_tree_aux(RBTree_t *x, int indent) +{ + int i; + + if (!x) { + for (i = 0; i < indent; i++) { + putc(' ', stderr); + } + fprintf(stderr, "BLACK: nil\r\n"); + } + else { + print_tree_aux(x->right, indent + INDENT_STEP); + for (i = 0; i < indent; i++) { + putc(' ', stderr); + } + fprintf(stderr, "%s: sz=%lu addr=0x%lx\r\n", + IS_BLACK(x) ? "BLACK" : "RED", + BLK_SZ(x), + (Uint) x); + print_tree_aux(x->left, indent + INDENT_STEP); + } +} + + +static void +print_tree(void) +{ + fprintf(stderr, " --- Size-Adress tree begin ---\r\n"); + print_tree_aux(root, 0); + fprintf(stderr, " --- Size-Adress tree end ---\r\n"); +} + +#endif + +#endif + +#endif /* ENABLE_ELIB_MALLOC */ diff --git a/erts/emulator/beam/elib_memmove.c b/erts/emulator/beam/elib_memmove.c new file mode 100644 index 0000000000..d2fe8649ed --- /dev/null +++ b/erts/emulator/beam/elib_memmove.c @@ -0,0 +1,113 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This memmove assumes that both src and dst are aligned on an address + * divisible by 4 and that n is a multiple of four. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifndef HAVE_MEMMOVE + +#define MEMCPY_LIMIT 12 +typedef unsigned long u_long; +typedef unsigned short u_short; + +static void copy_high(dst, src, n) +char* dst; char* src; int n; +{ + dst += n; + src += n; + + if (n >= MEMCPY_LIMIT) { + while(((u_long) dst) & 3) { + *--dst = *--src; + n--; + } + if ((((u_long) src) & 3) == 0) { + while(n >= sizeof(u_long)) { + src -= sizeof(u_long); + dst -= sizeof(u_long); + *((u_long*)dst) = *((u_long*)src); + n -= sizeof(u_long); + } + } + else if ((((u_short) src) & 3) == 2) { + while(n >= sizeof(u_short)) { + src -= sizeof(u_short); + dst -= sizeof(u_short); + *((u_short*)dst) = *((u_short*)src); + n -= sizeof(u_short); + } + } + } + while(n > 0) { + *--dst = *--src; + n--; + } +} + +static void copy_low(dst, src, n) +char* dst; char* src; int n; +{ + if (n >= MEMCPY_LIMIT) { + while(((u_long) dst) & 3) { + *dst++ = *src++; + n--; + } + if ((((u_long) src) & 3) == 0) { + while(n >= sizeof(u_long)) { + *((u_long*)dst) = *((u_long*)src); + src += sizeof(u_long); + dst += sizeof(u_long); + n -= sizeof(u_long); + } + } + else if ((((u_long) src) & 3) == 2) { + while(n >= sizeof(u_short)) { + *((u_short*)dst) = *((u_short*)src); + src += sizeof(u_short); + dst += sizeof(u_short); + n -= sizeof(u_short); + } + } + } + while(n > 0) { + *dst++ = *src++; + n--; + } +} + +/* +** Move memory (with overlap) +*/ +void* memmove(dst, src, n) +char* dst; char* src; int n; +{ + if (dst < src) + copy_low(dst, src, n); + else if (dst > src) + copy_high(dst, src, n); + return dst; +} + +#endif /* HAVE_MEMMOVE */ diff --git a/erts/emulator/beam/elib_stat.h b/erts/emulator/beam/elib_stat.h new file mode 100644 index 0000000000..d8c7f31737 --- /dev/null +++ b/erts/emulator/beam/elib_stat.h @@ -0,0 +1,45 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** Interface to elib statistics +** +*/ +#ifndef __ELIB_STAT_H__ +#define __ELIB_STAT_H__ + +struct elib_stat { + int mem_total; /* Number of heap words */ + int mem_blocks; /* Number of block */ + int mem_alloc; /* Number of words in use */ + int mem_free; /* Number of words free */ + int min_used; /* Size of the smallest block used */ + int max_free; /* Size of the largest free block */ + int free_blocks; /* Number of fragments in free list */ + int mem_max_alloc;/* Max number of words in use */ +}; + +EXTERN_FUNCTION(void, elib_statistics, (void*)); +EXTERN_FUNCTION(int, elib_check_heap, (_VOID_)); +EXTERN_FUNCTION(void, elib_heap_dump, (char*)); +EXTERN_FUNCTION(void, elib_stat, (struct elib_stat*)); +EXTERN_FUNCTION(int, elib_heap_map, (unsigned char*, int)); +EXTERN_FUNCTION(int, elib_histo, (unsigned long*, unsigned long*, int, int)); + +#endif diff --git a/erts/emulator/beam/erl_afit_alloc.c b/erts/emulator/beam/erl_afit_alloc.c new file mode 100644 index 0000000000..e8b594bb47 --- /dev/null +++ b/erts/emulator/beam/erl_afit_alloc.c @@ -0,0 +1,256 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: A fast allocator intended for temporary allocation. + * When allocating, only the first block in the free list + * is inspected, if this block doesn't fit a new carrier + * is created. NOTE: this allocator can behave really bad + * if misused. + * + * This module is a callback-module for erl_alloc_util.c + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "global.h" +#define GET_ERL_AF_ALLOC_IMPL +#include "erl_afit_alloc.h" + + +#define MIN_MBC_SZ (16*1024) +#define MIN_MBC_FIRST_FREE_SZ (4*1024) + +/* Prototypes of callback functions */ +static Block_t * get_free_block (Allctr_t *, Uint, + Block_t *, Uint); +static void link_free_block (Allctr_t *, Block_t *); +static void unlink_free_block (Allctr_t *, Block_t *); + + +static Eterm info_options (Allctr_t *, char *, int *, + void *arg, Uint **, Uint *); +static void init_atoms (void); + +static int atoms_initialized = 0; + +void +erts_afalc_init(void) +{ + atoms_initialized = 0; +} + +Allctr_t * +erts_afalc_start(AFAllctr_t *afallctr, + AFAllctrInit_t *afinit, + AllctrInit_t *init) +{ + AFAllctr_t nulled_state = {{0}}; + /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc + warning. gcc warns if {0} is used as initializer of a struct when + the first member is a struct (not if, for example, the third member + is a struct). */ + Allctr_t *allctr = (Allctr_t *) afallctr; + + sys_memcpy((void *) afallctr, (void *) &nulled_state, sizeof(AFAllctr_t)); + + allctr->mbc_header_size = sizeof(Carrier_t); + allctr->min_mbc_size = MIN_MBC_SZ; + allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; + allctr->min_block_size = sizeof(AFFreeBlock_t); + allctr->vsn_str = ERTS_ALC_AF_ALLOC_VSN_STR; + + /* Callback functions */ + allctr->get_free_block = get_free_block; + allctr->link_free_block = link_free_block; + allctr->unlink_free_block = unlink_free_block; + allctr->info_options = info_options; + + allctr->get_next_mbc_size = NULL; + allctr->creating_mbc = NULL; + allctr->destroying_mbc = NULL; + allctr->init_atoms = init_atoms; + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + allctr->check_block = NULL; + allctr->check_mbc = NULL; +#endif + + allctr->atoms_initialized = 0; + + if (!erts_alcu_start(allctr, init)) + return NULL; + + return allctr; +} + +static Block_t * +get_free_block(Allctr_t *allctr, Uint size, Block_t *cand_blk, Uint cand_size) +{ + AFAllctr_t *afallctr = (AFAllctr_t *) allctr; + + ASSERT(!cand_blk || cand_size >= size); + + if (afallctr->free_list && BLK_SZ(afallctr->free_list) >= size) { + AFFreeBlock_t *res = afallctr->free_list; + afallctr->free_list = res->next; + if (res->next) + res->next->prev = NULL; + return (Block_t *) res; + } + else + return NULL; +} + +static void +link_free_block(Allctr_t *allctr, Block_t *block) +{ + AFFreeBlock_t *blk = (AFFreeBlock_t *) block; + AFAllctr_t *afallctr = (AFAllctr_t *) allctr; + + if (afallctr->free_list && BLK_SZ(afallctr->free_list) > BLK_SZ(blk)) { + blk->next = afallctr->free_list->next; + blk->prev = afallctr->free_list; + afallctr->free_list->next = blk; + } + else { + blk->next = afallctr->free_list; + blk->prev = NULL; + afallctr->free_list = blk; + } + + if (blk->next) + blk->next->prev = blk; +} + +static void +unlink_free_block(Allctr_t *allctr, Block_t *block) +{ + AFFreeBlock_t *blk = (AFFreeBlock_t *) block; + AFAllctr_t *afallctr = (AFAllctr_t *) allctr; + + if (blk->prev) + blk->prev->next = blk->next; + else + afallctr->free_list = blk->next; + if (blk->next) + blk->next->prev = blk->prev; +} + + +static struct { + Eterm as; + Eterm af; +#ifdef DEBUG + Eterm end_of_atoms; +#endif +} am; + +static void ERTS_INLINE atom_init(Eterm *atom, char *name) +{ + *atom = am_atom_put(name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static void +init_atoms(void) +{ +#ifdef DEBUG + Eterm *atom; +#endif + + if (atoms_initialized) + return; + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) { + *atom = THE_NON_VALUE; + } +#endif + + AM_INIT(as); + AM_INIT(af); + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { + ASSERT(*atom != THE_NON_VALUE); + } +#endif + + atoms_initialized = 1; +} + + +#define bld_uint erts_bld_uint +#define bld_cons erts_bld_cons +#define bld_tuple erts_bld_tuple + +static ERTS_INLINE void +add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 2, el1, el2), *lp); +} + +static Eterm +info_options(Allctr_t *allctr, + char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + erts_print(*print_to_p, print_to_arg, "%sas: af\n", prefix); + } + + if (hpp || szp) { + + if (!atoms_initialized) + erl_exit(1, "%s:%d: Internal error: Atoms not initialized", + __FILE__, __LINE__);; + + res = NIL; + add_2tup(hpp, szp, &res, am.as, am.af); + } + + return res; +} + + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * NOTE: erts_afalc_test() is only supposed to be used for testing. * + * * + * Keep alloc_SUITE_data/allocator_test.h updated if changes are made * + * to erts_afalc_test() * +\* */ + +unsigned long +erts_afalc_test(unsigned long op, unsigned long a1, unsigned long a2) +{ + switch (op) { + default: ASSERT(0); return ~((unsigned long) 0); + } +} diff --git a/erts/emulator/beam/erl_afit_alloc.h b/erts/emulator/beam/erl_afit_alloc.h new file mode 100644 index 0000000000..ea408a7194 --- /dev/null +++ b/erts/emulator/beam/erl_afit_alloc.h @@ -0,0 +1,67 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +#ifndef ERL_AFIT_ALLOC__ +#define ERL_AFIT_ALLOC__ + +#include "erl_alloc_util.h" + +#define ERTS_ALC_AF_ALLOC_VSN_STR "0.9" + +typedef struct AFAllctr_t_ AFAllctr_t; + +typedef struct { + int dummy; +} AFAllctrInit_t; + +#define ERTS_DEFAULT_AF_ALLCTR_INIT { \ + 0 /* dummy */\ +} + +void erts_afalc_init(void); +Allctr_t *erts_afalc_start(AFAllctr_t *, AFAllctrInit_t *, AllctrInit_t *); + +#endif /* #ifndef ERL_BESTFIT_ALLOC__ */ + + + +#if defined(GET_ERL_AF_ALLOC_IMPL) && !defined(ERL_AF_ALLOC_IMPL__) +#define ERL_AF_ALLOC_IMPL__ + +#define GET_ERL_ALLOC_UTIL_IMPL +#include "erl_alloc_util.h" + +typedef struct AFFreeBlock_t_ AFFreeBlock_t; +struct AFFreeBlock_t_ { + Block_t block_head; + AFFreeBlock_t *prev; + AFFreeBlock_t *next; +}; + +struct AFAllctr_t_ { + Allctr_t allctr; /* Has to be first! */ + + AFFreeBlock_t * free_list; +}; + +unsigned long erts_afalc_test(unsigned long, unsigned long, unsigned long); + +#endif /* #if defined(GET_ERL_AF_ALLOC_IMPL) + && !defined(ERL_AF_ALLOC_IMPL__) */ diff --git a/erts/emulator/beam/erl_alloc.c b/erts/emulator/beam/erl_alloc.c new file mode 100644 index 0000000000..b853ec0f01 --- /dev/null +++ b/erts/emulator/beam/erl_alloc.c @@ -0,0 +1,3157 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: Management of memory allocators. + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#define ERTS_ALLOC_C__ +#define ERTS_ALC_INTERNAL__ +#include "sys.h" +#define ERL_THREADS_EMU_INTERNAL__ +#include "erl_threads.h" +#include "global.h" +#include "erl_db.h" +#include "erl_binary.h" +#include "erl_bits.h" +#include "erl_instrument.h" +#include "erl_mseg.h" +#ifdef ELIB_ALLOC_IS_CLIB +#include "erl_version.h" +#endif +#include "erl_monitors.h" +#include "erl_bif_timer.h" +#if defined(ERTS_ALC_T_DRV_SEL_D_STATE) || defined(ERTS_ALC_T_DRV_EV_D_STATE) +#include "erl_check_io.h" +#endif + +#define GET_ERL_GF_ALLOC_IMPL +#include "erl_goodfit_alloc.h" +#define GET_ERL_BF_ALLOC_IMPL +#include "erl_bestfit_alloc.h" +#define GET_ERL_AF_ALLOC_IMPL +#include "erl_afit_alloc.h" + +#define ERTS_ALC_DEFAULT_MAX_THR_PREF 16 + +#if defined(SMALL_MEMORY) || defined(PURIFY) || defined(VALGRIND) +#define AU_ALLOC_DEFAULT_ENABLE(X) 0 +#else +#define AU_ALLOC_DEFAULT_ENABLE(X) (X) +#endif + +#ifdef DEBUG +static Uint install_debug_functions(void); +#endif +extern void elib_ensure_initialized(void); + +ErtsAllocatorFunctions_t erts_allctrs[ERTS_ALC_A_MAX+1]; +ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1]; +ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]; + +#define ERTS_MIN(A, B) ((A) < (B) ? (A) : (B)) +#define ERTS_MAX(A, B) ((A) > (B) ? (A) : (B)) + +typedef union { + GFAllctr_t gfa; + char align_gfa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(GFAllctr_t))]; + BFAllctr_t bfa; + char align_bfa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(BFAllctr_t))]; + AFAllctr_t afa; + char align_afa[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(AFAllctr_t))]; +} ErtsAllocatorState_t; + +static ErtsAllocatorState_t sl_alloc_state; +static ErtsAllocatorState_t std_alloc_state; +static ErtsAllocatorState_t ll_alloc_state; +static ErtsAllocatorState_t temp_alloc_state; +static ErtsAllocatorState_t eheap_alloc_state; +static ErtsAllocatorState_t binary_alloc_state; +static ErtsAllocatorState_t ets_alloc_state; +static ErtsAllocatorState_t driver_alloc_state; + +ErtsAlcType_t erts_fix_core_allocator_ix; +#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE +static void *(*fix_core_allocator)(ErtsAlcType_t, void *, Uint); +static void *fix_core_extra; +static void *fix_core_alloc(Uint size) +{ + void *res; + res = (*fix_core_allocator)(ERTS_ALC_T_UNDEF, fix_core_extra, size); + if (erts_mtrace_enabled) + erts_mtrace_crr_alloc(res, + ERTS_ALC_A_FIXED_SIZE, + erts_fix_core_allocator_ix, + size); + return res; +} +#endif + +enum allctr_type { + GOODFIT, + BESTFIT, + AFIT +}; + +struct au_init { + int enable; + int thr_spec; + enum allctr_type atype; + struct { + AllctrInit_t util; + GFAllctrInit_t gf; + BFAllctrInit_t bf; + AFAllctrInit_t af; + } init; + struct { + int mmbcs; + int lmbcs; + int smbcs; + int mmmbc; + } default_; +}; + +#define DEFAULT_ALLCTR_INIT { \ + ERTS_DEFAULT_ALLCTR_INIT, \ + ERTS_DEFAULT_GF_ALLCTR_INIT, \ + ERTS_DEFAULT_BF_ALLCTR_INIT, \ + ERTS_DEFAULT_AF_ALLCTR_INIT \ +} + +typedef struct { + int erts_alloc_config; +#if HAVE_ERTS_MSEG + ErtsMsegInit_t mseg; +#endif + int trim_threshold; + int top_pad; + AlcUInit_t alloc_util; + struct { + int stat; + int map; + char *mtrace; + char *nodename; + } instr; + struct au_init sl_alloc; + struct au_init std_alloc; + struct au_init ll_alloc; + struct au_init temp_alloc; + struct au_init eheap_alloc; + struct au_init binary_alloc; + struct au_init ets_alloc; + struct au_init driver_alloc; +} erts_alc_hndl_args_init_t; + +#define ERTS_AU_INIT__ {0, 0, GOODFIT, DEFAULT_ALLCTR_INIT, {1,1,1,1}} + +#define SET_DEFAULT_ALLOC_OPTS(IP) \ +do { \ + struct au_init aui__ = ERTS_AU_INIT__; \ + sys_memcpy((void *) (IP), (void *) &aui__, sizeof(struct au_init)); \ +} while (0) + +static void +set_default_sl_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 1; + ip->atype = GOODFIT; + ip->init.util.name_prefix = "sl_"; + ip->init.util.mmmbc = 5; + ip->init.util.alloc_no = ERTS_ALC_A_SHORT_LIVED; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 128*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 32*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_SHORT_LIVED; + ip->init.util.rsbcst = 80; +} + +static void +set_default_std_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 1; + ip->atype = BESTFIT; + ip->init.util.name_prefix = "std_"; + ip->init.util.mmmbc = 5; + ip->init.util.alloc_no = ERTS_ALC_A_STANDARD; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 128*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 32*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_STANDARD; +} + +static void +set_default_ll_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 0; + ip->atype = BESTFIT; + ip->init.bf.ao = 1; + ip->init.util.ramv = 0; + ip->init.util.mmsbc = 0; + ip->init.util.mmmbc = 0; + ip->init.util.sbct = ~((Uint) 0); + ip->init.util.name_prefix = "ll_"; + ip->init.util.alloc_no = ERTS_ALC_A_LONG_LIVED; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 2*1024*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 1*1024*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_LONG_LIVED; + ip->init.util.asbcst = 0; + ip->init.util.rsbcst = 0; + ip->init.util.rsbcmt = 0; + ip->init.util.rmbcmt = 0; +} + +static void +set_default_temp_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 1; + ip->atype = AFIT; + ip->init.util.name_prefix = "temp_"; + ip->init.util.alloc_no = ERTS_ALC_A_TEMPORARY; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 128*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 32*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_TEMPORARY; + ip->init.util.rsbcst = 90; + ip->init.util.rmbcmt = 100; +} + +static void +set_default_eheap_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 1; + ip->atype = GOODFIT; + ip->init.util.mmmbc = 100; + ip->init.util.name_prefix = "eheap_"; + ip->init.util.alloc_no = ERTS_ALC_A_EHEAP; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 512*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 256*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_EHEAP; + ip->init.util.rsbcst = 50; +} + +static void +set_default_binary_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 1; + ip->atype = BESTFIT; + ip->init.util.mmmbc = 50; + ip->init.util.name_prefix = "binary_"; + ip->init.util.alloc_no = ERTS_ALC_A_BINARY; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 128*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 32*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_BINARY; +} + +static void +set_default_ets_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 1; + ip->atype = BESTFIT; + ip->init.util.mmmbc = 100; + ip->init.util.name_prefix = "ets_"; + ip->init.util.alloc_no = ERTS_ALC_A_ETS; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 128*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 32*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_ETS; +} + +static void +set_default_driver_alloc_opts(struct au_init *ip) +{ + SET_DEFAULT_ALLOC_OPTS(ip); + ip->enable = AU_ALLOC_DEFAULT_ENABLE(1); + ip->thr_spec = 1; + ip->atype = BESTFIT; + ip->init.util.name_prefix = "driver_"; + ip->init.util.alloc_no = ERTS_ALC_A_DRIVER; +#ifndef SMALL_MEMORY + ip->init.util.mmbcs = 128*1024; /* Main carrier size */ +#else + ip->init.util.mmbcs = 32*1024; /* Main carrier size */ +#endif + ip->init.util.ts = ERTS_ALC_MTA_DRIVER; +} + +#ifdef ERTS_SMP + +static void +adjust_tpref(struct au_init *ip, int no_sched) +{ + if (ip->thr_spec) { + Uint allocs; + if (ip->thr_spec < 0) {/* User specified amount */ + allocs = abs(ip->thr_spec); + if (allocs > no_sched) + allocs = no_sched; + } + else if (no_sched > ERTS_ALC_DEFAULT_MAX_THR_PREF) + allocs = ERTS_ALC_DEFAULT_MAX_THR_PREF; + else + allocs = no_sched; + if (allocs <= 1) + ip->thr_spec = 0; + else { + ip->thr_spec = (int) allocs; + ip->thr_spec *= -1; /* thread preferred */ + + /* If default ... */ + + /* ... shrink main multi-block carrier size */ + if (ip->default_.mmbcs) + ip->init.util.mmbcs /= ERTS_MIN(4, allocs); + /* ... shrink largest multi-block carrier size */ + if (ip->default_.lmbcs) + ip->init.util.lmbcs /= ERTS_MIN(2, allocs); + /* ... shrink smallest multi-block carrier size */ + if (ip->default_.smbcs) + ip->init.util.smbcs /= ERTS_MIN(4, allocs); + /* ... and more than three allocators shrink + max mseg multi-block carriers */ + if (ip->default_.mmmbc && allocs > 2) { + ip->init.util.mmmbc /= ERTS_MIN(4, allocs - 1); + if (ip->init.util.mmmbc < 3) + ip->init.util.mmmbc = 3; + } + } + } +} + +#endif + +static void handle_args(int *, char **, erts_alc_hndl_args_init_t *); + +static void +set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init); + +static void +start_au_allocator(ErtsAlcType_t alctr_n, + struct au_init *init, + ErtsAllocatorState_t *state); + +static void +refuse_af_strategy(struct au_init *init) +{ + if (init->atype == AFIT) + init->atype = GOODFIT; +} + +static void init_thr_ix(int static_ixs); + +void +erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop) +{ + Uint extra_block_size = 0; + int i; + erts_alc_hndl_args_init_t init = { + 0, +#if HAVE_ERTS_MSEG + ERTS_MSEG_INIT_DEFAULT_INITIALIZER, +#endif + ERTS_DEFAULT_TRIM_THRESHOLD, + ERTS_DEFAULT_TOP_PAD, + ERTS_DEFAULT_ALCU_INIT + }; + + erts_sys_alloc_init(); + init_thr_ix(erts_no_schedulers); + erts_init_utils_mem(); + + set_default_sl_alloc_opts(&init.sl_alloc); + set_default_std_alloc_opts(&init.std_alloc); + set_default_ll_alloc_opts(&init.ll_alloc); + set_default_temp_alloc_opts(&init.temp_alloc); + set_default_eheap_alloc_opts(&init.eheap_alloc); + set_default_binary_alloc_opts(&init.binary_alloc); + set_default_ets_alloc_opts(&init.ets_alloc); + set_default_driver_alloc_opts(&init.driver_alloc); + + if (argc && argv) + handle_args(argc, argv, &init); + + if (erts_no_schedulers <= 1) { + init.sl_alloc.thr_spec = 0; + init.std_alloc.thr_spec = 0; + init.ll_alloc.thr_spec = 0; + init.eheap_alloc.thr_spec = 0; + init.binary_alloc.thr_spec = 0; + init.ets_alloc.thr_spec = 0; + init.driver_alloc.thr_spec = 0; + } + + if (init.erts_alloc_config) { + /* Adjust flags that erts_alloc_config won't like */ + init.temp_alloc.thr_spec = 0; + init.sl_alloc.thr_spec = 0; + init.std_alloc.thr_spec = 0; + init.ll_alloc.thr_spec = 0; + init.eheap_alloc.thr_spec = 0; + init.binary_alloc.thr_spec = 0; + init.ets_alloc.thr_spec = 0; + init.driver_alloc.thr_spec = 0; + } + +#ifdef ERTS_SMP + /* Only temp_alloc can use thread specific interface */ + if (init.temp_alloc.thr_spec) + init.temp_alloc.thr_spec = erts_no_schedulers; + + /* Others must use thread preferred interface */ + adjust_tpref(&init.sl_alloc, erts_no_schedulers); + adjust_tpref(&init.std_alloc, erts_no_schedulers); + adjust_tpref(&init.ll_alloc, erts_no_schedulers); + adjust_tpref(&init.eheap_alloc, erts_no_schedulers); + adjust_tpref(&init.binary_alloc, erts_no_schedulers); + adjust_tpref(&init.ets_alloc, erts_no_schedulers); + adjust_tpref(&init.driver_alloc, erts_no_schedulers); + +#else + /* No thread specific if not smp */ + init.temp_alloc.thr_spec = 0; +#endif + + /* + * The following allocators cannot be run with afit strategy. + * Make sure they don't... + */ + refuse_af_strategy(&init.sl_alloc); + refuse_af_strategy(&init.std_alloc); + refuse_af_strategy(&init.ll_alloc); + refuse_af_strategy(&init.eheap_alloc); + refuse_af_strategy(&init.binary_alloc); + refuse_af_strategy(&init.ets_alloc); + refuse_af_strategy(&init.driver_alloc); + +#ifdef ERTS_SMP + if (!init.temp_alloc.thr_spec) + refuse_af_strategy(&init.temp_alloc); +#endif + + erts_mtrace_pre_init(); +#if HAVE_ERTS_MSEG + erts_mseg_init(&init.mseg); +#endif + erts_alcu_init(&init.alloc_util); + erts_afalc_init(); + erts_bfalc_init(); + erts_gfalc_init(); + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + erts_allctrs[i].alloc = NULL; + erts_allctrs[i].realloc = NULL; + erts_allctrs[i].free = NULL; + erts_allctrs[i].extra = NULL; + erts_allctrs_info[i].alloc_util = 0; + erts_allctrs_info[i].enabled = 0; + erts_allctrs_info[i].thr_spec = 0; + erts_allctrs_info[i].extra = NULL; + } + +#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE +#if !defined(PURIFY) && !defined(VALGRIND) + erts_allctrs[ERTS_ALC_A_FIXED_SIZE].alloc = erts_fix_alloc; + erts_allctrs[ERTS_ALC_A_FIXED_SIZE].realloc = erts_fix_realloc; + erts_allctrs[ERTS_ALC_A_FIXED_SIZE].free = erts_fix_free; + erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].enabled = 1; +#else + erts_allctrs[ERTS_ALC_A_FIXED_SIZE].alloc = erts_sys_alloc; + erts_allctrs[ERTS_ALC_A_FIXED_SIZE].realloc = erts_sys_realloc; + erts_allctrs[ERTS_ALC_A_FIXED_SIZE].free = erts_sys_free; + erts_allctrs_info[ERTS_ALC_A_FIXED_SIZE].enabled = 0; +#endif +#endif + + erts_allctrs[ERTS_ALC_A_SYSTEM].alloc = erts_sys_alloc; + erts_allctrs[ERTS_ALC_A_SYSTEM].realloc = erts_sys_realloc; + erts_allctrs[ERTS_ALC_A_SYSTEM].free = erts_sys_free; + erts_allctrs_info[ERTS_ALC_A_SYSTEM].enabled = 1; + + set_au_allocator(ERTS_ALC_A_TEMPORARY, &init.temp_alloc); + set_au_allocator(ERTS_ALC_A_SHORT_LIVED, &init.sl_alloc); + set_au_allocator(ERTS_ALC_A_STANDARD, &init.std_alloc); + set_au_allocator(ERTS_ALC_A_LONG_LIVED, &init.ll_alloc); + set_au_allocator(ERTS_ALC_A_EHEAP, &init.eheap_alloc); + set_au_allocator(ERTS_ALC_A_BINARY, &init.binary_alloc); + set_au_allocator(ERTS_ALC_A_ETS, &init.ets_alloc); + set_au_allocator(ERTS_ALC_A_DRIVER, &init.driver_alloc); + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + if (!erts_allctrs[i].alloc) + erl_exit(ERTS_ABORT_EXIT, + "Missing alloc function for %s\n", ERTS_ALC_A2AD(i)); + if (!erts_allctrs[i].realloc) + erl_exit(ERTS_ABORT_EXIT, + "Missing realloc function for %s\n", ERTS_ALC_A2AD(i)); + if (!erts_allctrs[i].free) + erl_exit(ERTS_ABORT_EXIT, + "Missing free function for %s\n", ERTS_ALC_A2AD(i)); + } + + sys_alloc_opt(SYS_ALLOC_OPT_TRIM_THRESHOLD, init.trim_threshold); + sys_alloc_opt(SYS_ALLOC_OPT_TOP_PAD, init.top_pad); + + if (erts_allctrs_info[ERTS_FIX_CORE_ALLOCATOR].enabled) + erts_fix_core_allocator_ix = ERTS_FIX_CORE_ALLOCATOR; + else + erts_fix_core_allocator_ix = ERTS_ALC_A_SYSTEM; + + erts_mtrace_init(init.instr.mtrace, init.instr.nodename); + + start_au_allocator(ERTS_ALC_A_TEMPORARY, + &init.temp_alloc, + &temp_alloc_state); + + start_au_allocator(ERTS_ALC_A_SHORT_LIVED, + &init.sl_alloc, + &sl_alloc_state); + + start_au_allocator(ERTS_ALC_A_STANDARD, + &init.std_alloc, + &std_alloc_state); + + start_au_allocator(ERTS_ALC_A_LONG_LIVED, + &init.ll_alloc, + &ll_alloc_state); + + start_au_allocator(ERTS_ALC_A_EHEAP, + &init.eheap_alloc, + &eheap_alloc_state); + + start_au_allocator(ERTS_ALC_A_BINARY, + &init.binary_alloc, + &binary_alloc_state); + + start_au_allocator(ERTS_ALC_A_ETS, + &init.ets_alloc, + &ets_alloc_state); + + start_au_allocator(ERTS_ALC_A_DRIVER, + &init.driver_alloc, + &driver_alloc_state); + + fix_core_allocator = erts_allctrs[erts_fix_core_allocator_ix].alloc; + fix_core_extra = erts_allctrs[erts_fix_core_allocator_ix].extra; + + erts_mtrace_install_wrapper_functions(); + extra_block_size += erts_instr_init(init.instr.stat, init.instr.map); + +#ifdef DEBUG + extra_block_size += install_debug_functions(); +#endif + +#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE + + erts_init_fix_alloc(extra_block_size, fix_core_alloc); + + +#if !defined(PURIFY) && !defined(VALGRIND) + erts_set_fix_size(ERTS_ALC_T_PROC, sizeof(Process)); + erts_set_fix_size(ERTS_ALC_T_DB_TABLE, sizeof(DbTable)); + erts_set_fix_size(ERTS_ALC_T_ATOM, sizeof(Atom)); + erts_set_fix_size(ERTS_ALC_T_EXPORT, sizeof(Export)); + erts_set_fix_size(ERTS_ALC_T_MODULE, sizeof(Module)); + erts_set_fix_size(ERTS_ALC_T_REG_PROC, sizeof(RegProc)); + erts_set_fix_size(ERTS_ALC_T_MONITOR_SH, ERTS_MONITOR_SH_SIZE*sizeof(Uint)); + erts_set_fix_size(ERTS_ALC_T_NLINK_SH, ERTS_LINK_SH_SIZE*sizeof(Uint)); + erts_set_fix_size(ERTS_ALC_T_FUN_ENTRY, sizeof(ErlFunEntry)); +#ifdef ERTS_ALC_T_DRV_EV_D_STATE + erts_set_fix_size(ERTS_ALC_T_DRV_EV_D_STATE, + sizeof(ErtsDrvEventDataState)); +#endif +#ifdef ERTS_ALC_T_DRV_SEL_D_STATE + erts_set_fix_size(ERTS_ALC_T_DRV_SEL_D_STATE, + sizeof(ErtsDrvSelectDataState)); +#endif +#endif +#endif + +} + +static void +set_au_allocator(ErtsAlcType_t alctr_n, struct au_init *init) +{ + ErtsAllocatorFunctions_t *af = &erts_allctrs[alctr_n]; + ErtsAllocatorInfo_t *ai = &erts_allctrs_info[alctr_n]; + ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[alctr_n]; + + if (!init->enable) { + af->alloc = erts_sys_alloc; + af->realloc = erts_sys_realloc; + af->free = erts_sys_free; + af->extra = NULL; + ai->alloc_util = 0; + ai->enabled = 0; + ai->extra = NULL; + return; + } + + tspec->enabled = 0; + tspec->all_thr_safe = 0; + ai->thr_spec = 0; +#ifdef USE_THREADS + if (init->thr_spec) { + if (init->thr_spec > 0) { + af->alloc = erts_alcu_alloc_thr_spec; + if (init->init.util.ramv) + af->realloc = erts_alcu_realloc_mv_thr_spec; + else + af->realloc = erts_alcu_realloc_thr_spec; + af->free = erts_alcu_free_thr_spec; + } + else { + af->alloc = erts_alcu_alloc_thr_pref; + if (init->init.util.ramv) + af->realloc = erts_alcu_realloc_mv_thr_pref; + else + af->realloc = erts_alcu_realloc_thr_pref; + af->free = erts_alcu_free_thr_pref; + tspec->all_thr_safe = 1; + } + + tspec->enabled = 1; + tspec->size = abs(init->thr_spec) + 1; + + ai->thr_spec = tspec->size; + } + else if (init->init.util.ts) { + af->alloc = erts_alcu_alloc_ts; + if (init->init.util.ramv) + af->realloc = erts_alcu_realloc_mv_ts; + else + af->realloc = erts_alcu_realloc_ts; + af->free = erts_alcu_free_ts; + } + else +#endif + { + af->alloc = erts_alcu_alloc; + if (init->init.util.ramv) + af->realloc = erts_alcu_realloc_mv; + else + af->realloc = erts_alcu_realloc; + af->free = erts_alcu_free; + } + af->extra = NULL; + ai->alloc_util = 1; + ai->enabled = 1; +} + +static void +start_au_allocator(ErtsAlcType_t alctr_n, + struct au_init *init, + ErtsAllocatorState_t *state) +{ + int i; + int size = 1; + void *as0; + enum allctr_type atype; + ErtsAllocatorFunctions_t *af = &erts_allctrs[alctr_n]; + ErtsAllocatorInfo_t *ai = &erts_allctrs_info[alctr_n]; + ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[alctr_n]; + + if (!init->enable) + return; + + if (init->thr_spec) { + void *states = erts_sys_alloc(0, + NULL, + ((sizeof(Allctr_t *) + * (tspec->size + 1)) + + (sizeof(ErtsAllocatorState_t) + * tspec->size) + + ERTS_CACHE_LINE_SIZE - 1)); + if (!states) + erl_exit(ERTS_ABORT_EXIT, + "Failed to allocate allocator states for %salloc\n", + init->init.util.name_prefix); + tspec->allctr = (Allctr_t **) states; + states = ((char *) states) + sizeof(Allctr_t *) * (tspec->size + 1); + states = ((((Uint) states) & ERTS_CACHE_LINE_MASK) + ? (void *) ((((Uint) states) & ~ERTS_CACHE_LINE_MASK) + + ERTS_CACHE_LINE_SIZE) + : (void *) states); + tspec->allctr[0] = init->thr_spec > 0 ? (Allctr_t *) state : (Allctr_t *) NULL; + size = tspec->size; + for (i = 1; i < size; i++) + tspec->allctr[i] = (Allctr_t *) + &((ErtsAllocatorState_t *) states)[i-1]; + } + + for (i = 0; i < size; i++) { + void *as; + atype = init->atype; + + if (!init->thr_spec) + as0 = state; + else { + as0 = (void *) tspec->allctr[i]; + if (!as0) + continue; + if (i == 0) { + if (atype == AFIT) + atype = GOODFIT; + init->init.util.ts = 1; + } + else { + if (init->thr_spec < 0) { + init->init.util.ts = 1; + init->init.util.tspec = 0; + init->init.util.tpref = -1*init->thr_spec; + } + else { + init->init.util.ts = 0; + init->init.util.tspec = init->thr_spec + 1; + init->init.util.tpref = 0; + } + } + } + + switch (atype) { + case GOODFIT: + as = (void *) erts_gfalc_start((GFAllctr_t *) as0, + &init->init.gf, + &init->init.util); + break; + case BESTFIT: + as = (void *) erts_bfalc_start((BFAllctr_t *) as0, + &init->init.bf, + &init->init.util); + break; + case AFIT: + as = (void *) erts_afalc_start((AFAllctr_t *) as0, + &init->init.af, + &init->init.util); + break; + default: + as = NULL; + ASSERT(0); + } + + if (!as) + erl_exit(ERTS_ABORT_EXIT, + "Failed to start %salloc\n", init->init.util.name_prefix); + + ASSERT(as == (void *) as0); + af->extra = as; + } + + if (init->thr_spec) { + af->extra = tspec; + init->init.util.ts = 1; + } + + ai->extra = af->extra; +} + + +static void bad_param(char *param_start, char *param_end) +{ + size_t len = param_end - param_start; + char param[100]; + if (len > 99) + len = 99; + sys_memcpy((void *) param, (void *) param_start, len); + param[len] = '\0'; + erts_fprintf(stderr, "bad \"%s\" parameter\n", param); + erts_usage(); +} + +static void bad_value(char *param_start, char *param_end, char *value) +{ + size_t len = param_end - param_start; + char param[100]; + if (len > 99) + len = 99; + sys_memcpy((void *) param, (void *) param_start, len); + param[len] = '\0'; + erts_fprintf(stderr, "bad \"%s\" value: %s\n", param, value); + erts_usage(); +} + +/* Get arg marks argument as handled by + putting NULL in argv */ +static char * +get_value(char* rest, char** argv, int* ip) +{ + char *param = argv[*ip]+1; + argv[*ip] = NULL; + if (*rest == '\0') { + char *next = argv[*ip + 1]; + if (next[0] == '-' + && next[1] == '-' + && next[2] == '\0') { + bad_value(param, rest, ""); + } + (*ip)++; + argv[*ip] = NULL; + return next; + } + return rest; +} + +static ERTS_INLINE int +has_prefix(const char *prefix, const char *string) +{ + int i; + for (i = 0; prefix[i]; i++) + if (prefix[i] != string[i]) + return 0; + return 1; +} + +static int +get_bool_value(char *param_end, char** argv, int* ip) +{ + char *param = argv[*ip]+1; + char *value = get_value(param_end, argv, ip); + if (strcmp(value, "true") == 0) + return 1; + else if (strcmp(value, "false") == 0) + return 0; + else + bad_value(param, param_end, value); + return -1; +} + +static Uint +get_kb_value(char *param_end, char** argv, int* ip) +{ + Sint tmp; + Uint max = ((~((Uint) 0))/1024) + 1; + char *rest; + char *param = argv[*ip]+1; + char *value = get_value(param_end, argv, ip); + errno = 0; + tmp = (Sint) strtol(value, &rest, 10); + if (errno != 0 || rest == value || tmp < 0 || max < ((Uint) tmp)) + bad_value(param, param_end, value); + if (max == (Uint) tmp) + return ~((Uint) 0); + else + return ((Uint) tmp)*1024; +} + +static Uint +get_amount_value(char *param_end, char** argv, int* ip) +{ + Sint tmp; + char *rest; + char *param = argv[*ip]+1; + char *value = get_value(param_end, argv, ip); + errno = 0; + tmp = (Sint) strtol(value, &rest, 10); + if (errno != 0 || rest == value || tmp < 0) + bad_value(param, param_end, value); + return (Uint) tmp; +} + +static int +get_bool_or_possitive_amount_value(int *bool, Uint *amount, + char *param_end, char** argv, int* ip) +{ + char *param = argv[*ip]+1; + char *value = get_value(param_end, argv, ip); + if (strcmp(value, "true") == 0) { + *bool = 1; + return 1; + } + else if (strcmp(value, "false") == 0) { + *bool = 0; + return 1; + } + else { + Sint tmp; + char *rest; + errno = 0; + tmp = (Sint) strtol(value, &rest, 10); + if (errno != 0 || rest == value || tmp <= 0) { + bad_value(param, param_end, value); + return -1; + } + *amount = (Uint) tmp; + return 0; + } +} + +static void +handle_au_arg(struct au_init *auip, + char* sub_param, + char** argv, + int* ip) +{ + char *param = argv[*ip]+1; + + switch (sub_param[0]) { + case 'a': + if(has_prefix("asbcst", sub_param)) { + auip->init.util.asbcst = get_kb_value(sub_param + 6, argv, ip); + } + else if(has_prefix("as", sub_param)) { + char *alg = get_value(sub_param + 2, argv, ip); + if (strcmp("bf", alg) == 0) { + auip->atype = BESTFIT; + auip->init.bf.ao = 0; + } + else if (strcmp("aobf", alg) == 0) { + auip->atype = BESTFIT; + auip->init.bf.ao = 1; + } + else if (strcmp("gf", alg) == 0) { + auip->atype = GOODFIT; + } + else if (strcmp("af", alg) == 0) { + auip->atype = AFIT; + } + else { + bad_value(param, sub_param + 1, alg); + } + } + else + goto bad_switch; + break; + case 'e': + auip->enable = get_bool_value(sub_param+1, argv, ip); + break; + case 'l': + if (has_prefix("lmbcs", sub_param)) { + auip->default_.lmbcs = 0; + auip->init.util.lmbcs = get_kb_value(sub_param + 5, argv, ip); + } + else + goto bad_switch; + break; + case 'm': + if (has_prefix("mbcgs", sub_param)) { + auip->init.util.mbcgs = get_amount_value(sub_param + 5, argv, ip); + + } + else if (has_prefix("mbsd", sub_param)) { + auip->init.gf.mbsd = get_amount_value(sub_param + 4, argv, ip); + if (auip->init.gf.mbsd < 1) + auip->init.gf.mbsd = 1; + } + else if (has_prefix("mmbcs", sub_param)) { + auip->default_.mmbcs = 0; + auip->init.util.mmbcs = get_kb_value(sub_param + 5, argv, ip); + } + else if (has_prefix("mmmbc", sub_param)) { + auip->default_.mmmbc = 0; + auip->init.util.mmmbc = get_amount_value(sub_param + 5, argv, ip); + } + else if (has_prefix("mmsbc", sub_param)) { + auip->init.util.mmsbc = get_amount_value(sub_param + 5, argv, ip); + } + else + goto bad_switch; + break; + case 'r': + if(has_prefix("rsbcmt", sub_param)) { + auip->init.util.rsbcmt = get_amount_value(sub_param + 6, argv, ip); + if (auip->init.util.rsbcmt > 100) + auip->init.util.rsbcmt = 100; + } + else if(has_prefix("rsbcst", sub_param)) { + auip->init.util.rsbcst = get_amount_value(sub_param + 6, argv, ip); + if (auip->init.util.rsbcst > 100) + auip->init.util.rsbcst = 100; + } + else if (has_prefix("rmbcmt", sub_param)) { + auip->init.util.rmbcmt = get_amount_value(sub_param + 6, argv, ip); + if (auip->init.util.rmbcmt > 100) + auip->init.util.rmbcmt = 100; + } + else if (has_prefix("ramv", sub_param)) { + auip->init.util.ramv = get_bool_value(sub_param + 4, argv, ip); + } + else + goto bad_switch; + break; + case 's': + if(has_prefix("sbct", sub_param)) { + auip->init.util.sbct = get_kb_value(sub_param + 4, argv, ip); + } + else if (has_prefix("smbcs", sub_param)) { + auip->default_.smbcs = 0; + auip->init.util.smbcs = get_kb_value(sub_param + 5, argv, ip); + } + else + goto bad_switch; + break; + case 't': { + Uint no; + int enable; + int res = get_bool_or_possitive_amount_value(&enable, + &no, + sub_param+1, + argv, + ip); + if (res > 0) + auip->thr_spec = enable ? 1 : 0; + else if (res == 0) { + int allocs = (int) no; + if (allocs < 0) + allocs = INT_MIN; + else { + allocs *= -1; + } + auip->thr_spec = allocs; + } + break; + } + default: + bad_switch: + bad_param(param, sub_param); + } +} + +static void +handle_args(int *argc, char **argv, erts_alc_hndl_args_init_t *init) +{ + struct au_init *aui[] = { + &init->binary_alloc, + &init->std_alloc, + &init->ets_alloc, + &init->eheap_alloc, + &init->ll_alloc, + &init->driver_alloc, + &init->sl_alloc, + &init->temp_alloc + }; + int aui_sz = (int) sizeof(aui)/sizeof(aui[0]); + char *arg; + char *rest; + int i, j; + + i = 1; + + ASSERT(argc && argv && init); + + while (i < *argc) { + if(argv[i][0] == '-') { + char *param = argv[i]+1; + switch (argv[i][1]) { + case 'M': + switch (argv[i][2]) { + case 'B': + handle_au_arg(&init->binary_alloc, &argv[i][3], argv, &i); + break; + case 'D': + handle_au_arg(&init->std_alloc, &argv[i][3], argv, &i); + break; + case 'E': + handle_au_arg(&init->ets_alloc, &argv[i][3], argv, &i); + break; + case 'F': /* fix_alloc */ + if (has_prefix("e", param+2)) { + arg = get_value(param+3, argv, &i); + if (strcmp("true", arg) != 0) + bad_value(param, param+3, arg); + } + else + bad_param(param, param+2); + break; + case 'H': + handle_au_arg(&init->eheap_alloc, &argv[i][3], argv, &i); + break; + case 'L': + handle_au_arg(&init->ll_alloc, &argv[i][3], argv, &i); + break; + case 'M': + if (has_prefix("amcbf", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.amcbf = +#endif + get_kb_value(argv[i]+8, argv, &i); + } + else if (has_prefix("rmcbf", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.rmcbf = +#endif + get_amount_value(argv[i]+8, argv, &i); + } + else if (has_prefix("mcs", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.mcs = +#endif + get_amount_value(argv[i]+6, argv, &i); + } + else if (has_prefix("cci", argv[i]+3)) { +#if HAVE_ERTS_MSEG + init->mseg.cci = +#endif + get_amount_value(argv[i]+6, argv, &i); + } + else { + bad_param(param, param+2); + } + break; + case 'R': + handle_au_arg(&init->driver_alloc, &argv[i][3], argv, &i); + break; + case 'S': + handle_au_arg(&init->sl_alloc, &argv[i][3], argv, &i); + break; + case 'T': + handle_au_arg(&init->temp_alloc, &argv[i][3], argv, &i); + break; + case 'Y': { /* sys_alloc */ + if (has_prefix("tt", param+2)) { + /* set trim threshold */ + arg = get_value(param+4, argv, &i); + errno = 0; + init->trim_threshold = (int) strtol(arg, &rest, 10); + if (errno != 0 + || rest == arg + || init->trim_threshold < 0 + || (INT_MAX/1024) < init->trim_threshold) { + bad_value(param, param+4, arg); + } + VERBOSE(DEBUG_SYSTEM, + ("using trim threshold: %d\n", + init->trim_threshold)); + init->trim_threshold *= 1024; + } + else if (has_prefix("tp", param+2)) { + /* set top pad */ + arg = get_value(param+4, argv, &i); + errno = 0; + init->top_pad = (int) strtol(arg, &rest, 10); + if (errno != 0 + || rest == arg + || init->top_pad < 0 + || (INT_MAX/1024) < init->top_pad) { + bad_value(param, param+4, arg); + } + VERBOSE(DEBUG_SYSTEM, + ("using top pad: %d\n",init->top_pad)); + init->top_pad *= 1024; + } + else if (has_prefix("m", param+2)) { + /* Has been handled by erlexec */ + (void) get_value(param+3, argv, &i); + } + else if (has_prefix("e", param+2)) { + arg = get_value(param+3, argv, &i); + if (strcmp("true", arg) != 0) + bad_value(param, param+3, arg); + } + else + bad_param(param, param+2); + break; + } + case 'e': + switch (argv[i][3]) { + case 'a': { + int a; + arg = get_value(argv[i]+4, argv, &i); + if (strcmp("min", arg) == 0) { + for (a = 0; a < aui_sz; a++) + aui[a]->enable = 0; + } + else if (strcmp("max", arg) == 0) { + for (a = 0; a < aui_sz; a++) + aui[a]->enable = 1; + } + else if (strcmp("config", arg) == 0) { + init->erts_alloc_config = 1; + } + else if (strcmp("r9c", arg) == 0 + || strcmp("r10b", arg) == 0 + || strcmp("r11b", arg) == 0) { + set_default_sl_alloc_opts(&init->sl_alloc); + set_default_std_alloc_opts(&init->std_alloc); + set_default_ll_alloc_opts(&init->ll_alloc); + set_default_temp_alloc_opts(&init->temp_alloc); + set_default_eheap_alloc_opts(&init->eheap_alloc); + set_default_binary_alloc_opts(&init->binary_alloc); + set_default_ets_alloc_opts(&init->ets_alloc); + set_default_driver_alloc_opts(&init->driver_alloc); + + init->driver_alloc.enable = 0; + if (strcmp("r9c", arg) == 0) { + init->sl_alloc.enable = 0; + init->std_alloc.enable = 0; + init->binary_alloc.enable = 0; + init->ets_alloc.enable = 0; + } + + for (a = 0; a < aui_sz; a++) { + aui[a]->thr_spec = 0; + aui[a]->init.util.ramv = 0; + aui[a]->init.util.mmmbc = 10; + aui[a]->init.util.lmbcs = 5*1024*1024; + } + } + else { + bad_param(param, param+3); + } + break; + } + default: + bad_param(param, param+1); + } + break; + case 'i': + switch (argv[i][3]) { + case 's': + arg = get_value(argv[i]+4, argv, &i); + if (strcmp("true", arg) == 0) + init->instr.stat = 1; + else if (strcmp("false", arg) == 0) + init->instr.stat = 0; + else + bad_value(param, param+3, arg); + break; + case 'm': + arg = get_value(argv[i]+4, argv, &i); + if (strcmp("true", arg) == 0) + init->instr.map = 1; + else if (strcmp("false", arg) == 0) + init->instr.map = 0; + else + bad_value(param, param+3, arg); + break; + case 't': + init->instr.mtrace = get_value(argv[i]+4, argv, &i); + break; + default: + bad_param(param, param+2); + } + break; + case 'u': + if (has_prefix("ycs", argv[i]+3)) { + init->alloc_util.ycs + = get_kb_value(argv[i]+6, argv, &i); + } + else if (has_prefix("mmc", argv[i]+3)) { + init->alloc_util.mmc + = get_amount_value(argv[i]+6, argv, &i); + } + else { + int a; + int start = i; + char *param = argv[i]; + char *val = i+1 < *argc ? argv[i+1] : NULL; + + for (a = 0; a < aui_sz; a++) { + if (a > 0) { + ASSERT(i == start || i == start+1); + argv[start] = param; + if (i != start) + argv[start + 1] = val; + i = start; + } + handle_au_arg(aui[a], &argv[i][3], argv, &i); + } + } + break; + default: + bad_param(param, param+1); + } + break; + case '-': + if (argv[i][2] == '\0') { + /* End of system flags reached */ + if (init->instr.mtrace + /* || init->instr.stat + || init->instr.map */) { + while (i < *argc) { + if(strcmp(argv[i], "-sname") == 0 + || strcmp(argv[i], "-name") == 0) { + if (i + 1 <*argc) { + init->instr.nodename = argv[i+1]; + break; + } + } + i++; + } + } + goto args_parsed; + } + break; + default: + break; + } + } + i++; + } + + args_parsed: + /* Handled arguments have been marked with NULL. Slide arguments + not handled towards the beginning of argv. */ + for (i = 0, j = 0; i < *argc; i++) { + if (argv[i]) + argv[j++] = argv[i]; + } + *argc = j; + +} + +static char *type_no_str(ErtsAlcType_t n) +{ + +#if ERTS_ALC_N_MIN != 0 + if (n < ERTS_ALC_N_MIN) + return NULL; +#endif + if (n > ERTS_ALC_N_MAX) + return NULL; + return (char *) ERTS_ALC_N2TD(n); +} + +#define type_str(T) type_no_str(ERTS_ALC_T2N((T))) + +erts_tsd_key_t thr_ix_key; +erts_spinlock_t alloc_thr_ix_lock; +int last_thr_ix; +int first_dyn_thr_ix; + +static void +init_thr_ix(int static_ixs) +{ + erts_tsd_key_create(&thr_ix_key); + erts_spinlock_init(&alloc_thr_ix_lock, "alloc_thr_ix_lock"); + last_thr_ix = -4711; + first_dyn_thr_ix = static_ixs+1; +} + +int +erts_alc_get_thr_ix(void) +{ + int ix = (int)(long) erts_tsd_get(thr_ix_key); + if (ix == 0) { + erts_spin_lock(&alloc_thr_ix_lock); + last_thr_ix++; + if (last_thr_ix < 0) + last_thr_ix = first_dyn_thr_ix; + ix = last_thr_ix; + erts_spin_unlock(&alloc_thr_ix_lock); + erts_tsd_set(thr_ix_key, (void *)(long) ix); + } + ASSERT(ix > 0); + return ix; +} + +void erts_alloc_reg_scheduler_id(Uint id) +{ + int ix = (int) id; + ASSERT(0 < ix && ix <= first_dyn_thr_ix); + ASSERT(0 == (int) (long) erts_tsd_get(thr_ix_key)); + erts_tsd_set(thr_ix_key, (void *)(long) ix); +} + +__decl_noreturn void +erts_alc_fatal_error(int error, int func, ErtsAlcType_t n, ...) +{ + char buf[10]; + char *t_str; + char *allctr_str; + + ASSERT(n >= ERTS_ALC_N_MIN); + ASSERT(n <= ERTS_ALC_N_MAX); + + + if (n < ERTS_ALC_N_MIN || ERTS_ALC_N_MAX < n) + allctr_str = "UNKNOWN"; + else { + ErtsAlcType_t a = ERTS_ALC_T2A(ERTS_ALC_N2T(n)); + if (erts_allctrs_info[a].enabled) + allctr_str = (char *) ERTS_ALC_A2AD(a); + else + allctr_str = (char *) ERTS_ALC_A2AD(ERTS_ALC_A_SYSTEM); + } + + t_str = type_no_str(n); + if (!t_str) { + sprintf(buf, "%d", (int) n); + t_str = buf; + } + + switch (error) { + case ERTS_ALC_E_NOTSUP: { + char *op_str; + switch (func) { + case ERTS_ALC_O_ALLOC: op_str = "alloc"; break; + case ERTS_ALC_O_REALLOC: op_str = "realloc"; break; + case ERTS_ALC_O_FREE: op_str = "free"; break; + default: op_str = "UNKNOWN"; break; + } + erl_exit(ERTS_ABORT_EXIT, + "%s: %s operation not supported (memory type: \"%s\")\n", + allctr_str, op_str, t_str); + break; + } + case ERTS_ALC_E_NOMEM: { + Uint size; + va_list argp; + char *op = func == ERTS_ALC_O_REALLOC ? "reallocate" : "allocate"; + + + va_start(argp, n); + size = va_arg(argp, Uint); + va_end(argp); + erl_exit(1, + "%s: Cannot %s %lu bytes of memory (of type \"%s\").\n", + allctr_str, op, size, t_str); + break; + } + case ERTS_ALC_E_NOALLCTR: + erl_exit(ERTS_ABORT_EXIT, + "erts_alloc: Unknown allocator type: %d\n", + ERTS_ALC_T2A(ERTS_ALC_N2T(n))); + break; + default: + erl_exit(ERTS_ABORT_EXIT, "erts_alloc: Unknown error: %d\n", error); + break; + } +} + +__decl_noreturn void +erts_alloc_enomem(ErtsAlcType_t type, Uint size) +{ + erts_alloc_n_enomem(ERTS_ALC_T2N(type), size); +} + +__decl_noreturn void +erts_alloc_n_enomem(ErtsAlcType_t n, Uint size) +{ + erts_alc_fatal_error(ERTS_ALC_E_NOMEM, ERTS_ALC_O_ALLOC, n, size); +} + +__decl_noreturn void +erts_realloc_enomem(ErtsAlcType_t type, void *ptr, Uint size) +{ + erts_realloc_n_enomem(ERTS_ALC_T2N(type), ptr, size); +} + +__decl_noreturn void +erts_realloc_n_enomem(ErtsAlcType_t n, void *ptr, Uint size) +{ + erts_alc_fatal_error(ERTS_ALC_E_NOMEM, ERTS_ALC_O_REALLOC, n, size); +} + +static ERTS_INLINE Uint +alcu_size(ErtsAlcType_t ai) +{ + Uint res = 0; + + ASSERT(erts_allctrs_info[ai].enabled); + ASSERT(erts_allctrs_info[ai].alloc_util); + + if (!erts_allctrs_info[ai].thr_spec) { + Allctr_t *allctr = erts_allctrs_info[ai].extra; + AllctrSize_t asize; + erts_alcu_current_size(allctr, &asize); + res += asize.blocks; + } + else { + ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[ai]; + int i; + + ASSERT(tspec->all_thr_safe); + + ASSERT(tspec->enabled); + + for (i = tspec->size - 1; i >= 0; i--) { + Allctr_t *allctr = tspec->allctr[i]; + AllctrSize_t asize; + if (allctr) { + erts_alcu_current_size(allctr, &asize); + res += asize.blocks; + } + } + } + + return res; +} + +Eterm +erts_memory(int *print_to_p, void *print_to_arg, void *proc, Eterm earg) +{ +#define ERTS_MEM_NEED_ALL_ALCU (!erts_instr_stat && want_tot_or_sys) + ErtsFixInfo efi; + struct { + int total; + int processes; + int processes_used; + int system; + int atom; + int atom_used; + int binary; + int code; + int ets; + int maximum; + } want = {0}; + struct { + Uint total; + Uint processes; + Uint processes_used; + Uint system; + Uint atom; + Uint atom_used; + Uint binary; + Uint code; + Uint ets; + Uint maximum; + } size = {0}; + Eterm atoms[sizeof(size)/sizeof(Uint)]; + Uint *uintps[sizeof(size)/sizeof(Uint)]; + Eterm euints[sizeof(size)/sizeof(Uint)]; + int need_atom; + int want_tot_or_sys; + int length; + Eterm res = THE_NON_VALUE; + ErtsAlcType_t ai; + int only_one_value = 0; + + /* Figure out whats wanted... */ + + length = 0; + if (is_non_value(earg)) { /* i.e. wants all */ + want.total = 1; + atoms[length] = am_total; + uintps[length++] = &size.total; + + want.processes = 1; + atoms[length] = am_processes; + uintps[length++] = &size.processes; + + want.processes_used = 1; + atoms[length] = am_processes_used; + uintps[length++] = &size.processes_used; + + want.system = 1; + atoms[length] = am_system; + uintps[length++] = &size.system; + + want.atom = 1; + atoms[length] = am_atom; + uintps[length++] = &size.atom; + + want.atom_used = 1; + atoms[length] = am_atom_used; + uintps[length++] = &size.atom_used; + + want.binary = 1; + atoms[length] = am_binary; + uintps[length++] = &size.binary; + + want.code = 1; + atoms[length] = am_code; + uintps[length++] = &size.code; + + want.ets = 1; + atoms[length] = am_ets; + uintps[length++] = &size.ets; + + want.maximum = erts_instr_stat; + if (want.maximum) { + atoms[length] = am_maximum; + uintps[length++] = &size.maximum; + } + + } + else { + Eterm tmp_heap[2]; + Eterm wanted_list; + + if (is_nil(earg)) + return NIL; + + if (is_not_atom(earg)) + wanted_list = earg; + else { + wanted_list = CONS(&tmp_heap[0], earg, NIL); + only_one_value = 1; + } + + while (is_list(wanted_list)) { + switch (CAR(list_val(wanted_list))) { + case am_total: + if (!want.total) { + want.total = 1; + atoms[length] = am_total; + uintps[length++] = &size.total; + } + break; + case am_processes: + if (!want.processes) { + want.processes = 1; + atoms[length] = am_processes; + uintps[length++] = &size.processes; + } + break; + case am_processes_used: + if (!want.processes_used) { + want.processes_used = 1; + atoms[length] = am_processes_used; + uintps[length++] = &size.processes_used; + } + break; + case am_system: + if (!want.system) { + want.system = 1; + atoms[length] = am_system; + uintps[length++] = &size.system; + } + break; + case am_atom: + if (!want.atom) { + want.atom = 1; + atoms[length] = am_atom; + uintps[length++] = &size.atom; + } + break; + case am_atom_used: + if (!want.atom_used) { + want.atom_used = 1; + atoms[length] = am_atom_used; + uintps[length++] = &size.atom_used; + } + break; + case am_binary: + if (!want.binary) { + want.binary = 1; + atoms[length] = am_binary; + uintps[length++] = &size.binary; + } + break; + case am_code: + if (!want.code) { + want.code = 1; + atoms[length] = am_code; + uintps[length++] = &size.code; + } + break; + case am_ets: + if (!want.ets) { + want.ets = 1; + atoms[length] = am_ets; + uintps[length++] = &size.ets; + } + break; + case am_maximum: + if (erts_instr_stat) { + if (!want.maximum) { + want.maximum = 1; + atoms[length] = am_maximum; + uintps[length++] = &size.maximum; + } + } + else + return am_badarg; + break; + default: + return am_badarg; + } + wanted_list = CDR(list_val(wanted_list)); + } + if (is_not_nil(wanted_list)) + return am_badarg; + } + + /* All alloc_util allocators *have* to be enabled */ + + for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) { + switch (ai) { + case ERTS_ALC_A_SYSTEM: + case ERTS_ALC_A_FIXED_SIZE: + break; + default: + if (!erts_allctrs_info[ai].enabled + || !erts_allctrs_info[ai].alloc_util) { + return am_notsup; + } + break; + } + } + + ASSERT(length <= sizeof(atoms)/sizeof(Eterm)); + ASSERT(length <= sizeof(euints)/sizeof(Eterm)); + ASSERT(length <= sizeof(uintps)/sizeof(Uint)); + + + if (proc) { + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN + == erts_proc_lc_my_proc_locks(proc)); + /* We'll need locks early in the lock order */ + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + } + + /* Calculate values needed... */ + + want_tot_or_sys = want.total || want.system; + need_atom = ERTS_MEM_NEED_ALL_ALCU || want.atom; + + if (ERTS_MEM_NEED_ALL_ALCU) { + size.total = 0; + + for (ai = ERTS_ALC_A_MIN; ai <= ERTS_ALC_A_MAX; ai++) { + if (erts_allctrs_info[ai].alloc_util) { + Uint *save; + Uint asz; + switch (ai) { + case ERTS_ALC_A_TEMPORARY: + /* + * Often not thread safe and usually never + * contain any allocated memory. + */ + continue; + case ERTS_ALC_A_EHEAP: + save = &size.processes; + break; + case ERTS_ALC_A_ETS: + save = &size.ets; + break; + case ERTS_ALC_A_BINARY: + save = &size.binary; + break; + default: + save = NULL; + break; + } + asz = alcu_size(ai); + if (save) + *save = asz; + size.total += asz; + } + } + } + + + + if (want_tot_or_sys || want.processes || want.processes_used) { + Uint tmp; + + if (ERTS_MEM_NEED_ALL_ALCU) + tmp = size.processes; + else + tmp = alcu_size(ERTS_ALC_A_EHEAP); + tmp += erts_max_processes*sizeof(Process*); +#ifdef HYBRID + tmp += erts_max_processes*sizeof(Process*); +#endif + tmp += erts_bif_timer_memory_size(); + tmp += erts_tot_link_lh_size(); + + size.processes = size.processes_used = tmp; + + erts_fix_info(ERTS_ALC_T_NLINK_SH, &efi); + size.processes += efi.total; + size.processes_used += efi.used; + + erts_fix_info(ERTS_ALC_T_MONITOR_SH, &efi); + size.processes += efi.total; + size.processes_used += efi.used; + + erts_fix_info(ERTS_ALC_T_PROC, &efi); + size.processes += efi.total; + size.processes_used += efi.used; + + erts_fix_info(ERTS_ALC_T_REG_PROC, &efi); + size.processes += efi.total; + size.processes_used += efi.used; + + } + + if (want.atom || want.atom_used) { + Uint reserved_atom_space, atom_space; + erts_atom_get_text_space_sizes(&reserved_atom_space, &atom_space); + size.atom = size.atom_used = atom_table_sz(); + erts_fix_info(ERTS_ALC_T_ATOM, &efi); + + if (want.atom) { + size.atom += reserved_atom_space; + size.atom += efi.total; + } + + if (want.atom_used) { + size.atom_used += atom_space; + size.atom_used += efi.used; + } + } + + if (!ERTS_MEM_NEED_ALL_ALCU && want.binary) + size.binary = alcu_size(ERTS_ALC_A_BINARY); + + if (want.code) { + size.code = module_table_sz(); + erts_fix_info(ERTS_ALC_T_MODULE, &efi); + size.code += efi.used; + size.code += export_table_sz(); + erts_fix_info(ERTS_ALC_T_EXPORT, &efi); + size.code += efi.used; + size.code += erts_fun_table_sz(); + erts_fix_info(ERTS_ALC_T_FUN_ENTRY, &efi); + size.code += efi.used; + size.code += allocated_modules*sizeof(Range); + size.code += erts_total_code_size; + } + + if (want.ets) { + if (!ERTS_MEM_NEED_ALL_ALCU) + size.ets = alcu_size(ERTS_ALC_A_ETS); + size.ets += erts_get_ets_misc_mem_size(); + } + + if (erts_instr_stat && (want_tot_or_sys || want.maximum)) { + if (want_tot_or_sys) { + size.total = erts_instr_get_total(); + size.system = size.total - size.processes; + } + size.maximum = erts_instr_get_max_total(); + } + else if (want_tot_or_sys) { + size.system = size.total - size.processes; + } + + if (print_to_p) { + int i; + int to = *print_to_p; + void *arg = print_to_arg; + + /* Print result... */ + erts_print(to, arg, "=memory\n"); + for (i = 0; i < length; i++) + erts_print(to, arg, "%T: %bpu\n", atoms[i], *uintps[i]); + } + + if (proc) { + /* Build erlang term result... */ + Uint *hp; + Uint hsz; + + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); + + if (only_one_value) { + ASSERT(length == 1); + hsz = 0; + erts_bld_uint(NULL, &hsz, *uintps[0]); + hp = hsz ? HAlloc((Process *) proc, hsz) : NULL; + res = erts_bld_uint(&hp, NULL, *uintps[0]); + } + else { + Uint **hpp = NULL; + Uint *hszp = &hsz; + hsz = 0; + + while (1) { + int i; + for (i = 0; i < length; i++) + euints[i] = erts_bld_uint(hpp, hszp, *uintps[i]); + res = erts_bld_2tup_list(hpp, hszp, length, atoms, euints); + if (hpp) + break; + hp = HAlloc((Process *) proc, hsz); + hpp = &hp; + hszp = NULL; + } + } + } + + return res; + +#undef ERTS_MEM_NEED_ALL_ALCU +} + +struct aa_values { + Uint arity; + const char *name; + Uint ui[2]; +}; + +Eterm +erts_allocated_areas(int *print_to_p, void *print_to_arg, void *proc) +{ +#define MAX_AA_VALUES \ + (20 + (ERTS_ALC_N_MAX_A_FIXED_SIZE - ERTS_ALC_N_MIN_A_FIXED_SIZE + 1)) + + struct aa_values values[MAX_AA_VALUES]; + Eterm res = THE_NON_VALUE; + int i, length; + ErtsFixInfo efi; + Uint reserved_atom_space, atom_space; + + if (proc) { + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN + == erts_proc_lc_my_proc_locks(proc)); + + /* We'll need locks early in the lock order */ + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + } + + i = 0; + + if (erts_instr_stat) { + values[i].arity = 2; + values[i].name = "total"; + values[i].ui[0] = erts_instr_get_total(); + i++; + + values[i].arity = 2; + values[i].name = "maximum"; + values[i].ui[0] = erts_instr_get_max_total(); + i++; + } + + values[i].arity = 2; + values[i].name = "sys_misc"; + values[i].ui[0] = erts_sys_misc_mem_sz(); + i++; + + values[i].arity = 2; + values[i].name = "static"; + values[i].ui[0] = + erts_max_ports*sizeof(Port) /* Port table */ + + erts_timer_wheel_memory_size() /* Timer wheel */ +#ifdef SYS_TMP_BUF_SIZE + + SYS_TMP_BUF_SIZE /* tmp_buf in sys on vxworks & ose */ +#endif + ; + i++; + + erts_atom_get_text_space_sizes(&reserved_atom_space, &atom_space); + + values[i].arity = 3; + values[i].name = "atom_space"; + values[i].ui[0] = reserved_atom_space; + values[i].ui[1] = atom_space; + i++; + + values[i].arity = 2; + values[i].name = "atom_table"; + values[i].ui[0] = atom_table_sz(); + i++; + + values[i].arity = 2; + values[i].name = "module_table"; + values[i].ui[0] = module_table_sz(); + i++; + + values[i].arity = 2; + values[i].name = "export_table"; + values[i].ui[0] = export_table_sz(); + i++; + + values[i].arity = 2; + values[i].name = "register_table"; + values[i].ui[0] = process_reg_sz(); + i++; + + values[i].arity = 2; + values[i].name = "fun_table"; + values[i].ui[0] = erts_fun_table_sz(); + i++; + + values[i].arity = 2; + values[i].name = "module_refs"; + values[i].ui[0] = allocated_modules*sizeof(Range); + i++; + + values[i].arity = 2; + values[i].name = "loaded_code"; + values[i].ui[0] = erts_total_code_size; + i++; + + values[i].arity = 2; + values[i].name = "dist_table"; + values[i].ui[0] = erts_dist_table_size(); + i++; + + values[i].arity = 2; + values[i].name = "node_table"; + values[i].ui[0] = erts_node_table_size(); + i++; + + values[i].arity = 2; + values[i].name = "bits_bufs_size"; + values[i].ui[0] = erts_bits_bufs_size(); + i++; + + values[i].arity = 2; + values[i].name = "bif_timer"; + values[i].ui[0] = erts_bif_timer_memory_size(); + i++; + + values[i].arity = 2; + values[i].name = "link_lh"; + values[i].ui[0] = erts_tot_link_lh_size(); + i++; + + { + Uint n; + + for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE; + n <= ERTS_ALC_N_MAX_A_FIXED_SIZE; + n++) { + erts_fix_info(ERTS_ALC_N2T(n), &efi); + + values[i].arity = 3; + values[i].name = ERTS_ALC_N2TD(n); + values[i].ui[0] = efi.total; + values[i].ui[1] = efi.used; + i++; + } + + } + + length = i; + ASSERT(length <= MAX_AA_VALUES); + + if (print_to_p) { + /* Print result... */ + int to = *print_to_p; + void *arg = print_to_arg; + + erts_print(to, arg, "=allocated_areas\n"); + for (i = 0; i < length; i++) { + switch (values[i].arity) { + case 2: + erts_print(to, arg, "%s: %bpu\n", + values[i].name, values[i].ui[0]); + break; + case 3: + erts_print(to, arg, "%s: %bpu %bpu\n", + values[i].name, values[i].ui[0], values[i].ui[1]); + break; + default: + erts_print(to, arg, "ERROR: internal_error\n"); + ASSERT(0); + return am_internal_error; + } + } + } + + if (proc) { + /* Build erlang term result... */ + Eterm tuples[MAX_AA_VALUES]; + Uint *hp; + Uint **hpp; + Uint hsz; + Uint *hszp; + + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); + + hpp = NULL; + hsz = 0; + hszp = &hsz; + + while (1) { + int i; + for (i = 0; i < length; i++) { + Eterm atom; + if (hpp) + atom = am_atom_put(values[i].name, + (int) strlen(values[i].name)); + else + atom = am_true; + + switch (values[i].arity) { + case 2: + tuples[i] = erts_bld_tuple(hpp, hszp, 2, + atom, + erts_bld_uint(hpp, hszp, + values[i].ui[0])); + break; + case 3: + tuples[i] = erts_bld_tuple(hpp, hszp, 3, + atom, + erts_bld_uint(hpp, hszp, + values[i].ui[0]), + erts_bld_uint(hpp, hszp, + values[i].ui[1])); + break; + default: + ASSERT(0); + return am_internal_error; + } + } + res = erts_bld_list(hpp, hszp, length, tuples); + if (hpp) + break; + hp = HAlloc((Process *) proc, hsz); + hpp = &hp; + hszp = NULL; + } + } + + return res; +#undef MAX_AA_VALUES +} + +Eterm +erts_alloc_util_allocators(void *proc) +{ + Eterm res; + Uint *hp; + Uint sz; + int i; + /* + * Currently all allocators except sys_alloc and fix_alloc are + * alloc_util allocators. + */ + sz = ((ERTS_ALC_A_MAX + 1 - ERTS_ALC_A_MIN) - 2)*2; + ASSERT(sz > 0); + hp = HAlloc((Process *) proc, sz); + res = NIL; + for (i = ERTS_ALC_A_MAX; i >= ERTS_ALC_A_MIN; i--) { + switch (i) { + case ERTS_ALC_A_SYSTEM: + case ERTS_ALC_A_FIXED_SIZE: + break; + default: { + char *alc_str = (char *) ERTS_ALC_A2AD(i); + Eterm alc = am_atom_put(alc_str, sys_strlen(alc_str)); + res = CONS(hp, alc, res); + hp += 2; + break; + } + } + } + return res; +} + +Eterm +erts_allocator_info_term(void *proc, Eterm which_alloc, int only_sz) +{ +#define ERTS_AIT_RET(R) \ + do { res = (R); goto done; } while (0) +#define ERTS_AIT_HALLOC(P, S) \ + do { hp = HAlloc((P), (S)); hp_end = hp + (S); } while (0) + + ErtsAlcType_t i; + Uint sz = 0; + Uint *hp = NULL; + Uint *hp_end = NULL; + Eterm res = am_undefined; + + if (is_not_atom(which_alloc)) + goto done; + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + if (erts_is_atom_str((char *) ERTS_ALC_A2AD(i), which_alloc)) { + if (!erts_allctrs_info[i].enabled) + ERTS_AIT_RET(am_false); + else { + if (erts_allctrs_info[i].alloc_util) { + Eterm ires, tmp; + Eterm **hpp; + Uint *szp; + Eterm (*info_func)(Allctr_t *, + int, + int *, + void *, + Uint **, + Uint *); + + info_func = (only_sz + ? erts_alcu_sz_info + : erts_alcu_info); + + if (erts_allctrs_info[i].thr_spec) { + ErtsAllocatorThrSpec_t *tspec = &erts_allctr_thr_spec[i]; + int j; + int block_system = !tspec->all_thr_safe; + + if (block_system) { + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + } + ASSERT(tspec->enabled); + + szp = &sz; + hpp = NULL; + + while (1) { + ires = NIL; + for (j = tspec->size - 1; j >= 0; j--) { + Allctr_t *allctr = tspec->allctr[j]; + if (allctr) { + tmp = erts_bld_tuple(hpp, + szp, + 3, + erts_bld_atom(hpp, + szp, + "instance"), + make_small((Uint) j), + (*info_func)(allctr, + hpp != NULL, + NULL, + NULL, + hpp, + szp)); + ires = erts_bld_cons(hpp, szp, tmp, ires); + } + } + if (hpp) + break; + ERTS_AIT_HALLOC((Process *) proc, sz); + hpp = &hp; + szp = NULL; + } + + if (block_system) { + erts_smp_release_system(); + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); + } + } + else { + Allctr_t *allctr = erts_allctrs_info[i].extra; + szp = &sz; + hpp = NULL; + while (1) { + ires = NIL; + tmp = erts_bld_tuple(hpp, + szp, + 3, + erts_bld_atom(hpp, + szp, + "instance"), + make_small((Uint) 0), + (*info_func)(allctr, + hpp != NULL, + NULL, + NULL, + hpp, + szp)); + ires = erts_bld_cons(hpp, szp, tmp, ires); + if (hpp) + break; + ERTS_AIT_HALLOC((Process *) proc, sz); + hpp = &hp; + szp = NULL; + } + } + ERTS_AIT_RET(ires); + } + else { + Eterm *szp, **hpp; + + switch (i) { + case ERTS_ALC_A_SYSTEM: { + SysAllocStat sas; + Eterm opts_am; + Eterm opts; + Eterm as[4]; + Eterm ts[4]; + int l; + + if (only_sz) + ERTS_AIT_RET(NIL); + + sys_alloc_stat(&sas); + opts_am = am_atom_put("options", 7); + + szp = &sz; + hpp = NULL; + + restart_sys_alloc: + l = 0; + as[l] = am_atom_put("e", 1); + ts[l++] = am_true; +#ifdef ELIB_ALLOC_IS_CLIB + as[l] = am_atom_put("m", 1); + ts[l++] = am_atom_put("elib", 4); +#else + as[l] = am_atom_put("m", 1); + ts[l++] = am_atom_put("libc", 4); +#endif + if(sas.trim_threshold >= 0) { + as[l] = am_atom_put("tt", 2); + ts[l++] = erts_bld_uint(hpp, szp, + (Uint) sas.trim_threshold); + } + if(sas.top_pad >= 0) { + as[l] = am_atom_put("tp", 2); + ts[l++] = erts_bld_uint(hpp, szp, (Uint) sas.top_pad); + } + + opts = erts_bld_2tup_list(hpp, szp, l, as, ts); + res = erts_bld_2tup_list(hpp, szp, 1, &opts_am, &opts); + + if (szp) { + ERTS_AIT_HALLOC((Process *) proc, sz); + szp = NULL; + hpp = &hp; + goto restart_sys_alloc; + } + ERTS_AIT_RET(res); + } + case ERTS_ALC_A_FIXED_SIZE: { + ErtsAlcType_t n; + Eterm as[2], vs[2]; + + if (only_sz) + ERTS_AIT_RET(NIL); + + as[0] = am_atom_put("options", 7); + as[1] = am_atom_put("pools", 5); + + szp = &sz; + hpp = NULL; + + restart_fix_alloc: + + vs[0] = erts_bld_cons(hpp, szp, + erts_bld_tuple(hpp, szp, 2, + am_atom_put("e", + 1), + am_true), + NIL); + + vs[1] = NIL; + for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE; + n <= ERTS_ALC_N_MAX_A_FIXED_SIZE; + n++) { + ErtsFixInfo efi; + erts_fix_info(ERTS_ALC_N2T(n), &efi); + + vs[1] = erts_bld_cons( + hpp, szp, + erts_bld_tuple( + hpp, szp, 3, + am_atom_put((char *) ERTS_ALC_N2TD(n), + strlen(ERTS_ALC_N2TD(n))), + erts_bld_uint(hpp, szp, efi.total), + erts_bld_uint(hpp, szp, efi.used)), + vs[1]); + + } + + res = erts_bld_2tup_list(hpp, szp, 2, as, vs); + if (szp) { + ERTS_AIT_HALLOC((Process *) proc, sz); + szp = NULL; + hpp = &hp; + goto restart_fix_alloc; + } + ERTS_AIT_RET(res); + } + default: + ASSERT(0); + goto done; + } + } + } + } + } + + if (ERTS_IS_ATOM_STR("mseg_alloc", which_alloc)) { +#if HAVE_ERTS_MSEG + if (only_sz) + ERTS_AIT_RET(NIL); + erts_mseg_info(NULL, NULL, 0, NULL, &sz); + if (sz) + ERTS_AIT_HALLOC((Process *) proc, sz); + ERTS_AIT_RET(erts_mseg_info(NULL, NULL, 1, &hp, NULL)); +#else + ERTS_AIT_RET(am_false); +#endif + + } + else if (ERTS_IS_ATOM_STR("alloc_util", which_alloc)) { + if (only_sz) + ERTS_AIT_RET(NIL); + erts_alcu_au_info_options(NULL, NULL, NULL, &sz); + if (sz) + ERTS_AIT_HALLOC((Process *) proc, sz); + ERTS_AIT_RET(erts_alcu_au_info_options(NULL, NULL, &hp, NULL)); + } + + done: + if (hp) { + ASSERT(hp_end >= hp); + HRelease((Process *) proc, hp_end, hp); + } + return res; + +#undef ERTS_AIT_RET +#undef ERTS_AIT_HALLOC +} + +void +erts_allocator_info(int to, void *arg) +{ + ErtsAlcType_t a; + + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0) + || (ERTS_IS_CRASH_DUMPING + && erts_smp_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + + for (a = ERTS_ALC_A_MIN; a <= ERTS_ALC_A_MAX; a++) { + int ai; + for (ai = 0; ai == 0 || ai < erts_allctrs_info[a].thr_spec; ai++) { + if (erts_allctrs_info[a].thr_spec) { + if (!erts_allctr_thr_spec[a].allctr[ai]) + continue; + erts_print(to, arg, "=allocator:%s[%d]\n", + ERTS_ALC_A2AD(a), ai); + } + else { + erts_print(to, arg, "=allocator:%s\n", ERTS_ALC_A2AD(a)); + } + if (!erts_allctrs_info[a].enabled) + erts_print(to, arg, "option e: false\n"); + else { + if (erts_allctrs_info[a].alloc_util) { + void *as; + if (!erts_allctrs_info[a].thr_spec) + as = erts_allctrs_info[a].extra; + else { + ASSERT(erts_allctr_thr_spec[a].enabled); + as = erts_allctr_thr_spec[a].allctr[ai]; + } + /* Binary alloc has its own thread safety... */ + erts_alcu_info(as, 0, &to, arg, NULL, NULL); + } + else { + switch (a) { + case ERTS_ALC_A_SYSTEM: { + SysAllocStat sas; + erts_print(to, arg, "option e: true\n"); +#ifdef ELIB_ALLOC_IS_CLIB + erts_print(to, arg, "option m: elib\n"); +#else + erts_print(to, arg, "option m: libc\n"); +#endif + sys_alloc_stat(&sas); + if(sas.trim_threshold >= 0) + erts_print(to, arg, "option tt: %d\n", sas.trim_threshold); + if(sas.top_pad >= 0) + erts_print(to, arg, "option tp: %d\n", sas.top_pad); + break; + } + case ERTS_ALC_A_FIXED_SIZE: { + ErtsAlcType_t n; + erts_print(to, arg, "option e: true\n"); + + for (n = ERTS_ALC_N_MIN_A_FIXED_SIZE; + n <= ERTS_ALC_N_MAX_A_FIXED_SIZE; + n++) { + ErtsFixInfo efi; + erts_fix_info(ERTS_ALC_N2T(n), &efi); + erts_print(to, arg, "%s: %lu %lu\n", + ERTS_ALC_N2TD(n), + efi.total, + efi.used); + } + break; + } + default: + ASSERT(0); + break; + } + } + } + } + } + +#if HAVE_ERTS_MSEG + erts_print(to, arg, "=allocator:mseg_alloc\n"); + erts_mseg_info(&to, arg, 0, NULL, NULL); +#endif + + erts_print(to, arg, "=allocator:alloc_util\n"); + erts_alcu_au_info_options(&to, arg, NULL, NULL); + + erts_print(to, arg, "=allocator:instr\n"); + erts_print(to, arg, "option m: %s\n", + erts_instr_memory_map ? "true" : "false"); + erts_print(to, arg, "option s: %s\n", + erts_instr_stat ? "true" : "false"); + erts_print(to, arg, "option t: %s\n", + erts_mtrace_enabled ? "true" : "false"); + +} + +Eterm +erts_allocator_options(void *proc) +{ +#if HAVE_ERTS_MSEG + int use_mseg = 0; +#endif + Uint sz, *szp, *hp, **hpp; + Eterm res, features, settings; + Eterm atoms[ERTS_ALC_A_MAX-ERTS_ALC_A_MIN+5]; + Uint terms[ERTS_ALC_A_MAX-ERTS_ALC_A_MIN+5]; + int a, length; + SysAllocStat sas; + Uint *endp = NULL; + + sys_alloc_stat(&sas); + + /* First find out the heap size needed ... */ + hpp = NULL; + szp = &sz; + sz = 0; + + bld_term: + + length = 0; + features = NIL; + settings = NIL; + + for (a = ERTS_ALC_A_MIN; a <= ERTS_ALC_A_MAX; a++) { + Eterm tmp = NIL; + atoms[length] = am_atom_put((char *) ERTS_ALC_A2AD(a), + strlen(ERTS_ALC_A2AD(a))); + if (erts_allctrs_info[a].enabled) { + if (erts_allctrs_info[a].alloc_util) { + Allctr_t *allctr; +#if HAVE_ERTS_MSEG + use_mseg++; +#endif + if (erts_allctr_thr_spec[a].enabled) + allctr = erts_allctr_thr_spec[a].allctr[1]; + else + allctr = erts_allctrs_info[a].extra; + tmp = erts_alcu_info_options(allctr, NULL, NULL, hpp, szp); + } + else { + int l = 0; + Eterm as[4]; + Eterm ts[4]; + + as[l] = am_atom_put("e", 1); + ts[l++] = am_true; + + switch (a) { + case ERTS_ALC_A_SYSTEM: +#ifdef ELIB_ALLOC_IS_CLIB + as[l] = am_atom_put("m", 1); + ts[l++] = am_atom_put("elib", 4); +#else + as[l] = am_atom_put("m", 1); + ts[l++] = am_atom_put("libc", 4); +#endif + if(sas.trim_threshold >= 0) { + as[l] = am_atom_put("tt", 2); + ts[l++] = erts_bld_uint(hpp, szp, + (Uint) sas.trim_threshold); + } + if(sas.top_pad >= 0) { + as[l] = am_atom_put("tp", 2); + ts[l++] = erts_bld_uint(hpp, szp, (Uint) sas.top_pad); + } + break; + default: + break; + } + + tmp = erts_bld_2tup_list(hpp, szp, l, as, ts); + + } + + } + else { + Eterm atom = am_atom_put("e", 1); + Eterm term = am_false; + tmp = erts_bld_2tup_list(hpp, szp, 1, &atom, &term); + } + + terms[length++] = tmp; + + } + +#if HAVE_ERTS_MSEG + if (use_mseg) { + atoms[length] = am_atom_put("mseg_alloc", 10); + terms[length++] = erts_mseg_info_options(NULL, NULL, hpp, szp); + } +#endif + + atoms[length] = am_atom_put("alloc_util", 10); + terms[length++] = erts_alcu_au_info_options(NULL, NULL, hpp, szp); + + { + Eterm o[3], v[3]; + o[0] = am_atom_put("m", 1); + v[0] = erts_instr_memory_map ? am_true : am_false; + o[1] = am_atom_put("s", 1); + v[1] = erts_instr_stat ? am_true : am_false; + o[2] = am_atom_put("t", 1); + v[2] = erts_mtrace_enabled ? am_true : am_false; + + atoms[length] = am_atom_put("instr", 5); + terms[length++] = erts_bld_2tup_list(hpp, szp, 3, o, v); + } + + settings = erts_bld_2tup_list(hpp, szp, length, atoms, terms); + + length = 0; + + for (a = ERTS_ALC_A_MIN; a <= ERTS_ALC_A_MAX; a++) { + if (erts_allctrs_info[a].enabled) { + terms[length++] = am_atom_put((char *) ERTS_ALC_A2AD(a), + strlen(ERTS_ALC_A2AD(a))); + } + } + +#if HAVE_ERTS_MSEG + if (use_mseg) + terms[length++] = am_atom_put("mseg_alloc", 10); +#endif + + features = length ? erts_bld_list(hpp, szp, length, terms) : NIL; + +#if defined(ELIB_ALLOC_IS_CLIB) + { + Eterm version; + int i; + int ver[5]; + i = sscanf(ERLANG_VERSION, + "%d.%d.%d.%d.%d", + &ver[0], &ver[1], &ver[2], &ver[3], &ver[4]); + + version = NIL; + for(i--; i >= 0; i--) + version = erts_bld_cons(hpp, szp, make_small(ver[i]), version); + + res = erts_bld_tuple(hpp, szp, 4, + am_elib_malloc, version, features, settings); + } +#elif defined(__GLIBC__) + { + Eterm AM_glibc = am_atom_put("glibc", 5); + Eterm version; + + version = erts_bld_cons(hpp, + szp, + make_small(__GLIBC__), +#ifdef __GLIBC_MINOR__ + erts_bld_cons(hpp, + szp, + make_small(__GLIBC_MINOR__), + NIL) +#else + NIL +#endif + ); + + res = erts_bld_tuple(hpp, szp, 4, + AM_glibc, version, features, settings); + } + +#else /* unknown allocator */ + + res = erts_bld_tuple(hpp, szp, 4, + am_undefined, NIL, features, settings); + +#endif + + if (szp) { + /* ... and then build the term */ + hp = HAlloc((Process *) proc, sz); + endp = hp + sz; + hpp = &hp; + szp = NULL; + goto bld_term; + } + + ASSERT(endp >= hp); + HRelease((Process *) proc, endp, hp); + + return res; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Deprecated functions * + * * + * These functions are still defined since "non-OTP linked in drivers" may * + * contain (illegal) calls to them. * +\* */ + +/* --- DO *NOT* USE THESE FUNCTIONS --- */ + +void *sys_alloc(Uint sz) +{ return erts_alloc_fnf(ERTS_ALC_T_UNDEF, sz); } +void *sys_realloc(void *ptr, Uint sz) +{ return erts_realloc_fnf(ERTS_ALC_T_UNDEF, ptr, sz); } +void sys_free(void *ptr) +{ erts_free(ERTS_ALC_T_UNDEF, ptr); } +void *safe_alloc(Uint sz) +{ return erts_alloc(ERTS_ALC_T_UNDEF, sz); } +void *safe_realloc(void *ptr, Uint sz) +{ return erts_realloc(ERTS_ALC_T_UNDEF, ptr, sz); } + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * NOTE: erts_alc_test() is only supposed to be used for testing. * + * * + * Keep alloc_SUITE_data/allocator_test.h updated if changes are made * + * to erts_alc_test() * +\* */ +#define ERTS_ALC_TEST_ABORT erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error\n") + +unsigned long erts_alc_test(unsigned long op, + unsigned long a1, + unsigned long a2, + unsigned long a3) +{ + switch (op >> 8) { + case 0x0: return erts_alcu_test(op, a1, a2); + case 0x1: return erts_gfalc_test(op, a1, a2); + case 0x2: return erts_bfalc_test(op, a1, a2); + case 0x3: return erts_afalc_test(op, a1, a2); + case 0x4: return erts_mseg_test(op, a1, a2, a3); + case 0xf: + switch (op) { + case 0xf00: +#ifdef USE_THREADS + if (((Allctr_t *) a1)->thread_safe) + return (unsigned long) erts_alcu_alloc_ts(ERTS_ALC_T_UNDEF, + (void *) a1, + (Uint) a2); + else +#endif + return (unsigned long) erts_alcu_alloc(ERTS_ALC_T_UNDEF, + (void *) a1, + (Uint) a2); + case 0xf01: +#ifdef USE_THREADS + if (((Allctr_t *) a1)->thread_safe) + return (unsigned long) erts_alcu_realloc_ts(ERTS_ALC_T_UNDEF, + (void *) a1, + (void *) a2, + (Uint) a3); + else +#endif + return (unsigned long) erts_alcu_realloc(ERTS_ALC_T_UNDEF, + (void *) a1, + (void *) a2, + (Uint) a3); + case 0xf02: +#ifdef USE_THREADS + if (((Allctr_t *) a1)->thread_safe) + erts_alcu_free_ts(ERTS_ALC_T_UNDEF, (void *) a1, (void *) a2); + else +#endif + erts_alcu_free(ERTS_ALC_T_UNDEF, (void *) a1, (void *) a2); + return 0; + case 0xf03: { + Allctr_t *allctr; + struct au_init init; + + SET_DEFAULT_ALLOC_OPTS(&init); + init.enable = 1; + init.atype = GOODFIT; + init.init.util.name_prefix = (char *) a1; + init.init.util.ts = a2 ? 1 : 0; + + if ((char **) a3) { + char **argv = (char **) a3; + int i = 0; + while (argv[i]) { + if (argv[i][0] == '-' && argv[i][1] == 't') + handle_au_arg(&init, &argv[i][2], argv, &i); + else + return (unsigned long) NULL; + i++; + } + } + + switch (init.atype) { + case GOODFIT: + allctr = erts_gfalc_start((GFAllctr_t *) + erts_alloc(ERTS_ALC_T_UNDEF, + sizeof(GFAllctr_t)), + &init.init.gf, + &init.init.util); + break; + case BESTFIT: + allctr = erts_bfalc_start((BFAllctr_t *) + erts_alloc(ERTS_ALC_T_UNDEF, + sizeof(BFAllctr_t)), + &init.init.bf, + &init.init.util); + break; + case AFIT: + allctr = erts_afalc_start((AFAllctr_t *) + erts_alloc(ERTS_ALC_T_UNDEF, + sizeof(AFAllctr_t)), + &init.init.af, + &init.init.util); + break; + default: + ASSERT(0); + allctr = NULL; + break; + } + + return (unsigned long) allctr; + } + case 0xf04: + erts_alcu_stop((Allctr_t *) a1); + erts_free(ERTS_ALC_T_UNDEF, (void *) a1); + break; +#ifdef USE_THREADS + case 0xf05: return (unsigned long) 1; + case 0xf06: return (unsigned long) ((Allctr_t *) a1)->thread_safe; +#ifdef ETHR_NO_FORKSAFETY + case 0xf07: return (unsigned long) 0; +#else + case 0xf07: return (unsigned long) ((Allctr_t *) a1)->thread_safe; +#endif + case 0xf08: { + ethr_mutex *mtx = erts_alloc(ERTS_ALC_T_UNDEF, sizeof(ethr_mutex)); + if (ethr_mutex_init(mtx) != 0) + ERTS_ALC_TEST_ABORT; + return (unsigned long) mtx; + } + case 0xf09: { + ethr_mutex *mtx = (ethr_mutex *) a1; + if (ethr_mutex_destroy(mtx) != 0) + ERTS_ALC_TEST_ABORT; + erts_free(ERTS_ALC_T_UNDEF, (void *) mtx); + break; + } + case 0xf0a: + if (ethr_mutex_lock((ethr_mutex *) a1) != 0) + ERTS_ALC_TEST_ABORT; + break; + case 0xf0b: + if (ethr_mutex_unlock((ethr_mutex *) a1) != 0) + ERTS_ALC_TEST_ABORT; + break; + case 0xf0c: { + ethr_cond *cnd = erts_alloc(ERTS_ALC_T_UNDEF, sizeof(ethr_cond)); + if (ethr_cond_init(cnd) != 0) + ERTS_ALC_TEST_ABORT; + return (unsigned long) cnd; + } + case 0xf0d: { + ethr_cond *cnd = (ethr_cond *) a1; + if (ethr_cond_destroy(cnd) != 0) + ERTS_ALC_TEST_ABORT; + erts_free(ERTS_ALC_T_UNDEF, (void *) cnd); + break; + } + case 0xf0e: + if (ethr_cond_broadcast((ethr_cond *) a1) != 0) + ERTS_ALC_TEST_ABORT; + break; + case 0xf0f: { + int res; + do { + res = ethr_cond_wait((ethr_cond *) a1, (ethr_mutex *) a2); + } while (res == EINTR); + if (res != 0) + ERTS_ALC_TEST_ABORT; + break; + } + case 0xf10: { + ethr_tid *tid = erts_alloc(ERTS_ALC_T_UNDEF, sizeof(ethr_tid)); +#ifdef ERTS_ENABLE_LOCK_COUNT + if (erts_lcnt_thr_create(tid, + (void * (*)(void *)) a1, + (void *) a2, + NULL) != 0) +#else + if (ethr_thr_create(tid, + (void * (*)(void *)) a1, + (void *) a2, + NULL) != 0) +#endif + ERTS_ALC_TEST_ABORT; + return (unsigned long) tid; + } + case 0xf11: { + ethr_tid *tid = (ethr_tid *) a1; + if (ethr_thr_join(*tid, NULL) != 0) + ERTS_ALC_TEST_ABORT; + erts_free(ERTS_ALC_T_UNDEF, (void *) tid); + break; + } + case 0xf12: + ethr_thr_exit((void *) a1); + ERTS_ALC_TEST_ABORT; + break; +#endif /* #ifdef USE_THREADS */ + default: + break; + } + return (unsigned long) 0; + default: + break; + } + + ASSERT(0); + return ~((unsigned long) 0); +} + +#ifdef DEBUG +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Debug stuff * +\* */ + +#if 0 +#define PRINT_OPS +#else +#undef PRINT_OPS +#endif + + +#define FENCE_SZ (3*sizeof(Uint)) + +#ifdef ARCH_64 +#define FENCE_PATTERN 0xABCDEF97ABCDEF97 +#else +#define FENCE_PATTERN 0xABCDEF97 +#endif + +#define TYPE_PATTERN_MASK ERTS_ALC_N_MASK +#define TYPE_PATTERN_SHIFT 16 + +#define FIXED_FENCE_PATTERN_MASK \ + (~((Uint) (TYPE_PATTERN_MASK << TYPE_PATTERN_SHIFT))) +#define FIXED_FENCE_PATTERN \ + (FENCE_PATTERN & FIXED_FENCE_PATTERN_MASK) + +#define MK_PATTERN(T) \ + (FIXED_FENCE_PATTERN | (((T) & TYPE_PATTERN_MASK) << TYPE_PATTERN_SHIFT)) + +#define GET_TYPE_OF_PATTERN(P) \ + (((P) >> TYPE_PATTERN_SHIFT) & TYPE_PATTERN_MASK) + + +static void * +set_memory_fence(void *ptr, Uint sz, ErtsAlcType_t n) +{ + Uint *ui_ptr; + Uint pattern; + + if (!ptr) + return NULL; + + ui_ptr = (Uint *) ptr; + pattern = MK_PATTERN(n); + + *(ui_ptr++) = sz; + *(ui_ptr++) = pattern; + memcpy((void *) (((char *) ui_ptr)+sz), (void *) &pattern, sizeof(Uint)); + + return (void *) ui_ptr; +} + +static void * +check_memory_fence(void *ptr, Uint *size, ErtsAlcType_t n, int func) +{ + Uint sz; + Uint found_type; + Uint pre_pattern; + Uint post_pattern; + Uint *ui_ptr; + + if (!ptr) + return NULL; + + ui_ptr = (Uint *) ptr; + pre_pattern = *(--ui_ptr); + *size = sz = *(--ui_ptr); + + found_type = GET_TYPE_OF_PATTERN(pre_pattern); + if (pre_pattern != MK_PATTERN(n)) { + if ((FIXED_FENCE_PATTERN_MASK & pre_pattern) != FIXED_FENCE_PATTERN) + erl_exit(ERTS_ABORT_EXIT, + "ERROR: Fence at beginning of memory block (p=0x%u) " + "clobbered.\n", + (unsigned long) ptr); + } + + memcpy((void *) &post_pattern, (void *) (((char *)ptr)+sz), sizeof(Uint)); + + if (post_pattern != MK_PATTERN(n) + || pre_pattern != post_pattern) { + char fbuf[10]; + char obuf[10]; + char *ftype; + char *otype; + char *op_str; + + if ((FIXED_FENCE_PATTERN_MASK & post_pattern) != FIXED_FENCE_PATTERN) + erl_exit(ERTS_ABORT_EXIT, + "ERROR: Fence at end of memory block (p=0x%u, sz=%u) " + "clobbered.\n", + (unsigned long) ptr, (unsigned long) sz); + if (found_type != GET_TYPE_OF_PATTERN(post_pattern)) + erl_exit(ERTS_ABORT_EXIT, + "ERROR: Fence around memory block (p=0x%u, sz=%u) " + "clobbered.\n", + (unsigned long) ptr, (unsigned long) sz); + + ftype = type_no_str(found_type); + if (!ftype) { + sprintf(fbuf, "%d", (int) found_type); + ftype = fbuf; + } + otype = type_no_str(n); + if (!otype) { + sprintf(obuf, "%d", (int) n); + otype = obuf; + } + + switch (func) { + case ERTS_ALC_O_ALLOC: op_str = "allocated"; break; + case ERTS_ALC_O_REALLOC: op_str = "reallocated"; break; + case ERTS_ALC_O_FREE: op_str = "freed"; break; + default: op_str = "???"; break; + } + + erl_exit(ERTS_ABORT_EXIT, + "ERROR: Memory block (p=0x%u, sz=%u) allocated as type \"%s\"," + " but %s as type \"%s\".\n", + (unsigned long) ptr, (unsigned long) sz, ftype, op_str, otype); + } + + return (void *) ui_ptr; +} + +static ErtsAllocatorFunctions_t real_allctrs[ERTS_ALC_A_MAX+1]; + +static void * +debug_alloc(ErtsAlcType_t n, void *extra, Uint size) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + Uint dsize; + void *res; + + ASSERT(ERTS_ALC_N_MIN <= n && n <= ERTS_ALC_N_MAX); + dsize = size + FENCE_SZ; + res = (*real_af->alloc)(n, real_af->extra, dsize); + + res = set_memory_fence(res, size, n); + +#ifdef PRINT_OPS + fprintf(stderr, "0x%lx = alloc(%s, %lu)\r\n", + (Uint) res, ERTS_ALC_N2TD(n), size); +#endif + + return res; +} + + +static void * +debug_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + Uint dsize; + Uint old_size; + void *dptr; + void *res; + + ASSERT(ERTS_ALC_N_MIN <= n && n <= ERTS_ALC_N_MAX); + + dsize = size + FENCE_SZ; + dptr = check_memory_fence(ptr, &old_size, n, ERTS_ALC_O_REALLOC); + + if (old_size > size) + sys_memset((void *) (((char *) ptr) + size), + 0xf, + sizeof(Uint) + old_size - size); + + res = (*real_af->realloc)(n, real_af->extra, dptr, dsize); + + res = set_memory_fence(res, size, n); + +#ifdef PRINT_OPS + fprintf(stderr, "0x%lx = realloc(%s, 0x%lx, %lu)\r\n", + (Uint) res, ERTS_ALC_N2TD(n), (Uint) ptr, size); +#endif + + return res; +} + +static void +debug_free(ErtsAlcType_t n, void *extra, void *ptr) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + void *dptr; + Uint size; + + ASSERT(ERTS_ALC_N_MIN <= n && n <= ERTS_ALC_N_MAX); + + dptr = check_memory_fence(ptr, &size, n, ERTS_ALC_O_FREE); + + sys_memset((void *) dptr, n, size + FENCE_SZ); + + (*real_af->free)(n, real_af->extra, dptr); + +#ifdef PRINT_OPS + fprintf(stderr, "free(%s, 0x%lx)\r\n", ERTS_ALC_N2TD(n), (Uint) ptr); +#endif + +} + +static Uint +install_debug_functions(void) +{ + int i; + ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); + + sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs)); + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + erts_allctrs[i].alloc = debug_alloc; + erts_allctrs[i].realloc = debug_realloc; + erts_allctrs[i].free = debug_free; + erts_allctrs[i].extra = (void *) &real_allctrs[i]; + } + return FENCE_SZ; +} + + + +#endif /* #ifdef DEBUG */ diff --git a/erts/emulator/beam/erl_alloc.h b/erts/emulator/beam/erl_alloc.h new file mode 100644 index 0000000000..e7a203002f --- /dev/null +++ b/erts/emulator/beam/erl_alloc.h @@ -0,0 +1,564 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_ALLOC_H__ +#define ERL_ALLOC_H__ + +#include "erl_alloc_types.h" +#include "erl_alloc_util.h" +#ifdef USE_THREADS +#include "erl_threads.h" +#endif + +#ifdef DEBUG +# undef ERTS_ALC_WANT_INLINE +# define ERTS_ALC_WANT_INLINE 0 +#endif + +#ifndef ERTS_ALC_WANT_INLINE +# define ERTS_ALC_WANT_INLINE 1 +#endif + +#if ERTS_CAN_INLINE && ERTS_ALC_WANT_INLINE +# define ERTS_ALC_DO_INLINE 1 +# define ERTS_ALC_INLINE static ERTS_INLINE +#else +# define ERTS_ALC_DO_INLINE 0 +# define ERTS_ALC_INLINE +#endif + +#define ERTS_FIX_CORE_ALLOCATOR ERTS_ALC_A_LONG_LIVED +extern ErtsAlcType_t erts_fix_core_allocator_ix; + +typedef struct { + Uint total; + Uint used; +} ErtsFixInfo; + +void erts_sys_alloc_init(void); +void *erts_sys_alloc(ErtsAlcType_t, void *, Uint); +void *erts_sys_realloc(ErtsAlcType_t, void *, void *, Uint); +void erts_sys_free(ErtsAlcType_t, void *, void *); + + +void erts_init_fix_alloc(Uint, void *(*)(Uint)); +Uint erts_get_fix_size(ErtsAlcType_t); +void erts_set_fix_size(ErtsAlcType_t, Uint); +void erts_fix_info(ErtsAlcType_t, ErtsFixInfo *); +void *erts_fix_alloc(ErtsAlcType_t, void *, Uint); +void *erts_fix_realloc(ErtsAlcType_t, void *, void*, Uint); +void erts_fix_free(ErtsAlcType_t, void *, void*); + + +Eterm erts_memory(int *, void *, void *, Eterm); +Eterm erts_allocated_areas(int *, void *, void *); + +Eterm erts_alloc_util_allocators(void *proc); +void erts_allocator_info(int, void *); +Eterm erts_allocator_info_term(void *proc, Eterm which_alloc, int only_sz); +Eterm erts_allocator_options(void *proc); + +#define ERTS_ALLOC_INIT_DEF_OPTS_INITER {0} +typedef struct { + int dummy; +} ErtsAllocInitOpts; + +void erts_alloc_init(int *argc, char **argv, ErtsAllocInitOpts *eaiop); + +#if defined(GET_ERTS_ALC_TEST) || defined(ERTS_ALC_INTERNAL__) +/* Only for testing */ +unsigned long erts_alc_test(unsigned long, + unsigned long, + unsigned long, + unsigned long); +#endif + +#define ERTS_ALC_O_ALLOC 0 +#define ERTS_ALC_O_REALLOC 1 +#define ERTS_ALC_O_FREE 2 + +#define ERTS_ALC_E_NOTSUP 0 +#define ERTS_ALC_E_NOMEM 1 +#define ERTS_ALC_E_NOALLCTR 2 + +#define ERTS_ALC_MIN_LONG_LIVED_TIME (10*60*1000) + +typedef struct { + int alloc_util; + int enabled; + int thr_spec; + void *extra; +} ErtsAllocatorInfo_t; + +typedef struct { + void * (*alloc) (ErtsAlcType_t, void *, Uint); + void * (*realloc) (ErtsAlcType_t, void *, void *, Uint); + void (*free) (ErtsAlcType_t, void *, void *); + void *extra; +} ErtsAllocatorFunctions_t; + +extern ErtsAllocatorFunctions_t erts_allctrs[ERTS_ALC_A_MAX+1]; +extern ErtsAllocatorInfo_t erts_allctrs_info[ERTS_ALC_A_MAX+1]; + +typedef struct { + int enabled; + int all_thr_safe; + int size; + Allctr_t **allctr; +} ErtsAllocatorThrSpec_t; + +extern ErtsAllocatorThrSpec_t erts_allctr_thr_spec[ERTS_ALC_A_MAX+1]; + +int erts_alc_get_thr_ix(void); +void erts_alloc_reg_scheduler_id(Uint id); + +__decl_noreturn void erts_alloc_enomem(ErtsAlcType_t,Uint) + __noreturn; +__decl_noreturn void erts_alloc_n_enomem(ErtsAlcType_t,Uint) + __noreturn; +__decl_noreturn void erts_realloc_enomem(ErtsAlcType_t,void*,Uint) + __noreturn; +__decl_noreturn void erts_realloc_n_enomem(ErtsAlcType_t,void*,Uint) + __noreturn; +__decl_noreturn void erts_alc_fatal_error(int,int,ErtsAlcType_t,...) + __noreturn; + +/* --- DO *NOT* USE THESE DEPRECATED FUNCTIONS --- Instead use: */ +void *safe_alloc(Uint) __deprecated; /* erts_alloc() */ +void *safe_realloc(void *, Uint) __deprecated; /* erts_realloc() */ +void sys_free(void *) __deprecated; /* erts_free() */ +void *sys_alloc(Uint ) __deprecated; /* erts_alloc_fnf() */ +void *sys_realloc(void *, Uint) __deprecated; /* erts_realloc_fnf() */ + +/* + * erts_alloc[_fnf](), erts_realloc[_fnf](), erts_free() works as + * malloc(), realloc(), and free() with the following exceptions: + * + * * They take an extra type argument as first argument which is + * the memory type to operate on. Memory types are generated + * (as ERTS_ALC_T_[SOMETHING] defines) from the erl_alloc.types + * configuration file. + * * The erts_alloc() and erts_realloc() functions terminate the + * emulator if memory cannot be obtained. The _fnf (Failure Not + * Fatal) suffixed versions return NULL if memory cannot be + * obtained. + * * They may be static functions so function pointers to "the same" + * function may differ. + * + * IMPORTANT: Memory allocated or reallocated as type X, can only + * be reallocated or deallocated as type X. + */ + +#if !ERTS_ALC_DO_INLINE + +void *erts_alloc(ErtsAlcType_t type, Uint size); +void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size); +void erts_free(ErtsAlcType_t type, void *ptr); +void *erts_alloc_fnf(ErtsAlcType_t type, Uint size); +void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size); + +#endif /* #if !ERTS_ALC_DO_INLINE */ + +#if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) + +ERTS_ALC_INLINE +void *erts_alloc(ErtsAlcType_t type, Uint size) +{ + void *res; + res = (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( + ERTS_ALC_T2N(type), + erts_allctrs[ERTS_ALC_T2A(type)].extra, + size); + if (!res) + erts_alloc_n_enomem(ERTS_ALC_T2N(type), size); + return res; +} + +ERTS_ALC_INLINE +void *erts_realloc(ErtsAlcType_t type, void *ptr, Uint size) +{ + void *res; + res = (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( + ERTS_ALC_T2N(type), + erts_allctrs[ERTS_ALC_T2A(type)].extra, + ptr, + size); + if (!res) + erts_realloc_n_enomem(ERTS_ALC_T2N(type), ptr, size); + return res; +} + +ERTS_ALC_INLINE +void erts_free(ErtsAlcType_t type, void *ptr) +{ + (*erts_allctrs[ERTS_ALC_T2A(type)].free)( + ERTS_ALC_T2N(type), + erts_allctrs[ERTS_ALC_T2A(type)].extra, + ptr); +} + + +ERTS_ALC_INLINE +void *erts_alloc_fnf(ErtsAlcType_t type, Uint size) +{ + return (*erts_allctrs[ERTS_ALC_T2A(type)].alloc)( + ERTS_ALC_T2N(type), + erts_allctrs[ERTS_ALC_T2A(type)].extra, + size); +} + + +ERTS_ALC_INLINE +void *erts_realloc_fnf(ErtsAlcType_t type, void *ptr, Uint size) +{ + return (*erts_allctrs[ERTS_ALC_T2A(type)].realloc)( + ERTS_ALC_T2N(type), + erts_allctrs[ERTS_ALC_T2A(type)].extra, + ptr, + size); +} + +#endif /* #if ERTS_ALC_DO_INLINE || defined(ERTS_ALC_INTERNAL__) */ + +#ifndef ERTS_CACHE_LINE_SIZE +/* Assume a cache line size of 64 bytes */ +# define ERTS_CACHE_LINE_SIZE ((Uint) 64) +# define ERTS_CACHE_LINE_MASK (ERTS_CACHE_LINE_SIZE - 1) +#endif + +#define ERTS_ALC_CACHE_LINE_ALIGN_SIZE(SZ) \ + (((((SZ) - 1) / ERTS_CACHE_LINE_SIZE) + 1) * ERTS_CACHE_LINE_SIZE) + +#define ERTS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ +ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \ + (void) 0, (void) 0, (void) 0) + +#define ERTS_SMP_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ +static erts_smp_spinlock_t NAME##_lck; \ +ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \ + erts_smp_spinlock_init(&NAME##_lck, #NAME "_alloc_lock"),\ + erts_smp_spin_lock(&NAME##_lck), \ + erts_smp_spin_unlock(&NAME##_lck)) + +#ifdef ERTS_SMP + +#define ERTS_TS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ +ERTS_SMP_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) + +#else /* !ERTS_SMP */ + +#define ERTS_TS_QUALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ +static erts_mtx_t NAME##_lck; \ +ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, \ + erts_mtx_init(NAME##_lck, #NAME "_alloc_lock"), \ + erts_mtx_lock(&NAME##_lck), \ + erts_mtx_unlock(&NAME##_lck)) + + +#endif + +#define ERTS_PALLOC_IMPL(NAME, TYPE, PASZ) \ +ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, (void) 0, (void) 0, (void) 0) + +#define ERTS_TS_PALLOC_IMPL(NAME, TYPE, PASZ) \ +static erts_spinlock_t NAME##_lck; \ +ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, \ + erts_spinlock_init(&NAME##_lck, #NAME "_alloc_lock"),\ + erts_spin_lock(&NAME##_lck), \ + erts_spin_unlock(&NAME##_lck)) + +#ifdef ERTS_SMP + +#define ERTS_SMP_PALLOC_IMPL(NAME, TYPE, PASZ) \ + ERTS_TS_PALLOC_IMPL(NAME, TYPE, PASZ) + +#else /* !ERTS_SMP */ + +#define ERTS_SMP_PALLOC_IMPL(NAME, TYPE, PASZ) \ + ERTS_PALLOC_IMPL(NAME, TYPE, PASZ) + +#endif + +#define ERTS_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT, ILCK, LCK, ULCK) \ +ERTS_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ, ILCK, LCK, ULCK) \ +static void \ +init_##NAME##_alloc(void) \ +{ \ + init_##NAME##_pre_alloc(); \ +} \ +static ERTS_INLINE TYPE * \ +NAME##_alloc(void) \ +{ \ + TYPE *res = NAME##_pre_alloc(); \ + if (!res) \ + res = erts_alloc(ALCT, sizeof(TYPE)); \ + return res; \ +} \ +static ERTS_INLINE void \ +NAME##_free(TYPE *p) \ +{ \ + if (!NAME##_pre_free(p)) \ + erts_free(ALCT, (void *) p); \ +} + +#ifdef ERTS_SMP +#define ERTS_SCHED_PREF_PALLOC_IMPL(NAME, TYPE, PASZ) \ + ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME, TYPE, PASZ) +#else +#define ERTS_SCHED_PREF_PALLOC_IMPL(NAME, TYPE, PASZ) \ + ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, (void) 0, (void) 0, (void) 0) +#endif + +#ifdef ERTS_SMP +#define ERTS_SCHED_PREF_AUX(NAME, TYPE, PASZ) \ +ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ) +#else +#define ERTS_SCHED_PREF_AUX(NAME, TYPE, PASZ) \ +ERTS_PRE_ALLOC_IMPL(NAME##_pre, TYPE, PASZ, (void) 0, (void) 0, (void) 0) +#endif + +#define ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(NAME, TYPE, PASZ, ALCT) \ +ERTS_SCHED_PREF_AUX(NAME, TYPE, PASZ) \ +static void \ +init_##NAME##_alloc(void) \ +{ \ + init_##NAME##_pre_alloc(); \ +} \ +static ERTS_INLINE TYPE * \ +NAME##_alloc(void) \ +{ \ + TYPE *res = NAME##_pre_alloc(); \ + if (!res) \ + res = erts_alloc(ALCT, sizeof(TYPE)); \ + return res; \ +} \ +static ERTS_INLINE void \ +NAME##_free(TYPE *p) \ +{ \ + if (!NAME##_pre_free(p)) \ + erts_free(ALCT, (void *) p); \ +} + +#ifdef DEBUG +#define ERTS_PRE_ALLOC_SIZE(SZ) 2 +#define ERTS_PRE_ALLOC_CLOBBER(P, T) memset((void *) (P), 0xfd, sizeof(T)) +#else +#define ERTS_PRE_ALLOC_SIZE(SZ) ((SZ) > 1 ? (SZ) : 1) +#define ERTS_PRE_ALLOC_CLOBBER(P, T) +#endif + +#define ERTS_PRE_ALLOC_IMPL(NAME, TYPE, PASZ, ILCK, LCK, ULCK) \ +union erts_qa_##NAME##__ { \ + TYPE type; \ + union erts_qa_##NAME##__ *next; \ +}; \ +static union erts_qa_##NAME##__ \ + qa_prealcd_##NAME[ERTS_PRE_ALLOC_SIZE((PASZ))]; \ +static union erts_qa_##NAME##__ *qa_freelist_##NAME; \ +static void \ +init_##NAME##_alloc(void) \ +{ \ + int i; \ + qa_freelist_##NAME = &qa_prealcd_##NAME[0]; \ + for (i = 1; i < ERTS_PRE_ALLOC_SIZE((PASZ)); i++) { \ + ERTS_PRE_ALLOC_CLOBBER(&qa_prealcd_##NAME[i-1], \ + union erts_qa_##NAME##__); \ + qa_prealcd_##NAME[i-1].next = &qa_prealcd_##NAME[i]; \ + } \ + ERTS_PRE_ALLOC_CLOBBER(&qa_prealcd_##NAME[ERTS_PRE_ALLOC_SIZE((PASZ))-1],\ + union erts_qa_##NAME##__); \ + qa_prealcd_##NAME[ERTS_PRE_ALLOC_SIZE((PASZ))-1].next = NULL; \ + ILCK; \ +} \ +static ERTS_INLINE TYPE * \ +NAME##_alloc(void) \ +{ \ + TYPE *res; \ + LCK; \ + if (!qa_freelist_##NAME) \ + res = NULL; \ + else { \ + res = &qa_freelist_##NAME->type; \ + qa_freelist_##NAME = qa_freelist_##NAME->next; \ + } \ + ULCK; \ + return res; \ +} \ +static ERTS_INLINE int \ +NAME##_free(TYPE *p) \ +{ \ + union erts_qa_##NAME##__ * up; \ + up = ((union erts_qa_##NAME##__ *) \ + (((char *) p) \ + - ((char *) &((union erts_qa_##NAME##__ *) 0)->type))); \ + if (up > &qa_prealcd_##NAME[ERTS_PRE_ALLOC_SIZE((PASZ))-1] \ + || up < &qa_prealcd_##NAME[0]) \ + return 0; \ + else { \ + LCK; \ + ERTS_PRE_ALLOC_CLOBBER(up, union erts_qa_##NAME##__); \ + up->next = qa_freelist_##NAME; \ + qa_freelist_##NAME = up; \ + ULCK; \ + return 1; \ + } \ +} + +typedef struct { + void *start; + void *end; + int chunks_mem_size; +} erts_sched_pref_quick_alloc_data_t; + +#ifdef DEBUG +#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P) \ +do { \ + ASSERT((void *) (C) < (void *) (P)); \ + ASSERT((void *) (P) \ + < (void *) (((char *) (C)) + (A)->chunks_mem_size)); \ +} while (0) +#else +#define ERTS_SPPA_DBG_CHK_IN_CHNK(A, C, P) +#endif + +#define ERTS_SCHED_PREF_PRE_ALLOC_IMPL(NAME, TYPE, PASZ) \ +union erts_qa_##NAME##__ { \ + TYPE type; \ + union erts_qa_##NAME##__ *next; \ +}; \ +typedef struct { \ + erts_smp_spinlock_t lock; \ + union erts_qa_##NAME##__ *freelist; \ + union erts_qa_##NAME##__ pre_alloced[1]; \ +} erts_qa_##NAME##_chunk__; \ +static erts_sched_pref_quick_alloc_data_t *qa_data_##NAME##__; \ +static ERTS_INLINE erts_qa_##NAME##_chunk__ * \ +get_##NAME##_chunk_ix(int cix) \ +{ \ + char *ptr = (char *) qa_data_##NAME##__->start; \ + ptr += cix*qa_data_##NAME##__->chunks_mem_size; \ + return (erts_qa_##NAME##_chunk__ *) ptr; \ +} \ +static ERTS_INLINE erts_qa_##NAME##_chunk__ * \ +get_##NAME##_chunk_ptr(void *ptr) \ +{ \ + int cix; \ + size_t diff; \ + if (ptr < qa_data_##NAME##__->start || qa_data_##NAME##__->end <= ptr)\ + return NULL; \ + diff = ((char *) ptr) - ((char *) qa_data_##NAME##__->start); \ + cix = diff / qa_data_##NAME##__->chunks_mem_size; \ + return get_##NAME##_chunk_ix(cix); \ +} \ +static void \ +init_##NAME##_alloc(void) \ +{ \ + size_t tot_size; \ + size_t chunk_mem_size; \ + char *chunk_start; \ + int cix; \ + int no_blocks = ERTS_PRE_ALLOC_SIZE((PASZ)); \ + int no_blocks_per_chunk = 2*((no_blocks-1)/erts_no_schedulers + 1); \ + no_blocks = no_blocks_per_chunk * erts_no_schedulers; \ + chunk_mem_size = sizeof(erts_qa_##NAME##_chunk__); \ + chunk_mem_size += (sizeof(union erts_qa_##NAME##__) \ + * (no_blocks_per_chunk - 1)); \ + chunk_mem_size = ERTS_ALC_CACHE_LINE_ALIGN_SIZE(chunk_mem_size); \ + tot_size = sizeof(erts_sched_pref_quick_alloc_data_t); \ + tot_size += ERTS_CACHE_LINE_SIZE - 1; \ + tot_size += chunk_mem_size*erts_no_schedulers; \ + qa_data_##NAME##__ = erts_alloc(ERTS_ALC_T_PRE_ALLOC_DATA,tot_size);\ + chunk_start = (((char *) qa_data_##NAME##__) \ + + sizeof(erts_sched_pref_quick_alloc_data_t)); \ + if ((((Uint) chunk_start) & ERTS_CACHE_LINE_MASK) != ((Uint) 0)) \ + chunk_start = ((char *) \ + ((((Uint) chunk_start) & ~ERTS_CACHE_LINE_MASK) \ + + ERTS_CACHE_LINE_SIZE)); \ + qa_data_##NAME##__->chunks_mem_size = chunk_mem_size; \ + qa_data_##NAME##__->start = (void *) chunk_start; \ + qa_data_##NAME##__->end = (chunk_start \ + + chunk_mem_size*erts_no_schedulers); \ + for (cix = 0; cix < erts_no_schedulers; cix++) { \ + int i; \ + erts_qa_##NAME##_chunk__ *chunk = get_##NAME##_chunk_ix(cix); \ + erts_smp_spinlock_init(&chunk->lock, #NAME "_alloc_lock"); \ + chunk->freelist = &chunk->pre_alloced[0]; \ + for (i = 1; i < no_blocks_per_chunk; i++) { \ + ERTS_PRE_ALLOC_CLOBBER(&chunk->pre_alloced[i-1], \ + union erts_qa_##NAME##__); \ + chunk->pre_alloced[i-1].next = &chunk->pre_alloced[i]; \ + } \ + ERTS_PRE_ALLOC_CLOBBER(&chunk->pre_alloced[no_blocks_per_chunk-1],\ + union erts_qa_##NAME##__); \ + chunk->pre_alloced[no_blocks_per_chunk-1].next = NULL; \ + } \ +} \ +static ERTS_INLINE TYPE * \ +NAME##_alloc(void) \ +{ \ + int cix = ((int) erts_get_scheduler_id()) - 1; \ + TYPE *res; \ + if (cix < 0) \ + res = NULL; \ + else { \ + erts_qa_##NAME##_chunk__ *chunk = get_##NAME##_chunk_ix(cix); \ + erts_smp_spin_lock(&chunk->lock); \ + if (!chunk->freelist) \ + res = NULL; \ + else { \ + res = &chunk->freelist->type; \ + chunk->freelist = chunk->freelist->next; \ + ERTS_SPPA_DBG_CHK_IN_CHNK(qa_data_##NAME##__, chunk, res); \ + } \ + erts_smp_spin_unlock(&chunk->lock); \ + } \ + return res; \ +} \ +static ERTS_INLINE int \ +NAME##_free(TYPE *p) \ +{ \ + erts_qa_##NAME##_chunk__ *chunk; \ + chunk = get_##NAME##_chunk_ptr((void *) p); \ + if (!chunk) \ + return 0; \ + else { \ + union erts_qa_##NAME##__ *up; \ + ERTS_SPPA_DBG_CHK_IN_CHNK(qa_data_##NAME##__, chunk, p); \ + up = ((union erts_qa_##NAME##__ *) \ + (((char *) p) \ + - ((char *) &((union erts_qa_##NAME##__ *) 0)->type))); \ + erts_smp_spin_lock(&chunk->lock); \ + ERTS_PRE_ALLOC_CLOBBER(up, union erts_qa_##NAME##__); \ + up->next = chunk->freelist; \ + chunk->freelist = up; \ + erts_smp_spin_unlock(&chunk->lock); \ + return 1; \ + } \ +} + +#ifdef DEBUG +#define ERTS_ALC_DBG_BLK_SZ(PTR) (*(((Uint *) (PTR)) - 2)) +#endif /* #ifdef DEBUG */ + +#undef ERTS_ALC_INLINE +#undef ERTS_ALC_ATTRIBUTES + +#endif /* #ifndef ERL_ALLOC_H__ */ + + diff --git a/erts/emulator/beam/erl_alloc.types b/erts/emulator/beam/erl_alloc.types new file mode 100644 index 0000000000..f701f71c7d --- /dev/null +++ b/erts/emulator/beam/erl_alloc.types @@ -0,0 +1,383 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# Rules: +# * Types, allocators, and classes can be declared. +# * Types, allocators, classes, and descriptions can only contain +# alphanumeric characters. +# * Allocators and classes have to be declared before they are used in +# type declarations. +# * Descriptions have only one name space (i.e. class descriptions, +# allocator descriptions, and type descriptions are all in the same +# name space). +# * Types, allocators, classes, and descriptions have different name +# spaces. +# * The type, allocator, and class names INVALID are reserved and can +# not be used. +# * The descriptions invalid_allocator, invalid_class, and invalid_type +# are reserved and can not be used. +# * Declarations can be done conditionally by use of a +# +if +# +# +else +# +# +endif +# or a +# +ifnot +# +# +else +# +# +endif +# construct (else branches are optional). The boolean variable X is +# true after a "+enable X" statement or if it has been passed as a +# command line argument to make_alloc_types. The variable X is false +# after a "+disable X" statement or if it has never been mentioned. + + +# --- Allocator declarations ------------------------------------------------- +# +# If, and only if, the same thread performes *all* allocations, +# reallocations and deallocations of all memory types that are handled +# by a specific allocator ( in type declaration), set +# for this specific allocator to false; otherwise, set +# it to true. +# +# Syntax: allocator +# +# + +allocator SYSTEM true sys_alloc + ++if smp + +allocator TEMPORARY true temp_alloc +allocator SHORT_LIVED true sl_alloc +allocator STANDARD true std_alloc +allocator LONG_LIVED true ll_alloc +allocator EHEAP true eheap_alloc +allocator ETS true ets_alloc +allocator FIXED_SIZE true fix_alloc + ++else # Non smp build + +allocator TEMPORARY false temp_alloc +allocator SHORT_LIVED false sl_alloc +allocator STANDARD false std_alloc +allocator LONG_LIVED false ll_alloc +allocator EHEAP false eheap_alloc +allocator ETS false ets_alloc +allocator FIXED_SIZE false fix_alloc + ++endif + +allocator BINARY true binary_alloc +allocator DRIVER true driver_alloc + + +# --- Class declarations ----------------------------------------------------- +# +# Syntax: class +# +# + +class PROCESSES process_data +class ATOM atom_data +class CODE code_data +class ETS ets_data +class BINARIES binary_data +class SYSTEM system_data + +# --- Type declarations ------------------------------------------------------ +# +# Syntax: type +# +# Use ERTS_ALC_T_ as first parameter to erts_alloc(), erts_alloc_fnf(), +# erts_realloc(), erts_realloc_fnf() or erts_free() in order to allocate, +# reallocate or deallocate a memory block of type . +# +# NOTE: Only use temp_alloc for memory types that *really* are *temporarily* +# allocated. A good thumb rule: all memory allocated by temp_alloc +# should be deallocated before the emulator starts executing Erlang +# code again. +# +# NOTE: When adding or removing a type which uses the FIXED_SIZE allocator, +# also add or remove initialization of the type in erts_alloc_init() +# (erl_alloc.c). +# +# + +type PROC FIXED_SIZE PROCESSES proc +type ATOM FIXED_SIZE ATOM atom_entry +type EXPORT FIXED_SIZE CODE export_entry +type MODULE FIXED_SIZE CODE module_entry +type REG_PROC FIXED_SIZE PROCESSES reg_proc +type LINK_LH STANDARD PROCESSES link_lh +type MONITOR_SH FIXED_SIZE PROCESSES monitor_sh +type MONITOR_LH STANDARD PROCESSES monitor_lh +type NLINK_SH FIXED_SIZE PROCESSES nlink_sh +type NLINK_LH STANDARD PROCESSES nlink_lh +type SUSPEND_MON STANDARD PROCESSES suspend_monitor +type PEND_SUSPEND SHORT_LIVED PROCESSES pending_suspend +type PROC_LIST SHORT_LIVED PROCESSES proc_list +type FUN_ENTRY FIXED_SIZE CODE fun_entry +type ATOM_TXT LONG_LIVED ATOM atom_text +type HEAP EHEAP PROCESSES heap +type OLD_HEAP EHEAP PROCESSES old_heap +type HEAP_FRAG EHEAP PROCESSES heap_frag +type TMP_HEAP TEMPORARY PROCESSES tmp_heap +type MSG_REF SHORT_LIVED PROCESSES msg_ref +type MSG_ROOTS TEMPORARY PROCESSES msg_roots +type ROOTSET TEMPORARY PROCESSES root_set +type LOADER_TMP TEMPORARY CODE loader_tmp +type BIF_TIMER_TABLE LONG_LIVED SYSTEM bif_timer_table +type SL_BIF_TIMER SHORT_LIVED PROCESSES bif_timer_sl +type LL_BIF_TIMER STANDARD PROCESSES bif_timer_ll +type REG_TABLE STANDARD SYSTEM reg_tab +type FUN_TABLE STANDARD CODE fun_tab +type DIST_TABLE STANDARD SYSTEM dist_tab +type NODE_TABLE STANDARD SYSTEM node_tab +type ATOM_TABLE LONG_LIVED ATOM atom_tab +type EXPORT_TABLE LONG_LIVED CODE export_tab +type MODULE_TABLE LONG_LIVED CODE module_tab +type TAINT LONG_LIVED CODE taint_list +type MODULE_REFS STANDARD CODE module_refs +type NC_TMP TEMPORARY SYSTEM nc_tmp +type TMP TEMPORARY SYSTEM tmp +type UNDEF SYSTEM SYSTEM undefined +type DCACHE STANDARD SYSTEM dcache +type DCTRL_BUF TEMPORARY SYSTEM dctrl_buf +type DIST_ENTRY STANDARD SYSTEM dist_entry +type NODE_ENTRY STANDARD SYSTEM node_entry +type PROC_TABLE LONG_LIVED PROCESSES proc_tab +type PORT_TABLE LONG_LIVED SYSTEM port_tab +type TIMER_WHEEL LONG_LIVED SYSTEM timer_wheel +type DRV DRIVER SYSTEM drv_internal +type DRV_BINARY BINARY BINARIES drv_binary +type DRIVER STANDARD SYSTEM driver +type NIF DRIVER SYSTEM nif_internal +type BINARY BINARY BINARIES binary +type NBIF_TABLE SYSTEM SYSTEM nbif_tab +type CODE LONG_LIVED CODE code +type ARG_REG STANDARD PROCESSES arg_reg +type PROC_DICT STANDARD PROCESSES proc_dict +type CALLS_BUF STANDARD PROCESSES calls_buf +type BPD STANDARD SYSTEM bpd +type PORT_NAME STANDARD SYSTEM port_name +type LINEBUF STANDARD SYSTEM line_buf +type IOQ STANDARD SYSTEM io_queue +type BITS_BUF STANDARD SYSTEM bits_buf +type TMP_DIST_BUF TEMPORARY SYSTEM tmp_dist_buf +type ASYNC_Q LONG_LIVED SYSTEM async_queue +type ESTACK TEMPORARY SYSTEM estack +type PORT_CALL_BUF TEMPORARY SYSTEM port_call_buf +type DB_TABLE FIXED_SIZE ETS db_tab +type DB_FIXATION SHORT_LIVED ETS db_fixation +type DB_FIX_DEL SHORT_LIVED ETS fixed_del +type DB_TABLES LONG_LIVED ETS db_tabs +type DB_NTAB_ENT STANDARD ETS db_named_table_entry +type DB_TMP TEMPORARY ETS db_tmp +type DB_MC_STK TEMPORARY ETS db_mc_stack +type DB_MS_PSDO_PROC LONG_LIVED ETS db_match_pseudo_proc +type DB_MS_RUN_HEAP SHORT_LIVED ETS db_match_spec_run_heap +type DB_MS_CMPL_HEAP TEMPORARY ETS db_match_spec_cmpl_heap +type DB_SEG ETS ETS db_segment +type DB_SEG_TAB ETS ETS db_segment_tab +type DB_STK ETS ETS db_stack +type DB_TRANS_TAB ETS ETS db_trans_tab +type DB_SEL_LIST ETS ETS db_select_list +type DB_DMC_ERROR ETS ETS db_dmc_error +type DB_DMC_ERR_INFO ETS ETS db_dmc_error_info +type DB_TERM ETS ETS db_term +type DB_PROC_CLEANUP SHORT_LIVED ETS db_proc_cleanup_state +type INSTR_INFO LONG_LIVED SYSTEM instr_info +type LOGGER_DSBUF TEMPORARY SYSTEM logger_dsbuf +type TMP_DSBUF TEMPORARY SYSTEM tmp_dsbuf +type INFO_DSBUF SYSTEM SYSTEM info_dsbuf +# INFO_DSBUF have to use the SYSTEM allocator; otherwise, a deadlock might occur +type SCHDLR_DATA LONG_LIVED PROCESSES scheduler_data +type RUNQS LONG_LIVED SYSTEM run_queues +type DDLL_PROCESS STANDARD SYSTEM ddll_processes +type DDLL_HANDLE STANDARD SYSTEM ddll_handle +type DDLL_ERRCODES LONG_LIVED SYSTEM ddll_errcodes +type DDLL_TMP_BUF TEMPORARY SYSTEM ddll_tmp_buf +type PORT_TASK SHORT_LIVED SYSTEM port_task +type PORT_TASKQ SHORT_LIVED SYSTEM port_task_queue +type MISC_OP_LIST SHORT_LIVED SYSTEM misc_op_list +type PORT_NAMES SHORT_LIVED SYSTEM port_names +type PORT_DATA_LOCK STANDARD SYSTEM port_data_lock +type NODES_MON STANDARD PROCESSES nodes_monitor +type PROCS_TPROC_EL SHORT_LIVED PROCESSES processes_term_proc_el +type PROCS_CNKINF SHORT_LIVED PROCESSES processes_chunk_info +type PROCS_PIDS SHORT_LIVED PROCESSES processes_pids +type RE_TMP_BUF TEMPORARY SYSTEM re_tmp_buf +type RE_SUBJECT SHORT_LIVED SYSTEM re_subject +type RE_HEAP STANDARD SYSTEM re_heap +type RE_STACK SHORT_LIVED SYSTEM re_stack +type UNICODE_BUFFER SHORT_LIVED SYSTEM unicode_buffer +type PRE_ALLOC_DATA LONG_LIVED SYSTEM pre_alloc_data +type DRV_THR_OPTS DRIVER SYSTEM driver_thread_opts +type DRV_TID DRIVER SYSTEM driver_tid +type DRV_MTX DRIVER SYSTEM driver_mutex +type DRV_CND DRIVER SYSTEM driver_cond +type DRV_RWLCK DRIVER SYSTEM driver_rwlock +type DRV_TSD DRIVER SYSTEM driver_tsd +type PSD STANDARD PROCESSES process_specific_data +type PRTSD STANDARD SYSTEM port_specific_data +type CPUDATA LONG_LIVED SYSTEM cpu_data +type TMP_CPU_IDS SHORT_LIVED SYSTEM tmp_cpu_ids +type EXT_TERM_DATA SHORT_LIVED PROCESSES external_term_data +type ZLIB STANDARD SYSTEM zlib + ++if smp +type ASYNC SHORT_LIVED SYSTEM async ++else +# sl_alloc is not thread safe in non smp build; therefore, we use driver_alloc +type ASYNC DRIVER SYSTEM async ++endif + ++if smp +type PORT_LOCK STANDARD SYSTEM port_lock +type DRIVER_LOCK STANDARD SYSTEM driver_lock +type XPORTS_LIST SHORT_LIVED SYSTEM extra_port_list +type PROC_LCK_WTR LONG_LIVED SYSTEM proc_lock_waiter +type PROC_LCK_QS LONG_LIVED SYSTEM proc_lock_queues +type RUNQ_BLNS LONG_LIVED SYSTEM run_queue_balancing ++endif + +# +# Types used for special emulators +# + ++if threads + +type ETHR_INTERNAL SYSTEM SYSTEM ethread_internal + ++ifnot smp + +type ARCALLBACK LONG_LIVED SYSTEM async_ready_callback + ++endif + ++endif + ++if shared_heap + +type STACK STANDARD PROCESSES stack +type ACTIVE_PROCS STANDARD PROCESSES active_procs + ++endif + ++if hybrid + +type ACTIVE_PROCS STANDARD PROCESSES active_procs + +# Used for all memory involved in incremental gc of the message area +# that is, young (x2) and old generation, forwarding pointers and blackmap +type MESSAGE_AREA LONG_LIVED PROCESSES message_area + +# Used in MA_STACK (global.h) and INC_STORAGE (erl_nmgc.h) +type OBJECT_STACK STANDARD PROCESSES object_stack + ++endif + ++if smp +type SL_PTIMER SHORT_LIVED SYSTEM ptimer_sl +type LL_PTIMER STANDARD SYSTEM ptimer_ll +type SYS_MSG_Q SHORT_LIVED PROCESSES system_messages_queue +type FP_EXCEPTION LONG_LIVED SYSTEM fp_exception ++endif + ++if hipe + +# Currently most hipe code use this type. +type HIPE SYSTEM SYSTEM hipe_data + ++endif + ++if heap_frag_elim_test + +type SSB SHORT_LIVED PROCESSES ssb + ++endif + + +# +# Types used by system specific code +# + +type DRV_TAB LONG_LIVED SYSTEM drv_tab +type DRV_EV_STATE LONG_LIVED SYSTEM driver_event_state +type DRV_EV_D_STATE FIXED_SIZE SYSTEM driver_event_data_state +type DRV_SEL_D_STATE FIXED_SIZE SYSTEM driver_select_data_state +type FD_LIST SHORT_LIVED SYSTEM fd_list +type POLLSET LONG_LIVED SYSTEM pollset +type POLLSET_UPDREQ SHORT_LIVED SYSTEM pollset_update_req +type POLL_FDS LONG_LIVED SYSTEM poll_fds +type POLL_RES_EVS LONG_LIVED SYSTEM poll_result_events +type FD_STATUS LONG_LIVED SYSTEM fd_status + ++if unix + +type SYS_READ_BUF TEMPORARY SYSTEM sys_read_buf +type FD_TAB LONG_LIVED SYSTEM fd_tab +type FD_ENTRY_BUF STANDARD SYSTEM fd_entry_buf +type CS_PROG_PATH LONG_LIVED SYSTEM cs_prog_path +type ENVIRONMENT TEMPORARY SYSTEM environment +type PUTENV_STR SYSTEM SYSTEM putenv_string +type PRT_REP_EXIT STANDARD SYSTEM port_report_exit + ++endif + ++if win32 + +type DRV_DATA_BUF SYSTEM SYSTEM drv_data_buf +type PRELOADED LONG_LIVED SYSTEM preloaded +type PUTENV_STR SYSTEM SYSTEM putenv_string +type WAITER_OBJ LONG_LIVED SYSTEM waiter_object +type ENVIRONMENT SYSTEM SYSTEM environment +type CON_VPRINTF_BUF TEMPORARY SYSTEM con_vprintf_buf + ++endif + ++if vxworks + +type SYS_TMP_BUF LONG_LIVED SYSTEM sys_tmp_buf +type PEND_DATA SYSTEM SYSTEM pending_data +type FD_TAB LONG_LIVED SYSTEM fd_tab +type FD_ENTRY_BUF SYSTEM SYSTEM fd_entry_buf + ++endif + ++if ose + +type SYS_TMP_BUF LONG_LIVED SYSTEM sys_tmp_buf +type PUTENV_STR SYSTEM SYSTEM putenv_string +type GETENV_STR SYSTEM SYSTEM getenv_string +type GETENV_STATE SYSTEM SYSTEM getenv_state +type SIG_ENTRY SYSTEM SYSTEM sig_entry +type DRIVER_DATA SYSTEM SYSTEM driver_data +type PGM_TAB SYSTEM SYSTEM pgm_tab +type PGM_ENTRY SYSTEM SYSTEM pgm_entry +type PRT_TAB SYSTEM SYSTEM prt_tab +type PRT_ENTRY SYSTEM SYSTEM prt_entry + ++endif + +# ---------------------------------------------------------------------------- diff --git a/erts/emulator/beam/erl_alloc_util.c b/erts/emulator/beam/erl_alloc_util.c new file mode 100644 index 0000000000..9b7bc24c1c --- /dev/null +++ b/erts/emulator/beam/erl_alloc_util.c @@ -0,0 +1,3467 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: A memory allocator utility. This utility provides + * management of (multiple) memory segments, coalescing + * of free blocks, etc. Allocators are implemented by + * implementing a callback-interface which is called by + * this utility. The only task the callback-module has to + * perform is to supervise the free blocks. + * + * Author: Rickard Green + */ + +/* + * Alloc util will enforce 8 byte alignment if sys_alloc and mseg_alloc at + * least enforces 8 byte alignment. If sys_alloc only enforces 4 byte + * alignment then alloc util will do so too. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "global.h" +#include "big.h" +#include "erl_mtrace.h" +#define GET_ERL_ALLOC_UTIL_IMPL +#include "erl_alloc_util.h" +#include "erl_mseg.h" +#include "erl_threads.h" + +#ifdef ERTS_ENABLE_LOCK_COUNT +#include "erl_lock_count.h" +#endif + +#if defined(ERTS_ALLOC_UTIL_HARD_DEBUG) && defined(__GNUC__) +#warning "* * * * * * * * * *" +#warning "* * * * * * * * * *" +#warning "* * NOTE: * *" +#warning "* * Hard debug * *" +#warning "* * is enabled! * *" +#warning "* * * * * * * * * *" +#warning "* * * * * * * * * *" +#endif + +#define ALLOC_ZERO_EQ_NULL 0 + +static int atoms_initialized = 0; +static int initialized = 0; + + +#if HAVE_ERTS_MSEG + +#define INV_MSEG_UNIT_MASK ((Uint) (mseg_unit_size - 1)) +#define MSEG_UNIT_MASK (~INV_MSEG_UNIT_MASK) +#define MSEG_UNIT_FLOOR(X) ((X) & MSEG_UNIT_MASK) +#define MSEG_UNIT_CEILING(X) MSEG_UNIT_FLOOR((X) + INV_MSEG_UNIT_MASK) + +#endif + +#define INV_SYS_ALLOC_CARRIER_MASK ((Uint) (sys_alloc_carrier_size - 1)) +#define SYS_ALLOC_CARRIER_MASK (~INV_SYS_ALLOC_CARRIER_MASK) +#define SYS_ALLOC_CARRIER_FLOOR(X) ((X) & SYS_ALLOC_CARRIER_MASK) +#define SYS_ALLOC_CARRIER_CEILING(X) \ + SYS_ALLOC_CARRIER_FLOOR((X) + INV_SYS_ALLOC_CARRIER_MASK) + +#undef ASSERT +#define ASSERT ASSERT_EXPR + +#define ERTS_ALCU_FLG_FAIL_REALLOC_MOVE ((Uint) 1) + +#if 0 +/* Can be useful for debugging */ +#define MBC_REALLOC_ALWAYS_MOVES +#endif + + +/* alloc_util global parameters */ +static Uint sys_alloc_carrier_size; +#if HAVE_ERTS_MSEG +static Uint max_mseg_carriers; +static Uint mseg_unit_size; +#endif + +#define ONE_GIGA (1000000000) + +#define INC_CC(CC) ((CC).no == ONE_GIGA - 1 \ + ? ((CC).giga_no++, (CC).no = 0) \ + : (CC).no++) + +#define DEC_CC(CC) ((CC).no == 0 \ + ? ((CC).giga_no--, (CC).no = ONE_GIGA - 1) \ + : (CC).no--) + +/* ... */ + +/* Blocks ... */ + +#define SBC_BLK_FTR_FLG (((Uint) 1) << 0) +#define UNUSED1_BLK_FTR_FLG (((Uint) 1) << 1) +#define UNUSED2_BLK_FTR_FLG (((Uint) 1) << 2) + +#define ABLK_HDR_SZ (sizeof(Block_t)) +#define FBLK_FTR_SZ (sizeof(Uint)) + +#define UMEMSZ2BLKSZ(AP, SZ) \ + (ABLK_HDR_SZ + (SZ) <= (AP)->min_block_size \ + ? (AP)->min_block_size \ + : UNIT_CEILING(ABLK_HDR_SZ + (SZ))) + +#define UMEM2BLK(P) ((Block_t *) (((char *) (P)) - ABLK_HDR_SZ)) +#define BLK2UMEM(P) ((void *) (((char *) (P)) + ABLK_HDR_SZ)) + +#define PREV_BLK_SZ(B) \ + ((Uint) (*(((Uint *) (B)) - 1) & SZ_MASK)) + +#define SET_BLK_SZ_FTR(B, SZ) \ + (*((Uint *) (((char *) (B)) + (SZ) - sizeof(Uint))) = (SZ)) + +#define THIS_FREE_BLK_HDR_FLG (((Uint) 1) << 0) +#define PREV_FREE_BLK_HDR_FLG (((Uint) 1) << 1) +#define LAST_BLK_HDR_FLG (((Uint) 1) << 2) + +#define SET_BLK_SZ(B, SZ) \ + (ASSERT(((SZ) & FLG_MASK) == 0), \ + (*((Block_t *) (B)) = ((*((Block_t *) (B)) & FLG_MASK) | (SZ)))) +#define SET_BLK_FREE(B) \ + (*((Block_t *) (B)) |= THIS_FREE_BLK_HDR_FLG) +#define SET_BLK_ALLOCED(B) \ + (*((Block_t *) (B)) &= ~THIS_FREE_BLK_HDR_FLG) +#define SET_PREV_BLK_FREE(B) \ + (*((Block_t *) (B)) |= PREV_FREE_BLK_HDR_FLG) +#define SET_PREV_BLK_ALLOCED(B) \ + (*((Block_t *) (B)) &= ~PREV_FREE_BLK_HDR_FLG) +#define SET_LAST_BLK(B) \ + (*((Block_t *) (B)) |= LAST_BLK_HDR_FLG) +#define SET_NOT_LAST_BLK(B) \ + (*((Block_t *) (B)) &= ~LAST_BLK_HDR_FLG) + +#define SBH_THIS_FREE THIS_FREE_BLK_HDR_FLG +#define SBH_THIS_ALLOCED ((Uint) 0) +#define SBH_PREV_FREE PREV_FREE_BLK_HDR_FLG +#define SBH_PREV_ALLOCED ((Uint) 0) +#define SBH_LAST_BLK LAST_BLK_HDR_FLG +#define SBH_NOT_LAST_BLK ((Uint) 0) + +#define SET_BLK_HDR(B, Sz, F) \ + (ASSERT(((Sz) & FLG_MASK) == 0), *((Block_t *) (B)) = ((Sz) | (F))) + +#define BLK_UMEM_SZ(B) \ + (BLK_SZ(B) - (ABLK_HDR_SZ)) +#define IS_PREV_BLK_FREE(B) \ + (*((Block_t *) (B)) & PREV_FREE_BLK_HDR_FLG) +#define IS_PREV_BLK_ALLOCED(B) \ + (!IS_PREV_BLK_FREE((B))) +#define IS_FREE_BLK(B) \ + (*((Block_t *) (B)) & THIS_FREE_BLK_HDR_FLG) +#define IS_ALLOCED_BLK(B) \ + (!IS_FREE_BLK((B))) +#define IS_LAST_BLK(B) \ + (*((Block_t *) (B)) & LAST_BLK_HDR_FLG) +#define IS_NOT_LAST_BLK(B) \ + (!IS_LAST_BLK((B))) + +#define GET_LAST_BLK_HDR_FLG(B) \ + (*((Block_t*) (B)) & LAST_BLK_HDR_FLG) +#define GET_THIS_FREE_BLK_HDR_FLG(B) \ + (*((Block_t*) (B)) & THIS_FREE_BLK_HDR_FLG) +#define GET_PREV_FREE_BLK_HDR_FLG(B) \ + (*((Block_t*) (B)) & PREV_FREE_BLK_HDR_FLG) +#define GET_BLK_HDR_FLGS(B) \ + (*((Block_t*) (B)) & FLG_MASK) + +#define IS_FIRST_BLK(B) \ + (IS_PREV_BLK_FREE((B)) && (PREV_BLK_SZ((B)) == 0)) +#define IS_NOT_FIRST_BLK(B) \ + (!IS_FIRST_BLK((B))) + +#define SET_SBC_BLK_FTR(FTR) \ + ((FTR) = (0 | SBC_BLK_FTR_FLG)) +#define SET_MBC_BLK_FTR(FTR) \ + ((FTR) = 0) + +#define IS_SBC_BLK(B) \ + (IS_PREV_BLK_FREE((B)) && (((Uint *) (B))[-1] & SBC_BLK_FTR_FLG)) +#define IS_MBC_BLK(B) \ + (!IS_SBC_BLK((B))) + +#define NXT_BLK(B) \ + ((Block_t *) (((char *) (B)) + BLK_SZ((B)))) +#define PREV_BLK(B) \ + ((Block_t *) (((char *) (B)) - PREV_BLK_SZ((B)))) + +/* Carriers ... */ + +#define MSEG_CARRIER_HDR_FLAG (((Uint) 1) << 0) +#define SBC_CARRIER_HDR_FLAG (((Uint) 1) << 1) + +#define SCH_SYS_ALLOC 0 +#define SCH_MSEG MSEG_CARRIER_HDR_FLAG +#define SCH_MBC 0 +#define SCH_SBC SBC_CARRIER_HDR_FLAG + +#define SET_CARRIER_HDR(C, Sz, F) \ + (ASSERT(((Sz) & FLG_MASK) == 0), (C)->chdr = ((Sz) | (F))) + +#define BLK2SBC(AP, B) \ + ((Carrier_t *) (((char *) (B)) - (AP)->sbc_header_size)) +#define FBLK2MBC(AP, B) \ + ((Carrier_t *) (((char *) (B)) - (AP)->mbc_header_size)) + +#define MBC2FBLK(AP, P) \ + ((Block_t *) (((char *) (P)) + (AP)->mbc_header_size)) +#define SBC2BLK(AP, P) \ + ((Block_t *) (((char *) (P)) + (AP)->sbc_header_size)) +#define SBC2UMEM(AP, P) \ + ((void *) (((char *) (P)) + ((AP)->sbc_header_size + ABLK_HDR_SZ))) + +#define IS_MSEG_CARRIER(C) \ + ((C)->chdr & MSEG_CARRIER_HDR_FLAG) +#define IS_SYS_ALLOC_CARRIER(C) \ + (!IS_MSEG_CARRIER((C))) +#define IS_SB_CARRIER(C) \ + ((C)->chdr & SBC_CARRIER_HDR_FLAG) +#define IS_MB_CARRIER(C) \ + (!IS_SB_CARRIER((C))) + +#define SET_MSEG_CARRIER(C) \ + ((C)->chdr |= MSEG_CARRIER_HDR_FLAG) +#define SET_SYS_ALLOC_CARRIER(C) \ + ((C)->chdr &= ~MSEG_CARRIER_HDR_FLAG) +#define SET_SB_CARRIER(C) \ + ((C)->chdr |= SBC_CARRIER_HDR_FLAG) +#define SET_MB_CARRIER(C) \ + ((C)->chdr &= ~SBC_CARRIER_HDR_FLAG) + +#define SET_CARRIER_SZ(C, SZ) \ + (ASSERT(((SZ) & FLG_MASK) == 0), \ + ((C)->chdr = ((C)->chdr & FLG_MASK) | (SZ))) + +#define CFLG_SBC (1 << 0) +#define CFLG_MBC (1 << 1) +#define CFLG_FORCE_MSEG (1 << 2) +#define CFLG_FORCE_SYS_ALLOC (1 << 3) +#define CFLG_FORCE_SIZE (1 << 4) +#define CFLG_MAIN_CARRIER (1 << 5) + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG +static void check_blk_carrier(Allctr_t *, Block_t *); +#define HARD_CHECK_BLK_CARRIER(A, B) check_blk_carrier((A), (B)) +#else +#define HARD_CHECK_BLK_CARRIER(A, B) +#endif + + +/* Statistics updating ... */ + +#ifdef DEBUG +#define DEBUG_CHECK_CARRIER_NO_SZ(AP) \ + ASSERT(((AP)->sbcs.curr_mseg.no && (AP)->sbcs.curr_mseg.size) \ + || (!(AP)->sbcs.curr_mseg.no && !(AP)->sbcs.curr_mseg.size));\ + ASSERT(((AP)->sbcs.curr_sys_alloc.no && (AP)->sbcs.curr_sys_alloc.size)\ + || (!(AP)->sbcs.curr_sys_alloc.no && !(AP)->sbcs.curr_sys_alloc.size));\ + ASSERT(((AP)->mbcs.curr_mseg.no && (AP)->mbcs.curr_mseg.size) \ + || (!(AP)->mbcs.curr_mseg.no && !(AP)->mbcs.curr_mseg.size));\ + ASSERT(((AP)->mbcs.curr_sys_alloc.no && (AP)->mbcs.curr_sys_alloc.size)\ + || (!(AP)->mbcs.curr_sys_alloc.no && !(AP)->mbcs.curr_sys_alloc.size)) + +#else +#define DEBUG_CHECK_CARRIER_NO_SZ(AP) +#endif + +#define STAT_SBC_ALLOC(AP, BSZ) \ + (AP)->sbcs.blocks.curr.size += (BSZ); \ + if ((AP)->sbcs.blocks.max.size < (AP)->sbcs.blocks.curr.size) \ + (AP)->sbcs.blocks.max.size = (AP)->sbcs.blocks.curr.size; \ + if ((AP)->sbcs.max.no < ((AP)->sbcs.curr_mseg.no \ + + (AP)->sbcs.curr_sys_alloc.no)) \ + (AP)->sbcs.max.no = ((AP)->sbcs.curr_mseg.no \ + + (AP)->sbcs.curr_sys_alloc.no); \ + if ((AP)->sbcs.max.size < ((AP)->sbcs.curr_mseg.size \ + + (AP)->sbcs.curr_sys_alloc.size)) \ + (AP)->sbcs.max.size = ((AP)->sbcs.curr_mseg.size \ + + (AP)->sbcs.curr_sys_alloc.size) + +#define STAT_MSEG_SBC_ALLOC(AP, CSZ, BSZ) \ +do { \ + (AP)->sbcs.curr_mseg.no++; \ + (AP)->sbcs.curr_mseg.size += (CSZ); \ + STAT_SBC_ALLOC((AP), (BSZ)); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + +#define STAT_SYS_ALLOC_SBC_ALLOC(AP, CSZ, BSZ) \ +do { \ + (AP)->sbcs.curr_sys_alloc.no++; \ + (AP)->sbcs.curr_sys_alloc.size += (CSZ); \ + STAT_SBC_ALLOC((AP), (BSZ)); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + + +#define STAT_SBC_FREE(AP, BSZ) \ + ASSERT((AP)->sbcs.blocks.curr.size >= (BSZ)); \ + (AP)->sbcs.blocks.curr.size -= (BSZ) + +#define STAT_MSEG_SBC_FREE(AP, CSZ, BSZ) \ +do { \ + ASSERT((AP)->sbcs.curr_mseg.no > 0); \ + (AP)->sbcs.curr_mseg.no--; \ + ASSERT((AP)->sbcs.curr_mseg.size >= (CSZ)); \ + (AP)->sbcs.curr_mseg.size -= (CSZ); \ + STAT_SBC_FREE((AP), (BSZ)); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + +#define STAT_SYS_ALLOC_SBC_FREE(AP, CSZ, BSZ) \ +do { \ + ASSERT((AP)->sbcs.curr_sys_alloc.no > 0); \ + (AP)->sbcs.curr_sys_alloc.no--; \ + ASSERT((AP)->sbcs.curr_sys_alloc.size >= (CSZ)); \ + (AP)->sbcs.curr_sys_alloc.size -= (CSZ); \ + STAT_SBC_FREE((AP), (BSZ)); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + +#define STAT_MBC_ALLOC(AP) \ + if ((AP)->mbcs.max.no < ((AP)->mbcs.curr_mseg.no \ + + (AP)->mbcs.curr_sys_alloc.no)) \ + (AP)->mbcs.max.no = ((AP)->mbcs.curr_mseg.no \ + + (AP)->mbcs.curr_sys_alloc.no); \ + if ((AP)->mbcs.max.size < ((AP)->mbcs.curr_mseg.size \ + + (AP)->mbcs.curr_sys_alloc.size)) \ + (AP)->mbcs.max.size = ((AP)->mbcs.curr_mseg.size \ + + (AP)->mbcs.curr_sys_alloc.size) + + +#define STAT_MSEG_MBC_ALLOC(AP, CSZ) \ +do { \ + (AP)->mbcs.curr_mseg.no++; \ + (AP)->mbcs.curr_mseg.size += (CSZ); \ + STAT_MBC_ALLOC((AP)); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + +#define STAT_SYS_ALLOC_MBC_ALLOC(AP, CSZ) \ +do { \ + (AP)->mbcs.curr_sys_alloc.no++; \ + (AP)->mbcs.curr_sys_alloc.size += (CSZ); \ + STAT_MBC_ALLOC((AP)); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + +#define STAT_MSEG_MBC_FREE(AP, CSZ) \ +do { \ + ASSERT((AP)->mbcs.curr_mseg.no > 0); \ + (AP)->mbcs.curr_mseg.no--; \ + ASSERT((AP)->mbcs.curr_mseg.size >= (CSZ)); \ + (AP)->mbcs.curr_mseg.size -= (CSZ); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + +#define STAT_SYS_ALLOC_MBC_FREE(AP, CSZ) \ +do { \ + ASSERT((AP)->mbcs.curr_sys_alloc.no > 0); \ + (AP)->mbcs.curr_sys_alloc.no--; \ + ASSERT((AP)->mbcs.curr_sys_alloc.size >= (CSZ)); \ + (AP)->mbcs.curr_sys_alloc.size -= (CSZ); \ + DEBUG_CHECK_CARRIER_NO_SZ((AP)); \ +} while (0) + +#define STAT_MBC_BLK_ALLOC(AP, BSZ) \ +do { \ + (AP)->mbcs.blocks.curr.no++; \ + if ((AP)->mbcs.blocks.max.no < (AP)->mbcs.blocks.curr.no) \ + (AP)->mbcs.blocks.max.no = (AP)->mbcs.blocks.curr.no; \ + (AP)->mbcs.blocks.curr.size += (BSZ); \ + if ((AP)->mbcs.blocks.max.size < (AP)->mbcs.blocks.curr.size) \ + (AP)->mbcs.blocks.max.size = (AP)->mbcs.blocks.curr.size; \ +} while (0) + +#define STAT_MBC_BLK_FREE(AP, BSZ) \ +do { \ + ASSERT((AP)->mbcs.blocks.curr.no > 0); \ + (AP)->mbcs.blocks.curr.no--; \ + ASSERT((AP)->mbcs.blocks.curr.size >= (BSZ)); \ + (AP)->mbcs.blocks.curr.size -= (BSZ); \ +} while (0) + +/* Debug stuff... */ +#ifdef DEBUG +static Uint carrier_alignment; +#define DEBUG_SAVE_ALIGNMENT(C) \ +do { \ + Uint algnmnt__ = sizeof(Unit_t) - (((Uint) (C)) % sizeof(Unit_t)); \ + carrier_alignment = MIN(carrier_alignment, algnmnt__); \ + ASSERT(((Uint) (C)) % sizeof(Uint) == 0); \ +} while (0) +#define DEBUG_CHECK_ALIGNMENT(P) \ +do { \ + ASSERT(sizeof(Unit_t) - (((Uint) (P)) % sizeof(Unit_t)) \ + >= carrier_alignment); \ + ASSERT(((Uint) (P)) % sizeof(Uint) == 0); \ +} while (0) + +#else +#define DEBUG_SAVE_ALIGNMENT(C) +#define DEBUG_CHECK_ALIGNMENT(P) +#endif + +#ifdef DEBUG +#ifdef USE_THREADS +#define ERTS_ALCU_DBG_CHK_THR_SPEC(A) \ +do { \ + if (!(A)->thread_safe) { \ + if (!(A)->debug.saved_tid) \ + (A)->debug.tid = erts_thr_self(); \ + else { \ + ASSERT(ethr_equal_tids((A)->debug.tid, erts_thr_self())); \ + } \ + } \ +} while (0) +#else +#define ERTS_ALCU_DBG_CHK_THR_SPEC(A) +#endif +#else +#define ERTS_ALCU_DBG_CHK_THR_SPEC(A) +#endif + + +static void make_name_atoms(Allctr_t *allctr); + + +/* mseg ... */ + +#if HAVE_ERTS_MSEG + +static ERTS_INLINE void * +alcu_mseg_alloc(Allctr_t *allctr, Uint *size_p) +{ + void *res; + + res = erts_mseg_alloc_opt(allctr->alloc_no, size_p, &allctr->mseg_opt); + INC_CC(allctr->calls.mseg_alloc); + return res; +} + +static ERTS_INLINE void * +alcu_mseg_realloc(Allctr_t *allctr, void *seg, Uint old_size, Uint *new_size_p) +{ + void *res; + + res = erts_mseg_realloc_opt(allctr->alloc_no, seg, old_size, new_size_p, + &allctr->mseg_opt); + INC_CC(allctr->calls.mseg_realloc); + return res; +} + +static ERTS_INLINE void +alcu_mseg_dealloc(Allctr_t *allctr, void *seg, Uint size) +{ + erts_mseg_dealloc_opt(allctr->alloc_no, seg, size, &allctr->mseg_opt); + INC_CC(allctr->calls.mseg_dealloc); +} + +#endif + +static ERTS_INLINE void * +alcu_sys_alloc(Allctr_t *allctr, Uint size) +{ + void *res; + + res = erts_sys_alloc(0, NULL, size); + INC_CC(allctr->calls.sys_alloc); + if (erts_mtrace_enabled) + erts_mtrace_crr_alloc(res, allctr->alloc_no, ERTS_ALC_A_SYSTEM, size); + return res; +} + +static ERTS_INLINE void * +alcu_sys_realloc(Allctr_t *allctr, void *ptr, Uint size) +{ + void *res; + + res = erts_sys_realloc(0, NULL, ptr, size); + INC_CC(allctr->calls.sys_realloc); + if (erts_mtrace_enabled) + erts_mtrace_crr_realloc(res, + allctr->alloc_no, + ERTS_ALC_A_SYSTEM, + ptr, + size); + return res; +} + +static ERTS_INLINE void +alcu_sys_free(Allctr_t *allctr, void *ptr) +{ + erts_sys_free(0, NULL, ptr); + INC_CC(allctr->calls.sys_free); + if (erts_mtrace_enabled) + erts_mtrace_crr_free(allctr->alloc_no, ERTS_ALC_A_SYSTEM, ptr); +} + +static Uint +get_next_mbc_size(Allctr_t *allctr) +{ + Uint size; + int cs = (allctr->mbcs.curr_mseg.no + + allctr->mbcs.curr_sys_alloc.no + - (allctr->main_carrier ? 1 : 0)); + + ASSERT(cs >= 0); + ASSERT(allctr->largest_mbc_size >= allctr->smallest_mbc_size); + + if (cs >= allctr->mbc_growth_stages) + size = allctr->largest_mbc_size; + else + size = ((cs*(allctr->largest_mbc_size - allctr->smallest_mbc_size) + / allctr->mbc_growth_stages) + + allctr->smallest_mbc_size); + + if (size < allctr->min_mbc_size) + size = allctr->min_mbc_size; + + return size; +} + +static ERTS_INLINE void +link_carrier(CarrierList_t *cl, Carrier_t *crr) +{ + crr->next = NULL; + if (!cl->last) { + ASSERT(!cl->first); + cl->first = cl->last = crr; + crr->prev = NULL; + } + else { + ASSERT(cl->first); + ASSERT(!cl->first->prev); + ASSERT(cl->last); + ASSERT(!cl->last->next); + crr->prev = cl->last; + cl->last->next = crr; + cl->last = crr; + } + ASSERT(crr->next != crr); + ASSERT(crr->prev != crr); +} + +static ERTS_INLINE void +relink_carrier(CarrierList_t *cl, Carrier_t *crr) +{ + if (crr->next) { + if (crr->next->prev != crr) + crr->next->prev = crr; + } + else if (cl->last != crr) + cl->last = crr; + + if (crr->prev) { + if (crr->prev->next != crr) + crr->prev->next = crr; + } + else if (cl->first != crr) + cl->first = crr; +} + +static ERTS_INLINE void +unlink_carrier(CarrierList_t *cl, Carrier_t *crr) +{ + ASSERT(crr->next != crr); + ASSERT(crr->prev != crr); + + if (cl->first == crr) { + ASSERT(!crr->prev); + cl->first = crr->next; + } + else { + ASSERT(crr->prev); + crr->prev->next = crr->next; + } + + if (cl->last == crr) { + ASSERT(!crr->next); + cl->last = crr->prev; + } + else { + ASSERT(crr->next); + crr->next->prev = crr->prev; + } +} + + +static Block_t *create_carrier(Allctr_t *, Uint, Uint); +static void destroy_carrier(Allctr_t *, Block_t *); + +/* Multi block carrier alloc/realloc/free ... */ + +/* NOTE! mbc_alloc() may in case of memory shortage place the requested + * block in a sbc. + */ +static ERTS_INLINE void * +mbc_alloc_block(Allctr_t *allctr, Uint size, Uint *blk_szp) +{ + Block_t *blk; + + ASSERT(size); + ASSERT(size < allctr->sbc_threshold); + + *blk_szp = UMEMSZ2BLKSZ(allctr, size); + + blk = (*allctr->get_free_block)(allctr, *blk_szp, NULL, 0); + + if (!blk) { + blk = create_carrier(allctr, *blk_szp, CFLG_MBC); + if (!blk) { + /* Emergency! We couldn't create the carrier as we wanted. + Try to place it in a sys_alloced sbc. */ + blk = create_carrier(allctr, + size, + CFLG_SBC|CFLG_FORCE_SIZE|CFLG_FORCE_SYS_ALLOC); + } + } + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (IS_MBC_BLK(blk)) { + (*allctr->link_free_block)(allctr, blk); + HARD_CHECK_BLK_CARRIER(allctr, blk); + (*allctr->unlink_free_block)(allctr, blk); + } +#endif + + return blk; +} + +static ERTS_INLINE void +mbc_alloc_finalize(Allctr_t *allctr, + Block_t *blk, + Uint org_blk_sz, + Uint flags, + Uint want_blk_sz, + int valid_blk_info) +{ + Uint blk_sz; + Uint nxt_blk_sz; + Block_t *nxt_blk; + Uint prev_free_flg = flags & PREV_FREE_BLK_HDR_FLG; + + ASSERT(org_blk_sz >= want_blk_sz); + ASSERT(blk); + +#ifdef DEBUG + nxt_blk = NULL; +#endif + + if (org_blk_sz - allctr->min_block_size >= want_blk_sz) { + /* Shrink block... */ + blk_sz = want_blk_sz; + nxt_blk_sz = org_blk_sz - blk_sz; + SET_BLK_HDR(blk, + blk_sz, + SBH_THIS_ALLOCED|SBH_NOT_LAST_BLK|prev_free_flg); + + nxt_blk = NXT_BLK(blk); + SET_BLK_HDR(nxt_blk, + nxt_blk_sz, + (SBH_THIS_FREE + | SBH_PREV_ALLOCED + | (flags & LAST_BLK_HDR_FLG))); + + if (!(flags & LAST_BLK_HDR_FLG)) { + SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); + if (!valid_blk_info) { + Block_t *nxt_nxt_blk = NXT_BLK(nxt_blk); + SET_PREV_BLK_FREE(nxt_nxt_blk); + } + } + (*allctr->link_free_block)(allctr, nxt_blk); + + ASSERT(IS_NOT_LAST_BLK(blk)); + ASSERT(IS_FREE_BLK(nxt_blk)); + ASSERT((flags & LAST_BLK_HDR_FLG) + ? IS_LAST_BLK(nxt_blk) + : IS_NOT_LAST_BLK(nxt_blk)); + ASSERT((flags & LAST_BLK_HDR_FLG) + || nxt_blk == PREV_BLK(NXT_BLK(nxt_blk))); + ASSERT((flags & LAST_BLK_HDR_FLG) + || IS_PREV_BLK_FREE(NXT_BLK(nxt_blk))); + ASSERT(nxt_blk_sz == BLK_SZ(nxt_blk)); + ASSERT(nxt_blk_sz % sizeof(Unit_t) == 0); + ASSERT(nxt_blk_sz >= allctr->min_block_size); + } + else { + blk_sz = org_blk_sz; + if (flags & LAST_BLK_HDR_FLG) { + if (valid_blk_info) + SET_BLK_ALLOCED(blk); + else + SET_BLK_HDR(blk, + blk_sz, + SBH_THIS_ALLOCED|SBH_LAST_BLK|prev_free_flg); + } + else { + if (valid_blk_info) + SET_BLK_ALLOCED(blk); + else + SET_BLK_HDR(blk, + blk_sz, + SBH_THIS_ALLOCED|SBH_NOT_LAST_BLK|prev_free_flg); + nxt_blk = NXT_BLK(blk); + SET_PREV_BLK_ALLOCED(nxt_blk); + } + + ASSERT((flags & LAST_BLK_HDR_FLG) + ? IS_LAST_BLK(blk) + : IS_NOT_LAST_BLK(blk)); + } + + STAT_MBC_BLK_ALLOC(allctr, blk_sz); + + ASSERT(IS_ALLOCED_BLK(blk)); + ASSERT(blk_sz == BLK_SZ(blk)); + ASSERT(blk_sz % sizeof(Unit_t) == 0); + ASSERT(blk_sz >= allctr->min_block_size); + ASSERT(blk_sz >= want_blk_sz); + ASSERT(IS_MBC_BLK(blk)); + + ASSERT(!nxt_blk || IS_PREV_BLK_ALLOCED(nxt_blk)); + ASSERT(!nxt_blk || IS_MBC_BLK(nxt_blk)); + + HARD_CHECK_BLK_CARRIER(allctr, blk); +} + +static void * +mbc_alloc(Allctr_t *allctr, Uint size) +{ + Block_t *blk; + Uint blk_sz; + blk = mbc_alloc_block(allctr, size, &blk_sz); + if (!blk) + return NULL; + if (IS_MBC_BLK(blk)) + mbc_alloc_finalize(allctr, + blk, + BLK_SZ(blk), + GET_BLK_HDR_FLGS(blk), + blk_sz, + 1); + return BLK2UMEM(blk); +} + +static void +mbc_free(Allctr_t *allctr, void *p) +{ + Uint is_first_blk; + Uint is_last_blk; + Uint blk_sz; + Block_t *blk; + Block_t *nxt_blk; + + + ASSERT(p); + + blk = UMEM2BLK(p); + blk_sz = BLK_SZ(blk); + + ASSERT(IS_MBC_BLK(blk)); + ASSERT(blk_sz >= allctr->min_block_size); + + HARD_CHECK_BLK_CARRIER(allctr, blk); + + STAT_MBC_BLK_FREE(allctr, blk_sz); + + is_first_blk = IS_FIRST_BLK(blk); + is_last_blk = IS_LAST_BLK(blk); + + if (!is_first_blk && IS_PREV_BLK_FREE(blk)) { + /* Coalesce with previous block... */ + blk = PREV_BLK(blk); + (*allctr->unlink_free_block)(allctr, blk); + + blk_sz += BLK_SZ(blk); + is_first_blk = IS_FIRST_BLK(blk); + SET_BLK_SZ(blk, blk_sz); + } + else { + SET_BLK_FREE(blk); + } + + if (is_last_blk) + SET_LAST_BLK(blk); + else { + nxt_blk = NXT_BLK(blk); + if (IS_FREE_BLK(nxt_blk)) { + /* Coalesce with next block... */ + (*allctr->unlink_free_block)(allctr, nxt_blk); + blk_sz += BLK_SZ(nxt_blk); + SET_BLK_SZ(blk, blk_sz); + + is_last_blk = IS_LAST_BLK(nxt_blk); + if (is_last_blk) + SET_LAST_BLK(blk); + else { + SET_NOT_LAST_BLK(blk); + SET_BLK_SZ_FTR(blk, blk_sz); + } + } + else { + SET_PREV_BLK_FREE(nxt_blk); + SET_NOT_LAST_BLK(blk); + SET_BLK_SZ_FTR(blk, blk_sz); + } + + } + + ASSERT(is_last_blk ? IS_LAST_BLK(blk) : IS_NOT_LAST_BLK(blk)); + ASSERT(is_first_blk ? IS_FIRST_BLK(blk) : IS_NOT_FIRST_BLK(blk)); + ASSERT(IS_FREE_BLK(blk)); + ASSERT(is_first_blk || IS_PREV_BLK_ALLOCED(blk)); + ASSERT(is_last_blk || IS_PREV_BLK_FREE(NXT_BLK(blk))); + ASSERT(blk_sz == BLK_SZ(blk)); + ASSERT(is_last_blk || blk == PREV_BLK(NXT_BLK(blk))); + ASSERT(blk_sz % sizeof(Unit_t) == 0); + ASSERT(IS_MBC_BLK(blk)); + + if (is_first_blk + && is_last_blk + && allctr->main_carrier != FBLK2MBC(allctr, blk)) + destroy_carrier(allctr, blk); + else { + (*allctr->link_free_block)(allctr, blk); + HARD_CHECK_BLK_CARRIER(allctr, blk); + } +} + +static void * +mbc_realloc(Allctr_t *allctr, void *p, Uint size, Uint flgs) +{ + void *new_p; + Uint old_blk_sz; + Block_t *blk; +#ifndef MBC_REALLOC_ALWAYS_MOVES + Block_t *new_blk, *cand_blk; + Uint cand_blk_sz; + Uint blk_sz; + Block_t *nxt_blk; + Uint nxt_blk_sz; + Uint is_last_blk; +#endif /* #ifndef MBC_REALLOC_ALWAYS_MOVES */ + + ASSERT(p); + ASSERT(size); + ASSERT(size < allctr->sbc_threshold); + + blk = (Block_t *) UMEM2BLK(p); + old_blk_sz = BLK_SZ(blk); + + ASSERT(old_blk_sz >= allctr->min_block_size); + +#ifdef MBC_REALLOC_ALWAYS_MOVES + if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + return NULL; +#else /* !MBC_REALLOC_ALWAYS_MOVES */ + blk_sz = UMEMSZ2BLKSZ(allctr, size); + + ASSERT(IS_ALLOCED_BLK(blk)); + ASSERT(IS_MBC_BLK(blk)); + + is_last_blk = IS_LAST_BLK(blk); + + if (old_blk_sz == blk_sz) + return p; + else if (blk_sz < old_blk_sz) { + /* Shrink block... */ + Block_t *nxt_nxt_blk; + Uint diff_sz_val = old_blk_sz - blk_sz; + Uint old_blk_sz_val = old_blk_sz; + + if (diff_sz_val >= (~((Uint) 0) / 100)) { + /* div both by 128 */ + old_blk_sz_val >>= 7; + diff_sz_val >>= 7; + } + + /* Avoid fragmentation by moving the block if it is shrunk much */ + if (100*diff_sz_val > allctr->mbc_move_threshold*old_blk_sz_val) { + if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + return NULL; + + cand_blk_sz = old_blk_sz; + if (!IS_PREV_BLK_FREE(blk) || IS_FIRST_BLK(blk)) + cand_blk = blk; + else { + cand_blk = PREV_BLK(blk); + cand_blk_sz += PREV_BLK_SZ(blk); + } + if (!is_last_blk) { + nxt_blk = NXT_BLK(blk); + if (IS_FREE_BLK(nxt_blk)) + cand_blk_sz += BLK_SZ(nxt_blk); + } + + new_blk = (*allctr->get_free_block)(allctr, + blk_sz, + cand_blk, + cand_blk_sz); + + if (new_blk || cand_blk != blk) + goto move_into_new_blk; + } + + /* Shrink at current location */ + + nxt_blk_sz = old_blk_sz - blk_sz; + + if ((is_last_blk || IS_ALLOCED_BLK(NXT_BLK(blk))) + && (nxt_blk_sz < allctr->min_block_size)) + return p; + + HARD_CHECK_BLK_CARRIER(allctr, blk); + + SET_BLK_SZ(blk, blk_sz); + SET_NOT_LAST_BLK(blk); + + nxt_blk = NXT_BLK(blk); + SET_BLK_HDR(nxt_blk, + nxt_blk_sz, + SBH_THIS_FREE|SBH_PREV_ALLOCED|SBH_NOT_LAST_BLK); + + STAT_MBC_BLK_FREE(allctr, old_blk_sz); + STAT_MBC_BLK_ALLOC(allctr, blk_sz); + + ASSERT(BLK_SZ(blk) >= allctr->min_block_size); + + if (is_last_blk) + SET_LAST_BLK(nxt_blk); + else { + nxt_nxt_blk = NXT_BLK(nxt_blk); + if (IS_FREE_BLK(nxt_nxt_blk)) { + /* Coalesce with next free block... */ + nxt_blk_sz += BLK_SZ(nxt_nxt_blk); + (*allctr->unlink_free_block)(allctr, nxt_nxt_blk); + SET_BLK_SZ(nxt_blk, nxt_blk_sz); + + is_last_blk = IS_LAST_BLK(nxt_nxt_blk); + if (is_last_blk) + SET_LAST_BLK(nxt_blk); + else + SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); + } + else { + SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); + SET_PREV_BLK_FREE(nxt_nxt_blk); + } + } + + (*allctr->link_free_block)(allctr, nxt_blk); + + + ASSERT(IS_ALLOCED_BLK(blk)); + ASSERT(blk_sz == BLK_SZ(blk)); + ASSERT(blk_sz % sizeof(Unit_t) == 0); + ASSERT(blk_sz >= allctr->min_block_size); + ASSERT(blk_sz >= size + ABLK_HDR_SZ); + ASSERT(IS_MBC_BLK(blk)); + + ASSERT(IS_FREE_BLK(nxt_blk)); + ASSERT(IS_PREV_BLK_ALLOCED(nxt_blk)); + ASSERT(nxt_blk_sz == BLK_SZ(nxt_blk)); + ASSERT(nxt_blk_sz % sizeof(Unit_t) == 0); + ASSERT(nxt_blk_sz >= allctr->min_block_size); + ASSERT(IS_MBC_BLK(nxt_blk)); + ASSERT(is_last_blk ? IS_LAST_BLK(nxt_blk) : IS_NOT_LAST_BLK(nxt_blk)); + ASSERT(is_last_blk || nxt_blk == PREV_BLK(NXT_BLK(nxt_blk))); + ASSERT(is_last_blk || IS_PREV_BLK_FREE(NXT_BLK(nxt_blk))); + + HARD_CHECK_BLK_CARRIER(allctr, blk); + + return p; + } + + /* Need larger block... */ + + if (!is_last_blk) { + nxt_blk = NXT_BLK(blk); + nxt_blk_sz = BLK_SZ(nxt_blk); + if (IS_FREE_BLK(nxt_blk) && blk_sz <= old_blk_sz + nxt_blk_sz) { + /* Grow into next block... */ + + HARD_CHECK_BLK_CARRIER(allctr, blk); + + (*allctr->unlink_free_block)(allctr, nxt_blk); + nxt_blk_sz -= blk_sz - old_blk_sz; + + is_last_blk = IS_LAST_BLK(nxt_blk); + if (nxt_blk_sz < allctr->min_block_size) { + blk_sz += nxt_blk_sz; + + SET_BLK_SZ(blk, blk_sz); + + if (is_last_blk) { + SET_LAST_BLK(blk); +#ifdef DEBUG + nxt_blk = NULL; +#endif + } + else { + nxt_blk = NXT_BLK(blk); + SET_PREV_BLK_ALLOCED(nxt_blk); +#ifdef DEBUG + is_last_blk = IS_LAST_BLK(nxt_blk); + nxt_blk_sz = BLK_SZ(nxt_blk); +#endif + } + } + else { + SET_BLK_SZ(blk, blk_sz); + + nxt_blk = NXT_BLK(blk); + SET_BLK_HDR(nxt_blk, + nxt_blk_sz, + SBH_THIS_FREE|SBH_PREV_ALLOCED|SBH_NOT_LAST_BLK); + + if (is_last_blk) + SET_LAST_BLK(nxt_blk); + else + SET_BLK_SZ_FTR(nxt_blk, nxt_blk_sz); + + (*allctr->link_free_block)(allctr, nxt_blk); + + ASSERT(IS_FREE_BLK(nxt_blk)); + } + + STAT_MBC_BLK_FREE(allctr, old_blk_sz); + STAT_MBC_BLK_ALLOC(allctr, blk_sz); + + + ASSERT(IS_ALLOCED_BLK(blk)); + ASSERT(blk_sz == BLK_SZ(blk)); + ASSERT(blk_sz % sizeof(Unit_t) == 0); + ASSERT(blk_sz >= allctr->min_block_size); + ASSERT(blk_sz >= size + ABLK_HDR_SZ); + ASSERT(IS_MBC_BLK(blk)); + + ASSERT(!nxt_blk || IS_PREV_BLK_ALLOCED(nxt_blk)); + ASSERT(!nxt_blk || nxt_blk_sz == BLK_SZ(nxt_blk)); + ASSERT(!nxt_blk || nxt_blk_sz % sizeof(Unit_t) == 0); + ASSERT(!nxt_blk || nxt_blk_sz >= allctr->min_block_size); + ASSERT(!nxt_blk || IS_MBC_BLK(nxt_blk)); + ASSERT(!nxt_blk || (is_last_blk + ? IS_LAST_BLK(nxt_blk) + : IS_NOT_LAST_BLK(nxt_blk))); + ASSERT(!nxt_blk || is_last_blk + || IS_ALLOCED_BLK(nxt_blk) + || nxt_blk == PREV_BLK(NXT_BLK(nxt_blk))); + ASSERT(!nxt_blk || is_last_blk + || IS_ALLOCED_BLK(nxt_blk) + || IS_PREV_BLK_FREE(NXT_BLK(nxt_blk))); + + HARD_CHECK_BLK_CARRIER(allctr, blk); + + return p; + } + } + + if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + return NULL; + + /* Need to grow in another block */ + + if (!IS_PREV_BLK_FREE(blk) || IS_FIRST_BLK(blk)) { + cand_blk = NULL; + cand_blk_sz = 0; + } + else { + cand_blk = PREV_BLK(blk); + cand_blk_sz = old_blk_sz + PREV_BLK_SZ(blk); + + if (!is_last_blk) { + nxt_blk = NXT_BLK(blk); + if (IS_FREE_BLK(nxt_blk)) + cand_blk_sz += BLK_SZ(nxt_blk); + } + } + + if (cand_blk_sz < blk_sz) { + /* We wont fit in cand_blk get a new one */ +#endif /* !MBC_REALLOC_ALWAYS_MOVES */ + + new_p = mbc_alloc(allctr, size); + if (!new_p) + return NULL; + sys_memcpy(new_p, p, MIN(size, old_blk_sz - ABLK_HDR_SZ)); + mbc_free(allctr, p); + + return new_p; + +#ifndef MBC_REALLOC_ALWAYS_MOVES + + } + else { + /* We will at least fit in cand_blk */ + + new_blk = (*allctr->get_free_block)(allctr, + blk_sz, + cand_blk, + cand_blk_sz); + move_into_new_blk: + /* + * new_blk, and cand_blk have to be correctly set + * when jumping to this label. + */ + + if (new_blk) { + mbc_alloc_finalize(allctr, + new_blk, + BLK_SZ(new_blk), + GET_BLK_HDR_FLGS(new_blk), + blk_sz, + 1); + new_p = BLK2UMEM(new_blk); + sys_memcpy(new_p, p, MIN(size, old_blk_sz - ABLK_HDR_SZ)); + mbc_free(allctr, p); + return new_p; + } + else { + Uint new_blk_sz; + Uint new_blk_flgs; + Uint prev_blk_sz; + Uint blk_cpy_sz; + + ASSERT(IS_PREV_BLK_FREE(blk)); + ASSERT(cand_blk == PREV_BLK(blk)); + + prev_blk_sz = PREV_BLK_SZ(blk); + new_blk = cand_blk; + new_blk_sz = prev_blk_sz + old_blk_sz; + new_blk_flgs = GET_BLK_HDR_FLGS(new_blk); + + HARD_CHECK_BLK_CARRIER(allctr, blk); + + (*allctr->unlink_free_block)(allctr, new_blk); /* prev */ + + if (is_last_blk) + new_blk_flgs |= LAST_BLK_HDR_FLG; + else { + nxt_blk = NXT_BLK(blk); + if (IS_FREE_BLK(nxt_blk)) { + new_blk_flgs |= GET_LAST_BLK_HDR_FLG(nxt_blk); + new_blk_sz += BLK_SZ(nxt_blk); + (*allctr->unlink_free_block)(allctr, nxt_blk); + } + } + + /* + * Copy user-data then update new blocks in mbc_alloc_finalize(). + * mbc_alloc_finalize() may write headers at old location of + * user data; therfore, order is important. + */ + + new_p = BLK2UMEM(new_blk); + blk_cpy_sz = MIN(blk_sz, old_blk_sz); + + if (prev_blk_sz >= blk_cpy_sz) + sys_memcpy(new_p, p, blk_cpy_sz - ABLK_HDR_SZ); + else + sys_memmove(new_p, p, blk_cpy_sz - ABLK_HDR_SZ); + + mbc_alloc_finalize(allctr, + new_blk, + new_blk_sz, + new_blk_flgs, + blk_sz, + 0); + + STAT_MBC_BLK_FREE(allctr, old_blk_sz); + + return new_p; + } + } +#endif /* !MBC_REALLOC_ALWAYS_MOVES */ +} + +#ifdef DEBUG + +#if HAVE_ERTS_MSEG +#define ASSERT_MSEG_UNIT_SIZE_MULTIPLE(CSZ) ASSERT((CSZ) % mseg_unit_size == 0) +#else +#define ASSERT_MSEG_UNIT_SIZE_MULTIPLE(CSZ) +#endif + +#define CHECK_1BLK_CARRIER(A, SBC, MSEGED, C, CSZ, B, BSZ) \ +do { \ + ASSERT(IS_FIRST_BLK((B))); \ + ASSERT(IS_LAST_BLK((B))); \ + ASSERT((CSZ) == CARRIER_SZ((C))); \ + ASSERT((BSZ) == BLK_SZ((B))); \ + ASSERT((BSZ) % sizeof(Unit_t) == 0); \ + if ((SBC)) { \ + ASSERT(IS_SBC_BLK((B))); \ + ASSERT(IS_SB_CARRIER((C))); \ + } \ + else { \ + ASSERT(IS_MBC_BLK((B))); \ + ASSERT(IS_MB_CARRIER((C))); \ + } \ + if ((MSEGED)) { \ + ASSERT(IS_MSEG_CARRIER((C))); \ + ASSERT_MSEG_UNIT_SIZE_MULTIPLE((CSZ)); \ + } \ + else { \ + ASSERT(IS_SYS_ALLOC_CARRIER((C))); \ + ASSERT((CSZ) % sizeof(Unit_t) == 0); \ + } \ +} while (0) + +#else +#define CHECK_1BLK_CARRIER(A, SBC, MSEGED, C, CSZ, B, BSZ) +#endif + + +static Block_t * +create_carrier(Allctr_t *allctr, Uint umem_sz, Uint flags) +{ + Block_t *blk; + Carrier_t *crr; + Uint blk_sz, bcrr_sz, crr_sz; +#if HAVE_ERTS_MSEG + int have_tried_sys_alloc = 0, have_tried_mseg = 0; +#endif +#ifdef DEBUG + int is_mseg = 0; +#endif + + ASSERT((flags & CFLG_SBC && !(flags & CFLG_MBC)) + || (flags & CFLG_MBC && !(flags & CFLG_SBC))); + + blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); + +#if HAVE_ERTS_MSEG + + if (flags & CFLG_FORCE_SYS_ALLOC) + goto try_sys_alloc; + if (flags & CFLG_FORCE_MSEG) + goto try_mseg; + if (erts_mseg_no() >= max_mseg_carriers) + goto try_sys_alloc; + if (flags & CFLG_SBC) { + if (allctr->sbcs.curr_mseg.no >= allctr->max_mseg_sbcs) + goto try_sys_alloc; + } + else { + if (allctr->mbcs.curr_mseg.no >= allctr->max_mseg_mbcs) + goto try_sys_alloc; + } + + try_mseg: + + if (flags & CFLG_SBC) { + crr_sz = blk_sz + allctr->sbc_header_size; + } + else { + crr_sz = (*allctr->get_next_mbc_size)(allctr); + if (crr_sz < allctr->mbc_header_size + blk_sz) + crr_sz = allctr->mbc_header_size + blk_sz; +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (sizeof(Unit_t) == sizeof(Uint)) + crr_sz += sizeof(Uint); +#endif + } + crr_sz = MSEG_UNIT_CEILING(crr_sz); + ASSERT(crr_sz % mseg_unit_size == 0); + + crr = (Carrier_t *) alcu_mseg_alloc(allctr, &crr_sz); + if (!crr) { + have_tried_mseg = 1; + if (!(have_tried_sys_alloc || flags & CFLG_FORCE_MSEG)) + goto try_sys_alloc; + return NULL; + } + +#ifdef DEBUG + is_mseg = 1; +#endif + if (flags & CFLG_SBC) { + SET_CARRIER_HDR(crr, crr_sz, SCH_MSEG|SCH_SBC); + STAT_MSEG_SBC_ALLOC(allctr, crr_sz, blk_sz); + goto sbc_final_touch; + } + else { + SET_CARRIER_HDR(crr, crr_sz, SCH_MSEG|SCH_MBC); + STAT_MSEG_MBC_ALLOC(allctr, crr_sz); + goto mbc_final_touch; + } + + try_sys_alloc: +#endif /* #if HAVE_ERTS_MSEG */ + + if (flags & CFLG_SBC) { + bcrr_sz = blk_sz + allctr->sbc_header_size; + } + else { + bcrr_sz = allctr->mbc_header_size + blk_sz; + if (!(flags & CFLG_MAIN_CARRIER) + && bcrr_sz < allctr->smallest_mbc_size) + bcrr_sz = allctr->smallest_mbc_size; +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (sizeof(Unit_t) == sizeof(Uint)) + bcrr_sz += sizeof(Uint); +#endif + + } + + crr_sz = (flags & CFLG_FORCE_SIZE + ? UNIT_CEILING(bcrr_sz) + : SYS_ALLOC_CARRIER_CEILING(bcrr_sz)); + + crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz); + + if (!crr) { + if (crr_sz > UNIT_CEILING(bcrr_sz)) { + crr_sz = UNIT_CEILING(bcrr_sz); + crr = (Carrier_t *) alcu_sys_alloc(allctr, crr_sz); + } + if (!crr) { +#if HAVE_ERTS_MSEG + have_tried_sys_alloc = 1; + if (!(have_tried_mseg || flags & CFLG_FORCE_SYS_ALLOC)) + goto try_mseg; +#endif + return NULL; + } + } + if (flags & CFLG_SBC) { + SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_SBC); + STAT_SYS_ALLOC_SBC_ALLOC(allctr, crr_sz, blk_sz); + +#if HAVE_ERTS_MSEG + sbc_final_touch: +#endif + + blk = SBC2BLK(allctr, crr); + + SET_SBC_BLK_FTR(((Uint *) blk)[-1]); + SET_BLK_HDR(blk, blk_sz, SBH_THIS_ALLOCED|SBH_PREV_FREE|SBH_LAST_BLK); + + link_carrier(&allctr->sbc_list, crr); + + CHECK_1BLK_CARRIER(allctr, 1, is_mseg, crr, crr_sz, blk, blk_sz); + + } + else { + SET_CARRIER_HDR(crr, crr_sz, SCH_SYS_ALLOC|SCH_MBC); + STAT_SYS_ALLOC_MBC_ALLOC(allctr, crr_sz); + +#if HAVE_ERTS_MSEG + mbc_final_touch: +#endif + + blk = MBC2FBLK(allctr, crr); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (sizeof(Unit_t) == sizeof(Uint)) + crr_sz -= sizeof(Uint); +#endif + + blk_sz = UNIT_FLOOR(crr_sz - allctr->mbc_header_size); + + SET_MBC_BLK_FTR(((Uint *) blk)[-1]); + SET_BLK_HDR(blk, blk_sz, SBH_THIS_FREE|SBH_PREV_FREE|SBH_LAST_BLK); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + *((Carrier_t **) NXT_BLK(blk)) = crr; +#endif + + if (flags & CFLG_MAIN_CARRIER) { + ASSERT(!allctr->main_carrier); + allctr->main_carrier = crr; + } + + link_carrier(&allctr->mbc_list, crr); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (sizeof(Unit_t) == sizeof(Uint)) + crr_sz += sizeof(Uint); +#endif + CHECK_1BLK_CARRIER(allctr, 0, is_mseg, crr, crr_sz, blk, blk_sz); +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + if (sizeof(Unit_t) == sizeof(Uint)) + crr_sz -= sizeof(Uint); +#endif + if (allctr->creating_mbc) + (*allctr->creating_mbc)(allctr, crr); + + } + + DEBUG_SAVE_ALIGNMENT(crr); + return blk; +} + +static Block_t * +resize_carrier(Allctr_t *allctr, Block_t *old_blk, Uint umem_sz, Uint flags) +{ + Block_t *new_blk; + Carrier_t *new_crr, *old_crr; + Uint create_flags, old_crr_sz, old_blk_sz, new_blk_sz, new_crr_sz; + Uint new_bcrr_sz; + + if (flags & CFLG_MBC) { + ASSERT(0); + return NULL; + } + + ASSERT(flags & CFLG_SBC); + create_flags = flags|CFLG_SBC; + + HARD_CHECK_BLK_CARRIER(allctr, old_blk); + + old_blk_sz = BLK_SZ(old_blk); + old_crr = BLK2SBC(allctr, old_blk); + old_crr_sz = CARRIER_SZ(old_crr); + ASSERT(IS_SB_CARRIER(old_crr)); + ASSERT(IS_SBC_BLK(old_blk)); + + new_blk_sz = UMEMSZ2BLKSZ(allctr, umem_sz); + +#if HAVE_ERTS_MSEG + + if (IS_MSEG_CARRIER(old_crr)) { + STAT_MSEG_SBC_FREE(allctr, old_crr_sz, old_blk_sz); + + if (!(flags & CFLG_FORCE_SYS_ALLOC)) { + + new_crr_sz = new_blk_sz + allctr->sbc_header_size; + new_crr_sz = MSEG_UNIT_CEILING(new_crr_sz); + new_crr = (Carrier_t *) alcu_mseg_realloc(allctr, + old_crr, + old_crr_sz, + &new_crr_sz); + if (new_crr) { + SET_CARRIER_SZ(new_crr, new_crr_sz); + new_blk = SBC2BLK(allctr, new_crr); + SET_BLK_SZ(new_blk, new_blk_sz); + STAT_MSEG_SBC_ALLOC(allctr, new_crr_sz, new_blk_sz); + relink_carrier(&allctr->sbc_list, new_crr); + CHECK_1BLK_CARRIER(allctr, 1, 1, new_crr, new_crr_sz, + new_blk, new_blk_sz); + DEBUG_SAVE_ALIGNMENT(new_crr); + return new_blk; + } + create_flags |= CFLG_FORCE_SYS_ALLOC; /* since mseg_realloc() + failed */ + } + + new_blk = create_carrier(allctr, umem_sz, create_flags); + if (new_blk) { + sys_memcpy((void *) BLK2UMEM(new_blk), + (void *) BLK2UMEM(old_blk), + MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ); + unlink_carrier(&allctr->sbc_list, old_crr); + alcu_mseg_dealloc(allctr, old_crr, old_crr_sz); + } + else { + /* Old carrier unchanged; restore stat */ + STAT_MSEG_SBC_ALLOC(allctr, old_crr_sz, old_blk_sz); + } + + return new_blk; + } + else { + if (!(flags & CFLG_FORCE_MSEG)) { +#endif /* #if HAVE_ERTS_MSEG */ + new_bcrr_sz = new_blk_sz + allctr->sbc_header_size; + new_crr_sz = (flags & CFLG_FORCE_SIZE + ? UNIT_CEILING(new_bcrr_sz) + : SYS_ALLOC_CARRIER_CEILING(new_bcrr_sz)); + + new_crr = (Carrier_t *) alcu_sys_realloc(allctr, + (void *) old_crr, + new_crr_sz); + if (new_crr) { + sys_realloc_success: + SET_CARRIER_SZ(new_crr, new_crr_sz); + new_blk = SBC2BLK(allctr, new_crr); + SET_BLK_SZ(new_blk, new_blk_sz); + STAT_SYS_ALLOC_SBC_FREE(allctr, old_crr_sz, old_blk_sz); + STAT_SYS_ALLOC_SBC_ALLOC(allctr, new_crr_sz, new_blk_sz); + relink_carrier(&allctr->sbc_list, new_crr); + CHECK_1BLK_CARRIER(allctr, 1, 0, new_crr, new_crr_sz, + new_blk, new_blk_sz); + DEBUG_SAVE_ALIGNMENT(new_crr); + return new_blk; + } + else if (new_crr_sz > UNIT_CEILING(new_bcrr_sz)) { + new_crr_sz = new_blk_sz + allctr->sbc_header_size; + new_crr_sz = UNIT_CEILING(new_crr_sz); + new_crr = (Carrier_t *) alcu_sys_realloc(allctr, + (void *) old_crr, + new_crr_sz); + if (new_crr) + goto sys_realloc_success; + } + +#if !HAVE_ERTS_MSEG + return NULL; +#else + create_flags |= CFLG_FORCE_MSEG; /* Since sys_realloc() failed */ + } + + STAT_SYS_ALLOC_SBC_FREE(allctr, old_crr_sz, old_blk_sz); + + new_blk = create_carrier(allctr, umem_sz, create_flags); + if (new_blk) { + sys_memcpy((void *) BLK2UMEM(new_blk), + (void *) BLK2UMEM(old_blk), + MIN(new_blk_sz, old_blk_sz) - ABLK_HDR_SZ); + unlink_carrier(&allctr->sbc_list, old_crr); + alcu_sys_free(allctr, old_crr); + } + else { + /* Old carrier unchanged; restore... */ + STAT_SYS_ALLOC_SBC_ALLOC(allctr, old_crr_sz, old_blk_sz); + } + DEBUG_SAVE_ALIGNMENT(new_crr); + return new_blk; + } +#endif +} + +static void +destroy_carrier(Allctr_t *allctr, Block_t *blk) +{ + Uint crr_sz; + Carrier_t *crr; +#if HAVE_ERTS_MSEG + Uint is_mseg = 0; +#endif + + ASSERT(IS_FIRST_BLK(blk)); + + if (IS_SBC_BLK(blk)) { + Uint blk_sz = BLK_SZ(blk); + crr = BLK2SBC(allctr, blk); + crr_sz = CARRIER_SZ(crr); + + ASSERT(IS_LAST_BLK(blk)); + + HARD_CHECK_BLK_CARRIER(allctr, blk); + +#if HAVE_ERTS_MSEG + if (IS_MSEG_CARRIER(crr)) { + is_mseg++; + ASSERT(crr_sz % mseg_unit_size == 0); + STAT_MSEG_SBC_FREE(allctr, crr_sz, blk_sz); + } + else +#endif + STAT_SYS_ALLOC_SBC_FREE(allctr, crr_sz, blk_sz); + + unlink_carrier(&allctr->sbc_list, crr); + + } + else { + crr = FBLK2MBC(allctr, blk); + crr_sz = CARRIER_SZ(crr); + +#ifdef DEBUG + if (!allctr->stopped) { + ASSERT(IS_LAST_BLK(blk)); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + (*allctr->link_free_block)(allctr, blk); + HARD_CHECK_BLK_CARRIER(allctr, blk); + (*allctr->unlink_free_block)(allctr, blk); +#endif + } +#endif + +#if HAVE_ERTS_MSEG + if (IS_MSEG_CARRIER(crr)) { + is_mseg++; + ASSERT(crr_sz % mseg_unit_size == 0); + STAT_MSEG_MBC_FREE(allctr, crr_sz); + } + else +#endif + STAT_SYS_ALLOC_MBC_FREE(allctr, crr_sz); + + unlink_carrier(&allctr->mbc_list, crr); + if (allctr->destroying_mbc) + (*allctr->destroying_mbc)(allctr, crr); + } + + +#if HAVE_ERTS_MSEG + if (is_mseg) { + alcu_mseg_dealloc(allctr, crr, crr_sz); + } + else +#endif + alcu_sys_free(allctr, crr); +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Info stuff * +\* */ + +static struct { + Eterm versions; + + Eterm options; + Eterm e; + Eterm t; + Eterm ramv; + Eterm sbct; +#if HAVE_ERTS_MSEG + Eterm asbcst; + Eterm rsbcst; +#endif + Eterm rsbcmt; + Eterm rmbcmt; + Eterm mmbcs; + Eterm msbclt; +#if HAVE_ERTS_MSEG + Eterm mmsbc; + Eterm mmmbc; +#endif + Eterm lmbcs; + Eterm smbcs; + Eterm mbcgs; + +#if HAVE_ERTS_MSEG + Eterm mmc; +#endif + Eterm ycs; + + Eterm mbcs; + Eterm sbcs; + Eterm sys_alloc_carriers_size; +#if HAVE_ERTS_MSEG + Eterm mseg_alloc_carriers_size; +#endif + Eterm carriers_size; + Eterm sys_alloc_carriers; +#if HAVE_ERTS_MSEG + Eterm mseg_alloc_carriers; +#endif + Eterm carriers; + Eterm blocks_size; + Eterm blocks; + + Eterm calls; + Eterm sys_alloc; + Eterm sys_free; + Eterm sys_realloc; +#if HAVE_ERTS_MSEG + Eterm mseg_alloc; + Eterm mseg_dealloc; + Eterm mseg_realloc; +#endif +#ifdef DEBUG + Eterm end_of_atoms; +#endif +} am; + +static ERTS_INLINE void atom_init(Eterm *atom, char *name) +{ + *atom = am_atom_put(name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static erts_mtx_t init_atoms_mtx; + +static void +init_atoms(Allctr_t *allctr) +{ + +#ifdef USE_THREADS + if (allctr && allctr->thread_safe) + erts_mtx_unlock(&allctr->mutex); +#endif + + erts_mtx_lock(&init_atoms_mtx); + + if (!atoms_initialized) { +#ifdef DEBUG + Eterm *atom; + + for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) { + *atom = THE_NON_VALUE; + } +#endif + + AM_INIT(versions); + + AM_INIT(options); + AM_INIT(e); + AM_INIT(t); + AM_INIT(ramv); + AM_INIT(sbct); +#if HAVE_ERTS_MSEG + AM_INIT(asbcst); + AM_INIT(rsbcst); +#endif + AM_INIT(rsbcmt); + AM_INIT(rmbcmt); + AM_INIT(mmbcs); + AM_INIT(msbclt); +#if HAVE_ERTS_MSEG + AM_INIT(mmsbc); + AM_INIT(mmmbc); +#endif + AM_INIT(lmbcs); + AM_INIT(smbcs); + AM_INIT(mbcgs); + +#if HAVE_ERTS_MSEG + AM_INIT(mmc); +#endif + AM_INIT(ycs); + + AM_INIT(mbcs); + AM_INIT(sbcs); + AM_INIT(sys_alloc_carriers_size); +#if HAVE_ERTS_MSEG + AM_INIT(mseg_alloc_carriers_size); +#endif + AM_INIT(carriers_size); + AM_INIT(sys_alloc_carriers); +#if HAVE_ERTS_MSEG + AM_INIT(mseg_alloc_carriers); +#endif + AM_INIT(carriers); + AM_INIT(blocks_size); + AM_INIT(blocks); + + AM_INIT(calls); + AM_INIT(sys_alloc); + AM_INIT(sys_free); + AM_INIT(sys_realloc); +#if HAVE_ERTS_MSEG + AM_INIT(mseg_alloc); + AM_INIT(mseg_dealloc); + AM_INIT(mseg_realloc); +#endif + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { + ASSERT(*atom != THE_NON_VALUE); + } +#endif + } + + + if (allctr) { + + make_name_atoms(allctr); + + (*allctr->init_atoms)(); + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); +#endif + allctr->atoms_initialized = 1; + } + + atoms_initialized = 1; + erts_mtx_unlock(&init_atoms_mtx); + +} + +static ERTS_INLINE void +ensure_atoms_initialized(Allctr_t *allctr) +{ + if (!allctr || !allctr->atoms_initialized) + init_atoms(allctr); +} + +#define bld_uint erts_bld_uint +#define bld_cons erts_bld_cons +#define bld_tuple erts_bld_tuple +#define bld_string erts_bld_string + +/* + * bld_unstable_uint() (instead bld_uint()) is used when values may + * change between size check and actual build. This because a value + * that would fit a small when size check is done may need to be built + * as a big when the actual build is performed. Caller is required to + * HRelease after build. + */ +static ERTS_INLINE Eterm +bld_unstable_uint(Uint **hpp, Uint *szp, Uint ui) +{ + Eterm res = THE_NON_VALUE; + if (szp) + *szp += BIG_UINT_HEAP_SIZE; + if (hpp) { + if (IS_USMALL(0, ui)) + res = make_small(ui); + else { + res = uint_to_big(ui, *hpp); + *hpp += BIG_UINT_HEAP_SIZE; + } + } + return res; +} + +static ERTS_INLINE void +add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 2, el1, el2), *lp); +} + +static ERTS_INLINE void +add_3tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2, Eterm el3) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 3, el1, el2, el3), *lp); +} + +static ERTS_INLINE void +add_4tup(Uint **hpp, Uint *szp, Eterm *lp, + Eterm el1, Eterm el2, Eterm el3, Eterm el4) +{ + *lp = + bld_cons(hpp, szp, bld_tuple(hpp, szp, 4, el1, el2, el3, el4), *lp); +} + +static Eterm +sz_info_carriers(Allctr_t *allctr, + CarriersStats_t *cs, + char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + Uint curr_size = cs->curr_mseg.size + cs->curr_sys_alloc.size; + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + erts_print(to, + arg, + "%sblocks size: %bpu %bpu %bpu\n", + prefix, + cs->blocks.curr.size, + cs->blocks.max.size, + cs->blocks.max_ever.size); + erts_print(to, + arg, + "%scarriers size: %bpu %bpu %bpu\n", + prefix, + curr_size, + cs->max.size, + cs->max_ever.size); + } + + if (hpp || szp) { + res = NIL; + add_4tup(hpp, szp, &res, + am.carriers_size, + bld_unstable_uint(hpp, szp, curr_size), + bld_unstable_uint(hpp, szp, cs->max.size), + bld_unstable_uint(hpp, szp, cs->max_ever.size)); + add_4tup(hpp, szp, &res, + am.blocks_size, + bld_unstable_uint(hpp, szp, cs->blocks.curr.size), + bld_unstable_uint(hpp, szp, cs->blocks.max.size), + bld_unstable_uint(hpp, szp, cs->blocks.max_ever.size)); + } + + return res; +} + +static Eterm +info_carriers(Allctr_t *allctr, + CarriersStats_t *cs, + char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + Uint curr_no = cs->curr_mseg.no + cs->curr_sys_alloc.no; + Uint curr_size = cs->curr_mseg.size + cs->curr_sys_alloc.size; + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + erts_print(to, + arg, + "%sblocks: %bpu %bpu %bpu\n", + prefix, + cs->blocks.curr.no, + cs->blocks.max.no, + cs->blocks.max_ever.no); + erts_print(to, + arg, + "%sblocks size: %bpu %bpu %bpu\n", + prefix, + cs->blocks.curr.size, + cs->blocks.max.size, + cs->blocks.max_ever.size); + erts_print(to, + arg, + "%scarriers: %bpu %bpu %bpu\n", + prefix, + curr_no, + cs->max.no, + cs->max_ever.no); +#if HAVE_ERTS_MSEG + erts_print(to, + arg, + "%smseg carriers: %bpu\n", + prefix, + cs->curr_mseg.no); +#endif + erts_print(to, + arg, + "%ssys_alloc carriers: %bpu\n", + prefix, + cs->curr_sys_alloc.no); + erts_print(to, + arg, + "%scarriers size: %bpu %bpu %bpu\n", + prefix, + curr_size, + cs->max.size, + cs->max_ever.size); +#if HAVE_ERTS_MSEG + erts_print(to, + arg, + "%smseg carriers size: %bpu\n", + prefix, + cs->curr_mseg.size); +#endif + erts_print(to, + arg, + "%ssys_alloc carriers size: %bpu\n", + prefix, + cs->curr_sys_alloc.size); + } + + if (hpp || szp) { + res = NIL; + add_2tup(hpp, szp, &res, + am.sys_alloc_carriers_size, + bld_unstable_uint(hpp, szp, cs->curr_sys_alloc.size)); +#if HAVE_ERTS_MSEG + add_2tup(hpp, szp, &res, + am.mseg_alloc_carriers_size, + bld_unstable_uint(hpp, szp, cs->curr_mseg.size)); +#endif + add_4tup(hpp, szp, &res, + am.carriers_size, + bld_unstable_uint(hpp, szp, curr_size), + bld_unstable_uint(hpp, szp, cs->max.size), + bld_unstable_uint(hpp, szp, cs->max_ever.size)); + add_2tup(hpp, szp, &res, + am.sys_alloc_carriers, + bld_unstable_uint(hpp, szp, cs->curr_sys_alloc.no)); +#if HAVE_ERTS_MSEG + add_2tup(hpp, szp, &res, + am.mseg_alloc_carriers, + bld_unstable_uint(hpp, szp, cs->curr_mseg.no)); +#endif + add_4tup(hpp, szp, &res, + am.carriers, + bld_unstable_uint(hpp, szp, curr_no), + bld_unstable_uint(hpp, szp, cs->max.no), + bld_unstable_uint(hpp, szp, cs->max_ever.no)); + add_4tup(hpp, szp, &res, + am.blocks_size, + bld_unstable_uint(hpp, szp, cs->blocks.curr.size), + bld_unstable_uint(hpp, szp, cs->blocks.max.size), + bld_unstable_uint(hpp, szp, cs->blocks.max_ever.size)); + add_4tup(hpp, szp, &res, + am.blocks, + bld_unstable_uint(hpp, szp, cs->blocks.curr.no), + bld_unstable_uint(hpp, szp, cs->blocks.max.no), + bld_unstable_uint(hpp, szp, cs->blocks.max_ever.no)); + } + + return res; +} + +static void +make_name_atoms(Allctr_t *allctr) +{ + char alloc[] = "alloc"; + char realloc[] = "realloc"; + char free[] = "free"; + char buf[MAX_ATOM_LENGTH]; + size_t prefix_len = strlen(allctr->name_prefix); + + if (prefix_len > MAX_ATOM_LENGTH + sizeof(realloc) - 1) + erl_exit(1,"Too long allocator name: %salloc\n",allctr->name_prefix); + + memcpy((void *) buf, (void *) allctr->name_prefix, prefix_len); + + memcpy((void *) &buf[prefix_len], (void *) alloc, sizeof(alloc) - 1); + allctr->name.alloc = am_atom_put(buf, prefix_len + sizeof(alloc) - 1); + + memcpy((void *) &buf[prefix_len], (void *) realloc, sizeof(realloc) - 1); + allctr->name.realloc = am_atom_put(buf, prefix_len + sizeof(realloc) - 1); + + memcpy((void *) &buf[prefix_len], (void *) free, sizeof(free) - 1); + allctr->name.free = am_atom_put(buf, prefix_len + sizeof(free) - 1); + +} + +static Eterm +info_calls(Allctr_t *allctr, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + + if (print_to_p) { + +#define PRINT_CC_4(TO, TOA, NAME, CC) \ + if ((CC).giga_no == 0) \ + erts_print(TO, TOA, "%s calls: %bpu\n", NAME, CC.no); \ + else \ + erts_print(TO, TOA, "%s calls: %bpu%09lu\n", NAME, CC.giga_no, CC.no) + +#define PRINT_CC_5(TO, TOA, PRFX, NAME, CC) \ + if ((CC).giga_no == 0) \ + erts_print(TO, TOA, "%s%s calls: %bpu\n",PRFX,NAME,CC.no); \ + else \ + erts_print(TO, TOA, "%s%s calls: %bpu%09lu\n",PRFX,NAME,CC.giga_no,CC.no) + + char *prefix = allctr->name_prefix; + int to = *print_to_p; + void *arg = print_to_arg; + + PRINT_CC_5(to, arg, prefix, "alloc", allctr->calls.this_alloc); + PRINT_CC_5(to, arg, prefix, "free", allctr->calls.this_free); + PRINT_CC_5(to, arg, prefix, "realloc", allctr->calls.this_realloc); + +#if HAVE_ERTS_MSEG + PRINT_CC_4(to, arg, "mseg_alloc", allctr->calls.mseg_alloc); + PRINT_CC_4(to, arg, "mseg_dealloc", allctr->calls.mseg_dealloc); + PRINT_CC_4(to, arg, "mseg_realloc", allctr->calls.mseg_realloc); +#endif + + PRINT_CC_4(to, arg, "sys_alloc", allctr->calls.sys_alloc); + PRINT_CC_4(to, arg, "sys_free", allctr->calls.sys_free); + PRINT_CC_4(to, arg, "sys_realloc", allctr->calls.sys_realloc); + +#undef PRINT_CC_4 +#undef PRINT_CC_5 + + } + + + if (hpp || szp) { + + ASSERT(allctr->name.alloc != THE_NON_VALUE); + ASSERT(allctr->name.realloc != THE_NON_VALUE); + ASSERT(allctr->name.free != THE_NON_VALUE); + + res = NIL; + + add_3tup(hpp, szp, &res, + am.sys_realloc, + bld_unstable_uint(hpp, szp, allctr->calls.sys_realloc.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.sys_realloc.no)); + add_3tup(hpp, szp, &res, + am.sys_free, + bld_unstable_uint(hpp, szp, allctr->calls.sys_free.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.sys_free.no)); + add_3tup(hpp, szp, &res, + am.sys_alloc, + bld_unstable_uint(hpp, szp, allctr->calls.sys_alloc.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.sys_alloc.no)); +#if HAVE_ERTS_MSEG + add_3tup(hpp, szp, &res, + am.mseg_realloc, + bld_unstable_uint(hpp, szp, allctr->calls.mseg_realloc.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.mseg_realloc.no)); + add_3tup(hpp, szp, &res, + am.mseg_dealloc, + bld_unstable_uint(hpp, szp, allctr->calls.mseg_dealloc.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.mseg_dealloc.no)); + add_3tup(hpp, szp, &res, + am.mseg_alloc, + bld_unstable_uint(hpp, szp, allctr->calls.mseg_alloc.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.mseg_alloc.no)); +#endif + add_3tup(hpp, szp, &res, + allctr->name.realloc, + bld_unstable_uint(hpp, szp, allctr->calls.this_realloc.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.this_realloc.no)); + add_3tup(hpp, szp, &res, + allctr->name.free, + bld_unstable_uint(hpp, szp, allctr->calls.this_free.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.this_free.no)); + add_3tup(hpp, szp, &res, + allctr->name.alloc, + bld_unstable_uint(hpp, szp, allctr->calls.this_alloc.giga_no), + bld_unstable_uint(hpp, szp, allctr->calls.this_alloc.no)); + } + + return res; +} + +static Eterm +info_options(Allctr_t *allctr, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + if (!allctr) { + if (print_to_p) + erts_print(*print_to_p, print_to_arg, "option e: false\n"); + if (hpp || szp) { + res = NIL; + add_2tup(hpp, szp, &res, am.e, am_false); + } + return res; + } + + if (print_to_p) { + char topt[21]; /* Enough for any 64-bit integer */ + if (allctr->t) + erts_snprintf(&topt[0], sizeof(topt), "%d", allctr->t); + else + erts_snprintf(&topt[0], sizeof(topt), "false"); + erts_print(*print_to_p, + print_to_arg, + "option e: true\n" + "option t: %s\n" + "option ramv: %s\n" + "option sbct: %bpu\n" +#if HAVE_ERTS_MSEG + "option asbcst: %bpu\n" + "option rsbcst: %bpu\n" +#endif + "option rsbcmt: %bpu\n" + "option rmbcmt: %bpu\n" + "option mmbcs: %bpu\n" +#if HAVE_ERTS_MSEG + "option mmsbc: %bpu\n" + "option mmmbc: %bpu\n" +#endif + "option lmbcs: %bpu\n" + "option smbcs: %bpu\n" + "option mbcgs: %bpu\n", + topt, + allctr->ramv ? "true" : "false", + allctr->sbc_threshold, +#if HAVE_ERTS_MSEG + allctr->mseg_opt.abs_shrink_th, + allctr->mseg_opt.rel_shrink_th, +#endif + allctr->sbc_move_threshold, + allctr->mbc_move_threshold, + allctr->main_carrier_size, +#if HAVE_ERTS_MSEG + allctr->max_mseg_sbcs, + allctr->max_mseg_mbcs, +#endif + allctr->largest_mbc_size, + allctr->smallest_mbc_size, + allctr->mbc_growth_stages); + } + + res = (*allctr->info_options)(allctr, "option ", print_to_p, print_to_arg, + hpp, szp); + + if (hpp || szp) { + add_2tup(hpp, szp, &res, + am.mbcgs, + bld_uint(hpp, szp, allctr->mbc_growth_stages)); + add_2tup(hpp, szp, &res, + am.smbcs, + bld_uint(hpp, szp, allctr->smallest_mbc_size)); + add_2tup(hpp, szp, &res, + am.lmbcs, + bld_uint(hpp, szp, allctr->largest_mbc_size)); +#if HAVE_ERTS_MSEG + add_2tup(hpp, szp, &res, + am.mmsbc, + bld_uint(hpp, szp, allctr->max_mseg_sbcs)); + add_2tup(hpp, szp, &res, + am.mmmbc, + bld_uint(hpp, szp, allctr->max_mseg_mbcs)); +#endif + add_2tup(hpp, szp, &res, + am.mmbcs, + bld_uint(hpp, szp, allctr->main_carrier_size)); + add_2tup(hpp, szp, &res, + am.rmbcmt, + bld_uint(hpp, szp, allctr->mbc_move_threshold)); + add_2tup(hpp, szp, &res, + am.rsbcmt, + bld_uint(hpp, szp, allctr->sbc_move_threshold)); +#if HAVE_ERTS_MSEG + add_2tup(hpp, szp, &res, + am.rsbcst, + bld_uint(hpp, szp, allctr->mseg_opt.rel_shrink_th)); + add_2tup(hpp, szp, &res, + am.asbcst, + bld_uint(hpp, szp, allctr->mseg_opt.abs_shrink_th)); +#endif + add_2tup(hpp, szp, &res, + am.sbct, + bld_uint(hpp, szp, allctr->sbc_threshold)); + add_2tup(hpp, szp, &res, am.ramv, allctr->ramv ? am_true : am_false); + add_2tup(hpp, szp, &res, am.t, (allctr->t + ? bld_uint(hpp, szp, (Uint) allctr->t) + : am_false)); + add_2tup(hpp, szp, &res, am.e, am_true); + } + + return res; +} + + +static ERTS_INLINE void +update_max_ever_values(CarriersStats_t *cs) +{ + if (cs->max_ever.no < cs->max.no) + cs->max_ever.no = cs->max.no; + if (cs->max_ever.size < cs->max.size) + cs->max_ever.size = cs->max.size; + if (cs->blocks.max_ever.no < cs->blocks.max.no) + cs->blocks.max_ever.no = cs->blocks.max.no; + if (cs->blocks.max_ever.size < cs->blocks.max.size) + cs->blocks.max_ever.size = cs->blocks.max.size; +} + +static ERTS_INLINE void +reset_max_values(CarriersStats_t *cs) +{ + cs->max.no = cs->curr_mseg.no + cs->curr_sys_alloc.no; + cs->max.size = cs->curr_mseg.size + cs->curr_sys_alloc.size; + cs->blocks.max.no = cs->blocks.curr.no; + cs->blocks.max.size = cs->blocks.curr.size; +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Exported functions * +\* */ + +Eterm +erts_alcu_au_info_options(int *print_to_p, void *print_to_arg, + Uint **hpp, Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + + erts_print(*print_to_p, + print_to_arg, +#if HAVE_ERTS_MSEG + "option mmc: %bpu\n" +#endif + "option ycs: %bpu\n", +#if HAVE_ERTS_MSEG + max_mseg_carriers, +#endif + sys_alloc_carrier_size); + } + + if (hpp || szp) { + res = NIL; + ensure_atoms_initialized(NULL); + add_2tup(hpp, szp, &res, + am.ycs, + bld_uint(hpp, szp, sys_alloc_carrier_size)); +#if HAVE_ERTS_MSEG + add_2tup(hpp, szp, &res, + am.mmc, + bld_uint(hpp, szp, max_mseg_carriers)); +#endif + } + + return res; +} + + +Eterm +erts_alcu_info_options(Allctr_t *allctr, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res; + + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); +#endif + if (hpp || szp) + ensure_atoms_initialized(allctr); + res = info_options(allctr, print_to_p, print_to_arg, hpp, szp); +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_unlock(&allctr->mutex); +#endif + return res; +} + +/* ----------------------------------------------------------------------- */ + +Eterm +erts_alcu_sz_info(Allctr_t *allctr, + int begin_max_period, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res, mbcs, sbcs; + + res = THE_NON_VALUE; + + if (!allctr) { + if (print_to_p) + erts_print(*print_to_p, print_to_arg, "false\n"); + if (szp) + *szp = 0; + return am_false; + } + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); +#endif + + if (hpp || szp) + ensure_atoms_initialized(allctr); + + /* Update sbc values not continously updated */ + allctr->sbcs.blocks.curr.no + = allctr->sbcs.curr_mseg.no + allctr->sbcs.curr_sys_alloc.no; + allctr->sbcs.blocks.max.no = allctr->sbcs.max.no; + + update_max_ever_values(&allctr->mbcs); + update_max_ever_values(&allctr->sbcs); + + mbcs = sz_info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, + print_to_arg, hpp, szp); + sbcs = sz_info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p, + print_to_arg, hpp, szp); + + if (hpp || szp) { + res = NIL; + add_2tup(hpp, szp, &res, am.sbcs, sbcs); + add_2tup(hpp, szp, &res, am.mbcs, mbcs); + } + + if (begin_max_period) { + reset_max_values(&allctr->mbcs); + reset_max_values(&allctr->sbcs); + } + + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_unlock(&allctr->mutex); +#endif + + return res; +} + +Eterm +erts_alcu_info(Allctr_t *allctr, + int begin_max_period, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res, sett, mbcs, sbcs, calls; + + res = THE_NON_VALUE; + + if (!allctr) { + if (print_to_p) + erts_print(*print_to_p, print_to_arg, "false\n"); + if (szp) + *szp = 0; + return am_false; + } + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); +#endif + + if (hpp || szp) + ensure_atoms_initialized(allctr); + + /* Update sbc values not continously updated */ + allctr->sbcs.blocks.curr.no + = allctr->sbcs.curr_mseg.no + allctr->sbcs.curr_sys_alloc.no; + allctr->sbcs.blocks.max.no = allctr->sbcs.max.no; + + update_max_ever_values(&allctr->mbcs); + update_max_ever_values(&allctr->sbcs); + + if (print_to_p) { + erts_print(*print_to_p, + print_to_arg, + "versions: %s %s\n", + allctr->vsn_str, + ERTS_ALCU_VSN_STR); + } + + sett = info_options(allctr, print_to_p, print_to_arg, hpp, szp); + mbcs = info_carriers(allctr, &allctr->mbcs, "mbcs ", print_to_p, + print_to_arg, hpp, szp); + sbcs = info_carriers(allctr, &allctr->sbcs, "sbcs ", print_to_p, + print_to_arg, hpp, szp); + calls = info_calls(allctr, print_to_p, print_to_arg, hpp, szp); + + if (hpp || szp) { + res = NIL; + + add_2tup(hpp, szp, &res, am.calls, calls); + add_2tup(hpp, szp, &res, am.sbcs, sbcs); + add_2tup(hpp, szp, &res, am.mbcs, mbcs); + add_2tup(hpp, szp, &res, am.options, sett); + add_3tup(hpp, szp, &res, + am.versions, + bld_string(hpp, szp, allctr->vsn_str), + bld_string(hpp, szp, ERTS_ALCU_VSN_STR));; + } + + if (begin_max_period) { + reset_max_values(&allctr->mbcs); + reset_max_values(&allctr->sbcs); + } + + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_unlock(&allctr->mutex); +#endif + + return res; +} + + +void +erts_alcu_current_size(Allctr_t *allctr, AllctrSize_t *size) +{ + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_lock(&allctr->mutex); +#endif + + size->carriers = allctr->mbcs.curr_mseg.size; + size->carriers += allctr->mbcs.curr_sys_alloc.size; + size->carriers += allctr->sbcs.curr_mseg.size; + size->carriers += allctr->sbcs.curr_sys_alloc.size; + + size->blocks = allctr->mbcs.blocks.curr.size; + size->blocks += allctr->sbcs.blocks.curr.size; + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_unlock(&allctr->mutex); +#endif +} + +/* ----------------------------------------------------------------------- */ + +static ERTS_INLINE void * +do_erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) +{ + Allctr_t *allctr = (Allctr_t *) extra; + void *res; + + ASSERT(initialized); + + ASSERT(allctr); + + ERTS_ALCU_DBG_CHK_THR_SPEC(allctr); + +#if ALLOC_ZERO_EQ_NULL + if (!size) + return NULL; +#endif + + INC_CC(allctr->calls.this_alloc); + + if (size >= allctr->sbc_threshold) { + Block_t *blk = create_carrier(allctr, size, CFLG_SBC); + res = blk ? BLK2UMEM(blk) : NULL; + } + else + res = mbc_alloc(allctr, size); + + return res; +} + +void *erts_alcu_alloc(ErtsAlcType_t type, void *extra, Uint size) +{ + void *res; + res = do_erts_alcu_alloc(type, extra, size); + DEBUG_CHECK_ALIGNMENT(res); + return res; +} + + +#ifdef USE_THREADS + +void * +erts_alcu_alloc_ts(ErtsAlcType_t type, void *extra, Uint size) +{ + Allctr_t *allctr = (Allctr_t *) extra; + void *res; + erts_mtx_lock(&allctr->mutex); + res = do_erts_alcu_alloc(type, extra, size); + + DEBUG_CHECK_ALIGNMENT(res); + + erts_mtx_unlock(&allctr->mutex); + return res; +} + +void * +erts_alcu_alloc_thr_spec(ErtsAlcType_t type, void *extra, Uint size) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + int ix = erts_alc_get_thr_ix(); + Allctr_t *allctr; + int unlock; + void *res; + + ASSERT(ix > 0); + if (ix < tspec->size) { + allctr = tspec->allctr[ix]; + unlock = 0; + } + else { + allctr = tspec->allctr[0]; + unlock = 1; + erts_mtx_lock(&allctr->mutex); + } + + res = do_erts_alcu_alloc(type, allctr, size); + + if (unlock) + erts_mtx_unlock(&allctr->mutex); + + DEBUG_CHECK_ALIGNMENT(res); + + return res; +} + +void * +erts_alcu_alloc_thr_pref(ErtsAlcType_t type, void *extra, Uint size) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + int ix = erts_alc_get_thr_ix(); + Allctr_t *allctr; + void *res; + + ASSERT(sizeof(Uint) == sizeof(Allctr_t *)); + ASSERT(ix > 0); + if (ix >= tspec->size) + ix = (ix % (tspec->size - 1)) + 1; + allctr = tspec->allctr[ix]; + erts_mtx_lock(&allctr->mutex); + res = do_erts_alcu_alloc(type, allctr, size + sizeof(Uint)); + if (res) { + *((Allctr_t **) res) = allctr; + res = (void *) (((char *) res) + sizeof(Uint)); + } + erts_mtx_unlock(&allctr->mutex); + DEBUG_CHECK_ALIGNMENT(res); + return res; +} + +#endif + +/* ------------------------------------------------------------------------- */ + +static ERTS_INLINE void +do_erts_alcu_free(ErtsAlcType_t type, void *extra, void *p) +{ + Allctr_t *allctr = (Allctr_t *) extra; + ASSERT(initialized); + + ASSERT(allctr); + + ERTS_ALCU_DBG_CHK_THR_SPEC(allctr); + + if (p) { + Block_t *blk; + + INC_CC(allctr->calls.this_free); + + blk = UMEM2BLK(p); + if (IS_SBC_BLK(blk)) + destroy_carrier(allctr, blk); + else + mbc_free(allctr, p); + } +} + +void erts_alcu_free(ErtsAlcType_t type, void *extra, void *p) +{ + do_erts_alcu_free(type, extra, p); +} + +#ifdef USE_THREADS + +void +erts_alcu_free_ts(ErtsAlcType_t type, void *extra, void *p) +{ + Allctr_t *allctr = (Allctr_t *) extra; + erts_mtx_lock(&allctr->mutex); + do_erts_alcu_free(type, extra, p); + erts_mtx_unlock(&allctr->mutex); +} + +void +erts_alcu_free_thr_spec(ErtsAlcType_t type, void *extra, void *p) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + int ix = erts_alc_get_thr_ix(); + int unlock; + Allctr_t *allctr; + + ASSERT(ix > 0); + if (ix < tspec->size) { + allctr = tspec->allctr[ix]; + unlock = 0; + } + else { + allctr = tspec->allctr[0]; + unlock = 1; + erts_mtx_lock(&allctr->mutex); + } + + do_erts_alcu_free(type, allctr, p); + if (unlock) + erts_mtx_unlock(&allctr->mutex); +} + +void +erts_alcu_free_thr_pref(ErtsAlcType_t type, void *unused, void *p) +{ + if (p) { + void *ptr = (void *) (((char *) p) - sizeof(Uint)); + Allctr_t *allctr = *((Allctr_t **) ptr); + erts_mtx_lock(&allctr->mutex); + do_erts_alcu_free(type, allctr, ptr); + erts_mtx_unlock(&allctr->mutex); + } +} + +#endif + +/* ------------------------------------------------------------------------- */ + +static ERTS_INLINE void * +do_erts_alcu_realloc(ErtsAlcType_t type, + void *extra, + void *p, + Uint size, + Uint flgs) +{ + Allctr_t *allctr = (Allctr_t *) extra; + Block_t *blk; + void *res; + + ASSERT(initialized); + + ASSERT(allctr); + + ERTS_ALCU_DBG_CHK_THR_SPEC(allctr); + + if (!p) { + res = do_erts_alcu_alloc(type, extra, size); + INC_CC(allctr->calls.this_realloc); + DEC_CC(allctr->calls.this_alloc); + return res; + } + +#if ALLOC_ZERO_EQ_NULL + if (!size) { + ASSERT(p); + do_erts_alcu_free(type, extra, p); + INC_CC(allctr->calls.this_realloc); + DEC_CC(allctr->calls.this_free); + return NULL; + } +#endif + + INC_CC(allctr->calls.this_realloc); + + blk = UMEM2BLK(p); + + if (size < allctr->sbc_threshold) { + if (IS_MBC_BLK(blk)) + res = mbc_realloc(allctr, p, size, flgs); + else { + Uint used_sz = allctr->sbc_header_size + ABLK_HDR_SZ + size; + Uint crr_sz; + Uint diff_sz_val; + Uint crr_sz_val; + +#if HAVE_ERTS_MSEG + if (IS_SYS_ALLOC_CARRIER(BLK2SBC(allctr, blk))) +#endif + crr_sz = SYS_ALLOC_CARRIER_CEILING(used_sz); +#if HAVE_ERTS_MSEG + else + crr_sz = MSEG_UNIT_CEILING(used_sz); +#endif + diff_sz_val = crr_sz - used_sz; + if (diff_sz_val < (~((Uint) 0) / 100)) + crr_sz_val = crr_sz; + else { + /* div both by 128 */ + crr_sz_val = crr_sz >> 7; + /* A sys_alloc carrier could potentially be + smaller than 128 bytes (but not likely) */ + if (crr_sz_val == 0) + goto do_carrier_resize; + diff_sz_val >>= 7; + } + + if (100*diff_sz_val < allctr->sbc_move_threshold*crr_sz_val) + /* Data won't be copied into a new carrier... */ + goto do_carrier_resize; + else if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + return NULL; + + res = mbc_alloc(allctr, size); + if (res) { + sys_memcpy((void*) res, + (void*) p, + MIN(BLK_SZ(blk) - ABLK_HDR_SZ, size)); + destroy_carrier(allctr, blk); + } + } + } + else { + Block_t *new_blk; + if(IS_SBC_BLK(blk)) { + do_carrier_resize: + new_blk = resize_carrier(allctr, blk, size, CFLG_SBC); + res = new_blk ? BLK2UMEM(new_blk) : NULL; + } + else if (flgs & ERTS_ALCU_FLG_FAIL_REALLOC_MOVE) + return NULL; + else { + new_blk = create_carrier(allctr, size, CFLG_SBC); + if (new_blk) { + res = BLK2UMEM(new_blk); + sys_memcpy((void *) res, + (void *) p, + MIN(BLK_SZ(blk) - ABLK_HDR_SZ, size)); + mbc_free(allctr, p); + } + else + res = NULL; + } + } + + return res; +} + +void * +erts_alcu_realloc(ErtsAlcType_t type, void *extra, void *p, Uint size) +{ + void *res; + res = do_erts_alcu_realloc(type, extra, p, size, 0); + DEBUG_CHECK_ALIGNMENT(res); + return res; +} + +void * +erts_alcu_realloc_mv(ErtsAlcType_t type, void *extra, void *p, Uint size) +{ + void *res; + res = do_erts_alcu_alloc(type, extra, size); + if (!res) + res = erts_alcu_realloc(type, extra, p, size); + else { + Block_t *blk; + size_t cpy_size; + + blk = UMEM2BLK(p); + cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ; + if (cpy_size > size) + cpy_size = size; + sys_memcpy(res, p, cpy_size); + do_erts_alcu_free(type, extra, p); + } + DEBUG_CHECK_ALIGNMENT(res); + return res; +} + + +#ifdef USE_THREADS + +void * +erts_alcu_realloc_ts(ErtsAlcType_t type, void *extra, void *ptr, Uint size) +{ + Allctr_t *allctr = (Allctr_t *) extra; + void *res; + erts_mtx_lock(&allctr->mutex); + res = do_erts_alcu_realloc(type, extra, ptr, size, 0); + erts_mtx_unlock(&allctr->mutex); + DEBUG_CHECK_ALIGNMENT(res); + return res; +} + +void * +erts_alcu_realloc_mv_ts(ErtsAlcType_t type, void *extra, void *p, Uint size) +{ + Allctr_t *allctr = (Allctr_t *) extra; + void *res; + erts_mtx_lock(&allctr->mutex); + res = do_erts_alcu_alloc(type, extra, size); + if (!res) + res = erts_alcu_realloc_ts(type, extra, p, size); + else { + Block_t *blk; + size_t cpy_size; + + blk = UMEM2BLK(p); + cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ; + if (cpy_size > size) + cpy_size = size; + sys_memcpy(res, p, cpy_size); + do_erts_alcu_free(type, extra, p); + } + erts_mtx_unlock(&allctr->mutex); + DEBUG_CHECK_ALIGNMENT(res); + return res; +} + +void * +erts_alcu_realloc_thr_spec(ErtsAlcType_t type, void *extra, + void *ptr, Uint size) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + int ix = erts_alc_get_thr_ix(); + Allctr_t *allctr; + int unlock; + void *res; + + ASSERT(ix > 0); + if (ix < tspec->size) { + allctr = tspec->allctr[ix]; + unlock = 0; + } + else { + allctr = tspec->allctr[0]; + unlock = 1; + erts_mtx_lock(&allctr->mutex); + } + + res = do_erts_alcu_realloc(type, allctr, ptr, size, 0); + + if (unlock) + erts_mtx_unlock(&allctr->mutex); + + DEBUG_CHECK_ALIGNMENT(res); + + return res; +} + +void * +erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t type, void *extra, + void *ptr, Uint size) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + int ix = erts_alc_get_thr_ix(); + Allctr_t *allctr; + int unlock; + void *res; + + ASSERT(ix > 0); + if (ix < tspec->size) { + allctr = tspec->allctr[ix]; + unlock = 0; + } + else { + allctr = tspec->allctr[0]; + unlock = 1; + erts_mtx_lock(&allctr->mutex); + } + + + res = do_erts_alcu_alloc(type, allctr, size); + if (!res) { + if (unlock) + erts_mtx_unlock(&allctr->mutex); + res = erts_alcu_realloc_thr_spec(type, allctr, ptr, size); + } + else { + Block_t *blk; + size_t cpy_size; + + blk = UMEM2BLK(ptr); + cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ; + if (cpy_size > size) + cpy_size = size; + sys_memcpy(res, ptr, cpy_size); + do_erts_alcu_free(type, allctr, ptr); + if (unlock) + erts_mtx_unlock(&allctr->mutex); + } + + DEBUG_CHECK_ALIGNMENT(res); + + return res; +} + +void * +erts_alcu_realloc_thr_pref(ErtsAlcType_t type, void *extra, void *p, Uint size) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + int ix; + void *ptr, *res; + Allctr_t *pref_allctr, *used_allctr; + + if (!p) + return erts_alcu_alloc_thr_pref(type, extra, size); + + ptr = (void *) (((char *) p) - sizeof(Uint)); + used_allctr = *((Allctr_t **) ptr); + + ix = erts_alc_get_thr_ix(); + ASSERT(ix > 0); + if (ix >= tspec->size) + ix = (ix % (tspec->size - 1)) + 1; + pref_allctr = tspec->allctr[ix]; + ASSERT(used_allctr && pref_allctr); + + erts_mtx_lock(&used_allctr->mutex); + res = do_erts_alcu_realloc(type, + used_allctr, + ptr, + size + sizeof(Uint), + (pref_allctr != used_allctr + ? ERTS_ALCU_FLG_FAIL_REALLOC_MOVE + : 0)); + erts_mtx_unlock(&used_allctr->mutex); + if (res) { + ASSERT(used_allctr == *((Allctr_t **) res)); + res = (void *) (((char *) res) + sizeof(Uint)); + DEBUG_CHECK_ALIGNMENT(res); + } + else { + erts_mtx_lock(&pref_allctr->mutex); + res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(Uint)); + erts_mtx_unlock(&pref_allctr->mutex); + if (res) { + Block_t *blk; + size_t cpy_size; + + *((Allctr_t **) res) = pref_allctr; + res = (void *) (((char *) res) + sizeof(Uint)); + + DEBUG_CHECK_ALIGNMENT(res); + + erts_mtx_lock(&used_allctr->mutex); + blk = UMEM2BLK(ptr); + cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ - sizeof(Uint); + if (cpy_size > size) + cpy_size = size; + sys_memcpy(res, p, cpy_size); + do_erts_alcu_free(type, used_allctr, ptr); + erts_mtx_unlock(&used_allctr->mutex); + } + } + + return res; +} + + +void * +erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t type, void *extra, + void *p, Uint size) +{ + ErtsAllocatorThrSpec_t *tspec = (ErtsAllocatorThrSpec_t *) extra; + int ix; + void *ptr, *res; + Allctr_t *pref_allctr, *used_allctr; + + if (!p) + return erts_alcu_alloc_thr_pref(type, extra, size); + + ptr = (void *) (((char *) p) - sizeof(Uint)); + used_allctr = *((Allctr_t **) ptr); + + ix = erts_alc_get_thr_ix(); + ASSERT(ix > 0); + if (ix >= tspec->size) + ix = (ix % (tspec->size - 1)) + 1; + pref_allctr = tspec->allctr[ix]; + ASSERT(used_allctr && pref_allctr); + + erts_mtx_lock(&pref_allctr->mutex); + res = do_erts_alcu_alloc(type, pref_allctr, size + sizeof(Uint)); + if (!res) { + erts_mtx_unlock(&pref_allctr->mutex); + res = erts_alcu_realloc_thr_pref(type, extra, p, size); + } + else { + Block_t *blk; + size_t cpy_size; + Allctr_t *allctr; + + *((Allctr_t **) res) = pref_allctr; + res = (void *) (((char *) res) + sizeof(Uint)); + + DEBUG_CHECK_ALIGNMENT(res); + + if (used_allctr == pref_allctr) + allctr = pref_allctr; + else { + erts_mtx_unlock(&pref_allctr->mutex); + allctr = used_allctr; + erts_mtx_lock(&allctr->mutex); + } + + blk = UMEM2BLK(ptr); + cpy_size = BLK_SZ(blk) - ABLK_HDR_SZ - sizeof(Uint); + if (cpy_size > size) + cpy_size = size; + sys_memcpy(res, p, cpy_size); + do_erts_alcu_free(type, allctr, ptr); + erts_mtx_unlock(&allctr->mutex); + } + + return res; +} + +#endif + +/* ------------------------------------------------------------------------- */ + +int +erts_alcu_start(Allctr_t *allctr, AllctrInit_t *init) +{ + /* erts_alcu_start assumes that allctr has been zeroed */ + + if (!initialized) + goto error; + +#if HAVE_ERTS_MSEG + { + ErtsMsegOpt_t mseg_opt = ERTS_MSEG_DEFAULT_OPT_INITIALIZER; + + sys_memcpy((void *) &allctr->mseg_opt, + (void *) &mseg_opt, + sizeof(ErtsMsegOpt_t)); + } +#endif + + allctr->name_prefix = init->name_prefix; + if (!allctr->name_prefix) + goto error; + + allctr->alloc_no = init->alloc_no; + if (allctr->alloc_no < ERTS_ALC_A_MIN + || ERTS_ALC_A_MAX < allctr->alloc_no) + allctr->alloc_no = ERTS_ALC_A_INVALID; + + if (!allctr->vsn_str) + goto error; + + allctr->name.alloc = THE_NON_VALUE; + allctr->name.realloc = THE_NON_VALUE; + allctr->name.free = THE_NON_VALUE; + + if (init->tspec) + allctr->t = init->tspec; + else if (init->tpref) + allctr->t = init->tpref; + else + allctr->t = 0; + + allctr->ramv = init->ramv; + allctr->main_carrier_size = init->mmbcs; + allctr->sbc_threshold = init->sbct; +#if HAVE_ERTS_MSEG + allctr->mseg_opt.abs_shrink_th = init->asbcst; + allctr->mseg_opt.rel_shrink_th = init->rsbcst; +#endif + allctr->sbc_move_threshold = init->rsbcmt; + allctr->mbc_move_threshold = init->rmbcmt; +#if HAVE_ERTS_MSEG + allctr->max_mseg_sbcs = init->mmsbc; + allctr->max_mseg_mbcs = init->mmmbc; +#endif + + allctr->largest_mbc_size = MAX(init->lmbcs, init->smbcs); + allctr->smallest_mbc_size = init->smbcs; + allctr->mbc_growth_stages = MAX(1, init->mbcgs); + + if (allctr->min_block_size < ABLK_HDR_SZ) + goto error; + allctr->min_block_size = UNIT_CEILING(allctr->min_block_size + + sizeof(Uint)); + +#if HAVE_ERTS_MSEG + if (allctr->mseg_opt.abs_shrink_th > ~((Uint) 0) / 100) + allctr->mseg_opt.abs_shrink_th = ~((Uint) 0) / 100; +#endif + +#ifdef USE_THREADS + if (init->ts) { + allctr->thread_safe = 1; + +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_mtx_init_x_opt(&allctr->mutex, + "alcu_allocator", + make_small(allctr->alloc_no), + ERTS_LCNT_LT_ALLOC); +#else + erts_mtx_init_x(&allctr->mutex, + "alcu_allocator", + make_small(allctr->alloc_no)); +#endif /*ERTS_ENABLE_LOCK_COUNT*/ + +#ifdef DEBUG + allctr->debug.saved_tid = 0; +#endif + } +#endif + + if(!allctr->get_free_block + || !allctr->link_free_block + || !allctr->unlink_free_block + || !allctr->info_options) + goto error; + + if (!allctr->get_next_mbc_size) + allctr->get_next_mbc_size = get_next_mbc_size; + + if (allctr->mbc_header_size < sizeof(Carrier_t)) + goto error; +#ifdef USE_THREADS + if (init->tpref) { + allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size + + FBLK_FTR_SZ + + ABLK_HDR_SZ + + sizeof(Uint)) + - ABLK_HDR_SZ + - sizeof(Uint)); + allctr->sbc_header_size = (UNIT_CEILING(sizeof(Carrier_t) + + FBLK_FTR_SZ + + ABLK_HDR_SZ + + sizeof(Uint)) + - ABLK_HDR_SZ + - sizeof(Uint)); + } + else +#endif + { + allctr->mbc_header_size = (UNIT_CEILING(allctr->mbc_header_size + + FBLK_FTR_SZ + + ABLK_HDR_SZ) + - ABLK_HDR_SZ); + allctr->sbc_header_size = (UNIT_CEILING(sizeof(Carrier_t) + + FBLK_FTR_SZ + + ABLK_HDR_SZ) + - ABLK_HDR_SZ); + } + + if (allctr->main_carrier_size) { + Block_t *blk; + + blk = create_carrier(allctr, + allctr->main_carrier_size, + CFLG_MBC + | CFLG_FORCE_SIZE + | CFLG_FORCE_SYS_ALLOC + | CFLG_MAIN_CARRIER); + if (!blk) + goto error; + + (*allctr->link_free_block)(allctr, blk); + + HARD_CHECK_BLK_CARRIER(allctr, blk); + + } + + return 1; + + error: + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_destroy(&allctr->mutex); +#endif + + return 0; + +} + +/* ------------------------------------------------------------------------- */ + +void +erts_alcu_stop(Allctr_t *allctr) +{ + allctr->stopped = 1; + + while (allctr->sbc_list.first) + destroy_carrier(allctr, SBC2BLK(allctr, allctr->sbc_list.first)); + while (allctr->mbc_list.first) + destroy_carrier(allctr, MBC2FBLK(allctr, allctr->mbc_list.first)); + +#ifdef USE_THREADS + if (allctr->thread_safe) + erts_mtx_destroy(&allctr->mutex); +#endif + +} + +/* ------------------------------------------------------------------------- */ + +void +erts_alcu_init(AlcUInit_t *init) +{ + +#if HAVE_ERTS_MSEG + mseg_unit_size = erts_mseg_unit_size(); + + if (mseg_unit_size % sizeof(Unit_t)) /* A little paranoid... */ + erl_exit(-1, + "Mseg unit size (%d) not evenly divideble by " + "internal unit size of alloc_util (%d)\n", + mseg_unit_size, + sizeof(Unit_t)); + + max_mseg_carriers = init->mmc; + sys_alloc_carrier_size = MSEG_UNIT_CEILING(init->ycs); +#else /* #if HAVE_ERTS_MSEG */ + sys_alloc_carrier_size = ((init->ycs + 4095) / 4096) * 4096; +#endif + +#ifdef DEBUG + carrier_alignment = sizeof(Unit_t); +#endif + + erts_mtx_init(&init_atoms_mtx, "alcu_init_atoms"); + + atoms_initialized = 0; + initialized = 1; +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * NOTE: erts_alcu_test() is only supposed to be used for testing. * + * * + * Keep alloc_SUITE_data/allocator_test.h updated if changes are made * + * to erts_alcu_test() * +\* */ + +unsigned long +erts_alcu_test(unsigned long op, unsigned long a1, unsigned long a2) +{ + switch (op) { + case 0x000: return (unsigned long) BLK_SZ((Block_t *) a1); + case 0x001: return (unsigned long) BLK_UMEM_SZ((Block_t *) a1); + case 0x002: return (unsigned long) IS_PREV_BLK_FREE((Block_t *) a1); + case 0x003: return (unsigned long) IS_FREE_BLK((Block_t *) a1); + case 0x004: return (unsigned long) IS_LAST_BLK((Block_t *) a1); + case 0x005: return (unsigned long) UMEM2BLK((void *) a1); + case 0x006: return (unsigned long) BLK2UMEM((Block_t *) a1); + case 0x007: return (unsigned long) IS_SB_CARRIER((Carrier_t *) a1); + case 0x008: return (unsigned long) IS_SBC_BLK((Block_t *) a1); + case 0x009: return (unsigned long) IS_MB_CARRIER((Carrier_t *) a1); + case 0x00a: return (unsigned long) IS_MSEG_CARRIER((Carrier_t *) a1); + case 0x00b: return (unsigned long) CARRIER_SZ((Carrier_t *) a1); + case 0x00c: return (unsigned long) SBC2BLK((Allctr_t *) a1, + (Carrier_t *) a2); + case 0x00d: return (unsigned long) BLK2SBC((Allctr_t *) a1, + (Block_t *) a2); + case 0x00e: return (unsigned long) MBC2FBLK((Allctr_t *) a1, + (Carrier_t *) a2); + case 0x00f: return (unsigned long) FBLK2MBC((Allctr_t *) a1, + (Block_t *) a2); + case 0x010: return (unsigned long) ((Allctr_t *) a1)->mbc_list.first; + case 0x011: return (unsigned long) ((Allctr_t *) a1)->mbc_list.last; + case 0x012: return (unsigned long) ((Allctr_t *) a1)->sbc_list.first; + case 0x013: return (unsigned long) ((Allctr_t *) a1)->sbc_list.last; + case 0x014: return (unsigned long) ((Carrier_t *) a1)->next; + case 0x015: return (unsigned long) ((Carrier_t *) a1)->prev; + case 0x016: return (unsigned long) ABLK_HDR_SZ; + case 0x017: return (unsigned long) ((Allctr_t *) a1)->min_block_size; + case 0x018: return (unsigned long) NXT_BLK((Block_t *) a1); + case 0x019: return (unsigned long) PREV_BLK((Block_t *) a1); + case 0x01a: return (unsigned long) IS_FIRST_BLK((Block_t *) a1); + case 0x01b: return (unsigned long) sizeof(Unit_t); + default: ASSERT(0); return ~((unsigned long) 0); + } +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Debug functions * +\* */ + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + +static void +check_blk_carrier(Allctr_t *allctr, Block_t *iblk) +{ + Carrier_t *crr; + CarrierList_t *cl; + + if (IS_SBC_BLK(iblk)) { + Carrier_t *sbc = BLK2SBC(allctr, iblk); + + ASSERT(SBC2BLK(allctr, sbc) == iblk); + ASSERT(IS_ALLOCED_BLK(iblk)); + ASSERT(IS_FIRST_BLK(iblk)); + ASSERT(IS_LAST_BLK(iblk)); + ASSERT(CARRIER_SZ(sbc) - allctr->sbc_header_size >= BLK_SZ(iblk)); +#if HAVE_ERTS_MSEG + if (IS_MSEG_CARRIER(sbc)) { + ASSERT(CARRIER_SZ(sbc) % mseg_unit_size == 0); + } +#endif + crr = sbc; + cl = &allctr->sbc_list; + } + else { + Carrier_t *mbc = NULL; + Block_t *prev_blk = NULL; + Block_t *blk; + char *carrier_end; + Uint is_free_blk; + Uint tot_blk_sz; + Uint blk_sz; + + blk = iblk; + tot_blk_sz = 0; + + while (1) { + + if (prev_blk) { + ASSERT(NXT_BLK(prev_blk) == blk); + if (IS_FREE_BLK(prev_blk)) { + ASSERT(IS_PREV_BLK_FREE(blk)); + ASSERT(prev_blk == PREV_BLK(blk)); + } + else { + ASSERT(IS_PREV_BLK_ALLOCED(blk)); + } + } + + if (mbc) { + if (blk == iblk) + break; + ASSERT(((Block_t *) mbc) < blk && blk < iblk); + } + else + ASSERT(blk >= iblk); + + + ASSERT(IS_MBC_BLK(blk)); + + blk_sz = BLK_SZ(blk); + + ASSERT(blk_sz % sizeof(Unit_t) == 0); + ASSERT(blk_sz >= allctr->min_block_size); + + tot_blk_sz += blk_sz; + + is_free_blk = (int) IS_FREE_BLK(blk); + if(is_free_blk) { + if (IS_NOT_LAST_BLK(blk)) + ASSERT(*((Uint *) (((char *) blk)+blk_sz-sizeof(Uint))) + == blk_sz); + } + + if (allctr->check_block) + (*allctr->check_block)(allctr, blk, (int) is_free_blk); + + if (IS_LAST_BLK(blk)) { + carrier_end = ((char *) NXT_BLK(blk)) + sizeof(Uint); + mbc = *((Carrier_t **) NXT_BLK(blk)); + prev_blk = NULL; + blk = MBC2FBLK(allctr, mbc); + ASSERT(IS_FIRST_BLK(blk)); + } + else { + prev_blk = blk; + blk = NXT_BLK(blk); + } + } + + ASSERT(IS_MB_CARRIER(mbc)); + ASSERT((((char *) mbc) + + allctr->mbc_header_size + + tot_blk_sz + + sizeof(Uint)) == carrier_end); + ASSERT(((char *) mbc) + CARRIER_SZ(mbc) == carrier_end); + + if (allctr->check_mbc) + (*allctr->check_mbc)(allctr, mbc); + +#if HAVE_ERTS_MSEG + if (IS_MSEG_CARRIER(mbc)) { + ASSERT(CARRIER_SZ(mbc) % mseg_unit_size == 0); + } +#endif + crr = mbc; + cl = &allctr->mbc_list; + } + + if (cl->first == crr) { + ASSERT(!crr->prev); + } + else { + ASSERT(crr->prev); + ASSERT(crr->prev->next == crr); + } + if (cl->last == crr) { + ASSERT(!crr->next); + } + else { + ASSERT(crr->next); + ASSERT(crr->next->prev == crr); + } +} + +#endif diff --git a/erts/emulator/beam/erl_alloc_util.h b/erts/emulator/beam/erl_alloc_util.h new file mode 100644 index 0000000000..10b11661e6 --- /dev/null +++ b/erts/emulator/beam/erl_alloc_util.h @@ -0,0 +1,342 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_ALLOC_UTIL__ +#define ERL_ALLOC_UTIL__ + +#define ERTS_ALCU_VSN_STR "2.2" + +#include "erl_alloc_types.h" + +typedef struct Allctr_t_ Allctr_t; + +typedef struct { + Uint ycs; + Uint mmc; +} AlcUInit_t; + +typedef struct { + char *name_prefix; + ErtsAlcType_t alloc_no; + int ts; + int tspec; + int tpref; + int ramv; + Uint sbct; + Uint asbcst; + Uint rsbcst; + Uint rsbcmt; + Uint rmbcmt; + Uint mmbcs; + Uint mmsbc; + Uint mmmbc; + Uint lmbcs; + Uint smbcs; + Uint mbcgs; +} AllctrInit_t; + +typedef struct { + Uint blocks; + Uint carriers; +} AllctrSize_t; + +#ifndef SMALL_MEMORY + +#define ERTS_DEFAULT_ALCU_INIT { \ + 1024*1024, /* (bytes) ycs: sys_alloc carrier size */\ + 1024 /* (amount) mmc: max mseg carriers */\ +} + +#define ERTS_DEFAULT_ALLCTR_INIT { \ + NULL, \ + ERTS_ALC_A_INVALID, /* (number) alloc_no: allocator number */\ + 1, /* (bool) ts: thread safe */\ + 0, /* (bool) tspec: thread specific */\ + 0, /* (bool) tpref: thread preferred */\ + 0, /* (bool) ramv: realloc always moves */\ + 512*1024, /* (bytes) sbct: sbc threshold */\ + 2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\ + 20, /* (%) rsbcst: rel sbc shrink threshold */\ + 80, /* (%) rsbcmt: rel sbc move threshold */\ + 50, /* (%) rmbcmt: rel mbc move threshold */\ + 1024*1024, /* (bytes) mmbcs: main multiblock carrier size */\ + 256, /* (amount) mmsbc: max mseg sbcs */\ + 10, /* (amount) mmmbc: max mseg mbcs */\ + 10*1024*1024, /* (bytes) lmbcs: largest mbc size */\ + 1024*1024, /* (bytes) smbcs: smallest mbc size */\ + 10 /* (amount) mbcgs: mbc growth stages */\ +} + +#else /* if SMALL_MEMORY */ + +#define ERTS_DEFAULT_ALCU_INIT { \ + 128*1024, /* (bytes) ycs: sys_alloc carrier size */\ + 1024 /* (amount) mmc: max mseg carriers */\ +} + +#define ERTS_DEFAULT_ALLCTR_INIT { \ + NULL, \ + ERTS_ALC_A_INVALID, /* (number) alloc_no: allocator number */\ + 1, /* (bool) ts: thread safe */\ + 0, /* (bool) tspec: thread specific */\ + 0, /* (bool) tpref: thread preferred */\ + 0, /* (bool) ramv: realloc always moves */\ + 64*1024, /* (bytes) sbct: sbc threshold */\ + 2*1024*2024, /* (amount) asbcst: abs sbc shrink threshold */\ + 20, /* (%) rsbcst: rel sbc shrink threshold */\ + 80, /* (%) rsbcmt: rel sbc move threshold */\ + 128*1024, /* (bytes) mmbcs: main multiblock carrier size */\ + 256, /* (amount) mmsbc: max mseg sbcs */\ + 10, /* (amount) mmmbc: max mseg mbcs */\ + 1024*1024, /* (bytes) lmbcs: largest mbc size */\ + 128*1024, /* (bytes) smbcs: smallest mbc size */\ + 10 /* (amount) mbcgs: mbc growth stages */\ +} + +#endif + +void * erts_alcu_alloc(ErtsAlcType_t, void *, Uint); +void * erts_alcu_realloc(ErtsAlcType_t, void *, void *, Uint); +void * erts_alcu_realloc_mv(ErtsAlcType_t, void *, void *, Uint); +void erts_alcu_free(ErtsAlcType_t, void *, void *); +#ifdef USE_THREADS +void * erts_alcu_alloc_ts(ErtsAlcType_t, void *, Uint); +void * erts_alcu_realloc_ts(ErtsAlcType_t, void *, void *, Uint); +void * erts_alcu_realloc_mv_ts(ErtsAlcType_t, void *, void *, Uint); +void erts_alcu_free_ts(ErtsAlcType_t, void *, void *); +void * erts_alcu_alloc_thr_spec(ErtsAlcType_t, void *, Uint); +void * erts_alcu_realloc_thr_spec(ErtsAlcType_t, void *, void *, Uint); +void * erts_alcu_realloc_mv_thr_spec(ErtsAlcType_t, void *, void *, Uint); +void erts_alcu_free_thr_spec(ErtsAlcType_t, void *, void *); +void * erts_alcu_alloc_thr_pref(ErtsAlcType_t, void *, Uint); +void * erts_alcu_realloc_thr_pref(ErtsAlcType_t, void *, void *, Uint); +void * erts_alcu_realloc_mv_thr_pref(ErtsAlcType_t, void *, void *, Uint); +void erts_alcu_free_thr_pref(ErtsAlcType_t, void *, void *); +#endif +Eterm erts_alcu_au_info_options(int *, void *, Uint **, Uint *); +Eterm erts_alcu_info_options(Allctr_t *, int *, void *, Uint **, Uint *); +Eterm erts_alcu_sz_info(Allctr_t *, int, int *, void *, Uint **, Uint *); +Eterm erts_alcu_info(Allctr_t *, int, int *, void *, Uint **, Uint *); +void erts_alcu_init(AlcUInit_t *); +void erts_alcu_current_size(Allctr_t *, AllctrSize_t *); + +#endif + +#if defined(GET_ERL_ALLOC_UTIL_IMPL) && !defined(ERL_ALLOC_UTIL_IMPL__) +#define ERL_ALLOC_UTIL_IMPL__ + +#ifdef USE_THREADS +#define ERL_THREADS_EMU_INTERNAL__ +#include "erl_threads.h" +#endif + +#include "erl_mseg.h" + +#undef ERTS_ALLOC_UTIL_HARD_DEBUG +#ifdef DEBUG +# if 0 +# define ERTS_ALLOC_UTIL_HARD_DEBUG +# endif +#endif + +#undef MIN +#undef MAX +#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) +#define MAX(X, Y) ((X) > (Y) ? (X) : (Y)) +#define FLOOR(X, I) (((X)/(I))*(I)) +#define CEILING(X, I) ((((X) - 1)/(I) + 1)*(I)) + +#undef WORD_MASK +#define INV_WORD_MASK ((Uint) (sizeof(Uint) - 1)) +#define WORD_MASK (~INV_WORD_MASK) +#define WORD_FLOOR(X) ((X) & WORD_MASK) +#define WORD_CEILING(X) WORD_FLOOR((X) + INV_WORD_MASK) + +#undef UNIT_MASK +#define INV_UNIT_MASK ((Uint) (sizeof(Unit_t) - 1)) +#define UNIT_MASK (~INV_UNIT_MASK) +#define UNIT_FLOOR(X) ((X) & UNIT_MASK) +#define UNIT_CEILING(X) UNIT_FLOOR((X) + INV_UNIT_MASK) + + +#define SZ_MASK (~((Uint) 0) << 3) +#define FLG_MASK (~(SZ_MASK)) + + +#define BLK_SZ(B) \ + (*((Block_t *) (B)) & SZ_MASK) + +#define CARRIER_SZ(C) \ + ((C)->chdr & SZ_MASK) + +typedef union {char c[8]; long l; double d;} Unit_t; + +typedef struct Carrier_t_ Carrier_t; +struct Carrier_t_ { + Uint chdr; + Carrier_t *next; + Carrier_t *prev; +}; + +typedef struct { + Carrier_t *first; + Carrier_t *last; +} CarrierList_t; + +typedef Uint Block_t; +typedef Uint FreeBlkFtr_t; + +typedef struct { + Uint giga_no; + Uint no; +} CallCounter_t; + +typedef struct { + Uint no; + Uint size; +} StatValues_t; + +typedef struct { + StatValues_t curr_mseg; + StatValues_t curr_sys_alloc; + StatValues_t max; + StatValues_t max_ever; + struct { + StatValues_t curr; + StatValues_t max; + StatValues_t max_ever; + } blocks; +} CarriersStats_t; + +struct Allctr_t_ { + + /* Allocator name prefix */ + char * name_prefix; + + /* Allocator number */ + ErtsAlcType_t alloc_no; + + /* Alloc, realloc and free names as atoms */ + struct { + Eterm alloc; + Eterm realloc; + Eterm free; + } name; + + /* Version string */ + char * vsn_str; + + /* Options */ + int t; + int ramv; + Uint sbc_threshold; + Uint sbc_move_threshold; + Uint mbc_move_threshold; + Uint main_carrier_size; + Uint max_mseg_sbcs; + Uint max_mseg_mbcs; + Uint largest_mbc_size; + Uint smallest_mbc_size; + Uint mbc_growth_stages; +#if HAVE_ERTS_MSEG + ErtsMsegOpt_t mseg_opt; +#endif + + /* */ + Uint mbc_header_size; + Uint sbc_header_size; + Uint min_mbc_size; + Uint min_mbc_first_free_size; + Uint min_block_size; + + /* Carriers */ + CarrierList_t mbc_list; + CarrierList_t sbc_list; + + /* Main carrier (if there is one) */ + Carrier_t * main_carrier; + + /* Callback functions (first 4 are mandatory) */ + Block_t * (*get_free_block) (Allctr_t *, Uint, + Block_t *, Uint); + void (*link_free_block) (Allctr_t *, Block_t *); + void (*unlink_free_block) (Allctr_t *, Block_t *); + Eterm (*info_options) (Allctr_t *, char *, int *, + void *, Uint **, Uint *); + + Uint (*get_next_mbc_size) (Allctr_t *); + void (*creating_mbc) (Allctr_t *, Carrier_t *); + void (*destroying_mbc) (Allctr_t *, Carrier_t *); + void (*init_atoms) (void); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + void (*check_block) (Allctr_t *, Block_t *, int); + void (*check_mbc) (Allctr_t *, Carrier_t *); +#endif + +#ifdef USE_THREADS + /* Mutex for this allocator */ + erts_mtx_t mutex; + int thread_safe; + struct { + Allctr_t *prev; + Allctr_t *next; + } ts_list; +#endif + + int atoms_initialized; + + int stopped; + + /* Some statistics ... */ + struct { + CallCounter_t this_alloc; + CallCounter_t this_free; + CallCounter_t this_realloc; + CallCounter_t mseg_alloc; + CallCounter_t mseg_dealloc; + CallCounter_t mseg_realloc; + CallCounter_t sys_alloc; + CallCounter_t sys_free; + CallCounter_t sys_realloc; + } calls; + + CarriersStats_t sbcs; + CarriersStats_t mbcs; + +#ifdef DEBUG +#ifdef USE_THREADS + struct { + int saved_tid; + erts_tid_t tid; + } debug; +#endif +#endif +}; + +int erts_alcu_start(Allctr_t *, AllctrInit_t *); +void erts_alcu_stop(Allctr_t *); + +unsigned long erts_alcu_test(unsigned long, unsigned long, unsigned long); + + + +#endif /* #if defined(GET_ERL_ALLOC_UTIL_IMPL) + && !defined(ERL_ALLOC_UTIL_IMPL__) */ + diff --git a/erts/emulator/beam/erl_arith.c b/erts/emulator/beam/erl_arith.c new file mode 100644 index 0000000000..b692832677 --- /dev/null +++ b/erts/emulator/beam/erl_arith.c @@ -0,0 +1,2040 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Arithmetic functions formerly found in beam_emu.c + * now available as bifs as erl_db_util and db_match_compile needs + * them. + */ + + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "atom.h" + +#ifndef MAX +# define MAX(x, y) (((x) > (y)) ? (x) : (y)) +#endif + +static Eterm shift(Process* p, Eterm arg1, Eterm arg2, int right); + +static ERTS_INLINE void maybe_shrink(Process* p, Eterm* hp, Eterm res, Uint alloc) +{ + Uint actual; + + if (is_immed(res)) { + if (p->heap <= hp && hp < p->htop) { + p->htop = hp; +#if defined(CHECK_FOR_HOLES) + } else { + erts_arith_shrink(p, hp); +#endif + } + } else if ((actual = bignum_header_arity(*hp)+1) < alloc) { + if (p->heap <= hp && hp < p->htop) { + p->htop = hp+actual; +#if defined(CHECK_FOR_HOLES) + } else { + erts_arith_shrink(p, hp+actual); +#endif + } + } +} + +/* + * BIF interfaces. They will only be from match specs and + * when a BIF is applied. + */ + +BIF_RETTYPE splus_1(BIF_ALIST_1) +{ + if (is_number(BIF_ARG_1)) { + BIF_RET(BIF_ARG_1); + } else { + BIF_ERROR(BIF_P, BADARITH); + } +} + +BIF_RETTYPE splus_2(BIF_ALIST_2) +{ + BIF_RET(erts_mixed_plus(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE sminus_1(BIF_ALIST_1) +{ + BIF_RET(erts_mixed_minus(BIF_P, make_small(0), BIF_ARG_1)); +} + +BIF_RETTYPE sminus_2(BIF_ALIST_2) +{ + BIF_RET(erts_mixed_minus(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE stimes_2(BIF_ALIST_2) +{ + BIF_RET(erts_mixed_times(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE div_2(BIF_ALIST_2) +{ + BIF_RET(erts_mixed_div(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE intdiv_2(BIF_ALIST_2) +{ + if (BIF_ARG_2 == SMALL_ZERO) { + BIF_ERROR(BIF_P, BADARITH); + } + if (is_both_small(BIF_ARG_1,BIF_ARG_2)){ + Sint ires = signed_val(BIF_ARG_1) / signed_val(BIF_ARG_2); + if (MY_IS_SSMALL(ires)) + BIF_RET(make_small(ires)); + } + BIF_RET(erts_int_div(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE rem_2(BIF_ALIST_2) +{ + if (BIF_ARG_2 == SMALL_ZERO) { + BIF_ERROR(BIF_P, BADARITH); + } + if (is_both_small(BIF_ARG_1,BIF_ARG_2)){ + /* Is this really correct? Isn't there a difference between + remainder and modulo that is not defined in C? Well, I don't + remember, this is the way it's done in beam_emu anyway... */ + BIF_RET(make_small(signed_val(BIF_ARG_1) % signed_val(BIF_ARG_2))); + } + BIF_RET(erts_int_rem(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE band_2(BIF_ALIST_2) +{ + if (is_both_small(BIF_ARG_1,BIF_ARG_2)){ + BIF_RET(BIF_ARG_1 & BIF_ARG_2); + } + BIF_RET(erts_band(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE bor_2(BIF_ALIST_2) +{ + if (is_both_small(BIF_ARG_1,BIF_ARG_2)){ + BIF_RET(BIF_ARG_1 | BIF_ARG_2); + } + BIF_RET(erts_bor(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE bxor_2(BIF_ALIST_2) +{ + if (is_both_small(BIF_ARG_1,BIF_ARG_2)){ + BIF_RET(make_small(signed_val(BIF_ARG_1) ^ signed_val(BIF_ARG_2))); + } + BIF_RET(erts_bxor(BIF_P, BIF_ARG_1, BIF_ARG_2)); +} + +BIF_RETTYPE bsl_2(Process* p, Eterm arg1, Eterm arg2) +{ + BIF_RET(shift(p, arg1, arg2, 0)); +} + +BIF_RETTYPE bsr_2(Process* p, Eterm arg1, Eterm arg2) +{ + BIF_RET(shift(p, arg1, arg2, 1)); +} + +static Eterm +shift(Process* p, Eterm arg1, Eterm arg2, int right) +{ + Sint i; + Sint ires; + Eterm tmp_big1[2]; + Eterm* bigp; + Uint need; + + if (right) { + if (is_small(arg2)) { + i = -signed_val(arg2); + if (is_small(arg1)) { + goto small_shift; + } else if (is_big(arg1)) { + if (i == 0) { + BIF_RET(arg1); + } + goto big_shift; + } + } else if (is_big(arg2)) { + /* + * N bsr NegativeBigNum == N bsl MAX_SMALL + * N bsr PositiveBigNum == N bsl MIN_SMALL + */ + arg2 = make_small(bignum_header_is_neg(*big_val(arg2)) ? + MAX_SMALL : MIN_SMALL); + goto do_bsl; + } + } else { + do_bsl: + if (is_small(arg2)) { + i = signed_val(arg2); + + if (is_small(arg1)) { + small_shift: + ires = signed_val(arg1); + + if (i == 0 || ires == 0) { + BIF_RET(arg1); + } else if (i < 0) { /* Right shift */ + i = -i; + if (i >= SMALL_BITS-1) { + arg1 = (ires < 0) ? SMALL_MINUS_ONE : SMALL_ZERO; + } else { + arg1 = make_small(ires >> i); + } + BIF_RET(arg1); + } else if (i < SMALL_BITS-1) { /* Left shift */ + if ((ires > 0 && ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ires) == 0) || + ((~(Uint)0 << ((SMALL_BITS-1)-i)) & ~ires) == 0) { + arg1 = make_small(ires << i); + BIF_RET(arg1); + } + } + arg1 = small_to_big(ires, tmp_big1); + + big_shift: + if (i > 0) { /* Left shift. */ + ires = big_size(arg1) + (i / D_EXP); + } else { /* Right shift. */ + ires = big_size(arg1); + if (ires <= (-i / D_EXP)) + ires = 3; + else + ires -= (-i / D_EXP); + } + + /* + * Slightly conservative check the size to avoid + * allocating huge amounts of memory for bignums that + * clearly would overflow the arity in the header + * word. + */ + if (ires-8 > BIG_ARITY_MAX) { + BIF_ERROR(p, SYSTEM_LIMIT); + } + need = BIG_NEED_SIZE(ires+1); + bigp = HAlloc(p, need); + arg1 = big_lshift(arg1, i, bigp); + maybe_shrink(p, bigp, arg1, need); + if (is_nil(arg1)) { + /* + * This result must have been only slight larger + * than allowed since it wasn't caught by the + * previous test. + */ + BIF_ERROR(p, SYSTEM_LIMIT); + } + BIF_RET(arg1); + } else if (is_big(arg1)) { + if (i == 0) { + BIF_RET(arg1); + } + goto big_shift; + } + } else if (is_big(arg2)) { + if (bignum_header_is_neg(*big_val(arg2))) { + /* + * N bsl NegativeBigNum is either 0 or -1, depending on + * the sign of N. Since we don't believe this case + * is common, do the calculation with the minimum + * amount of code. + */ + arg2 = make_small(MIN_SMALL); + goto do_bsl; + } else if (is_small(arg1) || is_big(arg1)) { + /* + * N bsl PositiveBigNum is too large to represent. + */ + BIF_ERROR(p, SYSTEM_LIMIT); + } + /* Fall through if the left argument is not an integer. */ + } + } + BIF_ERROR(p, BADARITH); +} + +BIF_RETTYPE bnot_1(BIF_ALIST_1) +{ + Eterm ret; + + if (is_small(BIF_ARG_1)) { + ret = make_small(~signed_val(BIF_ARG_1)); + } else if (is_big(BIF_ARG_1)) { + Uint need = BIG_NEED_SIZE(big_size(BIF_ARG_1)+1); + Eterm* bigp = HAlloc(BIF_P, need); + + ret = big_bnot(BIF_ARG_1, bigp); + maybe_shrink(BIF_P, bigp, ret, need); + if (is_nil(ret)) { + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } + } else { + BIF_ERROR(BIF_P, BADARITH); + } + BIF_RET(ret); +} + +/* + * Implementation and interfaces for the rest of the runtime system. + * The functions that follow are only used in match specs and when + * arithmetic functions are applied. + */ + +Eterm +erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2) +{ + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm res; + Eterm hdr; + FloatDef f1, f2; + dsize_t sz1, sz2, sz; + int need_heap; + Eterm* hp; + Sint ires; + + ERTS_FP_CHECK_INIT(p); + switch (arg1 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + ires = signed_val(arg1) + signed_val(arg2); + ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires)); + if (MY_IS_SSMALL(ires)) { + return make_small(ires); + } else { + hp = HAlloc(p, 2); + res = small_to_big(ires, hp); + return res; + } + default: + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + if (arg1 == SMALL_ZERO) { + return arg2; + } + arg1 = small_to_big(signed_val(arg1), tmp_big1); + goto do_big; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg1); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if (arg2 == SMALL_ZERO) { + return arg1; + } + arg2 = small_to_big(signed_val(arg2), tmp_big2); + goto do_big; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + do_big: + sz1 = big_size(arg1); + sz2 = big_size(arg2); + sz = MAX(sz1, sz2)+1; + need_heap = BIG_NEED_SIZE(sz); + hp = HAlloc(p, need_heap); + res = big_plus(arg1, arg2, hp); + if (is_nil(res)) { + erts_arith_shrink(p, hp); + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + maybe_shrink(p, hp, res, need_heap); + return res; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + GET_DOUBLE(arg2, f2); + + do_float: + f1.fd = f1.fd + f2.fd; + ERTS_FP_ERROR(p, f1.fd, goto badarith); + hp = HAlloc(p, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f1, hp); + return res; + default: + goto badarith; + } + default: + goto badarith; + } + } + default: + goto badarith; + } +} + +Eterm +erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2) +{ + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm hdr; + Eterm res; + FloatDef f1, f2; + dsize_t sz1, sz2, sz; + int need_heap; + Eterm* hp; + Sint ires; + + ERTS_FP_CHECK_INIT(p); + switch (arg1 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + ires = signed_val(arg1) - signed_val(arg2); + ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires)); + if (MY_IS_SSMALL(ires)) { + return make_small(ires); + } else { + hp = HAlloc(p, 2); + res = small_to_big(ires, hp); + return res; + } + default: + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + arg1 = small_to_big(signed_val(arg1), tmp_big1); + goto do_big; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg1); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if (arg2 == SMALL_ZERO) { + return arg1; + } + arg2 = small_to_big(signed_val(arg2), tmp_big2); + + do_big: + sz1 = big_size(arg1); + sz2 = big_size(arg2); + sz = MAX(sz1, sz2)+1; + need_heap = BIG_NEED_SIZE(sz); + hp = HAlloc(p, need_heap); + res = big_minus(arg1, arg2, hp); + if (is_nil(res)) { + erts_arith_shrink(p, hp); + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + maybe_shrink(p, hp, res, need_heap); + return res; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + goto do_big; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + GET_DOUBLE(arg2, f2); + + do_float: + f1.fd = f1.fd - f2.fd; + ERTS_FP_ERROR(p, f1.fd, goto badarith); + hp = HAlloc(p, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f1, hp); + return res; + default: + goto badarith; + } + default: + goto badarith; + } + } + default: + goto badarith; + } +} + +Eterm +erts_mixed_times(Process* p, Eterm arg1, Eterm arg2) +{ + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm hdr; + Eterm res; + FloatDef f1, f2; + dsize_t sz1, sz2, sz; + int need_heap; + Eterm* hp; + + ERTS_FP_CHECK_INIT(p); + switch (arg1 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if ((arg1 == SMALL_ZERO) || (arg2 == SMALL_ZERO)) { + return(SMALL_ZERO); + } else if (arg1 == SMALL_ONE) { + return(arg2); + } else if (arg2 == SMALL_ONE) { + return(arg1); + } else { + Eterm big_res[3]; + + /* + * The following code is optimized for the case that + * result is small (which should be the most common case + * in practice). + */ + res = small_times(signed_val(arg1), signed_val(arg2), big_res); + if (is_small(res)) { + return res; + } else { + /* + * The result is a a big number. + * Allocate a heap fragment and copy the result. + * Be careful to allocate exactly what we need + * to not leave any holes. + */ + Uint arity; + + ASSERT(is_big(res)); + hdr = big_res[0]; + arity = bignum_header_arity(hdr); + ASSERT(arity == 1 || arity == 2); + hp = HAlloc(p, arity+1); + res = make_big(hp); + *hp++ = hdr; + *hp++ = big_res[1]; + if (arity > 1) { + *hp = big_res[2]; + } + return res; + } + } + default: + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + if (arg1 == SMALL_ZERO) + return(SMALL_ZERO); + if (arg1 == SMALL_ONE) + return(arg2); + arg1 = small_to_big(signed_val(arg1), tmp_big1); + sz = 2 + big_size(arg2); + goto do_big; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg1); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if (arg2 == SMALL_ZERO) + return(SMALL_ZERO); + if (arg2 == SMALL_ONE) + return(arg1); + arg2 = small_to_big(signed_val(arg2), tmp_big2); + sz = 2 + big_size(arg1); + goto do_big; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + sz1 = big_size(arg1); + sz2 = big_size(arg2); + sz = sz1 + sz2; + + do_big: + need_heap = BIG_NEED_SIZE(sz); + hp = HAlloc(p, need_heap); + res = big_times(arg1, arg2, hp); + + /* + * Note that the result must be big in this case, since + * at least one operand was big to begin with, and + * the absolute value of the other is > 1. + */ + + if (is_nil(res)) { + erts_arith_shrink(p, hp); + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + maybe_shrink(p, hp, res, need_heap); + return res; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + GET_DOUBLE(arg2, f2); + + do_float: + f1.fd = f1.fd * f2.fd; + ERTS_FP_ERROR(p, f1.fd, goto badarith); + hp = HAlloc(p, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f1, hp); + return res; + default: + goto badarith; + } + default: + goto badarith; + } + } + default: + goto badarith; + } +} + +Eterm +erts_mixed_div(Process* p, Eterm arg1, Eterm arg2) +{ + FloatDef f1, f2; + Eterm* hp; + Eterm hdr; + + ERTS_FP_CHECK_INIT(p); + switch (arg1 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + f2.fd = signed_val(arg2); + goto do_float; + default: + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg1); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0 || + big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + GET_DOUBLE(arg2, f2); + + do_float: + f1.fd = f1.fd / f2.fd; + ERTS_FP_ERROR(p, f1.fd, goto badarith); + hp = HAlloc(p, FLOAT_SIZE_OBJECT); + PUT_DOUBLE(f1, hp); + return make_float(hp); + default: + goto badarith; + } + default: + goto badarith; + } + } + default: + goto badarith; + } +} + +Eterm +erts_int_div(Process* p, Eterm arg1, Eterm arg2) +{ + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + int ires; + + switch (NUMBER_CODE(arg1, arg2)) { + case SMALL_SMALL: + /* This case occurs if the most negative fixnum is divided by -1. */ + ASSERT(arg2 == make_small(-1)); + arg1 = small_to_big(signed_val(arg1), tmp_big1); + /*FALLTHROUGH*/ + case BIG_SMALL: + arg2 = small_to_big(signed_val(arg2), tmp_big2); + goto L_big_div; + case SMALL_BIG: + if (arg1 != make_small(MIN_SMALL)) { + return SMALL_ZERO; + } + arg1 = small_to_big(signed_val(arg1), tmp_big1); + /*FALLTHROUGH*/ + case BIG_BIG: + L_big_div: + ires = big_ucomp(arg1, arg2); + if (ires < 0) { + arg1 = SMALL_ZERO; + } else if (ires == 0) { + arg1 = (big_sign(arg1) == big_sign(arg2)) ? + SMALL_ONE : SMALL_MINUS_ONE; + } else { + Eterm* hp; + int i = big_size(arg1); + Uint need; + + ires = big_size(arg2); + need = BIG_NEED_SIZE(i-ires+1) + BIG_NEED_SIZE(i); + hp = HAlloc(p, need); + arg1 = big_div(arg1, arg2, hp); + if (is_nil(arg1)) { + erts_arith_shrink(p, hp); + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + maybe_shrink(p, hp, arg1, need); + } + return arg1; + default: + p->freason = BADARITH; + return THE_NON_VALUE; + } +} + +Eterm +erts_int_rem(Process* p, Eterm arg1, Eterm arg2) +{ + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + int ires; + + switch (NUMBER_CODE(arg1, arg2)) { + case BIG_SMALL: + arg2 = small_to_big(signed_val(arg2), tmp_big2); + goto L_big_rem; + case SMALL_BIG: + if (arg1 != make_small(MIN_SMALL)) { + return arg1; + } else { + Eterm tmp = small_to_big(signed_val(arg1), tmp_big1); + if ((ires = big_ucomp(tmp, arg2)) == 0) { + return SMALL_ZERO; + } else { + ASSERT(ires < 0); + return arg1; + } + } + /* All paths returned */ + case BIG_BIG: + L_big_rem: + ires = big_ucomp(arg1, arg2); + if (ires == 0) { + arg1 = SMALL_ZERO; + } else if (ires > 0) { + Uint need = BIG_NEED_SIZE(big_size(arg1)); + Eterm* hp = HAlloc(p, need); + + arg1 = big_rem(arg1, arg2, hp); + if (is_nil(arg1)) { + erts_arith_shrink(p, hp); + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + maybe_shrink(p, hp, arg1, need); + } + return arg1; + default: + p->freason = BADARITH; + return THE_NON_VALUE; + } +} + +Eterm erts_band(Process* p, Eterm arg1, Eterm arg2) +{ + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm* hp; + int need; + + switch (NUMBER_CODE(arg1, arg2)) { + case SMALL_BIG: + arg1 = small_to_big(signed_val(arg1), tmp_big1); + break; + case BIG_SMALL: + arg2 = small_to_big(signed_val(arg2), tmp_big2); + break; + case BIG_BIG: + break; + default: + p->freason = BADARITH; + return THE_NON_VALUE; + } + need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1); + hp = HAlloc(p, need); + arg1 = big_band(arg1, arg2, hp); + ASSERT(is_not_nil(arg1)); + maybe_shrink(p, hp, arg1, need); + return arg1; +} + +Eterm erts_bor(Process* p, Eterm arg1, Eterm arg2) +{ + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm* hp; + int need; + + switch (NUMBER_CODE(arg1, arg2)) { + case SMALL_BIG: + arg1 = small_to_big(signed_val(arg1), tmp_big1); + break; + case BIG_SMALL: + arg2 = small_to_big(signed_val(arg2), tmp_big2); + break; + case BIG_BIG: + break; + default: + p->freason = BADARITH; + return THE_NON_VALUE; + } + need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1); + hp = HAlloc(p, need); + arg1 = big_bor(arg1, arg2, hp); + ASSERT(is_not_nil(arg1)); + maybe_shrink(p, hp, arg1, need); + return arg1; +} + +Eterm erts_bxor(Process* p, Eterm arg1, Eterm arg2) +{ + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm* hp; + int need; + + switch (NUMBER_CODE(arg1, arg2)) { + case SMALL_BIG: + arg1 = small_to_big(signed_val(arg1), tmp_big1); + break; + case BIG_SMALL: + arg2 = small_to_big(signed_val(arg2), tmp_big2); + break; + case BIG_BIG: + break; + default: + p->freason = BADARITH; + return THE_NON_VALUE; + } + need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1); + hp = HAlloc(p, need); + arg1 = big_bxor(arg1, arg2, hp); + ASSERT(is_not_nil(arg1)); + maybe_shrink(p, hp, arg1, need); + return arg1; +} + +Eterm erts_bnot(Process* p, Eterm arg) +{ + Eterm ret; + + if (is_big(arg)) { + Uint need = BIG_NEED_SIZE(big_size(arg)+1); + Eterm* bigp = HAlloc(p, need); + + ret = big_bnot(arg, bigp); + maybe_shrink(p, bigp, ret, need); + if (is_nil(ret)) { + p->freason = SYSTEM_LIMIT; + return NIL; + } + } else { + p->freason = BADARITH; + return NIL; + } + return ret; +} + +#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need)) + +static ERTS_INLINE void +trim_heap(Process* p, Eterm* hp, Eterm res) +{ + if (is_immed(res)) { + ASSERT(p->heap <= hp && hp <= p->htop); + p->htop = hp; + } else { + Eterm* new_htop; + ASSERT(is_big(res)); + new_htop = hp + bignum_header_arity(*hp) + 1; + ASSERT(p->heap <= new_htop && new_htop <= p->htop); + p->htop = new_htop; + } + ASSERT(p->heap <= p->htop && p->htop <= p->stop); +} + +/* + * The functions that follow are called from the emulator loop. + * They are not allowed to allocate heap fragments, but must do + * a garbage collection if there is insufficient heap space. + */ + +#define erts_arith_shrink horrible error +#define maybe_shrink horrible error + +Eterm +erts_gc_mixed_plus(Process* p, Eterm* reg, Uint live) +{ + Eterm arg1; + Eterm arg2; + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm res; + Eterm hdr; + FloatDef f1, f2; + dsize_t sz1, sz2, sz; + int need_heap; + Eterm* hp; + Sint ires; + + arg1 = reg[live]; + arg2 = reg[live+1]; + ERTS_FP_CHECK_INIT(p); + switch (arg1 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + ires = signed_val(arg1) + signed_val(arg2); + ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires)); + if (MY_IS_SSMALL(ires)) { + return make_small(ires); + } else { + if (ERTS_NEED_GC(p, 2)) { + erts_garbage_collect(p, 2, reg, live); + } + hp = p->htop; + p->htop += 2; + res = small_to_big(ires, hp); + return res; + } + default: + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + if (arg1 == SMALL_ZERO) { + return arg2; + } + arg1 = small_to_big(signed_val(arg1), tmp_big1); + goto do_big; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg1); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if (arg2 == SMALL_ZERO) { + return arg1; + } + arg2 = small_to_big(signed_val(arg2), tmp_big2); + goto do_big; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + do_big: + sz1 = big_size(arg1); + sz2 = big_size(arg2); + sz = MAX(sz1, sz2)+1; + need_heap = BIG_NEED_SIZE(sz); + if (ERTS_NEED_GC(p, need_heap)) { + erts_garbage_collect(p, need_heap, reg, live+2); + if (arg1 != make_big(tmp_big1)) { + arg1 = reg[live]; + } + if (arg2 != make_big(tmp_big2)) { + arg2 = reg[live+1]; + } + } + hp = p->htop; + p->htop += need_heap; + res = big_plus(arg1, arg2, hp); + trim_heap(p, hp, res); + if (is_nil(res)) { + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + return res; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + GET_DOUBLE(arg2, f2); + + do_float: + f1.fd = f1.fd + f2.fd; + ERTS_FP_ERROR(p, f1.fd, goto badarith); + if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) { + erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live); + } + hp = p->htop; + p->htop += FLOAT_SIZE_OBJECT; + res = make_float(hp); + PUT_DOUBLE(f1, hp); + return res; + default: + goto badarith; + } + default: + goto badarith; + } + } + default: + goto badarith; + } +} + +Eterm +erts_gc_mixed_minus(Process* p, Eterm* reg, Uint live) +{ + Eterm arg1; + Eterm arg2; + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm hdr; + Eterm res; + FloatDef f1, f2; + dsize_t sz1, sz2, sz; + int need_heap; + Eterm* hp; + Sint ires; + + arg1 = reg[live]; + arg2 = reg[live+1]; + ERTS_FP_CHECK_INIT(p); + switch (arg1 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + ires = signed_val(arg1) - signed_val(arg2); + ASSERT(MY_IS_SSMALL(ires) == IS_SSMALL(ires)); + if (MY_IS_SSMALL(ires)) { + return make_small(ires); + } else { + if (ERTS_NEED_GC(p, 2)) { + erts_garbage_collect(p, 2, reg, live); + } + hp = p->htop; + p->htop += 2; + res = small_to_big(ires, hp); + return res; + } + default: + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + arg1 = small_to_big(signed_val(arg1), tmp_big1); + goto do_big; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg1); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if (arg2 == SMALL_ZERO) { + return arg1; + } + arg2 = small_to_big(signed_val(arg2), tmp_big2); + + do_big: + sz1 = big_size(arg1); + sz2 = big_size(arg2); + sz = MAX(sz1, sz2)+1; + need_heap = BIG_NEED_SIZE(sz); + if (ERTS_NEED_GC(p, need_heap)) { + erts_garbage_collect(p, need_heap, reg, live+2); + if (arg1 != make_big(tmp_big1)) { + arg1 = reg[live]; + } + if (arg2 != make_big(tmp_big2)) { + arg2 = reg[live+1]; + } + } + hp = p->htop; + p->htop += need_heap; + res = big_minus(arg1, arg2, hp); + trim_heap(p, hp, res); + if (is_nil(res)) { + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + return res; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + goto do_big; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + GET_DOUBLE(arg2, f2); + + do_float: + f1.fd = f1.fd - f2.fd; + ERTS_FP_ERROR(p, f1.fd, goto badarith); + if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) { + erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live); + } + hp = p->htop; + p->htop += FLOAT_SIZE_OBJECT; + res = make_float(hp); + PUT_DOUBLE(f1, hp); + return res; + default: + goto badarith; + } + default: + goto badarith; + } + } + default: + goto badarith; + } +} + +Eterm +erts_gc_mixed_times(Process* p, Eterm* reg, Uint live) +{ + Eterm arg1; + Eterm arg2; + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + Eterm hdr; + Eterm res; + FloatDef f1, f2; + dsize_t sz1, sz2, sz; + int need_heap; + Eterm* hp; + + arg1 = reg[live]; + arg2 = reg[live+1]; + ERTS_FP_CHECK_INIT(p); + switch (arg1 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if ((arg1 == SMALL_ZERO) || (arg2 == SMALL_ZERO)) { + return(SMALL_ZERO); + } else if (arg1 == SMALL_ONE) { + return(arg2); + } else if (arg2 == SMALL_ONE) { + return(arg1); + } else { + Eterm big_res[3]; + + /* + * The following code is optimized for the case that + * result is small (which should be the most common case + * in practice). + */ + res = small_times(signed_val(arg1), signed_val(arg2), + big_res); + if (is_small(res)) { + return res; + } else { + /* + * The result is a a big number. + * Allocate a heap fragment and copy the result. + * Be careful to allocate exactly what we need + * to not leave any holes. + */ + Uint arity; + Uint need; + + ASSERT(is_big(res)); + hdr = big_res[0]; + arity = bignum_header_arity(hdr); + ASSERT(arity == 1 || arity == 2); + need = arity + 1; + if (ERTS_NEED_GC(p, need)) { + erts_garbage_collect(p, need, reg, live); + } + hp = p->htop; + p->htop += need; + res = make_big(hp); + *hp++ = hdr; + *hp++ = big_res[1]; + if (arity > 1) { + *hp = big_res[2]; + } + return res; + } + } + default: + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + if (arg1 == SMALL_ZERO) + return(SMALL_ZERO); + if (arg1 == SMALL_ONE) + return(arg2); + arg1 = small_to_big(signed_val(arg1), tmp_big1); + sz = 2 + big_size(arg2); + goto do_big; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg1); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if (arg2 == SMALL_ZERO) + return(SMALL_ZERO); + if (arg2 == SMALL_ONE) + return(arg1); + arg2 = small_to_big(signed_val(arg2), tmp_big2); + sz = 2 + big_size(arg1); + goto do_big; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + sz1 = big_size(arg1); + sz2 = big_size(arg2); + sz = sz1 + sz2; + + do_big: + need_heap = BIG_NEED_SIZE(sz); + if (ERTS_NEED_GC(p, need_heap)) { + erts_garbage_collect(p, need_heap, reg, live+2); + if (arg1 != make_big(tmp_big1)) { + arg1 = reg[live]; + } + if (arg2 != make_big(tmp_big2)) { + arg2 = reg[live+1]; + } + } + hp = p->htop; + p->htop += need_heap; + res = big_times(arg1, arg2, hp); + trim_heap(p, hp, res); + + /* + * Note that the result must be big in this case, since + * at least one operand was big to begin with, and + * the absolute value of the other is > 1. + */ + + if (is_nil(res)) { + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + return res; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + GET_DOUBLE(arg2, f2); + + do_float: + f1.fd = f1.fd * f2.fd; + ERTS_FP_ERROR(p, f1.fd, goto badarith); + if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) { + erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live); + } + hp = p->htop; + p->htop += FLOAT_SIZE_OBJECT; + res = make_float(hp); + PUT_DOUBLE(f1, hp); + return res; + default: + goto badarith; + } + default: + goto badarith; + } + } + default: + goto badarith; + } +} + +Eterm +erts_gc_mixed_div(Process* p, Eterm* reg, Uint live) +{ + Eterm arg1; + Eterm arg2; + FloatDef f1, f2; + Eterm* hp; + Eterm hdr; + + arg1 = reg[live]; + arg2 = reg[live+1]; + ERTS_FP_CHECK_INIT(p); + switch (arg1 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg1 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + f2.fd = signed_val(arg2); + goto do_float; + default: + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + f1.fd = signed_val(arg1); + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg1); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0 || + big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (big_to_double(arg1, &f1.fd) < 0) { + goto badarith; + } + GET_DOUBLE(arg2, f2); + goto do_float; + default: + goto badarith; + } + } + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + switch (arg2 & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + switch ((arg2 & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + f2.fd = signed_val(arg2); + goto do_float; + default: + goto badarith; + } + case TAG_PRIMARY_BOXED: + hdr = *boxed_val(arg2); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + if (big_to_double(arg2, &f2.fd) < 0) { + goto badarith; + } + goto do_float; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + GET_DOUBLE(arg1, f1); + GET_DOUBLE(arg2, f2); + + do_float: + f1.fd = f1.fd / f2.fd; + ERTS_FP_ERROR(p, f1.fd, goto badarith); + if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) { + erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live); + } + hp = p->htop; + p->htop += FLOAT_SIZE_OBJECT; + PUT_DOUBLE(f1, hp); + return make_float(hp); + default: + goto badarith; + } + default: + goto badarith; + } + } + default: + goto badarith; + } +} + +Eterm +erts_gc_int_div(Process* p, Eterm* reg, Uint live) +{ + Eterm arg1; + Eterm arg2; + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + int ires; + + arg1 = reg[live]; + arg2 = reg[live+1]; + switch (NUMBER_CODE(arg1, arg2)) { + case SMALL_SMALL: + /* This case occurs if the most negative fixnum is divided by -1. */ + ASSERT(arg2 == make_small(-1)); + arg1 = small_to_big(signed_val(arg1), tmp_big1); + /*FALLTHROUGH*/ + case BIG_SMALL: + arg2 = small_to_big(signed_val(arg2), tmp_big2); + goto L_big_div; + case SMALL_BIG: + if (arg1 != make_small(MIN_SMALL)) { + return SMALL_ZERO; + } + arg1 = small_to_big(signed_val(arg1), tmp_big1); + /*FALLTHROUGH*/ + case BIG_BIG: + L_big_div: + ires = big_ucomp(arg1, arg2); + if (ires < 0) { + arg1 = SMALL_ZERO; + } else if (ires == 0) { + arg1 = (big_sign(arg1) == big_sign(arg2)) ? + SMALL_ONE : SMALL_MINUS_ONE; + } else { + Eterm* hp; + int i = big_size(arg1); + Uint need; + + ires = big_size(arg2); + need = BIG_NEED_SIZE(i-ires+1) + BIG_NEED_SIZE(i); + if (ERTS_NEED_GC(p, need)) { + erts_garbage_collect(p, need, reg, live+2); + if (arg1 != make_big(tmp_big1)) { + arg1 = reg[live]; + } + if (arg2 != make_big(tmp_big2)) { + arg2 = reg[live+1]; + } + } + hp = p->htop; + p->htop += need; + arg1 = big_div(arg1, arg2, hp); + trim_heap(p, hp, arg1); + if (is_nil(arg1)) { + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + } + return arg1; + default: + p->freason = BADARITH; + return THE_NON_VALUE; + } +} + +Eterm +erts_gc_int_rem(Process* p, Eterm* reg, Uint live) +{ + Eterm arg1; + Eterm arg2; + Eterm tmp_big1[2]; + Eterm tmp_big2[2]; + int ires; + + arg1 = reg[live]; + arg2 = reg[live+1]; + switch (NUMBER_CODE(arg1, arg2)) { + case BIG_SMALL: + arg2 = small_to_big(signed_val(arg2), tmp_big2); + goto L_big_rem; + case SMALL_BIG: + if (arg1 != make_small(MIN_SMALL)) { + return arg1; + } else { + Eterm tmp = small_to_big(signed_val(arg1), tmp_big1); + if ((ires = big_ucomp(tmp, arg2)) == 0) { + return SMALL_ZERO; + } else { + ASSERT(ires < 0); + return arg1; + } + } + /* All paths returned */ + case BIG_BIG: + L_big_rem: + ires = big_ucomp(arg1, arg2); + if (ires == 0) { + arg1 = SMALL_ZERO; + } else if (ires > 0) { + Eterm* hp; + Uint need = BIG_NEED_SIZE(big_size(arg1)); + + if (ERTS_NEED_GC(p, need)) { + erts_garbage_collect(p, need, reg, live+2); + if (arg1 != make_big(tmp_big1)) { + arg1 = reg[live]; + } + if (arg2 != make_big(tmp_big2)) { + arg2 = reg[live+1]; + } + } + hp = p->htop; + p->htop += need; + arg1 = big_rem(arg1, arg2, hp); + trim_heap(p, hp, arg1); + if (is_nil(arg1)) { + p->freason = SYSTEM_LIMIT; + return THE_NON_VALUE; + } + } + return arg1; + default: + p->freason = BADARITH; + return THE_NON_VALUE; + } +} + +#define DEFINE_GC_LOGIC_FUNC(func) \ +Eterm erts_gc_##func(Process* p, Eterm* reg, Uint live) \ +{ \ + Eterm arg1; \ + Eterm arg2; \ + Eterm tmp_big1[2]; \ + Eterm tmp_big2[2]; \ + Eterm* hp; \ + int need; \ + \ + arg1 = reg[live]; \ + arg2 = reg[live+1]; \ + switch (NUMBER_CODE(arg1, arg2)) { \ + case SMALL_BIG: \ + arg1 = small_to_big(signed_val(arg1), tmp_big1); \ + need = BIG_NEED_SIZE(big_size(arg2) + 1); \ + if (ERTS_NEED_GC(p, need)) { \ + erts_garbage_collect(p, need, reg, live+2); \ + arg2 = reg[live+1]; \ + } \ + break; \ + case BIG_SMALL: \ + arg2 = small_to_big(signed_val(arg2), tmp_big2); \ + need = BIG_NEED_SIZE(big_size(arg1) + 1); \ + if (ERTS_NEED_GC(p, need)) { \ + erts_garbage_collect(p, need, reg, live+2); \ + arg1 = reg[live]; \ + } \ + break; \ + case BIG_BIG: \ + need = BIG_NEED_SIZE(MAX(big_size(arg1), big_size(arg2)) + 1); \ + if (ERTS_NEED_GC(p, need)) { \ + erts_garbage_collect(p, need, reg, live+2); \ + arg1 = reg[live]; \ + arg2 = reg[live+1]; \ + } \ + break; \ + default: \ + p->freason = BADARITH; \ + return THE_NON_VALUE; \ + } \ + hp = p->htop; \ + p->htop += need; \ + arg1 = big_##func(arg1, arg2, hp); \ + trim_heap(p, hp, arg1); \ + return arg1; \ +} + +DEFINE_GC_LOGIC_FUNC(band) +DEFINE_GC_LOGIC_FUNC(bor) +DEFINE_GC_LOGIC_FUNC(bxor) + +Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live) +{ + Eterm result; + Eterm arg; + Uint need; + Eterm* bigp; + + arg = reg[live]; + if (is_not_big(arg)) { + p->freason = BADARITH; + return NIL; + } else { + need = BIG_NEED_SIZE(big_size(arg)+1); + if (ERTS_NEED_GC(p, need)) { + erts_garbage_collect(p, need, reg, live+1); + arg = reg[live]; + } + bigp = p->htop; + p->htop += need; + result = big_bnot(arg, bigp); + trim_heap(p, bigp, result); + if (is_nil(result)) { + p->freason = SYSTEM_LIMIT; + return NIL; + } + } + return result; +} diff --git a/erts/emulator/beam/erl_async.c b/erts/emulator/beam/erl_async.c new file mode 100644 index 0000000000..b090564649 --- /dev/null +++ b/erts/emulator/beam/erl_async.c @@ -0,0 +1,469 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_sys_driver.h" +#include "global.h" +#include "erl_threads.h" + +typedef struct _erl_async { + struct _erl_async* next; + struct _erl_async* prev; + DE_Handle* hndl; /* The DE_Handle is needed when port is gone */ + Eterm port; + long async_id; + void* async_data; + ErlDrvPDL pdl; + void (*async_invoke)(void*); + void (*async_free)(void*); +} ErlAsync; + +typedef struct { + erts_mtx_t mtx; + erts_cnd_t cv; + erts_tid_t thr; + int len; +#ifndef ERTS_SMP + int hndl; +#endif + ErlAsync* head; + ErlAsync* tail; +#ifdef ERTS_ENABLE_LOCK_CHECK + int no; +#endif +} AsyncQueue; + +static erts_smp_spinlock_t async_id_lock; +static long async_id = 0; + + +#ifndef ERTS_SMP + +erts_mtx_t async_ready_mtx; +static ErlAsync* async_ready_list = NULL; + +#endif + +/* +** Initialize worker threads (if supported) +*/ + +/* Detach from driver */ +static void async_detach(DE_Handle* dh) +{ + /* XXX:PaN what should happen here? we want to unload the driver or??? */ + return; +} + + +#ifdef USE_THREADS + +static AsyncQueue* async_q; + +static void* async_main(void*); +static void async_add(ErlAsync*, AsyncQueue*); + +#ifndef ERTS_SMP +typedef struct ErtsAsyncReadyCallback_ ErtsAsyncReadyCallback; +struct ErtsAsyncReadyCallback_ { + struct ErtsAsyncReadyCallback_ *next; + void (*callback)(void); +}; + +static ErtsAsyncReadyCallback *callbacks; +static int async_handle; + +int erts_register_async_ready_callback(void (*funcp)(void)) +{ + ErtsAsyncReadyCallback *cb = erts_alloc(ERTS_ALC_T_ARCALLBACK, + sizeof(ErtsAsyncReadyCallback)); + cb->next = callbacks; + cb->callback = funcp; + erts_mtx_lock(&async_ready_mtx); + callbacks = cb; + erts_mtx_unlock(&async_ready_mtx); + return async_handle; +} +#endif + +int init_async(int hndl) +{ + erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; + AsyncQueue* q; + int i; + + thr_opts.detached = 0; + thr_opts.suggested_stack_size = erts_async_thread_suggested_stack_size; + +#ifndef ERTS_SMP + callbacks = NULL; + async_handle = hndl; + erts_mtx_init(&async_ready_mtx, "async_ready"); + async_ready_list = NULL; +#endif + + async_id = 0; + erts_smp_spinlock_init(&async_id_lock, "async_id"); + + async_q = q = (AsyncQueue*) + (erts_async_max_threads + ? erts_alloc(ERTS_ALC_T_ASYNC_Q, + erts_async_max_threads * sizeof(AsyncQueue)) + : NULL); + for (i = 0; i < erts_async_max_threads; i++) { + q->head = NULL; + q->tail = NULL; + q->len = 0; +#ifndef ERTS_SMP + q->hndl = hndl; +#endif +#ifdef ERTS_ENABLE_LOCK_CHECK + q->no = i; +#endif + erts_mtx_init(&q->mtx, "asyncq"); + erts_cnd_init(&q->cv); + erts_thr_create(&q->thr, async_main, (void*)q, &thr_opts); + q++; + } + return 0; +} + + +int exit_async() +{ + int i; + + /* terminate threads */ + for (i = 0; i < erts_async_max_threads; i++) { + ErlAsync* a = (ErlAsync*) erts_alloc(ERTS_ALC_T_ASYNC, + sizeof(ErlAsync)); + a->port = NIL; + async_add(a, &async_q[i]); + } + + for (i = 0; i < erts_async_max_threads; i++) { + erts_thr_join(async_q[i].thr, NULL); + erts_mtx_destroy(&async_q[i].mtx); + erts_cnd_destroy(&async_q[i].cv); + } +#ifndef ERTS_SMP + erts_mtx_destroy(&async_ready_mtx); +#endif + if (async_q) + erts_free(ERTS_ALC_T_ASYNC_Q, (void *) async_q); + return 0; +} + + +static void async_add(ErlAsync* a, AsyncQueue* q) +{ + /* XXX:PaN Is this still necessary when ports lock drivers? */ + if (is_internal_port(a->port)) { + ERTS_LC_ASSERT(erts_drvportid2port(a->port)); + /* make sure the driver will stay around */ + driver_lock_driver(internal_port_index(a->port)); + } + + erts_mtx_lock(&q->mtx); + + if (q->len == 0) { + q->head = a; + q->tail = a; + q->len = 1; + erts_cnd_signal(&q->cv); + } + else { /* no need to signal (since the worker is working) */ + a->next = q->head; + q->head->prev = a; + q->head = a; + q->len++; + } + erts_mtx_unlock(&q->mtx); +} + +static ErlAsync* async_get(AsyncQueue* q) +{ + ErlAsync* a; + + erts_mtx_lock(&q->mtx); + while((a = q->tail) == NULL) { + erts_cnd_wait(&q->cv, &q->mtx); + } +#ifdef ERTS_SMP + ASSERT(a && q->tail == a); +#endif + if (q->head == q->tail) { + q->head = q->tail = NULL; + q->len = 0; + } + else { + q->tail->prev->next = NULL; + q->tail = q->tail->prev; + q->len--; + } + erts_mtx_unlock(&q->mtx); + return a; +} + + +static int async_del(long id) +{ + int i; + /* scan all queue for an entry with async_id == 'id' */ + + for (i = 0; i < erts_async_max_threads; i++) { + ErlAsync* a; + erts_mtx_lock(&async_q[i].mtx); + + a = async_q[i].head; + while(a != NULL) { + if (a->async_id == id) { + if (a->prev != NULL) + a->prev->next = a->next; + else + async_q[i].head = a->next; + if (a->next != NULL) + a->next->prev = a->prev; + else + async_q[i].tail = a->prev; + async_q[i].len--; + erts_mtx_unlock(&async_q[i].mtx); + if (a->async_free != NULL) + a->async_free(a->async_data); + async_detach(a->hndl); + erts_free(ERTS_ALC_T_ASYNC, a); + return 1; + } + } + erts_mtx_unlock(&async_q[i].mtx); + } + return 0; +} + +static void* async_main(void* arg) +{ + AsyncQueue* q = (AsyncQueue*) arg; + +#ifdef ERTS_ENABLE_LOCK_CHECK + { + char buf[27]; + erts_snprintf(&buf[0], 27, "async %d", q->no); + erts_lc_set_thread_name(&buf[0]); + } +#endif + + while(1) { + ErlAsync* a = async_get(q); + + if (a->port == NIL) { /* TIME TO DIE SIGNAL */ + erts_free(ERTS_ALC_T_ASYNC, (void *) a); + break; + } + else { + (*a->async_invoke)(a->async_data); + /* Major problem if the code for async_invoke + or async_free is removed during a blocking operation */ +#ifdef ERTS_SMP + { + Port *p; + p = erts_id2port_sflgs(a->port, + NULL, + 0, + ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); + if (!p) { + if (a->async_free) + (*a->async_free)(a->async_data); + } + else { + if (async_ready(p, a->async_data)) { + if (a->async_free) + (*a->async_free)(a->async_data); + } + async_detach(a->hndl); + erts_port_release(p); + } + if (a->pdl) { + driver_pdl_dec_refc(a->pdl); + } + erts_free(ERTS_ALC_T_ASYNC, (void *) a); + } +#else + if (a->pdl) { + driver_pdl_dec_refc(a->pdl); + } + erts_mtx_lock(&async_ready_mtx); + a->next = async_ready_list; + async_ready_list = a; + erts_mtx_unlock(&async_ready_mtx); + sys_async_ready(q->hndl); +#endif + } + } + + return NULL; +} + + +#endif + +#ifndef ERTS_SMP + +int check_async_ready(void) +{ +#ifdef USE_THREADS + ErtsAsyncReadyCallback *cbs; +#endif + ErlAsync* a; + int count = 0; + + erts_mtx_lock(&async_ready_mtx); + a = async_ready_list; + async_ready_list = NULL; +#ifdef USE_THREADS + cbs = callbacks; +#endif + erts_mtx_unlock(&async_ready_mtx); + + while(a != NULL) { + ErlAsync* a_next = a->next; + /* Every port not dead */ + Port *p = erts_id2port_sflgs(a->port, + NULL, + 0, + ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); + if (!p) { + if (a->async_free) + (*a->async_free)(a->async_data); + } + else { + count++; + if (async_ready(p, a->async_data)) { + if (a->async_free != NULL) + (*a->async_free)(a->async_data); + } + async_detach(a->hndl); + erts_port_release(p); + } + erts_free(ERTS_ALC_T_ASYNC, (void *) a); + a = a_next; + } +#ifdef USE_THREADS + for (; cbs; cbs = cbs->next) + (*cbs->callback)(); +#endif + return count; +} + +#endif + + +/* +** Schedule async_invoke on a worker thread +** NOTE will be syncrounous when threads are unsupported +** return values: +** 0 completed +** -1 error +** N handle value (used with async_cancel) +** arguments: +** ix driver index +** key pointer to secedule queue (NULL means round robin) +** async_invoke function to run in thread +** async_data data to pass to invoke function +** async_free function for relase async_data in case of failure +*/ +long driver_async(ErlDrvPort ix, unsigned int* key, + void (*async_invoke)(void*), void* async_data, + void (*async_free)(void*)) +{ + ErlAsync* a = (ErlAsync*) erts_alloc(ERTS_ALC_T_ASYNC, sizeof(ErlAsync)); + Port* prt = erts_drvport2port(ix); + long id; + unsigned int qix; + + + if (!prt) + return -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + a->next = NULL; + a->prev = NULL; + a->hndl = (DE_Handle*)prt->drv_ptr->handle; + a->port = prt->id; + a->pdl = NULL; + a->async_data = async_data; + a->async_invoke = async_invoke; + a->async_free = async_free; + + erts_smp_spin_lock(&async_id_lock); + async_id = (async_id + 1) & 0x7fffffff; + if (async_id == 0) + async_id++; + id = async_id; + erts_smp_spin_unlock(&async_id_lock); + + a->async_id = id; + + if (key == NULL) { + qix = (erts_async_max_threads > 0) + ? (id % erts_async_max_threads) : 0; + } + else { + qix = (erts_async_max_threads > 0) ? + (*key % erts_async_max_threads) : 0; + *key = qix; + } +#ifdef USE_THREADS + if (erts_async_max_threads > 0) { + if (prt->port_data_lock) { + driver_pdl_inc_refc(prt->port_data_lock); + a->pdl = prt->port_data_lock; + } + async_add(a, &async_q[qix]); + return id; + } +#endif + + (*a->async_invoke)(a->async_data); + + if (async_ready(prt, a->async_data)) { + if (a->async_free != NULL) + (*a->async_free)(a->async_data); + } + erts_free(ERTS_ALC_T_ASYNC, (void *) a); + + return id; +} + +int driver_async_cancel(unsigned int id) +{ +#ifdef USE_THREADS + if (erts_async_max_threads > 0) + return async_del(id); +#endif + return 0; +} + + + + + diff --git a/erts/emulator/beam/erl_bestfit_alloc.c b/erts/emulator/beam/erl_bestfit_alloc.c new file mode 100644 index 0000000000..3035e5df16 --- /dev/null +++ b/erts/emulator/beam/erl_bestfit_alloc.c @@ -0,0 +1,1161 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: A combined "address order best fit"/"best fit" allocator + * based on a Red-Black (binary search) Tree. The search, + * insert, and delete operations are all O(log n) operations + * on a Red-Black Tree. In the "address order best fit" case + * n equals number of free blocks, and in the "best fit" case + * n equals number of distinct sizes of free blocks. Red-Black + * Trees are described in "Introduction to Algorithms", by + * Thomas H. Cormen, Charles E. Leiserson, and + * Ronald L. Riverest. + * + * This module is a callback-module for erl_alloc_util.c + * + * Author: Rickard Green + */ + + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "global.h" +#define GET_ERL_BF_ALLOC_IMPL +#include "erl_bestfit_alloc.h" + +#ifdef DEBUG +#if 0 +#define HARD_DEBUG +#endif +#else +#undef HARD_DEBUG +#endif + +#define MIN_MBC_SZ (16*1024) +#define MIN_MBC_FIRST_FREE_SZ (4*1024) + +#define TREE_NODE_FLG (((Uint) 1) << 0) +#define RED_FLG (((Uint) 1) << 1) +#ifdef HARD_DEBUG +# define LEFT_VISITED_FLG (((Uint) 1) << 2) +# define RIGHT_VISITED_FLG (((Uint) 1) << 3) +#endif + +#define IS_TREE_NODE(N) (((RBTree_t *) (N))->flags & TREE_NODE_FLG) +#define IS_LIST_ELEM(N) (!IS_TREE_NODE(((RBTree_t *) (N)))) + +#define SET_TREE_NODE(N) (((RBTree_t *) (N))->flags |= TREE_NODE_FLG) +#define SET_LIST_ELEM(N) (((RBTree_t *) (N))->flags &= ~TREE_NODE_FLG) + +#define IS_RED(N) (((RBTree_t *) (N)) \ + && ((RBTree_t *) (N))->flags & RED_FLG) +#define IS_BLACK(N) (!IS_RED(((RBTree_t *) (N)))) + +#define SET_RED(N) (((RBTree_t *) (N))->flags |= RED_FLG) +#define SET_BLACK(N) (((RBTree_t *) (N))->flags &= ~RED_FLG) + +#undef ASSERT +#define ASSERT ASSERT_EXPR + +#if 1 +#define RBT_ASSERT ASSERT +#else +#define RBT_ASSERT(x) +#endif + + +#ifdef HARD_DEBUG +static RBTree_t * check_tree(BFAllctr_t *, Uint); +#endif + +static void tree_delete(Allctr_t *allctr, Block_t *del); + +/* Prototypes of callback functions */ + +/* "address order best fit" specific callback functions */ +static Block_t * aobf_get_free_block (Allctr_t *, Uint, + Block_t *, Uint); +static void aobf_link_free_block (Allctr_t *, Block_t *); +#define aobf_unlink_free_block tree_delete + +/* "best fit" specific callback functions */ +static Block_t * bf_get_free_block (Allctr_t *, Uint, + Block_t *, Uint); +static void bf_link_free_block (Allctr_t *, Block_t *); +static ERTS_INLINE void bf_unlink_free_block (Allctr_t *, Block_t *); + + +static Eterm info_options (Allctr_t *, char *, int *, + void *, Uint **, Uint *); +static void init_atoms (void); + +/* Types... */ +struct RBTree_t_ { + Block_t hdr; + Uint flags; + RBTree_t *parent; + RBTree_t *left; + RBTree_t *right; +}; + +typedef struct { + RBTree_t t; + RBTree_t *next; +} RBTreeList_t; + +#define LIST_NEXT(N) (((RBTreeList_t *) (N))->next) +#define LIST_PREV(N) (((RBTreeList_t *) (N))->t.parent) + + +#ifdef DEBUG + +/* Destroy all tree fields */ +#define DESTROY_TREE_NODE(N) \ + sys_memset((void *) (((Block_t *) (N)) + 1), \ + 0xff, \ + (sizeof(RBTree_t) - sizeof(Block_t))) + +/* Destroy all tree and list fields */ +#define DESTROY_LIST_ELEM(N) \ + sys_memset((void *) (((Block_t *) (N)) + 1), \ + 0xff, \ + (sizeof(RBTreeList_t) - sizeof(Block_t))) + +#else + +#define DESTROY_TREE_NODE(N) +#define DESTROY_LIST_ELEM(N) + +#endif + + +static int atoms_initialized = 0; + +void +erts_bfalc_init(void) +{ + atoms_initialized = 0; +} + +Allctr_t * +erts_bfalc_start(BFAllctr_t *bfallctr, + BFAllctrInit_t *bfinit, + AllctrInit_t *init) +{ + BFAllctr_t nulled_state = {{0}}; + /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc + warning. gcc warns if {0} is used as initializer of a struct when + the first member is a struct (not if, for example, the third member + is a struct). */ + Allctr_t *allctr = (Allctr_t *) bfallctr; + + sys_memcpy((void *) bfallctr, (void *) &nulled_state, sizeof(BFAllctr_t)); + + bfallctr->address_order = bfinit->ao; + + + allctr->mbc_header_size = sizeof(Carrier_t); + allctr->min_mbc_size = MIN_MBC_SZ; + allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; + allctr->min_block_size = (bfinit->ao + ? sizeof(RBTree_t) + : sizeof(RBTreeList_t)); + + allctr->vsn_str = (bfinit->ao + ? ERTS_ALC_AOBF_ALLOC_VSN_STR + : ERTS_ALC_BF_ALLOC_VSN_STR); + + + /* Callback functions */ + + if (bfinit->ao) { + allctr->get_free_block = aobf_get_free_block; + allctr->link_free_block = aobf_link_free_block; + allctr->unlink_free_block = aobf_unlink_free_block; + } + else { + allctr->get_free_block = bf_get_free_block; + allctr->link_free_block = bf_link_free_block; + allctr->unlink_free_block = bf_unlink_free_block; + } + allctr->info_options = info_options; + + allctr->get_next_mbc_size = NULL; + allctr->creating_mbc = NULL; + allctr->destroying_mbc = NULL; + allctr->init_atoms = init_atoms; + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + allctr->check_block = NULL; + allctr->check_mbc = NULL; +#endif + + allctr->atoms_initialized = 0; + + if (!erts_alcu_start(allctr, init)) + return NULL; + + return allctr; +} + +/* + * Red-Black Tree operations needed + */ + +static ERTS_INLINE void +left_rotate(RBTree_t **root, RBTree_t *x) +{ + RBTree_t *y = x->right; + x->right = y->left; + if (y->left) + y->left->parent = x; + y->parent = x->parent; + if (!y->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->left) + x->parent->left = y; + else { + RBT_ASSERT(x == x->parent->right); + x->parent->right = y; + } + y->left = x; + x->parent = y; +} + +static ERTS_INLINE void +right_rotate(RBTree_t **root, RBTree_t *x) +{ + RBTree_t *y = x->left; + x->left = y->right; + if (y->right) + y->right->parent = x; + y->parent = x->parent; + if (!y->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->right) + x->parent->right = y; + else { + RBT_ASSERT(x == x->parent->left); + x->parent->left = y; + } + y->right = x; + x->parent = y; +} + + +/* + * Replace node x with node y + * NOTE: block header of y is not changed + */ +static ERTS_INLINE void +replace(RBTree_t **root, RBTree_t *x, RBTree_t *y) +{ + + if (!x->parent) { + RBT_ASSERT(*root == x); + *root = y; + } + else if (x == x->parent->left) + x->parent->left = y; + else { + RBT_ASSERT(x == x->parent->right); + x->parent->right = y; + } + if (x->left) { + RBT_ASSERT(x->left->parent == x); + x->left->parent = y; + } + if (x->right) { + RBT_ASSERT(x->right->parent == x); + x->right->parent = y; + } + + y->flags = x->flags; + y->parent = x->parent; + y->right = x->right; + y->left = x->left; + + DESTROY_TREE_NODE(x); + +} + +static void +tree_insert_fixup(BFAllctr_t *bfallctr, RBTree_t *blk) +{ + RBTree_t *x = blk, *y; + + /* + * Rearrange the tree so that it satisfies the Red-Black Tree properties + */ + + RBT_ASSERT(x != bfallctr->root && IS_RED(x->parent)); + do { + + /* + * x and its parent are both red. Move the red pair up the tree + * until we get to the root or until we can separate them. + */ + + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(x->parent->parent); + + if (x->parent == x->parent->parent->left) { + y = x->parent->parent->right; + if (IS_RED(y)) { + SET_BLACK(y); + x = x->parent; + SET_BLACK(x); + x = x->parent; + SET_RED(x); + } + else { + + if (x == x->parent->right) { + x = x->parent; + left_rotate(&bfallctr->root, x); + } + + RBT_ASSERT(x == x->parent->parent->left->left); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_BLACK(y)); + + SET_BLACK(x->parent); + SET_RED(x->parent->parent); + right_rotate(&bfallctr->root, x->parent->parent); + + RBT_ASSERT(x == x->parent->left); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent->right)); + RBT_ASSERT(IS_BLACK(x->parent)); + break; + } + } + else { + RBT_ASSERT(x->parent == x->parent->parent->right); + y = x->parent->parent->left; + if (IS_RED(y)) { + SET_BLACK(y); + x = x->parent; + SET_BLACK(x); + x = x->parent; + SET_RED(x); + } + else { + + if (x == x->parent->left) { + x = x->parent; + right_rotate(&bfallctr->root, x); + } + + RBT_ASSERT(x == x->parent->parent->right->right); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent)); + RBT_ASSERT(IS_BLACK(x->parent->parent)); + RBT_ASSERT(IS_BLACK(y)); + + SET_BLACK(x->parent); + SET_RED(x->parent->parent); + left_rotate(&bfallctr->root, x->parent->parent); + + RBT_ASSERT(x == x->parent->right); + RBT_ASSERT(IS_RED(x)); + RBT_ASSERT(IS_RED(x->parent->left)); + RBT_ASSERT(IS_BLACK(x->parent)); + break; + } + } + } while (x != bfallctr->root && IS_RED(x->parent)); + + SET_BLACK(bfallctr->root); + +} + +/* + * The argument types of "Allctr_t *" and "Block_t *" have been + * chosen since we then can use tree_delete() as unlink_free_block + * callback function in the address order case. + */ +static void +tree_delete(Allctr_t *allctr, Block_t *del) +{ + BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + Uint spliced_is_black; + RBTree_t *x, *y, *z = (RBTree_t *) del; + RBTree_t null_x; /* null_x is used to get the fixup started when we + splice out a node without children. */ + + null_x.parent = NULL; + +#ifdef HARD_DEBUG + check_tree(bfallctr, 0); +#endif + + /* Remove node from tree... */ + + /* Find node to splice out */ + if (!z->left || !z->right) + y = z; + else + /* Set y to z:s successor */ + for(y = z->right; y->left; y = y->left); + /* splice out y */ + x = y->left ? y->left : y->right; + spliced_is_black = IS_BLACK(y); + if (x) { + x->parent = y->parent; + } + else if (!x && spliced_is_black) { + x = &null_x; + x->flags = 0; + SET_BLACK(x); + x->right = x->left = NULL; + x->parent = y->parent; + y->left = x; + } + + if (!y->parent) { + RBT_ASSERT(bfallctr->root == y); + bfallctr->root = x; + } + else if (y == y->parent->left) + y->parent->left = x; + else { + RBT_ASSERT(y == y->parent->right); + y->parent->right = x; + } + if (y != z) { + /* We spliced out the successor of z; replace z by the successor */ + replace(&bfallctr->root, z, y); + } + + if (spliced_is_black) { + /* We removed a black node which makes the resulting tree + violate the Red-Black Tree properties. Fixup tree... */ + + while (IS_BLACK(x) && x->parent) { + + /* + * x has an "extra black" which we move up the tree + * until we reach the root or until we can get rid of it. + * + * y is the sibbling of x + */ + + if (x == x->parent->left) { + y = x->parent->right; + RBT_ASSERT(y); + if (IS_RED(y)) { + RBT_ASSERT(y->right); + RBT_ASSERT(y->left); + SET_BLACK(y); + RBT_ASSERT(IS_BLACK(x->parent)); + SET_RED(x->parent); + left_rotate(&bfallctr->root, x->parent); + y = x->parent->right; + } + RBT_ASSERT(y); + RBT_ASSERT(IS_BLACK(y)); + if (IS_BLACK(y->left) && IS_BLACK(y->right)) { + SET_RED(y); + x = x->parent; + } + else { + if (IS_BLACK(y->right)) { + SET_BLACK(y->left); + SET_RED(y); + right_rotate(&bfallctr->root, y); + y = x->parent->right; + } + RBT_ASSERT(y); + if (IS_RED(x->parent)) { + + SET_BLACK(x->parent); + SET_RED(y); + } + RBT_ASSERT(y->right); + SET_BLACK(y->right); + left_rotate(&bfallctr->root, x->parent); + x = bfallctr->root; + break; + } + } + else { + RBT_ASSERT(x == x->parent->right); + y = x->parent->left; + RBT_ASSERT(y); + if (IS_RED(y)) { + RBT_ASSERT(y->right); + RBT_ASSERT(y->left); + SET_BLACK(y); + RBT_ASSERT(IS_BLACK(x->parent)); + SET_RED(x->parent); + right_rotate(&bfallctr->root, x->parent); + y = x->parent->left; + } + RBT_ASSERT(y); + RBT_ASSERT(IS_BLACK(y)); + if (IS_BLACK(y->right) && IS_BLACK(y->left)) { + SET_RED(y); + x = x->parent; + } + else { + if (IS_BLACK(y->left)) { + SET_BLACK(y->right); + SET_RED(y); + left_rotate(&bfallctr->root, y); + y = x->parent->left; + } + RBT_ASSERT(y); + if (IS_RED(x->parent)) { + SET_BLACK(x->parent); + SET_RED(y); + } + RBT_ASSERT(y->left); + SET_BLACK(y->left); + right_rotate(&bfallctr->root, x->parent); + x = bfallctr->root; + break; + } + } + } + SET_BLACK(x); + + if (null_x.parent) { + if (null_x.parent->left == &null_x) + null_x.parent->left = NULL; + else { + RBT_ASSERT(null_x.parent->right == &null_x); + null_x.parent->right = NULL; + } + RBT_ASSERT(!null_x.left); + RBT_ASSERT(!null_x.right); + } + else if (bfallctr->root == &null_x) { + bfallctr->root = NULL; + RBT_ASSERT(!null_x.left); + RBT_ASSERT(!null_x.right); + } + } + + + DESTROY_TREE_NODE(del); + +#ifdef HARD_DEBUG + check_tree(bfallctr, 0); +#endif + +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * "Address order best fit" specific callbacks. * +\* */ + +static void +aobf_link_free_block(Allctr_t *allctr, Block_t *block) +{ + BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + RBTree_t *blk = (RBTree_t *) block; + Uint blk_sz = BLK_SZ(blk); + + blk->flags = 0; + blk->left = NULL; + blk->right = NULL; + + if (!bfallctr->root) { + blk->parent = NULL; + SET_BLACK(blk); + bfallctr->root = blk; + } + else { + RBTree_t *x = bfallctr->root; + while (1) { + Uint size; + + size = BLK_SZ(x); + + if (blk_sz < size || (blk_sz == size && blk < x)) { + if (!x->left) { + blk->parent = x; + x->left = blk; + break; + } + x = x->left; + } + else { + if (!x->right) { + blk->parent = x; + x->right = blk; + break; + } + x = x->right; + } + + } + + /* Insert block into size tree */ + RBT_ASSERT(blk->parent); + + SET_RED(blk); + if (IS_RED(blk->parent)) + tree_insert_fixup(bfallctr, blk); + } + +#ifdef HARD_DEBUG + check_tree(bfallctr, 0); +#endif +} + +#if 0 /* tree_delete() is directly used instead */ +static void +aobf_unlink_free_block(Allctr_t *allctr, Block_t *block) +{ + tree_delete(allctr, block); +} +#endif + +static Block_t * +aobf_get_free_block(Allctr_t *allctr, Uint size, + Block_t *cand_blk, Uint cand_size) +{ + BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + RBTree_t *x = bfallctr->root; + RBTree_t *blk = NULL; + Uint blk_sz; + + ASSERT(!cand_blk || cand_size >= size); + + while (x) { + blk_sz = BLK_SZ(x); + if (blk_sz < size) { + x = x->right; + } + else { + blk = x; + x = x->left; + } + } + + if (!blk) + return NULL; + +#ifdef HARD_DEBUG + ASSERT(blk == check_tree(bfallctr, size)); +#endif + + if (cand_blk) { + blk_sz = BLK_SZ(blk); + if (cand_size < blk_sz) + return NULL; /* cand_blk was better */ + if (cand_size == blk_sz && ((void *) cand_blk) < ((void *) blk)) + return NULL; /* cand_blk was better */ + } + + aobf_unlink_free_block(allctr, (Block_t *) blk); + + return (Block_t *) blk; +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * "Best fit" specific callbacks. * +\* */ + +static void +bf_link_free_block(Allctr_t *allctr, Block_t *block) +{ + BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + RBTree_t *blk = (RBTree_t *) block; + Uint blk_sz = BLK_SZ(blk); + + SET_TREE_NODE(blk); + + + blk->flags = 0; + blk->left = NULL; + blk->right = NULL; + + if (!bfallctr->root) { + blk->parent = NULL; + SET_BLACK(blk); + bfallctr->root = blk; + } + else { + RBTree_t *x = bfallctr->root; + while (1) { + Uint size; + + size = BLK_SZ(x); + + if (blk_sz == size) { + + SET_LIST_ELEM(blk); + LIST_NEXT(blk) = LIST_NEXT(x); + LIST_PREV(blk) = x; + if (LIST_NEXT(x)) + LIST_PREV(LIST_NEXT(x)) = blk; + LIST_NEXT(x) = blk; + + return; /* Finnished */ + } + else if (blk_sz < size) { + if (!x->left) { + blk->parent = x; + x->left = blk; + break; + } + x = x->left; + } + else { + if (!x->right) { + blk->parent = x; + x->right = blk; + break; + } + x = x->right; + } + } + + RBT_ASSERT(blk->parent); + + SET_RED(blk); + if (IS_RED(blk->parent)) + tree_insert_fixup(bfallctr, blk); + + } + + SET_TREE_NODE(blk); + LIST_NEXT(blk) = NULL; + +#ifdef HARD_DEBUG + check_tree(bfallctr, 0); +#endif +} + +static ERTS_INLINE void +bf_unlink_free_block(Allctr_t *allctr, Block_t *block) +{ + BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + RBTree_t *x = (RBTree_t *) block; + + if (IS_LIST_ELEM(x)) { + /* Remove from list */ + ASSERT(LIST_PREV(x)); + LIST_NEXT(LIST_PREV(x)) = LIST_NEXT(x); + if (LIST_NEXT(x)) + LIST_PREV(LIST_NEXT(x)) = LIST_PREV(x); + } + else if (LIST_NEXT(x)) { + /* Replace tree node by next element in list... */ + + ASSERT(BLK_SZ(LIST_NEXT(x)) == BLK_SZ(x)); + ASSERT(IS_TREE_NODE(x)); + ASSERT(IS_LIST_ELEM(LIST_NEXT(x))); + +#ifdef HARD_DEBUG + check_tree(bfallctr, 0); +#endif + replace(&bfallctr->root, x, LIST_NEXT(x)); + +#ifdef HARD_DEBUG + check_tree(bfallctr, 0); +#endif + } + else { + /* Remove from tree */ + tree_delete(allctr, block); + } + + DESTROY_LIST_ELEM(x); +} + + +static Block_t * +bf_get_free_block(Allctr_t *allctr, Uint size, + Block_t *cand_blk, Uint cand_size) +{ + BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + RBTree_t *x = bfallctr->root; + RBTree_t *blk = NULL; + Uint blk_sz; + + ASSERT(!cand_blk || cand_size >= size); + + while (x) { + blk_sz = BLK_SZ(x); + if (blk_sz < size) { + x = x->right; + } + else { + blk = x; + if (blk_sz == size) + break; + x = x->left; + } + } + + if (!blk) + return NULL; + + ASSERT(IS_TREE_NODE(blk)); + + +#ifdef HARD_DEBUG + { + RBTree_t *ct_blk = check_tree(bfallctr, size); + ASSERT(BLK_SZ(ct_blk) == BLK_SZ(blk)); + } +#endif + + if (cand_blk && cand_size <= BLK_SZ(blk)) + return NULL; /* cand_blk was better */ + + /* Use next block if it exist in order to avoid replacing + the tree node */ + blk = LIST_NEXT(blk) ? LIST_NEXT(blk) : blk; + + bf_unlink_free_block(allctr, (Block_t *) blk); + return (Block_t *) blk; +} + + +/* + * info_options() + */ + +static struct { + Eterm as; + Eterm aobf; + Eterm bf; +#ifdef DEBUG + Eterm end_of_atoms; +#endif +} am; + +static void ERTS_INLINE atom_init(Eterm *atom, char *name) +{ + *atom = am_atom_put(name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static void +init_atoms(void) +{ +#ifdef DEBUG + Eterm *atom; +#endif + + if (atoms_initialized) + return; + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) { + *atom = THE_NON_VALUE; + } +#endif + AM_INIT(as); + AM_INIT(aobf); + AM_INIT(bf); + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { + ASSERT(*atom != THE_NON_VALUE); + } +#endif + + atoms_initialized = 1; +} + + +#define bld_uint erts_bld_uint +#define bld_cons erts_bld_cons +#define bld_tuple erts_bld_tuple + +static ERTS_INLINE void +add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 2, el1, el2), *lp); +} + +static Eterm +info_options(Allctr_t *allctr, + char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + BFAllctr_t *bfallctr = (BFAllctr_t *) allctr; + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + erts_print(*print_to_p, + print_to_arg, + "%sas: %s\n", + prefix, + bfallctr->address_order ? "aobf" : "bf"); + } + + if (hpp || szp) { + + if (!atoms_initialized) + erl_exit(1, "%s:%d: Internal error: Atoms not initialized", + __FILE__, __LINE__);; + + res = NIL; + add_2tup(hpp, szp, &res, + am.as, + bfallctr->address_order ? am.aobf : am.bf); + } + + return res; +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * NOTE: erts_bfalc_test() is only supposed to be used for testing. * + * * + * Keep alloc_SUITE_data/allocator_test.h updated if changes are made * + * to erts_bfalc_test() * +\* */ + +unsigned long +erts_bfalc_test(unsigned long op, unsigned long a1, unsigned long a2) +{ + switch (op) { + case 0x200: return (unsigned long) ((BFAllctr_t *) a1)->address_order; + case 0x201: return (unsigned long) ((BFAllctr_t *) a1)->root; + case 0x202: return (unsigned long) ((RBTree_t *) a1)->parent; + case 0x203: return (unsigned long) ((RBTree_t *) a1)->left; + case 0x204: return (unsigned long) ((RBTree_t *) a1)->right; + case 0x205: return (unsigned long) ((RBTreeList_t *) a1)->next; + case 0x206: return (unsigned long) IS_BLACK((RBTree_t *) a1); + case 0x207: return (unsigned long) IS_TREE_NODE((RBTree_t *) a1); + default: ASSERT(0); return ~((unsigned long) 0); + } +} + + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Debug functions * +\* */ + + +#ifdef HARD_DEBUG + +#define IS_LEFT_VISITED(FB) ((FB)->flags & LEFT_VISITED_FLG) +#define IS_RIGHT_VISITED(FB) ((FB)->flags & RIGHT_VISITED_FLG) + +#define SET_LEFT_VISITED(FB) ((FB)->flags |= LEFT_VISITED_FLG) +#define SET_RIGHT_VISITED(FB) ((FB)->flags |= RIGHT_VISITED_FLG) + +#define UNSET_LEFT_VISITED(FB) ((FB)->flags &= ~LEFT_VISITED_FLG) +#define UNSET_RIGHT_VISITED(FB) ((FB)->flags &= ~RIGHT_VISITED_FLG) + + +#if 0 +# define PRINT_TREE +#else +# undef PRINT_TREE +#endif + +#ifdef PRINT_TREE +static void print_tree(BFAllctr_t *); +#endif + +/* + * Checks that the order between parent and children are correct, + * and that the Red-Black Tree properies are satisfied. if size > 0, + * check_tree() returns a node that satisfies "best fit" resp. + * "address order best fit". + * + * The Red-Black Tree properies are: + * 1. Every node is either red or black. + * 2. Every leaf (NIL) is black. + * 3. If a node is red, then both its children are black. + * 4. Every simple path from a node to a descendant leaf + * contains the same number of black nodes. + */ + +static RBTree_t * +check_tree(BFAllctr_t *bfallctr, Uint size) +{ + RBTree_t *res = NULL; + Sint blacks; + Sint curr_blacks; + RBTree_t *x; + +#ifdef PRINT_TREE + print_tree(bfallctr); +#endif + + if (!bfallctr->root) + return res; + + x = bfallctr->root; + ASSERT(IS_BLACK(x)); + ASSERT(!x->parent); + curr_blacks = 1; + blacks = -1; + + while (x) { + if (!IS_LEFT_VISITED(x)) { + SET_LEFT_VISITED(x); + if (x->left) { + x = x->left; + if (IS_BLACK(x)) + curr_blacks++; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + ASSERT(blacks == curr_blacks); + } + } + + if (!IS_RIGHT_VISITED(x)) { + SET_RIGHT_VISITED(x); + if (x->right) { + x = x->right; + if (IS_BLACK(x)) + curr_blacks++; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + ASSERT(blacks == curr_blacks); + } + } + + + if (IS_RED(x)) { + ASSERT(IS_BLACK(x->right)); + ASSERT(IS_BLACK(x->left)); + } + + ASSERT(x->parent || x == bfallctr->root); + + if (x->left) { + ASSERT(x->left->parent == x); + if (bfallctr->address_order) { + ASSERT(BLK_SZ(x->left) < BLK_SZ(x) + || (BLK_SZ(x->left) == BLK_SZ(x) && x->left < x)); + } + else { + ASSERT(IS_TREE_NODE(x->left)); + ASSERT(BLK_SZ(x->left) < BLK_SZ(x)); + } + } + + if (x->right) { + ASSERT(x->right->parent == x); + if (bfallctr->address_order) { + ASSERT(BLK_SZ(x->right) > BLK_SZ(x) + || (BLK_SZ(x->right) == BLK_SZ(x) && x->right > x)); + } + else { + ASSERT(IS_TREE_NODE(x->right)); + ASSERT(BLK_SZ(x->right) > BLK_SZ(x)); + } + } + + if (size && BLK_SZ(x) >= size) { + if (bfallctr->address_order) { + if (!res + || BLK_SZ(x) < BLK_SZ(res) + || (BLK_SZ(x) == BLK_SZ(res) && x < res)) + res = x; + } + else { + if (!res || BLK_SZ(x) < BLK_SZ(res)) + res = x; + } + } + + UNSET_LEFT_VISITED(x); + UNSET_RIGHT_VISITED(x); + if (IS_BLACK(x)) + curr_blacks--; + x = x->parent; + + } + + ASSERT(curr_blacks == 0); + + UNSET_LEFT_VISITED(bfallctr->root); + UNSET_RIGHT_VISITED(bfallctr->root); + + return res; + +} + + +#ifdef PRINT_TREE +#define INDENT_STEP 2 + +#include + +static void +print_tree_aux(RBTree_t *x, int indent) +{ + int i; + + if (!x) { + for (i = 0; i < indent; i++) { + putc(' ', stderr); + } + fprintf(stderr, "BLACK: nil\r\n"); + } + else { + print_tree_aux(x->right, indent + INDENT_STEP); + for (i = 0; i < indent; i++) { + putc(' ', stderr); + } + fprintf(stderr, "%s: sz=%lu addr=0x%lx\r\n", + IS_BLACK(x) ? "BLACK" : "RED", + BLK_SZ(x), + (Uint) x); + print_tree_aux(x->left, indent + INDENT_STEP); + } +} + + +static void +print_tree(BFAllctr_t *bfallctr) +{ + char *type = bfallctr->address_order ? "Size-Adress" : "Size"; + fprintf(stderr, " --- %s tree begin ---\r\n", type); + print_tree_aux(bfallctr->root, 0); + fprintf(stderr, " --- %s tree end ---\r\n", type); +} + +#endif + +#endif diff --git a/erts/emulator/beam/erl_bestfit_alloc.h b/erts/emulator/beam/erl_bestfit_alloc.h new file mode 100644 index 0000000000..cb35e21e57 --- /dev/null +++ b/erts/emulator/beam/erl_bestfit_alloc.h @@ -0,0 +1,64 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +#ifndef ERL_BESTFIT_ALLOC__ +#define ERL_BESTFIT_ALLOC__ + +#include "erl_alloc_util.h" + +#define ERTS_ALC_BF_ALLOC_VSN_STR "0.9" +#define ERTS_ALC_AOBF_ALLOC_VSN_STR "0.9" + +typedef struct BFAllctr_t_ BFAllctr_t; + +typedef struct { + int ao; +} BFAllctrInit_t; + +#define ERTS_DEFAULT_BF_ALLCTR_INIT { \ + 0 /* (bool) ao: address order */\ +} + +void erts_bfalc_init(void); +Allctr_t *erts_bfalc_start(BFAllctr_t *, BFAllctrInit_t *, AllctrInit_t *); + +#endif /* #ifndef ERL_BESTFIT_ALLOC__ */ + + + +#if defined(GET_ERL_BF_ALLOC_IMPL) && !defined(ERL_BF_ALLOC_IMPL__) +#define ERL_BF_ALLOC_IMPL__ + +#define GET_ERL_ALLOC_UTIL_IMPL +#include "erl_alloc_util.h" + +typedef struct RBTree_t_ RBTree_t; + +struct BFAllctr_t_ { + Allctr_t allctr; /* Has to be first! */ + + RBTree_t * root; + int address_order; +}; + +unsigned long erts_bfalc_test(unsigned long, unsigned long, unsigned long); + +#endif /* #if defined(GET_ERL_BF_ALLOC_IMPL) + && !defined(ERL_BF_ALLOC_IMPL__) */ diff --git a/erts/emulator/beam/erl_bif_chksum.c b/erts/emulator/beam/erl_bif_chksum.c new file mode 100644 index 0000000000..445ba00ca7 --- /dev/null +++ b/erts/emulator/beam/erl_bif_chksum.c @@ -0,0 +1,612 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "erl_binary.h" +#include "big.h" +#include "zlib.h" + + +typedef void (*ChksumFun)(void *sum_in_out, unsigned char *buf, + unsigned buflen); + +/* Hidden trap target */ +static BIF_RETTYPE md5_2(BIF_ALIST_2); + +static Export chksum_md5_2_exp; + +void erts_init_bif_chksum(void) +{ + /* Non visual BIF to trap to. */ + memset(&chksum_md5_2_exp, 0, sizeof(Export)); + chksum_md5_2_exp.address = + &chksum_md5_2_exp.code[3]; + chksum_md5_2_exp.code[0] = am_erlang; + chksum_md5_2_exp.code[1] = am_atom_put("md5_trap",8); + chksum_md5_2_exp.code[2] = 2; + chksum_md5_2_exp.code[3] = + (Eterm) em_apply_bif; + chksum_md5_2_exp.code[4] = + (Eterm) &md5_2; +} + + +static Eterm do_chksum(ChksumFun sumfun, Process *p, Eterm ioterm, int left, + void *sum, int *res, int *err) +{ + Eterm *objp; + Eterm obj; + int c; + DECLARE_ESTACK(stack); + unsigned char *bytes = NULL; + int numbytes = 0; + + *err = 0; + if (left <= 0 || is_nil(ioterm)) { + DESTROY_ESTACK(stack); + *res = 0; + return ioterm; + } + if(is_binary(ioterm)) { + Uint bitoffs; + Uint bitsize; + Uint size; + Eterm res_term = NIL; + unsigned char *bytes; + byte *temp_alloc = NULL; + + ERTS_GET_BINARY_BYTES(ioterm, bytes, bitoffs, bitsize); + if (bitsize != 0) { + *res = 0; + *err = 1; + DESTROY_ESTACK(stack); + return NIL; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(ioterm, &temp_alloc); + /* The call to erts_get_aligned_binary_bytes cannot fail as + we'we already checked bitsize and that this is a binary */ + } + + size = binary_size(ioterm); + + + if (size > left) { + Eterm *hp; + ErlSubBin *sb; + Eterm orig; + Uint offset; + /* Split the binary in two parts, of which we + only process the first */ + hp = HAlloc(p, ERL_SUB_BIN_SIZE); + sb = (ErlSubBin *) hp; + ERTS_GET_REAL_BIN(ioterm, orig, offset, bitoffs, bitsize); + sb->thing_word = HEADER_SUB_BIN; + sb->size = size - left; + sb->offs = offset + left; + sb->orig = orig; + sb->bitoffs = bitoffs; + sb->bitsize = bitsize; + sb->is_writable = 0; + res_term = make_binary(sb); + size = left; + } + (*sumfun)(sum, bytes, size); + *res = size; + DESTROY_ESTACK(stack); + erts_free_aligned_binary_bytes(temp_alloc); + return res_term; + } + + if (!is_list(ioterm)) { + *res = 0; + *err = 1; + DESTROY_ESTACK(stack); + return NIL; + } + + /* OK a list, needs to be processed in order, handling each flat list-level + as they occur, just like io_list_to_binary would */ + *res = 0; + ESTACK_PUSH(stack,ioterm); + while (!ESTACK_ISEMPTY(stack) && left) { + ioterm = ESTACK_POP(stack); + if (is_nil(ioterm)) { + /* ignore empty lists */ + continue; + } + if(is_list(ioterm)) { +L_Again: /* Restart with sublist, old listend was pushed on stack */ + objp = list_val(ioterm); + obj = CAR(objp); + for(;;) { /* loop over one flat list of bytes and binaries + until sublist or list end is encountered */ + if (is_byte(obj)) { + int bsize = 0; + for(;;) { + if (bsize >= numbytes) { + if (!bytes) { + bytes = erts_alloc(ERTS_ALC_T_TMP, + numbytes = 500); + } else { + if (numbytes > left) { + numbytes += left; + } else { + numbytes *= 2; + } + bytes = erts_realloc(ERTS_ALC_T_TMP, bytes, + numbytes); + } + } + bytes[bsize++] = (unsigned char) unsigned_val(obj); + --left; + ioterm = CDR(objp); + if (!is_list(ioterm)) { + break; + } + objp = list_val(ioterm); + obj = CAR(objp); + if (!is_byte(obj)) + break; + if (!left) { + break; + } + } + (*sumfun)(sum, bytes, bsize); + *res += bsize; + } else if (is_nil(obj)) { + ioterm = CDR(objp); + if (!is_list(ioterm)) { + break; + } + objp = list_val(ioterm); + obj = CAR(objp); + } else if (is_list(obj)) { + /* push rest of list for later processing, start + again with sublist */ + ESTACK_PUSH(stack,CDR(objp)); + ioterm = obj; + goto L_Again; + } else if (is_binary(obj)) { + int sres, serr; + Eterm rest_term; + rest_term = do_chksum(sumfun, p, obj, left, sum, &sres, + &serr); + *res += sres; + if (serr != 0) { + *err = 1; + DESTROY_ESTACK(stack); + if (bytes != NULL) + erts_free(ERTS_ALC_T_TMP, bytes); + return NIL; + } + left -= sres; + if (rest_term != NIL) { + Eterm *hp; + hp = HAlloc(p, 2); + obj = CDR(objp); + ioterm = CONS(hp, rest_term, obj); + left = 0; + break; + } + ioterm = CDR(objp); + if (is_list(ioterm)) { + /* objp and obj need to be updated if + loop is to continue */ + objp = list_val(ioterm); + obj = CAR(objp); + } + } else { + *err = 1; + DESTROY_ESTACK(stack); + if (bytes != NULL) + erts_free(ERTS_ALC_T_TMP, bytes); + return NIL; + } + if (!left || is_nil(ioterm) || !is_list(ioterm)) { + break; + } + } /* for(;;) */ + } /* is_list(ioterm) */ + + if (!left) { +#ifdef ALLOW_BYTE_TAIL + if (is_byte(ioterm)) { + /* inproper list with byte tail*/ + Eterm *hp; + hp = HAlloc(p, 2); + ioterm = CONS(hp, ioterm, NIL); + } +#else + ; +#endif + } else if (!is_list(ioterm) && !is_nil(ioterm)) { + /* inproper list end */ +#ifdef ALLOW_BYTE_TAIL + if (is_byte(ioterm)) { + unsigned char b[1]; + b[0] = (unsigned char) unsigned_val(ioterm); + (*sumfun)(sum, b, 1); + ++(*res); + --left; + ioterm = NIL; + } else +#endif + if is_binary(ioterm) { + int sres, serr; + ioterm = do_chksum(sumfun, p, ioterm, left, sum, &sres, &serr); + *res +=sres; + if (serr != 0) { + *err = 1; + DESTROY_ESTACK(stack); + if (bytes != NULL) + erts_free(ERTS_ALC_T_TMP, bytes); + return NIL; + } + left -= sres; + } else { + *err = 1; + DESTROY_ESTACK(stack); + if (bytes != NULL) + erts_free(ERTS_ALC_T_TMP, bytes); + return NIL; + } + } + } /* while left and not estack empty */ + c = ESTACK_COUNT(stack); + if (c > 0) { + Eterm *hp = HAlloc(p,2*c); + while(!ESTACK_ISEMPTY(stack)) { + Eterm st = ESTACK_POP(stack); + ioterm = CONS(hp, ioterm, st); + hp += 2; + } + } + DESTROY_ESTACK(stack); + if (bytes != NULL) + erts_free(ERTS_ALC_T_TMP, bytes); + return ioterm; +} + +static void adler32_wrap(void *vsum, unsigned char *buf, unsigned buflen) +{ + unsigned long sum = *((unsigned long *) vsum); + sum = adler32(sum,buf,buflen); + *((unsigned long *) vsum) = sum; +} + +static void crc32_wrap(void *vsum, unsigned char *buf, unsigned buflen) +{ + unsigned long sum = *((unsigned long *) vsum); + sum = crc32(sum,buf,buflen); + *((unsigned long *) vsum) = sum; +} + +static void md5_wrap(void *vsum, unsigned char *buf, unsigned buflen) +{ + MD5_CTX *ctx = ((MD5_CTX *) vsum); + MD5Update(ctx,buf,buflen); +} + +#define BYTES_PER_REDUCTION 10 +#define CHUNK_PER_SCHEDULE (BYTES_PER_REDUCTION * CONTEXT_REDS) + +BIF_RETTYPE +crc32_1(BIF_ALIST_1) +{ + unsigned long chksum; + int res, err; + Eterm rest,res_sum; + chksum = crc32(0,NULL,0); + + rest = do_chksum(&crc32_wrap,BIF_P,BIF_ARG_1,CHUNK_PER_SCHEDULE, + (void *) &chksum,&res, + &err); + BUMP_REDS(BIF_P,res / BYTES_PER_REDUCTION); + if (err != 0) { + BIF_ERROR(BIF_P, BADARG); + } + res_sum = erts_make_integer(chksum,BIF_P); + if (rest != NIL) { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_crc32_2], BIF_P, res_sum, rest); + } + BIF_RET(res_sum); +} + +BIF_RETTYPE +crc32_2(BIF_ALIST_2) +{ + unsigned long chksum; + int res, err; + Eterm rest,res_sum; + Uint u; + if (!term_to_Uint(BIF_ARG_1, &u) || ((u >> 16) >> 16) != 0) { + BIF_ERROR(BIF_P, BADARG); + } + chksum = (unsigned long) u; + + rest = do_chksum(&crc32_wrap,BIF_P,BIF_ARG_2,CHUNK_PER_SCHEDULE, + (void *) &chksum,&res, + &err); + BUMP_REDS(BIF_P,res / BYTES_PER_REDUCTION); + if (err != 0) { + BIF_ERROR(BIF_P, BADARG); + } + res_sum = erts_make_integer(chksum,BIF_P); + if (rest != NIL) { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_crc32_2], BIF_P, res_sum, rest); + } + BIF_RET(res_sum); +} + +BIF_RETTYPE +crc32_combine_3(BIF_ALIST_3) +{ + unsigned long chksum1,chksum2; + z_off_t length; + Uint32 res; + Eterm res_sum; + Uint u; + + if (!term_to_Uint(BIF_ARG_1, &u) || ((u >> 16) >> 16) != 0) { + BIF_ERROR(BIF_P, BADARG); + } + chksum1 = (unsigned long) u; + + if (!term_to_Uint(BIF_ARG_2, &u) || ((u >> 16) >> 16) != 0) { + BIF_ERROR(BIF_P, BADARG); + } + chksum2 = (unsigned long) u; + + if (!term_to_Uint(BIF_ARG_3, &u) || ((u >> 16) >> 16) != 0) { + BIF_ERROR(BIF_P, BADARG); + } + length = (z_off_t) u; + + res = (Uint32) crc32_combine(chksum1,chksum2,length); + + res_sum = erts_make_integer(res,BIF_P); + BIF_RET(res_sum); +} + +BIF_RETTYPE +adler32_1(BIF_ALIST_1) +{ + unsigned long chksum; + int res, err; + Eterm rest,res_sum; + chksum = adler32(0,NULL,0); + + rest = do_chksum(&adler32_wrap,BIF_P,BIF_ARG_1,CHUNK_PER_SCHEDULE, + (void *) &chksum,&res, + &err); + BUMP_REDS(BIF_P,res / BYTES_PER_REDUCTION); + if (err != 0) { + BIF_ERROR(BIF_P, BADARG); + } + res_sum = erts_make_integer(chksum,BIF_P); + if (rest != NIL) { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_adler32_2], BIF_P, res_sum, rest); + } + BIF_RET(res_sum); +} + +BIF_RETTYPE +adler32_2(BIF_ALIST_2) +{ + unsigned long chksum; + int res, err; + Eterm rest,res_sum; + Uint u; + if (!term_to_Uint(BIF_ARG_1, &u) || ((u >> 16) >> 16) != 0) { + BIF_ERROR(BIF_P, BADARG); + } + chksum = (unsigned long) u; + + rest = do_chksum(&adler32_wrap,BIF_P,BIF_ARG_2,CHUNK_PER_SCHEDULE, + (void *) &chksum,&res, + &err); + BUMP_REDS(BIF_P,res / BYTES_PER_REDUCTION); + if (err != 0) { + BIF_ERROR(BIF_P, BADARG); + } + res_sum = erts_make_integer(chksum,BIF_P); + if (rest != NIL) { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_adler32_2], BIF_P, res_sum, rest); + } + BIF_RET(res_sum); +} + +BIF_RETTYPE +adler32_combine_3(BIF_ALIST_3) +{ + unsigned long chksum1,chksum2; + z_off_t length; + Uint32 res; + Eterm res_sum; + Uint u; + + if (!term_to_Uint(BIF_ARG_1, &u) || ((u >> 16) >> 16) != 0) { + BIF_ERROR(BIF_P, BADARG); + } + chksum1 = (unsigned long) u; + + if (!term_to_Uint(BIF_ARG_2, &u) || ((u >> 16) >> 16) != 0) { + BIF_ERROR(BIF_P, BADARG); + } + chksum2 = (unsigned long) u; + + if (!term_to_Uint(BIF_ARG_3, &u) || ((u >> 16) >> 16) != 0) { + BIF_ERROR(BIF_P, BADARG); + } + length = (z_off_t) u; + + if (length == 0) { /* Workaround for unexpected behaviour in zlib. */ + res = (Uint32) chksum1; + } else { + res = (Uint32) adler32_combine(chksum1,chksum2,length); + } + + res_sum = erts_make_integer(res,BIF_P); + BIF_RET(res_sum); +} + + +BIF_RETTYPE +md5_1(BIF_ALIST_1) +{ + Eterm bin; + byte* bytes; + Eterm rest; + int res, err; + + MD5_CTX context; + MD5Init(&context); + + rest = do_chksum(&md5_wrap,BIF_P,BIF_ARG_1,100,(void *) &context,&res, + &err); + if (err != 0) { + BUMP_REDS(BIF_P,res); + BIF_ERROR(BIF_P, BADARG); + } + if (rest != NIL) { + BUMP_ALL_REDS(BIF_P); + bin = new_binary(BIF_P, (byte *) &context, sizeof(MD5_CTX)); + BIF_TRAP2(&chksum_md5_2_exp, BIF_P, bin, rest); + } + BUMP_REDS(BIF_P,res); + bin = new_binary(BIF_P, (byte *)NULL, 16); + bytes = binary_bytes(bin); + MD5Final(bytes, &context); + BIF_RET(bin); +} + +/* Hidden trap target */ +static BIF_RETTYPE +md5_2(BIF_ALIST_2) +{ + byte *bytes; + MD5_CTX context; + Eterm rest; + Eterm bin; + int res, err; + + /* No need to check context, this function cannot be called with unaligned + or badly sized context as it's always trapped to. */ + bytes = binary_bytes(BIF_ARG_1); + memcpy(&context,bytes,sizeof(MD5_CTX)); + rest = do_chksum(&md5_wrap,BIF_P,BIF_ARG_2,100,(void *) &context,&res, + &err); + if (err != 0) { + BUMP_REDS(BIF_P,res); + BIF_ERROR(BIF_P, BADARG); + } + if (rest != NIL) { + BUMP_ALL_REDS(BIF_P); + bin = new_binary(BIF_P, (byte *) &context, sizeof(MD5_CTX)); + BIF_TRAP2(&chksum_md5_2_exp, BIF_P, bin, rest); + } + BUMP_REDS(BIF_P,res); + bin = new_binary(BIF_P, (byte *)NULL, 16); + bytes = binary_bytes(bin); + MD5Final(bytes, &context); + BIF_RET(bin); +} + +BIF_RETTYPE +md5_init_0(BIF_ALIST_0) +{ + Eterm bin; + byte* bytes; + + bin = erts_new_heap_binary(BIF_P, (byte *)NULL, sizeof(MD5_CTX), &bytes); + MD5Init((MD5_CTX *)bytes); + BIF_RET(bin); +} + +BIF_RETTYPE +md5_update_2(BIF_ALIST_2) +{ + byte *bytes; + MD5_CTX context; + Eterm rest; + Eterm bin; + int res, err; + byte *temp_alloc = NULL; + + if ((bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc)) == NULL) { + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); + } + if (binary_size(BIF_ARG_1) != sizeof(MD5_CTX)) { + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); + } + memcpy(&context,bytes,sizeof(MD5_CTX)); + erts_free_aligned_binary_bytes(temp_alloc); + rest = do_chksum(&md5_wrap,BIF_P,BIF_ARG_2,100,(void *) &context,&res, + &err); + if (err != 0) { + BUMP_REDS(BIF_P,res); + BIF_ERROR(BIF_P, BADARG); + } + bin = new_binary(BIF_P, (byte *) &context, sizeof(MD5_CTX)); + if (rest != NIL) { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_md5_update_2], BIF_P, bin, rest); + } + BUMP_REDS(BIF_P,res); + BIF_RET(bin); +} + +BIF_RETTYPE +md5_final_1(BIF_ALIST_1) +{ + Eterm bin; + byte* context; + byte* result; + MD5_CTX ctx_copy; + byte* temp_alloc = NULL; + + if ((context = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc)) == NULL) { + error: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); + } + if (binary_size(BIF_ARG_1) != sizeof(MD5_CTX)) { + goto error; + } + bin = erts_new_heap_binary(BIF_P, (byte *)NULL, 16, &result); + memcpy(&ctx_copy, context, sizeof(MD5_CTX)); + erts_free_aligned_binary_bytes(temp_alloc); + MD5Final(result, &ctx_copy); + BIF_RET(bin); +} diff --git a/erts/emulator/beam/erl_bif_ddll.c b/erts/emulator/beam/erl_bif_ddll.c new file mode 100644 index 0000000000..9d5f0d9c02 --- /dev/null +++ b/erts/emulator/beam/erl_bif_ddll.c @@ -0,0 +1,1964 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * BIFs belonging to the 'erl_ddll' module together with utility + * functions for dynamic loading. The actual loading is done in + * erl_sys_ddll.c in respective system dependent directory. The + * driver structure contains a handle to the actual loaded "module" as + * well as record keeping information about processes having loaded + * the driver and processes monitoring the driver. A process in any + * way involved in ddll-drivers, get a special flag, which triggers + * cleenup at process exit. + */ + + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERL_SYS_DRV + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "big.h" +#include "dist.h" +#include "erl_version.h" + +#ifdef ERTS_SMP +#define DDLL_SMP 1 +#else +#define DDLL_SMP 0 +#endif + + +/* + * Local types + */ + +typedef struct { + Eterm pid; + Process *proc; + Uint status; + Uint count; +} ProcEntryInfo; + +/* + * Forward + */ +static char *pick_list_or_atom(Eterm name_term); +static erts_driver_t *lookup_driver(char *name); +static Eterm mkatom(char *str); +static void add_proc_loaded(DE_Handle *dh, Process *proc); +static void add_proc_loaded_deref(DE_Handle *dh, Process *proc); +static void set_driver_reloading(DE_Handle *dh, Process *proc, char *path, char *name, Uint flags); +static int load_driver_entry(DE_Handle **dhp, char *path, char *name); +static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name); +static int do_load_driver_entry(DE_Handle *dh, char *path, char *name); +#if 0 +static void unload_driver_entry(DE_Handle *dh); +#endif +static int reload_driver_entry(DE_Handle *dh); +static int build_proc_info(DE_Handle *dh, ProcEntryInfo **out_pei, Uint filter); +static int is_last_user(DE_Handle *dh, Process *proc); +static DE_ProcEntry *find_proc_entry(DE_Handle *dh, Process *proc, Uint status); +static void remove_proc_entry(DE_Handle *dh, DE_ProcEntry *pe); +static int num_procs(DE_Handle *dh, Uint status); +/*static int num_entries(DE_Handle *dh, Process *proc, Uint status);*/ +static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, + Eterm type, Eterm tag, int errcode); +static void notify_all(DE_Handle *dh, char *name, Uint awaiting, Eterm type, Eterm tag); +static int load_error_need(int code); +static Eterm build_load_error_hp(Eterm *hp, int code); +static Eterm build_load_error(Process *p, int code); +static int errdesc_to_code(Eterm errdesc, int *code /* out */); +static Eterm add_monitor(Process *p, DE_Handle *dh, Uint status); +static Eterm notify_when_loaded(Process *p, Eterm name_term, char *name, + ErtsProcLocks plocks); +static Eterm notify_when_unloaded(Process *p, Eterm name_term, char *name, + ErtsProcLocks plocks, Uint flag); +static void first_ddll_reference(DE_Handle *dh); +static void dereference_all_processes(DE_Handle *dh); +static void restore_process_references(DE_Handle *dh); +static void ddll_no_more_references(void *vdh); + +#define lock_drv_list() erts_smp_mtx_lock(&erts_driver_list_lock) +#define unlock_drv_list() erts_smp_mtx_unlock(&erts_driver_list_lock) +#define assert_drv_list_locked() \ + ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&erts_driver_list_lock)) +#define assert_drv_list_not_locked() \ + ERTS_SMP_LC_ASSERT(!erts_smp_lc_mtx_is_locked(&erts_driver_list_lock)) + + +#define FREE_PORT_FLAGS (ERTS_PORT_SFLGS_DEAD & (~ERTS_PORT_SFLG_INITIALIZING)) + +/* + * try_load(Path, Name, OptionList) -> {ok,Status} | + * {ok, PendingStatus, Ref} | + * {error, ErrorDesc} + * Path = Name = string() | atom() + * OptionList = [ Option ] + * Option = {driver_options, DriverOptionList} | + * {monitor,MonitorOption} | + * {reload, ReloadOption} + * DriverOptionList = [ DriverOption ] + * DriverOption = kill_ports + * MonitorOption = pending_driver | pending + * ReloadOption = pending_driver | pending + * Status = loaded | already_loaded | PendingStatus + * PendingStatus = pending_driver | pending_process + * Ref = ref() + * ErrorDesc = ErrorAtom | OpaqueError + * ErrorAtom = linked_in_driver | inconsistent | + * permanent | pending + */ +/* + * Try to load. If the driver is OK, add as LOADED. If the driver is + * UNLOAD, possibly change to reload and add as LOADED, + * there should be no other + * LOADED tagged pid's. If the driver is RELOAD then add/increment as + * LOADED (should be some LOADED pid). If the driver is not present, + * really load and add as LOADED {ok,loaded} {ok,pending_driver} + * {error, permanent} {error,load_error()} + */ +BIF_RETTYPE erl_ddll_try_load_3(Process *p, Eterm path_term, + Eterm name_term, Eterm options) +{ + char *path = NULL; + int path_len; + char *name = NULL; + DE_Handle *dh; + erts_driver_t *drv; + int res; + Eterm soft_error_term = NIL; + Eterm ok_term = NIL; + Eterm *hp; + Eterm t; + int monitor = 0; + int reload = 0; + Eterm l; + Uint flags = 0; + int kill_ports = 0; + int do_build_load_error = 0; + int build_this_load_error = 0; + + for(l = options; is_list(l); l = CDR(list_val(l))) { + Eterm opt = CAR(list_val(l)); + Eterm *tp; + if (is_not_tuple(opt)) { + goto error; + } + tp = tuple_val(opt); + if (*tp != make_arityval(2) || is_not_atom(tp[1])) { + goto error; + } + switch (tp[1]) { + case am_driver_options: + { + Eterm ll; + for(ll = tp[2]; is_list(ll); ll = CDR(list_val(ll))) { + Eterm dopt = CAR(list_val(ll)); + if (dopt == am_kill_ports) { + flags |= ERL_DE_FL_KILL_PORTS; + } else { + goto error; + } + } + if (is_not_nil(ll)) { + goto error; + } + } + break; + case am_monitor: + if (tp[2] == am_pending_driver) { + monitor = 1; + } else if (tp[2] == am_pending ) { + monitor = 2; + } else { + goto error; + } + break; + case am_reload: + if (tp[2] == am_pending_driver) { + reload = 1; + } else if (tp[2] == am_pending ) { + reload = 2; + } else { + goto error; + } + break; + default: + goto error; + } + } + if (is_not_nil(l)) { + goto error; + } + + + if ((name = pick_list_or_atom(name_term)) == NULL) { + goto error; + } + + path_len = io_list_len(path_term); + + if (path_len <= 0) { + goto error; + } + path = erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF, path_len + 1 /* might need path separator */ + sys_strlen(name) + 1); + if (io_list_to_buf(path_term, path, path_len) != 0) { + goto error; + } + while (path_len > 0 && (path[path_len-1] == '\\' || path[path_len-1] == '/')) { + --path_len; + } + path[path_len++] = '/'; + /*path[path_len] = '\0';*/ + sys_strcpy(path+path_len,name); + +#if DDLL_SMP + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + lock_drv_list(); +#endif + if ((drv = lookup_driver(name)) != NULL) { + if (drv->handle == NULL) { + /* static_driver */ + soft_error_term = am_linked_in_driver; + goto soft_error; + } else { + dh = drv->handle; + if (dh->status == ERL_DE_OK) { + int is_last = is_last_user(dh,p); + if (reload == 1 && !is_last) { + /*Want reload if no other users, + but there are others...*/ + soft_error_term = am_pending_process; + goto soft_error; + } + if (reload != 0) { + DE_ProcEntry *old; + if ((dh->flags & ERL_FL_CONSISTENT_MASK) != + (flags & ERL_FL_CONSISTENT_MASK)) { + soft_error_term = am_inconsistent; + goto soft_error; + } + if ((old = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) == + NULL) { + soft_error_term = am_not_loaded_by_this_process; + goto soft_error; + } else { + remove_proc_entry(dh, old); + erts_ddll_dereference_driver(dh); + erts_free(ERTS_ALC_T_DDLL_PROCESS, old); + } + /* Reload requested and granted */ + dereference_all_processes(dh); + set_driver_reloading(dh, p, path, name, flags); + if (dh->flags & ERL_DE_FL_KILL_PORTS) { + kill_ports = 1; + } + ok_term = (reload == 1) ? am_pending_driver : + am_pending_process; + } else { + /* Already loaded and healthy (might be by me) */ + if (sys_strcmp(dh->full_path, path) || + (dh->flags & ERL_FL_CONSISTENT_MASK) != + (flags & ERL_FL_CONSISTENT_MASK)) { + soft_error_term = am_inconsistent; + goto soft_error; + } + add_proc_loaded(dh,p); + erts_ddll_reference_driver(dh); + monitor = 0; + ok_term = mkatom("already_loaded"); + } + } else if (dh->status == ERL_DE_UNLOAD || + dh->status == ERL_DE_FORCE_UNLOAD) { + /* pending driver */ + if (reload != 0) { + soft_error_term = am_not_loaded_by_this_process; + goto soft_error; + } + if (sys_strcmp(dh->full_path, path) || + (dh->flags & ERL_FL_CONSISTENT_MASK) != + (flags & ERL_FL_CONSISTENT_MASK)) { + soft_error_term = am_inconsistent; + goto soft_error; + } + dh->status = ERL_DE_OK; + notify_all(dh, drv->name, + ERL_DE_PROC_AWAIT_UNLOAD, am_UP, + am_unload_cancelled); + add_proc_loaded(dh,p); + erts_ddll_reference_driver(dh); + monitor = 0; + ok_term = mkatom("already_loaded"); + } else if (dh->status == ERL_DE_RELOAD || + dh->status == ERL_DE_FORCE_RELOAD) { + if (reload != 0) { + soft_error_term = am_pending_reload; + goto soft_error; + } + if (sys_strcmp(dh->reload_full_path, path) || + (dh->reload_flags & ERL_FL_CONSISTENT_MASK) != + (flags & ERL_FL_CONSISTENT_MASK)) { + soft_error_term = am_inconsistent; + goto soft_error; + } + /* Load of granted unload... */ + add_proc_loaded_deref(dh,p); /* Dont reference, will happen after reload */ + ++monitor; + ok_term = am_pending_driver; + } else { /* ERL_DE_PERMANENT */ + soft_error_term = am_permanent; + goto soft_error; + } + } + } else { /* driver non-existing */ + if (reload != 0) { + soft_error_term = am_not_loaded; + goto soft_error; + } + if ((res = load_driver_entry(&dh, path, name)) != ERL_DE_NO_ERROR) { + build_this_load_error = res; + do_build_load_error = 1; + soft_error_term = am_undefined; + goto soft_error; + } else { + dh->flags = flags; + add_proc_loaded(dh,p); + first_ddll_reference(dh); + monitor = 0; + ok_term = mkatom("loaded"); + } + } + assert_drv_list_locked(); + if (kill_ports) { + int j; + /* Avoid closing the driver by referencing it */ + erts_ddll_reference_driver(dh); + ASSERT(dh->status == ERL_DE_RELOAD); + dh->status = ERL_DE_FORCE_RELOAD; +#if DDLL_SMP + unlock_drv_list(); +#endif + for (j = 0; j < erts_max_ports; j++) { + Port* prt = &erts_port[j]; +#ifdef DDLL_SMP + erts_smp_port_state_lock(prt); +#endif + if (!(prt->status & FREE_PORT_FLAGS) && + prt->drv_ptr->handle == dh) { +#if DDLL_SMP + erts_smp_atomic_inc(&prt->refc); + /* Extremely rare spinlock */ + while(prt->status & ERTS_PORT_SFLG_INITIALIZING) { + erts_smp_port_state_unlock(prt); + erts_smp_port_state_lock(prt); + } + erts_smp_port_state_unlock(prt); + erts_smp_mtx_lock(prt->lock); + if (!(prt->status & ERTS_PORT_SFLGS_DEAD)) { + driver_failure_atom(j, "driver_unloaded"); + } +#else + driver_failure_atom(j, "driver_unloaded"); +#endif + erts_port_release(prt); + } + else erts_smp_port_state_unlock(prt); + } + /* Dereference, eventually causing driver destruction */ +#if DDLL_SMP + lock_drv_list(); +#endif + erts_ddll_dereference_driver(dh); + } + +#if DDLL_SMP + erts_ddll_reference_driver(dh); + unlock_drv_list(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + lock_drv_list(); + erts_ddll_dereference_driver(dh); +#endif + + p->flags |= F_USING_DDLL; + if (monitor) { + Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_LOAD); + hp = HAlloc(p,4); + t = TUPLE3(hp, am_ok, ok_term, mref); + } else { + hp = HAlloc(p,3); + t = TUPLE2(hp, am_ok, ok_term); + } +#if DDLL_SMP + unlock_drv_list(); +#endif + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + BIF_RET(t); + soft_error: +#if DDLL_SMP + unlock_drv_list(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); +#endif + if (do_build_load_error) { + soft_error_term = build_load_error(p, build_this_load_error); + } + + hp = HAlloc(p,3); + t = TUPLE2(hp, am_error, soft_error_term); + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + BIF_RET(t); + error: + assert_drv_list_not_locked(); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + if (path != NULL) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) path); + } + if (name != NULL) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + } + BIF_ERROR(p,BADARG); +} + +/* + * try_unload(Name, OptionList) -> {ok,Status} | + * {ok,PendingStatus, Ref} | + * {error, ErrorAtom} + * Name = string() | atom() + * OptionList = [ Option ] + * Option = {monitor,MonitorOption} | kill_ports + * MonitorOption = pending_driver | pending + * Status = unloaded | PendingStatus + * PendingStatus = pending_driver | pending_process + * Ref = ref() + * ErrorAtom = linked_in_driver | not_loaded | + * not_loaded_by_this_process | permanent + */ + +/* + You have to have loaded the driver and the pid state + is LOADED or AWAIT_LOAD. You will be removed from the list + regardless of driver state. + If the driver is loaded by someone else to, return is + {ok, pending_process} + If the driver is loaded but locked by a port, return is + {ok, pending_driver} + If the driver is loaded and free to unload (you're the last holding it) + {ok, unloaded} + If it's not loaded or not loaded by you + {error, not_loaded} or {error, not_loaded_by_you} + + Internally, if its in state UNLOADING, just return {ok, pending_driver} and + remove/decrement this pid (which should be an LOADED tagged one). + If the state is RELOADING, this pid should be in list as LOADED tagged, + only AWAIT_LOAD would be possible but not allowed for unloading, remove it + and, if the last LOADED tagged, change from RELOAD to UNLOAD and notify + any AWAIT_LOAD-waiters with {'DOWN', ref(), driver, name(), load_cancelled} + If the driver made itself permanent, {'UP', ref(), driver, name(), permanent} +*/ +Eterm erl_ddll_try_unload_2(Process *p, Eterm name_term, Eterm options) +{ + char *name = NULL; + Eterm ok_term = NIL; + Eterm soft_error_term = NIL; + erts_driver_t *drv; + DE_Handle *dh; + DE_ProcEntry *pe; + Eterm *hp; + Eterm t; + int monitor = 0; + Eterm l; + int kill_ports = 0; + + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + + for(l = options; is_list(l); l = CDR(list_val(l))) { + Eterm opt = CAR(list_val(l)); + Eterm *tp; + if (is_not_tuple(opt)) { + if (opt == am_kill_ports) { + kill_ports = 1; + continue; + } else { + goto error; + } + } + tp = tuple_val(opt); + if (*tp != make_arityval(2) || tp[1] != am_monitor) { + goto error; + } + if (tp[2] == am_pending_driver) { + monitor = 1; + } else if (tp[2] == am_pending) { + monitor = 2; + } else { + goto error; + } + } + if (is_not_nil(l)) { + goto error; + } + + if ((name = pick_list_or_atom(name_term)) == NULL) { + goto error; + } + +#if DDLL_SMP + lock_drv_list(); +#endif + + if ((drv = lookup_driver(name)) == NULL) { + soft_error_term = am_not_loaded; + goto soft_error; + } + + if (drv->handle == NULL) { + soft_error_term = am_linked_in_driver; + goto soft_error; + } else if (drv->handle->status == ERL_DE_PERMANENT) { + soft_error_term = am_permanent; + goto soft_error; + } + dh = drv->handle; + if (dh->flags & ERL_DE_FL_KILL_PORTS) { + kill_ports = 1; + } + if ((pe = find_proc_entry(dh, p, ERL_DE_PROC_LOADED)) == NULL) { + if (num_procs(dh, ERL_DE_PROC_LOADED) > 0) { + soft_error_term = am_not_loaded_by_this_process; + goto soft_error; + } + } else { + remove_proc_entry(dh, pe); + if (!(pe->flags & ERL_DE_FL_DEREFERENCED)) { + erts_ddll_dereference_driver(dh); + } + erts_free(ERTS_ALC_T_DDLL_PROCESS, pe); + } + if (num_procs(dh, ERL_DE_PROC_LOADED) > 0) { + ok_term = am_pending_process; + --monitor; + goto done; + } + if (dh->status == ERL_DE_RELOAD || + dh->status == ERL_DE_FORCE_RELOAD) { + notify_all(dh, drv->name, + ERL_DE_PROC_AWAIT_LOAD, am_DOWN, am_load_cancelled); + erts_free(ERTS_ALC_T_DDLL_HANDLE,dh->reload_full_path); + erts_free(ERTS_ALC_T_DDLL_HANDLE,dh->reload_driver_name); + dh->reload_full_path = dh->reload_driver_name = NULL; + dh->reload_flags = 0; + } + if (dh->port_count > 0) { + ++kill_ports; + } + dh->status = ERL_DE_UNLOAD; + ok_term = am_pending_driver; +done: + assert_drv_list_locked(); + if (kill_ports > 1) { + int j; + /* Avoid closing the driver by referencing it */ + erts_ddll_reference_driver(dh); + dh->status = ERL_DE_FORCE_UNLOAD; +#if DDLL_SMP + unlock_drv_list(); +#endif + for (j = 0; j < erts_max_ports; j++) { + Port* prt = &erts_port[j]; +#if DDLL_SMP + erts_smp_port_state_lock(prt); +#endif + if (!(prt->status & FREE_PORT_FLAGS) + && prt->drv_ptr->handle == dh) { +#if DDLL_SMP + erts_smp_atomic_inc(&prt->refc); + /* Extremely rare spinlock */ + while(prt->status & ERTS_PORT_SFLG_INITIALIZING) { + erts_smp_port_state_unlock(prt); + erts_smp_port_state_lock(prt); + } + erts_smp_port_state_unlock(prt); + erts_smp_mtx_lock(prt->lock); + if (!(prt->status & ERTS_PORT_SFLGS_DEAD)) { + driver_failure_atom(j, "driver_unloaded"); + } +#else + driver_failure_atom(j, "driver_unloaded"); +#endif + erts_port_release(prt); + } + else erts_smp_port_state_unlock(prt); + } +#if DDLL_SMP + lock_drv_list(); +#endif + erts_ddll_dereference_driver(dh); + } + +#if DDLL_SMP + erts_ddll_reference_driver(dh); + unlock_drv_list(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + lock_drv_list(); + erts_ddll_dereference_driver(dh); +#endif + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + p->flags |= F_USING_DDLL; + if (monitor > 0) { + Eterm mref = add_monitor(p, dh, ERL_DE_PROC_AWAIT_UNLOAD); + hp = HAlloc(p,4); + t = TUPLE3(hp, am_ok, ok_term, mref); + } else { + hp = HAlloc(p,3); + t = TUPLE2(hp, am_ok, ok_term); + } + if (kill_ports > 1) { + ERTS_BIF_CHK_EXITED(p); /* May be exited by port killing */ + } +#if DDLL_SMP + unlock_drv_list(); +#endif + BIF_RET(t); + +soft_error: +#if DDLL_SMP + unlock_drv_list(); +#endif + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + hp = HAlloc(p,3); + t = TUPLE2(hp, am_error, soft_error_term); + BIF_RET(t); + + error: /* No lock fiddling before going here */ + assert_drv_list_not_locked(); + if (name != NULL) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + } + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + BIF_ERROR(p,BADARG); +} + + +/* + * A shadow of the "real" demonitor BIF + */ +BIF_RETTYPE erl_ddll_demonitor_1(Process *p, Eterm ref) +{ + if (is_not_internal_ref(ref)) { + BIF_ERROR(p, BADARG); + } + if (p->flags & F_USING_DDLL) { + erts_ddll_remove_monitor(p, ref, ERTS_PROC_LOCK_MAIN); + } + BIF_RET(am_true); +} + +/* + * A shadow of the "real" monitor BIF + */ +BIF_RETTYPE erl_ddll_monitor_2(Process *p, Eterm dr, Eterm what) +{ + if (dr != am_driver) { + BIF_ERROR(p,BADARG); + } + return erts_ddll_monitor_driver(p, what, ERTS_PROC_LOCK_MAIN); +} + +/* + * Return list of loaded drivers {ok,[string()]} + */ +Eterm erl_ddll_loaded_drivers_0(Process *p) +{ + Eterm *hp; + int need = 3; + Eterm res = NIL; + erts_driver_t *drv; +#if DDLL_SMP + lock_drv_list(); +#endif + for (drv = driver_list; drv; drv = drv->next) { + need += sys_strlen(drv->name)*2+2; + } + hp = HAlloc(p,need); + for (drv = driver_list; drv; drv = drv->next) { + Eterm l; + l = buf_to_intlist(&hp, drv->name, sys_strlen(drv->name), NIL); + res = CONS(hp,l,res); + hp += 2; + } + res = TUPLE2(hp,am_ok,res); + /* hp += 3 */ +#if DDLL_SMP + unlock_drv_list(); +#endif + BIF_RET(res); +} + +/* + * More detailed info about loaded drivers: + * item is processes, driver_options, port_count, linked_in_driver, + * permanent, awaiting_load, awaiting_unload + */ +Eterm erl_ddll_info_2(Process *p, Eterm name_term, Eterm item) +{ + char *name = NULL; + Eterm res = NIL; + erts_driver_t *drv; + ProcEntryInfo *pei = NULL; + int num_pei; + Eterm *hp; + int i; + Uint filter; +#if DDLL_SMP + int have_lock = 0; +#endif + + if ((name = pick_list_or_atom(name_term)) == NULL) { + goto error; + } + + if (!is_atom(item)) { + goto error; + } + +#if DDLL_SMP + lock_drv_list(); + have_lock = 1; +#endif + if ((drv = lookup_driver(name)) == NULL) { + goto error; + } + + switch (item) { + case am_processes: + filter = ERL_DE_PROC_LOADED; + break; + case am_driver_options: + if (drv->handle == NULL) { + res = am_linked_in_driver; + } else { + Uint start_flags = drv->handle->flags & ERL_FL_CONSISTENT_MASK; + /* Cheating, only one flag for now... */ + if (start_flags & ERL_DE_FL_KILL_PORTS) { + Eterm *myhp; + myhp = HAlloc(p,2); + res = CONS(myhp,am_kill_ports,NIL); + } else { + res = NIL; + } + } + goto done; + case am_port_count: + if (drv->handle == NULL) { + res = am_linked_in_driver; + } else if (drv->handle->status == ERL_DE_PERMANENT) { + res = am_permanent; + } else { + res = make_small(drv->handle->port_count); + } + goto done; + case am_linked_in_driver: + if (drv->handle == NULL){ + res = am_true; + } else { + res = am_false; + } + goto done; + case am_permanent: + if (drv->handle != NULL && drv->handle->status == ERL_DE_PERMANENT) { + res = am_true; + } else { + res = am_false; + } + goto done; + case am_awaiting_load: + filter = ERL_DE_PROC_AWAIT_LOAD; + break; + case am_awaiting_unload: + filter = ERL_DE_PROC_AWAIT_UNLOAD; + break; + default: + goto error; + } + + if (drv->handle == NULL) { + res = am_linked_in_driver; + goto done; + } else if (drv->handle->status == ERL_DE_PERMANENT) { + res = am_permanent; + goto done; + } + num_pei = build_proc_info(drv->handle, &pei, filter); + if (!num_pei) { + goto done; + } + hp = HAlloc(p,num_pei * (2+3)); + for (i = 0; i < num_pei; ++ i) { + Eterm tpl = TUPLE2(hp,pei[i].pid,make_small(pei[i].count)); + hp += 3; + res = CONS(hp,tpl,res); + hp += 2; + } + done: +#if DDLL_SMP + unlock_drv_list(); +#endif + if (pei) + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, pei); + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + BIF_RET(res); + error: + if (name != NULL) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + } +#if DDLL_SMP + if (have_lock) { + unlock_drv_list(); + } +#endif + BIF_ERROR(p,BADARG); +} + +/* + * Backend for erl_ddll:format_error, handles all "soft" errors returned by builtins, + * possibly by calling the system specific error handler + */ +Eterm erl_ddll_format_error_int_1(Process *p, Eterm code_term) +{ + char *errstring = NULL; + int errint; + int len; + Eterm ret = NIL; + Eterm *hp; + + /* These errors can only appear in the erlang interface, not in the interface provided + to drivers... */ + switch (code_term) { + case am_inconsistent: + errstring = "Driver name and/or driver options are inconsistent with " + "currently loaded driver"; + break; + case am_linked_in_driver: + errstring = "Driver is statically linked and " + "cannot be loaded/unloaded"; + break; + case am_permanent: + errstring = "DDLL driver is permanent an can not be unloaded/loaded"; + break; + case am_not_loaded: + errstring = "DDLL driver is not loaded"; + break; + case am_not_loaded_by_this_process: + errstring = "DDLL driver was not loaded by this process"; + break; + case am_not_pending: + errstring = "DDLL load not pending for this driver name"; + break; + case am_already_loaded: + errstring = "DDLL driver is already loaded successfully"; + break; + case am_pending_reload: + errstring = "Driver reloading is already pending"; + break; + case am_pending_process: + errstring = "Driver is loaded by others when attempting " + "option {reload, pending_driver}"; + break; + default: + /* A "real" error, we translate the atom to a code and translate the code + to a string in the same manner as in the interface provided to drivers... */ + if (errdesc_to_code(code_term,&errint) != 0) { + goto error; + } +#if DDLL_SMP + lock_drv_list(); +#endif + errstring = erts_ddll_error(errint); +#if DDLL_SMP + unlock_drv_list(); +#endif + break; + } + if (errstring == NULL) { + goto error; + } + len = sys_strlen(errstring); + hp = HAlloc(p, 2 * len); + ret = buf_to_intlist(&hp, errstring, len, NIL); + BIF_RET(ret); + error: + BIF_ERROR(p,BADARG); +} + +void erts_ddll_init(void) +{ + erl_sys_ddll_init(); +} + +/* Return value as a bif, called by erlang:monitor */ +Eterm erts_ddll_monitor_driver(Process *p, + Eterm description, + ErtsProcLocks plocks) +{ + Eterm *tp; + Eterm ret; + char *name; + + if (is_not_tuple(description)) { + BIF_ERROR(p,BADARG); + } + tp = tuple_val(description); + if (*tp != make_arityval(2)) { + BIF_ERROR(p,BADARG); + } + if ((name = pick_list_or_atom(tp[1])) == NULL) { + BIF_ERROR(p,BADARG); + } + switch (tp[2]) { + case am_loaded: + ERTS_BIF_PREP_RET(ret, notify_when_loaded(p,tp[1],name,plocks)); + break; + case am_unloaded: + ERTS_BIF_PREP_RET(ret, notify_when_unloaded(p,tp[1],name,plocks, + ERL_DE_PROC_AWAIT_UNLOAD)); + break; + case am_unloaded_only: + ERTS_BIF_PREP_RET(ret, + notify_when_unloaded(p,tp[1],name,plocks, + ERL_DE_PROC_AWAIT_UNLOAD_ONLY)); + break; + default: + ERTS_BIF_PREP_ERROR(ret,p,BADARG); + break; + } + + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + return ret; +} + +void erts_ddll_remove_monitor(Process *p, Eterm ref, ErtsProcLocks plocks) +{ + erts_driver_t *drv; + erts_smp_proc_unlock(p, plocks); + lock_drv_list(); + drv = driver_list; + while (drv != NULL) { + if (drv->handle != NULL && drv->handle->status != ERL_DE_PERMANENT) { + DE_ProcEntry **pe = &(drv->handle->procs); + while ((*pe) != NULL) { + if ((*pe)->proc == p && + ((*pe)->awaiting_status == ERL_DE_PROC_AWAIT_LOAD || + (*pe)->awaiting_status == ERL_DE_PROC_AWAIT_UNLOAD || + (*pe)->awaiting_status == + ERL_DE_PROC_AWAIT_UNLOAD_ONLY) && + eq(make_internal_ref(&((*pe)->heap)),ref)) { + DE_ProcEntry *r = *pe; + *pe = r->next; + erts_free(ERTS_ALC_T_DDLL_PROCESS, (void *) r); + goto done; + } + pe = &((*pe)->next); + } + } + drv = drv->next; + } + done: + unlock_drv_list(); + erts_smp_proc_lock(p, plocks); +} + +/* + * Called from erl_process.c. + */ +void erts_ddll_proc_dead(Process *p, ErtsProcLocks plocks) +{ + erts_driver_t *drv; + erts_smp_proc_unlock(p, plocks); + lock_drv_list(); + drv = driver_list; + while (drv != NULL) { + if (drv->handle != NULL && drv->handle->status != ERL_DE_PERMANENT) { + DE_ProcEntry **pe = &(drv->handle->procs); + int kill_ports = (drv->handle->flags & ERL_DE_FL_KILL_PORTS); + int left = 0; + while ((*pe) != NULL) { + if ((*pe)->proc == p) { + DE_ProcEntry *r = *pe; + *pe = r->next; + if (!(r->flags & ERL_DE_FL_DEREFERENCED) && + r->awaiting_status == ERL_DE_PROC_LOADED) { + erts_ddll_dereference_driver(drv->handle); + } + erts_free(ERTS_ALC_T_DDLL_PROCESS, (void *) r); + } else { + if ((*pe)->awaiting_status == ERL_DE_PROC_LOADED) { + ++left; + } + pe = &((*pe)->next); + } + } + if (!left) { + DE_Handle *dh = drv->handle; + if (dh->status == ERL_DE_RELOAD || + dh->status == ERL_DE_FORCE_RELOAD) { + notify_all(dh, drv->name, + ERL_DE_PROC_AWAIT_LOAD, am_DOWN, am_load_cancelled); + erts_free(ERTS_ALC_T_DDLL_HANDLE,dh->reload_full_path); + erts_free(ERTS_ALC_T_DDLL_HANDLE,dh->reload_driver_name); + dh->reload_full_path = dh->reload_driver_name = NULL; + dh->reload_flags = 0; + } + dh->status = ERL_DE_UNLOAD; + } + if (!left && drv->handle->port_count > 0) { + if (kill_ports) { + int j; + DE_Handle *dh = drv->handle; + erts_ddll_reference_driver(dh); + dh->status = ERL_DE_FORCE_UNLOAD; +#if DDLL_SMP + unlock_drv_list(); +#endif + for (j = 0; j < erts_max_ports; j++) { + Port* prt = &erts_port[j]; +#if DDLL_SMP + erts_smp_port_state_lock(prt); +#endif + if (!(prt->status & FREE_PORT_FLAGS) && + prt->drv_ptr->handle == dh) { +#if DDLL_SMP + erts_smp_atomic_inc(&prt->refc); + while(prt->status & ERTS_PORT_SFLG_INITIALIZING) { + erts_smp_port_state_unlock(prt); + erts_smp_port_state_lock(prt); + } + erts_smp_port_state_unlock(prt); + erts_smp_mtx_lock(prt->lock); + if (!(prt->status & ERTS_PORT_SFLGS_DEAD)) { + driver_failure_atom(j, "driver_unloaded"); + } +#else + driver_failure_atom(j, "driver_unloaded"); +#endif + erts_port_release(prt); + } + else erts_smp_port_state_unlock(prt); + } +#if DDLL_SMP + lock_drv_list(); /* Needed for future list operations */ +#endif + drv = drv->next; /* before allowing destruction */ + erts_ddll_dereference_driver(dh); + } else { + drv = drv->next; + } + } else { + drv = drv->next; + } + } else { + drv = drv->next; + } + } + unlock_drv_list(); + erts_smp_proc_lock(p, plocks); +} +void erts_ddll_lock_driver(DE_Handle *dh, char *name) +{ + DE_ProcEntry *p,*q; + assert_drv_list_locked(); + notify_all(dh, name, + ERL_DE_PROC_AWAIT_LOAD, am_UP, am_permanent); + notify_all(dh, name, + ERL_DE_PROC_AWAIT_UNLOAD, am_UP, am_permanent); + notify_all(dh, name, + ERL_DE_PROC_AWAIT_UNLOAD_ONLY, am_UP, am_permanent); + + p = dh->procs; + while(p != NULL) { + q = p; + p = p->next; + erts_free(ERTS_ALC_T_DDLL_PROCESS, (void *) q); + } + dh->procs = NULL; + erts_ddll_reference_driver(dh); + dh->status = ERL_DE_PERMANENT; +} + + +void erts_ddll_increment_port_count(DE_Handle *dh) +{ + assert_drv_list_locked(); + dh->port_count++; +} + +void erts_ddll_decrement_port_count(DE_Handle *dh) +{ + assert_drv_list_locked(); + ASSERT(dh->port_count > 0); + dh->port_count--; +} + +static void first_ddll_reference(DE_Handle *dh) +{ + assert_drv_list_locked(); + erts_refc_init(&(dh->refc),1); +} + +void erts_ddll_reference_driver(DE_Handle *dh) +{ + assert_drv_list_locked(); + if (erts_refc_inctest(&(dh->refc),1) == 1) { + erts_refc_inc(&(dh->refc),2); /* add a reference for the scheduled operation */ + } +} + +void erts_ddll_reference_referenced_driver(DE_Handle *dh) +{ + erts_refc_inc(&(dh->refc),2); +} + +void erts_ddll_dereference_driver(DE_Handle *dh) +{ + if (erts_refc_dectest(&(dh->refc),0) == 0) { + /* No lock here, but if the driver is referenced again, + the scheduled deletion is added as a reference too, see above */ + erts_schedule_misc_op(ddll_no_more_references, (void *) dh); + } +} +static void dereference_all_processes(DE_Handle *dh) +{ + DE_ProcEntry *p; + assert_drv_list_locked(); + for(p = dh->procs;p != NULL; p = p->next) { + if (p->awaiting_status == ERL_DE_PROC_LOADED) { + ASSERT(!(p->flags & ERL_DE_FL_DEREFERENCED)); + erts_ddll_dereference_driver(dh); + p->flags |= ERL_DE_FL_DEREFERENCED; + } + } +} + +static void restore_process_references(DE_Handle *dh) +{ + DE_ProcEntry *p; + assert_drv_list_locked(); + ASSERT(erts_refc_read(&(dh->refc),0) == 0); + for(p = dh->procs;p != NULL; p = p->next) { + if (p->awaiting_status == ERL_DE_PROC_LOADED) { + ASSERT(p->flags & ERL_DE_FL_DEREFERENCED); + erts_refc_inc(&(dh->refc),1); + p->flags &= ~ERL_DE_FL_DEREFERENCED; + } + } +} + + +int erts_ddll_driver_ok(DE_Handle *dh) +{ + assert_drv_list_locked(); + return ((dh == NULL) || (dh->status != ERL_DE_FORCE_UNLOAD && + dh->status != ERL_DE_FORCE_RELOAD)); +} + + +static void ddll_no_more_references(void *vdh) +{ + DE_Handle *dh = (DE_Handle *) vdh; + int x; + + lock_drv_list(); + + x = erts_refc_read(&(dh->refc),0); + if (x > 0) { + x = erts_refc_dectest(&(dh->refc),0); /* delete the reference added for me */ + } + + + if (x == 0) { + DE_ProcEntry **p = &(dh->procs); + Eterm save_driver_name = am_undefined; + ASSERT(dh->status != ERL_DE_OK); + do_unload_driver_entry(dh,&save_driver_name); + while (*p != NULL) { + DE_ProcEntry *q; + if ((*p)->awaiting_status == ERL_DE_PROC_AWAIT_UNLOAD || + (*p)->awaiting_status == ERL_DE_PROC_AWAIT_UNLOAD_ONLY) { + notify_proc((*p)->proc, + make_internal_ref(&((*p)->heap)), + save_driver_name,am_DOWN,am_unloaded, 0); + q = *p; + *p = q->next; + erts_free(ERTS_ALC_T_DDLL_PROCESS, (void *) q); + } else { + ASSERT(dh->status == ERL_DE_RELOAD || + dh->status == ERL_DE_FORCE_RELOAD); + p = &((*p)->next); + } + } + + if (dh->status == ERL_DE_UNLOAD || dh->status == ERL_DE_FORCE_UNLOAD) { + ASSERT(dh->full_path != NULL); + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path); + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh); + } else { /* ERL_DE_RELOAD || ERL_DE_FORCE_RELOAD */ + int reload_res = + reload_driver_entry(dh); + p = &(dh->procs); + while (*p != NULL) { + DE_ProcEntry *q; + if ((*p)->awaiting_status == ERL_DE_PROC_AWAIT_LOAD) { + if (reload_res == 0) { + notify_proc((*p)->proc, + make_internal_ref(&((*p)->heap)), + save_driver_name, am_UP, am_loaded, 0); + } else { + notify_proc((*p)->proc, + make_internal_ref(&((*p)->heap)), + save_driver_name, am_DOWN, am_load_failure, reload_res); + } + q = *p; + *p = q->next; + erts_free(ERTS_ALC_T_DDLL_PROCESS, (void *) q); + } else { + if (reload_res != 0) { + DE_ProcEntry *q = *p; + *p = q->next; + erts_free(ERTS_ALC_T_DDLL_PROCESS, (void *) q); + } else { + p = &((*p)->next); + } + } + } + if (reload_res != 0) { + ASSERT(dh->full_path == NULL); + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh); + } + } + } + unlock_drv_list(); +} + +char *erts_ddll_error(int code) { + switch (code) { + case ERL_DE_NO_ERROR: + return "No error"; + case ERL_DE_LOAD_ERROR_NO_INIT: + return "No driver init in dynamic library"; + case ERL_DE_LOAD_ERROR_FAILED_INIT: + return "Driver init failed"; + case ERL_DE_LOAD_ERROR_BAD_NAME: + return "Bad driver name"; + case ERL_DE_LOAD_ERROR_NAME_TO_LONG: + return "Driver name to long"; + case ERL_DE_LOAD_ERROR_INCORRECT_VERSION: + return "Driver compiled with incorrect version of erl_driver.h"; + case ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY: + return "DDLL functionality not available on this platform"; + case ERL_DE_ERROR_UNSPECIFIED: + return "Unspecified dynamic library error"; + case ERL_DE_LOOKUP_ERROR_NOT_FOUND: + return "Symbol not found in dynamic library"; + default: + return erts_sys_ddll_error(code); + } +} + +/* + * Utilities + */ +static Eterm notify_when_loaded(Process *p, Eterm name_term, char *name, ErtsProcLocks plocks) +{ + Eterm r = NIL; + Eterm immediate_tag = NIL; + Eterm immediate_type = NIL; + erts_driver_t *drv; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & plocks); +#if DDLL_SMP + lock_drv_list(); +#endif + if ((drv = lookup_driver(name)) == NULL) { + immediate_tag = am_unloaded; + immediate_type = am_DOWN; + goto immediate; + } + if (drv->handle == NULL || drv->handle->status == ERL_DE_PERMANENT) { + immediate_tag = am_permanent; + immediate_type = am_UP; + goto immediate; + } + + switch (drv->handle->status) { + case ERL_DE_OK: + immediate_tag = am_loaded; + immediate_type = am_UP; + goto immediate; + case ERL_DE_UNLOAD: + case ERL_DE_FORCE_UNLOAD: + immediate_tag = am_load_cancelled; + immediate_type = am_DOWN; + goto immediate; + case ERL_DE_RELOAD: + case ERL_DE_FORCE_RELOAD: + break; + default: + erl_exit(1,"Internal error, unknown state %u in dynamic driver.", drv->handle->status); + } + p->flags |= F_USING_DDLL; + r = add_monitor(p, drv->handle, ERL_DE_PROC_AWAIT_LOAD); +#if DDLL_SMP + unlock_drv_list(); +#endif + BIF_RET(r); + immediate: + r = erts_make_ref(p); +#if DDLL_SMP + erts_smp_proc_unlock(p, plocks); +#endif + notify_proc(p, r, name_term, immediate_type, immediate_tag, 0); +#if DDLL_SMP + unlock_drv_list(); + erts_smp_proc_lock(p, plocks); +#endif + BIF_RET(r); +} + +static Eterm notify_when_unloaded(Process *p, Eterm name_term, char *name, ErtsProcLocks plocks, Uint flag) +{ + Eterm r = NIL; + Eterm immediate_tag = NIL; + Eterm immediate_type = NIL; + erts_driver_t *drv; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & plocks); +#if DDLL_SMP + lock_drv_list(); +#endif + if ((drv = lookup_driver(name)) == NULL) { + immediate_tag = am_unloaded; + immediate_type = am_DOWN; + goto immediate; + } + if (drv->handle == NULL || drv->handle->status == ERL_DE_PERMANENT) { + immediate_tag = am_permanent; + immediate_type = am_UP; + goto immediate; + } + + p->flags |= F_USING_DDLL; + r = add_monitor(p, drv->handle, flag); +#if DDLL_SMP + unlock_drv_list(); +#endif + BIF_RET(r); + immediate: + r = erts_make_ref(p); +#if DDLL_SMP + erts_smp_proc_unlock(p, plocks); +#endif + notify_proc(p, r, name_term, immediate_type, immediate_tag, 0); +#if DDLL_SMP + unlock_drv_list(); + erts_smp_proc_lock(p, plocks); +#endif + BIF_RET(r); +} + + +static int is_last_user(DE_Handle *dh, Process *proc) { + DE_ProcEntry *p = dh->procs; + int found = 0; + + assert_drv_list_locked(); + + while (p != NULL) { + if (p->proc == proc && p->awaiting_status == ERL_DE_PROC_LOADED) { + if (found == 0) { + found = 1; + } else { + return 0; + } + } else if (p->awaiting_status == ERL_DE_PROC_LOADED) { + return 0; + } + p = p->next; + } + return found; +} + +static DE_ProcEntry *find_proc_entry(DE_Handle *dh, Process *proc, Uint status) +{ + DE_ProcEntry *p = dh->procs; + + assert_drv_list_locked(); + + while (p != NULL) { + if (p->proc == proc && p->awaiting_status == status) { + return p; + } + p = p->next; + } + return NULL; +} + +static void remove_proc_entry(DE_Handle *dh, DE_ProcEntry *pe) +{ + DE_ProcEntry **p = &(dh->procs); + + while (*p != NULL && *p != pe) { + p = &((*p)->next); + } + if ((*p) != NULL) { + *p = (*p)->next; + } +} + +static int num_procs(DE_Handle *dh, Uint status) { + DE_ProcEntry *p = dh->procs; + int i = 0; + + assert_drv_list_locked(); + + while (p != NULL) { + if (p->awaiting_status == status) { + ++i; + } + p = p->next; + } + return i; +} +/* +static int num_entries(DE_Handle *dh, Process *proc, Uint status) { + DE_ProcEntry *p = dh->procs; + int i = 0; + + assert_drv_list_locked(); + while (p != NULL) { + if (p->awaiting_status == status && p->proc == proc) { + ++i; + } + p = p->next; + } + return i; +} +*/ +static void add_proc_loaded(DE_Handle *dh, Process *proc) +{ + DE_ProcEntry *p; + assert_drv_list_locked(); + p = erts_alloc(ERTS_ALC_T_DDLL_PROCESS, sizeof(DE_ProcEntry)); + p->proc = proc; + p->flags = 0; + p->awaiting_status = ERL_DE_PROC_LOADED; + p->next = dh->procs; + dh->procs = p; +} + +static void add_proc_loaded_deref(DE_Handle *dh, Process *proc) +{ + DE_ProcEntry *p; + assert_drv_list_locked(); + p = erts_alloc(ERTS_ALC_T_DDLL_PROCESS, sizeof(DE_ProcEntry)); + p->proc = proc; + p->awaiting_status = ERL_DE_PROC_LOADED; + p->flags = ERL_DE_FL_DEREFERENCED; + p->next = dh->procs; + dh->procs = p; +} + +static Eterm copy_ref(Eterm ref, Eterm *hp) +{ + RefThing *ptr = ref_thing_ptr(ref); + memcpy(hp, ptr, sizeof(RefThing)); + return (make_internal_ref(hp)); +} + +static void add_proc_waiting(DE_Handle *dh, Process *proc, + Uint status, Eterm ref) +{ + DE_ProcEntry *p; + assert_drv_list_locked(); + p = erts_alloc(ERTS_ALC_T_DDLL_PROCESS, sizeof(DE_ProcEntry)); + p->proc = proc; + p->flags = 0; + p->awaiting_status = status; + copy_ref(ref, p->heap); + p->next = dh->procs; + dh->procs = p; +} + +static Eterm add_monitor(Process *p, DE_Handle *dh, Uint status) +{ + Eterm r; + + assert_drv_list_locked(); + r = erts_make_ref(p); + add_proc_waiting(dh, p, status, r); + return r; +} + + +static void set_driver_reloading(DE_Handle *dh, Process *proc, char *path, char *name, Uint flags) +{ + DE_ProcEntry *p; + + assert_drv_list_locked(); + p = erts_alloc(ERTS_ALC_T_DDLL_PROCESS, sizeof(DE_ProcEntry)); + p->proc = proc; + p->awaiting_status = ERL_DE_OK; + p->next = dh->procs; + p->flags = ERL_DE_FL_DEREFERENCED; + dh->procs = p; + dh->status = ERL_DE_RELOAD; + dh->reload_full_path = erts_alloc(ERTS_ALC_T_DDLL_HANDLE, sys_strlen(path) + 1); + strcpy(dh->reload_full_path,path); + dh->reload_driver_name = erts_alloc(ERTS_ALC_T_DDLL_HANDLE, sys_strlen(name) + 1); + strcpy(dh->reload_driver_name,name); + dh->reload_flags = flags; +} + +static int do_load_driver_entry(DE_Handle *dh, char *path, char *name) +{ + void *init_handle; + int res; + ErlDrvEntry *dp; + + assert_drv_list_locked(); + + if ((res = erts_sys_ddll_open(path, &(dh->handle))) != ERL_DE_NO_ERROR) { + return res; + } + + if ((res = erts_sys_ddll_load_driver_init(dh->handle, + &init_handle)) != ERL_DE_NO_ERROR) { + erts_sys_ddll_close(dh->handle); + return ERL_DE_LOAD_ERROR_NO_INIT; + } + + dp = erts_sys_ddll_call_init(init_handle); + if (dp == NULL) { + erts_sys_ddll_close(dh->handle); + return ERL_DE_LOAD_ERROR_FAILED_INIT; + } + + switch (dp->extended_marker) { + case 0: + /* + * This may be an old driver that has been recompiled. If so, + * at least the fields that existed in extended driver version + * 1.0 should be zero. If not, a it is a bad driver. We cannot + * be completely certain that this is a valid driver but this is + * the best we can do with old drivers... + */ + if (dp->major_version != 0 + || dp->minor_version != 0 + || dp->driver_flags != 0 + || dp->handle2 != NULL + || dp->process_exit != NULL) { + /* Old driver; needs to be recompiled... */ + return ERL_DE_LOAD_ERROR_INCORRECT_VERSION; + } + break; + case ERL_DRV_EXTENDED_MARKER: + if (ERL_DRV_EXTENDED_MAJOR_VERSION != dp->major_version + || ERL_DRV_EXTENDED_MINOR_VERSION < dp->minor_version) { + /* Incompatible driver version */ + return ERL_DE_LOAD_ERROR_INCORRECT_VERSION; + } + break; + default: + /* Old driver; needs to be recompiled... */ + return ERL_DE_LOAD_ERROR_INCORRECT_VERSION; + } + + if (strcmp(name, dp->driver_name) != 0) { + erts_sys_ddll_close(dh->handle); + return ERL_DE_LOAD_ERROR_BAD_NAME; + } + erts_smp_atomic_init(&(dh->refc), (long) 0); + dh->port_count = 0; + dh->full_path = erts_alloc(ERTS_ALC_T_DDLL_HANDLE, sys_strlen(path) + 1); + sys_strcpy(dh->full_path, path); + dh->flags = 0; + dh->status = ERL_DE_OK; + + if (erts_add_driver_entry(dp, dh, 1) != 0 /* io.c */) { + /* + * The init in the driver struct did not return 0 + */ + erts_free(ERTS_ALC_T_DDLL_HANDLE, dh->full_path); + dh->full_path = NULL; + erts_sys_ddll_close(dh->handle); + return ERL_DE_LOAD_ERROR_FAILED_INIT; + } + + return ERL_DE_NO_ERROR; +} + +static int do_unload_driver_entry(DE_Handle *dh, Eterm *save_name) +{ + erts_driver_t *q, *p = driver_list; + + assert_drv_list_locked(); + + while (p != NULL) { + if (p->handle == dh) { + + q = p; + if (p->prev == NULL) { + driver_list = p->next; + } else { + p->prev->next = p->next; + } + if (p->next != NULL) { + p->next->prev = p->prev; + } + + if (save_name != NULL) { + *save_name = mkatom(q->name); + } + /* XXX:PaN Future locking problems? Don't dare to let go of the diver_list lock here!*/ + if (q->finish) { + int fpe_was_unmasked = erts_block_fpe(); + (*(q->finish))(); + erts_unblock_fpe(fpe_was_unmasked); + } + erts_sys_ddll_close(dh->handle); + erts_destroy_driver(q); + return 1; + } + p = p->next; + } + return 0; +} + +static int load_driver_entry(DE_Handle **dhp, char *path, char *name) +{ + int res; + DE_Handle *dh = erts_alloc(ERTS_ALC_T_DDLL_HANDLE, sizeof(DE_Handle)); + + assert_drv_list_locked(); + + dh->handle = NULL; + dh->procs = NULL; + dh->port_count = 0; + erts_refc_init(&(dh->refc), (long) 0); + dh->status = -1; + dh->reload_full_path = NULL; + dh->reload_driver_name = NULL; + dh->reload_flags = 0; + dh->full_path = NULL; + dh->flags = 0; + + if ((res = do_load_driver_entry(dh, path, name)) != ERL_DE_NO_ERROR) { + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh); + dh = NULL; + } + *dhp = dh; + return res; +} + +#if 0 +static void unload_driver_entry(DE_Handle *dh) +{ + do_unload_driver_entry(dh, NULL); + if (dh->full_path != NULL) { + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path); + } + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh); +} +#endif +static int reload_driver_entry(DE_Handle *dh) +{ + char *path = dh->reload_full_path; + char *name = dh->reload_driver_name; + int loadres; + Uint flags = dh->reload_flags; + + assert_drv_list_locked(); + + dh->reload_full_path = NULL; + dh->reload_driver_name = NULL; + + ASSERT(erts_refc_read(&(dh->refc),0) == 0); + ASSERT(dh->full_path != NULL); + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) dh->full_path); + dh->full_path = NULL; + + loadres = do_load_driver_entry(dh, path, name); + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) path); + erts_free(ERTS_ALC_T_DDLL_HANDLE, (void *) name); + if (loadres == ERL_DE_NO_ERROR) { + dh->status = ERL_DE_OK; + dh->flags = flags; + } + restore_process_references(dh); + return loadres; +} + +/* + * Notification {tag = atom(), ref = ref(), driver_name = atom()} or + * {'$DDLL_load_failure', ref = ref(), driver_name = atom(), + * error_term = atom() | {system_error, int()}} + */ + +static void notify_proc(Process *proc, Eterm ref, Eterm driver_name, Eterm type, + Eterm tag, int errcode) +{ + Eterm mess; + Eterm r; + Eterm *hp; + ErlHeapFragment *bp; + ErlOffHeap *ohp; + ErtsProcLocks rp_locks = 0; + ERTS_SMP_CHK_NO_PROC_LOCKS; + + assert_drv_list_locked(); + if (errcode != 0) { + int need = load_error_need(errcode); + Eterm e; + hp = erts_alloc_message_heap(6 /* tuple */ + 3 /* Error tuple */ + + REF_THING_SIZE + need, &bp, &ohp, + proc, &rp_locks); + r = copy_ref(ref,hp); + hp += REF_THING_SIZE; + e = build_load_error_hp(hp, errcode); + hp += need; + mess = TUPLE2(hp,tag,e); + hp += 3; + mess = TUPLE5(hp,type,r,am_driver,driver_name,mess); + } else { + hp = erts_alloc_message_heap(6 /* tuple */ + REF_THING_SIZE, &bp, &ohp, proc, &rp_locks); + r = copy_ref(ref,hp); + hp += REF_THING_SIZE; + mess = TUPLE5(hp,type,r,am_driver,driver_name,tag); + } + erts_queue_message(proc, &rp_locks, bp, mess, am_undefined); + erts_smp_proc_unlock(proc, rp_locks); + ERTS_SMP_CHK_NO_PROC_LOCKS; +} + +static void notify_all(DE_Handle *dh, char *name, Uint awaiting, Eterm type, Eterm tag) +{ + DE_ProcEntry **p; + + assert_drv_list_locked(); + + p = &(dh->procs); + while (*p != NULL) { + if ((*p)->awaiting_status == awaiting) { + DE_ProcEntry *pe; + pe = *p; + *p = pe->next; + notify_proc(pe->proc, make_internal_ref(&(pe->heap)), mkatom(name), type, tag, 0); + erts_free(ERTS_ALC_T_DDLL_PROCESS, (void *) pe); + } else { + p = &((*p)->next); + } + } +} + + + +typedef struct errcode_entry { + char *atm; + int code; +} ErrcodeEntry; + +static ErrcodeEntry errcode_tab[] = { + {"no_error", ERL_DE_NO_ERROR}, + {"no_driver_init", ERL_DE_LOAD_ERROR_NO_INIT}, + {"driver_init_failed", ERL_DE_LOAD_ERROR_FAILED_INIT}, + {"bad_driver_name", ERL_DE_LOAD_ERROR_BAD_NAME}, + {"driver_name_to_long", ERL_DE_LOAD_ERROR_NAME_TO_LONG}, + {"driver_incorrect_version", ERL_DE_LOAD_ERROR_INCORRECT_VERSION}, + {"no_ddll_available", ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY}, + {"unspecified_error", ERL_DE_ERROR_UNSPECIFIED}, + {"symbol_not_found", ERL_DE_LOOKUP_ERROR_NOT_FOUND}, + {NULL,0} +}; + +static int errdesc_to_code(Eterm errdesc, int *code /* out */) +{ + int i; + if (is_atom(errdesc)) { + Atom *ap = atom_tab(atom_val(errdesc)); + for (i = 0; errcode_tab[i].atm != NULL; ++i) { + int len = sys_strlen(errcode_tab[i].atm); + if (len == ap->len && + !sys_strncmp(errcode_tab[i].atm,(char *) ap->name,len)) { + *code = errcode_tab[i].code; + return 0; + } + } + return -1; + } else if (is_tuple(errdesc)) { + Eterm *tp = tuple_val(errdesc); + if (*tp != make_arityval(2) || tp[1] != am_open_error || is_not_small(tp[2])) { + return -1; + } + *code = signed_val(tp[2]); + return 0; + } + return -1; +} + +static Eterm build_load_error(Process *p, int code) +{ + int need = load_error_need(code); + Eterm *hp = NULL; + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + if (need) { + hp = HAlloc(p,need); + } + return build_load_error_hp(hp,code); +} + +static int load_error_need(int code) +{ + ErrcodeEntry *ee = errcode_tab; + while (ee->atm != NULL) { + if (ee->code == code) { + return 0; + } + ++ee; + } + return 3; +} + +static Eterm build_load_error_hp(Eterm *hp, int code) +{ + ErrcodeEntry *ee = errcode_tab; + while (ee->atm != NULL) { + if (ee->code == code) { + return mkatom(ee->atm); + } + ++ee; + } + return TUPLE2(hp,am_open_error, make_small(code)); +} + + + +static Eterm mkatom(char *str) +{ + return am_atom_put(str, sys_strlen(str)); +} + +static char *pick_list_or_atom(Eterm name_term) +{ + char *name = NULL; + int name_len; + if (is_atom(name_term)) { + Atom *ap = atom_tab(atom_val(name_term)); + if (ap->len == 0) { + /* If io_lists with zero length is not allowed, + then the empty atom shouldn't */ + goto error; + } + name = erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF, ap->len + 1); + memcpy(name,ap->name,ap->len); + name[ap->len] = '\0'; + } else { + name_len = io_list_len(name_term); + if (name_len <= 0) { + goto error; + } + name = erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF, name_len + 1); + if (io_list_to_buf(name_term, name, name_len) != 0) { + goto error; + } + name[name_len] = '\0'; + } + return name; + error: + if (name != NULL) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, (void *) name); + } + return NULL; +} + +static int build_proc_info(DE_Handle *dh, ProcEntryInfo **out_pei, Uint filter) +{ + ProcEntryInfo *pei = NULL; + int num_pei = 0; + int num_pei_allocated = 0; + int i; + DE_ProcEntry *pe; + + assert_drv_list_locked(); + + for (pe = dh->procs; pe != NULL; pe = pe->next) { + Eterm id = pe->proc->id; + Uint stat = pe->awaiting_status; + if (stat == ERL_DE_PROC_AWAIT_UNLOAD_ONLY) { + stat = ERL_DE_PROC_AWAIT_UNLOAD; + } + if (stat != filter) { + continue; + } + for (i = 0; i < num_pei; ++i) { + if (pei[i].pid == id && pei[i].status == stat) { + break; + } + } + if (i < num_pei) { + pei[i].count++; + } else { + if (num_pei >= num_pei_allocated) { + pei = (pei == NULL) + ? erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF, + sizeof(ProcEntryInfo) * (num_pei_allocated = 10)) + : erts_realloc(ERTS_ALC_T_DDLL_TMP_BUF, pei, + sizeof(ProcEntryInfo) * (num_pei_allocated += 10)); + } + pei[num_pei].pid = id; + pei[num_pei].proc = pe->proc; + pei[num_pei].status = stat; + pei[num_pei].count = 1; + ++num_pei; + } + } + *out_pei = pei; + return num_pei; +} + + + +static erts_driver_t *lookup_driver(char *name) +{ + erts_driver_t *drv; + assert_drv_list_locked(); + for (drv = driver_list; drv != NULL && strcmp(drv->name, name); drv = drv->next) + ; + return drv; +} diff --git a/erts/emulator/beam/erl_bif_guard.c b/erts/emulator/beam/erl_bif_guard.c new file mode 100644 index 0000000000..8b47db10dd --- /dev/null +++ b/erts/emulator/beam/erl_bif_guard.c @@ -0,0 +1,628 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Numeric guard BIFs. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "erl_binary.h" + +static Eterm gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live); + +static Eterm double_to_integer(Process* p, double x); + +/* + * Guard BIFs called using apply/3 and guard BIFs that never build + * anything on the heap. + */ + +BIF_RETTYPE abs_1(BIF_ALIST_1) +{ + Eterm res; + Sint i0, i; + Eterm* hp; + + /* integer arguments */ + if (is_small(BIF_ARG_1)) { + i0 = signed_val(BIF_ARG_1); + i = labs(i0); + if (i0 == MIN_SMALL) { + hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(i, hp)); + } else { + BIF_RET(make_small(i)); + } + } else if (is_big(BIF_ARG_1)) { + if (!big_sign(BIF_ARG_1)) { + BIF_RET(BIF_ARG_1); + } else { + int sz = big_arity(BIF_ARG_1) + 1; + Uint* x; + + hp = HAlloc(BIF_P, sz); /* See note at beginning of file */ + sz--; + res = make_big(hp); + x = big_val(BIF_ARG_1); + *hp++ = make_pos_bignum_header(sz); + x++; /* skip thing */ + while(sz--) + *hp++ = *x++; + BIF_RET(res); + } + } else if (is_float(BIF_ARG_1)) { + FloatDef f; + + GET_DOUBLE(BIF_ARG_1, f); + if (f.fd < 0.0) { + hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); + f.fd = fabs(f.fd); + res = make_float(hp); + PUT_DOUBLE(f, hp); + BIF_RET(res); + } + else + BIF_RET(BIF_ARG_1); + } + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE float_1(BIF_ALIST_1) +{ + Eterm res; + Eterm* hp; + FloatDef f; + + /* check args */ + if (is_not_integer(BIF_ARG_1)) { + if (is_float(BIF_ARG_1)) { + BIF_RET(BIF_ARG_1); + } else { + badarg: + BIF_ERROR(BIF_P, BADARG); + } + } + if (is_small(BIF_ARG_1)) { + Sint i = signed_val(BIF_ARG_1); + f.fd = i; /* use "C"'s auto casting */ + } else if (big_to_double(BIF_ARG_1, &f.fd) < 0) { + goto badarg; + } + hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f, hp); + BIF_RET(res); +} + +BIF_RETTYPE trunc_1(BIF_ALIST_1) +{ + Eterm res; + FloatDef f; + + /* check arg */ + if (is_not_float(BIF_ARG_1)) { + if (is_integer(BIF_ARG_1)) + BIF_RET(BIF_ARG_1); + BIF_ERROR(BIF_P, BADARG); + } + /* get the float */ + GET_DOUBLE(BIF_ARG_1, f); + + /* truncate it and return the resultant integer */ + res = double_to_integer(BIF_P, (f.fd >= 0.0) ? floor(f.fd) : ceil(f.fd)); + BIF_RET(res); +} + +BIF_RETTYPE round_1(BIF_ALIST_1) +{ + Eterm res; + FloatDef f; + + /* check arg */ + if (is_not_float(BIF_ARG_1)) { + if (is_integer(BIF_ARG_1)) + BIF_RET(BIF_ARG_1); + BIF_ERROR(BIF_P, BADARG); + } + + /* get the float */ + GET_DOUBLE(BIF_ARG_1, f); + + /* round it and return the resultant integer */ + res = double_to_integer(BIF_P, (f.fd > 0.0) ? f.fd + 0.5 : f.fd - 0.5); + BIF_RET(res); +} + +BIF_RETTYPE length_1(BIF_ALIST_1) +{ + Eterm list; + Uint i; + + if (is_nil(BIF_ARG_1)) + BIF_RET(SMALL_ZERO); + if (is_not_list(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + list = BIF_ARG_1; + i = 0; + while (is_list(list)) { + i++; + list = CDR(list_val(list)); + } + if (is_not_nil(list)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(make_small(i)); +} + +/* returns the size of a tuple or a binary */ + +BIF_RETTYPE size_1(BIF_ALIST_1) +{ + if (is_tuple(BIF_ARG_1)) { + Eterm* tupleptr = tuple_val(BIF_ARG_1); + + BIF_RET(make_small(arityval(*tupleptr))); + } else if (is_binary(BIF_ARG_1)) { + Uint sz = binary_size(BIF_ARG_1); + if (IS_USMALL(0, sz)) { + return make_small(sz); + } else { + Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(sz, hp)); + } + } + BIF_ERROR(BIF_P, BADARG); +} + +/**********************************************************************/ +/* returns the bitsize of a bitstring */ + +BIF_RETTYPE bit_size_1(BIF_ALIST_1) +{ + Uint low_bits; + Uint bytesize; + Uint high_bits; + if (is_binary(BIF_ARG_1)) { + bytesize = binary_size(BIF_ARG_1); + high_bits = bytesize >> ((sizeof(Uint) * 8)-3); + low_bits = (bytesize << 3) + binary_bitsize(BIF_ARG_1); + if (high_bits == 0) { + if (IS_USMALL(0,low_bits)) { + BIF_RET(make_small(low_bits)); + } else { + Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(low_bits, hp)); + } + } else { + Uint sz = BIG_UINT_HEAP_SIZE+1; + Eterm* hp = HAlloc(BIF_P, sz); + hp[0] = make_pos_bignum_header(sz-1); + BIG_DIGIT(hp,0) = low_bits; + BIG_DIGIT(hp,1) = high_bits; + BIF_RET(make_big(hp)); + } + } else { + BIF_ERROR(BIF_P, BADARG); + } +} + +/**********************************************************************/ +/* returns the number of bytes need to store a bitstring */ + +BIF_RETTYPE byte_size_1(BIF_ALIST_1) +{ + if (is_binary(BIF_ARG_1)) { + Uint bytesize = binary_size(BIF_ARG_1); + if (binary_bitsize(BIF_ARG_1) > 0) { + bytesize++; + } + if (IS_USMALL(0, bytesize)) { + BIF_RET(make_small(bytesize)); + } else { + Eterm* hp = HAlloc(BIF_P, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(bytesize, hp)); + } + } else { + BIF_ERROR(BIF_P, BADARG); + } +} + +/* + * Generate the integer part from a double. + */ +static Eterm +double_to_integer(Process* p, double x) +{ + int is_negative; + int ds; + ErtsDigit* xp; + int i; + Eterm res; + size_t sz; + Eterm* hp; + double dbase; + + if ((x < (double) (MAX_SMALL+1)) && (x > (double) (MIN_SMALL-1))) { + Sint xi = x; + return make_small(xi); + } + + if (x >= 0) { + is_negative = 0; + } else { + is_negative = 1; + x = -x; + } + + /* Unscale & (calculate exponent) */ + ds = 0; + dbase = ((double)(D_MASK)+1); + while(x >= 1.0) { + x /= dbase; /* "shift" right */ + ds++; + } + sz = BIG_NEED_SIZE(ds); /* number of words including arity */ + + hp = HAlloc(p, sz); + res = make_big(hp); + xp = (ErtsDigit*) (hp + 1); + + for (i = ds-1; i >= 0; i--) { + ErtsDigit d; + + x *= dbase; /* "shift" left */ + d = x; /* trunc */ + xp[i] = d; /* store digit */ + x -= d; /* remove integer part */ + } + while ((ds & (BIG_DIGITS_PER_WORD-1)) != 0) { + xp[ds++] = 0; + } + + if (is_negative) { + *hp = make_neg_bignum_header(sz-1); + } else { + *hp = make_pos_bignum_header(sz-1); + } + return res; +} + +/* + * The following code is used when a guard that may build on the + * heap is called directly. They must not use HAlloc(), but must + * do a garbage collection if there is insufficient heap space. + */ + +#define ERTS_NEED_GC(p, need) ((HEAP_LIMIT((p)) - HEAP_TOP((p))) <= (need)) + +Eterm erts_gc_length_1(Process* p, Eterm* reg, Uint live) +{ + Eterm list = reg[live]; + int i; + + if (is_nil(list)) + return SMALL_ZERO; + i = 0; + while (is_list(list)) { + i++; + list = CDR(list_val(list)); + } + if (is_not_nil(list)) { + BIF_ERROR(p, BADARG); + } + return make_small(i); +} + +Eterm erts_gc_size_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg = reg[live]; + if (is_tuple(arg)) { + Eterm* tupleptr = tuple_val(arg); + return make_small(arityval(*tupleptr)); + } else if (is_binary(arg)) { + Uint sz = binary_size(arg); + if (IS_USMALL(0, sz)) { + return make_small(sz); + } else { + Eterm* hp; + if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) { + erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live); + } + hp = p->htop; + p->htop += BIG_UINT_HEAP_SIZE; + return uint_to_big(sz, hp); + } + } + BIF_ERROR(p, BADARG); +} + +Eterm erts_gc_bit_size_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg = reg[live]; + if (is_binary(arg)) { + Uint low_bits; + Uint bytesize; + Uint high_bits; + bytesize = binary_size(arg); + high_bits = bytesize >> ((sizeof(Uint) * 8)-3); + low_bits = (bytesize << 3) + binary_bitsize(arg); + if (high_bits == 0) { + if (IS_USMALL(0,low_bits)) { + return make_small(low_bits); + } else { + Eterm* hp; + if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) { + erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live); + } + hp = p->htop; + p->htop += BIG_UINT_HEAP_SIZE; + return uint_to_big(low_bits, hp); + } + } else { + Uint sz = BIG_UINT_HEAP_SIZE+1; + Eterm* hp; + if (ERTS_NEED_GC(p, sz)) { + erts_garbage_collect(p, sz, reg, live); + } + hp = p->htop; + p->htop += sz; + hp[0] = make_pos_bignum_header(sz-1); + BIG_DIGIT(hp,0) = low_bits; + BIG_DIGIT(hp,1) = high_bits; + return make_big(hp); + } + } else { + BIF_ERROR(p, BADARG); + } +} + +Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg = reg[live]; + if (is_binary(arg)) { + Uint bytesize = binary_size(arg); + if (binary_bitsize(arg) > 0) { + bytesize++; + } + if (IS_USMALL(0, bytesize)) { + return make_small(bytesize); + } else { + Eterm* hp; + if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) { + erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live); + } + hp = p->htop; + p->htop += BIG_UINT_HEAP_SIZE; + return uint_to_big(bytesize, hp); + } + } else { + BIF_ERROR(p, BADARG); + } +} + +Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg; + Eterm res; + Sint i0, i; + Eterm* hp; + + arg = reg[live]; + + /* integer arguments */ + if (is_small(arg)) { + i0 = signed_val(arg); + i = labs(i0); + if (i0 == MIN_SMALL) { + if (ERTS_NEED_GC(p, BIG_UINT_HEAP_SIZE)) { + erts_garbage_collect(p, BIG_UINT_HEAP_SIZE, reg, live+1); + arg = reg[live]; + } + hp = p->htop; + p->htop += BIG_UINT_HEAP_SIZE; + return uint_to_big(i, hp); + } else { + return make_small(i); + } + } else if (is_big(arg)) { + if (!big_sign(arg)) { + return arg; + } else { + int sz = big_arity(arg) + 1; + Uint* x; + + if (ERTS_NEED_GC(p, sz)) { + erts_garbage_collect(p, sz, reg, live+1); + arg = reg[live]; + } + hp = p->htop; + p->htop += sz; + sz--; + res = make_big(hp); + x = big_val(arg); + *hp++ = make_pos_bignum_header(sz); + x++; /* skip thing */ + while(sz--) + *hp++ = *x++; + return res; + } + } else if (is_float(arg)) { + FloatDef f; + + GET_DOUBLE(arg, f); + if (f.fd < 0.0) { + if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) { + erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live+1); + arg = reg[live]; + } + hp = p->htop; + p->htop += FLOAT_SIZE_OBJECT; + f.fd = fabs(f.fd); + res = make_float(hp); + PUT_DOUBLE(f, hp); + return res; + } + else + return arg; + } + BIF_ERROR(p, BADARG); +} + +Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg; + Eterm res; + Eterm* hp; + FloatDef f; + + /* check args */ + arg = reg[live]; + if (is_not_integer(arg)) { + if (is_float(arg)) { + return arg; + } else { + badarg: + BIF_ERROR(p, BADARG); + } + } + if (is_small(arg)) { + Sint i = signed_val(arg); + f.fd = i; /* use "C"'s auto casting */ + } else if (big_to_double(arg, &f.fd) < 0) { + goto badarg; + } + if (ERTS_NEED_GC(p, FLOAT_SIZE_OBJECT)) { + erts_garbage_collect(p, FLOAT_SIZE_OBJECT, reg, live+1); + arg = reg[live]; + } + hp = p->htop; + p->htop += FLOAT_SIZE_OBJECT; + res = make_float(hp); + PUT_DOUBLE(f, hp); + return res; +} + +Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg; + FloatDef f; + + arg = reg[live]; + if (is_not_float(arg)) { + if (is_integer(arg)) { + return arg; + } + BIF_ERROR(p, BADARG); + } + GET_DOUBLE(arg, f); + + return gc_double_to_integer(p, (f.fd > 0.0) ? f.fd + 0.5 : f.fd - 0.5, + reg, live); +} + +Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live) +{ + Eterm arg; + FloatDef f; + + arg = reg[live]; + if (is_not_float(arg)) { + if (is_integer(arg)) { + return arg; + } + BIF_ERROR(p, BADARG); + } + /* get the float */ + GET_DOUBLE(arg, f); + + /* truncate it and return the resultant integer */ + return gc_double_to_integer(p, (f.fd >= 0.0) ? floor(f.fd) : ceil(f.fd), + reg, live); +} + +static Eterm +gc_double_to_integer(Process* p, double x, Eterm* reg, Uint live) +{ + int is_negative; + int ds; + ErtsDigit* xp; + int i; + Eterm res; + size_t sz; + Eterm* hp; + double dbase; + + if ((x < (double) (MAX_SMALL+1)) && (x > (double) (MIN_SMALL-1))) { + Sint xi = x; + return make_small(xi); + } + + if (x >= 0) { + is_negative = 0; + } else { + is_negative = 1; + x = -x; + } + + /* Unscale & (calculate exponent) */ + ds = 0; + dbase = ((double)(D_MASK)+1); + while(x >= 1.0) { + x /= dbase; /* "shift" right */ + ds++; + } + sz = BIG_NEED_SIZE(ds); /* number of words including arity */ + if (ERTS_NEED_GC(p, sz)) { + erts_garbage_collect(p, sz, reg, live); + } + hp = p->htop; + p->htop += sz; + res = make_big(hp); + xp = (ErtsDigit*) (hp + 1); + + for (i = ds-1; i >= 0; i--) { + ErtsDigit d; + + x *= dbase; /* "shift" left */ + d = x; /* trunc */ + xp[i] = d; /* store digit */ + x -= d; /* remove integer part */ + } + while ((ds & (BIG_DIGITS_PER_WORD-1)) != 0) { + xp[ds++] = 0; + } + + if (is_negative) { + *hp = make_neg_bignum_header(sz-1); + } else { + *hp = make_pos_bignum_header(sz-1); + } + return res; +} diff --git a/erts/emulator/beam/erl_bif_info.c b/erts/emulator/beam/erl_bif_info.c new file mode 100644 index 0000000000..60216aa8e4 --- /dev/null +++ b/erts/emulator/beam/erl_bif_info.c @@ -0,0 +1,3803 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "erl_nmgc.h" +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "big.h" +#include "erl_version.h" +#include "erl_db_util.h" +#include "erl_message.h" +#include "erl_binary.h" +#include "erl_db.h" +#include "erl_instrument.h" +#include "dist.h" +#include "erl_gc.h" +#ifdef ELIB_ALLOC_IS_CLIB +#include "elib_stat.h" +#endif +#ifdef HIPE +#include "hipe_arch.h" +#endif + +#ifdef ERTS_ENABLE_LOCK_COUNT +#include "erl_lock_count.h" +#endif + +#ifdef VALGRIND +#include +#include +#endif + +#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) + +/* Keep erts_system_version as a global variable for easy access from a core */ +static char erts_system_version[] = ("Erlang " ERLANG_OTP_RELEASE + " (erts-" ERLANG_VERSION ")" +#ifndef OTP_RELEASE + " [source]" +#endif +#ifdef ARCH_64 + " [64-bit]" +#endif +#ifdef ERTS_SMP + " [smp:%bpu:%bpu]" +#endif + " [rq:%bpu]" +#ifdef USE_THREADS + " [async-threads:%d]" +#endif +#ifdef HIPE + " [hipe]" +#endif +#ifdef ERTS_ENABLE_KERNEL_POLL + " [kernel-poll:%s]" +#endif +#ifdef HYBRID + " [hybrid heap]" +#endif +#ifdef INCREMENTAL + " [incremental GC]" +#endif +#ifdef ET_DEBUG +#if ET_DEBUG + " [type-assertions]" +#endif +#endif +#ifdef DEBUG + " [debug-compiled]" +#endif +#ifdef ERTS_ENABLE_LOCK_CHECK + " [lock-checking]" +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + " [lock-counting]" +#endif +#ifdef PURIFY + " [purify-compiled]" +#endif +#ifdef VALGRIND + " [valgrind-compiled]" +#endif + "\n"); + +#define ASIZE(a) (sizeof(a)/sizeof(a[0])) + +#if defined(HAVE_SOLARIS_SPARC_PERFMON) +# include +# define PERFMON_SETPCR _IOW('P', 1, unsigned long long) +# define PERFMON_GETPCR _IOR('P', 2, unsigned long long) +#endif + +static Eterm +bld_bin_list(Uint **hpp, Uint *szp, ProcBin* pb) +{ + Eterm res = NIL; + Eterm tuple; + + for (; pb; pb = pb->next) { + Eterm val = erts_bld_uint(hpp, szp, (Uint) pb->val); + Eterm orig_size = erts_bld_uint(hpp, szp, pb->val->orig_size); + + if (szp) + *szp += 4+2; + if (hpp) { + Uint refc = (Uint) erts_smp_atomic_read(&pb->val->refc); + tuple = TUPLE3(*hpp, val, orig_size, make_small(refc)); + res = CONS(*hpp + 4, tuple, res); + *hpp += 4+2; + } + } + return res; +} + + +/* + make_monitor_list: + returns a list of records.. + -record(erl_monitor, { + type, % MON_ORIGIN or MON_TARGET (1 or 3) + ref, + pid, % Process or nodename + name % registered name or [] + }). +*/ + +static void do_calc_mon_size(ErtsMonitor *mon, void *vpsz) +{ + Uint *psz = vpsz; + *psz += IS_CONST(mon->ref) ? 0 : NC_HEAP_SIZE(mon->ref); + *psz += IS_CONST(mon->pid) ? 0 : NC_HEAP_SIZE(mon->pid); + *psz += 8; /* CONS + 5-tuple */ +} + +typedef struct { + Process *p; + Eterm *hp; + Eterm res; + Eterm tag; +} MonListContext; + +static void do_make_one_mon_element(ErtsMonitor *mon, void * vpmlc) +{ + MonListContext *pmlc = vpmlc; + Eterm tup; + Eterm r = (IS_CONST(mon->ref) + ? mon->ref + : STORE_NC(&(pmlc->hp), &MSO(pmlc->p).externals, mon->ref)); + Eterm p = (IS_CONST(mon->pid) + ? mon->pid + : STORE_NC(&(pmlc->hp), &MSO(pmlc->p).externals, mon->pid)); + tup = TUPLE5(pmlc->hp, pmlc->tag, make_small(mon->type), r, p, mon->name); + pmlc->hp += 6; + pmlc->res = CONS(pmlc->hp, tup, pmlc->res); + pmlc->hp += 2; +} + +static Eterm +make_monitor_list(Process *p, ErtsMonitor *root) +{ + DECL_AM(erl_monitor); + Uint sz = 0; + MonListContext mlc; + + erts_doforall_monitors(root, &do_calc_mon_size, &sz); + if (sz == 0) { + return NIL; + } + mlc.p = p; + mlc.hp = HAlloc(p,sz); + mlc.res = NIL; + mlc.tag = AM_erl_monitor; + erts_doforall_monitors(root, &do_make_one_mon_element, &mlc); + return mlc.res; +} + +/* + make_link_list: + returns a list of records.. + -record(erl_link, { + type, % LINK_NODE or LINK_PID (1 or 3) + pid, % Process or nodename + targets % List of erl_link's or nil + }). +*/ + +static void do_calc_lnk_size(ErtsLink *lnk, void *vpsz) +{ + Uint *psz = vpsz; + *psz += IS_CONST(lnk->pid) ? 0 : NC_HEAP_SIZE(lnk->pid); + if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) { + /* Node links use this pointer as ref counter... */ + erts_doforall_links(ERTS_LINK_ROOT(lnk),&do_calc_lnk_size,vpsz); + } + *psz += 7; /* CONS + 4-tuple */ +} + +typedef struct { + Process *p; + Eterm *hp; + Eterm res; + Eterm tag; +} LnkListContext; + +static void do_make_one_lnk_element(ErtsLink *lnk, void * vpllc) +{ + LnkListContext *pllc = vpllc; + Eterm tup; + Eterm old_res, targets = NIL; + Eterm p = (IS_CONST(lnk->pid) + ? lnk->pid + : STORE_NC(&(pllc->hp), &MSO(pllc->p).externals, lnk->pid)); + if (lnk->type == LINK_NODE) { + targets = make_small(ERTS_LINK_REFC(lnk)); + } else if (ERTS_LINK_ROOT(lnk) != NULL) { + old_res = pllc->res; + pllc->res = NIL; + erts_doforall_links(ERTS_LINK_ROOT(lnk),&do_make_one_lnk_element, vpllc); + targets = pllc->res; + pllc->res = old_res; + } + tup = TUPLE4(pllc->hp, pllc->tag, make_small(lnk->type), p, targets); + pllc->hp += 5; + pllc->res = CONS(pllc->hp, tup, pllc->res); + pllc->hp += 2; +} + +static Eterm +make_link_list(Process *p, ErtsLink *root, Eterm tail) +{ + DECL_AM(erl_link); + Uint sz = 0; + LnkListContext llc; + + erts_doforall_links(root, &do_calc_lnk_size, &sz); + if (sz == 0) { + return tail; + } + llc.p = p; + llc.hp = HAlloc(p,sz); + llc.res = tail; + llc.tag = AM_erl_link; + erts_doforall_links(root, &do_make_one_lnk_element, &llc); + return llc.res; +} + +int +erts_print_system_version(int to, void *arg, Process *c_p) +{ +#ifdef ERTS_SMP + Uint total, online, active; + (void) erts_schedulers_state(&total, &online, &active, 0); +#endif + return erts_print(to, arg, erts_system_version +#ifdef ERTS_SMP + , total, online, erts_no_run_queues +#else + , 1 +#endif +#ifdef USE_THREADS + , erts_async_max_threads +#endif +#ifdef ERTS_ENABLE_KERNEL_POLL + , erts_use_kernel_poll ? "true" : "false" +#endif + ); +} + +typedef struct { + Eterm entity; + Eterm node; +} MonitorInfo; + +typedef struct { + MonitorInfo *mi; + Uint mi_i; + Uint mi_max; + int sz; +} MonitorInfoCollection; + +#define INIT_MONITOR_INFOS(MIC) do { \ + (MIC).mi = NULL; \ + (MIC).mi_i = (MIC).mi_max = 0; \ + (MIC).sz = 0; \ +} while(0) + +#define MI_INC 50 +#define EXTEND_MONITOR_INFOS(MICP) \ +do { \ + if ((MICP)->mi_i >= (MICP)->mi_max) { \ + (MICP)->mi = ((MICP)->mi ? erts_realloc(ERTS_ALC_T_TMP, \ + (MICP)->mi, \ + ((MICP)->mi_max+MI_INC) \ + * sizeof(MonitorInfo)) \ + : erts_alloc(ERTS_ALC_T_TMP, \ + MI_INC*sizeof(MonitorInfo))); \ + (MICP)->mi_max += MI_INC; \ + } \ + } while (0) +#define DESTROY_MONITOR_INFOS(MIC) \ +do { \ + if ((MIC).mi != NULL) { \ + erts_free(ERTS_ALC_T_TMP, (void *) (MIC).mi); \ + } \ + } while (0) + +static void collect_one_link(ErtsLink *lnk, void *vmicp) +{ + MonitorInfoCollection *micp = vmicp; + EXTEND_MONITOR_INFOS(micp); + if (!(lnk->type == LINK_PID)) { + return; + } + micp->mi[micp->mi_i].entity = lnk->pid; + micp->sz += 2 + NC_HEAP_SIZE(lnk->pid); + micp->mi_i++; +} + +static void collect_one_origin_monitor(ErtsMonitor *mon, void *vmicp) +{ + MonitorInfoCollection *micp = vmicp; + + if (mon->type != MON_ORIGIN) { + return; + } + EXTEND_MONITOR_INFOS(micp); + if (is_atom(mon->pid)) { /* external by name */ + micp->mi[micp->mi_i].entity = mon->name; + micp->mi[micp->mi_i].node = mon->pid; + micp->sz += 3; /* need one 2-tuple */ + } else if (is_external_pid(mon->pid)) { /* external by pid */ + micp->mi[micp->mi_i].entity = mon->pid; + micp->mi[micp->mi_i].node = NIL; + micp->sz += NC_HEAP_SIZE(mon->pid); + } else if (!is_nil(mon->name)) { /* internal by name */ + micp->mi[micp->mi_i].entity = mon->name; + micp->mi[micp->mi_i].node = erts_this_dist_entry->sysname; + micp->sz += 3; /* need one 2-tuple */ + } else { /* internal by pid */ + micp->mi[micp->mi_i].entity = mon->pid; + micp->mi[micp->mi_i].node = NIL; + /* no additional heap space needed */ + } + micp->mi_i++; + micp->sz += 2 + 3; /* For a cons cell and a 2-tuple */ +} + +static void collect_one_target_monitor(ErtsMonitor *mon, void *vmicp) +{ + MonitorInfoCollection *micp = vmicp; + + if (mon->type != MON_TARGET) { + return; + } + + EXTEND_MONITOR_INFOS(micp); + + micp->mi[micp->mi_i].node = NIL; + micp->mi[micp->mi_i].entity = mon->pid; + micp->sz += (NC_HEAP_SIZE(mon->pid) + 2 /* cons */); + micp->mi_i++; +} + +typedef struct { + Process *c_p; + ErtsProcLocks c_p_locks; + ErtsSuspendMonitor **smi; + Uint smi_i; + Uint smi_max; + int sz; +} ErtsSuspendMonitorInfoCollection; + +#define ERTS_INIT_SUSPEND_MONITOR_INFOS(SMIC, CP, CPL) do { \ + (SMIC).c_p = (CP); \ + (SMIC).c_p_locks = (CPL); \ + (SMIC).smi = NULL; \ + (SMIC).smi_i = (SMIC).smi_max = 0; \ + (SMIC).sz = 0; \ +} while(0) + +#define ERTS_SMI_INC 50 +#define ERTS_EXTEND_SUSPEND_MONITOR_INFOS(SMICP) \ +do { \ + if ((SMICP)->smi_i >= (SMICP)->smi_max) { \ + (SMICP)->smi = ((SMICP)->smi \ + ? erts_realloc(ERTS_ALC_T_TMP, \ + (SMICP)->smi, \ + ((SMICP)->smi_max \ + + ERTS_SMI_INC) \ + * sizeof(ErtsSuspendMonitor *)) \ + : erts_alloc(ERTS_ALC_T_TMP, \ + ERTS_SMI_INC \ + * sizeof(ErtsSuspendMonitor *))); \ + (SMICP)->smi_max += ERTS_SMI_INC; \ + } \ + } while (0) + +#define ERTS_DESTROY_SUSPEND_MONITOR_INFOS(SMIC) \ +do { \ + if ((SMIC).smi != NULL) { \ + erts_free(ERTS_ALC_T_TMP, (void *) (SMIC).smi); \ + } \ + } while (0) + +static void +collect_one_suspend_monitor(ErtsSuspendMonitor *smon, void *vsmicp) +{ + ErtsSuspendMonitorInfoCollection *smicp = vsmicp; + Process *suspendee = erts_pid2proc(smicp->c_p, + smicp->c_p_locks, + smon->pid, + 0); + if (suspendee) { /* suspendee is alive */ + Sint a, p; + if (smon->active) { + smon->active += smon->pending; + smon->pending = 0; + } + + ASSERT((smon->active && !smon->pending) + || (smon->pending && !smon->active)); + + ERTS_EXTEND_SUSPEND_MONITOR_INFOS(smicp); + + smicp->smi[smicp->smi_i] = smon; + smicp->sz += 2 /* cons */ + 4 /* 3-tuple */; + + a = (Sint) smon->active; /* quiet compiler warnings */ + p = (Sint) smon->pending; /* on 64-bit machines */ + + if (!IS_SSMALL(a)) + smicp->sz += BIG_UINT_HEAP_SIZE; + if (!IS_SSMALL(p)) + smicp->sz += BIG_UINT_HEAP_SIZE; + smicp->smi_i++; + } +} + + +static void one_link_size(ErtsLink *lnk, void *vpu) +{ + Uint *pu = vpu; + *pu += ERTS_LINK_SIZE*sizeof(Uint); + if(!IS_CONST(lnk->pid)) + *pu += NC_HEAP_SIZE(lnk->pid)*sizeof(Uint); + if (lnk->type != LINK_NODE && ERTS_LINK_ROOT(lnk) != NULL) { + erts_doforall_links(ERTS_LINK_ROOT(lnk),&one_link_size,vpu); + } +} +static void one_mon_size(ErtsMonitor *mon, void *vpu) +{ + Uint *pu = vpu; + *pu += ERTS_MONITOR_SIZE*sizeof(Uint); + if(!IS_CONST(mon->pid)) + *pu += NC_HEAP_SIZE(mon->pid)*sizeof(Uint); + if(!IS_CONST(mon->ref)) + *pu += NC_HEAP_SIZE(mon->ref)*sizeof(Uint); +} + +/* + * process_info/[1,2] + */ + +#define ERTS_PI_FAIL_TYPE_BADARG 0 +#define ERTS_PI_FAIL_TYPE_YIELD 1 +#define ERTS_PI_FAIL_TYPE_AWAIT_EXIT 2 + +static ERTS_INLINE ErtsProcLocks +pi_locks(Eterm info) +{ + switch (info) { + case am_status: + case am_priority: + return ERTS_PROC_LOCK_STATUS; + case am_links: + case am_monitors: + case am_monitored_by: + case am_suspending: + return ERTS_PROC_LOCK_LINK; + case am_messages: + case am_message_queue_len: + case am_total_heap_size: + return ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_MSGQ; + case am_memory: + return ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_MSGQ; + default: + return ERTS_PROC_LOCK_MAIN; + } +} + +/* + * All valid process_info arguments. + */ +static Eterm pi_args[] = { + am_registered_name, + am_current_function, + am_initial_call, + am_status, + am_messages, + am_message_queue_len, + am_links, + am_monitors, + am_monitored_by, + am_dictionary, + am_trap_exit, + am_error_handler, + am_heap_size, + am_stack_size, + am_memory, + am_garbage_collection, + am_group_leader, + am_reductions, + am_priority, + am_trace, + am_binary, + am_sequential_trace_token, + am_catchlevel, + am_backtrace, + am_last_calls, + am_total_heap_size, + am_suspending, +#ifdef HYBRID + am_message_binary +#endif +}; + +#define ERTS_PI_ARGS ((int) (sizeof(pi_args)/sizeof(Eterm))) + +static ERTS_INLINE Eterm +pi_ix2arg(int ix) +{ + if (ix < 0 || ERTS_PI_ARGS <= ix) + return am_undefined; + return pi_args[ix]; +} + +static ERTS_INLINE int +pi_arg2ix(Eterm arg) +{ + switch (arg) { + case am_registered_name: return 0; + case am_current_function: return 1; + case am_initial_call: return 2; + case am_status: return 3; + case am_messages: return 4; + case am_message_queue_len: return 5; + case am_links: return 6; + case am_monitors: return 7; + case am_monitored_by: return 8; + case am_dictionary: return 9; + case am_trap_exit: return 10; + case am_error_handler: return 11; + case am_heap_size: return 12; + case am_stack_size: return 13; + case am_memory: return 14; + case am_garbage_collection: return 15; + case am_group_leader: return 16; + case am_reductions: return 17; + case am_priority: return 18; + case am_trace: return 19; + case am_binary: return 20; + case am_sequential_trace_token: return 21; + case am_catchlevel: return 22; + case am_backtrace: return 23; + case am_last_calls: return 24; + case am_total_heap_size: return 25; + case am_suspending: return 26; +#ifdef HYBRID + case am_message_binary: return 27; +#endif + default: return -1; + } +} + +static Eterm pi_1_keys[] = { + am_registered_name, + am_current_function, + am_initial_call, + am_status, + am_message_queue_len, + am_messages, + am_links, + am_dictionary, + am_trap_exit, + am_error_handler, + am_priority, + am_group_leader, + am_total_heap_size, + am_heap_size, + am_stack_size, + am_reductions, + am_garbage_collection, + am_suspending +}; + +#define ERTS_PI_1_NO_OF_KEYS (sizeof(pi_1_keys)/sizeof(Eterm)) + +static Eterm pi_1_keys_list; +static Uint pi_1_keys_list_heap[2*ERTS_PI_1_NO_OF_KEYS]; + +static void +process_info_init(void) +{ + Eterm *hp = &pi_1_keys_list_heap[0]; + int i; + + pi_1_keys_list = NIL; + + for (i = ERTS_PI_1_NO_OF_KEYS-1; i >= 0; i--) { + pi_1_keys_list = CONS(hp, pi_1_keys[i], pi_1_keys_list); + hp += 2; + } + +#ifdef DEBUG + { /* Make sure the process_info argument mappings are consistent */ + int ix; + for (ix = 0; ix < ERTS_PI_ARGS; ix++) { + ASSERT(pi_arg2ix(pi_ix2arg(ix)) == ix); + } + } +#endif + +} + +static ERTS_INLINE Process * +pi_pid2proc(Process *c_p, Eterm pid, ErtsProcLocks info_locks) +{ +#ifdef ERTS_SMP + /* + * If the main lock is needed, we use erts_pid2proc_not_running() + * instead of erts_pid2proc() for two reasons: + * * Current function of pid and possibly other information will + * have been updated so that process_info() is consistent with an + * info-request/info-response signal model. + * * We avoid blocking the whole scheduler executing the + * process that is calling process_info() for a long time + * which will happen if pid is currently running. + * The caller of process_info() may have to yield if pid + * is currently running. + */ + + if (info_locks & ERTS_PROC_LOCK_MAIN) + return erts_pid2proc_not_running(c_p, ERTS_PROC_LOCK_MAIN, + pid, info_locks); + else +#endif + return erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN, + pid, info_locks); +} + + + +BIF_RETTYPE +process_info_aux(Process *BIF_P, + Process *rp, + Eterm rpid, + Eterm item, + int always_wrap); + +#define ERTS_PI_RES_ELEM_IX_BUF_INC 1024 +#define ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ ERTS_PI_ARGS + +static Eterm +process_info_list(Process *c_p, Eterm pid, Eterm list, int always_wrap, + int *fail_type) +{ + int want_messages = 0; + int def_res_elem_ix_buf[ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ]; + int *res_elem_ix = &def_res_elem_ix_buf[0]; + int res_elem_ix_ix = -1; + int res_elem_ix_sz = ERTS_PI_DEF_RES_ELEM_IX_BUF_SZ; + Eterm part_res[ERTS_PI_ARGS]; + Eterm res, arg; + Uint *hp, *hp_end; + ErtsProcLocks locks = (ErtsProcLocks) 0; + int res_len, ix; + Process *rp = NULL; + + *fail_type = ERTS_PI_FAIL_TYPE_BADARG; + + for (ix = 0; ix < ERTS_PI_ARGS; ix++) + part_res[ix] = THE_NON_VALUE; + + ASSERT(is_list(list)); + + while (is_list(list)) { + Eterm* consp = list_val(list); + + arg = CAR(consp); + ix = pi_arg2ix(arg); + if (ix < 0) { + res = THE_NON_VALUE; + goto done; + } + if (arg == am_messages) + want_messages = 1; + locks |= pi_locks(arg); + res_elem_ix_ix++; + if (res_elem_ix_ix >= res_elem_ix_sz) { + if (res_elem_ix != &def_res_elem_ix_buf[0]) + res_elem_ix = + erts_realloc(ERTS_ALC_T_TMP, + res_elem_ix, + sizeof(int)*(res_elem_ix_sz + += ERTS_PI_RES_ELEM_IX_BUF_INC)); + else { + int new_res_elem_ix_sz = ERTS_PI_RES_ELEM_IX_BUF_INC; + int *new_res_elem_ix = erts_alloc(ERTS_ALC_T_TMP, + sizeof(int)*new_res_elem_ix_sz); + sys_memcpy((void *) new_res_elem_ix, + (void *) res_elem_ix, + sizeof(int)*res_elem_ix_sz); + res_elem_ix = new_res_elem_ix; + res_elem_ix_sz = new_res_elem_ix_sz; + } + } + res_elem_ix[res_elem_ix_ix] = ix; + list = CDR(consp); + } + if (is_not_nil(list)) { + res = THE_NON_VALUE; + goto done; + } + + res_len = res_elem_ix_ix+1; + + ASSERT(res_len > 0); + + rp = pi_pid2proc(c_p, pid, locks|ERTS_PROC_LOCK_STATUS); + if (!rp) { + res = am_undefined; + goto done; + } + else if (rp == ERTS_PROC_LOCK_BUSY) { + rp = NULL; + res = THE_NON_VALUE; + *fail_type = ERTS_PI_FAIL_TYPE_YIELD; + goto done; + } + else if (c_p != rp && ERTS_PROC_PENDING_EXIT(rp)) { + locks |= ERTS_PROC_LOCK_STATUS; + res = THE_NON_VALUE; + *fail_type = ERTS_PI_FAIL_TYPE_AWAIT_EXIT; + goto done; + } + else if (!(locks & ERTS_PROC_LOCK_STATUS)) { + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + } + + + /* + * We always handle 'messages' first if it should be part + * of the result. This since if both 'messages' and + * 'message_queue_len' are wanted, 'messages' may + * change the result of 'message_queue_len' (in case + * the queue contain bad distribution messages). + */ + if (want_messages) { + ix = pi_arg2ix(am_messages); + ASSERT(part_res[ix] == THE_NON_VALUE); + part_res[ix] = process_info_aux(c_p, rp, pid, am_messages, always_wrap); + ASSERT(part_res[ix] != THE_NON_VALUE); + } + + for (; res_elem_ix_ix >= 0; res_elem_ix_ix--) { + ix = res_elem_ix[res_elem_ix_ix]; + if (part_res[ix] == THE_NON_VALUE) { + arg = pi_ix2arg(ix); + part_res[ix] = process_info_aux(c_p, rp, pid, arg, always_wrap); + ASSERT(part_res[ix] != THE_NON_VALUE); + } + } + + hp = HAlloc(c_p, res_len*2); + hp_end = hp + res_len*2; + res = NIL; + + for (res_elem_ix_ix = res_len - 1; res_elem_ix_ix >= 0; res_elem_ix_ix--) { + ix = res_elem_ix[res_elem_ix_ix]; + ASSERT(part_res[ix] != THE_NON_VALUE); + /* + * If we should ignore the value of registered_name, + * its value is nil. For more info, see comment in the + * beginning of process_info_aux(). + */ + if (is_nil(part_res[ix])) { + ASSERT(!always_wrap); + ASSERT(pi_ix2arg(ix) == am_registered_name); + } + else { + res = CONS(hp, part_res[ix], res); + hp += 2; + } + } + + if (!always_wrap) { + HRelease(c_p, hp_end, hp); + } + + done: + + if (c_p == rp) + locks &= ~ERTS_PROC_LOCK_MAIN; + if (locks && rp) + erts_smp_proc_unlock(rp, locks); + + if (res_elem_ix != &def_res_elem_ix_buf[0]) + erts_free(ERTS_ALC_T_TMP, res_elem_ix); + + return res; +} + +BIF_RETTYPE process_info_1(BIF_ALIST_1) +{ + Eterm res; + int fail_type; + + if (is_external_pid(BIF_ARG_1) + && external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) + BIF_RET(am_undefined); + + if (is_not_internal_pid(BIF_ARG_1) + || internal_pid_index(BIF_ARG_1) >= erts_max_processes) { + BIF_ERROR(BIF_P, BADARG); + } + + res = process_info_list(BIF_P, BIF_ARG_1, pi_1_keys_list, 0, &fail_type); + if (is_non_value(res)) { + switch (fail_type) { + case ERTS_PI_FAIL_TYPE_BADARG: + BIF_ERROR(BIF_P, BADARG); + case ERTS_PI_FAIL_TYPE_YIELD: + ERTS_BIF_YIELD1(bif_export[BIF_process_info_1], BIF_P, BIF_ARG_1); + case ERTS_PI_FAIL_TYPE_AWAIT_EXIT: + ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined); + default: + erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error", __FILE__, __LINE__); + } + } + + ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED)); + BIF_RET(res); +} + + +BIF_RETTYPE process_info_2(BIF_ALIST_2) +{ + Eterm res; + Process *rp; + Eterm pid = BIF_ARG_1; + ErtsProcLocks info_locks; + int fail_type; + + if (is_external_pid(pid) + && external_pid_dist_entry(pid) == erts_this_dist_entry) + BIF_RET(am_undefined); + + if (is_not_internal_pid(pid) + || internal_pid_index(BIF_ARG_1) >= erts_max_processes) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_nil(BIF_ARG_2)) + BIF_RET(NIL); + + if (is_list(BIF_ARG_2)) { + res = process_info_list(BIF_P, BIF_ARG_1, BIF_ARG_2, 1, &fail_type); + if (is_non_value(res)) { + switch (fail_type) { + case ERTS_PI_FAIL_TYPE_BADARG: + BIF_ERROR(BIF_P, BADARG); + case ERTS_PI_FAIL_TYPE_YIELD: + ERTS_BIF_YIELD2(bif_export[BIF_process_info_2], BIF_P, + BIF_ARG_1, BIF_ARG_2); + case ERTS_PI_FAIL_TYPE_AWAIT_EXIT: + ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined); + default: + erl_exit(ERTS_ABORT_EXIT, "%s:%d: Internal error", + __FILE__, __LINE__); + } + } + ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED)); + BIF_RET(res); + } + + if (pi_arg2ix(BIF_ARG_2) < 0) + BIF_ERROR(BIF_P, BADARG); + + info_locks = pi_locks(BIF_ARG_2); + + rp = pi_pid2proc(BIF_P, pid, info_locks|ERTS_PROC_LOCK_STATUS); + if (!rp) + res = am_undefined; + else if (rp == ERTS_PROC_LOCK_BUSY) + ERTS_BIF_YIELD2(bif_export[BIF_process_info_2], BIF_P, + BIF_ARG_1, BIF_ARG_2); + else if (rp != BIF_P && ERTS_PROC_PENDING_EXIT(rp)) { + erts_smp_proc_unlock(rp, info_locks|ERTS_PROC_LOCK_STATUS); + ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_undefined); + } + else { + if (!(info_locks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + res = process_info_aux(BIF_P, rp, pid, BIF_ARG_2, 0); + } + ASSERT(is_value(res)); + +#ifdef ERTS_SMP + if (BIF_P == rp) + info_locks &= ~ERTS_PROC_LOCK_MAIN; + if (rp && info_locks) + erts_smp_proc_unlock(rp, info_locks); +#endif + + ASSERT(!(BIF_P->flags & F_P2PNR_RESCHED)); + BIF_RET(res); +} + +Eterm +process_info_aux(Process *BIF_P, + Process *rp, + Eterm rpid, + Eterm item, + int always_wrap) +{ + Eterm *hp; + Eterm res = NIL; + + ASSERT(rp); + + /* + * Q: Why this always_wrap argument? + * + * A: registered_name is strange. If process has no registered name, + * process_info(Pid, registered_name) returns [], and + * the result of process_info(Pid) has no {registered_name, Name} + * tuple in the resulting list. This is inconsistent with all other + * options, but we do not dare to change it. + * + * When process_info/2 is called with a list as second argument, + * registered_name behaves as it should, i.e. a + * {registered_name, []} will appear in the resulting list. + * + * If always_wrap != 0, process_info_aux() always wrap the result + * in a key two tuple. + */ + + switch (item) { + + case am_registered_name: + if (rp->reg != NULL) { + hp = HAlloc(BIF_P, 3); + res = rp->reg->name; + } else { + if (always_wrap) { + hp = HAlloc(BIF_P, 3); + res = NIL; + } + else { + return NIL; + } + } + break; + + case am_current_function: + if (rp->current == NULL) { + rp->current = find_function_from_pc(rp->i); + } + if (rp->current == NULL) { + hp = HAlloc(BIF_P, 3); + res = am_undefined; + } else { + Eterm* current; + + if (rp->current[0] == am_erlang && + rp->current[1] == am_process_info && + (rp->current[2] == 1 || rp->current[2] == 2) && + (current = find_function_from_pc(rp->cp)) != NULL) { + + /* + * The current function is erlang:process_info/2, + * which is not the answer that the application want. + * We will use the function pointed into by rp->cp + * instead. + */ + + rp->current = current; + } + + hp = HAlloc(BIF_P, 3+4); + res = TUPLE3(hp, rp->current[0], + rp->current[1], make_small(rp->current[2])); + hp += 4; + } + break; + + case am_initial_call: + hp = HAlloc(BIF_P, 3+4); + res = TUPLE3(hp, + rp->initial[INITIAL_MOD], + rp->initial[INITIAL_FUN], + make_small(rp->initial[INITIAL_ARI])); + hp += 4; + break; + + case am_status: + res = erts_process_status(BIF_P, ERTS_PROC_LOCK_MAIN, rp, rpid); + ASSERT(res != am_undefined); + hp = HAlloc(BIF_P, 3); + break; + + case am_messages: { + ErlMessage* mp; + int n; + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + n = rp->msg.len; + + if (n == 0 || rp->trace_flags & F_SENSITIVE) { + hp = HAlloc(BIF_P, 3); + } else { + int remove_bad_messages = 0; + struct { + Uint copy_struct_size; + ErlMessage* msgp; + } *mq = erts_alloc(ERTS_ALC_T_TMP, n*sizeof(*mq)); + Sint i = 0; + Uint heap_need = 3; + Eterm *hp_end; + + for (mp = rp->msg.first; mp; mp = mp->next) { + heap_need += 2; + mq[i].msgp = mp; + if (rp != BIF_P) { + Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp); + if (is_value(msg)) { + mq[i].copy_struct_size = (is_immed(msg) +#ifdef HYBRID + || NO_COPY(msg) +#endif + ? 0 + : size_object(msg)); + } + else if (mq[i].msgp->data.attached) { + mq[i].copy_struct_size + = erts_msg_attached_data_size(mq[i].msgp); + } + else { + /* Bad distribution message; ignore */ + remove_bad_messages = 1; + mq[i].copy_struct_size = 0; + } + heap_need += mq[i].copy_struct_size; + } + else { + mq[i].copy_struct_size = 0; + if (mp->data.attached) + heap_need += erts_msg_attached_data_size(mp); + } + i++; + } + + hp = HAlloc(BIF_P, heap_need); + hp_end = hp + heap_need; + ASSERT(i == n); + for (i--; i >= 0; i--) { + Eterm msg = ERL_MESSAGE_TERM(mq[i].msgp); + if (rp != BIF_P) { + if (is_value(msg)) { + if (mq[i].copy_struct_size) + msg = copy_struct(msg, + mq[i].copy_struct_size, + &hp, + &MSO(BIF_P)); + } + else if (mq[i].msgp->data.attached) { + ErlHeapFragment *hfp; + /* + * Decode it into a message buffer and attach it + * to the message instead of the attached external + * term. + * + * Note that we may not pass a process pointer + * to erts_msg_distext2heap(), since it would then + * try to alter locks on that process. + */ + msg = erts_msg_distext2heap( + NULL, NULL, &hfp, &ERL_MESSAGE_TOKEN(mq[i].msgp), + mq[i].msgp->data.dist_ext); + + ERL_MESSAGE_TERM(mq[i].msgp) = msg; + mq[i].msgp->data.heap_frag = hfp; + + if (is_non_value(msg)) { + ASSERT(!mq[i].msgp->data.heap_frag); + /* Bad distribution message; ignore */ + remove_bad_messages = 1; + continue; + } + else { + /* Make our copy of the message */ + ASSERT(size_object(msg) == hfp->size); + msg = copy_struct(msg, + hfp->size, + &hp, + &MSO(BIF_P)); + } + } + else { + /* Bad distribution message; ignore */ + remove_bad_messages = 1; + continue; + } + } + else { + if (mq[i].msgp->data.attached) { + /* Decode it on the heap */ + erts_move_msg_attached_data_to_heap(&hp, + &MSO(BIF_P), + mq[i].msgp); + msg = ERL_MESSAGE_TERM(mq[i].msgp); + ASSERT(!mq[i].msgp->data.attached); + if (is_non_value(msg)) { + /* Bad distribution message; ignore */ + remove_bad_messages = 1; + continue; + } + } + } + + res = CONS(hp, msg, res); + hp += 2; + } + HRelease(BIF_P, hp_end, hp+3); + erts_free(ERTS_ALC_T_TMP, mq); + if (remove_bad_messages) { + ErlMessage **mpp; + /* + * We need to remove bad distribution messages from + * the queue, so that the value returned for + * 'message_queue_len' is consistent with the value + * returned for 'messages'. + */ + mpp = &rp->msg.first; + mp = rp->msg.first; + while (mp) { + if (is_value(ERL_MESSAGE_TERM(mp))) { + mpp = &mp->next; + mp = mp->next; + } + else { + ErlMessage* bad_mp = mp; + ASSERT(!mp->data.attached); + if (rp->msg.save == &mp->next) + rp->msg.save = mpp; + if (rp->msg.last == &mp->next) + rp->msg.last = mpp; + *mpp = mp->next; + mp = mp->next; + rp->msg.len--; + free_message(bad_mp); + } + } + } + } + break; + } + + case am_message_queue_len: + hp = HAlloc(BIF_P, 3); + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + res = make_small(rp->msg.len); + break; + + case am_links: { + MonitorInfoCollection mic; + int i; + Eterm item; + + INIT_MONITOR_INFOS(mic); + + erts_doforall_links(rp->nlinks,&collect_one_link,&mic); + + hp = HAlloc(BIF_P, 3 + mic.sz); + res = NIL; + for (i = 0; i < mic.mi_i; i++) { + item = STORE_NC(&hp, &MSO(BIF_P).externals, mic.mi[i].entity); + res = CONS(hp, item, res); + hp += 2; + } + DESTROY_MONITOR_INFOS(mic); + break; + } + + case am_monitors: { + MonitorInfoCollection mic; + int i; + + INIT_MONITOR_INFOS(mic); + erts_doforall_monitors(rp->monitors,&collect_one_origin_monitor,&mic); + hp = HAlloc(BIF_P, 3 + mic.sz); + res = NIL; + for (i = 0; i < mic.mi_i; i++) { + if (is_atom(mic.mi[i].entity)) { + /* Monitor by name. + * Build {process, {Name, Node}} and cons it. + */ + Eterm t1, t2; + + t1 = TUPLE2(hp, mic.mi[i].entity, mic.mi[i].node); + hp += 3; + t2 = TUPLE2(hp, am_process, t1); + hp += 3; + res = CONS(hp, t2, res); + hp += 2; + } + else { + /* Monitor by pid. Build {process, Pid} and cons it. */ + Eterm t; + Eterm pid = STORE_NC(&hp, + &MSO(BIF_P).externals, + mic.mi[i].entity); + t = TUPLE2(hp, am_process, pid); + hp += 3; + res = CONS(hp, t, res); + hp += 2; + } + } + DESTROY_MONITOR_INFOS(mic); + break; + } + + case am_monitored_by: { + MonitorInfoCollection mic; + int i; + Eterm item; + + INIT_MONITOR_INFOS(mic); + erts_doforall_monitors(rp->monitors,&collect_one_target_monitor,&mic); + hp = HAlloc(BIF_P, 3 + mic.sz); + + res = NIL; + for (i = 0; i < mic.mi_i; ++i) { + item = STORE_NC(&hp, &MSO(BIF_P).externals, mic.mi[i].entity); + res = CONS(hp, item, res); + hp += 2; + } + DESTROY_MONITOR_INFOS(mic); + break; + } + + case am_suspending: { + ErtsSuspendMonitorInfoCollection smic; + int i; + Eterm item; +#ifdef DEBUG + Eterm *hp_end; +#endif + + ERTS_INIT_SUSPEND_MONITOR_INFOS(smic, + BIF_P, + (BIF_P == rp + ? ERTS_PROC_LOCK_MAIN + : 0) | ERTS_PROC_LOCK_LINK); + + erts_doforall_suspend_monitors(rp->suspend_monitors, + &collect_one_suspend_monitor, + &smic); + hp = HAlloc(BIF_P, 3 + smic.sz); +#ifdef DEBUG + hp_end = hp + smic.sz; +#endif + + res = NIL; + for (i = 0; i < smic.smi_i; i++) { + Sint a = (Sint) smic.smi[i]->active; /* quiet compiler warnings */ + Sint p = (Sint) smic.smi[i]->pending; /* on 64-bit machines... */ + Eterm active; + Eterm pending; + if (IS_SSMALL(a)) + active = make_small(a); + else { + active = small_to_big(a, hp); + hp += BIG_UINT_HEAP_SIZE; + } + if (IS_SSMALL(p)) + pending = make_small(p); + else { + pending = small_to_big(p, hp); + hp += BIG_UINT_HEAP_SIZE; + } + item = TUPLE3(hp, smic.smi[i]->pid, active, pending); + hp += 4; + res = CONS(hp, item, res); + hp += 2; + } + + ERTS_DESTROY_SUSPEND_MONITOR_INFOS(smic); + ASSERT(hp == hp_end); + + break; + } + + case am_dictionary: + if (rp->trace_flags & F_SENSITIVE) { + res = NIL; + } else { + res = erts_dictionary_copy(BIF_P, rp->dictionary); + } + hp = HAlloc(BIF_P, 3); + break; + + case am_trap_exit: + hp = HAlloc(BIF_P, 3); + if (rp->flags & F_TRAPEXIT) + res = am_true; + else + res = am_false; + break; + + case am_error_handler: + hp = HAlloc(BIF_P, 3); + res = erts_proc_get_error_handler(BIF_P); + break; + + case am_heap_size: { + Uint hsz = 3; + (void) erts_bld_uint(NULL, &hsz, HEAP_SIZE(rp)); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, HEAP_SIZE(rp)); + break; + } + + case am_total_heap_size: { + ErlMessage *mp; + Uint total_heap_size; + Uint hsz = 3; + + total_heap_size = rp->heap_sz; + if (rp->old_hend && rp->old_heap) + total_heap_size += rp->old_hend - rp->old_heap; + + total_heap_size += rp->mbuf_sz; + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + + for (mp = rp->msg.first; mp; mp = mp->next) + if (mp->data.attached) + total_heap_size += erts_msg_attached_data_size(mp); + + (void) erts_bld_uint(NULL, &hsz, total_heap_size); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, total_heap_size); + break; + } + + case am_stack_size: { + Uint stack_size = STACK_START(rp) - rp->stop; + Uint hsz = 3; + (void) erts_bld_uint(NULL, &hsz, stack_size); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, stack_size); + break; + } + + case am_memory: { /* Memory consumed in bytes */ + ErlMessage *mp; + Uint size = 0; + Uint hsz = 3; + struct saved_calls *scb; + size += sizeof(Process); + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(rp); + + erts_doforall_links(rp->nlinks, &one_link_size, &size); + erts_doforall_monitors(rp->monitors, &one_mon_size, &size); + size += (rp->heap_sz + rp->mbuf_sz) * sizeof(Eterm); + if (rp->old_hend && rp->old_heap) + size += (rp->old_hend - rp->old_heap) * sizeof(Eterm); + + size += rp->msg.len * sizeof(ErlMessage); + + for (mp = rp->msg.first; mp; mp = mp->next) + if (mp->data.attached) + size += erts_msg_attached_data_size(mp)*sizeof(Eterm); + + if (rp->arg_reg != rp->def_arg_reg) { + size += rp->arity * sizeof(rp->arg_reg[0]); + } + + if (rp->psd) + size += sizeof(ErtsPSD); + + scb = ERTS_PROC_GET_SAVED_CALLS_BUF(rp); + if (scb) { + size += (sizeof(struct saved_calls) + + (scb->len-1) * sizeof(scb->ct[0])); + } + + size += erts_dicts_mem_size(rp); + + (void) erts_bld_uint(NULL, &hsz, size); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, size); + break; + } + + case am_garbage_collection: { + DECL_AM(minor_gcs); + Eterm t; + + hp = HAlloc(BIF_P, 3+2+3+2+3); + t = TUPLE2(hp, AM_minor_gcs, make_small(GEN_GCS(rp))); + hp += 3; + res = CONS(hp, t, NIL); + hp += 2; + t = TUPLE2(hp, am_fullsweep_after, make_small(MAX_GEN_GCS(rp))); + hp += 3; + res = CONS(hp, t, res); + hp += 2; + break; + } + + case am_group_leader: { + int sz = NC_HEAP_SIZE(rp->group_leader); + hp = HAlloc(BIF_P, 3 + sz); + res = STORE_NC(&hp, &MSO(BIF_P).externals, rp->group_leader); + break; + } + + case am_reductions: { + Uint reds = rp->reds + erts_current_reductions(BIF_P, rp); + Uint hsz = 3; + (void) erts_bld_uint(NULL, &hsz, reds); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, reds); + break; + } + + case am_priority: + hp = HAlloc(BIF_P, 3); + res = erts_get_process_priority(rp); + break; + + case am_trace: + hp = HAlloc(BIF_P, 3); + res = make_small(rp->trace_flags & TRACEE_FLAGS); + break; + + case am_binary: { + Uint sz = 3; + (void) bld_bin_list(NULL, &sz, MSO(rp).mso); + hp = HAlloc(BIF_P, sz); + res = bld_bin_list(&hp, NULL, MSO(rp).mso); + break; + } + +#ifdef HYBRID + case am_message_binary: { + Uint sz = 3; + (void) bld_bin_list(NULL, &sz, erts_global_offheap.mso); + hp = HAlloc(BIF_P, sz); + res = bld_bin_list(&hp, NULL, erts_global_offheap.mso); + break; + } +#endif + + case am_sequential_trace_token: + res = copy_object(rp->seq_trace_token, BIF_P); + hp = HAlloc(BIF_P, 3); + break; + + case am_catchlevel: + hp = HAlloc(BIF_P, 3); + res = make_small(catchlevel(BIF_P)); + break; + + case am_backtrace: { + erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); + erts_stack_dump(ERTS_PRINT_DSBUF, (void *) dsbufp, rp); + res = new_binary(BIF_P, (byte *) dsbufp->str, (int) dsbufp->str_len); + erts_destroy_tmp_dsbuf(dsbufp); + hp = HAlloc(BIF_P, 3); + break; + } + + case am_last_calls: { + struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(BIF_P); + if (!scb) { + hp = HAlloc(BIF_P, 3); + res = am_false; + } else { + /* + * One cons cell and a 3-struct, and a 2-tuple. + * Might be less than that, if there are sends, receives or timeouts, + * so we must do a HRelease() to avoid creating holes. + */ + Uint needed = scb->n*(2+4) + 3; + Eterm* limit; + Eterm term, list; + int i, j; + + hp = HAlloc(BIF_P, needed); + limit = hp + needed; + list = NIL; + for (i = 0; i < scb->n; i++) { + j = scb->cur - i - 1; + if (j < 0) + j += scb->len; + if (scb->ct[j] == &exp_send) + term = am_send; + else if (scb->ct[j] == &exp_receive) + term = am_receive; + else if (scb->ct[j] == &exp_timeout) + term = am_timeout; + else { + term = TUPLE3(hp, + scb->ct[j]->code[0], + scb->ct[j]->code[1], + make_small(scb->ct[j]->code[2])); + hp += 4; + } + list = CONS(hp, term, list); + hp += 2; + } + res = list; + res = TUPLE2(hp, item, res); + hp += 3; + HRelease(BIF_P,limit,hp); + return res; + } + break; + } + + default: + return THE_NON_VALUE; /* will produce badarg */ + + } + + return TUPLE2(hp, item, res); +} +#undef MI_INC + +#if defined(VALGRIND) +static int check_if_xml(void) +{ + char buf[1]; + size_t bufsz = sizeof(buf); + return erts_sys_getenv("VALGRIND_LOG_XML", buf, &bufsz) >= 0; +} +#else +#define check_if_xml() 0 +#endif + +/* + * This function takes care of calls to erlang:system_info/1 when the argument + * is a tuple. + */ +static BIF_RETTYPE +info_1_tuple(Process* BIF_P, /* Pointer to current process. */ + Eterm* tp, /* Pointer to first element in tuple */ + int arity) /* Arity of tuple (untagged). */ +{ + Eterm ret; + Eterm sel; + + sel = *tp++; + + if (sel == am_allocator_sizes && arity == 2) { + return erts_allocator_info_term(BIF_P, *tp, 1); + } else if (sel == am_allocated) { + if (arity == 2) { + Eterm res = THE_NON_VALUE; + char *buf; + int len = is_string(*tp); + if (len <= 0) + return res; + buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1); + if (intlist_to_buf(*tp, buf, len) != len) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + buf[len] = '\0'; + res = erts_instr_dump_memory_map(buf) ? am_true : am_false; + erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (is_non_value(res)) + goto badarg; + return res; + } + else if (arity == 3 && tp[0] == am_status) { + if (is_atom(tp[1])) + return erts_instr_get_stat(BIF_P, tp[1], 1); + else { + Eterm res = THE_NON_VALUE; + char *buf; + int len = is_string(tp[1]); + if (len <= 0) + return res; + buf = (char *) erts_alloc(ERTS_ALC_T_TMP, len+1); + if (intlist_to_buf(tp[1], buf, len) != len) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + buf[len] = '\0'; + res = erts_instr_dump_stat(buf, 1) ? am_true : am_false; + erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (is_non_value(res)) + goto badarg; + return res; + } + } + else + goto badarg; + } else if (sel == am_allocator && arity == 2) { + return erts_allocator_info_term(BIF_P, *tp, 0); + } else if (ERTS_IS_ATOM_STR("internal_cpu_topology", sel) && arity == 2) { + return erts_get_cpu_topology_term(BIF_P, *tp); + } else if (ERTS_IS_ATOM_STR("cpu_topology", sel) && arity == 2) { + Eterm res = erts_get_cpu_topology_term(BIF_P, *tp); + ERTS_BIF_PREP_TRAP1(ret, erts_format_cpu_topology_trap, BIF_P, res); + return ret; +#if defined(PURIFY) || defined(VALGRIND) + } else if (ERTS_IS_ATOM_STR("error_checker", sel) +#if defined(PURIFY) + || sel == am_purify +#elif defined(VALGRIND) + || ERTS_IS_ATOM_STR("valgrind", sel) +#endif + ) { + if (*tp == am_memory) { +#if defined(PURIFY) + BIF_RET(erts_make_integer(purify_new_leaks(), BIF_P)); +#elif defined(VALGRIND) + VALGRIND_DO_LEAK_CHECK; + BIF_RET(make_small(0)); +#endif + } else if (*tp == am_fd) { +#if defined(PURIFY) + BIF_RET(erts_make_integer(purify_new_fds_inuse(), BIF_P)); +#elif defined(VALGRIND) + /* Not present in valgrind... */ + BIF_RET(make_small(0)); +#endif + } else if (*tp == am_running) { +#if defined(PURIFY) + BIF_RET(purify_is_running() ? am_true : am_false); +#elif defined(VALGRIND) + BIF_RET(RUNNING_ON_VALGRIND ? am_true : am_false); +#endif + } else if (is_list(*tp)) { +#if defined(PURIFY) +#define ERTS_ERROR_CHECKER_PRINTF purify_printf +#elif defined(VALGRIND) +#define ERTS_ERROR_CHECKER_PRINTF VALGRIND_PRINTF +#endif + int buf_size = 8*1024; /* Try with 8KB first */ + char *buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); + int r = io_list_to_buf(*tp, (char*) buf, buf_size - 1); + if (r < 0) { + erts_free(ERTS_ALC_T_TMP, (void *) buf); + buf_size = io_list_len(*tp); + if (buf_size < 0) + goto badarg; + buf_size++; + buf = erts_alloc(ERTS_ALC_T_TMP, buf_size); + r = io_list_to_buf(*tp, (char*) buf, buf_size - 1); + ASSERT(r == buf_size - 1); + } + buf[buf_size - 1 - r] = '\0'; + if (check_if_xml()) { + ERTS_ERROR_CHECKER_PRINTF("" + "%s\n", buf); + } else { + ERTS_ERROR_CHECKER_PRINTF("%s\n", buf); + } + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(am_true); +#undef ERTS_ERROR_CHECKER_PRINTF + } +#endif +#ifdef QUANTIFY + } else if (sel == am_quantify) { + if (*tp == am_clear) { + quantify_clear_data(); + BIF_RET(am_true); + } else if (*tp == am_start) { + quantify_start_recording_data(); + BIF_RET(am_true); + } else if (*tp == am_stop) { + quantify_stop_recording_data(); + BIF_RET(am_true); + } else if (*tp == am_running) { + BIF_RET(quantify_is_running() ? am_true : am_false); + } +#endif +#if defined(__GNUC__) && defined(HAVE_SOLARIS_SPARC_PERFMON) + } else if (ERTS_IS_ATOM_STR("ultrasparc_set_pcr", sel)) { + unsigned long long tmp; + int fd; + int rc; + + if (arity != 2 || !is_small(*tp)) { + goto badarg; + } + tmp = signed_val(*tp); + if ((fd = open("/dev/perfmon", O_RDONLY)) == -1) { + BIF_RET(am_false); + } + rc = ioctl(fd, PERFMON_SETPCR, &tmp); + close(fd); + if (rc < 0) { + BIF_RET(am_false); + } + BIF_RET(am_true); +#endif + } + + badarg: + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + + return ret; +} + +#define INFO_DSBUF_INC_SZ 256 + +static erts_dsprintf_buf_t * +grow_info_dsbuf(erts_dsprintf_buf_t *dsbufp, size_t need) +{ + size_t size; + size_t free_size = dsbufp->size - dsbufp->str_len; + + ASSERT(dsbufp); + + if (need <= free_size) + return dsbufp; + size = need - free_size + INFO_DSBUF_INC_SZ; + size = ((size + INFO_DSBUF_INC_SZ - 1)/INFO_DSBUF_INC_SZ)*INFO_DSBUF_INC_SZ; + size += dsbufp->size; + ASSERT(dsbufp->str_len + need <= size); + dsbufp->str = (char *) erts_realloc(ERTS_ALC_T_INFO_DSBUF, + (void *) dsbufp->str, + size); + dsbufp->size = size; + return dsbufp; +} + +static erts_dsprintf_buf_t * +erts_create_info_dsbuf(Uint size) +{ + Uint init_size = size ? size : INFO_DSBUF_INC_SZ; + erts_dsprintf_buf_t init = ERTS_DSPRINTF_BUF_INITER(grow_info_dsbuf); + erts_dsprintf_buf_t *dsbufp = erts_alloc(ERTS_ALC_T_INFO_DSBUF, + sizeof(erts_dsprintf_buf_t)); + sys_memcpy((void *) dsbufp, (void *) &init, sizeof(erts_dsprintf_buf_t)); + dsbufp->str = (char *) erts_alloc(ERTS_ALC_T_INFO_DSBUF, init_size); + dsbufp->str[0] = '\0'; + dsbufp->size = init_size; + return dsbufp; +} + +static void +erts_destroy_info_dsbuf(erts_dsprintf_buf_t *dsbufp) +{ + if (dsbufp->str) + erts_free(ERTS_ALC_T_INFO_DSBUF, (void *) dsbufp->str); + erts_free(ERTS_ALC_T_INFO_DSBUF, (void *) dsbufp); +} + +static Eterm +c_compiler_used(Eterm **hpp, Uint *szp) +{ + +#if defined(__GNUC__) +# if defined(__GNUC_MINOR__) && defined(__GNUC_PATCHLEVEL__) +# define ERTS_GNUC_VSN_NUMS 3 +# elif defined(__GNUC_MINOR__) +# define ERTS_GNUC_VSN_NUMS 2 +# else +# define ERTS_GNUC_VSN_NUMS 1 +# endif + return erts_bld_tuple(hpp, + szp, + 2, + erts_bld_atom(hpp, szp, "gnuc"), +#if ERTS_GNUC_VSN_NUMS > 1 + erts_bld_tuple(hpp, + szp, + ERTS_GNUC_VSN_NUMS, +#endif + erts_bld_uint(hpp, szp, + (Uint) __GNUC__) +#ifdef __GNUC_MINOR__ + , + erts_bld_uint(hpp, szp, + (Uint) __GNUC_MINOR__) +#ifdef __GNUC_PATCHLEVEL__ + , + erts_bld_uint(hpp, szp, + (Uint) __GNUC_PATCHLEVEL__) +#endif +#endif +#if ERTS_GNUC_VSN_NUMS > 1 + ) +#endif + ); + +#elif defined(_MSC_VER) + return erts_bld_tuple(hpp, + szp, + 2, + erts_bld_atom(hpp, szp, "msc"), + erts_bld_uint(hpp, szp, (Uint) _MSC_VER)); + +#else + return erts_bld_tuple(hpp, + szp, + 2, + am_undefined, + am_undefined); +#endif + +} + +BIF_RETTYPE system_info_1(BIF_ALIST_1) +{ + Eterm res; + Eterm* hp; + Eterm val; + int i; + + if (is_tuple(BIF_ARG_1)) { + Eterm* tp = tuple_val(BIF_ARG_1); + Uint arity = *tp++; + return info_1_tuple(BIF_P, tp, arityval(arity)); + } else if (BIF_ARG_1 == am_scheduler_id) { +#ifdef ERTS_SMP + ASSERT(BIF_P->scheduler_data); + BIF_RET(make_small(BIF_P->scheduler_data->no)); +#else + BIF_RET(make_small(1)); +#endif + } else if (BIF_ARG_1 == am_compat_rel) { + ASSERT(erts_compat_rel > 0); + BIF_RET(make_small(erts_compat_rel)); + } else if (BIF_ARG_1 == am_multi_scheduling) { +#ifndef ERTS_SMP + BIF_RET(am_disabled); +#else + if (erts_no_schedulers == 1) + BIF_RET(am_disabled); + else { + BIF_RET(erts_is_multi_scheduling_blocked() + ? am_blocked + : am_enabled); + } +#endif + } else if (BIF_ARG_1 == am_allocated_areas) { + res = erts_allocated_areas(NULL, NULL, BIF_P); + BIF_RET(res); + } else if (BIF_ARG_1 == am_allocated) { + BIF_RET(erts_instr_get_memory_map(BIF_P)); + } else if (BIF_ARG_1 == am_hipe_architecture) { +#if defined(HIPE) + BIF_RET(hipe_arch_name); +#else + BIF_RET(am_undefined); +#endif + } else if (BIF_ARG_1 == am_trace_control_word) { + BIF_RET(db_get_trace_control_word_0(BIF_P)); + } else if (ERTS_IS_ATOM_STR("ets_realloc_moves", BIF_ARG_1)) { + BIF_RET((erts_ets_realloc_always_moves) ? am_true : am_false); + } else if (BIF_ARG_1 == am_sequential_tracer) { + val = erts_get_system_seq_tracer(); + ASSERT(is_internal_pid(val) || is_internal_port(val) || val==am_false) + hp = HAlloc(BIF_P, 3); + res = TUPLE2(hp, am_sequential_tracer, val); + BIF_RET(res); + } else if (BIF_ARG_1 == am_garbage_collection){ + Uint val = (Uint) erts_smp_atomic_read(&erts_max_gen_gcs); + hp = HAlloc(BIF_P, 3+2); + res = TUPLE2(hp, am_fullsweep_after, make_small(val)); + hp += 3; + res = CONS(hp, res, NIL); + BIF_RET(res); + } else if (BIF_ARG_1 == am_fullsweep_after){ + Uint val = (Uint) erts_smp_atomic_read(&erts_max_gen_gcs); + hp = HAlloc(BIF_P, 3); + res = TUPLE2(hp, am_fullsweep_after, make_small(val)); + BIF_RET(res); + } else if (BIF_ARG_1 == am_process_count) { + BIF_RET(make_small(erts_process_count())); + } else if (BIF_ARG_1 == am_process_limit) { + BIF_RET(make_small(erts_max_processes)); + } else if (BIF_ARG_1 == am_info + || BIF_ARG_1 == am_procs + || BIF_ARG_1 == am_loaded + || BIF_ARG_1 == am_dist) { + erts_dsprintf_buf_t *dsbufp = erts_create_info_dsbuf(0); + + /* Need to be the only thread running... */ + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + if (BIF_ARG_1 == am_info) + info(ERTS_PRINT_DSBUF, (void *) dsbufp); + else if (BIF_ARG_1 == am_procs) + process_info(ERTS_PRINT_DSBUF, (void *) dsbufp); + else if (BIF_ARG_1 == am_loaded) + loaded(ERTS_PRINT_DSBUF, (void *) dsbufp); + else + distribution_info(ERTS_PRINT_DSBUF, (void *) dsbufp); + + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + + ASSERT(dsbufp && dsbufp->str); + res = new_binary(BIF_P, (byte *) dsbufp->str, (int) dsbufp->str_len); + erts_destroy_info_dsbuf(dsbufp); + BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("dist_ctrl", BIF_ARG_1)) { + DistEntry *dep; + i = 0; + /* Need to be the only thread running... */ + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + for (dep = erts_visible_dist_entries; dep; dep = dep->next) + ++i; + for (dep = erts_hidden_dist_entries; dep; dep = dep->next) + ++i; + hp = HAlloc(BIF_P,i*(3+2)); + res = NIL; + for (dep = erts_hidden_dist_entries; dep; dep = dep->next) { + Eterm tpl; + ASSERT(is_immed(dep->cid)); + tpl = TUPLE2(hp, dep->sysname, dep->cid); + hp +=3; + res = CONS(hp, tpl, res); + hp += 2; + } + for (dep = erts_visible_dist_entries; dep; dep = dep->next) { + Eterm tpl; + ASSERT(is_immed(dep->cid)); + tpl = TUPLE2(hp, dep->sysname, dep->cid); + hp +=3; + res = CONS(hp, tpl, res); + hp += 2; + } + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(res); + } else if (BIF_ARG_1 == am_system_version) { + erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); + erts_print_system_version(ERTS_PRINT_DSBUF, (void *) dsbufp, BIF_P); + hp = HAlloc(BIF_P, dsbufp->str_len*2); + res = buf_to_intlist(&hp, dsbufp->str, dsbufp->str_len, NIL); + erts_destroy_tmp_dsbuf(dsbufp); + BIF_RET(res); + } else if (BIF_ARG_1 == am_system_architecture) { + hp = HAlloc(BIF_P, 2*(sizeof(ERLANG_ARCHITECTURE)-1)); + BIF_RET(buf_to_intlist(&hp, + ERLANG_ARCHITECTURE, + sizeof(ERLANG_ARCHITECTURE)-1, + NIL)); + } + else if (BIF_ARG_1 == am_memory_types) { + return erts_instr_get_type_info(BIF_P); + } + else if (BIF_ARG_1 == am_os_type) { + Eterm type = am_atom_put(os_type, strlen(os_type)); + Eterm flav, tup; + char *buf = erts_alloc(ERTS_ALC_T_TMP, 1024); /* More than enough */ + + os_flavor(buf, 1024); + flav = am_atom_put(buf, strlen(buf)); + hp = HAlloc(BIF_P, 3); + tup = TUPLE2(hp, type, flav); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(tup); + } + else if (BIF_ARG_1 == am_allocator) { + BIF_RET(erts_allocator_options((void *) BIF_P)); + } + else if (BIF_ARG_1 == am_thread_pool_size) { +#ifdef USE_THREADS + extern int erts_async_max_threads; +#endif + int n; + +#ifdef USE_THREADS + n = erts_async_max_threads; +#else + n = 0; +#endif + BIF_RET(make_small(n)); + } + else if (BIF_ARG_1 == am_alloc_util_allocators) { + BIF_RET(erts_alloc_util_allocators((void *) BIF_P)); + } + else if (BIF_ARG_1 == am_elib_malloc) { +#ifdef ELIB_ALLOC_IS_CLIB + struct elib_stat stat; + DECL_AM(heap_size); + DECL_AM(max_alloced_size); + DECL_AM(alloced_size); + DECL_AM(free_size); + DECL_AM(no_alloced_blocks); + DECL_AM(no_free_blocks); + DECL_AM(smallest_alloced_block); + DECL_AM(largest_free_block); + Eterm atoms[8]; + Eterm ints[8]; + Uint **hpp; + Uint sz; + Uint *szp; + int length; +#ifdef DEBUG + Uint *endp; +#endif + + elib_stat(&stat); + + /* First find out the heap size needed ... */ + hpp = NULL; + szp = &sz; + sz = 0; + + build_elib_malloc_term: + length = 0; + atoms[length] = AM_heap_size; + ints[length++] = erts_bld_uint(hpp, szp, + (Uint) stat.mem_total*sizeof(Uint)); + atoms[length] = AM_max_alloced_size; + ints[length++] = erts_bld_uint(hpp, szp, + (Uint) stat.mem_max_alloc*sizeof(Uint)); + atoms[length] = AM_alloced_size; + ints[length++] = erts_bld_uint(hpp, szp, + (Uint) stat.mem_alloc*sizeof(Uint)); + atoms[length] = AM_free_size; + ints[length++] = erts_bld_uint(hpp, szp, + (Uint) stat.mem_free*sizeof(Uint)); + atoms[length] = AM_no_alloced_blocks; + ints[length++] = erts_bld_uint(hpp, szp, (Uint) stat.mem_blocks); + atoms[length] = AM_no_free_blocks; + ints[length++] = erts_bld_uint(hpp, szp, (Uint) stat.free_blocks); + atoms[length] = AM_smallest_alloced_block; + ints[length++] = erts_bld_uint(hpp, szp, + (Uint) stat.min_used*sizeof(Uint)); + atoms[length] = AM_largest_free_block; + ints[length++] = erts_bld_uint(hpp, szp, + (Uint) stat.max_free*sizeof(Uint)); + + + + ASSERT(length <= sizeof(atoms)/sizeof(Eterm)); + ASSERT(length <= sizeof(ints)/sizeof(Eterm)); + + res = erts_bld_2tup_list(hpp, szp, length, atoms, ints); + + if (szp) { + /* ... and then build the term */ + hp = HAlloc(BIF_P, sz); +#ifdef DEBUG + endp = hp + sz; +#endif + + szp = NULL; + hpp = &hp; + goto build_elib_malloc_term; + } + +#ifdef DEBUG + ASSERT(endp == hp); +#endif + +#else /* #ifdef ELIB_ALLOC_IS_CLIB */ + res = am_false; +#endif /* #ifdef ELIB_ALLOC_IS_CLIB */ + + BIF_RET(res); + } + else if (BIF_ARG_1 == am_os_version) { + int major, minor, build; + Eterm tup; + + os_version(&major, &minor, &build); + hp = HAlloc(BIF_P, 4); + tup = TUPLE3(hp, + make_small(major), + make_small(minor), + make_small(build)); + BIF_RET(tup); + } + else if (BIF_ARG_1 == am_version) { + int n = strlen(ERLANG_VERSION); + hp = HAlloc(BIF_P, ((sizeof ERLANG_VERSION)-1) * 2); + BIF_RET(buf_to_intlist(&hp, ERLANG_VERSION, n, NIL)); + } + else if (BIF_ARG_1 == am_machine) { + int n = strlen(EMULATOR); + hp = HAlloc(BIF_P, n*2); + BIF_RET(buf_to_intlist(&hp, EMULATOR, n, NIL)); + } + else if (BIF_ARG_1 == am_garbage_collection) { + BIF_RET(am_generational); +#ifdef ERTS_OPCODE_COUNTER_SUPPORT + } else if (BIF_ARG_1 == am_instruction_counts) { +#ifdef DEBUG + Eterm *endp; +#endif + Eterm *hp, **hpp; + Uint hsz, *hszp; + int i; + + hpp = NULL; + hsz = 0; + hszp = &hsz; + + bld_instruction_counts: + + res = NIL; + for (i = num_instructions-1; i >= 0; i--) { + res = erts_bld_cons(hpp, hszp, + erts_bld_tuple(hpp, hszp, 2, + am_atom_put(opc[i].name, + strlen(opc[i].name)), + erts_bld_uint(hpp, hszp, + opc[i].count)), + res); + } + + if (!hpp) { + hp = HAlloc(BIF_P, hsz); + hpp = &hp; +#ifdef DEBUG + endp = hp + hsz; +#endif + hszp = NULL; + goto bld_instruction_counts; + } + +#ifdef DEBUG + ASSERT(endp == hp); +#endif + + BIF_RET(res); +#endif /* #ifndef ERTS_SMP */ + } else if (BIF_ARG_1 == am_wordsize) { + return make_small(sizeof(Eterm)); + } else if (BIF_ARG_1 == am_endian) { +#if defined(WORDS_BIGENDIAN) + return am_big; +#else + return am_little; +#endif + } else if (BIF_ARG_1 == am_heap_sizes) { + return erts_heap_sizes(BIF_P); + } else if (BIF_ARG_1 == am_global_heaps_size) { +#ifdef HYBRID + Uint hsz = 0; + Uint sz = 0; + + sz += global_heap_sz; +#ifdef INCREMENTAL + /* The size of the old generation is a bit hard to define here... + * The amount of live data in the last collection perhaps..? */ + sz = 0; +#else + if (global_old_hend && global_old_heap) + sz += global_old_hend - global_old_heap; +#endif + + sz *= sizeof(Eterm); + + (void) erts_bld_uint(NULL, &hsz, sz); + hp = hsz ? HAlloc(BIF_P, hsz) : NULL; + res = erts_bld_uint(&hp, NULL, sz); +#else + res = make_small(0); +#endif + return res; + } else if (BIF_ARG_1 == am_heap_type) { +#if defined(HYBRID) + return am_hybrid; +#else + return am_private; +#endif + } else if (ERTS_IS_ATOM_STR("cpu_topology", BIF_ARG_1)) { + res = erts_get_cpu_topology_term(BIF_P, am_used); + BIF_TRAP1(erts_format_cpu_topology_trap, BIF_P, res); +#if defined(__GNUC__) && defined(HAVE_SOLARIS_SPARC_PERFMON) + } else if (ERTS_IS_ATOM_STR("ultrasparc_read_tick1", BIF_ARG_1)) { + register unsigned high asm("%l0"); + register unsigned low asm("%l1"); + + hp = HAlloc(BIF_P, 5); + asm volatile (".word 0xa3410000;" /* rd %tick, %l1 */ + ".word 0xa1347020" /* srlx %l1, 0x20, %l0 */ + : "=r" (high), "=r" (low)); + res = TUPLE4(hp, make_small(high >> 16), + make_small(high & 0xFFFF), + make_small(low >> 16), + make_small(low & 0xFFFF)); + BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("ultrasparc_read_tick2", BIF_ARG_1)) { + register unsigned high asm("%l0"); + register unsigned low asm("%l1"); + + asm volatile (".word 0xa3410000;" /* rd %tick, %l1 */ + ".word 0xa1347020" /* srlx %l1, 0x20, %l0 */ + : "=r" (high), "=r" (low)); + hp = HAlloc(BIF_P, 5); + res = TUPLE4(hp, make_small(high >> 16), + make_small(high & 0xFFFF), + make_small(low >> 16), + make_small(low & 0xFFFF)); + BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("ultrasparc_read_pic1", BIF_ARG_1)) { + register unsigned high asm("%l0"); + register unsigned low asm("%l1"); + + hp = HAlloc(BIF_P, 5); + asm volatile (".word 0xa3444000;" /* rd %asr17, %l1 */ + ".word 0xa1347020" /* srlx %l1, 0x20, %l0 */ + : "=r" (high), "=r" (low)); + res = TUPLE4(hp, make_small(high >> 16), + make_small(high & 0xFFFF), + make_small(low >> 16), + make_small(low & 0xFFFF)); + BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("ultrasparc_read_pic2", BIF_ARG_1)) { + register unsigned high asm("%l0"); + register unsigned low asm("%l1"); + + asm volatile (".word 0xa3444000;" /* rd %asr17, %l1 */ + ".word 0xa1347020" /* srlx %l1, 0x20, %l0 */ + : "=r" (high), "=r" (low)); + hp = HAlloc(BIF_P, 5); + res = TUPLE4(hp, make_small(high >> 16), + make_small(high & 0xFFFF), + make_small(low >> 16), + make_small(low & 0xFFFF)); + BIF_RET(res); +#endif + } else if (BIF_ARG_1 == am_threads) { +#ifdef USE_THREADS + return am_true; +#else + return am_false; +#endif + } else if (BIF_ARG_1 == am_creation) { + return make_small(erts_this_node->creation); + } else if (BIF_ARG_1 == am_break_ignored) { + extern int ignore_break; + if (ignore_break) + return am_true; + else + return am_false; + } + /* Arguments that are unusual follow ... */ + else if (ERTS_IS_ATOM_STR("logical_processors", BIF_ARG_1)) { + int no = erts_get_cpu_configured(erts_cpuinfo); + if (no > 0) + BIF_RET(make_small((Uint) no)); + else { + DECL_AM(unknown); + BIF_RET(AM_unknown); + } + } + else if (ERTS_IS_ATOM_STR("logical_processors_online", BIF_ARG_1)) { + int no = erts_get_cpu_online(erts_cpuinfo); + if (no > 0) + BIF_RET(make_small((Uint) no)); + else { + DECL_AM(unknown); + BIF_RET(AM_unknown); + } + } + else if (ERTS_IS_ATOM_STR("logical_processors_available", BIF_ARG_1)) { + int no = erts_get_cpu_available(erts_cpuinfo); + if (no > 0) + BIF_RET(make_small((Uint) no)); + else { + DECL_AM(unknown); + BIF_RET(AM_unknown); + } + } else if (ERTS_IS_ATOM_STR("otp_release", BIF_ARG_1)) { + int n = sizeof(ERLANG_OTP_RELEASE)-1; + hp = HAlloc(BIF_P, 2*n); + BIF_RET(buf_to_intlist(&hp, ERLANG_OTP_RELEASE, n, NIL)); + } else if (ERTS_IS_ATOM_STR("driver_version", BIF_ARG_1)) { + char buf[42]; + int n = erts_snprintf(buf, 42, "%d.%d", + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION); + hp = HAlloc(BIF_P, 2*n); + BIF_RET(buf_to_intlist(&hp, buf, n, NIL)); + } else if (ERTS_IS_ATOM_STR("smp_support", BIF_ARG_1)) { +#ifdef ERTS_SMP + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif + } else if (ERTS_IS_ATOM_STR("scheduler_bind_type", BIF_ARG_1)) { + BIF_RET(erts_bound_schedulers_term(BIF_P)); + } else if (ERTS_IS_ATOM_STR("scheduler_bindings", BIF_ARG_1)) { + BIF_RET(erts_get_schedulers_binds(BIF_P)); + } else if (ERTS_IS_ATOM_STR("constant_pool_support", BIF_ARG_1)) { + BIF_RET(am_true); + } else if (ERTS_IS_ATOM_STR("schedulers", BIF_ARG_1) + || ERTS_IS_ATOM_STR("schedulers_total", BIF_ARG_1)) { + res = make_small(erts_no_schedulers); + BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("schedulers_state", BIF_ARG_1)) { +#ifndef ERTS_SMP + Eterm *hp = HAlloc(BIF_P, 4); + res = TUPLE3(hp, make_small(1), make_small(1), make_small(1)); + BIF_RET(res); +#else + Uint total, online, active; + switch (erts_schedulers_state(&total, + &online, + &active, + 1)) { + case ERTS_SCHDLR_SSPND_DONE: { + Eterm *hp = HAlloc(BIF_P, 4); + res = TUPLE3(hp, + make_small(total), + make_small(online), + make_small(active)); + BIF_RET(res); + } + case ERTS_SCHDLR_SSPND_YIELD_RESTART: + ERTS_VBUMP_ALL_REDS(BIF_P); + BIF_TRAP1(bif_export[BIF_system_info_1], + BIF_P, BIF_ARG_1); + default: + ASSERT(0); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } +#endif + } else if (ERTS_IS_ATOM_STR("schedulers_online", BIF_ARG_1)) { +#ifndef ERTS_SMP + BIF_RET(make_small(1)); +#else + Uint total, online, active; + switch (erts_schedulers_state(&total, &online, &active, 1)) { + case ERTS_SCHDLR_SSPND_DONE: + BIF_RET(make_small(online)); + case ERTS_SCHDLR_SSPND_YIELD_RESTART: + ERTS_VBUMP_ALL_REDS(BIF_P); + BIF_TRAP1(bif_export[BIF_system_info_1], + BIF_P, BIF_ARG_1); + default: + ASSERT(0); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } +#endif + } else if (ERTS_IS_ATOM_STR("schedulers_active", BIF_ARG_1)) { +#ifndef ERTS_SMP + BIF_RET(make_small(1)); +#else + Uint total, online, active; + switch (erts_schedulers_state(&total, &online, &active, 1)) { + case ERTS_SCHDLR_SSPND_DONE: + BIF_RET(make_small(active)); + case ERTS_SCHDLR_SSPND_YIELD_RESTART: + ERTS_VBUMP_ALL_REDS(BIF_P); + BIF_TRAP1(bif_export[BIF_system_info_1], + BIF_P, BIF_ARG_1); + default: + ASSERT(0); + BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); + } +#endif + } else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) { + res = make_small(erts_no_run_queues); + BIF_RET(res); + } else if (ERTS_IS_ATOM_STR("c_compiler_used", BIF_ARG_1)) { + Eterm *hp = NULL; + Uint sz = 0; + (void) c_compiler_used(NULL, &sz); + if (sz) + hp = HAlloc(BIF_P, sz); + BIF_RET(c_compiler_used(&hp, NULL)); + } else if (ERTS_IS_ATOM_STR("stop_memory_trace", BIF_ARG_1)) { + erts_mtrace_stop(); + BIF_RET(am_true); + } else if (ERTS_IS_ATOM_STR("context_reductions", BIF_ARG_1)) { + BIF_RET(make_small(CONTEXT_REDS)); + } else if (ERTS_IS_ATOM_STR("kernel_poll", BIF_ARG_1)) { +#ifdef ERTS_ENABLE_KERNEL_POLL + BIF_RET(erts_use_kernel_poll ? am_true : am_false); +#else + BIF_RET(am_false); +#endif + } else if (ERTS_IS_ATOM_STR("lock_checking", BIF_ARG_1)) { +#ifdef ERTS_ENABLE_LOCK_CHECK + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif + } else if (ERTS_IS_ATOM_STR("lock_counting", BIF_ARG_1)) { +#ifdef ERTS_ENABLE_LOCK_COUNT + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif + } else if (ERTS_IS_ATOM_STR("debug_compiled", BIF_ARG_1)) { +#ifdef DEBUG + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif + } else if (ERTS_IS_ATOM_STR("check_io", BIF_ARG_1)) { + BIF_RET(erts_check_io_info(BIF_P)); + } else if (ERTS_IS_ATOM_STR("multi_scheduling_blockers", BIF_ARG_1)) { +#ifndef ERTS_SMP + BIF_RET(NIL); +#else + if (erts_no_schedulers == 1) + BIF_RET(NIL); + else + BIF_RET(erts_multi_scheduling_blockers(BIF_P)); +#endif + } else if (ERTS_IS_ATOM_STR("modified_timing_level", BIF_ARG_1)) { + BIF_RET(ERTS_USE_MODIFIED_TIMING() + ? make_small(erts_modified_timing_level) + : am_undefined); + } else if (ERTS_IS_ATOM_STR("port_tasks", BIF_ARG_1)) { + BIF_RET(am_true); + } else if (ERTS_IS_ATOM_STR("io_thread", BIF_ARG_1)) { + BIF_RET(am_false); + } else if (ERTS_IS_ATOM_STR("scheduling_statistics", BIF_ARG_1)) { + BIF_RET(erts_sched_stat_term(BIF_P, 0)); + } else if (ERTS_IS_ATOM_STR("total_scheduling_statistics", BIF_ARG_1)) { + BIF_RET(erts_sched_stat_term(BIF_P, 1)); + } else if (ERTS_IS_ATOM_STR("taints", BIF_ARG_1)) { + BIF_RET(erts_nif_taints(BIF_P)); + } + + BIF_ERROR(BIF_P, BADARG); +} + +Eterm +port_info_1(Process* p, Eterm pid) +{ + static Eterm keys[] = { + am_name, + am_links, + am_id, + am_connected, + am_input, + am_output + }; + Eterm items[ASIZE(keys)]; + Eterm result = NIL; + Eterm reg_name; + Eterm* hp; + Uint need; + int i; + + /* + * Collect all information about the port. + */ + + for (i = 0; i < ASIZE(keys); i++) { + Eterm item; + + item = port_info_2(p, pid, keys[i]); + if (is_non_value(item)) { + return THE_NON_VALUE; + } + if (item == am_undefined) { + return am_undefined; + } + items[i] = item; + } + reg_name = port_info_2(p, pid, am_registered_name); + + /* + * Build the resulting list. + */ + + need = 2*ASIZE(keys); + if (is_tuple(reg_name)) { + need += 2; + } + hp = HAlloc(p, need); + for (i = ASIZE(keys) - 1; i >= 0; i--) { + result = CONS(hp, items[i], result); + hp += 2; + } + if (is_tuple(reg_name)) { + result = CONS(hp, reg_name, result); + } + + return result; +} + + +/**********************************************************************/ +/* Return information on ports */ +/* Info: +** id Port index +** connected (Pid) +** links List of pids +** name String +** input Number of bytes input from port program +** output Number of bytes output to the port program +*/ + +BIF_RETTYPE port_info_2(BIF_ALIST_2) +{ + BIF_RETTYPE ret; + Eterm portid = BIF_ARG_1; + Port *prt; + Eterm item = BIF_ARG_2; + Eterm res; + Eterm* hp; + int count; + + if (is_internal_port(portid)) + prt = erts_id2port(portid, BIF_P, ERTS_PROC_LOCK_MAIN); + else if (is_atom(portid)) + erts_whereis_name(BIF_P, ERTS_PROC_LOCK_MAIN, + portid, NULL, 0, 0, &prt); + else if (is_external_port(portid) + && external_port_dist_entry(portid) == erts_this_dist_entry) + BIF_RET(am_undefined); + else { + BIF_ERROR(BIF_P, BADARG); + } + + if (!prt) { + BIF_RET(am_undefined); + } + + if (item == am_id) { + hp = HAlloc(BIF_P, 3); + res = make_small(internal_port_number(portid)); + } + else if (item == am_links) { + MonitorInfoCollection mic; + int i; + Eterm item; + + INIT_MONITOR_INFOS(mic); + + erts_doforall_links(prt->nlinks, &collect_one_link, &mic); + + hp = HAlloc(BIF_P, 3 + mic.sz); + res = NIL; + for (i = 0; i < mic.mi_i; i++) { + item = STORE_NC(&hp, &MSO(BIF_P).externals, mic.mi[i].entity); + res = CONS(hp, item, res); + hp += 2; + } + DESTROY_MONITOR_INFOS(mic); + + } + else if (item == am_monitors) { + MonitorInfoCollection mic; + int i; + Eterm item; + + INIT_MONITOR_INFOS(mic); + + erts_doforall_monitors(prt->monitors, &collect_one_origin_monitor, &mic); + + hp = HAlloc(BIF_P, 3 + mic.sz); + res = NIL; + for (i = 0; i < mic.mi_i; i++) { + Eterm t; + item = STORE_NC(&hp, &MSO(BIF_P).externals, mic.mi[i].entity); + t = TUPLE2(hp, am_process, item); + hp += 3; + res = CONS(hp, t, res); + hp += 2; + } + DESTROY_MONITOR_INFOS(mic); + + } + else if (item == am_name) { + count = sys_strlen(prt->name); + + hp = HAlloc(BIF_P, 3 + 2*count); + res = buf_to_intlist(&hp, prt->name, count, NIL); + } + else if (item == am_connected) { + hp = HAlloc(BIF_P, 3); + res = prt->connected; /* internal pid */ + } + else if (item == am_input) { + Uint hsz = 3; + Uint n = prt->bytes_in; + (void) erts_bld_uint(NULL, &hsz, n); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, n); + } + else if (item == am_output) { + Uint hsz = 3; + Uint n = prt->bytes_out; + (void) erts_bld_uint(NULL, &hsz, n); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, n); + } + else if (item == am_registered_name) { + RegProc *reg; + reg = prt->reg; + if (reg == NULL) { + ERTS_BIF_PREP_RET(ret, NIL); + goto done; + } else { + hp = HAlloc(BIF_P, 3); + res = reg->name; + } + } + else if (item == am_memory) { + /* All memory consumed in bytes (the Port struct should not be + included though). + */ + Uint hsz = 3; + Uint size = 0; + ErlHeapFragment* bp; + + hp = HAlloc(BIF_P, 3); + + erts_doforall_links(prt->nlinks, &one_link_size, &size); + + for (bp = prt->bp; bp; bp = bp->next) + size += sizeof(ErlHeapFragment) + (bp->size - 1)*sizeof(Eterm); + + if (prt->linebuf) + size += sizeof(LineBuf) + prt->linebuf->ovsiz; + + /* ... */ + + + /* All memory allocated by the driver should be included, but it is + hard to retrieve... */ + + (void) erts_bld_uint(NULL, &hsz, size); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, size); + } + else if (item == am_queue_size) { + Uint ioq_size = erts_port_ioq_size(prt); + Uint hsz = 3; + (void) erts_bld_uint(NULL, &hsz, ioq_size); + hp = HAlloc(BIF_P, hsz); + res = erts_bld_uint(&hp, NULL, ioq_size); + } + else if (ERTS_IS_ATOM_STR("locking", item)) { + hp = HAlloc(BIF_P, 3); +#ifndef ERTS_SMP + res = am_false; +#else + if (prt->status & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK) { + DECL_AM(port_level); + ASSERT(prt->drv_ptr->flags + & ERL_DRV_FLAG_USE_PORT_LOCKING); + res = AM_port_level; + } + else { + DECL_AM(driver_level); + ASSERT(!(prt->drv_ptr->flags + & ERL_DRV_FLAG_USE_PORT_LOCKING)); + res = AM_driver_level; + } +#endif + } + else { + ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG); + goto done; + } + + ERTS_BIF_PREP_RET(ret, TUPLE2(hp, item, res)); + + done: + + erts_smp_port_unlock(prt); + + return ret; +} + + +Eterm +fun_info_2(Process* p, Eterm fun, Eterm what) +{ + Eterm* hp; + Eterm val; + + if (is_fun(fun)) { + ErlFunThing* funp = (ErlFunThing *) fun_val(fun); + + switch (what) { + case am_type: + hp = HAlloc(p, 3); + val = am_local; + break; + case am_pid: + hp = HAlloc(p, 3); + val = funp->creator; + break; + case am_module: + hp = HAlloc(p, 3); + val = funp->fe->module; + break; + case am_new_index: + hp = HAlloc(p, 3); + val = make_small(funp->fe->index); + break; + case am_new_uniq: + val = new_binary(p, funp->fe->uniq, 16); + hp = HAlloc(p, 3); + break; + case am_index: + hp = HAlloc(p, 3); + val = make_small(funp->fe->old_index); + break; + case am_uniq: + hp = HAlloc(p, 3); + val = make_small(funp->fe->old_uniq); + break; + case am_env: + { + Uint num_free = funp->num_free; + int i; + + hp = HAlloc(p, 3 + 2*num_free); + val = NIL; + for (i = num_free-1; i >= 0; i--) { + val = CONS(hp, funp->env[i], val); + hp += 2; + } + } + break; + case am_refc: + val = erts_make_integer(erts_smp_atomic_read(&funp->fe->refc), p); + hp = HAlloc(p, 3); + break; + case am_arity: + hp = HAlloc(p, 3); + val = make_small(funp->arity); + break; + case am_name: + hp = HAlloc(p, 3); + val = funp->fe->address[-2]; + break; + default: + goto error; + } + } else if (is_export(fun)) { + Export* exp = (Export *) (export_val(fun))[1]; + switch (what) { + case am_type: + hp = HAlloc(p, 3); + val = am_external; + break; + case am_pid: + hp = HAlloc(p, 3); + val = am_undefined; + break; + case am_module: + hp = HAlloc(p, 3); + val = exp->code[0]; + break; + case am_new_index: + hp = HAlloc(p, 3); + val = am_undefined; + break; + case am_new_uniq: + hp = HAlloc(p, 3); + val = am_undefined; + break; + case am_index: + hp = HAlloc(p, 3); + val = am_undefined; + break; + case am_uniq: + hp = HAlloc(p, 3); + val = am_undefined; + break; + case am_env: + hp = HAlloc(p, 3); + val = NIL; + break; + case am_refc: + hp = HAlloc(p, 3); + val = am_undefined; + break; + case am_arity: + hp = HAlloc(p, 3); + val = make_small(exp->code[2]); + break; + case am_name: + hp = HAlloc(p, 3); + val = exp->code[1]; + break; + default: + goto error; + } + } else { + error: + BIF_ERROR(p, BADARG); + } + return TUPLE2(hp, what, val); +} + +BIF_RETTYPE is_process_alive_1(BIF_ALIST_1) +{ + if(is_internal_pid(BIF_ARG_1)) { + Process *rp; + + if (BIF_ARG_1 == BIF_P->id) + BIF_RET(am_true); + + if(internal_pid_index(BIF_ARG_1) >= erts_max_processes) + BIF_ERROR(BIF_P, BADARG); + + rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCK_STATUS); + if (!rp) { + BIF_RET(am_false); + } + else { + int have_pending_exit = ERTS_PROC_PENDING_EXIT(rp); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + if (have_pending_exit) + ERTS_BIF_AWAIT_X_DATA_TRAP(BIF_P, BIF_ARG_1, am_false); + else + BIF_RET(am_true); + } + } + else if(is_external_pid(BIF_ARG_1)) { + if(external_pid_dist_entry(BIF_ARG_1) == erts_this_dist_entry) + BIF_RET(am_false); /* A pid from an old incarnation of this node */ + else + BIF_ERROR(BIF_P, BADARG); + } + else { + BIF_ERROR(BIF_P, BADARG); + } +} + +BIF_RETTYPE process_display_2(BIF_ALIST_2) +{ + Process *rp; + + if (BIF_ARG_2 != am_backtrace) + BIF_ERROR(BIF_P, BADARG); + + rp = erts_pid2proc_nropt(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCKS_ALL); + if(!rp) { + BIF_ERROR(BIF_P, BADARG); + } + if (rp == ERTS_PROC_LOCK_BUSY) + ERTS_BIF_YIELD2(bif_export[BIF_process_display_2], BIF_P, + BIF_ARG_1, BIF_ARG_2); + if (rp != BIF_P && ERTS_PROC_PENDING_EXIT(rp)) { + Eterm args[2] = {BIF_ARG_1, BIF_ARG_2}; + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_ALL); + ERTS_BIF_AWAIT_X_APPLY_TRAP(BIF_P, + BIF_ARG_1, + am_erlang, + am_process_display, + args, + 2); + } + erts_stack_dump(ERTS_PRINT_STDERR, NULL, rp); +#ifdef ERTS_SMP + erts_smp_proc_unlock(rp, (BIF_P == rp + ? ERTS_PROC_LOCKS_ALL_MINOR + : ERTS_PROC_LOCKS_ALL)); +#endif + BIF_RET(am_true); +} + + +/* this is a general call which return some possibly useful information */ + +BIF_RETTYPE statistics_1(BIF_ALIST_1) +{ + Eterm res; + Eterm* hp; + + if (BIF_ARG_1 == am_context_switches) { + Eterm cs = erts_make_integer(erts_get_total_context_switches(), BIF_P); + hp = HAlloc(BIF_P, 3); + res = TUPLE2(hp, cs, SMALL_ZERO); + BIF_RET(res); + } else if (BIF_ARG_1 == am_garbage_collection) { + Uint hsz = 4; + ErtsGCInfo gc_info; + Eterm gcs; + Eterm recl; + erts_gc_info(&gc_info); + (void) erts_bld_uint(NULL, &hsz, gc_info.garbage_collections); + (void) erts_bld_uint(NULL, &hsz, gc_info.reclaimed); + hp = HAlloc(BIF_P, hsz); + gcs = erts_bld_uint(&hp, NULL, gc_info.garbage_collections); + recl = erts_bld_uint(&hp, NULL, gc_info.reclaimed); + res = TUPLE3(hp, gcs, recl, SMALL_ZERO); + BIF_RET(res); + } else if (BIF_ARG_1 == am_reductions) { + Uint reds; + Uint diff; + Uint hsz = 3; + Eterm b1, b2; + + erts_get_total_reductions(&reds, &diff); + (void) erts_bld_uint(NULL, &hsz, reds); + (void) erts_bld_uint(NULL, &hsz, diff); + hp = HAlloc(BIF_P, hsz); + b1 = erts_bld_uint(&hp, NULL, reds); + b2 = erts_bld_uint(&hp, NULL, diff); + res = TUPLE2(hp, b1, b2); + BIF_RET(res); + } else if (BIF_ARG_1 == am_exact_reductions) { + Uint reds; + Uint diff; + Uint hsz = 3; + Eterm b1, b2; + + erts_get_exact_total_reductions(BIF_P, &reds, &diff); + (void) erts_bld_uint(NULL, &hsz, reds); + (void) erts_bld_uint(NULL, &hsz, diff); + hp = HAlloc(BIF_P, hsz); + b1 = erts_bld_uint(&hp, NULL, reds); + b2 = erts_bld_uint(&hp, NULL, diff); + res = TUPLE2(hp, b1, b2); + BIF_RET(res); + } else if (BIF_ARG_1 == am_runtime) { + unsigned long u1, u2, dummy; + Eterm b1, b2; + elapsed_time_both(&u1,&dummy,&u2,&dummy); + b1 = erts_make_integer(u1,BIF_P); + b2 = erts_make_integer(u2,BIF_P); + hp = HAlloc(BIF_P,3); + res = TUPLE2(hp, b1, b2); + BIF_RET(res); + } else if (BIF_ARG_1 == am_run_queue) { + res = erts_run_queues_len(NULL); + BIF_RET(make_small(res)); + } else if (BIF_ARG_1 == am_wall_clock) { + Uint w1, w2; + Eterm b1, b2; + wall_clock_elapsed_time_both(&w1, &w2); + b1 = erts_make_integer(w1,BIF_P); + b2 = erts_make_integer(w2,BIF_P); + hp = HAlloc(BIF_P,3); + res = TUPLE2(hp, b1, b2); + BIF_RET(res); + } else if (BIF_ARG_1 == am_io) { + Eterm r1, r2; + Eterm in, out; + Uint hsz = 9; + Uint bytes_in = (Uint) erts_smp_atomic_read(&erts_bytes_in); + Uint bytes_out = (Uint) erts_smp_atomic_read(&erts_bytes_out); + + (void) erts_bld_uint(NULL, &hsz, bytes_in); + (void) erts_bld_uint(NULL, &hsz, bytes_out); + hp = HAlloc(BIF_P, hsz); + in = erts_bld_uint(&hp, NULL, bytes_in); + out = erts_bld_uint(&hp, NULL, bytes_out); + + r1 = TUPLE2(hp, am_input, in); + hp += 3; + r2 = TUPLE2(hp, am_output, out); + hp += 3; + BIF_RET(TUPLE2(hp, r1, r2)); + } + else if (ERTS_IS_ATOM_STR("run_queues", BIF_ARG_1)) { + Eterm res, *hp, **hpp; + Uint sz, *szp; + int no_qs = erts_no_run_queues; + Uint *qszs = erts_alloc(ERTS_ALC_T_TMP,sizeof(Uint)*no_qs*2); + (void) erts_run_queues_len(qszs); + sz = 0; + szp = &sz; + hpp = NULL; + while (1) { + int i; + for (i = 0; i < no_qs; i++) + qszs[no_qs+i] = erts_bld_uint(hpp, szp, qszs[i]); + res = erts_bld_tuplev(hpp, szp, no_qs, &qszs[no_qs]); + if (hpp) { + erts_free(ERTS_ALC_T_TMP, qszs); + BIF_RET(res); + } + hp = HAlloc(BIF_P, sz); + szp = NULL; + hpp = &hp; + } + } + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE memory_0(BIF_ALIST_0) +{ + BIF_RETTYPE res = erts_memory(NULL, NULL, BIF_P, THE_NON_VALUE); + switch (res) { + case am_badarg: BIF_ERROR(BIF_P, EXC_INTERNAL_ERROR); /* never... */ + case am_notsup: BIF_ERROR(BIF_P, EXC_NOTSUP); + default: BIF_RET(res); + } +} + +BIF_RETTYPE memory_1(BIF_ALIST_1) +{ + BIF_RETTYPE res = erts_memory(NULL, NULL, BIF_P, BIF_ARG_1); + switch (res) { + case am_badarg: BIF_ERROR(BIF_P, BADARG); + case am_notsup: BIF_ERROR(BIF_P, EXC_NOTSUP); + default: BIF_RET(res); + } +} + +BIF_RETTYPE error_logger_warning_map_0(BIF_ALIST_0) +{ + BIF_RET(erts_error_logger_warnings); +} + +static erts_smp_atomic_t available_internal_state; + +BIF_RETTYPE erts_debug_get_internal_state_1(BIF_ALIST_1) +{ + /* + * NOTE: Only supposed to be used for testing, and debugging. + */ + + if (!erts_smp_atomic_read(&available_internal_state)) { + BIF_ERROR(BIF_P, EXC_UNDEF); + } + + if (is_atom(BIF_ARG_1)) { + if (ERTS_IS_ATOM_STR("reds_left", BIF_ARG_1)) { + /* Used by (emulator) */ + BIF_RET(make_small((Uint) ERTS_BIF_REDS_LEFT(BIF_P))); + } + else if (ERTS_IS_ATOM_STR("node_and_dist_references", BIF_ARG_1)) { + /* Used by node_container_SUITE (emulator) */ + Eterm res = erts_get_node_and_dist_references(BIF_P); + BIF_RET(res); + } + else if (ERTS_IS_ATOM_STR("monitoring_nodes", BIF_ARG_1)) { + BIF_RET(erts_processes_monitoring_nodes(BIF_P)); + } + else if (ERTS_IS_ATOM_STR("next_pid", BIF_ARG_1) + || ERTS_IS_ATOM_STR("next_port", BIF_ARG_1)) { + /* Used by node_container_SUITE (emulator) */ + Eterm res; + if (ERTS_IS_ATOM_STR("next_pid", BIF_ARG_1)) + res = erts_test_next_pid(0, 0); + else { + res = erts_test_next_port(0, 0); + } + if (res < 0) + BIF_RET(am_false); + BIF_RET(erts_make_integer(res, BIF_P)); + } + else if (ERTS_IS_ATOM_STR("DbTable_words", BIF_ARG_1)) { + /* Used by ets_SUITE (stdlib) */ + size_t words = (sizeof(DbTable) + sizeof(Uint) - 1)/sizeof(Uint); + BIF_RET(make_small((Uint) words)); + } + else if (ERTS_IS_ATOM_STR("check_io_debug", BIF_ARG_1)) { + /* Used by (emulator) */ + int res; +#ifdef HAVE_ERTS_CHECK_IO_DEBUG + erts_smp_proc_unlock(BIF_P,ERTS_PROC_LOCK_MAIN); + res = erts_check_io_debug(); + erts_smp_proc_lock(BIF_P,ERTS_PROC_LOCK_MAIN); +#else + res = 0; +#endif + ASSERT(res >= 0); + BIF_RET(erts_make_integer((Uint) res, BIF_P)); + } + else if (ERTS_IS_ATOM_STR("process_info_args", BIF_ARG_1)) { + /* Used by process_SUITE (emulator) */ + int i; + Eterm res = NIL; + Uint *hp = HAlloc(BIF_P, 2*ERTS_PI_ARGS); + for (i = ERTS_PI_ARGS-1; i >= 0; i--) { + res = CONS(hp, pi_args[i], res); + hp += 2; + } + BIF_RET(res); + } + else if (ERTS_IS_ATOM_STR("processes", BIF_ARG_1)) { + /* Used by process_SUITE (emulator) */ + BIF_RET(erts_debug_processes(BIF_P)); + } + else if (ERTS_IS_ATOM_STR("processes_bif_info", BIF_ARG_1)) { + /* Used by process_SUITE (emulator) */ + BIF_RET(erts_debug_processes_bif_info(BIF_P)); + } + else if (ERTS_IS_ATOM_STR("max_atom_out_cache_index", BIF_ARG_1)) { + /* Used by distribution_SUITE (emulator) */ + BIF_RET(make_small((Uint) erts_debug_max_atom_out_cache_index())); + } + else if (ERTS_IS_ATOM_STR("nbalance", BIF_ARG_1)) { + Uint n; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + n = erts_debug_nbalance(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(erts_make_integer(n, BIF_P)); + } + else if (ERTS_IS_ATOM_STR("available_internal_state", BIF_ARG_1)) { + BIF_RET(am_true); + } + } + else if (is_tuple(BIF_ARG_1)) { + Eterm* tp = tuple_val(BIF_ARG_1); + switch (arityval(tp[0])) { + case 2: { + if (ERTS_IS_ATOM_STR("process_status", tp[1])) { + /* Used by timer process_SUITE, timer_bif_SUITE, and + node_container_SUITE (emulator) */ + if (is_internal_pid(tp[2])) { + BIF_RET(erts_process_status(BIF_P, + ERTS_PROC_LOCK_MAIN, + NULL, + tp[2])); + } + } + else if (ERTS_IS_ATOM_STR("link_list", tp[1])) { + /* Used by erl_link_SUITE (emulator) */ + if(is_internal_pid(tp[2])) { + Eterm res; + Process *p; + + p = erts_pid2proc(BIF_P, + ERTS_PROC_LOCK_MAIN, + tp[2], + ERTS_PROC_LOCK_LINK); + if (!p) { + ERTS_SMP_ASSERT_IS_NOT_EXITING(BIF_P); + BIF_RET(am_undefined); + } + res = make_link_list(BIF_P, p->nlinks, NIL); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + BIF_RET(res); + } + else if(is_internal_port(tp[2])) { + Eterm res; + Port *p = erts_id2port(tp[2], BIF_P, ERTS_PROC_LOCK_MAIN); + if(!p) + BIF_RET(am_undefined); + res = make_link_list(BIF_P, p->nlinks, NIL); + erts_smp_port_unlock(p); + BIF_RET(res); + } + else if(is_node_name_atom(tp[2])) { + DistEntry *dep = erts_find_dist_entry(tp[2]); + if(dep) { + Eterm subres; + erts_smp_de_links_lock(dep); + subres = make_link_list(BIF_P, dep->nlinks, NIL); + subres = make_link_list(BIF_P, dep->node_links, subres); + erts_smp_de_links_unlock(dep); + erts_deref_dist_entry(dep); + BIF_RET(subres); + } else { + BIF_RET(am_undefined); + } + } + } + else if (ERTS_IS_ATOM_STR("monitor_list", tp[1])) { + /* Used by erl_link_SUITE (emulator) */ + if(is_internal_pid(tp[2])) { + Process *p; + Eterm res; + + p = erts_pid2proc(BIF_P, + ERTS_PROC_LOCK_MAIN, + tp[2], + ERTS_PROC_LOCK_LINK); + if (!p) { + ERTS_SMP_ASSERT_IS_NOT_EXITING(BIF_P); + BIF_RET(am_undefined); + } + res = make_monitor_list(BIF_P, p->monitors); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_LINK); + BIF_RET(res); + } else if(is_node_name_atom(tp[2])) { + DistEntry *dep = erts_find_dist_entry(tp[2]); + if(dep) { + Eterm ml; + erts_smp_de_links_lock(dep); + ml = make_monitor_list(BIF_P, dep->monitors); + erts_smp_de_links_unlock(dep); + erts_deref_dist_entry(dep); + BIF_RET(ml); + } else { + BIF_RET(am_undefined); + } + } + } + else if (ERTS_IS_ATOM_STR("channel_number", tp[1])) { + Eterm res; + DistEntry *dep = erts_find_dist_entry(tp[2]); + if (!dep) + res = am_undefined; + else { + Uint cno = dist_entry_channel_no(dep); + res = make_small(cno); + erts_deref_dist_entry(dep); + } + BIF_RET(res); + } + else if (ERTS_IS_ATOM_STR("have_pending_exit", tp[1])) { + Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + tp[2], ERTS_PROC_LOCK_STATUS); + if (!rp) { + BIF_RET(am_undefined); + } + else { + Eterm res = ERTS_PROC_PENDING_EXIT(rp) ? am_true : am_false; + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + BIF_RET(res); + } + } + else if (ERTS_IS_ATOM_STR("binary_info", tp[1])) { + Eterm bin = tp[2]; + if (is_binary(bin)) { + Eterm real_bin = bin; + Eterm res = am_true; + ErlSubBin* sb = (ErlSubBin *) binary_val(real_bin); + + if (sb->thing_word == HEADER_SUB_BIN) { + real_bin = sb->orig; + } + if (*binary_val(real_bin) == HEADER_PROC_BIN) { + ProcBin* pb; + Binary* val; + Eterm SzTerm; + Uint hsz = 3 + 5; + Eterm* hp; + DECL_AM(refc_binary); + + pb = (ProcBin *) binary_val(real_bin); + val = pb->val; + (void) erts_bld_uint(NULL, &hsz, pb->size); + (void) erts_bld_uint(NULL, &hsz, val->orig_size); + hp = HAlloc(BIF_P, hsz); + + /* Info about the Binary* object */ + SzTerm = erts_bld_uint(&hp, NULL, val->orig_size); + res = TUPLE2(hp, am_binary, SzTerm); + hp += 3; + + /* Info about the ProcBin* object */ + SzTerm = erts_bld_uint(&hp, NULL, pb->size); + res = TUPLE4(hp, AM_refc_binary, SzTerm, + res, make_small(pb->flags)); + } else { /* heap binary */ + DECL_AM(heap_binary); + res = AM_heap_binary; + } + BIF_RET(res); + } + } + else if (ERTS_IS_ATOM_STR("term_to_binary_no_funs", tp[1])) { + Uint dflags = (DFLAG_EXTENDED_REFERENCES | + DFLAG_EXTENDED_PIDS_PORTS | + DFLAG_BIT_BINARIES); + BIF_RET(erts_term_to_binary(BIF_P, tp[2], 0, dflags)); + } + else if (ERTS_IS_ATOM_STR("dist_port", tp[1])) { + Eterm res = am_undefined; + DistEntry *dep = erts_sysname_to_connected_dist_entry(tp[2]); + if (dep) { + erts_smp_de_rlock(dep); + if (is_internal_port(dep->cid)) + res = dep->cid; + erts_smp_de_runlock(dep); + erts_deref_dist_entry(dep); + } + BIF_RET(res); + } + else if (ERTS_IS_ATOM_STR("atom_out_cache_index", tp[1])) { + /* Used by distribution_SUITE (emulator) */ + if (is_atom(tp[2])) { + BIF_RET(make_small( + (Uint) + erts_debug_atom_to_out_cache_index(tp[2]))); + } + } + else if (ERTS_IS_ATOM_STR("fake_scheduler_bindings", tp[1])) { + return erts_fake_scheduler_bindings(BIF_P, tp[2]); + } + break; + } + default: + break; + } + } + BIF_ERROR(BIF_P, BADARG); +} + +static erts_smp_atomic_t hipe_test_reschedule_flag; + +BIF_RETTYPE erts_debug_set_internal_state_2(BIF_ALIST_2) +{ + /* + * NOTE: Only supposed to be used for testing, and debugging. + */ + if (ERTS_IS_ATOM_STR("available_internal_state", BIF_ARG_1) + && (BIF_ARG_2 == am_true || BIF_ARG_2 == am_false)) { + long on = (long) (BIF_ARG_2 == am_true); + long prev_on = erts_smp_atomic_xchg(&available_internal_state, on); + if (on) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Process %T ", BIF_P->id); + if (erts_is_alive) + erts_dsprintf(dsbufp, "on node %T ", erts_this_node->sysname); + erts_dsprintf(dsbufp, + "enabled access to the emulator internal state.\n"); + erts_dsprintf(dsbufp, + "NOTE: This is an erts internal test feature and " + "should *only* be used by OTP test-suites.\n"); + erts_send_warning_to_logger(BIF_P->group_leader, dsbufp); + } + BIF_RET(prev_on ? am_true : am_false); + } + + if (!erts_smp_atomic_read(&available_internal_state)) { + BIF_ERROR(BIF_P, EXC_UNDEF); + } + + if (is_atom(BIF_ARG_1)) { + + if (ERTS_IS_ATOM_STR("reds_left", BIF_ARG_1)) { + Sint reds; + if (term_to_Sint(BIF_ARG_2, &reds) != 0) { + if (0 <= reds && reds <= CONTEXT_REDS) { + if (!ERTS_PROC_GET_SAVED_CALLS_BUF(BIF_P)) + BIF_P->fcalls = reds; + else + BIF_P->fcalls = reds - CONTEXT_REDS; + } + BIF_RET(am_true); + } + } + else if (ERTS_IS_ATOM_STR("block", BIF_ARG_1) + || ERTS_IS_ATOM_STR("sleep", BIF_ARG_1)) { + int block = ERTS_IS_ATOM_STR("block", BIF_ARG_1); + Sint ms; + if (term_to_Sint(BIF_ARG_2, &ms) != 0) { + if (ms > 0) { + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + if (block) + erts_smp_block_system(0); + while (erts_milli_sleep((long) ms) != 0); + if (block) + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + } + BIF_RET(am_true); + } + } + else if (ERTS_IS_ATOM_STR("block_scheduler", BIF_ARG_1)) { + Sint ms; + if (term_to_Sint(BIF_ARG_2, &ms) != 0) { + if (ms > 0) { + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + while (erts_milli_sleep((long) ms) != 0); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + } + BIF_RET(am_true); + } + } + else if (ERTS_IS_ATOM_STR("next_pid", BIF_ARG_1) + || ERTS_IS_ATOM_STR("next_port", BIF_ARG_1)) { + /* Used by node_container_SUITE (emulator) */ + Uint next; + + if (term_to_Uint(BIF_ARG_2, &next) != 0) { + Eterm res; + + if (ERTS_IS_ATOM_STR("next_pid", BIF_ARG_1)) + res = erts_test_next_pid(1, next); + else { + res = erts_test_next_port(1, next); + } + if (res < 0) + BIF_RET(am_false); + BIF_RET(erts_make_integer(res, BIF_P)); + } + } + else if (ERTS_IS_ATOM_STR("force_gc", BIF_ARG_1)) { + /* Used by signal_SUITE (emulator) */ + Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_2, ERTS_PROC_LOCK_MAIN); + if (!rp) { + BIF_RET(am_false); + } + else { + FLAGS(rp) |= F_FORCE_GC; + if (BIF_P != rp) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + BIF_RET(am_true); + } + } + else if (ERTS_IS_ATOM_STR("send_fake_exit_signal", BIF_ARG_1)) { + /* Used by signal_SUITE (emulator) */ + + /* Testcases depend on the exit being received via + a pending exit when the receiver is the same as + the caller. */ + if (is_tuple(BIF_ARG_2)) { + Eterm* tp = tuple_val(BIF_ARG_2); + if (arityval(tp[0]) == 3 + && (is_pid(tp[1]) || is_port(tp[1])) + && is_internal_pid(tp[2])) { + int xres; + ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; + Process *rp = erts_pid2proc_opt(BIF_P, ERTS_PROC_LOCK_MAIN, + tp[2], rp_locks, + ERTS_P2P_FLG_SMP_INC_REFC); + if (!rp) { + DECL_AM(dead); + BIF_RET(AM_dead); + } + +#ifdef ERTS_SMP + if (BIF_P == rp) + rp_locks |= ERTS_PROC_LOCK_MAIN; +#endif + xres = erts_send_exit_signal(NULL, /* NULL in order to + force a pending exit + when we send to our + selves. */ + tp[1], + rp, + &rp_locks, + tp[3], + NIL, + NULL, + 0); +#ifdef ERTS_SMP + if (BIF_P == rp) + rp_locks &= ~ERTS_PROC_LOCK_MAIN; +#endif + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); + if (xres > 1) { + DECL_AM(message); + BIF_RET(AM_message); + } + else if (xres == 0) { + DECL_AM(unaffected); + BIF_RET(AM_unaffected); + } + else { + DECL_AM(exit); + BIF_RET(AM_exit); + } + } + } + } + else if (ERTS_IS_ATOM_STR("colliding_names", BIF_ARG_1)) { + /* Used by ets_SUITE (stdlib) */ + if (is_tuple(BIF_ARG_2)) { + Eterm* tpl = tuple_val(BIF_ARG_2); + Uint cnt; + if (arityval(tpl[0]) == 2 && is_atom(tpl[1]) && + term_to_Uint(tpl[2], &cnt)) { + BIF_RET(erts_ets_colliding_names(BIF_P,tpl[1],cnt)); + } + } + } + else if (ERTS_IS_ATOM_STR("re_loop_limit", BIF_ARG_1)) { + /* Used by re_SUITE (stdlib) */ + Uint max_loops; + if (is_atom(BIF_ARG_2) && ERTS_IS_ATOM_STR("default", BIF_ARG_2)) { + max_loops = erts_re_set_loop_limit(-1); + BIF_RET(make_small(max_loops)); + } else if (term_to_Uint(BIF_ARG_2, &max_loops) != 0) { + max_loops = erts_re_set_loop_limit(max_loops); + BIF_RET(make_small(max_loops)); + } + } + else if (ERTS_IS_ATOM_STR("unicode_loop_limit", BIF_ARG_1)) { + /* Used by unicode_SUITE (stdlib) */ + Uint max_loops; + if (is_atom(BIF_ARG_2) && ERTS_IS_ATOM_STR("default", BIF_ARG_2)) { + max_loops = erts_unicode_set_loop_limit(-1); + BIF_RET(make_small(max_loops)); + } else if (term_to_Uint(BIF_ARG_2, &max_loops) != 0) { + max_loops = erts_unicode_set_loop_limit(max_loops); + BIF_RET(make_small(max_loops)); + } + } + else if (ERTS_IS_ATOM_STR("hipe_test_reschedule_suspend", BIF_ARG_1)) { + /* Used by hipe test suites */ + long flag = erts_smp_atomic_read(&hipe_test_reschedule_flag); + if (!flag && BIF_ARG_2 != am_false) { + erts_smp_atomic_set(&hipe_test_reschedule_flag, 1); + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, NULL); + ERTS_BIF_YIELD2(bif_export[BIF_erts_debug_set_internal_state_2], + BIF_P, BIF_ARG_1, BIF_ARG_2); + } + erts_smp_atomic_set(&hipe_test_reschedule_flag, !flag); + BIF_RET(NIL); + } + else if (ERTS_IS_ATOM_STR("hipe_test_reschedule_resume", BIF_ARG_1)) { + /* Used by hipe test suites */ + Eterm res = am_false; + Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_2, ERTS_PROC_LOCK_STATUS); + if (rp) { + erts_resume(rp, ERTS_PROC_LOCK_STATUS); + res = am_true; + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + } + BIF_RET(res); + } + else if (ERTS_IS_ATOM_STR("test_long_gc_sleep", BIF_ARG_1)) { + if (term_to_Uint(BIF_ARG_2, &erts_test_long_gc_sleep) > 0) + BIF_RET(am_true); + } + else if (ERTS_IS_ATOM_STR("abort", BIF_ARG_1)) { + erl_exit(ERTS_ABORT_EXIT, "%T\n", BIF_ARG_2); + } + else if (ERTS_IS_ATOM_STR("kill_dist_connection", BIF_ARG_1)) { + DistEntry *dep = erts_sysname_to_connected_dist_entry(BIF_ARG_2); + if (!dep) + BIF_RET(am_false); + else { + Uint32 con_id; + erts_smp_de_rlock(dep); + con_id = dep->connection_id; + erts_smp_de_runlock(dep); + erts_kill_dist_connection(dep, con_id); + erts_deref_dist_entry(dep); + BIF_RET(am_true); + } + } + else if (ERTS_IS_ATOM_STR("not_running_optimization", BIF_ARG_1)) { +#ifdef ERTS_SMP + int old_use_opt, use_opt; + switch (BIF_ARG_2) { + case am_true: + use_opt = 1; + break; + case am_false: + use_opt = 0; + break; + default: + BIF_ERROR(BIF_P, BADARG); + } + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + old_use_opt = !erts_disable_proc_not_running_opt; + erts_disable_proc_not_running_opt = !use_opt; + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(old_use_opt ? am_true : am_false); +#else + BIF_ERROR(BIF_P, EXC_NOTSUP); +#endif + } + } + + BIF_ERROR(BIF_P, BADARG); +} + +#ifdef ERTS_ENABLE_LOCK_COUNT +static Eterm lcnt_build_lock_stats_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_stats_t *stats, Eterm res) { + unsigned long tries = 0, colls = 0; + unsigned long timer_s = 0, timer_ns = 0, timer_n = 0; + unsigned int line = 0; + + Eterm af, uil; + Eterm uit, uic; + Eterm uits, uitns, uitn; + Eterm tt, tstat, tloc, t; + + /* term: + * [{{file, line}, {tries, colls, {seconds, nanoseconds, n_blocks}}}] + */ + + ethr_atomic_read(&stats->tries, (long *)&tries); + ethr_atomic_read(&stats->colls, (long *)&colls); + + line = stats->line; + timer_s = stats->timer.s; + timer_ns = stats->timer.ns; + timer_n = stats->timer_n; + + af = am_atom_put(stats->file, strlen(stats->file)); + uil = erts_bld_uint( hpp, szp, line); + tloc = erts_bld_tuple(hpp, szp, 2, af, uil); + + uit = erts_bld_uint( hpp, szp, tries); + uic = erts_bld_uint( hpp, szp, colls); + + uits = erts_bld_uint( hpp, szp, timer_s); + uitns = erts_bld_uint( hpp, szp, timer_ns); + uitn = erts_bld_uint( hpp, szp, timer_n); + tt = erts_bld_tuple(hpp, szp, 3, uits, uitns, uitn); + + tstat = erts_bld_tuple(hpp, szp, 3, uit, uic, tt); + + t = erts_bld_tuple(hpp, szp, 2, tloc, tstat); + + res = erts_bld_cons( hpp, szp, t, res); + + return res; +} + +static Eterm lcnt_build_lock_term(Eterm **hpp, Uint *szp, erts_lcnt_lock_t *lock, Eterm res) { + Eterm name, type, id, stats = NIL, t; + Process *proc = NULL; + char *ltype; + int i; + + /* term: + * [{name, id, type, stats()}] + */ + + ASSERT(lock->name); + + ltype = erts_lcnt_lock_type(lock->flag); + + ASSERT(ltype); + + type = am_atom_put(ltype, strlen(ltype)); + + name = am_atom_put(lock->name, strlen(lock->name)); + + if (lock->flag & ERTS_LCNT_LT_ALLOC) { + /* use allocator types names as id's for allocator locks */ + ltype = ERTS_ALC_A2AD(signed_val(lock->id)); + id = am_atom_put(ltype, strlen(ltype)); + } else if (lock->flag & ERTS_LCNT_LT_PROCLOCK) { + /* use registered names as id's for process locks if available */ + proc = erts_pid2proc_unlocked(lock->id); + if (proc && proc->reg) { + id = proc->reg->name; + } else { + /* otherwise use process id */ + id = lock->id; + } + } else { + id = lock->id; + } + + for (i = 0; i < lock->n_stats; i++) { + stats = lcnt_build_lock_stats_term(hpp, szp, &(lock->stats[i]), stats); + } + + t = erts_bld_tuple(hpp, szp, 4, name, id, type, stats); + + res = erts_bld_cons( hpp, szp, t, res); + + return res; +} + +static Eterm lcnt_build_result_term(Eterm **hpp, Uint *szp, erts_lcnt_data_t *data, Eterm res) { + Eterm dts, dtns, tdt, adur, tdur, aloc, lloc = NIL, tloc; + erts_lcnt_lock_t *lock = NULL; + char *str_duration = "duration"; + char *str_locks = "locks"; + + /* term: + * [{'duration', {seconds, nanoseconds}}, {'locks', locks()}] + */ + + /* duration tuple */ + dts = erts_bld_uint( hpp, szp, data->duration.s); + dtns = erts_bld_uint( hpp, szp, data->duration.ns); + tdt = erts_bld_tuple(hpp, szp, 2, dts, dtns); + + adur = am_atom_put(str_duration, strlen(str_duration)); + tdur = erts_bld_tuple(hpp, szp, 2, adur, tdt); + + /* lock tuple */ + + aloc = am_atom_put(str_locks, strlen(str_locks)); + + for (lock = data->current_locks->head; lock != NULL ; lock = lock->next ) { + lloc = lcnt_build_lock_term(hpp, szp, lock, lloc); + } + + for (lock = data->deleted_locks->head; lock != NULL ; lock = lock->next ) { + lloc = lcnt_build_lock_term(hpp, szp, lock, lloc); + } + + tloc = erts_bld_tuple(hpp, szp, 2, aloc, lloc); + + res = erts_bld_cons( hpp, szp, tloc, res); + res = erts_bld_cons( hpp, szp, tdur, res); + + return res; +} +#endif + +BIF_RETTYPE erts_debug_lock_counters_1(BIF_ALIST_1) +{ +#ifdef ERTS_ENABLE_LOCK_COUNT + Eterm res = NIL; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + if (BIF_ARG_1 == am_info) { + erts_lcnt_data_t *data; + Uint hsize = 0; + Uint *szp; + Eterm* hp; + + erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_SUSPEND); + + data = erts_lcnt_get_data(); + + /* calculate size */ + + szp = &hsize; + lcnt_build_result_term(NULL, szp, data, NIL); + + /* alloc and build */ + + hp = HAlloc(BIF_P, hsize); + + res = lcnt_build_result_term(&hp, NULL, data, res); + + erts_lcnt_clear_rt_opt(ERTS_LCNT_OPT_SUSPEND); + + goto done; + } else if (BIF_ARG_1 == am_clear) { + erts_lcnt_clear_counters(); + res = am_ok; + goto done; + } else if (is_tuple(BIF_ARG_1)) { + Uint prev = 0; + Eterm* tp = tuple_val(BIF_ARG_1); + switch (arityval(tp[0])) { + case 2: + if (ERTS_IS_ATOM_STR("process_locks", tp[1])) { + if (tp[2] == am_true) { + prev = erts_lcnt_set_rt_opt(ERTS_LCNT_OPT_PROCLOCK); + if (prev) res = am_true; + else res = am_false; + goto done; + } else if (tp[2] == am_false) { + prev = erts_lcnt_clear_rt_opt(ERTS_LCNT_OPT_PROCLOCK); + if (prev) res = am_true; + else res = am_false; + goto done; + } + } + break; + + default: + break; + } + } + + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); +#endif + BIF_ERROR(BIF_P, BADARG); +#ifdef ERTS_ENABLE_LOCK_COUNT +done: + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(res); +#endif +} + +void +erts_bif_info_init(void) +{ + erts_smp_atomic_init(&available_internal_state, 0); + erts_smp_atomic_init(&hipe_test_reschedule_flag, 0); + + process_info_init(); +} diff --git a/erts/emulator/beam/erl_bif_lists.c b/erts/emulator/beam/erl_bif_lists.c new file mode 100644 index 0000000000..a9e8dd86f7 --- /dev/null +++ b/erts/emulator/beam/erl_bif_lists.c @@ -0,0 +1,392 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * BIFs logically belonging to the lists module. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" + +static Eterm keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List); + +/* + * erlang:'++'/2 + */ + +Eterm +ebif_plusplus_2(Process* p, Eterm A, Eterm B) +{ + return append_2(p, A, B); +} + +/* + * erlang:'--'/2 + */ + +Eterm +ebif_minusminus_2(Process* p, Eterm A, Eterm B) +{ + return subtract_2(p, A, B); +} + +BIF_RETTYPE append_2(BIF_ALIST_2) +{ + Eterm list; + Eterm copy; + Eterm last; + size_t need; + Eterm* hp; + int i; + + if ((i = list_length(BIF_ARG_1)) < 0) { + BIF_ERROR(BIF_P, BADARG); + } + if (i == 0) { + BIF_RET(BIF_ARG_2); + } else if (is_nil(BIF_ARG_2)) { + BIF_RET(BIF_ARG_1); + } + + need = 2*i; + hp = HAlloc(BIF_P, need); + list = BIF_ARG_1; + copy = last = CONS(hp, CAR(list_val(list)), make_list(hp+2)); + list = CDR(list_val(list)); + hp += 2; + i--; + while(i--) { + Eterm* listp = list_val(list); + last = CONS(hp, CAR(listp), make_list(hp+2)); + list = CDR(listp); + hp += 2; + } + CDR(list_val(last)) = BIF_ARG_2; + BIF_RET(copy); +} + +BIF_RETTYPE subtract_2(BIF_ALIST_2) +{ + Eterm list; + Eterm* hp; + Uint need; + Eterm res; + Eterm small_vec[10]; /* Preallocated memory for small lists */ + Eterm* vec_p; + Eterm* vp; + int i; + int n; + int m; + + if ((n = list_length(BIF_ARG_1)) < 0) { + BIF_ERROR(BIF_P, BADARG); + } + if ((m = list_length(BIF_ARG_2)) < 0) { + BIF_ERROR(BIF_P, BADARG); + } + + if (n == 0) + BIF_RET(NIL); + if (m == 0) + BIF_RET(BIF_ARG_1); + + /* allocate element vector */ + if (n <= sizeof(small_vec)/sizeof(small_vec[0])) + vec_p = small_vec; + else + vec_p = (Eterm*) erts_alloc(ERTS_ALC_T_TMP, n * sizeof(Eterm)); + + /* PUT ALL ELEMENTS IN VP */ + vp = vec_p; + list = BIF_ARG_1; + i = n; + while(i--) { + Eterm* listp = list_val(list); + *vp++ = CAR(listp); + list = CDR(listp); + } + + /* UNMARK ALL DELETED CELLS */ + list = BIF_ARG_2; + m = 0; /* number of deleted elements */ + while(is_list(list)) { + Eterm* listp = list_val(list); + Eterm elem = CAR(listp); + i = n; + vp = vec_p; + while(i--) { + if (is_value(*vp) && eq(*vp, elem)) { + *vp = THE_NON_VALUE; + m++; + break; + } + vp++; + } + list = CDR(listp); + } + + if (m == n) /* All deleted ? */ + res = NIL; + else if (m == 0) /* None deleted ? */ + res = BIF_ARG_1; + else { /* REBUILD LIST */ + res = NIL; + need = 2*(n - m); + hp = HAlloc(BIF_P, need); + vp = vec_p + n - 1; + while(vp >= vec_p) { + if (is_value(*vp)) { + res = CONS(hp, *vp, res); + hp += 2; + } + vp--; + } + } + if (vec_p != small_vec) + erts_free(ERTS_ALC_T_TMP, (void *) vec_p); + BIF_RET(res); +} + +BIF_RETTYPE lists_member_2(BIF_ALIST_2) +{ + Eterm term; + Eterm list; + Eterm item; + int non_immed_key; + int max_iter = 10 * CONTEXT_REDS; + + if (is_nil(BIF_ARG_2)) { + BIF_RET(am_false); + } else if (is_not_list(BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + term = BIF_ARG_1; + non_immed_key = is_not_immed(term); + list = BIF_ARG_2; + while (is_list(list)) { + if (--max_iter < 0) { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_lists_member_2], BIF_P, term, list); + } + item = CAR(list_val(list)); + if ((item == term) || (non_immed_key && eq(item, term))) { + BIF_RET2(am_true, CONTEXT_REDS - max_iter/10); + } + list = CDR(list_val(list)); + } + if (is_not_nil(list)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET2(am_false, CONTEXT_REDS - max_iter/10); +} + +BIF_RETTYPE lists_reverse_2(BIF_ALIST_2) +{ + Eterm list; + Eterm tmp_list; + Eterm result; + Eterm* hp; + Uint n; + int max_iter; + + /* + * Handle legal and illegal non-lists quickly. + */ + if (is_nil(BIF_ARG_1)) { + BIF_RET(BIF_ARG_2); + } else if (is_not_list(BIF_ARG_1)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + + /* + * First use the rest of the remaning heap space. + */ + list = BIF_ARG_1; + result = BIF_ARG_2; + hp = HEAP_TOP(BIF_P); + n = HeapWordsLeft(BIF_P) / 2; + while (n != 0 && is_list(list)) { + Eterm* pair = list_val(list); + result = CONS(hp, CAR(pair), result); + list = CDR(pair); + hp += 2; + n--; + } + HEAP_TOP(BIF_P) = hp; + if (is_nil(list)) { + BIF_RET(result); + } + + /* + * Calculate length of remaining list (up to a suitable limit). + */ + max_iter = CONTEXT_REDS * 40; + n = 0; + tmp_list = list; + while (max_iter-- > 0 && is_list(tmp_list)) { + tmp_list = CDR(list_val(tmp_list)); + n++; + } + if (is_not_nil(tmp_list) && is_not_list(tmp_list)) { + goto error; + } + + /* + * Now do one HAlloc() and continue reversing. + */ + hp = HAlloc(BIF_P, 2*n); + while (n != 0 && is_list(list)) { + Eterm* pair = list_val(list); + result = CONS(hp, CAR(pair), result); + list = CDR(pair); + hp += 2; + n--; + } + if (is_nil(list)) { + BIF_RET(result); + } else { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP2(bif_export[BIF_lists_reverse_2], BIF_P, list, result); + } +} + +BIF_RETTYPE +lists_keymember_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +{ + Eterm res; + + res = keyfind(BIF_lists_keymember_3, p, Key, Pos, List); + if (is_value(res) && is_tuple(res)) { + return am_true; + } else { + return res; + } +} + +BIF_RETTYPE +lists_keysearch_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +{ + Eterm res; + + res = keyfind(BIF_lists_keysearch_3, p, Key, Pos, List); + if (is_non_value(res) || is_not_tuple(res)) { + return res; + } else { /* Tuple */ + Eterm* hp = HAlloc(p, 3); + return TUPLE2(hp, am_value, res); + } +} + +BIF_RETTYPE +lists_keyfind_3(Process* p, Eterm Key, Eterm Pos, Eterm List) +{ + return keyfind(BIF_lists_keyfind_3, p, Key, Pos, List); +} + +static Eterm +keyfind(int Bif, Process* p, Eterm Key, Eterm Pos, Eterm List) +{ + int max_iter = 10 * CONTEXT_REDS; + Sint pos; + Eterm term; + + if (!is_small(Pos) || (pos = signed_val(Pos)) < 1) { + BIF_ERROR(p, BADARG); + } + + if (is_small(Key)) { + double float_key = (double) signed_val(Key); + + while (is_list(List)) { + if (--max_iter < 0) { + BUMP_ALL_REDS(p); + BIF_TRAP3(bif_export[Bif], p, Key, Pos, List); + } + term = CAR(list_val(List)); + List = CDR(list_val(List)); + if (is_tuple(term)) { + Eterm *tuple_ptr = tuple_val(term); + if (pos <= arityval(*tuple_ptr)) { + Eterm element = tuple_ptr[pos]; + if (Key == element) { + return term; + } else if (is_float(element)) { + FloatDef f; + + GET_DOUBLE(element, f); + if (f.fd == float_key) { + return term; + } + } + } + } + } + } else if (is_immed(Key)) { + while (is_list(List)) { + if (--max_iter < 0) { + BUMP_ALL_REDS(p); + BIF_TRAP3(bif_export[Bif], p, Key, Pos, List); + } + term = CAR(list_val(List)); + List = CDR(list_val(List)); + if (is_tuple(term)) { + Eterm *tuple_ptr = tuple_val(term); + if (pos <= arityval(*tuple_ptr)) { + Eterm element = tuple_ptr[pos]; + if (Key == element) { + return term; + } + } + } + } + } else { + while (is_list(List)) { + if (--max_iter < 0) { + BUMP_ALL_REDS(p); + BIF_TRAP3(bif_export[Bif], p, Key, Pos, List); + } + term = CAR(list_val(List)); + List = CDR(list_val(List)); + if (is_tuple(term)) { + Eterm *tuple_ptr = tuple_val(term); + if (pos <= arityval(*tuple_ptr)) { + Eterm element = tuple_ptr[pos]; + if (cmp(Key, element) == 0) { + return term; + } + } + } + } + } + + if (is_not_nil(List)) { + BIF_ERROR(p, BADARG); + } + return am_false; +} diff --git a/erts/emulator/beam/erl_bif_op.c b/erts/emulator/beam/erl_bif_op.c new file mode 100644 index 0000000000..6da72dcef9 --- /dev/null +++ b/erts/emulator/beam/erl_bif_op.c @@ -0,0 +1,327 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Operator BIFs. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "big.h" +#include "dist.h" +#include "erl_version.h" +#include "erl_binary.h" + +BIF_RETTYPE and_2(BIF_ALIST_2) +{ + if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true) + BIF_RET(am_true); + else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false) + BIF_RET(am_false); + else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true) + BIF_RET(am_false); + else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false) + BIF_RET(am_false); + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE or_2(BIF_ALIST_2) +{ + if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true) + BIF_RET(am_true); + else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false) + BIF_RET(am_true); + else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true) + BIF_RET(am_true); + else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false) + BIF_RET(am_false); + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE xor_2(BIF_ALIST_2) +{ + if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_true) + BIF_RET(am_false); + else if (BIF_ARG_1 == am_true && BIF_ARG_2 == am_false) + BIF_RET(am_true); + else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_true) + BIF_RET(am_true); + else if (BIF_ARG_1 == am_false && BIF_ARG_2 == am_false) + BIF_RET(am_false); + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE not_1(BIF_ALIST_1) +{ + if (BIF_ARG_1 == am_true) + BIF_RET(am_false); + else if (BIF_ARG_1 == am_false) + BIF_RET(am_true); + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE sgt_2(BIF_ALIST_2) +{ + BIF_RET(cmp_gt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); +} + +BIF_RETTYPE sge_2(BIF_ALIST_2) +{ + BIF_RET(cmp_ge(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); +} + +BIF_RETTYPE slt_2(BIF_ALIST_2) +{ + BIF_RET(cmp_lt(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); +} + +BIF_RETTYPE sle_2(BIF_ALIST_2) +{ + BIF_RET(cmp_le(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); +} + +BIF_RETTYPE seq_2(BIF_ALIST_2) +{ + BIF_RET(eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); +} + +BIF_RETTYPE seqeq_2(BIF_ALIST_2) +{ + BIF_RET(cmp_eq(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); +} + +BIF_RETTYPE sneq_2(BIF_ALIST_2) +{ + BIF_RET(eq(BIF_ARG_1, BIF_ARG_2) ? am_false : am_true); +} + +BIF_RETTYPE sneqeq_2(BIF_ALIST_2) +{ + BIF_RET(cmp_ne(BIF_ARG_1, BIF_ARG_2) ? am_true : am_false); +} + +BIF_RETTYPE is_atom_1(BIF_ALIST_1) +{ + if (is_atom(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_float_1(BIF_ALIST_1) +{ + if (is_float(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_integer_1(BIF_ALIST_1) +{ + if (is_integer(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_list_1(BIF_ALIST_1) +{ + if (is_list(BIF_ARG_1) || is_nil(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_number_1(BIF_ALIST_1) +{ + if (is_number(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + + +BIF_RETTYPE is_pid_1(BIF_ALIST_1) +{ + if (is_pid(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_port_1(BIF_ALIST_1) +{ + if (is_port(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_reference_1(BIF_ALIST_1) +{ + if (is_ref(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_tuple_1(BIF_ALIST_1) +{ + if (is_tuple(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_binary_1(BIF_ALIST_1) +{ + if (is_binary(BIF_ARG_1) && binary_bitsize(BIF_ARG_1) == 0) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_bitstring_1(BIF_ALIST_1) +{ + if (is_binary(BIF_ARG_1)) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_function_1(BIF_ALIST_1) +{ + if (is_any_fun(BIF_ARG_1)) { + BIF_RET(am_true); + } else { + BIF_RET(am_false); + } +} + +BIF_RETTYPE is_function_2(BIF_ALIST_2) +{ + Sint arity; + + /* + * Verify argument 2 (arity); arity must be >= 0. + */ + if (is_small(BIF_ARG_2)) { + arity = signed_val(BIF_ARG_2); + if (arity < 0) { + error: + BIF_ERROR(BIF_P, BADARG); + } + } else if (is_big(BIF_ARG_2) && !bignum_header_is_neg(*big_val(BIF_ARG_2))) { + /* A positive bignum is OK, but can't possibly match. */ + arity = -1; + } else { + /* Everything else (including negative bignum) is an error. */ + goto error; + } + + if (is_fun(BIF_ARG_1)) { + ErlFunThing* funp = (ErlFunThing *) fun_val(BIF_ARG_1); + + if (funp->arity == (Uint) arity) { + BIF_RET(am_true); + } + } else if (is_export(BIF_ARG_1)) { + Export* exp = (Export *) (export_val(BIF_ARG_1))[1]; + + if (exp->code[2] == (Uint) arity) { + BIF_RET(am_true); + } + } else if (is_tuple(BIF_ARG_1)) { + Eterm* tp = tuple_val(BIF_ARG_1); + if (tp[0] == make_arityval(2) && is_atom(tp[1]) && is_atom(tp[2])) { + BIF_RET(am_true); + } + } + BIF_RET(am_false); +} + +BIF_RETTYPE is_boolean_1(BIF_ALIST_1) +{ + if (BIF_ARG_1 == am_true || BIF_ARG_1 == am_false) { + BIF_RET(am_true); + } else { + BIF_RET(am_false); + } +} + + + +/* + * The compiler usually translates calls to is_record/2 to more primitive + * operations. In some cases this is not possible. We'll need to implement + * a weak version of is_record/2 as BIF (the size of the record cannot + * be verified). + */ +BIF_RETTYPE is_record_2(BIF_ALIST_2) +{ + Eterm *t; + + if (is_not_atom(BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_tuple(BIF_ARG_1) && + arityval(*(t = tuple_val(BIF_ARG_1))) >= 1 && + t[1] == BIF_ARG_2) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + + +/* + * Record test cannot actually be a bif. The epp processor is involved in + * the real guard test, we have to add one more parameter, the + * return value of record_info(size, Rec), which is the arity of the TUPLE. + * his may seem awkward when applied from the shell, where the plain + * tuple test is more understandable, I think... + */ +BIF_RETTYPE is_record_3(BIF_ALIST_3) +{ + Eterm *t; + if (is_not_atom(BIF_ARG_2) || is_not_small(BIF_ARG_3)) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_tuple(BIF_ARG_1) && + arityval(*(t = tuple_val(BIF_ARG_1))) == signed_val(BIF_ARG_3) + && t[1] == BIF_ARG_2) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + + + + + diff --git a/erts/emulator/beam/erl_bif_os.c b/erts/emulator/beam/erl_bif_os.c new file mode 100644 index 0000000000..954b1f9729 --- /dev/null +++ b/erts/emulator/beam/erl_bif_os.c @@ -0,0 +1,190 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * BIFs belonging to the 'os' module. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "big.h" +#include "dist.h" +#include "erl_version.h" + +/* + * Return the pid for the Erlang process in the host OS. + */ + + /* return a timestamp */ +BIF_RETTYPE os_timestamp_0(BIF_ALIST_0) +{ + Uint megasec, sec, microsec; + Eterm* hp; + + get_sys_now(&megasec, &sec, µsec); + hp = HAlloc(BIF_P, 4); + BIF_RET(TUPLE3(hp, make_small(megasec), make_small(sec), + make_small(microsec))); +} + + +Eterm +os_getpid_0(Process* p) +{ + char pid_string[21]; /* enough for a 64 bit number */ + int n; + Eterm* hp; + sys_get_pid(pid_string); /* In sys.c */ + n = sys_strlen(pid_string); + hp = HAlloc(p, n*2); + BIF_RET(buf_to_intlist(&hp, pid_string, n, NIL)); +} + +Eterm +os_getenv_0(Process* p) +{ + GETENV_STATE state; + char *cp; + Eterm* hp; + Eterm ret; + Eterm str; + int len; + + init_getenv_state(&state); + + ret = NIL; + while ((cp = getenv_string(&state)) != NULL) { + len = strlen(cp); + hp = HAlloc(p, len*2+2); + str = buf_to_intlist(&hp, cp, len, NIL); + ret = CONS(hp, str, ret); + } + + fini_getenv_state(&state); + + return ret; +} + +Eterm +os_getenv_1(Process* p, Eterm key) +{ + Eterm str; + int len, res; + char *key_str, *val; + char buf[1024]; + size_t val_size = sizeof(buf); + + len = is_string(key); + if (!len) { + BIF_ERROR(p, BADARG); + } + /* Leave at least one byte in buf for value */ + key_str = len < sizeof(buf)-2 ? &buf[0] : erts_alloc(ERTS_ALC_T_TMP, len+1); + if (intlist_to_buf(key, key_str, len) != len) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + key_str[len] = '\0'; + + if (key_str != &buf[0]) + val = &buf[0]; + else { + val_size -= len + 1; + val = &buf[len + 1]; + } + res = erts_sys_getenv(key_str, val, &val_size); + + if (res < 0) { + no_var: + str = am_false; + } else { + Eterm* hp; + if (res > 0) { + val = erts_alloc(ERTS_ALC_T_TMP, val_size); + while (1) { + res = erts_sys_getenv(key_str, val, &val_size); + if (res == 0) + break; + else if (res < 0) + goto no_var; + else + val = erts_realloc(ERTS_ALC_T_TMP, val, val_size); + } + } + if (val_size) + hp = HAlloc(p, val_size*2); + str = buf_to_intlist(&hp, val, val_size, NIL); + } + if (key_str != &buf[0]) + erts_free(ERTS_ALC_T_TMP, key_str); + if (val < &buf[0] || &buf[sizeof(buf)-1] < val) + erts_free(ERTS_ALC_T_TMP, val); + BIF_RET(str); +} + +Eterm +os_putenv_2(Process* p, Eterm key, Eterm value) +{ + char def_buf[1024]; + char *buf = NULL; + int sep_ix, i, key_len, value_len, tot_len; + key_len = is_string(key); + if (!key_len) { + error: + if (buf) + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_ERROR(p, BADARG); + } + if (is_nil(value)) + value_len = 0; + else { + value_len = is_string(value); + if (!value_len) + goto error; + } + tot_len = key_len + 1 + value_len + 1; + if (tot_len <= sizeof(def_buf)) + buf = &def_buf[0]; + else + buf = erts_alloc(ERTS_ALC_T_TMP, tot_len); + i = intlist_to_buf(key, buf, key_len); + if (i != key_len) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + sep_ix = i; + buf[i++] = '='; + if (is_not_nil(value)) + i += intlist_to_buf(value, &buf[i], value_len); + if (i != key_len + 1 + value_len) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + buf[i] = '\0'; + if (erts_sys_putenv(buf, sep_ix)) { + goto error; + } + if (buf != &def_buf[0]) + erts_free(ERTS_ALC_T_TMP, (void *) buf); + BIF_RET(am_true); +} + diff --git a/erts/emulator/beam/erl_bif_port.c b/erts/emulator/beam/erl_bif_port.c new file mode 100644 index 0000000000..f454f2e12d --- /dev/null +++ b/erts/emulator/beam/erl_bif_port.c @@ -0,0 +1,1476 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef _OSE_ +# include "ose.h" +#endif + +#include + +#define ERTS_WANT_EXTERNAL_TAGS +#include "sys.h" +#include "erl_vm.h" +#include "erl_sys_driver.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "dist.h" +#include "erl_version.h" +#include "erl_binary.h" +#include "erl_db_util.h" +#include "register.h" +#include "external.h" +#include "packet_parser.h" +#include "erl_bits.h" + +static int open_port(Process* p, Eterm name, Eterm settings, int *err_nump); +static byte* convert_environment(Process* p, Eterm env); +static char **convert_args(Eterm); +static void free_args(char **); + +char *erts_default_arg0 = "default"; + +BIF_RETTYPE open_port_2(BIF_ALIST_2) +{ + int port_num; + Eterm port_val; + char *str; + int err_num; + + if ((port_num = open_port(BIF_P, BIF_ARG_1, BIF_ARG_2, &err_num)) < 0) { + if (port_num == -3) { + ASSERT(err_num == BADARG || err_num == SYSTEM_LIMIT); + BIF_ERROR(BIF_P, err_num); + } else if (port_num == -2) { + str = erl_errno_id(err_num); + } else { + str = "einval"; + } + BIF_P->fvalue = am_atom_put(str, strlen(str)); + BIF_ERROR(BIF_P, EXC_ERROR); + } + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + + port_val = erts_port[port_num].id; + erts_add_link(&(erts_port[port_num].nlinks), LINK_PID, BIF_P->id); + erts_add_link(&(BIF_P->nlinks), LINK_PID, port_val); + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + + erts_port_release(&erts_port[port_num]); + + BIF_RET(port_val); +} + +/**************************************************************************** + + PORT BIFS: + + port_command/2 -- replace Port ! {..., {command, Data}} + port_command(Port, Data) -> true + when port(Port), io-list(Data) + + port_control/3 -- new port_control(Port, Ctl, Data) -> Reply + port_control(Port, Ctl, Data) -> Reply + where integer(Ctl), io-list(Data), io-list(Reply) + + port_close/1 -- replace Port ! {..., close} + port_close(Port) -> true + when port(Port) + + port_connect/2 -- replace Port ! {..., {connect, Pid}} + port_connect(Port, Pid) + when port(Port), pid(Pid) + + ***************************************************************************/ + +static Port* +id_or_name2port(Process *c_p, Eterm id) +{ + Port *port; + if (is_not_atom(id)) + port = erts_id2port(id, c_p, ERTS_PROC_LOCK_MAIN); + else + erts_whereis_name(c_p, ERTS_PROC_LOCK_MAIN, id, NULL, 0, 0, &port); + return port; +} + +#define ERTS_PORT_COMMAND_FLAG_FORCE (((Uint32) 1) << 0) +#define ERTS_PORT_COMMAND_FLAG_NOSUSPEND (((Uint32) 1) << 1) + +static BIF_RETTYPE do_port_command(Process *BIF_P, + Eterm BIF_ARG_1, + Eterm BIF_ARG_2, + Eterm BIF_ARG_3, + Uint32 flags) +{ + BIF_RETTYPE res; + Port *p; + + /* Trace sched out before lock check wait */ + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_out); + } + + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_inactive); + } + + p = id_or_name2port(BIF_P, BIF_ARG_1); + if (!p) { + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_in); + } + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_active); + } + BIF_ERROR(BIF_P, BADARG); + } + + /* Trace port in, id_or_name2port causes wait */ + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(p, am_in, am_command); + } + if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { + profile_runnable_port(p, am_active); + } + + ERTS_BIF_PREP_RET(res, am_true); + + if ((flags & ERTS_PORT_COMMAND_FLAG_FORCE) + && !(p->drv_ptr->flags & ERL_DRV_FLAG_SOFT_BUSY)) { + ERTS_BIF_PREP_ERROR(res, BIF_P, EXC_NOTSUP); + } + else if (!(flags & ERTS_PORT_COMMAND_FLAG_FORCE) + && p->status & ERTS_PORT_SFLG_PORT_BUSY) { + if (flags & ERTS_PORT_COMMAND_FLAG_NOSUSPEND) { + ERTS_BIF_PREP_RET(res, am_false); + } + else { + erts_suspend(BIF_P, ERTS_PROC_LOCK_MAIN, p); + if (erts_system_monitor_flags.busy_port) { + monitor_generic(BIF_P, am_busy_port, p->id); + } + ERTS_BIF_PREP_YIELD3(res, bif_export[BIF_port_command_3], BIF_P, + BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + } + } else { + int wres; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + ERTS_SMP_CHK_NO_PROC_LOCKS; + wres = erts_write_to_port(BIF_P->id, p, BIF_ARG_2); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + if (wres != 0) { + ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); + } + } + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(p, am_out, am_command); + } + if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { + profile_runnable_port(p, am_inactive); + } + + erts_port_release(p); + /* Trace sched in after port release */ + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_in); + } + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_active); + } + + if (ERTS_PROC_IS_EXITING(BIF_P)) { + KILL_CATCHES(BIF_P); /* Must exit */ + ERTS_BIF_PREP_ERROR(res, BIF_P, EXC_ERROR); + } + return res; +} + +BIF_RETTYPE port_command_2(BIF_ALIST_2) +{ + return do_port_command(BIF_P, BIF_ARG_1, BIF_ARG_2, NIL, 0); +} + +BIF_RETTYPE port_command_3(BIF_ALIST_3) +{ + Eterm l = BIF_ARG_3; + Uint32 flags = 0; + while (is_list(l)) { + Eterm* cons = list_val(l); + Eterm car = CAR(cons); + if (car == am_force) { + flags |= ERTS_PORT_COMMAND_FLAG_FORCE; + } else if (car == am_nosuspend) { + flags |= ERTS_PORT_COMMAND_FLAG_NOSUSPEND; + } else { + BIF_ERROR(BIF_P, BADARG); + } + l = CDR(cons); + } + if(!is_nil(l)) { + BIF_ERROR(BIF_P, BADARG); + } + return do_port_command(BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3, flags); +} + +BIF_RETTYPE port_call_2(BIF_ALIST_2) +{ + return port_call_3(BIF_P,BIF_ARG_1,make_small(0),BIF_ARG_2); +} + +BIF_RETTYPE port_call_3(BIF_ALIST_3) +{ + Uint op; + Port *p; + Uint size; + byte *bytes; + byte *endp; + size_t real_size; + erts_driver_t *drv; + byte port_input[256]; /* Default input buffer to encode in */ + byte port_result[256]; /* Buffer for result from port. */ + byte* port_resp; /* Pointer to result buffer. */ + char *prc; + int ret; + Eterm res; + Sint result_size; + Eterm *hp; + Eterm *hp_end; /* To satisfy hybrid heap architecture */ + unsigned ret_flags = 0U; + int fpe_was_unmasked; + + bytes = &port_input[0]; + port_resp = port_result; + /* trace of port scheduling with virtual process descheduling + * lock wait + */ + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_out); + } + + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_inactive); + } + + p = id_or_name2port(BIF_P, BIF_ARG_1); + if (!p) { + error: + if (port_resp != port_result && + !(ret_flags & DRIVER_CALL_KEEP_BUFFER)) { + driver_free(port_resp); + } + if (bytes != &port_input[0]) + erts_free(ERTS_ALC_T_PORT_CALL_BUF, bytes); + /* Need to virtual schedule in the process if there + * was an error. + */ + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_in); + } + + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_active); + } + + if (p) + erts_port_release(p); +#ifdef ERTS_SMP + ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN); +#else + ERTS_BIF_CHK_EXITED(BIF_P); +#endif + BIF_ERROR(BIF_P, BADARG); + } + + if ((drv = p->drv_ptr) == NULL) { + goto error; + } + if (drv->call == NULL) { + goto error; + } + if (!term_to_Uint(BIF_ARG_2, &op)) { + goto error; + } + p->caller = BIF_P->id; + + /* Lock taken, virtual schedule of port */ + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(p, am_in, am_call); + } + + if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { + profile_runnable_port(p, am_active); + } + size = erts_encode_ext_size(BIF_ARG_3); + if (size > sizeof(port_input)) + bytes = erts_alloc(ERTS_ALC_T_PORT_CALL_BUF, size); + + endp = bytes; + erts_encode_ext(BIF_ARG_3, &endp); + + real_size = endp - bytes; + if (real_size > size) { + erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", + __FILE__, __LINE__, endp - (bytes + size)); + } + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + prc = (char *) port_resp; + fpe_was_unmasked = erts_block_fpe(); + ret = drv->call((ErlDrvData)p->drv_data, + (unsigned) op, + (char *) bytes, + (int) real_size, + &prc, + (int) sizeof(port_result), + &ret_flags); + erts_unblock_fpe(fpe_was_unmasked); + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(p, am_out, am_call); + } + + if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { + profile_runnable_port(p, am_inactive); + } + + port_resp = (byte *) prc; + p->caller = NIL; + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); +#ifdef HARDDEBUG + { + int z; + printf("real_size = %ld,%d, ret = %d\r\n",real_size, + (int) real_size, ret); + printf("["); + for(z = 0; z < real_size; ++z) { + printf("%d, ",(int) bytes[z]); + } + printf("]\r\n"); + printf("["); + for(z = 0; z < ret; ++z) { + printf("%d, ",(int) port_resp[z]); + } + printf("]\r\n"); + } +#endif + if (ret <= 0 || port_resp[0] != VERSION_MAGIC) { + /* Error or a binary without magic/ with wrong magic */ + goto error; + } + result_size = erts_decode_ext_size(port_resp, ret, 0); + if (result_size < 0) { + goto error; + } + hp = HAlloc(BIF_P, result_size); + hp_end = hp + result_size; + endp = port_resp; + res = erts_decode_ext(&hp, &MSO(BIF_P), &endp); + if (res == THE_NON_VALUE) { + goto error; + } + HRelease(BIF_P, hp_end, hp); + if (port_resp != port_result && !(ret_flags & DRIVER_CALL_KEEP_BUFFER)) { + driver_free(port_resp); + } + if (bytes != &port_input[0]) + erts_free(ERTS_ALC_T_PORT_CALL_BUF, bytes); + if (p) + erts_port_release(p); +#ifdef ERTS_SMP + ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN); +#else + ERTS_BIF_CHK_EXITED(BIF_P); +#endif + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_in); + } + + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_active); + } + + return res; +} + +BIF_RETTYPE port_control_3(BIF_ALIST_3) +{ + Port* p; + Uint op; + Eterm res = THE_NON_VALUE; + + /* Virtual schedule out calling process before lock wait */ + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_out); + } + + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_inactive); + } + + p = id_or_name2port(BIF_P, BIF_ARG_1); + if (!p) { + /* Schedule the process before exiting */ + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_in); + } + + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_active); + } + + BIF_ERROR(BIF_P, BADARG); + } + + /* Trace the port for scheduling in */ + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(p, am_in, am_control); + } + + if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { + profile_runnable_port(p, am_active); + } + + if (term_to_Uint(BIF_ARG_2, &op)) + res = erts_port_control(BIF_P, p, op, BIF_ARG_3); + + /* Trace the port for scheduling out */ + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(p, am_out, am_control); + } + + if (erts_system_profile_flags.runnable_ports && !erts_port_is_scheduled(p)) { + profile_runnable_port(p, am_inactive); + } + + erts_port_release(p); +#ifdef ERTS_SMP + ERTS_SMP_BIF_CHK_PENDING_EXIT(BIF_P, ERTS_PROC_LOCK_MAIN); +#else + ERTS_BIF_CHK_EXITED(BIF_P); +#endif + + if (IS_TRACED_FL(BIF_P, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(BIF_P, am_in); + } + + if (erts_system_profile_flags.runnable_procs && erts_system_profile_flags.exclusive) { + profile_runnable_proc(BIF_P, am_active); + } + + if (is_non_value(res)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(res); +} + +BIF_RETTYPE port_close_1(BIF_ALIST_1) +{ + Port* p; + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + p = id_or_name2port(NULL, BIF_ARG_1); + if (!p) { + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_ERROR(BIF_P, BADARG); + } + erts_do_exit_port(p, p->connected, am_normal); + /* if !ERTS_SMP: since we terminate port with reason normal + we SHOULD never get an exit signal ourselves + */ + erts_port_release(p); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(am_true); +} + +BIF_RETTYPE port_connect_2(BIF_ALIST_2) +{ + Port* prt; + Process* rp; + Eterm pid = BIF_ARG_2; + + if (is_not_internal_pid(pid)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + prt = id_or_name2port(BIF_P, BIF_ARG_1); + if (!prt) { + goto error; + } + + rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + pid, ERTS_PROC_LOCK_LINK); + if (!rp) { + erts_smp_port_unlock(prt); + ERTS_SMP_ASSERT_IS_NOT_EXITING(BIF_P); + goto error; + } + + erts_add_link(&(rp->nlinks), LINK_PID, prt->id); + erts_add_link(&(prt->nlinks), LINK_PID, pid); + + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + + prt->connected = pid; /* internal pid */ + erts_smp_port_unlock(prt); + BIF_RET(am_true); +} + +BIF_RETTYPE port_set_data_2(BIF_ALIST_2) +{ + Port* prt; + Eterm portid = BIF_ARG_1; + Eterm data = BIF_ARG_2; + + prt = id_or_name2port(BIF_P, portid); + if (!prt) { + BIF_ERROR(BIF_P, BADARG); + } + if (prt->bp != NULL) { + free_message_buffer(prt->bp); + prt->bp = NULL; + } + if (IS_CONST(data)) { + prt->data = data; + } else { + Uint size; + ErlHeapFragment* bp; + Eterm* hp; + + size = size_object(data); + prt->bp = bp = new_message_buffer(size); + hp = bp->mem; + prt->data = copy_struct(data, size, &hp, &bp->off_heap); + } + erts_smp_port_unlock(prt); + BIF_RET(am_true); +} + + +BIF_RETTYPE port_get_data_1(BIF_ALIST_1) +{ + BIF_RETTYPE res; + Port* prt; + Eterm portid = BIF_ARG_1; + + prt = id_or_name2port(BIF_P, portid); + if (!prt) { + BIF_ERROR(BIF_P, BADARG); + } + if (prt->bp == NULL) { /* MUST be CONST! */ + res = prt->data; + } else { + Eterm* hp = HAlloc(BIF_P, prt->bp->size); + res = copy_struct(prt->data, prt->bp->size, &hp, &MSO(BIF_P)); + } + erts_smp_port_unlock(prt); + BIF_RET(res); +} + +/* + * Open a port. Most of the work is not done here but rather in + * the file io.c. + * Error returns: -1 or -2 returned from open_driver (-2 implies + * that *err_nump contains the error code; -1 means we don't really know what happened), + * -3 if argument parsing failed or we are out of ports (*err_nump should contain + * either BADARG or SYSTEM_LIMIT). + */ + +static int +open_port(Process* p, Eterm name, Eterm settings, int *err_nump) +{ +#define OPEN_PORT_ERROR(VAL) do { port_num = (VAL); goto do_return; } while (0) + int i, port_num; + Eterm option; + Uint arity; + Eterm* tp; + Uint* nargs; + erts_driver_t* driver; + char* name_buf = NULL; + SysDriverOpts opts; + int binary_io; + int soft_eof; + Sint linebuf; + byte dir[MAXPATHLEN]; + + /* These are the defaults */ + opts.packet_bytes = 0; + opts.use_stdio = 1; + opts.redir_stderr = 0; + opts.read_write = 0; + opts.hide_window = 0; + opts.wd = NULL; + opts.envir = NULL; + opts.exit_status = 0; + opts.overlapped_io = 0; + opts.spawn_type = ERTS_SPAWN_ANY; + opts.argv = NULL; + binary_io = 0; + soft_eof = 0; + linebuf = 0; + + *err_nump = 0; + + if (is_not_list(settings) && is_not_nil(settings)) { + goto badarg; + } + /* + * Parse the settings. + */ + + if (is_not_nil(settings)) { + nargs = list_val(settings); + while (1) { + if (is_tuple_arity(*nargs, 2)) { + tp = tuple_val(*nargs); + arity = *tp++; + option = *tp++; + if (option == am_packet) { + if (is_not_small(*tp)) { + goto badarg; + } + opts.packet_bytes = signed_val(*tp); + switch (opts.packet_bytes) { + case 1: + case 2: + case 4: + break; + default: + goto badarg; + } + } else if (option == am_line) { + if (is_not_small(*tp)) { + goto badarg; + } + linebuf = signed_val(*tp); + if (linebuf <= 0) { + goto badarg; + } + } else if (option == am_env) { + byte* bytes; + if ((bytes = convert_environment(p, *tp)) == NULL) { + goto badarg; + } + opts.envir = (char *) bytes; + } else if (option == am_args) { + char **av; + char **oav = opts.argv; + if ((av = convert_args(*tp)) == NULL) { + goto badarg; + } + opts.argv = av; + if (oav) { + opts.argv[0] = oav[0]; + oav[0] = erts_default_arg0; + free_args(oav); + } + + } else if (option == am_arg0) { + char *a0; + int n; + if (is_nil(*tp)) { + n = 0; + } else if( (n = is_string(*tp)) == 0) { + goto badarg; + } + a0 = (char *) erts_alloc(ERTS_ALC_T_TMP, + (n + 1) * sizeof(byte)); + if (intlist_to_buf(*tp, a0, n) != n) { + erl_exit(1, "%s:%d: Internal error\n", + __FILE__, __LINE__); + } + a0[n] = '\0'; + if (opts.argv == NULL) { + opts.argv = erts_alloc(ERTS_ALC_T_TMP, + 2 * sizeof(char **)); + opts.argv[0] = a0; + opts.argv[1] = NULL; + } else { + if (opts.argv[0] != erts_default_arg0) { + erts_free(ERTS_ALC_T_TMP, opts.argv[0]); + } + opts.argv[0] = a0; + } + } else if (option == am_cd) { + Eterm iolist; + Eterm heap[4]; + int r; + + heap[0] = *tp; + heap[1] = make_list(heap+2); + heap[2] = make_small(0); + heap[3] = NIL; + iolist = make_list(heap); + r = io_list_to_buf(iolist, (char*) dir, MAXPATHLEN); + if (r < 0) { + goto badarg; + } + opts.wd = (char *) dir; + } else { + goto badarg; + } + } else if (*nargs == am_stream) { + opts.packet_bytes = 0; + } else if (*nargs == am_use_stdio) { + opts.use_stdio = 1; + } else if (*nargs == am_stderr_to_stdout) { + opts.redir_stderr = 1; + } else if (*nargs == am_line) { + linebuf = 512; + } else if (*nargs == am_nouse_stdio) { + opts.use_stdio = 0; + } else if (*nargs == am_binary) { + binary_io = 1; + } else if (*nargs == am_in) { + opts.read_write |= DO_READ; + } else if (*nargs == am_out) { + opts.read_write |= DO_WRITE; + } else if (*nargs == am_eof) { + soft_eof = 1; + } else if (*nargs == am_hide) { + opts.hide_window = 1; + } else if (*nargs == am_exit_status) { + opts.exit_status = 1; + } else if (*nargs == am_overlapped_io) { + opts.overlapped_io = 1; + } else { + goto badarg; + } + if (is_nil(*++nargs)) + break; + if (is_not_list(*nargs)) { + goto badarg; + } + nargs = list_val(*nargs); + } + } + if (opts.read_write == 0) /* implement default */ + opts.read_write = DO_READ|DO_WRITE; + + /* Mutually exclusive arguments. */ + if((linebuf && opts.packet_bytes) || + (opts.redir_stderr && !opts.use_stdio)) { + goto badarg; + } + + /* + * Parse the first argument and start the appropriate driver. + */ + + if (is_atom(name) || (i = is_string(name))) { + /* a vanilla port */ + if (is_atom(name)) { + name_buf = (char *) erts_alloc(ERTS_ALC_T_TMP, + atom_tab(atom_val(name))->len+1); + sys_memcpy((void *) name_buf, + (void *) atom_tab(atom_val(name))->name, + atom_tab(atom_val(name))->len); + name_buf[atom_tab(atom_val(name))->len] = '\0'; + } else { + name_buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); + if (intlist_to_buf(name, name_buf, i) != i) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + name_buf[i] = '\0'; + } + driver = &vanilla_driver; + } else { + if (is_not_tuple(name)) { + goto badarg; /* Not a process or fd port */ + } + tp = tuple_val(name); + arity = *tp++; + + if (arity == make_arityval(0)) { + goto badarg; + } + + if (*tp == am_spawn || *tp == am_spawn_driver) { /* A process port */ + if (arity != make_arityval(2)) { + goto badarg; + } + name = tp[1]; + if (is_atom(name)) { + name_buf = (char *) erts_alloc(ERTS_ALC_T_TMP, + atom_tab(atom_val(name))->len+1); + sys_memcpy((void *) name_buf, + (void *) atom_tab(atom_val(name))->name, + atom_tab(atom_val(name))->len); + name_buf[atom_tab(atom_val(name))->len] = '\0'; + } else if ((i = is_string(name))) { + name_buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); + if (intlist_to_buf(name, name_buf, i) != i) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + name_buf[i] = '\0'; + } else { + goto badarg; + } + if (*tp == am_spawn_driver) { + opts.spawn_type = ERTS_SPAWN_DRIVER; + } + driver = &spawn_driver; + } else if (*tp == am_spawn_executable) { /* A program */ + /* + * {spawn_executable,Progname} + */ + + if (arity != make_arityval(2)) { + goto badarg; + } + name = tp[1]; + if (is_atom(name)) { + name_buf = (char *) erts_alloc(ERTS_ALC_T_TMP, + atom_tab(atom_val(name))->len+1); + sys_memcpy((void *) name_buf, + (void *) atom_tab(atom_val(name))->name, + atom_tab(atom_val(name))->len); + name_buf[atom_tab(atom_val(name))->len] = '\0'; + } else if ((i = is_string(name))) { + name_buf = (char *) erts_alloc(ERTS_ALC_T_TMP, i + 1); + if (intlist_to_buf(name, name_buf, i) != i) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + name_buf[i] = '\0'; + } else { + goto badarg; + } + opts.spawn_type = ERTS_SPAWN_EXECUTABLE; + driver = &spawn_driver; + } else if (*tp == am_fd) { /* An fd port */ + int n; + struct Sint_buf sbuf; + char* p; + + if (arity != make_arityval(3)) { + goto badarg; + } + if (is_not_small(tp[1]) || is_not_small(tp[2])) { + goto badarg; + } + opts.ifd = unsigned_val(tp[1]); + opts.ofd = unsigned_val(tp[2]); + + /* Syntesize name from input and output descriptor. */ + name_buf = erts_alloc(ERTS_ALC_T_TMP, + 2*sizeof(struct Sint_buf) + 2); + p = Sint_to_buf(opts.ifd, &sbuf); + n = sys_strlen(p); + sys_strncpy(name_buf, p, n); + name_buf[n] = '/'; + p = Sint_to_buf(opts.ofd, &sbuf); + sys_strcpy(name_buf+n+1, p); + + driver = &fd_driver; + } else { + goto badarg; + } + } + + if ((driver != &spawn_driver && opts.argv != NULL) || + (driver == &spawn_driver && + opts.spawn_type != ERTS_SPAWN_EXECUTABLE && + opts.argv != NULL)) { + /* Argument vector only if explicit spawn_executable */ + goto badarg; + } + + + if (driver != &spawn_driver && opts.exit_status) { + goto badarg; + } + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_out); + } + + + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + + port_num = erts_open_driver(driver, p->id, name_buf, &opts, err_nump); + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + + if (port_num < 0) { + DEBUGF(("open_driver returned %d(%d)\n", port_num, *err_nump)); + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_in); + } + OPEN_PORT_ERROR(port_num); + } + + if (IS_TRACED_FL(p, F_TRACE_SCHED_PROCS)) { + trace_virtual_sched(p, am_in); + } + + if (binary_io) { + erts_port_status_bor_set(&erts_port[port_num], + ERTS_PORT_SFLG_BINARY_IO); + } + if (soft_eof) { + erts_port_status_bor_set(&erts_port[port_num], + ERTS_PORT_SFLG_SOFT_EOF); + } + if (linebuf && erts_port[port_num].linebuf == NULL){ + erts_port[port_num].linebuf = allocate_linebuf(linebuf); + erts_port_status_bor_set(&erts_port[port_num], + ERTS_PORT_SFLG_LINEBUF_IO); + } + + do_return: + if (name_buf) + erts_free(ERTS_ALC_T_TMP, (void *) name_buf); + if (opts.argv) { + free_args(opts.argv); + } + return port_num; + + badarg: + *err_nump = BADARG; + OPEN_PORT_ERROR(-3); + goto do_return; +#undef OPEN_PORT_ERROR +} + +static char **convert_args(Eterm l) +{ + char **pp; + char *b; + int n; + int i = 0; + Eterm str; + /* We require at least one element in list (argv[0]) */ + if (is_not_list(l) && is_not_nil(l)) { + return NULL; + } + n = list_length(l); + pp = erts_alloc(ERTS_ALC_T_TMP, (n + 2) * sizeof(char **)); + pp[i++] = erts_default_arg0; + while (is_list(l)) { + str = CAR(list_val(l)); + + if (is_nil(str)) { + n = 0; + } else if( (n = is_string(str)) == 0) { + /* Not a string... */ + int j; + for (j = 1; j < i; ++j) + erts_free(ERTS_ALC_T_TMP, pp[j]); + erts_free(ERTS_ALC_T_TMP, pp); + return NULL; + } + b = (char *) erts_alloc(ERTS_ALC_T_TMP, (n + 1) * sizeof(byte)); + pp[i++] = (char *) b; + if (intlist_to_buf(str, b, n) != n) + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + b[n] = '\0'; + l = CDR(list_val(l)); + } + pp[i] = NULL; + return pp; +} + +static void free_args(char **av) +{ + int i; + if (av == NULL) + return; + for (i = 0; av[i] != NULL; ++i) { + if (av[i] != erts_default_arg0) { + erts_free(ERTS_ALC_T_TMP, av[i]); + } + } + erts_free(ERTS_ALC_T_TMP, av); +} + + +static byte* convert_environment(Process* p, Eterm env) +{ + Eterm all; + Eterm* temp_heap; + Eterm* hp; + Uint heap_size; + int n; + byte* bytes; + + if ((n = list_length(env)) < 0) { + return NULL; + } + heap_size = 2*(5*n+1); + temp_heap = hp = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, heap_size*sizeof(Eterm)); + bytes = NULL; /* Indicating error */ + + /* + * All errors below are handled by jumping to 'done', to ensure that the memory + * gets deallocated. Do NOT return directly from this function. + */ + + all = CONS(hp, make_small(0), NIL); + hp += 2; + + while(is_list(env)) { + Eterm tmp; + Eterm* tp; + + tmp = CAR(list_val(env)); + if (is_not_tuple_arity(tmp, 2)) { + goto done; + } + tp = tuple_val(tmp); + tmp = CONS(hp, make_small(0), NIL); + hp += 2; + if (tp[2] != am_false) { + tmp = CONS(hp, tp[2], tmp); + hp += 2; + } + tmp = CONS(hp, make_small('='), tmp); + hp += 2; + tmp = CONS(hp, tp[1], tmp); + hp += 2; + all = CONS(hp, tmp, all); + hp += 2; + env = CDR(list_val(env)); + } + if (is_not_nil(env)) { + goto done; + } + if ((n = io_list_len(all)) < 0) { + goto done; + } + + /* + * Put the result in a binary (no risk for a memory leak that way). + */ + (void) erts_new_heap_binary(p, NULL, n, &bytes); + io_list_to_buf(all, (char*)bytes, n); + + done: + erts_free(ERTS_ALC_T_TMP, temp_heap); + return bytes; +} + +/* ------------ decode_packet() and friends: */ + +struct packet_callback_args +{ + Process* p; /* In */ + Eterm res; /* Out */ + int string_as_bin; /* return strings as binaries (http_bin): */ + byte* aligned_ptr; + Eterm orig; + Uint bin_offs; + byte bin_bitoffs; +}; + +static Eterm +http_bld_string(struct packet_callback_args* pca, Uint **hpp, Uint *szp, + const char *str, Sint len) +{ + Eterm res = THE_NON_VALUE; + Uint size; + + if (pca->string_as_bin) { + size = heap_bin_size(len); + + if (szp) { + *szp += (size > ERL_SUB_BIN_SIZE) ? ERL_SUB_BIN_SIZE : size; + } + if (hpp) { + res = make_binary(*hpp); + if (size > ERL_SUB_BIN_SIZE) { + ErlSubBin* bin = (ErlSubBin*) *hpp; + bin->thing_word = HEADER_SUB_BIN; + bin->size = len; + bin->offs = pca->bin_offs + ((byte*)str - pca->aligned_ptr); + bin->orig = pca->orig; + bin->bitoffs = pca->bin_bitoffs; + bin->bitsize = 0; + bin->is_writable = 0; + *hpp += ERL_SUB_BIN_SIZE; + } + else { + ErlHeapBin* bin = (ErlHeapBin*) *hpp; + bin->thing_word = header_heap_bin(len); + bin->size = len; + memcpy(bin->data, str, len); + *hpp += size; + } + } + } + else { + res = erts_bld_string_n(hpp, szp, str, len); + } + return res; +} + +static int http_response_erl(void *arg, int major, int minor, + int status, const char* phrase, int phrase_len) +{ + /* {http_response,{Major,Minor},Status,"Phrase"} */ + struct packet_callback_args* pca = (struct packet_callback_args*) arg; + Eterm phrase_term, ver; + Uint hsize = 3 + 5; + Eterm* hp; +#ifdef DEBUG + Eterm* hend; +#endif + + http_bld_string(pca, NULL, &hsize, phrase, phrase_len); + hp = HAlloc(pca->p, hsize); +#ifdef DEBUG + hend = hp + hsize; +#endif + phrase_term = http_bld_string(pca, &hp, NULL, phrase, phrase_len); + ver = TUPLE2(hp, make_small(major), make_small(minor)); + hp += 3; + pca->res = TUPLE4(hp, am_http_response, ver, make_small(status), phrase_term); + ASSERT(hp+5==hend); + return 1; +} + +static Eterm http_bld_uri(struct packet_callback_args* pca, + Eterm** hpp, Uint* szp, const PacketHttpURI* uri) +{ + Eterm s1, s2; + if (uri->type == URI_STAR) { + return am_Times; /* '*' */ + } + + s1 = http_bld_string(pca, hpp, szp, uri->s1_ptr, uri->s1_len); + + switch (uri->type) { + case URI_ABS_PATH: + return erts_bld_tuple(hpp, szp, 2, am_abs_path, s1); + case URI_HTTP: + case URI_HTTPS: + s2 = http_bld_string(pca, hpp, szp, uri->s2_ptr, uri->s2_len); + return erts_bld_tuple + (hpp, szp, 5, am_absoluteURI, + ((uri->type==URI_HTTP) ? am_http : am_https), + s1, + ((uri->port==0) ? am_undefined : make_small(uri->port)), + s2); + + case URI_STRING: + return s1; + case URI_SCHEME: + s2 = http_bld_string(pca, hpp, szp, uri->s2_ptr, uri->s2_len); + return erts_bld_tuple(hpp, szp, 3, am_scheme, s1, s2); + + default: + erl_exit(1, "%s, line %d: type=%u\n", __FILE__, __LINE__, uri->type); + } +} + +static int http_request_erl(void* arg, const http_atom_t* meth, + const char* meth_ptr, int meth_len, + const PacketHttpURI* uri, int major, int minor) +{ + struct packet_callback_args* pca = (struct packet_callback_args*) arg; + Eterm meth_term, uri_term, ver_term; + Uint sz = 0; + Uint* szp = &sz; + Eterm* hp; + Eterm** hpp = NULL; + + /* {http_request,Meth,Uri,Version} */ + + for (;;) { + meth_term = (meth!=NULL) ? meth->atom : + http_bld_string(pca, hpp, szp, meth_ptr, meth_len); + uri_term = http_bld_uri(pca, hpp, szp, uri); + ver_term = erts_bld_tuple(hpp, szp, 2, + make_small(major), make_small(minor)); + pca->res = erts_bld_tuple(hpp, szp, 4, am_http_request, meth_term, + uri_term, ver_term); + if (hpp != NULL) break; + hpp = &hp; + hp = HAlloc(pca->p, sz); + szp = NULL; + } + return 1; +} + +static int +http_header_erl(void* arg, const http_atom_t* name, const char* name_ptr, + int name_len, const char* value_ptr, int value_len) +{ + struct packet_callback_args* pca = (struct packet_callback_args*) arg; + Eterm bit_term, name_term, val_term; + Uint sz = 6; + Eterm* hp; +#ifdef DEBUG + Eterm* hend; +#endif + + /* {http_header,Bit,Name,IValue,Value} */ + + if (name == NULL) { + http_bld_string(pca, NULL, &sz, name_ptr, name_len); + } + http_bld_string(pca, NULL, &sz, value_ptr, value_len); + + hp = HAlloc(pca->p, sz); +#ifdef DEBUG + hend = hp + sz; +#endif + + if (name != NULL) { + bit_term = make_small(name->index+1); + name_term = name->atom; + } + else { + bit_term = make_small(0); + name_term = http_bld_string(pca, &hp,NULL,name_ptr,name_len); + } + + val_term = http_bld_string(pca, &hp, NULL, value_ptr, value_len); + pca->res = TUPLE5(hp, am_http_header, bit_term, name_term, am_undefined, val_term); + ASSERT(hp+6==hend); + return 1; +} + +static int http_eoh_erl(void* arg) +{ + /* http_eoh */ + struct packet_callback_args* pca = (struct packet_callback_args*) arg; + pca->res = am_http_eoh; + return 1; +} + +static int http_error_erl(void* arg, const char* buf, int len) +{ + /* {http_error,Line} */ + struct packet_callback_args* pca = (struct packet_callback_args*) arg; + Uint sz = 3; + Eterm* hp; +#ifdef DEBUG + Eterm* hend; +#endif + + http_bld_string(pca, NULL, &sz, buf, len); + + hp = HAlloc(pca->p, sz); +#ifdef DEBUG + hend = hp + sz; +#endif + pca->res = erts_bld_tuple(&hp, NULL, 2, am_http_error, + http_bld_string(pca, &hp, NULL, buf, len)); + ASSERT(hp==hend); + return 1; +} + +static +int ssl_tls_erl(void* arg, unsigned type, unsigned major, unsigned minor, + const char* buf, int len, const char* prefix, int plen) +{ + struct packet_callback_args* pca = (struct packet_callback_args*) arg; + Eterm* hp; + Eterm ver; + Eterm bin = new_binary(pca->p, NULL, plen+len); + byte* bin_ptr = binary_bytes(bin); + + memcpy(bin_ptr+plen, buf, len); + if (plen) { + memcpy(bin_ptr, prefix, plen); + } + + /* {ssl_tls,NIL,ContentType,{Major,Minor},Bin} */ + hp = HAlloc(pca->p, 3+6); + ver = TUPLE2(hp, make_small(major), make_small(minor)); + hp += 3; + pca->res = TUPLE5(hp, am_ssl_tls, NIL, make_small(type), ver, bin); + return 1; +} + + +PacketCallbacks packet_callbacks_erl = { + http_response_erl, + http_request_erl, + http_eoh_erl, + http_header_erl, + http_error_erl, + ssl_tls_erl +}; + +/* + decode_packet(Type,Bin,Options) + Returns: + {ok, PacketBodyBin, RestBin} + {more, PacketSz | undefined} + {error, invalid} +*/ +BIF_RETTYPE decode_packet_3(BIF_ALIST_3) +{ + unsigned max_plen = 0; /* Packet max length, 0=no limit */ + unsigned trunc_len = 0; /* Truncate lines if longer, 0=no limit */ + int http_state = 0; /* 0=request/response 1=header */ + int packet_sz; /*-------Binaries involved: ------------------*/ + byte* bin_ptr; /*| orig: original binary */ + byte bin_bitsz; /*| bin: BIF_ARG_2, may be sub-binary of orig */ + Uint bin_sz; /*| packet: prefix of bin */ + char* body_ptr; /*| body: part of packet to return */ + int body_sz; /*| rest: bin without packet */ + struct packet_callback_args pca; + enum PacketParseType type; + Eterm* hp; + Eterm* hend; + ErlSubBin* rest; + Eterm res; + Eterm options; + int code; + + if (!is_binary(BIF_ARG_2) || + (!is_list(BIF_ARG_3) && !is_nil(BIF_ARG_3))) { + BIF_ERROR(BIF_P, BADARG); + } + switch (BIF_ARG_1) { + case make_small(0): case am_raw: type = TCP_PB_RAW; break; + case make_small(1): type = TCP_PB_1; break; + case make_small(2): type = TCP_PB_2; break; + case make_small(4): type = TCP_PB_4; break; + case am_asn1: type = TCP_PB_ASN1; break; + case am_sunrm: type = TCP_PB_RM; break; + case am_cdr: type = TCP_PB_CDR; break; + case am_fcgi: type = TCP_PB_FCGI; break; + case am_line: type = TCP_PB_LINE_LF; break; + case am_tpkt: type = TCP_PB_TPKT; break; + case am_http: type = TCP_PB_HTTP; break; + case am_httph: type = TCP_PB_HTTPH; break; + case am_http_bin: type = TCP_PB_HTTP_BIN; break; + case am_httph_bin: type = TCP_PB_HTTPH_BIN; break; + case am_ssl_tls: type = TCP_PB_SSL_TLS; break; + default: + BIF_ERROR(BIF_P, BADARG); + } + + options = BIF_ARG_3; + while (!is_nil(options)) { + Eterm* cons = list_val(options); + if (is_tuple(CAR(cons))) { + Eterm* tpl = tuple_val(CAR(cons)); + Uint val; + if (tpl[0] == make_arityval(2) && + term_to_Uint(tpl[2],&val) && val <= UINT_MAX) { + switch (tpl[1]) { + case am_packet_size: + max_plen = val; + goto next_option; + case am_line_length: + trunc_len = val; + goto next_option; + } + } + } + BIF_ERROR(BIF_P, BADARG); + + next_option: + options = CDR(cons); + } + + + bin_sz = binary_size(BIF_ARG_2); + ERTS_GET_BINARY_BYTES(BIF_ARG_2, bin_ptr, pca.bin_bitoffs, bin_bitsz); + if (pca.bin_bitoffs != 0) { + pca.aligned_ptr = erts_alloc(ERTS_ALC_T_TMP, bin_sz); + erts_copy_bits(bin_ptr, pca.bin_bitoffs, 1, pca.aligned_ptr, 0, 1, bin_sz*8); + } + else { + pca.aligned_ptr = bin_ptr; + } + packet_sz = packet_get_length(type, (char*)pca.aligned_ptr, bin_sz, + max_plen, trunc_len, &http_state); + if (!(packet_sz > 0 && packet_sz <= bin_sz)) { + if (packet_sz < 0) { + goto error; + } + else { /* not enough data */ + Eterm plen = (packet_sz==0) ? am_undefined : + erts_make_integer(packet_sz, BIF_P); + Eterm* hp = HAlloc(BIF_P,3); + res = TUPLE2(hp, am_more, plen); + goto done; + } + } + /* We got a whole packet */ + + body_ptr = (char*) pca.aligned_ptr; + body_sz = packet_sz; + packet_get_body(type, (const char**) &body_ptr, &body_sz); + + ERTS_GET_REAL_BIN(BIF_ARG_2, pca.orig, pca.bin_offs, pca.bin_bitoffs, bin_bitsz); + pca.p = BIF_P; + pca.res = THE_NON_VALUE; + pca.string_as_bin = (type == TCP_PB_HTTP_BIN || type == TCP_PB_HTTPH_BIN); + code = packet_parse(type, (char*)pca.aligned_ptr, packet_sz, &http_state, + &packet_callbacks_erl, &pca); + if (code == 0) { /* no special packet parsing, make plain binary */ + ErlSubBin* body; + Uint hsz = 2*ERL_SUB_BIN_SIZE + 4; + hp = HAlloc(BIF_P, hsz); + hend = hp + hsz; + + body = (ErlSubBin *) hp; + body->thing_word = HEADER_SUB_BIN; + body->size = body_sz; + body->offs = pca.bin_offs + (body_ptr - (char*)pca.aligned_ptr); + body->orig = pca.orig; + body->bitoffs = pca.bin_bitoffs; + body->bitsize = 0; + body->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + pca.res = make_binary(body); + } + else if (code > 0) { + Uint hsz = ERL_SUB_BIN_SIZE + 4; + ASSERT(pca.res != THE_NON_VALUE); + hp = HAlloc(BIF_P, hsz); + hend = hp + hsz; + } + else { +error: + hp = HAlloc(BIF_P,3); + res = TUPLE2(hp, am_error, am_invalid); + goto done; + } + + rest = (ErlSubBin *) hp; + rest->thing_word = HEADER_SUB_BIN; + rest->size = bin_sz - packet_sz; + rest->offs = pca.bin_offs + packet_sz; + rest->orig = pca.orig; + rest->bitoffs = pca.bin_bitoffs; + rest->bitsize = bin_bitsz; /* The extra bits go into the rest. */ + rest->is_writable = 0; + hp += ERL_SUB_BIN_SIZE; + res = TUPLE3(hp, am_ok, pca.res, make_binary(rest)); + hp += 4; + ASSERT(hp==hend); (void)hend; + +done: + if (pca.aligned_ptr != bin_ptr) { + erts_free(ERTS_ALC_T_TMP, pca.aligned_ptr); + } + BIF_RET(res); +} + diff --git a/erts/emulator/beam/erl_bif_re.c b/erts/emulator/beam/erl_bif_re.c new file mode 100644 index 0000000000..16abab65b0 --- /dev/null +++ b/erts/emulator/beam/erl_bif_re.c @@ -0,0 +1,1142 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "erl_binary.h" +#include "big.h" +#define ERLANG_INTEGRATION 1 +#define PCRE_STATIC +#include "pcre.h" + +#define PCRE_DEFAULT_COMPILE_OPTS 0 +#define PCRE_DEFAULT_EXEC_OPTS 0 +#define LOOP_FACTOR 10 + + +static const unsigned char *default_table; +static Uint max_loop_limit; +static Export re_exec_trap_export; +static Export *grun_trap_exportp = NULL; +static Export *urun_trap_exportp = NULL; +static Export *ucompile_trap_exportp = NULL; + +static BIF_RETTYPE re_exec_trap(BIF_ALIST_3); + +static void *erts_erts_pcre_malloc(size_t size) { + return erts_alloc(ERTS_ALC_T_RE_HEAP,size); +} + +static void erts_erts_pcre_free(void *ptr) { + erts_free(ERTS_ALC_T_RE_HEAP,ptr); +} + +static void *erts_erts_pcre_stack_malloc(size_t size) { + return erts_alloc(ERTS_ALC_T_RE_STACK,size); +} + +static void erts_erts_pcre_stack_free(void *ptr) { + erts_free(ERTS_ALC_T_RE_STACK,ptr); +} + +void erts_init_bif_re(void) +{ + erts_pcre_malloc = &erts_erts_pcre_malloc; + erts_pcre_free = &erts_erts_pcre_free; + erts_pcre_stack_malloc = &erts_erts_pcre_stack_malloc; + erts_pcre_stack_free = &erts_erts_pcre_stack_free; + default_table = NULL; /* ISO8859-1 default, forced into pcre */ + max_loop_limit = CONTEXT_REDS * LOOP_FACTOR; + + sys_memset((void *) &re_exec_trap_export, 0, sizeof(Export)); + re_exec_trap_export.address = &re_exec_trap_export.code[3]; + re_exec_trap_export.code[0] = am_erlang; + re_exec_trap_export.code[1] = am_re_run_trap; + re_exec_trap_export.code[2] = 3; + re_exec_trap_export.code[3] = (Eterm) em_apply_bif; + re_exec_trap_export.code[4] = (Eterm) &re_exec_trap; + + grun_trap_exportp = erts_export_put(am_re,am_grun,3); + urun_trap_exportp = erts_export_put(am_re,am_urun,3); + ucompile_trap_exportp = erts_export_put(am_re,am_ucompile,2); + + return; +} + +Sint erts_re_set_loop_limit(Sint limit) +{ + Sint save = (Sint) max_loop_limit; + if (limit <= 0) { + max_loop_limit = CONTEXT_REDS * LOOP_FACTOR; + } else { + max_loop_limit = (Uint) limit; + } + return save; +} + +/* + * Deal with plain int's and so on for the library interface + */ + +static int term_to_int(Eterm term, int *sp) +{ +#ifdef ARCH_64 + + if (is_small(term)) { + Uint x = signed_val(term); + if (x > INT_MAX) { + return 0; + } + *sp = (int) x; + return 1; + } + return 0; + +#else + + if (is_small(term)) { + *sp = signed_val(term); + return 1; + } else if (is_big(term)) { + ErtsDigit* xr = big_v(term); + dsize_t xl = big_size(term); + int sign = big_sign(term); + unsigned uval = 0; + int n = 0; + + if (xl*D_EXP > sizeof(unsigned)*8) { + return 0; + } + while (xl-- > 0) { + uval |= ((unsigned)(*xr++)) << n; + n += D_EXP; + } + if (sign) { + uval = -uval; + if ((int)uval > 0) + return 0; + } else { + if ((int)uval < 0) + return 0; + } + *sp = uval; + return 1; + } else { + return 0; + } + +#endif + +} + +static Eterm make_signed_integer(int x, Process *p) +{ +#ifdef ARCH_64 + return make_small(x); +#else + Eterm* hp; + if (IS_SSMALL(x)) + return make_small(x); + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + if (x >= 0) { + *hp = make_pos_bignum_header(1); + } else { + x = -x; + *hp = make_neg_bignum_header(1); + } + BIG_DIGIT(hp, 0) = x; + return make_big(hp); + } +#endif +} + +/* + * Parse option lists + */ + +#define PARSE_FLAG_UNIQUE_COMPILE_OPT 1 +#define PARSE_FLAG_UNIQUE_EXEC_OPT 2 +#define PARSE_FLAG_UNICODE 4 +#define PARSE_FLAG_STARTOFFSET 8 +#define PARSE_FLAG_CAPTURE_OPT 16 +#define PARSE_FLAG_GLOBAL 32 + +#define CAPSPEC_VALUES 0 +#define CAPSPEC_TYPE 1 +#define CAPSPEC_SIZE 2 + +static int /* 0 == ok, < 0 == error */ +parse_options(Eterm listp, /* in */ + int *compile_options, /* out */ + int *exec_options, /* out */ + int *flags,/* out */ + int *startoffset, /* out */ + Eterm *capture_spec) /* capture_spec[CAPSPEC_SIZE] */ /* out */ +{ + int copt,eopt,fl; + Eterm item; + + if (listp == NIL) { + copt = PCRE_DEFAULT_COMPILE_OPTS; + eopt = PCRE_DEFAULT_EXEC_OPTS; + fl = 0; + } else { + copt = 0; + eopt = 0; + fl = 0; + for (;is_list(listp); listp = CDR(list_val(listp))) { + item = CAR(list_val(listp)); + if (is_tuple(item)) { + Eterm *tp = tuple_val(item); + if (arityval(*tp) != 2 || is_not_atom(tp[1])) { + if (arityval(*tp) == 3 && tp[1] == am_capture) { + if (capture_spec != NULL) { + capture_spec[CAPSPEC_VALUES] = tp[2]; + capture_spec[CAPSPEC_TYPE] = tp[3]; + } + fl |= (PARSE_FLAG_CAPTURE_OPT | + PARSE_FLAG_UNIQUE_EXEC_OPT); + continue; + } else { + return -1; + } + } + switch(tp[1]) { + case am_capture: + if (capture_spec != NULL) { + capture_spec[CAPSPEC_VALUES] = tp[2]; + capture_spec[CAPSPEC_TYPE] = am_index; + } + fl |= (PARSE_FLAG_CAPTURE_OPT | + PARSE_FLAG_UNIQUE_EXEC_OPT); + break; + case am_offset: + { + int tmp; + if (!term_to_int(tp[2],&tmp)) { + return -1; + } + if (startoffset != NULL) { + *startoffset = tmp; + } + } + fl |= (PARSE_FLAG_UNIQUE_EXEC_OPT|PARSE_FLAG_STARTOFFSET); + break; + case am_newline: + if (!is_atom(tp[2])) { + return -1; + } + switch (tp[2]) { + case am_cr: + copt |= PCRE_NEWLINE_CR; + eopt |= PCRE_NEWLINE_CR; + break; + case am_crlf: + copt |= PCRE_NEWLINE_CRLF; + eopt |= PCRE_NEWLINE_CRLF; + break; + case am_lf: + copt |= PCRE_NEWLINE_LF; + eopt |= PCRE_NEWLINE_LF; + break; + case am_anycrlf: + copt |= PCRE_NEWLINE_ANYCRLF; + eopt |= PCRE_NEWLINE_ANYCRLF; + break; + case am_any: + eopt |= PCRE_NEWLINE_ANY; + copt |= PCRE_NEWLINE_ANY; + break; + default: + return -1; + break; + } + break; + default: + return -1; + } + }else if (is_not_atom(item)) { + return -1; + } else { + switch(item) { + case am_anchored: + copt |= PCRE_ANCHORED; + eopt |= PCRE_ANCHORED; + break; + case am_notempty: + eopt |= PCRE_NOTEMPTY; + fl |= PARSE_FLAG_UNIQUE_EXEC_OPT; + break; + case am_notbol: + eopt |= PCRE_NOTBOL; + fl |= PARSE_FLAG_UNIQUE_EXEC_OPT; + break; + case am_noteol: + eopt |= PCRE_NOTEOL; + fl |= PARSE_FLAG_UNIQUE_EXEC_OPT; + break; + case am_caseless: + copt |= PCRE_CASELESS; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_dollar_endonly: + copt |= PCRE_DOLLAR_ENDONLY; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_dotall: + copt |= PCRE_DOTALL; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_extended: + copt |= PCRE_EXTENDED; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_firstline: + copt |= PCRE_FIRSTLINE; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_multiline: + copt |= PCRE_MULTILINE; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_no_auto_capture: + copt |= PCRE_NO_AUTO_CAPTURE; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_dupnames: + copt |= PCRE_DUPNAMES; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_ungreedy: + copt |= PCRE_UNGREEDY; + fl |= PARSE_FLAG_UNIQUE_COMPILE_OPT; + break; + case am_unicode: + copt |= PCRE_UTF8; + fl |= (PARSE_FLAG_UNIQUE_COMPILE_OPT | PARSE_FLAG_UNICODE); + break; + case am_global: + fl |= (PARSE_FLAG_UNIQUE_EXEC_OPT | PARSE_FLAG_GLOBAL); + break; + case am_bsr_anycrlf: + eopt |= PCRE_BSR_ANYCRLF; + copt |= PCRE_BSR_ANYCRLF; + break; + case am_bsr_unicode: + eopt |= PCRE_BSR_UNICODE; + copt |= PCRE_BSR_UNICODE; + break; + default: + return -1; + } + } + } + if (is_not_nil(listp)) { + return -1; + } + } + if (compile_options != NULL) { + *compile_options = copt; + } + if (exec_options != NULL) { + *exec_options = eopt; + } + if (flags != NULL) { + *flags = fl; + } + return 0; +} + +/* + * Build Erlang term result from compilation + */ + +static Eterm +build_compile_result(Process *p, Eterm error_tag, pcre *result, int errcode, const char *errstr, int errofset, int unicode, int with_ok) +{ + Eterm *hp; + Eterm ret; + size_t pattern_size; + int capture_count; + if (!result) { + /* Return {error_tag, {Code, String, Offset}} */ + int elen = sys_strlen(errstr); + int need = 3 /* tuple of 2 */ + + 3 /* tuple of 2 */ + + (2 * elen) /* The error string list */; + hp = HAlloc(p, need); + ret = buf_to_intlist(&hp, (char *) errstr, elen, NIL); + ret = TUPLE2(hp, ret, make_small(errofset)); + hp += 3; + ret = TUPLE2(hp, error_tag, ret); + } else { + erts_pcre_fullinfo(result, NULL, PCRE_INFO_SIZE, &pattern_size); + erts_pcre_fullinfo(result, NULL, PCRE_INFO_CAPTURECOUNT, &capture_count); + /* XXX: Optimize - keep in offheap binary to allow this to + be kept across traps w/o need of copying */ + ret = new_binary(p, (byte *) result, pattern_size); + erts_pcre_free(result); + hp = HAlloc(p, (with_ok) ? (3+5) : 5); + ret = TUPLE4(hp,am_re_pattern, make_small(capture_count), make_small(unicode),ret); + if (with_ok) { + hp += 5; + ret = TUPLE2(hp,am_ok,ret); + } + } + return ret; +} + +/* + * Compile BIFs + */ + +BIF_RETTYPE +re_compile_2(BIF_ALIST_2) +{ + int slen; + char *expr; + pcre *result; + int errcode = 0; + const char *errstr = ""; + int errofset = 0; + Eterm ret; + int options = 0; + int pflags = 0; + int unicode = 0; + + + if (parse_options(BIF_ARG_2,&options,NULL,&pflags,NULL,NULL) + < 0) { + BIF_ERROR(BIF_P,BADARG); + } + + if (pflags & PARSE_FLAG_UNIQUE_EXEC_OPT) { + BIF_ERROR(BIF_P,BADARG); + } + + unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0; + + if (pflags & PARSE_FLAG_UNICODE && !is_binary(BIF_ARG_1)) { + BIF_TRAP2(ucompile_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2); + } + + if ((slen = io_list_len(BIF_ARG_1)) < 0) { + BIF_ERROR(BIF_P,BADARG); + } + expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1); + if (io_list_to_buf(BIF_ARG_1, expr, slen) != 0) { + erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); + BIF_ERROR(BIF_P,BADARG); + } + expr[slen]='\0'; + result = erts_pcre_compile2(expr, options, &errcode, + &errstr, &errofset, default_table); + + ret = build_compile_result(BIF_P, am_error, result, errcode, + errstr, errofset, unicode, 1); + erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); + BIF_RET(ret); +} + +BIF_RETTYPE +re_compile_1(BIF_ALIST_1) +{ + return re_compile_2(BIF_P,BIF_ARG_1,NIL); +} + +/* + * Restart contexts for the re:run bif + */ + +/* + * When erts_pcre_exec is restarted, only the actual extra-structure with + * it's restart-data need to be kept. The match is then called with + * watever is saved. The code is pointed out by this and cannot be + * reallocated or GC'ed, why it's passed along as a off-heap-binary, + * but not actually passed in the erts_pcre_exec restart calls. + */ + +typedef enum { RetIndex, RetString, RetBin, RetNone } ReturnType; + +typedef struct _return_info { + ReturnType type; + int num_spec; /* 0 == all, -1 == all_but first, > 0 specified in vector */ + int v[1]; +} ReturnInfo; + +typedef struct _restart_context { + pcre_extra extra; + void *restart_data; + Uint32 flags; + char *subject; /* to be able to free it when done */ + pcre *code; /* Keep a copy */ + int *ovector; /* Keep until done */ + ReturnInfo *ret_info; +} RestartContext; + +#define RESTART_FLAG_SUBJECT_IN_BINARY 0x1 + +static void cleanup_restart_context(RestartContext *rc) +{ + if (rc->restart_data != NULL) { + erts_pcre_free_restart_data(rc->restart_data); + rc->restart_data = NULL; + } + if (rc->ovector != NULL) { + erts_free(ERTS_ALC_T_RE_SUBJECT, rc->ovector); + rc->ovector = NULL; + } + if (rc->subject != NULL && !(rc->flags & RESTART_FLAG_SUBJECT_IN_BINARY)) { + erts_free(ERTS_ALC_T_RE_SUBJECT, rc->subject); + } + rc->subject = NULL; + if (rc->code != NULL) { + erts_free(ERTS_ALC_T_RE_SUBJECT, rc->code); + rc->code = NULL; + } + if (rc->ret_info != NULL) { + erts_free(ERTS_ALC_T_RE_SUBJECT, rc->ret_info); + rc->ret_info = NULL; + } +} + +static void cleanup_restart_context_bin(Binary *bp) +{ + RestartContext *rc = ERTS_MAGIC_BIN_DATA(bp); + cleanup_restart_context(rc); +} + +/* + * Build the return value for Erlang from result and restart context + */ + +static Eterm build_exec_return(Process *p, int rc, RestartContext *restartp, Eterm orig_subject) +{ + Eterm res; + Eterm *hp; + if (rc <= 0) { + res = am_nomatch; + } else { + ReturnInfo *ri = restartp->ret_info; + ReturnInfo defri = {RetIndex,0,{0}}; + if (ri == NULL) { + ri = &defri; + } + if (ri->type == RetNone) { + res = am_match; + } else if (ri->type == RetIndex){ + Eterm *tmp_vect; + Eterm tpl; + int i; + if (ri->num_spec <= 0) { + tmp_vect = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, + rc * 2 * sizeof(Eterm)); + for(i = -(ri->num_spec) ;i < rc; ++i) { + tmp_vect[i*2] = make_signed_integer(restartp->ovector[i*2],p); + tmp_vect[i*2+1] = make_signed_integer(restartp->ovector[i*2+1] - restartp->ovector[i*2],p); + } + hp = HAlloc(p, 3+(3+2)*(rc + ri->num_spec)); + res = NIL; + for(i = rc-1 ;i >= -(ri->num_spec); --i) { + tpl = TUPLE2(hp,tmp_vect[i*2],tmp_vect[i*2+1]); + hp += 3; + res = CONS(hp,tpl,res); + hp += 2; + } + } else { + int n = 0; + int x; + tmp_vect = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, + ri->num_spec * 2 * sizeof(Eterm)); + for (i = 0; i < ri->num_spec; ++i) { + x = ri->v[i]; + if (x < rc && x >= 0) { + tmp_vect[n*2] = make_signed_integer(restartp->ovector[x*2],p); + tmp_vect[n*2+1] = make_signed_integer(restartp->ovector[x*2+1]-restartp->ovector[x*2],p); + } else { + tmp_vect[n*2] = make_small(-1); + tmp_vect[n*2+1] = make_small(0); + } + ++n; + } + hp = HAlloc(p, 3+(3+2)*n); + res = NIL; + for(i = n-1 ;i >= 0; --i) { + tpl = TUPLE2(hp,tmp_vect[i*2],tmp_vect[i*2+1]); + hp += 3; + res = CONS(hp,tpl,res); + hp += 2; + } + } + res = TUPLE2(hp,am_match,res); + erts_free(ERTS_ALC_T_RE_TMP_BUF, tmp_vect); + } else { + Eterm *tmp_vect; + int i; + Eterm orig = NIL; + Uint offset = 0; + Uint bitoffs = 0; + Uint bitsize = 0; + if (restartp->flags & RESTART_FLAG_SUBJECT_IN_BINARY) { + ERTS_GET_REAL_BIN(orig_subject, orig, offset, bitoffs, bitsize); + } + if (ri->num_spec <= 0) { + tmp_vect = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, + rc * sizeof(Eterm)); + for(i = -(ri->num_spec) ;i < rc; ++i) { /* XXX: Unicode */ + char *cp; + int len; + if (restartp->ovector[i*2] < 0) { + cp = restartp->subject; + len = 0; + } else { + cp = restartp->subject + restartp->ovector[i*2]; + len = restartp->ovector[i*2+1] - restartp->ovector[i*2]; + } + if (ri->type == RetBin) { + if (restartp->flags & RESTART_FLAG_SUBJECT_IN_BINARY) { + /* Optimized - if subject was binary to begin + with, we can make sub-binaries. */ + ErlSubBin *sb; + Uint virtual_offset = cp - restartp->subject; + hp = HAlloc(p, ERL_SUB_BIN_SIZE); + sb = (ErlSubBin *) hp; + sb->thing_word = HEADER_SUB_BIN; + sb->size = len; + sb->offs = offset + virtual_offset; + sb->orig = orig; + sb->bitoffs = bitoffs; + sb->bitsize = bitsize; + sb->is_writable = 0; + tmp_vect[i] = make_binary(sb); + } else { + tmp_vect[i] = new_binary(p, (byte *) cp, len); + } + } else { + Eterm *hp2; + hp2 = HAlloc(p,(2*len)); + tmp_vect[i] = buf_to_intlist(&hp2, cp, len, NIL); + } + } + hp = HAlloc(p, 3+2*(rc + ri->num_spec)); + res = NIL; + for(i = rc-1 ;i >= -(ri->num_spec); --i) { + res = CONS(hp,tmp_vect[i],res); + hp += 2; + } + } else { + int n = 0; + int x; + tmp_vect = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, + ri->num_spec * sizeof(Eterm)); + for (i = 0; i < ri->num_spec; ++i) { + x = ri->v[i]; + if (x < rc && x >= 0) { + char *cp; + int len; + if (restartp->ovector[x*2] < 0) { + cp = restartp->subject; + len = 0; + } else { + cp = restartp->subject + restartp->ovector[x*2]; + len = restartp->ovector[x*2+1] - restartp->ovector[x*2]; + } + if (ri->type == RetBin) { + if (restartp->flags & RESTART_FLAG_SUBJECT_IN_BINARY) { + /* Optimized - if subject was binary to begin + with, we could make sub-binaries. */ + ErlSubBin *sb; + Uint virtual_offset = cp - restartp->subject; + hp = HAlloc(p, ERL_SUB_BIN_SIZE); + sb = (ErlSubBin *) hp; + sb->thing_word = HEADER_SUB_BIN; + sb->size = len; + sb->offs = offset + virtual_offset; + sb->orig = orig; + sb->bitoffs = bitoffs; + sb->bitsize = bitsize; + sb->is_writable = 0; + tmp_vect[n] = make_binary(sb); + } else { + tmp_vect[n] = new_binary(p, (byte *) cp, len); + } + } else { + Eterm *hp2; + hp2 = HAlloc(p,(2*len)); + tmp_vect[n] = buf_to_intlist(&hp2, cp, len, NIL); + } + } else { + if (ri->type == RetBin) { + tmp_vect[n] = new_binary(p, (byte *) "", 0); + } else { + tmp_vect[n] = NIL; + } + } + ++n; + } + hp = HAlloc(p, 3+2*n); + res = NIL; + for(i = n-1 ;i >= 0; --i) { + res = CONS(hp,tmp_vect[i],res); + hp += 2; + } + + } + res = TUPLE2(hp,am_match,res); + erts_free(ERTS_ALC_T_RE_TMP_BUF, tmp_vect); + } + } + return res; +} + +/* + * Extra parsing function, build the ReturnInfo structure from + * a capture specification in the option list + */ + +#define RINFO_SIZ(Num) (sizeof(ReturnInfo) + (sizeof(int) * (Num - 1))) + +static ReturnInfo * +build_capture(Eterm capture_spec[CAPSPEC_SIZE], const pcre *code) +{ + ReturnInfo *ri = erts_alloc(ERTS_ALC_T_RE_SUBJECT, RINFO_SIZ(0)); + int sallocated = 0; + char *tmpb = NULL; + int tmpbsiz = 0; + Eterm l; + + ri->type = RetIndex; + ri->num_spec = 0; + + + switch(capture_spec[CAPSPEC_TYPE]) { + case am_index: + ri->type = RetIndex; + break; + case am_list: + ri->type = RetString; + break; + case am_binary: + ri->type = RetBin; + break; + default: + goto error; + } + + switch(capture_spec[CAPSPEC_VALUES]) { + case am_all: + ri->num_spec = 0; + break; + case am_none: + case NIL: + ri->num_spec = 0; + ri->type = RetNone; + break; + case am_all_but_first: + ri->num_spec = -1; + break; + case am_first: + ri->num_spec = 1; + if(ri->num_spec > sallocated) { + sallocated = ri->num_spec; + ri = erts_realloc(ERTS_ALC_T_RE_SUBJECT, ri, RINFO_SIZ(sallocated)); + } + ri->v[ri->num_spec - 1] = 0; + break; + default: + if (is_list(capture_spec[CAPSPEC_VALUES])) { + for(l=capture_spec[CAPSPEC_VALUES];is_list(l);l = CDR(list_val(l))) { + int x; + Eterm val = CAR(list_val(l)); + if (ri->num_spec < 0) + ri->num_spec = 0; + ++(ri->num_spec); + if(ri->num_spec > sallocated) { + sallocated += 10; + ri = erts_realloc(ERTS_ALC_T_RE_SUBJECT, ri, RINFO_SIZ(sallocated)); + } + if (term_to_int(val,&x)) { + ri->v[ri->num_spec - 1] = x; + } else if (is_atom(val) || is_binary(val) || is_list(val)) { + if (is_atom(val)) { + Atom *ap = atom_tab(atom_val(val)); + if ((ap->len + 1) > tmpbsiz) { + if (!tmpbsiz) { + tmpb = erts_alloc(ERTS_ALC_T_RE_TMP_BUF,(tmpbsiz = ap->len + 1)); + } else { + tmpb = erts_realloc(ERTS_ALC_T_RE_TMP_BUF,tmpb, + (tmpbsiz = ap->len + 1)); + } + } + memcpy(tmpb,ap->name,ap->len); + tmpb[ap->len] = '\0'; + } else { + int slen = io_list_len(val); + if (slen < 0) { + goto error; + } + if ((slen + 1) > tmpbsiz) { + if (!tmpbsiz) { + tmpb = erts_alloc(ERTS_ALC_T_RE_TMP_BUF,(tmpbsiz = slen + 1)); + } else { + tmpb = erts_realloc(ERTS_ALC_T_RE_TMP_BUF,tmpb, + (tmpbsiz = slen + 1)); + } + } + if (io_list_to_buf(val, tmpb, slen) != 0) { + goto error; + } + tmpb[slen] = '\0'; + } + if ((ri->v[ri->num_spec - 1] = erts_pcre_get_stringnumber(code,tmpb)) == + PCRE_ERROR_NOSUBSTRING) { + ri->v[ri->num_spec - 1] = -1; + } + } else { + goto error; + } + } + if (l != NIL) { + goto error; + } + } else { + goto error; + } + break; + } + + if(tmpb != NULL) { + erts_free(ERTS_ALC_T_RE_TMP_BUF,tmpb); + } + return ri; + error: + if(tmpb != NULL) { + erts_free(ERTS_ALC_T_RE_TMP_BUF,tmpb); + } + erts_free(ERTS_ALC_T_RE_SUBJECT, ri); + return NULL; +} + + +/* + * The actual re:run/2,3 BIFs + */ +BIF_RETTYPE +re_run_3(BIF_ALIST_3) +{ + const pcre *code_tmp; + RestartContext restart; + byte *temp_alloc = NULL; + int slength; + int startoffset = 0; + int options = 0, comp_options = 0; + int ovsize; + int pflags; + Eterm *tp; + int rc; + Eterm res; + size_t code_size; + Uint loop_limit_tmp; + unsigned long loop_count; + Eterm capture[CAPSPEC_SIZE]; + int is_list_cap; + + if (parse_options(BIF_ARG_3,&comp_options,&options,&pflags,&startoffset,capture) + < 0) { + BIF_ERROR(BIF_P,BADARG); + } + is_list_cap = ((pflags & PARSE_FLAG_CAPTURE_OPT) && + (capture[CAPSPEC_TYPE] == am_list)); + + if (is_not_tuple(BIF_ARG_2) || (arityval(*tuple_val(BIF_ARG_2)) != 4)) { + if (is_binary(BIF_ARG_2) || is_list(BIF_ARG_2) || is_nil(BIF_ARG_2)) { + /* Compile from textual RE */ + int slen; + char *expr; + pcre *result; + int errcode = 0; + const char *errstr = ""; + int errofset = 0; + int capture_count; + + if (pflags & PARSE_FLAG_UNICODE && + (!is_binary(BIF_ARG_1) || + (is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) { + BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + } + + if ((slen = io_list_len(BIF_ARG_2)) < 0) { + BIF_ERROR(BIF_P,BADARG); + } + + expr = erts_alloc(ERTS_ALC_T_RE_TMP_BUF, slen + 1); + if (io_list_to_buf(BIF_ARG_2, expr, slen) != 0) { + erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); + BIF_ERROR(BIF_P,BADARG); + } + expr[slen]='\0'; + result = erts_pcre_compile2(expr, comp_options, &errcode, + &errstr, &errofset, default_table); + if (!result) { + erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); + /* Compilation error gives badarg except in the compile + function */ + BIF_ERROR(BIF_P,BADARG); + } + if (pflags & PARSE_FLAG_GLOBAL) { + Eterm precompiled = + build_compile_result(BIF_P, am_error, + result, errcode, + errstr, errofset, + (pflags & + PARSE_FLAG_UNICODE) ? 1 : 0, + 0); + Eterm *hp,r; + erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); + hp = HAlloc(BIF_P,4); + /* BIF_ARG_2 is in the tuple just to make exceptions right */ + r = TUPLE3(hp,BIF_ARG_3, + ((pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) ? + am_true : + am_false), BIF_ARG_2); + BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, precompiled, r); + } + + erts_pcre_fullinfo(result, NULL, PCRE_INFO_SIZE, &code_size); + erts_pcre_fullinfo(result, NULL, PCRE_INFO_CAPTURECOUNT, &capture_count); + ovsize = 3*(capture_count+1); + restart.code = erts_alloc(ERTS_ALC_T_RE_SUBJECT, code_size); + memcpy(restart.code, result, code_size); + erts_pcre_free(result); + erts_free(ERTS_ALC_T_RE_TMP_BUF, expr); + /*unicode = (pflags & PARSE_FLAG_UNICODE) ? 1 : 0;*/ + } else { + BIF_ERROR(BIF_P,BADARG); + } + } else { + if (pflags & PARSE_FLAG_UNIQUE_COMPILE_OPT) { + BIF_ERROR(BIF_P,BADARG); + } + + tp = tuple_val(BIF_ARG_2); + if (tp[1] != am_re_pattern || is_not_small(tp[2]) || + is_not_small(tp[3]) || is_not_binary(tp[4])) { + BIF_ERROR(BIF_P,BADARG); + } + + if (unsigned_val(tp[3]) && + (!is_binary(BIF_ARG_1) || + (is_list_cap && !(pflags & PARSE_FLAG_GLOBAL)))) { /* unicode */ + BIF_TRAP3(urun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, + BIF_ARG_3); + } + + if (pflags & PARSE_FLAG_GLOBAL) { + Eterm *hp,r; + hp = HAlloc(BIF_P,3); + r = TUPLE2(hp,BIF_ARG_3,am_false); + BIF_TRAP3(grun_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2, + r); + } + + ovsize = 3*(unsigned_val(tp[2])+1); + code_size = binary_size(tp[4]); + if ((code_tmp = (const pcre *) + erts_get_aligned_binary_bytes(tp[4], &temp_alloc)) == NULL) { + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); + } + restart.code = erts_alloc(ERTS_ALC_T_RE_SUBJECT, code_size); + memcpy(restart.code, code_tmp, code_size); + erts_free_aligned_binary_bytes(temp_alloc); + + } + + + restart.ovector = erts_alloc(ERTS_ALC_T_RE_SUBJECT, ovsize * sizeof(int)); + restart.extra.flags = PCRE_EXTRA_TABLES | PCRE_EXTRA_LOOP_LIMIT; + restart.extra.tables = default_table; + restart.extra.loop_limit = ERTS_BIF_REDS_LEFT(BIF_P) * LOOP_FACTOR; + loop_limit_tmp = max_loop_limit; /* To lesser probability of race in debug + situation (erts_debug) */ + if (restart.extra.loop_limit > loop_limit_tmp) { + restart.extra.loop_limit = loop_limit_tmp; + } + restart.restart_data = NULL; + restart.extra.restart_data = &restart.restart_data; + restart.extra.restart_flags = 0; + restart.extra.loop_counter_return = &loop_count; + restart.ret_info = NULL; + + if (pflags & PARSE_FLAG_CAPTURE_OPT) { + if ((restart.ret_info = build_capture(capture,restart.code)) == NULL) { + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); + BIF_ERROR(BIF_P,BADARG); + } + } + + /* Optimized - if already in binary off heap, keep that and avoid + copying, also binary returns can be sub binaries in that case */ + + restart.flags = 0; + if (is_binary(BIF_ARG_1)) { + Eterm real_bin; + Uint offset; + Eterm* bptr; + int bitoffs; + int bitsize; + ProcBin* pb; + + ERTS_GET_REAL_BIN(BIF_ARG_1, real_bin, offset, bitoffs, bitsize); + + slength = binary_size(BIF_ARG_1); + bptr = binary_val(real_bin); + if (bitsize != 0 || bitoffs != 0 || (*bptr != HEADER_PROC_BIN)) { + goto handle_iolist; + } + pb = (ProcBin *) bptr; + restart.subject = (char *) (pb->bytes+offset); + restart.flags |= RESTART_FLAG_SUBJECT_IN_BINARY; + } else { +handle_iolist: + if ((slength = io_list_len(BIF_ARG_1)) < 0) { + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); + if (restart.ret_info != NULL) { + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info); + } + BIF_ERROR(BIF_P,BADARG); + } + restart.subject = erts_alloc(ERTS_ALC_T_RE_SUBJECT, slength); + + if (io_list_to_buf(BIF_ARG_1, restart.subject, slength) != 0) { + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ovector); + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.code); + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.subject); + if (restart.ret_info != NULL) { + erts_free(ERTS_ALC_T_RE_SUBJECT, restart.ret_info); + } + BIF_ERROR(BIF_P,BADARG); + } + } + + +#ifdef DEBUG + loop_count = 0xFFFFFFFF; +#endif + + rc = erts_pcre_exec(restart.code, &(restart.extra), restart.subject, slength, startoffset, + options, restart.ovector, ovsize); + ASSERT(loop_count != 0xFFFFFFFF); + BUMP_REDS(BIF_P, loop_count / LOOP_FACTOR); + if (rc == PCRE_ERROR_LOOP_LIMIT) { + /* Trap */ + Binary *mbp = erts_create_magic_binary(sizeof(RestartContext), + cleanup_restart_context_bin); + RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp); + Eterm magic_bin; + Eterm *hp; + memcpy(restartp,&restart,sizeof(RestartContext)); + BUMP_ALL_REDS(BIF_P); + hp = HAlloc(BIF_P, PROC_BIN_SIZE); + magic_bin = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mbp); + BIF_TRAP3(&re_exec_trap_export, + BIF_P, + BIF_ARG_1, + BIF_ARG_2 /* To avoid GC of precompiled code, XXX: not utilized yet */, + magic_bin); + } + + res = build_exec_return(BIF_P, rc, &restart, BIF_ARG_1); + + cleanup_restart_context(&restart); + + BIF_RET(res); +} + +BIF_RETTYPE +re_run_2(BIF_ALIST_2) +{ + return re_run_3(BIF_P,BIF_ARG_1, BIF_ARG_2, NIL); +} + +/* + * The "magic" trap target, continue a re:run + */ + +static BIF_RETTYPE re_exec_trap(BIF_ALIST_3) + /* XXX: Optimize - arg 1 and 2 to be utilized for keeping binary + code and subject */ +{ + Binary *mbp; + RestartContext *restartp; + int rc; + unsigned long loop_count; + Uint loop_limit_tmp; + Eterm res; + + ASSERT(ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_3)); + + mbp = ((ProcBin *) binary_val(BIF_ARG_3))->val; + + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) + == cleanup_restart_context_bin); + + restartp = (RestartContext *) ERTS_MAGIC_BIN_DATA(mbp); + + restartp->extra.loop_limit = ERTS_BIF_REDS_LEFT(BIF_P) * LOOP_FACTOR; + loop_limit_tmp = max_loop_limit; /* To lesser probability of race in debug + situation (erts_debug) */ + if (restartp->extra.loop_limit > loop_limit_tmp) { + restartp->extra.loop_limit = loop_limit_tmp; + } + restartp->extra.loop_counter_return = &loop_count; + restartp->extra.restart_data = &restartp->restart_data; + restartp->extra.restart_flags = 0; + +#ifdef DEBUG + loop_count = 0xFFFFFFFF; +#endif + rc = erts_pcre_exec(NULL, &(restartp->extra), NULL, 0, 0, 0, NULL, 0); + ASSERT(loop_count != 0xFFFFFFFF); + BUMP_REDS(BIF_P, loop_count / LOOP_FACTOR); + if (rc == PCRE_ERROR_LOOP_LIMIT) { + /* Trap */ + BUMP_ALL_REDS(BIF_P); + BIF_TRAP3(&re_exec_trap_export, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + } + res = build_exec_return(BIF_P, rc, restartp, BIF_ARG_1); + + cleanup_restart_context(restartp); + + BIF_RET(res); +} + + + + diff --git a/erts/emulator/beam/erl_bif_timer.c b/erts/emulator/beam/erl_bif_timer.c new file mode 100644 index 0000000000..172bb37952 --- /dev/null +++ b/erts/emulator/beam/erl_bif_timer.c @@ -0,0 +1,701 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_bif_timer.h" +#include "global.h" +#include "bif.h" +#include "error.h" +#include "big.h" + +/**************************************************************************** +** BIF Timer support +****************************************************************************/ + +#define BTM_FLG_SL_TIMER (((Uint32) 1) << 0) +#define BTM_FLG_CANCELED (((Uint32) 1) << 1) +#define BTM_FLG_HEAD (((Uint32) 1) << 2) +#define BTM_FLG_BYNAME (((Uint32) 1) << 3) +#define BTM_FLG_WRAP (((Uint32) 1) << 4) + +struct ErtsBifTimer_ { + struct { + union { + ErtsBifTimer **head; + ErtsBifTimer *prev; + } u; + ErtsBifTimer *next; + } tab; + union { + Eterm name; + struct { + ErtsBifTimer *prev; + ErtsBifTimer *next; + Process *ess; + } proc; + } receiver; + ErlTimer tm; + ErlHeapFragment* bp; + Uint32 flags; + Eterm message; + Uint32 ref_numbers[ERTS_REF_NUMBERS]; +}; + +#ifdef SMALL_MEMORY +#define TIMER_HASH_VEC_SZ 3331 +#define BTM_PREALC_SZ 10 +#else +#define TIMER_HASH_VEC_SZ 10007 +#define BTM_PREALC_SZ 100 +#endif +static ErtsBifTimer **bif_timer_tab; +static Uint no_bif_timers; + + +static erts_smp_rwmtx_t bif_timer_lock; + +#define erts_smp_safe_btm_rwlock(P, L) \ + safe_btm_lock((P), (L), 1) +#define erts_smp_safe_btm_rlock(P, L) \ + safe_btm_lock((P), (L), 0) +#define erts_smp_btm_rwlock() \ + erts_smp_rwmtx_rwlock(&bif_timer_lock) +#define erts_smp_btm_tryrwlock() \ + erts_smp_rwmtx_tryrwlock(&bif_timer_lock) +#define erts_smp_btm_rwunlock() \ + erts_smp_rwmtx_rwunlock(&bif_timer_lock) +#define erts_smp_btm_rlock() \ + erts_smp_rwmtx_rlock(&bif_timer_lock) +#define erts_smp_btm_tryrlock() \ + erts_smp_rwmtx_tryrlock(&bif_timer_lock) +#define erts_smp_btm_runlock() \ + erts_smp_rwmtx_runlock(&bif_timer_lock) +#define erts_smp_btm_lock_init() \ + erts_smp_rwmtx_init(&bif_timer_lock, "bif_timers") + + +static ERTS_INLINE int +safe_btm_lock(Process *c_p, ErtsProcLocks c_p_locks, int rw_lock) +{ + ASSERT(c_p && c_p_locks); +#ifdef ERTS_SMP + if ((rw_lock ? erts_smp_btm_tryrwlock() : erts_smp_btm_tryrlock()) != EBUSY) + return 0; + erts_smp_proc_unlock(c_p, c_p_locks); + if (rw_lock) + erts_smp_btm_rwlock(); + else + erts_smp_btm_rlock(); + erts_smp_proc_lock(c_p, c_p_locks); + if (ERTS_PROC_IS_EXITING(c_p)) { + if (rw_lock) + erts_smp_btm_rwunlock(); + else + erts_smp_btm_runlock(); + return 1; + } +#endif + return 0; +} + +ERTS_SCHED_PREF_PALLOC_IMPL(btm_pre, ErtsBifTimer, BTM_PREALC_SZ) + +static ERTS_INLINE int +get_index(Uint32 *ref_numbers, Uint32 len) +{ + Uint32 hash; + /* len can potentially be larger than ERTS_REF_NUMBERS + if it has visited another node... */ + if (len > ERTS_REF_NUMBERS) + len = ERTS_REF_NUMBERS; + +#if ERTS_REF_NUMBERS != 3 +#error "ERTS_REF_NUMBERS changed. Update me..." +#endif + switch (len) { + case 3: if (!ref_numbers[2]) len = 2; + case 2: if (!ref_numbers[1]) len = 1; + default: break; + } + + ASSERT(1 <= len && len <= ERTS_REF_NUMBERS); + + hash = block_hash((byte *) ref_numbers, len * sizeof(Uint32), 0x08d12e65); + return (int) (hash % ((Uint32) TIMER_HASH_VEC_SZ)); +} + +static Eterm +create_ref(Uint *hp, Uint32 *ref_numbers, Uint32 len) +{ + Uint32 *datap; + int i; + + + if (len > ERTS_MAX_REF_NUMBERS) { + /* Such large refs should no be able to appear in the emulator */ + erl_exit(1, "%s:%d: Internal error\n", __FILE__, __LINE__); + } + +#ifdef ARCH_64 + hp[0] = make_ref_thing_header(len/2 + 1); + datap = (Uint32 *) &hp[1]; + *(datap++) = len; +#else + hp[0] = make_ref_thing_header(len); + datap = (Uint32 *) &hp[1]; +#endif + + for (i = 0; i < len; i++) + datap[i] = ref_numbers[i]; + + return make_internal_ref(hp); +} + +static int +eq_non_standard_ref_numbers(Uint32 *rn1, Uint32 len1, Uint32 *rn2, Uint32 len2) +{ +#ifdef ARCH_64 +#define MAX_REF_HEAP_SZ (1+(ERTS_MAX_REF_NUMBERS/2+1)) +#else +#define MAX_REF_HEAP_SZ (1+ERTS_MAX_REF_NUMBERS) +#endif + Uint r1_hp[MAX_REF_HEAP_SZ]; + Uint r2_hp[MAX_REF_HEAP_SZ]; + + return eq(create_ref(r1_hp, rn1, len1), create_ref(r2_hp, rn2, len2)); +#undef MAX_REF_HEAP_SZ +} + +static ERTS_INLINE int +eq_ref_numbers(Uint32 *rn1, Uint32 len1, Uint32 *rn2, Uint32 len2) +{ + int res; + if (len1 != ERTS_REF_NUMBERS || len2 != ERTS_REF_NUMBERS) { + /* Can potentially happen, but will never... */ + return eq_non_standard_ref_numbers(rn1, len1, rn2, len2); + } + +#if ERTS_REF_NUMBERS != 3 +#error "ERTS_REF_NUMBERS changed. Update me..." +#endif + res = rn1[0] == rn2[0] && rn1[1] == rn2[1] && rn1[2] == rn2[2]; + + ASSERT(res + ? eq_non_standard_ref_numbers(rn1, len1, rn2, len2) + : !eq_non_standard_ref_numbers(rn1, len1, rn2, len2)); + + return res; +} + +static ERTS_INLINE ErtsBifTimer * +tab_find(Eterm ref) +{ + Uint32 *ref_numbers = internal_ref_numbers(ref); + Uint32 ref_numbers_len = internal_ref_no_of_numbers(ref); + int ix = get_index(ref_numbers, ref_numbers_len); + ErtsBifTimer* btm; + + for (btm = bif_timer_tab[ix]; btm; btm = btm->tab.next) + if (eq_ref_numbers(ref_numbers, ref_numbers_len, + btm->ref_numbers, ERTS_REF_NUMBERS)) + return btm; + return NULL; +} + +static ERTS_INLINE void +tab_remove(ErtsBifTimer* btm) +{ + if (btm->flags & BTM_FLG_HEAD) { + *btm->tab.u.head = btm->tab.next; + if (btm->tab.next) { + btm->tab.next->flags |= BTM_FLG_HEAD; + btm->tab.next->tab.u.head = btm->tab.u.head; + } + } + else { + btm->tab.u.prev->tab.next = btm->tab.next; + if (btm->tab.next) + btm->tab.next->tab.u.prev = btm->tab.u.prev; + } + btm->flags |= BTM_FLG_CANCELED; + ASSERT(no_bif_timers > 0); + no_bif_timers--; +} + +static ERTS_INLINE void +tab_insert(ErtsBifTimer* btm) +{ + int ix = get_index(btm->ref_numbers, ERTS_REF_NUMBERS); + ErtsBifTimer* btm_list = bif_timer_tab[ix]; + + if (btm_list) { + btm_list->flags &= ~BTM_FLG_HEAD; + btm_list->tab.u.prev = btm; + } + + btm->flags |= BTM_FLG_HEAD; + btm->tab.u.head = &bif_timer_tab[ix]; + btm->tab.next = btm_list; + bif_timer_tab[ix] = btm; + no_bif_timers++; +} + +static ERTS_INLINE void +link_proc(Process *p, ErtsBifTimer* btm) +{ + btm->receiver.proc.ess = p; + btm->receiver.proc.prev = NULL; + btm->receiver.proc.next = p->bif_timers; + if (p->bif_timers) + p->bif_timers->receiver.proc.prev = btm; + p->bif_timers = btm; +} + +static ERTS_INLINE void +unlink_proc(ErtsBifTimer* btm) +{ + if (btm->receiver.proc.prev) + btm->receiver.proc.prev->receiver.proc.next = btm->receiver.proc.next; + else + btm->receiver.proc.ess->bif_timers = btm->receiver.proc.next; + if (btm->receiver.proc.next) + btm->receiver.proc.next->receiver.proc.prev = btm->receiver.proc.prev; +} + +static void +bif_timer_cleanup(ErtsBifTimer* btm) +{ + ASSERT(btm); + + if (btm->bp) + free_message_buffer(btm->bp); + + if (!btm_pre_free(btm)) { + if (btm->flags & BTM_FLG_SL_TIMER) + erts_free(ERTS_ALC_T_SL_BIF_TIMER, (void *) btm); + else + erts_free(ERTS_ALC_T_LL_BIF_TIMER, (void *) btm); + } +} + +static void +bif_timer_timeout(ErtsBifTimer* btm) +{ + ASSERT(btm); + + + erts_smp_btm_rwlock(); + + if (btm->flags & BTM_FLG_CANCELED) { + /* + * A concurrent cancel is ongoing. Do not send the timeout message, + * but cleanup here since the cancel call-back won't be called. + */ +#ifndef ERTS_SMP + ASSERT(0); +#endif + } + else { + ErtsProcLocks rp_locks = 0; + Process* rp; + + tab_remove(btm); + + ASSERT(!erts_get_current_process()); + + if (btm->flags & BTM_FLG_BYNAME) + rp = erts_whereis_process(NULL,0,btm->receiver.name,0,ERTS_P2P_FLG_SMP_INC_REFC); + else { + rp = btm->receiver.proc.ess; + erts_smp_proc_inc_refc(rp); + unlink_proc(btm); + } + + if (rp) { + Eterm message; + ErlHeapFragment *bp; + + bp = btm->bp; + btm->bp = NULL; /* Prevent cleanup of message buffer... */ + + if (!(btm->flags & BTM_FLG_WRAP)) + message = btm->message; + else { +#if ERTS_REF_NUMBERS != 3 +#error "ERTS_REF_NUMBERS changed. Update me..." +#endif + Eterm ref; + Uint *hp; + Uint wrap_size = REF_THING_SIZE + 4; + message = btm->message; + + if (!bp) { + ErlOffHeap *ohp; + ASSERT(is_immed(message)); + hp = erts_alloc_message_heap(wrap_size, + &bp, + &ohp, + rp, + &rp_locks); + } else { + Eterm old_size = bp->size; + bp = erts_resize_message_buffer(bp, old_size + wrap_size, + &message, 1); + hp = &bp->mem[0] + old_size; + } + + write_ref_thing(hp, + btm->ref_numbers[0], + btm->ref_numbers[1], + btm->ref_numbers[2]); + ref = make_internal_ref(hp); + hp += REF_THING_SIZE; + message = TUPLE3(hp, am_timeout, ref, message); + } + + erts_queue_message(rp, &rp_locks, bp, message, NIL); + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); + } + } + + erts_smp_btm_rwunlock(); + + bif_timer_cleanup(btm); +} + +static Eterm +setup_bif_timer(Uint32 xflags, + Process *c_p, + Eterm time, + Eterm receiver, + Eterm message) +{ + Process *rp; + ErtsBifTimer* btm; + Uint timeout; + Eterm ref; + Uint32 *ref_numbers; + + if (!term_to_Uint(time, &timeout)) + return THE_NON_VALUE; +#ifdef ARCH_64 + if ((timeout >> 32) != 0) + return THE_NON_VALUE; +#endif + if (is_not_internal_pid(receiver) && is_not_atom(receiver)) + return THE_NON_VALUE; + + ref = erts_make_ref(c_p); + + if (is_atom(receiver)) + rp = NULL; + else { + rp = erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN, + receiver, ERTS_PROC_LOCK_MSGQ); + if (!rp) + return ref; + } + + if (timeout < ERTS_ALC_MIN_LONG_LIVED_TIME) { + if (timeout < 1000) { + btm = btm_pre_alloc(); + if (!btm) + goto sl_timer_alloc; + btm->flags = 0; + } + else { + sl_timer_alloc: + btm = (ErtsBifTimer *) erts_alloc(ERTS_ALC_T_SL_BIF_TIMER, + sizeof(ErtsBifTimer)); + btm->flags = BTM_FLG_SL_TIMER; + } + } + else { + btm = (ErtsBifTimer *) erts_alloc(ERTS_ALC_T_LL_BIF_TIMER, + sizeof(ErtsBifTimer)); + btm->flags = 0; + } + + if (rp) { + link_proc(rp, btm); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MSGQ); + } + else { + ASSERT(is_atom(receiver)); + btm->receiver.name = receiver; + btm->flags |= BTM_FLG_BYNAME; + } + + btm->flags |= xflags; + + ref_numbers = internal_ref_numbers(ref); + ASSERT(internal_ref_no_of_numbers(ref) == 3); +#if ERTS_REF_NUMBERS != 3 +#error "ERTS_REF_NUMBERS changed. Update me..." +#endif + btm->ref_numbers[0] = ref_numbers[0]; + btm->ref_numbers[1] = ref_numbers[1]; + btm->ref_numbers[2] = ref_numbers[2]; + + ASSERT(eq_ref_numbers(btm->ref_numbers, ERTS_REF_NUMBERS, + ref_numbers, ERTS_REF_NUMBERS)); + + if (is_immed(message)) { + btm->bp = NULL; + btm->message = message; + } + else { + ErlHeapFragment* bp; + Eterm* hp; + Uint size; + + size = size_object(message); + btm->bp = bp = new_message_buffer(size); + hp = bp->mem; + btm->message = copy_struct(message, size, &hp, &bp->off_heap); + } + + tab_insert(btm); + ASSERT(btm == tab_find(ref)); + btm->tm.active = 0; /* MUST be initalized */ + erl_set_timer(&btm->tm, + (ErlTimeoutProc) bif_timer_timeout, + (ErlCancelProc) bif_timer_cleanup, + (void *) btm, + timeout); + return ref; +} + +/* send_after(Time, Pid, Message) -> Ref */ +BIF_RETTYPE send_after_3(BIF_ALIST_3) +{ + Eterm res; + + if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN)) + ERTS_BIF_EXITED(BIF_P); + + res = setup_bif_timer(0, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + + erts_smp_btm_rwunlock(); + + if (is_non_value(res)) { + BIF_ERROR(BIF_P, BADARG); + } + else { + ASSERT(is_internal_ref(res)); + BIF_RET(res); + } +} + +/* start_timer(Time, Pid, Message) -> Ref */ +BIF_RETTYPE start_timer_3(BIF_ALIST_3) +{ + Eterm res; + + if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN)) + ERTS_BIF_EXITED(BIF_P); + + res = setup_bif_timer(BTM_FLG_WRAP, BIF_P, BIF_ARG_1, BIF_ARG_2, BIF_ARG_3); + + erts_smp_btm_rwunlock(); + + if (is_non_value(res)) { + BIF_ERROR(BIF_P, BADARG); + } + else { + ASSERT(is_internal_ref(res)); + BIF_RET(res); + } +} + +/* cancel_timer(Ref) -> false | RemainingTime */ +BIF_RETTYPE cancel_timer_1(BIF_ALIST_1) +{ + Eterm res; + ErtsBifTimer *btm; + + if (is_not_internal_ref(BIF_ARG_1)) { + if (is_ref(BIF_ARG_1)) { + BIF_RET(am_false); + } + BIF_ERROR(BIF_P, BADARG); + } + + if (erts_smp_safe_btm_rwlock(BIF_P, ERTS_PROC_LOCK_MAIN)) + ERTS_BIF_EXITED(BIF_P); + + btm = tab_find(BIF_ARG_1); + if (!btm || btm->flags & BTM_FLG_CANCELED) { + erts_smp_btm_rwunlock(); + res = am_false; + } + else { + Uint left = time_left(&btm->tm); + if (!(btm->flags & BTM_FLG_BYNAME)) { + erts_smp_proc_lock(btm->receiver.proc.ess, ERTS_PROC_LOCK_MSGQ); + unlink_proc(btm); + erts_smp_proc_unlock(btm->receiver.proc.ess, ERTS_PROC_LOCK_MSGQ); + } + tab_remove(btm); + ASSERT(!tab_find(BIF_ARG_1)); + erl_cancel_timer(&btm->tm); + erts_smp_btm_rwunlock(); + res = erts_make_integer(left, BIF_P); + } + + BIF_RET(res); +} + +/* read_timer(Ref) -> false | RemainingTime */ +BIF_RETTYPE read_timer_1(BIF_ALIST_1) +{ + Eterm res; + ErtsBifTimer *btm; + + if (is_not_internal_ref(BIF_ARG_1)) { + if (is_ref(BIF_ARG_1)) { + BIF_RET(am_false); + } + BIF_ERROR(BIF_P, BADARG); + } + + if (erts_smp_safe_btm_rlock(BIF_P, ERTS_PROC_LOCK_MAIN)) + ERTS_BIF_EXITED(BIF_P); + + btm = tab_find(BIF_ARG_1); + if (!btm || btm->flags & BTM_FLG_CANCELED) { + res = am_false; + } + else { + Uint left = time_left(&btm->tm); + res = erts_make_integer(left, BIF_P); + } + + erts_smp_btm_runlock(); + + BIF_RET(res); +} + +void +erts_print_bif_timer_info(int to, void *to_arg) +{ + int i; + int lock = !ERTS_IS_CRASH_DUMPING; + + if (lock) + erts_smp_btm_rlock(); + + for (i = 0; i < TIMER_HASH_VEC_SZ; i++) { + ErtsBifTimer *btm; + for (btm = bif_timer_tab[i]; btm; btm = btm->tab.next) { + Eterm receiver = (btm->flags & BTM_FLG_BYNAME + ? btm->receiver.name + : btm->receiver.proc.ess->id); + erts_print(to, to_arg, "=timer:%T\n", receiver); + erts_print(to, to_arg, "Message: %T\n", btm->message); + erts_print(to, to_arg, "Time left: %d ms\n", time_left(&btm->tm)); + } + } + + if (lock) + erts_smp_btm_runlock(); +} + + +void +erts_cancel_bif_timers(Process *p, ErtsProcLocks plocks) +{ + ErtsBifTimer *btm; + + if (erts_smp_btm_tryrwlock() == EBUSY) { + erts_smp_proc_unlock(p, plocks); + erts_smp_btm_rwlock(); + erts_smp_proc_lock(p, plocks); + } + + btm = p->bif_timers; + while (btm) { + ErtsBifTimer *tmp_btm; + ASSERT(!(btm->flags & BTM_FLG_CANCELED)); + tab_remove(btm); + tmp_btm = btm; + btm = btm->receiver.proc.next; + erl_cancel_timer(&tmp_btm->tm); + } + + p->bif_timers = NULL; + + erts_smp_btm_rwunlock(); +} + +void erts_bif_timer_init(void) +{ + int i; + no_bif_timers = 0; + init_btm_pre_alloc(); + erts_smp_btm_lock_init(); + bif_timer_tab = erts_alloc(ERTS_ALC_T_BIF_TIMER_TABLE, + sizeof(ErtsBifTimer *)*TIMER_HASH_VEC_SZ); + for (i = 0; i < TIMER_HASH_VEC_SZ; ++i) + bif_timer_tab[i] = NULL; +} + +Uint +erts_bif_timer_memory_size(void) +{ + Uint res; + int lock = !ERTS_IS_CRASH_DUMPING; + + if (lock) + erts_smp_btm_rlock(); + + res = (sizeof(ErtsBifTimer *)*TIMER_HASH_VEC_SZ + + no_bif_timers*sizeof(ErtsBifTimer)); + + if (lock) + erts_smp_btm_runlock(); + + return res; +} + + +void +erts_bif_timer_foreach(void (*func)(Eterm, Eterm, ErlHeapFragment *, void *), + void *arg) +{ + int i; + + ERTS_SMP_LC_ASSERT(erts_smp_is_system_blocked(0)); + + for (i = 0; i < TIMER_HASH_VEC_SZ; i++) { + ErtsBifTimer *btm; + for (btm = bif_timer_tab[i]; btm; btm = btm->tab.next) { + (*func)((btm->flags & BTM_FLG_BYNAME + ? btm->receiver.name + : btm->receiver.proc.ess->id), + btm->message, + btm->bp, + arg); + } + } +} diff --git a/erts/emulator/beam/erl_bif_timer.h b/erts/emulator/beam/erl_bif_timer.h new file mode 100644 index 0000000000..1197c176f5 --- /dev/null +++ b/erts/emulator/beam/erl_bif_timer.h @@ -0,0 +1,36 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +#ifndef ERL_BIF_TIMER_H__ +#define ERL_BIF_TIMER_H__ + +typedef struct ErtsBifTimer_ ErtsBifTimer; + +#include "sys.h" +#include "erl_process.h" +#include "erl_message.h" + +Uint erts_bif_timer_memory_size(void); +void erts_print_bif_timer_info(int to, void *to_arg); +void erts_cancel_bif_timers(Process *p, ErtsProcLocks plocks); +void erts_bif_timer_init(void); +void erts_bif_timer_foreach(void (*func)(Eterm,Eterm,ErlHeapFragment *,void *), + void *arg); +#endif diff --git a/erts/emulator/beam/erl_bif_trace.c b/erts/emulator/beam/erl_bif_trace.c new file mode 100644 index 0000000000..7dff5e0eeb --- /dev/null +++ b/erts/emulator/beam/erl_bif_trace.c @@ -0,0 +1,2106 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Trace BIFs. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "big.h" +#include "dist.h" +#include "erl_version.h" +#include "beam_bp.h" +#include "erl_binary.h" + +#define DECL_AM(S) Eterm AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) + +static erts_smp_mtx_t trace_pattern_mutex; +const struct trace_pattern_flags erts_trace_pattern_flags_off = {0, 0, 0, 0}; +static int erts_default_trace_pattern_is_on; +static Binary *erts_default_match_spec; +static Binary *erts_default_meta_match_spec; +static struct trace_pattern_flags erts_default_trace_pattern_flags; +static Eterm erts_default_meta_tracer_pid; + +static void new_seq_trace_token(Process* p); /* help func for seq_trace_2*/ +static int already_traced(Process *p, Process *tracee_p, Eterm tracer); +static int port_already_traced(Process *p, Port *tracee_port, Eterm tracer); +static Eterm trace_info_pid(Process* p, Eterm pid_spec, Eterm key); +static Eterm trace_info_func(Process* p, Eterm pid_spec, Eterm key); +static Eterm trace_info_on_load(Process* p, Eterm key); + +static int setup_func_trace(Export* ep, void* match_prog); +static int reset_func_trace(Export* ep); +static void reset_bif_trace(int bif_index); +static void setup_bif_trace(int bif_index); +static void set_trace_bif(int bif_index, void* match_prog); +static void clear_trace_bif(int bif_index); + +void +erts_bif_trace_init(void) +{ + erts_smp_mtx_init(&trace_pattern_mutex, "trace_pattern"); + erts_default_trace_pattern_is_on = 0; + erts_default_match_spec = NULL; + erts_default_meta_match_spec = NULL; + erts_default_trace_pattern_flags = erts_trace_pattern_flags_off; + erts_default_meta_tracer_pid = NIL; +} + +/* + * Turn on/off call tracing for the given function(s). + */ + +Eterm +trace_pattern_2(Process* p, Eterm MFA, Eterm Pattern) +{ + return trace_pattern_3(p,MFA,Pattern,NIL); +} + +Eterm +trace_pattern_3(Process* p, Eterm MFA, Eterm Pattern, Eterm flaglist) +{ + Eterm mfa[3]; + int i; + int matches = 0; + int specified = 0; + enum erts_break_op on; + Binary* match_prog_set; + Eterm l; + struct trace_pattern_flags flags = erts_trace_pattern_flags_off; + int is_global; + Process *meta_tracer_proc = p; + Eterm meta_tracer_pid = p->id; + + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + /* + * Check and compile the match specification. + */ + + if (Pattern == am_false) { + match_prog_set = NULL; + on = 0; + } else if (is_nil(Pattern) || Pattern == am_true) { + match_prog_set = NULL; + on = 1; + } else if (Pattern == am_restart) { + match_prog_set = NULL; + on = erts_break_reset; + } else if (Pattern == am_pause) { + match_prog_set = NULL; + on = erts_break_stop; + } else if ((match_prog_set = erts_match_set_compile(p, Pattern)) != NULL) { + MatchSetRef(match_prog_set); + on = 1; + } else{ + goto error; + } + + is_global = 0; + for(l = flaglist; is_list(l); l = CDR(list_val(l))) { + if (is_tuple(CAR(list_val(l)))) { + Eterm *tp = tuple_val(CAR(list_val(l))); + + if (arityval(tp[0]) != 2 || tp[1] != am_meta) { + goto error; + } + meta_tracer_pid = tp[2]; + if (is_internal_pid(meta_tracer_pid)) { + meta_tracer_proc = erts_pid2proc(NULL, 0, meta_tracer_pid, 0); + if (!meta_tracer_proc) { + goto error; + } + } else if (is_internal_port(meta_tracer_pid)) { + Port *meta_tracer_port; + meta_tracer_proc = NULL; + if (internal_port_index(meta_tracer_pid) >= erts_max_ports) + goto error; + meta_tracer_port = + &erts_port[internal_port_index(meta_tracer_pid)]; + if (INVALID_TRACER_PORT(meta_tracer_port, meta_tracer_pid)) { + goto error; + } + } else { + goto error; + } + if (is_global) { + goto error; + } + flags.breakpoint = 1; + flags.meta = 1; + } else { + switch (CAR(list_val(l))) { + case am_local: + if (is_global) { + goto error; + } + flags.breakpoint = 1; + flags.local = 1; + break; + case am_meta: + if (is_global) { + goto error; + } + flags.breakpoint = 1; + flags.meta = 1; + break; + case am_global: + if (flags.breakpoint) { + goto error; + } + is_global = !0; + break; + case am_call_count: + if (is_global) { + goto error; + } + flags.breakpoint = 1; + flags.call_count = 1; + break; + default: + goto error; + } + } + } + if (l != NIL) { + goto error; + } + + if (match_prog_set && !flags.local && !flags.meta && flags.call_count) { + /* A match prog is not allowed with just call_count */ + goto error; + } + + /* + * Check the MFA specification. + */ + + if (MFA == am_on_load) { + if (flags.local || (! flags.breakpoint)) { + MatchSetUnref(erts_default_match_spec); + erts_default_match_spec = match_prog_set; + MatchSetRef(erts_default_match_spec); + } + if (flags.meta) { + MatchSetUnref(erts_default_meta_match_spec); + erts_default_meta_match_spec = match_prog_set; + MatchSetRef(erts_default_meta_match_spec); + erts_default_meta_tracer_pid = meta_tracer_pid; + if (meta_tracer_proc) { + meta_tracer_proc->trace_flags |= F_TRACER; + } + } else if (! flags.breakpoint) { + MatchSetUnref(erts_default_meta_match_spec); + erts_default_meta_match_spec = NULL; + erts_default_meta_tracer_pid = NIL; + } + MatchSetUnref(match_prog_set); + if (erts_default_trace_pattern_flags.breakpoint && + flags.breakpoint) { + /* Breakpoint trace -> breakpoint trace */ + ASSERT(erts_default_trace_pattern_is_on); + if (on) { + erts_default_trace_pattern_flags.local + |= flags.local; + erts_default_trace_pattern_flags.meta + |= flags.meta; + erts_default_trace_pattern_flags.call_count + |= (on == 1) ? flags.call_count : 0; + } else { + erts_default_trace_pattern_flags.local + &= ~flags.local; + erts_default_trace_pattern_flags.meta + &= ~flags.meta; + erts_default_trace_pattern_flags.call_count + &= ~flags.call_count; + if (! (erts_default_trace_pattern_flags.breakpoint = + erts_default_trace_pattern_flags.local | + erts_default_trace_pattern_flags.meta | + erts_default_trace_pattern_flags.call_count)) { + erts_default_trace_pattern_is_on = !!on; /* i.e off */ + } + } + } else if (! erts_default_trace_pattern_flags.breakpoint && + ! flags.breakpoint) { + /* Global call trace -> global call trace */ + erts_default_trace_pattern_is_on = !!on; + } else if (erts_default_trace_pattern_flags.breakpoint && + ! flags.breakpoint) { + /* Breakpoint trace -> global call trace */ + if (on) { + erts_default_trace_pattern_flags = flags; /* Struct copy */ + erts_default_trace_pattern_is_on = !!on; + } + } else { + ASSERT(! erts_default_trace_pattern_flags.breakpoint && + flags.breakpoint); + /* Global call trace -> breakpoint trace */ + if (on) { + if (on != 1) { + flags.call_count = 0; + } + flags.breakpoint = flags.local | flags.meta | flags.call_count; + erts_default_trace_pattern_flags = flags; /* Struct copy */ + erts_default_trace_pattern_is_on = !!flags.breakpoint; + } + } + + goto done; + } else if (is_tuple(MFA)) { + Eterm *tp = tuple_val(MFA); + if (tp[0] != make_arityval(3)) { + goto error; + } + mfa[0] = tp[1]; + mfa[1] = tp[2]; + mfa[2] = tp[3]; + if (!is_atom(mfa[0]) || !is_atom(mfa[1]) || + (!is_small(mfa[2]) && mfa[2] != am_Underscore)) { + goto error; + } + for (i = 0; i < 3 && mfa[i] != am_Underscore; i++, specified++) { + /* Empty loop body */ + } + for (i = specified; i < 3; i++) { + if (mfa[i] != am_Underscore) { + goto error; + } + } + if (is_small(mfa[2])) { + mfa[2] = signed_val(mfa[2]); + } + } else { + goto error; + } + + if (meta_tracer_proc) { + meta_tracer_proc->trace_flags |= F_TRACER; + } + + + matches = erts_set_trace_pattern(mfa, specified, + match_prog_set, match_prog_set, + on, flags, meta_tracer_pid); + MatchSetUnref(match_prog_set); + + done: + + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + + return make_small(matches); + + error: + + MatchSetUnref(match_prog_set); + + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + BIF_ERROR(p, BADARG); +} + +void +erts_get_default_trace_pattern(int *trace_pattern_is_on, + Binary **match_spec, + Binary **meta_match_spec, + struct trace_pattern_flags *trace_pattern_flags, + Eterm *meta_tracer_pid) +{ + erts_smp_mtx_lock(&trace_pattern_mutex); + if (trace_pattern_is_on) + *trace_pattern_is_on = erts_default_trace_pattern_is_on; + if (match_spec) + *match_spec = erts_default_match_spec; + if (meta_match_spec) + *meta_match_spec = erts_default_meta_match_spec; + if (trace_pattern_flags) + *trace_pattern_flags = erts_default_trace_pattern_flags; + if (meta_tracer_pid) + *meta_tracer_pid = erts_default_meta_tracer_pid; + erts_smp_mtx_unlock(&trace_pattern_mutex); +} + + + + +Uint +erts_trace_flag2bit(Eterm flag) +{ + switch (flag) { + case am_all: return TRACEE_FLAGS; + case am_send: return F_TRACE_SEND; + case am_receive: return F_TRACE_RECEIVE; + case am_set_on_spawn: return F_TRACE_SOS; + case am_procs: return F_TRACE_PROCS; + case am_set_on_first_spawn: return F_TRACE_SOS1; + case am_set_on_link: return F_TRACE_SOL; + case am_set_on_first_link: return F_TRACE_SOL1; + case am_timestamp: return F_TIMESTAMP; + case am_running: return F_TRACE_SCHED; + case am_exiting: return F_TRACE_SCHED_EXIT; + case am_garbage_collection: return F_TRACE_GC; + case am_call: return F_TRACE_CALLS; + case am_arity: return F_TRACE_ARITY_ONLY; + case am_return_to: return F_TRACE_RETURN_TO; + case am_silent: return F_TRACE_SILENT; + case am_scheduler_id: return F_TRACE_SCHED_NO; + case am_running_ports: return F_TRACE_SCHED_PORTS; + case am_running_procs: return F_TRACE_SCHED_PROCS; + case am_ports: return F_TRACE_PORTS; + default: return 0; + } +} + +/* Scan the argument list and sort out the trace flags. +** +** Returns !0 on success, 0 on failure. +** +** Sets the result variables on success, if their flags has +** occurred in the argument list. +*/ +int +erts_trace_flags(Eterm List, + Uint *pMask, Eterm *pTracer, int *pCpuTimestamp) +{ + Eterm list = List; + Uint mask = 0; + Eterm tracer = NIL; + int cpu_timestamp = 0; + + while (is_list(list)) { + Uint bit; + Eterm item = CAR(list_val(list)); + if (is_atom(item) && (bit = erts_trace_flag2bit(item))) { + mask |= bit; +#ifdef HAVE_ERTS_NOW_CPU + } else if (item == am_cpu_timestamp) { + cpu_timestamp = !0; +#endif + } else if (is_tuple(item)) { + Eterm* tp = tuple_val(item); + + if (arityval(tp[0]) != 2 || tp[1] != am_tracer) goto error; + if (is_internal_pid(tp[2]) || is_internal_port(tp[2])) { + tracer = tp[2]; + } else goto error; + } else goto error; + list = CDR(list_val(list)); + } + if (is_not_nil(list)) goto error; + + if (pMask && mask) *pMask = mask; + if (pTracer && tracer != NIL) *pTracer = tracer; + if (pCpuTimestamp && cpu_timestamp) *pCpuTimestamp = cpu_timestamp; + return !0; + error: + return 0; +} + +Eterm +trace_3(Process* p, Eterm pid_spec, Eterm how, Eterm list) +{ + int on; + Eterm tracer = NIL; + int matches = 0; + Uint mask = 0; + int cpu_ts = 0; +#ifdef ERTS_SMP + int system_blocked = 0; +#endif + + if (! erts_trace_flags(list, &mask, &tracer, &cpu_ts)) { + BIF_ERROR(p, BADARG); + } + + if (is_nil(tracer) || is_internal_pid(tracer)) { + Process *tracer_proc = erts_pid2proc(p, + ERTS_PROC_LOCK_MAIN, + is_nil(tracer) ? p->id : tracer, + ERTS_PROC_LOCKS_ALL); + if (!tracer_proc) + goto error; + tracer_proc->trace_flags |= F_TRACER; + erts_smp_proc_unlock(tracer_proc, + (tracer_proc == p + ? ERTS_PROC_LOCKS_ALL_MINOR + : ERTS_PROC_LOCKS_ALL)); + } else if (is_internal_port(tracer)) { + Port *tracer_port = erts_id2port(tracer, p, ERTS_PROC_LOCK_MAIN); + if (!erts_is_valid_tracer_port(tracer)) { + if (tracer_port) + erts_smp_port_unlock(tracer_port); + goto error; + } + tracer_port->trace_flags |= F_TRACER; + erts_smp_port_unlock(tracer_port); + } else + goto error; + + switch (how) { + case am_false: + on = 0; + break; + case am_true: + on = 1; + if (is_nil(tracer)) + tracer = p->id; + break; + default: + goto error; + } + + /* + * Set/reset the call trace flag for the given Pids. + */ + + if (is_port(pid_spec)) { + Port *tracee_port; + +#ifdef HAVE_ERTS_NOW_CPU + if (cpu_ts) { + goto error; + } +#endif + + if (pid_spec == tracer) + goto error; + + tracee_port = erts_id2port(pid_spec, p, ERTS_PROC_LOCK_MAIN); + if (!tracee_port) + goto error; + + if (tracer != NIL && port_already_traced(p, tracee_port, tracer)) { + erts_smp_port_unlock(tracee_port); + goto already_traced; + } + + if (on) + tracee_port->trace_flags |= mask; + else + tracee_port->trace_flags &= ~mask; + + if (!tracee_port->trace_flags) + tracee_port->tracer_proc = NIL; + else if (tracer != NIL) + tracee_port->tracer_proc = tracer; + + erts_smp_port_unlock(tracee_port); + + matches = 1; + } else if (is_pid(pid_spec)) { + Process *tracee_p; + +#ifdef HAVE_ERTS_NOW_CPU + if (cpu_ts) { + goto error; + } +#endif + /* Check that the tracee is not dead, not tracing + * and not about to be tracing. + */ + + if (pid_spec == tracer) + goto error; + + tracee_p = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, + pid_spec, ERTS_PROC_LOCKS_ALL); + if (!tracee_p) + goto error; + + if (tracer != NIL && already_traced(p, tracee_p, tracer)) { + erts_smp_proc_unlock(tracee_p, + (tracee_p == p + ? ERTS_PROC_LOCKS_ALL_MINOR + : ERTS_PROC_LOCKS_ALL)); + goto already_traced; + } + + if (on) + tracee_p->trace_flags |= mask; + else + tracee_p->trace_flags &= ~mask; + + if ((tracee_p->trace_flags & TRACEE_FLAGS) == 0) + tracee_p->tracer_proc = NIL; + else if (tracer != NIL) + tracee_p->tracer_proc = tracer; + + erts_smp_proc_unlock(tracee_p, + (tracee_p == p + ? ERTS_PROC_LOCKS_ALL_MINOR + : ERTS_PROC_LOCKS_ALL)); + + matches = 1; + } else { + int ok = 0; + +#ifdef HAVE_ERTS_NOW_CPU + if (cpu_ts) { + if (pid_spec == am_all) { + if (on) { + if (!erts_cpu_timestamp) { +#ifdef HAVE_CLOCK_GETTIME + /* + Perhaps clock_gettime was found during config + on a different machine than this. We check + if it works here and now, then don't bother + about checking return value for error later. + */ + { + SysCpuTime start, stop; + SysTimespec tp; + int i; + + if (sys_get_proc_cputime(start, tp) < 0) + goto error; + start = ((SysCpuTime)tp.tv_sec * 1000000000LL) + + (SysCpuTime)tp.tv_nsec; + for (i = 0; i < 100; i++) + sys_get_proc_cputime(stop, tp); + stop = ((SysCpuTime)tp.tv_sec * 1000000000LL) + + (SysCpuTime)tp.tv_nsec; + if (start == 0) goto error; + if (start == stop) goto error; + } +#else /* HAVE_GETHRVTIME */ + if (erts_start_now_cpu() < 0) { + goto error; + } +#endif /* HAVE_CLOCK_GETTIME */ + erts_cpu_timestamp = !0; + } + } + } else { + goto error; + } + } +#endif + + if (pid_spec == am_all || pid_spec == am_existing) { + int i; + int procs = 0; + int ports = 0; + int mods = 0; + + if (mask & (ERTS_PROC_TRACEE_FLAGS & ~ERTS_TRACEE_MODIFIER_FLAGS)) + procs = 1; + if (mask & (ERTS_PORT_TRACEE_FLAGS & ~ERTS_TRACEE_MODIFIER_FLAGS)) + ports = 1; + if (mask & ERTS_TRACEE_MODIFIER_FLAGS) + mods = 1; + +#ifdef ERTS_SMP + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + system_blocked = 1; +#endif + + ok = 1; + if (procs || mods) { + /* tracing of processes */ + for (i = 0; i < erts_max_processes; i++) { + Process* tracee_p = process_tab[i]; + + if (! tracee_p) + continue; + if (tracer != NIL) { + if (tracee_p->id == tracer) + continue; + if (already_traced(NULL, tracee_p, tracer)) + continue; + } + if (on) { + tracee_p->trace_flags |= mask; + } else { + tracee_p->trace_flags &= ~mask; + } + if(!(tracee_p->trace_flags & TRACEE_FLAGS)) { + tracee_p->tracer_proc = NIL; + } else if (tracer != NIL) { + tracee_p->tracer_proc = tracer; + } + matches++; + } + } + if (ports || mods) { + /* tracing of ports */ + for (i = 0; i < erts_max_ports; i++) { + Port *tracee_port = &erts_port[i]; + if (tracee_port->status & ERTS_PORT_SFLGS_DEAD) continue; + if (tracer != NIL) { + if (tracee_port->id == tracer) continue; + if (port_already_traced(NULL, tracee_port, tracer)) continue; + } + + if (on) tracee_port->trace_flags |= mask; + else tracee_port->trace_flags &= ~mask; + + if (!(tracee_port->trace_flags & TRACEE_FLAGS)) { + tracee_port->tracer_proc = NIL; + } else if (tracer != NIL) { + tracee_port->tracer_proc = tracer; + } + /* matches are not counted for ports since it would violate compability */ + /* This could be a reason to modify this function or make a new one. */ + } + } + } + + if (pid_spec == am_all || pid_spec == am_new) { + Uint def_flags = mask; + Eterm def_tracer = tracer; + + ok = 1; + erts_change_default_tracing(on, &def_flags, &def_tracer); + +#ifdef HAVE_ERTS_NOW_CPU + if (cpu_ts && !on) { + /* cpu_ts => pid_spec == am_all */ + if (erts_cpu_timestamp) { +#ifdef HAVE_GETHRVTIME + erts_stop_now_cpu(); +#endif + erts_cpu_timestamp = 0; + } + } +#endif + } + + if (!ok) + goto error; + } + +#ifdef ERTS_SMP + if (system_blocked) { + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + } +#endif + + BIF_RET(make_small(matches)); + + already_traced: + erts_send_error_to_logger_str(p->group_leader, + "** can only have one tracer per process\n"); + + error: + +#ifdef ERTS_SMP + if (system_blocked) { + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + } +#endif + + BIF_ERROR(p, BADARG); +} + +/* Check that the process to be traced is not already traced + * by a valid other tracer than the tracer to be. + */ +static int port_already_traced(Process *c_p, Port *tracee_port, Eterm tracer) +{ + /* + * SMP build assumes that either system is blocked or: + * * main lock is held on c_p + * * all locks are held on port tracee_p + */ + if ((tracee_port->trace_flags & TRACEE_FLAGS) + && tracee_port->tracer_proc != tracer) { + /* This tracee is already being traced, and not by the + * tracer to be */ + if (is_internal_port(tracee_port->tracer_proc)) { + if (!erts_is_valid_tracer_port(tracee_port->tracer_proc)) { + /* Current trace port now invalid + * - discard it and approve the new. */ + goto remove_tracer; + } else + return 1; + } + else if(is_internal_pid(tracee_port->tracer_proc)) { + Process *tracer_p = erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN, + tracee_port->tracer_proc, 0); + if (!tracer_p) { + /* Current trace process now invalid + * - discard it and approve the new. */ + goto remove_tracer; + } else + return 1; + } + else { + remove_tracer: + tracee_port->trace_flags &= ~TRACEE_FLAGS; + tracee_port->tracer_proc = NIL; + } + } + return 0; +} + +/* Check that the process to be traced is not already traced + * by a valid other tracer than the tracer to be. + */ +static int already_traced(Process *c_p, Process *tracee_p, Eterm tracer) +{ + /* + * SMP build assumes that either system is blocked or: + * * main lock is held on c_p + * * all locks multiple are held on tracee_p + */ + if ((tracee_p->trace_flags & TRACEE_FLAGS) + && tracee_p->tracer_proc != tracer) { + /* This tracee is already being traced, and not by the + * tracer to be */ + if (is_internal_port(tracee_p->tracer_proc)) { + if (!erts_is_valid_tracer_port(tracee_p->tracer_proc)) { + /* Current trace port now invalid + * - discard it and approve the new. */ + goto remove_tracer; + } else + return 1; + } + else if(is_internal_pid(tracee_p->tracer_proc)) { + Process *tracer_p = erts_pid2proc(c_p, ERTS_PROC_LOCK_MAIN, + tracee_p->tracer_proc, 0); + if (!tracer_p) { + /* Current trace process now invalid + * - discard it and approve the new. */ + goto remove_tracer; + } else + return 1; + } + else { + remove_tracer: + tracee_p->trace_flags &= ~TRACEE_FLAGS; + tracee_p->tracer_proc = NIL; + } + } + return 0; +} + +/* + * Return information about a process or an external function being traced. + */ + +Eterm +trace_info_2(Process* p, Eterm What, Eterm Key) +{ + Eterm res; + if (What == am_on_load) { + res = trace_info_on_load(p, Key); + } else if (is_atom(What) || is_pid(What)) { + res = trace_info_pid(p, What, Key); + } else if (is_tuple(What)) { + res = trace_info_func(p, What, Key); + } else { + BIF_ERROR(p, BADARG); + } + BIF_RET(res); +} + +static Eterm +trace_info_pid(Process* p, Eterm pid_spec, Eterm key) +{ + Eterm tracer; + Uint trace_flags; + Eterm* hp; + + if (pid_spec == am_new) { + erts_get_default_tracing(&trace_flags, &tracer); + } else if (is_internal_pid(pid_spec) + && internal_pid_index(pid_spec) < erts_max_processes) { + Process *tracee; + tracee = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, + pid_spec, ERTS_PROC_LOCKS_ALL); + + if (!tracee) { + return am_undefined; + } else { + tracer = tracee->tracer_proc; + trace_flags = tracee->trace_flags; + } + + if (is_internal_pid(tracer)) { + if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, tracer, 0)) { + reset_tracer: + tracee->trace_flags &= ~TRACEE_FLAGS; + trace_flags = tracee->trace_flags; + tracer = tracee->tracer_proc = NIL; + } + } + else if (is_internal_port(tracer)) { + if (!erts_is_valid_tracer_port(tracer)) + goto reset_tracer; + } +#ifdef ERTS_SMP + erts_smp_proc_unlock(tracee, + (tracee == p + ? ERTS_PROC_LOCKS_ALL_MINOR + : ERTS_PROC_LOCKS_ALL)); +#endif + } else if (is_external_pid(pid_spec) + && external_pid_dist_entry(pid_spec) == erts_this_dist_entry) { + return am_undefined; + } else { + error: + BIF_ERROR(p, BADARG); + } + + if (key == am_flags) { + int num_flags = 19; /* MAXIMUM number of flags. */ + Uint needed = 3+2*num_flags; + Eterm flag_list = NIL; + Eterm* limit; + +#define FLAG0(flag_mask,flag) \ + if (trace_flags & (flag_mask)) { flag_list = CONS(hp, flag, flag_list); hp += 2; } else {} + +#if defined(DEBUG) + /* + * Check num_flags if this assertion fires. + */ +# define FLAG ASSERT(num_flags-- > 0); FLAG0 +#else +# define FLAG FLAG0 +#endif + hp = HAlloc(p, needed); + limit = hp+needed; + FLAG(F_TRACE_SEND, am_send); + FLAG(F_TRACE_RECEIVE, am_receive); + FLAG(F_TRACE_SOS, am_set_on_spawn); + FLAG(F_TRACE_CALLS, am_call); + FLAG(F_TRACE_PROCS, am_procs); + FLAG(F_TRACE_SOS1, am_set_on_first_spawn); + FLAG(F_TRACE_SOL, am_set_on_link); + FLAG(F_TRACE_SOL1, am_set_on_first_link); + FLAG(F_TRACE_SCHED, am_running); + FLAG(F_TRACE_SCHED_EXIT, am_exiting); + FLAG(F_TRACE_GC, am_garbage_collection); + FLAG(F_TIMESTAMP, am_timestamp); + FLAG(F_TRACE_ARITY_ONLY, am_arity); + FLAG(F_TRACE_RETURN_TO, am_return_to); + FLAG(F_TRACE_SILENT, am_silent); + FLAG(F_TRACE_SCHED_NO, am_scheduler_id); + FLAG(F_TRACE_PORTS, am_ports); + FLAG(F_TRACE_SCHED_PORTS, am_running_ports); + FLAG(F_TRACE_SCHED_PROCS, am_running_procs); +#undef FLAG0 +#undef FLAG + HRelease(p,limit,hp+3); + return TUPLE2(hp, key, flag_list); + } else if (key == am_tracer) { + hp = HAlloc(p, 3); + return TUPLE2(hp, key, tracer); /* Local pid or port */ + } else { + goto error; + } +} + +#define FUNC_TRACE_NOEXIST 0 +#define FUNC_TRACE_UNTRACED (1<<0) +#define FUNC_TRACE_GLOBAL_TRACE (1<<1) +#define FUNC_TRACE_LOCAL_TRACE (1<<2) +#define FUNC_TRACE_META_TRACE (1<<3) +#define FUNC_TRACE_COUNT_TRACE (1<<4) +/* + * Returns either FUNC_TRACE_NOEXIST, FUNC_TRACE_UNTRACED, + * FUNC_TRACE_GLOBAL_TRACE, or, + * an or'ed combination of at least one of FUNC_TRACE_LOCAL_TRACE, + * FUNC_TRACE_META_TRACE, FUNC_TRACE_COUNT_TRACE. + * + * If the return value contains FUNC_TRACE_GLOBAL_TRACE + * or FUNC_TRACE_LOCAL_TRACE *ms is set. + * + * If the return value contains FUNC_TRACE_META_TRACE, + * *ms_meta or *tracer_pid_meta is set. + * + * If the return value contains FUNC_TRACE_COUNT_TRACE, *count is set. + */ +static int function_is_traced(Eterm mfa[3], + Binary **ms, /* out */ + Binary **ms_meta, /* out */ + Eterm *tracer_pid_meta, /* out */ + Sint *count) /* out */ +{ + Export e; + Export* ep; + int i; + Uint *code; + + /* First look for an export entry */ + e.code[0] = mfa[0]; + e.code[1] = mfa[1]; + e.code[2] = mfa[2]; + if ((ep = export_get(&e)) != NULL) { + if (ep->address == ep->code+3 && + ep->code[3] != (Uint) em_call_error_handler) { + if (ep->code[3] == (Uint) em_call_traced_function) { + *ms = ep->match_prog_set; + return FUNC_TRACE_GLOBAL_TRACE; + } + if (ep->code[3] == (Uint) em_apply_bif) { + for (i = 0; i < BIF_SIZE; ++i) { + if (bif_export[i] == ep) { + int r = 0; + + if (erts_bif_trace_flags[i] & BIF_TRACE_AS_GLOBAL) { + *ms = ep->match_prog_set; + return FUNC_TRACE_GLOBAL_TRACE; + } else { + if (erts_bif_trace_flags[i] & BIF_TRACE_AS_LOCAL) { + r |= FUNC_TRACE_LOCAL_TRACE; + *ms = ep->match_prog_set; + } + if (erts_is_mtrace_bif(ep->code+3, ms_meta, + tracer_pid_meta)) { + r |= FUNC_TRACE_META_TRACE; + } + } + return r ? r : FUNC_TRACE_UNTRACED; + } + } + erl_exit(1,"Impossible ghost bif encountered in trace_info."); + } + } + } + + /* OK, now look for breakpoint tracing */ + if ((code = erts_find_local_func(mfa)) != NULL) { + int r = + (erts_is_trace_break(code, ms, NULL) + ? FUNC_TRACE_LOCAL_TRACE : 0) + | (erts_is_mtrace_break(code, ms_meta, tracer_pid_meta) + ? FUNC_TRACE_META_TRACE : 0) + | (erts_is_count_break(code, count) + ? FUNC_TRACE_COUNT_TRACE : 0); + + return r ? r : FUNC_TRACE_UNTRACED; + } + return FUNC_TRACE_NOEXIST; +} + +static Eterm +trace_info_func(Process* p, Eterm func_spec, Eterm key) +{ + Eterm* tp; + Eterm* hp; + Eterm mfa[3]; + Binary *ms = NULL, *ms_meta = NULL; + Sint count = 0; + Eterm traced = am_false; + Eterm match_spec = am_false; + Eterm retval = am_false; + Eterm meta = am_false; + int r; + + if (!is_tuple(func_spec)) { + goto error; + } + tp = tuple_val(func_spec); + if (tp[0] != make_arityval(3)) { + goto error; + } + if (!is_atom(tp[1]) || !is_atom(tp[2]) || !is_small(tp[3])) { + goto error; + } + mfa[0] = tp[1]; + mfa[1] = tp[2]; + mfa[2] = signed_val(tp[3]); + + r = function_is_traced(mfa, &ms, &ms_meta, &meta, &count); + switch (r) { + case FUNC_TRACE_NOEXIST: + hp = HAlloc(p, 3); + return TUPLE2(hp, key, am_undefined); + case FUNC_TRACE_UNTRACED: + hp = HAlloc(p, 3); + return TUPLE2(hp, key, am_false); + case FUNC_TRACE_GLOBAL_TRACE: + traced = am_global; + match_spec = NIL; /* Fix up later if it's asked for*/ + break; + default: + if (r & FUNC_TRACE_LOCAL_TRACE) { + traced = am_local; + match_spec = NIL; /* Fix up later if it's asked for*/ + } + break; + } + + switch (key) { + case am_traced: + retval = traced; + break; + case am_match_spec: + if (ms) { + match_spec = MatchSetGetSource(ms); + match_spec = copy_object(match_spec, p); + } + retval = match_spec; + break; + case am_meta: + retval = meta; + break; + case am_meta_match_spec: + if (r & FUNC_TRACE_META_TRACE) { + if (ms_meta) { + retval = MatchSetGetSource(ms_meta); + retval = copy_object(retval, p); + } else { + retval = NIL; + } + } + break; + case am_call_count: + if (r & FUNC_TRACE_COUNT_TRACE) { + retval = count < 0 ? + erts_make_integer(-count-1, p) : + erts_make_integer(count, p); + } + break; + case am_all: { + Eterm match_spec_meta = am_false, c = am_false, t; + + if (ms) { + match_spec = MatchSetGetSource(ms); + match_spec = copy_object(match_spec, p); + } + if (r & FUNC_TRACE_META_TRACE) { + if (ms_meta) { + match_spec_meta = MatchSetGetSource(ms_meta); + match_spec_meta = copy_object(match_spec_meta, p); + } else + match_spec_meta = NIL; + } + if (r & FUNC_TRACE_COUNT_TRACE) { + c = count < 0 ? + erts_make_integer(-count-1, p) : + erts_make_integer(count, p); + } + hp = HAlloc(p, (3+2)*5); + retval = NIL; + t = TUPLE2(hp, am_call_count, c); hp += 3; + retval = CONS(hp, t, retval); hp += 2; + t = TUPLE2(hp, am_meta_match_spec, match_spec_meta); hp += 3; + retval = CONS(hp, t, retval); hp += 2; + t = TUPLE2(hp, am_meta, meta); hp += 3; + retval = CONS(hp, t, retval); hp += 2; + t = TUPLE2(hp, am_match_spec, match_spec); hp += 3; + retval = CONS(hp, t, retval); hp += 2; + t = TUPLE2(hp, am_traced, traced); hp += 3; + retval = CONS(hp, t, retval); hp += 2; + } break; + default: + goto error; + } + hp = HAlloc(p, 3); + return TUPLE2(hp, key, retval); + + error: + BIF_ERROR(p, BADARG); +} + +static Eterm +trace_info_on_load(Process* p, Eterm key) +{ + Eterm* hp; + + if (! erts_default_trace_pattern_is_on) { + hp = HAlloc(p, 3); + return TUPLE2(hp, key, am_false); + } + switch (key) { + case am_traced: + { + Eterm traced = am_false; + + if (! erts_default_trace_pattern_flags.breakpoint) { + traced = am_global; + } else if (erts_default_trace_pattern_flags.local) { + traced = am_local; + } + hp = HAlloc(p, 3); + return TUPLE2(hp, key, traced); + } + case am_match_spec: + { + Eterm match_spec = am_false; + + if ((! erts_default_trace_pattern_flags.breakpoint) || + erts_default_trace_pattern_flags.local) { + if (erts_default_match_spec) { + match_spec = MatchSetGetSource(erts_default_match_spec); + match_spec = copy_object(match_spec, p); + hp = HAlloc(p, 3); + } else { + match_spec = NIL; + hp = HAlloc(p, 3); + } + } else { + hp = HAlloc(p, 3); + } + return TUPLE2(hp, key, match_spec); + } + case am_meta: + hp = HAlloc(p, 3); + if (erts_default_trace_pattern_flags.meta) { + return TUPLE2(hp, key, erts_default_meta_tracer_pid); + } else { + return TUPLE2(hp, key, am_false); + } + case am_meta_match_spec: + { + Eterm match_spec = am_false; + + if (erts_default_trace_pattern_flags.meta) { + if (erts_default_meta_match_spec) { + match_spec = + MatchSetGetSource(erts_default_meta_match_spec); + match_spec = copy_object(match_spec, p); + hp = HAlloc(p, 3); + } else { + match_spec = NIL; + hp = HAlloc(p, 3); + } + } else { + hp = HAlloc(p, 3); + } + return TUPLE2(hp, key, match_spec); + } + case am_call_count: + hp = HAlloc(p, 3); + if (erts_default_trace_pattern_flags.call_count) { + return TUPLE2(hp, key, am_true); + } else { + return TUPLE2(hp, key, am_false); + } + case am_all: + { + Eterm match_spec = am_false, meta_match_spec = am_false, r = NIL, t; + + if (erts_default_trace_pattern_flags.local || + (! erts_default_trace_pattern_flags.breakpoint)) { + match_spec = NIL; + } + if (erts_default_match_spec) { + match_spec = MatchSetGetSource(erts_default_match_spec); + match_spec = copy_object(match_spec, p); + } + if (erts_default_trace_pattern_flags.meta) { + meta_match_spec = NIL; + } + if (erts_default_meta_match_spec) { + meta_match_spec = + MatchSetGetSource(erts_default_meta_match_spec); + meta_match_spec = copy_object(meta_match_spec, p); + } + hp = HAlloc(p, (3+2)*5 + 3); + t = TUPLE2(hp, am_call_count, + (erts_default_trace_pattern_flags.call_count + ? am_true : am_false)); hp += 3; + r = CONS(hp, t, r); hp += 2; + t = TUPLE2(hp, am_meta_match_spec, meta_match_spec); hp += 3; + r = CONS(hp, t, r); hp += 2; + t = TUPLE2(hp, am_meta, + (erts_default_trace_pattern_flags.meta + ? erts_default_meta_tracer_pid : am_false)); hp += 3; + r = CONS(hp, t, r); hp += 2; + t = TUPLE2(hp, am_match_spec, match_spec); hp += 3; + r = CONS(hp, t, r); hp += 2; + t = TUPLE2(hp, am_traced, + (! erts_default_trace_pattern_flags.breakpoint ? + am_global : (erts_default_trace_pattern_flags.local ? + am_local : am_false))); hp += 3; + r = CONS(hp, t, r); hp += 2; + return TUPLE2(hp, key, r); + } + default: + BIF_ERROR(p, BADARG); + } +} + +#undef FUNC_TRACE_NOEXIST +#undef FUNC_TRACE_UNTRACED +#undef FUNC_TRACE_GLOBAL_TRACE +#undef FUNC_TRACE_LOCAL_TRACE + +int +erts_set_trace_pattern(Eterm* mfa, int specified, + Binary* match_prog_set, Binary *meta_match_prog_set, + int on, struct trace_pattern_flags flags, + Eterm meta_tracer_pid) +{ + int matches = 0; + int i; + + /* + * First work on normal functions (not real BIFs). + */ + + for (i = 0; i < export_list_size(); i++) { + Export* ep = export_list(i); + int j; + + if (ExportIsBuiltIn(ep)) { + continue; + } + + for (j = 0; j < specified && mfa[j] == ep->code[j]; j++) { + /* Empty loop body */ + } + if (j == specified) { + if (on) { + if (! flags.breakpoint) + matches += setup_func_trace(ep, match_prog_set); + else + reset_func_trace(ep); + } else if (! flags.breakpoint) { + matches += reset_func_trace(ep); + } + } + } + + /* + ** OK, now for the bif's + */ + for (i = 0; i < BIF_SIZE; ++i) { + Export *ep = bif_export[i]; + int j; + + if (!ExportIsBuiltIn(ep)) { + continue; + } + + if (bif_table[i].f == bif_table[i].traced) { + /* Trace wrapper same as regular function - untraceable */ + continue; + } + + for (j = 0; j < specified && mfa[j] == ep->code[j]; j++) { + /* Empty loop body */ + } + if (j == specified) { + if (! flags.breakpoint) { /* Export entry call trace */ + if (on) { + if (erts_bif_trace_flags[i] & BIF_TRACE_AS_META) { + ASSERT(ExportIsBuiltIn(bif_export[i])); + erts_clear_mtrace_bif + ((Uint *)bif_export[i]->code + 3); + erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_META; + } + set_trace_bif(i, match_prog_set); + erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_LOCAL; + erts_bif_trace_flags[i] |= BIF_TRACE_AS_GLOBAL; + setup_bif_trace(i); + } else { /* off */ + if (erts_bif_trace_flags[i] & BIF_TRACE_AS_GLOBAL) { + clear_trace_bif(i); + erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_GLOBAL; + } + if (! erts_bif_trace_flags[i]) { + reset_bif_trace(i); + } + } + matches++; + } else { /* Breakpoint call trace */ + int m = 0; + + if (on) { + if (flags.local) { + set_trace_bif(i, match_prog_set); + erts_bif_trace_flags[i] |= BIF_TRACE_AS_LOCAL; + erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_GLOBAL; + m = 1; + } + if (flags.meta) { + erts_set_mtrace_bif + ((Uint *)bif_export[i]->code + 3, + meta_match_prog_set, meta_tracer_pid); + erts_bif_trace_flags[i] |= BIF_TRACE_AS_META; + erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_GLOBAL; + m = 1; + } + if (erts_bif_trace_flags[i]) { + setup_bif_trace(i); + } + } else { /* off */ + if (flags.local) { + if (erts_bif_trace_flags[i] & BIF_TRACE_AS_LOCAL) { + clear_trace_bif(i); + erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_LOCAL; + } + m = 1; + } + if (flags.meta) { + if (erts_bif_trace_flags[i] & BIF_TRACE_AS_META) { + erts_clear_mtrace_bif + ((Uint *)bif_export[i]->code + 3); + erts_bif_trace_flags[i] &= ~BIF_TRACE_AS_META; + } + m = 1; + } + if (! erts_bif_trace_flags[i]) { + reset_bif_trace(i); + } + } + matches += m; + } + } + } + + /* + ** So, now for breakpoint tracing + */ + if (on) { + if (! flags.breakpoint) { + erts_clear_trace_break(mfa, specified); + erts_clear_mtrace_break(mfa, specified); + erts_clear_count_break(mfa, specified); + } else { + int m = 0; + if (flags.local) { + m = erts_set_trace_break(mfa, specified, match_prog_set, + am_true); + } + if (flags.meta) { + m = erts_set_mtrace_break(mfa, specified, meta_match_prog_set, + meta_tracer_pid); + } + if (flags.call_count) { + m = erts_set_count_break(mfa, specified, on); + } + /* All assignments to 'm' above should give the same value, + * so just use the last */ + matches += m; + } + } else { + int m = 0; + if (flags.local) { + m = erts_clear_trace_break(mfa, specified); + } + if (flags.meta) { + m = erts_clear_mtrace_break(mfa, specified); + } + if (flags.call_count) { + m = erts_clear_count_break(mfa, specified); + } + /* All assignments to 'm' above should give the same value, + * so just use the last */ + matches += m; + } + + return matches; +} + +/* + * Setup function tracing for the given exported function. + * + * Return Value: 1 if entry refers to a BIF or loaded function, + * 0 if the entry refers to a function not loaded. + */ + +static int +setup_func_trace(Export* ep, void* match_prog) +{ + if (ep->address == ep->code+3) { + if (ep->code[3] == (Uint) em_call_error_handler) { + return 0; + } else if (ep->code[3] == (Uint) em_call_traced_function) { + MatchSetUnref(ep->match_prog_set); + ep->match_prog_set = match_prog; + MatchSetRef(ep->match_prog_set); + return 1; + } else { + /* + * We ignore apply/3 and anything else. + */ + return 0; + } + } + + /* + * Currently no trace support for native code. + */ + if (erts_is_native_break(ep->address)) { + return 0; + } + + ep->code[3] = (Uint) em_call_traced_function; + ep->code[4] = (Uint) ep->address; + ep->address = ep->code+3; + ep->match_prog_set = match_prog; + MatchSetRef(ep->match_prog_set); + return 1; +} + +static void setup_bif_trace(int bif_index) { + Export *ep = bif_export[bif_index]; + + ASSERT(ExportIsBuiltIn(ep)); + ASSERT(ep->code[4]); + ep->code[4] = (Uint) bif_table[bif_index].traced; +} + +static void set_trace_bif(int bif_index, void* match_prog) { + Export *ep = bif_export[bif_index]; + +#ifdef HARDDEBUG + erts_fprintf(stderr, "set_trace_bif: %T:%T/%bpu\n", + ep->code[0], ep->code[1], ep->code[2]); +#endif + ASSERT(ExportIsBuiltIn(ep)); + MatchSetUnref(ep->match_prog_set); + ep->match_prog_set = match_prog; + MatchSetRef(ep->match_prog_set); +} + +/* + * Reset function tracing for the given exported function. + * + * Return Value: 1 if entry refers to a BIF or loaded function, + * 0 if the entry refers to a function not loaded. + */ + +static int +reset_func_trace(Export* ep) +{ + if (ep->address == ep->code+3) { + if (ep->code[3] == (Uint) em_call_error_handler) { + return 0; + } else if (ep->code[3] == (Uint) em_call_traced_function) { + ep->address = (Uint *) ep->code[4]; + MatchSetUnref(ep->match_prog_set); + ep->match_prog_set = NULL; + return 1; + } else { + /* + * We ignore apply/3 and anything else. + */ + return 0; + } + } + + /* + * Currently no trace support for native code. + */ + if (erts_is_native_break(ep->address)) { + return 0; + } + + /* + * Nothing to do, but the export entry matches. + */ + + return 1; +} + +static void reset_bif_trace(int bif_index) { + Export *ep = bif_export[bif_index]; + + ASSERT(ExportIsBuiltIn(ep)); + ASSERT(ep->code[4]); + ASSERT(! ep->match_prog_set); + ASSERT(! erts_is_mtrace_bif((Uint *)ep->code+3, NULL, NULL)); + ep->code[4] = (Uint) bif_table[bif_index].f; +} + +static void clear_trace_bif(int bif_index) { + Export *ep = bif_export[bif_index]; + +#ifdef HARDDEBUG + erts_fprintf(stderr, "clear_trace_bif: %T:%T/%bpu\n", + ep->code[0], ep->code[1], ep->code[2]); +#endif + ASSERT(ExportIsBuiltIn(ep)); + MatchSetUnref(ep->match_prog_set); + ep->match_prog_set = NULL; +} + +/* + * Sequential tracing + * + * The sequential trace token is internally implemented as + * a tuple + * {Flags, Label, Serial, Sender, LastSerial} + * + * where + * - Flags is an integer (using masks 1, 2, and 4, for send, + * receive and print, respectively), + * - Label is any term, Serial (for now XXX) is an integer (it should + * be a list reflecting split traces), and + * - Sender is the Pid of the sender (i.e. the current process, + * except immediately after a message reception, in case it is + * the pid of the process that sent the message). + * + */ + +BIF_RETTYPE seq_trace_2(BIF_ALIST_2) +{ + Eterm res; + res = erts_seq_trace(BIF_P, BIF_ARG_1, BIF_ARG_2, 1); + if (is_non_value(res)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(res); +} + +Eterm erts_seq_trace(Process *p, Eterm arg1, Eterm arg2, + int build_result) +{ + Eterm flags; + Eterm old_value = am_true; + Eterm* hp; + int current_flag; + + if (!is_atom(arg1)) { + return THE_NON_VALUE; + } + + + if (arg1 == am_send) { + current_flag = SEQ_TRACE_SEND; + } else if (arg1 == am_receive) { + current_flag = SEQ_TRACE_RECEIVE; + } else if (arg1 == am_print) { + current_flag = SEQ_TRACE_PRINT; + } else if (arg1 == am_timestamp) { + current_flag = SEQ_TRACE_TIMESTAMP; + } + else + current_flag = 0; + + if (current_flag && ( (arg2 == am_true) || (arg2 == am_false)) ) { + /* Flags */ + new_seq_trace_token(p); + flags = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(p)); + if (build_result) { + old_value = flags & current_flag ? am_true : am_false; + } + if (arg2 == am_true) + SEQ_TRACE_TOKEN_FLAGS(p) = make_small(flags|current_flag); + else if (arg2 == am_false) + SEQ_TRACE_TOKEN_FLAGS(p) = make_small(flags&~current_flag); + else { + return THE_NON_VALUE; + } + return old_value; + } + else if (arg1 == am_label) { + if (! is_small(arg2)) { + return THE_NON_VALUE; + } + new_seq_trace_token(p); + if (build_result) { + old_value = SEQ_TRACE_TOKEN_LABEL(p); + } + SEQ_TRACE_TOKEN_LABEL(p) = arg2; + return old_value; + } + else if (arg1 == am_serial) { + Eterm* tp; + if (is_not_tuple(arg2)) { + return THE_NON_VALUE; + } + tp = tuple_val(arg2); + if ((*tp != make_arityval(2)) || is_not_small(*(tp+1)) || is_not_small(*(tp+2))) { + return THE_NON_VALUE; + } + new_seq_trace_token(p); + if (build_result) { + hp = HAlloc(p,3); + old_value = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(p), + SEQ_TRACE_TOKEN_SERIAL(p)); + } + SEQ_TRACE_TOKEN_LASTCNT(p) = *(tp+1); + SEQ_TRACE_TOKEN_SERIAL(p) = *(tp+2); + p->seq_trace_clock = unsigned_val(*(tp+2)); + p->seq_trace_lastcnt = unsigned_val(*(tp+1)); + return old_value; + } + else if (arg1 == am_sequential_trace_token) { + if (is_not_nil(arg2)) { + return THE_NON_VALUE; + } + if (build_result) { + old_value = SEQ_TRACE_TOKEN(p); + } + SEQ_TRACE_TOKEN(p) = NIL; + return old_value; + } + else { + return THE_NON_VALUE; + } +} + +void +new_seq_trace_token(Process* p) +{ + Eterm* hp; + + if (SEQ_TRACE_TOKEN(p) == NIL) { + hp = HAlloc(p, 6); + SEQ_TRACE_TOKEN(p) = TUPLE5(hp, make_small(0), /* Flags */ + make_small(0), /* Label */ + make_small(0), /* Serial */ + p->id, /* Internal pid */ /* From */ + make_small(p->seq_trace_lastcnt)); + } +} + +BIF_RETTYPE seq_trace_info_1(BIF_ALIST_1) +{ + Eterm item; + Eterm res; + Eterm* hp; + Uint current_flag; + + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + + item = BIF_ARG_1; + + if (SEQ_TRACE_TOKEN(BIF_P) == NIL) { + if ((item == am_send) || (item == am_receive) || + (item == am_print) || (item == am_timestamp)) { + hp = HAlloc(BIF_P,3); + res = TUPLE2(hp, item, am_false); + BIF_RET(res); + } else if ((item == am_label) || (item == am_serial)) { + BIF_RET(NIL); + } else { + goto error; + } + } + + if (BIF_ARG_1 == am_send) { + current_flag = SEQ_TRACE_SEND; + } else if (BIF_ARG_1 == am_receive) { + current_flag = SEQ_TRACE_RECEIVE; + } else if (BIF_ARG_1 == am_print) { + current_flag = SEQ_TRACE_PRINT; + } else if (BIF_ARG_1 == am_timestamp) { + current_flag = SEQ_TRACE_TIMESTAMP; + } else { + current_flag = 0; + } + + if (current_flag) { + res = unsigned_val(SEQ_TRACE_TOKEN_FLAGS(BIF_P)) & current_flag ? + am_true : am_false; + } else if (item == am_label) { + res = SEQ_TRACE_TOKEN_LABEL(BIF_P); + } else if (item == am_serial) { + hp = HAlloc(BIF_P, 3); + res = TUPLE2(hp, SEQ_TRACE_TOKEN_LASTCNT(BIF_P), SEQ_TRACE_TOKEN_SERIAL(BIF_P)); + } else { + error: + BIF_ERROR(BIF_P, BADARG); + } + hp = HAlloc(BIF_P, 3); + res = TUPLE2(hp, item, res); + BIF_RET(res); +} + +/* + seq_trace_print(Message) -> true | false + This function passes Message to the system_tracer + if the trace_token is not NIL. + Returns true if Message is passed else false + Note! That true is returned if the conditions to pass Message is + fulfilled, but nothing is passed if system_seq_tracer is not set. + */ +BIF_RETTYPE seq_trace_print_1(BIF_ALIST_1) +{ + if (SEQ_TRACE_TOKEN(BIF_P) == NIL) + BIF_RET(am_false); + seq_trace_update_send(BIF_P); + seq_trace_output(SEQ_TRACE_TOKEN(BIF_P), BIF_ARG_1, + SEQ_TRACE_PRINT, NIL, BIF_P); + BIF_RET(am_true); +} + +/* + seq_trace_print(Label,Message) -> true | false + This function passes Message to the system_tracer + if the trace_token is not NIL and the trace_token label is equal to + Label. Returns true if Message is passed else false + Note! That true is returned if the conditions to pass Message is + fulfilled, but nothing is passed if system_seq_tracer is not set. + */ +BIF_RETTYPE seq_trace_print_2(BIF_ALIST_2) +{ + if (SEQ_TRACE_TOKEN(BIF_P) == NIL) + BIF_RET(am_false); + if (!(is_atom(BIF_ARG_1) || is_small(BIF_ARG_1))) { + BIF_ERROR(BIF_P, BADARG); + } + if (SEQ_TRACE_TOKEN_LABEL(BIF_P) != BIF_ARG_1) + BIF_RET(am_false); + seq_trace_update_send(BIF_P); + seq_trace_output(SEQ_TRACE_TOKEN(BIF_P), BIF_ARG_2, + SEQ_TRACE_PRINT, NIL, BIF_P); + BIF_RET(am_true); +} + +void erts_system_monitor_clear(Process *c_p) { +#ifdef ERTS_SMP + if (c_p) { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + } +#endif + erts_set_system_monitor(NIL); + erts_system_monitor_long_gc = 0; + erts_system_monitor_large_heap = 0; + erts_system_monitor_flags.busy_port = 0; + erts_system_monitor_flags.busy_dist_port = 0; +#ifdef ERTS_SMP + if (c_p) { + erts_smp_release_system(); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + } +#endif +} + + +static Eterm system_monitor_get(Process *p) +{ + Eterm *hp; + Eterm system_monitor = erts_get_system_monitor(); + + if (system_monitor == NIL) { + return am_undefined; + } else { + Eterm res; + Uint hsz = 3 + (erts_system_monitor_flags.busy_dist_port ? 2 : 0) + + (erts_system_monitor_flags.busy_port ? 2 : 0); + Eterm long_gc = NIL; + Eterm large_heap = NIL; + + if (erts_system_monitor_long_gc != 0) { + hsz += 2+3; + (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_long_gc); + } + if (erts_system_monitor_large_heap != 0) { + hsz += 2+3; + (void) erts_bld_uint(NULL, &hsz, erts_system_monitor_large_heap); + } + + hp = HAlloc(p, hsz); + if (erts_system_monitor_long_gc != 0) { + long_gc = erts_bld_uint(&hp, NULL, erts_system_monitor_long_gc); + } + if (erts_system_monitor_large_heap != 0) { + large_heap = erts_bld_uint(&hp, NULL, erts_system_monitor_large_heap); + } + res = NIL; + if (long_gc != NIL) { + Eterm t = TUPLE2(hp, am_long_gc, long_gc); hp += 3; + res = CONS(hp, t, res); hp += 2; + } + if (large_heap != NIL) { + Eterm t = TUPLE2(hp, am_large_heap, large_heap); hp += 3; + res = CONS(hp, t, res); hp += 2; + } + if (erts_system_monitor_flags.busy_port) { + res = CONS(hp, am_busy_port, res); hp += 2; + } + if (erts_system_monitor_flags.busy_dist_port) { + res = CONS(hp, am_busy_dist_port, res); hp += 2; + } + return TUPLE2(hp, system_monitor, res); + } +} + + +BIF_RETTYPE system_monitor_0(Process *p) { + BIF_RET(system_monitor_get(p)); +} + +BIF_RETTYPE system_monitor_1(Process *p, Eterm spec) { + if (spec == am_undefined) { + BIF_RET(system_monitor_2(p, spec, NIL)); + } else if (is_tuple(spec)) { + Eterm *tp = tuple_val(spec); + if (tp[0] != make_arityval(2)) goto error; + BIF_RET(system_monitor_2(p, tp[1], tp[2])); + } + error: + BIF_ERROR(p, BADARG); +} + +BIF_RETTYPE system_monitor_2(Process *p, Eterm monitor_pid, Eterm list) { + Eterm prev; + int system_blocked = 0; + + if (monitor_pid == am_undefined || list == NIL) { + prev = system_monitor_get(p); + erts_system_monitor_clear(p); + BIF_RET(prev); + } + if (is_not_list(list)) goto error; + else { + Uint long_gc, large_heap; + int busy_port, busy_dist_port; + + system_blocked = 1; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, monitor_pid, 0)) + goto error; + + for (long_gc = 0, large_heap = 0, busy_port = 0, busy_dist_port = 0; + is_list(list); + list = CDR(list_val(list))) { + Eterm t = CAR(list_val(list)); + if (is_tuple(t)) { + Eterm *tp = tuple_val(t); + if (arityval(tp[0]) != 2) goto error; + if (tp[1] == am_long_gc) { + if (! term_to_Uint(tp[2], &long_gc)) goto error; + if (long_gc < 1) long_gc = 1; + } else if (tp[1] == am_large_heap) { + if (! term_to_Uint(tp[2], &large_heap)) goto error; + if (large_heap < 16384) large_heap = 16384; + /* 16 Kword is not an unnatural heap size */ + } else goto error; + } else if (t == am_busy_port) { + busy_port = !0; + } else if (t == am_busy_dist_port) { + busy_dist_port = !0; + } else goto error; + } + if (is_not_nil(list)) goto error; + prev = system_monitor_get(p); + erts_set_system_monitor(monitor_pid); + erts_system_monitor_long_gc = long_gc; + erts_system_monitor_large_heap = large_heap; + erts_system_monitor_flags.busy_port = !!busy_port; + erts_system_monitor_flags.busy_dist_port = !!busy_dist_port; + + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + BIF_RET(prev); + } + + error: + + if (system_blocked) { + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + } + + BIF_ERROR(p, BADARG); +} + +/* Begin: Trace for System Profiling */ + +void erts_system_profile_clear(Process *c_p) { +#ifdef ERTS_SMP + if (c_p) { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + } +#endif + erts_set_system_profile(NIL); + erts_system_profile_flags.scheduler = 0; + erts_system_profile_flags.runnable_procs = 0; + erts_system_profile_flags.runnable_ports = 0; + erts_system_profile_flags.exclusive = 0; +#ifdef ERTS_SMP + if (c_p) { + erts_smp_release_system(); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + } +#endif +} + +static Eterm system_profile_get(Process *p) { + Eterm *hp; + Eterm system_profile = erts_get_system_profile(); + if (system_profile == NIL) { + return am_undefined; + } else { + Eterm res; + Uint hsz = 3 + + (erts_system_profile_flags.scheduler ? 2 : 0) + + (erts_system_profile_flags.runnable_ports ? 2 : 0) + + (erts_system_profile_flags.exclusive ? 2 : 0) + + (erts_system_profile_flags.runnable_procs ? 2 : 0); + + hp = HAlloc(p, hsz); + res = NIL; + if (erts_system_profile_flags.runnable_ports) { + res = CONS(hp, am_runnable_ports, res); hp += 2; + } + if (erts_system_profile_flags.runnable_procs) { + res = CONS(hp, am_runnable_procs, res); hp += 2; + } + if (erts_system_profile_flags.scheduler) { + res = CONS(hp, am_scheduler, res); hp += 2; + } + if (erts_system_profile_flags.exclusive) { + res = CONS(hp, am_exclusive, res); hp += 2; + } + return TUPLE2(hp, system_profile, res); + } +} + +BIF_RETTYPE system_profile_0(Process *p) { + BIF_RET(system_profile_get(p)); +} + +BIF_RETTYPE system_profile_2(Process *p, Eterm profiler, Eterm list) { + Eterm prev; + int system_blocked = 0; + Process *profiler_p = NULL; + Port *profiler_port = NULL; + + if (profiler == am_undefined || list == NIL) { + prev = system_profile_get(p); + erts_system_profile_clear(p); + BIF_RET(prev); + } + if (is_not_list(list)) { + goto error; + } else { + int scheduler, runnable_procs, runnable_ports, exclusive; + system_blocked = 1; + + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + /* Check if valid process, no locks are taken */ + + if (is_internal_pid(profiler)) { + if (internal_pid_index(profiler) >= erts_max_processes) goto error; + profiler_p = process_tab[internal_pid_index(profiler)]; + if (INVALID_PID(profiler_p, profiler)) goto error; + } else if (is_internal_port(profiler)) { + if (internal_port_index(profiler) >= erts_max_ports) goto error; + profiler_port = &erts_port[internal_port_index(profiler)]; + if (INVALID_TRACER_PORT(profiler_port, profiler)) goto error; + } else { + goto error; + } + + for (scheduler = 0, runnable_ports = 0, runnable_procs = 0, exclusive = 0; + is_list(list); + list = CDR(list_val(list))) { + + Eterm t = CAR(list_val(list)); + if (t == am_runnable_procs) { + runnable_procs = !0; + } else if (t == am_runnable_ports) { + runnable_ports = !0; + } else if (t == am_exclusive) { + exclusive = !0; + } else if (t == am_scheduler) { + scheduler = !0; + } else goto error; + } + if (is_not_nil(list)) goto error; + prev = system_profile_get(p); + erts_set_system_profile(profiler); + + erts_system_profile_flags.scheduler = !!scheduler; + if (erts_system_profile_flags.scheduler) + erts_system_profile_setup_active_schedulers(); + erts_system_profile_flags.runnable_ports = !!runnable_ports; + erts_system_profile_flags.runnable_procs = !!runnable_procs; + erts_system_profile_flags.exclusive = !!exclusive; + + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + + BIF_RET(prev); + + } + + error: + if (system_blocked) { + erts_smp_release_system(); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + } + + BIF_ERROR(p, BADARG); +} +/* End: Trace for System Profiling */ + +BIF_RETTYPE +trace_delivered_1(BIF_ALIST_1) +{ + DECL_AM(trace_delivered); +#ifdef ERTS_SMP + ErlHeapFragment *bp; +#else + ErtsProcLocks locks = 0; +#endif + Eterm *hp; + Eterm msg, ref, msg_ref; + Process *p; + if (BIF_ARG_1 == am_all) { + p = NULL; + } else if (! (p = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCKS_ALL))) { + if (is_not_internal_pid(BIF_ARG_1) + || internal_pid_index(BIF_ARG_1) >= erts_max_processes) { + BIF_ERROR(BIF_P, BADARG); + } + } + + ref = erts_make_ref(BIF_P); + +#ifdef ERTS_SMP + bp = new_message_buffer(REF_THING_SIZE + 4); + hp = &bp->mem[0]; + msg_ref = STORE_NC(&hp, &bp->off_heap.externals, ref); +#else + hp = HAlloc(BIF_P, 4); + msg_ref = ref; +#endif + + msg = TUPLE3(hp, AM_trace_delivered, BIF_ARG_1, msg_ref); + +#ifdef ERTS_SMP + erts_send_sys_msg_proc(BIF_P->id, BIF_P->id, msg, bp); + if (p) + erts_smp_proc_unlock(p, + (BIF_P == p + ? ERTS_PROC_LOCKS_ALL_MINOR + : ERTS_PROC_LOCKS_ALL)); +#else + erts_send_message(BIF_P, BIF_P, &locks, msg, ERTS_SND_FLG_NO_SEQ_TRACE); +#endif + + BIF_RET(ref); +} diff --git a/erts/emulator/beam/erl_binary.h b/erts/emulator/beam/erl_binary.h new file mode 100644 index 0000000000..dc5539faad --- /dev/null +++ b/erts/emulator/beam/erl_binary.h @@ -0,0 +1,282 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERL_BINARY_H +#define __ERL_BINARY_H + +#include "erl_threads.h" + +/* + * Maximum number of bytes to place in a heap binary. + */ + +#define ERL_ONHEAP_BIN_LIMIT 64 + +/* + * This structure represents a SUB_BINARY. + * + * Note: The last field (orig) is not counted in arityval in the header. + * This simplifies garbage collection. + */ + +typedef struct erl_sub_bin { + Eterm thing_word; /* Subtag SUB_BINARY_SUBTAG. */ + Uint size; /* Binary size in bytes. */ + Uint offs; /* Offset into original binary. */ + byte bitsize; + byte bitoffs; + byte is_writable; /* The underlying binary is writable */ + Eterm orig; /* Original binary (REFC or HEAP binary). */ +} ErlSubBin; + +#define ERL_SUB_BIN_SIZE (sizeof(ErlSubBin)/sizeof(Eterm)) +#define HEADER_SUB_BIN _make_header(ERL_SUB_BIN_SIZE-2,_TAG_HEADER_SUB_BIN) + +/* + * This structure represents a HEAP_BINARY. + */ + +typedef struct erl_heap_bin { + Eterm thing_word; /* Subtag HEAP_BINARY_SUBTAG. */ + Uint size; /* Binary size in bytes. */ + Eterm data[1]; /* The data in the binary. */ +} ErlHeapBin; + +#define heap_bin_size(num_bytes) \ + (sizeof(ErlHeapBin)/sizeof(Eterm) - 1 + \ + ((num_bytes)+sizeof(Eterm)-1)/sizeof(Eterm)) + +#define header_heap_bin(num_bytes) \ + _make_header(heap_bin_size(num_bytes)-1,_TAG_HEADER_HEAP_BIN) + +/* + * Get the size in bytes of any type of binary. + */ + +#define binary_size(Bin) (binary_val(Bin)[1]) + +#define binary_bitsize(Bin) \ + ((*binary_val(Bin) == HEADER_SUB_BIN) ? \ + ((ErlSubBin *) binary_val(Bin))->bitsize: \ + 0) + +#define binary_bitoffset(Bin) \ + ((*binary_val(Bin) == HEADER_SUB_BIN) ? \ + ((ErlSubBin *) binary_val(Bin))->bitoffs: \ + 0) + +/* + * Get the pointer to the actual data bytes in a binary. + * Works for any type of binary. Always use binary_bytes() if + * you know that the binary cannot be a sub binary. + * + * Bin: input variable (Eterm) + * Bytep: output variable (byte *) + * Bitoffs: output variable (Uint) + * Bitsize: output variable (Uint) + */ + +#define ERTS_GET_BINARY_BYTES(Bin,Bytep,Bitoffs,Bitsize) \ +do { \ + Eterm* _real_bin = binary_val(Bin); \ + Uint _offs = 0; \ + Bitoffs = Bitsize = 0; \ + if (*_real_bin == HEADER_SUB_BIN) { \ + ErlSubBin* _sb = (ErlSubBin *) _real_bin; \ + _offs = _sb->offs; \ + Bitoffs = _sb->bitoffs; \ + Bitsize = _sb->bitsize; \ + _real_bin = binary_val(_sb->orig); \ + } \ + if (*_real_bin == HEADER_PROC_BIN) { \ + Bytep = ((ProcBin *) _real_bin)->bytes + _offs; \ + } else { \ + Bytep = (byte *)(&(((ErlHeapBin *) _real_bin)->data)) + _offs; \ + } \ +} while (0) + +/* + * Get the real binary from any binary type, where "real" means + * a REFC or HEAP binary. Also get the byte and bit offset into the + * real binary. Useful if you want to build a SUB binary from + * any binary. + * + * Bin: Input variable (Eterm) + * RealBin: Output variable (Eterm) + * ByteOffset: Output variable (Uint) + * BitOffset: Offset in bits (Uint) + * BitSize: Extra bit size (Uint) + */ + +#define ERTS_GET_REAL_BIN(Bin, RealBin, ByteOffset, BitOffset, BitSize) \ + do { \ + ErlSubBin* _sb = (ErlSubBin *) binary_val(Bin); \ + if (_sb->thing_word == HEADER_SUB_BIN) { \ + RealBin = _sb->orig; \ + ByteOffset = _sb->offs; \ + BitOffset = _sb->bitoffs; \ + BitSize = _sb->bitsize; \ + } else { \ + RealBin = Bin; \ + ByteOffset = BitOffset = BitSize = 0; \ + } \ + } while (0) + +/* + * Get a pointer to the binary bytes, for a heap or refc binary + * (NOT sub binary). + */ +#define binary_bytes(Bin) \ + (*binary_val(Bin) == HEADER_PROC_BIN ? \ + ((ProcBin *) binary_val(Bin))->bytes : \ + (ASSERT_EXPR(thing_subtag(*binary_val(Bin)) == HEAP_BINARY_SUBTAG), \ + (byte *)(&(((ErlHeapBin *) binary_val(Bin))->data)))) + +void erts_init_binary(void); + +byte* erts_get_aligned_binary_bytes(Eterm, byte**); + +#if defined(__i386__) || !defined(__GNUC__) +/* + * Doubles aren't required to be 8-byte aligned on intel x86. + * (if not gnuc we don't know if __i386__ is defined on x86; + * therefore, assume intel x86...) + */ +# define ERTS_BIN_ALIGNMENT_MASK ((Uint) 3) +#else +# define ERTS_BIN_ALIGNMENT_MASK ((Uint) 7) +#endif + +#define ERTS_CHK_BIN_ALIGNMENT(B) \ + do { ASSERT(!(B) || (((Uint) &((Binary *)(B))->orig_bytes[0]) & ERTS_BIN_ALIGNMENT_MASK) == ((Uint) 0)) } while(0) + +ERTS_GLB_INLINE void erts_free_aligned_binary_bytes(byte* buf); +ERTS_GLB_INLINE Binary *erts_bin_drv_alloc_fnf(Uint size); +ERTS_GLB_INLINE Binary *erts_bin_drv_alloc(Uint size); +ERTS_GLB_INLINE Binary *erts_bin_nrml_alloc(Uint size); +ERTS_GLB_INLINE Binary *erts_bin_realloc_fnf(Binary *bp, Uint size); +ERTS_GLB_INLINE Binary *erts_bin_realloc(Binary *bp, Uint size); +ERTS_GLB_INLINE void erts_bin_free(Binary *bp); +ERTS_GLB_INLINE Binary *erts_create_magic_binary(Uint size, + void (*destructor)(Binary *)); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_free_aligned_binary_bytes(byte* buf) +{ + if (buf) { + erts_free(ERTS_ALC_T_TMP, (void *) buf); + } +} + +ERTS_GLB_INLINE Binary * +erts_bin_drv_alloc_fnf(Uint size) +{ + Uint bsize = sizeof(Binary) - 1 + size; + void *res; + res = erts_alloc_fnf(ERTS_ALC_T_DRV_BINARY, bsize); + ERTS_CHK_BIN_ALIGNMENT(res); + return (Binary *) res; +} + +ERTS_GLB_INLINE Binary * +erts_bin_drv_alloc(Uint size) +{ + Uint bsize = sizeof(Binary) - 1 + size; + void *res; + res = erts_alloc(ERTS_ALC_T_DRV_BINARY, bsize); + ERTS_CHK_BIN_ALIGNMENT(res); + return (Binary *) res; +} + + +ERTS_GLB_INLINE Binary * +erts_bin_nrml_alloc(Uint size) +{ + Uint bsize = sizeof(Binary) - 1 + size; + void *res; + res = erts_alloc(ERTS_ALC_T_BINARY, bsize); + ERTS_CHK_BIN_ALIGNMENT(res); + return (Binary *) res; +} + +ERTS_GLB_INLINE Binary * +erts_bin_realloc_fnf(Binary *bp, Uint size) +{ + Binary *nbp; + Uint bsize = sizeof(Binary) - 1 + size; + ASSERT((bp->flags & BIN_FLAG_MAGIC) == 0); + if (bp->flags & BIN_FLAG_DRV) + nbp = erts_realloc_fnf(ERTS_ALC_T_DRV_BINARY, (void *) bp, bsize); + else + nbp = erts_realloc_fnf(ERTS_ALC_T_BINARY, (void *) bp, bsize); + ERTS_CHK_BIN_ALIGNMENT(nbp); + return nbp; +} + +ERTS_GLB_INLINE Binary * +erts_bin_realloc(Binary *bp, Uint size) +{ + Binary *nbp; + Uint bsize = sizeof(Binary) - 1 + size; + ASSERT((bp->flags & BIN_FLAG_MAGIC) == 0); + if (bp->flags & BIN_FLAG_DRV) + nbp = erts_realloc_fnf(ERTS_ALC_T_DRV_BINARY, (void *) bp, bsize); + else + nbp = erts_realloc_fnf(ERTS_ALC_T_BINARY, (void *) bp, bsize); + if (!nbp) + erts_realloc_n_enomem(ERTS_ALC_T2N(bp->flags & BIN_FLAG_DRV + ? ERTS_ALC_T_DRV_BINARY + : ERTS_ALC_T_BINARY), + bp, + bsize); + ERTS_CHK_BIN_ALIGNMENT(nbp); + return nbp; +} + +ERTS_GLB_INLINE void +erts_bin_free(Binary *bp) +{ + if (bp->flags & BIN_FLAG_MAGIC) + ERTS_MAGIC_BIN_DESTRUCTOR(bp)(bp); + if (bp->flags & BIN_FLAG_DRV) + erts_free(ERTS_ALC_T_DRV_BINARY, (void *) bp); + else + erts_free(ERTS_ALC_T_BINARY, (void *) bp); +} + +ERTS_GLB_INLINE Binary * +erts_create_magic_binary(Uint size, void (*destructor)(Binary *)) +{ + Uint bsize = sizeof(Binary) - 1 + sizeof(ErtsBinaryMagicPart) - 1 + size; + Binary* bptr = erts_alloc_fnf(ERTS_ALC_T_BINARY, bsize); + if (!bptr) + erts_alloc_n_enomem(ERTS_ALC_T2N(ERTS_ALC_T_BINARY), bsize); + ERTS_CHK_BIN_ALIGNMENT(bptr); + bptr->flags = BIN_FLAG_MAGIC; + bptr->orig_size = sizeof(ErtsBinaryMagicPart) - 1 + size; + erts_refc_init(&bptr->refc, 0); + ERTS_MAGIC_BIN_DESTRUCTOR(bptr) = destructor; + return bptr; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif diff --git a/erts/emulator/beam/erl_bits.c b/erts/emulator/beam/erl_bits.c new file mode 100644 index 0000000000..e4f5d50ddf --- /dev/null +++ b/erts/emulator/beam/erl_bits.c @@ -0,0 +1,1975 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "big.h" +#include "erl_bits.h" +#include "erl_binary.h" + +#ifdef MAX +#undef MAX +#endif +#define MAX(x,y) (((x)>(y))?(x):(y)) +#ifdef MIN +#undef MIN +#endif +#define MIN(x,y) (((x)<(y))?(x):(y)) + +#if defined(WORDS_BIGENDIAN) +# define BIT_ENDIAN_MACHINE 0 +#else +# define BIT_ENDIAN_MACHINE BSF_LITTLE +#endif + +#define BIT_IS_MACHINE_ENDIAN(x) (((x)&BSF_LITTLE) == BIT_ENDIAN_MACHINE) + +/* + * MAKE_MASK(n) constructs a mask with n bits. + * Example: MAKE_MASK(3) returns the binary number 00000111. + */ + +#define MAKE_MASK(n) ((((Uint) 1) << (n))-1) + +/* + * MASK_BITS assign src to dst, but preserves the dst bits outside the mask. + */ + +#define MASK_BITS(src,dst,mask) (((src) & (mask)) | ((dst) & ~(mask))) + +static byte get_bit(byte b, size_t a_offs); + +#if defined(ERTS_SMP) +/* the state resides in the current process' scheduler data */ +#elif defined(ERL_BITS_REENTRANT) +/* reentrant API but with a hidden single global state, for testing only */ +struct erl_bits_state ErlBitsState_; +#else +/* non-reentrant API with a single global state */ +struct erl_bits_state ErlBitsState; +#endif + +#define byte_buf (ErlBitsState.byte_buf_) +#define byte_buf_len (ErlBitsState.byte_buf_len_) + +#ifdef ERTS_SMP +static erts_smp_atomic_t bits_bufs_size; +#endif + +Uint +erts_bits_bufs_size(void) +{ + return 0; +} + +#if !defined(ERTS_SMP) +static +#endif +void +erts_bits_init_state(ERL_BITS_PROTO_0) +{ + byte_buf_len = 1; + byte_buf = erts_alloc(ERTS_ALC_T_BITS_BUF, byte_buf_len); + + erts_bin_offset = 0; +} + +#if defined(ERTS_SMP) +void +erts_bits_destroy_state(ERL_BITS_PROTO_0) +{ + erts_free(ERTS_ALC_T_BITS_BUF, byte_buf); +} +#endif + +void +erts_init_bits(void) +{ +#if defined(ERTS_SMP) + erts_smp_atomic_init(&bits_bufs_size, 0); + /* erl_process.c calls erts_bits_init_state() on all state instances */ +#else + ERL_BITS_DECLARE_STATEP; + erts_bits_init_state(ERL_BITS_ARGS_0); +#endif +} + +/***************************************************************** + *** + *** New matching binaries functions + *** + *****************************************************************/ + +#define ReadToVariable(v64, Buffer, x) \ + do{ \ + int _i; \ + v64 = 0; \ + for(_i = 0; _i < x; _i++) { \ + v64 = ((Uint)Buffer[_i] <<(8*_i)) + v64; \ + } \ + }while(0) \ + +Eterm +erts_bs_start_match_2(Process *p, Eterm Binary, Uint Max) +{ + Eterm Orig; + Uint offs; + Uint* hp; + Uint NeededSize; + ErlBinMatchState *ms; + Uint bitoffs; + Uint bitsize; + Uint total_bin_size; + ProcBin* pb; + + ASSERT(is_binary(Binary)); + total_bin_size = binary_size(Binary); + if ((total_bin_size >> (8*sizeof(Uint)-3)) != 0) { + return THE_NON_VALUE; + } + NeededSize = ERL_BIN_MATCHSTATE_SIZE(Max); + hp = HeapOnlyAlloc(p, NeededSize); + ms = (ErlBinMatchState *) hp; + ERTS_GET_REAL_BIN(Binary, Orig, offs, bitoffs, bitsize); + pb = (ProcBin *) boxed_val(Orig); + if (pb->thing_word == HEADER_PROC_BIN && pb->flags != 0) { + erts_emasculate_writable_binary(pb); + } + ms->thing_word = HEADER_BIN_MATCHSTATE(Max); + (ms->mb).orig = Orig; + (ms->mb).base = binary_bytes(Orig); + (ms->mb).offset = ms->save_offset[0] = 8 * offs + bitoffs; + (ms->mb).size = total_bin_size * 8 + (ms->mb).offset + bitsize; + return make_matchstate(ms); +} + +Eterm +erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb) +{ + Uint bytes; + Uint bits; + Uint offs; + byte bigbuf[64]; + byte* LSB; + byte* MSB; + Uint* hp; + Uint* hp_end; + Uint words_needed; + Uint actual; + Uint v32; + int sgn = 0; + Eterm res = THE_NON_VALUE; + + if (num_bits == 0) { + return SMALL_ZERO; + } + + if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */ + return THE_NON_VALUE; + } + + /* + * Special cases for field sizes up to the size of Uint. + */ + + if (num_bits <= 8-(offs = BIT_OFFSET(mb->offset))) { + /* + * All bits are in one byte in the binary. We only need + * shift them right and mask them. + */ + Uint b = mb->base[BYTE_OFFSET(mb->offset)]; + Uint mask = MAKE_MASK(num_bits); + mb->offset += num_bits; + b >>= 8 - offs - num_bits; + b &= mask; + if ((flags & BSF_SIGNED) && b >> (num_bits-1)) { + b |= ~mask; + } + return make_small(b); + } else if (num_bits <= 8) { + /* + * The bits are in two different bytes. It is easiest to + * combine the bytes to a word first, and then shift right and + * mask to extract the bits. + */ + Uint byte_offset = BYTE_OFFSET(mb->offset); + Uint w = mb->base[byte_offset] << 8 | mb->base[byte_offset+1]; + Uint mask = MAKE_MASK(num_bits); + mb->offset += num_bits; + w >>= 16 - offs - num_bits; + w &= mask; + if ((flags & BSF_SIGNED) && w >> (num_bits-1)) { + w |= ~mask; + } + return make_small(w); + } else if (num_bits < SMALL_BITS && (flags & BSF_LITTLE) == 0) { + /* + * Handle field sizes from 9 up to SMALL_BITS-1 bits, big-endian, + * stored in at least two bytes. + */ + byte* bp = mb->base + BYTE_OFFSET(mb->offset); + Uint n; + Uint w; + + n = num_bits; + mb->offset += num_bits; + + /* + * Handle the most signicant byte if it contains 1 to 7 bits. + * It only needs to be masked, not shifted. + */ + if (offs == 0) { + w = 0; + } else { + Uint num_bits_in_msb = 8 - offs; + w = *bp++; + n -= num_bits_in_msb; + w &= MAKE_MASK(num_bits_in_msb); + } + + /* + * Simply shift whole bytes into the result. + */ + switch (BYTE_OFFSET(n)) { +#ifdef ARCH_64 + case 7: w = (w << 8) | *bp++; + case 6: w = (w << 8) | *bp++; + case 5: w = (w << 8) | *bp++; + case 4: w = (w << 8) | *bp++; +#endif + case 3: w = (w << 8) | *bp++; + case 2: w = (w << 8) | *bp++; + case 1: w = (w << 8) | *bp++; + } + n = BIT_OFFSET(n); + + /* + * Handle the 1 to 7 bits remaining in the last byte (if any). + * They need to be shifted right, but there is no need to mask; + * then they can be shifted into the word. + */ + if (n > 0) { + Uint b = *bp; + b >>= 8 - n; + w = (w << n) | b; + } + + /* + * Sign extend the result if the field type is 'signed' and the + * most significant bit is 1. + */ + if ((flags & BSF_SIGNED) != 0 && (w >> (num_bits-1) != 0)) { + w |= ~MAKE_MASK(num_bits); + } + return make_small(w); + } + + /* + * Handle everything else, that is: + * + * Big-endian fields >= SMALL_BITS (potentially bignums). + * Little-endian fields with 9 or more bits. + */ + + bytes = NBYTES(num_bits); + if ((bits = BIT_OFFSET(num_bits)) == 0) { /* number of bits in MSB */ + bits = 8; + } + offs = 8 - bits; /* adjusted offset in MSB */ + + if (bytes <= sizeof bigbuf) { + LSB = bigbuf; + } else { + LSB = erts_alloc(ERTS_ALC_T_TMP, bytes); + } + MSB = LSB + bytes - 1; + + /* + * Move bits to temporary buffer. We want the buffer to be stored in + * little-endian order, since bignums are little-endian. + */ + + if (flags & BSF_LITTLE) { + erts_copy_bits(mb->base, mb->offset, 1, LSB, 0, 1, num_bits); + *MSB >>= offs; /* adjust msb */ + } else { + *MSB = 0; + erts_copy_bits(mb->base, mb->offset, 1, MSB, offs, -1, num_bits); + } + mb->offset += num_bits; + + /* + * Get the sign bit. + */ + sgn = 0; + if ((flags & BSF_SIGNED) && (*MSB & (1<<(bits-1)))) { + byte* ptr = LSB; + byte c = 1; + + /* sign extend MSB */ + *MSB |= ~MAKE_MASK(bits); + + /* two's complement */ + while (ptr <= MSB) { + byte pd = ~(*ptr); + byte d = pd + c; + c = (d < pd); + *ptr++ = d; + } + sgn = 1; + } + + /* normalize */ + while ((*MSB == 0) && (MSB > LSB)) { + MSB--; + bytes--; + } + + /* check for guaranteed small num */ + switch (bytes) { + case 1: + v32 = LSB[0]; + goto big_small; + case 2: + v32 = LSB[0] + (LSB[1]<<8); + goto big_small; + case 3: + v32 = LSB[0] + (LSB[1]<<8) + (LSB[2]<<16); + goto big_small; +#if !defined(ARCH_64) + case 4: + v32 = (LSB[0] + (LSB[1]<<8) + (LSB[2]<<16) + (LSB[3]<<24)); + if (!IS_USMALL(sgn, v32)) { + goto make_big; + } +#else + case 4: + ReadToVariable(v32, LSB, 4); + goto big_small; + case 5: + ReadToVariable(v32, LSB, 5); + goto big_small; + case 6: + ReadToVariable(v32, LSB, 6); + goto big_small; + case 7: + ReadToVariable(v32, LSB, 7); + goto big_small; + case 8: + ReadToVariable(v32, LSB, 8); + if (!IS_USMALL(sgn, v32)) { + goto make_big; + } +#endif + big_small: /* v32 loaded with value which fits in fixnum */ + if (sgn) { + res = make_small(-((Sint)v32)); + } else { + res = make_small(v32); + } + break; + make_big: + hp = HeapOnlyAlloc(p, BIG_UINT_HEAP_SIZE); + if (sgn) { + hp[0] = make_neg_bignum_header(1); + } else { + hp[0] = make_pos_bignum_header(1); + } + BIG_DIGIT(hp,0) = v32; + res = make_big(hp); + break; + default: + words_needed = 1+WSIZE(bytes); + hp = HeapOnlyAlloc(p, words_needed); + hp_end = hp + words_needed; + res = bytes_to_big(LSB, bytes, sgn, hp); + if (is_small(res)) { + p->htop = hp; + } else if ((actual = bignum_header_arity(*hp)+1) < words_needed) { + p->htop = hp + actual; + } + break; + } + + if (LSB != bigbuf) { + erts_free(ERTS_ALC_T_TMP, (void *) LSB); + } + return res; +} + +Eterm +erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb) +{ + ErlSubBin* sb; + size_t num_bytes; /* Number of bytes in binary. */ + + if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */ + return THE_NON_VALUE; + } + + /* + * From now on, we can't fail. + */ + + num_bytes = NBYTES(num_bits); + sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE); + + sb->thing_word = HEADER_SUB_BIN; + sb->orig = mb->orig; + sb->size = BYTE_OFFSET(num_bits); + sb->bitsize = BIT_OFFSET(num_bits); + sb->offs = BYTE_OFFSET(mb->offset); + sb->bitoffs = BIT_OFFSET(mb->offset); + sb->is_writable = 0; + mb->offset += num_bits; + + return make_binary(sb); +} + +Eterm +erts_bs_get_float_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb) +{ + Eterm* hp; + float f32; + double f64; + byte* fptr; + FloatDef f; + + if (num_bits == 0) { + f.fd = 0.0; + hp = HeapOnlyAlloc(p, FLOAT_SIZE_OBJECT); + PUT_DOUBLE(f, hp); + return make_float(hp); + } + if (mb->size - mb->offset < num_bits) { /* Asked for too many bits. */ + return THE_NON_VALUE; + } + if (num_bits == 32) { + fptr = (byte *) &f32; + } else if (num_bits == 64) { + fptr = (byte *) &f64; + } else { + return THE_NON_VALUE; + } + + if (BIT_IS_MACHINE_ENDIAN(flags)) { + erts_copy_bits(mb->base, mb->offset, 1, + fptr, 0, 1, + num_bits); + } else { + erts_copy_bits(mb->base, mb->offset, 1, + fptr + NBYTES(num_bits) - 1, 0, -1, + num_bits); + } + ERTS_FP_CHECK_INIT(p); + if (num_bits == 32) { + ERTS_FP_ERROR_THOROUGH(p, f32, return THE_NON_VALUE); + f.fd = f32; + } else { + ERTS_FP_ERROR_THOROUGH(p, f64, return THE_NON_VALUE); + f.fd = f64; + } + mb->offset += num_bits; + hp = HeapOnlyAlloc(p, FLOAT_SIZE_OBJECT); + PUT_DOUBLE(f, hp); + return make_float(hp); +} + +Eterm +erts_bs_get_binary_all_2(Process *p, ErlBinMatchBuffer* mb) +{ + ErlSubBin* sb; + Uint size; + size = mb->size-mb->offset; + sb = (ErlSubBin *) HeapOnlyAlloc(p, ERL_SUB_BIN_SIZE); + sb->thing_word = HEADER_SUB_BIN; + sb->size = BYTE_OFFSET(size); + sb->bitsize = BIT_OFFSET(size); + sb->offs = BYTE_OFFSET(mb->offset); + sb->bitoffs = BIT_OFFSET(mb->offset); + sb->is_writable = 0; + sb->orig = mb->orig; + mb->offset = mb->size; + return make_binary(sb); +} + +/**************************************************************** + *** + *** Building binaries + *** + ****************************************************************/ + + +/* COPY_VAL: + * copy sz byte from val to dst buffer, + * dst, val are updated!!! + */ + +#define COPY_VAL(dst,ddir,val,sz) do { \ + Uint __sz = (sz); \ + while(__sz) { \ + switch(__sz) { \ + default: \ + case 4: *dst = (val&0xff); dst += ddir; val >>= 8; __sz--; \ + case 3: *dst = (val&0xff); dst += ddir; val >>= 8; __sz--; \ + case 2: *dst = (val&0xff); dst += ddir; val >>= 8; __sz--; \ + case 1: *dst = (val&0xff); dst += ddir; val >>= 8; __sz--; \ + } \ + } \ + } while(0) + +/* calculate a - *cp (carry) (store result in b), *cp is updated! */ +#define SUBc(a, cp, b) do { \ + byte __x = (a); \ + byte __y = (__x - (*(cp))); \ + (*cp) = (__y > __x); \ + *(b) = ~__y; \ + } while(0) + +static int +fmt_int(byte *buf, Uint sz, Eterm val, Uint size, Uint flags) +{ + unsigned long offs; + + ASSERT(size != 0); + offs = BIT_OFFSET(size); + if (is_small(val)) { + Sint v = signed_val(val); + if (flags & BSF_LITTLE) { /* Little endian */ + sz--; + COPY_VAL(buf,1,v,sz); + *buf = offs ? ((v << (8-offs)) & 0xff) : (v & 0xff); + } else { /* Big endian */ + buf += (sz - 1); + if (offs) { + *buf-- = (v << (8-offs)) & 0xff; + sz--; + v >>= offs; + } + COPY_VAL(buf,-1,v,sz); + } + } else if (is_big(val)) { + int sign = big_sign(val); + Uint ds = big_size(val)*sizeof(ErtsDigit); /* number of digits bytes */ + ErtsDigit* dp = big_v(val); + int n = MIN(sz,ds); + + if (flags & BSF_LITTLE) { + sz -= n; /* pad with this amount */ + if (sign) { + int c = 1; + while(n >= sizeof(ErtsDigit)) { + ErtsDigit d = *dp++; + int i; + for(i = 0; i < sizeof(ErtsDigit); ++i) { + SUBc((d&0xff), &c, buf); + buf++; + d >>= 8; + } + n -= sizeof(ErtsDigit); + } + if (n) { + ErtsDigit d = *dp; + do { + SUBc((d&0xff), &c, buf); + buf++; + d >>= 8; + } while (--n > 0); + } + /* pad */ + while(sz--) { + SUBc(0, &c, buf); + buf++; + } + } + else { + while(n >= sizeof(ErtsDigit)) { + ErtsDigit d = *dp++; + int i; + for(i = 0; i < sizeof(ErtsDigit); ++i) { + *buf++ = (d & 0xff); + d >>= 8; + } + n -= sizeof(ErtsDigit); + } + if (n) { + ErtsDigit d = *dp; + do { + *buf++ = (d & 0xff); + d >>= 8; + } while (--n > 0); + } + /* pad */ + while(sz) { + *buf++ = 0; + sz--; + } + } + /* adjust MSB!!! */ + if (offs) { + buf--; + *buf <<= (8 - offs); + } + } + else { /* BIG ENDIAN */ + ErtsDigit acc = 0; + ErtsDigit d; + + buf += (sz - 1); /* end of buffer */ + sz -= n; /* pad with this amount */ + offs = offs ? (8-offs) : 0; /* shift offset */ + + if (sign) { /* SIGNED */ + int c = 1; + + while (n >= sizeof(ErtsDigit)) { + int i; + + d = *dp++; + acc |= d << offs; + SUBc((acc&0xff), &c, buf); + buf--; + acc = d >> (8-offs); + for (i = 0; i < sizeof(ErtsDigit)-1; ++i) { + SUBc((acc&0xff), &c, buf); + buf--; + acc >>= 8; + } + n -= sizeof(ErtsDigit); + } + if (n) { + acc |= ((ErtsDigit)*dp << offs); + do { + SUBc((acc & 0xff), &c, buf); + buf--; + acc >>= 8; + } while (--n > 0); + } + /* pad */ + while(sz--) { + SUBc((acc & 0xff), &c, buf); + buf--; + acc >>= 8; + } + } + else { /* UNSIGNED */ + while (n >= sizeof(ErtsDigit)) { + int i; + + d = *dp++; + acc |= d << offs; + *buf-- = acc; + acc = d >> (8-offs); + for (i = 0; i < sizeof(ErtsDigit)-1; ++i) { + *buf-- = acc; + acc >>= 8; + } + n -= sizeof(ErtsDigit); + } + if (n) { + acc |= ((ErtsDigit)*dp << offs); + do { + *buf-- = acc & 0xff; + acc >>= 8; + } while (--n > 0); + } + while (sz--) { + *buf-- = acc & 0xff; + acc >>= 8; + } + } + } + } else { /* Neither small nor big */ + return -1; + } + return 0; +} + +static void +ERTS_INLINE need_byte_buf(ERL_BITS_PROTO_1(int need)) +{ + if (byte_buf_len < need) { +#ifdef ERTS_SMP + erts_smp_atomic_add(&bits_bufs_size, need - byte_buf_len); +#endif + byte_buf_len = need; + byte_buf = erts_realloc(ERTS_ALC_T_BITS_BUF, byte_buf, byte_buf_len); + } +} + +int +erts_new_bs_put_integer(ERL_BITS_PROTO_3(Eterm arg, Uint num_bits, unsigned flags)) +{ + Uint bin_offset = erts_bin_offset; + Uint bit_offset; + Uint b; + byte *iptr; + + if (num_bits == 0) { + return 1; + } + + bit_offset = BIT_OFFSET(bin_offset); + if (is_small(arg)) { + Uint rbits = 8 - bit_offset; + + if (bit_offset + num_bits <= 8) { + /* + * All bits are in the same byte. + */ + iptr = erts_current_bin+BYTE_OFFSET(bin_offset); + b = *iptr & (0xff << rbits); + b |= (signed_val(arg) & ((1 << num_bits)-1)) << (8-bit_offset-num_bits); + *iptr = b; + } else if (bit_offset == 0) { + /* + * More than one bit, starting at a byte boundary. + * That will be quite efficiently handled by fmt_int(). + * + * (We know that fmt_int() can't fail here.) + */ + (void) fmt_int(erts_current_bin+BYTE_OFFSET(bin_offset), + NBYTES(num_bits), arg, num_bits, flags); + } else if (flags & BSF_LITTLE) { + /* + * Can't handle unaligned little-endian in a simple way. + */ + goto unaligned; + } else { /* Big endian */ + /* + * Big-endian, more than one byte, but not aligned on a byte boundary. + * Handle the bits up to the next byte boundary specially, + * then let fmt_int() handle the rest. + */ + Uint shift_count = num_bits - rbits; + Sint val = signed_val(arg); + iptr = erts_current_bin+BYTE_OFFSET(bin_offset); + b = *iptr & (0xff << rbits); + + /* + * Shifting with a shift count greater than or equal to the word + * size may be a no-op (instead of 0 the result may be the unshifted + * value). Therefore, only do the shift and the OR if the shift count + * is less than the word size if the number is positive; if negative, + * we must simulate the sign extension. + */ + if (shift_count < sizeof(Uint)*8) { + b |= (val >> shift_count) & ((1 << rbits) - 1); + } else if (val < 0) { + /* Simulate sign extension. */ + b |= (-1) & ((1 << rbits) - 1); + } + *iptr++ = b; + + /* fmt_int() can't fail here. */ + (void) fmt_int(iptr, NBYTES(num_bits-rbits), arg, + num_bits-rbits, flags); + } + } else if (bit_offset == 0) { + /* + * Big number, aligned on a byte boundary. We can format the + * integer directly into the binary. + */ + if (fmt_int(erts_current_bin+BYTE_OFFSET(bin_offset), + NBYTES(num_bits), arg, num_bits, flags) < 0) { + return 0; + } + } else { + unaligned: + /* + * Big number or small little-endian number, not byte-aligned, + * or not a number at all. + * + * We must format the number into a temporary buffer, and then + * copy that into the binary. + */ + need_byte_buf(ERL_BITS_ARGS_1(NBYTES(num_bits))); + iptr = byte_buf; + if (fmt_int(iptr, NBYTES(num_bits), arg, num_bits, flags) < 0) { + return 0; + } + erts_copy_bits(iptr, 0, 1, erts_current_bin, bin_offset, 1, num_bits); + } + erts_bin_offset = bin_offset + num_bits; + return 1; +} + +int +erts_bs_put_utf8(ERL_BITS_PROTO_1(Eterm arg)) +{ + Uint bin_offset = erts_bin_offset; + Uint bit_offset; + Uint num_bits; + byte tmp_buf[4]; + byte* dst; + Sint val; + + if (is_not_small(arg)) { + return 0; + } + val = signed_val(arg); + if (val < 0) { + return 0; + } + + if ((bit_offset = BIT_OFFSET(bin_offset)) == 0) { + /* We can write directly into the destination binary. */ + dst = erts_current_bin+BYTE_OFFSET(bin_offset); + } else { + /* Unaligned destination binary. Must use a temporary buffer. */ + dst = tmp_buf; + } + if (val < 0x80) { + dst[0] = val; + num_bits = 8; + } else if (val < 0x800) { + dst[0] = 0xC0 | (val >> 6); + dst[1] = 0x80 | (val & 0x3F); + num_bits = 16; + } else if (val < 0x10000UL) { + if ((0xD800 <= val && val <= 0xDFFF) || + val == 0xFFFE || val == 0xFFFF) { + return 0; + } + dst[0] = 0xE0 | (val >> 12); + dst[1] = 0x80 | ((val >> 6) & 0x3F); + dst[2] = 0x80 | (val & 0x3F); + num_bits = 24; + } else if (val < 0x110000) { + dst[0] = 0xF0 | (val >> 18); + dst[1] = 0x80 | ((val >> 12) & 0x3F); + dst[2] = 0x80 | ((val >> 6) & 0x3F); + dst[3] = 0x80 | (val & 0x3F); + num_bits = 32; + } else { + return 0; + } + + if (bin_offset != 0) { + erts_copy_bits(dst, 0, 1, erts_current_bin, bin_offset, 1, num_bits); + } + + erts_bin_offset += num_bits; + + return 1; +} + +int +erts_bs_put_utf16(ERL_BITS_PROTO_2(Eterm arg, Uint flags)) +{ + Uint bin_offset = erts_bin_offset; + Uint bit_offset; + Uint num_bits; + byte tmp_buf[4]; + byte* dst; + Uint val; + + if (is_not_small(arg)) { + return 0; + } + val = unsigned_val(arg); + if (val > 0x10FFFF || (0xD800 <= val && val <= 0xDFFF) || + val == 0xFFFE || val == 0xFFFF) { + return 0; + } + + if ((bit_offset = BIT_OFFSET(bin_offset)) == 0) { + /* We can write directly into the destination binary. */ + dst = erts_current_bin+BYTE_OFFSET(bin_offset); + } else { + /* Unaligned destination binary. Must use a temporary buffer. */ + dst = tmp_buf; + } + + if (val < 0x10000UL) { + num_bits = 16; + if (flags & BSF_LITTLE) { + dst[0] = val; + dst[1] = val >> 8; + } else { + dst[0] = val >> 8; + dst[1] = val; + } + } else { + Uint16 w1, w2; + + num_bits = 32; + val = val - 0x10000UL; + w1 = 0xD800 | (val >> 10); + w2 = 0xDC00 | (val & 0x3FF); + if (flags & BSF_LITTLE) { + dst[0] = w1; + dst[1] = w1 >> 8; + dst[2] = w2; + dst[3] = w2 >> 8; + } else { + dst[0] = w1 >> 8; + dst[1] = w1; + dst[2] = w2 >> 8; + dst[3] = w2; + } + } + + if (bin_offset != 0) { + erts_copy_bits(dst, 0, 1, erts_current_bin, bin_offset, 1, num_bits); + } + + erts_bin_offset += num_bits; + return 1; +} + + +int +erts_new_bs_put_binary(ERL_BITS_PROTO_2(Eterm arg, Uint num_bits)) +{ + byte *bptr; + Uint bitoffs; + Uint bitsize; + + if (!is_binary(arg)) { + return 0; + } + ERTS_GET_BINARY_BYTES(arg, bptr, bitoffs, bitsize); + if (num_bits > 8*binary_size(arg)+bitsize) { + return 0; + } + copy_binary_to_buffer(erts_current_bin, erts_bin_offset, bptr, bitoffs, num_bits); + erts_bin_offset += num_bits; + return 1; +} + +int +erts_new_bs_put_binary_all(ERL_BITS_PROTO_2(Eterm arg, Uint unit)) +{ + byte *bptr; + Uint bitoffs; + Uint bitsize; + Uint num_bits; + + /* + * This type test is not needed if the code was compiled with + * an R12B or later compiler, since there would have been a + * call to bit_size/1 or byte_size/1 that would have failed if + * 'arg' was not a binary. However, in R11B and earlier releases, + * size/1 was use for calculating the size of the binary, and + * therefore 'arg' could be a tuple. + */ + if (!is_binary(arg)) { + return 0; + } + + ERTS_GET_BINARY_BYTES(arg, bptr, bitoffs, bitsize); + num_bits = 8*binary_size(arg)+bitsize; + if (unit == 8) { + if (bitsize != 0) { + return 0; + } + } else if (unit != 1 && num_bits % unit != 0) { + return 0; + } + copy_binary_to_buffer(erts_current_bin, erts_bin_offset, bptr, bitoffs, num_bits); + erts_bin_offset += num_bits; + return 1; +} + +int +erts_new_bs_put_float(Process *c_p, Eterm arg, Uint num_bits, int flags) +{ + ERL_BITS_DEFINE_STATEP(c_p); + + if (BIT_OFFSET(erts_bin_offset) == 0) { + Uint32 a; + Uint32 b; + + if (num_bits == 64) { + union { + double f64; + Uint32 i32[2]; + } u; + + if (is_float(arg)) { + FloatDef *fdp = (FloatDef*)(float_val(arg) + 1); + a = fdp->fw[0]; + b = fdp->fw[1]; + } else if (is_small(arg)) { + u.f64 = (double) signed_val(arg); + a = u.i32[0]; + b = u.i32[1]; + } else if (is_big(arg)) { + if (big_to_double(arg, &u.f64) < 0) { + return 0; + } + a = u.i32[0]; + b = u.i32[1]; + } else { + return 0; + } + } else if (num_bits == 32) { + union { + float f32; + Uint32 i32; + } u; + + b = 0; + if (is_float(arg)) { + FloatDef f; + GET_DOUBLE(arg, f); + ERTS_FP_CHECK_INIT(c_p); + u.f32 = f.fd; + ERTS_FP_ERROR(c_p,u.f32,;); + a = u.i32; + } else if (is_small(arg)) { + u.f32 = (float) signed_val(arg); + a = u.i32; + } else if (is_big(arg)) { + double f64; + if (big_to_double(arg, &f64) < 0) { + return 0; + } + ERTS_FP_CHECK_INIT(c_p); + u.f32 = (float) f64; + ERTS_FP_ERROR(c_p,u.f32,;); + a = u.i32; + } else { + return 0; + } + } else { + return 0; + } + + if (BIT_IS_MACHINE_ENDIAN(flags)) { + byte* t = erts_current_bin+BYTE_OFFSET(erts_bin_offset); +#ifdef WORDS_BIGENDIAN + t[0] = a >> 24; + t[1] = a >> 16; + t[2] = a >> 8; + t[3] = a; + if (num_bits == 64) { + t[4] = b >> 24; + t[5] = b >> 16; + t[6] = b >> 8; + t[7] = b; + } +#else + t[3] = a >> 24; + t[2] = a >> 16; + t[1] = a >> 8; + t[0] = a; + if (num_bits == 64) { + t[7] = b >> 24; + t[6] = b >> 16; + t[5] = b >> 8; + t[4] = b; + } +#endif + } else { + byte* t = erts_current_bin+BYTE_OFFSET(erts_bin_offset) + NBYTES(num_bits); +#ifdef WORDS_BIGENDIAN + t[-1] = a >> 24; + t[-2] = a >> 16; + t[-3] = a >> 8; + t[-4] = a; + if (num_bits == 64) { + t[-5] = b >> 24; + t[-6] = b >> 16; + t[-7] = b >> 8; + t[-8] = b; + } +#else + t[-1] = a; + t[-2] = a >> 8; + t[-3] = a >> 16; + t[-4] = a >> 24; + if (num_bits == 64) { + t[-5] = b; + t[-6] = b >> 8; + t[-7] = b >> 16; + t[-8] = b >> 24; + } +#endif + } + } else { + byte *bptr; + double f64; + float f32; + + if (num_bits == 64) { + if (is_float(arg)) { + bptr = (byte *) (float_val(arg) + 1); + } else if (is_small(arg)) { + f64 = (double) signed_val(arg); + bptr = (byte *) &f64; + } else if (is_big(arg)) { + if (big_to_double(arg, &f64) < 0) { + return 0; + } + bptr = (byte *) &f64; + } else { + return 0; + } + } else if (num_bits == 32) { + if (is_float(arg)) { + FloatDef f; + GET_DOUBLE(arg, f); + ERTS_FP_CHECK_INIT(c_p); + f32 = f.fd; + ERTS_FP_ERROR(c_p,f32,;); + bptr = (byte *) &f32; + } else if (is_small(arg)) { + f32 = (float) signed_val(arg); + bptr = (byte *) &f32; + } else if (is_big(arg)) { + if (big_to_double(arg, &f64) < 0) { + return 0; + } + ERTS_FP_CHECK_INIT(c_p); + f32 = (float) f64; + ERTS_FP_ERROR(c_p,f32,;); + bptr = (byte *) &f32; + } else { + return 0; + } + } else { + return 0; + } + if (BIT_IS_MACHINE_ENDIAN(flags)) { + erts_copy_bits(bptr, 0, 1, + erts_current_bin, + erts_bin_offset, 1, num_bits); + } else { + erts_copy_bits(bptr+NBYTES(num_bits)-1, 0, -1, + erts_current_bin, erts_bin_offset, 1, + num_bits); + } + } + erts_bin_offset += num_bits; + return 1; +} + +void +erts_new_bs_put_string(ERL_BITS_PROTO_2(byte* iptr, Uint num_bytes)) +{ + if (BIT_OFFSET(erts_bin_offset) != 0) { + erts_copy_bits(iptr, 0, 1, erts_current_bin, erts_bin_offset, 1, num_bytes*8); + } else { + sys_memcpy(erts_current_bin+BYTE_OFFSET(erts_bin_offset), iptr, num_bytes); + } + erts_bin_offset += num_bytes*8; +} + +Eterm +erts_bs_append(Process* c_p, Eterm* reg, Uint live, Eterm build_size_term, + Uint extra_words, Uint unit) +{ + Eterm bin; /* Given binary */ + Eterm* ptr; + Eterm hdr; + ErlSubBin* sb; + ProcBin* pb; + Binary* binp; + Uint heap_need; + Uint build_size_in_bits; + Uint used_size_in_bits; + Uint unsigned_bits; + ERL_BITS_DEFINE_STATEP(c_p); + + /* + * Check and untag the requested build size. + */ + if (is_small(build_size_term)) { + Sint signed_bits = signed_val(build_size_term); + if (signed_bits < 0) { + goto badarg; + } + build_size_in_bits = (Uint) signed_bits; + } else if (term_to_Uint(build_size_term, &unsigned_bits)) { + build_size_in_bits = unsigned_bits; + } else { + c_p->freason = unsigned_bits; + return THE_NON_VALUE; + } + + /* + * Check the binary argument. + */ + bin = reg[live]; + if (!is_boxed(bin)) { + badarg: + c_p->freason = BADARG; + return THE_NON_VALUE; + } + ptr = boxed_val(bin); + hdr = *ptr; + if (!is_binary_header(hdr)) { + goto badarg; + } + if (hdr != HEADER_SUB_BIN) { + goto not_writable; + } + sb = (ErlSubBin *) ptr; + if (!sb->is_writable) { + goto not_writable; + } + pb = (ProcBin *) boxed_val(sb->orig); + ASSERT(pb->thing_word == HEADER_PROC_BIN); + if ((pb->flags & PB_IS_WRITABLE) == 0) { + goto not_writable; + } + + /* + * OK, the binary is writable. + */ + + erts_bin_offset = 8*sb->size + sb->bitsize; + used_size_in_bits = erts_bin_offset + build_size_in_bits; + sb->is_writable = 0; /* Make sure that no one else can write. */ + pb->size = NBYTES(used_size_in_bits); + pb->flags |= PB_ACTIVE_WRITER; + + /* + * Reallocate the binary if it is too small. + */ + binp = pb->val; + if (binp->orig_size < pb->size) { + Uint new_size = 2*pb->size; + binp = erts_bin_realloc(binp, new_size); + binp->orig_size = new_size; + pb->val = binp; + pb->bytes = (byte *) binp->orig_bytes; + } + erts_current_bin = pb->bytes; + + /* + * Allocate heap space and build a new sub binary. + */ + reg[live] = sb->orig; + heap_need = ERL_SUB_BIN_SIZE + extra_words; + if (c_p->stop - c_p->htop < heap_need) { + (void) erts_garbage_collect(c_p, heap_need, reg, live+1); + } + sb = (ErlSubBin *) c_p->htop; + c_p->htop += ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = BYTE_OFFSET(used_size_in_bits); + sb->bitsize = BIT_OFFSET(used_size_in_bits); + sb->offs = 0; + sb->bitoffs = 0; + sb->is_writable = 1; + sb->orig = reg[live]; + + return make_binary(sb); + + /* + * The binary is not writable. We must create a new writable binary and + * copy the old contents of the binary. + */ + not_writable: + { + Uint used_size_in_bytes; /* Size of old binary + data to be built */ + Uint bin_size; + Binary* bptr; + byte* src_bytes; + Uint bitoffs; + Uint bitsize; + Eterm* hp; + + /* + * Allocate heap space. + */ + heap_need = PROC_BIN_SIZE + ERL_SUB_BIN_SIZE + extra_words; + if (c_p->stop - c_p->htop < heap_need) { + (void) erts_garbage_collect(c_p, heap_need, reg, live+1); + bin = reg[live]; + } + hp = c_p->htop; + + /* + * Calculate sizes. The size of the new binary, is the sum of the + * build size and the size of the old binary. Allow some room + * for growing. + */ + ERTS_GET_BINARY_BYTES(bin, src_bytes, bitoffs, bitsize); + erts_bin_offset = 8*binary_size(bin) + bitsize; + used_size_in_bits = erts_bin_offset + build_size_in_bits; + used_size_in_bytes = NBYTES(used_size_in_bits); + bin_size = 2*used_size_in_bytes; + bin_size = (bin_size < 256) ? 256 : bin_size; + + /* + * Allocate the binary data struct itself. + */ + bptr = erts_bin_nrml_alloc(bin_size); + bptr->flags = 0; + bptr->orig_size = bin_size; + erts_refc_init(&bptr->refc, 1); + erts_current_bin = (byte *) bptr->orig_bytes; + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) hp; + hp += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = used_size_in_bytes; + pb->next = MSO(c_p).mso; + MSO(c_p).mso = pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = PB_IS_WRITABLE | PB_ACTIVE_WRITER; + MSO(c_p).overhead += pb->size / sizeof(Eterm); + + /* + * Now allocate the sub binary and set its size to include the + * data about to be built. + */ + sb = (ErlSubBin *) hp; + hp += ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = BYTE_OFFSET(used_size_in_bits); + sb->bitsize = BIT_OFFSET(used_size_in_bits); + sb->offs = 0; + sb->bitoffs = 0; + sb->is_writable = 1; + sb->orig = make_binary(pb); + + c_p->htop = hp; + + /* + * Now copy the data into the binary. + */ + if (unit > 1) { + if ((unit == 8 && (erts_bin_offset & 7) != 0) || + (erts_bin_offset % unit) != 0) { + return THE_NON_VALUE; + } + } + copy_binary_to_buffer(erts_current_bin, 0, src_bytes, bitoffs, erts_bin_offset); + + return make_binary(sb); + } +} + +Eterm +erts_bs_private_append(Process* p, Eterm bin, Eterm build_size_term, Uint unit) +{ + Eterm* ptr; + ErlSubBin* sb; + ProcBin* pb; + Binary* binp; + Uint build_size_in_bits; + Uint pos_in_bits_after_build; + Uint unsigned_bits; + ERL_BITS_DEFINE_STATEP(p); + + /* + * Check and untag the requested build size. + */ + if (is_small(build_size_term)) { + Sint signed_bits = signed_val(build_size_term); + if (signed_bits < 0) { + p->freason = BADARG; + return THE_NON_VALUE; + } + build_size_in_bits = (Uint) signed_bits; + } else if (term_to_Uint(build_size_term, &unsigned_bits)) { + build_size_in_bits = unsigned_bits; + } else { + p->freason = unsigned_bits; + return THE_NON_VALUE; + } + + ptr = boxed_val(bin); + ASSERT(*ptr == HEADER_SUB_BIN); + + sb = (ErlSubBin *) ptr; + ASSERT(sb->is_writable); + + pb = (ProcBin *) boxed_val(sb->orig); + ASSERT(pb->thing_word == HEADER_PROC_BIN); + + /* + * Calculate new size in bytes. + */ + erts_bin_offset = 8*sb->size + sb->bitsize; + pos_in_bits_after_build = erts_bin_offset + build_size_in_bits; + pb->size = (pos_in_bits_after_build+7) >> 3; + pb->flags |= PB_ACTIVE_WRITER; + + /* + * Reallocate the binary if it is too small. + */ + binp = pb->val; + if (binp->orig_size < pb->size) { + Uint new_size = 2*pb->size; + + if (pb->flags & PB_IS_WRITABLE) { + /* + * This is the normal case - the binary is writable. + * There are no other references to the binary, so it + * is safe to reallocate it. + */ + binp = erts_bin_realloc(binp, new_size); + binp->orig_size = new_size; + pb->val = binp; + pb->bytes = (byte *) binp->orig_bytes; + } else { + /* + * The binary is NOT writable. The only way that is + * supposed to happen if is call trace has been turned + * on. That means that a trace process now has (or have + * had) a reference to the binary, so we are not allowed + * to reallocate the binary. Instead, we must allocate a new + * binary and copy the contents of the old binary into it. + */ + Binary* bptr = erts_bin_nrml_alloc(new_size); + bptr->flags = 0; + bptr->orig_size = new_size; + erts_refc_init(&bptr->refc, 1); + sys_memcpy(bptr->orig_bytes, binp->orig_bytes, pb->size); + pb->flags |= PB_IS_WRITABLE | PB_ACTIVE_WRITER; + pb->val = bptr; + pb->bytes = (byte *) bptr->orig_bytes; + if (erts_refc_dectest(&binp->refc, 0) == 0) { + erts_bin_free(binp); + } + } + } + erts_current_bin = pb->bytes; + + sb->size = pos_in_bits_after_build >> 3; + sb->bitsize = pos_in_bits_after_build & 7; + return bin; +} + +Eterm +erts_bs_init_writable(Process* p, Eterm sz) +{ + Uint bin_size = 1024; + Uint heap_need; + Binary* bptr; + ProcBin* pb; + ErlSubBin* sb; + Eterm* hp; + + if (is_small(sz)) { + Sint s = signed_val(sz); + if (s >= 0) { + bin_size = (Uint) s; + } + } + + /* + * Allocate heap space. + */ + heap_need = PROC_BIN_SIZE + ERL_SUB_BIN_SIZE; + if (p->stop - p->htop < heap_need) { + (void) erts_garbage_collect(p, heap_need, NULL, 0); + } + hp = p->htop; + + /* + * Allocate the binary data struct itself. + */ + bptr = erts_bin_nrml_alloc(bin_size); + bptr->flags = 0; + bptr->orig_size = bin_size; + erts_refc_init(&bptr->refc, 1); + + /* + * Now allocate the ProcBin on the heap. + */ + pb = (ProcBin *) hp; + hp += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = 0; + pb->next = MSO(p).mso; + MSO(p).mso = pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = PB_IS_WRITABLE | PB_ACTIVE_WRITER; + MSO(p).overhead += pb->size / sizeof(Eterm); + + /* + * Now allocate the sub binary. + */ + sb = (ErlSubBin *) hp; + hp += ERL_SUB_BIN_SIZE; + sb->thing_word = HEADER_SUB_BIN; + sb->size = 0; + sb->offs = 0; + sb->bitsize = 0; + sb->bitoffs = 0; + sb->is_writable = 1; + sb->orig = make_binary(pb); + + p->htop = hp; + return make_binary(sb); +} + +void +erts_emasculate_writable_binary(ProcBin* pb) +{ + Binary* binp; + Uint unused; + + pb->flags = 0; + binp = pb->val; + ASSERT(binp->orig_size >= pb->size); + unused = binp->orig_size - pb->size; + /* Our allocators are 8 byte aligned, i.e., shrinking with + less than 8 bytes will have no real effect */ + if (unused >= 8) { + Uint new_size = pb->size; + binp = erts_bin_realloc(binp, pb->size); + binp->orig_size = new_size; + pb->val = binp; + pb->bytes = (byte *) binp->orig_bytes; + } +} + +Uint32 +erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb) +{ + Uint bytes; + Uint bits; + Uint offs; + byte bigbuf[4]; + byte* LSB; + byte* MSB; + + ASSERT((mb->offset & 7) != 0); + ASSERT(mb->size - mb->offset >= 32); + + bytes = 4; + bits = 8; + offs = 0; + + LSB = bigbuf; + MSB = LSB + bytes - 1; + + *MSB = 0; + erts_copy_bits(mb->base, mb->offset, 1, MSB, offs, -1, 32); + return LSB[0] | (LSB[1]<<8) | (LSB[2]<<16) | (LSB[3]<<24); +} + +void +erts_align_utf8_bytes(ErlBinMatchBuffer* mb, byte* buf) +{ + Uint bits = mb->size - mb->offset; + + /* + * Copy up to 4 bytes into the supplied buffer. + */ + + ASSERT(bits >= 8); + if (bits <= 15) { + bits = 8; + } else if (bits >= 32) { + bits = 32; + } else if (bits >= 24) { + bits = 24; + } else { + bits = 16; + } + erts_copy_bits(mb->base, mb->offset, 1, buf, 0, 1, bits); +} + +Eterm +erts_bs_get_utf8(ErlBinMatchBuffer* mb) +{ + Eterm result; + Uint remaining_bits; + byte* pos; + byte tmp_buf[4]; + Eterm a, b, c; + + /* + * Number of trailing bytes for each value of the first byte. + */ + static const byte erts_trailing_bytes_for_utf8[256] = { + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, + 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9, + 9,9,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 3,3,3,3,3,3,3,3,9,9,9,9,9,9,9,9 + }; + + if ((remaining_bits = mb->size - mb->offset) < 8) { + return THE_NON_VALUE; + } + if (BIT_OFFSET(mb->offset) == 0) { + pos = mb->base + BYTE_OFFSET(mb->offset); + } else { + erts_align_utf8_bytes(mb, tmp_buf); + pos = tmp_buf; + } + result = pos[0]; + switch (erts_trailing_bytes_for_utf8[result]) { + case 0: + /* One byte only */ + mb->offset += 8; + break; + case 1: + /* Two bytes */ + if (remaining_bits < 16) { + return THE_NON_VALUE; + } + a = pos[1]; + if ((a & 0xC0) != 0x80) { + return THE_NON_VALUE; + } + result = (result << 6) + a - (Eterm) 0x00003080UL; + mb->offset += 16; + break; + case 2: + /* Three bytes */ + if (remaining_bits < 24) { + return THE_NON_VALUE; + } + a = pos[1]; + b = pos[2]; + if ((a & 0xC0) != 0x80 || (b & 0xC0) != 0x80 || + (result == 0xE0 && a < 0xA0)) { + return THE_NON_VALUE; + } + result = (((result << 6) + a) << 6) + b - (Eterm) 0x000E2080UL; + if ((0xD800 <= result && result <= 0xDFFF) || + result == 0xFFFE || result == 0xFFFF) { + return THE_NON_VALUE; + } + mb->offset += 24; + break; + case 3: + /* Four bytes */ + if (remaining_bits < 32) { + return THE_NON_VALUE; + } + a = pos[1]; + b = pos[2]; + c = pos[3]; + if ((a & 0xC0) != 0x80 || (b & 0xC0) != 0x80 || + (c & 0xC0) != 0x80 || + (result == 0xF0 && a < 0x90)) { + return THE_NON_VALUE; + } + result = (((((result << 6) + a) << 6) + b) << 6) + + c - (Eterm) 0x03C82080UL; + if (result > 0x10FFFF) { + return THE_NON_VALUE; + } + mb->offset += 32; + break; + default: + return THE_NON_VALUE; + } + return make_small(result); +} + +Eterm +erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags) +{ + Uint bit_offset; + Uint num_bits = mb->size - mb->offset; + byte* src; + byte tmp_buf[4]; + Uint16 w1; + Uint16 w2; + + if (num_bits < 16) { + return THE_NON_VALUE; + } + + /* + * Set up the pointer to the source bytes. + */ + if ((bit_offset = BIT_OFFSET(mb->offset)) == 0) { + /* We can access the binary directly because the bytes are aligned. */ + src = mb->base + BYTE_OFFSET(mb->offset); + } else { + /* + * We must copy the data to a temporary buffer. If possible, + * get 4 bytes, otherwise two bytes. + */ + Uint n = num_bits < 32 ? 16 : 32; + erts_copy_bits(mb->base, mb->offset, 1, tmp_buf, 0, 1, n); + src = tmp_buf; + } + + /* + * Get the first (and maybe only) 16-bit word. See if we are done. + */ + if (flags & BSF_LITTLE) { + w1 = src[0] | (src[1] << 8); + } else { + w1 = (src[0] << 8) | src[1]; + } + if (w1 < 0xD800 || w1 > 0xDFFF) { + if (w1 == 0xFFFE || w1 == 0xFFFF) { + return THE_NON_VALUE; + } + mb->offset += 16; + return make_small(w1); + } else if (w1 > 0xDBFF) { + return THE_NON_VALUE; + } + + /* + * Get the second 16-bit word and combine it with the first. + */ + if (num_bits < 32) { + return THE_NON_VALUE; + } else if (flags & BSF_LITTLE) { + w2 = src[2] | (src[3] << 8); + } else { + w2 = (src[2] << 8) | src[3]; + } + if (!(0xDC00 <= w2 && w2 <= 0xDFFF)) { + return THE_NON_VALUE; + } + mb->offset += 32; + return make_small((((w1 & 0x3FF) << 10) | (w2 & 0x3FF)) + 0x10000UL); +} + +static byte +get_bit(byte b, size_t offs) +{ + return (b >> (7-offs)) & 1; +} + +int +erts_cmp_bits(byte* a_ptr, size_t a_offs, byte* b_ptr, size_t b_offs, size_t size) +{ + byte a; + byte b; + byte a_bit; + byte b_bit; + Uint lshift; + Uint rshift; + int cmp; + + if (((a_offs | b_offs | size) & 7) == 0) { + int byte_size = size >> 3; + return sys_memcmp(a_ptr, b_ptr, byte_size); + } + + /* Compare bit by bit until a_ptr is aligned on byte boundary */ + a = *a_ptr++; + b = *b_ptr++; + while (size > 0) { + a_bit = get_bit(a, a_offs); + b_bit = get_bit(b, b_offs); + if ((cmp = (a_bit-b_bit)) != 0) { + return cmp; + } + size--; + b_offs++; + if (b_offs == 8) { + b_offs = 0; + b = *b_ptr++; + } + a_offs++; + if (a_offs == 8) { + a_offs = 0; + a = *a_ptr++; + break; + } + } + + /* Compare byte by byte as long as at least 8 bits remain */ + lshift = b_offs; + rshift = 8 - lshift; + while (size >= 8) { + byte b_cmp = (b << lshift); + b = *b_ptr++; + b_cmp |= b >> rshift; + if ((cmp = (a - b_cmp)) != 0) { + return cmp; + } + a = *a_ptr++; + size -= 8; + } + + /* Compare the remaining bits bit by bit */ + while (size > 0) { + a_bit = get_bit(a, a_offs); + b_bit = get_bit(b, b_offs); + if ((cmp = (a_bit-b_bit)) != 0) { + return cmp; + } + a_offs++; + if (a_offs == 8) { + a_offs = 0; + a = *a_ptr++; + } + b_offs++; + if (b_offs == 8) { + b_offs = 0; + b = *b_ptr++; + } + size--; + } + + return 0; +} + +/* + * The basic bit copy operation. Copies n bits from the source buffer to + * the destination buffer. Depending on the directions, it can reverse the + * copied bits. + */ + + +void +erts_copy_bits(byte* src, /* Base pointer to source. */ + size_t soffs, /* Bit offset for source relative to src. */ + int sdir, /* Direction: 1 (forward) or -1 (backward). */ + byte* dst, /* Base pointer to destination. */ + size_t doffs, /* Bit offset for destination relative to dst. */ + int ddir, /* Direction: 1 (forward) or -1 (backward). */ + size_t n) /* Number of bits to copy. */ +{ + Uint lmask; + Uint rmask; + Uint count; + Uint deoffs; + + if (n == 0) { + return; + } + + src += sdir*BYTE_OFFSET(soffs); + dst += ddir*BYTE_OFFSET(doffs); + soffs = BIT_OFFSET(soffs); + doffs = BIT_OFFSET(doffs); + deoffs = BIT_OFFSET(doffs+n); + lmask = (doffs) ? MAKE_MASK(8-doffs) : 0; + rmask = (deoffs) ? (MAKE_MASK(deoffs)<<(8-deoffs)) : 0; + + /* + * Take care of the case that all bits are in the same byte. + */ + + if (doffs+n < 8) { /* All bits are in the same byte */ + lmask = (lmask & rmask) ? (lmask & rmask) : (lmask | rmask); + + if (soffs == doffs) { + *dst = MASK_BITS(*src,*dst,lmask); + } else if (soffs > doffs) { + Uint bits = (*src << (soffs-doffs)); + if (soffs+n > 8) { + src += sdir; + bits |= (*src >> (8-(soffs-doffs))); + } + *dst = MASK_BITS(bits,*dst,lmask); + } else { + *dst = MASK_BITS((*src >> (doffs-soffs)),*dst,lmask); + } + return; /* We are done! */ + } + + /* + * At this point, we know that the bits are in 2 or more bytes. + */ + + count = ((lmask) ? (n - (8 - doffs)) : n) >> 3; + + if (soffs == doffs) { + /* + * The bits are aligned in the same way. We can just copy the bytes + * (except for the first and last bytes). Note that the directions + * might be different, so we can't just use memcpy(). + */ + + if (lmask) { + *dst = MASK_BITS(*src, *dst, lmask); + dst += ddir; + src += sdir; + } + + while (count--) { + *dst = *src; + dst += ddir; + src += sdir; + } + + if (rmask) { + *dst = MASK_BITS(*src,*dst,rmask); + } + } else { + Uint bits; + Uint bits1; + Uint rshift; + Uint lshift; + + /* + * The tricky case. The bits must be shifted into position. + */ + + if (soffs > doffs) { + lshift = (soffs - doffs); + rshift = 8 - lshift; + bits = *src; + if (soffs + n > 8) { + src += sdir; + } + } else { + rshift = (doffs - soffs); + lshift = 8 - rshift; + bits = 0; + } + + if (lmask) { + bits1 = bits << lshift; + bits = *src; + src += sdir; + bits1 |= (bits >> rshift); + *dst = MASK_BITS(bits1,*dst,lmask); + dst += ddir; + } + + while (count--) { + bits1 = bits << lshift; + bits = *src; + src += sdir; + *dst = bits1 | (bits >> rshift); + dst += ddir; + } + + if (rmask) { + bits1 = bits << lshift; + if ((rmask << rshift) & 0xff) { + bits = *src; + bits1 |= (bits >> rshift); + } + *dst = MASK_BITS(bits1,*dst,rmask); + } + } +} + diff --git a/erts/emulator/beam/erl_bits.h b/erts/emulator/beam/erl_bits.h new file mode 100644 index 0000000000..e3f8e0b679 --- /dev/null +++ b/erts/emulator/beam/erl_bits.h @@ -0,0 +1,212 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERL_BITS_H__ +#define __ERL_BITS_H__ + +/* + * This structure represents a binary to be matched. + */ + +typedef struct erl_bin_match_buffer { + Eterm orig; /* Original binary term. */ + byte* base; /* Current position in binary. */ + Uint offset; /* Offset in bits. */ + size_t size; /* Size of binary in bits. */ +} ErlBinMatchBuffer; + +struct erl_bits_state { + /* + * Used for building binaries. + */ + byte *byte_buf_; + int byte_buf_len_; + /* + * Used for building binaries using the new instruction set. + */ + byte* erts_current_bin_; /* Pointer to beginning of current binary. */ + /* + * Offset in bits into the current binary (new instruction set) or + * buffer (old instruction set). + */ + Uint erts_bin_offset_; + /* + * Whether the current binary is writable. + */ + unsigned erts_writable_bin_; +}; + +typedef struct erl_bin_match_struct{ + Eterm thing_word; + ErlBinMatchBuffer mb; /* Present match buffer */ + Eterm save_offset[1]; /* Saved offsets */ +} ErlBinMatchState; + +#define ERL_BIN_MATCHSTATE_SIZE(_Max) ((sizeof(ErlBinMatchState) + (_Max)*sizeof(Eterm))/sizeof(Eterm)) +#define HEADER_BIN_MATCHSTATE(_Max) _make_header(ERL_BIN_MATCHSTATE_SIZE((_Max))-1, _TAG_HEADER_BIN_MATCHSTATE) +#define HEADER_NUM_SLOTS(hdr) (header_arity(hdr)-sizeof(ErlBinMatchState)/sizeof(Eterm)+1) + +#define make_matchstate(_Ms) make_boxed((Eterm*)(_Ms)) +#define ms_matchbuffer(_Ms) &(((ErlBinMatchState*)(_Ms - TAG_PRIMARY_BOXED))->mb) + + +#if defined(ERTS_SMP) +#define ERL_BITS_REENTRANT +#else +/* uncomment to test the reentrant API in the non-SMP runtime system */ +/* #define ERL_BITS_REENTRANT */ +#endif + +#ifdef ERL_BITS_REENTRANT + +/* + * Reentrant API with the state passed as a parameter. + * (Except when the current Process* already is a parameter.) + */ +#ifdef ERTS_SMP +/* the state resides in the current process' scheduler data */ +#define ERL_BITS_DECLARE_STATEP struct erl_bits_state *EBS +#define ERL_BITS_RELOAD_STATEP(P) do{EBS = &(P)->scheduler_data->erl_bits_state;}while(0) +#define ERL_BITS_DEFINE_STATEP(P) struct erl_bits_state *EBS = &(P)->scheduler_data->erl_bits_state +#else +/* reentrant API but with a hidden single global state, for testing only */ +extern struct erl_bits_state ErlBitsState_; +#define ERL_BITS_DECLARE_STATEP struct erl_bits_state *EBS = &ErlBitsState_ +#define ERL_BITS_RELOAD_STATEP(P) do{}while(0) +#define ERL_BITS_DEFINE_STATEP(P) ERL_BITS_DECLARE_STATEP +#endif +#define ErlBitsState (*EBS) + +#define ERL_BITS_PROTO_0 struct erl_bits_state *EBS +#define ERL_BITS_PROTO_1(PARM1) struct erl_bits_state *EBS, PARM1 +#define ERL_BITS_PROTO_2(PARM1,PARM2) struct erl_bits_state *EBS, PARM1, PARM2 +#define ERL_BITS_PROTO_3(PARM1,PARM2,PARM3) struct erl_bits_state *EBS, PARM1, PARM2, PARM3 +#define ERL_BITS_ARGS_0 EBS +#define ERL_BITS_ARGS_1(ARG1) EBS, ARG1 +#define ERL_BITS_ARGS_2(ARG1,ARG2) EBS, ARG1, ARG2 +#define ERL_BITS_ARGS_3(ARG1,ARG2,ARG3) EBS, ARG1, ARG2, ARG3 + +#else /* ERL_BITS_REENTRANT */ + +/* + * Non-reentrant API with a single global state. + */ +extern struct erl_bits_state ErlBitsState; +#define ERL_BITS_DECLARE_STATEP /*empty*/ +#define ERL_BITS_RELOAD_STATEP(P) do{}while(0) +#define ERL_BITS_DEFINE_STATEP(P) /*empty*/ + +#define ERL_BITS_PROTO_0 void +#define ERL_BITS_PROTO_1(PARM1) PARM1 +#define ERL_BITS_PROTO_2(PARM1,PARM2) PARM1, PARM2 +#define ERL_BITS_PROTO_3(PARM1,PARM2,PARM3) PARM1, PARM2, PARM3 +#define ERL_BITS_ARGS_0 /*empty*/ +#define ERL_BITS_ARGS_1(ARG1) ARG1 +#define ERL_BITS_ARGS_2(ARG1,ARG2) ARG1, ARG2 +#define ERL_BITS_ARGS_3(ARG1,ARG2,ARG3) ARG1, ARG2, ARG3 + +#endif /* ERL_BITS_REENTRANT */ + +#define erts_bin_offset (ErlBitsState.erts_bin_offset_) +#define erts_current_bin (ErlBitsState.erts_current_bin_) +#define erts_writable_bin (ErlBitsState.erts_writable_bin_) + +#define copy_binary_to_buffer(DstBuffer, DstBufOffset, SrcBuffer, SrcBufferOffset, NumBits) \ + do { \ + if (BIT_OFFSET(DstBufOffset) == 0 && (SrcBufferOffset == 0) && \ + (BIT_OFFSET(NumBits)==0)) { \ + sys_memcpy(DstBuffer+BYTE_OFFSET(DstBufOffset), \ + SrcBuffer, NBYTES(NumBits)); \ + } else { \ + erts_copy_bits(SrcBuffer, SrcBufferOffset, 1, \ + (byte*)DstBuffer, DstBufOffset, 1, NumBits); \ + } \ + } while (0) + +void erts_init_bits(void); /* Initialization once. */ +#ifdef ERTS_SMP +void erts_bits_init_state(ERL_BITS_PROTO_0); +void erts_bits_destroy_state(ERL_BITS_PROTO_0); +#endif + + +/* + * NBYTES(x) returns the number of bytes needed to store x bits. + */ + +#define NBYTES(x) (((x) + 7) >> 3) +#define BYTE_OFFSET(ofs) ((Uint) (ofs) >> 3) +#define BIT_OFFSET(ofs) ((ofs) & 7) + +/* + * Return number of Eterm words needed for allocation with HAlloc(), + * given a number of bytes. + */ +#define WSIZE(n) ((n + sizeof(Eterm) - 1) / sizeof(Eterm)) + +/* + * Binary matching. + */ + +Eterm erts_bs_start_match_2(Process *p, Eterm Bin, Uint Max); +Eterm erts_bs_get_integer_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb); +Eterm erts_bs_get_binary_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb); +Eterm erts_bs_get_float_2(Process *p, Uint num_bits, unsigned flags, ErlBinMatchBuffer* mb); +Eterm erts_bs_get_binary_all_2(Process *p, ErlBinMatchBuffer* mb); + +/* + * Binary construction, new instruction set. + */ + +int erts_new_bs_put_integer(ERL_BITS_PROTO_3(Eterm Integer, Uint num_bits, unsigned flags)); +int erts_bs_put_utf8(ERL_BITS_PROTO_1(Eterm Integer)); +int erts_bs_put_utf16(ERL_BITS_PROTO_2(Eterm Integer, Uint flags)); +int erts_new_bs_put_binary(ERL_BITS_PROTO_2(Eterm Bin, Uint num_bits)); +int erts_new_bs_put_binary_all(ERL_BITS_PROTO_2(Eterm Bin, Uint unit)); +int erts_new_bs_put_float(Process *c_p, Eterm Float, Uint num_bits, int flags); +void erts_new_bs_put_string(ERL_BITS_PROTO_2(byte* iptr, Uint num_bytes)); + +Uint erts_bits_bufs_size(void); +Uint32 erts_bs_get_unaligned_uint32(ErlBinMatchBuffer* mb); +void erts_align_utf8_bytes(ErlBinMatchBuffer* mb, byte* buf); +Eterm erts_bs_get_utf8(ErlBinMatchBuffer* mb); +Eterm erts_bs_get_utf16(ErlBinMatchBuffer* mb, Uint flags); +Eterm erts_bs_append(Process* p, Eterm* reg, Uint live, Eterm build_size_term, + Uint extra_words, Uint unit); +Eterm erts_bs_private_append(Process* p, Eterm bin, Eterm sz, Uint unit); +Eterm erts_bs_init_writable(Process* p, Eterm sz); + +/* + * Common utilities. + */ +void erts_copy_bits(byte* src, size_t soffs, int sdir, + byte* dst, size_t doffs,int ddir, size_t n); +int erts_cmp_bits(byte* a_ptr, size_t a_offs, byte* b_ptr, size_t b_offs, size_t size); + +/* + * Flags for bs_get_* / bs_put_* / bs_init* instructions. + */ + +#define BSF_ALIGNED 1 /* Field is guaranteed to be byte-aligned. */ +#define BSF_LITTLE 2 /* Field is little-endian (otherwise big-endian). */ +#define BSF_SIGNED 4 /* Field is signed (otherwise unsigned). */ +#define BSF_EXACT 8 /* Size in bs_init is exact. */ +#define BSF_NATIVE 16 /* Native endian. */ + +#endif /* __ERL_BITS_H__ */ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c new file mode 100644 index 0000000000..b02150008f --- /dev/null +++ b/erts/emulator/beam/erl_db.c @@ -0,0 +1,3631 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This file contains the bif interface functions and + * the handling of the "meta tables" ie the tables of + * db tables. + */ + +/* +#ifdef DEBUG +#define HARDDEBUG 1 +#endif +*/ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#define ERTS_WANT_DB_INTERNAL__ +#include "erl_db.h" +#include "bif.h" +#include "big.h" + + +erts_smp_atomic_t erts_ets_misc_mem_size; + +/* +** Utility macros +*/ + +/* Get a key from any table structure and a tagged object */ +#define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj)) + + +/* How safe are we from double-hits or missed objects +** when iterating without fixation? */ +enum DbIterSafety { + ITER_UNSAFE, /* Must fixate to be safe */ + ITER_SAFE_LOCKED, /* Safe while table is locked, not between trap calls */ + ITER_SAFE /* No need to fixate at all */ +}; +#ifdef ERTS_SMP +# define ITERATION_SAFETY(Proc,Tab) \ + ((IS_TREE_TABLE((Tab)->common.status) || ONLY_WRITER(Proc,Tab)) ? ITER_SAFE \ + : (((Tab)->common.status & DB_FINE_LOCKED) ? ITER_UNSAFE : ITER_SAFE_LOCKED)) +#else +# define ITERATION_SAFETY(Proc,Tab) \ + ((IS_TREE_TABLE((Tab)->common.status) || ONLY_WRITER(Proc,Tab)) \ + ? ITER_SAFE : ITER_SAFE_LOCKED) +#endif + +#define DID_TRAP(P,Ret) (!is_value(Ret) && ((P)->freason == TRAP)) + + +/* +** The main meta table, containing all ets tables. +*/ +#ifdef ERTS_SMP +# define META_MAIN_TAB_LOCK_CNT 16 +static union { + erts_smp_spinlock_t lck; + byte _cache_line_alignment[64]; +}meta_main_tab_locks[META_MAIN_TAB_LOCK_CNT]; +#endif +static struct { + union { + DbTable *tb; /* Only directly readable if slot is ALIVE */ + Uint next_free; /* (index<<2)|1 if slot is FREE */ + }u; +} *meta_main_tab; + +/* A slot in meta_main_tab can have three states: + * FREE : Free to use for new table. Part of linked free-list. + * ALIVE: Contains a table + * DEAD : Contains a table that is being removed. + */ +#define IS_SLOT_FREE(i) (meta_main_tab[(i)].u.next_free & 1) +#define IS_SLOT_DEAD(i) (meta_main_tab[(i)].u.next_free & 2) +#define IS_SLOT_ALIVE(i) (!(meta_main_tab[(i)].u.next_free & (1|2))) +#define GET_NEXT_FREE_SLOT(i) (meta_main_tab[(i)].u.next_free >> 2) +#define SET_NEXT_FREE_SLOT(i,next) (meta_main_tab[(i)].u.next_free = ((next)<<2)|1) +#define MARK_SLOT_DEAD(i) (meta_main_tab[(i)].u.next_free |= 2) +#define GET_ANY_SLOT_TAB(i) ((DbTable*)(meta_main_tab[(i)].u.next_free & ~(1|2))) /* dead or alive */ + +static ERTS_INLINE void meta_main_tab_lock(unsigned slot) +{ +#ifdef ERTS_SMP + erts_smp_spin_lock(&meta_main_tab_locks[slot % META_MAIN_TAB_LOCK_CNT].lck); +#endif +} + +static ERTS_INLINE void meta_main_tab_unlock(unsigned slot) +{ +#ifdef ERTS_SMP + erts_smp_spin_unlock(&meta_main_tab_locks[slot % META_MAIN_TAB_LOCK_CNT].lck); +#endif +} + +static erts_smp_spinlock_t meta_main_tab_main_lock; +static Uint meta_main_tab_first_free; /* Index of first free slot */ +static int meta_main_tab_cnt; /* Number of active tables */ +static Uint meta_main_tab_slot_mask; /* The slot index part of an unnamed table id */ +static Uint meta_main_tab_seq_incr; +static Uint meta_main_tab_seq_cnt = 0; /* To give unique(-ish) table identifiers */ + + + +/* +** The meta hash table of all NAMED ets tables +*/ +#ifdef ERTS_SMP +# define META_NAME_TAB_LOCK_CNT 16 +union { + erts_smp_rwmtx_t lck; + byte _cache_line_alignment[64]; +}meta_name_tab_rwlocks[META_NAME_TAB_LOCK_CNT]; +#endif +static struct meta_name_tab_entry { + union { + Eterm name_atom; + Eterm mcnt; /* Length of mvec in multiple tab entry */ + }u; + union { + DbTable *tb; + struct meta_name_tab_entry* mvec; + }pu; +} *meta_name_tab; + +static unsigned meta_name_tab_mask; + +static ERTS_INLINE +struct meta_name_tab_entry* meta_name_tab_bucket(Eterm name, + erts_smp_rwmtx_t** lockp) +{ + unsigned bix = atom_val(name) & meta_name_tab_mask; + struct meta_name_tab_entry* bucket = &meta_name_tab[bix]; +#ifdef ERTS_SMP + *lockp = &meta_name_tab_rwlocks[bix % META_NAME_TAB_LOCK_CNT].lck; +#endif + return bucket; +} + + +typedef enum { + LCK_READ=1, /* read only access */ + LCK_WRITE=2, /* exclusive table write access */ + LCK_WRITE_REC=3 /* record write access */ +} db_lock_kind_t; + +extern DbTableMethod db_hash; +extern DbTableMethod db_tree; + +int user_requested_db_max_tabs; +int erts_ets_realloc_always_moves; +static int db_max_tabs; +static DbTable *meta_pid_to_tab; /* Pid mapped to owned tables */ +static DbTable *meta_pid_to_fixed_tab; /* Pid mapped to fixed tables */ +static Eterm ms_delete_all; +static Eterm ms_delete_all_buff[8]; /* To compare with for deletion + of all objects */ + +/* +** Forward decls, static functions +*/ + +static void fix_table_locked(Process* p, DbTable* tb); +static void unfix_table_locked(Process* p, DbTable* tb, db_lock_kind_t* kind); +static void set_heir(Process* me, DbTable* tb, Eterm heir, Eterm heir_data); +static void free_heir_data(DbTable*); +static void free_fixations_locked(DbTable *tb); + +static int free_table_cont(Process *p, + DbTable *tb, + int first, + int clean_meta_tab); +static void print_table(int to, void *to_arg, int show, DbTable* tb); +static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1); +static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1); +static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1); +static BIF_RETTYPE ets_delete_trap(Process *p, Eterm a1); +static Eterm table_info(Process* p, DbTable* tb, Eterm What); + +/* + * Exported global + */ +Export ets_select_delete_continue_exp; +Export ets_select_count_continue_exp; +Export ets_select_continue_exp; + +/* + * Static traps + */ +static Export ets_delete_continue_exp; + +static ERTS_INLINE DbTable* db_ref(DbTable* tb) +{ + if (tb != NULL) { + erts_refc_inc(&tb->common.ref, 2); + } + return tb; +} + +static ERTS_INLINE DbTable* db_unref(DbTable* tb) +{ + if (!erts_refc_dectest(&tb->common.ref, 0)) { +#ifdef HARDDEBUG + if (erts_smp_atomic_read(&tb->common.memory_size) != sizeof(DbTable)) { + erts_fprintf(stderr, "ets: db_unref memory remain=%ld fix=%x\n", + erts_smp_atomic_read(&tb->common.memory_size)-sizeof(DbTable), + tb->common.fixations); + } + erts_fprintf(stderr, "ets: db_unref(%T) deleted!!!\r\n", + tb->common.id); + + erts_fprintf(stderr, "ets: db_unref: meta_pid_to_tab common.memory_size = %ld\n", + erts_smp_atomic_read(&meta_pid_to_tab->common.memory_size)); + print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_tab); + + + erts_fprintf(stderr, "ets: db_unref: meta_pid_to_fixed_tab common.memory_size = %ld\n", + erts_smp_atomic_read(&meta_pid_to_fixed_tab->common.memory_size)); + print_table(ERTS_PRINT_STDOUT, NULL, 1, meta_pid_to_fixed_tab); + +#endif +#ifdef ERTS_SMP + erts_smp_rwmtx_destroy(&tb->common.rwlock); + erts_smp_mtx_destroy(&tb->common.fixlock); +#endif + ASSERT(is_immed(tb->common.heir_data)); + erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(DbTable)); + return NULL; + } + return tb; +} + +static ERTS_INLINE void db_init_lock(DbTable* tb, char *rwname, char* fixname) +{ + erts_refc_init(&tb->common.ref, 1); + erts_refc_init(&tb->common.fixref, 0); +#ifdef ERTS_SMP +# ifdef ERTS_ENABLE_LOCK_COUNT + erts_smp_rwmtx_init_x(&tb->common.rwlock, rwname, tb->common.the_name); + erts_smp_mtx_init_x(&tb->common.fixlock, fixname, tb->common.the_name); +# else + erts_smp_rwmtx_init(&tb->common.rwlock, rwname); + erts_smp_mtx_init(&tb->common.fixlock, fixname); +# endif + tb->common.is_thread_safe = !(tb->common.status & DB_FINE_LOCKED); +#endif +} + +static ERTS_INLINE void db_lock_take_over_ref(DbTable* tb, db_lock_kind_t kind) +{ +#ifdef ERTS_SMP + ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab); + if (tb->common.type & DB_FINE_LOCKED) { + if (kind == LCK_WRITE) { + erts_smp_rwmtx_rwlock(&tb->common.rwlock); + tb->common.is_thread_safe = 1; + } else { + erts_smp_rwmtx_rlock(&tb->common.rwlock); + ASSERT(!tb->common.is_thread_safe); + } + } + else + { + switch (kind) { + case LCK_WRITE: + case LCK_WRITE_REC: + erts_smp_rwmtx_rwlock(&tb->common.rwlock); + break; + default: + erts_smp_rwmtx_rlock(&tb->common.rwlock); + } + ASSERT(tb->common.is_thread_safe); + } +#endif +} + +static ERTS_INLINE void db_lock(DbTable* tb, db_lock_kind_t kind) +{ + (void) db_ref(tb); +#ifdef ERTS_SMP + db_lock_take_over_ref(tb, kind); +#endif +} + +static ERTS_INLINE void db_unlock(DbTable* tb, db_lock_kind_t kind) +{ +#ifdef ERTS_SMP + ASSERT(tb != meta_pid_to_tab && tb != meta_pid_to_fixed_tab); + + if (tb->common.type & DB_FINE_LOCKED) { + if (tb->common.is_thread_safe) { + ASSERT(kind == LCK_WRITE); + tb->common.is_thread_safe = 0; + erts_smp_rwmtx_rwunlock(&tb->common.rwlock); + } + else { + ASSERT(kind != LCK_WRITE); + erts_smp_rwmtx_runlock(&tb->common.rwlock); + } + } + else { + ASSERT(tb->common.is_thread_safe); + switch (kind) { + case LCK_WRITE: + case LCK_WRITE_REC: + erts_smp_rwmtx_rwunlock(&tb->common.rwlock); + break; + default: + erts_smp_rwmtx_runlock(&tb->common.rwlock); + } + } +#endif + (void) db_unref(tb); /* May delete table... */ +} + + +static ERTS_INLINE void db_meta_lock(DbTable* tb, db_lock_kind_t kind) +{ + ASSERT(tb == meta_pid_to_tab || tb == meta_pid_to_fixed_tab); + ASSERT(kind != LCK_WRITE); + /* As long as we only lock for READ we don't have to lock at all. */ +} + +static ERTS_INLINE void db_meta_unlock(DbTable* tb, db_lock_kind_t kind) +{ + ASSERT(tb == meta_pid_to_tab || tb == meta_pid_to_fixed_tab); + ASSERT(kind != LCK_WRITE); +} + +static ERTS_INLINE +DbTable* db_get_table(Process *p, + Eterm id, + int what, + db_lock_kind_t kind) +{ + DbTable *tb = NULL; + + if (is_small(id)) { + Uint slot = unsigned_val(id) & meta_main_tab_slot_mask; + meta_main_tab_lock(slot); + if (slot < db_max_tabs && IS_SLOT_ALIVE(slot)) { + /* SMP: inc to prevent race, between unlock of meta_main_tab_lock + * and the table locking outside the meta_main_tab_lock + */ + tb = db_ref(meta_main_tab[slot].u.tb); + } + meta_main_tab_unlock(slot); + } + else if (is_atom(id)) { + erts_smp_rwmtx_t* rwlock; + struct meta_name_tab_entry* bucket = meta_name_tab_bucket(id,&rwlock); + erts_smp_rwmtx_rlock(rwlock); + if (bucket->pu.tb != NULL) { + if (is_atom(bucket->u.name_atom)) { /* single */ + if (bucket->u.name_atom == id) { + tb = db_ref(bucket->pu.tb); + } + } + else { /* multi */ + Uint cnt = unsigned_val(bucket->u.mcnt); + Uint i; + for (i=0; ipu.mvec[i].u.name_atom == id) { + tb = db_ref(bucket->pu.mvec[i].pu.tb); + break; + } + } + } + } + erts_smp_rwmtx_runlock(rwlock); + } + if (tb) { + db_lock_take_over_ref(tb, kind); + if (tb->common.id == id && ((tb->common.status & what) != 0 || + p->id == tb->common.owner)) { + return tb; + } + db_unlock(tb, kind); + } + return NULL; +} + +/* Requires meta_main_tab_locks[slot] locked. +*/ +static ERTS_INLINE void free_slot(int slot) +{ + ASSERT(!IS_SLOT_FREE(slot)); + erts_smp_spin_lock(&meta_main_tab_main_lock); + SET_NEXT_FREE_SLOT(slot,meta_main_tab_first_free); + meta_main_tab_first_free = slot; + meta_main_tab_cnt--; + erts_smp_spin_unlock(&meta_main_tab_main_lock); +} + +static int insert_named_tab(Eterm name_atom, DbTable* tb) +{ + int ret = 0; + erts_smp_rwmtx_t* rwlock; + struct meta_name_tab_entry* new_entry; + struct meta_name_tab_entry* bucket = meta_name_tab_bucket(name_atom, + &rwlock); + + erts_smp_rwmtx_rwlock(rwlock); + + if (bucket->pu.tb == NULL) { /* empty */ + new_entry = bucket; + } + else { + struct meta_name_tab_entry* entries; + Uint cnt; + if (is_atom(bucket->u.name_atom)) { /* single */ + size_t size; + if (bucket->u.name_atom == name_atom) { + goto done; + } + cnt = 2; + size = sizeof(struct meta_name_tab_entry)*cnt; + entries = erts_db_alloc_nt(ERTS_ALC_T_DB_NTAB_ENT, size); + ERTS_ETS_MISC_MEM_ADD(size); + new_entry = &entries[0]; + entries[1] = *bucket; + } + else { /* multi */ + size_t size, old_size; + Uint i; + cnt = unsigned_val(bucket->u.mcnt); + for (i=0; ipu.mvec[i].u.name_atom == name_atom) { + goto done; + } + } + old_size = sizeof(struct meta_name_tab_entry)*cnt; + size = sizeof(struct meta_name_tab_entry)*(cnt+1); + entries = erts_db_realloc_nt(ERTS_ALC_T_DB_NTAB_ENT, + bucket->pu.mvec, + old_size, + size); + ERTS_ETS_MISC_MEM_ADD(size-old_size); + new_entry = &entries[cnt]; + cnt++; + } + bucket->pu.mvec = entries; + bucket->u.mcnt = make_small(cnt); + } + new_entry->pu.tb = tb; + new_entry->u.name_atom = name_atom; + ret = 1; /* Ok */ + +done: + erts_smp_rwmtx_rwunlock(rwlock); + return ret; +} + +static int remove_named_tab(Eterm name_atom) +{ + int ret = 0; + erts_smp_rwmtx_t* rwlock; + struct meta_name_tab_entry* bucket = meta_name_tab_bucket(name_atom, + &rwlock); + erts_smp_rwmtx_rwlock(rwlock); + if (bucket->pu.tb == NULL) { + goto done; + } + else if (is_atom(bucket->u.name_atom)) { /* single */ + if (bucket->u.name_atom != name_atom) { + goto done; + } + bucket->pu.tb = NULL; + } + else { /* multi */ + Uint cnt = unsigned_val(bucket->u.mcnt); + Uint i = 0; + for (;;) { + if (bucket->pu.mvec[i].u.name_atom == name_atom) { + break; + } + if (++i >= cnt) { + goto done; + } + } + if (cnt == 2) { /* multi -> single */ + size_t size; + struct meta_name_tab_entry* entries = bucket->pu.mvec; + *bucket = entries[1-i]; + size = sizeof(struct meta_name_tab_entry)*cnt; + erts_db_free_nt(ERTS_ALC_T_DB_NTAB_ENT, entries, size); + ERTS_ETS_MISC_MEM_ADD(-size); + ASSERT(is_atom(bucket->u.name_atom)); + } + else { + size_t size, old_size; + ASSERT(cnt > 2); + bucket->u.mcnt = make_small(--cnt); + if (i != cnt) { + /* reposition last one before realloc destroys it */ + bucket->pu.mvec[i] = bucket->pu.mvec[cnt]; + } + old_size = sizeof(struct meta_name_tab_entry)*(cnt+1); + size = sizeof(struct meta_name_tab_entry)*cnt; + bucket->pu.mvec = erts_db_realloc_nt(ERTS_ALC_T_DB_NTAB_ENT, + bucket->pu.mvec, + old_size, + size); + ERTS_ETS_MISC_MEM_ADD(size - old_size); + + } + } + ret = 1; /* Ok */ + +done: + erts_smp_rwmtx_rwunlock(rwlock); + return ret; +} + +/* Do a fast fixation of a hash table. +** Must be matched by a local unfix before releasing table lock. +*/ +static ERTS_INLINE void local_fix_table(DbTable* tb) +{ + erts_refc_inc(&tb->common.fixref, 1); +} +static ERTS_INLINE void local_unfix_table(DbTable* tb) +{ + if (erts_refc_dectest(&tb->common.fixref, 0) == 0) { + ASSERT(IS_HASH_TABLE(tb->common.status)); + db_unfix_table_hash(&(tb->hash)); + } +} + + +/* + * BIFs. + */ + +BIF_RETTYPE ets_safe_fixtable_2(BIF_ALIST_2) +{ + DbTable *tb; + db_lock_kind_t kind; +#ifdef HARDDEBUG + erts_fprintf(stderr, + "ets:safe_fixtable(%T,%T); Process: %T, initial: %T:%T/%bpu\n", + BIF_ARG_1, BIF_ARG_2, BIF_P->id, + BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); +#endif + kind = (BIF_ARG_2 == am_true) ? LCK_READ : LCK_WRITE_REC; + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, kind)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + if (BIF_ARG_2 == am_true) { + fix_table_locked(BIF_P, tb); + } + else if (BIF_ARG_2 == am_false) { + if (IS_FIXED(tb)) { + unfix_table_locked(BIF_P, tb, &kind); + } + } + else { + db_unlock(tb, kind); + BIF_ERROR(BIF_P, BADARG); + } + db_unlock(tb, kind); + BIF_RET(am_true); +} + + +/* +** Returns the first Key in a table +*/ +BIF_RETTYPE ets_first_1(BIF_ALIST_1) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ); + + if (!tb) { + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_first(BIF_P, tb, &ret); + + db_unlock(tb, LCK_READ); + + if (cret != DB_ERROR_NONE) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(ret); +} + +/* +** The next BIF, given a key, return the "next" key +*/ +BIF_RETTYPE ets_next_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ); + + if (!tb) { + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_next(BIF_P, tb, BIF_ARG_2, &ret); + + db_unlock(tb, LCK_READ); + + if (cret != DB_ERROR_NONE) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(ret); +} + +/* +** Returns the last Key in a table +*/ +BIF_RETTYPE ets_last_1(BIF_ALIST_1) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ); + + if (!tb) { + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_last(BIF_P, tb, &ret); + + db_unlock(tb, LCK_READ); + + if (cret != DB_ERROR_NONE) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(ret); +} + +/* +** The prev BIF, given a key, return the "previous" key +*/ +BIF_RETTYPE ets_prev_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ); + + if (!tb) { + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_prev(BIF_P,tb,BIF_ARG_2,&ret); + + db_unlock(tb, LCK_READ); + + if (cret != DB_ERROR_NONE) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(ret); +} + +/* +** update_element(Tab, Key, {Pos, Value}) +** update_element(Tab, Key, [{Pos, Value}]) +*/ +BIF_RETTYPE ets_update_element_3(BIF_ALIST_3) +{ + DbTable* tb; + int cret = DB_ERROR_BADITEM; + Eterm list; + Eterm iter; + Eterm cell[2]; + DbUpdateHandle handle; + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + if (!(tb->common.status & (DB_SET | DB_ORDERED_SET))) { + goto bail_out; + } + if (is_tuple(BIF_ARG_3)) { + list = CONS(cell, BIF_ARG_3, NIL); + } + else { + list = BIF_ARG_3; + } + + if (!tb->common.meth->db_lookup_dbterm(tb, BIF_ARG_2, &handle)) { + cret = DB_ERROR_BADKEY; + goto bail_out; + } + + /* First verify that list is ok to avoid nasty rollback scenarios + */ + for (iter=list ; is_not_nil(iter); iter = CDR(list_val(iter))) { + Eterm pv; + Eterm* pvp; + Sint position; + + if (is_not_list(iter)) { + goto finalize; + } + pv = CAR(list_val(iter)); /* {Pos,Value} */ + if (is_not_tuple(pv)) { + goto finalize; + } + pvp = tuple_val(pv); + if (arityval(*pvp) != 2 || !is_small(pvp[1])) { + goto finalize; + } + position = signed_val(pvp[1]); + if (position < 1 || position == tb->common.keypos || + position > arityval(handle.dbterm->tpl[0])) { + goto finalize; + } + } + /* The point of no return, no failures from here on. + */ + cret = DB_ERROR_NONE; + + for (iter=list ; is_not_nil(iter); iter = CDR(list_val(iter))) { + Eterm* pvp = tuple_val(CAR(list_val(iter))); /* {Pos,Value} */ + db_do_update_element(&handle, signed_val(pvp[1]), pvp[2]); + } + +finalize: + tb->common.meth->db_finalize_dbterm(&handle); + +bail_out: + db_unlock(tb, LCK_WRITE_REC); + + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(am_true); + case DB_ERROR_BADKEY: + BIF_RET(am_false); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + break; + } +} + +/* +** update_counter(Tab, Key, Incr) +** update_counter(Tab, Key, {Upop}) +** update_counter(Tab, Key, [{Upop}]) +** Upop = {Pos,Incr} | {Pos,Incr,Threshold,WarpTo} +** Returns new value(s) (integer or [integer]) +*/ +BIF_RETTYPE ets_update_counter_3(BIF_ALIST_3) +{ + DbTable* tb; + int cret = DB_ERROR_BADITEM; + Eterm upop_list; + int list_size; + Eterm ret; /* int or [int] */ + Eterm* ret_list_currp = NULL; + Eterm* ret_list_prevp = NULL; + Eterm iter; + Eterm cell[2]; + Eterm tuple[3]; + DbUpdateHandle handle; + Uint halloc_size = 0; /* overestimated heap usage */ + Eterm* htop; /* actual heap usage */ + Eterm* hstart; + Eterm* hend; + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + if (!(tb->common.status & (DB_SET | DB_ORDERED_SET))) { + goto bail_out; + } + if (is_integer(BIF_ARG_3)) { /* Incr */ + upop_list = CONS(cell, TUPLE2(tuple, make_small(tb->common.keypos+1), + BIF_ARG_3), NIL); + } + else if (is_tuple(BIF_ARG_3)) { /* {Upop} */ + upop_list = CONS(cell, BIF_ARG_3, NIL); + } + else { /* [{Upop}] (probably) */ + upop_list = BIF_ARG_3; + ret_list_prevp = &ret; + } + + if (!tb->common.meth->db_lookup_dbterm(tb, BIF_ARG_2, &handle)) { + goto bail_out; /* key not found */ + } + + /* First verify that list is ok to avoid nasty rollback scenarios + */ + list_size = 0; + for (iter=upop_list ; is_not_nil(iter); iter = CDR(list_val(iter)), + list_size += 2) { + Eterm upop; + Eterm* tpl; + Sint position; + Eterm incr, warp, oldcnt; + + if (is_not_list(iter)) { + goto finalize; + } + upop = CAR(list_val(iter)); + if (is_not_tuple(upop)) { + goto finalize; + } + tpl = tuple_val(upop); + switch (arityval(*tpl)) { + case 4: /* threshold specified */ + if (is_not_integer(tpl[3])) { + goto finalize; + } + warp = tpl[4]; + if (is_big(warp)) { + halloc_size += BIG_NEED_SIZE(big_arity(warp)); + } + else if (is_not_small(warp)) { + goto finalize; + } + /* Fall through */ + case 2: + if (!is_small(tpl[1])) { + goto finalize; + } + incr = tpl[2]; + if (is_big(incr)) { + halloc_size += BIG_NEED_SIZE(big_arity(incr)); + } + else if (is_not_small(incr)) { + goto finalize; + } + position = signed_val(tpl[1]); + if (position < 1 || position == tb->common.keypos || + position > arityval(handle.dbterm->tpl[0])) { + goto finalize; + } + oldcnt = handle.dbterm->tpl[position]; + if (is_big(oldcnt)) { + halloc_size += BIG_NEED_SIZE(big_arity(oldcnt)); + } + else if (is_not_small(oldcnt)) { + goto finalize; + } + break; + default: + goto finalize; + } + halloc_size += 2; /* worst growth case: small(0)+small(0)=big(2) */ + } + + /* The point of no return, no failures from here on. + */ + cret = DB_ERROR_NONE; + + if (ret_list_prevp) { /* Prepare to return a list */ + ret = NIL; + halloc_size += list_size; + hstart = HAlloc(BIF_P, halloc_size); + ret_list_currp = hstart; + htop = hstart + list_size; + hend = hstart + halloc_size; + } + else { + hstart = htop = HAlloc(BIF_P, halloc_size); + } + hend = hstart + halloc_size; + + for (iter=upop_list ; is_not_nil(iter); iter = CDR(list_val(iter))) { + + Eterm* tpl = tuple_val(CAR(list_val(iter))); + Sint position = signed_val(tpl[1]); + Eterm incr = tpl[2]; + Eterm oldcnt = handle.dbterm->tpl[position]; + Eterm newcnt = db_add_counter(&htop, oldcnt, incr); + + if (newcnt == NIL) { + cret = DB_ERROR_SYSRES; /* Can only happen if BIG_ARITY_MAX */ + ret = NIL; /* is reached, ie should not happen */ + htop = hstart; + break; + } + ASSERT(is_integer(newcnt)); + + if (arityval(*tpl) == 4) { /* Maybe warp it */ + Eterm threshold = tpl[3]; + if ((cmp(incr,make_small(0)) < 0) ? /* negative increment? */ + (cmp(newcnt,threshold) < 0) : /* if negative, check if below */ + (cmp(newcnt,threshold) > 0)) { /* else check if above threshold */ + + newcnt = tpl[4]; + } + } + + db_do_update_element(&handle,position,newcnt); + + if (ret_list_prevp) { + *ret_list_prevp = CONS(ret_list_currp,newcnt,NIL); + ret_list_prevp = &CDR(ret_list_currp); + ret_list_currp += 2; + } + else { + ret = newcnt; + break; + } + } + + ASSERT(is_integer(ret) || is_nil(ret) || + (is_list(ret) && (list_val(ret)+list_size)==ret_list_currp)); + ASSERT(htop <= hend); + + HRelease(BIF_P,hend,htop); + +finalize: + tb->common.meth->db_finalize_dbterm(&handle); + +bail_out: + db_unlock(tb, LCK_WRITE_REC); + + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(ret); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + break; + } +} + +/* +** The put BIF +*/ +BIF_RETTYPE ets_insert_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret = DB_ERROR_NONE; + Eterm lst; + DbTableMethod* meth; + db_lock_kind_t kind; + + CHECK_TABLES(); + + /* Write lock table if more than one object to keep atomicy */ + kind = ((is_list(BIF_ARG_2) && CDR(list_val(BIF_ARG_2)) != NIL) + ? LCK_WRITE : LCK_WRITE_REC); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + if (BIF_ARG_2 == NIL) { + db_unlock(tb, kind); + BIF_RET(am_true); + } + meth = tb->common.meth; + if (is_list(BIF_ARG_2)) { + for (lst = BIF_ARG_2; is_list(lst); lst = CDR(list_val(lst))) { + if (is_not_tuple(CAR(list_val(lst))) || + (arityval(*tuple_val(CAR(list_val(lst)))) < tb->common.keypos)) { + goto badarg; + } + } + if (lst != NIL) { + goto badarg; + } + for (lst = BIF_ARG_2; is_list(lst); lst = CDR(list_val(lst))) { + cret = meth->db_put(tb, CAR(list_val(lst)), 0); + if (cret != DB_ERROR_NONE) + break; + } + } else { + if (is_not_tuple(BIF_ARG_2) || + (arityval(*tuple_val(BIF_ARG_2)) < tb->common.keypos)) { + goto badarg; + } + cret = meth->db_put(tb, BIF_ARG_2, 0); + } + + db_unlock(tb, kind); + + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(am_true); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + } + badarg: + db_unlock(tb, kind); + BIF_ERROR(BIF_P, BADARG); +} + + +/* +** The put-if-not-already-there BIF... +*/ +BIF_RETTYPE ets_insert_new_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret = DB_ERROR_NONE; + Eterm ret = am_true; + Eterm obj; + db_lock_kind_t kind; + + CHECK_TABLES(); + + if (is_list(BIF_ARG_2)) { + if (CDR(list_val(BIF_ARG_2)) != NIL) { + Eterm lst; + Eterm lookup_ret; + DbTableMethod* meth; + + /* More than one object, use LCK_WRITE to keep atomicy */ + kind = LCK_WRITE; + tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind); + if (tb == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + meth = tb->common.meth; + for (lst = BIF_ARG_2; is_list(lst); lst = CDR(list_val(lst))) { + if (is_not_tuple(CAR(list_val(lst))) + || (arityval(*tuple_val(CAR(list_val(lst)))) + < tb->common.keypos)) { + goto badarg; + } + } + if (lst != NIL) { + goto badarg; + } + for (lst = BIF_ARG_2; is_list(lst); lst = CDR(list_val(lst))) { + cret = meth->db_member(tb, TERM_GETKEY(tb,CAR(list_val(lst))), + &lookup_ret); + if ((cret != DB_ERROR_NONE) || (lookup_ret != am_false)) { + ret = am_false; + goto done; + } + } + + for (lst = BIF_ARG_2; is_list(lst); lst = CDR(list_val(lst))) { + cret = meth->db_put(tb,CAR(list_val(lst)), 0); + if (cret != DB_ERROR_NONE) + break; + } + goto done; + } + obj = CAR(list_val(BIF_ARG_2)); + } + else { + obj = BIF_ARG_2; + } + /* Only one object (or NIL) + */ + kind = LCK_WRITE_REC; + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, kind)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + if (BIF_ARG_2 == NIL) { + db_unlock(tb, kind); + BIF_RET(am_true); + } + if (is_not_tuple(obj) + || (arityval(*tuple_val(obj)) < tb->common.keypos)) { + goto badarg; + } + cret = tb->common.meth->db_put(tb, obj, + 1); /* key_clash_fail */ + +done: + db_unlock(tb, kind); + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(ret); + case DB_ERROR_BADKEY: + BIF_RET(am_false); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + } + badarg: + db_unlock(tb, kind); + BIF_ERROR(BIF_P, BADARG); +} + +/* +** Rename a (possibly) named table +*/ + +BIF_RETTYPE ets_rename_2(BIF_ALIST_2) +{ + DbTable* tb; + Eterm ret; + +#ifdef HARDDEBUG + erts_fprintf(stderr, + "ets:rename(%T,%T); Process: %T, initial: %T:%T/%bpu\n", + BIF_ARG_1, BIF_ARG_2, BIF_P->id, + BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); +#endif + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_not_atom(BIF_ARG_2)) { + goto badarg; + } + + if (is_not_atom(tb->common.id)) { /* Not a named table */ + tb->common.the_name = BIF_ARG_2; + goto done; + } + + if (!insert_named_tab(BIF_ARG_2,tb)) { + goto badarg; + } + if (!remove_named_tab(tb->common.id)) { + erl_exit(1,"Could not find named tab %s", tb->common.id); + } + + tb->common.id = tb->common.the_name = BIF_ARG_2; + + done: + ret = tb->common.id; + db_unlock(tb, LCK_WRITE); + BIF_RET(ret); + badarg: + db_unlock(tb, LCK_WRITE); + BIF_ERROR(BIF_P, BADARG); +} + + +/* +** The create table BIF +** Args: (Name, Properties) +*/ + +BIF_RETTYPE ets_new_2(BIF_ALIST_2) +{ + DbTable* tb = NULL; + int slot; + Eterm list; + Eterm val; + Eterm ret; + Eterm heir; + Eterm heir_data; + Uint32 status; + Sint keypos; + int is_named, is_fine_locked; + int cret; + Eterm meta_tuple[3]; + DbTableMethod* meth; + + if (is_not_atom(BIF_ARG_1)) { + BIF_ERROR(BIF_P, BADARG); + } + if (is_not_nil(BIF_ARG_2) && is_not_list(BIF_ARG_2)) { + BIF_ERROR(BIF_P, BADARG); + } + + status = DB_NORMAL | DB_SET | DB_PROTECTED; + keypos = 1; + is_named = 0; + is_fine_locked = 0; + heir = am_none; + heir_data = am_undefined; + + list = BIF_ARG_2; + while(is_list(list)) { + val = CAR(list_val(list)); + if (val == am_bag) { + status |= DB_BAG; + status &= ~(DB_SET | DB_DUPLICATE_BAG | DB_ORDERED_SET); + } + else if (val == am_duplicate_bag) { + status |= DB_DUPLICATE_BAG; + status &= ~(DB_SET | DB_BAG | DB_ORDERED_SET); + } + else if (val == am_ordered_set) { + status |= DB_ORDERED_SET; + status &= ~(DB_SET | DB_BAG | DB_DUPLICATE_BAG); + } + /*TT*/ + else if (is_tuple(val)) { + Eterm *tp = tuple_val(val); + if (arityval(tp[0]) == 2) { + if (tp[1] == am_keypos + && is_small(tp[2]) && (signed_val(tp[2]) > 0)) { + keypos = signed_val(tp[2]); + } + else if (tp[1] == am_write_concurrency) { + if (tp[2] == am_true) { + is_fine_locked = 1; + } else if (tp[2] == am_false) { + is_fine_locked = 0; + } else break; + } + else if (tp[1] == am_heir && tp[2] == am_none) { + heir = am_none; + heir_data = am_undefined; + } + else break; + } + else if (arityval(tp[0]) == 3 && tp[1] == am_heir + && is_internal_pid(tp[2])) { + heir = tp[2]; + heir_data = tp[3]; + } + else break; + } + else if (val == am_public) { + status |= DB_PUBLIC; + status &= ~(DB_PROTECTED|DB_PRIVATE); + } + else if (val == am_private) { + status |= DB_PRIVATE; + status &= ~(DB_PROTECTED|DB_PUBLIC); + } + else if (val == am_named_table) { + is_named = 1; + } + else if (val == am_set || val == am_protected) + ; + else break; + + list = CDR(list_val(list)); + } + if (is_not_nil(list)) { /* bad opt or not a well formed list */ + BIF_ERROR(BIF_P, BADARG); + } + if (IS_HASH_TABLE(status)) { + meth = &db_hash; + #ifdef ERTS_SMP + if (is_fine_locked && !(status & DB_PRIVATE)) { + status |= DB_FINE_LOCKED; + } + #endif + } + else if (IS_TREE_TABLE(status)) { + meth = &db_tree; + } + else { + BIF_ERROR(BIF_P, BADARG); + } + + /* we create table outside any table lock + * and take the unusal cost of destroy table if it + * fails to find a slot + */ + { + DbTable init_tb; + + erts_smp_atomic_init(&init_tb.common.memory_size, 0); + tb = (DbTable*) erts_db_alloc(ERTS_ALC_T_DB_TABLE, + &init_tb, sizeof(DbTable)); + ERTS_ETS_MISC_MEM_ADD(sizeof(DbTable)); + erts_smp_atomic_init(&tb->common.memory_size, + erts_smp_atomic_read(&init_tb.common.memory_size)); + } + + tb->common.meth = meth; + tb->common.the_name = BIF_ARG_1; + tb->common.status = status; +#ifdef ERTS_SMP + tb->common.type = status & ERTS_ETS_TABLE_TYPES; + /* Note, 'type' is *read only* from now on... */ +#endif + db_init_lock(tb, "db_tab", "db_tab_fix"); + tb->common.keypos = keypos; + tb->common.owner = BIF_P->id; + set_heir(BIF_P, tb, heir, heir_data); + + erts_smp_atomic_init(&tb->common.nitems, 0); + + tb->common.fixations = NULL; + + cret = meth->db_create(BIF_P, tb); + ASSERT(cret == DB_ERROR_NONE); + + erts_smp_spin_lock(&meta_main_tab_main_lock); + + if (meta_main_tab_cnt >= db_max_tabs) { + erts_smp_spin_unlock(&meta_main_tab_main_lock); + erts_send_error_to_logger_str(BIF_P->group_leader, + "** Too many db tables **\n"); + free_heir_data(tb); + tb->common.meth->db_free_table(tb); + erts_db_free(ERTS_ALC_T_DB_TABLE, tb, (void *) tb, sizeof(DbTable)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(DbTable)); + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + } + + slot = meta_main_tab_first_free; + ASSERT(slot>=0 && slotcommon.id = ret; + tb->common.slot = slot; /* store slot for erase */ + + meta_main_tab_lock(slot); + meta_main_tab[slot].u.tb = tb; + ASSERT(IS_SLOT_ALIVE(slot)); + meta_main_tab_unlock(slot); + + if (is_named && !insert_named_tab(BIF_ARG_1, tb)) { + meta_main_tab_lock(slot); + free_slot(slot); + meta_main_tab_unlock(slot); + + db_lock_take_over_ref(tb,LCK_WRITE); + free_heir_data(tb); + tb->common.meth->db_free_table(tb); + db_unlock(tb,LCK_WRITE); + BIF_ERROR(BIF_P, BADARG); + } + + BIF_P->flags |= F_USING_DB; /* So we can remove tb if p dies */ + +#ifdef HARDDEBUG + erts_fprintf(stderr, + "ets:new(%T,%T)=%T; Process: %T, initial: %T:%T/%bpu\n", + BIF_ARG_1, BIF_ARG_2, ret, BIF_P->id, + BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); + erts_fprintf(stderr, "ets: new: meta_pid_to_tab common.memory_size = %ld\n", + erts_smp_atomic_read(&meta_pid_to_tab->common.memory_size)); + erts_fprintf(stderr, "ets: new: meta_pid_to_fixed_tab common.memory_size = %ld\n", + erts_smp_atomic_read(&meta_pid_to_fixed_tab->common.memory_size)); +#endif + + db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC); + if (db_put_hash(meta_pid_to_tab, + TUPLE2(meta_tuple, BIF_P->id, make_small(slot)), + 0) != DB_ERROR_NONE) { + erl_exit(1,"Could not update ets metadata."); + } + db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); + + BIF_RET(ret); +} + +/* +** The lookup BIF +*/ +BIF_RETTYPE ets_lookup_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_get(BIF_P, tb, BIF_ARG_2, &ret); + + db_unlock(tb, LCK_READ); + + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(ret); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + } + +} + +/* +** The lookup BIF +*/ +BIF_RETTYPE ets_member_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_member(tb, BIF_ARG_2, &ret); + + db_unlock(tb, LCK_READ); + + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(ret); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + } + +} + +/* +** Get an element from a term +** get_element_3(Tab, Key, Index) +** return the element or a list of elements if bag +*/ +BIF_RETTYPE ets_lookup_element_3(BIF_ALIST_3) +{ + DbTable* tb; + Sint index; + int cret; + Eterm ret; + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + if (is_not_small(BIF_ARG_3) || ((index = signed_val(BIF_ARG_3)) < 1)) { + db_unlock(tb, LCK_READ); + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_get_element(BIF_P, tb, + BIF_ARG_2, index, &ret); + db_unlock(tb, LCK_READ); + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(ret); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + } +} + +/* + * BIF to erase a whole table and release all memory it holds + */ +BIF_RETTYPE ets_delete_1(BIF_ALIST_1) +{ + int trap; + DbTable* tb; + +#ifdef HARDDEBUG + erts_fprintf(stderr, + "ets:delete(%T); Process: %T, initial: %T:%T/%bpu\n", + BIF_ARG_1, BIF_P->id, + BIF_P->initial[0], BIF_P->initial[1], BIF_P->initial[2]); +#endif + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + /* + * Clear all access bits to prevent any ets operation to access the + * table while it is being deleted. + */ + tb->common.status &= ~(DB_PROTECTED|DB_PUBLIC|DB_PRIVATE); + tb->common.status |= DB_DELETE; + + meta_main_tab_lock(tb->common.slot); + /* We must keep the slot, to be found by db_proc_dead() if process dies */ + MARK_SLOT_DEAD(tb->common.slot); + meta_main_tab_unlock(tb->common.slot); + if (is_atom(tb->common.id)) { + remove_named_tab(tb->common.id); + } + + if (tb->common.owner != BIF_P->id) { + Eterm meta_tuple[3]; + + /* + * The table is being deleted by a process other than its owner. + * To make sure that the table will be completely deleted if the + * current process will be killed (e.g. by an EXIT signal), we will + * now transfer the ownership to the current process. + */ + db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC); + db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner, + make_small(tb->common.slot)); + + BIF_P->flags |= F_USING_DB; + tb->common.owner = BIF_P->id; + + db_put_hash(meta_pid_to_tab, + TUPLE2(meta_tuple,BIF_P->id,make_small(tb->common.slot)), + 0); + db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); + } + /* disable inheritance */ + free_heir_data(tb); + tb->common.heir = am_none; + + free_fixations_locked(tb); + + trap = free_table_cont(BIF_P, tb, 1, 1); + db_unlock(tb, LCK_WRITE); + if (trap) { + /* + * Package the DbTable* pointer into a bignum so that it can be safely + * passed through a trap. We used to pass the DbTable* pointer directly + * (it looks like an continuation pointer), but that is will crash the + * emulator if this BIF is call traced. + */ + Eterm *hp = HAlloc(BIF_P, 2); + hp[0] = make_pos_bignum_header(1); + hp[1] = (Eterm) tb; + BIF_TRAP1(&ets_delete_continue_exp, BIF_P, make_big(hp)); + } + else { + BIF_RET(am_true); + } +} + +/* +** BIF ets:give_away(Tab, Pid, GiftData) +*/ +BIF_RETTYPE ets_give_away_3(BIF_ALIST_3) +{ + Process* to_proc = NULL; + ErtsProcLocks to_locks = ERTS_PROC_LOCK_MAIN; + Eterm buf[5]; + Eterm to_pid = BIF_ARG_2; + Eterm from_pid; + DbTable* tb = NULL; + + if (!is_internal_pid(to_pid)) { + goto badarg; + } + to_proc = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, to_pid, to_locks); + if (to_proc == NULL) { + goto badarg; + } + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL + || tb->common.owner != BIF_P->id) { + goto badarg; + } + from_pid = tb->common.owner; + if (to_pid == from_pid) { + goto badarg; /* or should we be idempotent? return false maybe */ + } + + db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC); + db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner, + make_small(tb->common.slot)); + + to_proc->flags |= F_USING_DB; + tb->common.owner = to_pid; + + db_put_hash(meta_pid_to_tab, + TUPLE2(buf,to_pid,make_small(tb->common.slot)), + 0); + db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); + + db_unlock(tb,LCK_WRITE); + erts_send_message(BIF_P, to_proc, &to_locks, + TUPLE4(buf, am_ETS_TRANSFER, tb->common.id, from_pid, BIF_ARG_3), + 0); + erts_smp_proc_unlock(to_proc, to_locks); + BIF_RET(am_true); + +badarg: + if (to_proc != NULL && to_proc != BIF_P) erts_smp_proc_unlock(to_proc, to_locks); + if (tb != NULL) db_unlock(tb, LCK_WRITE); + BIF_ERROR(BIF_P, BADARG); +} + +BIF_RETTYPE ets_setopts_2(BIF_ALIST_2) +{ + DbTable* tb = NULL; + Eterm* tp; + Eterm opt; + Eterm heir = THE_NON_VALUE; + Eterm heir_data = THE_NON_VALUE; + Uint32 protection = 0; + Eterm fakelist[2]; + Eterm tail; + + for (tail = is_tuple(BIF_ARG_2) ? CONS(fakelist, BIF_ARG_2, NIL) : BIF_ARG_2; + is_list(tail); + tail = CDR(list_val(tail))) { + + opt = CAR(list_val(tail)); + if (!is_tuple(opt) || (tp = tuple_val(opt), arityval(tp[0]) < 2)) { + goto badarg; + } + + switch (tp[1]) { + case am_heir: + if (heir != THE_NON_VALUE) goto badarg; + heir = tp[2]; + if (arityval(tp[0]) == 2 && heir == am_none) { + heir_data = am_undefined; + } + else if (arityval(tp[0]) == 3 && is_internal_pid(heir)) { + heir_data = tp[3]; + } + else goto badarg; + break; + + case am_protection: + if (arityval(tp[0]) != 2 || protection != 0) goto badarg; + switch (tp[2]) { + case am_private: protection = DB_PRIVATE; break; + case am_protected: protection = DB_PROTECTED; break; + case am_public: protection = DB_PUBLIC; break; + default: goto badarg; + } + break; + + default: goto badarg; + } + } + + if (tail != NIL + || (tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL + || tb->common.owner != BIF_P->id) { + goto badarg; + } + + if (heir_data != THE_NON_VALUE) { + free_heir_data(tb); + set_heir(BIF_P, tb, heir, heir_data); + } + if (protection) { + tb->common.status &= ~(DB_PRIVATE|DB_PROTECTED|DB_PUBLIC); + tb->common.status |= protection; + } + + db_unlock (tb,LCK_WRITE); + BIF_RET(am_true); + +badarg: + if (tb != NULL) { + db_unlock(tb,LCK_WRITE); + } + BIF_ERROR(BIF_P, BADARG); +} + +/* +** BIF to erase a whole table and release all memory it holds +*/ +BIF_RETTYPE ets_delete_all_objects_1(BIF_ALIST_1) +{ + DbTable* tb; + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + tb->common.meth->db_delete_all_objects(BIF_P, tb); + + db_unlock(tb, LCK_WRITE); + + BIF_RET(am_true); +} + +/* +** Erase an object with given key, or maybe several objects if we have a bag +** Called as db_erase(Tab, Key), where Key is element 1 of the +** object(s) we want to erase +*/ +BIF_RETTYPE ets_delete_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_erase(tb,BIF_ARG_2,&ret); + + db_unlock(tb, LCK_WRITE_REC); + + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(ret); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + } +} + +/* +** Erase a specific object, or maybe several objects if we have a bag +*/ +BIF_RETTYPE ets_delete_object_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + if (is_not_tuple(BIF_ARG_2) || + (arityval(*tuple_val(BIF_ARG_2)) < tb->common.keypos)) { + db_unlock(tb, LCK_WRITE_REC); + BIF_ERROR(BIF_P, BADARG); + } + + cret = tb->common.meth->db_erase_object(tb, BIF_ARG_2, &ret); + db_unlock(tb, LCK_WRITE_REC); + + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(ret); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + } +} + +/* +** This is for trapping, cannot be called directly. +*/ +static BIF_RETTYPE ets_select_delete_1(Process *p, Eterm a1) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + Eterm ret; + Eterm *tptr; + db_lock_kind_t kind = LCK_WRITE_REC; + + CHECK_TABLES(); + ASSERT(is_tuple(a1)); + tptr = tuple_val(a1); + ASSERT(arityval(*tptr) >= 1); + + if ((tb = db_get_table(p, tptr[1], DB_WRITE, kind)) == NULL) { + BIF_ERROR(p,BADARG); + } + + cret = tb->common.meth->db_select_delete_continue(p,tb,a1,&ret); + + if(!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) { + unfix_table_locked(p, tb, &kind); + } + + db_unlock(tb, kind); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + default: + ERTS_BIF_PREP_ERROR(result, p, BADARG); + break; + } + erts_match_set_release_result(p); + + return result; +} + + +BIF_RETTYPE ets_select_delete_2(BIF_ALIST_2) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + Eterm ret; + enum DbIterSafety safety; + + CHECK_TABLES(); + + if(eq(BIF_ARG_2, ms_delete_all)) { + int nitems; + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + nitems = erts_smp_atomic_read(&tb->common.nitems); + tb->common.meth->db_delete_all_objects(BIF_P, tb); + db_unlock(tb, LCK_WRITE); + BIF_RET(erts_make_integer(nitems,BIF_P)); + } + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_WRITE, LCK_WRITE_REC)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + safety = ITERATION_SAFETY(BIF_P,tb); + if (safety == ITER_UNSAFE) { + local_fix_table(tb); + } + cret = tb->common.meth->db_select_delete(BIF_P, tb, BIF_ARG_2, &ret); + + if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { + fix_table_locked(BIF_P,tb); + } + if (safety == ITER_UNSAFE) { + local_unfix_table(tb); + } + db_unlock(tb, LCK_WRITE_REC); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + break; + } + + erts_match_set_release_result(BIF_P); + + return result; +} + +/* +** Return a list of tables on this node +*/ +BIF_RETTYPE ets_all_0(BIF_ALIST_0) +{ + DbTable* tb; + Eterm previous; + int i, j; + Eterm* hp; + Eterm* hendp; + int t_tabs_cnt; + int t_max_tabs; + + erts_smp_spin_lock(&meta_main_tab_main_lock); + t_tabs_cnt = meta_main_tab_cnt; + t_max_tabs = db_max_tabs; + erts_smp_spin_unlock(&meta_main_tab_main_lock); + + hp = HAlloc(BIF_P, 2*t_tabs_cnt); + hendp = hp + 2*t_tabs_cnt; + + previous = NIL; + j = 0; + for(i = 0; (i < t_max_tabs && j < t_tabs_cnt); i++) { + meta_main_tab_lock(i); + if (IS_SLOT_ALIVE(i)) { + j++; + tb = meta_main_tab[i].u.tb; + previous = CONS(hp, tb->common.id, previous); + hp += 2; + } + meta_main_tab_unlock(i); + } + HRelease(BIF_P, hendp, hp); + BIF_RET(previous); +} + + +/* +** db_slot(Db, Slot) -> [Items]. +*/ +BIF_RETTYPE ets_slot_2(BIF_ALIST_2) +{ + DbTable* tb; + int cret; + Eterm ret; + + CHECK_TABLES(); + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + /* The slot number is checked in table specific code. */ + cret = tb->common.meth->db_slot(BIF_P, tb, BIF_ARG_2, &ret); + db_unlock(tb, LCK_READ); + switch (cret) { + case DB_ERROR_NONE: + BIF_RET(ret); + case DB_ERROR_SYSRES: + BIF_ERROR(BIF_P, SYSTEM_LIMIT); + default: + BIF_ERROR(BIF_P, BADARG); + } +} + +/* +** The match BIF, called as ets:match(Table, Pattern), ets:match(Continuation) or ets:match(Table,Pattern,ChunkSize). +*/ + +BIF_RETTYPE ets_match_1(BIF_ALIST_1) +{ + return ets_select_1(BIF_P, BIF_ARG_1); +} + +BIF_RETTYPE ets_match_2(BIF_ALIST_2) +{ + Eterm ms; + Eterm buff[8]; + Eterm *hp = buff; + /*hp = HAlloc(BIF_P, 8);*/ + ms = CONS(hp, am_DollarDollar, NIL); + hp += 2; + ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); + hp += 4; + ms = CONS(hp, ms, NIL); + return ets_select_2(BIF_P, BIF_ARG_1, ms); +} + +BIF_RETTYPE ets_match_3(BIF_ALIST_3) +{ + Eterm ms; + Eterm buff[8]; + Eterm *hp = buff; + /*hp = HAlloc(BIF_P, 8);*/ + ms = CONS(hp, am_DollarDollar, NIL); + hp += 2; + ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); + hp += 4; + ms = CONS(hp, ms, NIL); + return ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); +} + + +BIF_RETTYPE ets_select_3(BIF_ALIST_3) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + Eterm ret; + Sint chunk_size; + enum DbIterSafety safety; + + CHECK_TABLES(); + + /* Chunk size strictly greater than 0 */ + if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) { + BIF_ERROR(BIF_P, BADARG); + } + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + safety = ITERATION_SAFETY(BIF_P,tb); + if (safety == ITER_UNSAFE) { + local_fix_table(tb); + } + cret = tb->common.meth->db_select_chunk(BIF_P, tb, + BIF_ARG_2, chunk_size, + 0 /* not reversed */, + &ret); + if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { + fix_table_locked(BIF_P, tb); + } + if (safety == ITER_UNSAFE) { + local_unfix_table(tb); + } + db_unlock(tb, LCK_READ); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + break; + } + + erts_match_set_release_result(BIF_P); + + return result; +} + + +/* We get here instead of in the real BIF when trapping */ +static BIF_RETTYPE ets_select_trap_1(Process *p, Eterm a1) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + Eterm ret; + Eterm *tptr; + db_lock_kind_t kind = LCK_READ; + + CHECK_TABLES(); + + tptr = tuple_val(a1); + ASSERT(arityval(*tptr) >= 1) + + if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) { + BIF_ERROR(p, BADARG); + } + + cret = tb->common.meth->db_select_continue(p, tb, a1, + &ret); + + if (!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) { + unfix_table_locked(p, tb, &kind); + } + db_unlock(tb, kind); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, p, BADARG); + break; + } + + erts_match_set_release_result(p); + + return result; +} + + +BIF_RETTYPE ets_select_1(BIF_ALIST_1) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + Eterm ret; + Eterm *tptr; + enum DbIterSafety safety; + + CHECK_TABLES(); + + /* + * Make sure that the table exists. + */ + + if (!is_tuple(BIF_ARG_1)) { + if (BIF_ARG_1 == am_EOT) { + BIF_RET(am_EOT); + } + BIF_ERROR(BIF_P, BADARG); + } + tptr = tuple_val(BIF_ARG_1); + if (arityval(*tptr) < 1 || + (tb = db_get_table(BIF_P, tptr[1], DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + safety = ITERATION_SAFETY(BIF_P,tb); + if (safety == ITER_UNSAFE) { + local_fix_table(tb); + } + + cret = tb->common.meth->db_select_continue(BIF_P,tb, + BIF_ARG_1, &ret); + + if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { + fix_table_locked(BIF_P, tb); + } + if (safety == ITER_UNSAFE) { + local_unfix_table(tb); + } + db_unlock(tb, LCK_READ); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + break; + } + + erts_match_set_release_result(BIF_P); + + return result; +} + +BIF_RETTYPE ets_select_2(BIF_ALIST_2) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + enum DbIterSafety safety; + Eterm ret; + + CHECK_TABLES(); + + /* + * Make sure that the table exists. + */ + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + safety = ITERATION_SAFETY(BIF_P,tb); + if (safety == ITER_UNSAFE) { + local_fix_table(tb); + } + + cret = tb->common.meth->db_select(BIF_P, tb, BIF_ARG_2, + 0, &ret); + + if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { + fix_table_locked(BIF_P, tb); + } + if (safety == ITER_UNSAFE) { + local_unfix_table(tb); + } + db_unlock(tb, LCK_READ); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + break; + } + + erts_match_set_release_result(BIF_P); + + return result; +} + +/* We get here instead of in the real BIF when trapping */ +static BIF_RETTYPE ets_select_count_1(Process *p, Eterm a1) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + Eterm ret; + Eterm *tptr; + db_lock_kind_t kind = LCK_READ; + + CHECK_TABLES(); + + tptr = tuple_val(a1); + ASSERT(arityval(*tptr) >= 1) + if ((tb = db_get_table(p, tptr[1], DB_READ, kind)) == NULL) { + BIF_ERROR(p, BADARG); + } + + cret = tb->common.meth->db_select_count_continue(p, tb, a1, &ret); + + if (!DID_TRAP(p,ret) && ITERATION_SAFETY(p,tb) != ITER_SAFE) { + unfix_table_locked(p, tb, &kind); + } + db_unlock(tb, kind); + + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, p, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, p, BADARG); + break; + } + + erts_match_set_release_result(p); + + return result; +} + +BIF_RETTYPE ets_select_count_2(BIF_ALIST_2) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + enum DbIterSafety safety; + Eterm ret; + + CHECK_TABLES(); + /* + * Make sure that the table exists. + */ + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + safety = ITERATION_SAFETY(BIF_P,tb); + if (safety == ITER_UNSAFE) { + local_fix_table(tb); + } + cret = tb->common.meth->db_select_count(BIF_P,tb,BIF_ARG_2, &ret); + + if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { + fix_table_locked(BIF_P, tb); + } + if (safety == ITER_UNSAFE) { + local_unfix_table(tb); + } + db_unlock(tb, LCK_READ); + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + break; + } + + erts_match_set_release_result(BIF_P); + + return result; +} + + +BIF_RETTYPE ets_select_reverse_3(BIF_ALIST_3) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + enum DbIterSafety safety; + Eterm ret; + Sint chunk_size; + + CHECK_TABLES(); + /* + * Make sure that the table exists. + */ + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + /* Chunk size strictly greater than 0 */ + if (is_not_small(BIF_ARG_3) || (chunk_size = signed_val(BIF_ARG_3)) <= 0) { + db_unlock(tb, LCK_READ); + BIF_ERROR(BIF_P, BADARG); + } + safety = ITERATION_SAFETY(BIF_P,tb); + if (safety == ITER_UNSAFE) { + local_fix_table(tb); + } + cret = tb->common.meth->db_select_chunk(BIF_P,tb, + BIF_ARG_2, chunk_size, + 1 /* reversed */, &ret); + if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { + fix_table_locked(BIF_P, tb); + } + if (safety == ITER_UNSAFE) { + local_unfix_table(tb); + } + db_unlock(tb, LCK_READ); + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + break; + } + erts_match_set_release_result(BIF_P); + return result; +} + +BIF_RETTYPE ets_select_reverse_1(BIF_ALIST_1) +{ + return ets_select_1(BIF_P, BIF_ARG_1); +} + +BIF_RETTYPE ets_select_reverse_2(BIF_ALIST_2) +{ + BIF_RETTYPE result; + DbTable* tb; + int cret; + enum DbIterSafety safety; + Eterm ret; + + CHECK_TABLES(); + /* + * Make sure that the table exists. + */ + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_READ, LCK_READ)) == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + safety = ITERATION_SAFETY(BIF_P,tb); + if (safety == ITER_UNSAFE) { + local_fix_table(tb); + } + cret = tb->common.meth->db_select(BIF_P,tb,BIF_ARG_2, + 1 /*reversed*/, &ret); + + if (DID_TRAP(BIF_P,ret) && safety != ITER_SAFE) { + fix_table_locked(BIF_P, tb); + } + if (safety == ITER_UNSAFE) { + local_unfix_table(tb); + } + db_unlock(tb, LCK_READ); + switch (cret) { + case DB_ERROR_NONE: + ERTS_BIF_PREP_RET(result, ret); + break; + case DB_ERROR_SYSRES: + ERTS_BIF_PREP_ERROR(result, BIF_P, SYSTEM_LIMIT); + break; + default: + ERTS_BIF_PREP_ERROR(result, BIF_P, BADARG); + break; + } + erts_match_set_release_result(BIF_P); + return result; +} + + +/* +** ets:match_object(Continuation), ets:match_object(Table, Pattern), ets:match_object(Table,Pattern,ChunkSize) +*/ +BIF_RETTYPE ets_match_object_1(BIF_ALIST_1) +{ + return ets_select_1(BIF_P, BIF_ARG_1); +} + +BIF_RETTYPE ets_match_object_2(BIF_ALIST_2) +{ + Eterm ms; + Eterm buff[8]; + Eterm *hp = buff; + /*hp = HAlloc(BIF_P, 8);*/ + ms = CONS(hp, am_DollarUnderscore, NIL); + hp += 2; + ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); + hp += 4; + ms = CONS(hp, ms, NIL); + return ets_select_2(BIF_P, BIF_ARG_1, ms); +} + +BIF_RETTYPE ets_match_object_3(BIF_ALIST_3) +{ + Eterm ms; + Eterm buff[8]; + Eterm *hp = buff; + /*hp = HAlloc(BIF_P, 8);*/ + ms = CONS(hp, am_DollarUnderscore, NIL); + hp += 2; + ms = TUPLE3(hp, BIF_ARG_2, NIL, ms); + hp += 4; + ms = CONS(hp, ms, NIL); + return ets_select_3(BIF_P, BIF_ARG_1, ms, BIF_ARG_3); +} + +/* + * BIF to extract information about a particular table. + */ + +BIF_RETTYPE ets_info_1(BIF_ALIST_1) +{ + static Eterm fields[] = {am_protection, am_keypos, am_type, am_named_table, + am_node, am_size, am_name, am_heir, am_owner, am_memory}; + Eterm results[sizeof(fields)/sizeof(Eterm)]; + DbTable* tb; + Eterm res; + int i; + Eterm* hp; + /*Process* rp = NULL;*/ + Eterm owner; + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { + if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) { + BIF_RET(am_undefined); + } + BIF_ERROR(BIF_P, BADARG); + } + + owner = tb->common.owner; + + /* If/when we implement lockless private tables: + if ((tb->common.status & DB_PRIVATE) && owner != BIF_P->id) { + db_unlock(tb, LCK_READ); + rp = erts_pid2proc_not_running(BIF_P, ERTS_PROC_LOCK_MAIN, + owner, ERTS_PROC_LOCK_MAIN); + if (rp == NULL) { + BIF_RET(am_undefined); + } + if (rp == ERTS_PROC_LOCK_BUSY) { + ERTS_BIF_YIELD1(bif_export[BIF_ets_info_1], BIF_P, BIF_ARG_1); + } + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL + || tb->common.owner != owner) { + if (BIF_P != rp) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN); + if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) { + BIF_RET(am_undefined); + } + BIF_ERROR(BIF_P, BADARG); + } + }*/ + for (i = 0; i < sizeof(fields)/sizeof(Eterm); i++) { + results[i] = table_info(BIF_P, tb, fields[i]); + ASSERT(is_value(results[i])); + } + db_unlock(tb, LCK_READ); + + /*if (rp != NULL && rp != BIF_P) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_MAIN);*/ + + hp = HAlloc(BIF_P, 5*sizeof(fields)/sizeof(Eterm)); + res = NIL; + for (i = 0; i < sizeof(fields)/sizeof(Eterm); i++) { + Eterm tuple; + tuple = TUPLE2(hp, fields[i], results[i]); + hp += 3; + res = CONS(hp, tuple, res); + hp += 2; + } + BIF_RET(res); +} + +/* + * BIF to extract information about a particular table. + */ + +BIF_RETTYPE ets_info_2(BIF_ALIST_2) +{ + DbTable* tb; + Eterm ret = THE_NON_VALUE; + + if ((tb = db_get_table(BIF_P, BIF_ARG_1, DB_INFO, LCK_READ)) == NULL) { + if (is_atom(BIF_ARG_1) || is_small(BIF_ARG_1)) { + BIF_RET(am_undefined); + } + BIF_ERROR(BIF_P, BADARG); + } + ret = table_info(BIF_P, tb, BIF_ARG_2); + db_unlock(tb, LCK_READ); + if (is_non_value(ret)) { + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(ret); +} + + +BIF_RETTYPE ets_is_compiled_ms_1(BIF_ALIST_1) +{ + if (erts_db_is_compiled_ms(BIF_ARG_1)) { + BIF_RET(am_true); + } else { + BIF_RET(am_false); + } +} + +BIF_RETTYPE ets_match_spec_compile_1(BIF_ALIST_1) +{ + Binary *mp = db_match_set_compile(BIF_P, BIF_ARG_1, DCOMP_TABLE); + Eterm *hp; + if (mp == NULL) { + BIF_ERROR(BIF_P, BADARG); + } + + hp = HAlloc(BIF_P, PROC_BIN_SIZE); + + BIF_RET(erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mp)); +} + +BIF_RETTYPE ets_match_spec_run_r_3(BIF_ALIST_3) +{ + Eterm ret = BIF_ARG_3; + int i = 0; + Eterm *hp; + Eterm lst; + ProcBin *bp; + Binary *mp; + Eterm res; + Uint32 dummy; + Uint sz; + + if (!(is_list(BIF_ARG_1) || BIF_ARG_1 == NIL) || !is_binary(BIF_ARG_2)) { + error: + BIF_ERROR(BIF_P, BADARG); + } + + bp = (ProcBin*) binary_val(BIF_ARG_2); + if (thing_subtag(bp->thing_word) != REFC_BINARY_SUBTAG) { + goto error; + } + mp = bp->val; + if (!IsMatchProgBinary(mp)) { + goto error; + } + + if (BIF_ARG_1 == NIL) { + BIF_RET(BIF_ARG_3); + } + for (lst = BIF_ARG_1; is_list(lst); lst = CDR(list_val(lst))) { + if (++i > CONTEXT_REDS) { + BUMP_ALL_REDS(BIF_P); + BIF_TRAP3(bif_export[BIF_ets_match_spec_run_r_3], + BIF_P,lst,BIF_ARG_2,ret); + } + res = db_prog_match(BIF_P, mp, CAR(list_val(lst)), 0, &dummy); + if (is_value(res)) { + sz = size_object(res); + hp = HAlloc(BIF_P, sz + 2); + res = copy_struct(res, sz, &hp, &MSO(BIF_P)); + ret = CONS(hp,res,ret); + /*hp += 2;*/ + } + } + if (lst != NIL) { + goto error; + } + BIF_RET2(ret,i); +} + + +/* +** External interface (NOT BIF's) +*/ + + +/* Init the db */ + +void init_db(void) +{ + DbTable init_tb; + int i; + extern Eterm* em_apply_bif; + Eterm *hp; + unsigned bits; + size_t size; + +#ifdef ERTS_SMP + for (i=0; i SMALL_BITS) { + erl_exit(1,"Max limit for ets tabled too high %u (max %u).", + db_max_tabs, 1L<common.memory_size, + erts_smp_atomic_read(&init_tb.common.memory_size)); + + meta_pid_to_tab->common.id = NIL; + meta_pid_to_tab->common.the_name = am_true; + meta_pid_to_tab->common.status = (DB_NORMAL | DB_BAG | DB_PUBLIC | DB_FINE_LOCKED); +#ifdef ERTS_SMP + meta_pid_to_tab->common.type + = meta_pid_to_tab->common.status & ERTS_ETS_TABLE_TYPES; + /* Note, 'type' is *read only* from now on... */ + meta_pid_to_tab->common.is_thread_safe = 0; +#endif + meta_pid_to_tab->common.keypos = 1; + meta_pid_to_tab->common.owner = NIL; + erts_smp_atomic_init(&meta_pid_to_tab->common.nitems, 0); + meta_pid_to_tab->common.slot = -1; + meta_pid_to_tab->common.meth = &db_hash; + + erts_refc_init(&meta_pid_to_tab->common.ref, 1); + erts_refc_init(&meta_pid_to_tab->common.fixref, 0); + /* Neither rwlock or fixlock used + db_init_lock(meta_pid_to_tab, "meta_pid_to_tab", "meta_pid_to_tab_FIX");*/ + + if (db_create_hash(NULL, meta_pid_to_tab) != DB_ERROR_NONE) { + erl_exit(1,"Unable to create ets metadata tables."); + } + + erts_smp_atomic_set(&init_tb.common.memory_size, 0); + meta_pid_to_fixed_tab = (DbTable*) erts_db_alloc(ERTS_ALC_T_DB_TABLE, + &init_tb, + sizeof(DbTable)); + ERTS_ETS_MISC_MEM_ADD(sizeof(DbTable)); + erts_smp_atomic_init(&meta_pid_to_fixed_tab->common.memory_size, + erts_smp_atomic_read(&init_tb.common.memory_size)); + + meta_pid_to_fixed_tab->common.id = NIL; + meta_pid_to_fixed_tab->common.the_name = am_true; + meta_pid_to_fixed_tab->common.status = (DB_NORMAL | DB_BAG | DB_PUBLIC | DB_FINE_LOCKED); +#ifdef ERTS_SMP + meta_pid_to_fixed_tab->common.type + = meta_pid_to_fixed_tab->common.status & ERTS_ETS_TABLE_TYPES; + /* Note, 'type' is *read only* from now on... */ + meta_pid_to_fixed_tab->common.is_thread_safe = 0; +#endif + meta_pid_to_fixed_tab->common.keypos = 1; + meta_pid_to_fixed_tab->common.owner = NIL; + erts_smp_atomic_init(&meta_pid_to_fixed_tab->common.nitems, 0); + meta_pid_to_fixed_tab->common.slot = -1; + meta_pid_to_fixed_tab->common.meth = &db_hash; + + erts_refc_init(&meta_pid_to_fixed_tab->common.ref, 1); + erts_refc_init(&meta_pid_to_fixed_tab->common.fixref, 0); + /* Neither rwlock or fixlock used + db_init_lock(meta_pid_to_fixed_tab, "meta_pid_to_fixed_tab", "meta_pid_to_fixed_tab_FIX");*/ + + if (db_create_hash(NULL, meta_pid_to_fixed_tab) != DB_ERROR_NONE) { + erl_exit(1,"Unable to create ets metadata tables."); + } + + /* Non visual BIF to trap to. */ + memset(&ets_select_delete_continue_exp, 0, sizeof(Export)); + ets_select_delete_continue_exp.address = + &ets_select_delete_continue_exp.code[3]; + ets_select_delete_continue_exp.code[0] = am_ets; + ets_select_delete_continue_exp.code[1] = am_atom_put("delete_trap",11); + ets_select_delete_continue_exp.code[2] = 1; + ets_select_delete_continue_exp.code[3] = + (Eterm) em_apply_bif; + ets_select_delete_continue_exp.code[4] = + (Eterm) &ets_select_delete_1; + + /* Non visual BIF to trap to. */ + memset(&ets_select_count_continue_exp, 0, sizeof(Export)); + ets_select_count_continue_exp.address = + &ets_select_count_continue_exp.code[3]; + ets_select_count_continue_exp.code[0] = am_ets; + ets_select_count_continue_exp.code[1] = am_atom_put("count_trap",11); + ets_select_count_continue_exp.code[2] = 1; + ets_select_count_continue_exp.code[3] = + (Eterm) em_apply_bif; + ets_select_count_continue_exp.code[4] = + (Eterm) &ets_select_count_1; + + /* Non visual BIF to trap to. */ + memset(&ets_select_continue_exp, 0, sizeof(Export)); + ets_select_continue_exp.address = + &ets_select_continue_exp.code[3]; + ets_select_continue_exp.code[0] = am_ets; + ets_select_continue_exp.code[1] = am_atom_put("select_trap",11); + ets_select_continue_exp.code[2] = 1; + ets_select_continue_exp.code[3] = + (Eterm) em_apply_bif; + ets_select_continue_exp.code[4] = + (Eterm) &ets_select_trap_1; + + /* Non visual BIF to trap to. */ + memset(&ets_delete_continue_exp, 0, sizeof(Export)); + ets_delete_continue_exp.address = &ets_delete_continue_exp.code[3]; + ets_delete_continue_exp.code[0] = am_ets; + ets_delete_continue_exp.code[1] = am_atom_put("delete_trap",11); + ets_delete_continue_exp.code[2] = 1; + ets_delete_continue_exp.code[3] = (Eterm) em_apply_bif; + ets_delete_continue_exp.code[4] = (Eterm) &ets_delete_trap; + + hp = ms_delete_all_buff; + ms_delete_all = CONS(hp, am_true, NIL); + hp += 2; + ms_delete_all = TUPLE3(hp,am_Underscore,NIL,ms_delete_all); + hp +=4; + ms_delete_all = CONS(hp, ms_delete_all,NIL); +} + +#define ARRAY_CHUNK 100 + +typedef enum { + ErtsDbProcCleanupProgressTables, + ErtsDbProcCleanupProgressFixations, + ErtsDbProcCleanupProgressDone, +} ErtsDbProcCleanupProgress; + +typedef enum { + ErtsDbProcCleanupOpGetTables, + ErtsDbProcCleanupOpDeleteTables, + ErtsDbProcCleanupOpGetFixations, + ErtsDbProcCleanupOpDeleteFixations, + ErtsDbProcCleanupOpDone +} ErtsDbProcCleanupOperation; + +typedef struct { + ErtsDbProcCleanupProgress progress; + ErtsDbProcCleanupOperation op; + struct { + Eterm arr[ARRAY_CHUNK]; + int size; + int ix; + int clean_ix; + } slots; +} ErtsDbProcCleanupState; + + +static void +proc_exit_cleanup_tables_meta_data(Eterm pid, ErtsDbProcCleanupState *state) +{ + ASSERT(state->slots.clean_ix <= state->slots.ix); + if (state->slots.clean_ix < state->slots.ix) { + db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC); + if (state->slots.size < ARRAY_CHUNK + && state->slots.ix == state->slots.size) { + Eterm dummy; + db_erase_hash(meta_pid_to_tab,pid,&dummy); + } + else { + int ix; + /* Need to erase each explicitly */ + for (ix = state->slots.clean_ix; ix < state->slots.ix; ix++) + db_erase_bag_exact2(meta_pid_to_tab, + pid, + state->slots.arr[ix]); + } + db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); + state->slots.clean_ix = state->slots.ix; + } +} + +static void +proc_exit_cleanup_fixations_meta_data(Eterm pid, ErtsDbProcCleanupState *state) +{ + ASSERT(state->slots.clean_ix <= state->slots.ix); + if (state->slots.clean_ix < state->slots.ix) { + db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC); + if (state->slots.size < ARRAY_CHUNK + && state->slots.ix == state->slots.size) { + Eterm dummy; + db_erase_hash(meta_pid_to_fixed_tab,pid,&dummy); + } + else { + int ix; + /* Need to erase each explicitly */ + for (ix = state->slots.clean_ix; ix < state->slots.ix; ix++) + db_erase_bag_exact2(meta_pid_to_fixed_tab, + pid, + state->slots.arr[ix]); + } + db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC); + state->slots.clean_ix = state->slots.ix; + } +} + +/* In: Table LCK_WRITE +** Return TRUE : ok, table not mine and NOT locked anymore. +** Return FALSE: failed, table still mine (LCK_WRITE) +*/ +static int give_away_to_heir(Process* p, DbTable* tb) +{ + Process* to_proc; + ErtsProcLocks to_locks = ERTS_PROC_LOCK_MAIN; + Eterm buf[5]; + Eterm to_pid; + Eterm heir_data; + + ASSERT(tb->common.owner == p->id); + ASSERT(is_internal_pid(tb->common.heir)); + ASSERT(tb->common.heir != p->id); +retry: + to_pid = tb->common.heir; + to_proc = erts_pid2proc_opt(p, ERTS_PROC_LOCK_MAIN, + to_pid, to_locks, + ERTS_P2P_FLG_TRY_LOCK); + if (to_proc == ERTS_PROC_LOCK_BUSY) { + db_ref(tb); /* while unlocked */ + db_unlock(tb,LCK_WRITE); + to_proc = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, + to_pid, to_locks); + db_lock(tb,LCK_WRITE); + tb = db_unref(tb); + ASSERT(tb != NULL); + + if (tb->common.owner != p->id) { + if (to_proc != NULL ) { + erts_smp_proc_unlock(to_proc, to_locks); + } + db_unlock(tb,LCK_WRITE); + return !0; /* ok, someone already gave my table away */ + } + if (tb->common.heir != to_pid) { /* someone changed the heir */ + if (to_proc != NULL ) { + erts_smp_proc_unlock(to_proc, to_locks); + } + if (to_pid == p->id || to_pid == am_none) { + return 0; /* no real heir, table still mine */ + } + goto retry; + } + } + if (to_proc == NULL) { + return 0; /* heir not alive, table still mine */ + } + if (erts_cmp_timeval(&to_proc->started, &tb->common.heir_started) != 0) { + erts_smp_proc_unlock(to_proc, to_locks); + return 0; /* heir dead and pid reused, table still mine */ + } + db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC); + db_erase_bag_exact2(meta_pid_to_tab, tb->common.owner, + make_small(tb->common.slot)); + + to_proc->flags |= F_USING_DB; + tb->common.owner = to_pid; + + db_put_hash(meta_pid_to_tab, + TUPLE2(buf,to_pid,make_small(tb->common.slot)), + 0); + db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); + + db_unlock(tb,LCK_WRITE); + heir_data = tb->common.heir_data; + if (!is_immed(heir_data)) { + Eterm* tpv = DBTERM_BUF((DbTerm*)heir_data); /* tuple_val */ + ASSERT(arityval(*tpv) == 1); + heir_data = tpv[1]; + } + erts_send_message(p, to_proc, &to_locks, + TUPLE4(buf, am_ETS_TRANSFER, tb->common.id, p->id, heir_data), + 0); + erts_smp_proc_unlock(to_proc, to_locks); + return !0; +} + +/* + * erts_db_process_exiting() is called when a process terminates. + * It returns 0 when completely done, and !0 when it wants to + * yield. c_p->u.exit_data can hold a pointer to a state while + * yielding. + */ +#define ERTS_DB_INTERNAL_ERROR(LSTR) \ + erl_exit(ERTS_ABORT_EXIT, "%s:%d:erts_db_process_exiting(): " LSTR "\n", \ + __FILE__, __LINE__) + +int +erts_db_process_exiting(Process *c_p, ErtsProcLocks c_p_locks) +{ + ErtsDbProcCleanupState *state = (ErtsDbProcCleanupState *) c_p->u.exit_data; + Eterm pid = c_p->id; + ErtsDbProcCleanupState default_state; + int ret; + + if (!state) { + state = &default_state; + state->progress = ErtsDbProcCleanupProgressTables; + state->op = ErtsDbProcCleanupOpGetTables; + } + + while (!0) { + switch (state->op) { + case ErtsDbProcCleanupOpGetTables: + state->slots.size = ARRAY_CHUNK; + db_meta_lock(meta_pid_to_tab, LCK_READ); + ret = db_get_element_array(meta_pid_to_tab, + pid, + 2, + state->slots.arr, + &state->slots.size); + db_meta_unlock(meta_pid_to_tab, LCK_READ); + if (ret == DB_ERROR_BADKEY) { + /* Done with tables; now fixations */ + state->progress = ErtsDbProcCleanupProgressFixations; + state->op = ErtsDbProcCleanupOpGetFixations; + break; + } else if (ret != DB_ERROR_NONE) { + ERTS_DB_INTERNAL_ERROR("Inconsistent ets table metadata"); + } + + state->slots.ix = 0; + state->slots.clean_ix = 0; + state->op = ErtsDbProcCleanupOpDeleteTables; + /* Fall through */ + + case ErtsDbProcCleanupOpDeleteTables: + + while (state->slots.ix < state->slots.size) { + DbTable *tb = NULL; + Sint ix = unsigned_val(state->slots.arr[state->slots.ix]); + meta_main_tab_lock(ix); + if (!IS_SLOT_FREE(ix)) { + tb = db_ref(GET_ANY_SLOT_TAB(ix)); + ASSERT(tb); + } + meta_main_tab_unlock(ix); + if (tb) { + int do_yield; + db_lock_take_over_ref(tb, LCK_WRITE); + /* Ownership may have changed since + we looked up the table. */ + if (tb->common.owner != pid) { + do_yield = 0; + db_unlock(tb, LCK_WRITE); + } + else if (tb->common.heir != am_none + && tb->common.heir != pid + && give_away_to_heir(c_p, tb)) { + do_yield = 0; + } + else { + int first_call; +#ifdef HARDDEBUG + erts_fprintf(stderr, + "erts_db_process_exiting(); Table: %T, " + "Process: %T\n", + tb->common.id, pid); +#endif + first_call = (tb->common.status & DB_DELETE) == 0; + if (first_call) { + /* Clear all access bits. */ + tb->common.status &= ~(DB_PROTECTED + | DB_PUBLIC + | DB_PRIVATE); + tb->common.status |= DB_DELETE; + + if (is_atom(tb->common.id)) + remove_named_tab(tb->common.id); + + free_heir_data(tb); + free_fixations_locked(tb); + } + + do_yield = free_table_cont(c_p, tb, first_call, 0); + db_unlock(tb, LCK_WRITE); + } + if (do_yield) + goto yield; + } + state->slots.ix++; + if (ERTS_BIF_REDS_LEFT(c_p) <= 0) + goto yield; + } + + proc_exit_cleanup_tables_meta_data(pid, state); + state->op = ErtsDbProcCleanupOpGetTables; + break; + + case ErtsDbProcCleanupOpGetFixations: + state->slots.size = ARRAY_CHUNK; + db_meta_lock(meta_pid_to_fixed_tab, LCK_READ); + ret = db_get_element_array(meta_pid_to_fixed_tab, + pid, + 2, + state->slots.arr, + &state->slots.size); + db_meta_unlock(meta_pid_to_fixed_tab, LCK_READ); + + if (ret == DB_ERROR_BADKEY) { + /* Done */ + state->progress = ErtsDbProcCleanupProgressDone; + state->op = ErtsDbProcCleanupOpDone; + break; + } else if (ret != DB_ERROR_NONE) { + ERTS_DB_INTERNAL_ERROR("Inconsistent ets fix table metadata"); + } + + state->slots.ix = 0; + state->slots.clean_ix = 0; + state->op = ErtsDbProcCleanupOpDeleteFixations; + /* Fall through */ + + case ErtsDbProcCleanupOpDeleteFixations: + + while (state->slots.ix < state->slots.size) { + DbTable *tb = NULL; + Sint ix = unsigned_val(state->slots.arr[state->slots.ix]); + meta_main_tab_lock(ix); + if (IS_SLOT_ALIVE(ix)) { + tb = db_ref(meta_main_tab[ix].u.tb); + ASSERT(tb); + } + meta_main_tab_unlock(ix); + if (tb) { + int reds; + DbFixation** pp; + + db_lock_take_over_ref(tb, LCK_WRITE_REC); + #ifdef ERTS_SMP + erts_smp_mtx_lock(&tb->common.fixlock); + #endif + reds = 10; + + for (pp = &tb->common.fixations; *pp != NULL; + pp = &(*pp)->next) { + if ((*pp)->pid == pid) { + DbFixation* fix = *pp; + erts_refc_add(&tb->common.fixref,-fix->counter,0); + *pp = fix->next; + erts_db_free(ERTS_ALC_T_DB_FIXATION, + tb, fix, sizeof(DbFixation)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation)); + break; + } + } + #ifdef ERTS_SMP + erts_smp_mtx_unlock(&tb->common.fixlock); + #endif + if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status)) { + db_unfix_table_hash(&(tb->hash)); + reds += 40; + } + db_unlock(tb, LCK_WRITE_REC); + BUMP_REDS(c_p, reds); + } + state->slots.ix++; + if (ERTS_BIF_REDS_LEFT(c_p) <= 0) + goto yield; + } + + proc_exit_cleanup_fixations_meta_data(pid, state); + state->op = ErtsDbProcCleanupOpGetFixations; + break; + + case ErtsDbProcCleanupOpDone: + + if (state != &default_state) + erts_free(ERTS_ALC_T_DB_PROC_CLEANUP, state); + c_p->u.exit_data = NULL; + return 0; + + default: + ERTS_DB_INTERNAL_ERROR("Bad internal state"); + } + } + + yield: + + switch (state->progress) { + case ErtsDbProcCleanupProgressTables: + proc_exit_cleanup_tables_meta_data(pid, state); + break; + case ErtsDbProcCleanupProgressFixations: + proc_exit_cleanup_fixations_meta_data(pid, state); + break; + default: + break; + } + + ASSERT(c_p->u.exit_data == (void *) state + || state == &default_state); + + if (state == &default_state) { + c_p->u.exit_data = erts_alloc(ERTS_ALC_T_DB_PROC_CLEANUP, + sizeof(ErtsDbProcCleanupState)); + sys_memcpy(c_p->u.exit_data, + (void*) state, + sizeof(ErtsDbProcCleanupState)); + } + + return !0; +} + +/* SMP note: table only need to be LCK_READ locked */ +static void fix_table_locked(Process* p, DbTable* tb) +{ + DbFixation *fix; + Eterm meta_tuple[3]; + +#ifdef ERTS_SMP + erts_smp_mtx_lock(&tb->common.fixlock); +#endif + erts_refc_inc(&tb->common.fixref,1); + fix = tb->common.fixations; + if (fix == NULL) { + get_now(&(tb->common.megasec), + &(tb->common.sec), + &(tb->common.microsec)); + } + else { + for (; fix != NULL; fix = fix->next) { + if (fix->pid == p->id) { + ++(fix->counter); +#ifdef ERTS_SMP + erts_smp_mtx_unlock(&tb->common.fixlock); +#endif + return; + } + } + } + fix = (DbFixation *) erts_db_alloc(ERTS_ALC_T_DB_FIXATION, + tb, sizeof(DbFixation)); + ERTS_ETS_MISC_MEM_ADD(sizeof(DbFixation)); + fix->pid = p->id; + fix->counter = 1; + fix->next = tb->common.fixations; + tb->common.fixations = fix; +#ifdef ERTS_SMP + erts_smp_mtx_unlock(&tb->common.fixlock); +#endif + p->flags |= F_USING_DB; + db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC); + if (db_put_hash(meta_pid_to_fixed_tab, + TUPLE2(meta_tuple, p->id, make_small(tb->common.slot)), + 0) != DB_ERROR_NONE) { + erl_exit(1,"Could not insert ets metadata in safe_fixtable."); + } + db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC); +} + +/* SMP note: May re-lock table +*/ +static void unfix_table_locked(Process* p, DbTable* tb, + db_lock_kind_t* kind_p) +{ + DbFixation** pp; + +#ifdef ERTS_SMP + erts_smp_mtx_lock(&tb->common.fixlock); +#endif + for (pp = &tb->common.fixations; *pp != NULL; pp = &(*pp)->next) { + if ((*pp)->pid == p->id) { + DbFixation* fix = *pp; + erts_refc_dec(&tb->common.fixref,0); + --(fix->counter); + ASSERT(fix->counter >= 0); + if (fix->counter > 0) { + break; + } + *pp = fix->next; +#ifdef ERTS_SMP + erts_smp_mtx_unlock(&tb->common.fixlock); +#endif + db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC); + db_erase_bag_exact2(meta_pid_to_fixed_tab, + p->id, make_small(tb->common.slot)); + db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC); + erts_db_free(ERTS_ALC_T_DB_FIXATION, + tb, (void *) fix, sizeof(DbFixation)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation)); + goto unlocked; + } + } +#ifdef ERTS_SMP + erts_smp_mtx_unlock(&tb->common.fixlock); +#endif +unlocked: + + if (!IS_FIXED(tb) && IS_HASH_TABLE(tb->common.status) + && erts_smp_atomic_read(&tb->hash.fixdel) != (long)NULL) { +#ifdef ERTS_SMP + if (*kind_p == LCK_READ && tb->common.is_thread_safe) { + /* Must have write lock while purging pseudo-deleted (OTP-8166) */ + erts_smp_rwmtx_runlock(&tb->common.rwlock); + erts_smp_rwmtx_rwlock(&tb->common.rwlock); + *kind_p = LCK_WRITE; + if (tb->common.status & DB_DELETE) return; + } +#endif + db_unfix_table_hash(&(tb->hash)); + } +} + +/* Assume that tb is WRITE locked */ +static void free_fixations_locked(DbTable *tb) +{ + DbFixation *fix; + DbFixation *next_fix; + + fix = tb->common.fixations; + while (fix != NULL) { + next_fix = fix->next; + db_meta_lock(meta_pid_to_fixed_tab, LCK_WRITE_REC); + db_erase_bag_exact2(meta_pid_to_fixed_tab, + fix->pid, + make_small(tb->common.slot)); + db_meta_unlock(meta_pid_to_fixed_tab, LCK_WRITE_REC); + erts_db_free(ERTS_ALC_T_DB_FIXATION, + tb, (void *) fix, sizeof(DbFixation)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(DbFixation)); + + fix = next_fix; + } + tb->common.fixations = NULL; +} + +static void set_heir(Process* me, DbTable* tb, Eterm heir, Eterm heir_data) +{ + tb->common.heir = heir; + if (heir == am_none) { + return; + } + if (heir == me->id) { + tb->common.heir_started = me->started; + } + else { + Process* heir_proc= erts_pid2proc_opt(me, ERTS_PROC_LOCK_MAIN, heir, + 0, ERTS_P2P_FLG_SMP_INC_REFC); + if (heir_proc != NULL) { + tb->common.heir_started = heir_proc->started; + erts_smp_proc_dec_refc(heir_proc); + } else { + tb->common.heir = am_none; + } + } + + if (!is_immed(heir_data)) { + Eterm tmp[2]; + /* Make a dummy 1-tuple around data to use db_get_term() */ + heir_data = (Eterm) db_get_term(&tb->common, NULL, 0, + TUPLE1(tmp,heir_data)); + ASSERT(!is_immed(heir_data)); + } + tb->common.heir_data = heir_data; +} + +static void free_heir_data(DbTable* tb) +{ + if (tb->common.heir != am_none && !is_immed(tb->common.heir_data)) { + DbTerm* p = (DbTerm*) tb->common.heir_data; + db_free_term_data(p); + erts_db_free(ERTS_ALC_T_DB_TERM, tb, (void *)p, + sizeof(DbTerm) + (p->size-1)*sizeof(Eterm)); + } + #ifdef DEBUG + tb->common.heir_data = am_undefined; + #endif +} + +static BIF_RETTYPE ets_delete_trap(Process *p, Eterm cont) +{ + int trap; + Eterm* ptr = big_val(cont); + DbTable *tb = (DbTable *) ptr[1]; + + ASSERT(*ptr == make_pos_bignum_header(1)); + + db_lock(tb, LCK_WRITE); + trap = free_table_cont(p, tb, 0, 1); + db_unlock(tb, LCK_WRITE); + + if (trap) { + BIF_TRAP1(&ets_delete_continue_exp, p, cont); + } + else { + BIF_RET(am_true); + } +} + + +/* + * free_table_cont() returns 0 when done and !0 when more work is needed. + */ +static int free_table_cont(Process *p, + DbTable *tb, + int first, + int clean_meta_tab) +{ + Eterm result; + +#ifdef HARDDEBUG + if (!first) { + erts_fprintf(stderr,"ets: free_table_cont %T (continue)\r\n", + tb->common.id); + } +#endif + + result = tb->common.meth->db_free_table_continue(tb); + + if (result == 0) { +#ifdef HARDDEBUG + erts_fprintf(stderr,"ets: free_table_cont %T (continue begin)\r\n", + tb->common.id); +#endif + /* More work to be done. Let other processes work and call us again. */ + BUMP_ALL_REDS(p); + return !0; + } + else { +#ifdef HARDDEBUG + erts_fprintf(stderr,"ets: free_table_cont %T (continue end)\r\n", + tb->common.id); +#endif + /* Completely done - we will not get called again. */ + meta_main_tab_lock(tb->common.slot); + free_slot(tb->common.slot); + meta_main_tab_unlock(tb->common.slot); + + if (clean_meta_tab) { + db_meta_lock(meta_pid_to_tab, LCK_WRITE_REC); + db_erase_bag_exact2(meta_pid_to_tab,tb->common.owner, + make_small(tb->common.slot)); + db_meta_unlock(meta_pid_to_tab, LCK_WRITE_REC); + } + db_unref(tb); + BUMP_REDS(p, 100); + return 0; + } +} + +static Eterm table_info(Process* p, DbTable* tb, Eterm What) +{ + Eterm ret = THE_NON_VALUE; + + if (What == am_size) { + ret = make_small(erts_smp_atomic_read(&tb->common.nitems)); + } else if (What == am_type) { + if (tb->common.status & DB_SET) { + ret = am_set; + } else if (tb->common.status & DB_DUPLICATE_BAG) { + ret = am_duplicate_bag; + } else if (tb->common.status & DB_ORDERED_SET) { + ret = am_ordered_set; + } else { /*TT*/ + ASSERT(tb->common.status & DB_BAG); + ret = am_bag; + } + } else if (What == am_memory) { + Uint words = (Uint) ((erts_smp_atomic_read(&tb->common.memory_size) + + sizeof(Uint) + - 1) + / sizeof(Uint)); + ret = erts_make_integer(words, p); + } else if (What == am_owner) { + ret = tb->common.owner; + } else if (What == am_heir) { + ret = tb->common.heir; + } else if (What == am_protection) { + if (tb->common.status & DB_PRIVATE) + ret = am_private; + else if (tb->common.status & DB_PROTECTED) + ret = am_protected; + else if (tb->common.status & DB_PUBLIC) + ret = am_public; + } else if (What == am_name) { + ret = tb->common.the_name; + } else if (What == am_keypos) { + ret = make_small(tb->common.keypos); + } else if (What == am_node) { + ret = erts_this_dist_entry->sysname; + } else if (What == am_named_table) { + ret = is_atom(tb->common.id) ? am_true : am_false; + /* + * For debugging purposes + */ + } else if (What == am_data) { + print_table(ERTS_PRINT_STDOUT, NULL, 1, tb); + ret = am_true; + } else if (What == am_atom_put("fixed",5)) { + if (IS_FIXED(tb)) + ret = am_true; + else + ret = am_false; + } else if (What == am_atom_put("kept_objects",12)) { + ret = make_small(IS_HASH_TABLE(tb->common.status) + ? db_kept_items_hash(&tb->hash) : 0); + } else if (What == am_atom_put("safe_fixed",10)) { +#ifdef ERTS_SMP + erts_smp_mtx_lock(&tb->common.fixlock); +#endif + if (IS_FIXED(tb)) { + Uint need; + Eterm *hp; + Eterm tpl, lst; + DbFixation *fix; + need = 7; + for (fix = tb->common.fixations; fix != NULL; fix = fix->next) { + need += 5; + } + hp = HAlloc(p, need); + lst = NIL; + for (fix = tb->common.fixations; fix != NULL; fix = fix->next) { + tpl = TUPLE2(hp,fix->pid,make_small(fix->counter)); + hp += 3; + lst = CONS(hp,tpl,lst); + hp += 2; + } + tpl = TUPLE3(hp, + make_small(tb->common.megasec), + make_small(tb->common.sec), + make_small(tb->common.microsec)); + hp += 4; + ret = TUPLE2(hp, tpl, lst); + } else { + ret = am_false; + } +#ifdef ERTS_SMP + erts_smp_mtx_unlock(&tb->common.fixlock); +#endif + } else if (What == am_atom_put("stats",5)) { + if (IS_HASH_TABLE(tb->common.status)) { + FloatDef f; + DbHashStats stats; + Eterm avg, std_dev_real, std_dev_exp; + Eterm* hp; + + db_calc_stats_hash(&tb->hash, &stats); + hp = HAlloc(p, 1 + 6 + FLOAT_SIZE_OBJECT*3); + f.fd = stats.avg_chain_len; + avg = make_float(hp); + PUT_DOUBLE(f, hp); + hp += FLOAT_SIZE_OBJECT; + + f.fd = stats.std_dev_chain_len; + std_dev_real = make_float(hp); + PUT_DOUBLE(f, hp); + hp += FLOAT_SIZE_OBJECT; + + f.fd = stats.std_dev_expected; + std_dev_exp = make_float(hp); + PUT_DOUBLE(f, hp); + hp += FLOAT_SIZE_OBJECT; + ret = TUPLE6(hp, make_small(erts_smp_atomic_read(&tb->hash.nactive)), + avg, std_dev_real, std_dev_exp, + make_small(stats.min_chain_len), + make_small(stats.max_chain_len)); + } + else { + ret = am_false; + } + } + return ret; +} + +static void print_table(int to, void *to_arg, int show, DbTable* tb) +{ + erts_print(to, to_arg, "Table: %T\n", tb->common.id); + erts_print(to, to_arg, "Name: %T\n", tb->common.the_name); + + tb->common.meth->db_print(to, to_arg, show, tb); + + erts_print(to, to_arg, "Objects: %d\n", (int)erts_smp_atomic_read(&tb->common.nitems)); + erts_print(to, to_arg, "Words: %bpu\n", + (Uint) ((erts_smp_atomic_read(&tb->common.memory_size) + + sizeof(Uint) + - 1) + / sizeof(Uint))); +} + +void db_info(int to, void *to_arg, int show) /* Called by break handler */ +{ + int i; + for (i=0; i < db_max_tabs; i++) + if (IS_SLOT_ALIVE(i)) { + erts_print(to, to_arg, "=ets:%T\n", meta_main_tab[i].u.tb->common.owner); + erts_print(to, to_arg, "Slot: %d\n", i); + print_table(to, to_arg, show, meta_main_tab[i].u.tb); + } +#ifdef DEBUG + erts_print(to, to_arg, "=internal_ets: Process to table index\n"); + print_table(to, to_arg, show, meta_pid_to_tab); + erts_print(to, to_arg, "=internal_ets: Process to fixation index\n"); + print_table(to, to_arg, show, meta_pid_to_fixed_tab); +#endif +} + +Uint +erts_get_ets_misc_mem_size(void) +{ + /* Memory not allocated in ets_alloc */ + return (Uint) erts_smp_atomic_read(&erts_ets_misc_mem_size); +} + +/* SMP Note: May only be used when system is locked */ +void +erts_db_foreach_table(void (*func)(DbTable *, void *), void *arg) +{ + int i, j; + j = 0; + for(i = 0; (i < db_max_tabs && j < meta_main_tab_cnt); i++) { + if (IS_SLOT_ALIVE(i)) { + j++; + (*func)(meta_main_tab[i].u.tb, arg); + } + } + ASSERT(j == meta_main_tab_cnt); +} + +/* SMP Note: May only be used when system is locked */ +void +erts_db_foreach_offheap(DbTable *tb, + void (*func)(ErlOffHeap *, void *), + void *arg) +{ + tb->common.meth->db_foreach_offheap(tb, func, arg); +} + +/* + * For testing of meta tables only. + * + * Given a name atom (as returned from ets:new/2), return a list of 'cnt' + * number of other names that will hash to the same bucket in meta_name_tab. + * + * WARNING: Will bloat the atom table! + */ +Eterm +erts_ets_colliding_names(Process* p, Eterm name, Uint cnt) +{ + Eterm list = NIL; + Eterm* hp = HAlloc(p,cnt*2); + Uint index = atom_val(name) & meta_name_tab_mask; + + while (cnt) { + if (index != atom_val(name)) { + while (index >= atom_table_size()) { + char tmp[20]; + erts_snprintf(tmp, sizeof(tmp), "am%x", atom_table_size()); + am_atom_put(tmp,strlen(tmp)); + } + list = CONS(hp, make_atom(index), list); + hp += 2; + --cnt; + } + index += meta_name_tab_mask + 1; + } + return list; +} + + +#ifdef HARDDEBUG /* Here comes some debug functions */ + +void db_check_tables(void) +{ +#ifdef ERTS_SMP + return; +#else + int i; + + for (i = 0; i < db_max_tabs; i++) { + if (IS_SLOT_ALIVE(i)) { + DbTable* tb = meta_main_tab[i].t; + tb->common.meth->db_check_table(tb); + } + } +#endif +} + +#endif /* HARDDEBUG */ diff --git a/erts/emulator/beam/erl_db.h b/erts/emulator/beam/erl_db.h new file mode 100644 index 0000000000..7da28fad29 --- /dev/null +++ b/erts/emulator/beam/erl_db.h @@ -0,0 +1,247 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This file now contains only the definitions needed for the + * meta table. + * + */ + +#ifndef __DB_H__ +#define __DB_H__ + +#include "sys.h" +#include "bif.h" + +#include "erl_db_util.h" /* Flags */ +#include "erl_db_hash.h" /* DbTableHash */ +#include "erl_db_tree.h" /* DbTableTree */ +/*TT*/ + +Uint erts_get_ets_misc_mem_size(void); + +/* + * So, the structure for a database table, NB this is only + * interesting in db.c. + */ +union db_table { + DbTableCommon common; /* Any type of db table */ + DbTableHash hash; /* Linear hash array specific data */ + DbTableTree tree; /* AVL tree specific data */ + /*TT*/ +}; + +#define DB_DEF_MAX_TABS 2053 /* Superseeded by environment variable + "ERL_MAX_ETS_TABLES" */ +#define ERL_MAX_ETS_TABLES_ENV "ERL_MAX_ETS_TABLES" + +void init_db(void); +int erts_db_process_exiting(Process *, ErtsProcLocks); +void db_info(int, void *, int); +void erts_db_foreach_table(void (*)(DbTable *, void *), void *); +void erts_db_foreach_offheap(DbTable *, + void (*func)(ErlOffHeap *, void *), + void *); + +extern int user_requested_db_max_tabs; /* set in erl_init */ +extern int erts_ets_realloc_always_moves; /* set in erl_init */ +extern Export ets_select_delete_continue_exp; +extern Export ets_select_count_continue_exp; +extern Export ets_select_continue_exp; +extern erts_smp_atomic_t erts_ets_misc_mem_size; + +Eterm erts_ets_colliding_names(Process*, Eterm name, Uint cnt); + +#endif + +#if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__) +#define ERTS_HAVE_DB_INTERNAL__ + +#include "erl_alloc.h" + +/* + * _fnf : Failure Not Fatal (same as for erts_alloc/erts_realloc/erts_free) + * _nt : No Table (i.e. memory not associated with a specific table) + */ + +#define ERTS_DB_ALC_MEM_UPDATE_(TAB, FREE_SZ, ALLOC_SZ) \ +do { \ + long sz__ = ((long) (ALLOC_SZ)) - ((long) (FREE_SZ)); \ + ASSERT((TAB)); \ + erts_smp_atomic_add(&(TAB)->common.memory_size, sz__); \ +} while (0) + +#define ERTS_ETS_MISC_MEM_ADD(SZ) \ + erts_smp_atomic_add(&erts_ets_misc_mem_size, (SZ)); + +ERTS_GLB_INLINE void *erts_db_alloc(ErtsAlcType_t type, + DbTable *tab, + Uint size); +ERTS_GLB_INLINE void *erts_db_alloc_fnf(ErtsAlcType_t type, + DbTable *tab, + Uint size); +ERTS_GLB_INLINE void *erts_db_alloc_nt(ErtsAlcType_t type, Uint size); +ERTS_GLB_INLINE void *erts_db_alloc_fnf_nt(ErtsAlcType_t type, Uint size); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void * +erts_db_alloc(ErtsAlcType_t type, DbTable *tab, Uint size) +{ + void *res = erts_alloc(type, size); + ERTS_DB_ALC_MEM_UPDATE_(tab, 0, size); + return res; +} + +ERTS_GLB_INLINE void * +erts_db_alloc_fnf(ErtsAlcType_t type, DbTable *tab, Uint size) +{ + void *res = erts_alloc_fnf(type, size); + if (!res) + return NULL; + ERTS_DB_ALC_MEM_UPDATE_(tab, 0, size); + return res; +} + +ERTS_GLB_INLINE void * +erts_db_alloc_nt(ErtsAlcType_t type, Uint size) +{ + void *res = erts_alloc(type, size); + return res; +} + +ERTS_GLB_INLINE void * +erts_db_alloc_fnf_nt(ErtsAlcType_t type, Uint size) +{ + void *res = erts_alloc_fnf(type, size); + if (!res) + return NULL; + return res; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +ERTS_GLB_INLINE void *erts_db_realloc(ErtsAlcType_t type, + DbTable *tab, + void *ptr, + Uint old_size, + Uint size); +ERTS_GLB_INLINE void *erts_db_realloc_fnf(ErtsAlcType_t type, + DbTable *tab, + void *ptr, + Uint old_size, + Uint size); +ERTS_GLB_INLINE void *erts_db_realloc_nt(ErtsAlcType_t type, + void *ptr, + Uint old_size, + Uint size); +ERTS_GLB_INLINE void *erts_db_realloc_fnf_nt(ErtsAlcType_t type, + void *ptr, + Uint old_size, + Uint size); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void * +erts_db_realloc(ErtsAlcType_t type, DbTable *tab, void *ptr, + Uint old_size, Uint size) +{ + void *res; + ASSERT(!ptr || old_size == ERTS_ALC_DBG_BLK_SZ(ptr)); + res = erts_realloc(type, ptr, size); + ERTS_DB_ALC_MEM_UPDATE_(tab, old_size, size); + return res; +} + +ERTS_GLB_INLINE void * +erts_db_realloc_fnf(ErtsAlcType_t type, DbTable *tab, void *ptr, + Uint old_size, Uint size) +{ + void *res; + ASSERT(!ptr || old_size == ERTS_ALC_DBG_BLK_SZ(ptr)); + res = erts_realloc_fnf(type, ptr, size); + if (!res) + return NULL; + ERTS_DB_ALC_MEM_UPDATE_(tab, old_size, size); + return res; +} + +ERTS_GLB_INLINE void * +erts_db_realloc_nt(ErtsAlcType_t type, void *ptr, + Uint old_size, Uint size) +{ + void *res; + ASSERT(!ptr || old_size == ERTS_ALC_DBG_BLK_SZ(ptr)); + res = erts_realloc(type, ptr, size); + return res; +} + +ERTS_GLB_INLINE void * +erts_db_realloc_fnf_nt(ErtsAlcType_t type, void *ptr, + Uint old_size, Uint size) +{ + void *res; + ASSERT(!ptr || old_size == ERTS_ALC_DBG_BLK_SZ(ptr)); + res = erts_realloc_fnf(type, ptr, size); + if (!res) + return NULL; + return res; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +ERTS_GLB_INLINE void erts_db_free(ErtsAlcType_t type, + DbTable *tab, + void *ptr, + Uint size); + +ERTS_GLB_INLINE void erts_db_free_nt(ErtsAlcType_t type, + void *ptr, + Uint size); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_db_free(ErtsAlcType_t type, DbTable *tab, void *ptr, Uint size) +{ + ASSERT(ptr != 0); + ASSERT(size == ERTS_ALC_DBG_BLK_SZ(ptr)); + ERTS_DB_ALC_MEM_UPDATE_(tab, size, 0); + + ASSERT(((void *) tab) != ptr + || erts_smp_atomic_read(&tab->common.memory_size) == 0); + + erts_free(type, ptr); +} + +ERTS_GLB_INLINE void +erts_db_free_nt(ErtsAlcType_t type, void *ptr, Uint size) +{ + ASSERT(ptr != 0); + ASSERT(size == ERTS_ALC_DBG_BLK_SZ(ptr)); + + erts_free(type, ptr); +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#undef ERTS_DB_ALC_MEM_UPDATE_ + +#endif /* #if defined(ERTS_WANT_DB_INTERNAL__) && !defined(ERTS_HAVE_DB_INTERNAL__) */ + diff --git a/erts/emulator/beam/erl_db_hash.c b/erts/emulator/beam/erl_db_hash.c new file mode 100644 index 0000000000..dea45053df --- /dev/null +++ b/erts/emulator/beam/erl_db_hash.c @@ -0,0 +1,2868 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** Implementation of unordered ETS tables. +** The tables are implemented as linear dynamic hash tables. +*/ + +/* SMP: +** The hash table supports two different locking "modes", +** coarse grained and fine grained locking. +** +** Coarse grained locking relies entirely on the caller (erl_db.c) to obtain +** the right kind of lock on the entire table depending on operation (reading +** or writing). No further locking is then done by the table itself. +** +** Fine grained locking is supported by this code to allow concurrent updates +** (and reading) to different parts of the table. This works by keeping one +** rw-mtx for every N'th bucket. Even dynamic growing and shrinking by +** rehashing buckets can be done without exclusive table lock. +** +** A table will support fine grained locking if it is created with flag +** DB_FINE_LOCKED set. The table variable is_thread_safe will then indicate +** if operations need to obtain fine grained locks or not. Some operations +** will for example always use exclusive table lock to guarantee +** a higher level of atomicy. +*/ + +/* FIXATION: +** Fixating the table, by ets:safe_fixtable or as done by select-operations, +** guarantees two things in current implementation. +** (1) Keys will not *totaly* disappear from the table. A key can thus be used +** as an iterator to find the next key in iteration sequence. Note however +** that this does not mean that (pointers to) table objects are guaranteed +** to be maintained while the table is fixated. A BAG or DBAG may actually +** remove objects as long as there is at least one object left in the table +** with the same key (alive or pseudo-deleted). +** (2) Objects will not be moved between buckets due to table grow/shrink. +** This will guarantee that iterations do not miss keys or get double-hits. +** +** With fine grained locking, a concurrent thread can fixate the table at any +** time. A "dangerous" operation (delete or move) therefore needs to check +** if the table is fixated while write-locking the bucket. +*/ + +/* +#ifdef DEBUG +#define HARDDEBUG 1 +#endif +*/ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#define ERTS_WANT_DB_INTERNAL__ +#include "erl_db.h" +#include "bif.h" +#include "big.h" +#include "export.h" +#include "erl_binary.h" + +#include "erl_db_hash.h" + +#ifdef MYDEBUG /* Will fail test case ets_SUITE:memory */ +# define IF_DEBUG(x) x +# define MY_ASSERT(x) ASSERT(x) +#else +# define IF_DEBUG(x) +# define MY_ASSERT(x) +#endif + +/* + * The following symbols can be manipulated to "tune" the linear hash array + */ +#define CHAIN_LEN 6 /* Medium bucket chain len */ + +/* Number of slots per segment */ +#define SEGSZ_EXP 8 +#define SEGSZ (1 << SEGSZ_EXP) +#define SEGSZ_MASK (SEGSZ-1) + +#define NSEG_1 2 /* Size of first segment table (must be at least 2) */ +#define NSEG_2 256 /* Size of second segment table */ +#define NSEG_INC 128 /* Number of segments to grow after that */ + +#define SEGTAB(tb) ((struct segment**)erts_smp_atomic_read(&(tb)->segtab)) +#define NACTIVE(tb) ((int)erts_smp_atomic_read(&(tb)->nactive)) +#define NITEMS(tb) ((int)erts_smp_atomic_read(&(tb)->common.nitems)) + +#define BUCKET(tb, i) SEGTAB(tb)[(i) >> SEGSZ_EXP]->buckets[(i) & SEGSZ_MASK] + +/* + * When deleting a table, the number of records to delete. + * Approximate number, because we must delete entire buckets. + */ +#define DELETE_RECORD_LIMIT 10000 + +/* Calculate slot index from hash value. +** RLOCK_HASH or WLOCK_HASH must be done before. +*/ +static ERTS_INLINE Uint hash_to_ix(DbTableHash* tb, HashValue hval) +{ + Uint mask = erts_smp_atomic_read(&tb->szm); + Uint ix = hval & mask; + if (ix >= erts_smp_atomic_read(&tb->nactive)) { + ix &= mask>>1; + ASSERT(ix < erts_smp_atomic_read(&tb->nactive)); + } + return ix; +} + +/* Remember a slot containing a pseudo-deleted item (INVALID_HASH) +*/ +static ERTS_INLINE void add_fixed_deletion(DbTableHash* tb, int ix) +{ + long was_next; + long exp_next; + FixedDeletion* fixd = (FixedDeletion*) erts_db_alloc(ERTS_ALC_T_DB_FIX_DEL, + (DbTable *) tb, + sizeof(FixedDeletion)); + ERTS_ETS_MISC_MEM_ADD(sizeof(FixedDeletion)); + fixd->slot = ix; + was_next = erts_smp_atomic_read(&tb->fixdel); + do { /* Lockless atomic insertion in linked list: */ + exp_next = was_next; + fixd->next = (FixedDeletion*) exp_next; + was_next = erts_smp_atomic_cmpxchg(&tb->fixdel, (long)fixd, exp_next); + }while (was_next != exp_next); +} + + +#define MAX_HASH 0xEFFFFFFFUL +#define INVALID_HASH 0xFFFFFFFFUL + +/* optimised version of make_hash (normal case? atomic key) */ +#define MAKE_HASH(term) \ + ((is_atom(term) ? (atom_tab(atom_val(term))->slot.bucket.hvalue) : \ + make_hash2(term)) % MAX_HASH) + +#ifdef ERTS_SMP +# define DB_HASH_LOCK_MASK (DB_HASH_LOCK_CNT-1) +# define GET_LOCK(tb,hval) (&(tb)->locks->lck_vec[(hval) & DB_HASH_LOCK_MASK].lck) + +/* Fine grained read lock */ +static ERTS_INLINE erts_smp_rwmtx_t* RLOCK_HASH(DbTableHash* tb, HashValue hval) +{ + if (tb->common.is_thread_safe) { + return NULL; + } else { + erts_smp_rwmtx_t* lck = GET_LOCK(tb,hval); + ASSERT(tb->common.type & DB_FINE_LOCKED); + erts_smp_rwmtx_rlock(lck); + return lck; + } +} +/* Fine grained write lock */ +static ERTS_INLINE erts_smp_rwmtx_t* WLOCK_HASH(DbTableHash* tb, HashValue hval) +{ + if (tb->common.is_thread_safe) { + return NULL; + } else { + erts_smp_rwmtx_t* lck = GET_LOCK(tb,hval); + ASSERT(tb->common.type & DB_FINE_LOCKED); + erts_smp_rwmtx_rwlock(lck); + return lck; + } +} + +static ERTS_INLINE void RUNLOCK_HASH(erts_smp_rwmtx_t* lck) +{ + if (lck != NULL) { + erts_smp_rwmtx_runlock(lck); + } +} + +static ERTS_INLINE void WUNLOCK_HASH(erts_smp_rwmtx_t* lck) +{ + if (lck != NULL) { + erts_smp_rwmtx_rwunlock(lck); + } +} +#else /* ERTS_SMP */ +# define RLOCK_HASH(tb,hval) NULL +# define WLOCK_HASH(tb,hval) NULL +# define RUNLOCK_HASH(lck) ((void)lck) +# define WUNLOCK_HASH(lck) ((void)lck) +#endif /* ERTS_SMP */ + + +#ifdef ERTS_ENABLE_LOCK_CHECK +# define IFN_EXCL(tb,cmd) (((tb)->common.is_thread_safe) || (cmd)) +# define IS_HASH_RLOCKED(tb,hval) IFN_EXCL(tb,erts_smp_lc_rwmtx_is_rlocked(GET_LOCK(tb,hval))) +# define IS_HASH_WLOCKED(tb,lck) IFN_EXCL(tb,erts_smp_lc_rwmtx_is_rwlocked(lck)) +# define IS_TAB_WLOCKED(tb) erts_smp_lc_rwmtx_is_rwlocked(&(tb)->common.rwlock) +#else +# define IS_HASH_RLOCKED(tb,hval) (1) +# define IS_HASH_WLOCKED(tb,hval) (1) +# define IS_TAB_WLOCKED(tb) (1) +#endif + + +/* Iteration helper +** Returns "next" slot index or 0 if EOT reached. +** Slot READ locks updated accordingly, unlocked if EOT. +*/ +static ERTS_INLINE Sint next_slot(DbTableHash* tb, Uint ix, + erts_smp_rwmtx_t** lck_ptr) +{ +#ifdef ERTS_SMP + ix += DB_HASH_LOCK_CNT; + if (ix < NACTIVE(tb)) return ix; + RUNLOCK_HASH(*lck_ptr); + ix = (ix + 1) & DB_HASH_LOCK_MASK; + if (ix != 0) *lck_ptr = RLOCK_HASH(tb,ix); + return ix; +#else + return (++ix < NACTIVE(tb)) ? ix : 0; +#endif +} +/* Same as next_slot but with WRITE locking */ +static ERTS_INLINE Sint next_slot_w(DbTableHash* tb, Uint ix, + erts_smp_rwmtx_t** lck_ptr) +{ +#ifdef ERTS_SMP + ix += DB_HASH_LOCK_CNT; + if (ix < NACTIVE(tb)) return ix; + WUNLOCK_HASH(*lck_ptr); + ix = (ix + 1) & DB_HASH_LOCK_MASK; + if (ix != 0) *lck_ptr = WLOCK_HASH(tb,ix); + return ix; +#else + return next_slot(tb,ix,lck_ptr); +#endif +} + + +/* + * tplp is an untagged pointer to a tuple we know is large enough + * and dth is a pointer to a DbTableHash. + */ +#define GETKEY(dth, tplp) (*((tplp) + (dth)->common.keypos)) + +/* + * Some special binary flags + */ +#define BIN_FLAG_ALL_OBJECTS BIN_FLAG_USR1 + +/* + * Size calculations + */ +#define SIZ_OVERHEAD ((sizeof(HashDbTerm)/sizeof(Eterm)) - 1) +#define SIZ_DBTERM(HDT) (SIZ_OVERHEAD + (HDT)->dbterm.size) + +/* + * Local types + */ +struct mp_prefound { + HashDbTerm** bucket; + int ix; +}; + +struct mp_info { + int all_objects; /* True if complete objects are always + * returned from the match_spec (can use + * copy_shallow on the return value) */ + int something_can_match; /* The match_spec is not "impossible" */ + int key_given; + struct mp_prefound dlists[10]; /* Default list of "pre-found" buckets */ + struct mp_prefound* lists; /* Buckets to search if keys are given, + * = dlists initially */ + unsigned num_lists; /* Number of elements in "lists", + * = 0 initially */ + Binary *mp; /* The compiled match program */ +}; + +/* A table segment */ +struct segment { + HashDbTerm* buckets[SEGSZ]; +#ifdef MYDEBUG + int is_ext_segment; +#endif +}; + +/* A segment that also contains a segment table */ +struct ext_segment { + struct segment s; /* The segment itself. Must be first */ + + struct segment** prev_segtab; /* Used when table is shrinking */ + int nsegs; /* Size of segtab */ + struct segment* segtab[1]; /* The segment table */ +}; +#define SIZEOF_EXTSEG(NSEGS) \ + (sizeof(struct ext_segment) - sizeof(struct segment*) + sizeof(struct segment*)*(NSEGS)) + +#ifdef DEBUG +# include /* offsetof */ +# define EXTSEG(SEGTAB_PTR) \ + ((struct ext_segment*) (((char*)(SEGTAB_PTR)) - offsetof(struct ext_segment,segtab))) +#endif + + +/* How the table segments relate to each other: + + ext_segment: ext_segment: "plain" segment + #=================# #================# #=============# + | bucket[0] |<--+ +------->| bucket[256] | +->| bucket[512] | + | bucket[1] | | | | [257] | | | [513] | + : : | | : : | : : + | bucket[255] | | | | [511] | | | [767] | + |-----------------| | | |----------------| | #=============# + | prev_segtab=NULL| | | +--<---prev_segtab | | + | nsegs = 2 | | | | | nsegs = 256 | | ++->| segtab[0] -->-------+---|---|--<---segtab[0] |<-+ | +| | segtab[1] -->-----------+---|--<---segtab[1] | | | +| #=================# | | segtab[2] -->-----|--+ ext_segment: +| | : : | #================# ++----------------<---------------+ | segtab[255] ->----|----->| bucket[255*256]| + #================# | | | + | : : + | |----------------| + +----<---prev_segtab | + : : +*/ + + +/* +** Forward decl's (static functions) +*/ +static struct ext_segment* alloc_ext_seg(DbTableHash* tb, unsigned seg_ix, + struct segment** old_segtab); +static int alloc_seg(DbTableHash *tb); +static int free_seg(DbTableHash *tb, int free_records); +static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr, + HashDbTerm *list); +static HashDbTerm* search_list(DbTableHash* tb, Eterm key, + HashValue hval, HashDbTerm *list); +static void shrink(DbTableHash* tb, int nactive); +static void grow(DbTableHash* tb, int nactive); +static void free_term(DbTableHash *tb, HashDbTerm* p); +static Eterm put_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2); +static HashDbTerm* get_term(DbTableHash* tb, HashDbTerm* old, + Eterm obj, HashValue hval); +static int analyze_pattern(DbTableHash *tb, Eterm pattern, + struct mp_info *mpi); + +/* + * Method interface functions + */ +static int db_first_hash(Process *p, + DbTable *tbl, + Eterm *ret); + +static int db_next_hash(Process *p, + DbTable *tbl, + Eterm key, + Eterm *ret); + +static int db_member_hash(DbTable *tbl, Eterm key, Eterm *ret); + +static int db_get_element_hash(Process *p, DbTable *tbl, + Eterm key, int ndex, Eterm *ret); + +static int db_erase_object_hash(DbTable *tbl, Eterm object,Eterm *ret); + +static int db_slot_hash(Process *p, DbTable *tbl, + Eterm slot_term, Eterm *ret); + +static int db_select_chunk_hash(Process *p, DbTable *tbl, + Eterm pattern, Sint chunk_size, + int reverse, Eterm *ret); +static int db_select_hash(Process *p, DbTable *tbl, + Eterm pattern, int reverse, Eterm *ret); +static int db_select_count_hash(Process *p, DbTable *tbl, + Eterm pattern, Eterm *ret); +static int db_select_delete_hash(Process *p, DbTable *tbl, + Eterm pattern, Eterm *ret); + +static int db_select_continue_hash(Process *p, DbTable *tbl, + Eterm continuation, Eterm *ret); + +static int db_select_count_continue_hash(Process *p, DbTable *tbl, + Eterm continuation, Eterm *ret); + +static int db_select_delete_continue_hash(Process *p, DbTable *tbl, + Eterm continuation, Eterm *ret); +static void db_print_hash(int to, + void *to_arg, + int show, + DbTable *tbl); +static int db_free_table_hash(DbTable *tbl); + +static int db_free_table_continue_hash(DbTable *tbl); + + +static void db_foreach_offheap_hash(DbTable *, + void (*)(ErlOffHeap *, void *), + void *); + +static int db_delete_all_objects_hash(Process* p, DbTable* tbl); +#ifdef HARDDEBUG +static void db_check_table_hash(DbTableHash *tb); +#endif +static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle); +static void db_finalize_dbterm_hash(DbUpdateHandle* handle); + +static ERTS_INLINE void try_shrink(DbTableHash* tb) +{ + int nactive = NACTIVE(tb); + if (nactive > SEGSZ && NITEMS(tb) < (nactive * CHAIN_LEN) + && !IS_FIXED(tb)) { + shrink(tb, nactive); + } +} + +/* Is this a live object (not pseodo-deleted) with the specified key? +*/ +static ERTS_INLINE int has_live_key(DbTableHash* tb, HashDbTerm* b, + Eterm key, HashValue hval) +{ + if (b->hvalue != hval) return 0; + else { + Eterm itemKey = GETKEY(tb, b->dbterm.tpl); + return EQ(key,itemKey); + } +} + +/* Has this object the specified key? Can be pseudo-deleted. +*/ +static ERTS_INLINE int has_key(DbTableHash* tb, HashDbTerm* b, + Eterm key, HashValue hval) +{ + if (b->hvalue != hval && b->hvalue != INVALID_HASH) return 0; + else { + Eterm itemKey = GETKEY(tb, b->dbterm.tpl); + return EQ(key,itemKey); + } +} + + +/* +** External interface +*/ +DbTableMethod db_hash = +{ + db_create_hash, + db_first_hash, + db_next_hash, + db_first_hash, /* last == first */ + db_next_hash, /* prev == next */ + db_put_hash, + db_get_hash, + db_get_element_hash, + db_member_hash, + db_erase_hash, + db_erase_object_hash, + db_slot_hash, + db_select_chunk_hash, + db_select_hash, + db_select_delete_hash, + db_select_continue_hash, /* hmm continue_hash? */ + db_select_delete_continue_hash, + db_select_count_hash, + db_select_count_continue_hash, + db_delete_all_objects_hash, + db_free_table_hash, + db_free_table_continue_hash, + db_print_hash, + db_foreach_offheap_hash, +#ifdef HARDDEBUG + db_check_table_hash, +#else + NULL, +#endif + db_lookup_dbterm_hash, + db_finalize_dbterm_hash +}; + +#ifdef DEBUG +/* Wait a while to provoke race and get code coverage */ +static void DEBUG_WAIT(void) +{ + unsigned long spin = 1UL << 20; + while (--spin); +} +#else +# define DEBUG_WAIT() +#endif + +/* Rare case of restoring the rest of the fixdel list + when "unfixer" gets interrupted by "fixer" */ +static void restore_fixdel(DbTableHash* tb, FixedDeletion* fixdel) +{ + /*int tries = 0;*/ + DEBUG_WAIT(); + if (erts_smp_atomic_cmpxchg(&tb->fixdel, (long)fixdel, + (long)NULL) != (long)NULL) { + /* Oboy, must join lists */ + FixedDeletion* last = fixdel; + long was_tail; + long exp_tail; + + while (last->next != NULL) last = last->next; + was_tail = erts_smp_atomic_read(&tb->fixdel); + do { /* Lockless atomic list insertion */ + exp_tail = was_tail; + last->next = (FixedDeletion*) exp_tail; + /*++tries;*/ + DEBUG_WAIT(); + was_tail = erts_smp_atomic_cmpxchg(&tb->fixdel, (long)fixdel, + exp_tail); + }while (was_tail != exp_tail); + } + /*erts_fprintf(stderr,"erl_db_hash: restore_fixdel tries=%d\r\n", tries);*/ +} +/* +** Table interface routines ie what's called by the bif's +*/ + +void db_unfix_table_hash(DbTableHash *tb) +{ + FixedDeletion* fixdel; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rwlocked(&tb->common.rwlock) + || (erts_smp_lc_rwmtx_is_rlocked(&tb->common.rwlock) + && !tb->common.is_thread_safe)); +restart: + fixdel = (FixedDeletion*) erts_smp_atomic_xchg(&tb->fixdel, (long)NULL); + while (fixdel != NULL) { + FixedDeletion *fx = fixdel; + int ix = fx->slot; + HashDbTerm **bp; + HashDbTerm *b; + erts_smp_rwmtx_t* lck = WLOCK_HASH(tb,ix); + + if (IS_FIXED(tb)) { /* interrupted by fixer */ + WUNLOCK_HASH(lck); + restore_fixdel(tb,fixdel); + if (!IS_FIXED(tb)) { + goto restart; /* unfixed again! */ + } + return; + } + if (ix < NACTIVE(tb)) { + bp = &BUCKET(tb, ix); + b = *bp; + + while (b != NULL) { + if (b->hvalue == INVALID_HASH) { + *bp = b->next; + free_term(tb, b); + b = *bp; + } else { + bp = &b->next; + b = b->next; + } + } + } + /* else slot has been joined and purged by shrink() */ + WUNLOCK_HASH(lck); + fixdel = fx->next; + erts_db_free(ERTS_ALC_T_DB_FIX_DEL, + (DbTable *) tb, + (void *) fx, + sizeof(FixedDeletion)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion)); + } + + /* ToDo: Maybe try grow/shrink the table as well */ +} + +/* Only used by tests +*/ +Uint db_kept_items_hash(DbTableHash *tb) +{ + Uint kept_items = 0; + Uint ix = 0; + erts_smp_rwmtx_t* lck = RLOCK_HASH(tb,ix); + HashDbTerm* b; + do { + for (b = BUCKET(tb, ix); b != NULL; b = b->next) { + if (b->hvalue == INVALID_HASH) { + ++kept_items; + } + } + ix = next_slot(tb, ix, &lck); + }while (ix); + return kept_items; +} + +int db_create_hash(Process *p, DbTable *tbl) +{ + DbTableHash *tb = &tbl->hash; + + erts_smp_atomic_init(&tb->szm, SEGSZ_MASK); + erts_smp_atomic_init(&tb->nactive, SEGSZ); + erts_smp_atomic_init(&tb->fixdel, (long)NULL); + erts_smp_atomic_init(&tb->segtab, (long) alloc_ext_seg(tb,0,NULL)->segtab); + tb->nsegs = NSEG_1; + tb->nslots = SEGSZ; + + erts_smp_atomic_init(&tb->is_resizing, 0); +#ifdef ERTS_SMP + if (tb->common.type & DB_FINE_LOCKED) { + int i; + tb->locks = (DbTableHashFineLocks*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, /* Other type maybe? */ + (DbTable *) tb, + sizeof(DbTableHashFineLocks)); + for (i=0; ilocks->lck_vec[i].lck, "db_hash_slot", tb->common.the_name); + #else + erts_rwmtx_init(&tb->locks->lck_vec[i].lck, "db_hash_slot"); + #endif + } + /* This important property is needed to guarantee that the buckets + * involved in a grow/shrink operation it protected by the same lock: + */ + ASSERT(erts_smp_atomic_read(&tb->nactive) % DB_HASH_LOCK_CNT == 0); + } + else { /* coarse locking */ + tb->locks = NULL; + } +#endif /* ERST_SMP */ + return DB_ERROR_NONE; +} + +static int db_first_hash(Process *p, DbTable *tbl, Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + Uint ix = 0; + erts_smp_rwmtx_t* lck = RLOCK_HASH(tb,ix); + HashDbTerm* list; + + for (;;) { + list = BUCKET(tb,ix); + if (list != NULL) { + if (list->hvalue == INVALID_HASH) { + list = next(tb,&ix,&lck,list); + } + break; + } + if ((ix=next_slot(tb,ix,&lck)) == 0) { + list = NULL; + break; + } + } + if (list != NULL) { + Eterm key = GETKEY(tb, list->dbterm.tpl); + + COPY_OBJECT(key, p, ret); + RUNLOCK_HASH(lck); + } + else { + *ret = am_EOT; + } + return DB_ERROR_NONE; +} + + +static int db_next_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + Uint ix; + HashDbTerm* b; + erts_smp_rwmtx_t* lck; + + hval = MAKE_HASH(key); + lck = RLOCK_HASH(tb,hval); + ix = hash_to_ix(tb, hval); + b = BUCKET(tb, ix); + + for (;;) { + if (b == NULL) { + RUNLOCK_HASH(lck); + return DB_ERROR_BADKEY; + } + if (has_key(tb, b, key, hval)) { + break; + } + b = b->next; + } + /* Key found */ + + b = next(tb, &ix, &lck, b); + if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { + while (b != 0) { + if (!has_live_key(tb, b, key, hval)) { + break; + } + b = next(tb, &ix, &lck, b); + } + } + if (b == NULL) { + *ret = am_EOT; + } + else { + COPY_OBJECT(GETKEY(tb, b->dbterm.tpl), p, ret); + RUNLOCK_HASH(lck); + } + return DB_ERROR_NONE; +} + +int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + int ix; + Eterm key; + HashDbTerm** bp; + HashDbTerm* b; + HashDbTerm* q; + erts_smp_rwmtx_t* lck; + int nitems; + int ret = DB_ERROR_NONE; + + key = GETKEY(tb, tuple_val(obj)); + hval = MAKE_HASH(key); + lck = WLOCK_HASH(tb, hval); + ix = hash_to_ix(tb, hval); + bp = &BUCKET(tb, ix); + b = *bp; + + for (;;) { + if (b == NULL) { + goto Lnew; + } + if (has_key(tb,b,key,hval)) { + break; + } + bp = &b->next; + b = b->next; + } + /* Key found + */ + if (tb->common.status & DB_SET) { + HashDbTerm* bnext = b->next; + if (b->hvalue == INVALID_HASH) { + erts_smp_atomic_inc(&tb->common.nitems); + } + else if (key_clash_fail) { + ret = DB_ERROR_BADKEY; + goto Ldone; + } + q = get_term(tb, b, obj, hval); + q->next = bnext; + q->hvalue = hval; /* In case of INVALID_HASH */ + *bp = q; + goto Ldone; + } + else if (key_clash_fail) { /* && (DB_BAG || DB_DUPLICATE_BAG) */ + q = b; + do { + if (q->hvalue != INVALID_HASH) { + ret = DB_ERROR_BADKEY; + goto Ldone; + } + q = q->next; + }while (q != NULL && has_key(tb,q,key,hval)); + } + else if (tb->common.status & DB_BAG) { + HashDbTerm** qp = bp; + q = b; + do { + if (eq(make_tuple(q->dbterm.tpl), obj)) { + if (q->hvalue == INVALID_HASH) { + erts_smp_atomic_inc(&tb->common.nitems); + q->hvalue = hval; + if (q != b) { /* must move to preserve key insertion order */ + *qp = q->next; + q->next = b; + *bp = q; + } + } + goto Ldone; + } + qp = &q->next; + q = *qp; + }while (q != NULL && has_key(tb,q,key,hval)); + } + /*else DB_DUPLICATE_BAG */ + +Lnew: + q = get_term(tb, NULL, obj, hval); + q->next = b; + *bp = q; + nitems = erts_smp_atomic_inctest(&tb->common.nitems); + WUNLOCK_HASH(lck); + { + int nactive = NACTIVE(tb); + if (nitems > nactive * (CHAIN_LEN+1) && !IS_FIXED(tb)) { + grow(tb, nactive); + } + } + CHECK_TABLES(); + return DB_ERROR_NONE; + +Ldone: + WUNLOCK_HASH(lck); + return ret; +} + +int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + int ix; + HashDbTerm* b1; + erts_smp_rwmtx_t* lck; + + hval = MAKE_HASH(key); + lck = RLOCK_HASH(tb,hval); + ix = hash_to_ix(tb, hval); + b1 = BUCKET(tb, ix); + + while(b1 != 0) { + if (has_live_key(tb,b1,key,hval)) { + HashDbTerm* b2 = b1->next; + Eterm copy; + + if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { + while(b2 != NULL && has_key(tb,b2,key,hval)) + b2 = b2->next; + } + copy = put_term_list(p, b1, b2); + CHECK_TABLES(); + *ret = copy; + goto done; + } + b1 = b1->next; + } + *ret = NIL; +done: + RUNLOCK_HASH(lck); + return DB_ERROR_NONE; +} + +int db_get_element_array(DbTable *tbl, + Eterm key, + int ndex, + Eterm *ret, + int *num_ret) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + int ix; + HashDbTerm* b1; + int num = 0; + int retval; + erts_smp_rwmtx_t* lck; + + ASSERT(!IS_FIXED(tbl)); /* no support for fixed tables here */ + + hval = MAKE_HASH(key); + lck = RLOCK_HASH(tb, hval); + ix = hash_to_ix(tb, hval); + b1 = BUCKET(tb, ix); + + while(b1 != 0) { + if (has_live_key(tb,b1,key,hval)) { + if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { + HashDbTerm* b; + HashDbTerm* b2 = b1->next; + + while(b2 != NULL && has_live_key(tb,b2,key,hval)) { + if (ndex > arityval(b2->dbterm.tpl[0])) { + retval = DB_ERROR_BADITEM; + goto done; + } + b2 = b2->next; + } + + b = b1; + while(b != b2) { + if (num < *num_ret) { + ret[num++] = b->dbterm.tpl[ndex]; + } else { + retval = DB_ERROR_NONE; + goto done; + } + b = b->next; + } + *num_ret = num; + } + else { + ASSERT(*num_ret > 0); + ret[0] = b1->dbterm.tpl[ndex]; + *num_ret = 1; + } + retval = DB_ERROR_NONE; + goto done; + } + b1 = b1->next; + } + retval = DB_ERROR_BADKEY; +done: + RUNLOCK_HASH(lck); + return retval; +} + + +static int db_member_hash(DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + int ix; + HashDbTerm* b1; + erts_smp_rwmtx_t* lck; + + hval = MAKE_HASH(key); + ix = hash_to_ix(tb, hval); + lck = RLOCK_HASH(tb, hval); + b1 = BUCKET(tb, ix); + + while(b1 != 0) { + if (has_live_key(tb,b1,key,hval)) { + *ret = am_true; + goto done; + } + b1 = b1->next; + } + *ret = am_false; +done: + RUNLOCK_HASH(lck); + return DB_ERROR_NONE; +} + +static int db_get_element_hash(Process *p, DbTable *tbl, + Eterm key, + int ndex, + Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + int ix; + HashDbTerm* b1; + erts_smp_rwmtx_t* lck; + int retval; + + hval = MAKE_HASH(key); + lck = RLOCK_HASH(tb, hval); + ix = hash_to_ix(tb, hval); + b1 = BUCKET(tb, ix); + + + while(b1 != 0) { + if (has_live_key(tb,b1,key,hval)) { + Eterm copy; + + if (ndex > arityval(b1->dbterm.tpl[0])) { + retval = DB_ERROR_BADITEM; + goto done; + } + + if (tb->common.status & (DB_BAG | DB_DUPLICATE_BAG)) { + HashDbTerm* b; + HashDbTerm* b2 = b1->next; + Eterm elem_list = NIL; + + while(b2 != NULL && has_key(tb,b2,key,hval)) { + if (ndex > arityval(b2->dbterm.tpl[0]) + && b2->hvalue != INVALID_HASH) { + retval = DB_ERROR_BADITEM; + goto done; + } + b2 = b2->next; + } + + b = b1; + while(b != b2) { + if (b->hvalue != INVALID_HASH) { + Eterm *hp; + Uint sz = size_object(b->dbterm.tpl[ndex])+2; + + hp = HAlloc(p, sz); + copy = copy_struct(b->dbterm.tpl[ndex], sz-2, &hp, &MSO(p)); + elem_list = CONS(hp, copy, elem_list); + hp += 2; + } + b = b->next; + } + *ret = elem_list; + } + else { + COPY_OBJECT(b1->dbterm.tpl[ndex], p, ©); + *ret = copy; + } + retval = DB_ERROR_NONE; + goto done; + } + b1 = b1->next; + } + retval = DB_ERROR_BADKEY; +done: + RUNLOCK_HASH(lck); + return retval; +} + +/* + * Very internal interface, removes elements of arity two from + * BAG. Used for the PID meta table + */ +int db_erase_bag_exact2(DbTable *tbl, Eterm key, Eterm value) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + int ix; + HashDbTerm** bp; + HashDbTerm* b; + erts_smp_rwmtx_t* lck; + int found = 0; + + hval = MAKE_HASH(key); + lck = WLOCK_HASH(tb,hval); + ix = hash_to_ix(tb, hval); + bp = &BUCKET(tb, ix); + b = *bp; + + ASSERT(!IS_FIXED(tb)); + ASSERT((tb->common.status & DB_BAG)); + + while(b != 0) { + if (has_live_key(tb,b,key,hval)) { + found = 1; + if ((arityval(b->dbterm.tpl[0]) == 2) && + EQ(value, b->dbterm.tpl[2])) { + *bp = b->next; + free_term(tb, b); + erts_smp_atomic_dec(&tb->common.nitems); + b = *bp; + break; + } + } else if (found) { + break; + } + bp = &b->next; + b = b->next; + } + WUNLOCK_HASH(lck); + if (found) { + try_shrink(tb); + } + return DB_ERROR_NONE; +} + +/* +** NB, this is for the db_erase/2 bif. +*/ +int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + int ix; + HashDbTerm** bp; + HashDbTerm* b; + erts_smp_rwmtx_t* lck; + int nitems_diff = 0; + + hval = MAKE_HASH(key); + lck = WLOCK_HASH(tb,hval); + ix = hash_to_ix(tb, hval); + bp = &BUCKET(tb, ix); + b = *bp; + + while(b != 0) { + if (has_live_key(tb,b,key,hval)) { + --nitems_diff; + if (nitems_diff == -1 && IS_FIXED(tb)) { + /* Pseudo remove (no need to keep several of same key) */ + add_fixed_deletion(tb, ix); + b->hvalue = INVALID_HASH; + } else { + *bp = b->next; + free_term(tb, b); + b = *bp; + continue; + } + } + else { + if (nitems_diff && b->hvalue != INVALID_HASH) + break; + } + bp = &b->next; + b = b->next; + } + WUNLOCK_HASH(lck); + if (nitems_diff) { + erts_smp_atomic_add(&tb->common.nitems, nitems_diff); + try_shrink(tb); + } + *ret = am_true; + return DB_ERROR_NONE; +} + +/* +** This is for the ets:delete_object BIF +*/ +static int db_erase_object_hash(DbTable *tbl, Eterm object, Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + HashValue hval; + int ix; + HashDbTerm** bp; + HashDbTerm* b; + erts_smp_rwmtx_t* lck; + int nitems_diff = 0; + int nkeys = 0; + Eterm key; + + key = GETKEY(tb, tuple_val(object)); + hval = MAKE_HASH(key); + lck = WLOCK_HASH(tb,hval); + ix = hash_to_ix(tb, hval); + bp = &BUCKET(tb, ix); + b = *bp; + + while(b != 0) { + if (has_live_key(tb,b,key,hval)) { + ++nkeys; + if (eq(object, make_tuple(b->dbterm.tpl))) { + --nitems_diff; + if (nkeys==1 && IS_FIXED(tb)) { /* Pseudo remove */ + add_fixed_deletion(tb,ix); + b->hvalue = INVALID_HASH; + bp = &b->next; + b = b->next; + } else { + *bp = b->next; + free_term(tb, b); + b = *bp; + } + if (tb->common.status & (DB_DUPLICATE_BAG)) { + continue; + } else { + break; + } + } + } + else if (nitems_diff && b->hvalue != INVALID_HASH) { + break; + } + bp = &b->next; + b = b->next; + } + WUNLOCK_HASH(lck); + if (nitems_diff) { + erts_smp_atomic_add(&tb->common.nitems, nitems_diff); + try_shrink(tb); + } + *ret = am_true; + return DB_ERROR_NONE; +} + + +static int db_slot_hash(Process *p, DbTable *tbl, Eterm slot_term, Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + erts_smp_rwmtx_t* lck; + Sint slot; + int retval; + int nactive; + + if (is_not_small(slot_term) || ((slot = signed_val(slot_term)) < 0)) { + return DB_ERROR_BADPARAM; + } + lck = RLOCK_HASH(tb, slot); + nactive = NACTIVE(tb); + if (slot < nactive) { + *ret = put_term_list(p, BUCKET(tb, slot), 0); + retval = DB_ERROR_NONE; + } + else if (slot == nactive) { + *ret = am_EOT; + retval = DB_ERROR_NONE; + } + else { + retval = DB_ERROR_BADPARAM; + } + RUNLOCK_HASH(lck); + return retval; +} + + +/* + * This is just here so I can take care of the return value + * that is to be sent during a trap (the BIF_TRAP macros explicitly returns) + */ +static BIF_RETTYPE bif_trap1(Export *bif, + Process *p, + Eterm p1) +{ + BIF_TRAP1(bif, p, p1); +} + +/* + * Continue collecting select matches, this may happen either due to a trap + * or when the user calls ets:select/1 + */ +static int db_select_continue_hash(Process *p, + DbTable *tbl, + Eterm continuation, + Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + Sint slot_ix; + Sint save_slot_ix; + Sint chunk_size; + int all_objects; + Binary *mp; + int num_left = 1000; + HashDbTerm *current = 0; + Eterm match_list; + Uint32 dummy; + unsigned sz; + Eterm *hp; + Eterm match_res; + Sint got; + Eterm *tptr; + erts_smp_rwmtx_t* lck; + +#define RET_TO_BIF(Term, State) do { *ret = (Term); return State; } while(0); + + /* Decode continuation. We know it's a tuple but not the arity or anything else */ + + tptr = tuple_val(continuation); + + if (arityval(*tptr) != 6) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + + if (!is_small(tptr[2]) || !is_small(tptr[3]) || !is_binary(tptr[4]) || + !(is_list(tptr[5]) || tptr[5] == NIL) || !is_small(tptr[6])) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + if ((chunk_size = signed_val(tptr[3])) < 0) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + if (!(thing_subtag(*binary_val(tptr[4])) == REFC_BINARY_SUBTAG)) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + mp = ((ProcBin *) binary_val(tptr[4]))->val; + if (!IsMatchProgBinary(mp)) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + all_objects = mp->flags & BIN_FLAG_ALL_OBJECTS; + match_list = tptr[5]; + if ((got = signed_val(tptr[6])) < 0) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + + slot_ix = signed_val(tptr[2]); + if (slot_ix < 0 /* EOT */ + || (chunk_size && got >= chunk_size)) { + goto done; /* Already got all or enough in the match_list */ + } + + lck = RLOCK_HASH(tb,slot_ix); + if (slot_ix >= NACTIVE(tb)) { + RUNLOCK_HASH(lck); + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + } + + while ((current = BUCKET(tb,slot_ix)) == NULL) { + slot_ix = next_slot(tb, slot_ix, &lck); + if (slot_ix == 0) { + slot_ix = -1; /* EOT */ + goto done; + } + } + for(;;) { + if (current->hvalue != INVALID_HASH && + (match_res = + db_prog_match(p,mp, + make_tuple(current->dbterm.tpl), + 0,&dummy), + is_value(match_res))) { + if (all_objects) { + hp = HAlloc(p, current->dbterm.size + 2); + match_res = copy_shallow(DBTERM_BUF(¤t->dbterm), + current->dbterm.size, + &hp, + &MSO(p)); + } else { + sz = size_object(match_res); + + hp = HAlloc(p, sz + 2); + match_res = copy_struct(match_res, sz, &hp, &MSO(p)); + } + match_list = CONS(hp, match_res, match_list); + ++got; + } + --num_left; + save_slot_ix = slot_ix; + if ((current = next(tb, (Uint*)&slot_ix, &lck, current)) == NULL) { + slot_ix = -1; /* EOT */ + break; + } + if (slot_ix != save_slot_ix) { + if (chunk_size && got >= chunk_size) { + RUNLOCK_HASH(lck); + break; + } + if (num_left <= 0 || MBUF(p)) { + /* + * We have either reached our limit, or just created some heap fragments. + * Since many heap fragments will make the GC slower, trap and GC now. + */ + RUNLOCK_HASH(lck); + goto trap; + } + } + } +done: + BUMP_REDS(p, 1000 - num_left); + if (chunk_size) { + Eterm continuation; + Eterm rest = NIL; + Sint rest_size = 0; + + if (got > chunk_size) { /* Cannot write destructively here, + the list may have + been in user space */ + rest = NIL; + hp = HAlloc(p, (got - chunk_size) * 2); + while (got-- > chunk_size) { + rest = CONS(hp, CAR(list_val(match_list)), rest); + hp += 2; + match_list = CDR(list_val(match_list)); + ++rest_size; + } + } + if (rest != NIL || slot_ix >= 0) { + hp = HAlloc(p,3+7); + continuation = TUPLE6(hp, tptr[1], make_small(slot_ix), + tptr[3], tptr[4], rest, + make_small(rest_size)); + hp += 7; + RET_TO_BIF(TUPLE2(hp, match_list, continuation),DB_ERROR_NONE); + } else { + if (match_list != NIL) { + hp = HAlloc(p, 3); + RET_TO_BIF(TUPLE2(hp, match_list, am_EOT),DB_ERROR_NONE); + } else { + RET_TO_BIF(am_EOT, DB_ERROR_NONE); + } + } + } + RET_TO_BIF(match_list,DB_ERROR_NONE); + +trap: + BUMP_ALL_REDS(p); + + hp = HAlloc(p,7); + continuation = TUPLE6(hp, tptr[1], make_small(slot_ix), tptr[3], + tptr[4], match_list, make_small(got)); + RET_TO_BIF(bif_trap1(&ets_select_continue_exp, p, + continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF + +} + +static int db_select_hash(Process *p, DbTable *tbl, + Eterm pattern, int reverse, + Eterm *ret) +{ + return db_select_chunk_hash(p, tbl, pattern, 0, reverse, ret); +} + +static int db_select_chunk_hash(Process *p, DbTable *tbl, + Eterm pattern, Sint chunk_size, + int reverse, /* not used */ + Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + struct mp_info mpi; + Sint slot_ix; + HashDbTerm *current = 0; + unsigned current_list_pos = 0; + Eterm match_list; + Uint32 dummy; + Eterm match_res; + unsigned sz; + Eterm *hp; + int num_left = 1000; + Uint got = 0; + Eterm continuation; + int errcode; + Eterm mpb; + erts_smp_rwmtx_t* lck; + + +#define RET_TO_BIF(Term,RetVal) do { \ + if (mpi.mp != NULL) { \ + erts_bin_free(mpi.mp); \ + } \ + if (mpi.lists != mpi.dlists) { \ + erts_free(ERTS_ALC_T_DB_SEL_LIST, \ + (void *) mpi.lists); \ + } \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + + if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + RET_TO_BIF(NIL,errcode); + } + + if (!mpi.something_can_match) { + if (chunk_size) { + RET_TO_BIF(am_EOT, DB_ERROR_NONE); /* We're done */ + } + RET_TO_BIF(NIL, DB_ERROR_NONE); + /* can't possibly match anything */ + } + + if (!mpi.key_given) { + /* Run this code if pattern is variable or GETKEY(pattern) */ + /* is a variable */ + slot_ix = 0; + lck = RLOCK_HASH(tb,slot_ix); + for (;;) { + ASSERT(slot_ix < NACTIVE(tb)); + if ((current = BUCKET(tb,slot_ix)) != NULL) { + break; + } + slot_ix = next_slot(tb,slot_ix,&lck); + if (slot_ix == 0) { + if (chunk_size) { + RET_TO_BIF(am_EOT, DB_ERROR_NONE); /* We're done */ + } + RET_TO_BIF(NIL,DB_ERROR_NONE); + } + } + } else { + /* We have at least one */ + slot_ix = mpi.lists[current_list_pos].ix; + lck = RLOCK_HASH(tb, slot_ix); + current = *(mpi.lists[current_list_pos].bucket); + ASSERT(current == BUCKET(tb,slot_ix)); + ++current_list_pos; + } + + match_list = NIL; + + for(;;) { + if (current != NULL) { + if (current->hvalue != INVALID_HASH) { + match_res = db_prog_match(p,mpi.mp, + make_tuple(current->dbterm.tpl), + 0,&dummy); + if (is_value(match_res)) { + if (mpi.all_objects) { + hp = HAlloc(p, current->dbterm.size + 2); + match_res = copy_shallow(DBTERM_BUF(¤t->dbterm), + current->dbterm.size, + &hp, + &MSO(p)); + } else { + sz = size_object(match_res); + + hp = HAlloc(p, sz + 2); + match_res = copy_struct(match_res, sz, &hp, &MSO(p)); + } + match_list = CONS(hp, match_res, match_list); + ++got; + } + } + current = current->next; + } + else if (mpi.key_given) { /* Key is bound */ + RUNLOCK_HASH(lck); + if (current_list_pos == mpi.num_lists) { + slot_ix = -1; /* EOT */ + goto done; + } else { + slot_ix = mpi.lists[current_list_pos].ix; + lck = RLOCK_HASH(tb, slot_ix); + current = *(mpi.lists[current_list_pos].bucket); + ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix)); + ++current_list_pos; + } + } + else { /* Key is variable */ + --num_left; + + if ((slot_ix=next_slot(tb,slot_ix,&lck)) == 0) { + slot_ix = -1; + break; + } + if (chunk_size && got >= chunk_size) { + RUNLOCK_HASH(lck); + break; + } + if (num_left <= 0 || MBUF(p)) { + /* + * We have either reached our limit, or just created some heap fragments. + * Since many heap fragments will make the GC slower, trap and GC now. + */ + RUNLOCK_HASH(lck); + goto trap; + } + current = BUCKET(tb,slot_ix); + } + } +done: + BUMP_REDS(p, 1000 - num_left); + if (chunk_size) { + Eterm continuation; + Eterm rest = NIL; + Sint rest_size = 0; + + if (mpi.all_objects) + (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; + if (got > chunk_size) { /* Split list in return value and 'rest' */ + Eterm tmp = match_list; + rest = match_list; + while (got-- > chunk_size + 1) { + tmp = CDR(list_val(tmp)); + ++rest_size; + } + ++rest_size; + match_list = CDR(list_val(tmp)); + CDR(list_val(tmp)) = NIL; /* Destructive, the list has never + been in 'user space' */ + } + if (rest != NIL || slot_ix >= 0) { /* Need more calls */ + hp = HAlloc(p,3+7+PROC_BIN_SIZE); + mpb =db_make_mp_binary(p,(mpi.mp),&hp); + if (mpi.all_objects) + (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; + continuation = TUPLE6(hp, tb->common.id,make_small(slot_ix), + make_small(chunk_size), + mpb, rest, + make_small(rest_size)); + mpi.mp = NULL; /*otherwise the return macro will destroy it */ + hp += 7; + RET_TO_BIF(TUPLE2(hp, match_list, continuation),DB_ERROR_NONE); + } else { /* All data is exhausted */ + if (match_list != NIL) { /* No more data to search but still a + result to return to the caller */ + hp = HAlloc(p, 3); + RET_TO_BIF(TUPLE2(hp, match_list, am_EOT),DB_ERROR_NONE); + } else { /* Reached the end of the ttable with no data to return */ + RET_TO_BIF(am_EOT, DB_ERROR_NONE); + } + } + } + RET_TO_BIF(match_list,DB_ERROR_NONE); +trap: + BUMP_ALL_REDS(p); + if (mpi.all_objects) + (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; + hp = HAlloc(p,7+PROC_BIN_SIZE); + mpb =db_make_mp_binary(p,(mpi.mp),&hp); + continuation = TUPLE6(hp, tb->common.id, make_small(slot_ix), + make_small(chunk_size), + mpb, match_list, + make_small(got)); + mpi.mp = NULL; /*otherwise the return macro will destroy it */ + RET_TO_BIF(bif_trap1(&ets_select_continue_exp, p, + continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF + +} + +static int db_select_count_hash(Process *p, + DbTable *tbl, + Eterm pattern, + Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + struct mp_info mpi; + Uint slot_ix = 0; + HashDbTerm* current = NULL; + unsigned current_list_pos = 0; + Uint32 dummy; + Eterm *hp; + int num_left = 1000; + Uint got = 0; + Eterm continuation; + int errcode; + Eterm egot; + Eterm mpb; + erts_smp_rwmtx_t* lck; + +#define RET_TO_BIF(Term,RetVal) do { \ + if (mpi.mp != NULL) { \ + erts_bin_free(mpi.mp); \ + } \ + if (mpi.lists != mpi.dlists) { \ + erts_free(ERTS_ALC_T_DB_SEL_LIST, \ + (void *) mpi.lists); \ + } \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + + if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + RET_TO_BIF(NIL,errcode); + } + + if (!mpi.something_can_match) { + RET_TO_BIF(make_small(0), DB_ERROR_NONE); + /* can't possibly match anything */ + } + + if (!mpi.key_given) { + /* Run this code if pattern is variable or GETKEY(pattern) */ + /* is a variable */ + slot_ix = 0; + lck = RLOCK_HASH(tb,slot_ix); + current = BUCKET(tb,slot_ix); + } else { + /* We have at least one */ + slot_ix = mpi.lists[current_list_pos].ix; + lck = RLOCK_HASH(tb, slot_ix); + current = *(mpi.lists[current_list_pos].bucket); + ASSERT(current == BUCKET(tb,slot_ix)); + ++current_list_pos; + } + + for(;;) { + if (current != NULL) { + if (current->hvalue != INVALID_HASH) { + if (db_prog_match(p, mpi.mp, make_tuple(current->dbterm.tpl), + 0, &dummy) == am_true) { + ++got; + } + --num_left; + } + current = current->next; + } + else { /* next bucket */ + if (mpi.key_given) { /* Key is bound */ + RUNLOCK_HASH(lck); + if (current_list_pos == mpi.num_lists) { + goto done; + } else { + slot_ix = mpi.lists[current_list_pos].ix; + lck = RLOCK_HASH(tb, slot_ix); + current = *(mpi.lists[current_list_pos].bucket); + ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix)); + ++current_list_pos; + } + } + else { + if ((slot_ix=next_slot(tb,slot_ix,&lck)) == 0) { + goto done; + } + if (num_left <= 0) { + RUNLOCK_HASH(lck); + goto trap; + } + current = BUCKET(tb,slot_ix); + } + } + } +done: + BUMP_REDS(p, 1000 - num_left); + RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE); +trap: + BUMP_ALL_REDS(p); + if (IS_USMALL(0, got)) { + hp = HAlloc(p, PROC_BIN_SIZE + 5); + egot = make_small(got); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + PROC_BIN_SIZE + 5); + egot = uint_to_big(got, hp); + hp += BIG_UINT_HEAP_SIZE; + } + mpb = db_make_mp_binary(p,mpi.mp,&hp); + continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix), + mpb, + egot); + mpi.mp = NULL; /*otherwise the return macro will destroy it */ + RET_TO_BIF(bif_trap1(&ets_select_count_continue_exp, p, + continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF +} + +static int db_select_delete_hash(Process *p, + DbTable *tbl, + Eterm pattern, + Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + struct mp_info mpi; + Uint slot_ix = 0; + HashDbTerm **current = NULL; + unsigned current_list_pos = 0; + Uint32 dummy; + Eterm *hp; + int num_left = 1000; + Uint got = 0; + Eterm continuation; + int errcode; + Uint last_pseudo_delete = (Uint)-1; + Eterm mpb; + Eterm egot; +#ifdef ERTS_SMP + int fixated_by_me = tb->common.is_thread_safe ? 0 : 1; /* ToDo: something nicer */ +#else + int fixated_by_me = 0; +#endif + erts_smp_rwmtx_t* lck; + +#define RET_TO_BIF(Term,RetVal) do { \ + if (mpi.mp != NULL) { \ + erts_bin_free(mpi.mp); \ + } \ + if (mpi.lists != mpi.dlists) { \ + erts_free(ERTS_ALC_T_DB_SEL_LIST, \ + (void *) mpi.lists); \ + } \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + + if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + RET_TO_BIF(NIL,errcode); + } + + if (!mpi.something_can_match) { + RET_TO_BIF(make_small(0), DB_ERROR_NONE); + /* can't possibly match anything */ + } + + if (!mpi.key_given) { + /* Run this code if pattern is variable or GETKEY(pattern) */ + /* is a variable */ + lck = WLOCK_HASH(tb,slot_ix); + current = &BUCKET(tb,slot_ix); + } else { + /* We have at least one */ + slot_ix = mpi.lists[current_list_pos].ix; + lck = WLOCK_HASH(tb, slot_ix); + current = mpi.lists[current_list_pos++].bucket; + ASSERT(*current == BUCKET(tb,slot_ix)); + } + + + for(;;) { + if ((*current) == NULL) { + if (mpi.key_given) { /* Key is bound */ + WUNLOCK_HASH(lck); + if (current_list_pos == mpi.num_lists) { + goto done; + } else { + slot_ix = mpi.lists[current_list_pos].ix; + lck = WLOCK_HASH(tb, slot_ix); + current = mpi.lists[current_list_pos].bucket; + ASSERT(mpi.lists[current_list_pos].bucket == &BUCKET(tb,slot_ix)); + ++current_list_pos; + } + } else { + if ((slot_ix=next_slot_w(tb,slot_ix,&lck)) == 0) { + goto done; + } + if (num_left <= 0) { + WUNLOCK_HASH(lck); + goto trap; + } + current = &BUCKET(tb,slot_ix); + } + } + else if ((*current)->hvalue == INVALID_HASH) { + current = &((*current)->next); + } + else { + int did_erase = 0; + if ((db_prog_match(p,mpi.mp, + make_tuple((*current)->dbterm.tpl), + 0,&dummy)) == am_true) { + if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ + if (slot_ix != last_pseudo_delete) { + add_fixed_deletion(tb, slot_ix); + last_pseudo_delete = slot_ix; + } + (*current)->hvalue = INVALID_HASH; + } else { + HashDbTerm *del = *current; + *current = (*current)->next; + free_term(tb, del); + did_erase = 1; + } + erts_smp_atomic_dec(&tb->common.nitems); + ++got; + } + --num_left; + if (!did_erase) { + current = &((*current)->next); + } + } + } +done: + BUMP_REDS(p, 1000 - num_left); + if (got) { + try_shrink(tb); + } + RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE); +trap: + BUMP_ALL_REDS(p); + if (IS_USMALL(0, got)) { + hp = HAlloc(p, PROC_BIN_SIZE + 5); + egot = make_small(got); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + PROC_BIN_SIZE + 5); + egot = uint_to_big(got, hp); + hp += BIG_UINT_HEAP_SIZE; + } + mpb = db_make_mp_binary(p,mpi.mp,&hp); + continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix), + mpb, + egot); + mpi.mp = NULL; /*otherwise the return macro will destroy it */ + RET_TO_BIF(bif_trap1(&ets_select_delete_continue_exp, p, + continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF + +} +/* +** This is called when select_delete traps +*/ +static int db_select_delete_continue_hash(Process *p, + DbTable *tbl, + Eterm continuation, + Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + Uint slot_ix; + Uint last_pseudo_delete = (Uint)-1; + HashDbTerm **current = NULL; + Uint32 dummy; + Eterm *hp; + int num_left = 1000; + Uint got; + Eterm *tptr; + Binary *mp; + Eterm egot; + int fixated_by_me = ONLY_WRITER(p,tb) ? 0 : 1; /* ToDo: something nicer */ + erts_smp_rwmtx_t* lck; + +#define RET_TO_BIF(Term,RetVal) do { \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + + tptr = tuple_val(continuation); + slot_ix = unsigned_val(tptr[2]); + mp = ((ProcBin *) binary_val(tptr[3]))->val; + if (is_big(tptr[4])) { + got = big_to_uint32(tptr[4]); + } else { + got = unsigned_val(tptr[4]); + } + + lck = WLOCK_HASH(tb,slot_ix); + if (slot_ix >= NACTIVE(tb)) { + WUNLOCK_HASH(lck); + goto done; + } + current = &BUCKET(tb,slot_ix); + + for(;;) { + if ((*current) == NULL) { + if ((slot_ix=next_slot_w(tb,slot_ix,&lck)) == 0) { + goto done; + } + if (num_left <= 0) { + WUNLOCK_HASH(lck); + goto trap; + } + current = &BUCKET(tb,slot_ix); + } + else if ((*current)->hvalue == INVALID_HASH) { + current = &((*current)->next); + } + else { + int did_erase = 0; + if ((db_prog_match(p,mp,make_tuple((*current)->dbterm.tpl), + 0,&dummy)) == am_true) { + if (NFIXED(tb) > fixated_by_me) { /* fixated by others? */ + if (slot_ix != last_pseudo_delete) { + add_fixed_deletion(tb, slot_ix); + last_pseudo_delete = slot_ix; + } + (*current)->hvalue = INVALID_HASH; + } else { + HashDbTerm *del = *current; + *current = (*current)->next; + free_term(tb, del); + did_erase = 1; + } + erts_smp_atomic_dec(&tb->common.nitems); + ++got; + } + + --num_left; + if (!did_erase) { + current = &((*current)->next); + } + } + } +done: + BUMP_REDS(p, 1000 - num_left); + if (got) { + try_shrink(tb); + } + RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE); +trap: + BUMP_ALL_REDS(p); + if (IS_USMALL(0, got)) { + hp = HAlloc(p, 5); + egot = make_small(got); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + 5); + egot = uint_to_big(got, hp); + hp += BIG_UINT_HEAP_SIZE; + } + continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix), + tptr[3], + egot); + RET_TO_BIF(bif_trap1(&ets_select_delete_continue_exp, p, + continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF + +} + +/* +** This is called when select_count traps +*/ +static int db_select_count_continue_hash(Process *p, + DbTable *tbl, + Eterm continuation, + Eterm *ret) +{ + DbTableHash *tb = &tbl->hash; + Uint slot_ix; + HashDbTerm* current; + Uint32 dummy; + Eterm *hp; + int num_left = 1000; + Uint got; + Eterm *tptr; + Binary *mp; + Eterm egot; + erts_smp_rwmtx_t* lck; + +#define RET_TO_BIF(Term,RetVal) do { \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + + tptr = tuple_val(continuation); + slot_ix = unsigned_val(tptr[2]); + mp = ((ProcBin *) binary_val(tptr[3]))->val; + if (is_big(tptr[4])) { + got = big_to_uint32(tptr[4]); + } else { + got = unsigned_val(tptr[4]); + } + + + lck = RLOCK_HASH(tb, slot_ix); + if (slot_ix >= NACTIVE(tb)) { /* Is this posible? */ + RUNLOCK_HASH(lck); + goto done; + } + current = BUCKET(tb,slot_ix); + + for(;;) { + if (current != NULL) { + if (current->hvalue == INVALID_HASH) { + current = current->next; + continue; + } + if (db_prog_match(p, mp, make_tuple(current->dbterm.tpl), + 0,&dummy) == am_true) { + ++got; + } + --num_left; + current = current->next; + } + else { /* next bucket */ + if ((slot_ix = next_slot(tb,slot_ix,&lck)) == 0) { + goto done; + } + if (num_left <= 0) { + RUNLOCK_HASH(lck); + goto trap; + } + current = BUCKET(tb,slot_ix); + } + } +done: + BUMP_REDS(p, 1000 - num_left); + RET_TO_BIF(erts_make_integer(got,p),DB_ERROR_NONE); +trap: + BUMP_ALL_REDS(p); + if (IS_USMALL(0, got)) { + hp = HAlloc(p, 5); + egot = make_small(got); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + 5); + egot = uint_to_big(got, hp); + hp += BIG_UINT_HEAP_SIZE; + } + continuation = TUPLE4(hp, tb->common.id, make_small(slot_ix), + tptr[3], + egot); + RET_TO_BIF(bif_trap1(&ets_select_count_continue_exp, p, + continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF + +} + +/* +** Other interface routines (not directly coupled to one bif) +*/ + +void db_initialize_hash(void) +{ +} + + +int db_mark_all_deleted_hash(DbTable *tbl) +{ + DbTableHash *tb = &tbl->hash; + HashDbTerm* list; + int i; + + ERTS_SMP_LC_ASSERT(IS_TAB_WLOCKED(tb)); + + for (i = 0; i < NACTIVE(tb); i++) { + if ((list = BUCKET(tb,i)) != NULL) { + add_fixed_deletion(tb, i); + do { + list->hvalue = INVALID_HASH; + list = list->next; + }while(list != NULL); + } + } + erts_smp_atomic_set(&tb->common.nitems, 0); + return DB_ERROR_NONE; +} + + +/* Display hash table contents (for dump) */ +static void db_print_hash(int to, void *to_arg, int show, DbTable *tbl) +{ + DbTableHash *tb = &tbl->hash; + int i; + + erts_print(to, to_arg, "Buckets: %d \n", NACTIVE(tb)); + + if (show) { + for (i = 0; i < NACTIVE(tb); i++) { + HashDbTerm* list = BUCKET(tb,i); + if (list == NULL) + continue; + erts_print(to, to_arg, "%d: [", i); + while(list != 0) { + if (list->hvalue == INVALID_HASH) + erts_print(to, to_arg, "*"); + erts_print(to, to_arg, "%T", make_tuple(list->dbterm.tpl)); + if (list->next != 0) + erts_print(to, to_arg, ","); + list = list->next; + } + erts_print(to, to_arg, "]\n"); + } + } +} + +/* release all memory occupied by a single table */ +static int db_free_table_hash(DbTable *tbl) +{ + while (!db_free_table_continue_hash(tbl)) + ; + return 0; +} + +static int db_free_table_continue_hash(DbTable *tbl) +{ + DbTableHash *tb = &tbl->hash; + int done; + FixedDeletion* fixdel = (FixedDeletion*) erts_smp_atomic_read(&tb->fixdel); + ERTS_SMP_LC_ASSERT(IS_TAB_WLOCKED(tb)); + + done = 0; + while (fixdel != NULL) { + FixedDeletion *fx = fixdel; + + fixdel = fx->next; + erts_db_free(ERTS_ALC_T_DB_FIX_DEL, + (DbTable *) tb, + (void *) fx, + sizeof(FixedDeletion)); + ERTS_ETS_MISC_MEM_ADD(-sizeof(FixedDeletion)); + if (++done >= 2*DELETE_RECORD_LIMIT) { + erts_smp_atomic_set(&tb->fixdel, (long)fixdel); + return 0; /* Not done */ + } + } + erts_smp_atomic_set(&tb->fixdel, (long)NULL); + + done /= 2; + while(tb->nslots != 0) { + free_seg(tb, 1); + + /* + * If we have done enough work, get out here. + */ + if (++done >= (DELETE_RECORD_LIMIT / CHAIN_LEN / SEGSZ)) { + return 0; /* Not done */ + } + } +#ifdef ERTS_SMP + if (tb->locks != NULL) { + int i; + for (i=0; ilocks, sizeof(DbTableHashFineLocks)); + tb->locks = NULL; + } +#endif + ASSERT(erts_smp_atomic_read(&tb->common.memory_size) == sizeof(DbTable)); + return 1; /* Done */ +} + + + +/* +** Utility routines. (static) +*/ +/* +** For the select functions, analyzes the pattern and determines which +** slots should be searched. Also compiles the match program +*/ +static int analyze_pattern(DbTableHash *tb, Eterm pattern, + struct mp_info *mpi) +{ + Eterm *ptpl; + Eterm lst, tpl, ttpl; + Eterm *matches,*guards, *bodies; + Eterm sbuff[30]; + Eterm *buff = sbuff; + Eterm key = NIL; + HashValue hval = NIL; + int num_heads = 0; + int i; + + mpi->lists = mpi->dlists; + mpi->num_lists = 0; + mpi->key_given = 1; + mpi->something_can_match = 0; + mpi->all_objects = 1; + mpi->mp = NULL; + + for (lst = pattern; is_list(lst); lst = CDR(list_val(lst))) + ++num_heads; + + if (lst != NIL) {/* proper list... */ + return DB_ERROR_BADPARAM; + } + + if (num_heads > 10) { + buff = erts_alloc(ERTS_ALC_T_DB_TMP, sizeof(Eterm) * num_heads * 3); + mpi->lists = erts_alloc(ERTS_ALC_T_DB_SEL_LIST, + sizeof(*(mpi->lists)) * num_heads); + } + + matches = buff; + guards = buff + num_heads; + bodies = buff + (num_heads * 2); + + i = 0; + for(lst = pattern; is_list(lst); lst = CDR(list_val(lst))) { + Eterm body; + ttpl = CAR(list_val(lst)); + if (!is_tuple(ttpl)) { + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_BADPARAM; + } + ptpl = tuple_val(ttpl); + if (ptpl[0] != make_arityval(3U)) { + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_BADPARAM; + } + matches[i] = tpl = ptpl[1]; + guards[i] = ptpl[2]; + bodies[i] = body = ptpl[3]; + if (!is_list(body) || CDR(list_val(body)) != NIL || + CAR(list_val(body)) != am_DollarUnderscore) { + mpi->all_objects = 0; + } + ++i; + if (!(mpi->key_given)) { + continue; + } + if (tpl == am_Underscore || db_is_variable(tpl) != -1) { + (mpi->key_given) = 0; + (mpi->something_can_match) = 1; + } else { + key = db_getkey(tb->common.keypos, tpl); + if (is_value(key)) { + if (!db_has_variable(key)) { /* Bound key */ + int ix, search_slot; + HashDbTerm** bp; + erts_smp_rwmtx_t* lck; + hval = MAKE_HASH(key); + lck = RLOCK_HASH(tb,hval); + ix = hash_to_ix(tb, hval); + bp = &BUCKET(tb,ix); + if (lck == NULL) { + search_slot = search_list(tb,key,hval,*bp) != NULL; + } else { + /* No point to verify if key exist now as there may be + concurrent inserters/deleters anyway */ + RUNLOCK_HASH(lck); + search_slot = 1; + } + if (search_slot) { + int j; + for (j=0; ; ++j) { + if (j == mpi->num_lists) { + mpi->lists[mpi->num_lists].bucket = bp; + mpi->lists[mpi->num_lists].ix = ix; + ++mpi->num_lists; + break; + } + if (mpi->lists[j].bucket == bp) { + ASSERT(mpi->lists[j].ix == ix); + break; + } + ASSERT(mpi->lists[j].ix != ix); + } + mpi->something_can_match = 1; + } + } else { + mpi->key_given = 0; + mpi->something_can_match = 1; + } + } + } + } + + /* + * It would be nice not to compile the match_spec if nothing could match, + * but then the select calls would not fail like they should on bad + * match specs that happen to specify non existent keys etc. + */ + if ((mpi->mp = db_match_compile(matches, guards, bodies, + num_heads, DCOMP_TABLE, NULL)) + == NULL) { + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_BADPARAM; + } + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_NONE; +} + +static struct ext_segment* alloc_ext_seg(DbTableHash* tb, unsigned seg_ix, + struct segment** old_segtab) +{ + int nsegs; + struct ext_segment* eseg; + + switch (seg_ix) { + case 0: nsegs = NSEG_1; break; + case 1: nsegs = NSEG_2; break; + default: nsegs = seg_ix + NSEG_INC; break; + } + eseg = (struct ext_segment*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, + (DbTable *) tb, + SIZEOF_EXTSEG(nsegs)); + ASSERT(eseg != NULL); + sys_memset(&eseg->s, 0, sizeof(struct segment)); + IF_DEBUG(eseg->s.is_ext_segment = 1); + eseg->prev_segtab = old_segtab; + eseg->nsegs = nsegs; + if (old_segtab) { + ASSERT(nsegs > tb->nsegs); + sys_memcpy(eseg->segtab, old_segtab, tb->nsegs*sizeof(struct segment*)); + } +#ifdef DEBUG + sys_memset(&eseg->segtab[seg_ix], 0, (nsegs-seg_ix)*sizeof(struct segment*)); +#endif + eseg->segtab[seg_ix] = &eseg->s; + return eseg; +} + +/* Extend table with one new segment +*/ +static int alloc_seg(DbTableHash *tb) +{ + int seg_ix = tb->nslots >> SEGSZ_EXP; + + if (seg_ix+1 == tb->nsegs) { /* New segtab needed (extended segment) */ + struct segment** segtab = SEGTAB(tb); + struct ext_segment* seg = alloc_ext_seg(tb, seg_ix, segtab); + if (seg == NULL) return 0; + segtab[seg_ix] = &seg->s; + /* We don't use the new segtab until next call (see "shrink race") */ + } + else { /* Just a new plain segment */ + struct segment** segtab; + if (seg_ix == tb->nsegs) { /* Time to start use segtab from last call */ + struct ext_segment* eseg; + eseg = (struct ext_segment*) SEGTAB(tb)[seg_ix-1]; + MY_ASSERT(eseg!=NULL && eseg->s.is_ext_segment); + erts_smp_atomic_set(&tb->segtab, (long) eseg->segtab); + tb->nsegs = eseg->nsegs; + } + ASSERT(seg_ix < tb->nsegs); + segtab = SEGTAB(tb); + ASSERT(segtab[seg_ix] == NULL); + segtab[seg_ix] = (struct segment*) erts_db_alloc_fnf(ERTS_ALC_T_DB_SEG, + (DbTable *) tb, + sizeof(struct segment)); + if (segtab[seg_ix] == NULL) return 0; + sys_memset(segtab[seg_ix], 0, sizeof(struct segment)); + } + tb->nslots += SEGSZ; + return 1; +} + +/* Shrink table by freeing the top segment +** free_records: 1=free any records in segment, 0=assume segment is empty +*/ +static int free_seg(DbTableHash *tb, int free_records) +{ + int seg_ix = (tb->nslots >> SEGSZ_EXP) - 1; + int bytes; + struct segment** segtab = SEGTAB(tb); + struct ext_segment* top = (struct ext_segment*) segtab[seg_ix]; + int nrecords = 0; + + ASSERT(top != NULL); +#ifndef DEBUG + if (free_records) +#endif + { + int i; + for (i=0; is.buckets[i]; + while(p != 0) { + HashDbTerm* nxt = p->next; + ASSERT(free_records); /* segment not empty as assumed? */ + free_term(tb, p); + p = nxt; + ++nrecords; + } + } + } + + /* The "shrink race": + * We must avoid deallocating an extended segment while its segtab may + * still be used by other threads. + * The trick is to stop use a segtab one call earlier. That is, stop use + * a segtab when the segment above it is deallocated. When the segtab is + * later deallocated, it has not been used for a very long time. + * It is even theoretically safe as we have by then rehashed the entire + * segment, seizing *all* locks, so there cannot exist any retarded threads + * still hanging in BUCKET macro with an old segtab pointer. + * For this to work, we must of course allocate a new segtab one call + * earlier in alloc_seg() as well. And this is also the reason why + * the minimum size of the first segtab is 2 and not 1 (NSEG_1). + */ + + if (seg_ix == tb->nsegs-1 || seg_ix==0) { /* Dealloc extended segment */ + MY_ASSERT(top->s.is_ext_segment); + ASSERT(segtab != top->segtab || seg_ix==0); + bytes = SIZEOF_EXTSEG(top->nsegs); + } + else { /* Dealloc plain segment */ + struct ext_segment* newtop = (struct ext_segment*) segtab[seg_ix-1]; + MY_ASSERT(!top->s.is_ext_segment); + + if (segtab == newtop->segtab) { /* New top segment is extended */ + MY_ASSERT(newtop->s.is_ext_segment); + if (newtop->prev_segtab != NULL) { + /* Time to use a smaller segtab */ + erts_smp_atomic_set(&tb->segtab, (long)newtop->prev_segtab); + tb->nsegs = seg_ix; + ASSERT(tb->nsegs == EXTSEG(SEGTAB(tb))->nsegs); + } + else { + ASSERT(NSEG_1 > 2 && seg_ix==1); + } + } + bytes = sizeof(struct segment); + } + + erts_db_free(ERTS_ALC_T_DB_SEG, (DbTable *)tb, + (void*)top, bytes); +#ifdef DEBUG + if (seg_ix > 0) { + if (seg_ix < tb->nsegs) SEGTAB(tb)[seg_ix] = NULL; + } else { + erts_smp_atomic_set(&tb->segtab, (long)NULL); + } +#endif + tb->nslots -= SEGSZ; + ASSERT(tb->nslots >= 0); + return nrecords; +} + + +static HashDbTerm* get_term(DbTableHash* tb, HashDbTerm* old, + Eterm obj, HashValue hval) +{ + HashDbTerm* p = db_get_term((DbTableCommon *) tb, + (old != NULL) ? &(old->dbterm) : NULL, + ((char *) &(old->dbterm)) - ((char *) old), + obj); + p->hvalue = hval; + /*p->next = NULL;*/ /*No Need */ + return p; +} + + +/* +** Copy terms from ptr1 until ptr2 +** works for ptr1 == ptr2 == 0 => [] +** or ptr2 == 0 +*/ +static Eterm put_term_list(Process* p, HashDbTerm* ptr1, HashDbTerm* ptr2) +{ + int sz = 0; + HashDbTerm* ptr; + Eterm list = NIL; + Eterm copy; + Eterm *hp; + + ptr = ptr1; + while(ptr != ptr2) { + + if (ptr->hvalue != INVALID_HASH) + sz += ptr->dbterm.size + 2; + + ptr = ptr->next; + } + + hp = HAlloc(p, sz); + + ptr = ptr1; + while(ptr != ptr2) { + if (ptr->hvalue != INVALID_HASH) { + copy = copy_shallow(DBTERM_BUF(&ptr->dbterm), ptr->dbterm.size, &hp, &MSO(p)); + list = CONS(hp, copy, list); + hp += 2; + } + ptr = ptr->next; + } + return list; +} + +static void free_term(DbTableHash *tb, HashDbTerm* p) +{ + db_free_term_data(&(p->dbterm)); + erts_db_free(ERTS_ALC_T_DB_TERM, + (DbTable *) tb, + (void *) p, + SIZ_DBTERM(p)*sizeof(Eterm)); +} + +/* Grow table with one new bucket. +** Allocate new segment if needed. +*/ +static void grow(DbTableHash* tb, int nactive) +{ + HashDbTerm** pnext; + HashDbTerm** to_pnext; + HashDbTerm* p; + erts_smp_rwmtx_t* lck; + int from_ix; + int szm; + + if (erts_smp_atomic_xchg(&tb->is_resizing, 1)) { + return; /* already in progress */ + } + if (NACTIVE(tb) != nactive) { + goto abort; /* already done (race) */ + } + + /* Ensure that the slot nactive exists */ + if (nactive == tb->nslots) { + /* Time to get a new segment */ + ASSERT((nactive & SEGSZ_MASK) == 0); + if (!alloc_seg(tb)) goto abort; + } + ASSERT(nactive < tb->nslots); + + szm = erts_smp_atomic_read(&tb->szm); + if (nactive <= szm) { + from_ix = nactive & (szm >> 1); + } else { + ASSERT(nactive == szm+1); + from_ix = 0; + szm = (szm<<1) | 1; + } + + lck = WLOCK_HASH(tb, from_ix); + /* Now a final double check (with the from_ix lock held) + * that we did not get raced by a table fixer. + */ + if (IS_FIXED(tb)) { + WUNLOCK_HASH(lck); + goto abort; + } + erts_smp_atomic_inc(&tb->nactive); + if (from_ix == 0) { + erts_smp_atomic_set(&tb->szm, szm); + } + erts_smp_atomic_set(&tb->is_resizing, 0); + + /* Finally, let's split the bucket. We try to do it in a smart way + to keep link order and avoid unnecessary updates of next-pointers */ + pnext = &BUCKET(tb, from_ix); + p = *pnext; + to_pnext = &BUCKET(tb, nactive); + while (p != NULL) { + if (p->hvalue == INVALID_HASH) { /* rare but possible with fine locking */ + *pnext = p->next; + free_term(tb, p); + p = *pnext; + } + else { + int ix = p->hvalue & szm; + if (ix != from_ix) { + ASSERT(ix == (from_ix ^ ((szm+1)>>1))); + *to_pnext = p; + /* Swap "from" and "to": */ + from_ix = ix; + to_pnext = pnext; + } + pnext = &p->next; + p = *pnext; + } + } + *to_pnext = NULL; + + WUNLOCK_HASH(lck); + return; + +abort: + erts_smp_atomic_set(&tb->is_resizing, 0); +} + + +/* Shrink table by joining top bucket. +** Remove top segment if it gets empty. +*/ +static void shrink(DbTableHash* tb, int nactive) +{ + if (erts_smp_atomic_xchg(&tb->is_resizing, 1)) { + return; /* already in progress */ + } + if (NACTIVE(tb) == nactive) { + erts_smp_rwmtx_t* lck; + int src_ix = nactive - 1; + int low_szm = erts_smp_atomic_read(&tb->szm) >> 1; + int dst_ix = src_ix & low_szm; + + ASSERT(dst_ix < src_ix); + ASSERT(nactive > SEGSZ); + lck = WLOCK_HASH(tb, dst_ix); + /* Double check for racing table fixers */ + if (!IS_FIXED(tb)) { + HashDbTerm** src_bp = &BUCKET(tb, src_ix); + HashDbTerm** dst_bp = &BUCKET(tb, dst_ix); + HashDbTerm** bp = src_bp; + + /* Q: Why join lists by appending "dst" at the end of "src"? + A: Must step through "src" anyway to purge pseudo deleted. */ + while(*bp != NULL) { + if ((*bp)->hvalue == INVALID_HASH) { + HashDbTerm* deleted = *bp; + *bp = deleted->next; + free_term(tb, deleted); + } else { + bp = &(*bp)->next; + } + } + *bp = *dst_bp; + *dst_bp = *src_bp; + *src_bp = NULL; + + erts_smp_atomic_set(&tb->nactive, src_ix); + if (dst_ix == 0) { + erts_smp_atomic_set(&tb->szm, low_szm); + } + WUNLOCK_HASH(lck); + + if (tb->nslots - src_ix >= SEGSZ) { + free_seg(tb, 0); + } + } + else { + WUNLOCK_HASH(lck); + } + + } + /*else already done */ + erts_smp_atomic_set(&tb->is_resizing, 0); +} + + +/* Search a list of tuples for a matching key */ + +static HashDbTerm* search_list(DbTableHash* tb, Eterm key, + HashValue hval, HashDbTerm *list) +{ + while (list != 0) { + if (has_live_key(tb,list,key,hval)) + return list; + list = list->next; + } + return 0; +} + + +/* This function is called by the next AND the select BIF */ +/* It return the next live object in a table, NULL if no more */ +/* In-bucket: RLOCKED */ +/* Out-bucket: RLOCKED unless NULL */ +static HashDbTerm* next(DbTableHash *tb, Uint *iptr, erts_smp_rwmtx_t** lck_ptr, + HashDbTerm *list) +{ + int i; + + ERTS_SMP_LC_ASSERT(IS_HASH_RLOCKED(tb,*iptr)); + + for (list = list->next; list != NULL; list = list->next) { + if (list->hvalue != INVALID_HASH) + return list; + } + + i = *iptr; + while ((i=next_slot(tb, i, lck_ptr)) != 0) { + + list = BUCKET(tb,i); + while (list != NULL) { + if (list->hvalue != INVALID_HASH) { + *iptr = i; + return list; + } + list = list->next; + } + } + /* *iptr = ??? */ + return NULL; +} + +static int db_lookup_dbterm_hash(DbTable *tbl, Eterm key, DbUpdateHandle* handle) +{ + DbTableHash *tb = &tbl->hash; + HashDbTerm* b; + HashDbTerm** prevp; + int ix; + HashValue hval; + erts_smp_rwmtx_t* lck; + + hval = MAKE_HASH(key); + lck = WLOCK_HASH(tb,hval); + ix = hash_to_ix(tb, hval); + prevp = &BUCKET(tb, ix); + b = *prevp; + + while (b != 0) { + if (has_live_key(tb,b,key,hval)) { + handle->tb = tbl; + handle->bp = (void**) prevp; + handle->dbterm = &b->dbterm; + handle->new_size = b->dbterm.size; + handle->mustResize = 0; + handle->lck = lck; + /* KEEP hval WLOCKED, db_finalize_dbterm_hash will WUNLOCK */ + return 1; + } + prevp = &b->next; + b = *prevp; + } + WUNLOCK_HASH(lck); + return 0; +} + +/* Must be called after call to db_lookup_dbterm +*/ +static void db_finalize_dbterm_hash(DbUpdateHandle* handle) +{ + DbTable* tbl = handle->tb; + HashDbTerm* oldp = (HashDbTerm*) *(handle->bp); + erts_smp_rwmtx_t* lck = (erts_smp_rwmtx_t*) handle->lck; + + ERTS_SMP_LC_ASSERT(IS_HASH_WLOCKED(&tbl->hash,lck)); /* locked by db_lookup_dbterm_hash */ + ASSERT(&oldp->dbterm == handle->dbterm); + + if (handle->mustResize) { + Eterm* top; + Eterm copy; + DbTerm* newDbTerm; + HashDbTerm* newp = erts_db_alloc(ERTS_ALC_T_DB_TERM, tbl, + sizeof(HashDbTerm)+sizeof(Eterm)*(handle->new_size-1)); + sys_memcpy(newp, oldp, sizeof(HashDbTerm)-sizeof(DbTerm)); /* copy only hashtab header */ + *(handle->bp) = newp; + newDbTerm = &newp->dbterm; + + newDbTerm->size = handle->new_size; + newDbTerm->off_heap.mso = NULL; + newDbTerm->off_heap.externals = NULL; + #ifndef HYBRID /* FIND ME! */ + newDbTerm->off_heap.funs = NULL; + #endif + newDbTerm->off_heap.overhead = 0; + + /* make a flat copy */ + top = DBTERM_BUF(newDbTerm); + copy = copy_struct(make_tuple(handle->dbterm->tpl), + handle->new_size, + &top, &newDbTerm->off_heap); + DBTERM_SET_TPL(newDbTerm,tuple_val(copy)); + + WUNLOCK_HASH(lck); + + db_free_term_data(handle->dbterm); + erts_db_free(ERTS_ALC_T_DB_TERM, tbl, + (void *) (((char *) handle->dbterm) - (sizeof(HashDbTerm) - sizeof(DbTerm))), + sizeof(HashDbTerm) + sizeof(Eterm)*(handle->dbterm->size-1)); + } + else { + WUNLOCK_HASH(lck); + } +#ifdef DEBUG + handle->dbterm = 0; +#endif + return; +} + +static int db_delete_all_objects_hash(Process* p, DbTable* tbl) +{ + if (IS_FIXED(tbl)) { + db_mark_all_deleted_hash(tbl); + } else { + db_free_table_hash(tbl); + db_create_hash(p, tbl); + erts_smp_atomic_set(&tbl->hash.common.nitems, 0); + } + return 0; +} + +void db_foreach_offheap_hash(DbTable *tbl, + void (*func)(ErlOffHeap *, void *), + void * arg) +{ + DbTableHash *tb = &tbl->hash; + HashDbTerm* list; + int i; + int nactive = NACTIVE(tb); + + for (i = 0; i < nactive; i++) { + list = BUCKET(tb,i); + while(list != 0) { + (*func)(&(list->dbterm.off_heap), arg); + list = list->next; + } + } +} + +void db_calc_stats_hash(DbTableHash* tb, DbHashStats* stats) +{ + HashDbTerm* b; + erts_smp_rwmtx_t* lck; + int sum = 0; + int sq_sum = 0; + int ix; + int len; + + stats->min_chain_len = INT_MAX; + stats->max_chain_len = 0; + ix = 0; + lck = RLOCK_HASH(tb,ix); + do { + len = 0; + for (b = BUCKET(tb,ix); b!=NULL; b=b->next) { + len++; + } + sum += len; + sq_sum += len*len; + if (len < stats->min_chain_len) stats->min_chain_len = len; + if (len > stats->max_chain_len) stats->max_chain_len = len; + ix = next_slot(tb,ix,&lck); + }while (ix); + stats->avg_chain_len = (float)sum / NACTIVE(tb); + stats->std_dev_chain_len = sqrt((sq_sum - stats->avg_chain_len*sum) / NACTIVE(tb)); + /* Expected standard deviation from a good uniform hash function, + ie binomial distribution (not taking the linear hashing into acount) */ + stats->std_dev_expected = sqrt(stats->avg_chain_len * (1 - 1.0/NACTIVE(tb))); +} +#ifdef HARDDEBUG + +void db_check_table_hash(DbTable *tbl) +{ + DbTableHash *tb = &tbl->hash; + HashDbTerm* list; + int j; + + for (j = 0; j < tb->nactive; j++) { + if ((list = BUCKET(tb,j)) != 0) { + while (list != 0) { + if (!is_tuple(make_tuple(list->dbterm.tpl))) { + erl_exit(1, "Bad term in slot %d of ets table", j); + } + list = list->next; + } + } + } +} + +#endif diff --git a/erts/emulator/beam/erl_db_hash.h b/erts/emulator/beam/erl_db_hash.h new file mode 100644 index 0000000000..e0285fa5ed --- /dev/null +++ b/erts/emulator/beam/erl_db_hash.h @@ -0,0 +1,103 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef _DB_HASH_H +#define _DB_HASH_H + +#include "erl_db_util.h" /* DbTerm & DbTableCommon */ + +typedef struct fixed_deletion { + int slot; + struct fixed_deletion *next; +} FixedDeletion; + +typedef struct hash_db_term { + struct hash_db_term* next; /* next bucket */ + HashValue hvalue; /* stored hash value */ + DbTerm dbterm; /* The actual term */ +} HashDbTerm; + +#define DB_HASH_LOCK_CNT 16 +typedef struct db_table_hash_fine_locks { + union { + erts_smp_rwmtx_t lck; + byte _cache_line_alignment[64]; + }lck_vec[DB_HASH_LOCK_CNT]; +} DbTableHashFineLocks; + +typedef struct db_table_hash { + DbTableCommon common; + + erts_smp_atomic_t segtab; /* The segment table (struct segment**) */ + erts_smp_atomic_t szm; /* current size mask. */ + + /* SMP: nslots and nsegs are protected by is_resizing or table write lock */ + int nslots; /* Total number of slots */ + int nsegs; /* Size of segment table */ + + /* List of slots where elements have been deleted while table was fixed */ + erts_smp_atomic_t fixdel; /* (FixedDeletion*) */ + erts_smp_atomic_t nactive; /* Number of "active" slots */ + erts_smp_atomic_t is_resizing; /* grow/shrink in progress */ +#ifdef ERTS_SMP + DbTableHashFineLocks* locks; +#endif +} DbTableHash; + + +/* +** Function prototypes, looks the same (except the suffix) for all +** table types. The process is always an [in out] parameter. +*/ +void db_initialize_hash(void); +void db_unfix_table_hash(DbTableHash *tb /* [in out] */); +Uint db_kept_items_hash(DbTableHash *tb); + +/* Interface for meta pid table */ +int db_create_hash(Process *p, + DbTable *tbl /* [in out] */); + +int db_put_hash(DbTable *tbl, Eterm obj, int key_clash_fail); + +int db_get_hash(Process *p, DbTable *tbl, Eterm key, Eterm *ret); + +int db_erase_hash(DbTable *tbl, Eterm key, Eterm *ret); + +int db_get_element_array(DbTable *tbl, + Eterm key, + int ndex, + Eterm *ret, + int *num_ret); + +int db_erase_bag_exact2(DbTable *tbl, Eterm key, Eterm value); + +/* not yet in method table */ +int db_mark_all_deleted_hash(DbTable *tbl); + +typedef struct { + float avg_chain_len; + float std_dev_chain_len; + float std_dev_expected; + int max_chain_len; + int min_chain_len; +}DbHashStats; + +void db_calc_stats_hash(DbTableHash* tb, DbHashStats*); + +#endif /* _DB_HASH_H */ diff --git a/erts/emulator/beam/erl_db_tree.c b/erts/emulator/beam/erl_db_tree.c new file mode 100644 index 0000000000..d3a916d2d9 --- /dev/null +++ b/erts/emulator/beam/erl_db_tree.c @@ -0,0 +1,3289 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** Implementation of ordered ETS tables. +** The tables are implemented as AVL trees (Published by Adelson-Velski +** and Landis). A nice source for learning about these trees is +** Wirth's Algorithms + Datastructures = Programs. +** The implementation here is however not made with recursion +** as the examples in Wirths book are. +*/ + +/* +#ifdef DEBUG +#define HARDDEBUG 1 +#endif +*/ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#define ERTS_WANT_DB_INTERNAL__ +#include "erl_db.h" +#include "bif.h" +#include "big.h" +#include "erl_binary.h" + +#include "erl_db_tree.h" + + + +#define GETKEY(dtt, tplp) (*((tplp) + (dtt)->common.keypos)) +#define GETKEY_WITH_POS(Keypos, Tplp) (*((Tplp) + Keypos)) +#define NITEMS(tb) ((int)erts_smp_atomic_read(&(tb)->common.nitems)) + +/* +** A stack of this size is enough for an AVL tree with more than +** 0xFFFFFFFF elements. May be subject to change if +** the datatype of the element counter is changed to a 64 bit integer. +** The Maximal height of an AVL tree is calculated as: +** h(n) <= 1.4404 * log(n + 2) - 0.328 +** Where n denotes the number of nodes, h(n) the height of the tree +** with n nodes and log is the binary logarithm. +*/ + +#define STACK_NEED 50 +#define TREE_MAX_ELEMENTS 0xFFFFFFFFUL + +#define PUSH_NODE(Dtt, Tdt) \ + ((Dtt)->array[(Dtt)->pos++] = Tdt) + +#define POP_NODE(Dtt) \ + (((Dtt)->pos) ? \ + (Dtt)->array[--((Dtt)->pos)] : NULL) + +#define TOP_NODE(Dtt) \ + ((Dtt->pos) ? \ + (Dtt)->array[(Dtt)->pos - 1] : NULL) + +#define EMPTY_NODE(Dtt) (TOP_NODE(Dtt) == NULL) + + + +/* Obtain table static stack if available. NULL if not. +** Must be released with release_stack() +*/ +static DbTreeStack* get_static_stack(DbTableTree* tb) +{ + if (!erts_smp_atomic_xchg(&tb->is_stack_busy, 1)) { + return &tb->static_stack; + } + return NULL; +} + +/* Obtain static stack if available, otherwise empty dynamic stack. +** Must be released with release_stack() +*/ +static DbTreeStack* get_any_stack(DbTableTree* tb) +{ + DbTreeStack* stack; + if (!erts_smp_atomic_xchg(&tb->is_stack_busy, 1)) { + return &tb->static_stack; + } + stack = erts_db_alloc(ERTS_ALC_T_DB_STK, (DbTable *) tb, + sizeof(DbTreeStack) + sizeof(TreeDbTerm*) * STACK_NEED); + stack->pos = 0; + stack->slot = 0; + stack->array = (TreeDbTerm**) (stack + 1); + return stack; +} + +static void release_stack(DbTableTree* tb, DbTreeStack* stack) +{ + if (stack == &tb->static_stack) { + ASSERT(erts_smp_atomic_read(&tb->is_stack_busy) == 1); + erts_smp_atomic_set(&tb->is_stack_busy, 0); + } + else { + erts_db_free(ERTS_ALC_T_DB_STK, (DbTable *) tb, + (void *) stack, sizeof(DbTreeStack) + sizeof(TreeDbTerm*) * STACK_NEED); + } +} + +static void reset_static_stack(DbTableTree* tb) +{ + tb->static_stack.pos = 0; + tb->static_stack.slot = 0; +} + + +/* +** Some macros for "direction stacks" +*/ +#define DIR_LEFT 0 +#define DIR_RIGHT 1 +#define DIR_END 2 + +/* + * Special binary flag + */ +#define BIN_FLAG_ALL_OBJECTS BIN_FLAG_USR1 + +/* + * Number of records to delete before trapping. + */ +#define DELETE_RECORD_LIMIT 12000 + +/* +** Debugging +*/ +#ifdef HARDDEBUG +static TreeDbTerm *traverse_until(TreeDbTerm *t, int *current, int to); +static void check_slot_pos(DbTableTree *tb); +static void check_saved_stack(DbTableTree *tb); +static int check_table_tree(TreeDbTerm *t); + +#define TREE_DEBUG +#endif + +#ifdef TREE_DEBUG +/* +** Primitive trace macro +*/ +#define DBG erts_fprintf(stderr,"%d\n",__LINE__) + +/* +** Debugging dump +*/ + +static void do_dump_tree2(int to, void *to_arg, int show, TreeDbTerm *t, + int offset); + +#else + +#define DBG /* nothing */ + +#endif + +/* + * Size calculations + */ +#define SIZ_OVERHEAD ((sizeof(TreeDbTerm)/sizeof(Eterm)) - 1) +#define SIZ_DBTERM(TDT) (SIZ_OVERHEAD + (TDT)->dbterm.size) + +/* +** Datatypes +*/ + +/* + * This structure is filled in by analyze_pattern() for the select + * functions. + */ +struct mp_info { + int all_objects; /* True if complete objects are always + * returned from the match_spec (can use + * copy_shallow on the return value) */ + int something_can_match; /* The match_spec is not "impossible" */ + int some_limitation; /* There is some limitation on the search + * area, i. e. least and/or most is set.*/ + int got_partial; /* The limitation has a partially bound + * key */ + Eterm least; /* The lowest matching key (possibly + * partially bound expression) */ + Eterm most; /* The highest matching key (possibly + * partially bound expression) */ + + TreeDbTerm *save_term; /* If the key is completely bound, this + * will be the Tree node we're searching + * for, otherwise it will be useless */ + Binary *mp; /* The compiled match program */ +}; + +/* + * Used by doit_select(_chunk) + */ +struct select_context { + Process *p; + Eterm accum; + Binary *mp; + Eterm end_condition; + Eterm *lastobj; + Sint32 max; + int keypos; + int all_objects; + Sint got; + Sint chunk_size; +}; + +/* + * Used by doit_select_count + */ +struct select_count_context { + Process *p; + Binary *mp; + Eterm end_condition; + Eterm *lastobj; + Sint32 max; + int keypos; + int all_objects; + Sint got; +}; + +/* + * Used by doit_select_delete + */ +struct select_delete_context { + Process *p; + DbTableTree *tb; + Uint accum; + Binary *mp; + Eterm end_condition; + int erase_lastterm; + TreeDbTerm *lastterm; + Sint32 max; + int keypos; +}; + +/* +** Forward declarations +*/ +static TreeDbTerm *linkout_tree(DbTableTree *tb, Eterm key); +static TreeDbTerm *linkout_object_tree(DbTableTree *tb, + Eterm object); +static int do_free_tree_cont(DbTableTree *tb, int num_left); +static TreeDbTerm* get_term(DbTableTree *tb, + TreeDbTerm* old, + Eterm obj); +static void free_term(DbTableTree *tb, TreeDbTerm* p); +static int balance_left(TreeDbTerm **this); +static int balance_right(TreeDbTerm **this); +static int delsub(TreeDbTerm **this); +static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot); +static TreeDbTerm *find_node(DbTableTree *tb, Eterm key); +static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key); +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack*, Eterm key); +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack*, Eterm key); +static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack*, + Eterm key); +static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack*, + Eterm key); +static void traverse_backwards(DbTableTree *tb, + DbTreeStack*, + Eterm lastkey, + int (*doit)(DbTableTree *tb, + TreeDbTerm *, + void *, + int), + void *context); +static void traverse_forward(DbTableTree *tb, + DbTreeStack*, + Eterm lastkey, + int (*doit)(DbTableTree *tb, + TreeDbTerm *, + void *, + int), + void *context); +static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, + Eterm *partly_bound_key); +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key); +static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done); + +static int analyze_pattern(DbTableTree *tb, Eterm pattern, + struct mp_info *mpi); +static int doit_select(DbTableTree *tb, + TreeDbTerm *this, + void *ptr, + int forward); +static int doit_select_count(DbTableTree *tb, + TreeDbTerm *this, + void *ptr, + int forward); +static int doit_select_chunk(DbTableTree *tb, + TreeDbTerm *this, + void *ptr, + int forward); +static int doit_select_delete(DbTableTree *tb, + TreeDbTerm *this, + void *ptr, + int forward); +static void do_dump_tree(int to, void *to_arg, TreeDbTerm *t); + +static int partly_bound_can_match_lesser(Eterm partly_bound_1, + Eterm partly_bound_2); +static int partly_bound_can_match_greater(Eterm partly_bound_1, + Eterm partly_bound_2); +static int do_partly_bound_can_match_lesser(Eterm a, Eterm b, + int *done); +static int do_partly_bound_can_match_greater(Eterm a, Eterm b, + int *done); +static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1, + Eterm a2, Eterm a3); + +/* Method interface functions */ +static int db_first_tree(Process *p, DbTable *tbl, + Eterm *ret); +static int db_next_tree(Process *p, DbTable *tbl, + Eterm key, Eterm *ret); +static int db_last_tree(Process *p, DbTable *tbl, + Eterm *ret); +static int db_prev_tree(Process *p, DbTable *tbl, + Eterm key, + Eterm *ret); +static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail); +static int db_get_tree(Process *p, DbTable *tbl, + Eterm key, Eterm *ret); +static int db_member_tree(DbTable *tbl, Eterm key, Eterm *ret); +static int db_get_element_tree(Process *p, DbTable *tbl, + Eterm key,int ndex, + Eterm *ret); +static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret); +static int db_erase_object_tree(DbTable *tbl, Eterm object,Eterm *ret); +static int db_slot_tree(Process *p, DbTable *tbl, + Eterm slot_term, Eterm *ret); +static int db_select_tree(Process *p, DbTable *tbl, + Eterm pattern, int reversed, Eterm *ret); +static int db_select_count_tree(Process *p, DbTable *tbl, + Eterm pattern, Eterm *ret); +static int db_select_chunk_tree(Process *p, DbTable *tbl, + Eterm pattern, Sint chunk_size, + int reversed, Eterm *ret); +static int db_select_continue_tree(Process *p, DbTable *tbl, + Eterm continuation, Eterm *ret); +static int db_select_count_continue_tree(Process *p, DbTable *tbl, + Eterm continuation, Eterm *ret); +static int db_select_delete_tree(Process *p, DbTable *tbl, + Eterm pattern, Eterm *ret); +static int db_select_delete_continue_tree(Process *p, DbTable *tbl, + Eterm continuation, Eterm *ret); +static void db_print_tree(int to, void *to_arg, + int show, DbTable *tbl); +static int db_free_table_tree(DbTable *tbl); + +static int db_free_table_continue_tree(DbTable *tbl); + +static void db_foreach_offheap_tree(DbTable *, + void (*)(ErlOffHeap *, void *), + void *); + +static int db_delete_all_objects_tree(Process* p, DbTable* tbl); + +#ifdef HARDDEBUG +static void db_check_table_tree(DbTable *tbl); +#endif +static int db_lookup_dbterm_tree(DbTable *, Eterm key, DbUpdateHandle*); +static void db_finalize_dbterm_tree(DbUpdateHandle*); + +/* +** Static variables +*/ + +Export ets_select_reverse_exp; + +/* +** External interface +*/ +DbTableMethod db_tree = +{ + db_create_tree, + db_first_tree, + db_next_tree, + db_last_tree, + db_prev_tree, + db_put_tree, + db_get_tree, + db_get_element_tree, + db_member_tree, + db_erase_tree, + db_erase_object_tree, + db_slot_tree, + db_select_chunk_tree, + db_select_tree, /* why not chunk size=0 ??? */ + db_select_delete_tree, + db_select_continue_tree, + db_select_delete_continue_tree, + db_select_count_tree, + db_select_count_continue_tree, + db_delete_all_objects_tree, + db_free_table_tree, + db_free_table_continue_tree, + db_print_tree, + db_foreach_offheap_tree, +#ifdef HARDDEBUG + db_check_table_tree, +#else + NULL, +#endif + db_lookup_dbterm_tree, + db_finalize_dbterm_tree + +}; + + + + + +void db_initialize_tree(void) +{ + memset(&ets_select_reverse_exp, 0, sizeof(Export)); + ets_select_reverse_exp.address = + &ets_select_reverse_exp.code[3]; + ets_select_reverse_exp.code[0] = am_ets; + ets_select_reverse_exp.code[1] = am_reverse; + ets_select_reverse_exp.code[2] = 3; + ets_select_reverse_exp.code[3] = + (Eterm) em_apply_bif; + ets_select_reverse_exp.code[4] = + (Eterm) &ets_select_reverse; + return; +}; + +/* +** Table interface routines ie what's called by the bif's +*/ + +int db_create_tree(Process *p, DbTable *tbl) +{ + DbTableTree *tb = &tbl->tree; + tb->root = NULL; + tb->static_stack.array = erts_db_alloc(ERTS_ALC_T_DB_STK, + (DbTable *) tb, + sizeof(TreeDbTerm *) * STACK_NEED); + tb->static_stack.pos = 0; + tb->static_stack.slot = 0; + erts_smp_atomic_init(&tb->is_stack_busy, 0); + tb->deletion = 0; + return DB_ERROR_NONE; +} + +static int db_first_tree(Process *p, DbTable *tbl, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + TreeDbTerm *this; + Eterm e; + Eterm *hp; + Uint sz; + + if (( this = tb->root ) == NULL) { + *ret = am_EOT; + return DB_ERROR_NONE; + } + /* Walk down to the tree to the left */ + if ((stack = get_static_stack(tb)) != NULL) { + stack->pos = stack->slot = 0; + } + while (this->left != NULL) { + if (stack) PUSH_NODE(stack, this); + this = this->left; + } + if (stack) { + PUSH_NODE(stack, this); + stack->slot = 1; + release_stack(tb,stack); + } + e = GETKEY(tb, this->dbterm.tpl); + sz = size_object(e); + + hp = HAlloc(p, sz); + + *ret = copy_struct(e,sz,&hp,&MSO(p)); + + return DB_ERROR_NONE; +} + +static int db_next_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + TreeDbTerm *this; + Eterm e; + Eterm *hp; + Uint sz; + + if (is_atom(key) && key == am_EOT) + return DB_ERROR_BADKEY; + stack = get_any_stack(tb); + this = find_next(tb, stack, key); + release_stack(tb,stack); + if (this == NULL) { + *ret = am_EOT; + return DB_ERROR_NONE; + } + e = GETKEY(tb, this->dbterm.tpl); + sz = size_object(e); + + hp = HAlloc(p, sz); + + *ret = copy_struct(e,sz,&hp,&MSO(p)); + + return DB_ERROR_NONE; +} + +static int db_last_tree(Process *p, DbTable *tbl, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + TreeDbTerm *this; + DbTreeStack* stack; + Eterm e; + Eterm *hp; + Uint sz; + + if (( this = tb->root ) == NULL) { + *ret = am_EOT; + return DB_ERROR_NONE; + } + /* Walk down to the tree to the left */ + if ((stack = get_static_stack(tb)) != NULL) { + stack->pos = stack->slot = 0; + } + while (this->right != NULL) { + if (stack) PUSH_NODE(stack, this); + this = this->right; + } + if (stack) { + PUSH_NODE(stack, this); + stack->slot = NITEMS(tb); + release_stack(tb,stack); + } + e = GETKEY(tb, this->dbterm.tpl); + sz = size_object(e); + + hp = HAlloc(p, sz); + + *ret = copy_struct(e,sz,&hp,&MSO(p)); + + return DB_ERROR_NONE; +} + +static int db_prev_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + TreeDbTerm *this; + DbTreeStack* stack; + Eterm e; + Eterm *hp; + Uint sz; + + if (is_atom(key) && key == am_EOT) + return DB_ERROR_BADKEY; + stack = get_any_stack(tb); + this = find_prev(tb, stack, key); + release_stack(tb,stack); + if (this == NULL) { + *ret = am_EOT; + return DB_ERROR_NONE; + } + e = GETKEY(tb, this->dbterm.tpl); + sz = size_object(e); + + hp = HAlloc(p, sz); + + *ret = copy_struct(e,sz,&hp,&MSO(p)); + + return DB_ERROR_NONE; +} + +static int db_put_tree(DbTable *tbl, Eterm obj, int key_clash_fail) +{ + DbTableTree *tb = &tbl->tree; + /* Non recursive insertion in AVL tree, building our own stack */ + TreeDbTerm **tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 0; + int state = 0; + TreeDbTerm **this = &tb->root; + Sint c; + Eterm key; + int dir; + TreeDbTerm *p1, *p2, *p; + + key = GETKEY(tb, tuple_val(obj)); + + reset_static_stack(tb); + + dstack[dpos++] = DIR_END; + for (;;) + if (!*this) { /* Found our place */ + state = 1; + if (erts_smp_atomic_inctest(&tb->common.nitems) >= TREE_MAX_ELEMENTS) { + erts_smp_atomic_dec(&tb->common.nitems); + return DB_ERROR_SYSRES; + } + *this = get_term(tb, NULL, obj); + (*this)->balance = 0; + (*this)->left = (*this)->right = NULL; + break; + } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { + /* go left */ + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else if (!key_clash_fail) { /* Equal key and this is a set, replace. */ + *this = get_term(tb, *this, obj); + break; + } else { + return DB_ERROR_BADKEY; /* key already exists */ + } + + while (state && ( dir = dstack[--dpos] ) != DIR_END) { + this = tstack[--tpos]; + p = *this; + if (dir == DIR_LEFT) { + switch (p->balance) { + case 1: + p->balance = 0; + state = 0; + break; + case 0: + p->balance = -1; + break; + case -1: /* The icky case */ + p1 = p->left; + if (p1->balance == -1) { /* Single LL rotation */ + p->left = p1->right; + p1->right = p; + p->balance = 0; + (*this) = p1; + } else { /* Double RR rotation */ + p2 = p1->right; + p1->right = p2->left; + p2->left = p1; + p->left = p2->right; + p2->right = p; + p->balance = (p2->balance == -1) ? +1 : 0; + p1->balance = (p2->balance == 1) ? -1 : 0; + (*this) = p2; + } + (*this)->balance = 0; + state = 0; + break; + } + } else { /* dir == DIR_RIGHT */ + switch (p->balance) { + case -1: + p->balance = 0; + state = 0; + break; + case 0: + p->balance = 1; + break; + case 1: + p1 = p->right; + if (p1->balance == 1) { /* Single RR rotation */ + p->right = p1->left; + p1->left = p; + p->balance = 0; + (*this) = p1; + } else { /* Double RL rotation */ + p2 = p1->left; + p1->left = p2->right; + p2->right = p1; + p->right = p2->left; + p2->left = p; + p->balance = (p2->balance == 1) ? -1 : 0; + p1->balance = (p2->balance == -1) ? 1 : 0; + (*this) = p2; + } + (*this)->balance = 0; + state = 0; + break; + } + } + } + return DB_ERROR_NONE; +} + +static int db_get_tree(Process *p, DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + Eterm copy; + Eterm *hp; + TreeDbTerm *this; + + /* + * This is always a set, so we know exactly how large + * the data is when we have found it. + * The list created around it is purely for interface conformance. + */ + + this = find_node(tb,key); + if (this == NULL) { + *ret = NIL; + } else { + hp = HAlloc(p, this->dbterm.size + 2); + copy = copy_shallow(DBTERM_BUF(&this->dbterm), + this->dbterm.size, + &hp, + &MSO(p)); + *ret = CONS(hp, copy, NIL); + } + return DB_ERROR_NONE; +} + +static int db_member_tree(DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + + *ret = (find_node(tb,key) == NULL) ? am_false : am_true; + return DB_ERROR_NONE; +} + +static int db_get_element_tree(Process *p, DbTable *tbl, + Eterm key, int ndex, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + /* + * Look the node up: + */ + Eterm *hp; + TreeDbTerm *this; + + /* + * This is always a set, so we know exactly how large + * the data is when we have found it. + * No list is created around elements in set's so there are no list + * around the element here either. + */ + + this = find_node(tb,key); + if (this == NULL) { + return DB_ERROR_BADKEY; + } else { + Eterm element; + Uint sz; + if (ndex > arityval(this->dbterm.tpl[0])) { + return DB_ERROR_BADPARAM; + } + element = this->dbterm.tpl[ndex]; + sz = size_object(element); + hp = HAlloc(p, sz); + *ret = copy_struct(element, + sz, + &hp, + &MSO(p)); + } + return DB_ERROR_NONE; +} + +static int db_erase_tree(DbTable *tbl, Eterm key, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + TreeDbTerm *res; + + *ret = am_true; + + if ((res = linkout_tree(tb, key)) != NULL) { + free_term(tb, res); + } + return DB_ERROR_NONE; +} + +static int db_erase_object_tree(DbTable *tbl, Eterm object, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + TreeDbTerm *res; + + *ret = am_true; + + if ((res = linkout_object_tree(tb, object)) != NULL) { + free_term(tb, res); + } + return DB_ERROR_NONE; +} + + +static int db_slot_tree(Process *p, DbTable *tbl, + Eterm slot_term, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + Sint slot; + TreeDbTerm *st; + Eterm *hp; + Eterm copy; + + /* + * The notion of a "slot" is not natural in a tree, but we try to + * simulate it by giving the n'th node in the tree instead. + * Traversing a tree in this way is not very convenient, but by + * using the saved stack we at least sometimes will get acceptable + * performance. + */ + + if (is_not_small(slot_term) || + ((slot = signed_val(slot_term)) < 0) || + (slot > NITEMS(tb))) + return DB_ERROR_BADPARAM; + + if (slot == NITEMS(tb)) { + *ret = am_EOT; + return DB_ERROR_NONE; + } + + /* + * We use the slot position and search from there, slot positions + * are counted from 1 and up. + */ + ++slot; + st = slot_search(p, tb, slot); + if (st == NULL) { + *ret = am_false; + return DB_ERROR_UNSPEC; + } + hp = HAlloc(p, st->dbterm.size + 2); + copy = copy_shallow(DBTERM_BUF(&st->dbterm), + st->dbterm.size, + &hp, + &MSO(p)); + *ret = CONS(hp, copy, NIL); + return DB_ERROR_NONE; +} + + + +static BIF_RETTYPE ets_select_reverse(Process *p, Eterm a1, Eterm a2, Eterm a3) +{ + Eterm list; + Eterm result; + Eterm* hp; + Eterm* hend; + + int max_iter = CONTEXT_REDS * 10; + + if (is_nil(a1)) { + hp = HAlloc(p, 3); + BIF_RET(TUPLE2(hp,a2,a3)); + } else if (is_not_list(a1)) { + error: + BIF_ERROR(p, BADARG); + } + + list = a1; + result = a2; + hp = hend = NULL; + while (is_list(list)) { + Eterm* pair = list_val(list); + if (--max_iter == 0) { + BUMP_ALL_REDS(p); + HRelease(p, hend, hp); + BIF_TRAP3(&ets_select_reverse_exp, p, list, result, a3); + } + if (hp == hend) { + hp = HAlloc(p, 64); + hend = hp + 64; + } + result = CONS(hp, CAR(pair), result); + hp += 2; + list = CDR(pair); + } + if (is_not_nil(list)) { + goto error; + } + HRelease(p, hend, hp); + BUMP_REDS(p,CONTEXT_REDS - max_iter / 10); + hp = HAlloc(p,3); + BIF_RET(TUPLE2(hp, result, a3)); +} + +static BIF_RETTYPE bif_trap1(Export *bif, + Process *p, + Eterm p1) +{ + BIF_TRAP1(bif, p, p1); +} + +static BIF_RETTYPE bif_trap3(Export *bif, + Process *p, + Eterm p1, + Eterm p2, + Eterm p3) +{ + BIF_TRAP3(bif, p, p1, p2, p3); +} + +/* +** This is called either when the select bif traps or when ets:select/1 +** is called. It does mostly the same as db_select_tree and may in either case +** trap to itself again (via the ets:select/1 bif). +** Note that this is common for db_select_tree and db_select_chunk_tree. +*/ +static int db_select_continue_tree(Process *p, + DbTable *tbl, + Eterm continuation, + Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + struct select_context sc; + unsigned sz; + Eterm *hp; + Eterm lastkey; + Eterm end_condition; + Binary *mp; + Eterm key; + Eterm *tptr; + Sint chunk_size; + Sint reverse; + + +#define RET_TO_BIF(Term, State) do { *ret = (Term); return State; } while(0); + + /* Decode continuation. We know it's a tuple but not the arity or + anything else */ + + tptr = tuple_val(continuation); + + if (arityval(*tptr) != 8) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + + if (!is_small(tptr[4]) || !is_binary(tptr[5]) || + !(is_list(tptr[6]) || tptr[6] == NIL) || !is_small(tptr[7]) || + !is_small(tptr[8])) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + + lastkey = tptr[2]; + end_condition = tptr[3]; + if (!(thing_subtag(*binary_val(tptr[5])) == REFC_BINARY_SUBTAG)) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + mp = ((ProcBin *) binary_val(tptr[5]))->val; + if (!IsMatchProgBinary(mp)) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + chunk_size = signed_val(tptr[4]); + + sc.p = p; + sc.accum = tptr[6]; + sc.mp = mp; + sc.end_condition = NIL; + sc.lastobj = NULL; + sc.max = 1000; + sc.keypos = tb->common.keypos; + sc.all_objects = mp->flags & BIN_FLAG_ALL_OBJECTS; + sc.chunk_size = chunk_size; + reverse = unsigned_val(tptr[7]); + sc.got = signed_val(tptr[8]); + + stack = get_any_stack(tb); + if (chunk_size) { + if (reverse) { + traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); + } else { + traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); + } + } else { + if (reverse) { + traverse_forward(tb, stack, lastkey, &doit_select, &sc); + } else { + traverse_backwards(tb, stack, lastkey, &doit_select, &sc); + } + } + release_stack(tb,stack); + + BUMP_REDS(p, 1000 - sc.max); + + if (sc.max > 0 || (chunk_size && sc.got == chunk_size)) { + if (chunk_size) { + Eterm *hp; + unsigned sz; + + if (sc.got < chunk_size || sc.lastobj == NULL) { + /* end of table, sc.lastobj may be NULL as we may have been + at the very last object in the table when trapping. */ + if (!sc.got) { + RET_TO_BIF(am_EOT, DB_ERROR_NONE); + } else { + RET_TO_BIF(bif_trap3(&ets_select_reverse_exp, p, + sc.accum, NIL, am_EOT), + DB_ERROR_NONE); + } + } + + key = GETKEY(tb, sc.lastobj); + + sz = size_object(key); + hp = HAlloc(p, 9 + sz); + key = copy_struct(key, sz, &hp, &MSO(p)); + continuation = TUPLE8 + (hp, + tptr[1], + key, + tptr[3], + tptr[4], + tptr[5], + NIL, + tptr[7], + make_small(0)); + RET_TO_BIF(bif_trap3(&ets_select_reverse_exp, p, + sc.accum, NIL, continuation), + DB_ERROR_NONE); + } else { + RET_TO_BIF(sc.accum, DB_ERROR_NONE); + } + } + key = GETKEY(tb, sc.lastobj); + if (chunk_size) { + if (end_condition != NIL && + ((!reverse && cmp_partly_bound(end_condition,key) < 0) || + (reverse && cmp_partly_bound(end_condition,key) > 0))) { + /* done anyway */ + if (!sc.got) { + RET_TO_BIF(am_EOT, DB_ERROR_NONE); + } else { + RET_TO_BIF(bif_trap3(&ets_select_reverse_exp, p, + sc.accum, NIL, am_EOT), + DB_ERROR_NONE); + } + } + } else { + if (end_condition != NIL && + ((!reverse && cmp_partly_bound(end_condition,key) > 0) || + (reverse && cmp_partly_bound(end_condition,key) < 0))) { + /* done anyway */ + RET_TO_BIF(sc.accum,DB_ERROR_NONE); + } + } + /* Not done yet, let's trap. */ + sz = size_object(key); + hp = HAlloc(p, 9 + sz); + key = copy_struct(key, sz, &hp, &MSO(p)); + continuation = TUPLE8 + (hp, + tptr[1], + key, + tptr[3], + tptr[4], + tptr[5], + sc.accum, + tptr[7], + make_small(sc.got)); + RET_TO_BIF(bif_trap1(bif_export[BIF_ets_select_1], p, continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF +} + + +static int db_select_tree(Process *p, DbTable *tbl, + Eterm pattern, int reverse, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + struct select_context sc; + struct mp_info mpi; + Eterm lastkey = NIL; + Eterm key; + Eterm continuation; + unsigned sz; + Eterm *hp; + TreeDbTerm *this; + int errcode; + Eterm mpb; + + +#define RET_TO_BIF(Term,RetVal) do { \ + if (mpi.mp != NULL) { \ + erts_bin_free(mpi.mp); \ + } \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + mpi.mp = NULL; + + sc.accum = NIL; + sc.lastobj = NULL; + sc.p = p; + sc.max = 1000; + sc.end_condition = NIL; + sc.keypos = tb->common.keypos; + sc.got = 0; + sc.chunk_size = 0; + + if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + RET_TO_BIF(NIL,errcode); + } + + if (!mpi.something_can_match) { + RET_TO_BIF(NIL,DB_ERROR_NONE); + /* can't possibly match anything */ + } + + sc.mp = mpi.mp; + sc.all_objects = mpi.all_objects; + + if (!mpi.got_partial && mpi.some_limitation && + cmp(mpi.least,mpi.most) == 0) { + doit_select(tb,mpi.save_term,&sc,0 /* direction doesn't matter */); + RET_TO_BIF(sc.accum,DB_ERROR_NONE); + } + + stack = get_any_stack(tb); + if (reverse) { + if (mpi.some_limitation) { + if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { + lastkey = GETKEY(tb, this->dbterm.tpl); + } + sc.end_condition = mpi.most; + } + + traverse_forward(tb, stack, lastkey, &doit_select, &sc); + } else { + if (mpi.some_limitation) { + if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { + lastkey = GETKEY(tb, this->dbterm.tpl); + } + sc.end_condition = mpi.least; + } + + traverse_backwards(tb, stack, lastkey, &doit_select, &sc); + } + release_stack(tb,stack); +#ifdef HARDDEBUG + erts_fprintf(stderr,"Least: %T\n", mpi.least); + erts_fprintf(stderr,"Most: %T\n", mpi.most); +#endif + BUMP_REDS(p, 1000 - sc.max); + if (sc.max > 0) { + RET_TO_BIF(sc.accum,DB_ERROR_NONE); + } + + key = GETKEY(tb, sc.lastobj); + sz = size_object(key); + hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + key = copy_struct(key, sz, &hp, &MSO(p)); + if (mpi.all_objects) + (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; + mpb=db_make_mp_binary(p,mpi.mp,&hp); + + continuation = TUPLE8 + (hp, + tb->common.id, + key, + sc.end_condition, /* From the match program, needn't be copied */ + make_small(0), /* Chunk size of zero means not chunked to the + continuation BIF */ + mpb, + sc.accum, + make_small(reverse), + make_small(sc.got)); + + /* Don't free mpi.mp, so don't use macro */ + *ret = bif_trap1(bif_export[BIF_ets_select_1], p, continuation); + return DB_ERROR_NONE; + +#undef RET_TO_BIF + +} + + +/* +** This is called either when the select_count bif traps. +*/ +static int db_select_count_continue_tree(Process *p, + DbTable *tbl, + Eterm continuation, + Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + struct select_count_context sc; + unsigned sz; + Eterm *hp; + Eterm lastkey; + Eterm end_condition; + Binary *mp; + Eterm key; + Eterm *tptr; + Eterm egot; + + +#define RET_TO_BIF(Term, State) do { *ret = (Term); return State; } while(0); + + /* Decode continuation. We know it's a tuple and everything else as + this is only called by ourselves */ + + /* continuation: + {Table, Lastkey, EndCondition, MatchProgBin, HowManyGot}*/ + + tptr = tuple_val(continuation); + + if (arityval(*tptr) != 5) + erl_exit(1,"Internal error in ets:select_count/1"); + + lastkey = tptr[2]; + end_condition = tptr[3]; + if (!(thing_subtag(*binary_val(tptr[4])) == REFC_BINARY_SUBTAG)) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + mp = ((ProcBin *) binary_val(tptr[4]))->val; + if (!IsMatchProgBinary(mp)) + RET_TO_BIF(NIL,DB_ERROR_BADPARAM); + + sc.p = p; + sc.mp = mp; + sc.end_condition = NIL; + sc.lastobj = NULL; + sc.max = 1000; + sc.keypos = tb->common.keypos; + if (is_big(tptr[5])) { + sc.got = big_to_uint32(tptr[5]); + } else { + sc.got = unsigned_val(tptr[5]); + } + + stack = get_any_stack(tb); + traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); + release_stack(tb,stack); + + BUMP_REDS(p, 1000 - sc.max); + + if (sc.max > 0) { + RET_TO_BIF(erts_make_integer(sc.got,p), DB_ERROR_NONE); + } + key = GETKEY(tb, sc.lastobj); + if (end_condition != NIL && + (cmp_partly_bound(end_condition,key) > 0)) { + /* done anyway */ + RET_TO_BIF(make_small(sc.got),DB_ERROR_NONE); + } + /* Not done yet, let's trap. */ + sz = size_object(key); + if (IS_USMALL(0, sc.got)) { + hp = HAlloc(p, sz + 6); + egot = make_small(sc.got); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + 6); + egot = uint_to_big(sc.got, hp); + hp += BIG_UINT_HEAP_SIZE; + } + key = copy_struct(key, sz, &hp, &MSO(p)); + continuation = TUPLE5 + (hp, + tptr[1], + key, + tptr[3], + tptr[4], + egot); + RET_TO_BIF(bif_trap1(&ets_select_count_continue_exp, p, continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF +} + + +static int db_select_count_tree(Process *p, DbTable *tbl, + Eterm pattern, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + struct select_count_context sc; + struct mp_info mpi; + Eterm lastkey = NIL; + Eterm key; + Eterm continuation; + unsigned sz; + Eterm *hp; + TreeDbTerm *this; + int errcode; + Eterm egot; + Eterm mpb; + + +#define RET_TO_BIF(Term,RetVal) do { \ + if (mpi.mp != NULL) { \ + erts_bin_free(mpi.mp); \ + } \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + mpi.mp = NULL; + + sc.lastobj = NULL; + sc.p = p; + sc.max = 1000; + sc.end_condition = NIL; + sc.keypos = tb->common.keypos; + sc.got = 0; + + if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + RET_TO_BIF(NIL,errcode); + } + + if (!mpi.something_can_match) { + RET_TO_BIF(make_small(0),DB_ERROR_NONE); + /* can't possibly match anything */ + } + + sc.mp = mpi.mp; + sc.all_objects = mpi.all_objects; + + if (!mpi.got_partial && mpi.some_limitation && + cmp(mpi.least,mpi.most) == 0) { + doit_select_count(tb,mpi.save_term,&sc,0 /* dummy */); + RET_TO_BIF(erts_make_integer(sc.got,p),DB_ERROR_NONE); + } + + stack = get_any_stack(tb); + if (mpi.some_limitation) { + if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { + lastkey = GETKEY(tb, this->dbterm.tpl); + } + sc.end_condition = mpi.least; + } + + traverse_backwards(tb, stack, lastkey, &doit_select_count, &sc); + release_stack(tb,stack); + BUMP_REDS(p, 1000 - sc.max); + if (sc.max > 0) { + RET_TO_BIF(erts_make_integer(sc.got,p),DB_ERROR_NONE); + } + + key = GETKEY(tb, sc.lastobj); + sz = size_object(key); + if (IS_USMALL(0, sc.got)) { + hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); + egot = make_small(sc.got); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + PROC_BIN_SIZE + 6); + egot = uint_to_big(sc.got, hp); + hp += BIG_UINT_HEAP_SIZE; + } + key = copy_struct(key, sz, &hp, &MSO(p)); + if (mpi.all_objects) + (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; + mpb = db_make_mp_binary(p,mpi.mp,&hp); + + continuation = TUPLE5 + (hp, + tb->common.id, + key, + sc.end_condition, /* From the match program, needn't be copied */ + mpb, + egot); + + /* Don't free mpi.mp, so don't use macro */ + *ret = bif_trap1(&ets_select_count_continue_exp, p, continuation); + return DB_ERROR_NONE; + +#undef RET_TO_BIF + +} + +static int db_select_chunk_tree(Process *p, DbTable *tbl, + Eterm pattern, Sint chunk_size, + int reverse, + Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + DbTreeStack* stack; + struct select_context sc; + struct mp_info mpi; + Eterm lastkey = NIL; + Eterm key; + Eterm continuation; + unsigned sz; + Eterm *hp; + TreeDbTerm *this; + int errcode; + Eterm mpb; + + +#define RET_TO_BIF(Term,RetVal) do { \ + if (mpi.mp != NULL) { \ + erts_bin_free(mpi.mp); \ + } \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + mpi.mp = NULL; + + sc.accum = NIL; + sc.lastobj = NULL; + sc.p = p; + sc.max = 1000; + sc.end_condition = NIL; + sc.keypos = tb->common.keypos; + sc.got = 0; + sc.chunk_size = chunk_size; + + if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + RET_TO_BIF(NIL,errcode); + } + + if (!mpi.something_can_match) { + RET_TO_BIF(am_EOT,DB_ERROR_NONE); + /* can't possibly match anything */ + } + + sc.mp = mpi.mp; + sc.all_objects = mpi.all_objects; + + if (!mpi.got_partial && mpi.some_limitation && + cmp(mpi.least,mpi.most) == 0) { + doit_select(tb,mpi.save_term,&sc, 0 /* direction doesn't matter */); + if (sc.accum != NIL) { + hp=HAlloc(p, 3); + RET_TO_BIF(TUPLE2(hp,sc.accum,am_EOT),DB_ERROR_NONE); + } else { + RET_TO_BIF(am_EOT,DB_ERROR_NONE); + } + } + + stack = get_any_stack(tb); + if (reverse) { + if (mpi.some_limitation) { + if ((this = find_next_from_pb_key(tb, stack, mpi.most)) != NULL) { + lastkey = GETKEY(tb, this->dbterm.tpl); + } + sc.end_condition = mpi.least; + } + + traverse_backwards(tb, stack, lastkey, &doit_select_chunk, &sc); + } else { + if (mpi.some_limitation) { + if ((this = find_prev_from_pb_key(tb, stack, mpi.least)) != NULL) { + lastkey = GETKEY(tb, this->dbterm.tpl); + } + sc.end_condition = mpi.most; + } + + traverse_forward(tb, stack, lastkey, &doit_select_chunk, &sc); + } + release_stack(tb,stack); + + BUMP_REDS(p, 1000 - sc.max); + if (sc.max > 0 || sc.got == chunk_size) { + Eterm *hp; + unsigned sz; + + if (sc.got < chunk_size || + sc.lastobj == NULL) { + /* We haven't got all and we haven't trapped + which should mean we are at the end of the + table, sc.lastobj may be NULL if the table was empty */ + + if (!sc.got) { + RET_TO_BIF(am_EOT, DB_ERROR_NONE); + } else { + RET_TO_BIF(bif_trap3(&ets_select_reverse_exp, p, + sc.accum, NIL, am_EOT), + DB_ERROR_NONE); + } + } + + key = GETKEY(tb, sc.lastobj); + sz = size_object(key); + hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + key = copy_struct(key, sz, &hp, &MSO(p)); + if (mpi.all_objects) + (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; + mpb = db_make_mp_binary(p,mpi.mp,&hp); + + continuation = TUPLE8 + (hp, + tb->common.id, + key, + sc.end_condition, /* From the match program, + needn't be copied */ + make_small(chunk_size), + mpb, + NIL, + make_small(reverse), + make_small(0)); + /* Don't let RET_TO_BIF macro free mpi.mp*/ + *ret = bif_trap3(&ets_select_reverse_exp, p, + sc.accum, NIL, continuation); + return DB_ERROR_NONE; + } + + key = GETKEY(tb, sc.lastobj); + sz = size_object(key); + hp = HAlloc(p, 9 + sz + PROC_BIN_SIZE); + key = copy_struct(key, sz, &hp, &MSO(p)); + + if (mpi.all_objects) + (mpi.mp)->flags |= BIN_FLAG_ALL_OBJECTS; + mpb = db_make_mp_binary(p,mpi.mp,&hp); + continuation = TUPLE8 + (hp, + tb->common.id, + key, + sc.end_condition, /* From the match program, needn't be copied */ + make_small(chunk_size), + mpb, + sc.accum, + make_small(reverse), + make_small(sc.got)); + /* Don't let RET_TO_BIF macro free mpi.mp*/ + *ret = bif_trap1(bif_export[BIF_ets_select_1], p, continuation); + return DB_ERROR_NONE; + +#undef RET_TO_BIF + +} + +/* +** This is called when select_delete traps +*/ +static int db_select_delete_continue_tree(Process *p, + DbTable *tbl, + Eterm continuation, + Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + struct select_delete_context sc; + unsigned sz; + Eterm *hp; + Eterm lastkey; + Eterm end_condition; + Binary *mp; + Eterm key; + Eterm *tptr; + Eterm eaccsum; + + +#define RET_TO_BIF(Term, State) do { \ + if (sc.erase_lastterm) { \ + free_term(tb, sc.lastterm); \ + } \ + *ret = (Term); \ + return State; \ + } while(0); + + /* Decode continuation. We know it's correct, this can only be called + by trapping */ + + tptr = tuple_val(continuation); + + lastkey = tptr[2]; + end_condition = tptr[3]; + + sc.erase_lastterm = 0; /* Before first RET_TO_BIF */ + sc.lastterm = NULL; + + mp = ((ProcBin *) binary_val(tptr[4]))->val; + sc.p = p; + sc.tb = tb; + if (is_big(tptr[5])) { + sc.accum = big_to_uint32(tptr[5]); + } else { + sc.accum = unsigned_val(tptr[5]); + } + sc.mp = mp; + sc.end_condition = NIL; + sc.max = 1000; + sc.keypos = tb->common.keypos; + + ASSERT(!erts_smp_atomic_read(&tb->is_stack_busy)); + traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); + + BUMP_REDS(p, 1000 - sc.max); + + if (sc.max > 0) { + RET_TO_BIF(erts_make_integer(sc.accum, p), DB_ERROR_NONE); + } + key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); + if (end_condition != NIL && + cmp_partly_bound(end_condition,key) > 0) { /* done anyway */ + RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); + } + /* Not done yet, let's trap. */ + sz = size_object(key); + if (IS_USMALL(0, sc.accum)) { + hp = HAlloc(p, sz + 6); + eaccsum = make_small(sc.accum); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + 6); + eaccsum = uint_to_big(sc.accum, hp); + hp += BIG_UINT_HEAP_SIZE; + } + key = copy_struct(key, sz, &hp, &MSO(p)); + continuation = TUPLE5 + (hp, + tptr[1], + key, + tptr[3], + tptr[4], + eaccsum); + RET_TO_BIF(bif_trap1(&ets_select_delete_continue_exp, p, continuation), + DB_ERROR_NONE); + +#undef RET_TO_BIF +} + +static int db_select_delete_tree(Process *p, DbTable *tbl, + Eterm pattern, Eterm *ret) +{ + DbTableTree *tb = &tbl->tree; + struct select_delete_context sc; + struct mp_info mpi; + Eterm lastkey = NIL; + Eterm key; + Eterm continuation; + unsigned sz; + Eterm *hp; + TreeDbTerm *this; + int errcode; + Eterm mpb; + Eterm eaccsum; + +#define RET_TO_BIF(Term,RetVal) do { \ + if (mpi.mp != NULL) { \ + erts_bin_free(mpi.mp); \ + } \ + if (sc.erase_lastterm) { \ + free_term(tb, sc.lastterm); \ + } \ + *ret = (Term); \ + return RetVal; \ + } while(0) + + mpi.mp = NULL; + + sc.accum = 0; + sc.erase_lastterm = 0; + sc.lastterm = NULL; + sc.p = p; + sc.max = 1000; + sc.end_condition = NIL; + sc.keypos = tb->common.keypos; + sc.tb = tb; + + if ((errcode = analyze_pattern(tb, pattern, &mpi)) != DB_ERROR_NONE) { + RET_TO_BIF(0,errcode); + } + + if (!mpi.something_can_match) { + RET_TO_BIF(make_small(0),DB_ERROR_NONE); + /* can't possibly match anything */ + } + + sc.mp = mpi.mp; + + if (!mpi.got_partial && mpi.some_limitation && + cmp(mpi.least,mpi.most) == 0) { + doit_select_delete(tb,mpi.save_term,&sc, 0 /* direction doesn't + matter */); + RET_TO_BIF(erts_make_integer(sc.accum,p),DB_ERROR_NONE); + } + + if (mpi.some_limitation) { + if ((this = find_next_from_pb_key(tb, &tb->static_stack, mpi.most)) != NULL) { + lastkey = GETKEY(tb, this->dbterm.tpl); + } + sc.end_condition = mpi.least; + } + + traverse_backwards(tb, &tb->static_stack, lastkey, &doit_select_delete, &sc); + BUMP_REDS(p, 1000 - sc.max); + + if (sc.max > 0) { + RET_TO_BIF(erts_make_integer(sc.accum,p), DB_ERROR_NONE); + } + + key = GETKEY(tb, (sc.lastterm)->dbterm.tpl); + sz = size_object(key); + if (IS_USMALL(0, sc.accum)) { + hp = HAlloc(p, sz + PROC_BIN_SIZE + 6); + eaccsum = make_small(sc.accum); + } + else { + hp = HAlloc(p, BIG_UINT_HEAP_SIZE + sz + PROC_BIN_SIZE + 6); + eaccsum = uint_to_big(sc.accum, hp); + hp += BIG_UINT_HEAP_SIZE; + } + key = copy_struct(key, sz, &hp, &MSO(p)); + mpb = db_make_mp_binary(p,mpi.mp,&hp); + + continuation = TUPLE5 + (hp, + tb->common.id, + key, + sc.end_condition, /* From the match program, needn't be copied */ + mpb, + eaccsum); + + /* Don't free mpi.mp, so don't use macro */ + if (sc.erase_lastterm) { + free_term(tb, sc.lastterm); + } + *ret = bif_trap1(&ets_select_delete_continue_exp, p, continuation); + return DB_ERROR_NONE; + +#undef RET_TO_BIF + +} + +/* +** Other interface routines (not directly coupled to one bif) +*/ + +/* Display hash table contents (for dump) */ +static void db_print_tree(int to, void *to_arg, + int show, + DbTable *tbl) +{ + DbTableTree *tb = &tbl->tree; +#ifdef TREE_DEBUG + if (show) + erts_print(to, to_arg, "\nTree data dump:\n" + "------------------------------------------------\n"); + do_dump_tree2(to, to_arg, show, tb->root, 0); + if (show) + erts_print(to, to_arg, "\n" + "------------------------------------------------\n"); +#else + erts_print(to, to_arg, "Ordered set (AVL tree), Elements: %d\n", NITEMS(tb)); + do_dump_tree(to, to_arg, tb->root); +#endif +} + +/* release all memory occupied by a single table */ +static int db_free_table_tree(DbTable *tbl) +{ + while (!db_free_table_continue_tree(tbl)) + ; + return 1; +} + +static int db_free_table_continue_tree(DbTable *tbl) +{ + DbTableTree *tb = &tbl->tree; + int result; + + if (!tb->deletion) { + tb->static_stack.pos = 0; + tb->deletion = 1; + PUSH_NODE(&tb->static_stack, tb->root); + } + result = do_free_tree_cont(tb, DELETE_RECORD_LIMIT); + if (result) { /* Completely done. */ + erts_db_free(ERTS_ALC_T_DB_STK, + (DbTable *) tb, + (void *) tb->static_stack.array, + sizeof(TreeDbTerm *) * STACK_NEED); + ASSERT(erts_smp_atomic_read(&tb->common.memory_size) + == sizeof(DbTable)); + } + return result; +} + +static int db_delete_all_objects_tree(Process* p, DbTable* tbl) +{ + db_free_table_tree(tbl); + db_create_tree(p, tbl); + erts_smp_atomic_set(&tbl->tree.common.nitems, 0); + return 0; +} + +static void do_db_tree_foreach_offheap(TreeDbTerm *, + void (*)(ErlOffHeap *, void *), + void *); + +static void db_foreach_offheap_tree(DbTable *tbl, + void (*func)(ErlOffHeap *, void *), + void * arg) +{ + do_db_tree_foreach_offheap(tbl->tree.root, func, arg); +} + + +/* +** Functions for internal use +*/ + + +static void +do_db_tree_foreach_offheap(TreeDbTerm *tdbt, + void (*func)(ErlOffHeap *, void *), + void * arg) +{ + if(!tdbt) + return; + do_db_tree_foreach_offheap(tdbt->left, func, arg); + (*func)(&(tdbt->dbterm.off_heap), arg); + do_db_tree_foreach_offheap(tdbt->right, func, arg); +} + +static TreeDbTerm *linkout_tree(DbTableTree *tb, + Eterm key) +{ + TreeDbTerm **tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 0; + int state = 0; + TreeDbTerm **this = &tb->root; + Sint c; + int dir; + TreeDbTerm *q = NULL; + + /* + * Somewhat complicated, deletion in an AVL tree, + * The two helpers balance_left and balance_right are used to + * keep the balance. As in insert, we do the stacking ourselves. + */ + + reset_static_stack(tb); + dstack[dpos++] = DIR_END; + for (;;) { + if (!*this) { /* Failure */ + return NULL; + } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Equal key, found the one to delete*/ + q = (*this); + if (q->right == NULL) { + (*this) = q->left; + state = 1; + } else if (q->left == NULL) { + (*this) = q->right; + state = 1; + } else { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + state = delsub(this); + } + erts_smp_atomic_dec(&tb->common.nitems); + break; + } + } + while (state && ( dir = dstack[--dpos] ) != DIR_END) { + this = tstack[--tpos]; + if (dir == DIR_LEFT) { + state = balance_left(this); + } else { + state = balance_right(this); + } + } + return q; +} + +static TreeDbTerm *linkout_object_tree(DbTableTree *tb, + Eterm object) +{ + TreeDbTerm **tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 0; + int state = 0; + TreeDbTerm **this = &tb->root; + Sint c; + int dir; + TreeDbTerm *q = NULL; + Eterm key; + + /* + * Somewhat complicated, deletion in an AVL tree, + * The two helpers balance_left and balance_right are used to + * keep the balance. As in insert, we do the stacking ourselves. + */ + + + key = GETKEY(tb, tuple_val(object)); + + reset_static_stack(tb); + dstack[dpos++] = DIR_END; + for (;;) { + if (!*this) { /* Failure */ + return NULL; + } else if ((c = cmp(key,GETKEY(tb,(*this)->dbterm.tpl))) < 0) { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Equal key, found the only possible matching object*/ + if (!eq(object,make_tuple((*this)->dbterm.tpl))) { + return NULL; + } + q = (*this); + if (q->right == NULL) { + (*this) = q->left; + state = 1; + } else if (q->left == NULL) { + (*this) = q->right; + state = 1; + } else { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + state = delsub(this); + } + erts_smp_atomic_dec(&tb->common.nitems); + break; + } + } + while (state && ( dir = dstack[--dpos] ) != DIR_END) { + this = tstack[--tpos]; + if (dir == DIR_LEFT) { + state = balance_left(this); + } else { + state = balance_right(this); + } + } + return q; +} + +/* +** For the select functions, analyzes the pattern and determines which +** part of the tree should be searched. Also compiles the match program +*/ +static int analyze_pattern(DbTableTree *tb, Eterm pattern, + struct mp_info *mpi) +{ + Eterm lst, tpl, ttpl; + Eterm *matches,*guards, *bodies; + Eterm sbuff[30]; + Eterm *buff = sbuff; + Eterm *ptpl; + int i; + int num_heads = 0; + Eterm key; + Eterm partly_bound; + int res; + Eterm least = 0; + Eterm most = 0; + + mpi->some_limitation = 1; + mpi->got_partial = 0; + mpi->something_can_match = 0; + mpi->mp = NULL; + mpi->all_objects = 1; + mpi->save_term = NULL; + + for (lst = pattern; is_list(lst); lst = CDR(list_val(lst))) + ++num_heads; + + if (lst != NIL) {/* proper list... */ + return DB_ERROR_BADPARAM; + } + if (num_heads > 10) { + buff = erts_alloc(ERTS_ALC_T_DB_TMP, sizeof(Eterm) * num_heads * 3); + } + + matches = buff; + guards = buff + num_heads; + bodies = buff + (num_heads * 2); + + i = 0; + for(lst = pattern; is_list(lst); lst = CDR(list_val(lst))) { + Eterm body; + ttpl = CAR(list_val(lst)); + if (!is_tuple(ttpl)) { + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_BADPARAM; + } + ptpl = tuple_val(ttpl); + if (ptpl[0] != make_arityval(3U)) { + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_BADPARAM; + } + matches[i] = tpl = ptpl[1]; + guards[i] = ptpl[2]; + bodies[i] = body = ptpl[3]; + if (!is_list(body) || CDR(list_val(body)) != NIL || + CAR(list_val(body)) != am_DollarUnderscore) { + mpi->all_objects = 0; + } + ++i; + + partly_bound = NIL; + res = key_given(tb, tpl, &mpi->save_term, &partly_bound); + if ( res >= 0 ) { /* Can match something */ + key = 0; + mpi->something_can_match = 1; + if (res > 0) { + key = GETKEY(tb,tuple_val(tpl)); + } else if (partly_bound != NIL) { + mpi->got_partial = 1; + key = partly_bound; + } else { + mpi->some_limitation = 0; + } + if (key != 0) { + if (least == 0 || + partly_bound_can_match_lesser(key,least)) { + least = key; + } + if (most == 0 || + partly_bound_can_match_greater(key,most)) { + most = key; + } + } + } + } + mpi->least = least; + mpi->most = most; + + /* + * It would be nice not to compile the match_spec if nothing could match, + * but then the select calls would not fail like they should on bad + * match specs that happen to specify non existent keys etc. + */ + if ((mpi->mp = db_match_compile(matches, guards, bodies, + num_heads, DCOMP_TABLE, NULL)) + == NULL) { + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_BADPARAM; + } + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return DB_ERROR_NONE; +} + +static void do_dump_tree(int to, void *to_arg, TreeDbTerm *t) +{ + if (t != NULL) { + do_dump_tree(to, to_arg, t->left); + erts_print(to, to_arg, "%T\n", make_tuple(t->dbterm.tpl)); + do_dump_tree(to, to_arg, t->right); + } +} + +static void free_term(DbTableTree *tb, TreeDbTerm* p) +{ + db_free_term_data(&(p->dbterm)); + erts_db_free(ERTS_ALC_T_DB_TERM, + (DbTable *) tb, + (void *) p, + SIZ_DBTERM(p)*sizeof(Uint)); +} + +static int do_free_tree_cont(DbTableTree *tb, int num_left) +{ + TreeDbTerm *root; + TreeDbTerm *p; + + for (;;) { + root = POP_NODE(&tb->static_stack); + if (root == NULL) break; + for (;;) { + if ((p = root->left) != NULL) { + root->left = NULL; + PUSH_NODE(&tb->static_stack, root); + root = p; + } else if ((p = root->right) != NULL) { + root->right = NULL; + PUSH_NODE(&tb->static_stack, root); + root = p; + } else { + free_term(tb, root); + if (--num_left > 0) { + break; + } else { + return 0; /* Done enough for now */ + } + } + } + } + return 1; +} + +static TreeDbTerm* get_term(DbTableTree *tb, + TreeDbTerm* old, + Eterm obj) +{ + TreeDbTerm* p = db_get_term((DbTableCommon *) tb, + (old != NULL) ? &(old->dbterm) : NULL, + ((char *) &(old->dbterm)) - ((char *) old), + obj); + return p; +} + +/* + * Deletion helpers + */ +static int balance_left(TreeDbTerm **this) +{ + TreeDbTerm *p, *p1, *p2; + int b1, b2, h = 1; + + p = *this; + switch (p->balance) { + case -1: + p->balance = 0; + break; + case 0: + p->balance = 1; + h = 0; + break; + case 1: + p1 = p->right; + b1 = p1->balance; + if (b1 >= 0) { /* Single RR rotation */ + p->right = p1->left; + p1->left = p; + if (b1 == 0) { + p->balance = 1; + p1->balance = -1; + h = 0; + } else { + p->balance = p1->balance = 0; + } + (*this) = p1; + } else { /* Double RL rotation */ + p2 = p1->left; + b2 = p2->balance; + p1->left = p2->right; + p2->right = p1; + p->right = p2->left; + p2->left = p; + p->balance = (b2 == 1) ? -1 : 0; + p1->balance = (b2 == -1) ? 1 : 0; + p2->balance = 0; + (*this) = p2; + } + break; + } + return h; +} + +static int balance_right(TreeDbTerm **this) +{ + TreeDbTerm *p, *p1, *p2; + int b1, b2, h = 1; + + p = *this; + switch (p->balance) { + case 1: + p->balance = 0; + break; + case 0: + p->balance = -1; + h = 0; + break; + case -1: + p1 = p->left; + b1 = p1->balance; + if (b1 <= 0) { /* Single LL rotation */ + p->left = p1->right; + p1->right = p; + if (b1 == 0) { + p->balance = -1; + p1->balance = 1; + h = 0; + } else { + p->balance = p1->balance = 0; + } + (*this) = p1; + } else { /* Double LR rotation */ + p2 = p1->right; + b2 = p2->balance; + p1->right = p2->left; + p2->left = p1; + p->left = p2->right; + p2->right = p; + p->balance = (b2 == -1) ? 1 : 0; + p1->balance = (b2 == 1) ? -1 : 0; + p2->balance = 0; + (*this) = p2; + } + } + return h; +} + +static int delsub(TreeDbTerm **this) +{ + TreeDbTerm **tstack[STACK_NEED]; + int tpos = 0; + TreeDbTerm *q = (*this); + TreeDbTerm **r = &(q->left); + int h; + + /* + * Walk down the tree to the right and search + * for a void right child, pick that child out + * and return it to be put in the deleted + * object's place. + */ + + while ((*r)->right != NULL) { + tstack[tpos++] = r; + r = &((*r)->right); + } + *this = *r; + *r = (*r)->left; + (*this)->left = q->left; + (*this)->right = q->right; + (*this)->balance = q->balance; + tstack[0] = &((*this)->left); + h = 1; + while (tpos && h) { + r = tstack[--tpos]; + h = balance_right(r); + } + return h; +} + +/* + * Helper for db_slot + */ + +static TreeDbTerm *slot_search(Process *p, DbTableTree *tb, Sint slot) +{ + TreeDbTerm *this; + TreeDbTerm *tmp; + DbTreeStack* stack = get_any_stack(tb); + ASSERT(stack != NULL); + + if (slot == 1) { /* Don't search from where we are if we are + looking for the first slot */ + stack->slot = 0; + } + + if (stack->slot == 0) { /* clear stack if slot positions + are not recorded */ + stack->pos = 0; + } + if (EMPTY_NODE(stack)) { + this = tb->root; + if (this == NULL) + goto done; + while (this->left != NULL){ + PUSH_NODE(stack, this); + this = this->left; + } + PUSH_NODE(stack, this); + stack->slot = 1; + } + this = TOP_NODE(stack); + while (stack->slot != slot && this != NULL) { + if (slot > stack->slot) { + if (this->right != NULL) { + this = this->right; + while (this->left != NULL) { + PUSH_NODE(stack, this); + this = this->left; + } + PUSH_NODE(stack, this); + } else { + for (;;) { + tmp = POP_NODE(stack); + this = TOP_NODE(stack); + if (this == NULL || this->left == tmp) + break; + } + } + ++(stack->slot); + } else { + if (this->left != NULL) { + this = this->left; + while (this->right != NULL) { + PUSH_NODE(stack, this); + this = this->right; + } + PUSH_NODE(stack, this); + } else { + for (;;) { + tmp = POP_NODE(stack); + this = TOP_NODE(stack); + if (this == NULL || this->right == tmp) + break; + } + } + --(stack->slot); + } + } +done: + release_stack(tb,stack); + return this; +} + +/* + * Find next and previous in sort order + */ + +static TreeDbTerm *find_next(DbTableTree *tb, DbTreeStack* stack, Eterm key) +{ + TreeDbTerm *this; + TreeDbTerm *tmp; + Sint c; + + if(( this = TOP_NODE(stack)) != NULL) { + if (!CMP_EQ(GETKEY(tb, this->dbterm.tpl),key)) { + /* Start from the beginning */ + stack->pos = stack->slot = 0; + } + } + if (EMPTY_NODE(stack)) { /* Have to rebuild the stack */ + if (( this = tb->root ) == NULL) + return NULL; + for (;;) { + PUSH_NODE(stack, this); + if (( c = cmp(GETKEY(tb, this->dbterm.tpl),key) ) < 0) { + if (this->right == NULL) /* We are at the previos + and the element does + not exist */ + break; + else + this = this->right; + } else if (c > 0) { + if (this->left == NULL) /* Done */ + return this; + else + this = this->left; + } else + break; + } + } + /* The next element from this... */ + if (this->right != NULL) { + this = this->right; + PUSH_NODE(stack,this); + while (this->left != NULL) { + this = this->left; + PUSH_NODE(stack, this); + } + if (stack->slot > 0) + ++(stack->slot); + } else { + do { + tmp = POP_NODE(stack); + if (( this = TOP_NODE(stack)) == NULL) { + stack->slot = 0; + return NULL; + } + } while (this->right == tmp); + if (stack->slot > 0) + ++(stack->slot); + } + return this; +} + +static TreeDbTerm *find_prev(DbTableTree *tb, DbTreeStack* stack, Eterm key) +{ + TreeDbTerm *this; + TreeDbTerm *tmp; + Sint c; + + if(( this = TOP_NODE(stack)) != NULL) { + if (!CMP_EQ(GETKEY(tb, this->dbterm.tpl),key)) { + /* Start from the beginning */ + stack->pos = stack->slot = 0; + } + } + if (EMPTY_NODE(stack)) { /* Have to rebuild the stack */ + if (( this = tb->root ) == NULL) + return NULL; + for (;;) { + PUSH_NODE(stack, this); + if (( c = cmp(GETKEY(tb, this->dbterm.tpl),key) ) > 0) { + if (this->left == NULL) /* We are at the next + and the element does + not exist */ + break; + else + this = this->left; + } else if (c < 0) { + if (this->right == NULL) /* Done */ + return this; + else + this = this->right; + } else + break; + } + } + /* The previous element from this... */ + if (this->left != NULL) { + this = this->left; + PUSH_NODE(stack,this); + while (this->right != NULL) { + this = this->right; + PUSH_NODE(stack, this); + } + if (stack->slot > 0) + --(stack->slot); + } else { + do { + tmp = POP_NODE(stack); + if (( this = TOP_NODE(stack)) == NULL) { + stack->slot = 0; + return NULL; + } + } while (this->left == tmp); + if (stack->slot > 0) + --(stack->slot); + } + return this; +} + +static TreeDbTerm *find_next_from_pb_key(DbTableTree *tb, DbTreeStack* stack, + Eterm key) +{ + TreeDbTerm *this; + TreeDbTerm *tmp; + Sint c; + + /* spool the stack, we have to "re-search" */ + stack->pos = stack->slot = 0; + if (( this = tb->root ) == NULL) + return NULL; + for (;;) { + PUSH_NODE(stack, this); + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl)) ) >= 0) { + if (this->right == NULL) { + do { + tmp = POP_NODE(stack); + if (( this = TOP_NODE(stack)) == NULL) { + return NULL; + } + } while (this->right == tmp); + return this; + } else + this = this->right; + } else /*if (c < 0)*/ { + if (this->left == NULL) /* Done */ + return this; + else + this = this->left; + } + } +} + +static TreeDbTerm *find_prev_from_pb_key(DbTableTree *tb, DbTreeStack* stack, + Eterm key) +{ + TreeDbTerm *this; + TreeDbTerm *tmp; + Sint c; + + /* spool the stack, we have to "re-search" */ + stack->pos = stack->slot = 0; + if (( this = tb->root ) == NULL) + return NULL; + for (;;) { + PUSH_NODE(stack, this); + if (( c = cmp_partly_bound(key,GETKEY(tb, this->dbterm.tpl)) ) <= 0) { + if (this->left == NULL) { + do { + tmp = POP_NODE(stack); + if (( this = TOP_NODE(stack)) == NULL) { + return NULL; + } + } while (this->left == tmp); + return this; + } else + this = this->left; + } else /*if (c < 0)*/ { + if (this->right == NULL) /* Done */ + return this; + else + this = this->right; + } + } +} + + +/* + * Just lookup a node + */ +static TreeDbTerm *find_node(DbTableTree *tb, Eterm key) +{ + TreeDbTerm *this; + Sint res; + DbTreeStack* stack = get_static_stack(tb); + + if(!stack || EMPTY_NODE(stack) + || !CMP_EQ(GETKEY(tb, ( this = TOP_NODE(stack) )->dbterm.tpl), key)) { + + this = tb->root; + while (this != NULL && + ( res = cmp(key, GETKEY(tb, this->dbterm.tpl)) ) != 0) { + if (res < 0) + this = this->left; + else + this = this->right; + } + } + release_stack(tb,stack); + return this; +} + +/* + * Lookup a node and return the address of the node pointer in the tree + */ +static TreeDbTerm **find_node2(DbTableTree *tb, Eterm key) +{ + TreeDbTerm **this; + Sint res; + + this = &tb->root; + while ((*this) != NULL && + ( res = cmp(key, GETKEY(tb, (*this)->dbterm.tpl)) ) != 0) { + if (res < 0) + this = &((*this)->left); + else + this = &((*this)->right); + } + if (*this == NULL) + return NULL; + return this; +} + +static int db_lookup_dbterm_tree(DbTable *tbl, Eterm key, DbUpdateHandle* handle) +{ + DbTableTree *tb = &tbl->tree; + TreeDbTerm **pp = find_node2(tb, key); + + if (pp == NULL) return 0; + + handle->tb = tbl; + handle->dbterm = &(*pp)->dbterm; + handle->bp = (void**) pp; + handle->new_size = (*pp)->dbterm.size; + handle->mustResize = 0; + return 1; +} + +static void db_finalize_dbterm_tree(DbUpdateHandle* handle) +{ + if (handle->mustResize) { + Eterm* top; + Eterm copy; + DbTerm* newDbTerm; + DbTableTree *tb = &handle->tb->tree; + TreeDbTerm* oldp = (TreeDbTerm*) *handle->bp; + TreeDbTerm* newp = erts_db_alloc(ERTS_ALC_T_DB_TERM, + handle->tb, + sizeof(TreeDbTerm)+sizeof(Eterm)*(handle->new_size-1)); + memcpy(newp, oldp, sizeof(TreeDbTerm)-sizeof(DbTerm)); /* copy only tree header */ + *(handle->bp) = newp; + reset_static_stack(tb); + newDbTerm = &newp->dbterm; + + newDbTerm->size = handle->new_size; + newDbTerm->off_heap.mso = NULL; + newDbTerm->off_heap.externals = NULL; + #ifndef HYBRID /* FIND ME! */ + newDbTerm->off_heap.funs = NULL; + #endif + newDbTerm->off_heap.overhead = 0; + + /* make a flat copy */ + top = DBTERM_BUF(newDbTerm); + copy = copy_struct(make_tuple(handle->dbterm->tpl), + handle->new_size, + &top, &newDbTerm->off_heap); + DBTERM_SET_TPL(newDbTerm,tuple_val(copy)); + + db_free_term_data(handle->dbterm); + erts_db_free(ERTS_ALC_T_DB_TERM, + handle->tb, + (void *) (((char *) handle->dbterm) - (sizeof(TreeDbTerm) - sizeof(DbTerm))), + sizeof(TreeDbTerm) + sizeof(Eterm)*(handle->dbterm->size-1)); + } +#ifdef DEBUG + handle->dbterm = 0; +#endif + return; +} + +/* + * Traverse the tree with a callback function, used by db_match_xxx + */ +static void traverse_backwards(DbTableTree *tb, + DbTreeStack* stack, + Eterm lastkey, + int (*doit)(DbTableTree *, + TreeDbTerm *, + void *, + int), + void *context) +{ + TreeDbTerm *this, *next; + + if (lastkey == NIL) { + stack->pos = stack->slot = 0; + if (( this = tb->root ) == NULL) { + return; + } + while (this != NULL) { + PUSH_NODE(stack, this); + this = this->right; + } + this = TOP_NODE(stack); + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); + if (!((*doit)(tb, this, context, 0))) + return; + } else { + next = find_prev(tb, stack, lastkey); + } + + while ((this = next) != NULL) { + next = find_prev(tb, stack, GETKEY(tb, this->dbterm.tpl)); + if (!((*doit)(tb, this, context, 0))) + return; + } +} + +/* + * Traverse the tree with a callback function, used by db_match_xxx + */ +static void traverse_forward(DbTableTree *tb, + DbTreeStack* stack, + Eterm lastkey, + int (*doit)(DbTableTree *, + TreeDbTerm *, + void *, + int), + void *context) +{ + TreeDbTerm *this, *next; + + if (lastkey == NIL) { + stack->pos = stack->slot = 0; + if (( this = tb->root ) == NULL) { + return; + } + while (this != NULL) { + PUSH_NODE(stack, this); + this = this->left; + } + this = TOP_NODE(stack); + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); + if (!((*doit)(tb, this, context, 1))) + return; + } else { + next = find_next(tb, stack, lastkey); + } + + while ((this = next) != NULL) { + next = find_next(tb, stack, GETKEY(tb, this->dbterm.tpl)); + if (!((*doit)(tb, this, context, 1))) + return; + } +} + +/* + * Returns 0 if not given 1 if given and -1 on no possible match + * if key is given; *ret is set to point to the object concerned. + */ +static int key_given(DbTableTree *tb, Eterm pattern, TreeDbTerm **ret, + Eterm *partly_bound) +{ + TreeDbTerm *this; + Eterm key; + + ASSERT(ret != NULL); + if (pattern == am_Underscore || db_is_variable(pattern) != -1) + return 0; + key = db_getkey(tb->common.keypos, pattern); + if (is_non_value(key)) + return -1; /* can't possibly match anything */ + if (!db_has_variable(key)) { /* Bound key */ + if (( this = find_node(tb, key) ) == NULL) { + return -1; + } + *ret = this; + return 1; + } else if (partly_bound != NULL && key != am_Underscore && + db_is_variable(key) < 0) + *partly_bound = key; + + return 0; +} + + + +static Sint do_cmp_partly_bound(Eterm a, Eterm b, int *done) +{ + Eterm* aa; + Eterm* bb; + Eterm a_hdr; + Eterm b_hdr; + int i; + Sint j; + + /* A variable matches anything */ + if (is_atom(a) && (a == am_Underscore || (db_is_variable(a) >= 0))) { + *done = 1; + return 0; + } + if (a == b) + return 0; + + switch (a & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: + if (!is_list(b)) { + return cmp(a,b); + } + aa = list_val(a); + bb = list_val(b); + while (1) { + if ((j = do_cmp_partly_bound(*aa++, *bb++, done)) != 0 || *done) + return j; + if (*aa==*bb) + return 0; + if (is_not_list(*aa) || is_not_list(*bb)) + return do_cmp_partly_bound(*aa, *bb, done); + aa = list_val(*aa); + bb = list_val(*bb); + } + case TAG_PRIMARY_BOXED: + if ((b & _TAG_PRIMARY_MASK) != TAG_PRIMARY_BOXED) { + return cmp(a,b); + } + a_hdr = ((*boxed_val(a)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; + b_hdr = ((*boxed_val(b)) & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE; + if (a_hdr != b_hdr) { + return cmp(a, b); + } + if (a_hdr == (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) { + aa = tuple_val(a); + bb = tuple_val(b); + /* compare the arities */ + i = arityval(*aa); /* get the arity*/ + if (i < arityval(*bb)) return(-1); + if (i > arityval(*bb)) return(1); + while (i--) { + if ((j = do_cmp_partly_bound(*++aa, *++bb, done)) != 0 + || *done) + return j; + } + return 0; + } + /* Drop through */ + default: + return cmp(a, b); + } +} + +static Sint cmp_partly_bound(Eterm partly_bound_key, Eterm bound_key) +{ + int done = 0; + Sint ret = do_cmp_partly_bound(partly_bound_key, bound_key, &done); +#ifdef HARDDEBUG + erts_fprintf(stderr,"\ncmp_partly_bound: %T", partly_bound_key); + if (ret < 0) + erts_fprintf(stderr," < "); + else if (ret > 0) + erts_fprintf(stderr," > "); + else + erts_fprintf(stderr," == "); + erts_fprintf(stderr,"%T\n",bound_key); +#endif + return ret; +} + +/* +** For partly_bound debugging.... +** +BIF_RETTYPE ets_testnisse_2(BIF_ALIST_2) +BIF_ADECL_2 +{ + Eterm r1 = make_small(partly_bound_can_match_lesser(BIF_ARG_1, + BIF_ARG_2)); + Eterm r2 = make_small(partly_bound_can_match_greater(BIF_ARG_1, + BIF_ARG_2)); + Eterm *hp = HAlloc(BIF_P,3); + Eterm ret; + + ret = TUPLE2(hp,r1,r2); + BIF_RET(ret); +} +** +*/ +static int partly_bound_can_match_lesser(Eterm partly_bound_1, + Eterm partly_bound_2) +{ + int done = 0; + int ret = do_partly_bound_can_match_lesser(partly_bound_1, + partly_bound_2, + &done); +#ifdef HARDDEBUG + erts_fprintf(stderr,"\npartly_bound_can_match_lesser: %T",partly_bound_1); + if (ret) + erts_fprintf(stderr," can match lesser than "); + else + erts_fprintf(stderr," can not match lesser than "); + erts_fprintf(stderr,"%T\n",partly_bound_2); +#endif + return ret; +} + +static int partly_bound_can_match_greater(Eterm partly_bound_1, + Eterm partly_bound_2) +{ + int done = 0; + int ret = do_partly_bound_can_match_greater(partly_bound_1, + partly_bound_2, + &done); +#ifdef HARDDEBUG + erts_fprintf(stderr,"\npartly_bound_can_match_greater: %T",partly_bound_1); + if (ret) + erts_fprintf(stderr," can match greater than "); + else + erts_fprintf(stderr," can not match greater than "); + erts_fprintf(stderr,"%T\n",partly_bound_2); +#endif + return ret; +} + +static int do_partly_bound_can_match_lesser(Eterm a, Eterm b, + int *done) +{ + Eterm* aa; + Eterm* bb; + Sint i; + int j; + + if (is_atom(a) && (a == am_Underscore || + (db_is_variable(a) >= 0))) { + *done = 1; + if (is_atom(b) && (b == am_Underscore || + (db_is_variable(b) >= 0))) { + return 0; + } else { + return 1; + } + } else if (is_atom(b) && (b == am_Underscore || + (db_is_variable(b) >= 0))) { + *done = 1; + return 0; + } + + if (a == b) + return 0; + + if (not_eq_tags(a,b)) { + *done = 1; + return (cmp(a, b) < 0) ? 1 : 0; + } + + /* we now know that tags are the same */ + switch (tag_val_def(a)) { + case TUPLE_DEF: + aa = tuple_val(a); + bb = tuple_val(b); + /* compare the arities */ + if (arityval(*aa) < arityval(*bb)) return 1; + if (arityval(*aa) > arityval(*bb)) return 0; + i = arityval(*aa); /* get the arity*/ + while (i--) { + if ((j = do_partly_bound_can_match_lesser(*++aa, *++bb, + done)) != 0 + || *done) + return j; + } + return 0; + case LIST_DEF: + aa = list_val(a); + bb = list_val(b); + while (1) { + if ((j = do_partly_bound_can_match_lesser(*aa++, *bb++, + done)) != 0 + || *done) + return j; + if (*aa==*bb) + return 0; + if (is_not_list(*aa) || is_not_list(*bb)) + return do_partly_bound_can_match_lesser(*aa, *bb, + done); + aa = list_val(*aa); + bb = list_val(*bb); + } + default: + if((i = cmp(a, b)) != 0) { + *done = 1; + } + return (i < 0) ? 1 : 0; + } +} + +static int do_partly_bound_can_match_greater(Eterm a, Eterm b, + int *done) +{ + Eterm* aa; + Eterm* bb; + Sint i; + int j; + + if (is_atom(a) && (a == am_Underscore || + (db_is_variable(a) >= 0))) { + *done = 1; + if (is_atom(b) && (b == am_Underscore || + (db_is_variable(b) >= 0))) { + return 0; + } else { + return 1; + } + } else if (is_atom(b) && (b == am_Underscore || + (db_is_variable(b) >= 0))) { + *done = 1; + return 0; + } + + if (a == b) + return 0; + + if (not_eq_tags(a,b)) { + *done = 1; + return (cmp(a, b) > 0) ? 1 : 0; + } + + /* we now know that tags are the same */ + switch (tag_val_def(a)) { + case TUPLE_DEF: + aa = tuple_val(a); + bb = tuple_val(b); + /* compare the arities */ + if (arityval(*aa) < arityval(*bb)) return 0; + if (arityval(*aa) > arityval(*bb)) return 1; + i = arityval(*aa); /* get the arity*/ + while (i--) { + if ((j = do_partly_bound_can_match_greater(*++aa, *++bb, + done)) != 0 + || *done) + return j; + } + return 0; + case LIST_DEF: + aa = list_val(a); + bb = list_val(b); + while (1) { + if ((j = do_partly_bound_can_match_greater(*aa++, *bb++, + done)) != 0 + || *done) + return j; + if (*aa==*bb) + return 0; + if (is_not_list(*aa) || is_not_list(*bb)) + return do_partly_bound_can_match_greater(*aa, *bb, + done); + aa = list_val(*aa); + bb = list_val(*bb); + } + default: + if((i = cmp(a, b)) != 0) { + *done = 1; + } + return (i > 0) ? 1 : 0; + } +} + +/* + * Callback functions for the different match functions + */ + +static int doit_select(DbTableTree *tb, TreeDbTerm *this, void *ptr, + int forward) +{ + struct select_context *sc = (struct select_context *) ptr; + Eterm ret; + Uint32 dummy; + + sc->lastobj = this->dbterm.tpl; + + if (sc->end_condition != NIL && + ((forward && + cmp_partly_bound(sc->end_condition, + GETKEY_WITH_POS(sc->keypos, + this->dbterm.tpl)) < 0) || + (!forward && + cmp_partly_bound(sc->end_condition, + GETKEY_WITH_POS(sc->keypos, + this->dbterm.tpl)) > 0))) { + return 0; + } + ret = db_prog_match(sc->p, sc->mp, + make_tuple(this->dbterm.tpl), + 0, &dummy); + if (is_value(ret)) { + Uint sz; + Eterm *hp; + if (sc->all_objects) { + hp = HAlloc(sc->p, this->dbterm.size + 2); + ret = copy_shallow(DBTERM_BUF(&this->dbterm), + this->dbterm.size, + &hp, + &MSO(sc->p)); + } else { + sz = size_object(ret); + hp = HAlloc(sc->p, sz + 2); + ret = copy_struct(ret, sz, + &hp, &MSO(sc->p)); + } + sc->accum = CONS(hp, ret, sc->accum); + } + if (MBUF(sc->p)) { + /* + * Force a trap and GC if a heap fragment was created. Many heap fragments + * make the GC slow. + */ + sc->max = 0; + } + if (--(sc->max) <= 0) { + return 0; + } + return 1; +} + +static int doit_select_count(DbTableTree *tb, TreeDbTerm *this, void *ptr, + int forward) +{ + struct select_count_context *sc = (struct select_count_context *) ptr; + Eterm ret; + Uint32 dummy; + + sc->lastobj = this->dbterm.tpl; + + /* Always backwards traversing */ + if (sc->end_condition != NIL && + (cmp_partly_bound(sc->end_condition, + GETKEY_WITH_POS(sc->keypos, + this->dbterm.tpl)) > 0)) { + return 0; + } + ret = db_prog_match(sc->p, sc->mp, + make_tuple(this->dbterm.tpl), + 0, &dummy); + if (ret == am_true) { + ++(sc->got); + } + if (--(sc->max) <= 0) { + return 0; + } + return 1; +} + +static int doit_select_chunk(DbTableTree *tb, TreeDbTerm *this, void *ptr, + int forward) +{ + struct select_context *sc = (struct select_context *) ptr; + Eterm ret; + Uint32 dummy; + + sc->lastobj = this->dbterm.tpl; + + if (sc->end_condition != NIL && + ((forward && + cmp_partly_bound(sc->end_condition, + GETKEY_WITH_POS(sc->keypos, + this->dbterm.tpl)) < 0) || + (!forward && + cmp_partly_bound(sc->end_condition, + GETKEY_WITH_POS(sc->keypos, + this->dbterm.tpl)) > 0))) { + return 0; + } + + ret = db_prog_match(sc->p, sc->mp, + make_tuple(this->dbterm.tpl), + 0, &dummy); + if (is_value(ret)) { + Uint sz; + Eterm *hp; + + ++(sc->got); + if (sc->all_objects) { + hp = HAlloc(sc->p, this->dbterm.size + 2); + ret = copy_shallow(DBTERM_BUF(&this->dbterm), + this->dbterm.size, + &hp, + &MSO(sc->p)); + } else { + sz = size_object(ret); + hp = HAlloc(sc->p, sz + 2); + ret = copy_struct(ret, sz, &hp, &MSO(sc->p)); + } + sc->accum = CONS(hp, ret, sc->accum); + } + if (MBUF(sc->p)) { + /* + * Force a trap and GC if a heap fragment was created. Many heap fragments + * make the GC slow. + */ + sc->max = 0; + } + if (--(sc->max) <= 0 || sc->got == sc->chunk_size) { + return 0; + } + return 1; +} + + +static int doit_select_delete(DbTableTree *tb, TreeDbTerm *this, void *ptr, + int forward) +{ + struct select_delete_context *sc = (struct select_delete_context *) ptr; + Eterm ret; + Uint32 dummy; + Eterm key; + + if (sc->erase_lastterm) + free_term(tb, sc->lastterm); + sc->erase_lastterm = 0; + sc->lastterm = this; + + if (sc->end_condition != NIL && + cmp_partly_bound(sc->end_condition, + GETKEY_WITH_POS(sc->keypos, + this->dbterm.tpl)) > 0) + return 0; + ret = db_prog_match(sc->p, sc->mp, + make_tuple(this->dbterm.tpl), + 0, &dummy); + if (ret == am_true) { + key = GETKEY(sc->tb, this->dbterm.tpl); + linkout_tree(sc->tb, key); + sc->erase_lastterm = 1; + ++sc->accum; + } + if (--(sc->max) <= 0) { + return 0; + } + return 1; +} + +#ifdef TREE_DEBUG +static void do_dump_tree2(int to, void *to_arg, int show, TreeDbTerm *t, + int offset) +{ + if (t == NULL) + return 0; + do_dump_tree2(to, to_arg, show, t->right, offset + 4); + if (show) { + erts_print(to, to_arg, "%*s%T (addr = %p, bal = %d)\n" + offset, "", make_tuple(t->dbterm.tpl), + t, t->balance); + } + do_dump_tree2(to, to_arg, show, t->left, offset + 4); + return sum; +} + +#endif + +#ifdef HARDDEBUG + +void db_check_table_tree(DbTable *tbl) +{ + DbTableTree *tb = &tbl->tree; + check_table_tree(tb->root); + check_saved_stack(tb); + check_slot_pos(tb); +} + +static TreeDbTerm *traverse_until(TreeDbTerm *t, int *current, int to) +{ + TreeDbTerm *tmp; + if (t == NULL) + return NULL; + tmp = traverse_until(t->left, current, to); + if (tmp != NULL) + return tmp; + ++(*current); + if (*current == to) + return t; + return traverse_until(t->right, current, to); +} + +static void check_slot_pos(DbTableTree *tb) +{ + int pos = 0; + TreeDbTerm *t; + if (tb->stack.slot == 0 || tb->stack.pos == 0) + return; + t = traverse_until(tb->root, &pos, tb->stack.slot); + if (t != tb->stack.array[tb->stack.pos - 1]) { + erts_fprintf(stderr, "Slot position does not correspont with stack, " + "element position %d is really 0x%08X, when stack says " + "it's 0x%08X\n", tb->stack.slot, t, + tb->stack.array[tb->stack.pos - 1]); + do_dump_tree2(ERTS_PRINT_STDERR, NULL, 1, tb->root, 0); + } +} + + +static void check_saved_stack(DbTableTree *tb) +{ + TreeDbTerm *t = tb->root; + DbTreeStack* stack = &tb->static_stack; + int n = 0; + if (stack->pos == 0) + return; + if (t != stack->array[0]) { + erts_fprintf(stderr,"tb->stack[0] is 0x%08X, should be 0x%08X\n", + stack->array[0], t); + do_dump_tree2(ERTS_PRINT_STDERR, NULL, 1, tb->root, 0); + return; + } + while (n < stack->pos) { + if (t == NULL) { + erts_fprintf(stderr, "NULL pointer in tree when stack not empty," + " stack depth is %d\n", n); + do_dump_tree2(ERTS_PRINT_STDERR, NULL, 1, tb->root, 0); + return; + } + n++; + if (n < stack->pos) { + if (stack->array[n] == t->left) + t = t->left; + else if (stack->array[n] == t->right) + t = t->right; + else { + erts_fprintf(stderr, "tb->stack[%d] == 0x%08X does not " + "represent child pointer in tree!" + "(left == 0x%08X, right == 0x%08X\n", + n, tb->stack[n], t->left, t->right); + do_dump_tree2(ERTS_PRINT_STDERR, NULL, 1, tb->root, 0); + return; + } + } + } +} + +static int check_table_tree(TreeDbTerm *t) +{ + int lh, rh; + if (t == NULL) + return 0; + lh = check_table_tree(t->left); + rh = check_table_tree(t->right); + if ((rh - lh) != t->balance) { + erts_fprintf(stderr, "Invalid tree balance for this node:\n"); + erts_fprintf(stderr,"balance = %d, left = 0x%08X, right = 0x%08X\n" + "data = %T", + t->balance, t->left, t->right, + make_tuple(t->dbterm.tpl)); + erts_fprintf(stderr,"\nDump:\n---------------------------------\n"); + do_dump_tree2(ERTS_PRINT_STDERR, NULL, 1, t, 0); + erts_fprintf(stderr,"\n---------------------------------\n"); + } + return ((rh > lh) ? rh : lh) + 1; +} + +#endif diff --git a/erts/emulator/beam/erl_db_tree.h b/erts/emulator/beam/erl_db_tree.h new file mode 100644 index 0000000000..7bc235e135 --- /dev/null +++ b/erts/emulator/beam/erl_db_tree.h @@ -0,0 +1,55 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef _DB_TREE_H +#define _DB_TREE_H + +#include "erl_db_util.h" + +typedef struct tree_db_term { + struct tree_db_term *left, *right; /* left and right child */ + int balance; /* tree balancing value */ + DbTerm dbterm; /* The actual term */ +} TreeDbTerm; + +typedef struct { + Uint pos; /* Current position on stack */ + Uint slot; /* "Slot number" of top element or 0 if not set */ + TreeDbTerm** array; /* The stack */ +} DbTreeStack; + +typedef struct db_table_tree { + DbTableCommon common; + + /* Tree-specific fields */ + TreeDbTerm *root; /* The tree root */ + Uint deletion; /* Being deleted */ + erts_smp_atomic_t is_stack_busy; + DbTreeStack static_stack; +} DbTableTree; + +/* +** Function prototypes, looks the same (except the suffix) for all +** table types. The process is always an [in out] parameter. +*/ +void db_initialize_tree(void); + +int db_create_tree(Process *p, DbTable *tbl); + +#endif /* _DB_TREE_H */ diff --git a/erts/emulator/beam/erl_db_util.c b/erts/emulator/beam/erl_db_util.c new file mode 100644 index 0000000000..8c373451fd --- /dev/null +++ b/erts/emulator/beam/erl_db_util.c @@ -0,0 +1,4651 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Common utilities for the different types of db tables. + * Mostly matching etc. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#define ERTS_WANT_DB_INTERNAL__ +#include "erl_db.h" +#include "bif.h" +#include "big.h" +#include "erl_binary.h" + +#include "erl_db_util.h" + + +/* +** Flags for the guard bif's +*/ + +/* These are offsets from the DCOMP_* value */ +#define DBIF_GUARD 1 +#define DBIF_BODY 0 + +/* These are the DBIF flag bits corresponding to the DCOMP_* value. + * If a bit is set, the BIF is allowed in that context. */ +#define DBIF_TABLE_GUARD (1 << (DCOMP_TABLE + DBIF_GUARD)) +#define DBIF_TABLE_BODY (1 << (DCOMP_TABLE + DBIF_BODY)) +#define DBIF_TRACE_GUARD (1 << (DCOMP_TRACE + DBIF_GUARD)) +#define DBIF_TRACE_BODY (1 << (DCOMP_TRACE + DBIF_BODY)) +#define DBIF_ALL \ +DBIF_TABLE_GUARD | DBIF_TABLE_BODY | DBIF_TRACE_GUARD | DBIF_TRACE_BODY + + + +/* +** Some convenience macros for stacks (DMC == db_match_compile) +*/ + +#define DMC_DEFAULT_SIZE 25 + +#define DMC_STACK_TYPE(Type) DMC_##Type##_stack + +#define DMC_DECLARE_STACK_TYPE(Type) \ +typedef struct DMC_STACK_TYPE(Type) { \ + int pos; \ + int siz; \ + Type def[DMC_DEFAULT_SIZE]; \ + Type *data; \ +} DMC_STACK_TYPE(Type) + +#define DMC_INIT_STACK(Name) \ + (Name).pos = 0; (Name).siz = DMC_DEFAULT_SIZE; (Name).data = (Name).def + +#define DMC_STACK_DATA(Name) (Name).data + +#define DMC_STACK_NUM(Name) (Name).pos + +#define DMC_PUSH(On, What) \ +do { \ + if ((On).pos >= (On).siz) { \ + (On).siz *= 2; \ + (On).data \ + = (((On).def == (On).data) \ + ? memcpy(erts_alloc(ERTS_ALC_T_DB_MC_STK, \ + (On).siz*sizeof(*((On).data))), \ + (On).def, \ + DMC_DEFAULT_SIZE*sizeof(*((On).data))) \ + : erts_realloc(ERTS_ALC_T_DB_MC_STK, \ + (void *) (On).data, \ + (On).siz*sizeof(*((On).data)))); \ + } \ + (On).data[(On).pos++] = What; \ +} while (0) + +#define DMC_POP(From) (From).data[--(From).pos] + +#define DMC_TOP(From) (From).data[(From).pos - 1] + +#define DMC_EMPTY(Name) ((Name).pos == 0) + +#define DMC_PEEK(On, At) (On).data[At] + +#define DMC_POKE(On, At, Value) ((On).data[At] = (Value)) + +#define DMC_CLEAR(Name) (Name).pos = 0 + +#define DMC_FREE(Name) \ +do { \ + if ((Name).def != (Name).data) \ + erts_free(ERTS_ALC_T_DB_MC_STK, (Name).data); \ +} while (0) + +static ERTS_INLINE Process * +get_proc(Process *cp, Uint32 cp_locks, Eterm id, Uint32 id_locks) +{ + Process *proc = erts_pid2proc(cp, cp_locks, id, id_locks); + if (!proc && is_atom(id)) + proc = erts_whereis_process(cp, cp_locks, id, id_locks, 0); + return proc; +} + + +static Eterm +set_tracee_flags(Process *tracee_p, Eterm tracer, Uint d_flags, Uint e_flags) { + Eterm ret; + Uint flags; + + if (tracer == NIL) { + flags = tracee_p->trace_flags & ~TRACEE_FLAGS; + } else { + flags = ((tracee_p->trace_flags & ~d_flags) | e_flags); + if (! flags) tracer = NIL; + } + ret = tracee_p->tracer_proc != tracer || tracee_p->trace_flags != flags + ? am_true : am_false; + tracee_p->tracer_proc = tracer; + tracee_p->trace_flags = flags; + return ret; +} +/* +** Assuming all locks on tracee_p on entry +** +** Changes tracee_p->trace_flags and tracee_p->tracer_proc +** according to input disable/enable flags and tracer. +** +** Returns am_true|am_false on success, am_true if value changed, +** returns fail_term on failure. Fails if tracer pid or port is invalid. +*/ +static Eterm +set_match_trace(Process *tracee_p, Eterm fail_term, Eterm tracer, + Uint d_flags, Uint e_flags) { + Eterm ret = fail_term; + Process *tracer_p; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCKS_ALL == + erts_proc_lc_my_proc_locks(tracee_p)); + + if (is_internal_pid(tracer) + && (tracer_p = + erts_pid2proc(tracee_p, ERTS_PROC_LOCKS_ALL, + tracer, ERTS_PROC_LOCKS_ALL))) { + if (tracee_p != tracer_p) { + ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); + tracer_p->trace_flags |= tracee_p->trace_flags ? F_TRACER : 0; + erts_smp_proc_unlock(tracer_p, ERTS_PROC_LOCKS_ALL); + } + } else if (is_internal_port(tracer)) { + Port *tracer_port = + erts_id2port(tracer, tracee_p, ERTS_PROC_LOCKS_ALL); + if (tracer_port) { + if (! INVALID_TRACER_PORT(tracer_port, tracer)) { + ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); + } + erts_smp_port_unlock(tracer_port); + } + } else { + ASSERT(is_nil(tracer)); + ret = set_tracee_flags(tracee_p, tracer, d_flags, e_flags); + } + return ret; +} + + +/* Type checking... */ + +#define BOXED_IS_TUPLE(Boxed) is_arity_value(*boxed_val((Boxed))) + +/* +** +** Types and enum's (compiled matches) +** +*/ + +/* +** match VM instructions +*/ +typedef enum { + matchArray, /* Only when parameter is an array (DCOMP_TRACE) */ + matchArrayBind, /* ------------- " ------------ */ + matchTuple, + matchPushT, + matchPushL, + matchPop, + matchBind, + matchCmp, + matchEqBin, + matchEqFloat, + matchEqBig, + matchEqRef, + matchEq, + matchList, + matchSkip, + matchPushC, + matchConsA, /* Car is below Cdr */ + matchConsB, /* Cdr is below Car (unusual) */ + matchMkTuple, + matchCall0, + matchCall1, + matchCall2, + matchCall3, + matchPushV, + matchPushExpr, /* Push the whole expression we're matching ('$_') */ + matchPushArrayAsList, /* Only when parameter is an Array and + not an erlang term (DCOMP_TRACE) */ + matchPushArrayAsListU, /* As above but unknown size */ + matchTrue, + matchOr, + matchAnd, + matchOrElse, + matchAndAlso, + matchJump, + matchSelf, + matchWaste, + matchReturn, + matchProcessDump, + matchDisplay, + matchIsSeqTrace, + matchSetSeqToken, + matchGetSeqToken, + matchSetReturnTrace, + matchSetExceptionTrace, + matchCatch, + matchEnableTrace, + matchDisableTrace, + matchEnableTrace2, + matchDisableTrace2, + matchTryMeElse, + matchCaller, + matchHalt, + matchSilent, + matchSetSeqTokenFake, + matchTrace2, + matchTrace3 +} MatchOps; + +/* +** Guard bif's +*/ + +typedef struct dmc_guard_bif { + Eterm name; /* atom */ + void *biff; + /* BIF_RETTYPE (*biff)(); */ + int arity; + Uint32 flags; +} DMCGuardBif; + +/* +** Error information (for lint) +*/ + +/* +** Type declarations for stacks +*/ +DMC_DECLARE_STACK_TYPE(Eterm); + +DMC_DECLARE_STACK_TYPE(Uint); + +DMC_DECLARE_STACK_TYPE(unsigned); + +/* +** Data about the heap during compilation +*/ + +typedef struct DMCHeap { + int size; + unsigned def[DMC_DEFAULT_SIZE]; + unsigned *data; + int used; +} DMCHeap; + +/* +** Return values from sub compilation steps (guard compilation) +*/ + +typedef enum dmc_ret { + retOk, + retFail, + retRestart +} DMCRet; + +/* +** Diverse context information +*/ + +typedef struct dmc_context { + int stack_need; + int stack_used; + ErlHeapFragment *save; + ErlHeapFragment *copy; + Eterm *matchexpr; + Eterm *guardexpr; + Eterm *bodyexpr; + int num_match; + int current_match; + int eheap_need; + Uint cflags; + int is_guard; /* 1 if in guard, 0 if in body */ + int special; /* 1 if the head in the match was a single expression */ + DMCErrInfo *err_info; +} DMCContext; + +/* +** +** Global variables +** +*/ + +/* +** Internal +*/ + +/* +** The pseudo process used by the VM (pam). +*/ + +#define ERTS_DEFAULT_MS_HEAP_SIZE 128 + +typedef struct { + Process process; + Eterm *heap; + Eterm default_heap[ERTS_DEFAULT_MS_HEAP_SIZE]; +} ErtsMatchPseudoProcess; + + +#ifdef ERTS_SMP +static erts_smp_tsd_key_t match_pseudo_process_key; +#else +static ErtsMatchPseudoProcess *match_pseudo_process; +#endif + +static ERTS_INLINE void +cleanup_match_pseudo_process(ErtsMatchPseudoProcess *mpsp, int keep_heap) +{ + if (mpsp->process.mbuf + || mpsp->process.off_heap.mso +#ifndef HYBRID /* FIND ME! */ + || mpsp->process.off_heap.funs +#endif + || mpsp->process.off_heap.externals) { + erts_cleanup_empty_process(&mpsp->process); + } +#ifdef DEBUG + else { + erts_debug_verify_clean_empty_process(&mpsp->process); + } +#endif + if (!keep_heap) { + if (mpsp->heap != &mpsp->default_heap[0]) { + /* Have to be done *after* call to erts_cleanup_empty_process() */ + erts_free(ERTS_ALC_T_DB_MS_RUN_HEAP, (void *) mpsp->heap); + mpsp->heap = &mpsp->default_heap[0]; + } +#ifdef DEBUG + else { + int i; + for (i = 0; i < ERTS_DEFAULT_MS_HEAP_SIZE; i++) { +#ifdef ARCH_64 + mpsp->default_heap[i] = (Eterm) 0xdeadbeefdeadbeef; +#else + mpsp->default_heap[i] = (Eterm) 0xdeadbeef; +#endif + } + } +#endif + } +} + +static ErtsMatchPseudoProcess * +create_match_pseudo_process(void) +{ + ErtsMatchPseudoProcess *mpsp; + mpsp = (ErtsMatchPseudoProcess *)erts_alloc(ERTS_ALC_T_DB_MS_PSDO_PROC, + sizeof(ErtsMatchPseudoProcess)); + erts_init_empty_process(&mpsp->process); + mpsp->heap = &mpsp->default_heap[0]; + return mpsp; +} + +static ERTS_INLINE ErtsMatchPseudoProcess * +get_match_pseudo_process(Process *c_p, Uint heap_size) +{ + ErtsMatchPseudoProcess *mpsp; +#ifdef ERTS_SMP + mpsp = (ErtsMatchPseudoProcess *) c_p->scheduler_data->match_pseudo_process; + if (mpsp) + cleanup_match_pseudo_process(mpsp, 0); + else { + ASSERT(erts_smp_tsd_get(match_pseudo_process_key) == NULL); + mpsp = create_match_pseudo_process(); + c_p->scheduler_data->match_pseudo_process = (void *) mpsp; + erts_smp_tsd_set(match_pseudo_process_key, (void *) mpsp); + } + ASSERT(mpsp == erts_smp_tsd_get(match_pseudo_process_key)); + mpsp->process.scheduler_data = c_p->scheduler_data; +#else + mpsp = match_pseudo_process; + cleanup_match_pseudo_process(mpsp, 0); +#endif + if (heap_size > ERTS_DEFAULT_MS_HEAP_SIZE) + mpsp->heap = (Eterm *) erts_alloc(ERTS_ALC_T_DB_MS_RUN_HEAP, + heap_size*sizeof(Uint)); + else { + ASSERT(mpsp->heap == &mpsp->default_heap[0]); + } + return mpsp; +} + +#ifdef ERTS_SMP +static void +destroy_match_pseudo_process(void) +{ + ErtsMatchPseudoProcess *mpsp; + mpsp = (ErtsMatchPseudoProcess *)erts_smp_tsd_get(match_pseudo_process_key); + if (mpsp) { + cleanup_match_pseudo_process(mpsp, 0); + erts_free(ERTS_ALC_T_DB_MS_PSDO_PROC, (void *) mpsp); + erts_smp_tsd_set(match_pseudo_process_key, (void *) NULL); + } +} +#endif + +static +void +match_pseudo_process_init(void) +{ +#ifdef ERTS_SMP + erts_smp_tsd_key_create(&match_pseudo_process_key); + erts_smp_install_exit_handler(destroy_match_pseudo_process); +#else + match_pseudo_process = create_match_pseudo_process(); +#endif +} + +void +erts_match_set_release_result(Process* c_p) +{ + (void) get_match_pseudo_process(c_p, 0); /* Clean it up */ +} + +/* The trace control word. */ + +static erts_smp_atomic_t trace_control_word; + + +Eterm +erts_ets_copy_object(Eterm obj, Process* to) +{ + Uint size = size_object(obj); + Eterm* hp = HAlloc(to, size); + Eterm res; + + res = copy_struct(obj, size, &hp, &MSO(to)); +#ifdef DEBUG + if (eq(obj, res) == 0) { + erl_exit(1, "copy not equal to source\n"); + } +#endif + return res; +} + +/* This needs to be here, before the bif table... */ + +static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm val); + +/* +** The table of callable bif's, i e guard bif's and +** some special animals that can provide us with trace +** information. This array is sorted on init. +*/ +static DMCGuardBif guard_tab[] = +{ + { + am_is_atom, + &is_atom_1, + 1, + DBIF_ALL + }, + { + am_is_float, + &is_float_1, + 1, + DBIF_ALL + }, + { + am_is_integer, + &is_integer_1, + 1, + DBIF_ALL + }, + { + am_is_list, + &is_list_1, + 1, + DBIF_ALL + }, + { + am_is_number, + &is_number_1, + 1, + DBIF_ALL + }, + { + am_is_pid, + &is_pid_1, + 1, + DBIF_ALL + }, + { + am_is_port, + &is_port_1, + 1, + DBIF_ALL + }, + { + am_is_reference, + &is_reference_1, + 1, + DBIF_ALL + }, + { + am_is_tuple, + &is_tuple_1, + 1, + DBIF_ALL + }, + { + am_is_binary, + &is_binary_1, + 1, + DBIF_ALL + }, + { + am_is_function, + &is_function_1, + 1, + DBIF_ALL + }, + { + am_is_record, + &is_record_3, + 3, + DBIF_ALL + }, + { + am_abs, + &abs_1, + 1, + DBIF_ALL + }, + { + am_element, + &element_2, + 2, + DBIF_ALL + }, + { + am_hd, + &hd_1, + 1, + DBIF_ALL + }, + { + am_length, + &length_1, + 1, + DBIF_ALL + }, + { + am_node, + &node_1, + 1, + DBIF_ALL + }, + { + am_node, + &node_0, + 0, + DBIF_ALL + }, + { + am_round, + &round_1, + 1, + DBIF_ALL + }, + { + am_size, + &size_1, + 1, + DBIF_ALL + }, + { + am_bit_size, + &bit_size_1, + 1, + DBIF_ALL + }, + { + am_tl, + &tl_1, + 1, + DBIF_ALL + }, + { + am_trunc, + &trunc_1, + 1, + DBIF_ALL + }, + { + am_float, + &float_1, + 1, + DBIF_ALL + }, + { + am_Plus, + &splus_1, + 1, + DBIF_ALL + }, + { + am_Minus, + &sminus_1, + 1, + DBIF_ALL + }, + { + am_Plus, + &splus_2, + 2, + DBIF_ALL + }, + { + am_Minus, + &sminus_2, + 2, + DBIF_ALL + }, + { + am_Times, + &stimes_2, + 2, + DBIF_ALL + }, + { + am_Div, + &div_2, + 2, + DBIF_ALL + }, + { + am_div, + &intdiv_2, + 2, + DBIF_ALL + }, + { + am_rem, + &rem_2, + 2, + DBIF_ALL + }, + { + am_band, + &band_2, + 2, + DBIF_ALL + }, + { + am_bor, + &bor_2, + 2, + DBIF_ALL + }, + { + am_bxor, + &bxor_2, + 2, + DBIF_ALL + }, + { + am_bnot, + &bnot_1, + 1, + DBIF_ALL + }, + { + am_bsl, + &bsl_2, + 2, + DBIF_ALL + }, + { + am_bsr, + &bsr_2, + 2, + DBIF_ALL + }, + { + am_Gt, + &sgt_2, + 2, + DBIF_ALL + }, + { + am_Ge, + &sge_2, + 2, + DBIF_ALL + }, + { + am_Lt, + &slt_2, + 2, + DBIF_ALL + }, + { + am_Le, + &sle_2, + 2, + DBIF_ALL + }, + { + am_Eq, + &seq_2, + 2, + DBIF_ALL + }, + { + am_Eqeq, + &seqeq_2, + 2, + DBIF_ALL + }, + { + am_Neq, + &sneq_2, + 2, + DBIF_ALL + }, + { + am_Neqeq, + &sneqeq_2, + 2, + DBIF_ALL + }, + { + am_not, + ¬_1, + 1, + DBIF_ALL + }, + { + am_xor, + &xor_2, + 2, + DBIF_ALL + }, + { + am_get_tcw, + &db_get_trace_control_word_0, + 0, + DBIF_TRACE_GUARD | DBIF_TRACE_BODY + }, + { + am_set_tcw, + &db_set_trace_control_word_1, + 1, + DBIF_TRACE_BODY + }, + { + am_set_tcw_fake, + &db_set_trace_control_word_fake_1, + 1, + DBIF_TRACE_BODY + } +}; + +/* +** Exported +*/ +Eterm db_am_eot; /* Atom '$end_of_table' */ + +/* +** Forward decl's +*/ + + +/* +** ... forwards for compiled matches +*/ +/* Utility code */ +static DMCGuardBif *dmc_lookup_bif(Eterm t, int arity); +#ifdef DMC_DEBUG +static Eterm dmc_lookup_bif_reversed(void *f); +#endif +static int cmp_uint(void *a, void *b); +static int cmp_guard_bif(void *a, void *b); +static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info); +static Uint my_size_object(Eterm t); +static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap); + +/* Guard compilation */ +static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(Uint) *text, + Eterm t); +static DMCRet dmc_list(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant); +static DMCRet dmc_tuple(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant); +static DMCRet dmc_variable(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant); +static DMCRet dmc_fun(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant); +static DMCRet dmc_expr(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant); +static DMCRet compile_guard_expr(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t); +/* match expression subroutine */ +static DMCRet dmc_one_term(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Eterm) *stack, + DMC_STACK_TYPE(Uint) *text, + Eterm c); + + +#ifdef DMC_DEBUG +static int test_disassemble_next = 0; +static void db_match_dis(Binary *prog); +#define TRACE erts_fprintf(stderr,"Trace: %s:%d\n",__FILE__,__LINE__) +#define FENCE_PATTERN_SIZE 1 +#define FENCE_PATTERN 0xDEADBEEFUL +#else +#define TRACE /* Nothing */ +#define FENCE_PATTERN_SIZE 0 +#endif +static void add_dmc_err(DMCErrInfo *err_info, + char *str, + int variable, + Eterm term, + DMCErrorSeverity severity); + +static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity); + +static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace); + +static Eterm seq_trace_fake(Process *p, Eterm arg1); + + +/* +** Interface routines. +*/ + +/* +** Pseudo BIF:s to be callable from the PAM VM. +*/ + +BIF_RETTYPE db_get_trace_control_word_0(Process *p) +{ + Uint32 tcw = (Uint32) erts_smp_atomic_read(&trace_control_word); + BIF_RET(erts_make_integer((Uint) tcw, p)); +} + +BIF_RETTYPE db_set_trace_control_word_1(Process *p, Eterm new) +{ + Uint val; + Uint32 old_tcw; + if (!term_to_Uint(new, &val)) + BIF_ERROR(p, BADARG); + if (val != ((Uint32)val)) + BIF_ERROR(p, BADARG); + + old_tcw = (Uint32) erts_smp_atomic_xchg(&trace_control_word, (long) val); + BIF_RET(erts_make_integer((Uint) old_tcw, p)); +} + +static Eterm db_set_trace_control_word_fake_1(Process *p, Eterm new) +{ + Uint val; + if (!term_to_Uint(new, &val)) + BIF_ERROR(p, BADARG); + if (val != ((Uint32)val)) + BIF_ERROR(p, BADARG); + BIF_RET(db_get_trace_control_word_0(p)); +} + +/* +** The API used by the tracer (declared in global.h): +*/ + +/* +** Matchexpr is a list of tuples containing match-code, i e: +** +** Matchexpr = [{Pattern, Guards, Body}, ...] +** Pattern = [ PatternExpr , ...] +** PatternExpr = Constant | PatternTuple | PatternList | Variable +** Constant = Any erlang term +** PatternTuple = { PatternExpr ... } +** PatternList = [ PatternExpr ] +** Variable = '$' ++ +** Guards = [Guard ...] +** Guard = {GuardFunc, GuardExpr, ...} +** GuardExpr = BoundVariable | Guard | GuardList | GuardTuple | ConstExpr +** BoundVariable = Variable (existing in Pattern) +** GuardList = [ GuardExpr , ... ] +** GuardTuple = {{ GuardExpr, ... }} +** ConstExpr = {const, Constant} +** GuardFunc = is_list | .... | element | ... +** Body = [ BodyExpr, ... ] +** BodyExpr = GuardExpr | { BodyFunc, GuardExpr, ... } +** BodyFunc = return_trace | seq_trace | trace | ... +** - or something like that... +*/ + + +Eterm erts_match_set_get_source(Binary *mpsp) +{ + MatchProg *prog = Binary2MatchProg(mpsp); + return prog->saved_program; +} + +/* This one is for the tracing */ +Binary *erts_match_set_compile(Process *p, Eterm matchexpr) { + Binary *bin; + Uint sz; + Eterm *hp; + + bin = db_match_set_compile(p, matchexpr, DCOMP_TRACE); + if (bin != NULL) { + MatchProg *prog = Binary2MatchProg(bin); + sz = size_object(matchexpr); + prog->saved_program_buf = new_message_buffer(sz); + hp = prog->saved_program_buf->mem; + prog->saved_program = + copy_struct(matchexpr, sz, &hp, + &(prog->saved_program_buf->off_heap)); + } + return bin; +} + +Binary *db_match_set_compile(Process *p, Eterm matchexpr, + Uint flags) +{ + Eterm l; + Eterm t; + Eterm l2; + Eterm *tp; + Eterm *hp; + int n = 0; + int num_heads; + int i; + Binary *mps = NULL; + int compiled = 0; + Eterm *matches,*guards, *bodies; + Eterm *buff; + Eterm sbuff[15]; + + if (!is_list(matchexpr)) + return NULL; + num_heads = 0; + for (l = matchexpr; is_list(l); l = CDR(list_val(l))) + ++num_heads; + + if (l != NIL) /* proper list... */ + return NULL; + + if (num_heads > 5) { + buff = erts_alloc(ERTS_ALC_T_DB_TMP, + sizeof(Eterm) * num_heads * 3); + } else { + buff = sbuff; + } + + matches = buff; + guards = buff + num_heads; + bodies = buff + (num_heads * 2); + + i = 0; + for (l = matchexpr; is_list(l); l = CDR(list_val(l))) { + t = CAR(list_val(l)); + if (!is_tuple(t) || arityval((tp = tuple_val(t))[0]) != 3) { + goto error; + } + if (!(flags & DCOMP_TRACE) || (!is_list(tp[1]) && + !is_nil(tp[1]))) { + t = tp[1]; + } else { + /* This is when tracing, the parameter is a list, + that I convert to a tuple and that is matched + against an array (strange, but gives the semantics + of matching against a parameter list) */ + n = 0; + for (l2 = tp[1]; is_list(l2); l2 = CDR(list_val(l2))) { + ++n; + } + if (l2 != NIL) { + goto error; + } + hp = HAlloc(p, n + 1); + t = make_tuple(hp); + *hp++ = make_arityval((Uint) n); + l2 = tp[1]; + while (n--) { + *hp++ = CAR(list_val(l2)); + l2 = CDR(list_val(l2)); + } + } + matches[i] = t; + guards[i] = tp[2]; + bodies[i] = tp[3]; + ++i; + } + if ((mps = db_match_compile(matches, guards, bodies, + num_heads, + flags, + NULL)) == NULL) { + goto error; + } + compiled = 1; + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return mps; + +error: + if (compiled) { + erts_bin_free(mps); + } + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return NULL; +} + +/* This is used when tracing */ +Eterm erts_match_set_lint(Process *p, Eterm matchexpr) { + return db_match_set_lint(p, matchexpr, DCOMP_TRACE); +} + +Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags) +{ + Eterm l; + Eterm t; + Eterm l2; + Eterm *tp; + Eterm *hp; + DMCErrInfo *err_info = db_new_dmc_err_info(); + Eterm ret; + int n = 0; + int num_heads; + Binary *mp; + Eterm *matches,*guards, *bodies; + Eterm sbuff[15]; + Eterm *buff = sbuff; + int i; + + if (!is_list(matchexpr)) { + add_dmc_err(err_info, "Match programs are not in a list.", + -1, 0UL, dmcError); + goto done; + } + num_heads = 0; + for (l = matchexpr; is_list(l); l = CDR(list_val(l))) + ++num_heads; + + if (l != NIL) { /* proper list... */ + add_dmc_err(err_info, "Match programs are not in a proper " + "list.", + -1, 0UL, dmcError); + goto done; + } + + if (num_heads > 5) { + buff = erts_alloc(ERTS_ALC_T_DB_TMP, + sizeof(Eterm) * num_heads * 3); + } + + matches = buff; + guards = buff + num_heads; + bodies = buff + (num_heads * 2); + + i = 0; + for (l = matchexpr; is_list(l); l = CDR(list_val(l))) { + t = CAR(list_val(l)); + if (!is_tuple(t) || arityval((tp = tuple_val(t))[0]) != 3) { + add_dmc_err(err_info, + "Match program part is not a tuple of " + "arity 3.", + -1, 0UL, dmcError); + goto done; + } + if (!(flags & DCOMP_TRACE) || (!is_list(tp[1]) && + !is_nil(tp[1]))) { + t = tp[1]; + } else { + n = 0; + for (l2 = tp[1]; is_list(l2); l2 = CDR(list_val(l2))) { + ++n; + } + if (l2 != NIL) { + add_dmc_err(err_info, + "Match expression part %T is not a " + "proper list.", + -1, tp[1], dmcError); + + goto done; + } + hp = HAlloc(p, n + 1); + t = make_tuple(hp); + *hp++ = make_arityval((Uint) n); + l2 = tp[1]; + while (n--) { + *hp++ = CAR(list_val(l2)); + l2 = CDR(list_val(l2)); + } + } + matches[i] = t; + guards[i] = tp[2]; + bodies[i] = tp[3]; + ++i; + } + mp = db_match_compile(matches, guards, bodies, num_heads, + flags, err_info); + if (mp != NULL) { + erts_bin_free(mp); + } +done: + ret = db_format_dmc_err_info(p, err_info); + db_free_dmc_err_info(err_info); + if (buff != sbuff) { + erts_free(ERTS_ALC_T_DB_TMP, buff); + } + return ret; +} + +Eterm erts_match_set_run(Process *p, Binary *mpsp, + Eterm *args, int num_args, + Uint32 *return_flags) +{ + Eterm ret; + + ret = db_prog_match(p, mpsp, + (Eterm) args, + num_args, return_flags); +#if defined(HARDDEBUG) + if (is_non_value(ret)) { + erts_fprintf(stderr, "Failed\n"); + } else { + erts_fprintf(stderr, "Returning : %T\n", ret); + } +#endif + return ret; + /* Returns + * THE_NON_VALUE if no match + * am_false if {message,false} has been called, + * am_true if {message,_} has not been called or + * if {message,true} has been called, + * Msg if {message,Msg} has been called. + */ +} + +/* +** API Used by other erl_db modules. +*/ + +void db_initialize_util(void){ + qsort(guard_tab, + sizeof(guard_tab) / sizeof(DMCGuardBif), + sizeof(DMCGuardBif), + (int (*)(const void *, const void *)) &cmp_guard_bif); + match_pseudo_process_init(); + erts_smp_atomic_init(&trace_control_word, 0); +} + + + +Eterm db_getkey(int keypos, Eterm obj) +{ + if (is_tuple(obj)) { + Eterm *tptr = tuple_val(obj); + if (arityval(*tptr) >= keypos) + return *(tptr + keypos); + } + return THE_NON_VALUE; +} + +/* +** Matching compiled (executed by "Pam" :-) +*/ + +/* +** The actual compiling of the match expression and the guards +*/ +Binary *db_match_compile(Eterm *matchexpr, + Eterm *guards, + Eterm *body, + int num_progs, + Uint flags, + DMCErrInfo *err_info) +{ + DMCHeap heap; + DMC_STACK_TYPE(Eterm) stack; + DMC_STACK_TYPE(Uint) text; + DMCContext context; + MatchProg *ret = NULL; + Eterm t; + Uint i; + Uint num_iters; + int structure_checked; + DMCRet res; + int current_try_label; + Uint max_eheap_need; + Binary *bp = NULL; + unsigned clause_start; + + DMC_INIT_STACK(stack); + DMC_INIT_STACK(text); + + context.stack_need = context.stack_used = 0; + context.save = context.copy = NULL; + context.num_match = num_progs; + context.matchexpr = matchexpr; + context.guardexpr = guards; + context.bodyexpr = body; + context.eheap_need = 0; + context.err_info = err_info; + context.cflags = flags; + + heap.size = DMC_DEFAULT_SIZE; + heap.data = heap.def; + + /* + ** Compile the match expression + */ +restart: + heap.used = 0; + max_eheap_need = 0; + for (context.current_match = 0; + context.current_match < num_progs; + ++context.current_match) { /* This loop is long, + too long */ + memset(heap.data, 0, heap.size * sizeof(*heap.data)); + t = context.matchexpr[context.current_match]; + context.stack_used = 0; + context.eheap_need = 0; + structure_checked = 0; + if (context.current_match < num_progs - 1) { + DMC_PUSH(text,matchTryMeElse); + current_try_label = DMC_STACK_NUM(text); + DMC_PUSH(text,0); + } else { + current_try_label = -1; + } + clause_start = DMC_STACK_NUM(text); /* the "special" test needs it */ + DMC_PUSH(stack,NIL); + for (;;) { + switch (t & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_BOXED: + if (!BOXED_IS_TUPLE(t)) { + goto simple_term; + } + num_iters = arityval(*tuple_val(t)); + if (!structure_checked) { /* i.e. we did not + pop it */ + DMC_PUSH(text,matchTuple); + DMC_PUSH(text,num_iters); + } + structure_checked = 0; + for (i = 1; i <= num_iters; ++i) { + if ((res = dmc_one_term(&context, + &heap, + &stack, + &text, + tuple_val(t)[i])) + != retOk) { + if (res == retRestart) { + goto restart; /* restart the + surrounding + loop */ + } else goto error; + } + } + break; + case TAG_PRIMARY_LIST: + if (!structure_checked) { + DMC_PUSH(text, matchList); + } + structure_checked = 0; /* Whatever it is, we did + not pop it */ + if ((res = dmc_one_term(&context, &heap, &stack, + &text, CAR(list_val(t)))) + != retOk) { + if (res == retRestart) { + goto restart; + } else goto error; + } + t = CDR(list_val(t)); + continue; + default: /* Nil and non proper tail end's or + single terms as match + expressions */ + simple_term: + structure_checked = 0; + if ((res = dmc_one_term(&context, &heap, &stack, + &text, t)) + != retOk) { + if (res == retRestart) { + goto restart; + } else goto error; + } + break; + } + + /* The *program's* stack just *grows* while we are + traversing one composite data structure, we can + check the stack usage here */ + + if (context.stack_used > context.stack_need) + context.stack_need = context.stack_used; + + /* We are at the end of one composite data structure, + pop sub structures and emit a matchPop instruction + (or break) */ + if ((t = DMC_POP(stack)) == NIL) { + break; + } else { + DMC_PUSH(text, matchPop); + structure_checked = 1; /* + * Checked with matchPushT + * or matchPushL + */ + --(context.stack_used); + } + } + + /* + ** There is one single top variable in the match expression + ** iff the text is tho Uint's and the single instruction + ** is 'matchBind' or it is only a skip. + */ + context.special = + (DMC_STACK_NUM(text) == 2 + clause_start && + DMC_PEEK(text,clause_start) == matchBind) || + (DMC_STACK_NUM(text) == 1 + clause_start && + DMC_PEEK(text, clause_start) == matchSkip); + + if (flags & DCOMP_TRACE) { + if (context.special) { + if (DMC_PEEK(text, clause_start) == matchBind) { + DMC_POKE(text, clause_start, matchArrayBind); + } + } else { + ASSERT(DMC_STACK_NUM(text) >= 1); + if (DMC_PEEK(text, clause_start) != matchTuple) { + /* If it isn't "special" and the argument is + not a tuple, the expression is not valid + when matching an array*/ + if (context.err_info) { + add_dmc_err(context.err_info, + "Match head is invalid in " + "this context.", + -1, 0UL, + dmcError); + } + goto error; + } + DMC_POKE(text, clause_start, matchArray); + } + } + + + /* + ** ... and the guards + */ + context.is_guard = 1; + if (compile_guard_expr + (&context, + &heap, + &text, + context.guardexpr[context.current_match]) != retOk) + goto error; + context.is_guard = 0; + if ((context.cflags & DCOMP_TABLE) && + !is_list(context.bodyexpr[context.current_match])) { + if (context.err_info) { + add_dmc_err(context.err_info, + "Body clause does not return " + "anything.", -1, 0UL, + dmcError); + } + goto error; + } + if (compile_guard_expr + (&context, + &heap, + &text, + context.bodyexpr[context.current_match]) != retOk) + goto error; + + /* + * The compilation does not bail out when error information + * is requested, so we need to detect that here... + */ + if (context.err_info != NULL && + (context.err_info)->error_added) { + goto error; + } + + + /* If the matchprogram comes here, the match is + successful */ + DMC_PUSH(text,matchHalt); + /* Fill in try-me-else label if there is one. */ + if (current_try_label >= 0) { + DMC_POKE(text, current_try_label, DMC_STACK_NUM(text)); + } + /* So, how much eheap did this part of the match program need? */ + if (context.eheap_need > max_eheap_need) { + max_eheap_need = context.eheap_need; + } + } /* for (context.current_match = 0 ...) */ + + + /* + ** Done compiling + ** Allocate enough space for the program, + ** heap size is in 'heap_used', stack size is in 'stack_need' + ** and text size is simply DMC_STACK_NUM(text). + ** The "program memory" is allocated like this: + ** text ----> +-------------+ + ** | | + ** .......... + ** +-------------+ + ** + ** The heap-eheap-stack block of a MatchProg is nowadays allocated + ** when the match program is run (see db_prog_match()). + ** + ** heap ----> +-------------+ + ** .......... + ** eheap ---> + + + ** .......... + ** stack ---> + + + ** .......... + ** +-------------+ + ** The stack is expected to grow towards *higher* adresses. + ** A special case is when the match expression is a single binding + ** (i.e '$1'), then the field single_variable is set to 1. + */ + bp = erts_create_magic_binary(((sizeof(MatchProg) - sizeof(Uint)) + + (DMC_STACK_NUM(text) * sizeof(Uint))), + erts_db_match_prog_destructor); + ret = Binary2MatchProg(bp); + ret->saved_program_buf = NULL; + ret->saved_program = NIL; + ret->term_save = context.save; + ret->num_bindings = heap.used; + ret->single_variable = context.special; + sys_memcpy(ret->text, DMC_STACK_DATA(text), + DMC_STACK_NUM(text) * sizeof(Uint)); + ret->heap_size = ((heap.used * sizeof(Eterm)) + + (max_eheap_need * sizeof(Eterm)) + + (context.stack_need * sizeof(Eterm *)) + + (3 * (FENCE_PATTERN_SIZE * sizeof(Eterm *)))); + ret->eheap_offset = heap.used + FENCE_PATTERN_SIZE; + ret->stack_offset = ret->eheap_offset + max_eheap_need + FENCE_PATTERN_SIZE; +#ifdef DMC_DEBUG + ret->prog_end = ret->text + DMC_STACK_NUM(text); +#endif + + /* + * Fall through to cleanup code, but context.save should not be free'd + */ + context.save = NULL; +error: /* Here is were we land when compilation failed. */ + while (context.save != NULL) { + ErlHeapFragment *ll = context.save->next; + free_message_buffer(context.save); + context.save = ll; + } + DMC_FREE(stack); + DMC_FREE(text); + if (context.copy != NULL) + free_message_buffer(context.copy); + if (heap.data != heap.def) + erts_free(ERTS_ALC_T_DB_MS_CMPL_HEAP, (void *) heap.data); + return bp; +} + +/* +** Free a match program (in a binary) +*/ +void erts_db_match_prog_destructor(Binary *bprog) +{ + MatchProg *prog; + ErlHeapFragment *tmp, *ll; + if (bprog == NULL) + return; + prog = Binary2MatchProg(bprog); + tmp = prog->term_save; + while (tmp != NULL) { + ll = tmp->next; + free_message_buffer(tmp); + tmp = ll; + } + if (prog->saved_program_buf != NULL) + free_message_buffer(prog->saved_program_buf); +} + +void +erts_match_prog_foreach_offheap(Binary *bprog, + void (*func)(ErlOffHeap *, void *), + void *arg) +{ + MatchProg *prog; + ErlHeapFragment *tmp; + if (bprog == NULL) + return; + prog = Binary2MatchProg(bprog); + tmp = prog->term_save; + while (tmp) { + (*func)(&(tmp->off_heap), arg); + tmp = tmp->next; + } + if (prog->saved_program_buf) + (*func)(&(prog->saved_program_buf->off_heap), arg); +} + +/* +** This is not the most efficient way to do it, but it's a rare +** and not especially nice case when this is used. +*/ +static Eterm dpm_array_to_list(Process *psp, Eterm *arr, int arity) +{ + Eterm *hp = HAlloc(psp, arity * 2); + Eterm ret = NIL; + while (--arity >= 0) { + ret = CONS(hp, arr[arity], ret); + hp += 2; + } + return ret; +} +/* +** Execution of the match program, this is Pam. +** May return THE_NON_VALUE, which is a bailout. +** the para meter 'arity' is only used if 'term' is actually an array, +** i.e. 'DCOMP_TRACE' was specified +*/ +Eterm db_prog_match(Process *c_p, Binary *bprog, Eterm term, + int arity, + Uint32 *return_flags) +{ + MatchProg *prog = Binary2MatchProg(bprog); + Eterm *ep; + Eterm *tp; + Eterm t; + Eterm **sp; + Eterm *esp; + Eterm *hp; + Uint *pc = prog->text; + Eterm *ehp; + Eterm ret; + Uint n = 0; /* To avoid warning. */ + int i; + unsigned do_catch; + ErtsMatchPseudoProcess *mpsp; + Process *psp; + Process *tmpp; + Process *current_scheduled; + ErtsSchedulerData *esdp; + Eterm (*bif)(Process*, ...); + int fail_label; + int atomic_trace; +#ifdef DMC_DEBUG + unsigned long *heap_fence; + unsigned long *eheap_fence; + unsigned long *stack_fence; + Uint save_op; +#endif /* DMC_DEBUG */ + + mpsp = get_match_pseudo_process(c_p, prog->heap_size); + psp = &mpsp->process; + + /* We need to lure the scheduler into believing in the pseudo process, + because of floating point exceptions. Do *after* mpsp is set!!! */ + + esdp = ERTS_GET_SCHEDULER_DATA_FROM_PROC(c_p); + ASSERT(esdp != NULL); + current_scheduled = esdp->current_process; + esdp->current_process = psp; + /* SMP: psp->scheduler_data is set by get_match_pseudo_process */ + + atomic_trace = 0; +#define BEGIN_ATOMIC_TRACE(p) \ + do { \ + if (! atomic_trace) { \ + erts_smp_proc_unlock((p), ERTS_PROC_LOCK_MAIN); \ + erts_smp_block_system(0); \ + atomic_trace = !0; \ + } \ + } while (0) +#define END_ATOMIC_TRACE(p) \ + do { \ + if (atomic_trace) { \ + erts_smp_release_system(); \ + erts_smp_proc_lock((p), ERTS_PROC_LOCK_MAIN); \ + atomic_trace = 0; \ + } \ + } while (0) + +#ifdef DMC_DEBUG + save_op = 0; + heap_fence = (unsigned long *) mpsp->heap + prog->eheap_offset - 1; + eheap_fence = (unsigned long *) mpsp->heap + prog->stack_offset - 1; + stack_fence = (unsigned long *) mpsp->heap + prog->heap_size - 1; + *heap_fence = FENCE_PATTERN; + *eheap_fence = FENCE_PATTERN; + *stack_fence = FENCE_PATTERN; +#endif /* DMC_DEBUG */ + +#ifdef HARDDEBUG +#define FAIL() {erts_printf("Fail line %d\n",__LINE__); goto fail;} +#else +#define FAIL() goto fail +#endif +#define FAIL_TERM am_EXIT /* The term to set as return when bif fails and + do_catch != 0 */ + + *return_flags = 0U; + +restart: + ep = &term; + esp = mpsp->heap + prog->stack_offset; + sp = (Eterm **) esp; + hp = mpsp->heap; + ehp = mpsp->heap + prog->eheap_offset; + ret = am_true; + do_catch = 0; + fail_label = -1; + + for (;;) { +#ifdef DMC_DEBUG + if (*heap_fence != FENCE_PATTERN) { + erl_exit(1, "Heap fence overwritten in db_prog_match after op " + "0x%08x, overwritten with 0x%08x.", save_op, *heap_fence); + } + if (*eheap_fence != FENCE_PATTERN) { + erl_exit(1, "Eheap fence overwritten in db_prog_match after op " + "0x%08x, overwritten with 0x%08x.", save_op, + *eheap_fence); + } + if (*stack_fence != FENCE_PATTERN) { + erl_exit(1, "Stack fence overwritten in db_prog_match after op " + "0x%08x, overwritten with 0x%08x.", save_op, + *stack_fence); + } + save_op = *pc; +#endif + switch (*pc++) { + case matchTryMeElse: + fail_label = *pc++; + break; + case matchArray: /* only when DCOMP_TRACE, is always first + instruction. */ + n = *pc++; + if ((int) n != arity) + FAIL(); + ep = (Eterm *) *ep; + break; + case matchArrayBind: /* When the array size is unknown. */ + n = *pc++; + hp[n] = dpm_array_to_list(psp, (Eterm *) term, arity); + break; + case matchTuple: /* *ep is a tuple of arity n */ + if (!is_tuple(*ep)) + FAIL(); + ep = tuple_val(*ep); + n = *pc++; + if (arityval(*ep) != n) + FAIL(); + ++ep; + break; + case matchPushT: /* *ep is a tuple of arity n, + push ptr to first element */ + if (!is_tuple(*ep)) + FAIL(); + tp = tuple_val(*ep); + n = *pc++; + if (arityval(*tp) != n) + FAIL(); + *sp++ = tp + 1; + ++ep; + break; + case matchList: + if (!is_list(*ep)) + FAIL(); + ep = list_val(*ep); + break; + case matchPushL: + if (!is_list(*ep)) + FAIL(); + *sp++ = list_val(*ep); + ++ep; + break; + case matchPop: + ep = *(--sp); + break; + case matchBind: + n = *pc++; + hp[n] = *ep++; + break; + case matchCmp: + n = *pc++; + if (!eq(hp[n],*ep)) + FAIL(); + ++ep; + break; + case matchEqBin: + t = (Eterm) *pc++; + if (!eq(*ep,t)) + FAIL(); + ++ep; + break; + case matchEqFloat: + if (!is_float(*ep)) + FAIL(); + if (memcmp(float_val(*ep) + 1, pc, sizeof(double))) + FAIL(); + pc += 2; + ++ep; + break; + case matchEqRef: + if (!is_ref(*ep)) + FAIL(); + if (!eq(*ep, make_internal_ref(pc))) + FAIL(); + i = thing_arityval(*pc); + pc += i+1; + ++ep; + break; + case matchEqBig: + if (!is_big(*ep)) + FAIL(); + tp = big_val(*ep); + if (*tp != *pc) + FAIL(); + i = BIG_ARITY(pc); + while(i--) + if (*++tp != *++pc) + FAIL(); + ++pc; + ++ep; + break; + case matchEq: + t = (Eterm) *pc++; + if (t != *ep++) + FAIL(); + break; + case matchSkip: + ++ep; + break; + /* + * Here comes guard instructions + */ + case matchPushC: /* Push constant */ + *esp++ = *pc++; + break; + case matchConsA: + ehp[1] = *--esp; + ehp[0] = esp[-1]; + esp[-1] = make_list(ehp); + ehp += 2; + break; + case matchConsB: + ehp[0] = *--esp; + ehp[1] = esp[-1]; + esp[-1] = make_list(ehp); + ehp += 2; + break; + case matchMkTuple: + n = *pc++; + t = make_tuple(ehp); + *ehp++ = make_arityval(n); + while (n--) { + *ehp++ = *--esp; + } + *esp++ = t; + break; + case matchCall0: + bif = (Eterm (*)(Process*, ...)) *pc++; + t = (*bif)(psp); + if (is_non_value(t)) { + if (do_catch) + t = FAIL_TERM; + else + FAIL(); + } + *esp++ = t; + break; + case matchCall1: + bif = (Eterm (*)(Process*, ...)) *pc++; + t = (*bif)(psp, esp[-1]); + if (is_non_value(t)) { + if (do_catch) + t = FAIL_TERM; + else + FAIL(); + } + esp[-1] = t; + break; + case matchCall2: + bif = (Eterm (*)(Process*, ...)) *pc++; + t = (*bif)(psp, esp[-1], esp[-2]); + if (is_non_value(t)) { + if (do_catch) + t = FAIL_TERM; + else + FAIL(); + } + --esp; + esp[-1] = t; + break; + case matchCall3: + bif = (Eterm (*)(Process*, ...)) *pc++; + t = (*bif)(psp, esp[-1], esp[-2], esp[-3]); + if (is_non_value(t)) { + if (do_catch) + t = FAIL_TERM; + else + FAIL(); + } + esp -= 2; + esp[-1] = t; + break; + case matchPushV: + *esp++ = hp[*pc++]; + break; + case matchPushExpr: + *esp++ = term; + break; + case matchPushArrayAsList: + n = arity; /* Only happens when 'term' is an array */ + tp = (Eterm *) term; + *esp++ = make_list(ehp); + while (n--) { + *ehp++ = *tp++; + *ehp = make_list(ehp + 1); + ehp++; /* As pointed out by Mikael Pettersson the expression + (*ehp++ = make_list(ehp + 1)) that I previously + had written here has undefined behaviour. */ + } + ehp[-1] = NIL; + break; + case matchPushArrayAsListU: + /* This instruction is NOT efficient. */ + *esp++ = dpm_array_to_list(psp, (Eterm *) term, arity); + break; + case matchTrue: + if (*--esp != am_true) + FAIL(); + break; + case matchOr: + n = *pc++; + t = am_false; + while (n--) { + if (*--esp == am_true) { + t = am_true; + } else if (*esp != am_false) { + esp -= n; + if (do_catch) { + t = FAIL_TERM; + break; + } else { + FAIL(); + } + } + } + *esp++ = t; + break; + case matchAnd: + n = *pc++; + t = am_true; + while (n--) { + if (*--esp == am_false) { + t = am_false; + } else if (*esp != am_true) { + esp -= n; + if (do_catch) { + t = FAIL_TERM; + break; + } else { + FAIL(); + } + } + } + *esp++ = t; + break; + case matchOrElse: + n = *pc++; + if (*--esp == am_true) { + ++esp; + pc += n; + } else if (*esp != am_false) { + if (do_catch) { + *esp++ = FAIL_TERM; + pc += n; + } else { + FAIL(); + } + } + break; + case matchAndAlso: + n = *pc++; + if (*--esp == am_false) { + esp++; + pc += n; + } else if (*esp != am_true) { + if (do_catch) { + *esp++ = FAIL_TERM; + pc += n; + } else { + FAIL(); + } + } + break; + case matchJump: + n = *pc++; + pc += n; + break; + case matchSelf: + *esp++ = c_p->id; + break; + case matchWaste: + --esp; + break; + case matchReturn: + ret = *--esp; + break; + case matchProcessDump: { + erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); + print_process_info(ERTS_PRINT_DSBUF, (void *) dsbufp, c_p); + *esp++ = new_binary(psp, (byte *)dsbufp->str, (int)dsbufp->str_len); + erts_destroy_tmp_dsbuf(dsbufp); + break; + } + case matchDisplay: /* Debugging, not for production! */ + erts_printf("%T\n", esp[-1]); + esp[-1] = am_true; + break; + case matchSetReturnTrace: + *return_flags |= MATCH_SET_RETURN_TRACE; + *esp++ = am_true; + break; + case matchSetExceptionTrace: + *return_flags |= MATCH_SET_EXCEPTION_TRACE; + *esp++ = am_true; + break; + case matchIsSeqTrace: + if (SEQ_TRACE_TOKEN(c_p) != NIL) + *esp++ = am_true; + else + *esp++ = am_false; + break; + case matchSetSeqToken: + t = erts_seq_trace(c_p, esp[-1], esp[-2], 0); + if (is_non_value(t)) { + esp[-2] = FAIL_TERM; + } else { + esp[-2] = t; + } + --esp; + break; + case matchSetSeqTokenFake: + t = seq_trace_fake(c_p, esp[-1]); + if (is_non_value(t)) { + esp[-2] = FAIL_TERM; + } else { + esp[-2] = t; + } + --esp; + break; + case matchGetSeqToken: + if (SEQ_TRACE_TOKEN(c_p) == NIL) + *esp++ = NIL; + else { + *esp++ = make_tuple(ehp); + ehp[0] = make_arityval(5); + ehp[1] = SEQ_TRACE_TOKEN_FLAGS(c_p); + ehp[2] = SEQ_TRACE_TOKEN_LABEL(c_p); + ehp[3] = SEQ_TRACE_TOKEN_SERIAL(c_p); + ehp[4] = SEQ_TRACE_TOKEN_SENDER(c_p); + ehp[5] = SEQ_TRACE_TOKEN_LASTCNT(c_p); + ASSERT(SEQ_TRACE_TOKEN_ARITY(c_p) == 5); + ASSERT(is_immed(ehp[1])); + ASSERT(is_immed(ehp[2])); + ASSERT(is_immed(ehp[3])); + ASSERT(is_immed(ehp[5])); + if(!is_immed(ehp[4])) { + Eterm *sender = &ehp[4]; + ehp += 6; + *sender = copy_struct(*sender, + size_object(*sender), + &ehp, + &MSO(psp)); + } + else + ehp += 6; + + } + break; + case matchEnableTrace: + if ( (n = erts_trace_flag2bit(esp[-1]))) { + BEGIN_ATOMIC_TRACE(c_p); + set_tracee_flags(c_p, c_p->tracer_proc, 0, n); + esp[-1] = am_true; + } else { + esp[-1] = FAIL_TERM; + } + break; + case matchEnableTrace2: + n = erts_trace_flag2bit((--esp)[-1]); + esp[-1] = FAIL_TERM; + if (n) { + BEGIN_ATOMIC_TRACE(c_p); + if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) { + /* Always take over the tracer of the current process */ + set_tracee_flags(tmpp, c_p->tracer_proc, 0, n); + esp[-1] = am_true; + } + } + break; + case matchDisableTrace: + if ( (n = erts_trace_flag2bit(esp[-1]))) { + BEGIN_ATOMIC_TRACE(c_p); + set_tracee_flags(c_p, c_p->tracer_proc, n, 0); + esp[-1] = am_true; + } else { + esp[-1] = FAIL_TERM; + } + break; + case matchDisableTrace2: + n = erts_trace_flag2bit((--esp)[-1]); + esp[-1] = FAIL_TERM; + if (n) { + BEGIN_ATOMIC_TRACE(c_p); + if ( (tmpp = get_proc(c_p, 0, esp[0], 0))) { + /* Always take over the tracer of the current process */ + set_tracee_flags(tmpp, c_p->tracer_proc, n, 0); + esp[-1] = am_true; + } + } + break; + case matchCaller: + if (!(c_p->cp) || !(hp = find_function_from_pc(c_p->cp))) { + *esp++ = am_undefined; + } else { + *esp++ = make_tuple(ehp); + ehp[0] = make_arityval(3); + ehp[1] = hp[0]; + ehp[2] = hp[1]; + ehp[3] = make_small(hp[2]); + ehp += 4; + } + break; + case matchSilent: + --esp; + if (*esp == am_true) { + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + c_p->trace_flags |= F_TRACE_SILENT; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + else if (*esp == am_false) { + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + c_p->trace_flags &= ~F_TRACE_SILENT; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + break; + case matchTrace2: + { + /* disable enable */ + Uint d_flags = 0, e_flags = 0; /* process trace flags */ + Eterm tracer = c_p->tracer_proc; + /* XXX Atomicity note: Not fully atomic. Default tracer + * is sampled from current process but applied to + * tracee and tracer later after releasing main + * locks on current process, so c_p->tracer_proc + * may actually have changed when tracee and tracer + * gets updated. I do not think nobody will notice. + * It is just the default value that is not fully atomic. + * and the real argument settable from match spec + * {trace,[],[{{tracer,Tracer}}]} is much, much older. + */ + int cputs = 0; + + if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) || + ! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) || + cputs ) { + (--esp)[-1] = FAIL_TERM; + break; + } + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + (--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer, + d_flags, e_flags); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + break; + case matchTrace3: + { + /* disable enable */ + Uint d_flags = 0, e_flags = 0; /* process trace flags */ + Eterm tracer = c_p->tracer_proc; + /* XXX Atomicity note. Not fully atomic. See above. + * Above it could possibly be solved, but not here. + */ + int cputs = 0; + Eterm tracee = (--esp)[0]; + + if (! erts_trace_flags(esp[-1], &d_flags, &tracer, &cputs) || + ! erts_trace_flags(esp[-2], &e_flags, &tracer, &cputs) || + cputs || + ! (tmpp = get_proc(c_p, ERTS_PROC_LOCK_MAIN, + tracee, ERTS_PROC_LOCKS_ALL))) { + (--esp)[-1] = FAIL_TERM; + break; + } + if (tmpp == c_p) { + (--esp)[-1] = set_match_trace(c_p, FAIL_TERM, tracer, + d_flags, e_flags); + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } else { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + (--esp)[-1] = set_match_trace(tmpp, FAIL_TERM, tracer, + d_flags, e_flags); + erts_smp_proc_unlock(tmpp, ERTS_PROC_LOCKS_ALL); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + } + } + break; + case matchCatch: + do_catch = 1; + break; + case matchHalt: + goto success; + default: + erl_exit(1, "Internal error: unexpected opcode in match program."); + } + } +fail: + *return_flags = 0U; + if (fail_label >= 0) { /* We failed during a "TryMeElse", + lets restart, with the next match + program */ + pc = (prog->text) + fail_label; + cleanup_match_pseudo_process(mpsp, 1); + goto restart; + } + ret = THE_NON_VALUE; +success: + +#ifdef DMC_DEBUG + if (*heap_fence != FENCE_PATTERN) { + erl_exit(1, "Heap fence overwritten in db_prog_match after op " + "0x%08x, overwritten with 0x%08x.", save_op, *heap_fence); + } + if (*eheap_fence != FENCE_PATTERN) { + erl_exit(1, "Eheap fence overwritten in db_prog_match after op " + "0x%08x, overwritten with 0x%08x.", save_op, + *eheap_fence); + } + if (*stack_fence != FENCE_PATTERN) { + erl_exit(1, "Stack fence overwritten in db_prog_match after op " + "0x%08x, overwritten with 0x%08x.", save_op, + *stack_fence); + } +#endif + + esdp->current_process = current_scheduled; + + END_ATOMIC_TRACE(c_p); + return ret; +#undef FAIL +#undef FAIL_TERM +#undef BEGIN_ATOMIC_TRACE +#undef END_ATOMIC_TRACE +} + + +/* + * Convert a match program to a "magic" binary to return up to erlang + */ +Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp) { + return erts_mk_magic_binary_term(hpp, &MSO(p), mp); +} + +DMCErrInfo *db_new_dmc_err_info(void) +{ + DMCErrInfo *ret = erts_alloc(ERTS_ALC_T_DB_DMC_ERR_INFO, + sizeof(DMCErrInfo)); + ret->var_trans = NULL; + ret->num_trans = 0; + ret->error_added = 0; + ret->first = NULL; + return ret; +} + +Eterm db_format_dmc_err_info(Process *p, DMCErrInfo *ei) +{ + int sl; + int vnum; + DMCError *tmp; + Eterm *shp; + Eterm ret = NIL; + Eterm tlist, tpl, sev; + char buff[DMC_ERR_STR_LEN + 20 /* for the number */]; + + for (tmp = ei->first; tmp != NULL; tmp = tmp->next) { + if (tmp->variable >= 0 && + tmp->variable < ei->num_trans && + ei->var_trans != NULL) { + vnum = (int) ei->var_trans[tmp->variable]; + } else { + vnum = tmp->variable; + } + if (vnum >= 0) + sprintf(buff,tmp->error_string, vnum); + else + strcpy(buff,tmp->error_string); + sl = strlen(buff); + shp = HAlloc(p, sl * 2 + 5); + sev = (tmp->severity == dmcWarning) ? + am_atom_put("warning",7) : + am_error; + tlist = buf_to_intlist(&shp, buff, sl, NIL); + tpl = TUPLE2(shp, sev, tlist); + shp += 3; + ret = CONS(shp, tpl, ret); + shp += 2; + } + return ret; +} + +void db_free_dmc_err_info(DMCErrInfo *ei){ + while (ei->first != NULL) { + DMCError *ll = ei->first->next; + erts_free(ERTS_ALC_T_DB_DMC_ERROR, ei->first); + ei->first = ll; + } + if (ei->var_trans) + erts_free(ERTS_ALC_T_DB_TRANS_TAB, ei->var_trans); + erts_free(ERTS_ALC_T_DB_DMC_ERR_INFO, ei); +} + +/* Calculate integer addition: counter+incr. +** Store bignum in *hpp and increase *hpp accordingly. +** *hpp is assumed to be large enough to hold the result. +*/ +Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr) +{ + Eterm big_tmp[2]; + Eterm res; + Sint ires; + Eterm arg1; + Eterm arg2; + + if (is_both_small(counter,incr)) { + ires = signed_val(counter) + signed_val(incr); + if (IS_SSMALL(ires)) { + return make_small(ires); + } else { + res = small_to_big(ires, *hpp); + ASSERT(BIG_NEED_SIZE(big_size(res))==2); + *hpp += 2; + return res; + } + } + else { + switch(NUMBER_CODE(counter, incr)) { + case SMALL_BIG: + arg1 = small_to_big(signed_val(counter), big_tmp); + arg2 = incr; + break; + case BIG_SMALL: + arg1 = counter; + arg2 = small_to_big(signed_val(incr), big_tmp); + break; + case BIG_BIG: + arg1 = incr; + arg2 = counter; + break; + default: + return THE_NON_VALUE; + } + res = big_plus(arg1, arg2, *hpp); + if (is_big(res)) { + *hpp += BIG_NEED_SIZE(big_size(res)); + } + return res; + } +} + +/* +** Update one element: +** handle: Initialized by db_lookup_dbterm() +** position: The tuple position of the elements to be updated. +** newval: The new value of the element. +** Can not fail. +*/ +void db_do_update_element(DbUpdateHandle* handle, + Sint position, + Eterm newval) +{ + Eterm oldval = handle->dbterm->tpl[position]; + Eterm* newp; + Eterm* oldp; + Uint newval_sz; + Uint oldval_sz; + + if (is_both_immed(newval,oldval)) { + handle->dbterm->tpl[position] = newval; + return; + } + else if (!handle->mustResize && is_boxed(newval)) { + newp = boxed_val(newval); + switch (*newp & _TAG_HEADER_MASK) { + case _TAG_HEADER_POS_BIG: + case _TAG_HEADER_NEG_BIG: + case _TAG_HEADER_FLOAT: + case _TAG_HEADER_HEAP_BIN: + newval_sz = header_arity(*newp) + 1; + if (is_boxed(oldval)) { + oldp = boxed_val(oldval); + switch (*oldp & _TAG_HEADER_MASK) { + case _TAG_HEADER_POS_BIG: + case _TAG_HEADER_NEG_BIG: + case _TAG_HEADER_FLOAT: + case _TAG_HEADER_HEAP_BIN: + oldval_sz = header_arity(*oldp) + 1; + if (oldval_sz == newval_sz) { + /* "self contained" terms of same size, do memcpy */ + sys_memcpy(oldp, newp, newval_sz*sizeof(Eterm)); + return; + } + goto both_size_set; + } + } + goto new_size_set; + } + } + /* Not possible for simple memcpy or dbterm is already non-contiguous, */ + /* need to realloc... */ + + newval_sz = is_immed(newval) ? 0 : size_object(newval); +new_size_set: + + oldval_sz = is_immed(oldval) ? 0 : size_object(oldval); +both_size_set: + + handle->new_size = handle->new_size - oldval_sz + newval_sz; + + /* write new value in old dbterm, finalize will make a flat copy */ + handle->dbterm->tpl[position] = newval; + handle->mustResize = 1; +} + + +/* +** Copy the object into a possibly new DbTerm, +** offset is the offset of the DbTerm from the start +** of the sysAllocaed structure, The possibly realloced and copied +** structure is returned. Make sure (((char *) old) - offset) is a +** pointer to a ERTS_ALC_T_DB_TERM allocated data area. +*/ +void* db_get_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj) +{ + int size = size_object(obj); + void *structp = ((char*) old) - offset; + DbTerm* p; + Eterm copy; + Eterm *top; + + if (old != 0) { + erts_cleanup_offheap(&old->off_heap); + if (size == old->size) { + p = old; + } else { + Uint new_sz = offset + sizeof(DbTerm) + sizeof(Eterm)*(size-1); + Uint old_sz = offset + sizeof(DbTerm) + sizeof(Eterm)*(old->size-1); + + if (erts_ets_realloc_always_moves) { + void *nstructp = erts_db_alloc(ERTS_ALC_T_DB_TERM, + (DbTable *) tb, + new_sz); + memcpy(nstructp,structp,offset); + erts_db_free(ERTS_ALC_T_DB_TERM, + (DbTable *) tb, + structp, + old_sz); + structp = nstructp; + } else { + structp = erts_db_realloc(ERTS_ALC_T_DB_TERM, + (DbTable *) tb, + structp, + old_sz, + new_sz); + } + p = (DbTerm*) ((void *)(((char *) structp) + offset)); + } + } + else { + structp = erts_db_alloc(ERTS_ALC_T_DB_TERM, + (DbTable *) tb, + (offset + + sizeof(DbTerm) + + sizeof(Eterm)*(size-1))); + p = (DbTerm*) ((void *)(((char *) structp) + offset)); + } + p->size = size; + p->off_heap.mso = NULL; + p->off_heap.externals = NULL; +#ifndef HYBRID /* FIND ME! */ + p->off_heap.funs = NULL; +#endif + p->off_heap.overhead = 0; + + top = DBTERM_BUF(p); + copy = copy_struct(obj, size, &top, &p->off_heap); + DBTERM_SET_TPL(p,tuple_val(copy)); + + return structp; +} + + +void db_free_term_data(DbTerm* p) +{ + erts_cleanup_offheap(&p->off_heap); +} + + +/* +** Check if object represents a "match" variable +** i.e and atom $N where N is an integer +** +*/ + +int db_is_variable(Eterm obj) +{ + byte *b; + int n; + int N; + + if (is_not_atom(obj)) + return -1; + b = atom_tab(atom_val(obj))->name; + if ((n = atom_tab(atom_val(obj))->len) < 2) + return -1; + if (*b++ != '$') + return -1; + n--; + /* Handle first digit */ + if (*b == '0') + return (n == 1) ? 0 : -1; + if (*b >= '1' && *b <= '9') + N = *b++ - '0'; + else + return -1; + n--; + while(n--) { + if (*b >= '0' && *b <= '9') { + N = N*10 + (*b - '0'); + b++; + } + else + return -1; + } + return N; +} + + +/* check if obj is (or contains) a variable */ +/* return 1 if obj contains a variable or underscore */ +/* return 0 if obj is fully ground */ + +int db_has_variable(Eterm obj) +{ + switch(obj & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: { + while (is_list(obj)) { + if (db_has_variable(CAR(list_val(obj)))) + return 1; + obj = CDR(list_val(obj)); + } + return(db_has_variable(obj)); /* Non wellformed list or [] */ + } + case TAG_PRIMARY_BOXED: + if (!BOXED_IS_TUPLE(obj)) { + return 0; + } else { + Eterm *tuple = tuple_val(obj); + int arity = arityval(*tuple++); + while(arity--) { + if (db_has_variable(*tuple)) + return 1; + tuple++; + } + return(0); + } + case TAG_PRIMARY_IMMED1: + if (obj == am_Underscore || db_is_variable(obj) >= 0) + return 1; + } + return 0; +} + +int erts_db_is_compiled_ms(Eterm term) +{ + return (is_binary(term) + && (thing_subtag(*binary_val(term)) == REFC_BINARY_SUBTAG) + && IsMatchProgBinary((((ProcBin *) binary_val(term))->val))); +} + +/* +** Local (static) utilities. +*/ + +/* +*************************************************************************** +** Compiled matches +*************************************************************************** +*/ +/* +** Utility to add an error +*/ + +static void add_dmc_err(DMCErrInfo *err_info, + char *str, + int variable, + Eterm term, + DMCErrorSeverity severity) +{ + /* Linked in in reverse order, to ease the formatting */ + DMCError *e = erts_alloc(ERTS_ALC_T_DB_DMC_ERROR, sizeof(DMCError)); + if (term != 0UL) { + erts_snprintf(e->error_string, DMC_ERR_STR_LEN, str, term); + } else { + strncpy(e->error_string, str, DMC_ERR_STR_LEN); + e->error_string[DMC_ERR_STR_LEN] ='\0'; + } + e->variable = variable; + e->severity = severity; + e->next = err_info->first; +#ifdef HARDDEBUG + erts_fprintf(stderr,"add_dmc_err: %s\n",e->error_string); +#endif + err_info->first = e; + if (severity >= dmcError) + err_info->error_added = 1; +} + +/* +** Handle one term in the match expression (not the guard) +*/ +static DMCRet dmc_one_term(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Eterm) *stack, + DMC_STACK_TYPE(Uint) *text, + Eterm c) +{ + Sint n; + Eterm *hp; + ErlHeapFragment *tmp_mb; + Uint sz, sz2, sz3; + Uint i, j; + + + switch (c & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_IMMED1: + if ((n = db_is_variable(c)) >= 0) { /* variable */ + if (n >= heap->size) { + /* + ** Ouch, big integer in match variable. + */ + Eterm *save_hp; + ASSERT(heap->data == heap->def); + sz = sz2 = sz3 = 0; + for (j = 0; j < context->num_match; ++j) { + sz += size_object(context->matchexpr[j]); + sz2 += size_object(context->guardexpr[j]); + sz3 += size_object(context->bodyexpr[j]); + } + context->copy = + new_message_buffer(sz + sz2 + sz3 + + context->num_match); + save_hp = hp = context->copy->mem; + hp += context->num_match; + for (j = 0; j < context->num_match; ++j) { + context->matchexpr[j] = + copy_struct(context->matchexpr[j], + size_object(context->matchexpr[j]), &hp, + &(context->copy->off_heap)); + context->guardexpr[j] = + copy_struct(context->guardexpr[j], + size_object(context->guardexpr[j]), &hp, + &(context->copy->off_heap)); + context->bodyexpr[j] = + copy_struct(context->bodyexpr[j], + size_object(context->bodyexpr[j]), &hp, + &(context->copy->off_heap)); + } + for (j = 0; j < context->num_match; ++j) { + /* the actual expressions can be + atoms in their selves, place them first */ + *save_hp++ = context->matchexpr[j]; + } + heap->size = match_compact(context->copy, + context->err_info); + for (j = 0; j < context->num_match; ++j) { + /* restore the match terms, as they + may be atoms that changed */ + context->matchexpr[j] = context->copy->mem[j]; + } + heap->data = erts_alloc(ERTS_ALC_T_DB_MS_CMPL_HEAP, + heap->size*sizeof(unsigned)); + sys_memset(heap->data, 0, + heap->size * sizeof(unsigned)); + DMC_CLEAR(*stack); + /*DMC_PUSH(*stack,NIL);*/ + DMC_CLEAR(*text); + return retRestart; + } + if (heap->data[n]) { /* already bound ? */ + DMC_PUSH(*text,matchCmp); + DMC_PUSH(*text,n); + } else { /* Not bound, bind! */ + if (n >= heap->used) + heap->used = n + 1; + DMC_PUSH(*text,matchBind); + DMC_PUSH(*text,n); + heap->data[n] = 1; + } + } else if (c == am_Underscore) { + DMC_PUSH(*text, matchSkip); + } else { /* Any immediate value */ + DMC_PUSH(*text, matchEq); + DMC_PUSH(*text, (Uint) c); + } + break; + case TAG_PRIMARY_LIST: + DMC_PUSH(*text, matchPushL); + ++(context->stack_used); + DMC_PUSH(*stack, c); + break; + case TAG_PRIMARY_BOXED: { + Eterm hdr = *boxed_val(c); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): + n = arityval(*tuple_val(c)); + DMC_PUSH(*text, matchPushT); + ++(context->stack_used); + DMC_PUSH(*text, n); + DMC_PUSH(*stack, c); + break; + case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): + n = thing_arityval(*internal_ref_val(c)); + DMC_PUSH(*text, matchEqRef); + DMC_PUSH(*text, *internal_ref_val(c)); + for (i = 1; i <= n; ++i) { + DMC_PUSH(*text, (Uint) internal_ref_val(c)[i]); + } + break; + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + n = thing_arityval(*big_val(c)); + DMC_PUSH(*text, matchEqBig); + DMC_PUSH(*text, *big_val(c)); + for (i = 1; i <= n; ++i) { + DMC_PUSH(*text, (Uint) big_val(c)[i]); + } + break; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + DMC_PUSH(*text,matchEqFloat); + DMC_PUSH(*text, (Uint) float_val(c)[1]); + /* XXX: this reads and pushes random junk on ARCH_64 */ + DMC_PUSH(*text, (Uint) float_val(c)[2]); + break; + default: /* BINARY, FUN, VECTOR, or EXTERNAL */ + /* + ** Make a private copy... + */ + n = size_object(c); + tmp_mb = new_message_buffer(n); + hp = tmp_mb->mem; + DMC_PUSH(*text, matchEqBin); + DMC_PUSH(*text, copy_struct(c, n, &hp, &(tmp_mb->off_heap))); + tmp_mb->next = context->save; + context->save = tmp_mb; + break; + } + break; + } + default: + erl_exit(1, "db_match_compile: " + "Bad object on heap: 0x%08lx\n", + (unsigned long) c); + } + return retOk; +} + +/* +** Match guard compilation +*/ + +static void do_emit_constant(DMCContext *context, DMC_STACK_TYPE(Uint) *text, + Eterm t) +{ + int sz; + ErlHeapFragment *emb; + Eterm *hp; + Eterm tmp; + + if (IS_CONST(t)) { + tmp = t; + } else { + sz = my_size_object(t); + emb = new_message_buffer(sz); + hp = emb->mem; + tmp = my_copy_struct(t,&hp,&(emb->off_heap)); + emb->next = context->save; + context->save = emb; + } + DMC_PUSH(*text,matchPushC); + DMC_PUSH(*text,(Uint) tmp); + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; +} + +#define RETURN_ERROR_X(String, X, Y, ContextP, ConstantF) \ +do { \ +if ((ContextP)->err_info != NULL) { \ + (ConstantF) = 0; \ + add_dmc_err((ContextP)->err_info, String, X, Y, dmcError); \ + return retOk; \ +} else \ + return retFail; \ +} while(0) + +#define RETURN_ERROR(String, ContextP, ConstantF) \ + RETURN_ERROR_X(String, -1, 0UL, ContextP, ConstantF) + +#define RETURN_VAR_ERROR(String, N, ContextP, ConstantF) \ + RETURN_ERROR_X(String, N, 0UL, ContextP, ConstantF) + +#define RETURN_TERM_ERROR(String, T, ContextP, ConstantF) \ + RETURN_ERROR_X(String, -1, T, ContextP, ConstantF) + +#define WARNING(String, ContextP) \ +add_dmc_err((ContextP)->err_info, String, -1, 0UL, dmcWarning) + +#define VAR_WARNING(String, N, ContextP) \ +add_dmc_err((ContextP)->err_info, String, N, 0UL, dmcWarning) + +#define TERM_WARNING(String, T, ContextP) \ +add_dmc_err((ContextP)->err_info, String, -1, T, dmcWarning) + +static DMCRet dmc_list(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + int c1; + int c2; + int ret; + + if ((ret = dmc_expr(context, heap, text, CAR(list_val(t)), &c1)) != retOk) + return ret; + + if ((ret = dmc_expr(context, heap, text, CDR(list_val(t)), &c2)) != retOk) + return ret; + + if (c1 && c2) { + *constant = 1; + return retOk; + } + *constant = 0; + if (!c1) { + /* The CAR is not a constant, so if the CDR is, we just push it, + otherwise it is already pushed. */ + if (c2) + do_emit_constant(context, text, CDR(list_val(t))); + DMC_PUSH(*text, matchConsA); + } else { /* !c2 && c1 */ + do_emit_constant(context, text, CAR(list_val(t))); + DMC_PUSH(*text, matchConsB); + } + --context->stack_used; /* Two objects on stack becomes one */ + context->eheap_need += 2; + return retOk; +} + +static DMCRet dmc_tuple(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + DMC_STACK_TYPE(Uint) instr_save; + int all_constant = 1; + int textpos = DMC_STACK_NUM(*text); + Eterm *p = tuple_val(t); + Uint nelems = arityval(*p); + Uint i; + int c; + DMCRet ret; + + /* + ** We remember where we started to layout code, + ** assume all is constant and back up and restart if not so. + ** The tuple should be laid out with the last element first, + ** so we can memcpy the tuple to the eheap. + */ + for (i = nelems; i > 0; --i) { + if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk) + return ret; + if (!c && all_constant) { + all_constant = 0; + if (i < nelems) { + Uint j; + + /* + * Oops, we need to relayout the constants. + * Save the already laid out instructions. + */ + DMC_INIT_STACK(instr_save); + while (DMC_STACK_NUM(*text) > textpos) + DMC_PUSH(instr_save, DMC_POP(*text)); + for (j = nelems; j > i; --j) + do_emit_constant(context, text, p[j]); + while(!DMC_EMPTY(instr_save)) + DMC_PUSH(*text, DMC_POP(instr_save)); + DMC_FREE(instr_save); + } + } else if (c && !all_constant) { + /* push a constant */ + do_emit_constant(context, text, p[i]); + } + } + + if (all_constant) { + *constant = 1; + return retOk; + } + DMC_PUSH(*text, matchMkTuple); + DMC_PUSH(*text, nelems); + context->stack_used -= (nelems - 1); + context->eheap_need += (nelems + 1); + *constant = 0; + return retOk; +} + +static DMCRet dmc_whole_expression(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + if (context->cflags & DCOMP_TRACE) { + /* Hmmm, convert array to list... */ + if (context->special) { + DMC_PUSH(*text, matchPushArrayAsListU); + } else { + ASSERT(is_tuple(context->matchexpr + [context->current_match])); + context->eheap_need += + arityval(*(tuple_val(context->matchexpr + [context->current_match]))) * 2; + DMC_PUSH(*text, matchPushArrayAsList); + } + } else { + DMC_PUSH(*text, matchPushExpr); + } + ++context->stack_used; + if (context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + *constant = 0; + return retOk; +} + +static DMCRet dmc_variable(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Uint n = db_is_variable(t); + ASSERT(n >= 0); + if (n >= heap->used) + RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant); + if (heap->data[n] == 0U) + RETURN_VAR_ERROR("Variable $%d is unbound.", n, context, *constant); + DMC_PUSH(*text, matchPushV); + DMC_PUSH(*text, n); + ++context->stack_used; + if (context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + *constant = 0; + return retOk; +} + +static DMCRet dmc_all_bindings(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + int i; + int heap_used = 0; + + DMC_PUSH(*text, matchPushC); + DMC_PUSH(*text, NIL); + for (i = heap->used - 1; i >= 0; --i) { + if (heap->data[i]) { + DMC_PUSH(*text, matchPushV); + DMC_PUSH(*text, i); + DMC_PUSH(*text, matchConsB); + heap_used += 2; + } + } + ++context->stack_used; + if ((context->stack_used + 1) > context->stack_need) + context->stack_need = (context->stack_used + 1); + context->eheap_need += heap_used; + *constant = 0; + return retOk; +} + +static DMCRet dmc_const(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + + if (a != 2) { + RETURN_TERM_ERROR("Special form 'const' called with more than one " + "argument in %T.", t, context, *constant); + } + *constant = 1; + return retOk; +} + +static DMCRet dmc_and(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int i; + int c; + + if (a < 2) { + RETURN_TERM_ERROR("Special form 'and' called without arguments " + "in %T.", t, context, *constant); + } + *constant = 0; + for (i = a; i > 1; --i) { + if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk) + return ret; + if (c) + do_emit_constant(context, text, p[i]); + } + DMC_PUSH(*text, matchAnd); + DMC_PUSH(*text, (Uint) a - 1); + context->stack_used -= (a - 2); + return retOk; +} + +static DMCRet dmc_or(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int i; + int c; + + if (a < 2) { + RETURN_TERM_ERROR("Special form 'or' called without arguments " + "in %T.", t, context, *constant); + } + *constant = 0; + for (i = a; i > 1; --i) { + if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk) + return ret; + if (c) + do_emit_constant(context, text, p[i]); + } + DMC_PUSH(*text, matchOr); + DMC_PUSH(*text, (Uint) a - 1); + context->stack_used -= (a - 2); + return retOk; +} + + +static DMCRet dmc_andalso(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int i; + int c; + Uint lbl; + Uint lbl_next; + Uint lbl_val; + + if (a < 2) { + RETURN_TERM_ERROR("Special form 'andalso' called without" + " arguments " + "in %T.", t, context, *constant); + } + *constant = 0; + lbl = 0; + for (i = 2; i <= a; ++i) { + if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk) + return ret; + if (c) + do_emit_constant(context, text, p[i]); + if (i == a) { + DMC_PUSH(*text, matchJump); + } else { + DMC_PUSH(*text, matchAndAlso); + } + DMC_PUSH(*text, lbl); + lbl = DMC_STACK_NUM(*text)-1; + --(context->stack_used); + } + DMC_PUSH(*text, matchPushC); + DMC_PUSH(*text, am_true); + lbl_val = DMC_STACK_NUM(*text); + while (lbl) { + lbl_next = DMC_PEEK(*text, lbl); + DMC_POKE(*text, lbl, lbl_val-lbl-1); + lbl = lbl_next; + } + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + +static DMCRet dmc_orelse(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int i; + int c; + Uint lbl; + Uint lbl_next; + Uint lbl_val; + + if (a < 2) { + RETURN_TERM_ERROR("Special form 'orelse' called without arguments " + "in %T.", t, context, *constant); + } + *constant = 0; + lbl = 0; + for (i = 2; i <= a; ++i) { + if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk) + return ret; + if (c) + do_emit_constant(context, text, p[i]); + if (i == a) { + DMC_PUSH(*text, matchJump); + } else { + DMC_PUSH(*text, matchOrElse); + } + DMC_PUSH(*text, lbl); + lbl = DMC_STACK_NUM(*text)-1; + --(context->stack_used); + } + DMC_PUSH(*text, matchPushC); + DMC_PUSH(*text, am_false); + lbl_val = DMC_STACK_NUM(*text); + while (lbl) { + lbl_next = DMC_PEEK(*text, lbl); + DMC_POKE(*text, lbl, lbl_val-lbl-1); + lbl = lbl_next; + } + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + +static DMCRet dmc_message(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int c; + + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'message' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'message' called in guard context.", + context, + *constant); + } + + if (a != 2) { + RETURN_TERM_ERROR("Special form 'message' called with wrong " + "number of arguments in %T.", t, context, + *constant); + } + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchReturn); + DMC_PUSH(*text, matchPushC); + DMC_PUSH(*text, am_true); + /* Push as much as we remove, stack_need is untouched */ + return retOk; +} + +static DMCRet dmc_self(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + + if (a != 1) { + RETURN_TERM_ERROR("Special form 'self' called with arguments " + "in %T.", t, context, *constant); + } + *constant = 0; + DMC_PUSH(*text, matchSelf); + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + +static DMCRet dmc_return_trace(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'return_trace' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'return_trace' called in " + "guard context.", context, *constant); + } + + if (a != 1) { + RETURN_TERM_ERROR("Special form 'return_trace' called with " + "arguments in %T.", t, context, *constant); + } + *constant = 0; + DMC_PUSH(*text, matchSetReturnTrace); /* Pushes 'true' on the stack */ + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + +static DMCRet dmc_exception_trace(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'exception_trace' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'exception_trace' called in " + "guard context.", context, *constant); + } + + if (a != 1) { + RETURN_TERM_ERROR("Special form 'exception_trace' called with " + "arguments in %T.", t, context, *constant); + } + *constant = 0; + DMC_PUSH(*text, matchSetExceptionTrace); /* Pushes 'true' on the stack */ + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + + + +static DMCRet dmc_is_seq_trace(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'is_seq_trace' used in wrong dialect.", + context, + *constant); + } + if (a != 1) { + RETURN_TERM_ERROR("Special form 'is_seq_trace' called with " + "arguments in %T.", t, context, *constant); + } + *constant = 0; + DMC_PUSH(*text, matchIsSeqTrace); + /* Pushes 'true' or 'false' on the stack */ + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + +static DMCRet dmc_set_seq_token(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int c; + + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'set_seq_token' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'set_seq_token' called in " + "guard context.", context, *constant); + } + + if (a != 3) { + RETURN_TERM_ERROR("Special form 'set_seq_token' called with wrong " + "number of arguments in %T.", t, context, + *constant); + } + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[3]); + } + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + if (context->cflags & DCOMP_FAKE_DESTRUCTIVE) { + DMC_PUSH(*text, matchSetSeqTokenFake); + } else { + DMC_PUSH(*text, matchSetSeqToken); + } + --context->stack_used; /* Remove two and add one */ + return retOk; +} + +static DMCRet dmc_get_seq_token(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'get_seq_token' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'get_seq_token' called in " + "guard context.", context, *constant); + } + if (a != 1) { + RETURN_TERM_ERROR("Special form 'get_seq_token' called with " + "arguments in %T.", t, context, + *constant); + } + + *constant = 0; + DMC_PUSH(*text, matchGetSeqToken); + context->eheap_need += (6 /* A 5-tuple is built */ + + EXTERNAL_THING_HEAD_SIZE + 2 /* Sender can + be an external + pid */); + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + + + +static DMCRet dmc_display(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int c; + + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'display' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'display' called in guard context.", + context, + *constant); + } + + if (a != 2) { + RETURN_TERM_ERROR("Special form 'display' called with wrong " + "number of arguments in %T.", t, context, + *constant); + } + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchDisplay); + /* Push as much as we remove, stack_need is untouched */ + return retOk; +} + +static DMCRet dmc_process_dump(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'process_dump' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'process_dump' called in " + "guard context.", context, *constant); + } + + if (a != 1) { + RETURN_TERM_ERROR("Special form 'process_dump' called with " + "arguments in %T.", t, context, *constant); + } + *constant = 0; + DMC_PUSH(*text, matchProcessDump); /* Creates binary */ + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + +static DMCRet dmc_enable_trace(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int c; + + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'enable_trace' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'enable_trace' called in guard context.", + context, + *constant); + } + + switch (a) { + case 2: + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchEnableTrace); + /* Push as much as we remove, stack_need is untouched */ + break; + case 3: + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[3]); + } + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchEnableTrace2); + --context->stack_used; /* Remove two and add one */ + break; + default: + RETURN_TERM_ERROR("Special form 'enable_trace' called with wrong " + "number of arguments in %T.", t, context, + *constant); + } + return retOk; +} + +static DMCRet dmc_disable_trace(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int c; + + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'disable_trace' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'disable_trace' called in guard context.", + context, + *constant); + } + + switch (a) { + case 2: + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchDisableTrace); + /* Push as much as we remove, stack_need is untouched */ + break; + case 3: + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[3]); + } + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchDisableTrace2); + --context->stack_used; /* Remove two and add one */ + break; + default: + RETURN_TERM_ERROR("Special form 'disable_trace' called with wrong " + "number of arguments in %T.", t, context, + *constant); + } + return retOk; +} + +static DMCRet dmc_trace(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int c; + + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'trace' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'trace' called in guard context.", + context, + *constant); + } + + switch (a) { + case 3: + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[3]); + } + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchTrace2); + --context->stack_used; /* Remove two and add one */ + break; + case 4: + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[4], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[4]); + } + if ((ret = dmc_expr(context, heap, text, p[3], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[3]); + } + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchTrace3); + context->stack_used -= 2; /* Remove three and add one */ + break; + default: + RETURN_TERM_ERROR("Special form 'trace' called with wrong " + "number of arguments in %T.", t, context, + *constant); + } + return retOk; +} + + + +static DMCRet dmc_caller(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'caller' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'caller' called in " + "guard context.", context, *constant); + } + + if (a != 1) { + RETURN_TERM_ERROR("Special form 'caller' called with " + "arguments in %T.", t, context, *constant); + } + *constant = 0; + DMC_PUSH(*text, matchCaller); /* Creates binary */ + context->eheap_need += 4; /* A 3-tuple is built */ + if (++context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + + + +static DMCRet dmc_silent(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + DMCRet ret; + int c; + + if (!(context->cflags & DCOMP_TRACE)) { + RETURN_ERROR("Special form 'silent' used in wrong dialect.", + context, + *constant); + } + if (context->is_guard) { + RETURN_ERROR("Special form 'silent' called in " + "guard context.", context, *constant); + } + + if (a != 2) { + RETURN_TERM_ERROR("Special form 'silent' called with wrong " + "number of arguments in %T.", t, context, + *constant); + } + *constant = 0; + if ((ret = dmc_expr(context, heap, text, p[2], &c)) != retOk) { + return ret; + } + if (c) { + do_emit_constant(context, text, p[2]); + } + DMC_PUSH(*text, matchSilent); + DMC_PUSH(*text, matchPushC); + DMC_PUSH(*text, am_true); + /* Push as much as we remove, stack_need is untouched */ + return retOk; +} + + + +static DMCRet dmc_fun(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + Eterm *p = tuple_val(t); + Uint a = arityval(*p); + int c; + int i; + DMCRet ret; + DMCGuardBif *b; + + /* Special forms. */ + switch (p[1]) { + case am_const: + return dmc_const(context, heap, text, t, constant); + case am_and: + return dmc_and(context, heap, text, t, constant); + case am_or: + return dmc_or(context, heap, text, t, constant); + case am_andalso: + case am_andthen: + return dmc_andalso(context, heap, text, t, constant); + case am_orelse: + return dmc_orelse(context, heap, text, t, constant); + case am_self: + return dmc_self(context, heap, text, t, constant); + case am_message: + return dmc_message(context, heap, text, t, constant); + case am_is_seq_trace: + return dmc_is_seq_trace(context, heap, text, t, constant); + case am_set_seq_token: + return dmc_set_seq_token(context, heap, text, t, constant); + case am_get_seq_token: + return dmc_get_seq_token(context, heap, text, t, constant); + case am_return_trace: + return dmc_return_trace(context, heap, text, t, constant); + case am_exception_trace: + return dmc_exception_trace(context, heap, text, t, constant); + case am_display: + return dmc_display(context, heap, text, t, constant); + case am_process_dump: + return dmc_process_dump(context, heap, text, t, constant); + case am_enable_trace: + return dmc_enable_trace(context, heap, text, t, constant); + case am_disable_trace: + return dmc_disable_trace(context, heap, text, t, constant); + case am_trace: + return dmc_trace(context, heap, text, t, constant); + case am_caller: + return dmc_caller(context, heap, text, t, constant); + case am_silent: + return dmc_silent(context, heap, text, t, constant); + case am_set_tcw: + if (context->cflags & DCOMP_FAKE_DESTRUCTIVE) { + b = dmc_lookup_bif(am_set_tcw_fake, ((int) a) - 1); + } else { + b = dmc_lookup_bif(p[1], ((int) a) - 1); + } + break; + default: + b = dmc_lookup_bif(p[1], ((int) a) - 1); + } + + + if (b == NULL) { + if (context->err_info != NULL) { + /* Ugly, should define a better RETURN_TERM_ERROR interface... */ + char buff[100]; + sprintf(buff, "Function %%T/%d does_not_exist.", (int)a - 1); + RETURN_TERM_ERROR(buff, p[1], context, *constant); + } else { + return retFail; + } + } + ASSERT(b->arity == ((int) a) - 1); + if (! (b->flags & + (1 << + ((context->cflags & DCOMP_DIALECT_MASK) + + (context->is_guard ? DBIF_GUARD : DBIF_BODY))))) { + /* Body clause used in wrong context. */ + if (context->err_info != NULL) { + /* Ugly, should define a better RETURN_TERM_ERROR interface... */ + char buff[100]; + sprintf(buff, + "Function %%T/%d cannot be called in this context.", + (int)a - 1); + RETURN_TERM_ERROR(buff, p[1], context, *constant); + } else { + return retFail; + } + } + + *constant = 0; + + for (i = a; i > 1; --i) { + if ((ret = dmc_expr(context, heap, text, p[i], &c)) != retOk) + return ret; + if (c) + do_emit_constant(context, text, p[i]); + } + switch (b->arity) { + case 0: + DMC_PUSH(*text, matchCall0); + break; + case 1: + DMC_PUSH(*text, matchCall1); + break; + case 2: + DMC_PUSH(*text, matchCall2); + break; + case 3: + DMC_PUSH(*text, matchCall3); + break; + default: + erl_exit(1,"ets:match() internal error, " + "guard with more than 3 arguments."); + } + DMC_PUSH(*text, (Uint) b->biff); + context->stack_used -= (((int) a) - 2); + if (context->stack_used > context->stack_need) + context->stack_need = context->stack_used; + return retOk; +} + +static DMCRet dmc_expr(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm t, + int *constant) +{ + DMCRet ret; + Eterm tmp; + Eterm *p; + + + switch (t & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: + if ((ret = dmc_list(context, heap, text, t, constant)) != retOk) + return ret; + break; + case TAG_PRIMARY_BOXED: + if (!BOXED_IS_TUPLE(t)) { + goto simple_term; + } + p = tuple_val(t); +#ifdef HARDDEBUG + erts_fprintf(stderr,"%d %d %d %d\n",arityval(*p),is_tuple(tmp = p[1]), + is_atom(p[1]),db_is_variable(p[1])); +#endif + if (arityval(*p) == 1 && is_tuple(tmp = p[1])) { + if ((ret = dmc_tuple(context, heap, text, tmp, constant)) != retOk) + return ret; + } else if (arityval(*p) >= 1 && is_atom(p[1]) && + !(db_is_variable(p[1]) >= 0)) { + if ((ret = dmc_fun(context, heap, text, t, constant)) != retOk) + return ret; + } else + RETURN_TERM_ERROR("%T is neither a function call, nor a tuple " + "(tuples are written {{ ... }}).", t, + context, *constant); + break; + case TAG_PRIMARY_IMMED1: + if (db_is_variable(t) >= 0) { + if ((ret = dmc_variable(context, heap, text, t, constant)) + != retOk) + return ret; + break; + } else if (t == am_DollarUnderscore) { + if ((ret = dmc_whole_expression(context, heap, text, t, constant)) + != retOk) + return ret; + break; + } else if (t == am_DollarDollar) { + if ((ret = dmc_all_bindings(context, heap, text, t, constant)) + != retOk) + return ret; + break; + } + /* Fall through */ + default: + simple_term: + *constant = 1; + } + return retOk; +} + + +static DMCRet compile_guard_expr(DMCContext *context, + DMCHeap *heap, + DMC_STACK_TYPE(Uint) *text, + Eterm l) +{ + DMCRet ret; + int constant; + Eterm t; + + if (l != NIL) { + if (!is_list(l)) + RETURN_ERROR("Match expression is not a list.", + context, constant); + if (!(context->is_guard)) { + DMC_PUSH(*text, matchCatch); + } + while (is_list(l)) { + constant = 0; + t = CAR(list_val(l)); + if ((ret = dmc_expr(context, heap, text, t, &constant)) != + retOk) + return ret; + if (constant) { + do_emit_constant(context, text, t); + } + l = CDR(list_val(l)); + if (context->is_guard) { + DMC_PUSH(*text,matchTrue); + } else { + DMC_PUSH(*text,matchWaste); + } + --context->stack_used; + } + if (l != NIL) + RETURN_ERROR("Match expression is not a proper list.", + context, constant); + if (!(context->is_guard) && (context->cflags & DCOMP_TABLE)) { + ASSERT(matchWaste == DMC_TOP(*text)); + (void) DMC_POP(*text); + DMC_PUSH(*text, matchReturn); /* Same impact on stack as + matchWaste */ + } + } + return retOk; +} + + + + +/* +** Match compilation utility code +*/ + +/* +** Handling of bif's in match guard expressions +*/ + +static DMCGuardBif *dmc_lookup_bif(Eterm t, int arity) +{ + /* + ** Place for optimization, bsearch is slower than inlining it... + */ + DMCGuardBif node = {0,NULL,0}; + node.name = t; + node.arity = arity; + return bsearch(&node, + guard_tab, + sizeof(guard_tab) / sizeof(DMCGuardBif), + sizeof(DMCGuardBif), + (int (*)(const void *, const void *)) &cmp_guard_bif); +} + +#ifdef DMC_DEBUG +static Eterm dmc_lookup_bif_reversed(void *f) +{ + int i; + for (i = 0; i < (sizeof(guard_tab) / sizeof(DMCGuardBif)); ++i) + if (f == guard_tab[i].biff) + return guard_tab[i].name; + return am_undefined; +} +#endif + +/* For sorting. */ +static int cmp_uint(void *a, void *b) +{ + if (*((unsigned *)a) < *((unsigned *)b)) + return -1; + else + return (*((unsigned *)a) > *((unsigned *)b)); +} + +static int cmp_guard_bif(void *a, void *b) +{ + int ret; + if (( ret = ((int) atom_val(((DMCGuardBif *) a)->name)) - + ((int) atom_val(((DMCGuardBif *) b)->name)) ) == 0) { + ret = ((DMCGuardBif *) a)->arity - ((DMCGuardBif *) b)->arity; + } + return ret; +} + +/* +** Compact the variables in a match expression i e make {$1, $100, $1000} +** become {$0,$1,$2}. +*/ +static int match_compact(ErlHeapFragment *expr, DMCErrInfo *err_info) +{ + int i, j, a, n, x; + DMC_STACK_TYPE(unsigned) heap; + Eterm *p; + char buff[25] = "$"; /* large enough for 64 bit to */ + int ret; + + DMC_INIT_STACK(heap); + + p = expr->mem; + i = expr->size; + while (i--) { + if (is_thing(*p)) { + a = thing_arityval(*p); + ASSERT(a <= i); + i -= a; + p += a; + } else if (is_atom(*p) && (n = db_is_variable(*p)) >= 0) { + x = DMC_STACK_NUM(heap); + for (j = 0; j < x && DMC_PEEK(heap,j) != n; ++j) + ; + + if (j == x) + DMC_PUSH(heap,n); + } + ++p; + } + qsort(DMC_STACK_DATA(heap), DMC_STACK_NUM(heap), sizeof(unsigned), + (int (*)(const void *, const void *)) &cmp_uint); + + if (err_info != NULL) { /* lint needs a translation table */ + err_info->var_trans = erts_alloc(ERTS_ALC_T_DB_TRANS_TAB, + sizeof(unsigned)*DMC_STACK_NUM(heap)); + sys_memcpy(err_info->var_trans, DMC_STACK_DATA(heap), + DMC_STACK_NUM(heap) * sizeof(unsigned)); + err_info->num_trans = DMC_STACK_NUM(heap); + } + + p = expr->mem; + i = expr->size; + while (i--) { + if (is_thing(*p)) { + a = thing_arityval(*p); + i -= a; + p += a; + } else if (is_atom(*p) && (n = db_is_variable(*p)) >= 0) { + x = DMC_STACK_NUM(heap); +#ifdef HARDDEBUG + erts_fprintf(stderr, "%T"); +#endif + for (j = 0; j < x && DMC_PEEK(heap,j) != n; ++j) + ; + ASSERT(j < x); + sprintf(buff+1,"%u", (unsigned) j); + /* Yes, writing directly into terms, they ARE off heap */ + *p = am_atom_put(buff, strlen(buff)); + } + ++p; + } + ret = DMC_STACK_NUM(heap); + DMC_FREE(heap); + return ret; +} + +/* +** Simple size object that takes care of function calls and constant tuples +*/ +static Uint my_size_object(Eterm t) +{ + Uint sum = 0; + Eterm tmp; + Eterm *p; + switch (t & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: + sum += 2 + my_size_object(CAR(list_val(t))) + + my_size_object(CDR(list_val(t))); + break; + case TAG_PRIMARY_BOXED: + if ((((*boxed_val(t)) & + _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) != + (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE)) { + goto simple_term; + } + + if (arityval(*tuple_val(t)) == 1 && is_tuple(tmp = tuple_val(t)[1])) { + Uint i,n; + p = tuple_val(tmp); + n = arityval(p[0]); + sum += 1 + n; + for (i = 1; i <= n; ++i) + sum += my_size_object(p[i]); + } else if (arityval(*tuple_val(t)) == 2 && + is_atom(tmp = tuple_val(t)[1]) && + tmp == am_const) { + sum += size_object(tuple_val(t)[2]); + } else { + erl_exit(1,"Internal error, sizing unrecognized object in " + "(d)ets:match compilation."); + } + break; + default: + simple_term: + sum += size_object(t); + break; + } + return sum; +} + +static Eterm my_copy_struct(Eterm t, Eterm **hp, ErlOffHeap* off_heap) +{ + Eterm ret = NIL, a, b; + Eterm *p; + Uint sz; + switch (t & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: + a = my_copy_struct(CAR(list_val(t)), hp, off_heap); + b = my_copy_struct(CDR(list_val(t)), hp, off_heap); + ret = CONS(*hp, a, b); + *hp += 2; + break; + case TAG_PRIMARY_BOXED: + if (BOXED_IS_TUPLE(t)) { + if (arityval(*tuple_val(t)) == 1 && + is_tuple(a = tuple_val(t)[1])) { + Uint i,n; + Eterm *savep = *hp; + ret = make_tuple(savep); + p = tuple_val(a); + n = arityval(p[0]); + *hp += n + 1; + *savep++ = make_arityval(n); + for(i = 1; i <= n; ++i) + *savep++ = my_copy_struct(p[i], hp, off_heap); + } else if (arityval(*tuple_val(t)) == 2 && + is_atom(a = tuple_val(t)[1]) && + a == am_const) { + /* A {const, XXX} expression */ + b = tuple_val(t)[2]; + sz = size_object(b); + ret = copy_struct(b,sz,hp,off_heap); + } else { + erl_exit(1, "Trying to constant-copy non constant expression " + "0x%08x in (d)ets:match compilation.", (unsigned long) t); + } + } else { + sz = size_object(t); + ret = copy_struct(t,sz,hp,off_heap); + } + break; + default: + ret = t; + } + return ret; +} + +/* +** Compiled match bif interface +*/ +/* +** erlang:match_spec_test(MatchAgainst, MatchSpec, Type) -> +** {ok, Return, Flags, Errors} | {error, Errors} +** MatchAgainst -> if Type == trace: list() else tuple() +** MatchSpec -> MatchSpec with body corresponding to Type +** Type -> trace | table (only trace implemented in R5C) +** Return -> if Type == trace TraceReturn else {BodyReturn, VariableBindings} +** TraceReturn -> {true | false | term()} +** BodyReturn -> term() +** VariableBindings -> [term(), ...] +** Errors -> [OneError, ...] +** OneError -> {error, string()} | {warning, string()} +** Flags -> [Flag, ...] +** Flag -> return_trace (currently only flag) +*/ +BIF_RETTYPE match_spec_test_3(BIF_ALIST_3) +{ + Eterm res; +#ifdef DMC_DEBUG + if (BIF_ARG_3 == am_atom_put("dis",3)) { + test_disassemble_next = 1; + BIF_RET(am_true); + } else +#endif + if (BIF_ARG_3 == am_trace) { + res = match_spec_test(BIF_P, BIF_ARG_1, BIF_ARG_2, 1); + if (is_value(res)) { + BIF_RET(res); + } + } else if (BIF_ARG_3 == am_table) { + res = match_spec_test(BIF_P, BIF_ARG_1, BIF_ARG_2, 0); + if (is_value(res)) { + BIF_RET(res); + } + } + BIF_ERROR(BIF_P, BADARG); +} + +static Eterm match_spec_test(Process *p, Eterm against, Eterm spec, int trace) +{ + Eterm lint_res; + Binary *mps; + Eterm res; + Eterm ret; + Eterm flg; + Eterm *hp; + Eterm *arr; + int n; + Eterm l; + Uint32 ret_flags; + Uint sz; + Eterm *save_cp; + + if (trace && !(is_list(against) || against == NIL)) { + return THE_NON_VALUE; + } + if (trace) { + lint_res = db_match_set_lint(p, spec, DCOMP_TRACE | DCOMP_FAKE_DESTRUCTIVE); + mps = db_match_set_compile(p, spec, DCOMP_TRACE | DCOMP_FAKE_DESTRUCTIVE); + } else { + lint_res = db_match_set_lint(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE); + mps = db_match_set_compile(p, spec, DCOMP_TABLE | DCOMP_FAKE_DESTRUCTIVE); + } + + if (mps == NULL) { + hp = HAlloc(p,3); + ret = TUPLE2(hp, am_error, lint_res); + } else { +#ifdef DMC_DEBUG + if (test_disassemble_next) { + test_disassemble_next = 0; + db_match_dis(mps); + } +#endif /* DMC_DEBUG */ + l = against; + n = 0; + while (is_list(l)) { + ++n; + l = CDR(list_val(l)); + } + if (trace) { + if (n) + arr = erts_alloc(ERTS_ALC_T_DB_TMP, sizeof(Eterm) * n); + else + arr = NULL; + l = against; + n = 0; + while (is_list(l)) { + arr[n] = CAR(list_val(l)); + ++n; + l = CDR(list_val(l)); + } + } else { + n = 0; + arr = (Eterm *) against; + } + + /* We are in the context of a BIF, + {caller} should return 'undefined' */ + save_cp = p->cp; + p->cp = NULL; + res = erts_match_set_run(p, mps, arr, n, &ret_flags); + p->cp = save_cp; + if (is_non_value(res)) { + res = am_false; + } + sz = size_object(res); + if (ret_flags & MATCH_SET_EXCEPTION_TRACE) sz += 2; + if (ret_flags & MATCH_SET_RETURN_TRACE) sz += 2; + hp = HAlloc(p, 5 + sz); + res = copy_struct(res, sz, &hp, &MSO(p)); + flg = NIL; + if (ret_flags & MATCH_SET_EXCEPTION_TRACE) { + flg = CONS(hp, am_exception_trace, flg); + hp += 2; + } + if (ret_flags & MATCH_SET_RETURN_TRACE) { + flg = CONS(hp, am_return_trace, flg); + hp += 2; + } + if (trace && arr != NULL) { + erts_free(ERTS_ALC_T_DB_TMP, arr); + } + erts_bin_free(mps); + ret = TUPLE4(hp, am_atom_put("ok",2), res, flg, lint_res); + } + return ret; +} + +static Eterm seq_trace_fake(Process *p, Eterm arg1) +{ + Eterm result = seq_trace_info_1(p,arg1); + if (is_tuple(result) && *tuple_val(result) == 2) { + return (tuple_val(result))[2]; + } + return result; +} + +#ifdef DMC_DEBUG +/* +** Disassemble match program +*/ +static void db_match_dis(Binary *bp) +{ + MatchProg *prog = Binary2MatchProg(bp); + Uint *t = prog->text; + Uint n; + Eterm p; + int first; + ErlHeapFragment *tmp; + + while (t < prog->prog_end) { + switch (*t) { + case matchTryMeElse: + ++t; + n = *t; + ++t; + erts_printf("TryMeElse\t%bpu\n", n); + break; + case matchArray: + ++t; + n = *t; + ++t; + erts_printf("Array\t%bpu\n", n); + break; + case matchArrayBind: + ++t; + n = *t; + ++t; + erts_printf("ArrayBind\t%bpu\n", n); + break; + case matchTuple: + ++t; + n = *t; + ++t; + erts_printf("Tuple\t%bpu\n", n); + break; + case matchPushT: + ++t; + n = *t; + ++t; + erts_printf("PushT\t%bpu\n", n); + break; + case matchPushL: + ++t; + erts_printf("PushL\n"); + break; + case matchPop: + ++t; + erts_printf("Pop\n"); + break; + case matchBind: + ++t; + n = *t; + ++t; + erts_printf("Bind\t%bpu\n", n); + break; + case matchCmp: + ++t; + n = *t; + ++t; + erts_printf("Cmp\t%bpu\n", n); + break; + case matchEqBin: + ++t; + p = (Eterm) *t; + ++t; + erts_printf("EqBin\t%p (%T)\n", t, p); + break; + case matchEqRef: + ++t; + n = thing_arityval(*t); + ++t; + erts_printf("EqRef\t(%d) {", (int) n); + first = 1; + while (n--) { + if (first) + first = 0; + else + erts_printf(", "); +#ifdef ARCH_64 + erts_printf("0x%016bpx", *t); +#else + erts_printf("0x%08bpx", *t); +#endif + ++t; + } + erts_printf("}\n"); + break; + case matchEqBig: + ++t; + n = thing_arityval(*t); + ++t; + erts_printf("EqBig\t(%d) {", (int) n); + first = 1; + while (n--) { + if (first) + first = 0; + else + erts_printf(", "); +#ifdef ARCH_64 + erts_printf("0x%016bpx", *t); +#else + erts_printf("0x%08bpx", *t); +#endif + ++t; + } + erts_printf("}\n"); + break; + case matchEqFloat: + ++t; + { + double num; + memcpy(&num,t, 2 * sizeof(*t)); + t += 2; + erts_printf("EqFloat\t%f\n", num); + } + break; + case matchEq: + ++t; + p = (Eterm) *t; + ++t; + erts_printf("Eq \t%T\n", p); + break; + case matchList: + ++t; + erts_printf("List\n"); + break; + case matchHalt: + ++t; + erts_printf("Halt\n"); + break; + case matchSkip: + ++t; + erts_printf("Skip\n"); + break; + case matchPushC: + ++t; + p = (Eterm) *t; + ++t; + erts_printf("PushC\t%T\n", p); + break; + case matchConsA: + ++t; + erts_printf("ConsA\n"); + break; + case matchConsB: + ++t; + erts_printf("ConsB\n"); + break; + case matchMkTuple: + ++t; + n = *t; + ++t; + erts_printf("MkTuple\t%bpu\n", n); + break; + case matchOr: + ++t; + n = *t; + ++t; + erts_printf("Or\t%bpu\n", n); + break; + case matchAnd: + ++t; + n = *t; + ++t; + erts_printf("And\t%bpu\n", n); + break; + case matchOrElse: + ++t; + n = *t; + ++t; + erts_printf("OrElse\t%bpu\n", n); + break; + case matchAndAlso: + ++t; + n = *t; + ++t; + erts_printf("AndAlso\t%bpu\n", n); + break; + case matchCall0: + ++t; + p = dmc_lookup_bif_reversed((void *) *t); + ++t; + erts_printf("Call0\t%T\n", p); + break; + case matchCall1: + ++t; + p = dmc_lookup_bif_reversed((void *) *t); + ++t; + erts_printf("Call1\t%T\n", p); + break; + case matchCall2: + ++t; + p = dmc_lookup_bif_reversed((void *) *t); + ++t; + erts_printf("Call2\t%T\n", p); + break; + case matchCall3: + ++t; + p = dmc_lookup_bif_reversed((void *) *t); + ++t; + erts_printf("Call3\t%T\n", p); + break; + case matchPushV: + ++t; + n = (Uint) *t; + ++t; + erts_printf("PushV\t%bpu\n", n); + break; + case matchTrue: + ++t; + erts_printf("True\n"); + break; + case matchPushExpr: + ++t; + erts_printf("PushExpr\n"); + break; + case matchPushArrayAsList: + ++t; + erts_printf("PushArrayAsList\n"); + break; + case matchPushArrayAsListU: + ++t; + erts_printf("PushArrayAsListU\n"); + break; + case matchSelf: + ++t; + erts_printf("Self\n"); + break; + case matchWaste: + ++t; + erts_printf("Waste\n"); + break; + case matchReturn: + ++t; + erts_printf("Return\n"); + break; + case matchProcessDump: + ++t; + erts_printf("ProcessDump\n"); + break; + case matchDisplay: + ++t; + erts_printf("Display\n"); + break; + case matchIsSeqTrace: + ++t; + erts_printf("IsSeqTrace\n"); + break; + case matchSetSeqToken: + ++t; + erts_printf("SetSeqToken\n"); + break; + case matchSetSeqTokenFake: + ++t; + erts_printf("SetSeqTokenFake\n"); + break; + case matchGetSeqToken: + ++t; + erts_printf("GetSeqToken\n"); + break; + case matchSetReturnTrace: + ++t; + erts_printf("SetReturnTrace\n"); + break; + case matchSetExceptionTrace: + ++t; + erts_printf("SetReturnTrace\n"); + break; + case matchCatch: + ++t; + erts_printf("Catch\n"); + break; + case matchEnableTrace: + ++t; + erts_printf("EnableTrace\n"); + break; + case matchDisableTrace: + ++t; + erts_printf("DisableTrace\n"); + break; + case matchEnableTrace2: + ++t; + erts_printf("EnableTrace2\n"); + break; + case matchDisableTrace2: + ++t; + erts_printf("DisableTrace2\n"); + break; + case matchTrace2: + ++t; + erts_printf("Trace2\n"); + break; + case matchTrace3: + ++t; + erts_printf("Trace3\n"); + break; + case matchCaller: + ++t; + erts_printf("Caller\n"); + break; + default: + erts_printf("??? (0x%08x)\n", *t); + ++t; + break; + } + } + erts_printf("\n\nterm_save: {"); + first = 1; + for (tmp = prog->term_save; tmp; tmp = tmp->next) { + if (first) + first = 0; + else + erts_printf(", "); + erts_printf("0x%08x", (unsigned long) tmp); + } + erts_printf("}\n"); + erts_printf("num_bindings: %d\n", prog->num_bindings); + erts_printf("heap_size: %bpu\n", prog->heap_size); + erts_printf("eheap_offset: %bpu\n", prog->eheap_offset); + erts_printf("stack_offset: %bpu\n", prog->stack_offset); + erts_printf("text: 0x%08x\n", (unsigned long) prog->text); + erts_printf("stack_size: %d (words)\n", prog->heap_size-prog->stack_offset); + +} + +#endif /* DMC_DEBUG */ + + diff --git a/erts/emulator/beam/erl_db_util.h b/erts/emulator/beam/erl_db_util.h new file mode 100644 index 0000000000..4fc7b4f52e --- /dev/null +++ b/erts/emulator/beam/erl_db_util.h @@ -0,0 +1,405 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef _DB_UTIL_H +#define _DB_UTIL_H + +#include "global.h" +#include "erl_message.h" + +/*#define HARDDEBUG 1*/ + +#ifdef DEBUG +/* +** DMC_DEBUG does NOT need DEBUG, but DEBUG needs DMC_DEBUG +*/ +#define DMC_DEBUG 1 +#endif + +/* + * These values can be returned from the functions performing the + * BIF operation for different types of tables. When the + * actual operations have been performed, the BIF function + * checks for negative returns and issues BIF_ERRORS based + * upon these values. + */ +#define DB_ERROR_NONE 0 /* No error */ +#define DB_ERROR_BADITEM -1 /* The item was malformed ie no + tuple or to small*/ +#define DB_ERROR_BADTABLE -2 /* The Table is inconsisitent */ +#define DB_ERROR_SYSRES -3 /* Out of system resources */ +#define DB_ERROR_BADKEY -4 /* Returned if a key that should + exist does not. */ +#define DB_ERROR_BADPARAM -5 /* Returned if a specified slot does + not exist (hash table only) or + the state parameter in db_match_object + is broken.*/ +#define DB_ERROR_UNSPEC -10 /* Unspecified error */ + + +/* + * A datatype for a database entry stored out of a process heap + */ +typedef struct db_term { + ErlOffHeap off_heap; /* Off heap data for term. */ + Uint size; /* Size of term in "words" */ + Eterm tpl[1]; /* Untagged "constant pointer" to top tuple */ + /* (assumed to be first in buffer) */ +} DbTerm; + +/* "Assign" a value to DbTerm.tpl */ +#define DBTERM_SET_TPL(dbtermPtr,tplPtr) ASSERT((tplPtr)==(dbtermPtr->tpl)) +/* Get start of term buffer */ +#define DBTERM_BUF(dbtermPtr) ((dbtermPtr)->tpl) + +union db_table; +typedef union db_table DbTable; + +/* Info about a database entry while it's being updated + * (by update_counter or update_element) + */ +typedef struct { + DbTable* tb; + DbTerm* dbterm; + void** bp; /* {Hash|Tree}DbTerm** */ + Uint new_size; + int mustResize; + void* lck; +} DbUpdateHandle; + + +typedef struct db_table_method +{ + int (*db_create)(Process *p, DbTable* tb); + int (*db_first)(Process* p, + DbTable* tb, /* [in out] */ + Eterm* ret /* [out] */); + int (*db_next)(Process* p, + DbTable* tb, /* [in out] */ + Eterm key, /* [in] */ + Eterm* ret /* [out] */); + int (*db_last)(Process* p, + DbTable* tb, /* [in out] */ + Eterm* ret /* [out] */); + int (*db_prev)(Process* p, + DbTable* tb, /* [in out] */ + Eterm key, + Eterm* ret); + int (*db_put)(DbTable* tb, /* [in out] */ + Eterm obj, + int key_clash_fail); /* DB_ERROR_BADKEY if key exists */ + int (*db_get)(Process* p, + DbTable* tb, /* [in out] */ + Eterm key, + Eterm* ret); + int (*db_get_element)(Process* p, + DbTable* tb, /* [in out] */ + Eterm key, + int index, + Eterm* ret); + int (*db_member)(DbTable* tb, /* [in out] */ + Eterm key, + Eterm* ret); + int (*db_erase)(DbTable* tb, /* [in out] */ + Eterm key, + Eterm* ret); + int (*db_erase_object)(DbTable* tb, /* [in out] */ + Eterm obj, + Eterm* ret); + int (*db_slot)(Process* p, + DbTable* tb, /* [in out] */ + Eterm slot, + Eterm* ret); + int (*db_select_chunk)(Process* p, + DbTable* tb, /* [in out] */ + Eterm pattern, + Sint chunk_size, + int reverse, + Eterm* ret); + int (*db_select)(Process* p, + DbTable* tb, /* [in out] */ + Eterm pattern, + int reverse, + Eterm* ret); + int (*db_select_delete)(Process* p, + DbTable* tb, /* [in out] */ + Eterm pattern, + Eterm* ret); + int (*db_select_continue)(Process* p, + DbTable* tb, /* [in out] */ + Eterm continuation, + Eterm* ret); + int (*db_select_delete_continue)(Process* p, + DbTable* tb, /* [in out] */ + Eterm continuation, + Eterm* ret); + int (*db_select_count)(Process* p, + DbTable* tb, /* [in out] */ + Eterm pattern, + Eterm* ret); + int (*db_select_count_continue)(Process* p, + DbTable* tb, /* [in out] */ + Eterm continuation, + Eterm* ret); + + int (*db_delete_all_objects)(Process* p, + DbTable* db /* [in out] */ ); + + int (*db_free_table)(DbTable* db /* [in out] */ ); + int (*db_free_table_continue)(DbTable* db); /* [in out] */ + + void (*db_print)(int to, + void* to_arg, + int show, + DbTable* tb /* [in out] */ ); + + void (*db_foreach_offheap)(DbTable* db, /* [in out] */ + void (*func)(ErlOffHeap *, void *), + void *arg); + void (*db_check_table)(DbTable* tb); + + /* Lookup a dbterm for updating. Return false if not found. + */ + int (*db_lookup_dbterm)(DbTable*, Eterm key, + DbUpdateHandle* handle); /* [out] */ + + /* Must be called for each db_lookup_dbterm that returned true, + ** even if dbterm was not updated. + */ + void (*db_finalize_dbterm)(DbUpdateHandle* handle); + +} DbTableMethod; + +/* + * This structure contains data for all different types of database + * tables. Note that these fields must match the same fields + * in the table-type specific structures. + * The reason it is placed here and not in db.h is that some table + * operations may be the same on different types of tables. + */ + +typedef struct db_fixation { + Eterm pid; + Uint counter; + struct db_fixation *next; +} DbFixation; + + +typedef struct db_table_common { + erts_refc_t ref; + erts_refc_t fixref; /* fixation counter */ +#ifdef ERTS_SMP + erts_smp_rwmtx_t rwlock; /* rw lock on table */ + erts_smp_mtx_t fixlock; /* Protects fixations,megasec,sec,microsec */ + int is_thread_safe; /* No fine locking inside table needed */ + Uint32 type; /* table type, *read only* after creation */ +#endif + Eterm owner; /* Pid of the creator */ + Eterm heir; /* Pid of the heir */ + Eterm heir_data; /* To send in ETS-TRANSFER (is_immed or (DbTerm*) */ + SysTimeval heir_started; /* To further identify the heir */ + Eterm the_name; /* an atom */ + Eterm id; /* atom | integer */ + DbTableMethod* meth; /* table methods */ + erts_smp_atomic_t nitems; /* Total number of items in table */ + erts_smp_atomic_t memory_size;/* Total memory size. NOTE: in bytes! */ + Uint megasec,sec,microsec; /* Last fixation time */ + DbFixation* fixations; /* List of processes who have done safe_fixtable, + "local" fixations not included. */ + /* All 32-bit fields */ + Uint32 status; /* bit masks defined below */ + int slot; /* slot index in meta_main_tab */ + int keypos; /* defaults to 1 */ +} DbTableCommon; + +/* These are status bit patterns */ +#define DB_NORMAL (1 << 0) +#define DB_PRIVATE (1 << 1) +#define DB_PROTECTED (1 << 2) +#define DB_PUBLIC (1 << 3) +#define DB_BAG (1 << 4) +#define DB_SET (1 << 5) +/*#define DB_LHASH (1 << 6)*/ +#define DB_FINE_LOCKED (1 << 7) /* fine grained locking enabled */ +#define DB_DUPLICATE_BAG (1 << 8) +#define DB_ORDERED_SET (1 << 9) +#define DB_DELETE (1 << 10) /* table is being deleted */ + +#define ERTS_ETS_TABLE_TYPES (DB_BAG|DB_SET|DB_DUPLICATE_BAG|DB_ORDERED_SET|DB_FINE_LOCKED) + +#define IS_HASH_TABLE(Status) (!!((Status) & \ + (DB_BAG | DB_SET | DB_DUPLICATE_BAG))) +#define IS_TREE_TABLE(Status) (!!((Status) & \ + DB_ORDERED_SET)) +#define NFIXED(T) (erts_refc_read(&(T)->common.fixref,0)) +#define IS_FIXED(T) (NFIXED(T) != 0) + +Eterm erts_ets_copy_object(Eterm, Process*); + +/* optimised version of copy_object (normal case? atomic object) */ +#define COPY_OBJECT(obj, p, objp) \ + if (IS_CONST(obj)) { *(objp) = (obj); } \ + else { *objp = erts_ets_copy_object(obj, p); } + +#define DB_READ (DB_PROTECTED|DB_PUBLIC) +#define DB_WRITE DB_PUBLIC +#define DB_INFO (DB_PROTECTED|DB_PUBLIC|DB_PRIVATE) + +/* tb is an DbTableCommon and obj is an Eterm (tagged) */ +#define TERM_GETKEY(tb, obj) db_getkey((tb)->common.keypos, (obj)) + +#define ONLY_WRITER(P,T) (((T)->common.status & (DB_PRIVATE|DB_PROTECTED)) \ + && (T)->common.owner == (P)->id) + +#define ONLY_READER(P,T) (((T)->common.status & DB_PRIVATE) && \ +(T)->common.owner == (P)->id) + +/* Function prototypes */ +Eterm db_get_trace_control_word_0(Process *p); +Eterm db_set_trace_control_word_1(Process *p, Eterm val); + +void db_initialize_util(void); +Eterm db_getkey(int keypos, Eterm obj); +void db_free_term_data(DbTerm* p); +void* db_get_term(DbTableCommon *tb, DbTerm* old, Uint offset, Eterm obj); +int db_has_variable(Eterm obj); +int db_is_variable(Eterm obj); +void db_do_update_element(DbUpdateHandle* handle, + Sint position, + Eterm newval); +void db_finalize_update_element(DbUpdateHandle* handle); +Eterm db_add_counter(Eterm** hpp, Eterm counter, Eterm incr); +Eterm db_match_set_lint(Process *p, Eterm matchexpr, Uint flags); +Binary *db_match_set_compile(Process *p, Eterm matchexpr, + Uint flags); +void erts_db_match_prog_destructor(Binary *); + +typedef struct match_prog { + ErlHeapFragment *term_save; /* Only if needed, a list of message + buffers for off heap copies + (i.e. binaries)*/ + int single_variable; /* ets:match needs to know this. */ + int num_bindings; /* Size of heap */ + /* The following two are only filled in when match specs + are used for tracing */ + struct erl_heap_fragment *saved_program_buf; + Eterm saved_program; + Uint heap_size; /* size of: heap + eheap + stack */ + Uint eheap_offset; + Uint stack_offset; +#ifdef DMC_DEBUG + Uint* prog_end; /* End of program */ +#endif + Uint text[1]; /* Beginning of program */ +} MatchProg; + +/* + * The heap-eheap-stack block of a MatchProg is nowadays allocated + * when the match program is run. + * - heap: variable bindings + * - eheap: erlang heap storage + * - eheap: a "large enough" stack + */ + +#define DMC_ERR_STR_LEN 100 + +typedef enum { dmcWarning, dmcError} DMCErrorSeverity; + +typedef struct dmc_error { + char error_string[DMC_ERR_STR_LEN + 1]; /* printf format string + with %d for the variable + number (if applicable) */ + int variable; /* -1 if no variable is referenced + in error string */ + struct dmc_error *next; + DMCErrorSeverity severity; /* Error or warning */ +} DMCError; + +typedef struct dmc_err_info { + unsigned int *var_trans; /* Translations of variable names, + initiated to NULL + and free'd with sys_free if != NULL + after compilation */ + int num_trans; + int error_added; /* indicates if the error list contains + any fatal errors (dmcError severity) */ + DMCError *first; /* List of errors */ +} DMCErrInfo; + +/* +** Compilation flags +** +** The dialect is in the 3 least significant bits and are to be interspaced by +** by at least 2 (decimal), thats why ((Uint) 2) isn't used. This is to be +** able to add DBIF_GUARD or DBIF BODY to it to use in the match_spec bif +** table. The rest of the word is used like ordinary flags, one bit for each +** flag. Note that DCOMP_TABLE and DCOMP_TRACE are mutually exclusive. +*/ +#define DCOMP_TABLE ((Uint) 1) /* Ets and dets. The body returns a value, + * and the parameter to the execution is a tuple. */ +#define DCOMP_TRACE ((Uint) 4) /* Trace. More functions are allowed, and the + * parameter to the execution will be an array. */ +#define DCOMP_DIALECT_MASK ((Uint) 0x7) /* To mask out the bits marking + dialect */ +#define DCOMP_FAKE_DESTRUCTIVE ((Uint) 8) /* When this is active, no setting of + trace control words or seq_trace tokens will be done. */ + + +Binary *db_match_compile(Eterm *matchexpr, Eterm *guards, + Eterm *body, int num_matches, + Uint flags, + DMCErrInfo *err_info); +/* Returns newly allocated MatchProg binary with refc == 0*/ +Eterm db_prog_match(Process *p, Binary *prog, Eterm term, int arity, + Uint32 *return_flags /* Zeroed on enter */); +/* returns DB_ERROR_NONE if matches, 1 if not matches and some db error on + error. */ +DMCErrInfo *db_new_dmc_err_info(void); +/* Returns allocated error info, where errors are collected for lint. */ +Eterm db_format_dmc_err_info(Process *p, DMCErrInfo *ei); +/* Formats an error info structure into a list of tuples. */ +void db_free_dmc_err_info(DMCErrInfo *ei); +/* Completely free's an error info structure, including all recorded + errors */ +Eterm db_make_mp_binary(Process *p, Binary *mp, Eterm **hpp); +/* Convert a match program to a erlang "magic" binary to be returned to userspace, + increments the reference counter. */ +int erts_db_is_compiled_ms(Eterm term); + +/* +** Convenience when compiling into Binary structures +*/ +#define IsMatchProgBinary(BP) \ + (((BP)->flags & BIN_FLAG_MAGIC) \ + && ERTS_MAGIC_BIN_DESTRUCTOR((BP)) == erts_db_match_prog_destructor) + +#define Binary2MatchProg(BP) \ + (ASSERT_EXPR(IsMatchProgBinary((BP))), \ + ((MatchProg *) ERTS_MAGIC_BIN_DATA((BP)))) +/* +** Debugging +*/ +#ifdef HARDDEBUG +void db_check_tables(void); /* in db.c */ +#define CHECK_TABLES() db_check_tables() +#else +#define CHECK_TABLES() +#endif + +#endif /* _DB_UTIL_H */ diff --git a/erts/emulator/beam/erl_debug.c b/erts/emulator/beam/erl_debug.c new file mode 100644 index 0000000000..34ce87bc5d --- /dev/null +++ b/erts/emulator/beam/erl_debug.c @@ -0,0 +1,899 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "erl_nmgc.h" +#include "big.h" +#include "bif.h" +#include "beam_catches.h" +#include "erl_debug.h" + +#define WITHIN(ptr, x, y) ((x) <= (ptr) && (ptr) < (y)) + +#if defined(HYBRID) +#if defined(INCREMENTAL) +/* Hybrid + Incremental */ +#define IN_HEAP(p, ptr) \ + (WITHIN((ptr), p->heap, p->hend) || \ + (OLD_HEAP(p) && WITHIN((ptr), OLD_HEAP(p), OLD_HEND(p))) || \ + WITHIN((ptr), global_heap, global_hend) || \ + (inc_fromspc && WITHIN((ptr), inc_fromspc, inc_fromend)) || \ + WITHIN((ptr), global_old_heap, global_old_hend)) + +#define IN_MA(ptr) \ + (WITHIN((ptr), global_heap, global_hend) || \ + (inc_fromspc && WITHIN((ptr), inc_fromspc, inc_fromend)) || \ + WITHIN((ptr), global_old_heap, global_old_hend)) +#else +/* Hybrid */ +#define IN_HEAP(p, ptr) \ + (WITHIN((ptr), p->heap, p->hend) || \ + (OLD_HEAP(p) && WITHIN((ptr), OLD_HEAP(p), OLD_HEND(p))) || \ + WITHIN((ptr), global_heap, global_hend) || \ + (global_old_heap && WITHIN((ptr),global_old_heap,global_old_hend))) +#endif +#else +/* Private */ +#define IN_HEAP(p, ptr) \ + (WITHIN((ptr), p->heap, p->hend) || \ + (OLD_HEAP(p) && WITHIN((ptr), OLD_HEAP(p), OLD_HEND(p)))) +#endif + + +#ifdef __GNUC__ +/* + * Does not work in Microsoft C. Since this is debugging code that will + * hardly be used on Windows, get rid of it unless we have Gnu compiler. + */ +#define PTR_SIZE 2*(int)sizeof(long) + +static const char dashes[PTR_SIZE+3] = { + [0 ... PTR_SIZE+1] = '-' +}; +#endif + +#if defined(DEBUG) && defined(__GNUC__) + +/* + * This file defines functions for use within a debugger like gdb + * and the declarations below is just to make gcc quiet. + */ + +void pps(Process*, Eterm*); +void ptd(Process*, Eterm); +void paranoid_display(int, void*, Process*, Eterm); +static int dcount; + +static int pdisplay1(int to, void *to_arg, Process* p, Eterm obj); + +void ptd(Process* p, Eterm x) +{ + pdisplay1(ERTS_PRINT_STDERR, NULL, p, x); + erts_putc(ERTS_PRINT_STDERR, NULL, '\n'); +} + +/* + * Paranoid version of display which doesn't crasch as easily if there + * are errors in the data structures. + */ + +void +paranoid_display(int to, void *to_arg, Process* p, Eterm obj) +{ + dcount = 100000; + pdisplay1(to, to_arg, p, obj); +} + +static int +pdisplay1(int to, void *to_arg, Process* p, Eterm obj) +{ + int i, k; + Eterm* nobj; + + if (dcount-- <= 0) + return(1); + + if (is_CP(obj)) { + erts_print(to, to_arg, "#", obj); + return 1; + } + + i = BIG_SIZE(nobj); + if (BIG_SIGN(nobj)) + erts_print(to, to_arg, "-#integer(%d) = {", i); + else + erts_print(to, to_arg, "#integer(%d) = {", i); + erts_print(to, to_arg, "%d", BIG_DIGIT(nobj, 0)); + for (k = 1; k < i; k++) + erts_print(to, to_arg, ",%d", BIG_DIGIT(nobj, k)); + erts_putc(to, to_arg, '}'); + break; + case REF_DEF: + case EXTERNAL_REF_DEF: { + Uint32 *ref_num; + erts_print(to, to_arg, "#Ref<%lu", ref_channel_no(obj)); + ref_num = ref_numbers(obj); + for (i = ref_no_of_numbers(obj)-1; i >= 0; i--) + erts_print(to, to_arg, ",%lu", ref_num[i]); + erts_print(to, to_arg, ">"); + break; + } + case PID_DEF: + case EXTERNAL_PID_DEF: + erts_print(to, to_arg, "<%lu.%lu.%lu>", + pid_channel_no(obj), + pid_number(obj), + pid_serial(obj)); + break; + case PORT_DEF: + case EXTERNAL_PORT_DEF: + erts_print(to, to_arg, "#Port<%lu.%lu>", + port_channel_no(obj), + port_number(obj)); + break; + case LIST_DEF: + erts_putc(to, to_arg, '['); + nobj = list_val(obj); + while (1) { + if (!IN_HEAP(p, nobj)) { + erts_print(to, to_arg, "#", obj); + return 1; + } + if (pdisplay1(to, to_arg, p, *nobj++) != 0) + return(1); + if (is_not_list(*nobj)) + break; + erts_putc(to, to_arg, ','); + nobj = list_val(*nobj); + } + if (is_not_nil(*nobj)) { + erts_putc(to, to_arg, '|'); + if (pdisplay1(to, to_arg, p, *nobj) != 0) + return(1); + } + erts_putc(to, to_arg, ']'); + break; + case TUPLE_DEF: + nobj = tuple_val(obj); /* pointer to arity */ + i = arityval(*nobj); /* arity */ + erts_putc(to, to_arg, '{'); + while (i--) { + if (pdisplay1(to, to_arg, p, *++nobj) != 0) return(1); + if (i >= 1) erts_putc(to, to_arg, ','); + } + erts_putc(to, to_arg, '}'); + break; + case FLOAT_DEF: { + FloatDef ff; + GET_DOUBLE(obj, ff); +#ifdef _OSE_ + erts_print(to, to_arg, "%e", ff.fd); +#else + erts_print(to, to_arg, "%.20e", ff.fd); +#endif + } + break; + case BINARY_DEF: + erts_print(to, to_arg, "#Bin"); + break; + default: + erts_print(to, to_arg, "unknown object %x", obj); + } + return(0); +} + +void +pps(Process* p, Eterm* stop) +{ + int to = ERTS_PRINT_STDOUT; + void *to_arg = NULL; + Eterm* sp = STACK_START(p) - 1; + + if (stop <= STACK_END(p)) { + stop = STACK_END(p) + 1; + } + + while(sp >= stop) { + erts_print(to, to_arg, "%0*lx: ", PTR_SIZE, (Eterm) sp); + if (is_catch(*sp)) { + erts_print(to, to_arg, "catch %d", (Uint)catch_pc(*sp)); + } else { + paranoid_display(to, to_arg, p, *sp); + } + erts_putc(to, to_arg, '\n'); + sp--; + } +} + +#endif /* DEBUG */ + +static int verify_eterm(Process *p,Eterm element); +static int verify_eterm(Process *p,Eterm element) +{ + Eterm *ptr; + ErlHeapFragment* mbuf; + + switch (primary_tag(element)) { + case TAG_PRIMARY_LIST: ptr = list_val(element); break; + case TAG_PRIMARY_BOXED: ptr = boxed_val(element); break; + default: /* Immediate or header/cp */ return 1; + } + + if (p) { + if (IN_HEAP(p, ptr)) + return 1; + + for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next) { + if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->size)) { + return 1; + } + } + } +#ifdef INCREMENTAL + else { + if (IN_MA(ptr)) + return 1; + } +#endif + + return 0; +} + +void erts_check_stack(Process *p) +{ + Eterm *elemp; + Eterm *stack_start = p->heap + p->heap_sz; + Eterm *stack_end = p->htop; + + if (p->stop > stack_start) + erl_exit(1, + "<%lu.%lu.%lu>: Stack underflow\n", + internal_pid_channel_no(p->id), + internal_pid_number(p->id), + internal_pid_serial(p->id)); + + if (p->stop < stack_end) + erl_exit(1, + "<%lu.%lu.%lu>: Stack overflow\n", + internal_pid_channel_no(p->id), + internal_pid_number(p->id), + internal_pid_serial(p->id)); + + for (elemp = p->stop; elemp < stack_start; elemp++) { + int in_mbuf = 0; + Eterm *ptr; + ErlHeapFragment* mbuf; + switch (primary_tag(*elemp)) { + case TAG_PRIMARY_LIST: ptr = list_val(*elemp); break; + case TAG_PRIMARY_BOXED: ptr = boxed_val(*elemp); break; + default: /* Immediate or cp */ continue; + } + if (IN_HEAP(p, ptr)) + continue; + for (mbuf = p->mbuf; mbuf; mbuf = mbuf->next) + if (WITHIN(ptr, &mbuf->mem[0], &mbuf->mem[0] + mbuf->size)) { + in_mbuf = 1; + break; + } + if (in_mbuf) + continue; + + erl_exit(1, + "<%lu.%lu.%lu>: Wild stack pointer\n", + internal_pid_channel_no(p->id), + internal_pid_number(p->id), + internal_pid_serial(p->id)); + } + +} + +#if defined(CHECK_FOR_HOLES) +static void check_memory(Eterm *start, Eterm *end); + +void erts_check_for_holes(Process* p) +{ + ErlHeapFragment* hf; + Eterm* start; + + start = p->last_htop ? p->last_htop : HEAP_START(p); + check_memory(start, HEAP_TOP(p)); + p->last_htop = HEAP_TOP(p); + + for (hf = MBUF(p); hf != 0; hf = hf->next) { + if (hf == p->last_mbuf) { + break; + } + check_memory(hf->mem, hf->mem+hf->size); + } + p->last_mbuf = MBUF(p); +} + +static void check_memory(Eterm *start, Eterm *end) +{ + Eterm *pos = start; + + while (pos < end) { + Eterm hval = *pos++; + + if (hval == ERTS_HOLE_MARKER) { + erts_fprintf(stderr,"%s, line %d: ERTS_HOLE_MARKER found at 0x%0*lx\n", + __FILE__, __LINE__,PTR_SIZE,(unsigned long)(pos-1)); + print_untagged_memory(start,end); /* DEBUGSTUFF */ + abort(); + } else if (is_thing(hval)) { + pos += (thing_arityval(hval)); + } + } +} +#endif + +#ifdef __GNUC__ + +/* + * erts_check_heap and erts_check_memory will run through the heap + * silently if everything is ok. If there are strange (untagged) data + * in the heap or wild pointers, the system will be halted with an + * error message. + */ +void erts_check_heap(Process *p) +{ + ErlHeapFragment* bp = MBUF(p); + + erts_check_memory(p,HEAP_START(p),HEAP_TOP(p)); + if (OLD_HEAP(p) != NULL) { + erts_check_memory(p,OLD_HEAP(p),OLD_HTOP(p)); + } + + while (bp) { + erts_check_memory(p,bp->mem,bp->mem + bp->size); + bp = bp->next; + } +} + +void erts_check_memory(Process *p, Eterm *start, Eterm *end) +{ + Eterm *pos = start; + + while (pos < end) { + Eterm hval = *pos++; + +#ifdef DEBUG + if (hval == DEBUG_BAD_WORD) { + print_untagged_memory(start, end); + erl_exit(1, "Uninitialized HAlloc'ed memory found @ 0x%0*lx!\n", + PTR_SIZE,(unsigned long)(pos - 1)); + } +#endif + + if (is_thing(hval)) { + pos += thing_arityval(hval); + continue; + } + + if (verify_eterm(p,hval)) + continue; + + erl_exit(1, "Wild pointer found @ 0x%0*lx!\n", + PTR_SIZE,(unsigned long)(pos - 1)); + } +} + +void verify_process(Process *p) +{ +#define VERIFY_AREA(name,ptr,sz) { \ + int n = (sz); \ + while (n--) if(!verify_eterm(p,*(ptr+n))) \ + erl_exit(1,"Wild pointer found in " name " of %T!\n",p->id); } + +#define VERIFY_ETERM(name,eterm) { \ + if(!verify_eterm(p,eterm)) \ + erl_exit(1,"Wild pointer found in " name " of %T!\n",p->id); } + + + ErlMessage* mp = p->msg.first; + + VERBOSE(DEBUG_MEMORY,("Verify process: %T...\n",p->id)); + + while (mp != NULL) { + VERIFY_ETERM("message term",ERL_MESSAGE_TERM(mp)); + VERIFY_ETERM("message token",ERL_MESSAGE_TOKEN(mp)); + mp = mp->next; + } + + erts_check_stack(p); + erts_check_heap(p); + + if (p->dictionary) + VERIFY_AREA("dictionary",p->dictionary->data, p->dictionary->used); + VERIFY_ETERM("seq trace token",p->seq_trace_token); + VERIFY_ETERM("group leader",p->group_leader); + VERIFY_ETERM("fvalue",p->fvalue); + VERIFY_ETERM("ftrace",p->ftrace); + +#ifdef HYBRID + VERIFY_AREA("rrma",p->rrma,p->nrr); +#endif + + VERBOSE(DEBUG_MEMORY,("...done\n")); + +#undef VERIFY_AREA +#undef VERIFY_ETERM +} + +void verify_everything() +{ +#ifdef HYBRID + Uint i; + Uint n = erts_num_active_procs; + +#ifdef INCREMENTAL_FREE_SIZES_NEEDS_TO_BE_TAGGED_AS_HEADERS_WITH_ARITY + INC_Page *page = inc_used_mem; +#endif + + for (i = 0; i < n; i++) { + verify_process(erts_active_procs[i]); + } + + erts_check_memory(NULL,global_heap,global_htop); + +#ifdef INCREMENTAL_FREE_SIZES_NEEDS_TO_BE_TAGGED_AS_HEADERS_WITH_ARITY + while (page) + { + Eterm *end = page + INC_PAGE_SIZE; + Eterm *pos = page->start; + + while( pos < end) { + Eterm val = *pos++; + if(is_header(val)) + pos += thing_arityval(val); + else + verify_eterm(NULL,val); + } + page = page->next; + } +#endif +#endif /* HYBRID */ +} + +/* + * print_untagged_memory will print the contents of given memory area. + */ +void print_untagged_memory(Eterm *pos, Eterm *end) +{ + int i = 0; + erts_printf("| %*s | Range: 0x%0*lx - 0x%0*lx%*s|\n", + PTR_SIZE, "", + PTR_SIZE,(unsigned long)pos, + PTR_SIZE,(unsigned long)(end - 1),2 * PTR_SIZE - 2,""); + erts_printf("| %-*s | %-*s |\n",PTR_SIZE+2,"Address", + 4*PTR_SIZE+11,"Contents"); + erts_printf("|-%s-|-%s-%s-%s-%s-|\n",dashes,dashes,dashes,dashes,dashes); + while( pos < end ) { + if (i == 0) + erts_printf("| 0x%0*lx | ", PTR_SIZE, (unsigned long)pos); + erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)*pos); + pos++; i++; + if (i == 4) { + erts_printf("|\n"); + i = 0; + } + } + while (i && i < 4) { + erts_printf("%*s",PTR_SIZE+3,""); + i++; + } + if (i != 0) + erts_printf("|\n"); + erts_printf("+-%s-+-%s-%s-%s-%s-+\n",dashes,dashes,dashes,dashes,dashes); +} + +/* + * print_tagged_memory will print contents of given memory area and + * display it as if it was tagged Erlang terms (which it hopefully + * is). This function knows about forwarding pointers to be able to + * print a heap during garbage collection. erts_printf("%T",val) + * do not know about forwarding pointers though, so it will still + * crash if they are encoutered... + */ +void print_tagged_memory(Eterm *pos, Eterm *end) +{ + erts_printf("+-%s-+-%s-+\n",dashes,dashes); + erts_printf("| 0x%0*lx - 0x%0*lx |\n", + PTR_SIZE,(unsigned long)pos, + PTR_SIZE,(unsigned long)(end - 1)); + erts_printf("| %-*s | %-*s |\n",PTR_SIZE,"Address",PTR_SIZE,"Contents"); + erts_printf("|-%s-|-%s-|\n",dashes,dashes); + while( pos < end ) { + Eterm val = pos[0]; + erts_printf("| 0x%0*lx | 0x%0*lx | ", + PTR_SIZE,(unsigned long)pos, PTR_SIZE,(unsigned long)val); + ++pos; + if( is_arity_value(val) ) { + erts_printf("Arity(%lu)", arityval(val)); + } else if( is_thing(val) ) { + unsigned int ari = thing_arityval(val); + erts_printf("Thing Arity(%u) Tag(%lu)", ari, thing_subtag(val)); + while( ari ) { + erts_printf("\n| 0x%0*lx | 0x%0*lx | THING", + PTR_SIZE, (unsigned long)pos, + PTR_SIZE, (unsigned long)*pos); + ++pos; + --ari; + } + } else { + switch (primary_tag(val)) { + case TAG_PRIMARY_BOXED: + if (!is_header(*boxed_val(val))) { + erts_printf("Moved -> 0x%0*lx\n",PTR_SIZE, + (unsigned long)*boxed_val(val)); + continue; + } + break; + + case TAG_PRIMARY_LIST: + if (is_non_value(*list_val(val))) { + erts_printf("Moved -> 0x%0*lx\n",PTR_SIZE, + (unsigned long)*(list_val(val) + 1)); + continue; + } + break; + } + erts_printf("%.30T", val); + } + erts_printf("\n"); + } + erts_printf("+-%s-+-%s-+\n",dashes,dashes); +} + +#ifdef HYBRID +void print_ma_info(void) +{ + erts_printf("Message Area (start - top - end): " + "0x%0*lx - 0x%0*lx - 0x%0*lx\n", + PTR_SIZE, (unsigned long)global_heap, + PTR_SIZE, (unsigned long)global_htop, + PTR_SIZE, (unsigned long)global_hend); +#ifndef INCREMENTAL + erts_printf(" High water: 0x%0*lx " + "Old gen: 0x%0*lx - 0x%0*lx - 0x%0*lx\n", + PTR_SIZE, (unsigned long)global_high_water, + PTR_SIZE, (unsigned long)global_old_heap, + PTR_SIZE, (unsigned long)global_old_htop, + PTR_SIZE, (unsigned long)global_old_hend); +#endif +} + +void print_message_area(void) +{ + Eterm *pos = global_heap; + Eterm *end = global_htop; + + erts_printf("From: 0x%0*lx to 0x%0*lx\n", + PTR_SIZE,(unsigned long)pos,PTR_SIZE,(unsigned long)end); + erts_printf("(Old generation: 0x%0*lx to 0x%0*lx\n", + PTR_SIZE, (unsigned long)global_old_heap, + PTR_SIZE, (unsigned long)global_old_hend); + erts_printf("| %-*s | %-*s |\n",PTR_SIZE,"Address",PTR_SIZE,"Contents"); + erts_printf("|-%s-|-%s-|\n",dashes,dashes); + while( pos < end ) { + Eterm val = pos[0]; + erts_printf("| 0x%0*lx | 0x%0*lx | ", + PTR_SIZE,(unsigned long)pos,PTR_SIZE,(unsigned long)val); + ++pos; + if( is_arity_value(val) ) { + erts_printf("Arity(%lu)", arityval(val)); + } else if( is_thing(val) ) { + unsigned int ari = thing_arityval(val); + erts_printf("Thing Arity(%u) Tag(%lu)", ari, thing_subtag(val)); + while( ari ) { + erts_printf("\n| 0x%0*lx | 0x%0*lx | THING", + PTR_SIZE, (unsigned long)pos, + PTR_SIZE, (unsigned long)*pos); + ++pos; + --ari; + } + } else + erts_printf("%.30T", val); + erts_printf("\n"); + } + erts_printf("+-%s-+-%s-+\n",dashes,dashes); +} + +void check_message_area() +{ + Eterm *pos = global_heap; + Eterm *end = global_htop; + + while( pos < end ) { + Eterm val = *pos++; + if(is_header(val)) + pos += thing_arityval(val); + else if(!is_immed(val)) + if ((ptr_val(val) < global_heap || ptr_val(val) >= global_htop) && + (ptr_val(val) < global_old_heap || + ptr_val(val) >= global_old_hend)) + { + erts_printf("check_message_area: Stray pointer found\n"); + print_message_area(); + erts_printf("Crashing to make it look real...\n"); + pos = 0; + } + } +} +#endif /* HYBRID */ + +static void print_process_memory(Process *p); +static void print_process_memory(Process *p) +{ + ErlHeapFragment* bp = MBUF(p); + + erts_printf("==============================\n"); + erts_printf("|| Memory info for %T ||\n",p->id); + erts_printf("==============================\n"); + + erts_printf("-- %-*s ---%s-%s-%s-%s--\n", + PTR_SIZE, "PCB", dashes, dashes, dashes, dashes); + + if (p->msg.first != NULL) { + ErlMessage* mp; + erts_printf(" Message Queue:\n"); + mp = p->msg.first; + while (mp != NULL) { + erts_printf("| 0x%0*lx | 0x%0*lx |\n",PTR_SIZE, + ERL_MESSAGE_TERM(mp),PTR_SIZE,ERL_MESSAGE_TOKEN(mp)); + mp = mp->next; + } + } + + if (p->dictionary != NULL) { + int n = p->dictionary->used; + Eterm *ptr = p->dictionary->data; + erts_printf(" Dictionary: "); + while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)ptr++); + erts_printf("\n"); + } + + if (p->arity > 0) { + int n = p->arity; + Eterm *ptr = p->arg_reg; + erts_printf(" Argument Registers: "); + while (n--) erts_printf("0x%0*lx ",PTR_SIZE,(unsigned long)*ptr++); + erts_printf("\n"); + } + + erts_printf(" Trace Token: 0x%0*lx\n",PTR_SIZE,p->seq_trace_token); + erts_printf(" Group Leader: 0x%0*lx\n",PTR_SIZE,p->group_leader); + erts_printf(" Fvalue: 0x%0*lx\n",PTR_SIZE,p->fvalue); + erts_printf(" Ftrace: 0x%0*lx\n",PTR_SIZE,p->ftrace); + +#ifdef HYBRID + if (p->nrr > 0) { + int i; + erts_printf(" Remembered Roots:\n"); + for (i = 0; i < p->nrr; i++) + if (p->rrsrc[i] != NULL) + erts_printf("0x%0*lx -> 0x%0*lx\n", + PTR_SIZE, (unsigned long)p->rrsrc[i], + PTR_SIZE, (unsigned long)p->rrma[i]); + erts_printf("\n"); + } +#endif + + erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx %s-%s-+\n", + PTR_SIZE, "Stack", + PTR_SIZE, (unsigned long)STACK_TOP(p), + PTR_SIZE, (unsigned long)STACK_START(p), + dashes, dashes); + print_untagged_memory(STACK_TOP(p),STACK_START(p)); + + erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx 0x%0*lx 0x%0*lx +\n", + PTR_SIZE, "Heap", + PTR_SIZE, (unsigned long)HEAP_START(p), + PTR_SIZE, (unsigned long)HIGH_WATER(p), + PTR_SIZE, (unsigned long)HEAP_TOP(p), + PTR_SIZE, (unsigned long)HEAP_END(p)); + print_untagged_memory(HEAP_START(p),HEAP_TOP(p)); + + if (OLD_HEAP(p)) { + erts_printf("+- %-*s -+ 0x%0*lx 0x%0*lx 0x%0*lx %s-+\n", + PTR_SIZE, "Old Heap", + PTR_SIZE, (unsigned long)OLD_HEAP(p), + PTR_SIZE, (unsigned long)OLD_HTOP(p), + PTR_SIZE, (unsigned long)OLD_HEND(p), + dashes); + print_untagged_memory(OLD_HEAP(p),OLD_HTOP(p)); + } + + if (bp) + erts_printf("+- %-*s -+-%s-%s-%s-%s-+\n", + PTR_SIZE, "heap fragments", + dashes, dashes, dashes, dashes); + while (bp) { + print_untagged_memory(bp->mem,bp->mem + bp->size); + bp = bp->next; + } +} + + +void print_memory(Process *p) +{ + if (p != NULL) { + print_process_memory(p); + } +#ifdef HYBRID + else { + Uint i; + Uint n = erts_num_active_procs; + + for (i = 0; i < n; i++) { + Process *p = erts_active_procs[i]; + print_process_memory(p); + } + + erts_printf("==================\n"); + erts_printf("|| Message area ||\n"); + erts_printf("==================\n"); + erts_printf("+-%s-+-%s-%s-%s-%s-+\n", + dashes,dashes,dashes,dashes,dashes); + erts_printf("| %-*s | 0x%0*lx - 0x%0*lx - 0x%0*lx%*s|\n", + PTR_SIZE, "Young", + PTR_SIZE, (unsigned long)global_heap, + PTR_SIZE, (unsigned long)global_htop, + PTR_SIZE, (unsigned long)global_hend, + PTR_SIZE, ""); + erts_printf("+-%s-+-%s-%s-%s-%s-+\n", + dashes,dashes,dashes,dashes,dashes); + + print_untagged_memory(global_heap,global_htop); + + + erts_printf("+-%s-+-%s-%s-%s-%s-+\n", + dashes,dashes,dashes,dashes,dashes); + erts_printf("| %-*s | 0x%0*lx - 0x%0*lx %*s |\n", + PTR_SIZE, "Old", + PTR_SIZE, (unsigned long)global_old_heap, + PTR_SIZE, (unsigned long)global_old_hend, + 2 * PTR_SIZE, ""); + erts_printf("+-%s-+-%s-%s-%s-%s-+\n", + dashes,dashes,dashes,dashes,dashes); + +#ifdef INCREMENTAL + { + INC_Page *page = inc_used_mem; + /* Genom att gå igenom fri-listan först kan vi markera de + områden som inte är allokerade och bara skriva ut de som + lever. + char markarea[INC_PAGESIZE]; + */ + + while (page) { + Eterm *ptr = (Eterm*)page->start; + Eterm *end = (Eterm*)page->start + INC_PAGESIZE; + + erts_printf("| %*s | This: 0x%0*lx Next: 0x%0*lx %*s|\n", + PTR_SIZE, "", + PTR_SIZE, (unsigned long)page, + PTR_SIZE, (unsigned long)page->next, + 2 * PTR_SIZE - 8, ""); + print_untagged_memory(ptr,end); + page = page->next; + } + } + + { + INC_MemBlock *this = inc_free_list; + + erts_printf("-- %-*s --%s-%s-%s-%s-\n",PTR_SIZE+2,"Free list", + dashes,dashes,dashes,dashes); + while (this) { + erts_printf("Block @ 0x%0*lx sz: %8d prev: 0x%0*lx next: 0x%0*lx\n", + PTR_SIZE, (unsigned long)this,this->size, + PTR_SIZE, (unsigned long)this->prev, + PTR_SIZE, (unsigned long)this->next); + this = this->next; + } + erts_printf("--%s---%s-%s-%s-%s--\n", + dashes,dashes,dashes,dashes,dashes); + } + + if (inc_fromspc != NULL) { + erts_printf("-- fromspace - 0x%0*lx 0x%0*lx " + "------------------------------\n", + PTR_SIZE, (unsigned long)inc_fromspc, + PTR_SIZE, (unsigned long)inc_fromend); + print_untagged_memory(inc_fromspc,inc_fromend); + } +#endif /* INCREMENTAL */ + } +#endif /* HYBRID */ +} + +void print_memory_info(Process *p) +{ + if (p != NULL) { + erts_printf("======================================\n"); + erts_printf("|| Memory info for %-12T ||\n",p->id); + erts_printf("======================================\n"); + erts_printf("+- local heap ----%s-%s-%s-%s-+\n", + dashes,dashes,dashes,dashes); + erts_printf("| Young | 0x%0*lx - (0x%0*lx) - 0x%0*lx - 0x%0*lx |\n", + PTR_SIZE, (unsigned long)HEAP_START(p), + PTR_SIZE, (unsigned long)HIGH_WATER(p), + PTR_SIZE, (unsigned long)HEAP_TOP(p), + PTR_SIZE, (unsigned long)HEAP_END(p)); + if (OLD_HEAP(p) != NULL) + erts_printf("| Old | 0x%0*lx - 0x%0*lx - 0x%0*lx %*s |\n", + PTR_SIZE, (unsigned long)OLD_HEAP(p), + PTR_SIZE, (unsigned long)OLD_HTOP(p), + PTR_SIZE, (unsigned long)OLD_HEND(p), + PTR_SIZE, ""); + } else { + erts_printf("=================\n"); + erts_printf("|| Memory info ||\n"); + erts_printf("=================\n"); + } +#ifdef HYBRID + erts_printf("|- message area --%s-%s-%s-%s-|\n", + dashes,dashes,dashes,dashes); + erts_printf("| Young | 0x%0*lx - 0x%0*lx - 0x%0*lx %*s |\n", + PTR_SIZE, (unsigned long)global_heap, + PTR_SIZE, (unsigned long)global_htop, + PTR_SIZE, (unsigned long)global_hend, + PTR_SIZE, ""); + erts_printf("| Old | 0x%0*lx - 0x%0*lx %*s |\n", + PTR_SIZE, (unsigned long)global_old_heap, + PTR_SIZE, (unsigned long)global_old_hend, + 2 * PTR_SIZE, ""); +#endif +#ifdef INCREMENTAL + if (inc_fromspc != NULL) + erts_printf("| Frmsp | 0x%0*lx - 0x%0*lx %*s |\n", + PTR_SIZE, (unsigned long)inc_fromspc, + PTR_SIZE, (unsigned long)inc_fromend, + 2 * PTR_SIZE, ""); +#endif + erts_printf("+-----------------%s-%s-%s-%s-+\n",dashes,dashes,dashes,dashes); +} +#endif + diff --git a/erts/emulator/beam/erl_debug.h b/erts/emulator/beam/erl_debug.h new file mode 100644 index 0000000000..74f4a00b63 --- /dev/null +++ b/erts/emulator/beam/erl_debug.h @@ -0,0 +1,102 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef _ERL_DEBUG_H_ +#define _ERL_DEBUG_H_ + +#ifdef DEBUG + +#ifdef HIPE +#include "hipe_debug.h" +#endif + +/* Heap areas will be filled with this value when they are deallocated + * after a garbage collection. This value used to be 0xff, but that is + * an immediate and might not crash the system if it is encountered. + * The value is now 0x01, the cons of death. + */ +#define DEBUG_BAD_BYTE 0x01 +#define DEBUG_BAD_WORD 0x01010101 + +/* + * VERBOSE. Use the -v option to enable the different categories. + */ +#define VERBOSE(flag, format) (flag & verbose ? erts_printf format : 0) + +#define DEBUG_DEFAULT 0x0000 /* No flags are set per default */ +#define DEBUG_SYSTEM 0x0001 /* Misc system info at startup and end */ +#define DEBUG_PRIVATE_GC 0x0002 /* GC of private heaps */ +#define DEBUG_HYBRID_GC 0x0004 /* GC of the message area */ +#define DEBUG_ALLOCATION 0x0008 /* HAlloc. To find holes in the heap */ +#define DEBUG_MESSAGES 0x0010 /* Message passing */ +#define DEBUG_THREADS 0x0020 /* Thread-related stuff */ +#define DEBUG_PROCESSES 0x0040 /* Process creation and removal */ +#define DEBUG_MEMORY 0x0080 /* Display results of memory checks */ + +extern Uint32 verbose; + +void upp(byte*, int); +void pat(Eterm); +void pinfo(void); +void pp(Process*); +void ppi(Eterm); +void pba(Process*, int); +void td(Eterm); +void ps(Process*, Eterm*); + +#undef ERTS_OFFHEAP_DEBUG +#define ERTS_OFFHEAP_DEBUG + +#else /* Non-debug mode */ + +#define VERBOSE(flag,format) + +#endif /* DEBUG */ + +#ifdef ERTS_OFFHEAP_DEBUG +#define ERTS_CHK_OFFHEAP(P) erts_check_off_heap((P)) +#define ERTS_CHK_OFFHEAP2(P, HT) erts_check_off_heap2((P), (HT)) +void erts_check_off_heap(Process *); +void erts_check_off_heap2(Process *, Eterm *); +#else +#define ERTS_CHK_OFFHEAP(P) +#define ERTS_CHK_OFFHEAP2(P, HT) +#endif + +/* + * These functions can be handy when developing, and perhaps useful + * even outside debugging. + */ +extern void erts_check_off_heap(Process *p); +extern void erts_check_stack(Process *p); +extern void erts_check_heap(Process *p); +extern void erts_check_memory(Process *p, Eterm *start, Eterm *end); +extern void verify_process(Process *p); +extern void verify_everything(void); +extern void print_tagged_memory(Eterm *start, Eterm *end); +extern void print_untagged_memory(Eterm *start, Eterm *end); +extern void print_memory(Process *p); +extern void print_memory_info(Process *p); + +#ifdef HYBRID +extern void print_ma_info(void); +extern void print_message_area(void); +extern void check_message_area(void); +#endif + +#endif /* _ERL_DEBUG_H_ */ diff --git a/erts/emulator/beam/erl_driver.h b/erts/emulator/beam/erl_driver.h new file mode 100644 index 0000000000..cdb584b282 --- /dev/null +++ b/erts/emulator/beam/erl_driver.h @@ -0,0 +1,626 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Include file for erlang driver writers. + */ + +#ifndef __ERL_DRIVER_H__ +#define __ERL_DRIVER_H__ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef SIZEOF_CHAR +# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR +# undef SIZEOF_CHAR +#endif +#ifdef SIZEOF_SHORT +# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT +# undef SIZEOF_SHORT +#endif +#ifdef SIZEOF_INT +# define SIZEOF_INT_SAVED__ SIZEOF_INT +# undef SIZEOF_INT +#endif +#ifdef SIZEOF_LONG +# define SIZEOF_LONG_SAVED__ SIZEOF_LONG +# undef SIZEOF_LONG +#endif +#ifdef SIZEOF_LONG_LONG +# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG +# undef SIZEOF_LONG_LONG +#endif +#include "erl_int_sizes_config.h" +#if defined(SIZEOF_CHAR_SAVED__) && SIZEOF_CHAR_SAVED__ != SIZEOF_CHAR +# error SIZEOF_CHAR mismatch +#endif +#if defined(SIZEOF_SHORT_SAVED__) && SIZEOF_SHORT_SAVED__ != SIZEOF_SHORT +# error SIZEOF_SHORT mismatch +#endif +#if defined(SIZEOF_INT_SAVED__) && SIZEOF_INT_SAVED__ != SIZEOF_INT +# error SIZEOF_INT mismatch +#endif +#if defined(SIZEOF_LONG_SAVED__) && SIZEOF_LONG_SAVED__ != SIZEOF_LONG +# error SIZEOF_LONG mismatch +#endif +#if defined(SIZEOF_LONG_LONG_SAVED__) && SIZEOF_LONG_LONG_SAVED__ != SIZEOF_LONG_LONG +# error SIZEOF_LONG_LONG mismatch +#endif + +#include + +#if defined(VXWORKS) +# include +typedef struct iovec SysIOVec; +#elif defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_) +#ifndef STATIC_ERLANG_DRIVER + /* Windows dynamic drivers, everything is different... */ +#define ERL_DRIVER_TYPES_ONLY +#define WIN32_DYNAMIC_ERL_DRIVER +#endif +/* + * This structure can be cast to a WSABUF structure. + */ +typedef struct _SysIOVec { + unsigned long iov_len; + char* iov_base; +} SysIOVec; +#else /* Unix */ +# ifdef HAVE_SYS_UIO_H +# include +# include +typedef struct iovec SysIOVec; +# else +typedef struct { + char* iov_base; + size_t iov_len; +} SysIOVec; +# endif +#endif + +#ifndef EXTERN +# ifdef __cplusplus +# define EXTERN extern "C" +# else +# define EXTERN extern +# endif +#endif + +/* Values for mode arg to driver_select() */ +#define ERL_DRV_READ (1 << 0) +#define ERL_DRV_WRITE (1 << 1) +#define ERL_DRV_USE (1 << 2) +#define ERL_DRV_USE_NO_CALLBACK (ERL_DRV_USE | (1 << 3)) + +/* Old deprecated */ +#define DO_READ ERL_DRV_READ +#define DO_WRITE ERL_DRV_WRITE + +#define ERL_DRV_EXTENDED_MARKER (0xfeeeeeed) +#define ERL_DRV_EXTENDED_MAJOR_VERSION 1 +#define ERL_DRV_EXTENDED_MINOR_VERSION 4 + +/* + * The emulator will refuse to load a driver with different major + * version than the one used by the emulator. + */ + + +/* Values for set_port_control_flags() */ + +#define PORT_CONTROL_FLAG_BINARY (1 << 0) +#define PORT_CONTROL_FLAG_HEAVY (1 << 1) + +/* Values for get_port_flags() */ + +#define PORT_FLAG_BINARY (1 << 0) +#define PORT_FLAG_LINE (1 << 1) + + +#define ERL_DRV_FLAG_USE_PORT_LOCKING (1 << 0) +#define ERL_DRV_FLAG_SOFT_BUSY (1 << 1) + +/* + * A binary as seen in a driver. Note that a binary should never be + * altered by the driver when it has been sent to Erlang. + */ + +typedef struct erl_drv_binary { + long orig_size; /* total length of binary */ + char orig_bytes[1]; /* the data (char instead of byte!) */ +} ErlDrvBinary; + + +/* + * Note: These types are incomplete to catch type errors easier. + */ + +typedef struct _erl_drv_data* ErlDrvData; /* Data to be used by the driver itself. */ +#ifndef ERL_SYS_DRV +typedef struct _erl_drv_event* ErlDrvEvent; /* An event to be selected on. */ +typedef struct _erl_drv_port* ErlDrvPort; /* A port descriptor. */ +#endif +typedef struct _erl_drv_port* ErlDrvThreadData; /* Thread data. */ + +#if !defined(__WIN32__) && !defined(_WIN32) && !defined(_WIN32_) && !defined(USE_SELECT) +struct erl_drv_event_data { + short events; + short revents; +}; +#endif +typedef struct erl_drv_event_data *ErlDrvEventData; /* Event data */ + +/* + * Used in monitors... + */ +typedef unsigned long ErlDrvTermData; +typedef unsigned long ErlDrvUInt; +typedef signed long ErlDrvSInt; + +#if defined(__WIN32__) +typedef unsigned __int64 ErlDrvUInt64; +typedef __int64 ErlDrvSInt64; +#elif SIZEOF_LONG == 8 +typedef unsigned long ErlDrvUInt64; +typedef long ErlDrvSInt64; +#elif SIZEOF_LONG_LONG == 8 +typedef unsigned long long ErlDrvUInt64; +typedef long long ErlDrvSInt64; +#else +#error No 64-bit integer type +#endif + +/* + * A driver monitor + */ +typedef struct { + unsigned char data[sizeof(void *)*4]; +} ErlDrvMonitor; + + +/* + * System info + */ + +typedef struct { + int driver_major_version; + int driver_minor_version; + char *erts_version; + char *otp_release; + int thread_support; + int smp_support; + int async_threads; + int scheduler_threads; +} ErlDrvSysInfo; + +typedef struct { + unsigned long megasecs; + unsigned long secs; + unsigned long microsecs; +} ErlDrvNowData; + +/* + * Error codes that can be return from driver. + */ + +/* + * Exception code from open_port/2 will be {'EXIT',{einval,Where}}. + */ +#define ERL_DRV_ERROR_GENERAL ((ErlDrvData) -1) + +/* + * Exception code from open_port/2 will be {'EXIT',{Errno,Where}}, + * where Errno is a textual representation of the errno variable + * (e.g. eacces if errno is EACCES). + */ +#define ERL_DRV_ERROR_ERRNO ((ErlDrvData) -2) + +/* + * Exception code from open_port/2 will be {'EXIT',{badarg,Where}}. + */ +#define ERL_DRV_ERROR_BADARG ((ErlDrvData) -3) + +typedef struct erl_io_vec { + int vsize; /* length of vectors */ + int size; /* total size in bytes */ + SysIOVec* iov; + ErlDrvBinary** binv; +} ErlIOVec; + +/* + * erl driver thread types + */ + +typedef struct ErlDrvTid_ *ErlDrvTid; +typedef struct ErlDrvMutex_ ErlDrvMutex; +typedef struct ErlDrvCond_ ErlDrvCond; +typedef struct ErlDrvRWLock_ ErlDrvRWLock; +typedef int ErlDrvTSDKey; + +typedef struct { + int suggested_stack_size; +} ErlDrvThreadOpts; + +/* + * + */ +typedef struct erl_drv_port_data_lock * ErlDrvPDL; + +/* + * This structure defines a driver. + */ + +typedef struct erl_drv_entry { + int (*init)(void); /* called at system start up for statically + linked drivers, and after loading for + dynamically loaded drivers */ + +#ifndef ERL_SYS_DRV + ErlDrvData (*start)(ErlDrvPort port, char *command); + /* called when open_port/2 is invoked. + return value -1 means failure. */ +#else + ErlDrvData (*start)(ErlDrvPort port, char *command, SysDriverOpts* opts); + /* special options, only for system driver */ +#endif + void (*stop)(ErlDrvData drv_data); + /* called when port is closed, and when the + emulator is halted. */ + void (*output)(ErlDrvData drv_data, char *buf, int len); + /* called when we have output from erlang to + the port */ + void (*ready_input)(ErlDrvData drv_data, ErlDrvEvent event); + /* called when we have input from one of + the driver's handles) */ + void (*ready_output)(ErlDrvData drv_data, ErlDrvEvent event); + /* called when output is possible to one of + the driver's handles */ + char *driver_name; /* name supplied as command + in open_port XXX ? */ + void (*finish)(void); /* called before unloading the driver - + DYNAMIC DRIVERS ONLY */ + void *handle; /* Reserved -- Used by emulator internally */ + int (*control)(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); + /* "ioctl" for drivers - invoked by + port_control/3) */ + void (*timeout)(ErlDrvData drv_data); /* Handling of timeout in driver */ + void (*outputv)(ErlDrvData drv_data, ErlIOVec *ev); + /* called when we have output from erlang + to the port */ + void (*ready_async)(ErlDrvData drv_data, ErlDrvThreadData thread_data); + void (*flush)(ErlDrvData drv_data); + /* called when the port is about to be + closed, and there is data in the + driver queue that needs to be flushed + before 'stop' can be called */ + int (*call)(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned int *flags); + /* Works mostly like 'control', a syncronous + call into the driver. */ + void (*event)(ErlDrvData drv_data, ErlDrvEvent event, + ErlDrvEventData event_data); + /* Called when an event selected by + driver_event() has occurred */ + int extended_marker; /* ERL_DRV_EXTENDED_MARKER */ + int major_version; /* ERL_DRV_EXTENDED_MAJOR_VERSION */ + int minor_version; /* ERL_DRV_EXTENDED_MINOR_VERSION */ + int driver_flags; /* ERL_DRV_FLAGs */ + void *handle2; /* Reserved -- Used by emulator internally */ + void (*process_exit)(ErlDrvData drv_data, ErlDrvMonitor *monitor); + /* Called when a process monitor fires */ + void (*stop_select)(ErlDrvEvent event, void* reserved); + /* Called on behalf of driver_select when + it is safe to release 'event'. A typical + unix driver would call close(event) */ + /* When adding entries here, dont forget to pad in obsolete/driver.h */ +} ErlDrvEntry; + +/* + * This macro is used to name a dynamic driver's init function in + * a way that doesn't lead to conflicts. This is crucial when using + * operating systems that has one namespace for all symbols + * (e.g. VxWorks). Example: if you have an dynamic driver C source + * file named echo_drv.c, you use the macro like this: + * + * DRIVER_INIT(echo_drv) + * { + * .... + * } + * + * This function will be called by the Erlang I/O system when the driver is loaded. + * It must initialize a ErlDrvEntry structure and return a pointer to it. + */ + +/* For windows dynamic drivers */ +#ifndef ERL_DRIVER_TYPES_ONLY + +#if defined(VXWORKS) +# define DRIVER_INIT(DRIVER_NAME) ErlDrvEntry* DRIVER_NAME ## _init(void) +#elif defined(__WIN32__) +# define DRIVER_INIT(DRIVER_NAME) __declspec(dllexport) ErlDrvEntry* driver_init(void) +#else +# define DRIVER_INIT(DRIVER_NAME) ErlDrvEntry* driver_init(void) +#endif + +/* + * These are the functions available for driver writers. + */ +EXTERN int driver_select(ErlDrvPort port, ErlDrvEvent event, int mode, int on); +EXTERN int driver_event(ErlDrvPort port, ErlDrvEvent event, + ErlDrvEventData event_data); +EXTERN int driver_output(ErlDrvPort port, char *buf, int len); +EXTERN int driver_output2(ErlDrvPort port, char *hbuf, int hlen, + char *buf, int len); +EXTERN int driver_output_binary(ErlDrvPort port, char *hbuf, int hlen, + ErlDrvBinary* bin, int offset, int len); +EXTERN int driver_outputv(ErlDrvPort port, char* hbuf, int hlen, ErlIOVec *ev, + int skip); +EXTERN int driver_vec_to_buf(ErlIOVec *ev, char *buf, int len); +EXTERN int driver_set_timer(ErlDrvPort port, unsigned long time); +EXTERN int driver_cancel_timer(ErlDrvPort port); +EXTERN int driver_read_timer(ErlDrvPort port, unsigned long *time_left); + +/* + * Get plain-text error message from within a driver + */ +EXTERN char* erl_errno_id(int error); + +/* + * The following functions are used to initiate a close of a port + * from a driver. + */ +EXTERN int driver_failure_eof(ErlDrvPort port); +EXTERN int driver_failure_atom(ErlDrvPort port, char *string); +EXTERN int driver_failure_posix(ErlDrvPort port, int error); +EXTERN int driver_failure(ErlDrvPort port, int error); +EXTERN int driver_exit (ErlDrvPort port, int err); + + +/* + * Port Data Lock + */ + +EXTERN ErlDrvPDL driver_pdl_create(ErlDrvPort); +EXTERN void driver_pdl_lock(ErlDrvPDL); +EXTERN void driver_pdl_unlock(ErlDrvPDL); +EXTERN long driver_pdl_get_refc(ErlDrvPDL); +EXTERN long driver_pdl_inc_refc(ErlDrvPDL); +EXTERN long driver_pdl_dec_refc(ErlDrvPDL); + +/* + * Process monitors + */ +EXTERN int +driver_monitor_process(ErlDrvPort port, ErlDrvTermData process, + ErlDrvMonitor *monitor); +EXTERN int +driver_demonitor_process(ErlDrvPort port, const ErlDrvMonitor *monitor); +EXTERN ErlDrvTermData +driver_get_monitored_process(ErlDrvPort port, const ErlDrvMonitor *monitor); +EXTERN int driver_compare_monitors(const ErlDrvMonitor *monitor1, + const ErlDrvMonitor *monitor2); + +/* + * Port attributes + */ +EXTERN void set_busy_port(ErlDrvPort port, int on); +EXTERN void set_port_control_flags(ErlDrvPort port, int flags); + +EXTERN int get_port_flags(ErlDrvPort port); + + +/* Binary interface */ + +/* + * NOTE: DO NOT overwrite a binary with new data (if the data is delivered); + * since the binary is a shared object it MUST be written once. + */ + +EXTERN ErlDrvBinary* driver_alloc_binary(int size); +EXTERN ErlDrvBinary* driver_realloc_binary(ErlDrvBinary *bin, int size); +EXTERN void driver_free_binary(ErlDrvBinary *bin); + +/* Referenc count on driver binaries */ +EXTERN long driver_binary_get_refc(ErlDrvBinary *dbp); +EXTERN long driver_binary_inc_refc(ErlDrvBinary *dbp); +EXTERN long driver_binary_dec_refc(ErlDrvBinary *dbp); + +/* Allocation interface */ +EXTERN void *driver_alloc(size_t size); +EXTERN void *driver_realloc(void *ptr, size_t size); +EXTERN void driver_free(void *ptr); + +/* Queue interface */ +EXTERN int driver_enq(ErlDrvPort port, char* buf, int len); +EXTERN int driver_pushq(ErlDrvPort port, char* buf, int len); +EXTERN int driver_deq(ErlDrvPort port, int size); +EXTERN int driver_sizeq(ErlDrvPort port); +EXTERN int driver_enq_bin(ErlDrvPort port, ErlDrvBinary *bin, int offset, + int len); +EXTERN int driver_pushq_bin(ErlDrvPort port, ErlDrvBinary *bin, int offset, + int len); + +EXTERN int driver_peekqv(ErlDrvPort port, ErlIOVec *ev); +EXTERN SysIOVec* driver_peekq(ErlDrvPort port, int *vlen); +EXTERN int driver_enqv(ErlDrvPort port, ErlIOVec *ev, int skip); +EXTERN int driver_pushqv(ErlDrvPort port, ErlIOVec *ev, int skip); + +/* + * Add and remove driver entries. + */ +EXTERN void add_driver_entry(ErlDrvEntry *de); +EXTERN int remove_driver_entry(ErlDrvEntry *de); + +/* + * System info + */ +EXTERN void driver_system_info(ErlDrvSysInfo *sip, size_t si_size); + +/* + * erl driver thread functions. + */ + +EXTERN ErlDrvMutex *erl_drv_mutex_create(char *name); +EXTERN void erl_drv_mutex_destroy(ErlDrvMutex *mtx); +EXTERN int erl_drv_mutex_trylock(ErlDrvMutex *mtx); +EXTERN void erl_drv_mutex_lock(ErlDrvMutex *mtx); +EXTERN void erl_drv_mutex_unlock(ErlDrvMutex *mtx); +EXTERN ErlDrvCond *erl_drv_cond_create(char *name); +EXTERN void erl_drv_cond_destroy(ErlDrvCond *cnd); +EXTERN void erl_drv_cond_signal(ErlDrvCond *cnd); +EXTERN void erl_drv_cond_broadcast(ErlDrvCond *cnd); +EXTERN void erl_drv_cond_wait(ErlDrvCond *cnd, ErlDrvMutex *mtx); +EXTERN ErlDrvRWLock *erl_drv_rwlock_create(char *name); +EXTERN void erl_drv_rwlock_destroy(ErlDrvRWLock *rwlck); +EXTERN int erl_drv_rwlock_tryrlock(ErlDrvRWLock *rwlck); +EXTERN void erl_drv_rwlock_rlock(ErlDrvRWLock *rwlck); +EXTERN void erl_drv_rwlock_runlock(ErlDrvRWLock *rwlck); +EXTERN int erl_drv_rwlock_tryrwlock(ErlDrvRWLock *rwlck); +EXTERN void erl_drv_rwlock_rwlock(ErlDrvRWLock *rwlck); +EXTERN void erl_drv_rwlock_rwunlock(ErlDrvRWLock *rwlck); +EXTERN int erl_drv_tsd_key_create(char *name, ErlDrvTSDKey *key); +EXTERN void erl_drv_tsd_key_destroy(ErlDrvTSDKey key); +EXTERN void erl_drv_tsd_set(ErlDrvTSDKey key, void *data); +EXTERN void *erl_drv_tsd_get(ErlDrvTSDKey key); +EXTERN ErlDrvThreadOpts *erl_drv_thread_opts_create(char *name); +EXTERN void erl_drv_thread_opts_destroy(ErlDrvThreadOpts *opts); +EXTERN int erl_drv_thread_create(char *name, + ErlDrvTid *tid, + void * (*func)(void *), + void *args, + ErlDrvThreadOpts *opts); +EXTERN ErlDrvTid erl_drv_thread_self(void); +EXTERN int erl_drv_equal_tids(ErlDrvTid tid1, ErlDrvTid tid2); +EXTERN void erl_drv_thread_exit(void *resp); +EXTERN int erl_drv_thread_join(ErlDrvTid, void **respp); + +/* + * Misc. + */ +EXTERN int null_func(void); + +#endif /* !ERL_DRIVER_TYPES_ONLY */ + +/* Constants for return flags from the 'port_call' callback */ +#define DRIVER_CALL_KEEP_BUFFER 0x1 + +/* ErlDrvTerm is the type to use for casts when building + * terms that should be sent to connected process, + * for instance a tuple on the form {tcp, Port, [Tag|Binary]} + * + * ErlDrvTerm spec[] = { + * ERL_DRV_ATOM, driver_mk_atom("tcp"), + * ERL_DRV_PORT, driver_mk_port(drv->ix), + * ERL_DRV_INT, REPLY_TAG, + * ERL_DRV_BINARY, (ErlDrvTerm)bin, 50, 0, + * ERL_DRV_LIST, 2, + * ERL_DRV_TUPLE, 3, + * } + * + */ + +#define TERM_DATA(x) ((ErlDrvTermData) (x)) + +/* Possible types to send from driver Argument type */ +#define ERL_DRV_NIL ((ErlDrvTermData) 1) /* None */ +#define ERL_DRV_ATOM ((ErlDrvTermData) 2) /* driver_mk_atom(string) */ +#define ERL_DRV_INT ((ErlDrvTermData) 3) /* ErlDrvSInt */ +#define ERL_DRV_PORT ((ErlDrvTermData) 4) /* driver_mk_port(ix) */ +#define ERL_DRV_BINARY ((ErlDrvTermData) 5) /* ErlDrvBinary*, + * ErlDrvUInt size, + * ErlDrvUInt offs */ +#define ERL_DRV_STRING ((ErlDrvTermData) 6) /* char*, ErlDrvUInt */ +#define ERL_DRV_TUPLE ((ErlDrvTermData) 7) /* ErlDrvUInt */ +#define ERL_DRV_LIST ((ErlDrvTermData) 8) /* ErlDrvUInt */ +#define ERL_DRV_STRING_CONS ((ErlDrvTermData) 9) /* char*, ErlDrvUInt */ +#define ERL_DRV_PID ((ErlDrvTermData) 10) /* driver_connected,... */ + +#define ERL_DRV_FLOAT ((ErlDrvTermData) 11) /* double * */ +#define ERL_DRV_EXT2TERM ((ErlDrvTermData) 12) /* char *, ErlDrvUInt */ +#define ERL_DRV_UINT ((ErlDrvTermData) 13) /* ErlDrvUInt */ +#define ERL_DRV_BUF2BINARY ((ErlDrvTermData) 14) /* char *, ErlDrvUInt */ +#define ERL_DRV_INT64 ((ErlDrvTermData) 15) /* ErlDrvSInt64 * */ +#define ERL_DRV_UINT64 ((ErlDrvTermData) 16) /* ErlDrvUInt64 * */ + +#ifndef ERL_DRIVER_TYPES_ONLY + +/* make terms for driver_output_term and driver_send_term */ +EXTERN ErlDrvTermData driver_mk_atom(char*); +EXTERN ErlDrvTermData driver_mk_port(ErlDrvPort); +EXTERN ErlDrvTermData driver_connected(ErlDrvPort); +EXTERN ErlDrvTermData driver_caller(ErlDrvPort); +extern const ErlDrvTermData driver_term_nil; +EXTERN ErlDrvTermData driver_mk_term_nil(void); +EXTERN ErlDrvPort driver_create_port(ErlDrvPort creator_port, + ErlDrvTermData connected, /* pid */ + char* name, /* driver name */ + ErlDrvData drv_data); + + +/* output term data to the port owner */ +EXTERN int driver_output_term(ErlDrvPort ix, ErlDrvTermData* data, int len); +/* output term data to a specific process */ +EXTERN int driver_send_term(ErlDrvPort ix, ErlDrvTermData to, + ErlDrvTermData* data, int len); + +/* Async IO functions */ +EXTERN long driver_async(ErlDrvPort ix, + unsigned int* key, + void (*async_invoke)(void*), + void* async_data, + void (*async_free)(void*)); + + +EXTERN int driver_async_cancel(unsigned int key); + +/* Locks the driver in the machine "forever", there is + no unlock function. Note that this is almost never useful, as an open + port towards the driver locks it until the port is closed, why unexpected + unloading "never" happens. */ +EXTERN int driver_lock_driver(ErlDrvPort ix); + +/* Get the current 'now' timestamp (analogue to erlang:now()) */ +EXTERN int driver_get_now(ErlDrvNowData *now); + + +/* These were removed from the ANSI version, now they're back. */ + +EXTERN void *driver_dl_open(char *); +EXTERN void *driver_dl_sym(void *, char *); +EXTERN int driver_dl_close(void *); +EXTERN char *driver_dl_error(void); + +/* environment */ +EXTERN int erl_drv_putenv(char *key, char *value); +EXTERN int erl_drv_getenv(char *key, char *value, size_t *value_size); + +#endif /* !ERL_DRIVER_TYPES_ONLY */ + +#ifdef WIN32_DYNAMIC_ERL_DRIVER +# include "erl_win_dyn_driver.h" +#endif + +#endif + + + + diff --git a/erts/emulator/beam/erl_drv_thread.c b/erts/emulator/beam/erl_drv_thread.c new file mode 100644 index 0000000000..50d8c25c46 --- /dev/null +++ b/erts/emulator/beam/erl_drv_thread.c @@ -0,0 +1,706 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "global.h" +#include + +#define ERL_DRV_THR_OPTS_SIZE(LAST_FIELD) \ + (((size_t) &((ErlDrvThreadOpts *) 0)->LAST_FIELD) \ + + sizeof(((ErlDrvThreadOpts *) 0)->LAST_FIELD)) + +static void +fatal_error(int err, char *func) +{ + char *estr = strerror(err); + if (!estr) { + if (err == ENOTSUP) + estr = "Not supported"; + else + estr = "Unknown error"; + } + erl_exit(ERTS_ABORT_EXIT, "Fatal error in %s: %s [%d]\n", func, estr, err); +} + +#define ERL_DRV_TSD_KEYS_INC 10 +#define ERL_DRV_TSD_EXTRA 10 +#define ERL_DRV_INVALID_TSD_KEY INT_MAX + +#ifdef USE_THREADS + +struct ErlDrvMutex_ { + ethr_mutex mtx; + char *name; +}; + +struct ErlDrvCond_ { + ethr_cond cnd; + char *name; +}; + +struct ErlDrvRWLock_ { + ethr_rwmutex rwmtx; + char *name; +}; + +struct ErlDrvTid_ { + ethr_tid tid; + void* (*func)(void*); + void* arg; + int drv_thr; + Uint tsd_len; + void **tsd; + char *name; +}; + +static ethr_tsd_key tid_key; + +static ethr_thr_opts def_ethr_opts = ETHR_THR_OPTS_DEFAULT_INITER; + +#else /* USE_THREADS */ +static Uint tsd_len; +static void **tsd; +#endif + +static ErlDrvTSDKey next_tsd_key; +static ErlDrvTSDKey max_used_tsd_key; +static ErlDrvTSDKey used_tsd_keys_len; +static char **used_tsd_keys; +static erts_mtx_t tsd_mtx; +static char *no_name; + +#ifdef USE_THREADS + +static void +thread_exit_handler(void) +{ + struct ErlDrvTid_ *dtid = ethr_tsd_get(tid_key); + if (dtid) { + if (dtid->tsd) + erts_free(ERTS_ALC_T_DRV_TSD, dtid->tsd); + if (!dtid->drv_thr) + erts_free(ERTS_ALC_T_DRV_TID, dtid); + } +} + +static void * +erl_drv_thread_wrapper(void *vdtid) +{ + int res; + struct ErlDrvTid_ *dtid = (struct ErlDrvTid_ *) vdtid; + res = ethr_tsd_set(tid_key, vdtid); + if (res != 0) + fatal_error(res, "erl_drv_thread_wrapper()"); + return (*dtid->func)(dtid->arg); +} + +#endif + +void erl_drv_thr_init(void) +{ + int i; +#ifdef USE_THREADS + int res = ethr_tsd_key_create(&tid_key); + if (res == 0) + res = ethr_install_exit_handler(thread_exit_handler); + if (res != 0) + fatal_error(res, "erl_drv_thr_init()"); +#else + tsd_len = 0; + tsd = NULL; +#endif + + no_name = "unknown"; + next_tsd_key = 0; + max_used_tsd_key = -1; + used_tsd_keys_len = ERL_DRV_TSD_KEYS_INC; + used_tsd_keys = erts_alloc(ERTS_ALC_T_DRV_TSD, + sizeof(char *)*ERL_DRV_TSD_KEYS_INC); + for (i = 0; i < ERL_DRV_TSD_KEYS_INC; i++) + used_tsd_keys[i] = NULL; + erts_mtx_init(&tsd_mtx, "drv_tsd"); +} + +/* + * These functions implement the driver thread interface in erl_driver.h. + * NOTE: Only use this interface from drivers. From within the emulator use + * either the erl_threads.h, the erl_smp.h or the ethread.h interface. + */ + +ErlDrvMutex * +erl_drv_mutex_create(char *name) +{ +#ifdef USE_THREADS + ErlDrvMutex *dmtx = erts_alloc_fnf(ERTS_ALC_T_DRV_MTX, + (sizeof(ErlDrvMutex) + + (name ? sys_strlen(name) + 1 : 0))); + if (dmtx) { + if (ethr_mutex_init(&dmtx->mtx) != 0) { + erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx); + dmtx = NULL; + } + else if (!name) + dmtx->name = no_name; + else { + dmtx->name = ((char *) dmtx) + sizeof(ErlDrvMutex); + sys_strcpy(dmtx->name, name); + } + } + return dmtx; +#else + return (ErlDrvMutex *) NULL; +#endif +} + +void +erl_drv_mutex_destroy(ErlDrvMutex *dmtx) +{ +#ifdef USE_THREADS + int res = dmtx ? ethr_mutex_destroy(&dmtx->mtx) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_mutex_destroy()"); + erts_free(ERTS_ALC_T_DRV_MTX, (void *) dmtx); +#endif +} + +int +erl_drv_mutex_trylock(ErlDrvMutex *dmtx) +{ +#ifdef USE_THREADS + int res = dmtx ? ethr_mutex_trylock(&dmtx->mtx) : EINVAL; + if (res != 0 && res != EBUSY) + fatal_error(res, "erl_drv_mutex_trylock()"); + return res; +#else + return 0; +#endif +} + +void +erl_drv_mutex_lock(ErlDrvMutex *dmtx) +{ +#ifdef USE_THREADS + int res = dmtx ? ethr_mutex_lock(&dmtx->mtx) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_mutex_lock()"); +#endif +} + +void +erl_drv_mutex_unlock(ErlDrvMutex *dmtx) +{ +#ifdef USE_THREADS + int res = dmtx ? ethr_mutex_unlock(&dmtx->mtx) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_mutex_unlock()"); +#endif +} + +ErlDrvCond * +erl_drv_cond_create(char *name) +{ +#ifdef USE_THREADS + ErlDrvCond *dcnd = erts_alloc_fnf(ERTS_ALC_T_DRV_CND, + (sizeof(ErlDrvCond) + + (name ? sys_strlen(name) + 1 : 0))); + if (dcnd) { + if (ethr_cond_init(&dcnd->cnd) != 0) { + erts_free(ERTS_ALC_T_DRV_CND, (void *) dcnd); + dcnd = NULL; + } + else if (!name) + dcnd->name = no_name; + else { + dcnd->name = ((char *) dcnd) + sizeof(ErlDrvCond); + sys_strcpy(dcnd->name, name); + } + } + return dcnd; +#else + return (ErlDrvCond *) NULL; +#endif +} + +void +erl_drv_cond_destroy(ErlDrvCond *dcnd) +{ +#ifdef USE_THREADS + int res = dcnd ? ethr_cond_destroy(&dcnd->cnd) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_cond_destroy()"); + erts_free(ERTS_ALC_T_DRV_CND, (void *) dcnd); +#endif +} + + +void +erl_drv_cond_signal(ErlDrvCond *dcnd) +{ +#ifdef USE_THREADS + int res = dcnd ? ethr_cond_signal(&dcnd->cnd) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_cond_signal()"); +#endif +} + +void +erl_drv_cond_broadcast(ErlDrvCond *dcnd) +{ +#ifdef USE_THREADS + int res = dcnd ? ethr_cond_broadcast(&dcnd->cnd) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_cond_broadcast()"); +#endif +} + + +void +erl_drv_cond_wait(ErlDrvCond *dcnd, ErlDrvMutex *dmtx) +{ +#ifdef USE_THREADS + int res; + if (!dcnd || !dmtx) { + res = EINVAL; + error: + fatal_error(res, "erl_drv_cond_wait()"); + } + while (1) { + res = ethr_cond_wait(&dcnd->cnd, &dmtx->mtx); + if (res == 0) + break; + if (res != EINTR) + goto error; + } +#endif +} + +ErlDrvRWLock * +erl_drv_rwlock_create(char *name) +{ +#ifdef USE_THREADS + ErlDrvRWLock *drwlck = erts_alloc_fnf(ERTS_ALC_T_DRV_RWLCK, + (sizeof(ErlDrvRWLock) + + (name ? sys_strlen(name) + 1 : 0))); + if (drwlck) { + if (ethr_rwmutex_init(&drwlck->rwmtx) != 0) { + erts_free(ERTS_ALC_T_DRV_RWLCK, (void *) drwlck); + drwlck = NULL; + } + else if (!name) + drwlck->name = no_name; + else { + drwlck->name = ((char *) drwlck) + sizeof(ErlDrvRWLock); + sys_strcpy(drwlck->name, name); + } + } + return drwlck; +#else + return (ErlDrvRWLock *) NULL; +#endif +} + +void +erl_drv_rwlock_destroy(ErlDrvRWLock *drwlck) +{ +#ifdef USE_THREADS + int res = drwlck ? ethr_rwmutex_destroy(&drwlck->rwmtx) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_rwlock_destroy()"); + erts_free(ERTS_ALC_T_DRV_RWLCK, (void *) drwlck); +#endif +} + +int +erl_drv_rwlock_tryrlock(ErlDrvRWLock *drwlck) +{ +#ifdef USE_THREADS + int res = drwlck ? ethr_rwmutex_tryrlock(&drwlck->rwmtx) : EINVAL; + if (res != 0 && res != EBUSY) + fatal_error(res, "erl_drv_rwlock_tryrlock()"); + return res; +#else + return 0; +#endif +} + +void +erl_drv_rwlock_rlock(ErlDrvRWLock *drwlck) +{ +#ifdef USE_THREADS + int res = drwlck ? ethr_rwmutex_rlock(&drwlck->rwmtx) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_rwlock_rlock()"); +#endif +} + +void +erl_drv_rwlock_runlock(ErlDrvRWLock *drwlck) +{ +#ifdef USE_THREADS + int res = drwlck ? ethr_rwmutex_runlock(&drwlck->rwmtx) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_rwlock_runlock()"); +#endif +} + +int +erl_drv_rwlock_tryrwlock(ErlDrvRWLock *drwlck) +{ +#ifdef USE_THREADS + int res = drwlck ? ethr_rwmutex_tryrwlock(&drwlck->rwmtx) : EINVAL; + if (res != 0 && res != EBUSY) + fatal_error(res, "erl_drv_rwlock_tryrwlock()"); + return res; +#else + return 0; +#endif +} + +void +erl_drv_rwlock_rwlock(ErlDrvRWLock *drwlck) +{ +#ifdef USE_THREADS + int res = drwlck ? ethr_rwmutex_rwlock(&drwlck->rwmtx) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_rwlock_rwlock()"); +#endif +} + +void +erl_drv_rwlock_rwunlock(ErlDrvRWLock *drwlck) +{ +#ifdef USE_THREADS + int res = drwlck ? ethr_rwmutex_rwunlock(&drwlck->rwmtx) : EINVAL; + if (res != 0) + fatal_error(res, "erl_drv_rwlock_rwunlock()"); +#endif +} + +int +erl_drv_tsd_key_create(char *name, ErlDrvTSDKey *key) +{ + char *name_copy; + Uint old_used_tsd_keys_len; + ErlDrvTSDKey res; + + if (!key) + fatal_error(EINVAL, "erl_drv_tsd_key_create()"); + + if (!name) + name_copy = no_name; + else { + name_copy = erts_alloc_fnf(ERTS_ALC_T_DRV_TSD, + sizeof(char)*(strlen(name) + 1)); + if (!name_copy) { + *key = -1; + return ENOMEM; + } + sys_strcpy(name_copy, name); + } + + erts_mtx_lock(&tsd_mtx); + + *key = next_tsd_key; + + if (next_tsd_key < 0) + res = ENOMEM; + else { + res = 0; + + ASSERT(!used_tsd_keys[next_tsd_key]); + used_tsd_keys[next_tsd_key] = name_copy; + + if (max_used_tsd_key < next_tsd_key) + max_used_tsd_key = next_tsd_key; + + if (max_used_tsd_key + 1 >= used_tsd_keys_len) { + int i; + old_used_tsd_keys_len = used_tsd_keys_len; + if (used_tsd_keys_len + ERL_DRV_TSD_KEYS_INC >= INT_MAX) + next_tsd_key = -1; + else { + char **new_used_tsd_keys; + used_tsd_keys_len += ERL_DRV_TSD_KEYS_INC; + new_used_tsd_keys = erts_realloc_fnf(ERTS_ALC_T_DRV_TSD, + used_tsd_keys, + (sizeof(char *) + * used_tsd_keys_len)); + if (!new_used_tsd_keys) + next_tsd_key = -1; + else { + used_tsd_keys = new_used_tsd_keys; + for (i = old_used_tsd_keys_len; i < used_tsd_keys_len; i++) + used_tsd_keys[i] = NULL; + } + } + } + + if (next_tsd_key >= 0) { + do { + next_tsd_key++; + } while (used_tsd_keys[next_tsd_key]); + } + ASSERT(next_tsd_key < used_tsd_keys_len); + } + + erts_mtx_unlock(&tsd_mtx); + + return res; +} + +void +erl_drv_tsd_key_destroy(ErlDrvTSDKey key) +{ + erts_mtx_lock(&tsd_mtx); + + if (key < 0 || max_used_tsd_key < key || !used_tsd_keys[key]) + fatal_error(EINVAL, "erl_drv_tsd_key_destroy()"); + + if (used_tsd_keys[key] != no_name) + erts_free(ERTS_ALC_T_DRV_TSD, used_tsd_keys[key]); + + used_tsd_keys[key] = NULL; + if (next_tsd_key < 0 || key < next_tsd_key) + next_tsd_key = key; + + erts_mtx_unlock(&tsd_mtx); +} + + +#ifdef USE_THREADS +#define ERL_DRV_TSD__ (dtid->tsd) +#define ERL_DRV_TSD_LEN__ (dtid->tsd_len) +#else +#define ERL_DRV_TSD__ (tsd) +#define ERL_DRV_TSD_LEN__ (tsd_len) +#endif + +void +erl_drv_tsd_set(ErlDrvTSDKey key, void *data) +{ +#ifdef USE_THREADS + struct ErlDrvTid_ *dtid = (struct ErlDrvTid_ *) erl_drv_thread_self(); +#endif + + if (key < 0 || max_used_tsd_key < key || !used_tsd_keys[key]) + fatal_error(EINVAL, "erl_drv_tsd_set()"); + + if (!ERL_DRV_TSD__) { + ErlDrvTSDKey i; + ERL_DRV_TSD_LEN__ = key + ERL_DRV_TSD_EXTRA; + ERL_DRV_TSD__ = erts_alloc(ERTS_ALC_T_DRV_TSD, + sizeof(void *)*ERL_DRV_TSD_LEN__); + for (i = 0; i < ERL_DRV_TSD_LEN__; i++) + ERL_DRV_TSD__[i] = NULL; + } + else if (ERL_DRV_TSD_LEN__ <= key) { + ErlDrvTSDKey i = ERL_DRV_TSD_LEN__; + ERL_DRV_TSD_LEN__ = key + ERL_DRV_TSD_EXTRA; + ERL_DRV_TSD__ = erts_realloc(ERTS_ALC_T_DRV_TSD, + ERL_DRV_TSD__, + sizeof(void *)*ERL_DRV_TSD_LEN__); + for (; i < ERL_DRV_TSD_LEN__; i++) + ERL_DRV_TSD__[i] = NULL; + } + ERL_DRV_TSD__[key] = data; +} + +void * +erl_drv_tsd_get(ErlDrvTSDKey key) +{ +#ifdef USE_THREADS + struct ErlDrvTid_ *dtid = ethr_tsd_get(tid_key); +#endif + if (key < 0 || max_used_tsd_key < key || !used_tsd_keys[key]) + fatal_error(EINVAL, "erl_drv_tsd_get()"); +#ifdef USE_THREADS + if (!dtid) + return NULL; +#endif + if (ERL_DRV_TSD_LEN__ < key) + return NULL; + return ERL_DRV_TSD__[key]; +} + +#undef ERL_DRV_TSD_LEN__ +#undef ERL_DRV_TSD__ + +ErlDrvThreadOpts * +erl_drv_thread_opts_create(char *name) +{ + ErlDrvThreadOpts *opts = erts_alloc_fnf(ERTS_ALC_T_DRV_THR_OPTS, + sizeof(ErlDrvThreadOpts)); + if (!opts) + return NULL; + opts->suggested_stack_size = -1; + return opts; +} + +void +erl_drv_thread_opts_destroy(ErlDrvThreadOpts *opts) +{ + if (!opts) + fatal_error(EINVAL, "erl_drv_thread_opts_destroy()"); + erts_free(ERTS_ALC_T_DRV_THR_OPTS, opts); +} + +int +erl_drv_thread_create(char *name, + ErlDrvTid *tid, + void* (*func)(void*), + void* arg, + ErlDrvThreadOpts *opts) +{ +#ifdef USE_THREADS + int res; + struct ErlDrvTid_ *dtid; + ethr_thr_opts ethr_opts; + ethr_thr_opts *use_opts; + + if (!opts) + use_opts = NULL; + else { + sys_memcpy((void *) ðr_opts, + (void *) &def_ethr_opts, + sizeof(ethr_thr_opts)); + ethr_opts.suggested_stack_size = opts->suggested_stack_size; + use_opts = ðr_opts; + } + + dtid = erts_alloc_fnf(ERTS_ALC_T_DRV_TID, + (sizeof(struct ErlDrvTid_) + + (name ? sys_strlen(name) + 1 : 0))); + if (!dtid) + return ENOMEM; + + dtid->drv_thr = 1; + dtid->func = func; + dtid->arg = arg; + dtid->tsd = NULL; + dtid->tsd_len = 0; + if (!name) + dtid->name = no_name; + else { + dtid->name = ((char *) dtid) + sizeof(struct ErlDrvTid_); + sys_strcpy(dtid->name, name); + } +#ifdef ERTS_ENABLE_LOCK_COUNT + res = erts_lcnt_thr_create(&dtid->tid, erl_drv_thread_wrapper, dtid, use_opts); +#else + res = ethr_thr_create(&dtid->tid, erl_drv_thread_wrapper, dtid, use_opts); +#endif + + if (res != 0) { + erts_free(ERTS_ALC_T_DRV_TID, dtid); + return res; + } + + *tid = (ErlDrvTid) dtid; + return 0; +#else + return ENOTSUP; +#endif +} + +ErlDrvTid +erl_drv_thread_self(void) +{ +#ifdef USE_THREADS + struct ErlDrvTid_ *dtid = ethr_tsd_get(tid_key); + if (!dtid) { + int res; + /* This is a thread not spawned by this interface. thread_exit_handler() + will clean it up when it terminates. */ + dtid = erts_alloc(ERTS_ALC_T_DRV_TID, sizeof(struct ErlDrvTid_)); + dtid->drv_thr = 0; /* Not a driver thread */ + dtid->tid = ethr_self(); + dtid->func = NULL; + dtid->arg = NULL; + dtid->tsd = NULL; + dtid->tsd_len = 0; + dtid->name = no_name; + res = ethr_tsd_set(tid_key, (void *) dtid); + if (res != 0) + fatal_error(res, "erl_drv_thread_self()"); + } + return (ErlDrvTid) dtid; +#else + return (ErlDrvTid) NULL; +#endif +} + +int +erl_drv_equal_tids(ErlDrvTid tid1, ErlDrvTid tid2) +{ +#ifdef USE_THREADS + int res; + struct ErlDrvTid_ *dtid1 = (struct ErlDrvTid_ *) tid1; + struct ErlDrvTid_ *dtid2 = (struct ErlDrvTid_ *) tid2; + if (!dtid1 || !dtid2) + fatal_error(EINVAL, "erl_drv_equal_tids()"); + + res = dtid1 == dtid2; + + ASSERT(res + ? ethr_equal_tids(dtid1->tid, dtid2->tid) + : !ethr_equal_tids(dtid1->tid, dtid2->tid)); + + return res; +#else + return 1; +#endif +} + +void +erl_drv_thread_exit(void *res) +{ +#ifdef USE_THREADS + struct ErlDrvTid_ *dtid = ethr_tsd_get(tid_key); + if (dtid && dtid->drv_thr) { + ethr_thr_exit(res); + fatal_error(0, "erl_drv_thread_exit()"); + } +#endif + fatal_error(EACCES, "erl_drv_thread_exit()"); +} + +int +erl_drv_thread_join(ErlDrvTid tid, void **respp) +{ +#ifdef USE_THREADS + int res; + struct ErlDrvTid_ *dtid = (struct ErlDrvTid_ *) tid; + + ASSERT(dtid); + + if (!dtid->drv_thr) + return EINVAL; + + res = ethr_thr_join(dtid->tid, respp); + if (res == 0) + erts_free(ERTS_ALC_T_DRV_TID, dtid); + return res; +#else + return ENOTSUP; +#endif +} + diff --git a/erts/emulator/beam/erl_fun.c b/erts/emulator/beam/erl_fun.c new file mode 100644 index 0000000000..79e844b315 --- /dev/null +++ b/erts/emulator/beam/erl_fun.c @@ -0,0 +1,315 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_fun.h" +#include "hash.h" + +static Hash erts_fun_table; + +#include "erl_smp.h" + +static erts_smp_rwmtx_t erts_fun_table_lock; + +#define erts_fun_read_lock() erts_smp_rwmtx_rlock(&erts_fun_table_lock) +#define erts_fun_read_unlock() erts_smp_rwmtx_runlock(&erts_fun_table_lock) +#define erts_fun_write_lock() erts_smp_rwmtx_rwlock(&erts_fun_table_lock) +#define erts_fun_write_unlock() erts_smp_rwmtx_rwunlock(&erts_fun_table_lock) +#define erts_fun_init_lock() erts_smp_rwmtx_init(&erts_fun_table_lock, \ + "fun_tab") + +static HashValue fun_hash(ErlFunEntry* obj); +static int fun_cmp(ErlFunEntry* obj1, ErlFunEntry* obj2); +static ErlFunEntry* fun_alloc(ErlFunEntry* template); +static void fun_free(ErlFunEntry* obj); + +/* + * The address field of every fun that has no loaded code will point + * to unloaded_fun[]. The -1 in unloaded_fun[0] will be interpreted + * as an illegal arity when attempting to call a fun. + */ +static Eterm unloaded_fun_code[3] = {NIL, -1, 0}; +static Eterm* unloaded_fun = unloaded_fun_code + 2; + +void +erts_init_fun_table(void) +{ + HashFunctions f; + + erts_fun_init_lock(); + f.hash = (H_FUN) fun_hash; + f.cmp = (HCMP_FUN) fun_cmp; + f.alloc = (HALLOC_FUN) fun_alloc; + f.free = (HFREE_FUN) fun_free; + + hash_init(ERTS_ALC_T_FUN_TABLE, &erts_fun_table, "fun_table", 16, f); +} + +void +erts_fun_info(int to, void *to_arg) +{ + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + erts_fun_read_lock(); + hash_info(to, to_arg, &erts_fun_table); + if (lock) + erts_fun_read_unlock(); +} + +int erts_fun_table_sz(void) +{ + int sz; + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + erts_fun_read_lock(); + sz = hash_table_sz(&erts_fun_table); + if (lock) + erts_fun_read_unlock(); + return sz; +} + +ErlFunEntry* +erts_put_fun_entry(Eterm mod, int uniq, int index) +{ + ErlFunEntry template; + ErlFunEntry* fe; + long refc; + ASSERT(is_atom(mod)); + template.old_uniq = uniq; + template.old_index = index; + template.module = mod; + erts_fun_write_lock(); + fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template); + sys_memset(fe->uniq, 0, sizeof(fe->uniq)); + fe->index = 0; + refc = erts_refc_inctest(&fe->refc, 0); + if (refc < 2) /* New or pending delete */ + erts_refc_inc(&fe->refc, 1); + erts_fun_write_unlock(); + return fe; +} + +ErlFunEntry* +erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index, + byte* uniq, int index, int arity) +{ + ErlFunEntry template; + ErlFunEntry* fe; + long refc; + + ASSERT(is_atom(mod)); + template.old_uniq = old_uniq; + template.old_index = old_index; + template.module = mod; + erts_fun_write_lock(); + fe = (ErlFunEntry *) hash_put(&erts_fun_table, (void*) &template); + sys_memcpy(fe->uniq, uniq, sizeof(fe->uniq)); + fe->index = index; + fe->arity = arity; + refc = erts_refc_inctest(&fe->refc, 0); + if (refc < 2) /* New or pending delete */ + erts_refc_inc(&fe->refc, 1); + erts_fun_write_unlock(); + return fe; +} + +struct my_key { + Eterm mod; + byte* uniq; + int index; + ErlFunEntry* fe; +}; + +ErlFunEntry* +erts_get_fun_entry(Eterm mod, int uniq, int index) +{ + ErlFunEntry template; + ErlFunEntry *ret; + + ASSERT(is_atom(mod)); + template.old_uniq = uniq; + template.old_index = index; + template.module = mod; + erts_fun_read_lock(); + ret = (ErlFunEntry *) hash_get(&erts_fun_table, (void*) &template); + if (ret) { + long refc = erts_refc_inctest(&ret->refc, 1); + if (refc < 2) /* Pending delete */ + erts_refc_inc(&ret->refc, 1); + } + erts_fun_read_unlock(); + return ret; +} + +static void +erts_erase_fun_entry_unlocked(ErlFunEntry* fe) +{ + hash_erase(&erts_fun_table, (void *) fe); +} + +void +erts_erase_fun_entry(ErlFunEntry* fe) +{ + erts_fun_write_lock(); +#ifdef ERTS_SMP + /* + * We have to check refc again since someone might have looked up + * the fun entry and incremented refc after last check. + */ + if (erts_refc_dectest(&fe->refc, -1) <= 0) +#endif + { + if (fe->address != unloaded_fun) + erl_exit(1, + "Internal error: " + "Invalid reference count found on #Fun<%T.%d.%d>: " + " About to erase fun still referred by code.\n", + fe->module, fe->old_index, fe->old_uniq); + erts_erase_fun_entry_unlocked(fe); + } + erts_fun_write_unlock(); +} + +#ifndef HYBRID /* FIND ME! */ +void +erts_cleanup_funs(ErlFunThing* funp) +{ + while (funp) { + ErlFunEntry* fe = funp->fe; + if (erts_refc_dectest(&fe->refc, 0) == 0) { + erts_erase_fun_entry(fe); + } + funp = funp->next; + } +} +#endif + +void +erts_cleanup_funs_on_purge(Eterm* start, Eterm* end) +{ + int limit; + HashBucket** bucket; + ErlFunEntry* to_delete = NULL; + int i; + + erts_fun_write_lock(); + limit = erts_fun_table.size; + bucket = erts_fun_table.bucket; + for (i = 0; i < limit; i++) { + HashBucket* b = bucket[i]; + + while (b) { + ErlFunEntry* fe = (ErlFunEntry *) b; + Eterm* addr = fe->address; + + if (start <= addr && addr < end) { + fe->address = unloaded_fun; + if (erts_refc_dectest(&fe->refc, 0) == 0) { + fe->address = (void *) to_delete; + to_delete = fe; + } + } + b = b->next; + } + } + + while (to_delete != NULL) { + ErlFunEntry* next = (ErlFunEntry *) to_delete->address; + erts_erase_fun_entry_unlocked(to_delete); + to_delete = next; + } + erts_fun_write_unlock(); +} + +void +erts_dump_fun_entries(int to, void *to_arg) +{ + int limit; + HashBucket** bucket; + int i; + int lock = !ERTS_IS_CRASH_DUMPING; + + + if (lock) + erts_fun_read_lock(); + limit = erts_fun_table.size; + bucket = erts_fun_table.bucket; + for (i = 0; i < limit; i++) { + HashBucket* b = bucket[i]; + + while (b) { + ErlFunEntry* fe = (ErlFunEntry *) b; + erts_print(to, to_arg, "=fun\n"); + erts_print(to, to_arg, "Module: %T\n", fe->module); + erts_print(to, to_arg, "Uniq: %d\n", fe->old_uniq); + erts_print(to, to_arg, "Index: %d\n",fe->old_index); + erts_print(to, to_arg, "Address: %p\n", fe->address); +#ifdef HIPE + erts_print(to, to_arg, "Native_address: %p\n", fe->native_address); +#endif + erts_print(to, to_arg, "Refc: %d\n", erts_refc_read(&fe->refc, 1)); + b = b->next; + } + } + if (lock) + erts_fun_read_unlock(); +} + +static HashValue +fun_hash(ErlFunEntry* obj) +{ + return (HashValue) (obj->old_uniq ^ obj->old_index ^ atom_val(obj->module)); +} + +static int +fun_cmp(ErlFunEntry* obj1, ErlFunEntry* obj2) +{ + return !(obj1->module == obj2->module && + obj1->old_uniq == obj2->old_uniq && + obj1->old_index == obj2->old_index); +} + +static ErlFunEntry* +fun_alloc(ErlFunEntry* template) +{ + ErlFunEntry* obj = (ErlFunEntry *) erts_alloc(ERTS_ALC_T_FUN_ENTRY, + sizeof(ErlFunEntry)); + + obj->old_uniq = template->old_uniq; + obj->old_index = template->old_index; + obj->module = template->module; + erts_refc_init(&obj->refc, -1); + obj->address = unloaded_fun; +#ifdef HIPE + obj->native_address = NULL; +#endif + return obj; +} + +static void +fun_free(ErlFunEntry* obj) +{ + erts_free(ERTS_ALC_T_FUN_ENTRY, (void *) obj); +} diff --git a/erts/emulator/beam/erl_fun.h b/erts/emulator/beam/erl_fun.h new file mode 100644 index 0000000000..fb5e75649b --- /dev/null +++ b/erts/emulator/beam/erl_fun.h @@ -0,0 +1,92 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERLFUNTABLE_H__ +#define __ERLFUNTABLE_H__ + +#include "erl_smp.h" + +/* + * Fun entry. + */ + +typedef struct erl_fun_entry { + HashBucket bucket; /* MUST BE LOCATED AT TOP OF STRUCT!!! */ + + byte uniq[16]; /* MD5 for module. */ + int index; /* New style index. */ + int old_uniq; /* Unique number (old_style) */ + int old_index; /* Old style index */ + Eterm* address; /* Pointer to code for fun */ + +#ifdef HIPE + Eterm* native_address; /* Native entry code for fun. */ +#endif + + Uint arity; /* The arity of the fun. */ + Eterm module; /* Tagged atom for module. */ + erts_refc_t refc; /* Reference count: One for code + one for each + fun object in each process. */ +} ErlFunEntry; + +/* + * This structure represents a 'fun' (lambda). It is stored on + * process heaps. It has variable size depending on the size + * of the environment. + */ + +typedef struct erl_fun_thing { + Eterm thing_word; /* Subtag FUN_SUBTAG. */ +#ifndef HYBRID /* FIND ME! */ + struct erl_fun_thing* next; /* Next fun in mso list. */ +#endif + ErlFunEntry* fe; /* Pointer to fun entry. */ +#ifdef HIPE + Eterm* native_address; /* Native code for the fun. */ +#endif + Uint arity; /* The arity of the fun. */ + Uint num_free; /* Number of free variables (in env). */ + /* -- The following may be compound Erlang terms ---------------------- */ + Eterm creator; /* Pid of creator process (contains node). */ + Eterm env[1]; /* Environment (free variables). */ +} ErlFunThing; + +/* ERL_FUN_SIZE does _not_ include space for the environment */ +#define ERL_FUN_SIZE ((sizeof(ErlFunThing)/sizeof(Eterm))-1) + +void erts_init_fun_table(void); +void erts_fun_info(int, void *); +int erts_fun_table_sz(void); + +ErlFunEntry* erts_put_fun_entry(Eterm mod, int uniq, int index); +ErlFunEntry* erts_get_fun_entry(Eterm mod, int uniq, int index); + +ErlFunEntry* erts_put_fun_entry2(Eterm mod, int old_uniq, int old_index, + byte* uniq, int index, int arity); +ErlFunEntry* erts_get_fun_entry2(Eterm mod, int old_uniq, int old_index, + byte* uniq, int index, int arity); + +void erts_erase_fun_entry(ErlFunEntry* fe); +#ifndef HYBRID /* FIND ME! */ +void erts_cleanup_funs(ErlFunThing* funp); +#endif +void erts_cleanup_funs_on_purge(Eterm* start, Eterm* end); +void erts_dump_fun_entries(int, void *); + +#endif diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c new file mode 100644 index 0000000000..6945317e65 --- /dev/null +++ b/erts/emulator/beam/erl_gc.c @@ -0,0 +1,2690 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "erl_db.h" +#include "beam_catches.h" +#include "erl_binary.h" +#include "erl_bits.h" +#include "error.h" +#include "big.h" +#include "erl_gc.h" +#if HIPE +#include "hipe_stack.h" +#endif + +#define ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT 1 +#define ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE 20 +#define ERTS_INACT_WR_PB_LEAVE_LIMIT 10 +#define ERTS_INACT_WR_PB_LEAVE_PERCENTAGE 10 + +/* + * Returns number of elements in an array. + */ +#define ALENGTH(a) (sizeof(a)/sizeof(a[0])) + +static erts_smp_spinlock_t info_lck; +static Uint garbage_cols; /* no of garbage collections */ +static Uint reclaimed; /* no of words reclaimed in GCs */ + +# define STACK_SZ_ON_HEAP(p) ((p)->hend - (p)->stop) +# define OverRunCheck(P) \ + if ((P)->stop < (P)->htop) { \ + erts_fprintf(stderr, "hend=%p\n", (p)->hend); \ + erts_fprintf(stderr, "stop=%p\n", (p)->stop); \ + erts_fprintf(stderr, "htop=%p\n", (p)->htop); \ + erts_fprintf(stderr, "heap=%p\n", (p)->heap); \ + erl_exit(ERTS_ABORT_EXIT, "%s, line %d: %T: Overrun stack and heap\n", \ + __FILE__,__LINE__,(P)->id); \ + } + +#ifdef DEBUG +#define ErtsGcQuickSanityCheck(P) \ +do { \ + ASSERT((P)->heap < (P)->hend); \ + ASSERT((P)->heap_sz == (P)->hend - (P)->heap); \ + ASSERT((P)->heap <= (P)->htop && (P)->htop <= (P)->hend); \ + ASSERT((P)->heap <= (P)->stop && (P)->stop <= (P)->hend); \ + ASSERT((P)->heap <= (P)->high_water && (P)->high_water <= (P)->hend);\ + OverRunCheck((P)); \ +} while (0) +#else +#define ErtsGcQuickSanityCheck(P) \ +do { \ + OverRunCheck((P)); \ +} while (0) +#endif +/* + * This structure describes the rootset for the GC. + */ +typedef struct roots { + Eterm* v; /* Pointers to vectors with terms to GC + * (e.g. the stack). + */ + Uint sz; /* Size of each vector. */ +} Roots; + +typedef struct { + Roots def[32]; /* Default storage. */ + Roots* roots; /* Pointer to root set array. */ + Uint size; /* Storage size. */ + int num_roots; /* Number of root arrays. */ +} Rootset; + +static Uint setup_rootset(Process*, Eterm*, int, Rootset*); +static void cleanup_rootset(Rootset *rootset); +static Uint combined_message_size(Process* p); +static void remove_message_buffers(Process* p); +static int major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); +static int minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl); +static void do_minor(Process *p, int new_sz, Eterm* objv, int nobj); +static Eterm* sweep_rootset(Rootset *rootset, Eterm* htop, char* src, Uint src_size); +static Eterm* sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size); +static Eterm* sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, + char* src, Uint src_size); +static Eterm* collect_heap_frags(Process* p, Eterm* heap, + Eterm* htop, Eterm* objv, int nobj); +static Uint adjust_after_fullsweep(Process *p, int size_before, + int need, Eterm *objv, int nobj); +static void shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj); +static void grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj); +static void sweep_proc_bins(Process *p, int fullsweep); +static void sweep_proc_funs(Process *p, int fullsweep); +static void sweep_proc_externals(Process *p, int fullsweep); +static void offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size); +static void offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size); +static void offset_rootset(Process *p, Sint offs, char* area, Uint area_size, + Eterm* objv, int nobj); +static void offset_off_heap(Process* p, Sint offs, char* area, Uint area_size); +static void offset_mqueue(Process *p, Sint offs, char* area, Uint area_size); + +#ifdef HARDDEBUG +static void disallow_heap_frag_ref_in_heap(Process* p); +static void disallow_heap_frag_ref_in_old_heap(Process* p); +static void disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj); +#endif + +#ifdef ARCH_64 +# define MAX_HEAP_SIZES 154 +#else +# define MAX_HEAP_SIZES 55 +#endif + +static Sint heap_sizes[MAX_HEAP_SIZES]; /* Suitable heap sizes. */ +static int num_heap_sizes; /* Number of heap sizes. */ + +Uint erts_test_long_gc_sleep; /* Only used for testing... */ + +/* + * Initialize GC global data. + */ +void +erts_init_gc(void) +{ + int i = 0; + + erts_smp_spinlock_init(&info_lck, "gc_info"); + garbage_cols = 0; + reclaimed = 0; + erts_test_long_gc_sleep = 0; + + /* + * Heap sizes start growing in a Fibonacci sequence. + * + * Fib growth is not really ok for really large heaps, for + * example is fib(35) == 14meg, whereas fib(36) == 24meg; + * we really don't want that growth when the heaps are that big. + */ + + heap_sizes[0] = 34; + heap_sizes[1] = 55; + for (i = 2; i < 23; i++) { + heap_sizes[i] = heap_sizes[i-1] + heap_sizes[i-2]; + } + + /* At 1.3 mega words heap, we start to slow down. */ + for (i = 23; i < ALENGTH(heap_sizes); i++) { + heap_sizes[i] = 5*(heap_sizes[i-1]/4); + if (heap_sizes[i] < 0) { + /* Size turned negative. Discard this last size. */ + i--; + break; + } + } + num_heap_sizes = i; +} + +/* + * Find the next heap size equal to or greater than the given size (if offset == 0). + * + * If offset is 1, the next higher heap size is returned (always greater than size). + */ +Uint +erts_next_heap_size(Uint size, Uint offset) +{ + if (size < heap_sizes[0]) { + return heap_sizes[0]; + } else { + Sint* low = heap_sizes; + Sint* high = heap_sizes + num_heap_sizes; + Sint* mid; + + while (low < high) { + mid = low + (high-low) / 2; + if (size < mid[0]) { + high = mid; + } else if (size == mid[0]) { + ASSERT(mid+offset-heap_sizes < num_heap_sizes); + return mid[offset]; + } else if (size < mid[1]) { + ASSERT(mid[0] < size && size <= mid[1]); + ASSERT(mid+offset-heap_sizes < num_heap_sizes); + return mid[offset+1]; + } else { + low = mid + 1; + } + } + erl_exit(1, "no next heap size found: %d, offset %d\n", size, offset); + } + return 0; +} +/* + * Return the next heap size to use. Make sure we never return + * a smaller heap size than the minimum heap size for the process. + * (Use of the erlang:hibernate/3 BIF could have shrinked the + * heap below the minimum heap size.) + */ +static Uint +next_heap_size(Process* p, Uint size, Uint offset) +{ + size = erts_next_heap_size(size, offset); + return size < p->min_heap_size ? p->min_heap_size : size; +} + +Eterm +erts_heap_sizes(Process* p) +{ + int i; + int n = 0; + int big = 0; + Eterm res = NIL; + Eterm* hp; + Eterm* bigp; + + for (i = num_heap_sizes-1; i >= 0; i--) { + n += 2; + if (!MY_IS_SSMALL(heap_sizes[i])) { + big += BIG_UINT_HEAP_SIZE; + } + } + + /* + * We store all big numbers first on the heap, followed + * by all the cons cells. + */ + bigp = HAlloc(p, n+big); + hp = bigp+big; + for (i = num_heap_sizes-1; i >= 0; i--) { + Eterm num; + Sint sz = heap_sizes[i]; + + if (MY_IS_SSMALL(sz)) { + num = make_small(sz); + } else { + num = uint_to_big(sz, bigp); + bigp += BIG_UINT_HEAP_SIZE; + } + res = CONS(hp, num, res); + hp += 2; + } + return res; +} + +void +erts_gc_info(ErtsGCInfo *gcip) +{ + if (gcip) { + erts_smp_spin_lock(&info_lck); + gcip->garbage_collections = garbage_cols; + gcip->reclaimed = reclaimed; + erts_smp_spin_unlock(&info_lck); + } +} + +void +erts_offset_heap(Eterm* hp, Uint sz, Sint offs, Eterm* low, Eterm* high) +{ + offset_heap(hp, sz, offs, (char*) low, ((char *)high)-((char *)low)); +} + +void +erts_offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, + Eterm* low, Eterm* high) +{ + offset_heap_ptr(hp, sz, offs, (char *) low, ((char *)high)-((char *)low)); +} + +#define ptr_within(ptr, low, high) ((ptr) < (high) && (ptr) >= (low)) + +void +erts_offset_off_heap(ErlOffHeap *ohp, Sint offs, Eterm* low, Eterm* high) +{ + if (ohp->mso && ptr_within((Eterm *)ohp->mso, low, high)) { + Eterm** uptr = (Eterm**) (void *) &ohp->mso; + *uptr += offs; + } + +#ifndef HYBRID /* FIND ME! */ + if (ohp->funs && ptr_within((Eterm *)ohp->funs, low, high)) { + Eterm** uptr = (Eterm**) (void *) &ohp->funs; + *uptr += offs; + } +#endif + + if (ohp->externals && ptr_within((Eterm *)ohp->externals, low, high)) { + Eterm** uptr = (Eterm**) (void *) &ohp->externals; + *uptr += offs; + } +} +#undef ptr_within + +Eterm +erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity) +{ + int cost; + + if (is_non_value(result)) { + if (p->freason == TRAP) { + cost = erts_garbage_collect(p, 0, p->def_arg_reg, p->arity); + } else { + cost = erts_garbage_collect(p, 0, regs, arity); + } + } else { + Eterm val[1]; + + val[0] = result; + cost = erts_garbage_collect(p, 0, val, 1); + result = val[0]; + } + BUMP_REDS(p, cost); + return result; +} + +/* + * Garbage collect a process. + * + * p: Pointer to the process structure. + * need: Number of Eterm words needed on the heap. + * objv: Array of terms to add to rootset; that is to preserve. + * nobj: Number of objects in objv. + */ +int +erts_garbage_collect(Process* p, int need, Eterm* objv, int nobj) +{ + Uint reclaimed_now = 0; + int done = 0; + Uint ms1, s1, us1; + + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_start); + } + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + p->gcstatus = p->status; + p->status = P_GARBING; + if (erts_system_monitor_long_gc != 0) { + get_now(&ms1, &s1, &us1); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + + erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC); + + ERTS_CHK_OFFHEAP(p); + + ErtsGcQuickSanityCheck(p); + if (GEN_GCS(p) >= MAX_GEN_GCS(p)) { + FLAGS(p) |= F_NEED_FULLSWEEP; + } + + /* + * Test which type of GC to do. + */ + while (!done) { + if ((FLAGS(p) & F_NEED_FULLSWEEP) != 0) { + done = major_collection(p, need, objv, nobj, &reclaimed_now); + } else { + done = minor_collection(p, need, objv, nobj, &reclaimed_now); + } + } + + /* + * Finish. + */ + + ERTS_CHK_OFFHEAP(p); + + ErtsGcQuickSanityCheck(p); + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + p->status = p->gcstatus; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + if (IS_TRACED_FL(p, F_TRACE_GC)) { + trace_gc(p, am_gc_end); + } + + erts_smp_locked_activity_end(ERTS_ACTIVITY_GC); + + if (erts_system_monitor_long_gc != 0) { + Uint ms2, s2, us2; + Sint t; + if (erts_test_long_gc_sleep) + while (0 != erts_milli_sleep(erts_test_long_gc_sleep)); + get_now(&ms2, &s2, &us2); + t = ms2 - ms1; + t = t*1000000 + s2 - s1; + t = t*1000 + ((Sint) (us2 - us1))/1000; + if (t > 0 && (Uint)t > erts_system_monitor_long_gc) { + monitor_long_gc(p, t); + } + } + if (erts_system_monitor_large_heap != 0) { + Uint size = HEAP_SIZE(p); + size += OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0; + if (size >= erts_system_monitor_large_heap) + monitor_large_heap(p); + } + + erts_smp_spin_lock(&info_lck); + garbage_cols++; + reclaimed += reclaimed_now; + erts_smp_spin_unlock(&info_lck); + + FLAGS(p) &= ~F_FORCE_GC; + +#ifdef CHECK_FOR_HOLES + /* + * We intentionally do not rescan the areas copied by the GC. + * We trust the GC not to leave any holes. + */ + p->last_htop = p->htop; + p->last_mbuf = 0; +#endif + +#ifdef DEBUG + /* + * The scanning for pointers from the old_heap into the new_heap or + * heap fragments turned out to be costly, so we remember how far we + * have scanned this time and will start scanning there next time. + * (We will not detect wild writes into the old heap, or modifications + * of the old heap in-between garbage collections.) + */ + p->last_old_htop = p->old_htop; +#endif + + return ((int) (HEAP_TOP(p) - HEAP_START(p)) / 10); +} + +/* + * Place all living data on a the new heap; deallocate any old heap. + * Meant to be used by hibernate/3. + */ +void +erts_garbage_collect_hibernate(Process* p) +{ + Uint heap_size; + Eterm* heap; + Eterm* htop; + Rootset rootset; + int n; + char* src; + Uint src_size; + Uint actual_size; + char* area; + Uint area_size; + Sint offs; + + /* + * Preliminaries. + */ + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + p->gcstatus = p->status; + p->status = P_GARBING; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC); + ErtsGcQuickSanityCheck(p); + ASSERT(p->mbuf_sz == 0); + ASSERT(p->mbuf == 0); + ASSERT(p->stop == p->hend); /* Stack must be empty. */ + + /* + * Do it. + */ + + + heap_size = p->heap_sz + (p->old_htop - p->old_heap); + heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_TMP_HEAP, + sizeof(Eterm)*heap_size); + htop = heap; + + n = setup_rootset(p, p->arg_reg, p->arity, &rootset); + + src = (char *) p->heap; + src_size = (char *) p->htop - src; + htop = sweep_rootset(&rootset, htop, src, src_size); + htop = sweep_one_area(heap, htop, src, src_size); + + if (p->old_heap) { + src = (char *) p->old_heap; + src_size = (char *) p->old_htop - src; + htop = sweep_rootset(&rootset, htop, src, src_size); + htop = sweep_one_area(heap, htop, src, src_size); + } + + cleanup_rootset(&rootset); + + if (MSO(p).mso) { + sweep_proc_bins(p, 1); + } + if (MSO(p).funs) { + sweep_proc_funs(p, 1); + } + if (MSO(p).externals) { + sweep_proc_externals(p, 1); + } + + /* + * Update all pointers. + */ + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, + (void*)HEAP_START(p), + HEAP_SIZE(p) * sizeof(Eterm)); + if (p->old_heap) { + ERTS_HEAP_FREE(ERTS_ALC_T_OLD_HEAP, + (void*)p->old_heap, + (p->old_hend - p->old_heap) * sizeof(Eterm)); + p->old_heap = p->old_htop = p->old_hend = 0; + } + + p->heap = heap; + p->high_water = htop; + p->htop = htop; + p->hend = p->heap + heap_size; + p->stop = p->hend; + p->heap_sz = heap_size; + + heap_size = actual_size = p->htop - p->heap; + if (heap_size == 0) { + heap_size = 1; /* We want a heap... */ + } + + FLAGS(p) &= ~F_FORCE_GC; + + /* + * Move the heap to its final destination. + * + * IMPORTANT: We have garbage collected to a temporary heap and + * then copy the result to a newly allocated heap of exact size. + * This is intentional and important! Garbage collecting as usual + * and then shrinking the heap by reallocating it caused serious + * fragmentation problems when large amounts of processes were + * hibernated. + */ + + ASSERT(p->hend - p->stop == 0); /* Empty stack */ + ASSERT(actual_size < p->heap_sz); + + heap = ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*heap_size); + sys_memcpy((void *) heap, (void *) p->heap, actual_size*sizeof(Eterm)); + ERTS_HEAP_FREE(ERTS_ALC_T_TMP_HEAP, p->heap, p->heap_sz*sizeof(Eterm)); + + p->stop = p->hend = heap + heap_size; + + offs = heap - p->heap; + area = (char *) p->heap; + area_size = ((char *) p->htop) - area; + offset_heap(heap, actual_size, offs, area, area_size); + p->high_water = heap + (p->high_water - p->heap); + offset_rootset(p, offs, area, area_size, p->arg_reg, p->arity); + p->htop = heap + actual_size; + p->heap = heap; + p->heap_sz = heap_size; + + +#ifdef CHECK_FOR_HOLES + p->last_htop = p->htop; + p->last_mbuf = 0; +#endif +#ifdef DEBUG + p->last_old_htop = NULL; +#endif + + /* + * Finishing. + */ + + ErtsGcQuickSanityCheck(p); + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + p->status = p->gcstatus; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_smp_locked_activity_end(ERTS_ACTIVITY_GC); +} + + +void +erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size) +{ + Uint byte_lit_size = sizeof(Eterm)*lit_size; + Uint old_heap_size; + Eterm* temp_lit; + Sint offs; + Rootset rootset; /* Rootset for GC (stack, dictionary, etc). */ + Roots* roots; + char* area; + Uint area_size; + Eterm* old_htop; + int n; + + /* + * Set GC state. + */ + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + p->gcstatus = p->status; + p->status = P_GARBING; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_smp_locked_activity_begin(ERTS_ACTIVITY_GC); + + /* + * We assume that the caller has already done a major collection + * (which has discarded the old heap), so that we don't have to cope + * with pointer to literals on the old heap. We will now allocate + * an old heap to contain the literals. + */ + + ASSERT(p->old_heap == 0); /* Must NOT have an old heap yet. */ + old_heap_size = erts_next_heap_size(lit_size, 0); + p->old_heap = p->old_htop = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_OLD_HEAP, + sizeof(Eterm)*old_heap_size); + p->old_hend = p->old_heap + old_heap_size; + + /* + * We soon want to garbage collect the literals. But since a GC is + * destructive (MOVED markers are written), we must copy the literals + * to a temporary area and change all references to literals. + */ + temp_lit = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, byte_lit_size); + sys_memcpy(temp_lit, literals, byte_lit_size); + offs = temp_lit - literals; + offset_heap(temp_lit, lit_size, offs, (char *) literals, byte_lit_size); + offset_heap(p->heap, p->htop - p->heap, offs, (char *) literals, byte_lit_size); + offset_rootset(p, offs, (char *) literals, byte_lit_size, p->arg_reg, p->arity); + + /* + * Now the literals are placed in memory that is safe to write into, + * so now we GC the literals into the old heap. First we go through the + * rootset. + */ + + area = (char *) temp_lit; + area_size = byte_lit_size; + n = setup_rootset(p, p->arg_reg, p->arity, &rootset); + roots = rootset.roots; + old_htop = p->old_htop; + while (n--) { + Eterm* g_ptr = roots->v; + Uint g_sz = roots->sz; + Eterm* ptr; + Eterm val; + + roots++; + + while (g_sz--) { + Eterm gval = *g_ptr; + + switch (primary_tag(gval)) { + case TAG_PRIMARY_BOXED: + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *g_ptr++ = val; + } else if (in_area(ptr, area, area_size)) { + MOVE_BOXED(ptr,val,old_htop,g_ptr++); + } else { + g_ptr++; + } + break; + case TAG_PRIMARY_LIST: + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { /* Moved */ + *g_ptr++ = ptr[1]; + } else if (in_area(ptr, area, area_size)) { + MOVE_CONS(ptr,val,old_htop,g_ptr++); + } else { + g_ptr++; + } + break; + default: + g_ptr++; + break; + } + } + } + ASSERT(p->old_htop <= old_htop && old_htop <= p->old_hend); + cleanup_rootset(&rootset); + + /* + * Now all references in the rootset to the literals have been updated. + * Now we'll have to go through all heaps updating all other references. + */ + + old_htop = sweep_one_heap(p->heap, p->htop, old_htop, area, area_size); + old_htop = sweep_one_area(p->old_heap, old_htop, area, area_size); + ASSERT(p->old_htop <= old_htop && old_htop <= p->old_hend); + p->old_htop = old_htop; + + /* + * We no longer need this temporary area. + */ + erts_free(ERTS_ALC_T_TMP, (void *) temp_lit); + + /* + * Restore status. + */ + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + p->status = p->gcstatus; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + erts_smp_locked_activity_end(ERTS_ACTIVITY_GC); +} + +static int +minor_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) +{ + Uint mature = HIGH_WATER(p) - HEAP_START(p); + + /* + * Allocate an old heap if we don't have one and if we'll need one. + */ + + if (OLD_HEAP(p) == NULL && mature != 0) { + Eterm* n_old; + + /* Note: We choose a larger heap size than strictly needed, + * which seems to reduce the number of fullsweeps. + * This improved Estone by more than 1200 estones on my computer + * (Ultra Sparc 10). + */ + size_t new_sz = erts_next_heap_size(HEAP_TOP(p) - HEAP_START(p), 1); + + /* Create new, empty old_heap */ + n_old = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_OLD_HEAP, + sizeof(Eterm)*new_sz); + + OLD_HEND(p) = n_old + new_sz; + OLD_HEAP(p) = OLD_HTOP(p) = n_old; + } + + /* + * Do a minor collection if there is an old heap and if it + * is large enough. + */ + + if (OLD_HEAP(p) && mature <= OLD_HEND(p) - OLD_HTOP(p)) { + ErlMessage *msgp; + Uint size_after; + Uint need_after; + Uint stack_size = STACK_SZ_ON_HEAP(p); + Uint fragments = MBUF_SIZE(p) + combined_message_size(p); + Uint size_before = fragments + (HEAP_TOP(p) - HEAP_START(p)); + Uint new_sz = next_heap_size(p, HEAP_SIZE(p) + fragments, 0); + + do_minor(p, new_sz, objv, nobj); + + /* + * Copy newly received message onto the end of the new heap. + */ + ErtsGcQuickSanityCheck(p); + for (msgp = p->msg.first; msgp; msgp = msgp->next) { + if (msgp->data.attached) { + erts_move_msg_attached_data_to_heap(&p->htop, &p->off_heap, msgp); + ErtsGcQuickSanityCheck(p); + } + } + ErtsGcQuickSanityCheck(p); + + GEN_GCS(p)++; + size_after = HEAP_TOP(p) - HEAP_START(p); + need_after = size_after + need + stack_size; + *recl += (size_before - size_after); + + /* + * Excessively large heaps should be shrunk, but + * don't even bother on reasonable small heaps. + * + * The reason for this is that after tenuring, we often + * use a really small portion of new heap, therefore, unless + * the heap size is substantial, we don't want to shrink. + */ + + if ((HEAP_SIZE(p) > 3000) && (4 * need_after < HEAP_SIZE(p)) && + ((HEAP_SIZE(p) > 8000) || + (HEAP_SIZE(p) > (OLD_HEND(p) - OLD_HEAP(p))))) { + Uint wanted = 3 * need_after; + Uint old_heap_sz = OLD_HEND(p) - OLD_HEAP(p); + + /* + * Additional test to make sure we don't make the heap too small + * compared to the size of the older generation heap. + */ + if (wanted*9 < old_heap_sz) { + Uint new_wanted = old_heap_sz / 8; + if (new_wanted > wanted) { + wanted = new_wanted; + } + } + + if (wanted < MIN_HEAP_SIZE(p)) { + wanted = MIN_HEAP_SIZE(p); + } else { + wanted = next_heap_size(p, wanted, 0); + } + if (wanted < HEAP_SIZE(p)) { + shrink_new_heap(p, wanted, objv, nobj); + } + ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); + return 1; /* We are done. */ + } + + if (HEAP_SIZE(p) >= need_after) { + /* + * The heap size turned out to be just right. We are done. + */ + ASSERT(HEAP_SIZE(p) == next_heap_size(p, HEAP_SIZE(p), 0)); + return 1; + } + } + + /* + * Still not enough room after minor collection. Must force a major collection. + */ + FLAGS(p) |= F_NEED_FULLSWEEP; + return 0; +} + +/* + * HiPE native code stack scanning procedures: + * - fullsweep_nstack() + * - gensweep_nstack() + * - offset_nstack() + */ +#if defined(HIPE) + +#define GENSWEEP_NSTACK(p,old_htop,n_htop) \ + do { \ + Eterm *tmp_old_htop = old_htop; \ + Eterm *tmp_n_htop = n_htop; \ + gensweep_nstack((p), &tmp_old_htop, &tmp_n_htop); \ + old_htop = tmp_old_htop; \ + n_htop = tmp_n_htop; \ + } while(0) + +/* + * offset_nstack() can ignore the descriptor-based traversal the other + * nstack procedures use and simply call offset_heap_ptr() instead. + * This relies on two facts: + * 1. The only live non-Erlang terms on an nstack are return addresses, + * and they will be skipped thanks to the low/high range check. + * 2. Dead values, even if mistaken for pointers into the low/high area, + * can be offset safely since they won't be dereferenced. + * + * XXX: WARNING: If HiPE starts storing other non-Erlang values on the + * nstack, such as floats, then this will have to be changed. + */ +#define offset_nstack(p,offs,area,area_size) offset_heap_ptr(hipe_nstack_start((p)),hipe_nstack_used((p)),(offs),(area),(area_size)) + +#else /* !HIPE */ + +#define fullsweep_nstack(p,n_htop) (n_htop) +#define GENSWEEP_NSTACK(p,old_htop,n_htop) do{}while(0) +#define offset_nstack(p,offs,area,area_size) do{}while(0) + +#endif /* HIPE */ + +static void +do_minor(Process *p, int new_sz, Eterm* objv, int nobj) +{ + Rootset rootset; /* Rootset for GC (stack, dictionary, etc). */ + Roots* roots; + Eterm* n_htop; + int n; + Eterm* ptr; + Eterm val; + Eterm gval; + char* heap = (char *) HEAP_START(p); + Uint heap_size = (char *) HEAP_TOP(p) - heap; + Uint mature_size = (char *) HIGH_WATER(p) - heap; + Eterm* old_htop = OLD_HTOP(p); + Eterm* n_heap; + + n_htop = n_heap = (Eterm*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, + sizeof(Eterm)*new_sz); + + if (MBUF(p) != NULL) { + n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj); + } + + n = setup_rootset(p, objv, nobj, &rootset); + roots = rootset.roots; + + GENSWEEP_NSTACK(p, old_htop, n_htop); + while (n--) { + Eterm* g_ptr = roots->v; + Uint g_sz = roots->sz; + + roots++; + while (g_sz--) { + gval = *g_ptr; + + switch (primary_tag(gval)) { + + case TAG_PRIMARY_BOXED: { + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *g_ptr++ = val; + } else if (in_area(ptr, heap, mature_size)) { + MOVE_BOXED(ptr,val,old_htop,g_ptr++); + } else if (in_area(ptr, heap, heap_size)) { + MOVE_BOXED(ptr,val,n_htop,g_ptr++); + } else { + g_ptr++; + } + break; + } + + case TAG_PRIMARY_LIST: { + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { /* Moved */ + *g_ptr++ = ptr[1]; + } else if (in_area(ptr, heap, mature_size)) { + MOVE_CONS(ptr,val,old_htop,g_ptr++); + } else if (in_area(ptr, heap, heap_size)) { + MOVE_CONS(ptr,val,n_htop,g_ptr++); + } else { + g_ptr++; + } + break; + } + + default: + g_ptr++; + break; + } + } + } + + cleanup_rootset(&rootset); + + /* + * Now all references in the rootset point to the new heap. However, + * most references on the new heap point to the old heap so the next stage + * is to scan through the new heap evacuating data from the old heap + * until all is changed. + */ + + if (mature_size == 0) { + n_htop = sweep_one_area(n_heap, n_htop, heap, heap_size); + } else { + Eterm* n_hp = n_heap; + + while (n_hp != n_htop) { + Eterm* ptr; + Eterm val; + Eterm gval = *n_hp; + + switch (primary_tag(gval)) { + case TAG_PRIMARY_BOXED: { + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *n_hp++ = val; + } else if (in_area(ptr, heap, mature_size)) { + MOVE_BOXED(ptr,val,old_htop,n_hp++); + } else if (in_area(ptr, heap, heap_size)) { + MOVE_BOXED(ptr,val,n_htop,n_hp++); + } else { + n_hp++; + } + break; + } + case TAG_PRIMARY_LIST: { + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { + *n_hp++ = ptr[1]; + } else if (in_area(ptr, heap, mature_size)) { + MOVE_CONS(ptr,val,old_htop,n_hp++); + } else if (in_area(ptr, heap, heap_size)) { + MOVE_CONS(ptr,val,n_htop,n_hp++); + } else { + n_hp++; + } + break; + } + case TAG_PRIMARY_HEADER: { + if (!header_is_thing(gval)) + n_hp++; + else { + if (header_is_bin_matchstate(gval)) { + ErlBinMatchState *ms = (ErlBinMatchState*) n_hp; + ErlBinMatchBuffer *mb = &(ms->mb); + Eterm* origptr = &(mb->orig); + ptr = boxed_val(*origptr); + val = *ptr; + if (IS_MOVED(val)) { + *origptr = val; + mb->base = binary_bytes(val); + } else if (in_area(ptr, heap, mature_size)) { + MOVE_BOXED(ptr,val,old_htop,origptr); + mb->base = binary_bytes(mb->orig); + } else if (in_area(ptr, heap, heap_size)) { + MOVE_BOXED(ptr,val,n_htop,origptr); + mb->base = binary_bytes(mb->orig); + } + } + n_hp += (thing_arityval(gval)+1); + } + break; + } + default: + n_hp++; + break; + } + } + } + + /* + * And also if we have been tenuring, references on the second generation + * may point to the old (soon to be deleted) new_heap. + */ + + if (OLD_HTOP(p) < old_htop) { + old_htop = sweep_one_area(OLD_HTOP(p), old_htop, heap, heap_size); + } + OLD_HTOP(p) = old_htop; + HIGH_WATER(p) = (HEAP_START(p) != HIGH_WATER(p)) ? n_heap : n_htop; + + if (MSO(p).mso) { + sweep_proc_bins(p, 0); + } + + if (MSO(p).funs) { + sweep_proc_funs(p, 0); + } + if (MSO(p).externals) { + sweep_proc_externals(p, 0); + } + +#ifdef HARDDEBUG + /* + * Go through the old_heap before, and try to find references from the old_heap + * into the old new_heap that has just been evacuated and is about to be freed + * (as well as looking for reference into heap fragments, of course). + */ + disallow_heap_frag_ref_in_old_heap(p); +#endif + + /* Copy stack to end of new heap */ + n = p->hend - p->stop; + sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm)); + p->stop = n_heap + new_sz - n; + + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, + (void*)HEAP_START(p), + HEAP_SIZE(p) * sizeof(Eterm)); + HEAP_START(p) = n_heap; + HEAP_TOP(p) = n_htop; + HEAP_SIZE(p) = new_sz; + HEAP_END(p) = n_heap + new_sz; + +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p); +#endif + remove_message_buffers(p); +} + +/* + * Major collection. DISCARD the old heap. + */ + +static int +major_collection(Process* p, int need, Eterm* objv, int nobj, Uint *recl) +{ + Rootset rootset; + Roots* roots; + int size_before; + Eterm* n_heap; + Eterm* n_htop; + char* src = (char *) HEAP_START(p); + Uint src_size = (char *) HEAP_TOP(p) - src; + char* oh = (char *) OLD_HEAP(p); + Uint oh_size = (char *) OLD_HTOP(p) - oh; + int n; + Uint new_sz; + Uint fragments = MBUF_SIZE(p) + combined_message_size(p); + ErlMessage *msgp; + + size_before = fragments + (HEAP_TOP(p) - HEAP_START(p)); + + /* + * Do a fullsweep GC. First figure out the size of the heap + * to receive all live data. + */ + + new_sz = HEAP_SIZE(p) + fragments + (OLD_HTOP(p) - OLD_HEAP(p)); + /* + * We used to do + * + * new_sz += STACK_SZ_ON_HEAP(p); + * + * here for no obvious reason. (The stack size is already counted once + * in HEAP_SIZE(p).) + */ + new_sz = next_heap_size(p, new_sz, 0); + + /* + * Should we grow although we don't actually need to? + */ + + if (new_sz == HEAP_SIZE(p) && FLAGS(p) & F_HEAP_GROW) { + new_sz = next_heap_size(p, HEAP_SIZE(p), 1); + } + FLAGS(p) &= ~(F_HEAP_GROW|F_NEED_FULLSWEEP); + n_htop = n_heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, + sizeof(Eterm)*new_sz); + + /* + * Get rid of heap fragments. + */ + + if (MBUF(p) != NULL) { + n_htop = collect_heap_frags(p, n_heap, n_htop, objv, nobj); + } + + /* + * Copy all top-level terms directly referenced by the rootset to + * the new new_heap. + */ + + n = setup_rootset(p, objv, nobj, &rootset); + n_htop = fullsweep_nstack(p, n_htop); + roots = rootset.roots; + while (n--) { + Eterm* g_ptr = roots->v; + Eterm g_sz = roots->sz; + + roots++; + while (g_sz--) { + Eterm* ptr; + Eterm val; + Eterm gval = *g_ptr; + + switch (primary_tag(gval)) { + + case TAG_PRIMARY_BOXED: { + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *g_ptr++ = val; + } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) { + MOVE_BOXED(ptr,val,n_htop,g_ptr++); + } else { + g_ptr++; + } + continue; + } + + case TAG_PRIMARY_LIST: { + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { + *g_ptr++ = ptr[1]; + } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) { + MOVE_CONS(ptr,val,n_htop,g_ptr++); + } else { + g_ptr++; + } + continue; + } + + default: { + g_ptr++; + continue; + } + } + } + } + + cleanup_rootset(&rootset); + + /* + * Now all references on the stack point to the new heap. However, + * most references on the new heap point to the old heap so the next stage + * is to scan through the new heap evacuating data from the old heap + * until all is copied. + */ + + if (oh_size == 0) { + n_htop = sweep_one_area(n_heap, n_htop, src, src_size); + } else { + Eterm* n_hp = n_heap; + + while (n_hp != n_htop) { + Eterm* ptr; + Eterm val; + Eterm gval = *n_hp; + + switch (primary_tag(gval)) { + case TAG_PRIMARY_BOXED: { + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *n_hp++ = val; + } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) { + MOVE_BOXED(ptr,val,n_htop,n_hp++); + } else { + n_hp++; + } + break; + } + case TAG_PRIMARY_LIST: { + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { + *n_hp++ = ptr[1]; + } else if (in_area(ptr, src, src_size) || in_area(ptr, oh, oh_size)) { + MOVE_CONS(ptr,val,n_htop,n_hp++); + } else { + n_hp++; + } + break; + } + case TAG_PRIMARY_HEADER: { + if (!header_is_thing(gval)) + n_hp++; + else { + if (header_is_bin_matchstate(gval)) { + ErlBinMatchState *ms = (ErlBinMatchState*) n_hp; + ErlBinMatchBuffer *mb = &(ms->mb); + Eterm* origptr; + origptr = &(mb->orig); + ptr = boxed_val(*origptr); + val = *ptr; + if (IS_MOVED(val)) { + *origptr = val; + mb->base = binary_bytes(*origptr); + } else if (in_area(ptr, src, src_size) || + in_area(ptr, oh, oh_size)) { + MOVE_BOXED(ptr,val,n_htop,origptr); + mb->base = binary_bytes(*origptr); + ptr = boxed_val(*origptr); + val = *ptr; + } + } + n_hp += (thing_arityval(gval)+1); + } + break; + } + default: + n_hp++; + break; + } + } + } + + if (MSO(p).mso) { + sweep_proc_bins(p, 1); + } + if (MSO(p).funs) { + sweep_proc_funs(p, 1); + } + if (MSO(p).externals) { + sweep_proc_externals(p, 1); + } + + if (OLD_HEAP(p) != NULL) { + ERTS_HEAP_FREE(ERTS_ALC_T_OLD_HEAP, + OLD_HEAP(p), + (OLD_HEND(p) - OLD_HEAP(p)) * sizeof(Eterm)); + OLD_HEAP(p) = OLD_HTOP(p) = OLD_HEND(p) = NULL; + } + + /* Move the stack to the end of the heap */ + n = HEAP_END(p) - p->stop; + sys_memcpy(n_heap + new_sz - n, p->stop, n * sizeof(Eterm)); + p->stop = n_heap + new_sz - n; + + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, + (void *) HEAP_START(p), + (HEAP_END(p) - HEAP_START(p)) * sizeof(Eterm)); + HEAP_START(p) = n_heap; + HEAP_TOP(p) = n_htop; + HEAP_SIZE(p) = new_sz; + HEAP_END(p) = n_heap + new_sz; + GEN_GCS(p) = 0; + + HIGH_WATER(p) = HEAP_TOP(p); + + ErtsGcQuickSanityCheck(p); + /* + * Copy newly received message onto the end of the new heap. + */ + for (msgp = p->msg.first; msgp; msgp = msgp->next) { + if (msgp->data.attached) { + erts_move_msg_attached_data_to_heap(&p->htop, &p->off_heap, msgp); + ErtsGcQuickSanityCheck(p); + } + } + + *recl += adjust_after_fullsweep(p, size_before, need, objv, nobj); + +#ifdef HARDDEBUG + disallow_heap_frag_ref_in_heap(p); +#endif + remove_message_buffers(p); + + ErtsGcQuickSanityCheck(p); + return 1; /* We are done. */ +} + +static Uint +adjust_after_fullsweep(Process *p, int size_before, int need, Eterm *objv, int nobj) +{ + int wanted, sz, size_after, need_after; + int stack_size = STACK_SZ_ON_HEAP(p); + Uint reclaimed_now; + + size_after = (HEAP_TOP(p) - HEAP_START(p)); + reclaimed_now = (size_before - size_after); + + /* + * Resize the heap if needed. + */ + + need_after = size_after + need + stack_size; + if (HEAP_SIZE(p) < need_after) { + /* Too small - grow to match requested need */ + sz = next_heap_size(p, need_after, 0); + grow_new_heap(p, sz, objv, nobj); + } else if (3 * HEAP_SIZE(p) < 4 * need_after){ + /* Need more than 75% of current, postpone to next GC.*/ + FLAGS(p) |= F_HEAP_GROW; + } else if (4 * need_after < HEAP_SIZE(p) && HEAP_SIZE(p) > H_MIN_SIZE){ + /* We need less than 25% of the current heap, shrink.*/ + /* XXX - This is how it was done in the old GC: + wanted = 4 * need_after; + I think this is better as fullsweep is used mainly on + small memory systems, but I could be wrong... */ + wanted = 2 * need_after; + if (wanted < p->min_heap_size) { + sz = p->min_heap_size; + } else { + sz = next_heap_size(p, wanted, 0); + } + if (sz < HEAP_SIZE(p)) { + shrink_new_heap(p, sz, objv, nobj); + } + } + + return reclaimed_now; +} + +/* + * Return the size of all message buffers that are NOT linked in the + * mbuf list. + */ +static Uint +combined_message_size(Process* p) +{ + Uint sz = 0; + ErlMessage *msgp; + + for (msgp = p->msg.first; msgp; msgp = msgp->next) { + if (msgp->data.attached) { + sz += erts_msg_attached_data_size(msgp); + } + } + return sz; +} + +/* + * Remove all message buffers. + */ +static void +remove_message_buffers(Process* p) +{ + ErlHeapFragment* bp = MBUF(p); + + MBUF(p) = NULL; + MBUF_SIZE(p) = 0; + while (bp != NULL) { + ErlHeapFragment* next_bp = bp->next; + free_message_buffer(bp); + bp = next_bp; + } +} + +/* + * Go through one root set array, move everything that it is one of the + * heap fragments to our new heap. + */ +static Eterm* +collect_root_array(Process* p, Eterm* n_htop, Eterm* objv, int nobj) +{ + ErlHeapFragment* qb; + Eterm gval; + Eterm* ptr; + Eterm val; + + ASSERT(p->htop != NULL); + while (nobj--) { + gval = *objv; + + switch (primary_tag(gval)) { + + case TAG_PRIMARY_BOXED: { + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *objv++ = val; + } else { + for (qb = MBUF(p); qb != NULL; qb = qb->next) { + if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) { + MOVE_BOXED(ptr,val,n_htop,objv); + break; + } + } + objv++; + } + break; + } + + case TAG_PRIMARY_LIST: { + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { + *objv++ = ptr[1]; + } else { + for (qb = MBUF(p); qb != NULL; qb = qb->next) { + if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) { + MOVE_CONS(ptr,val,n_htop,objv); + break; + } + } + objv++; + } + break; + } + + default: { + objv++; + break; + } + } + } + return n_htop; +} + +#ifdef HARDDEBUG + +/* + * Routines to verify that we don't have pointer into heap fragments from + * that are not allowed to have them. + * + * For performance reasons, we use _unchecked_list_val(), _unchecked_boxed_val(), + * and so on to avoid a function call. + */ + +static void +disallow_heap_frag_ref(Process* p, Eterm* n_htop, Eterm* objv, int nobj) +{ + ErlHeapFragment* mbuf; + ErlHeapFragment* qb; + Eterm gval; + Eterm* ptr; + Eterm val; + + ASSERT(p->htop != NULL); + mbuf = MBUF(p); + + while (nobj--) { + gval = *objv; + + switch (primary_tag(gval)) { + + case TAG_PRIMARY_BOXED: { + ptr = _unchecked_boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + objv++; + } else { + for (qb = mbuf; qb != NULL; qb = qb->next) { + if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) { + abort(); + } + } + objv++; + } + break; + } + + case TAG_PRIMARY_LIST: { + ptr = _unchecked_list_val(gval); + val = *ptr; + if (is_non_value(val)) { + objv++; + } else { + for (qb = mbuf; qb != NULL; qb = qb->next) { + if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) { + abort(); + } + } + objv++; + } + break; + } + + default: { + objv++; + break; + } + } + } +} + +static void +disallow_heap_frag_ref_in_heap(Process* p) +{ + Eterm* hp; + Eterm* htop; + Eterm* heap; + Uint heap_size; + + if (p->mbuf == 0) { + return; + } + + htop = p->htop; + heap = p->heap; + heap_size = (htop - heap)*sizeof(Eterm); + + hp = heap; + while (hp < htop) { + ErlHeapFragment* qb; + Eterm* ptr; + Eterm val; + + val = *hp++; + switch (primary_tag(val)) { + case TAG_PRIMARY_BOXED: + ptr = _unchecked_boxed_val(val); + if (!in_area(ptr, heap, heap_size)) { + for (qb = MBUF(p); qb != NULL; qb = qb->next) { + if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) { + abort(); + } + } + } + break; + case TAG_PRIMARY_LIST: + ptr = _unchecked_list_val(val); + if (!in_area(ptr, heap, heap_size)) { + for (qb = MBUF(p); qb != NULL; qb = qb->next) { + if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) { + abort(); + } + } + } + break; + case TAG_PRIMARY_HEADER: + if (header_is_thing(val)) { + hp += _unchecked_thing_arityval(val); + } + break; + } + } +} + +static void +disallow_heap_frag_ref_in_old_heap(Process* p) +{ + Eterm* hp; + Eterm* htop; + Eterm* old_heap; + Uint old_heap_size; + Eterm* new_heap; + Uint new_heap_size; + + htop = p->old_htop; + old_heap = p->old_heap; + old_heap_size = (htop - old_heap)*sizeof(Eterm); + new_heap = p->heap; + new_heap_size = (p->htop - new_heap)*sizeof(Eterm); + + ASSERT(!p->last_old_htop + || (old_heap <= p->last_old_htop && p->last_old_htop <= htop)); + hp = p->last_old_htop ? p->last_old_htop : old_heap; + while (hp < htop) { + ErlHeapFragment* qb; + Eterm* ptr; + Eterm val; + + val = *hp++; + switch (primary_tag(val)) { + case TAG_PRIMARY_BOXED: + ptr = (Eterm *) val; + if (!in_area(ptr, old_heap, old_heap_size)) { + if (in_area(ptr, new_heap, new_heap_size)) { + abort(); + } + for (qb = MBUF(p); qb != NULL; qb = qb->next) { + if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) { + abort(); + } + } + } + break; + case TAG_PRIMARY_LIST: + ptr = (Eterm *) val; + if (!in_area(ptr, old_heap, old_heap_size)) { + if (in_area(ptr, new_heap, new_heap_size)) { + abort(); + } + for (qb = MBUF(p); qb != NULL; qb = qb->next) { + if (in_area(ptr, qb->mem, qb->size*sizeof(Eterm))) { + abort(); + } + } + } + break; + case TAG_PRIMARY_HEADER: + if (header_is_thing(val)) { + hp += _unchecked_thing_arityval(val); + if (!in_area(hp, old_heap, old_heap_size+1)) { + abort(); + } + } + break; + } + } +} +#endif + +static Eterm* +sweep_rootset(Rootset* rootset, Eterm* htop, char* src, Uint src_size) +{ + Roots* roots = rootset->roots; + Uint n = rootset->num_roots; + Eterm* ptr; + Eterm gval; + Eterm val; + + while (n--) { + Eterm* g_ptr = roots->v; + Uint g_sz = roots->sz; + + roots++; + while (g_sz--) { + gval = *g_ptr; + + switch (primary_tag(gval)) { + case TAG_PRIMARY_BOXED: { + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *g_ptr++ = val; + } else if (in_area(ptr, src, src_size)) { + MOVE_BOXED(ptr,val,htop,g_ptr++); + } else { + g_ptr++; + } + break; + } + case TAG_PRIMARY_LIST: { + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { /* Moved */ + *g_ptr++ = ptr[1]; + } else if (in_area(ptr, src, src_size)) { + MOVE_CONS(ptr,val,htop,g_ptr++); + } else { + g_ptr++; + } + break; + } + + default: + g_ptr++; + break; + } + } + } + return htop; +} + + +static Eterm* +sweep_one_area(Eterm* n_hp, Eterm* n_htop, char* src, Uint src_size) +{ + while (n_hp != n_htop) { + Eterm* ptr; + Eterm val; + Eterm gval = *n_hp; + + switch (primary_tag(gval)) { + case TAG_PRIMARY_BOXED: { + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *n_hp++ = val; + } else if (in_area(ptr, src, src_size)) { + MOVE_BOXED(ptr,val,n_htop,n_hp++); + } else { + n_hp++; + } + break; + } + case TAG_PRIMARY_LIST: { + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { + *n_hp++ = ptr[1]; + } else if (in_area(ptr, src, src_size)) { + MOVE_CONS(ptr,val,n_htop,n_hp++); + } else { + n_hp++; + } + break; + } + case TAG_PRIMARY_HEADER: { + if (!header_is_thing(gval)) { + n_hp++; + } else { + if (header_is_bin_matchstate(gval)) { + ErlBinMatchState *ms = (ErlBinMatchState*) n_hp; + ErlBinMatchBuffer *mb = &(ms->mb); + Eterm* origptr; + origptr = &(mb->orig); + ptr = boxed_val(*origptr); + val = *ptr; + if (IS_MOVED(val)) { + *origptr = val; + mb->base = binary_bytes(*origptr); + } else if (in_area(ptr, src, src_size)) { + MOVE_BOXED(ptr,val,n_htop,origptr); + mb->base = binary_bytes(*origptr); + } + } + n_hp += (thing_arityval(gval)+1); + } + break; + } + default: + n_hp++; + break; + } + } + return n_htop; +} + +static Eterm* +sweep_one_heap(Eterm* heap_ptr, Eterm* heap_end, Eterm* htop, char* src, Uint src_size) +{ + while (heap_ptr < heap_end) { + Eterm* ptr; + Eterm val; + Eterm gval = *heap_ptr; + + switch (primary_tag(gval)) { + case TAG_PRIMARY_BOXED: { + ptr = boxed_val(gval); + val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *heap_ptr++ = val; + } else if (in_area(ptr, src, src_size)) { + MOVE_BOXED(ptr,val,htop,heap_ptr++); + } else { + heap_ptr++; + } + break; + } + case TAG_PRIMARY_LIST: { + ptr = list_val(gval); + val = *ptr; + if (is_non_value(val)) { + *heap_ptr++ = ptr[1]; + } else if (in_area(ptr, src, src_size)) { + MOVE_CONS(ptr,val,htop,heap_ptr++); + } else { + heap_ptr++; + } + break; + } + case TAG_PRIMARY_HEADER: { + if (!header_is_thing(gval)) { + heap_ptr++; + } else { + heap_ptr += (thing_arityval(gval)+1); + } + break; + } + default: + heap_ptr++; + break; + } + } + return htop; +} + +/* + * Collect heap fragments and check that they point in the correct direction. + */ + +static Eterm* +collect_heap_frags(Process* p, Eterm* n_hstart, Eterm* n_htop, + Eterm* objv, int nobj) +{ + ErlHeapFragment* qb; + char* frag_begin; + Uint frag_size; + ErlMessage* mp; + + /* + * We don't allow references to a heap fragments from the stack, heap, + * or process dictionary. + */ +#ifdef HARDDEBUG + disallow_heap_frag_ref(p, n_htop, p->stop, STACK_START(p) - p->stop); + if (p->dictionary != NULL) { + disallow_heap_frag_ref(p, n_htop, p->dictionary->data, p->dictionary->used); + } + disallow_heap_frag_ref_in_heap(p); +#endif + + /* + * Go through the subset of the root set that is allowed to + * reference data in heap fragments and move data from heap fragments + * to our new heap. + */ + + if (nobj != 0) { + n_htop = collect_root_array(p, n_htop, objv, nobj); + } + if (is_not_immed(p->fvalue)) { + n_htop = collect_root_array(p, n_htop, &p->fvalue, 1); + } + if (is_not_immed(p->ftrace)) { + n_htop = collect_root_array(p, n_htop, &p->ftrace, 1); + } + if (is_not_immed(p->seq_trace_token)) { + n_htop = collect_root_array(p, n_htop, &p->seq_trace_token, 1); + } + if (is_not_immed(p->group_leader)) { + n_htop = collect_root_array(p, n_htop, &p->group_leader, 1); + } + + /* + * Go through the message queue, move everything that is in one of the + * heap fragments to our new heap. + */ + + for (mp = p->msg.first; mp != NULL; mp = mp->next) { + /* + * In most cases, mp->data.attached points to a heap fragment which is + * self-contained and we will copy it to the heap at the + * end of the GC to avoid scanning it. + * + * In a few cases, however, such as in process_info(Pid, messages) + * and trace_delivered/1, a new message points to a term that has + * been allocated by HAlloc() and mp->data.attached is NULL. Therefore + * we need this loop. + */ + if (mp->data.attached == NULL) { + n_htop = collect_root_array(p, n_htop, mp->m, 2); + } + } + + /* + * Now all references in the root set point to the new heap. However, + * many references on the new heap point to heap fragments. + */ + + qb = MBUF(p); + while (qb != NULL) { + frag_begin = (char *) qb->mem; + frag_size = qb->size * sizeof(Eterm); + if (frag_size != 0) { + n_htop = sweep_one_area(n_hstart, n_htop, frag_begin, frag_size); + } + qb = qb->next; + } + return n_htop; +} + +static Uint +setup_rootset(Process *p, Eterm *objv, int nobj, Rootset *rootset) +{ + Uint avail; + Roots* roots; + ErlMessage* mp; + Uint n; + + n = 0; + roots = rootset->roots = rootset->def; + rootset->size = ALENGTH(rootset->def); + + roots[n].v = p->stop; + roots[n].sz = STACK_START(p) - p->stop; + ++n; + + if (p->dictionary != NULL) { + roots[n].v = p->dictionary->data; + roots[n].sz = p->dictionary->used; + ++n; + } + if (nobj > 0) { + roots[n].v = objv; + roots[n].sz = nobj; + ++n; + } + + ASSERT((is_nil(p->seq_trace_token) || + is_tuple(p->seq_trace_token) || + is_atom(p->seq_trace_token))); + if (is_not_immed(p->seq_trace_token)) { + roots[n].v = &p->seq_trace_token; + roots[n].sz = 1; + n++; + } + + ASSERT(is_nil(p->tracer_proc) || + is_internal_pid(p->tracer_proc) || + is_internal_port(p->tracer_proc)); + + ASSERT(is_pid(p->group_leader)); + if (is_not_immed(p->group_leader)) { + roots[n].v = &p->group_leader; + roots[n].sz = 1; + n++; + } + + /* + * The process may be garbage-collected while it is terminating. + * (fvalue contains the EXIT reason and ftrace the saved stack trace.) + */ + if (is_not_immed(p->fvalue)) { + roots[n].v = &p->fvalue; + roots[n].sz = 1; + n++; + } + if (is_not_immed(p->ftrace)) { + roots[n].v = &p->ftrace; + roots[n].sz = 1; + n++; + } + ASSERT(n <= rootset->size); + + mp = p->msg.first; + avail = rootset->size - n; + while (mp != NULL) { + if (avail == 0) { + Uint new_size = 2*rootset->size; + if (roots == rootset->def) { + roots = erts_alloc(ERTS_ALC_T_ROOTSET, + new_size*sizeof(Roots)); + sys_memcpy(roots, rootset->def, sizeof(rootset->def)); + } else { + roots = erts_realloc(ERTS_ALC_T_ROOTSET, + (void *) roots, + new_size*sizeof(Roots)); + } + rootset->size = new_size; + avail = new_size - n; + } + if (mp->data.attached == NULL) { + roots[n].v = mp->m; + roots[n].sz = 2; + n++; + avail--; + } + mp = mp->next; + } + rootset->roots = roots; + rootset->num_roots = n; + return n; +} + +static +void cleanup_rootset(Rootset* rootset) +{ + if (rootset->roots != rootset->def) { + erts_free(ERTS_ALC_T_ROOTSET, rootset->roots); + } +} + +static void +grow_new_heap(Process *p, Uint new_sz, Eterm* objv, int nobj) +{ + Eterm* new_heap; + int heap_size = HEAP_TOP(p) - HEAP_START(p); + int stack_size = p->hend - p->stop; + Sint offs; + + ASSERT(HEAP_SIZE(p) < new_sz); + new_heap = (Eterm *) ERTS_HEAP_REALLOC(ERTS_ALC_T_HEAP, + (void *) HEAP_START(p), + sizeof(Eterm)*(HEAP_SIZE(p)), + sizeof(Eterm)*new_sz); + + if ((offs = new_heap - HEAP_START(p)) == 0) { /* No move. */ + HEAP_END(p) = new_heap + new_sz; + sys_memmove(p->hend - stack_size, p->stop, stack_size * sizeof(Eterm)); + p->stop = p->hend - stack_size; + } else { + char* area = (char *) HEAP_START(p); + Uint area_size = (char *) HEAP_TOP(p) - area; + Eterm* prev_stop = p->stop; + + offset_heap(new_heap, heap_size, offs, area, area_size); + + HIGH_WATER(p) = new_heap + (HIGH_WATER(p) - HEAP_START(p)); + + HEAP_END(p) = new_heap + new_sz; + prev_stop = new_heap + (p->stop - p->heap); + p->stop = p->hend - stack_size; + sys_memmove(p->stop, prev_stop, stack_size * sizeof(Eterm)); + + offset_rootset(p, offs, area, area_size, objv, nobj); + HEAP_TOP(p) = new_heap + heap_size; + HEAP_START(p) = new_heap; + } + HEAP_SIZE(p) = new_sz; +} + +static void +shrink_new_heap(Process *p, Uint new_sz, Eterm *objv, int nobj) +{ + Eterm* new_heap; + int heap_size = HEAP_TOP(p) - HEAP_START(p); + Sint offs; + + int stack_size = p->hend - p->stop; + + ASSERT(new_sz < p->heap_sz); + sys_memmove(p->heap + new_sz - stack_size, p->stop, stack_size * + sizeof(Eterm)); + new_heap = (Eterm *) ERTS_HEAP_REALLOC(ERTS_ALC_T_HEAP, + (void*)p->heap, + sizeof(Eterm)*(HEAP_SIZE(p)), + sizeof(Eterm)*new_sz); + p->hend = new_heap + new_sz; + p->stop = p->hend - stack_size; + + if ((offs = new_heap - HEAP_START(p)) != 0) { + char* area = (char *) HEAP_START(p); + Uint area_size = (char *) HEAP_TOP(p) - area; + + /* + * Normally, we don't expect a shrunk heap to move, but you never + * know on some strange embedded systems... Or when using purify. + */ + + offset_heap(new_heap, heap_size, offs, area, area_size); + + HIGH_WATER(p) = new_heap + (HIGH_WATER(p) - HEAP_START(p)); + offset_rootset(p, offs, area, area_size, objv, nobj); + HEAP_TOP(p) = new_heap + heap_size; + HEAP_START(p) = new_heap; + } + HEAP_SIZE(p) = new_sz; +} + +static Uint +next_vheap_size(Uint vheap, Uint vheap_sz) { + if (vheap < H_MIN_SIZE) { + return H_MIN_SIZE; + } + + /* grow */ + if (vheap > vheap_sz) { + return erts_next_heap_size(2*vheap, 0); + } + /* shrink */ + if ( vheap < vheap_sz/2) { + return (Uint)vheap_sz*3/4; + } + + return vheap_sz; +} + + +static void +sweep_proc_externals(Process *p, int fullsweep) +{ + ExternalThing** prev; + ExternalThing* ptr; + char* oh = 0; + Uint oh_size = 0; + + if (fullsweep == 0) { + oh = (char *) OLD_HEAP(p); + oh_size = (char *) OLD_HEND(p) - oh; + } + + prev = &MSO(p).externals; + ptr = MSO(p).externals; + + while (ptr) { + Eterm* ppt = (Eterm *) ptr; + + if (IS_MOVED(*ppt)) { /* Object is alive */ + ExternalThing* ro = external_thing_ptr(*ppt); + + *prev = ro; /* Patch to moved pos */ + prev = &ro->next; + ptr = ro->next; + } else if (in_area(ppt, oh, oh_size)) { + /* + * Object resides on old heap, and we just did a + * generational collection - keep object in list. + */ + prev = &ptr->next; + ptr = ptr->next; + } else { /* Object has not been moved - deref it */ + erts_deref_node_entry(ptr->node); + *prev = ptr = ptr->next; + } + } + ASSERT(*prev == NULL); +} + +static void +sweep_proc_funs(Process *p, int fullsweep) +{ + ErlFunThing** prev; + ErlFunThing* ptr; + char* oh = 0; + Uint oh_size = 0; + + if (fullsweep == 0) { + oh = (char *) OLD_HEAP(p); + oh_size = (char *) OLD_HEND(p) - oh; + } + + prev = &MSO(p).funs; + ptr = MSO(p).funs; + + while (ptr) { + Eterm* ppt = (Eterm *) ptr; + + if (IS_MOVED(*ppt)) { /* Object is alive */ + ErlFunThing* ro = (ErlFunThing *) fun_val(*ppt); + + *prev = ro; /* Patch to moved pos */ + prev = &ro->next; + ptr = ro->next; + } else if (in_area(ppt, oh, oh_size)) { + /* + * Object resides on old heap, and we just did a + * generational collection - keep object in list. + */ + prev = &ptr->next; + ptr = ptr->next; + } else { /* Object has not been moved - deref it */ + ErlFunEntry* fe = ptr->fe; + + *prev = ptr = ptr->next; + if (erts_refc_dectest(&fe->refc, 0) == 0) { + erts_erase_fun_entry(fe); + } + } + } + ASSERT(*prev == NULL); +} + +struct shrink_cand_data { + ProcBin* new_candidates; + ProcBin* new_candidates_end; + ProcBin* old_candidates; + Uint no_of_candidates; + Uint no_of_active; +}; + +static ERTS_INLINE void +link_live_proc_bin(struct shrink_cand_data *shrink, + ProcBin ***prevppp, + ProcBin **pbpp, + int new_heap) +{ + ProcBin *pbp = *pbpp; + + *pbpp = pbp->next; + + if (pbp->flags & (PB_ACTIVE_WRITER|PB_IS_WRITABLE)) { + ASSERT(((pbp->flags & (PB_ACTIVE_WRITER|PB_IS_WRITABLE)) + == (PB_ACTIVE_WRITER|PB_IS_WRITABLE)) + || ((pbp->flags & (PB_ACTIVE_WRITER|PB_IS_WRITABLE)) + == PB_IS_WRITABLE)); + + + if (pbp->flags & PB_ACTIVE_WRITER) { + pbp->flags &= ~PB_ACTIVE_WRITER; + shrink->no_of_active++; + } + else { /* inactive */ + Uint unused = pbp->val->orig_size - pbp->size; + /* Our allocators are 8 byte aligned, i.e., shrinking with + less than 8 bytes will have no real effect */ + if (unused >= 8) { /* A shrink candidate; save in candidate list */ + if (new_heap) { + if (!shrink->new_candidates) + shrink->new_candidates_end = pbp; + pbp->next = shrink->new_candidates; + shrink->new_candidates = pbp; + } + else { + pbp->next = shrink->old_candidates; + shrink->old_candidates = pbp; + } + shrink->no_of_candidates++; + return; + } + } + } + + /* Not a shrink candidate; keep in original mso list */ + **prevppp = pbp; + *prevppp = &pbp->next; + +} + + +static void +sweep_proc_bins(Process *p, int fullsweep) +{ + struct shrink_cand_data shrink = {0}; + ProcBin** prev; + ProcBin* ptr; + Binary* bptr; + char* oh = NULL; + Uint oh_size = 0; + Uint bin_vheap = 0; + + if (fullsweep == 0) { + oh = (char *) OLD_HEAP(p); + oh_size = (char *) OLD_HEND(p) - oh; + } + + BIN_OLD_VHEAP(p) = 0; + + prev = &MSO(p).mso; + ptr = MSO(p).mso; + + /* + * Note: In R7 we no longer force a fullsweep when we find binaries + * on the old heap. The reason is that with the introduction of the + * bit syntax we can expect binaries to be used a lot more. Note that + * in earlier releases a brand new binary (or any other term) could + * be put on the old heap during a gen-gc fullsweep, but this is + * no longer the case in R7. + */ + while (ptr) { + Eterm* ppt = (Eterm *) ptr; + + if (IS_MOVED(*ppt)) { /* Object is alive */ + bin_vheap += ptr->size / sizeof(Eterm); + ptr = (ProcBin*) binary_val(*ppt); + link_live_proc_bin(&shrink, + &prev, + &ptr, + !in_area(ptr, oh, oh_size)); + } else if (in_area(ppt, oh, oh_size)) { + /* + * Object resides on old heap, and we just did a + * generational collection - keep object in list. + */ + BIN_OLD_VHEAP(p) += ptr->size / sizeof(Eterm); /* for binary gc (words)*/ + link_live_proc_bin(&shrink, &prev, &ptr, 0); + } else { /* Object has not been moved - deref it */ + + *prev = ptr->next; + bptr = ptr->val; + if (erts_refc_dectest(&bptr->refc, 0) == 0) + erts_bin_free(bptr); + ptr = *prev; + } + } + + if (BIN_OLD_VHEAP(p) >= BIN_OLD_VHEAP_SZ(p)) { + FLAGS(p) |= F_NEED_FULLSWEEP; + } + + BIN_VHEAP_SZ(p) = next_vheap_size(bin_vheap, BIN_VHEAP_SZ(p)); + BIN_OLD_VHEAP_SZ(p) = next_vheap_size(BIN_OLD_VHEAP(p), BIN_OLD_VHEAP_SZ(p)); + MSO(p).overhead = bin_vheap; + + /* + * If we got any shrink candidates, check them out. + */ + + if (shrink.no_of_candidates) { + ProcBin *candlist[] = {shrink.new_candidates, shrink.old_candidates}; + Uint leave_unused = 0; + int i; + + if (shrink.no_of_active == 0) { + if (shrink.no_of_candidates <= ERTS_INACT_WR_PB_LEAVE_MUCH_LIMIT) + leave_unused = ERTS_INACT_WR_PB_LEAVE_MUCH_PERCENTAGE; + else if (shrink.no_of_candidates <= ERTS_INACT_WR_PB_LEAVE_LIMIT) + leave_unused = ERTS_INACT_WR_PB_LEAVE_PERCENTAGE; + } + + for (i = 0; i < sizeof(candlist)/sizeof(candlist[0]); i++) { + + for (ptr = candlist[i]; ptr; ptr = ptr->next) { + Uint new_size = ptr->size; + + if (leave_unused) { + new_size += (new_size * 100) / leave_unused; + /* Our allocators are 8 byte aligned, i.e., shrinking with + less than 8 bytes will have no real effect */ + if (new_size + 8 >= ptr->val->orig_size) + continue; + } + + ptr->val = erts_bin_realloc(ptr->val, new_size); + ptr->val->orig_size = new_size; + ptr->bytes = (byte *) ptr->val->orig_bytes; + } + } + + + /* + * We now potentially have the mso list divided into three lists: + * - shrink candidates on new heap (inactive writable with unused data) + * - shrink candidates on old heap (inactive writable with unused data) + * - other binaries (read only + active writable ...) + * + * Put them back together: new candidates -> other -> old candidates + * This order will ensure that the list only refers from new + * generation to old and never from old to new *which is important*. + */ + if (shrink.new_candidates) { + if (prev == &MSO(p).mso) /* empty other binaries list */ + prev = &shrink.new_candidates_end->next; + else + shrink.new_candidates_end->next = MSO(p).mso; + MSO(p).mso = shrink.new_candidates; + } + } + + *prev = shrink.old_candidates; +} + +/* + * Offset pointers into the heap (not stack). + */ + +static void +offset_heap(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) +{ + while (sz--) { + Eterm val = *hp; + switch (primary_tag(val)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + if (in_area(ptr_val(val), area, area_size)) { + *hp = offset_ptr(val, offs); + } + hp++; + break; + case TAG_PRIMARY_HEADER: { + Uint tari; + + if (header_is_transparent(val)) { + hp++; + continue; + } + tari = thing_arityval(val); + switch (thing_subtag(val)) { + case REFC_BINARY_SUBTAG: + { + ProcBin* pb = (ProcBin*) hp; + Eterm** uptr = (Eterm **) (void *) &pb->next; + + if (*uptr && in_area((Eterm *)pb->next, area, area_size)) { + *uptr += offs; /* Patch the mso chain */ + } + sz -= tari; + hp += tari + 1; + } + break; + case BIN_MATCHSTATE_SUBTAG: + { + ErlBinMatchState *ms = (ErlBinMatchState*) hp; + ErlBinMatchBuffer *mb = &(ms->mb); + if (in_area(ptr_val(mb->orig), area, area_size)) { + mb->orig = offset_ptr(mb->orig, offs); + mb->base = binary_bytes(mb->orig); + } + sz -= tari; + hp += tari + 1; + } + break; + case FUN_SUBTAG: + { + ErlFunThing* funp = (ErlFunThing *) hp; + Eterm** uptr = (Eterm **) (void *) &funp->next; + + if (*uptr && in_area((Eterm *)funp->next, area, area_size)) { + *uptr += offs; + } + sz -= tari; + hp += tari + 1; + } + break; + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: + { + ExternalThing* etp = (ExternalThing *) hp; + Eterm** uptr = (Eterm **) (void *) &etp->next; + + if (*uptr && in_area((Eterm *)etp->next, area, area_size)) { + *uptr += offs; + } + sz -= tari; + hp += tari + 1; + } + break; + default: + sz -= tari; + hp += tari + 1; + } + break; + } + default: + hp++; + continue; + } + } +} + +/* + * Offset pointers to heap from stack. + */ + +static void +offset_heap_ptr(Eterm* hp, Uint sz, Sint offs, char* area, Uint area_size) +{ + while (sz--) { + Eterm val = *hp; + switch (primary_tag(val)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + if (in_area(ptr_val(val), area, area_size)) { + *hp = offset_ptr(val, offs); + } + hp++; + break; + default: + hp++; + break; + } + } +} + +static void +offset_off_heap(Process* p, Sint offs, char* area, Uint area_size) +{ + if (MSO(p).mso && in_area((Eterm *)MSO(p).mso, area, area_size)) { + Eterm** uptr = (Eterm**) (void *) &MSO(p).mso; + *uptr += offs; + } + + if (MSO(p).funs && in_area((Eterm *)MSO(p).funs, area, area_size)) { + Eterm** uptr = (Eterm**) (void *) &MSO(p).funs; + *uptr += offs; + } + + if (MSO(p).externals && in_area((Eterm *)MSO(p).externals, area, area_size)) { + Eterm** uptr = (Eterm**) (void *) &MSO(p).externals; + *uptr += offs; + } +} + +/* + * Offset pointers in message queue. + */ +static void +offset_mqueue(Process *p, Sint offs, char* area, Uint area_size) +{ + ErlMessage* mp = p->msg.first; + + while (mp != NULL) { + Eterm mesg = ERL_MESSAGE_TERM(mp); + if (is_value(mesg)) { + switch (primary_tag(mesg)) { + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + if (in_area(ptr_val(mesg), area, area_size)) { + ERL_MESSAGE_TERM(mp) = offset_ptr(mesg, offs); + } + break; + } + } + mesg = ERL_MESSAGE_TOKEN(mp); + if (is_boxed(mesg) && in_area(ptr_val(mesg), area, area_size)) { + ERL_MESSAGE_TOKEN(mp) = offset_ptr(mesg, offs); + } + ASSERT((is_nil(ERL_MESSAGE_TOKEN(mp)) || + is_tuple(ERL_MESSAGE_TOKEN(mp)) || + is_atom(ERL_MESSAGE_TOKEN(mp)))); + mp = mp->next; + } +} + +static void ERTS_INLINE +offset_one_rootset(Process *p, Sint offs, char* area, Uint area_size, + Eterm* objv, int nobj) +{ + if (p->dictionary) { + offset_heap(p->dictionary->data, + p->dictionary->used, + offs, area, area_size); + } + offset_heap_ptr(&p->fvalue, 1, offs, area, area_size); + offset_heap_ptr(&p->ftrace, 1, offs, area, area_size); + offset_heap_ptr(&p->seq_trace_token, 1, offs, area, area_size); + offset_heap_ptr(&p->group_leader, 1, offs, area, area_size); + offset_mqueue(p, offs, area, area_size); + offset_heap_ptr(p->stop, (STACK_START(p) - p->stop), offs, area, area_size); + offset_nstack(p, offs, area, area_size); + if (nobj > 0) { + offset_heap_ptr(objv, nobj, offs, area, area_size); + } + offset_off_heap(p, offs, area, area_size); +} + +static void +offset_rootset(Process *p, Sint offs, char* area, Uint area_size, + Eterm* objv, int nobj) +{ + offset_one_rootset(p, offs, area, area_size, objv, nobj); +} + +#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) + +static int +within2(Eterm *ptr, Process *p, Eterm *real_htop) +{ + ErlHeapFragment* bp = MBUF(p); + ErlMessage* mp = p->msg.first; + Eterm *htop = real_htop ? real_htop : HEAP_TOP(p); + + if (OLD_HEAP(p) && (OLD_HEAP(p) <= ptr && ptr < OLD_HEND(p))) { + return 1; + } + if (HEAP_START(p) <= ptr && ptr < htop) { + return 1; + } + while (bp != NULL) { + if (bp->mem <= ptr && ptr < bp->mem + bp->size) { + return 1; + } + bp = bp->next; + } + while (mp) { + if (mp->data.attached) { + ErlHeapFragment *hfp; + if (is_value(ERL_MESSAGE_TERM(mp))) + hfp = mp->data.heap_frag; + else if (is_not_nil(ERL_MESSAGE_TOKEN(mp))) + hfp = erts_dist_ext_trailer(mp->data.dist_ext); + else + hfp = NULL; + if (hfp && hfp->mem <= ptr && ptr < hfp->mem + hfp->size) + return 1; + } + mp = mp->next; + } + return 0; +} + +int +within(Eterm *ptr, Process *p) +{ + return within2(ptr, p, NULL); +} + +#endif + +#ifdef ERTS_OFFHEAP_DEBUG + +#define ERTS_CHK_OFFHEAP_ASSERT(EXP) \ +do { \ + if (!(EXP)) \ + erl_exit(ERTS_ABORT_EXIT, \ + "%s:%d: Assertion failed: %s\n", \ + __FILE__, __LINE__, #EXP); \ +} while (0) + +#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_EXTERNAL_LIST +# define ERTS_EXTERNAL_VISITED_BIT ((Eterm) 1 << 31) +#endif + + +void +erts_check_off_heap2(Process *p, Eterm *htop) +{ + Eterm *oheap = (Eterm *) OLD_HEAP(p); + Eterm *ohtop = (Eterm *) OLD_HTOP(p); + int old; + ProcBin *pb; + ErlFunThing *eft; + ExternalThing *et; + + old = 0; + for (pb = MSO(p).mso; pb; pb = pb->next) { + Eterm *ptr = (Eterm *) pb; + long refc = erts_refc_read(&pb->val->refc, 1); + ERTS_CHK_OFFHEAP_ASSERT(refc >= 1); + if (old) { + ERTS_CHK_OFFHEAP_ASSERT(oheap <= ptr && ptr < ohtop); + } + else if (oheap <= ptr && ptr < ohtop) + old = 1; + else { + ERTS_CHK_OFFHEAP_ASSERT(within2(ptr, p, htop)); + } + } + + old = 0; + for (eft = MSO(p).funs; eft; eft = eft->next) { + Eterm *ptr = (Eterm *) eft; + long refc = erts_refc_read(&eft->fe->refc, 1); + ERTS_CHK_OFFHEAP_ASSERT(refc >= 1); + if (old) + ERTS_CHK_OFFHEAP_ASSERT(oheap <= ptr && ptr < ohtop); + else if (oheap <= ptr && ptr < ohtop) + old = 1; + else + ERTS_CHK_OFFHEAP_ASSERT(within2(ptr, p, htop)); + } + + old = 0; + for (et = MSO(p).externals; et; et = et->next) { + Eterm *ptr = (Eterm *) et; + long refc = erts_refc_read(&et->node->refc, 1); + ERTS_CHK_OFFHEAP_ASSERT(refc >= 1); +#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_EXTERNAL_LIST + ERTS_CHK_OFFHEAP_ASSERT(!(et->header & ERTS_EXTERNAL_VISITED_BIT)); +#endif + if (old) + ERTS_CHK_OFFHEAP_ASSERT(oheap <= ptr && ptr < ohtop); + else if (oheap <= ptr && ptr < ohtop) + old = 1; + else + ERTS_CHK_OFFHEAP_ASSERT(within2(ptr, p, htop)); +#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_EXTERNAL_LIST + et->header |= ERTS_EXTERNAL_VISITED_BIT; +#endif + } + +#ifdef ERTS_OFFHEAP_DEBUG_CHK_CIRCULAR_EXTERNAL_LIST + for (et = MSO(p).externals; et; et = et->next) + et->header &= ~ERTS_EXTERNAL_VISITED_BIT; +#endif + +} + +void +erts_check_off_heap(Process *p) +{ + erts_check_off_heap2(p, NULL); +} + +#endif diff --git a/erts/emulator/beam/erl_gc.h b/erts/emulator/beam/erl_gc.h new file mode 100644 index 0000000000..af55b6363f --- /dev/null +++ b/erts/emulator/beam/erl_gc.h @@ -0,0 +1,72 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERL_GC_H__ +#define __ERL_GC_H__ + +/* GC declarations shared by beam/erl_gc.c and hipe/hipe_gc.c */ + +#ifdef DEBUG +# define HARDDEBUG 1 +#endif + +#define IS_MOVED(x) (!is_header((x))) + +#define MOVE_CONS(PTR,CAR,HTOP,ORIG) \ +do { \ + Eterm gval; \ + \ + HTOP[0] = CAR; /* copy car */ \ + HTOP[1] = PTR[1]; /* copy cdr */ \ + gval = make_list(HTOP); /* new location */ \ + *ORIG = gval; /* redirect original reference */ \ + PTR[0] = THE_NON_VALUE; /* store forwarding indicator */ \ + PTR[1] = gval; /* store forwarding address */ \ + HTOP += 2; /* update tospace htop */ \ +} while(0) + +#define MOVE_BOXED(PTR,HDR,HTOP,ORIG) \ +do { \ + Eterm gval; \ + Sint nelts; \ + \ + ASSERT(is_header(HDR)); \ + gval = make_boxed(HTOP); \ + *ORIG = gval; \ + *HTOP++ = HDR; \ + *PTR++ = gval; \ + nelts = header_arity(HDR); \ + switch ((HDR) & _HEADER_SUBTAG_MASK) { \ + case SUB_BINARY_SUBTAG: nelts++; break; \ + case FUN_SUBTAG: nelts+=((ErlFunThing*)(PTR-1))->num_free+1; break; \ + } \ + while (nelts--) \ + *HTOP++ = *PTR++; \ +} while(0) + +#define in_area(ptr,start,nbytes) \ + ((unsigned long)((char*)(ptr) - (char*)(start)) < (nbytes)) + +extern Uint erts_test_long_gc_sleep; + +#if defined(DEBUG) || defined(ERTS_OFFHEAP_DEBUG) +int within(Eterm *ptr, Process *p); +#endif + +#endif /* __ERL_GC_H__ */ diff --git a/erts/emulator/beam/erl_goodfit_alloc.c b/erts/emulator/beam/erl_goodfit_alloc.c new file mode 100644 index 0000000000..ea2ba4d55c --- /dev/null +++ b/erts/emulator/beam/erl_goodfit_alloc.c @@ -0,0 +1,662 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: A "good fit" allocator. Segregated free-lists with a + * maximum search depth are used in order to find a good + * fit fast. Each free-list contains blocks of sizes in a + * specific range. First the free-list + * covering the desired size is searched if it is not empty. + * This search is stopped when the maximum search depth has + * been reached. If no free block was found in the free-list + * covering the desired size, the next non-empty free-list + * covering larger sizes is searched. The maximum search + * depth is by default 3. The insert and delete operations + * are O(1) and the search operation is O(n) where n is the + * maximum search depth, i.e. by default the all operations + * are O(1). + * + * This module is a callback-module for erl_alloc_util.c + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "global.h" +#define GET_ERL_GF_ALLOC_IMPL +#include "erl_goodfit_alloc.h" + +#define MIN_MBC_SZ (16*1024) +#define MIN_MBC_FIRST_FREE_SZ (4*1024) + +#define MAX_SUB_MASK_IX \ + ((((Uint)1) << (NO_OF_BKT_IX_BITS - SUB_MASK_IX_SHIFT)) - 1) +#define MAX_SUB_BKT_IX ((((Uint)1) << SUB_MASK_IX_SHIFT) - 1) +#define MAX_BKT_IX (NO_OF_BKTS - 1) + +#define MIN_BLK_SZ UNIT_CEILING(sizeof(GFFreeBlock_t) + sizeof(Uint)) + +#define IX2SBIX(IX) ((IX) & (~(~((Uint)0) << SUB_MASK_IX_SHIFT))) +#define IX2SMIX(IX) ((IX) >> SUB_MASK_IX_SHIFT) +#define MAKE_BKT_IX(SMIX, SBIX) \ + ((((Uint)(SMIX)) << SUB_MASK_IX_SHIFT) | ((Uint)(SBIX))) + +#define SET_BKT_MASK_IX(BM, IX) \ +do { \ + int sub_mask_ix__ = IX2SMIX((IX)); \ + (BM).main |= (((Uint) 1) << sub_mask_ix__); \ + (BM).sub[sub_mask_ix__] |= (((Uint)1) << IX2SBIX((IX))); \ +} while (0) + +#define UNSET_BKT_MASK_IX(BM, IX) \ +do { \ + int sub_mask_ix__ = IX2SMIX((IX)); \ + (BM).sub[sub_mask_ix__] &= ~(((Uint)1) << IX2SBIX((IX))); \ + if (!(BM).sub[sub_mask_ix__]) \ + (BM).main &= ~(((Uint)1) << sub_mask_ix__); \ +} while (0) + +/* Buckets ... */ + +#define BKT_INTRVL_A (1*sizeof(Unit_t)) +#define BKT_INTRVL_B (16*sizeof(Unit_t)) +#define BKT_INTRVL_C (96*sizeof(Unit_t)) + +#define BKT_MIN_SIZE_A MIN_BLK_SZ +#define BKT_MIN_SIZE_B (BKT_MAX_SIZE_A + 1) +#define BKT_MIN_SIZE_C (BKT_MAX_SIZE_B + 1) +#define BKT_MIN_SIZE_D (BKT_MAX_SIZE_C + 1) + +#define BKT_MAX_SIZE_A ((NO_OF_BKTS/4)*BKT_INTRVL_A+BKT_MIN_SIZE_A-1) +#define BKT_MAX_SIZE_B ((NO_OF_BKTS/4)*BKT_INTRVL_B+BKT_MIN_SIZE_B-1) +#define BKT_MAX_SIZE_C ((NO_OF_BKTS/4)*BKT_INTRVL_C+BKT_MIN_SIZE_C-1) + + +#define BKT_MAX_IX_A ((NO_OF_BKTS*1)/4 - 1) +#define BKT_MAX_IX_B ((NO_OF_BKTS*2)/4 - 1) +#define BKT_MAX_IX_C ((NO_OF_BKTS*3)/4 - 1) +#define BKT_MAX_IX_D ((NO_OF_BKTS*4)/4 - 1) + +#define BKT_MIN_IX_A (0) +#define BKT_MIN_IX_B (BKT_MAX_IX_A + 1) +#define BKT_MIN_IX_C (BKT_MAX_IX_B + 1) +#define BKT_MIN_IX_D (BKT_MAX_IX_C + 1) + + +#define BKT_IX_(BAP, SZ) \ + ((SZ) <= BKT_MAX_SIZE_A \ + ? (((SZ) - BKT_MIN_SIZE_A)/BKT_INTRVL_A + BKT_MIN_IX_A) \ + : ((SZ) <= BKT_MAX_SIZE_B \ + ? (((SZ) - BKT_MIN_SIZE_B)/BKT_INTRVL_B + BKT_MIN_IX_B) \ + : ((SZ) <= BKT_MAX_SIZE_C \ + ? (((SZ) - BKT_MIN_SIZE_C)/BKT_INTRVL_C + BKT_MIN_IX_C) \ + : ((SZ) <= (BAP)->bkt_max_size_d \ + ? (((SZ) - BKT_MIN_SIZE_D)/(BAP)->bkt_intrvl_d + BKT_MIN_IX_D)\ + : (NO_OF_BKTS - 1))))) + +#define BKT_MIN_SZ_(BAP, IX) \ + ((IX) <= BKT_MAX_IX_A \ + ? (((IX) - BKT_MIN_IX_A)*BKT_INTRVL_A + BKT_MIN_SIZE_A) \ + : ((IX) <= BKT_MAX_IX_B \ + ? (((IX) - BKT_MIN_IX_B)*BKT_INTRVL_B + BKT_MIN_SIZE_B) \ + : ((IX) <= BKT_MAX_IX_C \ + ? (((IX) - BKT_MIN_IX_C)*BKT_INTRVL_C + BKT_MIN_SIZE_C) \ + : (((IX) - BKT_MIN_IX_D)*(BAP)->bkt_intrvl_d + BKT_MIN_SIZE_D)))) + +#ifdef DEBUG + +static int +BKT_IX(GFAllctr_t *gfallctr, Uint size) +{ + int ix; + ASSERT(size >= MIN_BLK_SZ); + + ix = BKT_IX_(gfallctr, size); + + ASSERT(0 <= ix && ix <= BKT_MAX_IX_D); + + return ix; +} + +static Uint +BKT_MIN_SZ(GFAllctr_t *gfallctr, int ix) +{ + Uint size; + ASSERT(0 <= ix && ix <= BKT_MAX_IX_D); + + size = BKT_MIN_SZ_(gfallctr, ix); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + ASSERT(ix == BKT_IX(gfallctr, size)); + ASSERT(size == MIN_BLK_SZ || ix - 1 == BKT_IX(gfallctr, size - 1)); +#endif + + return size; +} + +#else + +#define BKT_IX BKT_IX_ +#define BKT_MIN_SZ BKT_MIN_SZ_ + +#endif + + +/* Prototypes of callback functions */ +static Block_t * get_free_block (Allctr_t *, Uint, + Block_t *, Uint); +static void link_free_block (Allctr_t *, Block_t *); +static void unlink_free_block (Allctr_t *, Block_t *); +static void update_last_aux_mbc (Allctr_t *, Carrier_t *); +static Eterm info_options (Allctr_t *, char *, int *, + void *, Uint **, Uint *); +static void init_atoms (void); + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG +static void check_block (Allctr_t *, Block_t *, int); +static void check_mbc (Allctr_t *, Carrier_t *); +#endif + +static int atoms_initialized = 0; + +void +erts_gfalc_init(void) +{ + atoms_initialized = 0; +} + + +Allctr_t * +erts_gfalc_start(GFAllctr_t *gfallctr, + GFAllctrInit_t *gfinit, + AllctrInit_t *init) +{ + GFAllctr_t nulled_state = {{0}}; + /* {{0}} is used instead of {0}, in order to avoid (an incorrect) gcc + warning. gcc warns if {0} is used as initializer of a struct when + the first member is a struct (not if, for example, the third member + is a struct). */ + Allctr_t *allctr = (Allctr_t *) gfallctr; + + sys_memcpy((void *) gfallctr, (void *) &nulled_state, sizeof(GFAllctr_t)); + + allctr->mbc_header_size = sizeof(Carrier_t); + allctr->min_mbc_size = MIN_MBC_SZ; + allctr->min_mbc_first_free_size = MIN_MBC_FIRST_FREE_SZ; + allctr->min_block_size = sizeof(GFFreeBlock_t); + + + allctr->vsn_str = ERTS_ALC_GF_ALLOC_VSN_STR; + + /* Callback functions */ + + allctr->get_free_block = get_free_block; + allctr->link_free_block = link_free_block; + allctr->unlink_free_block = unlink_free_block; + allctr->info_options = info_options; + + allctr->get_next_mbc_size = NULL; + allctr->creating_mbc = update_last_aux_mbc; + allctr->destroying_mbc = update_last_aux_mbc; + + allctr->init_atoms = init_atoms; + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG + allctr->check_block = check_block; + allctr->check_mbc = check_mbc; +#endif + + allctr->atoms_initialized = 0; + + if (init->sbct > BKT_MIN_SIZE_D-1) + gfallctr->bkt_intrvl_d = + UNIT_CEILING(((3*(init->sbct - BKT_MIN_SIZE_D - 1) + /(NO_OF_BKTS/4 - 1)) + 1) + / 2); + if (gfallctr->bkt_intrvl_d < BKT_INTRVL_C) + gfallctr->bkt_intrvl_d = BKT_INTRVL_C; + gfallctr->bkt_max_size_d = ((NO_OF_BKTS/4)*gfallctr->bkt_intrvl_d + + BKT_MIN_SIZE_D + - 1); + + gfallctr->max_blk_search = (Uint) MAX(1, gfinit->mbsd); + + if (!erts_alcu_start(allctr, init)) + return NULL; + + if (allctr->min_block_size != MIN_BLK_SZ) + return NULL; + + return allctr; +} + +static int +find_bucket(BucketMask_t *bmask, int min_index) +{ + int min, mid, max; + int sub_mask_ix, sub_bkt_ix; + int ix = -1; + +#undef GET_MIN_BIT +#define GET_MIN_BIT(MinBit, BitMask, Min, Max) \ + min = (Min); \ + max = (Max); \ + while(max != min) { \ + mid = ((max - min) >> 1) + min; \ + if((BitMask) \ + & (~(~((Uint) 0) << (mid + 1))) \ + & (~((Uint) 0) << min)) \ + max = mid; \ + else \ + min = mid + 1; \ + } \ + (MinBit) = min + + + ASSERT(bmask->main < (((Uint) 1) << (MAX_SUB_MASK_IX+1))); + + sub_mask_ix = IX2SMIX(min_index); + + if ((bmask->main & (~((Uint) 0) << sub_mask_ix)) == 0) + return -1; + + /* There exists a non empty bucket; find it... */ + + if (bmask->main & (((Uint) 1) << sub_mask_ix)) { + sub_bkt_ix = IX2SBIX(min_index); + if ((bmask->sub[sub_mask_ix] & (~((Uint) 0) << sub_bkt_ix)) == 0) { + sub_mask_ix++; + sub_bkt_ix = 0; + if ((bmask->main & (~((Uint) 0)<< sub_mask_ix)) == 0) + return -1; + } + else + goto find_sub_bkt_ix; + } + else { + sub_mask_ix++; + sub_bkt_ix = 0; + } + + ASSERT(sub_mask_ix <= MAX_SUB_MASK_IX); + /* Has to be a bit > sub_mask_ix */ + ASSERT(bmask->main & (~((Uint) 0) << (sub_mask_ix))); + GET_MIN_BIT(sub_mask_ix, bmask->main, sub_mask_ix, MAX_SUB_MASK_IX); + + find_sub_bkt_ix: + ASSERT(sub_mask_ix <= MAX_SUB_MASK_IX); + ASSERT(sub_bkt_ix <= MAX_SUB_BKT_IX); + + if ((bmask->sub[sub_mask_ix] & (((Uint) 1) << sub_bkt_ix)) == 0) { + ASSERT(sub_mask_ix + 1 <= MAX_SUB_BKT_IX); + /* Has to be a bit > sub_bkt_ix */ + ASSERT(bmask->sub[sub_mask_ix] & (~((Uint) 0) << sub_bkt_ix)); + + GET_MIN_BIT(sub_bkt_ix, + bmask->sub[sub_mask_ix], + sub_bkt_ix+1, + MAX_SUB_BKT_IX); + + ASSERT(sub_bkt_ix <= MAX_SUB_BKT_IX); + } + + ix = MAKE_BKT_IX(sub_mask_ix, sub_bkt_ix); + + ASSERT(0 <= ix && ix < NO_OF_BKTS); + + return ix; + +#undef GET_MIN_BIT + +} + +static Block_t * +search_bucket(Allctr_t *allctr, int ix, Uint size) +{ + int i; + Uint min_sz; + Uint blk_sz; + Uint cand_sz = 0; + Uint max_blk_search; + GFFreeBlock_t *blk; + GFFreeBlock_t *cand = NULL; + int blk_on_lambc; + int cand_on_lambc = 0; + GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; + + ASSERT(0 <= ix && ix <= NO_OF_BKTS - 1); + + if (!gfallctr->buckets[ix]) + return NULL; + + min_sz = BKT_MIN_SZ(gfallctr, ix); + if (min_sz < size) + min_sz = size; + + max_blk_search = gfallctr->max_blk_search; + for (blk = gfallctr->buckets[ix], i = 0; + blk && i < max_blk_search; + blk = blk->next, i++) { + + blk_sz = BLK_SZ(blk); + blk_on_lambc = (((char *) blk) < gfallctr->last_aux_mbc_end + && gfallctr->last_aux_mbc_start <= ((char *) blk)); + + if (blk_sz == min_sz && !blk_on_lambc) + return (Block_t *) blk; + + if (blk_sz >= min_sz + && (!cand + || (!blk_on_lambc && (cand_on_lambc || blk_sz < cand_sz)) + || (blk_on_lambc && cand_on_lambc && blk_sz < cand_sz))) { + cand_sz = blk_sz; + cand = blk; + cand_on_lambc = blk_on_lambc; + } + + } + return (Block_t *) cand; +} + +static Block_t * +get_free_block(Allctr_t *allctr, Uint size, + Block_t *cand_blk, Uint cand_size) +{ + GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; + int unsafe_bi, min_bi; + Block_t *blk; + + ASSERT(!cand_blk || cand_size >= size); + + unsafe_bi = BKT_IX(gfallctr, size); + + min_bi = find_bucket(&gfallctr->bucket_mask, unsafe_bi); + if (min_bi < 0) + return NULL; + + if (min_bi == unsafe_bi) { + blk = search_bucket(allctr, min_bi, size); + if (blk) { + if (cand_blk && cand_size <= BLK_SZ(blk)) + return NULL; /* cand_blk was better */ + unlink_free_block(allctr, blk); + return blk; + } + if (min_bi < NO_OF_BKTS - 1) { + min_bi = find_bucket(&gfallctr->bucket_mask, min_bi + 1); + if (min_bi < 0) + return NULL; + } + else + return NULL; + } + else { + ASSERT(min_bi > unsafe_bi); + } + + /* We are guaranteed to find a block that fits in this bucket */ + blk = search_bucket(allctr, min_bi, size); + ASSERT(blk); + if (cand_blk && cand_size <= BLK_SZ(blk)) + return NULL; /* cand_blk was better */ + unlink_free_block(allctr, blk); + return blk; +} + + + +static void +link_free_block(Allctr_t *allctr, Block_t *block) +{ + GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; + GFFreeBlock_t *blk = (GFFreeBlock_t *) block; + Uint sz = BLK_SZ(blk); + int i = BKT_IX(gfallctr, sz); + + ASSERT(sz >= MIN_BLK_SZ); + + SET_BKT_MASK_IX(gfallctr->bucket_mask, i); + + blk->prev = NULL; + blk->next = gfallctr->buckets[i]; + if (blk->next) { + ASSERT(!blk->next->prev); + blk->next->prev = blk; + } + gfallctr->buckets[i] = blk; +} + +static void +unlink_free_block(Allctr_t *allctr, Block_t *block) +{ + GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; + GFFreeBlock_t *blk = (GFFreeBlock_t *) block; + Uint sz = BLK_SZ(blk); + int i = BKT_IX(gfallctr, sz); + + if (!blk->prev) { + ASSERT(gfallctr->buckets[i] == blk); + gfallctr->buckets[i] = blk->next; + } + else + blk->prev->next = blk->next; + if (blk->next) + blk->next->prev = blk->prev; + + if (!gfallctr->buckets[i]) + UNSET_BKT_MASK_IX(gfallctr->bucket_mask, i); +} + +static void +update_last_aux_mbc(Allctr_t *allctr, Carrier_t *mbc) +{ + GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; + + if (gfallctr->last_aux_mbc_start != (char *) allctr->mbc_list.last) { + + if (allctr->mbc_list.last + && allctr->main_carrier != allctr->mbc_list.last) { + gfallctr->last_aux_mbc_start = (char *) allctr->mbc_list.last; + gfallctr->last_aux_mbc_end = (((char *) allctr->mbc_list.last) + + CARRIER_SZ(allctr->mbc_list.last)); + } + else { + gfallctr->last_aux_mbc_start = NULL; + gfallctr->last_aux_mbc_end = NULL; + } + + } +} + +static struct { + Eterm mbsd; + Eterm as; + Eterm gf; +#ifdef DEBUG + Eterm end_of_atoms; +#endif +} am; + +static void ERTS_INLINE atom_init(Eterm *atom, char *name) +{ + *atom = am_atom_put(name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static void +init_atoms(void) +{ +#ifdef DEBUG + Eterm *atom; +#endif + + if (atoms_initialized) + return; + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) { + *atom = THE_NON_VALUE; + } +#endif + + AM_INIT(mbsd); + AM_INIT(as); + AM_INIT(gf); + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { + ASSERT(*atom != THE_NON_VALUE); + } +#endif + + atoms_initialized = 1; +} + +#define bld_uint erts_bld_uint +#define bld_cons erts_bld_cons +#define bld_tuple erts_bld_tuple + +static ERTS_INLINE void +add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 2, el1, el2), *lp); +} + +static Eterm +info_options(Allctr_t *allctr, + char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + erts_print(*print_to_p, + print_to_arg, + "%smbsd: %lu\n" + "%sas: gf\n", + prefix, gfallctr->max_blk_search, + prefix); + } + + if (hpp || szp) { + + if (!atoms_initialized) + erl_exit(1, "%s:%d: Internal error: Atoms not initialized", + __FILE__, __LINE__);; + + res = NIL; + add_2tup(hpp, szp, &res, am.as, am.gf); + add_2tup(hpp, szp, &res, + am.mbsd, + bld_uint(hpp, szp, gfallctr->max_blk_search)); + } + + return res; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * NOTE: erts_gfalc_test() is only supposed to be used for testing. * + * * + * Keep alloc_SUITE_data/allocator_test.h updated if changes are made * + * to erts_gfalc_test() * +\* */ + +unsigned long +erts_gfalc_test(unsigned long op, unsigned long a1, unsigned long a2) +{ + switch (op) { + case 0x100: return (unsigned long) BKT_IX((GFAllctr_t *) a1, (Uint) a2); + case 0x101: return (unsigned long) BKT_MIN_SZ((GFAllctr_t *) a1, (int) a2); + case 0x102: return (unsigned long) NO_OF_BKTS; + case 0x103: return (unsigned long) + find_bucket(&((GFAllctr_t *) a1)->bucket_mask, (int) a2); + default: ASSERT(0); return ~((unsigned long) 0); + } +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Debug functions * +\* */ + +#ifdef ERTS_ALLOC_UTIL_HARD_DEBUG +void +check_block(Allctr_t *allctr, Block_t * blk, int free_block) +{ + GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; + int i; + int bi; + int found; + GFFreeBlock_t *fblk; + + if(free_block) { + Uint blk_sz = BLK_SZ(blk); + bi = BKT_IX(gfallctr, blk_sz); + + ASSERT(gfallctr->bucket_mask.main & (((Uint) 1) << IX2SMIX(bi))); + ASSERT(gfallctr->bucket_mask.sub[IX2SMIX(bi)] + & (((Uint) 1) << IX2SBIX(bi))); + + found = 0; + for (fblk = gfallctr->buckets[bi]; fblk; fblk = fblk->next) + if (blk == (Block_t *) fblk) + found++; + ASSERT(found == 1); + } + else + bi = -1; + + found = 0; + for (i = 0; i < NO_OF_BKTS; i++) { + if (i == bi) + continue; /* Already checked */ + for (fblk = gfallctr->buckets[i]; fblk; fblk = fblk->next) + if (blk == (Block_t *) fblk) + found++; + } + + ASSERT(found == 0); + +} + +void +check_mbc(Allctr_t *allctr, Carrier_t *mbc) +{ + GFAllctr_t *gfallctr = (GFAllctr_t *) allctr; + int bi; + + for(bi = 0; bi < NO_OF_BKTS; bi++) { + if ((gfallctr->bucket_mask.main & (((Uint) 1) << IX2SMIX(bi))) + && (gfallctr->bucket_mask.sub[IX2SMIX(bi)] + & (((Uint) 1) << IX2SBIX(bi)))) { + ASSERT(gfallctr->buckets[bi] != NULL); + } + else { + ASSERT(gfallctr->buckets[bi] == NULL); + } + } +} + +#endif diff --git a/erts/emulator/beam/erl_goodfit_alloc.h b/erts/emulator/beam/erl_goodfit_alloc.h new file mode 100644 index 0000000000..3d1b8c01f6 --- /dev/null +++ b/erts/emulator/beam/erl_goodfit_alloc.h @@ -0,0 +1,88 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +#ifndef ERL_GOODFIT_ALLOC__ +#define ERL_GOODFIT_ALLOC__ + +#include "erl_alloc_util.h" + +#define ERTS_ALC_GF_ALLOC_VSN_STR "2.1" + +typedef struct GFAllctr_t_ GFAllctr_t; + +typedef struct { + Uint mbsd; +} GFAllctrInit_t; + +#define ERTS_DEFAULT_GF_ALLCTR_INIT { \ + 3, /* (amount) mbsd: max (mbc) block search depth */\ +} + +void erts_gfalc_init(void); +Allctr_t *erts_gfalc_start(GFAllctr_t *, GFAllctrInit_t *, AllctrInit_t *); + +#endif /* #ifndef ERL_GOODFIT_ALLOC__ */ + + + +#if defined(GET_ERL_GF_ALLOC_IMPL) && !defined(ERL_GF_ALLOC_IMPL__) +#define ERL_GF_ALLOC_IMPL__ + +#define GET_ERL_ALLOC_UTIL_IMPL +#include "erl_alloc_util.h" + +#define NO_OF_BKT_IX_BITS (8) +#ifdef ARCH_64 +# define SUB_MASK_IX_SHIFT (6) +#else +# define SUB_MASK_IX_SHIFT (5) +#endif +#define NO_OF_BKTS (((Uint) 1) << NO_OF_BKT_IX_BITS) +#define NO_OF_SUB_MASKS (NO_OF_BKTS/(((Uint) 1) << SUB_MASK_IX_SHIFT)) + +typedef struct { + Uint main; + Uint sub[NO_OF_SUB_MASKS]; +} BucketMask_t; + +typedef struct GFFreeBlock_t_ GFFreeBlock_t; +struct GFFreeBlock_t_ { + Block_t block_head; + GFFreeBlock_t *prev; + GFFreeBlock_t *next; +}; + +struct GFAllctr_t_ { + Allctr_t allctr; /* Has to be first! */ + + char * last_aux_mbc_start; + char * last_aux_mbc_end; + Uint bkt_max_size_d; + Uint bkt_intrvl_d; + BucketMask_t bucket_mask; + GFFreeBlock_t * buckets[NO_OF_BKTS]; + Uint max_blk_search; + +}; + +unsigned long erts_gfalc_test(unsigned long, unsigned long, unsigned long); + +#endif /* #if defined(GET_ERL_GF_ALLOC_IMPL) + && !defined(ERL_GF_ALLOC_IMPL__) */ diff --git a/erts/emulator/beam/erl_init.c b/erts/emulator/beam/erl_init.c new file mode 100644 index 0000000000..8afd349b85 --- /dev/null +++ b/erts/emulator/beam/erl_init.c @@ -0,0 +1,1461 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "erl_version.h" +#include "erl_db.h" +#include "beam_bp.h" +#include "erl_bits.h" +#include "erl_binary.h" +#include "dist.h" +#include "erl_mseg.h" +#include "erl_nmgc.h" +#include "erl_threads.h" +#include "erl_bif_timer.h" +#include "erl_instrument.h" +#include "erl_printf_term.h" +#include "erl_misc_utils.h" +#include "packet_parser.h" + +#ifdef HIPE +#include "hipe_mode_switch.h" /* for hipe_mode_switch_init() */ +#include "hipe_signal.h" /* for hipe_signal_init() */ +#endif + +#ifdef HAVE_SYS_RESOURCE_H +# include +#endif + +/* + * Note about VxWorks: All variables must be initialized by executable code, + * not by an initializer. Otherwise a new instance of the emulator will + * inherit previous values. + */ + +extern void erl_crash_dump_v(char *, int, char *, va_list); +#ifdef __WIN32__ +extern void ConNormalExit(void); +extern void ConWaitForExit(void); +#endif + +#define ERTS_MIN_COMPAT_REL 7 + +#ifdef ERTS_SMP +erts_smp_atomic_t erts_writing_erl_crash_dump; +#else +volatile int erts_writing_erl_crash_dump = 0; +#endif +int erts_initialized = 0; + +#if defined(USE_THREADS) && !defined(ERTS_SMP) +static erts_tid_t main_thread; +#endif + +erts_cpu_info_t *erts_cpuinfo; + +int erts_use_sender_punish; + +/* + * Configurable parameters. + */ + +Uint display_items; /* no of items to display in traces etc */ +Uint display_loads; /* print info about loaded modules */ +int H_MIN_SIZE; /* The minimum heap grain */ + +Uint32 erts_debug_flags; /* Debug flags. */ +#ifdef ERTS_OPCODE_COUNTER_SUPPORT +int count_instructions; +#endif +int erts_backtrace_depth; /* How many functions to show in a backtrace + * in error codes. + */ + +int erts_async_max_threads; /* number of threads for async support */ +int erts_async_thread_suggested_stack_size; +erts_smp_atomic_t erts_max_gen_gcs; + +Eterm erts_error_logger_warnings; /* What to map warning logs to, am_error, + am_info or am_warning, am_error is + the default for BC */ + +int erts_compat_rel; + +static int use_multi_run_queue; +static int no_schedulers; +static int no_schedulers_online; + +#ifdef DEBUG +Uint32 verbose; /* See erl_debug.h for information about verbose */ +#endif + +int erts_disable_tolerant_timeofday; /* Time correction can be disabled it is + * not and/or it is too slow. + */ + +int erts_modified_timing_level; + +int erts_no_crash_dump = 0; /* Use -d to suppress crash dump. */ + +/* + * Other global variables. + */ + +ErtsModifiedTimings erts_modified_timings[] = { + /* 0 */ {make_small(0), CONTEXT_REDS, INPUT_REDUCTIONS}, + /* 1 */ {make_small(0), 2*CONTEXT_REDS, 2*INPUT_REDUCTIONS}, + /* 2 */ {make_small(0), CONTEXT_REDS/2, INPUT_REDUCTIONS/2}, + /* 3 */ {make_small(0), 3*CONTEXT_REDS, 3*INPUT_REDUCTIONS}, + /* 4 */ {make_small(0), CONTEXT_REDS/3, 3*INPUT_REDUCTIONS}, + /* 5 */ {make_small(0), 4*CONTEXT_REDS, INPUT_REDUCTIONS/2}, + /* 6 */ {make_small(1), CONTEXT_REDS/4, 2*INPUT_REDUCTIONS}, + /* 7 */ {make_small(1), 5*CONTEXT_REDS, INPUT_REDUCTIONS/3}, + /* 8 */ {make_small(10), CONTEXT_REDS/5, 3*INPUT_REDUCTIONS}, + /* 9 */ {make_small(10), 6*CONTEXT_REDS, INPUT_REDUCTIONS/4} +}; + +#define ERTS_MODIFIED_TIMING_LEVELS \ + (sizeof(erts_modified_timings)/sizeof(ErtsModifiedTimings)) + +Export *erts_delay_trap = NULL; + +int erts_use_r9_pids_ports; + +#ifdef HYBRID +Eterm *global_heap; +Eterm *global_hend; +Eterm *global_htop; +Eterm *global_saved_htop; +Eterm *global_old_heap; +Eterm *global_old_hend; +ErlOffHeap erts_global_offheap; +Uint global_heap_sz = SH_DEFAULT_SIZE; + +#ifndef INCREMENTAL +Eterm *global_high_water; +Eterm *global_old_htop; +#endif + +Uint16 global_gen_gcs; +Uint16 global_max_gen_gcs; +Uint global_gc_flags; + +Uint global_heap_min_sz = SH_DEFAULT_SIZE; +#endif + +int ignore_break; +int replace_intr; + +static ERTS_INLINE int +has_prefix(const char *prefix, const char *string) +{ + int i; + for (i = 0; prefix[i]; i++) + if (prefix[i] != string[i]) + return 0; + return 1; +} + +static char* +progname(char *fullname) +{ + int i; + + i = strlen(fullname); + while (i >= 0) { + if ((fullname[i] != '/') && (fullname[i] != '\\')) + i--; + else + break; + } + return fullname+i+1; +} + +static int +this_rel_num(void) +{ + static int this_rel = -1; + + if (this_rel < 1) { + int i; + char this_rel_str[] = ERLANG_OTP_RELEASE; + + i = 0; + while (this_rel_str[i] && !isdigit((int) this_rel_str[i])) + i++; + this_rel = atoi(&this_rel_str[i]); + if (this_rel < 1) + erl_exit(-1, "Unexpected ERLANG_OTP_RELEASE format\n"); + } + return this_rel; +} + +/* + * Common error printout function, all error messages + * that don't go to the error logger go through here. + */ + +void erl_error(char *fmt, va_list args) +{ + erts_vfprintf(stderr, fmt, args); +} + +static void early_init(int *argc, char **argv); + +void +erts_short_init(void) +{ + early_init(NULL, NULL); + erl_init(); + erts_initialized = 1; +} + +void +erl_init(void) +{ + init_benchmarking(); + +#ifdef ERTS_SMP + erts_system_block_init(); +#endif + + erts_init_monitors(); + erts_init_gc(); + init_time(); + erts_init_process(); + erts_init_scheduling(use_multi_run_queue, + no_schedulers, + no_schedulers_online); + + H_MIN_SIZE = erts_next_heap_size(H_MIN_SIZE, 0); + + erts_init_trace(); + erts_init_binary(); + erts_init_bits(); + erts_init_fun_table(); + init_atom_table(); + init_export_table(); + init_module_table(); + init_register_table(); + init_message(); + erts_bif_info_init(); + erts_ddll_init(); + init_emulator(); + erts_bp_init(); + init_db(); /* Must be after init_emulator */ + erts_bif_timer_init(); + erts_init_node_tables(); + init_dist(); + erl_drv_thr_init(); + init_io(); + init_copy(); + init_load(); + erts_init_bif(); + erts_init_bif_chksum(); + erts_init_bif_re(); + erts_init_unicode(); /* after RE to get access to PCRE unicode */ + erts_delay_trap = erts_export_put(am_erlang, am_delay_trap, 2); + erts_late_init_process(); +#if HAVE_ERTS_MSEG + erts_mseg_late_init(); /* Must be after timer (init_time()) and thread + initializations */ +#endif +#ifdef HIPE + hipe_mode_switch_init(); /* Must be after init_load/beam_catches/init */ +#endif +#ifdef _OSE_ + erl_sys_init_final(); +#endif + packet_parser_init(); +} + +static void +init_shared_memory(int argc, char **argv) +{ +#ifdef HYBRID + int arg_size = 0; + + global_heap_sz = erts_next_heap_size(global_heap_sz,0); + + /* Make sure arguments will fit on the heap, no one else will check! */ + while (argc--) + arg_size += 2 + strlen(argv[argc]); + if (global_heap_sz < arg_size) + global_heap_sz = erts_next_heap_size(arg_size,1); + +#ifndef INCREMENTAL + global_heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, + sizeof(Eterm) * global_heap_sz); + global_hend = global_heap + global_heap_sz; + global_htop = global_heap; + global_high_water = global_heap; + global_old_hend = global_old_htop = global_old_heap = NULL; +#endif + + global_gen_gcs = 0; + global_max_gen_gcs = erts_smp_atomic_read(&erts_max_gen_gcs); + global_gc_flags = erts_default_process_flags; + + erts_global_offheap.mso = NULL; +#ifndef HYBRID /* FIND ME! */ + erts_global_offheap.funs = NULL; +#endif + erts_global_offheap.overhead = 0; +#endif + +#ifdef INCREMENTAL + erts_init_incgc(); +#endif +} + + +/* + * Create the very first process. + */ + +void +erts_first_process(Eterm modname, void* code, unsigned size, int argc, char** argv) +{ + int i; + Eterm args; + Eterm pid; + Eterm* hp; + Process parent; + Process* p; + ErlSpawnOpts so; + + if (erts_find_function(modname, am_start, 1) == NULL) { + char sbuf[256]; + Atom* ap; + + ap = atom_tab(atom_val(modname)); + memcpy(sbuf, ap->name, ap->len); + sbuf[ap->len] = '\0'; + erl_exit(5, "No function %s:start/1\n", sbuf); + } + + /* + * We need a dummy parent process to be able to call erl_create_process(). + */ + erts_init_empty_process(&parent); + hp = HAlloc(&parent, argc*2 + 4); + args = NIL; + for (i = argc-1; i >= 0; i--) { + int len = sys_strlen(argv[i]); + args = CONS(hp, new_binary(&parent, (byte*)argv[i], len), args); + hp += 2; + } + args = CONS(hp, new_binary(&parent, code, size), args); + hp += 2; + args = CONS(hp, args, NIL); + + so.flags = 0; + pid = erl_create_process(&parent, modname, am_start, args, &so); + p = process_tab[internal_pid_index(pid)]; + p->group_leader = pid; + + erts_cleanup_empty_process(&parent); +} + +/* + * XXX Old way of starting. Hopefully soon obsolete. + */ + +static void +erl_first_process_otp(char* modname, void* code, unsigned size, int argc, char** argv) +{ + int i; + Eterm start_mod; + Eterm args; + Eterm* hp; + Process parent; + ErlSpawnOpts so; + Eterm env; + + start_mod = am_atom_put(modname, sys_strlen(modname)); + if (erts_find_function(start_mod, am_start, 2) == NULL) { + erl_exit(5, "No function %s:start/2\n", modname); + } + + /* + * We need a dummy parent process to be able to call erl_create_process(). + */ + + erts_init_empty_process(&parent); + erts_smp_proc_lock(&parent, ERTS_PROC_LOCK_MAIN); + hp = HAlloc(&parent, argc*2 + 4); + args = NIL; + for (i = argc-1; i >= 0; i--) { + int len = sys_strlen(argv[i]); + args = CONS(hp, new_binary(&parent, (byte*)argv[i], len), args); + hp += 2; + } + env = new_binary(&parent, code, size); + args = CONS(hp, args, NIL); + hp += 2; + args = CONS(hp, env, args); + + so.flags = 0; + (void) erl_create_process(&parent, start_mod, am_start, args, &so); + erts_smp_proc_unlock(&parent, ERTS_PROC_LOCK_MAIN); + erts_cleanup_empty_process(&parent); +} + +Eterm +erts_preloaded(Process* p) +{ + Eterm previous; + int j; + int need; + Eterm mod; + Eterm* hp; + char* name; + const Preload *preload = sys_preloaded(); + + j = 0; + while (preload[j].name != NULL) { + j++; + } + previous = NIL; + need = 2*j; + hp = HAlloc(p, need); + j = 0; + while ((name = preload[j].name) != NULL) { + mod = am_atom_put(name, sys_strlen(name)); + previous = CONS(hp, mod, previous); + hp += 2; + j++; + } + return previous; +} + + +/* static variables that must not change (use same values at restart) */ +static char* program; +static char* init = "init"; +static char* boot = "boot"; +static int boot_argc; +static char** boot_argv; + +static char * +get_arg(char* rest, char* next, int* ip) +{ + if (*rest == '\0') { + if (next == NULL) { + erts_fprintf(stderr, "too few arguments\n"); + erts_usage(); + } + (*ip)++; + return next; + } + return rest; +} + +static void +load_preloaded(void) +{ + int i; + int res; + Preload* preload_p; + Eterm module_name; + byte* code; + char* name; + int length; + + if ((preload_p = sys_preloaded()) == NULL) { + return; + } + i = 0; + while ((name = preload_p[i].name) != NULL) { + length = preload_p[i].size; + module_name = am_atom_put(name, sys_strlen(name)); + if ((code = sys_preload_begin(&preload_p[i])) == 0) + erl_exit(1, "Failed to find preloaded code for module %s\n", + name); + res = erts_load_module(NULL, 0, NIL, &module_name, code, length); + sys_preload_end(&preload_p[i]); + if (res < 0) + erl_exit(1,"Failed loading preloaded module %s\n", name); + i++; + } +} + +/* be helpful (or maybe downright rude:-) */ +void erts_usage(void) +{ + erts_fprintf(stderr, "Usage: %s [flags] [ -- [init_args] ]\n", progname(program)); + erts_fprintf(stderr, "The flags are:\n\n"); + + /* erts_fprintf(stderr, "-# number set the number of items to be used in traces etc\n"); */ + + erts_fprintf(stderr, "-a size suggested stack size in kilo words for threads\n"); + erts_fprintf(stderr, " in the async-thread pool, valid range is [%d-%d]\n", + ERTS_ASYNC_THREAD_MIN_STACK_SIZE, + ERTS_ASYNC_THREAD_MAX_STACK_SIZE); + erts_fprintf(stderr, "-A number set number of threads in async thread pool,\n"); + erts_fprintf(stderr, " valid range is [0-%d]\n", + ERTS_MAX_NO_OF_ASYNC_THREADS); + + erts_fprintf(stderr, "-B[c|d|i] c to have Ctrl-c interrupt the Erlang shell,\n"); + erts_fprintf(stderr, " d (or no extra option) to disable the break\n"); + erts_fprintf(stderr, " handler, i to ignore break signals\n"); + + /* erts_fprintf(stderr, "-b func set the boot function (default boot)\n"); */ + + erts_fprintf(stderr, "-c disable continuous date/time correction with\n"); + erts_fprintf(stderr, " respect to uptime\n"); + + erts_fprintf(stderr, "-d don't write a crash dump for internally detected errors\n"); + erts_fprintf(stderr, " (halt(String) will still produce a crash dump)\n"); + + erts_fprintf(stderr, "-h number set minimum heap size in words (default %d)\n", + H_DEFAULT_SIZE); + + /* erts_fprintf(stderr, "-i module set the boot module (default init)\n"); */ + + erts_fprintf(stderr, "-K boolean enable or disable kernel poll\n"); + + erts_fprintf(stderr, "-l turn on auto load tracing\n"); + + erts_fprintf(stderr, "-M memory allocator switches,\n"); + erts_fprintf(stderr, " see the erts_alloc(3) documentation for more info.\n"); + + erts_fprintf(stderr, "-P number set maximum number of processes on this node,\n"); + erts_fprintf(stderr, " valid range is [%d-%d]\n", + ERTS_MIN_PROCESSES, ERTS_MAX_PROCESSES); + erts_fprintf(stderr, "-R number set compatibility release number,\n"); + erts_fprintf(stderr, " valid range [%d-%d]\n", + ERTS_MIN_COMPAT_REL, this_rel_num()); + + erts_fprintf(stderr, "-r force ets memory block to be moved on realloc\n"); + erts_fprintf(stderr, "-sbt type set scheduler bind type, valid types are:\n"); + erts_fprintf(stderr, " u|ns|ts|ps|s|nnts|nnps|tnnps|db\n"); + erts_fprintf(stderr, "-sct cput set cpu topology,\n"); + erts_fprintf(stderr, " see the erl(1) documentation for more info.\n"); + erts_fprintf(stderr, "-sss size suggested stack size in kilo words for scheduler threads,\n"); + erts_fprintf(stderr, " valid range is [%d-%d]\n", + ERTS_SCHED_THREAD_MIN_STACK_SIZE, + ERTS_SCHED_THREAD_MAX_STACK_SIZE); + erts_fprintf(stderr, "-S n1:n2 set number of schedulers (n1), and number of\n"); + erts_fprintf(stderr, " schedulers online (n2), valid range for both\n"); + erts_fprintf(stderr, " numbers are [1-%d]\n", + ERTS_MAX_NO_OF_SCHEDULERS); + erts_fprintf(stderr, "-T number set modified timing level,\n"); + erts_fprintf(stderr, " valid range is [0-%d]\n", + ERTS_MODIFIED_TIMING_LEVELS-1); + erts_fprintf(stderr, "-V print Erlang version\n"); + + erts_fprintf(stderr, "-v turn on chatty mode (GCs will be reported etc)\n"); + + erts_fprintf(stderr, "-W set error logger warnings mapping,\n"); + erts_fprintf(stderr, " see error_logger documentation for details\n"); + + erts_fprintf(stderr, "\n"); + erts_fprintf(stderr, "Note that if the emulator is started with erlexec (typically\n"); + erts_fprintf(stderr, "from the erl script), these flags should be specified with +.\n"); + erts_fprintf(stderr, "\n\n"); + erl_exit(-1, ""); +} + +static void +early_init(int *argc, char **argv) /* + * Only put things here which are + * really important initialize + * early! + */ +{ + ErtsAllocInitOpts alloc_opts = ERTS_ALLOC_INIT_DEF_OPTS_INITER; + int ncpu; + int ncpuonln; + int ncpuavail; + int schdlrs; + int schdlrs_onln; + use_multi_run_queue = 1; + erts_printf_eterm_func = erts_printf_term; + erts_disable_tolerant_timeofday = 0; + display_items = 200; + display_loads = 0; + erts_backtrace_depth = DEFAULT_BACKTRACE_SIZE; + erts_async_max_threads = 0; + erts_async_thread_suggested_stack_size = ERTS_ASYNC_THREAD_MIN_STACK_SIZE; + H_MIN_SIZE = H_DEFAULT_SIZE; + + erts_initialized = 0; + + erts_use_sender_punish = 1; + + erts_cpuinfo = erts_cpu_info_create(); + +#ifdef ERTS_SMP + ncpu = erts_get_cpu_configured(erts_cpuinfo); + ncpuonln = erts_get_cpu_online(erts_cpuinfo); + ncpuavail = erts_get_cpu_available(erts_cpuinfo); +#else + ncpu = 1; + ncpuonln = 1; + ncpuavail = 1; +#endif + + ignore_break = 0; + replace_intr = 0; + program = argv[0]; + + erts_modified_timing_level = -1; + + erts_compat_rel = this_rel_num(); + + erts_use_r9_pids_ports = 0; + + erts_sys_pre_init(); + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init(); +#endif +#ifdef ERTS_SMP + erts_smp_atomic_init(&erts_writing_erl_crash_dump, 0L); +#else + erts_writing_erl_crash_dump = 0; +#endif + + erts_smp_atomic_init(&erts_max_gen_gcs, (long)((Uint16) -1)); + + erts_pre_init_process(); +#if defined(USE_THREADS) && !defined(ERTS_SMP) + main_thread = erts_thr_self(); +#endif + + /* + * We need to know the number of schedulers to use before we + * can initialize the allocators. + */ + no_schedulers = (Uint) (ncpu > 0 ? ncpu : 1); + no_schedulers_online = (ncpuavail > 0 + ? ncpuavail + : (ncpuonln > 0 ? ncpuonln : no_schedulers)); + + schdlrs = no_schedulers; + schdlrs_onln = no_schedulers_online; + + if (argc && argv) { + int i = 1; + while (i < *argc) { + if (strcmp(argv[i], "--") == 0) { /* end of emulator options */ + i++; + break; + } + if (argv[i][0] == '-') { + switch (argv[i][1]) { + case 'S' : { + int tot, onln; + char *arg = get_arg(argv[i]+2, argv[i+1], &i); + switch (sscanf(arg, "%d:%d", &tot, &onln)) { + case 0: + switch (sscanf(arg, ":%d", &onln)) { + case 1: + tot = no_schedulers; + goto chk_S; + default: + goto bad_S; + } + case 1: + onln = tot < schdlrs_onln ? tot : schdlrs_onln; + case 2: + chk_S: + if (tot > 0) + schdlrs = tot; + else + schdlrs = no_schedulers + tot; + if (onln > 0) + schdlrs_onln = onln; + else + schdlrs_onln = no_schedulers_online + onln; + if (schdlrs < 1 || ERTS_MAX_NO_OF_SCHEDULERS < schdlrs) { + erts_fprintf(stderr, + "bad amount of schedulers %d\n", + tot); + erts_usage(); + } + if (schdlrs_onln < 1 || schdlrs < schdlrs_onln) { + erts_fprintf(stderr, + "bad amount of schedulers online %d " + "(total amount of schedulers %d)\n", + schdlrs_onln, schdlrs); + erts_usage(); + } + break; + default: + bad_S: + erts_fprintf(stderr, + "bad amount of schedulers %s\n", + arg); + erts_usage(); + break; + } + + VERBOSE(DEBUG_SYSTEM, + ("using %d:%d scheduler(s)\n", tot, onln)); + break; + } + default: + break; + } + } + i++; + } + } + +#ifdef ERTS_SMP + no_schedulers = schdlrs; + no_schedulers_online = schdlrs_onln; + + erts_no_schedulers = (Uint) no_schedulers; +#endif + + erts_alloc_init(argc, argv, &alloc_opts); /* Handles (and removes) + -M flags. */ + + erts_early_init_scheduling(); /* Require allocators */ + erts_init_utils(); /* Require allocators */ + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_late_init(); +#endif + +#if defined(HIPE) + hipe_signal_init(); /* must be done very early */ +#endif + erl_sys_init(); + + erl_sys_args(argc, argv); + + erts_ets_realloc_always_moves = 0; + +} + +#ifndef ERTS_SMP +static void set_main_stack_size(void) +{ + if (erts_sched_thread_suggested_stack_size > 0) { +# if HAVE_DECL_GETRLIMIT && HAVE_DECL_SETRLIMIT && HAVE_DECL_RLIMIT_STACK + struct rlimit rl; + int bytes = erts_sched_thread_suggested_stack_size * sizeof(Uint) * 1024; + if (getrlimit(RLIMIT_STACK, &rl) != 0 || + (rl.rlim_cur = bytes, setrlimit(RLIMIT_STACK, &rl) != 0)) { + erts_fprintf(stderr, "failed to set stack size for scheduler " + "thread to %d bytes\n", bytes); + erts_usage(); + } +# else + erts_fprintf(stderr, "no OS support for dynamic stack size limit\n"); + erts_usage(); +# endif + } +} +#endif + +void +erl_start(int argc, char **argv) +{ + int i = 1; + char* arg=NULL; + char* Parg = NULL; + int have_break_handler = 1; + char envbuf[21]; /* enough for any 64-bit integer */ + size_t envbufsz; + int async_max_threads = erts_async_max_threads; + + early_init(&argc, argv); + + envbufsz = sizeof(envbuf); + if (erts_sys_getenv(ERL_MAX_ETS_TABLES_ENV, envbuf, &envbufsz) == 0) + user_requested_db_max_tabs = atoi(envbuf); + else + user_requested_db_max_tabs = 0; + + envbufsz = sizeof(envbuf); + if (erts_sys_getenv("ERL_FULLSWEEP_AFTER", envbuf, &envbufsz) == 0) { + Uint16 max_gen_gcs = atoi(envbuf); + erts_smp_atomic_set(&erts_max_gen_gcs, (long) max_gen_gcs); + } + + envbufsz = sizeof(envbuf); + if (erts_sys_getenv("ERL_THREAD_POOL_SIZE", envbuf, &envbufsz) == 0) { + async_max_threads = atoi(envbuf); + } + + +#ifdef DEBUG + verbose = DEBUG_DEFAULT; +#endif + + erts_error_logger_warnings = am_error; + + while (i < argc) { + if (argv[i][0] != '-') { + erts_usage(); + } + if (strcmp(argv[i], "--") == 0) { /* end of emulator options */ + i++; + break; + } + switch (argv[i][1]) { + + /* + * NOTE: -M flags are handled (and removed from argv) by + * erts_alloc_init(). + * + * The -d, -m, -S, -t, and -T flags was removed in + * Erlang 5.3/OTP R9C. + * + * -S, and -T has been reused in Erlang 5.5/OTP R11B. + * + * -d has been reused in a patch R12B-4. + */ + + case '#' : + arg = get_arg(argv[i]+2, argv[i+1], &i); + if ((display_items = atoi(arg)) == 0) { + erts_fprintf(stderr, "bad display items%s\n", arg); + erts_usage(); + } + VERBOSE(DEBUG_SYSTEM, + ("using display items %d\n",display_items)); + break; + + case 'l': + display_loads++; + break; + + case 'v': +#ifdef DEBUG + if (argv[i][2] == '\0') { + verbose |= DEBUG_SYSTEM; + } else { + char *ch; + for (ch = argv[i]+2; *ch != '\0'; ch++) { + switch (*ch) { + case 's': verbose |= DEBUG_SYSTEM; break; + case 'g': verbose |= DEBUG_PRIVATE_GC; break; + case 'h': verbose |= DEBUG_HYBRID_GC; break; + case 'M': verbose |= DEBUG_MEMORY; break; + case 'a': verbose |= DEBUG_ALLOCATION; break; + case 't': verbose |= DEBUG_THREADS; break; + case 'p': verbose |= DEBUG_PROCESSES; break; + case 'm': verbose |= DEBUG_MESSAGES; break; + default : erts_fprintf(stderr,"Unknown verbose option: %c\n",*ch); + } + } + } + erts_printf("Verbose level: "); + if (verbose & DEBUG_SYSTEM) erts_printf("SYSTEM "); + if (verbose & DEBUG_PRIVATE_GC) erts_printf("PRIVATE_GC "); + if (verbose & DEBUG_HYBRID_GC) erts_printf("HYBRID_GC "); + if (verbose & DEBUG_MEMORY) erts_printf("PARANOID_MEMORY "); + if (verbose & DEBUG_ALLOCATION) erts_printf("ALLOCATION "); + if (verbose & DEBUG_THREADS) erts_printf("THREADS "); + if (verbose & DEBUG_PROCESSES) erts_printf("PROCESSES "); + if (verbose & DEBUG_MESSAGES) erts_printf("MESSAGES "); + erts_printf("\n"); +#else + erts_fprintf(stderr, "warning: -v (only in debug compiled code)\n"); +#endif + break; + case 'V' : + { + char tmp[256]; + + tmp[0] = tmp[1] = '\0'; +#ifdef DEBUG + strcat(tmp, ",DEBUG"); +#endif +#ifdef ERTS_SMP + strcat(tmp, ",SMP"); +#endif +#ifdef USE_THREADS + strcat(tmp, ",ASYNC_THREADS"); +#endif +#ifdef HIPE + strcat(tmp, ",HIPE"); +#endif +#ifdef INCREMENTAL + strcat(tmp, ",INCREMENTAL_GC"); +#endif +#ifdef HYBRID + strcat(tmp, ",HYBRID"); +#endif + erts_fprintf(stderr, "Erlang "); + if (tmp[1]) { + erts_fprintf(stderr, "(%s) ", tmp+1); + } + erts_fprintf(stderr, "(" EMULATOR ") emulator version " + ERLANG_VERSION "\n"); + erl_exit(0, ""); + } + break; + + case 'H': /* undocumented */ + fprintf(stderr, "The undocumented +H option has been removed (R10B-6).\n\n"); + break; + + case 'h': + /* set default heap size */ + arg = get_arg(argv[i]+2, argv[i+1], &i); + if ((H_MIN_SIZE = atoi(arg)) <= 0) { + erts_fprintf(stderr, "bad heap size %s\n", arg); + erts_usage(); + } + VERBOSE(DEBUG_SYSTEM, + ("using minimum heap size %d\n",H_MIN_SIZE)); + break; + + case 'd': + /* + * Never produce crash dumps for internally detected + * errors; only produce a core dump. (Generation of + * crash dumps is destructive and makes it impossible + * to inspect the contents of process heaps in the + * core dump.) + */ + erts_no_crash_dump = 1; + break; + + case 'e': + /* set maximum number of ets tables */ + arg = get_arg(argv[i]+2, argv[i+1], &i); + if (( user_requested_db_max_tabs = atoi(arg) ) < 0) { + erts_fprintf(stderr, "bad maximum number of ets tables %s\n", arg); + erts_usage(); + } + VERBOSE(DEBUG_SYSTEM, + ("using maximum number of ets tables %d\n", + user_requested_db_max_tabs)); + break; + + case 'i': + /* define name of module for initial function */ + init = get_arg(argv[i]+2, argv[i+1], &i); + break; + + case 'b': + /* define name of initial function */ + boot = get_arg(argv[i]+2, argv[i+1], &i); + break; + + case 'B': + if (argv[i][2] == 'i') /* +Bi */ + ignore_break = 1; + else if (argv[i][2] == 'c') /* +Bc */ + replace_intr = 1; + else if (argv[i][2] == 'd') /* +Bd */ + have_break_handler = 0; + else if (argv[i+1][0] == 'i') { /* +B i */ + get_arg(argv[i]+2, argv[i+1], &i); + ignore_break = 1; + } + else if (argv[i+1][0] == 'c') { /* +B c */ + get_arg(argv[i]+2, argv[i+1], &i); + replace_intr = 1; + } + else if (argv[i+1][0] == 'd') { /* +B d */ + get_arg(argv[i]+2, argv[i+1], &i); + have_break_handler = 0; + } + else /* +B */ + have_break_handler = 0; + break; + + case 'K': + /* If kernel poll support is present, + erl_sys_args() will remove the K parameter + and value */ + get_arg(argv[i]+2, argv[i+1], &i); + erts_fprintf(stderr, + "kernel-poll not supported; \"K\" parameter ignored\n", + arg); + break; + + case 'P': + /* set maximum number of processes */ + Parg = get_arg(argv[i]+2, argv[i+1], &i); + erts_max_processes = atoi(Parg); + /* Check of result is delayed until later. This is because +R + may be given after +P. */ + break; + + case 'S' : /* Was handled in early_init() just read past it */ + (void) get_arg(argv[i]+2, argv[i+1], &i); + break; + + case 's' : { + char *estr; + int res; + char *sub_param = argv[i]+2; + if (has_prefix("bt", sub_param)) { + arg = get_arg(sub_param+2, argv[i+1], &i); + res = erts_init_scheduler_bind_type(arg); + if (res != ERTS_INIT_SCHED_BIND_TYPE_SUCCESS) { + switch (res) { + case ERTS_INIT_SCHED_BIND_TYPE_NOT_SUPPORTED: + estr = "not supported"; + break; + case ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY: + estr = "no cpu topology available"; + break; + case ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_BAD_TYPE: + estr = "invalid type"; + break; + default: + estr = "undefined error"; + break; + } + erts_fprintf(stderr, + "setting scheduler bind type '%s' failed: %s\n", + arg, + estr); + erts_usage(); + } + } + else if (has_prefix("ct", sub_param)) { + arg = get_arg(sub_param+2, argv[i+1], &i); + res = erts_init_cpu_topology(arg); + if (res != ERTS_INIT_CPU_TOPOLOGY_OK) { + switch (res) { + case ERTS_INIT_CPU_TOPOLOGY_INVALID_ID: + estr = "invalid identifier"; + break; + case ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE: + estr = "invalid identifier range"; + break; + case ERTS_INIT_CPU_TOPOLOGY_INVALID_HIERARCHY: + estr = "invalid hierarchy"; + break; + case ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_TYPE: + estr = "invalid identifier type"; + break; + case ERTS_INIT_CPU_TOPOLOGY_INVALID_NODES: + estr = "invalid nodes declaration"; + break; + case ERTS_INIT_CPU_TOPOLOGY_MISSING_LID: + estr = "missing logical identifier"; + break; + case ERTS_INIT_CPU_TOPOLOGY_NOT_UNIQUE_LIDS: + estr = "not unique logical identifiers"; + break; + case ERTS_INIT_CPU_TOPOLOGY_NOT_UNIQUE_ENTITIES: + estr = "not unique entities"; + break; + case ERTS_INIT_CPU_TOPOLOGY_MISSING: + estr = "missing cpu topology"; + break; + default: + estr = "undefined error"; + break; + } + erts_fprintf(stderr, + "bad cpu topology '%s': %s\n", + arg, + estr); + erts_usage(); + } + } + else if (sys_strcmp("mrq", sub_param) == 0) + use_multi_run_queue = 1; + else if (sys_strcmp("srq", sub_param) == 0) + use_multi_run_queue = 0; + else if (sys_strcmp("nsp", sub_param) == 0) + erts_use_sender_punish = 0; + else if (has_prefix("ss", sub_param)) { + /* suggested stack size (Kilo Words) for scheduler threads */ + arg = get_arg(sub_param+2, argv[i+1], &i); + erts_sched_thread_suggested_stack_size = atoi(arg); + + if ((erts_sched_thread_suggested_stack_size + < ERTS_SCHED_THREAD_MIN_STACK_SIZE) + || (erts_sched_thread_suggested_stack_size > + ERTS_SCHED_THREAD_MAX_STACK_SIZE)) { + erts_fprintf(stderr, "bad stack size for scheduler threads %s\n", + arg); + erts_usage(); + } + VERBOSE(DEBUG_SYSTEM, + ("suggested scheduler thread stack size %d kilo words\n", + erts_sched_thread_suggested_stack_size)); + } + else { + erts_fprintf(stderr, "bad scheduling option %s\n", argv[i]); + erts_usage(); + } + break; + } + case 'T' : + arg = get_arg(argv[i]+2, argv[i+1], &i); + errno = 0; + erts_modified_timing_level = atoi(arg); + if ((erts_modified_timing_level == 0 && errno != 0) + || erts_modified_timing_level < 0 + || erts_modified_timing_level >= ERTS_MODIFIED_TIMING_LEVELS) { + erts_fprintf(stderr, "bad modified timing level %s\n", arg); + erts_usage(); + } + else { + VERBOSE(DEBUG_SYSTEM, + ("using modified timing level %d\n", + erts_modified_timing_level)); + } + + break; + + case 'R': { + /* set compatibility release */ + + arg = get_arg(argv[i]+2, argv[i+1], &i); + erts_compat_rel = atoi(arg); + + if (erts_compat_rel < ERTS_MIN_COMPAT_REL + || erts_compat_rel > this_rel_num()) { + erts_fprintf(stderr, "bad compatibility release number %s\n", arg); + erts_usage(); + } + + ASSERT(ERTS_MIN_COMPAT_REL >= 7); + switch (erts_compat_rel) { + case 7: + case 8: + case 9: + erts_use_r9_pids_ports = 1; + default: + break; + } + + break; + } + + case 'A': + /* set number of threads in thread pool */ + arg = get_arg(argv[i]+2, argv[i+1], &i); + if (((async_max_threads = atoi(arg)) < 0) || + (async_max_threads > ERTS_MAX_NO_OF_ASYNC_THREADS)) { + erts_fprintf(stderr, "bad number of async threads %s\n", arg); + erts_usage(); + } + + VERBOSE(DEBUG_SYSTEM, ("using %d async-threads\n", + async_max_threads)); + break; + + case 'a': + /* suggested stack size (Kilo Words) for threads in thread pool */ + arg = get_arg(argv[i]+2, argv[i+1], &i); + erts_async_thread_suggested_stack_size = atoi(arg); + + if ((erts_async_thread_suggested_stack_size + < ERTS_ASYNC_THREAD_MIN_STACK_SIZE) + || (erts_async_thread_suggested_stack_size > + ERTS_ASYNC_THREAD_MAX_STACK_SIZE)) { + erts_fprintf(stderr, "bad stack size for async threads %s\n", + arg); + erts_usage(); + } + + VERBOSE(DEBUG_SYSTEM, + ("suggested async-thread stack size %d kilo words\n", + erts_async_thread_suggested_stack_size)); + break; + + case 'r': + erts_ets_realloc_always_moves = 1; + break; + case 'n': /* XXX obsolete */ + break; + case 'c': + if (argv[i][2] == 0) { /* -c: documented option */ + erts_disable_tolerant_timeofday = 1; + } +#ifdef ERTS_OPCODE_COUNTER_SUPPORT + else if (argv[i][2] == 'i') { /* -ci: undcoumented option*/ + count_instructions = 1; + } +#endif + break; + case 'W': + arg = get_arg(argv[i]+2, argv[i+1], &i); + switch (arg[0]) { + case 'i': + erts_error_logger_warnings = am_info; + break; + case 'w': + erts_error_logger_warnings = am_warning; + break; + case 'e': /* The default */ + erts_error_logger_warnings = am_error; + default: + erts_fprintf(stderr, "unrecognized warning_map option %s\n", arg); + erts_usage(); + } + break; + + default: + erts_fprintf(stderr, "%s unknown flag %s\n", argv[0], argv[i]); + erts_usage(); + } + i++; + } + +#ifdef USE_THREADS + erts_async_max_threads = async_max_threads; +#endif + + /* Delayed check of +P flag */ + if (erts_max_processes < ERTS_MIN_PROCESSES + || erts_max_processes > ERTS_MAX_PROCESSES + || (erts_use_r9_pids_ports + && erts_max_processes > ERTS_MAX_R9_PROCESSES)) { + erts_fprintf(stderr, "bad number of processes %s\n", Parg); + erts_usage(); + } + + /* Restart will not reinstall the break handler */ +#ifdef __WIN32__ + if (ignore_break) + erts_set_ignore_break(); + else if (replace_intr) + erts_replace_intr(); + else + init_break_handler(); +#else + if (ignore_break) + erts_set_ignore_break(); + else if (have_break_handler) + init_break_handler(); + if (replace_intr) + erts_replace_intr(); +#endif + + boot_argc = argc - i; /* Number of arguments to init */ + boot_argv = &argv[i]; + + erl_init(); + + init_shared_memory(boot_argc, boot_argv); + load_preloaded(); + + erts_initialized = 1; + + erl_first_process_otp("otp_ring0", NULL, 0, boot_argc, boot_argv); + +#ifdef ERTS_SMP + erts_start_schedulers(); + /* Let system specific code decide what to do with the main thread... */ + + erts_sys_main_thread(); /* May or may not return! */ +#else + set_main_stack_size(); + process_main(); +#endif +} + + +#ifdef USE_THREADS + +__decl_noreturn void erts_thr_fatal_error(int err, char *what) +{ + char *errstr = err ? strerror(err) : NULL; + erts_fprintf(stderr, + "Failed to %s: %s%s(%d)\n", + what, + errstr ? errstr : "", + errstr ? " " : "", + err); + abort(); +} + +#endif + +static void +system_cleanup(int exit_code) +{ + /* No cleanup wanted if ... + * 1. we are about to do an abnormal exit + * 2. we haven't finished initializing, or + * 3. another thread than the main thread is performing the exit + * (in threaded non smp case). + */ + + if (exit_code != 0 + || !erts_initialized +#if defined(USE_THREADS) && !defined(ERTS_SMP) + || !erts_equal_tids(main_thread, erts_thr_self()) +#endif + ) + return; + +#ifdef ERTS_SMP +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); +#endif + erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); /* We never release it... */ +#endif + +#ifdef HYBRID + if (ma_src_stack) erts_free(ERTS_ALC_T_OBJECT_STACK, + (void *)ma_src_stack); + if (ma_dst_stack) erts_free(ERTS_ALC_T_OBJECT_STACK, + (void *)ma_dst_stack); + if (ma_offset_stack) erts_free(ERTS_ALC_T_OBJECT_STACK, + (void *)ma_offset_stack); + ma_src_stack = NULL; + ma_dst_stack = NULL; + ma_offset_stack = NULL; + erts_cleanup_offheap(&erts_global_offheap); +#endif + +#if defined(HYBRID) && !defined(INCREMENTAL) + if (global_heap) { + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, + (void*) global_heap, + sizeof(Eterm) * global_heap_sz); + } + global_heap = NULL; +#endif + +#ifdef INCREMENTAL + erts_cleanup_incgc(); +#endif + +#if defined(USE_THREADS) && !defined(ERTS_SMP) + exit_async(); +#endif +#if HAVE_ERTS_MSEG + erts_mseg_exit(); +#endif + + /* + * A lot more cleaning could/should have been done... + */ + +} + +/* + * Common exit function, all exits from the system go through here. + * n <= 0 -> normal exit with status n; + * n = 127 -> Erlang crash dump produced, exit with status 1; + * other positive n -> Erlang crash dump and core dump produced. + */ + +__decl_noreturn void erl_exit0(char *file, int line, int n, char *fmt,...) +{ + unsigned int an; + va_list args; + + va_start(args, fmt); + + save_statistics(); + + system_cleanup(n); + + an = abs(n); + + if (erts_mtrace_enabled) + erts_mtrace_exit((Uint32) an); + + /* Produce an Erlang core dump if error */ + if (n > 0 && erts_initialized && + (erts_no_crash_dump == 0 || n == ERTS_DUMP_EXIT)) { + erl_crash_dump_v(file, line, fmt, args); + } + + /* need to reinitialize va_args thing */ + va_end(args); + va_start(args, fmt); + + if (fmt != NULL && *fmt != '\0') + erl_error(fmt, args); /* Print error message. */ + va_end(args); +#ifdef __WIN32__ + if(n > 0) ConWaitForExit(); + else ConNormalExit(); +#endif +#if !defined(__WIN32__) && !defined(VXWORKS) && !defined(_OSE_) + sys_tty_reset(); +#endif + + if (n == ERTS_INTR_EXIT) + exit(0); + else if (n == 127) + ERTS_EXIT_AFTER_DUMP(1); + else if (n > 0 || n == ERTS_ABORT_EXIT) + abort(); + exit(an); +} + +__decl_noreturn void erl_exit(int n, char *fmt,...) +{ + unsigned int an; + va_list args; + + va_start(args, fmt); + + save_statistics(); + + system_cleanup(n); + + an = abs(n); + + if (erts_mtrace_enabled) + erts_mtrace_exit((Uint32) an); + + /* Produce an Erlang core dump if error */ + if (n > 0 && erts_initialized && + (erts_no_crash_dump == 0 || n == ERTS_DUMP_EXIT)) { + erl_crash_dump_v((char*) NULL, 0, fmt, args); + } + + /* need to reinitialize va_args thing */ + va_end(args); + va_start(args, fmt); + + if (fmt != NULL && *fmt != '\0') + erl_error(fmt, args); /* Print error message. */ + va_end(args); +#ifdef __WIN32__ + if(n > 0) ConWaitForExit(); + else ConNormalExit(); +#endif +#if !defined(__WIN32__) && !defined(VXWORKS) && !defined(_OSE_) + sys_tty_reset(); +#endif + + if (n == ERTS_INTR_EXIT) + exit(0); + else if (n == ERTS_DUMP_EXIT) + ERTS_EXIT_AFTER_DUMP(1); + else if (n > 0 || n == ERTS_ABORT_EXIT) + abort(); + exit(an); +} + diff --git a/erts/emulator/beam/erl_instrument.c b/erts/emulator/beam/erl_instrument.c new file mode 100644 index 0000000000..3f022f92b8 --- /dev/null +++ b/erts/emulator/beam/erl_instrument.c @@ -0,0 +1,1221 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "global.h" +#include "big.h" +#include "erl_instrument.h" +#include "erl_threads.h" + +typedef union { long l; double d; } Align_t; + +typedef struct { + Uint size; +#ifdef VALGRIND + void* valgrind_leak_suppressor; +#endif + Align_t mem[1]; +} StatBlock_t; + +#define STAT_BLOCK_HEADER_SIZE (sizeof(StatBlock_t) - sizeof(Align_t)) + +typedef struct MapStatBlock_t_ MapStatBlock_t; +struct MapStatBlock_t_ { + Uint size; + ErtsAlcType_t type_no; + Eterm pid; + MapStatBlock_t *prev; + MapStatBlock_t *next; + Align_t mem[1]; +}; + +#define MAP_STAT_BLOCK_HEADER_SIZE (sizeof(MapStatBlock_t) - sizeof(Align_t)) + +typedef struct { + Uint size; + Uint max_size; + Uint max_size_ever; + + Uint blocks; + Uint max_blocks; + Uint max_blocks_ever; +} Stat_t; + +static erts_mtx_t instr_mutex; +static erts_mtx_t instr_x_mutex; + +int erts_instr_memory_map; +int erts_instr_stat; + +static ErtsAllocatorFunctions_t real_allctrs[ERTS_ALC_A_MAX+1]; + +struct stats_ { + Stat_t tot; + Stat_t a[ERTS_ALC_A_MAX+1]; + Stat_t *ap[ERTS_ALC_A_MAX+1]; + Stat_t c[ERTS_ALC_C_MAX+1]; + Stat_t n[ERTS_ALC_N_MAX+1]; +}; + +static struct stats_ *stats; + +static MapStatBlock_t *mem_anchor; + +static Eterm *am_tot; +static Eterm *am_n; +static Eterm *am_a; +static Eterm *am_c; + +static int atoms_initialized; + +static struct { + Eterm total; + Eterm allocators; + Eterm classes; + Eterm types; + Eterm sizes; + Eterm blocks; + Eterm instr_hdr; +#ifdef DEBUG + Eterm end_of_atoms; +#endif +} am; + +static void ERTS_INLINE atom_init(Eterm *atom, const char *name) +{ + *atom = am_atom_put((char *) name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static void +init_atoms(void) +{ +#ifdef DEBUG + Eterm *atom; + for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) { + *atom = THE_NON_VALUE; + } +#endif + + AM_INIT(total); + AM_INIT(allocators); + AM_INIT(classes); + AM_INIT(types); + AM_INIT(sizes); + AM_INIT(blocks); + AM_INIT(instr_hdr); + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { + ASSERT(*atom != THE_NON_VALUE); + } +#endif + + atoms_initialized = 1; +} + +#undef AM_INIT + +static void +init_am_tot(void) +{ + am_tot = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO, + sizeof(Eterm)); + atom_init(am_tot, "total"); +} + + +static void +init_am_n(void) +{ + int i; + am_n = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO, + (ERTS_ALC_N_MAX+1)*sizeof(Eterm)); + + for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) { + atom_init(&am_n[i], ERTS_ALC_N2TD(i)); + } + +} + +static void +init_am_c(void) +{ + int i; + am_c = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO, + (ERTS_ALC_C_MAX+1)*sizeof(Eterm)); + + for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) { + atom_init(&am_c[i], ERTS_ALC_C2CD(i)); + } + +} + +static void +init_am_a(void) +{ + int i; + am_a = (Eterm *) erts_alloc(ERTS_ALC_T_INSTR_INFO, + (ERTS_ALC_A_MAX+1)*sizeof(Eterm)); + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + atom_init(&am_a[i], ERTS_ALC_A2AD(i)); + } + +} + +static ERTS_INLINE void +stat_upd_alloc(ErtsAlcType_t n, Uint size) +{ + ErtsAlcType_t t = ERTS_ALC_N2T(n); + ErtsAlcType_t a = ERTS_ALC_T2A(t); + ErtsAlcType_t c = ERTS_ALC_T2C(t); + + stats->ap[a]->size += size; + if (stats->ap[a]->max_size < stats->ap[a]->size) + stats->ap[a]->max_size = stats->ap[a]->size; + + stats->c[c].size += size; + if (stats->c[c].max_size < stats->c[c].size) + stats->c[c].max_size = stats->c[c].size; + + stats->n[n].size += size; + if (stats->n[n].max_size < stats->n[n].size) + stats->n[n].max_size = stats->n[n].size; + + stats->tot.size += size; + if (stats->tot.max_size < stats->tot.size) + stats->tot.max_size = stats->tot.size; + + stats->ap[a]->blocks++; + if (stats->ap[a]->max_blocks < stats->ap[a]->blocks) + stats->ap[a]->max_blocks = stats->ap[a]->blocks; + + stats->c[c].blocks++; + if (stats->c[c].max_blocks < stats->c[c].blocks) + stats->c[c].max_blocks = stats->c[c].blocks; + + stats->n[n].blocks++; + if (stats->n[n].max_blocks < stats->n[n].blocks) + stats->n[n].max_blocks = stats->n[n].blocks; + + stats->tot.blocks++; + if (stats->tot.max_blocks < stats->tot.blocks) + stats->tot.max_blocks = stats->tot.blocks; + +} + + +static ERTS_INLINE void +stat_upd_free(ErtsAlcType_t n, Uint size) +{ + ErtsAlcType_t t = ERTS_ALC_N2T(n); + ErtsAlcType_t a = ERTS_ALC_T2A(t); + ErtsAlcType_t c = ERTS_ALC_T2C(t); + + ASSERT(stats->ap[a]->size >= size); + stats->ap[a]->size -= size; + + ASSERT(stats->c[c].size >= size); + stats->c[c].size -= size; + + ASSERT(stats->n[n].size >= size); + stats->n[n].size -= size; + + ASSERT(stats->tot.size >= size); + stats->tot.size -= size; + + ASSERT(stats->ap[a]->blocks > 0); + stats->ap[a]->blocks--; + + ASSERT(stats->c[c].blocks > 0); + stats->c[c].blocks--; + + ASSERT(stats->n[n].blocks > 0); + stats->n[n].blocks--; + + ASSERT(stats->tot.blocks > 0); + stats->tot.blocks--; + +} + + +static ERTS_INLINE void +stat_upd_realloc(ErtsAlcType_t n, Uint size, Uint old_size) +{ + if (old_size) + stat_upd_free(n, old_size); + stat_upd_alloc(n, size); +} + +/* + * stat instrumentation callback functions + */ + +static void * +stat_alloc(ErtsAlcType_t n, void *extra, Uint size) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + Uint ssize; + void *res; + + erts_mtx_lock(&instr_mutex); + + ssize = size + STAT_BLOCK_HEADER_SIZE; + res = (*real_af->alloc)(n, real_af->extra, ssize); + if (res) { + stat_upd_alloc(n, size); + ((StatBlock_t *) res)->size = size; +#ifdef VALGRIND + /* Suppress "possibly leaks" by storing an actual dummy pointer + to the _start_ of the allocated block.*/ + ((StatBlock_t *) res)->valgrind_leak_suppressor = res; +#endif + res = (void *) ((StatBlock_t *) res)->mem; + } + + erts_mtx_unlock(&instr_mutex); + + return res; +} + +static void * +stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + Uint old_size; + Uint ssize; + void *sptr; + void *res; + + erts_mtx_lock(&instr_mutex); + + if (ptr) { + sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE); + old_size = ((StatBlock_t *) sptr)->size; + } + else { + sptr = NULL; + old_size = 0; + } + + ssize = size + STAT_BLOCK_HEADER_SIZE; + res = (*real_af->realloc)(n, real_af->extra, sptr, ssize); + if (res) { + stat_upd_realloc(n, size, old_size); + ((StatBlock_t *) res)->size = size; +#ifdef VALGRIND + ((StatBlock_t *) res)->valgrind_leak_suppressor = res; +#endif + res = (void *) ((StatBlock_t *) res)->mem; + } + + erts_mtx_unlock(&instr_mutex); + + return res; +} + +static void +stat_free(ErtsAlcType_t n, void *extra, void *ptr) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + void *sptr; + + erts_mtx_lock(&instr_mutex); + + if (ptr) { + sptr = (void *) (((char *) ptr) - STAT_BLOCK_HEADER_SIZE); + stat_upd_free(n, ((StatBlock_t *) sptr)->size); + } + else { + sptr = NULL; + } + + (*real_af->free)(n, real_af->extra, sptr); + + erts_mtx_unlock(&instr_mutex); + +} + +/* + * map stat instrumentation callback functions + */ + +static void * +map_stat_alloc(ErtsAlcType_t n, void *extra, Uint size) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + Uint msize; + void *res; + + erts_mtx_lock(&instr_mutex); + + msize = size + MAP_STAT_BLOCK_HEADER_SIZE; + res = (*real_af->alloc)(n, real_af->extra, msize); + if (res) { + MapStatBlock_t *mb = (MapStatBlock_t *) res; + stat_upd_alloc(n, size); + + mb->size = size; + mb->type_no = n; + mb->pid = erts_get_current_pid(); + + mb->prev = NULL; + mb->next = mem_anchor; + if (mem_anchor) + mem_anchor->prev = mb; + mem_anchor = mb; + + res = (void *) mb->mem; + } + + erts_mtx_unlock(&instr_mutex); + + return res; +} + +static void * +map_stat_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + Uint old_size; + Uint msize; + void *mptr; + void *res; + + erts_mtx_lock(&instr_x_mutex); + erts_mtx_lock(&instr_mutex); + + if (ptr) { + mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE); + old_size = ((MapStatBlock_t *) mptr)->size; + } + else { + mptr = NULL; + old_size = 0; + } + + msize = size + MAP_STAT_BLOCK_HEADER_SIZE; + res = (*real_af->realloc)(n, real_af->extra, mptr, msize); + if (res) { + MapStatBlock_t *mb = (MapStatBlock_t *) res; + + mb->size = size; + mb->type_no = n; + mb->pid = erts_get_current_pid(); + + stat_upd_realloc(n, size, old_size); + + if (mptr != res) { + + if (mptr) { + if (mb->prev) + mb->prev->next = mb; + else { + ASSERT(mem_anchor == (MapStatBlock_t *) mptr); + mem_anchor = mb; + } + if (mb->next) + mb->next->prev = mb; + } + else { + mb->prev = NULL; + mb->next = mem_anchor; + if (mem_anchor) + mem_anchor->prev = mb; + mem_anchor = mb; + } + + } + + res = (void *) mb->mem; + } + + erts_mtx_unlock(&instr_mutex); + erts_mtx_unlock(&instr_x_mutex); + + return res; +} + +static void +map_stat_free(ErtsAlcType_t n, void *extra, void *ptr) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + void *mptr; + + erts_mtx_lock(&instr_x_mutex); + erts_mtx_lock(&instr_mutex); + + if (ptr) { + MapStatBlock_t *mb; + + mptr = (void *) (((char *) ptr) - MAP_STAT_BLOCK_HEADER_SIZE); + mb = (MapStatBlock_t *) mptr; + + stat_upd_free(n, mb->size); + + if (mb->prev) + mb->prev->next = mb->next; + else + mem_anchor = mb->next; + if (mb->next) + mb->next->prev = mb->prev; + } + else { + mptr = NULL; + } + + (*real_af->free)(n, real_af->extra, mptr); + + erts_mtx_unlock(&instr_mutex); + erts_mtx_unlock(&instr_x_mutex); + +} + +static void dump_memory_map_to_stream(FILE *fp) +{ + ErtsAlcType_t n; + MapStatBlock_t *bp; + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + erts_mtx_lock(&instr_mutex); + + /* Write header */ + + fprintf(fp, + "{instr_hdr,\n" + " %lu,\n" + " %lu,\n" + " {", + (unsigned long) ERTS_INSTR_VSN, + (unsigned long) MAP_STAT_BLOCK_HEADER_SIZE); + +#if ERTS_ALC_N_MIN != 1 +#error ERTS_ALC_N_MIN is not 1 +#endif + + for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) { + ErtsAlcType_t t = ERTS_ALC_N2T(n); + ErtsAlcType_t a = ERTS_ALC_T2A(t); + ErtsAlcType_t c = ERTS_ALC_T2C(t); + const char *astr; + + if (erts_allctrs_info[a].enabled) + astr = ERTS_ALC_A2AD(a); + else + astr = ERTS_ALC_A2AD(ERTS_ALC_A_SYSTEM); + + fprintf(fp, + "%s{%s,%s,%s}%s", + (n == ERTS_ALC_N_MIN) ? "" : " ", + ERTS_ALC_N2TD(n), + astr, + ERTS_ALC_C2CD(c), + (n == ERTS_ALC_N_MAX) ? "" : ",\n"); + } + + fprintf(fp, "}}.\n"); + + /* Write memory data */ + for (bp = mem_anchor; bp; bp = bp->next) { + if (is_internal_pid(bp->pid)) + fprintf(fp, + "{%lu, %lu, %lu, {%lu,%lu,%lu}}.\n", + (Uint) bp->type_no, + (Uint) bp->mem, + (Uint) bp->size, + (Uint) pid_channel_no(bp->pid), + (Uint) pid_number(bp->pid), + (Uint) pid_serial(bp->pid)); + else + fprintf(fp, + "{%lu, %lu, %lu, undefined}.\n", + (Uint) bp->type_no, + (Uint) bp->mem, + (Uint) bp->size); + } + + if (lock) + erts_mtx_unlock(&instr_mutex); +} + +int erts_instr_dump_memory_map_to_fd(int fd) +{ + char buf[BUFSIZ]; + FILE *f; + + if (!erts_instr_memory_map) + return 0; + + f = fdopen(fd, "w"); + if (f == NULL) + return 0; + + /* Avoid allocating memory; we may have run out of it at this point. */ + setbuf(f, buf); + + dump_memory_map_to_stream(f); + fflush(f); + return 1; +} + +int erts_instr_dump_memory_map(const char *name) +{ + FILE *f; + + if (!erts_instr_memory_map) + return 0; + + f = fopen(name, "w"); + if (f == NULL) + return 0; + + dump_memory_map_to_stream(f); + + fclose(f); + return 1; +} + +Eterm erts_instr_get_memory_map(Process *proc) +{ + MapStatBlock_t *org_mem_anchor; + Eterm hdr_tuple, md_list, res; + Eterm *hp; + Uint hsz; + MapStatBlock_t *bp; +#ifdef DEBUG + Eterm *end_hp; +#endif + + if (!erts_instr_memory_map) + return am_false; + + if (!atoms_initialized) + init_atoms(); + if (!am_n) + init_am_n(); + if (!am_c) + init_am_c(); + if (!am_a) + init_am_a(); + + erts_mtx_lock(&instr_x_mutex); + erts_mtx_lock(&instr_mutex); + + /* Header size */ + hsz = 5 + 1 + (ERTS_ALC_N_MAX+1-ERTS_ALC_N_MIN)*(1 + 4); + + /* Memory data list */ + for (bp = mem_anchor; bp; bp = bp->next) { + if (is_internal_pid(bp->pid)) { +#if (_PID_NUM_SIZE - 1 > MAX_SMALL) + if (internal_pid_number(bp->pid) > MAX_SMALL) + hsz += BIG_UINT_HEAP_SIZE; +#endif +#if (_PID_SER_SIZE - 1 > MAX_SMALL) + if (internal_pid_serial(bp->pid) > MAX_SMALL) + hsz += BIG_UINT_HEAP_SIZE; +#endif + hsz += 4; + } + + if ((Uint) bp->mem > MAX_SMALL) + hsz += BIG_UINT_HEAP_SIZE; + if (bp->size > MAX_SMALL) + hsz += BIG_UINT_HEAP_SIZE; + + hsz += 5 + 2; + } + + hsz += 3; /* Root tuple */ + + org_mem_anchor = mem_anchor; + mem_anchor = NULL; + + erts_mtx_unlock(&instr_mutex); + + hp = HAlloc(proc, hsz); /* May end up calling map_stat_alloc() */ + + erts_mtx_lock(&instr_mutex); + +#ifdef DEBUG + end_hp = hp + hsz; +#endif + + { /* Build header */ + ErtsAlcType_t n; + Eterm type_map; + Uint *hp2 = hp; +#ifdef DEBUG + Uint *hp2_end; +#endif + + hp += (ERTS_ALC_N_MAX + 1 - ERTS_ALC_N_MIN)*4; + +#ifdef DEBUG + hp2_end = hp; +#endif + + type_map = make_tuple(hp); + *(hp++) = make_arityval(ERTS_ALC_N_MAX + 1 - ERTS_ALC_N_MIN); + + for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) { + ErtsAlcType_t t = ERTS_ALC_N2T(n); + ErtsAlcType_t a = ERTS_ALC_T2A(t); + ErtsAlcType_t c = ERTS_ALC_T2C(t); + + if (!erts_allctrs_info[a].enabled) + a = ERTS_ALC_A_SYSTEM; + + *(hp++) = TUPLE3(hp2, am_n[n], am_a[a], am_c[c]); + hp2 += 4; + } + + ASSERT(hp2 == hp2_end); + + hdr_tuple = TUPLE4(hp, + am.instr_hdr, + make_small(ERTS_INSTR_VSN), + make_small(MAP_STAT_BLOCK_HEADER_SIZE), + type_map); + + hp += 5; + } + + /* Build memory data list */ + + for (md_list = NIL, bp = org_mem_anchor; bp; bp = bp->next) { + Eterm tuple; + Eterm type; + Eterm ptr; + Eterm size; + Eterm pid; + + if (is_not_internal_pid(bp->pid)) + pid = am_undefined; + else { + Eterm c; + Eterm n; + Eterm s; + +#if (ERST_INTERNAL_CHANNEL_NO > MAX_SMALL) +#error Oversized internal channel number +#endif + c = make_small(ERST_INTERNAL_CHANNEL_NO); + +#if (_PID_NUM_SIZE - 1 > MAX_SMALL) + if (internal_pid_number(bp->pid) > MAX_SMALL) { + n = uint_to_big(internal_pid_number(bp->pid), hp); + hp += BIG_UINT_HEAP_SIZE; + } + else +#endif + n = make_small(internal_pid_number(bp->pid)); + +#if (_PID_SER_SIZE - 1 > MAX_SMALL) + if (internal_pid_serial(bp->pid) > MAX_SMALL) { + s = uint_to_big(internal_pid_serial(bp->pid), hp); + hp += BIG_UINT_HEAP_SIZE; + } + else +#endif + s = make_small(internal_pid_serial(bp->pid)); + pid = TUPLE3(hp, c, n, s); + hp += 4; + } + + +#if ERTS_ALC_N_MAX > MAX_SMALL +#error Oversized memory type number +#endif + type = make_small(bp->type_no); + + if ((Uint) bp->mem > MAX_SMALL) { + ptr = uint_to_big((Uint) bp->mem, hp); + hp += BIG_UINT_HEAP_SIZE; + } + else + ptr = make_small((Uint) bp->mem); + + if (bp->size > MAX_SMALL) { + size = uint_to_big(bp->size, hp); + hp += BIG_UINT_HEAP_SIZE; + } + else + size = make_small(bp->size); + + tuple = TUPLE4(hp, type, ptr, size, pid); + hp += 5; + + md_list = CONS(hp, tuple, md_list); + hp += 2; + } + + res = TUPLE2(hp, hdr_tuple, md_list); + + ASSERT(hp + 3 == end_hp); + + if (mem_anchor) { + for (bp = mem_anchor; bp->next; bp = bp->next); + + ASSERT(org_mem_anchor); + org_mem_anchor->prev = bp; + bp->next = org_mem_anchor; + } + else { + mem_anchor = org_mem_anchor; + } + + erts_mtx_unlock(&instr_mutex); + erts_mtx_unlock(&instr_x_mutex); + + return res; +} + +static ERTS_INLINE void +begin_new_max_period(Stat_t *stat, int min, int max) +{ + int i; + for (i = min; i <= max; i++) { + stat[i].max_size = stat[i].size; + stat[i].max_blocks = stat[i].blocks; + } +} + +static ERTS_INLINE void +update_max_ever_values(Stat_t *stat, int min, int max) +{ + int i; + for (i = min; i <= max; i++) { + if (stat[i].max_size_ever < stat[i].max_size) + stat[i].max_size_ever = stat[i].max_size; + if (stat[i].max_blocks_ever < stat[i].max_blocks) + stat[i].max_blocks_ever = stat[i].max_blocks; + } +} + +#define bld_string erts_bld_string +#define bld_tuple erts_bld_tuple +#define bld_tuplev erts_bld_tuplev +#define bld_list erts_bld_list +#define bld_2tup_list erts_bld_2tup_list +#define bld_uint erts_bld_uint + +Eterm +erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period) +{ + int i, len, max, min, allctr; + Eterm *names, *values, res; + Uint arr_size, stat_size, hsz, *hszp, *hp, **hpp; + Stat_t *stat_src, *stat; + + if (!erts_instr_stat) + return am_false; + + if (!atoms_initialized) + init_atoms(); + + if (what == am.total) { + min = 0; + max = 0; + allctr = 0; + stat_size = sizeof(Stat_t); + stat_src = &stats->tot; + if (!am_tot) + init_am_tot(); + names = am_tot; + } + else if (what == am.allocators) { + min = ERTS_ALC_A_MIN; + max = ERTS_ALC_A_MAX; + allctr = 1; + stat_size = sizeof(Stat_t)*(ERTS_ALC_A_MAX+1); + stat_src = stats->a; + if (!am_a) + init_am_a(); + names = am_a; + } + else if (what == am.classes) { + min = ERTS_ALC_C_MIN; + max = ERTS_ALC_C_MAX; + allctr = 0; + stat_size = sizeof(Stat_t)*(ERTS_ALC_C_MAX+1); + stat_src = stats->c; + if (!am_c) + init_am_c(); + names = &am_c[ERTS_ALC_C_MIN]; + } + else if (what == am.types) { + min = ERTS_ALC_N_MIN; + max = ERTS_ALC_N_MAX; + allctr = 0; + stat_size = sizeof(Stat_t)*(ERTS_ALC_N_MAX+1); + stat_src = stats->n; + if (!am_n) + init_am_n(); + names = &am_n[ERTS_ALC_N_MIN]; + } + else { + return THE_NON_VALUE; + } + + stat = (Stat_t *) erts_alloc(ERTS_ALC_T_TMP, stat_size); + + arr_size = (max - min + 1)*sizeof(Eterm); + + if (allctr) + names = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, arr_size); + + values = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, arr_size); + + erts_mtx_lock(&instr_mutex); + + update_max_ever_values(stat_src, min, max); + + sys_memcpy((void *) stat, (void *) stat_src, stat_size); + + if (begin_max_period) + begin_new_max_period(stat_src, min, max); + + erts_mtx_unlock(&instr_mutex); + + hsz = 0; + hszp = &hsz; + hpp = NULL; + + restart_bld: + + len = 0; + for (i = min; i <= max; i++) { + if (!allctr || erts_allctrs_info[i].enabled) { + Eterm s[2]; + + if (allctr) + names[len] = am_a[i]; + + s[0] = bld_tuple(hpp, hszp, 4, + am.sizes, + bld_uint(hpp, hszp, stat[i].size), + bld_uint(hpp, hszp, stat[i].max_size), + bld_uint(hpp, hszp, stat[i].max_size_ever)); + + s[1] = bld_tuple(hpp, hszp, 4, + am.blocks, + bld_uint(hpp, hszp, stat[i].blocks), + bld_uint(hpp, hszp, stat[i].max_blocks), + bld_uint(hpp, hszp, stat[i].max_blocks_ever)); + + values[len] = bld_list(hpp, hszp, 2, s); + + len++; + } + } + + res = bld_2tup_list(hpp, hszp, len, names, values); + + if (!hpp) { + hp = HAlloc(proc, hsz); + hszp = NULL; + hpp = &hp; + goto restart_bld; + } + + erts_free(ERTS_ALC_T_TMP, (void *) stat); + erts_free(ERTS_ALC_T_TMP, (void *) values); + if (allctr) + erts_free(ERTS_ALC_T_TMP, (void *) names); + + return res; +} + +static void +dump_stat_to_stream(FILE *fp, int begin_max_period) +{ + ErtsAlcType_t i, a_max, a_min; + + erts_mtx_lock(&instr_mutex); + + fprintf(fp, + "{instr_vsn,%lu}.\n", + (unsigned long) ERTS_INSTR_VSN); + + update_max_ever_values(&stats->tot, 0, 0); + + fprintf(fp, + "{total,[{total,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}]}.\n", + stats->tot.size, + stats->tot.max_size, + stats->tot.max_size_ever, + stats->tot.blocks, + stats->tot.max_blocks, + stats->tot.max_blocks_ever); + + a_max = 0; + a_min = ~0; + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + if (erts_allctrs_info[i].enabled) { + if (a_min > i) + a_min = i; + if (a_max < i) + a_max = i; + } + } + + ASSERT(ERTS_ALC_A_MIN <= a_min && a_min <= ERTS_ALC_A_MAX); + ASSERT(ERTS_ALC_A_MIN <= a_max && a_max <= ERTS_ALC_A_MAX); + ASSERT(a_min <= a_max); + + update_max_ever_values(stats->a, a_min, a_max); + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + if (erts_allctrs_info[i].enabled) { + fprintf(fp, + "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s", + i == a_min ? "{allocators,\n [" : " ", + ERTS_ALC_A2AD(i), + stats->a[i].size, + stats->a[i].max_size, + stats->a[i].max_size_ever, + stats->a[i].blocks, + stats->a[i].max_blocks, + stats->a[i].max_blocks_ever, + i == a_max ? "]}.\n" : ",\n"); + } + } + + update_max_ever_values(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX); + + for (i = ERTS_ALC_C_MIN; i <= ERTS_ALC_C_MAX; i++) { + fprintf(fp, + "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s", + i == ERTS_ALC_C_MIN ? "{classes,\n [" : " ", + ERTS_ALC_C2CD(i), + stats->c[i].size, + stats->c[i].max_size, + stats->c[i].max_size_ever, + stats->c[i].blocks, + stats->c[i].max_blocks, + stats->c[i].max_blocks_ever, + i == ERTS_ALC_C_MAX ? "]}.\n" : ",\n" ); + } + + update_max_ever_values(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX); + + for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) { + fprintf(fp, + "%s{%s,[{sizes,%lu,%lu,%lu},{blocks,%lu,%lu,%lu}]}%s", + i == ERTS_ALC_N_MIN ? "{types,\n [" : " ", + ERTS_ALC_N2TD(i), + stats->n[i].size, + stats->n[i].max_size, + stats->n[i].max_size_ever, + stats->n[i].blocks, + stats->n[i].max_blocks, + stats->n[i].max_blocks_ever, + i == ERTS_ALC_N_MAX ? "]}.\n" : ",\n" ); + } + + if (begin_max_period) { + begin_new_max_period(&stats->tot, 0, 0); + begin_new_max_period(stats->a, a_min, a_max); + begin_new_max_period(stats->c, ERTS_ALC_C_MIN, ERTS_ALC_C_MAX); + begin_new_max_period(stats->n, ERTS_ALC_N_MIN, ERTS_ALC_N_MAX); + } + + erts_mtx_unlock(&instr_mutex); + +} + +int erts_instr_dump_stat_to_fd(int fd, int begin_max_period) +{ + char buf[BUFSIZ]; + FILE *fp; + + if (!erts_instr_stat) + return 0; + + fp = fdopen(fd, "w"); + if (fp == NULL) + return 0; + + /* Avoid allocating memory; we may have run out of it at this point. */ + setbuf(fp, buf); + + dump_stat_to_stream(fp, begin_max_period); + fflush(fp); + return 1; +} + +int erts_instr_dump_stat(const char *name, int begin_max_period) +{ + FILE *file; + + if (!erts_instr_stat) + return 0; + + file = fopen(name, "w"); + if (file == NULL) + return 0; + + dump_stat_to_stream(file, begin_max_period); + + fclose(file); + return 1; +} + + +Uint +erts_instr_get_total(void) +{ + return erts_instr_stat ? stats->tot.size : 0; +} + +Uint +erts_instr_get_max_total(void) +{ + if (erts_instr_stat) { + update_max_ever_values(&stats->tot, 0, 0); + return stats->tot.max_size_ever; + } + return 0; +} + +Eterm +erts_instr_get_type_info(Process *proc) +{ + Eterm res, *tpls; + Uint hsz, *hszp, *hp, **hpp; + ErtsAlcType_t n; + + if (!am_n) + init_am_n(); + if (!am_a) + init_am_a(); + if (!am_c) + init_am_c(); + + tpls = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, + (ERTS_ALC_N_MAX-ERTS_ALC_N_MIN+1) + * sizeof(Eterm)); + hsz = 0; + hszp = &hsz; + hpp = NULL; + + restart_bld: + +#if ERTS_ALC_N_MIN != 1 +#error ERTS_ALC_N_MIN is not 1 +#endif + + for (n = ERTS_ALC_N_MIN; n <= ERTS_ALC_N_MAX; n++) { + ErtsAlcType_t t = ERTS_ALC_N2T(n); + ErtsAlcType_t a = ERTS_ALC_T2A(t); + ErtsAlcType_t c = ERTS_ALC_T2C(t); + + if (!erts_allctrs_info[a].enabled) + a = ERTS_ALC_A_SYSTEM; + + tpls[n - ERTS_ALC_N_MIN] + = bld_tuple(hpp, hszp, 3, am_n[n], am_a[a], am_c[c]); + } + + res = bld_tuplev(hpp, hszp, ERTS_ALC_N_MAX-ERTS_ALC_N_MIN+1, tpls); + + if (!hpp) { + hp = HAlloc(proc, hsz); + hszp = NULL; + hpp = &hp; + goto restart_bld; + } + + erts_free(ERTS_ALC_T_TMP, tpls); + + return res; +} + +Uint +erts_instr_init(int stat, int map_stat) +{ + int i; + + am_tot = NULL; + am_n = NULL; + am_c = NULL; + am_a = NULL; + + erts_instr_memory_map = 0; + erts_instr_stat = 0; + atoms_initialized = 0; + + if (!stat && !map_stat) + return 0; + + stats = erts_alloc(ERTS_ALC_T_INSTR_INFO, sizeof(struct stats_)); + + erts_mtx_init(&instr_mutex, "instr"); + + mem_anchor = NULL; + + /* Install instrumentation functions */ + ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); + + sys_memcpy((void *)real_allctrs,(void *)erts_allctrs,sizeof(erts_allctrs)); + + sys_memzero((void *) &stats->tot, sizeof(Stat_t)); + sys_memzero((void *) stats->a, sizeof(Stat_t)*(ERTS_ALC_A_MAX+1)); + sys_memzero((void *) stats->c, sizeof(Stat_t)*(ERTS_ALC_C_MAX+1)); + sys_memzero((void *) stats->n, sizeof(Stat_t)*(ERTS_ALC_N_MAX+1)); + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + if (erts_allctrs_info[i].enabled) + stats->ap[i] = &stats->a[i]; + else + stats->ap[i] = &stats->a[ERTS_ALC_A_SYSTEM]; + } + + if (map_stat) { + + erts_mtx_init(&instr_x_mutex, "instr_x"); + + erts_instr_memory_map = 1; + erts_instr_stat = 1; + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + erts_allctrs[i].alloc = map_stat_alloc; + erts_allctrs[i].realloc = map_stat_realloc; + erts_allctrs[i].free = map_stat_free; + erts_allctrs[i].extra = (void *) &real_allctrs[i]; + } + return MAP_STAT_BLOCK_HEADER_SIZE; + } + else { + erts_instr_stat = 1; + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + erts_allctrs[i].alloc = stat_alloc; + erts_allctrs[i].realloc = stat_realloc; + erts_allctrs[i].free = stat_free; + erts_allctrs[i].extra = (void *) &real_allctrs[i]; + } + return STAT_BLOCK_HEADER_SIZE; + } + +} + diff --git a/erts/emulator/beam/erl_instrument.h b/erts/emulator/beam/erl_instrument.h new file mode 100644 index 0000000000..37b9b67139 --- /dev/null +++ b/erts/emulator/beam/erl_instrument.h @@ -0,0 +1,41 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_INSTRUMENT_H__ +#define ERL_INSTRUMENT_H__ + +#include "erl_mtrace.h" + +#define ERTS_INSTR_VSN 2 + +extern int erts_instr_memory_map; +extern int erts_instr_stat; + +Uint erts_instr_init(int stat, int map_stat); +int erts_instr_dump_memory_map_to_fd(int fd); +int erts_instr_dump_memory_map(const char *name); +Eterm erts_instr_get_memory_map(Process *process); +int erts_instr_dump_stat_to_fd(int fd, int begin_max_period); +int erts_instr_dump_stat(const char *name, int begin_max_period); +Eterm erts_instr_get_stat(Process *proc, Eterm what, int begin_max_period); +Eterm erts_instr_get_type_info(Process *proc); +Uint erts_instr_get_total(void); +Uint erts_instr_get_max_total(void); + +#endif diff --git a/erts/emulator/beam/erl_lock_check.c b/erts/emulator/beam/erl_lock_check.c new file mode 100644 index 0000000000..25f1d420d1 --- /dev/null +++ b/erts/emulator/beam/erl_lock_check.c @@ -0,0 +1,1307 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: A lock checker that checks that each thread acquires + * locks according to a predefined global lock order. The + * global lock order is used to prevent deadlocks. If the + * lock order is violated, an error message is printed + * and the emulator aborts. The lock checker is only + * intended to be enabled when debugging. + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +/* Needed for VxWorks va_arg */ +#include "sys.h" + +#ifdef ERTS_ENABLE_LOCK_CHECK + +#include "erl_lock_check.h" +#include "erl_term.h" +#include "erl_threads.h" + +typedef struct { + char *name; + char *internal_order; +} erts_lc_lock_order_t; + +/* + * Global lock order for locks in the emulator. + * + * Locks early (low indexes) in the 'erts_lock_order' array should be + * locked before locks late (high indexes) in the array. Each lock has + * a name which is set on initialization. If multiple locks with the + * same name are used, either an immediate Erlang term (e.g. internal + * pid) or the address of the lock is used for internal lock order. + * The immediate Erlang term used for internal lock order is also set + * on initialization. Locks with small immediate Erlang terms should + * be locked before locks with large immediate Erlang terms, and + * locks with small addresses should be locked before locks with + * large addresses. The immediate terms and adresses (boxed pointers) + * are compared as unsigned integers not as Erlang terms. + * + * Once a spinlock or rw(spin)lock has been locked, the thread is not + * allowed to lock mutexes, rwmutexes or process locks until all + * spinlocks and rwlocks have been unlocked. This restriction is not + * reflected by the lock order below, but the lock checker will still + * check for violations of this restriction. + */ +static erts_lc_lock_order_t erts_lock_order[] = { + /* + * "Lock name" "Internal lock order + * description (NULL + * if only one lock use + * the lock name)" + */ +#ifdef ERTS_SMP + { "driver_lock", "driver_name" }, + { "port_lock", "port_id" }, +#endif + { "port_data_lock", "address" }, +#ifdef ERTS_SMP + { "bif_timers", NULL }, + { "reg_tab", NULL }, + { "migration_info_update", NULL }, + { "proc_main", "pid" }, + { "nodes_monitors", NULL }, + { "driver_list", NULL }, + { "proc_link", "pid" }, + { "proc_msgq", "pid" }, + { "dist_entry", "address" }, + { "dist_entry_links", "address" }, + { "proc_status", "pid" }, + { "proc_tab", NULL }, + { "ports_snapshot", NULL }, + { "db_tab", "address" }, + { "db_tab_fix", "address" }, + { "meta_name_tab", "address" }, + { "meta_main_tab_slot", "address" }, + { "meta_main_tab_main", NULL }, + { "db_hash_slot", "address" }, + { "node_table", NULL }, + { "dist_table", NULL }, + { "sys_tracers", NULL }, + { "trace_pattern", NULL }, + { "module_tab", NULL }, + { "export_tab", NULL }, + { "fun_tab", NULL }, + { "environ", NULL }, +#endif + { "asyncq", "address" }, +#ifndef ERTS_SMP + { "async_ready", NULL }, +#endif + { "efile_drv", "address" }, +#if defined(ENABLE_CHILD_WAITER_THREAD) || defined(ERTS_SMP) + { "child_status", NULL }, +#endif +#ifdef __WIN32__ + { "sys_driver_data_lock", NULL }, +#endif + { "drv_ev_state_grow", NULL, }, + { "drv_ev_state", "address" }, + { "safe_hash", "address" }, + { "pollset_rm_list", NULL }, + { "removed_fd_pre_alloc_lock", NULL }, + { "state_prealloc", NULL }, + { "schdlr_sspnd", NULL }, + { "cpu_bind", NULL }, + { "run_queue", "address" }, + { "pollset", "address" }, +#ifdef __WIN32__ + { "pollwaiter", "address" }, + { "break_waiter_lock", NULL }, +#endif /* __WIN32__ */ + { "alcu_init_atoms", NULL }, + { "mseg_init_atoms", NULL }, + { "drv_tsd", NULL }, +#ifdef ERTS_SMP + { "sys_msg_q", NULL }, + { "atom_tab", NULL }, + { "make_ref", NULL }, + { "misc_op_list_pre_alloc_lock", "address" }, + { "message_pre_alloc_lock", "address" }, + { "ptimer_pre_alloc_lock", "address", }, + { "btm_pre_alloc_lock", NULL, }, + { "dist_entry_out_queue", "address" }, +#endif + { "mtrace_op", NULL }, + { "instr_x", NULL }, + { "instr", NULL }, + { "fix_alloc", "index" }, + { "alcu_allocator", "index" }, + { "mseg", NULL }, +#ifdef ERTS_SMP + { "port_task_pre_alloc_lock", "address" }, + { "port_taskq_pre_alloc_lock", "address" }, + { "proclist_pre_alloc_lock", "address" }, + { "port_tasks_lock", NULL }, + { "get_free_port", NULL }, + { "port_state", "address" }, + { "xports_list_pre_alloc_lock", "address" }, + { "inet_buffer_stack_lock", NULL }, + { "gc_info", NULL }, + { "io_wake", NULL }, + { "timer_wheel", NULL }, + { "system_block", NULL }, + { "timeofday", NULL }, + { "breakpoints", NULL }, + { "pollsets_lock", NULL }, + { "async_id", NULL }, + { "pix_lock", "address" }, + { "run_queues_lists", NULL }, + { "sched_stat", NULL }, +#endif + { "alloc_thr_ix_lock", NULL }, +#ifdef ERTS_SMP + { "proc_lck_wtr_alloc", NULL }, +#endif +#ifdef __WIN32__ +#ifdef DEBUG + { "save_ops_lock", NULL }, +#endif +#endif + { "mtrace_buf", NULL } +}; + +#define ERTS_LOCK_ORDER_SIZE \ + (sizeof(erts_lock_order)/sizeof(erts_lc_lock_order_t)) + +#define LOCK_IS_TYPE_ORDER_VIOLATION(LCK_FLG, LCKD_FLG) \ + (((LCKD_FLG) & (ERTS_LC_FLG_LT_SPINLOCK|ERTS_LC_FLG_LT_RWSPINLOCK)) \ + && ((LCK_FLG) \ + & ERTS_LC_FLG_LT_ALL \ + & ~(ERTS_LC_FLG_LT_SPINLOCK|ERTS_LC_FLG_LT_RWSPINLOCK))) + +static char * +lock_type(Uint16 flags) +{ + switch (flags & ERTS_LC_FLG_LT_ALL) { + case ERTS_LC_FLG_LT_SPINLOCK: return "[spinlock]"; + case ERTS_LC_FLG_LT_RWSPINLOCK: return "[rw(spin)lock]"; + case ERTS_LC_FLG_LT_MUTEX: return "[mutex]"; + case ERTS_LC_FLG_LT_RWMUTEX: return "[rwmutex]"; + case ERTS_LC_FLG_LT_PROCLOCK: return "[proclock]"; + default: return ""; + } +} + +static char * +rw_op_str(Uint16 flags) +{ + switch (flags & ERTS_LC_FLG_LO_READ_WRITE) { + case ERTS_LC_FLG_LO_READ_WRITE: + return " (rw)"; + case ERTS_LC_FLG_LO_READ: + return " (r)"; + case ERTS_LC_FLG_LO_WRITE: + erts_fprintf(stderr, "\nInternal error\n"); + abort(); + default: + break; + } + return ""; +} + +typedef struct erts_lc_locked_lock_t_ erts_lc_locked_lock_t; +struct erts_lc_locked_lock_t_ { + erts_lc_locked_lock_t *next; + erts_lc_locked_lock_t *prev; + Eterm extra; + Sint16 id; + Uint16 flags; +}; + +typedef struct { + erts_lc_locked_lock_t *first; + erts_lc_locked_lock_t *last; +} erts_lc_locked_lock_list_t; + +typedef struct erts_lc_locked_locks_t_ erts_lc_locked_locks_t; +struct erts_lc_locked_locks_t_ { + char *thread_name; + erts_tid_t tid; + erts_lc_locked_locks_t *next; + erts_lc_locked_locks_t *prev; + erts_lc_locked_lock_list_t locked; + erts_lc_locked_lock_list_t required; +}; + +typedef union erts_lc_free_block_t_ erts_lc_free_block_t; +union erts_lc_free_block_t_ { + erts_lc_free_block_t *next; + erts_lc_locked_lock_t lock; +}; + +static ethr_tsd_key locks_key; + +static erts_lc_locked_locks_t *erts_locked_locks; + +static erts_lc_free_block_t *free_blocks; + +#ifdef ERTS_LC_STATIC_ALLOC +#define ERTS_LC_FB_CHUNK_SIZE 10000 +#else +#define ERTS_LC_FB_CHUNK_SIZE 10 +#endif + +#ifdef ETHR_HAVE_NATIVE_LOCKS +static ethr_spinlock_t free_blocks_lock; +#define ERTS_LC_LOCK ethr_spin_lock +#define ERTS_LC_UNLOCK ethr_spin_unlock +#else +static ethr_mutex free_blocks_lock; +#define ERTS_LC_LOCK ethr_mutex_lock +#define ERTS_LC_UNLOCK ethr_mutex_unlock +#endif + +static ERTS_INLINE void +lc_lock(void) +{ + if (ERTS_LC_LOCK(&free_blocks_lock) != 0) + abort(); +} + +static ERTS_INLINE void +lc_unlock(void) +{ + if (ERTS_LC_UNLOCK(&free_blocks_lock) != 0) + abort(); +} + +static ERTS_INLINE void lc_free(void *p) +{ + erts_lc_free_block_t *fb = (erts_lc_free_block_t *) p; +#ifdef DEBUG + memset((void *) p, 0xdf, sizeof(erts_lc_free_block_t)); +#endif + lc_lock(); + fb->next = free_blocks; + free_blocks = fb; + lc_unlock(); +} + +#ifdef ERTS_LC_STATIC_ALLOC + +static void *lc_core_alloc(void) +{ + lc_unlock(); + erts_fprintf(stderr, "Lock checker out of memory!\n"); + abort(); +} + +#else + +static void *lc_core_alloc(void) +{ + int i; + erts_lc_free_block_t *fbs; + lc_unlock(); + fbs = (erts_lc_free_block_t *) malloc(sizeof(erts_lc_free_block_t) + * ERTS_LC_FB_CHUNK_SIZE); + if (!fbs) { + erts_fprintf(stderr, "Lock checker failed to allocate memory!\n"); + abort(); + } + for (i = 1; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) { +#ifdef DEBUG + memset((void *) &fbs[i], 0xdf, sizeof(erts_lc_free_block_t)); +#endif + fbs[i].next = &fbs[i+1]; + } +#ifdef DEBUG + memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1], + 0xdf, sizeof(erts_lc_free_block_t)); +#endif + lc_lock(); + fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = free_blocks; + free_blocks = &fbs[1]; + return (void *) &fbs[0]; +} + +#endif + +static ERTS_INLINE void *lc_alloc(void) +{ + void *res; + lc_lock(); + if (!free_blocks) + res = lc_core_alloc(); + else { + res = (void *) free_blocks; + free_blocks = free_blocks->next; + } + lc_unlock(); + return res; +} + + +static erts_lc_locked_locks_t * +create_locked_locks(char *thread_name) +{ + erts_lc_locked_locks_t *l_lcks = malloc(sizeof(erts_lc_locked_locks_t)); + if (!l_lcks) + abort(); + + l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown"); + if (!l_lcks->thread_name) + abort(); + + l_lcks->tid = erts_thr_self(); + l_lcks->required.first = NULL; + l_lcks->required.last = NULL; + l_lcks->locked.first = NULL; + l_lcks->locked.last = NULL; + l_lcks->prev = NULL; + lc_lock(); + l_lcks->next = erts_locked_locks; + if (erts_locked_locks) + erts_locked_locks->prev = l_lcks; + erts_locked_locks = l_lcks; + lc_unlock(); + erts_tsd_set(locks_key, (void *) l_lcks); + return l_lcks; +} + +static void +destroy_locked_locks(erts_lc_locked_locks_t *l_lcks) +{ + ASSERT(l_lcks->thread_name); + free((void *) l_lcks->thread_name); + ASSERT(l_lcks->required.first == NULL); + ASSERT(l_lcks->required.last == NULL); + ASSERT(l_lcks->locked.first == NULL); + ASSERT(l_lcks->locked.last == NULL); + + lc_lock(); + if (l_lcks->prev) + l_lcks->prev->next = l_lcks->next; + else { + ASSERT(erts_locked_locks == l_lcks); + erts_locked_locks = l_lcks->next; + } + + if (l_lcks->next) + l_lcks->next->prev = l_lcks->prev; + lc_unlock(); + + free((void *) l_lcks); + +} + +static ERTS_INLINE erts_lc_locked_locks_t * +get_my_locked_locks(void) +{ + return erts_tsd_get(locks_key); +} + +static ERTS_INLINE erts_lc_locked_locks_t * +make_my_locked_locks(void) +{ + erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + if (l_lcks) + return l_lcks; + else + return create_locked_locks(NULL); +} + +static ERTS_INLINE erts_lc_locked_lock_t * +new_locked_lock(erts_lc_lock_t *lck, Uint16 op_flags) +{ + erts_lc_locked_lock_t *l_lck = (erts_lc_locked_lock_t *) lc_alloc(); + l_lck->next = NULL; + l_lck->prev = NULL; + l_lck->id = lck->id; + l_lck->extra = lck->extra; + l_lck->flags = lck->flags | op_flags; + return l_lck; +} + +static void +print_lock2(char *prefix, Sint16 id, Eterm extra, Uint16 flags, char *suffix) +{ + char *lname = (0 <= id && id < ERTS_LOCK_ORDER_SIZE + ? erts_lock_order[id].name + : "unknown"); + if (is_boxed(extra)) + erts_fprintf(stderr, + "%s'%s:%p%s'%s%s", + prefix, + lname, + boxed_val(extra), + lock_type(flags), + rw_op_str(flags), + suffix); + else + erts_fprintf(stderr, + "%s'%s:%T%s'%s%s", + prefix, + lname, + extra, + lock_type(flags), + rw_op_str(flags), + suffix); +} + +static void +print_lock(char *prefix, erts_lc_lock_t *lck, char *suffix) +{ + print_lock2(prefix, lck->id, lck->extra, lck->flags, suffix); +} + +static void +print_curr_locks(erts_lc_locked_locks_t *l_lcks) +{ + erts_lc_locked_lock_t *l_lck; + if (!l_lcks || !l_lcks->locked.first) + erts_fprintf(stderr, + "Currently no locks are locked by the %s thread.\n", + l_lcks->thread_name); + else { + erts_fprintf(stderr, + "Currently these locks are locked by the %s thread:\n", + l_lcks->thread_name); + for (l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) + print_lock2(" ", l_lck->id, l_lck->extra, l_lck->flags, "\n"); + } +} + +static void +print_lock_order(void) +{ + int i; + erts_fprintf(stderr, "Lock order:\n"); + for (i = 1; i < ERTS_LOCK_ORDER_SIZE; i++) { + if (erts_lock_order[i].internal_order) + erts_fprintf(stderr, + " %s:%s\n", + erts_lock_order[i].name, + erts_lock_order[i].internal_order); + else + erts_fprintf(stderr, " %s\n", erts_lock_order[i].name); + } +} + +static void +uninitialized_lock(void) +{ + erts_fprintf(stderr, "Performing operations on uninitialized lock!\n"); + print_curr_locks(get_my_locked_locks()); + abort(); +} + +static void +lock_twice(char *prefix, erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck, + Uint16 op_flags) +{ + erts_fprintf(stderr, "%s%s", prefix, rw_op_str(op_flags)); + print_lock(" ", lck, " lock which is already locked by thread!\n"); + print_curr_locks(l_lcks); + abort(); +} + +static void +unlock_op_mismatch(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck, + Uint16 op_flags) +{ + erts_fprintf(stderr, "Unlocking%s ", rw_op_str(op_flags)); + print_lock("", lck, " lock which mismatch previous lock operation!\n"); + print_curr_locks(l_lcks); + abort(); +} + +static void +unlock_of_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +{ + print_lock("Unlocking ", lck, " lock which is not locked by thread!\n"); + print_curr_locks(l_lcks); + abort(); +} + +static void +lock_order_violation(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +{ + print_lock("Lock order violation occured when locking ", lck, "!\n"); + print_curr_locks(l_lcks); + print_lock_order(); + abort(); +} + +static void +type_order_violation(char *op, erts_lc_locked_locks_t *l_lcks, + erts_lc_lock_t *lck) +{ + erts_fprintf(stderr, "Lock type order violation occured when "); + print_lock(op, lck, "!\n"); + ASSERT(l_lcks); + print_curr_locks(l_lcks); + abort(); +} + +static void +lock_mismatch(erts_lc_locked_locks_t *l_lcks, int exact, + int failed_have, erts_lc_lock_t *have, int have_len, + int failed_have_not, erts_lc_lock_t *have_not, int have_not_len) +{ + int i; + erts_fprintf(stderr, "Lock mismatch found!\n"); + if (failed_have >= 0) { + ASSERT(have && have_len > failed_have); + print_lock2("At least the ", + have[failed_have].id, have[failed_have].extra, 0, + " lock is not locked when it should have been\n"); + } + else if (failed_have_not >= 0) { + ASSERT(have_not && have_not_len > failed_have_not); + print_lock2("At least the ", + have_not[failed_have_not].id, + have_not[failed_have_not].extra, + 0, + " lock is locked when it should not have been\n"); + } + if (exact) { + if (!have || have_len <= 0) + erts_fprintf(stderr, + "Thread should not have any locks locked at all\n"); + else { + erts_fprintf(stderr, + "Thread should have these and only these locks " + "locked:\n"); + for (i = 0; i < have_len; i++) + print_lock2(" ", have[i].id, have[i].extra, 0, "\n"); + } + } + else { + if (have && have_len > 0) { + erts_fprintf(stderr, + "Thread should at least have these locks locked:\n"); + for (i = 0; i < have_len; i++) + print_lock2(" ", have[i].id, have[i].extra, 0, "\n"); + } + if (have_not && have_not_len > 0) { + erts_fprintf(stderr, + "Thread should at least not have these locks " + "locked:\n"); + for (i = 0; i < have_not_len; i++) + print_lock2(" ", have_not[i].id, have_not[i].extra, 0, "\n"); + } + } + print_curr_locks(l_lcks); + abort(); +} + +static void +unlock_of_required_lock(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +{ + print_lock("Unlocking required ", lck, " lock!\n"); + print_curr_locks(l_lcks); + abort(); +} + +static void +unrequire_of_not_required_lock(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +{ + print_lock("Unrequire on ", lck, " lock not required!\n"); + print_curr_locks(l_lcks); + abort(); +} + +static void +require_twice(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +{ + print_lock("Require on ", lck, " lock already required!\n"); + print_curr_locks(l_lcks); + abort(); +} + +static void +required_not_locked(erts_lc_locked_locks_t *l_lcks, erts_lc_lock_t *lck) +{ + print_lock("Required ", lck, " lock not locked!\n"); + print_curr_locks(l_lcks); + abort(); +} + + +static void +thread_exit_handler(void) +{ + erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + if (l_lcks) { + if (l_lcks->locked.first) { + erts_fprintf(stderr, + "Thread exiting while having locked locks!\n"); + print_curr_locks(l_lcks); + abort(); + } + destroy_locked_locks(l_lcks); + /* erts_tsd_set(locks_key, NULL); */ + } +} + +void +erts_lc_set_thread_name(char *thread_name) +{ + erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + if (!l_lcks) + (void) create_locked_locks(thread_name); + else { + ASSERT(l_lcks->thread_name); + free((void *) l_lcks->thread_name); + l_lcks->thread_name = strdup(thread_name ? thread_name : "unknown"); + if (!l_lcks->thread_name) + abort(); + } +} + +int +erts_lc_assert_failed(char *file, int line, char *assertion) +{ + erts_fprintf(stderr, "%s:%d: Lock check assertion \"%s\" failed!\n", + file, line, assertion); + print_curr_locks(get_my_locked_locks()); + abort(); + return 0; +} + +void erts_lc_fail(char *fmt, ...) +{ + va_list args; + erts_fprintf(stderr, "Lock check failed: "); + va_start(args, fmt); + erts_vfprintf(stderr, fmt, args); + va_end(args); + erts_fprintf(stderr, "\n"); + print_curr_locks(get_my_locked_locks()); + abort(); +} + + +Sint16 +erts_lc_get_lock_order_id(char *name) +{ + int i; + + if (!name || name[0] == '\0') + erts_fprintf(stderr, "Missing lock name\n"); + else { + for (i = 0; i < ERTS_LOCK_ORDER_SIZE; i++) + if (strcmp(erts_lock_order[i].name, name) == 0) + return i; + erts_fprintf(stderr, + "Lock name '%s' missing in lock order " + "(update erl_lock_check.c)\n", + name); + } + abort(); + return (Sint16) -1; +} + + +static int +find_lock(erts_lc_locked_lock_t **l_lcks, erts_lc_lock_t *lck) +{ + erts_lc_locked_lock_t *l_lck = *l_lcks; + + if (l_lck) { + if (l_lck->id == lck->id && l_lck->extra == lck->extra) { + if ((l_lck->flags & lck->flags) == lck->flags) + return 1; + return 0; + } + else if (l_lck->id < lck->id + || (l_lck->id == lck->id + && l_lck->extra < lck->extra)) { + for (l_lck = l_lck->next; l_lck; l_lck = l_lck->next) { + if (l_lck->id > lck->id + || (l_lck->id == lck->id + && l_lck->extra >= lck->extra)) { + *l_lcks = l_lck; + if (l_lck->id == lck->id + && l_lck->extra == lck->extra + && ((l_lck->flags & lck->flags) == lck->flags)) + return 1; + return 0; + } + } + } + else { + for (l_lck = l_lck->prev; l_lck; l_lck = l_lck->prev) { + if (l_lck->id < lck->id + || (l_lck->id == lck->id + && l_lck->extra <= lck->extra)) { + *l_lcks = l_lck; + if (l_lck->id == lck->id + && l_lck->extra == lck->extra + && ((l_lck->flags & lck->flags) == lck->flags)) + return 1; + return 0; + } + } + } + } + return 0; +} + +static int +find_id(erts_lc_locked_lock_t **l_lcks, Sint16 id) +{ + erts_lc_locked_lock_t *l_lck = *l_lcks; + + if (l_lck) { + if (l_lck->id == id) + return 1; + else if (l_lck->id < id) { + for (l_lck = l_lck->next; l_lck; l_lck = l_lck->next) { + if (l_lck->id >= id) { + *l_lcks = l_lck; + if (l_lck->id == id) + return 1; + return 0; + } + } + } + else { + for (l_lck = l_lck->prev; l_lck; l_lck = l_lck->prev) { + if (l_lck->id <= id) { + *l_lcks = l_lck; + if (l_lck->id == id) + return 1; + return 0; + } + } + } + } + return 0; +} + +void +erts_lc_have_locks(int *resv, erts_lc_lock_t *locks, int len) +{ + erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + int i; + + if (!l_lcks) { + for (i = 0; i < len; i++) + resv[i] = 0; + } + else { + erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; + for (i = 0; i < len; i++) + resv[i] = find_lock(&l_lck, &locks[i]); + } +} + +void +erts_lc_have_lock_ids(int *resv, int *ids, int len) +{ + erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + int i; + + if (!l_lcks) { + for (i = 0; i < len; i++) + resv[i] = 0; + } + else { + erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; + for (i = 0; i < len; i++) + resv[i] = find_id(&l_lck, ids[i]); + } +} + +void +erts_lc_check(erts_lc_lock_t *have, int have_len, + erts_lc_lock_t *have_not, int have_not_len) +{ + int i; + erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + erts_lc_locked_lock_t *l_lck; + + if (have && have_len > 0) { + if (!l_lcks) + lock_mismatch(NULL, 0, + -1, have, have_len, + -1, have_not, have_not_len); + l_lck = l_lcks->locked.first; + for (i = 0; i < have_len; i++) { + if (!find_lock(&l_lck, &have[i])) + lock_mismatch(l_lcks, 0, + i, have, have_len, + -1, have_not, have_not_len); + } + } + if (have_not && have_not_len > 0 && l_lcks) { + l_lck = l_lcks->locked.first; + for (i = 0; i < have_not_len; i++) { + if (find_lock(&l_lck, &have_not[i])) + lock_mismatch(l_lcks, 0, + -1, have, have_len, + i, have_not, have_not_len); + } + } +} + +void +erts_lc_check_exact(erts_lc_lock_t *have, int have_len) +{ + erts_lc_locked_locks_t *l_lcks = get_my_locked_locks(); + if (!l_lcks) { + if (have && have_len > 0) + lock_mismatch(NULL, 1, + -1, have, have_len, + -1, NULL, 0); + } + else { + int i; + erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; + for (i = 0; i < have_len; i++) { + if (!find_lock(&l_lck, &have[i])) + lock_mismatch(l_lcks, 1, + i, have, have_len, + -1, NULL, 0); + } + for (i = 0, l_lck = l_lcks->locked.first; l_lck; l_lck = l_lck->next) + i++; + if (i != have_len) + lock_mismatch(l_lcks, 1, + -1, have, have_len, + -1, NULL, 0); + } +} + +int +erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags) +{ +#ifdef ERTS_LC_DO_NOT_FORCE_BUSY_TRYLOCK_ON_LOCK_ORDER_VIOLATION + return 0; +#else + /* + * Force busy trylock if locking doesn't follow lock order. + * This in order to make sure that caller can handle + * the situation without causing a lock order violation. + */ + erts_lc_locked_locks_t *l_lcks; + + if (lck->inited != ERTS_LC_INITITALIZED) + uninitialized_lock(); + + if (lck->id < 0) + return 0; + + l_lcks = get_my_locked_locks(); + + if (!l_lcks || !l_lcks->locked.first) { + ASSERT(!l_lcks || !l_lcks->locked.last); + return 0; + } + else { + erts_lc_locked_lock_t *tl_lck; + + ASSERT(l_lcks->locked.last); + +#if 0 /* Ok when trylocking I guess... */ + if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags)) + type_order_violation("trylocking ", l_lcks, lck); +#endif + + if (l_lcks->locked.last->id < lck->id + || (l_lcks->locked.last->id == lck->id + && l_lcks->locked.last->extra < lck->extra)) + return 0; + + /* + * Lock order violation + */ + + + /* Check that we are not trying to lock this lock twice */ + for (tl_lck = l_lcks->locked.last; tl_lck; tl_lck = tl_lck->prev) { + if (tl_lck->id < lck->id + || (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) { + if (tl_lck->id == lck->id && tl_lck->extra == lck->extra) + lock_twice("Trylocking", l_lcks, lck, op_flags); + break; + } + } + +#ifndef ERTS_LC_ALLWAYS_FORCE_BUSY_TRYLOCK_ON_LOCK_ORDER_VIOLATION + /* We only force busy if a lock order violation would occur + and when on an even millisecond. */ + { + erts_thr_timeval_t time; + erts_thr_time_now(&time); + + if ((time.tv_nsec / 1000000) & 1) + return 0; + } +#endif + + return 1; + } +#endif +} + +void erts_lc_trylock_flg(int locked, erts_lc_lock_t *lck, Uint16 op_flags) +{ + erts_lc_locked_locks_t *l_lcks; + erts_lc_locked_lock_t *l_lck; + + if (lck->inited != ERTS_LC_INITITALIZED) + uninitialized_lock(); + + if (lck->id < 0) + return; + + l_lcks = make_my_locked_locks(); + l_lck = locked ? new_locked_lock(lck, op_flags) : NULL; + + if (!l_lcks->locked.last) { + ASSERT(!l_lcks->locked.first); + if (locked) + l_lcks->locked.first = l_lcks->locked.last = l_lck; + } + else { + erts_lc_locked_lock_t *tl_lck; +#if 0 /* Ok when trylocking I guess... */ + if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags)) + type_order_violation("trylocking ", l_lcks, lck); +#endif + + for (tl_lck = l_lcks->locked.last; tl_lck; tl_lck = tl_lck->prev) { + if (tl_lck->id < lck->id + || (tl_lck->id == lck->id && tl_lck->extra <= lck->extra)) { + if (tl_lck->id == lck->id && tl_lck->extra == lck->extra) + lock_twice("Trylocking", l_lcks, lck, op_flags); + if (locked) { + l_lck->next = tl_lck->next; + l_lck->prev = tl_lck; + if (tl_lck->next) + tl_lck->next->prev = l_lck; + else + l_lcks->locked.last = l_lck; + tl_lck->next = l_lck; + } + return; + } + } + + if (locked) { + l_lck->next = l_lcks->locked.first; + l_lcks->locked.first->prev = l_lck; + l_lcks->locked.first = l_lck; + } + } + +} + +void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags) +{ + erts_lc_locked_locks_t *l_lcks = make_my_locked_locks(); + erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; + if (!find_lock(&l_lck, lck)) + required_not_locked(l_lcks, lck); + l_lck = new_locked_lock(lck, op_flags); + if (!l_lcks->required.last) { + ASSERT(!l_lcks->required.first); + l_lck->next = l_lck->prev = NULL; + l_lcks->required.first = l_lcks->required.last = l_lck; + } + else { + erts_lc_locked_lock_t *l_lck2; + ASSERT(l_lcks->required.first); + for (l_lck2 = l_lcks->required.last; + l_lck2; + l_lck2 = l_lck2->prev) { + if (l_lck2->id < lck->id + || (l_lck2->id == lck->id && l_lck2->extra < lck->extra)) + break; + else if (l_lck2->id == lck->id && l_lck2->extra == lck->extra) + require_twice(l_lcks, lck); + } + if (!l_lck2) { + l_lck->next = l_lcks->required.first; + l_lck->prev = NULL; + l_lcks->required.first->prev = l_lck; + l_lcks->required.first = l_lck; + } + else { + l_lck->next = l_lck2->next; + if (l_lck->next) { + ASSERT(l_lcks->required.last != l_lck2); + l_lck->next->prev = l_lck; + } + else { + ASSERT(l_lcks->required.last == l_lck2); + l_lcks->required.last = l_lck; + } + l_lck->prev = l_lck2; + l_lck2->next = l_lck; + } + } +} + +void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags) +{ + erts_lc_locked_locks_t *l_lcks = make_my_locked_locks(); + erts_lc_locked_lock_t *l_lck = l_lcks->locked.first; + if (!find_lock(&l_lck, lck)) + required_not_locked(l_lcks, lck); + l_lck = l_lcks->required.first; + if (!find_lock(&l_lck, lck)) + unrequire_of_not_required_lock(l_lcks, lck); + if (l_lck->prev) { + ASSERT(l_lcks->required.first != l_lck); + l_lck->prev->next = l_lck->next; + } + else { + ASSERT(l_lcks->required.first == l_lck); + l_lcks->required.first = l_lck->next; + } + if (l_lck->next) { + ASSERT(l_lcks->required.last != l_lck); + l_lck->next->prev = l_lck->prev; + } + else { + ASSERT(l_lcks->required.last == l_lck); + l_lcks->required.last = l_lck->prev; + } + lc_free((void *) l_lck); +} + +void erts_lc_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags) +{ + erts_lc_locked_locks_t *l_lcks; + erts_lc_locked_lock_t *l_lck; + + if (lck->inited != ERTS_LC_INITITALIZED) + uninitialized_lock(); + + if (lck->id < 0) + return; + + l_lcks = make_my_locked_locks(); + l_lck = new_locked_lock(lck, op_flags); + + if (!l_lcks->locked.last) { + ASSERT(!l_lcks->locked.first); + l_lcks->locked.last = l_lcks->locked.first = l_lck; + } + else if (l_lcks->locked.last->id < lck->id + || (l_lcks->locked.last->id == lck->id + && l_lcks->locked.last->extra < lck->extra)) { + if (LOCK_IS_TYPE_ORDER_VIOLATION(lck->flags, l_lcks->locked.last->flags)) + type_order_violation("locking ", l_lcks, lck); + l_lck->prev = l_lcks->locked.last; + l_lcks->locked.last->next = l_lck; + l_lcks->locked.last = l_lck; + } + else if (l_lcks->locked.last->id == lck->id && l_lcks->locked.last->extra == lck->extra) + lock_twice("Locking", l_lcks, lck, op_flags); + else + lock_order_violation(l_lcks, lck); +} + +void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags) +{ + erts_lc_locked_locks_t *l_lcks; + erts_lc_locked_lock_t *l_lck; + + if (lck->inited != ERTS_LC_INITITALIZED) + uninitialized_lock(); + + if (lck->id < 0) + return; + + l_lcks = get_my_locked_locks(); + + if (l_lcks) { + l_lck = l_lcks->required.first; + if (find_lock(&l_lck, lck)) + unlock_of_required_lock(l_lcks, lck); + } + + for (l_lck = l_lcks ? l_lcks->locked.last : NULL; l_lck; l_lck = l_lck->prev) { + if (l_lck->id == lck->id && l_lck->extra == lck->extra) { + if ((l_lck->flags & ERTS_LC_FLG_LO_ALL) != op_flags) + unlock_op_mismatch(l_lcks, lck, op_flags); + if (l_lck->prev) + l_lck->prev->next = l_lck->next; + else + l_lcks->locked.first = l_lck->next; + if (l_lck->next) + l_lck->next->prev = l_lck->prev; + else + l_lcks->locked.last = l_lck->prev; + lc_free((void *) l_lck); + return; + } + } + + unlock_of_not_locked(l_lcks, lck); +} + +void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags) +{ + erts_lc_locked_locks_t *l_lcks; + erts_lc_locked_lock_t *l_lck; + + if (lck->inited != ERTS_LC_INITITALIZED) + uninitialized_lock(); + + if (lck->id < 0) + return; + + l_lcks = get_my_locked_locks(); + + if (l_lcks) { + l_lck = l_lcks->required.first; + if (find_lock(&l_lck, lck)) + unlock_of_required_lock(l_lcks, lck); + } + + l_lck = l_lcks->locked.first; + if (!find_lock(&l_lck, lck)) + unlock_of_not_locked(l_lcks, lck); +} + +int +erts_lc_trylock_force_busy(erts_lc_lock_t *lck) +{ + return erts_lc_trylock_force_busy_flg(lck, 0); +} + +void +erts_lc_trylock(int locked, erts_lc_lock_t *lck) +{ + erts_lc_trylock_flg(locked, lck, 0); +} + +void +erts_lc_lock(erts_lc_lock_t *lck) +{ + erts_lc_lock_flg(lck, 0); +} + +void +erts_lc_unlock(erts_lc_lock_t *lck) +{ + erts_lc_unlock_flg(lck, 0); +} + +void erts_lc_might_unlock(erts_lc_lock_t *lck) +{ + erts_lc_might_unlock_flg(lck, 0); +} + +void erts_lc_require_lock(erts_lc_lock_t *lck) +{ + erts_lc_require_lock_flg(lck, 0); +} + +void erts_lc_unrequire_lock(erts_lc_lock_t *lck) +{ + erts_lc_unrequire_lock_flg(lck, 0); +} + +void +erts_lc_init_lock(erts_lc_lock_t *lck, char *name, Uint16 flags) +{ + lck->id = erts_lc_get_lock_order_id(name); + lck->extra = make_boxed(&lck->extra); + lck->flags = flags; + lck->inited = ERTS_LC_INITITALIZED; +} + +void +erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, Uint16 flags, Eterm extra) +{ + lck->id = erts_lc_get_lock_order_id(name); + lck->extra = extra; + lck->flags = flags; + lck->inited = ERTS_LC_INITITALIZED; +} + +void +erts_lc_destroy_lock(erts_lc_lock_t *lck) +{ + if (lck->inited != ERTS_LC_INITITALIZED) + uninitialized_lock(); + + lck->inited = 0; + lck->id = -1; + lck->extra = THE_NON_VALUE; + lck->flags = 0; +} + +void +erts_lc_init(void) +{ +#ifdef ERTS_LC_STATIC_ALLOC + int i; + static erts_lc_free_block_t fbs[ERTS_LC_FB_CHUNK_SIZE]; + for (i = 0; i < ERTS_LC_FB_CHUNK_SIZE - 1; i++) { +#ifdef DEBUG + memset((void *) &fbs[i], 0xdf, sizeof(erts_lc_free_block_t)); +#endif + fbs[i].next = &fbs[i+1]; + } +#ifdef DEBUG + memset((void *) &fbs[ERTS_LC_FB_CHUNK_SIZE-1], + 0xdf, sizeof(erts_lc_free_block_t)); +#endif + fbs[ERTS_LC_FB_CHUNK_SIZE-1].next = NULL; + free_blocks = &fbs[0]; +#else /* #ifdef ERTS_LC_STATIC_ALLOC */ + free_blocks = NULL; +#endif /* #ifdef ERTS_LC_STATIC_ALLOC */ + +#ifdef ETHR_HAVE_NATIVE_LOCKS + if (ethr_spinlock_init(&free_blocks_lock) != 0) + abort(); +#else + if (ethr_mutex_init(&free_blocks_lock) != 0) + abort(); +#endif + + erts_tsd_key_create(&locks_key); +} + +void +erts_lc_late_init(void) +{ + erts_thr_install_exit_handler(thread_exit_handler); +} + + +/* + * erts_lc_pll(): print locked locks... + */ +void +erts_lc_pll(void) +{ + print_curr_locks(get_my_locked_locks()); +} + + +#endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */ diff --git a/erts/emulator/beam/erl_lock_check.h b/erts/emulator/beam/erl_lock_check.h new file mode 100644 index 0000000000..d5e2ede9ac --- /dev/null +++ b/erts/emulator/beam/erl_lock_check.h @@ -0,0 +1,117 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: A lock checker that checks that each thread acquires + * locks according to a predefined global lock order. The + * global lock order is used to prevent deadlocks. If the + * lock order is violated, an error message is printed + * and the emulator aborts. The lock checker is only + * intended to be enabled when debugging. + * + * Author: Rickard Green + */ + +#include "sys.h" + +#ifndef ERTS_LOCK_CHECK_H__ +#define ERTS_LOCK_CHECK_H__ + +#ifdef ERTS_ENABLE_LOCK_CHECK + +typedef struct { + int inited; + Sint16 id; + Uint16 flags; + Eterm extra; +} erts_lc_lock_t; + +#define ERTS_LC_INITITALIZED 0x7f7f7f7f + + +#define ERTS_LC_FLG_LT_SPINLOCK (((Uint16) 1) << 0) +#define ERTS_LC_FLG_LT_RWSPINLOCK (((Uint16) 1) << 1) +#define ERTS_LC_FLG_LT_MUTEX (((Uint16) 1) << 2) +#define ERTS_LC_FLG_LT_RWMUTEX (((Uint16) 1) << 3) +#define ERTS_LC_FLG_LT_PROCLOCK (((Uint16) 1) << 4) + +#define ERTS_LC_FLG_LO_READ (((Uint16) 1) << 5) +#define ERTS_LC_FLG_LO_WRITE (((Uint16) 1) << 6) + +#define ERTS_LC_FLG_LO_READ_WRITE (ERTS_LC_FLG_LO_READ \ + | ERTS_LC_FLG_LO_WRITE) + +#define ERTS_LC_FLG_LT_ALL (ERTS_LC_FLG_LT_SPINLOCK \ + | ERTS_LC_FLG_LT_RWSPINLOCK \ + | ERTS_LC_FLG_LT_MUTEX \ + | ERTS_LC_FLG_LT_RWMUTEX \ + | ERTS_LC_FLG_LT_PROCLOCK) + +#define ERTS_LC_FLG_LO_ALL (ERTS_LC_FLG_LO_READ \ + | ERTS_LC_FLG_LO_WRITE) + + +#define ERTS_LC_LOCK_INIT(ID, X, F) {ERTS_LC_INITITALIZED, (ID), (F), (X)} + +void erts_lc_init(void); +void erts_lc_late_init(void); +Sint16 erts_lc_get_lock_order_id(char *name); +void erts_lc_check(erts_lc_lock_t *have, int have_len, + erts_lc_lock_t *have_not, int have_not_len); +void erts_lc_check_exact(erts_lc_lock_t *have, int have_len); +void erts_lc_have_locks(int *resv, erts_lc_lock_t *lcks, int len); +void erts_lc_have_lock_ids(int *resv, int *ids, int len); +int erts_lc_trylock_force_busy_flg(erts_lc_lock_t *lck, Uint16 op_flags); +void erts_lc_trylock_flg(int locked, erts_lc_lock_t *lck, Uint16 op_flags); +void erts_lc_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags); +void erts_lc_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags); +void erts_lc_might_unlock_flg(erts_lc_lock_t *lck, Uint16 op_flags); +int erts_lc_trylock_force_busy(erts_lc_lock_t *lck); +void erts_lc_trylock(int locked, erts_lc_lock_t *lck); +void erts_lc_lock(erts_lc_lock_t *lck); +void erts_lc_unlock(erts_lc_lock_t *lck); +void erts_lc_might_unlock(erts_lc_lock_t *lck); +void erts_lc_init_lock(erts_lc_lock_t *lck, char *name, Uint16 flags); +void erts_lc_init_lock_x(erts_lc_lock_t *lck, char *name, Uint16 flags, Eterm extra); +void erts_lc_destroy_lock(erts_lc_lock_t *lck); +void erts_lc_fail(char *fmt, ...); +int erts_lc_assert_failed(char *file, int line, char *assertion); +void erts_lc_set_thread_name(char *thread_name); +void erts_lc_pll(void); + +void erts_lc_require_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags); +void erts_lc_unrequire_lock_flg(erts_lc_lock_t *lck, Uint16 op_flags); + +void erts_lc_require_lock(erts_lc_lock_t *lck); +void erts_lc_unrequire_lock(erts_lc_lock_t *lck); + + +#define ERTS_LC_ASSERT(A) \ + ((void) ((A) ? 1 : erts_lc_assert_failed(__FILE__, __LINE__, #A))) +#ifdef ERTS_SMP +#define ERTS_SMP_LC_ASSERT(A) ERTS_LC_ASSERT(A) +#else +#define ERTS_SMP_LC_ASSERT(A) ((void) 1) +#endif +#else /* #ifdef ERTS_ENABLE_LOCK_CHECK */ +#define ERTS_SMP_LC_ASSERT(A) ((void) 1) +#define ERTS_LC_ASSERT(A) ((void) 1) +#endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */ + +#endif /* #ifndef ERTS_LOCK_CHECK_H__ */ diff --git a/erts/emulator/beam/erl_lock_count.c b/erts/emulator/beam/erl_lock_count.c new file mode 100644 index 0000000000..6211983f4b --- /dev/null +++ b/erts/emulator/beam/erl_lock_count.c @@ -0,0 +1,675 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Statistics for locks. + * + * Author: Björn-Egil Dahlberg + * Date: 2008-07-03 + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +/* Needed for VxWorks va_arg */ +#include "sys.h" + +#ifdef ERTS_ENABLE_LOCK_COUNT + +#include "erl_lock_count.h" +#include "ethread.h" +#include "erl_term.h" +#include "atom.h" +#include + +/* globals, dont access these without locks or blocks */ + +ethr_mutex lcnt_data_lock; +erts_lcnt_data_t *erts_lcnt_data; +Uint16 erts_lcnt_rt_options; +erts_lcnt_time_t timer_start; +const char *str_undefined = "undefined"; + +static ethr_tsd_key lcnt_thr_data_key; +static int lcnt_n_thr; +static erts_lcnt_thread_data_t *lcnt_thread_data[1024]; + +/* local functions */ + +static ERTS_INLINE void lcnt_lock(void) { + ethr_mutex_lock(&lcnt_data_lock); +} + +static ERTS_INLINE void lcnt_unlock(void) { + ethr_mutex_unlock(&lcnt_data_lock); +} + + +static char* lcnt_lock_type(Uint16 flag) { + switch(flag & ERTS_LCNT_LT_ALL) { + case ERTS_LCNT_LT_SPINLOCK: return "spinlock"; + case ERTS_LCNT_LT_RWSPINLOCK: return "rw_spinlock"; + case ERTS_LCNT_LT_MUTEX: return "mutex"; + case ERTS_LCNT_LT_RWMUTEX: return "rw_mutex"; + case ERTS_LCNT_LT_PROCLOCK: return "proclock"; + default: return ""; + } +} + +static void lcnt_clear_stats(erts_lcnt_lock_stats_t *stats) { + ethr_atomic_set(&stats->tries, 0); + ethr_atomic_set(&stats->colls, 0); + stats->timer.s = 0; + stats->timer.ns = 0; + stats->timer_n = 0; + stats->file = (char *)str_undefined; + stats->line = 0; +} + +static void lcnt_time(erts_lcnt_time_t *time) { +#ifdef HAVE_GETHRTIME + SysHrTime hr_time; + hr_time = sys_gethrtime(); + time->s = (unsigned long)(hr_time / 1000000000LL); + time->ns = (unsigned long)(hr_time - 1000000000LL*time->s); +#else + SysTimeval tv; + sys_gettimeofday(&tv); + time->s = tv.tv_sec; + time->ns = tv.tv_usec*1000LL; +#endif +} + +static void lcnt_time_diff(erts_lcnt_time_t *d, erts_lcnt_time_t *t1, erts_lcnt_time_t *t0) { + long ds; + long dns; + + ds = t1->s - t0->s; + dns = t1->ns - t0->ns; + + /* the difference should not be able to get bigger than 1 sec in ns*/ + + if (dns < 0) { + ds -= 1; + dns += 1000000000LL; + } + + d->s = ds; + d->ns = dns; +} + +/* difference d must be positive */ + +static void lcnt_time_add(erts_lcnt_time_t *t, erts_lcnt_time_t *d) { + unsigned long ngns = 0; + + t->s += d->s; + t->ns += d->ns; + + ngns = t->ns / 1000000000LL; + t->ns = t->ns % 1000000000LL; + + t->s += ngns; +} + +static erts_lcnt_thread_data_t *lcnt_thread_data_alloc(void) { + erts_lcnt_thread_data_t *eltd; + + eltd = (erts_lcnt_thread_data_t*)malloc(sizeof(erts_lcnt_thread_data_t)); + eltd->timer_set = 0; + eltd->lock_in_conflict = 0; + + eltd->id = lcnt_n_thr++; + /* set thread data to array */ + lcnt_thread_data[eltd->id] = eltd; + + return eltd; +} + +static erts_lcnt_thread_data_t *lcnt_get_thread_data(void) { + return (erts_lcnt_thread_data_t *)ethr_tsd_get(lcnt_thr_data_key); +} + + +/* debug */ + +#if 0 +static char* lock_opt(Uint16 flag) { + if ((flag & ERTS_LCNT_LO_WRITE) && (flag & ERTS_LCNT_LO_READ)) return "rw"; + if (flag & ERTS_LCNT_LO_READ ) return "r "; + if (flag & ERTS_LCNT_LO_WRITE) return " w"; + return "--"; +} + +static void print_lock_x(erts_lcnt_lock_t *lock, Uint16 flag, char *action, char *extra) { + long int colls, tries, w_state, r_state; + erts_lcnt_lock_stats_t *stats = NULL; + + float rate; + char *type; + int i; + + type = lcnt_lock_type(lock->flag); + ethr_atomic_read(&lock->r_state, &r_state); + ethr_atomic_read(&lock->w_state, &w_state); + + if (tries > 0) rate = (float)(colls/(float)tries)*100; + else rate = 0.0f; + + if (lock->flag & flag) { + erts_printf("%20s [%30s] [r/w state %4ld/%4ld] id %T %s\r\n", + action, + lock->name, + r_state, + w_state, + lock->id, + extra); + + for(i = 0; i < lock->n_stats; i++) { + stats = &(lock->stats[i]); + ethr_atomic_read(&stats->tries, &tries); + ethr_atomic_read(&stats->colls, &colls); + fprintf(stderr, "%69s:%5d [tries %9ld] [colls %9ld] [timer_n %8ld] [timer %4ld s %6ld us]\r\n", + stats->file, + stats->line, + tries, + colls, + stats->timer_n, + stats->timer.s, + (unsigned long)stats->timer.ns/1000); + } + fprintf(stderr, "\r\n"); + } +} + +static void print_lock(erts_lcnt_lock_t *lock, char *action) { + print_lock_x(lock, ERTS_LCNT_LT_ALL, action, ""); +} + +#endif + +static erts_lcnt_lock_stats_t *lcnt_get_lock_stats(erts_lcnt_lock_t *lock, char *file, unsigned int line) { + unsigned int i; + erts_lcnt_lock_stats_t *stats = NULL; + + for (i = 0; i < lock->n_stats; i++) { + if ((lock->stats[i].file == file) && (lock->stats[i].line == line)) { + return &(lock->stats[i]); + } + } + if (lock->n_stats < ERTS_LCNT_MAX_LOCK_LOCATIONS) { + stats = &lock->stats[lock->n_stats]; + lock->n_stats++; + + stats->file = file; + stats->line = line; + return stats; + } + return &lock->stats[0]; + +} + +static void lcnt_update_stats(erts_lcnt_lock_stats_t *stats, int lock_in_conflict, erts_lcnt_time_t *time_wait) { + + ethr_atomic_inc(&stats->tries); + + /* beware of trylock */ + if (lock_in_conflict) ethr_atomic_inc(&stats->colls); + + if (time_wait) { + lcnt_time_add(&(stats->timer), time_wait); + stats->timer_n++; + } +} + +/* + * interface + */ + +void erts_lcnt_init() { + erts_lcnt_thread_data_t *eltd = NULL; + + /* init lock */ + if (ethr_mutex_init(&lcnt_data_lock) != 0) abort(); + + /* init tsd */ + lcnt_n_thr = 0; + + ethr_tsd_key_create(&lcnt_thr_data_key); + + lcnt_lock(); + + erts_lcnt_rt_options = ERTS_LCNT_OPT_PROCLOCK; + + eltd = lcnt_thread_data_alloc(); + + ethr_tsd_set(lcnt_thr_data_key, eltd); + + /* init lcnt structure */ + erts_lcnt_data = (erts_lcnt_data_t*)malloc(sizeof(erts_lcnt_data_t)); + erts_lcnt_data->current_locks = erts_lcnt_list_init(); + erts_lcnt_data->deleted_locks = erts_lcnt_list_init(); + + lcnt_unlock(); + + /* set start timer and zero statistics */ + erts_lcnt_clear_counters(); +} + +/* list operations */ + +/* BEGIN ASSUMPTION: lcnt_data_lock taken */ + +erts_lcnt_lock_list_t *erts_lcnt_list_init(void) { + erts_lcnt_lock_list_t *list; + + list = (erts_lcnt_lock_list_t*)malloc(sizeof(erts_lcnt_lock_list_t)); + list->head = NULL; + list->tail = NULL; + list->n = 0; + return list; +} + +/* only do this on the list with the deleted locks! */ +void erts_lcnt_list_clear(erts_lcnt_lock_list_t *list) { + erts_lcnt_lock_t *lock = NULL, + *next = NULL; + + lock = list->head; + + while(lock != NULL) { + next = lock->next; + free(lock); + lock = next; + } + + list->head = NULL; + list->tail = NULL; + list->n = 0; +} + +void erts_lcnt_list_insert(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock) { + erts_lcnt_lock_t *tail = NULL; + + tail = list->tail; + if (tail) { + tail->next = lock; + lock->prev = tail; + } else { + list->head = lock; + lock->prev = NULL; + ASSERT(!lock->next); + } + lock->next = NULL; + list->tail = lock; + + list->n++; +} + +void erts_lcnt_list_delete(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock) { + + if (lock->next) lock->next->prev = lock->prev; + if (lock->prev) lock->prev->next = lock->next; + if (list->head == lock) list->head = lock->next; + if (list->tail == lock) list->tail = lock->prev; + + lock->prev = NULL; + lock->next = NULL; + list->n--; +} +/* END ASSUMPTION: lcnt_data_lock taken */ + + +/* lock operations */ + +/* interface to erl_threads.h */ +/* only lock on init and destroy, all others should use atomics */ +void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag ) { + erts_lcnt_init_lock_x(lock, name, flag, am_undefined); +} +void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id) { + int i; + lcnt_lock(); + + lock->next = NULL; + lock->prev = NULL; + lock->flag = flag; + lock->name = name; + lock->id = id; + + ethr_atomic_init(&lock->r_state, 0); + ethr_atomic_init(&lock->w_state, 0); + +#ifdef DEBUG + ethr_atomic_init(&lock->flowstate, 0); +#endif + + lock->n_stats = 1; + + for (i = 0; i < ERTS_LCNT_MAX_LOCK_LOCATIONS; i++) { + lcnt_clear_stats(&lock->stats[i]); + } + erts_lcnt_list_insert(erts_lcnt_data->current_locks, lock); + + lcnt_unlock(); +} + +void erts_lcnt_destroy_lock(erts_lcnt_lock_t *lock) { + erts_lcnt_lock_t *deleted_lock; + + /* copy structure and insert the copy */ + deleted_lock = (erts_lcnt_lock_t*)malloc(sizeof(erts_lcnt_lock_t)); + + lcnt_lock(); + + memcpy(deleted_lock, lock, sizeof(erts_lcnt_lock_t)); + deleted_lock->next = NULL; + deleted_lock->prev = NULL; + + erts_lcnt_list_insert(erts_lcnt_data->deleted_locks, deleted_lock); + + /* delete original */ + erts_lcnt_list_delete(erts_lcnt_data->current_locks, lock); + + lcnt_unlock(); +} + +/* lock */ + +void erts_lcnt_lock_opt(erts_lcnt_lock_t *lock, Uint16 option) { + long r_state = 0, w_state = 0; + erts_lcnt_thread_data_t *eltd; + + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; + + eltd = lcnt_get_thread_data(); + + ASSERT(eltd); + + ethr_atomic_read(&lock->w_state, &w_state); + + if (option & ERTS_LCNT_LO_WRITE) { + ethr_atomic_read(&lock->r_state, &r_state); + ethr_atomic_inc( &lock->w_state); + } + if (option & ERTS_LCNT_LO_READ) { + ethr_atomic_inc( &lock->r_state); + } + + /* we cannot acquire w_lock if either w or r are taken */ + /* we cannot acquire r_lock if w_lock is taken */ + + if ((w_state > 0) || (r_state > 0)){ + eltd->lock_in_conflict = 1; + if (eltd->timer_set == 0) lcnt_time(&eltd->timer); + eltd->timer_set++; + } else { + eltd->lock_in_conflict = 0; + } +} + +void erts_lcnt_lock(erts_lcnt_lock_t *lock) { + long w_state; + erts_lcnt_thread_data_t *eltd; + + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; + + ethr_atomic_read(&lock->w_state, &w_state); + ethr_atomic_inc( &lock->w_state); + + eltd = lcnt_get_thread_data(); + + ASSERT(eltd); + + if (w_state > 0) { + eltd->lock_in_conflict = 1; + /* only set the timer if nobody else has it + * This should only happen when proc_locks aquires several locks + * 'atomicly'. All other locks will block the thread if w_state > 0 + * i.e. locked. + */ + if (eltd->timer_set == 0) lcnt_time(&eltd->timer); + eltd->timer_set++; + + } else { + eltd->lock_in_conflict = 0; + } +} + +/* if a lock wasn't really a lock operation, bad bad process locks */ + +void erts_lcnt_lock_unaquire(erts_lcnt_lock_t *lock) { + /* should check if this thread was "waiting" */ + + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; + + ethr_atomic_dec( &lock->w_state); +} + +/* erts_lcnt_lock_post + * used when we get a lock (i.e. directly after a lock operation) + * if the timer was set then we had to wait for the lock + * lock_post will calculate the wait time. + */ +void erts_lcnt_lock_post(erts_lcnt_lock_t *lock) { + erts_lcnt_lock_post_x(lock, (char*)str_undefined, 0); +} + +void erts_lcnt_lock_post_x(erts_lcnt_lock_t *lock, char *file, unsigned int line) { + erts_lcnt_thread_data_t *eltd; + erts_lcnt_time_t timer; + erts_lcnt_time_t time_wait; + erts_lcnt_lock_stats_t *stats; +#ifdef DEBUG + long flowstate; +#endif + + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; + +#ifdef DEBUG + if (!(lock->flag & (ERTS_LCNT_LT_RWMUTEX | ERTS_LCNT_LT_RWSPINLOCK))) { + ethr_atomic_read(&lock->flowstate, &flowstate); + ASSERT(flowstate == 0); + ethr_atomic_inc( &lock->flowstate); + } +#endif + + eltd = lcnt_get_thread_data(); + + ASSERT(eltd); + + /* if lock was in conflict, time it */ + + stats = lcnt_get_lock_stats(lock, file, line); + + if (eltd->timer_set) { + lcnt_time(&timer); + + eltd->timer_set--; + + lcnt_time_diff(&time_wait, &timer, &(eltd->timer)); + lcnt_update_stats(stats, eltd->lock_in_conflict, &time_wait); + + ASSERT(eltd->timer_set >= 0); + } else { + lcnt_update_stats(stats, eltd->lock_in_conflict, NULL); + } + +} + +/* unlock */ + +void erts_lcnt_unlock_opt(erts_lcnt_lock_t *lock, Uint16 option) { + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; + if (option & ERTS_LCNT_LO_WRITE) ethr_atomic_dec(&lock->w_state); + if (option & ERTS_LCNT_LO_READ ) ethr_atomic_dec(&lock->r_state); +} + +void erts_lcnt_unlock(erts_lcnt_lock_t *lock) { +#ifdef DEBUG + long w_state; + long flowstate; +#endif + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; +#ifdef DEBUG + /* flowstate */ + ethr_atomic_read(&lock->flowstate, &flowstate); + ASSERT(flowstate == 1); + ethr_atomic_dec( &lock->flowstate); + + /* write state */ + ethr_atomic_read(&lock->w_state, &w_state); + ASSERT(w_state > 0) +#endif + ethr_atomic_dec(&lock->w_state); +} + +/* trylock */ + +void erts_lcnt_trylock_opt(erts_lcnt_lock_t *lock, int res, Uint16 option) { + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; + /* Determine lock_state via res instead of state */ + if (res != EBUSY) { + if (option & ERTS_LCNT_LO_WRITE) ethr_atomic_inc(&lock->w_state); + if (option & ERTS_LCNT_LO_READ ) ethr_atomic_inc(&lock->r_state); + lcnt_update_stats(&(lock->stats[0]), 0, NULL); + } else { + ethr_atomic_inc(&lock->stats[0].tries); + ethr_atomic_inc(&lock->stats[0].colls); + } +} + + +void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res) { + /* Determine lock_state via res instead of state */ +#ifdef DEBUG + long flowstate; +#endif + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_SUSPEND) return; + if (res != EBUSY) { + +#ifdef DEBUG + ethr_atomic_read(&lock->flowstate, &flowstate); + ASSERT(flowstate == 0); + ethr_atomic_inc( &lock->flowstate); +#endif + ethr_atomic_inc(&lock->w_state); + + lcnt_update_stats(&(lock->stats[0]), 0, NULL); + + } else { + ethr_atomic_inc(&lock->stats[0].tries); + ethr_atomic_inc(&lock->stats[0].colls); + } +} + +/* thread operations */ + +static void *lcnt_thr_init(erts_lcnt_thread_data_t *eltd) { + void *(*function)(void *); + void *argument; + void *res; + function = eltd->function; + argument = eltd->argument; + + ethr_tsd_set(lcnt_thr_data_key, eltd); + + res = (void *)function(argument); + free(eltd); + return (void *)res; +} + + + +int erts_lcnt_thr_create(ethr_tid *tid, void * (*function)(void *), void *arg, ethr_thr_opts *opts) { + erts_lcnt_thread_data_t *eltd; + + lcnt_lock(); + /* lock for thread id global update */ + eltd = lcnt_thread_data_alloc(); + lcnt_unlock(); + + eltd->function = function; + eltd->argument = arg; + + return ethr_thr_create(tid, (void *)lcnt_thr_init, (void *)eltd, opts); +} + + +/* bindings for bifs */ + +Uint16 erts_lcnt_set_rt_opt(Uint16 opt) { + Uint16 prev; + prev = (erts_lcnt_rt_options & opt); + erts_lcnt_rt_options |= opt; + return prev; +} + +Uint16 erts_lcnt_clear_rt_opt(Uint16 opt) { + Uint16 prev; + prev = (erts_lcnt_rt_options & opt); + erts_lcnt_rt_options &= ~opt; + return prev; +} + +void erts_lcnt_clear_counters(void) { + erts_lcnt_lock_t *lock; + erts_lcnt_lock_list_t *list; + erts_lcnt_lock_stats_t *stats; + int i; + + lcnt_lock(); + + list = erts_lcnt_data->current_locks; + + for (lock = list->head; lock != NULL; lock = lock->next) { + for( i = 0; i < ERTS_LCNT_MAX_LOCK_LOCATIONS; i++) { + stats = &lock->stats[i]; + lcnt_clear_stats(stats); + } + lock->n_stats = 1; + } + + /* empty deleted locks in lock list */ + erts_lcnt_list_clear(erts_lcnt_data->deleted_locks); + + lcnt_time(&timer_start); + + lcnt_unlock(); +} + +erts_lcnt_data_t *erts_lcnt_get_data(void) { + erts_lcnt_time_t timer_stop; + + lcnt_lock(); + + lcnt_time(&timer_stop); + lcnt_time_diff(&(erts_lcnt_data->duration), &timer_stop, &timer_start); + + lcnt_unlock(); + + return erts_lcnt_data; +} + +char *erts_lcnt_lock_type(Uint16 type) { + return lcnt_lock_type(type); +} + +#endif /* ifdef ERTS_ENABLE_LOCK_COUNT */ diff --git a/erts/emulator/beam/erl_lock_count.h b/erts/emulator/beam/erl_lock_count.h new file mode 100644 index 0000000000..8564c36203 --- /dev/null +++ b/erts/emulator/beam/erl_lock_count.h @@ -0,0 +1,195 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Statistics for locks. + * + * Author: Björn-Egil Dahlberg + * Date: 2008-07-03 + * Abstract: + * Locks statistics internal representation. + * + * Conceptual representation, + * - set name + * | - id (the unique lock) + * | | - lock type + * | | - statistics + * | | | - location (file and line number) + * | | | - tries + * | | | - collisions (including trylock busy) + * | | | - timer (time spent in waiting for lock) + * | | | - n_timer (collisions excluding trylock busy) + * + * Each instance of a lock is the unique lock, i.e. set and id in that set. + * For each lock there is a set of statistics with where and what impact + * the lock aqusition had. + */ + +#include "sys.h" + +#ifndef ERTS_LOCK_COUNT_H__ +#define ERTS_LOCK_COUNT_H__ + +#ifdef ERTS_ENABLE_LOCK_COUNT +#include "ethread.h" + +#define ERTS_LCNT_MAX_LOCK_LOCATIONS (10) + +#define ERTS_LCNT_LT_SPINLOCK (((Uint16) 1) << 0) +#define ERTS_LCNT_LT_RWSPINLOCK (((Uint16) 1) << 1) +#define ERTS_LCNT_LT_MUTEX (((Uint16) 1) << 2) +#define ERTS_LCNT_LT_RWMUTEX (((Uint16) 1) << 3) +#define ERTS_LCNT_LT_PROCLOCK (((Uint16) 1) << 4) +#define ERTS_LCNT_LT_ALLOC (((Uint16) 1) << 5) + +#define ERTS_LCNT_LO_READ (((Uint16) 1) << 6) +#define ERTS_LCNT_LO_WRITE (((Uint16) 1) << 7) + +#define ERTS_LCNT_LO_READ_WRITE ( ERTS_LCNT_LO_READ \ + | ERTS_LCNT_LO_WRITE ) + +#define ERTS_LCNT_LT_ALL ( ERTS_LCNT_LT_SPINLOCK \ + | ERTS_LCNT_LT_RWSPINLOCK \ + | ERTS_LCNT_LT_MUTEX \ + | ERTS_LCNT_LT_RWMUTEX \ + | ERTS_LCNT_LT_PROCLOCK ) +/* runtime options */ + +#define ERTS_LCNT_OPT_SUSPEND (((Uint16) 1) << 0) +#define ERTS_LCNT_OPT_LOCATION (((Uint16) 1) << 1) +#define ERTS_LCNT_OPT_PROCLOCK (((Uint16) 1) << 2) + +typedef struct { + unsigned long s; + unsigned long ns; +} erts_lcnt_time_t; + +extern erts_lcnt_time_t timer_start; + +typedef struct erts_lcnt_lock_stats_s { + /* "tries" and "colls" needs to be atomic since + * trylock busy does not aquire a lock and there + * is no post action to rectify the situation + */ + + char *file; /* which file the lock was taken */ + unsigned int line; /* line number in file */ + + ethr_atomic_t tries; /* n tries to get lock */ + ethr_atomic_t colls; /* n collisions of tries to get lock */ + + unsigned long timer_n; /* #times waited for lock */ + erts_lcnt_time_t timer; /* total wait time for lock */ +} erts_lcnt_lock_stats_t; + +/* rw locks uses both states, other locks only uses w_state */ +typedef struct erts_lcnt_lock_s { + char *name; /* lock name */ + Uint16 flag; /* lock type */ + Eterm id; /* id if possible */ + +#ifdef DEBUG + ethr_atomic_t flowstate; +#endif + + /* lock states */ + ethr_atomic_t w_state; /* 0 not taken, otherwise n threads waiting */ + ethr_atomic_t r_state; /* 0 not taken, > 0 -> writes will wait */ + + /* statistics */ + unsigned int n_stats; + erts_lcnt_lock_stats_t stats[ERTS_LCNT_MAX_LOCK_LOCATIONS]; /* first entry is "undefined"*/ + + /* chains for list handling */ + /* data is hold by lcnt_lock */ + struct erts_lcnt_lock_s *prev; + struct erts_lcnt_lock_s *next; +} erts_lcnt_lock_t; + +typedef struct { + erts_lcnt_lock_t *head; + erts_lcnt_lock_t *tail; + unsigned long n; +} erts_lcnt_lock_list_t; + +typedef struct { + erts_lcnt_time_t duration; /* time since last clear */ + erts_lcnt_lock_list_t *current_locks; + erts_lcnt_lock_list_t *deleted_locks; +} erts_lcnt_data_t; + +typedef struct { + int id; + + erts_lcnt_time_t timer; /* timer */ + int timer_set; /* bool */ + int lock_in_conflict; /* bool */ + + /* function pointer */ + void *(*function)(void *); + void *argument; + +} erts_lcnt_thread_data_t; + +/* globals */ + +extern Uint16 erts_lcnt_rt_options; + +/* function declerations */ + +void erts_lcnt_init(void); + +/* list operations (local) */ +erts_lcnt_lock_list_t *erts_lcnt_list_init(void); + +void erts_lcnt_list_clear( erts_lcnt_lock_list_t *list); +void erts_lcnt_list_insert(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock); +void erts_lcnt_list_delete(erts_lcnt_lock_list_t *list, erts_lcnt_lock_t *lock); + +/* lock operations (global) */ +void erts_lcnt_init_lock(erts_lcnt_lock_t *lock, char *name, Uint16 flag); +void erts_lcnt_init_lock_x(erts_lcnt_lock_t *lock, char *name, Uint16 flag, Eterm id); +void erts_lcnt_destroy_lock(erts_lcnt_lock_t *lock); + +void erts_lcnt_lock(erts_lcnt_lock_t *lock); +void erts_lcnt_lock_opt(erts_lcnt_lock_t *lock, Uint16 option); +void erts_lcnt_lock_post(erts_lcnt_lock_t *lock); +void erts_lcnt_lock_post_x(erts_lcnt_lock_t *lock, char *file, unsigned int line); +void erts_lcnt_lock_unaquire(erts_lcnt_lock_t *lock); + +void erts_lcnt_unlock(erts_lcnt_lock_t *lock); +void erts_lcnt_unlock_opt(erts_lcnt_lock_t *lock, Uint16 option); + +void erts_lcnt_trylock_opt(erts_lcnt_lock_t *lock, int res, Uint16 option); +void erts_lcnt_trylock(erts_lcnt_lock_t *lock, int res); + +/* thread operations */ + +int erts_lcnt_thr_create(ethr_tid *tid, void * (*function)(void *), void *arg, ethr_thr_opts *opts); + +/* bif interface */ + +Uint16 erts_lcnt_set_rt_opt(Uint16 opt); +Uint16 erts_lcnt_clear_rt_opt(Uint16 opt); +void erts_lcnt_clear_counters(void); +char *erts_lcnt_lock_type(Uint16 type); +erts_lcnt_data_t *erts_lcnt_get_data(void); + +#endif /* ifdef ERTS_ENABLE_LOCK_COUNT */ +#endif /* ifndef ERTS_LOCK_COUNT_H__ */ diff --git a/erts/emulator/beam/erl_math.c b/erts/emulator/beam/erl_math.c new file mode 100644 index 0000000000..16d4fdc09c --- /dev/null +++ b/erts/emulator/beam/erl_math.c @@ -0,0 +1,233 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "big.h" + +static Eterm +math_call_1(Process* p, double (*func)(double), Eterm arg1) +{ + FloatDef a1; + Eterm res; + Eterm* hp; + + ERTS_FP_CHECK_INIT(p); + if (is_float(arg1)) { + GET_DOUBLE(arg1, a1); + } else if (is_small(arg1)) { + a1.fd = signed_val(arg1); + } else if (is_big(arg1)) { + if (big_to_double(arg1, &a1.fd) < 0) { + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + } else { + p->freason = BADARG; + return THE_NON_VALUE; + } + a1.fd = (*func)(a1.fd); + ERTS_FP_ERROR_THOROUGH(p, a1.fd, goto badarith); + hp = HAlloc(p, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(a1, hp); + return res; +} + + +static Eterm +math_call_2(Process* p, double (*func)(double, double), Eterm arg1, Eterm arg2) +{ + FloatDef a1; + FloatDef a2; + Eterm res; + Eterm* hp; + + ERTS_FP_CHECK_INIT(p); + if (is_float(arg1)) { + GET_DOUBLE(arg1, a1); + } else if (is_small(arg1)) { + a1.fd = signed_val(arg1); + } else if (is_big(arg1)) { + if (big_to_double(arg1, &a1.fd) < 0) { + badarith: + p->freason = BADARITH; + return THE_NON_VALUE; + } + } else { + p->freason = BADARG; + return THE_NON_VALUE; + } + + if (is_float(arg2)) { + GET_DOUBLE(arg2, a2); + } else if (is_small(arg2)) { + a2.fd = signed_val(arg2); + } else if (is_big(arg2)) { + if (big_to_double(arg2, &a2.fd) < 0) { + goto badarith; + } + } else { + p->freason = BADARG; + return THE_NON_VALUE; + } + + a1.fd = (*func)(a1.fd, a2.fd); + ERTS_FP_ERROR_THOROUGH(p, a1.fd, goto badarith); + hp = HAlloc(p, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(a1, hp); + return res; +} + +BIF_RETTYPE math_cos_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, cos, BIF_ARG_1); +} + +BIF_RETTYPE math_cosh_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, cosh, BIF_ARG_1); +} + +BIF_RETTYPE math_sin_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, sin, BIF_ARG_1); +} + +BIF_RETTYPE math_sinh_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, sinh, BIF_ARG_1); +} + +BIF_RETTYPE math_tan_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, tan, BIF_ARG_1); +} + + +BIF_RETTYPE math_tanh_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, tanh, BIF_ARG_1); +} + + +BIF_RETTYPE math_acos_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, acos, BIF_ARG_1); +} + +BIF_RETTYPE math_acosh_1(BIF_ALIST_1) +{ +#ifdef NO_ACOSH + BIF_ERROR(BIF_P, EXC_UNDEF); +#else + return math_call_1(BIF_P, acosh, BIF_ARG_1); +#endif +} + +BIF_RETTYPE math_asin_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, asin, BIF_ARG_1); +} + +BIF_RETTYPE math_asinh_1(BIF_ALIST_1) +{ +#ifdef NO_ASINH + BIF_ERROR(BIF_P, EXC_UNDEF); +#else + return math_call_1(BIF_P, asinh, BIF_ARG_1); +#endif +} + +BIF_RETTYPE math_atan_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, atan, BIF_ARG_1); +} + +BIF_RETTYPE math_atanh_1(BIF_ALIST_1) +{ +#ifdef NO_ATANH + BIF_ERROR(BIF_P, EXC_UNDEF); +#else + return math_call_1(BIF_P, atanh, BIF_ARG_1); +#endif +} + +BIF_RETTYPE math_erf_1(BIF_ALIST_1) +{ +#ifdef NO_ERF + BIF_ERROR(BIF_P, EXC_UNDEF); +#else + return math_call_1(BIF_P, erf, BIF_ARG_1); +#endif +} + +BIF_RETTYPE math_erfc_1(BIF_ALIST_1) +{ +#ifdef NO_ERFC + BIF_ERROR(BIF_P, EXC_UNDEF); +#else + return math_call_1(BIF_P, erfc, BIF_ARG_1); +#endif +} + +BIF_RETTYPE math_exp_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, exp, BIF_ARG_1); +} + +BIF_RETTYPE math_log_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, log, BIF_ARG_1); +} + + +BIF_RETTYPE math_log10_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, log10, BIF_ARG_1); +} + +BIF_RETTYPE math_sqrt_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, sqrt, BIF_ARG_1); +} + +BIF_RETTYPE math_atan2_2(BIF_ALIST_2) +{ + return math_call_2(BIF_P, atan2, BIF_ARG_1, BIF_ARG_2); +} + +BIF_RETTYPE math_pow_2(BIF_ALIST_2) +{ + return math_call_2(BIF_P, pow, BIF_ARG_1, BIF_ARG_2); +} + + + + diff --git a/erts/emulator/beam/erl_md5.c b/erts/emulator/beam/erl_md5.c new file mode 100644 index 0000000000..8d0352a367 --- /dev/null +++ b/erts/emulator/beam/erl_md5.c @@ -0,0 +1,340 @@ +/* + * MD5C.C - RSA Data Security, Inc., MD5 message-digest algorithm + */ + +/* Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All + * rights reserved. + * + * License to copy and use this software is granted provided that it + * is identified as the "RSA Data Security, Inc. MD5 Message-Digest + * Algorithm" in all material mentioning or referencing this software + * or this function. + * + * License is also granted to make and use derivative works provided + * that such works are identified as "derived from the RSA Data + * Security, Inc. MD5 Message-Digest Algorithm" in all material + * mentioning or referencing the derived work. + * + * RSA Data Security, Inc. makes no representations concerning either + * the merchantability of this software or the suitability of this + * software for any particular purpose. It is provided "as is" + * without express or implied warranty of any kind. + * + * These notices must be retained in any copies of any part of this + * documentation and/or software. + */ + +/* %ExternalCopyright% */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "erl_binary.h" + +typedef void *POINTER; + +/* + * Constants for MD5Transform routine. + */ + +#define S11 7 +#define S12 12 +#define S13 17 +#define S14 22 +#define S21 5 +#define S22 9 +#define S23 14 +#define S24 20 +#define S31 4 +#define S32 11 +#define S33 16 +#define S34 23 +#define S41 6 +#define S42 10 +#define S43 15 +#define S44 21 + +static void MD5Transform(Uint32 [4], unsigned char [64]); +static void Encode(unsigned char *, Uint32 *, unsigned int); +static void Decode(Uint32 *, unsigned char *, unsigned int); + +static unsigned char PADDING[64] = { + 0x80, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 +}; + +/* + * F, G, H and I are basic MD5 functions. + */ +#define F(x, y, z) (((x) & (y)) | ((~x) & (z))) +#define G(x, y, z) (((x) & (z)) | ((y) & (~z))) +#define H(x, y, z) ((x) ^ (y) ^ (z)) +#define I(x, y, z) ((y) ^ ((x) | (~z))) + +/* + * ROTATE_LEFT rotates x left n bits. + */ +#define ROTATE_LEFT(x, n) (((x) << (n)) | ((x) >> (32-(n)))) + +/* + * FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4. + * Rotation is separate from addition to prevent recomputation. + */ +#define FF(a, b, c, d, x, s, ac) { \ + (a) += F ((b), (c), (d)) + (x) + (Uint32)(ac); \ + (a) = ROTATE_LEFT ((a), (s)); \ + (a) += (b); \ +} +#define GG(a, b, c, d, x, s, ac) { \ + (a) += G ((b), (c), (d)) + (x) + (Uint32)(ac); \ + (a) = ROTATE_LEFT ((a), (s)); \ + (a) += (b); \ +} +#define HH(a, b, c, d, x, s, ac) { \ + (a) += H ((b), (c), (d)) + (x) + (Uint32)(ac); \ + (a) = ROTATE_LEFT ((a), (s)); \ + (a) += (b); \ +} +#define II(a, b, c, d, x, s, ac) { \ + (a) += I ((b), (c), (d)) + (x) + (Uint32)(ac); \ + (a) = ROTATE_LEFT ((a), (s)); \ + (a) += (b); \ +} + +/* + * MD5 initialization. Begins an MD5 operation, writing a new context. + */ +void MD5Init(MD5_CTX* context) +{ + context->count[0] = context->count[1] = 0; + + /* + * Load magic initialization constants. + */ + context->state[0] = 0x67452301; + context->state[1] = 0xefcdab89; + context->state[2] = 0x98badcfe; + context->state[3] = 0x10325476; +} + +/* + * MD5 block update operation. Continues an MD5 message-digest + * operation, processing another message block, and updating the + * context. + */ +void MD5Update (context, input, inputLen) + MD5_CTX *context; /* context */ + unsigned char *input; /* input block */ + unsigned int inputLen; /* length of input block */ +{ + unsigned int i, index, partLen; + + /* + * Compute number of bytes mod 64 + */ + index = (unsigned int)((context->count[0] >> 3) & 0x3F); + + /* Update number of bits */ + if ((context->count[0] += ((Uint32)inputLen << 3)) + < ((Uint32)inputLen << 3)) + context->count[1]++; + context->count[1] += ((Uint32)inputLen >> 29); + + partLen = 64 - index; + + /* + * Transform as many times as possible. + */ + if (inputLen >= partLen) { + sys_memcpy + ((POINTER)&context->buffer[index], (POINTER)input, partLen); + MD5Transform (context->state, context->buffer); + + for (i = partLen; i + 63 < inputLen; i += 64) + MD5Transform (context->state, &input[i]); + + index = 0; + } + else + i = 0; + + /* + * Buffer remaining input + */ + sys_memcpy((POINTER)&context->buffer[index], (POINTER)&input[i], inputLen-i); +} + +/* + * MD5 finalization. Ends an MD5 message-digest operation, writing the + the message digest and zeroizing the context. + */ +void MD5Final (digest, context) + unsigned char digest[16]; /* message digest */ + MD5_CTX *context; /* context */ +{ + unsigned char bits[8]; + unsigned int index, padLen; + + /* + * Save number of bits + */ + Encode (bits, context->count, 8); + + /* + * Pad out to 56 mod 64. + */ + index = (unsigned int)((context->count[0] >> 3) & 0x3f); + padLen = (index < 56) ? (56 - index) : (120 - index); + MD5Update (context, PADDING, padLen); + + /* + * Append length (before padding) + */ + MD5Update (context, bits, 8); + + /* + * Store state in digest + */ + Encode (digest, context->state, 16); + + /* + * Zeroize sensitive information. + */ + sys_memset ((POINTER)context, 0, sizeof (*context)); +} + +/* + * MD5 basic transformation. Transforms state based on block. + */ +static void MD5Transform (state, block) + Uint32 state[4]; + unsigned char block[64]; +{ + Uint32 a = state[0], b = state[1], c = state[2], d = state[3], x[16]; + + Decode (x, block, 64); + + /* Round 1 */ + FF (a, b, c, d, x[ 0], S11, 0xd76aa478); /* 1 */ + FF (d, a, b, c, x[ 1], S12, 0xe8c7b756); /* 2 */ + FF (c, d, a, b, x[ 2], S13, 0x242070db); /* 3 */ + FF (b, c, d, a, x[ 3], S14, 0xc1bdceee); /* 4 */ + FF (a, b, c, d, x[ 4], S11, 0xf57c0faf); /* 5 */ + FF (d, a, b, c, x[ 5], S12, 0x4787c62a); /* 6 */ + FF (c, d, a, b, x[ 6], S13, 0xa8304613); /* 7 */ + FF (b, c, d, a, x[ 7], S14, 0xfd469501); /* 8 */ + FF (a, b, c, d, x[ 8], S11, 0x698098d8); /* 9 */ + FF (d, a, b, c, x[ 9], S12, 0x8b44f7af); /* 10 */ + FF (c, d, a, b, x[10], S13, 0xffff5bb1); /* 11 */ + FF (b, c, d, a, x[11], S14, 0x895cd7be); /* 12 */ + FF (a, b, c, d, x[12], S11, 0x6b901122); /* 13 */ + FF (d, a, b, c, x[13], S12, 0xfd987193); /* 14 */ + FF (c, d, a, b, x[14], S13, 0xa679438e); /* 15 */ + FF (b, c, d, a, x[15], S14, 0x49b40821); /* 16 */ + + /* Round 2 */ + GG (a, b, c, d, x[ 1], S21, 0xf61e2562); /* 17 */ + GG (d, a, b, c, x[ 6], S22, 0xc040b340); /* 18 */ + GG (c, d, a, b, x[11], S23, 0x265e5a51); /* 19 */ + GG (b, c, d, a, x[ 0], S24, 0xe9b6c7aa); /* 20 */ + GG (a, b, c, d, x[ 5], S21, 0xd62f105d); /* 21 */ + GG (d, a, b, c, x[10], S22, 0x2441453); /* 22 */ + GG (c, d, a, b, x[15], S23, 0xd8a1e681); /* 23 */ + GG (b, c, d, a, x[ 4], S24, 0xe7d3fbc8); /* 24 */ + GG (a, b, c, d, x[ 9], S21, 0x21e1cde6); /* 25 */ + GG (d, a, b, c, x[14], S22, 0xc33707d6); /* 26 */ + GG (c, d, a, b, x[ 3], S23, 0xf4d50d87); /* 27 */ + GG (b, c, d, a, x[ 8], S24, 0x455a14ed); /* 28 */ + GG (a, b, c, d, x[13], S21, 0xa9e3e905); /* 29 */ + GG (d, a, b, c, x[ 2], S22, 0xfcefa3f8); /* 30 */ + GG (c, d, a, b, x[ 7], S23, 0x676f02d9); /* 31 */ + GG (b, c, d, a, x[12], S24, 0x8d2a4c8a); /* 32 */ + + /* Round 3 */ + HH (a, b, c, d, x[ 5], S31, 0xfffa3942); /* 33 */ + HH (d, a, b, c, x[ 8], S32, 0x8771f681); /* 34 */ + HH (c, d, a, b, x[11], S33, 0x6d9d6122); /* 35 */ + HH (b, c, d, a, x[14], S34, 0xfde5380c); /* 36 */ + HH (a, b, c, d, x[ 1], S31, 0xa4beea44); /* 37 */ + HH (d, a, b, c, x[ 4], S32, 0x4bdecfa9); /* 38 */ + HH (c, d, a, b, x[ 7], S33, 0xf6bb4b60); /* 39 */ + HH (b, c, d, a, x[10], S34, 0xbebfbc70); /* 40 */ + HH (a, b, c, d, x[13], S31, 0x289b7ec6); /* 41 */ + HH (d, a, b, c, x[ 0], S32, 0xeaa127fa); /* 42 */ + HH (c, d, a, b, x[ 3], S33, 0xd4ef3085); /* 43 */ + HH (b, c, d, a, x[ 6], S34, 0x4881d05); /* 44 */ + HH (a, b, c, d, x[ 9], S31, 0xd9d4d039); /* 45 */ + HH (d, a, b, c, x[12], S32, 0xe6db99e5); /* 46 */ + HH (c, d, a, b, x[15], S33, 0x1fa27cf8); /* 47 */ + HH (b, c, d, a, x[ 2], S34, 0xc4ac5665); /* 48 */ + + /* Round 4 */ + II (a, b, c, d, x[ 0], S41, 0xf4292244); /* 49 */ + II (d, a, b, c, x[ 7], S42, 0x432aff97); /* 50 */ + II (c, d, a, b, x[14], S43, 0xab9423a7); /* 51 */ + II (b, c, d, a, x[ 5], S44, 0xfc93a039); /* 52 */ + II (a, b, c, d, x[12], S41, 0x655b59c3); /* 53 */ + II (d, a, b, c, x[ 3], S42, 0x8f0ccc92); /* 54 */ + II (c, d, a, b, x[10], S43, 0xffeff47d); /* 55 */ + II (b, c, d, a, x[ 1], S44, 0x85845dd1); /* 56 */ + II (a, b, c, d, x[ 8], S41, 0x6fa87e4f); /* 57 */ + II (d, a, b, c, x[15], S42, 0xfe2ce6e0); /* 58 */ + II (c, d, a, b, x[ 6], S43, 0xa3014314); /* 59 */ + II (b, c, d, a, x[13], S44, 0x4e0811a1); /* 60 */ + II (a, b, c, d, x[ 4], S41, 0xf7537e82); /* 61 */ + II (d, a, b, c, x[11], S42, 0xbd3af235); /* 62 */ + II (c, d, a, b, x[ 2], S43, 0x2ad7d2bb); /* 63 */ + II (b, c, d, a, x[ 9], S44, 0xeb86d391); /* 64 */ + + state[0] += a; + state[1] += b; + state[2] += c; + state[3] += d; + + /* + * Zeroize sensitive information. + */ + sys_memset ((POINTER)x, 0, sizeof (x)); +} + +/* + * Encodes input (Uint32) into output (unsigned char). Assumes len is + * a multiple of 4. + */ +static void Encode (output, input, len) + unsigned char *output; + Uint32 *input; + unsigned int len; +{ + unsigned int i, j; + + for (i = 0, j = 0; j < len; i++, j += 4) { + output[j] = (unsigned char)(input[i] & 0xff); + output[j+1] = (unsigned char)((input[i] >> 8) & 0xff); + output[j+2] = (unsigned char)((input[i] >> 16) & 0xff); + output[j+3] = (unsigned char)((input[i] >> 24) & 0xff); + } +} + +/* + * Decodes input (unsigned char) into output (Uint32). Assumes len is + * a multiple of 4. + */ +static void Decode (output, input, len) + Uint32 *output; + unsigned char *input; + unsigned int len; +{ + unsigned int i, j; + + for (i = 0, j = 0; j < len; i++, j += 4) + output[i] = ((Uint32)input[j]) | (((Uint32)input[j+1]) << 8) | + (((Uint32)input[j+2]) << 16) | (((Uint32)input[j+3]) << 24); +} diff --git a/erts/emulator/beam/erl_message.c b/erts/emulator/beam/erl_message.c new file mode 100644 index 0000000000..81fbdfbd5a --- /dev/null +++ b/erts/emulator/beam/erl_message.c @@ -0,0 +1,1070 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Message passing primitives. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_message.h" +#include "erl_process.h" +#include "erl_nmgc.h" + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(message, + ErlMessage, + ERL_MESSAGE_BUF_SZ, + ERTS_ALC_T_MSG_REF) + +#if defined(DEBUG) && 0 +#define HARD_DEBUG +#else +#undef HARD_DEBUG +#endif + +void +init_message(void) +{ + init_message_alloc(); +} + +void +free_message(ErlMessage* mp) +{ + message_free(mp); +} + +/* Allocate message buffer (size in words) */ +ErlHeapFragment* +new_message_buffer(Uint size) +{ + ErlHeapFragment* bp; + bp = (ErlHeapFragment*) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, + ERTS_HEAP_FRAG_SIZE(size)); + ERTS_INIT_HEAP_FRAG(bp, size); + return bp; +} + +ErlHeapFragment* +erts_resize_message_buffer(ErlHeapFragment *bp, Uint size, + Eterm *brefs, Uint brefs_size) +{ +#ifdef DEBUG + int i; +#endif +#ifdef HARD_DEBUG + ErlHeapFragment *dbg_bp; + Eterm *dbg_brefs; + Uint dbg_size; + Uint dbg_tot_size; + Eterm *dbg_hp; +#endif + ErlHeapFragment* nbp; + +#ifdef DEBUG + { + Uint off_sz = size < bp->size ? size : bp->size; + for (i = 0; i < brefs_size; i++) { + Eterm *ptr; + if (is_immed(brefs[i])) + continue; + ptr = ptr_val(brefs[i]); + ASSERT(&bp->mem[0] <= ptr && ptr < &bp->mem[0] + off_sz); + + } + } +#endif + + if (size == bp->size) + return bp; + +#ifdef HARD_DEBUG + dbg_brefs = erts_alloc(ERTS_ALC_T_UNDEF, sizeof(Eterm *)*brefs_size); + dbg_bp = new_message_buffer(bp->size); + dbg_hp = dbg_bp->mem; + dbg_tot_size = 0; + for (i = 0; i < brefs_size; i++) { + dbg_size = size_object(brefs[i]); + dbg_tot_size += dbg_size; + dbg_brefs[i] = copy_struct(brefs[i], dbg_size, &dbg_hp, + &dbg_bp->off_heap); + } + ASSERT(dbg_tot_size == (size < bp->size ? size : bp->size)); +#endif + + nbp = (ErlHeapFragment*) ERTS_HEAP_REALLOC(ERTS_ALC_T_HEAP_FRAG, + (void *) bp, + (sizeof(ErlHeapFragment) + - sizeof(Eterm) + + bp->size*sizeof(Eterm)), + (sizeof(ErlHeapFragment) + - sizeof(Eterm) + + size*sizeof(Eterm))); + if (bp != nbp) { + Uint off_sz = size < nbp->size ? size : nbp->size; + Eterm *sp = &bp->mem[0]; + Eterm *ep = sp + off_sz; + Sint offs = &nbp->mem[0] - sp; + erts_offset_off_heap(&nbp->off_heap, offs, sp, ep); + erts_offset_heap(&nbp->mem[0], off_sz, offs, sp, ep); + if (brefs && brefs_size) + erts_offset_heap_ptr(brefs, brefs_size, offs, sp, ep); +#ifdef DEBUG + for (i = 0; i < brefs_size; i++) { + Eterm *ptr; + if (is_immed(brefs[i])) + continue; + ptr = ptr_val(brefs[i]); + ASSERT(&nbp->mem[0] <= ptr && ptr < &nbp->mem[0] + off_sz); + } +#endif + } + nbp->size = size; + + +#ifdef HARD_DEBUG + for (i = 0; i < brefs_size; i++) + ASSERT(eq(dbg_brefs[i], brefs[i])); + free_message_buffer(dbg_bp); + erts_free(ERTS_ALC_T_UNDEF, dbg_brefs); +#endif + + return nbp; +} + + +void +erts_cleanup_offheap(ErlOffHeap *offheap) +{ + if (offheap->mso) { + erts_cleanup_mso(offheap->mso); + } +#ifndef HYBRID /* FIND ME! */ + if (offheap->funs) { + erts_cleanup_funs(offheap->funs); + } +#endif + if (offheap->externals) { + erts_cleanup_externals(offheap->externals); + } +} + +void +free_message_buffer(ErlHeapFragment* bp) +{ + erts_cleanup_offheap(&bp->off_heap); + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP_FRAG, + (void *) bp, + (sizeof(ErlHeapFragment) + - sizeof(Eterm) + + bp->size*sizeof(Eterm))); +} + +static ERTS_INLINE void +link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp) +{ + if (bp) { + /* Link the message buffer */ + bp->next = MBUF(proc); + MBUF(proc) = bp; + MBUF_SIZE(proc) += bp->size; + FLAGS(proc) |= F_FORCE_GC; + + /* Move any binaries into the process */ + if (bp->off_heap.mso != NULL) { + ProcBin** next_p = &bp->off_heap.mso; + while (*next_p != NULL) { + next_p = &((*next_p)->next); + } + *next_p = MSO(proc).mso; + MSO(proc).mso = bp->off_heap.mso; + bp->off_heap.mso = NULL; + MSO(proc).overhead += bp->off_heap.overhead; + } + + /* Move any funs into the process */ +#ifndef HYBRID + if (bp->off_heap.funs != NULL) { + ErlFunThing** next_p = &bp->off_heap.funs; + while (*next_p != NULL) { + next_p = &((*next_p)->next); + } + *next_p = MSO(proc).funs; + MSO(proc).funs = bp->off_heap.funs; + bp->off_heap.funs = NULL; + } +#endif + + /* Move any external things into the process */ + if (bp->off_heap.externals != NULL) { + ExternalThing** next_p = &bp->off_heap.externals; + while (*next_p != NULL) { + next_p = &((*next_p)->next); + } + *next_p = MSO(proc).externals; + MSO(proc).externals = bp->off_heap.externals; + bp->off_heap.externals = NULL; + } + } +} + +Eterm +erts_msg_distext2heap(Process *pp, + ErtsProcLocks *plcksp, + ErlHeapFragment **bpp, + Eterm *tokenp, + ErtsDistExternal *dist_extp) +{ + Eterm msg; + Uint tok_sz = 0; + Eterm *hp = NULL; + Eterm *hp_end = NULL; + ErlOffHeap *ohp; + Sint sz; + + *bpp = NULL; + sz = erts_decode_dist_ext_size(dist_extp, 0); + if (sz < 0) + goto decode_error; + if (is_not_nil(*tokenp)) { + ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); + tok_sz = heap_frag->size; + sz += tok_sz; + } + if (pp) + hp = erts_alloc_message_heap(sz, bpp, &ohp, pp, plcksp); + else { + *bpp = new_message_buffer(sz); + hp = (*bpp)->mem; + ohp = &(*bpp)->off_heap; + } + hp_end = hp + sz; + msg = erts_decode_dist_ext(&hp, ohp, dist_extp); + if (is_non_value(msg)) + goto decode_error; + if (is_not_nil(*tokenp)) { + ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); + *tokenp = copy_struct(*tokenp, tok_sz, &hp, ohp); + erts_cleanup_offheap(&heap_frag->off_heap); + } + erts_free_dist_ext_copy(dist_extp); + if (hp_end != hp) { + if (!(*bpp)) { + HRelease(pp, hp_end, hp); + } + else { + Uint final_size = hp - &(*bpp)->mem[0]; + Eterm brefs[2] = {msg, *tokenp}; + ASSERT(sz - (hp_end - hp) == final_size); + *bpp = erts_resize_message_buffer(*bpp, final_size, &brefs[0], 2); + msg = brefs[0]; + *tokenp = brefs[1]; + } + } + return msg; + + decode_error: + if (is_not_nil(*tokenp)) { + ErlHeapFragment *heap_frag = erts_dist_ext_trailer(dist_extp); + erts_cleanup_offheap(&heap_frag->off_heap); + } + erts_free_dist_ext_copy(dist_extp); + if (*bpp) + free_message_buffer(*bpp); + else if (hp) { + HRelease(pp, hp_end, hp); + } + *bpp = NULL; + return THE_NON_VALUE; + } + +static ERTS_INLINE void +notify_new_message(Process *receiver) +{ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS + & erts_proc_lc_my_proc_locks(receiver)); + + ACTIVATE(receiver); + + switch (receiver->status) { + case P_GARBING: + switch (receiver->gcstatus) { + case P_SUSPENDED: + goto suspended; + case P_WAITING: + goto waiting; + default: + break; + } + break; + case P_SUSPENDED: + suspended: + receiver->rstatus = P_RUNABLE; + break; + case P_WAITING: + waiting: + erts_add_to_runq(receiver); + break; + default: + break; + } +} + +void +erts_queue_dist_message(Process *rcvr, + ErtsProcLocks *rcvr_locks, + ErtsDistExternal *dist_ext, + Eterm token) +{ + ErlMessage* mp; +#ifdef ERTS_SMP + ErtsProcLocks need_locks; +#endif + + ERTS_SMP_LC_ASSERT(*rcvr_locks == erts_proc_lc_my_proc_locks(rcvr)); + + mp = message_alloc(); + +#ifdef ERTS_SMP + need_locks = ~(*rcvr_locks) & (ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS); + if (need_locks) { + *rcvr_locks |= need_locks; + if (erts_smp_proc_trylock(rcvr, need_locks) == EBUSY) { + if (need_locks == ERTS_PROC_LOCK_MSGQ) { + erts_smp_proc_unlock(rcvr, ERTS_PROC_LOCK_STATUS); + need_locks = (ERTS_PROC_LOCK_MSGQ + | ERTS_PROC_LOCK_STATUS); + } + erts_smp_proc_lock(rcvr, need_locks); + } + } + + if (rcvr->is_exiting || ERTS_PROC_PENDING_EXIT(rcvr)) { + /* Drop message if receiver is exiting or has a pending exit ... */ + if (is_not_nil(token)) { + ErlHeapFragment *heap_frag; + heap_frag = erts_dist_ext_trailer(mp->data.dist_ext); + erts_cleanup_offheap(&heap_frag->off_heap); + } + erts_free_dist_ext_copy(dist_ext); + message_free(mp); + } + else +#endif + if (IS_TRACED_FL(rcvr, F_TRACE_RECEIVE)) { + /* Ahh... need to decode it in order to trace it... */ + ErlHeapFragment *mbuf; + Eterm msg; + message_free(mp); + msg = erts_msg_distext2heap(rcvr, rcvr_locks, &mbuf, &token, dist_ext); + if (is_value(msg)) + erts_queue_message(rcvr, rcvr_locks, mbuf, msg, token); + } + else { + /* Enqueue message on external format */ + + ERL_MESSAGE_TERM(mp) = THE_NON_VALUE; + ERL_MESSAGE_TOKEN(mp) = token; + mp->next = NULL; + + mp->data.dist_ext = dist_ext; + LINK_MESSAGE(rcvr, mp); + + notify_new_message(rcvr); + } +} + +/* Add a message last in message queue */ +void +erts_queue_message(Process* receiver, + ErtsProcLocks *receiver_locks, + ErlHeapFragment* bp, + Eterm message, + Eterm seq_trace_token) +{ + ErlMessage* mp; +#ifdef ERTS_SMP + ErtsProcLocks need_locks; +#else + ASSERT(bp != NULL || receiver->mbuf == NULL); +#endif + + ERTS_SMP_LC_ASSERT(*receiver_locks == erts_proc_lc_my_proc_locks(receiver)); + + mp = message_alloc(); + +#ifdef ERTS_SMP + need_locks = ~(*receiver_locks) & (ERTS_PROC_LOCK_MSGQ + | ERTS_PROC_LOCK_STATUS); + if (need_locks) { + *receiver_locks |= need_locks; + if (erts_smp_proc_trylock(receiver, need_locks) == EBUSY) { + if (need_locks == ERTS_PROC_LOCK_MSGQ) { + erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS); + need_locks = (ERTS_PROC_LOCK_MSGQ + | ERTS_PROC_LOCK_STATUS); + } + erts_smp_proc_lock(receiver, need_locks); + } + } + + if (receiver->is_exiting || ERTS_PROC_PENDING_EXIT(receiver)) { + /* Drop message if receiver is exiting or has a pending + * exit ... + */ + if (bp) + free_message_buffer(bp); + message_free(mp); + return; + } +#endif + + ERL_MESSAGE_TERM(mp) = message; + ERL_MESSAGE_TOKEN(mp) = seq_trace_token; + mp->next = NULL; + +#ifdef ERTS_SMP + if (*receiver_locks & ERTS_PROC_LOCK_MAIN) { + mp->data.heap_frag = bp; + + /* + * We move 'in queue' to 'private queue' and place + * message at the end of 'private queue' in order + * to ensure that the 'in queue' doesn't contain + * references into the heap. By ensuring this, + * we don't need to include the 'in queue' in + * the root set when garbage collecting. + */ + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver); + LINK_MESSAGE_PRIVQ(receiver, mp); + } + else { + mp->data.heap_frag = bp; + LINK_MESSAGE(receiver, mp); + } +#else + mp->data.heap_frag = bp; + LINK_MESSAGE(receiver, mp); +#endif + + notify_new_message(receiver); + + if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { + trace_receive(receiver, message); + } + +#ifndef ERTS_SMP + ERTS_HOLE_CHECK(receiver); +#endif +} + +void +erts_link_mbuf_to_proc(struct process *proc, ErlHeapFragment *bp) +{ + Eterm* htop = HEAP_TOP(proc); + + link_mbuf_to_proc(proc, bp); + if (htop < HEAP_LIMIT(proc)) { + *htop = make_pos_bignum_header(HEAP_LIMIT(proc)-htop-1); + HEAP_TOP(proc) = HEAP_LIMIT(proc); + } +} + +/* + * Moves content of message buffer attached to a message into a heap. + * The message buffer is deallocated. + */ +void +erts_move_msg_mbuf_to_heap(Eterm** hpp, ErlOffHeap* off_heap, ErlMessage *msg) +{ + /* Unions for typecasts avoids warnings about type-punned pointers and aliasing */ + union { + Uint** upp; + ProcBin **pbpp; + ErlFunThing **efpp; + ExternalThing **etpp; + } oh_list_pp, oh_el_next_pp; + union { + Uint *up; + ProcBin *pbp; + ErlFunThing *efp; + ExternalThing *etp; + } oh_el_p; + Eterm term, token, *fhp, *hp; + Sint offs; + Uint sz; + ErlHeapFragment *bp; + +#ifdef HARD_DEBUG + ProcBin *dbg_mso_start = off_heap->mso; + ErlFunThing *dbg_fun_start = off_heap->funs; + ExternalThing *dbg_external_start = off_heap->externals; + Eterm dbg_term, dbg_token; + ErlHeapFragment *dbg_bp; + Uint *dbg_hp, *dbg_thp_start; + Uint dbg_term_sz, dbg_token_sz; +#endif + + bp = msg->data.heap_frag; + term = ERL_MESSAGE_TERM(msg); + token = ERL_MESSAGE_TOKEN(msg); + if (!bp) { + ASSERT(is_immed(term) && is_immed(token)); + return; + } + +#ifdef HARD_DEBUG + dbg_term_sz = size_object(term); + dbg_token_sz = size_object(token); + ASSERT(bp->size == dbg_term_sz + dbg_token_sz); + + dbg_bp = new_message_buffer(bp->size); + dbg_hp = dbg_bp->mem; + dbg_term = copy_struct(term, dbg_term_sz, &dbg_hp, &dbg_bp->off_heap); + dbg_token = copy_struct(token, dbg_token_sz, &dbg_hp, &dbg_bp->off_heap); + dbg_thp_start = *hpp; +#endif + + ASSERT(bp); + msg->data.attached = NULL; + + off_heap->overhead += bp->off_heap.overhead; + sz = bp->size; + +#ifdef DEBUG + if (is_not_immed(term)) { + ASSERT(bp->mem <= ptr_val(term)); + ASSERT(bp->mem + bp->size > ptr_val(term)); + } + + if (is_not_immed(token)) { + ASSERT(bp->mem <= ptr_val(token)); + ASSERT(bp->mem + bp->size > ptr_val(token)); + } +#endif + + fhp = bp->mem; + hp = *hpp; + offs = hp - fhp; + + oh_list_pp.upp = NULL; + oh_el_next_pp.upp = NULL; /* Shut up compiler warning */ + oh_el_p.up = NULL; /* Shut up compiler warning */ + while (sz--) { + Uint cpy_sz; + Eterm val = *fhp++; + + switch (primary_tag(val)) { + case TAG_PRIMARY_IMMED1: + *hp++ = val; + break; + case TAG_PRIMARY_LIST: + case TAG_PRIMARY_BOXED: + ASSERT(bp->mem <= ptr_val(val)); + ASSERT(bp->mem + bp->size > ptr_val(val)); + *hp++ = offset_ptr(val, offs); + break; + case TAG_PRIMARY_HEADER: + *hp++ = val; + switch (val & _HEADER_SUBTAG_MASK) { + case ARITYVAL_SUBTAG: + break; + case REFC_BINARY_SUBTAG: + oh_list_pp.pbpp = &off_heap->mso; + oh_el_p.up = (hp-1); + oh_el_next_pp.pbpp = &(oh_el_p.pbp)->next; + cpy_sz = thing_arityval(val); + goto cpy_words; + case FUN_SUBTAG: +#ifndef HYBRID + oh_list_pp.efpp = &off_heap->funs; + oh_el_p.up = (hp-1); + oh_el_next_pp.efpp = &(oh_el_p.efp)->next; +#endif + cpy_sz = thing_arityval(val); + goto cpy_words; + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: + oh_list_pp.etpp = &off_heap->externals; + oh_el_p.up = (hp-1); + oh_el_next_pp.etpp = &(oh_el_p.etp)->next; + cpy_sz = thing_arityval(val); + goto cpy_words; + default: + cpy_sz = header_arity(val); + + cpy_words: + sz -= cpy_sz; + while (cpy_sz >= 8) { + cpy_sz -= 8; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + *hp++ = *fhp++; + } + switch (cpy_sz) { + case 7: *hp++ = *fhp++; + case 6: *hp++ = *fhp++; + case 5: *hp++ = *fhp++; + case 4: *hp++ = *fhp++; + case 3: *hp++ = *fhp++; + case 2: *hp++ = *fhp++; + case 1: *hp++ = *fhp++; + default: break; + } + if (oh_list_pp.upp) { +#ifdef HARD_DEBUG + Uint *dbg_old_oh_list_p = *oh_list_pp.upp; +#endif + /* Add to offheap list */ + *oh_el_next_pp.upp = *oh_list_pp.upp; + *oh_list_pp.upp = oh_el_p.up; + ASSERT(*hpp <= oh_el_p.up); + ASSERT(hp > oh_el_p.up); +#ifdef HARD_DEBUG + switch (val & _HEADER_SUBTAG_MASK) { + case REFC_BINARY_SUBTAG: + ASSERT(off_heap->mso == *oh_list_pp.pbpp); + ASSERT(off_heap->mso->next + == (ProcBin *) dbg_old_oh_list_p); + break; +#ifndef HYBRID + case FUN_SUBTAG: + ASSERT(off_heap->funs == *oh_list_pp.efpp); + ASSERT(off_heap->funs->next + == (ErlFunThing *) dbg_old_oh_list_p); + break; +#endif + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: + case EXTERNAL_REF_SUBTAG: + ASSERT(off_heap->externals + == *oh_list_pp.etpp); + ASSERT(off_heap->externals->next + == (ExternalThing *) dbg_old_oh_list_p); + break; + default: + ASSERT(0); + } +#endif + oh_list_pp.upp = NULL; + + + } + break; + } + break; + } + } + + ASSERT(bp->size == hp - *hpp); + *hpp = hp; + + if (is_not_immed(token)) { + ASSERT(bp->mem <= ptr_val(token)); + ASSERT(bp->mem + bp->size > ptr_val(token)); + ERL_MESSAGE_TOKEN(msg) = offset_ptr(token, offs); +#ifdef HARD_DEBUG + ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TOKEN(msg))); + ASSERT(hp > ptr_val(ERL_MESSAGE_TOKEN(msg))); +#endif + } + + if (is_not_immed(term)) { + ASSERT(bp->mem <= ptr_val(term)); + ASSERT(bp->mem + bp->size > ptr_val(term)); + ERL_MESSAGE_TERM(msg) = offset_ptr(term, offs); +#ifdef HARD_DEBUG + ASSERT(dbg_thp_start <= ptr_val(ERL_MESSAGE_TERM(msg))); + ASSERT(hp > ptr_val(ERL_MESSAGE_TERM(msg))); +#endif + } + + +#ifdef HARD_DEBUG + { + int i, j; + { + ProcBin *mso = off_heap->mso; + i = j = 0; + while (mso != dbg_mso_start) { + mso = mso->next; + i++; + } + mso = bp->off_heap.mso; + while (mso) { + mso = mso->next; + j++; + } + ASSERT(i == j); + } + { + ErlFunThing *fun = off_heap->funs; + i = j = 0; + while (fun != dbg_fun_start) { + fun = fun->next; + i++; + } + fun = bp->off_heap.funs; + while (fun) { + fun = fun->next; + j++; + } + ASSERT(i == j); + } + { + ExternalThing *external = off_heap->externals; + i = j = 0; + while (external != dbg_external_start) { + external = external->next; + i++; + } + external = bp->off_heap.externals; + while (external) { + external = external->next; + j++; + } + ASSERT(i == j); + } + } +#endif + + + bp->off_heap.mso = NULL; +#ifndef HYBRID + bp->off_heap.funs = NULL; +#endif + bp->off_heap.externals = NULL; + free_message_buffer(bp); + +#ifdef HARD_DEBUG + ASSERT(eq(ERL_MESSAGE_TERM(msg), dbg_term)); + ASSERT(eq(ERL_MESSAGE_TOKEN(msg), dbg_token)); + free_message_buffer(dbg_bp); +#endif + +} + +Uint +erts_msg_attached_data_size_aux(ErlMessage *msg) +{ + Sint sz; + ASSERT(is_non_value(ERL_MESSAGE_TERM(msg))); + ASSERT(msg->data.dist_ext); + ASSERT(msg->data.dist_ext->heap_size < 0); + + sz = erts_decode_dist_ext_size(msg->data.dist_ext, 0); + if (sz < 0) { + /* Bad external; remove it */ + if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) { + ErlHeapFragment *heap_frag; + heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + erts_cleanup_offheap(&heap_frag->off_heap); + } + erts_free_dist_ext_copy(msg->data.dist_ext); + msg->data.dist_ext = NULL; + return 0; + } + + msg->data.dist_ext->heap_size = sz; + if (is_not_nil(msg->m[1])) { + ErlHeapFragment *heap_frag; + heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + sz += heap_frag->size; + } + return sz; +} + +void +erts_move_msg_attached_data_to_heap(Eterm **hpp, ErlOffHeap *ohp, ErlMessage *msg) +{ + if (is_value(ERL_MESSAGE_TERM(msg))) + erts_move_msg_mbuf_to_heap(hpp, ohp, msg); + else if (msg->data.dist_ext) { + ASSERT(msg->data.dist_ext->heap_size >= 0); + if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) { + ErlHeapFragment *heap_frag; + heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + ERL_MESSAGE_TOKEN(msg) = copy_struct(ERL_MESSAGE_TOKEN(msg), + heap_frag->size, + hpp, + ohp); + erts_cleanup_offheap(&heap_frag->off_heap); + } + ERL_MESSAGE_TERM(msg) = erts_decode_dist_ext(hpp, + ohp, + msg->data.dist_ext); + erts_free_dist_ext_copy(msg->data.dist_ext); + msg->data.dist_ext = NULL; + } + /* else: bad external detected when calculating size */ +} + +/* + * Send a local message when sender & receiver processes are known. + */ + +void +erts_send_message(Process* sender, + Process* receiver, + ErtsProcLocks *receiver_locks, + Eterm message, + unsigned flags) +{ + Uint msize; + ErlHeapFragment* bp = NULL; + Eterm token = NIL; + + BM_STOP_TIMER(system); + BM_MESSAGE(message,sender,receiver); + BM_START_TIMER(send); + + if (SEQ_TRACE_TOKEN(sender) != NIL && !(flags & ERTS_SND_FLG_NO_SEQ_TRACE)) { + Eterm* hp; + + BM_SWAP_TIMER(send,size); + msize = size_object(message); + BM_SWAP_TIMER(size,send); + + seq_trace_update_send(sender); + seq_trace_output(SEQ_TRACE_TOKEN(sender), message, SEQ_TRACE_SEND, + receiver->id, sender); + bp = new_message_buffer(msize + 6 /* TUPLE5 */); + hp = bp->mem; + + BM_SWAP_TIMER(send,copy); + token = copy_struct(SEQ_TRACE_TOKEN(sender), + 6 /* TUPLE5 */, + &hp, + &bp->off_heap); + + message = copy_struct(message, msize, &hp, &bp->off_heap); + BM_MESSAGE_COPIED(msize); + BM_SWAP_TIMER(copy,send); + + erts_queue_message(receiver, + receiver_locks, + bp, + message, + token); + BM_SWAP_TIMER(send,system); +#ifdef HYBRID + } else { + ErlMessage* mp = message_alloc(); + BM_SWAP_TIMER(send,copy); +#ifdef INCREMENTAL + /* TODO: During GC activate processes if the message relies in + * the fromspace and the sender is active. During major + * collections add the message to the gray stack if it relies + * in the old generation and the sender is active and the + * receiver is inactive. + + if (!IS_CONST(message) && (ma_gc_flags & GC_CYCLE) && + (ptr_val(message) >= inc_fromspc && + ptr_val(message) < inc_fromend) && INC_IS_ACTIVE(sender)) + INC_ACTIVATE(receiver); + else if (!IS_CONST(message) && (ma_gc_flags & GC_CYCLE) && + (ptr_val(message) >= global_old_heap && + ptr_val(message) < global_old_hend) && + INC_IS_ACTIVE(sender) && !INC_IS_ACTIVE(receiver)) + Mark message in blackmap and add it to the gray stack + */ + + if (!IS_CONST(message)) + INC_ACTIVATE(receiver); +#endif + LAZY_COPY(sender,message); + BM_SWAP_TIMER(copy,send); + ERL_MESSAGE_TERM(mp) = message; + ERL_MESSAGE_TOKEN(mp) = NIL; + mp->next = NULL; + LINK_MESSAGE(receiver, mp); + ACTIVATE(receiver); + + if (receiver->status == P_WAITING) { + erts_add_to_runq(receiver); + } else if (receiver->status == P_SUSPENDED) { + receiver->rstatus = P_RUNABLE; + } + if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { + trace_receive(receiver, message); + } + + BM_SWAP_TIMER(send,system); + return; +#else + } else if (sender == receiver) { + /* Drop message if receiver has a pending exit ... */ +#ifdef ERTS_SMP + ErtsProcLocks need_locks = (~(*receiver_locks) + & (ERTS_PROC_LOCK_MSGQ + | ERTS_PROC_LOCK_STATUS)); + if (need_locks) { + *receiver_locks |= need_locks; + if (erts_smp_proc_trylock(receiver, need_locks) == EBUSY) { + if (need_locks == ERTS_PROC_LOCK_MSGQ) { + erts_smp_proc_unlock(receiver, ERTS_PROC_LOCK_STATUS); + need_locks = ERTS_PROC_LOCK_MSGQ|ERTS_PROC_LOCK_STATUS; + } + erts_smp_proc_lock(receiver, need_locks); + } + } + if (!ERTS_PROC_PENDING_EXIT(receiver)) +#endif + { + ErlMessage* mp = message_alloc(); + + mp->data.attached = NULL; + ERL_MESSAGE_TERM(mp) = message; + ERL_MESSAGE_TOKEN(mp) = NIL; + mp->next = NULL; + /* + * We move 'in queue' to 'private queue' and place + * message at the end of 'private queue' in order + * to ensure that the 'in queue' doesn't contain + * references into the heap. By ensuring this, + * we don't need to include the 'in queue' in + * the root set when garbage collecting. + */ + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(receiver); + LINK_MESSAGE_PRIVQ(receiver, mp); + + if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { + trace_receive(receiver, message); + } + } + BM_SWAP_TIMER(send,system); + return; + } else { +#ifdef ERTS_SMP + ErlOffHeap *ohp; + Eterm *hp; + BM_SWAP_TIMER(send,size); + msize = size_object(message); + BM_SWAP_TIMER(size,send); + hp = erts_alloc_message_heap(msize,&bp,&ohp,receiver,receiver_locks); + BM_SWAP_TIMER(send,copy); + message = copy_struct(message, msize, &hp, ohp); + BM_MESSAGE_COPIED(msz); + BM_SWAP_TIMER(copy,send); + erts_queue_message(receiver, receiver_locks, bp, message, token); + BM_SWAP_TIMER(send,system); +#else + ErlMessage* mp = message_alloc(); + Eterm *hp; + BM_SWAP_TIMER(send,size); + msize = size_object(message); + BM_SWAP_TIMER(size,send); + + if (receiver->stop - receiver->htop <= msize) { + BM_SWAP_TIMER(send,system); + erts_garbage_collect(receiver, msize, receiver->arg_reg, receiver->arity); + BM_SWAP_TIMER(system,send); + } + hp = receiver->htop; + receiver->htop = hp + msize; + BM_SWAP_TIMER(send,copy); + message = copy_struct(message, msize, &hp, &receiver->off_heap); + BM_MESSAGE_COPIED(msize); + BM_SWAP_TIMER(copy,send); + ERL_MESSAGE_TERM(mp) = message; + ERL_MESSAGE_TOKEN(mp) = NIL; + mp->next = NULL; + mp->data.attached = NULL; + LINK_MESSAGE(receiver, mp); + + if (receiver->status == P_WAITING) { + erts_add_to_runq(receiver); + } else if (receiver->status == P_SUSPENDED) { + receiver->rstatus = P_RUNABLE; + } + if (IS_TRACED_FL(receiver, F_TRACE_RECEIVE)) { + trace_receive(receiver, message); + } + BM_SWAP_TIMER(send,system); +#endif /* #ifndef ERTS_SMP */ + return; +#endif /* HYBRID */ + } +} + +/* + * This function delivers an EXIT message to a process + * which is trapping EXITs. + */ + +void +erts_deliver_exit_message(Eterm from, Process *to, ErtsProcLocks *to_locksp, + Eterm reason, Eterm token) +{ + Eterm mess; + Eterm save; + Eterm from_copy; + Uint sz_reason; + Uint sz_token; + Uint sz_from; + Eterm* hp; + Eterm temptoken; + ErlHeapFragment* bp = NULL; + + if (token != NIL) { + + ASSERT(is_tuple(token)); + sz_reason = size_object(reason); + sz_token = size_object(token); + sz_from = size_object(from); + bp = new_message_buffer(sz_reason + sz_from + sz_token + 4); + hp = bp->mem; + mess = copy_struct(reason, sz_reason, &hp, &bp->off_heap); + from_copy = copy_struct(from, sz_from, &hp, &bp->off_heap); + save = TUPLE3(hp, am_EXIT, from_copy, mess); + hp += 4; + /* the trace token must in this case be updated by the caller */ + seq_trace_output(token, save, SEQ_TRACE_SEND, to->id, NULL); + temptoken = copy_struct(token, sz_token, &hp, &bp->off_heap); + erts_queue_message(to, to_locksp, bp, save, temptoken); + } else { + ErlOffHeap *ohp; + sz_reason = size_object(reason); + sz_from = IS_CONST(from) ? 0 : size_object(from); + + hp = erts_alloc_message_heap(sz_reason+sz_from+4, + &bp, + &ohp, + to, + to_locksp); + + mess = copy_struct(reason, sz_reason, &hp, ohp); + from_copy = (IS_CONST(from) + ? from + : copy_struct(from, sz_from, &hp, ohp)); + save = TUPLE3(hp, am_EXIT, from_copy, mess); + erts_queue_message(to, to_locksp, bp, save, NIL); + } +} diff --git a/erts/emulator/beam/erl_message.h b/erts/emulator/beam/erl_message.h new file mode 100644 index 0000000000..f14f14a586 --- /dev/null +++ b/erts/emulator/beam/erl_message.h @@ -0,0 +1,251 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERL_MESSAGE_H__ +#define __ERL_MESSAGE_H__ + +struct proc_bin; +struct external_thing_; + +/* + * This struct represents data that must be updated by structure copy, + * but is stored outside of any heap. + */ + +typedef struct erl_off_heap { + struct proc_bin* mso; /* List of associated binaries. */ +#ifndef HYBRID /* FIND ME! */ + struct erl_fun_thing* funs; /* List of funs. */ +#endif + struct external_thing_* externals; /* List of external things. */ + int overhead; /* Administrative overhead (used to force GC). */ +} ErlOffHeap; + +#include "external.h" +#include "erl_process.h" + +/* + * This struct represents a heap fragment, which is used when there + * isn't sufficient room in the process heap and we can't do a GC. + */ + +typedef struct erl_heap_fragment ErlHeapFragment; +struct erl_heap_fragment { + ErlHeapFragment* next; /* Next heap fragment */ + ErlOffHeap off_heap; /* Offset heap data. */ + unsigned size; /* Size in words of mem */ + Eterm mem[1]; /* Data */ +}; + +#define ERTS_SET_MBUF_HEAP_END(BP, HENDP) \ +do { \ + unsigned real_size__ = (BP)->size; \ + ASSERT((BP)->mem <= (HENDP) && (HENDP) <= (BP)->mem + real_size__); \ + (BP)->size = (HENDP) - (BP)->mem; \ + /* We do not reallocate since buffer *might* be moved. */ \ + /* FIXME: Memory count is wrong, but at least it's almost */ \ + /* right... */ \ +} while (0) + +typedef struct erl_mesg { + struct erl_mesg* next; /* Next message */ + union { + ErtsDistExternal *dist_ext; + ErlHeapFragment *heap_frag; + void *attached; + } data; + Eterm m[2]; /* m[0] = message, m[1] = seq trace token */ +} ErlMessage; + +#define ERL_MESSAGE_TERM(mp) ((mp)->m[0]) +#define ERL_MESSAGE_TOKEN(mp) ((mp)->m[1]) + +/* Size of default message buffer (erl_message.c) */ +#define ERL_MESSAGE_BUF_SZ 500 + +typedef struct { + ErlMessage* first; + ErlMessage** last; /* point to the last next pointer */ + ErlMessage** save; + int len; /* queue length */ +} ErlMessageQueue; + +#ifdef ERTS_SMP + +typedef struct { + ErlMessage* first; + ErlMessage** last; /* point to the last next pointer */ + int len; /* queue length */ +} ErlMessageInQueue; + +#endif + +/* Get "current" message */ +#define PEEK_MESSAGE(p) (*(p)->msg.save) + + +/* Add message last in private message queue */ +#define LINK_MESSAGE_PRIVQ(p, mp) do { \ + *(p)->msg.last = (mp); \ + (p)->msg.last = &(mp)->next; \ + (p)->msg.len++; \ +} while(0) + + +#ifdef ERTS_SMP + +/* Move in message queue to end of private message queue */ +#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(P) \ +do { \ + if ((P)->msg_inq.first) { \ + *(P)->msg.last = (P)->msg_inq.first; \ + (P)->msg.last = (P)->msg_inq.last; \ + (P)->msg.len += (P)->msg_inq.len; \ + (P)->msg_inq.first = NULL; \ + (P)->msg_inq.last = &(P)->msg_inq.first; \ + (P)->msg_inq.len = 0; \ + } \ +} while (0) + +/* Add message last in message queue */ +#define LINK_MESSAGE(p, mp) do { \ + *(p)->msg_inq.last = (mp); \ + (p)->msg_inq.last = &(mp)->next; \ + (p)->msg_inq.len++; \ +} while(0) + +#else + +#define ERTS_SMP_MSGQ_MV_INQ2PRIVQ(P) + +/* Add message last in message queue */ +#define LINK_MESSAGE(p, mp) LINK_MESSAGE_PRIVQ((p), (mp)) + +#endif + +/* Unlink current message */ +#define UNLINK_MESSAGE(p,msgp) do { \ + ErlMessage* __mp = (msgp)->next; \ + *(p)->msg.save = __mp; \ + (p)->msg.len--; \ + if (__mp == NULL) \ + (p)->msg.last = (p)->msg.save; \ +} while(0) + +/* Reset message save point (after receive match) */ +#define JOIN_MESSAGE(p) \ + (p)->msg.save = &(p)->msg.first + +/* Save current message */ +#define SAVE_MESSAGE(p) \ + (p)->msg.save = &(*(p)->msg.save)->next + +/* + * ErtsMoveMsgAttachmentIntoProc() moves data attached to a message + * onto the heap of a process. The attached data is the content of + * the the message either on the internal format or on the external + * format, and also possibly a seq trace token on the internal format. + * If the message content is on the external format, the decode might + * fail. If the decoding fails, ERL_MESSAGE_TERM(M) will contain + * THE_NON_VALUE. That is, ERL_MESSAGE_TERM(M) *has* to be checked + * afterwards and taken care of appropriately. + * + * ErtsMoveMsgAttachmentIntoProc() will shallow copy to heap if + * possible; otherwise, move to heap via garbage collection. + * + * ErtsMoveMsgAttachmentIntoProc() is used when receiveing messages + * in process_main() and in hipe_check_get_msg(). + */ + +#define ErtsMoveMsgAttachmentIntoProc(M, P, ST, HT, FC, SWPO, SWPI) \ +do { \ + if ((M)->data.attached) { \ + Uint need__ = erts_msg_attached_data_size((M)); \ + if ((ST) - (HT) >= need__) { \ + Uint *htop__ = (HT); \ + erts_move_msg_attached_data_to_heap(&htop__, &MSO((P)), (M));\ + ASSERT(htop__ - (HT) <= need__); \ + (HT) = htop__; \ + } \ + else { \ + { SWPO ; } \ + (FC) -= erts_garbage_collect((P), 0, NULL, 0); \ + { SWPI ; } \ + } \ + ASSERT(!(M)->data.attached); \ + } \ +} while (0) + +#define ERTS_SND_FLG_NO_SEQ_TRACE (((unsigned) 1) << 0) + +#define ERTS_HEAP_FRAG_SIZE(DATA_WORDS) \ + (sizeof(ErlHeapFragment) - sizeof(Eterm) + (DATA_WORDS)*sizeof(Eterm)) +#define ERTS_INIT_HEAP_FRAG(HEAP_FRAG_P, DATA_WORDS) \ +do { \ + (HEAP_FRAG_P)->next = NULL; \ + (HEAP_FRAG_P)->size = (DATA_WORDS); \ + (HEAP_FRAG_P)->off_heap.mso = NULL; \ + (HEAP_FRAG_P)->off_heap.funs = NULL; \ + (HEAP_FRAG_P)->off_heap.externals = NULL; \ + (HEAP_FRAG_P)->off_heap.overhead = 0; \ +} while (0) + +void init_message(void); +void free_message(ErlMessage *); +ErlHeapFragment* new_message_buffer(Uint); +ErlHeapFragment* erts_resize_message_buffer(ErlHeapFragment *, Uint, + Eterm *, Uint); +void free_message_buffer(ErlHeapFragment *); +void erts_queue_dist_message(Process*, ErtsProcLocks*, ErtsDistExternal *, Eterm); +void erts_queue_message(Process*, ErtsProcLocks*, ErlHeapFragment*, Eterm, Eterm); +void erts_deliver_exit_message(Eterm, Process*, ErtsProcLocks *, Eterm, Eterm); +void erts_send_message(Process*, Process*, ErtsProcLocks*, Eterm, unsigned); +void erts_link_mbuf_to_proc(Process *proc, ErlHeapFragment *bp); + +void erts_move_msg_mbuf_to_heap(Eterm**, ErlOffHeap*, ErlMessage *); + +Uint erts_msg_attached_data_size_aux(ErlMessage *msg); +void erts_move_msg_attached_data_to_heap(Eterm **, ErlOffHeap *, ErlMessage *); + +Eterm erts_msg_distext2heap(Process *, ErtsProcLocks *, ErlHeapFragment **, + Eterm *, ErtsDistExternal *); + +ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE Uint erts_msg_attached_data_size(ErlMessage *msg) +{ + ASSERT(msg->data.attached); + if (is_value(ERL_MESSAGE_TERM(msg))) + return msg->data.heap_frag->size; + else if (msg->data.dist_ext->heap_size < 0) + return erts_msg_attached_data_size_aux(msg); + else { + Uint sz = msg->data.dist_ext->heap_size; + if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) { + ErlHeapFragment *heap_frag; + heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + sz += heap_frag->size; + } + return sz; + } +} +#endif + +#endif diff --git a/erts/emulator/beam/erl_monitors.c b/erts/emulator/beam/erl_monitors.c new file mode 100644 index 0000000000..d873c7a701 --- /dev/null +++ b/erts/emulator/beam/erl_monitors.c @@ -0,0 +1,1019 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/************************************************************************** + * Monitors and links data structure manipulation. + * Monitors and links are organized as AVL trees with the reference as + * key in the monitor case and the pid of the linked process as key in the + * link case. Lookups the order of the references is somewhat special. Local + * references are strictly smaller than remote references and are sorted + * by inlined comparision functionality. Remote references are handled by the + * usual cmp function. + * Each Monitor is tagged with different tags depending on which end of the + * monitor it is. + * A monitor is removed either explicitly by reference or all monitors are + * removed when the process exits. No need to access the monitor by pid. + **************************************************************************/ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "erl_db.h" +#include "bif.h" +#include "big.h" +#include "erl_monitors.h" + +#define STACK_NEED 50 +#define MAX_MONITORS 0xFFFFFFFFUL + +#define DIR_LEFT 0 +#define DIR_RIGHT 1 +#define DIR_END 2 + +static erts_smp_atomic_t tot_link_lh_size; + +/* Implements the sort order in monitor trees, which is different from + the ordinary term order. + No short local ref's should ever exist (the ref is created by the bif's + in runtime), therefore: + All local ref's are less than external ref's + Local ref's are inline-compared, + External ref's are compared by cmp */ + +#if 0 +#define CMP_MON_REF(Ref1,Ref2) \ +cmp((Ref1),(Ref2)) /* XXX, the inline comparision yet to be done */ +#else +#define CMP_MON_REF(Ref1,Ref2) cmp_mon_ref((Ref1),(Ref2)) +#endif + +static ERTS_INLINE int cmp_mon_ref(Eterm ref1, Eterm ref2) +{ + Eterm *b1, *b2; + + + b1 = boxed_val(ref1); + b2 = boxed_val(ref2); + if (is_ref_thing_header(*b1)) { + if (is_ref_thing_header(*b2)) { + return memcmp(b1+1,b2+1,ERTS_REF_WORDS*sizeof(Uint)); + } + return -1; + } + if (is_ref_thing_header(*b2)) { + return 1; + } + return cmp(ref1,ref2); +} + +#define CP_LINK_VAL(To, Hp, From) \ +do { \ + if (IS_CONST(From)) \ + (To) = (From); \ + else { \ + Uint i__; \ + Uint len__; \ + ASSERT((Hp)); \ + ASSERT(is_internal_ref((From)) || is_external((From))); \ + (To) = make_boxed((Hp)); \ + len__ = thing_arityval(*boxed_val((From))) + 1; \ + for(i__ = 0; i__ < len__; i__++) \ + (*((Hp)++)) = boxed_val((From))[i__]; \ + if (is_external((To))) { \ + external_thing_ptr((To))->next = NULL; \ + erts_refc_inc(&(external_thing_ptr((To))->node->refc), 2);\ + } \ + } \ +} while (0) + +static ErtsMonitor *create_monitor(Uint type, Eterm ref, Eterm pid, Eterm name) +{ + Uint mon_size = ERTS_MONITOR_SIZE; + ErtsMonitor *n; + Eterm *hp; + + mon_size += NC_HEAP_SIZE(ref); + if (!IS_CONST(pid)) { + mon_size += NC_HEAP_SIZE(pid); + } + + if (mon_size <= ERTS_MONITOR_SH_SIZE) { + n = (ErtsMonitor *) erts_alloc(ERTS_ALC_T_MONITOR_SH, + mon_size*sizeof(Uint)); + } else { + n = (ErtsMonitor *) erts_alloc(ERTS_ALC_T_MONITOR_LH, + mon_size*sizeof(Uint)); + erts_smp_atomic_add(&tot_link_lh_size, mon_size*sizeof(Uint)); + } + hp = n->heap; + + + n->left = n->right = NULL; /* Always the same initial value*/ + n->type = (Uint16) type; + n->balance = 0; /* Always the same initial value */ + n->name = name; /* atom() or [] */ + CP_LINK_VAL(n->ref, hp, ref); /*XXX Unneccesary check, never immediate*/ + CP_LINK_VAL(n->pid, hp, pid); + + return n; +} + +static ErtsLink *create_link(Uint type, Eterm pid) +{ + Uint lnk_size = ERTS_LINK_SIZE; + ErtsLink *n; + Eterm *hp; + + if (!IS_CONST(pid)) { + lnk_size += NC_HEAP_SIZE(pid); + } + + if (lnk_size <= ERTS_LINK_SH_SIZE) { + n = (ErtsLink *) erts_alloc(ERTS_ALC_T_NLINK_SH, + lnk_size*sizeof(Uint)); + } else { + n = (ErtsLink *) erts_alloc(ERTS_ALC_T_NLINK_LH, + lnk_size*sizeof(Uint)); + erts_smp_atomic_add(&tot_link_lh_size, lnk_size*sizeof(Uint)); + } + hp = n->heap; + + + n->left = n->right = NULL; /* Always the same initial value*/ + n->type = (Uint16) type; + n->balance = 0; /* Always the same initial value */ + if (n->type == LINK_NODE) { + ERTS_LINK_REFC(n) = 0; + } else { + ERTS_LINK_ROOT(n) = NULL; + } + CP_LINK_VAL(n->pid, hp, pid); + + return n; +} + +#undef CP_LINK_VAL + +static ErtsSuspendMonitor *create_suspend_monitor(Eterm pid) +{ + ErtsSuspendMonitor *smon = erts_alloc(ERTS_ALC_T_SUSPEND_MON, + sizeof(ErtsSuspendMonitor)); + smon->left = smon->right = NULL; /* Always the same initial value */ + smon->balance = 0; /* Always the same initial value */ + smon->pending = 0; + smon->active = 0; + smon->pid = pid; + return smon; +} + +void +erts_init_monitors(void) +{ + erts_smp_atomic_init(&tot_link_lh_size, 0); +} + +Uint +erts_tot_link_lh_size(void) +{ + return (Uint) erts_smp_atomic_read(&tot_link_lh_size); +} + +void erts_destroy_monitor(ErtsMonitor *mon) +{ + Uint mon_size = ERTS_MONITOR_SIZE; + ErlNode *node; + + ASSERT(!IS_CONST(mon->ref)); + mon_size += NC_HEAP_SIZE(mon->ref); + if (is_external(mon->ref)) { + node = external_thing_ptr(mon->ref)->node; + erts_deref_node_entry(node); + } + if (!IS_CONST(mon->pid)) { + mon_size += NC_HEAP_SIZE(mon->pid); + if (is_external(mon->pid)) { + node = external_thing_ptr(mon->pid)->node; + erts_deref_node_entry(node); + } + } + if (mon_size <= ERTS_MONITOR_SH_SIZE) { + erts_free(ERTS_ALC_T_MONITOR_SH, (void *) mon); + } else { + erts_free(ERTS_ALC_T_MONITOR_LH, (void *) mon); + erts_smp_atomic_add(&tot_link_lh_size, -1*mon_size*sizeof(Uint)); + } +} + +void erts_destroy_link(ErtsLink *lnk) +{ + Uint lnk_size = ERTS_LINK_SIZE; + ErlNode *node; + + ASSERT(lnk->type == LINK_NODE || ERTS_LINK_ROOT(lnk) == NULL); + + if (!IS_CONST(lnk->pid)) { + lnk_size += NC_HEAP_SIZE(lnk->pid); + if (is_external(lnk->pid)) { + node = external_thing_ptr(lnk->pid)->node; + erts_deref_node_entry(node); + } + } + if (lnk_size <= ERTS_LINK_SH_SIZE) { + erts_free(ERTS_ALC_T_NLINK_SH, (void *) lnk); + } else { + erts_free(ERTS_ALC_T_NLINK_LH, (void *) lnk); + erts_smp_atomic_add(&tot_link_lh_size, -1*lnk_size*sizeof(Uint)); + } +} + +void erts_destroy_suspend_monitor(ErtsSuspendMonitor *smon) +{ + erts_free(ERTS_ALC_T_SUSPEND_MON, smon); +} + +static void insertion_rotation(int dstack[], int dpos, + void *tstack[], int tpos, + int state) { + + ErtsMonitorOrLink **this; + ErtsMonitorOrLink *p1, *p2, *p; + int dir; + + while (state && ( dir = dstack[--dpos] ) != DIR_END) { + this = tstack[--tpos]; + p = *this; + if (dir == DIR_LEFT) { + switch (p->balance) { + case 1: + p->balance = 0; + state = 0; + break; + case 0: + p->balance = -1; + break; + case -1: /* The icky case */ + p1 = p->left; + if (p1->balance == -1) { /* Single LL rotation */ + p->left = p1->right; + p1->right = p; + p->balance = 0; + (*this) = p1; + } else { /* Double RR rotation */ + p2 = p1->right; + p1->right = p2->left; + p2->left = p1; + p->left = p2->right; + p2->right = p; + p->balance = (p2->balance == -1) ? +1 : 0; + p1->balance = (p2->balance == 1) ? -1 : 0; + (*this) = p2; + } + (*this)->balance = 0; + state = 0; + break; + } + } else { /* dir == DIR_RIGHT */ + switch (p->balance) { + case -1: + p->balance = 0; + state = 0; + break; + case 0: + p->balance = 1; + break; + case 1: + p1 = p->right; + if (p1->balance == 1) { /* Single RR rotation */ + p->right = p1->left; + p1->left = p; + p->balance = 0; + (*this) = p1; + } else { /* Double RL rotation */ + p2 = p1->left; + p1->left = p2->right; + p2->right = p1; + p->right = p2->left; + p2->left = p; + p->balance = (p2->balance == 1) ? -1 : 0; + p1->balance = (p2->balance == -1) ? 1 : 0; + (*this) = p2; + } + (*this)->balance = 0; + state = 0; + break; + } + } + } +} + +void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid, + Eterm name) +{ + void *tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int state = 0; + ErtsMonitor **this = root; + Sint c; + + dstack[0] = DIR_END; + for (;;) { + if (!*this) { /* Found our place */ + state = 1; + *this = create_monitor(type,ref,pid,name); + break; + } else if ((c = CMP_MON_REF(ref,(*this)->ref)) < 0) { + /* go left */ + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Equal key is an error for monitors */ + erl_exit(1,"Insertion of already present monitor!"); + break; + } + } + insertion_rotation(dstack, dpos, tstack, tpos, state); +} + + +/* Returns 0 if OK, < 0 if already present */ +int erts_add_link(ErtsLink **root, Uint type, Eterm pid) +{ + void *tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int state = 0; + ErtsLink **this = root; + Sint c; + + dstack[0] = DIR_END; + for (;;) { + if (!*this) { /* Found our place */ + state = 1; + *this = create_link(type,pid); + break; + } else if ((c = cmp(pid,(*this)->pid)) < 0) { + /* go left */ + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Equal key is an error for monitors */ + return -1; + } + } + insertion_rotation(dstack, dpos, tstack, tpos, state); + return 0; +} + +ErtsSuspendMonitor * +erts_add_or_lookup_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid) +{ + void *tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int state = 0; + ErtsSuspendMonitor **this = root; + ErtsSuspendMonitor *res; + Sint c; + + dstack[0] = DIR_END; + for (;;) { + if (!*this) { /* Found our place */ + state = 1; + res = *this = create_suspend_monitor(pid); + break; + } else if ((c = cmp(pid,(*this)->pid)) < 0) { + /* go left */ + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Already here... */ + ASSERT((*this)->pid == pid); + return *this; + } + } + insertion_rotation(dstack, dpos, tstack, tpos, state); + return res; +} + + +/* Returns the new or old link structure */ +ErtsLink *erts_add_or_lookup_link(ErtsLink **root, Uint type, Eterm pid) +{ + void *tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int state = 0; + ErtsLink **this = root; + Sint c; + ErtsLink *ret = NULL; + + dstack[0] = DIR_END; + for (;;) { + if (!*this) { /* Found our place */ + state = 1; + *this = create_link(type,pid); + ret = *this; + break; + } else if ((c = cmp(pid,(*this)->pid)) < 0) { + /* go left */ + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Equal key is an error for monitors */ + return *this; + } + } + insertion_rotation(dstack, dpos, tstack, tpos, state); + return ret; +} + + +/* + * Deletion helpers + */ +static int balance_left(ErtsMonitorOrLink **this) +{ + ErtsMonitorOrLink *p, *p1, *p2; + int b1, b2, h = 1; + + p = *this; + switch (p->balance) { + case -1: + p->balance = 0; + break; + case 0: + p->balance = 1; + h = 0; + break; + case 1: + p1 = p->right; + b1 = p1->balance; + if (b1 >= 0) { /* Single RR rotation */ + p->right = p1->left; + p1->left = p; + if (b1 == 0) { + p->balance = 1; + p1->balance = -1; + h = 0; + } else { + p->balance = p1->balance = 0; + } + (*this) = p1; + } else { /* Double RL rotation */ + p2 = p1->left; + b2 = p2->balance; + p1->left = p2->right; + p2->right = p1; + p->right = p2->left; + p2->left = p; + p->balance = (b2 == 1) ? -1 : 0; + p1->balance = (b2 == -1) ? 1 : 0; + p2->balance = 0; + (*this) = p2; + } + break; + } + return h; +} + +static int balance_right(ErtsMonitorOrLink **this) +{ + ErtsMonitorOrLink *p, *p1, *p2; + int b1, b2, h = 1; + + p = *this; + switch (p->balance) { + case 1: + p->balance = 0; + break; + case 0: + p->balance = -1; + h = 0; + break; + case -1: + p1 = p->left; + b1 = p1->balance; + if (b1 <= 0) { /* Single LL rotation */ + p->left = p1->right; + p1->right = p; + if (b1 == 0) { + p->balance = -1; + p1->balance = 1; + h = 0; + } else { + p->balance = p1->balance = 0; + } + (*this) = p1; + } else { /* Double LR rotation */ + p2 = p1->right; + b2 = p2->balance; + p1->right = p2->left; + p2->left = p1; + p->left = p2->right; + p2->right = p; + p->balance = (b2 == -1) ? 1 : 0; + p1->balance = (b2 == 1) ? -1 : 0; + p2->balance = 0; + (*this) = p2; + } + } + return h; +} + +static int delsub(ErtsMonitorOrLink **this) +{ + ErtsMonitorOrLink **tstack[STACK_NEED]; + int tpos = 0; + ErtsMonitorOrLink *q = (*this); + ErtsMonitorOrLink **r = &(q->left); + int h; + + /* + * Walk down the tree to the right and search + * for a void right child, pick that child out + * and return it to be put in the deleted + * object's place. + */ + + while ((*r)->right != NULL) { + tstack[tpos++] = r; + r = &((*r)->right); + } + *this = *r; + *r = (*r)->left; + (*this)->left = q->left; + (*this)->right = q->right; + (*this)->balance = q->balance; + tstack[0] = &((*this)->left); + h = 1; + while (tpos && h) { + r = tstack[--tpos]; + h = balance_right(r); + } + return h; +} + +ErtsMonitor *erts_remove_monitor(ErtsMonitor **root, Eterm ref) +{ + ErtsMonitor **tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int state = 0; + ErtsMonitor **this = root; + Sint c; + int dir; + ErtsMonitor *q = NULL; + + dstack[0] = DIR_END; + for (;;) { + if (!*this) { /* Failure */ + return NULL; + } else if ((c = CMP_MON_REF(ref,(*this)->ref)) < 0) { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Equal key, found the one to delete */ + q = (*this); + if (q->right == NULL) { + (*this) = q->left; + state = 1; + } else if (q->left == NULL) { + (*this) = q->right; + state = 1; + } else { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + state = delsub((ErtsMonitorOrLink **) this); + } + break; + } + } + while (state && ( dir = dstack[--dpos] ) != DIR_END) { + this = tstack[--tpos]; + if (dir == DIR_LEFT) { + state = balance_left((ErtsMonitorOrLink **) this); + } else { + state = balance_right((ErtsMonitorOrLink **) this); + } + } + return q; +} + +ErtsLink *erts_remove_link(ErtsLink **root, Eterm pid) +{ + ErtsLink **tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int state = 0; + ErtsLink **this = root; + Sint c; + int dir; + ErtsLink *q = NULL; + + dstack[0] = DIR_END; + for (;;) { + if (!*this) { /* Failure */ + return NULL; + } else if ((c = cmp(pid,(*this)->pid)) < 0) { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Equal key, found the one to delete */ + q = (*this); + if (q->right == NULL) { + (*this) = q->left; + state = 1; + } else if (q->left == NULL) { + (*this) = q->right; + state = 1; + } else { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + state = delsub((ErtsMonitorOrLink **) this); + } + break; + } + } + while (state && ( dir = dstack[--dpos] ) != DIR_END) { + this = tstack[--tpos]; + if (dir == DIR_LEFT) { + state = balance_left((ErtsMonitorOrLink **) this); + } else { + state = balance_right((ErtsMonitorOrLink **) this); + } + } + return q; +} + +void +erts_delete_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid) +{ + ErtsSuspendMonitor **tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int state = 0; + ErtsSuspendMonitor **this = root; + Sint c; + int dir; + ErtsSuspendMonitor *q = NULL; + + dstack[0] = DIR_END; + for (;;) { + if (!*this) { /* Nothing found */ + return; + } else if ((c = cmp(pid,(*this)->pid)) < 0) { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + this = &((*this)->left); + } else if (c > 0) { /* go right */ + dstack[dpos++] = DIR_RIGHT; + tstack[tpos++] = this; + this = &((*this)->right); + } else { /* Equal key, found the one to delete */ + q = (*this); + ASSERT(q->pid == pid); + if (q->right == NULL) { + (*this) = q->left; + state = 1; + } else if (q->left == NULL) { + (*this) = q->right; + state = 1; + } else { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = this; + state = delsub((ErtsMonitorOrLink **) this); + } + erts_destroy_suspend_monitor(q); + break; + } + } + while (state && ( dir = dstack[--dpos] ) != DIR_END) { + this = tstack[--tpos]; + if (dir == DIR_LEFT) { + state = balance_left((ErtsMonitorOrLink **) this); + } else { + state = balance_right((ErtsMonitorOrLink **) this); + } + } +} + +ErtsMonitor *erts_lookup_monitor(ErtsMonitor *root, Eterm ref) +{ + Sint c; + + for (;;) { + if (root == NULL || (c = CMP_MON_REF(ref,root->ref)) == 0) { + return root; + } else if (c < 0) { + root = root->left; + } else { /* c > 0 */ + root = root->right; + } + } +} + +ErtsLink *erts_lookup_link(ErtsLink *root, Eterm pid) +{ + Sint c; + + for (;;) { + if (root == NULL || (c = cmp(pid,root->pid)) == 0) { + return root; + } else if (c < 0) { + root = root->left; + } else { /* c > 0 */ + root = root->right; + } + } +} + +ErtsSuspendMonitor * +erts_lookup_suspend_monitor(ErtsSuspendMonitor *root, Eterm pid) +{ + Sint c; + + for (;;) { + if (root == NULL || (c = cmp(pid,root->pid)) == 0) { + return root; + } else if (c < 0) { + root = root->left; + } else { /* c > 0 */ + root = root->right; + } + } +} + +void erts_sweep_monitors(ErtsMonitor *root, + void (*doit)(ErtsMonitor *, void *), + void *context) +{ + ErtsMonitor *tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int dir; + + dstack[0] = DIR_END; + + for (;;) { + if (root == NULL) { + if ((dir = dstack[dpos-1]) == DIR_END) { + return; + } + if (dir == DIR_LEFT) { + /* Still has DIR_RIGHT to do */ + dstack[dpos-1] = DIR_RIGHT; + root = (tstack[tpos-1])->right; + } else { + /* stacktop is an object to be deleted */ + (*doit)(tstack[--tpos],context); /* expeted to do the + deletion */ + --dpos; + root = NULL; + } + } else { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = root; + root = root->left; + } + } +} + +void erts_sweep_links(ErtsLink *root, + void (*doit)(ErtsLink *, void *), + void *context) +{ + ErtsLink *tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int dir; + + dstack[0] = DIR_END; + + for (;;) { + if (root == NULL) { + if ((dir = dstack[dpos-1]) == DIR_END) { + return; + } + if (dir == DIR_LEFT) { + /* Still has DIR_RIGHT to do */ + dstack[dpos-1] = DIR_RIGHT; + root = (tstack[tpos-1])->right; + } else { + /* stacktop is an object to be deleted */ + (*doit)(tstack[--tpos],context); /* expeted to do the + deletion */ + --dpos; + root = NULL; + } + } else { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = root; + root = root->left; + } + } +} + +void erts_sweep_suspend_monitors(ErtsSuspendMonitor *root, + void (*doit)(ErtsSuspendMonitor *, void *), + void *context) +{ + ErtsSuspendMonitor *tstack[STACK_NEED]; + int tpos = 0; + int dstack[STACK_NEED+1]; + int dpos = 1; + int dir; + + dstack[0] = DIR_END; + + for (;;) { + if (root == NULL) { + if ((dir = dstack[dpos-1]) == DIR_END) { + return; + } + if (dir == DIR_LEFT) { + /* Still has DIR_RIGHT to do */ + dstack[dpos-1] = DIR_RIGHT; + root = (tstack[tpos-1])->right; + } else { + /* stacktop is an object to be deleted */ + (*doit)(tstack[--tpos],context); /* expeted to do the + deletion */ + --dpos; + root = NULL; + } + } else { + dstack[dpos++] = DIR_LEFT; + tstack[tpos++] = root; + root = root->left; + } + } +} + + +/* Debug BIF, always present, but undocumented... */ + +static void erts_dump_monitors(ErtsMonitor *root, int indent) +{ + if (root == NULL) + return; + erts_dump_monitors(root->right,indent+2); + erts_printf("%*s[%b16d:%b16u:%T:%T:%T]\n", indent, "", root->balance, + root->type, root->ref, root->pid, root->name); + erts_dump_monitors(root->left,indent+2); +} + +static void erts_dump_links_aux(ErtsLink *root, int indent, + erts_dsprintf_buf_t *dsbufp) +{ + if (root == NULL) + return; + erts_dump_links_aux(root->right, indent+2, dsbufp); + dsbufp->str_len = 0; + erts_dsprintf(dsbufp, "%*s[%b16d:%b16u:%T:%p]", indent, "", + root->balance, root->type, root->pid, ERTS_LINK_ROOT(root)); + if (ERTS_LINK_ROOT(root) != NULL) { + ErtsLink *sub = ERTS_LINK_ROOT(root); + int len = dsbufp->str_len; + erts_dump_links_aux(sub->right, indent+len+5, dsbufp); + erts_dsprintf(dsbufp, "-> %*s[%b16d:%b16u:%T:%p]", indent, "", + sub->balance, sub->type, sub->pid, ERTS_LINK_ROOT(sub)); + erts_printf("%s\n", dsbufp->str); + erts_dump_links_aux(sub->left, indent+len+5, dsbufp); + } else { + erts_printf("%s\n", dsbufp->str); + } + erts_dump_links_aux(root->left, indent+2, dsbufp); +} + +static void erts_dump_links(ErtsLink *root, int indent) +{ + erts_dsprintf_buf_t *dsbufp = erts_create_tmp_dsbuf(0); + erts_dump_links_aux(root, indent, dsbufp); + erts_destroy_tmp_dsbuf(dsbufp); +} + +Eterm erts_debug_dump_monitors_1(Process *p, Eterm pid) +{ + Process *rp; + DistEntry *dep; + rp = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid, ERTS_PROC_LOCK_LINK); + if (!rp) { + ERTS_SMP_ASSERT_IS_NOT_EXITING(p); + if (is_atom(pid) && is_node_name_atom(pid) && + (dep = erts_find_dist_entry(pid)) != NULL) { + erts_printf("Dumping dist monitors-------------------\n"); + erts_smp_de_links_lock(dep); + erts_dump_monitors(dep->monitors,0); + erts_smp_de_links_unlock(dep); + erts_printf("Monitors dumped-------------------------\n"); + erts_deref_dist_entry(dep); + BIF_RET(am_true); + } else { + BIF_ERROR(p,BADARG); + } + } else { + erts_printf("Dumping pid monitors--------------------\n"); + erts_dump_monitors(rp->monitors,0); + erts_printf("Monitors dumped-------------------------\n"); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + BIF_RET(am_true); + } +} + +Eterm erts_debug_dump_links_1(Process *p, Eterm pid) +{ + Process *rp; + DistEntry *dep; + if (is_internal_port(pid)) { + Port *rport = erts_id2port(pid, p, ERTS_PROC_LOCK_MAIN); + if (rport) { + erts_printf("Dumping port links----------------------\n"); + erts_dump_links(rport->nlinks,0); + erts_printf("Links dumped----------------------------\n"); + erts_smp_port_unlock(rport); + BIF_RET(am_true); + } else { + BIF_ERROR(p,BADARG); + } + } else { + rp = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, pid, ERTS_PROC_LOCK_LINK); + if (!rp) { + ERTS_SMP_ASSERT_IS_NOT_EXITING(p); + if (is_atom(pid) && is_node_name_atom(pid) && + (dep = erts_find_dist_entry(pid)) != NULL) { + erts_printf("Dumping dist links----------------------\n"); + erts_smp_de_links_lock(dep); + erts_dump_links(dep->nlinks,0); + erts_smp_de_links_unlock(dep); + erts_printf("Links dumped----------------------------\n"); + erts_deref_dist_entry(dep); + BIF_RET(am_true); + } else { + BIF_ERROR(p,BADARG); + } + + } else { + erts_printf("Dumping pid links-----------------------\n"); + erts_dump_links(rp->nlinks,0); + erts_printf("Links dumped----------------------------\n"); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + BIF_RET(am_true); + } + } +} diff --git a/erts/emulator/beam/erl_monitors.h b/erts/emulator/beam/erl_monitors.h new file mode 100644 index 0000000000..d3f6d410dd --- /dev/null +++ b/erts/emulator/beam/erl_monitors.h @@ -0,0 +1,180 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/********************************************************************** + * Header for monitors and links data structures. + * Monitors are kept in an AVL tree and the data structures for + * the four different types of monitors are like this: + ********************************************************************** + * Local monitor by pid/port: + * (Ref is always same in all involved data structures) + ********************************************************************** + * Process/Port X Process Y + * +-------------+ +-------------+ + * Type: | MON_ORIGIN | | MON_TARGET | + * +-------------+ +-------------+ + * Pid: | Pid(Y) | | Pid/Port(X) | + * +-------------+ +-------------+ + * Name: | [] | | [] | + * +-------------+ +-------------+ + ********************************************************************** + * Local monitor by name: (Ref is always same in all involved data structures) + ********************************************************************** + * Process X Process Y (name foo) + * +-------------+ +-------------+ + * Type: | MON_ORIGIN | | MON_TARGET | + * +-------------+ +-------------+ + * Pid: | Pid(Y) | | Pid(X) | + * +-------------+ +-------------+ + * Name: | Atom(foo) | | Atom(foo) | + * +-------------+ +-------------+ + ********************************************************************** + * Remote monitor by pid: (Ref is always same in all involved data structures) + ********************************************************************** + * Node A | Node B + * ---------------------------------+---------------------------------- + * Process X (@A) Distentry @A Distentry @B Process Y (@B) + * for node B for node A + * +-------------+ +-------------+ +-------------+ +-------------+ + * Type: | MON_ORIGIN | | MON_TARGET | | MON_ORIGIN | | MON_TARGET | + * +-------------+ +-------------+ +-------------+ +-------------+ + * Pid: | Pid(Y) | | Pid(X) | | Pid(Y) | | Pid(X) | + * +-------------+ +-------------+ +-------------+ +-------------+ + * Name: | [] | | [] | | [] | | [] | + * +-------------+ +-------------+ +-------------+ +-------------+ + ********************************************************************** + * Remote monitor by name: (Ref is always same in all involved data structures) + ********************************************************************** + * Node A | Node B + * ---------------------------------+---------------------------------- + * Process X (@A) Distentry @A Distentry @B Process Y (@B) + * for node B for node A (name foo) + * +-------------+ +-------------+ +-------------+ +-------------+ + * Type: | MON_ORIGIN | | MON_TARGET | | MON_ORIGIN | | MON_TARGET | + * +-------------+ +-------------+ +-------------+ +-------------+ + * Pid: | Atom(node B)| | Pid(X) | | Pid(Y) | | Pid(X) | + * +-------------+ +-------------+ +-------------+ +-------------+ + * Name: | Atom(foo) | | Atom(foo) | | Atom(foo) | | Atom(foo) | + * +-------------+ +-------------+ +-------------+ +-------------+ + * The reason for the node atom in X->pid is that we don't know the actual + * pid of the monitored process on the other node when setting the monitor + * (which is done asyncronously). + **********************************************************************/ +#ifndef _ERL_MONITORS_H +#define _ERL_MONITORS_H + +/* Type tags for monitors */ +#define MON_ORIGIN 1 +#define MON_TARGET 3 + +/* Type tags for links */ +#define LINK_PID 1 /* ...Or port */ +#define LINK_NODE 3 /* "Node monitor" */ + +/* Size of a monitor without heap, in words (fixalloc) */ +#define ERTS_MONITOR_SIZE ((sizeof(ErtsMonitor) - sizeof(Uint))/sizeof(Uint)) +#define ERTS_MONITOR_SH_SIZE (ERTS_MONITOR_SIZE + REF_THING_SIZE) +#define ERTS_LINK_SIZE ((sizeof(ErtsLink) - sizeof(Uint))/sizeof(Uint)) +#define ERTS_LINK_SH_SIZE ERTS_LINK_SIZE /* Size of fix-alloced links */ + +/* ErtsMonitor and ErtsLink *need* to begin in a similar way as + ErtsMonitorOrLink */ +typedef struct erts_monitor_or_link { + struct erts_monitor_or_link *left, *right; + Sint16 balance; +} ErtsMonitorOrLink; + +typedef struct erts_monitor { + struct erts_monitor *left, *right; + Sint16 balance; + Uint16 type; /* MON_ORIGIN | MON_TARGET */ + Eterm ref; + Eterm pid; /* In case of distributed named monitor, this is the + nodename atom in MON_ORIGIN process, otherwise a pid or + , in case of a MON_TARGET, a port */ + Eterm name; /* When monitoring a named process: atom() else [] */ + Uint heap[1]; /* Larger in reality */ +} ErtsMonitor; + +typedef struct erts_link { + struct erts_link *left, *right; + Sint16 balance; + Uint16 type; /* LINK_PID | LINK_NODE */ + Eterm pid; /* When node monitor, + the node atom is here instead */ + union { + struct erts_link *root; /* Used only in dist entries */ + Uint refc; + } shared; + Uint heap[1]; /* Larger in reality */ +} ErtsLink; + +typedef struct erts_suspend_monitor { + struct erts_suspend_monitor *left, *right; + Sint16 balance; + + int pending; + int active; + Eterm pid; +} ErtsSuspendMonitor; + +#define ERTS_LINK_ROOT(Linkp) ((Linkp)->shared.root) +#define ERTS_LINK_REFC(Linkp) ((Linkp)->shared.refc) + +#define ERTS_LINK_ROOT_AS_UINT(Linkp) (*((Uint *) &((Linkp)->root))) + +Uint erts_tot_link_lh_size(void); + + +/* Prototypes */ +void erts_destroy_monitor(ErtsMonitor *mon); +void erts_add_monitor(ErtsMonitor **root, Uint type, Eterm ref, Eterm pid, + Eterm name); +ErtsMonitor *erts_remove_monitor(ErtsMonitor **root, Eterm ref); +ErtsMonitor *erts_lookup_monitor(ErtsMonitor *root, Eterm ref); +void erts_sweep_monitors(ErtsMonitor *root, + void (*doit)(ErtsMonitor *, void *), + void *context); + +void erts_destroy_link(ErtsLink *lnk); +/* Returns 0 if OK, < 0 if already present */ +int erts_add_link(ErtsLink **root, Uint type, Eterm pid); +ErtsLink *erts_add_or_lookup_link(ErtsLink **root, Uint type, Eterm pid); +ErtsLink *erts_remove_link(ErtsLink **root, Eterm pid); +ErtsLink *erts_lookup_link(ErtsLink *root, Eterm pid); +void erts_sweep_links(ErtsLink *root, + void (*doit)(ErtsLink *, void *), + void *context); + +void erts_destroy_suspend_monitor(ErtsSuspendMonitor *sproc); +void erts_sweep_suspend_monitors(ErtsSuspendMonitor *root, + void (*doit)(ErtsSuspendMonitor *, void *), + void *context); +ErtsSuspendMonitor *erts_add_or_lookup_suspend_monitor(ErtsSuspendMonitor **root, + Eterm pid); +ErtsSuspendMonitor *erts_lookup_suspend_monitor(ErtsSuspendMonitor *root, + Eterm pid); +void erts_delete_suspend_monitor(ErtsSuspendMonitor **root, Eterm pid); +void erts_init_monitors(void); + +#define erts_doforall_monitors erts_sweep_monitors +#define erts_doforall_links erts_sweep_links +#define erts_doforall_suspend_monitors erts_sweep_suspend_monitors + +#endif /* _ERL_MONITORS_H */ diff --git a/erts/emulator/beam/erl_mtrace.c b/erts/emulator/beam/erl_mtrace.c new file mode 100644 index 0000000000..8b8ac2ec80 --- /dev/null +++ b/erts/emulator/beam/erl_mtrace.c @@ -0,0 +1,1240 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Memory allocation trace. The trace is sent over a + * tcp/ip connection. + * + * The trace format is not intended to be documented. + * Instead a library for parsing the trace will be + * distributed. This in order to more easily be able + * to make changes in the trace format. The library + * for parsing the trace is currently not included in + * the OTP distribution, but will be in the future. + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "global.h" +#include "erl_sock.h" +#include "erl_threads.h" +#include "erl_memory_trace_protocol.h" +#include "erl_mtrace.h" + +#if defined(MAXHOSTNAMELEN) && MAXHOSTNAMELEN > 255 +# undef MAXHOSTNAMELEN +#endif + +#ifndef MAXHOSTNAMELEN +# define MAXHOSTNAMELEN 255 +#endif + +#define TRACE_PRINTOUTS 0 +#ifdef TRACE_PRINTOUTS +#define MSB2BITS(X) ((((unsigned)(X))+1)*8) +#endif + +static erts_mtx_t mtrace_op_mutex; +static erts_mtx_t mtrace_buf_mutex; + +#define TRACE_BUF_SZ (16*1024) + + +#define UI8_MSB_EHF_SZ ERTS_MT_UI8_MSB_EHDR_FLD_SZ +#define UI16_MSB_EHF_SZ ERTS_MT_UI16_MSB_EHDR_FLD_SZ +#define UI32_MSB_EHF_SZ ERTS_MT_UI32_MSB_EHDR_FLD_SZ +#define UI64_MSB_EHF_SZ ERTS_MT_UI64_MSB_EHDR_FLD_SZ +#define UI_MSB_EHF_SZ ERTS_MT_UI64_MSB_EHDR_FLD_SZ +#define TAG_EHF_SZ ERTS_MT_TAG_EHDR_FLD_SZ + +#define UI8_MSB_EHF_MSK ERTS_MT_UI8_MSB_EHDR_FLD_MSK +#define UI16_MSB_EHF_MSK ERTS_MT_UI16_MSB_EHDR_FLD_MSK +#define UI32_MSB_EHF_MSK ERTS_MT_UI32_MSB_EHDR_FLD_MSK +#define UI_MSB_EHF_MSK ERTS_MT_UI64_MSB_EHDR_FLD_MSK +#define UI64_MSB_EHF_MSK ERTS_MT_UI64_MSB_EHDR_FLD_MSK +#define TAG_EHF_MSK ERTS_MT_TAG_EHDR_FLD_MSK + +#define UI8_SZ (1) +#define UI16_SZ (2) +#define UI32_SZ (4) +#define UI64_SZ (8) +#ifdef ARCH_64 +# define UI_SZ UI64_SZ +#else +# define UI_SZ UI32_SZ +#endif + +#define WRITE_UI8(P, V) (*(P) = (byte) ((V) & 0xff)) + +#define WRITE_UI16(P, V) \ + ((P)[0] = (byte) (((V) >> 8) & 0xff), \ + (P)[1] = (byte) ( (V) & 0xff)) + +#define WRITE_UI32(P, V) \ + ((P)[0] = (byte) (((V) >> 24) & 0xff), \ + (P)[1] = (byte) (((V) >> 16) & 0xff), \ + (P)[2] = (byte) (((V) >> 8) & 0xff), \ + (P)[3] = (byte) ( (V) & 0xff)) + +#define WRITE_UI64(P, V) \ + ((P)[0] = (byte) (((V) >> 56) & 0xff), \ + (P)[1] = (byte) (((V) >> 48) & 0xff), \ + (P)[2] = (byte) (((V) >> 40) & 0xff), \ + (P)[3] = (byte) (((V) >> 32) & 0xff), \ + (P)[4] = (byte) (((V) >> 24) & 0xff), \ + (P)[5] = (byte) (((V) >> 16) & 0xff), \ + (P)[6] = (byte) (((V) >> 8) & 0xff), \ + (P)[7] = (byte) ( (V) & 0xff)) + +#define PUT_UI8(P, V) (WRITE_UI8((P), (V)), (P) += UI8_SZ) +#define PUT_UI16(P, V) (WRITE_UI16((P), (V)), (P) += UI16_SZ) +#define PUT_UI32(P, V) (WRITE_UI32((P), (V)), (P) += UI32_SZ) +#define PUT_UI64(P, V) (WRITE_UI64((P), (V)), (P) += UI64_SZ) + +#define PUT_VSZ_UI16(P, M, V) \ +do { \ + Uint16 v__ = (Uint16) (V); \ + if (v__ >= (((Uint16) 1) << 8)) (M) = 1; else (M) = 0; \ + switch ((M)) { \ + case 1: *((P)++) = (byte) ((v__ >> 8) & 0xff); \ + case 0: *((P)++) = (byte) ( v__ & 0xff); \ + } \ +} while (0) + +#define PUT_VSZ_UI32(P, M, V) \ +do { \ + Uint32 v__ = (Uint32) (V); \ + if (v__ >= (((Uint32) 1) << 16)) { \ + if (v__ >= (((Uint32) 1) << 24)) (M) = 3; else (M) = 2; \ + } else { \ + if (v__ >= (((Uint32) 1) << 8)) (M) = 1; else (M) = 0; \ + } \ + switch ((M)) { \ + case 3: *((P)++) = (byte) ((v__ >> 24) & 0xff); \ + case 2: *((P)++) = (byte) ((v__ >> 16) & 0xff); \ + case 1: *((P)++) = (byte) ((v__ >> 8) & 0xff); \ + case 0: *((P)++) = (byte) ( v__ & 0xff); \ + } \ +} while (0) + +#ifdef ARCH_64 + +#define PUT_VSZ_UI64(P, M, V) \ +do { \ + Uint64 v__ = (Uint64) (V); \ + if (v__ >= (((Uint64) 1) << 32)) { \ + if (v__ >= (((Uint64) 1) << 48)) { \ + if (v__ >= (((Uint64) 1) << 56)) (M) = 7; else (M) = 6; \ + } else { \ + if (v__ >= (((Uint64) 1) << 40)) (M) = 5; else (M) = 4; \ + } \ + } else { \ + if (v__ >= (((Uint64) 1) << 16)) { \ + if (v__ >= (((Uint64) 1) << 24)) (M) = 3; else (M) = 2; \ + } else { \ + if (v__ >= (((Uint64) 1) << 8)) (M) = 1; else (M) = 0; \ + } \ + } \ + switch ((M)) { \ + case 7: *((P)++) = (byte) ((v__ >> 56) & 0xff); \ + case 6: *((P)++) = (byte) ((v__ >> 48) & 0xff); \ + case 5: *((P)++) = (byte) ((v__ >> 40) & 0xff); \ + case 4: *((P)++) = (byte) ((v__ >> 32) & 0xff); \ + case 3: *((P)++) = (byte) ((v__ >> 24) & 0xff); \ + case 2: *((P)++) = (byte) ((v__ >> 16) & 0xff); \ + case 1: *((P)++) = (byte) ((v__ >> 8) & 0xff); \ + case 0: *((P)++) = (byte) ( v__ & 0xff); \ + } \ +} while (0) + +#define PUT_VSZ_UI PUT_VSZ_UI64 +#else /* #ifdef ARCH_64 */ +#define PUT_VSZ_UI PUT_VSZ_UI32 +#endif /* #ifdef ARCH_64 */ + +#define MAKE_TBUF_SZ(SZ) \ + (TRACE_BUF_SZ < (SZ) \ + ? (disable_trace(1, "Internal buffer overflow", 0), 0) \ + : (endp - tracep < (SZ) ? send_trace_buffer() : 1)) + + +static void disable_trace(int error, char *reason, int eno); +static int send_trace_buffer(void); + +#ifdef DEBUG +void +check_alloc_entry(byte *sp, byte *ep, + byte tag, + Uint16 ct_no, int ct_no_n, + Uint16 type, int type_n, + Uint res, int res_n, + Uint size, int size_n, + Uint32 ti,int ti_n); +void +check_realloc_entry(byte *sp, byte *ep, + byte tag, + Uint16 ct_no, int ct_no_n, + Uint16 type, int type_n, + Uint res, int res_n, + Uint ptr, int ptr_n, + Uint size, int size_n, + Uint32 ti,int ti_n); +void +check_free_entry(byte *sp, byte *ep, + byte tag, + Uint16 ct_no, int ct_no_n, + Uint16 t_no, int t_no_n, + Uint ptr, int ptr_n, + Uint32 ti,int ti_n); +void +check_time_inc_entry(byte *sp, byte *ep, + Uint32 secs, int secs_n, + Uint32 usecs, int usecs_n); +#endif + + + +int erts_mtrace_enabled; +static erts_sock_t socket_desc; +static byte trace_buffer[TRACE_BUF_SZ]; +static byte *tracep; +static byte *endp; +static SysTimeval last_tv; + +#if ERTS_MTRACE_SEGMENT_ID >= ERTS_ALC_A_MIN || ERTS_MTRACE_SEGMENT_ID < 0 +#error ERTS_MTRACE_SEGMENT_ID >= ERTS_ALC_A_MIN || ERTS_MTRACE_SEGMENT_ID < 0 +#endif + +char* erl_errno_id(int error); + +#define INVALID_TIME_INC (0xffffffff) + +static ERTS_INLINE Uint32 +get_time_inc(void) +{ + Sint32 secs; + Sint32 usecs; + Uint32 res; + SysTimeval tv; + sys_gettimeofday(&tv); + + secs = tv.tv_sec - last_tv.tv_sec; + if (tv.tv_usec >= last_tv.tv_usec) + usecs = tv.tv_usec - last_tv.tv_usec; + else { + secs--; + usecs = 1000000 + tv.tv_usec - last_tv.tv_usec; + } + + ASSERT(0 <= usecs); + ASSERT(usecs < 1000000); + + if (secs < 0) { + /* Clock stepped backwards; we pretend that no time has past. */ + res = 0; + } + else if (secs < ERTS_MT_TIME_INC_SECS_MASK) { + res = ((((Uint32) secs) << ERTS_MT_TIME_INC_SECS_SHIFT) + | (((Uint32) usecs) << ERTS_MT_TIME_INC_USECS_SHIFT)); + } + else { + /* Increment too large to fit in a 32-bit integer; + put a time inc entry in trace ... */ + if (MAKE_TBUF_SZ(UI8_SZ + UI16_SZ + 2*UI32_SZ)) { + byte *hdrp; + Uint16 hdr; + int secs_n, usecs_n; + + *(tracep++) = ERTS_MT_TIME_INC_BDY_TAG; + + hdrp = tracep; + tracep += 2; + + PUT_VSZ_UI32(tracep, secs_n, secs); + PUT_VSZ_UI32(tracep, usecs_n, usecs); + + hdr = usecs_n; + + hdr <<= UI32_MSB_EHF_SZ; + hdr |= secs_n; + + WRITE_UI16(hdrp, hdr); +#ifdef DEBUG + check_time_inc_entry(hdrp-1, tracep, + (Uint32) secs, secs_n, + (Uint32) usecs, usecs_n); +#endif + res = 0; + } + else { + res = INVALID_TIME_INC; + } + } + + last_tv = tv; + return res; +} + + +static void +disable_trace(int error, char *reason, int eno) +{ + char *mt_dis = "Memory trace disabled"; + char *eno_str; + + erts_mtrace_enabled = 0; + erts_sock_close(socket_desc); + socket_desc = ERTS_SOCK_INVALID_SOCKET; + + if (eno == 0) + erts_fprintf(stderr, "%s: %s\n", mt_dis, reason); + else { + eno_str = erl_errno_id(eno); + if (strcmp(eno_str, "unknown") == 0) + erts_fprintf(stderr, "%s: %s: %d\n", mt_dis, reason, eno); + else + erts_fprintf(stderr, "%s: %s: %s\n", mt_dis, reason, eno_str); + } +} + +static int +send_trace_buffer(void) +{ + ssize_t ssz; + size_t sz; + + sz = tracep - trace_buffer; + tracep = trace_buffer; + + do { + ssz = erts_sock_send(socket_desc, (void *) tracep, sz); + if (ssz < 0) { + int socket_errno = erts_sock_errno(); + +#ifdef EINTR + if (socket_errno == EINTR) + continue; +#endif + disable_trace(0, "Connection lost", socket_errno); + return 0; + } + if (ssz > sz) { + disable_trace(1, "Unexpected error", 0); + return 0; + } + tracep += ssz; + sz -= ssz; + } while (sz); + + tracep = trace_buffer; + return 1; +} + +#if ERTS_ALC_N_MAX >= (1 << 16) +#error "Excessively large type numbers" +#endif + + +static int +write_trace_header(char *nodename, char *pid, char *hostname) +{ +#ifdef DEBUG + byte *startp; +#endif + Uint16 entry_sz; + Uint32 flags, n_len, h_len, p_len, hdr_prolog_len; + int i, no, str_len; + const char *str; + struct { + Uint32 gsec; + Uint32 sec; + Uint32 usec; + } start_time; + + sys_gettimeofday(&last_tv); + + start_time.gsec = (Uint32) (last_tv.tv_sec / 1000000000); + start_time.sec = (Uint32) (last_tv.tv_sec % 1000000000); + start_time.usec = (Uint32) last_tv.tv_usec; + + if (!MAKE_TBUF_SZ(3*UI32_SZ)) + return 0; + + flags = 0; +#ifdef ARCH_64 + flags |= ERTS_MT_64_BIT_FLAG; +#endif + flags |= ERTS_MT_CRR_INFO; +#ifdef ERTS_CAN_TRACK_MALLOC + flags |= ERTS_MT_SEG_CRR_INFO; +#endif + + /* + * The following 3 ui32 words *always* have to come + * first in the trace. + */ + PUT_UI32(tracep, ERTS_MT_START_WORD); + PUT_UI32(tracep, ERTS_MT_MAJOR_VSN); + PUT_UI32(tracep, ERTS_MT_MINOR_VSN); + + n_len = strlen(nodename); + h_len = strlen(hostname); + p_len = strlen(pid); + hdr_prolog_len = (2*UI32_SZ + + 3*UI16_SZ + + 3*UI32_SZ + + 3*UI8_SZ + + n_len + + h_len + + p_len); + + if (!MAKE_TBUF_SZ(hdr_prolog_len)) + return 0; + + /* + * New stuff can be added at the end the of header prolog + * (EOHP). The reader should skip stuff at the end, that it + * doesn't understand. + */ + +#ifdef DEBUG + startp = tracep; +#endif + + PUT_UI32(tracep, hdr_prolog_len); + PUT_UI32(tracep, flags); + PUT_UI16(tracep, ERTS_MTRACE_SEGMENT_ID); + PUT_UI16(tracep, ERTS_ALC_A_MAX); + PUT_UI16(tracep, ERTS_ALC_N_MAX); + + PUT_UI32(tracep, start_time.gsec); + PUT_UI32(tracep, start_time.sec); + PUT_UI32(tracep, start_time.usec); + + PUT_UI8(tracep, (byte) n_len); + memcpy((void *) tracep, (void *) nodename, n_len); + tracep += n_len; + + PUT_UI8(tracep, (byte) h_len); + memcpy((void *) tracep, (void *) hostname, h_len); + tracep += h_len; + + PUT_UI8(tracep, (byte) p_len); + memcpy((void *) tracep, (void *) pid, p_len); + tracep += p_len; + + ASSERT(startp + hdr_prolog_len == tracep); + + /* + * EOHP + */ + + /* + * All tags from here on should be followed by an Uint16 size + * field containing the total size of the entry. + * + * New stuff can eigther be added at the end of an entry, or + * as a new tagged entry. The reader should skip stuff at the + * end, that it doesn't understand. + */ + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + Uint16 aflags = 0; + +#ifndef ERTS_CAN_TRACK_MALLOC + if (i != ERTS_ALC_A_SYSTEM) +#endif + aflags |= ERTS_MT_ALLCTR_USD_CRR_INFO; + + str = ERTS_ALC_A2AD(i); + ASSERT(str); + str_len = strlen(str); + if (str_len >= (1 << 8)) { + disable_trace(1, "Excessively large allocator string", 0); + return 0; + } + + entry_sz = UI8_SZ + 3*UI16_SZ + UI8_SZ; + entry_sz += (erts_allctrs_info[i].alloc_util ? 2 : 1)*UI16_SZ; + entry_sz += UI8_SZ + str_len; + + if (!MAKE_TBUF_SZ(entry_sz)) + return 0; + +#ifdef DEBUG + startp = tracep; +#endif + PUT_UI8(tracep, ERTS_MT_ALLOCATOR_HDR_TAG); + PUT_UI16(tracep, entry_sz); + PUT_UI16(tracep, aflags); + PUT_UI16(tracep, (Uint16) i); + PUT_UI8( tracep, (byte) str_len); + memcpy((void *) tracep, (void *) str, str_len); + tracep += str_len; + if (erts_allctrs_info[i].alloc_util) { + PUT_UI8(tracep, 2); + PUT_UI16(tracep, ERTS_MTRACE_SEGMENT_ID); + PUT_UI16(tracep, ERTS_ALC_A_SYSTEM); + } + else { + PUT_UI8(tracep, 1); + switch (i) { + case ERTS_ALC_A_SYSTEM: + PUT_UI16(tracep, ERTS_MTRACE_SEGMENT_ID); + break; + case ERTS_ALC_A_FIXED_SIZE: + if (erts_allctrs_info[ERTS_FIX_CORE_ALLOCATOR].enabled) + PUT_UI16(tracep, ERTS_FIX_CORE_ALLOCATOR); + else + PUT_UI16(tracep, ERTS_ALC_A_SYSTEM); + break; + default: + PUT_UI16(tracep, ERTS_MTRACE_SEGMENT_ID); + break; + } + } + ASSERT(startp + entry_sz == tracep); + } + + for (i = ERTS_ALC_N_MIN; i <= ERTS_ALC_N_MAX; i++) { + Uint16 nflags = 0; + str = ERTS_ALC_N2TD(i); + ASSERT(str); + + str_len = strlen(str); + if (str_len >= (1 << 8)) { + disable_trace(1, "Excessively large type string", 0); + return 0; + } + + no = ERTS_ALC_T2A(ERTS_ALC_N2T(i)); + if (!erts_allctrs_info[no].enabled) + no = ERTS_ALC_A_SYSTEM; + ASSERT(ERTS_ALC_A_MIN <= no && no <= ERTS_ALC_A_MAX); + + entry_sz = UI8_SZ + 3*UI16_SZ + UI8_SZ + str_len + UI16_SZ; + + if (!MAKE_TBUF_SZ(entry_sz)) + return 0; + +#ifdef DEBUG + startp = tracep; +#endif + PUT_UI8(tracep, ERTS_MT_BLOCK_TYPE_HDR_TAG); + PUT_UI16(tracep, entry_sz); + PUT_UI16(tracep, nflags); + PUT_UI16(tracep, (Uint16) i); + PUT_UI8(tracep, (byte) str_len); + memcpy((void *) tracep, (void *) str, str_len); + tracep += str_len; + PUT_UI16(tracep, no); + ASSERT(startp + entry_sz == tracep); + } + + entry_sz = UI8_SZ + UI16_SZ; + if (!MAKE_TBUF_SZ(entry_sz)) + return 0; + PUT_UI8(tracep, ERTS_MT_END_OF_HDR_TAG); + PUT_UI16(tracep, entry_sz); + + return 1; +} + +static void *mtrace_alloc(ErtsAlcType_t, void *, Uint); +static void *mtrace_realloc(ErtsAlcType_t, void *, void *, Uint); +static void mtrace_free(ErtsAlcType_t, void *, void *); + +static ErtsAllocatorFunctions_t real_allctrs[ERTS_ALC_A_MAX+1]; + +void erts_mtrace_pre_init(void) +{ +} + +void erts_mtrace_init(char *receiver, char *nodename) +{ + char hostname[MAXHOSTNAMELEN]; + char pid[21]; /* enough for a 64 bit number */ + + socket_desc = ERTS_SOCK_INVALID_SOCKET; + erts_mtrace_enabled = receiver != NULL; + + if (erts_mtrace_enabled) { + unsigned a, b, c, d, p; + byte ip_addr[4]; + Uint16 port; + + erts_mtx_init(&mtrace_buf_mutex, "mtrace_buf"); + erts_mtx_set_forksafe(&mtrace_buf_mutex); + erts_mtx_init(&mtrace_op_mutex, "mtrace_op"); + erts_mtx_set_forksafe(&mtrace_op_mutex); + + socket_desc = erts_sock_open(); + if (socket_desc == ERTS_SOCK_INVALID_SOCKET) { + disable_trace(1, "Failed to open socket", erts_sock_errno()); + return; + } + + if (5 != sscanf(receiver, "%u.%u.%u.%u:%u", &a, &b, &c, &d, &p) + || a >= (1 << 8) || b >= (1 << 8)|| c >= (1 << 8) || d >= (1 << 8) + || p >= (1 << 16)) { + disable_trace(1, "Invalid receiver address", 0); + return; + } + + ip_addr[0] = (byte) a; + ip_addr[1] = (byte) b; + ip_addr[2] = (byte) c; + ip_addr[3] = (byte) d; + + port = (Uint16) p; + + if (!erts_sock_connect(socket_desc, ip_addr, 4, port)) { + disable_trace(1, "Failed to connect to receiver", + erts_sock_errno()); + return; + } + tracep = trace_buffer; + endp = trace_buffer + TRACE_BUF_SZ; + if (erts_sock_gethostname(hostname, MAXHOSTNAMELEN) != 0) + hostname[0] = '\0'; + hostname[MAXHOSTNAMELEN-1] = '\0'; + sys_get_pid(pid); + write_trace_header(nodename ? nodename : "", pid, hostname); + erts_mtrace_update_heap_size(); + } +} + +void +erts_mtrace_install_wrapper_functions(void) +{ + if (erts_mtrace_enabled) { + int i; + /* Install trace functions */ + ASSERT(sizeof(erts_allctrs) == sizeof(real_allctrs)); + + sys_memcpy((void *) real_allctrs, + (void *) erts_allctrs, + sizeof(erts_allctrs)); + + for (i = ERTS_ALC_A_MIN; i <= ERTS_ALC_A_MAX; i++) { + erts_allctrs[i].alloc = mtrace_alloc; + erts_allctrs[i].realloc = mtrace_realloc; + erts_allctrs[i].free = mtrace_free; + erts_allctrs[i].extra = (void *) &real_allctrs[i]; + } + } +} + +void +erts_mtrace_stop(void) +{ + erts_mtx_lock(&mtrace_op_mutex); + erts_mtx_lock(&mtrace_buf_mutex); + if (erts_mtrace_enabled) { + Uint32 ti = get_time_inc(); + + if (ti != INVALID_TIME_INC + && MAKE_TBUF_SZ(UI8_SZ + UI16_SZ + UI32_SZ)) { + byte *hdrp; + Uint16 hdr; + int ti_n; + + *(tracep++) = ERTS_MT_STOP_BDY_TAG; + + hdrp = tracep; + tracep += 2; + + PUT_VSZ_UI32(tracep, ti_n, ti); + + hdr = ti_n; + + WRITE_UI16(hdrp, hdr); + + if(send_trace_buffer()) { + erts_mtrace_enabled = 0; + erts_sock_close(socket_desc); + socket_desc = ERTS_SOCK_INVALID_SOCKET; + } + } + } + erts_mtx_unlock(&mtrace_buf_mutex); + erts_mtx_unlock(&mtrace_op_mutex); +} + +void +erts_mtrace_exit(Uint32 exit_value) +{ + erts_mtx_lock(&mtrace_op_mutex); + erts_mtx_lock(&mtrace_buf_mutex); + if (erts_mtrace_enabled) { + Uint32 ti = get_time_inc(); + + if (ti != INVALID_TIME_INC + && MAKE_TBUF_SZ(UI8_SZ + UI16_SZ + 2*UI32_SZ)) { + byte *hdrp; + Uint16 hdr; + int ti_n, exit_value_n; + + *(tracep++) = ERTS_MT_EXIT_BDY_TAG; + + hdrp = tracep; + tracep += 2; + + PUT_VSZ_UI32(tracep, exit_value_n, exit_value); + PUT_VSZ_UI32(tracep, ti_n, ti); + + hdr = ti_n; + + hdr <<= UI32_MSB_EHF_SZ; + hdr |= exit_value_n; + + WRITE_UI16(hdrp, hdr); + + if(send_trace_buffer()) { + erts_mtrace_enabled = 0; + erts_sock_close(socket_desc); + socket_desc = ERTS_SOCK_INVALID_SOCKET; + } + } + } + erts_mtx_unlock(&mtrace_buf_mutex); + erts_mtx_unlock(&mtrace_op_mutex); +} + +static ERTS_INLINE void +write_alloc_entry(byte tag, + void *res, + ErtsAlcType_t x, + ErtsAlcType_t y, + Uint size) +{ + erts_mtx_lock(&mtrace_buf_mutex); + if (erts_mtrace_enabled) { + Uint32 ti = get_time_inc(); + + if (ti != INVALID_TIME_INC + && MAKE_TBUF_SZ(UI8_SZ + 2*UI16_SZ + 2*UI_SZ + UI32_SZ)) { + Uint16 hdr, t_no = (Uint16) x, ct_no = (Uint16) y; + byte *hdrp; + int t_no_n, ct_no_n = 0, res_n, size_n, ti_n; + + *(tracep++) = tag; + + hdrp = tracep; + tracep += 2; + + if (tag == ERTS_MT_CRR_ALLOC_BDY_TAG) { + PUT_VSZ_UI16(tracep, ct_no_n, ct_no); + } + PUT_VSZ_UI16(tracep, t_no_n, t_no); + PUT_VSZ_UI( tracep, res_n, res); + PUT_VSZ_UI( tracep, size_n, size); + PUT_VSZ_UI32(tracep, ti_n, ti); + + hdr = ti_n; + + hdr <<= UI_MSB_EHF_SZ; + hdr |= size_n; + + hdr <<= UI_MSB_EHF_SZ; + hdr |= res_n; + + hdr <<= UI16_MSB_EHF_SZ; + hdr |= t_no_n; + + if (tag == ERTS_MT_CRR_ALLOC_BDY_TAG) { + hdr <<= UI16_MSB_EHF_SZ; + hdr |= ct_no_n; + } + + WRITE_UI16(hdrp, hdr); + +#if TRACE_PRINTOUTS + print_trace_entry(tag, + ct_no, ct_no_n, + t_no, t_no_n, + (Uint) res, res_n, + 0, 0, + size, size_n, + ti, ti_n); +#endif + +#ifdef DEBUG + check_alloc_entry(hdrp-1, tracep, + tag, + ct_no, ct_no_n, + t_no, t_no_n, + (Uint) res, res_n, + size, size_n, + ti, ti_n); +#endif + + } + + } + erts_mtx_unlock(&mtrace_buf_mutex); + +} + +static ERTS_INLINE void +write_realloc_entry(byte tag, + void *res, + ErtsAlcType_t x, + ErtsAlcType_t y, + void *ptr, + Uint size) +{ + erts_mtx_lock(&mtrace_buf_mutex); + if (erts_mtrace_enabled) { + Uint32 ti = get_time_inc(); + + if (ti != INVALID_TIME_INC + && MAKE_TBUF_SZ(UI8_SZ + 2*UI16_SZ + 3*UI_SZ + UI32_SZ)) { + Uint16 hdr, t_no = (Uint16) x, ct_no = (Uint16) y; + byte *hdrp; + int t_no_n, ct_no_n = 0, res_n, ptr_n, size_n, ti_n; + + *(tracep++) = tag; + + hdrp = tracep; + tracep += 2; + + if (tag == ERTS_MT_CRR_REALLOC_BDY_TAG) { + PUT_VSZ_UI16(tracep, ct_no_n, ct_no); + } + PUT_VSZ_UI16(tracep, t_no_n, t_no); + PUT_VSZ_UI( tracep, res_n, res); + PUT_VSZ_UI( tracep, ptr_n, ptr); + PUT_VSZ_UI( tracep, size_n, size); + PUT_VSZ_UI32(tracep, ti_n, ti); + + hdr = ti_n; + + hdr <<= UI_MSB_EHF_SZ; + hdr |= size_n; + + hdr <<= UI_MSB_EHF_SZ; + hdr |= ptr_n; + + hdr <<= UI_MSB_EHF_SZ; + hdr |= res_n; + + hdr <<= UI16_MSB_EHF_SZ; + hdr |= t_no_n; + + if (tag == ERTS_MT_CRR_REALLOC_BDY_TAG) { + hdr <<= UI16_MSB_EHF_SZ; + hdr |= ct_no_n; + } + + WRITE_UI16(hdrp, hdr); + +#if TRACE_PRINTOUTS + print_trace_entry(tag, + ct_no, ct_no_n, + t_no, t_no_n, + (Uint) res, res_n, + (Uint) ptr, ptr_n, + size, size_n, + ti, ti_n); +#endif + +#ifdef DEBUG + check_realloc_entry(hdrp-1, tracep, + tag, + ct_no, ct_no_n, + t_no, t_no_n, + (Uint) res, res_n, + (Uint) ptr, ptr_n, + size, size_n, + ti, ti_n); +#endif + + } + } + erts_mtx_unlock(&mtrace_buf_mutex); +} + +static ERTS_INLINE void +write_free_entry(byte tag, + ErtsAlcType_t x, + ErtsAlcType_t y, + void *ptr) +{ + erts_mtx_lock(&mtrace_buf_mutex); + if (erts_mtrace_enabled) { + Uint32 ti = get_time_inc(); + + if (ti != INVALID_TIME_INC + && MAKE_TBUF_SZ(UI8_SZ + 2*UI16_SZ + UI_SZ + UI32_SZ)) { + Uint16 hdr, t_no = (Uint16) x, ct_no = (Uint16) y; + byte *hdrp; + int t_no_n, ct_no_n = 0, ptr_n, ti_n; + + *(tracep++) = tag; + + hdrp = tracep; + tracep += 2; + + if (tag == ERTS_MT_CRR_FREE_BDY_TAG) { + PUT_VSZ_UI16(tracep, ct_no_n, ct_no); + } + PUT_VSZ_UI16(tracep, t_no_n, t_no); + PUT_VSZ_UI( tracep, ptr_n, ptr); + PUT_VSZ_UI32(tracep, ti_n, ti); + + hdr = ti_n; + + hdr <<= UI_MSB_EHF_SZ; + hdr |= ptr_n; + + hdr <<= UI16_MSB_EHF_SZ; + hdr |= t_no_n; + + if (tag == ERTS_MT_CRR_FREE_BDY_TAG) { + hdr <<= UI16_MSB_EHF_SZ; + hdr |= ct_no_n; + } + + WRITE_UI16(hdrp, hdr); + +#if TRACE_PRINTOUTS + print_trace_entry(tag, + ct_no, ct_no_n, + t_no, t_no_n, + (Uint) 0, 0, + (Uint) ptr, ptr_n, + 0, 0, + ti, ti_n); +#endif + +#ifdef DEBUG + check_free_entry(hdrp-1, tracep, + tag, + ct_no, ct_no_n, + t_no, t_no_n, + (Uint) ptr, ptr_n, + ti, ti_n); +#endif + } + + } + erts_mtx_unlock(&mtrace_buf_mutex); +} + +static void * +mtrace_alloc(ErtsAlcType_t n, void *extra, Uint size) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + void *res; + + erts_mtx_lock(&mtrace_op_mutex); + + res = (*real_af->alloc)(n, real_af->extra, size); + write_alloc_entry(ERTS_MT_ALLOC_BDY_TAG, res, n, 0, size); + + erts_mtx_unlock(&mtrace_op_mutex); + + return res; +} + +static void * +mtrace_realloc(ErtsAlcType_t n, void *extra, void *ptr, Uint size) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + void *res; + + erts_mtx_lock(&mtrace_op_mutex); + + res = (*real_af->realloc)(n, real_af->extra, ptr, size); + write_realloc_entry(ERTS_MT_REALLOC_BDY_TAG, res, n, 0, ptr, size); + + erts_mtx_unlock(&mtrace_op_mutex); + + return res; + +} + +static void +mtrace_free(ErtsAlcType_t n, void *extra, void *ptr) +{ + ErtsAllocatorFunctions_t *real_af = (ErtsAllocatorFunctions_t *) extra; + + erts_mtx_lock(&mtrace_op_mutex); + + (*real_af->free)(n, real_af->extra, ptr); + write_free_entry(ERTS_MT_FREE_BDY_TAG, n, 0, ptr); + + erts_mtx_unlock(&mtrace_op_mutex); +} + + +void +erts_mtrace_crr_alloc(void *res, ErtsAlcType_t n, ErtsAlcType_t m, Uint size) +{ + write_alloc_entry(ERTS_MT_CRR_ALLOC_BDY_TAG, res, n, m, size); +} + +void +erts_mtrace_crr_realloc(void *res, ErtsAlcType_t n, ErtsAlcType_t m, void *ptr, + Uint size) +{ + write_realloc_entry(ERTS_MT_CRR_REALLOC_BDY_TAG, res, n, m, ptr, size); +} + +void +erts_mtrace_crr_free(ErtsAlcType_t n, ErtsAlcType_t m, void *ptr) +{ + write_free_entry(ERTS_MT_CRR_FREE_BDY_TAG, n, m, ptr); +} + + +#if TRACE_PRINTOUTS +static void +print_trace_entry(byte tag, + Uint16 t_no, int t_no_n, + Uint16 ct_no, int ct_no_n, + Uint res, int res_n, + Uint ptr, int ptr_n, + Uint size, int size_n, + Uint32 ti,int ti_n) +{ + switch (tag) { + case ERTS_MT_ALLOC_BDY_TAG: + fprintf(stderr, + "{alloc, {%lu, %lu, %lu}, {%u, %u, %u, %u}}\n\r", + + (unsigned long) t_no, (unsigned long) res, + (unsigned long) size, + + MSB2BITS(t_no_n), MSB2BITS(res_n), + MSB2BITS(size_n), MSB2BITS(ti_n)); + break; + case ERTS_MT_REALLOC_BDY_TAG: + fprintf(stderr, + "{realloc, {%lu, %lu, %lu, %lu}, {%u, %u, %u, %u, %u}}\n\r", + + (unsigned long) t_no, (unsigned long) res, + (unsigned long) ptr, (unsigned long) size, + + MSB2BITS(t_no_n), MSB2BITS(res_n), + MSB2BITS(ptr_n), MSB2BITS(size_n), MSB2BITS(ti_n)); + break; + case ERTS_MT_FREE_BDY_TAG: + fprintf(stderr, + "{free, {%lu, %lu}, {%u, %u, %u, %u, %u}}\n\r", + + (unsigned long) t_no, (unsigned long) ptr, + + MSB2BITS(t_no_n), MSB2BITS(ptr_n), MSB2BITS(ti_n)); + break; + case ERTS_MT_CRR_ALLOC_BDY_TAG: + fprintf(stderr, + "{crr_alloc, {%lu, %lu, %lu, %lu}, {%u, %u, %u, %u, %u}}\n\r", + + (unsigned long) ct_no, (unsigned long) t_no, + (unsigned long) res, (unsigned long) size, + + MSB2BITS(ct_no_n), MSB2BITS(t_no_n), + MSB2BITS(res_n), MSB2BITS(size_n), + MSB2BITS(ti_n)); + break; + case ERTS_MT_CRR_REALLOC_BDY_TAG: + fprintf(stderr, + "{crr_realloc, {%lu, %lu, %lu, %lu, %lu}, " + "{%u, %u, %u, %u, %u, %u}}\n\r", + + (unsigned long) ct_no, (unsigned long) t_no, + (unsigned long) res, (unsigned long) ptr, + (unsigned long) size, + + MSB2BITS(ct_no_n), MSB2BITS(t_no_n), + MSB2BITS(res_n), MSB2BITS(ptr_n), + MSB2BITS(size_n), MSB2BITS(ti_n)); + break; + case ERTS_MT_CRR_FREE_BDY_TAG: + fprintf(stderr, + "{crr_free, {%lu, %lu, %lu}, {%u, %u, %u, %u}}\n\r", + + (unsigned long) ct_no, (unsigned long) t_no, + (unsigned long) ptr, + + MSB2BITS(ct_no_n), MSB2BITS(t_no_n), + MSB2BITS(ptr_n), MSB2BITS(ti_n)); + break; + default: + fprintf(stderr, "{'\?\?\?'}\n\r"); + break; + } +} + +#endif /* #if TRACE_PRINTOUTS */ + +#ifdef DEBUG + +#define GET_UI16(P) ((P) += UI16_SZ, \ + (((Uint16) (*((P) - 2) << 8)) | ((Uint16) (*((P) - 1))))) + +static void +check_ui(Uint16 *hdrp, byte **pp, Uint ui, int msb, + Uint16 f_mask, Uint16 f_size) +{ + Uint x; + int n; + + ASSERT((msb & ~f_mask) == 0); + + n = (int) (*hdrp & f_mask); + + ASSERT(n == msb); + + *hdrp >>= f_size; + + x = 0; + switch (n) { +#ifdef ARCH_64 + case 7: x |= *((*pp)++); x <<= 8; + case 6: x |= *((*pp)++); x <<= 8; + case 5: x |= *((*pp)++); x <<= 8; + case 4: x |= *((*pp)++); x <<= 8; +#endif + case 3: x |= *((*pp)++); x <<= 8; + case 2: x |= *((*pp)++); x <<= 8; + case 1: x |= *((*pp)++); x <<= 8; + case 0: x |= *((*pp)++); break; + default: ASSERT(0); + } + + ASSERT(x == ui); +} + + +void +check_alloc_entry(byte *sp, byte *ep, + byte tag, + Uint16 ct_no, int ct_no_n, + Uint16 t_no, int t_no_n, + Uint res, int res_n, + Uint size, int size_n, + Uint32 ti,int ti_n) +{ + byte *p = sp; + Uint16 hdr; + + ASSERT(*p == tag); + p++; + + hdr = GET_UI16(p); + + if (tag == ERTS_MT_CRR_ALLOC_BDY_TAG) + check_ui(&hdr, &p, ct_no, ct_no_n, UI16_MSB_EHF_MSK, UI16_MSB_EHF_SZ); + check_ui(&hdr, &p, t_no, t_no_n, UI16_MSB_EHF_MSK, UI16_MSB_EHF_SZ); + check_ui(&hdr, &p, res, res_n, UI_MSB_EHF_MSK, UI_MSB_EHF_SZ); + check_ui(&hdr, &p, size, size_n, UI_MSB_EHF_MSK, UI_MSB_EHF_SZ); + check_ui(&hdr, &p, ti, ti_n, UI32_MSB_EHF_MSK, UI32_MSB_EHF_SZ); + + ASSERT(hdr == 0); + ASSERT(p == ep); +} + +void +check_realloc_entry(byte *sp, byte *ep, + byte tag, + Uint16 ct_no, int ct_no_n, + Uint16 t_no, int t_no_n, + Uint res, int res_n, + Uint ptr, int ptr_n, + Uint size, int size_n, + Uint32 ti,int ti_n) +{ + byte *p = sp; + Uint16 hdr; + + ASSERT(*p == tag); + p++; + + hdr = GET_UI16(p); + + if (tag == ERTS_MT_CRR_REALLOC_BDY_TAG) + check_ui(&hdr, &p, ct_no, ct_no_n, UI16_MSB_EHF_MSK, UI16_MSB_EHF_SZ); + check_ui(&hdr, &p, t_no, t_no_n, UI16_MSB_EHF_MSK, UI16_MSB_EHF_SZ); + check_ui(&hdr, &p, res, res_n, UI_MSB_EHF_MSK, UI_MSB_EHF_SZ); + check_ui(&hdr, &p, ptr, ptr_n, UI_MSB_EHF_MSK, UI_MSB_EHF_SZ); + check_ui(&hdr, &p, size, size_n, UI_MSB_EHF_MSK, UI_MSB_EHF_SZ); + check_ui(&hdr, &p, ti, ti_n, UI32_MSB_EHF_MSK, UI32_MSB_EHF_SZ); + + ASSERT(hdr == 0); + ASSERT(p == ep); +} + +void +check_free_entry(byte *sp, byte *ep, + byte tag, + Uint16 ct_no, int ct_no_n, + Uint16 t_no, int t_no_n, + Uint ptr, int ptr_n, + Uint32 ti,int ti_n) +{ + byte *p = sp; + Uint16 hdr; + + ASSERT(*p == tag); + p++; + + hdr = GET_UI16(p); + + if (tag == ERTS_MT_CRR_FREE_BDY_TAG) + check_ui(&hdr, &p, ct_no, ct_no_n, UI16_MSB_EHF_MSK, UI16_MSB_EHF_SZ); + check_ui(&hdr, &p, t_no, t_no_n, UI16_MSB_EHF_MSK, UI16_MSB_EHF_SZ); + check_ui(&hdr, &p, ptr, ptr_n, UI_MSB_EHF_MSK, UI_MSB_EHF_SZ); + check_ui(&hdr, &p, ti, ti_n, UI32_MSB_EHF_MSK, UI32_MSB_EHF_SZ); + + ASSERT(hdr == 0); + ASSERT(p == ep); + +} + +void +check_time_inc_entry(byte *sp, byte *ep, + Uint32 secs, int secs_n, + Uint32 usecs, int usecs_n) +{ + byte *p = sp; + Uint16 hdr; + + ASSERT(*p == ERTS_MT_TIME_INC_BDY_TAG); + p++; + + hdr = GET_UI16(p); + + check_ui(&hdr, &p, secs, secs_n, UI32_MSB_EHF_MSK, UI32_MSB_EHF_SZ); + check_ui(&hdr, &p, usecs, usecs_n, UI32_MSB_EHF_MSK, UI32_MSB_EHF_SZ); + + ASSERT(hdr == 0); + ASSERT(p == ep); + +} + +#endif /* #ifdef DEBUG */ + diff --git a/erts/emulator/beam/erl_mtrace.h b/erts/emulator/beam/erl_mtrace.h new file mode 100644 index 0000000000..204543ddb0 --- /dev/null +++ b/erts/emulator/beam/erl_mtrace.h @@ -0,0 +1,51 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_MTRACE_H__ +#define ERL_MTRACE_H__ + +#include "erl_alloc_types.h" + +#if (defined(ERTS___AFTER_MORECORE_HOOK_CAN_TRACK_MALLOC) \ + || defined(ERTS_BRK_WRAPPERS_CAN_TRACK_MALLOC)) +#undef ERTS_CAN_TRACK_MALLOC +#define ERTS_CAN_TRACK_MALLOC +#endif + +#define ERTS_MTRACE_SEGMENT_ID ERTS_ALC_A_INVALID + +extern int erts_mtrace_enabled; + +void erts_mtrace_pre_init(void); +void erts_mtrace_init(char *receiver, char *nodename); +void erts_mtrace_install_wrapper_functions(void); +void erts_mtrace_stop(void); +void erts_mtrace_exit(Uint32 exit_value); + +void erts_mtrace_crr_alloc(void*, ErtsAlcType_t, ErtsAlcType_t, Uint); +void erts_mtrace_crr_realloc(void*, ErtsAlcType_t, ErtsAlcType_t, void*, Uint); +void erts_mtrace_crr_free(ErtsAlcType_t, ErtsAlcType_t, void*); + + +void erts_mtrace_update_heap_size(void); /* Implemented in + * ../sys/common/erl_mtrace_sys_wrap.c + */ + +#endif /* #ifndef ERL_MTRACE_H__ */ + diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c new file mode 100644 index 0000000000..fa4454a3f3 --- /dev/null +++ b/erts/emulator/beam/erl_nif.c @@ -0,0 +1,641 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* Erlang Native InterFace + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_nif.h" + +#include "sys.h" +#include "global.h" +#include "erl_binary.h" +#include "bif.h" +#include "error.h" +#include "big.h" +#include "beam_bp.h" + +#include + +/* +static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need) +{ + return HAlloc(env->proc, need); +} +*/ + +#define MIN_HEAP_FRAG_SZ 200 +static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need); + +static ERTS_INLINE Eterm* alloc_heap(ErlNifEnv* env, unsigned need) +{ + Eterm* hp = env->hp; + env->hp += need; + if (env->hp <= env->hp_end) { + return hp; + } + env->hp = hp; + return alloc_heap_heavy(env,need); +} + +static Eterm* alloc_heap_heavy(ErlNifEnv* env, unsigned need) +{ + Eterm* hp; + + if (env->heap_frag_sz == 0) { + ASSERT(HEAP_LIMIT(env->proc) == env->hp_end); + HEAP_TOP(env->proc) = env->hp; + env->heap_frag_sz = need + MIN_HEAP_FRAG_SZ; + } + else { + HRelease(env->proc, env->hp_end, env->hp); + env->heap_frag_sz *= 2; + } + hp = erts_heap_alloc(env->proc, env->heap_frag_sz); + env->hp = hp + need; + env->hp_end = hp + env->heap_frag_sz; + return hp; +} + +void erts_pre_nif(ErlNifEnv* env, Process* p, void* nif_data) +{ + env->nif_data = nif_data; + env->proc = p; + env->hp = HEAP_TOP(p); + env->hp_end = HEAP_LIMIT(p); + env->heap_frag_sz = 0; + env->fpe_was_unmasked = erts_block_fpe(); +} + +void erts_post_nif(ErlNifEnv* env) +{ + erts_unblock_fpe(env->fpe_was_unmasked); + if (env->heap_frag_sz == 0) { + ASSERT(env->hp_end == HEAP_LIMIT(env->proc)); + ASSERT(env->hp >= HEAP_TOP(env->proc)); + ASSERT(env->hp <= HEAP_LIMIT(env->proc)); + HEAP_TOP(env->proc) = env->hp; + } + else { + ASSERT(env->hp_end != HEAP_LIMIT(env->proc)); + ASSERT(env->hp_end - env->hp <= env->heap_frag_sz); + HRelease(env->proc, env->hp_end, env->hp); + } +} + +void* enif_get_data(ErlNifEnv* env) +{ + return env->nif_data; +} + +void* enif_alloc(ErlNifEnv* env, size_t size) +{ + return erts_alloc_fnf(ERTS_ALC_T_NIF, (Uint) size); +} + +void enif_free(ErlNifEnv* env, void* ptr) +{ + erts_free(ERTS_ALC_T_NIF, ptr); +} + + +int enif_is_binary(ErlNifEnv* env, ERL_NIF_TERM term) +{ + return is_binary(term) && (binary_bitsize(term) % 8 == 0); +} + + +int enif_inspect_binary(ErlNifEnv* env, Eterm bin_term, ErlNifBinary* bin) +{ + bin->tmp_alloc = NULL; + bin->data = erts_get_aligned_binary_bytes(bin_term, &bin->tmp_alloc); + if (bin->data == NULL) { + return 0; + } + bin->bin_term = bin_term; + bin->size = binary_size(bin_term); + bin->ref_bin = NULL; + return 1; +} + + +int enif_alloc_binary(ErlNifEnv* env, unsigned size, ErlNifBinary* bin) +{ + Binary* refbin; + + refbin = erts_bin_drv_alloc_fnf(size); /* BUGBUG: alloc type? */ + if (refbin == NULL) { + return 0; /* The NIF must take action */ + } + refbin->flags = BIN_FLAG_DRV; /* BUGBUG: Flag? */ + erts_refc_init(&refbin->refc, 1); + refbin->orig_size = (long) size; + + bin->size = size; + bin->data = (unsigned char*) refbin->orig_bytes; + bin->bin_term = THE_NON_VALUE; + bin->tmp_alloc = NULL; + bin->ref_bin = refbin; + return 1; +} + +void enif_release_binary(ErlNifEnv* env, ErlNifBinary* bin) +{ + if (bin->ref_bin == NULL) { + erts_free_aligned_binary_bytes(bin->tmp_alloc); + } + else { + Binary* refbin = bin->ref_bin; + ASSERT(bin->tmp_alloc == NULL); + ASSERT(bin->bin_term == THE_NON_VALUE); + if (erts_refc_dectest(&refbin->refc, 0) == 0) { + erts_bin_free(refbin); + } + } +#ifdef DEBUG + bin->bin_term = THE_NON_VALUE; + bin->tmp_alloc = NULL; + bin->ref_bin = NULL; +#endif +} + +Eterm enif_make_binary(ErlNifEnv* env, ErlNifBinary* bin) +{ + if (bin->ref_bin == NULL) { + erts_free_aligned_binary_bytes(bin->tmp_alloc); + return bin->bin_term; + } + else { + Binary* bptr = bin->ref_bin; + ProcBin* pb; + ASSERT(bin->tmp_alloc == NULL); + + /* !! Copy-paste from new_binary() !! */ + pb = (ProcBin *) alloc_heap(env, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = bptr->orig_size; + pb->next = MSO(env->proc).mso; + MSO(env->proc).mso = pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + + MSO(env->proc).overhead += pb->size / sizeof(Eterm); + return make_binary(pb); + } +} + +ERL_NIF_TERM enif_make_badarg(ErlNifEnv* env) +{ + BIF_ERROR(env->proc, BADARG); +} + + +int enif_get_int(ErlNifEnv* env, Eterm term, int* ip) +{ +#if SIZEOF_INT == SIZEOF_VOID_P + return term_to_Sint(term, ip); +#elif SIZEOF_LONG == SIZEOF_VOID_P + Sint i; + if (!term_to_Sint(term, &i) || i < INT_MIN || i > INT_MAX) { + return 0; + } + *ip = (int) i; + return 1; +#else +# error Unknown word size +#endif +} + +int enif_get_ulong(ErlNifEnv* env, Eterm term, unsigned long* ip) +{ +#if SIZEOF_LONG == SIZEOF_VOID_P + return term_to_Uint(term, ip); +#else +# error Unknown long word size +#endif +} + +int enif_get_list_cell(ErlNifEnv* env, Eterm term, Eterm* head, Eterm* tail) +{ + Eterm* val; + if (is_not_list(term)) return 0; + val = list_val(term); + *head = CAR(val); + *tail = CDR(val); + return 1; +} + +ERL_NIF_TERM enif_make_int(ErlNifEnv* env, int i) +{ +#if SIZEOF_INT == SIZEOF_VOID_P + return IS_SSMALL(i) ? make_small(i) : small_to_big(i,alloc_heap(env,2)); +#elif SIZEOF_LONG == SIZEOF_VOID_P + return make_small(i); +#endif +} + +ERL_NIF_TERM enif_make_ulong(ErlNifEnv* env, unsigned long i) +{ +#if SIZEOF_LONG == SIZEOF_VOID_P + Eterm* hp; + Uint sz = 0; + erts_bld_uint(NULL, &sz, i); + hp = alloc_heap(env,sz); + return erts_bld_uint(&hp, NULL, i); +#else +# error Unknown long word size +#endif + +} + + +ERL_NIF_TERM enif_make_atom(ErlNifEnv* env, const char* name) +{ + return am_atom_put(name, sys_strlen(name)); +} + + +ERL_NIF_TERM enif_make_tuple(ErlNifEnv* env, unsigned cnt, ...) +{ + Eterm* hp = alloc_heap(env,cnt+1); + Eterm ret = make_tuple(hp); + va_list ap; + + *hp++ = make_arityval(cnt); + va_start(ap,cnt); + while (cnt--) { + *hp++ = va_arg(ap,Eterm); + } + va_end(ap); + return ret; +} + +ERL_NIF_TERM enif_make_list_cell(ErlNifEnv* env, Eterm car, Eterm cdr) +{ + Eterm* hp = alloc_heap(env,2); + Eterm ret = make_list(hp); + + CAR(hp) = car; + CDR(hp) = cdr; + return ret; +} + +ERL_NIF_TERM enif_make_list(ErlNifEnv* env, unsigned cnt, ...) +{ + Eterm* hp = alloc_heap(env,cnt*2); + Eterm ret = make_list(hp); + Eterm* last = &ret; + va_list ap; + + va_start(ap,cnt); + while (cnt--) { + *last = make_list(hp); + *hp = va_arg(ap,Eterm); + last = ++hp; + ++hp; + } + va_end(ap); + *last = NIL; + return ret; +} + +ERL_NIF_TERM enif_make_string(ErlNifEnv* env, const char* string) +{ + Sint n = strlen(string); + Eterm* hp = alloc_heap(env,n*2); + return erts_bld_string_n(&hp,NULL,string,n); +} + + + + +/*************************************************************************** + ** load_nif/2 ** + ***************************************************************************/ + + +static Uint** get_func_pp(Eterm* mod_code, Eterm f_atom, unsigned arity) +{ + int n = (int) mod_code[MI_NUM_FUNCTIONS]; + int j; + for (j = 0; j < n; ++j) { + Uint* code_ptr = (Uint*) mod_code[MI_FUNCTIONS+j]; + ASSERT(code_ptr[0] == (Uint) BeamOp(op_i_func_info_IaaI)); + if (f_atom == ((Eterm) code_ptr[3]) + && arity == ((unsigned) code_ptr[4])) { + + return (Uint**) &mod_code[MI_FUNCTIONS+j]; + } + } + return NULL; +} + +#define in_area(ptr,start,nbytes) \ + ((unsigned long)((char*)(ptr) - (char*)(start)) < (nbytes)) + +static void refresh_cached_nif_data(Eterm* mod_code, + struct erl_module_nif* mod_nif) +{ + int i; + for (i=0; i < mod_nif->entry->num_of_funcs; i++) { + Eterm f_atom; + ErlNifFunc* func = &mod_nif->entry->funcs[i]; + Uint* code_ptr; + + erts_atom_get(func->name, strlen(func->name), &f_atom); + code_ptr = *get_func_pp(mod_code, f_atom, func->arity); + code_ptr[5+2] = (Uint) mod_nif->data; + } +} + +static Eterm mkatom(const char *str) +{ + return am_atom_put(str, sys_strlen(str)); +} + +static struct tainted_module_t +{ + struct tainted_module_t* next; + Eterm module_atom; +}*first_tainted_module = NULL; + +static void add_taint(Eterm mod_atom) +{ + struct tainted_module_t* t; + for (t=first_tainted_module ; t!=NULL; t=t->next) { + if (t->module_atom == mod_atom) { + return; + } + } + t = erts_alloc_fnf(ERTS_ALC_T_TAINT, sizeof(*t)); + if (t != NULL) { + t->module_atom = mod_atom; + t->next = first_tainted_module; + first_tainted_module = t; + } +} + +Eterm erts_nif_taints(Process* p) +{ + struct tainted_module_t* t; + unsigned cnt = 0; + Eterm list = NIL; + Eterm* hp; + for (t=first_tainted_module ; t!=NULL; t=t->next) { + cnt++; + } + hp = HAlloc(p,cnt*2); + for (t=first_tainted_module ; t!=NULL; t=t->next) { + list = CONS(hp, t->module_atom, list); + hp += 2; + } + return list; +} + + +static Eterm load_nif_error(Process* p, const char* atom, const char* format, ...) +{ + erts_dsprintf_buf_t* dsbufp = erts_create_tmp_dsbuf(0); + Eterm ret; + Eterm* hp; + Eterm** hpp = NULL; + Uint sz = 0; + Uint* szp = &sz; + va_list arglist; + + va_start(arglist, format); + erts_vdsprintf(dsbufp, format, arglist); + va_end(arglist); + + for (;;) { + Eterm txt = erts_bld_string_n(hpp, &sz, dsbufp->str, dsbufp->str_len); + ret = erts_bld_tuple(hpp, szp, 3, am_error, mkatom(atom), txt); + if (hpp != NULL) { + break; + } + hp = HAlloc(p,sz); + hpp = &hp; + szp = NULL; + } + erts_destroy_tmp_dsbuf(dsbufp); + return ret; +} + +BIF_RETTYPE load_nif_2(BIF_ALIST_2) +{ + static const char bad_lib[] = "bad_lib"; + static const char reload[] = "reload"; + static const char upgrade[] = "upgrade"; + char lib_name[256]; /* BUGBUG: Max-length? */ + void* handle = NULL; + void* init_func; + ErlNifEntry* entry = NULL; + ErlNifEnv env; + int len, i, err; + Module* mod; + Eterm mod_atom; + Eterm f_atom; + Eterm* caller; + ErtsSysDdllError errdesc = ERTS_SYS_DDLL_ERROR_INIT; + Eterm ret = am_ok; + int veto; + + len = intlist_to_buf(BIF_ARG_1, lib_name, sizeof(lib_name)-1); + if (len < 1) { + /*erts_fprintf(stderr, "Invalid library path name '%T'\r\n", BIF_ARG_1);*/ + BIF_ERROR(BIF_P, BADARG); + } + lib_name[len] = '\0'; + + /* Block system (is this the right place to do it?) */ + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + + /* Find calling module */ + ASSERT(BIF_P->current != NULL); + ASSERT(BIF_P->current[0] == am_erlang + && BIF_P->current[1] == am_load_nif + && BIF_P->current[2] == 2); + caller = find_function_from_pc(BIF_P->cp); + ASSERT(caller != NULL); + mod_atom = caller[0]; + ASSERT(is_atom(mod_atom)); + mod=erts_get_module(mod_atom); + ASSERT(mod != NULL); + + if (!in_area(caller, mod->code, mod->code_length)) { + ASSERT(in_area(caller, mod->old_code, mod->old_code_length)); + + ret = load_nif_error(BIF_P, "old_code", "Calling load_nif from old " + "module '%T' not allowed", mod_atom); + } + else if ((err=erts_sys_ddll_open2(lib_name, &handle, &errdesc)) != ERL_DE_NO_ERROR) { + ret = load_nif_error(BIF_P, "load_failed", "Failed to load NIF library" + " %s: '%s'", lib_name, errdesc.str); + } + else if (erts_sys_ddll_load_nif_init(handle, &init_func, &errdesc) != ERL_DE_NO_ERROR) { + ret = load_nif_error(BIF_P, bad_lib, "Failed to find library init" + " function: '%s'", errdesc.str); + + } + else if ((add_taint(mod_atom), + (entry = erts_sys_ddll_call_nif_init(init_func)) == NULL)) { + ret = load_nif_error(BIF_P, bad_lib, "Library init-call unsuccessful"); + } + else if (entry->major != ERL_NIF_MAJOR_VERSION + || entry->minor > ERL_NIF_MINOR_VERSION) { + + ret = load_nif_error(BIF_P, bad_lib, "Library version (%d.%d) not compatible (with %d.%d).", + entry->major, entry->minor, ERL_NIF_MAJOR_VERSION, ERL_NIF_MINOR_VERSION); + } + else if (!erts_is_atom_str((char*)entry->name, mod_atom)) { + ret = load_nif_error(BIF_P, bad_lib, "Library module name '%s' does not" + " match calling module '%T'", entry->name, mod_atom); + } + else { + /*erts_fprintf(stderr, "Found module %T\r\n", mod_atom);*/ + + for (i=0; i < entry->num_of_funcs && ret==am_ok; i++) { + Uint** code_pp; + ErlNifFunc* f = &entry->funcs[i]; + if (f->arity > 3) { + ret = load_nif_error(BIF_P,bad_lib,"Function arity too high for NIF %s/%u", + f->name, f->arity); + } + else if (!erts_atom_get(f->name, strlen(f->name), &f_atom) + || (code_pp = get_func_pp(mod->code, f_atom, f->arity))==NULL) { + ret = load_nif_error(BIF_P,bad_lib,"Function not found %T:%s/%u", + mod_atom, f->name, f->arity); + } + else if (code_pp[1] - code_pp[0] < (5+3)) { + ret = load_nif_error(BIF_P,bad_lib,"No explicit call to load_nif" + " in module (%T:%s/%u to small)", + mod_atom, entry->funcs[i].name, entry->funcs[i].arity); + } + /*erts_fprintf(stderr, "Found NIF %T:%s/%u\r\n", + mod_atom, entry->funcs[i].name, entry->funcs[i].arity);*/ + } + } + + if (ret != am_ok) { + goto error; + } + + /* Call load, reload or upgrade: + */ + if (mod->nif.handle != NULL) { /* Reload */ + int k; + ASSERT(mod->nif.entry != NULL); + if (entry->reload == NULL) { + ret = load_nif_error(BIF_P,reload,"Reload not supported by this NIF library."); + goto error; + } + /* Check that no NIF is removed */ + for (k=0; k < mod->nif.entry->num_of_funcs; k++) { + ErlNifFunc* old_func = &mod->nif.entry->funcs[k]; + for (i=0; i < entry->num_of_funcs; i++) { + if (old_func->arity == entry->funcs[i].arity + && sys_strcmp(old_func->name, entry->funcs[i].name) == 0) { + break; + } + } + if (i == entry->num_of_funcs) { + ret = load_nif_error(BIF_P,reload,"Reloaded library missing " + "function %T:%s/%u\r\n", mod_atom, + old_func->name, old_func->arity); + goto error; + } + } + erts_pre_nif(&env, BIF_P, mod->nif.data); + veto = entry->reload(&env, &env.nif_data, BIF_ARG_2); + erts_post_nif(&env); + if (veto) { + ret = load_nif_error(BIF_P, reload, "Library reload-call unsuccessful."); + } + else { + erts_sys_ddll_close(mod->nif.handle); + } + } + else { + if (mod->old_nif.handle != NULL) { /* Upgrade */ + void* prev_old_data = mod->old_nif.data; + if (entry->upgrade == NULL) { + ret = load_nif_error(BIF_P, upgrade, "Upgrade not supported by this NIF library."); + goto error; + } + erts_pre_nif(&env, BIF_P, NULL); + veto = entry->upgrade(&env, &env.nif_data, &mod->old_nif.data, BIF_ARG_2); + erts_post_nif(&env); + if (veto) { + mod->old_nif.data = prev_old_data; + ret = load_nif_error(BIF_P, upgrade, "Library upgrade-call unsuccessful."); + } + else if (mod->old_nif.data != prev_old_data) { + refresh_cached_nif_data(mod->old_code, &mod->old_nif); + } + } + else if (entry->load != NULL) { /* Initial load */ + erts_pre_nif(&env, BIF_P, NULL); + veto = entry->load(&env, &env.nif_data, BIF_ARG_2); + erts_post_nif(&env); + if (veto) { + ret = load_nif_error(BIF_P, "load", "Library load-call unsuccessful."); + } + } + } + if (ret == am_ok) { + /* + ** Everything ok, patch the beam code with op_call_nif + */ + mod->nif.data = env.nif_data; + mod->nif.handle = handle; + mod->nif.entry = entry; + for (i=0; i < entry->num_of_funcs; i++) + { + Uint* code_ptr; + erts_atom_get(entry->funcs[i].name, strlen(entry->funcs[i].name), &f_atom); + code_ptr = *get_func_pp(mod->code, f_atom, entry->funcs[i].arity); + + if (code_ptr[1] == 0) { + code_ptr[5+0] = (Uint) BeamOp(op_call_nif); + } else { /* Function traced, patch the original instruction word */ + BpData* bp = (BpData*) code_ptr[1]; + bp->orig_instr = (Uint) BeamOp(op_call_nif); + } + code_ptr[5+1] = (Uint) entry->funcs[i].fptr; + code_ptr[5+2] = (Uint) mod->nif.data; + } + } + else { + error: + ASSERT(ret != am_ok); + if (handle != NULL) { + erts_sys_ddll_close(handle); + } + erts_sys_ddll_free_error(&errdesc); + } + + erts_smp_release_system(); + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); + BIF_RET(ret); +} + diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h new file mode 100644 index 0000000000..8650b7ce47 --- /dev/null +++ b/erts/emulator/beam/erl_nif.h @@ -0,0 +1,122 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Include file for writers of Native Implemented Functions. +*/ + +#define ERL_NIF_MAJOR_VERSION 0 +#define ERL_NIF_MINOR_VERSION 1 + +#include + +typedef unsigned long ERL_NIF_TERM; + +typedef struct +{ + const char* name; + unsigned arity; + void* fptr; //ERL_NIF_TERM (*fptr)(void*, ...); +}ErlNifFunc; + +struct enif_environment_t; +typedef struct enif_environment_t ErlNifEnv; + +typedef struct enif_entry_t +{ + int major; + int minor; + const char* name; + int num_of_funcs; + ErlNifFunc* funcs; + int (*load) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); + int (*reload) (ErlNifEnv*, void** priv_data, ERL_NIF_TERM load_info); + int (*upgrade)(ErlNifEnv*, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info); + void (*unload) (ErlNifEnv*, void* priv_data); +}ErlNifEntry; + + + +typedef struct +{ + unsigned size; + unsigned char* data; + + /* Internals (avert your eyes) */ + ERL_NIF_TERM bin_term; + unsigned char* tmp_alloc; + void* ref_bin; + +}ErlNifBinary; + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) RET_TYPE (*NAME) ARGS +typedef struct { +# include "erl_nif_api_funcs.h" +} TWinDynNifCallbacks; +extern TWinDynNifCallbacks WinDynNifCallbacks; +# undef ERL_NIF_API_FUNC_DECL +#endif + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) && !defined(STATIC_ERLANG_DRIVER) +# define ERL_NIF_API_FUNC_MACRO(NAME) (WinDynNifCallbacks.NAME) +# include "erl_nif_api_funcs.h" +/* note that we have to keep ERL_NIF_API_FUNC_MACRO defined */ + +#else /* non windows or included from emulator itself */ + +# define ERL_NIF_API_FUNC_DECL(RET_TYPE, NAME, ARGS) extern RET_TYPE NAME ARGS +# include "erl_nif_api_funcs.h" +# undef ERL_NIF_API_FUNC_DECL +#endif + + + + +#if (defined(__WIN32__) || defined(_WIN32) || defined(_WIN32_)) +# define ERL_NIF_INIT_GLOB TWinDynNifCallbacks WinDynNifCallbacks; +# define ERL_NIF_INIT_DECL(MODNAME) __declspec(dllexport) ErlNifEntry* nif_init(TWinDynNifCallbacks* callbacks) +# define ERL_NIF_INIT_BODY memcpy(&WinDynNifCallbacks,callbacks,sizeof(TWinDynNifCallbacks)) +#else +# define ERL_NIF_INIT_GLOB +# define ERL_NIF_INIT_BODY +# if defined(VXWORKS) +# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* MODNAME ## _init(void) +# else +# define ERL_NIF_INIT_DECL(MODNAME) ErlNifEntry* nif_init(void) +# endif +#endif + + +#define ERL_NIF_INIT(NAME, FUNCS, LOAD, RELOAD, UPGRADE, UNLOAD) \ +ERL_NIF_INIT_GLOB \ +ERL_NIF_INIT_DECL(NAME) \ +{ \ + static ErlNifEntry entry = \ + { \ + ERL_NIF_MAJOR_VERSION, \ + ERL_NIF_MINOR_VERSION, \ + #NAME, \ + sizeof(FUNCS) / sizeof(*FUNCS), \ + FUNCS, \ + LOAD, RELOAD, UPGRADE, UNLOAD \ + }; \ + ERL_NIF_INIT_BODY; \ + return &entry; \ +} + diff --git a/erts/emulator/beam/erl_nif_api_funcs.h b/erts/emulator/beam/erl_nif_api_funcs.h new file mode 100644 index 0000000000..400c1822cc --- /dev/null +++ b/erts/emulator/beam/erl_nif_api_funcs.h @@ -0,0 +1,68 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#if !defined(ERL_NIF_API_FUNC_DECL) && !defined(ERL_NIF_API_FUNC_MACRO) +# error This file should not be included directly +#endif + +#ifdef ERL_NIF_API_FUNC_DECL +ERL_NIF_API_FUNC_DECL(void*,enif_get_data,(ErlNifEnv*)); +ERL_NIF_API_FUNC_DECL(void*,enif_alloc,(ErlNifEnv*, size_t size)); +ERL_NIF_API_FUNC_DECL(void,enif_free,(ErlNifEnv*, void* ptr)); +ERL_NIF_API_FUNC_DECL(int,enif_is_binary,(ErlNifEnv*, ERL_NIF_TERM term)); +ERL_NIF_API_FUNC_DECL(int,enif_inspect_binary,(ErlNifEnv*, ERL_NIF_TERM bin_term, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(int,enif_alloc_binary,(ErlNifEnv*, unsigned size, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(void,enif_release_binary,(ErlNifEnv*, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(int,enif_get_int,(ErlNifEnv*, ERL_NIF_TERM term, int* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_ulong,(ErlNifEnv*, ERL_NIF_TERM term, unsigned long* ip)); +ERL_NIF_API_FUNC_DECL(int,enif_get_list_cell,(ErlNifEnv* env, ERL_NIF_TERM term, ERL_NIF_TERM* head, ERL_NIF_TERM* tail)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_binary,(ErlNifEnv* env, ErlNifBinary* bin)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_badarg,(ErlNifEnv* env)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_int,(ErlNifEnv* env, int i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_ulong,(ErlNifEnv* env, unsigned long i)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_atom,(ErlNifEnv* env, const char* name)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_tuple,(ErlNifEnv* env, unsigned cnt, ...)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list,(ErlNifEnv* env, unsigned cnt, ...)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_list_cell,(ErlNifEnv* env, ERL_NIF_TERM car, ERL_NIF_TERM cdr)); +ERL_NIF_API_FUNC_DECL(ERL_NIF_TERM,enif_make_string,(ErlNifEnv* env, const char* string)); +#endif + +#ifdef ERL_NIF_API_FUNC_MACRO +# define enif_get_data ERL_NIF_API_FUNC_MACRO(enif_get_data) +# define enif_alloc ERL_NIF_API_FUNC_MACRO(enif_alloc) +# define enif_free ERL_NIF_API_FUNC_MACRO(enif_free) +# define enif_is_binary ERL_NIF_API_FUNC_MACRO(enif_is_binary) +# define enif_inspect_binary ERL_NIF_API_FUNC_MACRO(enif_inspect_binary) +# define enif_alloc_binary ERL_NIF_API_FUNC_MACRO(enif_alloc_binary) +# define enif_release_binary ERL_NIF_API_FUNC_MACRO(enif_release_binary) +# define enif_get_int ERL_NIF_API_FUNC_MACRO(enif_get_int) +# define enif_get_ulong ERL_NIF_API_FUNC_MACRO(enif_get_ulong) +# define enif_get_list_cell ERL_NIF_API_FUNC_MACRO(enif_get_list_cell) + +# define enif_make_binary ERL_NIF_API_FUNC_MACRO(enif_make_binary) +# define enif_make_badarg ERL_NIF_API_FUNC_MACRO(enif_make_badarg) +# define enif_make_int ERL_NIF_API_FUNC_MACRO(enif_make_int) +# define enif_make_ulong ERL_NIF_API_FUNC_MACRO(enif_make_ulong) +# define enif_make_atom ERL_NIF_API_FUNC_MACRO(enif_make_atom) +# define enif_make_tuple ERL_NIF_API_FUNC_MACRO(enif_make_tuple) +# define enif_make_list ERL_NIF_API_FUNC_MACRO(enif_make_list) +# define enif_make_list_cell ERL_NIF_API_FUNC_MACRO(enif_make_list_cell) +# define enif_make_string ERL_NIF_API_FUNC_MACRO(enif_make_string) +#endif + diff --git a/erts/emulator/beam/erl_nmgc.c b/erts/emulator/beam/erl_nmgc.c new file mode 100644 index 0000000000..626d4e295a --- /dev/null +++ b/erts/emulator/beam/erl_nmgc.c @@ -0,0 +1,1402 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "global.h" +#include "erl_gc.h" +#include "erl_binary.h" +#include "erl_nmgc.h" +#include "erl_debug.h" +#if HIPE +#include "hipe_bif0.h" /* for hipe_constants_{start,next} */ +#include "hipe_stack.h" +#endif + + +#ifdef INCREMENTAL +/*************************************************************************** + * * + * Incremental Garbage Collector for the Message Area * + * * + ***************************************************************************/ + +/* + * The heap pointers are declared in erl_init.c + * global_heap is the nursery + * global_old_heap is the old generation + */ +unsigned char *blackmap = NULL; +INC_Page *inc_used_mem = NULL; +INC_MemBlock *inc_free_list = NULL; +Eterm *inc_fromspc; +Eterm *inc_fromend; +Eterm *inc_nursery_scn_ptr; +Eterm **fwdptrs; +Eterm *inc_alloc_limit; +Process *inc_active_proc; +Process *inc_active_last; +int inc_words_to_go; + +static Eterm *inc_last_nursery; +static int inc_pages = INC_NoPAGES; +static INC_Page *inc_bibop = NULL; +static int inc_used_pages; + +/* Used when growing the old generation */ +/* +#define INC_ROOTSAVE 16384 +static Eterm *root_save[INC_ROOTSAVE]; +static int roots_saved = 0; +*/ + +INC_STORAGE_DECLARATION(,gray); + +static void inc_minor_gc(Process *p, int need, Eterm* objv, int nobj); +static void inc_major_gc(Process *p, int need, Eterm* objv, int nobj); + +#ifdef INC_TIME_BASED +#if USE_PERFCTR + +/* + * This uses the Linux perfctr extension to virtualise the + * time-stamp counter. + */ +#include "libperfctr.h" +static struct vperfctr *vperfctr; +static double cpu_khz; +static double tsc_to_cpu_mult; + +static void inc_start_hrvtime(void) +{ + struct perfctr_info info; + struct vperfctr_control control; + + if( vperfctr != NULL ) + return; + vperfctr = vperfctr_open(); + if( vperfctr == NULL ) + return; + if( vperfctr_info(vperfctr, &info) >= 0 ) { + cpu_khz = (double)info.cpu_khz; + tsc_to_cpu_mult = (double)(info.tsc_to_cpu_mult ? : 1); + if( info.cpu_features & PERFCTR_FEATURE_RDTSC ) { + memset(&control, 0, sizeof control); + control.cpu_control.tsc_on = 1; + if( vperfctr_control(vperfctr, &control) >= 0 ) + return; + } + } + vperfctr_close(vperfctr); + vperfctr = NULL; +} + +#define inc_get_hrvtime() (((double)vperfctr_read_tsc(vperfctr) * tsc_to_cpu_mult) / cpu_khz) + +#endif /* USE_PERFCTR */ +#endif /* INC_TIME_BASED */ + +#ifdef INC_TIME_BASED +# define timeslice 1 /* milli seconds */ +# define WORK_MORE (inc_get_hrvtime() < start_time + timeslice) +#else +//# define inc_min_work 100 /* words */ +# define inc_min_work global_heap_sz + inc_pages * INC_FULLPAGE /* words */ +# define WORK_MORE (inc_words_to_go > 0) +#endif + +void erts_init_incgc(void) +{ + int i; + int size = inc_pages * INC_FULLPAGE; + + /* Young generation */ + global_heap = (Eterm *)erts_alloc(ERTS_ALC_T_MESSAGE_AREA, + sizeof(Eterm) * global_heap_sz); + global_hend = global_heap + global_heap_sz; + global_htop = global_heap; + inc_alloc_limit = global_hend; + + /* Fromspace */ + inc_last_nursery = (Eterm *) erts_alloc(ERTS_ALC_T_MESSAGE_AREA, + global_heap_sz * sizeof(Eterm)); + inc_fromspc = inc_fromend = NULL; + + /* Forward-pointers */ + fwdptrs = erts_alloc(ERTS_ALC_T_MESSAGE_AREA, + global_heap_sz * sizeof(Eterm*)); + /* Old generation */ + global_old_heap = (Eterm *)erts_alloc(ERTS_ALC_T_MESSAGE_AREA, + size * sizeof(Eterm)); + global_old_hend = global_old_heap + size; + + /* Pages i BiBOP */ + for (i = 0; i < inc_pages; i++) + { + INC_Page *this = (INC_Page*)(global_old_heap + i * INC_FULLPAGE); + this->next = (INC_Page*)((Eterm*)this + INC_FULLPAGE); + } + + inc_bibop = (INC_Page*)global_old_heap; + ((INC_Page*)(global_old_heap + (inc_pages - 1) * INC_FULLPAGE))->next = + NULL; + + inc_used_mem = inc_bibop; + inc_bibop = inc_bibop->next; + inc_used_mem->next = NULL; + inc_used_pages = 1; + + /* Free-list */ + inc_free_list = (INC_MemBlock*)inc_used_mem->start; + inc_free_list->size = INC_PAGESIZE; + inc_free_list->prev = NULL; + inc_free_list->next = NULL; + + /* Blackmap */ + blackmap = (unsigned char*)erts_alloc(ERTS_ALC_T_MESSAGE_AREA, + INC_FULLPAGE * inc_pages); + /* Gray stack */ + INC_STORAGE_INIT(gray); + + inc_active_proc = NULL; + inc_active_last = NULL; + +#ifdef INC_TIME_BASED + inc_start_hrvtime(); +#endif +} + +void erts_cleanup_incgc(void) +{ + INC_STORAGE_ERASE(gray); + + if (inc_fromspc) + inc_last_nursery = inc_fromspc; + + erts_free(ERTS_ALC_T_MESSAGE_AREA,(void*)global_heap); + erts_free(ERTS_ALC_T_MESSAGE_AREA,(void*)inc_last_nursery); + erts_free(ERTS_ALC_T_MESSAGE_AREA,(void*)global_old_heap); + erts_free(ERTS_ALC_T_MESSAGE_AREA,(void*)blackmap); + erts_free(ERTS_ALC_T_MESSAGE_AREA,(void*)fwdptrs); +} + +void erts_incremental_gc(Process* p, int need, Eterm* objv, int nobj) +{ + int repeat_minor; +#ifdef INC_TIME_BASED + double start_time = inc_get_hrvtime(); + int work_left_before = inc_words_to_go; +#endif + /* Used when growing the fromspace */ + static char inc_growing_nurs = 0; + + BM_STOP_TIMER(system); + //BM_MMU_READ(); + BM_RESET_TIMER(gc); + BM_START_TIMER(gc); + + VERBOSE(DEBUG_HYBRID_GC, + ("INCGC: Incremental GC START Caused by: %T Need: %d\n", + p->id,need)); + + ma_gc_flags |= GC_GLOBAL; + ma_gc_flags &= ~GC_CYCLE_START; + +#ifndef INC_TIME_BASED + /* Decide how much work to do this GC stage. The work is meassured + * in number of words copied from the young generation to the old + * plus number of work marked in the old generation. + */ + if (ma_gc_flags & GC_MAJOR) { + int wm = (need > inc_min_work) ? need : inc_min_work; + inc_words_to_go = (int)((wm * (((inc_used_pages * INC_PAGESIZE) / + (double)global_heap_sz) + 1)) + 0.5); + } + else + inc_words_to_go = (need > inc_min_work) ? need : inc_min_work; +#endif + + do { + if (ma_gc_flags & GC_MAJOR) { + /* This is a major collection cycle. */ + inc_major_gc(p,need,objv,nobj); + } else if (ma_gc_flags & GC_CYCLE) { + /* This is a minor collection cycle. */ + inc_minor_gc(p,need,objv,nobj); + } else { + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Collection cycle START\n")); + ma_gc_flags |= (GC_CYCLE | GC_CYCLE_START); + inc_fromspc = global_heap; + inc_fromend = global_htop; + global_heap = global_htop = inc_last_nursery; + global_hend = global_heap + global_heap_sz; + inc_nursery_scn_ptr = global_heap; +#ifdef INC_TIME_BASED + work_left_before = inc_words_to_go = global_heap_sz; +#endif +#ifdef DEBUG + inc_last_nursery = NULL; +#endif + memset(fwdptrs,0,global_heap_sz * sizeof(Eterm)); + + { + /* TODO: Alla processer ska väl egentligen inte aktiveras här... */ + int i; + for (i = 0; i < erts_num_active_procs; i++) { + Process *cp = erts_active_procs[i]; + INC_ACTIVATE(cp); + cp->scan_top = cp->high_water; + } + } + + if (ma_gc_flags & GC_NEED_MAJOR) { + /* The previous collection cycle caused the old generation to + * overflow. This collection cycle will therefore be a major + * one. + */ + BM_COUNT(major_gc_cycles); + VERBOSE(DEBUG_HYBRID_GC,("INCGC: MAJOR cycle\n")); + inc_major_gc(p,need,objv,nobj); + } else { + BM_COUNT(minor_gc_cycles); + VERBOSE(DEBUG_HYBRID_GC,("INCGC: MINOR cycle\n")); + inc_minor_gc(p,need,objv,nobj); + } + } + + repeat_minor = 0; + if (!(ma_gc_flags & GC_CYCLE)) { + inc_alloc_limit = global_hend; + inc_last_nursery = inc_fromspc; + inc_fromspc = inc_fromend = NULL; + ASSERT(INC_STORAGE_EMPTY(gray)); + + if (inc_growing_nurs) { + /* + * The previous collection cycle caused the nursery to + * grow, now we have to grow the from-space as well. + */ + inc_last_nursery = + (Eterm*) erts_realloc(ERTS_ALC_T_MESSAGE_AREA, + (void*)inc_last_nursery, + sizeof(Eterm) * global_heap_sz); + inc_growing_nurs = 0; + } + + if (global_hend - global_htop <= need) { + /* + * Initiate a new GC cycle immediately and, if necessary, + * enlarge the nursery. + */ + if (global_heap_sz <= need) { + VERBOSE(DEBUG_HYBRID_GC, + ("INCGC: Allocating a larger nursery\n")); + global_heap_sz = erts_next_heap_size(need * 1.5,0); + inc_last_nursery = + (Eterm*) erts_realloc(ERTS_ALC_T_MESSAGE_AREA, + (void*)inc_last_nursery, + sizeof(Eterm) * global_heap_sz); + fwdptrs = erts_realloc(ERTS_ALC_T_MESSAGE_AREA,fwdptrs, + global_heap_sz * sizeof(Eterm*)); + inc_growing_nurs = 1; + } + repeat_minor = 1; + } + +#ifdef DEBUG + /* Fill the from-space with bad things */ + memset(inc_last_nursery,DEBUG_BAD_BYTE, + global_heap_sz * sizeof(Eterm)); +#endif + } + } while (repeat_minor); + + + /* Clean up after garbage collection ********************************/ + + if (inc_alloc_limit != global_hend) { + +#ifdef INC_TIME_BASED + if ((work_left_before - inc_words_to_go) == 0) { + inc_alloc_limit = global_htop + need; + } else { + inc_alloc_limit = (global_hend - global_htop) / + (inc_words_to_go / (work_left_before - inc_words_to_go)) + + global_htop; + if (inc_alloc_limit > global_hend) + inc_alloc_limit = global_hend; + } +#else + inc_alloc_limit = (Eterm*)(global_htop + (need > inc_min_work) ? + need : inc_min_work); + if (inc_alloc_limit > global_hend) + inc_alloc_limit = global_hend; +#endif + } + + ma_gc_flags &= ~GC_GLOBAL; + + /* INC_TIME_BASED: If this fails we have to increase the timeslice! */ + ASSERT(inc_alloc_limit - global_htop > need); + + BM_STOP_TIMER(gc); +#ifdef BM_TIMERS + minor_global_gc_time += gc_time; + if (gc_time > max_global_minor_time) + max_global_minor_time = gc_time; + + pause_times[(((gc_time * 1000) < MAX_PAUSE_TIME) ? + (int)(gc_time * 1000) : + MAX_PAUSE_TIME - 1)]++; +#endif + //BM_MMU_INIT(); + { static long long verif = 0; + //erts_printf("innan verify: %d\n",++verif); + if (verif==168) print_memory(NULL); + verify_everything(); + //erts_printf("efter verify: %d\n",verif); + } + BM_START_TIMER(system); + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Incremental GC END\n")); +} + + +/*************************************************************************** + * * + * Minor collection - Copy live data from young generation to old * + * * + ***************************************************************************/ + +#define MINOR_SCAN(PTR,END) do { \ + ASSERT(PTR <= END); \ + while (WORK_MORE && PTR < END) { \ + Eterm val = *PTR; \ + Eterm *obj_ptr = ptr_val(val); \ + switch (primary_tag(val)) { \ + case TAG_PRIMARY_LIST: \ + if (ptr_within(obj_ptr,inc_fromspc,inc_fromend)) { \ + if (INC_IS_FORWARDED(obj_ptr)) { \ + *PTR = make_list(INC_FORWARD_VALUE(obj_ptr)); \ + } \ + else { \ + Eterm *hp = erts_inc_alloc(2); \ + INC_STORE(gray,hp,2); \ + INC_COPY_CONS(obj_ptr,hp,PTR); \ + } \ + } \ + break; \ + case TAG_PRIMARY_BOXED: \ + if (ptr_within(obj_ptr,inc_fromspc,inc_fromend)) { \ + if (INC_IS_FORWARDED(obj_ptr)) { \ + *PTR = make_boxed(INC_FORWARD_VALUE(obj_ptr)); \ + } \ + else { \ + Eterm *hp = erts_inc_alloc(BOXED_NEED(obj_ptr,*obj_ptr)); \ + INC_STORE(gray,hp,BOXED_NEED(obj_ptr,*obj_ptr)); \ + INC_COPY_BOXED(obj_ptr,hp,PTR); \ + } \ + } \ + break; \ + case TAG_PRIMARY_HEADER: \ + switch (val & _TAG_HEADER_MASK) { \ + case ARITYVAL_SUBTAG: break; \ + default: PTR += thing_arityval(val); break; \ + } \ + break; \ + } \ + PTR++; \ + } \ +} while(0) + + +/* Returns: TRUE (1) if the need is greater than the available space + * and the garbage collector needs to be restarted immediately. FALSE + * (0) otherwise. + */ +static void inc_minor_gc(Process* p, int need, Eterm* objv, int nobj) +{ + BM_COUNT(minor_gc_stages); + + /* Start with looking at gray objects found in earlier collection + * stages. + */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Rescue gray found from nursery\n")); + { + INC_Object *obj = NULL; + Eterm *ptr; + + while (WORK_MORE && !INC_STORAGE_EMPTY(gray)) { + obj = INC_STORAGE_GET(gray); + if ((*obj->this & _TAG_HEADER_MASK) == FUN_SUBTAG) { + ptr = obj->this + thing_arityval(*obj->this) + 1; + } else { + ptr = obj->this; + } + MINOR_SCAN(ptr,obj->this + obj->size); + } + /* TODO: Se föregående uppdatering av grå objekt */ + if (!WORK_MORE && obj != NULL) + INC_STORE(gray,obj->this,obj->size); + } + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Scan root-set\n")); + while (WORK_MORE && inc_active_proc) { + Rootset rootset; + Process *cp = inc_active_proc; + + ASSERT(INC_IS_ACTIVE(cp)); + + /* TODO: Hur dyrt är det att bygga nytt rootset varje gång? */ + + /* TODO: Fundera på ordningen! Rootset, Heap, Old heap... */ + + /* TODO: Scanna stacken från p->send till p->stop! [Brooks84] */ + /* Notera: Vi GC:ar inte de yngsta objekten - de som allokeras + under GC-cykeln. Detta ger ynglingarna en chans att dö innan + GC:n börjar kopiera dem. [StefanovicMcKinleyMoss@OOPSLA99] */ + + /* TODO: När rootset är scannat borde processen inte vara + aktiv mer. Den bör aktiveras i schedule, endast om en + process har kört behöver vi scanna rootset igen. */ + + /* MT: In a multithreaded system the process cp needs to be + * locked here. + */ + + if (cp == p) + rootset.n = setup_rootset(cp, objv, nobj, &rootset); + else + rootset.n = setup_rootset(cp, cp->arg_reg, cp->arity, &rootset); + + //MA_GENSWEEP_NSTACK(cp, old_htop, n_htop, objv, nobj); + + while (WORK_MORE && rootset.n--) { + Eterm *g_ptr = rootset.v[rootset.n]; + Uint g_sz = rootset.sz[rootset.n]; + + while (WORK_MORE && g_sz--) { + Eterm gval = *g_ptr; + switch (primary_tag(gval)) { + case TAG_PRIMARY_LIST: { + Eterm *ptr = list_val(gval); + if (ptr_within(ptr,inc_fromspc,inc_fromend)) { + if (INC_IS_FORWARDED(ptr)) { + *g_ptr++ = make_list(INC_FORWARD_VALUE(ptr)); + } + else { + Eterm *hp = erts_inc_alloc(2); + INC_STORE(gray,hp,2); + INC_COPY_CONS(ptr,hp,g_ptr++); + } + } + else + ++g_ptr; + continue; + } + + case TAG_PRIMARY_BOXED: { + Eterm *ptr = boxed_val(gval); + if (ptr_within(ptr,inc_fromspc,inc_fromend)) { + if (INC_IS_FORWARDED(ptr)) { + *g_ptr++ = make_boxed(INC_FORWARD_VALUE(ptr)); + } + else { + Eterm *hp = erts_inc_alloc(BOXED_NEED(ptr,*ptr)); + INC_STORE(gray,hp,BOXED_NEED(ptr,*ptr)); + INC_COPY_BOXED(ptr,hp,g_ptr++); + } + } + else + ++g_ptr; + continue; + } + + default: + g_ptr++; + continue; + } + } + } + + restore_one_rootset(cp, &rootset); + + /* MT: cp can be unlocked now. */ + + /* VERBOSE(DEBUG_HYBRID_GC,("INCGC: Scan private nursery\n")); */ + if (cp->scan_top != HEAP_TOP(cp)) { + Eterm *ptr = cp->scan_top; + MINOR_SCAN(ptr,HEAP_TOP(cp)); + /* TODO: För att spara scan_top här måste alla ma-pekare + * som hittas läggas till i cp->rrma. + */ + //cp->scan_top = ptr; + } + + /* VERBOSE(DEBUG_HYBRID_GC,("INCGC: Scan heap fragments\n")); */ + { + ErlHeapFragment* bp = MBUF(cp); + + while (WORK_MORE && bp) { + Eterm *ptr = bp->mem; + if ((ARITH_HEAP(cp) >= bp->mem) && + (ARITH_HEAP(cp) < bp->mem + bp->size)) { + MINOR_SCAN(ptr,ARITH_HEAP(cp)); + } else { + MINOR_SCAN(ptr,bp->mem + bp->size); + } + bp = bp->next; + } + } + + /* VERBOSE(DEBUG_HYBRID_GC,("INCGC: Scan gray\n")); */ + { + INC_Object *obj = NULL; + Eterm *ptr; + while (WORK_MORE && !INC_STORAGE_EMPTY(gray)) { + obj = INC_STORAGE_GET(gray); + if ((*obj->this & _TAG_HEADER_MASK) == FUN_SUBTAG) { + ptr = obj->this + thing_arityval(*obj->this) + 1; + } else { + ptr = obj->this; + } + MINOR_SCAN(ptr,obj->this + obj->size); + } + /* TODO: INC_STORE(gray,ptr,obj->size-(ptr-obj->this)); Typ.. */ + if (!WORK_MORE && obj != NULL) + INC_STORE(gray,obj->this,obj->size); + } + + if (WORK_MORE) { + //printf("Rootset after:\r\n"); + //print_one_rootset(&rootset); + INC_DEACTIVATE(cp); + } + } + + /* Update new pointers in the nursery to new copies in old generation. */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Update nursery\n")); + { + Eterm *ptr = inc_nursery_scn_ptr; + MINOR_SCAN(ptr,global_htop); + inc_nursery_scn_ptr = ptr; + } + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Rescue gray found from nursery\n")); + { + INC_Object *obj = NULL; + Eterm *ptr; + + while (WORK_MORE && !INC_STORAGE_EMPTY(gray)) { + obj = INC_STORAGE_GET(gray); + if ((*obj->this & _TAG_HEADER_MASK) == FUN_SUBTAG) { + ptr = obj->this + thing_arityval(*obj->this) + 1; + } else { + ptr = obj->this; + } + MINOR_SCAN(ptr,obj->this + obj->size); + } + /* TODO: Se föregående uppdatering av grå objekt */ + if (!WORK_MORE && obj != NULL) + INC_STORE(gray,obj->this,obj->size); + } + + /* Atomic phase */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Update copy stack\n")); + { + Uint i; + for (i = 0; i < ma_dst_top; i++) { + if (ptr_within(ma_dst_stack[i],inc_fromspc,inc_fromend)) { + if (INC_IS_FORWARDED(ma_dst_stack[i])) + ma_dst_stack[i] = INC_FORWARD_VALUE(ma_dst_stack[i]); + } + } + } + + if (WORK_MORE) { + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Update offheap-lists\n")); + { + ExternalThing **prev = &erts_global_offheap.externals; + ExternalThing *ptr = erts_global_offheap.externals; + + /* Atomic phase */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Sweep proc externals\n")); + while (ptr) { + Eterm *ppt = (Eterm*) ptr; + + if (ptr_within(ppt,global_old_heap,global_old_hend)) { + prev = &ptr->next; + ptr = ptr->next; + } else if (ptr_within(ppt, inc_fromspc, inc_fromend) && + INC_IS_FORWARDED(ppt)) { + ExternalThing *ro = (ExternalThing*)INC_FORWARD_VALUE(ppt); + *prev = ro; /* Patch to moved pos */ + prev = &ro->next; + ptr = ro->next; + } else { + erts_deref_node_entry(ptr->node); + *prev = ptr = ptr->next; + } + } + ASSERT(*prev == NULL); + } + + { + ProcBin **prev = &erts_global_offheap.mso; + ProcBin *ptr = erts_global_offheap.mso; + + /* Atomic phase */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Sweep proc bins\n")); + while (ptr) { + Eterm *ppt = (Eterm*)ptr; + + if (ptr_within(ppt,global_old_heap,global_old_hend)) { + prev = &ptr->next; + ptr = ptr->next; + } else if (ptr_within(ppt, inc_fromspc, inc_fromend) && + INC_IS_FORWARDED(ppt)) { + ProcBin *ro = (ProcBin*)INC_FORWARD_VALUE(ppt); + *prev = ro; /* Patch to moved pos */ + prev = &ro->next; + ptr = ro->next; + } else { + Binary *bptr; + *prev = ptr->next; + bptr = ptr->val; + if (erts_refc_dectest(&bptr->refc, 0) == 0) + erts_bin_free(bptr); + ptr = *prev; + } + } + ASSERT(*prev == NULL); + } + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Minor collection cycle END\n")); + ma_gc_flags &= ~GC_CYCLE; + } +} + + + + +/*************************************************************************** + * * + * Major collection - CopyMark - Copy young to old, Mark-Sweep old * + * * + ***************************************************************************/ + +#define COPYMARK(PTR,END) do { \ + ASSERT(PTR <= END); \ + while (WORK_MORE && PTR < END) { \ + Eterm val = *PTR; \ + Eterm *obj_ptr = ptr_val(val); \ + switch (primary_tag(val)) { \ + case TAG_PRIMARY_LIST: \ + COPYMARK_CONS(obj_ptr,aging_htop,PTR,aging_end); break; \ + case TAG_PRIMARY_BOXED: \ + COPYMARK_BOXED(obj_ptr,aging_htop,PTR,aging_end); break; \ + case TAG_PRIMARY_HEADER: \ + switch (val & _TAG_HEADER_MASK) { \ + case ARITYVAL_SUBTAG: break; \ + default: \ + PTR += thing_arityval(val); \ + break; \ + } \ + break; \ + default: break; \ + } \ + PTR++; \ + } \ +} while(0); +/* TODO: + if (aging_htop + 10 > aging + INC_FULLPAGE) { + aging->next = inc_used_mem; + inc_used_mem = aging; + } +*/ + +static void inc_major_gc(Process *p, int need, Eterm* objv, int nobj) +{ + Eterm *free_start = NULL; + Uint live = 0; + Uint old_gen_sz = 0; + static INC_Page *aging; + static Eterm *aging_htop; + static Eterm *aging_end; + BM_NEW_TIMER(old_gc); + + BM_SWAP_TIMER(gc,old_gc); + BM_COUNT(major_gc_stages); + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Major collection START\n")); + + ma_gc_flags |= GC_INCLUDE_ALL; + + if (ma_gc_flags & GC_NEED_MAJOR) + { + INC_Page *page = inc_used_mem; + + ma_gc_flags |= GC_MAJOR; + ma_gc_flags &= ~GC_NEED_MAJOR; + + while (page) + { + memset(blackmap + + ((void*)page - (void*)global_old_heap) / sizeof(void*), + 0, INC_FULLPAGE); + page = page->next; + } + + if (inc_bibop) { + aging = inc_bibop; + inc_bibop = inc_bibop->next; + aging->next = NULL; + memset(blackmap + + ((void*)aging - (void*)global_old_heap) / sizeof(void*), + 1, INC_FULLPAGE); + aging_htop = aging->start; + aging_end = aging->start + INC_PAGESIZE; + } + else { + /* There are no free pages.. Either fragmentation is a + * problem or we are simply out of memory. Allocation in + * the old generation will be done through the free-list + * this GC cycle. + */ + aging = NULL; + aging_htop = aging_end = NULL; + } + } + + /* Start with looking at gray objects found in earlier collection + * stages. + */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Copy-Mark gray\n")); + { + INC_Object *obj = NULL; + + while (WORK_MORE && !INC_STORAGE_EMPTY(gray)) { + Eterm *ptr; + + obj = INC_STORAGE_GET(gray); + if ((*obj->this & _TAG_HEADER_MASK) == FUN_SUBTAG) { + ptr = obj->this + thing_arityval(*obj->this) + 1; + } else { + ptr = obj->this; + } + COPYMARK(ptr,obj->this + obj->size); + } + /* TODO: Titta på motsvarande i minor. */ + if (!WORK_MORE && obj != NULL) + INC_STORE(gray,obj->this,obj->size); + } + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Copy-Mark roots\n")); + while (WORK_MORE && inc_active_proc) + { + /* For each process: Scan all areas containing pointers to the + * message area. When a process is done here, all it's + * message-pointers should be to the old generation. + */ + Rootset rootset; + Process *cp = inc_active_proc; + + ASSERT(INC_IS_ACTIVE(cp)); + + /* MT: In a multithreaded system the process cp needs to be + * locked here. + */ + if (cp == p) + rootset.n = setup_rootset(cp, objv, nobj, &rootset); + else + rootset.n = setup_rootset(cp, cp->arg_reg, cp->arity, &rootset); + + while (WORK_MORE && rootset.n--) + { + Eterm *ptr = rootset.v[rootset.n]; + Eterm *end = ptr + rootset.sz[rootset.n]; + + while (WORK_MORE && ptr < end) { + Eterm val = *ptr; + Eterm *obj_ptr = ptr_val(val); + + switch (primary_tag(val)) { + case TAG_PRIMARY_LIST: + { + COPYMARK_CONS(obj_ptr,aging_htop,ptr,aging_end); + break; + } + + case TAG_PRIMARY_BOXED: + { + COPYMARK_BOXED(obj_ptr,aging_htop,ptr,aging_end); + break; + } + } + ptr++; + } + } + +#ifdef HIPE + /* Atomic phase */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Native stack scan: %T\n",cp->id)); + aging_htop = ma_fullsweep_nstack(cp,aging_htop,aging_end); +#endif + restore_one_rootset(cp, &rootset); + + /* MT: cp can be unlocked now. But beware!! The message queue + * might be updated with new pointers to the fromspace while + * we work below. The send operation can not assume that all + * active processes will look through their message queue + * before deactivating as is the case in non-MT incremental + * collection. + */ + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Copy-Mark process heap\n")); + { + Eterm *ptr = cp->scan_top; + COPYMARK(ptr,cp->htop); + //cp->scan_top = ptr; + } + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Copy-Mark heap fragments\n")); + { + ErlHeapFragment* bp = MBUF(cp); + + while (WORK_MORE && bp) { + Eterm *ptr = bp->mem; + Eterm *end; + + if ((ARITH_HEAP(cp) >= bp->mem) && + (ARITH_HEAP(cp) < bp->mem + bp->size)) { + end = ARITH_HEAP(cp); + } else { + end = bp->mem + bp->size; + } + + COPYMARK(ptr,end); + bp = bp->next; + } + } + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Copy-Mark gray stack\n")); + { + INC_Object *obj = NULL; + + while (WORK_MORE && !INC_STORAGE_EMPTY(gray)) { + Eterm *ptr; + + obj = INC_STORAGE_GET(gray); + if ((*obj->this & _TAG_HEADER_MASK) == FUN_SUBTAG) { + ptr = obj->this + thing_arityval(*obj->this) + 1; + } else { + ptr = obj->this; + } + COPYMARK(ptr,obj->this + obj->size); + } + /* TODO: Titta på motsvarande i minor. */ + if (!WORK_MORE && obj != NULL) + INC_STORE(gray,obj->this,obj->size); + } + + if (WORK_MORE) { + INC_DEACTIVATE(cp); + } + } + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Copy-Mark nursery\n")); + { + Eterm *ptr = inc_nursery_scn_ptr; + COPYMARK(ptr,global_htop); + inc_nursery_scn_ptr = ptr; + } + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Copy-Mark gray found in nursery\n")); + { + INC_Object *obj = NULL; + + while (WORK_MORE && !INC_STORAGE_EMPTY(gray)) { + Eterm *ptr; + + obj = INC_STORAGE_GET(gray); + if ((*obj->this & _TAG_HEADER_MASK) == FUN_SUBTAG) { + ptr = obj->this + thing_arityval(*obj->this) + 1; + } else { + ptr = obj->this; + } + COPYMARK(ptr,obj->this + obj->size); + } + /* TODO: Titta på motsvarande i minor. */ + if (!WORK_MORE && obj != NULL) + INC_STORE(gray,obj->this,obj->size); + } + + + /**********************************************************************/ + if (WORK_MORE) { + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Sweep phase\n")); + + /* Atomic phase */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Sweep externals in old generation\n")); + { + ExternalThing** prev = &erts_global_offheap.externals; + ExternalThing* ptr = erts_global_offheap.externals; + + while (ptr) { + Eterm* ppt = (Eterm *) ptr; + + if ((ptr_within(ppt, global_old_heap, global_old_hend) && + blackmap[ppt - global_old_heap] == 0) || + (ptr_within(ppt, inc_fromspc, inc_fromend) && + !INC_IS_FORWARDED(ppt))) + { + erts_deref_node_entry(ptr->node); + *prev = ptr = ptr->next; + } else if (ptr_within(ppt, inc_fromspc, inc_fromend)) { + ExternalThing* ro = (ExternalThing*)INC_FORWARD_VALUE(ppt); + *prev = ro; /* Patch to moved pos */ + prev = &ro->next; + ptr = ro->next; + } else { + prev = &ptr->next; + ptr = ptr->next; + } + } + ASSERT(*prev == NULL); + } + + /* Atomic phase */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Sweep refc bins in old generation\n")); + { + ProcBin** prev = &erts_global_offheap.mso; + ProcBin* ptr = erts_global_offheap.mso; + + while (ptr) { + Eterm *ppt = (Eterm*)ptr; + + if ((ptr_within(ppt, global_old_heap, global_old_hend) && + blackmap[ppt - global_old_heap] == 0) || + (ptr_within(ppt, inc_fromspc, inc_fromend) && + !INC_IS_FORWARDED(ppt))) + { + Binary* bptr; + *prev = ptr->next; + bptr = ptr->val; + if (erts_refc_dectest(&bptr->refc, 0) == 0) + erts_bin_free(bptr); + ptr = *prev; + } else if (ptr_within(ppt, inc_fromspc, inc_fromend)) { + ProcBin* ro = (ProcBin*)INC_FORWARD_VALUE(ppt); + *prev = ro; /* Patch to moved pos */ + prev = &ro->next; + ptr = ro->next; + } else { + prev = &ptr->next; + ptr = ptr->next; + } + } + ASSERT(*prev == NULL); + } + + /* TODO: Currently atomic phase - Can not be later of course. */ + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Sweep old generation\n")); + { + INC_Page *page = inc_used_mem; + INC_Page *prev = NULL; + inc_free_list = NULL; + + while (page) { + int scavenging = 0; + int n = page->start - global_old_heap; + int stop = n + INC_PAGESIZE; + + old_gen_sz += INC_PAGESIZE; + while (n < stop) { + if (blackmap[n] != 0) { + if (scavenging) { + Eterm *ptr = global_old_heap + n; + scavenging = 0; + if ((ptr - free_start) * sizeof(Eterm) >= + sizeof(INC_MemBlock)) + { + INC_MemBlock *new = (INC_MemBlock*)free_start; + new->size = ptr - free_start; + new->prev = NULL; + new->next = inc_free_list; + if (inc_free_list) + inc_free_list->prev = new; + inc_free_list = new; + } + } + if (blackmap[n] == 255) { + unsigned int size = + *(unsigned int*)(((long)&blackmap[n]+4) & ~3); + live += size; + n += size; + } + else { + live += blackmap[n]; + n += blackmap[n]; + } + } + else if (!scavenging) { + free_start = global_old_heap + n; + scavenging = 1; + n++; + } + else { + n++; + } + } + + if (scavenging) { + if ((global_old_heap + n - free_start) * sizeof(Eterm) > + sizeof(INC_MemBlock)) + { + INC_MemBlock *new = (INC_MemBlock*)free_start; + new->size = global_old_heap + n - free_start; + new->prev = NULL; + new->next = inc_free_list; + if (inc_free_list) + inc_free_list->prev = new; + inc_free_list = new; + } + else if (free_start == page->start) { + INC_Page *next = page->next; + + if (prev) + prev->next = page->next; + else + inc_used_mem = page->next; + + page->next = inc_bibop; + inc_bibop = page; + inc_used_pages--; + page = next; + continue; + } + } + prev = page; + page = page->next; + } + } + } + + ASSERT(inc_bibop); + /* + This code is not expected to work right now. + if (!inc_bibop) { + int i; + int new_pages = inc_pages * 2; + int size = sizeof(Eterm) * new_pages * INC_FULLPAGE; + Eterm *new_heap = erts_alloc(ERTS_ALC_T_MESSAGE_AREA,size); + Eterm *new_hend = new_heap + size; + Eterm *new_htop; + Eterm *last_page_end; + INC_Page *new_used_mem; + INC_Page *page; + + erts_printf("The last page has been allocated..\n"); + erts_printf("We need to copy things!\n"); + + / * Create new, bigger bag of pages * / + for (i = 0; i < new_pages; i++) + { + INC_Page *this = + (INC_Page*)(new_heap + i * INC_FULLPAGE); + this->next = (INC_Page*)((Eterm*)this + INC_FULLPAGE); + } + inc_bibop = (INC_Page*)new_heap; + ((INC_Page*)(new_heap + (new_pages - 1) * + INC_FULLPAGE))->next = NULL; + + new_used_mem = inc_bibop; + inc_bibop = inc_bibop->next; + new_used_mem->next = NULL; + + / * Move stuff from old bag to new * / + inc_free_list = NULL; + new_htop = new_used_mem->start; + last_page_end = new_htop + INC_PAGESIZE; + page = inc_used_mem; + while (page) + { + Eterm *ptr = page->start; + Eterm *page_end = ptr + INC_PAGESIZE; + int n = offsetof(INC_Page,start) / sizeof(void*) + + ((Eterm*)page - global_old_heap); + while (ptr < page_end) + { + if (blackmap[n] > 0) + { + if (last_page_end - new_htop < blackmap[n]) + { + INC_Page *new_page = inc_bibop; + inc_bibop = inc_bibop->next; + new_page->next = new_used_mem; + new_used_mem = new_page; + new_htop = new_page->start; + last_page_end = new_htop + INC_PAGESIZE; + } + + memcpy(new_htop,ptr,blackmap[n] * sizeof(Eterm)); + for (i = 0; i < blackmap[n]; i++) + { + *ptr++ = (Eterm)new_htop++; + } + //new_htop += blackmap[n]; + //ptr += blackmap[n]; + / * + if (blackmap[n] == 255) Do the right thing... + * / + n += blackmap[n]; + } + else + { + n++; ptr++; + } + } + page = page->next; + } + + page = inc_used_mem; + while (page) + { + Eterm *ptr = page->start; + Eterm *page_end = ptr + INC_PAGESIZE; + + / * TODO: If inc_used_mem is sorted in address order, this + * pass can be done at the same time as copying. * / + while (ptr < page_end) + { + if (ptr_within(ptr_val(*ptr),global_old_heap,global_old_hend)) + { + *ptr = *((Eterm*)ptr_val(*ptr)); + } + ptr++; + } + page = page->next; + } + + printf("Restore rootset after heap move. Roots: %d\r\n",roots_saved); + while (roots_saved--) + { + Eterm *ptr = root_save[roots_saved]; + *ptr = *((Eterm*)ptr_val(*ptr)); + } + + erts_free(ERTS_ALC_T_MESSAGE_AREA,(void*)global_old_heap); + + global_old_heap = new_heap; + global_old_hend = new_hend; + inc_used_mem = new_used_mem; + inc_pages = new_pages; + + if ((last_page_end - new_htop) * sizeof(Eterm) >= + sizeof(INC_MemBlock)) + { + inc_free_list = (INC_MemBlock*)(new_htop); + inc_free_list->size = last_page_end - new_htop; + inc_free_list->prev = NULL; + inc_free_list->next = NULL; + } + } + */ + + /* I vilka lägen kan vi vilja slänga på en extra sida.. ( < 25% kvar?) + if () + { + INC_Page *new_page = inc_bibop; + INC_MemBlock *new_free = + (INC_MemBlock*)new_page->start; + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Fetching new page\n")); + inc_bibop = inc_bibop->next; + + new_page->next = inc_used_mem; + if (inc_used_mem) + inc_used_mem->prev = new_page; + inc_used_mem = new_page; + + // kolla detta med normal sidstorlek! old_gen_sz += INC_PAGESIZE; + //BM_SWAP_TIMER(gc,misc1); + memset(blackmap + + ((void*)new_page - (void*)global_old_heap) / sizeof(void*), + 0, INC_FULLPAGE); + //BM_SWAP_TIMER(misc1,gc); + + new_free->prev = NULL; + new_free->next = inc_free_list; + new_free->size = INC_PAGESIZE; + if (inc_free_list) + inc_free_list->prev = new_free; + inc_free_list = new_free; + //printf("Snatched a new page @ 0x%08x\r\n",(int)new_page); + //print_free_list(); + found = new_free; + } + */ + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Update copy stack\n")); + { + Uint i; + for (i = 0; i < ma_dst_top; i++) { + if (ptr_within(ma_dst_stack[i],inc_fromspc,inc_fromend)) { + if (INC_IS_FORWARDED(ma_dst_stack[i])) + ma_dst_stack[i] = INC_FORWARD_VALUE(ma_dst_stack[i]); + } + } + } + + if (WORK_MORE) + { + int size_left = INC_PAGESIZE - (aging_htop - aging->start); + + if (size_left > sizeof(INC_MemBlock)) + { + ((INC_MemBlock*)aging_htop)->size = size_left; + ((INC_MemBlock*)aging_htop)->prev = NULL; + ((INC_MemBlock*)aging_htop)->next = inc_free_list; + if (inc_free_list) + inc_free_list->prev = (INC_MemBlock*)aging_htop; + inc_free_list = (INC_MemBlock*)aging_htop; + } + aging->next = inc_used_mem; + inc_used_mem = aging; + inc_used_pages++; + + ma_gc_flags &= ~GC_MAJOR; + ma_gc_flags &= ~GC_CYCLE; + + VERBOSE(DEBUG_HYBRID_GC,("INCGC: Major collection cycle END\n")); + } + + ma_gc_flags &= ~GC_INCLUDE_ALL; + + BM_STOP_TIMER(old_gc); +#ifdef BM_TIMER + major_global_gc_time += old_gc_time; + if (old_gc_time > max_global_major_time) + max_global_major_time = old_gc_time; + + if ((old_gc_time * 1000) < MAX_PAUSE_TIME) + pause_times_old[(int)(old_gc_time * 1000)]++; + else + pause_times_old[MAX_PAUSE_TIME - 1]++; +#endif + BM_START_TIMER(gc); +} + + + +/*************************************************************************** + * * + * Allocation in the old generation. Used in minor colection and when * + * copying the rest of a message after a GC. * + * * + ***************************************************************************/ + + +Eterm *erts_inc_alloc(int need) +{ + INC_MemBlock *this = inc_free_list; + + ASSERT(need < INC_PAGESIZE); + while (this && (this->size) < need) + { + this = this->next; + } + + if (!this) + { + /* If a free block large enough is not found, a new page is + * allocated. GC_NEED_MAJOR is set so that the next garbage + * collection cycle will be a major one, that is, both + * generations will be garbage collected. + */ + INC_Page *new_page = inc_bibop; + INC_MemBlock *new_free = (INC_MemBlock*)new_page->start; + + if (new_page) + { + VERBOSE(DEBUG_HYBRID_GC, + ("INCGC: Allocation grabs a new page\n")); + inc_bibop = inc_bibop->next; + new_page->next = inc_used_mem; + inc_used_mem = new_page; + inc_used_pages++; + + new_free->prev = NULL; + new_free->next = inc_free_list; + new_free->size = INC_PAGESIZE; + if (inc_free_list) + inc_free_list->prev = new_free; + inc_free_list = new_free; + + this = new_free; + if (!(ma_gc_flags & GC_MAJOR)) + ma_gc_flags |= GC_NEED_MAJOR; + } + else + { + erl_exit(-1, "inc_alloc ran out of pages!\n"); + } + } + + if (((this->size) - need) * sizeof(Eterm) >= sizeof(INC_MemBlock)) + { + INC_MemBlock *rest = (INC_MemBlock*)((Eterm*)this + need); + + /* The order here IS important! */ + rest->next = this->next; + + if (rest->next) + rest->next->prev = rest; + + rest->prev = this->prev; + + if (rest->prev) + rest->prev->next = rest; + else + inc_free_list = rest; + + rest->size = this->size - need; + } + else + { + if (this->prev) + this->prev->next = this->next; + else + inc_free_list = this->next; + + if (this->next) + this->next->prev = this->prev; + } + + if (ma_gc_flags & GC_MAJOR) { + if (need > 254) { + blackmap[(Eterm*)this - global_old_heap] = 255; + *(int*)((long)(&blackmap[(Eterm*)this - global_old_heap]+4) & ~3) = + need; + } else + blackmap[(Eterm*)this - global_old_heap] = need; + } + return (Eterm*)this; +} +#endif /* INCREMENTAL */ diff --git a/erts/emulator/beam/erl_nmgc.h b/erts/emulator/beam/erl_nmgc.h new file mode 100644 index 0000000000..b207dd37fa --- /dev/null +++ b/erts/emulator/beam/erl_nmgc.h @@ -0,0 +1,364 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERL_NMGC_H__ +#define __ERL_NMGC_H__ + +#ifdef INCREMENTAL +#include /* offsetof() */ +#include "erl_process.h" + +#define INC_FULLPAGE (INC_PAGESIZE + offsetof(INC_Page,start) / sizeof(void*)) + +#define BOXED_NEED(PTR,HDR) \ + (((HDR) & _HEADER_SUBTAG_MASK) == SUB_BINARY_SUBTAG ? \ + header_arity(HDR) + 2 : \ + ((HDR) & _HEADER_SUBTAG_MASK) == FUN_SUBTAG ? \ + header_arity(HDR) + ((ErlFunThing*)(PTR))->num_free + 2 : \ + header_arity(HDR) + 1) + + +#define INC_DECREASE_WORK(n) inc_words_to_go -= (n); + +#define INC_COPY_CONS(FROM,TO,PTR) \ +do { \ + TO[0] = FROM[0]; \ + TO[1] = FROM[1]; \ + INC_MARK_FORWARD(FROM,TO); \ + *(PTR) = make_list(TO); \ + INC_DECREASE_WORK(2); \ + (TO) += 2; \ +} while(0) + +#define INC_COPY_BOXED(FROM,TO,PTR) \ +do { \ + Sint nelts; \ + Eterm hdr = *(FROM); \ + \ + ASSERT(is_header(hdr)); \ + INC_MARK_FORWARD(FROM,TO); \ + *(PTR) = make_boxed(TO); \ + *(TO)++ = *(FROM)++; \ + nelts = header_arity(hdr); \ + switch ((hdr) & _HEADER_SUBTAG_MASK) { \ + case SUB_BINARY_SUBTAG: nelts++; break; \ + case FUN_SUBTAG: nelts+=((ErlFunThing*)(FROM-1))->num_free+1; break;\ + } \ + INC_DECREASE_WORK(nelts + 1); \ + while (nelts--) \ + *(TO)++ = *(FROM)++; \ +} while(0) + + +/* Things copied to the old generation are not marked in the blackmap. + * This is ok since the page they are copied to (aging) is not part of + * the sweep. + */ +#define COPYMARK_CONS(FROM,TO,PTR,LIMIT) \ +do { \ + if (ptr_within(FROM,inc_fromspc,inc_fromend)) { \ + if (INC_IS_FORWARDED(FROM)) { \ + *PTR = make_list(INC_FORWARD_VALUE(FROM)); \ + } else if (TO + 2 <= LIMIT) { \ + INC_STORE(gray,TO,2); \ + INC_COPY_CONS(FROM,TO,PTR); \ + } else { \ + Eterm *hp = erts_inc_alloc(2); \ + INC_STORE(gray,hp,2); \ + INC_COPY_CONS(FROM,hp,PTR); \ + } \ + } else if (ptr_within(FROM,global_old_heap,global_old_hend) && \ + (blackmap[FROM - global_old_heap] == 0)) { \ + blackmap[FROM - global_old_heap] = 2; \ + INC_DECREASE_WORK(2); \ + INC_STORE(gray,FROM,2); \ + } \ +} while(0) + +#define COPYMARK_BOXED(FROM,TO,PTR,LIMIT) \ +do { \ + if (ptr_within(FROM,inc_fromspc,inc_fromend)) { \ + int size = BOXED_NEED(FROM,*FROM); \ + if (INC_IS_FORWARDED(FROM)) { \ + *PTR = make_boxed(INC_FORWARD_VALUE(FROM)); \ + } else if (TO + size <= LIMIT) { \ + INC_STORE(gray,TO,size); \ + INC_COPY_BOXED(FROM,TO,PTR); \ + } else { \ + Eterm *hp = erts_inc_alloc(size); \ + INC_STORE(gray,hp,size); \ + INC_COPY_BOXED(FROM,hp,PTR); \ + } \ + } else if (ptr_within(FROM,global_old_heap,global_old_hend) && \ + (blackmap[FROM - global_old_heap] == 0)) { \ + int size = BOXED_NEED(FROM,*FROM); \ + if (size > 254) { \ + blackmap[FROM - global_old_heap] = 255; \ + *(int*)((long)(&blackmap[FROM - \ + global_old_heap] + 4) & ~3) = size; \ + } else \ + blackmap[FROM - global_old_heap] = size; \ + INC_DECREASE_WORK(size); \ + INC_STORE(gray,FROM,size); \ + } \ +} while(0) + +#define INC_MARK_FORWARD(ptr,dst) fwdptrs[(ptr) - inc_fromspc] = (dst); +#define INC_IS_FORWARDED(ptr) (fwdptrs[(ptr) - inc_fromspc] != 0) +#define INC_FORWARD_VALUE(ptr) fwdptrs[(ptr) - inc_fromspc] + +/* Note for BM_TIMER: Active timer should always be 'system' when IncAlloc + * is called! + */ +#define IncAlloc(p, sz, objv, nobj) \ + (ASSERT_EXPR((sz) >= 0), \ + (((inc_alloc_limit - global_htop) <= (sz)) ? \ + erts_incremental_gc((p),(sz),(objv),(nobj)) : 0), \ + ASSERT_EXPR(global_hend - global_htop > (sz)), \ + global_htop += (sz), global_htop - (sz)) + + +/************************************************************************ + * INC_STORAGE, a dynamic circular storage for objects (INC_Object). * + * Use INC_STORE to add objects to the storage. The storage can then * + * be used either as a queue, using INC_STORAGE_GET to retreive * + * values, or as a stack, using INC_STORAGE_POP. It is OK to mix calls * + * to GET and POP if that is desired. * + * An iterator can be declared to traverse the storage without removing * + * any elements, and INC_STORAGE_STEP will then return each element in * + * turn, oldest first. * + ***********************************************************************/ + +/* Declare a new storage; must be in the beginning of a block. Give + * the storage a name that is used in all later calls to the storage. + * If this is an external declaration of the storage, pass the keyword + * external as the first argument, otherwise leave it empty. + */ +#define INC_STORAGE_DECLARATION(ext,name) \ + ext INC_Storage *name##head; \ + ext INC_Storage *name##tail; \ + ext INC_Object *name##free; \ + ext INC_Object *name##last_free; \ + ext int name##size; + + +/* Initialize the storage. Note that memory allocation is involved - + * don't forget to erase the storage when you are done. + */ +#define INC_STORAGE_INIT(name) do { \ + name##head = (INC_Storage*)erts_alloc(ERTS_ALC_T_OBJECT_STACK, \ + sizeof(INC_Storage)); \ + name##head->next = name##head; \ + name##head->prev = name##head; \ + name##tail = name##head; \ + name##free = name##head->data; \ + name##last_free = name##free + INC_STORAGE_SIZE - 1; \ + name##size = 0; \ +} while(0) + + +/* +#define INC_STORAGE_SWAP(s1,s2) do { \ + INC_Storage *tmphead = s1##head; \ + INC_Storage *tmptail = s1##tail; \ + INC_Object *tmpfree = s1##free; \ + INC_Object *tmplast = s1##last_free; \ + int tmpsize = s1##size; \ + s1##head = s2##head; \ + s1##tail = s2##tail; \ + s1##free = s2##free; \ + s1##last_free = s2##last_free; \ + s1##size = s2##size; \ + s2##head = tmphead; \ + s2##tail = tmptail; \ + s2##free = tmpfree; \ + s2##last_free = tmplast; \ + s2##size = tmpsize; \ +} while(0) +*/ + + +/* Return and remove the youngest element - treat the storage as a + * stack. Always check that there are elements in the queue before + * using INC_STORAGE_POP! + */ +#define INC_STORAGE_POP(name) (ASSERT_EXPR(name##size != 0), \ + name##size--, \ + (--name##free != name##head->data - 1) ? \ + name##free : (name##head = name##head->prev, \ + name##free = name##head->data + INC_STORAGE_SIZE - 1)) + + +/* Return and remove the oldest element - treat the storage as a + * queue. Always check that there are elements in the queue before + * using INC_STORAGE_GET! + */ +#define INC_STORAGE_GET(name) (ASSERT_EXPR(name##size != 0), \ + name##size--, \ + (++name##last_free != name##tail->data + INC_STORAGE_SIZE) ? \ + name##last_free : (name##tail = name##tail->next, \ + name##last_free = name##tail->data)) + + +/* Advance the head to the next free location. If the storage is full, + * a new storage is allocated and linked into the list. + */ +#define INC_STORAGE_NEXT(name) do { \ + if (name##free == name##last_free) { \ + name##tail = (INC_Storage*)erts_alloc(ERTS_ALC_T_OBJECT_STACK, \ + sizeof(INC_Storage)); \ + memcpy(name##tail->data,name##head->data, \ + INC_STORAGE_SIZE * sizeof(INC_Object)); \ + name##tail->next = name##head->next; \ + name##head->next = name##tail; \ + name##tail->prev = name##tail->next->prev; \ + name##tail->next->prev = name##tail; \ + name##last_free = ((void*)name##tail + \ + ((void*)name##last_free - (void*)name##head)); \ + } \ + name##free++; \ + name##size++; \ + if (name##free == name##head->data + INC_STORAGE_SIZE) { \ + name##head = name##head->next; \ + name##free = name##head->data; \ + } \ +} while(0) + + +/* The head of this storage is the next free location. This is where + * the next element will be stored. + */ +#define INC_STORAGE_HEAD(name) (name##free) + + +/* Return the top - the youngest element in the storage. */ +/* #define INC_STORAGE_TOP(name) (name##free - 1 with some magic..) */ + + +/* True if the storage is empty, false otherwise */ +#define INC_STORAGE_EMPTY(name) (name##size == 0) + + +/* Store a new element in the head of the storage and advance the head + * to the next free location. + */ +#define INC_STORE(name,ptr,sz) do { \ + INC_STORAGE_HEAD(name)->this = ptr; \ + INC_STORAGE_HEAD(name)->size = sz; \ + INC_STORAGE_NEXT(name); \ +} while(0) + + +/* An iterator. Use it together with INC_STORAGE_STEP to browse throuh + * the storage. Please note that it is not possible to remove an entry + * in the middle of the storage, use GET or POP to remove enties. + */ +#define INC_STORAGE_ITERATOR(name) \ + INC_Storage *name##iterator_head = name##tail; \ + INC_Object *name##iterator_current = name##last_free; \ + int name##iterator_left = name##size; + + +/* Return the next element in the storage (sorted by age, oldest + * first) or NULL if the storage is empty or the last element has been + * returned already. + */ +#define INC_STORAGE_STEP(name) (name##iterator_left == 0 ? NULL : \ + (name##iterator_left--, \ + (++name##iterator_current != name##iterator_head->data + \ + INC_STORAGE_SIZE) ? name##iterator_current : \ + (name##iterator_head = name##iterator_head->next, \ + name##iterator_current = name##iterator_head->data))) + + +/* Erase the storage. */ +#define INC_STORAGE_ERASE(name)do { \ + name##head->prev->next = NULL; \ + while (name##head != NULL) { \ + name##tail = name##head; \ + name##head = name##head->next; \ + erts_free(ERTS_ALC_T_OBJECT_STACK,(void*)name##tail); \ + } \ + name##tail = NULL; \ + name##free = NULL; \ + name##last_free = NULL; \ + name##size = 0; \ +} while(0) + +/* + * Structures used by the non-moving memory manager + */ + +typedef struct +{ + Eterm *this; + unsigned long size; +} INC_Object; + +typedef struct inc_storage { + struct inc_storage *next; + struct inc_storage *prev; + INC_Object data[INC_STORAGE_SIZE]; +} INC_Storage; + +typedef struct inc_mem_block +{ + unsigned long size; + struct inc_mem_block *prev; + struct inc_mem_block *next; +} INC_MemBlock; + +typedef struct inc_page +{ + struct inc_page *next; + Eterm start[1]; /* Has to be last in struct, this is where the data start */ +} INC_Page; + + +/* + * Heap pointers for the non-moving memory area. + */ +extern INC_Page *inc_used_mem; +extern INC_MemBlock *inc_free_list; +extern unsigned char *blackmap; + +extern Eterm **fwdptrs; +extern Eterm *inc_fromspc; +extern Eterm *inc_fromend; +extern Process *inc_active_proc; +extern Process *inc_active_last; +extern Eterm *inc_alloc_limit; +extern int inc_words_to_go; + +INC_STORAGE_DECLARATION(extern,gray); +INC_STORAGE_DECLARATION(extern,root); + +void erts_init_incgc(void); +void erts_cleanup_incgc(void); +void erts_incremental_gc(Process *p, int sz, Eterm* objv, int nobj); +Eterm *erts_inc_alloc(int need); + +#else +# define INC_STORE(lst,ptr,sz) +# define INC_MARK_FORWARD(ptr) +# define INC_IS_FORWARDED(ptr) +# define INC_FORWARD_VALUE(ptr) +#endif /* INCREMENTAL */ + +#endif /* _ERL_NMGC_H_ */ diff --git a/erts/emulator/beam/erl_node_container_utils.h b/erts/emulator/beam/erl_node_container_utils.h new file mode 100644 index 0000000000..87dbfc2a04 --- /dev/null +++ b/erts/emulator/beam/erl_node_container_utils.h @@ -0,0 +1,318 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_NODE_CONTAINER_UTILS_H__ +#define ERL_NODE_CONTAINER_UTILS_H__ + +#include "erl_term.h" + +/* + * Note regarding node containers: + * + * The term "node container" is used as a group name (internally in + * the emulator) for the Erlang data types that contain a reference + * to a node, i.e. pids, ports, and references. + * + * Observe! The layouts of the node container data types have been + * changed in R9. + * + * Node containers are divided into internal and external node containers. + * An internal node container refer to the current incarnation of the + * node which it reside on. An external node container refer to + * either a remote node (i.e. a node with another node name than the + * node name of the node on which the node container resides on) or another + * incarnation of the node which the node container resides on (i.e + * another node with the same node name but another creation). + * + * External node containers are boxed data types. The data of an + * external node container is stored on the heap together with a pointer + * to an element in the node table (see erl_term.h and erl_node_tables.h). + * The elements of the node table are garbage collected by reference + * counting (much like refc binaries, and funs in the separate heap case). + * + * Internal node containers are stored as they previously were (in R8) + * with the exception of changed internal layouts (see erl_term.h), i.e. + * internal pid, and internal port are immediate data types and internal + * reference is a boxed data type. An internal node container have an + * implicit reference to the 'erts_this_node' element in the node table. + * + * Due to the R9 changes in layouts of node containers there are room to + * store more data than previously. Today (R9) this extra space is unused, + * but it is planned to be used in the future. For example only 18 bits + * are used for data in a pid but there is room for 28 bits of data (on a + * 32-bit machine). Some preparations have been made in the emulator for + * usage of this extra space. + * + * OBSERVE! Pids doesn't use fixed size 'serial' and 'number' fields any + * more. Previously the 15 bit 'number' field of a pid was used as index + * into the process table, and the 3 bit 'serial' field was used as a + * "wrap counter". The needed number of bits for index into the process + * table is now calculated at startup and the rest (of the 18 bits used) + * are used as 'serial'. In the "emulator interface" (external format, + * list_to_pid, etc) the least significant 15 bits are presented as + * 'number' and the most significant 3 bits are presented as 'serial', + * though. The makro internal_pid_index() can be used for retrieving + * index into the process table. Do *not* use the result from + * pid_number() as an index into the process table. The pid_number() and + * pid_serial() (and friends) fetch the old fixed size 'number' and + * 'serial' fields. + */ + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Node containers * +\* */ + +#define node_container_node_name(x) (is_external(x) \ + ? external_node_name((x)) \ + : internal_node_name((x))) +#define node_container_creation(x) (is_external(x) \ + ? external_creation((x)) \ + : internal_creation((x))) +#define node_container_dist_entry(x) (is_external(x) \ + ? external_dist_entry((x)) \ + : internal_dist_entry((x))) +#define node_container_channel_no(x) (is_external((x)) \ + ? external_channel_no((x)) \ + : internal_channel_no((x))) +#define is_node_container(x) (is_external((x)) || is_internal((x))) +#define is_not_node_container(x) (!is_node_container((x))) + +#define is_internal(x) (is_internal_pid((x)) \ + || is_internal_port((x)) \ + || is_internal_ref((x))) +#define is_not_internal(x) (!is_internal((x))) +#define internal_node_name(x) (erts_this_node->sysname) +#define external_node_name(x) external_node((x))->sysname +#define internal_creation(x) (erts_this_node->creation) +#define external_creation(x) (external_node((x))->creation) +#define internal_dist_entry(x) (erts_this_node->dist_entry) +#define external_dist_entry(x) (external_node((x))->dist_entry) + +extern int erts_use_r9_pids_ports; + +/* + * For this node (and previous incarnations of this node), 0 is used as + * channel no. For other nodes, the atom index of the atom corresponding + * to the node name is used as channel no. + * + * (We used to assert for correct node names, but we removed that assertion + * as it is possible to sneak in incorrect node names for instance using + * the external format.) + */ +#define dist_entry_channel_no(x) \ + ((x) == erts_this_dist_entry \ + ? ((Uint) 0) \ + : (ASSERT_EXPR(is_atom((x)->sysname)), \ + (Uint) atom_val((x)->sysname))) +#define internal_channel_no(x) ((Uint) ERST_INTERNAL_CHANNEL_NO) +#define external_channel_no(x) \ + (dist_entry_channel_no(external_dist_entry((x)))) + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Pids * +\* */ + +#define internal_pid_index(x) (internal_pid_data((x)) \ + & erts_process_tab_index_mask) + +#define internal_pid_node_name(x) (internal_pid_node((x))->sysname) +#define external_pid_node_name(x) (external_pid_node((x))->sysname) +#define internal_pid_creation(x) (internal_pid_node((x))->creation) +#define external_pid_creation(x) (external_pid_node((x))->creation) +#define internal_pid_dist_entry(x) (internal_pid_node((x))->dist_entry) +#define external_pid_dist_entry(x) (external_pid_node((x))->dist_entry) + +#define internal_pid_channel_no(x) (internal_channel_no((x))) +#define external_pid_channel_no(x) (external_channel_no((x))) + +#define pid_data_words(x) (is_internal_pid((x)) \ + ? internal_pid_data_words((x)) \ + : external_pid_data_words((x))) +#define pid_number(x) (is_internal_pid((x)) \ + ? internal_pid_number((x)) \ + : external_pid_number((x))) +#define pid_serial(x) (is_internal_pid((x)) \ + ? internal_pid_serial((x)) \ + : external_pid_serial((x))) +#define pid_node(x) (is_internal_pid((x)) \ + ? internal_pid_node((x)) \ + : external_pid_node((x))) +#define pid_node_name(x) (is_internal_pid((x)) \ + ? internal_pid_node_name((x)) \ + : external_pid_node_name((x))) +#define pid_creation(x) (is_internal_pid((x)) \ + ? internal_pid_creation((x)) \ + : external_pid_creation((x))) +#define pid_dist_entry(x) (is_internal_pid((x)) \ + ? internal_pid_dist_entry((x)) \ + : external_pid_dist_entry((x))) +#define pid_channel_no(x) (is_internal_pid((x)) \ + ? internal_pid_channel_no((x)) \ + : external_pid_channel_no((x))) +#define is_pid(x) (is_internal_pid((x)) \ + || is_external_pid((x))) +#define is_not_pid(x) (!is_pid(x)) + +#define ERTS_MAX_R9_PROCESSES (1 << ERTS_R9_PROC_BITS) + +/* + * Maximum number of processes. We want the number to fit in a SMALL on + * 32-bit CPU. + */ + +#define ERTS_MAX_PROCESSES ((1L << 27)-1) +#if (ERTS_MAX_PROCESSES > MAX_SMALL) +# error "The maximum number of processes must fit in a SMALL." +#endif + +#define ERTS_MAX_PID_DATA ((1 << _PID_DATA_SIZE) - 1) +#define ERTS_MAX_PID_NUMBER ((1 << _PID_NUM_SIZE) - 1) +#define ERTS_MAX_PID_SERIAL ((1 << _PID_SER_SIZE) - 1) +#define ERTS_MAX_PID_R9_SERIAL ((1 << _PID_R9_SER_SIZE) - 1) + +#define ERTS_R9_PROC_BITS (_PID_R9_SER_SIZE + _PID_NUM_SIZE) +#define ERTS_PROC_BITS (_PID_SER_SIZE + _PID_NUM_SIZE) + +#define ERTS_INVALID_PID make_internal_pid(ERTS_MAX_PID_DATA) + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Ports * +\* */ + +#define internal_port_index(x) (internal_port_data((x)) \ + & erts_port_tab_index_mask) + +#define internal_port_node_name(x) (internal_port_node((x))->sysname) +#define external_port_node_name(x) (external_port_node((x))->sysname) +#define internal_port_creation(x) (internal_port_node((x))->creation) +#define external_port_creation(x) (external_port_node((x))->creation) +#define internal_port_dist_entry(x) (internal_port_node((x))->dist_entry) +#define external_port_dist_entry(x) (external_port_node((x))->dist_entry) + +#define internal_port_channel_no(x) (internal_channel_no((x))) +#define external_port_channel_no(x) (external_channel_no((x))) + +#define port_data_words(x) (is_internal_port((x)) \ + ? internal_port_data_words((x))\ + : external_port_data_words((x))) +#define port_number(x) (is_internal_port((x)) \ + ? internal_port_number((x)) \ + : external_port_number((x))) +#define port_node(x) (is_internal_port((x)) \ + ? internal_port_node((x)) \ + : external_port_node((x))) +#define port_node_name(x) (is_internal_port((x)) \ + ? internal_port_node_name((x)) \ + : external_port_node_name((x))) +#define port_creation(x) (is_internal_port((x)) \ + ? internal_port_creation((x)) \ + : external_port_creation((x))) +#define port_dist_entry(x) (is_internal_port((x)) \ + ? internal_port_dist_entry((x))\ + : external_port_dist_entry((x))) +#define port_channel_no(x) (is_internal_port((x)) \ + ? internal_port_channel_no((x))\ + : external_port_channel_no((x))) + +#define is_port(x) (is_internal_port((x)) \ + || is_external_port((x))) +#define is_not_port(x) (!is_port(x)) + +/* Highest port-ID part in a term of type Port + Not necessarily the same as the variable erts_max_ports + which defines the maximum number of simultaneous Ports + in the Erlang node. ERTS_MAX_PORTS is a hard upper limit. +*/ +#define ERTS_MAX_R9_PORTS (1 << ERTS_R9_PORTS_BITS) +#define ERTS_MAX_PORTS (1 << ERTS_PORTS_BITS) + +#define ERTS_MAX_PORT_DATA ((1 << _PORT_DATA_SIZE) - 1) +#define ERTS_MAX_PORT_NUMBER ((1 << _PORT_NUM_SIZE) - 1) + +#define ERTS_R9_PORTS_BITS (_PORT_R9_NUM_SIZE) +#define ERTS_PORTS_BITS (_PORT_NUM_SIZE) +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Refs * +\* */ + +#ifdef ARCH_64 + +#define internal_ref_no_of_numbers(x) \ + (internal_ref_data((x))[0]) +#define internal_ref_numbers(x) \ + (&internal_ref_data((x))[1]) +#define external_ref_no_of_numbers(x) \ + (external_ref_data((x))[0]) +#define external_ref_numbers(x) \ + (&external_ref_data((x))[1]) + +#else + +#define internal_ref_no_of_numbers(x) (internal_ref_data_words((x))) +#define internal_ref_numbers(x) (internal_ref_data((x))) +#define external_ref_no_of_numbers(x) (external_ref_data_words((x))) +#define external_ref_numbers(x) (external_ref_data((x))) + +#endif + +#define internal_ref_node_name(x) (internal_ref_node((x))->sysname) +#define external_ref_node_name(x) (external_ref_node((x))->sysname) +#define internal_ref_creation(x) (internal_ref_node((x))->creation) +#define external_ref_creation(x) (external_ref_node((x))->creation) +#define internal_ref_dist_entry(x) (internal_ref_node((x))->dist_entry) +#define external_ref_dist_entry(x) (external_ref_node((x))->dist_entry) + + +#define internal_ref_channel_no(x) (internal_channel_no((x))) +#define external_ref_channel_no(x) (external_channel_no((x))) + +#define ref_data_words(x) (is_internal_ref((x)) \ + ? internal_ref_data_words((x)) \ + : external_ref_data_words((x))) +#define ref_data(x) (is_internal_ref((x)) \ + ? internal_ref_data((x)) \ + : external_ref_data((x))) +#define ref_no_of_numbers(x) (is_internal_ref((x)) \ + ? internal_ref_no_of_numbers((x))\ + : external_ref_no_of_numbers((x))) +#define ref_numbers(x) (is_internal_ref((x)) \ + ? internal_ref_numbers((x)) \ + : external_ref_numbers((x))) +#define ref_node(x) (is_internal_ref((x)) \ + ? internal_ref_node(x) \ + : external_ref_node((x))) +#define ref_node_name(x) (is_internal_ref((x)) \ + ? internal_ref_node_name((x)) \ + : external_ref_node_name((x))) +#define ref_creation(x) (is_internal_ref((x)) \ + ? internal_ref_creation((x)) \ + : external_ref_creation((x))) +#define ref_dist_entry(x) (is_internal_ref((x)) \ + ? internal_ref_dist_entry((x)) \ + : external_ref_dist_entry((x))) +#define ref_channel_no(x) (is_internal_ref((x)) \ + ? internal_ref_channel_no((x)) \ + : external_ref_channel_no((x))) +#define is_ref(x) (is_internal_ref((x)) \ + || is_external_ref((x))) +#define is_not_ref(x) (!is_ref(x)) + +#endif + + diff --git a/erts/emulator/beam/erl_node_tables.c b/erts/emulator/beam/erl_node_tables.c new file mode 100644 index 0000000000..42b28d987c --- /dev/null +++ b/erts/emulator/beam/erl_node_tables.c @@ -0,0 +1,1660 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "global.h" +#include "erl_node_tables.h" +#include "dist.h" +#include "big.h" +#include "error.h" + +Hash erts_dist_table; +Hash erts_node_table; +erts_smp_rwmtx_t erts_dist_table_rwmtx; +erts_smp_rwmtx_t erts_node_table_rwmtx; + +DistEntry *erts_hidden_dist_entries; +DistEntry *erts_visible_dist_entries; +DistEntry *erts_not_connected_dist_entries; +Sint erts_no_of_hidden_dist_entries; +Sint erts_no_of_visible_dist_entries; +Sint erts_no_of_not_connected_dist_entries; + +DistEntry *erts_this_dist_entry; +ErlNode *erts_this_node; + +static Uint node_entries; +static Uint dist_entries; + +static int references_atoms_need_init = 1; + +/* -- The distribution table ---------------------------------------------- */ + +#ifdef DEBUG +static int +is_in_de_list(DistEntry *dep, DistEntry *dep_list) +{ + DistEntry *tdep; + for(tdep = dep_list; tdep; tdep = tdep->next) + if(tdep == dep) + return 1; + return 0; +} +#endif + +static HashValue +dist_table_hash(void *dep) +{ + return atom_tab(atom_val(((DistEntry *) dep)->sysname))->slot.bucket.hvalue; +} + +static int +dist_table_cmp(void *dep1, void *dep2) +{ + return (((DistEntry *) dep1)->sysname == ((DistEntry *) dep2)->sysname + ? 0 : 1); +} + +static void* +dist_table_alloc(void *dep_tmpl) +{ + Eterm chnl_nr; + Eterm sysname; + DistEntry *dep; + + if(((DistEntry *) dep_tmpl) == erts_this_dist_entry) + return dep_tmpl; + + sysname = ((DistEntry *) dep_tmpl)->sysname; + chnl_nr = make_small((Uint) atom_val(sysname)); + dep = (DistEntry *) erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry)); + + dist_entries++; + + dep->prev = NULL; + erts_refc_init(&dep->refc, -1); + erts_smp_rwmtx_init_x(&dep->rwmtx, "dist_entry", chnl_nr); + dep->sysname = sysname; + dep->cid = NIL; + dep->connection_id = 0; + dep->status = 0; + dep->flags = 0; + dep->version = 0; + + erts_smp_mtx_init_x(&dep->lnk_mtx, "dist_entry_links", chnl_nr); + dep->node_links = NULL; + dep->nlinks = NULL; + dep->monitors = NULL; + + erts_smp_spinlock_init_x(&dep->qlock, "dist_entry_out_queue", chnl_nr); + dep->qflgs = 0; + dep->qsize = 0; + dep->out_queue.first = NULL; + dep->out_queue.last = NULL; + dep->suspended.first = NULL; + dep->suspended.last = NULL; + + dep->finalized_out_queue.first = NULL; + dep->finalized_out_queue.last = NULL; + + erts_smp_atomic_init(&dep->dist_cmd_scheduled, 0); + erts_port_task_handle_init(&dep->dist_cmd); + dep->send = NULL; + dep->cache = NULL; + + /* Link in */ + + /* All new dist entries are "not connected" */ + dep->next = erts_not_connected_dist_entries; + if(erts_not_connected_dist_entries) { + ASSERT(erts_not_connected_dist_entries->prev == NULL); + erts_not_connected_dist_entries->prev = dep; + } + erts_not_connected_dist_entries = dep; + erts_no_of_not_connected_dist_entries++; + + return (void *) dep; +} + +static void +dist_table_free(void *vdep) +{ + DistEntry *dep = (DistEntry *) vdep; + + if(dep == erts_this_dist_entry) + return; + + ASSERT(is_nil(dep->cid)); + ASSERT(dep->nlinks == NULL); + ASSERT(dep->node_links == NULL); + ASSERT(dep->monitors == NULL); + + /* Link out */ + + /* All dist entries about to be removed are "not connected" */ + + if(dep->prev) { + ASSERT(is_in_de_list(dep, erts_not_connected_dist_entries)); + dep->prev->next = dep->next; + } + else { + ASSERT(erts_not_connected_dist_entries == dep); + erts_not_connected_dist_entries = dep->next; + } + + if(dep->next) + dep->next->prev = dep->prev; + + ASSERT(erts_no_of_not_connected_dist_entries > 0); + erts_no_of_not_connected_dist_entries--; + + ASSERT(!dep->cache); + erts_smp_rwmtx_destroy(&dep->rwmtx); + erts_smp_mtx_destroy(&dep->lnk_mtx); + erts_smp_spinlock_destroy(&dep->qlock); + +#ifdef DEBUG + sys_memset(vdep, 0x77, sizeof(DistEntry)); +#endif + erts_free(ERTS_ALC_T_DIST_ENTRY, (void *) dep); + + ASSERT(dist_entries > 1); + dist_entries--; +} + + +void +erts_dist_table_info(int to, void *to_arg) +{ + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); + hash_info(to, to_arg, &erts_dist_table); + if (lock) + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); +} + +DistEntry * +erts_channel_no_to_dist_entry(Uint cno) +{ +/* + * For this node (and previous incarnations of this node), + * ERST_INTERNAL_CHANNEL_NO (will always be 0 I guess) is used as + * channel no. For other nodes, the atom index of the atom corresponding + * to the node name is used as channel no. + */ + if(cno == ERST_INTERNAL_CHANNEL_NO) { + erts_refc_inc(&erts_this_dist_entry->refc, 2); + return erts_this_dist_entry; + } + + if((cno > MAX_ATOM_INDEX) + || (cno >= atom_table_size()) + || (atom_tab(cno) == NULL)) + return NULL; + + /* cno is a valid atom index; find corresponding dist entry (if there + is one) */ + return erts_find_dist_entry(make_atom(cno)); +} + + +DistEntry * +erts_sysname_to_connected_dist_entry(Eterm sysname) +{ + DistEntry de; + DistEntry *res_dep; + de.sysname = sysname; + + if(erts_this_dist_entry->sysname == sysname) { + erts_refc_inc(&erts_this_dist_entry->refc, 2); + return erts_this_dist_entry; + } + + erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); + res_dep = (DistEntry *) hash_get(&erts_dist_table, (void *) &de); + if (res_dep) { + long refc = erts_refc_inctest(&res_dep->refc, 1); + if (refc < 2) /* Pending delete */ + erts_refc_inc(&res_dep->refc, 1); + } + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); + if (res_dep) { + int deref; + erts_smp_rwmtx_rlock(&res_dep->rwmtx); + deref = is_nil(res_dep->cid); + erts_smp_rwmtx_runlock(&res_dep->rwmtx); + if (deref) { + erts_deref_dist_entry(res_dep); + res_dep = NULL; + } + } + return res_dep; +} + +DistEntry *erts_find_or_insert_dist_entry(Eterm sysname) +{ + DistEntry *res; + DistEntry de; + long refc; + res = erts_find_dist_entry(sysname); + if (res) + return res; + de.sysname = sysname; + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + res = hash_put(&erts_dist_table, (void *) &de); + refc = erts_refc_inctest(&res->refc, 0); + if (refc < 2) /* New or pending delete */ + erts_refc_inc(&res->refc, 1); + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + return res; +} + +DistEntry *erts_find_dist_entry(Eterm sysname) +{ + DistEntry *res; + DistEntry de; + de.sysname = sysname; + erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); + res = hash_get(&erts_dist_table, (void *) &de); + if (res) { + long refc = erts_refc_inctest(&res->refc, 1); + if (refc < 2) /* Pending delete */ + erts_refc_inc(&res->refc, 1); + } + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); + return res; +} + +void erts_delete_dist_entry(DistEntry *dep) +{ + ASSERT(dep != erts_this_dist_entry); + if(dep != erts_this_dist_entry) { + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + /* + * Another thread might have looked up this dist entry after + * we decided to delete it (refc became zero). If so, the other + * thread incremented refc twice. Once for the new reference + * and once for this thread. Therefore, delete dist entry if + * refc is 0 or -1 after a decrement. + */ + if (erts_refc_dectest(&dep->refc, -1) <= 0) + (void) hash_erase(&erts_dist_table, (void *) dep); + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + } +} + +Uint +erts_dist_table_size(void) +{ + Uint res; +#ifdef DEBUG + HashInfo hi; + DistEntry *dep; + int i; +#endif + int lock = !ERTS_IS_CRASH_DUMPING; + + if (lock) + erts_smp_rwmtx_rlock(&erts_dist_table_rwmtx); +#ifdef DEBUG + hash_get_info(&hi, &erts_dist_table); + ASSERT(dist_entries == hi.objs); + + i = 0; + for(dep = erts_visible_dist_entries; dep; dep = dep->next) + i++; + ASSERT(i == erts_no_of_visible_dist_entries); + i = 0; + for(dep = erts_hidden_dist_entries; dep; dep = dep->next) + i++; + ASSERT(i == erts_no_of_hidden_dist_entries); + i = 0; + for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) + i++; + ASSERT(i == erts_no_of_not_connected_dist_entries); + + ASSERT(dist_entries == (erts_no_of_visible_dist_entries + + erts_no_of_hidden_dist_entries + + erts_no_of_not_connected_dist_entries + + 1 /* erts_this_dist_entry */)); +#endif + + res = (hash_table_sz(&erts_dist_table) + + dist_entries*sizeof(DistEntry) + + erts_dist_cache_size()); + if (lock) + erts_smp_rwmtx_runlock(&erts_dist_table_rwmtx); + return res; +} + +void +erts_set_dist_entry_not_connected(DistEntry *dep) +{ + ERTS_SMP_LC_ASSERT(erts_lc_is_de_rwlocked(dep)); + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + + ASSERT(dep != erts_this_dist_entry); + ASSERT(is_internal_port(dep->cid)); + + if(dep->flags & DFLAG_PUBLISHED) { + if(dep->prev) { + ASSERT(is_in_de_list(dep, erts_visible_dist_entries)); + dep->prev->next = dep->next; + } + else { + ASSERT(erts_visible_dist_entries == dep); + erts_visible_dist_entries = dep->next; + } + + ASSERT(erts_no_of_visible_dist_entries > 0); + erts_no_of_visible_dist_entries--; + } + else { + if(dep->prev) { + ASSERT(is_in_de_list(dep, erts_hidden_dist_entries)); + dep->prev->next = dep->next; + } + else { + ASSERT(erts_hidden_dist_entries == dep); + erts_hidden_dist_entries = dep->next; + } + + ASSERT(erts_no_of_hidden_dist_entries > 0); + erts_no_of_hidden_dist_entries--; + } + + if(dep->next) + dep->next->prev = dep->prev; + + dep->status &= ~ERTS_DE_SFLG_CONNECTED; + dep->flags = 0; + dep->prev = NULL; + dep->cid = NIL; + + dep->next = erts_not_connected_dist_entries; + if(erts_not_connected_dist_entries) { + ASSERT(erts_not_connected_dist_entries->prev == NULL); + erts_not_connected_dist_entries->prev = dep; + } + erts_not_connected_dist_entries = dep; + erts_no_of_not_connected_dist_entries++; + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); +} + +void +erts_set_dist_entry_connected(DistEntry *dep, Eterm cid, Uint flags) +{ + ERTS_SMP_LC_ASSERT(erts_lc_is_de_rwlocked(dep)); + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + + ASSERT(dep != erts_this_dist_entry); + ASSERT(is_nil(dep->cid)); + ASSERT(is_internal_port(cid)); + + if(dep->prev) { + ASSERT(is_in_de_list(dep, erts_not_connected_dist_entries)); + dep->prev->next = dep->next; + } + else { + ASSERT(erts_not_connected_dist_entries == dep); + erts_not_connected_dist_entries = dep->next; + } + + if(dep->next) + dep->next->prev = dep->prev; + + ASSERT(erts_no_of_not_connected_dist_entries > 0); + erts_no_of_not_connected_dist_entries--; + + dep->status |= ERTS_DE_SFLG_CONNECTED; + dep->flags = flags; + dep->cid = cid; + dep->connection_id++; + dep->connection_id &= ERTS_DIST_EXT_CON_ID_MASK; + dep->prev = NULL; + + if(flags & DFLAG_PUBLISHED) { + dep->next = erts_visible_dist_entries; + if(erts_visible_dist_entries) { + ASSERT(erts_visible_dist_entries->prev == NULL); + erts_visible_dist_entries->prev = dep; + } + erts_visible_dist_entries = dep; + erts_no_of_visible_dist_entries++; + } + else { + dep->next = erts_hidden_dist_entries; + if(erts_hidden_dist_entries) { + ASSERT(erts_hidden_dist_entries->prev == NULL); + erts_hidden_dist_entries->prev = dep; + } + erts_hidden_dist_entries = dep; + erts_no_of_hidden_dist_entries++; + } + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); +} + +/* -- Node table --------------------------------------------------------- */ + +/* Some large primes */ +#define PRIME0 ((HashValue) 268438039) +#define PRIME1 ((HashValue) 268440479) +#define PRIME2 ((HashValue) 268439161) +#define PRIME3 ((HashValue) 268437017) + +static HashValue +node_table_hash(void *venp) +{ + Uint32 cre = ((ErlNode *) venp)->creation; + HashValue h = atom_tab(atom_val(((ErlNode *) venp)->sysname))->slot.bucket.hvalue; + + h *= PRIME0; + h += cre & 0xff; + +#if MAX_CREATION >= (1 << 8) + h *= PRIME1; + h += (cre >> 8) & 0xff; +#endif + +#if MAX_CREATION >= (1 << 16) + h *= PRIME2; + h += (cre >> 16) & 0xff; +#endif + +#if MAX_CREATION >= (1 << 24) + h *= PRIME3; + h += (cre >> 24) & 0xff; +#endif + +#if 0 +/* XXX Problems in older versions of GCC */ + #if MAX_CREATION >= (1UL << 32) + #error "MAX_CREATION larger than size of expected creation storage (Uint32)" + #endif +#endif + return h; +} + +static int +node_table_cmp(void *venp1, void *venp2) +{ + return ((((ErlNode *) venp1)->sysname == ((ErlNode *) venp2)->sysname + && ((ErlNode *) venp1)->creation == ((ErlNode *) venp2)->creation) + ? 0 + : 1); +} + +static void* +node_table_alloc(void *venp_tmpl) +{ + ErlNode *enp; + + if(((ErlNode *) venp_tmpl) == erts_this_node) + return venp_tmpl; + + enp = (ErlNode *) erts_alloc(ERTS_ALC_T_NODE_ENTRY, sizeof(ErlNode)); + + node_entries++; + + erts_refc_init(&enp->refc, -1); + enp->creation = ((ErlNode *) venp_tmpl)->creation; + enp->sysname = ((ErlNode *) venp_tmpl)->sysname; + enp->dist_entry = erts_find_or_insert_dist_entry(((ErlNode *) venp_tmpl)->sysname); + + return (void *) enp; +} + +static void +node_table_free(void *venp) +{ + ErlNode *enp = (ErlNode *) venp; + + if(enp == erts_this_node) + return; + + erts_deref_dist_entry(enp->dist_entry); +#ifdef DEBUG + sys_memset(venp, 0x55, sizeof(ErlNode)); +#endif + erts_free(ERTS_ALC_T_NODE_ENTRY, venp); + + ASSERT(node_entries > 1); + node_entries--; +} + +Uint +erts_node_table_size(void) +{ + Uint res; +#ifdef DEBUG + HashInfo hi; +#endif + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); +#ifdef DEBUG + hash_get_info(&hi, &erts_node_table); + ASSERT(node_entries == hi.objs); +#endif + res = hash_table_sz(&erts_node_table) + node_entries*sizeof(ErlNode); + if (lock) + erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + return res; +} + +void +erts_node_table_info(int to, void *to_arg) +{ + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + hash_info(to, to_arg, &erts_node_table); + if (lock) + erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); +} + + +ErlNode *erts_find_or_insert_node(Eterm sysname, Uint creation) +{ + ErlNode *res; + ErlNode ne; + ne.sysname = sysname; + ne.creation = creation; + erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + res = hash_put(&erts_node_table, (void *) &ne); + ASSERT(res); + if (res != erts_this_node) { + long refc = erts_refc_inctest(&res->refc, 0); + if (refc < 2) /* New or pending delete */ + erts_refc_inc(&res->refc, 1); + } + erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + return res; +} + +void erts_delete_node(ErlNode *enp) +{ + ASSERT(enp != erts_this_node); + if(enp != erts_this_node) { + erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + /* + * Another thread might have looked up this node after we + * decided to delete it (refc became zero). If so, the other + * thread incremented refc twice. Once for the new reference + * and once for this thread. Therefore, delete node if refc + * is 0 or -1 after a decrement. + */ + if (erts_refc_dectest(&enp->refc, -1) <= 0) + (void) hash_erase(&erts_node_table, (void *) enp); + erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + } +} + +struct pn_data { + int to; + void *to_arg; + Eterm sysname; + int no_sysname; + int no_total; +}; + +static void print_node(void *venp, void *vpndp) +{ + struct pn_data *pndp = ((struct pn_data *) vpndp); + ErlNode *enp = ((ErlNode *) venp); + + if(pndp->sysname == NIL + || enp->sysname == pndp->sysname) { + if (pndp->no_sysname == 0) { + erts_print(pndp->to, pndp->to_arg, "Creation:"); + } + if(pndp->sysname == NIL) { + erts_print(pndp->to, pndp->to_arg, "Name: %T ", enp->sysname); + } + erts_print(pndp->to, pndp->to_arg, " %d", enp->creation); +#ifdef DEBUG + erts_print(pndp->to, pndp->to_arg, " (refc=%ld)", + erts_refc_read(&enp->refc, 1)); +#endif + pndp->no_sysname++; + } + pndp->no_total++; +} + +void erts_print_node_info(int to, + void *to_arg, + Eterm sysname, + int *no_sysname, + int *no_total) +{ + int lock = !ERTS_IS_CRASH_DUMPING; + struct pn_data pnd; + + pnd.to = to; + pnd.to_arg = to_arg; + pnd.sysname = sysname; + pnd.no_sysname = 0; + pnd.no_total = 0; + + if (lock) + erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + hash_foreach(&erts_node_table, print_node, (void *) &pnd); + if (pnd.no_sysname != 0) { + erts_print(to, to_arg, "\n"); + } + if (lock) + erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + + if(no_sysname) + *no_sysname = pnd.no_sysname; + if(no_total) + *no_total = pnd.no_total; +} + +/* ----------------------------------------------------------------------- */ + +void +erts_set_this_node(Eterm sysname, Uint creation) +{ + erts_smp_rwmtx_rwlock(&erts_node_table_rwmtx); + erts_smp_rwmtx_rwlock(&erts_dist_table_rwmtx); + + (void) hash_erase(&erts_dist_table, (void *) erts_this_dist_entry); + erts_this_dist_entry->sysname = sysname; + erts_this_dist_entry->creation = creation; + (void) hash_put(&erts_dist_table, (void *) erts_this_dist_entry); + + (void) hash_erase(&erts_node_table, (void *) erts_this_node); + erts_this_node->sysname = sysname; + erts_this_node->creation = creation; + (void) hash_put(&erts_node_table, (void *) erts_this_node); + + erts_smp_rwmtx_rwunlock(&erts_dist_table_rwmtx); + erts_smp_rwmtx_rwunlock(&erts_node_table_rwmtx); + +} + +void erts_init_node_tables(void) +{ + HashFunctions f; + + f.hash = (H_FUN) dist_table_hash; + f.cmp = (HCMP_FUN) dist_table_cmp; + f.alloc = (HALLOC_FUN) dist_table_alloc; + f.free = (HFREE_FUN) dist_table_free; + + erts_this_dist_entry = erts_alloc(ERTS_ALC_T_DIST_ENTRY, sizeof(DistEntry)); + dist_entries = 1; + + hash_init(ERTS_ALC_T_DIST_TABLE, &erts_dist_table, "dist_table", 11, f); + + erts_hidden_dist_entries = NULL; + erts_visible_dist_entries = NULL; + erts_not_connected_dist_entries = NULL; + erts_no_of_hidden_dist_entries = 0; + erts_no_of_visible_dist_entries = 0; + erts_no_of_not_connected_dist_entries = 0; + + erts_this_dist_entry->next = NULL; + erts_this_dist_entry->prev = NULL; + erts_refc_init(&erts_this_dist_entry->refc, 1); /* erts_this_node */ + + erts_smp_rwmtx_init_x(&erts_this_dist_entry->rwmtx, + "dist_entry", + make_small(ERST_INTERNAL_CHANNEL_NO)); + erts_this_dist_entry->sysname = am_Noname; + erts_this_dist_entry->cid = NIL; + erts_this_dist_entry->connection_id = 0; + erts_this_dist_entry->status = 0; + erts_this_dist_entry->flags = 0; + erts_this_dist_entry->version = 0; + + erts_smp_mtx_init_x(&erts_this_dist_entry->lnk_mtx, + "dist_entry_links", + make_small(ERST_INTERNAL_CHANNEL_NO)); + erts_this_dist_entry->node_links = NULL; + erts_this_dist_entry->nlinks = NULL; + erts_this_dist_entry->monitors = NULL; + + erts_smp_spinlock_init_x(&erts_this_dist_entry->qlock, + "dist_entry_out_queue", + make_small(ERST_INTERNAL_CHANNEL_NO)); + erts_this_dist_entry->qflgs = 0; + erts_this_dist_entry->qsize = 0; + erts_this_dist_entry->out_queue.first = NULL; + erts_this_dist_entry->out_queue.last = NULL; + erts_this_dist_entry->suspended.first = NULL; + erts_this_dist_entry->suspended.last = NULL; + + erts_this_dist_entry->finalized_out_queue.first = NULL; + erts_this_dist_entry->finalized_out_queue.last = NULL; + erts_smp_atomic_init(&erts_this_dist_entry->dist_cmd_scheduled, 0); + erts_port_task_handle_init(&erts_this_dist_entry->dist_cmd); + erts_this_dist_entry->send = NULL; + erts_this_dist_entry->cache = NULL; + + (void) hash_put(&erts_dist_table, (void *) erts_this_dist_entry); + + f.hash = (H_FUN) node_table_hash; + f.cmp = (HCMP_FUN) node_table_cmp; + f.alloc = (HALLOC_FUN) node_table_alloc; + f.free = (HFREE_FUN) node_table_free; + + hash_init(ERTS_ALC_T_NODE_TABLE, &erts_node_table, "node_table", 11, f); + + erts_this_node = erts_alloc(ERTS_ALC_T_NODE_ENTRY, sizeof(ErlNode)); + node_entries = 1; + + erts_refc_init(&erts_this_node->refc, 1); /* The system itself */ + erts_this_node->sysname = am_Noname; + erts_this_node->creation = 0; + erts_this_node->dist_entry = erts_this_dist_entry; + + (void) hash_put(&erts_node_table, (void *) erts_this_node); + + erts_smp_rwmtx_init(&erts_node_table_rwmtx, "node_table"); + erts_smp_rwmtx_init(&erts_dist_table_rwmtx, "dist_table"); + + references_atoms_need_init = 1; +} + +#ifdef ERTS_SMP +#ifdef ERTS_ENABLE_LOCK_CHECK +int erts_lc_is_de_rwlocked(DistEntry *dep) +{ + return erts_smp_lc_rwmtx_is_rwlocked(&dep->rwmtx); +} +int erts_lc_is_de_rlocked(DistEntry *dep) +{ + return erts_smp_lc_rwmtx_is_rlocked(&dep->rwmtx); +} +#endif +#endif + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * The following is only supposed to be used for testing, and debugging. * + * * + * erts_get_node_and_dist_references() returns a table of all references to * + * all entries in the node and dist tables. The hole system will be searched * + * at once. This will give a consistent view over the references, but can * + * can damage the real-time properties of the system. * +\* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +#include "erl_db.h" + +#undef INIT_AM +#define INIT_AM(S) AM_ ## S = am_atom_put(#S, sizeof(#S) - 1) + +static Eterm AM_heap; +static Eterm AM_link; +static Eterm AM_monitor; +static Eterm AM_process; +static Eterm AM_port; +static Eterm AM_ets; +static Eterm AM_binary; +static Eterm AM_match_spec; +static Eterm AM_control; +static Eterm AM_dist; +static Eterm AM_node; +static Eterm AM_dist_references; +static Eterm AM_node_references; +static Eterm AM_system; +static Eterm AM_timer; +#ifdef HYBRID +static Eterm AM_processes; +#endif + +static void setup_reference_table(void); +static Eterm reference_table_term(Uint **hpp, Uint *szp); +static void delete_reference_table(void); + +#if BIG_UINT_HEAP_SIZE > 3 /* 2-tuple */ +#define ID_HEAP_SIZE BIG_UINT_HEAP_SIZE +#else +#define ID_HEAP_SIZE 3 /* 2-tuple */ +#endif + +typedef struct node_referrer_ { + struct node_referrer_ *next; + int heap_ref; + int link_ref; + int monitor_ref; + int ets_ref; + int bin_ref; + int timer_ref; + int system_ref; + Eterm id; + Uint id_heap[ID_HEAP_SIZE]; +} NodeReferrer; + +typedef struct { + ErlNode *node; + NodeReferrer *referrers; +} ReferredNode; + +typedef struct dist_referrer_ { + struct dist_referrer_ *next; + int heap_ref; + int node_ref; + int ctrl_ref; + Eterm id; + Uint creation; +} DistReferrer; + +typedef struct { + DistEntry *dist; + DistReferrer *referrers; +} ReferredDist; + +typedef struct inserted_bin_ { + struct inserted_bin_ *next; + Binary *bin_val; +} InsertedBin; + +static ReferredNode *referred_nodes; +static int no_referred_nodes; +static ReferredDist *referred_dists; +static int no_referred_dists; +static InsertedBin *inserted_bins; + +Eterm +erts_get_node_and_dist_references(struct process *proc) +{ + Uint *hp; + Uint size; + Eterm res; +#ifdef DEBUG + Uint *endp; +#endif + + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + erts_smp_block_system(0); + /* No need to lock any thing since we are alone... */ + + if (references_atoms_need_init) { + INIT_AM(heap); + INIT_AM(link); + INIT_AM(monitor); + INIT_AM(process); + INIT_AM(port); + INIT_AM(ets); + INIT_AM(binary); + INIT_AM(match_spec); + INIT_AM(control); + INIT_AM(dist); + INIT_AM(node); + INIT_AM(dist_references); + INIT_AM(node_references); + INIT_AM(timer); + INIT_AM(system); +#ifdef HYBRID + INIT_AM(processes); +#endif + references_atoms_need_init = 0; + } + + setup_reference_table(); + + /* Get term size */ + size = 0; + (void) reference_table_term(NULL, &size); + + hp = HAlloc(proc, size); +#ifdef DEBUG + ASSERT(size > 0); + endp = hp + size; +#endif + + /* Write term */ + res = reference_table_term(&hp, NULL); + + ASSERT(endp == hp); + + delete_reference_table(); + + erts_smp_release_system(); + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); + return res; +} + +#define HEAP_REF 1 +#define LINK_REF 2 +#define ETS_REF 3 +#define BIN_REF 4 +#define NODE_REF 5 +#define CTRL_REF 6 +#define MONITOR_REF 7 +#define TIMER_REF 8 +#define SYSTEM_REF 9 + +#define INC_TAB_SZ 10 + +static void +insert_dist_referrer(ReferredDist *referred_dist, + int type, + Eterm id, + Uint creation) +{ + DistReferrer *drp; + + for(drp = referred_dist->referrers; drp; drp = drp->next) + if(id == drp->id && (type == CTRL_REF + || creation == drp->creation)) + break; + + if(!drp) { + drp = (DistReferrer *) erts_alloc(ERTS_ALC_T_NC_TMP, + sizeof(DistReferrer)); + drp->next = referred_dist->referrers; + referred_dist->referrers = drp; + drp->id = id; + drp->creation = creation; + drp->heap_ref = 0; + drp->node_ref = 0; + drp->ctrl_ref = 0; + } + + switch (type) { + case NODE_REF: drp->node_ref++; break; + case CTRL_REF: drp->ctrl_ref++; break; + case HEAP_REF: drp->heap_ref++; break; + default: ASSERT(0); + } +} + +static void +insert_dist_entry(DistEntry *dist, int type, Eterm id, Uint creation) +{ + ReferredDist *rdp = NULL; + int i; + + for(i = 0; i < no_referred_dists; i++) { + if(dist == referred_dists[i].dist) { + rdp = &referred_dists[i]; + break; + } + } + + if(!rdp) + erl_exit(1, + "Reference to non-existing distribution table entry found!\n"); + + insert_dist_referrer(rdp, type, id, creation); +} + +static void +insert_node_referrer(ReferredNode *referred_node, int type, Eterm id) +{ + NodeReferrer *nrp; + + for(nrp = referred_node->referrers; nrp; nrp = nrp->next) + if(EQ(id, nrp->id)) + break; + + if(!nrp) { + nrp = (NodeReferrer *) erts_alloc(ERTS_ALC_T_NC_TMP, + sizeof(NodeReferrer)); + nrp->next = referred_node->referrers; + referred_node->referrers = nrp; + if(IS_CONST(id)) + nrp->id = id; + else { + Uint *hp = &nrp->id_heap[0]; + ASSERT(is_big(id) || is_tuple(id)); + nrp->id = copy_struct(id, size_object(id), &hp, NULL); + } + nrp->heap_ref = 0; + nrp->link_ref = 0; + nrp->monitor_ref = 0; + nrp->ets_ref = 0; + nrp->bin_ref = 0; + nrp->timer_ref = 0; + nrp->system_ref = 0; + } + + switch (type) { + case HEAP_REF: nrp->heap_ref++; break; + case LINK_REF: nrp->link_ref++; break; + case ETS_REF: nrp->ets_ref++; break; + case BIN_REF: nrp->bin_ref++; break; + case MONITOR_REF: nrp->monitor_ref++; break; + case TIMER_REF: nrp->timer_ref++; break; + case SYSTEM_REF: nrp->system_ref++; break; + default: ASSERT(0); + } +} + +static void +insert_node(ErlNode *node, int type, Eterm id) +{ + int i; + ReferredNode *rnp = NULL; + for(i = 0; i < no_referred_nodes; i++) { + if(node == referred_nodes[i].node) { + rnp = &referred_nodes[i]; + break; + } + } + + if (!rnp) + erl_exit(1, "Reference to non-existing node table entry found!\n"); + + insert_node_referrer(rnp, type, id); +} + +static void +insert_erl_node(void *venp, void *unused) +{ + ErlNode *enp = (ErlNode *) venp; + + insert_dist_entry(enp->dist_entry, NODE_REF, enp->sysname, enp->creation); +} + +struct insert_offheap2_arg { + int type; + Eterm id; +}; + +static void insert_offheap(ErlOffHeap *, int, Eterm); + +static void +insert_offheap2(ErlOffHeap *oh, void *arg) +{ + struct insert_offheap2_arg *a = (struct insert_offheap2_arg *) arg; + insert_offheap(oh, a->type, a->id); +} + +static void +insert_offheap(ErlOffHeap *oh, int type, Eterm id) +{ + if(oh->externals) { + ExternalThing *etp = oh->externals; + while (etp) { + insert_node(etp->node, type, id); + etp = etp->next; + } + } + + if(oh->mso) { + ProcBin *pb; + struct insert_offheap2_arg a; + a.type = BIN_REF; + for(pb = oh->mso; pb; pb = pb->next) { + if(IsMatchProgBinary(pb->val)) { + InsertedBin *ib; + int insert_bin = 1; + for (ib = inserted_bins; ib; ib = ib->next) + if(ib->bin_val == pb->val) { + insert_bin = 0; + break; + } + if (insert_bin) { + Uint id_heap[BIG_UINT_HEAP_SIZE]; + Uint *hp = &id_heap[0]; + InsertedBin *nib; + a.id = erts_bld_uint(&hp, NULL, (Uint) pb->val); + erts_match_prog_foreach_offheap(pb->val, + insert_offheap2, + (void *) &a); + nib = erts_alloc(ERTS_ALC_T_NC_TMP, sizeof(InsertedBin)); + nib->bin_val = pb->val; + nib->next = inserted_bins; + inserted_bins = nib; + } + } + } + } + +#if 0 + if(oh->funs) { + /* No need to */ + } +#endif +} + +static void doit_insert_monitor(ErtsMonitor *monitor, void *p) +{ + Eterm *idp = p; + if(is_external(monitor->pid)) + insert_node(external_thing_ptr(monitor->pid)->node, MONITOR_REF, *idp); + if(is_external(monitor->ref)) + insert_node(external_thing_ptr(monitor->ref)->node, MONITOR_REF, *idp); +} + +static void doit_insert_link(ErtsLink *lnk, void *p) +{ + Eterm *idp = p; + if(is_external(lnk->pid)) + insert_node(external_thing_ptr(lnk->pid)->node, LINK_REF, + *idp); +} + + +static void +insert_monitors(ErtsMonitor *monitors, Eterm id) +{ + erts_doforall_monitors(monitors,&doit_insert_monitor,&id); +} + +static void +insert_links(ErtsLink *lnk, Eterm id) +{ + erts_doforall_links(lnk,&doit_insert_link,&id); +} + +static void doit_insert_link2(ErtsLink *lnk, void *p) +{ + Eterm *idp = p; + if(is_external(lnk->pid)) + insert_node(external_thing_ptr(lnk->pid)->node, LINK_REF, + *idp); + insert_links(ERTS_LINK_ROOT(lnk), *idp); +} + +static void +insert_links2(ErtsLink *lnk, Eterm id) +{ + erts_doforall_links(lnk,&doit_insert_link2,&id); +} + +static void +insert_ets_table(DbTable *tab, void *unused) +{ + struct insert_offheap2_arg a; + a.type = ETS_REF; + a.id = tab->common.id; + erts_db_foreach_offheap(tab, insert_offheap2, (void *) &a); +} + +static void +insert_bif_timer(Eterm receiver, Eterm msg, ErlHeapFragment *bp, void *arg) +{ + if (bp) { + Eterm heap[3]; + insert_offheap(&bp->off_heap, + TIMER_REF, + (is_internal_pid(receiver) + ? receiver + : TUPLE2(&heap[0], AM_process, receiver))); + } +} + +static void +init_referred_node(void *node, void *unused) +{ + referred_nodes[no_referred_nodes].node = (ErlNode *) node; + referred_nodes[no_referred_nodes].referrers = NULL; + no_referred_nodes++; +} + +static void +init_referred_dist(void *dist, void *unused) +{ + referred_dists[no_referred_dists].dist = (DistEntry *) dist; + referred_dists[no_referred_dists].referrers = NULL; + no_referred_dists++; +} + +#ifdef ERTS_SMP +static void +insert_sys_msg(Eterm from, Eterm to, Eterm msg, ErlHeapFragment *bp) +{ + insert_offheap(&bp->off_heap, HEAP_REF, to); +} +#endif + +static void +setup_reference_table(void) +{ + ErlHeapFragment *hfp; + DistEntry *dep; + HashInfo hi; + int i; + Eterm heap[3]; + + inserted_bins = NULL; + + hash_get_info(&hi, &erts_node_table); + referred_nodes = erts_alloc(ERTS_ALC_T_NC_TMP, + hi.objs*sizeof(ReferredNode)); + no_referred_nodes = 0; + hash_foreach(&erts_node_table, init_referred_node, NULL); + ASSERT(no_referred_nodes == hi.objs); + + hash_get_info(&hi, &erts_dist_table); + referred_dists = erts_alloc(ERTS_ALC_T_NC_TMP, + hi.objs*sizeof(ReferredDist)); + no_referred_dists = 0; + hash_foreach(&erts_dist_table, init_referred_dist, NULL); + ASSERT(no_referred_dists == hi.objs); + + /* Go through the hole system, and build a table of all references + to ErlNode and DistEntry structures */ + + insert_node(erts_this_node, + SYSTEM_REF, + TUPLE2(&heap[0], AM_system, am_undefined)); + +#ifdef HYBRID + /* Insert Heap */ + insert_offheap(&erts_global_offheap, + HEAP_REF, + TUPLE2(&heap[0], AM_processes, am_undefined)); +#endif + + /* Insert all processes */ + for (i = 0; i < erts_max_processes; i++) + if (process_tab[i]) { + ErlMessage *msg; + /* Insert Heap */ + insert_offheap(&(process_tab[i]->off_heap), + HEAP_REF, + process_tab[i]->id); + /* Insert message buffers */ + for(hfp = process_tab[i]->mbuf; hfp; hfp = hfp->next) + insert_offheap(&(hfp->off_heap), + HEAP_REF, + process_tab[i]->id); + /* Insert msg msg buffers */ + for (msg = process_tab[i]->msg.first; msg; msg = msg->next) { + ErlHeapFragment *heap_frag = NULL; + if (msg->data.attached) { + if (is_value(ERL_MESSAGE_TERM(msg))) + heap_frag = msg->data.heap_frag; + else { + if (msg->data.dist_ext->dep) + insert_dist_entry(msg->data.dist_ext->dep, + HEAP_REF, process_tab[i]->id, 0); + if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) + heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + } + } + if (heap_frag) + insert_offheap(&(heap_frag->off_heap), + HEAP_REF, + process_tab[i]->id); + } +#ifdef ERTS_SMP + for (msg = process_tab[i]->msg_inq.first; msg; msg = msg->next) { + ErlHeapFragment *heap_frag = NULL; + if (msg->data.attached) { + if (is_value(ERL_MESSAGE_TERM(msg))) + heap_frag = msg->data.heap_frag; + else { + if (msg->data.dist_ext->dep) + insert_dist_entry(msg->data.dist_ext->dep, + HEAP_REF, process_tab[i]->id, 0); + if (is_not_nil(ERL_MESSAGE_TOKEN(msg))) + heap_frag = erts_dist_ext_trailer(msg->data.dist_ext); + } + } + if (heap_frag) + insert_offheap(&(heap_frag->off_heap), + HEAP_REF, + process_tab[i]->id); + } +#endif + /* Insert links */ + if(process_tab[i]->nlinks) + insert_links(process_tab[i]->nlinks, process_tab[i]->id); + if(process_tab[i]->monitors) + insert_monitors(process_tab[i]->monitors, process_tab[i]->id); + /* Insert controller */ + { + DistEntry *dep = ERTS_PROC_GET_DIST_ENTRY(process_tab[i]); + if (dep) + insert_dist_entry(dep, CTRL_REF, process_tab[i]->id, 0); + } + } + +#ifdef ERTS_SMP + erts_foreach_sys_msg_in_q(insert_sys_msg); +#endif + + /* Insert all ports */ + for (i = 0; i < erts_max_ports; i++) { + if (erts_port[i].status & ERTS_PORT_SFLGS_DEAD) + continue; + + /* Insert links */ + if(erts_port[i].nlinks) + insert_links(erts_port[i].nlinks, erts_port[i].id); + /* Insert port data */ + for(hfp = erts_port[i].bp; hfp; hfp = hfp->next) + insert_offheap(&(hfp->off_heap), HEAP_REF, erts_port[i].id); + /* Insert controller */ + if (erts_port[i].dist_entry) + insert_dist_entry(erts_port[i].dist_entry, + CTRL_REF, + erts_port[i].id, + 0); + } + + { /* Add binaries stored elsewhere ... */ + ErlOffHeap oh; + ProcBin pb[2] = {{0},{0}}; + ProcBin *mso = NULL; + int i = 0; + Binary *default_match_spec; + Binary *default_meta_match_spec; + + /* Only the ProcBin members val and next will be inspected + (by insert_offheap()) */ +#undef ADD_BINARY +#define ADD_BINARY(Bin) \ + if ((Bin)) { \ + pb[i].val = (Bin); \ + pb[i].next = mso; \ + mso = &pb[i]; \ + i++; \ + } + + erts_get_default_trace_pattern(NULL, + &default_match_spec, + &default_meta_match_spec, + NULL, + NULL); + + ADD_BINARY(default_match_spec); + ADD_BINARY(default_meta_match_spec); + + oh.mso = mso; + oh.externals = NULL; +#ifndef HYBRID /* FIND ME! */ + oh.funs = NULL; +#endif + insert_offheap(&oh, BIN_REF, AM_match_spec); +#undef ADD_BINARY + } + + /* Insert all dist links */ + + for(dep = erts_visible_dist_entries; dep; dep = dep->next) { + if(dep->nlinks) + insert_links2(dep->nlinks, dep->sysname); + if(dep->node_links) + insert_links(dep->node_links, dep->sysname); + if(dep->monitors) + insert_monitors(dep->monitors, dep->sysname); + } + + for(dep = erts_hidden_dist_entries; dep; dep = dep->next) { + if(dep->nlinks) + insert_links2(dep->nlinks, dep->sysname); + if(dep->node_links) + insert_links(dep->node_links, dep->sysname); + if(dep->monitors) + insert_monitors(dep->monitors, dep->sysname); + } + + /* Not connected dist entries should not have any links, + but inspect them anyway */ + for(dep = erts_not_connected_dist_entries; dep; dep = dep->next) { + if(dep->nlinks) + insert_links2(dep->nlinks, dep->sysname); + if(dep->node_links) + insert_links(dep->node_links, dep->sysname); + if(dep->monitors) + insert_monitors(dep->monitors, dep->sysname); + } + + /* Insert all ets tables */ + erts_db_foreach_table(insert_ets_table, NULL); + + /* Insert all bif timers */ + erts_bif_timer_foreach(insert_bif_timer, NULL); + + /* Insert node table (references to dist) */ + hash_foreach(&erts_node_table, insert_erl_node, NULL); +} + +/* + Returns an erlang term on this format: + + {{node_references, + [{{Node, Creation}, Refc, + [{{ReferrerType, ID}, + [{ReferenceType,References}, + '...']}, + '...']}, + '...']}, + {dist_references, + [{Node, Refc, + [{{ReferrerType, ID}, + [{ReferenceType,References}, + '...']}, + '...']}, + '...']}} + */ + +static Eterm +reference_table_term(Uint **hpp, Uint *szp) +{ +#undef MK_2TUP +#undef MK_3TUP +#undef MK_CONS +#undef MK_UINT +#define MK_2TUP(E1, E2) erts_bld_tuple(hpp, szp, 2, (E1), (E2)) +#define MK_3TUP(E1, E2, E3) erts_bld_tuple(hpp, szp, 3, (E1), (E2), (E3)) +#define MK_CONS(CAR, CDR) erts_bld_cons(hpp, szp, (CAR), (CDR)) +#define MK_UINT(UI) erts_bld_uint(hpp, szp, (UI)) + int i; + Eterm tup; + Eterm tup2; + Eterm nl = NIL; + Eterm dl = NIL; + Eterm nrid; + + for(i = 0; i < no_referred_nodes; i++) { + NodeReferrer *nrp; + Eterm nril = NIL; + + for(nrp = referred_nodes[i].referrers; nrp; nrp = nrp->next) { + Eterm nrl = NIL; + /* NodeReferenceList = [{ReferenceType,References}] */ + if(nrp->heap_ref) { + tup = MK_2TUP(AM_heap, MK_UINT(nrp->heap_ref)); + nrl = MK_CONS(tup, nrl); + } + if(nrp->link_ref) { + tup = MK_2TUP(AM_link, MK_UINT(nrp->link_ref)); + nrl = MK_CONS(tup, nrl); + } + if(nrp->monitor_ref) { + tup = MK_2TUP(AM_monitor, MK_UINT(nrp->monitor_ref)); + nrl = MK_CONS(tup, nrl); + } + if(nrp->ets_ref) { + tup = MK_2TUP(AM_ets, MK_UINT(nrp->ets_ref)); + nrl = MK_CONS(tup, nrl); + } + if(nrp->bin_ref) { + tup = MK_2TUP(AM_binary, MK_UINT(nrp->bin_ref)); + nrl = MK_CONS(tup, nrl); + } + if(nrp->timer_ref) { + tup = MK_2TUP(AM_timer, MK_UINT(nrp->timer_ref)); + nrl = MK_CONS(tup, nrl); + } + if(nrp->system_ref) { + tup = MK_2TUP(AM_system, MK_UINT(nrp->system_ref)); + nrl = MK_CONS(tup, nrl); + } + + nrid = nrp->id; + if (!IS_CONST(nrp->id)) { + + Uint nrid_sz = size_object(nrp->id); + if (szp) + *szp += nrid_sz; + if (hpp) + nrid = copy_struct(nrp->id, nrid_sz, hpp, NULL); + } + + if (is_internal_pid(nrid) || nrid == am_error_logger) { + ASSERT(!nrp->ets_ref && !nrp->bin_ref && !nrp->system_ref); + tup = MK_2TUP(AM_process, nrid); + } + else if (is_tuple(nrid)) { + Eterm *t; + ASSERT(!nrp->ets_ref && !nrp->bin_ref); + t = tuple_val(nrid); + ASSERT(2 == arityval(t[0])); + tup = MK_2TUP(t[1], t[2]); + } + else if(is_internal_port(nrid)) { + ASSERT(!nrp->heap_ref && !nrp->ets_ref && !nrp->bin_ref + && !nrp->timer_ref && !nrp->system_ref); + tup = MK_2TUP(AM_port, nrid); + } + else if(nrp->ets_ref) { + ASSERT(!nrp->heap_ref && !nrp->link_ref && + !nrp->monitor_ref && !nrp->bin_ref + && !nrp->timer_ref && !nrp->system_ref); + tup = MK_2TUP(AM_ets, nrid); + } + else if(nrp->bin_ref) { + ASSERT(is_small(nrid) || is_big(nrid)); + ASSERT(!nrp->heap_ref && !nrp->ets_ref && !nrp->link_ref && + !nrp->monitor_ref && !nrp->timer_ref + && !nrp->system_ref); + tup = MK_2TUP(AM_match_spec, nrid); + } + else { + ASSERT(!nrp->heap_ref && !nrp->ets_ref && !nrp->bin_ref); + ASSERT(is_atom(nrid)); + tup = MK_2TUP(AM_dist, nrid); + } + tup = MK_2TUP(tup, nrl); + /* NodeReferenceIdList = [{{ReferrerType, ID}, NodeReferenceList}] */ + nril = MK_CONS(tup, nril); + } + + /* NodeList = [{{Node, Creation}, Refc, NodeReferenceIdList}] */ + + tup = MK_2TUP(referred_nodes[i].node->sysname, + MK_UINT(referred_nodes[i].node->creation)); + tup = MK_3TUP(tup, MK_UINT(erts_refc_read(&referred_nodes[i].node->refc, 1)), nril); + nl = MK_CONS(tup, nl); + } + + for(i = 0; i < no_referred_dists; i++) { + DistReferrer *drp; + Eterm dril = NIL; + for(drp = referred_dists[i].referrers; drp; drp = drp->next) { + Eterm drl = NIL; + + /* DistReferenceList = [{ReferenceType,References}] */ + if(drp->node_ref) { + tup = MK_2TUP(AM_node, MK_UINT(drp->node_ref)); + drl = MK_CONS(tup, drl); + } + if(drp->ctrl_ref) { + tup = MK_2TUP(AM_control, MK_UINT(drp->ctrl_ref)); + drl = MK_CONS(tup, drl); + } + if(drp->heap_ref) { + tup = MK_2TUP(AM_heap, MK_UINT(drp->heap_ref)); + drl = MK_CONS(tup, drl); + } + + if (is_internal_pid(drp->id)) { + ASSERT(!drp->node_ref); + tup = MK_2TUP(AM_process, drp->id); + } + else if(is_internal_port(drp->id)) { + ASSERT(drp->ctrl_ref && !drp->node_ref); + tup = MK_2TUP(AM_port, drp->id); + } + else { + ASSERT(!drp->ctrl_ref && drp->node_ref); + ASSERT(is_atom(drp->id)); + tup = MK_2TUP(drp->id, MK_UINT(drp->creation)); + tup = MK_2TUP(AM_node, tup); + } + + tup = MK_2TUP(tup, drl); + + /* DistReferenceIdList = + [{{ReferrerType, ID}, DistReferenceList}] */ + dril = MK_CONS(tup, dril); + + } + + /* DistList = [{Dist, Refc, ReferenceIdList}] */ + tup = MK_3TUP(referred_dists[i].dist->sysname, + MK_UINT(erts_refc_read(&referred_dists[i].dist->refc, 1)), + dril); + dl = MK_CONS(tup, dl); + } + + /* {{node_references, NodeList}, {dist_references, DistList}} */ + + tup = MK_2TUP(AM_node_references, nl); + tup2 = MK_2TUP(AM_dist_references, dl); + tup = MK_2TUP(tup, tup2); + + return tup; +#undef MK_2TUP +#undef MK_3TUP +#undef MK_CONS +#undef MK_UINT + +} + +static void +delete_reference_table(void) +{ + Uint i; + for(i = 0; i < no_referred_nodes; i++) { + NodeReferrer *nrp; + NodeReferrer *tnrp; + nrp = referred_nodes[i].referrers; + while(nrp) { + tnrp = nrp; + nrp = nrp->next; + erts_free(ERTS_ALC_T_NC_TMP, (void *) tnrp); + } + } + if (referred_nodes) + erts_free(ERTS_ALC_T_NC_TMP, (void *) referred_nodes); + + for(i = 0; i < no_referred_dists; i++) { + DistReferrer *drp; + DistReferrer *tdrp; + drp = referred_dists[i].referrers; + while(drp) { + tdrp = drp; + drp = drp->next; + erts_free(ERTS_ALC_T_NC_TMP, (void *) tdrp); + } + } + if (referred_dists) + erts_free(ERTS_ALC_T_NC_TMP, (void *) referred_dists); + while(inserted_bins) { + InsertedBin *ib = inserted_bins; + inserted_bins = inserted_bins->next; + erts_free(ERTS_ALC_T_NC_TMP, (void *)ib); + } +} + diff --git a/erts/emulator/beam/erl_node_tables.h b/erts/emulator/beam/erl_node_tables.h new file mode 100644 index 0000000000..c48dac6219 --- /dev/null +++ b/erts/emulator/beam/erl_node_tables.h @@ -0,0 +1,261 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_NODE_TABLES_H__ +#define ERL_NODE_TABLES_H__ + +/* + * The "node_tables module" contain two (hash) tables: the node_table + * and the dist_table. + * + * The elements of the node_table represents a specific incarnation of + * an Erlang node and has {Nodename, Creation} pairs as keys. Elements + * in the node_table are referred to from node containers (see + * node_container_utils.h). + * + * The elements of the dist_table represents a (potential) connection + * to an Erlang node and has Nodename as key. Elements in the + * dist_table are either referred to from elements in the node_table + * or from the process or port structure of the entity controlling + * the connection. + * + * Both tables are garbage collected by reference counting. + */ + +#include "sys.h" +#include "hash.h" +#include "erl_process.h" +#include "erl_monitors.h" +#include "erl_smp.h" +#define ERTS_PORT_TASK_ONLY_BASIC_TYPES__ +#include "erl_port_task.h" +#undef ERTS_PORT_TASK_ONLY_BASIC_TYPES__ + +#define ERST_INTERNAL_CHANNEL_NO 0 + +#define ERTS_DE_SFLG_CONNECTED (((Uint32) 1) << 0) +#define ERTS_DE_SFLG_EXITING (((Uint32) 1) << 1) + +#define ERTS_DE_SFLGS_ALL (ERTS_DE_SFLG_CONNECTED \ + | ERTS_DE_SFLG_EXITING) + +#define ERTS_DE_QFLG_BUSY (((Uint32) 1) << 0) +#define ERTS_DE_QFLG_EXIT (((Uint32) 1) << 1) + +#define ERTS_DE_QFLGS_ALL (ERTS_DE_QFLG_BUSY \ + | ERTS_DE_QFLG_EXIT) + +#ifdef ARCH_64 +#define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713f713f713UL) +#else +#define ERTS_DIST_OUTPUT_BUF_DBG_PATTERN ((Uint) 0xf713f713) +#endif + +typedef struct ErtsDistOutputBuf_ ErtsDistOutputBuf; +struct ErtsDistOutputBuf_ { +#ifdef DEBUG + Uint dbg_pattern; +#endif + ErtsDistOutputBuf *next; + byte *extp; + byte *ext_endp; + byte data[1]; +}; + +typedef struct { + ErtsDistOutputBuf *first; + ErtsDistOutputBuf *last; +} ErtsDistOutputQueue; + +struct ErtsProcList_; +typedef struct { + struct ErtsProcList_ *first; + struct ErtsProcList_ *last; +} ErtsDistSuspended; + +/* + * Lock order: + * 1. dist_entry->rwmtx + * 2. erts_node_table_rwmtx + * 3. erts_dist_table_rwmtx + * + * Lock mutexes with lower numbers before mutexes with higher numbers and + * unlock mutexes with higher numbers before mutexes with higher numbers. + */ + +struct erl_link; +struct port; + +typedef struct dist_entry_ { + HashBucket hash_bucket; /* Hash bucket */ + struct dist_entry_ *next; /* Next entry in dist_table (not sorted) */ + struct dist_entry_ *prev; /* Previous entry in dist_table (not sorted) */ + erts_refc_t refc; /* Reference count */ + + erts_smp_rwmtx_t rwmtx; /* Protects all fields below until lck_mtx. */ + Eterm sysname; /* name@host atom for efficiency */ + Uint32 creation; /* creation of connected node */ + Eterm cid; /* connection handler (pid or port), NIL == free */ + Uint32 connection_id; /* Connection id incremented on connect */ + Uint32 status; /* Slot status, like exiting reserved etc */ + Uint32 flags; /* Distribution flags, like hidden, + atom cache etc. */ + unsigned long version; /* Protocol version */ + + + erts_smp_mtx_t lnk_mtx; /* Protects node_links, nlinks, and + monitors. */ + ErtsLink *node_links; /* In a dist entry, node links are kept + in a separate tree, while they are + colocted with the ordinary link tree + for processes. It's not due to confusion, + it's because the link tree for the dist + entry is in two levels, see erl_monitors.h + */ + ErtsLink *nlinks; /* Link tree with subtrees */ + ErtsMonitor *monitors; /* Monitor tree */ + + erts_smp_spinlock_t qlock; /* Protects qflgs and out_queue */ + Uint32 qflgs; + Sint qsize; + ErtsDistOutputQueue out_queue; + ErtsDistSuspended suspended; + + ErtsDistOutputQueue finalized_out_queue; + erts_smp_atomic_t dist_cmd_scheduled; + ErtsPortTaskHandle dist_cmd; + + Uint (*send)(struct port *prt, ErtsDistOutputBuf *obuf); + + struct cache* cache; /* The atom cache */ +} DistEntry; + +typedef struct erl_node_ { + HashBucket hash_bucket; /* Hash bucket */ + erts_refc_t refc; /* Reference count */ + Eterm sysname; /* name@host atom for efficiency */ + Uint32 creation; /* Creation */ + DistEntry *dist_entry; /* Corresponding dist entry */ +} ErlNode; + + +extern Hash erts_dist_table; +extern Hash erts_node_table; +extern erts_smp_rwmtx_t erts_dist_table_rwmtx; +extern erts_smp_rwmtx_t erts_node_table_rwmtx; + +extern DistEntry *erts_hidden_dist_entries; +extern DistEntry *erts_visible_dist_entries; +extern DistEntry *erts_not_connected_dist_entries; +extern Sint erts_no_of_hidden_dist_entries; +extern Sint erts_no_of_visible_dist_entries; +extern Sint erts_no_of_not_connected_dist_entries; + +extern DistEntry *erts_this_dist_entry; +extern ErlNode *erts_this_node; + +DistEntry *erts_channel_no_to_dist_entry(Uint); +DistEntry *erts_sysname_to_connected_dist_entry(Eterm); +DistEntry *erts_find_or_insert_dist_entry(Eterm); +DistEntry *erts_find_dist_entry(Eterm); +void erts_delete_dist_entry(DistEntry *); +Uint erts_dist_table_size(void); +void erts_dist_table_info(int, void *); +void erts_set_dist_entry_not_connected(DistEntry *); +void erts_set_dist_entry_connected(DistEntry *, Eterm, Uint); +ErlNode *erts_find_or_insert_node(Eterm, Uint); +void erts_delete_node(ErlNode *); +void erts_set_this_node(Eterm, Uint); +Uint erts_node_table_size(void); +void erts_init_node_tables(void); +void erts_node_table_info(int, void *); +void erts_print_node_info(int, void *, Eterm, int*, int*); +Eterm erts_get_node_and_dist_references(struct process *); +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) +int erts_lc_is_de_rwlocked(DistEntry *); +int erts_lc_is_de_rlocked(DistEntry *); +#endif + +ERTS_GLB_INLINE void erts_deref_dist_entry(DistEntry *dep); +ERTS_GLB_INLINE void erts_deref_node_entry(ErlNode *np); +ERTS_GLB_INLINE void erts_smp_de_rlock(DistEntry *dep); +ERTS_GLB_INLINE void erts_smp_de_runlock(DistEntry *dep); +ERTS_GLB_INLINE void erts_smp_de_rwlock(DistEntry *dep); +ERTS_GLB_INLINE void erts_smp_de_rwunlock(DistEntry *dep); +ERTS_GLB_INLINE void erts_smp_de_links_lock(DistEntry *dep); +ERTS_GLB_INLINE void erts_smp_de_links_unlock(DistEntry *dep); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_deref_dist_entry(DistEntry *dep) +{ + ASSERT(dep); + if (erts_refc_dectest(&dep->refc, 0) == 0) + erts_delete_dist_entry(dep); +} + +ERTS_GLB_INLINE void +erts_deref_node_entry(ErlNode *np) +{ + ASSERT(np); + if (erts_refc_dectest(&np->refc, 0) == 0) + erts_delete_node(np); +} + +ERTS_GLB_INLINE void +erts_smp_de_rlock(DistEntry *dep) +{ + erts_smp_rwmtx_rlock(&dep->rwmtx); +} + +ERTS_GLB_INLINE void +erts_smp_de_runlock(DistEntry *dep) +{ + erts_smp_rwmtx_runlock(&dep->rwmtx); +} + +ERTS_GLB_INLINE void +erts_smp_de_rwlock(DistEntry *dep) +{ + erts_smp_rwmtx_rwlock(&dep->rwmtx); +} + +ERTS_GLB_INLINE void +erts_smp_de_rwunlock(DistEntry *dep) +{ + erts_smp_rwmtx_rwunlock(&dep->rwmtx); +} + +ERTS_GLB_INLINE void +erts_smp_de_links_lock(DistEntry *dep) +{ + erts_smp_mtx_lock(&dep->lnk_mtx); +} + +ERTS_GLB_INLINE void +erts_smp_de_links_unlock(DistEntry *dep) +{ + erts_smp_mtx_unlock(&dep->lnk_mtx); +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + +#endif diff --git a/erts/emulator/beam/erl_obsolete.c b/erts/emulator/beam/erl_obsolete.c new file mode 100644 index 0000000000..9c5a7c7ff9 --- /dev/null +++ b/erts/emulator/beam/erl_obsolete.c @@ -0,0 +1,186 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_driver.h" + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * * + * ------------------------- OBSOLETE! DO NOT USE! ------------------------- * + * * +\* */ + +/* cut from ../obsolete/driver.h (since it doesn't mix well with other + * headers from the emulator). + */ +#ifdef __WIN32__ +#ifdef CONST +# undef CONST +#endif +#endif + +#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE) +# define _USING_PROTOTYPES_ 1 +# define _ANSI_ARGS_(x) x +# define CONST const +#else +# define _ANSI_ARGS_(x) () +# define CONST +#endif + +typedef void* erl_mutex_t; +typedef void* erl_cond_t; +typedef void* erl_thread_t; + +EXTERN erl_mutex_t erts_mutex_create _ANSI_ARGS_((void)); +EXTERN int erts_mutex_destroy _ANSI_ARGS_((erl_mutex_t)); +EXTERN int erts_mutex_lock _ANSI_ARGS_((erl_mutex_t)); +EXTERN int erts_mutex_unlock _ANSI_ARGS_((erl_mutex_t)); + +EXTERN erl_cond_t erts_cond_create _ANSI_ARGS_((void)); +EXTERN int erts_cond_destroy _ANSI_ARGS_((erl_cond_t)); +EXTERN int erts_cond_signal _ANSI_ARGS_((erl_cond_t)); +EXTERN int erts_cond_broadcast _ANSI_ARGS_((erl_cond_t)); +EXTERN int erts_cond_wait _ANSI_ARGS_((erl_cond_t, erl_mutex_t)); +EXTERN int erts_cond_timedwait _ANSI_ARGS_((erl_cond_t, erl_mutex_t, long)); + +EXTERN int erts_thread_create _ANSI_ARGS_((erl_thread_t*, + void* (*func)(void*), + void* arg, + int detached)); +EXTERN erl_thread_t erts_thread_self _ANSI_ARGS_((void)); +EXTERN void erts_thread_exit _ANSI_ARGS_((void*)); +EXTERN int erts_thread_join _ANSI_ARGS_((erl_thread_t, void**)); +EXTERN int erts_thread_kill _ANSI_ARGS_((erl_thread_t)); + +/* + * These functions implement the thread interface in ../obsolete/driver.h. + * Do *not* use this interface! Within the emulator, use the erl_threads.h, + * erl_smp.h, or ethread.h interface. From a driver use the thread interface + * in erl_driver.h. + */ + +erl_mutex_t +erts_mutex_create(void) +{ + return (erl_mutex_t) erl_drv_mutex_create(NULL); +} + +int +erts_mutex_destroy(erl_mutex_t mtx) +{ + erl_drv_mutex_destroy((ErlDrvMutex *) mtx); + return 0; +} + +int +erts_mutex_lock(erl_mutex_t mtx) +{ + erl_drv_mutex_lock((ErlDrvMutex *) mtx); + return 0; +} + +int +erts_mutex_unlock(erl_mutex_t mtx) +{ + erl_drv_mutex_unlock((ErlDrvMutex *) mtx); + return 0; +} + +erl_cond_t +erts_cond_create(void) +{ + return (erl_cond_t) erl_drv_cond_create(NULL); +} + +int +erts_cond_destroy(erl_cond_t cnd) +{ + erl_drv_cond_destroy((ErlDrvCond *) cnd); + return 0; +} + + +int +erts_cond_signal(erl_cond_t cnd) +{ + erl_drv_cond_signal((ErlDrvCond *) cnd); + return 0; +} + +int +erts_cond_broadcast(erl_cond_t cnd) +{ + erl_drv_cond_broadcast((ErlDrvCond *) cnd); + return 0; +} + + +int +erts_cond_wait(erl_cond_t cnd, erl_mutex_t mtx) +{ + erl_drv_cond_wait((ErlDrvCond *) cnd, (ErlDrvMutex *) mtx); + return 0; +} + +int +erts_cond_timedwait(erl_cond_t cnd, erl_mutex_t mtx, long ms) +{ + return ENOTSUP; +} + +int +erts_thread_create(erl_thread_t *tid, + void* (*func)(void*), + void* arg, + int detached) +{ + if (detached) + return ENOTSUP; + return erl_drv_thread_create(NULL, (ErlDrvTid *) tid, func, arg, NULL); +} + +erl_thread_t +erts_thread_self(void) +{ + return (erl_thread_t) erl_drv_thread_self(); +} + +void +erts_thread_exit(void *res) +{ + erl_drv_thread_exit(res); +} + +int +erts_thread_join(erl_thread_t tid, void **respp) +{ + return erl_drv_thread_join((ErlDrvTid) tid, respp); +} + +int +erts_thread_kill(erl_thread_t tid) +{ + return ENOTSUP; +} + diff --git a/erts/emulator/beam/erl_port_task.c b/erts/emulator/beam/erl_port_task.c new file mode 100644 index 0000000000..0fb264a53c --- /dev/null +++ b/erts/emulator/beam/erl_port_task.c @@ -0,0 +1,1100 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Scheduling of port tasks + * + * Author: Rickard Green + */ + +#define ERL_PORT_TASK_C__ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "global.h" +#include "erl_port_task.h" +#include "dist.h" + +#if defined(DEBUG) && 0 +#define HARD_DEBUG +#endif + +/* + * Costs in reductions for some port operations. + */ +#define ERTS_PORT_REDS_EXECUTE 0 +#define ERTS_PORT_REDS_FREE 50 +#define ERTS_PORT_REDS_TIMEOUT 200 +#define ERTS_PORT_REDS_INPUT 200 +#define ERTS_PORT_REDS_OUTPUT 200 +#define ERTS_PORT_REDS_EVENT 200 +#define ERTS_PORT_REDS_TERMINATE 100 + + +#define ERTS_PORT_TASK_INVALID_PORT(P, ID) \ + ((erts_port_status_get((P)) & ERTS_PORT_SFLGS_DEAD) || (P)->id != (ID)) + +#define ERTS_PORT_IS_IN_RUNQ(RQ, P) \ + ((P)->sched.next || (P)->sched.prev || (RQ)->ports.start == (P)) + +#define ERTS_PORT_NOT_IN_RUNQ(P) \ +do { \ + (P)->sched.prev = NULL; \ + (P)->sched.next = NULL; \ +} while (0) + +erts_smp_atomic_t erts_port_task_outstanding_io_tasks; + +struct ErtsPortTaskQueue_ { + ErtsPortTask *first; + ErtsPortTask *last; + Port *port; +}; + +struct ErtsPortTask_ { + ErtsPortTask *prev; + ErtsPortTask *next; + ErtsPortTaskQueue *queue; + ErtsPortTaskHandle *handle; + ErtsPortTaskType type; + ErlDrvEvent event; + ErlDrvEventData event_data; +}; + +#ifdef HARD_DEBUG +#define ERTS_PT_CHK_PORTQ(RQ) check_port_queue((RQ), NULL, 0) +#define ERTS_PT_CHK_PRES_PORTQ(RQ, PP) check_port_queue((RQ), (PP), -1) +#define ERTS_PT_CHK_IN_PORTQ(RQ, PP) check_port_queue((RQ), (PP), 1) +#define ERTS_PT_CHK_NOT_IN_PORTQ(RQ, PP) check_port_queue((RQ), (PP), 0) +#define ERTS_PT_CHK_TASKQ(Q) check_task_queue((Q), NULL, 0) +#define ERTS_PT_CHK_IN_TASKQ(Q, T) check_task_queue((Q), (T), 1) +#define ERTS_PT_CHK_NOT_IN_TASKQ(Q, T) check_task_queue((Q), (T), 0) +static void +check_port_queue(Port *chk_pp, int inq); +static void +check_task_queue(ErtsPortTaskQueue *ptqp, + ErtsPortTask *chk_ptp, + int inq); +#else +#define ERTS_PT_CHK_PORTQ(RQ) +#define ERTS_PT_CHK_PRES_PORTQ(RQ, PP) +#define ERTS_PT_CHK_IN_PORTQ(RQ, PP) +#define ERTS_PT_CHK_NOT_IN_PORTQ(RQ, PP) +#define ERTS_PT_CHK_TASKQ(Q) +#define ERTS_PT_CHK_IN_TASKQ(Q, T) +#define ERTS_PT_CHK_NOT_IN_TASKQ(Q, T) +#endif + +static void handle_remaining_tasks(ErtsRunQueue *runq, Port *pp); + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(port_task, + ErtsPortTask, + 200, + ERTS_ALC_T_PORT_TASK) +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(port_taskq, + ErtsPortTaskQueue, + 50, + ERTS_ALC_T_PORT_TASKQ) + +/* + * Task handle manipulation. + */ + +static ERTS_INLINE ErtsPortTask * +handle2task(ErtsPortTaskHandle *pthp) +{ + return (ErtsPortTask *) erts_smp_atomic_read(pthp); +} + +static ERTS_INLINE void +reset_handle(ErtsPortTask *ptp) +{ + if (ptp->handle) { + ASSERT(ptp == handle2task(ptp->handle)); + erts_smp_atomic_set(ptp->handle, (long) NULL); + } +} + +static ERTS_INLINE void +set_handle(ErtsPortTask *ptp, ErtsPortTaskHandle *pthp) +{ + ptp->handle = pthp; + if (pthp) { + erts_smp_atomic_set(pthp, (long) ptp); + ASSERT(ptp == handle2task(ptp->handle)); + } +} + +/* + * Port queue operations + */ + +static ERTS_INLINE void +enqueue_port(ErtsRunQueue *runq, Port *pp) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + pp->sched.next = NULL; + pp->sched.prev = runq->ports.end; + if (runq->ports.end) { + ASSERT(runq->ports.start); + runq->ports.end->sched.next = pp; + } + else { + ASSERT(!runq->ports.start); + runq->ports.start = pp; + } + + runq->ports.info.len++; + if (runq->ports.info.max_len < runq->ports.info.len) + runq->ports.info.max_len = runq->ports.info.len; + runq->len++; + if (runq->max_len < runq->len) + runq->max_len = runq->len; + runq->ports.end = pp; + ASSERT(runq->ports.start && runq->ports.end); +} + +static ERTS_INLINE void +dequeue_port(ErtsRunQueue *runq, Port *pp) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + if (pp->sched.next) + pp->sched.next->sched.prev = pp->sched.prev; + else { + ASSERT(runq->ports.end == pp); + runq->ports.end = pp->sched.prev; + } + if (pp->sched.prev) + pp->sched.prev->sched.next = pp->sched.next; + else { + ASSERT(runq->ports.start == pp); + runq->ports.start = pp->sched.next; + } + + ASSERT(runq->ports.info.len > 0); + runq->ports.info.len--; + ASSERT(runq->len > 0); + runq->len--; + ASSERT(runq->ports.start || !runq->ports.end); + ASSERT(runq->ports.end || !runq->ports.start); +} + +static ERTS_INLINE Port * +pop_port(ErtsRunQueue *runq) +{ + Port *pp = runq->ports.start; + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + if (!pp) { + ASSERT(!runq->ports.end); + } + else { + runq->ports.start = runq->ports.start->sched.next; + if (runq->ports.start) + runq->ports.start->sched.prev = NULL; + else { + ASSERT(runq->ports.end == pp); + runq->ports.end = NULL; + } + ASSERT(runq->ports.info.len > 0); + runq->ports.info.len--; + ASSERT(runq->len > 0); + runq->len--; + } + + ASSERT(runq->ports.start || !runq->ports.end); + ASSERT(runq->ports.end || !runq->ports.start); + return pp; +} + + +#ifdef HARD_DEBUG + +static void +check_port_queue(ErtsRunQueue *runq, Port *chk_pp, int inq) +{ + Port *pp; + Port *last_pp; + Port *first_pp = runq->ports.start; + int no_forward = 0, no_backward = 0; + int found_forward = 0, found_backward = 0; + if (!first_pp) { + ASSERT(!runq->ports.end); + } + else { + ASSERT(!first_pp->sched.prev); + for (pp = first_pp; pp; pp = pp->sched.next) { + ASSERT(pp->sched.taskq); + if (pp->sched.taskq->first) + no_forward++; + if (chk_pp == pp) + found_forward = 1; + if (!pp->sched.prev) { + ASSERT(first_pp == pp); + } + if (!pp->sched.next) { + ASSERT(runq->ports.end == pp); + last_pp = pp; + } + } + for (pp = last_pp; pp; pp = pp->sched.prev) { + ASSERT(pp->sched.taskq); + if (pp->sched.taskq->last) + no_backward++; + if (chk_pp == pp) + found_backward = 1; + if (!pp->sched.prev) { + ASSERT(first_pp == pp); + } + if (!pp->sched.next) { + ASSERT(runq->ports.end == pp); + } + check_task_queue(pp->sched.taskq, NULL, 0); + } + ASSERT(no_forward == no_backward); + } + ASSERT(no_forward == runq->ports.info.len); + if (chk_pp) { + if (chk_pp->sched.taskq || chk_pp->sched.exe_taskq) { + ASSERT(chk_pp->sched.taskq != chk_pp->sched.exe_taskq); + } + ASSERT(!chk_pp->sched.taskq || chk_pp->sched.taskq->first); + if (inq < 0) + inq = chk_pp->sched.taskq && !chk_pp->sched.exe_taskq; + if (inq) { + ASSERT(found_forward && found_backward); + } + else { + ASSERT(!found_forward && !found_backward); + } + } +} + +#endif + +/* + * Task queue operations + */ + +static ERTS_INLINE ErtsPortTaskQueue * +port_taskq_init(ErtsPortTaskQueue *ptqp, Port *pp) +{ + if (ptqp) { + ptqp->first = NULL; + ptqp->last = NULL; + ptqp->port = pp; + } + return ptqp; +} + +static ERTS_INLINE void +enqueue_task(ErtsPortTaskQueue *ptqp, ErtsPortTask *ptp) +{ + ERTS_PT_CHK_NOT_IN_TASKQ(ptqp, ptp); + ptp->next = NULL; + ptp->prev = ptqp->last; + ptp->queue = ptqp; + if (ptqp->last) { + ASSERT(ptqp->first); + ptqp->last->next = ptp; + } + else { + ASSERT(!ptqp->first); + ptqp->first = ptp; + } + ptqp->last = ptp; + ERTS_PT_CHK_IN_TASKQ(ptqp, ptp); +} + +static ERTS_INLINE void +push_task(ErtsPortTaskQueue *ptqp, ErtsPortTask *ptp) +{ + ERTS_PT_CHK_NOT_IN_TASKQ(ptqp, ptp); + ptp->next = ptqp->first; + ptp->prev = NULL; + ptp->queue = ptqp; + if (ptqp->first) { + ASSERT(ptqp->last); + ptqp->first->prev = ptp; + } + else { + ASSERT(!ptqp->last); + ptqp->last = ptp; + } + ptqp->first = ptp; + ERTS_PT_CHK_IN_TASKQ(ptqp, ptp); +} + +static ERTS_INLINE void +dequeue_task(ErtsPortTask *ptp) +{ + ASSERT(ptp); + ASSERT(ptp->queue); + ERTS_PT_CHK_IN_TASKQ(ptp->queue, ptp); + if (ptp->next) + ptp->next->prev = ptp->prev; + else { + ASSERT(ptp->queue->last == ptp); + ptp->queue->last = ptp->prev; + } + if (ptp->prev) + ptp->prev->next = ptp->next; + else { + ASSERT(ptp->queue->first == ptp); + ptp->queue->first = ptp->next; + } + + ASSERT(ptp->queue->first || !ptp->queue->last); + ASSERT(ptp->queue->last || !ptp->queue->first); + ERTS_PT_CHK_NOT_IN_TASKQ(ptp->queue, ptp); +} + +static ERTS_INLINE ErtsPortTask * +pop_task(ErtsPortTaskQueue *ptqp) +{ + ErtsPortTask *ptp = ptqp->first; + if (!ptp) { + ASSERT(!ptqp->last); + } + else { + ERTS_PT_CHK_IN_TASKQ(ptqp, ptp); + ASSERT(!ptp->prev); + ptqp->first = ptp->next; + if (ptqp->first) + ptqp->first->prev = NULL; + else { + ASSERT(ptqp->last == ptp); + ptqp->last = NULL; + } + ASSERT(ptp->queue->first || !ptp->queue->last); + ASSERT(ptp->queue->last || !ptp->queue->first); + } + ERTS_PT_CHK_NOT_IN_TASKQ(ptqp, ptp); + return ptp; +} + +#ifdef HARD_DEBUG + +static void +check_task_queue(ErtsPortTaskQueue *ptqp, + ErtsPortTask *chk_ptp, + int inq) +{ + ErtsPortTask *ptp; + ErtsPortTask *last_ptp; + ErtsPortTask *first_ptp = ptqp->first; + int found_forward = 0, found_backward = 0; + if (!first_ptp) { + ASSERT(!ptqp->last); + } + else { + ASSERT(!first_ptp->prev); + for (ptp = first_ptp; ptp; ptp = ptp->next) { + ASSERT(ptp->queue == ptqp); + if (chk_ptp == ptp) + found_forward = 1; + if (!ptp->prev) { + ASSERT(first_ptp == ptp); + } + if (!ptp->next) { + ASSERT(ptqp->last == ptp); + last_ptp = ptp; + } + } + for (ptp = last_ptp; ptp; ptp = ptp->prev) { + ASSERT(ptp->queue == ptqp); + if (chk_ptp == ptp) + found_backward = 1; + if (!ptp->prev) { + ASSERT(first_ptp == ptp); + } + if (!ptp->next) { + ASSERT(ptqp->last == ptp); + } + } + } + if (chk_ptp) { + if (inq) { + ASSERT(found_forward && found_backward); + } + else { + ASSERT(!found_forward && !found_backward); + } + } +} +#endif + +/* + * Abort a scheduled task. + */ + +int +erts_port_task_abort(Eterm id, ErtsPortTaskHandle *pthp) +{ + ErtsRunQueue *runq; + ErtsPortTaskQueue *ptqp; + ErtsPortTask *ptp; + Port *pp; + int port_is_dequeued = 0; + + pp = &erts_port[internal_port_index(id)]; + runq = erts_port_runq(pp); + + ptp = handle2task(pthp); + + if (!ptp) { + erts_smp_runq_unlock(runq); + return 1; + } + + ASSERT(ptp->handle == pthp); + ptqp = ptp->queue; + ASSERT(pp == ptqp->port); + + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + ASSERT(ptqp); + ASSERT(ptqp->first); + + dequeue_task(ptp); + reset_handle(ptp); + + switch (ptp->type) { + case ERTS_PORT_TASK_INPUT: + case ERTS_PORT_TASK_OUTPUT: + case ERTS_PORT_TASK_EVENT: + ASSERT(erts_smp_atomic_read(&erts_port_task_outstanding_io_tasks) > 0); + erts_smp_atomic_dec(&erts_port_task_outstanding_io_tasks); + break; + default: + break; + } + + ASSERT(ptqp == pp->sched.taskq || ptqp == pp->sched.exe_taskq); + + if (ptqp->first || pp->sched.taskq != ptqp) + ptqp = NULL; + else { + pp->sched.taskq = NULL; + if (!pp->sched.exe_taskq) { + dequeue_port(runq, pp); + ERTS_PORT_NOT_IN_RUNQ(pp); + port_is_dequeued = 1; + } + } + + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + + erts_smp_runq_unlock(runq); + + if (erts_system_profile_flags.runnable_ports && port_is_dequeued) { + profile_runnable_port(pp, am_inactive); + } + + port_task_free(ptp); + if (ptqp) + port_taskq_free(ptqp); + + return 0; +} + +/* + * Schedule a task. + */ + +int +erts_port_task_schedule(Eterm id, + ErtsPortTaskHandle *pthp, + ErtsPortTaskType type, + ErlDrvEvent event, + ErlDrvEventData event_data) +{ + ErtsRunQueue *runq; + Port *pp; + ErtsPortTask *ptp; + int enq_port = 0; + + /* + * NOTE: We might not have the port lock here. We are only + * allowed to access the 'sched', 'tab_status', + * and 'id' fields of the port struct while + * tasks_lock is held. + */ + + if (pthp && erts_port_task_is_scheduled(pthp)) { + ASSERT(0); + erts_port_task_abort(id, pthp); + } + + ptp = port_task_alloc(); + + ASSERT(is_internal_port(id)); + pp = &erts_port[internal_port_index(id)]; + runq = erts_port_runq(pp); + + if (!runq || ERTS_PORT_TASK_INVALID_PORT(pp, id)) { + if (runq) + erts_smp_runq_unlock(runq); + return -1; + } + + ASSERT(!erts_port_task_is_scheduled(pthp)); + + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + + if (!pp->sched.taskq) { + pp->sched.taskq = port_taskq_init(port_taskq_alloc(), pp); + enq_port = !pp->sched.exe_taskq; + } + +#ifdef ERTS_SMP + if (enq_port) { + ErtsRunQueue *xrunq = erts_check_emigration_need(runq, ERTS_PORT_PRIO_LEVEL); + if (xrunq) { + /* Port emigrated ... */ + erts_smp_atomic_set(&pp->run_queue, (long) xrunq); + erts_smp_runq_unlock(runq); + runq = xrunq; + } + } +#endif + + ASSERT(!(runq->flags & ERTS_RUNQ_FLG_SUSPENDED)); + + ASSERT(pp->sched.taskq); + ASSERT(ptp); + + ptp->type = type; + ptp->event = event; + ptp->event_data = event_data; + + set_handle(ptp, pthp); + + switch (type) { + case ERTS_PORT_TASK_FREE: + erl_exit(ERTS_ABORT_EXIT, + "erts_port_task_schedule(): Cannot schedule free task\n"); + break; + case ERTS_PORT_TASK_INPUT: + case ERTS_PORT_TASK_OUTPUT: + case ERTS_PORT_TASK_EVENT: + erts_smp_atomic_inc(&erts_port_task_outstanding_io_tasks); + /* Fall through... */ + default: + enqueue_task(pp->sched.taskq, ptp); + break; + } + +#if defined(HARD_DEBUG) + if (pp->sched.exe_taskq || enq_port) + ERTS_PT_CHK_NOT_IN_PORTQ(runq, pp); + else + ERTS_PT_CHK_IN_PORTQ(runq, pp); +#elif defined(DEBUG) + if (!enq_port && !pp->sched.exe_taskq) { + /* We should be in port run q */ + ASSERT(pp->sched.prev || runq->ports.start == pp); + } +#endif + + if (!enq_port) { + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + } + else { + enqueue_port(runq, pp); + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + + if (erts_system_profile_flags.runnable_ports) { + profile_runnable_port(pp, am_active); + } + + erts_smp_notify_inc_runq(runq); + } + erts_smp_runq_unlock(runq); + return 0; +} + +void +erts_port_task_free_port(Port *pp) +{ + ErtsRunQueue *runq; + int port_is_dequeued = 0; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + ASSERT(!(pp->status & ERTS_PORT_SFLGS_DEAD)); + runq = erts_port_runq(pp); + ASSERT(runq); + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + if (pp->sched.exe_taskq) { + /* I (this thread) am currently executing this port, free it + when scheduled out... */ + ErtsPortTask *ptp = port_task_alloc(); + erts_smp_port_state_lock(pp); + ASSERT(erts_smp_atomic_read(&erts_ports_alive) > 0); + erts_smp_atomic_dec(&erts_ports_alive); + pp->status &= ~ERTS_PORT_SFLG_CLOSING; + pp->status |= ERTS_PORT_SFLG_FREE_SCHEDULED; + erts_may_save_closed_port(pp); + erts_smp_port_state_unlock(pp); + ERTS_SMP_LC_ASSERT(erts_smp_atomic_read(&pp->refc) > 1); + ptp->type = ERTS_PORT_TASK_FREE; + ptp->event = (ErlDrvEvent) -1; + ptp->event_data = NULL; + set_handle(ptp, NULL); + push_task(pp->sched.exe_taskq, ptp); + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + erts_smp_runq_unlock(runq); + } + else { + ErtsPortTaskQueue *ptqp = pp->sched.taskq; + if (ptqp) { + dequeue_port(runq, pp); + ERTS_PORT_NOT_IN_RUNQ(pp); + port_is_dequeued = 1; + } + erts_smp_port_state_lock(pp); + erts_smp_atomic_dec(&erts_ports_alive); + pp->status &= ~ERTS_PORT_SFLG_CLOSING; + pp->status |= ERTS_PORT_SFLG_FREE_SCHEDULED; + erts_may_save_closed_port(pp); + erts_smp_port_state_unlock(pp); +#ifdef ERTS_SMP + erts_smp_atomic_dec(&pp->refc); /* Not alive */ +#endif + ERTS_SMP_LC_ASSERT(erts_smp_atomic_read(&pp->refc) > 0); /* Lock */ + handle_remaining_tasks(runq, pp); /* May release runq lock */ + ASSERT(!pp->sched.exe_taskq && (!ptqp || !ptqp->first)); + pp->sched.taskq = NULL; + ERTS_PT_CHK_PRES_PORTQ(runq, pp); +#ifndef ERTS_SMP + ASSERT(pp->status & ERTS_PORT_SFLG_PORT_DEBUG); + erts_port_status_set(pp, ERTS_PORT_SFLG_FREE); +#endif + erts_smp_runq_unlock(runq); + + if (erts_system_profile_flags.runnable_ports && port_is_dequeued) { + profile_runnable_port(pp, am_inactive); + } + + if (ptqp) + port_taskq_free(ptqp); + } +} + +typedef struct { + ErtsRunQueue *runq; + int *resp; +} ErtsPortTaskExeBlockData; + +static void +prepare_for_block(void *vd) +{ + ErtsPortTaskExeBlockData *d = (ErtsPortTaskExeBlockData *) vd; + erts_smp_runq_unlock(d->runq); +} + +static void +resume_after_block(void *vd) +{ + ErtsPortTaskExeBlockData *d = (ErtsPortTaskExeBlockData *) vd; + erts_smp_runq_lock(d->runq); + if (d->resp) + *d->resp = erts_smp_atomic_read(&erts_port_task_outstanding_io_tasks) != (long) 0; +} + +/* + * Run all scheduled tasks for the first port in run queue. If + * new tasks appear while running reschedule port (free task is + * an exception; it is always handled instantly). + * + * erts_port_task_execute() is called by scheduler threads between + * scheduleing of processes. Sched lock should be held by caller. + */ + +int +erts_port_task_execute(ErtsRunQueue *runq, Port **curr_port_pp) +{ + int port_was_enqueued = 0; + Port *pp; + ErtsPortTaskQueue *ptqp; + ErtsPortTask *ptp; + int res = 0; + int reds = ERTS_PORT_REDS_EXECUTE; + long io_tasks_executed = 0; + int fpe_was_unmasked; + ErtsPortTaskExeBlockData blk_data = {runq, NULL}; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + + erts_smp_activity_begin(ERTS_ACTIVITY_IO, + prepare_for_block, + resume_after_block, + (void *) &blk_data); + + ERTS_PT_CHK_PORTQ(runq); + + pp = pop_port(runq); + if (!pp) { + res = 0; + goto done; + } + + ERTS_PORT_NOT_IN_RUNQ(pp); + + *curr_port_pp = pp; + + ASSERT(pp->sched.taskq); + ASSERT(pp->sched.taskq->first); + ptqp = pp->sched.taskq; + pp->sched.taskq = NULL; + + ASSERT(!pp->sched.exe_taskq); + pp->sched.exe_taskq = ptqp; + + if (erts_smp_port_trylock(pp) == EBUSY) { + erts_smp_runq_unlock(runq); + erts_smp_port_lock(pp); + erts_smp_runq_lock(runq); + } + + if (erts_sched_stat.enabled) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + Uint old = ERTS_PORT_SCHED_ID(pp, esdp->no); + int migrated = old && old != esdp->no; + + erts_smp_spin_lock(&erts_sched_stat.lock); + erts_sched_stat.prio[ERTS_PORT_PRIO_LEVEL].total_executed++; + erts_sched_stat.prio[ERTS_PORT_PRIO_LEVEL].executed++; + if (migrated) { + erts_sched_stat.prio[ERTS_PORT_PRIO_LEVEL].total_migrated++; + erts_sched_stat.prio[ERTS_PORT_PRIO_LEVEL].migrated++; + } + erts_smp_spin_unlock(&erts_sched_stat.lock); + } + + /* trace port scheduling, in */ + if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) { + trace_sched_ports(pp, am_in); + } + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + ptp = pop_task(ptqp); + + fpe_was_unmasked = erts_block_fpe(); + + while (ptp) { + ASSERT(pp->sched.taskq != pp->sched.exe_taskq); + + reset_handle(ptp); + erts_smp_runq_unlock(runq); + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + ERTS_SMP_CHK_NO_PROC_LOCKS; + ASSERT(pp->drv_ptr); + + switch (ptp->type) { + case ERTS_PORT_TASK_FREE: /* May be pushed in q at any time */ + reds += ERTS_PORT_REDS_FREE; + erts_smp_runq_lock(runq); + + erts_unblock_fpe(fpe_was_unmasked); + ASSERT(pp->status & ERTS_PORT_SFLG_FREE_SCHEDULED); + if (ptqp->first || (pp->sched.taskq && pp->sched.taskq->first)) + handle_remaining_tasks(runq, pp); + ASSERT(!ptqp->first + && (!pp->sched.taskq || !pp->sched.taskq->first)); +#ifdef ERTS_SMP + erts_smp_atomic_dec(&pp->refc); /* Not alive */ + ERTS_SMP_LC_ASSERT(erts_smp_atomic_read(&pp->refc) > 0); /* Lock */ +#else + erts_port_status_bor_set(pp, ERTS_PORT_SFLG_FREE); +#endif + + port_task_free(ptp); + if (pp->sched.taskq) + port_taskq_free(pp->sched.taskq); + pp->sched.taskq = NULL; + + goto tasks_done; + case ERTS_PORT_TASK_TIMEOUT: + reds += ERTS_PORT_REDS_TIMEOUT; + if (!(pp->status & ERTS_PORT_SFLGS_DEAD)) + (*pp->drv_ptr->timeout)((ErlDrvData) pp->drv_data); + break; + case ERTS_PORT_TASK_INPUT: + reds += ERTS_PORT_REDS_INPUT; + ASSERT((pp->status & ERTS_PORT_SFLGS_DEAD) == 0); + /* NOTE some windows drivers use ->ready_input for input and output */ + (*pp->drv_ptr->ready_input)((ErlDrvData) pp->drv_data, ptp->event); + io_tasks_executed++; + break; + case ERTS_PORT_TASK_OUTPUT: + reds += ERTS_PORT_REDS_OUTPUT; + ASSERT((pp->status & ERTS_PORT_SFLGS_DEAD) == 0); + (*pp->drv_ptr->ready_output)((ErlDrvData) pp->drv_data, ptp->event); + io_tasks_executed++; + break; + case ERTS_PORT_TASK_EVENT: + reds += ERTS_PORT_REDS_EVENT; + ASSERT((pp->status & ERTS_PORT_SFLGS_DEAD) == 0); + (*pp->drv_ptr->event)((ErlDrvData) pp->drv_data, ptp->event, ptp->event_data); + io_tasks_executed++; + break; + case ERTS_PORT_TASK_DIST_CMD: + reds += erts_dist_command(pp, CONTEXT_REDS-reds); + break; + default: + erl_exit(ERTS_ABORT_EXIT, + "Invalid port task type: %d\n", + (int) ptp->type); + break; + } + + if ((pp->status & ERTS_PORT_SFLG_CLOSING) + && erts_is_port_ioq_empty(pp)) { + reds += ERTS_PORT_REDS_TERMINATE; + erts_terminate_port(pp); + } + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + +#ifdef ERTS_SMP + if (pp->xports) + erts_smp_xports_unlock(pp); + ASSERT(!pp->xports); +#endif + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + + port_task_free(ptp); + + erts_smp_runq_lock(runq); + + ptp = pop_task(ptqp); + } + + tasks_done: + + erts_unblock_fpe(fpe_was_unmasked); + + if (io_tasks_executed) { + ASSERT(erts_smp_atomic_read(&erts_port_task_outstanding_io_tasks) >= io_tasks_executed); + erts_smp_atomic_add(&erts_port_task_outstanding_io_tasks, -1*io_tasks_executed); + } + + *curr_port_pp = NULL; + + if (pp->sched.taskq) { + ASSERT(!(pp->status & ERTS_PORT_SFLGS_DEAD)); + ASSERT(pp->sched.taskq->first); + enqueue_port(runq, pp); + port_was_enqueued = 1; + + /* + erts_smp_notify_inc_runq(); + + * No need to notify schedulers about the increase in run + * queue length since at least this thread, which is a + * scheduler, will discover that the port run queue isn't + * empty before trying to go to sleep. + */ + } + + ASSERT(pp->sched.exe_taskq); + pp->sched.exe_taskq = NULL; + + res = erts_smp_atomic_read(&erts_port_task_outstanding_io_tasks) != (long) 0; + + ERTS_PT_CHK_PRES_PORTQ(runq, pp); + + port_taskq_free(ptqp); + + if (erts_system_profile_flags.runnable_ports && (port_was_enqueued != 1)) { + profile_runnable_port(pp, am_inactive); + } + + /* trace port scheduling, out */ + if (IS_TRACED_FL(pp, F_TRACE_SCHED_PORTS)) { + trace_sched_ports(pp, am_out); + } +#ifndef ERTS_SMP + erts_port_release(pp); +#else + { + long refc = erts_smp_atomic_dectest(&pp->refc); + ASSERT(refc >= 0); + if (refc > 0) + erts_smp_mtx_unlock(pp->lock); + else { + erts_smp_runq_unlock(runq); + erts_port_cleanup(pp); /* Might aquire runq lock */ + erts_smp_runq_lock(runq); + res = erts_smp_atomic_read(&erts_port_task_outstanding_io_tasks) != (long) 0; + } + } +#endif + + done: + blk_data.resp = &res; + erts_smp_activity_end(ERTS_ACTIVITY_IO, + prepare_for_block, + resume_after_block, + (void *) &blk_data); + + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + + ERTS_PORT_REDUCTIONS_EXECUTED(runq, reds); + + return res; +} + +/* + * Handle remaining tasks after a free task. + */ + +static void +handle_remaining_tasks(ErtsRunQueue *runq, Port *pp) +{ + int i; + ErtsPortTask *ptp; + ErtsPortTaskQueue *ptqps[] = {pp->sched.exe_taskq, pp->sched.taskq}; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + + for (i = 0; i < sizeof(ptqps)/sizeof(ErtsPortTaskQueue *); i++) { + if (!ptqps[i]) + continue; + + ptp = pop_task(ptqps[i]); + while (ptp) { + reset_handle(ptp); + erts_smp_runq_unlock(runq); + + switch (ptp->type) { + case ERTS_PORT_TASK_FREE: + case ERTS_PORT_TASK_TIMEOUT: + break; + case ERTS_PORT_TASK_INPUT: + erts_stale_drv_select(pp->id, ptp->event, DO_READ, 1); + break; + case ERTS_PORT_TASK_OUTPUT: + erts_stale_drv_select(pp->id, ptp->event, DO_WRITE, 1); + break; + case ERTS_PORT_TASK_EVENT: + erts_stale_drv_select(pp->id, ptp->event, 0, 1); + break; + case ERTS_PORT_TASK_DIST_CMD: + break; + default: + erl_exit(ERTS_ABORT_EXIT, + "Invalid port task type: %d\n", + (int) ptp->type); + } + + port_task_free(ptp); + + erts_smp_runq_lock(runq); + ptp = pop_task(ptqps[i]); + } + } + + ASSERT(!pp->sched.taskq || !pp->sched.taskq->first); +} + +int +erts_port_is_scheduled(Port *pp) +{ + int res; + ErtsRunQueue *runq = erts_port_runq(pp); + res = pp->sched.taskq || pp->sched.exe_taskq; + erts_smp_runq_unlock(runq); + return res; +} + +#ifdef ERTS_SMP + +ErtsMigrateResult +erts_port_migrate(Port *prt, int *prt_locked, + ErtsRunQueue *from_rq, int *from_locked, + ErtsRunQueue *to_rq, int *to_locked) +{ + ERTS_SMP_LC_ASSERT(*from_locked); + ERTS_SMP_LC_CHK_RUNQ_LOCK(from_rq, *from_locked); + ERTS_SMP_LC_CHK_RUNQ_LOCK(to_rq, *to_locked); + + ASSERT(!erts_common_run_queue); + + if (!*from_locked || !*to_locked) { + if (from_rq < to_rq) { + if (!*to_locked) { + if (!*from_locked) + erts_smp_runq_lock(from_rq); + erts_smp_runq_lock(to_rq); + } + else if (erts_smp_runq_trylock(from_rq) == EBUSY) { + erts_smp_runq_unlock(to_rq); + erts_smp_runq_lock(from_rq); + erts_smp_runq_lock(to_rq); + } + } + else { + if (!*from_locked) { + if (!*to_locked) + erts_smp_runq_lock(to_rq); + erts_smp_runq_lock(from_rq); + } + else if (erts_smp_runq_trylock(to_rq) == EBUSY) { + erts_smp_runq_unlock(from_rq); + erts_smp_runq_lock(to_rq); + erts_smp_runq_lock(from_rq); + } + } + *to_locked = *from_locked = 1; + } + ERTS_SMP_LC_CHK_RUNQ_LOCK(from_rq, *from_locked); + ERTS_SMP_LC_CHK_RUNQ_LOCK(to_rq, *to_locked); + + /* Refuse to migrate to a suspended run queue */ + if (to_rq->flags & ERTS_RUNQ_FLG_SUSPENDED) + return ERTS_MIGRATE_FAILED_RUNQ_SUSPENDED; + if (from_rq != (ErtsRunQueue *) erts_smp_atomic_read(&prt->run_queue)) + return ERTS_MIGRATE_FAILED_RUNQ_CHANGED; + if (!ERTS_PORT_IS_IN_RUNQ(from_rq, prt)) + return ERTS_MIGRATE_FAILED_NOT_IN_RUNQ; + dequeue_port(from_rq, prt); + erts_smp_atomic_set(&prt->run_queue, (long) to_rq); + enqueue_port(to_rq, prt); + erts_smp_notify_inc_runq(to_rq); + return ERTS_MIGRATE_SUCCESS; +} + +#endif + +/* + * Initialize the module. + */ +void +erts_port_task_init(void) +{ + erts_smp_atomic_init(&erts_port_task_outstanding_io_tasks, (long) 0); + init_port_task_alloc(); + init_port_taskq_alloc(); +} diff --git a/erts/emulator/beam/erl_port_task.h b/erts/emulator/beam/erl_port_task.h new file mode 100644 index 0000000000..f12d02da0c --- /dev/null +++ b/erts/emulator/beam/erl_port_task.h @@ -0,0 +1,135 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Scheduling of port tasks + * + * Author: Rickard Green + */ + +#ifndef ERTS_PORT_TASK_H_BASIC_TYPES__ +#define ERTS_PORT_TASK_H_BASIC_TYPES__ +#include "erl_sys_driver.h" +#include "erl_smp.h" +typedef erts_smp_atomic_t ErtsPortTaskHandle; +#endif + +#ifndef ERTS_PORT_TASK_ONLY_BASIC_TYPES__ +#ifndef ERL_PORT_TASK_H__ +#define ERL_PORT_TASK_H__ + +#undef ERTS_INCLUDE_SCHEDULER_INTERNALS +#if (defined(ERL_PROCESS_C__) \ + || defined(ERL_PORT_TASK_C__) \ + || defined(ERL_IO_C__) \ + || (ERTS_GLB_INLINE_INCL_FUNC_DEF \ + && defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF))) +#define ERTS_INCLUDE_SCHEDULER_INTERNALS +#endif + +typedef enum { + ERTS_PORT_TASK_FREE, + ERTS_PORT_TASK_INPUT, + ERTS_PORT_TASK_OUTPUT, + ERTS_PORT_TASK_EVENT, + ERTS_PORT_TASK_TIMEOUT, + ERTS_PORT_TASK_DIST_CMD +} ErtsPortTaskType; + +#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS +/* NOTE: Do not access any of the exported variables directly */ +extern erts_smp_atomic_t erts_port_task_outstanding_io_tasks; +#endif + +typedef struct ErtsPortTask_ ErtsPortTask; +typedef struct ErtsPortTaskQueue_ ErtsPortTaskQueue; + +typedef struct { + Port *next; + Port *prev; + ErtsPortTaskQueue *taskq; + ErtsPortTaskQueue *exe_taskq; +} ErtsPortTaskSched; + +ERTS_GLB_INLINE void erts_port_task_handle_init(ErtsPortTaskHandle *pthp); +ERTS_GLB_INLINE int erts_port_task_is_scheduled(ErtsPortTaskHandle *pthp); +ERTS_GLB_INLINE void erts_port_task_init_sched(ErtsPortTaskSched *ptsp); +#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS +ERTS_GLB_INLINE int erts_port_task_have_outstanding_io_tasks(void); +#endif + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_port_task_handle_init(ErtsPortTaskHandle *pthp) +{ + erts_smp_atomic_init(pthp, (long) NULL); +} + +ERTS_GLB_INLINE int +erts_port_task_is_scheduled(ErtsPortTaskHandle *pthp) +{ + return ((void *) erts_smp_atomic_read(pthp)) != NULL; +} + +ERTS_GLB_INLINE void +erts_port_task_init_sched(ErtsPortTaskSched *ptsp) +{ + ptsp->next = NULL; + ptsp->prev = NULL; + ptsp->taskq = NULL; + ptsp->exe_taskq = NULL; +} + +#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS + +ERTS_GLB_INLINE int +erts_port_task_have_outstanding_io_tasks(void) +{ + return erts_smp_atomic_read(&erts_port_task_outstanding_io_tasks) != 0; +} + +#endif /* ERTS_INCLUDE_SCHEDULER_INTERNALS */ + +#endif + +#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS +int erts_port_task_execute(ErtsRunQueue *, Port **); +void erts_port_task_init(void); +#endif + +int erts_port_task_abort(Eterm id, ErtsPortTaskHandle *); +int erts_port_task_schedule(Eterm, + ErtsPortTaskHandle *, + ErtsPortTaskType, + ErlDrvEvent, + ErlDrvEventData); +void erts_port_task_free_port(Port *); +int erts_port_is_scheduled(Port *); +#ifdef ERTS_SMP +ErtsMigrateResult erts_port_migrate(Port *, + int *, + ErtsRunQueue *, + int *, + ErtsRunQueue *, + int *); +#endif +#undef ERTS_INCLUDE_SCHEDULER_INTERNALS +#endif /* ERL_PORT_TASK_H__ */ +#endif /* ERTS_PORT_TASK_ONLY_BASIC_TYPES__ */ diff --git a/erts/emulator/beam/erl_posix_str.c b/erts/emulator/beam/erl_posix_str.c new file mode 100644 index 0000000000..02db10905b --- /dev/null +++ b/erts/emulator/beam/erl_posix_str.c @@ -0,0 +1,641 @@ +/* + * Original: tclPosixStr.c -- + * + * This file contains procedures that generate strings + * corresponding to various POSIX-related codes, such + * as errno and signals. + * + * Copyright (c) 1991-1994 The Regents of the University of California. + * Copyright (c) 1994-1996 Sun Microsystems, Inc. + * + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * + * SCCS: @(#) tclPosixStr.c 1.32 96/10/10 10:09:42 + */ + +/* %ExternalCopyright% */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef __WIN32__ +#ifndef WINDOWS_H_INCLUDES_WINSOCK2_H +#include +#endif +#include +#endif + +#include "erl_errno.h" +#include "sys.h" +#include "erl_driver.h" + +/* + *---------------------------------------------------------------------- + * + * erl_errno_id -- + * + * Return a textual identifier for the given errno value. + * + * Results: + * This procedure returns a machine-readable textual identifier + * that corresponds to the current errno value (e.g. "eperm"). + * The identifier is the same as the #define name in errno.h, + * except that it is in lowercase. + * + *---------------------------------------------------------------------- + */ + +char * +erl_errno_id(error) + int error; /* Posix error number (as from errno). */ +{ + switch (error) { +#ifdef E2BIG + case E2BIG: return "e2big"; +#endif +#ifdef EACCES + case EACCES: return "eacces"; +#endif +#ifdef EADDRINUSE + case EADDRINUSE: return "eaddrinuse"; +#endif +#ifdef EADDRNOTAVAIL + case EADDRNOTAVAIL: return "eaddrnotavail"; +#endif +#ifdef EADV + case EADV: return "eadv"; +#endif +#ifdef EAFNOSUPPORT + case EAFNOSUPPORT: return "eafnosupport"; +#endif +#ifdef EAGAIN + case EAGAIN: return "eagain"; +#endif +#ifdef EALIGN + case EALIGN: return "ealign"; +#endif +#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY )) + case EALREADY: return "ealready"; +#endif +#ifdef EBADE + case EBADE: return "ebade"; +#endif +#ifdef EBADF + case EBADF: return "ebadf"; +#endif +#ifdef EBADFD + case EBADFD: return "ebadfd"; +#endif +#ifdef EBADMSG + case EBADMSG: return "ebadmsg"; +#endif +#ifdef EBADR + case EBADR: return "ebadr"; +#endif +#ifdef EBADRPC + case EBADRPC: return "ebadrpc"; +#endif +#ifdef EBADRQC + case EBADRQC: return "ebadrqc"; +#endif +#ifdef EBADSLT + case EBADSLT: return "ebadslt"; +#endif +#ifdef EBFONT + case EBFONT: return "ebfont"; +#endif +#ifdef EBUSY + case EBUSY: return "ebusy"; +#endif +#ifdef ECHILD + case ECHILD: return "echild"; +#endif +#ifdef ECHRNG + case ECHRNG: return "echrng"; +#endif +#ifdef ECOMM + case ECOMM: return "ecomm"; +#endif +#ifdef ECONNABORTED + case ECONNABORTED: return "econnaborted"; +#endif +#ifdef ECONNREFUSED + case ECONNREFUSED: return "econnrefused"; +#endif +#ifdef ECONNRESET + case ECONNRESET: return "econnreset"; +#endif +#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK)) + case EDEADLK: return "edeadlk"; +#endif +#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK)) + case EDEADLOCK: return "edeadlock"; +#endif +#ifdef EDESTADDRREQ + case EDESTADDRREQ: return "edestaddrreq"; +#endif +#ifdef EDIRTY + case EDIRTY: return "edirty"; +#endif +#ifdef EDOM + case EDOM: return "edom"; +#endif +#ifdef EDOTDOT + case EDOTDOT: return "edotdot"; +#endif +#ifdef EDQUOT + case EDQUOT: return "edquot"; +#endif +#ifdef EDUPPKG + case EDUPPKG: return "eduppkg"; +#endif +#ifdef EEXIST + case EEXIST: return "eexist"; +#endif +#ifdef EFAULT + case EFAULT: return "efault"; +#endif +#ifdef EFBIG + case EFBIG: return "efbig"; +#endif +#ifdef EHOSTDOWN + case EHOSTDOWN: return "ehostdown"; +#endif +#ifdef EHOSTUNREACH + case EHOSTUNREACH: return "ehostunreach"; +#endif +#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS)) + case EIDRM: return "eidrm"; +#endif +#ifdef EINIT + case EINIT: return "einit"; +#endif +#ifdef EINPROGRESS + case EINPROGRESS: return "einprogress"; +#endif +#ifdef EINTR + case EINTR: return "eintr"; +#endif +#ifdef EINVAL + case EINVAL: return "einval"; +#endif +#ifdef EIO + case EIO: return "eio"; +#endif +#ifdef EISCONN + case EISCONN: return "eisconn"; +#endif +#ifdef EISDIR + case EISDIR: return "eisdir"; +#endif +#ifdef EISNAME + case EISNAM: return "eisnam"; +#endif +#ifdef ELBIN + case ELBIN: return "elbin"; +#endif +#ifdef EL2HLT + case EL2HLT: return "el2hlt"; +#endif +#ifdef EL2NSYNC + case EL2NSYNC: return "el2nsync"; +#endif +#ifdef EL3HLT + case EL3HLT: return "el3hlt"; +#endif +#ifdef EL3RST + case EL3RST: return "el3rst"; +#endif +#ifdef ELIBACC + case ELIBACC: return "elibacc"; +#endif +#ifdef ELIBBAD + case ELIBBAD: return "elibbad"; +#endif +#ifdef ELIBEXEC + case ELIBEXEC: return "elibexec"; +#endif +#ifdef ELIBMAX + case ELIBMAX: return "elibmax"; +#endif +#ifdef ELIBSCN + case ELIBSCN: return "elibscn"; +#endif +#ifdef ELNRNG + case ELNRNG: return "elnrng"; +#endif +#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT)) + case ELOOP: return "eloop"; +#endif +#ifdef EMFILE + case EMFILE: return "emfile"; +#endif +#ifdef EMLINK + case EMLINK: return "emlink"; +#endif +#ifdef EMSGSIZE + case EMSGSIZE: return "emsgsize"; +#endif +#ifdef EMULTIHOP + case EMULTIHOP: return "emultihop"; +#endif +#ifdef ENAMETOOLONG + case ENAMETOOLONG: return "enametoolong"; +#endif +#ifdef ENAVAIL + case ENAVAIL: return "enavail"; +#endif +#ifdef ENET + case ENET: return "enet"; +#endif +#ifdef ENETDOWN + case ENETDOWN: return "enetdown"; +#endif +#ifdef ENETRESET + case ENETRESET: return "enetreset"; +#endif +#ifdef ENETUNREACH + case ENETUNREACH: return "enetunreach"; +#endif +#ifdef ENFILE + case ENFILE: return "enfile"; +#endif +#ifdef ENOANO + case ENOANO: return "enoano"; +#endif +#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR)) + case ENOBUFS: return "enobufs"; +#endif +#ifdef ENOCSI + case ENOCSI: return "enocsi"; +#endif +#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED)) + case ENODATA: return "enodata"; +#endif +#ifdef ENODEV + case ENODEV: return "enodev"; +#endif +#ifdef ENOENT + case ENOENT: return "enoent"; +#endif +#ifdef ENOEXEC + case ENOEXEC: return "enoexec"; +#endif +#ifdef ENOLCK + case ENOLCK: return "enolck"; +#endif +#ifdef ENOLINK + case ENOLINK: return "enolink"; +#endif +#ifdef ENOMEM + case ENOMEM: return "enomem"; +#endif +#ifdef ENOMSG + case ENOMSG: return "enomsg"; +#endif +#ifdef ENONET + case ENONET: return "enonet"; +#endif +#ifdef ENOPKG + case ENOPKG: return "enopkg"; +#endif +#ifdef ENOPROTOOPT + case ENOPROTOOPT: return "enoprotoopt"; +#endif +#ifdef ENOSPC + case ENOSPC: return "enospc"; +#endif +#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR)) + case ENOSR: return "enosr"; +#endif +#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR)) + case ENOSTR: return "enostr"; +#endif +#ifdef ENOSYM + case ENOSYM: return "enosym"; +#endif +#ifdef ENOSYS + case ENOSYS: return "enosys"; +#endif +#ifdef ENOTBLK + case ENOTBLK: return "enotblk"; +#endif +#ifdef ENOTCONN + case ENOTCONN: return "enotconn"; +#endif +#ifdef ENOTDIR + case ENOTDIR: return "enotdir"; +#endif +#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST)) + case ENOTEMPTY: return "enotempty"; +#endif +#ifdef ENOTNAM + case ENOTNAM: return "enotnam"; +#endif +#ifdef ENOTSOCK + case ENOTSOCK: return "enotsock"; +#endif +#ifdef ENOTSUP + case ENOTSUP: return "enotsup"; +#endif +#ifdef ENOTTY + case ENOTTY: return "enotty"; +#endif +#ifdef ENOTUNIQ + case ENOTUNIQ: return "enotuniq"; +#endif +#ifdef ENXIO + case ENXIO: return "enxio"; +#endif +#if defined(EOPNOTSUPP) && (!defined(ENOTSUP) || (EOPNOTSUPP != ENOTSUP)) + case EOPNOTSUPP: return "eopnotsupp"; +#endif +#ifdef EPERM + case EPERM: return "eperm"; +#endif +#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT)) + case EPFNOSUPPORT: return "epfnosupport"; +#endif +#ifdef EPIPE + case EPIPE: return "epipe"; +#endif +#ifdef EPROCLIM + case EPROCLIM: return "eproclim"; +#endif +#ifdef EPROCUNAVAIL + case EPROCUNAVAIL: return "eprocunavail"; +#endif +#ifdef EPROGMISMATCH + case EPROGMISMATCH: return "eprogmismatch"; +#endif +#ifdef EPROGUNAVAIL + case EPROGUNAVAIL: return "eprogunavail"; +#endif +#ifdef EPROTO + case EPROTO: return "eproto"; +#endif +#ifdef EPROTONOSUPPORT + case EPROTONOSUPPORT: return "eprotonosupport"; +#endif +#ifdef EPROTOTYPE + case EPROTOTYPE: return "eprototype"; +#endif +#ifdef ERANGE + case ERANGE: return "erange"; +#endif +#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED)) + case EREFUSED: return "erefused"; +#endif +#ifdef EREMCHG + case EREMCHG: return "eremchg"; +#endif +#ifdef EREMDEV + case EREMDEV: return "eremdev"; +#endif +#ifdef EREMOTE + case EREMOTE: return "eremote"; +#endif +#ifdef EREMOTEIO + case EREMOTEIO: return "eremoteio"; +#endif +#ifdef EREMOTERELEASE + case EREMOTERELEASE: return "eremoterelease"; +#endif +#ifdef EROFS + case EROFS: return "erofs"; +#endif +#ifdef ERPCMISMATCH + case ERPCMISMATCH: return "erpcmismatch"; +#endif +#ifdef ERREMOTE + case ERREMOTE: return "erremote"; +#endif +#ifdef ESHUTDOWN + case ESHUTDOWN: return "eshutdown"; +#endif +#ifdef ESOCKTNOSUPPORT + case ESOCKTNOSUPPORT: return "esocktnosupport"; +#endif +#ifdef ESPIPE + case ESPIPE: return "espipe"; +#endif +#ifdef ESRCH + case ESRCH: return "esrch"; +#endif +#ifdef ESRMNT + case ESRMNT: return "esrmnt"; +#endif +#ifdef ESTALE + case ESTALE: return "estale"; +#endif +#ifdef ESUCCESS + case ESUCCESS: return "esuccess"; +#endif +#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP)) + case ETIME: return "etime"; +#endif +#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR)) && (!defined(EAGAIN) || (ETIMEDOUT != EAGAIN)) && (!defined(WSAETIMEDOUT) || (ETIMEDOUT != WSAETIMEDOUT)) + case ETIMEDOUT: return "etimedout"; +#endif +#ifdef ETOOMANYREFS + case ETOOMANYREFS: return "etoomanyrefs"; +#endif +#ifdef ETXTBSY + case ETXTBSY: return "etxtbsy"; +#endif +#ifdef EUCLEAN + case EUCLEAN: return "euclean"; +#endif +#ifdef EUNATCH + case EUNATCH: return "eunatch"; +#endif +#ifdef EUSERS + case EUSERS: return "eusers"; +#endif +#ifdef EVERSION + case EVERSION: return "eversion"; +#endif +#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN)) && (!defined(WSAEWOULDBLOCK) || (EWOULDBLOCK != WSAEWOULDBLOCK)) + case EWOULDBLOCK: return "ewouldblock"; +#endif +#ifdef EXDEV + case EXDEV: return "exdev"; +#endif +#ifdef EXFULL + case EXFULL: return "exfull"; +#endif +#ifdef WSAEINTR + case WSAEINTR: return "eintr"; +#endif +#ifdef WSAEBADF + case WSAEBADF: return "ebadf"; +#endif +#ifdef WSAEACCES + case WSAEACCES: return "eacces"; +#endif +#ifdef WSAEFAULT + case WSAEFAULT: return "efault"; +#endif +#ifdef WSAEINVAL + case WSAEINVAL: return "einval"; +#endif +#ifdef WSAEMFILE + case WSAEMFILE: return "emfile"; +#endif +#ifdef WSAEWOULDBLOCK + case WSAEWOULDBLOCK: return "ewouldblock"; +#endif +#ifdef WSAEINPROGRESS + case WSAEINPROGRESS: return "einprogress"; +#endif +#ifdef WSAEALREADY + case WSAEALREADY: return "ealready"; +#endif +#ifdef WSAENOTSOCK + case WSAENOTSOCK: return "enotsock"; +#endif +#ifdef WSAEDESTADDRREQ + case WSAEDESTADDRREQ: return "edestaddrreq"; +#endif +#ifdef WSAEMSGSIZE + case WSAEMSGSIZE: return "emsgsize"; +#endif +#ifdef WSAEPROTOTYPE + case WSAEPROTOTYPE: return "eprototype"; +#endif +#ifdef WSAENOPROTOOPT + case WSAENOPROTOOPT: return "enoprotoopt"; +#endif +#ifdef WSAEPROTONOSUPPORT + case WSAEPROTONOSUPPORT: return "eprotonosupport"; +#endif +#ifdef WSAESOCKTNOSUPPORT + case WSAESOCKTNOSUPPORT: return "esocktnosupport"; +#endif +#ifdef WSAEOPNOTSUPP + case WSAEOPNOTSUPP: return "eopnotsupp"; +#endif +#ifdef WSAEPFNOSUPPORT + case WSAEPFNOSUPPORT: return "epfnosupport"; +#endif +#ifdef WSAEAFNOSUPPORT + case WSAEAFNOSUPPORT: return "eafnosupport"; +#endif +#ifdef WSAEADDRINUSE + case WSAEADDRINUSE: return "eaddrinuse"; +#endif +#ifdef WSAEADDRNOTAVAIL + case WSAEADDRNOTAVAIL: return "eaddrnotavail"; +#endif +#ifdef WSAENETDOWN + case WSAENETDOWN: return "enetdown"; +#endif +#ifdef WSAENETUNREACH + case WSAENETUNREACH: return "enetunreach"; +#endif +#ifdef WSAENETRESET + case WSAENETRESET: return "enetreset"; +#endif +#ifdef WSAECONNABORTED + case WSAECONNABORTED: return "econnaborted"; +#endif +#ifdef WSAECONNRESET + case WSAECONNRESET: return "econnreset"; +#endif +#ifdef WSAENOBUFS + case WSAENOBUFS: return "enobufs"; +#endif +#ifdef WSAEISCONN + case WSAEISCONN: return "eisconn"; +#endif +#ifdef WSAENOTCONN + case WSAENOTCONN: return "enotconn"; +#endif +#ifdef WSAESHUTDOWN + case WSAESHUTDOWN: return "eshutdown"; +#endif +#ifdef WSAETOOMANYREFS + case WSAETOOMANYREFS: return "etoomanyrefs"; +#endif +#ifdef WSAETIMEDOUT + case WSAETIMEDOUT: return "etimedout"; +#endif +#ifdef WSAECONNREFUSED + case WSAECONNREFUSED: return "econnrefused"; +#endif +#ifdef WSAELOOP + case WSAELOOP: return "eloop"; +#endif +#ifdef WSAENAMETOOLONG + case WSAENAMETOOLONG: return "enametoolong"; +#endif +#ifdef WSAEHOSTDOWN + case WSAEHOSTDOWN: return "ehostdown"; +#endif +#ifdef WSAEHOSTUNREACH + case WSAEHOSTUNREACH: return "ehostunreach"; +#endif +#ifdef WSAENOTEMPTY + case WSAENOTEMPTY: return "enotempty"; +#endif +#ifdef WSAEPROCLIM + case WSAEPROCLIM: return "eproclim"; +#endif +#ifdef WSAEUSERS + case WSAEUSERS: return "eusers"; +#endif +#ifdef WSAEDQUOT + case WSAEDQUOT: return "edquot"; +#endif +#ifdef WSAESTALE + case WSAESTALE: return "estale"; +#endif +#ifdef WSAEREMOTE + case WSAEREMOTE: return "eremote"; +#endif +#ifdef WSASYSNOTREADY + case WSASYSNOTREADY: return "sysnotready"; +#endif +#ifdef WSAVERNOTSUPPORTED + case WSAVERNOTSUPPORTED: return "vernotsupported"; +#endif +#ifdef WSANOTINITIALISED + case WSANOTINITIALISED: return "notinitialised"; +#endif +#ifdef WSAEDISCON + case WSAEDISCON: return "ediscon"; +#endif +#ifdef WSAENOMORE + case WSAENOMORE: return "enomore"; +#endif +#ifdef WSAECANCELLED + case WSAECANCELLED: return "ecancelled"; +#endif +#ifdef WSAEINVALIDPROCTABLE + case WSAEINVALIDPROCTABLE: return "einvalidproctable"; +#endif +#ifdef WSAEINVALIDPROVIDER + case WSAEINVALIDPROVIDER: return "einvalidprovider"; +#endif +#ifdef WSAEPROVIDERFAILEDINIT + case WSAEPROVIDERFAILEDINIT: return "eproviderfailedinit"; +#endif +#ifdef WSASYSCALLFAILURE + case WSASYSCALLFAILURE: return "syscallfailure"; +#endif +#ifdef WSASERVICE_NOT_FOUND + case WSASERVICE_NOT_FOUND: return "service_not_found"; +#endif +#ifdef WSATYPE_NOT_FOUND + case WSATYPE_NOT_FOUND: return "type_not_found"; +#endif +#ifdef WSA_E_NO_MORE + case WSA_E_NO_MORE: return "e_no_more"; +#endif +#ifdef WSA_E_CANCELLED + case WSA_E_CANCELLED: return "e_cancelled"; +#endif + } + return "unknown"; +} diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c new file mode 100644 index 0000000000..7fe3f3bca5 --- /dev/null +++ b/erts/emulator/beam/erl_printf_term.c @@ -0,0 +1,458 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_printf_term.h" +#include "sys.h" +#include "big.h" + +#define PRINT_CHAR(CNT, FN, ARG, C) \ +do { \ + int res__ = erts_printf_char((FN), (ARG), (C)); \ + if (res__ < 0) \ + return res__; \ + (CNT) += res__; \ +} while (0) + +#define PRINT_STRING(CNT, FN, ARG, STR) \ +do { \ + int res__ = erts_printf_string((FN), (ARG), (STR)); \ + if (res__ < 0) \ + return res__; \ + (CNT) += res__; \ +} while (0) + +#define PRINT_BUF(CNT, FN, ARG, BUF, LEN) \ +do { \ + int res__ = erts_printf_buf((FN), (ARG), (char*)(BUF), (LEN)); \ + if (res__ < 0) \ + return res__; \ + (CNT) += res__; \ +} while (0) + +#define PRINT_POINTER(CNT, FN, ARG, PTR) \ +do { \ + int res__ = erts_printf_pointer((FN), (ARG), (void *) (PTR)); \ + if (res__ < 0) \ + return res__; \ + (CNT) += res__; \ +} while (0) + +#define PRINT_ULONG(CNT, FN, ARG, C, P, W, I) \ +do { \ + int res__ = erts_printf_ulong((FN), (ARG), (C), (P), (W), (I)); \ + if (res__ < 0) \ + return res__; \ + (CNT) += res__; \ +} while (0) + +#define PRINT_SLONG(CNT, FN, ARG, C, P, W, I) \ +do { \ + int res__ = erts_printf_slong((FN), (ARG), (C), (P), (W), (I)); \ + if (res__ < 0) \ + return res__; \ + (CNT) += res__; \ +} while (0) + +#define PRINT_DOUBLE(CNT, FN, ARG, C, P, W, I) \ +do { \ + int res__ = erts_printf_double((FN), (ARG), (C), (P), (W), (I)); \ + if (res__ < 0) \ + return res__; \ + (CNT) += res__; \ +} while (0) + +/* CTYPE macros */ + +#define LATIN1 + +#define IS_DIGIT(c) ((c) >= '0' && (c) <= '9') +#ifdef LATIN1 +#define IS_LOWER(c) (((c) >= 'a' && (c) <= 'z') \ + || ((c) >= 128+95 && (c) <= 255 && (c) != 247)) +#define IS_UPPER(c) (((c) >= 'A' && (c) <= 'Z') \ + || ((c) >= 128+64 && (c) <= 128+94 && (c) != 247-32)) +#else +#define IS_LOWER(c) ((c) >= 'a' && (c) <= 'z') +#define IS_UPPER(c) ((c) >= 'A' && (c) <= 'Z') +#endif + +#define IS_ALNUM(c) (IS_DIGIT(c) || IS_LOWER(c) || IS_UPPER(c)) + +/* We don't include 160 (non-breaking space). */ +#define IS_SPACE(c) (c == ' ' || c == '\n' || c == '\t' || c == '\r') + +#ifdef LATIN1 +#define IS_CNTRL(c) ((c) < ' ' || (c) == 127 \ + || ((c) >= 128 && (c) < 128+32)) +#else +/* Treat all non-ASCII as control characters */ +#define IS_CNTRL(c) ((c) < ' ' || (c) >= 127) +#endif + +#define IS_PRINT(c) (!IS_CNTRL(c)) + +/* return 0 if list is not a non-empty flat list of printable characters */ + +static int +is_printable_string(Eterm list) +{ + int len = 0; + int c; + + while(is_list(list)) { + Eterm* consp = list_val(list); + Eterm hd = CAR(consp); + + if (!is_byte(hd)) + return 0; + c = signed_val(hd); + /* IS_PRINT || IS_SPACE would be another way to put it */ + if (IS_CNTRL(c) && !IS_SPACE(c)) + return 0; + len++; + list = CDR(consp); + } + if (is_nil(list)) + return len; + return 0; +} + +/* print a atom doing what quoting is necessary */ +static int print_atom_name(fmtfn_t fn, void* arg, Eterm atom, long *dcount) +{ + int n, i; + int res; + int need_quote; + int pos; + byte *s; + byte *cpos; + int c; + + res = 0; + i = atom_val(atom); + + if ((i < 0) || (i >= atom_table_size()) || (atom_tab(i) == NULL)) { + PRINT_STRING(res, fn, arg, "'); + return res; + } + + s = atom_tab(i)->name; + n = atom_tab(i)->len; + + *dcount -= atom_tab(i)->len; + + if (n == 0) { + PRINT_STRING(res, fn, arg, "''"); + return res; + } + + + need_quote = 0; + cpos = s; + pos = n - 1; + + c = *cpos++; + if (!IS_LOWER(c)) + need_quote++; + else { + while (pos--) { + c = *cpos++; + if (!IS_ALNUM(c) && (c != '_')) { + need_quote++; + break; + } + } + } + cpos = s; + pos = n; + if (need_quote) + PRINT_CHAR(res, fn, arg, '\''); + while(pos--) { + c = *cpos++; + switch(c) { + case '\'': PRINT_STRING(res, fn, arg, "\\'"); break; + case '\\': PRINT_STRING(res, fn, arg, "\\\\"); break; + case '\n': PRINT_STRING(res, fn, arg, "\\n"); break; + case '\f': PRINT_STRING(res, fn, arg, "\\f"); break; + case '\t': PRINT_STRING(res, fn, arg, "\\t"); break; + case '\r': PRINT_STRING(res, fn, arg, "\\r"); break; + case '\b': PRINT_STRING(res, fn, arg, "\\b"); break; + case '\v': PRINT_STRING(res, fn, arg, "\\v"); break; + default: + if (IS_CNTRL(c)) { + PRINT_CHAR(res, fn, arg, '\\'); + PRINT_ULONG(res, fn, arg, 'o', 1, 3, (unsigned long) c); + } + else + PRINT_CHAR(res, fn, arg, (char) c); + break; + } + } + if (need_quote) + PRINT_CHAR(res, fn, arg, '\''); + return res; +} + + + +static int +print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) +{ + int res; + int i; + Uint32 *ref_num; + Eterm* nobj; + + res = 0; + + if ((*dcount)-- <= 0) + return res; + +#ifdef HYBRID___NOT_ACTIVE + /* Color coded output based on memory location */ + if(ptr_val(obj) >= global_heap && ptr_val(obj) < global_hend) + PRINT_STRING(res, fn, arg, "\033[32m"); +#ifdef INCREMENTAL + else if(ptr_val(obj) >= inc_fromspc && ptr_val(obj) < inc_fromend) + PRINT_STRING(res, fn, arg, "\033[33m"); +#endif + else if(IS_CONST(obj)) + PRINT_STRING(res, fn, arg, "\033[34m"); + else + PRINT_STRING(res, fn, arg, "\033[31m"); +#endif + + if (is_CP(obj)) { + PRINT_STRING(res, fn, arg, "'); + return res; + } + + switch (tag_val_def(obj)) { + case NIL_DEF: + PRINT_STRING(res, fn, arg, "[]"); + break; + case ATOM_DEF: { + int tres = print_atom_name(fn, arg, obj, dcount); + if (tres < 0) + return tres; + res += tres; + if (*dcount <= 0) + return res; + break; + } + case SMALL_DEF: + PRINT_SLONG(res, fn, arg, 'd', 0, 1, (signed long) signed_val(obj)); + break; + case BIG_DEF: { + int print_res; + char def_buf[64]; + char *buf, *big_str; + Uint sz = (Uint) big_decimal_estimate(obj); + sz++; + if (sz <= 64) + buf = &def_buf[0]; + else + buf = erts_alloc(ERTS_ALC_T_TMP, sz); + big_str = erts_big_to_string(obj, buf, sz); + print_res = erts_printf_string(fn, arg, big_str); + if (buf != &def_buf[0]) + erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (print_res < 0) + return print_res; + res += print_res; + break; + } + case REF_DEF: + case EXTERNAL_REF_DEF: + PRINT_STRING(res, fn, arg, "#Ref<"); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) ref_channel_no(obj)); + ref_num = ref_numbers(obj); + for (i = ref_no_of_numbers(obj)-1; i >= 0; i--) { + PRINT_CHAR(res, fn, arg, '.'); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, (unsigned long) ref_num[i]); + } + PRINT_CHAR(res, fn, arg, '>'); + break; + case PID_DEF: + case EXTERNAL_PID_DEF: + PRINT_CHAR(res, fn, arg, '<'); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) pid_channel_no(obj)); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) pid_number(obj)); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) pid_serial(obj)); + PRINT_CHAR(res, fn, arg, '>'); + break; + case PORT_DEF: + case EXTERNAL_PORT_DEF: + PRINT_STRING(res, fn, arg, "#Port<"); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) port_channel_no(obj)); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, + (unsigned long) port_number(obj)); + PRINT_CHAR(res, fn, arg, '>'); + break; + case LIST_DEF: + if (is_printable_string(obj)) { + int c; + PRINT_CHAR(res, fn, arg, '"'); + nobj = list_val(obj); + while (1) { + if ((*dcount)-- <= 0) + return res; + c = signed_val(*nobj++); + if (c == '\n') + PRINT_STRING(res, fn, arg, "\\n"); + else { + if (c == '"') + PRINT_CHAR(res, fn, arg, '\\'); + PRINT_CHAR(res, fn, arg, (char) c); + } + if (is_not_list(*nobj)) + break; + nobj = list_val(*nobj); + } + PRINT_CHAR(res, fn, arg, '"'); + } else { + PRINT_CHAR(res, fn, arg, '['); + nobj = list_val(obj); + while (1) { + int tres = print_term(fn, arg, *nobj++, dcount); + if (tres < 0) + return tres; + res += tres; + if (*dcount <= 0) + return res; + if (is_not_list(*nobj)) + break; + PRINT_CHAR(res, fn, arg, ','); + nobj = list_val(*nobj); + } + if (is_not_nil(*nobj)) { + int tres; + PRINT_CHAR(res, fn, arg, '|'); + tres = print_term(fn, arg, *nobj, dcount); + if (tres < 0) + return tres; + res += tres; + if (*dcount <= 0) + return res; + } + PRINT_CHAR(res, fn, arg, ']'); + } + break; + case TUPLE_DEF: + nobj = tuple_val(obj); /* pointer to arity */ + i = arityval(*nobj); /* arity */ + PRINT_CHAR(res, fn, arg, '{'); + while (i--) { + int tres = print_term(fn, arg, *++nobj, dcount); + if (tres < 0) + return tres; + res += tres; + if (*dcount <= 0) + return res; + if (i >= 1) + PRINT_CHAR(res, fn, arg, ','); + } + PRINT_CHAR(res, fn, arg, '}'); + break; + case FLOAT_DEF: { + FloatDef ff; + GET_DOUBLE(obj, ff); + PRINT_DOUBLE(res, fn, arg, 'e', 6, 0, ff.fd); + } + break; + case BINARY_DEF: + { + ProcBin* pb = (ProcBin *) binary_val(obj); + if (pb->size == 1) + PRINT_STRING(res, fn, arg, "<<1 byte>>"); + else { + PRINT_STRING(res, fn, arg, "<<"); + PRINT_ULONG(res, fn, arg, 'u', 0, 1, (unsigned long) pb->size); + PRINT_STRING(res, fn, arg, " bytes>>"); + } + } + break; + case EXPORT_DEF: + { + Export* ep = (Export *) (export_val(obj))[1]; + Atom* module = atom_tab(atom_val(ep->code[0])); + Atom* name = atom_tab(atom_val(ep->code[1])); + + PRINT_STRING(res, fn, arg, "#Fun<"); + PRINT_BUF(res, fn, arg, module->name, module->len); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_BUF(res, fn, arg, name->name, name->len); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_SLONG(res, fn, arg, 'd', 0, 1, + (signed long) ep->code[2]); + PRINT_CHAR(res, fn, arg, '>'); + } + break; + case FUN_DEF: + { + ErlFunThing *funp = (ErlFunThing *) fun_val(obj); + Atom *ap = atom_tab(atom_val(funp->fe->module)); + + PRINT_STRING(res, fn, arg, "#Fun<"); + PRINT_BUF(res, fn, arg, ap->name, ap->len); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_SLONG(res, fn, arg, 'd', 0, 1, + (signed long) funp->fe->old_index); + PRINT_CHAR(res, fn, arg, '.'); + PRINT_SLONG(res, fn, arg, 'd', 0, 1, + (signed long) funp->fe->old_uniq); + PRINT_CHAR(res, fn, arg, '>'); + } + break; + default: + PRINT_STRING(res, fn, arg, "'); + break; + } + + return res; +} + +int +erts_printf_term(fmtfn_t fn, void* arg, unsigned long term, long precision) +{ + int res = print_term(fn, arg, (Uint) term, &precision); + if (res < 0) + return res; + if (precision <= 0) + PRINT_STRING(res, fn, arg, "... "); + return res; +} diff --git a/erts/emulator/beam/erl_printf_term.h b/erts/emulator/beam/erl_printf_term.h new file mode 100644 index 0000000000..4f76028396 --- /dev/null +++ b/erts/emulator/beam/erl_printf_term.h @@ -0,0 +1,26 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_PRINTF_TERM_H__ +#define ERL_PRINTF_TERM_H__ + +#include "erl_printf_format.h" +int erts_printf_term(fmtfn_t fn, void* arg, unsigned long term, long precision); + +#endif diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c new file mode 100644 index 0000000000..9960172366 --- /dev/null +++ b/erts/emulator/beam/erl_process.c @@ -0,0 +1,9469 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#define ERL_PROCESS_C__ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include /* offsetof() */ +#include +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "erl_nmgc.h" +#include "error.h" +#include "bif.h" +#include "erl_db.h" +#include "dist.h" +#include "beam_catches.h" +#include "erl_instrument.h" +#include "erl_threads.h" +#include "erl_binary.h" + +#define ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED (2000*CONTEXT_REDS) +#define ERTS_RUNQ_CALL_CHECK_BALANCE_REDS \ + (ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED/2) + +#define ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST (CONTEXT_REDS/10) + +#define ERTS_SCHED_SLEEP_SPINCOUNT 10000 + +#define ERTS_WAKEUP_OTHER_LIMIT (100*CONTEXT_REDS/2) +#define ERTS_WAKEUP_OTHER_DEC 10 +#define ERTS_WAKEUP_OTHER_FIXED_INC (CONTEXT_REDS/10) + +#define ERTS_MAX_CPU_TOPOLOGY_ID ((int) 0xffff) + +#if 0 || defined(DEBUG) +#define ERTS_FAKE_SCHED_BIND_PRINT_SORTED_CPU_DATA +#endif + +#if defined(DEBUG) && 0 +#define HARDDEBUG +#else +#undef HARDDEBUG +#endif + +#ifdef HARDDEBUG +#define HARDDEBUG_RUNQS +#endif + +#ifdef HIPE +#include "hipe_mode_switch.h" /* for hipe_init_process() */ +#include "hipe_signal.h" /* for hipe_thread_signal_init() */ +#endif + +#ifdef ERTS_ENABLE_LOCK_COUNT +#include "erl_lock_count.h" +#endif + +#define MAX_BIT (1 << PRIORITY_MAX) +#define HIGH_BIT (1 << PRIORITY_HIGH) +#define NORMAL_BIT (1 << PRIORITY_NORMAL) +#define LOW_BIT (1 << PRIORITY_LOW) + +#define ERTS_MAYBE_SAVE_TERMINATING_PROCESS(P) \ +do { \ + ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&proc_tab_mtx)); \ + if (saved_term_procs.end) \ + save_terminating_process((P)); \ +} while (0) + +#define ERTS_EMPTY_RUNQ(RQ) \ + ((RQ)->len == 0 && (RQ)->misc.start == NULL) + +extern Eterm beam_apply[]; +extern Eterm beam_exit[]; +extern Eterm beam_continue_exit[]; + +static Sint p_last; +static Sint p_next; +static Sint p_serial; +static Uint p_serial_mask; +static Uint p_serial_shift; + +Uint erts_no_schedulers; +Uint erts_max_processes = ERTS_DEFAULT_MAX_PROCESSES; +Uint erts_process_tab_index_mask; + +int erts_sched_thread_suggested_stack_size = -1; + +#ifdef ERTS_ENABLE_LOCK_CHECK +ErtsLcPSDLocks erts_psd_required_locks[ERTS_PSD_SIZE]; +#endif + +#ifdef ERTS_SMP + +int erts_disable_proc_not_running_opt; + +#define ERTS_SCHED_CHANGING_ONLINE 1 +#define ERTS_SCHED_CHANGING_MULTI_SCHED 2 + +static struct { + erts_smp_mtx_t mtx; + erts_smp_cnd_t cnd; + int changing; + int online; + int curr_online; + int wait_curr_online; + erts_smp_atomic_t active; + struct { + erts_smp_atomic_t ongoing; + long wait_active; + ErtsProcList *procs; + } msb; /* Multi Scheduling Block */ +} schdlr_sspnd; + +static struct { + erts_smp_mtx_t update_mtx; + erts_smp_atomic_t active_runqs; + int last_active_runqs; + erts_smp_atomic_t used_runqs; + int forced_check_balance; + erts_smp_atomic_t checking_balance; + int halftime; + int full_reds_history_index; + struct { + int active_runqs; + int reds; + int max_len; + } prev_rise; + Uint n; +} balance_info; + +#define ERTS_BLNCE_SAVE_RISE(ACTIVE, MAX_LEN, REDS) \ +do { \ + balance_info.prev_rise.active_runqs = (ACTIVE); \ + balance_info.prev_rise.max_len = (MAX_LEN); \ + balance_info.prev_rise.reds = (REDS); \ +} while (0) + +#endif + +/* + * Cpu topology hierarchy. + */ +#define ERTS_TOPOLOGY_NODE 0 +#define ERTS_TOPOLOGY_PROCESSOR 1 +#define ERTS_TOPOLOGY_PROCESSOR_NODE 2 +#define ERTS_TOPOLOGY_CORE 3 +#define ERTS_TOPOLOGY_THREAD 4 +#define ERTS_TOPOLOGY_LOGICAL 5 + +#define ERTS_TOPOLOGY_MAX_DEPTH 6 + +typedef struct { + int bind_id; + int bound_id; +} ErtsCpuBindData; + +static ErtsCpuBindData *scheduler2cpu_map; +erts_smp_rwmtx_t erts_cpu_bind_rwmtx; + +typedef enum { + ERTS_CPU_BIND_SPREAD, + ERTS_CPU_BIND_PROCESSOR_SPREAD, + ERTS_CPU_BIND_THREAD_SPREAD, + ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD, + ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD, + ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD, + ERTS_CPU_BIND_NO_SPREAD, + ERTS_CPU_BIND_NONE +} ErtsCpuBindOrder; + +ErtsCpuBindOrder cpu_bind_order; + +static erts_cpu_topology_t *user_cpudata; +static int user_cpudata_size; +static erts_cpu_topology_t *system_cpudata; +static int system_cpudata_size; + +erts_sched_stat_t erts_sched_stat; + +ErtsRunQueue *erts_common_run_queue; + +#ifdef USE_THREADS +static erts_tsd_key_t sched_data_key; +#endif + +static erts_smp_mtx_t proc_tab_mtx; + +static erts_smp_atomic_t function_calls; + +#ifdef ERTS_SMP +static erts_smp_atomic_t doing_sys_schedule; +static erts_smp_atomic_t no_empty_run_queues; +#else /* !ERTS_SMP */ +ErtsSchedulerData *erts_scheduler_data; +#endif + +ErtsAlignedRunQueue *erts_aligned_run_queues; +Uint erts_no_run_queues; + +typedef struct { + ErtsSchedulerData esd; + char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsSchedulerData))]; +} ErtsAlignedSchedulerData; + +ErtsAlignedSchedulerData *erts_aligned_scheduler_data; + +#ifndef BM_COUNTERS +static int processes_busy; +#endif + +Process** process_tab; +static Uint last_reductions; +static Uint last_exact_reductions; +Uint erts_default_process_flags; +Eterm erts_system_monitor; +Eterm erts_system_monitor_msg_queue_len; +Eterm erts_system_monitor_long_gc; +Eterm erts_system_monitor_large_heap; +struct erts_system_monitor_flags_t erts_system_monitor_flags; + +/* system performance monitor */ +Eterm erts_system_profile; +struct erts_system_profile_flags_t erts_system_profile_flags; + +#ifdef HYBRID +Uint erts_num_active_procs; +Process** erts_active_procs; +#endif + +static erts_smp_atomic_t process_count; + +typedef struct ErtsTermProcElement_ ErtsTermProcElement; +struct ErtsTermProcElement_ { + ErtsTermProcElement *next; + ErtsTermProcElement *prev; + int ix; + union { + struct { + Eterm pid; + SysTimeval spawned; + SysTimeval exited; + } process; + struct { + SysTimeval time; + } bif_invocation; + } u; +}; + +static struct { + ErtsTermProcElement *start; + ErtsTermProcElement *end; +} saved_term_procs; + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(misc_op_list, + ErtsMiscOpList, + 10, + ERTS_ALC_T_MISC_OP_LIST) + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(proclist, + ErtsProcList, + 200, + ERTS_ALC_T_PROC_LIST) + +#define ERTS_RUNQ_IX(IX) (&erts_aligned_run_queues[(IX)].runq) +#define ERTS_SCHEDULER_IX(IX) (&erts_aligned_scheduler_data[(IX)].esd) + +#define ERTS_FOREACH_RUNQ(RQVAR, DO) \ +do { \ + ErtsRunQueue *RQVAR; \ + int ix__; \ + for (ix__ = 0; ix__ < erts_no_run_queues; ix__++) { \ + RQVAR = ERTS_RUNQ_IX(ix__); \ + erts_smp_runq_lock(RQVAR); \ + { DO; } \ + erts_smp_runq_unlock(RQVAR); \ + } \ +} while (0) + +#define ERTS_FOREACH_OP_RUNQ(RQVAR, DO) \ +do { \ + ErtsRunQueue *RQVAR; \ + int ix__; \ + ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&schdlr_sspnd.mtx)); \ + for (ix__ = 0; ix__ < schdlr_sspnd.online; ix__++) { \ + RQVAR = ERTS_RUNQ_IX(ix__); \ + erts_smp_runq_lock(RQVAR); \ + { DO; } \ + erts_smp_runq_unlock(RQVAR); \ + } \ +} while (0) + +#define ERTS_ATOMIC_FOREACH_RUNQ_X(RQVAR, DO, DOX) \ +do { \ + ErtsRunQueue *RQVAR; \ + int ix__; \ + for (ix__ = 0; ix__ < erts_no_run_queues; ix__++) { \ + RQVAR = ERTS_RUNQ_IX(ix__); \ + erts_smp_runq_lock(RQVAR); \ + { DO; } \ + } \ + { DOX; } \ + for (ix__ = 0; ix__ < erts_no_run_queues; ix__++) \ + erts_smp_runq_unlock(ERTS_RUNQ_IX(ix__)); \ +} while (0) + +#define ERTS_ATOMIC_FOREACH_RUNQ(RQVAR, DO) \ + ERTS_ATOMIC_FOREACH_RUNQ_X(RQVAR, DO, ) +/* + * Local functions. + */ + +static void init_processes_bif(void); +static void save_terminating_process(Process *p); +static void exec_misc_ops(ErtsRunQueue *); +static void print_function_from_pc(int to, void *to_arg, Eterm* x); +static int stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, + int yreg); +#ifdef ERTS_SMP +static void handle_pending_exiters(ErtsProcList *); + +static void cpu_bind_order_sort(erts_cpu_topology_t *cpudata, + int size, + ErtsCpuBindOrder bind_order, + int mk_seq); +static void signal_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size); + +#endif + +static void early_cpu_bind_init(void); +static void late_cpu_bind_init(void); + +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) +int +erts_smp_lc_runq_is_locked(ErtsRunQueue *runq) +{ + return erts_smp_lc_mtx_is_locked(&runq->mtx); +} +#endif + +void +erts_pre_init_process(void) +{ +#ifdef USE_THREADS + erts_tsd_key_create(&sched_data_key); +#endif + +#ifdef ERTS_ENABLE_LOCK_CHECK + { + int ix; + + erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].get_locks + = ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_ERROR_HANDLER].set_locks + = ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS; + + erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].get_locks + = ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SAVED_CALLS_BUF].set_locks + = ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS; + + erts_psd_required_locks[ERTS_PSD_SCHED_ID].get_locks + = ERTS_PSD_SCHED_ID_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_SCHED_ID].set_locks + = ERTS_PSD_SCHED_ID_SET_LOCKS; + + erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].get_locks + = ERTS_PSD_DIST_ENTRY_GET_LOCKS; + erts_psd_required_locks[ERTS_PSD_DIST_ENTRY].set_locks + = ERTS_PSD_DIST_ENTRY_GET_LOCKS; + + /* Check that we have locks for all entries */ + for (ix = 0; ix < ERTS_PSD_SIZE; ix++) { + ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].get_locks); + ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks); + } + } +#endif +} + +/* initialize the scheduler */ +void +erts_init_process(void) +{ + Uint proc_bits = ERTS_PROC_BITS; + +#ifdef ERTS_SMP + erts_disable_proc_not_running_opt = 0; + erts_init_proc_lock(); +#endif + + init_proclist_alloc(); + + erts_smp_atomic_init(&process_count, 0); + + if (erts_use_r9_pids_ports) { + proc_bits = ERTS_R9_PROC_BITS; + ASSERT(erts_max_processes <= (1 << ERTS_R9_PROC_BITS)); + } + + process_tab = (Process**) erts_alloc(ERTS_ALC_T_PROC_TABLE, + erts_max_processes*sizeof(Process*)); + sys_memzero(process_tab, erts_max_processes * sizeof(Process*)); +#ifdef HYBRID + erts_active_procs = (Process**) + erts_alloc(ERTS_ALC_T_ACTIVE_PROCS, + erts_max_processes * sizeof(Process*)); + erts_num_active_procs = 0; +#endif + + erts_smp_mtx_init(&proc_tab_mtx, "proc_tab"); + p_last = -1; + p_next = 0; + p_serial = 0; + + p_serial_shift = erts_fit_in_bits(erts_max_processes - 1); + p_serial_mask = ((~(~((Uint) 0) << proc_bits)) >> p_serial_shift); + erts_process_tab_index_mask = ~(~((Uint) 0) << p_serial_shift); +#ifndef BM_COUNTERS + processes_busy = 0; +#endif + last_reductions = 0; + last_exact_reductions = 0; + erts_default_process_flags = 0; +} + +void +erts_late_init_process(void) +{ + int ix; + init_processes_bif(); + + erts_smp_spinlock_init(&erts_sched_stat.lock, "sched_stat"); + for (ix = 0; ix < ERTS_NO_PRIO_LEVELS; ix++) { + Eterm atom; + char *atom_str; + switch (ix) { + case PRIORITY_MAX: + atom_str = "process_max"; + break; + case PRIORITY_HIGH: + atom_str = "process_high"; + break; + case PRIORITY_NORMAL: + atom_str = "process_normal"; + break; + case PRIORITY_LOW: + atom_str = "process_low"; + break; + case ERTS_PORT_PRIO_LEVEL: + atom_str = "port"; + break; + default: + atom_str = "bad_prio"; + ASSERT(!"bad prio"); + break; + } + atom = am_atom_put(atom_str, sys_strlen(atom_str)); + erts_sched_stat.prio[ix].name = atom; + erts_sched_stat.prio[ix].total_executed = 0; + erts_sched_stat.prio[ix].executed = 0; + erts_sched_stat.prio[ix].total_migrated = 0; + erts_sched_stat.prio[ix].migrated = 0; + } + +} + +static ERTS_INLINE ErtsProcList * +proclist_create(Process *p) +{ + ErtsProcList *plp = proclist_alloc(); + plp->pid = p->id; + plp->started = p->started; + return plp; +} + +static ERTS_INLINE void +proclist_destroy(ErtsProcList *plp) +{ + proclist_free(plp); +} + +static ERTS_INLINE int +proclist_same(ErtsProcList *plp, Process *p) +{ + return (plp->pid == p->id + && erts_cmp_timeval(&plp->started, &p->started) == 0); +} + +ErtsProcList * +erts_proclist_create(Process *p) +{ + return proclist_create(p); +} + +void +erts_proclist_destroy(ErtsProcList *plp) +{ + proclist_destroy(plp); +} + +int +erts_proclist_same(ErtsProcList *plp, Process *p) +{ + return proclist_same(plp, p); +} + +void * +erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data) +{ + void *old; + ErtsProcLocks xplocks; + int refc = 0; + ErtsPSD *psd = erts_alloc(ERTS_ALC_T_PSD, sizeof(ErtsPSD)); + int i; + for (i = 0; i < ERTS_PSD_SIZE; i++) + psd->data[i] = NULL; + + ERTS_SMP_LC_ASSERT(plocks); + ERTS_SMP_LC_ASSERT(plocks == erts_proc_lc_my_proc_locks(p)); + + xplocks = ERTS_PROC_LOCKS_ALL; + xplocks &= ~plocks; + if (xplocks && erts_smp_proc_trylock(p, xplocks) == EBUSY) { + if (xplocks & ERTS_PROC_LOCK_MAIN) { + erts_smp_proc_inc_refc(p); + erts_smp_proc_unlock(p, plocks); + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL); + refc = 1; + } + else { + if (plocks & ERTS_PROC_LOCKS_ALL_MINOR) + erts_smp_proc_unlock(p, plocks & ERTS_PROC_LOCKS_ALL_MINOR); + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); + } + } + if (!p->psd) + p->psd = psd; + if (xplocks) + erts_smp_proc_unlock(p, xplocks); + if (refc) + erts_smp_proc_dec_refc(p); + ASSERT(p->psd); + if (p->psd != psd) + erts_free(ERTS_ALC_T_PSD, psd); + old = p->psd->data[ix]; + p->psd->data[ix] = data; + ERTS_SMP_LC_ASSERT(plocks == erts_proc_lc_my_proc_locks(p)); + return old; +} + +#ifdef ERTS_SMP + +static void +prepare_for_block(void *vrq) +{ + erts_smp_runq_unlock((ErtsRunQueue *) vrq); +} + +static void +resume_after_block(void *vrq) +{ + erts_smp_runq_lock((ErtsRunQueue *) vrq); +} + +#endif + +static ERTS_INLINE void +sched_waiting_sys(Uint no, ErtsRunQueue *rq) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + ASSERT(rq->waiting >= 0); + rq->flags |= (ERTS_RUNQ_FLG_OUT_OF_WORK + | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK); + rq->waiting++; + rq->waiting *= -1; + rq->woken = 0; + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(no), am_inactive); +} + +static ERTS_INLINE void +sched_active_sys(Uint no, ErtsRunQueue *rq) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + ASSERT(rq->waiting < 0); + rq->waiting *= -1; + rq->waiting--; + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(no), am_active); +} + +Uint +erts_active_schedulers(void) +{ + /* RRRRRRRRR */ + + Uint as = erts_no_schedulers; + + ERTS_ATOMIC_FOREACH_RUNQ(rq, as -= abs(rq->waiting)); + + ASSERT(as >= 0); + return as; +} + +#ifdef ERTS_SMP + +static ERTS_INLINE void +sched_waiting(Uint no, ErtsRunQueue *rq) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + rq->flags |= (ERTS_RUNQ_FLG_OUT_OF_WORK + | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK); + if (rq->waiting < 0) + rq->waiting--; + else + rq->waiting++; + rq->woken = 0; + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(no), am_inactive); +} + +static ERTS_INLINE void +sched_active(Uint no, ErtsRunQueue *rq) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + if (rq->waiting < 0) + rq->waiting++; + else + rq->waiting--; + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(no), am_active); +} + +static int ERTS_INLINE +ongoing_multi_scheduling_block(void) +{ + return erts_smp_atomic_read(&schdlr_sspnd.msb.ongoing) != 0; +} + +static ERTS_INLINE void +empty_runq(ErtsRunQueue *rq) +{ + long oifls = erts_smp_atomic_band(&rq->info_flags, ~ERTS_RUNQ_IFLG_NONEMPTY); + if (oifls & ERTS_RUNQ_IFLG_NONEMPTY) { +#ifdef DEBUG + long empty = erts_smp_atomic_read(&no_empty_run_queues); + ASSERT(0 <= empty && empty < erts_no_run_queues); +#endif + erts_smp_atomic_inc(&no_empty_run_queues); + } +} + +static ERTS_INLINE void +non_empty_runq(ErtsRunQueue *rq) +{ + long oifls = erts_smp_atomic_bor(&rq->info_flags, ERTS_RUNQ_IFLG_NONEMPTY); + if (!(oifls & ERTS_RUNQ_IFLG_NONEMPTY)) { +#ifdef DEBUG + long empty = erts_smp_atomic_read(&no_empty_run_queues); + ASSERT(0 < empty && empty <= erts_no_run_queues); +#endif + erts_smp_atomic_dec(&no_empty_run_queues); + } +} + +static ERTS_INLINE int +sched_spin_wake(ErtsRunQueue *rq) +{ +#if ERTS_SCHED_SLEEP_SPINCOUNT == 0 + return 0; +#else + long val; + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + + val = erts_smp_atomic_read(&rq->spin_waiter); + ASSERT(val >= 0); + if (val != 0) { + erts_smp_atomic_inc(&rq->spin_wake); + return 1; + } + return 0; +#endif +} + +static ERTS_INLINE int +sched_spin_wake_all(ErtsRunQueue *rq) +{ +#if ERTS_SCHED_SLEEP_SPINCOUNT == 0 + return 0; +#else + long val; + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + + val = erts_smp_atomic_read(&rq->spin_waiter); + ASSERT(val >= 0); + if (val != 0) + erts_smp_atomic_add(&rq->spin_wake, val); + return val; +#endif +} + +static void +sched_sys_wait(Uint no, ErtsRunQueue *rq) +{ + long dt; +#if ERTS_SCHED_SLEEP_SPINCOUNT != 0 + int val; + int spincount = ERTS_SCHED_SLEEP_SPINCOUNT; + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + +#endif + + sched_waiting_sys(no, rq); + +#if ERTS_SCHED_SLEEP_SPINCOUNT != 0 + erts_smp_atomic_inc(&rq->spin_waiter); + erts_smp_runq_unlock(rq); + + erl_sys_schedule(1); /* Might give us something to do */ + + dt = do_time_read_and_reset(); + if (dt) bump_timer(dt); + + while (spincount-- > 0) { + val = erts_smp_atomic_read(&rq->spin_wake); + ASSERT(val >= 0); + if (val != 0) { + erts_smp_runq_lock(rq); + val = erts_smp_atomic_read(&rq->spin_wake); + ASSERT(val >= 0); + if (val != 0) + goto woken; + if (spincount == 0) + goto sleep; + erts_smp_runq_unlock(rq); + } + } + + erts_smp_runq_lock(rq); + val = erts_smp_atomic_read(&rq->spin_wake); + ASSERT(val >= 0); + if (val != 0) { + woken: + erts_smp_atomic_dec(&rq->spin_wake); + ASSERT(erts_smp_atomic_read(&rq->spin_wake) >= 0); + erts_smp_atomic_dec(&rq->spin_waiter); + ASSERT(erts_smp_atomic_read(&rq->spin_waiter) >= 0); + } + else { + sleep: + erts_smp_atomic_dec(&rq->spin_waiter); + ASSERT(erts_smp_atomic_read(&rq->spin_waiter) >= 0); + /* + * If we got new I/O tasks we aren't allowed to + * sleep in erl_sys_schedule(). + */ + if (!erts_port_task_have_outstanding_io_tasks()) { +#endif + + erts_sys_schedule_interrupt(0); + erts_smp_runq_unlock(rq); + + erl_sys_schedule(0); + + dt = do_time_read_and_reset(); + if (dt) bump_timer(dt); + + erts_smp_runq_lock(rq); + +#if ERTS_SCHED_SLEEP_SPINCOUNT != 0 + } + } +#endif + + sched_active_sys(no, rq); +} + +static void +sched_cnd_wait(Uint no, ErtsRunQueue *rq) +{ +#if ERTS_SCHED_SLEEP_SPINCOUNT != 0 + int val; + int spincount = ERTS_SCHED_SLEEP_SPINCOUNT; + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); +#endif + + sched_waiting(no, rq); + erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, + prepare_for_block, + resume_after_block, + (void *) rq); + +#if ERTS_SCHED_SLEEP_SPINCOUNT == 0 + erts_smp_cnd_wait(&rq->cnd, &rq->mtx); +#else + erts_smp_atomic_inc(&rq->spin_waiter); + erts_smp_mtx_unlock(&rq->mtx); + + while (spincount-- > 0) { + val = erts_smp_atomic_read(&rq->spin_wake); + ASSERT(val >= 0); + if (val != 0) { + erts_smp_mtx_lock(&rq->mtx); + val = erts_smp_atomic_read(&rq->spin_wake); + ASSERT(val >= 0); + if (val != 0) + goto woken; + if (spincount == 0) + goto sleep; + erts_smp_mtx_unlock(&rq->mtx); + } + } + + erts_smp_mtx_lock(&rq->mtx); + val = erts_smp_atomic_read(&rq->spin_wake); + ASSERT(val >= 0); + if (val == 0) { + sleep: + erts_smp_atomic_dec(&rq->spin_waiter); + ASSERT(erts_smp_atomic_read(&rq->spin_waiter) >= 0); + erts_smp_cnd_wait(&rq->cnd, &rq->mtx); + } + else { + woken: + erts_smp_atomic_dec(&rq->spin_wake); + ASSERT(erts_smp_atomic_read(&rq->spin_wake) >= 0); + erts_smp_atomic_dec(&rq->spin_waiter); + ASSERT(erts_smp_atomic_read(&rq->spin_waiter) >= 0); + } +#endif + + erts_smp_activity_end(ERTS_ACTIVITY_WAIT, + prepare_for_block, + resume_after_block, + (void *) rq); + + sched_active(no, rq); +} + +static void +wake_one_scheduler(void) +{ + ASSERT(erts_common_run_queue); + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(erts_common_run_queue)); + if (erts_common_run_queue->waiting) { + if (!sched_spin_wake(erts_common_run_queue)) { + if (erts_common_run_queue->waiting == -1) /* One scheduler waiting + and doing so in + sys_schedule */ + erts_sys_schedule_interrupt(1); + else + erts_smp_cnd_signal(&erts_common_run_queue->cnd); + } + } +} + +static void +wake_scheduler(ErtsRunQueue *rq, int incq) +{ + ASSERT(!erts_common_run_queue); + ASSERT(-1 <= rq->waiting && rq->waiting <= 1); + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + if (rq->waiting && !rq->woken) { + if (!sched_spin_wake(rq)) { + if (rq->waiting < 0) + erts_sys_schedule_interrupt(1); + else + erts_smp_cnd_signal(&rq->cnd); + } + rq->woken = 1; + if (incq) + non_empty_runq(rq); + } +} + +static void +wake_all_schedulers(void) +{ + if (erts_common_run_queue) { + erts_smp_runq_lock(erts_common_run_queue); + if (erts_common_run_queue->waiting) { + if (erts_common_run_queue->waiting < 0) + erts_sys_schedule_interrupt(1); + sched_spin_wake_all(erts_common_run_queue); + erts_smp_cnd_broadcast(&erts_common_run_queue->cnd); + } + erts_smp_runq_unlock(erts_common_run_queue); + } + else { + int ix; + for (ix = 0; ix < erts_no_run_queues; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + erts_smp_runq_lock(rq); + wake_scheduler(rq, 0); + erts_smp_runq_unlock(rq); + } + } +} + +static ERTS_INLINE int +chk_wake_sched(ErtsRunQueue *crq, int ix, int activate) +{ + long iflgs; + ErtsRunQueue *wrq; + if (crq->ix == ix) + return 0; + wrq = ERTS_RUNQ_IX(ix); + iflgs = erts_smp_atomic_read(&wrq->info_flags); + if (!(iflgs & (ERTS_RUNQ_IFLG_SUSPENDED|ERTS_RUNQ_IFLG_NONEMPTY))) { + erts_smp_xrunq_lock(crq, wrq); + if (activate) { + if (ix == erts_smp_atomic_cmpxchg(&balance_info.active_runqs, ix+1, ix)) { + wrq->flags &= ~ERTS_RUNQ_FLG_INACTIVE; + } + } + wake_scheduler(wrq, 0); + erts_smp_xrunq_unlock(crq, wrq); + return 1; + } + return 0; +} + +static void +wake_scheduler_on_empty_runq(ErtsRunQueue *crq) +{ + int ix = crq->ix; + int stop_ix = ix; + int active_ix = erts_smp_atomic_read(&balance_info.active_runqs); + int balance_ix = erts_smp_atomic_read(&balance_info.used_runqs); + + if (active_ix > balance_ix) + active_ix = balance_ix; + + if (ix >= active_ix) + stop_ix = ix = active_ix; + + /* Try to wake a scheduler on an active run queue */ + while (1) { + ix--; + if (ix < 0) { + if (active_ix == stop_ix) + break; + ix = active_ix - 1; + } + if (ix == stop_ix) + break; + if (chk_wake_sched(crq, ix, 0)) + return; + } + + if (active_ix < balance_ix) { + /* Try to activate a new run queue and wake its scheduler */ + (void) chk_wake_sched(crq, active_ix, 1); + } +} + +#endif /* ERTS_SMP */ + +static ERTS_INLINE void +smp_notify_inc_runq(ErtsRunQueue *runq) +{ +#ifdef ERTS_SMP + if (erts_common_run_queue) + wake_one_scheduler(); + else + wake_scheduler(runq, 1); +#endif +} + +void +erts_smp_notify_inc_runq__(ErtsRunQueue *runq) +{ + smp_notify_inc_runq(runq); +} + +#ifdef ERTS_SMP + +ErtsRunQueue * +erts_prepare_emigrate(ErtsRunQueue *c_rq, ErtsRunQueueInfo *c_rqi, int prio) +{ + ASSERT(ERTS_CHK_RUNQ_FLG_EMIGRATE(c_rq->flags, prio)); + ASSERT(ERTS_CHK_RUNQ_FLG_EVACUATE(c_rq->flags, prio) + || c_rqi->len >= c_rqi->migrate.limit.this); + + while (1) { + ErtsRunQueue *n_rq = c_rqi->migrate.runq; + ERTS_DBG_VERIFY_VALID_RUNQP(n_rq); + erts_smp_xrunq_lock(c_rq, n_rq); + + /* + * erts_smp_xrunq_lock() may release lock on c_rq! We have + * to check that we still want to emigrate and emigrate + * to the same run queue as before. + */ + + if (ERTS_CHK_RUNQ_FLG_EMIGRATE(c_rq->flags, prio)) { + Uint32 force = (ERTS_CHK_RUNQ_FLG_EVACUATE(c_rq->flags, prio) + | (c_rq->flags & ERTS_RUNQ_FLG_INACTIVE)); + if (force || c_rqi->len > c_rqi->migrate.limit.this) { + ErtsRunQueueInfo *n_rqi; + /* We still want to emigrate */ + + if (n_rq != c_rqi->migrate.runq) { + /* Ahh... run queue changed; need to do it all over again... */ + erts_smp_runq_unlock(n_rq); + continue; + } + else { + + if (prio == ERTS_PORT_PRIO_LEVEL) + n_rqi = &n_rq->ports.info; + else + n_rqi = &n_rq->procs.prio_info[prio]; + + if (force || (n_rqi->len < c_rqi->migrate.limit.other)) { + /* emigrate ... */ + return n_rq; + } + } + } + } + + ASSERT(n_rq != c_rq); + erts_smp_runq_unlock(n_rq); + if (!(c_rq->flags & ERTS_RUNQ_FLG_INACTIVE)) { + /* No more emigrations to this runq */ + ERTS_UNSET_RUNQ_FLG_EMIGRATE(c_rq->flags, prio); + ERTS_DBG_SET_INVALID_RUNQP(c_rqi->migrate.runq, 0x3); + } + + return NULL; + } +} + +static void +immigrate(ErtsRunQueue *rq) +{ + int prio; + + ASSERT(rq->flags & ERTS_RUNQ_FLGS_IMMIGRATE_QMASK); + + for (prio = 0; prio < ERTS_NO_PRIO_LEVELS; prio++) { + if (ERTS_CHK_RUNQ_FLG_IMMIGRATE(rq->flags, prio)) { + ErtsRunQueueInfo *rqi = (prio == ERTS_PORT_PRIO_LEVEL + ? &rq->ports.info + : &rq->procs.prio_info[prio]); + ErtsRunQueue *from_rq = rqi->migrate.runq; + int rq_locked, from_rq_locked; + + ERTS_DBG_VERIFY_VALID_RUNQP(from_rq); + + rq_locked = 1; + from_rq_locked = 1; + erts_smp_xrunq_lock(rq, from_rq); + /* + * erts_smp_xrunq_lock() may release lock on rq! We have + * to check that we still want to immigrate from the same + * run queue as before. + */ + if (ERTS_CHK_RUNQ_FLG_IMMIGRATE(rq->flags, prio) + && from_rq == rqi->migrate.runq) { + ErtsRunQueueInfo *from_rqi = (prio == ERTS_PORT_PRIO_LEVEL + ? &from_rq->ports.info + : &from_rq->procs.prio_info[prio]); + if ((ERTS_CHK_RUNQ_FLG_EVACUATE(rq->flags, prio) + && ERTS_CHK_RUNQ_FLG_EVACUATE(from_rq->flags, prio) + && from_rqi->len) + || (from_rqi->len > rqi->migrate.limit.other + && rqi->len < rqi->migrate.limit.this)) { + if (prio == ERTS_PORT_PRIO_LEVEL) { + Port *prt = from_rq->ports.start; + if (prt) { + int prt_locked = 0; + (void) erts_port_migrate(prt, &prt_locked, + from_rq, &from_rq_locked, + rq, &rq_locked); + if (prt_locked) + erts_smp_port_unlock(prt); + } + } + else { + Process *proc; + ErtsRunPrioQueue *from_rpq; + from_rpq = (prio == PRIORITY_LOW + ? &from_rq->procs.prio[PRIORITY_NORMAL] + : &from_rq->procs.prio[prio]); + for (proc = from_rpq->first; proc; proc = proc->next) + if (proc->prio == prio && !proc->bound_runq) + break; + if (proc) { + ErtsProcLocks proc_locks = 0; + (void) erts_proc_migrate(proc, &proc_locks, + from_rq, &from_rq_locked, + rq, &rq_locked); + if (proc_locks) + erts_smp_proc_unlock(proc, proc_locks); + } + } + } + else { + ERTS_UNSET_RUNQ_FLG_IMMIGRATE(rq->flags, prio); + ERTS_DBG_SET_INVALID_RUNQP(rqi->migrate.runq, 0x1); + } + } + if (from_rq_locked) + erts_smp_runq_unlock(from_rq); + if (!rq_locked) + erts_smp_runq_lock(rq); + } + } +} + +static void +evacuate_run_queue(ErtsRunQueue *evac_rq, ErtsRunQueue *rq) +{ + Port *prt; + int prio; + int prt_locked = 0; + int rq_locked = 0; + int evac_rq_locked = 1; + + erts_smp_runq_lock(evac_rq); + + evac_rq->flags &= ~ERTS_RUNQ_FLGS_IMMIGRATE_QMASK; + evac_rq->flags |= (ERTS_RUNQ_FLGS_EMIGRATE_QMASK + | ERTS_RUNQ_FLGS_EVACUATE_QMASK + | ERTS_RUNQ_FLG_SUSPENDED); + + erts_smp_atomic_bor(&evac_rq->info_flags, ERTS_RUNQ_IFLG_SUSPENDED); + + /* + * Need to set up evacuation paths first since we + * may release the run queue lock on evac_rq + * when evacuating. + */ + evac_rq->misc.evac_runq = rq; + evac_rq->ports.info.migrate.runq = rq; + for (prio = 0; prio < ERTS_NO_PROC_PRIO_LEVELS; prio++) + evac_rq->procs.prio_info[prio].migrate.runq = rq; + + /* Evacuate scheduled misc ops */ + + if (evac_rq->misc.start) { + rq_locked = 1; + erts_smp_xrunq_lock(evac_rq, rq); + if (rq->misc.end) + rq->misc.end->next = evac_rq->misc.start; + else + rq->misc.start = evac_rq->misc.start; + rq->misc.end = evac_rq->misc.end; + evac_rq->misc.start = NULL; + evac_rq->misc.end = NULL; + } + + /* Evacuate scheduled ports */ + prt = evac_rq->ports.start; + while (prt) { + (void) erts_port_migrate(prt, &prt_locked, + evac_rq, &evac_rq_locked, + rq, &rq_locked); + if (prt_locked) + erts_smp_port_unlock(prt); + if (!evac_rq_locked) { + evac_rq_locked = 1; + erts_smp_runq_lock(evac_rq); + } + prt = evac_rq->ports.start; + } + + /* Evacuate scheduled processes */ + for (prio = 0; prio < ERTS_NO_PROC_PRIO_LEVELS; prio++) { + Process *proc; + + switch (prio) { + case PRIORITY_MAX: + case PRIORITY_HIGH: + case PRIORITY_NORMAL: + proc = evac_rq->procs.prio[prio].first; + while (proc) { + ErtsProcLocks proc_locks = 0; + + /* Bound processes are stuck... */ + while (proc->bound_runq) { + proc = proc->next; + if (!proc) + goto end_of_proc; + } + + (void) erts_proc_migrate(proc, &proc_locks, + evac_rq, &evac_rq_locked, + rq, &rq_locked); + if (proc_locks) + erts_smp_proc_unlock(proc, proc_locks); + if (!evac_rq_locked) { + erts_smp_runq_lock(evac_rq); + evac_rq_locked = 1; + } + + proc = evac_rq->procs.prio[prio].first; + } + + end_of_proc: + +#ifdef DEBUG + for (proc = evac_rq->procs.prio[prio].first; + proc; + proc = proc->next) { + ASSERT(proc->bound_runq); + } +#endif + break; + case PRIORITY_LOW: + break; + default: + ASSERT(!"Invalid process priority"); + break; + } + } + + if (rq_locked) + erts_smp_runq_unlock(rq); + + if (!evac_rq_locked) + erts_smp_runq_lock(evac_rq); + wake_scheduler(evac_rq, 0); + erts_smp_runq_unlock(evac_rq); +} + +static int +try_steal_task_from_victim(ErtsRunQueue *rq, int *rq_lockedp, ErtsRunQueue *vrq) +{ + Process *proc; + int vrq_locked; + + if (*rq_lockedp) + erts_smp_xrunq_lock(rq, vrq); + else + erts_smp_runq_lock(vrq); + vrq_locked = 1; + + ERTS_SMP_LC_CHK_RUNQ_LOCK(rq, *rq_lockedp); + ERTS_SMP_LC_CHK_RUNQ_LOCK(vrq, vrq_locked); + + /* + * Check for a runnable process to steal... + */ + + switch (vrq->flags & ERTS_RUNQ_FLGS_PROCS_QMASK) { + case MAX_BIT: + case MAX_BIT|HIGH_BIT: + case MAX_BIT|NORMAL_BIT: + case MAX_BIT|LOW_BIT: + case MAX_BIT|HIGH_BIT|NORMAL_BIT: + case MAX_BIT|HIGH_BIT|LOW_BIT: + case MAX_BIT|NORMAL_BIT|LOW_BIT: + case MAX_BIT|HIGH_BIT|NORMAL_BIT|LOW_BIT: + for (proc = vrq->procs.prio[PRIORITY_MAX].last; + proc; + proc = proc->prev) { + if (!proc->bound_runq) + break; + } + if (proc) + break; + case HIGH_BIT: + case HIGH_BIT|NORMAL_BIT: + case HIGH_BIT|LOW_BIT: + case HIGH_BIT|NORMAL_BIT|LOW_BIT: + for (proc = vrq->procs.prio[PRIORITY_HIGH].last; + proc; + proc = proc->prev) { + if (!proc->bound_runq) + break; + } + if (proc) + break; + case NORMAL_BIT: + case LOW_BIT: + case NORMAL_BIT|LOW_BIT: + for (proc = vrq->procs.prio[PRIORITY_NORMAL].last; + proc; + proc = proc->prev) { + if (!proc->bound_runq) + break; + } + if (proc) + break; + case 0: + proc = NULL; + break; + default: + ASSERT(!"Invalid queue mask"); + proc = NULL; + break; + } + + if (proc) { + ErtsProcLocks proc_locks = 0; + int res; + ErtsMigrateResult mres; + mres = erts_proc_migrate(proc, &proc_locks, + vrq, &vrq_locked, + rq, rq_lockedp); + if (proc_locks) + erts_smp_proc_unlock(proc, proc_locks); + res = !0; + switch (mres) { + case ERTS_MIGRATE_FAILED_RUNQ_SUSPENDED: + res = 0; + case ERTS_MIGRATE_SUCCESS: + if (vrq_locked) + erts_smp_runq_unlock(vrq); + return res; + default: /* Other failures */ + break; + } + } + + ERTS_SMP_LC_CHK_RUNQ_LOCK(rq, *rq_lockedp); + ERTS_SMP_LC_CHK_RUNQ_LOCK(vrq, vrq_locked); + + if (!vrq_locked) { + if (*rq_lockedp) + erts_smp_xrunq_lock(rq, vrq); + else + erts_smp_runq_lock(vrq); + vrq_locked = 1; + } + + ERTS_SMP_LC_CHK_RUNQ_LOCK(rq, *rq_lockedp); + ERTS_SMP_LC_CHK_RUNQ_LOCK(vrq, vrq_locked); + + /* + * Check for a runnable port to steal... + */ + + if (vrq->ports.info.len) { + Port *prt = vrq->ports.end; + int prt_locked = 0; + int res; + ErtsMigrateResult mres; + + mres = erts_port_migrate(prt, &prt_locked, + vrq, &vrq_locked, + rq, rq_lockedp); + if (prt_locked) + erts_smp_port_unlock(prt); + res = !0; + switch (mres) { + case ERTS_MIGRATE_FAILED_RUNQ_SUSPENDED: + res = 0; + case ERTS_MIGRATE_SUCCESS: + if (vrq_locked) + erts_smp_runq_unlock(vrq); + return res; + default: /* Other failures */ + break; + } + } + + if (vrq_locked) + erts_smp_runq_unlock(vrq); + + return 0; +} + + +static ERTS_INLINE int +check_possible_steal_victim(ErtsRunQueue *rq, int *rq_lockedp, int vix) +{ + ErtsRunQueue *vrq = ERTS_RUNQ_IX(vix); + long iflgs = erts_smp_atomic_read(&vrq->info_flags); + if (iflgs & ERTS_RUNQ_IFLG_NONEMPTY) + return try_steal_task_from_victim(rq, rq_lockedp, vrq); + else + return 0; +} + + +static int +try_steal_task(ErtsRunQueue *rq) +{ + int res, rq_locked, vix, active_rqs, blnc_rqs; + + if (erts_common_run_queue) + return 0; + + /* + * We are not allowed to steal jobs to this run queue + * if it is suspended. Note that it might get suspended + * at any time when we don't have the lock on the run + * queue. + */ + if (rq->flags & ERTS_RUNQ_FLG_SUSPENDED) + return 0; + + res = 0; + rq_locked = 1; + + ERTS_SMP_LC_CHK_RUNQ_LOCK(rq, rq_locked); + + active_rqs = erts_smp_atomic_read(&balance_info.active_runqs); + blnc_rqs = erts_smp_atomic_read(&balance_info.used_runqs); + + if (active_rqs > blnc_rqs) + active_rqs = blnc_rqs; + + if (rq->ix < active_rqs) { + + /* First try to steal from an inactive run queue... */ + if (active_rqs < blnc_rqs) { + int no = blnc_rqs - active_rqs; + int stop_ix = vix = active_rqs + rq->ix % no; + while (erts_smp_atomic_read(&no_empty_run_queues) < blnc_rqs) { + res = check_possible_steal_victim(rq, &rq_locked, vix); + if (res) + goto done; + vix++; + if (vix >= blnc_rqs) + vix = active_rqs; + if (vix == stop_ix) + break; + } + } + + vix = rq->ix; + + /* ... then try to steal a job from another active queue... */ + while (erts_smp_atomic_read(&no_empty_run_queues) < blnc_rqs) { + vix++; + if (vix >= active_rqs) + vix = 0; + if (vix == rq->ix) + break; + + res = check_possible_steal_victim(rq, &rq_locked, vix); + if (res) + goto done; + } + + } + + done: + + if (!rq_locked) + erts_smp_runq_lock(rq); + + if (!res) + res = !ERTS_EMPTY_RUNQ(rq); + + return res; +} + +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN +void +erts_smp_notify_check_children_needed(void) +{ + int i; + for (i = 0; i < erts_no_schedulers; i++) { + erts_smp_runq_lock(ERTS_SCHEDULER_IX(i)->run_queue); + ERTS_SCHEDULER_IX(i)->check_children = 1; + if (!erts_common_run_queue) + wake_scheduler(ERTS_SCHEDULER_IX(i)->run_queue, 0); + erts_smp_runq_unlock(ERTS_SCHEDULER_IX(i)->run_queue); + } + if (ongoing_multi_scheduling_block()) { + /* Also blocked schedulers need to check children */ + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + for (i = 0; i < erts_no_schedulers; i++) + ERTS_SCHEDULER_IX(i)->blocked_check_children = 1; + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + } + if (erts_common_run_queue) + wake_all_schedulers(); +} +#endif + +/* Run queue balancing */ + +typedef struct { + Uint32 flags; + struct { + int max_len; + int avail; + int reds; + int migration_limit; + int emigrate_to; + int immigrate_from; + } prio[ERTS_NO_PRIO_LEVELS]; + int reds; + int full_reds; + int full_reds_history_sum; + int full_reds_history_change; + int oowc; + int max_len; +} ErtsRunQueueBalance; +static ErtsRunQueueBalance *run_queue_info; + +typedef struct { + int qix; + int len; +} ErtsRunQueueCompare; +static ErtsRunQueueCompare *run_queue_compare; + +static int +rqc_len_cmp(const void *x, const void *y) +{ + return ((ErtsRunQueueCompare *) x)->len - ((ErtsRunQueueCompare *) y)->len; +} + +#define ERTS_PERCENT(X, Y) \ + ((Y) == 0 \ + ? ((X) == 0 ? 100 : INT_MAX) \ + : ((100*(X))/(Y))) + +#define ERTS_UPDATE_FULL_REDS(QIX, LAST_REDS) \ +do { \ + run_queue_info[(QIX)].full_reds \ + = run_queue_info[(QIX)].full_reds_history_sum; \ + run_queue_info[(QIX)].full_reds += (LAST_REDS); \ + run_queue_info[(QIX)].full_reds \ + >>= ERTS_FULL_REDS_HISTORY_AVG_SHFT; \ + run_queue_info[(QIX)].full_reds_history_sum \ + -= run_queue_info[(QIX)].full_reds_history_change; \ + run_queue_info[(QIX)].full_reds_history_sum += (LAST_REDS); \ + run_queue_info[(QIX)].full_reds_history_change = (LAST_REDS); \ +} while (0) + +#define ERTS_DBG_CHK_FULL_REDS_HISTORY(RQ) \ +do { \ + int sum__ = 0; \ + int rix__; \ + for (rix__ = 0; rix__ < ERTS_FULL_REDS_HISTORY_SIZE; rix__++) \ + sum__ += (RQ)->full_reds_history[rix__]; \ + ASSERT(sum__ == (RQ)->full_reds_history_sum); \ +} while (0); + +static void +check_balance(ErtsRunQueue *c_rq) +{ + ErtsRunQueueBalance avg = {0}; + Sint64 scheds_reds, full_scheds_reds; + int forced, active, current_active, oowc, half_full_scheds, full_scheds, + mmax_len, blnc_no_rqs, qix, pix, freds_hist_ix; + + if (erts_smp_atomic_xchg(&balance_info.checking_balance, 1)) { + c_rq->check_balance_reds = INT_MAX; + return; + } + + blnc_no_rqs = (int) erts_smp_atomic_read(&balance_info.used_runqs); + if (blnc_no_rqs == 1) { + c_rq->check_balance_reds = INT_MAX; + erts_smp_atomic_set(&balance_info.checking_balance, 0); + return; + } + + erts_smp_runq_unlock(c_rq); + + if (balance_info.halftime) { + balance_info.halftime = 0; + erts_smp_atomic_set(&balance_info.checking_balance, 0); + ERTS_FOREACH_RUNQ(rq, + { + if (rq->waiting) + rq->flags |= ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK; + else + rq->flags &= ~ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK; + rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS; + }); + + erts_smp_runq_lock(c_rq); + return; + } + + /* + * check_balance() is never called in more threads + * than one at a time, i.e., we will normally never + * get any conflicts on the balance_info.update_mtx. + * However, when blocking multi scheduling (which performance + * critical applications do *not* do) migration information + * is manipulated. Such updates of the migration information + * might clash with balancing. + */ + erts_smp_mtx_lock(&balance_info.update_mtx); + + forced = balance_info.forced_check_balance; + balance_info.forced_check_balance = 0; + + blnc_no_rqs = (int) erts_smp_atomic_read(&balance_info.used_runqs); + if (blnc_no_rqs == 1) { + erts_smp_mtx_unlock(&balance_info.update_mtx); + erts_smp_runq_lock(c_rq); + c_rq->check_balance_reds = INT_MAX; + erts_smp_atomic_set(&balance_info.checking_balance, 0); + return; + } + + freds_hist_ix = balance_info.full_reds_history_index; + balance_info.full_reds_history_index++; + if (balance_info.full_reds_history_index >= ERTS_FULL_REDS_HISTORY_SIZE) + balance_info.full_reds_history_index = 0; + + current_active = erts_smp_atomic_read(&balance_info.active_runqs); + + /* Read balance information for all run queues */ + for (qix = 0; qix < blnc_no_rqs; qix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(qix); + erts_smp_runq_lock(rq); + + run_queue_info[qix].flags = rq->flags; + for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) { + run_queue_info[qix].prio[pix].max_len + = rq->procs.prio_info[pix].max_len; + run_queue_info[qix].prio[pix].reds + = rq->procs.prio_info[pix].reds; + } + run_queue_info[qix].prio[ERTS_PORT_PRIO_LEVEL].max_len + = rq->ports.info.max_len; + run_queue_info[qix].prio[ERTS_PORT_PRIO_LEVEL].reds + = rq->ports.info.reds; + + run_queue_info[qix].full_reds_history_sum + = rq->full_reds_history_sum; + run_queue_info[qix].full_reds_history_change + = rq->full_reds_history[freds_hist_ix]; + + run_queue_info[qix].oowc = rq->out_of_work_count; + run_queue_info[qix].max_len = rq->max_len; + rq->check_balance_reds = INT_MAX; + + erts_smp_runq_unlock(rq); + } + + full_scheds = 0; + half_full_scheds = 0; + full_scheds_reds = 0; + scheds_reds = 0; + oowc = 0; + mmax_len = 0; + + /* Calculate availability for each priority in each run queues */ + for (qix = 0; qix < blnc_no_rqs; qix++) { + int treds = 0; + + if (run_queue_info[qix].flags & ERTS_RUNQ_FLG_OUT_OF_WORK) { + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + run_queue_info[qix].prio[pix].avail = 100; + treds += run_queue_info[qix].prio[pix].reds; + } + if (!(run_queue_info[qix].flags & ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK)) + half_full_scheds++; + ERTS_UPDATE_FULL_REDS(qix, ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED); + } + else { + ASSERT(!(run_queue_info[qix].flags & ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK)); + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) + treds += run_queue_info[qix].prio[pix].reds; + if (treds == 0) { + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) + run_queue_info[qix].prio[pix].avail = 0; + } + else { + int xreds = 0; + int procreds = treds; + procreds -= run_queue_info[qix].prio[ERTS_PORT_PRIO_LEVEL].reds; + + for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) { + int av; + + if (xreds == 0) + av = 100; + else if (procreds == xreds) + av = 0; + else { + av = (100*(procreds - xreds)) / procreds; + if (av == 0) + av = 1; + } + run_queue_info[qix].prio[pix].avail = av; + if (pix < PRIORITY_NORMAL) /* ie., max or high */ + xreds += run_queue_info[qix].prio[pix].reds; + } + run_queue_info[qix].prio[ERTS_PORT_PRIO_LEVEL].avail = 100; + } + ERTS_UPDATE_FULL_REDS(qix, treds); + full_scheds_reds += run_queue_info[qix].full_reds; + full_scheds++; + half_full_scheds++; + } + run_queue_info[qix].reds = treds; + scheds_reds += treds; + oowc += run_queue_info[qix].oowc; + if (mmax_len < run_queue_info[qix].max_len) + mmax_len = run_queue_info[qix].max_len; + } + + if (!forced && half_full_scheds != blnc_no_rqs) { + int min = 1; + if (min < half_full_scheds) + min = half_full_scheds; + if (full_scheds) { + active = (scheds_reds - 1)/ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED+1; + } + else { + active = balance_info.last_active_runqs - 1; + } + + if (balance_info.last_active_runqs < current_active) { + ERTS_BLNCE_SAVE_RISE(current_active, mmax_len, scheds_reds); + active = current_active; + } + else if (active < balance_info.prev_rise.active_runqs) { + if (ERTS_PERCENT(mmax_len, + balance_info.prev_rise.max_len) >= 90 + && ERTS_PERCENT(scheds_reds, + balance_info.prev_rise.reds) >= 90) { + active = balance_info.prev_rise.active_runqs; + } + } + + if (active < min) + active = min; + else if (active > blnc_no_rqs) + active = blnc_no_rqs; + + if (active == blnc_no_rqs) + goto all_active; + + for (qix = 0; qix < active; qix++) { + run_queue_info[qix].flags = 0; + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + run_queue_info[qix].prio[pix].emigrate_to = -1; + run_queue_info[qix].prio[pix].immigrate_from = -1; + run_queue_info[qix].prio[pix].migration_limit = 0; + } + } + for (qix = active; qix < blnc_no_rqs; qix++) { + run_queue_info[qix].flags = ERTS_RUNQ_FLG_INACTIVE; + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + int tix = qix % active; + ERTS_SET_RUNQ_FLG_EMIGRATE(run_queue_info[qix].flags, pix); + run_queue_info[qix].prio[pix].emigrate_to = tix; + run_queue_info[qix].prio[pix].immigrate_from = -1; + run_queue_info[qix].prio[pix].migration_limit = 0; + } + } + } + else { + if (balance_info.last_active_runqs < current_active) + ERTS_BLNCE_SAVE_RISE(current_active, mmax_len, scheds_reds); + all_active: + + active = blnc_no_rqs; + + for (qix = 0; qix < blnc_no_rqs; qix++) { + + if (full_scheds_reds > 0) { + /* Calculate availability compared to other schedulers */ + if (!(run_queue_info[qix].flags & ERTS_RUNQ_FLG_OUT_OF_WORK)) { + Sint64 tmp = ((Sint64) run_queue_info[qix].full_reds + * (Sint64) full_scheds); + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + Sint64 avail = run_queue_info[qix].prio[pix].avail; + avail = (avail*tmp)/full_scheds_reds; + ASSERT(avail >= 0); + run_queue_info[qix].prio[pix].avail = (int) avail; + } + } + } + + /* Calculate average max length */ + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + run_queue_info[qix].prio[pix].emigrate_to = -1; + run_queue_info[qix].prio[pix].immigrate_from = -1; + avg.prio[pix].max_len += run_queue_info[qix].prio[pix].max_len; + avg.prio[pix].avail += run_queue_info[qix].prio[pix].avail; + } + + } + + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + int max_len = avg.prio[pix].max_len; + if (max_len != 0) { + int avail = avg.prio[pix].avail; + if (avail != 0) { + max_len = ((100*max_len - 1) / avail) + 1; + avg.prio[pix].max_len = max_len; + ASSERT(max_len >= 0); + } + } + } + + /* Calculate migration limits for all priority queues in all + run queues */ + for (qix = 0; qix < blnc_no_rqs; qix++) { + run_queue_info[qix].flags = 0; /* Reset for later use... */ + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + int limit; + if (avg.prio[pix].max_len == 0 + || run_queue_info[qix].prio[pix].avail == 0) + limit = 0; + else + limit = (((avg.prio[pix].max_len + * run_queue_info[qix].prio[pix].avail) - 1) + / 100 + 1); + run_queue_info[qix].prio[pix].migration_limit = limit; + } + } + + /* Setup migration paths for all priorities */ + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + int low = 0, high = 0; + for (qix = 0; qix < blnc_no_rqs; qix++) { + int len_diff = run_queue_info[qix].prio[pix].max_len; + len_diff -= run_queue_info[qix].prio[pix].migration_limit; +#ifdef DBG_PRINT +if (pix == 2) erts_fprintf(stderr, "%d ", len_diff); +#endif + run_queue_compare[qix].qix = qix; + run_queue_compare[qix].len = len_diff; + if (len_diff != 0) { + if (len_diff < 0) + low++; + else + high++; + } + } +#ifdef DBG_PRINT +if (pix == 2) erts_fprintf(stderr, "\n"); +#endif + if (low && high) { + int from_qix; + int to_qix; + int eof = 0; + int eot = 0; + int tix = 0; + int fix = blnc_no_rqs-1; + qsort(run_queue_compare, + blnc_no_rqs, + sizeof(ErtsRunQueueCompare), + rqc_len_cmp); + + while (1) { + if (run_queue_compare[fix].len <= 0) + eof = 1; + if (run_queue_compare[tix].len >= 0) + eot = 1; + if (eof || eot) + break; + from_qix = run_queue_compare[fix].qix; + to_qix = run_queue_compare[tix].qix; + if (run_queue_info[from_qix].prio[pix].avail == 0) { + ERTS_SET_RUNQ_FLG_EVACUATE(run_queue_info[from_qix].flags, + pix); + ERTS_SET_RUNQ_FLG_EVACUATE(run_queue_info[to_qix].flags, + pix); + } + ERTS_SET_RUNQ_FLG_EMIGRATE(run_queue_info[from_qix].flags, pix); + ERTS_SET_RUNQ_FLG_IMMIGRATE(run_queue_info[to_qix].flags, pix); + run_queue_info[from_qix].prio[pix].emigrate_to = to_qix; + run_queue_info[to_qix].prio[pix].immigrate_from = from_qix; + tix++; + fix--; + +#ifdef DBG_PRINT +if (pix == 2) erts_fprintf(stderr, "%d >--> %d\n", from_qix, to_qix); +#endif + } + + if (!eot && eof) { + if (fix < blnc_no_rqs-1) + fix++; + + if (run_queue_compare[fix].len > 0) { + int fix2 = -1; + while (tix < fix) { + if (run_queue_compare[tix].len >= 0) + break; + if (fix2 < fix) + fix2 = blnc_no_rqs-1; + from_qix = run_queue_compare[fix2].qix; + to_qix = run_queue_compare[tix].qix; + ASSERT(to_qix != from_qix); + if (run_queue_info[from_qix].prio[pix].avail == 0) + ERTS_SET_RUNQ_FLG_EVACUATE(run_queue_info[to_qix].flags, + pix); + ERTS_SET_RUNQ_FLG_IMMIGRATE(run_queue_info[to_qix].flags, pix); + run_queue_info[to_qix].prio[pix].immigrate_from = from_qix; + tix++; + fix2--; +#ifdef DBG_PRINT +if (pix == 2) erts_fprintf(stderr, "%d --> %d\n", from_qix, to_qix); +#endif + } + } + } + else if (!eof && eot) { + if (tix > 0) + tix--; + if (run_queue_compare[tix].len < 0) { + int tix2 = 0; + while (tix < fix) { + if (run_queue_compare[fix].len <= 0) + break; + if (tix2 > tix) + tix2 = 0; + from_qix = run_queue_compare[fix].qix; + to_qix = run_queue_compare[tix2].qix; + ASSERT(to_qix != from_qix); + if (run_queue_info[from_qix].prio[pix].avail == 0) + ERTS_SET_RUNQ_FLG_EVACUATE(run_queue_info[from_qix].flags, + pix); + ERTS_SET_RUNQ_FLG_EMIGRATE(run_queue_info[from_qix].flags, pix); + run_queue_info[from_qix].prio[pix].emigrate_to = to_qix; + fix--; + tix2++; +#ifdef DBG_PRINT +if (pix == 2) erts_fprintf(stderr, "%d >-- %d\n", from_qix, to_qix); +#endif + + } + } + } + } + } + +#ifdef DBG_PRINT +erts_fprintf(stderr, "--------------------------------\n"); +#endif + } + + balance_info.last_active_runqs = active; + erts_smp_atomic_set(&balance_info.active_runqs, active); + + balance_info.halftime = 1; + erts_smp_atomic_set(&balance_info.checking_balance, 0); + + /* Write migration paths and reset balance statistics in all queues */ + for (qix = 0; qix < blnc_no_rqs; qix++) { + int mqix; + Uint32 flags; + ErtsRunQueue *rq = ERTS_RUNQ_IX(qix); + ErtsRunQueueInfo *rqi; + flags = run_queue_info[qix].flags; + erts_smp_runq_lock(rq); + flags |= (rq->flags & ~ERTS_RUNQ_FLGS_MIGRATION_INFO); + ASSERT(!(flags & ERTS_RUNQ_FLG_OUT_OF_WORK)); + if (rq->waiting) + flags |= ERTS_RUNQ_FLG_OUT_OF_WORK; + + rq->full_reds_history_sum + = run_queue_info[qix].full_reds_history_sum; + rq->full_reds_history[freds_hist_ix] + = run_queue_info[qix].full_reds_history_change; + + ERTS_DBG_CHK_FULL_REDS_HISTORY(rq); + + rq->out_of_work_count = 0; + rq->flags = flags; + rq->max_len = rq->len; + for (pix = 0; pix < ERTS_NO_PRIO_LEVELS; pix++) { + rqi = (pix == ERTS_PORT_PRIO_LEVEL + ? &rq->ports.info + : &rq->procs.prio_info[pix]); + rqi->max_len = rqi->len; + rqi->reds = 0; + if (!(ERTS_CHK_RUNQ_FLG_EMIGRATE(flags, pix) + | ERTS_CHK_RUNQ_FLG_IMMIGRATE(flags, pix))) { + ASSERT(run_queue_info[qix].prio[pix].immigrate_from < 0); + ASSERT(run_queue_info[qix].prio[pix].emigrate_to < 0); +#ifdef DEBUG + rqi->migrate.limit.this = -1; + rqi->migrate.limit.other = -1; + ERTS_DBG_SET_INVALID_RUNQP(rqi->migrate.runq, 0x2); +#endif + + } + else if (ERTS_CHK_RUNQ_FLG_EMIGRATE(flags, pix)) { + ASSERT(!ERTS_CHK_RUNQ_FLG_IMMIGRATE(flags, pix)); + ASSERT(run_queue_info[qix].prio[pix].immigrate_from < 0); + ASSERT(run_queue_info[qix].prio[pix].emigrate_to >= 0); + + mqix = run_queue_info[qix].prio[pix].emigrate_to; + rqi->migrate.limit.this + = run_queue_info[qix].prio[pix].migration_limit; + rqi->migrate.limit.other + = run_queue_info[mqix].prio[pix].migration_limit; + rqi->migrate.runq = ERTS_RUNQ_IX(mqix); + } + else { + ASSERT(ERTS_CHK_RUNQ_FLG_IMMIGRATE(flags, pix)); + ASSERT(run_queue_info[qix].prio[pix].emigrate_to < 0); + ASSERT(run_queue_info[qix].prio[pix].immigrate_from >= 0); + + mqix = run_queue_info[qix].prio[pix].immigrate_from; + rqi->migrate.limit.this + = run_queue_info[qix].prio[pix].migration_limit; + rqi->migrate.limit.other + = run_queue_info[mqix].prio[pix].migration_limit; + rqi->migrate.runq = ERTS_RUNQ_IX(mqix); + } + } + + rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS; + erts_smp_runq_unlock(rq); + } + + balance_info.n++; + erts_smp_mtx_unlock(&balance_info.update_mtx); + + erts_smp_runq_lock(c_rq); +} + +#endif /* #ifdef ERTS_SMP */ + +Uint +erts_debug_nbalance(void) +{ +#ifdef ERTS_SMP + Uint n; + erts_smp_mtx_lock(&balance_info.update_mtx); + n = balance_info.n; + erts_smp_mtx_unlock(&balance_info.update_mtx); + return n; +#else + return 0; +#endif +} + +void +erts_early_init_scheduling(void) +{ + early_cpu_bind_init(); +} + +void +erts_init_scheduling(int mrq, int no_schedulers, int no_schedulers_online) +{ + int ix, n; + +#ifndef ERTS_SMP + mrq = 0; +#endif + + init_misc_op_list_alloc(); + + ASSERT(no_schedulers_online <= no_schedulers); + ASSERT(no_schedulers_online >= 1); + ASSERT(no_schedulers >= 1); + + /* Create and initialize run queues */ + + n = (int) (mrq ? no_schedulers : 1); + + erts_aligned_run_queues = erts_alloc(ERTS_ALC_T_RUNQS, + (sizeof(ErtsAlignedRunQueue)*(n+1))); + if ((((Uint) erts_aligned_run_queues) & ERTS_CACHE_LINE_MASK) == 0) + erts_aligned_run_queues = ((ErtsAlignedRunQueue *) + ((((Uint) erts_aligned_run_queues) + & ~ERTS_CACHE_LINE_MASK) + + ERTS_CACHE_LINE_SIZE)); + +#ifdef ERTS_SMP + erts_smp_atomic_init(&no_empty_run_queues, 0); +#endif + + for (ix = 0; ix < n; ix++) { + int pix, rix; + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + + rq->ix = ix; + erts_smp_atomic_init(&rq->info_flags, ERTS_RUNQ_IFLG_NONEMPTY); + + erts_smp_mtx_init(&rq->mtx, "run_queue"); + erts_smp_cnd_init(&rq->cnd); + + erts_smp_atomic_init(&rq->spin_waiter, 0); + erts_smp_atomic_init(&rq->spin_wake, 0); + + rq->waiting = 0; + rq->woken = 0; + rq->flags = !mrq ? ERTS_RUNQ_FLG_SHARED_RUNQ : 0; + rq->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS; + rq->full_reds_history_sum = 0; + for (rix = 0; rix < ERTS_FULL_REDS_HISTORY_SIZE; rix++) { + rq->full_reds_history_sum += ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED; + rq->full_reds_history[rix] = ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED; + } + rq->out_of_work_count = 0; + rq->max_len = 0; + rq->len = 0; + rq->wakeup_other = 0; + rq->wakeup_other_reds = 0; + + rq->procs.len = 0; + rq->procs.pending_exiters = NULL; + rq->procs.context_switches = 0; + rq->procs.reductions = 0; + + for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) { + rq->procs.prio_info[pix].len = 0; + rq->procs.prio_info[pix].max_len = 0; + rq->procs.prio_info[pix].reds = 0; + rq->procs.prio_info[pix].migrate.limit.this = 0; + rq->procs.prio_info[pix].migrate.limit.other = 0; + ERTS_DBG_SET_INVALID_RUNQP(rq->procs.prio_info[pix].migrate.runq, + 0x0); + if (pix < ERTS_NO_PROC_PRIO_LEVELS - 1) { + rq->procs.prio[pix].first = NULL; + rq->procs.prio[pix].last = NULL; + } + } + + rq->misc.start = NULL; + rq->misc.end = NULL; + rq->misc.evac_runq = NULL; + + rq->ports.info.len = 0; + rq->ports.info.max_len = 0; + rq->ports.info.reds = 0; + rq->ports.info.migrate.limit.this = 0; + rq->ports.info.migrate.limit.other = 0; + rq->ports.info.migrate.runq = NULL; + rq->ports.start = NULL; + rq->ports.end = NULL; + } + + erts_common_run_queue = !mrq ? ERTS_RUNQ_IX(0) : NULL; + erts_no_run_queues = n; + +#ifdef ERTS_SMP + + if (erts_no_run_queues != 1) { + run_queue_info = erts_alloc(ERTS_ALC_T_RUNQ_BLNS, + (sizeof(ErtsRunQueueBalance) + * erts_no_run_queues)); + run_queue_compare = erts_alloc(ERTS_ALC_T_RUNQ_BLNS, + (sizeof(ErtsRunQueueCompare) + * erts_no_run_queues)); + } + +#endif + + /* Create and initialize scheduler specific data */ + + n = (int) no_schedulers; + erts_aligned_scheduler_data = erts_alloc(ERTS_ALC_T_SCHDLR_DATA, + (sizeof(ErtsAlignedSchedulerData) + *(n+1))); + if ((((Uint) erts_aligned_scheduler_data) & ERTS_CACHE_LINE_MASK) == 0) + erts_aligned_scheduler_data = ((ErtsAlignedSchedulerData *) + ((((Uint) erts_aligned_scheduler_data) + & ~ERTS_CACHE_LINE_MASK) + + ERTS_CACHE_LINE_SIZE)); + for (ix = 0; ix < n; ix++) { + ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(ix); +#ifdef ERTS_SMP + erts_bits_init_state(&esdp->erl_bits_state); + esdp->match_pseudo_process = NULL; + esdp->free_process = NULL; +#endif + esdp->no = (Uint) ix+1; + esdp->current_process = NULL; + esdp->current_port = NULL; + + esdp->virtual_reds = 0; + esdp->cpu_id = -1; + + erts_init_atom_cache_map(&esdp->atom_cache_map); + + if (erts_common_run_queue) { + esdp->run_queue = erts_common_run_queue; + esdp->run_queue->scheduler = NULL; + } + else { + esdp->run_queue = ERTS_RUNQ_IX(ix); + esdp->run_queue->scheduler = esdp; + } + +#ifdef ERTS_SMP +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN + esdp->check_children = 0; + esdp->blocked_check_children = 0; +#endif + erts_smp_atomic_init(&esdp->suspended, 0); + erts_smp_atomic_init(&esdp->chk_cpu_bind, 0); +#endif + } + +#ifdef ERTS_SMP + erts_smp_mtx_init(&schdlr_sspnd.mtx, "schdlr_sspnd"); + erts_smp_cnd_init(&schdlr_sspnd.cnd); + + schdlr_sspnd.changing = 0; + schdlr_sspnd.online = no_schedulers_online; + schdlr_sspnd.curr_online = no_schedulers; + erts_smp_atomic_init(&schdlr_sspnd.msb.ongoing, 0); + erts_smp_atomic_init(&schdlr_sspnd.active, no_schedulers); + schdlr_sspnd.msb.procs = NULL; + erts_smp_atomic_set(&balance_info.used_runqs, + erts_common_run_queue ? 1 : no_schedulers_online); + erts_smp_atomic_init(&balance_info.active_runqs, no_schedulers); + balance_info.last_active_runqs = no_schedulers; + erts_smp_mtx_init(&balance_info.update_mtx, "migration_info_update"); + balance_info.forced_check_balance = 0; + balance_info.halftime = 1; + balance_info.full_reds_history_index = 0; + erts_smp_atomic_init(&balance_info.checking_balance, 0); + balance_info.prev_rise.active_runqs = 0; + balance_info.prev_rise.max_len = 0; + balance_info.prev_rise.reds = 0; + balance_info.n = 0; + + if (no_schedulers_online < no_schedulers) { + if (erts_common_run_queue) { + for (ix = no_schedulers_online; ix < no_schedulers; ix++) + erts_smp_atomic_set(&(ERTS_SCHEDULER_IX(ix)->suspended), 1); + } + else { + for (ix = no_schedulers_online; ix < erts_no_run_queues; ix++) + evacuate_run_queue(ERTS_RUNQ_IX(ix), + ERTS_RUNQ_IX(ix % no_schedulers_online)); + } + } + + schdlr_sspnd.wait_curr_online = no_schedulers_online; + schdlr_sspnd.curr_online *= 2; /* Boot strapping... */ + schdlr_sspnd.changing = ERTS_SCHED_CHANGING_ONLINE; + + erts_smp_atomic_init(&doing_sys_schedule, 0); + +#else /* !ERTS_SMP */ + { + ErtsSchedulerData *esdp; + esdp = ERTS_SCHEDULER_IX(0); + erts_scheduler_data = esdp; +#ifdef USE_THREADS + erts_tsd_set(sched_data_key, (void *) esdp); +#endif + } + erts_no_schedulers = 1; +#endif + + erts_smp_atomic_init(&function_calls, 0); + + /* init port tasks */ + erts_port_task_init(); + + late_cpu_bind_init(); +} + +ErtsRunQueue * +erts_schedid2runq(Uint id) +{ + int ix; + if (erts_common_run_queue) + return erts_common_run_queue; + ix = (int) id - 1; + ASSERT(0 <= ix && ix < erts_no_run_queues); + return ERTS_RUNQ_IX(ix); +} + +#ifdef USE_THREADS + +ErtsSchedulerData * +erts_get_scheduler_data(void) +{ + return (ErtsSchedulerData *) erts_tsd_get(sched_data_key); +} + +#endif + +static int remove_proc_from_runq(ErtsRunQueue *rq, Process *p, int to_inactive); + +static ERTS_INLINE void +suspend_process(ErtsRunQueue *rq, Process *p) +{ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + p->rcount++; /* count number of suspend */ +#ifdef ERTS_SMP + ASSERT(!(p->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) + || p == erts_get_current_process()); + ASSERT(p->status != P_RUNNING + || p->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING); + if (p->status_flags & ERTS_PROC_SFLG_PENDADD2SCHEDQ) + goto runable; +#endif + switch(p->status) { + case P_SUSPENDED: + break; + case P_RUNABLE: +#ifdef ERTS_SMP + runable: + if (!ERTS_PROC_PENDING_EXIT(p)) +#endif + remove_proc_from_runq(rq, p, 1); + /* else: + * leave process in schedq so it will discover the pending exit + */ + p->rstatus = P_RUNABLE; /* wakeup as runnable */ + break; + case P_RUNNING: + p->rstatus = P_RUNABLE; /* wakeup as runnable */ + break; + case P_WAITING: + p->rstatus = P_WAITING; /* wakeup as waiting */ + break; + case P_EXITING: + return; /* ignore this */ + case P_GARBING: + case P_FREE: + erl_exit(1, "bad state in suspend_process()\n"); + } + + if ((erts_system_profile_flags.runnable_procs) && (p->rcount == 1) && (p->status != P_WAITING)) { + profile_runnable_proc(p, am_inactive); + } + + p->status = P_SUSPENDED; + +} + +static ERTS_INLINE void +resume_process(Process *p) +{ + Uint32 *statusp; + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + switch (p->status) { + case P_SUSPENDED: + statusp = &p->status; + break; + case P_GARBING: + if (p->gcstatus == P_SUSPENDED) { + statusp = &p->gcstatus; + break; + } + /* Fall through */ + default: + return; + } + + ASSERT(p->rcount > 0); + + if (--p->rcount > 0) /* multiple suspend */ + return; + switch(p->rstatus) { + case P_RUNABLE: + *statusp = P_WAITING; /* make erts_add_to_runq work */ + erts_add_to_runq(p); + break; + case P_WAITING: + *statusp = P_WAITING; + break; + default: + erl_exit(1, "bad state in resume_process()\n"); + } + p->rstatus = P_FREE; +} + +#ifdef ERTS_SMP + +static void +susp_sched_prep_block(void *unused) +{ + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); +} + +static void +susp_sched_resume_block(void *unused) +{ + erts_smp_mtx_lock(&schdlr_sspnd.mtx); +} + +static void +suspend_scheduler(ErtsSchedulerData *esdp) +{ + long no = (long) esdp->no; + ErtsRunQueue *rq = esdp->run_queue; + long active_schedulers; + int curr_online = 1; + int wake = 0; + + /* + * Schedulers may be suspended in two different ways: + * - A scheduler may be suspended since it is not online. + * All schedulers with scheduler ids greater than + * schdlr_sspnd.online are suspended. + * - Multi scheduling is blocked. All schedulers except the + * scheduler with scheduler id 1 are suspended. + * + * Regardless of why a scheduler is suspended, it ends up here. + */ + + ASSERT(no != 1); + + erts_smp_runq_unlock(esdp->run_queue); + + /* Unbind from cpu */ + erts_smp_rwmtx_rwlock(&erts_cpu_bind_rwmtx); + if (scheduler2cpu_map[esdp->no].bound_id >= 0 + && erts_unbind_from_cpu(erts_cpuinfo) == 0) { + esdp->cpu_id = scheduler2cpu_map[esdp->no].bound_id = -1; + } + erts_smp_rwmtx_rwunlock(&erts_cpu_bind_rwmtx); + + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(esdp->no), am_inactive); + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + + active_schedulers = erts_smp_atomic_dectest(&schdlr_sspnd.active); + ASSERT(active_schedulers >= 1); + if (schdlr_sspnd.changing == ERTS_SCHED_CHANGING_MULTI_SCHED) { + if (active_schedulers == schdlr_sspnd.msb.wait_active) + wake = 1; + if (active_schedulers == 1) + schdlr_sspnd.changing = 0; + } + + while (1) { + +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN + int check_children; + erts_smp_runq_lock(esdp->run_queue); + check_children = esdp->check_children; + esdp->check_children = 0; + erts_smp_runq_unlock(esdp->run_queue); + if (check_children) { + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + erts_check_children(); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + } +#endif + + if (schdlr_sspnd.changing == ERTS_SCHED_CHANGING_ONLINE) { + int changed = 0; + if (no > schdlr_sspnd.online && curr_online) { + schdlr_sspnd.curr_online--; + curr_online = 0; + changed = 1; + } + else if (no <= schdlr_sspnd.online && !curr_online) { + schdlr_sspnd.curr_online++; + curr_online = 1; + changed = 1; + } + if (changed + && schdlr_sspnd.curr_online == schdlr_sspnd.wait_curr_online) + wake = 1; + if (schdlr_sspnd.online == schdlr_sspnd.curr_online) + schdlr_sspnd.changing = 0; + } + + if (wake) { + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); + wake = 0; + } + + + if (!(rq->flags & (ERTS_RUNQ_FLG_SHARED_RUNQ|ERTS_RUNQ_FLG_SUSPENDED))) + break; + if ((rq->flags & ERTS_RUNQ_FLG_SHARED_RUNQ) + && !erts_smp_atomic_read(&esdp->suspended)) + break; + + erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, + susp_sched_prep_block, + susp_sched_resume_block, + NULL); + while (1) { + +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN + if (esdp->blocked_check_children) + break; +#endif + + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + + if (schdlr_sspnd.changing == ERTS_SCHED_CHANGING_ONLINE) + break; + + if (!(rq->flags & (ERTS_RUNQ_FLG_SHARED_RUNQ + | ERTS_RUNQ_FLG_SUSPENDED))) + break; + if ((rq->flags & ERTS_RUNQ_FLG_SHARED_RUNQ) + && !erts_smp_atomic_read(&esdp->suspended)) + break; + } + +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN + esdp->blocked_check_children = 0; +#endif + + erts_smp_activity_end(ERTS_ACTIVITY_WAIT, + susp_sched_prep_block, + susp_sched_resume_block, + NULL); + } + + erts_smp_atomic_inc(&schdlr_sspnd.active); + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + + if (erts_system_profile_flags.scheduler) + profile_scheduler(make_small(esdp->no), am_active); + + erts_smp_runq_lock(esdp->run_queue); + non_empty_runq(esdp->run_queue); + + /* Make sure we check if we should bind to a cpu or not... */ + if (rq->flags & ERTS_RUNQ_FLG_SHARED_RUNQ) + erts_smp_atomic_set(&esdp->chk_cpu_bind, 1); + else + rq->flags |= ERTS_RUNQ_FLG_CHK_CPU_BIND; +} + +#define ERTS_RUNQ_RESET_SUSPEND_INFO(RQ, DBG_ID) \ +do { \ + int pix__; \ + (RQ)->misc.evac_runq = NULL; \ + (RQ)->ports.info.migrate.runq = NULL; \ + (RQ)->flags &= ~(ERTS_RUNQ_FLGS_IMMIGRATE_QMASK \ + | ERTS_RUNQ_FLGS_EMIGRATE_QMASK \ + | ERTS_RUNQ_FLGS_EVACUATE_QMASK \ + | ERTS_RUNQ_FLG_SUSPENDED); \ + (RQ)->flags |= (ERTS_RUNQ_FLG_OUT_OF_WORK \ + | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK); \ + (RQ)->check_balance_reds = ERTS_RUNQ_CALL_CHECK_BALANCE_REDS; \ + erts_smp_atomic_band(&(RQ)->info_flags, ~ERTS_RUNQ_IFLG_SUSPENDED); \ + for (pix__ = 0; pix__ < ERTS_NO_PROC_PRIO_LEVELS; pix__++) { \ + (RQ)->procs.prio_info[pix__].max_len = 0; \ + (RQ)->procs.prio_info[pix__].reds = 0; \ + ERTS_DBG_SET_INVALID_RUNQP((RQ)->procs.prio_info[pix__].migrate.runq,\ + (DBG_ID)); \ + } \ + (RQ)->ports.info.max_len = 0; \ + (RQ)->ports.info.reds = 0; \ +} while (0) + +#define ERTS_RUNQ_RESET_MIGRATION_PATHS__(RQ) \ +do { \ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked((RQ))); \ + (RQ)->misc.evac_runq = NULL; \ + (RQ)->ports.info.migrate.runq = NULL; \ + (RQ)->flags &= ~(ERTS_RUNQ_FLGS_IMMIGRATE_QMASK \ + | ERTS_RUNQ_FLGS_EMIGRATE_QMASK \ + | ERTS_RUNQ_FLGS_EVACUATE_QMASK); \ +} while (0) + +#ifdef DEBUG +#define ERTS_RUNQ_RESET_MIGRATION_PATHS(RQ, DBG_ID) \ +do { \ + int pix__; \ + ERTS_RUNQ_RESET_MIGRATION_PATHS__((RQ)); \ + for (pix__ = 0; pix__ < ERTS_NO_PROC_PRIO_LEVELS; pix__++) \ + ERTS_DBG_SET_INVALID_RUNQP((RQ)->procs.prio_info[pix__].migrate.runq,\ + (DBG_ID)); \ +} while (0) +#else +#define ERTS_RUNQ_RESET_MIGRATION_PATHS(RQ, DBG_ID) \ + ERTS_RUNQ_RESET_MIGRATION_PATHS__((RQ)) +#endif + +ErtsSchedSuspendResult +erts_schedulers_state(Uint *total, + Uint *online, + Uint *active, + int yield_allowed) +{ + int res; + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + if (yield_allowed && schdlr_sspnd.changing) + res = ERTS_SCHDLR_SSPND_YIELD_RESTART; + else { + *active = *online = schdlr_sspnd.online; + if (ongoing_multi_scheduling_block()) + *active = 1; + res = ERTS_SCHDLR_SSPND_DONE; + } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + *total = erts_no_schedulers; + return res; +} + +ErtsSchedSuspendResult +erts_set_schedulers_online(Process *p, + ErtsProcLocks plocks, + Sint new_no, + Sint *old_no) +{ + int ix, res, no, have_unlocked_plocks; + + if (new_no < 1 || erts_no_schedulers < new_no) + return ERTS_SCHDLR_SSPND_EINVAL; + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + + have_unlocked_plocks = 0; + no = (int) new_no; + + if (schdlr_sspnd.changing) { + res = ERTS_SCHDLR_SSPND_YIELD_RESTART; + } + else { + int online = *old_no = schdlr_sspnd.online; + if (no == schdlr_sspnd.online) { + res = ERTS_SCHDLR_SSPND_DONE; + } + else { + schdlr_sspnd.changing = ERTS_SCHED_CHANGING_ONLINE; + schdlr_sspnd.online = no; + if (no > online) { + int ix; + schdlr_sspnd.wait_curr_online = no; + if (ongoing_multi_scheduling_block()) + /* No schedulers to resume */; + else if (erts_common_run_queue) { + for (ix = online; ix < no; ix++) + erts_smp_atomic_set(&ERTS_SCHEDULER_IX(ix)->suspended, + 0); + } + else { + if (plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + erts_smp_mtx_lock(&balance_info.update_mtx); + for (ix = online; ix < no; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + erts_smp_runq_lock(rq); + ERTS_RUNQ_RESET_SUSPEND_INFO(rq, 0x5); + erts_smp_runq_unlock(rq); + } + /* + * Spread evacuation paths among all online + * run queues. + */ + for (ix = no; ix < erts_no_run_queues; ix++) { + ErtsRunQueue *from_rq = ERTS_RUNQ_IX(ix); + ErtsRunQueue *to_rq = ERTS_RUNQ_IX(ix % no); + evacuate_run_queue(from_rq, to_rq); + } + erts_smp_atomic_set(&balance_info.used_runqs, no); + erts_smp_mtx_unlock(&balance_info.update_mtx); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + } + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); + res = ERTS_SCHDLR_SSPND_DONE; + } + else /* if (no < online) */ { + if (p->scheduler_data->no <= no) { + res = ERTS_SCHDLR_SSPND_DONE; + schdlr_sspnd.wait_curr_online = no; + } + else { + /* + * Yield! Current process needs to migrate + * before bif returns. + */ + res = ERTS_SCHDLR_SSPND_YIELD_DONE; + schdlr_sspnd.wait_curr_online = no+1; + } + + if (ongoing_multi_scheduling_block()) + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); + else if (erts_common_run_queue) { + for (ix = no; ix < online; ix++) + erts_smp_atomic_set(&ERTS_SCHEDULER_IX(ix)->suspended, + 1); + wake_all_schedulers(); + } + else { + if (plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + erts_smp_mtx_lock(&balance_info.update_mtx); + + for (ix = 0; ix < online; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + erts_smp_runq_lock(rq); + ERTS_RUNQ_RESET_MIGRATION_PATHS(rq, 0x6); + erts_smp_runq_unlock(rq); + } + /* + * Evacutation order important! Newly suspended run queues + * has to be evacuated last. + */ + for (ix = erts_no_run_queues-1; ix >= no; ix--) + evacuate_run_queue(ERTS_RUNQ_IX(ix), + ERTS_RUNQ_IX(ix % no)); + erts_smp_atomic_set(&balance_info.used_runqs, no); + erts_smp_mtx_unlock(&balance_info.update_mtx); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + ERTS_FOREACH_OP_RUNQ(rq, wake_scheduler(rq, 0)); + } + } + + erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, + susp_sched_prep_block, + susp_sched_resume_block, + NULL); + while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + erts_smp_activity_end(ERTS_ACTIVITY_WAIT, + susp_sched_prep_block, + susp_sched_resume_block, + NULL); + } + } + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (have_unlocked_plocks) + erts_smp_proc_lock(p, plocks); + + return res; +} + +ErtsSchedSuspendResult +erts_block_multi_scheduling(Process *p, ErtsProcLocks plocks, int on, int all) +{ + int ix, res, have_unlocked_plocks = 0; + ErtsProcList *plp; + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + if (on) { + if (schdlr_sspnd.changing) { + res = ERTS_SCHDLR_SSPND_YIELD_RESTART; /* Yield */ + } + else if (erts_is_multi_scheduling_blocked()) { + plp = proclist_create(p); + plp->next = schdlr_sspnd.msb.procs; + schdlr_sspnd.msb.procs = plp; + p->flags |= F_HAVE_BLCKD_MSCHED; + ASSERT(erts_smp_atomic_read(&schdlr_sspnd.active) == 1); + ASSERT(p->scheduler_data->no == 1); + res = 1; + } + else { + p->flags |= F_HAVE_BLCKD_MSCHED; + if (plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + erts_smp_atomic_set(&schdlr_sspnd.msb.ongoing, 1); + if (schdlr_sspnd.online == 1) { + res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; + ASSERT(erts_smp_atomic_read(&schdlr_sspnd.active) == 1); + ASSERT(p->scheduler_data->no == 1); + } + else { + schdlr_sspnd.changing = ERTS_SCHED_CHANGING_MULTI_SCHED; + if (p->scheduler_data->no == 1) { + res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; + schdlr_sspnd.msb.wait_active = 1; + } + else { + /* + * Yield! Current process needs to migrate + * before bif returns. + */ + res = ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED; + schdlr_sspnd.msb.wait_active = 2; + } + if (erts_common_run_queue) { + for (ix = 1; ix < schdlr_sspnd.online; ix++) + erts_smp_atomic_set(&ERTS_SCHEDULER_IX(ix)->suspended, 1); + wake_all_schedulers(); + } + else { + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + erts_smp_mtx_lock(&balance_info.update_mtx); + erts_smp_atomic_set(&balance_info.used_runqs, 1); + for (ix = 0; ix < schdlr_sspnd.online; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + erts_smp_runq_lock(rq); + ERTS_RUNQ_RESET_MIGRATION_PATHS(rq, 0x7); + erts_smp_runq_unlock(rq); + } + /* + * Evacuate all activities in all other run queues + * into the first run queue. Note order is important, + * online run queues has to be evacuated last. + */ + for (ix = erts_no_run_queues-1; ix >= 1; ix--) + evacuate_run_queue(ERTS_RUNQ_IX(ix), ERTS_RUNQ_IX(0)); + erts_smp_mtx_unlock(&balance_info.update_mtx); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + } + erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, + susp_sched_prep_block, + susp_sched_resume_block, + NULL); + while (erts_smp_atomic_read(&schdlr_sspnd.active) + != schdlr_sspnd.msb.wait_active) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + erts_smp_activity_end(ERTS_ACTIVITY_WAIT, + susp_sched_prep_block, + susp_sched_resume_block, + NULL); + } + plp = proclist_create(p); + plp->next = schdlr_sspnd.msb.procs; + schdlr_sspnd.msb.procs = plp; +#ifdef DEBUG + ERTS_FOREACH_RUNQ(srq, + { + if (srq != ERTS_RUNQ_IX(0)) { + ASSERT(ERTS_EMPTY_RUNQ(srq)); + ASSERT(srq->flags & ERTS_RUNQ_FLG_SUSPENDED); + } + }); +#endif + ASSERT(p->scheduler_data); + } + } + else if (!ongoing_multi_scheduling_block()) { + ASSERT(!schdlr_sspnd.msb.procs); + res = ERTS_SCHDLR_SSPND_DONE; + } + else { + if (p->flags & F_HAVE_BLCKD_MSCHED) { + ErtsProcList **plpp = &schdlr_sspnd.msb.procs; + plp = schdlr_sspnd.msb.procs; + + while (plp) { + if (!proclist_same(plp, p)){ + plpp = &plp->next; + plp = plp->next; + } + else { + *plpp = plp->next; + proclist_destroy(plp); + if (!all) + break; + plp = *plpp; + } + } + } + if (schdlr_sspnd.msb.procs) + res = ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED; + else { + schdlr_sspnd.changing = ERTS_SCHED_CHANGING_MULTI_SCHED; +#ifdef DEBUG + ERTS_FOREACH_RUNQ(rq, + { + if (rq != p->scheduler_data->run_queue) { + if (!ERTS_EMPTY_RUNQ(rq)) { + Process *rp; + int pix; + ASSERT(rq->ports.info.len == 0); + for (pix = 0; pix < ERTS_NO_PROC_PRIO_LEVELS; pix++) { + for (rp = rq->procs.prio[pix].first; + rp; + rp = rp->next) { + ASSERT(rp->bound_runq); + } + } + } + + ASSERT(rq->flags & ERTS_RUNQ_FLG_SUSPENDED); + } + }); +#endif + p->flags &= ~F_HAVE_BLCKD_MSCHED; + erts_smp_atomic_set(&schdlr_sspnd.msb.ongoing, 0); + if (schdlr_sspnd.online == 1) + /* No schedulers to resume */; + else if (erts_common_run_queue) { + for (ix = 1; ix < schdlr_sspnd.online; ix++) + erts_smp_atomic_set(&ERTS_SCHEDULER_IX(ix)->suspended, 0); + wake_all_schedulers(); + } + else { + int online = schdlr_sspnd.online; + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (plocks) { + have_unlocked_plocks = 1; + erts_smp_proc_unlock(p, plocks); + } + erts_smp_mtx_lock(&balance_info.update_mtx); + + /* Resume all online run queues */ + for (ix = 1; ix < online; ix++) { + ErtsRunQueue *rq = ERTS_RUNQ_IX(ix); + erts_smp_runq_lock(rq); + ERTS_RUNQ_RESET_SUSPEND_INFO(rq, 0x4); + erts_smp_runq_unlock(rq); + } + + /* Spread evacuation paths among all online run queues */ + for (ix = online; ix < erts_no_run_queues; ix++) + evacuate_run_queue(ERTS_RUNQ_IX(ix), + ERTS_RUNQ_IX(ix % online)); + + erts_smp_atomic_set(&balance_info.used_runqs, online); + /* Make sure that we balance soon... */ + balance_info.forced_check_balance = 1; + erts_smp_runq_lock(ERTS_RUNQ_IX(0)); + ERTS_RUNQ_IX(0)->check_balance_reds = 0; + erts_smp_runq_unlock(ERTS_RUNQ_IX(0)); + erts_smp_mtx_unlock(&balance_info.update_mtx); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + } + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); + schdlr_sspnd.changing = 0; + res = ERTS_SCHDLR_SSPND_DONE; + } + } + + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + if (have_unlocked_plocks) + erts_smp_proc_lock(p, plocks); + return res; +} + +#ifdef DEBUG +void +erts_dbg_multi_scheduling_return_trap(Process *p, Eterm return_value) +{ + if (return_value == am_blocked) { + long active = erts_smp_atomic_read(&schdlr_sspnd.active); + ASSERT(1 <= active && active <= 2); + ASSERT(ERTS_PROC_GET_SCHDATA(p)->no == 1); + } +} +#endif + +int +erts_is_multi_scheduling_blocked(void) +{ + return (erts_smp_atomic_read(&schdlr_sspnd.msb.ongoing) + && erts_smp_atomic_read(&schdlr_sspnd.active) == 1); +} + +Eterm +erts_multi_scheduling_blockers(Process *p) +{ + Eterm res = NIL; + + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + if (erts_is_multi_scheduling_blocked()) { + Eterm *hp, *hp_end; + ErtsProcList *plp1, *plp2; + Uint max_size; + ASSERT(schdlr_sspnd.msb.procs); + for (max_size = 0, plp1 = schdlr_sspnd.msb.procs; + plp1; + plp1 = plp1->next) { + max_size += 2; + } + ASSERT(max_size); + hp = HAlloc(p, max_size); + hp_end = hp + max_size; + for (plp1 = schdlr_sspnd.msb.procs; plp1; plp1 = plp1->next) { + for (plp2 = schdlr_sspnd.msb.procs; + plp2->pid != plp1->pid; + plp2 = plp2->next); + if (plp2 == plp1) { + res = CONS(hp, plp1->pid, res); + hp += 2; + } + /* else: already in result list */ + } + HRelease(p, hp_end, hp); + } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + return res; +} + +static void * +sched_thread_func(void *vesdp) +{ +#ifdef ERTS_ENABLE_LOCK_CHECK + { + char buf[31]; + Uint no = ((ErtsSchedulerData *) vesdp)->no; + erts_snprintf(&buf[0], 31, "scheduler %bpu", no); + erts_lc_set_thread_name(&buf[0]); + } +#endif + erts_alloc_reg_scheduler_id(((ErtsSchedulerData *) vesdp)->no); + erts_tsd_set(sched_data_key, vesdp); +#ifdef ERTS_SMP + erts_proc_lock_prepare_proc_lock_waiter(); +#endif + erts_register_blockable_thread(); +#ifdef HIPE + hipe_thread_signal_init(); +#endif + erts_thread_init_float(); + erts_smp_mtx_lock(&schdlr_sspnd.mtx); + + ASSERT(schdlr_sspnd.changing == ERTS_SCHED_CHANGING_ONLINE); + + schdlr_sspnd.curr_online--; + + if (((ErtsSchedulerData *) vesdp)->no != 1) { + if (schdlr_sspnd.online == schdlr_sspnd.curr_online) { + schdlr_sspnd.changing = 0; + erts_smp_cnd_broadcast(&schdlr_sspnd.cnd); + } + } + else if (schdlr_sspnd.curr_online == schdlr_sspnd.wait_curr_online) + schdlr_sspnd.changing = 0; + else { + erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, + susp_sched_prep_block, + susp_sched_resume_block, + NULL); + while (schdlr_sspnd.curr_online != schdlr_sspnd.wait_curr_online) + erts_smp_cnd_wait(&schdlr_sspnd.cnd, &schdlr_sspnd.mtx); + erts_smp_activity_end(ERTS_ACTIVITY_WAIT, + susp_sched_prep_block, + susp_sched_resume_block, + NULL); + ASSERT(!schdlr_sspnd.changing); + } + erts_smp_mtx_unlock(&schdlr_sspnd.mtx); + + process_main(); + /* No schedulers should *ever* terminate */ + erl_exit(ERTS_ABORT_EXIT, "Scheduler thread number %bpu terminated\n", + ((ErtsSchedulerData *) vesdp)->no); + return NULL; +} + +void +erts_start_schedulers(void) +{ + int res = 0; + Uint actual = 0; + Uint wanted = erts_no_schedulers; + Uint wanted_no_schedulers = erts_no_schedulers; + ethr_thr_opts opts = ETHR_THR_OPTS_DEFAULT_INITER; + + opts.detached = 1; + opts.suggested_stack_size = erts_sched_thread_suggested_stack_size; + + if (wanted < 1) + wanted = 1; + if (wanted > ERTS_MAX_NO_OF_SCHEDULERS) { + wanted = ERTS_MAX_NO_OF_SCHEDULERS; + res = ENOTSUP; + } + + erts_block_system(0); + + while (actual < wanted) { + ErtsSchedulerData *esdp = ERTS_SCHEDULER_IX(actual); + actual++; + ASSERT(actual == esdp->no); +#ifdef ERTS_ENABLE_LOCK_COUNT + res = erts_lcnt_thr_create(&esdp->tid,sched_thread_func,(void*)esdp,&opts); +#else + res = ethr_thr_create(&esdp->tid,sched_thread_func,(void*)esdp,&opts); +#endif + if (res != 0) { + actual--; + break; + } + } + + erts_no_schedulers = actual; + erts_release_system(); + + if (actual < 1) + erl_exit(1, + "Failed to create any scheduler-threads: %s (%d)\n", + erl_errno_id(res), + res); + if (res != 0) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + ASSERT(actual != wanted_no_schedulers); + erts_dsprintf(dsbufp, + "Failed to create %bpu scheduler-threads (%s:%d); " + "only %bpu scheduler-thread%s created.\n", + wanted_no_schedulers, erl_errno_id(res), res, + actual, actual == 1 ? " was" : "s were"); + erts_send_error_to_logger_nogl(dsbufp); + } +} + +#endif /* ERTS_SMP */ + +static int +int_cmp(const void *vx, const void *vy) +{ + return *((int *) vx) - *((int *) vy); +} + +static int +cpu_spread_order_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->thread != y->thread) + return x->thread - y->thread; + if (x->core != y->core) + return x->core - y->core; + if (x->processor_node != y->processor_node) + return x->processor_node - y->processor_node; + if (x->processor != y->processor) + return x->processor - y->processor; + if (x->node != y->node) + return x->node - y->node; + return 0; +} + +static int +cpu_processor_spread_order_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->thread != y->thread) + return x->thread - y->thread; + if (x->processor_node != y->processor_node) + return x->processor_node - y->processor_node; + if (x->core != y->core) + return x->core - y->core; + if (x->node != y->node) + return x->node - y->node; + if (x->processor != y->processor) + return x->processor - y->processor; + return 0; +} + +static int +cpu_thread_spread_order_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->thread != y->thread) + return x->thread - y->thread; + if (x->node != y->node) + return x->node - y->node; + if (x->processor != y->processor) + return x->processor - y->processor; + if (x->processor_node != y->processor_node) + return x->processor_node - y->processor_node; + if (x->core != y->core) + return x->core - y->core; + return 0; +} + +static int +cpu_thread_no_node_processor_spread_order_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->thread != y->thread) + return x->thread - y->thread; + if (x->node != y->node) + return x->node - y->node; + if (x->core != y->core) + return x->core - y->core; + if (x->processor != y->processor) + return x->processor - y->processor; + return 0; +} + +static int +cpu_no_node_processor_spread_order_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->node != y->node) + return x->node - y->node; + if (x->thread != y->thread) + return x->thread - y->thread; + if (x->core != y->core) + return x->core - y->core; + if (x->processor != y->processor) + return x->processor - y->processor; + return 0; +} + +static int +cpu_no_node_thread_spread_order_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->node != y->node) + return x->node - y->node; + if (x->thread != y->thread) + return x->thread - y->thread; + if (x->processor != y->processor) + return x->processor - y->processor; + if (x->core != y->core) + return x->core - y->core; + return 0; +} + +static int +cpu_no_spread_order_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->node != y->node) + return x->node - y->node; + if (x->processor != y->processor) + return x->processor - y->processor; + if (x->processor_node != y->processor_node) + return x->processor_node - y->processor_node; + if (x->core != y->core) + return x->core - y->core; + if (x->thread != y->thread) + return x->thread - y->thread; + return 0; +} + +static ERTS_INLINE void +make_cpudata_id_seq(erts_cpu_topology_t *cpudata, int size, int no_node) +{ + int ix; + int node = -1; + int processor = -1; + int processor_node = -1; + int processor_node_node = -1; + int core = -1; + int thread = -1; + int old_node = -1; + int old_processor = -1; + int old_processor_node = -1; + int old_core = -1; + int old_thread = -1; + + for (ix = 0; ix < size; ix++) { + if (!no_node || cpudata[ix].node >= 0) { + if (old_node == cpudata[ix].node) + cpudata[ix].node = node; + else { + old_node = cpudata[ix].node; + old_processor = processor = -1; + if (!no_node) + old_processor_node = processor_node = -1; + old_core = core = -1; + old_thread = thread = -1; + if (no_node || cpudata[ix].node >= 0) + cpudata[ix].node = ++node; + } + } + if (old_processor == cpudata[ix].processor) + cpudata[ix].processor = processor; + else { + old_processor = cpudata[ix].processor; + if (!no_node) + processor_node_node = old_processor_node = processor_node = -1; + old_core = core = -1; + old_thread = thread = -1; + cpudata[ix].processor = ++processor; + } + if (no_node && cpudata[ix].processor_node < 0) + old_processor_node = -1; + else { + if (old_processor_node == cpudata[ix].processor_node) { + if (no_node) + cpudata[ix].node = cpudata[ix].processor_node = node; + else { + if (processor_node_node >= 0) + cpudata[ix].node = processor_node_node; + cpudata[ix].processor_node = processor_node; + } + } + else { + old_processor_node = cpudata[ix].processor_node; + old_core = core = -1; + old_thread = thread = -1; + if (no_node) + cpudata[ix].node = cpudata[ix].processor_node = ++node; + else { + cpudata[ix].node = processor_node_node = ++node; + cpudata[ix].processor_node = ++processor_node; + } + } + } + if (!no_node && cpudata[ix].processor_node < 0) + cpudata[ix].processor_node = 0; + if (old_core == cpudata[ix].core) + cpudata[ix].core = core; + else { + old_core = cpudata[ix].core; + old_thread = thread = -1; + cpudata[ix].core = ++core; + } + if (old_thread == cpudata[ix].thread) + cpudata[ix].thread = thread; + else + old_thread = cpudata[ix].thread = ++thread; + } +} + +static void +cpu_bind_order_sort(erts_cpu_topology_t *cpudata, + int size, + ErtsCpuBindOrder bind_order, + int mk_seq) +{ + if (size > 1) { + int no_node = 0; + int (*cmp_func)(const void *, const void *); + switch (bind_order) { + case ERTS_CPU_BIND_SPREAD: + cmp_func = cpu_spread_order_cmp; + break; + case ERTS_CPU_BIND_PROCESSOR_SPREAD: + cmp_func = cpu_processor_spread_order_cmp; + break; + case ERTS_CPU_BIND_THREAD_SPREAD: + cmp_func = cpu_thread_spread_order_cmp; + break; + case ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD: + no_node = 1; + cmp_func = cpu_thread_no_node_processor_spread_order_cmp; + break; + case ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD: + no_node = 1; + cmp_func = cpu_no_node_processor_spread_order_cmp; + break; + case ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD: + no_node = 1; + cmp_func = cpu_no_node_thread_spread_order_cmp; + break; + case ERTS_CPU_BIND_NO_SPREAD: + cmp_func = cpu_no_spread_order_cmp; + break; + default: + cmp_func = NULL; + erl_exit(ERTS_ABORT_EXIT, + "Bad cpu bind type: %d\n", + (int) cpu_bind_order); + break; + } + + if (mk_seq) + make_cpudata_id_seq(cpudata, size, no_node); + + qsort(cpudata, size, sizeof(erts_cpu_topology_t), cmp_func); + } +} + +static int +processor_order_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->processor != y->processor) + return x->processor - y->processor; + if (x->node != y->node) + return x->node - y->node; + if (x->processor_node != y->processor_node) + return x->processor_node - y->processor_node; + if (x->core != y->core) + return x->core - y->core; + if (x->thread != y->thread) + return x->thread - y->thread; + return 0; +} + +static void +check_cpu_bind(ErtsSchedulerData *esdp) +{ + int res; + int cpu_id; + erts_smp_runq_unlock(esdp->run_queue); + erts_smp_rwmtx_rwlock(&erts_cpu_bind_rwmtx); + cpu_id = scheduler2cpu_map[esdp->no].bind_id; + if (cpu_id >= 0 && cpu_id != scheduler2cpu_map[esdp->no].bound_id) { + res = erts_bind_to_cpu(erts_cpuinfo, cpu_id); + if (res == 0) + esdp->cpu_id = scheduler2cpu_map[esdp->no].bound_id = cpu_id; + else { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Scheduler %d failed to bind to cpu %d: %s\n", + (int) esdp->no, cpu_id, erl_errno_id(-res)); + erts_send_error_to_logger_nogl(dsbufp); + if (scheduler2cpu_map[esdp->no].bound_id >= 0) + goto unbind; + } + } + else if (cpu_id < 0 && scheduler2cpu_map[esdp->no].bound_id >= 0) { + unbind: + /* Get rid of old binding */ + res = erts_unbind_from_cpu(erts_cpuinfo); + if (res == 0) + esdp->cpu_id = scheduler2cpu_map[esdp->no].bound_id = -1; + else { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Scheduler %d failed to unbind from cpu %d: %s\n", + (int) esdp->no, cpu_id, erl_errno_id(-res)); + erts_send_error_to_logger_nogl(dsbufp); + } + } + erts_smp_runq_lock(esdp->run_queue); +#ifdef ERTS_SMP + if (erts_common_run_queue) + erts_smp_atomic_set(&esdp->chk_cpu_bind, 0); + else { + esdp->run_queue->flags &= ~ERTS_RUNQ_FLG_CHK_CPU_BIND; + } +#endif + erts_smp_rwmtx_rwunlock(&erts_cpu_bind_rwmtx); + +} + +static void +signal_schedulers_bind_change(erts_cpu_topology_t *cpudata, int size) +{ + int s_ix = 1; + int cpu_ix; + + if (cpu_bind_order != ERTS_CPU_BIND_NONE) { + + cpu_bind_order_sort(cpudata, size, cpu_bind_order, 1); + + for (cpu_ix = 0; cpu_ix < size && cpu_ix < erts_no_schedulers; cpu_ix++) + if (erts_is_cpu_available(erts_cpuinfo, cpudata[cpu_ix].logical)) + scheduler2cpu_map[s_ix++].bind_id = cpudata[cpu_ix].logical; + } + + if (s_ix <= erts_no_schedulers) + for (; s_ix <= erts_no_schedulers; s_ix++) + scheduler2cpu_map[s_ix].bind_id = -1; + +#ifdef ERTS_SMP + if (erts_common_run_queue) { + for (s_ix = 0; s_ix < erts_no_schedulers; s_ix++) + erts_smp_atomic_set(&ERTS_SCHEDULER_IX(s_ix)->chk_cpu_bind, 1); + wake_all_schedulers(); + } + else { + ERTS_FOREACH_RUNQ(rq, + { + rq->flags |= ERTS_RUNQ_FLG_CHK_CPU_BIND; + wake_scheduler(rq, 0); + }); + } +#else + check_cpu_bind(erts_get_scheduler_data()); +#endif +} + +int +erts_init_scheduler_bind_type(char *how) +{ + if (erts_bind_to_cpu(erts_cpuinfo, -1) == -ENOTSUP) + return ERTS_INIT_SCHED_BIND_TYPE_NOT_SUPPORTED; + + if (!system_cpudata && !user_cpudata) + return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY; + + if (sys_strcmp(how, "s") == 0) + cpu_bind_order = ERTS_CPU_BIND_SPREAD; + else if (sys_strcmp(how, "ps") == 0) + cpu_bind_order = ERTS_CPU_BIND_PROCESSOR_SPREAD; + else if (sys_strcmp(how, "ts") == 0) + cpu_bind_order = ERTS_CPU_BIND_THREAD_SPREAD; + else if (sys_strcmp(how, "db") == 0 + || sys_strcmp(how, "tnnps") == 0) + cpu_bind_order = ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD; + else if (sys_strcmp(how, "nnps") == 0) + cpu_bind_order = ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD; + else if (sys_strcmp(how, "nnts") == 0) + cpu_bind_order = ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD; + else if (sys_strcmp(how, "ns") == 0) + cpu_bind_order = ERTS_CPU_BIND_NO_SPREAD; + else if (sys_strcmp(how, "u") == 0) + cpu_bind_order = ERTS_CPU_BIND_NONE; + else + return ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_BAD_TYPE; + + return ERTS_INIT_SCHED_BIND_TYPE_SUCCESS; +} + +typedef struct { + int *id; + int used; + int size; +} ErtsCpuTopIdSeq; + +typedef struct { + ErtsCpuTopIdSeq logical; + ErtsCpuTopIdSeq thread; + ErtsCpuTopIdSeq core; + ErtsCpuTopIdSeq processor_node; + ErtsCpuTopIdSeq processor; + ErtsCpuTopIdSeq node; +} ErtsCpuTopEntry; + +static void +init_cpu_top_entry(ErtsCpuTopEntry *cte) +{ + int size = 10; + cte->logical.id = erts_alloc(ERTS_ALC_T_TMP_CPU_IDS, + sizeof(int)*size); + cte->logical.size = size; + cte->thread.id = erts_alloc(ERTS_ALC_T_TMP_CPU_IDS, + sizeof(int)*size); + cte->thread.size = size; + cte->core.id = erts_alloc(ERTS_ALC_T_TMP_CPU_IDS, + sizeof(int)*size); + cte->core.size = size; + cte->processor_node.id = erts_alloc(ERTS_ALC_T_TMP_CPU_IDS, + sizeof(int)*size); + cte->processor_node.size = size; + cte->processor.id = erts_alloc(ERTS_ALC_T_TMP_CPU_IDS, + sizeof(int)*size); + cte->processor.size = size; + cte->node.id = erts_alloc(ERTS_ALC_T_TMP_CPU_IDS, + sizeof(int)*size); + cte->node.size = size; +} + +static void +destroy_cpu_top_entry(ErtsCpuTopEntry *cte) +{ + erts_free(ERTS_ALC_T_TMP_CPU_IDS, cte->logical.id); + erts_free(ERTS_ALC_T_TMP_CPU_IDS, cte->thread.id); + erts_free(ERTS_ALC_T_TMP_CPU_IDS, cte->core.id); + erts_free(ERTS_ALC_T_TMP_CPU_IDS, cte->processor_node.id); + erts_free(ERTS_ALC_T_TMP_CPU_IDS, cte->processor.id); + erts_free(ERTS_ALC_T_TMP_CPU_IDS, cte->node.id); +} + +static int +get_cput_value_or_range(int *v, int *vr, char **str) +{ + long l; + char *c = *str; + errno = 0; + if (!isdigit((unsigned char)*c)) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID; + l = strtol(c, &c, 10); + if (errno != 0 || l < 0 || ERTS_MAX_CPU_TOPOLOGY_ID < l) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID; + *v = (int) l; + if (*c == '-') { + c++; + if (!isdigit((unsigned char)*c)) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE; + l = strtol(c, &c, 10); + if (errno != 0 || l < 0 || ERTS_MAX_CPU_TOPOLOGY_ID < l) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE; + *vr = (int) l; + } + *str = c; + return ERTS_INIT_CPU_TOPOLOGY_OK; +} + +static int +get_cput_id_seq(ErtsCpuTopIdSeq *idseq, char **str) +{ + int ix = 0; + int need_size = 0; + char *c = *str; + + while (1) { + int res; + int val; + int nids; + int val_range = -1; + res = get_cput_value_or_range(&val, &val_range, &c); + if (res != ERTS_INIT_CPU_TOPOLOGY_OK) + return res; + if (val_range < 0 || val_range == val) + nids = 1; + else { + if (val_range > val) + nids = val_range - val + 1; + else + nids = val - val_range + 1; + } + need_size += nids; + if (need_size > idseq->size) { + idseq->size = need_size + 10; + idseq->id = erts_realloc(ERTS_ALC_T_TMP_CPU_IDS, + idseq->id, + sizeof(int)*idseq->size); + } + if (nids == 1) + idseq->id[ix++] = val; + else if (val_range > val) { + for (; val <= val_range; val++) + idseq->id[ix++] = val; + } + else { + for (; val >= val_range; val--) + idseq->id[ix++] = val; + } + if (*c != ',') + break; + c++; + } + *str = c; + idseq->used = ix; + return ERTS_INIT_CPU_TOPOLOGY_OK; +} + +static int +get_cput_entry(ErtsCpuTopEntry *cput, char **str) +{ + int h; + char *c = *str; + + cput->logical.used = 0; + cput->thread.id[0] = 0; + cput->thread.used = 1; + cput->core.id[0] = 0; + cput->core.used = 1; + cput->processor_node.id[0] = -1; + cput->processor_node.used = 1; + cput->processor.id[0] = 0; + cput->processor.used = 1; + cput->node.id[0] = -1; + cput->node.used = 1; + + h = ERTS_TOPOLOGY_MAX_DEPTH; + while (*c != ':' && *c != '\0') { + int res; + ErtsCpuTopIdSeq *idseqp; + switch (*c++) { + case 'L': + if (h <= ERTS_TOPOLOGY_LOGICAL) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_HIERARCHY; + idseqp = &cput->logical; + h = ERTS_TOPOLOGY_LOGICAL; + break; + case 't': + case 'T': + if (h <= ERTS_TOPOLOGY_THREAD) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_HIERARCHY; + idseqp = &cput->thread; + h = ERTS_TOPOLOGY_THREAD; + break; + case 'c': + case 'C': + if (h <= ERTS_TOPOLOGY_CORE) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_HIERARCHY; + idseqp = &cput->core; + h = ERTS_TOPOLOGY_CORE; + break; + case 'p': + case 'P': + if (h <= ERTS_TOPOLOGY_PROCESSOR) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_HIERARCHY; + idseqp = &cput->processor; + h = ERTS_TOPOLOGY_PROCESSOR; + break; + case 'n': + case 'N': + if (h <= ERTS_TOPOLOGY_PROCESSOR) { + do_node: + if (h <= ERTS_TOPOLOGY_NODE) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_HIERARCHY; + idseqp = &cput->node; + h = ERTS_TOPOLOGY_NODE; + } + else { + int p_node = 0; + char *p_chk = c; + while (*p_chk != '\0' && *p_chk != ':') { + if (*p_chk == 'p' || *p_chk == 'P') { + p_node = 1; + break; + } + p_chk++; + } + if (!p_node) + goto do_node; + if (h <= ERTS_TOPOLOGY_PROCESSOR_NODE) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_HIERARCHY; + idseqp = &cput->processor_node; + h = ERTS_TOPOLOGY_PROCESSOR_NODE; + } + break; + default: + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_TYPE; + } + res = get_cput_id_seq(idseqp, &c); + if (res != ERTS_INIT_CPU_TOPOLOGY_OK) + return res; + } + + if (cput->logical.used < 1) + return ERTS_INIT_CPU_TOPOLOGY_MISSING_LID; + + if (*c == ':') { + c++; + } + + if (cput->thread.used != 1 + && cput->thread.used != cput->logical.used) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE; + if (cput->core.used != 1 + && cput->core.used != cput->logical.used) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE; + if (cput->processor_node.used != 1 + && cput->processor_node.used != cput->logical.used) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE; + if (cput->processor.used != 1 + && cput->processor.used != cput->logical.used) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE; + if (cput->node.used != 1 + && cput->node.used != cput->logical.used) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE; + + *str = c; + return ERTS_INIT_CPU_TOPOLOGY_OK; +} + +static int +verify_topology(erts_cpu_topology_t *cpudata, int size) +{ + if (size > 0) { + int *logical; + int node, processor, no_nodes, i; + + /* Verify logical ids */ + logical = erts_alloc(ERTS_ALC_T_TMP, sizeof(int)*size); + + for (i = 0; i < user_cpudata_size; i++) + logical[i] = user_cpudata[i].logical; + + qsort(logical, user_cpudata_size, sizeof(int), int_cmp); + for (i = 0; i < user_cpudata_size-1; i++) { + if (logical[i] == logical[i+1]) { + erts_free(ERTS_ALC_T_TMP, logical); + return ERTS_INIT_CPU_TOPOLOGY_NOT_UNIQUE_LIDS; + } + } + + erts_free(ERTS_ALC_T_TMP, logical); + + qsort(cpudata, size, sizeof(erts_cpu_topology_t), processor_order_cmp); + + /* Verify unique entities */ + + for (i = 1; i < user_cpudata_size; i++) { + if (user_cpudata[i-1].processor == user_cpudata[i].processor + && user_cpudata[i-1].node == user_cpudata[i].node + && (user_cpudata[i-1].processor_node + == user_cpudata[i].processor_node) + && user_cpudata[i-1].core == user_cpudata[i].core + && user_cpudata[i-1].thread == user_cpudata[i].thread) { + return ERTS_INIT_CPU_TOPOLOGY_NOT_UNIQUE_ENTITIES; + } + } + + /* Verify numa nodes */ + node = cpudata[0].node; + processor = cpudata[0].processor; + no_nodes = cpudata[0].node < 0 && cpudata[0].processor_node < 0; + for (i = 1; i < size; i++) { + if (no_nodes) { + if (cpudata[i].node >= 0 || cpudata[i].processor_node >= 0) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_NODES; + } + else { + if (cpudata[i].processor == processor && cpudata[i].node != node) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_NODES; + node = cpudata[i].node; + processor = cpudata[i].processor; + if (node >= 0 && cpudata[i].processor_node >= 0) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_NODES; + if (node < 0 && cpudata[i].processor_node < 0) + return ERTS_INIT_CPU_TOPOLOGY_INVALID_NODES; + } + } + } + + return ERTS_INIT_CPU_TOPOLOGY_OK; +} + +int +erts_init_cpu_topology(char *topology_str) +{ + ErtsCpuTopEntry cput; + int need_size; + char *c; + int ix; + int error = ERTS_INIT_CPU_TOPOLOGY_OK; + + if (user_cpudata) + erts_free(ERTS_ALC_T_CPUDATA, user_cpudata); + user_cpudata_size = 10; + + user_cpudata = erts_alloc(ERTS_ALC_T_CPUDATA, + (sizeof(erts_cpu_topology_t) + * user_cpudata_size)); + + init_cpu_top_entry(&cput); + + ix = 0; + need_size = 0; + + c = topology_str; + if (*c == '\0') { + error = ERTS_INIT_CPU_TOPOLOGY_MISSING; + goto fail; + } + do { + int r; + error = get_cput_entry(&cput, &c); + if (error != ERTS_INIT_CPU_TOPOLOGY_OK) + goto fail; + need_size += cput.logical.used; + if (user_cpudata_size < need_size) { + user_cpudata_size = need_size + 10; + user_cpudata = erts_realloc(ERTS_ALC_T_CPUDATA, + user_cpudata, + (sizeof(erts_cpu_topology_t) + * user_cpudata_size)); + } + + ASSERT(cput.thread.used == 1 + || cput.thread.used == cput.logical.used); + ASSERT(cput.core.used == 1 + || cput.core.used == cput.logical.used); + ASSERT(cput.processor_node.used == 1 + || cput.processor_node.used == cput.logical.used); + ASSERT(cput.processor.used == 1 + || cput.processor.used == cput.logical.used); + ASSERT(cput.node.used == 1 + || cput.node.used == cput.logical.used); + + for (r = 0; r < cput.logical.used; r++) { + user_cpudata[ix].logical = cput.logical.id[r]; + user_cpudata[ix].thread = + cput.thread.id[cput.thread.used == 1 ? 0 : r]; + user_cpudata[ix].core = + cput.core.id[cput.core.used == 1 ? 0 : r]; + user_cpudata[ix].processor_node = + cput.processor_node.id[cput.processor_node.used == 1 ? 0 : r]; + user_cpudata[ix].processor = + cput.processor.id[cput.processor.used == 1 ? 0 : r]; + user_cpudata[ix].node = + cput.node.id[cput.node.used == 1 ? 0 : r]; + ix++; + } + } while (*c != '\0'); + + if (user_cpudata_size != ix) { + user_cpudata_size = ix; + user_cpudata = erts_realloc(ERTS_ALC_T_CPUDATA, + user_cpudata, + (sizeof(erts_cpu_topology_t) + * user_cpudata_size)); + } + + error = verify_topology(user_cpudata, user_cpudata_size); + if (error == ERTS_INIT_CPU_TOPOLOGY_OK) { + destroy_cpu_top_entry(&cput); + return ERTS_INIT_CPU_TOPOLOGY_OK; + } + + fail: + if (user_cpudata) + erts_free(ERTS_ALC_T_CPUDATA, user_cpudata); + user_cpudata_size = 0; + destroy_cpu_top_entry(&cput); + return error; +} + +#define ERTS_GET_CPU_TOPOLOGY_ERROR -1 +#define ERTS_GET_USED_CPU_TOPOLOGY 0 +#define ERTS_GET_DETECTED_CPU_TOPOLOGY 1 +#define ERTS_GET_DEFINED_CPU_TOPOLOGY 2 + +static Eterm get_cpu_topology_term(Process *c_p, int type); + +Eterm +erts_set_cpu_topology(Process *c_p, Eterm term) +{ + erts_cpu_topology_t *cpudata = NULL; + int cpudata_size = 0; + Eterm res; + + erts_smp_rwmtx_rwlock(&erts_cpu_bind_rwmtx); + res = get_cpu_topology_term(c_p, ERTS_GET_USED_CPU_TOPOLOGY); + if (term == am_undefined) { + if (user_cpudata) + erts_free(ERTS_ALC_T_CPUDATA, user_cpudata); + user_cpudata = NULL; + user_cpudata_size = 0; + + if (cpu_bind_order != ERTS_CPU_BIND_NONE && system_cpudata) { + cpudata_size = system_cpudata_size; + cpudata = erts_alloc(ERTS_ALC_T_TMP, + (sizeof(erts_cpu_topology_t) + * cpudata_size)); + + sys_memcpy((void *) cpudata, + (void *) system_cpudata, + sizeof(erts_cpu_topology_t)*cpudata_size); + } + } + else if (is_not_list(term)) { + error: + res = THE_NON_VALUE; + goto done; + } + else { + Eterm list = term; + int ix = 0; + + cpudata_size = 100; + cpudata = erts_alloc(ERTS_ALC_T_TMP, + (sizeof(erts_cpu_topology_t) + * cpudata_size)); + + while (is_list(list)) { + Eterm *lp = list_val(list); + Eterm cpu = CAR(lp); + Eterm* tp; + Sint id; + + if (is_not_tuple(cpu)) + goto error; + + tp = tuple_val(cpu); + + if (arityval(tp[0]) != 7 || tp[1] != am_cpu) + goto error; + + if (ix >= cpudata_size) { + cpudata_size += 100; + cpudata = erts_realloc(ERTS_ALC_T_TMP, + cpudata, + (sizeof(erts_cpu_topology_t) + * cpudata_size)); + } + + id = signed_val(tp[2]); + if (id < -1 || ERTS_MAX_CPU_TOPOLOGY_ID < id) + goto error; + cpudata[ix].node = (int) id; + + id = signed_val(tp[3]); + if (id < -1 || ERTS_MAX_CPU_TOPOLOGY_ID < id) + goto error; + cpudata[ix].processor = (int) id; + + id = signed_val(tp[4]); + if (id < -1 || ERTS_MAX_CPU_TOPOLOGY_ID < id) + goto error; + cpudata[ix].processor_node = (int) id; + + id = signed_val(tp[5]); + if (id < -1 || ERTS_MAX_CPU_TOPOLOGY_ID < id) + goto error; + cpudata[ix].core = (int) id; + + id = signed_val(tp[6]); + if (id < -1 || ERTS_MAX_CPU_TOPOLOGY_ID < id) + goto error; + cpudata[ix].thread = (int) id; + + id = signed_val(tp[7]); + if (id < -1 || ERTS_MAX_CPU_TOPOLOGY_ID < id) + goto error; + cpudata[ix].logical = (int) id; + + list = CDR(lp); + ix++; + } + + if (is_not_nil(list)) + goto error; + + cpudata_size = ix; + + if (ERTS_INIT_CPU_TOPOLOGY_OK != verify_topology(cpudata, cpudata_size)) + goto error; + + if (user_cpudata_size != cpudata_size) { + if (user_cpudata) + erts_free(ERTS_ALC_T_CPUDATA, user_cpudata); + user_cpudata = erts_alloc(ERTS_ALC_T_CPUDATA, + sizeof(erts_cpu_topology_t)*cpudata_size); + user_cpudata_size = cpudata_size; + } + + sys_memcpy((void *) user_cpudata, + (void *) cpudata, + sizeof(erts_cpu_topology_t)*cpudata_size); + } + + signal_schedulers_bind_change(cpudata, cpudata_size); + + done: + erts_smp_rwmtx_rwunlock(&erts_cpu_bind_rwmtx); + + if (cpudata) + erts_free(ERTS_ALC_T_TMP, cpudata); + + return res; +} + +static Eterm +bound_schedulers_term(ErtsCpuBindOrder order) +{ + switch (order) { + case ERTS_CPU_BIND_SPREAD: { + ERTS_DECL_AM(spread); + return AM_spread; + } + case ERTS_CPU_BIND_PROCESSOR_SPREAD: { + ERTS_DECL_AM(processor_spread); + return AM_processor_spread; + } + case ERTS_CPU_BIND_THREAD_SPREAD: { + ERTS_DECL_AM(thread_spread); + return AM_thread_spread; + } + case ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD: { + ERTS_DECL_AM(thread_no_node_processor_spread); + return AM_thread_no_node_processor_spread; + } + case ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD: { + ERTS_DECL_AM(no_node_processor_spread); + return AM_no_node_processor_spread; + } + case ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD: { + ERTS_DECL_AM(no_node_thread_spread); + return AM_no_node_thread_spread; + } + case ERTS_CPU_BIND_NO_SPREAD: { + ERTS_DECL_AM(no_spread); + return AM_no_spread; + } + case ERTS_CPU_BIND_NONE: { + ERTS_DECL_AM(unbound); + return AM_unbound; + } + default: + ASSERT(0); + return THE_NON_VALUE; + } +} + +Eterm +erts_bound_schedulers_term(Process *c_p) +{ + ErtsCpuBindOrder order; + erts_smp_rwmtx_rlock(&erts_cpu_bind_rwmtx); + order = cpu_bind_order; + erts_smp_rwmtx_runlock(&erts_cpu_bind_rwmtx); + return bound_schedulers_term(order); +} + +static void +create_tmp_cpu_topology_copy(erts_cpu_topology_t **cpudata, int *cpudata_size) +{ + if (user_cpudata) { + *cpudata_size = user_cpudata_size; + *cpudata = erts_alloc(ERTS_ALC_T_TMP, + (sizeof(erts_cpu_topology_t) + * (*cpudata_size))); + sys_memcpy((void *) *cpudata, + (void *) user_cpudata, + sizeof(erts_cpu_topology_t)*(*cpudata_size)); + } + else if (system_cpudata) { + *cpudata_size = system_cpudata_size; + *cpudata = erts_alloc(ERTS_ALC_T_TMP, + (sizeof(erts_cpu_topology_t) + * (*cpudata_size))); + sys_memcpy((void *) *cpudata, + (void *) system_cpudata, + sizeof(erts_cpu_topology_t)*(*cpudata_size)); + } + else { + *cpudata = NULL; + *cpudata_size = 0; + } +} + +static void +destroy_tmp_cpu_topology_copy(erts_cpu_topology_t *cpudata) +{ + if (cpudata) + erts_free(ERTS_ALC_T_TMP, cpudata); +} + +Eterm +erts_bind_schedulers(Process *c_p, Eterm how) +{ + Eterm res; + erts_cpu_topology_t *cpudata; + int cpudata_size; + ErtsCpuBindOrder old_cpu_bind_order; + + erts_smp_rwmtx_rwlock(&erts_cpu_bind_rwmtx); + + if (erts_bind_to_cpu(erts_cpuinfo, -1) == -ENOTSUP) { + ERTS_BIF_PREP_ERROR(res, c_p, EXC_NOTSUP); + } + else { + + old_cpu_bind_order = cpu_bind_order; + + if (ERTS_IS_ATOM_STR("spread", how)) + cpu_bind_order = ERTS_CPU_BIND_SPREAD; + else if (ERTS_IS_ATOM_STR("processor_spread", how)) + cpu_bind_order = ERTS_CPU_BIND_PROCESSOR_SPREAD; + else if (ERTS_IS_ATOM_STR("thread_spread", how)) + cpu_bind_order = ERTS_CPU_BIND_THREAD_SPREAD; + else if (ERTS_IS_ATOM_STR("default_bind", how) + || ERTS_IS_ATOM_STR("thread_no_node_processor_spread", how)) + cpu_bind_order = ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD; + else if (ERTS_IS_ATOM_STR("no_node_processor_spread", how)) + cpu_bind_order = ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD; + else if (ERTS_IS_ATOM_STR("no_node_thread_spread", how)) + cpu_bind_order = ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD; + else if (ERTS_IS_ATOM_STR("no_spread", how)) + cpu_bind_order = ERTS_CPU_BIND_NO_SPREAD; + else if (ERTS_IS_ATOM_STR("unbound", how)) + cpu_bind_order = ERTS_CPU_BIND_NONE; + else { + cpu_bind_order = old_cpu_bind_order; + ERTS_BIF_PREP_ERROR(res, c_p, BADARG); + goto done; + } + + create_tmp_cpu_topology_copy(&cpudata, &cpudata_size); + + if (!cpudata) { + cpu_bind_order = old_cpu_bind_order; + ERTS_BIF_PREP_ERROR(res, c_p, BADARG); + goto done; + } + + signal_schedulers_bind_change(cpudata, cpudata_size); + + destroy_tmp_cpu_topology_copy(cpudata); + + res = bound_schedulers_term(old_cpu_bind_order); + } + + done: + + erts_smp_rwmtx_rwunlock(&erts_cpu_bind_rwmtx); + + return res; +} + +Eterm +erts_fake_scheduler_bindings(Process *p, Eterm how) +{ + ErtsCpuBindOrder fake_cpu_bind_order; + erts_cpu_topology_t *cpudata; + int cpudata_size; + Eterm res; + + if (ERTS_IS_ATOM_STR("spread", how)) + fake_cpu_bind_order = ERTS_CPU_BIND_SPREAD; + else if (ERTS_IS_ATOM_STR("processor_spread", how)) + fake_cpu_bind_order = ERTS_CPU_BIND_PROCESSOR_SPREAD; + else if (ERTS_IS_ATOM_STR("thread_spread", how)) + fake_cpu_bind_order = ERTS_CPU_BIND_THREAD_SPREAD; + else if (ERTS_IS_ATOM_STR("default_bind", how) + || ERTS_IS_ATOM_STR("thread_no_node_processor_spread", how)) + fake_cpu_bind_order = ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD; + else if (ERTS_IS_ATOM_STR("no_node_processor_spread", how)) + fake_cpu_bind_order = ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD; + else if (ERTS_IS_ATOM_STR("no_node_thread_spread", how)) + fake_cpu_bind_order = ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD; + else if (ERTS_IS_ATOM_STR("no_spread", how)) + fake_cpu_bind_order = ERTS_CPU_BIND_NO_SPREAD; + else if (ERTS_IS_ATOM_STR("unbound", how)) + fake_cpu_bind_order = ERTS_CPU_BIND_NONE; + else { + ERTS_BIF_PREP_ERROR(res, p, BADARG); + return res; + } + + erts_smp_rwmtx_rlock(&erts_cpu_bind_rwmtx); + create_tmp_cpu_topology_copy(&cpudata, &cpudata_size); + erts_smp_rwmtx_runlock(&erts_cpu_bind_rwmtx); + + if (!cpudata || fake_cpu_bind_order == ERTS_CPU_BIND_NONE) + ERTS_BIF_PREP_RET(res, am_false); + else { + int i; + Eterm *hp; + + cpu_bind_order_sort(cpudata, cpudata_size, fake_cpu_bind_order, 1); + +#ifdef ERTS_FAKE_SCHED_BIND_PRINT_SORTED_CPU_DATA + + erts_fprintf(stderr, "node: "); + for (i = 0; i < cpudata_size; i++) + erts_fprintf(stderr, " %2d", cpudata[i].node); + erts_fprintf(stderr, "\n"); + erts_fprintf(stderr, "processor: "); + for (i = 0; i < cpudata_size; i++) + erts_fprintf(stderr, " %2d", cpudata[i].processor); + erts_fprintf(stderr, "\n"); + if (fake_cpu_bind_order != ERTS_CPU_BIND_THREAD_NO_NODE_PROCESSOR_SPREAD + && fake_cpu_bind_order != ERTS_CPU_BIND_NO_NODE_PROCESSOR_SPREAD + && fake_cpu_bind_order != ERTS_CPU_BIND_NO_NODE_THREAD_SPREAD) { + erts_fprintf(stderr, "processor_node:"); + for (i = 0; i < cpudata_size; i++) + erts_fprintf(stderr, " %2d", cpudata[i].processor_node); + erts_fprintf(stderr, "\n"); + } + erts_fprintf(stderr, "core: "); + for (i = 0; i < cpudata_size; i++) + erts_fprintf(stderr, " %2d", cpudata[i].core); + erts_fprintf(stderr, "\n"); + erts_fprintf(stderr, "thread: "); + for (i = 0; i < cpudata_size; i++) + erts_fprintf(stderr, " %2d", cpudata[i].thread); + erts_fprintf(stderr, "\n"); + erts_fprintf(stderr, "logical: "); + for (i = 0; i < cpudata_size; i++) + erts_fprintf(stderr, " %2d", cpudata[i].logical); + erts_fprintf(stderr, "\n"); +#endif + + hp = HAlloc(p, cpudata_size+1); + ERTS_BIF_PREP_RET(res, make_tuple(hp)); + *hp++ = make_arityval((Uint) cpudata_size); + for (i = 0; i < cpudata_size; i++) + *hp++ = make_small((Uint) cpudata[i].logical); + } + + destroy_tmp_cpu_topology_copy(cpudata); + + return res; +} + +Eterm +erts_get_schedulers_binds(Process *c_p) +{ + int ix; + ERTS_DECL_AM(unbound); + Eterm *hp = HAlloc(c_p, erts_no_schedulers+1); + Eterm res = make_tuple(hp); + + *(hp++) = make_arityval(erts_no_schedulers); + erts_smp_rwmtx_rlock(&erts_cpu_bind_rwmtx); + for (ix = 1; ix <= erts_no_schedulers; ix++) + *(hp++) = (scheduler2cpu_map[ix].bound_id >= 0 + ? make_small(scheduler2cpu_map[ix].bound_id) + : AM_unbound); + erts_smp_rwmtx_runlock(&erts_cpu_bind_rwmtx); + return res; +} + +static Eterm +bld_topology_term(Eterm **hpp, + Uint *hszp, + erts_cpu_topology_t *cpudata, + int size) +{ + Eterm res = NIL; + int i; + + if (size == 0) + return am_undefined; + + for (i = size-1; i >= 0; i--) { + res = erts_bld_cons(hpp, + hszp, + erts_bld_tuple(hpp, + hszp, + 7, + am_cpu, + make_small(cpudata[i].node), + make_small(cpudata[i].processor), + make_small(cpudata[i].processor_node), + make_small(cpudata[i].core), + make_small(cpudata[i].thread), + make_small(cpudata[i].logical)), + res); + } + return res; +} + +static Eterm +get_cpu_topology_term(Process *c_p, int type) +{ +#ifdef DEBUG + Eterm *hp_end; +#endif + Eterm *hp; + Uint hsz; + Eterm res = THE_NON_VALUE; + erts_cpu_topology_t *cpudata = NULL; + int size = 0; + + switch (type) { + case ERTS_GET_USED_CPU_TOPOLOGY: + if (user_cpudata) + goto defined; + else + goto detected; + case ERTS_GET_DETECTED_CPU_TOPOLOGY: + detected: + if (!system_cpudata) + res = am_undefined; + else { + size = system_cpudata_size; + cpudata = erts_alloc(ERTS_ALC_T_TMP, + (sizeof(erts_cpu_topology_t) + * size)); + sys_memcpy((void *) cpudata, + (void *) system_cpudata, + sizeof(erts_cpu_topology_t)*size); + } + break; + case ERTS_GET_DEFINED_CPU_TOPOLOGY: + defined: + if (!user_cpudata) + res = am_undefined; + else { + size = user_cpudata_size; + cpudata = user_cpudata; + } + break; + default: + erl_exit(ERTS_ABORT_EXIT, "Bad cpu topology type: %d\n", type); + break; + } + + if (res == am_undefined) { + ASSERT(!cpudata); + return res; + } + + hsz = 0; + + bld_topology_term(NULL, &hsz, + cpudata, size); + + hp = HAlloc(c_p, hsz); + +#ifdef DEBUG + hp_end = hp + hsz; +#endif + + res = bld_topology_term(&hp, NULL, + cpudata, size); + + ASSERT(hp_end == hp); + + if (cpudata && cpudata != system_cpudata && cpudata != user_cpudata) + erts_free(ERTS_ALC_T_TMP, cpudata); + + return res; +} + +Eterm +erts_get_cpu_topology_term(Process *c_p, Eterm which) +{ + Eterm res; + int type; + erts_smp_rwmtx_rlock(&erts_cpu_bind_rwmtx); + if (ERTS_IS_ATOM_STR("used", which)) + type = ERTS_GET_USED_CPU_TOPOLOGY; + else if (ERTS_IS_ATOM_STR("detected", which)) + type = ERTS_GET_DETECTED_CPU_TOPOLOGY; + else if (ERTS_IS_ATOM_STR("defined", which)) + type = ERTS_GET_DEFINED_CPU_TOPOLOGY; + else + type = ERTS_GET_CPU_TOPOLOGY_ERROR; + if (type == ERTS_GET_CPU_TOPOLOGY_ERROR) + res = THE_NON_VALUE; + else + res = get_cpu_topology_term(c_p, type); + erts_smp_rwmtx_runlock(&erts_cpu_bind_rwmtx); + return res; +} + +static void +early_cpu_bind_init(void) +{ + user_cpudata = NULL; + user_cpudata_size = 0; + + system_cpudata_size = erts_get_cpu_topology_size(erts_cpuinfo); + system_cpudata = erts_alloc(ERTS_ALC_T_CPUDATA, + (sizeof(erts_cpu_topology_t) + * system_cpudata_size)); + + cpu_bind_order = ERTS_CPU_BIND_NONE; + + if (!erts_get_cpu_topology(erts_cpuinfo, system_cpudata) + || ERTS_INIT_CPU_TOPOLOGY_OK != verify_topology(system_cpudata, + system_cpudata_size)) { + erts_free(ERTS_ALC_T_CPUDATA, system_cpudata); + system_cpudata = NULL; + system_cpudata_size = 0; + } +} + +static void +late_cpu_bind_init(void) +{ + int ix; + + erts_smp_rwmtx_init(&erts_cpu_bind_rwmtx, "cpu_bind"); + + scheduler2cpu_map = erts_alloc(ERTS_ALC_T_CPUDATA, + (sizeof(ErtsCpuBindData) + * (erts_no_schedulers+1))); + for (ix = 1; ix <= erts_no_schedulers; ix++) { + scheduler2cpu_map[ix].bind_id = -1; + scheduler2cpu_map[ix].bound_id = -1; + } + + if (cpu_bind_order != ERTS_CPU_BIND_NONE) { + erts_cpu_topology_t *cpudata; + int cpudata_size; + create_tmp_cpu_topology_copy(&cpudata, &cpudata_size); + ASSERT(cpudata); + signal_schedulers_bind_change(cpudata, cpudata_size); + destroy_tmp_cpu_topology_copy(cpudata); + } +} + +#ifdef ERTS_SMP + +static void +add_pend_suspend(Process *suspendee, + Eterm originator_pid, + void (*handle_func)(Process *, + ErtsProcLocks, + int, + Eterm)) +{ + ErtsPendingSuspend *psp = erts_alloc(ERTS_ALC_T_PEND_SUSPEND, + sizeof(ErtsPendingSuspend)); + psp->next = NULL; +#ifdef DEBUG +#ifdef ARCH_64 + psp->end = (ErtsPendingSuspend *) 0xdeaddeaddeaddead; +#else + psp->end = (ErtsPendingSuspend *) 0xdeaddead; +#endif +#endif + psp->pid = originator_pid; + psp->handle_func = handle_func; + + if (suspendee->pending_suspenders) + suspendee->pending_suspenders->end->next = psp; + else + suspendee->pending_suspenders = psp; + suspendee->pending_suspenders->end = psp; +} + +static void +handle_pending_suspend(Process *p, ErtsProcLocks p_locks) +{ + ErtsPendingSuspend *psp; + int is_alive = !ERTS_PROC_IS_EXITING(p); + + ERTS_SMP_LC_ASSERT(p_locks & ERTS_PROC_LOCK_STATUS); + + /* + * New pending suspenders might appear while we are processing + * (since we may release the status lock on p while processing). + */ + while (p->pending_suspenders) { + psp = p->pending_suspenders; + p->pending_suspenders = NULL; + while (psp) { + ErtsPendingSuspend *free_psp; + (*psp->handle_func)(p, p_locks, is_alive, psp->pid); + free_psp = psp; + psp = psp->next; + erts_free(ERTS_ALC_T_PEND_SUSPEND, (void *) free_psp); + } + } + +} + +static ERTS_INLINE void +cancel_suspend_of_suspendee(Process *p, ErtsProcLocks p_locks) +{ + if (is_not_nil(p->suspendee)) { + Process *rp; + if (!(p_locks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + rp = erts_pid2proc(p, p_locks|ERTS_PROC_LOCK_STATUS, + p->suspendee, ERTS_PROC_LOCK_STATUS); + if (rp) { + erts_resume(rp, ERTS_PROC_LOCK_STATUS); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + } + if (!(p_locks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + p->suspendee = NIL; + } +} + +static void +handle_pend_sync_suspend(Process *suspendee, + ErtsProcLocks suspendee_locks, + int suspendee_alive, + Eterm suspender_pid) +{ + Process *suspender; + + ERTS_SMP_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS); + + suspender = erts_pid2proc(suspendee, + suspendee_locks, + suspender_pid, + ERTS_PROC_LOCK_STATUS); + if (suspender) { + ASSERT(is_nil(suspender->suspendee)); + if (suspendee_alive) { + ErtsRunQueue *rq = erts_get_runq_proc(suspendee); + erts_smp_runq_lock(rq); + suspend_process(rq, suspendee); + erts_smp_runq_unlock(rq); + suspender->suspendee = suspendee->id; + } + /* suspender is suspended waiting for suspendee to suspend; + resume suspender */ + resume_process(suspender); + erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_STATUS); + } +} + +/* + * Like erts_pid2proc() but: + * + * * At least ERTS_PROC_LOCK_MAIN have to be held on c_p. + * * At least ERTS_PROC_LOCK_MAIN have to be taken on pid. + * * It also waits for proc to be in a state != running and garbing. + * * If ERTS_PROC_LOCK_BUSY is returned, the calling process has to + * yield (ERTS_BIF_YIELD[0-3]()). c_p might in this case have been + * suspended. + */ + + +Process * +erts_pid2proc_not_running(Process *c_p, ErtsProcLocks c_p_locks, + Eterm pid, ErtsProcLocks pid_locks) +{ + Process *rp; + int unlock_c_p_status; + + ERTS_SMP_LC_ASSERT(c_p_locks == erts_proc_lc_my_proc_locks(c_p)); + + ERTS_SMP_LC_ASSERT(c_p_locks & ERTS_PROC_LOCK_MAIN); + ERTS_SMP_LC_ASSERT(pid_locks & (ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS)); + + if (c_p->id == pid) + return erts_pid2proc(c_p, c_p_locks, pid, pid_locks); + + if (c_p_locks & ERTS_PROC_LOCK_STATUS) + unlock_c_p_status = 0; + else { + unlock_c_p_status = 1; + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_STATUS); + } + + if (c_p->suspendee == pid) { + /* Process previously suspended by c_p (below)... */ + ErtsProcLocks rp_locks = pid_locks|ERTS_PROC_LOCK_STATUS; + rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, pid, rp_locks); + c_p->suspendee = NIL; + ASSERT(c_p->flags & F_P2PNR_RESCHED); + c_p->flags &= ~F_P2PNR_RESCHED; + if (rp) + resume_process(rp); + } + else { + ErtsRunQueue *cp_rq, *rp_rq; + + rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, + pid, ERTS_PROC_LOCK_STATUS); + + if (!rp) { + c_p->flags &= ~F_P2PNR_RESCHED; + goto done; + } + + ASSERT(!(c_p->flags & F_P2PNR_RESCHED)); + + cp_rq = erts_get_runq_proc(c_p); + rp_rq = erts_get_runq_proc(rp); + erts_smp_runqs_lock(cp_rq, rp_rq); + if (rp->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) { + running: + /* Phiu... */ + + /* + * If we got pending suspenders and suspend ourselves waiting + * to suspend another process we might deadlock. + * In this case we have to yield, be suspended by + * someone else and then do it all over again. + */ + if (!c_p->pending_suspenders) { + /* Mark rp pending for suspend by c_p */ + add_pend_suspend(rp, c_p->id, handle_pend_sync_suspend); + ASSERT(is_nil(c_p->suspendee)); + + /* Suspend c_p; when rp is suspended c_p will be resumed. */ + suspend_process(cp_rq, c_p); + c_p->flags |= F_P2PNR_RESCHED; + } + /* Yield (caller is assumed to yield immediately in bif). */ + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + rp = ERTS_PROC_LOCK_BUSY; + } + else { + ErtsProcLocks need_locks = pid_locks & ~ERTS_PROC_LOCK_STATUS; + if (need_locks && erts_smp_proc_trylock(rp, need_locks) == EBUSY) { + erts_smp_runqs_unlock(cp_rq, rp_rq); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + rp = erts_pid2proc(c_p, c_p_locks|ERTS_PROC_LOCK_STATUS, + pid, pid_locks|ERTS_PROC_LOCK_STATUS); + if (!rp) + goto done; + /* run-queues may have changed */ + cp_rq = erts_get_runq_proc(c_p); + rp_rq = erts_get_runq_proc(rp); + erts_smp_runqs_lock(cp_rq, rp_rq); + if (rp->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) { + /* Ahh... */ + erts_smp_proc_unlock(rp, + pid_locks & ~ERTS_PROC_LOCK_STATUS); + goto running; + } + } + + /* rp is not running and we got the locks we want... */ + } + erts_smp_runqs_unlock(cp_rq, rp_rq); + } + + done: + if (rp && rp != ERTS_PROC_LOCK_BUSY && !(pid_locks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_STATUS); + if (unlock_c_p_status) + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_STATUS); + return rp; +} + +/* + * erts_pid2proc_nropt() is normally the same as + * erts_pid2proc_not_running(). However it is only + * to be used when 'not running' is a pure optimization, + * not a requirement. + */ + +Process * +erts_pid2proc_nropt(Process *c_p, ErtsProcLocks c_p_locks, + Eterm pid, ErtsProcLocks pid_locks) +{ + if (erts_disable_proc_not_running_opt) + return erts_pid2proc(c_p, c_p_locks, pid, pid_locks); + else + return erts_pid2proc_not_running(c_p, c_p_locks, pid, pid_locks); +} + +static ERTS_INLINE void +do_bif_suspend_process(ErtsSuspendMonitor *smon, + Process *suspendee, + ErtsRunQueue *locked_runq) +{ + ASSERT(suspendee); + ASSERT(!suspendee->is_exiting); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS + & erts_proc_lc_my_proc_locks(suspendee)); + if (smon) { + if (!smon->active) { + ErtsRunQueue *rq; + + if (locked_runq) + rq = locked_runq; + else { + rq = erts_get_runq_proc(suspendee); + erts_smp_runq_lock(rq); + } + + suspend_process(rq, suspendee); + + if (!locked_runq) + erts_smp_runq_unlock(rq); + } + smon->active += smon->pending; + ASSERT(smon->active); + smon->pending = 0; + } + +} + +static void +handle_pend_bif_sync_suspend(Process *suspendee, + ErtsProcLocks suspendee_locks, + int suspendee_alive, + Eterm suspender_pid) +{ + Process *suspender; + + ERTS_SMP_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS); + + suspender = erts_pid2proc(suspendee, + suspendee_locks, + suspender_pid, + ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + if (suspender) { + ASSERT(is_nil(suspender->suspendee)); + if (!suspendee_alive) + erts_delete_suspend_monitor(&suspender->suspend_monitors, + suspendee->id); + else { + ErtsSuspendMonitor *smon; + smon = erts_lookup_suspend_monitor(suspender->suspend_monitors, + suspendee->id); + do_bif_suspend_process(smon, suspendee, NULL); + suspender->suspendee = suspendee->id; + } + /* suspender is suspended waiting for suspendee to suspend; + resume suspender */ + resume_process(suspender); + erts_smp_proc_unlock(suspender, + ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS); + } +} + +static void +handle_pend_bif_async_suspend(Process *suspendee, + ErtsProcLocks suspendee_locks, + int suspendee_alive, + Eterm suspender_pid) +{ + + Process *suspender; + + ERTS_SMP_LC_ASSERT(suspendee_locks & ERTS_PROC_LOCK_STATUS); + + suspender = erts_pid2proc(suspendee, + suspendee_locks, + suspender_pid, + ERTS_PROC_LOCK_LINK); + if (suspender) { + ASSERT(is_nil(suspender->suspendee)); + if (!suspendee_alive) + erts_delete_suspend_monitor(&suspender->suspend_monitors, + suspendee->id); + else { + ErtsSuspendMonitor *smon; + smon = erts_lookup_suspend_monitor(suspender->suspend_monitors, + suspendee->id); + do_bif_suspend_process(smon, suspendee, NULL); + } + erts_smp_proc_unlock(suspender, ERTS_PROC_LOCK_LINK); + } +} + +#endif /* ERTS_SMP */ + +/* + * The erlang:suspend_process/2 BIF + */ + +BIF_RETTYPE +suspend_process_2(BIF_ALIST_2) +{ + Eterm res; + Process* suspendee = NULL; + ErtsSuspendMonitor *smon; + ErtsProcLocks xlocks = (ErtsProcLocks) 0; + + /* Options and default values: */ + int asynchronous = 0; + int unless_suspending = 0; + + + if (BIF_P->id == BIF_ARG_1) + goto badarg; /* We are not allowed to suspend ourselves */ + + if (is_not_nil(BIF_ARG_2)) { + /* Parse option list */ + Eterm arg = BIF_ARG_2; + + while (is_list(arg)) { + Eterm *lp = list_val(arg); + arg = CAR(lp); + switch (arg) { + case am_unless_suspending: + unless_suspending = 1; + break; + case am_asynchronous: + asynchronous = 1; + break; + default: + goto badarg; + } + arg = CDR(lp); + } + if (is_not_nil(arg)) + goto badarg; + } + + xlocks = ERTS_PROC_LOCK_LINK | (asynchronous + ? (ErtsProcLocks) 0 + : ERTS_PROC_LOCK_STATUS); + + erts_smp_proc_lock(BIF_P, xlocks); + + suspendee = erts_pid2proc(BIF_P, + ERTS_PROC_LOCK_MAIN|xlocks, + BIF_ARG_1, + ERTS_PROC_LOCK_STATUS); + if (!suspendee) + goto no_suspendee; + + smon = erts_add_or_lookup_suspend_monitor(&BIF_P->suspend_monitors, + BIF_ARG_1); +#ifndef ERTS_SMP /* no ERTS_SMP */ + + /* This is really a piece of cake without SMP support... */ + if (!smon->active) { + suspend_process(erts_common_run_queue, suspendee); + smon->active++; + res = am_true; + } + else if (unless_suspending) + res = am_false; + else if (smon->active == INT_MAX) + goto system_limit; + else { + smon->active++; + res = am_true; + } + +#else /* ERTS_SMP */ + + /* ... but a little trickier with SMP support ... */ + + if (asynchronous) { + /* --- Asynchronous suspend begin ---------------------------------- */ + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_LINK + & erts_proc_lc_my_proc_locks(BIF_P)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS + == erts_proc_lc_my_proc_locks(suspendee)); + + if (smon->active) { + smon->active += smon->pending; + smon->pending = 0; + if (unless_suspending) + res = am_false; + else if (smon->active == INT_MAX) + goto system_limit; + else { + smon->active++; + res = am_true; + } + /* done */ + } + else { + /* We havn't got any active suspends on the suspendee */ + if (smon->pending && unless_suspending) + res = am_false; + else { + ErtsRunQueue *rq; + if (smon->pending == INT_MAX) + goto system_limit; + + smon->pending++; + rq = erts_get_runq_proc(suspendee); + erts_smp_runq_lock(rq); + + if (suspendee->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) + add_pend_suspend(suspendee, + BIF_P->id, + handle_pend_bif_async_suspend); + else + do_bif_suspend_process(smon, suspendee, rq); + erts_smp_runq_unlock(rq); + + res = am_true; + } + /* done */ + } + /* --- Asynchronous suspend end ------------------------------------ */ + } + else /* if (!asynchronous) */ { + /* --- Synchronous suspend begin ----------------------------------- */ + + ERTS_SMP_LC_ASSERT(((ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS) + & erts_proc_lc_my_proc_locks(BIF_P)) + == (ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCK_STATUS)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS + == erts_proc_lc_my_proc_locks(suspendee)); + + if (BIF_P->suspendee == BIF_ARG_1) { + /* We are back after a yield and the suspendee + has been suspended on behalf of us. */ + ASSERT(smon->active >= 1); + BIF_P->suspendee = NIL; + res = (!unless_suspending || smon->active == 1 + ? am_true + : am_false); + /* done */ + } + else if (smon->active) { + if (unless_suspending) + res = am_false; + else { + smon->active++; + res = am_true; + } + /* done */ + } + else { + ErtsRunQueue *cp_rq, *s_rq; + /* We haven't got any active suspends on the suspendee */ + + /* + * If we have pending suspenders and suspend ourselves waiting + * to suspend another process, or suspend another process + * we might deadlock. In this case we have to yield, + * be suspended by someone else, and then do it all over again. + */ + if (BIF_P->pending_suspenders) + goto yield; + + if (!unless_suspending && smon->pending == INT_MAX) + goto system_limit; + if (!unless_suspending || smon->pending == 0) + smon->pending++; + + cp_rq = erts_get_runq_proc(BIF_P); + s_rq = erts_get_runq_proc(suspendee); + erts_smp_runqs_lock(cp_rq, s_rq); + if (!(suspendee->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING)) { + do_bif_suspend_process(smon, suspendee, s_rq); + erts_smp_runqs_unlock(cp_rq, s_rq); + res = (!unless_suspending || smon->active == 1 + ? am_true + : am_false); + /* done */ + } + else { + /* Mark suspendee pending for suspend by BIF_P */ + add_pend_suspend(suspendee, + BIF_P->id, + handle_pend_bif_sync_suspend); + + ASSERT(is_nil(BIF_P->suspendee)); + + /* + * Suspend BIF_P; when suspendee is suspended, BIF_P + * will be resumed and this BIF will be called again. + * This time with BIF_P->suspendee == BIF_ARG_1 (see + * above). + */ + suspend_process(cp_rq, BIF_P); + erts_smp_runqs_unlock(cp_rq, s_rq); + goto yield; + } + } + /* --- Synchronous suspend end ------------------------------------- */ + } + +#endif /* ERTS_SMP */ + + ASSERT(suspendee->status == P_SUSPENDED || (asynchronous && smon->pending)); + ASSERT(suspendee->status == P_SUSPENDED || !smon->active); + + erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); + erts_smp_proc_unlock(BIF_P, xlocks); + BIF_RET(res); + + system_limit: + ERTS_BIF_PREP_ERROR(res, BIF_P, SYSTEM_LIMIT); + goto do_return; + + no_suspendee: +#ifdef ERTS_SMP + BIF_P->suspendee = NIL; +#endif + erts_delete_suspend_monitor(&BIF_P->suspend_monitors, BIF_ARG_1); + + badarg: + ERTS_BIF_PREP_ERROR(res, BIF_P, BADARG); +#ifdef ERTS_SMP + goto do_return; + + yield: + ERTS_BIF_PREP_YIELD2(res, bif_export[BIF_suspend_process_2], + BIF_P, BIF_ARG_1, BIF_ARG_2); +#endif + + do_return: + if (suspendee) + erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); + if (xlocks) + erts_smp_proc_unlock(BIF_P, xlocks); + return res; + +} + + +/* + * The erlang:resume_process/1 BIF + */ + +BIF_RETTYPE +resume_process_1(BIF_ALIST_1) +{ + ErtsSuspendMonitor *smon; + Process *suspendee; + int is_active; + + if (BIF_P->id == BIF_ARG_1) + BIF_ERROR(BIF_P, BADARG); + + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_LINK); + smon = erts_lookup_suspend_monitor(BIF_P->suspend_monitors, BIF_ARG_1); + + if (!smon) { + /* No previous suspend or dead suspendee */ + goto error; + } + else if (smon->pending) { + smon->pending--; + ASSERT(smon->pending >= 0); + if (smon->active) { + smon->active += smon->pending; + smon->pending = 0; + } + is_active = smon->active; + } + else if (smon->active) { + smon->active--; + ASSERT(smon->pending >= 0); + is_active = 1; + } + else { + /* No previous suspend or dead suspendee */ + goto error; + } + + if (smon->active || smon->pending || !is_active) { + /* Leave the suspendee as it is; just verify that it is still alive */ + suspendee = erts_pid2proc(BIF_P, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, + BIF_ARG_1, + 0); + if (!suspendee) + goto no_suspendee; + + } + else { + /* Resume */ + suspendee = erts_pid2proc(BIF_P, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_LINK, + BIF_ARG_1, + ERTS_PROC_LOCK_STATUS); + if (!suspendee) + goto no_suspendee; + + ASSERT(suspendee->status == P_SUSPENDED + || (suspendee->status == P_GARBING + && suspendee->gcstatus == P_SUSPENDED)); + resume_process(suspendee); + + erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); + } + + if (!smon->active && !smon->pending) + erts_delete_suspend_monitor(&BIF_P->suspend_monitors, BIF_ARG_1); + + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + + BIF_RET(am_true); + + no_suspendee: + /* cleanup */ + erts_delete_suspend_monitor(&BIF_P->suspend_monitors, BIF_ARG_1); + + error: + erts_smp_proc_unlock(BIF_P, ERTS_PROC_LOCK_LINK); + BIF_ERROR(BIF_P, BADARG); +} + +Uint +erts_run_queues_len(Uint *qlen) +{ + int i = 0; + Uint len = 0; + ERTS_ATOMIC_FOREACH_RUNQ(rq, + { + if (qlen) + qlen[i++] = rq->procs.len; + len += rq->procs.len; + } + ); + return len; +} + +#ifdef HARDDEBUG_RUNQS +static void +check_procs_runq(ErtsRunQueue *runq, Process *p_in_q, Process *p_not_in_q) +{ + int len[ERTS_NO_PROC_PRIO_LEVELS] = {0}; + int tot_len; + int prioq, prio; + int found_p_in_q; + Process *p, *prevp; + + found_p_in_q = 0; + for (prioq = 0; prioq < ERTS_NO_PROC_PRIO_LEVELS - 1; prioq++) { + prevp = NULL; + for (p = runq->procs.prio[prioq].first; p; p = p->next) { + ASSERT(p != p_not_in_q); + if (p == p_in_q) + found_p_in_q = 1; + switch (p->prio) { + case PRIORITY_MAX: + case PRIORITY_HIGH: + case PRIORITY_NORMAL: + ASSERT(prioq == p->prio); + break; + case PRIORITY_LOW: + ASSERT(prioq == PRIORITY_NORMAL); + break; + default: + ASSERT(!"Bad prio on process"); + } + len[p->prio]++; + ASSERT(prevp == p->prev); + if (p->prev) { + ASSERT(p->prev->next == p); + } + else { + ASSERT(runq->procs.prio[prioq].first == p); + } + if (p->next) { + ASSERT(p->next->prev == p); + } + else { + ASSERT(runq->procs.prio[prioq].last == p); + } + ASSERT(p->run_queue == runq); + prevp = p; + } + } + + ASSERT(!p_in_q || found_p_in_q); + + tot_len = 0; + for (prio = 0; prio < ERTS_NO_PROC_PRIO_LEVELS; prio++) { + ASSERT(len[prio] == runq->procs.prio_info[prio].len); + if (len[prio]) { + ASSERT(runq->flags & (1 << prio)); + } + else { + ASSERT(!(runq->flags & (1 << prio))); + } + tot_len += len[prio]; + } + ASSERT(runq->procs.len == tot_len); +} +# define ERTS_DBG_CHK_PROCS_RUNQ(RQ) check_procs_runq((RQ), NULL, NULL) +# define ERTS_DBG_CHK_PROCS_RUNQ_PROC(RQ, P) check_procs_runq((RQ), (P), NULL) +# define ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(RQ, P) check_procs_runq((RQ), NULL, (P)) +#else +# define ERTS_DBG_CHK_PROCS_RUNQ(RQ) +# define ERTS_DBG_CHK_PROCS_RUNQ_PROC(RQ, P) +# define ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(RQ, P) +#endif + + +static ERTS_INLINE void +enqueue_process(ErtsRunQueue *runq, Process *p) +{ + ErtsRunPrioQueue *rpq; + ErtsRunQueueInfo *rqi; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + + ASSERT(p->bound_runq || !(runq->flags & ERTS_RUNQ_FLG_SUSPENDED)); + + rqi = &runq->procs.prio_info[p->prio]; + rqi->len++; + if (rqi->max_len < rqi->len) + rqi->max_len = rqi->len; + + runq->procs.len++; + runq->len++; + if (runq->max_len < runq->len) + runq->max_len = runq->len; + + runq->flags |= (1 << p->prio); + + rpq = (p->prio == PRIORITY_LOW + ? &runq->procs.prio[PRIORITY_NORMAL] + : &runq->procs.prio[p->prio]); + + p->next = NULL; + p->prev = rpq->last; + if (rpq->last) + rpq->last->next = p; + else + rpq->first = p; + rpq->last = p; + + switch (p->status) { + case P_EXITING: + break; + case P_GARBING: + p->gcstatus = P_RUNABLE; + break; + default: + p->status = P_RUNABLE; + break; + } + +#ifdef ERTS_SMP + p->status_flags |= ERTS_PROC_SFLG_INRUNQ; +#endif + + ERTS_DBG_CHK_PROCS_RUNQ_PROC(runq, p); +} + + +static ERTS_INLINE int +dequeue_process(ErtsRunQueue *runq, Process *p) +{ + ErtsRunPrioQueue *rpq; + int res = 1; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + + ERTS_DBG_CHK_PROCS_RUNQ(runq); + + rpq = &runq->procs.prio[p->prio == PRIORITY_LOW ? PRIORITY_NORMAL : p->prio]; + if (p->prev) { + p->prev->next = p->next; + } + else if (rpq->first == p) { + rpq->first = p->next; + } + else { + res = 0; + } + if (p->next) { + p->next->prev = p->prev; + } + else if (rpq->last == p) { + rpq->last = p->prev; + } + else { + ASSERT(res == 0); + } + + if (res) { + + if (--runq->procs.prio_info[p->prio].len == 0) + runq->flags &= ~(1 << p->prio); + runq->procs.len--; + runq->len--; + +#ifdef ERTS_SMP + p->status_flags &= ~ERTS_PROC_SFLG_INRUNQ; +#endif + } + + ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p); + return res; +} + +/* schedule a process */ +static ERTS_INLINE void +internal_add_to_runq(ErtsRunQueue *runq, Process *p) +{ + Uint32 prev_status = p->status; + ErtsRunQueue *add_runq; +#ifdef ERTS_SMP + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + + if (p->status_flags & ERTS_PROC_SFLG_INRUNQ) + return; + else if (p->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) { + ASSERT(p->status != P_SUSPENDED); + ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p); + p->status_flags |= ERTS_PROC_SFLG_PENDADD2SCHEDQ; + return; + } + ASSERT(!p->scheduler_data); +#endif + + ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(runq, p); +#ifndef ERTS_SMP + /* Never schedule a suspended process (ok in smp case) */ + ASSERT(p->status != P_SUSPENDED); + add_runq = runq; + +#else + ASSERT(!p->bound_runq || p->bound_runq == p->run_queue); + if (p->bound_runq) { + if (p->bound_runq == runq) + add_runq = runq; + else { + add_runq = p->bound_runq; + erts_smp_xrunq_lock(runq, add_runq); + } + } + else { + add_runq = erts_check_emigration_need(runq, p->prio); + if (!add_runq) + add_runq = runq; + else /* Process emigrated */ + p->run_queue = add_runq; + } +#endif + + /* Enqueue the process */ + enqueue_process(add_runq, p); + + if ((erts_system_profile_flags.runnable_procs) + && (prev_status == P_WAITING + || prev_status == P_SUSPENDED)) { + profile_runnable_proc(p, am_active); + } + + smp_notify_inc_runq(add_runq); + + if (add_runq != runq) + erts_smp_runq_unlock(add_runq); +} + + +void +erts_add_to_runq(Process *p) +{ + ErtsRunQueue *runq = erts_get_runq_proc(p); + erts_smp_runq_lock(runq); + internal_add_to_runq(runq, p); + erts_smp_runq_unlock(runq); +} + +/* Possibly remove a scheduled process we need to suspend */ + +static int +remove_proc_from_runq(ErtsRunQueue *rq, Process *p, int to_inactive) +{ + int res; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + +#ifdef ERTS_SMP + if (p->status_flags & ERTS_PROC_SFLG_PENDADD2SCHEDQ) { + p->status_flags &= ~ERTS_PROC_SFLG_PENDADD2SCHEDQ; + ASSERT(!remove_proc_from_runq(rq, p, 0)); + return 1; + } +#endif + + res = dequeue_process(rq, p); + + if (res && erts_system_profile_flags.runnable_procs && to_inactive) + profile_runnable_proc(p, am_inactive); + +#ifdef ERTS_SMP + ASSERT(!(p->status_flags & ERTS_PROC_SFLG_INRUNQ)); +#endif + + return res; +} + +#ifdef ERTS_SMP + +ErtsMigrateResult +erts_proc_migrate(Process *p, ErtsProcLocks *plcks, + ErtsRunQueue *from_rq, int *from_locked, + ErtsRunQueue *to_rq, int *to_locked) +{ + ERTS_SMP_LC_ASSERT(*plcks == erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT((ERTS_PROC_LOCK_STATUS & *plcks) + || from_locked); + ERTS_SMP_LC_CHK_RUNQ_LOCK(from_rq, *from_locked); + ERTS_SMP_LC_CHK_RUNQ_LOCK(to_rq, *to_locked); + + ASSERT(!erts_common_run_queue); + + /* + * If we have the lock on the run queue to migrate to, + * check that it isn't suspended. If it is suspended, + * we will refuse to migrate to it anyway. + */ + if (*to_locked && (to_rq->flags & ERTS_RUNQ_FLG_SUSPENDED)) + return ERTS_MIGRATE_FAILED_RUNQ_SUSPENDED; + + /* We need status lock on process and locks on both run queues */ + + if (!(ERTS_PROC_LOCK_STATUS & *plcks)) { + if (erts_smp_proc_trylock(p, ERTS_PROC_LOCK_STATUS) == EBUSY) { + ErtsProcLocks lcks = *plcks; + Eterm pid = p->id; + Process *proc = *plcks ? p : NULL; + + if (*from_locked) { + *from_locked = 0; + erts_smp_runq_unlock(from_rq); + } + if (*to_locked) { + *to_locked = 0; + erts_smp_runq_unlock(to_rq); + } + + proc = erts_pid2proc_opt(proc, + lcks, + pid, + lcks|ERTS_PROC_LOCK_STATUS, + ERTS_P2P_FLG_ALLOW_OTHER_X); + if (!proc) { + *plcks = 0; + return ERTS_MIGRATE_FAILED_NOT_IN_RUNQ; + } + ASSERT(proc == p); + } + *plcks |= ERTS_PROC_LOCK_STATUS; + } + + ASSERT(!p->bound_runq); + + ERTS_SMP_LC_CHK_RUNQ_LOCK(from_rq, *from_locked); + ERTS_SMP_LC_CHK_RUNQ_LOCK(to_rq, *to_locked); + + if (p->run_queue != from_rq) + return ERTS_MIGRATE_FAILED_RUNQ_CHANGED; + + if (!*from_locked || !*to_locked) { + if (from_rq < to_rq) { + if (!*to_locked) { + if (!*from_locked) + erts_smp_runq_lock(from_rq); + erts_smp_runq_lock(to_rq); + } + else if (erts_smp_runq_trylock(from_rq) == EBUSY) { + erts_smp_runq_unlock(to_rq); + erts_smp_runq_lock(from_rq); + erts_smp_runq_lock(to_rq); + } + } + else { + if (!*from_locked) { + if (!*to_locked) + erts_smp_runq_lock(to_rq); + erts_smp_runq_lock(from_rq); + } + else if (erts_smp_runq_trylock(to_rq) == EBUSY) { + erts_smp_runq_unlock(from_rq); + erts_smp_runq_lock(to_rq); + erts_smp_runq_lock(from_rq); + } + } + *to_locked = *from_locked = 1; + } + + ERTS_SMP_LC_CHK_RUNQ_LOCK(from_rq, *from_locked); + ERTS_SMP_LC_CHK_RUNQ_LOCK(to_rq, *to_locked); + + /* Ok we now got all locks we need; do it... */ + + /* Refuse to migrate to a suspended run queue */ + if (to_rq->flags & ERTS_RUNQ_FLG_SUSPENDED) + return ERTS_MIGRATE_FAILED_RUNQ_SUSPENDED; + + if ((p->runq_flags & ERTS_PROC_RUNQ_FLG_RUNNING) + || !(p->status_flags & ERTS_PROC_SFLG_INRUNQ)) + return ERTS_MIGRATE_FAILED_NOT_IN_RUNQ; + + dequeue_process(from_rq, p); + p->run_queue = to_rq; + enqueue_process(to_rq, p); + + return ERTS_MIGRATE_SUCCESS; +} +#endif /* ERTS_SMP */ + +Eterm +erts_process_status(Process *c_p, ErtsProcLocks c_p_locks, + Process *rp, Eterm rpid) +{ + Eterm res = am_undefined; + Process *p; + + if (rp) { + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS + & erts_proc_lc_my_proc_locks(rp)); + p = rp; + } + else { + p = erts_pid2proc_opt(c_p, c_p_locks, + rpid, ERTS_PROC_LOCK_STATUS, + ERTS_P2P_FLG_ALLOW_OTHER_X); + } + + if (p) { + switch (p->status) { + case P_RUNABLE: + res = am_runnable; + break; + case P_WAITING: + res = am_waiting; + break; + case P_RUNNING: + res = am_running; + break; + case P_EXITING: + res = am_exiting; + break; + case P_GARBING: + res = am_garbage_collecting; + break; + case P_SUSPENDED: + res = am_suspended; + break; + case P_FREE: /* We cannot look up a process in P_FREE... */ + default: /* Not a valid status... */ + erl_exit(1, "Bad status (%b32u) found for process %T\n", + p->status, p->id); + break; + } + +#ifdef ERTS_SMP + if (!rp && (p != c_p || !(ERTS_PROC_LOCK_STATUS & c_p_locks))) + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + } + else { + int i; + ErtsSchedulerData *esdp; + + if (erts_common_run_queue) + erts_smp_runq_lock(erts_common_run_queue); + + for (i = 0; i < erts_no_schedulers; i++) { + esdp = ERTS_SCHEDULER_IX(i); + if (!erts_common_run_queue) + erts_smp_runq_lock(esdp->run_queue); + if (esdp->free_process && esdp->free_process->id == rpid) { + res = am_free; + if (!erts_common_run_queue) + erts_smp_runq_unlock(esdp->run_queue); + break; + } + if (!erts_common_run_queue) + erts_smp_runq_unlock(esdp->run_queue); + } + + if (erts_common_run_queue) + erts_smp_runq_unlock(erts_common_run_queue); +#endif + + } + + return res; +} + +/* +** Suspend a process +** If we are to suspend on a port the busy_port is the thing +** otherwise busy_port is NIL +*/ + +void +erts_suspend(Process* process, ErtsProcLocks process_locks, Port *busy_port) +{ + ErtsRunQueue *rq; + + ERTS_SMP_LC_ASSERT(process_locks == erts_proc_lc_my_proc_locks(process)); + if (!(process_locks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_lock(process, ERTS_PROC_LOCK_STATUS); + + rq = erts_get_runq_proc(process); + + erts_smp_runq_lock(rq); + + suspend_process(rq, process); + + erts_smp_runq_unlock(rq); + + if (busy_port) + erts_wake_process_later(busy_port, process); + + if (!(process_locks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(process, ERTS_PROC_LOCK_STATUS); + +} + +void +erts_resume(Process* process, ErtsProcLocks process_locks) +{ + ERTS_SMP_LC_ASSERT(process_locks == erts_proc_lc_my_proc_locks(process)); + if (!(process_locks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_lock(process, ERTS_PROC_LOCK_STATUS); + resume_process(process); + if (!(process_locks & ERTS_PROC_LOCK_STATUS)) + erts_smp_proc_unlock(process, ERTS_PROC_LOCK_STATUS); +} + +int +erts_resume_processes(ErtsProcList *plp) +{ + int nresumed = 0; + while (plp) { + Process *proc; + ErtsProcList *fplp; + ASSERT(is_internal_pid(plp->pid)); + proc = erts_pid2proc(NULL, 0, plp->pid, ERTS_PROC_LOCK_STATUS); + if (proc) { + if (proclist_same(plp, proc)) { + resume_process(proc); + nresumed++; + } + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_STATUS); + } + fplp = plp; + plp = plp->next; + proclist_destroy(fplp); + } + return nresumed; +} + +Eterm +erts_get_process_priority(Process *p) +{ + ErtsRunQueue *rq; + Eterm value; + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + rq = erts_get_runq_proc(p); + erts_smp_runq_lock(rq); + switch(p->prio) { + case PRIORITY_MAX: value = am_max; break; + case PRIORITY_HIGH: value = am_high; break; + case PRIORITY_NORMAL: value = am_normal; break; + case PRIORITY_LOW: value = am_low; break; + default: ASSERT(0); value = am_undefined; break; + } + erts_smp_runq_unlock(rq); + return value; +} + +Eterm +erts_set_process_priority(Process *p, Eterm new_value) +{ + ErtsRunQueue *rq; + Eterm old_value; + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + rq = erts_get_runq_proc(p); +#ifdef ERTS_SMP + ASSERT(!(p->status_flags & ERTS_PROC_SFLG_INRUNQ)); +#endif + erts_smp_runq_lock(rq); + switch(p->prio) { + case PRIORITY_MAX: old_value = am_max; break; + case PRIORITY_HIGH: old_value = am_high; break; + case PRIORITY_NORMAL: old_value = am_normal; break; + case PRIORITY_LOW: old_value = am_low; break; + default: ASSERT(0); old_value = am_undefined; break; + } + switch (new_value) { + case am_max: p->prio = PRIORITY_MAX; break; + case am_high: p->prio = PRIORITY_HIGH; break; + case am_normal: p->prio = PRIORITY_NORMAL; break; + case am_low: p->prio = PRIORITY_LOW; break; + default: old_value = THE_NON_VALUE; break; + } + erts_smp_runq_unlock(rq); + return old_value; +} + +#ifdef ERTS_SMP + +static ERTS_INLINE int +prepare_for_sys_schedule(void) +{ + while (!erts_port_task_have_outstanding_io_tasks() + && !erts_smp_atomic_xchg(&doing_sys_schedule, 1)) { + if (!erts_port_task_have_outstanding_io_tasks()) + return 1; + erts_smp_atomic_set(&doing_sys_schedule, 0); + } + return 0; +} + +#else + +static ERTS_INLINE int +prepare_for_sys_schedule(void) +{ + return !erts_port_task_have_outstanding_io_tasks(); +} + +#endif + +/* note that P_RUNNING is only set so that we don't try to remove +** running processes from the schedule queue if they exit - a running +** process not being in the schedule queue!! +** Schedule for up to INPUT_REDUCTIONS context switches, +** return 1 if more to do. +*/ + +/* + * schedule() is called from BEAM (process_main()) or HiPE + * (hipe_mode_switch()) when the current process is to be + * replaced by a new process. 'calls' is the number of reduction + * steps the current process consumed. + * schedule() returns the new process, and the new process' + * ->fcalls field is initialised with its allowable number of + * reduction steps. + * + * When no process is runnable, or when sufficiently many reduction + * steps have been made, schedule() calls erl_sys_schedule() to + * schedule system-level activities. + * + * We use the same queue for normal and low prio processes. + * We reschedule low prio processes a certain number of times + * so that normal processes get to run more frequently. + */ + +Process *schedule(Process *p, int calls) +{ + ErtsRunQueue *rq; + ErtsRunPrioQueue *rpq; + long dt; + ErtsSchedulerData *esdp; + int context_reds; + long fcalls; + int input_reductions; + int actual_reds; + int reds; + + if (ERTS_USE_MODIFIED_TIMING()) { + context_reds = ERTS_MODIFIED_TIMING_CONTEXT_REDS; + input_reductions = ERTS_MODIFIED_TIMING_INPUT_REDS; + } + else { + context_reds = CONTEXT_REDS; + input_reductions = INPUT_REDUCTIONS; + } + + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + + /* + * Clean up after the process being scheduled out. + */ + if (!p) { /* NULL in the very first schedule() call */ + esdp = erts_get_scheduler_data(); + rq = erts_get_runq_current(esdp); + ASSERT(esdp); + fcalls = erts_smp_atomic_read(&function_calls); + actual_reds = reds = 0; + erts_smp_runq_lock(rq); + } else { +#ifdef ERTS_SMP + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + esdp = p->scheduler_data; + ASSERT(esdp->current_process == p + || esdp->free_process == p); +#else + esdp = erts_scheduler_data; + ASSERT(esdp->current_process == p); +#endif + reds = actual_reds = calls - esdp->virtual_reds; + if (reds < ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST) + reds = ERTS_PROC_MIN_CONTEXT_SWITCH_REDS_COST; + esdp->virtual_reds = 0; + + fcalls = erts_smp_atomic_addtest(&function_calls, reds); + ASSERT(esdp && esdp == erts_get_scheduler_data()); + + rq = erts_get_runq_current(esdp); + + p->reds += actual_reds; + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + + if ((erts_system_profile_flags.runnable_procs) + && (p->status == P_WAITING)) { + profile_runnable_proc(p, am_inactive); + } + + if (IS_TRACED(p)) { + switch (p->status) { + case P_EXITING: + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) + trace_sched(p, am_out_exiting); + break; + case P_FREE: + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) + trace_sched(p, am_out_exited); + break; + default: + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED)) + trace_sched(p, am_out); + else if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) + trace_virtual_sched(p, am_out); + break; + } + } + +#ifdef ERTS_SMP + if (ERTS_PROC_PENDING_EXIT(p)) { + erts_handle_pending_exit(p, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + p->status_flags |= ERTS_PROC_SFLG_PENDADD2SCHEDQ; + } + + if (p->pending_suspenders) { + handle_pending_suspend(p, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + ASSERT(!(p->status_flags & ERTS_PROC_SFLG_PENDADD2SCHEDQ) + || p->status != P_SUSPENDED); + } +#endif + erts_smp_runq_lock(rq); + + ERTS_PROC_REDUCTIONS_EXECUTED(rq, p->prio, reds, actual_reds); + + esdp->current_process = NULL; +#ifdef ERTS_SMP + p->scheduler_data = NULL; + p->runq_flags &= ~ERTS_PROC_RUNQ_FLG_RUNNING; + p->status_flags &= ~ERTS_PROC_SFLG_RUNNING; + + if (p->status_flags & ERTS_PROC_SFLG_PENDADD2SCHEDQ) { + p->status_flags &= ~ERTS_PROC_SFLG_PENDADD2SCHEDQ; + internal_add_to_runq(rq, p); + } +#endif + + + if (p->status == P_FREE) { +#ifdef ERTS_SMP + ASSERT(esdp->free_process == p); + esdp->free_process = NULL; + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + erts_smp_proc_dec_refc(p); +#else + erts_free_proc(p); +#endif + } else { + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + } + +#ifdef ERTS_SMP + { + ErtsProcList *pnd_xtrs = rq->procs.pending_exiters; + rq->procs.pending_exiters = NULL; + + if (pnd_xtrs) { + erts_smp_runq_unlock(rq); + handle_pending_exiters(pnd_xtrs); + erts_smp_runq_lock(rq); + } + + } + ASSERT(!esdp->free_process); +#endif + ASSERT(!esdp->current_process); + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + dt = do_time_read_and_reset(); + if (dt) { + erts_smp_runq_unlock(rq); + bump_timer(dt); + erts_smp_runq_lock(rq); + } + BM_STOP_TIMER(system); + + } + + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + check_activities_to_run: { + +#ifdef ERTS_SMP + + if (!(rq->flags & ERTS_RUNQ_FLG_SHARED_RUNQ) + && rq->check_balance_reds <= 0) { + check_balance(rq); + } + + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + + if (rq->flags & ERTS_RUNQ_FLGS_IMMIGRATE_QMASK) + immigrate(rq); + + continue_check_activities_to_run: + + if (rq->flags & (ERTS_RUNQ_FLG_SHARED_RUNQ + | ERTS_RUNQ_FLG_CHK_CPU_BIND + | ERTS_RUNQ_FLG_SUSPENDED)) { + if ((rq->flags & ERTS_RUNQ_FLG_SUSPENDED) + || erts_smp_atomic_read(&esdp->suspended)) { + suspend_scheduler(esdp); + } + if ((rq->flags & ERTS_RUNQ_FLG_CHK_CPU_BIND) + || erts_smp_atomic_read(&esdp->chk_cpu_bind)) { + check_cpu_bind(esdp); + } + } + +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN + if (esdp->check_children) { + esdp->check_children = 0; + erts_smp_runq_unlock(rq); + erts_check_children(); + erts_smp_runq_lock(rq); + } +#endif + + erts_smp_chk_system_block(prepare_for_block, + resume_after_block, + (void *) rq); + + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + +#endif + + ASSERT(rq->len == rq->procs.len + rq->ports.info.len); + +#ifndef ERTS_SMP + + if (rq->len == 0 && !rq->misc.start) + goto do_sys_schedule; + +#else /* ERTS_SMP */ + if (rq->len == 0 && !rq->misc.start) { + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq)); + + rq->wakeup_other = 0; + rq->wakeup_other_reds = 0; + + empty_runq(rq); + + if (rq->flags & (ERTS_RUNQ_FLG_SHARED_RUNQ + | ERTS_RUNQ_FLG_SUSPENDED)) { + if ((rq->flags & ERTS_RUNQ_FLG_SUSPENDED) + || erts_smp_atomic_read(&esdp->suspended)) { + non_empty_runq(rq); + goto continue_check_activities_to_run; + } + } + else if (!(rq->flags & ERTS_RUNQ_FLG_INACTIVE)) { + /* + * Check for ERTS_RUNQ_FLG_SUSPENDED has to be done + * after trying to steal a task. + */ + if (try_steal_task(rq) + || (rq->flags & ERTS_RUNQ_FLG_SUSPENDED)) { + non_empty_runq(rq); + goto continue_check_activities_to_run; + } + } + + if (prepare_for_sys_schedule()) { + erts_smp_atomic_set(&function_calls, 0); + fcalls = 0; + sched_sys_wait(esdp->no, rq); + erts_smp_atomic_set(&doing_sys_schedule, 0); + } + else { + /* If all schedulers are waiting, one of them *should* + be waiting in erl_sys_schedule() */ + sched_cnd_wait(esdp->no, rq); + } + + non_empty_runq(rq); + + goto check_activities_to_run; + } + else +#endif /* ERTS_SMP */ + if (fcalls > input_reductions && prepare_for_sys_schedule()) { + int runnable; + +#ifdef ERTS_SMP + runnable = 1; +#else + do_sys_schedule: + runnable = rq->len != 0; + if (!runnable) + sched_waiting_sys(esdp->no, rq); +#endif + + /* + * Schedule system-level activities. + */ + + erts_smp_atomic_set(&function_calls, 0); + fcalls = 0; + ASSERT(!erts_port_task_have_outstanding_io_tasks()); +#ifdef ERTS_SMP + /* erts_sys_schedule_interrupt(0); */ +#endif + erts_smp_runq_unlock(rq); + erl_sys_schedule(runnable); + dt = do_time_read_and_reset(); + if (dt) bump_timer(dt); +#ifdef ERTS_SMP + erts_smp_runq_lock(rq); + erts_smp_atomic_set(&doing_sys_schedule, 0); + goto continue_check_activities_to_run; +#else + if (!runnable) + sched_active_sys(esdp->no, rq); + goto check_activities_to_run; +#endif + } + + if (rq->misc.start) + exec_misc_ops(rq); + +#ifdef ERTS_SMP + { + int wo_reds = rq->wakeup_other_reds; + if (wo_reds) { + if (rq->len < 2) { + rq->wakeup_other -= ERTS_WAKEUP_OTHER_DEC*wo_reds; + if (rq->wakeup_other < 0) + rq->wakeup_other = 0; + } + else if (rq->wakeup_other < ERTS_WAKEUP_OTHER_LIMIT) + rq->wakeup_other += rq->len*wo_reds + ERTS_WAKEUP_OTHER_FIXED_INC; + else { + if (erts_common_run_queue) { + if (erts_common_run_queue->waiting) + wake_one_scheduler(); + } + else if (erts_smp_atomic_read(&no_empty_run_queues) != 0) { + wake_scheduler_on_empty_runq(rq); + rq->wakeup_other = 0; + } + rq->wakeup_other = 0; + } + } + rq->wakeup_other_reds = 0; + } +#endif + + /* + * Find a new port to run. + */ + + if (rq->ports.info.len) { + int have_outstanding_io; + have_outstanding_io = erts_port_task_execute(rq, &esdp->current_port); + if (have_outstanding_io && fcalls > 2*input_reductions) { + /* + * If we have performed more than 2*INPUT_REDUCTIONS since + * last call to erl_sys_schedule() and we still haven't + * handled all I/O tasks we stop running processes and + * focus completely on ports. + * + * One could argue that this is a strange behavior. The + * reason for doing it this way is that it is similar + * to the behavior before port tasks were introduced. + * We don't want to change the behavior too much, at + * least not at the time of writing. This behavior + * might change in the future. + * + * /rickard + */ + goto check_activities_to_run; + } + } + + /* + * Find a new process to run. + */ + pick_next_process: + + ERTS_DBG_CHK_PROCS_RUNQ(rq); + + switch (rq->flags & ERTS_RUNQ_FLGS_PROCS_QMASK) { + case MAX_BIT: + case MAX_BIT|HIGH_BIT: + case MAX_BIT|NORMAL_BIT: + case MAX_BIT|LOW_BIT: + case MAX_BIT|HIGH_BIT|NORMAL_BIT: + case MAX_BIT|HIGH_BIT|LOW_BIT: + case MAX_BIT|NORMAL_BIT|LOW_BIT: + case MAX_BIT|HIGH_BIT|NORMAL_BIT|LOW_BIT: + rpq = &rq->procs.prio[PRIORITY_MAX]; + break; + case HIGH_BIT: + case HIGH_BIT|NORMAL_BIT: + case HIGH_BIT|LOW_BIT: + case HIGH_BIT|NORMAL_BIT|LOW_BIT: + rpq = &rq->procs.prio[PRIORITY_HIGH]; + break; + case NORMAL_BIT: + rpq = &rq->procs.prio[PRIORITY_NORMAL]; + break; + case LOW_BIT: + rpq = &rq->procs.prio[PRIORITY_NORMAL]; + break; + case NORMAL_BIT|LOW_BIT: + rpq = &rq->procs.prio[PRIORITY_NORMAL]; + ASSERT(rpq->first != NULL); + p = rpq->first; + if (p->prio == PRIORITY_LOW) { + if (p == rpq->last || p->skipped >= RESCHEDULE_LOW-1) + p->skipped = 0; + else { + /* skip it */ + p->skipped++; + rpq->first = p->next; + rpq->first->prev = NULL; + rpq->last->next = p; + p->prev = rpq->last; + p->next = NULL; + rpq->last = p; + goto pick_next_process; + } + } + break; + case 0: /* No process at all */ + default: + ASSERT((rq->flags & ERTS_RUNQ_FLGS_PROCS_QMASK) == 0); + ASSERT(rq->procs.len == 0); + goto check_activities_to_run; + } + + BM_START_TIMER(system); + + /* + * Take the chosen process out of the queue. + */ + ASSERT(rpq->first); /* Wrong qmask in rq->flags? */ + p = rpq->first; +#ifdef ERTS_SMP + ERTS_SMP_LC_ASSERT(rq == p->run_queue); +#endif + rpq->first = p->next; + if (!rpq->first) + rpq->last = NULL; + else + rpq->first->prev = NULL; + + p->next = p->prev = NULL; + + if (--rq->procs.prio_info[p->prio].len == 0) + rq->flags &= ~(1 << p->prio); + ASSERT(rq->procs.len > 0); + rq->procs.len--; + ASSERT(rq->len > 0); + rq->len--; + + { + Uint32 ee_flgs = (ERTS_RUNQ_FLG_EVACUATE(p->prio) + | ERTS_RUNQ_FLG_EMIGRATE(p->prio)); + + if ((rq->flags & (ERTS_RUNQ_FLG_SUSPENDED|ee_flgs)) == ee_flgs) + ERTS_UNSET_RUNQ_FLG_EVACUATE(rq->flags, p->prio); + } + + ERTS_DBG_CHK_PROCS_RUNQ_NOPROC(rq, p); + + rq->procs.context_switches++; + + esdp->current_process = p; + +#ifdef ERTS_SMP + p->runq_flags |= ERTS_PROC_RUNQ_FLG_RUNNING; + erts_smp_runq_unlock(rq); + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + + if (erts_sched_stat.enabled) { + Uint old = ERTS_PROC_SCHED_ID(p, + (ERTS_PROC_LOCK_MAIN + | ERTS_PROC_LOCK_STATUS), + esdp->no); + int migrated = old && old != esdp->no; + + erts_smp_spin_lock(&erts_sched_stat.lock); + erts_sched_stat.prio[p->prio].total_executed++; + erts_sched_stat.prio[p->prio].executed++; + if (migrated) { + erts_sched_stat.prio[p->prio].total_migrated++; + erts_sched_stat.prio[p->prio].migrated++; + } + erts_smp_spin_unlock(&erts_sched_stat.lock); + } + + p->status_flags |= ERTS_PROC_SFLG_RUNNING; + p->status_flags &= ~ERTS_PROC_SFLG_INRUNQ; + if (ERTS_PROC_PENDING_EXIT(p)) { + erts_handle_pending_exit(p, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + } + ASSERT(!p->scheduler_data); + p->scheduler_data = esdp; + +#endif + ASSERT(p->status != P_SUSPENDED); /* Never run a suspended process */ + + ACTIVATE(p); + reds = context_reds; + + if (IS_TRACED(p)) { + switch (p->status) { + case P_EXITING: + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_EXIT)) + trace_sched(p, am_in_exiting); + break; + default: + if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED)) + trace_sched(p, am_in); + else if (ARE_TRACE_FLAGS_ON(p, F_TRACE_SCHED_PROCS)) + trace_virtual_sched(p, am_in); + break; + } + } + if (p->status != P_EXITING) + p->status = P_RUNNING; + + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + +#ifdef ERTS_SMP + if (is_not_nil(p->tracer_proc)) + erts_check_my_tracer_proc(p); +#endif + + if ((FLAGS(p) & F_FORCE_GC) || (MSO(p).overhead >= BIN_VHEAP_SZ(p))) { + reds -= erts_garbage_collect(p, 0, p->arg_reg, p->arity); + if (reds < 0) { + reds = 1; + } + } + + p->fcalls = reds; + ASSERT(IS_ACTIVE(p)); + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + return p; + } +} + +void +erts_sched_stat_modify(int what) +{ + int ix; + switch (what) { + case ERTS_SCHED_STAT_MODIFY_ENABLE: + erts_smp_block_system(0); + erts_sched_stat.enabled = 1; + erts_smp_release_system(); + break; + case ERTS_SCHED_STAT_MODIFY_DISABLE: + erts_smp_block_system(0); + erts_sched_stat.enabled = 1; + erts_smp_release_system(); + break; + case ERTS_SCHED_STAT_MODIFY_CLEAR: + erts_smp_spin_lock(&erts_sched_stat.lock); + for (ix = 0; ix < ERTS_NO_PRIO_LEVELS; ix++) { + erts_sched_stat.prio[ix].total_executed = 0; + erts_sched_stat.prio[ix].executed = 0; + erts_sched_stat.prio[ix].total_migrated = 0; + erts_sched_stat.prio[ix].migrated = 0; + } + erts_smp_spin_unlock(&erts_sched_stat.lock); + break; + } +} + +Eterm +erts_sched_stat_term(Process *p, int total) +{ + Uint sz; + Uint *hp; + Eterm prio[ERTS_NO_PRIO_LEVELS]; + Uint executed[ERTS_NO_PRIO_LEVELS]; + Uint migrated[ERTS_NO_PRIO_LEVELS]; + + erts_smp_spin_lock(&erts_sched_stat.lock); + if (total) { + int i; + for (i = 0; i < ERTS_NO_PRIO_LEVELS; i++) { + prio[i] = erts_sched_stat.prio[i].name; + executed[i] = erts_sched_stat.prio[i].total_executed; + migrated[i] = erts_sched_stat.prio[i].total_migrated; + } + } + else { + int i; + for (i = 0; i < ERTS_NO_PRIO_LEVELS; i++) { + prio[i] = erts_sched_stat.prio[i].name; + executed[i] = erts_sched_stat.prio[i].executed; + erts_sched_stat.prio[i].executed = 0; + migrated[i] = erts_sched_stat.prio[i].migrated; + erts_sched_stat.prio[i].migrated = 0; + } + } + erts_smp_spin_unlock(&erts_sched_stat.lock); + + sz = 0; + (void) erts_bld_atom_2uint_3tup_list(NULL, &sz, ERTS_NO_PRIO_LEVELS, + prio, executed, migrated); + hp = HAlloc(p, sz); + return erts_bld_atom_2uint_3tup_list(&hp, NULL, ERTS_NO_PRIO_LEVELS, + prio, executed, migrated); +} + +/* + * Scheduling of misc stuff + */ + +void +erts_schedule_misc_op(void (*func)(void *), void *arg) +{ + ErtsRunQueue *rq = erts_get_runq_current(NULL); + ErtsMiscOpList *molp = misc_op_list_alloc(); + + erts_smp_runq_lock(rq); + + while (rq->misc.evac_runq) { + ErtsRunQueue *tmp_rq = rq->misc.evac_runq; + erts_smp_runq_unlock(rq); + rq = tmp_rq; + erts_smp_runq_lock(rq); + } + + ASSERT(!(rq->flags & ERTS_RUNQ_FLG_SUSPENDED)); + + molp->next = NULL; + molp->func = func; + molp->arg = arg; + if (rq->misc.end) + rq->misc.end->next = molp; + else + rq->misc.start = molp; + rq->misc.end = molp; + smp_notify_inc_runq(rq); + erts_smp_runq_unlock(rq); +} + +static void +exec_misc_ops(ErtsRunQueue *rq) +{ + int i; + ErtsMiscOpList *molp = rq->misc.start; + ErtsMiscOpList *tmp_molp = molp; + + for (i = 0; i < ERTS_MAX_MISC_OPS-1; i++) { + if (!tmp_molp) + goto mtq; + tmp_molp = tmp_molp->next; + } + + if (!tmp_molp) { + mtq: + rq->misc.start = NULL; + rq->misc.end = NULL; + } + else { + rq->misc.start = tmp_molp->next; + tmp_molp->next = NULL; + if (!rq->misc.start) + rq->misc.end = NULL; + } + + erts_smp_runq_unlock(rq); + + while (molp) { + tmp_molp = molp; + (*molp->func)(molp->arg); + molp = molp->next; + misc_op_list_free(tmp_molp); + } + + erts_smp_runq_lock(rq); +} + +Uint +erts_get_total_context_switches(void) +{ + Uint res = 0; + ERTS_ATOMIC_FOREACH_RUNQ(rq, res += rq->procs.context_switches); + return res; +} + +void +erts_get_total_reductions(Uint *redsp, Uint *diffp) +{ + Uint reds = 0; + ERTS_ATOMIC_FOREACH_RUNQ_X(rq, + + reds += rq->procs.reductions, + + if (redsp) *redsp = reds; + if (diffp) *diffp = reds - last_reductions; + last_reductions = reds); +} + +void +erts_get_exact_total_reductions(Process *c_p, Uint *redsp, Uint *diffp) +{ + Uint reds = erts_current_reductions(c_p, c_p); + int ix; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + /* + * Wait for other schedulers to schedule out their processes + * and update 'reductions'. + */ + erts_smp_block_system(0); + for (reds = 0, ix = 0; ix < erts_no_run_queues; ix++) + reds += ERTS_RUNQ_IX(ix)->procs.reductions; + if (redsp) + *redsp = reds; + if (diffp) + *diffp = reds - last_exact_reductions; + last_exact_reductions = reds; + erts_smp_release_system(); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); +} + +/* + * erts_test_next_pid() is only used for testing. + */ +Sint +erts_test_next_pid(int set, Uint next) +{ + Sint res; + Sint p_prev; + + + erts_smp_mtx_lock(&proc_tab_mtx); + + if (!set) { + res = p_next < 0 ? -1 : (p_serial << p_serial_shift | p_next); + } + else { + + p_serial = (Sint) ((next >> p_serial_shift) & p_serial_mask); + p_next = (Sint) (erts_process_tab_index_mask & next); + + if (p_next >= erts_max_processes) { + p_next = 0; + p_serial++; + p_serial &= p_serial_mask; + } + + p_prev = p_next; + + do { + if (!process_tab[p_next]) + break; + p_next++; + if(p_next >= erts_max_processes) { + p_next = 0; + p_serial++; + p_serial &= p_serial_mask; + } + } while (p_prev != p_next); + + res = process_tab[p_next] ? -1 : (p_serial << p_serial_shift | p_next); + + } + + erts_smp_mtx_unlock(&proc_tab_mtx); + + return res; + +} + +Uint erts_process_count(void) +{ + long res = erts_smp_atomic_read(&process_count); + ASSERT(res >= 0); + return (Uint) res; +} + +void +erts_free_proc(Process *p) +{ +#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) + erts_lcnt_proc_lock_destroy(p); +#endif + erts_free(ERTS_ALC_T_PROC, (void *) p); +} + + +/* +** Allocate process and find out where to place next process. +*/ +static Process* +alloc_process(void) +{ +#ifdef ERTS_SMP + erts_pix_lock_t *pix_lock; +#endif + Process* p; + int p_prev; + + erts_smp_mtx_lock(&proc_tab_mtx); + + if (p_next == -1) { + p = NULL; + goto error; /* Process table full! */ + } + + p = (Process*) erts_alloc_fnf(ERTS_ALC_T_PROC, sizeof(Process)); + if (!p) + goto error; /* ENOMEM */ + + p_last = p_next; + + erts_get_emu_time(&p->started); + +#ifdef ERTS_SMP + pix_lock = ERTS_PIX2PIXLOCK(p_next); + erts_pix_lock(pix_lock); +#endif + ASSERT(!process_tab[p_next]); + + process_tab[p_next] = p; + erts_smp_atomic_inc(&process_count); + p->id = make_internal_pid(p_serial << p_serial_shift | p_next); + if (p->id == ERTS_INVALID_PID) { + /* Do not use the invalid pid; change serial */ + p_serial++; + p_serial &= p_serial_mask; + p->id = make_internal_pid(p_serial << p_serial_shift | p_next); + ASSERT(p->id != ERTS_INVALID_PID); + } + ASSERT(internal_pid_serial(p->id) <= (erts_use_r9_pids_ports + ? ERTS_MAX_PID_R9_SERIAL + : ERTS_MAX_PID_SERIAL)); + +#ifdef ERTS_SMP + erts_proc_lock_init(p); /* All locks locked */ + erts_pix_unlock(pix_lock); +#endif + + p->rstatus = P_FREE; + p->rcount = 0; + + /* + * set p_next to the next available slot + */ + + p_prev = p_next; + + while (1) { + p_next++; + if(p_next >= erts_max_processes) { + p_serial++; + p_serial &= p_serial_mask; + p_next = 0; + } + + if (p_prev == p_next) { + p_next = -1; + break; /* Table full! */ + } + + if (!process_tab[p_next]) + break; /* found a free slot */ + } + + error: + + erts_smp_mtx_unlock(&proc_tab_mtx); + + return p; + +} + +Eterm +erl_create_process(Process* parent, /* Parent of process (default group leader). */ + Eterm mod, /* Tagged atom for module. */ + Eterm func, /* Tagged atom for function. */ + Eterm args, /* Arguments for function (must be well-formed list). */ + ErlSpawnOpts* so) /* Options for spawn. */ +{ + ErtsRunQueue *rq; + Process *p; + Sint arity; /* Number of arguments. */ +#ifndef HYBRID + Uint arg_size; /* Size of arguments. */ +#endif + Uint sz; /* Needed words on heap. */ + Uint heap_need; /* Size needed on heap. */ + Eterm res = THE_NON_VALUE; + +#ifdef ERTS_SMP + erts_smp_proc_lock(parent, ERTS_PROC_LOCKS_ALL_MINOR); +#endif + +#ifdef HYBRID + /* + * Copy the arguments to the global heap + * Since global GC might occur we want to do this before adding the + * new process to the process_tab. + */ + BM_SWAP_TIMER(system,copy); + LAZY_COPY(parent,args); + BM_SWAP_TIMER(copy,system); + heap_need = 0; +#endif /* HYBRID */ + /* + * Check for errors. + */ + + if (is_not_atom(mod) || is_not_atom(func) || ((arity = list_length(args)) < 0)) { + so->error_code = BADARG; + goto error; + } + p = alloc_process(); /* All proc locks are locked by this thread + on success */ + if (!p) { + erts_send_error_to_logger_str(parent->group_leader, + "Too many processes\n"); + so->error_code = SYSTEM_LIMIT; + goto error; + } + + processes_busy++; + BM_COUNT(processes_spawned); + +#ifndef HYBRID + BM_SWAP_TIMER(system,size); + arg_size = size_object(args); + BM_SWAP_TIMER(size,system); + heap_need = arg_size; +#endif + + p->flags = erts_default_process_flags; + + /* Scheduler queue mutex should be locked when changeing + * prio. In this case we don't have to lock it, since + * noone except us has access to the process. + */ + if (so->flags & SPO_USE_ARGS) { + p->min_heap_size = so->min_heap_size; + p->prio = so->priority; + p->max_gen_gcs = so->max_gen_gcs; + } else { + p->min_heap_size = H_MIN_SIZE; + p->prio = PRIORITY_NORMAL; + p->max_gen_gcs = (Uint16) erts_smp_atomic_read(&erts_max_gen_gcs); + } + p->skipped = 0; + ASSERT(p->min_heap_size == erts_next_heap_size(p->min_heap_size, 0)); + + p->initial[INITIAL_MOD] = mod; + p->initial[INITIAL_FUN] = func; + p->initial[INITIAL_ARI] = (Uint) arity; + + /* + * Must initialize binary lists here before copying binaries to process. + */ + p->off_heap.mso = NULL; +#ifndef HYBRID /* FIND ME! */ + p->off_heap.funs = NULL; +#endif + p->off_heap.externals = NULL; + p->off_heap.overhead = 0; + + heap_need += + IS_CONST(parent->group_leader) ? 0 : NC_HEAP_SIZE(parent->group_leader); + + if (heap_need < p->min_heap_size) { + sz = heap_need = p->min_heap_size; + } else { + sz = erts_next_heap_size(heap_need, 0); + } + +#ifdef HIPE + hipe_init_process(&p->hipe); +#ifdef ERTS_SMP + hipe_init_process_smp(&p->hipe_smp); +#endif +#endif + + p->heap = (Eterm *) ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP, sizeof(Eterm)*sz); + p->old_hend = p->old_htop = p->old_heap = NULL; + p->high_water = p->heap; +#ifdef INCREMENTAL + p->scan_top = p->high_water; +#endif + p->gen_gcs = 0; + p->stop = p->hend = p->heap + sz; + p->htop = p->heap; + p->heap_sz = sz; + p->catches = 0; + + p->bin_vheap_sz = H_MIN_SIZE; + p->bin_old_vheap_sz = H_MIN_SIZE; + p->bin_old_vheap = 0; + + /* No need to initialize p->fcalls. */ + + p->current = p->initial+INITIAL_MOD; + + p->i = (Eterm *) beam_apply; + p->cp = (Eterm *) beam_apply+1; + + p->arg_reg = p->def_arg_reg; + p->max_arg_reg = sizeof(p->def_arg_reg)/sizeof(p->def_arg_reg[0]); + p->arg_reg[0] = mod; + p->arg_reg[1] = func; + BM_STOP_TIMER(system); + BM_MESSAGE(args,p,parent); + BM_START_TIMER(system); +#ifdef HYBRID + p->arg_reg[2] = args; +#ifdef INCREMENTAL + p->active = 0; + if (ptr_val(args) >= inc_fromspc && ptr_val(args) < inc_fromend) + INC_ACTIVATE(p); +#endif +#else + BM_SWAP_TIMER(system,copy); + p->arg_reg[2] = copy_struct(args, arg_size, &p->htop, &p->off_heap); + BM_MESSAGE_COPIED(arg_size); + BM_SWAP_TIMER(copy,system); +#endif + p->arity = 3; + + p->fvalue = NIL; + p->freason = EXC_NULL; + p->ftrace = NIL; + p->reds = 0; + +#ifdef ERTS_SMP + p->u.ptimer = NULL; +#else + sys_memset(&p->u.tm, 0, sizeof(ErlTimer)); +#endif + + p->reg = NULL; + p->nlinks = NULL; + p->monitors = NULL; + p->nodes_monitors = NULL; + p->suspend_monitors = NULL; + + ASSERT(is_pid(parent->group_leader)); + + if (parent->group_leader == ERTS_INVALID_PID) + p->group_leader = p->id; + else { + /* Needs to be done after the heap has been set up */ + p->group_leader = + IS_CONST(parent->group_leader) + ? parent->group_leader + : STORE_NC(&p->htop, &p->off_heap.externals, parent->group_leader); + } + + erts_get_default_tracing(&p->trace_flags, &p->tracer_proc); + + p->msg.first = NULL; + p->msg.last = &p->msg.first; + p->msg.save = &p->msg.first; + p->msg.len = 0; +#ifdef ERTS_SMP + p->msg_inq.first = NULL; + p->msg_inq.last = &p->msg_inq.first; + p->msg_inq.len = 0; + p->bound_runq = NULL; +#endif + p->bif_timers = NULL; + p->mbuf = NULL; + p->mbuf_sz = 0; + p->psd = NULL; + p->dictionary = NULL; + p->seq_trace_lastcnt = 0; + p->seq_trace_clock = 0; + SEQ_TRACE_TOKEN(p) = NIL; + p->parent = parent->id == ERTS_INVALID_PID ? NIL : parent->id; + +#ifdef HYBRID + p->rrma = NULL; + p->rrsrc = NULL; + p->nrr = 0; + p->rrsz = 0; +#endif + + INIT_HOLE_CHECK(p); +#ifdef DEBUG + p->last_old_htop = NULL; +#endif + + if (IS_TRACED(parent)) { + if (parent->trace_flags & F_TRACE_SOS) { + p->trace_flags |= (parent->trace_flags & TRACEE_FLAGS); + p->tracer_proc = parent->tracer_proc; + } + if (ARE_TRACE_FLAGS_ON(parent, F_TRACE_PROCS)) { + trace_proc_spawn(parent, p->id, mod, func, args); + } + if (parent->trace_flags & F_TRACE_SOS1) { /* Overrides TRACE_CHILDREN */ + p->trace_flags |= (parent->trace_flags & TRACEE_FLAGS); + p->tracer_proc = parent->tracer_proc; + p->trace_flags &= ~(F_TRACE_SOS1 | F_TRACE_SOS); + parent->trace_flags &= ~(F_TRACE_SOS1 | F_TRACE_SOS); + } + } + + /* + * Check if this process should be initially linked to its parent. + */ + + if (so->flags & SPO_LINK) { +#ifdef DEBUG + int ret; +#endif + if (IS_TRACED_FL(parent, F_TRACE_PROCS)) { + trace_proc(parent, parent, am_link, p->id); + } + +#ifdef DEBUG + ret = erts_add_link(&(parent->nlinks), LINK_PID, p->id); + ASSERT(ret == 0); + ret = erts_add_link(&(p->nlinks), LINK_PID, parent->id); + ASSERT(ret == 0); +#else + erts_add_link(&(parent->nlinks), LINK_PID, p->id); + erts_add_link(&(p->nlinks), LINK_PID, parent->id); +#endif + + if (IS_TRACED(parent)) { + if (parent->trace_flags & (F_TRACE_SOL|F_TRACE_SOL1)) { + p->trace_flags |= (parent->trace_flags & TRACEE_FLAGS); + p->tracer_proc = parent->tracer_proc; /* maybe steal */ + + if (parent->trace_flags & F_TRACE_SOL1) { /* maybe override */ + p ->trace_flags &= ~(F_TRACE_SOL1 | F_TRACE_SOL); + parent->trace_flags &= ~(F_TRACE_SOL1 | F_TRACE_SOL); + } + } + } + } + + /* + * Test whether this process should be initially monitored by its parent. + */ + if (so->flags & SPO_MONITOR) { + Eterm mref; + + mref = erts_make_ref(parent); + erts_add_monitor(&(parent->monitors), MON_ORIGIN, mref, p->id, NIL); + erts_add_monitor(&(p->monitors), MON_TARGET, mref, parent->id, NIL); + so->mref = mref; + } + +#ifdef HYBRID + /* + * Add process to the array of active processes. + */ + ACTIVATE(p); + p->active_index = erts_num_active_procs++; + erts_active_procs[p->active_index] = p; +#endif + +#ifdef ERTS_SMP + p->scheduler_data = NULL; + p->is_exiting = 0; + p->status_flags = 0; + p->runq_flags = 0; + p->suspendee = NIL; + p->pending_suspenders = NULL; + p->pending_exit.reason = THE_NON_VALUE; + p->pending_exit.bp = NULL; +#endif + +#if !defined(NO_FPE_SIGNALS) + p->fp_exception = 0; +#endif + + /* + * Schedule process for execution. + */ + + if (!((so->flags & SPO_USE_ARGS) && so->scheduler)) + rq = erts_get_runq_proc(parent); + else { + int ix = so->scheduler-1; + ASSERT(0 <= ix && ix < erts_no_run_queues); + rq = ERTS_RUNQ_IX(ix); + p->bound_runq = rq; + } + + erts_smp_runq_lock(rq); + +#ifdef ERTS_SMP + p->run_queue = rq; +#endif + + p->status = P_WAITING; + internal_add_to_runq(rq, p); + + erts_smp_runq_unlock(rq); + + res = p->id; + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); + + VERBOSE(DEBUG_PROCESSES, ("Created a new process: %T\n",p->id)); + + error: + + erts_smp_proc_unlock(parent, ERTS_PROC_LOCKS_ALL_MINOR); + + return res; +} + +/* + * Initiates a pseudo process that can be used + * for arithmetic BIFs. + */ + +void erts_init_empty_process(Process *p) +{ + p->htop = NULL; + p->stop = NULL; + p->hend = NULL; + p->heap = NULL; + p->gen_gcs = 0; + p->max_gen_gcs = 0; + p->min_heap_size = 0; + p->status = P_RUNABLE; + p->gcstatus = P_RUNABLE; + p->rstatus = P_RUNABLE; + p->rcount = 0; + p->id = ERTS_INVALID_PID; + p->prio = PRIORITY_NORMAL; + p->reds = 0; + p->tracer_proc = NIL; + p->trace_flags = F_INITIAL_TRACE_FLAGS; + p->group_leader = ERTS_INVALID_PID; + p->flags = 0; + p->fvalue = NIL; + p->freason = EXC_NULL; + p->ftrace = NIL; + p->fcalls = 0; + + p->bin_vheap_sz=H_MIN_SIZE; + p->bin_old_vheap_sz=H_MIN_SIZE; + p->bin_old_vheap = 0; +#ifdef ERTS_SMP + p->u.ptimer = NULL; + p->bound_runq = NULL; +#else + memset(&(p->u.tm), 0, sizeof(ErlTimer)); +#endif + p->next = NULL; + p->off_heap.mso = NULL; +#ifndef HYBRID /* FIND ME! */ + p->off_heap.funs = NULL; +#endif + p->off_heap.externals = NULL; + p->off_heap.overhead = 0; + p->reg = NULL; + p->heap_sz = 0; + p->high_water = NULL; +#ifdef INCREMENTAL + p->scan_top = NULL; +#endif + p->old_hend = NULL; + p->old_htop = NULL; + p->old_heap = NULL; + p->mbuf = NULL; + p->mbuf_sz = 0; + p->psd = NULL; + p->monitors = NULL; + p->nlinks = NULL; /* List of links */ + p->nodes_monitors = NULL; + p->suspend_monitors = NULL; + p->msg.first = NULL; + p->msg.last = &p->msg.first; + p->msg.save = &p->msg.first; + p->msg.len = 0; + p->bif_timers = NULL; + p->dictionary = NULL; + p->seq_trace_clock = 0; + p->seq_trace_lastcnt = 0; + p->seq_trace_token = NIL; + p->initial[0] = 0; + p->initial[1] = 0; + p->initial[2] = 0; + p->catches = 0; + p->cp = NULL; + p->i = NULL; + p->current = NULL; + + /* + * Saved x registers. + */ + p->arity = 0; + p->arg_reg = NULL; + p->max_arg_reg = 0; + p->def_arg_reg[0] = 0; + p->def_arg_reg[1] = 0; + p->def_arg_reg[2] = 0; + p->def_arg_reg[3] = 0; + p->def_arg_reg[4] = 0; + p->def_arg_reg[5] = 0; + + p->parent = NIL; + p->started.tv_sec = 0; + p->started.tv_usec = 0; + +#ifdef HIPE + hipe_init_process(&p->hipe); +#ifdef ERTS_SMP + hipe_init_process_smp(&p->hipe_smp); +#endif +#endif + + ACTIVATE(p); + +#ifdef HYBRID + p->rrma = NULL; + p->rrsrc = NULL; + p->nrr = 0; + p->rrsz = 0; +#endif + INIT_HOLE_CHECK(p); +#ifdef DEBUG + p->last_old_htop = NULL; +#endif + + +#ifdef ERTS_SMP + p->scheduler_data = NULL; + p->is_exiting = 0; + p->status_flags = 0; + p->runq_flags = 0; + p->msg_inq.first = NULL; + p->msg_inq.last = &p->msg_inq.first; + p->msg_inq.len = 0; + p->suspendee = NIL; + p->pending_suspenders = NULL; + p->pending_exit.reason = THE_NON_VALUE; + p->pending_exit.bp = NULL; + erts_proc_lock_init(p); + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); + p->run_queue = ERTS_RUNQ_IX(0); +#endif + +#if !defined(NO_FPE_SIGNALS) + p->fp_exception = 0; +#endif + +} + +#ifdef DEBUG + +void +erts_debug_verify_clean_empty_process(Process* p) +{ + /* Things that erts_cleanup_empty_process() will *not* cleanup... */ + ASSERT(p->htop == NULL); + ASSERT(p->stop == NULL); + ASSERT(p->hend == NULL); + ASSERT(p->heap == NULL); + ASSERT(p->id == ERTS_INVALID_PID); + ASSERT(p->tracer_proc == NIL); + ASSERT(p->trace_flags == F_INITIAL_TRACE_FLAGS); + ASSERT(p->group_leader == ERTS_INVALID_PID); + ASSERT(p->next == NULL); + ASSERT(p->reg == NULL); + ASSERT(p->heap_sz == 0); + ASSERT(p->high_water == NULL); +#ifdef INCREMENTAL + ASSERT(p->scan_top == NULL); +#endif + ASSERT(p->old_hend == NULL); + ASSERT(p->old_htop == NULL); + ASSERT(p->old_heap == NULL); + + ASSERT(p->monitors == NULL); + ASSERT(p->nlinks == NULL); + ASSERT(p->nodes_monitors == NULL); + ASSERT(p->suspend_monitors == NULL); + ASSERT(p->msg.first == NULL); + ASSERT(p->msg.len == 0); + ASSERT(p->bif_timers == NULL); + ASSERT(p->dictionary == NULL); + ASSERT(p->catches == 0); + ASSERT(p->cp == NULL); + ASSERT(p->i == NULL); + ASSERT(p->current == NULL); + + ASSERT(p->parent == NIL); + +#ifdef ERTS_SMP + ASSERT(p->msg_inq.first == NULL); + ASSERT(p->msg_inq.len == 0); + ASSERT(p->suspendee == NIL); + ASSERT(p->pending_suspenders == NULL); + ASSERT(p->pending_exit.reason == THE_NON_VALUE); + ASSERT(p->pending_exit.bp == NULL); +#endif + + /* Thing that erts_cleanup_empty_process() cleans up */ + + ASSERT(p->off_heap.mso == NULL); +#ifndef HYBRID /* FIND ME! */ + ASSERT(p->off_heap.funs == NULL); +#endif + ASSERT(p->off_heap.externals == NULL); + ASSERT(p->off_heap.overhead == 0); + + ASSERT(p->mbuf == NULL); +} + +#endif + +void +erts_cleanup_empty_process(Process* p) +{ + ErlHeapFragment* mbufp; + + /* We only check fields that are known to be used... */ + + erts_cleanup_offheap(&p->off_heap); + p->off_heap.mso = NULL; +#ifndef HYBRID /* FIND ME! */ + p->off_heap.funs = NULL; +#endif + p->off_heap.externals = NULL; + p->off_heap.overhead = 0; + + mbufp = p->mbuf; + while (mbufp) { + ErlHeapFragment *next = mbufp->next; + free_message_buffer(mbufp); + mbufp = next; + } + p->mbuf = NULL; +#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) + erts_lcnt_proc_lock_destroy(p); +#endif +#ifdef DEBUG + erts_debug_verify_clean_empty_process(p); +#endif +} + +/* + * p must be the currently executing process. + */ +static void +delete_process(Process* p) +{ + ErlMessage* mp; + ErlHeapFragment* bp; + + VERBOSE(DEBUG_PROCESSES, ("Removing process: %T\n",p->id)); + + /* Cleanup psd */ + + if (p->psd) + erts_free(ERTS_ALC_T_PSD, p->psd); + + /* Clean binaries and funs */ + erts_cleanup_offheap(&p->off_heap); + + /* + * The mso list should not be used anymore, but if it is, make sure that + * we'll notice. + */ + p->off_heap.mso = (void *) 0x8DEFFACD; + + if (p->arg_reg != p->def_arg_reg) { + erts_free(ERTS_ALC_T_ARG_REG, p->arg_reg); + } + + /* + * Release heaps. Clobber contents in DEBUG build. + */ + + +#ifdef DEBUG + sys_memset(p->heap, DEBUG_BAD_BYTE, p->heap_sz*sizeof(Eterm)); +#endif + +#ifdef HIPE + hipe_delete_process(&p->hipe); +#endif + + ERTS_HEAP_FREE(ERTS_ALC_T_HEAP, (void*) p->heap, p->heap_sz*sizeof(Eterm)); + if (p->old_heap != NULL) { + +#ifdef DEBUG + sys_memset(p->old_heap, DEBUG_BAD_BYTE, + (p->old_hend-p->old_heap)*sizeof(Eterm)); +#endif + ERTS_HEAP_FREE(ERTS_ALC_T_OLD_HEAP, + p->old_heap, + (p->old_hend-p->old_heap)*sizeof(Eterm)); + } + + /* + * Free all pending message buffers. + */ + bp = p->mbuf; + while (bp != NULL) { + ErlHeapFragment* next_bp = bp->next; + free_message_buffer(bp); + bp = next_bp; + } + + erts_erase_dicts(p); + + /* free all pending messages */ + mp = p->msg.first; + while(mp != NULL) { + ErlMessage* next_mp = mp->next; + if (mp->data.attached) { + if (is_value(mp->m[0])) + free_message_buffer(mp->data.heap_frag); + else { + if (is_not_nil(mp->m[1])) { + ErlHeapFragment *heap_frag; + heap_frag = (ErlHeapFragment *) mp->data.dist_ext->ext_endp; + erts_cleanup_offheap(&heap_frag->off_heap); + } + erts_free_dist_ext_copy(mp->data.dist_ext); + } + } + free_message(mp); + mp = next_mp; + } + + ASSERT(!p->monitors); + ASSERT(!p->nlinks); + ASSERT(!p->nodes_monitors); + ASSERT(!p->suspend_monitors); + + p->fvalue = NIL; + +#ifdef HYBRID + erts_active_procs[p->active_index] = + erts_active_procs[--erts_num_active_procs]; + erts_active_procs[p->active_index]->active_index = p->active_index; +#ifdef INCREMENTAL + if (INC_IS_ACTIVE(p)) + INC_DEACTIVATE(p); +#endif + + if (p->rrma != NULL) { + erts_free(ERTS_ALC_T_ROOTSET,p->rrma); + erts_free(ERTS_ALC_T_ROOTSET,p->rrsrc); + } +#endif + +} + +static ERTS_INLINE void +set_proc_exiting(Process *p, Eterm reason, ErlHeapFragment *bp) +{ +#ifdef ERTS_SMP + erts_pix_lock_t *pix_lock = ERTS_PID2PIXLOCK(p->id); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(p) == ERTS_PROC_LOCKS_ALL); + /* + * You are required to have all proc locks and the pix lock when going + * to status P_EXITING. This makes it is enough to take any lock when + * looking up a process (pid2proc()) to prevent the looked up process + * from exiting until the lock has been released. + */ + + erts_pix_lock(pix_lock); + p->is_exiting = 1; +#endif + p->status = P_EXITING; +#ifdef ERTS_SMP + erts_pix_unlock(pix_lock); +#endif + p->fvalue = reason; + if (bp) + erts_link_mbuf_to_proc(p, bp); + /* + * We used to set freason to EXC_EXIT here, but there is no need to + * save the stack trace since this process irreversibly is going to + * exit. + */ + p->freason = EXTAG_EXIT; + KILL_CATCHES(p); + cancel_timer(p); + p->i = (Eterm *) beam_exit; +} + + +#ifdef ERTS_SMP + +void +erts_handle_pending_exit(Process *c_p, ErtsProcLocks locks) +{ + ErtsProcLocks xlocks; + ASSERT(is_value(c_p->pending_exit.reason)); + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(c_p) == locks); + ERTS_SMP_LC_ASSERT(locks & ERTS_PROC_LOCK_MAIN); + ERTS_SMP_LC_ASSERT(c_p->status != P_EXITING); + ERTS_SMP_LC_ASSERT(c_p->status != P_FREE); + + /* Ensure that all locks on c_p are locked before proceeding... */ + if (locks == ERTS_PROC_LOCKS_ALL) + xlocks = 0; + else { + xlocks = ~locks & ERTS_PROC_LOCKS_ALL; + if (erts_smp_proc_trylock(c_p, xlocks) == EBUSY) { + erts_smp_proc_unlock(c_p, locks & ~ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + } + + set_proc_exiting(c_p, c_p->pending_exit.reason, c_p->pending_exit.bp); + c_p->pending_exit.reason = THE_NON_VALUE; + c_p->pending_exit.bp = NULL; + + if (xlocks) + erts_smp_proc_unlock(c_p, xlocks); +} + +static void +handle_pending_exiters(ErtsProcList *pnd_xtrs) +{ + ErtsProcList *plp = pnd_xtrs; + ErtsProcList *free_plp; + while (plp) { + Process *p = erts_pid2proc(NULL, 0, plp->pid, ERTS_PROC_LOCKS_ALL); + if (p) { + if (proclist_same(plp, p) + && !(p->status_flags & ERTS_PROC_SFLG_RUNNING)) { + ASSERT(p->status_flags & ERTS_PROC_SFLG_INRUNQ); + ASSERT(ERTS_PROC_PENDING_EXIT(p)); + erts_handle_pending_exit(p, ERTS_PROC_LOCKS_ALL); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); + } + free_plp = plp; + plp = plp->next; + proclist_destroy(free_plp); + } +} + +static void +save_pending_exiter(Process *p) +{ + ErtsProcList *plp; + ErtsRunQueue *rq; + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); + + rq = erts_get_runq_current(NULL); + + plp = proclist_create(p); + + erts_smp_runq_lock(rq); + + plp->next = rq->procs.pending_exiters; + rq->procs.pending_exiters = plp; + + erts_smp_runq_unlock(rq); + +} + +#endif + +/* + * This function delivers an EXIT message to a process + * which is trapping EXITs. + */ + +static ERTS_INLINE void +send_exit_message(Process *to, ErtsProcLocks *to_locksp, + Eterm exit_term, Uint term_size, Eterm token) +{ + if (token == NIL) { + Eterm* hp; + Eterm mess; + ErlHeapFragment* bp; + ErlOffHeap *ohp; + + hp = erts_alloc_message_heap(term_size, &bp, &ohp, to, to_locksp); + mess = copy_struct(exit_term, term_size, &hp, ohp); + erts_queue_message(to, to_locksp, bp, mess, NIL); + } else { + ErlHeapFragment* bp; + Eterm* hp; + Eterm mess; + Eterm temp_token; + Uint sz_token; + + ASSERT(is_tuple(token)); + sz_token = size_object(token); + bp = new_message_buffer(term_size+sz_token); + hp = bp->mem; + mess = copy_struct(exit_term, term_size, &hp, &bp->off_heap); + /* the trace token must in this case be updated by the caller */ + seq_trace_output(token, mess, SEQ_TRACE_SEND, to->id, NULL); + temp_token = copy_struct(token, sz_token, &hp, &bp->off_heap); + erts_queue_message(to, to_locksp, bp, mess, temp_token); + } +} + +/* + * + * *** Exit signal behavior *** + * + * Exit signals are asynchronous (truly asynchronous in the + * SMP emulator). When the signal is received the receiver receives an + * 'EXIT' message if it is trapping exits; otherwise, it will either + * ignore the signal if the exit reason is normal, or go into an + * exiting state (status P_EXITING). When a process has gone into the + * exiting state it will not execute any more Erlang code, but it might + * take a while before it actually exits. The exit signal is being + * received when the 'EXIT' message is put in the message queue, the + * signal is dropped, or when it changes state into exiting. The time it + * is in the exiting state before actually exiting is undefined (it + * might take a really long time under certain conditions). The + * receiver of the exit signal does not break links or trigger monitors + * until it actually exits. + * + * Exit signals and other signals, e.g. messages, have to be received + * by a receiver in the same order as sent by a sender. + * + * + * + * Exit signal implementation in the SMP emulator: + * + * If the receiver is trapping exits, the signal is transformed + * into an 'EXIT' message and sent as a normal message, if the + * reason is normal the signal is dropped; otherwise, the process + * is determined to be exited. The interesting case is when the + * process is to be exited and this is what is described below. + * + * If it is possible, the receiver is set in the exiting state straight + * away and we are done; otherwise, the sender places the exit reason + * in the pending_exit field of the process struct and if necessary + * adds the receiver to the run queue. It is typically not possible + * to set a scheduled process or a process which we cannot get all locks + * on without releasing locks on it in an exiting state straight away. + * + * The receiver will poll the pending_exit field when it reach certain + * places during it's execution. When it discovers the pending exit + * it will change state into the exiting state. If the receiver wasn't + * scheduled when the pending exit was set, the first scheduler that + * schedules a new process will set the receiving process in the exiting + * state just before it schedules next process. + * + * When the exit signal is placed in the pending_exit field, the signal + * is considered as being in transit on the Erlang level. The signal is + * actually in some kind of semi transit state, since we have already + * determined how it should be received. It will exit the process no + * matter what if it is received (the process may exit by itself before + * reception of the exit signal). The signal is received when it is + * discovered in the pending_exit field by the receiver. + * + * The receiver have to poll the pending_exit field at least before: + * - moving messages from the message in queue to the private message + * queue. This in order to preserve signal order. + * - unlink. Otherwise the process might get exited on a link that + * have been removed. + * - changing the trap_exit flag to true. This in order to simplify the + * implementation; otherwise, we would have to transform the signal + * into an 'EXIT' message when setting the trap_exit flag to true. We + * would also have to maintain a queue of exit signals in transit. + * - being scheduled in or out. + */ + +static ERTS_INLINE int +send_exit_signal(Process *c_p, /* current process if and only + if reason is stored on it */ + Eterm from, /* Id of sender of signal */ + Process *rp, /* receiving process */ + ErtsProcLocks *rp_locks,/* current locks on receiver */ + Eterm reason, /* exit reason */ + Eterm exit_tuple, /* Prebuild exit tuple + or THE_NON_VALUE */ + Uint exit_tuple_sz, /* Size of prebuilt exit tuple + (if exit_tuple != THE_NON_VALUE) */ + Eterm token, /* token */ + Process *token_update, /* token updater */ + Uint32 flags /* flags */ + ) +{ + Eterm rsn = reason == am_kill ? am_killed : reason; + + ERTS_SMP_LC_ASSERT(*rp_locks == erts_proc_lc_my_proc_locks(rp)); + ERTS_SMP_LC_ASSERT((*rp_locks & ERTS_PROC_LOCKS_XSIG_SEND) + == ERTS_PROC_LOCKS_XSIG_SEND); + + ASSERT(reason != THE_NON_VALUE); + + if (ERTS_PROC_IS_TRAPPING_EXITS(rp) + && (reason != am_kill || (flags & ERTS_XSIG_FLG_IGN_KILL))) { + if (is_not_nil(token) && token_update) + seq_trace_update_send(token_update); + if (is_value(exit_tuple)) + send_exit_message(rp, rp_locks, exit_tuple, exit_tuple_sz, token); + else + erts_deliver_exit_message(from, rp, rp_locks, rsn, token); + return 1; /* Receiver will get a message */ + } + else if (reason != am_normal || (flags & ERTS_XSIG_FLG_NO_IGN_NORMAL)) { +#ifdef ERTS_SMP + if (!ERTS_PROC_PENDING_EXIT(rp) && !rp->is_exiting) { + ASSERT(rp->status != P_EXITING); + ASSERT(rp->status != P_FREE); + ASSERT(!rp->pending_exit.bp); + + if (rp == c_p && (*rp_locks & ERTS_PROC_LOCK_MAIN)) { + /* Ensure that all locks on c_p are locked before + proceeding... */ + if (*rp_locks != ERTS_PROC_LOCKS_ALL) { + ErtsProcLocks need_locks = (~(*rp_locks) + & ERTS_PROC_LOCKS_ALL); + if (erts_smp_proc_trylock(c_p, need_locks) == EBUSY) { + erts_smp_proc_unlock(c_p, + *rp_locks & ~ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_ALL_MINOR); + } + *rp_locks = ERTS_PROC_LOCKS_ALL; + } + set_proc_exiting(c_p, rsn, NULL); + } + else if (!(rp->status_flags & ERTS_PROC_SFLG_RUNNING)) { + /* Process not running ... */ + ErtsProcLocks need_locks = ~(*rp_locks) & ERTS_PROC_LOCKS_ALL; + if (need_locks + && erts_smp_proc_trylock(rp, need_locks) == EBUSY) { + /* ... but we havn't got all locks on it ... */ + save_pending_exiter(rp); + /* + * The pending exit will be discovered when next + * process is scheduled in + */ + goto set_pending_exit; + } + else { + /* ...and we have all locks on it... */ + *rp_locks = ERTS_PROC_LOCKS_ALL; + set_proc_exiting(rp, + (is_immed(rsn) + ? rsn + : copy_object(rsn, rp)), + NULL); + } + } + else { /* Process running... */ + + /* + * The pending exit will be discovered when the process + * is scheduled out if not discovered earlier. + */ + + set_pending_exit: + if (is_immed(rsn)) { + rp->pending_exit.reason = rsn; + } + else { + Eterm *hp; + Uint sz = size_object(rsn); + ErlHeapFragment *bp = new_message_buffer(sz); + + hp = &bp->mem[0]; + rp->pending_exit.reason = copy_struct(rsn, + sz, + &hp, + &bp->off_heap); + rp->pending_exit.bp = bp; + } + ASSERT(ERTS_PROC_PENDING_EXIT(rp)); + } + if (!(rp->status_flags + & (ERTS_PROC_SFLG_INRUNQ|ERTS_PROC_SFLG_RUNNING))) + erts_add_to_runq(rp); + } + /* else: + * + * The receiver already has a pending exit (or is exiting) + * so we drop this signal. + * + * NOTE: dropping this exit signal is based on the assumption + * that the receiver *will* exit; either on the pending + * exit or by itself before seeing the pending exit. + */ +#else /* !ERTS_SMP */ + if (c_p == rp) { + rp->status = P_EXITING; + c_p->fvalue = rsn; + } + else if (rp->status != P_EXITING) { /* No recursive process exits /PaN */ + Eterm old_status = rp->status; + set_proc_exiting(rp, + is_immed(rsn) ? rsn : copy_object(rsn, rp), + NULL); + ACTIVATE(rp); + if (old_status != P_RUNABLE && old_status != P_RUNNING) + erts_add_to_runq(rp); + } +#endif + return -1; /* Receiver will exit */ + } + + return 0; /* Receiver unaffected */ +} + + +int +erts_send_exit_signal(Process *c_p, + Eterm from, + Process *rp, + ErtsProcLocks *rp_locks, + Eterm reason, + Eterm token, + Process *token_update, + Uint32 flags) +{ + return send_exit_signal(c_p, + from, + rp, + rp_locks, + reason, + THE_NON_VALUE, + 0, + token, + token_update, + flags); +} + +typedef struct { + Eterm reason; + Process *p; +} ExitMonitorContext; + +static void doit_exit_monitor(ErtsMonitor *mon, void *vpcontext) +{ + ExitMonitorContext *pcontext = vpcontext; + DistEntry *dep; + ErtsMonitor *rmon; + Process *rp; + + if (mon->type == MON_ORIGIN) { + /* We are monitoring someone else, we need to demonitor that one.. */ + if (is_atom(mon->pid)) { /* remote by name */ + ASSERT(is_node_name_atom(mon->pid)); + dep = erts_sysname_to_connected_dist_entry(mon->pid); + if (dep) { + erts_smp_de_links_lock(dep); + rmon = erts_remove_monitor(&(dep->monitors), mon->ref); + erts_smp_de_links_unlock(dep); + if (rmon) { + ErtsDSigData dsd; + int code = erts_dsig_prepare(&dsd, dep, NULL, + ERTS_DSP_NO_LOCK, 0); + if (code == ERTS_DSIG_PREP_CONNECTED) { + code = erts_dsig_send_demonitor(&dsd, + rmon->pid, + mon->name, + mon->ref, + 1); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + erts_destroy_monitor(rmon); + } + erts_deref_dist_entry(dep); + } + } else { + ASSERT(is_pid(mon->pid)); + if (is_internal_pid(mon->pid)) { /* local by pid or name */ + rp = erts_pid2proc(NULL, 0, mon->pid, ERTS_PROC_LOCK_LINK); + if (!rp) { + goto done; + } + rmon = erts_remove_monitor(&(rp->monitors),mon->ref); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + if (rmon == NULL) { + goto done; + } + erts_destroy_monitor(rmon); + } else { /* remote by pid */ + ASSERT(is_external_pid(mon->pid)); + dep = external_pid_dist_entry(mon->pid); + ASSERT(dep != NULL); + if (dep) { + erts_smp_de_links_lock(dep); + rmon = erts_remove_monitor(&(dep->monitors), mon->ref); + erts_smp_de_links_unlock(dep); + if (rmon) { + ErtsDSigData dsd; + int code = erts_dsig_prepare(&dsd, dep, NULL, + ERTS_DSP_NO_LOCK, 0); + if (code == ERTS_DSIG_PREP_CONNECTED) { + code = erts_dsig_send_demonitor(&dsd, + rmon->pid, + mon->pid, + mon->ref, + 1); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + erts_destroy_monitor(rmon); + } + } + } + } + } else { /* type == MON_TARGET */ + ASSERT(mon->type == MON_TARGET); + ASSERT(is_pid(mon->pid) || is_internal_port(mon->pid)); + if (is_internal_port(mon->pid)) { + Port *prt = erts_id2port(mon->pid, NULL, 0); + if (prt == NULL) { + goto done; + } + erts_fire_port_monitor(prt, mon->ref); + erts_port_release(prt); + } else if (is_internal_pid(mon->pid)) {/* local by name or pid */ + Eterm watched; + Eterm lhp[3]; + ErtsProcLocks rp_locks = (ERTS_PROC_LOCK_LINK + | ERTS_PROC_LOCKS_MSG_SEND); + rp = erts_pid2proc(NULL, 0, mon->pid, rp_locks); + if (rp == NULL) { + goto done; + } + rmon = erts_remove_monitor(&(rp->monitors),mon->ref); + if (rmon) { + erts_destroy_monitor(rmon); + watched = (is_atom(mon->name) + ? TUPLE2(lhp, mon->name, + erts_this_dist_entry->sysname) + : pcontext->p->id); + erts_queue_monitor_message(rp, &rp_locks, mon->ref, am_process, + watched, pcontext->reason); + } + /* else: demonitor while we exited, i.e. do nothing... */ + erts_smp_proc_unlock(rp, rp_locks); + } else { /* external by pid or name */ + ASSERT(is_external_pid(mon->pid)); + dep = external_pid_dist_entry(mon->pid); + ASSERT(dep != NULL); + if (dep) { + erts_smp_de_links_lock(dep); + rmon = erts_remove_monitor(&(dep->monitors), mon->ref); + erts_smp_de_links_unlock(dep); + if (rmon) { + ErtsDSigData dsd; + int code = erts_dsig_prepare(&dsd, dep, NULL, + ERTS_DSP_NO_LOCK, 0); + if (code == ERTS_DSIG_PREP_CONNECTED) { + code = erts_dsig_send_m_exit(&dsd, + mon->pid, + (rmon->name != NIL + ? rmon->name + : rmon->pid), + mon->ref, + pcontext->reason); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + erts_destroy_monitor(rmon); + } + } + } + } + done: + /* As the monitors are previously removed from the process, + distribution operations will not cause monitors to disappear, + we can safely delete it. */ + + erts_destroy_monitor(mon); +} + +typedef struct { + Process *p; + Eterm reason; + Eterm exit_tuple; + Uint exit_tuple_sz; +} ExitLinkContext; + +static void doit_exit_link(ErtsLink *lnk, void *vpcontext) +{ + ExitLinkContext *pcontext = vpcontext; + /* Unpack context, it's readonly */ + Process *p = pcontext->p; + Eterm reason = pcontext->reason; + Eterm exit_tuple = pcontext->exit_tuple; + Uint exit_tuple_sz = pcontext->exit_tuple_sz; + Eterm item = lnk->pid; + ErtsLink *rlnk; + DistEntry *dep; + Process *rp; + + switch(lnk->type) { + case LINK_PID: + if(is_internal_port(item)) { + Port *prt = erts_id2port(item, NULL, 0); + if (prt) { + rlnk = erts_remove_link(&prt->nlinks, p->id); + if (rlnk) + erts_destroy_link(rlnk); + erts_do_exit_port(prt, p->id, reason); + erts_port_release(prt); + } + } + else if(is_external_port(item)) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Erroneous link between %T and external port %T " + "found\n", + p->id, + item); + erts_send_error_to_logger_nogl(dsbufp); + ASSERT(0); /* It isn't possible to setup such a link... */ + } + else if (is_internal_pid(item)) { + ErtsProcLocks rp_locks = (ERTS_PROC_LOCK_LINK + | ERTS_PROC_LOCKS_XSIG_SEND); + rp = erts_pid2proc(NULL, 0, item, rp_locks); + if (rp) { + rlnk = erts_remove_link(&(rp->nlinks), p->id); + /* If rlnk == NULL, we got unlinked while exiting, + i.e., do nothing... */ + if (rlnk) { + int xres; + erts_destroy_link(rlnk); + xres = send_exit_signal(NULL, + p->id, + rp, + &rp_locks, + reason, + exit_tuple, + exit_tuple_sz, + SEQ_TRACE_TOKEN(p), + p, + ERTS_XSIG_FLG_IGN_KILL); + if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { + /* We didn't exit the process and it is traced */ + if (IS_TRACED_FL(rp, F_TRACE_PROCS)) { + trace_proc(p, rp, am_getting_unlinked, p->id); + } + } + } + ASSERT(rp != p); + erts_smp_proc_unlock(rp, rp_locks); + } + } + else if (is_external_pid(item)) { + dep = external_pid_dist_entry(item); + if(dep != erts_this_dist_entry) { + ErtsDSigData dsd; + int code; + ErtsDistLinkData dld; + erts_remove_dist_link(&dld, p->id, item, dep); + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + code = erts_dsig_prepare(&dsd, dep, p, ERTS_DSP_NO_LOCK, 0); + if (code == ERTS_DSIG_PREP_CONNECTED) { + code = erts_dsig_send_exit_tt(&dsd, p->id, item, reason, + SEQ_TRACE_TOKEN(p)); + ASSERT(code == ERTS_DSIG_SEND_OK); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + erts_destroy_dist_link(&dld); + } + } + break; + case LINK_NODE: + ASSERT(is_node_name_atom(item)); + dep = erts_sysname_to_connected_dist_entry(item); + if(dep) { + /* dist entries have node links in a separate structure to + avoid confusion */ + erts_smp_de_links_lock(dep); + rlnk = erts_remove_link(&(dep->node_links), p->id); + erts_smp_de_links_unlock(dep); + if (rlnk) + erts_destroy_link(rlnk); + erts_deref_dist_entry(dep); + } else { +#ifndef ERTS_SMP + /* XXX Is this possible? Shouldn't this link + previously have been removed if the node + had previously been disconnected. */ + ASSERT(0); +#endif + /* This is possible when smp support has been enabled, + and dist port and process exits simultaneously. */ + } + break; + + default: + erl_exit(1, "bad type in link list\n"); + break; + } + erts_destroy_link(lnk); +} + +static void +resume_suspend_monitor(ErtsSuspendMonitor *smon, void *vc_p) +{ + Process *suspendee = erts_pid2proc((Process *) vc_p, ERTS_PROC_LOCK_MAIN, + smon->pid, ERTS_PROC_LOCK_STATUS); + if (suspendee) { + if (smon->active) + resume_process(suspendee); + erts_smp_proc_unlock(suspendee, ERTS_PROC_LOCK_STATUS); + } + erts_destroy_suspend_monitor(smon); +} + +static void +continue_exit_process(Process *p +#ifdef ERTS_SMP + , erts_pix_lock_t *pix_lock +#endif + ); + +/* this function fishishes a process and propagates exit messages - called + by process_main when a process dies */ +void +erts_do_exit_process(Process* p, Eterm reason) +{ +#ifdef ERTS_SMP + erts_pix_lock_t *pix_lock = ERTS_PID2PIXLOCK(p->id); +#endif + + p->arity = 0; /* No live registers */ + p->fvalue = reason; + +#ifdef ERTS_SMP + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + /* By locking all locks (main lock is already locked) when going + to status P_EXITING, it is enough to take any lock when + looking up a process (erts_pid2proc()) to prevent the looked up + process from exiting until the lock has been released. */ + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); +#endif + + if (erts_system_profile_flags.runnable_procs && (p->status != P_WAITING)) { + profile_runnable_proc(p, am_inactive); + } + +#ifdef ERTS_SMP + erts_pix_lock(pix_lock); + p->is_exiting = 1; +#endif + + p->status = P_EXITING; + +#ifdef ERTS_SMP + erts_pix_unlock(pix_lock); + + if (ERTS_PROC_PENDING_EXIT(p)) { + /* Process exited before pending exit was received... */ + p->pending_exit.reason = THE_NON_VALUE; + if (p->pending_exit.bp) { + free_message_buffer(p->pending_exit.bp); + p->pending_exit.bp = NULL; + } + } + + cancel_suspend_of_suspendee(p, ERTS_PROC_LOCKS_ALL); + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); +#endif + + if (IS_TRACED_FL(p,F_TRACE_PROCS)) + trace_proc(p, p, am_exit, reason); + + erts_trace_check_exiting(p->id); + + ASSERT((p->trace_flags & F_INITIAL_TRACE_FLAGS) == F_INITIAL_TRACE_FLAGS); + + cancel_timer(p); /* Always cancel timer just in case */ + + /* + * The timer of this process can *not* be used anymore. The field used + * for the timer is now used for misc exiting data. + */ + p->u.exit_data = NULL; + + if (p->bif_timers) + erts_cancel_bif_timers(p, ERTS_PROC_LOCKS_ALL); + +#ifdef ERTS_SMP + if (p->flags & F_HAVE_BLCKD_MSCHED) + erts_block_multi_scheduling(p, ERTS_PROC_LOCKS_ALL, 0, 1); +#endif + + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); + +#ifdef ERTS_SMP + continue_exit_process(p, pix_lock); +#else + continue_exit_process(p); +#endif +} + +void +erts_continue_exit_process(Process *c_p) +{ +#ifdef ERTS_SMP + continue_exit_process(c_p, ERTS_PID2PIXLOCK(c_p->id)); +#else + continue_exit_process(c_p); +#endif +} + +static void +continue_exit_process(Process *p +#ifdef ERTS_SMP + , erts_pix_lock_t *pix_lock +#endif + ) +{ + ErtsLink* lnk; + ErtsMonitor *mon; + ErtsProcLocks curr_locks = ERTS_PROC_LOCK_MAIN; + Eterm reason = p->fvalue; + DistEntry *dep; + struct saved_calls *scb; +#ifdef DEBUG + int yield_allowed = 1; +#endif + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p)); + +#ifdef DEBUG + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + ASSERT(p->status == P_EXITING); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); +#endif + + if (p->flags & F_USING_DB) { + if (erts_db_process_exiting(p, ERTS_PROC_LOCK_MAIN)) + goto yield; + p->flags &= ~F_USING_DB; + } + + if (p->flags & F_USING_DDLL) { + erts_ddll_proc_dead(p, ERTS_PROC_LOCK_MAIN); + p->flags &= ~F_USING_DDLL; + } + + if (p->nodes_monitors) { + erts_delete_nodes_monitors(p, ERTS_PROC_LOCK_MAIN); + p->nodes_monitors = NULL; + } + + + if (p->suspend_monitors) { + erts_sweep_suspend_monitors(p->suspend_monitors, + resume_suspend_monitor, + p); + p->suspend_monitors = NULL; + } + + /* + * The registered name *should* be the last "erlang resource" to + * cleanup. + */ + if (p->reg) { + (void) erts_unregister_name(p, ERTS_PROC_LOCK_MAIN, NULL, THE_NON_VALUE); + ASSERT(!p->reg); + } + + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); + curr_locks = ERTS_PROC_LOCKS_ALL; + + /* + * From this point on we are no longer allowed to yield + * this process. + */ +#ifdef DEBUG + yield_allowed = 0; +#endif + + { + int pix; + /* Do *not* use erts_get_runq_proc() */ + ErtsRunQueue *rq; + rq = erts_get_runq_current(ERTS_GET_SCHEDULER_DATA_FROM_PROC(p)); + + ASSERT(internal_pid_index(p->id) < erts_max_processes); + pix = internal_pid_index(p->id); + + erts_smp_mtx_lock(&proc_tab_mtx); + erts_smp_runq_lock(rq); + +#ifdef ERTS_SMP + erts_pix_lock(pix_lock); + + ASSERT(p->scheduler_data); + ASSERT(p->scheduler_data->current_process == p); + ASSERT(p->scheduler_data->free_process == NULL); + + p->scheduler_data->current_process = NULL; + p->scheduler_data->free_process = p; + p->status_flags = 0; +#endif + process_tab[pix] = NULL; /* Time of death! */ + ASSERT(erts_smp_atomic_read(&process_count) > 0); + erts_smp_atomic_dec(&process_count); + +#ifdef ERTS_SMP + erts_pix_unlock(pix_lock); +#endif + erts_smp_runq_unlock(rq); + + if (p_next < 0) { + if (p_last >= p_next) { + p_serial++; + p_serial &= p_serial_mask; + } + p_next = pix; + } + + ERTS_MAYBE_SAVE_TERMINATING_PROCESS(p); + + erts_smp_mtx_unlock(&proc_tab_mtx); + } + + /* + * All "erlang resources" have to be deallocated before this point, + * e.g. registered name, so monitoring and linked processes can + * be sure that all interesting resources have been deallocated + * when the monitors and/or links hit. + */ + + mon = p->monitors; + p->monitors = NULL; /* to avoid recursive deletion during traversal */ + + lnk = p->nlinks; + p->nlinks = NULL; + p->status = P_FREE; + dep = ((p->flags & F_DISTRIBUTION) + ? ERTS_PROC_SET_DIST_ENTRY(p, ERTS_PROC_LOCKS_ALL, NULL) + : NULL); + scb = ERTS_PROC_SET_SAVED_CALLS_BUF(p, ERTS_PROC_LOCKS_ALL, NULL); + + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL); + processes_busy--; + + if (dep) { + erts_do_net_exits(dep, reason); + if(dep) + erts_deref_dist_entry(dep); + } + + /* + * Pre-build the EXIT tuple if there are any links. + */ + if (lnk) { + Eterm tmp_heap[4]; + Eterm exit_tuple; + Uint exit_tuple_sz; + Eterm* hp; + + hp = &tmp_heap[0]; + + exit_tuple = TUPLE3(hp, am_EXIT, p->id, reason); + + exit_tuple_sz = size_object(exit_tuple); + + { + ExitLinkContext context = {p, reason, exit_tuple, exit_tuple_sz}; + erts_sweep_links(lnk, &doit_exit_link, &context); + } + } + + { + ExitMonitorContext context = {reason, p}; + erts_sweep_monitors(mon,&doit_exit_monitor,&context); + } + + if (scb) + erts_free(ERTS_ALC_T_CALLS_BUF, (void *) scb); + + delete_process(p); + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + + return; + + yield: + +#ifdef DEBUG + ASSERT(yield_allowed); +#endif + + ERTS_SMP_LC_ASSERT(curr_locks == erts_proc_lc_my_proc_locks(p)); + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & curr_locks); + + ASSERT(p->status == P_EXITING); + + p->i = (Eterm *) beam_continue_exit; + + if (!(curr_locks & ERTS_PROC_LOCK_STATUS)) { + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + curr_locks |= ERTS_PROC_LOCK_STATUS; + } + + erts_add_to_runq(p); + + if (curr_locks != ERTS_PROC_LOCK_MAIN) + erts_smp_proc_unlock(p, ~ERTS_PROC_LOCK_MAIN & curr_locks); + + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN == erts_proc_lc_my_proc_locks(p)); + +} + +/* Callback for process timeout */ +static void +timeout_proc(Process* p) +{ + p->i = (Eterm *) p->def_arg_reg[0]; + p->flags |= F_TIMO; + p->flags &= ~F_INSLPQUEUE; + + if (p->status == P_WAITING) + erts_add_to_runq(p); + if (p->status == P_SUSPENDED) + p->rstatus = P_RUNABLE; /* MUST set resume status to runnable */ +} + + +void +cancel_timer(Process* p) +{ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + p->flags &= ~(F_INSLPQUEUE|F_TIMO); +#ifdef ERTS_SMP + erts_cancel_smp_ptimer(p->u.ptimer); +#else + erl_cancel_timer(&p->u.tm); +#endif +} + +/* + * Insert a process into the time queue, with a timeout 'timeout' in ms. + */ +void +set_timer(Process* p, Uint timeout) +{ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks(p)); + + /* check for special case timeout=0 DONT ADD TO time queue */ + if (timeout == 0) { + p->flags |= F_TIMO; + return; + } + p->flags |= F_INSLPQUEUE; + p->flags &= ~F_TIMO; + +#ifdef ERTS_SMP + erts_create_smp_ptimer(&p->u.ptimer, + p->id, + (ErlTimeoutProc) timeout_proc, + timeout); +#else + erl_set_timer(&p->u.tm, + (ErlTimeoutProc) timeout_proc, + NULL, + (void*) p, + timeout); +#endif +} + +/* + * Stack dump functions follow. + */ + +void +erts_stack_dump(int to, void *to_arg, Process *p) +{ + Eterm* sp; + int yreg = -1; + + if (p->trace_flags & F_SENSITIVE) { + return; + } + erts_program_counter_info(to, to_arg, p); + for (sp = p->stop; sp < STACK_START(p); sp++) { + yreg = stack_element_dump(to, to_arg, p, sp, yreg); + } +} + +void +erts_program_counter_info(int to, void *to_arg, Process *p) +{ + int i; + + erts_print(to, to_arg, "Program counter: %p (", p->i); + print_function_from_pc(to, to_arg, p->i); + erts_print(to, to_arg, ")\n"); + erts_print(to, to_arg, "CP: %p (", p->cp); + print_function_from_pc(to, to_arg, p->cp); + erts_print(to, to_arg, ")\n"); + if (!((p->status == P_RUNNING) || (p->status == P_GARBING))) { + erts_print(to, to_arg, "arity = %d\n",p->arity); + if (!ERTS_IS_CRASH_DUMPING) { + /* + * Only print the arguments if we are not writing a + * crash dump file. The arguments cannot be interpreted + * by the crashdump_viewer application and will therefore + * only cause problems. + */ + for (i = 0; i < p->arity; i++) + erts_print(to, to_arg, " %T\n", p->arg_reg[i]); + } + } +} + +static void +print_function_from_pc(int to, void *to_arg, Eterm* x) +{ + Eterm* addr = find_function_from_pc(x); + if (addr == NULL) { + if (x == beam_exit) { + erts_print(to, to_arg, ""); + } else if (x == beam_continue_exit) { + erts_print(to, to_arg, ""); + } else if (x == beam_apply+1) { + erts_print(to, to_arg, ""); + } else if (x == 0) { + erts_print(to, to_arg, "invalid"); + } else { + erts_print(to, to_arg, "unknown function"); + } + } else { + erts_print(to, to_arg, "%T:%T/%d + %d", + addr[0], addr[1], addr[2], ((x-addr)-2) * sizeof(Eterm)); + } +} + +static int +stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg) +{ + Eterm x = *sp; + + if (yreg < 0 || is_CP(x)) { + erts_print(to, to_arg, "\n%p ", sp); + } else { + char sbuf[16]; + sprintf(sbuf, "y(%d)", yreg); + erts_print(to, to_arg, "%-8s ", sbuf); + yreg++; + } + + if (is_CP(x)) { + erts_print(to, to_arg, "Return addr %p (", (Eterm *) x); + print_function_from_pc(to, to_arg, cp_val(x)); + erts_print(to, to_arg, ")\n"); + yreg = 0; + } else if is_catch(x) { + erts_print(to, to_arg, "Catch %p (", catch_pc(x)); + print_function_from_pc(to, to_arg, catch_pc(x)); + erts_print(to, to_arg, ")\n"); + } else { + erts_print(to, to_arg, "%T\n", x); + } + return yreg; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * The processes/0 BIF implementation. * +\* */ + + +#define ERTS_PROCESSES_BIF_TAB_INSPECT_INDICES_PER_RED 25 +#define ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE 1000 +#define ERTS_PROCESSES_BIF_MIN_START_REDS \ + (ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE \ + / ERTS_PROCESSES_BIF_TAB_INSPECT_INDICES_PER_RED) + +#define ERTS_PROCESSES_BIF_TAB_FREE_TERM_PROC_REDS 1 + +#define ERTS_PROCESSES_BIF_INSPECT_TERM_PROC_PER_RED 10 + +#define ERTS_PROCESSES_INSPECT_TERM_PROC_MAX_REDS \ + (ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE \ + / ERTS_PROCESSES_BIF_TAB_INSPECT_INDICES_PER_RED) + + +#define ERTS_PROCESSES_BIF_BUILD_RESULT_CONSES_PER_RED 75 + +#define ERTS_PROCS_DBG_DO_TRACE 0 + +#ifdef DEBUG +# define ERTS_PROCESSES_BIF_DEBUGLEVEL 100 +#else +# define ERTS_PROCESSES_BIF_DEBUGLEVEL 0 +#endif + +#define ERTS_PROCS_DBGLVL_CHK_HALLOC 1 +#define ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS 5 +#define ERTS_PROCS_DBGLVL_CHK_PIDS 10 +#define ERTS_PROCS_DBGLVL_CHK_TERM_PROC_LIST 20 +#define ERTS_PROCS_DBGLVL_CHK_RESLIST 20 + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL == 0 +# define ERTS_PROCS_ASSERT(EXP) +#else +# define ERTS_PROCS_ASSERT(EXP) \ + ((void) ((EXP) \ + ? 1 \ + : (debug_processes_assert_error(#EXP, __FILE__, __LINE__), 0))) +#endif + + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_HALLOC +# define ERTS_PROCS_DBG_SAVE_HEAP_ALLOC(PBDP, HP, SZ) \ +do { \ + ERTS_PROCS_ASSERT(!(PBDP)->debug.heap); \ + ERTS_PROCS_ASSERT(!(PBDP)->debug.heap_size); \ + (PBDP)->debug.heap = (HP); \ + (PBDP)->debug.heap_size = (SZ); \ +} while (0) +# define ERTS_PROCS_DBG_VERIFY_HEAP_ALLOC_USED(PBDP, HP) \ +do { \ + ERTS_PROCS_ASSERT((PBDP)->debug.heap); \ + ERTS_PROCS_ASSERT((PBDP)->debug.heap_size); \ + ERTS_PROCS_ASSERT((PBDP)->debug.heap + (PBDP)->debug.heap_size == (HP));\ + (PBDP)->debug.heap = NULL; \ + (PBDP)->debug.heap_size = 0; \ +} while (0) +# define ERTS_PROCS_DBG_HEAP_ALLOC_INIT(PBDP) \ +do { \ + (PBDP)->debug.heap = NULL; \ + (PBDP)->debug.heap_size = 0; \ +} while (0) +#else +# define ERTS_PROCS_DBG_SAVE_HEAP_ALLOC(PBDP, HP, SZ) +# define ERTS_PROCS_DBG_VERIFY_HEAP_ALLOC_USED(PBDP, HP) +# define ERTS_PROCS_DBG_HEAP_ALLOC_INIT(PBDP) +#endif + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_RESLIST +# define ERTS_PROCS_DBG_CHK_RESLIST(R) debug_processes_check_res_list((R)) +#else +# define ERTS_PROCS_DBG_CHK_RESLIST(R) +#endif + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_PIDS +# define ERTS_PROCS_DBG_SAVE_PIDS(PBDP) debug_processes_save_all_pids((PBDP)) +# define ERTS_PROCS_DBG_VERIFY_PIDS(PBDP) \ +do { \ + if (!(PBDP)->debug.correct_pids_verified) \ + debug_processes_verify_all_pids((PBDP)); \ +} while (0) +# define ERTS_PROCS_DBG_CLEANUP_CHK_PIDS(PBDP) \ +do { \ + if ((PBDP)->debug.correct_pids) { \ + erts_free(ERTS_ALC_T_PROCS_PIDS, \ + (PBDP)->debug.correct_pids); \ + (PBDP)->debug.correct_pids = NULL; \ + } \ +} while(0) +# define ERTS_PROCS_DBG_CHK_PIDS_INIT(PBDP) \ +do { \ + (PBDP)->debug.correct_pids_verified = 0; \ + (PBDP)->debug.correct_pids = NULL; \ +} while (0) +#else +# define ERTS_PROCS_DBG_SAVE_PIDS(PBDP) +# define ERTS_PROCS_DBG_VERIFY_PIDS(PBDP) +# define ERTS_PROCS_DBG_CLEANUP_CHK_PIDS(PBDP) +# define ERTS_PROCS_DBG_CHK_PIDS_INIT(PBDP) +#endif + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS +# define ERTS_PROCS_DBG_CHK_PID_FOUND(PBDP, PID, TVP) \ + debug_processes_check_found_pid((PBDP), (PID), (TVP), 1) +# define ERTS_PROCS_DBG_CHK_PID_NOT_FOUND(PBDP, PID, TVP) \ + debug_processes_check_found_pid((PBDP), (PID), (TVP), 0) +#else +# define ERTS_PROCS_DBG_CHK_PID_FOUND(PBDP, PID, TVP) +# define ERTS_PROCS_DBG_CHK_PID_NOT_FOUND(PBDP, PID, TVP) +#endif + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_TERM_PROC_LIST +# define ERTS_PROCS_DBG_CHK_TPLIST() \ + debug_processes_check_term_proc_list() +# define ERTS_PROCS_DBG_CHK_FREELIST(FL) \ + debug_processes_check_term_proc_free_list(FL) +#else +# define ERTS_PROCS_DBG_CHK_TPLIST() +# define ERTS_PROCS_DBG_CHK_FREELIST(FL) +#endif + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL == 0 +#if ERTS_PROCS_DBG_DO_TRACE +# define ERTS_PROCS_DBG_INIT(P, PBDP) (PBDP)->debug.caller = (P)->id +# else +# define ERTS_PROCS_DBG_INIT(P, PBDP) +# endif +# define ERTS_PROCS_DBG_CLEANUP(PBDP) +#else +# define ERTS_PROCS_DBG_INIT(P, PBDP) \ +do { \ + (PBDP)->debug.caller = (P)->id; \ + ERTS_PROCS_DBG_HEAP_ALLOC_INIT((PBDP)); \ + ERTS_PROCS_DBG_CHK_PIDS_INIT((PBDP)); \ +} while (0) +# define ERTS_PROCS_DBG_CLEANUP(PBDP) \ +do { \ + ERTS_PROCS_DBG_CLEANUP_CHK_PIDS((PBDP)); \ +} while (0) +#endif + +#if ERTS_PROCS_DBG_DO_TRACE +# define ERTS_PROCS_DBG_TRACE(PID, FUNC, WHAT) \ + erts_fprintf(stderr, "%T %s:%d:%s(): %s\n", \ + (PID), __FILE__, __LINE__, #FUNC, #WHAT) +#else +# define ERTS_PROCS_DBG_TRACE(PID, FUNC, WHAT) +#endif + +static Uint processes_bif_tab_chunks; +static Export processes_trap_export; + +typedef struct { + SysTimeval time; +} ErtsProcessesBifChunkInfo; + +typedef enum { + INITIALIZING, + INSPECTING_TABLE, + INSPECTING_TERMINATED_PROCESSES, + BUILDING_RESULT, + RETURN_RESULT +} ErtsProcessesBifState; + +typedef struct { + ErtsProcessesBifState state; + Eterm caller; + ErtsProcessesBifChunkInfo *chunk; + int tix; + int pid_ix; + int pid_sz; + Eterm *pid; + ErtsTermProcElement *bif_invocation; /* Only used when > 1 chunk */ + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL != 0 || ERTS_PROCS_DBG_DO_TRACE + struct { + Eterm caller; +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS + SysTimeval *pid_started; +#endif +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_HALLOC + Eterm *heap; + Uint heap_size; +#endif +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_PIDS + int correct_pids_verified; + Eterm *correct_pids; +#endif + } debug; +#endif + +} ErtsProcessesBifData; + + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL != 0 +static void debug_processes_assert_error(char* expr, char* file, int line); +#endif +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_RESLIST +static void debug_processes_check_res_list(Eterm list); +#endif +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_PIDS +static void debug_processes_save_all_pids(ErtsProcessesBifData *pbdp); +static void debug_processes_verify_all_pids(ErtsProcessesBifData *pbdp); +#endif +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS +static void debug_processes_check_found_pid(ErtsProcessesBifData *pbdp, + Eterm pid, + SysTimeval *started, + int pid_should_be_found); +#endif +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_TERM_PROC_LIST +static SysTimeval debug_tv_start; +static void debug_processes_check_term_proc_list(void); +static void debug_processes_check_term_proc_free_list(ErtsTermProcElement *tpep); +#endif + +static void +save_terminating_process(Process *p) +{ + ErtsTermProcElement *tpep = erts_alloc(ERTS_ALC_T_PROCS_TPROC_EL, + sizeof(ErtsTermProcElement)); + ERTS_PROCS_ASSERT(saved_term_procs.start && saved_term_procs.end); + ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&proc_tab_mtx)); + + ERTS_PROCS_DBG_CHK_TPLIST(); + + tpep->prev = saved_term_procs.end; + tpep->next = NULL; + tpep->ix = internal_pid_index(p->id); + tpep->u.process.pid = p->id; + tpep->u.process.spawned = p->started; + erts_get_emu_time(&tpep->u.process.exited); + + saved_term_procs.end->next = tpep; + saved_term_procs.end = tpep; + + ERTS_PROCS_DBG_CHK_TPLIST(); + + ERTS_PROCS_ASSERT((tpep->prev->ix >= 0 + ? erts_cmp_timeval(&tpep->u.process.exited, + &tpep->prev->u.process.exited) + : erts_cmp_timeval(&tpep->u.process.exited, + &tpep->prev->u.bif_invocation.time)) > 0); +} + +static void +cleanup_processes_bif_data(Binary *bp) +{ + ErtsProcessesBifData *pbdp = ERTS_MAGIC_BIN_DATA(bp); + + ERTS_PROCS_DBG_TRACE(pbdp->debug.caller, cleanup_processes_bif_data, call); + + if (pbdp->state != INITIALIZING) { + + if (pbdp->chunk) { + erts_free(ERTS_ALC_T_PROCS_CNKINF, pbdp->chunk); + pbdp->chunk = NULL; + } + if (pbdp->pid) { + erts_free(ERTS_ALC_T_PROCS_PIDS, pbdp->pid); + pbdp->pid = NULL; + } + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS + if (pbdp->debug.pid_started) { + erts_free(ERTS_ALC_T_PROCS_PIDS, pbdp->debug.pid_started); + pbdp->debug.pid_started = NULL; + } +#endif + + if (pbdp->bif_invocation) { + ErtsTermProcElement *tpep; + + erts_smp_mtx_lock(&proc_tab_mtx); + + ERTS_PROCS_DBG_TRACE(pbdp->debug.caller, + cleanup_processes_bif_data, + term_proc_cleanup); + + tpep = pbdp->bif_invocation; + pbdp->bif_invocation = NULL; + + ERTS_PROCS_DBG_CHK_TPLIST(); + + if (tpep->prev) { + /* + * Only remove this bif invokation when we + * have preceding invokations. + */ + tpep->prev->next = tpep->next; + if (tpep->next) + tpep->next->prev = tpep->prev; + else { + /* + * At the time of writing this branch cannot be + * reached. I don't want to remove this code though + * since it may be possible to reach this line + * in the future if the cleanup order in + * erts_do_exit_process() is changed. The ASSERT(0) + * is only here to make us aware that the reorder + * has happened. /rickard + */ + ASSERT(0); + saved_term_procs.end = tpep->prev; + } + erts_free(ERTS_ALC_T_PROCS_TPROC_EL, tpep); + } + else { + /* + * Free all elements until next bif invokation + * is found. + */ + ERTS_PROCS_ASSERT(saved_term_procs.start == tpep); + do { + ErtsTermProcElement *ftpep = tpep; + tpep = tpep->next; + erts_free(ERTS_ALC_T_PROCS_TPROC_EL, ftpep); + } while (tpep && tpep->ix >= 0); + saved_term_procs.start = tpep; + if (tpep) + tpep->prev = NULL; + else + saved_term_procs.end = NULL; + } + + ERTS_PROCS_DBG_CHK_TPLIST(); + + erts_smp_mtx_unlock(&proc_tab_mtx); + + } + } + + ERTS_PROCS_DBG_TRACE(pbdp->debug.caller, + cleanup_processes_bif_data, + return); + ERTS_PROCS_DBG_CLEANUP(pbdp); +} + +static int +processes_bif_engine(Process *p, Eterm *res_accp, Binary *mbp) +{ + ErtsProcessesBifData *pbdp = ERTS_MAGIC_BIN_DATA(mbp); + int have_reds; + int reds; + int locked = 0; + + do { + switch (pbdp->state) { + case INITIALIZING: + pbdp->chunk = erts_alloc(ERTS_ALC_T_PROCS_CNKINF, + (sizeof(ErtsProcessesBifChunkInfo) + * processes_bif_tab_chunks)); + pbdp->tix = 0; + pbdp->pid_ix = 0; + + erts_smp_mtx_lock(&proc_tab_mtx); + locked = 1; + + ERTS_PROCS_DBG_TRACE(p->id, processes_bif_engine, init); + + pbdp->pid_sz = erts_process_count(); + pbdp->pid = erts_alloc(ERTS_ALC_T_PROCS_PIDS, + sizeof(Eterm)*pbdp->pid_sz); + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS + pbdp->debug.pid_started = erts_alloc(ERTS_ALC_T_PROCS_PIDS, + sizeof(SysTimeval)*pbdp->pid_sz); +#endif + + ERTS_PROCS_DBG_SAVE_PIDS(pbdp); + + if (processes_bif_tab_chunks == 1) + pbdp->bif_invocation = NULL; + else { + /* + * We will have to access the table multiple times + * releasing the table lock in between chunks. + */ + pbdp->bif_invocation = erts_alloc(ERTS_ALC_T_PROCS_TPROC_EL, + sizeof(ErtsTermProcElement)); + pbdp->bif_invocation->ix = -1; + erts_get_emu_time(&pbdp->bif_invocation->u.bif_invocation.time); + ERTS_PROCS_DBG_CHK_TPLIST(); + + pbdp->bif_invocation->next = NULL; + if (saved_term_procs.end) { + pbdp->bif_invocation->prev = saved_term_procs.end; + saved_term_procs.end->next = pbdp->bif_invocation; + ERTS_PROCS_ASSERT(saved_term_procs.start); + } + else { + pbdp->bif_invocation->prev = NULL; + saved_term_procs.start = pbdp->bif_invocation; + } + saved_term_procs.end = pbdp->bif_invocation; + + ERTS_PROCS_DBG_CHK_TPLIST(); + + } + + pbdp->state = INSPECTING_TABLE; + /* Fall through */ + + case INSPECTING_TABLE: { + int ix = pbdp->tix; + int indices = ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE; + int cix = ix / ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE; + int end_ix = ix + indices; + SysTimeval *invocation_timep; + + invocation_timep = (pbdp->bif_invocation + ? &pbdp->bif_invocation->u.bif_invocation.time + : NULL); + + ERTS_PROCS_ASSERT(is_nil(*res_accp)); + if (!locked) { + erts_smp_mtx_lock(&proc_tab_mtx); + locked = 1; + } + + ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&proc_tab_mtx)); + ERTS_PROCS_DBG_TRACE(p->id, processes_bif_engine, insp_table); + + if (cix != 0) + erts_get_emu_time(&pbdp->chunk[cix].time); + else if (pbdp->bif_invocation) + pbdp->chunk[0].time = *invocation_timep; + /* else: Time is irrelevant */ + + if (end_ix >= erts_max_processes) { + ERTS_PROCS_ASSERT(cix+1 == processes_bif_tab_chunks); + end_ix = erts_max_processes; + indices = end_ix - ix; + /* What to do when done with this chunk */ + pbdp->state = (processes_bif_tab_chunks == 1 + ? BUILDING_RESULT + : INSPECTING_TERMINATED_PROCESSES); + } + + for (; ix < end_ix; ix++) { + Process *rp = process_tab[ix]; + if (rp + && (!invocation_timep + || erts_cmp_timeval(&rp->started, + invocation_timep) < 0)) { + ERTS_PROCS_ASSERT(is_internal_pid(rp->id)); + pbdp->pid[pbdp->pid_ix] = rp->id; + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS + pbdp->debug.pid_started[pbdp->pid_ix] = rp->started; +#endif + + pbdp->pid_ix++; + ERTS_PROCS_ASSERT(pbdp->pid_ix <= pbdp->pid_sz); + } + } + + pbdp->tix = end_ix; + + erts_smp_mtx_unlock(&proc_tab_mtx); + locked = 0; + + reds = indices/ERTS_PROCESSES_BIF_TAB_INSPECT_INDICES_PER_RED; + BUMP_REDS(p, reds); + + have_reds = ERTS_BIF_REDS_LEFT(p); + + if (have_reds && pbdp->state == INSPECTING_TABLE) { + ix = pbdp->tix; + indices = ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE; + end_ix = ix + indices; + if (end_ix > erts_max_processes) { + end_ix = erts_max_processes; + indices = end_ix - ix; + } + + reds = indices/ERTS_PROCESSES_BIF_TAB_INSPECT_INDICES_PER_RED; + + /* Pretend we have no reds left if we haven't got enough + reductions to complete next chunk */ + if (reds > have_reds) + have_reds = 0; + } + + break; + } + + case INSPECTING_TERMINATED_PROCESSES: { + int i; + int max_reds; + int free_term_procs = 0; + SysTimeval *invocation_timep; + ErtsTermProcElement *tpep; + ErtsTermProcElement *free_list = NULL; + + tpep = pbdp->bif_invocation; + ERTS_PROCS_ASSERT(tpep); + invocation_timep = &tpep->u.bif_invocation.time; + + max_reds = have_reds = ERTS_BIF_REDS_LEFT(p); + if (max_reds > ERTS_PROCESSES_INSPECT_TERM_PROC_MAX_REDS) + max_reds = ERTS_PROCESSES_INSPECT_TERM_PROC_MAX_REDS; + + reds = 0; + erts_smp_mtx_lock(&proc_tab_mtx); + ERTS_PROCS_DBG_TRACE(p->id, processes_bif_engine, insp_term_procs); + + ERTS_PROCS_DBG_CHK_TPLIST(); + + if (tpep->prev) + tpep->prev->next = tpep->next; + else { + ERTS_PROCS_ASSERT(saved_term_procs.start == tpep); + saved_term_procs.start = tpep->next; + + if (saved_term_procs.start && saved_term_procs.start->ix >= 0) { + free_list = saved_term_procs.start; + free_term_procs = 1; + } + } + + if (tpep->next) + tpep->next->prev = tpep->prev; + else + saved_term_procs.end = tpep->prev; + + tpep = tpep->next; + + i = 0; + while (reds < max_reds && tpep) { + if (tpep->ix < 0) { + if (free_term_procs) { + ERTS_PROCS_ASSERT(free_list); + ERTS_PROCS_ASSERT(tpep->prev); + + tpep->prev->next = NULL; /* end of free_list */ + saved_term_procs.start = tpep; + tpep->prev = NULL; + free_term_procs = 0; + } + } + else { + int cix = tpep->ix/ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE; + SysTimeval *chunk_timep = &pbdp->chunk[cix].time; + Eterm pid = tpep->u.process.pid; + ERTS_PROCS_ASSERT(is_internal_pid(pid)); + + if (erts_cmp_timeval(&tpep->u.process.spawned, + invocation_timep) < 0) { + if (erts_cmp_timeval(&tpep->u.process.exited, + chunk_timep) < 0) { + ERTS_PROCS_DBG_CHK_PID_NOT_FOUND(pbdp, + pid, + &tpep->u.process.spawned); + pbdp->pid[pbdp->pid_ix] = pid; +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS + pbdp->debug.pid_started[pbdp->pid_ix] = tpep->u.process.spawned; +#endif + pbdp->pid_ix++; + ERTS_PROCS_ASSERT(pbdp->pid_ix <= pbdp->pid_sz); + } + else { + ERTS_PROCS_DBG_CHK_PID_FOUND(pbdp, + pid, + &tpep->u.process.spawned); + } + } + else { + ERTS_PROCS_DBG_CHK_PID_NOT_FOUND(pbdp, + pid, + &tpep->u.process.spawned); + } + + i++; + if (i == ERTS_PROCESSES_BIF_INSPECT_TERM_PROC_PER_RED) { + reds++; + i = 0; + } + if (free_term_procs) + reds += ERTS_PROCESSES_BIF_TAB_FREE_TERM_PROC_REDS; + } + tpep = tpep->next; + } + + if (free_term_procs) { + ERTS_PROCS_ASSERT(free_list); + saved_term_procs.start = tpep; + if (!tpep) + saved_term_procs.end = NULL; + else { + ERTS_PROCS_ASSERT(tpep->prev); + tpep->prev->next = NULL; /* end of free_list */ + tpep->prev = NULL; + } + } + + if (!tpep) { + /* Done */ + ERTS_PROCS_ASSERT(pbdp->pid_ix == pbdp->pid_sz); + pbdp->state = BUILDING_RESULT; + pbdp->bif_invocation->next = free_list; + free_list = pbdp->bif_invocation; + pbdp->bif_invocation = NULL; + } + else { + /* Link in bif_invocation again where we left off */ + pbdp->bif_invocation->prev = tpep->prev; + pbdp->bif_invocation->next = tpep; + tpep->prev = pbdp->bif_invocation; + if (pbdp->bif_invocation->prev) + pbdp->bif_invocation->prev->next = pbdp->bif_invocation; + else { + ERTS_PROCS_ASSERT(saved_term_procs.start == tpep); + saved_term_procs.start = pbdp->bif_invocation; + } + } + + ERTS_PROCS_DBG_CHK_TPLIST(); + ERTS_PROCS_DBG_CHK_FREELIST(free_list); + erts_smp_mtx_unlock(&proc_tab_mtx); + + /* + * We do the actual free of term proc structures now when we + * have released the table lock instead of when we encountered + * them. This since free() isn't for free and we don't want to + * unnecessarily block other schedulers. + */ + while (free_list) { + tpep = free_list; + free_list = tpep->next; + erts_free(ERTS_ALC_T_PROCS_TPROC_EL, tpep); + } + + have_reds -= reds; + if (have_reds < 0) + have_reds = 0; + BUMP_REDS(p, reds); + break; + } + + case BUILDING_RESULT: { + int conses, ix, min_ix; + Eterm *hp; + Eterm res = *res_accp; + + ERTS_PROCS_DBG_VERIFY_PIDS(pbdp); + ERTS_PROCS_DBG_CHK_RESLIST(res); + + ERTS_PROCS_DBG_TRACE(p->id, processes_bif_engine, begin_build_res); + + have_reds = ERTS_BIF_REDS_LEFT(p); + conses = ERTS_PROCESSES_BIF_BUILD_RESULT_CONSES_PER_RED*have_reds; + min_ix = pbdp->pid_ix - conses; + if (min_ix < 0) { + min_ix = 0; + conses = pbdp->pid_ix; + } + + hp = HAlloc(p, conses*2); + ERTS_PROCS_DBG_SAVE_HEAP_ALLOC(pbdp, hp, conses*2); + + for (ix = pbdp->pid_ix - 1; ix >= min_ix; ix--) { + ERTS_PROCS_ASSERT(is_internal_pid(pbdp->pid[ix])); + res = CONS(hp, pbdp->pid[ix], res); + hp += 2; + } + + ERTS_PROCS_DBG_VERIFY_HEAP_ALLOC_USED(pbdp, hp); + + pbdp->pid_ix = min_ix; + if (min_ix == 0) + pbdp->state = RETURN_RESULT; + else { + pbdp->pid_sz = min_ix; + pbdp->pid = erts_realloc(ERTS_ALC_T_PROCS_PIDS, + pbdp->pid, + sizeof(Eterm)*pbdp->pid_sz); +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS + pbdp->debug.pid_started = erts_realloc(ERTS_ALC_T_PROCS_PIDS, + pbdp->debug.pid_started, + sizeof(SysTimeval)*pbdp->pid_sz); +#endif + } + reds = conses/ERTS_PROCESSES_BIF_BUILD_RESULT_CONSES_PER_RED; + BUMP_REDS(p, reds); + have_reds -= reds; + + ERTS_PROCS_DBG_CHK_RESLIST(res); + ERTS_PROCS_DBG_TRACE(p->id, processes_bif_engine, end_build_res); + *res_accp = res; + break; + } + case RETURN_RESULT: + cleanup_processes_bif_data(mbp); + return 1; + + default: + erl_exit(ERTS_ABORT_EXIT, + "erlang:processes/0: Invalid state: %d\n", + (int) pbdp->state); + } + + + } while (have_reds || pbdp->state == RETURN_RESULT); + + return 0; +} + +/* + * processes_trap/2 is a hidden BIF that processes/0 traps to. + */ + +static BIF_RETTYPE processes_trap(BIF_ALIST_2) +{ + Eterm res_acc; + Binary *mbp; + + /* + * This bif cannot be called from erlang code. It can only be + * trapped to from processes/0; therefore, a bad argument + * is a processes/0 internal error. + */ + + ERTS_PROCS_DBG_TRACE(BIF_P->id, processes_trap, call); + ERTS_PROCS_ASSERT(is_nil(BIF_ARG_1) || is_list(BIF_ARG_1)); + + res_acc = BIF_ARG_1; + + ERTS_PROCS_ASSERT(ERTS_TERM_IS_MAGIC_BINARY(BIF_ARG_2)); + + mbp = ((ProcBin *) binary_val(BIF_ARG_2))->val; + + ERTS_PROCS_ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) + == cleanup_processes_bif_data); + ERTS_PROCS_ASSERT( + ((ErtsProcessesBifData *) ERTS_MAGIC_BIN_DATA(mbp))->debug.caller + == BIF_P->id); + + if (processes_bif_engine(BIF_P, &res_acc, mbp)) { + ERTS_PROCS_DBG_TRACE(BIF_P->id, processes_trap, return); + BIF_RET(res_acc); + } + else { + ERTS_PROCS_DBG_TRACE(BIF_P->id, processes_trap, trap); + ERTS_BIF_YIELD2(&processes_trap_export, BIF_P, res_acc, BIF_ARG_2); + } +} + + + +/* + * The actual processes/0 BIF. + */ + +BIF_RETTYPE processes_0(BIF_ALIST_0) +{ + /* + * A requirement: The list of pids returned should be a consistent + * snapshot of all processes existing at some point + * in time during the execution of processes/0. Since + * processes might terminate while processes/0 is + * executing, we have to keep track of terminated + * processes and add them to the result. We also + * ignore processes created after processes/0 has + * begun executing. + */ + Eterm res_acc = NIL; + Binary *mbp = erts_create_magic_binary(sizeof(ErtsProcessesBifData), + cleanup_processes_bif_data); + ErtsProcessesBifData *pbdp = ERTS_MAGIC_BIN_DATA(mbp); + + ERTS_PROCS_DBG_TRACE(BIF_P->id, processes_0, call); + pbdp->state = INITIALIZING; + ERTS_PROCS_DBG_INIT(BIF_P, pbdp); + + if (ERTS_BIF_REDS_LEFT(BIF_P) >= ERTS_PROCESSES_BIF_MIN_START_REDS + && processes_bif_engine(BIF_P, &res_acc, mbp)) { + erts_bin_free(mbp); + ERTS_PROCS_DBG_CHK_RESLIST(res_acc); + ERTS_PROCS_DBG_TRACE(BIF_P->id, processes_0, return); + BIF_RET(res_acc); + } + else { + Eterm *hp; + Eterm magic_bin; + ERTS_PROCS_DBG_CHK_RESLIST(res_acc); + hp = HAlloc(BIF_P, PROC_BIN_SIZE); + ERTS_PROCS_DBG_SAVE_HEAP_ALLOC(pbdp, hp, PROC_BIN_SIZE); + magic_bin = erts_mk_magic_binary_term(&hp, &MSO(BIF_P), mbp); + ERTS_PROCS_DBG_VERIFY_HEAP_ALLOC_USED(pbdp, hp); + ERTS_PROCS_DBG_TRACE(BIF_P->id, processes_0, trap); + ERTS_BIF_YIELD2(&processes_trap_export, BIF_P, res_acc, magic_bin); + } +} + +static void +init_processes_bif(void) +{ + saved_term_procs.start = NULL; + saved_term_procs.end = NULL; + processes_bif_tab_chunks = (((erts_max_processes - 1) + / ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE) + + 1); + + /* processes_trap/2 is a hidden BIF that the processes/0 BIF traps to. */ + sys_memset((void *) &processes_trap_export, 0, sizeof(Export)); + processes_trap_export.address = &processes_trap_export.code[3]; + processes_trap_export.code[0] = am_erlang; + processes_trap_export.code[1] = am_processes_trap; + processes_trap_export.code[2] = 2; + processes_trap_export.code[3] = (Eterm) em_apply_bif; + processes_trap_export.code[4] = (Eterm) &processes_trap; + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_TERM_PROC_LIST + erts_get_emu_time(&debug_tv_start); +#endif + +} + +/* + * Debug stuff + */ + +Eterm +erts_debug_processes(Process *c_p) +{ + /* This is the old processes/0 BIF. */ + int i; + Uint need; + Eterm res; + Eterm* hp; + Process *p; +#ifdef DEBUG + Eterm *hp_end; +#endif + + erts_smp_mtx_lock(&proc_tab_mtx); + + res = NIL; + need = erts_process_count() * 2; + hp = HAlloc(c_p, need); /* we need two heap words for each pid */ +#ifdef DEBUG + hp_end = hp + need; +#endif + + /* make the list by scanning bakward */ + + + for (i = erts_max_processes-1; i >= 0; i--) { + if ((p = process_tab[i]) != NULL) { + res = CONS(hp, process_tab[i]->id, res); + hp += 2; + } + } + ASSERT(hp == hp_end); + + erts_smp_mtx_unlock(&proc_tab_mtx); + + return res; +} + +Eterm +erts_debug_processes_bif_info(Process *c_p) +{ + ERTS_DECL_AM(processes_bif_info); + Eterm elements[] = { + AM_processes_bif_info, + make_small((Uint) ERTS_PROCESSES_BIF_MIN_START_REDS), + make_small((Uint) processes_bif_tab_chunks), + make_small((Uint) ERTS_PROCESSES_BIF_TAB_CHUNK_SIZE), + make_small((Uint) ERTS_PROCESSES_BIF_TAB_INSPECT_INDICES_PER_RED), + make_small((Uint) ERTS_PROCESSES_BIF_TAB_FREE_TERM_PROC_REDS), + make_small((Uint) ERTS_PROCESSES_BIF_INSPECT_TERM_PROC_PER_RED), + make_small((Uint) ERTS_PROCESSES_INSPECT_TERM_PROC_MAX_REDS), + make_small((Uint) ERTS_PROCESSES_BIF_BUILD_RESULT_CONSES_PER_RED), + make_small((Uint) ERTS_PROCESSES_BIF_DEBUGLEVEL) + }; + Uint sz = 0; + Eterm *hp; + (void) erts_bld_tuplev(NULL, &sz, sizeof(elements)/sizeof(Eterm), elements); + hp = HAlloc(c_p, sz); + return erts_bld_tuplev(&hp, NULL, sizeof(elements)/sizeof(Eterm), elements); +} + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_FOUND_PIDS +static void +debug_processes_check_found_pid(ErtsProcessesBifData *pbdp, + Eterm pid, + SysTimeval *tvp, + int pid_should_be_found) +{ + int i; + for (i = 0; i < pbdp->pid_ix; i++) { + if (pbdp->pid[i] == pid + && pbdp->debug.pid_started[i].tv_sec == tvp->tv_sec + && pbdp->debug.pid_started[i].tv_usec == tvp->tv_usec) { + ERTS_PROCS_ASSERT(pid_should_be_found); + return; + } + } + ERTS_PROCS_ASSERT(!pid_should_be_found); +} +#endif + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_RESLIST +static void +debug_processes_check_res_list(Eterm list) +{ + while (is_list(list)) { + Eterm* consp = list_val(list); + Eterm hd = CAR(consp); + ERTS_PROCS_ASSERT(is_internal_pid(hd)); + list = CDR(consp); + } + + ERTS_PROCS_ASSERT(is_nil(list)); +} +#endif + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_PIDS + +static void +debug_processes_save_all_pids(ErtsProcessesBifData *pbdp) +{ + int ix, tix, cpix; + pbdp->debug.correct_pids_verified = 0; + pbdp->debug.correct_pids = erts_alloc(ERTS_ALC_T_PROCS_PIDS, + sizeof(Eterm)*pbdp->pid_sz); + + for (tix = 0, cpix = 0; tix < erts_max_processes; tix++) { + Process *rp = process_tab[tix]; + if (rp) { + ERTS_PROCS_ASSERT(is_internal_pid(rp->id)); + pbdp->debug.correct_pids[cpix++] = rp->id; + ERTS_PROCS_ASSERT(cpix <= pbdp->pid_sz); + } + } + ERTS_PROCS_ASSERT(cpix == pbdp->pid_sz); + + for (ix = 0; ix < pbdp->pid_sz; ix++) + pbdp->pid[ix] = make_small(ix); +} + +static void +debug_processes_verify_all_pids(ErtsProcessesBifData *pbdp) +{ + int ix, cpix; + + ERTS_PROCS_ASSERT(pbdp->pid_ix == pbdp->pid_sz); + + for (ix = 0; ix < pbdp->pid_sz; ix++) { + int found = 0; + Eterm pid = pbdp->pid[ix]; + ERTS_PROCS_ASSERT(is_internal_pid(pid)); + for (cpix = ix; cpix < pbdp->pid_sz; cpix++) { + if (pbdp->debug.correct_pids[cpix] == pid) { + pbdp->debug.correct_pids[cpix] = NIL; + found = 1; + break; + } + } + if (!found) { + for (cpix = 0; cpix < ix; cpix++) { + if (pbdp->debug.correct_pids[cpix] == pid) { + pbdp->debug.correct_pids[cpix] = NIL; + found = 1; + break; + } + } + } + ERTS_PROCS_ASSERT(found); + } + pbdp->debug.correct_pids_verified = 1; + + erts_free(ERTS_ALC_T_PROCS_PIDS, pbdp->debug.correct_pids); + pbdp->debug.correct_pids = NULL; +} +#endif /* ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_PIDS */ + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL >= ERTS_PROCS_DBGLVL_CHK_TERM_PROC_LIST +static void +debug_processes_check_term_proc_list(void) +{ + ERTS_SMP_LC_ASSERT(erts_lc_mtx_is_locked(&proc_tab_mtx)); + if (!saved_term_procs.start) + ERTS_PROCS_ASSERT(!saved_term_procs.end); + else { + SysTimeval tv_now; + SysTimeval *prev_xtvp = NULL; + ErtsTermProcElement *tpep; + erts_get_emu_time(&tv_now); + + for (tpep = saved_term_procs.start; tpep; tpep = tpep->next) { + if (!tpep->prev) + ERTS_PROCS_ASSERT(saved_term_procs.start == tpep); + else + ERTS_PROCS_ASSERT(tpep->prev->next == tpep); + if (!tpep->next) + ERTS_PROCS_ASSERT(saved_term_procs.end == tpep); + else + ERTS_PROCS_ASSERT(tpep->next->prev == tpep); + if (tpep->ix < 0) { + SysTimeval *tvp = &tpep->u.bif_invocation.time; + ERTS_PROCS_ASSERT(erts_cmp_timeval(&debug_tv_start, tvp) < 0 + && erts_cmp_timeval(tvp, &tv_now) < 0); + } + else { + SysTimeval *stvp = &tpep->u.process.spawned; + SysTimeval *xtvp = &tpep->u.process.exited; + + ERTS_PROCS_ASSERT(erts_cmp_timeval(&debug_tv_start, + stvp) < 0); + ERTS_PROCS_ASSERT(erts_cmp_timeval(stvp, xtvp) < 0); + if (prev_xtvp) + ERTS_PROCS_ASSERT(erts_cmp_timeval(prev_xtvp, xtvp) < 0); + prev_xtvp = xtvp; + ERTS_PROCS_ASSERT(is_internal_pid(tpep->u.process.pid)); + ERTS_PROCS_ASSERT(tpep->ix + == internal_pid_index(tpep->u.process.pid)); + } + } + + } +} + +static void +debug_processes_check_term_proc_free_list(ErtsTermProcElement *free_list) +{ + if (saved_term_procs.start) { + ErtsTermProcElement *ftpep; + ErtsTermProcElement *tpep; + + for (ftpep = free_list; ftpep; ftpep = ftpep->next) { + for (tpep = saved_term_procs.start; tpep; tpep = tpep->next) + ERTS_PROCS_ASSERT(ftpep != tpep); + } + } +} + +#endif + +#if ERTS_PROCESSES_BIF_DEBUGLEVEL != 0 + +static void +debug_processes_assert_error(char* expr, char* file, int line) +{ + fflush(stdout); + erts_fprintf(stderr, "%s:%d: Assertion failed: %s\n", file, line, expr); + fflush(stderr); + abort(); +} + +#endif + +/* *\ + * End of the processes/0 BIF implementation. * +\* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ diff --git a/erts/emulator/beam/erl_process.h b/erts/emulator/beam/erl_process.h new file mode 100644 index 0000000000..7bae1e4efc --- /dev/null +++ b/erts/emulator/beam/erl_process.h @@ -0,0 +1,1495 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __PROCESS_H__ +#define __PROCESS_H__ + +#undef ERTS_INCLUDE_SCHEDULER_INTERNALS +#if (defined(ERL_PROCESS_C__) \ + || defined(ERL_PORT_TASK_C__) \ + || (ERTS_GLB_INLINE_INCL_FUNC_DEF \ + && defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF))) +#define ERTS_INCLUDE_SCHEDULER_INTERNALS +#endif + +typedef struct process Process; + +#include "sys.h" + +#define ERTS_PROCESS_LOCK_ONLY_PROC_LOCK_TYPE__ +#include "erl_process_lock.h" /* Only pull out important types... */ +#undef ERTS_PROCESS_LOCK_ONLY_PROC_LOCK_TYPE__ + +#include "erl_vm.h" +#include "erl_smp.h" +#include "erl_message.h" +#include "erl_process_dict.h" +#include "erl_node_container_utils.h" +#include "erl_node_tables.h" +#include "erl_monitors.h" +#include "erl_bif_timer.h" +#include "erl_time.h" +#include "erl_atom_table.h" +#include "external.h" + +#ifdef HIPE +#include "hipe_process.h" +#endif + +struct ErtsNodesMonitor_; +struct port; + +#define ERTS_MAX_NO_OF_SCHEDULERS 1024 + +#define ERTS_DEFAULT_MAX_PROCESSES (1 << 15) + +#define ERTS_HEAP_ALLOC(Type, Size) \ + erts_alloc((Type), (Size)) + +#define ERTS_HEAP_REALLOC(Type, Ptr, OldSize, NewSize) \ + erts_realloc((Type), (Ptr), (NewSize)) + +#define ERTS_HEAP_FREE(Type, Ptr, Size) \ + erts_free((Type), (Ptr)) + +#define INITIAL_MOD 0 +#define INITIAL_FUN 1 +#define INITIAL_ARI 2 + +#include "export.h" + +struct saved_calls { + int len; + int n; + int cur; + Export *ct[1]; +}; + +extern Export exp_send, exp_receive, exp_timeout; +extern Uint erts_no_schedulers; +extern Uint erts_no_run_queues; +extern int erts_sched_thread_suggested_stack_size; +#define ERTS_SCHED_THREAD_MIN_STACK_SIZE 4 /* Kilo words */ +#define ERTS_SCHED_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */ + +#ifdef ERTS_SMP +#include "erl_bits.h" +#endif + +/* process priorities */ +#define PRIORITY_MAX 0 +#define PRIORITY_HIGH 1 +#define PRIORITY_NORMAL 2 +#define PRIORITY_LOW 3 +#define ERTS_NO_PROC_PRIO_LEVELS 4 + +#define ERTS_PORT_PRIO_LEVEL ERTS_NO_PROC_PRIO_LEVELS + +#define ERTS_RUNQ_FLGS_PROCS_QMASK \ + ((((Uint32) 1) << ERTS_NO_PROC_PRIO_LEVELS) - 1) + +#define ERTS_NO_PRIO_LEVELS (ERTS_NO_PROC_PRIO_LEVELS + 1) +#define ERTS_RUNQ_FLGS_MIGRATE_QMASK \ + ((((Uint32) 1) << ERTS_NO_PRIO_LEVELS) - 1) + +#define ERTS_RUNQ_FLGS_EMIGRATE_SHFT \ + ERTS_NO_PROC_PRIO_LEVELS +#define ERTS_RUNQ_FLGS_IMMIGRATE_SHFT \ + (ERTS_RUNQ_FLGS_EMIGRATE_SHFT + ERTS_NO_PRIO_LEVELS) +#define ERTS_RUNQ_FLGS_EVACUATE_SHFT \ + (ERTS_RUNQ_FLGS_IMMIGRATE_SHFT + ERTS_NO_PRIO_LEVELS) +#define ERTS_RUNQ_FLGS_EMIGRATE_QMASK \ + (ERTS_RUNQ_FLGS_MIGRATE_QMASK << ERTS_RUNQ_FLGS_EMIGRATE_SHFT) +#define ERTS_RUNQ_FLGS_IMMIGRATE_QMASK \ + (ERTS_RUNQ_FLGS_MIGRATE_QMASK << ERTS_RUNQ_FLGS_IMMIGRATE_SHFT) +#define ERTS_RUNQ_FLGS_EVACUATE_QMASK \ + (ERTS_RUNQ_FLGS_MIGRATE_QMASK << ERTS_RUNQ_FLGS_EVACUATE_SHFT) + +#define ERTS_RUNQ_FLG_BASE2 \ + (ERTS_RUNQ_FLGS_EVACUATE_SHFT + ERTS_NO_PRIO_LEVELS) + +#define ERTS_RUNQ_FLG_OUT_OF_WORK \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 0)) +#define ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 1)) +#define ERTS_RUNQ_FLG_SUSPENDED \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 2)) +#define ERTS_RUNQ_FLG_SHARED_RUNQ \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 3)) +#define ERTS_RUNQ_FLG_CHK_CPU_BIND \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 4)) +#define ERTS_RUNQ_FLG_INACTIVE \ + (((Uint32) 1) << (ERTS_RUNQ_FLG_BASE2 + 5)) + +#define ERTS_RUNQ_FLGS_MIGRATION_QMASKS \ + (ERTS_RUNQ_FLGS_EMIGRATE_QMASK \ + | ERTS_RUNQ_FLGS_IMMIGRATE_QMASK \ + | ERTS_RUNQ_FLGS_EVACUATE_QMASK) +#define ERTS_RUNQ_FLGS_MIGRATION_INFO \ + (ERTS_RUNQ_FLGS_MIGRATION_QMASKS \ + | ERTS_RUNQ_FLG_INACTIVE \ + | ERTS_RUNQ_FLG_OUT_OF_WORK \ + | ERTS_RUNQ_FLG_HALFTIME_OUT_OF_WORK) + +#define ERTS_RUNQ_FLG_EMIGRATE(PRIO) \ + (((Uint32) 1) << (ERTS_RUNQ_FLGS_EMIGRATE_SHFT + (PRIO))) +#define ERTS_CHK_RUNQ_FLG_EMIGRATE(FLGS, PRIO) \ + ((FLGS) & ERTS_RUNQ_FLG_EMIGRATE((PRIO))) +#define ERTS_SET_RUNQ_FLG_EMIGRATE(FLGS, PRIO) \ + ((FLGS) |= ERTS_RUNQ_FLG_EMIGRATE((PRIO))) +#define ERTS_UNSET_RUNQ_FLG_EMIGRATE(FLGS, PRIO) \ + ((FLGS) &= ~ERTS_RUNQ_FLG_EMIGRATE((PRIO))) + +#define ERTS_RUNQ_FLG_IMMIGRATE(PRIO) \ + (((Uint32) 1) << (ERTS_RUNQ_FLGS_IMMIGRATE_SHFT + (PRIO))) +#define ERTS_CHK_RUNQ_FLG_IMMIGRATE(FLGS, PRIO) \ + ((FLGS) & ERTS_RUNQ_FLG_IMMIGRATE((PRIO))) +#define ERTS_SET_RUNQ_FLG_IMMIGRATE(FLGS, PRIO) \ + ((FLGS) |= ERTS_RUNQ_FLG_IMMIGRATE((PRIO))) +#define ERTS_UNSET_RUNQ_FLG_IMMIGRATE(FLGS, PRIO) \ + ((FLGS) &= ~ERTS_RUNQ_FLG_IMMIGRATE((PRIO))) + +#define ERTS_RUNQ_FLG_EVACUATE(PRIO) \ + (((Uint32) 1) << (ERTS_RUNQ_FLGS_EVACUATE_SHFT + (PRIO))) +#define ERTS_CHK_RUNQ_FLG_EVACUATE(FLGS, PRIO) \ + ((FLGS) & ERTS_RUNQ_FLG_EVACUATE((PRIO))) +#define ERTS_SET_RUNQ_FLG_EVACUATE(FLGS, PRIO) \ + ((FLGS) |= ERTS_RUNQ_FLG_EVACUATE((PRIO))) +#define ERTS_UNSET_RUNQ_FLG_EVACUATE(FLGS, PRIO) \ + ((FLGS) &= ~ERTS_RUNQ_FLG_EVACUATE((PRIO))) + +#define ERTS_RUNQ_IFLG_SUSPENDED (((long) 1) << 0) +#define ERTS_RUNQ_IFLG_NONEMPTY (((long) 1) << 1) + + +#ifdef DEBUG +# ifdef ARCH_64 +# define ERTS_DBG_SET_INVALID_RUNQP(RQP, N) \ + (*((char **) &(RQP)) = (char *) (0xdeadbeefdead0003 | ((N) << 4))) +# define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) \ +do { \ + ASSERT((RQP) != NULL); \ + ASSERT(((((Uint) (RQP)) & ((Uint) 0x3))) == ((Uint) 0)); \ + ASSERT((((Uint) (RQP)) & ~((Uint) 0xffff)) != ((Uint) 0xdeadbeefdead0000));\ +} while (0) +# else +# define ERTS_DBG_SET_INVALID_RUNQP(RQP, N) \ + (*((char **) &(RQP)) = (char *) (0xdead0003 | ((N) << 4))) +# define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) \ +do { \ + ASSERT((RQP) != NULL); \ + ASSERT(((((Uint) (RQP)) & ((Uint) 1))) == ((Uint) 0)); \ + ASSERT((((Uint) (RQP)) & ~((Uint) 0xffff)) != ((Uint) 0xdead0000)); \ +} while (0) +# endif +#else +# define ERTS_DBG_SET_INVALID_RUNQP(RQP, N) +# define ERTS_DBG_VERIFY_VALID_RUNQP(RQP) +#endif + +typedef enum { + ERTS_SCHDLR_SSPND_DONE_MSCHED_BLOCKED, + ERTS_SCHDLR_SSPND_YIELD_DONE_MSCHED_BLOCKED, + ERTS_SCHDLR_SSPND_DONE, + ERTS_SCHDLR_SSPND_YIELD_RESTART, + ERTS_SCHDLR_SSPND_YIELD_DONE, + ERTS_SCHDLR_SSPND_EINVAL +} ErtsSchedSuspendResult; + +typedef enum { + ERTS_MIGRATE_SUCCESS, + ERTS_MIGRATE_FAILED_NOT_IN_RUNQ, + ERTS_MIGRATE_FAILED_RUNQ_CHANGED, + ERTS_MIGRATE_FAILED_RUNQ_SUSPENDED +} ErtsMigrateResult; + +/* times to reschedule low prio process before running */ +#define RESCHEDULE_LOW 8 + +#define ERTS_MAX_MISC_OPS 5 + +#define ERTS_FULL_REDS_HISTORY_AVG_SHFT 3 +#define ERTS_FULL_REDS_HISTORY_SIZE \ + ((1 << ERTS_FULL_REDS_HISTORY_AVG_SHFT) - 1) + +typedef struct ErtsProcList_ ErtsProcList; +struct ErtsProcList_ { + Eterm pid; + SysTimeval started; + ErtsProcList* next; +}; + +typedef struct ErtsMiscOpList_ ErtsMiscOpList; +struct ErtsMiscOpList_ { + ErtsMiscOpList *next; + void (*func)(void *arg); + void *arg; +}; + +typedef struct { + Process* first; + Process* last; +} ErtsRunPrioQueue; + +typedef struct ErtsSchedulerData_ ErtsSchedulerData; + +typedef struct ErtsRunQueue_ ErtsRunQueue; + +typedef struct { + int len; + int max_len; + int reds; + struct { + struct { + int this; + int other; + } limit; + ErtsRunQueue *runq; + } migrate; +} ErtsRunQueueInfo; + +struct ErtsRunQueue_ { + int ix; + erts_smp_atomic_t info_flags; + + erts_smp_mtx_t mtx; + erts_smp_cnd_t cnd; + + erts_smp_atomic_t spin_waiter; + erts_smp_atomic_t spin_wake; + + ErtsSchedulerData *scheduler; + int waiting; /* < 0 in sys schedule; > 0 on cnd variable */ + int woken; + Uint32 flags; + int check_balance_reds; + int full_reds_history_sum; + int full_reds_history[ERTS_FULL_REDS_HISTORY_SIZE]; + int out_of_work_count; + int max_len; + int len; + int wakeup_other; + int wakeup_other_reds; + + struct { + int len; + ErtsProcList *pending_exiters; + Uint context_switches; + Uint reductions; + + ErtsRunQueueInfo prio_info[ERTS_NO_PROC_PRIO_LEVELS]; + + /* We use the same prio queue for low and + normal prio processes */ + ErtsRunPrioQueue prio[ERTS_NO_PROC_PRIO_LEVELS-1]; + } procs; + + struct { + ErtsMiscOpList *start; + ErtsMiscOpList *end; + ErtsRunQueue *evac_runq; + } misc; + + struct { + ErtsRunQueueInfo info; + struct port *start; + struct port *end; + } ports; +}; + +typedef union { + ErtsRunQueue runq; + char align[ERTS_ALC_CACHE_LINE_ALIGN_SIZE(sizeof(ErtsRunQueue))]; +} ErtsAlignedRunQueue; + +extern ErtsAlignedRunQueue *erts_aligned_run_queues; +extern ErtsRunQueue *erts_common_run_queue; + +#define ERTS_PROC_REDUCTIONS_EXECUTED(RQ, PRIO, REDS, AREDS) \ +do { \ + (RQ)->procs.reductions += (AREDS); \ + (RQ)->procs.prio_info[p->prio].reds += (REDS); \ + (RQ)->check_balance_reds -= (REDS); \ + (RQ)->wakeup_other_reds += (AREDS); \ +} while (0) + +#define ERTS_PORT_REDUCTIONS_EXECUTED(RQ, REDS) \ +do { \ + (RQ)->ports.info.reds += (REDS); \ + (RQ)->check_balance_reds -= (REDS); \ + (RQ)->wakeup_other_reds += (REDS); \ +} while (0) + +struct ErtsSchedulerData_ { + +#ifdef ERTS_SMP + ethr_tid tid; /* Thread id */ + Eterm save_reg[ERTS_X_REGS_ALLOCATED]; /* X registers */ + FloatDef freg[MAX_REG]; /* Floating point registers. */ + struct erl_bits_state erl_bits_state; /* erl_bits.c state */ + void *match_pseudo_process; /* erl_db_util.c:db_prog_match() */ + Process *free_process; +#endif + + Process *current_process; + Uint no; /* Scheduler number */ + struct port *current_port; + ErtsRunQueue *run_queue; + int virtual_reds; + int cpu_id; /* >= 0 when bound */ + + ErtsAtomCacheMap atom_cache_map; + +#ifdef ERTS_SMP + /* NOTE: These fields are modified under held mutexes by other threads */ +#ifdef ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN + int check_children; /* run queue mutex */ + int blocked_check_children; /* schdlr_sspnd mutex */ +#endif + erts_smp_atomic_t suspended; /* Only used when common run queue */ + erts_smp_atomic_t chk_cpu_bind; /* Only used when common run queue */ +#endif +}; + +#ifndef ERTS_SMP +extern ErtsSchedulerData *erts_scheduler_data; +#endif + +/* + * Process Specific Data. + * + * NOTE: Only use PSD for very rarely used data. + */ + +#define ERTS_PSD_ERROR_HANDLER 0 +#define ERTS_PSD_SAVED_CALLS_BUF 1 +#define ERTS_PSD_SCHED_ID 2 +#define ERTS_PSD_DIST_ENTRY 3 + +#define ERTS_PSD_SIZE 4 + +typedef struct { + void *data[ERTS_PSD_SIZE]; +} ErtsPSD; + +#ifdef ERTS_ENABLE_LOCK_CHECK +#define ERTS_LC_PSD_ANY_LOCK (~ERTS_PROC_LOCKS_ALL) + +#define ERTS_PSD_ERROR_HANDLER_BUF_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_ERROR_HANDLER_BUF_SET_LOCKS ERTS_PROC_LOCK_MAIN + +#define ERTS_PSD_SAVED_CALLS_BUF_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_SAVED_CALLS_BUF_SET_LOCKS ERTS_PROC_LOCK_MAIN + +#define ERTS_PSD_SCHED_ID_GET_LOCKS ERTS_PROC_LOCK_STATUS +#define ERTS_PSD_SCHED_ID_SET_LOCKS ERTS_PROC_LOCK_STATUS + +#define ERTS_PSD_DIST_ENTRY_GET_LOCKS ERTS_PROC_LOCK_MAIN +#define ERTS_PSD_DIST_ENTRY_SET_LOCKS ERTS_PROC_LOCK_MAIN + +typedef struct { + ErtsProcLocks get_locks; + ErtsProcLocks set_locks; +} ErtsLcPSDLocks; + +extern ErtsLcPSDLocks erts_psd_required_locks[ERTS_PSD_SIZE]; + +#endif + +#define ERTS_SCHED_STAT_MODIFY_DISABLE 1 +#define ERTS_SCHED_STAT_MODIFY_ENABLE 2 +#define ERTS_SCHED_STAT_MODIFY_CLEAR 3 + +typedef struct { + erts_smp_spinlock_t lock; + int enabled; + struct { + Eterm name; + Uint total_executed; + Uint executed; + Uint total_migrated; + Uint migrated; + } prio[ERTS_NO_PRIO_LEVELS]; +} erts_sched_stat_t; + +extern erts_sched_stat_t erts_sched_stat; + +typedef struct { + Eterm reason; + ErlHeapFragment *bp; +} ErtsPendExit; + +#ifdef ERTS_SMP + +typedef struct ErtsPendingSuspend_ ErtsPendingSuspend; +struct ErtsPendingSuspend_ { + ErtsPendingSuspend *next; + ErtsPendingSuspend *end; + Eterm pid; + void (*handle_func)(Process *suspendee, + ErtsProcLocks suspendee_locks, + int suspendee_alive, + Eterm pid); +}; + +#endif + +/* Defines to ease the change of memory architecture */ +# define HEAP_START(p) (p)->heap +# define HEAP_TOP(p) (p)->htop +# define HEAP_LIMIT(p) (p)->stop +# define HEAP_END(p) (p)->hend +# define HEAP_SIZE(p) (p)->heap_sz +# define STACK_START(p) (p)->hend +# define STACK_TOP(p) (p)->stop +# define STACK_END(p) (p)->htop +# define HIGH_WATER(p) (p)->high_water +# define OLD_HEND(p) (p)->old_hend +# define OLD_HTOP(p) (p)->old_htop +# define OLD_HEAP(p) (p)->old_heap +# define GEN_GCS(p) (p)->gen_gcs +# define MAX_GEN_GCS(p) (p)->max_gen_gcs +# define FLAGS(p) (p)->flags +# define MBUF(p) (p)->mbuf +# define HALLOC_MBUF(p) (p)->halloc_mbuf +# define MBUF_SIZE(p) (p)->mbuf_sz +# define MSO(p) (p)->off_heap +# define MIN_HEAP_SIZE(p) (p)->min_heap_size + +# define BIN_VHEAP_SZ(p) (p)->bin_vheap_sz +# define BIN_OLD_VHEAP_SZ(p) (p)->bin_old_vheap_sz +# define BIN_OLD_VHEAP(p) (p)->bin_old_vheap + +struct process { + /* All fields in the PCB that differs between different heap + * architectures, have been moved to the end of this struct to + * make sure that as few offsets as possible differ. Different + * offsets between memory architectures in this struct, means that + * native code have to use functions instead of constants. + */ + + Eterm* htop; /* Heap top */ + Eterm* stop; /* Stack top */ + Eterm* heap; /* Heap start */ + Eterm* hend; /* Heap end */ + Uint heap_sz; /* Size of heap in words */ + Uint min_heap_size; /* Minimum size of heap (in words). */ + +#if !defined(NO_FPE_SIGNALS) + volatile unsigned long fp_exception; +#endif + +#ifdef HIPE + /* HiPE-specific process fields. Put it early in struct process, + to enable smaller & faster addressing modes on the x86. */ + struct hipe_process_state hipe; +#endif + + /* + * Saved x registers. + */ + Uint arity; /* Number of live argument registers (only valid + * when process is *not* running). + */ + Eterm* arg_reg; /* Pointer to argument registers. */ + unsigned max_arg_reg; /* Maximum number of argument registers available. */ + Eterm def_arg_reg[6]; /* Default array for argument registers. */ + + Eterm* cp; /* Continuation pointer (for threaded code). */ + Eterm* i; /* Program counter for threaded code. */ + Sint catches; /* Number of catches on stack */ + Sint fcalls; /* + * Number of reductions left to execute. + * Only valid for the current process. + */ + Uint32 status; /* process STATE */ + Uint32 gcstatus; /* process gc STATE */ + Uint32 rstatus; /* process resume STATE */ + Uint32 rcount; /* suspend count */ + Eterm id; /* The pid of this process */ + int prio; /* Priority of process */ + int skipped; /* Times a low prio process has been rescheduled */ + Uint reds; /* No of reductions for this process */ + Eterm tracer_proc; /* If proc is traced, this is the tracer + (can NOT be boxed) */ + Uint trace_flags; /* Trace flags (used to be in flags) */ + Eterm group_leader; /* Pid in charge + (can be boxed) */ + Uint flags; /* Trap exit, etc (no trace flags anymore) */ + Eterm fvalue; /* Exit & Throw value (failure reason) */ + Uint freason; /* Reason for detected failure */ + Eterm ftrace; /* Latest exception stack trace dump */ + + Process *next; /* Pointer to next process in run queue */ + Process *prev; /* Pointer to prev process in run queue */ + + struct reg_proc *reg; /* NULL iff not registered */ + ErtsLink *nlinks; + ErtsMonitor *monitors; /* The process monitors, both ends */ + + struct ErtsNodesMonitor_ *nodes_monitors; + + ErtsSuspendMonitor *suspend_monitors; /* Processes suspended by + this process via + erlang:suspend_process/1 */ + + ErlMessageQueue msg; /* Message queue */ + + ErtsBifTimer *bif_timers; /* Bif timers aiming at this process */ + + ProcDict *dictionary; /* Process dictionary, may be NULL */ + + Uint seq_trace_clock; + Uint seq_trace_lastcnt; + Eterm seq_trace_token; /* Sequential trace token (tuple size 5 see below) */ + + Eterm initial[3]; /* Initial module(0), function(1), arity(2) */ + Eterm* current; /* Current Erlang function: + * module(0), function(1), arity(2) + * (module and functions are tagged atoms; + * arity an untagged integer). + */ + + /* + * Information mainly for post-mortem use (erl crash dump). + */ + Eterm parent; /* Pid of process that created this process. */ + SysTimeval started; /* Time when started. */ + + + /* This is the place, where all fields that differs between memory + * architectures, have gone to. + */ + + Eterm *high_water; + Eterm *old_hend; /* Heap pointers for generational GC. */ + Eterm *old_htop; + Eterm *old_heap; + Uint16 gen_gcs; /* Number of (minor) generational GCs. */ + Uint16 max_gen_gcs; /* Max minor gen GCs before fullsweep. */ + ErlOffHeap off_heap; /* Off-heap data updated by copy_struct(). */ + ErlHeapFragment* mbuf; /* Pointer to message buffer list */ + Uint mbuf_sz; /* Size of all message buffers */ + ErtsPSD *psd; /* Rarely used process specific data */ + + Uint bin_vheap_sz; /* Virtual heap block size for binaries */ + Uint bin_old_vheap_sz; /* Virtual old heap block size for binaries */ + Uint bin_old_vheap; /* Virtual old heap size for binaries */ + + union { +#ifdef ERTS_SMP + ErtsSmpPTimer *ptimer; +#else + ErlTimer tm; /* Timer entry */ +#endif + void *exit_data; /* Misc data referred during termination */ + } u; + + ErtsRunQueue *bound_runq; + +#ifdef ERTS_SMP + erts_proc_lock_t lock; + ErtsSchedulerData *scheduler_data; + int is_exiting; + Uint32 runq_flags; + Uint32 status_flags; + ErlMessageInQueue msg_inq; + Eterm suspendee; + ErtsPendingSuspend *pending_suspenders; + ErtsPendExit pending_exit; + ErtsRunQueue *run_queue; +#ifdef HIPE + struct hipe_process_state_smp hipe_smp; +#endif +#endif + +#ifdef HYBRID + Eterm *rrma; /* Remembered roots to Message Area */ + Eterm **rrsrc; /* The source of the root */ + Uint nrr; /* Number of remembered roots */ + Uint rrsz; /* Size of root array */ +#endif + +#ifdef HYBRID + Uint active; /* Active since last major collection? */ + Uint active_index; /* Index in the active process array */ +#endif + +#ifdef INCREMENTAL + Process *active_next; /* Active processes to scan for roots */ + Process *active_prev; /* in collection of the message area */ + Eterm *scan_top; +#endif + +#ifdef CHECK_FOR_HOLES + Eterm* last_htop; /* No need to scan the heap below this point. */ + ErlHeapFragment* last_mbuf; /* No need to scan beyond this mbuf. */ +#endif + +#ifdef DEBUG + Eterm* last_old_htop; /* + * No need to scan the old heap below this point + * when looking for invalid pointers into the new heap or + * heap fragments. + */ +#endif +}; + +#ifdef CHECK_FOR_HOLES +# define INIT_HOLE_CHECK(p) \ +do { \ + (p)->last_htop = 0; \ + (p)->last_mbuf = 0; \ +} while (0) + +# define ERTS_HOLE_CHECK(p) erts_check_for_holes((p)) +void erts_check_for_holes(Process* p); +#else +# define INIT_HOLE_CHECK(p) +# define ERTS_HOLE_CHECK(p) +#endif + +/* + * The MBUF_GC_FACTOR decides how easily a process is subject to GC + * due to message buffers allocated outside the heap. + * The larger the factor, the easier the process gets GCed. + * On a small memory system with lots of processes, this makes a significant + * difference, especially since the GCs help fragmentation quite a bit too. + */ +#if defined(SMALL_MEMORY) +#define MBUF_GC_FACTOR 4 +#else +#define MBUF_GC_FACTOR 1 +#endif + +#define SEQ_TRACE_TOKEN(p) ((p)->seq_trace_token) + +/* The sequential tracing token is a tuple of size 5: + * + * {Flags, Label, Serial, Sender} + */ + +#define SEQ_TRACE_TOKEN_ARITY(p) (arityval(*(tuple_val(SEQ_TRACE_TOKEN(p))))) +#define SEQ_TRACE_TOKEN_FLAGS(p) (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 1)) +#define SEQ_TRACE_TOKEN_LABEL(p) (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 2)) +#define SEQ_TRACE_TOKEN_SERIAL(p) (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 3)) +#define SEQ_TRACE_TOKEN_SENDER(p) (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 4)) +#define SEQ_TRACE_TOKEN_LASTCNT(p) (*(tuple_val(SEQ_TRACE_TOKEN(p)) + 5)) + +/* used when we have unit32 token */ +#define SEQ_TRACE_T_ARITY(token) (arityval(*(tuple_val(token)))) +#define SEQ_TRACE_T_FLAGS(token) (*(tuple_val(token) + 1)) +#define SEQ_TRACE_T_LABEL(token) (*(tuple_val(token) + 2)) +#define SEQ_TRACE_T_SERIAL(token) (*(tuple_val(token) + 3)) +#define SEQ_TRACE_T_SENDER(token) (*(tuple_val(token) + 4)) +#define SEQ_TRACE_T_LASTCNT(token) (*(tuple_val(token) + 5)) + +/* + * Possible flags for the flags field in ErlSpawnOpts below. + */ + +#define SPO_LINK 1 +#define SPO_USE_ARGS 2 +#define SPO_MONITOR 4 + +/* + * The following struct contains options for a process to be spawned. + */ +typedef struct { + Uint flags; + int error_code; /* Error code returned from create_process(). */ + Eterm mref; /* Monitor ref returned (if SPO_MONITOR was given). */ + + /* + * The following items are only initialized if the SPO_USE_ARGS flag is set. + */ + Uint min_heap_size; /* Minimum heap size (must be a valued returned + * from next_heap_size()). + */ + int priority; /* Priority for process. */ + Uint16 max_gen_gcs; /* Maximum number of gen GCs before fullsweep. */ + int scheduler; +} ErlSpawnOpts; + +/* + * The KILL_CATCHES(p) macro kills pending catches for process p. + */ + +#define KILL_CATCHES(p) (p)->catches = -1 + +void erts_arith_shrink(Process* p, Eterm* hp); +Eterm* erts_heap_alloc(Process* p, Uint need); +#ifdef CHECK_FOR_HOLES +Eterm* erts_set_hole_marker(Eterm* ptr, Uint sz); +#endif + +extern Process** process_tab; +#ifdef HYBRID +extern Uint erts_num_active_procs; +extern Process** erts_active_procs; +#endif +extern Uint erts_max_processes; +extern Uint erts_process_tab_index_mask; +extern Uint erts_default_process_flags; +extern erts_smp_rwmtx_t erts_cpu_bind_rwmtx; +/* If any of the erts_system_monitor_* variables are set (enabled), +** erts_system_monitor must be != NIL, to allow testing on just +** the erts_system_monitor_* variables. +*/ +extern Eterm erts_system_monitor; +extern Uint erts_system_monitor_long_gc; +extern Uint erts_system_monitor_large_heap; +struct erts_system_monitor_flags_t { + unsigned int busy_port : 1; + unsigned int busy_dist_port : 1; +}; +extern struct erts_system_monitor_flags_t erts_system_monitor_flags; + +/* system_profile, same rules as for system_monitor. + erts_profile must be != NIL when + erts_profile_* is set. */ + +extern Eterm erts_system_profile; +struct erts_system_profile_flags_t { + unsigned int scheduler : 1; + unsigned int runnable_procs : 1; + unsigned int runnable_ports : 1; + unsigned int exclusive : 1; +}; +extern struct erts_system_profile_flags_t erts_system_profile_flags; + +#define INVALID_PID(p, pid) ((p) == NULL \ + || (p)->id != (pid) \ + || (p)->status == P_EXITING) + +#define IS_TRACED(p) ( (p)->tracer_proc != NIL ) +#define ARE_TRACE_FLAGS_ON(p,tf) ( ((p)->trace_flags & (tf|F_SENSITIVE)) == (tf) ) +#define IS_TRACED_FL(p,tf) ( IS_TRACED(p) && ARE_TRACE_FLAGS_ON(p,tf) ) + +/* process flags */ +#define F_TRAPEXIT (1 << 0) +#define F_INSLPQUEUE (1 << 1) /* Set if in timer queue */ +#define F_TIMO (1 << 2) /* Set if timeout */ +#define F_HEAP_GROW (1 << 3) +#define F_NEED_FULLSWEEP (1 << 4) /* If process has old binaries & funs. */ +#define F_USING_DB (1 << 5) /* If have created tables */ +#define F_DISTRIBUTION (1 << 6) /* Process used in distribution */ +#define F_USING_DDLL (1 << 7) /* Process has used the DDLL interface */ +#define F_HAVE_BLCKD_MSCHED (1 << 8) /* Process has blocked multi-scheduling */ +#define F_P2PNR_RESCHED (1 << 9) /* Process has been rescheduled via erts_pid2proc_not_running() */ +#define F_FORCE_GC (1 << 10) /* Force gc at process in-scheduling */ + +/* process trace_flags */ +#define F_SENSITIVE (1 << 0) +#define F_TRACE_SEND (1 << 1) +#define F_TRACE_RECEIVE (1 << 2) +#define F_TRACE_SOS (1 << 3) /* Set on spawn */ +#define F_TRACE_SOS1 (1 << 4) /* Set on first spawn */ +#define F_TRACE_SOL (1 << 5) /* Set on link */ +#define F_TRACE_SOL1 (1 << 6) /* Set on first link */ +#define F_TRACE_CALLS (1 << 7) +#define F_TIMESTAMP (1 << 8) +#define F_TRACE_PROCS (1 << 9) +#define F_TRACE_FIRST_CHILD (1 << 10) +#define F_TRACE_SCHED (1 << 11) +#define F_TRACE_GC (1 << 12) +#define F_TRACE_ARITY_ONLY (1 << 13) +#define F_TRACE_RETURN_TO (1 << 14) /* Return_to trace when breakpoint tracing */ +#define F_TRACE_SILENT (1 << 15) /* No call trace msg suppress */ +#define F_TRACER (1 << 16) /* May be (has been) tracer */ +#define F_EXCEPTION_TRACE (1 << 17) /* May have exception trace on stack */ + +/* port trace flags, currently the same as process trace flags */ +#define F_TRACE_SCHED_PORTS (1 << 18) /* Trace of port scheduling */ +#define F_TRACE_SCHED_PROCS (1 << 19) /* With virtual scheduling */ +#define F_TRACE_PORTS (1 << 20) /* Ports equivalent to F_TRACE_PROCS */ +#define F_TRACE_SCHED_NO (1 << 21) /* Trace with scheduler id */ +#define F_TRACE_SCHED_EXIT (1 << 22) + +#define F_NUM_FLAGS 23 +#ifdef DEBUG +# define F_INITIAL_TRACE_FLAGS (5 << F_NUM_FLAGS) +#else +# define F_INITIAL_TRACE_FLAGS 0 +#endif + + + +#define TRACEE_FLAGS ( F_TRACE_PROCS | F_TRACE_CALLS \ + | F_TRACE_SOS | F_TRACE_SOS1| F_TRACE_RECEIVE \ + | F_TRACE_SOL | F_TRACE_SOL1 | F_TRACE_SEND \ + | F_TRACE_SCHED | F_TIMESTAMP | F_TRACE_GC \ + | F_TRACE_ARITY_ONLY | F_TRACE_RETURN_TO \ + | F_TRACE_SILENT | F_TRACE_SCHED_PROCS | F_TRACE_PORTS \ + | F_TRACE_SCHED_PORTS | F_TRACE_SCHED_NO \ + | F_TRACE_SCHED_EXIT) + +#define ERTS_TRACEE_MODIFIER_FLAGS \ + (F_TRACE_SILENT | F_TIMESTAMP | F_TRACE_SCHED_NO) +#define ERTS_PORT_TRACEE_FLAGS \ + (ERTS_TRACEE_MODIFIER_FLAGS | F_TRACE_PORTS | F_TRACE_SCHED_PORTS) +#define ERTS_PROC_TRACEE_FLAGS \ + ((TRACEE_FLAGS & ~ERTS_PORT_TRACEE_FLAGS) | ERTS_TRACEE_MODIFIER_FLAGS) + +/* Sequential trace flags */ +#define SEQ_TRACE_SEND (1 << 0) +#define SEQ_TRACE_RECEIVE (1 << 1) +#define SEQ_TRACE_PRINT (1 << 2) +#define SEQ_TRACE_TIMESTAMP (1 << 3) + +#ifdef ERTS_SMP +/* Status flags ... */ +#define ERTS_PROC_SFLG_PENDADD2SCHEDQ (((Uint32) 1) << 0) /* Pending + add to + schedule q */ +#define ERTS_PROC_SFLG_INRUNQ (((Uint32) 1) << 1) /* Process is + in run q */ +#define ERTS_PROC_SFLG_TRAPEXIT (((Uint32) 1) << 2) /* Process is + trapping + exit */ +#define ERTS_PROC_SFLG_RUNNING (((Uint32) 1) << 3) /* Process is + running */ +/* Scheduler flags in process struct... */ +#define ERTS_PROC_RUNQ_FLG_RUNNING (((Uint32) 1) << 0) /* Process is + running */ + +#endif + + +#ifdef ERTS_SMP +#define ERTS_PROC_IS_TRAPPING_EXITS(P) \ + (ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((P)) \ + & ERTS_PROC_LOCK_STATUS), \ + (P)->status_flags & ERTS_PROC_SFLG_TRAPEXIT) + +#define ERTS_PROC_SET_TRAP_EXIT(P) \ + (ERTS_SMP_LC_ASSERT(((ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS) \ + & erts_proc_lc_my_proc_locks((P))) \ + == (ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS)), \ + (P)->status_flags |= ERTS_PROC_SFLG_TRAPEXIT, \ + (P)->flags |= F_TRAPEXIT, \ + 1) + +#define ERTS_PROC_UNSET_TRAP_EXIT(P) \ + (ERTS_SMP_LC_ASSERT(((ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS) \ + & erts_proc_lc_my_proc_locks((P))) \ + == (ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS)), \ + (P)->status_flags &= ~ERTS_PROC_SFLG_TRAPEXIT, \ + (P)->flags &= ~F_TRAPEXIT, \ + 0) +#else +#define ERTS_PROC_IS_TRAPPING_EXITS(P) ((P)->flags & F_TRAPEXIT) +#define ERTS_PROC_SET_TRAP_EXIT(P) ((P)->flags |= F_TRAPEXIT, 1) +#define ERTS_PROC_UNSET_TRAP_EXIT(P) ((P)->flags &= ~F_TRAPEXIT, 0) +#endif + +/* Option flags to erts_send_exit_signal() */ +#define ERTS_XSIG_FLG_IGN_KILL (((Uint32) 1) << 0) +#define ERTS_XSIG_FLG_NO_IGN_NORMAL (((Uint32) 1) << 1) + + +/* Process status values */ +#define P_FREE 0 +#define P_RUNABLE 1 +#define P_WAITING 2 +#define P_RUNNING 3 +#define P_EXITING 4 +#define P_GARBING 5 +#define P_SUSPENDED 6 + +#define CANCEL_TIMER(p) \ + do { \ + if ((p)->flags & (F_INSLPQUEUE)) \ + cancel_timer(p); \ + else \ + (p)->flags &= ~F_TIMO; \ + } while (0) + + +#define ERTS_INIT_SCHED_BIND_TYPE_SUCCESS 0 +#define ERTS_INIT_SCHED_BIND_TYPE_NOT_SUPPORTED 1 +#define ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_CPU_TOPOLOGY 2 +#define ERTS_INIT_SCHED_BIND_TYPE_ERROR_NO_BAD_TYPE 3 + +int erts_init_scheduler_bind_type(char *how); + +#define ERTS_INIT_CPU_TOPOLOGY_OK 0 +#define ERTS_INIT_CPU_TOPOLOGY_INVALID_ID 1 +#define ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_RANGE 2 +#define ERTS_INIT_CPU_TOPOLOGY_INVALID_HIERARCHY 3 +#define ERTS_INIT_CPU_TOPOLOGY_INVALID_ID_TYPE 4 +#define ERTS_INIT_CPU_TOPOLOGY_INVALID_NODES 5 +#define ERTS_INIT_CPU_TOPOLOGY_MISSING_LID 6 +#define ERTS_INIT_CPU_TOPOLOGY_NOT_UNIQUE_LIDS 7 +#define ERTS_INIT_CPU_TOPOLOGY_NOT_UNIQUE_ENTITIES 8 +#define ERTS_INIT_CPU_TOPOLOGY_MISSING 9 + +int erts_init_cpu_topology(char *topology_str); + +void erts_pre_init_process(void); +void erts_late_init_process(void); +void erts_early_init_scheduling(void); +void erts_init_scheduling(int, int, int); + +ErtsProcList *erts_proclist_create(Process *); +void erts_proclist_destroy(ErtsProcList *); +int erts_proclist_same(ErtsProcList *, Process *); + +#ifdef DEBUG +void erts_dbg_multi_scheduling_return_trap(Process *, Eterm); +#endif +#ifdef ERTS_SMP +ErtsSchedSuspendResult +erts_schedulers_state(Uint *, Uint *, Uint *, int); +ErtsSchedSuspendResult +erts_set_schedulers_online(Process *p, + ErtsProcLocks plocks, + Sint new_no, + Sint *old_no); +ErtsSchedSuspendResult +erts_block_multi_scheduling(Process *, ErtsProcLocks, int, int); +int erts_is_multi_scheduling_blocked(void); +Eterm erts_multi_scheduling_blockers(Process *); +void erts_start_schedulers(void); +void erts_smp_notify_check_children_needed(void); +#endif +Uint erts_active_schedulers(void); +void erts_init_process(void); +Eterm erts_process_status(Process *, ErtsProcLocks, Process *, Eterm); +Uint erts_run_queues_len(Uint *); +void erts_add_to_runq(Process *); +Eterm erts_bound_schedulers_term(Process *c_p); +Eterm erts_get_cpu_topology_term(Process *c_p, Eterm which); +Eterm erts_get_schedulers_binds(Process *c_p); +Eterm erts_set_cpu_topology(Process *c_p, Eterm term); +Eterm erts_bind_schedulers(Process *c_p, Eterm how); +ErtsRunQueue *erts_schedid2runq(Uint); +#ifdef ERTS_SMP +ErtsMigrateResult erts_proc_migrate(Process *, + ErtsProcLocks *, + ErtsRunQueue *, + int *, + ErtsRunQueue *, + int *); +#endif +Process *schedule(Process*, int); +void erts_schedule_misc_op(void (*)(void *), void *); +Eterm erl_create_process(Process*, Eterm, Eterm, Eterm, ErlSpawnOpts*); +void erts_do_exit_process(Process*, Eterm); +void erts_continue_exit_process(Process *); +void set_timer(Process*, Uint); +void cancel_timer(Process*); +/* Begin System profile */ +Uint erts_runnable_process_count(void); +Uint erts_process_count(void); +/* End System profile */ +void erts_init_empty_process(Process *p); +void erts_cleanup_empty_process(Process* p); +#ifdef DEBUG +void erts_debug_verify_clean_empty_process(Process* p); +#endif +void erts_stack_dump(int to, void *to_arg, Process *); +void erts_program_counter_info(int to, void *to_arg, Process *); + +Eterm erts_get_process_priority(Process *p); +Eterm erts_set_process_priority(Process *p, Eterm prio); + +Uint erts_get_total_context_switches(void); +void erts_get_total_reductions(Uint *, Uint *); +void erts_get_exact_total_reductions(Process *, Uint *, Uint *); + +Eterm erts_fake_scheduler_bindings(Process *p, Eterm how); + +void erts_sched_stat_modify(int what); +Eterm erts_sched_stat_term(Process *p, int total); + +void erts_free_proc(Process *); + +void erts_suspend(Process*, ErtsProcLocks, struct port*); +void erts_resume(Process*, ErtsProcLocks); +int erts_resume_processes(ErtsProcList *); + +int erts_send_exit_signal(Process *, + Eterm, + Process *, + ErtsProcLocks *, + Eterm, + Eterm, + Process *, + Uint32); +#ifdef ERTS_SMP +void erts_handle_pending_exit(Process *, ErtsProcLocks); +#define ERTS_PROC_PENDING_EXIT(P) \ + (ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((P)) & ERTS_PROC_LOCK_STATUS),\ + (P)->pending_exit.reason != THE_NON_VALUE) +#else +#define ERTS_PROC_PENDING_EXIT(P) 0 +#endif + +void erts_deep_process_dump(int, void *); + +Sint erts_test_next_pid(int, Uint); +Eterm erts_debug_processes(Process *c_p); +Eterm erts_debug_processes_bif_info(Process *c_p); +Uint erts_debug_nbalance(void); + +#ifdef ERTS_SMP +# define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) ((PROC)->scheduler_data) +# define ERTS_PROC_GET_SCHDATA(PROC) ((PROC)->scheduler_data) +#else +# define ERTS_GET_SCHEDULER_DATA_FROM_PROC(PROC) (erts_scheduler_data) +# define ERTS_PROC_GET_SCHDATA(PROC) (erts_scheduler_data) +#endif + +#if defined(ERTS_SMP) || defined(USE_THREADS) +ErtsSchedulerData *erts_get_scheduler_data(void); +#else +ERTS_GLB_INLINE ErtsSchedulerData *erts_get_scheduler_data(void); +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE +ErtsSchedulerData *erts_get_scheduler_data(void) +{ + return erts_scheduler_data; +} +#endif +#endif + +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + +#define ERTS_PROCESS_LOCK_ONLY_LOCK_CHECK_PROTO__ +#include "erl_process_lock.h" +#undef ERTS_PROCESS_LOCK_ONLY_LOCK_CHECK_PROTO__ + +int erts_smp_lc_runq_is_locked(ErtsRunQueue *); +#define ERTS_SMP_LC_CHK_RUNQ_LOCK(RQ, L) \ +do { \ + if ((L)) \ + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked((RQ))); \ + else \ + ERTS_SMP_LC_ASSERT(!erts_smp_lc_runq_is_locked((RQ))); \ +} while (0) +#else +#define ERTS_SMP_LC_CHK_RUNQ_LOCK(RQ, L) +#endif + +void *erts_psd_set_init(Process *p, ErtsProcLocks plocks, int ix, void *data); + +ERTS_GLB_INLINE void * +erts_psd_get(Process *p, int ix); +ERTS_GLB_INLINE void * +erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *new); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void * +erts_psd_get(Process *p, int ix) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p); + if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].get_locks) + ERTS_SMP_LC_ASSERT(locks + || erts_is_system_blocked(0) + || (ERTS_IS_CRASH_DUMPING + && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + else { + locks &= erts_psd_required_locks[ix].get_locks; + ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].get_locks == locks + || erts_is_system_blocked(0) + || (ERTS_IS_CRASH_DUMPING + && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + } +#endif + ASSERT(0 <= ix && ix < ERTS_PSD_SIZE); + return p->psd ? p->psd->data[ix] : NULL; +} + + +/* + * NOTE: erts_psd_set() might release and reacquire locks on 'p'. + */ +ERTS_GLB_INLINE void * +erts_psd_set(Process *p, ErtsProcLocks plocks, int ix, void *data) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + ErtsProcLocks locks = erts_proc_lc_my_proc_locks(p); + if (ERTS_LC_PSD_ANY_LOCK == erts_psd_required_locks[ix].set_locks) + ERTS_SMP_LC_ASSERT(locks + || erts_is_system_blocked(0) + || (ERTS_IS_CRASH_DUMPING + && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + else { + locks &= erts_psd_required_locks[ix].set_locks; + ERTS_SMP_LC_ASSERT(erts_psd_required_locks[ix].set_locks == locks + || erts_is_system_blocked(0) + || (ERTS_IS_CRASH_DUMPING + && erts_is_system_blocked(ERTS_BS_FLG_ALLOW_GC))); + } +#endif + ASSERT(0 <= ix && ix < ERTS_PSD_SIZE); + if (p->psd) { + void *old = p->psd->data[ix]; + p->psd->data[ix] = data; + return old; + } + else { + if (!data) + return NULL; + else + return erts_psd_set_init(p, plocks, ix, data); + } +} + +#endif + +#define ERTS_PROC_SCHED_ID(P, L, ID) \ + ((Uint) erts_psd_set((P), (L), ERTS_PSD_SCHED_ID, (void *) (ID))) + +#define ERTS_PROC_GET_DIST_ENTRY(P) \ + ((DistEntry *) erts_psd_get((P), ERTS_PSD_DIST_ENTRY)) +#define ERTS_PROC_SET_DIST_ENTRY(P, L, D) \ + ((DistEntry *) erts_psd_set((P), (L), ERTS_PSD_DIST_ENTRY, (void *) (D))) + +#define ERTS_PROC_GET_SAVED_CALLS_BUF(P) \ + ((struct saved_calls *) erts_psd_get((P), ERTS_PSD_SAVED_CALLS_BUF)) +#define ERTS_PROC_SET_SAVED_CALLS_BUF(P, L, SCB) \ + ((struct saved_calls *) erts_psd_set((P), (L), ERTS_PSD_SAVED_CALLS_BUF, (void *) (SCB))) + +ERTS_GLB_INLINE Eterm erts_proc_get_error_handler(Process *p); +ERTS_GLB_INLINE Eterm erts_proc_set_error_handler(Process *p, + ErtsProcLocks plocks, + Eterm handler); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE Eterm +erts_proc_get_error_handler(Process *p) +{ + void *val = erts_psd_get(p, ERTS_PSD_ERROR_HANDLER); + if (!val) + return am_error_handler; + else { + ASSERT(is_atom(((Eterm) val))); + return (Eterm) val; + } +} + +ERTS_GLB_INLINE Eterm +erts_proc_set_error_handler(Process *p, ErtsProcLocks plocks, Eterm handler) +{ + void *old_val; + void *new_val; + ASSERT(is_atom(handler)); + new_val = handler == am_error_handler ? NULL : (void *) handler; + old_val = erts_psd_set(p, plocks, ERTS_PSD_ERROR_HANDLER, new_val); + if (!old_val) + return am_error_handler; + else { + ASSERT(is_atom(((Eterm) old_val))); + return (Eterm) old_val; + } +} + +#endif + +#ifdef ERTS_SMP +ErtsRunQueue *erts_prepare_emigrate(ErtsRunQueue *c_rq, + ErtsRunQueueInfo *c_rqi, + int prio); + +ERTS_GLB_INLINE ErtsRunQueue *erts_check_emigration_need(ErtsRunQueue *c_rq, + int prio); +#endif + +ERTS_GLB_INLINE int erts_is_scheduler_bound(ErtsSchedulerData *esdp); +ERTS_GLB_INLINE Process *erts_get_current_process(void); +ERTS_GLB_INLINE Eterm erts_get_current_pid(void); +ERTS_GLB_INLINE Uint erts_get_scheduler_id(void); +ERTS_GLB_INLINE ErtsRunQueue *erts_get_runq_proc(Process *p); +ERTS_GLB_INLINE ErtsRunQueue *erts_get_runq_current(ErtsSchedulerData *esdp); +ERTS_GLB_INLINE void erts_smp_runq_lock(ErtsRunQueue *rq); +ERTS_GLB_INLINE int erts_smp_runq_trylock(ErtsRunQueue *rq); +ERTS_GLB_INLINE void erts_smp_runq_unlock(ErtsRunQueue *rq); +ERTS_GLB_INLINE void erts_smp_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq); +ERTS_GLB_INLINE void erts_smp_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq); +ERTS_GLB_INLINE void erts_smp_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2); +ERTS_GLB_INLINE void erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#ifdef ERTS_SMP +ERTS_GLB_INLINE ErtsRunQueue * +erts_check_emigration_need(ErtsRunQueue *c_rq, int prio) +{ + ErtsRunQueueInfo *c_rqi; + + if (!ERTS_CHK_RUNQ_FLG_EMIGRATE(c_rq->flags, prio)) + return NULL; + + if (prio == ERTS_PORT_PRIO_LEVEL) + c_rqi = &c_rq->ports.info; + else + c_rqi = &c_rq->procs.prio_info[prio]; + + if (!ERTS_CHK_RUNQ_FLG_EVACUATE(c_rq->flags, prio) + && !(c_rq->flags & ERTS_RUNQ_FLG_INACTIVE) + && c_rqi->len <= c_rqi->migrate.limit.this) + return NULL; + + return erts_prepare_emigrate(c_rq, c_rqi, prio); +} +#endif + +ERTS_GLB_INLINE +int erts_is_scheduler_bound(ErtsSchedulerData *esdp) +{ + if (!esdp) + esdp = erts_get_scheduler_data(); + ASSERT(esdp); + return esdp->cpu_id >= 0; +} + +ERTS_GLB_INLINE +Process *erts_get_current_process(void) +{ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + return esdp ? esdp->current_process : NULL; +} + +ERTS_GLB_INLINE +Eterm erts_get_current_pid(void) +{ + Process *proc = erts_get_current_process(); + return proc ? proc->id : THE_NON_VALUE; +} + +ERTS_GLB_INLINE +Uint erts_get_scheduler_id(void) +{ +#ifdef ERTS_SMP + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + return esdp ? esdp->no : (Uint) 0; +#else + return erts_get_scheduler_data() ? (Uint) 1 : (Uint) 0; +#endif +} + +ERTS_GLB_INLINE ErtsRunQueue * +erts_get_runq_proc(Process *p) +{ + ERTS_SMP_LC_ASSERT(ERTS_PROC_LOCK_STATUS & erts_proc_lc_my_proc_locks(p)); +#ifdef ERTS_SMP + ASSERT(p->run_queue); + return p->run_queue; +#else + ASSERT(erts_common_run_queue); + return erts_common_run_queue; +#endif +} + +ERTS_GLB_INLINE ErtsRunQueue * +erts_get_runq_current(ErtsSchedulerData *esdp) +{ + ASSERT(!esdp || esdp == erts_get_scheduler_data()); +#ifdef ERTS_SMP + if (!esdp) + esdp = erts_get_scheduler_data(); + return esdp->run_queue; +#else + ASSERT(erts_common_run_queue); + return erts_common_run_queue; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_runq_lock(ErtsRunQueue *rq) +{ +#ifdef ERTS_SMP + erts_smp_mtx_lock(&rq->mtx); +#endif +} + +ERTS_GLB_INLINE int +erts_smp_runq_trylock(ErtsRunQueue *rq) +{ +#ifdef ERTS_SMP + return erts_smp_mtx_trylock(&rq->mtx); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_runq_unlock(ErtsRunQueue *rq) +{ +#ifdef ERTS_SMP + erts_smp_mtx_unlock(&rq->mtx); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_xrunq_lock(ErtsRunQueue *rq, ErtsRunQueue *xrq) +{ +#ifdef ERTS_SMP + ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(&rq->mtx)); + if (xrq != rq) { + if (erts_smp_mtx_trylock(&xrq->mtx) == EBUSY) { + if (rq < xrq) + erts_smp_mtx_lock(&xrq->mtx); + else { + erts_smp_mtx_unlock(&rq->mtx); + erts_smp_mtx_lock(&xrq->mtx); + erts_smp_mtx_lock(&rq->mtx); + } + } + } +#endif +} + +ERTS_GLB_INLINE void +erts_smp_xrunq_unlock(ErtsRunQueue *rq, ErtsRunQueue *xrq) +{ +#ifdef ERTS_SMP + if (xrq != rq) + erts_smp_mtx_unlock(&xrq->mtx); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_runqs_lock(ErtsRunQueue *rq1, ErtsRunQueue *rq2) +{ +#ifdef ERTS_SMP + ASSERT(rq1 && rq2); + if (rq1 == rq2) + erts_smp_mtx_lock(&rq1->mtx); + else if (rq1 < rq2) { + erts_smp_mtx_lock(&rq1->mtx); + erts_smp_mtx_lock(&rq2->mtx); + } + else { + erts_smp_mtx_lock(&rq2->mtx); + erts_smp_mtx_lock(&rq1->mtx); + } +#endif +} + +ERTS_GLB_INLINE void +erts_smp_runqs_unlock(ErtsRunQueue *rq1, ErtsRunQueue *rq2) +{ +#ifdef ERTS_SMP + ASSERT(rq1 && rq2); + erts_smp_mtx_unlock(&rq1->mtx); + if (rq1 != rq2) + erts_smp_mtx_unlock(&rq2->mtx); +#endif +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +ERTS_GLB_INLINE ErtsAtomCacheMap *erts_get_atom_cache_map(Process *c_p); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE ErtsAtomCacheMap * +erts_get_atom_cache_map(Process *c_p) +{ + ErtsSchedulerData *esdp = (c_p + ? ERTS_PROC_GET_SCHDATA(c_p) + : erts_get_scheduler_data()); + ASSERT(esdp); + return &esdp->atom_cache_map; +} +#endif + +#ifdef ERTS_SMP + +Process *erts_pid2proc_not_running(Process *, + ErtsProcLocks, + Eterm, + ErtsProcLocks); +Process *erts_pid2proc_nropt(Process *c_p, + ErtsProcLocks c_p_locks, + Eterm pid, + ErtsProcLocks pid_locks); +extern int erts_disable_proc_not_running_opt; + +#ifdef DEBUG +#define ERTS_SMP_ASSERT_IS_NOT_EXITING(P) \ + do { ASSERT(!(P)->is_exiting); } while (0) +#else +#define ERTS_SMP_ASSERT_IS_NOT_EXITING(P) +#endif + +/* NOTE: At least one process lock has to be held on P! */ +#ifdef ERTS_ENABLE_LOCK_CHECK +#define ERTS_PROC_IS_EXITING(P) \ + (ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks((P)) != 0 \ + || erts_lc_pix_lock_is_locked(ERTS_PID2PIXLOCK((P)->id))),\ + (P)->is_exiting) +#else +#define ERTS_PROC_IS_EXITING(P) ((P)->is_exiting) +#endif + +#else /* !ERTS_SMP */ + +#define ERTS_PROC_IS_EXITING(P) ((P)->status == P_EXITING) + +#define ERTS_SMP_ASSERT_IS_NOT_EXITING(P) + +#define erts_pid2proc_not_running erts_pid2proc +#define erts_pid2proc_nropt erts_pid2proc + +#endif + +/* Minimum NUMBER of processes for a small system to start */ +#ifdef ERTS_SMP +#define ERTS_MIN_PROCESSES ERTS_NO_OF_PIX_LOCKS +#else +#define ERTS_MIN_PROCESSES 16 +#endif + +#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS +ERTS_GLB_INLINE void erts_smp_notify_inc_runq(ErtsRunQueue *runq); +void erts_smp_notify_inc_runq__(ErtsRunQueue *runq); +#endif /* ERTS_INCLUDE_SCHEDULER_INTERNALS */ + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#ifdef ERTS_INCLUDE_SCHEDULER_INTERNALS + +ERTS_GLB_INLINE void +erts_smp_notify_inc_runq(ErtsRunQueue *runq) +{ +#ifdef ERTS_SMP + ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(runq)); + if (runq->waiting) + erts_smp_notify_inc_runq__(runq); +#endif +} + +#endif /* ERTS_INCLUDE_SCHEDULER_INTERNALS */ + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#include "erl_process_lock.h" + +#undef ERTS_INCLUDE_SCHEDULER_INTERNALS + +#endif + + + diff --git a/erts/emulator/beam/erl_process_dict.c b/erts/emulator/beam/erl_process_dict.c new file mode 100644 index 0000000000..93466da3aa --- /dev/null +++ b/erts/emulator/beam/erl_process_dict.c @@ -0,0 +1,1001 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Code for process dictionaries. + * + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" /* Will include erl_process_dict.h */ +#include "error.h" +#include "erl_driver.h" +#include "bif.h" +#include "big.h" +#include "dist.h" +#include "erl_version.h" + +/* #define HARDDEBUG */ + +/* +** Utility macros +*/ + +/* Flags to pd_get_hash */ +#define PD_GET_OTHER_PROCESS 1UL + +/* Hash constant macros */ +#define MAX_HASH 1342177280UL +#define INITIAL_SIZE 10 + +/* Hash utility macros */ +#define HASH_RANGE(PDict) ((PDict)->homeSize + (PDict)->splitPosition) + +#define MAKE_HASH(Term) \ +((is_small(Term)) ? unsigned_val(Term) : \ + ((is_atom(Term)) ? \ + (atom_tab(atom_val(term))->slot.bucket.hvalue) : \ + make_hash2(Term))) + +#define PD_SZ2BYTES(Sz) (sizeof(ProcDict) + ((Sz) - 1)*sizeof(Eterm)) + +/* Memory allocation macros */ +#define PD_ALLOC(Sz) \ + erts_alloc(ERTS_ALC_T_PROC_DICT, (Sz)) +#define PD_FREE(P, Sz) \ + erts_free(ERTS_ALC_T_PROC_DICT, (P)) +#define PD_REALLOC(P, OSz, NSz) \ + erts_realloc(ERTS_ALC_T_PROC_DICT, (P), (NSz)) + + +#define TCAR(Term) CAR(list_val(Term)) +#define TCDR(Term) CDR(list_val(Term)) + +/* Array access macro */ +#define ARRAY_GET(PDict, Index) (((PDict)->size > (Index)) ? \ + (PDict)->data[Index] : NIL) + +/* + * Forward decalarations + */ +static void pd_hash_erase(Process *p, Eterm id, Eterm *ret); +static void pd_hash_erase_all(Process *p); +static Eterm pd_hash_get_keys(Process *p, Eterm value); +static Eterm pd_hash_get_all(Process *p, ProcDict *pd); +static Eterm pd_hash_put(Process *p, Eterm id, Eterm value); + +static void shrink(Process *p, Eterm* ret); +static void grow(Process *p); + +static void array_shrink(ProcDict **ppd, unsigned int need); +static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term); + +static unsigned int pd_hash_value(ProcDict *pdict, Eterm term); +static unsigned int next_array_size(unsigned int need); + +/* +** Debugging prototypes and macros +*/ +#ifdef HARDDEBUG + +#include + +static int hdebugf(char *format, ...); +static char *hdebugf_file = ""; +static int hdebugf_line; +#define HDEBUGF(X) ((int) hdebugf_file = __FILE__, hdebugf_line = __LINE__, \ + hdebugf X) +#ifndef DEBUG +#define DEBUG 1 +#endif + +#else /* !HARDDEBUG */ + +#define HDEBUGF(X) /* Nothing */ + +#endif /* HARDDEBUG (else) */ + +#ifdef DEBUG + +static void pd_check(ProcDict *pd); + +#define PD_CHECK(PD) pd_check(PD) + +#else /* !DEBUG */ + +#define PD_CHECK(PD) /* Nothing */ + +#endif /* DEBUG (else) */ + +/* +** External interface +*/ + +/* + * Called from break handler + */ +void +erts_dictionary_dump(int to, void *to_arg, ProcDict *pd) +{ + unsigned int i; +#ifdef DEBUG + + /*PD_CHECK(pd);*/ + if (pd == NULL) + return; + erts_print(to, to_arg, "(size = %d, used = %d, homeSize = %d, " + "splitPosition = %d, numElements = %d)\n", + pd->size, pd->used, pd->homeSize, + pd->splitPosition, (unsigned int) pd->numElements); + for (i = 0; i < HASH_RANGE(pd); ++i) { + erts_print(to, to_arg, "%d: %T\n", i, ARRAY_GET(pd, i)); + } + +#else /* !DEBUG */ + + int written = 0; + Eterm t; + + erts_print(to, to_arg, "["); + if (pd != NULL) { + for (i = 0; i < HASH_RANGE(pd); ++i) { + t = ARRAY_GET(pd, i); + if (is_list(t)) { + for (; t != NIL; t = TCDR(t)) { + erts_print(to, to_arg, written++ ? ",%T" : "%T", TCAR(t)); + } + } else if (is_tuple(t)) { + erts_print(to, to_arg, written++ ? ",%T" : "%T", t); + } + } + } + erts_print(to, to_arg, "]"); + +#endif /* DEBUG (else) */ +} + +void +erts_deep_dictionary_dump(int to, void *to_arg, + ProcDict* pd, void (*cb)(int, void *, Eterm)) +{ + unsigned int i; + Eterm t; + + if (pd != NULL) { + for (i = 0; i < HASH_RANGE(pd); ++i) { + t = ARRAY_GET(pd, i); + if (is_list(t)) { + for (; t != NIL; t = TCDR(t)) { + (*cb)(to, to_arg, TCAR(t)); + } + } else if (is_tuple(t)) { + (*cb)(to, to_arg, t); + } + } + } +} + +Uint +erts_dicts_mem_size(Process *p) +{ + Uint size = 0; + if (p->dictionary) + size += PD_SZ2BYTES(p->dictionary->size); + return size; +} + +void +erts_erase_dicts(Process *p) +{ + if (p->dictionary) { + pd_hash_erase_all(p); + p->dictionary = NULL; + } +} + +/* + * Called from process_info/1,2. + */ +Eterm erts_dictionary_copy(Process *p, ProcDict *pd) +{ + Eterm* hp; + Eterm* heap_start; + Eterm res = NIL; + Eterm tmp, tmp2; + unsigned int i, num; + + if (pd == NULL) { + return res; + } + + PD_CHECK(pd); + num = HASH_RANGE(pd); + heap_start = hp = (Eterm *) erts_alloc(ERTS_ALC_T_TMP, + sizeof(Eterm) * pd->numElements * 2); + for (i = 0; i < num; ++i) { + tmp = ARRAY_GET(pd, i); + if (is_boxed(tmp)) { + ASSERT(is_tuple(tmp)); + res = CONS(hp, tmp, res); + hp += 2; + } else if (is_list(tmp)) { + while (tmp != NIL) { + tmp2 = TCAR(tmp); + res = CONS(hp, tmp2, res); + hp += 2; + tmp = TCDR(tmp); + } + } + } + res = copy_object(res, p); + erts_free(ERTS_ALC_T_TMP, (void *) heap_start); + return res; +} + + +/* +** BIF interface +*/ +BIF_RETTYPE get_0(BIF_ALIST_0) +{ + Eterm ret; + PD_CHECK(BIF_P->dictionary); + ret = pd_hash_get_all(BIF_P, BIF_P->dictionary); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + +BIF_RETTYPE get_1(BIF_ALIST_1) +{ + Eterm ret; + PD_CHECK(BIF_P->dictionary); + ret = erts_pd_hash_get(BIF_P, BIF_ARG_1); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + +BIF_RETTYPE get_keys_1(BIF_ALIST_1) +{ + Eterm ret; + + PD_CHECK(BIF_P->dictionary); + ret = pd_hash_get_keys(BIF_P, BIF_ARG_1); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + +BIF_RETTYPE put_2(BIF_ALIST_2) +{ + Eterm ret; + + PD_CHECK(BIF_P->dictionary); + ret = pd_hash_put(BIF_P, BIF_ARG_1, BIF_ARG_2); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + +BIF_RETTYPE erase_0(BIF_ALIST_0) +{ + Eterm ret; + PD_CHECK(BIF_P->dictionary); + ret = pd_hash_get_all(BIF_P, BIF_P->dictionary); + pd_hash_erase_all(BIF_P); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + +BIF_RETTYPE erase_1(BIF_ALIST_1) +{ + Eterm ret; + PD_CHECK(BIF_P->dictionary); + pd_hash_erase(BIF_P, BIF_ARG_1, &ret); + PD_CHECK(BIF_P->dictionary); + BIF_RET(ret); +} + +/* + * BIF implementations + */ +static void pd_hash_erase(Process *p, Eterm id, Eterm *ret) +{ + unsigned int hval; + Eterm old; + Eterm tmp; + unsigned int range; + + *ret = am_undefined; + if (p->dictionary == NULL) { + return; + } + hval = pd_hash_value(p->dictionary, id); + old = ARRAY_GET(p->dictionary, hval); + if (is_boxed(old)) { /* Tuple */ + ASSERT(is_tuple(old)); + if (EQ(tuple_val(old)[1], id)) { + array_put(&(p->dictionary), hval, NIL); + --(p->dictionary->numElements); + *ret = tuple_val(old)[2]; + } + } else if (is_list(old)) { + /* Find cons cell for identical value */ + Eterm* prev = &p->dictionary->data[hval]; + + for (tmp = *prev; tmp != NIL; prev = &TCDR(tmp), tmp = *prev) { + if (EQ(tuple_val(TCAR(tmp))[1], id)) { + *prev = TCDR(tmp); + *ret = tuple_val(TCAR(tmp))[2]; + --(p->dictionary->numElements); + } + } + + /* If there is only one element left in the list we must remove the list. */ + old = ARRAY_GET(p->dictionary, hval); + ASSERT(is_list(old)); + if (is_nil(TCDR(old))) { + array_put(&p->dictionary, hval, TCAR(old)); + } + } else if (is_not_nil(old)) { +#ifdef DEBUG + erts_fprintf(stderr, + "Process dictionary for process %T is broken, trying to " + "display term found in line %d:\n" + "%T\n", p->id, __LINE__, old); +#endif + erl_exit(1, "Damaged process dictionary found during erase/1."); + } + if ((range = HASH_RANGE(p->dictionary)) > INITIAL_SIZE && + range / 2 > (p->dictionary->numElements)) { + shrink(p, ret); + } +} + +static void pd_hash_erase_all(Process *p) +{ + if (p->dictionary != NULL) { + PD_FREE(p->dictionary, PD_SZ2BYTES(p->dictionary->size)); + p->dictionary = NULL; + } +} + +Eterm erts_pd_hash_get(Process *p, Eterm id) +{ + unsigned int hval; + Eterm tmp; + ProcDict *pd = p->dictionary; + + if (pd == NULL) + return am_undefined; + hval = pd_hash_value(pd, id); + tmp = ARRAY_GET(pd, hval); + if (is_boxed(tmp)) { /* Tuple */ + ASSERT(is_tuple(tmp)); + if (EQ(tuple_val(tmp)[1], id)) { + return tuple_val(tmp)[2]; + } + } else if (is_list(tmp)) { + for (; tmp != NIL && !EQ(tuple_val(TCAR(tmp))[1], id); tmp = TCDR(tmp)) { + ; + } + if (tmp != NIL) { + return tuple_val(TCAR(tmp))[2]; + } + } else if (is_not_nil(tmp)) { +#ifdef DEBUG + erts_fprintf(stderr, + "Process dictionary for process %T is broken, trying to " + "display term found in line %d:\n" + "%T\n", p->id, __LINE__, tmp); +#endif + erl_exit(1, "Damaged process dictionary found during get/1."); + } + return am_undefined; +} + +static Eterm pd_hash_get_keys(Process *p, Eterm value) +{ + Eterm *hp; + Eterm res = NIL; + ProcDict *pd = p->dictionary; + unsigned int i, num; + Eterm tmp, tmp2; + + if (pd == NULL) { + return res; + } + + num = HASH_RANGE(pd); + for (i = 0; i < num; ++i) { + tmp = ARRAY_GET(pd, i); + if (is_boxed(tmp)) { + ASSERT(is_tuple(tmp)); + if (EQ(tuple_val(tmp)[2], value)) { + hp = HAlloc(p, 2); + res = CONS(hp, tuple_val(tmp)[1], res); + } + } else if (is_list(tmp)) { + while (tmp != NIL) { + tmp2 = TCAR(tmp); + if (EQ(tuple_val(tmp2)[2], value)) { + hp = HAlloc(p, 2); + res = CONS(hp, tuple_val(tmp2)[1], res); + } + tmp = TCDR(tmp); + } + } + } + return res; +} + + +static Eterm +pd_hash_get_all(Process *p, ProcDict *pd) +{ + Eterm* hp; + Eterm res = NIL; + Eterm tmp, tmp2; + unsigned int i; + unsigned int num; + + if (pd == NULL) { + return res; + } + num = HASH_RANGE(pd); + hp = HAlloc(p, pd->numElements * 2); + + for (i = 0; i < num; ++i) { + tmp = ARRAY_GET(pd, i); + if (is_boxed(tmp)) { + ASSERT(is_tuple(tmp)); + res = CONS(hp, tmp, res); + hp += 2; + } else if (is_list(tmp)) { + while (tmp != NIL) { + tmp2 = TCAR(tmp); + res = CONS(hp, tmp2, res); + hp += 2; + tmp = TCDR(tmp); + } + } + } + return res; +} + +static Eterm pd_hash_put(Process *p, Eterm id, Eterm value) +{ + unsigned int hval; + Eterm *hp; + Eterm tpl; + Eterm old; + Eterm tmp; + int needed; + int i = 0; +#ifdef DEBUG + Eterm *hp_limit; +#endif + + if (p->dictionary == NULL) { + /* Create it */ + array_put(&(p->dictionary), INITIAL_SIZE - 1, NIL); + p->dictionary->homeSize = INITIAL_SIZE; + } + hval = pd_hash_value(p->dictionary, id); + old = ARRAY_GET(p->dictionary, hval); + + /* + * Calculate the number of heap words needed and garbage + * collect if necessary. (Might be a slight overestimation.) + */ + needed = 3; /* {Key,Value} tuple */ + if (is_boxed(old)) { + /* + * We don't want to compare keys twice, so we'll always + * reserve the space for two CONS cells. + */ + needed += 2+2; + } else if (is_list(old)) { + i = 0; + for (tmp = old; tmp != NIL && !EQ(tuple_val(TCAR(tmp))[1], id); tmp = TCDR(tmp)) { + ++i; + } + if (is_nil(tmp)) { + i = -1; + needed += 2; + } else { + needed += 2*(i+1); + } + } + if (HeapWordsLeft(p) < needed) { + Eterm root[3]; + root[0] = id; + root[1] = value; + root[2] = old; + BUMP_REDS(p, erts_garbage_collect(p, needed, root, 3)); + id = root[0]; + value = root[1]; + old = root[2]; + } +#ifdef DEBUG + hp_limit = p->htop + needed; +#endif + + /* + * Create the {Key,Value} tuple. + */ + hp = HeapOnlyAlloc(p, 3); + tpl = TUPLE2(hp, id, value); + + /* + * Update the dictionary. + */ + if (is_nil(old)) { + array_put(&(p->dictionary), hval, tpl); + ++(p->dictionary->numElements); + } else if (is_boxed(old)) { + ASSERT(is_tuple(old)); + if (EQ(tuple_val(old)[1],id)) { + array_put(&(p->dictionary), hval, tpl); + return tuple_val(old)[2]; + } else { + hp = HeapOnlyAlloc(p, 4); + tmp = CONS(hp, old, NIL); + hp += 2; + ++(p->dictionary->numElements); + array_put(&(p->dictionary), hval, CONS(hp, tpl, tmp)); + hp += 2; + ASSERT(hp <= hp_limit); + } + } else if (is_list(old)) { + if (i == -1) { + /* + * New key. Simply prepend the tuple to the beginning of the list. + */ + hp = HeapOnlyAlloc(p, 2); + array_put(&(p->dictionary), hval, CONS(hp, tpl, old)); + hp += 2; + ASSERT(hp <= hp_limit); + ++(p->dictionary->numElements); + } else { + /* + * i = Number of CDRs to skip to reach the changed element in the list. + * + * Replace old value in list. To avoid pointers from the old generation + * to the new, we must rebuild the list from the beginning up to and + * including the changed element. + */ + Eterm nlist; + int j; + + hp = HeapOnlyAlloc(p, (i+1)*2); + + /* Find the list element to change. */ + for (j = 0, nlist = old; j < i; j++, nlist = TCDR(nlist)) { + ; + } + ASSERT(EQ(tuple_val(TCAR(nlist))[1], id)); + nlist = TCDR(nlist); /* Unchanged part of list. */ + + /* Rebuild list before the updated element. */ + for (tmp = old; i-- > 0; tmp = TCDR(tmp)) { + nlist = CONS(hp, TCAR(tmp), nlist); + hp += 2; + } + ASSERT(EQ(tuple_val(TCAR(tmp))[1], id)); + + /* Put the updated element first in the new list. */ + nlist = CONS(hp, tpl, nlist); + hp += 2; + ASSERT(hp <= hp_limit); + array_put(&(p->dictionary), hval, nlist); + return tuple_val(TCAR(tmp))[2]; + } + } else { +#ifdef DEBUG + erts_fprintf(stderr, + "Process dictionary for process %T is broken, trying to " + "display term found in line %d:\n" + "%T\n", p->id, __LINE__, old); +#endif + + erl_exit(1, "Damaged process dictionary found during put/2."); + } + if (HASH_RANGE(p->dictionary) <= p->dictionary->numElements) { + grow(p); + } + return am_undefined; +} + +/* + * Hash table utilities, rehashing + */ + +static void shrink(Process *p, Eterm* ret) +{ + unsigned int range = HASH_RANGE(p->dictionary); + unsigned int steps = (range*3) / 10; + Eterm hi, lo, tmp; + unsigned int i; + Eterm *hp; +#ifdef DEBUG + Eterm *hp_limit; +#endif + + if (range - steps < INITIAL_SIZE) { + steps = range - INITIAL_SIZE; + } + + for (i = 0; i < steps; ++i) { + ProcDict *pd = p->dictionary; + if (pd->splitPosition == 0) { + pd->homeSize /= 2; + pd->splitPosition = pd->homeSize; + } + --(pd->splitPosition); + hi = ARRAY_GET(pd, (pd->splitPosition + pd->homeSize)); + lo = ARRAY_GET(pd, pd->splitPosition); + if (hi != NIL) { + if (lo == NIL) { + array_put(&(p->dictionary), pd->splitPosition, hi); + } else { + int needed = 4; + if (is_list(hi) && is_list(lo)) { + needed = 2*list_length(hi); + } + if (HeapWordsLeft(p) < needed) { + BUMP_REDS(p, erts_garbage_collect(p, needed, ret, 1)); + hi = pd->data[(pd->splitPosition + pd->homeSize)]; + lo = pd->data[pd->splitPosition]; + } +#ifdef DEBUG + hp_limit = p->htop + needed; +#endif + if (is_tuple(lo)) { + if (is_tuple(hi)) { + hp = HeapOnlyAlloc(p, 4); + tmp = CONS(hp, hi, NIL); + hp += 2; + array_put(&(p->dictionary), pd->splitPosition, + CONS(hp,lo,tmp)); + hp += 2; + ASSERT(hp <= hp_limit); + } else { /* hi is a list */ + hp = HeapOnlyAlloc(p, 2); + array_put(&(p->dictionary), pd->splitPosition, + CONS(hp, lo, hi)); + hp += 2; + ASSERT(hp <= hp_limit); + } + } else { /* lo is a list */ + if (is_tuple(hi)) { + hp = HeapOnlyAlloc(p, 2); + array_put(&(p->dictionary), pd->splitPosition, + CONS(hp, hi, lo)); + hp += 2; + ASSERT(hp <= hp_limit); + + } else { /* Two lists */ + hp = HeapOnlyAlloc(p, needed); + for (tmp = hi; tmp != NIL; tmp = TCDR(tmp)) { + lo = CONS(hp, TCAR(tmp), lo); + hp += 2; + } + ASSERT(hp <= hp_limit); + array_put(&(p->dictionary), pd->splitPosition, lo); + } + } + } + } + array_put(&(p->dictionary), (pd->splitPosition + pd->homeSize), NIL); + } + if (HASH_RANGE(p->dictionary) <= (p->dictionary->size / 4)) { + array_shrink(&(p->dictionary), (HASH_RANGE(p->dictionary) * 3) / 2); + } +} + +static void grow(Process *p) +{ + unsigned int i,j; + unsigned int steps = p->dictionary->homeSize / 5; + Eterm l1,l2; + Eterm l; + Eterm *hp; + unsigned int pos; + unsigned int homeSize; + int needed = 0; + ProcDict *pd; +#ifdef DEBUG + Eterm *hp_limit; +#endif + + HDEBUGF(("grow: steps = %d", steps)); + if (steps == 0) + steps = 1; + /* Dont grow over MAX_HASH */ + if ((MAX_HASH - steps) <= HASH_RANGE(p->dictionary)) { + return; + } + + /* + * Calculate total number of heap words needed, and garbage collect + * if necessary. + */ + + pd = p->dictionary; + pos = pd->splitPosition; + homeSize = pd->homeSize; + for (i = 0; i < steps; ++i) { + if (pos == homeSize) { + homeSize *= 2; + pos = 0; + } + l = ARRAY_GET(pd, pos); + pos++; + if (is_not_tuple(l)) { + while (l != NIL) { + needed += 2; + l = TCDR(l); + } + } + } + if (HeapWordsLeft(p) < needed) { + BUMP_REDS(p, erts_garbage_collect(p, needed, 0, 0)); + } +#ifdef DEBUG + hp_limit = p->htop + needed; +#endif + + /* + * Now grow. + */ + + for (i = 0; i < steps; ++i) { + ProcDict *pd = p->dictionary; + if (pd->splitPosition == pd->homeSize) { + pd->homeSize *= 2; + pd->splitPosition = 0; + } + pos = pd->splitPosition; + ++pd->splitPosition; /* For the hashes */ + l = ARRAY_GET(pd, pos); + if (is_tuple(l)) { + if (pd_hash_value(pd, tuple_val(l)[1]) != pos) { + array_put(&(p->dictionary), pos + + p->dictionary->homeSize, l); + array_put(&(p->dictionary), pos, NIL); + } + } else { + l2 = NIL; + l1 = l; + for (j = 0; l1 != NIL; l1 = TCDR(l1)) + j += 2; + hp = HeapOnlyAlloc(p, j); + + while (l != NIL) { + if (pd_hash_value(pd, tuple_val(TCAR(l))[1]) == pos) + l1 = CONS(hp, TCAR(l), l1); + else + l2 = CONS(hp, TCAR(l), l2); + hp += 2; + l = TCDR(l); + } + if (l1 != NIL && TCDR(l1) == NIL) + l1 = TCAR(l1); + if (l2 != NIL && TCDR(l2) == NIL) + l2 = TCAR(l2); + ASSERT(hp <= hp_limit); + /* After array_put pd is no longer valid */ + array_put(&(p->dictionary), pos, l1); + array_put(&(p->dictionary), pos + + p->dictionary->homeSize, l2); + } + } + +#ifdef HARDDEBUG + dictionary_dump(p->dictionary,CERR); +#endif +} + +/* +** Array oriented operations +*/ + +static void array_shrink(ProcDict **ppd, unsigned int need) +{ + unsigned int siz = next_array_size(need); + + HDEBUGF(("array_shrink: size = %d, used = %d, need = %d", + (*ppd)->size, (*ppd)->used, need)); + + if (siz > (*ppd)->size) + return; /* Only shrink */ + + *ppd = PD_REALLOC(((void *) *ppd), + PD_SZ2BYTES((*ppd)->size), + PD_SZ2BYTES(siz)); + + (*ppd)->size = siz; + if ((*ppd)->size < (*ppd)->used) + (*ppd)->used = (*ppd)->size; +} + + +static Eterm array_put(ProcDict **ppdict, unsigned int ndx, Eterm term) +{ + unsigned int i; + Eterm ret; + if (*ppdict == NULL) { + Uint siz = next_array_size(ndx+1); + ProcDict *p; + + p = PD_ALLOC(PD_SZ2BYTES(siz)); + for (i = 0; i < siz; ++i) + p->data[i] = NIL; + p->size = siz; + p->homeSize = p->splitPosition = p->numElements = p->used = 0; + *ppdict = p; + } else if (ndx >= (*ppdict)->size) { + Uint osize = (*ppdict)->size; + Uint nsize = next_array_size(ndx+1); + *ppdict = PD_REALLOC(((void *) *ppdict), + PD_SZ2BYTES(osize), + PD_SZ2BYTES(nsize)); + for (i = osize; i < nsize; ++i) + (*ppdict)->data[i] = NIL; + (*ppdict)->size = nsize; + } + ret = (*ppdict)->data[ndx]; + (*ppdict)->data[ndx] = term; + if ((ndx + 1) > (*ppdict)->used) + (*ppdict)->used = ndx + 1; +#ifdef HARDDEBUG + HDEBUGF(("array_put: (*ppdict)->size = %d, (*ppdict)->used = %d, ndx = %d", + (*ppdict)->size, (*ppdict)->used, ndx)); + erts_fprintf(stderr, "%T", term); +#endif /* HARDDEBUG */ + return ret; +} + +/* +** Basic utilities +*/ + +static unsigned int pd_hash_value(ProcDict *pdict, Eterm term) +{ + Uint hash, high; + + hash = MAKE_HASH(term); + high = hash % (pdict->homeSize*2); + if (high >= HASH_RANGE(pdict)) + return hash % pdict->homeSize; + return high; +} + +static unsigned int next_array_size(unsigned int need) +{ + static unsigned int tab[] = + { + 10UL, + 20UL, + 40UL, + 80UL, + 160UL, + 320UL, + 640UL, + 1280UL, + 2560UL, + 5120UL, + 10240UL, + 20480UL, + 40960UL, + 81920UL, + 163840UL, + 327680UL, + 655360UL, + 1310720UL, + 2621440UL, + 5242880UL, + 10485760UL, + 20971520UL, + 41943040UL, + 83886080UL, + 167772160UL, + 335544320UL, + 671088640UL, + 1342177280UL, + 2684354560UL + }; + int hi = sizeof(tab) / sizeof(Uint) - 1; + int lo = 1; + int cur = 4; + + while (hi >= lo) { + if (tab[cur] >= need && tab[cur - 1] < need) + return tab[cur]; + if (tab[cur] > need) + hi = cur - 1; + else + lo = cur + 1; + cur = (hi + lo) / 2; + } + return need; +} + + +/* +** Debug functions +*/ +#ifdef DEBUG + +static void pd_check(ProcDict *pd) +{ + unsigned int i; + Uint num; + if (pd == NULL) + return; + ASSERT(pd->size >= pd->used); + ASSERT(HASH_RANGE(pd) <= MAX_HASH); + for (i = 0, num = 0; i < pd->used; ++i) { + Eterm t = pd->data[i]; + if (is_nil(t)) { + continue; + } else if (is_tuple(t)) { + ++num; + ASSERT(arityval(*tuple_val(t)) == 2); + continue; + } else if (is_list(t)) { + while (t != NIL) { + ++num; + ASSERT(is_tuple(TCAR(t))); + ASSERT(arityval(*(tuple_val(TCAR(t)))) == 2); + t = TCDR(t); + } + continue; + } else { + erl_exit(1, + "Found tag 0x%08x in process dictionary at position %d", + (unsigned long) t, (int) i); + } + } + ASSERT(num == pd->numElements); + ASSERT(pd->splitPosition <= pd->homeSize); +} + +#endif /* DEBUG */ + + +#ifdef HARDDEBUG + +static int hdebugf(char *format, ...) +{ + va_list ap; + + erts_fprintf(stderr, "DEBUG: %s:%d :", hdebugf_file, hdebugf_line); + va_start(ap, format); + erts_vfprintf(stderr, format, ap); + va_end(ap); + erts_fprintf(stderr, "\n"); + return 0; +} + +#endif /* HARDDEBUG */ + diff --git a/erts/emulator/beam/erl_process_dict.h b/erts/emulator/beam/erl_process_dict.h new file mode 100644 index 0000000000..8fad2a67ab --- /dev/null +++ b/erts/emulator/beam/erl_process_dict.h @@ -0,0 +1,42 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef _ERL_PROCESS_DICT_H +#define _ERL_PROCESS_DICT_H +#include "sys.h" + +typedef struct proc_dict { + unsigned int size; + unsigned int used; + unsigned int homeSize; + unsigned int splitPosition; + Uint numElements; + Eterm data[1]; /* The beginning of an array of erlang terms */ +} ProcDict; + +Uint erts_dicts_mem_size(struct process *p); +void erts_erase_dicts(struct process *p); +void erts_dictionary_dump(int to, void *to_arg, ProcDict *pd); +void erts_deep_dictionary_dump(int to, void *to_arg, + ProcDict* pd, void (*cb)(int, void *, Eterm obj)); +Eterm erts_dictionary_copy(struct process *p, ProcDict *pd); + +Eterm erts_pd_hash_get(struct process *p, Eterm id); + +#endif diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c new file mode 100644 index 0000000000..1666509c72 --- /dev/null +++ b/erts/emulator/beam/erl_process_dump.c @@ -0,0 +1,454 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "erl_db.h" +#include "dist.h" +#include "beam_catches.h" +#include "erl_binary.h" +#define ERTS_WANT_EXTERNAL_TAGS +#include "external.h" + +#define WORD_FMT "%X" +#define ADDR_FMT "%X" + +#define OUR_NIL _make_header(0,_TAG_HEADER_FLOAT) + +static void dump_process_info(int to, void *to_arg, Process *p); +static void dump_element(int to, void *to_arg, Eterm x); +static void dump_dist_ext(int to, void *to_arg, ErtsDistExternal *edep); +static void dump_element_nl(int to, void *to_arg, Eterm x); +static int stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, + int yreg); +static void print_function_from_pc(int to, void *to_arg, Eterm* x); +static void heap_dump(int to, void *to_arg, Eterm x); +static void dump_binaries(int to, void *to_arg, Binary* root); +static void dump_externally(int to, void *to_arg, Eterm term); + +static Binary* all_binaries; + +extern Eterm beam_apply[]; +extern Eterm beam_exit[]; +extern Eterm beam_continue_exit[]; + + +void +erts_deep_process_dump(int to, void *to_arg) +{ + int i; + + all_binaries = NULL; + + for (i = 0; i < erts_max_processes; i++) { + if ((process_tab[i] != NULL) && (process_tab[i]->i != ENULL)) { + if (process_tab[i]->status != P_EXITING) { + Process* p = process_tab[i]; + + if (p->status != P_GARBING) { + dump_process_info(to, to_arg, p); + } + } + } + } + + dump_binaries(to, to_arg, all_binaries); +} + +static void +dump_process_info(int to, void *to_arg, Process *p) +{ + Eterm* sp; + ErlMessage* mp; + int yreg = -1; + + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(p); + + if ((p->trace_flags & F_SENSITIVE) == 0 && p->msg.first) { + erts_print(to, to_arg, "=proc_messages:%T\n", p->id); + for (mp = p->msg.first; mp != NULL; mp = mp->next) { + Eterm mesg = ERL_MESSAGE_TERM(mp); + if (is_value(mesg)) + dump_element(to, to_arg, mesg); + else + dump_dist_ext(to, to_arg, mp->data.dist_ext); + mesg = ERL_MESSAGE_TOKEN(mp); + erts_print(to, to_arg, ":"); + dump_element(to, to_arg, mesg); + erts_print(to, to_arg, "\n"); + } + } + + if ((p->trace_flags & F_SENSITIVE) == 0) { + if (p->dictionary) { + erts_print(to, to_arg, "=proc_dictionary:%T\n", p->id); + erts_deep_dictionary_dump(to, to_arg, + p->dictionary, dump_element_nl); + } + } + + if ((p->trace_flags & F_SENSITIVE) == 0) { + erts_print(to, to_arg, "=proc_stack:%T\n", p->id); + for (sp = p->stop; sp < STACK_START(p); sp++) { + yreg = stack_element_dump(to, to_arg, p, sp, yreg); + } + + erts_print(to, to_arg, "=proc_heap:%T\n", p->id); + for (sp = p->stop; sp < STACK_START(p); sp++) { + Eterm term = *sp; + + if (!is_catch(term) && !is_CP(term)) { + heap_dump(to, to_arg, term); + } + } + for (mp = p->msg.first; mp != NULL; mp = mp->next) { + Eterm mesg = ERL_MESSAGE_TERM(mp); + if (is_value(mesg)) + heap_dump(to, to_arg, mesg); + mesg = ERL_MESSAGE_TOKEN(mp); + heap_dump(to, to_arg, mesg); + } + if (p->dictionary) { + erts_deep_dictionary_dump(to, to_arg, p->dictionary, heap_dump); + } + } +} + +static void +dump_dist_ext(int to, void *to_arg, ErtsDistExternal *edep) +{ + if (!edep) + erts_print(to, to_arg, "D0:E0:"); + else { + byte *e; + size_t sz; + if (!(edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB)) + erts_print(to, to_arg, "D0:"); + else { + int i; + erts_print(to, to_arg, "D%X:", edep->attab.size); + for (i = 0; i < edep->attab.size; i++) + dump_element(to, to_arg, edep->attab.atom[i]); + } + sz = edep->ext_endp - edep->extp; + e = edep->extp; + if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) { + ASSERT(*e != VERSION_MAGIC); + sz++; + } + else { + ASSERT(*e == VERSION_MAGIC); + } + + erts_print(to, to_arg, "E%X:", sz); + if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) + erts_print(to, to_arg, "%02X", VERSION_MAGIC); + while (e < edep->ext_endp) + erts_print(to, to_arg, "%02X", *e++); + } +} + +static void +dump_element(int to, void *to_arg, Eterm x) +{ + if (is_list(x)) { + erts_print(to, to_arg, "H" WORD_FMT, list_val(x)); + } else if (is_boxed(x)) { + erts_print(to, to_arg, "H" WORD_FMT, boxed_val(x)); + } else if (is_immed(x)) { + if (is_atom(x)) { + unsigned char* s = atom_tab(atom_val(x))->name; + int len = atom_tab(atom_val(x))->len; + int i; + + erts_print(to, to_arg, "A%X:", atom_tab(atom_val(x))->len); + for (i = 0; i < len; i++) { + erts_putc(to, to_arg, *s++); + } + } else if (is_small(x)) { + erts_print(to, to_arg, "I%T", x); + } else if (is_pid(x)) { + erts_print(to, to_arg, "P%T", x); + } else if (is_port(x)) { + erts_print(to, to_arg, "p<%bpu.%bpu>", + port_channel_no(x), port_number(x)); + } else if (is_nil(x)) { + erts_putc(to, to_arg, 'N'); + } + } +} + +static void +dump_element_nl(int to, void *to_arg, Eterm x) +{ + dump_element(to, to_arg, x); + erts_putc(to, to_arg, '\n'); +} + + +static int +stack_element_dump(int to, void *to_arg, Process* p, Eterm* sp, int yreg) +{ + Eterm x = *sp; + + if (yreg < 0 || is_CP(x)) { + erts_print(to, to_arg, "%p:", sp); + } else { + erts_print(to, to_arg, "y%d:", yreg); + yreg++; + } + + if (is_CP(x)) { + erts_print(to, to_arg, "SReturn addr 0x%X (", (Eterm *) x); + print_function_from_pc(to, to_arg, cp_val(x)); + erts_print(to, to_arg, ")\n"); + yreg = 0; + } else if is_catch(x) { + erts_print(to, to_arg, "SCatch 0x%X (", catch_pc(x)); + print_function_from_pc(to, to_arg, catch_pc(x)); + erts_print(to, to_arg, ")\n"); + } else { + dump_element(to, to_arg, x); + erts_putc(to, to_arg, '\n'); + } + return yreg; +} + +static void +print_function_from_pc(int to, void *to_arg, Eterm* x) +{ + Eterm* addr = find_function_from_pc(x); + if (addr == NULL) { + if (x == beam_exit) { + erts_print(to, to_arg, ""); + } else if (x == beam_continue_exit) { + erts_print(to, to_arg, ""); + } else if (x == beam_apply+1) { + erts_print(to, to_arg, ""); + } else { + erts_print(to, to_arg, "unknown function"); + } + } else { + erts_print(to, to_arg, "%T:%T/%bpu + %bpu", + addr[0], addr[1], addr[2], ((x-addr)-2) * sizeof(Eterm)); + } +} + +static void +heap_dump(int to, void *to_arg, Eterm x) +{ + Eterm* ptr; + Eterm last = OUR_NIL; + Eterm* next = &last; + + if (is_immed(x) || is_CP(x)) { + return; + } + + again: + if (x == OUR_NIL) { /* We are done. */ + return; + } if (is_CP(x)) { + next = (Eterm *) x; + } else if (is_list(x)) { + ptr = list_val(x); + if (ptr[0] != OUR_NIL) { + erts_print(to, to_arg, ADDR_FMT ":l", ptr); + dump_element(to, to_arg, ptr[0]); + erts_putc(to, to_arg, '|'); + dump_element(to, to_arg, ptr[1]); + erts_putc(to, to_arg, '\n'); + if (is_immed(ptr[1])) { + ptr[1] = make_small(0); + } + x = ptr[0]; + ptr[0] = (Eterm) next; + next = ptr + 1; + goto again; + } + } else if (is_boxed(x)) { + Eterm hdr; + + ptr = boxed_val(x); + hdr = *ptr; + if (hdr != OUR_NIL) { /* If not visited */ + erts_print(to, to_arg, ADDR_FMT ":", ptr); + if (is_arity_value(hdr)) { + Uint i; + Uint arity = arityval(hdr); + + erts_print(to, to_arg, "t" WORD_FMT ":", arity); + for (i = 1; i <= arity; i++) { + dump_element(to, to_arg, ptr[i]); + if (is_immed(ptr[i])) { + ptr[i] = make_small(0); + } + if (i < arity) { + erts_putc(to, to_arg, ','); + } + } + erts_putc(to, to_arg, '\n'); + if (arity == 0) { + ptr[0] = OUR_NIL; + } else { + x = ptr[arity]; + ptr[0] = (Eterm) next; + next = ptr + arity - 1; + goto again; + } + } else if (hdr == HEADER_FLONUM) { + FloatDef f; + char sbuf[31]; + int i; + + GET_DOUBLE_DATA((ptr+1), f); + i = sys_double_to_chars(f.fd, (char*) sbuf); + sys_memset(sbuf+i, 0, 31-i); + erts_print(to, to_arg, "F%X:%s\n", i, sbuf); + *ptr = OUR_NIL; + } else if (_is_bignum_header(hdr)) { + erts_print(to, to_arg, "B%T\n", x); + *ptr = OUR_NIL; + } else if (is_binary_header(hdr)) { + Uint tag = thing_subtag(hdr); + Uint size = binary_size(x); + Uint i; + + if (tag == HEAP_BINARY_SUBTAG) { + byte* p; + + erts_print(to, to_arg, "Yh%X:", size); + p = binary_bytes(x); + for (i = 0; i < size; i++) { + erts_print(to, to_arg, "%02X", p[i]); + } + } else if (tag == REFC_BINARY_SUBTAG) { + ProcBin* pb = (ProcBin *) binary_val(x); + Binary* val = pb->val; + + if (erts_smp_atomic_xchg(&val->refc, 0) != 0) { + val->flags = (Uint) all_binaries; + all_binaries = val; + } + erts_print(to, to_arg, "Yc%X:%X:%X", val, + pb->bytes - (byte *)val->orig_bytes, + size); + } else if (tag == SUB_BINARY_SUBTAG) { + ErlSubBin* Sb = (ErlSubBin *) binary_val(x); + Eterm* real_bin = binary_val(Sb->orig); + void* val; + + if (thing_subtag(*real_bin) == REFC_BINARY_SUBTAG) { + ProcBin* pb = (ProcBin *) real_bin; + val = pb->val; + } else { /* Heap binary */ + val = real_bin; + } + erts_print(to, to_arg, "Ys%X:%X:%X", val, Sb->offs, size); + } + erts_putc(to, to_arg, '\n'); + *ptr = OUR_NIL; + } else if (is_external_pid_header(hdr)) { + erts_print(to, to_arg, "P%T\n", x); + *ptr = OUR_NIL; + } else if (is_external_port_header(hdr)) { + erts_print(to, to_arg, "p<%bpu.%bpu>\n", + port_channel_no(x), port_number(x)); + *ptr = OUR_NIL; + } else { + /* + * All other we dump in the external term format. + */ + dump_externally(to, to_arg, x); + erts_putc(to, to_arg, '\n'); + *ptr = OUR_NIL; + } + } + } + + x = *next; + *next = OUR_NIL; + next--; + goto again; +} + +static void +dump_binaries(int to, void *to_arg, Binary* current) +{ + while (current) { + long i; + long size = current->orig_size; + byte* bytes = (byte*) current->orig_bytes; + + erts_print(to, to_arg, "=binary:%X\n", current); + erts_print(to, to_arg, "%X:", size); + for (i = 0; i < size; i++) { + erts_print(to, to_arg, "%02X", bytes[i]); + } + erts_putc(to, to_arg, '\n'); + current = (Binary *) current->flags; + } +} + +static void +dump_externally(int to, void *to_arg, Eterm term) +{ + byte sbuf[1024]; /* encode and hope for the best ... */ + byte* s; + byte* p; + + if (is_fun(term)) { + /* + * The fun's environment used to cause trouble. There were + * two kind of problems: + * + * 1. A term used in the environment could already have been + * dumped and thus destroyed (since dumping is destructive). + * + * 2. A term in the environment could be too big, so that + * the buffer for external format overflowed (allocating + * memory is not really a solution, as it could be exhausted). + * + * Simple solution: Set all variables in the environment to NIL. + * The crashdump_viewer does not allow inspection of them anyway. + */ + ErlFunThing* funp = (ErlFunThing *) fun_val(term); + Uint num_free = funp->num_free; + Uint i; + + for (i = 0; i < num_free; i++) { + funp->env[i] = NIL; + } + } + + s = p = sbuf; + erts_encode_ext(term, &p); + erts_print(to, to_arg, "E%X:", p-s); + while (s < p) { + erts_print(to, to_arg, "%02X", *s++); + } +} diff --git a/erts/emulator/beam/erl_process_lock.c b/erts/emulator/beam/erl_process_lock.c new file mode 100644 index 0000000000..52440fb635 --- /dev/null +++ b/erts/emulator/beam/erl_process_lock.c @@ -0,0 +1,1431 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: Impementation of Erlang process locks. + * + * Author: Rickard Green + */ + +/* + * A short explanation of the process lock implementation: + * Each process has a lock bitfield and a number of lock wait + * queues. + * The bit field contains of a number of lock flags (L1, L2, ...) + * and a number of wait flags (W1, W2, ...). Each lock flag has a + * corresponding wait flag. The bit field isn't guarranteed to be + * larger than 32-bits which sets a maximum of 16 different locks + * per process. Currently, only 4 locks per process are used. The + * bit field is operated on by use of atomic operations (custom + * made bitwise atomic operations). When a lock is locked the + * corresponding lock bit is set. When a thread is waiting on a + * lock the wait flag for the lock is set. + * The process table is protected by pix (process index) locks + * which is spinlocks that protects a number of process indices in + * the process table. The pix locks also protects the lock queues + * and modifications of wait flags. + * When acquiring a process lock we first try to set the lock + * flag. If we are able to set the lock flag and the wait flag + * isn't set we are done. If the lock flag was already set we + * have to acquire the pix lock, set the wait flag, and put + * ourselves in the wait queue. + * Process locks will always be acquired in fifo order. + * When releasing a process lock we first unset all lock flags + * whose corresponding wait flag is clear (which will succeed). + * If wait flags were set for the locks being released, we acquire + * the pix lock, and transfer the lock to the first thread + * in the wait queue. + * Note that wait flags may be read without the pix lock, but + * it is important that wait flags only are modified when the pix + * lock is held. + * This implementation assumes that erts_smp_atomic_or_retold() + * provides necessary memorybarriers for a lock operation, and that + * erts_smp_atomic_and_retold() provides necessary memorybarriers + * for an unlock operation. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_process.h" + +const Process erts_proc_lock_busy; + +#ifdef ERTS_SMP + +/*#define ERTS_PROC_LOCK_SPIN_ON_GATE*/ +#define ERTS_PROC_LOCK_SPIN_COUNT_MAX 16000 +#define ERTS_PROC_LOCK_SPIN_COUNT_BASE 1000 + +#ifdef ERTS_PROC_LOCK_DEBUG +#define ERTS_PROC_LOCK_HARD_DEBUG +#endif + +#ifdef ERTS_PROC_LOCK_HARD_DEBUG +static void check_queue(erts_proc_lock_t *lck); +#endif + + +typedef struct erts_proc_lock_waiter_t_ erts_proc_lock_waiter_t; +struct erts_proc_lock_waiter_t_ { + erts_proc_lock_waiter_t *next; + erts_proc_lock_waiter_t *prev; + ErtsProcLocks wait_locks; + erts_smp_gate_t gate; + erts_proc_lock_queues_t *queues; +}; + +struct erts_proc_lock_queues_t_ { + erts_proc_lock_queues_t *next; + erts_proc_lock_waiter_t *queue[ERTS_PROC_LOCK_MAX_BIT+1]; +}; + +struct erts_proc_lock_thr_spec_data_t_ { + erts_proc_lock_queues_t *qs; + erts_proc_lock_waiter_t *wtr; +}; + +static erts_proc_lock_queues_t zeroqs = {0}; + +static erts_smp_spinlock_t wtr_lock; +static erts_proc_lock_waiter_t *waiter_free_list; +static erts_proc_lock_queues_t *queue_free_list; +static erts_tsd_key_t waiter_key; + +#ifdef ERTS_ENABLE_LOCK_CHECK +static struct { + Sint16 proc_lock_main; + Sint16 proc_lock_link; + Sint16 proc_lock_msgq; + Sint16 proc_lock_status; +} lc_id; +#endif + +erts_pix_lock_t erts_pix_locks[ERTS_NO_OF_PIX_LOCKS]; + +static int proc_lock_spin_count; +static int proc_lock_trans_spin_cost; + +static void cleanup_waiter(void); + +void +erts_init_proc_lock(void) +{ + int i; + int cpus; + erts_smp_spinlock_init(&wtr_lock, "proc_lck_wtr_alloc"); + for (i = 0; i < ERTS_NO_OF_PIX_LOCKS; i++) { +#if ERTS_PROC_LOCK_MUTEX_IMPL +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_smp_mtx_init_x(&erts_pix_locks[i].u.mtx, "pix_lock", make_small(i)); +#else + erts_smp_mtx_init(&erts_pix_locks[i].u.mtx, "pix_lock"); +#endif +#else +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_smp_spinlock_init_x(&erts_pix_locks[i].u.spnlck, "pix_lock", make_small(i)); +#else + erts_smp_spinlock_init(&erts_pix_locks[i].u.spnlck, "pix_lock"); +#endif +#endif + } + waiter_free_list = NULL; + queue_free_list = NULL; + erts_tsd_key_create(&waiter_key); + erts_thr_install_exit_handler(cleanup_waiter); +#ifdef ERTS_ENABLE_LOCK_CHECK + lc_id.proc_lock_main = erts_lc_get_lock_order_id("proc_main"); + lc_id.proc_lock_link = erts_lc_get_lock_order_id("proc_link"); + lc_id.proc_lock_msgq = erts_lc_get_lock_order_id("proc_msgq"); + lc_id.proc_lock_status = erts_lc_get_lock_order_id("proc_status"); +#endif + cpus = erts_get_cpu_configured(erts_cpuinfo); + if (cpus > 1) + proc_lock_spin_count = (ERTS_PROC_LOCK_SPIN_COUNT_BASE + * ((int) erts_no_schedulers)); + else if (cpus == 1) + proc_lock_spin_count = 0; + else /* No of cpus unknown. Assume multi proc, but be conservative. */ + proc_lock_spin_count = ERTS_PROC_LOCK_SPIN_COUNT_BASE; + if (proc_lock_spin_count > ERTS_PROC_LOCK_SPIN_COUNT_MAX) + proc_lock_spin_count = ERTS_PROC_LOCK_SPIN_COUNT_MAX; + proc_lock_trans_spin_cost = proc_lock_spin_count/20; +} + +static ERTS_INLINE erts_proc_lock_waiter_t * +alloc_wtr(void) +{ + erts_proc_lock_waiter_t *wtr; + erts_smp_spin_lock(&wtr_lock); + wtr = waiter_free_list; + if (wtr) { + waiter_free_list = wtr->next; + ERTS_LC_ASSERT(queue_free_list); + wtr->queues = queue_free_list; + queue_free_list = wtr->queues->next; + erts_smp_spin_unlock(&wtr_lock); + } + else { + erts_smp_spin_unlock(&wtr_lock); + wtr = erts_alloc(ERTS_ALC_T_PROC_LCK_WTR, + sizeof(erts_proc_lock_waiter_t)); + erts_smp_gate_init(&wtr->gate); + wtr->wait_locks = (ErtsProcLocks) 0; + wtr->queues = erts_alloc(ERTS_ALC_T_PROC_LCK_QS, + sizeof(erts_proc_lock_queues_t)); + sys_memcpy((void *) wtr->queues, + (void *) &zeroqs, + sizeof(erts_proc_lock_queues_t)); + } + return wtr; +} + +#ifdef ERTS_ENABLE_LOCK_CHECK +static void +check_unused_waiter(erts_proc_lock_waiter_t *wtr) +{ + int i; + ERTS_LC_ASSERT(wtr->wait_locks == 0); + for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++) + ERTS_LC_ASSERT(!wtr->queues->queue[i]); +} +#define CHECK_UNUSED_WAITER(W) check_unused_waiter((W)) +#else +#define CHECK_UNUSED_WAITER(W) +#endif + + +static ERTS_INLINE void +free_wtr(erts_proc_lock_waiter_t *wtr) +{ + CHECK_UNUSED_WAITER(wtr); + erts_smp_spin_lock(&wtr_lock); + wtr->next = waiter_free_list; + waiter_free_list = wtr; + wtr->queues->next = queue_free_list; + queue_free_list = wtr->queues; + erts_smp_spin_unlock(&wtr_lock); +} + +void +erts_proc_lock_prepare_proc_lock_waiter(void) +{ + erts_tsd_set(waiter_key, (void *) alloc_wtr()); +} + + +static void +cleanup_waiter(void) +{ + erts_proc_lock_waiter_t *wtr = erts_tsd_get(waiter_key); + if (wtr) + free_wtr(wtr); +} + + +/* + * Waiters are queued in a circular double linked list; + * where qs->queue[lock_ix] is the first waiter in queue, and + * qs->queue[lock_ix]->prev is the last waiter in queue. + */ + +static ERTS_INLINE void +enqueue_waiter(erts_proc_lock_queues_t *qs, + int ix, + erts_proc_lock_waiter_t *wtr) +{ + if (!qs->queue[ix]) { + qs->queue[ix] = wtr; + wtr->next = wtr; + wtr->prev = wtr; + } + else { + ERTS_LC_ASSERT(qs->queue[ix]->next && qs->queue[ix]->prev); + wtr->next = qs->queue[ix]; + wtr->prev = qs->queue[ix]->prev; + wtr->prev->next = wtr; + qs->queue[ix]->prev = wtr; + } +} + +static erts_proc_lock_waiter_t * +dequeue_waiter(erts_proc_lock_queues_t *qs, int ix) +{ + erts_proc_lock_waiter_t *wtr = qs->queue[ix]; + ERTS_LC_ASSERT(qs->queue[ix]); + if (wtr->next == wtr) { + ERTS_LC_ASSERT(qs->queue[ix]->prev == wtr); + qs->queue[ix] = NULL; + } + else { + ERTS_LC_ASSERT(wtr->next != wtr); + ERTS_LC_ASSERT(wtr->prev != wtr); + wtr->next->prev = wtr->prev; + wtr->prev->next = wtr->next; + qs->queue[ix] = wtr->next; + } + return wtr; +} + +/* + * Tries to aquire as many locks as possible in lock order, + * and sets the wait flag on the first lock not possible to + * aquire. + * + * Note: We need the pix lock during this operation. Wait + * flags are only allowed to be manipulated under pix + * lock. + */ +static ERTS_INLINE void +try_aquire(erts_proc_lock_t *lck, erts_proc_lock_waiter_t *wtr) +{ + ErtsProcLocks got_locks = (ErtsProcLocks) 0; + ErtsProcLocks locks = wtr->wait_locks; + int lock_no; + + ERTS_LC_ASSERT(lck->queues); + ERTS_LC_ASSERT(got_locks != locks); + + for (lock_no = 0; lock_no <= ERTS_PROC_LOCK_MAX_BIT; lock_no++) { + ErtsProcLocks lock = ((ErtsProcLocks) 1) << lock_no; + if (locks & lock) { + ErtsProcLocks wflg, old_lflgs; + if (lck->queues->queue[lock_no]) { + /* Others already waiting */ + enqueue: + ERTS_LC_ASSERT(ERTS_PROC_LOCK_FLGS_READ_(lck) + & (lock << ERTS_PROC_LOCK_WAITER_SHIFT)); + enqueue_waiter(lck->queues, lock_no, wtr); + break; + } + wflg = lock << ERTS_PROC_LOCK_WAITER_SHIFT; + old_lflgs = ERTS_PROC_LOCK_FLGS_BOR_(lck, wflg | lock); + if (old_lflgs & lock) { + /* Didn't get the lock */ + goto enqueue; + } + else { + /* Got the lock */ + got_locks |= lock; + ERTS_LC_ASSERT(!(old_lflgs & wflg)); + /* No one else can be waiting for the lock; remove wait flag */ + (void) ERTS_PROC_LOCK_FLGS_BAND_(lck, ~wflg); + if (got_locks == locks) + break; + } + } + } + + wtr->wait_locks &= ~got_locks; +} + +/* + * Transfer 'trnsfr_lcks' held by this executing thread to other + * threads waiting for the locks. When a lock has been transferred + * we also have to try to aquire as many lock as possible for the + * other thread. + */ +static int +transfer_locks(Process *p, + ErtsProcLocks trnsfr_lcks, + erts_pix_lock_t *pix_lock, + int unlock) +{ + int transferred = 0; + erts_proc_lock_waiter_t *wake = NULL; + erts_proc_lock_waiter_t *wtr; + ErtsProcLocks unset_waiter = 0; + ErtsProcLocks tlocks = trnsfr_lcks; + int lock_no; + + ERTS_LC_ASSERT(erts_lc_pix_lock_is_locked(pix_lock)); + +#ifdef ERTS_PROC_LOCK_HARD_DEBUG + check_queue(&p->lock); +#endif + + for (lock_no = 0; tlocks && lock_no <= ERTS_PROC_LOCK_MAX_BIT; lock_no++) { + ErtsProcLocks lock = ((ErtsProcLocks) 1) << lock_no; + if (tlocks & lock) { + erts_proc_lock_queues_t *qs = p->lock.queues; + /* Transfer lock */ +#ifdef ERTS_ENABLE_LOCK_CHECK + tlocks &= ~lock; +#endif + ERTS_LC_ASSERT(ERTS_PROC_LOCK_FLGS_READ_(&p->lock) + & (lock << ERTS_PROC_LOCK_WAITER_SHIFT)); + transferred++; + wtr = dequeue_waiter(qs, lock_no); + ERTS_LC_ASSERT(wtr); + if (!qs->queue[lock_no]) + unset_waiter |= lock; + ERTS_LC_ASSERT(wtr->wait_locks & lock); + wtr->wait_locks &= ~lock; + if (wtr->wait_locks) + try_aquire(&p->lock, wtr); + if (!wtr->wait_locks) { + /* + * The other thread got all locks it needs; + * need to wake it up. + */ + wtr->next = wake; + wake = wtr; + } + } + + } + + if (unset_waiter) { + unset_waiter <<= ERTS_PROC_LOCK_WAITER_SHIFT; + (void) ERTS_PROC_LOCK_FLGS_BAND_(&p->lock, ~unset_waiter); + } + +#ifdef ERTS_PROC_LOCK_HARD_DEBUG + check_queue(&p->lock); +#endif + + ERTS_LC_ASSERT(tlocks == 0); /* We should have transferred all of them */ + + if (!wake) { + if (unlock) + erts_pix_unlock(pix_lock); + } + else { + erts_pix_unlock(pix_lock); + + do { + erts_proc_lock_waiter_t *tmp = wake; + wake = wake->next; + erts_smp_gate_let_through(&tmp->gate, 1); + } while (wake); + + if (!unlock) + erts_pix_lock(pix_lock); + } + return transferred; +} + +/* + * Determine which locks in 'need_locks' are not currently locked in + * 'in_use', but do not return any locks "above" some lock we need, + * so we do not attempt to grab locks out of order. + * + * For example, if we want to lock 10111, and 00100 was already locked, this + * would return 00011, indicating we should not try for 10000 yet because + * that would be a lock-ordering violation. + */ +static ERTS_INLINE ErtsProcLocks +in_order_locks(ErtsProcLocks in_use, ErtsProcLocks need_locks) +{ + /* All locks we want that are already locked by someone else. */ + ErtsProcLocks busy = in_use & need_locks; + + /* Just the lowest numbered lock we want that's in use; 0 if none. */ + ErtsProcLocks lowest_busy = busy & -busy; + + /* All locks below the lowest one we want that's in use already. */ + return need_locks & (lowest_busy - 1); +} + +/* + * Try to grab locks one at a time in lock order and wait on the lowest + * lock we fail to grab, if any. + * + * If successful, this returns 0 and all locks in 'need_locks' are held. + * + * On entry, the pix lock is held iff !ERTS_PROC_LOCK_ATOMIC_IMPL. + * On exit it is not held. + */ +static void +wait_for_locks(Process *p, + erts_pix_lock_t *pixlck, + ErtsProcLocks locks, + ErtsProcLocks need_locks, + ErtsProcLocks olflgs) +{ + erts_pix_lock_t *pix_lock = pixlck ? pixlck : ERTS_PID2PIXLOCK(p->id); + int tsd; + erts_proc_lock_waiter_t *wtr; + + /* Acquire a waiter object on which this thread can wait. */ + wtr = erts_tsd_get(waiter_key); + if (wtr) + tsd = 1; + else { +#if ERTS_PROC_LOCK_SPINLOCK_IMPL && !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_unlock(pix_lock); +#endif + wtr = alloc_wtr(); + tsd = 0; +#if ERTS_PROC_LOCK_SPINLOCK_IMPL && !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_lock(pix_lock); +#endif + } + + /* Record which locks this waiter needs. */ + wtr->wait_locks = need_locks; + +#if ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_lock(pix_lock); +#endif + + ERTS_LC_ASSERT(erts_lc_pix_lock_is_locked(pix_lock)); + + /* Provide the process with waiter queues, if it doesn't have one. */ + if (!p->lock.queues) { + wtr->queues->next = NULL; + p->lock.queues = wtr->queues; + } + else { + wtr->queues->next = p->lock.queues->next; + p->lock.queues->next = wtr->queues; + } + +#ifdef ERTS_PROC_LOCK_HARD_DEBUG + check_queue(&p->lock); +#endif + + /* Try to aquire locks one at a time in lock order and set wait flag */ + try_aquire(&p->lock, wtr); + +#ifdef ERTS_PROC_LOCK_HARD_DEBUG + check_queue(&p->lock); +#endif + + if (wtr->wait_locks) { /* We didn't get them all; need to wait... */ + /* Got to wait for locks... */ + erts_pix_unlock(pix_lock); + + /* + * Wait for needed locks. When we return all needed locks have + * have been acquired by other threads and transfered to us. + */ +#ifdef ERTS_PROC_LOCK_SPIN_ON_GATE + erts_smp_gate_swait(&wtr->gate, proc_lock_spin_count); +#else + erts_smp_gate_wait(&wtr->gate); +#endif + + erts_pix_lock(pix_lock); + } + + /* Recover some queues to store in the waiter. */ + ERTS_LC_ASSERT(p->lock.queues); + if (p->lock.queues->next) { + wtr->queues = p->lock.queues->next; + p->lock.queues->next = wtr->queues->next; + } + else { + wtr->queues = p->lock.queues; + p->lock.queues = NULL; + } + + erts_pix_unlock(pix_lock); + + ERTS_LC_ASSERT(locks == (ERTS_PROC_LOCK_FLGS_READ_(&p->lock) & locks)); + + if (tsd) + CHECK_UNUSED_WAITER(wtr); + else + free_wtr(wtr); +} + +/* + * erts_proc_lock_failed() is called when erts_smp_proc_lock() + * wasn't able to lock all locks. We may need to transfer locks + * to waiters and wait for our turn on locks. + * + * Iff !ERTS_PROC_LOCK_ATOMIC_IMPL, the pix lock is locked on entry. + * + * This always returns with the pix lock unlocked. + */ +void +erts_proc_lock_failed(Process *p, + erts_pix_lock_t *pixlck, + ErtsProcLocks locks, + ErtsProcLocks old_lflgs) +{ +#ifdef ERTS_PROC_LOCK_SPIN_ON_GATE + int spin_count = 0; +#else + int spin_count = proc_lock_spin_count; +#endif + + ErtsProcLocks need_locks = locks; + ErtsProcLocks olflgs = old_lflgs; + + while (need_locks != 0) + { + ErtsProcLocks can_grab = in_order_locks(olflgs, need_locks); + + if (can_grab == 0) + { + /* Someone already has the lowest-numbered lock we want. */ + + if (spin_count-- <= 0) + { + /* Too many retries, give up and sleep for the lock. */ + wait_for_locks(p, pixlck, locks, need_locks, olflgs); + return; + } + + olflgs = ERTS_PROC_LOCK_FLGS_READ_(&p->lock); + } + else + { + /* Try to grab all of the grabbable locks at once with cmpxchg. */ + ErtsProcLocks grabbed = olflgs | can_grab; + ErtsProcLocks nflgs = + ERTS_PROC_LOCK_FLGS_CMPXCHG_(&p->lock, grabbed, olflgs); + + if (nflgs == olflgs) + { + /* Success! We grabbed the 'can_grab' locks. */ + olflgs = grabbed; + need_locks &= ~can_grab; + +#ifndef ERTS_PROC_LOCK_SPIN_ON_GATE + /* Since we made progress, reset the spin count. */ + spin_count = proc_lock_spin_count; +#endif + } + else + { + /* Compare-and-exchange failed, try again. */ + olflgs = nflgs; + } + } + } + + /* Now we have all of the locks we wanted. */ + +#if !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_unlock(pixlck); +#endif +} + +/* + * erts_proc_unlock_failed() is called when erts_smp_proc_unlock() + * wasn't able to unlock all locks. We may need to transfer locks + * to waiters. + */ +void +erts_proc_unlock_failed(Process *p, + erts_pix_lock_t *pixlck, + ErtsProcLocks wait_locks) +{ + erts_pix_lock_t *pix_lock = pixlck ? pixlck : ERTS_PID2PIXLOCK(p->id); + +#if ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_lock(pix_lock); +#endif + + transfer_locks(p, wait_locks, pix_lock, 1); /* unlocks pix_lock */ +} + +/* + * proc_safelock() locks process locks on two processes. In order + * to avoid a deadlock, proc_safelock() unlocks those locks that + * needs to be unlocked, and then acquires locks in lock order + * (including the previously unlocked ones). + */ + +static void +proc_safelock(Process *a_proc, + erts_pix_lock_t *a_pix_lck, + ErtsProcLocks a_have_locks, + ErtsProcLocks a_need_locks, + Process *b_proc, + erts_pix_lock_t *b_pix_lck, + ErtsProcLocks b_have_locks, + ErtsProcLocks b_need_locks) +{ + Process *p1, *p2; + Eterm pid1, pid2; + erts_pix_lock_t *pix_lck1, *pix_lck2; + ErtsProcLocks need_locks1, have_locks1, need_locks2, have_locks2; + ErtsProcLocks unlock_mask; + int lock_no, refc1 = 0, refc2 = 0; + + ERTS_LC_ASSERT(b_proc); + + + /* Determine inter process lock order... + * Locks with the same lock order should be locked on p1 before p2. + */ + if (a_proc) { + if (a_proc->id < b_proc->id) { + p1 = a_proc; + pid1 = a_proc->id; + pix_lck1 = a_pix_lck; + need_locks1 = a_need_locks; + have_locks1 = a_have_locks; + p2 = b_proc; + pid2 = b_proc->id; + pix_lck2 = b_pix_lck; + need_locks2 = b_need_locks; + have_locks2 = b_have_locks; + } + else if (a_proc->id > b_proc->id) { + p1 = b_proc; + pid1 = b_proc->id; + pix_lck1 = b_pix_lck; + need_locks1 = b_need_locks; + have_locks1 = b_have_locks; + p2 = a_proc; + pid2 = a_proc->id; + pix_lck2 = a_pix_lck; + need_locks2 = a_need_locks; + have_locks2 = a_have_locks; + } + else { + ERTS_LC_ASSERT(a_proc == b_proc); + ERTS_LC_ASSERT(a_proc->id == b_proc->id); + p1 = a_proc; + pid1 = a_proc->id; + pix_lck1 = a_pix_lck; + need_locks1 = a_need_locks | b_need_locks; + have_locks1 = a_have_locks | b_have_locks; + p2 = NULL; + pid2 = 0; + pix_lck2 = NULL; + need_locks2 = 0; + have_locks2 = 0; + } + } + else { + p1 = b_proc; + pid1 = b_proc->id; + pix_lck1 = b_pix_lck; + need_locks1 = b_need_locks; + have_locks1 = b_have_locks; + p2 = NULL; + pid2 = 0; + pix_lck2 = NULL; + need_locks2 = 0; + have_locks2 = 0; +#ifdef ERTS_ENABLE_LOCK_CHECK + a_need_locks = 0; + a_have_locks = 0; +#endif + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (p1) + erts_proc_lc_chk_proc_locks(p1, have_locks1); + if (p2) + erts_proc_lc_chk_proc_locks(p2, have_locks2); + + if ((need_locks1 & have_locks1) != have_locks1) + erts_lc_fail("Thread tries to release process lock(s) " + "on %T via erts_proc_safelock().", pid1); + if ((need_locks2 & have_locks2) != have_locks2) + erts_lc_fail("Thread tries to release process lock(s) " + "on %T via erts_proc_safelock().", + pid2); +#endif + + + need_locks1 &= ~have_locks1; + need_locks2 &= ~have_locks2; + + /* Figure out the range of locks that needs to be unlocked... */ + unlock_mask = ERTS_PROC_LOCKS_ALL; + for (lock_no = 0; + lock_no <= ERTS_PROC_LOCK_MAX_BIT; + lock_no++) { + ErtsProcLocks lock = (1 << lock_no); + if (lock & need_locks1) + break; + unlock_mask &= ~lock; + if (lock & need_locks2) + break; + } + + /* ... and unlock locks in that range... */ + if (have_locks1 || have_locks2) { + ErtsProcLocks unlock_locks; + unlock_locks = unlock_mask & have_locks1; + if (unlock_locks) { + have_locks1 &= ~unlock_locks; + need_locks1 |= unlock_locks; + if (!have_locks1) { + refc1 = 1; + erts_smp_proc_inc_refc(p1); + } + erts_smp_proc_unlock__(p1, pix_lck1, unlock_locks); + } + unlock_locks = unlock_mask & have_locks2; + if (unlock_locks) { + have_locks2 &= ~unlock_locks; + need_locks2 |= unlock_locks; + if (!have_locks2) { + refc2 = 1; + erts_smp_proc_inc_refc(p2); + } + erts_smp_proc_unlock__(p2, pix_lck2, unlock_locks); + } + } + + /* + * lock_no equals the number of the first lock to lock on + * either p1 *or* p2. + */ + + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (p1) + erts_proc_lc_chk_proc_locks(p1, have_locks1); + if (p2) + erts_proc_lc_chk_proc_locks(p2, have_locks2); +#endif + + /* Lock locks in lock order... */ + while (lock_no <= ERTS_PROC_LOCK_MAX_BIT) { + ErtsProcLocks locks; + ErtsProcLocks lock = (1 << lock_no); + ErtsProcLocks lock_mask = 0; + if (need_locks1 & lock) { + do { + lock = (1 << lock_no++); + lock_mask |= lock; + } while (lock_no <= ERTS_PROC_LOCK_MAX_BIT + && !(need_locks2 & lock)); + if (need_locks2 & lock) + lock_no--; + locks = need_locks1 & lock_mask; + erts_smp_proc_lock__(p1, pix_lck1, locks); + have_locks1 |= locks; + need_locks1 &= ~locks; + } + else if (need_locks2 & lock) { + while (lock_no <= ERTS_PROC_LOCK_MAX_BIT + && !(need_locks1 & lock)) { + lock_mask |= lock; + lock = (1 << ++lock_no); + } + locks = need_locks2 & lock_mask; + erts_smp_proc_lock__(p2, pix_lck2, locks); + have_locks2 |= locks; + need_locks2 &= ~locks; + } + else + lock_no++; + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (p1) + erts_proc_lc_chk_proc_locks(p1, have_locks1); + if (p2) + erts_proc_lc_chk_proc_locks(p2, have_locks2); + + if (p1 && p2) { + if (p1 == a_proc) { + ERTS_LC_ASSERT(a_need_locks == have_locks1); + ERTS_LC_ASSERT(b_need_locks == have_locks2); + } + else { + ERTS_LC_ASSERT(a_need_locks == have_locks2); + ERTS_LC_ASSERT(b_need_locks == have_locks1); + } + } + else { + ERTS_LC_ASSERT(p1); + if (a_proc) { + ERTS_LC_ASSERT(have_locks1 == (a_need_locks | b_need_locks)); + } + else { + ERTS_LC_ASSERT(have_locks1 == b_need_locks); + } + } +#endif + + if (refc1) + erts_smp_proc_dec_refc(p1); + if (refc2) + erts_smp_proc_dec_refc(p2); +} + +void +erts_proc_safelock(Process *a_proc, + ErtsProcLocks a_have_locks, + ErtsProcLocks a_need_locks, + Process *b_proc, + ErtsProcLocks b_have_locks, + ErtsProcLocks b_need_locks) +{ + proc_safelock(a_proc, + a_proc ? ERTS_PID2PIXLOCK(a_proc->id) : NULL, + a_have_locks, + a_need_locks, + b_proc, + b_proc ? ERTS_PID2PIXLOCK(b_proc->id) : NULL, + b_have_locks, + b_need_locks); +} + +/* + * erts_pid2proc_safelock() is called from erts_pid2proc_opt() when + * it wasn't possible to trylock all locks needed. + * c_p - current process + * c_p_have_locks - locks held on c_p + * pid - process id of process we are looking up + * proc - process struct of process we are looking + * up (both in and out argument) + * need_locks - all locks we need (including have_locks) + * pix_lock - pix lock for process we are looking up + * flags - option flags + */ +void +erts_pid2proc_safelock(Process *c_p, + ErtsProcLocks c_p_have_locks, + Process **proc, + ErtsProcLocks need_locks, + erts_pix_lock_t *pix_lock, + int flags) +{ + Process *p = *proc; + ERTS_LC_ASSERT(p->lock.refc > 0); + ERTS_LC_ASSERT(process_tab[internal_pid_index(p->id)] == p); + p->lock.refc++; + erts_pix_unlock(pix_lock); + + proc_safelock(c_p, + c_p ? ERTS_PID2PIXLOCK(c_p->id) : NULL, + c_p_have_locks, + c_p_have_locks, + p, + pix_lock, + 0, + need_locks); + + erts_pix_lock(pix_lock); + + if (!p->is_exiting + || ((flags & ERTS_P2P_FLG_ALLOW_OTHER_X) + && process_tab[internal_pid_index(p->id)] == p)) { + ERTS_LC_ASSERT(p->lock.refc > 1); + p->lock.refc--; + } + else { + /* No proc. Note, we need to keep refc until after process unlock */ + erts_pix_unlock(pix_lock); + erts_smp_proc_unlock__(p, pix_lock, need_locks); + *proc = NULL; + erts_pix_lock(pix_lock); + ERTS_LC_ASSERT(p->lock.refc > 0); + if (--p->lock.refc == 0) { + erts_pix_unlock(pix_lock); + erts_free_proc(p); + erts_pix_lock(pix_lock); + } + } +} + +void +erts_proc_lock_init(Process *p) +{ + /* We always start with all locks locked */ +#if ERTS_PROC_LOCK_ATOMIC_IMPL + erts_smp_atomic_init(&p->lock.flags, (long) ERTS_PROC_LOCKS_ALL); +#else + p->lock.flags = ERTS_PROC_LOCKS_ALL; +#endif + p->lock.queues = NULL; + p->lock.refc = 1; +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_proc_lock_init(p); + erts_lcnt_proc_lock(&(p->lock), ERTS_PROC_LOCKS_ALL); + erts_lcnt_proc_lock_post_x(&(p->lock), ERTS_PROC_LOCKS_ALL, __FILE__, __LINE__); +#endif + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_proc_lc_trylock(p, ERTS_PROC_LOCKS_ALL, 1); +#endif +#ifdef ERTS_PROC_LOCK_DEBUG + { + int i; + for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++) + erts_smp_atomic_init(&p->lock.locked[i], (long) 1); + } +#endif +} + +/* --- Process lock counting ----------------------------------------------- */ + +#ifdef ERTS_ENABLE_LOCK_COUNT +void erts_lcnt_proc_lock_init(Process *p) { + + if (p->id != ERTS_INVALID_PID) { + erts_lcnt_init_lock_x(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK, p->id); + erts_lcnt_init_lock_x(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK, p->id); + erts_lcnt_init_lock_x(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK, p->id); + erts_lcnt_init_lock_x(&(p->lock.lcnt_status), "proc_status", ERTS_LCNT_LT_PROCLOCK, p->id); + } else { + erts_lcnt_init_lock(&(p->lock.lcnt_main), "proc_main", ERTS_LCNT_LT_PROCLOCK); + erts_lcnt_init_lock(&(p->lock.lcnt_msgq), "proc_msgq", ERTS_LCNT_LT_PROCLOCK); + erts_lcnt_init_lock(&(p->lock.lcnt_link), "proc_link", ERTS_LCNT_LT_PROCLOCK); + erts_lcnt_init_lock(&(p->lock.lcnt_status), "proc_status", ERTS_LCNT_LT_PROCLOCK); + } +} + + +void erts_lcnt_proc_lock_destroy(Process *p) { + erts_lcnt_destroy_lock(&(p->lock.lcnt_main)); + erts_lcnt_destroy_lock(&(p->lock.lcnt_msgq)); + erts_lcnt_destroy_lock(&(p->lock.lcnt_link)); + erts_lcnt_destroy_lock(&(p->lock.lcnt_status)); +} + +void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks) { + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) { + if (locks & ERTS_PROC_LOCK_MAIN) { + erts_lcnt_lock(&(lock->lcnt_main)); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + erts_lcnt_lock(&(lock->lcnt_msgq)); + } + if (locks & ERTS_PROC_LOCK_LINK) { + erts_lcnt_lock(&(lock->lcnt_link)); + } + if (locks & ERTS_PROC_LOCK_STATUS) { + erts_lcnt_lock(&(lock->lcnt_status)); + } + } +} + +void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, char *file, unsigned int line) { + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) { + if (locks & ERTS_PROC_LOCK_MAIN) { + erts_lcnt_lock_post_x(&(lock->lcnt_main), file, line); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + erts_lcnt_lock_post_x(&(lock->lcnt_msgq), file, line); + } + if (locks & ERTS_PROC_LOCK_LINK) { + erts_lcnt_lock_post_x(&(lock->lcnt_link), file, line); + } + if (locks & ERTS_PROC_LOCK_STATUS) { + erts_lcnt_lock_post_x(&(lock->lcnt_status), file, line); + } + } +} + +void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks) { + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) { + if (locks & ERTS_PROC_LOCK_MAIN) { + erts_lcnt_lock_unaquire(&(lock->lcnt_main)); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + erts_lcnt_lock_unaquire(&(lock->lcnt_msgq)); + } + if (locks & ERTS_PROC_LOCK_LINK) { + erts_lcnt_lock_unaquire(&(lock->lcnt_link)); + } + if (locks & ERTS_PROC_LOCK_STATUS) { + erts_lcnt_lock_unaquire(&(lock->lcnt_status)); + } + } +} + +void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks) { + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) { + if (locks & ERTS_PROC_LOCK_MAIN) { + erts_lcnt_unlock(&(lock->lcnt_main)); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + erts_lcnt_unlock(&(lock->lcnt_msgq)); + } + if (locks & ERTS_PROC_LOCK_LINK) { + erts_lcnt_unlock(&(lock->lcnt_link)); + } + if (locks & ERTS_PROC_LOCK_STATUS) { + erts_lcnt_unlock(&(lock->lcnt_status)); + } + } +} +void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res) { + if (erts_lcnt_rt_options & ERTS_LCNT_OPT_PROCLOCK) { + if (locks & ERTS_PROC_LOCK_MAIN) { + erts_lcnt_trylock(&(lock->lcnt_main), res); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + erts_lcnt_trylock(&(lock->lcnt_msgq), res); + } + if (locks & ERTS_PROC_LOCK_LINK) { + erts_lcnt_trylock(&(lock->lcnt_link), res); + } + if (locks & ERTS_PROC_LOCK_STATUS) { + erts_lcnt_trylock(&(lock->lcnt_status), res); + } + } +} + +#endif /* ifdef ERTS_ENABLE_LOCK_COUNT */ + + +/* --- Process lock checking ----------------------------------------------- */ + +#ifdef ERTS_ENABLE_LOCK_CHECK + +void +erts_proc_lc_lock(Process *p, ErtsProcLocks locks) +{ + erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, + p->id, + ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_MAIN) { + lck.id = lc_id.proc_lock_main; + erts_lc_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_LINK) { + lck.id = lc_id.proc_lock_link; + erts_lc_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + lck.id = lc_id.proc_lock_msgq; + erts_lc_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_STATUS) { + lck.id = lc_id.proc_lock_status; + erts_lc_lock(&lck); + } +} + +void +erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked) +{ + erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, + p->id, + ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_MAIN) { + lck.id = lc_id.proc_lock_main; + erts_lc_trylock(locked, &lck); + } + if (locks & ERTS_PROC_LOCK_LINK) { + lck.id = lc_id.proc_lock_link; + erts_lc_trylock(locked, &lck); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + lck.id = lc_id.proc_lock_msgq; + erts_lc_trylock(locked, &lck); + } + if (locks & ERTS_PROC_LOCK_STATUS) { + lck.id = lc_id.proc_lock_status; + erts_lc_trylock(locked, &lck); + } +} + +void +erts_proc_lc_unlock(Process *p, ErtsProcLocks locks) +{ + erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, + p->id, + ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_STATUS) { + lck.id = lc_id.proc_lock_status; + erts_lc_unlock(&lck); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + lck.id = lc_id.proc_lock_msgq; + erts_lc_unlock(&lck); + } + if (locks & ERTS_PROC_LOCK_LINK) { + lck.id = lc_id.proc_lock_link; + erts_lc_unlock(&lck); + } + if (locks & ERTS_PROC_LOCK_MAIN) { + lck.id = lc_id.proc_lock_main; + erts_lc_unlock(&lck); + } +} + +void +erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks) +{ + erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, + p->id, + ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_STATUS) { + lck.id = lc_id.proc_lock_status; + erts_lc_might_unlock(&lck); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + lck.id = lc_id.proc_lock_msgq; + erts_lc_might_unlock(&lck); + } + if (locks & ERTS_PROC_LOCK_LINK) { + lck.id = lc_id.proc_lock_link; + erts_lc_might_unlock(&lck); + } + if (locks & ERTS_PROC_LOCK_MAIN) { + lck.id = lc_id.proc_lock_main; + erts_lc_might_unlock(&lck); + } +} + +void +erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks) +{ + erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, + p->id, + ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_MAIN) { + lck.id = lc_id.proc_lock_main; + erts_lc_require_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_LINK) { + lck.id = lc_id.proc_lock_link; + erts_lc_require_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + lck.id = lc_id.proc_lock_msgq; + erts_lc_require_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_STATUS) { + lck.id = lc_id.proc_lock_status; + erts_lc_require_lock(&lck); + } +} + +void +erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks) +{ + erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, + p->id, + ERTS_LC_FLG_LT_PROCLOCK); + if (locks & ERTS_PROC_LOCK_STATUS) { + lck.id = lc_id.proc_lock_status; + erts_lc_unrequire_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + lck.id = lc_id.proc_lock_msgq; + erts_lc_unrequire_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_LINK) { + lck.id = lc_id.proc_lock_link; + erts_lc_unrequire_lock(&lck); + } + if (locks & ERTS_PROC_LOCK_MAIN) { + lck.id = lc_id.proc_lock_main; + erts_lc_unrequire_lock(&lck); + } +} + + +int +erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks) +{ + if (locks & ERTS_PROC_LOCKS_ALL) { + erts_lc_lock_t lck = ERTS_LC_LOCK_INIT(-1, + p->id, + ERTS_LC_FLG_LT_PROCLOCK); + + if (locks & ERTS_PROC_LOCK_MAIN) + lck.id = lc_id.proc_lock_main; + else if (locks & ERTS_PROC_LOCK_LINK) + lck.id = lc_id.proc_lock_link; + else if (locks & ERTS_PROC_LOCK_MSGQ) + lck.id = lc_id.proc_lock_msgq; + else if (locks & ERTS_PROC_LOCK_STATUS) + lck.id = lc_id.proc_lock_status; + else + erts_lc_fail("Unknown proc lock found"); + + return erts_lc_trylock_force_busy(&lck); + } + return 0; +} + +void erts_proc_lc_chk_only_proc_main(Process *p) +{ + erts_lc_lock_t proc_main = ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, + p->id, + ERTS_LC_FLG_LT_PROCLOCK); + erts_lc_check_exact(&proc_main, 1); +} + +#define ERTS_PROC_LC_EMPTY_LOCK_INIT \ + ERTS_LC_LOCK_INIT(-1, THE_NON_VALUE, ERTS_LC_FLG_LT_PROCLOCK) + +void +erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks) +{ + int have_locks_len = 0; + erts_lc_lock_t have_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT}; + if (locks & ERTS_PROC_LOCK_MAIN) { + have_locks[have_locks_len].id = lc_id.proc_lock_main; + have_locks[have_locks_len++].extra = p->id; + } + if (locks & ERTS_PROC_LOCK_LINK) { + have_locks[have_locks_len].id = lc_id.proc_lock_link; + have_locks[have_locks_len++].extra = p->id; + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + have_locks[have_locks_len].id = lc_id.proc_lock_msgq; + have_locks[have_locks_len++].extra = p->id; + } + if (locks & ERTS_PROC_LOCK_STATUS) { + have_locks[have_locks_len].id = lc_id.proc_lock_status; + have_locks[have_locks_len++].extra = p->id; + } + + erts_lc_check(have_locks, have_locks_len, NULL, 0); +} + +void +erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks) +{ + int have_locks_len = 0; + int have_not_locks_len = 0; + erts_lc_lock_t have_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT}; + erts_lc_lock_t have_not_locks[4] = {ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT, + ERTS_PROC_LC_EMPTY_LOCK_INIT}; + + if (locks & ERTS_PROC_LOCK_MAIN) { + have_locks[have_locks_len].id = lc_id.proc_lock_main; + have_locks[have_locks_len++].extra = p->id; + } + else { + have_not_locks[have_not_locks_len].id = lc_id.proc_lock_main; + have_not_locks[have_not_locks_len++].extra = p->id; + } + if (locks & ERTS_PROC_LOCK_LINK) { + have_locks[have_locks_len].id = lc_id.proc_lock_link; + have_locks[have_locks_len++].extra = p->id; + } + else { + have_not_locks[have_not_locks_len].id = lc_id.proc_lock_link; + have_not_locks[have_not_locks_len++].extra = p->id; + } + if (locks & ERTS_PROC_LOCK_MSGQ) { + have_locks[have_locks_len].id = lc_id.proc_lock_msgq; + have_locks[have_locks_len++].extra = p->id; + } + else { + have_not_locks[have_not_locks_len].id = lc_id.proc_lock_msgq; + have_not_locks[have_not_locks_len++].extra = p->id; + } + if (locks & ERTS_PROC_LOCK_STATUS) { + have_locks[have_locks_len].id = lc_id.proc_lock_status; + have_locks[have_locks_len++].extra = p->id; + } + else { + have_not_locks[have_not_locks_len].id = lc_id.proc_lock_status; + have_not_locks[have_not_locks_len++].extra = p->id; + } + + erts_lc_check(have_locks, have_locks_len, + have_not_locks, have_not_locks_len); +} + +ErtsProcLocks +erts_proc_lc_my_proc_locks(Process *p) +{ + int resv[4]; + erts_lc_lock_t locks[4] = {ERTS_LC_LOCK_INIT(lc_id.proc_lock_main, + p->id, + ERTS_LC_FLG_LT_PROCLOCK), + ERTS_LC_LOCK_INIT(lc_id.proc_lock_link, + p->id, + ERTS_LC_FLG_LT_PROCLOCK), + ERTS_LC_LOCK_INIT(lc_id.proc_lock_msgq, + p->id, + ERTS_LC_FLG_LT_PROCLOCK), + ERTS_LC_LOCK_INIT(lc_id.proc_lock_status, + p->id, + ERTS_LC_FLG_LT_PROCLOCK)}; + + ErtsProcLocks res = 0; + + erts_lc_have_locks(resv, locks, 4); + if (resv[0]) + res |= ERTS_PROC_LOCK_MAIN; + if (resv[1]) + res |= ERTS_PROC_LOCK_LINK; + if (resv[2]) + res |= ERTS_PROC_LOCK_MSGQ; + if (resv[3]) + res |= ERTS_PROC_LOCK_STATUS; + + return res; +} + +void +erts_proc_lc_chk_no_proc_locks(char *file, int line) +{ + int resv[4]; + int ids[4] = {lc_id.proc_lock_main, + lc_id.proc_lock_link, + lc_id.proc_lock_msgq, + lc_id.proc_lock_status}; + erts_lc_have_lock_ids(resv, ids, 4); + if (resv[0] || resv[1] || resv[2] || resv[3]) { + erts_lc_fail("%s:%d: Thread has process locks locked when expected " + "not to have any process locks locked", + file, line); + } +} + +#endif /* #ifdef ERTS_ENABLE_LOCK_CHECK */ + +#ifdef ERTS_PROC_LOCK_HARD_DEBUG +void +check_queue(erts_proc_lock_t *lck) +{ + int lock_no; + ErtsProcLocks lflgs = ERTS_PROC_LOCK_FLGS_READ_(lck); + + for (lock_no = 0; lock_no <= ERTS_PROC_LOCK_MAX_BIT; lock_no++) { + ErtsProcLocks wtr; + wtr = (((ErtsProcLocks) 1) << lock_no) << ERTS_PROC_LOCK_WAITER_SHIFT; + if (lflgs & wtr) { + int n; + erts_proc_lock_waiter_t *wtr; + ERTS_LC_ASSERT(lck->queues && lck->queues->queue[lock_no]); + wtr = lck->queues->queue[lock_no]; + n = 0; + do { + wtr = wtr->next; + n++; + } while (wtr != lck->queues->queue[lock_no]); + do { + wtr = wtr->prev; + n--; + } while (wtr != lck->queues->queue[lock_no]); + ERTS_LC_ASSERT(n == 0); + } + else { + ERTS_LC_ASSERT(!lck->queues || !lck->queues->queue[lock_no]); + } + } +} +#endif + +#endif /* ERTS_SMP (the whole file) */ diff --git a/erts/emulator/beam/erl_process_lock.h b/erts/emulator/beam/erl_process_lock.h new file mode 100644 index 0000000000..d71e5a0a6e --- /dev/null +++ b/erts/emulator/beam/erl_process_lock.h @@ -0,0 +1,990 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: Impementation of Erlang process locks. + * + * Author: Rickard Green + */ + +#ifndef ERTS_PROC_LOCK_TYPE__ +#define ERTS_PROC_LOCK_TYPE__ + +#ifdef ERTS_ENABLE_LOCK_CHECK +#define ERTS_PROC_LOCK_DEBUG +#endif + +#ifdef ERTS_ENABLE_LOCK_COUNT +#include "erl_lock_count.h" +#endif + +#include "erl_smp.h" + +#define ERTS_PROC_LOCK_ATOMIC_IMPL 0 +#define ERTS_PROC_LOCK_SPINLOCK_IMPL 0 +#define ERTS_PROC_LOCK_MUTEX_IMPL 0 + +#if defined(ETHR_HAVE_OPTIMIZED_ATOMIC_OPS) +# undef ERTS_PROC_LOCK_ATOMIC_IMPL +# define ERTS_PROC_LOCK_ATOMIC_IMPL 1 +#elif defined(ETHR_HAVE_OPTIMIZED_SPINLOCK) +# undef ERTS_PROC_LOCK_SPINLOCK_IMPL +# define ERTS_PROC_LOCK_SPINLOCK_IMPL 1 +#else +# undef ERTS_PROC_LOCK_MUTEX_IMPL +# define ERTS_PROC_LOCK_MUTEX_IMPL 1 +#endif + +#define ERTS_PROC_LOCK_MAX_BIT 3 + +typedef Uint32 ErtsProcLocks; + +typedef struct erts_proc_lock_queues_t_ erts_proc_lock_queues_t; + +typedef struct erts_proc_lock_t_ { +#if ERTS_PROC_LOCK_ATOMIC_IMPL + erts_smp_atomic_t flags; +#else + ErtsProcLocks flags; +#endif + erts_proc_lock_queues_t *queues; + long refc; +#ifdef ERTS_PROC_LOCK_DEBUG + erts_smp_atomic_t locked[ERTS_PROC_LOCK_MAX_BIT+1]; +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_t lcnt_main; + erts_lcnt_lock_t lcnt_link; + erts_lcnt_lock_t lcnt_msgq; + erts_lcnt_lock_t lcnt_status; +#endif +} erts_proc_lock_t; + +/* Process lock flags */ + +/* + * Main lock: + * The main lock is held by the scheduler running a process. It + * is used to protect all fields in the process structure except + * for those fields protected by other process locks (follows). + */ +#define ERTS_PROC_LOCK_MAIN (((ErtsProcLocks) 1) << 0) + +/* + * Link lock: + * Protects the following fields in the process structure: + * * nlinks + * * monitors + * * suspend_monitors + */ +#define ERTS_PROC_LOCK_LINK (((ErtsProcLocks) 1) << 1) + +/* + * Message queue lock: + * Protects the following fields in the process structure: + * * msg_inq + * * bif_timers + */ +#define ERTS_PROC_LOCK_MSGQ (((ErtsProcLocks) 1) << 2) + +/* + * Status lock: + * Protects the following fields in the process structure: + * * status + * * rstatus + * * status_flags + * * pending_suspenders + * * suspendee + */ +#define ERTS_PROC_LOCK_STATUS (((ErtsProcLocks) 1) << ERTS_PROC_LOCK_MAX_BIT) + +/* + * Special fields: + * + * The following fields are read only and can be read if at + * least one process lock (whichever one doesn't matter) + * is held, or if the process structure is guaranteed not to + * disappear by other means (e.g. pix lock is held): + * * id + * + * The following fields are only allowed to be written if + * all process locks are held, and are allowed to be read if + * at least one process lock (whichever one doesn't matter) + * is held: + * * tracer_proc + * * tracer_flags + * + * The following fields are only allowed to be accessed if + * both the schedule queue lock and at least one process lock + * (whichever one doesn't matter) are held: + * * prio + * * next + * * scheduler_flags + */ + +/* + * Other rules regarding process locking: + * + * Exiting processes: + * When changing status to P_EXITING on a process, you are required + * to take all process locks (ERTS_PROC_LOCKS_ALL). Thus, by holding + * at least one process lock (whichever one doesn't matter) you + * are guaranteed that the process won't exit until the lock you are + * holding has been released. Appart from all process locks also + * the pix lock corresponding to the process has to be held. + * At the same time as status is changed to P_EXITING, also the + * field 'is_exiting' in the process structure is set to a value != 0. + * + * Lock order: + * Process locks with low numeric values has to be locked before + * process locks with high numeric values. E.g., main locks has + * to be locked before message queue locks. + * + * When process locks with the same numeric value are to be locked + * on multiple processes, locks on processes with low process ids + * have to be locked before locks on processes with high process + * ids. E.g., if the main and the message queue locks are to be + * locked on processes p1 and p2 and p1->id < p2->id, then locks + * should be locked in the following order: + * 1. main lock on p1 + * 2. main lock on p2 + * 3. message queue lock on p1 + * 4. message queue lock on p2 + */ + +/* Other lock flags */ +#define ERTS_PROC_LOCK_WAITER_SHIFT (ERTS_PROC_LOCK_MAX_BIT + 1) + + +/* ERTS_PROC_LOCKS_* are combinations of process locks */ + +#define ERTS_PROC_LOCKS_MSG_RECEIVE (ERTS_PROC_LOCK_MSGQ \ + | ERTS_PROC_LOCK_STATUS) +#define ERTS_PROC_LOCKS_MSG_SEND (ERTS_PROC_LOCK_MSGQ \ + | ERTS_PROC_LOCK_STATUS) +#define ERTS_PROC_LOCKS_XSIG_SEND ERTS_PROC_LOCK_STATUS + +#define ERTS_PROC_LOCKS_ALL \ + ((((ErtsProcLocks) 1) << (ERTS_PROC_LOCK_MAX_BIT + 1)) - 1) + +#define ERTS_PROC_LOCKS_ALL_MINOR (ERTS_PROC_LOCKS_ALL \ + & ~ERTS_PROC_LOCK_MAIN) + + +#define ERTS_PIX_LOCKS_BITS 8 +#define ERTS_NO_OF_PIX_LOCKS (1 << ERTS_PIX_LOCKS_BITS) + + +#endif /* #ifndef ERTS_PROC_LOCK_TYPE__ */ + +#ifndef ERTS_PROCESS_LOCK_ONLY_PROC_LOCK_TYPE__ +#ifndef ERTS_PROC_LOCK_LOCK_CHECK__ +#define ERTS_PROC_LOCK_LOCK_CHECK__ + +/* Lock counter implemetation */ + +#ifdef ERTS_ENABLE_LOCK_COUNT +#define erts_smp_proc_lock__(P,I,L) erts_smp_proc_lock_x__(P,I,L,__FILE__,__LINE__) +#define erts_smp_proc_lock(P,L) erts_smp_proc_lock_x(P,L,__FILE__,__LINE__) +#endif + +#if defined(ERTS_SMP) && defined (ERTS_ENABLE_LOCK_COUNT) + +void erts_lcnt_proc_lock_init(Process *p); +void erts_lcnt_proc_lock_destroy(Process *p); +void erts_lcnt_proc_lock(erts_proc_lock_t *lock, ErtsProcLocks locks); +void erts_lcnt_proc_lock_post_x(erts_proc_lock_t *lock, ErtsProcLocks locks, char *file, unsigned int line); +void erts_lcnt_proc_lock_unaquire(erts_proc_lock_t *lock, ErtsProcLocks locks); +void erts_lcnt_proc_unlock(erts_proc_lock_t *lock, ErtsProcLocks locks); +void erts_lcnt_proc_trylock(erts_proc_lock_t *lock, ErtsProcLocks locks, int res); + +#endif /* ERTS_ENABLE_LOCK_COUNT*/ + + + +/* --- Process lock checking ----------------------------------------------- */ + +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) +#define ERTS_SMP_CHK_NO_PROC_LOCKS \ + erts_proc_lc_chk_no_proc_locks(__FILE__, __LINE__) +#define ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(P) \ + erts_proc_lc_chk_only_proc_main((P)) +void erts_proc_lc_lock(Process *p, ErtsProcLocks locks); +void erts_proc_lc_trylock(Process *p, ErtsProcLocks locks, int locked); +void erts_proc_lc_unlock(Process *p, ErtsProcLocks locks); +void erts_proc_lc_might_unlock(Process *p, ErtsProcLocks locks); +void erts_proc_lc_chk_have_proc_locks(Process *p, ErtsProcLocks locks); +void erts_proc_lc_chk_proc_locks(Process *p, ErtsProcLocks locks); +void erts_proc_lc_chk_only_proc_main(Process *p); +void erts_proc_lc_chk_no_proc_locks(char *file, int line); +ErtsProcLocks erts_proc_lc_my_proc_locks(Process *p); +int erts_proc_lc_trylock_force_busy(Process *p, ErtsProcLocks locks); +void erts_proc_lc_require_lock(Process *p, ErtsProcLocks locks); +void erts_proc_lc_unrequire_lock(Process *p, ErtsProcLocks locks); +#else +#define ERTS_SMP_CHK_NO_PROC_LOCKS +#define ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(P) +#endif + +#endif /* #ifndef ERTS_PROC_LOCK_LOCK_CHECK__ */ +#endif /* #ifndef ERTS_PROCESS_LOCK_ONLY_PROC_LOCK_TYPE__ */ + +#if !defined(ERTS_PROCESS_LOCK_ONLY_PROC_LOCK_TYPE__) \ + && !defined(ERTS_PROCESS_LOCK_ONLY_LOCK_CHECK_PROTO__) +#ifndef ERTS_PROCESS_LOCK_H__ +#define ERTS_PROCESS_LOCK_H__ + +#ifdef ERTS_SMP + +typedef struct { + union { +#if ERTS_PROC_LOCK_MUTEX_IMPL + erts_smp_mtx_t mtx; +#else + erts_smp_spinlock_t spnlck; +#endif + char buf[64]; /* Try to get locks in different cache lines */ + } u; +} erts_pix_lock_t; + +#define ERTS_PIX2PIXLOCKIX(PIX) \ + ((PIX) & ((1 << ERTS_PIX_LOCKS_BITS) - 1)) +#define ERTS_PIX2PIXLOCK(PIX) \ + (&erts_pix_locks[ERTS_PIX2PIXLOCKIX((PIX))]) +#define ERTS_PID2PIXLOCK(PID) \ + ERTS_PIX2PIXLOCK(internal_pid_data((PID))) + +#if ERTS_PROC_LOCK_ATOMIC_IMPL + +#define ERTS_PROC_LOCK_FLGS_BAND_(L, MSK) \ + ((ErtsProcLocks) erts_smp_atomic_band(&(L)->flags, (long) (MSK))) +#define ERTS_PROC_LOCK_FLGS_BOR_(L, MSK) \ + ((ErtsProcLocks) erts_smp_atomic_bor(&(L)->flags, (long) (MSK))) +#define ERTS_PROC_LOCK_FLGS_CMPXCHG_(L, NEW, EXPECTED) \ + ((ErtsProcLocks) erts_smp_atomic_cmpxchg(&(L)->flags, \ + (long) (NEW), (long) (EXPECTED))) +#define ERTS_PROC_LOCK_FLGS_READ_(L) \ + ((ErtsProcLocks) erts_smp_atomic_read(&(L)->flags)) + +#else /* no opt atomic ops */ + +ERTS_GLB_INLINE ErtsProcLocks erts_proc_lock_flags_band(erts_proc_lock_t *, + ErtsProcLocks); +ERTS_GLB_INLINE ErtsProcLocks erts_proc_lock_flags_bor(erts_proc_lock_t *, + ErtsProcLocks); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE ErtsProcLocks +erts_proc_lock_flags_band(erts_proc_lock_t *lck, ErtsProcLocks mask) +{ + ErtsProcLocks res = lck->flags; + lck->flags &= mask; + return res; +} + +ERTS_GLB_INLINE ErtsProcLocks +erts_proc_lock_flags_bor(erts_proc_lock_t *lck, ErtsProcLocks mask) +{ + ErtsProcLocks res = lck->flags; + lck->flags |= mask; + return res; +} + +ERTS_GLB_INLINE ErtsProcLocks +erts_proc_lock_flags_cmpxchg(erts_proc_lock_t *lck, ErtsProcLocks new, + ErtsProcLocks expected) +{ + ErtsProcLocks res = lck->flags; + if (res == expected) + lck->flags = new; + return res; +} + +#endif + +#define ERTS_PROC_LOCK_FLGS_BAND_(L, MSK) erts_proc_lock_flags_band((L), (MSK)) +#define ERTS_PROC_LOCK_FLGS_BOR_(L, MSK) erts_proc_lock_flags_bor((L), (MSK)) +#define ERTS_PROC_LOCK_FLGS_CMPXCHG_(L, NEW, EXPECTED) \ + erts_proc_lock_flags_cmpxchg((L), (NEW), (EXPECTED)) +#define ERTS_PROC_LOCK_FLGS_READ_(L) ((L)->flags) + +#endif /* end no opt atomic ops */ + +extern erts_pix_lock_t erts_pix_locks[ERTS_NO_OF_PIX_LOCKS]; + +void erts_init_proc_lock(void); +void erts_proc_lock_prepare_proc_lock_waiter(void); +void erts_proc_lock_failed(Process *, + erts_pix_lock_t *, + ErtsProcLocks, + ErtsProcLocks); +void erts_proc_unlock_failed(Process *, + erts_pix_lock_t *, + ErtsProcLocks); + +ERTS_GLB_INLINE void erts_pix_lock(erts_pix_lock_t *); +ERTS_GLB_INLINE void erts_pix_unlock(erts_pix_lock_t *); +ERTS_GLB_INLINE int erts_lc_pix_lock_is_locked(erts_pix_lock_t *); + +ERTS_GLB_INLINE ErtsProcLocks erts_smp_proc_raw_trylock__(Process *p, + ErtsProcLocks locks); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_smp_proc_lock_x__(Process *, + erts_pix_lock_t *, + ErtsProcLocks, + char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_smp_proc_lock__(Process *, + erts_pix_lock_t *, + ErtsProcLocks); +#endif +ERTS_GLB_INLINE void erts_smp_proc_unlock__(Process *, + erts_pix_lock_t *, + ErtsProcLocks); +ERTS_GLB_INLINE int erts_smp_proc_trylock__(Process *, + erts_pix_lock_t *, + ErtsProcLocks); + +#ifdef ERTS_PROC_LOCK_DEBUG +ERTS_GLB_INLINE void erts_proc_lock_op_debug(Process *, ErtsProcLocks, int); +#endif + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void erts_pix_lock(erts_pix_lock_t *pixlck) +{ + ERTS_LC_ASSERT(pixlck); +#if ERTS_PROC_LOCK_MUTEX_IMPL + erts_smp_mtx_lock(&pixlck->u.mtx); +#else + erts_smp_spin_lock(&pixlck->u.spnlck); +#endif +} + +ERTS_GLB_INLINE void erts_pix_unlock(erts_pix_lock_t *pixlck) +{ + ERTS_LC_ASSERT(pixlck); +#if ERTS_PROC_LOCK_MUTEX_IMPL + erts_smp_mtx_unlock(&pixlck->u.mtx); +#else + erts_smp_spin_unlock(&pixlck->u.spnlck); +#endif +} + +ERTS_GLB_INLINE int erts_lc_pix_lock_is_locked(erts_pix_lock_t *pixlck) +{ +#if ERTS_PROC_LOCK_MUTEX_IMPL + return erts_smp_lc_mtx_is_locked(&pixlck->u.mtx); +#else + return erts_smp_lc_spinlock_is_locked(&pixlck->u.spnlck); +#endif +} + +/* + * Helper function for erts_smp_proc_lock__ and erts_smp_proc_trylock__. + * + * Attempts to grab all of 'locks' simultaneously. + * + * On success, returns zero. + * + * On failure, returns the p->locks at the moment it tried to grab them, + * at least some of which will intersect with 'locks', so it is nonzero. + * + * This assumes p's pix lock is held on entry if !ERTS_PROC_LOCK_ATOMIC_IMPL. + * Does not release the pix lock. + */ +ERTS_GLB_INLINE ErtsProcLocks +erts_smp_proc_raw_trylock__(Process *p, ErtsProcLocks locks) +{ + ErtsProcLocks expct_lflgs = 0; + + while (1) { + ErtsProcLocks lflgs = ERTS_PROC_LOCK_FLGS_CMPXCHG_(&p->lock, + expct_lflgs | locks, + expct_lflgs); + if (ERTS_LIKELY(lflgs == expct_lflgs)) { + /* We successfully grabbed all locks. */ + return 0; + } + + if (lflgs & locks) { + /* Some locks we need are locked, give up. */ + return lflgs; + } + + /* cmpxchg failed, try again (should be rare). */ + expct_lflgs = lflgs; + } +} + + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_smp_proc_lock_x__(Process *p, + erts_pix_lock_t *pix_lck, + ErtsProcLocks locks, + char *file, unsigned int line) +#else +erts_smp_proc_lock__(Process *p, + erts_pix_lock_t *pix_lck, + ErtsProcLocks locks) +#endif +{ + ErtsProcLocks old_lflgs; +#if !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_lock(pix_lck); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_proc_lock(&(p->lock), locks); +#endif + + ERTS_LC_ASSERT((locks & ~ERTS_PROC_LOCKS_ALL) == 0); + + old_lflgs = erts_smp_proc_raw_trylock__(p, locks); + + if (old_lflgs != 0) { + /* + * There is lock contention, so let erts_proc_lock_failed() deal + * with it. Note that erts_proc_lock_failed() returns with + * pix_lck unlocked. + */ + erts_proc_lock_failed(p, pix_lck, locks, old_lflgs); + } + +#if !ERTS_PROC_LOCK_ATOMIC_IMPL + else { + ERTS_LC_ASSERT(locks == (ERTS_PROC_LOCK_FLGS_READ_(&p->lock) & locks)); + erts_pix_unlock(pix_lck); + } +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_proc_lock_post_x(&(p->lock), locks, file, line); +#endif +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_proc_lc_lock(p, locks); +#endif +#ifdef ERTS_PROC_LOCK_DEBUG + erts_proc_lock_op_debug(p, locks, 1); +#endif + +#if ERTS_PROC_LOCK_ATOMIC_IMPL + ETHR_COMPILER_BARRIER; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_proc_unlock__(Process *p, + erts_pix_lock_t *pix_lck, + ErtsProcLocks locks) +{ + ErtsProcLocks old_lflgs; + +#if ERTS_PROC_LOCK_ATOMIC_IMPL + ETHR_COMPILER_BARRIER; +#endif + +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_proc_unlock(&(p->lock), locks); +#endif + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_proc_lc_unlock(p, locks); +#endif +#ifdef ERTS_PROC_LOCK_DEBUG + erts_proc_lock_op_debug(p, locks, 0); +#endif + +#if !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_lock(pix_lck); +#endif + + old_lflgs = ERTS_PROC_LOCK_FLGS_READ_(&p->lock); + + ERTS_LC_ASSERT((locks & ~ERTS_PROC_LOCKS_ALL) == 0); + ERTS_LC_ASSERT(locks == (old_lflgs & locks)); + + while (1) { + /* + * We'll atomically unlock every lock that has no waiter. + * If any locks with waiters remain we'll let + * erts_proc_unlock_failed() deal with them. + */ + ErtsProcLocks wait_locks = + (old_lflgs >> ERTS_PROC_LOCK_WAITER_SHIFT) & locks; + + /* What p->lock will look like with all non-waited locks released. */ + ErtsProcLocks want_lflgs = old_lflgs & (wait_locks | ~locks); + + if (want_lflgs != old_lflgs) { + ErtsProcLocks new_lflgs = + ERTS_PROC_LOCK_FLGS_CMPXCHG_(&p->lock, want_lflgs, old_lflgs); + + if (new_lflgs != old_lflgs) { + /* cmpxchg failed, try again. */ + old_lflgs = new_lflgs; + continue; + } + } + + /* We have successfully unlocked every lock with no waiter. */ + + if (want_lflgs & locks) { + /* Locks with waiters remain. */ + /* erts_proc_unlock_failed() returns with pix_lck unlocked. */ + erts_proc_unlock_failed(p, pix_lck, want_lflgs & locks); + } + else { +#if !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_unlock(pix_lck); +#endif + } + + break; + } +} + +ERTS_GLB_INLINE int +erts_smp_proc_trylock__(Process *p, + erts_pix_lock_t *pix_lck, + ErtsProcLocks locks) +{ + int res; + +#ifdef ERTS_ENABLE_LOCK_CHECK + ERTS_LC_ASSERT((locks & ~ERTS_PROC_LOCKS_ALL) == 0); + if (erts_proc_lc_trylock_force_busy(p, locks)) { + res = EBUSY; /* Make sure caller can handle the situation without + causing a lock order violation to occur */ + } + else +#endif + { +#if !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_lock(pix_lck); +#endif + + if (erts_smp_proc_raw_trylock__(p, locks) != 0) { + /* Didn't get all locks... */ + res = EBUSY; + +#if !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_unlock(pix_lck); +#endif + } + else { + res = 0; + + ERTS_LC_ASSERT(locks + == (ERTS_PROC_LOCK_FLGS_READ_(&p->lock) & locks)); + +#if !ERTS_PROC_LOCK_ATOMIC_IMPL + erts_pix_unlock(pix_lck); +#endif + +#ifdef ERTS_PROC_LOCK_DEBUG + erts_proc_lock_op_debug(p, locks, 1); +#endif + } + } +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_proc_trylock(&(p->lock), locks, res); +#endif + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_proc_lc_trylock(p, locks, res == 0); +#endif + +#if ERTS_PROC_LOCK_ATOMIC_IMPL + ETHR_COMPILER_BARRIER; +#endif + + return res; +} + +#ifdef ERTS_PROC_LOCK_DEBUG +ERTS_GLB_INLINE void +erts_proc_lock_op_debug(Process *p, ErtsProcLocks locks, int locked) +{ + int i; + for (i = 0; i <= ERTS_PROC_LOCK_MAX_BIT; i++) { + ErtsProcLocks lock = ((ErtsProcLocks) 1) << i; + if (locks & lock) { + long lock_count; + if (locked) { + lock_count = erts_smp_atomic_inctest(&p->lock.locked[i]); + ERTS_LC_ASSERT(lock_count == 1); + } + else { + lock_count = erts_smp_atomic_dectest(&p->lock.locked[i]); + ERTS_LC_ASSERT(lock_count == 0); + } + } + } +} +#endif + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERTS_SMP */ + +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_smp_proc_lock_x(Process *, ErtsProcLocks, char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_smp_proc_lock(Process *, ErtsProcLocks); +#endif +ERTS_GLB_INLINE void erts_smp_proc_unlock(Process *, ErtsProcLocks); +ERTS_GLB_INLINE int erts_smp_proc_trylock(Process *, ErtsProcLocks); + +ERTS_GLB_INLINE void erts_smp_proc_inc_refc(Process *); +ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_smp_proc_lock_x(Process *p, ErtsProcLocks locks, char *file, unsigned int line) +#else +erts_smp_proc_lock(Process *p, ErtsProcLocks locks) +#endif +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) + erts_smp_proc_lock_x__(p, +#if ERTS_PROC_LOCK_ATOMIC_IMPL + NULL, +#else + ERTS_PID2PIXLOCK(p->id), +#endif /*ERTS_PROC_LOCK_ATOMIC_IMPL*/ + locks, file, line); +#elif defined(ERTS_SMP) + erts_smp_proc_lock__(p, +#if ERTS_PROC_LOCK_ATOMIC_IMPL + NULL, +#else + ERTS_PID2PIXLOCK(p->id), +#endif /*ERTS_PROC_LOCK_ATOMIC_IMPL*/ + locks); +#endif /*ERTS_SMP*/ +} + +ERTS_GLB_INLINE void +erts_smp_proc_unlock(Process *p, ErtsProcLocks locks) +{ +#ifdef ERTS_SMP + erts_smp_proc_unlock__(p, +#if ERTS_PROC_LOCK_ATOMIC_IMPL + NULL, +#else + ERTS_PID2PIXLOCK(p->id), +#endif + locks); +#endif +} + +ERTS_GLB_INLINE int +erts_smp_proc_trylock(Process *p, ErtsProcLocks locks) +{ +#ifndef ERTS_SMP + return 0; +#else + return erts_smp_proc_trylock__(p, +#if ERTS_PROC_LOCK_ATOMIC_IMPL + NULL, +#else + ERTS_PID2PIXLOCK(p->id), +#endif + locks); +#endif +} + + +ERTS_GLB_INLINE void erts_smp_proc_inc_refc(Process *p) +{ +#ifdef ERTS_SMP + erts_pix_lock_t *pixlck = ERTS_PID2PIXLOCK(p->id); + erts_pix_lock(pixlck); + ERTS_LC_ASSERT(p->lock.refc > 0); + p->lock.refc++; + erts_pix_unlock(pixlck); +#endif +} + +ERTS_GLB_INLINE void erts_smp_proc_dec_refc(Process *p) +{ +#ifdef ERTS_SMP + Process *fp; + erts_pix_lock_t *pixlck = ERTS_PID2PIXLOCK(p->id); + erts_pix_lock(pixlck); + ERTS_LC_ASSERT(p->lock.refc > 0); + fp = --p->lock.refc == 0 ? p : NULL; + erts_pix_unlock(pixlck); + if (fp) + erts_free_proc(fp); +#endif +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#ifdef ERTS_SMP +void erts_proc_lock_init(Process *); +void erts_proc_safelock(Process *a_proc, + ErtsProcLocks a_have_locks, + ErtsProcLocks a_need_locks, + Process *b_proc, + ErtsProcLocks b_have_locks, + ErtsProcLocks b_need_locks); +#endif + +/* + * --- Process table lookup ------------------------------------------------ + * + * erts_pid2proc() and friends looks up the process structure of a pid + * and at the same time acquires process locks in the smp case. Locks + * on currently executing process and looked up process are taken according + * to the lock order, i.e., locks on currently executing process may have + * been released and reacquired. + * + * erts_pid2proc_opt() currently accepts the following flags: + * ERTS_P2P_FLG_ALLOW_OTHER_X Lookup process even if it currently + * is exiting. + */ + +#define ERTS_P2P_FLG_ALLOW_OTHER_X (1 << 0) +#define ERTS_P2P_FLG_TRY_LOCK (1 << 1) +#define ERTS_P2P_FLG_SMP_INC_REFC (1 << 2) + +#define ERTS_PROC_LOCK_BUSY ((Process *) &erts_proc_lock_busy) +extern const Process erts_proc_lock_busy; + +#define erts_pid2proc(PROC, HL, PID, NL) \ + erts_pid2proc_opt((PROC), (HL), (PID), (NL), 0) + +ERTS_GLB_INLINE Process * +erts_pid2proc_opt(Process *, ErtsProcLocks, Eterm, ErtsProcLocks, int); + +#ifdef ERTS_SMP +void +erts_pid2proc_safelock(Process *c_p, + ErtsProcLocks c_p_have_locks, + Process **proc, + ErtsProcLocks need_locks, + erts_pix_lock_t *pix_lock, + int flags); +ERTS_GLB_INLINE Process *erts_pid2proc_unlocked_opt(Eterm pid, int flags); +#define erts_pid2proc_unlocked(PID) erts_pid2proc_unlocked_opt((PID), 0) +#else +#define erts_pid2proc_unlocked_opt(PID, FLGS) \ + erts_pid2proc_opt(NULL, 0, (PID), 0, FLGS) +#define erts_pid2proc_unlocked(PID) erts_pid2proc_opt(NULL, 0, (PID), 0, 0) +#endif + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE Process * +#ifdef ERTS_SMP +erts_pid2proc_unlocked_opt(Eterm pid, int flags) +#else +erts_pid2proc_opt(Process *c_p_unused, + ErtsProcLocks c_p_have_locks_unused, + Eterm pid, + ErtsProcLocks pid_need_locks_unused, + int flags) +#endif +{ + Uint pix; + Process *proc; + + if (is_not_internal_pid(pid)) + return NULL; + pix = internal_pid_index(pid); + if(pix >= erts_max_processes) + return NULL; + proc = process_tab[pix]; + if (proc) { + if (proc->id != pid + || (!(flags & ERTS_P2P_FLG_ALLOW_OTHER_X) + && proc->status == P_EXITING)) + proc = NULL; + } + return proc; +} + +#ifdef ERTS_SMP + +ERTS_GLB_INLINE Process * +erts_pid2proc_opt(Process *c_p, + ErtsProcLocks c_p_have_locks, + Eterm pid, + ErtsProcLocks pid_need_locks, + int flags) +{ + erts_pix_lock_t *pix_lock; + ErtsProcLocks need_locks; + Uint pix; + Process *proc; +#ifdef ERTS_ENABLE_LOCK_COUNT + ErtsProcLocks lcnt_locks; +#endif + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (c_p) { + ErtsProcLocks might_unlock = c_p_have_locks & pid_need_locks; + if (might_unlock) + erts_proc_lc_might_unlock(c_p, might_unlock); + } +#endif + if (is_not_internal_pid(pid)) { + proc = NULL; + goto done; + } + pix = internal_pid_index(pid); + if(pix >= erts_max_processes) { + proc = NULL; + goto done; + } + + ERTS_LC_ASSERT((pid_need_locks & ERTS_PROC_LOCKS_ALL) == pid_need_locks); + need_locks = pid_need_locks; + + pix_lock = ERTS_PIX2PIXLOCK(pix); + + if (c_p && c_p->id == pid) { + ASSERT(c_p->id != ERTS_INVALID_PID); + ASSERT(c_p == process_tab[pix]); + if (!(flags & ERTS_P2P_FLG_ALLOW_OTHER_X) && c_p->is_exiting) { + proc = NULL; + goto done; + } + need_locks &= ~c_p_have_locks; + if (!need_locks) { + proc = c_p; + erts_pix_lock(pix_lock); + if (flags & ERTS_P2P_FLG_SMP_INC_REFC) + proc->lock.refc++; + erts_pix_unlock(pix_lock); + goto done; + } + } + + erts_pix_lock(pix_lock); + + proc = process_tab[pix]; + if (proc) { + if (proc->id != pid || (!(flags & ERTS_P2P_FLG_ALLOW_OTHER_X) + && ERTS_PROC_IS_EXITING(proc))) { + proc = NULL; + } + else if (!need_locks) { + if (flags & ERTS_P2P_FLG_SMP_INC_REFC) + proc->lock.refc++; + } + else { + int busy; + +#ifdef ERTS_ENABLE_LOCK_COUNT + lcnt_locks = need_locks; + if (!(flags & ERTS_P2P_FLG_TRY_LOCK)) { + erts_lcnt_proc_lock(&proc->lock, need_locks); + } +#endif + +#ifdef ERTS_ENABLE_LOCK_CHECK + /* Make sure erts_pid2proc_safelock() is enough to handle + a potential lock order violation situation... */ + busy = erts_proc_lc_trylock_force_busy(proc, need_locks); + if (!busy) +#endif + { + /* Try a quick trylock to grab all the locks we need. */ + busy = (int) erts_smp_proc_raw_trylock__(proc, need_locks); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_proc_lc_trylock(proc, need_locks, !busy); +#endif +#ifdef ERTS_PROC_LOCK_DEBUG + if (!busy) + erts_proc_lock_op_debug(proc, need_locks, 1); +#endif + } + +#ifdef ERTS_ENABLE_LOCK_COUNT + if (flags & ERTS_P2P_FLG_TRY_LOCK) { + if (busy) { + erts_lcnt_proc_trylock(&proc->lock, need_locks, EBUSY); + } else { + erts_lcnt_proc_trylock(&proc->lock, need_locks, 0); + } + } +#endif + if (!busy) { + if (flags & ERTS_P2P_FLG_SMP_INC_REFC) + proc->lock.refc++; +#ifdef ERTS_ENABLE_LOCK_COUNT + /* all is great */ + if (!(flags & ERTS_P2P_FLG_TRY_LOCK)) { + erts_lcnt_proc_lock_post_x(&proc->lock, lcnt_locks, __FILE__, __LINE__); + } +#endif + } + else { + if (flags & ERTS_P2P_FLG_TRY_LOCK) + proc = ERTS_PROC_LOCK_BUSY; + else { + if (flags & ERTS_P2P_FLG_SMP_INC_REFC) + proc->lock.refc++; +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_proc_lock_unaquire(&proc->lock, lcnt_locks); +#endif + erts_pid2proc_safelock(c_p, + c_p_have_locks, + &proc, + pid_need_locks, + pix_lock, + flags); + } + } + } + } + + erts_pix_unlock(pix_lock); +#ifdef ERTS_PROC_LOCK_DEBUG + ERTS_LC_ASSERT(!proc + || proc == ERTS_PROC_LOCK_BUSY + || (pid_need_locks == + (ERTS_PROC_LOCK_FLGS_READ_(&proc->lock) + & pid_need_locks))); +#endif + + + done: + +#if ERTS_PROC_LOCK_ATOMIC_IMPL + ETHR_COMPILER_BARRIER; +#endif + + return proc; +} +#endif /* ERTS_SMP */ + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* #ifndef ERTS_PROCESS_LOCK_H__ */ +#endif /* #if !defined(ERTS_PROCESS_LOCK_ONLY_PROC_LOCK_TYPE__) + && !defined(ERTS_PROCESS_LOCK_ONLY_LOCK_CHECK_PROTO__) */ diff --git a/erts/emulator/beam/erl_resolv_dns.c b/erts/emulator/beam/erl_resolv_dns.c new file mode 100644 index 0000000000..9d76fa89f8 --- /dev/null +++ b/erts/emulator/beam/erl_resolv_dns.c @@ -0,0 +1,23 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Set this to non-zero value if DNS should be used. + */ +int erl_use_resolver = 1; diff --git a/erts/emulator/beam/erl_resolv_nodns.c b/erts/emulator/beam/erl_resolv_nodns.c new file mode 100644 index 0000000000..f14ab68e27 --- /dev/null +++ b/erts/emulator/beam/erl_resolv_nodns.c @@ -0,0 +1,23 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Set this to non-zero value if DNS should be used. + */ +int erl_use_resolver = 0; diff --git a/erts/emulator/beam/erl_smp.h b/erts/emulator/beam/erl_smp.h new file mode 100644 index 0000000000..03d2a586e3 --- /dev/null +++ b/erts/emulator/beam/erl_smp.h @@ -0,0 +1,993 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * SMP interface to ethread library. + * This is essentially "sed s/erts_/erts_smp_/g < erl_threads.h > erl_smp.h", + * plus changes to NOP operations when ERTS_SMP is disabled. + * Author: Mikael Pettersson + */ +#ifndef ERL_SMP_H +#define ERL_SMP_H +#include "erl_threads.h" + +#ifdef ERTS_ENABLE_LOCK_COUNT +#define erts_smp_mtx_lock(L) erts_smp_mtx_lock_x(L, __FILE__, __LINE__) +#define erts_smp_spin_lock(L) erts_smp_spin_lock_x(L, __FILE__, __LINE__) +#define erts_smp_rwmtx_rlock(L) erts_smp_rwmtx_rlock_x(L, __FILE__, __LINE__) +#define erts_smp_rwmtx_rwlock(L) erts_smp_rwmtx_rwlock_x(L, __FILE__, __LINE__) +#define erts_smp_read_lock(L) erts_smp_read_lock_x(L, __FILE__, __LINE__) +#define erts_smp_write_lock(L) erts_smp_write_lock_x(L, __FILE__, __LINE__) +#endif + + +#ifdef ERTS_SMP +#define ERTS_SMP_THR_OPTS_DEFAULT_INITER ERTS_THR_OPTS_DEFAULT_INITER +typedef erts_thr_opts_t erts_smp_thr_opts_t; +typedef erts_thr_init_data_t erts_smp_thr_init_data_t; +typedef erts_tid_t erts_smp_tid_t; +typedef erts_mtx_t erts_smp_mtx_t; +typedef erts_cnd_t erts_smp_cnd_t; +typedef erts_rwmtx_t erts_smp_rwmtx_t; +typedef erts_tsd_key_t erts_smp_tsd_key_t; +typedef erts_gate_t erts_smp_gate_t; +typedef ethr_atomic_t erts_smp_atomic_t; +typedef erts_spinlock_t erts_smp_spinlock_t; +typedef erts_rwlock_t erts_smp_rwlock_t; +typedef erts_thr_timeval_t erts_smp_thr_timeval_t; +void erts_thr_fatal_error(int, char *); /* implemented in erl_init.c */ + +#else /* #ifdef ERTS_SMP */ + +#define ERTS_SMP_THR_OPTS_DEFAULT_INITER 0 +typedef int erts_smp_thr_opts_t; +typedef int erts_smp_thr_init_data_t; +typedef int erts_smp_tid_t; +typedef int erts_smp_mtx_t; +typedef int erts_smp_cnd_t; +typedef int erts_smp_rwmtx_t; +typedef int erts_smp_tsd_key_t; +typedef int erts_smp_gate_t; +typedef long erts_smp_atomic_t; +#if __GNUC__ > 2 +typedef struct { } erts_smp_spinlock_t; +typedef struct { } erts_smp_rwlock_t; +#else +typedef struct { int gcc_is_buggy; } erts_smp_spinlock_t; +typedef struct { int gcc_is_buggy; } erts_smp_rwlock_t; +#endif + +typedef struct { + long tv_sec; + long tv_nsec; +} erts_smp_thr_timeval_t; + +#endif /* #ifdef ERTS_SMP */ + +ERTS_GLB_INLINE void erts_smp_thr_init(erts_smp_thr_init_data_t *id); +ERTS_GLB_INLINE void erts_smp_thr_create(erts_smp_tid_t *tid, + void * (*func)(void *), + void *arg, + erts_smp_thr_opts_t *opts); +ERTS_GLB_INLINE void erts_smp_thr_join(erts_smp_tid_t tid, void **thr_res); +ERTS_GLB_INLINE void erts_smp_thr_detach(erts_smp_tid_t tid); +ERTS_GLB_INLINE void erts_smp_thr_exit(void *res); +ERTS_GLB_INLINE void erts_smp_install_exit_handler(void (*exit_handler)(void)); +ERTS_GLB_INLINE erts_smp_tid_t erts_smp_thr_self(void); +ERTS_GLB_INLINE int erts_smp_equal_tids(erts_smp_tid_t x, erts_smp_tid_t y); +#ifdef ERTS_HAVE_REC_MTX_INIT +#define ERTS_SMP_HAVE_REC_MTX_INIT 1 +ERTS_GLB_INLINE void erts_smp_rec_mtx_init(erts_smp_mtx_t *mtx); +#endif +ERTS_GLB_INLINE void erts_smp_mtx_init_x(erts_smp_mtx_t *mtx, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name); +ERTS_GLB_INLINE void erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name); +ERTS_GLB_INLINE void erts_smp_mtx_destroy(erts_smp_mtx_t *mtx); +ERTS_GLB_INLINE void erts_smp_mtx_set_forksafe(erts_smp_mtx_t *mtx); +ERTS_GLB_INLINE void erts_smp_mtx_unset_forksafe(erts_smp_mtx_t *mtx); +ERTS_GLB_INLINE int erts_smp_mtx_trylock(erts_smp_mtx_t *mtx); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_smp_mtx_lock_x(erts_smp_mtx_t *mtx, char *file, int line); +#else +ERTS_GLB_INLINE void erts_smp_mtx_lock(erts_smp_mtx_t *mtx); +#endif +ERTS_GLB_INLINE void erts_smp_mtx_unlock(erts_smp_mtx_t *mtx); +ERTS_GLB_INLINE int erts_smp_lc_mtx_is_locked(erts_smp_mtx_t *mtx); +ERTS_GLB_INLINE void erts_smp_cnd_init(erts_smp_cnd_t *cnd); +ERTS_GLB_INLINE void erts_smp_cnd_destroy(erts_smp_cnd_t *cnd); +ERTS_GLB_INLINE void erts_smp_cnd_wait(erts_smp_cnd_t *cnd, + erts_smp_mtx_t *mtx); +ERTS_GLB_INLINE void erts_smp_cnd_signal(erts_smp_cnd_t *cnd); +ERTS_GLB_INLINE void erts_smp_cnd_broadcast(erts_smp_cnd_t *cnd); +ERTS_GLB_INLINE void erts_smp_rwmtx_init_x(erts_smp_rwmtx_t *rwmtx, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx, + char *name); +ERTS_GLB_INLINE void erts_smp_rwmtx_destroy(erts_smp_rwmtx_t *rwmtx); +ERTS_GLB_INLINE int erts_smp_rwmtx_tryrlock(erts_smp_rwmtx_t *rwmtx); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_smp_rwmtx_rlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line); +ERTS_GLB_INLINE void erts_smp_rwmtx_rwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_smp_rwmtx_rlock(erts_smp_rwmtx_t *rwmtx); +ERTS_GLB_INLINE void erts_smp_rwmtx_rwlock(erts_smp_rwmtx_t *rwmtx); +#endif +ERTS_GLB_INLINE void erts_smp_rwmtx_runlock(erts_smp_rwmtx_t *rwmtx); +ERTS_GLB_INLINE int erts_smp_rwmtx_tryrwlock(erts_smp_rwmtx_t *rwmtx); +ERTS_GLB_INLINE void erts_smp_rwmtx_rwunlock(erts_smp_rwmtx_t *rwmtx); +ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rlocked(erts_smp_rwmtx_t *mtx); +ERTS_GLB_INLINE int erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx); +ERTS_GLB_INLINE void erts_smp_atomic_init(erts_smp_atomic_t *var, long i); +ERTS_GLB_INLINE void erts_smp_atomic_set(erts_smp_atomic_t *var, long i); +ERTS_GLB_INLINE long erts_smp_atomic_read(erts_smp_atomic_t *var); +ERTS_GLB_INLINE long erts_smp_atomic_inctest(erts_smp_atomic_t *incp); +ERTS_GLB_INLINE long erts_smp_atomic_dectest(erts_smp_atomic_t *decp); +ERTS_GLB_INLINE void erts_smp_atomic_inc(erts_smp_atomic_t *incp); +ERTS_GLB_INLINE void erts_smp_atomic_dec(erts_smp_atomic_t *decp); +ERTS_GLB_INLINE long erts_smp_atomic_addtest(erts_smp_atomic_t *addp, + long i); +ERTS_GLB_INLINE void erts_smp_atomic_add(erts_smp_atomic_t *addp, long i); +ERTS_GLB_INLINE long erts_smp_atomic_xchg(erts_smp_atomic_t *xchgp, + long new); +ERTS_GLB_INLINE long erts_smp_atomic_cmpxchg(erts_smp_atomic_t *xchgp, + long new, + long expected); +ERTS_GLB_INLINE long erts_smp_atomic_bor(erts_smp_atomic_t *var, long mask); +ERTS_GLB_INLINE long erts_smp_atomic_band(erts_smp_atomic_t *var, long mask); +ERTS_GLB_INLINE void erts_smp_spinlock_init_x(erts_smp_spinlock_t *lock, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_smp_spinlock_init(erts_smp_spinlock_t *lock, + char *name); +ERTS_GLB_INLINE void erts_smp_spinlock_destroy(erts_smp_spinlock_t *lock); +ERTS_GLB_INLINE void erts_smp_spin_unlock(erts_smp_spinlock_t *lock); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_smp_spin_lock_x(erts_smp_spinlock_t *lock, char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_smp_spin_lock(erts_smp_spinlock_t *lock); +#endif +ERTS_GLB_INLINE int erts_smp_lc_spinlock_is_locked(erts_smp_spinlock_t *lock); +ERTS_GLB_INLINE void erts_smp_rwlock_init_x(erts_smp_rwlock_t *lock, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_smp_rwlock_init(erts_smp_rwlock_t *lock, + char *name); +ERTS_GLB_INLINE void erts_smp_rwlock_destroy(erts_smp_rwlock_t *lock); +ERTS_GLB_INLINE void erts_smp_read_unlock(erts_smp_rwlock_t *lock); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_smp_read_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line); +ERTS_GLB_INLINE void erts_smp_write_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_smp_read_lock(erts_smp_rwlock_t *lock); +ERTS_GLB_INLINE void erts_smp_write_lock(erts_smp_rwlock_t *lock); +#endif +ERTS_GLB_INLINE void erts_smp_write_unlock(erts_smp_rwlock_t *lock); +ERTS_GLB_INLINE int erts_smp_lc_rwlock_is_rlocked(erts_smp_rwlock_t *lock); +ERTS_GLB_INLINE int erts_smp_lc_rwlock_is_rwlocked(erts_smp_rwlock_t *lock); +ERTS_GLB_INLINE void erts_smp_thr_time_now(erts_smp_thr_timeval_t *time); +ERTS_GLB_INLINE void erts_smp_tsd_key_create(erts_smp_tsd_key_t *keyp); +ERTS_GLB_INLINE void erts_smp_tsd_key_delete(erts_smp_tsd_key_t key); +ERTS_GLB_INLINE void erts_smp_tsd_set(erts_smp_tsd_key_t key, void *value); +ERTS_GLB_INLINE void * erts_smp_tsd_get(erts_smp_tsd_key_t key); +ERTS_GLB_INLINE void erts_smp_gate_init(erts_smp_gate_t *gp); +ERTS_GLB_INLINE void erts_smp_gate_destroy(erts_smp_gate_t *gp); +ERTS_GLB_INLINE void erts_smp_gate_close(erts_smp_gate_t *gp); +ERTS_GLB_INLINE void erts_smp_gate_let_through(erts_smp_gate_t *gp, unsigned no); +ERTS_GLB_INLINE void erts_smp_gate_wait(erts_smp_gate_t *gp); +ERTS_GLB_INLINE void erts_smp_gate_swait(erts_smp_gate_t *gp, int spincount); + +#ifdef ERTS_THR_HAVE_SIG_FUNCS +#define ERTS_SMP_THR_HAVE_SIG_FUNCS 1 +ERTS_GLB_INLINE void erts_smp_thr_sigmask(int how, + const sigset_t *set, + sigset_t *oset); +ERTS_GLB_INLINE void erts_smp_thr_sigwait(const sigset_t *set, int *sig); +#endif /* #ifdef ERTS_THR_HAVE_SIG_FUNCS */ + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_smp_thr_init(erts_smp_thr_init_data_t *id) +{ +#ifdef ERTS_SMP + erts_thr_init(id); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_thr_create(erts_smp_tid_t *tid, void * (*func)(void *), void *arg, + erts_smp_thr_opts_t *opts) +{ +#ifdef ERTS_SMP + erts_thr_create(tid, func, arg, opts); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_thr_join(erts_smp_tid_t tid, void **thr_res) +{ +#ifdef ERTS_SMP + erts_thr_join(tid, thr_res); +#endif +} + + +ERTS_GLB_INLINE void +erts_smp_thr_detach(erts_smp_tid_t tid) +{ +#ifdef ERTS_SMP + erts_thr_detach(tid); +#endif +} + + +ERTS_GLB_INLINE void +erts_smp_thr_exit(void *res) +{ +#ifdef ERTS_SMP + erts_thr_exit(res); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_install_exit_handler(void (*exit_handler)(void)) +{ +#ifdef ERTS_SMP + erts_thr_install_exit_handler(exit_handler); +#endif +} + +ERTS_GLB_INLINE erts_smp_tid_t +erts_smp_thr_self(void) +{ +#ifdef ERTS_SMP + return erts_thr_self(); +#else + return 0; +#endif +} + + +ERTS_GLB_INLINE int +erts_smp_equal_tids(erts_smp_tid_t x, erts_smp_tid_t y) +{ +#ifdef ERTS_SMP + return erts_equal_tids(x, y); +#else + return 1; +#endif +} + + +#ifdef ERTS_HAVE_REC_MTX_INIT +ERTS_GLB_INLINE void +erts_smp_rec_mtx_init(erts_smp_mtx_t *mtx) +{ +#ifdef ERTS_SMP + erts_rec_mtx_init(mtx); +#endif +} +#endif + +ERTS_GLB_INLINE void +erts_smp_mtx_init_x(erts_smp_mtx_t *mtx, char *name, Eterm extra) +{ +#ifdef ERTS_SMP + erts_mtx_init_x(mtx, name, extra); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_mtx_init_locked_x(erts_smp_mtx_t *mtx, char *name, Eterm extra) +{ +#ifdef ERTS_SMP + erts_mtx_init_locked_x(mtx, name, extra); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_mtx_init(erts_smp_mtx_t *mtx, char *name) +{ +#ifdef ERTS_SMP + erts_mtx_init(mtx, name); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_mtx_init_locked(erts_smp_mtx_t *mtx, char *name) +{ +#ifdef ERTS_SMP + erts_mtx_init_locked(mtx, name); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_mtx_destroy(erts_smp_mtx_t *mtx) +{ +#ifdef ERTS_SMP + erts_mtx_destroy(mtx); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_mtx_set_forksafe(erts_smp_mtx_t *mtx) +{ +#ifdef ERTS_SMP + erts_mtx_set_forksafe(mtx); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_mtx_unset_forksafe(erts_smp_mtx_t *mtx) +{ +#ifdef ERTS_SMP + erts_mtx_unset_forksafe(mtx); +#endif +} + +ERTS_GLB_INLINE int +erts_smp_mtx_trylock(erts_smp_mtx_t *mtx) +{ +#ifdef ERTS_SMP + return erts_mtx_trylock(mtx); +#else + return 0; +#endif + +} + + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_smp_mtx_lock_x(erts_smp_mtx_t *mtx, char *file, int line) +#else +erts_smp_mtx_lock(erts_smp_mtx_t *mtx) +#endif +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) + erts_mtx_lock_x(mtx, file, line); +#elif defined(ERTS_SMP) + erts_mtx_lock(mtx); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_mtx_unlock(erts_smp_mtx_t *mtx) +{ +#ifdef ERTS_SMP + erts_mtx_unlock(mtx); +#endif +} + +ERTS_GLB_INLINE int +erts_smp_lc_mtx_is_locked(erts_smp_mtx_t *mtx) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + return erts_lc_mtx_is_locked(mtx); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_cnd_init(erts_smp_cnd_t *cnd) +{ +#ifdef ERTS_SMP + erts_cnd_init(cnd); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_cnd_destroy(erts_smp_cnd_t *cnd) +{ +#ifdef ERTS_SMP + erts_cnd_destroy(cnd); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_cnd_wait(erts_smp_cnd_t *cnd, erts_smp_mtx_t *mtx) +{ +#ifdef ERTS_SMP + erts_cnd_wait(cnd, mtx); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_cnd_signal(erts_smp_cnd_t *cnd) +{ +#ifdef ERTS_SMP + erts_cnd_signal(cnd); +#endif +} + + +ERTS_GLB_INLINE void +erts_smp_cnd_broadcast(erts_smp_cnd_t *cnd) +{ +#ifdef ERTS_SMP + erts_cnd_broadcast(cnd); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_rwmtx_init_x(erts_smp_rwmtx_t *rwmtx, char *name, Eterm extra) +{ +#ifdef ERTS_SMP + erts_rwmtx_init_x(rwmtx, name, extra); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_rwmtx_init(erts_smp_rwmtx_t *rwmtx, char *name) +{ +#ifdef ERTS_SMP + erts_rwmtx_init(rwmtx, name); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_rwmtx_destroy(erts_smp_rwmtx_t *rwmtx) +{ +#ifdef ERTS_SMP + erts_rwmtx_destroy(rwmtx); +#endif +} + +ERTS_GLB_INLINE int +erts_smp_rwmtx_tryrlock(erts_smp_rwmtx_t *rwmtx) +{ +#ifdef ERTS_SMP + return erts_rwmtx_tryrlock(rwmtx); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_smp_rwmtx_rlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line) +#else +erts_smp_rwmtx_rlock(erts_smp_rwmtx_t *rwmtx) +#endif +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) + erts_rwmtx_rlock_x(rwmtx, file, line); +#elif defined(ERTS_SMP) + erts_rwmtx_rlock(rwmtx); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_rwmtx_runlock(erts_smp_rwmtx_t *rwmtx) +{ +#ifdef ERTS_SMP + erts_rwmtx_runlock(rwmtx); +#endif +} + + +ERTS_GLB_INLINE int +erts_smp_rwmtx_tryrwlock(erts_smp_rwmtx_t *rwmtx) +{ +#ifdef ERTS_SMP + return erts_rwmtx_tryrwlock(rwmtx); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_smp_rwmtx_rwlock_x(erts_smp_rwmtx_t *rwmtx, char *file, unsigned int line) +#else +erts_smp_rwmtx_rwlock(erts_smp_rwmtx_t *rwmtx) +#endif +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) + erts_rwmtx_rwlock_x(rwmtx, file, line); +#elif defined(ERTS_SMP) + erts_rwmtx_rwlock(rwmtx); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_rwmtx_rwunlock(erts_smp_rwmtx_t *rwmtx) +{ +#ifdef ERTS_SMP + erts_rwmtx_rwunlock(rwmtx); +#endif +} + +#if 0 /* The following rwmtx function names are + reserved for potential future use. */ + +/* Try upgrade from r-locked state to rw-locked state */ +ERTS_GLB_INLINE int +erts_smp_rwmtx_trywlock(erts_smp_rwmtx_t *rwmtx) +{ + return 0; +} + +/* Upgrade from r-locked state to rw-locked state */ +ERTS_GLB_INLINE void +erts_smp_rwmtx_wlock(erts_smp_rwmtx_t *rwmtx) +{ + +} + +/* Downgrade from rw-locked state to r-locked state */ +ERTS_GLB_INLINE void +erts_smp_rwmtx_wunlock(erts_smp_rwmtx_t *rwmtx) +{ + +} + +#endif + +ERTS_GLB_INLINE int +erts_smp_lc_rwmtx_is_rlocked(erts_smp_rwmtx_t *mtx) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + return erts_lc_rwmtx_is_rlocked(mtx); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE int +erts_smp_lc_rwmtx_is_rwlocked(erts_smp_rwmtx_t *mtx) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + return erts_lc_rwmtx_is_rwlocked(mtx); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_atomic_init(erts_smp_atomic_t *var, long i) +{ +#ifdef ERTS_SMP + erts_atomic_init(var, i); +#else + *var = i; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_atomic_set(erts_smp_atomic_t *var, long i) +{ +#ifdef ERTS_SMP + erts_atomic_set(var, i); +#else + *var = i; +#endif +} + +ERTS_GLB_INLINE long +erts_smp_atomic_read(erts_smp_atomic_t *var) +{ +#ifdef ERTS_SMP + return erts_atomic_read(var); +#else + return *var; +#endif +} + +ERTS_GLB_INLINE long +erts_smp_atomic_inctest(erts_smp_atomic_t *incp) +{ +#ifdef ERTS_SMP + return erts_atomic_inctest(incp); +#else + return ++(*incp); +#endif +} + +ERTS_GLB_INLINE long +erts_smp_atomic_dectest(erts_smp_atomic_t *decp) +{ +#ifdef ERTS_SMP + return erts_atomic_dectest(decp); +#else + return --(*decp); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_atomic_inc(erts_smp_atomic_t *incp) +{ +#ifdef ERTS_SMP + erts_atomic_inc(incp); +#else + ++(*incp); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_atomic_dec(erts_smp_atomic_t *decp) +{ +#ifdef ERTS_SMP + erts_atomic_dec(decp); +#else + --(*decp); +#endif +} + +ERTS_GLB_INLINE long +erts_smp_atomic_addtest(erts_smp_atomic_t *addp, long i) +{ +#ifdef ERTS_SMP + return erts_atomic_addtest(addp, i); +#else + return *addp += i; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_atomic_add(erts_smp_atomic_t *addp, long i) +{ +#ifdef ERTS_SMP + erts_atomic_add(addp, i); +#else + *addp += i; +#endif +} + +ERTS_GLB_INLINE long +erts_smp_atomic_xchg(erts_smp_atomic_t *xchgp, long new) +{ +#ifdef ERTS_SMP + return erts_atomic_xchg(xchgp, new); +#else + long old; + old = *xchgp; + *xchgp = new; + return old; +#endif +} + +ERTS_GLB_INLINE long +erts_smp_atomic_cmpxchg(erts_smp_atomic_t *xchgp, long new, long expected) +{ +#ifdef ERTS_SMP + return erts_atomic_cmpxchg(xchgp, new, expected); +#else + long old = *xchgp; + if (old == expected) + *xchgp = new; + return old; +#endif +} + +ERTS_GLB_INLINE long +erts_smp_atomic_bor(erts_smp_atomic_t *var, long mask) +{ +#ifdef ERTS_SMP + return erts_atomic_bor(var, mask); +#else + long old; + old = *var; + *var |= mask; + return old; +#endif +} + +ERTS_GLB_INLINE long +erts_smp_atomic_band(erts_smp_atomic_t *var, long mask) +{ +#ifdef ERTS_SMP + return erts_atomic_band(var, mask); +#else + long old; + old = *var; + *var &= mask; + return old; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_spinlock_init_x(erts_smp_spinlock_t *lock, char *name, Eterm extra) +{ +#ifdef ERTS_SMP + erts_spinlock_init_x(lock, name, extra); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_spinlock_init(erts_smp_spinlock_t *lock, char *name) +{ +#ifdef ERTS_SMP + erts_spinlock_init(lock, name); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_spinlock_destroy(erts_smp_spinlock_t *lock) +{ +#ifdef ERTS_SMP + erts_spinlock_destroy(lock); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_spin_unlock(erts_smp_spinlock_t *lock) +{ +#ifdef ERTS_SMP + erts_spin_unlock(lock); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_smp_spin_lock_x(erts_smp_spinlock_t *lock, char *file, unsigned int line) +#else +erts_smp_spin_lock(erts_smp_spinlock_t *lock) +#endif +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) + erts_spin_lock_x(lock, file, line); +#elif defined(ERTS_SMP) + erts_spin_lock(lock); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE int +erts_smp_lc_spinlock_is_locked(erts_smp_spinlock_t *lock) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + return erts_lc_spinlock_is_locked(lock); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_rwlock_init_x(erts_smp_rwlock_t *lock, char *name, Eterm extra) +{ +#ifdef ERTS_SMP + erts_rwlock_init_x(lock, name, extra); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_rwlock_init(erts_smp_rwlock_t *lock, char *name) +{ +#ifdef ERTS_SMP + erts_rwlock_init(lock, name); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_rwlock_destroy(erts_smp_rwlock_t *lock) +{ +#ifdef ERTS_SMP + erts_rwlock_destroy(lock); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_read_unlock(erts_smp_rwlock_t *lock) +{ +#ifdef ERTS_SMP + erts_read_unlock(lock); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_smp_read_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line) +#else +erts_smp_read_lock(erts_smp_rwlock_t *lock) +#endif +{ +#if defined(ERTS_ENABLE_LOCK_COUNT) && defined(ERTS_SMP) + erts_read_lock_x(lock, file, line); +#elif defined(ERTS_SMP) + erts_read_lock(lock); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_write_unlock(erts_smp_rwlock_t *lock) +{ +#ifdef ERTS_SMP + erts_write_unlock(lock); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_smp_write_lock_x(erts_smp_rwlock_t *lock, char *file, unsigned int line) +#else +erts_smp_write_lock(erts_smp_rwlock_t *lock) +#endif +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_COUNT) + erts_write_lock_x(lock, file, line); +#elif defined(ERTS_SMP) + erts_write_lock(lock); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE int +erts_smp_lc_rwlock_is_rlocked(erts_smp_rwlock_t *lock) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + return erts_lc_rwlock_is_rlocked(lock); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE int +erts_smp_lc_rwlock_is_rwlocked(erts_smp_rwlock_t *lock) +{ +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) + return erts_lc_rwlock_is_rwlocked(lock); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_thr_time_now(erts_smp_thr_timeval_t *time) +{ +#ifdef ERTS_SMP + erts_thr_time_now(time); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_tsd_key_create(erts_smp_tsd_key_t *keyp) +{ +#ifdef ERTS_SMP + erts_tsd_key_create(keyp); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_tsd_key_delete(erts_smp_tsd_key_t key) +{ +#ifdef ERTS_SMP + erts_tsd_key_delete(key); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_tsd_set(erts_smp_tsd_key_t key, void *value) +{ +#ifdef ERTS_SMP + erts_tsd_set(key, value); +#endif +} + +ERTS_GLB_INLINE void * +erts_smp_tsd_get(erts_smp_tsd_key_t key) +{ +#ifdef ERTS_SMP + return erts_tsd_get(key); +#else + return NULL; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_gate_init(erts_smp_gate_t *gp) +{ +#ifdef ERTS_SMP + erts_gate_init((erts_gate_t *) gp); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_gate_destroy(erts_smp_gate_t *gp) +{ +#ifdef ERTS_SMP + erts_gate_destroy((erts_gate_t *) gp); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_gate_close(erts_smp_gate_t *gp) +{ +#ifdef ERTS_SMP + erts_gate_close((erts_gate_t *) gp); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_gate_let_through(erts_smp_gate_t *gp, unsigned no) +{ +#ifdef ERTS_SMP + erts_gate_let_through((erts_gate_t *) gp, no); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_gate_wait(erts_smp_gate_t *gp) +{ +#ifdef ERTS_SMP + erts_gate_wait((erts_gate_t *) gp); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_gate_swait(erts_smp_gate_t *gp, int spincount) +{ +#ifdef ERTS_SMP + erts_gate_swait((erts_gate_t *) gp, spincount); +#endif +} + +#ifdef ERTS_THR_HAVE_SIG_FUNCS +#define ERTS_SMP_THR_HAVE_SIG_FUNCS 1 + +ERTS_GLB_INLINE void +erts_smp_thr_sigmask(int how, const sigset_t *set, sigset_t *oset) +{ +#ifdef ERTS_SMP + erts_thr_sigmask(how, set, oset); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_thr_sigwait(const sigset_t *set, int *sig) +{ +#ifdef ERTS_SMP + erts_thr_sigwait(set, sig); +#endif +} + +#endif /* #ifdef ERTS_THR_HAVE_SIG_FUNCS */ + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* ERL_SMP_H */ diff --git a/erts/emulator/beam/erl_sock.h b/erts/emulator/beam/erl_sock.h new file mode 100644 index 0000000000..7ae6116dc5 --- /dev/null +++ b/erts/emulator/beam/erl_sock.h @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * A *very* limited socket interface exported by inet_drv.c. + * Used by the erl_mtrace.c. + */ + +#ifndef ERL_SOCK_H_ +#define ERL_SOCK_H_ + +#ifdef __WIN32__ +#include +typedef SOCKET erts_sock_t; +#else +typedef int erts_sock_t; +#endif + +#define ERTS_SOCK_INVALID_SOCKET -1 + +erts_sock_t erts_sock_open(void); +void erts_sock_close(erts_sock_t); +int erts_sock_connect(erts_sock_t, byte *, int, Uint16); +Sint erts_sock_send(erts_sock_t, const void *, Sint); +int erts_sock_gethostname(char *, int); +int erts_sock_errno(void); + +#endif diff --git a/erts/emulator/beam/erl_sys_driver.h b/erts/emulator/beam/erl_sys_driver.h new file mode 100644 index 0000000000..d429d0ce96 --- /dev/null +++ b/erts/emulator/beam/erl_sys_driver.h @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Include file for erlang driver writers. + */ + +#ifndef __ERL_SYS_DRIVER_H__ +#define __ERL_SYS_DRIVER_H__ + +#ifdef __ERL_DRIVER_H__ +#error erl_sys_driver.h cannot be included after erl_driver.h +#endif + +#define ERL_SYS_DRV + +typedef long ErlDrvEvent; /* An event to be selected on. */ +typedef long ErlDrvPort; /* A port descriptor. */ + +/* typedef struct _SysDriverOpts SysDriverOpts; defined in sys.h */ + +#include "erl_driver.h" + +#endif + + + + diff --git a/erts/emulator/beam/erl_term.c b/erts/emulator/beam/erl_term.c new file mode 100644 index 0000000000..2924abbd51 --- /dev/null +++ b/erts/emulator/beam/erl_term.c @@ -0,0 +1,174 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#if HAVE_CONFIG_H +#include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include +#include + +__decl_noreturn static void __noreturn +et_abort(const char *expr, const char *file, unsigned line) +{ +#ifdef EXIT_ON_ET_ABORT + static int have_been_called = 0; + + if (have_been_called) { + abort(); + } else { + /* + * Prevent infinite loop. + */ + have_been_called = 1; + erl_exit(1, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr); + } +#else + erts_fprintf(stderr, "TYPE ASSERTION FAILED, file %s, line %u: %s\n", file, line, expr); + abort(); +#endif +} + +#if ET_DEBUG +#define ET_ASSERT(expr,file,line) \ +do { \ + if (!(expr)) \ + et_abort(#expr, file, line); \ +} while(0) +#else +#define ET_ASSERT(expr,file,line) do { } while(0) +#endif + +#if ET_DEBUG +unsigned tag_val_def_debug(Eterm x, const char *file, unsigned line) +#else +unsigned tag_val_def(Eterm x) +#define file __FILE__ +#define line __LINE__ +#endif +{ + static char msg[32]; + + switch (x & _TAG_PRIMARY_MASK) { + case TAG_PRIMARY_LIST: return LIST_DEF; + case TAG_PRIMARY_BOXED: { + Eterm hdr = *boxed_val(x); + ET_ASSERT(is_header(hdr),file,line); + switch ((hdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): return TUPLE_DEF; + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): return BIG_DEF; + case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): return REF_DEF; + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): return FLOAT_DEF; + case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): return EXPORT_DEF; + case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): return FUN_DEF; + case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): return EXTERNAL_PID_DEF; + case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): return EXTERNAL_PORT_DEF; + case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): return EXTERNAL_REF_DEF; + default: return BINARY_DEF; + } + break; + } + case TAG_PRIMARY_IMMED1: { + switch ((x & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE): return PID_DEF; + case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE): return PORT_DEF; + case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): { + switch ((x & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) { + case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE): return ATOM_DEF; + case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE): return NIL_DEF; + } + break; + } + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): return SMALL_DEF; + } + break; + } + } + sprintf(msg, "tag_val_def: %#lx", x); + et_abort(msg, file, line); +#undef file +#undef line +} + +/* + * XXX: define NUMBER_CODE() here when new representation is used + */ + +#if ET_DEBUG +#define ET_DEFINE_CHECKED(FUNTY,FUN,ARGTY,PRECOND) \ +FUNTY checked_##FUN(ARGTY x, const char *file, unsigned line) \ +{ \ + ET_ASSERT(PRECOND(x),file,line); \ + return _unchecked_##FUN(x); \ +} + +ET_DEFINE_CHECKED(Eterm,make_boxed,Eterm*,_is_aligned); +ET_DEFINE_CHECKED(int,is_boxed,Eterm,!is_header); +ET_DEFINE_CHECKED(Eterm*,boxed_val,Eterm,is_boxed); +ET_DEFINE_CHECKED(Eterm,make_list,Eterm*,_is_aligned); +ET_DEFINE_CHECKED(int,is_not_list,Eterm,!is_header); +ET_DEFINE_CHECKED(Eterm*,list_val,Eterm,is_list); +ET_DEFINE_CHECKED(Uint,unsigned_val,Eterm,is_small); +ET_DEFINE_CHECKED(Sint,signed_val,Eterm,is_small); +ET_DEFINE_CHECKED(Uint,atom_val,Eterm,is_atom); +ET_DEFINE_CHECKED(Uint,header_arity,Eterm,is_header); +ET_DEFINE_CHECKED(Uint,arityval,Eterm,is_arity_value); +ET_DEFINE_CHECKED(Uint,thing_arityval,Eterm,is_thing); +ET_DEFINE_CHECKED(Uint,thing_subtag,Eterm,is_thing); +ET_DEFINE_CHECKED(Eterm*,binary_val,Eterm,is_binary); +ET_DEFINE_CHECKED(Eterm*,fun_val,Eterm,is_fun); +ET_DEFINE_CHECKED(int,bignum_header_is_neg,Eterm,_is_bignum_header); +ET_DEFINE_CHECKED(Eterm,bignum_header_neg,Eterm,_is_bignum_header); +ET_DEFINE_CHECKED(Uint,bignum_header_arity,Eterm,_is_bignum_header); +ET_DEFINE_CHECKED(Eterm*,big_val,Eterm,is_big); +ET_DEFINE_CHECKED(Eterm*,float_val,Eterm,is_float); +ET_DEFINE_CHECKED(Eterm*,tuple_val,Eterm,is_tuple); +ET_DEFINE_CHECKED(Uint,internal_pid_data,Eterm,is_internal_pid); +ET_DEFINE_CHECKED(struct erl_node_*,internal_pid_node,Eterm,is_internal_pid); +ET_DEFINE_CHECKED(Uint,internal_port_data,Eterm,is_internal_port); +ET_DEFINE_CHECKED(struct erl_node_*,internal_port_node,Eterm,is_internal_port); +ET_DEFINE_CHECKED(Eterm*,internal_ref_val,Eterm,is_internal_ref); +ET_DEFINE_CHECKED(Uint,internal_ref_data_words,Eterm,is_internal_ref); +ET_DEFINE_CHECKED(Uint32*,internal_ref_data,Eterm,is_internal_ref); +ET_DEFINE_CHECKED(struct erl_node_*,internal_ref_node,Eterm,is_internal_ref); +ET_DEFINE_CHECKED(Eterm*,external_val,Eterm,is_external); +ET_DEFINE_CHECKED(Uint,external_data_words,Eterm,is_external); +ET_DEFINE_CHECKED(Uint,external_pid_data_words,Eterm,is_external_pid); +ET_DEFINE_CHECKED(Uint,external_pid_data,Eterm,is_external_pid); +ET_DEFINE_CHECKED(struct erl_node_*,external_pid_node,Eterm,is_external_pid); +ET_DEFINE_CHECKED(Uint,external_port_data_words,Eterm,is_external_port); +ET_DEFINE_CHECKED(Uint,external_port_data,Eterm,is_external_port); +ET_DEFINE_CHECKED(struct erl_node_*,external_port_node,Eterm,is_external_port); +ET_DEFINE_CHECKED(Uint,external_ref_data_words,Eterm,is_external_ref); +ET_DEFINE_CHECKED(Uint32*,external_ref_data,Eterm,is_external_ref); +ET_DEFINE_CHECKED(struct erl_node_*,external_ref_node,Eterm,is_external_ref); +ET_DEFINE_CHECKED(Eterm*,export_val,Eterm,is_export); + +ET_DEFINE_CHECKED(Eterm,make_cp,Uint*,_is_aligned); +ET_DEFINE_CHECKED(Uint*,cp_val,Eterm,is_CP); +ET_DEFINE_CHECKED(Uint,catch_val,Eterm,is_catch); +ET_DEFINE_CHECKED(Uint,x_reg_offset,Uint,_is_xreg); +ET_DEFINE_CHECKED(Uint,y_reg_offset,Uint,_is_yreg); +ET_DEFINE_CHECKED(Uint,x_reg_index,Uint,_is_xreg); +ET_DEFINE_CHECKED(Uint,y_reg_index,Uint,_is_yreg); + +#endif /* ET_DEBUG */ diff --git a/erts/emulator/beam/erl_term.h b/erts/emulator/beam/erl_term.h new file mode 100644 index 0000000000..b0a57a3ebe --- /dev/null +++ b/erts/emulator/beam/erl_term.h @@ -0,0 +1,1056 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERL_TERM_H +#define __ERL_TERM_H + +struct erl_node_; /* Declared in erl_node_tables.h */ + +/* + * Defining ET_DEBUG to 1 causes all type-specific data access + * macros to perform runtime type checking. This is very useful + * during development but reduces performance, so ET_DEBUG should + * be disabled during benchmarking or release. + */ +/* #define ET_DEBUG 1 */ +#ifndef ET_DEBUG +# ifdef DEBUG +# define ET_DEBUG 1 +# else +# define ET_DEBUG 0 +# endif +#endif + +#if ET_DEBUG +#define _ET_DECLARE_CHECKED(TF,F,TX) extern TF checked_##F(TX,const char*,unsigned) +#define _ET_APPLY(F,X) checked_##F(X,__FILE__,__LINE__) +#else +#define _ET_DECLARE_CHECKED(TF,F,TX) +#define _ET_APPLY(F,X) _unchecked_##F(X) +#endif + +#define _TAG_PRIMARY_SIZE 2 +#define _TAG_PRIMARY_MASK 0x3 +#define TAG_PRIMARY_HEADER 0x0 +#define TAG_PRIMARY_LIST 0x1 +#define TAG_PRIMARY_BOXED 0x2 +#define TAG_PRIMARY_IMMED1 0x3 + +#define primary_tag(x) ((x) & _TAG_PRIMARY_MASK) + +#define _TAG_IMMED1_SIZE 4 +#define _TAG_IMMED1_MASK 0xF +#define _TAG_IMMED1_PID ((0x0 << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_IMMED1) +#define _TAG_IMMED1_PORT ((0x1 << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_IMMED1) +#define _TAG_IMMED1_IMMED2 ((0x2 << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_IMMED1) +#define _TAG_IMMED1_SMALL ((0x3 << _TAG_PRIMARY_SIZE) | TAG_PRIMARY_IMMED1) + +#define _TAG_IMMED2_SIZE 6 +#define _TAG_IMMED2_MASK 0x3F +#define _TAG_IMMED2_ATOM ((0x0 << _TAG_IMMED1_SIZE) | _TAG_IMMED1_IMMED2) +#define _TAG_IMMED2_CATCH ((0x1 << _TAG_IMMED1_SIZE) | _TAG_IMMED1_IMMED2) +#define _TAG_IMMED2_NIL ((0x3 << _TAG_IMMED1_SIZE) | _TAG_IMMED1_IMMED2) + +/* + * HEADER representation: + * + * aaaaaaaaaaaaaaaaaaaaaaaaaatttt00 arity:26, tag:4 + * + * HEADER tags: + * + * 0000 ARITYVAL + * 0001 BINARY_AGGREGATE | + * 001x BIGNUM with sign bit | + * 0100 REF | + * 0101 FUN | THINGS + * 0110 FLONUM | + * 0111 EXPORT | + * 1000 REFC_BINARY | | + * 1001 HEAP_BINARY | BINARIES | + * 1010 SUB_BINARY | | + * 1011 Not used + * 1100 EXTERNAL_PID | | + * 1101 EXTERNAL_PORT | EXTERNAL THINGS | + * 1110 EXTERNAL_REF | | + * 1111 Not used + * + * COMMENTS: + * + * - The tag is zero for arityval and non-zero for thing headers. + * - A single bit differentiates between positive and negative bignums. + * - If more tags are needed, the REF and and EXTERNAL_REF tags could probably + * be combined to one tag. + * + * XXX: globally replace XXX_SUBTAG with TAG_HEADER_XXX + */ +#define ARITYVAL_SUBTAG (0x0 << _TAG_PRIMARY_SIZE) /* TUPLE */ +#define BIN_MATCHSTATE_SUBTAG (0x1 << _TAG_PRIMARY_SIZE) +#define POS_BIG_SUBTAG (0x2 << _TAG_PRIMARY_SIZE) /* BIG: tags 2&3 */ +#define NEG_BIG_SUBTAG (0x3 << _TAG_PRIMARY_SIZE) /* BIG: tags 2&3 */ +#define _BIG_SIGN_BIT (0x1 << _TAG_PRIMARY_SIZE) +#define REF_SUBTAG (0x4 << _TAG_PRIMARY_SIZE) /* REF */ +#define FUN_SUBTAG (0x5 << _TAG_PRIMARY_SIZE) /* FUN */ +#define FLOAT_SUBTAG (0x6 << _TAG_PRIMARY_SIZE) /* FLOAT */ +#define EXPORT_SUBTAG (0x7 << _TAG_PRIMARY_SIZE) /* FLOAT */ +#define _BINARY_XXX_MASK (0x3 << _TAG_PRIMARY_SIZE) +#define REFC_BINARY_SUBTAG (0x8 << _TAG_PRIMARY_SIZE) /* BINARY */ +#define HEAP_BINARY_SUBTAG (0x9 << _TAG_PRIMARY_SIZE) /* BINARY */ +#define SUB_BINARY_SUBTAG (0xA << _TAG_PRIMARY_SIZE) /* BINARY */ +#define EXTERNAL_PID_SUBTAG (0xC << _TAG_PRIMARY_SIZE) /* EXTERNAL_PID */ +#define EXTERNAL_PORT_SUBTAG (0xD << _TAG_PRIMARY_SIZE) /* EXTERNAL_PORT */ +#define EXTERNAL_REF_SUBTAG (0xE << _TAG_PRIMARY_SIZE) /* EXTERNAL_REF */ + + +#define _TAG_HEADER_ARITYVAL (TAG_PRIMARY_HEADER|ARITYVAL_SUBTAG) +#define _TAG_HEADER_FUN (TAG_PRIMARY_HEADER|FUN_SUBTAG) +#define _TAG_HEADER_POS_BIG (TAG_PRIMARY_HEADER|POS_BIG_SUBTAG) +#define _TAG_HEADER_NEG_BIG (TAG_PRIMARY_HEADER|NEG_BIG_SUBTAG) +#define _TAG_HEADER_FLOAT (TAG_PRIMARY_HEADER|FLOAT_SUBTAG) +#define _TAG_HEADER_EXPORT (TAG_PRIMARY_HEADER|EXPORT_SUBTAG) +#define _TAG_HEADER_REF (TAG_PRIMARY_HEADER|REF_SUBTAG) +#define _TAG_HEADER_REFC_BIN (TAG_PRIMARY_HEADER|REFC_BINARY_SUBTAG) +#define _TAG_HEADER_HEAP_BIN (TAG_PRIMARY_HEADER|HEAP_BINARY_SUBTAG) +#define _TAG_HEADER_SUB_BIN (TAG_PRIMARY_HEADER|SUB_BINARY_SUBTAG) +#define _TAG_HEADER_EXTERNAL_PID (TAG_PRIMARY_HEADER|EXTERNAL_PID_SUBTAG) +#define _TAG_HEADER_EXTERNAL_PORT (TAG_PRIMARY_HEADER|EXTERNAL_PORT_SUBTAG) +#define _TAG_HEADER_EXTERNAL_REF (TAG_PRIMARY_HEADER|EXTERNAL_REF_SUBTAG) +#define _TAG_HEADER_BIN_MATCHSTATE (TAG_PRIMARY_HEADER|BIN_MATCHSTATE_SUBTAG) + + +#define _TAG_HEADER_MASK 0x3F +#define _HEADER_SUBTAG_MASK 0x3C /* 4 bits for subtag */ +#define _HEADER_ARITY_OFFS 6 + +#define header_is_transparent(x) \ + (((x) & (_HEADER_SUBTAG_MASK)) == ARITYVAL_SUBTAG) +#define header_is_arityval(x) (((x) & _HEADER_SUBTAG_MASK) == ARITYVAL_SUBTAG) +#define header_is_thing(x) (!header_is_transparent((x))) +#define header_is_bin_matchstate(x) ((((x) & (_HEADER_SUBTAG_MASK)) == BIN_MATCHSTATE_SUBTAG)) + +#define _CPMASK 0x3 + +/* immediate object access methods */ +#define is_immed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_IMMED1) +#define is_not_immed(x) (!is_immed((x))) +#define IS_CONST(x) is_immed((x)) +#if TAG_PRIMARY_IMMED1 == _TAG_PRIMARY_MASK +#define is_both_immed(x,y) is_immed(((x)&(y))) +#else +#define is_both_immed(x,y) (is_immed((x)) && is_immed((y))) +#endif +#define is_not_both_immed(x,y) (!is_both_immed((x),(y))) + + +/* boxed object access methods */ +#define _is_aligned(x) (((Uint)(x) & 0x3) == 0) +#define _unchecked_make_boxed(x) ((Uint)(x) + TAG_PRIMARY_BOXED) +_ET_DECLARE_CHECKED(Eterm,make_boxed,Eterm*); +#define make_boxed(x) _ET_APPLY(make_boxed,(x)) +#if 1 +#define _is_not_boxed(x) ((x) & (_TAG_PRIMARY_MASK-TAG_PRIMARY_BOXED)) +#define _unchecked_is_boxed(x) (!_is_not_boxed((x))) +_ET_DECLARE_CHECKED(int,is_boxed,Eterm); +#define is_boxed(x) _ET_APPLY(is_boxed,(x)) +#else +#define is_boxed(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_BOXED) +#endif +#define _unchecked_boxed_val(x) ((Eterm*)((x) - TAG_PRIMARY_BOXED)) +_ET_DECLARE_CHECKED(Eterm*,boxed_val,Eterm); +#define boxed_val(x) _ET_APPLY(boxed_val,(x)) + +/* cons cell ("list") access methods */ +#define _unchecked_make_list(x) ((Uint)(x) + TAG_PRIMARY_LIST) +_ET_DECLARE_CHECKED(Eterm,make_list,Eterm*); +#define make_list(x) _ET_APPLY(make_list,(x)) +#if 1 +#define _unchecked_is_not_list(x) ((x) & (_TAG_PRIMARY_MASK-TAG_PRIMARY_LIST)) +_ET_DECLARE_CHECKED(int,is_not_list,Eterm); +#define is_not_list(x) _ET_APPLY(is_not_list,(x)) +#define is_list(x) (!is_not_list((x))) +#else +#define is_list(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_LIST) +#define is_not_list(x) (!is_list((x))) +#endif +#define _unchecked_list_val(x) ((Eterm*)((x) - TAG_PRIMARY_LIST)) +_ET_DECLARE_CHECKED(Eterm*,list_val,Eterm); +#define list_val(x) _ET_APPLY(list_val,(x)) + +#define CONS(hp, car, cdr) \ + (CAR(hp)=(car), CDR(hp)=(cdr), make_list(hp)) + +#define CAR(x) ((x)[0]) +#define CDR(x) ((x)[1]) + +/* generic tagged pointer (boxed or list) access methods */ +#define _unchecked_ptr_val(x) ((Eterm*)((x) & ~((Uint) 0x3))) +#define ptr_val(x) _unchecked_ptr_val((x)) /*XXX*/ +#define _unchecked_offset_ptr(x,offs) ((x)+((offs)*sizeof(Eterm))) +#define offset_ptr(x,offs) _unchecked_offset_ptr(x,offs) /*XXX*/ + +/* fixnum ("small") access methods */ +#if defined(ARCH_64) +#define SMALL_BITS (64-4) +#define SMALL_DIGITS (17) +#else +#define SMALL_BITS (28) +#define SMALL_DIGITS (8) +#endif +#define MAX_SMALL ((1L << (SMALL_BITS-1))-1) +#define MIN_SMALL (-(1L << (SMALL_BITS-1))) +#define make_small(x) (((Uint)(x) << _TAG_IMMED1_SIZE) + _TAG_IMMED1_SMALL) +#define is_small(x) (((x) & _TAG_IMMED1_MASK) == _TAG_IMMED1_SMALL) +#define is_not_small(x) (!is_small((x))) +#define is_byte(x) (((x) & ((~(Uint)0 << (_TAG_IMMED1_SIZE+8)) + _TAG_IMMED1_MASK)) == _TAG_IMMED1_SMALL) +#define is_valid_bit_size(x) (((Sint)(x)) >= 0 && ((x) & 0x7F) == _TAG_IMMED1_SMALL) +#define is_not_valid_bit_size(x) (!is_valid_bit_size((x))) +#define MY_IS_SSMALL(x) (((Uint) (((x) >> (SMALL_BITS-1)) + 1)) < 2) +#define _unchecked_unsigned_val(x) ((x) >> _TAG_IMMED1_SIZE) +_ET_DECLARE_CHECKED(Uint,unsigned_val,Eterm); +#define unsigned_val(x) _ET_APPLY(unsigned_val,(x)) +#define _unchecked_signed_val(x) ((Sint)(x) >> _TAG_IMMED1_SIZE) +_ET_DECLARE_CHECKED(Sint,signed_val,Eterm); +#define signed_val(x) _ET_APPLY(signed_val,(x)) + +#if _TAG_IMMED1_SMALL == 0x0F +#define is_both_small(x,y) (((x) & (y) & _TAG_IMMED1_MASK) == _TAG_IMMED1_SMALL) +#elif _TAG_IMMED1_SMALL == 0x00 +#define is_both_small(x,y) ((((x)|(y)) & _TAG_IMMED1_MASK) == _TAG_IMMED1_SMALL) +#else +#define is_both_small(x,y) (is_small(x) && is_small(y)) +#endif + +/* NIL access methods */ +#define NIL ((~((Uint) 0) << _TAG_IMMED2_SIZE) | _TAG_IMMED2_NIL) +#define is_nil(x) ((x) == NIL) +#define is_not_nil(x) ((x) != NIL) + +#define MAX_ATOM_INDEX (~(~((Uint) 0) << (sizeof(Uint)*8 - _TAG_IMMED2_SIZE))) + +/* atom access methods */ +#define make_atom(x) ((Eterm)(((x) << _TAG_IMMED2_SIZE) + _TAG_IMMED2_ATOM)) +#define is_atom(x) (((x) & _TAG_IMMED2_MASK) == _TAG_IMMED2_ATOM) +#define is_not_atom(x) (!is_atom(x)) +#define _unchecked_atom_val(x) ((x) >> _TAG_IMMED2_SIZE) +_ET_DECLARE_CHECKED(Uint,atom_val,Eterm); +#define atom_val(x) _ET_APPLY(atom_val,(x)) + +/* header (arityval or thing) access methods */ +#define _make_header(sz,tag) ((Uint)(((sz) << _HEADER_ARITY_OFFS) + (tag))) +#define is_header(x) (((x) & _TAG_PRIMARY_MASK) == TAG_PRIMARY_HEADER) +#define _unchecked_header_arity(x) ((x) >> _HEADER_ARITY_OFFS) +_ET_DECLARE_CHECKED(Uint,header_arity,Eterm); +#define header_arity(x) _ET_APPLY(header_arity,(x)) + +/* arityval access methods */ +#define make_arityval(sz) _make_header((sz),_TAG_HEADER_ARITYVAL) +#define is_arity_value(x) (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_ARITYVAL) +#define is_not_arity_value(x) (!is_arity_value((x))) +#define _unchecked_arityval(x) _unchecked_header_arity((x)) +_ET_DECLARE_CHECKED(Uint,arityval,Eterm); +#define arityval(x) _ET_APPLY(arityval,(x)) + +/* thing access methods */ +#define is_thing(x) (is_header((x)) && header_is_thing((x))) +#define _unchecked_thing_arityval(x) _unchecked_header_arity((x)) +_ET_DECLARE_CHECKED(Uint,thing_arityval,Eterm); +#define thing_arityval(x) _ET_APPLY(thing_arityval,(x)) +#define _unchecked_thing_subtag(x) ((x) & _HEADER_SUBTAG_MASK) +_ET_DECLARE_CHECKED(Uint,thing_subtag,Eterm); +#define thing_subtag(x) _ET_APPLY(thing_subtag,(x)) + +/* + * Magic non-value object. + * Used as function return error and "absent value" indicator + * in the original runtime system. The new runtime system also + * uses it as forwarding marker for CONS cells. + * + * This value is 0 in the original runtime system, which unfortunately + * promotes sloppy programming practices. It also prevents some useful + * tag assignment schemes, e.g. using a 2-bit tag 00 for FIXNUM. + * + * To help find code which makes unwarranted assumptions about zero, + * we now use a non-zero bit-pattern in debug mode. + */ +#if ET_DEBUG +#define THE_NON_VALUE _make_header(0,_TAG_HEADER_FLOAT) +#else +#define THE_NON_VALUE (0) +#endif +#define is_non_value(x) ((x) == THE_NON_VALUE) +#define is_value(x) ((x) != THE_NON_VALUE) + +/* binary object access methods */ +#define is_binary_header(x) (((x) & (_TAG_HEADER_MASK-_BINARY_XXX_MASK)) == _TAG_HEADER_REFC_BIN) +#define make_binary(x) make_boxed((Eterm*)(x)) +#define is_binary(x) (is_boxed((x)) && is_binary_header(*boxed_val((x)))) +#define is_not_binary(x) (!is_binary((x))) +#define _unchecked_binary_val(x) _unchecked_boxed_val((x)) +_ET_DECLARE_CHECKED(Eterm*,binary_val,Eterm); +#define binary_val(x) _ET_APPLY(binary_val,(x)) + +/* process binaries stuff (special case of binaries) */ +#define HEADER_PROC_BIN _make_header(PROC_BIN_SIZE-1,_TAG_HEADER_REFC_BIN) + +/* fun & export objects */ +#define is_any_fun(x) (is_fun((x)) || is_export((x))) +#define is_not_any_fun(x) (!is_any_fun((x))) + +/* fun objects */ +#define HEADER_FUN _make_header(ERL_FUN_SIZE-2,_TAG_HEADER_FUN) +#define is_fun_header(x) ((x) == HEADER_FUN) +#define make_fun(x) make_boxed((Eterm*)(x)) +#define is_fun(x) (is_boxed((x)) && is_fun_header(*boxed_val((x)))) +#define is_not_fun(x) (!is_fun((x))) +#define _unchecked_fun_val(x) _unchecked_boxed_val((x)) +_ET_DECLARE_CHECKED(Eterm*,fun_val,Eterm); +#define fun_val(x) _ET_APPLY(fun_val,(x)) + +/* export access methods */ +#define make_export(x) make_boxed((x)) +#define is_export(x) (is_boxed((x)) && is_export_header(*boxed_val((x)))) +#define is_not_export(x) (!is_export((x))) +#define _unchecked_export_val(x) _unchecked_boxed_val(x) +_ET_DECLARE_CHECKED(Eterm*,export_val,Eterm); +#define export_val(x) _ET_APPLY(export_val,(x)) +#define is_export_header(x) ((x) == HEADER_EXPORT) +#define HEADER_EXPORT _make_header(1,_TAG_HEADER_EXPORT) + +/* bignum access methods */ +#define make_pos_bignum_header(sz) _make_header((sz),_TAG_HEADER_POS_BIG) +#define make_neg_bignum_header(sz) _make_header((sz),_TAG_HEADER_NEG_BIG) +#define _is_bignum_header(x) (((x) & (_TAG_HEADER_MASK-_BIG_SIGN_BIT)) == _TAG_HEADER_POS_BIG) +#define _unchecked_bignum_header_is_neg(x) ((x) & _BIG_SIGN_BIT) +_ET_DECLARE_CHECKED(int,bignum_header_is_neg,Eterm); +#define bignum_header_is_neg(x) _ET_APPLY(bignum_header_is_neg,(x)) +#define _unchecked_bignum_header_neg(x) ((x) | _BIG_SIGN_BIT) +_ET_DECLARE_CHECKED(Eterm,bignum_header_neg,Eterm); +#define bignum_header_neg(x) _ET_APPLY(bignum_header_neg,(x)) +#define _unchecked_bignum_header_arity(x) _unchecked_header_arity((x)) +_ET_DECLARE_CHECKED(Uint,bignum_header_arity,Eterm); +#define bignum_header_arity(x) _ET_APPLY(bignum_header_arity,(x)) +#define BIG_ARITY_MAX ((1 << 19)-1) +#define make_big(x) make_boxed((x)) +#define is_big(x) (is_boxed((x)) && _is_bignum_header(*boxed_val((x)))) +#define is_not_big(x) (!is_big((x))) +#define _unchecked_big_val(x) _unchecked_boxed_val((x)) +_ET_DECLARE_CHECKED(Eterm*,big_val,Eterm); +#define big_val(x) _ET_APPLY(big_val,(x)) + +/* flonum ("float") access methods */ +#ifdef ARCH_64 +#define HEADER_FLONUM _make_header(1,_TAG_HEADER_FLOAT) +#else +#define HEADER_FLONUM _make_header(2,_TAG_HEADER_FLOAT) +#endif +#define make_float(x) make_boxed((x)) +#define is_float(x) (is_boxed((x)) && *boxed_val((x)) == HEADER_FLONUM) +#define is_not_float(x) (!is_float(x)) +#define _unchecked_float_val(x) _unchecked_boxed_val((x)) +_ET_DECLARE_CHECKED(Eterm*,float_val,Eterm); +#define float_val(x) _ET_APPLY(float_val,(x)) + +/* Float definition for byte and word access */ +typedef double ieee754_8; + +typedef union float_def +{ + ieee754_8 fd; + byte fb[sizeof(ieee754_8)]; + Uint16 fs[sizeof(ieee754_8) / sizeof(Uint16)]; + Uint32 fw[sizeof(ieee754_8) / sizeof(Uint32)]; +#ifdef ARCH_64 + Uint fdw; +#endif +} FloatDef; + +#ifdef ARCH_64 +#define GET_DOUBLE(x, f) (f).fdw = *(float_val(x)+1) + +#define PUT_DOUBLE(f, x) *(x) = HEADER_FLONUM, \ + *((x)+1) = (f).fdw +#define GET_DOUBLE_DATA(p, f) (f).fdw = *((Uint *) (p)) +#define PUT_DOUBLE_DATA(f,p) *((Uint *) (p)) = (f).fdw +#else +#define GET_DOUBLE(x, f) (f).fw[0] = *(float_val(x)+1), \ + (f).fw[1] = *(float_val(x)+2) + +#define PUT_DOUBLE(f, x) *(x) = HEADER_FLONUM, \ + *((x)+1) = (f).fw[0], \ + *((x)+2) = (f).fw[1] +#define GET_DOUBLE_DATA(p, f) (f).fw[0] = *((Uint *) (p)),\ + (f).fw[1] = *(((Uint *) (p))+1) +#define PUT_DOUBLE_DATA(f,p) *((Uint *) (p)) = (f).fw[0],\ + *(((Uint *) (p))+1) = (f).fw[1] +#endif +#define DOUBLE_DATA_WORDS (sizeof(ieee754_8)/sizeof(Eterm)) +#define FLOAT_SIZE_OBJECT (DOUBLE_DATA_WORDS+1) + +/* tuple access methods */ +#define make_tuple(x) make_boxed((x)) +#define is_tuple(x) (is_boxed((x)) && is_arity_value(*boxed_val((x)))) +#define is_not_tuple(x) (!is_tuple((x))) +#define is_tuple_arity(x, a) \ + (is_boxed((x)) && *boxed_val((x)) == make_arityval((a))) +#define is_not_tuple_arity(x, a) (!is_tuple_arity((x),(a))) +#define _unchecked_tuple_val(x) _unchecked_boxed_val(x) +_ET_DECLARE_CHECKED(Eterm*,tuple_val,Eterm); +#define tuple_val(x) _ET_APPLY(tuple_val,(x)) + +#define TUPLE0(t) \ + ((t)[0] = make_arityval(0), \ + make_tuple(t)) +#define TUPLE1(t,e1) \ + ((t)[0] = make_arityval(1), \ + (t)[1] = (e1), \ + make_tuple(t)) +#define TUPLE2(t,e1,e2) \ + ((t)[0] = make_arityval(2), \ + (t)[1] = (e1), \ + (t)[2] = (e2), \ + make_tuple(t)) +#define TUPLE3(t,e1,e2,e3) \ + ((t)[0] = make_arityval(3), \ + (t)[1] = (e1), \ + (t)[2] = (e2), \ + (t)[3] = (e3), \ + make_tuple(t)) +#define TUPLE4(t,e1,e2,e3,e4) \ + ((t)[0] = make_arityval(4), \ + (t)[1] = (e1), \ + (t)[2] = (e2), \ + (t)[3] = (e3), \ + (t)[4] = (e4), \ + make_tuple(t)) +#define TUPLE5(t,e1,e2,e3,e4,e5) \ + ((t)[0] = make_arityval(5), \ + (t)[1] = (e1), \ + (t)[2] = (e2), \ + (t)[3] = (e3), \ + (t)[4] = (e4), \ + (t)[5] = (e5), \ + make_tuple(t)) +#define TUPLE6(t,e1,e2,e3,e4,e5,e6) \ + ((t)[0] = make_arityval(6), \ + (t)[1] = (e1), \ + (t)[2] = (e2), \ + (t)[3] = (e3), \ + (t)[4] = (e4), \ + (t)[5] = (e5), \ + (t)[6] = (e6), \ + make_tuple(t)) + +#define TUPLE7(t,e1,e2,e3,e4,e5,e6,e7) \ + ((t)[0] = make_arityval(7), \ + (t)[1] = (e1), \ + (t)[2] = (e2), \ + (t)[3] = (e3), \ + (t)[4] = (e4), \ + (t)[5] = (e5), \ + (t)[6] = (e6), \ + (t)[7] = (e7), \ + make_tuple(t)) + +#define TUPLE8(t,e1,e2,e3,e4,e5,e6,e7,e8) \ + ((t)[0] = make_arityval(8), \ + (t)[1] = (e1), \ + (t)[2] = (e2), \ + (t)[3] = (e3), \ + (t)[4] = (e4), \ + (t)[5] = (e5), \ + (t)[6] = (e6), \ + (t)[7] = (e7), \ + (t)[8] = (e8), \ + make_tuple(t)) + +/* This macro get Size bits starting at low order position Pos + and adjusts the bits to the right + bits are numbered from 0 - (sizeof(Uint)*8-1) */ + +#define _GETBITS(X,Pos,Size) (((X) >> (Pos)) & ~(~((Uint) 0) << (Size))) + +/* + * Observe! New layout for pids, ports and references in R9 (see also note + * in erl_node_container_utils.h). + */ + + +/* + * Creation in node specific data (pids, ports, refs) + */ + +#define _CRE_SIZE 2 + +/* MAX value for the creation field in pid, port and reference */ +#define MAX_CREATION (1 << _CRE_SIZE) + +/* + * PID layout (internal pids): + * + * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | + * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| + * | | | | | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |n n n n n n n n n n n n n n n n n n n n n n n n n n n n|0 0|1 1| + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * + * n : number + * + * Old pid layout: + * + * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | + * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| + * | | | | | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |s s s|n n n n n n n n n n n n n n n|N N N N N N N N|c c|0 0|1 1| + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * + * s : serial + * n : number + * c : creation + * N : node number + * + */ + +#define _PID_R9_SER_SIZE 3 +#define _PID_SER_SIZE (_PID_DATA_SIZE - _PID_NUM_SIZE) +#define _PID_NUM_SIZE 15 + +#define _PID_DATA_SIZE 28 +#define _PID_DATA_SHIFT (_TAG_IMMED1_SIZE) + +#define _GET_PID_DATA(X) _GETBITS((X),_PID_DATA_SHIFT,_PID_DATA_SIZE) +#define _GET_PID_NUM(X) _GETBITS((X),0,_PID_NUM_SIZE) +#define _GET_PID_SER(X) _GETBITS((X),_PID_NUM_SIZE,_PID_SER_SIZE) + +#define make_pid_data(Ser, Num) \ + ((Uint) ((Ser) << _PID_NUM_SIZE | (Num))) + +#define make_internal_pid(X) \ + ((Eterm) (((X) << _PID_DATA_SHIFT) | _TAG_IMMED1_PID)) + +#define is_internal_pid(x) (((x) & _TAG_IMMED1_MASK) == _TAG_IMMED1_PID) +#define is_not_internal_pid(x) (!is_internal_pid((x))) + +#define _unchecked_internal_pid_data(x) _GET_PID_DATA((x)) +_ET_DECLARE_CHECKED(Uint,internal_pid_data,Eterm); +#define internal_pid_data(x) _ET_APPLY(internal_pid_data,(x)) + +#define _unchecked_internal_pid_node(x) erts_this_node +_ET_DECLARE_CHECKED(struct erl_node_*,internal_pid_node,Eterm); +#define internal_pid_node(x) _ET_APPLY(internal_pid_node,(x)) + +#define internal_pid_number(x) _GET_PID_NUM(internal_pid_data((x))) +#define internal_pid_serial(x) _GET_PID_SER(internal_pid_data((x))) + +#define internal_pid_data_words(x) (1) + +/* + * PORT layout (internal ports): + * + * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | + * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| + * | | | | | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |n n n n n n n n n n n n n n n n n n n n n n n n n n n n|0 1|1 1| + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * + * n : number + * + * Old port layout: + * + * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | + * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| + * | | | | | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |N N N N N N N N|n n n n n n n n n n n n n n n n n n|c c|0 1|1 1| + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * + * s : serial + * n : number + * c : creation + * N : node number + * + */ +#define _PORT_R9_NUM_SIZE 18 +#define _PORT_NUM_SIZE _PORT_DATA_SIZE + +#define _PORT_DATA_SIZE 28 +#define _PORT_DATA_SHIFT (_TAG_IMMED1_SIZE) + +#define _GET_PORT_DATA(X) _GETBITS((X),_PORT_DATA_SHIFT,_PORT_DATA_SIZE) +#define _GET_PORT_NUM(X) _GETBITS((X), 0, _PORT_NUM_SIZE) + + +#define make_internal_port(X) \ + ((Eterm) (((X) << _PORT_DATA_SHIFT) | _TAG_IMMED1_PORT)) + +#define is_internal_port(x) (((x) & _TAG_IMMED1_MASK) == _TAG_IMMED1_PORT) +#define is_not_internal_port(x) (!is_internal_port(x)) + +#define _unchecked_internal_port_data(x) _GET_PORT_DATA((x)) +_ET_DECLARE_CHECKED(Uint,internal_port_data,Eterm); +#define internal_port_data(x) _ET_APPLY(internal_port_data,(x)) + +#define internal_port_number(x) _GET_PORT_NUM(internal_port_data((x))) + +#define _unchecked_internal_port_node(x) erts_this_node +_ET_DECLARE_CHECKED(struct erl_node_*,internal_port_node,Eterm); +#define internal_port_node(x) _ET_APPLY(internal_port_node,(x)) + +#define internal_port_data_words(x) (1) +/* + * Ref layout (internal references): + * + * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | + * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| + * | | | | | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1|0 1 0 0|0 0| Thing + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |0 0 0 0 0 0 0 0 0 0 0 0 0 0|r r r r r r r r r r r r r r r r r r| Data 0 + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r| Data 1 + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r| Data 2 + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * + * + * r : reference number + * c : creation + * + * + * Old "heap ref" layout: + * + * + * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | + * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| + * | | | | | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1|0 1 0 0|0 0| Thing + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |N N N N N N N N|0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0|c c|0 1 1 1| Head + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |0 0 0 0 0 0 0 0 0 0 0 0 0 0|r r r r r r r r r r r r r r r r r r| Word 0 + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r| Word 1 + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r r| Word 2 + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * + * r : reference number + * c : creation + * N : node index + * + * Old "one-word ref" layout: + * + * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | + * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| + * | | | | | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |N N N N N N N N|r r r r r r r r r r r r r r r r r r|c c|T T T T| + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * + * r : reference number + * c : creation + * N : node index + * + */ +#define _REF_NUM_SIZE 18 + +/* Old maximum number of references in the system */ +#define MAX_REFERENCE (1 << _REF_NUM_SIZE) +#define REF_MASK (~(~((Uint)0) << _REF_NUM_SIZE)) +#define ERTS_MAX_REF_NUMBERS 3 +#define ERTS_REF_NUMBERS ERTS_MAX_REF_NUMBERS + +#ifdef ARCH_64 +# define ERTS_REF_WORDS (ERTS_REF_NUMBERS/2 + 1) +# define ERTS_REF_32BIT_WORDS (ERTS_REF_NUMBERS+1) +#else +# define ERTS_REF_WORDS ERTS_REF_NUMBERS +# define ERTS_REF_32BIT_WORDS ERTS_REF_NUMBERS +#endif + +typedef struct { + Eterm header; + union { + Uint32 ui32[ERTS_REF_32BIT_WORDS]; + Uint ui[ERTS_REF_WORDS]; + } data; +} RefThing; + +#define REF_THING_SIZE (sizeof(RefThing)/sizeof(Uint)) +#define REF_THING_HEAD_SIZE (sizeof(Eterm)/sizeof(Uint)) + +#define make_ref_thing_header(DW) \ + _make_header((DW)+REF_THING_HEAD_SIZE-1,_TAG_HEADER_REF) + +#ifdef ARCH_64 + +/* + * Ref layout on a 64-bit little endian machine: + * + * 63 31 0 + * +--------------+--------------+ + * | Thing word | + * +--------------+--------------+ + * | Data 0 | 32-bit arity | + * +--------------+--------------+ + * | Data 2 | Data 1 | + * +--------------+--------------+ + * + * Data is stored as an Uint32 array with 32-bit arity as first number. + */ + +#define write_ref_thing(Hp, R0, R1, R2) \ +do { \ + ((RefThing *) (Hp))->header = make_ref_thing_header(ERTS_REF_WORDS); \ + ((RefThing *) (Hp))->data.ui32[0] = ERTS_REF_NUMBERS; \ + ((RefThing *) (Hp))->data.ui32[1] = (R0); \ + ((RefThing *) (Hp))->data.ui32[2] = (R1); \ + ((RefThing *) (Hp))->data.ui32[3] = (R2); \ +} while (0) + +#else + +#define write_ref_thing(Hp, R0, R1, R2) \ +do { \ + ((RefThing *) (Hp))->header = make_ref_thing_header(ERTS_REF_WORDS); \ + ((RefThing *) (Hp))->data.ui32[0] = (R0); \ + ((RefThing *) (Hp))->data.ui32[1] = (R1); \ + ((RefThing *) (Hp))->data.ui32[2] = (R2); \ +} while (0) + +#endif + +#define is_ref_thing_header(x) (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_REF) +#define make_internal_ref(x) make_boxed((Eterm*)(x)) + +#define _unchecked_ref_thing_ptr(x) \ + ((RefThing*) _unchecked_internal_ref_val(x)) +#define ref_thing_ptr(x) \ + ((RefThing*) internal_ref_val(x)) + +#define is_internal_ref(x) \ + (_unchecked_is_boxed((x)) && is_ref_thing_header(*boxed_val((x)))) +#define is_not_internal_ref(x) \ + (!is_internal_ref((x))) + +#define _unchecked_internal_ref_val(x) _unchecked_boxed_val((x)) +_ET_DECLARE_CHECKED(Eterm*,internal_ref_val,Eterm); +#define internal_ref_val(x) _ET_APPLY(internal_ref_val,(x)) + +#define _unchecked_internal_ref_data_words(x) \ + (_unchecked_thing_arityval(*_unchecked_internal_ref_val(x))) +_ET_DECLARE_CHECKED(Uint,internal_ref_data_words,Eterm); +#define internal_ref_data_words(x) _ET_APPLY(internal_ref_data_words,(x)) + +#define _unchecked_internal_ref_data(x) (_unchecked_ref_thing_ptr(x)->data.ui32) +_ET_DECLARE_CHECKED(Uint32*,internal_ref_data,Eterm); +#define internal_ref_data(x) _ET_APPLY(internal_ref_data,(x)) + +#define _unchecked_internal_ref_node(x) erts_this_node +_ET_DECLARE_CHECKED(struct erl_node_*,internal_ref_node,Eterm); +#define internal_ref_node(x) _ET_APPLY(internal_ref_node,(x)) + +/* + * + * External thing layout (external pids, ports, and refs): + * + * |3 3 2 2 2 2 2 2|2 2 2 2 1 1 1 1|1 1 1 1 1 1 | | + * |1 0 9 8 7 6 5 4|3 2 1 0 9 8 7 6|5 4 3 2 1 0 9 8|7 6 5 4 3 2 1 0| + * | | | | | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |A A A A A A A A A A A A A A A A A A A A A A A A A A|t t t t|0 0| Thing + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |N N N N N N N N N N N N N N N N N N N N N N N N N N N N N N N N| Next + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |E E E E E E E E E E E E E E E E E E E E E E E E E E E E E E E E| ErlNode + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * |X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X X| Data 0 + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * . . . + * . . . + * . . . + * + * A : Arity + * t : External pid thing tag (1100) + * t : External port thing tag (1101) + * t : External ref thing tag (1110) + * N : Next (external thing) pointer + * E : ErlNode pointer + * X : Type specific data + * + * External pid and port layout: + * External pids and ports only have one data word (Data 0) which has + * the same layout as internal pids resp. internal ports. + * + * External refs layout: + * External refs has the same layout for the data words as in the internal + * ref. + * + */ + +typedef struct external_thing_ { + /* ----+ */ + Eterm header; /* | */ + struct external_thing_ *next; /* > External thing head */ + struct erl_node_ *node; /* | */ + /* ----+ */ + union { + Uint32 ui32[1]; + Uint ui[1]; + } data; +} ExternalThing; + +#define EXTERNAL_THING_HEAD_SIZE (sizeof(ExternalThing)/sizeof(Uint) - 1) + +#define make_external_pid_header(DW) \ + _make_header((DW)+EXTERNAL_THING_HEAD_SIZE-1,_TAG_HEADER_EXTERNAL_PID) +#define is_external_pid_header(x) \ + (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_EXTERNAL_PID) + +#define make_external_port_header(DW) \ + _make_header((DW)+EXTERNAL_THING_HEAD_SIZE-1,_TAG_HEADER_EXTERNAL_PORT) +#define is_external_port_header(x) \ + (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_EXTERNAL_PORT) + +#define make_external_ref_header(DW) \ + _make_header((DW)+EXTERNAL_THING_HEAD_SIZE-1,_TAG_HEADER_EXTERNAL_REF) +#define is_external_ref_header(x) \ + (((x) & _TAG_HEADER_MASK) == _TAG_HEADER_EXTERNAL_REF) + +#define is_external_header(x) \ + (((x) & (_TAG_HEADER_MASK-_BINARY_XXX_MASK)) == _TAG_HEADER_EXTERNAL_PID) + +#define is_external(x) \ + (is_boxed((x)) && is_external_header(*boxed_val((x)))) +#define is_external_pid(x) \ + (is_boxed((x)) && is_external_pid_header(*boxed_val((x)))) +#define is_external_port(x) \ + (is_boxed((x)) && is_external_port_header(*boxed_val((x)))) +#define is_external_ref(x) \ + (_unchecked_is_boxed((x)) && is_external_ref_header(*boxed_val((x)))) + +#define _unchecked_is_external(x) \ + (_unchecked_is_boxed((x)) && is_external_header(*_unchecked_boxed_val((x)))) + +#define is_not_external(x) (!is_external((x))) +#define is_not_external_pid(x) (!is_external_pid((x))) +#define is_not_external_port(x) (!is_external_port((x))) +#define is_not_external_ref(x) (!is_external_ref((x))) + + +#define make_external(x) make_boxed((Eterm *) (x)) + +#define make_external_pid make_external +#define make_external_port make_external +#define make_external_ref make_external + +#define _unchecked_external_val(x) _unchecked_boxed_val((x)) +_ET_DECLARE_CHECKED(Eterm*,external_val,Eterm); +#define external_val(x) _ET_APPLY(external_val,(x)) + +#define external_thing_ptr(x) ((ExternalThing *) external_val((x))) +#define _unchecked_external_thing_ptr(x) \ + ((ExternalThing *) _unchecked_external_val((x))) + +#define _unchecked_external_data_words(x) \ + (_unchecked_thing_arityval(_unchecked_external_thing_ptr((x))->header) \ + + (1 - EXTERNAL_THING_HEAD_SIZE)) +_ET_DECLARE_CHECKED(Uint,external_data_words,Eterm); +#define external_data_words(x) _ET_APPLY(external_data_words,(x)) + +#define _unchecked_external_data(x) (_unchecked_external_thing_ptr((x))->data.ui) +#define _unchecked_external_node(x) (_unchecked_external_thing_ptr((x))->node) + +#define external_data(x) (external_thing_ptr((x))->data.ui) +#define external_node(x) (external_thing_ptr((x))->node) + +#define _unchecked_external_pid_data_words(x) \ + _unchecked_external_data_words((x)) +_ET_DECLARE_CHECKED(Uint,external_pid_data_words,Eterm); +#define external_pid_data_words(x) _ET_APPLY(external_pid_data_words,(x)) + +#define _unchecked_external_pid_data(x) _unchecked_external_data((x))[0] +_ET_DECLARE_CHECKED(Uint,external_pid_data,Eterm); +#define external_pid_data(x) _ET_APPLY(external_pid_data,(x)) + +#define _unchecked_external_pid_node(x) _unchecked_external_node((x)) +_ET_DECLARE_CHECKED(struct erl_node_*,external_pid_node,Eterm); +#define external_pid_node(x) _ET_APPLY(external_pid_node,(x)) + +#define external_pid_number(x) _GET_PID_NUM(external_pid_data((x))) +#define external_pid_serial(x) _GET_PID_SER(external_pid_data((x))) + +#define _unchecked_external_port_data_words(x) \ + _unchecked_external_data_words((x)) +_ET_DECLARE_CHECKED(Uint,external_port_data_words,Eterm); +#define external_port_data_words(x) _ET_APPLY(external_port_data_words,(x)) + +#define _unchecked_external_port_data(x) _unchecked_external_data((x))[0] +_ET_DECLARE_CHECKED(Uint,external_port_data,Eterm); +#define external_port_data(x) _ET_APPLY(external_port_data,(x)) + +#define _unchecked_external_port_node(x) _unchecked_external_node((x)) +_ET_DECLARE_CHECKED(struct erl_node_*,external_port_node,Eterm); +#define external_port_node(x) _ET_APPLY(external_port_node,(x)) + +#define external_port_number(x) _GET_PORT_NUM(external_port_data((x))) + +#define _unchecked_external_ref_data_words(x) \ + _unchecked_external_data_words((x)) +_ET_DECLARE_CHECKED(Uint,external_ref_data_words,Eterm); +#define external_ref_data_words(x) _ET_APPLY(external_ref_data_words,(x)) + +#define _unchecked_external_ref_data(x) (_unchecked_external_thing_ptr((x))->data.ui32) +_ET_DECLARE_CHECKED(Uint32*,external_ref_data,Eterm); +#define external_ref_data(x) _ET_APPLY(external_ref_data,(x)) + +#define _unchecked_external_ref_node(x) _unchecked_external_node((x)) +_ET_DECLARE_CHECKED(struct erl_node_*,external_ref_node,Eterm); +#define external_ref_node(x) _ET_APPLY(external_ref_node,(x)) + +/* number tests */ + +#define is_integer(x) (is_small(x) || is_big(x)) +#define is_not_integer(x) (!is_integer(x)) +#define is_number(x) (is_integer(x) || is_float(x)) + +#define SMALL_MINUS_ONE make_small(-1) +#define SMALL_ZERO make_small(0) +#define SMALL_ONE make_small(1) + +#define ENULL 0 + +/* on some architectures CP contains labels which are not aligned */ +#ifdef NOT_ALIGNED +#error "fix yer arch, like" +#endif + +#define _unchecked_make_cp(x) ((Eterm)(x)) +_ET_DECLARE_CHECKED(Eterm,make_cp,Uint*); +#define make_cp(x) _ET_APPLY(make_cp,(x)) + +#define is_not_CP(x) ((x) & _CPMASK) +#define is_CP(x) (!is_not_CP(x)) + +#define _unchecked_cp_val(x) ((Uint*)(x)) +_ET_DECLARE_CHECKED(Uint*,cp_val,Eterm); +#define cp_val(x) _ET_APPLY(cp_val,(x)) + +#define make_catch(x) (((x) << _TAG_IMMED2_SIZE) | _TAG_IMMED2_CATCH) +#define is_catch(x) (((x) & _TAG_IMMED2_MASK) == _TAG_IMMED2_CATCH) +#define is_not_catch(x) (!is_catch(x)) +#define _unchecked_catch_val(x) ((x) >> _TAG_IMMED2_SIZE) +_ET_DECLARE_CHECKED(Uint,catch_val,Eterm); +#define catch_val(x) _ET_APPLY(catch_val,(x)) + +#define make_blank(X) ((X) = NIL) + +/* + * Overloaded tags. + * + * SMALL = 15 + * ATOM/NIL=7 + * + * Note that the two least significant bits in SMALL/ATOM/NIL always are 3; + * thus, we can distinguish register from literals by looking at only these + * two bits. + */ + +#define X_REG_DEF 0 +#define Y_REG_DEF 1 +#define R_REG_DEF 2 + +#define beam_reg_tag(x) ((x) & 3) + +#define make_rreg() R_REG_DEF +#define make_xreg(ix) (((ix) * sizeof(Eterm)) | X_REG_DEF) +#define make_yreg(ix) (((ix) * sizeof(Eterm)) | Y_REG_DEF) + +#define _is_xreg(x) (beam_reg_tag(x) == X_REG_DEF) +#define _is_yreg(x) (beam_reg_tag(x) == Y_REG_DEF) + +#define _unchecked_x_reg_offset(R) ((R) - X_REG_DEF) +_ET_DECLARE_CHECKED(Uint,x_reg_offset,Uint); +#define x_reg_offset(R) _ET_APPLY(x_reg_offset,(R)) + +#define _unchecked_y_reg_offset(R) ((R) - Y_REG_DEF) +_ET_DECLARE_CHECKED(Uint,y_reg_offset,Uint); +#define y_reg_offset(R) _ET_APPLY(y_reg_offset,(R)) + +#define reg_index(R) ((R) / sizeof(Eterm)) + +#define _unchecked_x_reg_index(R) ((R) >> 2) +_ET_DECLARE_CHECKED(Uint,x_reg_index,Uint); +#define x_reg_index(R) _ET_APPLY(x_reg_index,(R)) + +#define _unchecked_y_reg_index(R) ((R) >> 2) +_ET_DECLARE_CHECKED(Uint,y_reg_index,Uint); +#define y_reg_index(R) _ET_APPLY(y_reg_index,(R)) + +/* + * Backwards compatibility definitions: + * - #define virtal *_DEF constants with values that fit term order: + * number < atom < ref < fun < port < pid < tuple < nil < cons < binary + * - tag_val_def() function generates virtual _DEF tag + * - not_eq_tags() and NUMBER_CODE() defined in terms + * of the tag_val_def() function + */ + +#define BINARY_DEF 0x0 +#define LIST_DEF 0x1 +#define NIL_DEF 0x2 +#define TUPLE_DEF 0x3 +#define PID_DEF 0x4 +#define EXTERNAL_PID_DEF 0x5 +#define PORT_DEF 0x6 +#define EXTERNAL_PORT_DEF 0x7 +#define EXPORT_DEF 0x8 +#define FUN_DEF 0x9 +#define REF_DEF 0xa +#define EXTERNAL_REF_DEF 0xb +#define ATOM_DEF 0xc +#define FLOAT_DEF 0xd +#define BIG_DEF 0xe +#define SMALL_DEF 0xf + +#if ET_DEBUG +extern unsigned tag_val_def_debug(Eterm, const char*, unsigned); +#define tag_val_def(x) tag_val_def_debug((x),__FILE__,__LINE__) +#else +extern unsigned tag_val_def(Eterm); +#endif +#define not_eq_tags(X,Y) (tag_val_def((X)) ^ tag_val_def((Y))) + +#define NUMBER_CODE(x,y) ((tag_val_def(x) << 4) | tag_val_def(y)) +#define _NUMBER_CODE(TX,TY) ((TX << 4) | TY) +#define SMALL_SMALL _NUMBER_CODE(SMALL_DEF,SMALL_DEF) +#define SMALL_BIG _NUMBER_CODE(SMALL_DEF,BIG_DEF) +#define SMALL_FLOAT _NUMBER_CODE(SMALL_DEF,FLOAT_DEF) +#define BIG_SMALL _NUMBER_CODE(BIG_DEF,SMALL_DEF) +#define BIG_BIG _NUMBER_CODE(BIG_DEF,BIG_DEF) +#define BIG_FLOAT _NUMBER_CODE(BIG_DEF,FLOAT_DEF) +#define FLOAT_SMALL _NUMBER_CODE(FLOAT_DEF,SMALL_DEF) +#define FLOAT_BIG _NUMBER_CODE(FLOAT_DEF,BIG_DEF) +#define FLOAT_FLOAT _NUMBER_CODE(FLOAT_DEF,FLOAT_DEF) + +#endif /* __ERL_TERM_H */ + diff --git a/erts/emulator/beam/erl_threads.h b/erts/emulator/beam/erl_threads.h new file mode 100644 index 0000000000..d635916dd8 --- /dev/null +++ b/erts/emulator/beam/erl_threads.h @@ -0,0 +1,1524 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Description: Error checking thread interface to the ethread library. + * All functions terminates the emulator on failure. + * Author: Rickard Green + */ + +#ifndef ERL_THREAD_H__ +#define ERL_THREAD_H__ + +#include "sys.h" +#ifdef USE_THREADS + +#define ETHR_TRY_INLINE_FUNCS +#include "ethread.h" +#include "erl_lock_check.h" +#include "erl_lock_count.h" +#include "erl_term.h" + +#ifdef ERTS_ENABLE_LOCK_COUNT +#define erts_mtx_lock(L) erts_mtx_lock_x(L, __FILE__, __LINE__) +#define erts_spin_lock(L) erts_spin_lock_x(L, __FILE__, __LINE__) +#define erts_rwmtx_rlock(L) erts_rwmtx_rlock_x(L, __FILE__, __LINE__) +#define erts_rwmtx_rwlock(L) erts_rwmtx_rwlock_x(L, __FILE__, __LINE__) +#define erts_read_lock(L) erts_read_lock_x(L, __FILE__, __LINE__) +#define erts_write_lock(L) erts_write_lock_x(L, __FILE__, __LINE__) +#endif + +#define ERTS_THR_OPTS_DEFAULT_INITER ETHR_THR_OPTS_DEFAULT_INITER +typedef ethr_thr_opts erts_thr_opts_t; +typedef ethr_init_data erts_thr_init_data_t; +typedef ethr_tid erts_tid_t; + +/* mutex */ +typedef struct { + ethr_mutex mtx; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock_t lc; +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_t lcnt; +#endif + +} erts_mtx_t; +typedef ethr_cond erts_cnd_t; + +/* rwmutex */ +typedef struct { + ethr_rwmutex rwmtx; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock_t lc; +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_t lcnt; +#endif +} erts_rwmtx_t; +typedef ethr_tsd_key erts_tsd_key_t; +typedef ethr_gate erts_gate_t; +typedef ethr_atomic_t erts_atomic_t; + +/* spinlock */ +typedef struct { + ethr_spinlock_t slck; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock_t lc; +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_t lcnt; +#endif +} erts_spinlock_t; + +/* rwlock */ +typedef struct { + ethr_rwlock_t rwlck; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock_t lc; +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_t lcnt; +#endif +} erts_rwlock_t; + +typedef ethr_timeval erts_thr_timeval_t; +__decl_noreturn void __noreturn erts_thr_fatal_error(int, char *); + /* implemented in erl_init.c */ + +#ifdef ERTS_ENABLE_LOCK_CHECK +#define ERTS_REC_MTX_INITER \ + {ETHR_REC_MUTEX_INITER, \ + ERTS_LC_LOCK_INIT(-1,THE_NON_VALUE,ERTS_LC_FLG_LT_MUTEX)} +#define ERTS_MTX_INITER \ + {ETHR_MUTEX_INITER, \ + ERTS_LC_LOCK_INIT(-1, THE_NON_VALUE, ERTS_LC_FLG_LT_MUTEX)} +#else +#define ERTS_REC_MTX_INITER {ETHR_REC_MUTEX_INITER} +#define ERTS_MTX_INITER {ETHR_MUTEX_INITER} +#endif +#define ERTS_CND_INITER ETHR_COND_INITER +#define ERTS_THR_INIT_DATA_DEF_INITER ETHR_INIT_DATA_DEFAULT_INITER + +#ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT +# define ERTS_HAVE_REC_MTX_INIT ETHR_HAVE_ETHR_REC_MUTEX_INIT +#endif + + +#else /* #ifdef USE_THREADS */ + +#define ERTS_THR_OPTS_DEFAULT_INITER 0 +typedef int erts_thr_opts_t; +typedef int erts_thr_init_data_t; +typedef int erts_tid_t; +typedef int erts_mtx_t; +typedef int erts_cnd_t; +typedef int erts_rwmtx_t; +typedef int erts_tsd_key_t; +typedef int erts_gate_t; +typedef long erts_atomic_t; +#if __GNUC__ > 2 +typedef struct { } erts_spinlock_t; +typedef struct { } erts_rwlock_t; +#else +typedef struct { int gcc_is_buggy; } erts_spinlock_t; +typedef struct { int gcc_is_buggy; } erts_rwlock_t; +#endif +typedef struct { + long tv_sec; + long tv_nsec; +} erts_thr_timeval_t; + +#define ERTS_REC_MTX_INITER 0 +#define ERTS_MTX_INITER 0 +#define ERTS_CND_INITER 0 +#define ERTS_THR_INIT_DATA_DEF_INITER 0 + +#define ERTS_HAVE_REC_MTX_INIT 1 + +#endif /* #ifdef USE_THREADS */ + +ERTS_GLB_INLINE void erts_thr_init(erts_thr_init_data_t *id); +ERTS_GLB_INLINE void erts_thr_create(erts_tid_t *tid, void * (*func)(void *), + void *arg, erts_thr_opts_t *opts); +ERTS_GLB_INLINE void erts_thr_join(erts_tid_t tid, void **thr_res); +ERTS_GLB_INLINE void erts_thr_detach(erts_tid_t tid); +ERTS_GLB_INLINE void erts_thr_exit(void *res); +ERTS_GLB_INLINE void erts_thr_install_exit_handler(void (*exit_handler)(void)); +ERTS_GLB_INLINE erts_tid_t erts_thr_self(void); +ERTS_GLB_INLINE int erts_equal_tids(erts_tid_t x, erts_tid_t y); +#ifdef ERTS_HAVE_REC_MTX_INIT +ERTS_GLB_INLINE void erts_rec_mtx_init(erts_mtx_t *mtx); +#endif +ERTS_GLB_INLINE void erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra); +ERTS_GLB_INLINE void erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt); +ERTS_GLB_INLINE void erts_mtx_init_locked_x(erts_mtx_t *mtx, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_mtx_init(erts_mtx_t *mtx, char *name); +ERTS_GLB_INLINE void erts_mtx_init_locked(erts_mtx_t *mtx, char *name); +ERTS_GLB_INLINE void erts_mtx_destroy(erts_mtx_t *mtx); +ERTS_GLB_INLINE void erts_mtx_set_forksafe(erts_mtx_t *mtx); +ERTS_GLB_INLINE void erts_mtx_unset_forksafe(erts_mtx_t *mtx); +ERTS_GLB_INLINE int erts_mtx_trylock(erts_mtx_t *mtx); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_mtx_lock_x(erts_mtx_t *mtx, char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_mtx_lock(erts_mtx_t *mtx); +#endif +ERTS_GLB_INLINE void erts_mtx_unlock(erts_mtx_t *mtx); +ERTS_GLB_INLINE int erts_lc_mtx_is_locked(erts_mtx_t *mtx); +ERTS_GLB_INLINE void erts_cnd_init(erts_cnd_t *cnd); +ERTS_GLB_INLINE void erts_cnd_destroy(erts_cnd_t *cnd); +ERTS_GLB_INLINE void erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx); +ERTS_GLB_INLINE void erts_cnd_signal(erts_cnd_t *cnd); +ERTS_GLB_INLINE void erts_cnd_broadcast(erts_cnd_t *cnd); +ERTS_GLB_INLINE void erts_rwmtx_init_x(erts_rwmtx_t *rwmtx, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_rwmtx_init(erts_rwmtx_t *rwmtx, + char *name); +ERTS_GLB_INLINE void erts_rwmtx_destroy(erts_rwmtx_t *rwmtx); +ERTS_GLB_INLINE int erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_rwmtx_rlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line); +ERTS_GLB_INLINE void erts_rwmtx_rwlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_rwmtx_rlock(erts_rwmtx_t *rwmtx); +ERTS_GLB_INLINE void erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx); +#endif +ERTS_GLB_INLINE void erts_rwmtx_runlock(erts_rwmtx_t *rwmtx); +ERTS_GLB_INLINE int erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx); +ERTS_GLB_INLINE void erts_rwmtx_rwunlock(erts_rwmtx_t *rwmtx); +ERTS_GLB_INLINE int erts_lc_rwmtx_is_rlocked(erts_rwmtx_t *mtx); +ERTS_GLB_INLINE int erts_lc_rwmtx_is_rwlocked(erts_rwmtx_t *mtx); +ERTS_GLB_INLINE void erts_atomic_init(erts_atomic_t *var, long i); +ERTS_GLB_INLINE void erts_atomic_set(erts_atomic_t *var, long i); +ERTS_GLB_INLINE long erts_atomic_read(erts_atomic_t *var); +ERTS_GLB_INLINE long erts_atomic_inctest(erts_atomic_t *incp); +ERTS_GLB_INLINE long erts_atomic_dectest(erts_atomic_t *decp); +ERTS_GLB_INLINE void erts_atomic_inc(erts_atomic_t *incp); +ERTS_GLB_INLINE void erts_atomic_dec(erts_atomic_t *decp); +ERTS_GLB_INLINE long erts_atomic_addtest(erts_atomic_t *addp, + long i); +ERTS_GLB_INLINE void erts_atomic_add(erts_atomic_t *addp, long i); +ERTS_GLB_INLINE long erts_atomic_xchg(erts_atomic_t *xchgp, + long new); +ERTS_GLB_INLINE long erts_atomic_cmpxchg(erts_atomic_t *xchgp, + long new, + long expected); +ERTS_GLB_INLINE long erts_atomic_bor(erts_atomic_t *var, long mask); +ERTS_GLB_INLINE long erts_atomic_band(erts_atomic_t *var, long mask); +ERTS_GLB_INLINE void erts_spinlock_init_x(erts_spinlock_t *lock, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_spinlock_init(erts_spinlock_t *lock, + char *name); +ERTS_GLB_INLINE void erts_spinlock_destroy(erts_spinlock_t *lock); +ERTS_GLB_INLINE void erts_spin_unlock(erts_spinlock_t *lock); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_spin_lock_x(erts_spinlock_t *lock, char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_spin_lock(erts_spinlock_t *lock); +#endif +ERTS_GLB_INLINE int erts_lc_spinlock_is_locked(erts_spinlock_t *lock); +ERTS_GLB_INLINE void erts_rwlock_init_x(erts_rwlock_t *lock, + char *name, + Eterm extra); +ERTS_GLB_INLINE void erts_rwlock_init(erts_rwlock_t *lock, + char *name); +ERTS_GLB_INLINE void erts_rwlock_destroy(erts_rwlock_t *lock); +ERTS_GLB_INLINE void erts_read_unlock(erts_rwlock_t *lock); +#ifdef ERTS_ENABLE_LOCK_COUNT +ERTS_GLB_INLINE void erts_read_lock_x(erts_rwlock_t *lock, char *file, unsigned int line); +ERTS_GLB_INLINE void erts_write_lock_x(erts_rwlock_t *lock, char *file, unsigned int line); +#else +ERTS_GLB_INLINE void erts_read_lock(erts_rwlock_t *lock); +ERTS_GLB_INLINE void erts_write_lock(erts_rwlock_t *lock); +#endif +ERTS_GLB_INLINE void erts_write_unlock(erts_rwlock_t *lock); +ERTS_GLB_INLINE int erts_lc_rwlock_is_rlocked(erts_rwlock_t *lock); +ERTS_GLB_INLINE int erts_lc_rwlock_is_rwlocked(erts_rwlock_t *lock); +ERTS_GLB_INLINE void erts_thr_time_now(erts_thr_timeval_t *time); +ERTS_GLB_INLINE void erts_tsd_key_create(erts_tsd_key_t *keyp); +ERTS_GLB_INLINE void erts_tsd_key_delete(erts_tsd_key_t key); +ERTS_GLB_INLINE void erts_tsd_set(erts_tsd_key_t key, void *value); +ERTS_GLB_INLINE void * erts_tsd_get(erts_tsd_key_t key); +ERTS_GLB_INLINE void erts_gate_init(erts_gate_t *gp); +ERTS_GLB_INLINE void erts_gate_destroy(erts_gate_t *gp); +ERTS_GLB_INLINE void erts_gate_close(erts_gate_t *gp); +ERTS_GLB_INLINE void erts_gate_let_through(erts_gate_t *gp, unsigned no); +ERTS_GLB_INLINE void erts_gate_wait(erts_gate_t *gp); +ERTS_GLB_INLINE void erts_gate_swait(erts_gate_t *gp, int spincount); + +#ifdef ETHR_HAVE_ETHR_SIG_FUNCS +#define ERTS_THR_HAVE_SIG_FUNCS 1 +ERTS_GLB_INLINE void erts_thr_sigmask(int how, const sigset_t *set, + sigset_t *oset); +ERTS_GLB_INLINE void erts_thr_sigwait(const sigset_t *set, int *sig); +#endif /* #ifdef HAVE_ETHR_SIG_FUNCS */ + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_thr_init(erts_thr_init_data_t *id) +{ +#ifdef USE_THREADS + int res = ethr_init(id); + if (res) + erts_thr_fatal_error(res, "initialize thread library"); +#endif +} + +ERTS_GLB_INLINE void +erts_thr_create(erts_tid_t *tid, void * (*func)(void *), void *arg, + erts_thr_opts_t *opts) +{ +#ifdef USE_THREADS +#ifdef ERTS_ENABLE_LOCK_COUNT + int res = erts_lcnt_thr_create(tid, func, arg, opts); +#else + int res = ethr_thr_create(tid, func, arg, opts); +#endif + if (res) + erts_thr_fatal_error(res, "create thread"); +#endif +} + +ERTS_GLB_INLINE void +erts_thr_join(erts_tid_t tid, void **thr_res) +{ +#ifdef USE_THREADS + int res = ethr_thr_join(tid, thr_res); + if (res) + erts_thr_fatal_error(res, "join thread"); +#endif +} + + +ERTS_GLB_INLINE void +erts_thr_detach(erts_tid_t tid) +{ +#ifdef USE_THREADS + int res = ethr_thr_detach(tid); + if (res) + erts_thr_fatal_error(res, "detach thread"); +#endif +} + + +ERTS_GLB_INLINE void +erts_thr_exit(void *res) +{ +#ifdef USE_THREADS + ethr_thr_exit(res); + erts_thr_fatal_error(0, "terminate thread"); +#endif +} + +ERTS_GLB_INLINE void +erts_thr_install_exit_handler(void (*exit_handler)(void)) +{ +#ifdef USE_THREADS + int res = ethr_install_exit_handler(exit_handler); + if (res != 0) + erts_thr_fatal_error(res, "install thread exit handler"); +#endif +} + +ERTS_GLB_INLINE erts_tid_t +erts_thr_self(void) +{ +#ifdef USE_THREADS + return ethr_self(); +#else + return 0; +#endif +} + + +ERTS_GLB_INLINE int +erts_equal_tids(erts_tid_t x, erts_tid_t y) +{ +#ifdef USE_THREADS + return ethr_equal_tids(x, y); +#else + return 1; +#endif +} + + +#ifdef ERTS_HAVE_REC_MTX_INIT +ERTS_GLB_INLINE void +erts_rec_mtx_init(erts_mtx_t *mtx) +{ +#ifdef USE_THREADS + int res = ethr_rec_mutex_init(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "initialize recursive mutex"); +#endif +} +#endif + + +ERTS_GLB_INLINE void +erts_mtx_init_x(erts_mtx_t *mtx, char *name, Eterm extra) +{ +#ifdef USE_THREADS + int res = ethr_mutex_init(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "initialize mutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); +#endif +#endif +} + +ERTS_GLB_INLINE void +erts_mtx_init_x_opt(erts_mtx_t *mtx, char *name, Eterm extra, Uint16 opt) +{ +#ifdef USE_THREADS + int res = ethr_mutex_init(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "initialize mutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX | opt, extra); +#endif +#endif +} + + +ERTS_GLB_INLINE void +erts_mtx_init_locked_x(erts_mtx_t *mtx, char *name, Eterm extra) +{ +#ifdef USE_THREADS + int res = ethr_mutex_init(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "initialize mutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock_x(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX, extra); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock_x(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX, extra); +#endif + res = ethr_mutex_lock(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "lock mutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock(1, &mtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_trylock(&mtx->lcnt, 1); +#endif +#endif +} + +ERTS_GLB_INLINE void +erts_mtx_init(erts_mtx_t *mtx, char *name) +{ +#ifdef USE_THREADS + int res = ethr_mutex_init(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "initialize mutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX); +#endif +#endif +} + +ERTS_GLB_INLINE void +erts_mtx_init_locked(erts_mtx_t *mtx, char *name) +{ +#ifdef USE_THREADS + int res = ethr_mutex_init(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "initialize mutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock(&mtx->lc, name, ERTS_LC_FLG_LT_MUTEX); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock(&mtx->lcnt, name, ERTS_LCNT_LT_MUTEX); +#endif + res = ethr_mutex_lock(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "lock mutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock(1, &mtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_trylock(&mtx->lcnt, 1); +#endif +#endif +} + +ERTS_GLB_INLINE void +erts_mtx_destroy(erts_mtx_t *mtx) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_destroy_lock(&mtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_destroy_lock(&mtx->lcnt); +#endif + res = ethr_mutex_destroy(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "destroy mutex"); +#endif +} + +ERTS_GLB_INLINE void +erts_mtx_set_forksafe(erts_mtx_t *mtx) +{ +#ifdef USE_THREADS + int res = ethr_mutex_set_forksafe(&mtx->mtx); + if (res != 0 && res != ENOTSUP) + erts_thr_fatal_error(res, "set mutex forksafe"); +#endif +} + +ERTS_GLB_INLINE void +erts_mtx_unset_forksafe(erts_mtx_t *mtx) +{ +#ifdef USE_THREADS + int res = ethr_mutex_unset_forksafe(&mtx->mtx); + if (res != 0 && res != ENOTSUP) + erts_thr_fatal_error(res, "unset mutex forksafe"); +#endif +} + +ERTS_GLB_INLINE int +erts_mtx_trylock(erts_mtx_t *mtx) +{ +#ifdef USE_THREADS + int res; + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (erts_lc_trylock_force_busy(&mtx->lc)) + return EBUSY; /* Make sure caller can handle the situation without + causing a lock order violation */ +#endif + + res = ethr_mutex_trylock(&mtx->mtx); + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock(res == 0, &mtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_trylock(&mtx->lcnt, res); +#endif + + if (res != 0 && res != EBUSY) + erts_thr_fatal_error(res, "try lock mutex"); + + return res; +#else + return 0; +#endif + +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_mtx_lock_x(erts_mtx_t *mtx, char *file, unsigned int line) +#else +erts_mtx_lock(erts_mtx_t *mtx) +#endif +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock(&mtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock(&mtx->lcnt); +#endif + res = ethr_mutex_lock(&mtx->mtx); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post_x(&mtx->lcnt, file, line); +#endif + if (res) + erts_thr_fatal_error(res, "lock mutex"); +#endif +} + +ERTS_GLB_INLINE void +erts_mtx_unlock(erts_mtx_t *mtx) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_unlock(&mtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock(&mtx->lcnt); +#endif + res = ethr_mutex_unlock(&mtx->mtx); + if (res) + erts_thr_fatal_error(res, "unlock mutex"); +#endif +} + +ERTS_GLB_INLINE int +erts_lc_mtx_is_locked(erts_mtx_t *mtx) +{ +#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK) + int res; + erts_lc_lock_t lc = mtx->lc; + lc.flags = 0; + erts_lc_have_locks(&res, &lc, 1); + return res; +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_cnd_init(erts_cnd_t *cnd) +{ +#ifdef USE_THREADS + int res = ethr_cond_init(cnd); + if (res) + erts_thr_fatal_error(res, "initialize condition variable"); +#endif +} + +ERTS_GLB_INLINE void +erts_cnd_destroy(erts_cnd_t *cnd) +{ +#ifdef USE_THREADS + int res = ethr_cond_destroy(cnd); + if (res) + erts_thr_fatal_error(res, "destroy condition variable"); +#endif +} + +ERTS_GLB_INLINE void +erts_cnd_wait(erts_cnd_t *cnd, erts_mtx_t *mtx) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_unlock(&mtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock(&mtx->lcnt); +#endif + res = ethr_cond_wait(cnd, &mtx->mtx); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock(&mtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock(&mtx->lcnt); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post(&mtx->lcnt); +#endif + if (res != 0 && res != EINTR) + erts_thr_fatal_error(res, "wait on condition variable"); +#endif +} + +ERTS_GLB_INLINE void +erts_cnd_signal(erts_cnd_t *cnd) +{ +#ifdef USE_THREADS + int res = ethr_cond_signal(cnd); + if (res) + erts_thr_fatal_error(res, "signal on condition variable"); +#endif +} + + +ERTS_GLB_INLINE void +erts_cnd_broadcast(erts_cnd_t *cnd) +{ +#ifdef USE_THREADS + int res = ethr_cond_broadcast(cnd); + if (res) + erts_thr_fatal_error(res, "broadcast on condition variable"); +#endif +} + +/* rwmutex */ + +ERTS_GLB_INLINE void +erts_rwmtx_init_x(erts_rwmtx_t *rwmtx, char *name, Eterm extra) +{ +#ifdef USE_THREADS + int res = ethr_rwmutex_init(&rwmtx->rwmtx); + if (res != 0) + erts_thr_fatal_error(res, "initialize rwmutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock_x(&rwmtx->lc, name, ERTS_LC_FLG_LT_RWMUTEX, extra); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock_x(&rwmtx->lcnt, name, ERTS_LCNT_LT_RWMUTEX, extra); +#endif +#endif +} + +ERTS_GLB_INLINE void +erts_rwmtx_init(erts_rwmtx_t *rwmtx, char *name) +{ +#ifdef USE_THREADS + int res = ethr_rwmutex_init(&rwmtx->rwmtx); + if (res != 0) + erts_thr_fatal_error(res, "initialize rwmutex"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock(&rwmtx->lc, name, ERTS_LC_FLG_LT_RWMUTEX); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock(&rwmtx->lcnt, name, ERTS_LCNT_LT_RWMUTEX); +#endif +#endif +} + +ERTS_GLB_INLINE void +erts_rwmtx_destroy(erts_rwmtx_t *rwmtx) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_destroy_lock(&rwmtx->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_destroy_lock(&rwmtx->lcnt); +#endif + res = ethr_rwmutex_destroy(&rwmtx->rwmtx); + if (res != 0) + erts_thr_fatal_error(res, "destroy rwmutex"); +#endif +} + +ERTS_GLB_INLINE int +erts_rwmtx_tryrlock(erts_rwmtx_t *rwmtx) +{ +#ifdef USE_THREADS + int res; + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ)) + return EBUSY; /* Make sure caller can handle the situation without + causing a lock order violation */ +#endif + + res = ethr_rwmutex_tryrlock(&rwmtx->rwmtx); + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LCNT_LO_READ); +#endif + + if (res != 0 && res != EBUSY) + erts_thr_fatal_error(res, "try read lock rwmutex"); + + return res; +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_rwmtx_rlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line) +#else +erts_rwmtx_rlock(erts_rwmtx_t *rwmtx) +#endif +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ); +#endif + res = ethr_rwmutex_rlock(&rwmtx->rwmtx); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post_x(&rwmtx->lcnt, file, line); +#endif + if (res != 0) + erts_thr_fatal_error(res, "read lock rwmutex"); +#endif +} + +ERTS_GLB_INLINE void +erts_rwmtx_runlock(erts_rwmtx_t *rwmtx) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_unlock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ); +#endif + res = ethr_rwmutex_runlock(&rwmtx->rwmtx); + if (res != 0) + erts_thr_fatal_error(res, "read unlock rwmutex"); +#endif +} + + +ERTS_GLB_INLINE int +erts_rwmtx_tryrwlock(erts_rwmtx_t *rwmtx) +{ +#ifdef USE_THREADS + int res; + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (erts_lc_trylock_force_busy_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE)) + return EBUSY; /* Make sure caller can handle the situation without + causing a lock order violation */ +#endif + + res = ethr_rwmutex_tryrwlock(&rwmtx->rwmtx); + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_trylock_flg(res == 0, &rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_trylock_opt(&rwmtx->lcnt, res, ERTS_LCNT_LO_READ_WRITE); +#endif + + if (res != 0 && res != EBUSY) + erts_thr_fatal_error(res, "try write lock rwmutex"); + + return res; +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_rwmtx_rwlock_x(erts_rwmtx_t *rwmtx, char *file, unsigned int line) +#else +erts_rwmtx_rwlock(erts_rwmtx_t *rwmtx) +#endif +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ_WRITE); +#endif + res = ethr_rwmutex_rwlock(&rwmtx->rwmtx); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post_x(&rwmtx->lcnt, file, line); +#endif + if (res != 0) + erts_thr_fatal_error(res, "write lock rwmutex"); +#endif +} + +ERTS_GLB_INLINE void +erts_rwmtx_rwunlock(erts_rwmtx_t *rwmtx) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_unlock_flg(&rwmtx->lc, ERTS_LC_FLG_LO_READ_WRITE); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock_opt(&rwmtx->lcnt, ERTS_LCNT_LO_READ_WRITE); +#endif + res = ethr_rwmutex_rwunlock(&rwmtx->rwmtx); + if (res != 0) + erts_thr_fatal_error(res, "write unlock rwmutex"); +#endif +} + +#if 0 /* The following rwmtx function names are + reserved for potential future use. */ + +/* Try upgrade from r-locked state to rw-locked state */ +ERTS_GLB_INLINE int +erts_rwmtx_trywlock(erts_rwmtx_t *rwmtx) +{ + return 0; +} + +/* Upgrade from r-locked state to rw-locked state */ +ERTS_GLB_INLINE void +erts_rwmtx_wlock(erts_rwmtx_t *rwmtx) +{ + +} + +/* Downgrade from rw-locked state to r-locked state */ +ERTS_GLB_INLINE void +erts_rwmtx_wunlock(erts_rwmtx_t *rwmtx) +{ + +} + +#endif + +ERTS_GLB_INLINE int +erts_lc_rwmtx_is_rlocked(erts_rwmtx_t *mtx) +{ +#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK) + int res; + erts_lc_lock_t lc = mtx->lc; + lc.flags = ERTS_LC_FLG_LO_READ; + erts_lc_have_locks(&res, &lc, 1); + return res; +#else + return 0; +#endif +} + +ERTS_GLB_INLINE int +erts_lc_rwmtx_is_rwlocked(erts_rwmtx_t *mtx) +{ +#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK) + int res; + erts_lc_lock_t lc = mtx->lc; + lc.flags = ERTS_LC_FLG_LO_READ|ERTS_LC_FLG_LO_WRITE; + erts_lc_have_locks(&res, &lc, 1); + return res; +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_atomic_init(erts_atomic_t *var, long i) +{ +#ifdef USE_THREADS + int res = ethr_atomic_init(var, i); + if (res) + erts_thr_fatal_error(res, "perform atomic init"); +#else + *var = i; +#endif +} + +ERTS_GLB_INLINE void +erts_atomic_set(erts_atomic_t *var, long i) +{ +#ifdef USE_THREADS + int res = ethr_atomic_set(var, i); + if (res) + erts_thr_fatal_error(res, "perform atomic set"); +#else + *var = i; +#endif +} + +ERTS_GLB_INLINE long +erts_atomic_read(erts_atomic_t *var) +{ +#ifdef USE_THREADS + long i; + int res = ethr_atomic_read(var, &i); + if (res) + erts_thr_fatal_error(res, "perform atomic read"); + return i; +#else + return *var; +#endif +} + +ERTS_GLB_INLINE long +erts_atomic_inctest(erts_atomic_t *incp) +{ +#ifdef USE_THREADS + long test; + int res = ethr_atomic_inctest(incp, &test); + if (res) + erts_thr_fatal_error(res, "perform atomic increment and test"); + return test; +#else + return ++(*incp); +#endif +} + +ERTS_GLB_INLINE long +erts_atomic_dectest(erts_atomic_t *decp) +{ +#ifdef USE_THREADS + long test; + int res = ethr_atomic_dectest(decp, &test); + if (res) + erts_thr_fatal_error(res, "perform atomic decrement and test"); + return test; +#else + return --(*decp); +#endif +} + +ERTS_GLB_INLINE void +erts_atomic_inc(erts_atomic_t *incp) +{ +#ifdef USE_THREADS + int res = ethr_atomic_inc(incp); + if (res) + erts_thr_fatal_error(res, "perform atomic increment"); +#else + ++(*incp); +#endif +} + +ERTS_GLB_INLINE void +erts_atomic_dec(erts_atomic_t *decp) +{ +#ifdef USE_THREADS + int res = ethr_atomic_dec(decp); + if (res) + erts_thr_fatal_error(res, "perform atomic decrement"); +#else + --(*decp); +#endif +} + +ERTS_GLB_INLINE long +erts_atomic_addtest(erts_atomic_t *addp, long i) +{ +#ifdef USE_THREADS + long test; + int res = ethr_atomic_addtest(addp, i, &test); + if (res) + erts_thr_fatal_error(res, "perform atomic addition and test"); + return test; +#else + return *addp += i; +#endif +} + +ERTS_GLB_INLINE void +erts_atomic_add(erts_atomic_t *addp, long i) +{ +#ifdef USE_THREADS + int res = ethr_atomic_add(addp, i); + if (res) + erts_thr_fatal_error(res, "perform atomic addition"); +#else + *addp += i; +#endif +} + +ERTS_GLB_INLINE long +erts_atomic_xchg(erts_atomic_t *xchgp, long new) +{ + long old; +#ifdef USE_THREADS + int res = ethr_atomic_xchg(xchgp, new, &old); + if (res) + erts_thr_fatal_error(res, "perform atomic exchange"); +#else + old = *xchgp; + *xchgp = new; +#endif + return old; +} + +ERTS_GLB_INLINE long +erts_atomic_cmpxchg(erts_atomic_t *xchgp, long new, long expected) +{ +#ifdef USE_THREADS + long old; + int res = ethr_atomic_cmpxchg(xchgp, new, expected, &old); + if (ERTS_UNLIKELY(res != 0)) + erts_thr_fatal_error(res, "perform atomic exchange"); + return old; +#else + long old = *xchgp; + if (old == expected) + *xchgp = new; + return old; +#endif +} + +ERTS_GLB_INLINE long +erts_atomic_bor(erts_atomic_t *var, long mask) +{ + long old; +#ifdef USE_THREADS + int res = ethr_atomic_or_old(var, mask, &old); + if (res != 0) + erts_thr_fatal_error(res, "perform atomic bitwise or"); +#else + old = *var; + *var |= mask; +#endif + return old; +} + +ERTS_GLB_INLINE long +erts_atomic_band(erts_atomic_t *var, long mask) +{ + long old; +#ifdef USE_THREADS + int res = ethr_atomic_and_old(var, mask, &old); + if (res != 0) + erts_thr_fatal_error(res, "perform atomic bitwise and"); +#else + old = *var; + *var &= mask; +#endif + return old; +} + +/* spinlock */ + +ERTS_GLB_INLINE void +erts_spinlock_init_x(erts_spinlock_t *lock, char *name, Eterm extra) +{ +#ifdef USE_THREADS + int res = ethr_spinlock_init(&lock->slck); + if (res) + erts_thr_fatal_error(res, "init spinlock"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock_x(&lock->lc, name, ERTS_LC_FLG_LT_SPINLOCK, extra); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock_x(&lock->lcnt, name, ERTS_LCNT_LT_SPINLOCK, extra); +#endif +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_spinlock_init(erts_spinlock_t *lock, char *name) +{ +#ifdef USE_THREADS + int res = ethr_spinlock_init(&lock->slck); + if (res) + erts_thr_fatal_error(res, "init spinlock"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock(&lock->lc, name, ERTS_LC_FLG_LT_SPINLOCK); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock(&lock->lcnt, name, ERTS_LCNT_LT_SPINLOCK); +#endif +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_spinlock_destroy(erts_spinlock_t *lock) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_destroy_lock(&lock->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_destroy_lock(&lock->lcnt); +#endif + res = ethr_spinlock_destroy(&lock->slck); + if (res) + erts_thr_fatal_error(res, "destroy spinlock"); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_spin_unlock(erts_spinlock_t *lock) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_unlock(&lock->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock(&lock->lcnt); +#endif + res = ethr_spin_unlock(&lock->slck); + if (res) + erts_thr_fatal_error(res, "release spin lock"); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_spin_lock_x(erts_spinlock_t *lock, char *file, unsigned int line) +#else +erts_spin_lock(erts_spinlock_t *lock) +#endif +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock(&lock->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock(&lock->lcnt); +#endif + res = ethr_spin_lock(&lock->slck); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post_x(&lock->lcnt, file, line); +#endif + if (res) + erts_thr_fatal_error(res, "take spin lock"); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE int +erts_lc_spinlock_is_locked(erts_spinlock_t *lock) +{ +#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK) + int res; + erts_lc_lock_t lc = lock->lc; + lc.flags = 0; + erts_lc_have_locks(&res, &lc, 1); + return res; +#else + return 0; +#endif +} + +/* rwspinlock */ + +ERTS_GLB_INLINE void +erts_rwlock_init_x(erts_rwlock_t *lock, char *name, Eterm extra) +{ +#ifdef USE_THREADS + int res = ethr_rwlock_init(&lock->rwlck); + if (res) + erts_thr_fatal_error(res, "init rwlock"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock_x(&lock->lc, name, ERTS_LC_FLG_LT_RWSPINLOCK, extra); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock_x(&lock->lcnt, name, ERTS_LCNT_LT_RWSPINLOCK, extra); +#endif +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_rwlock_init(erts_rwlock_t *lock, char *name) +{ +#ifdef USE_THREADS + int res = ethr_rwlock_init(&lock->rwlck); + if (res) + erts_thr_fatal_error(res, "init rwlock"); +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_init_lock(&lock->lc, name, ERTS_LC_FLG_LT_RWSPINLOCK); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init_lock(&lock->lcnt, name, ERTS_LCNT_LT_RWSPINLOCK); +#endif +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_rwlock_destroy(erts_rwlock_t *lock) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_destroy_lock(&lock->lc); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_destroy_lock(&lock->lcnt); +#endif + res = ethr_rwlock_destroy(&lock->rwlck); + if (res) + erts_thr_fatal_error(res, "destroy rwlock"); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_read_unlock(erts_rwlock_t *lock) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_unlock_flg(&lock->lc, ERTS_LC_FLG_LO_READ); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LCNT_LO_READ); +#endif + res = ethr_read_unlock(&lock->rwlck); + if (res) + erts_thr_fatal_error(res, "release read lock"); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_read_lock_x(erts_rwlock_t *lock, char *file, unsigned int line) +#else +erts_read_lock(erts_rwlock_t *lock) +#endif +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock_flg(&lock->lc, ERTS_LC_FLG_LO_READ); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_opt(&lock->lcnt, ERTS_LCNT_LO_READ); +#endif + res = ethr_read_lock(&lock->rwlck); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post_x(&lock->lcnt, file, line); +#endif + if (res) + erts_thr_fatal_error(res, "take read lock"); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +erts_write_unlock(erts_rwlock_t *lock) +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_unlock_flg(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_unlock_opt(&lock->lcnt, ERTS_LCNT_LO_READ_WRITE); +#endif + res = ethr_write_unlock(&lock->rwlck); + if (res) + erts_thr_fatal_error(res, "release write lock"); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE void +#ifdef ERTS_ENABLE_LOCK_COUNT +erts_write_lock_x(erts_rwlock_t *lock, char *file, unsigned int line) +#else +erts_write_lock(erts_rwlock_t *lock) +#endif +{ +#ifdef USE_THREADS + int res; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_lock_flg(&lock->lc, ERTS_LC_FLG_LO_READ_WRITE); +#endif +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_opt(&lock->lcnt, ERTS_LCNT_LO_READ_WRITE); +#endif + res = ethr_write_lock(&lock->rwlck); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_lock_post_x(&lock->lcnt, file, line); +#endif + if (res) + erts_thr_fatal_error(res, "take write lock"); +#else + (void)lock; +#endif +} + +ERTS_GLB_INLINE int +erts_lc_rwlock_is_rlocked(erts_rwlock_t *lock) +{ +#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK) + int res; + erts_lc_lock_t lc = lock->lc; + lc.flags = ERTS_LC_FLG_LO_READ; + erts_lc_have_locks(&res, &lc, 1); + return res; +#else + return 0; +#endif +} + +ERTS_GLB_INLINE int +erts_lc_rwlock_is_rwlocked(erts_rwlock_t *lock) +{ +#if defined(USE_THREADS) && defined(ERTS_ENABLE_LOCK_CHECK) + int res; + erts_lc_lock_t lc = lock->lc; + lc.flags = ERTS_LC_FLG_LO_READ|ERTS_LC_FLG_LO_WRITE; + erts_lc_have_locks(&res, &lc, 1); + return res; +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_thr_time_now(erts_thr_timeval_t *time) +{ +#ifdef USE_THREADS + int res = ethr_time_now(time); + if (res) + erts_thr_fatal_error(res, "get current time"); +#endif +} + +ERTS_GLB_INLINE void +erts_tsd_key_create(erts_tsd_key_t *keyp) +{ +#ifdef USE_THREADS + int res = ethr_tsd_key_create(keyp); + if (res) + erts_thr_fatal_error(res, "create thread specific data key"); +#endif +} + +ERTS_GLB_INLINE void +erts_tsd_key_delete(erts_tsd_key_t key) +{ +#ifdef USE_THREADS + int res = ethr_tsd_key_delete(key); + if (res) + erts_thr_fatal_error(res, "delete thread specific data key"); +#endif +} + +ERTS_GLB_INLINE void +erts_tsd_set(erts_tsd_key_t key, void *value) +{ +#ifdef USE_THREADS + int res = ethr_tsd_set(key, value); + if (res) + erts_thr_fatal_error(res, "set thread specific data"); +#endif +} + +ERTS_GLB_INLINE void * +erts_tsd_get(erts_tsd_key_t key) +{ +#ifdef USE_THREADS + return ethr_tsd_get(key); +#else + return NULL; +#endif +} + +ERTS_GLB_INLINE void +erts_gate_init(erts_gate_t *gp) +{ +#ifdef USE_THREADS + int res = ethr_gate_init((ethr_gate *) gp); + if (res != 0) + erts_thr_fatal_error(res, "initialize gate"); +#endif +} + +ERTS_GLB_INLINE void +erts_gate_destroy(erts_gate_t *gp) +{ +#ifdef USE_THREADS + int res = ethr_gate_destroy((ethr_gate *) gp); + if (res != 0) + erts_thr_fatal_error(res, "destroy gate"); +#endif +} + +ERTS_GLB_INLINE void +erts_gate_close(erts_gate_t *gp) +{ +#ifdef USE_THREADS + int res = ethr_gate_close((ethr_gate *) gp); + if (res != 0) + erts_thr_fatal_error(res, "close gate"); +#endif +} + +ERTS_GLB_INLINE void +erts_gate_let_through(erts_gate_t *gp, unsigned no) +{ +#ifdef USE_THREADS + int res = ethr_gate_let_through((ethr_gate *) gp, no); + if (res != 0) + erts_thr_fatal_error(res, "let through gate"); +#endif +} + +ERTS_GLB_INLINE void +erts_gate_wait(erts_gate_t *gp) +{ +#ifdef USE_THREADS + int res = ethr_gate_wait((ethr_gate *) gp); + if (res != 0) + erts_thr_fatal_error(res, "wait on gate"); +#endif +} + +ERTS_GLB_INLINE void +erts_gate_swait(erts_gate_t *gp, int spincount) +{ +#ifdef USE_THREADS + int res = ethr_gate_swait((ethr_gate *) gp, spincount); + if (res != 0) + erts_thr_fatal_error(res, "swait on gate"); +#endif +} + +#ifdef ETHR_HAVE_ETHR_SIG_FUNCS + +ERTS_GLB_INLINE void +erts_thr_sigmask(int how, const sigset_t *set, sigset_t *oset) +{ +#ifdef USE_THREADS + int res = ethr_sigmask(how, set, oset); + if (res) + erts_thr_fatal_error(res, "get or set signal mask"); +#endif +} + +ERTS_GLB_INLINE void +erts_thr_sigwait(const sigset_t *set, int *sig) +{ +#ifdef USE_THREADS + int res; + do { + res = ethr_sigwait(set, sig); + } while (res == EINTR); + if (res) + erts_thr_fatal_error(res, "to wait for signal"); +#endif +} + +#endif /* #ifdef HAVE_ETHR_SIG_FUNCS */ + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* #ifndef ERL_THREAD_H__ */ diff --git a/erts/emulator/beam/erl_time.h b/erts/emulator/beam/erl_time.h new file mode 100644 index 0000000000..6f6b971d34 --- /dev/null +++ b/erts/emulator/beam/erl_time.h @@ -0,0 +1,67 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_TIME_H__ +#define ERL_TIME_H__ + +/* +** Timer entry: +*/ +typedef struct erl_timer { + struct erl_timer* next; /* next entry tiw slot or chain */ + Uint slot; /* slot in timer wheel */ + Uint count; /* number of loops remaining */ + int active; /* 1=activated, 0=deactivated */ + /* called when timeout */ + void (*timeout)(void*); + /* called when cancel (may be NULL) */ + void (*cancel)(void*); + void* arg; /* argument to timeout/cancel procs */ +} ErlTimer; + +typedef void (*ErlTimeoutProc)(void*); +typedef void (*ErlCancelProc)(void*); + +#ifdef ERTS_SMP + +/* + * Process and port timer + */ +typedef union ErtsSmpPTimer_ ErtsSmpPTimer; +union ErtsSmpPTimer_ { + struct { + ErlTimer tm; + Eterm id; + void (*timeout_func)(void*); + ErtsSmpPTimer **timer_ref; + Uint32 flags; + } timer; + ErtsSmpPTimer *next; +}; + + +void erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref, + Eterm id, + ErlTimeoutProc timeout_func, + Uint timeout); +void erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer); + +#endif + +#endif diff --git a/erts/emulator/beam/erl_time_sup.c b/erts/emulator/beam/erl_time_sup.c new file mode 100644 index 0000000000..76bfdecd9f --- /dev/null +++ b/erts/emulator/beam/erl_time_sup.c @@ -0,0 +1,899 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** Support routines for the timer wheel +** +** This code contains two strategies for dealing with +** date/time changes in the system. +** If the system has some kind of high resolution timer (HAVE_GETHRTIME), +** the high resolution timer is used to correct the time-of-day and the +** timeouts, the base source is the hrtimer, but at certain intervals the +** OS time-of-day is checked and if it is not within certain bounds, the +** delivered time gets slowly adjusted for each call until +** it corresponds to the system time (built-in adjtime...). +** The call gethrtime() is detected by autoconf on Unix, but other +** platforms may define it in erl_*_sys.h and implement +** their own high resolution timer. The high resolution timer +** strategy is (probably) best on all systems where the timer have +** a resolution higher or equal to gettimeofday (or what's implemented +** is sys_gettimeofday()). The actual resolution is the interesting thing, +** not the unit's thats used (i.e. on VxWorks, nanoseconds can be +** retrieved in terms of units, but the actual resolution is the same as +** for the clock ticks). +** If the systems best timer routine is kernel ticks returned from +** sys_times(), and the actual resolution of sys_gettimeofday() is +** better (like most unixes that does not have any realtime extensions), +** another strategy is used. The tolerant gettimeofday() corrects +** the value with respect to uptime (sys_times() return value) and checks +** for correction both when delivering timeticks and delivering nowtime. +** this strategy is slower, but accurate on systems without better timer +** routines. The kernel tick resolution is not enough to implement +** a gethrtime routine. On Linux and other non solaris unix-boxes the second +** strategy is used, on all other platforms we use the first. +** +** The following is expected (from sys.[ch] and erl_*_sys.h): +** +** 64 bit integers. So it is, and so it will be. +** +** sys_init_time(), will return the clock resolution in MS and +** that's about it. More could be added of course +** If the clock-rate is constant (i.e. 1 ms) one can define +** SYS_CLOCK_RESOLUTION (to 1), +** which makes erts_deliver_time/erts_time_remaining a bit faster. +** +** if HAVE_GETHRTIME is defined: +** sys_gethrtime() will return a SysHrTime (long long) representing +** nanoseconds, sys_init_hrtime() will do any initialization. +** else +** a long (64bit) integer type called Sint64 should be defined. +** +** sys_times() will return clock_ticks since start and +** fill in a SysTimes structure (struct tms). Instead of CLK_TCK, +** SYS_CLK_TCK is used to determine the resolution of kernel ticks. +** +** sys_gettimeofday() will take a SysTimeval (a struct timeval) as parameter +** and fill it in as gettimeofday(X,NULL). +** +*/ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" + +static erts_smp_mtx_t erts_timeofday_mtx; + +static SysTimeval inittv; /* Used everywhere, the initial time-of-day */ + +static SysTimes t_start; /* Used in elapsed_time_both */ +static SysTimeval gtv; /* Used in wall_clock_elapsed_time_both */ +static SysTimeval then; /* Used in get_now */ +static SysTimeval last_emu_time; /* Used in erts_get_emu_time() */ +SysTimeval erts_first_emu_time; /* Used in erts_get_emu_time() */ + + +#ifdef HAVE_GETHRTIME + +int erts_disable_tolerant_timeofday; + +static SysHrTime hr_init_time, hr_last_correction_check, + hr_correction, hr_last_time; + +static void init_tolerant_timeofday(void) +{ + /* Should be in sys.c */ +#if defined(HAVE_SYSCONF) && defined(_SC_NPROCESSORS_CONF) + if (sysconf(_SC_NPROCESSORS_CONF) > 1) { + char b[1024]; + int maj,min,build; + os_flavor(b,1024); + os_version(&maj,&min,&build); + if (!strcmp(b,"sunos") && maj <= 5 && min <= 7) { + erts_disable_tolerant_timeofday = 1; + } + } +#endif + hr_init_time = sys_gethrtime(); + hr_last_correction_check = hr_last_time = hr_init_time; + hr_correction = 0; +} + +static void get_tolerant_timeofday(SysTimeval *tv) +{ + SysHrTime diff_time, curr; + + if (erts_disable_tolerant_timeofday) { + sys_gettimeofday(tv); + return; + } + *tv = inittv; + diff_time = ((curr = sys_gethrtime()) + hr_correction - hr_init_time) / 1000; + + if (curr < hr_init_time) { + erl_exit(1,"Unexpected behaviour from operating system high " + "resolution timer"); + } + + if ((curr - hr_last_correction_check) / 1000 > 1000000) { + /* Check the correction need */ + SysHrTime tv_diff, diffdiff; + SysTimeval tmp; + int done = 0; + + sys_gettimeofday(&tmp); + tv_diff = ((SysHrTime) tmp.tv_sec) * 1000000 + tmp.tv_usec; + tv_diff -= ((SysHrTime) inittv.tv_sec) * 1000000 + inittv.tv_usec; + diffdiff = diff_time - tv_diff; + if (diffdiff > 10000) { + SysHrTime corr = (curr - hr_last_time) / 100; + if (corr / 1000 >= diffdiff) { + ++done; + hr_correction -= ((SysHrTime)diffdiff) * 1000; + } else { + hr_correction -= corr; + } + diff_time = (curr + hr_correction - hr_init_time) / 1000; + } else if (diffdiff < -10000) { + SysHrTime corr = (curr - hr_last_time) / 100; + if (corr / 1000 >= -diffdiff) { + ++done; + hr_correction -= ((SysHrTime)diffdiff) * 1000; + } else { + hr_correction += corr; + } + diff_time = (curr + hr_correction - hr_init_time) / 1000; + } else { + ++done; + } + if (done) { + hr_last_correction_check = curr; + } + } + tv->tv_sec += (int) (diff_time / ((SysHrTime) 1000000)); + tv->tv_usec += (int) (diff_time % ((SysHrTime) 1000000)); + if (tv->tv_usec >= 1000000) { + tv->tv_usec -= 1000000; + tv->tv_sec += 1; + } + hr_last_time = curr; +} + +#define correction (hr_correction/1000000) + +#else /* !HAVE_GETHRTIME */ +#if !defined(CORRECT_USING_TIMES) +#define init_tolerant_timeofday() +#define get_tolerant_timeofday(tvp) sys_gettimeofday(tvp) +#else + +typedef Sint64 Milli; + +static clock_t init_ct; +static Sint64 ct_wrap; +static Milli init_tv_m; +static Milli correction_supress; +static Milli last_ct_diff; +static Milli last_cc; +static clock_t last_ct; + +/* sys_times() might need to be wrapped and the values shifted (right) + a bit to cope with newer linux (2.5.*) kernels, this has to be taken care + of dynamically to start with, a special version that uses + the times() return value as a high resolution timer can be made + to fully utilize the faster ticks, like on windows, but for now, we'll + settle with this silly workaround */ +#ifdef ERTS_WRAP_SYS_TIMES +#define KERNEL_TICKS() (sys_times_wrap() & \ + ((1UL << ((sizeof(clock_t) * 8) - 1)) - 1)) +#else +SysTimes dummy_tms; + +#define KERNEL_TICKS() (sys_times(&dummy_tms) & \ + ((1UL << ((sizeof(clock_t) * 8) - 1)) - 1)) + +#endif + +static void init_tolerant_timeofday(void) +{ + last_ct = init_ct = KERNEL_TICKS(); + last_cc = 0; + init_tv_m = (((Milli) inittv.tv_sec) * 1000) + + (inittv.tv_usec / 1000); + ct_wrap = 0; + correction_supress = 0; +} + + +static void get_tolerant_timeofday(SysTimeval *tvp) +{ + clock_t current_ct; + SysTimeval current_tv; + Milli ct_diff; + Milli tv_diff; + Milli current_correction; + Milli act_correction; /* long shown to be too small */ + Milli max_adjust; + + if (erts_disable_tolerant_timeofday) { + sys_gettimeofday(tvp); + return; + } + +#ifdef ERTS_WRAP_SYS_TIMES +#define TICK_MS (1000 / SYS_CLK_TCK_WRAP) +#else +#define TICK_MS (1000 / SYS_CLK_TCK) +#endif + current_ct = KERNEL_TICKS(); + sys_gettimeofday(¤t_tv); + + /* I dont know if uptime can move some units backwards + on some systems, but I allow for small backward + jumps to avoid such problems if they exist...*/ + if (last_ct > 100 && current_ct < (last_ct - 100)) { + ct_wrap += ((Sint64) 1) << ((sizeof(clock_t) * 8) - 1); + } + last_ct = current_ct; + ct_diff = ((ct_wrap + current_ct) - init_ct) * TICK_MS; + + /* + * We will adjust the time in milliseconds and we allow for 1% + * adjustments, but if this function is called more often then every 100 + * millisecond (which is obviously possible), we will never adjust, so + * we accumulate small times by setting last_ct_diff iff max_adjust > 0 + */ + if ((max_adjust = (ct_diff - last_ct_diff)/100) > 0) + last_ct_diff = ct_diff; + + tv_diff = ((((Milli) current_tv.tv_sec) * 1000) + + (current_tv.tv_usec / 1000)) - init_tv_m; + + current_correction = ((ct_diff - tv_diff) / TICK_MS) * TICK_MS; /* trunc */ + + /* + * We allow the current_correction value to wobble a little, as it + * suffers from the low resolution of the kernel ticks. + * if it hasn't changed more than one tick in either direction, + * we will keep the old value. + */ + if ((last_cc > current_correction + TICK_MS) || + (last_cc < current_correction - TICK_MS)) { + last_cc = current_correction; + } else { + current_correction = last_cc; + } + + /* + * As time goes, we try to get the actual correction to 0, + * that is, make erlangs time correspond to the systems dito. + * The act correction is what we seem to need (current_correction) + * minus the correction suppression. The correction supression + * will change slowly (max 1% of elapsed time) but in millisecond steps. + */ + act_correction = current_correction - correction_supress; + if (max_adjust > 0) { + /* + * Here we slowly adjust erlangs time to correspond with the + * system time by changing the correction_supress variable. + * It can change max_adjust milliseconds which is 1% of elapsed time + */ + if (act_correction > 0) { + if (current_correction - correction_supress > max_adjust) { + correction_supress += max_adjust; + } else { + correction_supress = current_correction; + } + act_correction = current_correction - correction_supress; + } else if (act_correction < 0) { + if (correction_supress - current_correction > max_adjust) { + correction_supress -= max_adjust; + } else { + correction_supress = current_correction; + } + act_correction = current_correction - correction_supress; + } + } + /* + * The actual correction will correct the timeval so that system + * time warps gets smothed down. + */ + current_tv.tv_sec += act_correction / 1000; + current_tv.tv_usec += (act_correction % 1000) * 1000; + + if (current_tv.tv_usec >= 1000000) { + ++current_tv.tv_sec ; + current_tv.tv_usec -= 1000000; + } else if (current_tv.tv_usec < 0) { + --current_tv.tv_sec; + current_tv.tv_usec += 1000000; + } + *tvp = current_tv; +#undef TICK_MS +} + +#endif /* CORRECT_USING_TIMES */ +#endif /* !HAVE_GETHRTIME */ + +/* +** Why this? Well, most platforms have a constant clock resolution of 1, +** we dont want the deliver_time/time_remaining routines to waste +** time dividing and multiplying by/with a variable that's always one. +** so the return value of sys_init_time is ignored on those platforms. +*/ + +#ifndef SYS_CLOCK_RESOLUTION +static int clock_resolution; +#define CLOCK_RESOLUTION clock_resolution +#else +#define CLOCK_RESOLUTION SYS_CLOCK_RESOLUTION +#endif + +/* +** The clock resolution should really be the resolution of the +** time function in use, which on most platforms +** is 1. On VxWorks the resolution shold be +** the number of ticks per second (or 1, which would work nicely to). +** +** Setting lower resolutions is mostly interesting when timers are used +** instead of something like select. +*/ + +#if defined(ERTS_TIMER_THREAD) +static ERTS_INLINE void init_erts_deliver_time(const SysTimeval *inittv) { } +static ERTS_INLINE void do_erts_deliver_time(const SysTimeval *current) { } +#else +static SysTimeval last_delivered; + +static void init_erts_deliver_time(const SysTimeval *inittv) +{ + /* We set the initial values for deliver_time here */ + last_delivered = *inittv; + last_delivered.tv_usec = 1000 * (last_delivered.tv_usec / 1000); + /* ms resolution */ +} + +static void do_erts_deliver_time(const SysTimeval *current) +{ + SysTimeval cur_time; + long elapsed; + + /* calculate and deliver appropriate number of ticks */ + cur_time = *current; + cur_time.tv_usec = 1000 * (cur_time.tv_usec / 1000); /* ms resolution */ + elapsed = (1000 * (cur_time.tv_sec - last_delivered.tv_sec) + + (cur_time.tv_usec - last_delivered.tv_usec) / 1000) / + CLOCK_RESOLUTION; + + /* Sometimes the time jump backwards, + resulting in a negative elapsed time. We compensate for + this by simply pretend as if the time stood still. :) */ + + if (elapsed > 0) { + do_time_add(elapsed); + last_delivered = cur_time; + } +} +#endif + +int +erts_init_time_sup(void) +{ + erts_smp_mtx_init(&erts_timeofday_mtx, "timeofday"); + + last_emu_time.tv_sec = 0; + last_emu_time.tv_usec = 0; + +#ifndef SYS_CLOCK_RESOLUTION + clock_resolution = sys_init_time(); +#else + (void) sys_init_time(); +#endif + sys_gettimeofday(&inittv); + +#ifdef HAVE_GETHRTIME + sys_init_hrtime(); +#endif + init_tolerant_timeofday(); + + init_erts_deliver_time(&inittv); + gtv = inittv; + then.tv_sec = then.tv_usec = 0; + + erts_get_emu_time(&erts_first_emu_time); + + return CLOCK_RESOLUTION; +} +/* info functions */ + +void +elapsed_time_both(unsigned long *ms_user, unsigned long *ms_sys, + unsigned long *ms_user_diff, unsigned long *ms_sys_diff) +{ + unsigned long prev_total_user, prev_total_sys; + unsigned long total_user, total_sys; + SysTimes now; + + sys_times(&now); + total_user = (now.tms_utime * 1000) / SYS_CLK_TCK; + total_sys = (now.tms_stime * 1000) / SYS_CLK_TCK; + + if (ms_user != NULL) + *ms_user = total_user; + if (ms_sys != NULL) + *ms_sys = total_sys; + + erts_smp_mtx_lock(&erts_timeofday_mtx); + + prev_total_user = (t_start.tms_utime * 1000) / SYS_CLK_TCK; + prev_total_sys = (t_start.tms_stime * 1000) / SYS_CLK_TCK; + t_start = now; + + erts_smp_mtx_unlock(&erts_timeofday_mtx); + + if (ms_user_diff != NULL) + *ms_user_diff = total_user - prev_total_user; + + if (ms_sys_diff != NULL) + *ms_sys_diff = total_sys - prev_total_sys; +} + + +/* wall clock routines */ + +void +wall_clock_elapsed_time_both(unsigned long *ms_total, unsigned long *ms_diff) +{ + unsigned long prev_total; + SysTimeval tv; + + erts_smp_mtx_lock(&erts_timeofday_mtx); + + get_tolerant_timeofday(&tv); + + *ms_total = 1000 * (tv.tv_sec - inittv.tv_sec) + + (tv.tv_usec - inittv.tv_usec) / 1000; + + prev_total = 1000 * (gtv.tv_sec - inittv.tv_sec) + + (gtv.tv_usec - inittv.tv_usec) / 1000; + *ms_diff = *ms_total - prev_total; + gtv = tv; + + /* must sync the machine's idea of time here */ + do_erts_deliver_time(&tv); + + erts_smp_mtx_unlock(&erts_timeofday_mtx); +} + +/* get current time */ +void +get_time(int *hour, int *minute, int *second) +{ + time_t the_clock; + struct tm *tm; +#ifdef HAVE_LOCALTIME_R + struct tm tmbuf; +#endif + + the_clock = time((time_t *)0); +#ifdef HAVE_LOCALTIME_R + localtime_r(&the_clock, (tm = &tmbuf)); +#else + tm = localtime(&the_clock); +#endif + *hour = tm->tm_hour; + *minute = tm->tm_min; + *second = tm->tm_sec; +} + +/* get current date */ +void +get_date(int *year, int *month, int *day) +{ + time_t the_clock; + struct tm *tm; +#ifdef HAVE_LOCALTIME_R + struct tm tmbuf; +#endif + + + the_clock = time((time_t *)0); +#ifdef HAVE_LOCALTIME_R + localtime_r(&the_clock, (tm = &tmbuf)); +#else + tm = localtime(&the_clock); +#endif + *year = tm->tm_year + 1900; + *month = tm->tm_mon +1; + *day = tm->tm_mday; +} + +/* get localtime */ +void +get_localtime(int *year, int *month, int *day, + int *hour, int *minute, int *second) +{ + time_t the_clock; + struct tm *tm; +#ifdef HAVE_LOCALTIME_R + struct tm tmbuf; +#endif + + the_clock = time((time_t *)0); +#ifdef HAVE_LOCALTIME_R + localtime_r(&the_clock, (tm = &tmbuf)); +#else + tm = localtime(&the_clock); +#endif + *year = tm->tm_year + 1900; + *month = tm->tm_mon +1; + *day = tm->tm_mday; + *hour = tm->tm_hour; + *minute = tm->tm_min; + *second = tm->tm_sec; +} + + +/* get universaltime */ +void +get_universaltime(int *year, int *month, int *day, + int *hour, int *minute, int *second) +{ + time_t the_clock; + struct tm *tm; +#ifdef HAVE_GMTIME_R + struct tm tmbuf; +#endif + + the_clock = time((time_t *)0); +#ifdef HAVE_GMTIME_R + gmtime_r(&the_clock, (tm = &tmbuf)); +#else + tm = gmtime(&the_clock); +#endif + *year = tm->tm_year + 1900; + *month = tm->tm_mon +1; + *day = tm->tm_mday; + *hour = tm->tm_hour; + *minute = tm->tm_min; + *second = tm->tm_sec; +} + + +/* days in month = 1, 2, ..., 12 */ +static const int mdays[14] = {0, 31, 28, 31, 30, 31, 30, + 31, 31, 30, 31, 30, 31}; + +#define IN_RANGE(a,x,b) (((a) <= (x)) && ((x) <= (b))) +#define is_leap_year(y) (((((y) % 4) == 0) && \ + (((y) % 100) != 0)) || \ + (((y) % 400) == 0)) + +#define BASEYEAR 1970 + +/* + * gregday + * + * Returns the number of days since Jan 1, 1600, if year is + * greater of equal to 1600 , and month [1-12] and day [1-31] + * are within range. Otherwise it returns -1. + */ +static int long gregday(int year, int month, int day) +{ + int long ndays = 0; + int gyear, pyear, m; + + /* number of days in previous years */ + gyear = year - 1600; + if (gyear > 0) { + pyear = gyear - 1; + ndays = (pyear/4) - (pyear/100) + (pyear/400) + pyear*365 + 366; + } + /* number of days in all months preceeding month */ + for (m = 1; m < month; m++) + ndays += mdays[m]; + /* Extra day if leap year and March or later */ + if (is_leap_year(year) && (month > 2)) + ndays++; + ndays += day - 1; + return ndays - 135140; /* 135140 = Jan 1, 1970 */ +} + + + +int +local_to_univ(Sint *year, Sint *month, Sint *day, + Sint *hour, Sint *minute, Sint *second, int isdst) +{ + time_t the_clock; + struct tm *tm, t; +#ifdef HAVE_GMTIME_R + struct tm tmbuf; +#endif + + if (!(IN_RANGE(BASEYEAR, *year, INT_MAX - 1) && + IN_RANGE(1, *month, 12) && + IN_RANGE(1, *day, (mdays[*month] + + (*month == 2 + && (*year % 4 == 0) + && (*year % 100 != 0 || *year % 400 == 0)))) && + IN_RANGE(0, *hour, 23) && + IN_RANGE(0, *minute, 59) && + IN_RANGE(0, *second, 59))) { + return 0; + } + + t.tm_year = *year - 1900; + t.tm_mon = *month - 1; + t.tm_mday = *day; + t.tm_hour = *hour; + t.tm_min = *minute; + t.tm_sec = *second; + t.tm_isdst = isdst; + the_clock = mktime(&t); +#ifdef HAVE_GMTIME_R + gmtime_r(&the_clock, (tm = &tmbuf)); +#else + tm = gmtime(&the_clock); +#endif + *year = tm->tm_year + 1900; + *month = tm->tm_mon +1; + *day = tm->tm_mday; + *hour = tm->tm_hour; + *minute = tm->tm_min; + *second = tm->tm_sec; + return 1; +} + +int +univ_to_local(Sint *year, Sint *month, Sint *day, + Sint *hour, Sint *minute, Sint *second) +{ + time_t the_clock; + struct tm *tm; +#ifdef HAVE_LOCALTIME_R + struct tm tmbuf; +#endif + + if (!(IN_RANGE(BASEYEAR, *year, INT_MAX - 1) && + IN_RANGE(1, *month, 12) && + IN_RANGE(1, *day, (mdays[*month] + + (*month == 2 + && (*year % 4 == 0) + && (*year % 100 != 0 || *year % 400 == 0)))) && + IN_RANGE(0, *hour, 23) && + IN_RANGE(0, *minute, 59) && + IN_RANGE(0, *second, 59))) { + return 0; + } + + the_clock = *second + 60 * (*minute + 60 * (*hour + 24 * + gregday(*year, *month, *day))); +#ifdef HAVE_POSIX2TIME + /* + * Addition from OpenSource - affects FreeBSD. + * No valid test case /PaN + * + * leap-second correction performed + * if system is configured so; + * do nothing if not + * See FreeBSD 6.x and 7.x + * /usr/src/lib/libc/stdtime/localtime.c + * for the details + */ + the_clock = posix2time(the_clock); +#endif + +#ifdef HAVE_LOCALTIME_R + localtime_r(&the_clock, (tm = &tmbuf)); +#else + tm = localtime(&the_clock); +#endif + *year = tm->tm_year + 1900; + *month = tm->tm_mon +1; + *day = tm->tm_mday; + *hour = tm->tm_hour; + *minute = tm->tm_min; + *second = tm->tm_sec; + return 1; +} + + +/* get a timestamp */ +void +get_now(Uint* megasec, Uint* sec, Uint* microsec) +{ + SysTimeval now; + + erts_smp_mtx_lock(&erts_timeofday_mtx); + + get_tolerant_timeofday(&now); + do_erts_deliver_time(&now); + + /* Make sure time is later than last */ + if (then.tv_sec > now.tv_sec || + (then.tv_sec == now.tv_sec && then.tv_usec >= now.tv_usec)) { + now = then; + now.tv_usec++; + } + /* Check for carry from above + general reasonability */ + if (now.tv_usec >= 1000000) { + now.tv_usec = 0; + now.tv_sec++; + } + then = now; + + erts_smp_mtx_unlock(&erts_timeofday_mtx); + + *megasec = (Uint) (now.tv_sec / 1000000); + *sec = (Uint) (now.tv_sec % 1000000); + *microsec = (Uint) (now.tv_usec); +} + +void +get_sys_now(Uint* megasec, Uint* sec, Uint* microsec) +{ + SysTimeval now; + + erts_smp_mtx_lock(&erts_timeofday_mtx); + + sys_gettimeofday(&now); + + erts_smp_mtx_unlock(&erts_timeofday_mtx); + + *megasec = (Uint) (now.tv_sec / 1000000); + *sec = (Uint) (now.tv_sec % 1000000); + *microsec = (Uint) (now.tv_usec); +} + + +/* deliver elapsed *ticks* to the machine - takes a pointer + to a struct timeval representing current time (to save + a gettimeofday() where possible) or NULL */ + +#if !defined(ERTS_TIMER_THREAD) +void erts_deliver_time(void) { + SysTimeval now; + + erts_smp_mtx_lock(&erts_timeofday_mtx); + + get_tolerant_timeofday(&now); + do_erts_deliver_time(&now); + + erts_smp_mtx_unlock(&erts_timeofday_mtx); +} +#endif + +/* get *real* time (not ticks) remaining until next timeout - if there + isn't one, give a "long" time, that is guaranteed + to not cause overflow when we report elapsed time later on */ + +void erts_time_remaining(SysTimeval *rem_time) +{ + int ticks; +#if !defined(ERTS_TIMER_THREAD) + SysTimeval cur_time; +#endif + long elapsed; + + /* next_time() returns no of ticks to next timeout or -1 if none */ + + if ((ticks = next_time()) == -1) { + /* timer queue empty */ + /* this will cause at most 100000000 ticks */ + rem_time->tv_sec = 100000; + rem_time->tv_usec = 0; + } else { + /* next timeout after ticks ticks */ + ticks *= CLOCK_RESOLUTION; + +#if defined(ERTS_TIMER_THREAD) + elapsed = 0; +#else + erts_smp_mtx_lock(&erts_timeofday_mtx); + + get_tolerant_timeofday(&cur_time); + cur_time.tv_usec = 1000 * + (cur_time.tv_usec / 1000);/* ms resolution*/ + elapsed = 1000 * (cur_time.tv_sec - last_delivered.tv_sec) + + (cur_time.tv_usec - last_delivered.tv_usec) / 1000; + + erts_smp_mtx_unlock(&erts_timeofday_mtx); + + if (ticks <= elapsed) { /* Ooops, better hurry */ + rem_time->tv_sec = rem_time->tv_usec = 0; + return; + } +#endif + rem_time->tv_sec = (ticks - elapsed) / 1000; + rem_time->tv_usec = 1000 * ((ticks - elapsed) % 1000); + } +} + +void erts_get_timeval(SysTimeval *tv) +{ + erts_smp_mtx_lock(&erts_timeofday_mtx); + get_tolerant_timeofday(tv); + erts_smp_mtx_unlock(&erts_timeofday_mtx); +} + +long +erts_get_time(void) +{ + SysTimeval sys_tv; + + erts_smp_mtx_lock(&erts_timeofday_mtx); + + get_tolerant_timeofday(&sys_tv); + + erts_smp_mtx_unlock(&erts_timeofday_mtx); + + return sys_tv.tv_sec; +} + +#ifdef HAVE_ERTS_NOW_CPU +void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec) { + SysCpuTime t; + SysTimespec tp; + + sys_get_proc_cputime(t, tp); + *microsec = (Uint)(tp.tv_nsec / 1000); + t = (tp.tv_sec / 1000000); + *megasec = (Uint)(t % 1000000); + *sec = (Uint)(tp.tv_sec % 1000000); +} +#endif + + +/* + * erts_get_emu_time() is similar to get_now(). You will + * always get different times from erts_get_emu_time(), but they + * may equal a time from get_now(). + * + * erts_get_emu_time() is only used internally in the emulator in + * order to order emulator internal events. + */ + +void +erts_get_emu_time(SysTimeval *this_emu_time_p) +{ + erts_smp_mtx_lock(&erts_timeofday_mtx); + + get_tolerant_timeofday(this_emu_time_p); + + /* Make sure time is later than last */ + if (last_emu_time.tv_sec > this_emu_time_p->tv_sec || + (last_emu_time.tv_sec == this_emu_time_p->tv_sec + && last_emu_time.tv_usec >= this_emu_time_p->tv_usec)) { + *this_emu_time_p = last_emu_time; + this_emu_time_p->tv_usec++; + } + /* Check for carry from above + general reasonability */ + if (this_emu_time_p->tv_usec >= 1000000) { + this_emu_time_p->tv_usec = 0; + this_emu_time_p->tv_sec++; + } + + last_emu_time = *this_emu_time_p; + + erts_smp_mtx_unlock(&erts_timeofday_mtx); +} diff --git a/erts/emulator/beam/erl_trace.c b/erts/emulator/beam/erl_trace.c new file mode 100644 index 0000000000..2afb16fc52 --- /dev/null +++ b/erts/emulator/beam/erl_trace.c @@ -0,0 +1,3260 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Support functions for tracing. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "big.h" +#include "bif.h" +#include "dist.h" +#include "beam_bp.h" +#include "error.h" +#include "erl_binary.h" +#include "erl_bits.h" + +#if 0 +#define DEBUG_PRINTOUTS +#else +#undef DEBUG_PRINTOUTS +#endif + +extern Eterm beam_return_to_trace[1]; /* OpCode(i_return_to_trace) */ +extern Eterm beam_return_trace[1]; /* OpCode(i_return_trace) */ + +/* Pseudo export entries. Never filled in with data, only used to + yield unique pointers of the correct type. */ +Export exp_send, exp_receive, exp_timeout; + +static Eterm system_seq_tracer; +static Uint default_trace_flags; +static Eterm default_tracer; + +static Eterm system_monitor; +static Eterm system_profile; + +#ifdef HAVE_ERTS_NOW_CPU +int erts_cpu_timestamp; +#endif + +static erts_smp_mtx_t smq_mtx; +static erts_smp_mtx_t sys_trace_mtx; + +enum ErtsSysMsgType { + SYS_MSG_TYPE_UNDEFINED, + SYS_MSG_TYPE_TRACE, + SYS_MSG_TYPE_SEQTRACE, + SYS_MSG_TYPE_SYSMON, + SYS_MSG_TYPE_ERRLGR, + SYS_MSG_TYPE_PROC_MSG, + SYS_MSG_TYPE_SYSPROF +}; + +#ifdef ERTS_SMP +static void enqueue_sys_msg_unlocked(enum ErtsSysMsgType type, + Eterm from, + Eterm to, + Eterm msg, + ErlHeapFragment *bp); +static void enqueue_sys_msg(enum ErtsSysMsgType type, + Eterm from, + Eterm to, + Eterm msg, + ErlHeapFragment *bp); +static void init_sys_msg_dispatcher(void); +#endif + +void erts_init_trace(void) { + erts_smp_mtx_init(&sys_trace_mtx, "sys_tracers"); +#ifdef HAVE_ERTS_NOW_CPU + erts_cpu_timestamp = 0; +#endif + erts_bif_trace_init(); + erts_system_monitor_clear(NULL); + erts_system_profile_clear(NULL); + default_trace_flags = F_INITIAL_TRACE_FLAGS; + default_tracer = NIL; + system_seq_tracer = am_false; +#ifdef ERTS_SMP + init_sys_msg_dispatcher(); +#endif +} + +static Eterm system_seq_tracer; + +#ifdef ERTS_SMP +#define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, UNUSED) \ + (*(BPP) = new_message_buffer((SZ)), \ + *(OHPP) = &(*(BPP))->off_heap, \ + (*(BPP))->mem) +#else +#define ERTS_ALLOC_SYSMSG_HEAP(SZ, BPP, OHPP, RPP) \ + erts_alloc_message_heap((SZ), (BPP), (OHPP), (RPP), 0) +#endif + +#ifdef ERTS_SMP +#define ERTS_ENQ_TRACE_MSG(FPID, TPID, MSG, BP) \ +do { \ + ERTS_LC_ASSERT(erts_smp_lc_mtx_is_locked(&smq_mtx)); \ + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_TRACE, (FPID), (TPID), (MSG), (BP)); \ +} while(0) +#else +#define ERTS_ENQ_TRACE_MSG(FPID, TPROC, MSG, BP) \ + erts_queue_message((TPROC), NULL, (BP), (MSG), NIL) +#endif + +/* + * NOTE that the ERTS_GET_TRACER_REF() returns from the function (!!!) + * using it, and resets the parameters used if the tracer is invalid, i.e., + * use it with extreme care! + */ +#ifdef ERTS_SMP +#define ERTS_NULL_TRACER_REF NIL +#define ERTS_TRACER_REF_TYPE Eterm + /* In the smp case, we never find the tracer invalid here (the sys + message dispatcher thread takes care of that). */ +#define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \ +do { (RES) = (TPID); } while(0) +#else +#define ERTS_NULL_TRACER_REF NULL +#define ERTS_TRACER_REF_TYPE Process * +#define ERTS_GET_TRACER_REF(RES, TPID, TRACEE_FLGS) \ +do { \ + (RES) = process_tab[internal_pid_index((TPID))]; \ + if (INVALID_PID((RES), (TPID)) || !((RES)->trace_flags & F_TRACER)) { \ + (TPID) = NIL; \ + (TRACEE_FLGS) &= ~TRACEE_FLAGS; \ + return; \ + } \ +} while (0) +#endif + +static Uint active_sched; + +void +erts_system_profile_setup_active_schedulers(void) +{ + ERTS_SMP_LC_ASSERT(erts_is_system_blocked(0)); + active_sched = erts_active_schedulers(); +} + +void +erts_trace_check_exiting(Eterm exiting) +{ + erts_smp_mtx_lock(&sys_trace_mtx); + if (exiting == default_tracer) { + default_tracer = NIL; + default_trace_flags &= TRACEE_FLAGS; +#ifdef DEBUG + default_trace_flags |= F_INITIAL_TRACE_FLAGS; +#endif + } + if (exiting == system_seq_tracer) { +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "seq tracer %T exited\n", exiting); +#endif + system_seq_tracer = am_false; + } + if (exiting == system_monitor) { +#ifdef ERTS_SMP + system_monitor = NIL; + /* Let the trace message dispatcher clear flags, etc */ +#else + erts_system_monitor_clear(NULL); +#endif + } + if (exiting == system_profile) { +#ifdef ERTS_SMP + system_profile = NIL; + /* Let the trace message dispatcher clear flags, etc */ +#else + erts_system_profile_clear(NULL); +#endif + } + erts_smp_mtx_unlock(&sys_trace_mtx); +} + +Eterm +erts_set_system_seq_tracer(Process *c_p, ErtsProcLocks c_p_locks, Eterm new) +{ + Eterm old = THE_NON_VALUE; + + if (new != am_false) { + if (!erts_pid2proc(c_p, c_p_locks, new, 0) + && !erts_is_valid_tracer_port(new)) { + return old; + } + } + + erts_smp_mtx_lock(&sys_trace_mtx); + old = system_seq_tracer; + system_seq_tracer = new; + +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "set seq tracer new=%T old=%T\n", new, old); +#endif + erts_smp_mtx_unlock(&sys_trace_mtx); + return old; +} + +Eterm +erts_get_system_seq_tracer(void) +{ + Eterm st; + erts_smp_mtx_lock(&sys_trace_mtx); + st = system_seq_tracer; +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "get seq tracer %T\n", st); +#endif + erts_smp_mtx_unlock(&sys_trace_mtx); + return st; +} + +static ERTS_INLINE void +get_default_tracing(Uint *flagsp, Eterm *tracerp) +{ + if (!(default_trace_flags & TRACEE_FLAGS)) + default_tracer = NIL; + + if (is_nil(default_tracer)) { + default_trace_flags &= ~TRACEE_FLAGS; + } else if (is_internal_pid(default_tracer)) { + if (!erts_pid2proc(NULL, 0, default_tracer, 0)) { + reset_tracer: + default_trace_flags &= ~TRACEE_FLAGS; + default_tracer = NIL; + } + } else { + ASSERT(is_internal_port(default_tracer)); + if (!erts_is_valid_tracer_port(default_tracer)) + goto reset_tracer; + } + + if (flagsp) + *flagsp = default_trace_flags; + if (tracerp) + *tracerp = default_tracer; +} + +void +erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp) +{ + erts_smp_mtx_lock(&sys_trace_mtx); + if (flagsp) { + if (setflags) + default_trace_flags |= *flagsp; + else + default_trace_flags &= ~(*flagsp); + } + if (tracerp) + default_tracer = *tracerp; + get_default_tracing(flagsp, tracerp); + erts_smp_mtx_unlock(&sys_trace_mtx); +} + +void +erts_get_default_tracing(Uint *flagsp, Eterm *tracerp) +{ + erts_smp_mtx_lock(&sys_trace_mtx); + get_default_tracing(flagsp, tracerp); + erts_smp_mtx_unlock(&sys_trace_mtx); +} + +void +erts_set_system_monitor(Eterm monitor) +{ + erts_smp_mtx_lock(&sys_trace_mtx); + system_monitor = monitor; + erts_smp_mtx_unlock(&sys_trace_mtx); +} + +Eterm +erts_get_system_monitor(void) +{ + Eterm monitor; + erts_smp_mtx_lock(&sys_trace_mtx); + monitor = system_monitor; + erts_smp_mtx_unlock(&sys_trace_mtx); + return monitor; +} + +/* Performance monitoring */ +void erts_set_system_profile(Eterm profile) { + erts_smp_mtx_lock(&sys_trace_mtx); + system_profile = profile; + erts_smp_mtx_unlock(&sys_trace_mtx); +} + +Eterm +erts_get_system_profile(void) { + Eterm profile; + erts_smp_mtx_lock(&sys_trace_mtx); + profile = system_profile; + erts_smp_mtx_unlock(&sys_trace_mtx); + return profile; +} + + +#ifdef HAVE_ERTS_NOW_CPU +# define GET_NOW(m, s, u) \ +do { \ + if (erts_cpu_timestamp) \ + erts_get_now_cpu(m, s, u); \ + else \ + get_now(m, s, u); \ +} while (0) +#else +# define GET_NOW(m, s, u) do {get_now(m, s, u);} while (0) +#endif + + + +static Eterm* patch_ts(Eterm tuple4, Eterm* hp); + +#ifdef ERTS_SMP +static void +do_send_to_port(Eterm to, + Port* unused_port, + Eterm from, + enum ErtsSysMsgType type, + Eterm message) +{ + Uint sz = size_object(message); + ErlHeapFragment *bp = new_message_buffer(sz); + Uint *hp = bp->mem; + Eterm msg = copy_struct(message, sz, &hp, &bp->off_heap); + + enqueue_sys_msg_unlocked(type, from, to, msg, bp); +} + +#define WRITE_SYS_MSG_TO_PORT write_sys_msg_to_port +#else +#define WRITE_SYS_MSG_TO_PORT do_send_to_port +#endif + +static void +WRITE_SYS_MSG_TO_PORT(Eterm unused_to, + Port* trace_port, + Eterm unused_from, + enum ErtsSysMsgType unused_type, + Eterm message) { + byte *buffer; + byte *ptr; + unsigned size; + + size = erts_encode_ext_size(message); + buffer = (byte *) erts_alloc(ERTS_ALC_T_TMP, size); + + ptr = buffer; + + erts_encode_ext(message, &ptr); + if (!(ptr <= buffer+size)) { + erl_exit(1, "Internal error in do_send_to_port: %d\n", ptr-buffer); + } + +#ifndef ERTS_SMP + if (!INVALID_TRACER_PORT(trace_port, trace_port->id)) { +#endif + erts_raw_port_command(trace_port, buffer, ptr-buffer); +#ifndef ERTS_SMP + erts_port_release(trace_port); + } +#endif + + erts_free(ERTS_ALC_T_TMP, (void *) buffer); +} + + +#ifndef ERTS_SMP +/* Send {trace_ts, Pid, out, 0, Timestamp} + * followed by {trace_ts, Pid, in, 0, NewTimestamp} + * + * 'NewTimestamp' is fetched from GET_NOW() through patch_ts(). + */ +static void +do_send_schedfix_to_port(Port *trace_port, Eterm pid, Eterm timestamp) { + Eterm local_heap[4+5+5]; + Eterm message; + Eterm *hp; + Eterm mfarity; + + ASSERT(is_pid(pid)); + ASSERT(is_tuple(timestamp)); + ASSERT(*tuple_val(timestamp) == make_arityval(3)); + + hp = local_heap; + mfarity = make_small(0); + message = TUPLE5(hp, am_trace_ts, pid, am_out, mfarity, timestamp); + /* Note, hp is deliberately NOT incremented since it will be reused */ + + do_send_to_port(trace_port->id, + trace_port, + pid, + SYS_MSG_TYPE_UNDEFINED, + message); + + message = TUPLE4(hp, am_trace_ts, pid, am_in, mfarity); + hp += 5; + hp = patch_ts(message, hp); + + do_send_to_port(trace_port->id, + trace_port, + pid, + SYS_MSG_TYPE_UNDEFINED, + message); +} +#endif + +/* If (c_p != NULL), a fake schedule out/in message pair will be sent, + * if the driver so requests. + * It is assumed that 'message' is not an 'out' message. + * + * 'c_p' is the currently executing process, "tracee" is the traced process + * which 'message' concerns => if (*tracee_flags & F_TIMESTAMP), + * 'message' must contain a timestamp. + */ +static void +send_to_port(Process *c_p, Eterm message, + Eterm *tracer_pid, Uint *tracee_flags) { + Port* trace_port; +#ifndef ERTS_SMP + Eterm ts, local_heap[4], *hp; +#endif + + ASSERT(is_internal_port(*tracer_pid)); +#ifdef ERTS_SMP + if (is_not_internal_port(*tracer_pid)) + return; + + trace_port = NULL; +#else + if (is_not_internal_port(*tracer_pid)) + goto invalid_tracer_port; + + trace_port = &erts_port[internal_port_index(*tracer_pid)]; + + if (INVALID_TRACER_PORT(trace_port, *tracer_pid)) { + invalid_tracer_port: + *tracee_flags &= ~TRACEE_FLAGS; + *tracer_pid = NIL; + return; + } + + /* + * Make a fake schedule only if the current process is traced + * with 'running' and 'timestamp'. + */ + + if ( c_p == NULL || + (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) { +#endif + do_send_to_port(*tracer_pid, + trace_port, + c_p ? c_p->id : NIL, + SYS_MSG_TYPE_TRACE, + message); +#ifndef ERTS_SMP + return; + } + + /* + * Note that the process being traced for some type of trace messages + * (e.g. getting_linked) need not be the current process. That other + * process might not have timestamps enabled. + */ + if (*tracee_flags & F_TIMESTAMP) { + ASSERT(is_tuple(message)); + hp = tuple_val(message); + ts = hp[arityval(hp[0])]; + } else { + /* A fake schedule might be needed, + * but this message does not contain a timestamp. + * Create a dummy trace message with timestamp to be + * passed to do_send_schedfix_to_port(). + */ + Uint ms,s,us; + GET_NOW(&ms, &s, &us); + hp = local_heap; + ts = TUPLE3(hp, make_small(ms), make_small(s), make_small(us)); + hp += 4; + } + + trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; + do_send_to_port(*tracer_pid, + trace_port, + c_p ? c_p->id : NIL, + SYS_MSG_TYPE_TRACE, + message); + + if (trace_port->control_flags & PORT_CONTROL_FLAG_HEAVY) { + /* The driver has just informed us that the last write took a + * non-neglectible amount of time. + * + * We need to fake some trace messages to compensate for the time the + * current process had to sacrifice for the writing of the previous + * trace message. We pretend that the process got scheduled out + * just after writning the real trace message, and now gets scheduled + * in again. + */ + do_send_schedfix_to_port(trace_port, c_p->id, ts); + } +#endif +} + +#ifndef ERTS_SMP +/* Profile send + * Checks if profiler is port or process + * Eterm msg is local, need copying. + */ + +static void +profile_send(Eterm message) { + Uint sz = 0; + ErlHeapFragment *bp = NULL; + Uint *hp = NULL; + Eterm msg = NIL; + Process *profile_p = NULL; + ErlOffHeap *off_heap = NULL; + + Eterm profiler = erts_get_system_profile(); + + if (is_internal_port(profiler)) { + Port *profiler_port = NULL; + + /* not smp */ + + + profiler_port = &erts_port[internal_port_index(profiler)]; + + do_send_to_port(profiler, + profiler_port, + NIL, /* or current process->id */ + SYS_MSG_TYPE_SYSPROF, + message); + + } else { + ASSERT(is_internal_pid(profiler) + && internal_pid_index(profiler) < erts_max_processes); + + profile_p = process_tab[internal_pid_index(profiler)]; + + if (INVALID_PID(profile_p, profiler)) return; + + sz = size_object(message); + hp = erts_alloc_message_heap(sz, &bp, &off_heap, profile_p, 0); + msg = copy_struct(message, sz, &hp, &bp->off_heap); + + erts_queue_message(profile_p, NULL, bp, msg, NIL); + } +} + +#endif + + +/* A fake schedule out/in message pair will be sent, + * if the driver so requests. + * If (timestamp == NIL), one is fetched from GET_NOW(). + * + * 'c_p' is the currently executing process, may be NULL. + */ +static void +seq_trace_send_to_port(Process *c_p, + Eterm seq_tracer, + Eterm message, + Eterm timestamp) +{ + Port* trace_port; +#ifndef ERTS_SMP + Eterm ts, local_heap[4], *hp; +#endif + + ASSERT(is_internal_port(seq_tracer)); +#ifdef ERTS_SMP + if (is_not_internal_port(seq_tracer)) + return; + + trace_port = NULL; +#else + if (is_not_internal_port(seq_tracer)) + goto invalid_tracer_port; + + trace_port = &erts_port[internal_port_index(seq_tracer)]; + + if (INVALID_TRACER_PORT(trace_port, seq_tracer)) { + invalid_tracer_port: + system_seq_tracer = am_false; + return; + } + + if (c_p == NULL + || (! IS_TRACED_FL(c_p, F_TRACE_SCHED | F_TIMESTAMP))) { +#endif + do_send_to_port(seq_tracer, + trace_port, + c_p ? c_p->id : NIL, + SYS_MSG_TYPE_SEQTRACE, + message); + +#ifndef ERTS_SMP + return; + } + /* Make a fake schedule only if the current process is traced + * with 'running' and 'timestamp'. + */ + + if (timestamp != NIL) { + ts = timestamp; + } else { + /* A fake schedule might be needed, + * but this message does not contain a timestamp. + * Create a dummy trace message with timestamp to be + * passed to do_send_schedfix_to_port(). + */ + Uint ms,s,us; + GET_NOW(&ms, &s, &us); + hp = local_heap; + ts = TUPLE3(hp, make_small(ms), make_small(s), make_small(us)); + hp += 4; + } + + trace_port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; + do_send_to_port(seq_tracer, + trace_port, + c_p ? c_p->id : NIL, + SYS_MSG_TYPE_SEQTRACE, + message); + + if (trace_port->control_flags & PORT_CONTROL_FLAG_HEAVY) { + /* The driver has just informed us that the last write took a + * non-neglectible amount of time. + * + * We need to fake some trace messages to compensate for the time the + * current process had to sacrifice for the writing of the previous + * trace message. We pretend that the process got scheduled out + * just after writing the real trace message, and now gets scheduled + * in again. + */ + do_send_schedfix_to_port(trace_port, c_p->id, ts); + } +#endif +} + +#define TS_HEAP_WORDS 5 +#define TS_SIZE(p) (((p)->trace_flags & F_TIMESTAMP) ? TS_HEAP_WORDS : 0) + +/* + * Patch a timestamp into a tuple. The tuple must be the last thing + * built on the heap. + * + * Returns the new hp pointer. +*/ +static Eterm* +patch_ts(Eterm tuple, Eterm* hp) +{ + Uint ms, s, us; + Eterm* ptr = tuple_val(tuple); + int arity = arityval(*ptr); + + ASSERT((ptr+arity+1) == hp); + ptr[0] = make_arityval(arity+1); + ptr[1] = am_trace_ts; + GET_NOW(&ms, &s, &us); + *hp = TUPLE3(hp+1, make_small(ms), make_small(s), make_small(us)); + return hp+5; +} + +static ERTS_INLINE void +send_to_tracer(Process *tracee, + ERTS_TRACER_REF_TYPE tracer_ref, + Eterm msg, + Eterm **hpp, + ErlHeapFragment *bp, + int no_fake_sched) +{ + ERTS_SMP_LC_ASSERT(erts_proc_lc_my_proc_locks(tracee)); + + erts_smp_mtx_lock(&smq_mtx); + + if (tracee->trace_flags & F_TIMESTAMP) + *hpp = patch_ts(msg, *hpp); + + if (is_internal_pid(tracee->tracer_proc)) + ERTS_ENQ_TRACE_MSG(tracee->id, tracer_ref, msg, bp); + else { + ASSERT(is_internal_port(tracee->tracer_proc)); + send_to_port(no_fake_sched ? NULL : tracee, + msg, + &tracee->tracer_proc, + &tracee->trace_flags); + } + + erts_smp_mtx_unlock(&smq_mtx); + +} + +static void +trace_sched_aux(Process *p, Eterm what, int never_fake_sched) +{ + Eterm local_heap[5+4+1+TS_HEAP_WORDS]; + Eterm tmp, mess, *hp; + ErlHeapFragment *bp = NULL; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; + int sched_no, curr_func, to_port, no_fake_sched; + + if (is_nil(p->tracer_proc)) + return; + + no_fake_sched = never_fake_sched; + + switch (what) { + case am_out: + case am_out_exiting: + case am_out_exited: + no_fake_sched = 1; + break; + case am_in: + case am_in_exiting: + break; + default: + ASSERT(0); + break; + } + + sched_no = IS_TRACED_FL(p, F_TRACE_SCHED_NO); + to_port = is_internal_port(p->tracer_proc); + + if (!to_port) { + ASSERT(is_internal_pid(p->tracer_proc) + && internal_pid_index(p->tracer_proc) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, p->tracer_proc, p->trace_flags); + } + + if (ERTS_PROC_IS_EXITING(p) +#ifndef ERTS_SMP + || p->status == P_FREE +#endif + ) { + curr_func = 0; + } + else { + if (!p->current) + p->current = find_function_from_pc(p->i); + curr_func = p->current != NULL; + } + + if (to_port) + hp = &local_heap[0]; + else { + Uint size = 5; + if (curr_func) + size += 4; + if (sched_no) + size += 1; + size += TS_SIZE(p); + hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); + } + + if (!curr_func) { + tmp = make_small(0); + } else { + tmp = TUPLE3(hp,p->current[0],p->current[1],make_small(p->current[2])); + hp += 4; + } + + if (!sched_no) { + mess = TUPLE4(hp, am_trace, p->id, what, tmp); + hp += 5; + } + else { +#ifdef ERTS_SMP + Eterm sched_id = make_small(p->scheduler_data->no); +#else + Eterm sched_id = make_small(1); +#endif + mess = TUPLE5(hp, am_trace, p->id, what, sched_id, tmp); + hp += 6; + } + + send_to_tracer(p, tracer_ref, mess, &hp, bp, no_fake_sched); +} + +/* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp} + * or {trace, Pid, What, {Mod, Func, Arity}} + * + * where 'What' is supposed to be 'in', 'out', 'in_exiting', + * 'out_exiting', or 'out_exited'. + */ +void +trace_sched(Process *p, Eterm what) +{ + trace_sched_aux(p, what, 0); +} + +/* Send {trace_ts, Pid, Send, Msg, DestPid, Timestamp} + * or {trace, Pid, Send, Msg, DestPid} + * + * where 'Send' is 'send' or 'send_to_non_existing_process'. + */ +void +trace_send(Process *p, Eterm to, Eterm msg) +{ + Eterm operation; + unsigned sz_msg; + unsigned sz_to; + Eterm* hp; + Eterm mess; + + if (!ARE_TRACE_FLAGS_ON(p, F_TRACE_SEND)) { + return; + } + + operation = am_send; + if (is_internal_pid(to)) { + if (!erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, to, 0)) + goto send_to_non_existing_process; + } + else if(is_external_pid(to) + && external_pid_dist_entry(to) == erts_this_dist_entry) { + char *s; + send_to_non_existing_process: + s = "send_to_non_existing_process"; + operation = am_atom_put(s, sys_strlen(s)); + } + + if (is_internal_port(p->tracer_proc)) { + Eterm local_heap[11]; + hp = local_heap; + mess = TUPLE5(hp, am_trace, p->id, operation, msg, to); + hp += 6; + erts_smp_mtx_lock(&smq_mtx); + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + send_to_port(p, mess, &p->tracer_proc, &p->trace_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + Uint need; + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref; + + ASSERT(is_internal_pid(p->tracer_proc) + && internal_pid_index(p->tracer_proc) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, p->tracer_proc, p->trace_flags); + + sz_msg = size_object(msg); + sz_to = size_object(to); + need = sz_msg + sz_to + 6 + TS_SIZE(p); + + hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); + + to = copy_struct(to, + sz_to, + &hp, + off_heap); + msg = copy_struct(msg, + sz_msg, + &hp, + off_heap); + mess = TUPLE5(hp, am_trace, p->id/* Local pid */, operation, msg, to); + hp += 6; + + erts_smp_mtx_lock(&smq_mtx); + + if (p->trace_flags & F_TIMESTAMP) { + patch_ts(mess, hp); + } + + ERTS_ENQ_TRACE_MSG(p->id, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } +} + +/* Send {trace_ts, Pid, receive, Msg, Timestamp} + * or {trace, Pid, receive, Msg} + */ +void +trace_receive(Process *rp, Eterm msg) +{ + Eterm mess; + size_t sz_msg; + Eterm* hp; + + if (is_internal_port(rp->tracer_proc)) { + Eterm local_heap[10]; + hp = local_heap; + mess = TUPLE4(hp, am_trace, rp->id, am_receive, msg); + hp += 5; + erts_smp_mtx_lock(&smq_mtx); + if (rp->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + send_to_port(rp, mess, &rp->tracer_proc, &rp->trace_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + Uint hsz; + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref; + + ASSERT(is_internal_pid(rp->tracer_proc) + && internal_pid_index(rp->tracer_proc) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, rp->tracer_proc, rp->trace_flags); + + sz_msg = size_object(msg); + + hsz = sz_msg + 5 + TS_SIZE(rp); + + hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, tracer_ref); + + msg = copy_struct(msg, sz_msg, &hp, off_heap); + mess = TUPLE4(hp, am_trace, rp->id/* Local pid */, am_receive, msg); + hp += 5; + + erts_smp_mtx_lock(&smq_mtx); + + if (rp->trace_flags & F_TIMESTAMP) { + patch_ts(mess, hp); + } + + ERTS_ENQ_TRACE_MSG(rp->id, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } +} + +int +seq_trace_update_send(Process *p) +{ + Eterm seq_tracer = erts_get_system_seq_tracer(); + ASSERT((is_tuple(SEQ_TRACE_TOKEN(p)) || is_nil(SEQ_TRACE_TOKEN(p)))); + if ( (p->id == seq_tracer) || (SEQ_TRACE_TOKEN(p) == NIL)) + return 0; + + SEQ_TRACE_TOKEN_SENDER(p) = p->id; /* Internal pid */ + SEQ_TRACE_TOKEN_SERIAL(p) = + make_small(++(p -> seq_trace_clock)); + SEQ_TRACE_TOKEN_LASTCNT(p) = + make_small(p -> seq_trace_lastcnt); + return 1; +} + + +/* Send a sequential trace message to the sequential tracer. + * p is the caller (which contains the trace token), + * msg is the original message, type is trace type (SEQ_TRACE_SEND etc), + * and receiver is the receiver of the message. + * + * The message to be received by the sequential tracer is: + * + * TraceMsg = + * {seq_trace, Label, {Type, {Lastcnt, Serial}, Sender, Receiver, Msg} [,Timestamp] } + * + */ +void +seq_trace_output_generic(Eterm token, Eterm msg, Uint type, + Eterm receiver, Process *process, Eterm exitfrom) +{ + Eterm mess; + ErlHeapFragment* bp; + Eterm* hp; + Eterm label; + Eterm lastcnt_serial; + Eterm type_atom; + int sz_exit; + Eterm seq_tracer; + + seq_tracer = erts_get_system_seq_tracer(); + + ASSERT(is_tuple(token) || is_nil(token)); + if (SEQ_TRACE_T_SENDER(token) == seq_tracer || token == NIL || + (process && process->trace_flags & F_SENSITIVE)) { + return; + } + + switch (type) { + case SEQ_TRACE_SEND: type_atom = am_send; break; + case SEQ_TRACE_PRINT: type_atom = am_print; break; + case SEQ_TRACE_RECEIVE: type_atom = am_receive; break; + default: + erl_exit(1, "invalid type in seq_trace_output_generic: %d:\n", type); + return; /* To avoid warning */ + } + + if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & type) == 0) { + /* No flags set, nothing to do */ + return; + } + + if (seq_tracer == am_false) { + return; /* no need to send anything */ + } + + if (is_internal_port(seq_tracer)) { + Eterm local_heap[64]; + hp = local_heap; + label = SEQ_TRACE_T_LABEL(token); + lastcnt_serial = TUPLE2(hp, SEQ_TRACE_T_LASTCNT(token), + SEQ_TRACE_T_SERIAL(token)); + hp += 3; + if (exitfrom != NIL) { + msg = TUPLE3(hp, am_EXIT, exitfrom, msg); + hp += 4; + } + mess = TUPLE5(hp, type_atom, lastcnt_serial, SEQ_TRACE_T_SENDER(token), + receiver, msg); + hp += 6; + erts_smp_mtx_lock(&smq_mtx); + if ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) == 0) { + mess = TUPLE3(hp, am_seq_trace, label, mess); + seq_trace_send_to_port(NULL, seq_tracer, mess, NIL); + } else { + Uint ms,s,us,ts; + GET_NOW(&ms, &s, &us); + ts = TUPLE3(hp, make_small(ms),make_small(s), make_small(us)); + hp += 4; + mess = TUPLE4(hp, am_seq_trace, label, mess, ts); + seq_trace_send_to_port(process, seq_tracer, mess, ts); + } + erts_smp_mtx_unlock(&smq_mtx); + } else { +#ifndef ERTS_SMP + Process* tracer; +#endif + Eterm sender_copy; + Eterm receiver_copy; + Eterm m2; + Uint sz_label, sz_lastcnt_serial, sz_msg, sz_ts, sz_sender, + sz_exitfrom, sz_receiver; + + ASSERT(is_internal_pid(seq_tracer) + && internal_pid_index(seq_tracer) < erts_max_processes); + +#ifndef ERTS_SMP + + tracer = process_tab[internal_pid_index(seq_tracer)]; + if (INVALID_PID(tracer, tracer->id)) { + system_seq_tracer = am_false; + return; /* no need to send anything */ + } +#endif + if (receiver == seq_tracer) { + return; /* no need to send anything */ + } + + sz_label = size_object(SEQ_TRACE_T_LABEL(token)); + sz_sender = size_object(SEQ_TRACE_T_SENDER(token)); + sz_receiver = size_object(receiver); + sz_lastcnt_serial = 3; /* TUPLE2 */ + sz_msg = size_object(msg); + + sz_ts = ((unsigned_val(SEQ_TRACE_T_FLAGS(token)) & SEQ_TRACE_TIMESTAMP) ? + 5 : 0); + if (exitfrom != NIL) { + sz_exit = 4; /* create {'EXIT',exitfrom,msg} */ + sz_exitfrom = size_object(exitfrom); + } + else { + sz_exit = 0; + sz_exitfrom = 0; + } + bp = new_message_buffer(4 /* TUPLE3 */ + sz_ts + 6 /* TUPLE5 */ + + sz_lastcnt_serial + sz_label + sz_msg + + sz_exit + sz_exitfrom + + sz_sender + sz_receiver); + hp = bp->mem; + label = copy_struct(SEQ_TRACE_T_LABEL(token), sz_label, &hp, &bp->off_heap); + lastcnt_serial = TUPLE2(hp,SEQ_TRACE_T_LASTCNT(token),SEQ_TRACE_T_SERIAL(token)); + hp += 3; + m2 = copy_struct(msg, sz_msg, &hp, &bp->off_heap); + if (sz_exit) { + Eterm exitfrom_copy = copy_struct(exitfrom, + sz_exitfrom, + &hp, + &bp->off_heap); + m2 = TUPLE3(hp, am_EXIT, exitfrom_copy, m2); + hp += 4; + } + sender_copy = copy_struct(SEQ_TRACE_T_SENDER(token), + sz_sender, + &hp, + &bp->off_heap); + receiver_copy = copy_struct(receiver, + sz_receiver, + &hp, + &bp->off_heap); + mess = TUPLE5(hp, + type_atom, + lastcnt_serial, + sender_copy, + receiver_copy, + m2); + hp += 6; + + erts_smp_mtx_lock(&smq_mtx); + + if (sz_ts) {/* timestamp should be included */ + Uint ms,s,us,ts; + GET_NOW(&ms, &s, &us); + ts = TUPLE3(hp, make_small(ms),make_small(s), make_small(us)); + hp += 4; + mess = TUPLE4(hp, am_seq_trace, label, mess, ts); + } else { + mess = TUPLE3(hp, am_seq_trace, label, mess); + } + +#ifdef ERTS_SMP + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SEQTRACE, NIL, NIL, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); +#else + erts_queue_message(tracer, NULL, bp, mess, NIL); /* trace_token must be NIL here */ +#endif + } +} + +/* Send {trace_ts, Pid, return_to, {Mod, Func, Arity}, Timestamp} + * or {trace, Pid, return_to, {Mod, Func, Arity}} + */ +void +erts_trace_return_to(Process *p, Uint *pc) +{ + Eterm* hp; + Eterm mfa; + Eterm mess; + Eterm local_heap[4+5+5]; + + Eterm *code_ptr = find_function_from_pc(pc); + + hp = local_heap; + + if (!code_ptr) { + mfa = am_undefined; + } else { + mfa = TUPLE3(hp, code_ptr[0], code_ptr[1], make_small(code_ptr[2])); + hp += 4; + } + + mess = TUPLE4(hp, am_trace, p->id, am_return_to, mfa); + hp += 5; + + erts_smp_mtx_lock(&smq_mtx); + + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + if (is_internal_port(p->tracer_proc)) { + send_to_port(p, mess, &p->tracer_proc, &p->trace_flags); + } else { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref; + unsigned size; + + /* + * Find the tracer. + */ + ASSERT(is_internal_pid(p->tracer_proc) + && internal_pid_index(p->tracer_proc) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, p->tracer_proc, p->trace_flags); + + size = size_object(mess); + + hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); + + /* + * Copy the trace message into the buffer and enqueue it. + */ + mess = copy_struct(mess, size, &hp, off_heap); + ERTS_ENQ_TRACE_MSG(p->id, tracer_ref, mess, bp); + } + erts_smp_mtx_unlock(&smq_mtx); +} + + +/* Send {trace_ts, Pid, return_from, {Mod, Name, Arity}, Retval, Timestamp} + * or {trace, Pid, return_from, {Mod, Name, Arity}, Retval} + */ +void +erts_trace_return(Process* p, Eterm* fi, Eterm retval, Eterm *tracer_pid) +{ + Eterm* hp; + Eterm mfa; + Eterm mess; + Eterm mod, name; + int arity; + Uint meta_flags, *tracee_flags; +#ifdef ERTS_SMP + Eterm tracee; +#endif + + ASSERT(tracer_pid); + if (*tracer_pid == am_true) { + /* Breakpoint trace enabled without specifying tracer => + * use process tracer and flags + */ + tracer_pid = &p->tracer_proc; + } + if (is_nil(*tracer_pid)) { + /* Trace disabled */ + return; + } + ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); + if (*tracer_pid == p->id) { + /* Do not generate trace messages to oneself */ + return; + } + if (tracer_pid == &p->tracer_proc) { + /* Tracer specified in process structure => + * non-breakpoint trace => + * use process flags + */ + tracee_flags = &p->trace_flags; +#ifdef ERTS_SMP + tracee = p->id; +#endif + } else { + /* Tracer not specified in process structure => + * tracer specified in breakpoint => + * meta trace => + * use fixed flag set instead of process flags + */ + meta_flags = F_TRACE_CALLS | F_TIMESTAMP; + tracee_flags = &meta_flags; +#ifdef ERTS_SMP + tracee = NIL; +#endif + } + if (! (*tracee_flags & F_TRACE_CALLS)) { + return; + } + + mod = fi[0]; + name = fi[1]; + arity = fi[2]; + + if (is_internal_port(*tracer_pid)) { + Eterm local_heap[4+6+5]; + hp = local_heap; + mfa = TUPLE3(hp, mod, name, make_small(arity)); + hp += 4; + mess = TUPLE5(hp, am_trace, p->id, am_return_from, mfa, retval); + hp += 6; + erts_smp_mtx_lock(&smq_mtx); + if (*tracee_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + send_to_port(p, mess, tracer_pid, tracee_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref; + unsigned size; + unsigned retval_size; +#ifdef DEBUG + Eterm* limit; +#endif + + ASSERT(is_internal_pid(*tracer_pid) + && internal_pid_index(*tracer_pid) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags); + + retval_size = size_object(retval); + size = 6 + 4 + retval_size; + if (*tracee_flags & F_TIMESTAMP) { + size += 1+4; + } + + hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); +#ifdef DEBUG + limit = hp + size; +#endif + + /* + * Build the trace tuple and put it into receive queue of the tracer process. + */ + + mfa = TUPLE3(hp, mod, name, make_small(arity)); + hp += 4; + retval = copy_struct(retval, retval_size, &hp, off_heap); + mess = TUPLE5(hp, am_trace, p->id/* Local pid */, am_return_from, mfa, retval); + hp += 6; + + erts_smp_mtx_lock(&smq_mtx); + + if (*tracee_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + ASSERT(hp == limit); + + ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } +} + +/* Send {trace_ts, Pid, exception_from, {Mod, Name, Arity}, {Class,Value}, + * Timestamp} + * or {trace, Pid, exception_from, {Mod, Name, Arity}, {Class,Value}, + * Timestamp} + * + * Where Class is atomic but Value is any term. + */ +void +erts_trace_exception(Process* p, Eterm mfa[3], Eterm class, Eterm value, + Eterm *tracer_pid) +{ + Eterm* hp; + Eterm mfa_tuple; + Eterm cv; + Eterm mess; + Uint meta_flags, *tracee_flags; +#ifdef ERTS_SMP + Eterm tracee; +#endif + + ASSERT(tracer_pid); + if (*tracer_pid == am_true) { + /* Breakpoint trace enabled without specifying tracer => + * use process tracer and flags + */ + tracer_pid = &p->tracer_proc; + } + if (is_nil(*tracer_pid)) { + /* Trace disabled */ + return; + } + ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); + if (*tracer_pid == p->id) { + /* Do not generate trace messages to oneself */ + return; + } + if (tracer_pid == &p->tracer_proc) { + /* Tracer specified in process structure => + * non-breakpoint trace => + * use process flags + */ + tracee_flags = &p->trace_flags; +#ifdef ERTS_SMP + tracee = p->id; +#endif + if (! (*tracee_flags & F_TRACE_CALLS)) { + return; + } + } else { + /* Tracer not specified in process structure => + * tracer specified in breakpoint => + * meta trace => + * use fixed flag set instead of process flags + */ + meta_flags = F_TRACE_CALLS | F_TIMESTAMP; + tracee_flags = &meta_flags; +#ifdef ERTS_SMP + tracee = NIL; +#endif + } + + if (is_internal_port(*tracer_pid)) { + Eterm local_heap[4+3+6+5]; + hp = local_heap; + mfa_tuple = TUPLE3(hp, mfa[0], mfa[1], make_small(mfa[2])); + hp += 4; + cv = TUPLE2(hp, class, value); + hp += 3; + mess = TUPLE5(hp, am_trace, p->id, am_exception_from, mfa_tuple, cv); + hp += 6; + ASSERT((hp - local_heap)*sizeof(*hp) <= sizeof(local_heap)); + erts_smp_mtx_lock(&smq_mtx); + if (*tracee_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); /* hp += 5 */ + ASSERT((hp - local_heap)*sizeof(*hp) == sizeof(local_heap)); + } + send_to_port(p, mess, tracer_pid, tracee_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref; + unsigned size; + unsigned value_size; +#ifdef DEBUG + Eterm* limit; +#endif + + ASSERT(is_internal_pid(*tracer_pid) + && internal_pid_index(*tracer_pid) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, *tracer_pid, *tracee_flags); + + value_size = size_object(value); + size = 6 + 4 + 3 + value_size; + if (*tracee_flags & F_TIMESTAMP) { + size += 1+4; + } + + hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); +#ifdef DEBUG + limit = hp + size; +#endif + + /* + * Build the trace tuple and put it into receive queue of the tracer process. + */ + + mfa_tuple = TUPLE3(hp, mfa[0], mfa[1], make_small(mfa[2])); + hp += 4; + value = copy_struct(value, value_size, &hp, off_heap); + cv = TUPLE2(hp, class, value); + hp += 3; + mess = TUPLE5(hp, am_trace, p->id/* Local pid */, + am_exception_from, mfa_tuple, cv); + hp += 6; + + erts_smp_mtx_lock(&smq_mtx); + + if (*tracee_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + ASSERT(hp == limit); + + ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } +} + +/* + * This function implements the new call trace. + * + * Send {trace_ts, Pid, call, {Mod, Func, A}, PamResult, Timestamp} + * or {trace_ts, Pid, call, {Mod, Func, A}, Timestamp} + * or {trace, Pid, call, {Mod, Func, A}, PamResult} + * or {trace, Pid, call, {Mod, Func, A} + * + * where 'A' is arity or argument list depending on trace flag 'arity'. + * + * If *tracer_pid is am_true, it is a breakpoint trace that shall use + * the process tracer, if it is NIL no trace message is generated, + * if it is a pid or port we do a meta trace. + */ +Uint32 +erts_call_trace(Process* p, Eterm mfa[3], Binary *match_spec, + Eterm* args, int local, Eterm *tracer_pid) +{ + Eterm* hp; + Eterm mfa_tuple; + int arity; + int i; + Uint32 return_flags; + Eterm pam_result = am_true; + Eterm mess; + Uint meta_flags, *tracee_flags; +#ifdef ERTS_SMP + Eterm tracee; +#endif + Eterm transformed_args[MAX_ARG]; + ErlSubBin sub_bin_heap; + + ASSERT(tracer_pid); + if (*tracer_pid == am_true) { + /* Breakpoint trace enabled without specifying tracer => + * use process tracer and flags + */ + tracer_pid = &p->tracer_proc; + } + if (is_nil(*tracer_pid)) { + /* Trace disabled */ + return 0; + } + ASSERT(is_internal_pid(*tracer_pid) || is_internal_port(*tracer_pid)); + if (*tracer_pid == p->id) { + /* Do not generate trace messages to oneself */ + return 0; + } + if (tracer_pid == &p->tracer_proc) { + /* Tracer specified in process structure => + * non-breakpoint trace => + * use process flags + */ + tracee_flags = &p->trace_flags; +#ifdef ERTS_SMP + tracee = p->id; +#endif + } else { + /* Tracer not specified in process structure => + * tracer specified in breakpoint => + * meta trace => + * use fixed flag set instead of process flags + */ + if (p->trace_flags & F_SENSITIVE) { + /* No trace messages for sensitive processes. */ + return 0; + } + meta_flags = F_TRACE_CALLS | F_TIMESTAMP; + tracee_flags = &meta_flags; +#ifdef ERTS_SMP + tracee = NIL; +#endif + } + + /* + * Because of the delayed sub-binary creation optimization introduced in + * R12B, (at most) one of arguments can be a match context instead of + * a binary. Since we don't want to handle match contexts in utility functions + * such as size_object() and copy_struct(), we must make sure that we + * temporarily convert any match contexts to sub binaries. + */ + arity = mfa[2]; +#ifdef DEBUG + sub_bin_heap.thing_word = 0; +#endif + for (i = 0; i < arity; i++) { + Eterm arg = args[i]; + if (is_boxed(arg) && header_is_bin_matchstate(*boxed_val(arg))) { + ErlBinMatchState* ms = (ErlBinMatchState *) boxed_val(arg); + ErlBinMatchBuffer* mb = &ms->mb; + ErlSubBin* sb = &sub_bin_heap; + Uint bit_size; + + ASSERT(sub_bin_heap.thing_word == 0); /* At most one of match context */ + + bit_size = mb->size - mb->offset; + sb->thing_word = HEADER_SUB_BIN; + sb->size = BYTE_OFFSET(bit_size); + sb->bitsize = BIT_OFFSET(bit_size); + sb->offs = BYTE_OFFSET(mb->offset); + sb->bitoffs = BIT_OFFSET(mb->offset); + sb->is_writable = 0; + sb->orig = mb->orig; + + arg = make_binary(sb); + } + transformed_args[i] = arg; + } + args = transformed_args; + + if (is_internal_port(*tracer_pid)) { + Eterm local_heap[64+MAX_ARG]; + hp = local_heap; + + if (!erts_is_valid_tracer_port(*tracer_pid)) { +#ifdef ERTS_SMP + ASSERT(is_nil(tracee) || tracer_pid == &p->tracer_proc); + if (is_not_nil(tracee)) + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); +#endif + *tracee_flags &= ~TRACEE_FLAGS; + *tracer_pid = NIL; +#ifdef ERTS_SMP + if (is_not_nil(tracee)) + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); +#endif + return 0; + } + + /* + * If there is a PAM program, run it. Return if it fails. + * + * Some precedence rules: + * + * - No proc flags, e.g 'silent' or 'return_to' + * has any effect on meta trace. + * - The 'silent' process trace flag silences all call + * related messages, e.g 'call', 'return_to' and 'return_from'. + * - The {message,_} PAM function does not affect {return_trace}. + * - The {message,false} PAM function shall give the same + * 'call' trace message as no PAM match. + * - The {message,true} PAM function shall give the same + * 'call' trace message as a nonexistent PAM program. + */ + + /* BEGIN this code should be the same for port and pid trace */ + return_flags = 0; + if (match_spec) { + pam_result = erts_match_set_run(p, match_spec, args, arity, + &return_flags); + if (is_non_value(pam_result)) { + erts_match_set_release_result(p); + return 0; + } + } + if (tracee_flags == &meta_flags) { + /* Meta trace */ + if (pam_result == am_false) { + erts_match_set_release_result(p); + return return_flags; + } + } else { + /* Non-meta trace */ + if (*tracee_flags & F_TRACE_SILENT) { + erts_match_set_release_result(p); + return 0; + } + if (pam_result == am_false) { + erts_match_set_release_result(p); + return return_flags; + } + if (local && (*tracee_flags & F_TRACE_RETURN_TO)) { + return_flags |= MATCH_SET_RETURN_TO_TRACE; + } + } + /* END this code should be the same for port and pid trace */ + + /* + * Build the the {M,F,A} tuple in the local heap. + * (A is arguments or arity.) + */ + + if (*tracee_flags & F_TRACE_ARITY_ONLY) { + mfa_tuple = make_small(arity); + } else { + mfa_tuple = NIL; + for (i = arity-1; i >= 0; i--) { + mfa_tuple = CONS(hp, args[i], mfa_tuple); + hp += 2; + } + } + mfa_tuple = TUPLE3(hp, mfa[0], mfa[1], mfa_tuple); + hp += 4; + + /* + * Build the trace tuple and send it to the port. + */ + + mess = TUPLE4(hp, am_trace, p->id, am_call, mfa_tuple); + hp += 5; + if (pam_result != am_true) { + hp[-5] = make_arityval(5); + *hp++ = pam_result; + } + erts_smp_mtx_lock(&smq_mtx); + if (*tracee_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + send_to_port(p, mess, tracer_pid, tracee_flags); + erts_smp_mtx_unlock(&smq_mtx); + erts_match_set_release_result(p); + return *tracer_pid == NIL ? 0 : return_flags; + + } else { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + Process *tracer; + ERTS_TRACER_REF_TYPE tracer_ref; +#ifdef ERTS_SMP + Eterm tpid; +#endif + unsigned size; + unsigned sizes[MAX_ARG]; + unsigned pam_result_size = 0; + int invalid_tracer; +#ifdef DEBUG + Eterm* limit; +#endif + + ASSERT(is_internal_pid(*tracer_pid) + && internal_pid_index(*tracer_pid) < erts_max_processes); + + tracer = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, + *tracer_pid, ERTS_PROC_LOCK_STATUS); + if (!tracer) + invalid_tracer = 1; + else { + invalid_tracer = (tracer->trace_flags & F_TRACER) == 0; + erts_smp_proc_unlock(tracer, ERTS_PROC_LOCK_STATUS); + } + + if (invalid_tracer) { +#ifdef ERTS_SMP + ASSERT(is_nil(tracee) || tracer_pid == &p->tracer_proc); + if (is_not_nil(tracee)) + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); +#endif + *tracee_flags &= ~TRACEE_FLAGS; + *tracer_pid = NIL; +#ifdef ERTS_SMP + if (is_not_nil(tracee)) + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); +#endif + return 0; + } + +#ifdef ERTS_SMP + tpid = *tracer_pid; /* Need to save tracer pid, + since *tracer_pid might + be reset by erts_match_set_run() */ + tracer_ref = tpid; +#else + tracer_ref = tracer; +#endif + + /* + * If there is a PAM program, run it. Return if it fails. + * + * See the rules above in the port trace code. + */ + + /* BEGIN this code should be the same for port and pid trace */ + return_flags = 0; + if (match_spec) { + pam_result = erts_match_set_run(p, match_spec, args, arity, + &return_flags); + if (is_non_value(pam_result)) { + erts_match_set_release_result(p); + return 0; + } + } + if (tracee_flags == &meta_flags) { + /* Meta trace */ + if (pam_result == am_false) { + erts_match_set_release_result(p); + return return_flags; + } + } else { + /* Non-meta trace */ + if (*tracee_flags & F_TRACE_SILENT) { + erts_match_set_release_result(p); + return 0; + } + if (pam_result == am_false) { + erts_match_set_release_result(p); + return return_flags; + } + if (local && (*tracee_flags & F_TRACE_RETURN_TO)) { + return_flags |= MATCH_SET_RETURN_TO_TRACE; + } + } + /* END this code should be the same for port and pid trace */ + + /* + * Calculate number of words needed on heap. + */ + + size = 4 + 5; /* Trace tuple + MFA tuple. */ + if (! (*tracee_flags & F_TRACE_ARITY_ONLY)) { + size += 2*arity; + for (i = arity-1; i >= 0; i--) { + sizes[i] = size_object(args[i]); + size += sizes[i]; + } + } + if (*tracee_flags & F_TIMESTAMP) { + size += 1 + 4; + /* One element in trace tuple + timestamp tuple. */ + } + if (pam_result != am_true) { + pam_result_size = size_object(pam_result); + size += 1 + pam_result_size; + /* One element in trace tuple + term size. */ + } + + hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); +#ifdef DEBUG + limit = hp + size; +#endif + + /* + * Build the the {M,F,A} tuple in the message buffer. + * (A is arguments or arity.) + */ + + if (*tracee_flags & F_TRACE_ARITY_ONLY) { + mfa_tuple = make_small(arity); + } else { + mfa_tuple = NIL; + for (i = arity-1; i >= 0; i--) { + Eterm term = copy_struct(args[i], sizes[i], &hp, off_heap); + mfa_tuple = CONS(hp, term, mfa_tuple); + hp += 2; + } + } + mfa_tuple = TUPLE3(hp, mfa[0], mfa[1], mfa_tuple); + hp += 4; + + /* + * Copy the PAM result (if any) onto the heap. + */ + + if (pam_result != am_true) { + pam_result = copy_struct(pam_result, pam_result_size, &hp, off_heap); + } + + erts_match_set_release_result(p); + + /* + * Build the trace tuple and enqueue it. + */ + + mess = TUPLE4(hp, am_trace, p->id/* Local pid */, am_call, mfa_tuple); + hp += 5; + if (pam_result != am_true) { + hp[-5] = make_arityval(5); + *hp++ = pam_result; + } + + erts_smp_mtx_lock(&smq_mtx); + + if (*tracee_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + ASSERT(hp == limit); + ERTS_ENQ_TRACE_MSG(tracee, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + return return_flags; + } +} + +/* Sends trace message: + * {trace_ts, ProcessPid, What, Data, Timestamp} + * or {trace, ProcessPid, What, Data} + * + * 'what' must be atomic, 'data' may be a deep term. + * 'c_p' is the currently executing process, may be NULL. + * 't_p' is the traced process. + */ +void +trace_proc(Process *c_p, Process *t_p, Eterm what, Eterm data) +{ + Eterm mess; + Eterm* hp; + int need; + + if (is_internal_port(t_p->tracer_proc)) { + Eterm local_heap[5+5]; + hp = local_heap; + mess = TUPLE4(hp, am_trace, t_p->id, what, data); + hp += 5; + erts_smp_mtx_lock(&smq_mtx); + if (t_p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + send_to_port( +#ifndef ERTS_SMP + /* No fake schedule out and in again after an exit */ + what == am_exit ? NULL : c_p, +#else + /* Fake schedule out and in are never sent when smp enabled */ + c_p, +#endif + mess, &t_p->tracer_proc, &t_p->trace_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + Eterm tmp; + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref; + size_t sz_data; + + ASSERT(is_internal_pid(t_p->tracer_proc) + && internal_pid_index(t_p->tracer_proc) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, t_p->tracer_proc, t_p->trace_flags); + + sz_data = size_object(data); + + need = sz_data + 5 + TS_SIZE(t_p); + + hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); + + tmp = copy_struct(data, sz_data, &hp, off_heap); + mess = TUPLE4(hp, am_trace, t_p->id/* Local pid */, what, tmp); + hp += 5; + + erts_smp_mtx_lock(&smq_mtx); + + if (t_p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + ERTS_ENQ_TRACE_MSG(t_p->id, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } +} + + +/* Sends trace message: + * {trace_ts, ParentPid, spawn, ChildPid, {Mod, Func, Args}, Timestamp} + * or {trace, ParentPid, spawn, ChildPid, {Mod, Func, Args}} + * + * 'pid' is the ChildPid, 'mod' and 'func' must be atomic, + * and 'args' may be a deep term. + */ +void +trace_proc_spawn(Process *p, Eterm pid, + Eterm mod, Eterm func, Eterm args) +{ + Eterm mfa; + Eterm mess; + Eterm* hp; + + if (is_internal_port(p->tracer_proc)) { + Eterm local_heap[4+6+5]; + hp = local_heap; + mfa = TUPLE3(hp, mod, func, args); + hp += 4; + mess = TUPLE5(hp, am_trace, p->id, am_spawn, pid, mfa); + hp += 6; + erts_smp_mtx_lock(&smq_mtx); + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + send_to_port(p, mess, &p->tracer_proc, &p->trace_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + Eterm tmp; + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref; + size_t sz_args, sz_pid; + Uint need; + + ASSERT(is_internal_pid(p->tracer_proc) + && internal_pid_index(p->tracer_proc) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, p->tracer_proc, p->trace_flags); + + sz_args = size_object(args); + sz_pid = size_object(pid); + need = sz_args + 4 + 6 + TS_SIZE(p); + + hp = ERTS_ALLOC_SYSMSG_HEAP(need, &bp, &off_heap, tracer_ref); + + tmp = copy_struct(args, sz_args, &hp, off_heap); + mfa = TUPLE3(hp, mod, func, tmp); + hp += 4; + tmp = copy_struct(pid, sz_pid, &hp, off_heap); + mess = TUPLE5(hp, am_trace, p->id, am_spawn, tmp, mfa); + hp += 6; + + erts_smp_mtx_lock(&smq_mtx); + + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + ERTS_ENQ_TRACE_MSG(p->id, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } +} + +void save_calls(Process *p, Export *e) +{ + struct saved_calls *scb = ERTS_PROC_GET_SAVED_CALLS_BUF(p); + if (scb) { + Export **ct = &scb->ct[0]; + int len = scb->len; + + ct[scb->cur] = e; + if (++scb->cur >= len) + scb->cur = 0; + if (scb->n < len) + scb->n++; + } +} + +/* + * Entry point called by the trace wrap functions in erl_bif_wrap.c + * + * The trace wrap functions are themselves called through the export + * entries instead of the original BIF functions. + */ +Eterm +erts_bif_trace(int bif_index, Process* p, + Eterm arg1, Eterm arg2, Eterm arg3, Uint *I) +{ + Eterm result; + int meta = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_META); + + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + + if (!ARE_TRACE_FLAGS_ON(p, F_TRACE_CALLS) && (! meta)) { + /* Warning! This is an Optimization. + * + * If neither meta trace is active nor process trace flags then + * no tracing will occur. Doing the whole else branch will + * also do nothing, only slower. + */ + Eterm (*func)(Process*, Eterm, Eterm, Eterm, Uint*) = bif_table[bif_index].f; + result = func(p, arg1, arg2, arg3, I); + } else { + Eterm (*func)(Process*, Eterm, Eterm, Eterm, Uint*); + Export* ep = bif_export[bif_index]; + Uint32 flags = 0, flags_meta = 0; + int global = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_GLOBAL); + int local = !!(erts_bif_trace_flags[bif_index] & BIF_TRACE_AS_LOCAL); + Eterm meta_tracer_pid = NIL; + int applying = (I == &(ep->code[3])); /* Yup, the apply code for a bif + * is actually in the + * export entry */ + Eterm *cp = p->cp; + +#ifndef _OSE_ + Eterm args[3] = {arg1, arg2, arg3}; +#else + Eterm args[3]; + args[0] = arg1; + args[1] = arg2; + args[2] = arg3; +#endif + + /* + * Make continuation pointer OK, it is not during direct BIF calls, + * but it is correct during apply of bif. + */ + if (!applying) { + p->cp = I; + } + if (global || local) { + flags = erts_call_trace(p, ep->code, ep->match_prog_set, args, + local, &p->tracer_proc); + } + if (meta) { + flags_meta = erts_bif_mtrace(p, ep->code+3, args, local, + &meta_tracer_pid); + } + /* Restore original continuation pointer (if changed). */ + p->cp = cp; + + func = bif_table[bif_index].f; + + result = func(p, arg1, arg2, arg3, I); + + if (applying && (flags & MATCH_SET_RETURN_TO_TRACE)) { + Uint i_return_trace = beam_return_trace[0]; + Uint i_return_to_trace = beam_return_to_trace[0]; + Eterm *cpp; + /* Maybe advance cp to skip trace stack frames */ + for (cpp = p->stop; ; cp = cp_val(*cpp++)) { + ASSERT(is_CP((Eterm) cp)); + if (*cp_val((Eterm) cp) == i_return_trace) { + /* Skip stack frame variables */ + while (is_not_CP(*cpp)) cpp++; + cpp += 2; /* Skip return_trace parameters */ + } else if (*cp_val((Eterm) cp) == i_return_to_trace) { + /* A return_to trace message is going to be generated + * by normal means, so we do not have to. + */ + cp = NULL; + break; + } else break; + } + } + + /* Try to get these in the order + * they usually appear in normal code... */ + if (is_non_value(result)) { + Uint reason = p->freason; + if (reason != TRAP) { + Eterm class; + Eterm value = p->fvalue; + Eterm nocatch[3]; + /* Expand error value like in handle_error() */ + if (reason & EXF_ARGLIST) { + Eterm *tp; + ASSERT(is_tuple(value)); + tp = tuple_val(value); + value = tp[1]; + } + if ((reason & EXF_THROWN) && (p->catches <= 0)) { + value = TUPLE2(nocatch, am_nocatch, value); + reason = EXC_ERROR; + } + /* Note: expand_error_value() could theoretically + * allocate on the heap, but not for any error + * returned by a BIF, and it would do no harm, + * just be annoying. + */ + value = expand_error_value(p, reason, value); + class = exception_tag[GET_EXC_CLASS(reason)]; + + if (flags_meta & MATCH_SET_EXCEPTION_TRACE) { + erts_trace_exception(p, ep->code, class, value, + &meta_tracer_pid); + } + if (flags & MATCH_SET_EXCEPTION_TRACE) { + erts_trace_exception(p, ep->code, class, value, + &p->tracer_proc); + } + if ((flags & MATCH_SET_RETURN_TO_TRACE) && p->catches > 0) { + /* can only happen if(local)*/ + Eterm *ptr = p->stop; + ASSERT(is_CP(*ptr)); + ASSERT(ptr <= STACK_START(p)); + /* Search the nearest stack frame for a catch */ + while (++ptr < STACK_START(p)) { + if (is_CP(*ptr)) break; + if (is_catch(*ptr)) { + if (applying) { + /* Apply of BIF, cp is in calling function */ + if (cp) erts_trace_return_to(p, cp); + } else { + /* Direct bif call, I points into + * calling function */ + erts_trace_return_to(p, I); + } + } + } + } + if ((flags_meta|flags) & MATCH_SET_EXCEPTION_TRACE) { + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); + p->trace_flags |= F_EXCEPTION_TRACE; + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); + } + } + } else { + if (flags_meta & MATCH_SET_RX_TRACE) { + erts_trace_return(p, ep->code, result, &meta_tracer_pid); + } + /* MATCH_SET_RETURN_TO_TRACE cannot occur if(meta) */ + if (flags & MATCH_SET_RX_TRACE) { + erts_trace_return(p, ep->code, result, &p->tracer_proc); + } + if (flags & MATCH_SET_RETURN_TO_TRACE) { + /* can only happen if(local)*/ + if (applying) { + /* Apply of BIF, cp is in calling function */ + if (cp) erts_trace_return_to(p, cp); + } else { + /* Direct bif call, I points into calling function */ + erts_trace_return_to(p, I); + } + } + } + } + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(p); + return result; +} + +/* Sends trace message: + * {trace_ts, Pid, What, Msg, Timestamp} + * or {trace, Pid, What, Msg} + * + * where 'What' must be atomic and 'Msg' is: + * [{heap_size, HeapSize}, {old_heap_size, OldHeapSize}, + * {stack_size, StackSize}, {recent_size, RecentSize}, + * {mbuf_size, MbufSize}] + * + * where 'HeapSize', 'OldHeapSize', 'StackSize', 'RecentSize and 'MbufSize' + * are all small (atomic) integers. + */ +void +trace_gc(Process *p, Eterm what) +{ + ErlHeapFragment *bp = NULL; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref = ERTS_NULL_TRACER_REF; /* Initialized + to eliminate + compiler + warning */ + Eterm* hp; + Eterm msg = NIL; + Uint size; + Eterm tags[] = { + am_old_heap_block_size, + am_heap_block_size, + am_mbuf_size, + am_recent_size, + am_stack_size, + am_old_heap_size, + am_heap_size + }; + Uint values[] = { + OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, + HEAP_SIZE(p), + MBUF_SIZE(p), + HIGH_WATER(p) - HEAP_START(p), + STACK_START(p) - p->stop, + OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0, + HEAP_TOP(p) - HEAP_START(p) + }; + Eterm local_heap[(sizeof(values)/sizeof(Uint)) + *(2/*cons*/ + 3/*2-tuple*/ + BIG_UINT_HEAP_SIZE) + + 5/*4-tuple */ + TS_HEAP_WORDS]; +#ifdef DEBUG + Eterm* limit; +#endif + + ASSERT(sizeof(values)/sizeof(Uint) == sizeof(tags)/sizeof(Eterm)); + + if (is_internal_port(p->tracer_proc)) { + hp = local_heap; +#ifdef DEBUG + size = 0; + (void) erts_bld_atom_uint_2tup_list(NULL, + &size, + sizeof(values)/sizeof(Uint), + tags, + values); + size += 5/*4-tuple*/ + TS_SIZE(p); +#endif + } else { + ASSERT(is_internal_pid(p->tracer_proc) + && internal_pid_index(p->tracer_proc) < erts_max_processes); + + ERTS_GET_TRACER_REF(tracer_ref, p->tracer_proc, p->trace_flags); + + size = 0; + (void) erts_bld_atom_uint_2tup_list(NULL, + &size, + sizeof(values)/sizeof(Uint), + tags, + values); + size += 5/*4-tuple*/ + TS_SIZE(p); + + hp = ERTS_ALLOC_SYSMSG_HEAP(size, &bp, &off_heap, tracer_ref); + } + +#ifdef DEBUG + limit = hp + size; + ASSERT(size <= sizeof(local_heap)/sizeof(Eterm)); +#endif + + msg = erts_bld_atom_uint_2tup_list(&hp, + NULL, + sizeof(values)/sizeof(Uint), + tags, + values); + + msg = TUPLE4(hp, am_trace, p->id/* Local pid */, what, msg); + hp += 5; + + erts_smp_mtx_lock(&smq_mtx); + + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(msg, hp); + } + ASSERT(hp == limit); + if (is_internal_port(p->tracer_proc)) + send_to_port(p, msg, &p->tracer_proc, &p->trace_flags); + else + ERTS_ENQ_TRACE_MSG(p->id, tracer_ref, msg, bp); + erts_smp_mtx_unlock(&smq_mtx); +} + + + +void +monitor_long_gc(Process *p, Uint time) { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; +#ifndef ERTS_SMP + Process *monitor_p; +#endif + Uint hsz; + Eterm *hp, list, msg; + Eterm tags[] = { + am_timeout, + am_old_heap_block_size, + am_heap_block_size, + am_mbuf_size, + am_stack_size, + am_old_heap_size, + am_heap_size + }; + Eterm values[] = { + time, + OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, + HEAP_SIZE(p), + MBUF_SIZE(p), + STACK_START(p) - p->stop, + OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0, + HEAP_TOP(p) - HEAP_START(p) + }; +#ifdef DEBUG + Eterm *hp_end; +#endif + +#ifndef ERTS_SMP + ASSERT(is_internal_pid(system_monitor) + && internal_pid_index(system_monitor) < erts_max_processes); + monitor_p = process_tab[internal_pid_index(system_monitor)]; + if (INVALID_PID(monitor_p, system_monitor) || p == monitor_p) { + return; + } +#endif + + hsz = 0; + (void) erts_bld_atom_uint_2tup_list(NULL, + &hsz, + sizeof(values)/sizeof(Uint), + tags, + values); + hsz += 5 /* 4-tuple */; + + hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p); + +#ifdef DEBUG + hp_end = hp + hsz; +#endif + + list = erts_bld_atom_uint_2tup_list(&hp, + NULL, + sizeof(values)/sizeof(Uint), + tags, + values); + msg = TUPLE4(hp, am_monitor, p->id/* Local pid */, am_long_gc, list); + +#ifdef DEBUG + hp += 5 /* 4-tuple */; + ASSERT(hp == hp_end); +#endif + +#ifdef ERTS_SMP + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->id, NIL, msg, bp); +#else + erts_queue_message(monitor_p, NULL, bp, msg, NIL); +#endif +} + +void +monitor_large_heap(Process *p) { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; +#ifndef ERTS_SMP + Process *monitor_p; +#endif + Uint hsz; + Eterm *hp, list, msg; + Eterm tags[] = { + am_old_heap_block_size, + am_heap_block_size, + am_mbuf_size, + am_stack_size, + am_old_heap_size, + am_heap_size + }; + Uint values[] = { + OLD_HEAP(p) ? OLD_HEND(p) - OLD_HEAP(p) : 0, + HEAP_SIZE(p), + MBUF_SIZE(p), + STACK_START(p) - p->stop, + OLD_HEAP(p) ? OLD_HTOP(p) - OLD_HEAP(p) : 0, + HEAP_TOP(p) - HEAP_START(p) + }; +#ifdef DEBUG + Eterm *hp_end; +#endif + + +#ifndef ERTS_SMP + ASSERT(is_internal_pid(system_monitor) + && internal_pid_index(system_monitor) < erts_max_processes); + monitor_p = process_tab[internal_pid_index(system_monitor)]; + if (INVALID_PID(monitor_p, system_monitor) || p == monitor_p) { + return; + } +#endif + + hsz = 0; + (void) erts_bld_atom_uint_2tup_list(NULL, + &hsz, + sizeof(values)/sizeof(Uint), + tags, + values); + hsz += 5 /* 4-tuple */; + + hp = ERTS_ALLOC_SYSMSG_HEAP(hsz, &bp, &off_heap, monitor_p); + +#ifdef DEBUG + hp_end = hp + hsz; +#endif + + list = erts_bld_atom_uint_2tup_list(&hp, + NULL, + sizeof(values)/sizeof(Uint), + tags, + values); + msg = TUPLE4(hp, am_monitor, p->id/* Local pid */, am_large_heap, list); + +#ifdef DEBUG + hp += 5 /* 4-tuple */; + ASSERT(hp == hp_end); +#endif + +#ifdef ERTS_SMP + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->id, NIL, msg, bp); +#else + erts_queue_message(monitor_p, NULL, bp, msg, NIL); +#endif +} + +void +monitor_generic(Process *p, Eterm type, Eterm spec) { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; +#ifndef ERTS_SMP + Process *monitor_p; +#endif + Eterm *hp, msg; + +#ifndef ERTS_SMP + ASSERT(is_internal_pid(system_monitor) + && internal_pid_index(system_monitor) < erts_max_processes); + monitor_p = process_tab[internal_pid_index(system_monitor)]; + if (INVALID_PID(monitor_p, system_monitor) || p == monitor_p) { + return; + } +#endif + + hp = ERTS_ALLOC_SYSMSG_HEAP(5, &bp, &off_heap, monitor_p); + + msg = TUPLE4(hp, am_monitor, p->id/* Local pid */, type, spec); + hp += 5; + +#ifdef ERTS_SMP + enqueue_sys_msg(SYS_MSG_TYPE_SYSMON, p->id, NIL, msg, bp); +#else + erts_queue_message(monitor_p, NULL, bp, msg, NIL); +#endif + +} + + +/* Begin system_profile tracing */ +/* Scheduler profiling */ + +void +profile_scheduler(Eterm scheduler_id, Eterm state) { + Eterm *hp, msg, timestamp; + Uint Ms, s, us; + +#ifndef ERTS_SMP + Eterm local_heap[4 + 7]; + hp = local_heap; +#else + ErlHeapFragment *bp; + Uint hsz; + + hsz = 4 + 7; + + bp = new_message_buffer(hsz); + hp = bp->mem; +#endif + + erts_smp_mtx_lock(&smq_mtx); + + switch (state) { + case am_active: + active_sched++; + break; + case am_inactive: + active_sched--; + break; + default: + ASSERT(!"Invalid state"); + break; + } + + GET_NOW(&Ms, &s, &us); + timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; + msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state, + make_small(active_sched), timestamp); hp += 7; + +#ifndef ERTS_SMP + profile_send(msg); +#else + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp); +#endif + erts_smp_mtx_unlock(&smq_mtx); + +} + +void +profile_scheduler_q(Eterm scheduler_id, Eterm state, Eterm no_schedulers, Uint Ms, Uint s, Uint us) { + Eterm *hp, msg, timestamp; + +#ifndef ERTS_SMP + Eterm local_heap[4 + 7]; + hp = local_heap; +#else + ErlHeapFragment *bp; + Uint hsz; + + hsz = 4 + 7; + + bp = new_message_buffer(hsz); + hp = bp->mem; +#endif + + erts_smp_mtx_lock(&smq_mtx); + + timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; + msg = TUPLE6(hp, am_profile, am_scheduler, scheduler_id, state, no_schedulers, timestamp); hp += 7; +#ifndef ERTS_SMP + profile_send(msg); +#else + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp); +#endif + erts_smp_mtx_unlock(&smq_mtx); + +} + + +/* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp} + * or {trace, Pid, What, {Mod, Func, Arity}} + * + * where 'What' is supposed to be 'in' or 'out'. + * + * Virtual scheduling do not fake scheduling for ports. + */ + + +void trace_virtual_sched(Process *p, Eterm what) +{ + trace_sched_aux(p, what, 1); +} + +/* Port profiling */ + +void +trace_port_open(Port *p, Eterm calling_pid, Eterm drv_name) { + Eterm mess; + Eterm* hp; + + if (is_internal_port(p->tracer_proc)) { + Eterm local_heap[5+6]; + hp = local_heap; + + mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->id, drv_name); + hp += 6; + erts_smp_mtx_lock(&smq_mtx); + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + /* No fake schedule */ + send_to_port(NULL, mess, &p->tracer_proc, &p->trace_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + size_t sz_data; + ERTS_TRACER_REF_TYPE tracer_ref; + + ASSERT(is_internal_pid(p->tracer_proc) + && internal_pid_index(p->tracer_proc) < erts_max_processes); + + sz_data = 6 + TS_SIZE(p); + + ERTS_GET_TRACER_REF(tracer_ref, p->tracer_proc, p->trace_flags); + + hp = ERTS_ALLOC_SYSMSG_HEAP(sz_data, &bp, &off_heap, tracer_ref); + + mess = TUPLE5(hp, am_trace, calling_pid, am_open, p->id, drv_name); + hp += 6; + + erts_smp_mtx_lock(&smq_mtx); + + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + ERTS_ENQ_TRACE_MSG(p->id, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } + +} + +/* Sends trace message: + * {trace_ts, PortPid, What, Data, Timestamp} + * or {trace, PortPid, What, Data} + * + * 'what' must be atomic, 'data' must be atomic. + * 't_p' is the traced port. + */ +void +trace_port(Port *t_p, Eterm what, Eterm data) { + Eterm mess; + Eterm* hp; + + if (is_internal_port(t_p->tracer_proc)) { + Eterm local_heap[5+5]; + hp = local_heap; + mess = TUPLE4(hp, am_trace, t_p->id, what, data); + hp += 5; + erts_smp_mtx_lock(&smq_mtx); + if (t_p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + /* No fake schedule */ + send_to_port(NULL, mess, &t_p->tracer_proc, &t_p->trace_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + size_t sz_data; + ERTS_TRACER_REF_TYPE tracer_ref; + + ASSERT(is_internal_pid(t_p->tracer_proc) + && internal_pid_index(t_p->tracer_proc) < erts_max_processes); + + sz_data = 5 + TS_SIZE(t_p); + + ERTS_GET_TRACER_REF(tracer_ref, t_p->tracer_proc, t_p->trace_flags); + + hp = ERTS_ALLOC_SYSMSG_HEAP(sz_data, &bp, &off_heap, tracer_ref); + + mess = TUPLE4(hp, am_trace, t_p->id, what, data); + hp += 5; + + erts_smp_mtx_lock(&smq_mtx); + + if (t_p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + ERTS_ENQ_TRACE_MSG(t_p->id, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } +} + +/* Send {trace_ts, Pid, What, {Mod, Func, Arity}, Timestamp} + * or {trace, Pid, What, {Mod, Func, Arity}} + * + * where 'What' is supposed to be 'in' or 'out' and + * where 'where' is supposed to be location (callback) + * for the port. + */ + +void +trace_sched_ports(Port *p, Eterm what) { + trace_sched_ports_where(p,what, make_small(0)); +} + +void +trace_sched_ports_where(Port *p, Eterm what, Eterm where) { + Eterm mess; + Eterm* hp; + int ws = 5; + Eterm sched_id = am_undefined; + + if (is_internal_port(p->tracer_proc)) { + Eterm local_heap[5+6]; + hp = local_heap; + + if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) { +#ifdef ERTS_SMP + ErtsSchedulerData *esd = erts_get_scheduler_data(); + if (esd) sched_id = make_small(esd->no); + else sched_id = am_undefined; +#else + sched_id = make_small(1); +#endif + mess = TUPLE5(hp, am_trace, p->id, what, sched_id, where); + ws = 6; + } else { + mess = TUPLE4(hp, am_trace, p->id, what, where); + ws = 5; + } + hp += ws; + + erts_smp_mtx_lock(&smq_mtx); + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + /* No fake scheduling */ + send_to_port(NULL, mess, &p->tracer_proc, &p->trace_flags); + erts_smp_mtx_unlock(&smq_mtx); + } else { + ErlHeapFragment *bp; + ErlOffHeap *off_heap; + ERTS_TRACER_REF_TYPE tracer_ref; + + ASSERT(is_internal_pid(p->tracer_proc) + && internal_pid_index(p->tracer_proc) < erts_max_processes); + + if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) ws = 6; /* Make place for scheduler id */ + + ERTS_GET_TRACER_REF(tracer_ref, p->tracer_proc, p->trace_flags); + + hp = ERTS_ALLOC_SYSMSG_HEAP(ws+TS_SIZE(p), &bp, &off_heap, tracer_ref); + + if (IS_TRACED_FL(p, F_TRACE_SCHED_NO)) { +#ifdef ERTS_SMP + ErtsSchedulerData *esd = erts_get_scheduler_data(); + if (esd) sched_id = make_small(esd->no); + else sched_id = am_undefined; +#else + sched_id = make_small(1); +#endif + mess = TUPLE5(hp, am_trace, p->id, what, sched_id, where); + } else { + mess = TUPLE4(hp, am_trace, p->id, what, where); + } + hp += ws; + + erts_smp_mtx_lock(&smq_mtx); + + if (p->trace_flags & F_TIMESTAMP) { + hp = patch_ts(mess, hp); + } + + ERTS_ENQ_TRACE_MSG(p->id, tracer_ref, mess, bp); + erts_smp_mtx_unlock(&smq_mtx); + } +} + +/* Port profiling */ + +void +profile_runnable_port(Port *p, Eterm status) { + Uint Ms, s, us; + Eterm *hp, msg, timestamp; + + Eterm count = make_small(0); + +#ifndef ERTS_SMP + Eterm local_heap[4 + 6]; + hp = local_heap; + +#else + ErlHeapFragment *bp; + Uint hsz; + + hsz = 4 + 6; + + bp = new_message_buffer(hsz); + hp = bp->mem; +#endif + + erts_smp_mtx_lock(&smq_mtx); + + GET_NOW(&Ms, &s, &us); + timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; + msg = TUPLE5(hp, am_profile, p->id, status, count, timestamp); hp += 6; + +#ifndef ERTS_SMP + profile_send(msg); +#else + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp); +#endif + erts_smp_mtx_unlock(&smq_mtx); +} + +/* Process profiling */ +void +profile_runnable_proc(Process *p, Eterm status){ + Uint Ms, s, us; + Eterm *hp, msg, timestamp; + Eterm where = am_undefined; + +#ifndef ERTS_SMP + Eterm local_heap[4 + 6 + 4]; + hp = local_heap; +#else + ErlHeapFragment *bp; + Uint hsz = 4 + 6 + 4; +#endif + + if (!p->current) { + p->current = find_function_from_pc(p->i); + } + +#ifdef ERTS_SMP + if (!p->current) { + hsz = 4 + 6; + } + + bp = new_message_buffer(hsz); + hp = bp->mem; +#endif + + if (p->current) { + where = TUPLE3(hp, p->current[0], p->current[1], make_small(p->current[2])); hp += 4; + } else { + where = make_small(0); + } + + erts_smp_mtx_lock(&smq_mtx); + + GET_NOW(&Ms, &s, &us); + timestamp = TUPLE3(hp, make_small(Ms), make_small(s), make_small(us)); hp += 4; + msg = TUPLE5(hp, am_profile, p->id, status, where, timestamp); hp += 6; +#ifndef ERTS_SMP + profile_send(msg); +#else + enqueue_sys_msg_unlocked(SYS_MSG_TYPE_SYSPROF, NIL, NIL, msg, bp); +#endif + erts_smp_mtx_unlock(&smq_mtx); +} +/* End system_profile tracing */ + + + +#ifdef ERTS_SMP + +void +erts_check_my_tracer_proc(Process *p) +{ + if (is_internal_pid(p->tracer_proc)) { + Process *tracer = erts_pid2proc(p, ERTS_PROC_LOCK_MAIN, + p->tracer_proc, ERTS_PROC_LOCK_STATUS); + int invalid_tracer = !tracer || !(tracer->trace_flags & F_TRACER); + if (tracer) + erts_smp_proc_unlock(tracer, ERTS_PROC_LOCK_STATUS); + if (invalid_tracer) { + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_ALL_MINOR); + p->trace_flags &= ~TRACEE_FLAGS; + p->tracer_proc = NIL; + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_ALL_MINOR); + } + } +} + + +typedef struct ErtsSysMsgQ_ ErtsSysMsgQ; +struct ErtsSysMsgQ_ { + ErtsSysMsgQ *next; + enum ErtsSysMsgType type; + Eterm from; + Eterm to; + Eterm msg; + ErlHeapFragment *bp; +}; + +static ErtsSysMsgQ *sys_message_queue; +static ErtsSysMsgQ *sys_message_queue_end; + +static erts_tid_t sys_msg_dispatcher_tid; +static erts_cnd_t smq_cnd; + +static int dispatcher_waiting; + +ERTS_QUALLOC_IMPL(smq_element, ErtsSysMsgQ, 20, ERTS_ALC_T_SYS_MSG_Q) + +static void +enqueue_sys_msg_unlocked(enum ErtsSysMsgType type, + Eterm from, + Eterm to, + Eterm msg, + ErlHeapFragment *bp) +{ + ErtsSysMsgQ *smqp; + + smqp = smq_element_alloc(); + smqp->next = NULL; + smqp->type = type; + smqp->from = from; + smqp->to = to; + smqp->msg = msg; + smqp->bp = bp; + + if (sys_message_queue_end) { + ASSERT(sys_message_queue); + sys_message_queue_end->next = smqp; + } + else { + ASSERT(!sys_message_queue); + sys_message_queue = smqp; + } + sys_message_queue_end = smqp; + erts_smp_cnd_signal(&smq_cnd); +} + +static void +enqueue_sys_msg(enum ErtsSysMsgType type, + Eterm from, + Eterm to, + Eterm msg, + ErlHeapFragment *bp) +{ + erts_smp_mtx_lock(&smq_mtx); + enqueue_sys_msg_unlocked(type, from, to, msg, bp); + erts_smp_mtx_unlock(&smq_mtx); +} + +static void +prepare_for_block(void *unused) +{ + erts_smp_mtx_unlock(&smq_mtx); +} + +static void +resume_after_block(void *unused) +{ + erts_smp_mtx_lock(&smq_mtx); +} + +void +erts_queue_error_logger_message(Eterm from, Eterm msg, ErlHeapFragment *bp) +{ + enqueue_sys_msg(SYS_MSG_TYPE_ERRLGR, from, am_error_logger, msg, bp); +} + +void +erts_send_sys_msg_proc(Eterm from, Eterm to, Eterm msg, ErlHeapFragment *bp) +{ + ASSERT(is_internal_pid(to)); + enqueue_sys_msg(SYS_MSG_TYPE_PROC_MSG, from, to, msg, bp); +} + +#ifdef DEBUG_PRINTOUTS +static void +print_msg_type(ErtsSysMsgQ *smqp) +{ + switch (smqp->type) { + case SYS_MSG_TYPE_TRACE: + erts_fprintf(stderr, "TRACE "); + break; + case SYS_MSG_TYPE_SEQTRACE: + erts_fprintf(stderr, "SEQTRACE "); + break; + case SYS_MSG_TYPE_SYSMON: + erts_fprintf(stderr, "SYSMON "); + break; + case SYS_MSG_TYPE_SYSPROF: + erts_fprintf(stderr, "SYSPROF "); + break; + case SYS_MSG_TYPE_ERRLGR: + erts_fprintf(stderr, "ERRLGR "); + break; + case SYS_MSG_TYPE_PROC_MSG: + erts_fprintf(stderr, "PROC_MSG "); + break; + default: + erts_fprintf(stderr, "??? "); + break; + } +} +#endif + +static void +sys_msg_disp_failure(ErtsSysMsgQ *smqp, Eterm receiver) +{ + switch (smqp->type) { + case SYS_MSG_TYPE_TRACE: + /* Invalid tracer_proc's are removed when processes + are scheduled in. */ + break; + case SYS_MSG_TYPE_SEQTRACE: + /* Reset seq_tracer if it hasn't changed */ + erts_smp_mtx_lock(&sys_trace_mtx); + if (system_seq_tracer == receiver) + system_seq_tracer = am_false; + erts_smp_mtx_unlock(&sys_trace_mtx); + break; + case SYS_MSG_TYPE_SYSMON: + if (receiver == NIL + && !erts_system_monitor_long_gc + && !erts_system_monitor_large_heap + && !erts_system_monitor_flags.busy_port + && !erts_system_monitor_flags.busy_dist_port) + break; /* Everything is disabled */ + erts_smp_block_system(ERTS_BS_FLG_ALLOW_GC); + if (system_monitor == receiver || receiver == NIL) + erts_system_monitor_clear(NULL); + erts_smp_release_system(); + break; + case SYS_MSG_TYPE_SYSPROF: + if (receiver == NIL + && !erts_system_profile_flags.runnable_procs + && !erts_system_profile_flags.runnable_ports + && !erts_system_profile_flags.exclusive + && !erts_system_profile_flags.scheduler) + break; + /* Block system to clear flags */ + erts_smp_block_system(0); + if (system_profile == receiver || receiver == NIL) { + erts_system_profile_clear(NULL); + } + erts_smp_release_system(); + break; + case SYS_MSG_TYPE_ERRLGR: { + char *no_elgger = "(no error logger present)"; + Eterm *tp; + Eterm tag; + if (is_not_tuple(smqp->msg)) { + unexpected_elmsg: + erts_fprintf(stderr, + "%s unexpected error logger message: %T\n", + no_elgger, + smqp->msg); + } + + tp = tuple_val(smqp->msg); + if (arityval(tp[0]) != 2) + goto unexpected_elmsg; + if (is_not_tuple(tp[2])) + goto unexpected_elmsg; + tp = tuple_val(tp[2]); + if (arityval(tp[0]) != 3) + goto unexpected_elmsg; + tag = tp[1]; + if (is_not_tuple(tp[3])) + goto unexpected_elmsg; + tp = tuple_val(tp[3]); + if (arityval(tp[0]) != 3) + goto unexpected_elmsg; + if (is_not_list(tp[3])) + goto unexpected_elmsg; + erts_fprintf(stderr, "%s %T: %T\n", + no_elgger, tag, CAR(list_val(tp[3]))); + break; + } + case SYS_MSG_TYPE_PROC_MSG: + break; + default: + ASSERT(0); + } +} + +static void * +sys_msg_dispatcher_func(void *unused) +{ + ErtsSysMsgQ *local_sys_message_queue = NULL; + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_set_thread_name("system message dispatcher"); +#endif + + erts_register_blockable_thread(); + erts_smp_activity_begin(ERTS_ACTIVITY_IO, NULL, NULL, NULL); + + while (1) { + ErtsSysMsgQ *smqp; + + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + + erts_smp_mtx_lock(&smq_mtx); + + /* Free previously used queue ... */ + while (local_sys_message_queue) { + smqp = local_sys_message_queue; + local_sys_message_queue = smqp->next; + smq_element_free(smqp); + } + + /* Fetch current trace message queue ... */ + erts_smp_activity_change(ERTS_ACTIVITY_IO, + ERTS_ACTIVITY_WAIT, + prepare_for_block, + resume_after_block, + NULL); + dispatcher_waiting = 1; + while (!sys_message_queue) + erts_smp_cnd_wait(&smq_cnd, &smq_mtx); + dispatcher_waiting = 0; + erts_smp_activity_change(ERTS_ACTIVITY_WAIT, + ERTS_ACTIVITY_IO, + prepare_for_block, + resume_after_block, + NULL); + + local_sys_message_queue = sys_message_queue; + sys_message_queue = NULL; + sys_message_queue_end = NULL; + + erts_smp_mtx_unlock(&smq_mtx); + + /* Send trace messages ... */ + + ASSERT(local_sys_message_queue); + + for (smqp = local_sys_message_queue; smqp; smqp = smqp->next) { + Eterm receiver; + ErtsProcLocks proc_locks = ERTS_PROC_LOCKS_MSG_SEND; + Process *proc = NULL; + Port *port = NULL; + +#ifdef DEBUG_PRINTOUTS + print_msg_type(smqp); +#endif + switch (smqp->type) { + case SYS_MSG_TYPE_TRACE: + case SYS_MSG_TYPE_PROC_MSG: + receiver = smqp->to; + break; + case SYS_MSG_TYPE_SEQTRACE: + receiver = erts_get_system_seq_tracer(); + break; + case SYS_MSG_TYPE_SYSMON: + receiver = erts_get_system_monitor(); + if (smqp->from == receiver) { +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "MSG=%T to %T... ", + smqp->msg, receiver); +#endif + goto drop_sys_msg; + } + break; + case SYS_MSG_TYPE_SYSPROF: + receiver = erts_get_system_profile(); + if (smqp->from == receiver) { +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "MSG=%T to %T... ", + smqp->msg, receiver); +#endif + goto drop_sys_msg; + } + break; + case SYS_MSG_TYPE_ERRLGR: + receiver = am_error_logger; + break; + default: + receiver = NIL; + break; + } + +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "MSG=%T to %T... ", smqp->msg, receiver); +#endif + + if (is_internal_pid(receiver)) { + proc = erts_pid2proc(NULL, 0, receiver, proc_locks); + if (!proc + || (smqp->type == SYS_MSG_TYPE_TRACE + && !(proc->trace_flags & F_TRACER))) { + /* Bad tracer */ +#ifdef DEBUG_PRINTOUTS + if (smqp->type == SYS_MSG_TYPE_TRACE && proc) + erts_fprintf(stderr, + " "); +#endif + goto failure; + } + else { + queue_proc_msg: + erts_queue_message(proc,&proc_locks,smqp->bp,smqp->msg,NIL); +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "delivered\n"); +#endif + erts_smp_proc_unlock(proc, proc_locks); + } + } + else if (receiver == am_error_logger) { + proc = erts_whereis_process(NULL,0,receiver,proc_locks,0); + if (!proc) + goto failure; + else if (smqp->from == proc->id) + goto drop_sys_msg; + else + goto queue_proc_msg; + } + else if (is_internal_port(receiver)) { + port = erts_id2port(receiver, NULL, 0); + if (INVALID_TRACER_PORT(port, receiver)) { + if (port) + erts_port_release(port); + goto failure; + } + else { + write_sys_msg_to_port(receiver, + port, + smqp->from, + smqp->type, + smqp->msg); + if (port->control_flags & PORT_CONTROL_FLAG_HEAVY) + port->control_flags &= ~PORT_CONTROL_FLAG_HEAVY; +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "delivered\n"); +#endif + erts_port_release(port); + if (smqp->bp) + free_message_buffer(smqp->bp); + } + } + else { + failure: + sys_msg_disp_failure(smqp, receiver); + drop_sys_msg: + if (proc) + erts_smp_proc_unlock(proc, proc_locks); + if (smqp->bp) + free_message_buffer(smqp->bp); +#ifdef DEBUG_PRINTOUTS + erts_fprintf(stderr, "dropped\n"); +#endif + } + } + } + + erts_smp_activity_end(ERTS_ACTIVITY_IO, NULL, NULL, NULL); + return NULL; +} + +void +erts_foreach_sys_msg_in_q(void (*func)(Eterm, + Eterm, + Eterm, + ErlHeapFragment *)) +{ + ErtsSysMsgQ *sm; + erts_smp_mtx_lock(&smq_mtx); + for (sm = sys_message_queue; sm; sm = sm->next) { + Eterm to; + switch (sm->type) { + case SYS_MSG_TYPE_TRACE: + to = sm->to; + break; + case SYS_MSG_TYPE_SEQTRACE: + to = erts_get_system_seq_tracer(); + break; + case SYS_MSG_TYPE_SYSMON: + to = erts_get_system_monitor(); + break; + case SYS_MSG_TYPE_SYSPROF: + to = erts_get_system_profile(); + break; + case SYS_MSG_TYPE_ERRLGR: + to = am_error_logger; + break; + default: + to = NIL; + break; + } + (*func)(sm->from, to, sm->msg, sm->bp); + } + erts_smp_mtx_unlock(&smq_mtx); +} + + +static void +init_sys_msg_dispatcher(void) +{ + erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER; + thr_opts.detached = 1; + init_smq_element_alloc(); + sys_message_queue = NULL; + sys_message_queue_end = NULL; + erts_smp_cnd_init(&smq_cnd); + erts_smp_mtx_init(&smq_mtx, "sys_msg_q"); + dispatcher_waiting = 0; + erts_smp_thr_create(&sys_msg_dispatcher_tid, + sys_msg_dispatcher_func, + NULL, + &thr_opts); +} + +#endif diff --git a/erts/emulator/beam/erl_unicode.c b/erts/emulator/beam/erl_unicode.c new file mode 100644 index 0000000000..ab5811c70f --- /dev/null +++ b/erts/emulator/beam/erl_unicode.c @@ -0,0 +1,1815 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "erl_binary.h" +#include "big.h" + +#include "erl_unicode.h" + +typedef struct _restart_context { + byte *bytes; + Uint num_processed_bytes; + Uint num_bytes_to_process; + Uint num_resulting_chars; + int state; +} RestartContext; + + +#define LOOP_FACTOR 10 +#define LOOP_FACTOR_SIMPLE 50 /* When just counting */ + +static Uint max_loop_limit; + +static BIF_RETTYPE utf8_to_list(BIF_ALIST_1); +static BIF_RETTYPE finalize_list_to_list(Process *p, + byte *bytes, + Eterm rest, + Uint num_processed_bytes, + Uint num_bytes_to_process, + Uint num_resulting_chars, + int state, int left, + Eterm tail); +static int analyze_utf8(byte *source, Uint size, + byte **err_pos, Uint *num_chars, int *left); +#define UTF8_OK 0 +#define UTF8_INCOMPLETE 1 +#define UTF8_ERROR 2 +#define UTF8_ANALYZE_MORE 3 + +static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3); +static BIF_RETTYPE characters_to_list_trap_1(BIF_ALIST_3); +static BIF_RETTYPE characters_to_list_trap_2(BIF_ALIST_3); + +static BIF_RETTYPE characters_to_list_trap_3(BIF_ALIST_3); +static BIF_RETTYPE characters_to_list_trap_4(BIF_ALIST_1); + +static Export characters_to_utf8_trap_exp; +static Export characters_to_list_trap_1_exp; +static Export characters_to_list_trap_2_exp; + +static Export characters_to_list_trap_3_exp; +static Export characters_to_list_trap_4_exp; + +static Export *c_to_b_int_trap_exportp = NULL; +static Export *c_to_l_int_trap_exportp = NULL; + +void erts_init_unicode(void) +{ + max_loop_limit = CONTEXT_REDS * LOOP_FACTOR; + /* Non visual BIFs to trap to. */ + memset(&characters_to_utf8_trap_exp, 0, sizeof(Export)); + characters_to_utf8_trap_exp.address = + &characters_to_utf8_trap_exp.code[3]; + characters_to_utf8_trap_exp.code[0] = am_erlang; + characters_to_utf8_trap_exp.code[1] = + am_atom_put("characters_to_utf8_trap",23); + characters_to_utf8_trap_exp.code[2] = 3; + characters_to_utf8_trap_exp.code[3] = + (Eterm) em_apply_bif; + characters_to_utf8_trap_exp.code[4] = + (Eterm) &characters_to_utf8_trap; + + memset(&characters_to_list_trap_1_exp, 0, sizeof(Export)); + characters_to_list_trap_1_exp.address = + &characters_to_list_trap_1_exp.code[3]; + characters_to_list_trap_1_exp.code[0] = am_erlang; + characters_to_list_trap_1_exp.code[1] = + am_atom_put("characters_to_list_trap_1",25); + characters_to_list_trap_1_exp.code[2] = 3; + characters_to_list_trap_1_exp.code[3] = + (Eterm) em_apply_bif; + characters_to_list_trap_1_exp.code[4] = + (Eterm) &characters_to_list_trap_1; + + memset(&characters_to_list_trap_2_exp, 0, sizeof(Export)); + characters_to_list_trap_2_exp.address = + &characters_to_list_trap_2_exp.code[3]; + characters_to_list_trap_2_exp.code[0] = am_erlang; + characters_to_list_trap_2_exp.code[1] = + am_atom_put("characters_to_list_trap_2",25); + characters_to_list_trap_2_exp.code[2] = 3; + characters_to_list_trap_2_exp.code[3] = + (Eterm) em_apply_bif; + characters_to_list_trap_2_exp.code[4] = + (Eterm) &characters_to_list_trap_2; + + + memset(&characters_to_list_trap_3_exp, 0, sizeof(Export)); + characters_to_list_trap_3_exp.address = + &characters_to_list_trap_3_exp.code[3]; + characters_to_list_trap_3_exp.code[0] = am_erlang; + characters_to_list_trap_3_exp.code[1] = + am_atom_put("characters_to_list_trap_3",25); + characters_to_list_trap_3_exp.code[2] = 3; + characters_to_list_trap_3_exp.code[3] = + (Eterm) em_apply_bif; + characters_to_list_trap_3_exp.code[4] = + (Eterm) &characters_to_list_trap_3; + + memset(&characters_to_list_trap_4_exp, 0, sizeof(Export)); + characters_to_list_trap_4_exp.address = + &characters_to_list_trap_4_exp.code[3]; + characters_to_list_trap_4_exp.code[0] = am_erlang; + characters_to_list_trap_4_exp.code[1] = + am_atom_put("characters_to_list_trap_4",25); + characters_to_list_trap_4_exp.code[2] = 1; + characters_to_list_trap_4_exp.code[3] = + (Eterm) em_apply_bif; + characters_to_list_trap_4_exp.code[4] = + (Eterm) &characters_to_list_trap_4; + + c_to_b_int_trap_exportp = erts_export_put(am_unicode,am_characters_to_binary_int,2); + c_to_l_int_trap_exportp = erts_export_put(am_unicode,am_characters_to_list_int,2); + + +} + + +static ERTS_INLINE void *alloc_restart(size_t size) +{ + return erts_alloc(ERTS_ALC_T_UNICODE_BUFFER,size); +} + +static ERTS_INLINE void free_restart(void *ptr) +{ + erts_free(ERTS_ALC_T_UNICODE_BUFFER, ptr); +} + +static void cleanup_restart_context(RestartContext *rc) +{ + if (rc->bytes != NULL) { + free_restart(rc->bytes); + rc->bytes = NULL; + } +} + +static void cleanup_restart_context_bin(Binary *bp) +{ + RestartContext *rc = ERTS_MAGIC_BIN_DATA(bp); + cleanup_restart_context(rc); +} + +static RestartContext *get_rc_from_bin(Eterm bin) +{ + Binary *mbp; + ASSERT(ERTS_TERM_IS_MAGIC_BINARY(bin)); + + mbp = ((ProcBin *) binary_val(bin))->val; + + ASSERT(ERTS_MAGIC_BIN_DESTRUCTOR(mbp) + == cleanup_restart_context_bin); + return (RestartContext *) ERTS_MAGIC_BIN_DATA(mbp); +} + +static Eterm make_magic_bin_for_restart(Process *p, RestartContext *rc) +{ + Binary *mbp = erts_create_magic_binary(sizeof(RestartContext), + cleanup_restart_context_bin); + RestartContext *restartp = ERTS_MAGIC_BIN_DATA(mbp); + Eterm *hp; + memcpy(restartp,rc,sizeof(RestartContext)); + hp = HAlloc(p, PROC_BIN_SIZE); + return erts_mk_magic_binary_term(&hp, &MSO(p), mbp); +} + + +Sint erts_unicode_set_loop_limit(Sint limit) +{ + Sint save = (Sint) max_loop_limit; + if (limit <= 0) { + max_loop_limit = CONTEXT_REDS * LOOP_FACTOR; + } else { + max_loop_limit = (Uint) limit; + } + return save; +} + +static ERTS_INLINE int allowed_iterations(Process *p) +{ + int tmp = ERTS_BIF_REDS_LEFT(p) * LOOP_FACTOR; + int tmp2 = max_loop_limit; + if (tmp2 < tmp) + return tmp2; + else + return tmp; +} +static ERTS_INLINE int cost_to_proc(Process *p, int cost) +{ + int x = (cost / LOOP_FACTOR); + BUMP_REDS(p,x); + return x; +} +static ERTS_INLINE int simple_loops_to_common(int cost) +{ + int factor = (LOOP_FACTOR_SIMPLE / LOOP_FACTOR); + return (cost / factor); +} + +static Sint aligned_binary_size(Eterm binary) +{ + unsigned char *bytes; + Uint bitoffs; + Uint bitsize; + + ERTS_GET_BINARY_BYTES(binary, bytes, bitoffs, bitsize); + if (bitsize != 0) { + return (Sint) -1; + } + return binary_size(binary); +} + +static Sint latin1_binary_need(Eterm binary) +{ + unsigned char *bytes; + byte *temp_alloc = NULL; + Uint bitoffs; + Uint bitsize; + Uint size; + Sint need = 0; + Sint i; + + ERTS_GET_BINARY_BYTES(binary, bytes, bitoffs, bitsize); + if (bitsize != 0) { + return (Sint) -1; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(binary, &temp_alloc); + /* The call to erts_get_aligned_binary_bytes cannot fail as + we'we already checked bitsize and that this is a binary */ + } + size = binary_size(binary); + for(i = 0; i < size; ++i) { + if (bytes[i] & ((byte) 0x80)) { + need += 2; + } else { + need += 1; + } + } + erts_free_aligned_binary_bytes(temp_alloc); + return need; +} + +static int utf8_len(byte first) +{ + if ((first & ((byte) 0x80)) == 0) { + return 1; + } else if ((first & ((byte) 0xE0)) == 0xC0) { + return 2; + } else if ((first & ((byte) 0xF0)) == 0xE0) { + return 3; + } else if ((first & ((byte) 0xF8)) == 0xF0) { + return 4; + } + return -1; +} + +static int copy_utf8_bin(byte *target, byte *source, Uint size, + byte *leftover, int *num_leftovers, + byte **err_pos, Uint *characters) { + int copied = 0; + if (leftover != NULL && *num_leftovers) { + int need = utf8_len(leftover[0]); + int from_source = need - (*num_leftovers); + int c; + byte *tmp_err_pos = NULL; + ASSERT(need > 0); + ASSERT(from_source > 0); + if (size < from_source) { + memcpy(leftover + (*num_leftovers), source, size); + *num_leftovers += size; + return 0; + } + /* leftover has room for four bytes (see bif) */ + memcpy(leftover + (*num_leftovers),source,from_source); + c = copy_utf8_bin(target, leftover, need, NULL, NULL, &tmp_err_pos, characters); + if (tmp_err_pos != 0) { + *err_pos = source; + return 0; + } + copied += c; + *num_leftovers = 0; + size -= from_source; + target += c; + source += from_source; + } + while (size) { + if (((*source) & ((byte) 0x80)) == 0) { + *(target++) = *(source++); + --size; ++copied; + } else if (((*source) & ((byte) 0xE0)) == 0xC0) { + if (leftover && size < 2) { + *leftover = *source; + *num_leftovers = 1; + break; + } + if (size < 2 || ((source[1] & ((byte) 0xC0)) != 0x80) || + ((*source) < 0xC2) /* overlong */) { + *err_pos = source; + return copied; + } + *(target++) = *(source++); + *(target++) = *(source++); + size -= 2; copied += 2; + } else if (((*source) & ((byte) 0xF0)) == 0xE0) { + if (leftover && size < 3) { + memcpy(leftover, source, (int) size); + *num_leftovers = (int) size; + break; + } + if (size < 3 || ((source[1] & ((byte) 0xC0)) != 0x80) || + ((source[2] & ((byte) 0xC0)) != 0x80) || + (((*source) == 0xE0) && (source[1] < 0xA0)) /* overlong */ ) { + *err_pos = source; + return copied; + } + if ((((*source) & ((byte) 0xF)) == 0xD) && + ((source[1] & 0x20) != 0)) { + *err_pos = source; + return copied; + } + + if (((*source) == 0xEF) && (source[1] == 0xBF) && + ((source[2] == 0xBE) || (source[2] == 0xBF))) { + *err_pos = source; + return copied; + } + + *(target++) = *(source++); + *(target++) = *(source++); + *(target++) = *(source++); + size -= 3; copied += 3; + } else if (((*source) & ((byte) 0xF8)) == 0xF0) { + if (leftover && size < 4) { + memcpy(leftover, source, (int) size); + *num_leftovers = (int) size; + break; + } + if (size < 4 || ((source[1] & ((byte) 0xC0)) != 0x80) || + ((source[2] & ((byte) 0xC0)) != 0x80) || + ((source[3] & ((byte) 0xC0)) != 0x80) || + (((*source) == 0xF0) && (source[1] < 0x90)) /* overlong */) { + *err_pos = source; + return copied; + } + if ((((*source) & ((byte)0x7)) > 0x4U) || + ((((*source) & ((byte)0x7)) == 0x4U) && + ((source[1] & ((byte)0x3F)) > 0xFU))) { + *err_pos = source; + return copied; + } + *(target++) = *(source++); + *(target++) = *(source++); + *(target++) = *(source++); + *(target++) = *(source++); + size -= 4; copied +=4; + } else { + *err_pos = source; + return copied; + } + ++(*characters); + } + return copied; +} + + + +static Sint utf8_need(Eterm ioterm, int latin1, Uint *costp) +{ + Eterm *objp; + Eterm obj; + DECLARE_ESTACK(stack); + Sint need = 0; + Uint cost = 0; + + if (is_nil(ioterm)) { + DESTROY_ESTACK(stack); + *costp = 0; + return need; + } + if(is_binary(ioterm)) { + DESTROY_ESTACK(stack); + if (latin1) { + Sint x = latin1_binary_need(ioterm); + *costp = x; + return x; + } else { + *costp = 1; + return aligned_binary_size(ioterm); + } + } + + if (!is_list(ioterm)) { + DESTROY_ESTACK(stack); + *costp = 0; + return (Sint) -1; + } + /* OK a list, needs to be processed in order, handling each flat list-level + as they occur, just like io_list_to_binary would */ + ESTACK_PUSH(stack,ioterm); + while (!ESTACK_ISEMPTY(stack)) { + ioterm = ESTACK_POP(stack); + if (is_nil(ioterm)) { + /* ignore empty lists */ + continue; + } + if(is_list(ioterm)) { +L_Again: /* Restart with sublist, old listend was pushed on stack */ + objp = list_val(ioterm); + obj = CAR(objp); + for(;;) { /* loop over one flat list of bytes and binaries + until sublist or list end is encountered */ + if (is_small(obj)) { /* Always small */ + for(;;) { + Uint x = unsigned_val(obj); + if (x < 0x80) + need +=1; + else if (x < 0x800) + need += 2; + else if (x < 0x10000) + need += 3; + else + need += 4; + /* everything else will give badarg later + in the process, so we dont check */ + ++cost; + ioterm = CDR(objp); + if (!is_list(ioterm)) { + break; + } + objp = list_val(ioterm); + obj = CAR(objp); + if (!is_byte(obj)) + break; + } + } else if (is_nil(obj)) { + ioterm = CDR(objp); + if (!is_list(ioterm)) { + break; + } + objp = list_val(ioterm); + obj = CAR(objp); + } else if (is_list(obj)) { + /* push rest of list for later processing, start + again with sublist */ + ESTACK_PUSH(stack,CDR(objp)); + ioterm = obj; + goto L_Again; + } else if (is_binary(obj)) { + Sint x; + + if (latin1) { + x = latin1_binary_need(obj); + if (x < 0) { + DESTROY_ESTACK(stack); + *costp = cost; + return x; + } + cost += x; + } else { + x = aligned_binary_size(obj); + if (x < 0) { + DESTROY_ESTACK(stack); + *costp = cost; + return x; + } + ++cost; + } + need += x; + ioterm = CDR(objp); + if (is_list(ioterm)) { + /* objp and obj need to be updated if + loop is to continue */ + objp = list_val(ioterm); + obj = CAR(objp); + } + } else { + DESTROY_ESTACK(stack); + *costp = cost; + return ((Sint) -1); + } + if (is_nil(ioterm) || !is_list(ioterm)) { + break; + } + } /* for(;;) */ + } /* is_list(ioterm) */ + + if (!is_list(ioterm) && !is_nil(ioterm)) { + /* inproper list end */ + if (is_binary(ioterm)) { + Sint x; + if (latin1) { + x = latin1_binary_need(ioterm); + if (x < 0) { + DESTROY_ESTACK(stack); + *costp = cost; + return x; + } + cost += x; + } else { + x = aligned_binary_size(ioterm); + if (x < 0) { + DESTROY_ESTACK(stack); + *costp = cost; + return x; + } + ++cost; + } + need += x; + } else { + DESTROY_ESTACK(stack); + *costp = cost; + return ((Sint) -1); + } + } + } /* while not estack empty */ + DESTROY_ESTACK(stack); + *costp = cost; + return need; +} + + +static Eterm do_build_utf8(Process *p, Eterm ioterm, int *left, int latin1, + byte *target, int *pos, Uint *characters, int *err, + byte *leftover, int *num_leftovers) +{ + int c; + Eterm *objp; + Eterm obj; + DECLARE_ESTACK(stack); + + *err = 0; + if ((*left) <= 0 || is_nil(ioterm)) { + DESTROY_ESTACK(stack); + return ioterm; + } + if(is_binary(ioterm)) { + Uint bitoffs; + Uint bitsize; + Uint size; + Uint i; + Eterm res_term = NIL; + unsigned char *bytes; + byte *temp_alloc = NULL; + Uint orig_size; + + ERTS_GET_BINARY_BYTES(ioterm, bytes, bitoffs, bitsize); + if (bitsize != 0) { + *err = 1; + DESTROY_ESTACK(stack); + return ioterm; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(ioterm, &temp_alloc); + /* The call to erts_get_aligned_binary_bytes cannot fail as + we'we already checked bitsize and that this is a binary */ + } + + orig_size = size = binary_size(ioterm); + + /* This is done to avoid splitting binaries in two + and then create an unnecessary rest that eventually gives an error. + For cases where errors are not returned this is unnecessary */ + if (!latin1) { + /* Find a valid character boundary */ + while (size > (*left) && + (((byte) bytes[(*left)]) & ((byte) 0xC0)) == ((byte) 0x80)) { + ++(*left); + } + } + + if (size > (*left)) { + Eterm *hp; + ErlSubBin *sb; + Eterm orig; + Uint offset; + /* Split the binary in two parts, of which we + only process the first */ + hp = HAlloc(p, ERL_SUB_BIN_SIZE); + sb = (ErlSubBin *) hp; + ERTS_GET_REAL_BIN(ioterm, orig, offset, bitoffs, bitsize); + sb->thing_word = HEADER_SUB_BIN; + sb->size = size - (*left); + sb->offs = offset + (*left); + sb->orig = orig; + sb->bitoffs = bitoffs; + sb->bitsize = bitsize; + sb->is_writable = 0; + res_term = make_binary(sb); + size = (*left); + } + + if (!latin1) { + int num; + byte *err_pos = NULL; + num = copy_utf8_bin(target + (*pos), bytes, + size, leftover, num_leftovers,&err_pos,characters); + *pos += num; + if (err_pos != NULL) { + int rest_bin_offset; + int rest_bin_size; + Eterm *hp; + ErlSubBin *sb; + Eterm orig; + Uint offset; + + *err = 1; + /* we have no real stack, just build a list of the binaries + we have not decoded... */ + DESTROY_ESTACK(stack); + + rest_bin_offset = (err_pos - bytes); + rest_bin_size = orig_size - rest_bin_offset; + + hp = HAlloc(p, ERL_SUB_BIN_SIZE); + sb = (ErlSubBin *) hp; + ERTS_GET_REAL_BIN(ioterm, orig, offset, bitoffs, bitsize); + sb->thing_word = HEADER_SUB_BIN; + sb->size = rest_bin_size; + sb->offs = offset + rest_bin_offset; + sb->orig = orig; + sb->bitoffs = bitoffs; + sb->bitsize = bitsize; + sb->is_writable = 0; + res_term = make_binary(sb); + erts_free_aligned_binary_bytes(temp_alloc); + return res_term; + } + } else { + i = 0; + while(i < size) { + if (bytes[i] < 0x80) { + target[(*pos)++] = bytes[i++]; + } else { + target[(*pos)++] = ((bytes[i] >> 6) | ((byte) 0xC0)); + target[(*pos)++] = ((bytes[i] & 0x3F) | ((byte) 0x80)); + ++i; + } + ++(*characters); + } + } + *left -= size; + DESTROY_ESTACK(stack); + erts_free_aligned_binary_bytes(temp_alloc); + return res_term; + } + + if (!is_list(ioterm)) { + *err = 1; + goto done; + } + + /* OK a list, needs to be processed in order, handling each flat list-level + as they occur, just like io_list_to_binary would */ + ESTACK_PUSH(stack,ioterm); + while (!ESTACK_ISEMPTY(stack) && (*left)) { + ioterm = ESTACK_POP(stack); + if (is_nil(ioterm)) { + /* ignore empty lists */ + continue; + } + if(is_list(ioterm)) { +L_Again: /* Restart with sublist, old listend was pushed on stack */ + objp = list_val(ioterm); + obj = CAR(objp); + for(;;) { /* loop over one flat list of bytes and binaries + until sublist or list end is encountered */ + if (is_small(obj)) { /* Always small in unicode*/ + if (*num_leftovers) { + /* Have rest from previous bin and this is an integer, not allowed */ + *err = 1; + goto done; + } + for(;;) { + Uint x = unsigned_val(obj); + if (latin1 && x > 255) { + *err = 1; + goto done; + } + if (x < 0x80) { + target[(*pos)++] = (byte) x; + } + else if (x < 0x800) { + target[(*pos)++] = (((byte) (x >> 6)) | + ((byte) 0xC0)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else if (x < 0x10000) { + if ((x >= 0xD800 && x <= 0xDFFF) || + (x == 0xFFFE) || + (x == 0xFFFF)) { /* Invalid unicode range */ + *err = 1; + goto done; + } + target[(*pos)++] = (((byte) (x >> 12)) | + ((byte) 0xE0)); + target[(*pos)++] = ((((byte) (x >> 6)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else if (x < 0x110000) { /* Standard imposed max */ + target[(*pos)++] = (((byte) (x >> 18)) | + ((byte) 0xF0)); + target[(*pos)++] = ((((byte) (x >> 12)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = ((((byte) (x >> 6)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else { + *err = 1; + goto done; + } + ++(*characters); + --(*left); + ioterm = CDR(objp); + if (!is_list(ioterm) || !(*left)) { + break; + } + objp = list_val(ioterm); + obj = CAR(objp); + if (!is_small(obj)) + break; + } + } else if (is_nil(obj)) { + ioterm = CDR(objp); + if (!is_list(ioterm)) { + break; + } + objp = list_val(ioterm); + obj = CAR(objp); + } else if (is_list(obj)) { + /* push rest of list for later processing, start + again with sublist */ + ESTACK_PUSH(stack,CDR(objp)); + ioterm = obj; + goto L_Again; + } else if (is_binary(obj)) { + Eterm rest_term; + rest_term = do_build_utf8(p,obj,left,latin1,target,pos, characters, err, + leftover, num_leftovers); + if ((*err) != 0) { + Eterm *hp; + hp = HAlloc(p, 2); + obj = CDR(objp); + ioterm = CONS(hp, rest_term, obj); + //(*left) = 0; + goto done; + } + if (rest_term != NIL) { + Eterm *hp; + hp = HAlloc(p, 2); + obj = CDR(objp); + ioterm = CONS(hp, rest_term, obj); + (*left) = 0; + break; + } + ioterm = CDR(objp); + if (is_list(ioterm)) { + /* objp and obj need to be updated if + loop is to continue */ + objp = list_val(ioterm); + obj = CAR(objp); + } + } else { + *err = 1; + goto done; + } + if (!(*left) || is_nil(ioterm) || !is_list(ioterm)) { + break; + } + } /* for(;;) */ + } /* is_list(ioterm) */ + + if ((*left) && !is_list(ioterm) && !is_nil(ioterm)) { + /* inproper list end */ + if (is_binary(ioterm)) { + ioterm = do_build_utf8(p,ioterm,left,latin1,target,pos,characters,err,leftover,num_leftovers); + if ((*err) != 0) { + goto done; + } + } else { + *err = 1; + goto done; + } + } + } /* while left and not estack empty */ + done: + c = ESTACK_COUNT(stack); + if (c > 0) { + Eterm *hp = HAlloc(p,2*c); + while(!ESTACK_ISEMPTY(stack)) { + Eterm st = ESTACK_POP(stack); + ioterm = CONS(hp, ioterm, st); + hp += 2; + } + } + DESTROY_ESTACK(stack); + return ioterm; + +} + +static int check_leftovers(byte *source, int size) +{ + if (((*source) & ((byte) 0xE0)) == 0xC0) { + return 0; + } else if (((*source) & ((byte) 0xF0)) == 0xE0) { + if (size < 2 || + (size < 3 && ((source[1] & ((byte) 0xC0)) == 0x80))) { + return 0; + } + } else if (((*source) & ((byte) 0xF8)) == 0xF0) { + if (size < 2 || + (size < 3 && ((source[1] & ((byte) 0xC0)) == 0x80)) || + (size < 4 && + ((source[1] & ((byte) 0xC0)) == 0x80) && + ((source[2] & ((byte) 0xC0)) == 0x80))) { + return 0; + } + } + return -1; +} + + + +static BIF_RETTYPE build_utf8_return(Process *p,Eterm bin,int pos, + Eterm rest_term,int err, + byte *leftover,int num_leftovers,Eterm latin1) +{ + Eterm *hp; + Eterm ret; + + binary_size(bin) = pos; + if (err) { + if (num_leftovers > 0) { + Eterm leftover_bin = new_binary(p, leftover, num_leftovers); + hp = HAlloc(p,8); + rest_term = CONS(hp,rest_term,NIL); + hp += 2; + rest_term = CONS(hp,leftover_bin,rest_term); + hp += 2; + } else { + hp = HAlloc(p,4); + } + ret = TUPLE3(hp,am_error,bin,rest_term); + } else if (rest_term == NIL && num_leftovers != 0) { + Eterm leftover_bin = new_binary(p, leftover, num_leftovers); + if (check_leftovers(leftover,num_leftovers) != 0) { + hp = HAlloc(p,4); + ret = TUPLE3(hp,am_error,bin,leftover_bin); + } else { + hp = HAlloc(p,4); + ret = TUPLE3(hp,am_incomplete,bin,leftover_bin); + } + } else { /* All OK */ + if (rest_term != NIL) { /* Trap */ + if (num_leftovers > 0) { + Eterm rest_bin = new_binary(p, leftover, num_leftovers); + hp = HAlloc(p,2); + rest_term = CONS(hp,rest_bin,rest_term); + } + BUMP_ALL_REDS(p); + BIF_TRAP3(&characters_to_utf8_trap_exp, p, bin, rest_term, latin1); + } else { /* Success */ + /*hp = HAlloc(p,5); + ret = TUPLE4(hp,bin,rest_term,make_small(pos),make_small(err));*/ + ret = bin; + } + } + BIF_RET(ret); +} + + +static BIF_RETTYPE characters_to_utf8_trap(BIF_ALIST_3) +{ + Eterm *real_bin; + Sint need; + byte* bytes; + Eterm rest_term; + int left, sleft; + int pos; + int err; + byte leftover[4]; /* used for temp buffer too, + otherwise 3 bytes would have been enough */ + int num_leftovers = 0; + int latin1 = 0; + Uint characters = 0; + + /*erts_printf("Trap %T!\r\n",BIF_ARG_2);*/ + ASSERT(is_binary(BIF_ARG_1)); + real_bin = binary_val(BIF_ARG_1); + ASSERT(*real_bin == HEADER_PROC_BIN); + need = ((ProcBin *) real_bin)->val->orig_size; + pos = (int) binary_size(BIF_ARG_1); + bytes = binary_bytes(BIF_ARG_1); + sleft = left = allowed_iterations(BIF_P); + err = 0; + if (BIF_ARG_3 == am_latin1) { + latin1 = 1; + } + rest_term = do_build_utf8(BIF_P, BIF_ARG_2, &left, latin1, + bytes, &pos, &characters, &err, leftover, &num_leftovers); + cost_to_proc(BIF_P, sleft - left); + return build_utf8_return(BIF_P,BIF_ARG_1,pos,rest_term,err, + leftover,num_leftovers,BIF_ARG_3); +} + +BIF_RETTYPE unicode_bin_is_7bit_1(BIF_ALIST_1) +{ + Sint need; + if(!is_binary(BIF_ARG_1)) { + BIF_RET(am_false); + } + need = latin1_binary_need(BIF_ARG_1); + if(need >= 0 && aligned_binary_size(BIF_ARG_1) == need) { + BIF_RET(am_true); + } + BIF_RET(am_false); +} + +static int is_valid_utf8(Eterm orig_bin) +{ + Uint bitoffs; + Uint bitsize; + Uint size; + byte *temp_alloc = NULL; + byte *endpos; + Uint numchar; + byte *bytes; + int ret; + + ERTS_GET_BINARY_BYTES(orig_bin, bytes, bitoffs, bitsize); + if (bitsize != 0) { + return 0; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(orig_bin, &temp_alloc); + } + size = binary_size(orig_bin); + ret = analyze_utf8(bytes, + size, + &endpos,&numchar,NULL); + erts_free_aligned_binary_bytes(temp_alloc); + return (ret == UTF8_OK); +} + +BIF_RETTYPE unicode_characters_to_binary_2(BIF_ALIST_2) +{ + Sint need; + Uint characters; + int latin1; + Eterm bin; + byte *bytes; + int pos; + int err; + int left, sleft; + Eterm rest_term, subject; + byte leftover[4]; /* used for temp buffer too, o + therwise 3 bytes would have been enough */ + int num_leftovers = 0; + Uint cost_of_utf8_need; + + + if (BIF_ARG_2 == am_latin1) { + latin1 = 1; + } else if (BIF_ARG_2 == am_unicode || BIF_ARG_2 == am_utf8) { + latin1 = 0; + } else { + BIF_TRAP2(c_to_b_int_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2); + } + if (is_list(BIF_ARG_1) && is_binary(CAR(list_val(BIF_ARG_1))) && + is_nil(CDR(list_val(BIF_ARG_1)))) { + subject = CAR(list_val(BIF_ARG_1)); + } else { + subject = BIF_ARG_1; + } + + need = utf8_need(subject,latin1,&cost_of_utf8_need); + if (need < 0) { + BIF_ERROR(BIF_P,BADARG); + } + if (is_binary(subject) && need >= 0 && aligned_binary_size(subject) == need + && (latin1 || is_valid_utf8(subject))) { + cost_to_proc(BIF_P, simple_loops_to_common(cost_of_utf8_need)); + BIF_RET(subject); + } + + + bin = erts_new_mso_binary(BIF_P, (byte *)NULL, need); + bytes = binary_bytes(bin); + cost_to_proc(BIF_P, simple_loops_to_common(cost_of_utf8_need)); + left = allowed_iterations(BIF_P) - + simple_loops_to_common(cost_of_utf8_need); + if (left <= 0) { + /* simplified - let everything be setup by setting left to 1 */ + left = 1; + } + sleft = left; + pos = 0; + err = 0; + + + rest_term = do_build_utf8(BIF_P, subject, &left, latin1, + bytes, &pos, &characters, &err, leftover, &num_leftovers); +#ifdef HARDDEBUG + if (left == 0) { + Eterm bin; + if (is_binary(subject)) { + bin = subject; + } else if(is_list(subject) && is_binary(CAR(list_val(subject)))) { + bin = CAR(list_val(subject)); + } else { + bin = NIL; + } + if (is_binary(bin)) { + byte *t = NULL; + Uint sz = binary_size(bin); + byte *by = erts_get_aligned_binary_bytes(bin,&t); + int i; + erts_printf("<<"); + for (i = 0;i < sz; ++i) { + erts_printf((i == sz -1) ? "0x%X" : "0x%X, ", (unsigned) by[i]); + } + erts_printf(">>: "); + erts_free_aligned_binary_bytes(t); + } + erts_printf("%d - %d = %d\n",sleft,left,sleft - left); + } +#endif + cost_to_proc(BIF_P, sleft - left); + return build_utf8_return(BIF_P,bin,pos,rest_term,err, + leftover,num_leftovers,BIF_ARG_2); +} + +static BIF_RETTYPE build_list_return(Process *p, byte *bytes, int pos, Uint characters, + Eterm rest_term, int err, + byte *leftover, int num_leftovers, + Eterm latin1, int left) +{ + Eterm *hp; + + if (left <= 0) { + left = 1; + } + + if (err) { + if (num_leftovers > 0) { + Eterm leftover_bin = new_binary(p, leftover, num_leftovers); + hp = HAlloc(p,4); + rest_term = CONS(hp,rest_term,NIL); + hp += 2; + rest_term = CONS(hp,leftover_bin,rest_term); + } + BIF_RET(finalize_list_to_list(p, bytes, rest_term, 0U, pos, characters, UTF8_ERROR, left, NIL)); + } else if (rest_term == NIL && num_leftovers != 0) { + Eterm leftover_bin = new_binary(p, leftover, num_leftovers); + if (check_leftovers(leftover,num_leftovers) != 0) { + BIF_RET(finalize_list_to_list(p, bytes, leftover_bin, 0U, pos, characters, UTF8_ERROR, + left, NIL)); + } else { + BIF_RET(finalize_list_to_list(p, bytes, leftover_bin, 0U, pos, characters, UTF8_INCOMPLETE, + left, NIL)); + } + } else { /* All OK */ + if (rest_term != NIL) { /* Trap */ + RestartContext rc; + if (num_leftovers > 0) { + Eterm rest_bin = new_binary(p, leftover, num_leftovers); + hp = HAlloc(p,2); + rest_term = CONS(hp,rest_bin,rest_term); + } + BUMP_ALL_REDS(p); + rc.bytes = bytes; + rc.num_processed_bytes = 0; /* not used */ + rc.num_bytes_to_process = pos; + rc.num_resulting_chars = characters; + rc.state = UTF8_OK; /* not used */ + BIF_TRAP3(&characters_to_list_trap_1_exp, p, make_magic_bin_for_restart(p,&rc), + rest_term, latin1); + } else { /* Success */ + BIF_RET(finalize_list_to_list(p, bytes, NIL, 0U, pos, characters, UTF8_OK, left, NIL)); + } + } +} + +static BIF_RETTYPE characters_to_list_trap_1(BIF_ALIST_3) +{ + RestartContext *rc; + byte* bytes; + int pos; + Uint characters; + int err; + Eterm rest_term; + int left, sleft; + + int latin1 = 0; + byte leftover[4]; /* used for temp buffer too, + otherwise 3 bytes would have been enough */ + int num_leftovers = 0; + + + rc = get_rc_from_bin(BIF_ARG_1); + + bytes = rc->bytes; + rc->bytes = NULL; /* to avoid free due to later GC */ + pos = rc->num_bytes_to_process; + characters = rc->num_resulting_chars; + + sleft = left = allowed_iterations(BIF_P); + err = 0; + if (BIF_ARG_3 == am_latin1) { + latin1 = 1; + } + rest_term = do_build_utf8(BIF_P, BIF_ARG_2, &left, latin1, + bytes, &pos, &characters, &err, leftover, &num_leftovers); + cost_to_proc(BIF_P, sleft - left); + return build_list_return(BIF_P,bytes,pos,characters,rest_term,err, + leftover,num_leftovers,BIF_ARG_3,left); +} + +BIF_RETTYPE unicode_characters_to_list_2(BIF_ALIST_2) +{ + Sint need; + int latin1; + Uint characters = 0; + byte *bytes; + int pos; + int err; + int left, sleft; + Eterm rest_term; + byte leftover[4]; /* used for temp buffer too, o + therwise 3 bytes would have been enough */ + int num_leftovers = 0; + Uint cost_of_utf8_need; + + if (BIF_ARG_2 == am_latin1) { + latin1 = 1; + } else if (BIF_ARG_2 == am_unicode || BIF_ARG_2 == am_utf8) { + latin1 = 0; + } else { + BIF_TRAP2(c_to_l_int_trap_exportp, BIF_P, BIF_ARG_1, BIF_ARG_2); + } + if (is_binary(BIF_ARG_1) && !latin1) { /* Optimized behaviour for this case */ + return utf8_to_list(BIF_P,BIF_ARG_1); + } + need = utf8_need(BIF_ARG_1,latin1,&cost_of_utf8_need); + if (need < 0) { + BIF_ERROR(BIF_P,BADARG); + } + bytes = alloc_restart(need); + cost_to_proc(BIF_P, simple_loops_to_common(cost_of_utf8_need)); + left = allowed_iterations(BIF_P) - + simple_loops_to_common(cost_of_utf8_need); + if (left <= 0) { + /* simplified - let everything be setup by setting left to 1 */ + left = 1; + } + sleft = left; + pos = 0; + err = 0; + + + rest_term = do_build_utf8(BIF_P, BIF_ARG_1, &left, latin1, + bytes, &pos, &characters, &err, leftover, &num_leftovers); + cost_to_proc(BIF_P, sleft - left); + return build_list_return(BIF_P,bytes,pos,characters,rest_term,err, + leftover,num_leftovers,BIF_ARG_2,left); +} + + +/* + * When input to characters_to_list is a plain binary and the format is 'unicode', we do + * a faster analyze and size count with this function. + */ +static int analyze_utf8(byte *source, Uint size, + byte **err_pos, Uint *num_chars, int *left) +{ + *err_pos = source; + *num_chars = 0; + while (size) { + if (((*source) & ((byte) 0x80)) == 0) { + source++; + --size; + } else if (((*source) & ((byte) 0xE0)) == 0xC0) { + if (size < 2) { + return UTF8_INCOMPLETE; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((*source) < 0xC2) /* overlong */) { + return UTF8_ERROR; + } + source += 2; + size -= 2; + } else if (((*source) & ((byte) 0xF0)) == 0xE0) { + if (size < 3) { + return UTF8_INCOMPLETE; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((source[2] & ((byte) 0xC0)) != 0x80) || + (((*source) == 0xE0) && (source[1] < 0xA0)) /* overlong */ ) { + return UTF8_ERROR; + } + if ((((*source) & ((byte) 0xF)) == 0xD) && + ((source[1] & 0x20) != 0)) { + return UTF8_ERROR; + } + if (((*source) == 0xEF) && (source[1] == 0xBF) && + ((source[2] == 0xBE) || (source[2] == 0xBF))) { + return UTF8_ERROR; + } + source += 3; + size -= 3; + } else if (((*source) & ((byte) 0xF8)) == 0xF0) { + if (size < 4) { + return UTF8_INCOMPLETE; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((source[2] & ((byte) 0xC0)) != 0x80) || + ((source[3] & ((byte) 0xC0)) != 0x80) || + (((*source) == 0xF0) && (source[1] < 0x90)) /* overlong */) { + return UTF8_ERROR; + } + if ((((*source) & ((byte)0x7)) > 0x4U) || + ((((*source) & ((byte)0x7)) == 0x4U) && + ((source[1] & ((byte)0x3F)) > 0xFU))) { + return UTF8_ERROR; + } + source += 4; + size -= 4; + } else { + return UTF8_ERROR; + } + ++(*num_chars); + *err_pos = source; + if (left && --(*left) <= 0) { + return UTF8_ANALYZE_MORE; + } + } + return UTF8_OK; +} + +/* + * No errors should be able to occur - no overlongs, no malformed, no nothing + */ +static Eterm do_utf8_to_list(Process *p, Uint num, byte *bytes, Uint sz, + Uint left, + Uint *num_built, Uint *num_eaten, Eterm tail) +{ + Eterm *hp; + Eterm ret; + byte *source, *ssource; + Uint unipoint; + + ASSERT(num > 0); + if (left < num) { + if (left > 0) + num = left; + else + num = 1; + } + + *num_built = num; /* Always */ + + hp = HAlloc(p,num * 2); + ret = tail; + source = bytes + sz; + ssource = source; + while(--source >= bytes) { + if (((*source) & ((byte) 0x80)) == 0) { + unipoint = (Uint) *source; + } else if (((*source) & ((byte) 0xE0)) == 0xC0) { + unipoint = + (((Uint) ((*source) & ((byte) 0x1F))) << 6) | + ((Uint) (source[1] & ((byte) 0x3F))); + } else if (((*source) & ((byte) 0xF0)) == 0xE0) { + unipoint = + (((Uint) ((*source) & ((byte) 0xF))) << 12) | + (((Uint) (source[1] & ((byte) 0x3F))) << 6) | + ((Uint) (source[2] & ((byte) 0x3F))); + } else if (((*source) & ((byte) 0xF8)) == 0xF0) { + unipoint = + (((Uint) ((*source) & ((byte) 0x7))) << 18) | + (((Uint) (source[1] & ((byte) 0x3F))) << 12) | + (((Uint) (source[2] & ((byte) 0x3F))) << 6) | + ((Uint) (source[3] & ((byte) 0x3F))); + } else { + /* ignore 2#10XXXXXX */ + continue; + } + ret = CONS(hp,make_small(unipoint),ret); + hp += 2; + if (--num <= 0) { + break; + } + } + *num_eaten = (ssource - source); + return ret; +} + +/* + * The last step of characters_to_list, build a list from the buffer 'bytes' (created in the same way + * as for characters_to_utf8). All sizes are known in advance and most data will be held in a + * "magic binary" during trapping. + */ +static BIF_RETTYPE finalize_list_to_list(Process *p, + byte *bytes, + Eterm rest, + Uint num_processed_bytes, + Uint num_bytes_to_process, + Uint num_resulting_chars, + int state, int left, + Eterm tail) +{ + Uint num_built; /* characters */ + Uint num_eaten; /* bytes */ + Eterm *hp; + Eterm converted,ret; + + if (!num_bytes_to_process) { + converted = tail; + } else { + num_built = 0; + num_eaten = 0; + converted = do_utf8_to_list(p, num_resulting_chars, + bytes, num_bytes_to_process, + left, &num_built, &num_eaten, tail); + cost_to_proc(p,num_built); + + if (num_built != num_resulting_chars) { /* work left to do */ + RestartContext rc; + + rc.num_resulting_chars = num_resulting_chars - num_built; + rc.num_bytes_to_process = num_bytes_to_process - num_eaten; + rc.num_processed_bytes = num_processed_bytes + num_eaten; + rc.state = state; + rc.bytes = bytes; + BUMP_ALL_REDS(p); + BIF_TRAP3(&characters_to_list_trap_2_exp, p, + make_magic_bin_for_restart(p, &rc), rest, converted); + } + } + + /* + * OK, no more trapping, let's get rid of the temporary array... + */ + + free_restart(bytes); + if (state == UTF8_INCOMPLETE) { + hp = HAlloc(p,4); + ret = TUPLE3(hp,am_incomplete,converted,rest); + } else if (state == UTF8_ERROR) { + hp = HAlloc(p,4); + ret = TUPLE3(hp,am_error,converted,rest); + } else { + ret = converted; + } + + BIF_RET(ret); +} + +static BIF_RETTYPE characters_to_list_trap_2(BIF_ALIST_3) +{ + RestartContext *rc; + byte *bytes; + + rc = get_rc_from_bin(BIF_ARG_1); + + bytes = rc->bytes; + rc->bytes = NULL; /* Don't want this freed just yet... */ + return finalize_list_to_list(BIF_P, bytes, BIF_ARG_2, rc->num_processed_bytes, + rc->num_bytes_to_process, rc->num_resulting_chars, + rc->state, allowed_iterations(BIF_P), BIF_ARG_3); +} + + +/* + * Hooks into the process of decoding a binary depending on state. + * If last_state is UTF8_ANALYZE_MORE, num_bytes_to_process + * and num_resulting_chars will grow + * until we're done analyzing the binary. Then we'll eat + * the bytes to process, lowering num_bytes_to_process and num_resulting_chars, + * while increasing num_processed_bytes until we're done. the state + * indicates how to return (error, incomplete or ok) in this stage. + * note that num_processed_bytes and num_bytes_to_process will make up the + * length of the binary part to process, not necessarily the length of the + * whole binary (if there are errors or an incomplete tail). + * + * Analyzing happens from the beginning of the binary towards the end, + * while result is built from the end of the analyzed/accepted part + * towards the beginning. + * + * Note that this routine is *only* called when original input was a plain utf8 binary, + * otherwise the rest and the sizes are known in advance, so finalize_list_to_list is + * used to build the resulting list (no analyzing needed). + */ +static BIF_RETTYPE do_bif_utf8_to_list(Process *p, + Eterm orig_bin, + Uint num_processed_bytes, + Uint num_bytes_to_process, + Uint num_resulting_chars, + int state, + Eterm tail) +{ + int left; + Uint bitoffs; + Uint bitsize; + Uint size; + byte *bytes; + Eterm converted = NIL; + Eterm rest = NIL; + Eterm *hp; + Eterm ret; + byte *temp_alloc = NULL; + byte *endpos; + Uint numchar; + + Uint b_sz; /* size of the non analyzed tail */ + Uint num_built; /* characters */ + Uint num_eaten; /* bytes */ + + ERTS_GET_BINARY_BYTES(orig_bin, bytes, bitoffs, bitsize); + if (bitsize != 0) { + converted = NIL; + rest = orig_bin; + goto error_return; + } + if (bitoffs != 0) { + bytes = erts_get_aligned_binary_bytes(orig_bin, &temp_alloc); + } + + size = binary_size(orig_bin); + + left = allowed_iterations(p); + + if (state == UTF8_ANALYZE_MORE) { + state = analyze_utf8(bytes + num_bytes_to_process, + size - num_bytes_to_process, + &endpos,&numchar,&left); + cost_to_proc(p,numchar); + num_resulting_chars += numchar; + num_bytes_to_process = endpos - bytes; + if (state == UTF8_ANALYZE_MORE) { + Eterm epos = erts_make_integer(num_bytes_to_process,p); + Eterm enumchar = erts_make_integer(num_resulting_chars,p); + erts_free_aligned_binary_bytes(temp_alloc); + BUMP_ALL_REDS(p); + BIF_TRAP3(&characters_to_list_trap_3_exp, p, orig_bin, epos, + enumchar); + } + } + + /* + * If we're here, we have everything analyzed and are instead building + */ + + + if (!num_bytes_to_process) { + converted = tail; + } else { + num_built = 0; + num_eaten = 0; + converted = do_utf8_to_list(p, num_resulting_chars, + bytes, num_bytes_to_process, + left, &num_built, &num_eaten, tail); + cost_to_proc(p,num_built); + + if (num_built != num_resulting_chars) { /* work left to do */ + Eterm newnum_resulting_chars = + erts_make_integer(num_resulting_chars - num_built,p); + Eterm newnum_bytes_to_process = + erts_make_integer(num_bytes_to_process - num_eaten,p); + Eterm newnum_processed_bytes = + erts_make_integer(num_processed_bytes + num_eaten,p); + Eterm traptuple; + hp = HAlloc(p,7); + traptuple = TUPLE6(hp,orig_bin,newnum_processed_bytes, + newnum_bytes_to_process, + newnum_resulting_chars, + make_small(state), + converted); + BUMP_ALL_REDS(p); + erts_free_aligned_binary_bytes(temp_alloc); + BIF_TRAP1(&characters_to_list_trap_4_exp,p,traptuple); + } + } + + /* + * OK, no more trapping, let's build rest binary if there should + * be one. + */ + + b_sz = size - (num_bytes_to_process + num_processed_bytes); + + if (b_sz) { + ErlSubBin *sb; + Eterm orig; + Uint offset; + ASSERT(state != UTF8_OK); + hp = HAlloc(p, ERL_SUB_BIN_SIZE); + sb = (ErlSubBin *) hp; + ERTS_GET_REAL_BIN(orig_bin, orig, offset, bitoffs, bitsize); + sb->thing_word = HEADER_SUB_BIN; + sb->size = b_sz; + sb->offs = num_bytes_to_process + num_processed_bytes; + sb->orig = orig; + sb->bitoffs = bitoffs; + sb->bitsize = bitsize; + sb->is_writable = 0; + rest = make_binary(sb); + } + + /* Done */ + + if (state == UTF8_INCOMPLETE) { + if (check_leftovers(bytes + num_bytes_to_process + num_processed_bytes, + b_sz) != 0) { + goto error_return; + } + hp = HAlloc(p,4); + ret = TUPLE3(hp,am_incomplete,converted,rest); + } else if (state == UTF8_ERROR) { + error_return: + hp = HAlloc(p,4); + ret = TUPLE3(hp,am_error,converted,rest); + } else { + ret = converted; + } + + erts_free_aligned_binary_bytes(temp_alloc); + BIF_RET(ret); +} + + +/* + * This is called when there's still analyzing left to do, + * we only reach this if original input was a binary. + */ + +static BIF_RETTYPE characters_to_list_trap_3(BIF_ALIST_3) +{ + Uint num_bytes_to_process; + Uint num_resulting_chars; + + term_to_Uint(BIF_ARG_2, &num_bytes_to_process); /* The number of already + analyzed and accepted + bytes */ + term_to_Uint(BIF_ARG_3, &num_resulting_chars); /* The number of chars + procuced by the + already analyzed + part of the binary */ + + /*erts_printf("Trap: %T, %T, %T\n",BIF_ARG_1, BIF_ARG_2, BIF_ARG_3);*/ + + return do_bif_utf8_to_list(BIF_P, + BIF_ARG_1, /* the binary */ + 0U, /* nothing processed yet */ + num_bytes_to_process, + num_resulting_chars, + UTF8_ANALYZE_MORE, /* always this state here */ + NIL); /* Nothing built -> no tail yet */ + +} + +/* + * This is called when analyzing is done and we are trapped during building, + * we only reach this if original input was a binary. + */ +static BIF_RETTYPE characters_to_list_trap_4(BIF_ALIST_1) +{ + Uint num_processed_bytes; + Uint num_bytes_to_process; + Uint num_resulting_chars; + Eterm orig_bin, tail; + int last_state; + Eterm *tplp = tuple_val(BIF_ARG_1); + + orig_bin = tplp[1]; + term_to_Uint(tplp[2], &num_processed_bytes); + term_to_Uint(tplp[3], &num_bytes_to_process); + term_to_Uint(tplp[4], &num_resulting_chars); + last_state = (int) signed_val(tplp[5]); + tail = tplp[6]; + + /*erts_printf("Trap: {%T, %lu, %lu, %lu, %d, %T}\n", + orig_bin, num_processed_bytes, num_bytes_to_process, + num_resulting_chars, last_state, tail);*/ + + return do_bif_utf8_to_list(BIF_P, + orig_bin, /* The whole binary */ + num_processed_bytes, /* Number of bytes + already processed */ + num_bytes_to_process, /* Bytes left to proc. */ + num_resulting_chars, /* Num chars left to + build */ + last_state, /* The current state + (never ANALYZE_MORE)*/ + tail); /* The already built + tail */ + +} +/* + * This is only used when characters are a plain unicode (utf8) binary. + * Instead of building an utf8 buffer, we analyze the binary given and use that. + */ + +static BIF_RETTYPE utf8_to_list(BIF_ALIST_1) +{ + if (!is_binary(BIF_ARG_1) || aligned_binary_size(BIF_ARG_1) < 0) { + BIF_ERROR(BIF_P,BADARG); + } + return do_bif_utf8_to_list(BIF_P, BIF_ARG_1, 0U, 0U, 0U, + UTF8_ANALYZE_MORE,NIL); +} + + +BIF_RETTYPE atom_to_binary_2(BIF_ALIST_2) +{ + Atom* ap; + + if (is_not_atom(BIF_ARG_1)) { + goto error; + } + + ap = atom_tab(atom_val(BIF_ARG_1)); + + if (BIF_ARG_2 == am_latin1) { + BIF_RET(new_binary(BIF_P, ap->name, ap->len)); + } else if (BIF_ARG_2 == am_utf8 || BIF_ARG_2 == am_unicode) { + int bin_size = 0; + int i; + Eterm bin_term; + byte* bin_p; + + for (i = 0; i < ap->len; i++) { + bin_size += (ap->name[i] >= 0x80) ? 2 : 1; + } + if (bin_size == ap->len) { + BIF_RET(new_binary(BIF_P, ap->name, ap->len)); + } + bin_term = new_binary(BIF_P, 0, bin_size); + bin_p = binary_bytes(bin_term); + for (i = 0; i < ap->len; i++) { + byte b = ap->name[i]; + if (b < 0x80) { + *bin_p++ = b; + } else { + *bin_p++ = 0xC0 | (b >> 6); + *bin_p++ = 0x80 | (b & 0x3F); + } + } + BIF_RET(bin_term); + } else { + error: + BIF_ERROR(BIF_P, BADARG); + } +} + +static BIF_RETTYPE +binary_to_atom(Process* p, Eterm bin, Eterm enc, int must_exist) +{ + byte* bytes; + byte *temp_alloc = NULL; + Uint bin_size; + + if ((bytes = erts_get_aligned_binary_bytes(bin, &temp_alloc)) == 0) { + BIF_ERROR(p, BADARG); + } + bin_size = binary_size(bin); + if (enc == am_latin1) { + Eterm a; + if (bin_size > MAX_ATOM_LENGTH) { + system_limit: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(p, SYSTEM_LIMIT); + } + if (!must_exist) { + a = am_atom_put((char *)bytes, bin_size); + erts_free_aligned_binary_bytes(temp_alloc); + BIF_RET(a); + } else if (erts_atom_get((char *)bytes, bin_size, &a)) { + erts_free_aligned_binary_bytes(temp_alloc); + BIF_RET(a); + } else { + goto badarg; + } + } else if (enc == am_utf8 || enc == am_unicode) { + char *buf; + char *dst; + int i; + int num_chars; + Eterm res; + + if (bin_size > 2*MAX_ATOM_LENGTH) { + byte* err_pos; + Uint n; + int reds_left = bin_size+1; /* Number of reductions left. */ + + if (analyze_utf8(bytes, bin_size, &err_pos, + &n, &reds_left) == UTF8_OK) { + /* + * Correct UTF-8 encoding, but too many characters to + * fit in an atom. + */ + goto system_limit; + } else { + /* + * Something wrong in the UTF-8 encoding or Unicode code + * points > 255. + */ + goto badarg; + } + } + + /* + * Allocate a temporary buffer the same size as the binary, + * so that we don't need an extra overflow test. + */ + buf = (char *) erts_alloc(ERTS_ALC_T_TMP, bin_size); + dst = buf; + for (i = 0; i < bin_size; i++) { + int c = bytes[i]; + if (c < 0x80) { + *dst++ = c; + } else if (i < bin_size-1) { + int c2; + if ((c & 0xE0) != 0xC0) { + goto free_badarg; + } + i++; + c = (c & 0x3F) << 6; + c2 = bytes[i]; + if ((c2 & 0xC0) != 0x80) { + goto free_badarg; + } + c = c | (c2 & 0x3F); + if (0x80 <= c && c < 256) { + *dst++ = c; + } else { + goto free_badarg; + } + } else { + free_badarg: + erts_free(ERTS_ALC_T_TMP, (void *) buf); + goto badarg; + } + } + num_chars = dst - buf; + if (num_chars > MAX_ATOM_LENGTH) { + erts_free(ERTS_ALC_T_TMP, (void *) buf); + goto system_limit; + } + if (!must_exist) { + res = am_atom_put(buf, num_chars); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + erts_free_aligned_binary_bytes(temp_alloc); + BIF_RET(res); + } else { + int exists = erts_atom_get(buf, num_chars, &res); + erts_free(ERTS_ALC_T_TMP, (void *) buf); + if (exists) { + erts_free_aligned_binary_bytes(temp_alloc); + BIF_RET(res); + } else { + goto badarg; + } + } + } else { + badarg: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(p, BADARG); + } +} + +BIF_RETTYPE binary_to_atom_2(BIF_ALIST_2) +{ + return binary_to_atom(BIF_P, BIF_ARG_1, BIF_ARG_2, 0); +} + +BIF_RETTYPE binary_to_existing_atom_2(BIF_ALIST_2) +{ + return binary_to_atom(BIF_P, BIF_ARG_1, BIF_ARG_2, 1); +} diff --git a/erts/emulator/beam/erl_unicode.h b/erts/emulator/beam/erl_unicode.h new file mode 100644 index 0000000000..1b63b797c2 --- /dev/null +++ b/erts/emulator/beam/erl_unicode.h @@ -0,0 +1,23 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef _ERL_UNICODE_H +#define _ERL_UNICODE_H + +#endif /* _ERL_UNICODE_H */ diff --git a/erts/emulator/beam/erl_vm.h b/erts/emulator/beam/erl_vm.h new file mode 100644 index 0000000000..4d8315ab95 --- /dev/null +++ b/erts/emulator/beam/erl_vm.h @@ -0,0 +1,204 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERL_VM_H__ +#define __ERL_VM_H__ + +/* #define ERTS_OPCODE_COUNTER_SUPPORT */ + +#if defined(HYBRID) +/* # define CHECK_FOR_HOLES */ +#endif + +#if defined(DEBUG) && !defined(CHECK_FOR_HOLES) && !defined(__WIN32__) +# define CHECK_FOR_HOLES +#endif + +#if defined(HYBRID) +/* # define INCREMENTAL 1 */ /* Incremental garbage collection */ +/* # define INC_TIME_BASED 1 */ /* Time-based incremental GC (vs Work-based) */ +#endif + +#define BEAM 1 +#define EMULATOR "BEAM" +#define SEQ_TRACE 1 + +#define CONTEXT_REDS 2000 /* Swap process out after this number */ +#define MAX_ARG 256 /* Max number of arguments allowed */ +#define MAX_REG 1024 /* Max number of x(N) registers used */ + +/* + * The new arithmetic operations need some extra X registers in the register array. + */ +#define ERTS_X_REGS_ALLOCATED (MAX_REG+2) + +#define INPUT_REDUCTIONS (2 * CONTEXT_REDS) + +#define H_DEFAULT_SIZE 233 /* default (heap + stack) min size */ + +#ifdef HYBRID +# define SH_DEFAULT_SIZE 2629425 /* default message area min size */ +#endif + +#ifdef INCREMENTAL +# define INC_NoPAGES 256 /* Number of pages in the old generation */ +# define INC_PAGESIZE 32768 /* The size of each page */ +# define INC_STORAGE_SIZE 1024 /* The size of gray stack and similar */ +#endif + +#define CP_SIZE 1 + +#define ErtsHAllocLockCheck(P) \ + ERTS_SMP_LC_ASSERT((ERTS_PROC_LOCK_MAIN & erts_proc_lc_my_proc_locks((P))) \ + || ((P)->scheduler_data \ + && (P) == (P)->scheduler_data->match_pseudo_process) \ + || erts_is_system_blocked(0)) + +#ifdef DEBUG +/* + * Debug HAlloc that initialize all memory to bad things. + * + * To get information about where memory is allocated, insert the two + * lines below directly after the memset line and use the flag +va. + * + VERBOSE(DEBUG_ALLOCATION,("HAlloc @ 0x%08lx (%d) %s:%d\n", \ + (unsigned long)HEAP_TOP(p),(sz),__FILE__,__LINE__)), \ + */ +#ifdef CHECK_FOR_HOLES +#define HAlloc(p, sz) \ + (ASSERT_EXPR((sz) >= 0), \ + ErtsHAllocLockCheck(p), \ + ((((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \ + ? erts_heap_alloc((p),(sz)) \ + : (erts_set_hole_marker(HEAP_TOP(p), (sz)), \ + HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz)))) +#else +#define HAlloc(p, sz) \ + (ASSERT_EXPR((sz) >= 0), \ + ErtsHAllocLockCheck(p), \ + ((((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \ + ? erts_heap_alloc((p),(sz)) \ + : (memset(HEAP_TOP(p),DEBUG_BAD_BYTE,(sz)*sizeof(Eterm*)), \ + HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz)))) +#endif +#else + +/* + * Allocate heap memory, first on the ordinary heap; + * failing that, in a heap fragment. + */ +#define HAlloc(p, sz) \ + (ASSERT_EXPR((sz) >= 0), \ + ErtsHAllocLockCheck(p), \ + ((((HEAP_LIMIT(p) - HEAP_TOP(p)) < (sz))) \ + ? erts_heap_alloc((p),(sz)) \ + : (HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz)))) + +#endif /* DEBUG */ + +#if defined(CHECK_FOR_HOLES) +# define HRelease(p, endp, ptr) \ + if ((ptr) == (endp)) { \ + ; \ + } else if (HEAP_START(p) <= (ptr) && (ptr) < HEAP_TOP(p)) { \ + HEAP_TOP(p) = (ptr); \ + } else { \ + erts_arith_shrink(p, ptr); \ + } +#else +# define HRelease(p, endp, ptr) \ + if ((ptr) == (endp)) { \ + ; \ + } else if (HEAP_START(p) <= (ptr) && (ptr) < HEAP_TOP(p)) { \ + HEAP_TOP(p) = (ptr); \ + } +#endif + +#define HeapWordsLeft(p) (HEAP_LIMIT(p) - HEAP_TOP(p)) + +#if defined(DEBUG) || defined(CHECK_FOR_HOLES) +# define ERTS_HOLE_MARKER (((0xaf5e78ccUL << 24) << 8) | 0xaf5e78ccUL) +#endif + +/* + * Allocate heap memory on the ordinary heap, NEVER in a heap + * segment. The caller must ensure that there is enough words + * left on the heap before calling HeapOnlyAlloc() (for instance, + * by testing HeapWordsLeft() and calling the garbage collector + * if not enough). + */ +#ifdef CHECK_FOR_HOLES +# define HeapOnlyAlloc(p, sz) \ + (ASSERT_EXPR((sz) >= 0), \ + (ASSERT_EXPR(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \ + (erts_set_hole_marker(HEAP_TOP(p), (sz)), \ + (HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz))))) +#else +# define HeapOnlyAlloc(p, sz) \ + (ASSERT_EXPR((sz) >= 0), \ + (ASSERT_EXPR(((HEAP_LIMIT(p) - HEAP_TOP(p)) >= (sz))), \ + (HEAP_TOP(p) = HEAP_TOP(p) + (sz), HEAP_TOP(p) - (sz)))) +#endif + + +/* + * Description for each instruction (defined here because the name and + * count fields are interesting outside the emulator proper). + */ + +typedef struct op_entry { + char* name; /* Name of instruction. */ + Uint32 mask[3]; /* Signature mask. */ + int sz; /* Number of loaded words. */ + char* pack; /* Instructions for packing engine. */ + char* sign; /* Signature string. */ + unsigned count; /* Number of times executed. */ +} OpEntry; + +extern OpEntry opc[]; /* Description of all instructions. */ +extern int num_instructions; /* Number of instruction in opc[]. */ + +/* some constants for various table sizes etc */ + +#define ATOM_TEXT_SIZE 32768 /* Increment for allocating atom text space */ + +#define ITIME 100 /* Number of milliseconds per clock tick */ +#define MAX_PORT_LINK 8 /* Maximum number of links to a port */ + +extern int H_MIN_SIZE; /* minimum (heap + stack) */ + +#define ORIG_CREATION 0 + +/* macros for extracting bytes from uint16's */ + +#define hi_byte(a) ((a) >> 8) +#define lo_byte(a) ((a) & 255) + +/* macros for combining bytes */ + +#define make_16(x, y) (((x) << 8) | (y)) +#define make_24(x,y,z) (((x) << 16) | ((y) << 8) | (z)) +#define make_32(x3,x2,x1,x0) (((x3)<<24) | ((x2)<<16) | ((x1)<<8) | (x0)) + +#define make_signed_24(x,y,z) ((sint32) (((x) << 24) | ((y) << 16) | ((z) << 8)) >> 8) +#define make_signed_32(x3,x2,x1,x0) ((sint32) (((x3) << 24) | ((x2) << 16) | ((x1) << 8) | (x0))) + +#include "erl_term.h" + +#endif /* __ERL_VM_H__ */ diff --git a/erts/emulator/beam/erl_zlib.c b/erts/emulator/beam/erl_zlib.c new file mode 100644 index 0000000000..f73d48b6c2 --- /dev/null +++ b/erts/emulator/beam/erl_zlib.c @@ -0,0 +1,113 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* A sparse wrapper around zlib with erts memory allocation. + * + * erl_zlib_compress2 and erl_zlib_uncompress are erts-adapted versions + * of the original compress2 and uncompress from zlib-1.2.3. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_zlib.h" + +#include "sys.h" +#include "erl_alloc.h" + +voidpf erl_zlib_zalloc_callback (voidpf opaque, unsigned items, unsigned size) +{ + (void) opaque; /* make compiler happy */ + return erts_alloc_fnf(ERTS_ALC_T_ZLIB, items * size); +} + +void erl_zlib_zfree_callback (voidpf opaque, voidpf ptr) +{ + (void) opaque; /* make compiler happy */ + erts_free(ERTS_ALC_T_ZLIB, ptr); +} + + +int ZEXPORT erl_zlib_compress2 (Bytef* dest, uLongf* destLen, + const Bytef* source, uLong sourceLen, + int level) +{ + z_stream stream; + int err; + + stream.next_in = (Bytef*)source; + stream.avail_in = (uInt)sourceLen; +#ifdef MAXSEG_64K + /* Check for source > 64K on 16-bit machine: */ + if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; +#endif + stream.next_out = dest; + stream.avail_out = (uInt)*destLen; + if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; + + erl_zlib_alloc_init(&stream); + + err = deflateInit(&stream, level); + if (err != Z_OK) return err; + + err = deflate(&stream, Z_FINISH); + if (err != Z_STREAM_END) { + deflateEnd(&stream); + return err == Z_OK ? Z_BUF_ERROR : err; + } + *destLen = stream.total_out; + + err = deflateEnd(&stream); + return err; +} + +int ZEXPORT erl_zlib_uncompress (Bytef* dest, uLongf* destLen, + const Bytef* source, uLong sourceLen) +{ + z_stream stream; + int err; + + stream.next_in = (Bytef*)source; + stream.avail_in = (uInt)sourceLen; + /* Check for source > 64K on 16-bit machine: */ + if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; + + stream.next_out = dest; + stream.avail_out = (uInt)*destLen; + if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; + + erl_zlib_alloc_init(&stream); + + err = inflateInit(&stream); + if (err != Z_OK) return err; + + err = inflate(&stream, Z_FINISH); + if (err != Z_STREAM_END) { + inflateEnd(&stream); + if (err == Z_NEED_DICT || (err == Z_BUF_ERROR && stream.avail_in == 0)) + return Z_DATA_ERROR; + return err; + } + *destLen = stream.total_out; + + err = inflateEnd(&stream); + return err; +} + diff --git a/erts/emulator/beam/erl_zlib.h b/erts/emulator/beam/erl_zlib.h new file mode 100644 index 0000000000..9054a5e428 --- /dev/null +++ b/erts/emulator/beam/erl_zlib.h @@ -0,0 +1,52 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* A sparse wrapper interface around zlib with erts memory allocation. +*/ + +#include + + +/* Initialize zalloc, zfree and opaque of a z_stream +*/ +#define erl_zlib_alloc_init(s) \ + do { /* 'opaque' not used */ \ + (s)->zalloc = erl_zlib_zalloc_callback; \ + (s)->zfree = erl_zlib_zfree_callback; \ + } while (0) + +/* Use instead of compress +*/ +#define erl_zlib_compress(dest,destLen,source,sourceLen) \ + erl_zlib_compress2(dest,destLen,source,sourceLen,Z_DEFAULT_COMPRESSION) + +/* Use instead of compress2 +*/ +int ZEXPORT erl_zlib_compress2 (Bytef* dest, uLongf* destLen, + const Bytef* source, uLong sourceLen, + int level); +/* Use instead of uncompress +*/ +int ZEXPORT erl_zlib_uncompress (Bytef* dest, uLongf* destLen, + const Bytef* source, uLong sourceLen); + + +voidpf erl_zlib_zalloc_callback (voidpf,unsigned,unsigned); +void erl_zlib_zfree_callback (voidpf,voidpf); + diff --git a/erts/emulator/beam/error.h b/erts/emulator/beam/error.h new file mode 100644 index 0000000000..4930def4ed --- /dev/null +++ b/erts/emulator/beam/error.h @@ -0,0 +1,196 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __ERROR_H__ +#define __ERROR_H__ + +/* + * There are three primary exception classes: + * + * - exit Process termination - not an error. + * - error Error (adds stacktrace; will be logged). + * - thrown Nonlocal return (turns into a 'nocatch' + * error if not caught by the process). + * + * In addition, we define a number of exit codes as a convenient + * short-hand: instead of building the error descriptor term at the time + * the exception is raised, it is built as necessary when the exception + * is handled. Examples are EXC_NORMAL, EXC_BADARG, EXC_BADARITH, etc. + * Some of these have convenient aliases, like BADARG and BADARITH. + */ + +/* + * Bits 0-1 index the 'exception class tag' table. + */ +#define EXC_CLASSBITS 3 +#define GET_EXC_CLASS(x) ((x) & EXC_CLASSBITS) + +/* + * Exception class tags (indices into the 'exception_tag' array) + */ +#define EXTAG_ERROR 0 +#define EXTAG_EXIT 1 +#define EXTAG_THROWN 2 + +#define NUMBER_EXC_TAGS 3 /* The number of exception class tags */ + +/* + * Exit code flags (bits 2-7) + * + * These flags make is easier and quicker to decide what to do with the + * exception in the early stages, before a handler is found, and also + * maintains some separation between the class tag and the actions. + */ +#define EXF_PANIC (1<<2) /* ignore catches */ +#define EXF_THROWN (1<<3) /* nonlocal return */ +#define EXF_LOG (1<<4) /* write to logger on termination */ +#define EXF_NATIVE (1<<5) /* occurred in native code */ +#define EXF_SAVETRACE (1<<6) /* save stack trace in internal form */ +#define EXF_ARGLIST (1<<7) /* has arglist for top of trace */ + +#define EXC_FLAGBITS 0x00fc + +/* + * The primary fields of an exception code + */ +#define EXF_PRIMARY (EXF_PANIC | EXF_THROWN | EXF_LOG | EXF_NATIVE) +#define PRIMARY_EXCEPTION(x) ((x) & (EXF_PRIMARY | EXC_CLASSBITS)) +#define NATIVE_EXCEPTION(x) ((x) | EXF_NATIVE) + +/* + * Bits 8-12 of the error code are used for indexing into + * the short-hand error descriptor table. + */ +#define EXC_INDEXBITS 0x1f00 +#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> 8) + +/* + * Exit codes used for raising a fresh exception. The primary exceptions + * share index 0 in the descriptor table. EXC_NULL signals that no + * exception has occurred. The primary exit codes EXC_EXIT, EXC_ERROR + * and EXC_THROWN are the basis for all other exit codes, and must + * always have the EXF_SAVETRACE flag set so that a trace is saved + * whenever a new exception occurs; the flag is then cleared. + */ +#define EXC_NULL 0 /* Initial value for p->freason */ +#define EXC_PRIMARY (0 | EXF_SAVETRACE) +#define EXC_ERROR (EXC_PRIMARY | EXTAG_ERROR | EXF_LOG) + /* Generic error (exit term + * in p->fvalue) */ +#define EXC_EXIT (EXC_PRIMARY | EXTAG_EXIT) + /* Generic exit (exit term + * in p->fvalue) */ +#define EXC_THROWN (EXC_PRIMARY | EXTAG_THROWN | EXF_THROWN) + /* Generic nonlocal return + * (thrown term in p->fvalue) */ + +#define EXC_ERROR_2 (EXC_ERROR | EXF_ARGLIST) + /* Error with given arglist term + * (exit reason in p->fvalue) */ + +#define EXC_NORMAL ((1 << 8) | EXC_EXIT) + /* Normal exit (reason 'normal') */ +#define EXC_INTERNAL_ERROR ((2 << 8) | EXC_ERROR | EXF_PANIC) + /* Things that shouldn't happen */ +#define EXC_BADARG ((3 << 8) | EXC_ERROR) + /* Bad argument to a BIF */ +#define EXC_BADARITH ((4 << 8) | EXC_ERROR) + /* Bad arithmetic */ +#define EXC_BADMATCH ((5 << 8) | EXC_ERROR) + /* Bad match in function body */ +#define EXC_FUNCTION_CLAUSE ((6 << 8) | EXC_ERROR) + /* No matching function head */ +#define EXC_CASE_CLAUSE ((7 << 8) | EXC_ERROR) + /* No matching case clause */ +#define EXC_IF_CLAUSE ((8 << 8) | EXC_ERROR) + /* No matching if clause */ +#define EXC_UNDEF ((9 << 8) | EXC_ERROR) + /* No farity that matches */ +#define EXC_BADFUN ((10 << 8) | EXC_ERROR) + /* Not an existing fun */ +#define EXC_BADARITY ((11 << 8) | EXC_ERROR) + /* Attempt to call fun with + * wrong number of arguments. */ +#define EXC_TIMEOUT_VALUE ((12 << 8) | EXC_ERROR) + /* Bad time out value */ +#define EXC_NOPROC ((13 << 8) | EXC_ERROR) + /* No process or port */ +#define EXC_NOTALIVE ((14 << 8) | EXC_ERROR) + /* Not distributed */ +#define EXC_SYSTEM_LIMIT ((15 << 8) | EXC_ERROR) + /* Ran out of something */ +#define EXC_TRY_CLAUSE ((16 << 8) | EXC_ERROR) + /* No matching try clause */ +#define EXC_NOTSUP ((17 << 8) | EXC_ERROR) + /* Not supported */ + +#define NUMBER_EXIT_CODES 18 /* The number of exit code indices */ + +/* + * Internal pseudo-error codes. + */ +#define TRAP (1 << 8) /* BIF Trap to erlang code */ + +/* + * Aliases for some common exit codes. + */ +#define BADARG EXC_BADARG +#define BADARITH EXC_BADARITH +#define BADMATCH EXC_BADMATCH +#define SYSTEM_LIMIT EXC_SYSTEM_LIMIT + + +/* + * Pseudo error codes (these are never seen by the user). + */ +#define TLOAD_OK 0 /* The threaded code linking was successful */ +#define TLOAD_MAGIC_NUMBER 1 /* Wrong kind of object file */ +#define TLOAD_FORMAT 2 /* Format error while reading object code */ +#define TLOAD_MODULE 3 /* Module name in object code does not match */ +#define TLOAD_SIZE 4 /* Given size in object code differs from actual size */ + +/* + * The exception stack trace parameters. + */ +#define MAX_BACKTRACE_SIZE 64 /* whatever - just not too huge */ +#define DEFAULT_BACKTRACE_SIZE 8 + +/* + * The table translating an exception code to an atom. + */ +extern Eterm error_atom[NUMBER_EXIT_CODES]; + +/* + * The exception tag table. + */ +extern Eterm exception_tag[NUMBER_EXC_TAGS]; + +/* + * The quick-saved stack trace structure + */ +struct StackTrace { + Eterm header; /* bignum header - must be first in struct */ + Eterm freason; /* original exception reason is saved in the struct */ + Eterm* pc; + Eterm* current; + int depth; /* number of saved pointers in trace[] */ + Eterm *trace[1]; /* varying size - must be last in struct */ +}; + +#endif /* __ERROR_H__ */ diff --git a/erts/emulator/beam/export.c b/erts/emulator/beam/export.c new file mode 100644 index 0000000000..271b40cf0f --- /dev/null +++ b/erts/emulator/beam/export.c @@ -0,0 +1,296 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "export.h" +#include "hash.h" + +#define EXPORT_INITIAL_SIZE 4000 +#define EXPORT_LIMIT (512*1024) + +#define EXPORT_HASH(m,f,a) ((m)*(f)+(a)) + +static IndexTable export_table; /* Not locked. */ +static Hash secondary_export_table; /* Locked. */ + +#include "erl_smp.h" + +static erts_smp_rwmtx_t export_table_lock; /* Locks the secondary export table. */ + +#define export_read_lock() erts_smp_rwmtx_rlock(&export_table_lock) +#define export_read_unlock() erts_smp_rwmtx_runlock(&export_table_lock) +#define export_write_lock() erts_smp_rwmtx_rwlock(&export_table_lock) +#define export_write_unlock() erts_smp_rwmtx_rwunlock(&export_table_lock) +#define export_init_lock() erts_smp_rwmtx_init(&export_table_lock, \ + "export_tab") + +extern Eterm* em_call_error_handler; +extern Uint* em_call_traced_function; + +void +export_info(int to, void *to_arg) +{ +#ifdef ERTS_SMP + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + export_read_lock(); +#endif + index_info(to, to_arg, &export_table); + hash_info(to, to_arg, &secondary_export_table); +#ifdef ERTS_SMP + if (lock) + export_read_unlock(); +#endif +} + + +static HashValue +export_hash(Export* x) +{ + return EXPORT_HASH(x->code[0], x->code[1], x->code[2]); +} + +static int +export_cmp(Export* tmpl, Export* obj) +{ + return !(tmpl->code[0] == obj->code[0] && + tmpl->code[1] == obj->code[1] && + tmpl->code[2] == obj->code[2]); +} + + +static Export* +export_alloc(Export* tmpl) +{ + Export* obj = (Export*) erts_alloc(ERTS_ALC_T_EXPORT, sizeof(Export)); + + obj->fake_op_func_info_for_hipe[0] = 0; + obj->fake_op_func_info_for_hipe[1] = 0; + obj->code[0] = tmpl->code[0]; + obj->code[1] = tmpl->code[1]; + obj->code[2] = tmpl->code[2]; + obj->slot.index = -1; + obj->address = obj->code+3; + obj->code[3] = (Eterm) em_call_error_handler; + obj->code[4] = 0; + obj->match_prog_set = NULL; + return obj; +} + + +static void +export_free(Export* obj) +{ + erts_free(ERTS_ALC_T_EXPORT, (void*) obj); +} + + +void +init_export_table(void) +{ + HashFunctions f; + + export_init_lock(); + f.hash = (H_FUN) export_hash; + f.cmp = (HCMP_FUN) export_cmp; + f.alloc = (HALLOC_FUN) export_alloc; + f.free = (HFREE_FUN) export_free; + + erts_index_init(ERTS_ALC_T_EXPORT_TABLE, &export_table, "export_list", + EXPORT_INITIAL_SIZE, EXPORT_LIMIT, f); + hash_init(ERTS_ALC_T_EXPORT_TABLE, &secondary_export_table, + "secondary_export_table", 50, f); +} + +/* + * Return a pointer to the export entry for the given function, + * or NULL otherwise. Notes: + * + * 1) BIFs have export entries and can be called through + * a wrapper in the export entry. + * 2) Functions referenced by a loaded module, but not yet loaded + * also have export entries. The export entry contains + * a wrapper which invokes the error handler if a function is + * called through such an export entry. + * 3) This function is suitable for the implementation of erlang:apply/3. + */ + +Export* +erts_find_export_entry(Eterm m, Eterm f, unsigned int a) +{ + HashValue hval = EXPORT_HASH(m, f, a); + int ix; + HashBucket* b; + + ix = hval % export_table.htable.size; + b = export_table.htable.bucket[ix]; + + /* + * Note: We have inlined the code from hash.c for speed. + */ + + while (b != (HashBucket*) 0) { + Export* ep = (Export *) b; + if (ep->code[0] == m && ep->code[1] == f && ep->code[2] == a) { + break; + } + b = b->next; + } + return (Export*)b; +} + + +/* + * Find the export entry for a loaded function. + * Returns a NULL pointer if the given function is not loaded, or + * a pointer to the export entry. + * + * Note: This function never returns export entries for BIFs + * or functions which are not yet loaded. This makes it suitable + * for use by the erlang:function_exported/3 BIF or whenever you + * cannot depend on the error_handler. + */ + +Export* +erts_find_function(Eterm m, Eterm f, unsigned int a) +{ + Export e; + Export* ep; + + e.code[0] = m; + e.code[1] = f; + e.code[2] = a; + + ep = hash_get(&export_table.htable, (void*) &e); + if (ep != NULL && ep->address == ep->code+3 && + ep->code[3] != (Uint) em_call_traced_function) { + ep = NULL; + } + return ep; +} + +/* + * Returns a pointer to an existing export entry for a MFA, + * or creates a new one and returns the pointer. + * + * This function provides unlocked write access to the main export + * table. It should only be used during start up or when + * all other threads are blocked. + */ + +Export* +erts_export_put(Eterm mod, Eterm func, unsigned int arity) +{ + Export e; + int ix; + + ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0)); + ASSERT(is_atom(mod)); + ASSERT(is_atom(func)); + e.code[0] = mod; + e.code[1] = func; + e.code[2] = arity; + ix = index_put(&export_table, (void*) &e); + return (Export*) erts_index_lookup(&export_table, ix); +} + +/* + * Find the existing export entry for M:F/A. Failing that, create a stub + * export entry (making a call through it will cause the error_handler to + * be called). + * + * Stub export entries will be placed in the secondary export table. + * erts_export_consolidate() will move all stub export entries into the + * main export table (will be done the next time code is loaded). + */ + +Export* +erts_export_get_or_make_stub(Eterm mod, Eterm func, unsigned int arity) +{ + Export e; + Export* ep; + + ASSERT(is_atom(mod)); + ASSERT(is_atom(func)); + + e.code[0] = mod; + e.code[1] = func; + e.code[2] = arity; + ep = erts_find_export_entry(mod, func, arity); + if (ep == 0) { + /* + * The code is not loaded (yet). Put the export in the secondary + * export table, to avoid having to lock the main export table. + */ + export_write_lock(); + ep = (Export *) hash_put(&secondary_export_table, (void*) &e); + export_write_unlock(); + } + return ep; +} + +/* + * To be called before loading code (with other threads blocked). + * This function will move all export entries from the secondary + * export table into the primary. + */ +void +erts_export_consolidate(void) +{ +#ifdef DEBUG + HashInfo hi; +#endif + + ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0)); + + export_write_lock(); + erts_index_merge(&secondary_export_table, &export_table); + erts_hash_merge(&secondary_export_table, &export_table.htable); + export_write_unlock(); +#ifdef DEBUG + hash_get_info(&hi, &export_table.htable); + ASSERT(export_table.entries == hi.objs); +#endif +} + +Export *export_list(int i) +{ + return (Export*) erts_index_lookup(&export_table, i); +} + +int export_list_size(void) +{ + return export_table.entries; +} + +int export_table_sz(void) +{ + return index_table_sz(&export_table); +} + +Export *export_get(Export *e) +{ + return hash_get(&export_table.htable, e); +} diff --git a/erts/emulator/beam/export.h b/erts/emulator/beam/export.h new file mode 100644 index 0000000000..cd6af6dd85 --- /dev/null +++ b/erts/emulator/beam/export.h @@ -0,0 +1,79 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __EXPORT_H__ +#define __EXPORT_H__ + +#ifndef __SYS_H__ +#include "sys.h" +#endif + +#ifndef __INDEX_H__ +#include "index.h" +#endif + +/* +** Export entry +*/ +typedef struct export +{ + IndexSlot slot; /* MUST BE LOCATED AT TOP OF STRUCT!!! */ + void* address; /* Pointer to code for function. */ + struct binary* match_prog_set; /* Match program for tracing. */ + + Eterm fake_op_func_info_for_hipe[2]; /* MUST be just before code[] */ + /* + * code[0]: Tagged atom for module. + * code[1]: Tagged atom for function. + * code[2]: Arity (untagged integer). + * code[3]: This entry is 0 unless the 'address' field points to it. + * Threaded code instruction to load function + * (em_call_error_handler), execute BIF (em_apply_bif, + * em_apply_apply), or call a traced function + * (em_call_traced_function). + * code[4]: Function pointer to BIF function (for BIFs only) + * or pointer to threaded code if the module has an + * on_load function that has not been run yet. + * Otherwise: 0. + */ + Eterm code[5]; +} Export; + + +void init_export_table(void); +void export_info(int, void *); + +Export* erts_find_export_entry(Eterm m, Eterm f, unsigned int a); +Export* erts_export_put(Eterm mod, Eterm func, unsigned int arity); + + +Export* erts_export_get_or_make_stub(Eterm, Eterm, unsigned); +void erts_export_consolidate(void); + +Export *export_list(int); +int export_list_size(void); +int export_table_sz(void); +Export *export_get(Export*); + +#include "beam_load.h" /* For em_* extern declarations */ +#define ExportIsBuiltIn(EntryPtr) \ +(((EntryPtr)->address == (EntryPtr)->code + 3) && \ + ((EntryPtr)->code[3] == (Uint) em_apply_bif)) + +#endif diff --git a/erts/emulator/beam/external.c b/erts/emulator/beam/external.c new file mode 100644 index 0000000000..f856cce18f --- /dev/null +++ b/erts/emulator/beam/external.c @@ -0,0 +1,2839 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Implementation of the erlang external format + * + * And a nice cache mechanism which is used just to send a + * index indicating a specific atom to a remote node instead of the + * entire atom. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERTS_WANT_EXTERNAL_TAGS + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "external.h" +#include "bif.h" +#include "big.h" +#include "dist.h" +#include "erl_binary.h" +#include "erl_bits.h" +#include "erl_zlib.h" + +#ifdef HIPE +#include "hipe_mode_switch.h" +#endif +#define in_area(ptr,start,nbytes) ((Uint)((char*)(ptr) - (char*)(start)) < (nbytes)) + +#define MAX_STRING_LEN 0xffff +#define dec_set_creation(nodename,creat) \ + (((nodename) == erts_this_node->sysname && (creat) == ORIG_CREATION) \ + ? erts_this_node->creation \ + : (creat)) + +#undef ERTS_DEBUG_USE_DIST_SEP +#ifdef DEBUG +# if 0 +/* + * Enabling ERTS_DEBUG_USE_DIST_SEP can be useful when debugging, but the + * result refuses to talk to nodes without it! + */ +# define ERTS_DEBUG_USE_DIST_SEP +# endif +#endif + +/* + * For backward compatibility reasons, only encode integers that + * fit in 28 bits (signed) using INTEGER_EXT. + */ +#define IS_SSMALL28(x) (((Uint) (((x) >> (28-1)) + 1)) < 2) + +/* + * Valid creations for nodes are 1, 2, or 3. 0 can also be sent + * as creation, though. When 0 is used as creation, the real creation + * is unknown. Creation 0 on data will be changed to current + * creation of the node which it belongs to when it enters + * that node. + * This typically happens when a remote pid is created with + * list_to_pid/1 and then sent to the remote node. This behavior + * has the undesirable effect that a pid can be passed between nodes, + * and as a result of that not being equal to itself (the pid that + * comes back isn't equal to the original pid). + * + */ + +static byte* enc_term(ErtsAtomCacheMap *, Eterm, byte*, Uint32); +static Uint is_external_string(Eterm obj, int* p_is_string); +static byte* enc_atom(ErtsAtomCacheMap *, Eterm, byte*, Uint32); +static byte* enc_pid(ErtsAtomCacheMap *, Eterm, byte*, Uint32); +static byte* dec_term(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); +static byte* dec_atom(ErtsDistExternal *, byte*, Eterm*); +static byte* dec_pid(ErtsDistExternal *, Eterm**, byte*, ErlOffHeap*, Eterm*); +static Sint decoded_size(byte *ep, byte* endp, int only_heap_bins); + + +static Uint encode_size_struct2(ErtsAtomCacheMap *, Eterm, unsigned); + +#define ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES 255 + +#define ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTE_IX(IIX) \ + (((((Uint32) (IIX)) >> 1) & 0x7fffffff)) +#define ERTS_DIST_HDR_ATOM_CACHE_FLAG_BIT_IX(IIX) \ + (((IIX) << 2) & 7) +#define ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTES(NO_ATOMS) \ + (((((Uint32) (NO_ATOMS)) >> 1) & 0x7fffffff)+1) + +#define ERTS_DIST_HDR_LONG_ATOMS_FLG (1 << 0) + +/* #define ERTS_ATOM_CACHE_HASH */ +#define ERTS_USE_ATOM_CACHE_SIZE 2039 +#if ERTS_ATOM_CACHE_SIZE < ERTS_USE_ATOM_CACHE_SIZE +#error "ERTS_USE_ATOM_CACHE_SIZE too large" +#endif + +static ERTS_INLINE int +atom2cix(Eterm atom) +{ + Uint val; + ASSERT(is_atom(atom)); + val = atom_val(atom); +#ifdef ERTS_ATOM_CACHE_HASH + val = atom_tab(val)->slot.bucket.hvalue; +#endif +#if ERTS_USE_ATOM_CACHE_SIZE == 256 + return (int) (val & ((Uint) 0xff)); +#else + return (int) (val % ERTS_USE_ATOM_CACHE_SIZE); +#endif +} + +int erts_debug_max_atom_out_cache_index(void) +{ + return ERTS_USE_ATOM_CACHE_SIZE-1; +} + +int +erts_debug_atom_to_out_cache_index(Eterm atom) +{ + return atom2cix(atom); +} + +void +erts_init_atom_cache_map(ErtsAtomCacheMap *acmp) +{ + if (acmp) { + int ix; + for (ix = 0; ix < ERTS_ATOM_CACHE_SIZE; ix++) + acmp->cache[ix].iix = -1; + acmp->sz = 0; + acmp->hdr_sz = -1; + } +} + +void +erts_reset_atom_cache_map(ErtsAtomCacheMap *acmp) +{ + if (acmp) { + int i; + for (i = 0; i < acmp->sz; i++) { + ASSERT(0 <= acmp->cix[i] && acmp->cix[i] < ERTS_ATOM_CACHE_SIZE); + acmp->cache[acmp->cix[i]].iix = -1; + } + acmp->sz = 0; + acmp->hdr_sz = -1; +#ifdef DEBUG + for (i = 0; i < ERTS_ATOM_CACHE_SIZE; i++) { + ASSERT(acmp->cache[i].iix < 0); + } +#endif + } +} + +void +erts_destroy_atom_cache_map(ErtsAtomCacheMap *acmp) +{ + +} + +static ERTS_INLINE void +insert_acache_map(ErtsAtomCacheMap *acmp, Eterm atom) +{ + if (acmp && acmp->sz < ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES) { + int ix; + ASSERT(acmp->hdr_sz < 0); + ix = atom2cix(atom); + if (acmp->cache[ix].iix < 0) { + acmp->cache[ix].iix = acmp->sz; + acmp->cix[acmp->sz++] = ix; + acmp->cache[ix].atom = atom; + } + } +} + +static ERTS_INLINE int +get_iix_acache_map(ErtsAtomCacheMap *acmp, Eterm atom) +{ + if (!acmp) + return -1; + else { + int ix; + ASSERT(is_atom(atom)); + ix = atom2cix(atom); + if (acmp->cache[ix].iix < 0) { + ASSERT(acmp->sz == ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES); + return -1; + } + else { + ASSERT(acmp->cache[ix].iix < ERTS_ATOM_CACHE_SIZE); + return acmp->cache[ix].atom == atom ? acmp->cache[ix].iix : -1; + } + } +} + +void +erts_finalize_atom_cache_map(ErtsAtomCacheMap *acmp) +{ + if (acmp) { +#if MAX_ATOM_LENGTH > 255 +#error "This code is not complete; long_atoms info need to be passed to the following stages." + int long_atoms = 0; /* !0 if one or more atoms are long than 255. */ +#endif + int i; + int sz; + int fix_sz + = 1 /* VERSION_MAGIC */ + + 1 /* DIST_HEADER */ + + 1 /* number of internal cache entries */ + ; + int min_sz; + ASSERT(acmp->hdr_sz < 0); + /* Make sure cache update instructions fit */ + min_sz = fix_sz+(2+4)*acmp->sz; + sz = fix_sz; + for (i = 0; i < acmp->sz; i++) { + Eterm atom; + int len; + atom = acmp->cache[acmp->cix[i]].atom; + ASSERT(is_atom(atom)); + len = atom_tab(atom_val(atom))->len; +#if MAX_ATOM_LENGTH > 255 + if (!long_atoms && len > 255) + long_atoms = 1; +#endif + /* Enough for a new atom cache value */ + sz += 1 /* cix */ + 1 /* length */ + len /* text */; + } +#if MAX_ATOM_LENGTH > 255 + if (long_atoms) + sz += acmp->sz; /* we need 2 bytes per atom for length */ +#endif + /* Dynamically sized flag field */ + sz += ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTES(acmp->sz); + if (sz < min_sz) + sz = min_sz; + acmp->hdr_sz = sz; + } +} + +Uint +erts_encode_ext_dist_header_size(ErtsAtomCacheMap *acmp) +{ + if (!acmp) + return 0; + else { + ASSERT(acmp->hdr_sz >= 0); + return acmp->hdr_sz; + } +} + +byte *erts_encode_ext_dist_header_setup(byte *ctl_ext, ErtsAtomCacheMap *acmp) +{ +#ifndef ARCH_32 +#if ATOM_LIMIT >= (1UL << 32) +#error "ATOM_LIMIT too large for interal atom cache update instructions. New instructions needed." +#endif +#endif + if (!acmp) + return ctl_ext; + else { + int i; + byte *ep = ctl_ext; + ASSERT(acmp->hdr_sz >= 0); + /* + * Write cache update instructions. Note that this is a purely + * internal format, never seen on the wire. This section is later + * rewritten by erts_encode_ext_dist_header_finalize() while updating + * the cache. We write the header backwards just before the + * actual term(s). + */ + for (i = acmp->sz-1; i >= 0; i--) { + Uint32 aval; + ASSERT(0 <= acmp->cix[i] && acmp->cix[i] < ERTS_ATOM_CACHE_SIZE); + ASSERT(i == acmp->cache[acmp->cix[i]].iix); + ASSERT(is_atom(acmp->cache[acmp->cix[i]].atom)); + + aval = (Uint32) atom_val(acmp->cache[acmp->cix[i]].atom); + ep -= 4; + put_int32(aval, ep); + ep -= 2; + put_int16(acmp->cix[i], ep); + } + --ep; + put_int8(acmp->sz, ep); + *--ep = DIST_HEADER; + *--ep = VERSION_MAGIC; + return ep; + } +} + +byte *erts_encode_ext_dist_header_finalize(byte *ext, ErtsAtomCache *cache) +{ + byte *ip; + byte instr_buf[(2+4)*ERTS_ATOM_CACHE_SIZE]; + int ci, sz; + register byte *ep = ext; + ASSERT(ep[0] == VERSION_MAGIC); + if (ep[1] != DIST_HEADER) + return ext; + + /* + * Update output atom cache and write the external version of + * the dist header. We write the header backwards just + * before the actual term(s). + */ + ep += 2; + ci = (int) get_int8(ep); + ASSERT(0 <= ci && ci < ERTS_ATOM_CACHE_SIZE); + ep += 1; + sz = (2+4)*ci; + ip = &instr_buf[0]; + sys_memcpy((void *) ip, (void *) ep, sz); + ep += sz; + /* ep now points to the beginning of the control message term */ +#ifdef ERTS_DEBUG_USE_DIST_SEP + ASSERT(*ep == VERSION_MAGIC); +#endif + if (ci > 0) { + Uint32 flgs_buf[((ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTES( + ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES)-1) + / sizeof(Uint32))+1]; + register Uint32 flgs; + int iix, flgs_bytes, flgs_buf_ix, used_half_bytes; +#ifdef DEBUG + int tot_used_half_bytes; +#endif + + flgs_bytes = ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTES(ci); + + ASSERT(flgs_bytes <= sizeof(flgs_buf)); +#if MAX_ATOM_LENGTH > 255 + /* long_atoms info needs to be passed from previous stages */ + if (long_atoms) + flgs |= ERTS_DIST_HDR_LONG_ATOMS_FLG; +#endif + flgs = 0; + flgs_buf_ix = 0; + if ((ci & 1) == 0) + used_half_bytes = 2; + else + used_half_bytes = 1; +#ifdef DEBUG + tot_used_half_bytes = used_half_bytes; +#endif + iix = ci-1; + while (iix >= 0) { + int cix; + Eterm atom; + + if (used_half_bytes != 8) + flgs <<= 4; + else { + flgs_buf[flgs_buf_ix++] = flgs; + flgs = 0; + used_half_bytes = 0; + } + + ip = &instr_buf[0] + (2+4)*iix; + cix = (int) get_int16(&ip[0]); + ASSERT(0 <= cix && cix < ERTS_ATOM_CACHE_SIZE); + atom = make_atom((Uint) get_int32(&ip[2])); + if (cache->out_arr[cix] == atom) { + --ep; + put_int8(cix, ep); + flgs |= ((cix >> 8) & 7); + } + else { + Atom *a; + cache->out_arr[cix] = atom; + a = atom_tab(atom_val(atom)); + sz = a->len; + ep -= sz; + sys_memcpy((void *) ep, (void *) a->name, sz); +#if MAX_ATOM_LENGTH > 255 + if (long_atoms) { + ep -= 2; + put_int16(sz, ep); + } + else +#endif + { + ASSERT(0 <= sz && sz <= 255); + --ep; + put_int8(sz, ep); + } + --ep; + put_int8(cix, ep); + flgs |= (8 | ((cix >> 8) & 7)); + } + iix--; + used_half_bytes++; +#ifdef DEBUG + tot_used_half_bytes++; +#endif + } + ASSERT(tot_used_half_bytes == 2*flgs_bytes); + flgs_buf[flgs_buf_ix] = flgs; + flgs_buf_ix = 0; + while (1) { + flgs = flgs_buf[flgs_buf_ix]; + if (flgs_bytes > 4) { + *--ep = (byte) ((flgs >> 24) & 0xff); + *--ep = (byte) ((flgs >> 16) & 0xff); + *--ep = (byte) ((flgs >> 8) & 0xff); + *--ep = (byte) (flgs & 0xff); + flgs_buf_ix++; + flgs_bytes -= 4; + } + else { + switch (flgs_bytes) { + case 4: + *--ep = (byte) ((flgs >> 24) & 0xff); + case 3: + *--ep = (byte) ((flgs >> 16) & 0xff); + case 2: + *--ep = (byte) ((flgs >> 8) & 0xff); + case 1: + *--ep = (byte) (flgs & 0xff); + } + break; + } + } + } + --ep; + put_int8(ci, ep); + *--ep = DIST_HEADER; + *--ep = VERSION_MAGIC; + return ep; +} + +Uint erts_encode_dist_ext_size(Eterm term, Uint32 flags, ErtsAtomCacheMap *acmp) +{ + Uint sz = 0; +#ifndef ERTS_DEBUG_USE_DIST_SEP + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) +#endif + sz++ /* VERSION_MAGIC */; + sz += encode_size_struct2(acmp, term, flags); + return sz; +} + +Uint erts_encode_ext_size(Eterm term) +{ + return encode_size_struct2(NULL, term, TERM_TO_BINARY_DFLAGS) + + 1 /* VERSION_MAGIC */; +} + +void erts_encode_dist_ext(Eterm term, byte **ext, Uint32 flags, ErtsAtomCacheMap *acmp) +{ + byte *ep = *ext; +#ifndef ERTS_DEBUG_USE_DIST_SEP + if (!(flags & DFLAG_DIST_HDR_ATOM_CACHE)) +#endif + *ep++ = VERSION_MAGIC; + ep = enc_term(acmp, term, ep, flags); + if (!ep) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:erts_encode_dist_ext(): Internal data structure error\n", + __FILE__, __LINE__); + *ext = ep; +} + +void erts_encode_ext(Eterm term, byte **ext) +{ + byte *ep = *ext; + *ep++ = VERSION_MAGIC; + ep = enc_term(NULL, term, ep, TERM_TO_BINARY_DFLAGS); + if (!ep) + erl_exit(ERTS_ABORT_EXIT, + "%s:%d:erts_encode_ext(): Internal data structure error\n", + __FILE__, __LINE__); + *ext = ep; +} + +ErtsDistExternal * +erts_make_dist_ext_copy(ErtsDistExternal *edep, Uint xsize) +{ + size_t align_sz; + size_t dist_ext_sz; + size_t ext_sz; + byte *ep; + ErtsDistExternal *new_edep; + + dist_ext_sz = ERTS_DIST_EXT_SIZE(edep); + ASSERT(edep->ext_endp && edep->extp); + ASSERT(edep->ext_endp >= edep->extp); + ext_sz = edep->ext_endp - edep->extp; + + align_sz = ERTS_WORD_ALIGN_PAD_SZ(dist_ext_sz + ext_sz); + + new_edep = erts_alloc(ERTS_ALC_T_EXT_TERM_DATA, + dist_ext_sz + ext_sz + align_sz + xsize); + + ep = (byte *) new_edep; + sys_memcpy((void *) ep, (void *) edep, dist_ext_sz); + ep += dist_ext_sz; + if (new_edep->dep) + erts_refc_inc(&new_edep->dep->refc, 1); + new_edep->extp = ep; + new_edep->ext_endp = ep + ext_sz; + new_edep->heap_size = -1; + sys_memcpy((void *) ep, (void *) edep->extp, ext_sz); + return new_edep; +} + +int +erts_prepare_dist_ext(ErtsDistExternal *edep, + byte *ext, + Uint size, + DistEntry *dep, + ErtsAtomCache *cache) +{ +#undef ERTS_EXT_FAIL +#undef ERTS_EXT_HDR_FAIL +#if 1 +#define ERTS_EXT_FAIL goto fail +#define ERTS_EXT_HDR_FAIL goto bad_hdr +#else +#define ERTS_EXT_FAIL abort() +#define ERTS_EXT_HDR_FAIL abort() +#endif + + register byte *ep = ext; + + edep->heap_size = -1; + edep->ext_endp = ext+size; + + if (size < 2) + ERTS_EXT_FAIL; + + if (ep[0] != VERSION_MAGIC) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + if (dep) + erts_dsprintf(dsbufp, + "** Got message from incompatible erlang on " + "channel %d\n", + dist_entry_channel_no(dep)); + else + erts_dsprintf(dsbufp, + "** Attempt to convert old incompatible " + "binary %d\n", + *ep); + erts_send_error_to_logger_nogl(dsbufp); + ERTS_EXT_FAIL; + } + + edep->flags = 0; + edep->dep = dep; + if (dep) { + erts_smp_de_rlock(dep); + if (dep->flags & DFLAG_DIST_HDR_ATOM_CACHE) + edep->flags |= ERTS_DIST_EXT_DFLAG_HDR; + + edep->flags |= (dep->connection_id & ERTS_DIST_EXT_CON_ID_MASK); + erts_smp_de_runlock(dep); + } + + if (ep[1] != DIST_HEADER) { + if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) + ERTS_EXT_HDR_FAIL; + edep->attab.size = 0; + edep->extp = ext; + } + else { + int tix; + int no_atoms; + + if (!(edep->flags & ERTS_DIST_EXT_DFLAG_HDR)) + ERTS_EXT_HDR_FAIL; + +#undef CHKSIZE +#define CHKSIZE(SZ) \ + do { if ((SZ) > edep->ext_endp - ep) ERTS_EXT_HDR_FAIL; } while(0) + + CHKSIZE(1+1+1); + ep += 2; + no_atoms = (int) get_int8(ep); + if (no_atoms < 0 || ERTS_ATOM_CACHE_SIZE < no_atoms) + ERTS_EXT_HDR_FAIL; + ep++; + if (no_atoms) { +#if MAX_ATOM_LENGTH > 255 + int long_atoms = 0; +#endif +#ifdef DEBUG + byte *flgs_buf = ep; +#endif + byte *flgsp = ep; + int flgs_size = ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTES(no_atoms); + int byte_ix; + int bit_ix; + int got_flgs; + register Uint32 flgs = 0; + + CHKSIZE(flgs_size); + ep += flgs_size; + + /* + * Check long atoms flag + */ + byte_ix = ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTE_IX(no_atoms); + bit_ix = ERTS_DIST_HDR_ATOM_CACHE_FLAG_BIT_IX(no_atoms); + if (flgsp[byte_ix] & (((byte) ERTS_DIST_HDR_LONG_ATOMS_FLG) + << bit_ix)) { +#if MAX_ATOM_LENGTH > 255 + long_atoms = 1; +#else + ERTS_EXT_HDR_FAIL; /* Long atoms not supported yet */ +#endif + } + +#ifdef DEBUG + byte_ix = 0; + bit_ix = 0; +#endif + got_flgs = 0; + /* + * Setup the atom translation table. + */ + edep->flags |= ERTS_DIST_EXT_ATOM_TRANS_TAB; + edep->attab.size = no_atoms; + for (tix = 0; tix < no_atoms; tix++) { + Eterm atom; + int cix; + int len; + + if (!got_flgs) { + int left = no_atoms - tix; + if (left > 6) { + flgs = ((((Uint32) flgsp[3]) << 24) + | (((Uint32) flgsp[2]) << 16) + | (((Uint32) flgsp[1]) << 8) + | ((Uint32) flgsp[0])); + flgsp += 4; + } + else { + flgs = 0; + switch (left) { + case 6: + case 5: + flgs |= (((Uint32) flgsp[2]) << 16); + case 4: + case 3: + flgs |= (((Uint32) flgsp[1]) << 8); + case 2: + case 1: + flgs |= ((Uint32) flgsp[0]); + } + } + got_flgs = 8; + } + + ASSERT(byte_ix == ERTS_DIST_HDR_ATOM_CACHE_FLAG_BYTE_IX(tix)); + ASSERT(bit_ix == ERTS_DIST_HDR_ATOM_CACHE_FLAG_BIT_IX(tix)); + ASSERT((flgs & 3) + == (((flgs_buf[byte_ix] + & (((byte) 3) << bit_ix)) >> bit_ix) & 3)); + + CHKSIZE(1); + cix = (int) ((flgs & 7) << 8); + if ((flgs & 8) == 0) { + /* atom already cached */ + cix += (int) get_int8(ep); + if (cix >= ERTS_ATOM_CACHE_SIZE) + ERTS_EXT_HDR_FAIL; + ep++; + atom = cache->in_arr[cix]; + if (!is_atom(atom)) + ERTS_EXT_HDR_FAIL; + edep->attab.atom[tix] = atom; + } + else { + /* new cached atom */ + cix += (int) get_int8(ep); + if (cix >= ERTS_ATOM_CACHE_SIZE) + ERTS_EXT_HDR_FAIL; + ep++; +#if MAX_ATOM_LENGTH > 255 + if (long_atoms) { + CHKSIZE(2); + len = get_int16(ep); + ep += 2; + } + else +#endif + { + CHKSIZE(1); + len = get_int8(ep); + ep++; + } + if (len > MAX_ATOM_LENGTH) + ERTS_EXT_HDR_FAIL; /* Too long atom */ + CHKSIZE(len); + atom = am_atom_put((char *) ep, len); + ep += len; + cache->in_arr[cix] = atom; + edep->attab.atom[tix] = atom; + } + flgs >>= 4; + got_flgs--; +#ifdef DEBUG + bit_ix += 4; + if (bit_ix >= 8) { + bit_ix = 0; + flgs = (int) flgs_buf[++byte_ix]; + ASSERT(byte_ix < flgs_size); + } +#endif + } + } + edep->extp = ep; +#ifdef ERTS_DEBUG_USE_DIST_SEP + if (*ep != VERSION_MAGIC) + ERTS_EXT_HDR_FAIL; +#endif + } +#ifdef ERTS_DEBUG_USE_DIST_SEP + if (*ep != VERSION_MAGIC) + ERTS_EXT_FAIL; +#endif + + return 0; + +#undef CHKSIZE +#undef ERTS_EXT_FAIL +#undef ERTS_EXT_HDR_FAIL + + bad_hdr: + if (dep) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "%T got a corrupted distribution header from %T " + "on distribution channel %d\n", + erts_this_node->sysname, + edep->dep->sysname, + dist_entry_channel_no(edep->dep)); + for (ep = ext; ep < edep->ext_endp; ep++) + erts_dsprintf(dsbufp, ep != ext ? ",%b8u" : "<<%b8u", *ep); + erts_dsprintf(dsbufp, ">>"); + erts_send_warning_to_logger_nogl(dsbufp); + } + fail: + if (dep) + erts_kill_dist_connection(dep, dep->connection_id); + return -1; +} + +static void +bad_dist_ext(ErtsDistExternal *edep) +{ + if (edep->dep) { + DistEntry *dep = edep->dep; + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + byte *ep; + erts_dsprintf(dsbufp, + "%T got a corrupted external term from %T " + "on distribution channel %d\n", + erts_this_node->sysname, + dep->sysname, + dist_entry_channel_no(dep)); + for (ep = edep->extp; ep < edep->ext_endp; ep++) + erts_dsprintf(dsbufp, + ep != edep->extp ? ",%b8u" : "<<...,%b8u", + *ep); + erts_dsprintf(dsbufp, ">>\n"); + erts_dsprintf(dsbufp, "ATOM_CACHE_REF translations: "); + if (!(edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) || !edep->attab.size) + erts_dsprintf(dsbufp, "none"); + else { + int i; + erts_dsprintf(dsbufp, "0=%T", edep->attab.atom[0]); + for (i = 1; i < edep->attab.size; i++) + erts_dsprintf(dsbufp, ", %d=%T", i, edep->attab.atom[i]); + } + erts_send_warning_to_logger_nogl(dsbufp); + erts_kill_dist_connection(dep, ERTS_DIST_EXT_CON_ID(edep)); + } +} + +Sint +erts_decode_dist_ext_size(ErtsDistExternal *edep, int no_refc_bins) +{ + Sint res; + byte *ep; + if (edep->extp >= edep->ext_endp) + goto fail; +#ifndef ERTS_DEBUG_USE_DIST_SEP + if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) { + if (*edep->extp == VERSION_MAGIC) + goto fail; + ep = edep->extp; + } + else +#endif + { + if (*edep->extp != VERSION_MAGIC) + goto fail; + ep = edep->extp+1; + } + res = decoded_size(ep, edep->ext_endp, no_refc_bins); + if (res >= 0) + return res; + fail: + bad_dist_ext(edep); + return -1; +} + +Sint erts_decode_ext_size(byte *ext, Uint size, int no_refc_bins) +{ + if (size == 0 || *ext != VERSION_MAGIC) + return -1; + return decoded_size(ext+1, ext+size, no_refc_bins); +} + +/* +** hpp is set to either a &p->htop or +** a pointer to a memory pointer (form message buffers) +** on return hpp is updated to point after allocated data +*/ +Eterm +erts_decode_dist_ext(Eterm** hpp, + ErlOffHeap* off_heap, + ErtsDistExternal *edep) +{ + Eterm obj; + byte* ep = edep->extp; + + if (ep >= edep->ext_endp) + goto error; +#ifndef ERTS_DEBUG_USE_DIST_SEP + if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) { + if (*ep == VERSION_MAGIC) + goto error; + } + else +#endif + { + if (*ep != VERSION_MAGIC) + goto error; + ep++; + } + ep = dec_term(edep, hpp, ep, off_heap, &obj); + if (!ep) + goto error; + + edep->extp = ep; + + return obj; + + error: + + bad_dist_ext(edep); + + return THE_NON_VALUE; +} + +Eterm erts_decode_ext(Eterm **hpp, ErlOffHeap *off_heap, byte **ext) +{ + Eterm obj; + byte *ep = *ext; + if (*ep++ != VERSION_MAGIC) + return THE_NON_VALUE; + ep = dec_term(NULL, hpp, ep, off_heap, &obj); + if (!ep) { +#ifdef DEBUG + bin_write(ERTS_PRINT_STDERR,NULL,*ext,500); +#endif + return THE_NON_VALUE; + } + *ext = ep; + return obj; +} + + + +/**********************************************************************/ + +BIF_RETTYPE erts_debug_dist_ext_to_term_2(BIF_ALIST_2) +{ + Eterm res; + Eterm *hp; + Eterm *hendp; + Uint hsz; + ErtsDistExternal ede; + Eterm *tp; + Eterm real_bin; + Uint offset; + Uint size; + Uint bitsize; + Uint bitoffs; + Uint arity; + int i; + + ede.flags = ERTS_DIST_EXT_ATOM_TRANS_TAB; + ede.dep = NULL; + ede.heap_size = -1; + + if (is_not_tuple(BIF_ARG_1)) + goto badarg; + tp = tuple_val(BIF_ARG_1); + arity = arityval(tp[0]); + if (arity > ERTS_MAX_INTERNAL_ATOM_CACHE_ENTRIES) + goto badarg; + + ede.attab.size = arity; + for (i = 1; i <= arity; i++) { + if (is_not_atom(tp[i])) + goto badarg; + ede.attab.atom[i-1] = tp[i]; + } + + if (is_not_binary(BIF_ARG_2)) + goto badarg; + + size = binary_size(BIF_ARG_2); + if (size == 0) + goto badarg; + ERTS_GET_REAL_BIN(BIF_ARG_2, real_bin, offset, bitoffs, bitsize); + if (bitsize != 0) + goto badarg; + + ede.extp = binary_bytes(real_bin)+offset; + ede.ext_endp = ede.extp + size; + + hsz = erts_decode_dist_ext_size(&ede, 0); + if (hsz < 0) + goto badarg; + + hp = HAlloc(BIF_P, hsz); + hendp = hp + hsz; + + res = erts_decode_dist_ext(&hp, &MSO(BIF_P), &ede); + + HRelease(BIF_P, hendp, hp); + + if (is_value(res)) + BIF_RET(res); + + badarg: + + BIF_ERROR(BIF_P, BADARG); +} + + +Eterm +term_to_binary_1(Process* p, Eterm Term) +{ + return erts_term_to_binary(p, Term, 0, TERM_TO_BINARY_DFLAGS); +} + +Eterm +term_to_binary_2(Process* p, Eterm Term, Eterm Flags) +{ + int level = 0; + Uint flags = TERM_TO_BINARY_DFLAGS; + + while (is_list(Flags)) { + Eterm arg = CAR(list_val(Flags)); + Eterm* tp; + if (arg == am_compressed) { + level = Z_DEFAULT_COMPRESSION; + } else if (is_tuple(arg) && *(tp = tuple_val(arg)) == make_arityval(2)) { + if (tp[1] == am_minor_version && is_small(tp[2])) { + switch (signed_val(tp[2])) { + case 0: + flags = TERM_TO_BINARY_DFLAGS; + break; + case 1: + flags = TERM_TO_BINARY_DFLAGS|DFLAG_NEW_FLOATS; + break; + default: + goto error; + } + } else if (tp[1] == am_compressed && is_small(tp[2])) { + level = signed_val(tp[2]); + if (!(0 <= level && level < 10)) { + goto error; + } + } else { + goto error; + } + } else { + error: + BIF_ERROR(p, BADARG); + } + Flags = CDR(list_val(Flags)); + } + if (is_not_nil(Flags)) { + goto error; + } + + return erts_term_to_binary(p, Term, level, flags); +} + +static ERTS_INLINE Sint +binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size) +{ + Sint res; + byte *bytes = data; + Sint size = data_size; + + state->exttmp = 0; + + if (size < 1 || *bytes != VERSION_MAGIC) { + error: + if (state->exttmp) + erts_free(ERTS_ALC_T_TMP, state->extp); + state->extp = NULL; + state->exttmp = 0; + return -1; + } + bytes++; + size--; + if (size < 5 || *bytes != COMPRESSED) { + state->extp = bytes; + } + else { + uLongf dest_len = get_int32(bytes+1); + state->extp = erts_alloc(ERTS_ALC_T_TMP, dest_len); + state->exttmp = 1; + if (erl_zlib_uncompress(state->extp, &dest_len, bytes+5, size-5) != Z_OK) + goto error; + size = (Sint) dest_len; + } + res = decoded_size(state->extp, state->extp + size, 0); + if (res < 0) + goto error; + return res; +} + +static ERTS_INLINE void +binary2term_abort(ErtsBinary2TermState *state) +{ + if (state->exttmp) { + state->exttmp = 0; + erts_free(ERTS_ALC_T_TMP, state->extp); + } +} + +static ERTS_INLINE Eterm +binary2term_create(ErtsBinary2TermState *state, Eterm **hpp, ErlOffHeap *ohp) +{ + Eterm res; + if (!dec_term(NULL, hpp, state->extp, ohp, &res)) + res = THE_NON_VALUE; + if (state->exttmp) { + state->exttmp = 0; + erts_free(ERTS_ALC_T_TMP, state->extp); + } + return res; +} + +Sint +erts_binary2term_prepare(ErtsBinary2TermState *state, byte *data, Sint data_size) +{ + return binary2term_prepare(state, data, data_size); +} + +void +erts_binary2term_abort(ErtsBinary2TermState *state) +{ + binary2term_abort(state); +} + +Eterm +erts_binary2term_create(ErtsBinary2TermState *state, Eterm **hpp, ErlOffHeap *ohp) +{ + return binary2term_create(state, hpp, ohp); +} + +BIF_RETTYPE binary_to_term_1(BIF_ALIST_1) +{ + Sint heap_size; + Eterm res; + Eterm* hp; + Eterm* endp; + Sint size; + byte* bytes; + byte* temp_alloc = NULL; + ErtsBinary2TermState b2ts; + + if ((bytes = erts_get_aligned_binary_bytes(BIF_ARG_1, &temp_alloc)) == NULL) { + error: + erts_free_aligned_binary_bytes(temp_alloc); + BIF_ERROR(BIF_P, BADARG); + } + size = binary_size(BIF_ARG_1); + + heap_size = binary2term_prepare(&b2ts, bytes, size); + if (heap_size < 0) + goto error; + + hp = HAlloc(BIF_P, heap_size); + endp = hp + heap_size; + + res = binary2term_create(&b2ts, &hp, &MSO(BIF_P)); + + erts_free_aligned_binary_bytes(temp_alloc); + + if (hp > endp) { + erl_exit(1, ":%s, line %d: heap overrun by %d words(s)\n", + __FILE__, __LINE__, hp-endp); + } + + HRelease(BIF_P, endp, hp); + + if (res == THE_NON_VALUE) + goto error; + + return res; +} + +Eterm +external_size_1(Process* p, Eterm Term) +{ + Uint size = erts_encode_ext_size(Term); + if (IS_USMALL(0, size)) { + BIF_RET(make_small(size)); + } else { + Eterm* hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + BIF_RET(uint_to_big(size, hp)); + } +} + +Eterm +erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags) +{ + int size; + Eterm bin; + size_t real_size; + byte* endp; + + size = encode_size_struct2(NULL, Term, flags) + 1 /* VERSION_MAGIC */; + + if (level != 0) { + byte buf[256]; + byte* bytes = buf; + byte* out_bytes; + uLongf dest_len; + + if (sizeof(buf) < size) { + bytes = erts_alloc(ERTS_ALC_T_TMP, size); + } + + if ((endp = enc_term(NULL, Term, bytes, flags)) + == NULL) { + erl_exit(1, "%s, line %d: bad term: %x\n", + __FILE__, __LINE__, Term); + } + real_size = endp - bytes; + if (real_size > size) { + erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", + __FILE__, __LINE__, real_size - size); + } + + /* + * We don't want to compress if compression actually increases the size. + * Therefore, don't give zlib more out buffer than the size of the + * uncompressed external format (minus the 5 bytes needed for the + * COMPRESSED tag). If zlib returns any error, we'll revert to using + * the original uncompressed external term format. + */ + + if (real_size < 5) { + dest_len = 0; + } else { + dest_len = real_size - 5; + } + bin = new_binary(p, NULL, real_size+1); + out_bytes = binary_bytes(bin); + out_bytes[0] = VERSION_MAGIC; + if (erl_zlib_compress2(out_bytes+6, &dest_len, bytes, real_size, level) != Z_OK) { + sys_memcpy(out_bytes+1, bytes, real_size); + bin = erts_realloc_binary(bin, real_size+1); + } else { + out_bytes[1] = COMPRESSED; + put_int32(real_size, out_bytes+2); + bin = erts_realloc_binary(bin, dest_len+6); + } + if (bytes != buf) { + erts_free(ERTS_ALC_T_TMP, bytes); + } + return bin; + } else { + byte* bytes; + + bin = new_binary(p, (byte *)NULL, size); + bytes = binary_bytes(bin); + bytes[0] = VERSION_MAGIC; + if ((endp = enc_term(NULL, Term, bytes+1, flags)) + == NULL) { + erl_exit(1, "%s, line %d: bad term: %x\n", + __FILE__, __LINE__, Term); + } + real_size = endp - bytes; + if (real_size > size) { + erl_exit(1, "%s, line %d: buffer overflow: %d word(s)\n", + __FILE__, __LINE__, endp - (bytes + size)); + } + return erts_realloc_binary(bin, real_size); + } +} + +/* + * This function fills ext with the external format of atom. + * If it's an old atom we just supply an index, otherwise + * we insert the index _and_ the entire atom. This way the receiving side + * does not have to perform an hash on the etom to locate it, and + * we save a lot of space on the wire. + */ + +static byte* +enc_atom(ErtsAtomCacheMap *acmp, Eterm atom, byte *ep, Uint32 dflags) +{ + int iix; + int i, j; + + ASSERT(is_atom(atom)); + + /* + * term_to_binary/1,2 and the initial distribution message + * don't use the cache. + */ + iix = get_iix_acache_map(acmp, atom); + if (iix < 0) { + i = atom_val(atom); + j = atom_tab(i)->len; + if ((MAX_ATOM_LENGTH <= 255 || j <= 255) + && (dflags & DFLAG_SMALL_ATOM_TAGS)) { + *ep++ = SMALL_ATOM_EXT; + put_int8(j, ep); + ep++; + } + else { + *ep++ = ATOM_EXT; + put_int16(j, ep); + ep += 2; + } + sys_memcpy((char *) ep, (char*)atom_tab(i)->name, (int) j); + ep += j; + return ep; + } + + /* The atom is referenced in the cache. */ + *ep++ = ATOM_CACHE_REF; + put_int8(iix, ep); + ep++; + return ep; +} + +static byte* +enc_pid(ErtsAtomCacheMap *acmp, Eterm pid, byte* ep, Uint32 dflags) +{ + Uint on, os; + + *ep++ = PID_EXT; + /* insert atom here containing host and sysname */ + ep = enc_atom(acmp, pid_node_name(pid), ep, dflags); + + /* two bytes for each number and serial */ + + on = pid_number(pid); + os = pid_serial(pid); + + put_int32(on, ep); + ep += 4; + put_int32(os, ep); + ep += 4; + *ep++ = pid_creation(pid); + return ep; +} + +/* Expect an atom in plain text or cached */ +static byte* +dec_atom(ErtsDistExternal *edep, byte* ep, Eterm* objp) +{ + Uint len; + int n; + + switch (*ep++) { + case ATOM_CACHE_REF: + if (!(edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB)) + goto error; + n = get_int8(ep); + ep++; + if (n >= edep->attab.size) + goto error; + ASSERT(is_atom(edep->attab.atom[n])); + *objp = edep->attab.atom[n]; + break; + case ATOM_EXT: + len = get_int16(ep), + ep += 2; + *objp = am_atom_put((char*)ep, len); + ep += len; + break; + case SMALL_ATOM_EXT: + len = get_int8(ep); + ep++; + *objp = am_atom_put((char*)ep, len); + ep += len; + break; + default: + error: + *objp = NIL; /* Don't leave a hole in the heap */ + return NULL; + } + return ep; +} + +static byte* +dec_pid(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Eterm* objp) +{ + Eterm sysname; + Uint data; + Uint num; + Uint ser; + Uint cre; + ErlNode *node; + + *objp = NIL; /* In case we fail, don't leave a hole in the heap */ + + /* eat first atom */ + if ((ep = dec_atom(edep, ep, &sysname)) == NULL) + return NULL; + num = get_int32(ep); + ep += 4; + if (num > ERTS_MAX_PID_NUMBER) + return NULL; + ser = get_int32(ep); + ep += 4; + if (ser > ERTS_MAX_PID_SERIAL) + return NULL; + if ((cre = get_int8(ep)) >= MAX_CREATION) + return NULL; + ep += 1; + + /* + * We are careful to create the node entry only after all + * validity tests are done. + */ + cre = dec_set_creation(sysname,cre); + node = erts_find_or_insert_node(sysname,cre); + + data = make_pid_data(ser, num); + if(node == erts_this_node) { + *objp = make_internal_pid(data); + } else { + ExternalThing *etp = (ExternalThing *) *hpp; + *hpp += EXTERNAL_THING_HEAD_SIZE + 1; + + etp->header = make_external_pid_header(1); + etp->next = off_heap->externals; + etp->node = node; + etp->data.ui[0] = data; + + off_heap->externals = etp; + *objp = make_external_pid(etp); + } + return ep; +} + + +#define ENC_TERM ((Eterm) 0) +#define ENC_ONE_CONS ((Eterm) 1) +#define ENC_PATCH_FUN_SIZE ((Eterm) 2) +#define ENC_LAST_ARRAY_ELEMENT ((Eterm) 3) + +static byte* +enc_term(ErtsAtomCacheMap *acmp, Eterm obj, byte* ep, Uint32 dflags) +{ + DECLARE_ESTACK(s); + Uint n; + Uint i; + Uint j; + Uint* ptr; + Eterm val; + FloatDef f; + + goto L_jump_start; + + outer_loop: + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + switch (val = ESTACK_POP(s)) { + case ENC_TERM: + break; + case ENC_ONE_CONS: + encode_one_cons: + { + Eterm* cons = list_val(obj); + Eterm tl; + + obj = CAR(cons); + tl = CDR(cons); + ESTACK_PUSH(s, is_list(tl) ? ENC_ONE_CONS : ENC_TERM); + ESTACK_PUSH(s, tl); + } + break; + case ENC_PATCH_FUN_SIZE: + { + byte* size_p = (byte *) obj; + + put_int32(ep - size_p, size_p); + } + goto outer_loop; + case ENC_LAST_ARRAY_ELEMENT: + { + Eterm* ptr = (Eterm *) obj; + obj = *ptr; + } + break; + default: /* ENC_LAST_ARRAY_ELEMENT+1 and upwards */ + { + Eterm* ptr = (Eterm *) obj; + obj = *ptr++; + ESTACK_PUSH(s, val-1); + ESTACK_PUSH(s, (Eterm) ptr); + } + break; + } + + L_jump_start: + switch(tag_val_def(obj)) { + case NIL_DEF: + *ep++ = NIL_EXT; + break; + + case ATOM_DEF: + ep = enc_atom(acmp,obj,ep,dflags); + break; + + case SMALL_DEF: + { + Sint val = signed_val(obj); + + if ((Uint)val < 256) { + *ep++ = SMALL_INTEGER_EXT; + put_int8(val, ep); + ep++; + } else if (sizeof(Sint) == 4 || IS_SSMALL28(val)) { + *ep++ = INTEGER_EXT; + put_int32(val, ep); + ep += 4; + } else { + Eterm tmp_big[2]; + Eterm big = small_to_big(val, tmp_big); + *ep++ = SMALL_BIG_EXT; + n = big_bytes(big); + ASSERT(n < 256); + put_int8(n, ep); + ep += 1; + *ep++ = big_sign(big); + ep = big_to_bytes(big, ep); + } + } + break; + + case BIG_DEF: + if ((n = big_bytes(obj)) < 256) { + *ep++ = SMALL_BIG_EXT; + put_int8(n, ep); + ep += 1; + } + else { + *ep++ = LARGE_BIG_EXT; + put_int32(n, ep); + ep += 4; + } + *ep++ = big_sign(obj); + ep = big_to_bytes(obj, ep); + break; + + case PID_DEF: + case EXTERNAL_PID_DEF: + ep = enc_pid(acmp, obj, ep, dflags); + break; + + case REF_DEF: + case EXTERNAL_REF_DEF: { + Uint32 *ref_num; + + ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); + *ep++ = NEW_REFERENCE_EXT; + i = ref_no_of_numbers(obj); + put_int16(i, ep); + ep += 2; + ep = enc_atom(acmp,ref_node_name(obj),ep,dflags); + *ep++ = ref_creation(obj); + ref_num = ref_numbers(obj); + for (j = 0; j < i; j++) { + put_int32(ref_num[j], ep); + ep += 4; + } + break; + } + case PORT_DEF: + case EXTERNAL_PORT_DEF: + + *ep++ = PORT_EXT; + ep = enc_atom(acmp,port_node_name(obj),ep,dflags); + j = port_number(obj); + put_int32(j, ep); + ep += 4; + *ep++ = port_creation(obj); + break; + + case LIST_DEF: + { + int is_str; + + i = is_external_string(obj, &is_str); + if (is_str) { + *ep++ = STRING_EXT; + put_int16(i, ep); + ep += 2; + while (is_list(obj)) { + Eterm* cons = list_val(obj); + *ep++ = unsigned_val(CAR(cons)); + obj = CDR(cons); + } + } else { + *ep++ = LIST_EXT; + put_int32(i, ep); + ep += 4; + goto encode_one_cons; + } + } + break; + + case TUPLE_DEF: + ptr = tuple_val(obj); + i = arityval(*ptr); + ptr++; + if (i <= 0xff) { + *ep++ = SMALL_TUPLE_EXT; + put_int8(i, ep); + ep += 1; + } else { + *ep++ = LARGE_TUPLE_EXT; + put_int32(i, ep); + ep += 4; + } + if (i > 0) { + ESTACK_PUSH(s, ENC_LAST_ARRAY_ELEMENT+i-1); + ESTACK_PUSH(s, (Eterm) ptr); + } + break; + + case FLOAT_DEF: + GET_DOUBLE(obj, f); + if (dflags & DFLAG_NEW_FLOATS) { + *ep++ = NEW_FLOAT_EXT; +#ifdef WORDS_BIGENDIAN + put_int32(f.fw[0], ep); + ep += 4; + put_int32(f.fw[1], ep); +#else + put_int32(f.fw[1], ep); + ep += 4; + put_int32(f.fw[0], ep); +#endif + ep += 4; + } else { + *ep++ = FLOAT_EXT; + + /* now the sprintf which does the work */ + i = sys_double_to_chars(f.fd, (char*) ep); + + /* Don't leave garbage after the float! (Bad practice in general, + * and Purify complains.) + */ + sys_memset(ep+i, 0, 31-i); + ep += 31; + } + break; + + case BINARY_DEF: + { + Uint bitoffs; + Uint bitsize; + byte* bytes; + + ERTS_GET_BINARY_BYTES(obj, bytes, bitoffs, bitsize); + if (bitsize == 0) { + /* Plain old byte-sized binary. */ + *ep++ = BINARY_EXT; + j = binary_size(obj); + put_int32(j, ep); + ep += 4; + copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j); + ep += j; + } else if (dflags & DFLAG_BIT_BINARIES) { + /* Bit-level binary. */ + *ep++ = BIT_BINARY_EXT; + j = binary_size(obj); + put_int32((j+1), ep); + ep += 4; + *ep++ = bitsize; + ep[j] = 0; /* Zero unused bits at end of binary */ + copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j+bitsize); + ep += j + 1; + } else { + /* + * Bit-level binary, but the receiver doesn't support it. + * Build a tuple instead. + */ + *ep++ = SMALL_TUPLE_EXT; + *ep++ = 2; + *ep++ = BINARY_EXT; + j = binary_size(obj); + put_int32((j+1), ep); + ep += 4; + ep[j] = 0; /* Zero unused bits at end of binary */ + copy_binary_to_buffer(ep, 0, bytes, bitoffs, 8*j+bitsize); + ep += j+1; + *ep++ = SMALL_INTEGER_EXT; + *ep++ = bitsize; + } + break; + } + case EXPORT_DEF: + { + Export* exp = (Export *) (export_val(obj))[1]; + if ((dflags & DFLAG_EXPORT_PTR_TAG) != 0) { + *ep++ = EXPORT_EXT; + ep = enc_atom(acmp, exp->code[0], ep, dflags); + ep = enc_atom(acmp, exp->code[1], ep, dflags); + ep = enc_term(acmp, make_small(exp->code[2]), ep, dflags); + } else { + /* Tag, arity */ + *ep++ = SMALL_TUPLE_EXT; + put_int8(2, ep); + ep += 1; + + /* Module name */ + ep = enc_atom(acmp, exp->code[0], ep, dflags); + + /* Function name */ + ep = enc_atom(acmp, exp->code[1], ep, dflags); + } + break; + } + break; + case FUN_DEF: + { + ErlFunThing* funp = (ErlFunThing *) fun_val(obj); + + if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) { + int ei; + + *ep++ = NEW_FUN_EXT; + ESTACK_PUSH(s, ENC_PATCH_FUN_SIZE); + ESTACK_PUSH(s, (Eterm) ep); /* Position for patching in size */ + ep += 4; + *ep = funp->arity; + ep += 1; + sys_memcpy(ep, funp->fe->uniq, 16); + ep += 16; + put_int32(funp->fe->index, ep); + ep += 4; + put_int32(funp->num_free, ep); + ep += 4; + ep = enc_atom(acmp, funp->fe->module, ep, dflags); + ep = enc_term(acmp, make_small(funp->fe->old_index), ep, dflags); + ep = enc_term(acmp, make_small(funp->fe->old_uniq), ep, dflags); + ep = enc_pid(acmp, funp->creator, ep, dflags); + + fun_env: + for (ei = funp->num_free-1; ei > 0; ei--) { + ESTACK_PUSH(s, ENC_TERM); + ESTACK_PUSH(s, funp->env[ei]); + } + if (funp->num_free != 0) { + obj = funp->env[0]; + goto L_jump_start; + } + } else { + /* + * Communicating with an obsolete erl_interface or + * jinterface node. Convert the fun to a tuple to + * avoid crasching. + */ + + /* Tag, arity */ + *ep++ = SMALL_TUPLE_EXT; + put_int8(5, ep); + ep += 1; + + /* 'fun' */ + ep = enc_atom(acmp, am_fun, ep, dflags); + + /* Module name */ + ep = enc_atom(acmp, funp->fe->module, ep, dflags); + + /* Index, Uniq */ + *ep++ = INTEGER_EXT; + put_int32(funp->fe->old_index, ep); + ep += 4; + *ep++ = INTEGER_EXT; + put_int32(funp->fe->old_uniq, ep); + ep += 4; + + /* Environment sub-tuple arity */ + ASSERT(funp->num_free < MAX_ARG); + *ep++ = SMALL_TUPLE_EXT; + put_int8(funp->num_free, ep); + ep += 1; + goto fun_env; + } + } + break; + } + } + DESTROY_ESTACK(s); + return ep; +} + +static Uint +is_external_string(Eterm list, int* p_is_string) +{ + Uint len = 0; + + /* + * Calculate the length of the list as long as all characters + * are integers from 0 through 255. + */ + while (is_list(list)) { + Eterm* consp = list_val(list); + Eterm hd = CAR(consp); + + if (!is_byte(hd)) { + break; + } + len++; + list = CDR(consp); + } + + /* + * If we have reached the end of the list, and we have + * not exceeded the maximum length of a string, this + * is a string. + */ + *p_is_string = is_nil(list) && len < MAX_STRING_LEN; + + /* + * Continue to calculate the length. + */ + while (is_list(list)) { + Eterm* consp = list_val(list); + len++; + list = CDR(consp); + } + return len; +} + +static byte* +dec_term(ErtsDistExternal *edep, Eterm** hpp, byte* ep, ErlOffHeap* off_heap, Eterm* objp) +{ + int n; + register Eterm* hp = *hpp; /* Please don't take the address of hp */ + Eterm* next = objp; + + *next = (Eterm) NULL; + + while (next != NULL) { + objp = next; + next = (Eterm *) (*objp); + + switch (*ep++) { + case INTEGER_EXT: + { + Sint sn = get_int32(ep); + + ep += 4; +#if defined(ARCH_64) + *objp = make_small(sn); +#else + if (MY_IS_SSMALL(sn)) { + *objp = make_small(sn); + } else { + *objp = small_to_big(sn, hp); + hp += BIG_UINT_HEAP_SIZE; + } +#endif + break; + } + case SMALL_INTEGER_EXT: + n = get_int8(ep); + ep++; + *objp = make_small(n); + break; + case SMALL_BIG_EXT: + n = get_int8(ep); + ep++; + goto big_loop; + case LARGE_BIG_EXT: + n = get_int32(ep); + ep += 4; + big_loop: + { + Eterm big; + byte* first; + byte* last; + Uint neg; + + neg = get_int8(ep); /* Sign bit */ + ep++; + + /* + * Strip away leading zeroes to avoid creating illegal bignums. + */ + first = ep; + last = ep + n; + ep += n; + do { + --last; + } while (first <= last && *last == 0); + + if ((n = last - first + 1) == 0) { + /* Zero width bignum defaults to zero */ + big = make_small(0); + } else { + big = bytes_to_big(first, n, neg, hp); + if (is_big(big)) { + hp += big_arity(big) + 1; + } + } + *objp = big; + break; + } + case ATOM_CACHE_REF: + if (edep == 0 || (edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) == 0) { + goto error; + } + n = get_int8(ep); + ep++; + if (n >= edep->attab.size) + goto error; + ASSERT(is_atom(edep->attab.atom[n])); + *objp = edep->attab.atom[n]; + break; + case ATOM_EXT: + n = get_int16(ep); + ep += 2; + *objp = am_atom_put((char*)ep, n); + ep += n; + break; + case SMALL_ATOM_EXT: + n = get_int8(ep); + ep++; + *objp = am_atom_put((char*)ep, n); + ep += n; + break; + case LARGE_TUPLE_EXT: + n = get_int32(ep); + ep += 4; + goto tuple_loop; + case SMALL_TUPLE_EXT: + n = get_int8(ep); + ep++; + tuple_loop: + *objp = make_tuple(hp); + *hp++ = make_arityval(n); + hp += n; + objp = hp - 1; + while (n-- > 0) { + objp[0] = (Eterm) next; + next = objp; + objp--; + } + break; + case NIL_EXT: + *objp = NIL; + break; + case LIST_EXT: + n = get_int32(ep); + ep += 4; + if (n == 0) { + next = objp; + break; + } + *objp = make_list(hp); + hp += 2*n; + objp = hp - 2; + objp[0] = (Eterm) (objp+1); + objp[1] = (Eterm) next; + next = objp; + objp -= 2; + while (--n > 0) { + objp[0] = (Eterm) next; + objp[1] = make_list(objp + 2); + next = objp; + objp -= 2; + } + break; + case STRING_EXT: + n = get_int16(ep); + ep += 2; + if (n == 0) { + *objp = NIL; + break; + } + *objp = make_list(hp); + while (n-- > 0) { + hp[0] = make_small(*ep++); + hp[1] = make_list(hp+2); + hp += 2; + } + hp[-1] = NIL; + break; + case FLOAT_EXT: + { + FloatDef ff; + + if (sys_chars_to_double((char*)ep, &ff.fd) != 0) { + goto error; + } + ep += 31; + *objp = make_float(hp); + PUT_DOUBLE(ff, hp); + hp += FLOAT_SIZE_OBJECT; + break; + } + case NEW_FLOAT_EXT: + { + FloatDef ff; +#ifndef NO_FPE_SIGNALS + volatile unsigned long *fpexnp = erts_get_current_fp_exception(); +#endif + +#ifdef WORDS_BIGENDIAN + ff.fw[0] = get_int32(ep); + ep += 4; + ff.fw[1] = get_int32(ep); + ep += 4; +#else + ff.fw[1] = get_int32(ep); + ep += 4; + ff.fw[0] = get_int32(ep); + ep += 4; +#endif + __ERTS_FP_CHECK_INIT(fpexnp); + __ERTS_FP_ERROR_THOROUGH(fpexnp, ff.fd, goto error); + *objp = make_float(hp); + PUT_DOUBLE(ff, hp); + hp += FLOAT_SIZE_OBJECT; + break; + } + case PID_EXT: + *hpp = hp; + ep = dec_pid(edep, hpp, ep, off_heap, objp); + hp = *hpp; + if (ep == NULL) { + return NULL; + } + break; + case PORT_EXT: + { + Eterm sysname; + ErlNode *node; + Uint num; + Uint cre; + + if ((ep = dec_atom(edep, ep, &sysname)) == NULL) { + goto error; + } + if ((num = get_int32(ep)) > ERTS_MAX_PORT_NUMBER) { + goto error; + } + ep += 4; + if ((cre = get_int8(ep)) >= MAX_CREATION) { + goto error; + } + ep++; + cre = dec_set_creation(sysname,cre); + node = erts_find_or_insert_node(sysname, cre); + + if(node == erts_this_node) { + *objp = make_internal_port(num); + } + else { + ExternalThing *etp = (ExternalThing *) hp; + hp += EXTERNAL_THING_HEAD_SIZE + 1; + + etp->header = make_external_port_header(1); + etp->next = off_heap->externals; + etp->node = node; + etp->data.ui[0] = num; + + off_heap->externals = etp; + *objp = make_external_port(etp); + } + + break; + } + case REFERENCE_EXT: + { + Eterm sysname; + ErlNode *node; + int i; + Uint cre; + Uint32 *ref_num; + Uint32 r0; + Uint ref_words; + + ref_words = 1; + + if ((ep = dec_atom(edep, ep, &sysname)) == NULL) + goto error; + if ((r0 = get_int32(ep)) >= MAX_REFERENCE ) + goto error; + ep += 4; + + if ((cre = get_int8(ep)) >= MAX_CREATION) + goto error; + ep += 1; + goto ref_ext_common; + + case NEW_REFERENCE_EXT: + + ref_words = get_int16(ep); + ep += 2; + + if (ref_words > ERTS_MAX_REF_NUMBERS) + goto error; + + if ((ep = dec_atom(edep, ep, &sysname)) == NULL) + goto error; + + if ((cre = get_int8(ep)) >= MAX_CREATION) + goto error; + ep += 1; + + r0 = get_int32(ep); + ep += 4; + if (r0 >= MAX_REFERENCE) + goto error; + + ref_ext_common: + + cre = dec_set_creation(sysname, cre); + node = erts_find_or_insert_node(sysname, cre); + if(node == erts_this_node) { + RefThing *rtp = (RefThing *) hp; + hp += REF_THING_HEAD_SIZE; +#ifdef ARCH_64 + rtp->header = make_ref_thing_header(ref_words/2 + 1); +#else + rtp->header = make_ref_thing_header(ref_words); +#endif + *objp = make_internal_ref(rtp); + } + else { + ExternalThing *etp = (ExternalThing *) hp; + hp += EXTERNAL_THING_HEAD_SIZE; + +#ifdef ARCH_64 + etp->header = make_external_ref_header(ref_words/2 + 1); +#else + etp->header = make_external_ref_header(ref_words); +#endif + etp->next = off_heap->externals; + etp->node = node; + + off_heap->externals = etp; + *objp = make_external_ref(etp); + } + + ref_num = (Uint32 *) hp; +#ifdef ARCH_64 + *(ref_num++) = ref_words /* 32-bit arity */; +#endif + ref_num[0] = r0; + for(i = 1; i < ref_words; i++) { + ref_num[i] = get_int32(ep); + ep += 4; + } +#ifdef ARCH_64 + if ((1 + ref_words) % 2) + ref_num[ref_words] = 0; + hp += ref_words/2 + 1; +#else + hp += ref_words; +#endif + break; + } + case BINARY_EXT: + { + n = get_int32(ep); + ep += 4; + + if (n <= ERL_ONHEAP_BIN_LIMIT || off_heap == NULL) { + ErlHeapBin* hb = (ErlHeapBin *) hp; + + hb->thing_word = header_heap_bin(n); + hb->size = n; + hp += heap_bin_size(n); + sys_memcpy(hb->data, ep, n); + *objp = make_binary(hb); + } else { + Binary* dbin = erts_bin_nrml_alloc(n); + ProcBin* pb; + dbin->flags = 0; + dbin->orig_size = n; + erts_refc_init(&dbin->refc, 1); + sys_memcpy(dbin->orig_bytes, ep, n); + pb = (ProcBin *) hp; + hp += PROC_BIN_SIZE; + pb->thing_word = HEADER_PROC_BIN; + pb->size = n; + pb->next = off_heap->mso; + off_heap->mso = pb; + pb->val = dbin; + pb->bytes = (byte*) dbin->orig_bytes; + pb->flags = 0; + *objp = make_binary(pb); + } + ep += n; + break; + } + case BIT_BINARY_EXT: + { + Eterm bin; + ErlSubBin* sb; + Uint bitsize; + + n = get_int32(ep); + bitsize = ep[4]; + ep += 5; + if (n <= ERL_ONHEAP_BIN_LIMIT || off_heap == NULL) { + ErlHeapBin* hb = (ErlHeapBin *) hp; + + hb->thing_word = header_heap_bin(n); + hb->size = n; + sys_memcpy(hb->data, ep, n); + bin = make_binary(hb); + hp += heap_bin_size(n); + } else { + Binary* dbin = erts_bin_nrml_alloc(n); + ProcBin* pb; + dbin->flags = 0; + dbin->orig_size = n; + erts_refc_init(&dbin->refc, 1); + sys_memcpy(dbin->orig_bytes, ep, n); + pb = (ProcBin *) hp; + pb->thing_word = HEADER_PROC_BIN; + pb->size = n; + pb->next = off_heap->mso; + off_heap->mso = pb; + pb->val = dbin; + pb->bytes = (byte*) dbin->orig_bytes; + pb->flags = 0; + bin = make_binary(pb); + hp += PROC_BIN_SIZE; + } + ep += n; + if (bitsize == 0) { + *objp = bin; + } else { + sb = (ErlSubBin *) hp; + sb->thing_word = HEADER_SUB_BIN; + sb->orig = bin; + sb->size = n - 1; + sb->bitsize = bitsize; + sb->bitoffs = 0; + sb->offs = 0; + sb->is_writable = 0; + *objp = make_binary(sb); + hp += ERL_SUB_BIN_SIZE; + } + break; + } + case EXPORT_EXT: + { + Eterm mod; + Eterm name; + Eterm temp; + Sint arity; + + if ((ep = dec_atom(edep, ep, &mod)) == NULL) { + goto error; + } + if ((ep = dec_atom(edep, ep, &name)) == NULL) { + goto error; + } + *hpp = hp; + ep = dec_term(edep, hpp, ep, off_heap, &temp); + hp = *hpp; + if (ep == NULL) { + return NULL; + } + if (!is_small(temp)) { + goto error; + } + arity = signed_val(temp); + if (arity < 0) { + goto error; + } + *objp = make_export(hp); + *hp++ = HEADER_EXPORT; + *hp++ = (Eterm) erts_export_get_or_make_stub(mod, name, arity); + break; + } + break; + case NEW_FUN_EXT: + { + ErlFunThing* funp = (ErlFunThing *) hp; + Uint arity; + Eterm module; + byte* uniq; + int index; + Sint old_uniq; + Sint old_index; + unsigned num_free; + int i; + Eterm* temp_hp; + Eterm** hpp = &temp_hp; + Eterm temp; + + ep += 4; /* Skip total size in bytes */ + arity = *ep++; + uniq = ep; + ep += 16; + index = get_int32(ep); + ep += 4; + num_free = get_int32(ep); + ep += 4; + hp += ERL_FUN_SIZE; + if (num_free > 0) { + /* Don't leave a hole in case we fail */ + *hp = make_pos_bignum_header(num_free-1); + } + hp += num_free; + *hpp = hp; + funp->thing_word = HEADER_FUN; + funp->num_free = num_free; + funp->creator = NIL; /* Don't leave a hole in case we fail */ + *objp = make_fun(funp); + + /* Module */ + if ((ep = dec_atom(edep, ep, &temp)) == NULL) { + goto error; + } + module = temp; + + /* Index */ + if ((ep = dec_term(edep, hpp, ep, off_heap, &temp)) == NULL) { + goto error; + } + if (!is_small(temp)) { + goto error; + } + old_index = unsigned_val(temp); + + /* Uniq */ + if ((ep = dec_term(edep, hpp, ep, off_heap, &temp)) == NULL) { + goto error; + } + if (!is_small(temp)) { + goto error; + } + old_uniq = unsigned_val(temp); + +#ifndef HYBRID /* FIND ME! */ + /* + * It is safe to link the fun into the fun list only when + * no more validity tests can fail. + */ + funp->next = off_heap->funs; + off_heap->funs = funp; +#endif + + funp->fe = erts_put_fun_entry2(module, old_uniq, old_index, + uniq, index, arity); + funp->arity = arity; +#ifdef HIPE + if (funp->fe->native_address == NULL) { + hipe_set_closure_stub(funp->fe, num_free); + } + funp->native_address = funp->fe->native_address; +#endif + hp = *hpp; + + /* Environment */ + for (i = num_free-1; i >= 0; i--) { + funp->env[i] = (Eterm) next; + next = funp->env + i; + } + /* Creator */ + funp->creator = (Eterm) next; + next = &(funp->creator); + break; + } + case FUN_EXT: + { + ErlFunThing* funp = (ErlFunThing *) hp; + Eterm module; + Sint old_uniq; + Sint old_index; + unsigned num_free; + int i; + Eterm* temp_hp; + Eterm** hpp = &temp_hp; + Eterm temp; + + num_free = get_int32(ep); + ep += 4; + hp += ERL_FUN_SIZE; + if (num_free > 0) { + /* Don't leave a hole in the heap in case we fail. */ + *hp = make_pos_bignum_header(num_free-1); + } + hp += num_free; + *hpp = hp; + funp->thing_word = HEADER_FUN; + funp->num_free = num_free; + *objp = make_fun(funp); + + /* Creator pid */ + switch(*ep) { + case PID_EXT: + ep = dec_pid(edep, hpp, ++ep, off_heap, &funp->creator); + if (ep == NULL) { + funp->creator = NIL; /* Don't leave a hole in the heap */ + goto error; + } + break; + default: + goto error; + } + + /* Module */ + if ((ep = dec_atom(edep, ep, &temp)) == NULL) { + goto error; + } + module = temp; + + /* Index */ + if ((ep = dec_term(edep, hpp, ep, off_heap, &temp)) == NULL) { + goto error; + } + if (!is_small(temp)) { + goto error; + } + old_index = unsigned_val(temp); + + /* Uniq */ + if ((ep = dec_term(edep, hpp, ep, off_heap, &temp)) == NULL) { + goto error; + } + if (!is_small(temp)) { + goto error; + } + +#ifndef HYBRID /* FIND ME! */ + /* + * It is safe to link the fun into the fun list only when + * no more validity tests can fail. + */ + funp->next = off_heap->funs; + off_heap->funs = funp; +#endif + + old_uniq = unsigned_val(temp); + + funp->fe = erts_put_fun_entry(module, old_uniq, old_index); + funp->arity = funp->fe->address[-1] - num_free; +#ifdef HIPE + funp->native_address = funp->fe->native_address; +#endif + hp = *hpp; + + /* Environment */ + for (i = num_free-1; i >= 0; i--) { + funp->env[i] = (Eterm) next; + next = funp->env + i; + } + break; + } + default: + error: + /* + * Be careful to return the updated heap pointer, to avoid + * that the caller wipes out binaries or other off-heap objects + * that may have been linked into the process. + */ + *hpp = hp; + return NULL; + } + } + *hpp = hp; + return ep; +} + +/* returns the number of bytes needed to encode an object + to a sequence of bytes + N.B. That this must agree with to_external2() above!!! + (except for cached atoms) */ + +static Uint +encode_size_struct2(ErtsAtomCacheMap *acmp, Eterm obj, unsigned dflags) +{ + DECLARE_ESTACK(s); + Uint m, i, arity; + Uint result = 0; + + goto L_jump_start; + + outer_loop: + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + + handle_popped_obj: + if (is_CP(obj)) { + Eterm* ptr = (Eterm *) obj; + + /* + * Pointer into a tuple. + */ + obj = *ptr--; + if (!is_header(obj)) { + ESTACK_PUSH(s, (Eterm)ptr); + } else { + /* Reached tuple header */ + ASSERT(header_is_arityval(obj)); + goto outer_loop; + } + } else if (is_list(obj)) { + Eterm* cons = list_val(obj); + Eterm tl; + + tl = CDR(cons); + obj = CAR(cons); + ESTACK_PUSH(s, tl); + } else if (is_nil(obj)) { + result++; + goto outer_loop; + } else { + /* + * Other term (in the tail of a non-proper list or + * in a fun's environment). + */ + } + + L_jump_start: + switch (tag_val_def(obj)) { + case NIL_DEF: + result++; + break; + case ATOM_DEF: { + int alen = atom_tab(atom_val(obj))->len; + if ((MAX_ATOM_LENGTH <= 255 || alen <= 255) + && (dflags & DFLAG_SMALL_ATOM_TAGS)) { + /* Make sure a SMALL_ATOM_EXT fits: SMALL_ATOM_EXT l t1 t2... */ + result += 1 + 1 + alen; + } + else { + /* Make sure an ATOM_EXT fits: ATOM_EXT l1 l0 t1 t2... */ + result += 1 + 2 + alen; + } + insert_acache_map(acmp, obj); + break; + } + case SMALL_DEF: + { + Sint val = signed_val(obj); + + if ((Uint)val < 256) + result += 1 + 1; /* SMALL_INTEGER_EXT */ + else if (sizeof(Sint) == 4 || IS_SSMALL28(val)) + result += 1 + 4; /* INTEGER_EXT */ + else { + Eterm tmp_big[2]; + i = big_bytes(small_to_big(val, tmp_big)); + result += 1 + 1 + 1 + i; /* SMALL_BIG_EXT */ + } + } + break; + case BIG_DEF: + if ((i = big_bytes(obj)) < 256) + result += 1 + 1 + 1 + i; /* tag,size,sign,digits */ + else + result += 1 + 4 + 1 + i; /* tag,size,sign,digits */ + break; + case PID_DEF: + case EXTERNAL_PID_DEF: + result += (1 + encode_size_struct2(acmp, pid_node_name(obj), dflags) + + 4 + 4 + 1); + break; + case REF_DEF: + case EXTERNAL_REF_DEF: + ASSERT(dflags & DFLAG_EXTENDED_REFERENCES); + i = ref_no_of_numbers(obj); + result += (1 + 2 + encode_size_struct2(acmp, ref_node_name(obj), dflags) + + 1 + 4*i); + break; + case PORT_DEF: + case EXTERNAL_PORT_DEF: + result += (1 + encode_size_struct2(acmp, port_node_name(obj), dflags) + + 4 + 1); + break; + case LIST_DEF: + if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { + result += m + 2 + 1; + } else { + result += 5; + goto handle_popped_obj; + } + break; + case TUPLE_DEF: + { + Eterm* ptr = tuple_val(obj); + + arity = arityval(*ptr); + if (arity <= 0xff) { + result += 1 + 1; + } else { + result += 1 + 4; + } + ptr += arity; + obj = (Eterm) ptr; + goto handle_popped_obj; + } + break; + case FLOAT_DEF: + if (dflags & DFLAG_NEW_FLOATS) { + result += 9; + } else { + result += 32; /* Yes, including the tag */ + } + break; + case BINARY_DEF: + result += 1 + 4 + binary_size(obj) + + 5; /* For unaligned binary */ + break; + case FUN_DEF: + { + ErlFunThing* funp = (ErlFunThing *) fun_val(obj); + + if ((dflags & DFLAG_NEW_FUN_TAGS) != 0) { + result += 20+1+1+4; /* New ID + Tag */ + result += 4; /* Length field (number of free variables */ + result += encode_size_struct2(acmp, funp->creator, dflags); + result += encode_size_struct2(acmp, funp->fe->module, dflags); + result += 2 * (1+4); /* Index, Uniq */ + } else { + /* + * Size when fun is mapped to a tuple. + */ + result += 1 + 1; /* Tuple tag, arity */ + result += 1 + 1 + 2 + + atom_tab(atom_val(am_fun))->len; /* 'fun' */ + result += 1 + 1 + 2 + + atom_tab(atom_val(funp->fe->module))->len; /* Module name */ + result += 2 * (1 + 4); /* Index + Uniq */ + result += 1 + (funp->num_free < 0x100 ? 1 : 4); + } + for (i = 1; i < funp->num_free; i++) { + obj = funp->env[i]; + + if (is_not_list(obj)) { + /* Push any non-list terms on the stack */ + ESTACK_PUSH(s, obj); + } else { + /* Lists must be handled specially. */ + if ((m = is_string(obj)) && (m < MAX_STRING_LEN)) { + result += m + 2 + 1; + } else { + result += 5; + ESTACK_PUSH(s, obj); + } + } + } + if (funp->num_free != 0) { + obj = funp->env[0]; + goto L_jump_start; + } + break; + } + + case EXPORT_DEF: + { + Export* ep = (Export *) (export_val(obj))[1]; + result += 1; + result += encode_size_struct2(acmp, ep->code[0], dflags); + result += encode_size_struct2(acmp, ep->code[1], dflags); + result += encode_size_struct2(acmp, make_small(ep->code[2]), dflags); + } + break; + + default: + erl_exit(1,"Internal data structure error (in encode_size_struct2)%x\n", + obj); + } + } + + DESTROY_ESTACK(s); + return result; +} + +static Sint +decoded_size(byte *ep, byte* endp, int no_refc_bins) +{ + int heap_size = 0; + int terms; + int atom_extra_skip = 0; + Uint n; + +#define SKIP(sz) \ + do { \ + if ((sz) <= endp-ep) { \ + ep += (sz); \ + } else { return -1; }; \ + } while (0) + +#define SKIP2(sz1, sz2) \ + do { \ + Uint sz = (sz1) + (sz2); \ + if (sz1 < sz && (sz) <= endp-ep) { \ + ep += (sz); \ + } else { return -1; } \ + } while (0) + +#define CHKSIZE(sz) \ + do { \ + if ((sz) > endp-ep) { return -1; } \ + } while (0) + +#define ADDTERMS(n) \ + do { \ + int before = terms; \ + terms += (n); \ + if (terms < before) return -1; \ + } while (0) + + + for (terms=1; terms > 0; terms--) { + int tag; + + CHKSIZE(1); + tag = ep++[0]; + switch (tag) { + case INTEGER_EXT: + SKIP(4); + heap_size += BIG_UINT_HEAP_SIZE; + break; + case SMALL_INTEGER_EXT: + SKIP(1); + break; + case SMALL_BIG_EXT: + CHKSIZE(1); + n = ep[0]; /* number of bytes */ + SKIP2(n, 1+1); /* skip size,sign,digits */ + heap_size += 1+(n+sizeof(Eterm)-1)/sizeof(Eterm); /* XXX: 1 too much? */ + break; + case LARGE_BIG_EXT: + CHKSIZE(4); + n = get_int32(ep); + SKIP2(n,4+1); /* skip, size,sign,digits */ + heap_size += 1+1+(n+sizeof(Eterm)-1)/sizeof(Eterm); /* XXX: 1 too much? */ + break; + case ATOM_EXT: + CHKSIZE(2); + n = get_int16(ep); + if (n > MAX_ATOM_LENGTH) { + return -1; + } + SKIP(n+2+atom_extra_skip); + atom_extra_skip = 0; + break; + case SMALL_ATOM_EXT: + CHKSIZE(1); + n = get_int8(ep); + if (n > MAX_ATOM_LENGTH) { + return -1; + } + SKIP(n+1+atom_extra_skip); + atom_extra_skip = 0; + break; + case ATOM_CACHE_REF: + SKIP(1+atom_extra_skip); + atom_extra_skip = 0; + break; + case PID_EXT: + atom_extra_skip = 9; + /* In case it is an external pid */ + heap_size += EXTERNAL_THING_HEAD_SIZE + 1; + terms++; + break; + case PORT_EXT: + atom_extra_skip = 5; + /* In case it is an external port */ + heap_size += EXTERNAL_THING_HEAD_SIZE + 1; + terms++; + break; + case NEW_REFERENCE_EXT: + { + int id_words; + + CHKSIZE(2); + id_words = get_int16(ep); + + if (id_words > ERTS_MAX_REF_NUMBERS) + return -1; + + ep += 2; + atom_extra_skip = 1 + 4*id_words; + /* In case it is an external ref */ +#ifdef ARCH_64 + heap_size += EXTERNAL_THING_HEAD_SIZE + id_words/2 + 1; +#else + heap_size += EXTERNAL_THING_HEAD_SIZE + id_words; +#endif + terms++; + break; + } + case REFERENCE_EXT: + /* In case it is an external ref */ + heap_size += EXTERNAL_THING_HEAD_SIZE + 1; + atom_extra_skip = 5; + terms++; + break; + case NIL_EXT: + break; + case LIST_EXT: + CHKSIZE(4); + n = get_int32(ep); + ep += 4; + ADDTERMS(n); + terms++; + heap_size += 2 * n; + break; + case SMALL_TUPLE_EXT: + CHKSIZE(1); + n = *ep++; + terms += n; + heap_size += n + 1; + break; + case LARGE_TUPLE_EXT: + CHKSIZE(4); + n = get_int32(ep); + ep += 4; + ADDTERMS(n); + heap_size += n + 1; + break; + case STRING_EXT: + CHKSIZE(2); + n = get_int16(ep); + SKIP(n+2); + heap_size += 2 * n; + break; + case FLOAT_EXT: + SKIP(31); + heap_size += FLOAT_SIZE_OBJECT; + break; + case NEW_FLOAT_EXT: + SKIP(8); + heap_size += FLOAT_SIZE_OBJECT; + break; + case BINARY_EXT: + CHKSIZE(4); + n = get_int32(ep); + SKIP2(n, 4); + if (n <= ERL_ONHEAP_BIN_LIMIT || no_refc_bins) { + heap_size += heap_bin_size(n); + } else { + heap_size += PROC_BIN_SIZE; + } + break; + case BIT_BINARY_EXT: + { + CHKSIZE(5); + n = get_int32(ep); + SKIP2(n, 5); + if (n <= ERL_ONHEAP_BIN_LIMIT || no_refc_bins) { + heap_size += heap_bin_size(n) + ERL_SUB_BIN_SIZE; + } else { + heap_size += PROC_BIN_SIZE + ERL_SUB_BIN_SIZE; + } + } + break; + case EXPORT_EXT: + terms += 3; + heap_size += 2; + break; + case NEW_FUN_EXT: + { + unsigned num_free; + Uint total_size; + + CHKSIZE(1+16+4+4); + total_size = get_int32(ep); + CHKSIZE(total_size); + ep += 1+16+4+4; + /*FALLTHROUGH*/ + + case FUN_EXT: + CHKSIZE(4); + num_free = get_int32(ep); + ep += 4; + if (num_free > MAX_ARG) { + return -1; + } + terms += 4 + num_free; + heap_size += ERL_FUN_SIZE + num_free; + break; + } + default: + return -1; + } + } + /* 'terms' may be non-zero if it has wrapped around */ + return terms==0 ? heap_size : -1; +#undef SKIP +#undef SKIP2 +#undef CHKSIZE +} diff --git a/erts/emulator/beam/external.h b/erts/emulator/beam/external.h new file mode 100644 index 0000000000..f308680f89 --- /dev/null +++ b/erts/emulator/beam/external.h @@ -0,0 +1,211 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Same order as the ordering of terms in erlang */ + +/* Since there are 255 different External tag values to choose from + There is no reason to not be extravagant. + Hence, the different tags for large/small tuple e.t.c +*/ + + +#ifdef ERTS_WANT_EXTERNAL_TAGS +#ifndef ERTS_EXTERNAL_TAGS +#define ERTS_EXTERNAL_TAGS + +#define SMALL_INTEGER_EXT 'a' +#define INTEGER_EXT 'b' +#define FLOAT_EXT 'c' +#define ATOM_EXT 'd' +#define SMALL_ATOM_EXT 's' +#define REFERENCE_EXT 'e' +#define NEW_REFERENCE_EXT 'r' +#define PORT_EXT 'f' +#define NEW_FLOAT_EXT 'F' +#define PID_EXT 'g' +#define SMALL_TUPLE_EXT 'h' +#define LARGE_TUPLE_EXT 'i' +#define NIL_EXT 'j' +#define STRING_EXT 'k' +#define LIST_EXT 'l' +#define BINARY_EXT 'm' +#define BIT_BINARY_EXT 'M' +#define SMALL_BIG_EXT 'n' +#define LARGE_BIG_EXT 'o' +#define NEW_FUN_EXT 'p' +#define EXPORT_EXT 'q' +#define FUN_EXT 'u' + +#define DIST_HEADER 'D' +#define ATOM_CACHE_REF 'R' +#define COMPRESSED 'P' + +#if 0 +/* Not used anymore */ +#define CACHED_ATOM 'C' +#define NEW_CACHE 'N' +#endif + + +#define VERSION_MAGIC 131 /* 130 in erlang 4.2 */ + /* Increment this when changing the external format. */ + /* ON the other hand, don't change the external format */ + /* since that breaks other people's code! */ + +#endif /* ERTS_EXTERNAL_TAGS */ +#endif /* ERTS_WANT_EXTERNAL_TAGS */ + +#ifndef ERL_EXTERNAL_H__ +#define ERL_EXTERNAL_H__ + +#include "erl_node_tables.h" + +#define ERTS_ATOM_CACHE_SIZE 2048 + +typedef struct cache { + Eterm in_arr[ERTS_ATOM_CACHE_SIZE]; + Eterm out_arr[ERTS_ATOM_CACHE_SIZE]; +} ErtsAtomCache; + +typedef struct { + int hdr_sz; + int sz; + int cix[ERTS_ATOM_CACHE_SIZE]; + struct { + Eterm atom; + int iix; + } cache[ERTS_ATOM_CACHE_SIZE]; +} ErtsAtomCacheMap; + +typedef struct { + Uint32 size; + Eterm atom[ERTS_ATOM_CACHE_SIZE]; +} ErtsAtomTranslationTable; + +#define ERTS_DIST_EXT_DFLAG_HDR (((Uint32) 1) << 31) +#define ERTS_DIST_EXT_ATOM_TRANS_TAB (((Uint32) 1) << 30) +#define ERTS_DIST_EXT_CON_ID_MASK ((Uint32) 0x3fffffff) + +#define ERTS_DIST_EXT_CON_ID(DIST_EXTP) \ + ((DIST_EXTP)->flags & ERTS_DIST_EXT_CON_ID_MASK) +typedef struct { + DistEntry *dep; + byte *extp; + byte *ext_endp; + Sint heap_size; + Uint32 flags; + ErtsAtomTranslationTable attab; +} ErtsDistExternal; + +typedef struct { + int have_header; + int cache_entries; +} ErtsDistHeaderPeek; + +#define ERTS_DIST_EXT_SIZE(EDEP) \ + (sizeof(ErtsDistExternal) \ + - (((EDEP)->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB) \ + ? (ASSERT_EXPR(0 <= (EDEP)->attab.size \ + && (EDEP)->attab.size <= ERTS_ATOM_CACHE_SIZE), \ + sizeof(Eterm)*(ERTS_ATOM_CACHE_SIZE - (EDEP)->attab.size)) \ + : sizeof(ErtsAtomTranslationTable))) + +typedef struct { + byte *extp; + int exttmp; +} ErtsBinary2TermState; + +/* -------------------------------------------------------------------------- */ + +void erts_init_atom_cache_map(ErtsAtomCacheMap *); +void erts_reset_atom_cache_map(ErtsAtomCacheMap *); +void erts_destroy_atom_cache_map(ErtsAtomCacheMap *); +void erts_finalize_atom_cache_map(ErtsAtomCacheMap *); +Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); + +Uint erts_encode_ext_dist_header_size(ErtsAtomCacheMap *); +byte *erts_encode_ext_dist_header_setup(byte *, ErtsAtomCacheMap *); +byte *erts_encode_ext_dist_header_finalize(byte *, ErtsAtomCache *); +Uint erts_encode_dist_ext_size(Eterm, Uint32, ErtsAtomCacheMap *); +void erts_encode_dist_ext(Eterm, byte **, Uint32, ErtsAtomCacheMap *); + +Uint erts_encode_ext_size(Eterm); +void erts_encode_ext(Eterm, byte **); + +#ifdef ERTS_WANT_EXTERNAL_TAGS +ERTS_GLB_INLINE void erts_peek_dist_header(ErtsDistHeaderPeek *, byte *, Uint); +#endif +ERTS_GLB_INLINE void erts_free_dist_ext_copy(ErtsDistExternal *); +ERTS_GLB_INLINE void *erts_dist_ext_trailer(ErtsDistExternal *); +ErtsDistExternal *erts_make_dist_ext_copy(ErtsDistExternal *, Uint); +void *erts_dist_ext_trailer(ErtsDistExternal *); +void erts_destroy_dist_ext_copy(ErtsDistExternal *); +int erts_prepare_dist_ext(ErtsDistExternal *, byte *, Uint, + DistEntry *, ErtsAtomCache *); +Sint erts_decode_dist_ext_size(ErtsDistExternal *, int); +Eterm erts_decode_dist_ext(Eterm **, ErlOffHeap *, ErtsDistExternal *); + +Sint erts_decode_ext_size(byte*, Uint, int); +Eterm erts_decode_ext(Eterm **, ErlOffHeap *, byte**); + +Eterm erts_term_to_binary(Process* p, Eterm Term, int level, Uint flags); + +Sint erts_binary2term_prepare(ErtsBinary2TermState *, byte *, Sint); +void erts_binary2term_abort(ErtsBinary2TermState *); +Eterm erts_binary2term_create(ErtsBinary2TermState *, Eterm **hpp, ErlOffHeap *); +int erts_debug_max_atom_out_cache_index(void); +int erts_debug_atom_to_out_cache_index(Eterm); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +#ifdef ERTS_WANT_EXTERNAL_TAGS +ERTS_GLB_INLINE void +erts_peek_dist_header(ErtsDistHeaderPeek *dhpp, byte *ext, Uint sz) +{ + if (ext[0] == VERSION_MAGIC + || ext[1] != DIST_HEADER + || sz < (1+1+1)) + dhpp->have_header = 0; + else { + dhpp->have_header = 1; + dhpp->cache_entries = (int) get_int8(&ext[2]); + } +} +#endif + +ERTS_GLB_INLINE void +erts_free_dist_ext_copy(ErtsDistExternal *edep) +{ + if (edep->dep) + erts_deref_dist_entry(edep->dep); + erts_free(ERTS_ALC_T_EXT_TERM_DATA, edep); +} + +ERTS_GLB_INLINE void * +erts_dist_ext_trailer(ErtsDistExternal *edep) +{ + void *res = (void *) (edep->ext_endp + + ERTS_WORD_ALIGN_PAD_SZ(edep->ext_endp)); + ASSERT((((Uint) res) % sizeof(Uint)) == 0); + return res; +} + +#endif + +#endif /* ERL_EXTERNAL_H__ */ diff --git a/erts/emulator/beam/fix_alloc.c b/erts/emulator/beam/fix_alloc.c new file mode 100644 index 0000000000..5637281597 --- /dev/null +++ b/erts/emulator/beam/fix_alloc.c @@ -0,0 +1,287 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* General purpose Memory allocator for fixed block size objects */ +/* This allocater is at least an order of magnitude faster than malloc() */ + + +#define NOPERBLOCK 20 +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_db.h" + +#ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE + +#if ERTS_ALC_MTA_FIXED_SIZE +#include "erl_threads.h" +#include "erl_smp.h" +# ifdef ERTS_SMP +# define FA_LOCK(FA) erts_smp_spin_lock(&(FA)->slck) +# define FA_UNLOCK(FA) erts_smp_spin_unlock(&(FA)->slck) +# else +# define FA_LOCK(FA) erts_mtx_lock(&(FA)->mtx) +# define FA_UNLOCK(FA) erts_mtx_unlock(&(FA)->mtx) +# endif +#else +# define FA_LOCK(FA) +# define FA_UNLOCK(FA) +#endif + +typedef union {double d; long l;} align_t; + +typedef struct fix_alloc_block { + struct fix_alloc_block *next; + align_t mem[1]; +} FixAllocBlock; + +typedef struct fix_alloc { + Uint item_size; + void *freelist; + Uint no_free; + Uint no_blocks; + FixAllocBlock *blocks; +#if ERTS_ALC_MTA_FIXED_SIZE +# ifdef ERTS_SMP + erts_smp_spinlock_t slck; +# else + erts_mtx_t mtx; +# endif +#endif +} FixAlloc; + +static void *(*core_alloc)(Uint); +static Uint xblk_sz; + +static FixAlloc **fa; +#define FA_SZ (1 + ERTS_ALC_N_MAX_A_FIXED_SIZE - ERTS_ALC_N_MIN_A_FIXED_SIZE) + +#define FIX_IX(N) ((N) - ERTS_ALC_N_MIN_A_FIXED_SIZE) + +#define FIX_POOL_SZ(I_SZ) \ + ((I_SZ)*NOPERBLOCK + sizeof(FixAllocBlock) - sizeof(align_t)) + +#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE +static int first_time; +#endif + +void erts_init_fix_alloc(Uint extra_block_size, + void *(*alloc)(Uint)) +{ + int i; + + xblk_sz = extra_block_size; + core_alloc = alloc; + + fa = (FixAlloc **) (*core_alloc)(FA_SZ * sizeof(FixAlloc *)); + if (!fa) + erts_alloc_enomem(ERTS_ALC_T_UNDEF, FA_SZ * sizeof(FixAlloc *)); + + for (i = 0; i < FA_SZ; i++) + fa[i] = NULL; +#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE + first_time = 1; +#endif +} + +Uint +erts_get_fix_size(ErtsAlcType_t type) +{ + Uint i = FIX_IX(ERTS_ALC_T2N(type)); + return i < FA_SZ && fa[i] ? fa[i]->item_size : 0; +} + +void +erts_set_fix_size(ErtsAlcType_t type, Uint size) +{ + Uint sz; + Uint i; + FixAlloc *fs; + ErtsAlcType_t t_no = ERTS_ALC_T2N(type); + sz = xblk_sz + size; + +#ifdef DEBUG + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no); + ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE); +#endif + + while (sz % sizeof(align_t) != 0) /* Alignment */ + sz++; + + i = FIX_IX(t_no); + fs = (FixAlloc *) (*core_alloc)(sizeof(FixAlloc)); + if (!fs) + erts_alloc_n_enomem(t_no, sizeof(FixAlloc)); + + fs->item_size = sz; + fs->no_blocks = 0; + fs->no_free = 0; + fs->blocks = NULL; + fs->freelist = NULL; + if (fa[i]) + erl_exit(-1, "Attempt to overwrite existing fix size (%d)", i); + fa[i] = fs; + +#if ERTS_ALC_MTA_FIXED_SIZE +#ifdef ERTS_SMP + erts_smp_spinlock_init_x(&fs->slck, "fix_alloc", make_small(i)); +#else + erts_mtx_init_x(&fs->mtx, "fix_alloc", make_small(i)); +#endif +#endif + +} + +void +erts_fix_info(ErtsAlcType_t type, ErtsFixInfo *efip) +{ + Uint i; + FixAlloc *f; +#ifdef DEBUG + FixAllocBlock *b; + void *fp; +#endif + Uint real_item_size; + ErtsAlcType_t t_no = ERTS_ALC_T2N(type); + + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no); + ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + + i = FIX_IX(t_no); + f = fa[i]; + + efip->total = sizeof(FixAlloc *); + efip->used = 0; + if (!f) + return; + + real_item_size = f->item_size - xblk_sz; + + FA_LOCK(f); + + efip->total += sizeof(FixAlloc); + efip->total += f->no_blocks*FIX_POOL_SZ(real_item_size); + efip->used = efip->total - f->no_free*real_item_size; + +#ifdef DEBUG + ASSERT(efip->total >= efip->used); + for(i = 0, b = f->blocks; b; i++, b = b->next); + ASSERT(f->no_blocks == i); + for (i = 0, fp = f->freelist; fp; i++, fp = *((void **) fp)); + ASSERT(f->no_free == i); +#endif + + FA_UNLOCK(f); + +} + +void +erts_fix_free(ErtsAlcType_t t_no, void *extra, void* ptr) +{ + Uint i; + FixAlloc *f; + + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no); + ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + + i = FIX_IX(t_no); + f = fa[i]; + + FA_LOCK(f); + *((void **) ptr) = f->freelist; + f->freelist = ptr; + f->no_free++; + FA_UNLOCK(f); +} + + +void *erts_fix_realloc(ErtsAlcType_t t_no, void *extra, void* ptr, Uint size) +{ + erts_alc_fatal_error(ERTS_ALC_E_NOTSUP, ERTS_ALC_O_REALLOC, t_no); + return NULL; +} + +void *erts_fix_alloc(ErtsAlcType_t t_no, void *extra, Uint size) +{ + void *ret; + int i; + FixAlloc *f; + +#if defined(DEBUG) && !ERTS_ALC_MTA_FIXED_SIZE + ASSERT(ERTS_ALC_N_MIN_A_FIXED_SIZE <= t_no); + ASSERT(t_no <= ERTS_ALC_N_MAX_A_FIXED_SIZE); + if (first_time) { /* Check that all sizes have been initialized */ + int i; + for (i = 0; i < FA_SZ; i++) + ASSERT(fa[i]); + first_time = 0; + } +#endif + + + i = FIX_IX(t_no); + f = fa[i]; + + ASSERT(f); + ASSERT(f->item_size >= size); + + FA_LOCK(f); + if (f->freelist == NULL) { /* Gotta alloc some more mem */ + char *ptr; + FixAllocBlock *bl; + Uint n; + + + FA_UNLOCK(f); + bl = (*core_alloc)(FIX_POOL_SZ(f->item_size)); + if (!bl) + return NULL; + + FA_LOCK(f); + bl->next = f->blocks; /* link in first */ + f->blocks = bl; + + n = NOPERBLOCK; + ptr = (char *) &f->blocks->mem[0]; + while(n--) { + *((void **) ptr) = f->freelist; + f->freelist = (void *) ptr; + ptr += f->item_size; + } +#if !ERTS_ALC_MTA_FIXED_SIZE + ASSERT(f->no_free == 0); +#endif + f->no_free += NOPERBLOCK; + f->no_blocks++; + } + + ret = f->freelist; + f->freelist = *((void **) f->freelist); + ASSERT(f->no_free > 0); + f->no_free--; + + FA_UNLOCK(f); + + return ret; +} + +#endif /* #ifdef ERTS_ALC_N_MIN_A_FIXED_SIZE */ diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h new file mode 100644 index 0000000000..1b64e23174 --- /dev/null +++ b/erts/emulator/beam/global.h @@ -0,0 +1,1800 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __GLOBAL_H__ +#define __GLOBAL_H__ + +#include "sys.h" +#include "erl_alloc.h" +#include "erl_vm.h" +#include "erl_node_container_utils.h" +#include "hash.h" +#include "index.h" +#include "atom.h" +#include "export.h" +#include "module.h" +#include "register.h" +#include "erl_fun.h" +#include "erl_node_tables.h" +#include "benchmark.h" +#include "erl_process.h" +#include "erl_sys_driver.h" +#include "erl_debug.h" + +typedef struct port Port; +#include "erl_port_task.h" + +#define ERTS_MAX_NO_OF_ASYNC_THREADS 1024 +extern int erts_async_max_threads; +#define ERTS_ASYNC_THREAD_MIN_STACK_SIZE 16 /* Kilo words */ +#define ERTS_ASYNC_THREAD_MAX_STACK_SIZE 8192 /* Kilo words */ +extern int erts_async_thread_suggested_stack_size; + +typedef struct erts_driver_t_ erts_driver_t; + +#define SMALL_IO_QUEUE 5 /* Number of fixed elements */ + +typedef struct { + int size; /* total size in bytes */ + + SysIOVec* v_start; + SysIOVec* v_end; + SysIOVec* v_head; + SysIOVec* v_tail; + SysIOVec v_small[SMALL_IO_QUEUE]; + + ErlDrvBinary** b_start; + ErlDrvBinary** b_end; + ErlDrvBinary** b_head; + ErlDrvBinary** b_tail; + ErlDrvBinary* b_small[SMALL_IO_QUEUE]; +} ErlIOQueue; + +typedef struct line_buf { /* Buffer used in line oriented I/O */ + int bufsiz; /* Size of character buffer */ + int ovlen; /* Length of overflow data */ + int ovsiz; /* Actual size of overflow buffer */ + char data[1]; /* Starting point of buffer data, + data[0] is a flag indicating an unprocess CR, + The rest is the overflow buffer. */ +} LineBuf; + +struct enif_environment_t /* ErlNifEnv */ +{ + void* nif_data; + Process* proc; + Eterm* hp; + Eterm* hp_end; + unsigned heap_frag_sz; + int fpe_was_unmasked; +}; +extern void erts_pre_nif(struct enif_environment_t*, Process*, void* nif_data); +extern void erts_post_nif(struct enif_environment_t* env); +extern Eterm erts_nif_taints(Process* p); + +/* + * Port Specific Data. + * + * Only use PrtSD for very rarely used data. + */ + +#define ERTS_PRTSD_SCHED_ID 0 + +#define ERTS_PRTSD_SIZE 1 + +typedef struct { + void *data[ERTS_PRTSD_SIZE]; +} ErtsPrtSD; + +#ifdef ERTS_SMP +typedef struct ErtsXPortsList_ ErtsXPortsList; +#endif + +/* + * Port locking: + * + * Locking is done either driver specific or port specific. When + * driver specific locking is used, all instances of the driver, + * i.e. ports running the driver, share the same lock. When port + * specific locking is used each instance have its own lock. + * + * Most fields in the Port structure are protected by the lock + * referred to by the lock field. I'v called it the port lock. + * This lock is shared between all ports running the same driver + * when driver specific locking is used. + * + * The 'sched' field is protected by the port tasks lock + * (see erl_port_tasks.c) + * + * The 'status' field is protected by a combination of the port lock, + * the port tasks lock, and the state_lck. It may be read if + * the state_lck, or the port lock is held. It may only be + * modified if both the port lock and the state_lck is held + * (with one exception; see below). When changeing status from alive + * to dead or vice versa, also the port task lock has to be held. + * This in order to guarantee that tasks are scheduled only for + * ports that are alive. + * + * The status field may be modified with only the state_lck + * held when status is changed from dead to alive. This since no + * threads can have any references to the port other than via the + * port table. + * + * /rickard + */ + +struct port { + ErtsPortTaskSched sched; + ErtsPortTaskHandle timeout_task; +#ifdef ERTS_SMP + erts_smp_atomic_t refc; + erts_smp_mtx_t *lock; + ErtsXPortsList *xports; + erts_smp_atomic_t run_queue; + erts_smp_spinlock_t state_lck; /* protects: id, status, snapshot */ +#endif + Eterm id; /* The Port id of this port */ + Eterm connected; /* A connected process */ + Eterm caller; /* Current caller. */ + Eterm data; /* Data associated with port. */ + ErlHeapFragment* bp; /* Heap fragment holding data (NULL if imm data). */ + ErtsLink *nlinks; + ErtsMonitor *monitors; /* Only MON_ORIGIN monitors of pid's */ + Uint bytes_in; /* Number of bytes read */ + Uint bytes_out; /* Number of bytes written */ +#ifdef ERTS_SMP + ErtsSmpPTimer *ptimer; +#else + ErlTimer tm; /* Timer entry */ +#endif + + Eterm tracer_proc; /* If the port is traced, this is the tracer */ + Uint trace_flags; /* Trace flags */ + + ErlIOQueue ioq; /* driver accessible i/o queue */ + DistEntry *dist_entry; /* Dist entry used in DISTRIBUTION */ + char *name; /* String used in the open */ + erts_driver_t* drv_ptr; + long drv_data; + ErtsProcList *suspended; /* List of suspended processes. */ + LineBuf *linebuf; /* Buffer to hold data not ready for + process to get (line oriented I/O)*/ + Uint32 status; /* Status and type flags */ + int control_flags; /* Flags for port_control() */ + Uint32 snapshot; /* Next snapshot that port should be part of */ + struct reg_proc *reg; + ErlDrvPDL port_data_lock; + + ErtsPrtSD *psd; /* Port specific data */ +}; + + +ERTS_GLB_INLINE ErtsRunQueue *erts_port_runq(Port *prt); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE ErtsRunQueue * +erts_port_runq(Port *prt) +{ +#ifdef ERTS_SMP + ErtsRunQueue *rq1, *rq2; + rq1 = (ErtsRunQueue *) erts_smp_atomic_read(&prt->run_queue); + while (1) { + erts_smp_runq_lock(rq1); + rq2 = (ErtsRunQueue *) erts_smp_atomic_read(&prt->run_queue); + if (rq1 == rq2) + return rq1; + erts_smp_runq_unlock(rq1); + rq1 = rq2; + } +#else + return erts_common_run_queue; +#endif +} + +#endif + + +ERTS_GLB_INLINE void *erts_prtsd_get(Port *p, int ix); +ERTS_GLB_INLINE void *erts_prtsd_set(Port *p, int ix, void *new); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void * +erts_prtsd_get(Port *prt, int ix) +{ + return prt->psd ? prt->psd->data[ix] : NULL; +} + +ERTS_GLB_INLINE void * +erts_prtsd_set(Port *prt, int ix, void *data) +{ + if (prt->psd) { + void *old = prt->psd->data[ix]; + prt->psd->data[ix] = data; + return old; + } + else { + prt->psd = erts_alloc(ERTS_ALC_T_PRTSD, sizeof(ErtsPrtSD)); + prt->psd->data[ix] = data; + return NULL; + } +} + +#endif + +/* Driver handle (wrapper for old plain handle) */ +#define ERL_DE_OK 0 +#define ERL_DE_UNLOAD 1 +#define ERL_DE_FORCE_UNLOAD 2 +#define ERL_DE_RELOAD 3 +#define ERL_DE_FORCE_RELOAD 4 +#define ERL_DE_PERMANENT 5 + +#define ERL_DE_PROC_LOADED 0 +#define ERL_DE_PROC_AWAIT_UNLOAD 1 +#define ERL_DE_PROC_AWAIT_UNLOAD_ONLY 2 +#define ERL_DE_PROC_AWAIT_LOAD 3 + +/* Flags for process entries */ +#define ERL_DE_FL_DEREFERENCED 1 + +/* Flags for drivers, put locking policy here /PaN */ +#define ERL_DE_FL_KILL_PORTS 1 + +#define ERL_FL_CONSISTENT_MASK ( ERL_DE_FL_KILL_PORTS ) + +/* System specific load errors are returned as positive values */ +#define ERL_DE_NO_ERROR 0 +#define ERL_DE_LOAD_ERROR_NO_INIT -1 +#define ERL_DE_LOAD_ERROR_FAILED_INIT -2 +#define ERL_DE_LOAD_ERROR_BAD_NAME -3 +#define ERL_DE_LOAD_ERROR_NAME_TO_LONG -4 +#define ERL_DE_LOAD_ERROR_INCORRECT_VERSION -5 +#define ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY -6 +#define ERL_DE_ERROR_UNSPECIFIED -7 +#define ERL_DE_LOOKUP_ERROR_NOT_FOUND -8 +#define ERL_DE_DYNAMIC_ERROR_OFFSET -10 + +typedef struct de_proc_entry { + Process *proc; /* The process... */ + Uint awaiting_status; /* PROC_LOADED == Have loaded the driver + PROC_AWAIT_UNLOAD == Wants to be notified + when we have unloaded the driver (was locked) + PROC_AWAIT_LOAD == Wants to be notified when we + reloaded the driver (old was locked) */ + Uint flags; /* ERL_FL_DE_DEREFERENCED when reload in progress */ + Eterm heap[REF_THING_SIZE]; /* "ref heap" */ + struct de_proc_entry *next; +} DE_ProcEntry; + +typedef struct { + void *handle; /* Handle for DLL or SO (for dyn. drivers). */ + DE_ProcEntry *procs; /* List of pids that have loaded this driver, + or that wait for it to change state */ + erts_refc_t refc; /* Number of ports/processes having + references to the driver */ + Uint port_count; /* Number of ports using the driver */ + Uint flags; /* ERL_DE_FL_KILL_PORTS */ + int status; /* ERL_DE_xxx */ + char *full_path; /* Full path of the driver */ + char *reload_full_path; /* If status == ERL_DE_RELOAD, this contains + full name of driver (path) */ + char *reload_driver_name; /* ... and this contains the driver name */ + Uint reload_flags; /* flags for reloaded driver */ +} DE_Handle; + +/* + * This structure represents a link to the next driver. + */ + +struct erts_driver_t_ { + erts_driver_t *next; + erts_driver_t *prev; + char *name; + struct { + int major; + int minor; + } version; + int flags; + DE_Handle *handle; +#ifdef ERTS_SMP + erts_smp_mtx_t *lock; +#endif + ErlDrvEntry *entry; + ErlDrvData (*start)(ErlDrvPort port, char *command, SysDriverOpts* opts); + void (*stop)(ErlDrvData drv_data); + void (*finish)(void); + void (*flush)(ErlDrvData drv_data); + void (*output)(ErlDrvData drv_data, char *buf, int len); + void (*outputv)(ErlDrvData drv_data, ErlIOVec *ev); /* Might be NULL */ + int (*control)(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); /* Might be NULL */ + int (*call)(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned int *flags); /* Might be NULL */ + void (*event)(ErlDrvData drv_data, ErlDrvEvent event, + ErlDrvEventData event_data); + void (*ready_input)(ErlDrvData drv_data, ErlDrvEvent event); + void (*ready_output)(ErlDrvData drv_data, ErlDrvEvent event); + void (*timeout)(ErlDrvData drv_data); + void (*ready_async)(ErlDrvData drv_data, ErlDrvThreadData thread_data); /* Might be NULL */ + void (*process_exit)(ErlDrvData drv_data, ErlDrvMonitor *monitor); + void (*stop_select)(ErlDrvEvent event, void*); /* Might be NULL */ +}; + +extern erts_driver_t *driver_list; +extern erts_smp_mtx_t erts_driver_list_lock; + +extern void erts_ddll_init(void); +extern void erts_ddll_lock_driver(DE_Handle *dh, char *name); + +/* These are for bookkeeping */ +extern void erts_ddll_increment_port_count(DE_Handle *dh); +extern void erts_ddll_decrement_port_count(DE_Handle *dh); + +/* These makes things happen, drivers may be scheduled for unload etc */ +extern void erts_ddll_reference_driver(DE_Handle *dh); +extern void erts_ddll_reference_referenced_driver(DE_Handle *dh); +extern void erts_ddll_dereference_driver(DE_Handle *dh); + +extern char *erts_ddll_error(int code); +extern void erts_ddll_proc_dead(Process *p, ErtsProcLocks plocks); +extern int erts_ddll_driver_ok(DE_Handle *dh); +extern void erts_ddll_remove_monitor(Process *p, + Eterm ref, + ErtsProcLocks plocks); +extern Eterm erts_ddll_monitor_driver(Process *p, + Eterm description, + ErtsProcLocks plocks); +/* + * Max no. of drivers (linked in and dynamically loaded). Each table + * entry uses 4 bytes. + */ +#define DRIVER_TAB_SIZE 32 + +/* +** Just like the driver binary but with initial flags +** Note that the two structures Binary and ErlDrvBinary HAVE to +** be equal except for extra fields in the beginning of the struct. +** ErlDrvBinary is defined in erl_driver.h. +** When driver_alloc_binary is called, a Binary is allocated, but +** the pointer returned is to the address of the first element that +** also occurs in the ErlDrvBinary struct (driver.*binary takes care if this). +** The driver need never know about additions to the internal Binary of the +** emulator. One should however NEVER be sloppy when mixing ErlDrvBinary +** and Binary, the macros below can convert one type to the other, as they both +** in reality are equal. +*/ +typedef struct binary { + Uint flags; + erts_refc_t refc; +#ifdef ARCH_32 + Uint32 align__; /* *DO NOT USE* only for alignment. */ +#endif + /* Add fields BEFORE this, otherwise the drivers crash */ + long orig_size; + char orig_bytes[1]; /* to be continued */ +} Binary; + +/* + * 'Binary' alignment: + * Address of orig_bytes[0] of a Binary should always be 8-byte aligned. + * It is assumed that the flags, refc, and orig_size fields are 4 bytes on + * 32-bits architectures and 8 bytes on 64-bits architectures. + */ + +/* + * "magic" binary. + */ +typedef struct { + void (*destructor)(Binary *); + char magic_bin_data[1]; +} ErtsBinaryMagicPart; + +#define ERTS_MAGIC_BIN_DESTRUCTOR(BP) \ + (((ErtsBinaryMagicPart *) (BP)->orig_bytes)->destructor) +#define ERTS_MAGIC_BIN_DATA(BP) \ + ((void *) (((ErtsBinaryMagicPart *) (BP)->orig_bytes)->magic_bin_data)) +#define ERTS_MAGIC_BIN_DATA_SIZE(BP) \ + ((BP)->orig_size - (sizeof(ErtsBinaryMagicPart) - 1)) + +#define Binary2ErlDrvBinary(B) ((ErlDrvBinary *) (&((B)->orig_size))) +#define ErlDrvBinary2Binary(D) ((Binary *) \ + (((char *) (D)) - \ + ((char *) &(((Binary *) 0)->orig_size)))) + +/* A "magic" binary flag */ +#define BIN_FLAG_MAGIC 1 +#define BIN_FLAG_USR1 2 /* Reserved for use by different modules too mark */ +#define BIN_FLAG_USR2 4 /* certain binaries as special (used by ets) */ +#define BIN_FLAG_DRV 8 + +/* + * This structure represents one type of a binary in a process. + */ + +typedef struct proc_bin { + Eterm thing_word; /* Subtag REFC_BINARY_SUBTAG. */ + Uint size; /* Binary size in bytes. */ + struct proc_bin *next; /* Pointer to next ProcBin. */ + Binary *val; /* Pointer to Binary structure. */ + byte *bytes; /* Pointer to the actual data bytes. */ + Uint flags; /* Flag word. */ +} ProcBin; + +#define PB_IS_WRITABLE 1 /* Writable (only one reference to ProcBin) */ +#define PB_ACTIVE_WRITER 2 /* There is an active writer */ + +/* + * ProcBin size in Eterm words. + */ +#define PROC_BIN_SIZE (sizeof(ProcBin)/sizeof(Eterm)) + +ERTS_GLB_INLINE Eterm erts_mk_magic_binary_term(Eterm **hpp, + ErlOffHeap *ohp, + Binary *mbp); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE Eterm +erts_mk_magic_binary_term(Eterm **hpp, ErlOffHeap *ohp, Binary *mbp) +{ + ProcBin *pb = (ProcBin *) *hpp; + *hpp += PROC_BIN_SIZE; + + ASSERT(mbp->flags & BIN_FLAG_MAGIC); + + pb->thing_word = HEADER_PROC_BIN; + pb->size = 0; + pb->next = ohp->mso; + ohp->mso = pb; + pb->val = mbp; + pb->bytes = (byte *) mbp->orig_bytes; + pb->flags = 0; + + erts_refc_inc(&mbp->refc, 1); + + return make_binary(pb); +} + +#endif + +#define ERTS_TERM_IS_MAGIC_BINARY(T) \ + (is_binary((T)) \ + && (thing_subtag(*binary_val((T))) == REFC_BINARY_SUBTAG) \ + && (((ProcBin *) binary_val((T)))->val->flags & BIN_FLAG_MAGIC)) + +/* arrays that get malloced at startup */ +extern Port* erts_port; +extern erts_smp_atomic_t erts_ports_alive; + +extern Uint erts_max_ports; +extern Uint erts_port_tab_index_mask; +extern erts_smp_atomic_t erts_ports_snapshot; +extern erts_smp_atomic_t erts_dead_ports_ptr; + +ERTS_GLB_INLINE void erts_may_save_closed_port(Port *prt); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void erts_may_save_closed_port(Port *prt) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_spinlock_is_locked(&prt->state_lck)); + if (prt->snapshot != erts_smp_atomic_read(&erts_ports_snapshot)) { + /* Dead ports are added from the end of the snapshot buffer */ + Eterm* tombstone = (Eterm*) erts_smp_atomic_addtest(&erts_dead_ports_ptr, + -(long)sizeof(Eterm)); + ASSERT(tombstone+1 != NULL); + ASSERT(prt->snapshot == (Uint32) erts_smp_atomic_read(&erts_ports_snapshot) - 1); + *tombstone = prt->id; + } + /*else no ongoing snapshot or port was already included or created after snapshot */ +} + +#endif + +/* controls warning mapping in error_logger */ + +extern Eterm node_cookie; +extern erts_smp_atomic_t erts_bytes_out; /* no bytes written out */ +extern erts_smp_atomic_t erts_bytes_in; /* no bytes sent into the system */ +extern Uint display_items; /* no of items to display in traces etc */ +extern Uint display_loads; /* print info about loaded modules */ + +extern int erts_backtrace_depth; +extern erts_smp_atomic_t erts_max_gen_gcs; + +extern int erts_disable_tolerant_timeofday; + +#ifdef HYBRID + +/* Message Area heap pointers */ +extern Eterm *global_heap; /* Heap start */ +extern Eterm *global_hend; /* Heap end */ +extern Eterm *global_htop; /* Heap top (heap pointer) */ +extern Eterm *global_saved_htop; /* Saved heap top (heap pointer) */ +extern Uint global_heap_sz; /* Heap size, in words */ +extern Eterm *global_old_heap; /* Old generation */ +extern Eterm *global_old_hend; +extern ErlOffHeap erts_global_offheap; /* Global MSO (OffHeap) list */ + +extern Uint16 global_gen_gcs; +extern Uint16 global_max_gen_gcs; +extern Uint global_gc_flags; + +#ifdef INCREMENTAL +#define ACTIVATE(p) +#define DEACTIVATE(p) +#define IS_ACTIVE(p) 1 + +#define INC_ACTIVATE(p) do { \ + if ((p)->active) { \ + if ((p)->active_next != NULL) { \ + (p)->active_next->active_prev = (p)->active_prev; \ + if ((p)->active_prev) { \ + (p)->active_prev->active_next = (p)->active_next; \ + } else { \ + inc_active_proc = (p)->active_next; \ + } \ + inc_active_last->active_next = (p); \ + (p)->active_next = NULL; \ + (p)->active_prev = inc_active_last; \ + inc_active_last = (p); \ + } \ + } else { \ + (p)->active_next = NULL; \ + (p)->active_prev = inc_active_last; \ + if (inc_active_last) { \ + inc_active_last->active_next = (p); \ + } else { \ + inc_active_proc = (p); \ + } \ + inc_active_last = (p); \ + (p)->active = 1; \ + } \ +} while(0); + +#define INC_DEACTIVATE(p) do { \ + ASSERT((p)->active == 1); \ + if ((p)->active_next == NULL) { \ + inc_active_last = (p)->active_prev; \ + } else { \ + (p)->active_next->active_prev = (p)->active_prev; \ + } \ + if ((p)->active_prev == NULL) { \ + inc_active_proc = (p)->active_next; \ + } else { \ + (p)->active_prev->active_next = (p)->active_next; \ + } \ + (p)->active = 0; \ +} while(0); + +#define INC_IS_ACTIVE(p) ((p)->active != 0) + +#else +extern Eterm *global_old_htop; +extern Eterm *global_high_water; +#define ACTIVATE(p) (p)->active = 1; +#define DEACTIVATE(p) (p)->active = 0; +#define IS_ACTIVE(p) ((p)->active != 0) +#define INC_ACTIVATE(p) +#define INC_IS_ACTIVE(p) 1 +#endif /* INCREMENTAL */ + +#else +# define ACTIVATE(p) +# define DEACTIVATE(p) +# define IS_ACTIVE(p) 1 +# define INC_ACTIVATE(p) +#endif /* HYBRID */ + +#ifdef HYBRID +extern Uint global_heap_min_sz; +#endif + +extern int bif_reductions; /* reductions + fcalls (when doing call_bif) */ +extern int stackdump_on_exit; + +/* + * Here is an implementation of a lightweiht stack. + * + * Use it like this: + * + * DECLARE_ESTACK(Stack) (At the start of a block) + * ... + * ESTACK_PUSH(Stack, Term) + * ... + * if (ESTACK_ISEMPTY(Stack)) { + * Stack is empty + * } else { + * Term = ESTACK_POP(Stack); + * Process popped Term here + * } + * ... + * DESTROY_ESTACK(Stack) + */ + + +void erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end); +#define ESTK_CONCAT(a,b) a##b +#define ESTK_SUBSCRIPT(s,i) *((Eterm *)((byte *)ESTK_CONCAT(s,_start) + (i))) +#define DEF_ESTACK_SIZE (16) + +#define DECLARE_ESTACK(s) \ + Eterm ESTK_CONCAT(s,_default_stack)[DEF_ESTACK_SIZE]; \ + Eterm* ESTK_CONCAT(s,_start) = ESTK_CONCAT(s,_default_stack); \ + Eterm* ESTK_CONCAT(s,_sp) = ESTK_CONCAT(s,_start); \ + Eterm* ESTK_CONCAT(s,_end) = ESTK_CONCAT(s,_start) + DEF_ESTACK_SIZE + +#define DESTROY_ESTACK(s) \ +do { \ + if (ESTK_CONCAT(s,_start) != ESTK_CONCAT(s,_default_stack)) { \ + erts_free(ERTS_ALC_T_ESTACK, ESTK_CONCAT(s,_start)); \ + } \ +} while(0) + +#define ESTACK_PUSH(s, x) \ +do { \ + if (ESTK_CONCAT(s,_sp) == ESTK_CONCAT(s,_end)) { \ + erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \ + &ESTK_CONCAT(s,_end)); \ + } \ + *ESTK_CONCAT(s,_sp)++ = (x); \ +} while(0) + +#define ESTACK_PUSH2(s, x, y) \ +do { \ + if (ESTK_CONCAT(s,_sp) > ESTK_CONCAT(s,_end) - 2) { \ + erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \ + &ESTK_CONCAT(s,_end)); \ + } \ + *ESTK_CONCAT(s,_sp)++ = (x); \ + *ESTK_CONCAT(s,_sp)++ = (y); \ +} while(0) + +#define ESTACK_PUSH3(s, x, y, z) \ +do { \ + if (ESTK_CONCAT(s,_sp) > ESTK_CONCAT(s,_end) - 3) { \ + erl_grow_stack(&ESTK_CONCAT(s,_start), &ESTK_CONCAT(s,_sp), \ + &ESTK_CONCAT(s,_end)); \ + } \ + *ESTK_CONCAT(s,_sp)++ = (x); \ + *ESTK_CONCAT(s,_sp)++ = (y); \ + *ESTK_CONCAT(s,_sp)++ = (z); \ +} while(0) + +#define ESTACK_COUNT(s) (ESTK_CONCAT(s,_sp) - ESTK_CONCAT(s,_start)) + +#define ESTACK_ISEMPTY(s) (ESTK_CONCAT(s,_sp) == ESTK_CONCAT(s,_start)) +#define ESTACK_POP(s) (*(--ESTK_CONCAT(s,_sp))) + + +/* port status flags */ + +#define ERTS_PORT_SFLG_CONNECTED ((Uint32) (1 << 0)) +/* Port have begun exiting */ +#define ERTS_PORT_SFLG_EXITING ((Uint32) (1 << 1)) +/* Distribution port */ +#define ERTS_PORT_SFLG_DISTRIBUTION ((Uint32) (1 << 2)) +#define ERTS_PORT_SFLG_BINARY_IO ((Uint32) (1 << 3)) +#define ERTS_PORT_SFLG_SOFT_EOF ((Uint32) (1 << 4)) +/* Flow control */ +#define ERTS_PORT_SFLG_PORT_BUSY ((Uint32) (1 << 5)) +/* Port is closing (no i/o accepted) */ +#define ERTS_PORT_SFLG_CLOSING ((Uint32) (1 << 6)) +/* Send a closed message when terminating */ +#define ERTS_PORT_SFLG_SEND_CLOSED ((Uint32) (1 << 7)) +/* Line orinted io on port */ +#define ERTS_PORT_SFLG_LINEBUF_IO ((Uint32) (1 << 8)) +/* Immortal port (only certain system ports) */ +#define ERTS_PORT_SFLG_IMMORTAL ((Uint32) (1 << 9)) +#define ERTS_PORT_SFLG_FREE ((Uint32) (1 << 10)) +#define ERTS_PORT_SFLG_FREE_SCHEDULED ((Uint32) (1 << 11)) +#define ERTS_PORT_SFLG_INITIALIZING ((Uint32) (1 << 12)) +/* Port uses port specific locking (opposed to driver specific locking) */ +#define ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK ((Uint32) (1 << 13)) +#define ERTS_PORT_SFLG_INVALID ((Uint32) (1 << 14)) +#ifdef DEBUG +/* Only debug: make sure all flags aren't cleared unintentionally */ +#define ERTS_PORT_SFLG_PORT_DEBUG ((Uint32) (1 << 31)) +#endif + +/* Combinations of port status flags */ +#define ERTS_PORT_SFLGS_DEAD \ + (ERTS_PORT_SFLG_FREE \ + | ERTS_PORT_SFLG_FREE_SCHEDULED \ + | ERTS_PORT_SFLG_INITIALIZING) +#define ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP \ + (ERTS_PORT_SFLGS_DEAD | ERTS_PORT_SFLG_INVALID) +#define ERTS_PORT_SFLGS_INVALID_LOOKUP \ + (ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP \ + | ERTS_PORT_SFLG_CLOSING) +#define ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP \ + (ERTS_PORT_SFLGS_INVALID_LOOKUP \ + | ERTS_PORT_SFLG_PORT_BUSY \ + | ERTS_PORT_SFLG_DISTRIBUTION) + +/* binary.c */ + +void erts_emasculate_writable_binary(ProcBin* pb); +Eterm erts_new_heap_binary(Process *p, byte *buf, int len, byte** datap); +Eterm erts_new_mso_binary(Process*, byte*, int); +Eterm new_binary(Process*, byte*, int); +Eterm erts_realloc_binary(Eterm bin, size_t size); +void erts_cleanup_mso(ProcBin* pb); + +/* erl_bif_info.c */ + +void erts_bif_info_init(void); + +/* bif.c */ +Eterm erts_make_ref(Process *); +Eterm erts_make_ref_in_buffer(Eterm buffer[REF_THING_SIZE]); +void erts_queue_monitor_message(Process *, + ErtsProcLocks*, + Eterm, + Eterm, + Eterm, + Eterm); +void erts_init_bif(void); + +/* erl_bif_port.c */ + +/* erl_bif_trace.c */ +void erts_system_monitor_clear(Process *c_p); +void erts_system_profile_clear(Process *c_p); + +/* beam_load.c */ +int erts_load_module(Process *c_p, ErtsProcLocks c_p_locks, + Eterm group_leader, Eterm* mod, byte* code, int size); +void init_load(void); +Eterm* find_function_from_pc(Eterm* pc); +Eterm erts_module_info_0(Process* p, Eterm module); +Eterm erts_module_info_1(Process* p, Eterm module, Eterm what); +Eterm erts_make_stub_module(Process* p, Eterm Mod, Eterm Beam, Eterm Info); + +/* break.c */ +void init_break_handler(void); +void erts_set_ignore_break(void); +void erts_replace_intr(void); +void process_info(int, void *); +void print_process_info(int, void *, Process*); +void info(int, void *); +void loaded(int, void *); + +/* config.c */ + +__decl_noreturn void __noreturn erl_exit(int n, char*, ...); +__decl_noreturn void __noreturn erl_exit0(char *, int, int n, char*, ...); +void erl_error(char*, va_list); + +#define ERL_EXIT0(n,f) erl_exit0(__FILE__, __LINE__, n, f) +#define ERL_EXIT1(n,f,a) erl_exit0(__FILE__, __LINE__, n, f, a) +#define ERL_EXIT2(n,f,a,b) erl_exit0(__FILE__, __LINE__, n, f, a, b) +#define ERL_EXIT3(n,f,a,b,c) erl_exit0(__FILE__, __LINE__, n, f, a, b, c) + +/* copy.c */ +void init_copy(void); +Eterm copy_object(Eterm, Process*); +Uint size_object(Eterm); +Eterm copy_struct(Eterm, Uint, Eterm**, ErlOffHeap*); +Eterm copy_shallow(Eterm*, Uint, Eterm**, ErlOffHeap*); + +#ifdef HYBRID +#define RRMA_DEFAULT_SIZE 256 +#define RRMA_STORE(p,ptr,src) do { \ + ASSERT((p)->rrma != NULL); \ + ASSERT((p)->rrsrc != NULL); \ + (p)->rrma[(p)->nrr] = (ptr); \ + (p)->rrsrc[(p)->nrr++] = (src); \ + if ((p)->nrr == (p)->rrsz) \ + { \ + (p)->rrsz *= 2; \ + (p)->rrma = (Eterm *) erts_realloc(ERTS_ALC_T_ROOTSET, \ + (void*)(p)->rrma, \ + sizeof(Eterm) * (p)->rrsz); \ + (p)->rrsrc = (Eterm **) erts_realloc(ERTS_ALC_T_ROOTSET, \ + (void*)(p)->rrsrc, \ + sizeof(Eterm) * (p)->rrsz); \ + } \ +} while(0) + +/* Note that RRMA_REMOVE decreases the given index after deletion. + * This is done so that a loop with an increasing index can call + * remove without having to decrease the index to see the element + * placed in the hole after the deleted element. + */ +#define RRMA_REMOVE(p,index) do { \ + p->rrsrc[index] = p->rrsrc[--p->nrr]; \ + p->rrma[index--] = p->rrma[p->nrr]; \ + } while(0); + + +/* The MessageArea STACKs are used while copying messages to the + * message area. + */ +#define MA_STACK_EXTERNAL_DECLARE(type,_s_) \ + typedef type ma_##_s_##_type; \ + extern ma_##_s_##_type *ma_##_s_##_stack; \ + extern Uint ma_##_s_##_top; \ + extern Uint ma_##_s_##_size; + +#define MA_STACK_DECLARE(_s_) \ + ma_##_s_##_type *ma_##_s_##_stack; Uint ma_##_s_##_top; Uint ma_##_s_##_size; + +#define MA_STACK_ALLOC(_s_) do { \ + ma_##_s_##_top = 0; \ + ma_##_s_##_size = 512; \ + ma_##_s_##_stack = (ma_##_s_##_type*)erts_alloc(ERTS_ALC_T_OBJECT_STACK, \ + sizeof(ma_##_s_##_type) * ma_##_s_##_size); \ +} while(0) + + +#define MA_STACK_PUSH(_s_,val) do { \ + ma_##_s_##_stack[ma_##_s_##_top++] = (val); \ + if (ma_##_s_##_top == ma_##_s_##_size) \ + { \ + ma_##_s_##_size *= 2; \ + ma_##_s_##_stack = \ + (ma_##_s_##_type*) erts_realloc(ERTS_ALC_T_OBJECT_STACK, \ + (void*)ma_##_s_##_stack, \ + sizeof(ma_##_s_##_type) * ma_##_s_##_size); \ + } \ +} while(0) + +#define MA_STACK_POP(_s_) (ma_##_s_##_top != 0 ? ma_##_s_##_stack[--ma_##_s_##_top] : 0) +#define MA_STACK_TOP(_s_) (ma_##_s_##_stack[ma_##_s_##_top - 1]) +#define MA_STACK_UPDATE(_s_,offset,value) \ + *(ma_##_s_##_stack[ma_##_s_##_top - 1] + (offset)) = (value) +#define MA_STACK_SIZE(_s_) (ma_##_s_##_top) +#define MA_STACK_ELM(_s_,i) ma_##_s_##_stack[i] + +MA_STACK_EXTERNAL_DECLARE(Eterm,src); +MA_STACK_EXTERNAL_DECLARE(Eterm*,dst); +MA_STACK_EXTERNAL_DECLARE(Uint,offset); + + +#ifdef INCREMENTAL +extern Eterm *ma_pending_stack; +extern Uint ma_pending_top; +extern Uint ma_pending_size; + +#define NO_COPY(obj) (IS_CONST(obj) || \ + (((ptr_val(obj) >= global_heap) && \ + (ptr_val(obj) < global_htop)) || \ + ((ptr_val(obj) >= inc_fromspc) && \ + (ptr_val(obj) < inc_fromend)) || \ + ((ptr_val(obj) >= global_old_heap) && \ + (ptr_val(obj) < global_old_hend)))) + +#else + +#define NO_COPY(obj) (IS_CONST(obj) || \ + (((ptr_val(obj) >= global_heap) && \ + (ptr_val(obj) < global_htop)) || \ + ((ptr_val(obj) >= global_old_heap) && \ + (ptr_val(obj) < global_old_hend)))) + +#endif /* INCREMENTAL */ + +#define LAZY_COPY(from,obj) do { \ + if (!NO_COPY(obj)) { \ + BM_LAZY_COPY_START; \ + BM_COUNT(messages_copied); \ + obj = copy_struct_lazy(from,obj,0); \ + BM_LAZY_COPY_STOP; \ + } \ +} while(0) + +Eterm copy_struct_lazy(Process*, Eterm, Uint); + +#endif /* HYBRID */ + +/* Utilities */ +extern void erts_delete_nodes_monitors(Process *, ErtsProcLocks); +extern Eterm erts_monitor_nodes(Process *, Eterm, Eterm); +extern Eterm erts_processes_monitoring_nodes(Process *); +extern int erts_do_net_exits(DistEntry*, Eterm); +extern int distribution_info(int, void *); +extern int is_node_name_atom(Eterm a); + +extern int erts_net_message(Port *, DistEntry *, byte *, int, byte *, int); + +extern void init_dist(void); +extern int stop_dist(void); + +void erl_progressf(char* format, ...); + +#ifdef MESS_DEBUG +void print_pass_through(int, byte*, int); +#endif + +/* beam_emu.c */ +int catchlevel(Process*); +void init_emulator(_VOID_); +void process_main(void); +Eterm build_stacktrace(Process* c_p, Eterm exc); +Eterm expand_error_value(Process* c_p, Uint freason, Eterm Value); + +/* erl_init.c */ + +typedef struct { + Eterm delay_time; + int context_reds; + int input_reds; +} ErtsModifiedTimings; + +extern Export *erts_delay_trap; +extern int erts_modified_timing_level; +extern ErtsModifiedTimings erts_modified_timings[]; +#define ERTS_USE_MODIFIED_TIMING() \ + (erts_modified_timing_level >= 0) +#define ERTS_MODIFIED_TIMING_DELAY \ + (erts_modified_timings[erts_modified_timing_level].delay_time) +#define ERTS_MODIFIED_TIMING_CONTEXT_REDS \ + (erts_modified_timings[erts_modified_timing_level].context_reds) +#define ERTS_MODIFIED_TIMING_INPUT_REDS \ + (erts_modified_timings[erts_modified_timing_level].input_reds) + +extern Eterm erts_error_logger_warnings; +extern int erts_initialized; +extern int erts_compat_rel; +extern int erts_use_sender_punish; +void erts_short_init(void); +void erl_start(int, char**); +void erts_usage(void); +Eterm erts_preloaded(Process* p); +/* erl_md5.c */ + +typedef struct { + Uint32 state[4]; /* state (ABCD) */ + Uint32 count[2]; /* number of bits, modulo 2^64 (lsb first) */ + unsigned char buffer[64]; /* input buffer */ +} MD5_CTX; + +void MD5Init(MD5_CTX *); +void MD5Update(MD5_CTX *, unsigned char *, unsigned int); +void MD5Final(unsigned char [16], MD5_CTX *); + +/* ggc.c */ + + +typedef struct { + Uint garbage_collections; + Uint reclaimed; +} ErtsGCInfo; + +void erts_gc_info(ErtsGCInfo *gcip); +void erts_init_gc(void); +int erts_garbage_collect(Process*, int, Eterm*, int); +void erts_garbage_collect_hibernate(Process* p); +Eterm erts_gc_after_bif_call(Process* p, Eterm result, Eterm* regs, Uint arity); +void erts_garbage_collect_literals(Process* p, Eterm* literals, Uint lit_size); +Uint erts_next_heap_size(Uint, Uint); +Eterm erts_heap_sizes(Process* p); + +void erts_offset_off_heap(ErlOffHeap *, Sint, Eterm*, Eterm*); +void erts_offset_heap_ptr(Eterm*, Uint, Sint, Eterm*, Eterm*); +void erts_offset_heap(Eterm*, Uint, Sint, Eterm*, Eterm*); + +#ifdef HYBRID +int erts_global_garbage_collect(Process*, int, Eterm*, int); +#endif + +/* io.c */ + +struct erl_drv_port_data_lock { + erts_mtx_t mtx; + erts_atomic_t refc; +}; + +typedef struct { + char *name; + char *driver_name; +} ErtsPortNames; + +#define ERTS_SPAWN_DRIVER 1 +#define ERTS_SPAWN_EXECUTABLE 2 +#define ERTS_SPAWN_ANY (ERTS_SPAWN_DRIVER | ERTS_SPAWN_EXECUTABLE) + +int erts_add_driver_entry(ErlDrvEntry *drv, DE_Handle *handle, int driver_list_locked); +void erts_destroy_driver(erts_driver_t *drv); +void erts_wake_process_later(Port*, Process*); +int erts_open_driver(erts_driver_t*, Eterm, char*, SysDriverOpts*, int *); +int erts_is_port_ioq_empty(Port *); +void erts_terminate_port(Port *); +void close_port(Eterm); +void init_io(void); +void cleanup_io(void); +void erts_do_exit_port(Port *, Eterm, Eterm); +void erts_port_command(Process *, Eterm, Port *, Eterm); +Eterm erts_port_control(Process*, Port*, Uint, Eterm); +int erts_write_to_port(Eterm caller_id, Port *p, Eterm list); +void print_port_info(int, void *, int); +void erts_raw_port_command(Port*, byte*, Uint); +void driver_report_exit(int, int); +LineBuf* allocate_linebuf(int); +int async_ready(Port *, void*); +Sint erts_test_next_port(int, Uint); +ErtsPortNames *erts_get_port_names(Eterm); +void erts_free_port_names(ErtsPortNames *); +Uint erts_port_ioq_size(Port *pp); +void erts_stale_drv_select(Eterm, ErlDrvEvent, int, int); +void erts_port_cleanup(Port *); +void erts_fire_port_monitor(Port *prt, Eterm ref); +#ifdef ERTS_SMP +void erts_smp_xports_unlock(Port *); +#endif + +#if defined(ERTS_SMP) && defined(ERTS_ENABLE_LOCK_CHECK) +int erts_lc_is_port_locked(Port *); +#endif + +ERTS_GLB_INLINE void erts_smp_port_state_lock(Port*); +ERTS_GLB_INLINE void erts_smp_port_state_unlock(Port*); + +ERTS_GLB_INLINE int erts_smp_port_trylock(Port *prt); +ERTS_GLB_INLINE void erts_smp_port_lock(Port *prt); +ERTS_GLB_INLINE void erts_smp_port_unlock(Port *prt); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_smp_port_state_lock(Port* prt) +{ +#ifdef ERTS_SMP + erts_smp_spin_lock(&prt->state_lck); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_port_state_unlock(Port *prt) +{ +#ifdef ERTS_SMP + erts_smp_spin_unlock(&prt->state_lck); +#endif +} + + +ERTS_GLB_INLINE int +erts_smp_port_trylock(Port *prt) +{ +#ifdef ERTS_SMP + int res; + + ASSERT(erts_smp_atomic_read(&prt->refc) > 0); + erts_smp_atomic_inc(&prt->refc); + res = erts_smp_mtx_trylock(prt->lock); + if (res == EBUSY) { + erts_smp_atomic_dec(&prt->refc); + } + + return res; +#else /* !ERTS_SMP */ + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_port_lock(Port *prt) +{ +#ifdef ERTS_SMP + ASSERT(erts_smp_atomic_read(&prt->refc) > 0); + erts_smp_atomic_inc(&prt->refc); + erts_smp_mtx_lock(prt->lock); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_port_unlock(Port *prt) +{ +#ifdef ERTS_SMP + long refc; + refc = erts_smp_atomic_dectest(&prt->refc); + ASSERT(refc >= 0); + if (refc == 0) + erts_port_cleanup(prt); + else + erts_smp_mtx_unlock(prt->lock); +#endif +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + +#define ERTS_INVALID_PORT_OPT(PP, ID, FLGS) \ + (!(PP) || ((PP)->status & (FLGS)) || (PP)->id != (ID)) + +/* port lookup */ + +#define INVALID_PORT(PP, ID) \ + ERTS_INVALID_PORT_OPT((PP), (ID), ERTS_PORT_SFLGS_INVALID_LOOKUP) + +/* Invalidate trace port if anything suspicious, for instance + * that the port is a distribution port or it is busy. + */ +#define INVALID_TRACER_PORT(PP, ID) \ + ERTS_INVALID_PORT_OPT((PP), (ID), ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP) + +#define ERTS_PORT_SCHED_ID(P, ID) \ + ((Uint) erts_prtsd_set((P), ERTS_PSD_SCHED_ID, (void *) (ID))) + +#ifdef ERTS_SMP +Port *erts_de2port(DistEntry *, Process *, ErtsProcLocks); +#endif + +#define erts_id2port(ID, P, PL) \ + erts_id2port_sflgs((ID), (P), (PL), ERTS_PORT_SFLGS_INVALID_LOOKUP) + +ERTS_GLB_INLINE Port*erts_id2port_sflgs(Eterm, Process *, ErtsProcLocks, Uint32); +ERTS_GLB_INLINE void erts_port_release(Port *); +ERTS_GLB_INLINE Port*erts_drvport2port(ErlDrvPort); +ERTS_GLB_INLINE Port*erts_drvportid2port(Eterm); +ERTS_GLB_INLINE Uint32 erts_portid2status(Eterm id); +ERTS_GLB_INLINE int erts_is_port_alive(Eterm id); +ERTS_GLB_INLINE int erts_is_valid_tracer_port(Eterm id); +ERTS_GLB_INLINE void erts_port_status_bandor_set(Port *, Uint32, Uint32); +ERTS_GLB_INLINE void erts_port_status_band_set(Port *, Uint32); +ERTS_GLB_INLINE void erts_port_status_bor_set(Port *, Uint32); +ERTS_GLB_INLINE void erts_port_status_set(Port *, Uint32); +ERTS_GLB_INLINE Uint32 erts_port_status_get(Port *); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE Port* +erts_id2port_sflgs(Eterm id, Process *c_p, ErtsProcLocks c_p_locks, Uint32 sflgs) +{ +#ifdef ERTS_SMP + int no_proc_locks = !c_p || !c_p_locks; +#endif + Port *prt; + + if (is_not_internal_port(id)) + return NULL; + + prt = &erts_port[internal_port_index(id)]; + + erts_smp_port_state_lock(prt); + if (ERTS_INVALID_PORT_OPT(prt, id, sflgs)) { + erts_smp_port_state_unlock(prt); + prt = NULL; + } +#ifdef ERTS_SMP + else { + erts_smp_atomic_inc(&prt->refc); + erts_smp_port_state_unlock(prt); + + if (no_proc_locks) + erts_smp_mtx_lock(prt->lock); + else if (erts_smp_mtx_trylock(prt->lock) == EBUSY) { + /* Unlock process locks, and acquire locks in lock order... */ + erts_smp_proc_unlock(c_p, c_p_locks); + erts_smp_mtx_lock(prt->lock); + erts_smp_proc_lock(c_p, c_p_locks); + } + + /* The id may not have changed... */ + ERTS_SMP_LC_ASSERT(prt->id == id); + /* ... but status may have... */ + if (prt->status & sflgs) { + erts_smp_port_unlock(prt); /* Also decrements refc... */ + prt = NULL; + } + } +#endif + + return prt; +} + +ERTS_GLB_INLINE void +erts_port_release(Port *prt) +{ +#ifdef ERTS_SMP + erts_smp_port_unlock(prt); +#else + if (prt->status & ERTS_PORT_SFLGS_DEAD) + erts_port_cleanup(prt); +#endif +} + +ERTS_GLB_INLINE Port* +erts_drvport2port(ErlDrvPort drvport) +{ + int ix = (int) drvport; + if (ix < 0 || erts_max_ports <= ix) + return NULL; + if (erts_port[ix].status & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + return NULL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(&erts_port[ix])); + return &erts_port[ix]; +} + +ERTS_GLB_INLINE Port* +erts_drvportid2port(Eterm id) +{ + int ix; + if (is_not_internal_port(id)) + return NULL; + ix = (int) internal_port_index(id); + if (erts_max_ports <= ix) + return NULL; + if (erts_port[ix].status & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + return NULL; + if (erts_port[ix].id != id) + return NULL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(&erts_port[ix])); + return &erts_port[ix]; +} + +ERTS_GLB_INLINE Uint32 +erts_portid2status(Eterm id) +{ + if (is_not_internal_port(id)) + return ERTS_PORT_SFLG_INVALID; + else { + Uint32 status; + int ix = internal_port_index(id); + if (erts_max_ports <= ix) + return ERTS_PORT_SFLG_INVALID; + erts_smp_port_state_lock(&erts_port[ix]); + if (erts_port[ix].id == id) + status = erts_port[ix].status; + else + status = ERTS_PORT_SFLG_INVALID; + erts_smp_port_state_unlock(&erts_port[ix]); + return status; + } +} + +ERTS_GLB_INLINE int +erts_is_port_alive(Eterm id) +{ + return !(erts_portid2status(id) & (ERTS_PORT_SFLG_INVALID + | ERTS_PORT_SFLGS_DEAD)); +} + +ERTS_GLB_INLINE int +erts_is_valid_tracer_port(Eterm id) +{ + return !(erts_portid2status(id) & ERTS_PORT_SFLGS_INVALID_TRACER_LOOKUP); +} + +ERTS_GLB_INLINE void erts_port_status_bandor_set(Port *prt, + Uint32 band_status, + Uint32 bor_status) +{ + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + erts_smp_port_state_lock(prt); + prt->status &= band_status; + prt->status |= bor_status; + erts_smp_port_state_unlock(prt); +} + +ERTS_GLB_INLINE void erts_port_status_band_set(Port *prt, Uint32 status) +{ + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + erts_smp_port_state_lock(prt); + prt->status &= status; + erts_smp_port_state_unlock(prt); +} + +ERTS_GLB_INLINE void erts_port_status_bor_set(Port *prt, Uint32 status) +{ + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + erts_smp_port_state_lock(prt); + prt->status |= status; + erts_smp_port_state_unlock(prt); +} + +ERTS_GLB_INLINE void erts_port_status_set(Port *prt, Uint32 status) +{ + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + erts_smp_port_state_lock(prt); + prt->status = status; + erts_smp_port_state_unlock(prt); +} + +ERTS_GLB_INLINE Uint32 erts_port_status_get(Port *prt) +{ + Uint32 res; + erts_smp_port_state_lock(prt); + res = prt->status; + erts_smp_port_state_unlock(prt); + return res; +} +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +/* erl_drv_thread.c */ +void erl_drv_thr_init(void); + +/* time.c */ + +ERTS_GLB_INLINE long do_time_read_and_reset(void); +#ifdef ERTS_TIMER_THREAD +ERTS_GLB_INLINE int next_time(void); +ERTS_GLB_INLINE void bump_timer(long); +#else +int next_time(void); +void bump_timer(long); +extern erts_smp_atomic_t do_time; /* set at clock interrupt */ +ERTS_GLB_INLINE void do_time_add(long); +#endif + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +#ifdef ERTS_TIMER_THREAD +ERTS_GLB_INLINE long do_time_read_and_reset(void) { return 0; } +ERTS_GLB_INLINE int next_time(void) { return -1; } +ERTS_GLB_INLINE void bump_timer(long ignore) { } +#else +ERTS_GLB_INLINE long do_time_read_and_reset(void) +{ + return erts_smp_atomic_xchg(&do_time, 0L); +} +ERTS_GLB_INLINE void do_time_add(long elapsed) +{ + erts_smp_atomic_add(&do_time, elapsed); +} +#endif + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +void init_time(void); +void erl_set_timer(ErlTimer*, ErlTimeoutProc, ErlCancelProc, void*, Uint); +void erl_cancel_timer(ErlTimer*); +Uint time_left(ErlTimer *); + +Uint erts_timer_wheel_memory_size(void); + +#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME)) +# ifndef HAVE_ERTS_NOW_CPU +# define HAVE_ERTS_NOW_CPU +# ifdef HAVE_GETHRVTIME +# define erts_start_now_cpu() sys_start_hrvtime() +# define erts_stop_now_cpu() sys_stop_hrvtime() +# endif +# endif +void erts_get_now_cpu(Uint* megasec, Uint* sec, Uint* microsec); +#endif + +void erts_get_timeval(SysTimeval *tv); +long erts_get_time(void); + +extern SysTimeval erts_first_emu_time; + +void erts_get_emu_time(SysTimeval *); + +ERTS_GLB_INLINE int erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE int +erts_cmp_timeval(SysTimeval *t1p, SysTimeval *t2p) +{ + if (t1p->tv_sec == t2p->tv_sec) { + if (t1p->tv_usec < t2p->tv_usec) + return -1; + else if (t1p->tv_usec > t2p->tv_usec) + return 1; + return 0; + } + return t1p->tv_sec < t2p->tv_sec ? -1 : 1; +} + +#endif + +#ifdef DEBUG +void p_slpq(_VOID_); +#endif + +/* utils.c */ + +void erts_cleanup_offheap(ErlOffHeap *offheap); +void erts_cleanup_externals(ExternalThing *); + +Uint erts_fit_in_bits(Uint); +int list_length(Eterm); +Export* erts_find_function(Eterm, Eterm, unsigned int); +int erts_is_builtin(Eterm, Eterm, int); +Uint32 make_broken_hash(Eterm); +Uint32 block_hash(byte *, unsigned, Uint32); +Uint32 make_hash2(Eterm); +Uint32 make_hash(Eterm); + + +Eterm erts_bld_atom(Uint **hpp, Uint *szp, char *str); +Eterm erts_bld_uint(Uint **hpp, Uint *szp, Uint ui); +Eterm erts_bld_uint64(Uint **hpp, Uint *szp, Uint64 ui64); +Eterm erts_bld_sint64(Uint **hpp, Uint *szp, Sint64 si64); +Eterm erts_bld_cons(Uint **hpp, Uint *szp, Eterm car, Eterm cdr); +Eterm erts_bld_tuple(Uint **hpp, Uint *szp, Uint arity, ...); +Eterm erts_bld_tuplev(Uint **hpp, Uint *szp, Uint arity, Eterm terms[]); +Eterm erts_bld_string_n(Uint **hpp, Uint *szp, const char *str, Sint len); +#define erts_bld_string(hpp,szp,str) erts_bld_string_n(hpp,szp,str,strlen(str)) +Eterm erts_bld_list(Uint **hpp, Uint *szp, Sint length, Eterm terms[]); +Eterm erts_bld_2tup_list(Uint **hpp, Uint *szp, + Sint length, Eterm terms1[], Uint terms2[]); +Eterm +erts_bld_atom_uint_2tup_list(Uint **hpp, Uint *szp, + Sint length, Eterm atoms[], Uint uints[]); +Eterm +erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length, + Eterm atoms[], Uint uints1[], Uint uints2[]); + +Eterm store_external_or_ref_in_proc_(Process *, Eterm); +Eterm store_external_or_ref_(Uint **, ExternalThing **, Eterm); + +#define NC_HEAP_SIZE(NC) \ + (ASSERT_EXPR(is_node_container((NC))), \ + IS_CONST((NC)) ? 0 : (thing_arityval(*boxed_val((NC))) + 1)) +#define STORE_NC(Hpp, ETpp, NC) \ + (ASSERT_EXPR(is_node_container((NC))), \ + IS_CONST((NC)) ? (NC) : store_external_or_ref_((Hpp), (ETpp), (NC))) +#define STORE_NC_IN_PROC(Pp, NC) \ + (ASSERT_EXPR(is_node_container((NC))), \ + IS_CONST((NC)) ? (NC) : store_external_or_ref_in_proc_((Pp), (NC))) + +void erts_init_utils(void); +void erts_init_utils_mem(void); + +erts_dsprintf_buf_t *erts_create_tmp_dsbuf(Uint); +void erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *); + +int eq(Eterm, Eterm); +#define EQ(x,y) (((x) == (y)) || (is_not_both_immed((x),(y)) && eq((x),(y)))) + +Sint cmp(Eterm, Eterm); +#define cmp_lt(a,b) (cmp((a),(b)) < 0) +#define cmp_le(a,b) (cmp((a),(b)) <= 0) +#define cmp_eq(a,b) (cmp((a),(b)) == 0) +#define cmp_ne(a,b) (cmp((a),(b)) != 0) +#define cmp_ge(a,b) (cmp((a),(b)) >= 0) +#define cmp_gt(a,b) (cmp((a),(b)) > 0) + +#define CMP_LT(a,b) ((a) != (b) && cmp_lt((a),(b))) +#define CMP_GE(a,b) ((a) == (b) || cmp_ge((a),(b))) +#define CMP_EQ(a,b) ((a) == (b) || cmp_eq((a),(b))) +#define CMP_NE(a,b) ((a) != (b) && cmp_ne((a),(b))) + +int term_to_Uint(Eterm term, Uint *up); + +#ifdef HAVE_ERTS_NOW_CPU +extern int erts_cpu_timestamp; +#endif +/* erl_bif_chksum.c */ +void erts_init_bif_chksum(void); +/* erl_bif_re.c */ +void erts_init_bif_re(void); +Sint erts_re_set_loop_limit(Sint limit); +/* erl_unicode.c */ +void erts_init_unicode(void); +Sint erts_unicode_set_loop_limit(Sint limit); +/* erl_trace.c */ +void erts_init_trace(void); +void erts_trace_check_exiting(Eterm exiting); +Eterm erts_set_system_seq_tracer(Process *c_p, + ErtsProcLocks c_p_locks, + Eterm new); +Eterm erts_get_system_seq_tracer(void); +void erts_change_default_tracing(int setflags, Uint *flagsp, Eterm *tracerp); +void erts_get_default_tracing(Uint *flagsp, Eterm *tracerp); +void erts_set_system_monitor(Eterm monitor); +Eterm erts_get_system_monitor(void); + +#ifdef ERTS_SMP +void erts_check_my_tracer_proc(Process *); +void erts_block_sys_msg_dispatcher(void); +void erts_release_sys_msg_dispatcher(void); +void erts_foreach_sys_msg_in_q(void (*func)(Eterm, + Eterm, + Eterm, + ErlHeapFragment *)); +void erts_queue_error_logger_message(Eterm, Eterm, ErlHeapFragment *); +#endif + +void erts_send_sys_msg_proc(Eterm, Eterm, Eterm, ErlHeapFragment *); +void trace_send(Process*, Eterm, Eterm); +void trace_receive(Process*, Eterm); +Uint32 erts_call_trace(Process *p, Eterm mfa[], Binary *match_spec, Eterm* args, + int local, Eterm *tracer_pid); +void erts_trace_return(Process* p, Eterm* fi, Eterm retval, Eterm *tracer_pid); +void erts_trace_exception(Process* p, Eterm mfa[], Eterm class, Eterm value, + Eterm *tracer); +void erts_trace_return_to(Process *p, Uint *pc); +void trace_sched(Process*, Eterm); +void trace_proc(Process*, Process*, Eterm, Eterm); +void trace_proc_spawn(Process*, Eterm pid, Eterm mod, Eterm func, Eterm args); +void save_calls(Process *p, Export *); +void trace_gc(Process *p, Eterm what); +/* port tracing */ +void trace_virtual_sched(Process*, Eterm); +void trace_sched_ports(Port *pp, Eterm); +void trace_sched_ports_where(Port *pp, Eterm, Eterm); +void trace_port(Port *, Eterm what, Eterm data); +void trace_port_open(Port *, Eterm calling_pid, Eterm drv_name); + +/* system_profile */ +void erts_set_system_profile(Eterm profile); +Eterm erts_get_system_profile(void); +void profile_scheduler(Eterm scheduler_id, Eterm); +void profile_scheduler_q(Eterm scheduler_id, Eterm state, Eterm no_schedulers, Uint Ms, Uint s, Uint us); +void profile_runnable_proc(Process* p, Eterm status); +void profile_runnable_port(Port* p, Eterm status); +void erts_system_profile_setup_active_schedulers(void); + +/* system_monitor */ +void monitor_long_gc(Process *p, Uint time); +void monitor_large_heap(Process *p); +void monitor_generic(Process *p, Eterm type, Eterm spec); +Uint erts_trace_flag2bit(Eterm flag); +int erts_trace_flags(Eterm List, + Uint *pMask, Eterm *pTracer, int *pCpuTimestamp); +Eterm erts_bif_trace(int bif_index, Process* p, + Eterm arg1, Eterm arg2, Eterm arg3, Uint *I); + +#ifdef ERTS_SMP +void erts_send_pending_trace_msgs(ErtsSchedulerData *esdp); +#define ERTS_SMP_CHK_PEND_TRACE_MSGS(ESDP) \ +do { \ + if ((ESDP)->pending_trace_msgs) \ + erts_send_pending_trace_msgs((ESDP)); \ +} while (0) +#else +#define ERTS_SMP_CHK_PEND_TRACE_MSGS(ESDP) +#endif + +void bin_write(int, void*, byte*, int); +int intlist_to_buf(Eterm, char*, int); /* most callers pass plain char*'s */ + +struct Sint_buf { +#ifdef ARCH_64 + char s[22]; +#else + char s[12]; +#endif +}; +char* Sint_to_buf(Sint, struct Sint_buf*); + +Eterm buf_to_intlist(Eterm**, char*, int, Eterm); /* most callers pass plain char*'s */ +int io_list_to_buf(Eterm, char*, int); +int io_list_to_buf2(Eterm, char*, int); +int io_list_len(Eterm); +int is_string(Eterm); +void erl_at_exit(FUNCTION(void,(*),(void*)), void*); +Eterm collect_memory(Process *); +void dump_memory_to_fd(int); +int dump_memory_data(const char *); + +Eterm erts_mixed_plus(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_mixed_minus(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_mixed_times(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_mixed_div(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_int_div(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_int_rem(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_band(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_bor(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_bxor(Process* p, Eterm arg1, Eterm arg2); +Eterm erts_bnot(Process* p, Eterm arg); + +Eterm erts_gc_mixed_plus(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_mixed_minus(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_mixed_times(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_mixed_div(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_int_div(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_int_rem(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_band(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_bor(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_bxor(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live); + +Eterm erts_gc_length_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_size_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_bit_size_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live); +Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live); + +Uint erts_current_reductions(Process* current, Process *p); + +int erts_print_system_version(int to, void *arg, Process *c_p); + +/* + * Interface to erl_init + */ +void erl_init(void); +void erts_first_process(Eterm modname, void* code, unsigned size, int argc, char** argv); + +#define seq_trace_output(token, msg, type, receiver, process) \ +seq_trace_output_generic((token), (msg), (type), (receiver), (process), NIL) +#define seq_trace_output_exit(token, msg, type, receiver, exitfrom) \ +seq_trace_output_generic((token), (msg), (type), (receiver), NULL, (exitfrom)) +void seq_trace_output_generic(Eterm token, Eterm msg, Uint type, + Eterm receiver, Process *process, Eterm exitfrom); + +int seq_trace_update_send(Process *process); + +Eterm erts_seq_trace(Process *process, + Eterm atom_type, Eterm atom_true_or_false, + int build_result); + +struct trace_pattern_flags { + unsigned int breakpoint : 1; /* Set if any other is set */ + unsigned int local : 1; /* Local call trace breakpoint */ + unsigned int meta : 1; /* Metadata trace breakpoint */ + unsigned int call_count : 1; /* Fast call count breakpoint */ +}; +extern const struct trace_pattern_flags erts_trace_pattern_flags_off; +int erts_set_trace_pattern(Eterm* mfa, int specified, + Binary* match_prog_set, Binary *meta_match_prog_set, + int on, struct trace_pattern_flags, + Eterm meta_tracer_pid); +void +erts_get_default_trace_pattern(int *trace_pattern_is_on, + Binary **match_spec, + Binary **meta_match_spec, + struct trace_pattern_flags *trace_pattern_flags, + Eterm *meta_tracer_pid); +void erts_bif_trace_init(void); + +/* +** Call_trace uses this API for the parameter matching functions +*/ + struct erl_heap_fragment* saved_program_buf; + +#define MatchSetRef(MPSP) \ +do { \ + if ((MPSP) != NULL) { \ + erts_refc_inc(&(MPSP)->refc, 1); \ + } \ +} while (0) + +#define MatchSetUnref(MPSP) \ +do { \ + if (((MPSP) != NULL) && erts_refc_dectest(&(MPSP)->refc, 0) <= 0) { \ + erts_bin_free(MPSP); \ + } \ +} while(0) + +#define MatchSetGetSource(MPSP) erts_match_set_get_source(MPSP) + +extern Binary *erts_match_set_compile(Process *p, Eterm matchexpr); +Eterm erts_match_set_lint(Process *p, Eterm matchexpr); +extern void erts_match_set_release_result(Process* p); +extern Eterm erts_match_set_run(Process *p, Binary *mpsp, + Eterm *args, int num_args, + Uint32 *return_flags); +extern Eterm erts_match_set_get_source(Binary *mpsp); +extern void erts_match_prog_foreach_offheap(Binary *b, + void (*)(ErlOffHeap *, void *), + void *); + +#define MATCH_SET_RETURN_TRACE 0x1 /* return trace requested */ +#define MATCH_SET_RETURN_TO_TRACE 0x2 /* Misleading name, it is not actually + set by the match program, but by the + breakpoint functions */ +#define MATCH_SET_EXCEPTION_TRACE 0x4 /* exception trace requested */ +#define MATCH_SET_RX_TRACE (MATCH_SET_RETURN_TRACE|MATCH_SET_EXCEPTION_TRACE) +/* + * Flag values when tracing bif + */ +#define BIF_TRACE_AS_LOCAL 0x1 +#define BIF_TRACE_AS_GLOBAL 0x2 +#define BIF_TRACE_AS_META 0x4 + +extern erts_driver_t vanilla_driver; +extern erts_driver_t spawn_driver; +extern erts_driver_t fd_driver; + +/* Should maybe be placed in erl_message.h, but then we get an include mess. */ + +ERTS_GLB_INLINE Eterm * +erts_alloc_message_heap(Uint size, + ErlHeapFragment **bpp, + ErlOffHeap **ohpp, + Process *receiver, + ErtsProcLocks *receiver_locks); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +/* + * NOTE: erts_alloc_message_heap() releases msg q and status + * lock on receiver without ensuring that other locks are + * held. User is responsible to ensure that the receiver + * pointer cannot become invalid until after message has + * been passed. This is normal done either by increasing + * reference count on process (preferred) or by holding + * main or link lock over the whole message passing + * operation. + */ + +ERTS_GLB_INLINE Eterm * +erts_alloc_message_heap(Uint size, + ErlHeapFragment **bpp, + ErlOffHeap **ohpp, + Process *receiver, + ErtsProcLocks *receiver_locks) +{ + Eterm *hp; +#ifdef ERTS_SMP + int locked_main = 0; + ErtsProcLocks ulocks = *receiver_locks & ERTS_PROC_LOCKS_MSG_SEND; +#endif + + if (size > (Uint) INT_MAX) + erl_exit(ERTS_ABORT_EXIT, "HUGE size (%bpu)\n", size); + + if ( +#if defined(ERTS_SMP) + *receiver_locks & ERTS_PROC_LOCK_MAIN +#else + 1 +#endif + ) { +#ifdef ERTS_SMP + try_allocate_on_heap: +#endif + if (ERTS_PROC_IS_EXITING(receiver) + || HEAP_LIMIT(receiver) - HEAP_TOP(receiver) <= size) { +#ifdef ERTS_SMP + if (locked_main) + ulocks |= ERTS_PROC_LOCK_MAIN; +#endif + goto allocate_in_mbuf; + } +#ifdef ERTS_SMP + if (ulocks) { + erts_smp_proc_unlock(receiver, ulocks); + *receiver_locks &= ~ulocks; + } +#endif + hp = HEAP_TOP(receiver); + HEAP_TOP(receiver) = hp + size; + *bpp = NULL; + *ohpp = &MSO(receiver); + } +#ifdef ERTS_SMP + else if (erts_smp_proc_trylock(receiver, ERTS_PROC_LOCK_MAIN) == 0) { + locked_main = 1; + *receiver_locks |= ERTS_PROC_LOCK_MAIN; + goto try_allocate_on_heap; + } +#endif + else { + ErlHeapFragment *bp; + allocate_in_mbuf: +#ifdef ERTS_SMP + if (ulocks) { + *receiver_locks &= ~ulocks; + erts_smp_proc_unlock(receiver, ulocks); + } +#endif + bp = new_message_buffer(size); + hp = bp->mem; + *bpp = bp; + *ohpp = &bp->off_heap; + } + + return hp; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif diff --git a/erts/emulator/beam/hash.c b/erts/emulator/beam/hash.c new file mode 100644 index 0000000000..afaf32f8ce --- /dev/null +++ b/erts/emulator/beam/hash.c @@ -0,0 +1,407 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** General hash functions +** +*/ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "hash.h" + +/* +** List of sizes (all are primes) +*/ +static const int h_size_table[] = { + 2, 5, 11, 23, 47, 97, 197, 397, 797, /* double upto here */ + 1201, 1597, + 2411, 3203, + 4813, 6421, + 9643, 12853, + 19289, 25717, + 51437, + 102877, + 205759, + 411527, + 823117, + 1646237, + 3292489, + 6584983, + 13169977, + 26339969, + 52679969, + -1 +}; + +/* +** Get info about hash +** +*/ + +void hash_get_info(HashInfo *hi, Hash *h) +{ + int size = h->size; + int i; + int max_depth = 0; + int objects = 0; + + for (i = 0; i < size; i++) { + int depth = 0; + HashBucket* b = h->bucket[i]; + + while (b != (HashBucket*) 0) { + objects++; + depth++; + b = b->next; + } + if (depth > max_depth) + max_depth = depth; + } + + hi->name = h->name; + hi->size = h->size; + hi->used = h->used; + hi->objs = objects; + hi->depth = max_depth; +} + +/* +** Display info about hash +** +*/ + +void hash_info(int to, void *arg, Hash* h) +{ + HashInfo hi; + + hash_get_info(&hi, h); + + erts_print(to, arg, "=hash_table:%s\n", hi.name); + erts_print(to, arg, "size: %d\n", hi.size); + erts_print(to, arg, "used: %d\n", hi.used); + erts_print(to, arg, "objs: %d\n", hi.objs); + erts_print(to, arg, "depth: %d\n", hi.depth); +} + + +/* + * Returns size of table in bytes. Stored objects not included. + */ +int +hash_table_sz(Hash *h) +{ + int i; + for(i=0;h->name[i];i++); + i++; + return sizeof(Hash) + h->size*sizeof(HashBucket*) + i; +} + + +/* +** init a pre allocated or static hash structure +** and allocate buckets. +*/ +Hash* hash_init(ErtsAlcType_t type, Hash* h, char* name, int size, HashFunctions fun) +{ + int sz; + int ix = 0; + + h->type = type; + + while (h_size_table[ix] != -1 && h_size_table[ix] < size) + ix++; + if (h_size_table[ix] == -1) + erl_exit(1, "panic: too large hash table size (%d)\n", size); + + size = h_size_table[ix]; + sz = size*sizeof(HashBucket*); + + h->bucket = (HashBucket**) erts_alloc(h->type, sz); + + sys_memzero(h->bucket, sz); + h->is_allocated = 0; + h->name = name; + h->fun = fun; + h->size = size; + h->size20percent = h->size/5; + h->size80percent = (4*h->size)/5; + h->ix = ix; + h->used = 0; + return h; +} + +/* +** Create a new hash table +*/ +Hash* hash_new(ErtsAlcType_t type, char* name, int size, HashFunctions fun) +{ + Hash* h; + + h = erts_alloc(type, sizeof(Hash)); + + h = hash_init(type, h, name, size, fun); + h->is_allocated = 1; + return h; +} + +/* +** Delete hash table and all objects +*/ +void hash_delete(Hash* h) +{ + int old_size = h->size; + int i; + + for (i = 0; i < old_size; i++) { + HashBucket* b = h->bucket[i]; + while (b != (HashBucket*) 0) { + HashBucket* b_next = b->next; + + h->fun.free((void*) b); + b = b_next; + } + } + erts_free(h->type, h->bucket); + if (h->is_allocated) + erts_free(h->type, (void*) h); +} + +/* +** Rehash all objects +*/ +static void rehash(Hash* h, int grow) +{ + int sz; + int old_size = h->size; + HashBucket** new_bucket; + int i; + + if (grow) { + if ((h_size_table[h->ix+1]) == -1) + return; + h->ix++; + } + else { + if (h->ix == 0) + return; + h->ix--; + } + h->size = h_size_table[h->ix]; + h->size20percent = h->size/5; + h->size80percent = (4*h->size)/5; + sz = h->size*sizeof(HashBucket*); + + new_bucket = (HashBucket **) erts_alloc(h->type, sz); + sys_memzero(new_bucket, sz); + + h->used = 0; + + for (i = 0; i < old_size; i++) { + HashBucket* b = h->bucket[i]; + while (b != (HashBucket*) 0) { + HashBucket* b_next = b->next; + int ix = b->hvalue % h->size; + if (new_bucket[ix] == NULL) + h->used++; + b->next = new_bucket[ix]; + new_bucket[ix] = b; + b = b_next; + } + } + erts_free(h->type, (void *) h->bucket); + h->bucket = new_bucket; +} + +/* +** Find an object in the hash table +** +*/ +void* hash_get(Hash* h, void* tmpl) +{ + HashValue hval = h->fun.hash(tmpl); + int ix = hval % h->size; + HashBucket* b = h->bucket[ix]; + + while(b != (HashBucket*) 0) { + if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) + return (void*) b; + b = b->next; + } + return (void*) 0; +} + +/* +** Find or insert an object in the hash table +*/ +void* hash_put(Hash* h, void* tmpl) +{ + HashValue hval = h->fun.hash(tmpl); + int ix = hval % h->size; + HashBucket* b = h->bucket[ix]; + + while(b != (HashBucket*) 0) { + if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) + return (void*) b; + b = b->next; + } + b = (HashBucket*) h->fun.alloc(tmpl); + + if (h->bucket[ix] == NULL) + h->used++; + + b->hvalue = hval; + b->next = h->bucket[ix]; + h->bucket[ix] = b; + + if (h->used > h->size80percent) /* rehash at 80% */ + rehash(h, 1); + return (void*) b; +} + +static void +hash_insert_entry(Hash* h, HashBucket* entry) +{ + HashValue hval = entry->hvalue; + int ix = hval % h->size; + HashBucket* b = h->bucket[ix]; + + while (b != (HashBucket*) 0) { + if ((b->hvalue == hval) && (h->fun.cmp((void*)entry, (void*)b) == 0)) { + abort(); /* Should not happen */ + } + b = b->next; + } + + if (h->bucket[ix] == NULL) + h->used++; + + entry->next = h->bucket[ix]; + h->bucket[ix] = entry; + + if (h->used > h->size80percent) /* rehash at 80% */ + rehash(h, 1); +} + + +/* + * Move all entries in src into dst; empty src. + * Entries in src must not exist in dst. + */ +void +erts_hash_merge(Hash* src, Hash* dst) +{ + int limit = src->size; + HashBucket** bucket = src->bucket; + int i; + + src->used = 0; + for (i = 0; i < limit; i++) { + HashBucket* b = bucket[i]; + HashBucket* next; + + bucket[i] = NULL; + while (b) { + next = b->next; + hash_insert_entry(dst, b); + b = next; + } + } +} + +/* +** Erase hash entry return template if erased +** return 0 if not erased +*/ +void* hash_erase(Hash* h, void* tmpl) +{ + HashValue hval = h->fun.hash(tmpl); + int ix = hval % h->size; + HashBucket* b = h->bucket[ix]; + HashBucket* prev = 0; + + while(b != 0) { + if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) { + if (prev != 0) + prev->next = b->next; + else + h->bucket[ix] = b->next; + h->fun.free((void*)b); + if (h->bucket[ix] == NULL) + h->used--; + if (h->used < h->size20percent) /* rehash at 20% */ + rehash(h, 0); + return tmpl; + } + prev = b; + b = b->next; + } + return (void*)0; +} + +/* +** Remove hash entry from table return entry if removed +** return NULL if not removed +** NOTE: hash_remove() differs from hash_erase() in that +** it returns entry (not the template) and does +** *not* call the free() callback. +*/ +void * +hash_remove(Hash *h, void *tmpl) +{ + HashValue hval = h->fun.hash(tmpl); + int ix = hval % h->size; + HashBucket *b = h->bucket[ix]; + HashBucket *prev = NULL; + + while (b) { + if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) { + if (prev) + prev->next = b->next; + else + h->bucket[ix] = b->next; + if (h->bucket[ix] == NULL) + h->used--; + if (h->used < h->size20percent) /* rehash at 20% */ + rehash(h, 0); + return (void *) b; + } + prev = b; + b = b->next; + } + return NULL; +} + +void hash_foreach(Hash* h, void (*func)(void *, void *), void *func_arg2) +{ + int i; + + for (i = 0; i < h->size; i++) { + HashBucket* b = h->bucket[i]; + while(b != (HashBucket*) 0) { + (*func)((void *) b, func_arg2); + b = b->next; + } + } +} + diff --git a/erts/emulator/beam/hash.h b/erts/emulator/beam/hash.h new file mode 100644 index 0000000000..6dd66fc9b3 --- /dev/null +++ b/erts/emulator/beam/hash.h @@ -0,0 +1,97 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** General hash functions +** +*/ +#ifndef __HASH_H__ +#define __HASH_H__ + +#ifndef __SYS_H__ +#include "sys.h" +#endif + +#include "erl_alloc.h" + +typedef unsigned long HashValue; + +typedef int (*HCMP_FUN)(void*, void*); +typedef HashValue (*H_FUN)(void*); +typedef void* (*HALLOC_FUN)(void*); +typedef void (*HFREE_FUN)(void*); + +/* +** This bucket must be placed in top of +** every object that uses hashing!!! +** (Object*) == (Object*) &bucket +*/ +typedef struct hash_bucket +{ + struct hash_bucket* next; /* Next bucket */ + HashValue hvalue; /* Store hash value for get, rehash */ +} HashBucket; + +typedef struct hash_functions +{ + H_FUN hash; + HCMP_FUN cmp; + HALLOC_FUN alloc; + HFREE_FUN free; +} HashFunctions; + +typedef struct { + char *name; + int size; + int used; + int objs; + int depth; +} HashInfo; + +typedef struct hash +{ + HashFunctions fun; /* Function block */ + int is_allocated; /* 0 iff hash structure is on stack or is static */ + ErtsAlcType_t type; + char* name; /* Table name (static string, for debugging) */ + int size; /* Number of slots */ + int size20percent; /* 20 percent of number of slots */ + int size80percent; /* 80 percent of number of slots */ + int ix; /* Size index in size table */ + int used; /* Number of slots used */ + HashBucket** bucket; /* Vector of bucket pointers (objects) */ +} Hash; + +Hash* hash_new(ErtsAlcType_t, char*, int, HashFunctions); +Hash* hash_init(ErtsAlcType_t, Hash*, char*, int, HashFunctions); + +void hash_delete(Hash*); +void hash_get_info(HashInfo*, Hash*); +void hash_info(int, void *, Hash*); +int hash_table_sz(Hash *); + +void* hash_get(Hash*, void*); +void* hash_put(Hash*, void*); +void* hash_erase(Hash*, void*); +void* hash_remove(Hash*, void*); +void hash_foreach(Hash*, void (*func)(void *, void *), void *); + +void erts_hash_merge(Hash* src, Hash* dst); + +#endif diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c new file mode 100644 index 0000000000..a4a3007f93 --- /dev/null +++ b/erts/emulator/beam/index.c @@ -0,0 +1,137 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "index.h" + +void index_info(int to, void *arg, IndexTable *t) +{ + hash_info(to, arg, &t->htable); + erts_print(to, arg, "=index_table:%s\n", t->htable.name); + erts_print(to, arg, "size: %d\n", t->size); + erts_print(to, arg, "limit: %d\n", t->limit); + erts_print(to, arg, "entries: %d\n",t->entries); +} + + +/* + * Returns size of table in bytes. Stored objects not included. + */ +int +index_table_sz(IndexTable *t) +{ + return (sizeof(IndexTable) + - sizeof(Hash) + + t->size*sizeof(IndexSlot*) + + hash_table_sz(&(t->htable))); +} + + +/* +** init a pre allocated or static hash structure +** and allocate buckets. +*/ +IndexTable* +erts_index_init(ErtsAlcType_t type, IndexTable* t, char* name, + int size, int limit, HashFunctions fun) +{ + Uint base_size = ((limit+INDEX_PAGE_SIZE-1)/INDEX_PAGE_SIZE)*sizeof(IndexSlot*); + hash_init(type, &t->htable, name, 3*size/4, fun); + + t->size = 0; + t->limit = limit; + t->entries = 0; + t->type = type; + t->seg_table = (IndexSlot***) erts_alloc(type, base_size); + return t; +} + +int +index_put(IndexTable* t, void* tmpl) +{ + int ix; + IndexSlot* p = (IndexSlot*) hash_put(&t->htable, tmpl); + + if (p->index >= 0) { + return p->index; + } + + ix = t->entries; + if (ix >= t->size) { + Uint sz; + if (ix >= t->limit) { + erl_exit(1, "no more index entries in %s (max=%d)\n", + t->htable.name, t->limit); + } + sz = INDEX_PAGE_SIZE*sizeof(IndexSlot*); + t->seg_table[ix>>INDEX_PAGE_SHIFT] = erts_alloc(t->type, sz); + t->size += INDEX_PAGE_SIZE; + } + t->entries++; + p->index = ix; + t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK] = p; + return ix; +} + +int index_get(IndexTable* t, void* tmpl) +{ + IndexSlot* p = (IndexSlot*) hash_get(&t->htable, tmpl); + + if (p != NULL) { + return p->index; + } + return -1; +} + +void erts_index_merge(Hash* src, IndexTable* dst) +{ + int limit = src->size; + HashBucket** bucket = src->bucket; + int i; + + for (i = 0; i < limit; i++) { + HashBucket* b = bucket[i]; + IndexSlot* p; + int ix; + + while (b) { + Uint sz; + ix = dst->entries++; + if (ix >= dst->size) { + if (ix >= dst->limit) { + erl_exit(1, "no more index entries in %s (max=%d)\n", + dst->htable.name, dst->limit); + } + sz = INDEX_PAGE_SIZE*sizeof(IndexSlot*); + dst->seg_table[ix>>INDEX_PAGE_SHIFT] = erts_alloc(dst->type, sz); + dst->size += INDEX_PAGE_SIZE; + } + p = (IndexSlot*) b; + p->index = ix; + dst->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK] = p; + b = b->next; + } + } +} diff --git a/erts/emulator/beam/index.h b/erts/emulator/beam/index.h new file mode 100644 index 0000000000..4eb9b1f992 --- /dev/null +++ b/erts/emulator/beam/index.h @@ -0,0 +1,71 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** General hash and index functions +** The idea behind this file was to capture the +** way Atom,Export and Module table was implemented +*/ +#ifndef __INDEX_H__ +#define __INDEX_H__ + +#ifndef __HASH_H__ +#include "hash.h" +#endif + +typedef struct index_slot +{ + HashBucket bucket; + int index; +} IndexSlot; + + +typedef struct index_table +{ + Hash htable; /* Mapping obj -> index */ + ErtsAlcType_t type; + int size; /* Allocated size */ + int limit; /* Max size */ + int entries; /* Number of entries */ + IndexSlot*** seg_table; /* Mapping index -> obj */ +} IndexTable; + +#define INDEX_PAGE_SHIFT 10 +#define INDEX_PAGE_SIZE (1 << INDEX_PAGE_SHIFT) +#define INDEX_PAGE_MASK ((1 << INDEX_PAGE_SHIFT)-1) + +IndexTable *erts_index_init(ErtsAlcType_t,IndexTable*,char*,int,int,HashFunctions); +void index_info(int, void *, IndexTable*); +int index_table_sz(IndexTable *); + +int index_get(IndexTable*, void*); +int index_put(IndexTable*, void*); +void erts_index_merge(Hash*, IndexTable*); + +ERTS_GLB_INLINE IndexSlot* erts_index_lookup(IndexTable*, Uint); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE IndexSlot* +erts_index_lookup(IndexTable* t, Uint ix) +{ + return t->seg_table[ix>>INDEX_PAGE_SHIFT][ix&INDEX_PAGE_MASK]; +} +#endif + +#endif diff --git a/erts/emulator/beam/io.c b/erts/emulator/beam/io.c new file mode 100644 index 0000000000..61985271e6 --- /dev/null +++ b/erts/emulator/beam/io.c @@ -0,0 +1,4732 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * I/O routines for manipulating ports. + */ + +#define ERL_IO_C__ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" + +/* must be included BEFORE global.h (since it includes erl_driver.h) */ +#include "erl_sys_driver.h" + +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "dist.h" +#include "big.h" +#include "erl_binary.h" +#include "erl_bits.h" +#include "erl_version.h" +#include "error.h" + +extern ErlDrvEntry fd_driver_entry; +extern ErlDrvEntry vanilla_driver_entry; +extern ErlDrvEntry spawn_driver_entry; +extern ErlDrvEntry *driver_tab[]; /* table of static drivers, only used during initialization */ + +erts_driver_t *driver_list; /* List of all drivers, static and dynamic. */ +erts_smp_mtx_t erts_driver_list_lock; /* Mutex for driver list */ +static erts_smp_tsd_key_t driver_list_lock_status_key; /*stop recursive locks when calling + driver init */ +static erts_smp_tsd_key_t driver_list_last_error_key; /* Save last DDLL error on a + per thread basis (for BC interfaces) */ + +Port* erts_port; /* The port table */ +erts_smp_atomic_t erts_ports_alive; +erts_smp_atomic_t erts_bytes_out; /* No bytes sent out of the system */ +erts_smp_atomic_t erts_bytes_in; /* No bytes gotten into the system */ + +Uint erts_max_ports; +Uint erts_port_tab_index_mask; + +const ErlDrvTermData driver_term_nil = (ErlDrvTermData)NIL; + +erts_driver_t vanilla_driver; +erts_driver_t spawn_driver; +erts_driver_t fd_driver; + +static int init_driver(erts_driver_t *, ErlDrvEntry *, DE_Handle *); +static void terminate_port(Port *p); +static void pdl_init(void); + +static ERTS_INLINE ErlIOQueue* +drvport2ioq(ErlDrvPort drvport) +{ + int ix = (int) drvport; + if (ix < 0 || erts_max_ports <= ix) + return NULL; + if (erts_port[ix].status & ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP) + return NULL; + ERTS_LC_ASSERT(!erts_port[ix].port_data_lock + || erts_lc_mtx_is_locked(&erts_port[ix].port_data_lock->mtx)); + ERTS_SMP_LC_ASSERT(erts_port[ix].port_data_lock + || erts_lc_is_port_locked(&erts_port[ix])); + return &erts_port[ix].ioq; +} + +static ERTS_INLINE int +is_port_ioq_empty(Port *pp) +{ + int res; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + if (!pp->port_data_lock) + res = (pp->ioq.size == 0); + else { + ErlDrvPDL pdl = pp->port_data_lock; + erts_mtx_lock(&pdl->mtx); + res = (pp->ioq.size == 0); + erts_mtx_unlock(&pdl->mtx); + } + return res; +} + +int +erts_is_port_ioq_empty(Port *pp) +{ + return is_port_ioq_empty(pp); +} + +Uint +erts_port_ioq_size(Port *pp) +{ + int res; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + if (!pp->port_data_lock) + res = pp->ioq.size; + else { + ErlDrvPDL pdl = pp->port_data_lock; + erts_mtx_lock(&pdl->mtx); + res = pp->ioq.size; + erts_mtx_unlock(&pdl->mtx); + } + return (Uint) res; +} + +/* + * Line buffered I/O. + */ +typedef struct line_buf_context { + LineBuf **b; + char *buf; + int left; + int retlen; +} LineBufContext; + +#define LINEBUF_EMPTY 0 +#define LINEBUF_EOL 1 +#define LINEBUF_NOEOL 2 +#define LINEBUF_ERROR -1 + +#define LINEBUF_STATE(LBC) ((*(LBC).b)->data[0]) + +#define LINEBUF_DATA(LBC) (((*(LBC).b)->data) + 1) +#define LINEBUF_DATALEN(LBC) ((LBC).retlen) + +#define LINEBUF_INITIAL 100 + + +/* The 'number' field in a port now has two parts: the lowest bits + contain the index in the port table, and the higher bits are a counter + which is incremented each time we look for a free port and start from + the beginning of the table. erts_max_ports is the number of file descriptors, + rounded up to a power of 2. + To get the index from a port, use the macro 'internal_port_index'; + 'port_number' returns the whole number field. +*/ + +static erts_smp_spinlock_t get_free_port_lck; +static Uint last_port_num; +static Uint port_num_mask; +erts_smp_atomic_t erts_ports_snapshot; /* Identifies the _next_ snapshot (not the ongoing) */ + + +static ERTS_INLINE void +kill_port(Port *pp) +{ + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(pp)); + erts_port_task_free_port(pp); + ASSERT(pp->status & ERTS_PORT_SFLGS_DEAD); +} + +#ifdef ERTS_SMP + +#ifdef ERTS_ENABLE_LOCK_CHECK +int +erts_lc_is_port_locked(Port *prt) +{ + if (!prt) + return 0; + return erts_smp_lc_mtx_is_locked(prt->lock); +} +#endif + +#endif /* #ifdef ERTS_SMP */ + +static int +get_free_port(void) +{ + Uint num; + Uint tries = erts_max_ports; + Port* port; + + erts_smp_spin_lock(&get_free_port_lck); + num = last_port_num + 1; + for (;; ++num) { + port = &erts_port[num & erts_port_tab_index_mask]; + + erts_smp_port_state_lock(port); + if (port->status & ERTS_PORT_SFLG_FREE) { + last_port_num = num; + erts_smp_spin_unlock(&get_free_port_lck); + break; + } + erts_smp_port_state_unlock(port); + + if (--tries == 0) { + erts_smp_spin_unlock(&get_free_port_lck); + return -1; + } + } + port->status = ERTS_PORT_SFLG_INITIALIZING; +#ifdef ERTS_SMP + ERTS_SMP_LC_ASSERT(erts_smp_atomic_read(&port->refc) == 0); + erts_smp_atomic_set(&port->refc, 2); /* Port alive + lock */ +#endif + erts_smp_port_state_unlock(port); + return num & port_num_mask; +} + +/* + * erts_test_next_port() is only used for testing. + */ +Sint +erts_test_next_port(int set, Uint next) +{ + Uint i, num; + Sint res = -1; + + erts_smp_spin_lock(&get_free_port_lck); + if (set) { + last_port_num = (next - 1) & port_num_mask; + } + num = last_port_num + 1; + + for (i=0; i < erts_max_ports && res<0; ++i, ++num) { + + Port* port = &erts_port[num & erts_port_tab_index_mask]; + + erts_smp_port_state_lock(port); + + if (port->status & ERTS_PORT_SFLG_FREE) { + last_port_num = num - 1; + res = num & port_num_mask; + } + erts_smp_port_state_unlock(port); + } + erts_smp_spin_unlock(&get_free_port_lck); + return res; +} + +void +erts_port_cleanup(Port *prt) +{ +#ifdef ERTS_SMP + Uint32 port_specific; + erts_smp_mtx_t *mtx; +#endif + erts_driver_t *driver; + + erts_smp_port_state_lock(prt); + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + driver = prt->drv_ptr; + prt->drv_ptr = NULL; + ASSERT(driver); + +#ifdef ERTS_SMP + + ASSERT(prt->status & ERTS_PORT_SFLG_FREE_SCHEDULED); + ERTS_SMP_LC_ASSERT(erts_smp_atomic_read(&prt->refc) == 0); + + port_specific = (prt->status & ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK); + + mtx = prt->lock; + ASSERT(mtx); + + prt->lock = NULL; + + ASSERT(prt->status & ERTS_PORT_SFLG_PORT_DEBUG); + ASSERT(!(prt->status & ERTS_PORT_SFLG_FREE)); + prt->status = ERTS_PORT_SFLG_FREE; + + erts_smp_port_state_unlock(prt); + erts_smp_mtx_unlock(mtx); + + if (port_specific) { + erts_smp_mtx_destroy(mtx); + erts_free(ERTS_ALC_T_PORT_LOCK, mtx); + } +#endif + + if (driver->handle) + erts_ddll_dereference_driver(driver->handle); +} + + +/* +** Initialize v_start to point to the small fixed vector. +** Once (reallocated) we never reset the pointer to the small vector +** This is a possible optimisation. +*/ +static void initq(Port* prt) +{ + ErlIOQueue* q = &prt->ioq; + + ERTS_LC_ASSERT(!prt->port_data_lock); + + q->size = 0; + q->v_head = q->v_tail = q->v_start = q->v_small; + q->v_end = q->v_small + SMALL_IO_QUEUE; + q->b_head = q->b_tail = q->b_start = q->b_small; + q->b_end = q->b_small + SMALL_IO_QUEUE; +} + +static void stopq(Port* prt) +{ + ErlIOQueue* q; + ErlDrvBinary** binp; + + if (prt->port_data_lock) + driver_pdl_lock(prt->port_data_lock); + + q = &prt->ioq; + binp = q->b_head; + + if (q->v_start != q->v_small) + erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start); + + while(binp < q->b_tail) { + if (*binp != NULL) + driver_free_binary(*binp); + binp++; + } + if (q->b_start != q->b_small) + erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start); + q->v_start = q->v_end = q->v_head = q->v_tail = NULL; + q->b_start = q->b_end = q->b_head = q->b_tail = NULL; + q->size = 0; + + if (prt->port_data_lock) { + driver_pdl_unlock(prt->port_data_lock); + driver_pdl_dec_refc(prt->port_data_lock); + prt->port_data_lock = NULL; + } +} + + + +static void +setup_port(Port* prt, Eterm pid, erts_driver_t *driver, + ErlDrvData drv_data, char *name, Uint32 xstatus) +{ + ErtsRunQueue *runq = erts_get_runq_current(NULL); + char *new_name, *old_name; +#ifdef DEBUG + /* Make sure the debug flags survives until port is freed */ + xstatus |= ERTS_PORT_SFLG_PORT_DEBUG; +#endif + ASSERT(runq); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + + new_name = (char*) erts_alloc(ERTS_ALC_T_PORT_NAME, sys_strlen(name)+1); + sys_strcpy(new_name, name); + erts_smp_runq_lock(runq); + erts_smp_atomic_inc(&erts_ports_alive); + erts_smp_port_state_lock(prt); + prt->status = ERTS_PORT_SFLG_CONNECTED | xstatus; + prt->snapshot = (Uint32) erts_smp_atomic_read(&erts_ports_snapshot); + old_name = prt->name; + prt->name = new_name; +#ifdef ERTS_SMP + erts_smp_atomic_set(&prt->run_queue, (long) runq); +#endif + ASSERT(!prt->drv_ptr); + prt->drv_ptr = driver; + erts_smp_port_state_unlock(prt); + erts_smp_runq_unlock(runq); +#ifdef ERTS_SMP + ASSERT(!prt->xports); +#endif + if (old_name) { + erts_free(ERTS_ALC_T_PORT_NAME, (void *) old_name); + } + + prt->control_flags = 0; + prt->connected = pid; + prt->drv_data = (long) drv_data; + prt->bytes_in = 0; + prt->bytes_out = 0; + prt->dist_entry = NULL; + prt->reg = NULL; +#ifdef ERTS_SMP + prt->ptimer = NULL; +#else + sys_memset(&prt->tm, 0, sizeof(ErlTimer)); +#endif + erts_port_task_handle_init(&prt->timeout_task); + prt->suspended = NULL; + sys_strcpy(prt->name, name); + prt->nlinks = NULL; + prt->monitors = NULL; + prt->linebuf = NULL; + prt->bp = NULL; + prt->data = am_undefined; + /* Set default tracing */ + erts_get_default_tracing(&(prt->trace_flags), &(prt->tracer_proc)); + + prt->psd = NULL; + + initq(prt); +} + +void +erts_wake_process_later(Port *prt, Process *process) +{ + ErtsProcList** p; + ErtsProcList* new_p; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (prt->status & ERTS_PORT_SFLGS_DEAD) + return; + + for (p = &(prt->suspended); *p != NULL; p = &((*p)->next)) + /* Empty loop body */; + + new_p = erts_proclist_create(process); + new_p->next = NULL; + *p = new_p; +} + +/* + Opens a driver. + Returns the non-negative port number, if successful. + If there is an error, -1 or -2 or -3 is returned. -2 means that + there is valid error information in *error_number_ptr. + Returning -3 means that an error in the given options was detected + (*error_number_ptr must contain either BADARG or SYSTEM_LIMIT). + The driver start function must obey the same conventions. +*/ +int +erts_open_driver(erts_driver_t* driver, /* Pointer to driver. */ + Eterm pid, /* Current process. */ + char* name, /* Driver name. */ + SysDriverOpts* opts, /* Options. */ + int *error_number_ptr) /* errno in case -2 is returned */ +{ + int port_num; + int port_ix; + ErlDrvData drv_data = 0; + Uint32 xstatus = 0; + Port *port; + int fpe_was_unmasked; + + if (error_number_ptr) + *error_number_ptr = 0; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if ((port_num = get_free_port()) < 0) { + if (error_number_ptr) { + *error_number_ptr = SYSTEM_LIMIT; + } + return -3; + } + + port_ix = port_num & erts_port_tab_index_mask; + port = &erts_port[port_ix]; + port->id = make_internal_port(port_num); + + erts_smp_mtx_lock(&erts_driver_list_lock); + if (!driver) { + for (driver = driver_list; driver; driver = driver->next) { + if (sys_strcmp(driver->name, name) == 0) + break; + } + if (!driver) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + if (error_number_ptr) + *error_number_ptr = BADARG; + return -3; + } + } + if (driver == &spawn_driver) { + char *p; + erts_driver_t *d; + + /* + * Dig out the name of the driver or port program. + */ + + if (!(opts->spawn_type & ERTS_SPAWN_EXECUTABLE)) { + /* No spawn driver default */ + driver = NULL; + } + + + if (opts->spawn_type != ERTS_SPAWN_EXECUTABLE) { + p = name; + while(*p != '\0' && *p != ' ') + p++; + if (*p == '\0') + p = NULL; + else + *p = '\0'; + + /* + * Search for a driver having this name. Defaults to spawn_driver + * if not found. + */ + + for (d = driver_list; d; d = d->next) { + if (strcmp(d->name, name) == 0 && + erts_ddll_driver_ok(d->handle)) { + driver = d; + break; + } + } + if (p != NULL) + *p = ' '; + } + } + + if (driver == NULL || (driver != &spawn_driver && opts->exit_status)) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + if (error_number_ptr) { + *error_number_ptr = BADARG; + } + /* Need to mark the port as free again */ + erts_smp_port_state_lock(port); + port->status = ERTS_PORT_SFLG_FREE; +#ifdef ERTS_SMP + ERTS_SMP_LC_ASSERT(erts_smp_atomic_read(&port->refc) == 2); + erts_smp_atomic_set(&port->refc, 0); +#endif + erts_smp_port_state_unlock(port); + return -3; + } + + /* + * We'll set up the port before calling the start function, + * to allow message sending and setting timers in the start function. + */ + +#ifdef ERTS_SMP + ASSERT(!port->lock); + port->lock = driver->lock; + if (!port->lock) { + port->lock = erts_alloc(ERTS_ALC_T_PORT_LOCK, + sizeof(erts_smp_mtx_t)); + erts_smp_mtx_init_x(port->lock, + "port_lock", + port->id); + xstatus |= ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK; + } +#endif + + if (driver->handle != NULL) { + erts_ddll_increment_port_count(driver->handle); + erts_ddll_reference_driver(driver->handle); + } + erts_smp_mtx_unlock(&erts_driver_list_lock); + +#ifdef ERTS_SMP + erts_smp_mtx_lock(port->lock); +#endif + + setup_port(port, pid, driver, drv_data, name, xstatus); + + if (IS_TRACED_FL(port, F_TRACE_PORTS)) { + trace_port_open(port, + pid, + am_atom_put(port->name, strlen(port->name))); + } + + if (driver->start) { + if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(port, am_in, am_start); + } + port->caller = pid; + fpe_was_unmasked = erts_block_fpe(); + drv_data = (*driver->start)((ErlDrvPort)(port_ix), + name, opts); + erts_unblock_fpe(fpe_was_unmasked); + port->caller = NIL; + erts_unblock_fpe(fpe_was_unmasked); + if (IS_TRACED_FL(port, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(port, am_out, am_start); + } + if (error_number_ptr && ((long) drv_data) == (long) -2) + *error_number_ptr = errno; +#ifdef ERTS_SMP + if (port->xports) + erts_smp_xports_unlock(port); + ASSERT(!port->xports); +#endif + } + + if (((long)drv_data) == -1 || + ((long)drv_data) == -2 || + ((long)drv_data) == -3) { + int res = (int) ((long) drv_data); + + if (res == -3 && error_number_ptr) { + *error_number_ptr = BADARG; + } + + /* + * Must clean up the port. + */ +#ifdef ERTS_SMP + erts_cancel_smp_ptimer(port->ptimer); +#else + erl_cancel_timer(&(port->tm)); +#endif + stopq(port); + kill_port(port); + if (port->linebuf != NULL) { + erts_free(ERTS_ALC_T_LINEBUF, + (void *) port->linebuf); + port->linebuf = NULL; + } + if (driver->handle != NULL) { + erts_smp_mtx_lock(&erts_driver_list_lock); + erts_ddll_decrement_port_count(driver->handle); + erts_smp_mtx_unlock(&erts_driver_list_lock); + } + erts_port_release(port); + return res; + } + port->drv_data = (long) drv_data; + return port_ix; +} + +#ifdef ERTS_SMP + +struct ErtsXPortsList_ { + ErtsXPortsList *next; + Port *port; +}; + +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(xports_list, ErtsXPortsList, 50, ERTS_ALC_T_XPORTS_LIST) + +#endif + +/* + * Driver function to create new instances of a driver + * Historical reason: to be used with inet_drv for creating + * accept sockets inorder to avoid a global table. + */ +ErlDrvPort +driver_create_port(ErlDrvPort creator_port_ix, /* Creating port */ + ErlDrvTermData pid, /* Owner/Caller */ + char* name, /* Driver name */ + ErlDrvData drv_data) /* Driver data */ +{ + Port *creator_port; + Port* port; + erts_driver_t *driver; + Process *rp; + int port_num; + Eterm port_id; + Uint32 xstatus = 0; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + creator_port = erts_drvport2port(creator_port_ix); + if (!creator_port) + return (ErlDrvTermData) -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(creator_port)); + + driver = creator_port->drv_ptr; + erts_smp_mtx_lock(&erts_driver_list_lock); + if (!erts_ddll_driver_ok(driver->handle)) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + return (ErlDrvTermData) -1; + } + + rp = erts_pid2proc(NULL, 0, pid, ERTS_PROC_LOCK_LINK); + if (!rp) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + return (ErlDrvTermData) -1; /* pid does not exist */ + } + if ((port_num = get_free_port()) < 0) { + errno = ENFILE; + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + erts_smp_mtx_unlock(&erts_driver_list_lock); + return (ErlDrvTermData) -1; + } + + port_id = make_internal_port(port_num); + port = &erts_port[port_num & erts_port_tab_index_mask]; + +#ifdef ERTS_SMP + ASSERT(!port->lock); + port->lock = driver->lock; + if (!port->lock) { + ErtsXPortsList *xplp = xports_list_alloc(); + xplp->port = port; + xplp->next = creator_port->xports; + creator_port->xports = xplp; + port->lock = erts_alloc(ERTS_ALC_T_PORT_LOCK, + sizeof(erts_smp_mtx_t)); + erts_smp_mtx_init_locked_x(port->lock, "port_lock", port_id); + xstatus |= ERTS_PORT_SFLG_PORT_SPECIFIC_LOCK; + } + +#endif + + if (driver->handle != NULL) { + erts_ddll_increment_port_count(driver->handle); + erts_ddll_reference_referenced_driver(driver->handle); + } + erts_smp_mtx_unlock(&erts_driver_list_lock); + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(port)); + + setup_port(port, pid, driver, drv_data, name, xstatus); + port->id = port_id; + + erts_add_link(&(port->nlinks), LINK_PID, pid); + erts_add_link(&(rp->nlinks), LINK_PID, port_id); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + return port_num & erts_port_tab_index_mask; +} + +#ifdef ERTS_SMP +void +erts_smp_xports_unlock(Port *prt) +{ + ErtsXPortsList *xplp; + + ASSERT(prt); + xplp = prt->xports; + ASSERT(xplp); + while (xplp) { + ErtsXPortsList *free_xplp; + if (xplp->port->xports) + erts_smp_xports_unlock(xplp->port); + erts_port_release(xplp->port); + free_xplp = xplp; + xplp = xplp->next; + xports_list_free(free_xplp); + } + prt->xports = NULL; +} +#endif + +/* Fills a possibly deep list of chars and binaries into vec +** Small characters are first stored in the buffer buf of length ln +** binaries found are copied and linked into msoh +** Return vector length on succsess, +** -1 on overflow +** -2 on type error +*/ + +#define SET_VEC(iov, bv, bin, ptr, len, vlen) do { \ + (iov)->iov_base = (ptr); \ + (iov)->iov_len = (len); \ + *(bv)++ = (bin); \ + (iov)++; \ + (vlen)++; \ +} while(0) + +static int +io_list_to_vec(Eterm obj, /* io-list */ + SysIOVec* iov, /* io vector */ + ErlDrvBinary** binv, /* binary reference vector */ + ErlDrvBinary* cbin, /* binary to store characters */ + int bin_limit) /* small binaries limit */ +{ + DECLARE_ESTACK(s); + Eterm* objp; + char *buf = cbin->orig_bytes; + int len = cbin->orig_size; + int csize = 0; + int vlen = 0; + char* cptr = buf; + + goto L_jump_start; /* avoid push */ + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_jump_start: + if (is_list(obj)) { + L_iter_list: + objp = list_val(obj); + obj = CAR(objp); + if (is_byte(obj)) { + if (len == 0) + goto L_overflow; + *buf++ = unsigned_val(obj); + csize++; + len--; + } else if (is_binary(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto handle_binary; + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto L_iter_list; /* on head */ + } else if (!is_nil(obj)) { + goto L_type_error; + } + obj = CDR(objp); + if (is_list(obj)) + goto L_iter_list; /* on tail */ + else if (is_binary(obj)) { + goto handle_binary; + } else if (!is_nil(obj)) { + goto L_type_error; + } + } else if (is_binary(obj)) { + Eterm real_bin; + Uint offset; + Eterm* bptr; + int size; + int bitoffs; + int bitsize; + + handle_binary: + size = binary_size(obj); + ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize); + ASSERT(bitsize == 0); + bptr = binary_val(real_bin); + if (*bptr == HEADER_PROC_BIN) { + ProcBin* pb = (ProcBin *) bptr; + if (bitoffs != 0) { + if (len < size) { + goto L_overflow; + } + erts_copy_bits(pb->bytes+offset, bitoffs, 1, + (byte *) buf, 0, 1, size*8); + csize += size; + buf += size; + len -= size; + } else if (bin_limit && size < bin_limit) { + if (len < size) { + goto L_overflow; + } + sys_memcpy(buf, pb->bytes+offset, size); + csize += size; + buf += size; + len -= size; + } else { + if (csize != 0) { + SET_VEC(iov, binv, cbin, cptr, csize, vlen); + cptr = buf; + csize = 0; + } + if (pb->flags) { + erts_emasculate_writable_binary(pb); + } + SET_VEC(iov, binv, Binary2ErlDrvBinary(pb->val), + pb->bytes+offset, size, vlen); + } + } else { + ErlHeapBin* hb = (ErlHeapBin *) bptr; + if (len < size) { + goto L_overflow; + } + copy_binary_to_buffer(buf, 0, + ((byte *) hb->data)+offset, bitoffs, + 8*size); + csize += size; + buf += size; + len -= size; + } + } else if (!is_nil(obj)) { + goto L_type_error; + } + } + + if (csize != 0) { + SET_VEC(iov, binv, cbin, cptr, csize, vlen); + } + + DESTROY_ESTACK(s); + return vlen; + + L_type_error: + DESTROY_ESTACK(s); + return -2; + + L_overflow: + DESTROY_ESTACK(s); + return -1; +} + +#define IO_LIST_VEC_COUNT(obj) \ +do { \ + int _size = binary_size(obj); \ + Eterm _real; \ + Uint _offset; \ + int _bitoffs; \ + int _bitsize; \ + ERTS_GET_REAL_BIN(obj, _real, _offset, _bitoffs, _bitsize); \ + ASSERT(_bitsize == 0); \ + if (thing_subtag(*binary_val(_real)) == REFC_BINARY_SUBTAG && \ + _bitoffs == 0) { \ + b_size += _size; \ + in_clist = 0; \ + v_size++; \ + if (_size >= bin_limit) { \ + p_in_clist = 0; \ + p_v_size++; \ + } else { \ + p_c_size += _size; \ + if (!p_in_clist) { \ + p_in_clist = 1; \ + p_v_size++; \ + } \ + } \ + } else { \ + c_size += _size; \ + if (!in_clist) { \ + in_clist = 1; \ + v_size++; \ + } \ + p_c_size += _size; \ + if (!p_in_clist) { \ + p_in_clist = 1; \ + p_v_size++; \ + } \ + } \ +} while (0) + + +/* +** Size of a io list in bytes +** return -1 if error +** returns: - Total size of io list +** vsize - SysIOVec size needed for a writev +** csize - Number of bytes not in binary (in the common binary) +** pvsize - SysIOVec size needed if packing small binaries +** pcsize - Number of bytes in the common binary if packing +*/ + +static int +io_list_vec_len(Eterm obj, int* vsize, int* csize, + int bin_limit, /* small binaries limit */ + int * pvsize, int * pcsize) +{ + DECLARE_ESTACK(s); + Eterm* objp; + int v_size = 0; + int c_size = 0; + int b_size = 0; + int in_clist = 0; + int p_v_size = 0; + int p_c_size = 0; + int p_in_clist = 0; + + goto L_jump_start; /* avoid a push */ + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_jump_start: + if (is_list(obj)) { + L_iter_list: + objp = list_val(obj); + obj = CAR(objp); + + if (is_byte(obj)) { + c_size++; + if (!in_clist) { + in_clist = 1; + v_size++; + } + p_c_size++; + if (!p_in_clist) { + p_in_clist = 1; + p_v_size++; + } + } + else if (is_binary(obj)) { + IO_LIST_VEC_COUNT(obj); + } + else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto L_iter_list; /* on head */ + } + else if (!is_nil(obj)) { + goto L_type_error; + } + + obj = CDR(objp); + if (is_list(obj)) + goto L_iter_list; /* on tail */ + else if (is_binary(obj)) { /* binary tail is OK */ + IO_LIST_VEC_COUNT(obj); + } + else if (!is_nil(obj)) { + goto L_type_error; + } + } + else if (is_binary(obj)) { + IO_LIST_VEC_COUNT(obj); + } + else if (!is_nil(obj)) { + goto L_type_error; + } + } + + DESTROY_ESTACK(s); + if (vsize != NULL) + *vsize = v_size; + if (csize != NULL) + *csize = c_size; + if (pvsize != NULL) + *pvsize = p_v_size; + if (pcsize != NULL) + *pcsize = p_c_size; + return c_size + b_size; + + L_type_error: + DESTROY_ESTACK(s); + return -1; +} + +#define ERL_SMALL_IO_BIN_LIMIT (4*ERL_ONHEAP_BIN_LIMIT) +#define SMALL_WRITE_VEC 16 + + +/* write data to a port */ +int erts_write_to_port(Eterm caller_id, Port *p, Eterm list) +{ + char *buf; + erts_driver_t *drv = p->drv_ptr; + int size; + int fpe_was_unmasked; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); + ERTS_SMP_CHK_NO_PROC_LOCKS; + + p->caller = caller_id; + if (drv->outputv != NULL) { + int vsize; + int csize; + int pvsize; + int pcsize; + int blimit; + SysIOVec iv[SMALL_WRITE_VEC]; + ErlDrvBinary* bv[SMALL_WRITE_VEC]; + SysIOVec* ivp; + ErlDrvBinary** bvp; + ErlDrvBinary* cbin; + ErlIOVec ev; + + if ((size = io_list_vec_len(list, &vsize, &csize, + ERL_SMALL_IO_BIN_LIMIT, + &pvsize, &pcsize)) < 0) { + goto bad_value; + } + /* To pack or not to pack (small binaries) ...? */ + vsize++; + if (vsize <= SMALL_WRITE_VEC) { + /* Do NOT pack */ + blimit = 0; + } else { + /* Do pack */ + vsize = pvsize + 1; + csize = pcsize; + blimit = ERL_SMALL_IO_BIN_LIMIT; + } + /* Use vsize and csize from now on */ + if (vsize <= SMALL_WRITE_VEC) { + ivp = iv; + bvp = bv; + } else { + ivp = (SysIOVec *) erts_alloc(ERTS_ALC_T_TMP, + vsize * sizeof(SysIOVec)); + bvp = (ErlDrvBinary**) erts_alloc(ERTS_ALC_T_TMP, + vsize * sizeof(ErlDrvBinary*)); + } + cbin = driver_alloc_binary(csize); + if (!cbin) + erts_alloc_enomem(ERTS_ALC_T_DRV_BINARY, sizeof(Binary) + csize); + + /* Element 0 is for driver usage to add header block */ + ivp[0].iov_base = NULL; + ivp[0].iov_len = 0; + bvp[0] = NULL; + ev.vsize = io_list_to_vec(list, ivp+1, bvp+1, cbin, blimit); + ev.vsize++; +#if 0 + /* This assertion may say something useful, but it can + be falsified during the emulator test suites. */ + ASSERT((ev.vsize >= 0) && (ev.vsize == vsize)); +#endif + ev.size = size; /* total size */ + ev.iov = ivp; + ev.binv = bvp; + fpe_was_unmasked = erts_block_fpe(); + (*drv->outputv)((ErlDrvData)p->drv_data, &ev); + erts_unblock_fpe(fpe_was_unmasked); + if (ivp != iv) { + erts_free(ERTS_ALC_T_TMP, (void *) ivp); + } + if (bvp != bv) { + erts_free(ERTS_ALC_T_TMP, (void *) bvp); + } + driver_free_binary(cbin); + } else { + int r; + + /* Try with an 8KB buffer first (will often be enough I guess). */ + size = 8*1024; + /* See below why the extra byte is added. */ + buf = erts_alloc(ERTS_ALC_T_TMP, size+1); + r = io_list_to_buf(list, buf, size); + + if (r >= 0) { + size -= r; + fpe_was_unmasked = erts_block_fpe(); + (*drv->output)((ErlDrvData)p->drv_data, buf, size); + erts_unblock_fpe(fpe_was_unmasked); + erts_free(ERTS_ALC_T_TMP, buf); + } + else if (r == -2) { + erts_free(ERTS_ALC_T_TMP, buf); + goto bad_value; + } + else { + ASSERT(r == -1); /* Overflow */ + erts_free(ERTS_ALC_T_TMP, buf); + if ((size = io_list_len(list)) < 0) { + goto bad_value; + } + + /* + * I know drivers that pad space with '\0' this is clearly + * incorrect but I don't feel like fixing them now, insted + * add ONE extra byte. + */ + buf = erts_alloc(ERTS_ALC_T_TMP, size+1); + r = io_list_to_buf(list, buf, size); + fpe_was_unmasked = erts_block_fpe(); + (*drv->output)((ErlDrvData)p->drv_data, buf, size); + erts_unblock_fpe(fpe_was_unmasked); + erts_free(ERTS_ALC_T_TMP, buf); + } + } + p->bytes_out += size; + erts_smp_atomic_add(&erts_bytes_out, size); + +#ifdef ERTS_SMP + if (p->xports) + erts_smp_xports_unlock(p); + ASSERT(!p->xports); +#endif + p->caller = NIL; + return 0; + + bad_value: + p->caller = NIL; + { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Bad value on output port '%s'\n", p->name); + erts_send_error_to_logger_nogl(dsbufp); + return 1; + } +} + +/* initialize the port array */ +void init_io(void) +{ + int i; + ErlDrvEntry** dp; + ErlDrvEntry* drv; + char maxports[21]; /* enough for any 64-bit integer */ + size_t maxportssize = sizeof(maxports); + Uint ports_bits = ERTS_PORTS_BITS; + Sint port_extra_shift; + +#ifdef ERTS_SMP + init_xports_list_alloc(); +#endif + + pdl_init(); + + if (erts_sys_getenv("ERL_MAX_PORTS", maxports, &maxportssize) == 0) + erts_max_ports = atoi(maxports); + else + erts_max_ports = sys_max_files(); + + if (erts_max_ports > ERTS_MAX_PORTS) + erts_max_ports = ERTS_MAX_PORTS; + if (erts_max_ports < 1024) + erts_max_ports = 1024; + + if (erts_use_r9_pids_ports) { + ports_bits = ERTS_R9_PORTS_BITS; + if (erts_max_ports > ERTS_MAX_R9_PORTS) + erts_max_ports = ERTS_MAX_R9_PORTS; + } + + port_extra_shift = erts_fit_in_bits(erts_max_ports - 1); + port_num_mask = (1 << ports_bits) - 1; + + erts_port_tab_index_mask = ~(~((Uint) 0) << port_extra_shift); + erts_max_ports = 1 << port_extra_shift; + + erts_smp_mtx_init(&erts_driver_list_lock,"driver_list"); + driver_list = NULL; + erts_smp_tsd_key_create(&driver_list_lock_status_key); + erts_smp_tsd_key_create(&driver_list_last_error_key); + + if (erts_max_ports * sizeof(Port) <= erts_max_ports) { + /* More memory needed than the whole address space. */ + erts_alloc_enomem(ERTS_ALC_T_PORT_TABLE, ~((Uint) 0)); + } + + erts_port = (Port *) erts_alloc(ERTS_ALC_T_PORT_TABLE, + erts_max_ports * sizeof(Port)); + + erts_smp_atomic_init(&erts_bytes_out, 0); + erts_smp_atomic_init(&erts_bytes_in, 0); + erts_smp_atomic_init(&erts_ports_alive, 0); + + for (i = 0; i < erts_max_ports; i++) { + erts_port_task_init_sched(&erts_port[i].sched); +#ifdef ERTS_SMP + erts_smp_atomic_init(&erts_port[i].refc, 0); + erts_port[i].lock = NULL; + erts_port[i].xports = NULL; + erts_smp_spinlock_init(&erts_port[i].state_lck, "port_state"); +#endif + erts_port[i].tracer_proc = NIL; + erts_port[i].trace_flags = 0; + + erts_port[i].drv_ptr = NULL; + erts_port[i].status = ERTS_PORT_SFLG_FREE; + erts_port[i].name = NULL; + erts_port[i].nlinks = NULL; + erts_port[i].monitors = NULL; + erts_port[i].linebuf = NULL; + erts_port[i].port_data_lock = NULL; + } + + erts_smp_atomic_init(&erts_ports_snapshot, (long) 0); + last_port_num = 0; + erts_smp_spinlock_init(&get_free_port_lck, "get_free_port"); + + sys_init_io(); + + erts_smp_tsd_set(driver_list_lock_status_key, (void *) 1); + erts_smp_mtx_lock(&erts_driver_list_lock); + + init_driver(&fd_driver, &fd_driver_entry, NULL); + init_driver(&vanilla_driver, &vanilla_driver_entry, NULL); + init_driver(&spawn_driver, &spawn_driver_entry, NULL); + for (dp = driver_tab; *dp != NULL; dp++) { + drv = *dp; + erts_add_driver_entry(*dp, NULL, 1); + } + + erts_smp_tsd_set(driver_list_lock_status_key, NULL); + erts_smp_mtx_unlock(&erts_driver_list_lock); +} + +/* + * Buffering of data when using line oriented I/O on ports + */ + +/* + * Buffer states + */ +#define LINEBUF_MAIN 0 +#define LINEBUF_FULL 1 +#define LINEBUF_CR_INSIDE 2 +#define LINEBUF_CR_AFTER 3 + +/* + * Creates a LineBuf to be added to the port structure, + * Returns: Pointer to a newly allocated and initialized LineBuf. + * Parameters: + * bufsiz - The (maximum) size of the line buffer. + */ +LineBuf *allocate_linebuf(bufsiz) +int bufsiz; +{ + int ovsiz = (bufsiz < LINEBUF_INITIAL) ? bufsiz : LINEBUF_INITIAL; + LineBuf *lb = (LineBuf *) erts_alloc(ERTS_ALC_T_LINEBUF, + sizeof(LineBuf)+ovsiz); + lb->ovsiz = ovsiz; + lb->bufsiz = bufsiz; + lb->ovlen = 0; + lb->data[0] = LINEBUF_MAIN; /* state */ + return lb; +} + +/* + * Initializes a LineBufContext to be used in calls to read_linebuf + * or flush_linebuf. + * Returns: 0 if ok, <0 on error. + * Parameters: + * lc - Pointer to an allocated LineBufContext. + * lb - Pointer to a LineBuf structure (probably from the Port structure). + * buf - A buffer containing the data to be read and split to lines. + * len - The number of bytes in buf. + */ +static int init_linebuf_context(LineBufContext *lc, LineBuf **lb, char *buf, int len) +{ + if(lc == NULL || lb == NULL) + return -1; + lc->b = lb; + lc->buf = buf; + lc->left = len; + return 0; +} + +static void resize_linebuf(LineBuf **b) +{ + int newsiz = (((*b)->ovsiz * 2) > (*b)->bufsiz) ? (*b)->bufsiz : + (*b)->ovsiz * 2; + *b = (LineBuf *) erts_realloc(ERTS_ALC_T_LINEBUF, + (void *) *b, + sizeof(LineBuf)+newsiz); + (*b)->ovsiz = newsiz; +} + +/* + * Delivers all data in the buffer regardless of newlines (always + * an LINEBUF_NOEOL. Has to be called until it return LINEBUF_EMPTY. + * Return values and barameters as read_linebuf (see below). + */ +static int flush_linebuf(LineBufContext *bp) +{ + bp->retlen = (*bp->b)->ovlen; + switch(LINEBUF_STATE(*bp)){ + case LINEBUF_CR_INSIDE: + if((*bp->b)->ovlen >= (*bp->b)->ovsiz) + resize_linebuf(bp->b); + LINEBUF_DATA(*bp)[((*bp->b)->ovlen)++] = '\r'; + ++bp->retlen; /* fall through instead of switching state... */ + case LINEBUF_MAIN: + case LINEBUF_FULL: + (*bp->b)->ovlen = 0; + LINEBUF_STATE(*bp) = LINEBUF_MAIN; + if(!bp->retlen) + return LINEBUF_EMPTY; + return LINEBUF_NOEOL; + case LINEBUF_CR_AFTER: + LINEBUF_STATE(*bp) = LINEBUF_CR_INSIDE; + (*bp->b)->ovlen = 0; + if(!bp->retlen) + return LINEBUF_EMPTY; + return LINEBUF_NOEOL; + default: + return LINEBUF_ERROR; + } +} + +/* + * Reads input from a buffer and "chops" it up in lines. + * Has to be called repeatedly until it returns LINEBUF_EMPTY + * to get all lines in buffer. + * Handles both and style newlines. + * On Unix, this is slightly incorrect, as is NOT to be regarded + * as a newline together, but i treat newlines equally in all systems + * to avoid putting this in sys.c or clutter it with #ifdef's. + * Returns: LINEBUF_EMPTY if there is no more data that can be + * determined as a line (only part of a line left), LINEBUF_EOL if a whole + * line could be delivered and LINEBUF_NOEOL if the buffer size has been + * exceeded. The data and the data length can be accesed through the + * LINEBUF_DATA and the LINEBUF_DATALEN macros applied to the LineBufContext. + * Parameters: + * bp - A LineBufContext that is initialized with + * the init_linebuf_context call. The context has to be retained during + * all calls that returns other than LINEBUF_EMPTY. When LINEBUF_EMPTY + * is returned the context can be discarded and a new can be created when new + * data arrives (the state is saved in the Port structure). + */ +static int read_linebuf(LineBufContext *bp) +{ + for(;;){ + if(bp->left == 0) + return LINEBUF_EMPTY; + if(*bp->buf == '\n'){ + LINEBUF_STATE(*bp) = LINEBUF_MAIN; + ++(bp->buf); + --(bp->left); + bp->retlen = (*bp->b)->ovlen; + (*bp->b)->ovlen = 0; + return LINEBUF_EOL; + } + switch(LINEBUF_STATE(*bp)){ + case LINEBUF_MAIN: + if((*bp->b)->ovlen == (*bp->b)->bufsiz) + LINEBUF_STATE(*bp) = LINEBUF_FULL; + else if(*bp->buf == '\r'){ + ++(bp->buf); + --(bp->left); + LINEBUF_STATE(*bp) = LINEBUF_CR_INSIDE; + } else { + if((*bp->b)->ovlen >= (*bp->b)->ovsiz) + resize_linebuf(bp->b); + LINEBUF_DATA(*bp)[((*bp->b)->ovlen)++] = *((bp->buf)++); + --(bp->left); + } + continue; + case LINEBUF_FULL: + if(*bp->buf == '\r'){ + ++(bp->buf); + --(bp->left); + LINEBUF_STATE(*bp) = LINEBUF_CR_AFTER; + } else { + bp->retlen = (*bp->b)->ovlen; + (*bp->b)->ovlen = 0; + LINEBUF_STATE(*bp) = LINEBUF_MAIN; + return LINEBUF_NOEOL; + } + continue; + case LINEBUF_CR_INSIDE: + if((*bp->b)->ovlen >= (*bp->b)->ovsiz) + resize_linebuf(bp->b); + LINEBUF_DATA(*bp)[((*bp->b)->ovlen)++] = '\r'; + LINEBUF_STATE(*bp) = LINEBUF_MAIN; + continue; + case LINEBUF_CR_AFTER: + bp->retlen = (*bp->b)->ovlen; + (*bp->b)->ovlen = 0; + LINEBUF_STATE(*bp) = LINEBUF_CR_INSIDE; + return LINEBUF_NOEOL; + default: + return LINEBUF_ERROR; + } + } +} + +static void +deliver_result(Eterm sender, Eterm pid, Eterm res) +{ + Process *rp; + ErtsProcLocks rp_locks = 0; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + ASSERT(is_internal_port(sender) + && is_internal_pid(pid) + && internal_pid_index(pid) < erts_max_processes); + + rp = erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_SMP_INC_REFC); + + if (rp) { + Eterm tuple; + ErlHeapFragment *bp; + ErlOffHeap *ohp; + Eterm* hp; + Uint sz_res; + sz_res = size_object(res); + hp = erts_alloc_message_heap(sz_res + 3, &bp, &ohp, rp, &rp_locks); + res = copy_struct(res, sz_res, &hp, ohp); + tuple = TUPLE2(hp, sender, res); + erts_queue_message(rp, &rp_locks, bp, tuple, NIL); + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); + } +} + + +/* + * Deliver a "read" message. + * hbuf -- byte that are always formated as a list + * hlen -- number of byte in header + * buf -- data + * len -- length of data + */ + +static void deliver_read_message(Port* prt, Eterm to, + char *hbuf, int hlen, + char *buf, int len, int eol) +{ + int need; + Eterm listp; + Eterm tuple; + Process* rp; + Eterm* hp; + ErlHeapFragment *bp; + ErlOffHeap *ohp; + ErtsProcLocks rp_locks = 0; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + ERTS_SMP_CHK_NO_PROC_LOCKS; + + need = 3 + 3 + 2*hlen; + if (prt->status & ERTS_PORT_SFLG_LINEBUF_IO) { + need += 3; + } + if (prt->status & ERTS_PORT_SFLG_BINARY_IO && buf != NULL) { + need += PROC_BIN_SIZE; + } else { + need += 2*len; + } + + rp = erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC); + if (!rp) + return; + + hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); + + listp = NIL; + if ((prt->status & ERTS_PORT_SFLG_BINARY_IO) == 0) { + listp = buf_to_intlist(&hp, buf, len, listp); + } else if (buf != NULL) { + ProcBin* pb; + Binary* bptr; + + bptr = erts_bin_nrml_alloc(len); + bptr->flags = 0; + bptr->orig_size = len; + erts_refc_init(&bptr->refc, 1); + sys_memcpy(bptr->orig_bytes, buf, len); + + pb = (ProcBin *) hp; + pb->thing_word = HEADER_PROC_BIN; + pb->size = len; + pb->next = ohp->mso; + ohp->mso = pb; + pb->val = bptr; + pb->bytes = (byte*) bptr->orig_bytes; + pb->flags = 0; + hp += PROC_BIN_SIZE; + + ohp->overhead += pb->size / sizeof(Eterm); + listp = make_binary(pb); + } + + /* Prepend the header */ + if (hlen > 0) { + listp = buf_to_intlist(&hp, hbuf, hlen, listp); + } + + if (prt->status & ERTS_PORT_SFLG_LINEBUF_IO){ + listp = TUPLE2(hp, (eol) ? am_eol : am_noeol, listp); + hp += 3; + } + tuple = TUPLE2(hp, am_data, listp); + hp += 3; + + tuple = TUPLE2(hp, prt->id, tuple); + hp += 3; + + erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); +} + +/* + * Deliver all lines in a line buffer, repeats calls to + * deliver_read_message, and takes the same parameters. + */ +static void deliver_linebuf_message(Port* prt, Eterm to, + char* hbuf, int hlen, + char *buf, int len) +{ + LineBufContext lc; + int ret; + if(init_linebuf_context(&lc,&(prt->linebuf), buf, len) < 0) + return; + while((ret = read_linebuf(&lc)) > LINEBUF_EMPTY) + deliver_read_message(prt, to, hbuf, hlen, LINEBUF_DATA(lc), + LINEBUF_DATALEN(lc), (ret == LINEBUF_EOL)); +} + +/* + * Deliver any nonterminated lines in the line buffer before the + * port gets closed. + * Has to be called before terminate_port. + * Parameters: + * prt - Pointer to a Port structure for this port. + */ +static void flush_linebuf_messages(Port *prt) +{ + LineBufContext lc; + int ret; + + ERTS_SMP_LC_ASSERT(!prt || erts_lc_is_port_locked(prt)); + if(prt == NULL || !(prt->status & ERTS_PORT_SFLG_LINEBUF_IO)) + return; + + if(init_linebuf_context(&lc,&(prt->linebuf), NULL, 0) < 0) + return; + while((ret = flush_linebuf(&lc)) > LINEBUF_EMPTY) + deliver_read_message(prt, + prt->connected, + NULL, + 0, + LINEBUF_DATA(lc), + LINEBUF_DATALEN(lc), + (ret == LINEBUF_EOL)); +} + +static void +deliver_vec_message(Port* prt, /* Port */ + Eterm to, /* Receiving pid */ + char* hbuf, /* "Header" buffer... */ + int hlen, /* ... and its length */ + ErlDrvBinary** binv, /* Vector of binaries */ + SysIOVec* iov, /* I/O vector */ + int vsize, /* Size of binv & iov */ + int csize) /* Size of characters in + iov (not hlen) */ +{ + int need; + Eterm listp; + Eterm tuple; + Process* rp; + Eterm* hp; + ErlHeapFragment *bp; + ErlOffHeap *ohp; + ErtsProcLocks rp_locks = 0; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + ERTS_SMP_CHK_NO_PROC_LOCKS; + + /* + * Check arguments for validity. + */ + + rp = erts_pid2proc_opt(NULL, 0, to, 0, ERTS_P2P_FLG_SMP_INC_REFC); + if (!rp) + return; + + /* + * Calculate the exact number of heap words needed. + */ + + need = 3 + 3; /* Heap space for two tuples */ + if (prt->status & ERTS_PORT_SFLG_BINARY_IO) { + need += (2+PROC_BIN_SIZE)*vsize - 2 + hlen*2; + } else { + need += (hlen+csize)*2; + } + + hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); + + listp = NIL; + iov += vsize; + + if ((prt->status & ERTS_PORT_SFLG_BINARY_IO) == 0) { + Eterm* thp = hp; + while (vsize--) { + iov--; + listp = buf_to_intlist(&thp, iov->iov_base, iov->iov_len, listp); + } + hp = thp; + } else { + binv += vsize; + while (vsize--) { + ErlDrvBinary* b; + ProcBin* pb = (ProcBin*) hp; + byte* base; + + iov--; + binv--; + if ((b = *binv) == NULL) { + b = driver_alloc_binary(iov->iov_len); + sys_memcpy(b->orig_bytes, iov->iov_base, iov->iov_len); + base = (byte*) b->orig_bytes; + } else { + /* Must increment reference count, caller calls free */ + driver_binary_inc_refc(b); + base = iov->iov_base; + } + pb->thing_word = HEADER_PROC_BIN; + pb->size = iov->iov_len; + pb->next = ohp->mso; + ohp->mso = pb; + pb->val = ErlDrvBinary2Binary(b); + pb->bytes = base; + pb->flags = 0; + hp += PROC_BIN_SIZE; + + ohp->overhead += iov->iov_len / sizeof(Eterm); + + if (listp == NIL) { /* compatible with deliver_bin_message */ + listp = make_binary(pb); + } else { + listp = CONS(hp, make_binary(pb), listp); + hp += 2; + } + } + } + + if (hlen > 0) { /* Prepend the header */ + Eterm* thp = hp; + listp = buf_to_intlist(&thp, hbuf, hlen, listp); + hp = thp; + } + + tuple = TUPLE2(hp, am_data, listp); + hp += 3; + tuple = TUPLE2(hp, prt->id, tuple); + hp += 3; + + erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); +} + + +static void deliver_bin_message(Port* prt, /* port */ + Eterm to, /* receiving pid */ + char* hbuf, /* "header" buffer */ + int hlen, /* and it's length */ + ErlDrvBinary* bin, /* binary data */ + int offs, /* offset into binary */ + int len) /* length of binary */ +{ + SysIOVec vec; + + vec.iov_base = bin->orig_bytes+offs; + vec.iov_len = len; + deliver_vec_message(prt, to, hbuf, hlen, &bin, &vec, 1, len); +} + +/* flush the port I/O queue and terminate if empty */ +/* + * Note. + * + * The test for (p->status & ERTS_PORT_SFLGS_DEAD) == 0 is important since the + * driver's flush function might call driver_async, which when using no + * threads and being short circuited will notice that the io queue is empty + * (after calling the driver's async_ready) and recursively call + * terminate_port. So when we get back here, the port is already terminated. + */ +static void flush_port(Port *p) +{ + int fpe_was_unmasked; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); + + if (p->drv_ptr->flush != NULL) { + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(p, am_in, am_flush); + } + fpe_was_unmasked = erts_block_fpe(); + (*p->drv_ptr->flush)((ErlDrvData)p->drv_data); + erts_unblock_fpe(fpe_was_unmasked); + if (IS_TRACED_FL(p, F_TRACE_SCHED_PORTS)) { + trace_sched_ports_where(p, am_out, am_flush); + } +#ifdef ERTS_SMP + if (p->xports) + erts_smp_xports_unlock(p); + ASSERT(!p->xports); +#endif + } + if ((p->status & ERTS_PORT_SFLGS_DEAD) == 0 && is_port_ioq_empty(p)) { + terminate_port(p); + } +} + +/* stop and delete a port that is ERTS_PORT_SFLG_CLOSING */ +static void +terminate_port(Port *prt) +{ + Eterm send_closed_port_id; + Eterm connected_id = NIL /* Initialize to silence compiler */; + erts_driver_t *drv; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + ASSERT(!prt->nlinks); + ASSERT(!prt->monitors); + + if (prt->status & ERTS_PORT_SFLG_SEND_CLOSED) { + erts_port_status_band_set(prt, ~ERTS_PORT_SFLG_SEND_CLOSED); + send_closed_port_id = prt->id; + connected_id = prt->connected; + } + else { + send_closed_port_id = NIL; + } + +#ifdef ERTS_SMP + erts_cancel_smp_ptimer(prt->ptimer); +#else + erl_cancel_timer(&prt->tm); +#endif + + drv = prt->drv_ptr; + if ((drv != NULL) && (drv->stop != NULL)) { + int fpe_was_unmasked = erts_block_fpe(); + (*drv->stop)((ErlDrvData)prt->drv_data); + erts_unblock_fpe(fpe_was_unmasked); +#ifdef ERTS_SMP + if (prt->xports) + erts_smp_xports_unlock(prt); + ASSERT(!prt->xports); +#endif + } + if(drv->handle != NULL) { + erts_smp_mtx_lock(&erts_driver_list_lock); + erts_ddll_decrement_port_count(drv->handle); + erts_smp_mtx_unlock(&erts_driver_list_lock); + } + stopq(prt); /* clear queue memory */ + if(prt->linebuf != NULL){ + erts_free(ERTS_ALC_T_LINEBUF, (void *) prt->linebuf); + prt->linebuf = NULL; + } + if (prt->bp != NULL) { + free_message_buffer(prt->bp); + prt->bp = NULL; + prt->data = am_undefined; + } + + if (prt->psd) + erts_free(ERTS_ALC_T_PRTSD, prt->psd); + + kill_port(prt); + + /* + * We don't want to send the closed message until after the + * port has been removed from the port table (in kill_port()). + */ + if (is_internal_port(send_closed_port_id)) + deliver_result(send_closed_port_id, connected_id, am_closed); + + ASSERT(prt->dist_entry == NULL); +} + +void +erts_terminate_port(Port *pp) +{ + terminate_port(pp); +} + +static void sweep_one_monitor(ErtsMonitor *mon, void *vpsc) +{ + ErtsMonitor *rmon; + Process *rp; + + ASSERT(mon->type == MON_ORIGIN); + ASSERT(is_internal_pid(mon->pid)); + rp = erts_pid2proc(NULL, 0, mon->pid, ERTS_PROC_LOCK_LINK); + if (!rp) { + goto done; + } + rmon = erts_remove_monitor(&(rp->monitors),mon->ref); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + if (rmon == NULL) { + goto done; + } + erts_destroy_monitor(rmon); + done: + erts_destroy_monitor(mon); +} + + + +typedef struct { + Eterm port; + Eterm reason; +} SweepContext; + +static void sweep_one_link(ErtsLink *lnk, void *vpsc) +{ + SweepContext *psc = vpsc; + DistEntry *dep; + Process *rp; + + + ASSERT(lnk->type == LINK_PID); + + if (is_external_pid(lnk->pid)) { + dep = external_pid_dist_entry(lnk->pid); + if(dep != erts_this_dist_entry) { + ErtsDistLinkData dld; + ErtsDSigData dsd; + int code; + code = erts_dsig_prepare(&dsd, dep, NULL, ERTS_DSP_NO_LOCK, 0); + switch (code) { + case ERTS_DSIG_PREP_NOT_ALIVE: + case ERTS_DSIG_PREP_NOT_CONNECTED: + break; + case ERTS_DSIG_PREP_CONNECTED: + erts_remove_dist_link(&dld, psc->port, lnk->pid, dep); + erts_destroy_dist_link(&dld); + code = erts_dsig_send_exit(&dsd, psc->port, lnk->pid, + psc->reason); + ASSERT(code == ERTS_DSIG_SEND_OK); + break; + default: + ASSERT(! "Invalid dsig prepare result"); + break; + } + } + } else { + ErtsProcLocks rp_locks = ERTS_PROC_LOCK_LINK|ERTS_PROC_LOCKS_XSIG_SEND; + ASSERT(is_internal_pid(lnk->pid)); + rp = erts_pid2proc(NULL, 0, lnk->pid, rp_locks); + if (rp) { + ErtsLink *rlnk = erts_remove_link(&(rp->nlinks), psc->port); + + if (rlnk) { + int xres = erts_send_exit_signal(NULL, + psc->port, + rp, + &rp_locks, + psc->reason, + NIL, + NULL, + 0); + if (xres >= 0 && IS_TRACED_FL(rp, F_TRACE_PROCS)) { + /* We didn't exit the process and it is traced */ + if (IS_TRACED_FL(rp, F_TRACE_PROCS)) { + trace_proc(NULL, rp, am_getting_unlinked, + psc->port); + } + } + erts_destroy_link(rlnk); + } + + erts_smp_proc_unlock(rp, rp_locks); + } + } + erts_destroy_link(lnk); +} + +/* 'from' is sending 'this_port' an exit signal, (this_port must be internal). + * If reason is normal we don't do anything, *unless* from is our connected + * process in which case we close the port. Any other reason kills the port. + * If 'from' is ourself we always die. + * When a driver has data in ioq then driver will be set to closing + * and become inaccessible to the processes. One exception exists and + * that is to kill a port till reason kill. Then the port is stopped. + * + */ +void +erts_do_exit_port(Port *p, Eterm from, Eterm reason) +{ + ErtsLink *lnk; + Eterm rreason; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); + + rreason = (reason == am_kill) ? am_killed : reason; + + if ((p->status & (ERTS_PORT_SFLGS_DEAD + | ERTS_PORT_SFLG_EXITING + | ERTS_PORT_SFLG_IMMORTAL)) + || ((reason == am_normal) && + ((from != p->connected) && (from != p->id)))) { + return; + } + + if (IS_TRACED_FL(p, F_TRACE_PORTS)) { + trace_port(p, am_closed, reason); + } + + erts_trace_check_exiting(p->id); + + /* + * Setting the port to not busy here, frees the list of pending + * processes and makes them runnable. + */ + set_busy_port((ErlDrvPort)internal_port_index(p->id), 0); + + if (p->reg != NULL) + (void) erts_unregister_name(NULL, 0, p, p->reg->name); + + erts_port_status_bor_set(p, ERTS_PORT_SFLG_EXITING); + + { + SweepContext sc = {p->id, rreason}; + lnk = p->nlinks; + p->nlinks = NULL; + erts_sweep_links(lnk, &sweep_one_link, &sc); + } + { + ErtsMonitor *moni = p->monitors; + p->monitors = NULL; + erts_sweep_monitors(moni, &sweep_one_monitor, NULL); + } + + + if ((p->status & ERTS_PORT_SFLG_DISTRIBUTION) && p->dist_entry) { + erts_do_net_exits(p->dist_entry, rreason); + erts_deref_dist_entry(p->dist_entry); + p->dist_entry = NULL; + erts_port_status_band_set(p, ~ERTS_PORT_SFLG_DISTRIBUTION); + } + + if ((reason != am_kill) && !is_port_ioq_empty(p)) { + erts_port_status_bandor_set(p, + ~ERTS_PORT_SFLG_EXITING, /* must turn it off */ + ERTS_PORT_SFLG_CLOSING); + flush_port(p); + } + else { + terminate_port(p); + } +} + +/* About the states ERTS_PORT_SFLG_EXITING and ERTS_PORT_SFLG_CLOSING used above. +** +** ERTS_PORT_SFLG_EXITING is a recursion protection for erts_do_exit_port(). +** It is unclear whether this state is necessary or not, it might be possible +** to merge it with ERTS_PORT_SFLG_CLOSING. ERTS_PORT_SFLG_EXITING only persists +** over a section of sequential (but highly recursive) code. +** +** ERTS_PORT_SFLG_CLOSING is a state where the port is in Limbo, waiting to +** pass on. All links are removed, and the port receives in/out-put events so +** as soon as the port queue gets empty terminate_port() is called. +*/ + + + +/* Command should be of the form +** {PID, close} +** {PID, {command, io-list}} +** {PID, {connect, New_PID}} +** +** +*/ +void erts_port_command(Process *proc, + Eterm caller_id, + Port *port, + Eterm command) +{ + Eterm *tp; + Eterm pid; + + if (!port) + return; + + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + ERTS_SMP_CHK_NO_PROC_LOCKS; + ASSERT(!INVALID_PORT(port, port->id)); + + if (is_tuple_arity(command, 2)) { + tp = tuple_val(command); + if ((pid = port->connected) == tp[1]) { + /* PID must be connected */ + if (tp[2] == am_close) { + erts_port_status_bor_set(port, ERTS_PORT_SFLG_SEND_CLOSED); + erts_do_exit_port(port, pid, am_normal); + goto done; + } else if (is_tuple_arity(tp[2], 2)) { + tp = tuple_val(tp[2]); + if (tp[1] == am_command) { + if (erts_write_to_port(caller_id, port, tp[2]) == 0) + goto done; + } else if ((tp[1] == am_connect) && is_internal_pid(tp[2])) { + port->connected = tp[2]; + deliver_result(port->id, pid, am_connected); + goto done; + } + } + } + } + + { + ErtsProcLocks rp_locks = ERTS_PROC_LOCKS_XSIG_SEND; + Process* rp = erts_pid2proc_opt(NULL, 0, + port->connected, rp_locks, + ERTS_P2P_FLG_SMP_INC_REFC); + if (rp) { + (void) erts_send_exit_signal(NULL, + port->id, + rp, + &rp_locks, + am_badsig, + NIL, + NULL, + 0); + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); + } + + } + done: + erts_smp_proc_lock(proc, ERTS_PROC_LOCK_MAIN); +} + +/* + * Control a port synchronously. + * Returns either a list or a binary. + */ +Eterm +erts_port_control(Process* p, Port* prt, Uint command, Eterm iolist) +{ + byte* to_port = NULL; /* Buffer to write to port. */ + /* Initialization is for shutting up + warning about use before set. */ + int to_len = 0; /* Length of buffer. */ + int must_free = 0; /* True if the buffer should be freed. */ + char port_result[ERL_ONHEAP_BIN_LIMIT]; /* Default buffer for result from port. */ + char* port_resp; /* Pointer to result buffer. */ + int n; + int (*control)(ErlDrvData, unsigned, char*, int, char**, int); + int fpe_was_unmasked; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if ((control = prt->drv_ptr->control) == NULL) { + return THE_NON_VALUE; + } + + /* + * Convert the iolist to a buffer, pointed to by to_port, + * and with its length in to_len. + */ + if (is_binary(iolist) && binary_bitoffset(iolist) == 0) { + Uint bitoffs; + Uint bitsize; + ERTS_GET_BINARY_BYTES(iolist, to_port, bitoffs, bitsize); + to_len = binary_size(iolist); + } else { + int r; + + /* Try with an 8KB buffer first (will often be enough I guess). */ + to_len = 8*1024; + to_port = erts_alloc(ERTS_ALC_T_TMP, to_len); + must_free = 1; + + /* + * In versions before R10B, we used to reserve random + * amounts of extra memory. From R10B, we allocate the + * exact amount. + */ + r = io_list_to_buf(iolist, (char*) to_port, to_len); + if (r >= 0) { + to_len -= r; + } else if (r == -2) { /* Type error */ + erts_free(ERTS_ALC_T_TMP, (void *) to_port); + return THE_NON_VALUE; + } else { + ASSERT(r == -1); /* Overflow */ + erts_free(ERTS_ALC_T_TMP, (void *) to_port); + if ((to_len = io_list_len(iolist)) < 0) { /* Type error */ + return THE_NON_VALUE; + } + must_free = 1; + to_port = erts_alloc(ERTS_ALC_T_TMP, to_len); + r = io_list_to_buf(iolist, (char*) to_port, to_len); + ASSERT(r == 0); + } + } + + prt->caller = p->id; /* Internal pid */ + + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN); + ERTS_SMP_CHK_NO_PROC_LOCKS; + + /* + * Call the port's control routine. + */ + + port_resp = port_result; + fpe_was_unmasked = erts_block_fpe(); + n = control((ErlDrvData)prt->drv_data, command, (char*)to_port, to_len, + &port_resp, sizeof(port_result)); + erts_unblock_fpe(fpe_was_unmasked); + if (must_free) { + erts_free(ERTS_ALC_T_TMP, (void *) to_port); + } + prt->caller = NIL; +#ifdef ERTS_SMP + if (prt->xports) + erts_smp_xports_unlock(prt); + ASSERT(!prt->xports); +#endif + + erts_smp_proc_lock(p, ERTS_PROC_LOCK_MAIN); + /* + * Handle the result. + */ + + if (n < 0) { + return THE_NON_VALUE; + } + + if ((prt->control_flags & PORT_CONTROL_FLAG_BINARY) == 0) { /* List result */ + Eterm ret; + Eterm* hp = HAlloc(p, 2*n); + ret = buf_to_intlist(&hp, port_resp, n, NIL); + if (port_resp != port_result) { + driver_free(port_resp); + } + return ret; + } + else if (port_resp == NULL) { + return NIL; + } + else { /* Binary result */ + ErlDrvBinary *dbin; + ErlHeapBin *hbin; + if (port_resp != port_result) { + dbin = (ErlDrvBinary *) port_resp; + if (dbin->orig_size > ERL_ONHEAP_BIN_LIMIT) { + ProcBin* pb = (ProcBin *) HAlloc(p, PROC_BIN_SIZE); + pb->thing_word = HEADER_PROC_BIN; + pb->size = dbin->orig_size; + pb->next = MSO(p).mso; + MSO(p).mso = pb; + pb->val = ErlDrvBinary2Binary(dbin); + pb->bytes = (byte*) dbin->orig_bytes; + pb->flags = 0; + MSO(p).overhead += dbin->orig_size / sizeof(Eterm); + return make_binary(pb); + } + port_resp = dbin->orig_bytes; + n = dbin->orig_size; + } else { + dbin = NULL; + } + hbin = (ErlHeapBin*) HAlloc(p, heap_bin_size(n)); + ASSERT(n <= ERL_ONHEAP_BIN_LIMIT); + hbin->thing_word = header_heap_bin(n); + hbin->size = n; + sys_memcpy(hbin->data, port_resp, n); + if (dbin != NULL) { + driver_free_binary(dbin); + } + return make_binary(hbin); + } +} + +typedef struct { + int to; + void *arg; +} prt_one_lnk_data; + +static void prt_one_monitor(ErtsMonitor *mon, void *vprtd) +{ + prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd; + erts_print(prtd->to, prtd->arg, "(%T,%T)", mon->pid,mon->ref); +} + +static void prt_one_lnk(ErtsLink *lnk, void *vprtd) +{ + prt_one_lnk_data *prtd = (prt_one_lnk_data *) vprtd; + erts_print(prtd->to, prtd->arg, "%T", lnk->pid); +} + +void +print_port_info(int to, void *arg, int i) +{ + Port* p = &erts_port[i]; + + if (p->status & ERTS_PORT_SFLGS_DEAD) + return; + + erts_print(to, arg, "=port:%T\n", p->id); + erts_print(to, arg, "Slot: %d\n", i); + if (p->status & ERTS_PORT_SFLG_CONNECTED) { + erts_print(to, arg, "Connected: %T", p->connected); + erts_print(to, arg, "\n"); + } + + if (p->nlinks != NULL) { + prt_one_lnk_data prtd; + prtd.to = to; + prtd.arg = arg; + erts_print(to, arg, "Links: "); + erts_doforall_links(p->nlinks, &prt_one_lnk, &prtd); + erts_print(to, arg, "\n"); + } + if (p->monitors != NULL) { + prt_one_lnk_data prtd; + prtd.to = to; + prtd.arg = arg; + erts_print(to, arg, "Monitors: "); + erts_doforall_monitors(p->monitors, &prt_one_monitor, &prtd); + erts_print(to, arg, "\n"); + } + + if (p->reg != NULL) + erts_print(to, arg, "Registered as: %T\n", p->reg->name); + + if (p->drv_ptr == &fd_driver) { + erts_print(to, arg, "Port is UNIX fd not opened by emulator: %s\n", p->name); + } else if (p->drv_ptr == &vanilla_driver) { + erts_print(to, arg, "Port is a file: %s\n",p->name); + } else if (p->drv_ptr == &spawn_driver) { + erts_print(to, arg, "Port controls external process: %s\n",p->name); + } else { + erts_print(to, arg, "Port controls linked-in driver: %s\n",p->name); + } +} + +void +set_busy_port(ErlDrvPort port_num, int on) +{ + ERTS_SMP_CHK_NO_PROC_LOCKS; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(&erts_port[port_num])); + + if (on) { + erts_port_status_bor_set(&erts_port[port_num], + ERTS_PORT_SFLG_PORT_BUSY); + } else { + ErtsProcList* plp = erts_port[port_num].suspended; + erts_port_status_band_set(&erts_port[port_num], + ~ERTS_PORT_SFLG_PORT_BUSY); + erts_port[port_num].suspended = NULL; + + if (erts_port[port_num].dist_entry) { + /* + * Processes suspended on distribution ports are + * normally queued on the dist entry. + */ + erts_dist_port_not_busy(&erts_port[port_num]); + } + + /* + * Resume, in a round-robin fashion, all processes waiting on the port. + * + * This version submitted by Tony Rogvall. The earlier version used + * to resume the processes in order, which caused starvation of all but + * the first process. + */ + + if (plp) { + /* First proc should be resumed last */ + if (plp->next) { + erts_resume_processes(plp->next); + plp->next = NULL; + } + erts_resume_processes(plp); + } + } +} + +void set_port_control_flags(ErlDrvPort port_num, int flags) +{ + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(&erts_port[port_num])); + + erts_port[port_num].control_flags = flags; +} + +int get_port_flags(ErlDrvPort ix) { + Port* prt = erts_drvport2port(ix); + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (prt == NULL) + return 0; + + return (prt->status & ERTS_PORT_SFLG_BINARY_IO ? PORT_FLAG_BINARY : 0) + | (prt->status & ERTS_PORT_SFLG_LINEBUF_IO ? PORT_FLAG_LINE : 0); +} + + +void erts_raw_port_command(Port* p, byte* buf, Uint len) +{ + int fpe_was_unmasked; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); + + if (len > (Uint) INT_MAX) + erl_exit(ERTS_ABORT_EXIT, + "Absurdly large data buffer (%bpu bytes) passed to" + "output callback of %s driver.\n", + len, + p->drv_ptr->name ? p->drv_ptr->name : "unknown"); + + p->caller = NIL; + fpe_was_unmasked = erts_block_fpe(); + (*p->drv_ptr->output)((ErlDrvData)p->drv_data, (char*) buf, (int) len); + erts_unblock_fpe(fpe_was_unmasked); +} + +int async_ready(Port *p, void* data) +{ + int need_free = 1; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if (p) { + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); + ASSERT(!(p->status & ERTS_PORT_SFLGS_DEAD)); + if (p->drv_ptr->ready_async != NULL) { + (*p->drv_ptr->ready_async)((ErlDrvData)p->drv_data, data); + need_free = 0; +#ifdef ERTS_SMP + if (p->xports) + erts_smp_xports_unlock(p); + ASSERT(!p->xports); +#endif + } + if ((p->status & ERTS_PORT_SFLG_CLOSING) && is_port_ioq_empty(p)) { + terminate_port(p); + } + } + return need_free; +} + +static void +report_missing_drv_callback(Port *p, char *drv_type, char *callback) +{ + ErtsPortNames *pnp = erts_get_port_names(p->id); + char *unknown = ""; + char *drv_name = pnp->driver_name ? pnp->driver_name : unknown; + char *prt_name = pnp->name ? pnp->name : unknown; + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "%T: %s driver '%s' ", p->id, drv_type, drv_name); + if (sys_strcmp(drv_name, prt_name) != 0) + erts_dsprintf(dsbufp, "(%s) ", prt_name); + erts_dsprintf(dsbufp, "does not implement the %s callback!\n", callback); + erts_free_port_names(pnp); + erts_send_error_to_logger_nogl(dsbufp); +} + +void +erts_stale_drv_select(Eterm port, + ErlDrvEvent hndl, + int mode, + int deselect) +{ + char *type; + ErlDrvPort drv_port = internal_port_index(port); + ErtsPortNames *pnp = erts_get_port_names(port); + erts_dsprintf_buf_t *dsbufp; + + switch (mode) { + case ERL_DRV_READ | ERL_DRV_WRITE: + type = "Input/Output"; + goto deselect; + case ERL_DRV_WRITE: + type = "Output"; + goto deselect; + case ERL_DRV_READ: + type = "Input"; + deselect: + if (deselect) { + driver_select(drv_port, hndl, + mode | ERL_DRV_USE_NO_CALLBACK, + 0); + } + break; + default: + type = "Event"; + if (deselect) + driver_event(drv_port, hndl, NULL); + break; + } + + dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "%T: %s: %s driver gone away without deselecting!\n", + port, + pnp->name ? pnp->name : "", + type); + erts_free_port_names(pnp); + erts_send_error_to_logger_nogl(dsbufp); +} + +ErtsPortNames * +erts_get_port_names(Eterm id) +{ + ErtsPortNames *pnp; + ASSERT(is_nil(id) || is_internal_port(id)); + + if (is_not_internal_port(id)) { + pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, sizeof(ErtsPortNames)); + pnp->name = NULL; + pnp->driver_name = NULL; + } + else { + Port* prt = &erts_port[internal_port_index(id)]; + int do_realloc = 1; + int len = -1; + size_t pnp_len = sizeof(ErtsPortNames); +#ifndef DEBUG + pnp_len += 100; /* In most cases 100 characters will be enough... */ +#endif + pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, pnp_len); + do { + int nlen; + char *name, *driver_name; + if (len > 0) { + erts_free(ERTS_ALC_T_PORT_NAMES, pnp); + pnp_len = sizeof(ErtsPortNames) + len; + pnp = erts_alloc(ERTS_ALC_T_PORT_NAMES, pnp_len); + } + erts_smp_port_state_lock(prt); + if (id != prt->id) { + len = nlen = 0; + name = driver_name = NULL; + } + else { + name = prt->name; + len = nlen = name ? sys_strlen(name) + 1 : 0; + driver_name = (prt->drv_ptr ? prt->drv_ptr->name : NULL); + len += driver_name ? sys_strlen(driver_name) + 1 : 0; + } + if (len <= pnp_len - sizeof(ErtsPortNames)) { + if (!name) + pnp->name = NULL; + else { + pnp->name = ((char *) pnp) + sizeof(ErtsPortNames); + sys_strcpy(pnp->name, name); + } + if (!driver_name) + pnp->driver_name = NULL; + else { + pnp->driver_name = (((char *) pnp) + + sizeof(ErtsPortNames) + + nlen); + sys_strcpy(pnp->driver_name, driver_name); + } + do_realloc = 0; + } + erts_smp_port_state_unlock(prt); + } while (do_realloc); + } + return pnp; +} + +void +erts_free_port_names(ErtsPortNames *pnp) +{ + erts_free(ERTS_ALC_T_PORT_NAMES, pnp); +} + +static void schedule_port_timeout(Port *p) +{ + /* + * Scheduling of port timeouts can be done without port locking, but + * since the task handle is stored in the port structure and the ptimer + * structure is protected by the port lock we require the port to be + * locked for now... + * + * TODO: Implement scheduling of port timeouts without locking + * the port. + * /Rickard + */ + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(p)); + (void) erts_port_task_schedule(p->id, + &p->timeout_task, + ERTS_PORT_TASK_TIMEOUT, + (ErlDrvEvent) -1, + NULL); +} + +ErlDrvTermData driver_mk_term_nil(void) +{ + return driver_term_nil; +} + +void driver_report_exit(int ix, int status) +{ + Port* prt = erts_drvport2port(ix); + Eterm* hp; + Eterm tuple; + Process *rp; + Eterm pid; + ErlHeapFragment *bp = NULL; + ErlOffHeap *ohp; + ErtsProcLocks rp_locks = 0; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + pid = prt->connected; + ASSERT(is_internal_pid(pid)); + rp = erts_pid2proc_opt(NULL, 0, pid, 0, ERTS_P2P_FLG_SMP_INC_REFC); + if (!rp) + return; + + hp = erts_alloc_message_heap(3+3, &bp, &ohp, rp, &rp_locks); + + tuple = TUPLE2(hp, am_exit_status, make_small(status)); + hp += 3; + tuple = TUPLE2(hp, prt->id, tuple); + + erts_queue_message(rp, &rp_locks, bp, tuple, am_undefined); + + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); +} + + +static ERTS_INLINE int +deliver_term_check_port(ErlDrvPort drvport) +{ + int res; + int ix = (int) drvport; + if (ix < 0 || erts_max_ports <= ix) + res = -1; /* invalid */ + else { + Port* prt = &erts_port[ix]; + erts_smp_port_state_lock(prt); + if (!(prt->status & ERTS_PORT_SFLGS_INVALID_LOOKUP)) + res = 1; /* ok */ + else if (prt->status & ERTS_PORT_SFLG_CLOSING) + res = 0; /* closing */ + else + res = -1; /* invalid (dead) */ + erts_smp_port_state_unlock(prt); + } + return res; +} + +#define ERTS_B2T_STATES_DEF_STATES_SZ 5 +#define ERTS_B2T_STATES_DEF_STATES_INC 100 + +struct b2t_states__ { + int len; + int ix; + int used; + ErtsBinary2TermState *state; + ErtsBinary2TermState def_states[ERTS_B2T_STATES_DEF_STATES_SZ]; +#ifdef DEBUG + byte **org_ext; + byte *def_org_ext[ERTS_B2T_STATES_DEF_STATES_SZ]; +#endif +}; + +static ERTS_INLINE void +init_b2t_states(struct b2t_states__ *b2tsp) +{ + b2tsp->len = ERTS_B2T_STATES_DEF_STATES_SZ; + b2tsp->ix = 0; + b2tsp->used = 0; + b2tsp->state = &b2tsp->def_states[0]; +#ifdef DEBUG + b2tsp->org_ext = &b2tsp->def_org_ext[0]; +#endif +} + +static ERTS_INLINE void +grow_b2t_states(struct b2t_states__ *b2tsp) +{ + if (b2tsp->state != &b2tsp->def_states[0]) { + b2tsp->len += ERTS_B2T_STATES_DEF_STATES_INC; + b2tsp->state = erts_realloc(ERTS_ALC_T_TMP, + b2tsp->state, + sizeof(ErtsBinary2TermState)*b2tsp->len); +#ifdef DEBUG + b2tsp->org_ext = erts_realloc(ERTS_ALC_T_TMP, + b2tsp->org_ext, + sizeof(char *)*b2tsp->len); +#endif + } + else { + ErtsBinary2TermState *new_states; + new_states = erts_alloc(ERTS_ALC_T_TMP, + (sizeof(ErtsBinary2TermState) + *ERTS_B2T_STATES_DEF_STATES_INC)); + sys_memcpy((void *) new_states, + (void *) b2tsp->state, + sizeof(ErtsBinary2TermState)*ERTS_B2T_STATES_DEF_STATES_SZ); + b2tsp->state = new_states; + b2tsp->len = ERTS_B2T_STATES_DEF_STATES_INC; +#ifdef DEBUG + { + byte **new_org_ext = erts_alloc(ERTS_ALC_T_TMP, + (sizeof(char *) + *ERTS_B2T_STATES_DEF_STATES_INC)); + sys_memcpy((void *) new_org_ext, + (void *) b2tsp->org_ext, + sizeof(char *)*ERTS_B2T_STATES_DEF_STATES_SZ); + b2tsp->org_ext = new_org_ext; + } +#endif + } +} + +static ERTS_INLINE void +cleanup_b2t_states(struct b2t_states__ *b2tsp) +{ + if (b2tsp->state != &b2tsp->def_states[0]) { + erts_free(ERTS_ALC_T_TMP, b2tsp->state); +#ifdef DEBUG + erts_free(ERTS_ALC_T_TMP, b2tsp->org_ext); +#endif + } +} + + +/* + * Generate an Erlang term from data in an array (representing a simple stack + * machine to build terms). + * Returns: + * -1 on error in input data + * 0 if the message was not delivered (bad to pid or closed port) + * 1 if the message was delivered successfully + */ + +static int +driver_deliver_term(ErlDrvPort port, + Eterm to, + ErlDrvTermData* data, + int len) +{ +#define ERTS_DDT_FAIL do { res = -1; goto done; } while (0) + Uint need = 0; + int depth = 0; + int res; + Eterm *hp = NULL, *hp_start = NULL, *hp_end = NULL; + ErlDrvTermData* ptr; + ErlDrvTermData* ptr_end; + DECLARE_ESTACK(stack); + Eterm mess = NIL; /* keeps compiler happy */ + Process* rp = NULL; + ErlHeapFragment *bp = NULL; + ErlOffHeap *ohp; + ErtsProcLocks rp_locks = 0; + struct b2t_states__ b2t; + + init_b2t_states(&b2t); + + /* + * We used to check port and process here. In the SMP enabled emulator, + * however, we don't want to that until we have verified the term. + */ + + /* + * Check ErlDrvTermData for consistency and calculate needed heap size + * and stack depth. + */ + ptr = data; + ptr_end = ptr + len; + + while (ptr < ptr_end) { + ErlDrvTermData tag = *ptr++; + +#define ERTS_DDT_CHK_ENOUGH_ARGS(NEED) \ + if (ptr+((NEED)-1) >= ptr_end) ERTS_DDT_FAIL; + + switch(tag) { + case ERL_DRV_NIL: /* no arguments */ + depth++; + break; + case ERL_DRV_ATOM: /* atom argument */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + if (is_not_atom(ptr[0])) ERTS_DDT_FAIL; + ptr++; + depth++; + break; + case ERL_DRV_INT: /* signed int argument */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + /* check for bignum */ + if (!IS_SSMALL((Sint)ptr[0])) + need += BIG_UINT_HEAP_SIZE; /* use small_to_big */ + ptr++; + depth++; + break; + case ERL_DRV_UINT: /* unsigned int argument */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + /* check for bignum */ + if (!IS_USMALL(0, (Uint)ptr[0])) + need += BIG_UINT_HEAP_SIZE; /* use small_to_big */ + ptr++; + depth++; + break; + case ERL_DRV_INT64: /* pointer to signed 64-bit int argument */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + erts_bld_sint64(NULL, &need, *((Sint64 *) ptr[0])); + ptr++; + depth++; + break; + case ERL_DRV_UINT64: /* pointer to unsigned 64-bit int argument */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + erts_bld_uint64(NULL, &need, *((Uint64 *) ptr[0])); + ptr++; + depth++; + break; + case ERL_DRV_PORT: /* port argument */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + if (is_not_internal_port(ptr[0])) ERTS_DDT_FAIL; + ptr++; + depth++; + break; + case ERL_DRV_BINARY: { /* ErlDrvBinary*, size, offs */ + ErlDrvBinary* b; + Uint size; + Uint offset; + ERTS_DDT_CHK_ENOUGH_ARGS(3); + b = (ErlDrvBinary*) ptr[0]; + size = ptr[1]; + offset = ptr[2]; + if (!b || size + offset > b->orig_size) + ERTS_DDT_FAIL; /* No binary or outside the binary */ + need += (size <= ERL_ONHEAP_BIN_LIMIT + ? heap_bin_size(size) + : PROC_BIN_SIZE); + ptr += 3; + depth++; + break; + } + case ERL_DRV_BUF2BINARY: { /* char*, size */ + byte *bufp; + Uint size; + ERTS_DDT_CHK_ENOUGH_ARGS(2); + bufp = (byte *) ptr[0]; + size = (Uint) ptr[1]; + if (!bufp && size > 0) ERTS_DDT_FAIL; + need += (size <= ERL_ONHEAP_BIN_LIMIT + ? heap_bin_size(size) + : PROC_BIN_SIZE); + ptr += 2; + depth++; + break; + } + case ERL_DRV_STRING: /* char*, length */ + ERTS_DDT_CHK_ENOUGH_ARGS(2); + if ((char *) ptr[0] == NULL || (int) ptr[1] < 0) ERTS_DDT_FAIL; + need += ptr[1] * 2; + ptr += 2; + depth++; + break; + case ERL_DRV_STRING_CONS: /* char*, length */ + ERTS_DDT_CHK_ENOUGH_ARGS(2); + if ((char *) ptr[0] == NULL || (int) ptr[1] < 0) ERTS_DDT_FAIL; + need += ptr[1] * 2; + if (depth < 1) ERTS_DDT_FAIL; + ptr += 2; + break; + case ERL_DRV_LIST: /* int */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + if ((int) ptr[0] <= 0) ERTS_DDT_FAIL; + need += (ptr[0]-1)*2; /* list cells */ + depth -= ptr[0]; + if (depth < 0) ERTS_DDT_FAIL; + ptr++; + depth++; + break; + case ERL_DRV_TUPLE: { /* int */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + if ((int) ptr[0] < 0) ERTS_DDT_FAIL; + need += ptr[0]+1; /* vector positions + arityval */ + depth -= ptr[0]; + if (depth < 0) ERTS_DDT_FAIL; + ptr++; + depth++; + break; + } + case ERL_DRV_PID: /* pid argument */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + if (is_not_internal_pid(ptr[0])) ERTS_DDT_FAIL; + ptr++; + depth++; + break; + case ERL_DRV_FLOAT: /* double * */ + ERTS_DDT_CHK_ENOUGH_ARGS(1); + need += FLOAT_SIZE_OBJECT; + ptr++; + depth++; + break; + case ERL_DRV_EXT2TERM: { /* char *ext, int size */ + byte* ext; + Sint size; + Sint hsz; + + ERTS_DDT_CHK_ENOUGH_ARGS(2); + ext = (byte *) ptr[0]; + size = (Sint) ptr[1]; + if (!ext || size <= 0) + ERTS_DDT_FAIL; + if (b2t.len <= b2t.ix) + grow_b2t_states(&b2t); +#ifdef DEBUG + b2t.org_ext[b2t.ix] = ext; +#endif + hsz = erts_binary2term_prepare(&b2t.state[b2t.ix++], ext, size); + if (hsz < 0) + ERTS_DDT_FAIL; /* Invalid data */ + need += hsz; + ptr += 2; + depth++; + break; + } + default: + ERTS_DDT_FAIL; + } +#undef ERTS_DDT_CHK_ENOUGH_ARGS + } + + if ((depth != 1) || (ptr != ptr_end)) + ERTS_DDT_FAIL; + + b2t.used = b2t.ix; + b2t.ix = 0; + + /* + * The term is OK. Go ahead and validate the port and process. + */ + res = deliver_term_check_port(port); + if (res <= 0) + goto done; + + rp = erts_pid2proc_opt(NULL, 0, to, rp_locks, ERTS_P2P_FLG_SMP_INC_REFC); + if (!rp) { + res = 0; + goto done; + } + + hp_start = hp = erts_alloc_message_heap(need, &bp, &ohp, rp, &rp_locks); + hp_end = hp + need; + + /* + * Interpret the instructions and build the term. + */ + ptr = data; + while (ptr < ptr_end) { + ErlDrvTermData tag = *ptr++; + + switch(tag) { + case ERL_DRV_NIL: /* no arguments */ + mess = NIL; + break; + + case ERL_DRV_ATOM: /* atom argument */ + mess = ptr[0]; + ptr++; + break; + + case ERL_DRV_INT: /* signed int argument */ + if (IS_SSMALL((Sint)ptr[0])) + mess = make_small((Sint)ptr[0]); + else { + mess = small_to_big((Sint)ptr[0], hp); + hp += BIG_UINT_HEAP_SIZE; + } + ptr++; + break; + + case ERL_DRV_UINT: /* unsigned int argument */ + if (IS_USMALL(0, (Uint)ptr[0])) + mess = make_small((Uint)ptr[0]); + else { + mess = uint_to_big((Uint)ptr[0], hp); + hp += BIG_UINT_HEAP_SIZE; + } + ptr++; + break; + + case ERL_DRV_INT64: /* pointer to unsigned 64-bit int argument */ + mess = erts_bld_sint64(&hp, NULL, *((Sint64 *) ptr[0])); + ptr++; + break; + + case ERL_DRV_UINT64: /* pointer to unsigned 64-bit int argument */ + mess = erts_bld_uint64(&hp, NULL, *((Uint64 *) ptr[0])); + ptr++; + break; + + case ERL_DRV_PORT: /* port argument */ + mess = ptr[0]; + ptr++; + break; + + case ERL_DRV_BINARY: { /* ErlDrvBinary*, size, offs */ + ErlDrvBinary* b = (ErlDrvBinary*) ptr[0]; + Uint size = ptr[1]; + Uint offset = ptr[2]; + + if (size <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin* hbp = (ErlHeapBin *) hp; + hp += heap_bin_size(size); + hbp->thing_word = header_heap_bin(size); + hbp->size = size; + if (size > 0) { + sys_memcpy((void *) hbp->data, (void *) (((byte*) b->orig_bytes) + offset), size); + } + mess = make_binary(hbp); + } + else { + ProcBin* pb = (ProcBin *) hp; + driver_binary_inc_refc(b); /* caller will free binary */ + pb->thing_word = HEADER_PROC_BIN; + pb->size = size; + pb->next = ohp->mso; + ohp->mso = pb; + pb->val = ErlDrvBinary2Binary(b); + pb->bytes = ((byte*) b->orig_bytes) + offset; + pb->flags = 0; + mess = make_binary(pb); + hp += PROC_BIN_SIZE; + ohp->overhead += pb->size / sizeof(Eterm); + } + ptr += 3; + break; + } + + case ERL_DRV_BUF2BINARY: { /* char*, size */ + byte *bufp = (byte *) ptr[0]; + Uint size = (Uint) ptr[1]; + if (size <= ERL_ONHEAP_BIN_LIMIT) { + ErlHeapBin* hbp = (ErlHeapBin *) hp; + hp += heap_bin_size(size); + hbp->thing_word = header_heap_bin(size); + hbp->size = size; + if (size > 0) { + ASSERT(bufp); + sys_memcpy((void *) hbp->data, (void *) bufp, size); + } + mess = make_binary(hbp); + } + else { + ProcBin* pbp; + Binary* bp = erts_bin_nrml_alloc(size); + ASSERT(bufp); + bp->flags = 0; + bp->orig_size = (long) size; + erts_refc_init(&bp->refc, 1); + sys_memcpy((void *) bp->orig_bytes, (void *) bufp, size); + pbp = (ProcBin *) hp; + hp += PROC_BIN_SIZE; + pbp->thing_word = HEADER_PROC_BIN; + pbp->size = size; + pbp->next = ohp->mso; + ohp->mso = pbp; + pbp->val = bp; + pbp->bytes = (byte*) bp->orig_bytes; + pbp->flags = 0; + ohp->overhead += (pbp->size / sizeof(Eterm)); + mess = make_binary(pbp); + } + ptr += 2; + break; + } + + case ERL_DRV_STRING: /* char*, length */ + mess = buf_to_intlist(&hp, (char*)ptr[0], ptr[1], NIL); + ptr += 2; + break; + + case ERL_DRV_STRING_CONS: /* char*, length */ + mess = ESTACK_POP(stack); + mess = buf_to_intlist(&hp, (char*)ptr[0], ptr[1], mess); + ptr += 2; + break; + + case ERL_DRV_LIST: { /* unsigned */ + Uint i = (int) ptr[0]; /* i > 0 */ + + mess = ESTACK_POP(stack); + i--; + while(i > 0) { + Eterm hd = ESTACK_POP(stack); + + mess = CONS(hp, hd, mess); + hp += 2; + i--; + } + ptr++; + break; + } + + case ERL_DRV_TUPLE: { /* int */ + int size = (int)ptr[0]; + Eterm* tp = hp; + + *tp = make_arityval(size); + mess = make_tuple(tp); + + tp += size; /* point at last element */ + hp = tp+1; /* advance "heap" pointer */ + + while(size--) { + *tp-- = ESTACK_POP(stack); + } + ptr++; + break; + } + + case ERL_DRV_PID: /* pid argument */ + mess = ptr[0]; + ptr++; + break; + + case ERL_DRV_FLOAT: { /* double * */ + FloatDef f; + + mess = make_float(hp); + f.fd = *((double *) ptr[0]); + PUT_DOUBLE(f, hp); + hp += FLOAT_SIZE_OBJECT; + ptr++; + break; + } + + case ERL_DRV_EXT2TERM: /* char *ext, int size */ + ASSERT(b2t.org_ext[b2t.ix] == (byte *) ptr[0]); + mess = erts_binary2term_create(&b2t.state[b2t.ix++], &hp, ohp); + if (mess == THE_NON_VALUE) + ERTS_DDT_FAIL; + ptr += 2; + break; + + } + ESTACK_PUSH(stack, mess); + } + + res = 1; + + done: + + if (res > 0) { + mess = ESTACK_POP(stack); /* get resulting value */ + if (bp) + bp = erts_resize_message_buffer(bp, hp - hp_start, &mess, 1); + else { + ASSERT(hp); + HRelease(rp, hp_end, hp); + } + /* send message */ + erts_queue_message(rp, &rp_locks, bp, mess, am_undefined); + } + else { + if (b2t.ix > b2t.used) + b2t.used = b2t.ix; + for (b2t.ix = 0; b2t.ix < b2t.used; b2t.ix++) + erts_binary2term_abort(&b2t.state[b2t.ix]); + if (bp) + free_message_buffer(bp); + else if (hp) { + HRelease(rp, hp_end, hp); + } + } +#ifdef ERTS_SMP + if (rp) { + if (rp_locks) + erts_smp_proc_unlock(rp, rp_locks); + erts_smp_proc_dec_refc(rp); + } +#endif + cleanup_b2t_states(&b2t); + DESTROY_ESTACK(stack); + return res; +#undef ERTS_DDT_FAIL +} + + +int +driver_output_term(ErlDrvPort ix, ErlDrvTermData* data, int len) +{ + Port* prt = erts_drvport2port(ix); + + ERTS_SMP_CHK_NO_PROC_LOCKS; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (prt == NULL) + return -1; + return driver_deliver_term(ix, prt->connected, data, len); +} + + +int +driver_send_term(ErlDrvPort ix, ErlDrvTermData to, ErlDrvTermData* data, int len) +{ + return driver_deliver_term(ix, to, data, len); +} + + +/* + * Output a binary with hlen bytes from hbuf as list header + * and data is len length of bin starting from offset offs. + */ + +int driver_output_binary(ErlDrvPort ix, char* hbuf, int hlen, + ErlDrvBinary* bin, int offs, int len) +{ + Port* prt = erts_drvport2port(ix); + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if (prt == NULL) + return -1; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + if (prt->status & ERTS_PORT_SFLG_CLOSING) + return 0; + + prt->bytes_in += (hlen + len); + erts_smp_atomic_add(&erts_bytes_in, (long) (hlen + len)); + if (prt->status & ERTS_PORT_SFLG_DISTRIBUTION) { + return erts_net_message(prt, + prt->dist_entry, + (byte*) hbuf, hlen, + (byte*) (bin->orig_bytes+offs), len); + } + else + deliver_bin_message(prt, prt->connected, + hbuf, hlen, bin, offs, len); + return 0; +} + +/* driver_output2: +** Delivers hlen bytes from hbuf to the port owner as a list; +** after that, the port settings apply, buf is sent as binary or list. +** +** Example: if hlen = 3 then the port owner will receive the data +** [H1,H2,H3 | T] +*/ +int driver_output2(ErlDrvPort ix, char* hbuf, int hlen, char* buf, int len) +{ + Port* prt = erts_drvport2port(ix); + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if (prt == NULL) + return -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (prt->status & ERTS_PORT_SFLG_CLOSING) + return 0; + + prt->bytes_in += (hlen + len); + erts_smp_atomic_add(&erts_bytes_in, (long) (hlen + len)); + if (prt->status & ERTS_PORT_SFLG_DISTRIBUTION) { + if (len == 0) + return erts_net_message(prt, + prt->dist_entry, + NULL, 0, + (byte*) hbuf, hlen); + else + return erts_net_message(prt, + prt->dist_entry, + (byte*) hbuf, hlen, + (byte*) buf, len); + } + else if(prt->status & ERTS_PORT_SFLG_LINEBUF_IO) + deliver_linebuf_message(prt, prt->connected, hbuf, hlen, buf, len); + else + deliver_read_message(prt, prt->connected, hbuf, hlen, buf, len, 0); + return 0; +} + +/* Interface functions available to driver writers */ + +int driver_output(ErlDrvPort ix, char* buf, int len) +{ + ERTS_SMP_CHK_NO_PROC_LOCKS; + return driver_output2(ix, NULL, 0, buf, len); +} + +int driver_outputv(ErlDrvPort ix, char* hbuf, int hlen, ErlIOVec* vec, int skip) +{ + int n; + int len; + int size; + SysIOVec* iov; + ErlDrvBinary** binv; + Port* prt; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + size = vec->size - skip; /* Size of remaining bytes in vector */ + ASSERT(size >= 0); + if (size <= 0) + return driver_output2(ix, hbuf, hlen, NULL, 0); + ASSERT(hlen >= 0); /* debug only */ + if (hlen < 0) + hlen = 0; + + prt = erts_drvport2port(ix); + if (prt == NULL) + return -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + if (prt->status & ERTS_PORT_SFLG_CLOSING) + return 0; + + /* size > 0 ! */ + iov = vec->iov; + binv = vec->binv; + n = vec->vsize; + /* we use do here to strip iov_len=0 from beginning */ + do { + len = iov->iov_len; + if (len <= skip) { + skip -= len; + iov++; + binv++; + n--; + } else { + iov->iov_base += skip; + iov->iov_len -= skip; + skip = 0; + } + } while (skip > 0); + + /* XXX handle distribution !!! */ + prt->bytes_in += (hlen + size); + erts_smp_atomic_add(&erts_bytes_in, (long) (hlen + size)); + deliver_vec_message(prt, prt->connected, hbuf, hlen, binv, iov, n, size); + return 0; +} + +/* Copy bytes from a vector into a buffer +** input is a vector a buffer and a max length +** return bytes copied +*/ +int driver_vec_to_buf(vec, buf, len) +ErlIOVec* vec; +char* buf; +int len; +{ + SysIOVec* iov = vec->iov; + int n = vec->vsize; + int orig_len = len; + + while(n--) { + int ilen = iov->iov_len; + if (ilen < len) { + sys_memcpy(buf, iov->iov_base, ilen); + len -= ilen; + buf += ilen; + iov++; + } + else { + sys_memcpy(buf, iov->iov_base, len); + return orig_len; + } + } + return (orig_len - len); +} + + +/* + * - driver_alloc_binary() is thread safe (efile driver depend on it). + * - driver_realloc_binary(), and driver_free_binary() are *not* thread safe. + */ + +/* + * reference count on driver binaries... + */ + +long +driver_binary_get_refc(ErlDrvBinary *dbp) +{ + Binary* bp = ErlDrvBinary2Binary(dbp); + return erts_refc_read(&bp->refc, 1); +} + +long +driver_binary_inc_refc(ErlDrvBinary *dbp) +{ + Binary* bp = ErlDrvBinary2Binary(dbp); + return erts_refc_inctest(&bp->refc, 2); +} + +long +driver_binary_dec_refc(ErlDrvBinary *dbp) +{ + Binary* bp = ErlDrvBinary2Binary(dbp); + return erts_refc_dectest(&bp->refc, 1); +} + + +/* +** Allocation/Deallocation of binary objects +*/ + +ErlDrvBinary* +driver_alloc_binary(int size) +{ + Binary* bin; + + if (size < 0) + return NULL; + + bin = erts_bin_drv_alloc_fnf((Uint) size); + if (!bin) + return NULL; /* The driver write must take action */ + bin->flags = BIN_FLAG_DRV; + erts_refc_init(&bin->refc, 1); + bin->orig_size = (long) size; + return Binary2ErlDrvBinary(bin); +} + +/* Reallocate space hold by binary */ + +ErlDrvBinary* driver_realloc_binary(ErlDrvBinary* bin, int size) +{ + Binary* oldbin; + Binary* newbin; + + if (!bin || size < 0) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Bad use of driver_realloc_binary(%p, %d): " + "called with ", + bin, size); + if (!bin) { + erts_dsprintf(dsbufp, "NULL pointer as first argument"); + if (size < 0) + erts_dsprintf(dsbufp, ", and "); + } + if (size < 0) { + erts_dsprintf(dsbufp, "negative size as second argument"); + size = 0; + } + erts_send_warning_to_logger_nogl(dsbufp); + if (!bin) + return driver_alloc_binary(size); + } + + oldbin = ErlDrvBinary2Binary(bin); + newbin = (Binary *) erts_bin_realloc_fnf(oldbin, size); + if (!newbin) + return NULL; + + newbin->orig_size = size; + return Binary2ErlDrvBinary(newbin); +} + + +void driver_free_binary(dbin) +ErlDrvBinary* dbin; +{ + Binary *bin; + if (!dbin) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Bad use of driver_free_binary(%p): called with " + "NULL pointer as argument", dbin); + erts_send_warning_to_logger_nogl(dsbufp); + return; + } + + bin = ErlDrvBinary2Binary(dbin); + if (erts_refc_dectest(&bin->refc, 0) == 0) + erts_bin_free(bin); +} + + +/* + * Allocation/deallocation of memory for drivers + */ + +void *driver_alloc(size_t size) +{ + return erts_alloc_fnf(ERTS_ALC_T_DRV, (Uint) size); +} + +void *driver_realloc(void *ptr, size_t size) +{ + return erts_realloc_fnf(ERTS_ALC_T_DRV, ptr, (Uint) size); +} + +void driver_free(void *ptr) +{ + erts_free(ERTS_ALC_T_DRV, ptr); +} + +/* + * Port Data Lock + */ + +static void +pdl_init(void) +{ +} + +static ERTS_INLINE void +pdl_init_refc(ErlDrvPDL pdl) +{ + erts_atomic_init(&pdl->refc, 1); +} + +static ERTS_INLINE long +pdl_read_refc(ErlDrvPDL pdl) +{ + long refc = erts_atomic_read(&pdl->refc); + ERTS_LC_ASSERT(refc >= 0); + return refc; +} + +static ERTS_INLINE void +pdl_inc_refc(ErlDrvPDL pdl) +{ + erts_atomic_inc(&pdl->refc); + ERTS_LC_ASSERT(driver_pdl_get_refc(pdl) > 1); +} + +static ERTS_INLINE long +pdl_inctest_refc(ErlDrvPDL pdl) +{ + long refc = erts_atomic_inctest(&pdl->refc); + ERTS_LC_ASSERT(refc > 1); + return refc; +} + +#if 0 /* unused */ +static ERTS_INLINE void +pdl_dec_refc(ErlDrvPDL pdl) +{ + erts_atomic_dec(&pdl->refc); + ERTS_LC_ASSERT(driver_pdl_get_refc(pdl) > 0); +} +#endif + +static ERTS_INLINE long +pdl_dectest_refc(ErlDrvPDL pdl) +{ + long refc = erts_atomic_dectest(&pdl->refc); + ERTS_LC_ASSERT(refc >= 0); + return refc; +} + +static ERTS_INLINE void pdl_destroy(ErlDrvPDL pdl) +{ + ERTS_LC_ASSERT(driver_pdl_get_refc(pdl) == 0); + erts_mtx_destroy(&pdl->mtx); + erts_free(ERTS_ALC_T_PORT_DATA_LOCK, pdl); +} + +/* + * exported driver_pdl_* functions ... + */ + +ErlDrvPDL +driver_pdl_create(ErlDrvPort dp) +{ + ErlDrvPDL pdl; + Port *pp = erts_drvport2port(dp); + if (!pp || pp->port_data_lock) + return NULL; + pdl = erts_alloc(ERTS_ALC_T_PORT_DATA_LOCK, + sizeof(struct erl_drv_port_data_lock)); + erts_mtx_init(&pdl->mtx, "port_data_lock"); + pdl_init_refc(pdl); + pp->port_data_lock = pdl; +#ifdef HARDDEBUG + erts_fprintf(stderr, "driver_pdl_create(%T) -> 0x%08X\r\n",pp->id,(unsigned) pdl); +#endif + return pdl; +} + +void +driver_pdl_lock(ErlDrvPDL pdl) +{ +#ifdef HARDDEBUG + erts_fprintf(stderr, "driver_pdl_lock(0x%08X)\r\n",(unsigned) pdl); +#endif + pdl_inc_refc(pdl); + erts_mtx_lock(&pdl->mtx); +} + +void +driver_pdl_unlock(ErlDrvPDL pdl) +{ + long refc; +#ifdef HARDDEBUG + erts_fprintf(stderr, "driver_pdl_unlock(0x%08X)\r\n",(unsigned) pdl); +#endif + erts_mtx_unlock(&pdl->mtx); + refc = pdl_dectest_refc(pdl); + if (!refc) + pdl_destroy(pdl); +} + +long +driver_pdl_get_refc(ErlDrvPDL pdl) +{ + return pdl_read_refc(pdl); +} + +long +driver_pdl_inc_refc(ErlDrvPDL pdl) +{ + long refc = pdl_inctest_refc(pdl); +#ifdef HARDDEBUG + erts_fprintf(stderr, "driver_pdl_inc_refc(0x%08X) -> %ld\r\n",(unsigned) pdl, refc); +#endif + return refc; +} + +long +driver_pdl_dec_refc(ErlDrvPDL pdl) +{ + long refc = pdl_dectest_refc(pdl); +#ifdef HARDDEBUG + erts_fprintf(stderr, "driver_pdl_dec_refc(0x%08X) -> %ld\r\n",(unsigned) pdl, refc); +#endif + if (!refc) + pdl_destroy(pdl); + return refc; +} + +/* expand queue to hold n elements in tail or head */ +static int expandq(ErlIOQueue* q, int n, int tail) +/* tail: 0 if make room in head, make room in tail otherwise */ +{ + int h_sz; /* room before header */ + int t_sz; /* room after tail */ + int q_sz; /* occupied */ + int nvsz; + SysIOVec* niov; + ErlDrvBinary** nbinv; + + h_sz = q->v_head - q->v_start; + t_sz = q->v_end - q->v_tail; + q_sz = q->v_tail - q->v_head; + + if (tail && (n <= t_sz)) /* do we need to expand tail? */ + return 0; + else if (!tail && (n <= h_sz)) /* do we need to expand head? */ + return 0; + else if (n > (h_sz + t_sz)) { /* need to allocate */ + /* we may get little extra but it ok */ + nvsz = (q->v_end - q->v_start) + n; + + niov = erts_alloc_fnf(ERTS_ALC_T_IOQ, nvsz * sizeof(SysIOVec)); + if (!niov) + return -1; + nbinv = erts_alloc_fnf(ERTS_ALC_T_IOQ, nvsz * sizeof(ErlDrvBinary**)); + if (!nbinv) { + erts_free(ERTS_ALC_T_IOQ, (void *) niov); + return -1; + } + if (tail) { + sys_memcpy(niov, q->v_head, q_sz*sizeof(SysIOVec)); + if (q->v_start != q->v_small) + erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start); + q->v_start = niov; + q->v_end = niov + nvsz; + q->v_head = q->v_start; + q->v_tail = q->v_head + q_sz; + + sys_memcpy(nbinv, q->b_head, q_sz*sizeof(ErlDrvBinary*)); + if (q->b_start != q->b_small) + erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start); + q->b_start = nbinv; + q->b_end = nbinv + nvsz; + q->b_head = q->b_start; + q->b_tail = q->b_head + q_sz; + } + else { + sys_memcpy(niov+nvsz-q_sz, q->v_head, q_sz*sizeof(SysIOVec)); + if (q->v_start != q->v_small) + erts_free(ERTS_ALC_T_IOQ, (void *) q->v_start); + q->v_start = niov; + q->v_end = niov + nvsz; + q->v_tail = q->v_end; + q->v_head = q->v_tail - q_sz; + + sys_memcpy(nbinv+nvsz-q_sz, q->b_head, q_sz*sizeof(ErlDrvBinary*)); + if (q->b_start != q->b_small) + erts_free(ERTS_ALC_T_IOQ, (void *) q->b_start); + q->b_start = nbinv; + q->b_end = nbinv + nvsz; + q->b_tail = q->b_end; + q->b_head = q->b_tail - q_sz; + } + } + else if (tail) { /* move to beginning to make room in tail */ + sys_memmove(q->v_start, q->v_head, q_sz*sizeof(SysIOVec)); + q->v_head = q->v_start; + q->v_tail = q->v_head + q_sz; + sys_memmove(q->b_start, q->b_head, q_sz*sizeof(ErlDrvBinary*)); + q->b_head = q->b_start; + q->b_tail = q->b_head + q_sz; + } + else { /* move to end to make room */ + sys_memmove(q->v_end-q_sz, q->v_head, q_sz*sizeof(SysIOVec)); + q->v_tail = q->v_end; + q->v_head = q->v_tail-q_sz; + sys_memmove(q->b_end-q_sz, q->b_head, q_sz*sizeof(ErlDrvBinary*)); + q->b_tail = q->b_end; + q->b_head = q->b_tail-q_sz; + } + + return 0; +} + + + +/* Put elements from vec at q tail */ +int driver_enqv(ErlDrvPort ix, ErlIOVec* vec, int skip) +{ + int n; + int len; + int size; + SysIOVec* iov; + ErlDrvBinary** binv; + ErlDrvBinary* b; + ErlIOQueue* q = drvport2ioq(ix); + + if (q == NULL) + return -1; + + size = vec->size - skip; + ASSERT(size >= 0); /* debug only */ + if (size <= 0) + return 0; + + iov = vec->iov; + binv = vec->binv; + n = vec->vsize; + + /* we use do here to strip iov_len=0 from beginning */ + do { + len = iov->iov_len; + if (len <= skip) { + skip -= len; + iov++; + binv++; + n--; + } + else { + iov->iov_base += skip; + iov->iov_len -= skip; + skip = 0; + } + } while(skip > 0); + + if (q->v_tail + n >= q->v_end) + expandq(q, n, 1); + + /* Queue and reference all binaries (remove zero length items) */ + while(n--) { + if ((len = iov->iov_len) > 0) { + if ((b = *binv) == NULL) { /* speical case create binary ! */ + b = driver_alloc_binary(len); + sys_memcpy(b->orig_bytes, iov->iov_base, len); + *q->b_tail++ = b; + q->v_tail->iov_len = len; + q->v_tail->iov_base = b->orig_bytes; + q->v_tail++; + } + else { + driver_binary_inc_refc(b); + *q->b_tail++ = b; + *q->v_tail++ = *iov; + } + } + iov++; + binv++; + } + q->size += size; /* update total size in queue */ + return 0; +} + +/* Put elements from vec at q head */ +int driver_pushqv(ErlDrvPort ix, ErlIOVec* vec, int skip) +{ + int n; + int len; + int size; + SysIOVec* iov; + ErlDrvBinary** binv; + ErlDrvBinary* b; + ErlIOQueue* q = drvport2ioq(ix); + + if (q == NULL) + return -1; + + if ((size = vec->size - skip) <= 0) + return 0; + iov = vec->iov; + binv = vec->binv; + n = vec->vsize; + + /* we use do here to strip iov_len=0 from beginning */ + do { + len = iov->iov_len; + if (len <= skip) { + skip -= len; + iov++; + binv++; + n--; + } + else { + iov->iov_base += skip; + iov->iov_len -= skip; + skip = 0; + } + } while(skip > 0); + + if (q->v_head - n < q->v_start) + expandq(q, n, 0); + + /* Queue and reference all binaries (remove zero length items) */ + iov += (n-1); /* move to end */ + binv += (n-1); /* move to end */ + while(n--) { + if ((len = iov->iov_len) > 0) { + if ((b = *binv) == NULL) { /* speical case create binary ! */ + b = driver_alloc_binary(len); + sys_memcpy(b->orig_bytes, iov->iov_base, len); + *--q->b_head = b; + q->v_head--; + q->v_head->iov_len = len; + q->v_head->iov_base = b->orig_bytes; + } + else { + driver_binary_inc_refc(b); + *--q->b_head = b; + *--q->v_head = *iov; + } + } + iov--; + binv--; + } + q->size += size; /* update total size in queue */ + return 0; +} + + +/* +** Remove size bytes from queue head +** Return number of bytes that remain in queue +*/ +int driver_deq(ErlDrvPort ix, int size) +{ + ErlIOQueue* q = drvport2ioq(ix); + int len; + int sz; + + if ((q == NULL) || (sz = (q->size - size)) < 0) + return -1; + q->size = sz; + while (size > 0) { + ASSERT(q->v_head != q->v_tail); + + len = q->v_head->iov_len; + if (len <= size) { + size -= len; + driver_free_binary(*q->b_head); + *q->b_head++ = NULL; + q->v_head++; + } + else { + q->v_head->iov_base += size; + q->v_head->iov_len -= size; + size = 0; + } + } + + /* restart pointers (optimised for enq) */ + if (q->v_head == q->v_tail) { + q->v_head = q->v_tail = q->v_start; + q->b_head = q->b_tail = q->b_start; + } + return sz; +} + + +int driver_peekqv(ErlDrvPort ix, ErlIOVec *ev) { + ErlIOQueue *q = drvport2ioq(ix); + ASSERT(ev); + + if (! q) { + return -1; + } else { + if ((ev->vsize = q->v_tail - q->v_head) == 0) { + ev->size = 0; + ev->iov = NULL; + ev->binv = NULL; + } else { + ev->size = q->size; + ev->iov = q->v_head; + ev->binv = q->b_head; + } + return q->size; + } +} + +SysIOVec* driver_peekq(ErlDrvPort ix, int* vlenp) /* length of io-vector */ +{ + ErlIOQueue* q = drvport2ioq(ix); + + if (q == NULL) { + *vlenp = -1; + return NULL; + } + if ((*vlenp = (q->v_tail - q->v_head)) == 0) + return NULL; + return q->v_head; +} + + +int driver_sizeq(ErlDrvPort ix) +{ + ErlIOQueue* q = drvport2ioq(ix); + + if (q == NULL) + return -1; + return q->size; +} + + +/* Utils */ + +/* Enqueue a binary */ +int driver_enq_bin(ErlDrvPort ix, ErlDrvBinary* bin, int offs, int len) +{ + SysIOVec iov; + ErlIOVec ev; + + ASSERT(len >= 0); + if (len == 0) + return 0; + iov.iov_base = bin->orig_bytes + offs; + iov.iov_len = len; + ev.vsize = 1; + ev.size = len; + ev.iov = &iov; + ev.binv = &bin; + return driver_enqv(ix, &ev, 0); +} + +int driver_enq(ErlDrvPort ix, char* buffer, int len) +{ + int code; + ErlDrvBinary* bin; + + ASSERT(len >= 0); + if (len == 0) + return 0; + if ((bin = driver_alloc_binary(len)) == NULL) + return -1; + sys_memcpy(bin->orig_bytes, buffer, len); + code = driver_enq_bin(ix, bin, 0, len); + driver_free_binary(bin); /* dereference */ + return code; +} + +int driver_pushq_bin(ErlDrvPort ix, ErlDrvBinary* bin, int offs, int len) +{ + SysIOVec iov; + ErlIOVec ev; + + ASSERT(len >= 0); + if (len == 0) + return 0; + iov.iov_base = bin->orig_bytes + offs; + iov.iov_len = len; + ev.vsize = 1; + ev.size = len; + ev.iov = &iov; + ev.binv = &bin; + return driver_pushqv(ix, &ev, 0); +} + +int driver_pushq(ErlDrvPort ix, char* buffer, int len) +{ + int code; + ErlDrvBinary* bin; + + ASSERT(len >= 0); + if (len == 0) + return 0; + + if ((bin = driver_alloc_binary(len)) == NULL) + return -1; + sys_memcpy(bin->orig_bytes, buffer, len); + code = driver_pushq_bin(ix, bin, 0, len); + driver_free_binary(bin); /* dereference */ + return code; +} + +static ERTS_INLINE void +drv_cancel_timer(Port *prt) +{ +#ifdef ERTS_SMP + erts_cancel_smp_ptimer(prt->ptimer); +#else + erl_cancel_timer(&prt->tm); +#endif + if (erts_port_task_is_scheduled(&prt->timeout_task)) + erts_port_task_abort(prt->id, &prt->timeout_task); +} + +int driver_set_timer(ErlDrvPort ix, Uint t) +{ + Port* prt = erts_drvport2port(ix); + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if (prt == NULL) + return -1; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + if (prt->drv_ptr->timeout == NULL) + return -1; + drv_cancel_timer(prt); +#ifdef ERTS_SMP + erts_create_smp_ptimer(&prt->ptimer, + prt->id, + (ErlTimeoutProc) schedule_port_timeout, + t); +#else + erl_set_timer(&prt->tm, + (ErlTimeoutProc) schedule_port_timeout, + NULL, + prt, + t); +#endif + return 0; +} + +int driver_cancel_timer(ErlDrvPort ix) +{ + Port* prt = erts_drvport2port(ix); + if (prt == NULL) + return -1; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + drv_cancel_timer(prt); + return 0; +} + + +int +driver_read_timer(ErlDrvPort ix, unsigned long* t) +{ + Port* prt = erts_drvport2port(ix); + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if (prt == NULL) + return -1; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); +#ifdef ERTS_SMP + *t = prt->ptimer ? time_left(&prt->ptimer->timer.tm) : 0; +#else + *t = time_left(&prt->tm); +#endif + return 0; +} + +int +driver_get_now(ErlDrvNowData *now_data) +{ + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if (now_data == NULL) { + return -1; + } + get_now(&(now_data->megasecs),&(now_data->secs),&(now_data->microsecs)); + return 0; +} + +static void ref_to_driver_monitor(Eterm ref, ErlDrvMonitor *mon) +{ + RefThing *refp; + ASSERT(is_internal_ref(ref)); + ASSERT(sizeof(RefThing) <= sizeof(ErlDrvMonitor)); + refp = ref_thing_ptr(ref); + memset(mon,0,sizeof(ErlDrvMonitor)); + memcpy(mon,refp,sizeof(RefThing)); +} + +int driver_monitor_process(ErlDrvPort port, + ErlDrvTermData process, + ErlDrvMonitor *monitor) +{ + Port *prt = erts_drvport2port(port); + Process *rp; + Eterm ref; + Eterm buf[REF_THING_SIZE]; + if (prt->drv_ptr->process_exit == NULL) { + return -1; + } + rp = erts_pid2proc_opt(NULL, 0, + (Eterm) process, ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + if (!rp) { + return 1; + } + ref = erts_make_ref_in_buffer(buf); + erts_add_monitor(&(prt->monitors), MON_ORIGIN, ref, rp->id, NIL); + erts_add_monitor(&(rp->monitors), MON_TARGET, ref, prt->id, NIL); + + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + ref_to_driver_monitor(ref,monitor); + return 0; +} + +int driver_demonitor_process(ErlDrvPort port, + const ErlDrvMonitor *monitor) +{ + Port *prt = erts_drvport2port(port); + Process *rp; + Eterm ref; + Eterm buf[REF_THING_SIZE]; + ErtsMonitor *mon; + Eterm to; + + memcpy(buf,monitor,sizeof(Eterm)*REF_THING_SIZE); + ref = make_internal_ref(buf); + mon = erts_lookup_monitor(prt->monitors, ref); + if (mon == NULL) { + return 1; + } + ASSERT(mon->type == MON_ORIGIN); + to = mon->pid; + ASSERT(is_internal_pid(to)); + rp = erts_pid2proc_opt(NULL, + 0, + to, + ERTS_PROC_LOCK_LINK, + ERTS_P2P_FLG_ALLOW_OTHER_X); + mon = erts_remove_monitor(&(prt->monitors), ref); + if (mon) { + erts_destroy_monitor(mon); + } + if (rp) { + ErtsMonitor *rmon; + rmon = erts_remove_monitor(&(rp->monitors), ref); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); + if (rmon != NULL) { + erts_destroy_monitor(rmon); + } + } + return 0; +} + +ErlDrvTermData driver_get_monitored_process(ErlDrvPort port, + const ErlDrvMonitor *monitor) +{ + Port *prt = erts_drvport2port(port); + Eterm ref; + Eterm buf[REF_THING_SIZE]; + ErtsMonitor *mon; + Eterm to; + + memcpy(buf,monitor,sizeof(Eterm)*REF_THING_SIZE); + ref = make_internal_ref(buf); + mon = erts_lookup_monitor(prt->monitors, ref); + if (mon == NULL) { + return driver_term_nil; + } + ASSERT(mon->type == MON_ORIGIN); + to = mon->pid; + ASSERT(is_internal_pid(to)); + return (ErlDrvTermData) to; +} + +int driver_compare_monitors(const ErlDrvMonitor *monitor1, + const ErlDrvMonitor *monitor2) +{ + return memcmp(monitor1,monitor2,sizeof(ErlDrvMonitor)); +} + +void erts_fire_port_monitor(Port *prt, Eterm ref) +{ + ErtsMonitor *rmon; + void (*callback)(ErlDrvData drv_data, ErlDrvMonitor *monitor); + ErlDrvMonitor drv_monitor; + int fpe_was_unmasked; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + ASSERT(prt->drv_ptr != NULL); + + if (erts_lookup_monitor(prt->monitors,ref) == NULL) { + return; + } + callback = prt->drv_ptr->process_exit; + ASSERT(callback != NULL); + ref_to_driver_monitor(ref,&drv_monitor); + fpe_was_unmasked = erts_block_fpe(); + (*callback)((ErlDrvData) (prt->drv_data), &drv_monitor); + erts_unblock_fpe(fpe_was_unmasked); + /* remove monitor *after* callback */ + rmon = erts_remove_monitor(&(prt->monitors),ref); + if (rmon) { + erts_destroy_monitor(rmon); + } +} + + +static int +driver_failure_term(ErlDrvPort ix, Eterm term, int eof) +{ + Port* prt = erts_drvport2port(ix); + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if (prt == NULL) + return -1; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + if (eof) + flush_linebuf_messages(prt); + if (prt->status & ERTS_PORT_SFLG_CLOSING) { + terminate_port(prt); + } else if (eof && (prt->status & ERTS_PORT_SFLG_SOFT_EOF)) { + deliver_result(prt->id, prt->connected, am_eof); + } else { + /* XXX UGLY WORK AROUND, Let do_exit_port terminate the port */ + if (prt->port_data_lock) + driver_pdl_lock(prt->port_data_lock); + prt->ioq.size = 0; + if (prt->port_data_lock) + driver_pdl_unlock(prt->port_data_lock); + erts_do_exit_port(prt, prt->id, eof ? am_normal : term); + } + return 0; +} + + + +/* +** Do a (soft) exit. unlink the connected process before doing +** driver posix error or (normal) +*/ +int driver_exit(ErlDrvPort ix, int err) +{ + Port* prt = erts_drvport2port(ix); + Process* rp; + ErtsLink *lnk, *rlnk = NULL; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + if (prt == NULL) + return -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + + rp = erts_pid2proc(NULL, 0, prt->connected, ERTS_PROC_LOCK_LINK); + if (rp) { + rlnk = erts_remove_link(&(rp->nlinks),prt->id); + } + + lnk = erts_remove_link(&(prt->nlinks),prt->connected); + +#ifdef ERTS_SMP + if (rp) + erts_smp_proc_unlock(rp, ERTS_PROC_LOCK_LINK); +#endif + + if (rlnk != NULL) { + erts_destroy_link(rlnk); + } + + if (lnk != NULL) { + erts_destroy_link(lnk); + } + + if (err == 0) + return driver_failure_term(ix, am_normal, 0); + else { + char* err_str = erl_errno_id(err); + Eterm am_err = am_atom_put(err_str, sys_strlen(err_str)); + return driver_failure_term(ix, am_err, 0); + } +} + + +int driver_failure(ErlDrvPort ix, int code) +{ + return driver_failure_term(ix, make_small(code), code == 0); +} + +int driver_failure_atom(ErlDrvPort ix, char* string) +{ + Eterm am = am_atom_put(string, strlen(string)); + return driver_failure_term(ix, am, 0); +} + +int driver_failure_posix(ErlDrvPort ix, int err) +{ + return driver_failure_atom(ix, erl_errno_id(err)); +} + +int driver_failure_eof(ErlDrvPort ix) +{ + return driver_failure_term(ix, NIL, 1); +} + + + +ErlDrvTermData driver_mk_atom(char* string) +{ + Eterm am = am_atom_put(string, sys_strlen(string)); + ERTS_SMP_CHK_NO_PROC_LOCKS; + return (ErlDrvTermData) am; +} + +ErlDrvTermData driver_mk_port(ErlDrvPort ix) +{ + Port* prt = erts_drvport2port(ix); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + return (ErlDrvTermData) prt->id; +} + +ErlDrvTermData driver_connected(ErlDrvPort ix) +{ + Port* prt = erts_drvport2port(ix); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (prt == NULL) + return NIL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + return prt->connected; +} + +ErlDrvTermData driver_caller(ErlDrvPort ix) +{ + Port* prt = erts_drvport2port(ix); + ERTS_SMP_CHK_NO_PROC_LOCKS; + if (prt == NULL) + return NIL; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + return prt->caller; +} + +int driver_lock_driver(ErlDrvPort ix) +{ + Port* prt = erts_drvport2port(ix); + DE_Handle* dh; + + ERTS_SMP_CHK_NO_PROC_LOCKS; + + erts_smp_mtx_lock(&erts_driver_list_lock); + + if (prt == NULL) return -1; + + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(prt)); + if ((dh = (DE_Handle*)prt->drv_ptr->handle ) == NULL) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + return -1; + } + erts_ddll_lock_driver(dh, prt->drv_ptr->name); + erts_smp_mtx_unlock(&erts_driver_list_lock); + return 0; +} + + +static int maybe_lock_driver_list(void) +{ + void *rec_lock; + rec_lock = erts_smp_tsd_get(driver_list_lock_status_key); + if (rec_lock == 0) { + erts_smp_mtx_lock(&erts_driver_list_lock); + return 1; + } + return 0; +} +static void maybe_unlock_driver_list(int doit) +{ + if (doit) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + } +} +/* + These old interfaces are certainly not MT friendly. Hopefully they are only used internally, + but you never know, so they are kept for BC. As The sys ddll code has no notion + of locking, I use the driver list lock to mutex this from the code in erl_bif_ddll.c. + To allow dynamic code loading in the init functions of a driver, recursive locking is + handled as in add_driver_entry etc. + A TSD variable holds the last error for a thread, so that code like + ... + x = driver_dl_open(...); + if (x == NULL) + y = driver_dl_error(); + ... + works as long as execution happens in one driver callback even in an SMP emulator. + Writing code using these interfaces spanning several driver callbacks between loading/lookup + and error handling may give undesired results... +*/ +void *driver_dl_open(char * path) +{ + void *ptr; + int res; + int *last_error_p = erts_smp_tsd_get(driver_list_last_error_key); + int locked = maybe_lock_driver_list(); + if ((res = erts_sys_ddll_open(path, &ptr)) == 0) { + maybe_unlock_driver_list(locked); + return ptr; + } else { + if (!last_error_p) { + last_error_p = erts_alloc(ERTS_ALC_T_DDLL_ERRCODES, sizeof(int)); + erts_smp_tsd_set(driver_list_last_error_key,last_error_p); + } + *last_error_p = res; + maybe_unlock_driver_list(locked); + return NULL; + } +} + +void *driver_dl_sym(void * handle, char *func_name) +{ + void *ptr; + int res; + int *last_error_p = erts_smp_tsd_get(driver_list_lock_status_key); + int locked = maybe_lock_driver_list(); + if ((res = erts_sys_ddll_sym(handle, func_name, &ptr)) == 0) { + maybe_unlock_driver_list(locked); + return ptr; + } else { + if (!last_error_p) { + last_error_p = erts_alloc(ERTS_ALC_T_DDLL_ERRCODES, sizeof(int)); + erts_smp_tsd_set(driver_list_lock_status_key,last_error_p); + } + *last_error_p = res; + maybe_unlock_driver_list(locked); + return NULL; + } +} + +int driver_dl_close(void *handle) +{ + int res; + int locked = maybe_lock_driver_list(); + res = erts_sys_ddll_close(handle); + maybe_unlock_driver_list(locked); + return res; +} + +char *driver_dl_error(void) +{ + char *res; + int *last_error_p = erts_smp_tsd_get(driver_list_lock_status_key); + int locked = maybe_lock_driver_list(); + res = erts_ddll_error((last_error_p != NULL) ? (*last_error_p) : ERL_DE_ERROR_UNSPECIFIED); + maybe_unlock_driver_list(locked); + return res; +} + + +#define ERL_DRV_SYS_INFO_SIZE(LAST_FIELD) \ + (((size_t) &((ErlDrvSysInfo *) 0)->LAST_FIELD) \ + + sizeof(((ErlDrvSysInfo *) 0)->LAST_FIELD)) + +void +driver_system_info(ErlDrvSysInfo *sip, size_t si_size) +{ + /* + * When adding fields in the ErlDrvSysInfo struct + * remember to increment ERL_DRV_EXTENDED_MINOR_VERSION + */ + + /* + * 'smp_support' is the last field in the first version + * of ErlDrvSysInfo (introduced in driver version 1.0). + */ + if (!sip || si_size < ERL_DRV_SYS_INFO_SIZE(smp_support)) + erl_exit(1, + "driver_system_info(%p, %ld) called with invalid arguments\n", + sip, si_size); + + /* + * 'smp_support' is the last field in the first version + * of ErlDrvSysInfo (introduced in driver version 1.0). + */ + if (si_size >= ERL_DRV_SYS_INFO_SIZE(smp_support)) { + sip->driver_major_version = ERL_DRV_EXTENDED_MAJOR_VERSION; + sip->driver_minor_version = ERL_DRV_EXTENDED_MINOR_VERSION; + sip->erts_version = ERLANG_VERSION; + sip->otp_release = ERLANG_OTP_RELEASE; + sip->thread_support = +#ifdef USE_THREADS + 1 +#else + 0 +#endif + ; + sip->smp_support = +#ifdef ERTS_SMP + 1 +#else + 0 +#endif + ; + + } + + /* + * 'scheduler_threads' is the last field in the second version + * of ErlDrvSysInfo (introduced in driver version 1.1). + */ + if (si_size >= ERL_DRV_SYS_INFO_SIZE(scheduler_threads)) { + sip->async_threads = erts_async_max_threads; + sip->scheduler_threads = erts_no_schedulers; + } + +} + + +static ERTS_INLINE Port * +get_current_port(void) +{ + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + ASSERT(esdp); + ASSERT(esdp->current_port); + return esdp->current_port; +} + +/* + * Default callbacks used if not supplied by driver. + */ + +static void +no_output_callback(ErlDrvData drv_data, char *buf, int len) +{ + +} + +static void +no_event_callback(ErlDrvData drv_data, ErlDrvEvent event, ErlDrvEventData event_data) +{ + Port *prt = get_current_port(); + report_missing_drv_callback(prt, "Event", "event()"); + driver_event((ErlDrvPort) internal_port_index(prt->id), event, NULL); +} + +static void +no_ready_input_callback(ErlDrvData drv_data, ErlDrvEvent event) +{ + Port *prt = get_current_port(); + report_missing_drv_callback(prt, "Input", "ready_input()"); + driver_select((ErlDrvPort) internal_port_index(prt->id), event, + (ERL_DRV_READ | ERL_DRV_USE_NO_CALLBACK), 0); +} + +static void +no_ready_output_callback(ErlDrvData drv_data, ErlDrvEvent event) +{ + Port *prt = get_current_port(); + report_missing_drv_callback(prt, "Output", "ready_output()"); + driver_select((ErlDrvPort) internal_port_index(prt->id), event, + (ERL_DRV_WRITE | ERL_DRV_USE_NO_CALLBACK), 0); +} + +static void +no_timeout_callback(ErlDrvData drv_data) +{ + +} + +static void +no_stop_select_callback(ErlDrvEvent event, void* private) +{ + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "Driver does not implement stop_select callback " + "(event=%ld, private=%p)!\n", (long)event, private); + erts_send_error_to_logger_nogl(dsbufp); +} + + +static int +init_driver(erts_driver_t *drv, ErlDrvEntry *de, DE_Handle *handle) +{ + drv->name = de->driver_name; + if (de->extended_marker == ERL_DRV_EXTENDED_MARKER) { + drv->version.major = de->major_version; + drv->version.minor = de->minor_version; + drv->flags = de->driver_flags; + } + else { + drv->version.major = 0; + drv->version.minor = 0; + drv->flags = 0; + } + drv->handle = handle; +#ifdef ERTS_SMP + if (drv->flags & ERL_DRV_FLAG_USE_PORT_LOCKING) + drv->lock = NULL; + else { + drv->lock = erts_alloc(ERTS_ALC_T_DRIVER_LOCK, + sizeof(erts_smp_mtx_t)); + erts_smp_mtx_init_x(drv->lock, + "driver_lock", +#if defined(ERTS_ENABLE_LOCK_CHECK) || defined(ERTS_ENABLE_LOCK_COUNT) + am_atom_put(drv->name, sys_strlen(drv->name)) +#else + NIL +#endif + ); + } +#endif + drv->entry = de; + + drv->start = de->start; + drv->stop = de->stop; + drv->finish = de->finish; + drv->flush = de->flush; + drv->output = de->output ? de->output : no_output_callback; + drv->outputv = de->outputv; + drv->control = de->control; + drv->call = de->call; + drv->event = de->event ? de->event : no_event_callback; + drv->ready_input = de->ready_input ? de->ready_input : no_ready_input_callback; + drv->ready_output = de->ready_output ? de->ready_output : no_ready_output_callback; + drv->timeout = de->timeout ? de->timeout : no_timeout_callback; + drv->ready_async = de->ready_async; + if (de->extended_marker == ERL_DRV_EXTENDED_MARKER) + drv->process_exit = de->process_exit; + else + drv->process_exit = NULL; + if (de->minor_version >= 3/*R13A*/ && de->stop_select) + drv->stop_select = de->stop_select; + else + drv->stop_select = no_stop_select_callback; + + if (!de->init) + return 0; + else { + int res; + int fpe_was_unmasked = erts_block_fpe(); + res = (*de->init)(); + erts_unblock_fpe(fpe_was_unmasked); + return res; + } +} + +void +erts_destroy_driver(erts_driver_t *drv) +{ +#ifdef ERTS_SMP + if (drv->lock) { + erts_smp_mtx_destroy(drv->lock); + erts_free(ERTS_ALC_T_DRIVER_LOCK, drv->lock); + } +#endif + erts_free(ERTS_ALC_T_DRIVER, drv); +} + +/* + * Functions for maintaining a list of driver_entry struct + * Exposed in the driver interface, and therefore possibly locking directly. + */ + +void add_driver_entry(ErlDrvEntry *drv){ + void *rec_lock; + rec_lock = erts_smp_tsd_get(driver_list_lock_status_key); + /* + * Ignore result of erts_add_driver_entry, the init is not + * allowed to fail when drivers are added by drivers. + */ + erts_add_driver_entry(drv, NULL, rec_lock != NULL); +} + +int erts_add_driver_entry(ErlDrvEntry *de, DE_Handle *handle, int driver_list_locked) +{ + erts_driver_t *dp = erts_alloc(ERTS_ALC_T_DRIVER, sizeof(erts_driver_t)); + int res; + + if (!driver_list_locked) { + erts_smp_mtx_lock(&erts_driver_list_lock); + } + + dp->next = driver_list; + dp->prev = NULL; + if (driver_list != NULL) { + driver_list->prev = dp; + } + driver_list = dp; + + if (!driver_list_locked) { + erts_smp_tsd_set(driver_list_lock_status_key, (void *) 1); + } + + res = init_driver(dp, de, handle); + + if (res != 0) { + /* + * Remove it all again... + */ + driver_list = dp->next; + if (driver_list != NULL) { + driver_list->prev = NULL; + } + erts_destroy_driver(dp); + } + + if (!driver_list_locked) { + erts_smp_tsd_set(driver_list_lock_status_key, NULL); + erts_smp_mtx_unlock(&erts_driver_list_lock); + } + return res; +} + +/* Not allowed for dynamic drivers */ +int remove_driver_entry(ErlDrvEntry *drv) +{ + erts_driver_t *dp; + void *rec_lock; + + rec_lock = erts_smp_tsd_get(driver_list_lock_status_key); + if (rec_lock == NULL) { + erts_smp_mtx_lock(&erts_driver_list_lock); + } + dp = driver_list; + while (dp && dp->entry != drv) + dp = dp->next; + if (dp) { + if (dp->handle) { + if (rec_lock == NULL) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + } + return -1; + } + if (dp->prev == NULL) { + driver_list = dp->next; + } else { + dp->prev->next = dp->next; + } + if (dp->next != NULL) { + dp->next->prev = dp->prev; + } + erts_destroy_driver(dp); + if (rec_lock == NULL) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + } + return 1; + } + if (rec_lock == NULL) { + erts_smp_mtx_unlock(&erts_driver_list_lock); + } + return 0; +} + +/* very useful function that can be used in entries that are not used + * so that not every driver writer must supply a personal version + */ +int null_func(void) +{ + return 0; +} + +int +erl_drv_putenv(char *key, char *value) +{ + return erts_write_env(key, value); +} + +int +erl_drv_getenv(char *key, char *value, size_t *value_size) +{ + return erts_sys_getenv(key, value, value_size); +} diff --git a/erts/emulator/beam/module.c b/erts/emulator/beam/module.c new file mode 100644 index 0000000000..57a43c89f4 --- /dev/null +++ b/erts/emulator/beam/module.c @@ -0,0 +1,134 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "module.h" + +#define MODULE_SIZE 50 +#define MODULE_LIMIT (64*1024) + +static IndexTable module_table; + +/* + * SMP note: We don't need to look accesses to the module table because + * there is one only scheduler thread when we update it. + */ + +#include "erl_smp.h" + +void module_info(int to, void *to_arg) +{ + index_info(to, to_arg, &module_table); +} + + +static HashValue module_hash(Module* x) +{ + return (HashValue) x->module; +} + + +static int module_cmp(Module* tmpl, Module* obj) +{ + return tmpl->module != obj->module; +} + + +static Module* module_alloc(Module* tmpl) +{ + Module* obj = (Module*) erts_alloc(ERTS_ALC_T_MODULE, sizeof(Module)); + + obj->module = tmpl->module; + obj->code = 0; + obj->old_code = 0; + obj->code_length = 0; + obj->old_code_length = 0; + obj->slot.index = -1; + obj->nif.handle = NULL; + obj->old_nif.handle = NULL; + obj->nif.entry = NULL; + obj->old_nif.entry = NULL; + obj->nif.data = NULL; + obj->old_nif.data = NULL; + return obj; +} + + +void init_module_table(void) +{ + HashFunctions f; + + f.hash = (H_FUN) module_hash; + f.cmp = (HCMP_FUN) module_cmp; + f.alloc = (HALLOC_FUN) module_alloc; + f.free = 0; + + erts_index_init(ERTS_ALC_T_MODULE_TABLE, &module_table, "module_code", + MODULE_SIZE, MODULE_LIMIT, f); +} + +Module* +erts_get_module(Eterm mod) +{ + Module e; + int index; + + ASSERT(is_atom(mod)); + e.module = atom_val(mod); + index = index_get(&module_table, (void*) &e); + if (index == -1) { + return NULL; + } else { + return (Module*) erts_index_lookup(&module_table, index); + } +} + +Module* +erts_put_module(Eterm mod) +{ + Module e; + int index; + + ASSERT(is_atom(mod)); + ERTS_SMP_LC_ASSERT(erts_initialized == 0 || erts_smp_is_system_blocked(0)); + e.module = atom_val(mod); + index = index_put(&module_table, (void*) &e); + return (Module*) erts_index_lookup(&module_table, index); +} + +Module *module_code(int i) +{ + return (Module*) erts_index_lookup(&module_table, i); +} + +int module_code_size(void) +{ + return module_table.entries; +} + +int module_table_sz(void) +{ + return index_table_sz(&module_table); +} diff --git a/erts/emulator/beam/module.h b/erts/emulator/beam/module.h new file mode 100644 index 0000000000..314be8e2ee --- /dev/null +++ b/erts/emulator/beam/module.h @@ -0,0 +1,56 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __MODULE_H__ +#define __MODULE_H__ + +#ifndef __INDEX_H__ +#include "index.h" +#endif + +struct erl_module_nif { + void* handle; + struct enif_entry_t* entry; + void* data; +}; + +typedef struct erl_module { + IndexSlot slot; /* Must be located at top of struct! */ + int module; /* Atom index for module (not tagged). */ + + Eterm* code; + Eterm* old_code; + int code_length; /* Length of loaded code in bytes. */ + int old_code_length; /* Length of old loaded code in bytes */ + unsigned catches, old_catches; + struct erl_module_nif nif; + struct erl_module_nif old_nif; +} Module; + +Module* erts_get_module(Eterm mod); +Module* erts_put_module(Eterm mod); + +void init_module_table(void); +void module_info(int, void *); + +Module *module_code(int); +int module_code_size(void); +int module_table_sz(void); + +#endif diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab new file mode 100644 index 0000000000..ce1df74f03 --- /dev/null +++ b/erts/emulator/beam/ops.tab @@ -0,0 +1,1430 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# +# The instructions that follows are only known by the loader and the emulator. +# They can be changed without recompiling old Beam files. +# +# Instructions starting with a "i_" prefix are instructions produced by +# instruction transformations; thus, they never occur in BEAM files. +# + +# Special instruction used to generate an error message when +# trying to load a module compiled by the V1 compiler (R5 & R6). +# (Specially treated in beam_load.c.) + +too_old_compiler/0 +too_old_compiler + +# +# Obsolete instruction usage follow. (Nowdays we use f with +# a zero label instead of p.) +# + +is_list p S => too_old_compiler +is_nonempty_list p R => too_old_compiler +is_nil p R => too_old_compiler + +is_tuple p S => too_old_compiler +test_arity p S Arity => too_old_compiler + +is_integer p R => too_old_compiler +is_float p R => too_old_compiler +is_atom p R => too_old_compiler + +is_eq_exact p S1 S2 => too_old_compiler + +# In R9C and earlier, the loader used to insert special instructions inside +# the module_info/0,1 functions. (In R10B and later, the compiler inserts +# an explicit call to an undocumented BIF, so that no loader trickery is +# necessary.) Since the instructions don't work correctly in R12B, simply +# refuse to load the module. + +func_info M=a a==am_module_info A=u==0 | label L | move n r => too_old_compiler +func_info M=a a==am_module_info A=u==1 | label L | move n r => too_old_compiler + +# The undocumented and unsupported guard BIF is_constant/1 was removed +# in R13. The is_constant/2 operation is marked as obosolete in genop.tab, +# so the loader will automatically generate a too_old_compiler message +# it is used, but we need to handle the is_constant/1 BIF specially here. + +bif1 Fail u$func:erlang:is_constant/1 Src Dst => too_old_compiler + + +# +# All the other instructions. +# + +label L +i_func_info I a a I +int_code_end + +i_trace_breakpoint +i_mtrace_breakpoint +i_debug_breakpoint +i_count_breakpoint +i_return_to_trace +i_yield +i_global_cons +i_global_tuple +i_global_copy + +return + +%macro: allocate Allocate -pack +%macro: allocate_zero AllocateZero -pack +%macro: allocate_heap AllocateHeap -pack +%macro: allocate_heap_zero AllocateHeapZero -pack +%macro: test_heap TestHeap -pack + +allocate t t +allocate_heap I I I +deallocate I +init y +allocate_zero t t +allocate_heap_zero I I I + +trim N Remaining => i_trim N +i_trim I + +test_heap I I + +allocate_heap S u==0 R => allocate S R +allocate_heap_zero S u==0 R => allocate_zero S R + +init2 y y +init3 y y y +init Y1 | init Y2 | init Y3 => init3 Y1 Y2 Y3 +init Y1 | init Y2 => init2 Y1 Y2 +%macro: init2 Init2 -pack +%macro: init3 Init3 -pack + +# +# Warning: The put_string instruction is specially treated in the loader. +# Don't change the instruction format unless you change the loader too. +# +put_string I I d + +# Selecting values + +select_val S=q Fail=f Size=u Rest=* => const_select_val(S, Fail, Size, Rest) + +select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \ + gen_jump_tab(S, Fail, Size, Rest) + +is_integer Fail=f S | select_val S=s Fail=f Size=u Rest=* | use_jump_tab(Size, Rest) => \ + gen_jump_tab(S, Fail, Size, Rest) + +select_val S=s Fail=f Size=u Rest=* | mixed_types(Size, Rest) => \ + gen_split_values(S, Fail, Size, Rest) + +is_integer Fail=f S | select_val S=s Fail=f Size=u Rest=* | \ + fixed_size_values(Size, Rest) => gen_select_val(S, Fail, Size, Rest) + +is_atom Fail=f S | select_val S=s Fail=f Size=u Rest=* | \ + fixed_size_values(Size, Rest) => gen_select_val(S, Fail, Size, Rest) + +select_val S=s Fail=f Size=u Rest=* | fixed_size_values(Size, Rest) => \ + gen_select_val(S, Fail, Size, Rest) + +select_val S=s Fail=f Size=u Rest=* | all_values_are_big(Size, Rest) => \ + gen_select_big(S, Fail, Size, Rest) + +is_tuple Fail=f S | select_tuple_arity S=s Fail=f Size=u Rest=* => \ + gen_select_tuple_arity(S, Fail, Size, Rest) + +select_tuple_arity S=s Fail=f Size=u Rest=* => \ + gen_select_tuple_arity(S, Fail, Size, Rest) + +i_select_val s f I +i_select_tuple_arity s f I +i_select_big s f +i_select_float s f I + +i_jump_on_val_zero s f I +i_jump_on_val s f I I + +%macro: get_list GetList -pack +get_list x x x +get_list x x y +get_list x x r +get_list x y x +get_list x y y +get_list x y r +get_list x r x +get_list x r y + +get_list y x x +get_list y x y +get_list y x r +get_list y y x +get_list y y y +get_list y y r +get_list y r x +get_list y r y + +get_list r x x +get_list r x y +get_list r x r +get_list r y x +get_list r y y +get_list r y r +get_list r r x +get_list r r y + +# Old-style catch. +catch y f +catch_end y + +# Try/catch. +try Y F => catch Y F +try_case Y => try_end Y +try_end y + +try_case_end Literal=q => move Literal x | try_case_end x +try_case_end s + +# Destructive set tuple element + +set_tuple_element Lit=q Tuple Pos => move Lit x | set_tuple_element x Tuple Pos +set_tuple_element s d P + +# Get tuple element + +%macro: i_get_tuple_element GetTupleElement -pack +i_get_tuple_element x P x +i_get_tuple_element r P x +i_get_tuple_element y P x +i_get_tuple_element x P r +i_get_tuple_element y P r + +%cold +i_get_tuple_element r P r +i_get_tuple_element x P y +i_get_tuple_element r P y +i_get_tuple_element y P y +%hot + +%macro: is_number IsNumber -fail_action +%cold +is_number f r +is_number f x +is_number f y +%hot +is_number Fail=f i => +is_number Fail=f na => jump Fail +is_number Fail Literal=q => move Literal x | is_number Fail x + +jump f + +case_end Literal=q => move Literal x | case_end x +badmatch Literal=q => move Literal x | badmatch x + +case_end s +badmatch s +if_end +raise s s + +# Internal now, but could be useful to make known to the compiler. +badarg j +system_limit j + +move R R => + +move X1=x Y1=y | move X2=x Y2=y => move2 X1 Y1 X2 Y2 +move Y1=y X1=x | move Y2=y X2=x => move2 Y1 X1 Y2 X2 + +%macro: move2 Move2 -pack +move2 x y x y +move2 y x y x + +%macro:move Move -pack -gen_dest +move x x +move x y +move x r +move y x +move y r +move r x +move r y +move c r +move c x +move c y +move n x +move n r +move y y + +%cold +move s d +%hot + +# Receive operations. + +loop_rec Fail Src | smp_mark_target_label(Fail) => i_loop_rec Fail Src + +label L | wait_timeout Fail Src | smp_already_locked(L) => label L | i_wait_timeout_locked Fail Src +wait_timeout Fail Src => i_wait_timeout Fail Src +i_wait_timeout Fail Src=aiq => gen_literal_timeout(Fail, Src) +i_wait_timeout_locked Fail Src=aiq => gen_literal_timeout_locked(Fail, Src) + +label L | wait Fail | smp_already_locked(L) => label L | wait_locked Fail +wait Fail | smp() => wait_unlocked Fail + +label L | timeout | smp_already_locked(L) => label L | timeout_locked + +remove_message +timeout +timeout_locked +i_loop_rec f r +loop_rec_end f +wait f +wait_locked f +wait_unlocked f +i_wait_timeout f I +i_wait_timeout f s +i_wait_timeout_locked f I +i_wait_timeout_locked f s +i_wait_error +i_wait_error_locked + +send + +# +# Comparisions. +# + +is_eq_exact Lbl=f R=rxy C=ian => i_is_eq_immed Lbl R C +is_eq Lbl=f R=rxy C=an => i_is_eq_immed Lbl R C + +is_ge Lbl S1 S2 => i_fetch S1 S2 | i_is_ge Lbl +is_lt Lbl S1 S2 => i_fetch S1 S2 | i_is_lt Lbl +is_eq Lbl S1 S2 => i_fetch S1 S2 | i_is_eq Lbl +is_ne Lbl S1 S2 => i_fetch S1 S2 | i_is_ne Lbl + +is_eq_exact Lbl=f S1 S2 => i_fetch S1 S2 | i_is_eq_exact Lbl +is_ne_exact Lbl S1 S2 => i_fetch S1 S2 | i_is_ne_exact Lbl + +i_is_lt f +i_is_ge f +i_is_eq f +i_is_ne f +i_is_eq_exact f +i_is_ne_exact f + +%macro: i_is_eq_immed EqualImmed -fail_action +i_is_eq_immed f r c +i_is_eq_immed f x c +i_is_eq_immed f y c + +# +# Putting things. +# + +put_tuple u==0 Dst => i_put_tuple_only u Dst +put_tuple Arity Dst | put V => i_put_tuple Arity V Dst + +i_put_tuple_only A d + +%macro: i_put_tuple PutTuple -pack +i_put_tuple A x x +i_put_tuple A y x +i_put_tuple A r x +i_put_tuple A n x +i_put_tuple A c x +i_put_tuple A x y +i_put_tuple A x r +i_put_tuple A y r +i_put_tuple A n r +i_put_tuple A c r + +%cold +i_put_tuple A r y +i_put_tuple A y y +i_put_tuple A c y +%hot + +%macro:put_list PutList -pack -gen_dest + +put_list x n x +put_list y n x +put_list x x x +put_list y x x +put_list c n x +put_list x x r +put_list y r r +put_list c n r + +put_list y y x +put_list x y x +put_list r x x +put_list r y x +put_list r x r +put_list y y r +put_list y r x +put_list r n x + +# put_list SrcReg Constant Dst +put_list r c r +put_list r c x +put_list r c y + +put_list x c r +put_list x c x +put_list x c y + +put_list y c r +put_list y c x +put_list y c y + +# put_list Constant SrcReg Dst +put_list c r r +put_list c r x +put_list c r y + +put_list c x r +put_list c x x +put_list c x y + +put_list c y r +put_list c y x +put_list c y y + +%cold +put_list x r r +put_list s s d +%hot + +%macro: put Put +put x +put r +put y +put c +put n + +%macro: i_fetch FetchArgs -pack +i_fetch c c +i_fetch c r +i_fetch c x +i_fetch c y +i_fetch r c +i_fetch r x +i_fetch r y +i_fetch x c +i_fetch x r +i_fetch x x +i_fetch x y +i_fetch y c +i_fetch y r +i_fetch y x +i_fetch y y + +%cold +i_fetch s s +%hot + +# +# Some more only used by the emulator +# + +normal_exit +continue_exit +apply_bif +call_nif +call_error_handler +error_action_code +call_traced_function +return_trace + +# +# Instruction transformations & folded instructions. +# + +# Note: There is no 'move_return y r', since there never are any y registers +# when we do move_return (if we have y registers, we must do move_deallocate_return). + +move S r | return => move_return S r + +%macro: move_return MoveReturn -nonext +move_return x r +move_return c r +move_return n r + +move S r | deallocate D | return => move_deallocate_return S r D + +%macro: move_deallocate_return MoveDeallocateReturn -nonext +move_deallocate_return x r P +move_deallocate_return y r P +move_deallocate_return c r P +move_deallocate_return n r P + +deallocate D | return => deallocate_return D + +%macro: deallocate_return DeallocateReturn -nonext +deallocate_return P + +test_heap Need u==1 | put_list Y=y r r => test_heap_1_put_list Need Y + +test_heap_1_put_list I y + +# Test tuple & arity (head) + +is_tuple Fail Literal=q => move Literal x | is_tuple Fail x +is_tuple Fail=f c => jump Fail +is_tuple Fail=f S=rxy | test_arity Fail=f S=rxy Arity => is_tuple_of_arity Fail S Arity + +%macro:is_tuple_of_arity IsTupleOfArity -fail_action + +is_tuple_of_arity f x A +is_tuple_of_arity f y A +is_tuple_of_arity f r A + +%macro: is_tuple IsTuple -fail_action +is_tuple f x +is_tuple f y +is_tuple f r + +test_arity Fail Literal=q Arity => move Literal x | test_arity Fail x Arity +test_arity Fail=f c Arity => jump Fail + +%macro: test_arity IsArity -fail_action +test_arity f x A +test_arity f y A +test_arity f r A + +is_tuple_of_arity Fail=f Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \ + is_tuple_of_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P + +test_arity Fail Reg Arity | get_tuple_element Reg P=u==0 Dst=xy => \ + test_arity Fail Reg Arity | extract_next_element Dst | original_reg Reg P + +original_reg Reg P1 | get_tuple_element Reg P2 Dst=xy | succ(P1, P2) => \ + extract_next_element Dst | original_reg Reg P2 + +get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst | original_reg Reg P + +original_reg Reg Pos => + +get_tuple_element Reg P Dst => i_get_tuple_element Reg P Dst + +original_reg/2 + +extract_next_element D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ +succ(P1, P2) | succ(D1, D2) => \ + extract_next_element2 D1 | original_reg Reg P2 + +extract_next_element2 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ +succ(P1, P2) | succ2(D1, D2) => \ + extract_next_element3 D1 | original_reg Reg P2 + +#extract_next_element3 D1=xy | original_reg Reg P1 | get_tuple_element Reg P2 D2=xy | \ +#succ(P1, P2) | succ3(D1, D2) => \ +# extract_next_element4 D1 | original_reg Reg P2 + +%macro: extract_next_element ExtractNextElement -pack +extract_next_element x +extract_next_element y + +%macro: extract_next_element2 ExtractNextElement2 -pack +extract_next_element2 x +extract_next_element2 y + +%macro: extract_next_element3 ExtractNextElement3 -pack +extract_next_element3 x +extract_next_element3 y + +#%macro: extract_next_element4 ExtractNextElement4 -pack +#extract_next_element4 x +#extract_next_element4 y + +is_integer Fail=f i => +is_integer Fail=f an => jump Fail +is_integer Fail Literal=q => move Literal x | is_integer Fail x + +is_integer Fail=f S=rx | allocate Need Regs => is_integer_allocate Fail S Need Regs + +%macro: is_integer_allocate IsIntegerAllocate -fail_action +is_integer_allocate f x I I +is_integer_allocate f r I I + +%macro: is_integer IsInteger -fail_action +is_integer f x +is_integer f y +is_integer f r + +is_list Fail=f n => +is_list Fail Literal=q => move Literal x | is_list Fail x +is_list Fail=f c => jump Fail +%macro: is_list IsList -fail_action +is_list f r +is_list f x +%cold +is_list f y +%hot + +is_nonempty_list Fail=f S=rx | allocate Need Rs => is_nonempty_list_allocate Fail S Need Rs + +%macro:is_nonempty_list_allocate IsNonemptyListAllocate -fail_action +is_nonempty_list_allocate f x I I +is_nonempty_list_allocate f r I I + +is_nonempty_list F=f r | test_heap I1 I2 => is_non_empty_list_test_heap F r I1 I2 + +%macro: is_non_empty_list_test_heap IsNonemptyListTestHeap -fail_action +is_non_empty_list_test_heap f r I I + +%macro: is_nonempty_list IsNonemptyList -fail_action +is_nonempty_list f x +is_nonempty_list f y +is_nonempty_list f r + +%macro: is_atom IsAtom -fail_action +is_atom f x +is_atom f r +%cold +is_atom f y +%hot +is_atom Fail=f a => +is_atom Fail=f niq => jump Fail + +%macro: is_float IsFloat -fail_action +is_float f r +is_float f x +%cold +is_float f y +%hot +is_float Fail=f nai => jump Fail +is_float Fail Literal=q => move Literal x | is_float Fail x + +is_nil Fail=f n => +is_nil Fail=f qia => jump Fail + +%macro: is_nil IsNil -fail_action +is_nil f x +is_nil f y +is_nil f r + +is_binary Fail Literal=q => move Literal x | is_binary Fail x +is_binary Fail=f c => jump Fail +%macro: is_binary IsBinary -fail_action +is_binary f r +is_binary f x +%cold +is_binary f y +%hot + +# XXX Deprecated. +is_bitstr Fail Term => is_bitstring Fail Term + +is_bitstring Fail Literal=q => move Literal x | is_bitstring Fail x +is_bitstring Fail=f c => jump Fail +%macro: is_bitstring IsBitstring -fail_action +is_bitstring f r +is_bitstring f x +%cold +is_bitstring f y +%hot + +is_reference Fail=f cq => jump Fail +%macro: is_reference IsRef -fail_action +is_reference f r +is_reference f x +%cold +is_reference f y +%hot + +is_pid Fail=f cq => jump Fail +%macro: is_pid IsPid -fail_action +is_pid f r +is_pid f x +%cold +is_pid f y +%hot + +is_port Fail=f cq => jump Fail +%macro: is_port IsPort -fail_action +is_port f r +is_port f x +%cold +is_port f y +%hot + +is_boolean Fail=f a==am_true => +is_boolean Fail=f a==am_false => +is_boolean Fail=f ac => jump Fail + +%cold +%macro: is_boolean IsBoolean -fail_action +is_boolean f r +is_boolean f x +is_boolean f y +%hot + +is_function2 Fail=f acq Arity => jump Fail +is_function2 Fail=f Fun a => jump Fail +is_function2 Fail Fun Literal=q => move Literal x | is_function2 Fail Fun x + +is_function2 f s s +%macro: is_function2 IsFunction2 -fail_action + +# Allocating & initializing. +allocate Need Regs | init Y => allocate_init Need Regs Y +init Y1 | init Y2 => init2 Y1 Y2 + +%macro: allocate_init AllocateInit -pack +allocate_init t I y + +################################################################# +# External function and bif calls. +################################################################# + +# +# The BIFs erlang:check_process_code/2 must be called like a function, +# to ensure that c_p->i (program counter) is set correctly (an ordinary +# BIF call doesn't set it). +# + +call_ext u==2 Bif=u$bif:erlang:check_process_code/2 => i_call_ext Bif +call_ext_last u==2 Bif=u$bif:erlang:check_process_code/2 D => i_call_ext_last Bif D +call_ext_only u==2 Bif=u$bif:erlang:check_process_code/2 => i_call_ext_only Bif + +# +# The BIFs erlang:garbage_collect/0,1 must be called like functions, +# to allow them to invoke the garbage collector. (The stack pointer must +# be saved and p->arity must be zeroed, which is not done on ordinary BIF calls.) +# + +call_ext u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext Bif +call_ext_last u==0 Bif=u$bif:erlang:garbage_collect/0 D => i_call_ext_last Bif D +call_ext_only u==0 Bif=u$bif:erlang:garbage_collect/0 => i_call_ext_only Bif + +call_ext u==1 Bif=u$bif:erlang:garbage_collect/1 => i_call_ext Bif +call_ext_last u==1 Bif=u$bif:erlang:garbage_collect/1 D => i_call_ext_last Bif D +call_ext_only u==1 Bif=u$bif:erlang:garbage_collect/1 => i_call_ext_only Bif + +# +# put/2 and erase/1 must be able to do garbage collection, so we must call +# them like functions. +# + +call_ext u==2 Bif=u$bif:erlang:put/2 => i_call_ext Bif +call_ext_last u==2 Bif=u$bif:erlang:put/2 D => i_call_ext_last Bif D +call_ext_only u==2 Bif=u$bif:erlang:put/2 => i_call_ext_only Bif + +call_ext u==1 Bif=u$bif:erlang:erase/1 => i_call_ext Bif +call_ext_last u==1 Bif=u$bif:erlang:erase/1 D => i_call_ext_last Bif D +call_ext_only u==1 Bif=u$bif:erlang:erase/1 => i_call_ext_only Bif + +# +# The process_info/1,2 BIF should be called like a function, to force +# the emulator to set c_p->current before calling it (a BIF call doesn't +# set it). +# +# In addition, we force the use of a non-tail-recursive call. This will ensure +# that c_p->cp points into the function making the call. +# + +call_ext u==1 Bif=u$bif:erlang:process_info/1 => i_call_ext Bif +call_ext_last u==1 Bif=u$bif:erlang:process_info/1 D => i_call_ext Bif | deallocate_return D +call_ext_only Ar=u==1 Bif=u$bif:erlang:process_info/1 => allocate u Ar | i_call_ext Bif | deallocate_return u + +call_ext u==2 Bif=u$bif:erlang:process_info/2 => i_call_ext Bif +call_ext_last u==2 Bif=u$bif:erlang:process_info/2 D => i_call_ext Bif | deallocate_return D +call_ext_only Ar=u==2 Bif=u$bif:erlang:process_info/2 => allocate u Ar | i_call_ext Bif | deallocate_return u + +# +# load_nif/2 also needs to know calling function like process_info +# +call_ext u==2 Bif=u$bif:erlang:load_nif/2 => i_call_ext Bif +call_ext_last u==2 Bif=u$bif:erlang:load_nif/2 D => i_call_ext Bif | deallocate_return D +call_ext_only Ar=u==2 Bif=u$bif:erlang:load_nif/2 => allocate u Ar | i_call_ext Bif | deallocate_return u + + +# +# The apply/2 and apply/3 BIFs are instructions. +# + +call_ext u==2 u$func:erlang:apply/2 => i_apply_fun +call_ext_last u==2 u$func:erlang:apply/2 D => i_apply_fun_last D +call_ext_only u==2 u$func:erlang:apply/2 => i_apply_fun_only + +call_ext u==3 u$func:erlang:apply/3 => i_apply +call_ext_last u==3 u$func:erlang:apply/3 D => i_apply_last D +call_ext_only u==3 u$func:erlang:apply/3 => i_apply_only + +# +# The exit/1 and throw/1 BIFs never execute the instruction following them; +# thus there is no need to generate any return instruction. +# + +call_ext_last u==1 Bif=u$bif:erlang:exit/1 D => call_bif1 Bif +call_ext_last u==1 Bif=u$bif:erlang:throw/1 D => call_bif1 Bif + +call_ext_only u==1 Bif=u$bif:erlang:exit/1 => call_bif1 Bif +call_ext_only u==1 Bif=u$bif:erlang:throw/1 => call_bif1 Bif + +# +# The error/1 and error/2 BIFs never execute the instruction following them; +# thus there is no need to generate any return instruction. +# However, they generate stack backtraces, so if the call instruction +# is call_ext_only/2 instruction, we explicitly do an allocate/2 to store +# the continuation pointer on the stack. +# + +call_ext_last u==1 Bif=u$bif:erlang:error/1 D => call_bif1 Bif +call_ext_last u==2 Bif=u$bif:erlang:error/2 D => call_bif2 Bif + +call_ext_only Ar=u==1 Bif=u$bif:erlang:error/1 => \ + allocate u Ar | call_bif1 Bif +call_ext_only Ar=u==2 Bif=u$bif:erlang:error/2 => \ + allocate u Ar | call_bif2 Bif + +# +# The yield/0 BIF is an instruction +# + +call_ext u==0 u$func:erlang:yield/0 => i_yield +call_ext_last u==0 u$func:erlang:yield/0 D => i_yield | deallocate_return D +call_ext_only u==0 u$func:erlang:yield/0 => i_yield | return + +# +# The hibernate/3 BIF is an instruction. +# +call_ext u==3 u$func:erlang:hibernate/3 => i_hibernate +call_ext_last u==3 u$func:erlang:hibernate/3 D => i_hibernate +call_ext_only u==3 u$func:erlang:hibernate/3 => i_hibernate + +# +# Hybrid memory architecture need special cons and tuple instructions +# that allocate on the message area. These looks like BIFs in the BEAM code. +# + +call_ext u==2 u$func:hybrid:cons/2 => i_global_cons +call_ext_last u==2 u$func:hybrid:cons/2 D => i_global_cons | deallocate_return D +call_ext_only Ar=u==2 u$func:hybrid:cons/2 => i_global_cons | return + +call_ext u==1 u$func:hybrid:tuple/1 => i_global_tuple +call_ext_last u==1 u$func:hybrid:tuple/1 D => i_global_tuple | deallocate_return D +call_ext_only Ar=u==1 u$func:hybrid:tuple/1 => i_global_tuple | return + +call_ext u==1 u$func:hybrid:copy/1 => i_global_copy +call_ext_last u==1 u$func:hybrid:copy/1 D => i_global_copy | deallocate_return D +call_ext_only u==1 Ar=u$func:hybrid:copy/1 => i_global_copy | return + +# +# The general case for BIFs that have no special instructions. +# A BIF used in the tail must be followed by a return instruction. +# +# To make trapping and stack backtraces work correctly, we make sure that +# the continuation pointer is always stored on the stack. + +call_ext u==0 Bif=u$is_bif => call_bif0 Bif +call_ext u==1 Bif=u$is_bif => call_bif1 Bif +call_ext u==2 Bif=u$is_bif => call_bif2 Bif +call_ext u==3 Bif=$is_bif => call_bif3 Bif + +call_ext_last u==0 Bif=u$is_bif D => call_bif0 Bif | deallocate_return D +call_ext_last u==1 Bif=u$is_bif D => call_bif1 Bif | deallocate_return D +call_ext_last u==2 Bif=u$is_bif D => call_bif2 Bif | deallocate_return D +call_ext_last u==3 Bif=u$is_bif D => call_bif3 Bif | deallocate_return D + +call_ext_only Ar=u==0 Bif=u$is_bif => \ + allocate u Ar | call_bif0 Bif | deallocate_return u +call_ext_only Ar=u==1 Bif=u$is_bif => \ + allocate u Ar | call_bif1 Bif | deallocate_return u +call_ext_only Ar=u==2 Bif=u$is_bif => \ + allocate u Ar | call_bif2 Bif | deallocate_return u +call_ext_only Ar=u==3 Bif=u$is_bif => \ + allocate u Ar | call_bif3 Bif | deallocate_return u + +# +# Any remaining calls are calls to Erlang functions, not BIFs. +# We rename the instructions to internal names. This is necessary, +# to avoid an end-less loop, because we want to call a few BIFs +# with call instructions. +# + +move S=c r | call_ext Ar=u Func=u$is_not_bif => i_move_call_ext S r Func +move S=c r | call_ext_last Ar=u Func=u$is_not_bif D => i_move_call_ext_last Func D S r +move S=c r | call_ext_only Ar=u Func=u$is_not_bif => i_move_call_ext_only Func S r + +call_ext Ar=u Func => i_call_ext Func +call_ext_last Ar=u Func D => i_call_ext_last Func D +call_ext_only Ar=u Func => i_call_ext_only Func + +i_apply +i_apply_last P +i_apply_only + +i_apply_fun +i_apply_fun_last P +i_apply_fun_only + +i_hibernate + +call_bif0 e +call_bif1 e +call_bif2 e +call_bif3 e + +# +# Calls to non-building and guard BIFs. +# + +bif0 u$bif:erlang:self/0 Dst=d => self Dst +bif0 u$bif:erlang:node/0 Dst=d => node Dst + +bif1 Fail Bif=u$bif:erlang:get/1 Src=s Dst=d => i_get Src Dst + +bif2 Jump=j u$bif:erlang:element/2 S1=s S2=s Dst=d => gen_element(Jump, S1, S2, Dst) + +bif1 Fail Bif Literal=q Dst => move Literal x | bif1 Fail Bif x Dst +bif1 p Bif S1 Dst => bif1_body Bif S1 Dst + +bif1_body Bif Literal=q Dst => move Literal x | bif1_body Bif x Dst + +bif2 p Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2_body Bif Dst +bif2 Fail=f Bif S1 S2 Dst => i_fetch S1 S2 | i_bif2 Fail Bif Dst + +i_get s d + +%macro: self Self +self r +self x +self y + +%macro: node Node +node r +node x +%cold +node y +%hot + +i_fast_element j I s d +i_element j s s d + +bif1 f b s d +bif1_body b s d +i_bif2 f b d +i_bif2_body b d + +# +# Internal calls. +# + +move S=c r | call Ar P=f => i_move_call S r P +move S=s r | call Ar P=f => move_call S r P + +i_move_call c r f + +%macro:move_call MoveCall -arg_f -size -nonext +move_call/3 + +move_call x r f +move_call y r f + +move S=c r | call_last Ar P=f D => i_move_call_last P D S r +move S r | call_last Ar P=f D => move_call_last S r P D + +i_move_call_last f P c r + +%macro:move_call_last MoveCallLast -arg_f -nonext + +move_call_last/4 +move_call_last x r f P +move_call_last y r f P + +move S=c r | call_only Ar P=f => i_move_call_only P S r +move S=x r | call_only Ar P=f => move_call_only S r P + +i_move_call_only f c r + +%macro:move_call_only MoveCallOnly -arg_f -nonext +move_call_only/3 + +move_call_only x r f + +call Ar Func => i_call Func +call_last Ar Func D => i_call_last Func D +call_only Ar Func => i_call_only Func + +i_call f +i_call_last f P +i_call_only f + +i_call_ext e +i_call_ext_last e P +i_call_ext_only e + +i_move_call_ext c r e +i_move_call_ext_last e P c r +i_move_call_ext_only e c r + +# Fun calls. + +call_fun Arity=u | deallocate D | return => i_call_fun_last Arity D +call_fun Arity=u => i_call_fun Arity + +i_call_fun I +i_call_fun_last I P + +make_fun2 OldIndex=u => gen_make_fun2(OldIndex) + +%macro: i_make_fun MakeFun -pack +%cold +i_make_fun I t +%hot + +%macro: is_function IsFunction -fail_action +is_function f x +is_function f y +is_function f r +is_function Fail=f c => jump Fail + +func_info M=a F=a A=u | label L => gen_func_info(M, F, A, L) + +# ================================================================ +# New bit syntax matching (R11B). +# ================================================================ + +%cold +bs_start_match2 Fail=f ica X Y D => jump Fail +bs_start_match2 Fail Bin X Y D => i_bs_start_match2 Bin Fail X Y D +i_bs_start_match2 r f I I d +i_bs_start_match2 x f I I d +i_bs_start_match2 y f I I d + +bs_save2 Reg Index => gen_bs_save(Reg, Index) +i_bs_save2 r I +i_bs_save2 x I + +bs_restore2 Reg Index => gen_bs_restore(Reg, Index) +i_bs_restore2 r I +i_bs_restore2 x I + +# Matching integers +bs_match_string Fail Ms Bits Val => i_bs_match_string Ms Fail Bits Val + +i_bs_match_string r f I I +i_bs_match_string x f I I + +# Fetching integers from binaries. +bs_get_integer2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \ + gen_get_integer2(Fail, Ms, Live, Sz, Unit, Flags, Dst) + +i_bs_get_integer_small_imm r I f I d +i_bs_get_integer_small_imm x I f I d +i_bs_get_integer_imm r I I f I d +i_bs_get_integer_imm x I I f I d +i_bs_get_integer f I I d +i_bs_get_integer_8 r f d +i_bs_get_integer_8 x f d +i_bs_get_integer_16 r f d +i_bs_get_integer_16 x f d +i_bs_get_integer_32 r f I d +i_bs_get_integer_32 x f I d + +# Fetching binaries from binaries. +bs_get_binary2 Fail=f Ms=rx Live=u Sz=sq Unit=u Flags=u Dst=d => \ + gen_get_binary2(Fail, Ms, Live, Sz, Unit, Flags, Dst) + +%macro: i_bs_get_binary_imm2 BsGetBinaryImm_2 -fail_action -gen_dest +%macro: i_bs_get_binary2 BsGetBinary_2 -fail_action -gen_dest +%macro: i_bs_get_binary_all2 BsGetBinaryAll_2 -fail_action -gen_dest + +i_bs_get_binary_imm2 f r I I I d +i_bs_get_binary_imm2 f x I I I d +i_bs_get_binary2 f r I s I d +i_bs_get_binary2 f x I s I d +i_bs_get_binary_all2 f r I I d +i_bs_get_binary_all2 f x I I d +i_bs_get_binary_all_reuse r f I +i_bs_get_binary_all_reuse x f I + +# Fetching float from binaries. +bs_get_float2 Fail=f Ms=rx Live=u Sz=s Unit=u Flags=u Dst=d => \ + gen_get_float2(Fail, Ms, Live, Sz, Unit, Flags, Dst) + +bs_get_float2 Fail=f Ms=rx Live=u Sz=q Unit=u Flags=u Dst=d => jump Fail + +%macro: i_bs_get_float2 BsGetFloat2 -fail_action -gen_dest +i_bs_get_float2 f r I s I d +i_bs_get_float2 f x I s I d + +# Miscellanous + +bs_skip_bits2 Fail=f Ms=rx Sz=s Unit=u Flags=u => \ + gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) +bs_skip_bits2 Fail=f Ms=rx Sz=q Unit=u Flags=u => \ + gen_skip_bits2(Fail, Ms, Sz, Unit, Flags) + +%macro: i_bs_skip_bits_imm2 BsSkipBitsImm2 -fail_action +i_bs_skip_bits_imm2 f r I +i_bs_skip_bits_imm2 f x I + +%macro: i_bs_skip_bits2 BsSkipBits2 -fail_action +i_bs_skip_bits2 f r x I +i_bs_skip_bits2 f r y I +i_bs_skip_bits2 f x x I +i_bs_skip_bits2 f x r I +i_bs_skip_bits2 f x y I + +%macro: i_bs_skip_bits_all2 BsSkipBitsAll2 -fail_action +i_bs_skip_bits_all2 f r I +i_bs_skip_bits_all2 f x I + +bs_test_tail2 Fail=f Ms=rx Bits=u==0 => bs_test_zero_tail2 Fail Ms +bs_test_tail2 Fail=f Ms=rx Bits=u => bs_test_tail_imm2 Fail Ms Bits +bs_test_zero_tail2 f r +bs_test_zero_tail2 f x +bs_test_tail_imm2 f r I +bs_test_tail_imm2 f x I + +bs_test_unit F Ms Unit=u==8 => bs_test_unit8 F Ms +bs_test_unit f r I +bs_test_unit f x I +bs_test_unit8 f r +bs_test_unit8 f x + +bs_context_to_binary r +bs_context_to_binary x +bs_context_to_binary y + +# +# Utf8/utf16/utf32 support. (R12B-5) +# +bs_get_utf8 Fail=f Ms=rx u u Dst=d => i_bs_get_utf8 Ms Fail Dst +i_bs_get_utf8 r f d +i_bs_get_utf8 x f d + +bs_skip_utf8 Fail=f Ms=rx u u => i_bs_get_utf8 Ms Fail x + +bs_get_utf16 Fail=f Ms=rx u Flags=u Dst=d => i_bs_get_utf16 Ms Fail Flags Dst +bs_skip_utf16 Fail=f Ms=rx u Flags=u => i_bs_get_utf16 Ms Fail Flags x + +i_bs_get_utf16 r f I d +i_bs_get_utf16 x f I d + +bs_get_utf32 Fail=f Ms=rx Live=u Flags=u Dst=d => \ + bs_get_integer2 Fail Ms Live i=32 u=1 Flags Dst | \ + i_fetch Dst Ms | \ + i_bs_validate_unicode_retract Fail +bs_skip_utf32 Fail=f Ms=rx Live=u Flags=u => \ + bs_get_integer2 Fail Ms Live i=32 u=1 Flags x | \ + i_fetch x Ms | \ + i_bs_validate_unicode_retract Fail + +i_bs_validate_unicode_retract j +%hot + +# +# Constructing binaries +# +%cold + +bs_init2 Fail Sz Words Regs Flags Dst | binary_too_big(Sz) => system_limit Fail + +bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst | should_gen_heap_bin(Sz) => \ + i_bs_init_heap_bin Sz Regs Dst +bs_init2 Fail Sz=u Words=u==0 Regs Flags Dst => i_bs_init Sz Regs Dst + +bs_init2 Fail Sz=u Words Regs Flags Dst | should_gen_heap_bin(Sz) => \ + i_bs_init_heap_bin_heap Sz Words Regs Dst +bs_init2 Fail Sz=u Words Regs Flags Dst => \ + i_bs_init_heap Sz Words Regs Dst + +bs_init2 Fail Sz Words=u==0 Regs Flags Dst => \ + i_bs_init_fail Sz Fail Regs Dst +bs_init2 Fail Sz Words Regs Flags Dst => \ + i_fetch Sz r | i_bs_init_fail_heap Words Fail Regs Dst + +i_bs_init_fail r j I d +i_bs_init_fail x j I d +i_bs_init_fail y j I d + +i_bs_init_fail_heap I j I d + +i_bs_init I I d +i_bs_init_heap_bin I I d + +i_bs_init_heap I I I d +i_bs_init_heap_bin_heap I I I d + + +bs_init_bits Fail Sz Words Regs Flags Dst | binary_too_big_bits(Sz) => system_limit Fail + +bs_init_bits Fail Sz=u Words=u==0 Regs Flags Dst => i_bs_init_bits Sz Regs Dst +bs_init_bits Fail Sz=u Words Regs Flags Dst => i_bs_init_bits_heap Sz Words Regs Dst + +bs_init_bits Fail Sz Words=u==0 Regs Flags Dst => \ + i_bs_init_bits_fail Sz Fail Regs Dst +bs_init_bits Fail Sz Words Regs Flags Dst => \ + i_fetch Sz r | i_bs_init_bits_fail_heap Words Fail Regs Dst + +i_bs_init_bits_fail r j I d +i_bs_init_bits_fail x j I d +i_bs_init_bits_fail y j I d + +i_bs_init_bits_fail_heap I j I d + +i_bs_init_bits I I d +i_bs_init_bits_heap I I I d + +bs_bits_to_bytes Fail Src Dst => i_bs_bits_to_bytes Src Fail Dst + +i_bs_bits_to_bytes r j d +i_bs_bits_to_bytes x j d +i_bs_bits_to_bytes y j d + +bs_add Fail S1=i==0 S2 Unit=u==1 D => move S2 D +bs_add Fail S1 S2 Unit D => i_fetch S1 S2 | i_bs_add Fail Unit D + +i_bs_add j I d + +bs_append Fail Size Extra Live Unit Bin Flags Dst => \ + i_fetch Size Bin | i_bs_append Fail Extra Live Unit Dst + +bs_private_append Fail Size Unit Bin Flags Dst => \ + i_fetch Size Bin | i_bs_private_append Fail Unit Dst + +bs_init_writable + +i_bs_append j I I I d +i_bs_private_append j I d + +# +# Storing integers into binaries. +# + +bs_put_integer Fail=j Sz=s Unit=u Flags=u Literal=q => \ + move Literal x | bs_put_integer Fail Sz Unit Flags x +bs_put_integer Fail=j Sz=sq Unit=u Flags=u Src=s => \ + gen_put_integer(Fail, Sz, Unit, Flags, Src) + +%macro: i_new_bs_put_integer NewBsPutInteger +%macro: i_new_bs_put_integer_imm NewBsPutIntegerImm + +i_new_bs_put_integer j s I s +i_new_bs_put_integer_imm j I I s + +# +# Utf8/utf16/utf32 support. (R12B-5) +# + +bs_utf8_size Fail Literal=q Dst=d => \ + move Literal x | bs_utf8_size Fail x Dst +bs_utf8_size j Src=s Dst=d => i_bs_utf8_size Src Dst + +i_bs_utf8_size s d + +bs_utf16_size Fail Literal=q Dst=d => \ + move Literal x | bs_utf16_size Fail x Dst +bs_utf16_size j Src=s Dst=d => i_bs_utf16_size Src Dst + +i_bs_utf16_size s d + +bs_put_utf8 Fail=j Flags=u Literal=q => \ + move Literal x | bs_put_utf8 Fail Flags x +bs_put_utf8 Fail=j u Src=s => i_bs_put_utf8 Fail Src + +i_bs_put_utf8 j s + +bs_put_utf16 Fail=j Flags=u Literal=q => \ + move Literal x | bs_put_utf16 Fail Flags x +bs_put_utf16 Fail=j Flags=u Src=s => i_bs_put_utf16 Fail Flags Src + +i_bs_put_utf16 j I s + +bs_put_utf32 Fail=j Flags=u Literal=q => \ + move Literal x | bs_put_utf32 Fail Flags x +bs_put_utf32 Fail=j Flags=u Src=s => \ + i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src + +i_bs_validate_unicode j s + +# +# Storing floats into binaries. +# +bs_put_float Fail Sz=q Unit Flags Val => badarg Fail + +bs_put_float Fail=j Sz Unit=u Flags=u Literal=q => \ + move Literal x | bs_put_float Fail Sz Unit Flags x + +bs_put_float Fail=j Sz=s Unit=u Flags=u Src=s => \ + gen_put_float(Fail, Sz, Unit, Flags, Src) + +%macro: i_new_bs_put_float NewBsPutFloat +%macro: i_new_bs_put_float_imm NewBsPutFloatImm + +i_new_bs_put_float j s I s +i_new_bs_put_float_imm j I I s + +# +# Storing binaries into binaries. +# + +bs_put_binary Fail Sz Unit Flags Literal=q => \ + move Literal x | bs_put_binary Fail Sz Unit Flags x +bs_put_binary Fail=j Sz=s Unit=u Flags=u Src=s => \ + gen_put_binary(Fail, Sz, Unit, Flags, Src) + +%macro: i_new_bs_put_binary NewBsPutBinary +i_new_bs_put_binary j s I s + +%macro: i_new_bs_put_binary_imm NewBsPutBinaryImm +i_new_bs_put_binary_imm j I s + +%macro: i_new_bs_put_binary_all NewBsPutBinaryAll +i_new_bs_put_binary_all j s I + +# +# Warning: The i_bs_put_string and i_new_bs_put_string instructions +# are specially treated in the loader. +# Don't change the instruction format unless you change the loader too. +# + +bs_put_string I I + +%hot + +# +# New floating point instructions (R8). +# + +fadd p FR1 FR2 FR3 => i_fadd FR1 FR2 FR3 +fsub p FR1 FR2 FR3 => i_fsub FR1 FR2 FR3 +fmul p FR1 FR2 FR3 => i_fmul FR1 FR2 FR3 +fdiv p FR1 FR2 FR3 => i_fdiv FR1 FR2 FR3 +fnegate p FR1 FR2 => i_fnegate FR1 FR2 + +fconv Int=iq Dst=l => move Int x | fconv x Dst + +fmove q l +fmove d l +fconv d l + +i_fadd l l l +i_fsub l l l +i_fmul l l l +i_fdiv l l l +i_fnegate l l + +fclearerror | no_fpe_signals() => +fcheckerror p | no_fpe_signals() => +fcheckerror p => i_fcheckerror + +i_fcheckerror +fclearerror + +fmove FR=l Dst=d | new_float_allocation() => fmove_new FR Dst + +# The new instruction for moving a float out of a floating point register. +# (No allocation.) +fmove_new l d + +# +# New apply instructions in R10B. +# + +apply I +apply_last I P + +# +# New GCing arithmetic instructions. +# + +gc_bif2 Fail I u$bif:erlang:splus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_plus Fail I Dst +gc_bif2 Fail I u$bif:erlang:sminus/2 S1 S2 Dst=d => i_fetch S1 S2 | i_minus Fail I Dst +gc_bif2 Fail I u$bif:erlang:stimes/2 S1 S2 Dst=d => i_fetch S1 S2 | i_times Fail I Dst +gc_bif2 Fail I u$bif:erlang:div/2 S1 S2 Dst=d => i_fetch S1 S2 | i_m_div Fail I Dst + +gc_bif2 Fail I u$bif:erlang:intdiv/2 S1 S2 Dst=d => i_fetch S1 S2 | i_int_div Fail I Dst +gc_bif2 Fail I u$bif:erlang:rem/2 S1 S2 Dst=d => i_fetch S1 S2 | i_rem Fail I Dst + +gc_bif2 Fail I u$bif:erlang:bsl/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsl Fail I Dst +gc_bif2 Fail I u$bif:erlang:bsr/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bsr Fail I Dst + +gc_bif2 Fail I u$bif:erlang:band/2 S1 S2 Dst=d => i_fetch S1 S2 | i_band Fail I Dst +gc_bif2 Fail I u$bif:erlang:bor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bor Fail I Dst +gc_bif2 Fail I u$bif:erlang:bxor/2 S1 S2 Dst=d => i_fetch S1 S2 | i_bxor Fail I Dst + +gc_bif1 Fail I u$bif:erlang:bnot/1 Src Dst=d => i_int_bnot Fail Src I Dst + +gc_bif1 Fail I u$bif:erlang:sminus/1 Src Dst=d => i_fetch i Src | i_minus Fail I Dst +gc_bif1 Fail I u$bif:erlang:splus/1 Src Dst=d => i_fetch i Src | i_plus Fail I Dst + +i_plus j I d +i_minus j I d +i_times j I d +i_m_div j I d +i_int_div j I d +i_rem j I d + +i_bsl j I d +i_bsr j I d + +i_band j I d +i_bor j I d +i_bxor j I d + +i_int_bnot j s I d + +# +# Old guard BIFs that creates heap fragments are no longer allowed. +# +bif1 Fail u$bif:erlang:length/1 s d => too_old_compiler +bif1 Fail u$bif:erlang:size/1 s d => too_old_compiler +bif1 Fail u$bif:erlang:abs/1 s d => too_old_compiler +bif1 Fail u$bif:erlang:float/1 s d => too_old_compiler +bif1 Fail u$bif:erlang:round/1 s d => too_old_compiler +bif1 Fail u$bif:erlang:trunc/1 s d => too_old_compiler + +# +# Guard BIFs. +# +gc_bif1 Fail I Bif=u$bif:erlang:length/1 Src Dst=d => \ + gen_guard_bif(Fail, I, Bif, Src, Dst) + +gc_bif1 Fail I Bif=u$bif:erlang:size/1 Src Dst=d => \ + gen_guard_bif(Fail, I, Bif, Src, Dst) + +gc_bif1 Fail I Bif=u$bif:erlang:bit_size/1 Src Dst=d => \ + gen_guard_bif(Fail, I, Bif, Src, Dst) + +gc_bif1 Fail I Bif=u$bif:erlang:byte_size/1 Src Dst=d => \ + gen_guard_bif(Fail, I, Bif, Src, Dst) + +gc_bif1 Fail I Bif=u$bif:erlang:abs/1 Src Dst=d => \ + gen_guard_bif(Fail, I, Bif, Src, Dst) + +gc_bif1 Fail I Bif=u$bif:erlang:float/1 Src Dst=d => \ + gen_guard_bif(Fail, I, Bif, Src, Dst) + +gc_bif1 Fail I Bif=u$bif:erlang:round/1 Src Dst=d => \ + gen_guard_bif(Fail, I, Bif, Src, Dst) + +gc_bif1 Fail I Bif=u$bif:erlang:trunc/1 Src Dst=d => \ + gen_guard_bif(Fail, I, Bif, Src, Dst) + +i_gc_bif1 Fail Bif V=q Live D => move V x | i_gc_bif1 Fail Bif x Live D + +i_gc_bif1 j I s I d + +# +# R13B03 +# +on_load diff --git a/erts/emulator/beam/packet_parser.c b/erts/emulator/beam/packet_parser.c new file mode 100644 index 0000000000..8c8029d450 --- /dev/null +++ b/erts/emulator/beam/packet_parser.c @@ -0,0 +1,847 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* A protocol decoder. Simple packet length extraction as well as packet + * body parsing with protocol specific callback interfaces (http and ssl). + * + * Code ripped out from inet_drv.c to also be used by BIF decode_packet. + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "packet_parser.h" + +#include +#include "sys.h" + +/* #define INET_DRV_DEBUG 1 */ +#ifdef INET_DRV_DEBUG +# define DEBUG 1 +# undef DEBUGF +# define DEBUGF(X) printf X +#endif + +#define get_int24(s) ((((unsigned char*) (s))[0] << 16) | \ + (((unsigned char*) (s))[1] << 8) | \ + (((unsigned char*) (s))[2])) + +#define get_little_int32(s) ((((unsigned char*) (s))[3] << 24) | \ + (((unsigned char*) (s))[2] << 16) | \ + (((unsigned char*) (s))[1] << 8) | \ + (((unsigned char*) (s))[0])) + +#define put_int24(s, x) ((((unsigned char*)(s))[0] = ((x) >> 16) & 0xff), \ + (((unsigned char*)(s))[1] = ((x) >> 8) & 0xff), \ + (((unsigned char*)(s))[2] = (x) & 0xff)) + + +#if !defined(__WIN32__) && !defined(HAVE_STRNCASECMP) +#define STRNCASECMP my_strncasecmp + +static int my_strncasecmp(const char *s1, const char *s2, size_t n) +{ + int i; + + for (i=0;i 32) && ((x) < 128)) ? tspecial[(x)] : 1) + +#define hash_update(h,c) do { \ + unsigned long __g; \ + (h) = ((h) << 4) + (c); \ + if ((__g = (h) & 0xf0000000)) { \ + (h) ^= (__g >> 24); \ + (h) ^= __g; \ + } \ + } while(0) + +static void http_hash_insert(const char* name, http_atom_t* entry, + http_atom_t** hash, int hsize) +{ + unsigned long h = 0; + const unsigned char* ptr = (const unsigned char*) name; + int ix; + int len = 0; + + while (*ptr != '\0') { + hash_update(h, *ptr); + ptr++; + len++; + } + ix = h % hsize; + + entry->next = hash[ix]; + entry->h = h; + entry->name = name; + entry->len = len; + entry->atom = driver_mk_atom((char*)name); + + hash[ix] = entry; +} + + +static int http_init(void) +{ + int i; + unsigned char* ptr; + + for (i = 0; i < 33; i++) + tspecial[i] = 1; + for (i = 33; i < 127; i++) + tspecial[i] = 0; + for (ptr = (unsigned char*)"()<>@,;:\\\"/[]?={} \t"; *ptr != '\0'; ptr++) + tspecial[*ptr] = 1; + + for (i = 0; i < HTTP_HDR_HASH_SIZE; i++) + http_hdr_hash[i] = NULL; + for (i = 0; http_hdr_strings[i] != NULL; i++) { + ASSERT(strlen(http_hdr_strings[i]) <= HTTP_MAX_NAME_LEN); + http_hdr_table[i].index = i; + http_hash_insert(http_hdr_strings[i], + &http_hdr_table[i], + http_hdr_hash, HTTP_HDR_HASH_SIZE); + } + + for (i = 0; i < HTTP_METH_HASH_SIZE; i++) + http_meth_hash[i] = NULL; + for (i = 0; http_meth_strings[i] != NULL; i++) { + http_meth_table[i].index = i; + http_hash_insert(http_meth_strings[i], + &http_meth_table[i], + http_meth_hash, HTTP_METH_HASH_SIZE); + } + return 0; +} + + +#define CDR_MAGIC "GIOP" + +struct cdr_head { + unsigned char magic[4]; /* 4 bytes must be 'GIOP' */ + unsigned char major; /* major version */ + unsigned char minor; /* minor version */ + unsigned char flags; /* bit 0: 0 == big endian, 1 == little endian + bit 1: 1 == more fragments follow */ + unsigned char message_type; /* message type ... */ + unsigned char message_size[4]; /* size in (flags bit 0 byte order) */ +}; + +#define TPKT_VRSN 3 + +struct tpkt_head { + unsigned char vrsn; /* contains TPKT_VRSN */ + unsigned char reserved; + unsigned char packet_length[2]; /* size incl header, big-endian (?) */ +}; + +void packet_parser_init() +{ + static int done = 0; + if (!done) { + done = 1; + http_init(); + } +} + +/* Return > 0 Total packet length.in bytes + * = 0 Length unknown, need more data. + * < 0 Error, invalid format. + */ +int packet_get_length(enum PacketParseType htype, + const char* ptr, unsigned n, /* Bytes read so far */ + unsigned max_plen, /* Max packet length, 0=no limit */ + unsigned trunc_len, /* Truncate (lines) if longer, 0=no limit */ + int* statep) /* Protocol specific state */ +{ + unsigned hlen, plen; + + switch (htype) { + case TCP_PB_RAW: + if (n == 0) goto more; + else { + DEBUGF((" => nothing remain packet=%d\r\n", n)); + return n; + } + + case TCP_PB_1: + /* TCP_PB_1: [L0 | Data] */ + hlen = 1; + if (n < hlen) goto more; + plen = get_int8(ptr); + goto remain; + + case TCP_PB_2: + /* TCP_PB_2: [L1,L0 | Data] */ + hlen = 2; + if (n < hlen) goto more; + plen = get_int16(ptr); + goto remain; + + case TCP_PB_4: + /* TCP_PB_4: [L3,L2,L1,L0 | Data] */ + hlen = 4; + if (n < hlen) goto more; + plen = get_int32(ptr); + goto remain; + + case TCP_PB_RM: + /* TCP_PB_RM: [L3,L2,L1,L0 | Data] + ** where MSB (bit) is used to signal end of record + */ + hlen = 4; + if (n < hlen) goto more; + plen = get_int32(ptr) & 0x7fffffff; + goto remain; + + case TCP_PB_LINE_LF: { + /* TCP_PB_LINE_LF: [Data ... \n] */ + const char* ptr2; + if ((ptr2 = memchr(ptr, '\n', n)) == NULL) { + if (n >= trunc_len && trunc_len!=0) { /* buffer full */ + DEBUGF((" => line buffer full (no NL)=%d\r\n", n)); + return trunc_len; + } + goto more; + } + else { + int len = (ptr2 - ptr) + 1; /* including newline */ + if (len > trunc_len && trunc_len!=0) { + DEBUGF((" => truncated line=%d\r\n", trunc_len)); + return trunc_len; + } + DEBUGF((" => nothing remain packet=%d\r\n", len)); + return len; + } + } + + case TCP_PB_ASN1: { + /* TCP_PB_ASN1: handles long (4 bytes) or short length format */ + const char* tptr = ptr; + int length; + int nn = n; + + if (n < 2) goto more; + nn--; + if ((*tptr++ & 0x1f) == 0x1f) { /* Long tag format */ + while (nn && ((*tptr & 0x80) == 0x80)) { + tptr++; + nn--; + } + if (nn < 2) goto more; + tptr++; + nn--; + } + + /* tptr now point to length field and nn characters remain */ + length = *tptr & 0x7f; + if ((*tptr & 0x80) == 0x80) { /* Long length format */ + tptr++; + nn--; + if (nn < length) goto more; + switch (length) { + case 0: plen = 0; break; + case 1: plen = get_int8(tptr); tptr += 1; break; + case 2: plen = get_int16(tptr); tptr += 2; break; + case 3: plen = get_int24(tptr); tptr += 3; break; + case 4: plen = get_int32(tptr); tptr += 4; break; + default: goto error; /* error */ + } + } + else { + tptr++; + plen = length; + } + hlen = (tptr-ptr); + goto remain; + } + + case TCP_PB_CDR: { + const struct cdr_head* hp; + hlen = sizeof(struct cdr_head); + if (n < hlen) goto more; + hp = (struct cdr_head*) ptr; + if (sys_memcmp(hp->magic, CDR_MAGIC, 4) != 0) + goto error; + if (hp->flags & 0x01) /* Byte ordering flag */ + plen = get_little_int32(hp->message_size); + else + plen = get_int32(hp->message_size); + goto remain; + } + + case TCP_PB_FCGI: { + const struct fcgi_head* hp; + hlen = sizeof(struct fcgi_head); + if (n < hlen) goto more; + hp = (struct fcgi_head*) ptr; + if (hp->version != FCGI_VERSION_1) + goto error; + plen = ((hp->contentLengthB1 << 8) | hp->contentLengthB0) + + hp->paddingLength; + goto remain; + } + case TCP_PB_HTTPH: + case TCP_PB_HTTPH_BIN: + *statep = !0; + case TCP_PB_HTTP: + case TCP_PB_HTTP_BIN: + /* TCP_PB_HTTP: data \r\n(SP data\r\n)* */ + plen = n; + if (((plen == 1) && NL(ptr)) || ((plen == 2) && CRNL(ptr))) + goto done; + else { + const char* ptr1 = ptr; + int len = plen; + + while (1) { + const char* ptr2 = memchr(ptr1, '\n', len); + + if (ptr2 == NULL) { + if (n >= trunc_len && trunc_len!=0) { /* buffer full */ + plen = trunc_len; + goto done; + } + goto more; + } + else { + plen = (ptr2 - ptr) + 1; + + if (*statep == 0) + goto done; + + if (plen < n) { + if (SP(ptr2+1) && plen>2) { + /* header field value continue on next line */ + ptr1 = ptr2+1; + len = n - plen; + } + else + goto done; + } + else + goto more; + } + } + } + case TCP_PB_TPKT: { + const struct tpkt_head* hp; + hlen = sizeof(struct tpkt_head); + if (n < hlen) + goto more; + hp = (struct tpkt_head*) ptr; + if (hp->vrsn == TPKT_VRSN) { + plen = get_int16(hp->packet_length) - hlen; + if (plen < 0) + goto error; + } + else + goto error; + goto remain; + } + + case TCP_PB_SSL_TLS: + hlen = 5; + if (n < hlen) goto more; + if ((ptr[0] & 0x80) && ptr[2] == 1) { + /* Ssl-v2 Client hello <<1:1, Len:15, 1:8, Version:16>> */ + plen = (get_int16(&ptr[0]) & 0x7fff) - 3; + } + else { + /* <> */ + plen = get_int16(&ptr[3]); + } + goto remain; + + default: + DEBUGF((" => case error\r\n")); + return -1; + } + +more: + return 0; + +remain: + { + int tlen = hlen + plen; + if ((max_plen != 0 && plen > max_plen) + || tlen < (int)hlen) { /* wrap-around protection */ + return -1; + } + return tlen; + } + +done: + return plen; + +error: + return -1; +} + + +static http_atom_t* http_hash_lookup(const char* name, int len, + unsigned long h, + http_atom_t** hash, int hsize) +{ + int ix = h % hsize; + http_atom_t* ap = hash[ix]; + + while (ap != NULL) { + if ((ap->h == h) && (ap->len == len) && + (strncmp(ap->name, name, len) == 0)) + return ap; + ap = ap->next; + } + return NULL; +} + +static void +http_parse_absoluteURI(PacketHttpURI* uri, const char* uri_ptr, int uri_len) +{ + const char* p; + + if ((p = memchr(uri_ptr, '/', uri_len)) == NULL) { + /* host [":" port] */ + uri->s2_ptr = "/"; + uri->s2_len = 1; + } + else { + int n = (p - uri_ptr); + uri->s2_ptr = p; + uri->s2_len = uri_len - n; + uri_len = n; + } + + uri->s1_ptr = uri_ptr; + uri->port = 0; /* undefined */ + /* host[:port] */ + if ((p = memchr(uri_ptr, ':', uri_len)) == NULL) { + uri->s1_len = uri_len; + } + else { + int n = (p - uri_ptr); + int port = 0; + uri->s1_len = n; + n = uri_len - (n+1); + p++; + while(n && isdigit((int) *p)) { + port = port*10 + (*p - '0'); + n--; + p++; + } + if (n==0 && port!=0) + uri->port = port; + } +} + +/* +** Handle URI syntax: +** +** Request-URI = "*" | absoluteURI | abs_path +** absoluteURI = scheme ":" *( uchar | reserved ) +** net_path = "//" net_loc [ abs_path ] +** abs_path = "/" rel_path +** rel_path = [ path ] [ ";" params ] [ "?" query ] +** path = fsegment *( "/" segment ) +** fsegment = 1*pchar +** segment = *pchar +** params = param *( ";" param ) +** param = *( pchar | "/" ) +** query = *( uchar | reserved ) +** +** http_URL = "http:" "//" host [ ":" port ] [ abs_path ] +** +** host = +** port = *DIGIT +** +** {absoluteURI, , , , } +** when = http | https +** {scheme, , } +** wheb is something else then http or https +** {abs_path, } +** +** (unknown form) +** +*/ +static void http_parse_uri(PacketHttpURI* uri, const char* uri_ptr, int uri_len) +{ + if ((uri_len == 1) && (uri_ptr[0] == '*')) + uri->type = URI_STAR; + else if ((uri_len <= 1) || (uri_ptr[0] == '/')) { + uri->type = URI_ABS_PATH; + uri->s1_ptr = uri_ptr; + uri->s1_len = uri_len; + } + else if ((uri_len>=7) && (STRNCASECMP(uri_ptr, "http://", 7) == 0)) { + uri_len -= 7; + uri_ptr += 7; + uri->type = URI_HTTP; + http_parse_absoluteURI(uri, uri_ptr, uri_len); + } + else if ((uri_len>=8) && (STRNCASECMP(uri_ptr, "https://", 8) == 0)) { + uri_len -= 8; + uri_ptr += 8; + uri->type = URI_HTTPS; + http_parse_absoluteURI(uri, uri_ptr, uri_len); + } + else { + char* ptr; + if ((ptr = memchr(uri_ptr, ':', uri_len)) == NULL) { + uri->type = URI_STRING; + uri->s1_ptr = uri_ptr; + uri->s1_len = uri_len; + } + else { + int slen = ptr - uri_ptr; + uri->type = URI_SCHEME; + uri->s1_ptr = uri_ptr; + uri->s1_len = slen; + uri->s2_ptr = uri_ptr + (slen+1); + uri->s2_len = uri_len - (slen+1); + } + } +} + +/* +** parse http message: +** http_eoh - end of headers +** {http_header, Key, Value} - Key = atom() | string() +** {http_request, Method,Url,Version} +** {http_response, Version, Status, Message} +** {http_error, Error-Line} +*/ +int packet_parse_http(const char* buf, int len, int* statep, + PacketCallbacks* pcb, void* arg) +{ + const char* ptr = buf; + const char* p0; + int n = len; + + /* remove trailing CRNL (accept NL as well) */ + if ((n >= 2) && (buf[n-2] == '\r')) + n -= 2; + else if ((n >= 1) && (buf[n-1] == '\n')) + n -= 1; + + if (*statep == 0) { + /* start-line = Request-Line | Status-Line */ + + if (n >= 5 && (strncmp(buf, "HTTP/", 5) == 0)) { + int major = 0; + int minor = 0; + int status = 0; + /* Status-Line = HTTP-Version SP + * Status-Code SP Reason-Phrase + * CRNL + * HTTP-Version = "HTTP" "/" 1*DIGIT "." 1*DIGIT + */ + ptr += 5; + n -= 5; + p0 = ptr; + while (n && isdigit((int) *ptr)) { + major = 10*major + (*ptr - '0'); + ptr++; + n--; + } + if (ptr==p0 || !n || (*ptr != '.')) + return -1; + ptr++; + n--; + p0 = ptr; + while (n && isdigit((int) *ptr)) { + minor = 10*minor + (*ptr - '0'); + ptr++; + n--; + } + if (ptr==p0) return -1; + p0 = ptr; + while (n && SP(ptr)) { + ptr++; n--; + } + if (ptr==p0) return -1; + + while (n && isdigit((int) *ptr)) { + status = 10*status + (*ptr - '0'); + ptr++; + n--; + } + p0 = ptr; + while (n && SP(ptr)) { + ptr++; n--; + } + if (ptr==p0) return -1; + + /* NOTE: the syntax allows empty reason phrases */ + (*statep) = !0; + + return pcb->http_response(arg, major, minor, status, + ptr, n); + } + else { + /* Request-Line = Method SP Request-URI SP HTTP-Version CRLF */ + http_atom_t* meth; + const char* meth_ptr = buf; + int meth_len; + PacketHttpURI uri; + const char* uri_ptr; + int uri_len; + int major = 0; + int minor = 0; + unsigned long h = 0; + + while (n && !is_tspecial((unsigned char)*ptr)) { + hash_update(h, (int)*ptr); + ptr++; + n--; + } + meth_len = ptr - meth_ptr; + if (n == 0 || meth_len == 0 || !SP(ptr)) return -1; + + meth = http_hash_lookup(meth_ptr, meth_len, h, + http_meth_hash, HTTP_METH_HASH_SIZE); + + while (n && SP(ptr)) { + ptr++; n--; + } + uri_ptr = ptr; + while (n && !SP(ptr)) { + ptr++; n--; + } + if ((uri_len = (ptr - uri_ptr)) == 0) + return -1; + while (n && SP(ptr)) { + ptr++; n--; + } + if (n == 0) { + (*statep) = !0; + http_parse_uri(&uri, uri_ptr, uri_len); + return pcb->http_request(arg, meth, meth_ptr, meth_len, + &uri, 0, 9); + } + if (n < 8) + return -1; + if (strncmp(ptr, "HTTP/", 5) != 0) + return -1; + ptr += 5; + n -= 5; + + p0 = ptr; + while (n && isdigit((int) *ptr)) { + major = 10*major + (*ptr - '0'); + ptr++; + n--; + } + if (ptr==p0 || !n || (*ptr != '.')) + return -1; + ptr++; + n--; + p0 = ptr; + while (n && isdigit((int) *ptr)) { + minor = 10*minor + (*ptr - '0'); + ptr++; + n--; + } + if (ptr==p0) return -1; + + (*statep) = !0; + http_parse_uri(&uri, uri_ptr, uri_len); + return pcb->http_request(arg, meth, meth_ptr, meth_len, + &uri, major, minor); + } + } + else { + int up = 1; /* make next char uppercase */ + http_atom_t* name; + char name_buf[HTTP_MAX_NAME_LEN]; + const char* name_ptr = name_buf; + int name_len; + unsigned long h; + + if (n == 0) { + /* end of headers */ + *statep = 0; /* reset state (for next request) */ + return pcb->http_eoh(arg); + } + h = 0; + name_len = 0; + while (!is_tspecial((unsigned char)*ptr)) { + if (name_len < HTTP_MAX_NAME_LEN) { + int c = *ptr; + if (up) { + if (islower(c)) { + c = toupper(c); + } + up = 0; + } + else { + if (isupper(c)) + c = tolower(c); + else if (c == '-') + up = 1; + } + name_buf[name_len] = c; + hash_update(h, c); + } + name_len++; + ptr++; + if (--n == 0) return -1; + } + while (n && SP(ptr)) { /* Skip white space before ':' */ + ptr++; n--; + } + if (*ptr != ':') { + return -1; + } + if (name_len <= HTTP_MAX_NAME_LEN) { + name = http_hash_lookup(name_buf, name_len, h, + http_hdr_hash, HTTP_HDR_HASH_SIZE); + } + else { + /* Is it ok to return original name without case adjustments? */ + name_ptr = buf; + name = NULL; + } + ptr++; + n--; + /* Skip white space after ':' */ + while (n && SP(ptr)) { + ptr++; n--; + } + return pcb->http_header(arg, name, name_ptr, name_len, + ptr, n); + } + return -1; +} + +int packet_parse_ssl(const char* buf, int len, + PacketCallbacks* pcb, void* arg) +{ + /* Check for ssl-v2 client hello */ + if ((buf[0] & 0x80) && buf[2] == 1) { + unsigned major = (unsigned char) buf[3]; + unsigned minor = (unsigned char) buf[4]; + char prefix[4]; + /* <<1:8,Length:24,Data/binary>> */ + prefix[0] = 1; + put_int24(&prefix[1],len-3); + return pcb->ssl_tls(arg, 22, major, minor, buf+3, len-3, prefix, sizeof(prefix)); + } + else { + /* ContentType (1 byte), ProtocolVersion (2 bytes), Length (2 bytes big-endian) */ + unsigned type = (unsigned char) buf[0]; + unsigned major = (unsigned char) buf[1]; + unsigned minor = (unsigned char) buf[2]; + return pcb->ssl_tls(arg, type, major, minor, buf+5, len-5, NULL, 0); + } +} + diff --git a/erts/emulator/beam/packet_parser.h b/erts/emulator/beam/packet_parser.h new file mode 100644 index 0000000000..1c3a9aa3da --- /dev/null +++ b/erts/emulator/beam/packet_parser.h @@ -0,0 +1,181 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* A protocol decoder. Simple packet length extraction as well as packet + * body parsing with protocol specific callback interfaces (http and ssl). + */ +#ifndef __PACKET_PARSER_H__ +#define __PACKET_PARSER_H__ + +#include +#include "sys.h" + + +/* INET_LOPT_PACKET options */ +enum PacketParseType { + TCP_PB_RAW = 0, + TCP_PB_1 = 1, + TCP_PB_2 = 2, + TCP_PB_4 = 3, + TCP_PB_ASN1 = 4, + TCP_PB_RM = 5, + TCP_PB_CDR = 6, + TCP_PB_FCGI = 7, + TCP_PB_LINE_LF = 8, + TCP_PB_TPKT = 9, + TCP_PB_HTTP = 10, + TCP_PB_HTTPH = 11, + TCP_PB_SSL_TLS = 12, + TCP_PB_HTTP_BIN = 13, + TCP_PB_HTTPH_BIN = 14 +}; + +typedef struct http_atom { + struct http_atom* next; /* next in bucket */ + unsigned long h; /* stored hash value */ + const char* name; + int len; + int index; /* index in table + bit-pos */ + ErlDrvTermData atom; /* erlang atom rep */ +} http_atom_t; + +typedef struct { + enum { + URI_STAR, /* '*' */ + URI_STRING, /* "string(s1)" */ + URI_ABS_PATH,/* {abs_path, "path(s1)"} */ + URI_SCHEME, /* {scheme, "scheme(s1)", "string(s2)"} */ + URI_HTTP, /* {absoluteURI, http, "host(s1)", Port, "path(s2)"} */ + URI_HTTPS /* {absoluteURI, https, ... */ + } type; + const char* s1_ptr; + int s1_len; + const char* s2_ptr; + int s2_len; + int port; /* 0=undefined */ +}PacketHttpURI; + +typedef int HttpResponseMessageFn(void* arg, int major, int minor, int status, + const char* phrase, int phrase_len); +typedef int HttpRequestMessageFn(void* arg, const http_atom_t* meth, const char* meth_ptr, + int meth_len, const PacketHttpURI*, int major, int minor); +typedef int HttpEohMessageFn(void *arg); +typedef int HttpHeaderMessageFn(void* arg, const http_atom_t* name, const char* name_ptr, + int name_len, const char* value_ptr, int value_len); +typedef int HttpErrorMessageFn(void* arg, const char* buf, int len); +typedef int SslTlsFn(void* arg, unsigned type, unsigned major, unsigned minor, + const char* data, int len, const char* prefix, int plen); + +typedef struct { + HttpResponseMessageFn* http_response; + HttpRequestMessageFn* http_request; + HttpEohMessageFn* http_eoh; + HttpHeaderMessageFn* http_header; + HttpErrorMessageFn* http_error; + SslTlsFn* ssl_tls; +}PacketCallbacks; + + +/* Called once at emulator start + */ +void packet_parser_init(void); + +/* Returns > 0 Total packet length. + * = 0 Length unknown, need more data. + * < 0 Error, invalid format. + */ +int packet_get_length(enum PacketParseType htype, + const char* ptr, unsigned n, /* Bytes read so far */ + unsigned max_plen, /* Packet max length, 0=no limit */ + unsigned trunc_len, /* Truncate (lines) if longer, 0=no limit */ + int* statep); /* Internal protocol state */ + +ERTS_GLB_INLINE +void packet_get_body(enum PacketParseType htype, + const char** bufp, /* In: Packet header, Out: Packet body */ + int* lenp); /* In: Packet length, Out: Body length */ + +/* Returns 1 = Packet parsed and handled by callbacks. +** 0 = No parsing support for this packet type +** -1 = Error +*/ +ERTS_GLB_INLINE +int packet_parse(enum PacketParseType htype, + const char* buf, int len, /* Total packet */ + int* statep, PacketCallbacks* pcb, void* arg); + + + +/* Internals for the inlines below: */ + +#define FCGI_VERSION_1 1 +struct fcgi_head { + unsigned char version; + unsigned char type; + unsigned char requestIdB1; + unsigned char requestIdB0; + unsigned char contentLengthB1; + unsigned char contentLengthB0; + unsigned char paddingLength; + unsigned char reserved; + /* char data[] */ + /* char padding[paddingLength] */ +}; +int packet_parse_http(const char*, int, int*, PacketCallbacks*, void*); +int packet_parse_ssl(const char*, int, PacketCallbacks*, void*); + + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF +ERTS_GLB_INLINE +void packet_get_body(enum PacketParseType htype, const char** bufp, int* lenp) +{ + switch (htype) { + case TCP_PB_1: *bufp += 1; *lenp -= 1; break; + case TCP_PB_2: *bufp += 2; *lenp -= 2; break; + case TCP_PB_4: *bufp += 4; *lenp -= 4; break; + case TCP_PB_FCGI: + *lenp -= ((struct fcgi_head*)*bufp)->paddingLength; + break; + default: + ;/* Return other packets "as is" */ + } +} + +ERTS_GLB_INLINE +int packet_parse(enum PacketParseType htype, const char* buf, int len, + int* statep, PacketCallbacks* pcb, void* arg) +{ + switch (htype) { + case TCP_PB_HTTP: + case TCP_PB_HTTPH: + case TCP_PB_HTTP_BIN: + case TCP_PB_HTTPH_BIN: + if (packet_parse_http(buf, len, statep, pcb, arg) < 0) + pcb->http_error(arg, buf, len); + return 1; + case TCP_PB_SSL_TLS: + return packet_parse_ssl(buf, len, pcb, arg); + default:; + } + return 0; +} +#endif /* ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#endif /* !__PACKET_PARSER_H__ */ + diff --git a/erts/emulator/beam/register.c b/erts/emulator/beam/register.c new file mode 100644 index 0000000000..7ba097382a --- /dev/null +++ b/erts/emulator/beam/register.c @@ -0,0 +1,655 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Manage registered processes. + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "hash.h" +#include "atom.h" +#include "register.h" + +static Hash process_reg; + +#define PREG_HASH_SIZE 10 + +#define REG_HASH(term) ((HashValue) atom_val(term)) + +static erts_smp_rwmtx_t regtab_rwmtx; + +#define reg_lock_init() erts_smp_rwmtx_init(®tab_rwmtx, \ + "reg_tab") +#define reg_try_read_lock() erts_smp_rwmtx_tryrlock(®tab_rwmtx) +#define reg_try_write_lock() erts_smp_rwmtx_tryrwlock(®tab_rwmtx) +#define reg_read_lock() erts_smp_rwmtx_rlock(®tab_rwmtx) +#define reg_write_lock() erts_smp_rwmtx_rwlock(®tab_rwmtx) +#define reg_read_unlock() erts_smp_rwmtx_runlock(®tab_rwmtx) +#define reg_write_unlock() erts_smp_rwmtx_rwunlock(®tab_rwmtx) + +#ifdef ERTS_SMP +static ERTS_INLINE void +reg_safe_read_lock(Process *c_p, ErtsProcLocks *c_p_locks) +{ + if (*c_p_locks) { + ASSERT(c_p); + ASSERT(c_p_locks); + ASSERT(*c_p_locks); + + if (reg_try_read_lock() != EBUSY) { +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_proc_lc_might_unlock(c_p, *c_p_locks); +#endif + return; + } + + /* Release process locks in order to avoid deadlock */ + erts_smp_proc_unlock(c_p, *c_p_locks); + *c_p_locks = 0; + } + + reg_read_lock(); +} + +static ERTS_INLINE void +reg_safe_write_lock(Process *c_p, ErtsProcLocks *c_p_locks) +{ + if (*c_p_locks) { + ASSERT(c_p); + ASSERT(c_p_locks); + ASSERT(*c_p_locks); + + if (reg_try_write_lock() != EBUSY) { +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_proc_lc_might_unlock(c_p, *c_p_locks); +#endif + return; + } + + /* Release process locks in order to avoid deadlock */ + erts_smp_proc_unlock(c_p, *c_p_locks); + *c_p_locks = 0; + } + + reg_write_lock(); +} + +static ERTS_INLINE int +is_proc_alive(Process *p) +{ + int res; + erts_pix_lock_t *pixlck = ERTS_PID2PIXLOCK(p->id); + erts_pix_lock(pixlck); + res = !p->is_exiting; + erts_pix_unlock(pixlck); + return res; +} + +#endif + +void register_info(int to, void *to_arg) +{ + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + reg_read_lock(); + hash_info(to, to_arg, &process_reg); + if (lock) + reg_read_unlock(); +} + +static HashValue reg_hash(RegProc* obj) +{ + return REG_HASH(obj->name); +} + +static int reg_cmp(RegProc *tmpl, RegProc *obj) { + return tmpl->name != obj->name; +} + +static RegProc* reg_alloc(RegProc *tmpl) +{ + RegProc* obj = (RegProc*) erts_alloc(ERTS_ALC_T_REG_PROC, sizeof(RegProc)); + if (!obj) { + erl_exit(1, "Can't allocate %d bytes of memory\n", sizeof(RegProc)); + } + obj->name = tmpl->name; + obj->p = tmpl->p; + obj->pt = tmpl->pt; + return obj; +} + +static void reg_free(RegProc *obj) +{ + erts_free(ERTS_ALC_T_REG_PROC, (void*) obj); +} + +void init_register_table(void) +{ + HashFunctions f; + + reg_lock_init(); + + f.hash = (H_FUN) reg_hash; + f.cmp = (HCMP_FUN) reg_cmp; + f.alloc = (HALLOC_FUN) reg_alloc; + f.free = (HFREE_FUN) reg_free; + + hash_init(ERTS_ALC_T_REG_TABLE, &process_reg, "process_reg", + PREG_HASH_SIZE, f); +} + +/* + * Register a process or port (can't be registered twice). + * Returns 0 if name, process or port is already registered. + * + * When smp support is enabled: + * * Assumes that main lock is locked (and only main lock) + * on c_p. + * + */ +int erts_register_name(Process *c_p, Eterm name, Eterm id) +{ + int res = 0; + Process *proc = NULL; + Port *port = NULL; + RegProc r, *rp; + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p); + + if (is_not_atom(name) || name == am_undefined) + return res; + + if (c_p->id == id) /* A very common case I think... */ + proc = c_p; + else { + if (is_not_internal_pid(id) && is_not_internal_port(id)) + return res; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCK_MAIN); + if (is_internal_port(id)) { + port = erts_id2port(id, NULL, 0); + if (!port) + goto done; + } + } + +#ifdef ERTS_SMP + { + ErtsProcLocks proc_locks = proc ? ERTS_PROC_LOCK_MAIN : 0; + reg_safe_write_lock(proc, &proc_locks); + + if (proc && !proc_locks) + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + } +#endif + + if (is_internal_pid(id)) { + if (!proc) + proc = erts_pid2proc(NULL, 0, id, ERTS_PROC_LOCK_MAIN); + r.p = proc; + if (!proc) + goto done; + if (proc->reg) + goto done; + r.pt = NULL; + } + else { + ASSERT(!INVALID_PORT(port, id)); + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(port)); + r.pt = port; + if (r.pt->reg) + goto done; + r.p = NULL; + } + + r.name = name; + + rp = (RegProc*) hash_put(&process_reg, (void*) &r); + if (proc && rp->p == proc) { + if (IS_TRACED_FL(proc, F_TRACE_PROCS)) { + trace_proc(c_p, proc, am_register, name); + } + proc->reg = rp; + } + else if (port && rp->pt == port) { + if (IS_TRACED_FL(port, F_TRACE_PORTS)) { + trace_port(port, am_register, name); + } + port->reg = rp; + } + + if ((rp->p && rp->p->id == id) || (rp->pt && rp->pt->id == id)) { + res = 1; + } + + done: + reg_write_unlock(); + if (port) + erts_smp_port_unlock(port); + if (c_p != proc) { + if (proc) + erts_smp_proc_unlock(proc, ERTS_PROC_LOCK_MAIN); + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); + } + return res; +} + +/* + * + * When smp support is enabled: + * * Assumes that main lock is locked (and only main lock) + * on c_p. + * + * * am_undefined is returned if c_p became exiting. + */ + +Eterm +erts_whereis_name_to_id(Process *c_p, Eterm name) +{ + Eterm res = am_undefined; + HashValue hval; + int ix; + HashBucket* b; +#ifdef ERTS_SMP + ErtsProcLocks c_p_locks = c_p ? ERTS_PROC_LOCK_MAIN : 0; + + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(c_p); + reg_safe_read_lock(c_p, &c_p_locks); + if (c_p && !c_p_locks) + erts_smp_proc_lock(c_p, ERTS_PROC_LOCK_MAIN); +#endif + + hval = REG_HASH(name); + ix = hval % process_reg.size; + b = process_reg.bucket[ix]; + + /* + * Note: We have inlined the code from hash.c for speed. + */ + + while (b) { + RegProc* rp = (RegProc *) b; + if (rp->name == name) { + /* + * SMP NOTE: No need to lock registered entity since it cannot + * be removed without acquiring write reg lock and id on entity + * is read only. + */ + if (rp->p) + res = rp->p->id; + else if (rp->pt) + res = rp->pt->id; + break; + } + b = b->next; + } + + reg_read_unlock(); + + ASSERT(is_internal_pid(res) || is_internal_port(res) || res==am_undefined); + + return res; +} + + +void +erts_whereis_name(Process *c_p, + ErtsProcLocks c_p_locks, + Eterm name, + Process** proc, + ErtsProcLocks need_locks, + int flags, + Port** port) +{ + RegProc* rp = NULL; + HashValue hval; + int ix; + HashBucket* b; +#ifdef ERTS_SMP + ErtsProcLocks current_c_p_locks; + Port *pending_port = NULL; + + if (!c_p) + c_p_locks = 0; + current_c_p_locks = c_p_locks; + + restart: + + reg_safe_read_lock(c_p, ¤t_c_p_locks); + + /* Locked locks: + * - port lock on pending_port if pending_port != NULL + * - read reg lock + * - current_c_p_locks (either c_p_locks or 0) on c_p + */ +#endif + + hval = REG_HASH(name); + ix = hval % process_reg.size; + b = process_reg.bucket[ix]; + + /* + * Note: We have inlined the code from hash.c for speed. + */ + + while (b) { + if (((RegProc *) b)->name == name) { + rp = (RegProc *) b; + break; + } + b = b->next; + } + + if (proc) { + if (!rp) + *proc = NULL; + else { +#ifdef ERTS_SMP + if (!rp->p) + *proc = NULL; + else { + if (need_locks) { + erts_proc_safelock(c_p, + current_c_p_locks, + c_p_locks, + rp->p, + 0, + need_locks); + current_c_p_locks = c_p_locks; + } + if ((flags & ERTS_P2P_FLG_ALLOW_OTHER_X) || is_proc_alive(rp->p)) + *proc = rp->p; + else { + if (need_locks) + erts_smp_proc_unlock(rp->p, need_locks); + *proc = NULL; + } + if (*proc && (flags & ERTS_P2P_FLG_SMP_INC_REFC)) + erts_smp_proc_inc_refc(rp->p); + } +#else + if (rp->p + && ((flags & ERTS_P2P_FLG_ALLOW_OTHER_X) + || rp->p->status != P_EXITING)) + *proc = rp->p; + else + *proc = NULL; +#endif + } + } + + if (port) { + if (!rp || !rp->pt) + *port = NULL; + else { +#ifdef ERTS_SMP + if (pending_port == rp->pt) + pending_port = NULL; + else { + if (pending_port) { + /* Ahh! Registered port changed while reg lock + was unlocked... */ + erts_smp_port_unlock(pending_port); + pending_port = NULL; + } + + if (erts_smp_port_trylock(rp->pt) == EBUSY) { + Eterm id = rp->pt->id; /* id read only... */ + /* Unlock all locks, acquire port lock, and restart... */ + if (current_c_p_locks) { + erts_smp_proc_unlock(c_p, current_c_p_locks); + current_c_p_locks = 0; + } + reg_read_unlock(); + pending_port = erts_id2port(id, NULL, 0); + goto restart; + } + } +#endif + *port = rp->pt; + ERTS_SMP_LC_ASSERT(erts_lc_is_port_locked(*port)); + } + } + +#ifdef ERTS_SMP + if (c_p && !current_c_p_locks) + erts_smp_proc_lock(c_p, c_p_locks); + if (pending_port) + erts_smp_port_unlock(pending_port); +#endif + + reg_read_unlock(); +} + +Process * +erts_whereis_process(Process *c_p, + ErtsProcLocks c_p_locks, + Eterm name, + ErtsProcLocks need_locks, + int flags) +{ + Process *proc; + erts_whereis_name(c_p, c_p_locks, name, &proc, need_locks, flags, NULL); + return proc; +} + + +/* + * Unregister a name + * Return 0 if not registered + * Otherwise returns 1 + * + */ +int erts_unregister_name(Process *c_p, + ErtsProcLocks c_p_locks, + Port *c_prt, + Eterm name) +{ + int res = 0; + RegProc r, *rp; + Port *port = c_prt; +#ifdef ERTS_SMP + ErtsProcLocks current_c_p_locks; + + /* + * SMP note: If 'c_prt != NULL' and 'c_prt->reg->name == name', + * we are *not* allowed to temporarily release the lock + * on c_prt. + */ + + if (!c_p) + c_p_locks = 0; + current_c_p_locks = c_p_locks; + + restart: + + reg_safe_write_lock(c_p, ¤t_c_p_locks); +#endif + + r.name = name; + if (is_non_value(name)) { + /* Unregister current process name */ + ASSERT(c_p); + if (c_p->reg) + r.name = c_p->reg->name; + else { + /* Name got unregistered while main lock was released */ + res = 0; + goto done; + } + } + + if ((rp = (RegProc*) hash_get(&process_reg, (void*) &r)) != NULL) { + if (rp->pt) { +#ifdef ERTS_SMP + if (port != rp->pt) { + if (port) { + ERTS_SMP_LC_ASSERT(port != c_prt); + erts_smp_port_unlock(port); + port = NULL; + } + + if (erts_smp_port_trylock(rp->pt) == EBUSY) { + Eterm id = rp->pt->id; /* id read only... */ + /* Unlock all locks, acquire port lock, and restart... */ + if (current_c_p_locks) { + erts_smp_proc_unlock(c_p, current_c_p_locks); + current_c_p_locks = 0; + } + reg_write_unlock(); + port = erts_id2port(id, NULL, 0); + goto restart; + } + port = rp->pt; + } +#endif + ERTS_SMP_LC_ASSERT(rp->pt == port && erts_lc_is_port_locked(port)); + rp->pt->reg = NULL; + + if (IS_TRACED_FL(port, F_TRACE_PORTS)) { + trace_port(port, am_unregister, r.name); + } + + } else if (rp->p) { + Process* p = rp->p; +#ifdef ERTS_SMP + erts_proc_safelock(c_p, + current_c_p_locks, + c_p_locks, + rp->p, + 0, + ERTS_PROC_LOCK_MAIN); + current_c_p_locks = c_p_locks; +#endif + p->reg = NULL; +#ifdef ERTS_SMP + if (rp->p != c_p) + erts_smp_proc_unlock(rp->p, ERTS_PROC_LOCK_MAIN); +#endif + if (IS_TRACED_FL(p, F_TRACE_PROCS)) { + trace_proc(c_p, p, am_unregister, r.name); + } + } + hash_erase(&process_reg, (void*) &r); + res = 1; + } + + done: + + reg_write_unlock(); + if (c_prt != port) { + if (port) + erts_smp_port_unlock(port); + if (c_prt) + erts_smp_port_lock(c_prt); + } +#ifdef ERTS_SMP + if (c_p && !current_c_p_locks) + erts_smp_proc_lock(c_p, c_p_locks); +#endif + return res; +} + +int process_reg_size(void) +{ + int size; + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + reg_read_lock(); + size = process_reg.size; + if (lock) + reg_read_unlock(); + return size; +} + +int process_reg_sz(void) +{ + int sz; + int lock = !ERTS_IS_CRASH_DUMPING; + if (lock) + reg_read_lock(); + sz = hash_table_sz(&process_reg); + if (lock) + reg_read_unlock(); + return sz; +} + +/**********************************************************************/ + +#include "bif.h" + +/* return a list of the registered processes */ + +BIF_RETTYPE registered_0(BIF_ALIST_0) +{ + int i; + Eterm res; + Uint need; + Eterm* hp; + HashBucket **bucket; +#ifdef ERTS_SMP + ErtsProcLocks proc_locks = ERTS_PROC_LOCK_MAIN; + + ERTS_SMP_CHK_HAVE_ONLY_MAIN_PROC_LOCK(BIF_P); + reg_safe_read_lock(BIF_P, &proc_locks); + if (!proc_locks) + erts_smp_proc_lock(BIF_P, ERTS_PROC_LOCK_MAIN); +#endif + + bucket = process_reg.bucket; + + /* work out how much heap we need & maybe garb, by scanning through + the registered process table */ + need = 0; + for (i = 0; i < process_reg.size; i++) { + HashBucket *b = bucket[i]; + while (b != NULL) { + need += 2; + b = b->next; + } + } + + if (need == 0) { + reg_read_unlock(); + BIF_RET(NIL); + } + + hp = HAlloc(BIF_P, need); + + /* scan through again and make the list */ + res = NIL; + + for (i = 0; i < process_reg.size; i++) { + HashBucket *b = bucket[i]; + while (b != NULL) { + RegProc *reg = (RegProc *) b; + + res = CONS(hp, reg->name, res); + hp += 2; + b = b->next; + } + } + + reg_read_unlock(); + + BIF_RET(res); +} diff --git a/erts/emulator/beam/register.h b/erts/emulator/beam/register.h new file mode 100644 index 0000000000..97bab3ab71 --- /dev/null +++ b/erts/emulator/beam/register.h @@ -0,0 +1,66 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** Registered processes +*/ + +#ifndef __REGPROC_H__ +#define __REGPROC_H__ + +#ifndef __SYS_H__ +#include "sys.h" +#endif + +#ifndef __HASH_H__ +#include "hash.h" +#endif + +#ifndef __PROCESS_H__ +#include "erl_process.h" +#endif + +struct port; + +typedef struct reg_proc +{ + HashBucket bucket; /* MUST BE LOCATED AT TOP OF STRUCT!!! */ + Process *p; /* The process registerd (only one of this and + 'pt' is non-NULL */ + struct port *pt; /* The port registered */ + Eterm name; /* Atom name */ +} RegProc; + +int process_reg_size(void); +int process_reg_sz(void); +void init_register_table(void); +void register_info(int, void *); +int erts_register_name(Process *, Eterm, Eterm); +Eterm erts_whereis_name_to_id(Process *, Eterm); +void erts_whereis_name(Process *, ErtsProcLocks, + Eterm, Process**, ErtsProcLocks, int, + struct port**); +Process *erts_whereis_process(Process *, + ErtsProcLocks, + Eterm, + ErtsProcLocks, + int); +int erts_unregister_name(Process *, ErtsProcLocks, struct port *, Eterm); + +#endif diff --git a/erts/emulator/beam/safe_hash.c b/erts/emulator/beam/safe_hash.c new file mode 100644 index 0000000000..21d6ce9304 --- /dev/null +++ b/erts/emulator/beam/safe_hash.c @@ -0,0 +1,276 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** General thread safe hash table. Simular interface as hash.h +** +** Author: Sverker Eriksson +*/ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "safe_hash.h" + +/* Currently only used by erl_check_io on Windows */ +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + + +static ERTS_INLINE void set_size(SafeHash* h, int size) +{ + ASSERT(size % SAFE_HASH_LOCK_CNT == 0); + /* This important property allows us to lock the right mutex + ** without reading the table size (that can change without the lock) */ + + h->size_mask = size - 1; + ASSERT((size & h->size_mask) == 0); + /* An even power of 2 is just for fast bit masking */ + + h->grow_limit = size; /* grow table at 100% load */ +} + +static ERTS_INLINE int align_up_pow2(int val) +{ + int x = val & (val-1); + if (x==0) return val ? val : 1; + do { + val = x; + x &= x - 1; + }while (x); + return val << 1; +} + +/* +** Rehash all objects +*/ +static void rehash(SafeHash* h, int grow_limit) +{ + if (erts_smp_atomic_xchg(&h->is_rehashing, 1) != 0) { + return; /* already in progress */ + } + if (h->grow_limit == grow_limit) { + int i, size, bytes; + SafeHashBucket** new_tab; + SafeHashBucket** old_tab = h->tab; + int old_size = h->size_mask + 1; + + size = old_size * 2; /* double table size */ + bytes = size * sizeof(SafeHashBucket*); + new_tab = (SafeHashBucket **) erts_alloc(h->type, bytes); + sys_memzero(new_tab, bytes); + + for (i=0; ilock_vec[i].mtx); + } + + h->tab = new_tab; + set_size(h, size); + + for (i = 0; i < old_size; i++) { + SafeHashBucket* b = old_tab[i]; + while (b != NULL) { + SafeHashBucket* b_next = b->next; + int ix = b->hvalue & h->size_mask; + b->next = new_tab[ix]; + new_tab[ix] = b; + b = b_next; + } + } + + for (i=0; ilock_vec[i].mtx); + } + erts_free(h->type, (void *) old_tab); + } + /*else already done */ + erts_smp_atomic_set(&h->is_rehashing, 0); +} + + +/* +** Get info about hash +*/ +void safe_hash_get_info(SafeHashInfo *hi, SafeHash *h) +{ + int size; + int i, lock_ix; + int max_depth = 0; + int objects = 0; + + for (lock_ix=0; lock_ixlock_vec[lock_ix].mtx); + size = h->size_mask + 1; + for (i = lock_ix; i < size; i += SAFE_HASH_LOCK_CNT) { + int depth = 0; + SafeHashBucket* b = h->tab[i]; + while (b != NULL) { + objects++; + depth++; + b = b->next; + } + if (depth > max_depth) + max_depth = depth; + } + erts_smp_mtx_unlock(&h->lock_vec[lock_ix].mtx); + } + + hi->name = h->name; + hi->size = size; + hi->objs = objects; + hi->depth = max_depth; +} + +/* +** Returns size of table in bytes. Stored objects not included. +**/ +int safe_hash_table_sz(SafeHash *h) +{ + int i, size; + for(i=0; h->name[i]; i++); + i++; + erts_smp_mtx_lock(&h->lock_vec[0].mtx); /* any lock will do to read size */ + size = h->size_mask + 1; + erts_smp_mtx_unlock(&h->lock_vec[0].mtx); + return sizeof(SafeHash) + size*sizeof(SafeHashBucket*) + i; +} + +/* +** Init a pre allocated or static hash structure +** and allocate buckets. NOT SAFE +*/ +SafeHash* safe_hash_init(ErtsAlcType_t type, SafeHash* h, char* name, int size, SafeHashFunctions fun) +{ + int i, bytes; + + size = align_up_pow2(size); + bytes = size * sizeof(SafeHashBucket*); + h->type = type; + h->tab = (SafeHashBucket**) erts_alloc(h->type, bytes); + sys_memzero(h->tab, bytes); + h->name = name; + h->fun = fun; + set_size(h,size); + erts_smp_atomic_init(&h->is_rehashing, 0); + erts_smp_atomic_init(&h->nitems, 0); + for (i=0; ilock_vec[i].mtx,"safe_hash"); + } + return h; +} + + +/* +** Find an object in the hash table +*/ +void* safe_hash_get(SafeHash* h, void* tmpl) +{ + SafeHashValue hval = h->fun.hash(tmpl); + SafeHashBucket* b; + erts_smp_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx; + erts_smp_mtx_lock(lock); + b = h->tab[hval & h->size_mask]; + + while(b != NULL) { + if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) + break; + b = b->next; + } + erts_smp_mtx_unlock(lock); + return (void*) b; +} + +/* +** Find or insert an object in the hash table +*/ +void* safe_hash_put(SafeHash* h, void* tmpl) +{ + int grow_limit; + SafeHashValue hval = h->fun.hash(tmpl); + SafeHashBucket* b; + SafeHashBucket** head; + erts_smp_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx; + erts_smp_mtx_lock(lock); + head = &h->tab[hval & h->size_mask]; + b = *head; + while(b != NULL) { + if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) { + erts_smp_mtx_unlock(lock); + return b; + } + b = b->next; + } + + b = (SafeHashBucket*) h->fun.alloc(tmpl); + b->hvalue = hval; + b->next = *head; + *head = b; + grow_limit = h->grow_limit; + erts_smp_mtx_unlock(lock); + if (erts_smp_atomic_inctest(&h->nitems) > grow_limit) { + rehash(h, grow_limit); + } + return (void*) b; +} + +/* +** Erase hash entry return template if erased +** return 0 if not erased +*/ +void* safe_hash_erase(SafeHash* h, void* tmpl) +{ + SafeHashValue hval = h->fun.hash(tmpl); + SafeHashBucket* b; + SafeHashBucket** prevp; + erts_smp_mtx_t* lock = &h->lock_vec[hval % SAFE_HASH_LOCK_CNT].mtx; + erts_smp_mtx_lock(lock); + prevp = &h->tab[hval & h->size_mask]; + b = *prevp; + while(b != NULL) { + if ((b->hvalue == hval) && (h->fun.cmp(tmpl, (void*)b) == 0)) { + *prevp = b->next; + erts_smp_mtx_unlock(lock); + erts_smp_atomic_dec(&h->nitems); + h->fun.free((void*)b); + return tmpl; + } + prevp = &b->next; + b = b->next; + } + erts_smp_mtx_unlock(lock); + return NULL; +} + +/* +** Call 'func(obj,func_arg2)' for all objects in table. NOT SAFE!!! +*/ +void safe_hash_for_each(SafeHash* h, void (*func)(void *, void *), void *func_arg2) +{ + int i; + + for (i = 0; i <= h->size_mask; i++) { + SafeHashBucket* b = h->tab[i]; + while (b != NULL) { + (*func)((void *) b, func_arg2); + b = b->next; + } + } +} + +#endif /* !ERTS_SYS_CONTINOUS_FD_NUMBERS */ + diff --git a/erts/emulator/beam/safe_hash.h b/erts/emulator/beam/safe_hash.h new file mode 100644 index 0000000000..c691126ef9 --- /dev/null +++ b/erts/emulator/beam/safe_hash.h @@ -0,0 +1,104 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* +** General thread safe hash table. Simular interface as hash.h +** +** Author: Sverker Eriksson +*/ +#ifndef __SAFE_HASH_H__ +#define __SAFE_HASH_H__ + + +#ifndef __SYS_H__ +#include "sys.h" +#endif + +#include "erl_alloc.h" + + +typedef unsigned long SafeHashValue; + +typedef int (*SHCMP_FUN)(void*, void*); +typedef SafeHashValue (*SH_FUN)(void*); +typedef void* (*SHALLOC_FUN)(void*); +typedef void (*SHFREE_FUN)(void*); + +/* +** This bucket must be placed in top of +** every object that uses hashing!!! +** (Object*) == (Object*) &bucket +*/ +typedef struct safe_hashbucket +{ + struct safe_hashbucket* next; /* Next bucket */ + SafeHashValue hvalue; /* Store hash value for get, rehash */ +} SafeHashBucket; + +typedef struct safe_hashfunctions +{ + SH_FUN hash; + SHCMP_FUN cmp; + SHALLOC_FUN alloc; + SHFREE_FUN free; +} SafeHashFunctions; + +typedef struct { + char *name; + int size; + int used; + int objs; + int depth; +} SafeHashInfo; + +#define SAFE_HASH_LOCK_CNT 16 +typedef struct +{ + SafeHashFunctions fun; /* (C) Function block */ + ErtsAlcType_t type; /* (C) */ + char* name; /* (C) Table name (static, for debugging) */ + int size_mask; /* (RW) Number of slots - 1 */ + SafeHashBucket** tab; /* (RW) Vector of bucket pointers (objects) */ + int grow_limit; /* (RW) Threshold for growing table */ + erts_smp_atomic_t nitems; /* (A) Number of items in table */ + erts_smp_atomic_t is_rehashing; /* (A) Table rehashing in progress */ + + union { + erts_smp_mtx_t mtx; + byte __cache_line__[64]; + }lock_vec[SAFE_HASH_LOCK_CNT]; + + /* C: Constants initialized once */ + /* RW: One lock (or is_rehashing) to read and _all_ locks to write */ + /* A: Lockless atomics */ +} SafeHash; + +SafeHash* safe_hash_init(ErtsAlcType_t, SafeHash*, char*, int, SafeHashFunctions); + +void safe_hash_get_info(SafeHashInfo*, SafeHash*); +int safe_hash_table_sz(SafeHash *); + +void* safe_hash_get(SafeHash*, void*); +void* safe_hash_put(SafeHash*, void*); +void* safe_hash_erase(SafeHash*, void*); + +void safe_hash_for_each(SafeHash*, void (*func)(void *, void *), void *); + +#endif /* __SAFE_HASH_H__ */ + diff --git a/erts/emulator/beam/sys.h b/erts/emulator/beam/sys.h new file mode 100644 index 0000000000..71cb6a36cc --- /dev/null +++ b/erts/emulator/beam/sys.h @@ -0,0 +1,1257 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef __SYS_H__ +#define __SYS_H__ + +#if defined(VALGRIND) && !defined(NO_FPE_SIGNALS) +# define NO_FPE_SIGNALS +#endif + +/* Never use elib-malloc when purify-memory-tracing */ +#if defined(PURIFY) +#undef ENABLE_ELIB_MALLOC +#undef ELIB_HEAP_SBRK +#undef ELIB_ALLOC_IS_CLIB +#endif + + +/* xxxP __VXWORKS__ */ +#ifdef VXWORKS +#include +#endif + +#ifdef DISABLE_CHILD_WAITER_THREAD +#undef ENABLE_CHILD_WAITER_THREAD +#endif + +#if defined(ERTS_SMP) && !defined(DISABLE_CHILD_WAITER_THREAD) +#undef ENABLE_CHILD_WAITER_THREAD +#define ENABLE_CHILD_WAITER_THREAD 1 +#endif + +/* The ERTS_TIMER_TREAD #define must be visible to the + erl_${OS}_sys.h #include files: it controls whether + certain optional facilities should be defined or not. */ +#if defined(ERTS_SMP) && 0 +#define ERTS_TIMER_THREAD +#endif + +#if defined (__WIN32__) +# include "erl_win_sys.h" +#elif defined (VXWORKS) +# include "erl_vxworks_sys.h" +#elif defined (_OSE_) +# include "erl_ose_sys.h" +#else +# include "erl_unix_sys.h" +#ifndef UNIX +# define UNIX 1 +#endif +#endif + +#include "erl_misc_utils.h" + +/* + * To allow building of Universal Binaries for Mac OS X, + * we must not depend on the endian detected by the configure script. + */ +#if defined(__APPLE__) +# if defined(__BIG_ENDIAN__) && !defined(WORDS_BIGENDIAN) +# define WORDS_BIGENDIAN 1 +# elif !defined(__BIG_ENDIAN__) && defined(WORDS_BIGENDIAN) +# undef WORDS_BIGENDIAN +# endif +#endif + +/* + * Make sure we have a type for FD's (used by erl_check_io) + */ + +#ifndef ERTS_SYS_FD_TYPE +typedef int ErtsSysFdType; +#else +typedef ERTS_SYS_FD_TYPE ErtsSysFdType; +#endif + +#ifdef ERTS_INLINE +# ifndef ERTS_CAN_INLINE +# define ERTS_CAN_INLINE 1 +# endif +#else +# if defined(__GNUC__) +# define ERTS_CAN_INLINE 1 +# define ERTS_INLINE __inline__ +# elif defined(__WIN32__) +# define ERTS_CAN_INLINE 1 +# define ERTS_INLINE __inline +# else +# define ERTS_CAN_INLINE 0 +# define ERTS_INLINE +# endif +#endif + +#ifdef __GNUC__ +# if __GNUC__ < 3 && (__GNUC__ != 2 || __GNUC_MINOR__ < 96) +# define ERTS_LIKELY(BOOL) (BOOL) +# define ERTS_UNLIKELY(BOOL) (BOOL) +# else +# define ERTS_LIKELY(BOOL) __builtin_expect((BOOL), !0) +# define ERTS_UNLIKELY(BOOL) __builtin_expect((BOOL), 0) +# endif +#else +# define ERTS_LIKELY(BOOL) (BOOL) +# define ERTS_UNLIKELY(BOOL) (BOOL) +#endif + +#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK) +# undef ERTS_CAN_INLINE +# define ERTS_CAN_INLINE 0 +# undef ERTS_INLINE +# define ERTS_INLINE +#endif + +#if ERTS_CAN_INLINE +#define ERTS_GLB_INLINE static ERTS_INLINE +#else +#define ERTS_GLB_INLINE +#endif + +#if ERTS_CAN_INLINE || defined(ERTS_DO_INCL_GLB_INLINE_FUNC_DEF) +# define ERTS_GLB_INLINE_INCL_FUNC_DEF 1 +#else +# define ERTS_GLB_INLINE_INCL_FUNC_DEF 0 +#endif + +#ifndef ERTS_EXIT_AFTER_DUMP +# define ERTS_EXIT_AFTER_DUMP exit +#endif + +#ifdef DEBUG +# define ASSERT(e) \ + if (e) { \ + ; \ + } else { \ + erl_assert_error(#e, __FILE__, __LINE__); \ + } +# define ASSERT_EXPR(e) \ + ((void) ((e) ? 1 : (erl_assert_error(#e, __FILE__, __LINE__), 0))) +void erl_assert_error(char* expr, char* file, int line); +#else +# define ASSERT(e) +# define ASSERT_EXPR(e) ((void) 1) +#endif + +/* + * Microsoft C/C++: We certainly want to use stdarg.h and prototypes. + * But MSC doesn't define __STDC__, unless we compile with the -Za + * flag (strict ANSI C, no Microsoft extension). Compiling with -Za + * doesn't work: some Microsoft headers fail to compile... + * + * Solution: Test if __STDC__ or _MSC_VER is defined. + * + * Note: Simply defining __STDC__ doesn't work, as some Microsoft + * headers will fail to compile! + */ + +#include + +#if defined(__STDC__) || defined(_MSC_VER) +# define EXTERN_FUNCTION(t, f, x) extern t f x +# define FUNCTION(t, f, x) t f x +# define _DOTS_ ... +# define _VOID_ void +#elif defined(__cplusplus) +# define EXTERN_FUNCTION(f, x) extern "C" { f x } +# define FUNCTION(t, f, x) t f x +# define _DOTS_ ... +# define _VOID_ void +#else +# define EXTERN_FUNCTION(t, f, x) extern t f (/*x*/) +# define FUNCTION(t, f, x) t f (/*x*/) +# define _DOTS_ +# define _VOID_ +#endif + +/* This isn't sys-dependent, but putting it here benefits sys.c and drivers + - allow use of 'const' regardless of compiler */ + +#if !defined(__STDC__) && !defined(_MSC_VER) +# define const +#endif + +#ifdef VXWORKS +/* Replace VxWorks' printf with a real one that does fprintf(stdout, ...) */ +EXTERN_FUNCTION(int, real_printf, (const char *fmt, ...)); +# define printf real_printf +#endif + +/* In VC++, noreturn is a declspec that has to be before the types, + * but in GNUC it is an att ribute to be placed between return type + * and function name, hence __decl_noreturn __noreturn + */ +#if __GNUC__ +# define __decl_noreturn +# define __noreturn __attribute__((noreturn)) +# undef __deprecated +# if __GNUC__ >= 3 +# define __deprecated __attribute__((deprecated)) +# else +# define __deprecated +# endif +#else +# if defined(__WIN32__) && defined(_MSC_VER) +# define __noreturn +# define __decl_noreturn __declspec(noreturn) +# else +# define __noreturn +# define __decl_noreturn +# endif +# define __deprecated +#endif + +/* +** Data types: +** +** Eterm: A tagged erlang term (possibly 64 bits) +** UInt: An unsigned integer exactly as large as an Eterm. +** SInt: A signed integer exactly as large as an eterm and therefor large +** enough to hold the return value of the signed_val() macro. +** Uint32: An unsigned integer of 32 bits exactly +** Sint32: A signed integer of 32 bits exactly +** Uint16: An unsigned integer of 16 bits exactly +** Sint16: A signed integer of 16 bits exactly. +*/ + +#if SIZEOF_VOID_P == 8 +#undef ARCH_32 +#define ARCH_64 +#elif SIZEOF_VOID_P == 4 +#define ARCH_32 +#undef ARCH_64 +#else +#error Neither 32 nor 64 bit architecture +#endif + +#if SIZEOF_VOID_P != SIZEOF_SIZE_T +#error sizeof(void*) != sizeof(size_t) +#endif + +#if SIZEOF_VOID_P == SIZEOF_LONG +typedef unsigned long Eterm; +typedef unsigned long Uint; +typedef long Sint; +#define ERTS_SIZEOF_ETERM SIZEOF_LONG +#elif SIZEOF_VOID_P == SIZEOF_INT +typedef unsigned int Eterm; +typedef unsigned int Uint; +typedef int Sint; +#define ERTS_SIZEOF_ETERM SIZEOF_INT +#else +#error Found no appropriate type to use for 'Eterm', 'Uint' and 'Sint' +#endif + +#ifndef HAVE_INT64 +#if SIZEOF_LONG == 8 +#define HAVE_INT64 1 +typedef unsigned long Uint64; +typedef long Sint64; +#elif SIZEOF_LONG_LONG == 8 +#define HAVE_INT64 1 +typedef unsigned long long Uint64; +typedef long long Sint64; +#else +#define HAVE_INT64 0 +#endif +#endif + +#if SIZEOF_LONG == 4 +typedef unsigned long Uint32; +typedef long Sint32; +#elif SIZEOF_INT == 4 +typedef unsigned int Uint32; +typedef int Sint32; +#else +#error Found no appropriate type to use for 'Uint32' and 'Sint32' +#endif + +#if SIZEOF_INT == 2 +typedef unsigned int Uint16; +typedef int Sint16; +#elif SIZEOF_SHORT == 2 +typedef unsigned short Uint16; +typedef short Sint16; +#else +#error Found no appropriate type to use for 'Uint16' and 'Sint16' +#endif + +#if CHAR_BIT == 8 +typedef unsigned char byte; +#else +#error Found no appropriate type to use for 'byte' +#endif + +#if defined(ARCH_64) && !HAVE_INT64 +#error 64-bit architecture, but no appropriate type to use for Uint64 and Sint64 found +#endif + +#if defined(ARCH_64) +# define ERTS_WORD_ALIGN_PAD_SZ(X) \ + (((size_t) 8) - (((size_t) (X)) & ((size_t) 7))) +#elif defined(ARCH_32) +# define ERTS_WORD_ALIGN_PAD_SZ(X) \ + (((size_t) 4) - (((size_t) (X)) & ((size_t) 3))) +#else +#error "Not supported..." +#endif + +#include "erl_lock_check.h" +#include "erl_smp.h" + +#ifdef ERTS_WANT_BREAK_HANDLING +# ifdef ERTS_SMP +extern erts_smp_atomic_t erts_break_requested; +# define ERTS_BREAK_REQUESTED ((int) erts_smp_atomic_read(&erts_break_requested)) +# else +extern volatile int erts_break_requested; +# define ERTS_BREAK_REQUESTED erts_break_requested +# endif +void erts_do_break_handling(void); +#endif + +#ifdef ERTS_WANT_GOT_SIGUSR1 +# ifndef UNIX +# define ERTS_GOT_SIGUSR1 0 +# else +# ifdef ERTS_SMP +extern erts_smp_atomic_t erts_got_sigusr1; +# define ERTS_GOT_SIGUSR1 ((int) erts_smp_atomic_read(&erts_got_sigusr1)) +# else +extern volatile int erts_got_sigusr1; +# define ERTS_GOT_SIGUSR1 erts_got_sigusr1 +# endif +# endif +#endif + +#ifdef ERTS_SMP +extern erts_smp_atomic_t erts_writing_erl_crash_dump; +#define ERTS_IS_CRASH_DUMPING \ + ((int) erts_smp_atomic_read(&erts_writing_erl_crash_dump)) +#else +extern volatile int erts_writing_erl_crash_dump; +#define ERTS_IS_CRASH_DUMPING erts_writing_erl_crash_dump +#endif + +/* Deal with memcpy() vs bcopy() etc. We want to use the mem*() functions, + but be able to fall back on bcopy() etc on systems that don't have + mem*(), but this doesn't work to well with memset()/bzero() - thus the + memzero() macro. +*/ + +/* xxxP */ +#if defined(USE_BCOPY) +# define memcpy(a, b, c) bcopy((b), (a), (c)) +# define memcmp(a, b, c) bcmp((a), (b), (c)) +# define memzero(buf, len) bzero((buf), (len)) +#else +# define memzero(buf, len) memset((buf), '\0', (len)) +#endif + +/* Stuff that is useful for port programs, drivers, etc */ + +#ifdef ISC32 /* Too much for the Makefile... */ +# define signal sigset +# define NO_ASINH +# define NO_ACOSH +# define NO_ATANH +# define NO_FTRUNCATE +# define SIG_SIGHOLD +# define _POSIX_SOURCE +# define _XOPEN_SOURCE +#endif + +#ifdef QNX /* Too much for the Makefile... */ +# define SYS_SELECT_H +# define NO_ERF +# define NO_ERFC +/* This definition doesn't take NaN into account, but matherr() gets those */ +# define finite(x) (fabs(x) != HUGE_VAL) +# define USE_MATHERR +# define HAVE_FINITE +#endif + + +#ifdef WANT_NONBLOCKING /* must define this to pull in fcntl.h/ioctl.h */ + +/* This is really a mess... We used to use fcntl O_NDELAY, but that seems + to only work on SunOS 4 - in particular, on SysV-based systems + (including Solaris 2), it does set non-blocking mode, but causes + read() to return 0!! fcntl O_NONBLOCK is specified by POSIX, and + seems to work on most systems, with the notable exception of AIX, + where the old ioctl FIONBIO is the *only* one that will set a *socket* + in non-blocking mode - and ioctl FIONBIO on AIX *doesn't* work for + pipes or ttys (O_NONBLOCK does)!!! For now, we'll use FIONBIO for AIX. */ + +# ifdef _OSE_ +static const int zero_value = 0, one_value = 1; +# define SET_BLOCKING(fd) ioctl((fd), FIONBIO, (char*)&zero_value) +# define SET_NONBLOCKING(fd) ioctl((fd), FIONBIO, (char*)&one_value) +# define ERRNO_BLOCK EWOULDBLOCK +# else + +# ifdef __WIN32__ + +static unsigned long zero_value = 0, one_value = 1; +# define SET_BLOCKING(fd) { if (ioctlsocket((fd), FIONBIO, &zero_value) != 0) fprintf(stderr, "Error setting socket to non-blocking: %d\n", WSAGetLastError()); } +# define SET_NONBLOCKING(fd) ioctlsocket((fd), FIONBIO, &one_value) + +# else +# ifdef VXWORKS +# include /* xxxP added for O_WRONLY etc ... macro:s ... */ +# include +static const int zero_value = 0, one_value = 1; +# define SET_BLOCKING(fd) ioctl((fd), FIONBIO, (int)&zero_value) +# define SET_NONBLOCKING(fd) ioctl((fd), FIONBIO, (int)&one_value) +# define ERRNO_BLOCK EWOULDBLOCK + +# else +# ifdef NB_FIONBIO /* Old BSD */ +# include + static const int zero_value = 0, one_value = 1; +# define SET_BLOCKING(fd) ioctl((fd), FIONBIO, &zero_value) +# define SET_NONBLOCKING(fd) ioctl((fd), FIONBIO, &one_value) +# define ERRNO_BLOCK EWOULDBLOCK +# else /* !NB_FIONBIO */ +# include +# ifdef NB_O_NDELAY /* Nothing needs this? */ +# define NB_FLAG O_NDELAY +# ifndef ERRNO_BLOCK /* allow override (e.g. EAGAIN) via Makefile */ +# define ERRNO_BLOCK EWOULDBLOCK +# endif +# else /* !NB_O_NDELAY */ /* The True Way - POSIX!:-) */ +# define NB_FLAG O_NONBLOCK +# define ERRNO_BLOCK EAGAIN +# endif /* !NB_O_NDELAY */ +# define SET_BLOCKING(fd) fcntl((fd), F_SETFL, \ + fcntl((fd), F_GETFL, 0) & ~NB_FLAG) +# define SET_NONBLOCKING(fd) fcntl((fd), F_SETFL, \ + fcntl((fd), F_GETFL, 0) | NB_FLAG) +# endif /* !NB_FIONBIO */ +# endif /* _WXWORKS_ */ +# endif /* !__WIN32__ */ +# endif /* _OSE_ */ +#endif /* WANT_NONBLOCKING */ + +extern erts_cpu_info_t *erts_cpuinfo; /* erl_init.c */ + +__decl_noreturn void __noreturn erl_exit(int n, char*, ...); + +/* Some special erl_exit() codes: */ +#define ERTS_INTR_EXIT INT_MIN /* called from signal handler */ +#define ERTS_ABORT_EXIT (INT_MIN + 1) /* no crash dump; only abort() */ +#define ERTS_DUMP_EXIT (127) /* crash dump; then exit() */ + + +#ifndef ERTS_SMP +int check_async_ready(void); +#ifdef USE_THREADS +void sys_async_ready(int hndl); +int erts_register_async_ready_callback(void (*funcp)(void)); +#endif +#endif + +Eterm erts_check_io_info(void *p); + +/* Size of misc memory allocated from system dependent code */ +Uint erts_sys_misc_mem_sz(void); + +/* print stuff is declared here instead of in global.h, so sys stuff won't + have to include global.h */ +#include "erl_printf.h" + +/* Io constants to erts_print and erts_putc */ +#define ERTS_PRINT_STDERR (2) +#define ERTS_PRINT_STDOUT (1) +#define ERTS_PRINT_INVALID (0) /* Don't want to use 0 since CBUF was 0 */ +#define ERTS_PRINT_FILE (-1) +#define ERTS_PRINT_SBUF (-2) +#define ERTS_PRINT_SNBUF (-3) +#define ERTS_PRINT_DSBUF (-4) + +#define ERTS_PRINT_MIN ERTS_PRINT_DSBUF + +typedef struct { + char *buf; + size_t size; +} erts_print_sn_buf; + +int erts_print(int to, void *arg, char *format, ...); /* in utils.c */ +int erts_putc(int to, void *arg, char); /* in utils.c */ + +/* logger stuff is declared here instead of in global.h, so sys files + won't have to include global.h */ + +erts_dsprintf_buf_t *erts_create_logger_dsbuf(void); +int erts_send_info_to_logger(Eterm, erts_dsprintf_buf_t *); +int erts_send_warning_to_logger(Eterm, erts_dsprintf_buf_t *); +int erts_send_error_to_logger(Eterm, erts_dsprintf_buf_t *); +int erts_send_info_to_logger_str(Eterm, char *); +int erts_send_warning_to_logger_str(Eterm, char *); +int erts_send_error_to_logger_str(Eterm, char *); +int erts_send_info_to_logger_nogl(erts_dsprintf_buf_t *); +int erts_send_warning_to_logger_nogl(erts_dsprintf_buf_t *); +int erts_send_error_to_logger_nogl(erts_dsprintf_buf_t *); +int erts_send_info_to_logger_str_nogl(char *); +int erts_send_warning_to_logger_str_nogl(char *); +int erts_send_error_to_logger_str_nogl(char *); + +typedef struct preload { + char *name; /* Name of module */ + int size; /* Size of code */ + unsigned char* code; /* Code pointer */ +} Preload; + + +/* + * This structure contains options to all built in drivers. + * None of the drivers use all of the fields. + */ + +/* OSE: Want process_type and priority in here as well! Needs updates in erl_bif_ports.c! */ + +typedef struct _SysDriverOpts { + int ifd; /* Input file descriptor (fd driver). */ + int ofd; /* Outputfile descriptor (fd driver). */ + int packet_bytes; /* Number of bytes in packet header. */ + int read_write; /* Read and write bits. */ + int use_stdio; /* Use standard I/O: TRUE or FALSE. */ + int redir_stderr; /* Redirect stderr to stdout: TRUE/FALSE. */ + int hide_window; /* Hide this windows (Windows). */ + int exit_status; /* Report exit status of subprocess. */ + int overlapped_io; /* Only has effect on windows NT et al */ + char *envir; /* Environment of the port process, */ + /* in Windows format. */ + char **argv; /* Argument vector in Unix'ish format. */ + char *wd; /* Working directory. */ + unsigned spawn_type; /* Bitfield of ERTS_SPAWN_DRIVER | + ERTS_SPAWN_EXTERNAL | both*/ + +#ifdef _OSE_ + enum PROCESS_TYPE process_type; + OSPRIORITY priority; +#endif /* _OSE_ */ + +} SysDriverOpts; + +extern char *erts_default_arg0; + +extern char os_type[]; + +extern int sys_init_time(void); +#if defined(ERTS_TIMER_THREAD) +#define erts_deliver_time() +#else +extern void erts_deliver_time(void); +#endif +extern void erts_time_remaining(SysTimeval *); +extern int erts_init_time_sup(void); +extern void erts_sys_init_float(void); +extern void erts_thread_init_float(void); +extern void erts_thread_disable_fpe(void); + +ERTS_GLB_INLINE int erts_block_fpe(void); +ERTS_GLB_INLINE void erts_unblock_fpe(int); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE int erts_block_fpe(void) +{ + return erts_sys_block_fpe(); +} + +ERTS_GLB_INLINE void erts_unblock_fpe(int unmasked) +{ + erts_sys_unblock_fpe(unmasked); +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + + +/* Dynamic library/driver loading */ +typedef struct { + char* str; +}ErtsSysDdllError; +#define ERTS_SYS_DDLL_ERROR_INIT {NULL} +extern void erts_sys_ddll_free_error(ErtsSysDdllError*); +extern void erl_sys_ddll_init(void); /* to initialize mutexes etc */ +extern int erts_sys_ddll_open2(char *path, void **handle, ErtsSysDdllError*); +#define erts_sys_ddll_open(P,H) erts_sys_ddll_open2(P,H,NULL) +extern int erts_sys_ddll_open_noext(char *path, void **handle, ErtsSysDdllError*); +extern int erts_sys_ddll_load_driver_init(void *handle, void **function); +extern int erts_sys_ddll_load_nif_init(void *handle, void **function,ErtsSysDdllError*); +extern int erts_sys_ddll_close2(void *handle, ErtsSysDdllError*); +#define erts_sys_ddll_close(H) erts_sys_ddll_close2(H,NULL) +extern void *erts_sys_ddll_call_init(void *function); +extern void *erts_sys_ddll_call_nif_init(void *function); +extern int erts_sys_ddll_sym2(void *handle, char *name, void **function, ErtsSysDdllError*); +#define erts_sys_ddll_sym(H,N,F) erts_sys_ddll_sym2(H,N,F,NULL) +extern char *erts_sys_ddll_error(int code); + + + +/* + * System interfaces for startup/sae code (functions found in respective sys.c) + */ + + +#ifdef ERTS_SMP +void erts_sys_schedule_interrupt(int set); +void erts_sys_schedule_interrupt_timed(int set, long msec); +void erts_sys_main_thread(void); +#else +#define erts_sys_schedule_interrupt(Set) +#endif + +extern void erts_sys_prepare_crash_dump(void); +extern void erts_sys_pre_init(void); +extern void erl_sys_init(void); +extern void erl_sys_args(int *argc, char **argv); +extern void erl_sys_schedule(int); +#ifdef _OSE_ +extern void erl_sys_init_final(void); +#else +void sys_tty_reset(void); +#endif + +EXTERN_FUNCTION(int, sys_max_files, (_VOID_)); +void sys_init_io(void); +Preload* sys_preloaded(void); +EXTERN_FUNCTION(unsigned char*, sys_preload_begin, (Preload*)); +EXTERN_FUNCTION(void, sys_preload_end, (Preload*)); +EXTERN_FUNCTION(int, sys_get_key, (int)); +void elapsed_time_both(unsigned long *ms_user, unsigned long *ms_sys, + unsigned long *ms_user_diff, unsigned long *ms_sys_diff); +void wall_clock_elapsed_time_both(unsigned long *ms_total, + unsigned long *ms_diff); +void get_time(int *hour, int *minute, int *second); +void get_date(int *year, int *month, int *day); +void get_localtime(int *year, int *month, int *day, + int *hour, int *minute, int *second); +void get_universaltime(int *year, int *month, int *day, + int *hour, int *minute, int *second); +int univ_to_local(Sint *year, Sint *month, Sint *day, + Sint *hour, Sint *minute, Sint *second); +int local_to_univ(Sint *year, Sint *month, Sint *day, + Sint *hour, Sint *minute, Sint *second, int isdst); +void get_now(Uint*, Uint*, Uint*); +void get_sys_now(Uint*, Uint*, Uint*); +EXTERN_FUNCTION(void, set_break_quit, (void (*)(void), void (*)(void))); + +void os_flavor(char*, unsigned); +void os_version(int*, int*, int*); +void init_getenv_state(GETENV_STATE *); +char * getenv_string(GETENV_STATE *); +void fini_getenv_state(GETENV_STATE *); + +/* xxxP */ +void init_sys_float(void); +int sys_chars_to_double(char*, double*); +int sys_double_to_chars(double, char*); +void sys_get_pid(char *); + +/* erts_sys_putenv() returns, 0 on success and a value != 0 on failure. */ +int erts_sys_putenv(char *key_value, int sep_ix); +/* erts_sys_getenv() returns 0 on success (length of value string in + *size), a value > 0 if value buffer is too small (*size is set to needed + size), and a value < 0 on failure. */ +int erts_sys_getenv(char *key, char *value, size_t *size); + +/* Easier to use, but not as efficient, environment functions */ +char *erts_read_env(char *key); +void erts_free_read_env(void *value); +int erts_write_env(char *key, char *value); + +/* utils.c */ + +/* Options to sys_alloc_opt */ +#define SYS_ALLOC_OPT_TRIM_THRESHOLD 0 +#define SYS_ALLOC_OPT_TOP_PAD 1 +#define SYS_ALLOC_OPT_MMAP_THRESHOLD 2 +#define SYS_ALLOC_OPT_MMAP_MAX 3 + +/* Default values to sys_alloc_opt options */ +#define ERTS_DEFAULT_TRIM_THRESHOLD (128 * 1024) +#define ERTS_DEFAULT_TOP_PAD 0 +#define ERTS_DEFAULT_MMAP_THRESHOLD (128 * 1024) +#define ERTS_DEFAULT_MMAP_MAX 64 + +EXTERN_FUNCTION(int, sys_alloc_opt, (int, int)); + +typedef struct { + Sint trim_threshold; + Sint top_pad; + Sint mmap_threshold; + Sint mmap_max; +} SysAllocStat; + +EXTERN_FUNCTION(void, sys_alloc_stat, (SysAllocStat *)); + +/* Block the whole system... */ + +#define ERTS_BS_FLG_ALLOW_GC (((Uint32) 1) << 0) +#define ERTS_BS_FLG_ALLOW_IO (((Uint32) 1) << 1) + +/* Activities... */ +typedef enum { + ERTS_ACTIVITY_UNDEFINED, /* Undefined activity */ + ERTS_ACTIVITY_WAIT, /* Waiting */ + ERTS_ACTIVITY_GC, /* Garbage collecting */ + ERTS_ACTIVITY_IO /* I/O including message passing to erl procs */ +} erts_activity_t; + +#ifdef ERTS_SMP + +typedef enum { + ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED, + ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY, + ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY +} erts_activity_error_t; + +typedef struct { + erts_smp_atomic_t do_block; + struct { + erts_smp_atomic_t wait; + erts_smp_atomic_t gc; + erts_smp_atomic_t io; + } in_activity; +} erts_system_block_state_t; + +extern erts_system_block_state_t erts_system_block_state; + +int erts_is_system_blocked(erts_activity_t allowed_activities); +void erts_block_me(void (*prepare)(void *), void (*resume)(void *), void *arg); +void erts_register_blockable_thread(void); +void erts_unregister_blockable_thread(void); +void erts_note_activity_begin(erts_activity_t activity); +void +erts_check_block(erts_activity_t old_activity, + erts_activity_t new_activity, + int locked, + void (*prepare)(void *), + void (*resume)(void *), + void *arg); +void erts_block_system(Uint32 allowed_activities); +int erts_emergency_block_system(long timeout, Uint32 allowed_activities); +void erts_release_system(void); +void erts_system_block_init(void); +void erts_set_activity_error(erts_activity_error_t, char *, int); +#ifdef ERTS_ENABLE_LOCK_CHECK +void erts_lc_activity_change_begin(void); +void erts_lc_activity_change_end(void); +int erts_lc_is_blocking(void); +#define ERTS_LC_IS_BLOCKING \ + (erts_smp_pending_system_block() && erts_lc_is_blocking()) +#endif +#endif + +#define erts_smp_activity_begin(NACT, PRP, RSM, ARG) \ + erts_smp_set_activity(ERTS_ACTIVITY_UNDEFINED, \ + (NACT), \ + 0, \ + (PRP), \ + (RSM), \ + (ARG), \ + __FILE__, \ + __LINE__) +#define erts_smp_activity_change(OACT, NACT, PRP, RSM, ARG) \ + erts_smp_set_activity((OACT), \ + (NACT), \ + 0, \ + (PRP), \ + (RSM), \ + (ARG), \ + __FILE__, \ + __LINE__) +#define erts_smp_activity_end(OACT, PRP, RSM, ARG) \ + erts_smp_set_activity((OACT), \ + ERTS_ACTIVITY_UNDEFINED, \ + 0, \ + (PRP), \ + (RSM), \ + (ARG), \ + __FILE__, \ + __LINE__) + +#define erts_smp_locked_activity_begin(NACT) \ + erts_smp_set_activity(ERTS_ACTIVITY_UNDEFINED, \ + (NACT), \ + 1, \ + NULL, \ + NULL, \ + NULL, \ + __FILE__, \ + __LINE__) +#define erts_smp_locked_activity_change(OACT, NACT) \ + erts_smp_set_activity((OACT), \ + (NACT), \ + 1, \ + NULL, \ + NULL, \ + NULL, \ + __FILE__, \ + __LINE__) +#define erts_smp_locked_activity_end(OACT) \ + erts_smp_set_activity((OACT), \ + ERTS_ACTIVITY_UNDEFINED, \ + 1, \ + NULL, \ + NULL, \ + NULL, \ + __FILE__, \ + __LINE__) + + +ERTS_GLB_INLINE int erts_smp_is_system_blocked(erts_activity_t allowed_activities); +ERTS_GLB_INLINE void erts_smp_block_system(Uint32 allowed_activities); +ERTS_GLB_INLINE int erts_smp_emergency_block_system(long timeout, + Uint32 allowed_activities); +ERTS_GLB_INLINE void erts_smp_release_system(void); +ERTS_GLB_INLINE int erts_smp_pending_system_block(void); +ERTS_GLB_INLINE void erts_smp_chk_system_block(void (*prepare)(void *), + void (*resume)(void *), + void *arg); +ERTS_GLB_INLINE void +erts_smp_set_activity(erts_activity_t old_activity, + erts_activity_t new_activity, + int locked, + void (*prepare)(void *), + void (*resume)(void *), + void *arg, + char *file, + int line); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + + +ERTS_GLB_INLINE int +erts_smp_is_system_blocked(erts_activity_t allowed_activities) +{ +#ifdef ERTS_SMP + return erts_is_system_blocked(allowed_activities); +#else + return 1; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_block_system(Uint32 allowed_activities) +{ +#ifdef ERTS_SMP + erts_block_system(allowed_activities); +#endif +} + +ERTS_GLB_INLINE int +erts_smp_emergency_block_system(long timeout, Uint32 allowed_activities) +{ +#ifdef ERTS_SMP + return erts_emergency_block_system(timeout, allowed_activities); +#else + return 0; +#endif +} + +ERTS_GLB_INLINE void +erts_smp_release_system(void) +{ +#ifdef ERTS_SMP + erts_release_system(); +#endif +} + +ERTS_GLB_INLINE int +erts_smp_pending_system_block(void) +{ +#ifdef ERTS_SMP + return erts_smp_atomic_read(&erts_system_block_state.do_block); +#else + return 0; +#endif +} + + +ERTS_GLB_INLINE void +erts_smp_chk_system_block(void (*prepare)(void *), + void (*resume)(void *), + void *arg) +{ +#ifdef ERTS_SMP + if (erts_smp_pending_system_block()) + erts_block_me(prepare, resume, arg); +#endif +} + +ERTS_GLB_INLINE void +erts_smp_set_activity(erts_activity_t old_activity, + erts_activity_t new_activity, + int locked, + void (*prepare)(void *), + void (*resume)(void *), + void *arg, + char *file, + int line) +{ +#ifdef ERTS_SMP +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_activity_change_begin(); +#endif + switch (old_activity) { + case ERTS_ACTIVITY_UNDEFINED: + break; + case ERTS_ACTIVITY_WAIT: + erts_smp_atomic_dec(&erts_system_block_state.in_activity.wait); + if (locked) { + /* You are not allowed to leave activity waiting + * without supplying the possibility to block + * unlocked. + */ + erts_set_activity_error(ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED, + file, line); + } + break; + case ERTS_ACTIVITY_GC: + erts_smp_atomic_dec(&erts_system_block_state.in_activity.gc); + break; + case ERTS_ACTIVITY_IO: + erts_smp_atomic_dec(&erts_system_block_state.in_activity.io); + break; + default: + erts_set_activity_error(ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY, + file, line); + break; + } + + /* We are not allowed to block when going to activity waiting... */ + if (new_activity != ERTS_ACTIVITY_WAIT && erts_smp_pending_system_block()) + erts_check_block(old_activity,new_activity,locked,prepare,resume,arg); + + switch (new_activity) { + case ERTS_ACTIVITY_UNDEFINED: + break; + case ERTS_ACTIVITY_WAIT: + erts_smp_atomic_inc(&erts_system_block_state.in_activity.wait); + break; + case ERTS_ACTIVITY_GC: + erts_smp_atomic_inc(&erts_system_block_state.in_activity.gc); + break; + case ERTS_ACTIVITY_IO: + erts_smp_atomic_inc(&erts_system_block_state.in_activity.io); + break; + default: + erts_set_activity_error(ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY, + file, line); + break; + } + + switch (new_activity) { + case ERTS_ACTIVITY_WAIT: + case ERTS_ACTIVITY_GC: + case ERTS_ACTIVITY_IO: + if (erts_smp_pending_system_block()) + erts_note_activity_begin(new_activity); + break; + default: + break; + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_activity_change_end(); +#endif + +#endif +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#if defined(DEBUG) || defined(ERTS_ENABLE_LOCK_CHECK) +#undef ERTS_REFC_DEBUG +#define ERTS_REFC_DEBUG +#endif + +typedef erts_smp_atomic_t erts_refc_t; + +ERTS_GLB_INLINE void erts_refc_init(erts_refc_t *refcp, long val); +ERTS_GLB_INLINE void erts_refc_inc(erts_refc_t *refcp, long min_val); +ERTS_GLB_INLINE long erts_refc_inctest(erts_refc_t *refcp, long min_val); +ERTS_GLB_INLINE void erts_refc_dec(erts_refc_t *refcp, long min_val); +ERTS_GLB_INLINE long erts_refc_dectest(erts_refc_t *refcp, long min_val); +ERTS_GLB_INLINE void erts_refc_add(erts_refc_t *refcp, long diff, long min_val); +ERTS_GLB_INLINE long erts_refc_read(erts_refc_t *refcp, long min_val); + +#if ERTS_GLB_INLINE_INCL_FUNC_DEF + +ERTS_GLB_INLINE void +erts_refc_init(erts_refc_t *refcp, long val) +{ + erts_smp_atomic_init((erts_smp_atomic_t *) refcp, val); +} + +ERTS_GLB_INLINE void +erts_refc_inc(erts_refc_t *refcp, long min_val) +{ +#ifdef ERTS_REFC_DEBUG + long val = erts_smp_atomic_inctest((erts_smp_atomic_t *) refcp); + if (val < min_val) + erl_exit(ERTS_ABORT_EXIT, + "erts_refc_inc(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#else + erts_smp_atomic_inc((erts_smp_atomic_t *) refcp); +#endif +} + +ERTS_GLB_INLINE long +erts_refc_inctest(erts_refc_t *refcp, long min_val) +{ + long val = erts_smp_atomic_inctest((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erl_exit(ERTS_ABORT_EXIT, + "erts_refc_inctest(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +ERTS_GLB_INLINE void +erts_refc_dec(erts_refc_t *refcp, long min_val) +{ +#ifdef ERTS_REFC_DEBUG + long val = erts_smp_atomic_dectest((erts_smp_atomic_t *) refcp); + if (val < min_val) + erl_exit(ERTS_ABORT_EXIT, + "erts_refc_dec(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#else + erts_smp_atomic_dec((erts_smp_atomic_t *) refcp); +#endif +} + +ERTS_GLB_INLINE long +erts_refc_dectest(erts_refc_t *refcp, long min_val) +{ + long val = erts_smp_atomic_dectest((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erl_exit(ERTS_ABORT_EXIT, + "erts_refc_dectest(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +ERTS_GLB_INLINE void +erts_refc_add(erts_refc_t *refcp, long diff, long min_val) +{ +#ifdef ERTS_REFC_DEBUG + long val = erts_smp_atomic_addtest((erts_smp_atomic_t *) refcp, diff); + if (val < min_val) + erl_exit(ERTS_ABORT_EXIT, + "erts_refc_add(%ld): Bad refc found (refc=%ld < %ld)!\n", + diff, val, min_val); +#else + erts_smp_atomic_add((erts_smp_atomic_t *) refcp, diff); +#endif +} + +ERTS_GLB_INLINE long +erts_refc_read(erts_refc_t *refcp, long min_val) +{ + long val = erts_smp_atomic_read((erts_smp_atomic_t *) refcp); +#ifdef ERTS_REFC_DEBUG + if (val < min_val) + erl_exit(ERTS_ABORT_EXIT, + "erts_refc_read(): Bad refc found (refc=%ld < %ld)!\n", + val, min_val); +#endif + return val; +} + +#endif /* #if ERTS_GLB_INLINE_INCL_FUNC_DEF */ + +#ifdef ERTS_ENABLE_KERNEL_POLL +extern int erts_use_kernel_poll; +#endif + +void elib_ensure_initialized(void); + + +#if (defined(VXWORKS) || defined(_OSE_)) +/* NOTE! sys_calloc2 does not exist on other + platforms than VxWorks and OSE */ +EXTERN_FUNCTION(void*, sys_calloc2, (Uint, Uint)); +#endif /* VXWORKS || OSE */ + + +#define sys_memcpy(s1,s2,n) memcpy(s1,s2,n) +#define sys_memmove(s1,s2,n) memmove(s1,s2,n) +#define sys_memcmp(s1,s2,n) memcmp(s1,s2,n) +#define sys_memset(s,c,n) memset(s,c,n) +#define sys_memzero(s, n) memset(s,'\0',n) +#define sys_strcmp(s1,s2) strcmp(s1,s2) +#define sys_strncmp(s1,s2,n) strncmp(s1,s2,n) +#define sys_strcpy(s1,s2) strcpy(s1,s2) +#define sys_strncpy(s1,s2,n) strncpy(s1,s2,n) +#define sys_strlen(s) strlen(s) + +/* define function symbols (needed in sys_drv_api) */ +#define sys_fp_alloc sys_alloc +#define sys_fp_realloc sys_realloc +#define sys_fp_free sys_free +#define sys_fp_memcpy memcpy +#define sys_fp_memmove memmove +#define sys_fp_memcmp memcmp +#define sys_fp_memset memset +/* #define sys_fp_memzero elib_memzero */ +#define sys_fp_strcmp strcmp +#define sys_fp_strncmp strncmp +#define sys_fp_strcpy strcpy +#define sys_fp_strncpy strncpy +#define sys_fp_strlen strlen + + +/* Return codes from the nb_read and nb_write functions */ +#define FD_READY 1 +#define FD_CONTINUE 2 +#define FD_ERROR 3 + + + +/* Standard set of integer macros .. */ + +#define get_int64(s) ((((unsigned char*) (s))[0] << 56) | \ + (((unsigned char*) (s))[1] << 48) | \ + (((unsigned char*) (s))[2] << 40) | \ + (((unsigned char*) (s))[3] << 32) | \ + (((unsigned char*) (s))[4] << 24) | \ + (((unsigned char*) (s))[5] << 16) | \ + (((unsigned char*) (s))[6] << 8) | \ + (((unsigned char*) (s))[7])) + +#define put_int64(i, s) do {((char*)(s))[0] = (char)((Sint64)(i) >> 56) & 0xff;\ + ((char*)(s))[1] = (char)((Sint64)(i) >> 48) & 0xff;\ + ((char*)(s))[2] = (char)((Sint64)(i) >> 40) & 0xff;\ + ((char*)(s))[3] = (char)((Sint64)(i) >> 32) & 0xff;\ + ((char*)(s))[4] = (char)((Sint64)(i) >> 24) & 0xff;\ + ((char*)(s))[5] = (char)((Sint64)(i) >> 16) & 0xff;\ + ((char*)(s))[6] = (char)((Sint64)(i) >> 8) & 0xff;\ + ((char*)(s))[7] = (char)((Sint64)(i)) & 0xff;\ + } while (0) + +#define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \ + (((unsigned char*) (s))[1] << 16) | \ + (((unsigned char*) (s))[2] << 8) | \ + (((unsigned char*) (s))[3])) + +#define put_int32(i, s) do {((char*)(s))[0] = (char)((i) >> 24) & 0xff; \ + ((char*)(s))[1] = (char)((i) >> 16) & 0xff; \ + ((char*)(s))[2] = (char)((i) >> 8) & 0xff; \ + ((char*)(s))[3] = (char)(i) & 0xff;} \ + while (0) + +#define get_int16(s) ((((unsigned char*) (s))[0] << 8) | \ + (((unsigned char*) (s))[1])) + + +#define put_int16(i, s) do {((char*)(s))[0] = (char)((i) >> 8) & 0xff; \ + ((char*)(s))[1] = (char)(i) & 0xff;} \ + while (0) + +#define get_int8(s) ((((unsigned char*) (s))[0] )) + + +#define put_int8(i, s) do {((unsigned char*)(s))[0] = (i) & 0xff;} while (0) + +/* + * Use DEBUGF as you would use printf, but use double parentheses: + * + * DEBUGF(("Error: %s\n", error)); + * + * The output will appear in a special console. + */ + +#ifdef DEBUG +EXTERN_FUNCTION(void, erl_debug, (char* format, ...)); +EXTERN_FUNCTION(void, erl_bin_write, (unsigned char *, int, int)); + +# define DEBUGF(x) erl_debug x +#else +# define DEBUGF(x) +#endif + + +#ifdef VXWORKS +/* This includes redefines of malloc etc + this should be done after sys_alloc, etc, above */ +# include "reclaim.h" +/*********************Malloc and friends************************ + * There is a problem with the naming of malloc and friends, + * malloc is used throughout sys.c and the resolver to mean save_alloc, + * but it should actually mean either sys_alloc or sys_alloc2, + * so the definitions from reclaim_master.h are not any + * good, i redefine the malloc family here, although it's quite + * ugly, actually it would be preferrable to use the + * names sys_alloc and so on throughout the offending code, but + * that will be saved as an later exercise... + * I also add an own calloc, to make the BSD resolver source happy. + ***************************************************************/ +/* Undefine malloc and friends */ +# ifdef malloc +# undef malloc +# endif +# ifdef calloc +# undef calloc +# endif +# ifdef realloc +# undef realloc +# endif +# ifdef free +# undef free +# endif +/* Redefine malloc and friends */ +# define malloc sys_alloc +# define calloc sys_calloc +# define realloc sys_realloc +# define free sys_free + +#endif + + +#ifdef __WIN32__ + +void call_break_handler(void); +char* last_error(void); +char* win32_errorstr(int); + + +#endif + + +#endif + diff --git a/erts/emulator/beam/time.c b/erts/emulator/beam/time.c new file mode 100644 index 0000000000..a07d6a5327 --- /dev/null +++ b/erts/emulator/beam/time.c @@ -0,0 +1,571 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * TIMING WHEEL + * + * Timeouts kept in an wheel. A timeout is measured relative to the + * current slot (tiw_pos) in the wheel, and inserted at slot + * (tiw_pos + timeout) % TIW_SIZE. Each timeout also has a count + * equal to timeout/TIW_SIZE, which is needed since the time axis + * is wrapped arount the wheel. + * + * Several slots may be processed in one operation. If the number of + * slots is greater that the wheel size, the wheel is only traversed + * once, + * + * The following example shows a time axis where there is one timeout + * at each "tick", and where 1, 2, 3 ... wheel slots are released in + * one operation. The notation "tv_usec = 1000 * (now->tv_usec / 1000); /* ms resolution */ + elapsed = (1000 * (now->tv_sec - time_start.tv_sec) + + (now->tv_usec - time_start.tv_usec) / 1000); + // elapsed /= CLOCK_RESOLUTION; + return elapsed; +} + +static long do_time_update(void) +{ + SysTimeval now; + long elapsed; + + elapsed = time_gettimeofday(&now); + ticks_latest = elapsed; + return elapsed; +} + +static ERTS_INLINE long do_time_read(void) +{ + return ticks_latest; +} + +static long do_time_reset(void) +{ + SysTimeval now; + long elapsed; + + elapsed = time_gettimeofday(&now); + time_start = now; + ticks_end = LONG_MAX; + ticks_latest = 0; + return elapsed; +} + +static ERTS_INLINE void do_time_init(void) +{ + (void)do_time_reset(); +} + +#else +erts_smp_atomic_t do_time; /* set at clock interrupt */ +static ERTS_INLINE long do_time_read(void) { return erts_smp_atomic_read(&do_time); } +static ERTS_INLINE long do_time_update(void) { return do_time_read(); } +static ERTS_INLINE void do_time_init(void) { erts_smp_atomic_init(&do_time, 0L); } +#endif + +/* get the time (in units of itime) to the next timeout, + or -1 if there are no timeouts */ + +static int next_time_internal(void) /* PRE: tiw_lock taken by caller */ +{ + int i, tm, nto; + unsigned int min; + ErlTimer* p; + long dt; + + if (tiw_nto == 0) + return -1; /* no timeouts in wheel */ + + /* start going through wheel to find next timeout */ + tm = nto = 0; + min = (unsigned int) -1; /* max unsigned int */ + i = tiw_pos; + do { + p = tiw[i]; + while (p != NULL) { + nto++; + if (p->count == 0) { + /* found next timeout */ + dt = do_time_read(); + return ((tm >= dt) ? (tm - dt) : 0); + } else { + /* keep shortest time in 'min' */ + if (tm + p->count*TIW_SIZE < min) + min = tm + p->count*TIW_SIZE; + } + p = p->next; + } + /* when we have found all timeouts the shortest time will be in min */ + if (nto == tiw_nto) break; + tm++; + i = (i + 1) % TIW_SIZE; + } while (i != tiw_pos); + dt = do_time_read(); + return ((min >= dt) ? (min - dt) : 0); +} + +#if !defined(ERTS_TIMER_THREAD) +/* Private export to erl_time_sup.c */ +int next_time(void) +{ + int ret; + + tiw_write_lock(); + (void)do_time_update(); + ret = next_time_internal(); + tiw_write_unlock(); + return ret; +} +#endif + +static ERTS_INLINE void bump_timer_internal(long dt) /* PRE: tiw_lock is write-locked */ +{ + Uint keep_pos; + Uint count; + ErlTimer *p, **prev, *timeout_head, **timeout_tail; + Uint dtime = (unsigned long)dt; + + /* no need to bump the position if there aren't any timeouts */ + if (tiw_nto == 0) { + tiw_write_unlock(); + return; + } + + /* if do_time > TIW_SIZE we want to go around just once */ + count = (Uint)(dtime / TIW_SIZE) + 1; + keep_pos = (tiw_pos + dtime) % TIW_SIZE; + if (dtime > TIW_SIZE) dtime = TIW_SIZE; + + timeout_head = NULL; + timeout_tail = &timeout_head; + while (dtime > 0) { + /* this is to decrease the counters with the right amount */ + /* when dtime >= TIW_SIZE */ + if (tiw_pos == keep_pos) count--; + prev = &tiw[tiw_pos]; + while ((p = *prev) != NULL) { + if (p->count < count) { /* we have a timeout */ + *prev = p->next; /* Remove from list */ + tiw_nto--; + p->next = NULL; + p->active = 0; /* Make sure cancel callback + isn't called */ + *timeout_tail = p; /* Insert in timeout queue */ + timeout_tail = &p->next; + } + else { + /* no timeout, just decrease counter */ + p->count -= count; + prev = &p->next; + } + } + tiw_pos = (tiw_pos + 1) % TIW_SIZE; + dtime--; + } + tiw_pos = keep_pos; + + tiw_write_unlock(); + + /* Call timedout timers callbacks */ + while (timeout_head) { + p = timeout_head; + timeout_head = p->next; + /* Here comes hairy use of the timer fields! + * They are reset without having the lock. + * It is assumed that no code but this will + * accesses any field until the ->timeout + * callback is called. + */ + p->next = NULL; + p->slot = 0; + (*p->timeout)(p->arg); + } +} + +#if defined(ERTS_TIMER_THREAD) +static void timer_thread_bump_timer(void) +{ + tiw_write_lock(); + bump_timer_internal(do_time_reset()); +} +#else +void bump_timer(long dt) /* dt is value from do_time */ +{ + tiw_write_lock(); + bump_timer_internal(dt); +} +#endif + +Uint +erts_timer_wheel_memory_size(void) +{ + return (Uint) TIW_SIZE * sizeof(ErlTimer*); +} + +#if defined(ERTS_TIMER_THREAD) +static struct erts_iwait *timer_thread_iwait; + +static int timer_thread_setup_delay(SysTimeval *rem_time) +{ + long elapsed; + int ticks; + + tiw_write_lock(); + elapsed = do_time_update(); + ticks = next_time_internal(); + if (ticks == -1) /* timer queue empty */ + ticks = 100*1000*1000; + if (elapsed > ticks) + elapsed = ticks; + ticks -= elapsed; + //ticks *= CLOCK_RESOLUTION; + rem_time->tv_sec = ticks / 1000; + rem_time->tv_usec = 1000 * (ticks % 1000); + ticks_end = ticks; + tiw_write_unlock(); + return ticks; +} + +static void *timer_thread_start(void *ignore) +{ + SysTimeval delay; + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_set_thread_name("timer"); +#endif + erts_register_blockable_thread(); + + for(;;) { + if (timer_thread_setup_delay(&delay)) { + erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); + ASSERT_NO_LOCKED_LOCKS; + erts_iwait_wait(timer_thread_iwait, &delay); + ASSERT_NO_LOCKED_LOCKS; + erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); + } + else + erts_smp_chk_system_block(NULL, NULL, NULL); + timer_thread_bump_timer(); + ASSERT_NO_LOCKED_LOCKS; + } + /*NOTREACHED*/ + return NULL; +} + +static ERTS_INLINE void timer_thread_post_insert(Uint ticks) +{ + if ((Sint)ticks < ticks_end) + erts_iwait_interrupt(timer_thread_iwait); +} + +static void timer_thread_init(void) +{ + erts_thr_opts_t opts = ERTS_THR_OPTS_DEFAULT_INITER; + erts_tid_t tid; + + opts->detached = 1; + + timer_thread_iwait = erts_iwait_init(); + erts_thr_create(&tid, timer_thread_start, NULL, &opts); +} + +#else +static ERTS_INLINE void timer_thread_post_insert(Uint ticks) { } +static ERTS_INLINE void timer_thread_init(void) { } +#endif + +/* this routine links the time cells into a free list at the start + and sets the time queue as empty */ +void +init_time(void) +{ + int i; + + /* system dependent init; must be done before do_time_init() + if timer thread is enabled */ + itime = erts_init_time_sup(); + + tiw_init_lock(); + + tiw = (ErlTimer**) erts_alloc(ERTS_ALC_T_TIMER_WHEEL, + TIW_SIZE * sizeof(ErlTimer*)); + for(i = 0; i < TIW_SIZE; i++) + tiw[i] = NULL; + do_time_init(); + tiw_pos = tiw_nto = 0; + + timer_thread_init(); +} + +/* +** Insert a process into the time queue, with a timeout 't' +*/ +static void +insert_timer(ErlTimer* p, Uint t) +{ + Uint tm; + Uint64 ticks; + + /* The current slot (tiw_pos) in timing wheel is the next slot to be + * be processed. Hence no extra time tick is needed. + * + * (x + y - 1)/y is precisely the "number of bins" formula. + */ + ticks = (t + itime - 1) / itime; + + /* + * Ticks must be a Uint64, or the addition may overflow here, + * resulting in an incorrect value for p->count below. + */ + ticks += do_time_update(); /* Add backlog of unprocessed time */ + + /* calculate slot */ + tm = (ticks + tiw_pos) % TIW_SIZE; + p->slot = (Uint) tm; + p->count = (Uint) (ticks / TIW_SIZE); + + /* insert at head of list at slot */ + p->next = tiw[tm]; + tiw[tm] = p; + tiw_nto++; + + timer_thread_post_insert(ticks); +} + +void +erl_set_timer(ErlTimer* p, ErlTimeoutProc timeout, ErlCancelProc cancel, + void* arg, Uint t) +{ + erts_deliver_time(); + tiw_write_lock(); + if (p->active) { /* XXX assert ? */ + tiw_write_unlock(); + return; + } + p->timeout = timeout; + p->cancel = cancel; + p->arg = arg; + p->active = 1; + insert_timer(p, t); + tiw_write_unlock(); +#if defined(ERTS_SMP) && !defined(ERTS_TIMER_THREAD) + if (t <= (Uint) LONG_MAX) + erts_sys_schedule_interrupt_timed(1, (long) t); +#endif +} + +void +erl_cancel_timer(ErlTimer* p) +{ + ErlTimer *tp; + ErlTimer **prev; + + tiw_write_lock(); + if (!p->active) { /* allow repeated cancel (drivers) */ + tiw_write_unlock(); + return; + } + /* find p in linked list at slot p->slot and remove it */ + prev = &tiw[p->slot]; + while ((tp = *prev) != NULL) { + if (tp == p) { + *prev = p->next; /* Remove from list */ + tiw_nto--; + p->next = NULL; + p->slot = p->count = 0; + p->active = 0; + if (p->cancel != NULL) { + tiw_write_unlock(); + (*p->cancel)(p->arg); + } else { + tiw_write_unlock(); + } + return; + } else { + prev = &tp->next; + } + } + tiw_write_unlock(); +} + +/* + Returns the amount of time left in ms until the timer 'p' is triggered. + 0 is returned if 'p' isn't active. + 0 is returned also if the timer is overdue (i.e., would have triggered + immediately if it hadn't been cancelled). +*/ +Uint +time_left(ErlTimer *p) +{ + Uint left; + long dt; + + tiw_read_lock(); + + if (!p->active) { + tiw_read_unlock(); + return 0; + } + + if (p->slot < tiw_pos) + left = (p->count + 1) * TIW_SIZE + p->slot - tiw_pos; + else + left = p->count * TIW_SIZE + p->slot - tiw_pos; + dt = do_time_read(); + if (left < dt) + left = 0; + else + left -= dt; + + tiw_read_unlock(); + + return left * itime; +} + +#ifdef DEBUG + +void p_slpq() +{ + int i; + ErlTimer* p; + + tiw_read_lock(); + + /* print the whole wheel, starting at the current position */ + erts_printf("\ntiw_pos = %d tiw_nto %d\n", tiw_pos, tiw_nto); + i = tiw_pos; + if (tiw[i] != NULL) { + erts_printf("%d:\n", i); + for(p = tiw[i]; p != NULL; p = p->next) { + erts_printf(" (count %d, slot %d)\n", + p->count, p->slot); + } + } + for(i = (i+1)%TIW_SIZE; i != tiw_pos; i = (i+1)%TIW_SIZE) { + if (tiw[i] != NULL) { + erts_printf("%d:\n", i); + for(p = tiw[i]; p != NULL; p = p->next) { + erts_printf(" (count %d, slot %d)\n", + p->count, p->slot); + } + } + } + + tiw_read_unlock(); +} + +#endif /* DEBUG */ diff --git a/erts/emulator/beam/utils.c b/erts/emulator/beam/utils.c new file mode 100644 index 0000000000..be442fa480 --- /dev/null +++ b/erts/emulator/beam/utils.c @@ -0,0 +1,4053 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERTS_DO_INCL_GLB_INLINE_FUNC_DEF + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "big.h" +#include "bif.h" +#include "erl_binary.h" +#include "erl_bits.h" +#include "packet_parser.h" +#define ERTS_WANT_DB_INTERNAL__ +#include "erl_db.h" +#include "erl_threads.h" +#include "register.h" +#include "dist.h" +#include "erl_printf.h" +#include "erl_threads.h" +#include "erl_smp.h" +#include "erl_time.h" + +#undef M_TRIM_THRESHOLD +#undef M_TOP_PAD +#undef M_MMAP_THRESHOLD +#undef M_MMAP_MAX + +#if !defined(ELIB_ALLOC_IS_CLIB) && defined(__GLIBC__) && defined(HAVE_MALLOC_H) +#include +#endif + +#if defined(ELIB_ALLOC_IS_CLIB) || !defined(HAVE_MALLOPT) +#undef HAVE_MALLOPT +#define HAVE_MALLOPT 0 +#endif + +/* profile_scheduler mini message queue */ + +#ifdef ERTS_TIMER_THREAD +/* A timer thread is not welcomed with this lock violation work around. + * - Björn-Egil + */ +#error Timer thread may not be enabled due to lock violation. +#endif + +typedef struct { + Uint scheduler_id; + Uint no_schedulers; + Uint Ms; + Uint s; + Uint us; + Eterm state; +} profile_sched_msg; + +typedef struct { + profile_sched_msg msg[2]; + Uint n; +} profile_sched_msg_q; + +#ifdef ERTS_SMP + +static void +dispatch_profile_msg_q(profile_sched_msg_q *psmq) +{ + int i = 0; + profile_sched_msg *msg = NULL; + ASSERT(psmq != NULL); + for (i = 0; i < psmq->n; i++) { + msg = &(psmq->msg[i]); + profile_scheduler_q(make_small(msg->scheduler_id), msg->state, am_undefined, msg->Ms, msg->s, msg->us); + } +} + +#endif + +Eterm* +erts_heap_alloc(Process* p, Uint need) +{ + ErlHeapFragment* bp; + Eterm* htop; + Uint n; +#if defined(DEBUG) || defined(CHECK_FOR_HOLES) + Uint i; +#endif + + n = need; +#ifdef DEBUG + n++; +#endif + bp = (ErlHeapFragment*) + ERTS_HEAP_ALLOC(ERTS_ALC_T_HEAP_FRAG, + sizeof(ErlHeapFragment) + ((n-1)*sizeof(Eterm))); + +#ifdef DEBUG + n--; +#endif + +#if defined(DEBUG) + for (i = 0; i <= n; i++) { + bp->mem[i] = ERTS_HOLE_MARKER; + } +#elif defined(CHECK_FOR_HOLES) + for (i = 0; i < n; i++) { + bp->mem[i] = ERTS_HOLE_MARKER; + } +#endif + + /* + * When we have created a heap fragment, we are no longer allowed + * to store anything more on the heap. + */ + htop = HEAP_TOP(p); + if (htop < HEAP_LIMIT(p)) { + *htop = make_pos_bignum_header(HEAP_LIMIT(p)-htop-1); + HEAP_TOP(p) = HEAP_LIMIT(p); + } + + bp->next = MBUF(p); + MBUF(p) = bp; + bp->size = n; + MBUF_SIZE(p) += n; + bp->off_heap.mso = NULL; +#ifndef HYBRID /* FIND ME! */ + bp->off_heap.funs = NULL; +#endif + bp->off_heap.externals = NULL; + bp->off_heap.overhead = 0; + + return bp->mem; +} + +void erts_arith_shrink(Process* p, Eterm* hp) +{ +#if defined(CHECK_FOR_HOLES) + ErlHeapFragment* hf; + + /* + * We must find the heap fragment that hp points into. + * If we are unlucky, we might have to search through + * a large part of the list. We'll hope that will not + * happen too often. + */ + for (hf = MBUF(p); hf != 0; hf = hf->next) { + if (hp - hf->mem < (unsigned long)hf->size) { + /* + * We are not allowed to changed hf->size (because the + * size must be correct when deallocating). Therefore, + * clear out the uninitialized part of the heap fragment. + */ + Eterm* to = hf->mem + hf->size; + while (hp < to) { + *hp++ = NIL; + } + break; + } + } +#endif +} + +#ifdef CHECK_FOR_HOLES +Eterm* +erts_set_hole_marker(Eterm* ptr, Uint sz) +{ + Eterm* p = ptr; + int i; + + for (i = 0; i < sz; i++) { + *p++ = ERTS_HOLE_MARKER; + } + return ptr; +} +#endif + +/* + * Helper function for the ESTACK macros defined in global.h. + */ +void +erl_grow_stack(Eterm** start, Eterm** sp, Eterm** end) +{ + Uint old_size = (*end - *start); + Uint new_size = old_size * 2; + Uint sp_offs = *sp - *start; + if (new_size > 2 * DEF_ESTACK_SIZE) { + *start = erts_realloc(ERTS_ALC_T_ESTACK, (void *) *start, new_size*sizeof(Eterm)); + } else { + Eterm* new_ptr = erts_alloc(ERTS_ALC_T_ESTACK, new_size*sizeof(Eterm)); + sys_memcpy(new_ptr, *start, old_size*sizeof(Eterm)); + *start = new_ptr; + } + *end = *start + new_size; + *sp = *start + sp_offs; +} + +/* CTYPE macros */ + +#define LATIN1 + +#define IS_DIGIT(c) ((c) >= '0' && (c) <= '9') +#ifdef LATIN1 +#define IS_LOWER(c) (((c) >= 'a' && (c) <= 'z') \ + || ((c) >= 128+95 && (c) <= 255 && (c) != 247)) +#define IS_UPPER(c) (((c) >= 'A' && (c) <= 'Z') \ + || ((c) >= 128+64 && (c) <= 128+94 && (c) != 247-32)) +#else +#define IS_LOWER(c) ((c) >= 'a' && (c) <= 'z') +#define IS_UPPER(c) ((c) >= 'A' && (c) <= 'Z') +#endif + +#define IS_ALNUM(c) (IS_DIGIT(c) || IS_LOWER(c) || IS_UPPER(c)) + +/* We don't include 160 (non-breaking space). */ +#define IS_SPACE(c) (c == ' ' || c == '\n' || c == '\t' || c == '\r') + +#ifdef LATIN1 +#define IS_CNTRL(c) ((c) < ' ' || (c) == 127 \ + || ((c) >= 128 && (c) < 128+32)) +#else +/* Treat all non-ASCII as control characters */ +#define IS_CNTRL(c) ((c) < ' ' || (c) >= 127) +#endif + +#define IS_PRINT(c) (!IS_CNTRL(c)) + +/* + * Calculate length of a list. + * Returns -1 if not a proper list (i.e. not terminated with NIL) + */ +int +list_length(Eterm list) +{ + int i = 0; + + while(is_list(list)) { + i++; + list = CDR(list_val(list)); + } + if (is_not_nil(list)) { + return -1; + } + return i; +} + +Uint erts_fit_in_bits(Uint n) +{ + Uint i; + + i = 0; + while (n > 0) { + i++; + n >>= 1; + } + return i; +} + +int +erts_print(int to, void *arg, char *format, ...) +{ + int res; + va_list arg_list; + va_start(arg_list, format); + + if (to < ERTS_PRINT_MIN) + res = -EINVAL; + else { + switch (to) { + case ERTS_PRINT_STDOUT: + res = erts_vprintf(format, arg_list); + break; + case ERTS_PRINT_STDERR: + res = erts_vfprintf(stderr, format, arg_list); + break; + case ERTS_PRINT_FILE: + res = erts_vfprintf((FILE *) arg, format, arg_list); + break; + case ERTS_PRINT_SBUF: + res = erts_vsprintf((char *) arg, format, arg_list); + break; + case ERTS_PRINT_SNBUF: + res = erts_vsnprintf(((erts_print_sn_buf *) arg)->buf, + ((erts_print_sn_buf *) arg)->size, + format, + arg_list); + break; + case ERTS_PRINT_DSBUF: + res = erts_vdsprintf((erts_dsprintf_buf_t *) arg, format, arg_list); + break; + case ERTS_PRINT_INVALID: + res = -EINVAL; + break; + default: + res = erts_vfdprintf((int) to, format, arg_list); + break; + } + } + + va_end(arg_list); + return res; +} + +int +erts_putc(int to, void *arg, char c) +{ + return erts_print(to, arg, "%c", c); +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Some Erlang term building utility functions (to be used when performance * + * isn't critical). * + * * + * Add more functions like these here (and function prototypes in global.h) * + * when needed. * + * * +\* */ + +Eterm +erts_bld_atom(Uint **hpp, Uint *szp, char *str) +{ + if (hpp) + return am_atom_put(str, sys_strlen(str)); + else + return THE_NON_VALUE; +} + +Eterm +erts_bld_uint(Uint **hpp, Uint *szp, Uint ui) +{ + Eterm res = THE_NON_VALUE; + if (IS_USMALL(0, ui)) { + if (hpp) + res = make_small(ui); + } + else { + if (szp) + *szp += BIG_UINT_HEAP_SIZE; + if (hpp) { + res = uint_to_big(ui, *hpp); + *hpp += BIG_UINT_HEAP_SIZE; + } + } + return res; +} + +Eterm +erts_bld_uint64(Uint **hpp, Uint *szp, Uint64 ui64) +{ + Eterm res = THE_NON_VALUE; + if (IS_USMALL(0, ui64)) { + if (hpp) + res = make_small((Uint) ui64); + } + else { + if (szp) + *szp = ERTS_UINT64_HEAP_SIZE(ui64); + if (hpp) + res = erts_uint64_to_big(ui64, hpp); + } + return res; +} + +Eterm +erts_bld_sint64(Uint **hpp, Uint *szp, Sint64 si64) +{ + Eterm res = THE_NON_VALUE; + if (IS_SSMALL(si64)) { + if (hpp) + res = make_small((Sint) si64); + } + else { + if (szp) + *szp = ERTS_SINT64_HEAP_SIZE(si64); + if (hpp) + res = erts_sint64_to_big(si64, hpp); + } + return res; +} + + +Eterm +erts_bld_cons(Uint **hpp, Uint *szp, Eterm car, Eterm cdr) +{ + Eterm res = THE_NON_VALUE; + if (szp) + *szp += 2; + if (hpp) { + res = CONS(*hpp, car, cdr); + *hpp += 2; + } + return res; +} + +Eterm +erts_bld_tuple(Uint **hpp, Uint *szp, Uint arity, ...) +{ + Eterm res = THE_NON_VALUE; + + ASSERT(arity < (((Uint)1) << (sizeof(Uint)*8 - _HEADER_ARITY_OFFS))); + + if (szp) + *szp += arity + 1; + if (hpp) { + res = make_tuple(*hpp); + *((*hpp)++) = make_arityval(arity); + + if (arity > 0) { + Uint i; + va_list argp; + + va_start(argp, arity); + for (i = 0; i < arity; i++) { + *((*hpp)++) = va_arg(argp, Eterm); + } + va_end(argp); + } + } + return res; +} + + +Eterm erts_bld_tuplev(Uint **hpp, Uint *szp, Uint arity, Eterm terms[]) +{ + Eterm res = THE_NON_VALUE; + /* + * Note callers expect that 'terms' is *not* accessed if hpp == NULL. + */ + + ASSERT(arity < (((Uint)1) << (sizeof(Uint)*8 - _HEADER_ARITY_OFFS))); + + if (szp) + *szp += arity + 1; + if (hpp) { + + res = make_tuple(*hpp); + *((*hpp)++) = make_arityval(arity); + + if (arity > 0) { + Uint i; + for (i = 0; i < arity; i++) + *((*hpp)++) = terms[i]; + } + } + return res; +} + +Eterm +erts_bld_string_n(Uint **hpp, Uint *szp, const char *str, Sint len) +{ + Eterm res = THE_NON_VALUE; + Sint i = len; + if (szp) + *szp += len*2; + if (hpp) { + res = NIL; + while (--i >= 0) { + res = CONS(*hpp, make_small(str[i]), res); + *hpp += 2; + } + } + return res; +} + +Eterm +erts_bld_list(Uint **hpp, Uint *szp, Sint length, Eterm terms[]) +{ + Eterm list = THE_NON_VALUE; + if (szp) + *szp += 2*length; + if (hpp) { + Sint i = length; + list = NIL; + + while (--i >= 0) { + list = CONS(*hpp, terms[i], list); + *hpp += 2; + } + } + return list; +} + +Eterm +erts_bld_2tup_list(Uint **hpp, Uint *szp, + Sint length, Eterm terms1[], Uint terms2[]) +{ + Eterm res = THE_NON_VALUE; + if (szp) + *szp += 5*length; + if (hpp) { + Sint i = length; + res = NIL; + + while (--i >= 0) { + res = CONS(*hpp+3, TUPLE2(*hpp, terms1[i], terms2[i]), res); + *hpp += 5; + } + } + return res; +} + +Eterm +erts_bld_atom_uint_2tup_list(Uint **hpp, Uint *szp, + Sint length, Eterm atoms[], Uint uints[]) +{ + Sint i; + Eterm res = THE_NON_VALUE; + if (szp) { + *szp += 5*length; + i = length; + while (--i >= 0) { + if (!IS_USMALL(0, uints[i])) + *szp += BIG_UINT_HEAP_SIZE; + } + } + if (hpp) { + i = length; + res = NIL; + + while (--i >= 0) { + Eterm ui; + + if (IS_USMALL(0, uints[i])) + ui = make_small(uints[i]); + else { + ui = uint_to_big(uints[i], *hpp); + *hpp += BIG_UINT_HEAP_SIZE; + } + + res = CONS(*hpp+3, TUPLE2(*hpp, atoms[i], ui), res); + *hpp += 5; + } + } + return res; +} + +Eterm +erts_bld_atom_2uint_3tup_list(Uint **hpp, Uint *szp, Sint length, + Eterm atoms[], Uint uints1[], Uint uints2[]) +{ + Sint i; + Eterm res = THE_NON_VALUE; + if (szp) { + *szp += 6*length; + i = length; + while (--i >= 0) { + if (!IS_USMALL(0, uints1[i])) + *szp += BIG_UINT_HEAP_SIZE; + if (!IS_USMALL(0, uints2[i])) + *szp += BIG_UINT_HEAP_SIZE; + } + } + if (hpp) { + i = length; + res = NIL; + + while (--i >= 0) { + Eterm ui1; + Eterm ui2; + + if (IS_USMALL(0, uints1[i])) + ui1 = make_small(uints1[i]); + else { + ui1 = uint_to_big(uints1[i], *hpp); + *hpp += BIG_UINT_HEAP_SIZE; + } + + if (IS_USMALL(0, uints2[i])) + ui2 = make_small(uints2[i]); + else { + ui2 = uint_to_big(uints2[i], *hpp); + *hpp += BIG_UINT_HEAP_SIZE; + } + + res = CONS(*hpp+4, TUPLE3(*hpp, atoms[i], ui1, ui2), res); + *hpp += 6; + } + } + return res; +} + +/* *\ + * * +\* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ + +/* make a hash index from an erlang term */ + +/* +** There are three hash functions. +** make_broken_hash: the one used for backward compatibility +** is called from the bif erlang:hash/2. Should never be used +** as it a) hashes only a part of binaries, b) hashes bignums really poorly, +** c) hashes bignums differently on different endian processors and d) hashes +** small integers with different weights on different bytes. +** +** make_hash: A hash function that will give the same values for the same +** terms regardless of the internal representation. Small integers are +** hashed using the same algorithm as bignums and bignums are hashed +** independent of the CPU endianess. +** Make_hash also hashes pids, ports and references like 32 bit numbers +** (but with different constants). +** make_hash() is called from the bif erlang:phash/2 +** +** The idea behind the hash algorithm is to produce values suitable for +** linear dynamic hashing. We cannot choose the range at all while hashing +** (it's not even supplied to the hashing functions). The good old algorithm +** [H = H*C+X mod M, where H is the hash value, C is a "random" constant(or M), +** M is the range, preferably a prime, and X is each byte value] is therefore +** modified to: +** H = H*C+X mod 2^32, where C is a large prime. This gives acceptable +** "spreading" of the hashes, so that later modulo calculations also will give +** acceptable "spreading" in the range. +** We really need to hash on bytes, otherwise the +** upper bytes of a word will be less significant than the lower ones. That's +** not acceptable at all. For internal use one could maybe optimize by using +** another hash function, that is less strict but faster. That is, however, not +** implemented. +** +** Short semi-formal description of make_hash: +** +** In make_hash, the number N is treated like this: +** Abs(N) is hashed bytewise with the least significant byte, B(0), first. +** The number of bytes (J) to calculate hash on in N is +** (the number of _32_ bit words needed to store the unsigned +** value of abs(N)) * 4. +** X = FUNNY_NUMBER2 +** If N < 0, Y = FUNNY_NUMBER4 else Y = FUNNY_NUMBER3. +** The hash value is Y*h(J) mod 2^32 where h(J) is calculated like +** h(0) = +** h(i) = h(i-i)*X + B(i-1) +** The above should hold regardless of internal representation. +** Pids are hashed like small numbers but with differrent constants, as are +** ports. +** References are hashed like ports but only on the least significant byte. +** Binaries are hashed on all bytes (not on the 15 first as in +** make_broken_hash()). +** Bytes in lists (possibly text strings) use a simpler multiplication inlined +** in the handling of lists, that is an optimization. +** Everything else is like in the old hash (make_broken_hash()). +** +** make_hash2() is faster than make_hash, in particular for bignums +** and binaries, and produces better hash values. +*/ + +/* some prime numbers just above 2 ^ 28 */ + +#define FUNNY_NUMBER1 268440163 +#define FUNNY_NUMBER2 268439161 +#define FUNNY_NUMBER3 268435459 +#define FUNNY_NUMBER4 268436141 +#define FUNNY_NUMBER5 268438633 +#define FUNNY_NUMBER6 268437017 +#define FUNNY_NUMBER7 268438039 +#define FUNNY_NUMBER8 268437511 +#define FUNNY_NUMBER9 268439627 +#define FUNNY_NUMBER10 268440479 +#define FUNNY_NUMBER11 268440577 +#define FUNNY_NUMBER12 268440581 + +static Uint32 +hash_binary_bytes(Eterm bin, Uint sz, Uint32 hash) +{ + byte* ptr; + Uint bitoffs; + Uint bitsize; + + ERTS_GET_BINARY_BYTES(bin, ptr, bitoffs, bitsize); + if (bitoffs == 0) { + while (sz--) { + hash = hash*FUNNY_NUMBER1 + *ptr++; + } + if (bitsize > 0) { + byte b = *ptr; + + b >>= 8 - bitsize; + hash = (hash*FUNNY_NUMBER1 + b) * FUNNY_NUMBER12 + bitsize; + } + } else { + Uint previous = *ptr++; + Uint b; + Uint lshift = bitoffs; + Uint rshift = 8 - lshift; + + while (sz--) { + b = (previous << lshift) & 0xFF; + previous = *ptr++; + b |= previous >> rshift; + hash = hash*FUNNY_NUMBER1 + b; + } + if (bitsize > 0) { + b = (previous << lshift) & 0xFF; + previous = *ptr++; + b |= previous >> rshift; + + b >>= 8 - bitsize; + hash = (hash*FUNNY_NUMBER1 + b) * FUNNY_NUMBER12 + bitsize; + } + } + return hash; +} + +Uint32 make_hash(Eterm term_arg) +{ + DECLARE_ESTACK(stack); + Eterm term = term_arg; + Eterm hash = 0; + unsigned op; + + /* Must not collide with the real tag_val_def's: */ +#define MAKE_HASH_TUPLE_OP 0x10 +#define MAKE_HASH_FUN_OP 0x11 +#define MAKE_HASH_CDR_PRE_OP 0x12 +#define MAKE_HASH_CDR_POST_OP 0x13 + + /* + ** Convenience macro for calculating a bytewise hash on an unsigned 32 bit + ** integer. + ** If the endianess is known, we could be smarter here, + ** but that gives no significant speedup (on a sparc at least) + */ +#define UINT32_HASH_STEP(Expr, Prime1) \ + do { \ + Uint32 x = (Uint32) (Expr); \ + hash = \ + (((((hash)*(Prime1) + (x & 0xFF)) * (Prime1) + \ + ((x >> 8) & 0xFF)) * (Prime1) + \ + ((x >> 16) & 0xFF)) * (Prime1) + \ + (x >> 24)); \ + } while(0) + +#define UINT32_HASH_RET(Expr, Prime1, Prime2) \ + UINT32_HASH_STEP(Expr, Prime1); \ + hash = hash * (Prime2); \ + break + + + /* + * Significant additions needed for real 64 bit port with larger fixnums. + */ + + /* + * Note, for the simple 64bit port, not utilizing the + * larger word size this function will work without modification. + */ +tail_recur: + op = tag_val_def(term); + + for (;;) { + switch (op) { + case NIL_DEF: + hash = hash*FUNNY_NUMBER3 + 1; + break; + case ATOM_DEF: + hash = hash*FUNNY_NUMBER1 + + (atom_tab(atom_val(term))->slot.bucket.hvalue); + break; + case SMALL_DEF: + { + Sint y1 = signed_val(term); + Uint y2 = y1 < 0 ? -(Uint)y1 : y1; + + UINT32_HASH_STEP(y2, FUNNY_NUMBER2); +#ifdef ARCH_64 + if (y2 >> 32) + UINT32_HASH_STEP(y2 >> 32, FUNNY_NUMBER2); +#endif + hash *= (y1 < 0 ? FUNNY_NUMBER4 : FUNNY_NUMBER3); + break; + } + case BINARY_DEF: + { + Uint sz = binary_size(term); + + hash = hash_binary_bytes(term, sz, hash); + hash = hash*FUNNY_NUMBER4 + sz; + break; + } + case EXPORT_DEF: + { + Export* ep = (Export *) (export_val(term))[1]; + + hash = hash * FUNNY_NUMBER11 + ep->code[2]; + hash = hash*FUNNY_NUMBER1 + + (atom_tab(atom_val(ep->code[0]))->slot.bucket.hvalue); + hash = hash*FUNNY_NUMBER1 + + (atom_tab(atom_val(ep->code[1]))->slot.bucket.hvalue); + break; + } + + case FUN_DEF: + { + ErlFunThing* funp = (ErlFunThing *) fun_val(term); + Uint num_free = funp->num_free; + + hash = hash * FUNNY_NUMBER10 + num_free; + hash = hash*FUNNY_NUMBER1 + + (atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue); + hash = hash*FUNNY_NUMBER2 + funp->fe->old_index; + hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq; + if (num_free > 0) { + if (num_free > 1) { + ESTACK_PUSH3(stack, (Eterm) &funp->env[1], (num_free-1), MAKE_HASH_FUN_OP); + } + term = funp->env[0]; + goto tail_recur; + } + break; + } + case PID_DEF: + UINT32_HASH_RET(internal_pid_number(term),FUNNY_NUMBER5,FUNNY_NUMBER6); + case EXTERNAL_PID_DEF: + UINT32_HASH_RET(external_pid_number(term),FUNNY_NUMBER5,FUNNY_NUMBER6); + case PORT_DEF: + UINT32_HASH_RET(internal_port_number(term),FUNNY_NUMBER9,FUNNY_NUMBER10); + case EXTERNAL_PORT_DEF: + UINT32_HASH_RET(external_port_number(term),FUNNY_NUMBER9,FUNNY_NUMBER10); + case REF_DEF: + UINT32_HASH_RET(internal_ref_numbers(term)[0],FUNNY_NUMBER9,FUNNY_NUMBER10); + case EXTERNAL_REF_DEF: + UINT32_HASH_RET(external_ref_numbers(term)[0],FUNNY_NUMBER9,FUNNY_NUMBER10); + case FLOAT_DEF: + { + FloatDef ff; + GET_DOUBLE(term, ff); + hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]); + break; + } + + case MAKE_HASH_CDR_PRE_OP: + term = ESTACK_POP(stack); + if (is_not_list(term)) { + ESTACK_PUSH(stack, MAKE_HASH_CDR_POST_OP); + goto tail_recur; + } + /* fall through */ + case LIST_DEF: + { + Eterm* list = list_val(term); + while(is_byte(*list)) { + /* Optimization for strings. + ** Note that this hash is different from a 'small' hash, + ** as multiplications on a Sparc is so slow. + */ + hash = hash*FUNNY_NUMBER2 + unsigned_val(*list); + + if (is_not_list(CDR(list))) { + ESTACK_PUSH(stack, MAKE_HASH_CDR_POST_OP); + term = CDR(list); + goto tail_recur; + } + list = list_val(CDR(list)); + } + ESTACK_PUSH2(stack, CDR(list), MAKE_HASH_CDR_PRE_OP); + term = CAR(list); + goto tail_recur; + } + case MAKE_HASH_CDR_POST_OP: + hash *= FUNNY_NUMBER8; + break; + + case BIG_DEF: + /* Note that this is the exact same thing as the hashing of smalls.*/ + { + Eterm* ptr = big_val(term); + Uint n = BIG_SIZE(ptr); + Uint k = n-1; + ErtsDigit d; + int is_neg = BIG_SIGN(ptr); + Uint i; + int j; + + for (i = 0; i < k; i++) { + d = BIG_DIGIT(ptr, i); + for(j = 0; j < sizeof(ErtsDigit); ++j) { + hash = (hash*FUNNY_NUMBER2) + (d & 0xff); + d >>= 8; + } + } + d = BIG_DIGIT(ptr, k); + k = sizeof(ErtsDigit); +#ifdef ARCH_64 + if (!(d >> 32)) + k /= 2; +#endif + for(j = 0; j < (int)k; ++j) { + hash = (hash*FUNNY_NUMBER2) + (d & 0xff); + d >>= 8; + } + hash *= is_neg ? FUNNY_NUMBER4 : FUNNY_NUMBER3; + break; + } + case TUPLE_DEF: + { + Eterm* ptr = tuple_val(term); + Uint arity = arityval(*ptr); + + ESTACK_PUSH3(stack, arity, (Eterm)(ptr+1), arity); + op = MAKE_HASH_TUPLE_OP; + }/*fall through*/ + case MAKE_HASH_TUPLE_OP: + case MAKE_HASH_FUN_OP: + { + Uint i = ESTACK_POP(stack); + Eterm* ptr = (Eterm*) ESTACK_POP(stack); + if (i != 0) { + term = *ptr; + ESTACK_PUSH3(stack, (Eterm)(ptr+1), i-1, op); + goto tail_recur; + } + if (op == MAKE_HASH_TUPLE_OP) { + Uint32 arity = ESTACK_POP(stack); + hash = hash*FUNNY_NUMBER9 + arity; + } + break; + } + + default: + erl_exit(1, "Invalid tag in make_hash(0x%X,0x%X)\n", term, op); + return 0; + } + if (ESTACK_ISEMPTY(stack)) break; + op = ESTACK_POP(stack); + } + DESTROY_ESTACK(stack); + return hash; + +#undef UINT32_HASH_STEP +#undef UINT32_HASH_RET +} + + + +/* Hash function suggested by Bob Jenkins. */ + +#define MIX(a,b,c) \ +do { \ + a -= b; a -= c; a ^= (c>>13); \ + b -= c; b -= a; b ^= (a<<8); \ + c -= a; c -= b; c ^= (b>>13); \ + a -= b; a -= c; a ^= (c>>12); \ + b -= c; b -= a; b ^= (a<<16); \ + c -= a; c -= b; c ^= (b>>5); \ + a -= b; a -= c; a ^= (c>>3); \ + b -= c; b -= a; b ^= (a<<10); \ + c -= a; c -= b; c ^= (b>>15); \ +} while(0) + +#define HCONST 0x9e3779b9UL /* the golden ratio; an arbitrary value */ + +Uint32 +block_hash(byte *k, unsigned length, Uint32 initval) +{ + Uint32 a,b,c; + unsigned len; + + /* Set up the internal state */ + len = length; + a = b = HCONST; + c = initval; /* the previous hash value */ + + while (len >= 12) + { + a += (k[0] +((Uint32)k[1]<<8) +((Uint32)k[2]<<16) +((Uint32)k[3]<<24)); + b += (k[4] +((Uint32)k[5]<<8) +((Uint32)k[6]<<16) +((Uint32)k[7]<<24)); + c += (k[8] +((Uint32)k[9]<<8) +((Uint32)k[10]<<16)+((Uint32)k[11]<<24)); + MIX(a,b,c); + k += 12; len -= 12; + } + + c += length; + switch(len) /* all the case statements fall through */ + { + case 11: c+=((Uint32)k[10]<<24); + case 10: c+=((Uint32)k[9]<<16); + case 9 : c+=((Uint32)k[8]<<8); + /* the first byte of c is reserved for the length */ + case 8 : b+=((Uint32)k[7]<<24); + case 7 : b+=((Uint32)k[6]<<16); + case 6 : b+=((Uint32)k[5]<<8); + case 5 : b+=k[4]; + case 4 : a+=((Uint32)k[3]<<24); + case 3 : a+=((Uint32)k[2]<<16); + case 2 : a+=((Uint32)k[1]<<8); + case 1 : a+=k[0]; + /* case 0: nothing left to add */ + } + MIX(a,b,c); + return c; +} + +Uint32 +make_hash2(Eterm term) +{ + Uint32 hash; + Eterm tmp_big[2]; + +/* (HCONST * {2, ..., 14}) mod 2^32 */ +#define HCONST_2 0x3c6ef372UL +#define HCONST_3 0xdaa66d2bUL +#define HCONST_4 0x78dde6e4UL +#define HCONST_5 0x1715609dUL +#define HCONST_6 0xb54cda56UL +#define HCONST_7 0x5384540fUL +#define HCONST_8 0xf1bbcdc8UL +#define HCONST_9 0x8ff34781UL +#define HCONST_10 0x2e2ac13aUL +#define HCONST_11 0xcc623af3UL +#define HCONST_12 0x6a99b4acUL +#define HCONST_13 0x08d12e65UL +#define HCONST_14 0xa708a81eUL +#define HCONST_15 0x454021d7UL + +#define UINT32_HASH_2(Expr1, Expr2, AConst) \ + do { \ + Uint32 a,b; \ + a = AConst + (Uint32) (Expr1); \ + b = AConst + (Uint32) (Expr2); \ + MIX(a,b,hash); \ + } while(0) + +#define UINT32_HASH(Expr, AConst) UINT32_HASH_2(Expr, 0, AConst) + +#define SINT32_HASH(Expr, AConst) \ + do { \ + Sint32 y = (Sint32) (Expr); \ + if (y < 0) { \ + UINT32_HASH(-y, AConst); \ + /* Negative numbers are unnecessarily mixed twice. */ \ + } \ + UINT32_HASH(y, AConst); \ + } while(0) + +#define IS_SSMALL28(x) (((Uint) (((x) >> (28-1)) + 1)) < 2) + + /* Optimization. Simple cases before declaration of estack. */ + if (primary_tag(term) == TAG_PRIMARY_IMMED1) { + switch (term & _TAG_IMMED1_MASK) { + case _TAG_IMMED1_IMMED2: + switch (term & _TAG_IMMED2_MASK) { + case _TAG_IMMED2_ATOM: + /* Fast, but the poor hash value should be mixed. */ + return atom_tab(atom_val(term))->slot.bucket.hvalue; + } + break; + case _TAG_IMMED1_SMALL: + { + Sint x = signed_val(term); + + if (SMALL_BITS > 28 && !IS_SSMALL28(x)) { + term = small_to_big(x, tmp_big); + break; + } + hash = 0; + SINT32_HASH(x, HCONST); + return hash; + } + } + }; + { + Eterm tmp; + DECLARE_ESTACK(s); + + hash = 0; + for (;;) { + switch (primary_tag(term)) { + case TAG_PRIMARY_LIST: + { + int c = 0; + Uint32 sh = 0; + Eterm* ptr = list_val(term); + while (is_byte(*ptr)) { + /* Optimization for strings. */ + sh = (sh << 8) + unsigned_val(*ptr); + if (c == 3) { + UINT32_HASH(sh, HCONST_4); + c = sh = 0; + } else { + c++; + } + term = CDR(ptr); + if (is_not_list(term)) + break; + ptr = list_val(term); + } + if (c > 0) + UINT32_HASH(sh, HCONST_4); + if (is_list(term)) { + term = *ptr; + tmp = *++ptr; + ESTACK_PUSH(s, tmp); + } + } + break; + case TAG_PRIMARY_BOXED: + { + Eterm hdr = *boxed_val(term); + ASSERT(is_header(hdr)); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + { + int i; + int arity = header_arity(hdr); + Eterm* elem = tuple_val(term); + UINT32_HASH(arity, HCONST_9); + if (arity == 0) /* Empty tuple */ + goto hash2_common; + for (i = arity; i >= 2; i--) { + tmp = elem[i]; + ESTACK_PUSH(s, tmp); + } + term = elem[1]; + } + break; + case EXPORT_SUBTAG: + { + Export* ep = (Export *) (export_val(term))[1]; + + UINT32_HASH_2 + (ep->code[2], + atom_tab(atom_val(ep->code[0]))->slot.bucket.hvalue, + HCONST); + UINT32_HASH + (atom_tab(atom_val(ep->code[1]))->slot.bucket.hvalue, + HCONST_14); + goto hash2_common; + } + + case FUN_SUBTAG: + { + ErlFunThing* funp = (ErlFunThing *) fun_val(term); + Uint num_free = funp->num_free; + + UINT32_HASH_2 + (num_free, + atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue, + HCONST); + UINT32_HASH_2 + (funp->fe->old_index, funp->fe->old_uniq, HCONST); + if (num_free == 0) { + goto hash2_common; + } else { + Eterm* bptr = funp->env + num_free - 1; + while (num_free-- > 1) { + term = *bptr--; + ESTACK_PUSH(s, term); + } + term = *bptr; + } + } + break; + case REFC_BINARY_SUBTAG: + case HEAP_BINARY_SUBTAG: + case SUB_BINARY_SUBTAG: + { + byte* bptr; + unsigned sz = binary_size(term); + Uint32 con = HCONST_13 + hash; + Uint bitoffs; + Uint bitsize; + + ERTS_GET_BINARY_BYTES(term, bptr, bitoffs, bitsize); + if (sz == 0 && bitsize == 0) { + hash = con; + } else { + if (bitoffs == 0) { + hash = block_hash(bptr, sz, con); + if (bitsize > 0) { + UINT32_HASH_2(bitsize, (bptr[sz] >> (8 - bitsize)), + HCONST_15); + } + } else { + byte* buf = (byte *) erts_alloc(ERTS_ALC_T_TMP, + sz + (bitsize != 0)); + erts_copy_bits(bptr, bitoffs, 1, buf, 0, 1, sz*8+bitsize); + hash = block_hash(buf, sz, con); + if (bitsize > 0) { + UINT32_HASH_2(bitsize, (buf[sz] >> (8 - bitsize)), + HCONST_15); + } + erts_free(ERTS_ALC_T_TMP, (void *) buf); + } + } + goto hash2_common; + } + break; + case POS_BIG_SUBTAG: + case NEG_BIG_SUBTAG: + { + Eterm* ptr = big_val(term); + Uint i = 0; + Uint n = BIG_SIZE(ptr); + Uint32 con = BIG_SIGN(ptr) ? HCONST_10 : HCONST_11; +#if D_EXP == 16 + do { + Uint32 x, y; + x = i < n ? BIG_DIGIT(ptr, i++) : 0; + x += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16; + y = i < n ? BIG_DIGIT(ptr, i++) : 0; + y += (Uint32)(i < n ? BIG_DIGIT(ptr, i++) : 0) << 16; + UINT32_HASH_2(x, y, con); + } while (i < n); +#elif D_EXP == 32 + do { + Uint32 x, y; + x = i < n ? BIG_DIGIT(ptr, i++) : 0; + y = i < n ? BIG_DIGIT(ptr, i++) : 0; + UINT32_HASH_2(x, y, con); + } while (i < n); +#elif D_EXP == 64 + do { + Uint t; + Uint32 x, y; + t = i < n ? BIG_DIGIT(ptr, i++) : 0; + x = t & 0xffffffff; + y = t >> 32; + UINT32_HASH_2(x, y, con); + } while (i < n); +#else +#error "unsupported D_EXP size" +#endif + goto hash2_common; + } + break; + case REF_SUBTAG: + /* All parts of the ref should be hashed. */ + UINT32_HASH(internal_ref_numbers(term)[0], HCONST_7); + goto hash2_common; + break; + case EXTERNAL_REF_SUBTAG: + /* All parts of the ref should be hashed. */ + UINT32_HASH(external_ref_numbers(term)[0], HCONST_7); + goto hash2_common; + break; + case EXTERNAL_PID_SUBTAG: + /* Only 15 bits are hashed. */ + UINT32_HASH(external_pid_number(term), HCONST_5); + goto hash2_common; + case EXTERNAL_PORT_SUBTAG: + /* Only 15 bits are hashed. */ + UINT32_HASH(external_port_number(term), HCONST_6); + goto hash2_common; + case FLOAT_SUBTAG: + { + FloatDef ff; + GET_DOUBLE(term, ff); +#if defined(WORDS_BIGENDIAN) + UINT32_HASH_2(ff.fw[0], ff.fw[1], HCONST_12); +#else + UINT32_HASH_2(ff.fw[1], ff.fw[0], HCONST_12); +#endif + goto hash2_common; + } + break; + + default: + erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term); + } + } + break; + case TAG_PRIMARY_IMMED1: + switch (term & _TAG_IMMED1_MASK) { + case _TAG_IMMED1_PID: + /* Only 15 bits are hashed. */ + UINT32_HASH(internal_pid_number(term), HCONST_5); + goto hash2_common; + case _TAG_IMMED1_PORT: + /* Only 15 bits are hashed. */ + UINT32_HASH(internal_port_number(term), HCONST_6); + goto hash2_common; + case _TAG_IMMED1_IMMED2: + switch (term & _TAG_IMMED2_MASK) { + case _TAG_IMMED2_ATOM: + if (hash == 0) + /* Fast, but the poor hash value should be mixed. */ + hash = atom_tab(atom_val(term))->slot.bucket.hvalue; + else + UINT32_HASH(atom_tab(atom_val(term))->slot.bucket.hvalue, + HCONST_3); + goto hash2_common; + case _TAG_IMMED2_NIL: + if (hash == 0) + hash = 3468870702UL; + else + UINT32_HASH(NIL_DEF, HCONST_2); + goto hash2_common; + default: + erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term); + } + case _TAG_IMMED1_SMALL: + { + Sint x = signed_val(term); + + if (SMALL_BITS > 28 && !IS_SSMALL28(x)) { + term = small_to_big(x, tmp_big); + break; + } + SINT32_HASH(x, HCONST); + goto hash2_common; + } + } + break; + default: + erl_exit(1, "Invalid tag in make_hash2(0x%X)\n", term); + hash2_common: + if (ESTACK_ISEMPTY(s)) { + DESTROY_ESTACK(s); + return hash; + } + term = ESTACK_POP(s); + } + } + } +#undef UINT32_HASH_2 +#undef UINT32_HASH +#undef SINT32_HASH +} + +#undef HCONST +#undef MIX + + +Uint32 make_broken_hash(Eterm term) +{ + Uint32 hash = 0; + DECLARE_ESTACK(stack); + unsigned op; +tail_recur: + op = tag_val_def(term); + for (;;) { + switch (op) { + case NIL_DEF: + hash = hash*FUNNY_NUMBER3 + 1; + break; + case ATOM_DEF: + hash = hash*FUNNY_NUMBER1 + + (atom_tab(atom_val(term))->slot.bucket.hvalue); + break; + case SMALL_DEF: +#ifdef ARCH_64 + { + Sint y1 = signed_val(term); + Uint y2 = y1 < 0 ? -(Uint)y1 : y1; + Uint32 y3 = (Uint32) (y2 >> 32); + int arity = 1; + +#if defined(WORDS_BIGENDIAN) + if (!IS_SSMALL28(y1)) + { /* like a bignum */ + Uint32 y4 = (Uint32) y2; + hash = hash*FUNNY_NUMBER2 + ((y4 << 16) | (y4 >> 16)); + if (y3) + { + hash = hash*FUNNY_NUMBER2 + ((y3 << 16) | (y3 >> 16)); + arity++; + } + hash = hash * (y1 < 0 ? FUNNY_NUMBER3 : FUNNY_NUMBER2) + arity; + } else { + hash = hash*FUNNY_NUMBER2 + (((Uint) y1) & 0xfffffff); + } +#else + if (!IS_SSMALL28(y1)) + { /* like a bignum */ + hash = hash*FUNNY_NUMBER2 + ((Uint32) y2); + if (y3) + { + hash = hash*FUNNY_NUMBER2 + y3; + arity++; + } + hash = hash * (y1 < 0 ? FUNNY_NUMBER3 : FUNNY_NUMBER2) + arity; + } else { + hash = hash*FUNNY_NUMBER2 + (((Uint) y1) & 0xfffffff); + } +#endif + } +#else + hash = hash*FUNNY_NUMBER2 + unsigned_val(term); +#endif + break; + + case BINARY_DEF: + { + size_t sz = binary_size(term); + size_t i = (sz < 15) ? sz : 15; + + hash = hash_binary_bytes(term, i, hash); + hash = hash*FUNNY_NUMBER4 + sz; + break; + } + + case EXPORT_DEF: + { + Export* ep = (Export *) (export_val(term))[1]; + + hash = hash * FUNNY_NUMBER11 + ep->code[2]; + hash = hash*FUNNY_NUMBER1 + + (atom_tab(atom_val(ep->code[0]))->slot.bucket.hvalue); + hash = hash*FUNNY_NUMBER1 + + (atom_tab(atom_val(ep->code[1]))->slot.bucket.hvalue); + break; + } + + case FUN_DEF: + { + ErlFunThing* funp = (ErlFunThing *) fun_val(term); + Uint num_free = funp->num_free; + + hash = hash * FUNNY_NUMBER10 + num_free; + hash = hash*FUNNY_NUMBER1 + + (atom_tab(atom_val(funp->fe->module))->slot.bucket.hvalue); + hash = hash*FUNNY_NUMBER2 + funp->fe->old_index; + hash = hash*FUNNY_NUMBER2 + funp->fe->old_uniq; + if (num_free > 0) { + if (num_free > 1) { + ESTACK_PUSH3(stack, (Eterm) &funp->env[1], (num_free-1), MAKE_HASH_FUN_OP); + } + term = funp->env[0]; + goto tail_recur; + } + break; + } + + case PID_DEF: + hash = hash*FUNNY_NUMBER5 + internal_pid_number(term); + break; + case EXTERNAL_PID_DEF: + hash = hash*FUNNY_NUMBER5 + external_pid_number(term); + break; + case PORT_DEF: + hash = hash*FUNNY_NUMBER9 + internal_port_number(term); + break; + case EXTERNAL_PORT_DEF: + hash = hash*FUNNY_NUMBER9 + external_port_number(term); + break; + case REF_DEF: + hash = hash*FUNNY_NUMBER9 + internal_ref_numbers(term)[0]; + break; + case EXTERNAL_REF_DEF: + hash = hash*FUNNY_NUMBER9 + external_ref_numbers(term)[0]; + break; + case FLOAT_DEF: + { + FloatDef ff; + GET_DOUBLE(term, ff); + hash = hash*FUNNY_NUMBER6 + (ff.fw[0] ^ ff.fw[1]); + } + break; + + case MAKE_HASH_CDR_PRE_OP: + term = ESTACK_POP(stack); + if (is_not_list(term)) { + ESTACK_PUSH(stack, MAKE_HASH_CDR_POST_OP); + goto tail_recur; + } + /*fall through*/ + case LIST_DEF: + { + Eterm* list = list_val(term); + ESTACK_PUSH2(stack, CDR(list), MAKE_HASH_CDR_PRE_OP); + term = CAR(list); + goto tail_recur; + } + + case MAKE_HASH_CDR_POST_OP: + hash *= FUNNY_NUMBER8; + break; + + case BIG_DEF: + { + Eterm* ptr = big_val(term); + int is_neg = BIG_SIGN(ptr); + Uint arity = BIG_ARITY(ptr); + Uint i = arity; + ptr++; +#if D_EXP == 16 + /* hash over 32 bit LE */ + + while(i--) { + hash = hash*FUNNY_NUMBER2 + *ptr++; + } +#elif D_EXP == 32 + +#if defined(WORDS_BIGENDIAN) + while(i--) { + Uint d = *ptr++; + hash = hash*FUNNY_NUMBER2 + ((d << 16) | (d >> 16)); + } +#else + while(i--) { + hash = hash*FUNNY_NUMBER2 + *ptr++; + } +#endif + +#elif D_EXP == 64 + { + Uint32 h = 0, l; +#if defined(WORDS_BIGENDIAN) + while(i--) { + Uint d = *ptr++; + l = d & 0xffffffff; + h = d >> 32; + hash = hash*FUNNY_NUMBER2 + ((l << 16) | (l >> 16)); + if (h || i) + hash = hash*FUNNY_NUMBER2 + ((h << 16) | (h >> 16)); + } +#else + while(i--) { + Uint d = *ptr++; + l = d & 0xffffffff; + h = d >> 32; + hash = hash*FUNNY_NUMBER2 + l; + if (h || i) + hash = hash*FUNNY_NUMBER2 + h; + } +#endif + /* adjust arity to match 32 bit mode */ + arity = (arity << 1) - (h == 0); + } + +#else +#error "unsupported D_EXP size" +#endif + hash = hash * (is_neg ? FUNNY_NUMBER3 : FUNNY_NUMBER2) + arity; + } + break; + + case TUPLE_DEF: + { + Eterm* ptr = tuple_val(term); + Uint arity = arityval(*ptr); + + ESTACK_PUSH3(stack, arity, (Eterm)(ptr+1), arity); + op = MAKE_HASH_TUPLE_OP; + }/*fall through*/ + case MAKE_HASH_TUPLE_OP: + case MAKE_HASH_FUN_OP: + { + Uint i = ESTACK_POP(stack); + Eterm* ptr = (Eterm*) ESTACK_POP(stack); + if (i != 0) { + term = *ptr; + ESTACK_PUSH3(stack, (Eterm)(ptr+1), i-1, op); + goto tail_recur; + } + if (op == MAKE_HASH_TUPLE_OP) { + Uint32 arity = ESTACK_POP(stack); + hash = hash*FUNNY_NUMBER9 + arity; + } + break; + } + + default: + erl_exit(1, "Invalid tag in make_broken_hash\n"); + return 0; + } + if (ESTACK_ISEMPTY(stack)) break; + op = ESTACK_POP(stack); + } + + DESTROY_ESTACK(stack); + return hash; + +#undef MAKE_HASH_TUPLE_OP +#undef MAKE_HASH_FUN_OP +#undef MAKE_HASH_CDR_PRE_OP +#undef MAKE_HASH_CDR_POST_OP +} + +static int do_send_to_logger(Eterm tag, Eterm gleader, char *buf, int len) +{ + /* error_logger ! + {notify,{info_msg,gleader,{emulator,"~s~n",[]}}} | + {notify,{error,gleader,{emulator,"~s~n",[]}}} | + {notify,{warning_msg,gleader,{emulator,"~s~n",[}]}} */ + Eterm* hp; + Uint sz; + Uint gl_sz; + Eterm gl; + Eterm list,plist,format,tuple1,tuple2,tuple3; + ErlOffHeap *ohp; + ErlHeapFragment *bp = NULL; +#if !defined(ERTS_SMP) + Process *p; +#endif + + ASSERT(is_atom(tag)); + + if (len <= 0) { + return -1; + } + +#ifndef ERTS_SMP + if ( +#ifdef USE_THREADS + !erts_get_scheduler_data() || /* Must be scheduler thread */ +#endif + (p = erts_whereis_process(NULL, 0, am_error_logger, 0, 0)) == NULL + || p->status == P_RUNNING) { + /* buf *always* points to a null terminated string */ + erts_fprintf(stderr, "(no error logger present) %T: \"%s\"\n", + tag, buf); + return 0; + } + /* So we have an error logger, lets build the message */ +#endif + gl_sz = IS_CONST(gleader) ? 0 : size_object(gleader); + sz = len * 2 /* message list */+ 2 /* cons surrounding message list */ + + gl_sz + + 3 /*outer 2-tuple*/ + 4 /* middle 3-tuple */ + 4 /*inner 3-tuple */ + + 8 /* "~s~n" */; + +#ifndef ERTS_SMP + if (sz <= HeapWordsLeft(p)) { + ohp = &MSO(p); + hp = HEAP_TOP(p); + HEAP_TOP(p) += sz; + } else { +#endif + bp = new_message_buffer(sz); + ohp = &bp->off_heap; + hp = bp->mem; +#ifndef ERTS_SMP + } +#endif + gl = (is_nil(gleader) + ? am_noproc + : (IS_CONST(gleader) + ? gleader + : copy_struct(gleader,gl_sz,&hp,ohp))); + list = buf_to_intlist(&hp, buf, len, NIL); + plist = CONS(hp,list,NIL); + hp += 2; + format = buf_to_intlist(&hp, "~s~n", 4, NIL); + tuple1 = TUPLE3(hp, am_emulator, format, plist); + hp += 4; + tuple2 = TUPLE3(hp, tag, gl, tuple1); + hp += 4; + tuple3 = TUPLE2(hp, am_notify, tuple2); +#ifdef HARDDEBUG + erts_fprintf(stderr, "%T\n", tuple3); +#endif +#ifdef ERTS_SMP + { + Eterm from = erts_get_current_pid(); + if (is_not_internal_pid(from)) + from = NIL; + erts_queue_error_logger_message(from, tuple3, bp); + } +#else + erts_queue_message(p, NULL /* only used for smp build */, bp, tuple3, NIL); +#endif + return 0; +} + +static ERTS_INLINE int +send_info_to_logger(Eterm gleader, char *buf, int len) +{ + return do_send_to_logger(am_info_msg, gleader, buf, len); +} + +static ERTS_INLINE int +send_warning_to_logger(Eterm gleader, char *buf, int len) +{ + Eterm tag; + switch (erts_error_logger_warnings) { + case am_info: tag = am_info_msg; break; + case am_warning: tag = am_warning_msg; break; + default: tag = am_error; break; + } + return do_send_to_logger(tag, gleader, buf, len); +} + +static ERTS_INLINE int +send_error_to_logger(Eterm gleader, char *buf, int len) +{ + return do_send_to_logger(am_error, gleader, buf, len); +} + +#define LOGGER_DSBUF_INC_SZ 256 + +static erts_dsprintf_buf_t * +grow_logger_dsbuf(erts_dsprintf_buf_t *dsbufp, size_t need) +{ + size_t size; + size_t free_size = dsbufp->size - dsbufp->str_len; + + ASSERT(dsbufp && dsbufp->str); + + if (need <= free_size) + return dsbufp; + + size = need - free_size + LOGGER_DSBUF_INC_SZ; + size = (((size + LOGGER_DSBUF_INC_SZ - 1) / LOGGER_DSBUF_INC_SZ) + * LOGGER_DSBUF_INC_SZ); + size += dsbufp->size; + ASSERT(dsbufp->str_len + need <= size); + dsbufp->str = (char *) erts_realloc(ERTS_ALC_T_LOGGER_DSBUF, + (void *) dsbufp->str, + size); + dsbufp->size = size; + return dsbufp; +} + +erts_dsprintf_buf_t * +erts_create_logger_dsbuf(void) +{ + erts_dsprintf_buf_t init = ERTS_DSPRINTF_BUF_INITER(grow_logger_dsbuf); + erts_dsprintf_buf_t *dsbufp = erts_alloc(ERTS_ALC_T_LOGGER_DSBUF, + sizeof(erts_dsprintf_buf_t)); + sys_memcpy((void *) dsbufp, (void *) &init, sizeof(erts_dsprintf_buf_t)); + dsbufp->str = (char *) erts_alloc(ERTS_ALC_T_LOGGER_DSBUF, + LOGGER_DSBUF_INC_SZ); + dsbufp->str[0] = '\0'; + dsbufp->size = LOGGER_DSBUF_INC_SZ; + return dsbufp; +} + +static ERTS_INLINE void +destroy_logger_dsbuf(erts_dsprintf_buf_t *dsbufp) +{ + ASSERT(dsbufp && dsbufp->str); + erts_free(ERTS_ALC_T_LOGGER_DSBUF, (void *) dsbufp->str); + erts_free(ERTS_ALC_T_LOGGER_DSBUF, (void *) dsbufp); +} + +int +erts_send_info_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp) +{ + int res; + res = send_info_to_logger(gleader, dsbufp->str, dsbufp->str_len); + destroy_logger_dsbuf(dsbufp); + return res; +} + +int +erts_send_warning_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp) +{ + int res; + res = send_warning_to_logger(gleader, dsbufp->str, dsbufp->str_len); + destroy_logger_dsbuf(dsbufp); + return res; +} + +int +erts_send_error_to_logger(Eterm gleader, erts_dsprintf_buf_t *dsbufp) +{ + int res; + res = send_error_to_logger(gleader, dsbufp->str, dsbufp->str_len); + destroy_logger_dsbuf(dsbufp); + return res; +} + +int +erts_send_info_to_logger_str(Eterm gleader, char *str) +{ + return send_info_to_logger(gleader, str, sys_strlen(str)); +} + +int +erts_send_warning_to_logger_str(Eterm gleader, char *str) +{ + return send_warning_to_logger(gleader, str, sys_strlen(str)); +} + +int +erts_send_error_to_logger_str(Eterm gleader, char *str) +{ + return send_error_to_logger(gleader, str, sys_strlen(str)); +} + +int +erts_send_info_to_logger_nogl(erts_dsprintf_buf_t *dsbuf) +{ + return erts_send_info_to_logger(NIL, dsbuf); +} + +int +erts_send_warning_to_logger_nogl(erts_dsprintf_buf_t *dsbuf) +{ + return erts_send_warning_to_logger(NIL, dsbuf); +} + +int +erts_send_error_to_logger_nogl(erts_dsprintf_buf_t *dsbuf) +{ + return erts_send_error_to_logger(NIL, dsbuf); +} + +int +erts_send_info_to_logger_str_nogl(char *str) +{ + return erts_send_info_to_logger_str(NIL, str); +} + +int +erts_send_warning_to_logger_str_nogl(char *str) +{ + return erts_send_warning_to_logger_str(NIL, str); +} + +int +erts_send_error_to_logger_str_nogl(char *str) +{ + return erts_send_error_to_logger_str(NIL, str); +} + + +#define TMP_DSBUF_INC_SZ 256 + +static erts_dsprintf_buf_t * +grow_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp, size_t need) +{ + size_t size; + size_t free_size = dsbufp->size - dsbufp->str_len; + + ASSERT(dsbufp); + + if (need <= free_size) + return dsbufp; + size = need - free_size + TMP_DSBUF_INC_SZ; + size = ((size + TMP_DSBUF_INC_SZ - 1)/TMP_DSBUF_INC_SZ)*TMP_DSBUF_INC_SZ; + size += dsbufp->size; + ASSERT(dsbufp->str_len + need <= size); + dsbufp->str = (char *) erts_realloc(ERTS_ALC_T_TMP_DSBUF, + (void *) dsbufp->str, + size); + dsbufp->size = size; + return dsbufp; +} + +erts_dsprintf_buf_t * +erts_create_tmp_dsbuf(Uint size) +{ + Uint init_size = size ? size : TMP_DSBUF_INC_SZ; + erts_dsprintf_buf_t init = ERTS_DSPRINTF_BUF_INITER(grow_tmp_dsbuf); + erts_dsprintf_buf_t *dsbufp = erts_alloc(ERTS_ALC_T_TMP_DSBUF, + sizeof(erts_dsprintf_buf_t)); + sys_memcpy((void *) dsbufp, (void *) &init, sizeof(erts_dsprintf_buf_t)); + dsbufp->str = (char *) erts_alloc(ERTS_ALC_T_TMP_DSBUF, init_size); + dsbufp->str[0] = '\0'; + dsbufp->size = init_size; + return dsbufp; +} + +void +erts_destroy_tmp_dsbuf(erts_dsprintf_buf_t *dsbufp) +{ + if (dsbufp->str) + erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp->str); + erts_free(ERTS_ALC_T_TMP_DSBUF, (void *) dsbufp); +} + + +/* eq and cmp are written as separate functions a eq is a little faster */ + +/* + * Test for equality of two terms. + * Returns 0 if not equal, or a non-zero value otherwise. + */ + +int eq(Eterm a, Eterm b) +{ + DECLARE_ESTACK(stack); + Sint sz; + Eterm* aa; + Eterm* bb; + +tailrecur: + if (a == b) goto pop_next; +tailrecur_ne: + + switch (primary_tag(a)) { + case TAG_PRIMARY_LIST: + if (is_list(b)) { + Eterm* aval = list_val(a); + Eterm* bval = list_val(b); + while (1) { + Eterm atmp = CAR(aval); + Eterm btmp = CAR(bval); + if (atmp != btmp) { + ESTACK_PUSH2(stack,CDR(bval),CDR(aval)); + a = atmp; + b = btmp; + goto tailrecur_ne; + } + atmp = CDR(aval); + btmp = CDR(bval); + if (atmp == btmp) { + goto pop_next; + } + if (is_not_list(atmp) || is_not_list(btmp)) { + a = atmp; + b = btmp; + goto tailrecur_ne; + } + aval = list_val(atmp); + bval = list_val(btmp); + } + } + break; /* not equal */ + + case TAG_PRIMARY_BOXED: + { + Eterm hdr = *boxed_val(a); + switch (hdr & _TAG_HEADER_MASK) { + case ARITYVAL_SUBTAG: + { + aa = tuple_val(a); + if (!is_boxed(b) || *boxed_val(b) != *aa) + goto not_equal; + bb = tuple_val(b); + if ((sz = arityval(*aa)) == 0) goto pop_next; + ++aa; + ++bb; + goto term_array; + } + case REFC_BINARY_SUBTAG: + case HEAP_BINARY_SUBTAG: + case SUB_BINARY_SUBTAG: + { + byte* a_ptr; + byte* b_ptr; + size_t a_size; + size_t b_size; + Uint a_bitsize; + Uint b_bitsize; + Uint a_bitoffs; + Uint b_bitoffs; + + if (is_not_binary(b)) { + goto not_equal; + } + a_size = binary_size(a); + b_size = binary_size(b); + if (a_size != b_size) { + goto not_equal; + } + ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); + ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); + if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { + if (sys_memcmp(a_ptr, b_ptr, a_size) == 0) goto pop_next; + } else if (a_bitsize == b_bitsize) { + if (erts_cmp_bits(a_ptr, a_bitoffs, b_ptr, b_bitoffs, + (a_size << 3) + a_bitsize) == 0) goto pop_next; + } + break; /* not equal */ + } + case EXPORT_SUBTAG: + { + if (is_export(b)) { + Export* a_exp = (Export *) (export_val(a))[1]; + Export* b_exp = (Export *) (export_val(b))[1]; + if (a_exp == b_exp) goto pop_next; + } + break; /* not equal */ + } + case FUN_SUBTAG: + { + ErlFunThing* f1; + ErlFunThing* f2; + + if (is_not_fun(b)) + goto not_equal; + f1 = (ErlFunThing *) fun_val(a); + f2 = (ErlFunThing *) fun_val(b); + if (f1->fe->module != f2->fe->module || + f1->fe->old_index != f2->fe->old_index || + f1->fe->old_uniq != f2->fe->old_uniq || + f1->num_free != f2->num_free) { + goto not_equal; + } + if ((sz = f1->num_free) == 0) goto pop_next; + aa = f1->env; + bb = f2->env; + goto term_array; + } + + case EXTERNAL_PID_SUBTAG: + case EXTERNAL_PORT_SUBTAG: { + ExternalThing *ap; + ExternalThing *bp; + + if(is_not_external(b)) + goto not_equal; + + ap = external_thing_ptr(a); + bp = external_thing_ptr(b); + + if(ap->header == bp->header && ap->node == bp->node) { + ASSERT(1 == external_data_words(a)); + ASSERT(1 == external_data_words(b)); + + if (ap->data.ui[0] == bp->data.ui[0]) goto pop_next; + } + break; /* not equal */ + } + case EXTERNAL_REF_SUBTAG: { + /* + * Observe! + * When comparing refs we need to compare ref numbers + * (32-bit words) *not* ref data words. + */ + Uint32 *anum; + Uint32 *bnum; + Uint common_len; + Uint alen; + Uint blen; + Uint i; + + if(is_not_external_ref(b)) + goto not_equal; + + if(external_node(a) != external_node(b)) + goto not_equal; + + anum = external_ref_numbers(a); + bnum = external_ref_numbers(b); + alen = external_ref_no_of_numbers(a); + blen = external_ref_no_of_numbers(b); + + goto ref_common; + case REF_SUBTAG: + + if (is_not_internal_ref(b)) + goto not_equal; + alen = internal_ref_no_of_numbers(a); + blen = internal_ref_no_of_numbers(b); + anum = internal_ref_numbers(a); + bnum = internal_ref_numbers(b); + + ref_common: + ASSERT(alen > 0 && blen > 0); + + if (anum[0] != bnum[0]) + goto not_equal; + + if (alen == 3 && blen == 3) { + /* Most refs are of length 3 */ + if (anum[1] == bnum[1] && anum[2] == bnum[2]) { + goto pop_next; + } else { + goto not_equal; + } + } + + common_len = alen; + if (blen < alen) + common_len = blen; + + for (i = 1; i < common_len; i++) + if (anum[i] != bnum[i]) + goto not_equal; + + if(alen != blen) { + + if (alen > blen) { + for (i = common_len; i < alen; i++) + if (anum[i] != 0) + goto not_equal; + } + else { + for (i = common_len; i < blen; i++) + if (bnum[i] != 0) + goto not_equal; + } + } + goto pop_next; + } + case POS_BIG_SUBTAG: + case NEG_BIG_SUBTAG: + { + int i; + + if (is_not_big(b)) + goto not_equal; + aa = big_val(a); /* get pointer to thing */ + bb = big_val(b); + if (*aa != *bb) + goto not_equal; + i = BIG_ARITY(aa); + while(i--) { + if (*++aa != *++bb) + goto not_equal; + } + goto pop_next; + } + case FLOAT_SUBTAG: + { + FloatDef af; + FloatDef bf; + + if (is_float(b)) { + GET_DOUBLE(a, af); + GET_DOUBLE(b, bf); + if (af.fd == bf.fd) goto pop_next; + } + break; /* not equal */ + } + } + break; + } + } + goto not_equal; + + +term_array: /* arrays in 'aa' and 'bb', length in 'sz' */ + ASSERT(sz != 0); + { + Eterm* ap = aa; + Eterm* bp = bb; + Sint i = sz; + for (;;) { + if (*ap != *bp) break; + if (--i == 0) goto pop_next; + ++ap; + ++bp; + } + a = *ap; + b = *bp; + if (is_both_immed(a,b)) { + goto not_equal; + } + if (i > 1) { /* push the rest */ + ESTACK_PUSH3(stack, i-1, (Eterm)(bp+1), + ((Eterm)(ap+1)) | TAG_PRIMARY_HEADER); + /* We (ab)use TAG_PRIMARY_HEADER to recognize a term_array */ + } + goto tailrecur_ne; + } + +pop_next: + if (!ESTACK_ISEMPTY(stack)) { + Eterm something = ESTACK_POP(stack); + if (primary_tag(something) == TAG_PRIMARY_HEADER) { /* a term_array */ + aa = (Eterm*) something; + bb = (Eterm*) ESTACK_POP(stack); + sz = ESTACK_POP(stack); + goto term_array; + } + a = something; + b = ESTACK_POP(stack); + goto tailrecur; + } + + DESTROY_ESTACK(stack); + return 1; + +not_equal: + DESTROY_ESTACK(stack); + return 0; +} + + +/* + * Lexically compare two strings of bytes (string s1 length l1 and s2 l2). + * + * s1 < s2 return -1 + * s1 = s2 return 0 + * s1 > s2 return +1 + */ +static int cmpbytes(byte *s1, int l1, byte *s2, int l2) +{ + int i; + i = 0; + while((i < l1) && (i < l2)) { + if (s1[i] < s2[i]) return(-1); + if (s1[i] > s2[i]) return(1); + i++; + } + if (l1 < l2) return(-1); + if (l1 > l2) return(1); + return(0); +} + + +/* + * Compare objects. + * Returns 0 if equal, a negative value if a < b, or a positive number a > b. + * + * According to the Erlang Standard, types are orderered as follows: + * numbers < (characters) < atoms < refs < funs < ports < pids < + * tuples < [] < conses < binaries. + * + * Note that characters are currently not implemented. + * + */ + + +#define float_comp(x,y) (((x)<(y)) ? -1 : (((x)==(y)) ? 0 : 1)) + +static int cmp_atoms(Eterm a, Eterm b) +{ + Atom *aa = atom_tab(atom_val(a)); + Atom *bb = atom_tab(atom_val(b)); + int diff = aa->ord0 - bb->ord0; + if (diff) + return diff; + return cmpbytes(aa->name+3, aa->len-3, + bb->name+3, bb->len-3); +} + +Sint cmp(Eterm a, Eterm b) +{ + DECLARE_ESTACK(stack); + Eterm* aa; + Eterm* bb; + int i; + Sint j; + int a_tag; + int b_tag; + ErlNode *anode; + ErlNode *bnode; + Uint adata; + Uint bdata; + Uint alen; + Uint blen; + Uint32 *anum; + Uint32 *bnum; + +#define RETURN_NEQ(cmp) { j=(cmp); ASSERT(j != 0); goto not_equal; } +#define ON_CMP_GOTO(cmp) if ((j=(cmp)) == 0) goto pop_next; else goto not_equal + +#undef CMP_NODES +#define CMP_NODES(AN, BN) \ + do { \ + if((AN) != (BN)) { \ + if((AN)->sysname != (BN)->sysname) \ + RETURN_NEQ(cmp_atoms((AN)->sysname, (BN)->sysname)); \ + ASSERT((AN)->creation != (BN)->creation); \ + RETURN_NEQ(((AN)->creation < (BN)->creation) ? -1 : 1); \ + } \ + } while (0) + + +tailrecur: + if (a == b) { /* Equal values or pointers. */ + goto pop_next; + } +tailrecur_ne: + + /* deal with majority (?) cases by brute-force */ + if (is_atom(a)) { + if (is_atom(b)) { + ON_CMP_GOTO(cmp_atoms(a, b)); + } + } else if (is_both_small(a, b)) { + ON_CMP_GOTO(signed_val(a) - signed_val(b)); + } + + /* + * Take care of cases where the types are the same. + */ + + a_tag = 42; /* Suppress warning */ + switch (primary_tag(a)) { + case TAG_PRIMARY_IMMED1: + switch ((a & _TAG_IMMED1_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_IMMED1_PORT >> _TAG_PRIMARY_SIZE): + if (is_internal_port(b)) { + bnode = erts_this_node; + bdata = internal_port_data(b); + } else if (is_external_port(b)) { + bnode = external_port_node(b); + bdata = external_port_data(b); + } else { + a_tag = PORT_DEF; + goto mixed_types; + } + anode = erts_this_node; + adata = internal_port_data(a); + + port_common: + CMP_NODES(anode, bnode); + ON_CMP_GOTO((Sint)(adata - bdata)); + + case (_TAG_IMMED1_PID >> _TAG_PRIMARY_SIZE): + if (is_internal_pid(b)) { + bnode = erts_this_node; + bdata = internal_pid_data(b); + } else if (is_external_pid(b)) { + bnode = external_pid_node(b); + bdata = external_pid_data(b); + } else { + a_tag = PID_DEF; + goto mixed_types; + } + anode = erts_this_node; + adata = internal_pid_data(a); + + pid_common: + if (adata != bdata) { + RETURN_NEQ(adata < bdata ? -1 : 1); + } + CMP_NODES(anode, bnode); + goto pop_next; + case (_TAG_IMMED1_SMALL >> _TAG_PRIMARY_SIZE): + a_tag = SMALL_DEF; + goto mixed_types; + case (_TAG_IMMED1_IMMED2 >> _TAG_PRIMARY_SIZE): { + switch ((a & _TAG_IMMED2_MASK) >> _TAG_IMMED1_SIZE) { + case (_TAG_IMMED2_ATOM >> _TAG_IMMED1_SIZE): + a_tag = ATOM_DEF; + goto mixed_types; + case (_TAG_IMMED2_NIL >> _TAG_IMMED1_SIZE): + a_tag = NIL_DEF; + goto mixed_types; + } + } + } + case TAG_PRIMARY_LIST: + if (is_not_list(b)) { + a_tag = LIST_DEF; + goto mixed_types; + } + aa = list_val(a); + bb = list_val(b); + while (1) { + Eterm atmp = CAR(aa); + Eterm btmp = CAR(bb); + if (atmp != btmp) { + ESTACK_PUSH2(stack,CDR(bb),CDR(aa)); + a = atmp; + b = btmp; + goto tailrecur_ne; + } + atmp = CDR(aa); + btmp = CDR(bb); + if (atmp == btmp) { + goto pop_next; + } + if (is_not_list(atmp) || is_not_list(btmp)) { + a = atmp; + b = btmp; + goto tailrecur_ne; + } + aa = list_val(atmp); + bb = list_val(btmp); + } + case TAG_PRIMARY_BOXED: + { + Eterm ahdr = *boxed_val(a); + switch ((ahdr & _TAG_HEADER_MASK) >> _TAG_PRIMARY_SIZE) { + case (_TAG_HEADER_ARITYVAL >> _TAG_PRIMARY_SIZE): + if (is_not_tuple(b)) { + a_tag = TUPLE_DEF; + goto mixed_types; + } + aa = tuple_val(a); + bb = tuple_val(b); + /* compare the arities */ + i = arityval(ahdr); /* get the arity*/ + if (i != arityval(*bb)) { + RETURN_NEQ((int)(i - arityval(*bb))); + } + if (i == 0) { + goto pop_next; + } + ++aa; + ++bb; + goto term_array; + + case (_TAG_HEADER_FLOAT >> _TAG_PRIMARY_SIZE): + if (is_not_float(b)) { + a_tag = FLOAT_DEF; + goto mixed_types; + } else { + FloatDef af; + FloatDef bf; + + GET_DOUBLE(a, af); + GET_DOUBLE(b, bf); + ON_CMP_GOTO(float_comp(af.fd, bf.fd)); + } + case (_TAG_HEADER_POS_BIG >> _TAG_PRIMARY_SIZE): + case (_TAG_HEADER_NEG_BIG >> _TAG_PRIMARY_SIZE): + if (is_not_big(b)) { + a_tag = BIG_DEF; + goto mixed_types; + } + ON_CMP_GOTO(big_comp(a, b)); + case (_TAG_HEADER_EXPORT >> _TAG_PRIMARY_SIZE): + if (is_not_export(b)) { + a_tag = EXPORT_DEF; + goto mixed_types; + } else { + Export* a_exp = (Export *) (export_val(a))[1]; + Export* b_exp = (Export *) (export_val(b))[1]; + + if ((j = cmp_atoms(a_exp->code[0], b_exp->code[0])) != 0) { + RETURN_NEQ(j); + } + if ((j = cmp_atoms(a_exp->code[1], b_exp->code[1])) != 0) { + RETURN_NEQ(j); + } + ON_CMP_GOTO((Sint) a_exp->code[2] - (Sint) b_exp->code[2]); + } + break; + case (_TAG_HEADER_FUN >> _TAG_PRIMARY_SIZE): + if (is_not_fun(b)) { + a_tag = FUN_DEF; + goto mixed_types; + } else { + ErlFunThing* f1 = (ErlFunThing *) fun_val(a); + ErlFunThing* f2 = (ErlFunThing *) fun_val(b); + Sint diff; + + diff = cmpbytes(atom_tab(atom_val(f1->fe->module))->name, + atom_tab(atom_val(f1->fe->module))->len, + atom_tab(atom_val(f2->fe->module))->name, + atom_tab(atom_val(f2->fe->module))->len); + if (diff != 0) { + RETURN_NEQ(diff); + } + diff = f1->fe->old_index - f2->fe->old_index; + if (diff != 0) { + RETURN_NEQ(diff); + } + diff = f1->fe->old_uniq - f2->fe->old_uniq; + if (diff != 0) { + RETURN_NEQ(diff); + } + diff = f1->num_free - f2->num_free; + if (diff != 0) { + RETURN_NEQ(diff); + } + i = f1->num_free; + if (i == 0) goto pop_next; + aa = f1->env; + bb = f2->env; + goto term_array; + } + case (_TAG_HEADER_EXTERNAL_PID >> _TAG_PRIMARY_SIZE): + if (is_internal_pid(b)) { + bnode = erts_this_node; + bdata = internal_pid_data(b); + } else if (is_external_pid(b)) { + bnode = external_pid_node(b); + bdata = external_pid_data(b); + } else { + a_tag = EXTERNAL_PID_DEF; + goto mixed_types; + } + anode = external_pid_node(a); + adata = external_pid_data(a); + goto pid_common; + case (_TAG_HEADER_EXTERNAL_PORT >> _TAG_PRIMARY_SIZE): + if (is_internal_port(b)) { + bnode = erts_this_node; + bdata = internal_port_data(b); + } else if (is_external_port(b)) { + bnode = external_port_node(b); + bdata = external_port_data(b); + } else { + a_tag = EXTERNAL_PORT_DEF; + goto mixed_types; + } + anode = external_port_node(a); + adata = external_port_data(a); + goto port_common; + case (_TAG_HEADER_REF >> _TAG_PRIMARY_SIZE): + /* + * Note! When comparing refs we need to compare ref numbers + * (32-bit words), *not* ref data words. + */ + + if (is_internal_ref(b)) { + bnode = erts_this_node; + bnum = internal_ref_numbers(b); + blen = internal_ref_no_of_numbers(b); + } else if(is_external_ref(b)) { + bnode = external_ref_node(b); + bnum = external_ref_numbers(b); + blen = external_ref_no_of_numbers(b); + } else { + a_tag = REF_DEF; + goto mixed_types; + } + anode = erts_this_node; + anum = internal_ref_numbers(a); + alen = internal_ref_no_of_numbers(a); + + ref_common: + CMP_NODES(anode, bnode); + + ASSERT(alen > 0 && blen > 0); + if (alen != blen) { + if (alen > blen) { + do { + if (anum[alen - 1] != 0) + RETURN_NEQ(1); + alen--; + } while (alen > blen); + } + else { + do { + if (bnum[blen - 1] != 0) + RETURN_NEQ(-1); + blen--; + } while (alen < blen); + } + } + + ASSERT(alen == blen); + for (i = (Sint) alen - 1; i >= 0; i--) + if (anum[i] != bnum[i]) + RETURN_NEQ((Sint32) (anum[i] - bnum[i])); + goto pop_next; + case (_TAG_HEADER_EXTERNAL_REF >> _TAG_PRIMARY_SIZE): + if (is_internal_ref(b)) { + bnode = erts_this_node; + bnum = internal_ref_numbers(b); + blen = internal_ref_no_of_numbers(b); + } else if (is_external_ref(b)) { + bnode = external_ref_node(b); + bnum = external_ref_numbers(b); + blen = external_ref_no_of_numbers(b); + } else { + a_tag = EXTERNAL_REF_DEF; + goto mixed_types; + } + anode = external_ref_node(a); + anum = external_ref_numbers(a); + alen = external_ref_no_of_numbers(a); + goto ref_common; + default: + /* Must be a binary */ + ASSERT(is_binary(a)); + if (is_not_binary(b)) { + a_tag = BINARY_DEF; + goto mixed_types; + } else { + Uint a_size = binary_size(a); + Uint b_size = binary_size(b); + Uint a_bitsize; + Uint b_bitsize; + Uint a_bitoffs; + Uint b_bitoffs; + Uint min_size; + int cmp; + byte* a_ptr; + byte* b_ptr; + ERTS_GET_BINARY_BYTES(a, a_ptr, a_bitoffs, a_bitsize); + ERTS_GET_BINARY_BYTES(b, b_ptr, b_bitoffs, b_bitsize); + if ((a_bitsize | b_bitsize | a_bitoffs | b_bitoffs) == 0) { + min_size = (a_size < b_size) ? a_size : b_size; + if ((cmp = sys_memcmp(a_ptr, b_ptr, min_size)) != 0) { + RETURN_NEQ(cmp); + } + } + else { + a_size = (a_size << 3) + a_bitsize; + b_size = (b_size << 3) + b_bitsize; + min_size = (a_size < b_size) ? a_size : b_size; + if ((cmp = erts_cmp_bits(a_ptr,a_bitoffs, + b_ptr,b_bitoffs,min_size)) != 0) { + RETURN_NEQ(cmp); + } + } + ON_CMP_GOTO((Sint)(a_size - b_size)); + } + } + } + } + + /* + * Take care of the case that the tags are different. + */ + + mixed_types: + b_tag = tag_val_def(b); + + { + FloatDef f1, f2; + Eterm big; + Eterm big_buf[2]; + + switch(_NUMBER_CODE(a_tag, b_tag)) { + case SMALL_BIG: + big = small_to_big(signed_val(a), big_buf); + j = big_comp(big, b); + break; + case SMALL_FLOAT: + f1.fd = signed_val(a); + GET_DOUBLE(b, f2); + j = float_comp(f1.fd, f2.fd); + break; + case BIG_SMALL: + big = small_to_big(signed_val(b), big_buf); + j = big_comp(a, big); + break; + case BIG_FLOAT: + if (big_to_double(a, &f1.fd) < 0) { + j = big_sign(a) ? -1 : 1; + } else { + GET_DOUBLE(b, f2); + j = float_comp(f1.fd, f2.fd); + } + break; + case FLOAT_SMALL: + GET_DOUBLE(a, f1); + f2.fd = signed_val(b); + j = float_comp(f1.fd, f2.fd); + break; + case FLOAT_BIG: + if (big_to_double(b, &f2.fd) < 0) { + j = big_sign(b) ? 1 : -1; + } else { + GET_DOUBLE(a, f1); + j = float_comp(f1.fd, f2.fd); + } + break; + default: + j = b_tag - a_tag; + } + } + if (j == 0) { + goto pop_next; + } else { + goto not_equal; + } + +term_array: /* arrays in 'aa' and 'bb', length in 'i' */ + ASSERT(i>0); + while (--i) { + a = *aa++; + b = *bb++; + if (a != b) { + if (is_atom(a) && is_atom(b)) { + if ((j = cmp_atoms(a, b)) != 0) { + goto not_equal; + } + } else if (is_both_small(a, b)) { + if ((j = signed_val(a)-signed_val(b)) != 0) { + goto not_equal; + } + } else { + /* (ab)Use TAG_PRIMARY_HEADER to recognize a term_array */ + ESTACK_PUSH3(stack, i, (Eterm)bb, (Eterm)aa | TAG_PRIMARY_HEADER); + goto tailrecur_ne; + } + } + } + a = *aa; + b = *bb; + goto tailrecur; + +pop_next: + if (!ESTACK_ISEMPTY(stack)) { + Eterm something = ESTACK_POP(stack); + if (primary_tag(something) == TAG_PRIMARY_HEADER) { /* a term_array */ + aa = (Eterm*) something; + bb = (Eterm*) ESTACK_POP(stack); + i = ESTACK_POP(stack); + goto term_array; + } + a = something; + b = ESTACK_POP(stack); + goto tailrecur; + } + + DESTROY_ESTACK(stack); + return 0; + +not_equal: + DESTROY_ESTACK(stack); + return j; + +#undef CMP_NODES +} + + +void +erts_cleanup_externals(ExternalThing *etp) +{ + ExternalThing *tetp; + + tetp = etp; + + while(tetp) { + erts_deref_node_entry(tetp->node); + tetp = tetp->next; + } +} + +Eterm +store_external_or_ref_(Uint **hpp, ExternalThing **etpp, Eterm ns) +{ + Uint i; + Uint size; + Uint *from_hp; + Uint *to_hp = *hpp; + + ASSERT(is_external(ns) || is_internal_ref(ns)); + + if(is_external(ns)) { + from_hp = external_val(ns); + size = thing_arityval(*from_hp) + 1; + *hpp += size; + + for(i = 0; i < size; i++) + to_hp[i] = from_hp[i]; + + erts_refc_inc(&((ExternalThing *) to_hp)->node->refc, 2); + + ((ExternalThing *) to_hp)->next = *etpp; + *etpp = (ExternalThing *) to_hp; + + return make_external(to_hp); + } + + /* Internal ref */ + from_hp = internal_ref_val(ns); + + size = thing_arityval(*from_hp) + 1; + + *hpp += size; + + for(i = 0; i < size; i++) + to_hp[i] = from_hp[i]; + + return make_internal_ref(to_hp); +} + +Eterm +store_external_or_ref_in_proc_(Process *proc, Eterm ns) +{ + Uint sz; + Uint *hp; + + ASSERT(is_external(ns) || is_internal_ref(ns)); + + sz = NC_HEAP_SIZE(ns); + ASSERT(sz > 0); + hp = HAlloc(proc, sz); + return store_external_or_ref_(&hp, &MSO(proc).externals, ns); +} + +void bin_write(int to, void *to_arg, byte* buf, int sz) +{ + int i; + + for (i=0;is[sizeof(buf->s)-1]; + int sign = 0; + + *p-- = '\0'; /* null terminate */ + if (n == 0) + *p-- = '0'; + else if (n < 0) { + sign = 1; + n = -n; + } + + while (n != 0) { + *p-- = (n % 10) + '0'; + n /= 10; + } + if (sign) + *p-- = '-'; + return p+1; +} + +/* Build a list of integers in some safe memory area +** Memory must be pre allocated prio call 2*len in size +** hp is a pointer to the "heap" pointer on return +** this pointer is updated to point after the list +*/ + +Eterm +buf_to_intlist(Eterm** hpp, char *buf, int len, Eterm tail) +{ + Eterm* hp = *hpp; + + buf += (len-1); + while(len > 0) { + tail = CONS(hp, make_small((byte)*buf), tail); + hp += 2; + buf--; + len--; + } + *hpp = hp; + return tail; +} + +/* +** Write io list in to a buffer. +** +** An iolist is defined as: +** +** iohead ::= Binary +** | Byte (i.e integer in range [0..255] +** | iolist +** ; +** +** iotail ::= [] +** | Binary (added by tony) +** | iolist +** ; +** +** iolist ::= [] +** | Binary +** | [ iohead | iotail] +** ; +** +** Return remaining bytes in buffer on success +** -1 on overflow +** -2 on type error (including that result would not be a whole number of bytes) +*/ + +int io_list_to_buf(Eterm obj, char* buf, int len) +{ + Eterm* objp; + DECLARE_ESTACK(s); + goto L_again; + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_again: + if (is_list(obj)) { + L_iter_list: + objp = list_val(obj); + obj = CAR(objp); + if (is_byte(obj)) { + if (len == 0) { + goto L_overflow; + } + *buf++ = unsigned_val(obj); + len--; + } else if (is_binary(obj)) { + byte* bptr; + size_t size = binary_size(obj); + Uint bitsize; + Uint bitoffs; + Uint num_bits; + + if (len < size) { + goto L_overflow; + } + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); + if (bitsize != 0) { + goto L_type_error; + } + num_bits = 8*size; + copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); + buf += size; + len -= size; + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto L_iter_list; /* on head */ + } else if (is_not_nil(obj)) { + goto L_type_error; + } + + obj = CDR(objp); + if (is_list(obj)) { + goto L_iter_list; /* on tail */ + } else if (is_binary(obj)) { + byte* bptr; + size_t size = binary_size(obj); + Uint bitsize; + Uint bitoffs; + Uint num_bits; + if (len < size) { + goto L_overflow; + } + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); + if (bitsize != 0) { + goto L_type_error; + } + num_bits = 8*size; + copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); + buf += size; + len -= size; + } else if (is_not_nil(obj)) { + goto L_type_error; + } + } else if (is_binary(obj)) { + byte* bptr; + size_t size = binary_size(obj); + Uint bitsize; + Uint bitoffs; + Uint num_bits; + if (len < size) { + goto L_overflow; + } + ERTS_GET_BINARY_BYTES(obj, bptr, bitoffs, bitsize); + if (bitsize != 0) { + goto L_type_error; + } + num_bits = 8*size; + copy_binary_to_buffer(buf, 0, bptr, bitoffs, num_bits); + buf += size; + len -= size; + } else if (is_not_nil(obj)) { + goto L_type_error; + } + } + + DESTROY_ESTACK(s); + return len; + + L_type_error: + DESTROY_ESTACK(s); + return -2; + + L_overflow: + DESTROY_ESTACK(s); + return -1; +} + +int io_list_len(Eterm obj) +{ + Eterm* objp; + Sint len = 0; + DECLARE_ESTACK(s); + goto L_again; + + while (!ESTACK_ISEMPTY(s)) { + obj = ESTACK_POP(s); + L_again: + if (is_list(obj)) { + L_iter_list: + objp = list_val(obj); + /* Head */ + obj = CAR(objp); + if (is_byte(obj)) { + len++; + } else if (is_binary(obj) && binary_bitsize(obj) == 0) { + len += binary_size(obj); + } else if (is_list(obj)) { + ESTACK_PUSH(s, CDR(objp)); + goto L_iter_list; /* on head */ + } else if (is_not_nil(obj)) { + goto L_type_error; + } + /* Tail */ + obj = CDR(objp); + if (is_list(obj)) + goto L_iter_list; /* on tail */ + else if (is_binary(obj) && binary_bitsize(obj) == 0) { + len += binary_size(obj); + } else if (is_not_nil(obj)) { + goto L_type_error; + } + } else if (is_binary(obj) && binary_bitsize(obj) == 0) { /* Tail was binary */ + len += binary_size(obj); + } else if (is_not_nil(obj)) { + goto L_type_error; + } + } + + DESTROY_ESTACK(s); + return len; + + L_type_error: + DESTROY_ESTACK(s); + return -1; +} + +/* return 0 if item is not a non-empty flat list of bytes */ +int +is_string(Eterm list) +{ + int len = 0; + + while(is_list(list)) { + Eterm* consp = list_val(list); + Eterm hd = CAR(consp); + + if (!is_byte(hd)) + return 0; + len++; + list = CDR(consp); + } + if (is_nil(list)) + return len; + return 0; +} + +#ifdef ERTS_SMP + +/* + * Process and Port timers in smp case + */ + +ERTS_SCHED_PREF_PRE_ALLOC_IMPL(ptimer_pre, ErtsSmpPTimer, 1000) + +#define ERTS_PTMR_FLGS_ALLCD_SIZE \ + 2 +#define ERTS_PTMR_FLGS_ALLCD_MASK \ + ((((Uint32) 1) << ERTS_PTMR_FLGS_ALLCD_SIZE) - 1) + +#define ERTS_PTMR_FLGS_PREALLCD ((Uint32) 1) +#define ERTS_PTMR_FLGS_SLALLCD ((Uint32) 2) +#define ERTS_PTMR_FLGS_LLALLCD ((Uint32) 3) +#define ERTS_PTMR_FLG_CANCELLED (((Uint32) 1) << (ERTS_PTMR_FLGS_ALLCD_SIZE+0)) + +static void +init_ptimers(void) +{ + init_ptimer_pre_alloc(); +} + +static ERTS_INLINE void +free_ptimer(ErtsSmpPTimer *ptimer) +{ + switch (ptimer->timer.flags & ERTS_PTMR_FLGS_ALLCD_MASK) { + case ERTS_PTMR_FLGS_PREALLCD: + (void) ptimer_pre_free(ptimer); + break; + case ERTS_PTMR_FLGS_SLALLCD: + erts_free(ERTS_ALC_T_SL_PTIMER, (void *) ptimer); + break; + case ERTS_PTMR_FLGS_LLALLCD: + erts_free(ERTS_ALC_T_LL_PTIMER, (void *) ptimer); + break; + default: + erl_exit(ERTS_ABORT_EXIT, + "Internal error: Bad ptimer alloc type\n"); + break; + } +} + +/* Callback for process timeout cancelled */ +static void +ptimer_cancelled(ErtsSmpPTimer *ptimer) +{ + free_ptimer(ptimer); +} + +/* Callback for process timeout */ +static void +ptimer_timeout(ErtsSmpPTimer *ptimer) +{ + if (is_internal_pid(ptimer->timer.id)) { + Process *p; + p = erts_pid2proc_opt(NULL, + 0, + ptimer->timer.id, + ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS, + ERTS_P2P_FLG_ALLOW_OTHER_X); + if (p) { + if (!p->is_exiting + && !(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) { + ASSERT(*ptimer->timer.timer_ref == ptimer); + *ptimer->timer.timer_ref = NULL; + (*ptimer->timer.timeout_func)(p); + } + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_MAIN|ERTS_PROC_LOCK_STATUS); + } + } + else { + Port *p; + ASSERT(is_internal_port(ptimer->timer.id)); + p = erts_id2port_sflgs(ptimer->timer.id, + NULL, + 0, + ERTS_PORT_SFLGS_DEAD); + if (p) { + if (!(ptimer->timer.flags & ERTS_PTMR_FLG_CANCELLED)) { + ASSERT(*ptimer->timer.timer_ref == ptimer); + *ptimer->timer.timer_ref = NULL; + (*ptimer->timer.timeout_func)(p); + } + erts_port_release(p); + } + } + free_ptimer(ptimer); +} + +void +erts_create_smp_ptimer(ErtsSmpPTimer **timer_ref, + Eterm id, + ErlTimeoutProc timeout_func, + Uint timeout) +{ + ErtsSmpPTimer *res = ptimer_pre_alloc(); + if (res) + res->timer.flags = ERTS_PTMR_FLGS_PREALLCD; + else { + if (timeout < ERTS_ALC_MIN_LONG_LIVED_TIME) { + res = erts_alloc(ERTS_ALC_T_SL_PTIMER, sizeof(ErtsSmpPTimer)); + res->timer.flags = ERTS_PTMR_FLGS_SLALLCD; + } + else { + res = erts_alloc(ERTS_ALC_T_LL_PTIMER, sizeof(ErtsSmpPTimer)); + res->timer.flags = ERTS_PTMR_FLGS_LLALLCD; + } + } + res->timer.timeout_func = timeout_func; + res->timer.timer_ref = timer_ref; + res->timer.id = id; + res->timer.tm.active = 0; /* MUST be initalized */ + + ASSERT(!*timer_ref); + + *timer_ref = res; + + erl_set_timer(&res->timer.tm, + (ErlTimeoutProc) ptimer_timeout, + (ErlCancelProc) ptimer_cancelled, + (void*) res, + timeout); +} + +void +erts_cancel_smp_ptimer(ErtsSmpPTimer *ptimer) +{ + if (ptimer) { + ASSERT(*ptimer->timer.timer_ref == ptimer); + *ptimer->timer.timer_ref = NULL; + ptimer->timer.flags |= ERTS_PTMR_FLG_CANCELLED; + erl_cancel_timer(&ptimer->timer.tm); + } +} + +#endif + +static Sint trim_threshold; +static Sint top_pad; +static Sint mmap_threshold; +static Sint mmap_max; + +Uint tot_bin_allocated; + +void erts_init_utils(void) +{ +#ifdef ERTS_SMP + init_ptimers(); +#endif +} + +void erts_init_utils_mem(void) +{ + trim_threshold = -1; + top_pad = -1; + mmap_threshold = -1; + mmap_max = -1; +} + +int +sys_alloc_opt(int opt, int value) +{ +#if HAVE_MALLOPT + Sint m_opt; + Sint *curr_val; + + switch(opt) { + case SYS_ALLOC_OPT_TRIM_THRESHOLD: +#ifdef M_TRIM_THRESHOLD + m_opt = M_TRIM_THRESHOLD; + curr_val = &trim_threshold; + break; +#else + return 0; +#endif + case SYS_ALLOC_OPT_TOP_PAD: +#ifdef M_TOP_PAD + m_opt = M_TOP_PAD; + curr_val = &top_pad; + break; +#else + return 0; +#endif + case SYS_ALLOC_OPT_MMAP_THRESHOLD: +#ifdef M_MMAP_THRESHOLD + m_opt = M_MMAP_THRESHOLD; + curr_val = &mmap_threshold; + break; +#else + return 0; +#endif + case SYS_ALLOC_OPT_MMAP_MAX: +#ifdef M_MMAP_MAX + m_opt = M_MMAP_MAX; + curr_val = &mmap_max; + break; +#else + return 0; +#endif + default: + return 0; + } + + if(mallopt(m_opt, value)) { + *curr_val = (Sint) value; + return 1; + } + +#endif /* #if HAVE_MALLOPT */ + + return 0; +} + +void +sys_alloc_stat(SysAllocStat *sasp) +{ + sasp->trim_threshold = trim_threshold; + sasp->top_pad = top_pad; + sasp->mmap_threshold = mmap_threshold; + sasp->mmap_max = mmap_max; + +} + +#ifdef ERTS_SMP + +/* Local system block state */ + +struct { + int emergency; + long emergency_timeout; + erts_smp_cnd_t watchdog_cnd; + erts_smp_tid_t watchdog_tid; + int threads_to_block; + int have_blocker; + erts_smp_tid_t blocker_tid; + int recursive_block; + Uint32 allowed_activities; + erts_smp_tsd_key_t blockable_key; + erts_smp_mtx_t mtx; + erts_smp_cnd_t cnd; +#ifdef ERTS_ENABLE_LOCK_CHECK + int activity_changing; + int checking; +#endif +} system_block_state; + +/* Global system block state */ +erts_system_block_state_t erts_system_block_state; + + +static ERTS_INLINE int +is_blockable_thread(void) +{ + return erts_smp_tsd_get(system_block_state.blockable_key) != NULL; +} + +static ERTS_INLINE int +is_blocker(void) +{ + return (system_block_state.have_blocker + && erts_smp_equal_tids(system_block_state.blocker_tid, + erts_smp_thr_self())); +} + +#ifdef ERTS_ENABLE_LOCK_CHECK +int +erts_lc_is_blocking(void) +{ + int res; + erts_smp_mtx_lock(&system_block_state.mtx); + res = erts_smp_pending_system_block() && is_blocker(); + erts_smp_mtx_unlock(&system_block_state.mtx); + return res; +} +#endif + +static ERTS_INLINE void +block_me(void (*prepare)(void *), + void (*resume)(void *), + void *arg, + int mtx_locked, + int want_to_block, + int update_act_changing, + profile_sched_msg_q *psmq) +{ + if (prepare) + (*prepare)(arg); + + /* Locks might be held... */ + + if (!mtx_locked) + erts_smp_mtx_lock(&system_block_state.mtx); + + if (erts_smp_pending_system_block() && !is_blocker()) { + int is_blockable = is_blockable_thread(); + ASSERT(is_blockable); + + if (is_blockable) + system_block_state.threads_to_block--; + + if (erts_system_profile_flags.scheduler && psmq) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + if (esdp) { + profile_sched_msg *msg = NULL; + + ASSERT(psmq->n < 2); + msg = &((psmq->msg)[psmq->n]); + msg->scheduler_id = esdp->no; + get_now(&(msg->Ms), &(msg->s), &(msg->us)); + msg->no_schedulers = 0; + msg->state = am_inactive; + psmq->n++; + } + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (update_act_changing) + system_block_state.activity_changing--; +#endif + + erts_smp_cnd_broadcast(&system_block_state.cnd); + + do { + erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); + } while (erts_smp_pending_system_block() + && !(want_to_block && !system_block_state.have_blocker)); + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (update_act_changing) + system_block_state.activity_changing++; +#endif + if (erts_system_profile_flags.scheduler && psmq) { + ErtsSchedulerData *esdp = erts_get_scheduler_data(); + if (esdp) { + profile_sched_msg *msg = NULL; + + ASSERT(psmq->n < 2); + msg = &((psmq->msg)[psmq->n]); + msg->scheduler_id = esdp->no; + get_now(&(msg->Ms), &(msg->s), &(msg->us)); + msg->no_schedulers = 0; + msg->state = am_active; + psmq->n++; + } + } + + if (is_blockable) + system_block_state.threads_to_block++; + } + + if (!mtx_locked) + erts_smp_mtx_unlock(&system_block_state.mtx); + + if (resume) + (*resume)(arg); +} + +void +erts_block_me(void (*prepare)(void *), + void (*resume)(void *), + void *arg) +{ + profile_sched_msg_q psmq; + psmq.n = 0; + if (prepare) + (*prepare)(arg); + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); /* No locks should be locked */ +#endif + + block_me(NULL, NULL, NULL, 0, 0, 0, &psmq); + + if (erts_system_profile_flags.scheduler && psmq.n > 0) + dispatch_profile_msg_q(&psmq); + + if (resume) + (*resume)(arg); +} + +void +erts_register_blockable_thread(void) +{ + profile_sched_msg_q psmq; + psmq.n = 0; + if (!is_blockable_thread()) { + erts_smp_mtx_lock(&system_block_state.mtx); + system_block_state.threads_to_block++; + erts_smp_tsd_set(system_block_state.blockable_key, + (void *) &erts_system_block_state); + + /* Someone might be waiting for us to block... */ + if (erts_smp_pending_system_block()) + block_me(NULL, NULL, NULL, 1, 0, 0, &psmq); + erts_smp_mtx_unlock(&system_block_state.mtx); + + if (erts_system_profile_flags.scheduler && psmq.n > 0) + dispatch_profile_msg_q(&psmq); + } +} + +void +erts_unregister_blockable_thread(void) +{ + if (is_blockable_thread()) { + erts_smp_mtx_lock(&system_block_state.mtx); + system_block_state.threads_to_block--; + ASSERT(system_block_state.threads_to_block >= 0); + erts_smp_tsd_set(system_block_state.blockable_key, NULL); + + /* Someone might be waiting for us to block... */ + if (erts_smp_pending_system_block()) + erts_smp_cnd_broadcast(&system_block_state.cnd); + erts_smp_mtx_unlock(&system_block_state.mtx); + } +} + +void +erts_note_activity_begin(erts_activity_t activity) +{ + erts_smp_mtx_lock(&system_block_state.mtx); + if (erts_smp_pending_system_block()) { + Uint32 broadcast = 0; + switch (activity) { + case ERTS_ACTIVITY_GC: + broadcast = (system_block_state.allowed_activities + & ERTS_BS_FLG_ALLOW_GC); + break; + case ERTS_ACTIVITY_IO: + broadcast = (system_block_state.allowed_activities + & ERTS_BS_FLG_ALLOW_IO); + break; + case ERTS_ACTIVITY_WAIT: + broadcast = 1; + break; + default: + abort(); + break; + } + if (broadcast) + erts_smp_cnd_broadcast(&system_block_state.cnd); + } + erts_smp_mtx_unlock(&system_block_state.mtx); +} + +void +erts_check_block(erts_activity_t old_activity, + erts_activity_t new_activity, + int locked, + void (*prepare)(void *), + void (*resume)(void *), + void *arg) +{ + int do_block; + profile_sched_msg_q psmq; + + psmq.n = 0; + if (!locked && prepare) + (*prepare)(arg); + + erts_smp_mtx_lock(&system_block_state.mtx); + + /* First check if it is ok to block... */ + if (!locked) + do_block = 1; + else { + switch (old_activity) { + case ERTS_ACTIVITY_UNDEFINED: + do_block = 0; + break; + case ERTS_ACTIVITY_GC: + do_block = (system_block_state.allowed_activities + & ERTS_BS_FLG_ALLOW_GC); + break; + case ERTS_ACTIVITY_IO: + do_block = (system_block_state.allowed_activities + & ERTS_BS_FLG_ALLOW_IO); + break; + case ERTS_ACTIVITY_WAIT: + /* You are not allowed to leave activity waiting + * without supplying the possibility to block + * unlocked. + */ + erts_set_activity_error(ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED, + __FILE__, __LINE__); + do_block = 0; + break; + default: + erts_set_activity_error(ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY, + __FILE__, __LINE__); + do_block = 0; + break; + } + } + + if (do_block) { + /* ... then check if it is necessary to block... */ + + switch (new_activity) { + case ERTS_ACTIVITY_UNDEFINED: + do_block = 1; + break; + case ERTS_ACTIVITY_GC: + do_block = !(system_block_state.allowed_activities + & ERTS_BS_FLG_ALLOW_GC); + break; + case ERTS_ACTIVITY_IO: + do_block = !(system_block_state.allowed_activities + & ERTS_BS_FLG_ALLOW_IO); + break; + case ERTS_ACTIVITY_WAIT: + /* No need to block if we are going to wait */ + do_block = 0; + break; + default: + erts_set_activity_error(ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY, + __FILE__, __LINE__); + break; + } + } + + if (do_block) { + +#ifdef ERTS_ENABLE_LOCK_CHECK + if (!locked) { + /* Only system_block_state.mtx should be held */ + erts_lc_check_exact(&system_block_state.mtx.lc, 1); + } +#endif + + block_me(NULL, NULL, NULL, 1, 0, 1, &psmq); + + } + + erts_smp_mtx_unlock(&system_block_state.mtx); + + if (erts_system_profile_flags.scheduler && psmq.n > 0) + dispatch_profile_msg_q(&psmq); + + if (!locked && resume) + (*resume)(arg); +} + + + +void +erts_set_activity_error(erts_activity_error_t error, char *file, int line) +{ + switch (error) { + case ERTS_ACT_ERR_LEAVE_WAIT_UNLOCKED: + erl_exit(1, "%s:%d: Fatal error: Leaving activity waiting without " + "supplying the possibility to block unlocked.", + file, line); + break; + case ERTS_ACT_ERR_LEAVE_UNKNOWN_ACTIVITY: + erl_exit(1, "%s:%d: Fatal error: Leaving unknown activity.", + file, line); + break; + case ERTS_ACT_ERR_ENTER_UNKNOWN_ACTIVITY: + erl_exit(1, "%s:%d: Fatal error: Leaving unknown activity.", + file, line); + break; + default: + erl_exit(1, "%s:%d: Internal error in erts_smp_set_activity()", + file, line); + break; + } + +} + + +static ERTS_INLINE int +threads_not_under_control(void) +{ + int res = system_block_state.threads_to_block; + + /* Waiting is always an allowed activity... */ + res -= erts_smp_atomic_read(&erts_system_block_state.in_activity.wait); + + if (system_block_state.allowed_activities & ERTS_BS_FLG_ALLOW_GC) + res -= erts_smp_atomic_read(&erts_system_block_state.in_activity.gc); + + if (system_block_state.allowed_activities & ERTS_BS_FLG_ALLOW_IO) + res -= erts_smp_atomic_read(&erts_system_block_state.in_activity.io); + + if (res < 0) { + ASSERT(0); + return 0; + } + return res; +} + +/* + * erts_block_system() blocks all threads registered as blockable. + * It doesn't return until either all threads have blocked (0 is returned) + * or it has timed out (ETIMEDOUT) is returned. + * + * If allowed activities == 0, blocked threads will release all locks + * before blocking. + * + * If allowed_activities is != 0, erts_block_system() will allow blockable + * threads to continue executing as long as they are doing an allowed + * activity. When they are done with the allowed activity they will block, + * *but* they will block holding locks. Therefore, the thread calling + * erts_block_system() must *not* try to aquire any locks that might be + * held by blocked threads holding locks from allowed activities. + * + * Currently allowed_activities are: + * * ERTS_BS_FLG_ALLOW_GC Thread continues with garbage + * collection and blocks with + * main process lock on current + * process locked. + * * ERTS_BS_FLG_ALLOW_IO Thread continues with I/O + */ + +void +erts_block_system(Uint32 allowed_activities) +{ + int do_block; + profile_sched_msg_q psmq; + + psmq.n = 0; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); /* No locks should be locked */ +#endif + + erts_smp_mtx_lock(&system_block_state.mtx); + + do_block = erts_smp_pending_system_block(); + if (do_block + && system_block_state.have_blocker + && erts_smp_equal_tids(system_block_state.blocker_tid, + erts_smp_thr_self())) { + ASSERT(system_block_state.recursive_block >= 0); + system_block_state.recursive_block++; + + /* You are not allowed to restrict allowed activites + in a recursive block! */ + ERTS_SMP_LC_ASSERT((system_block_state.allowed_activities + & ~allowed_activities) == 0); + } + else { + + erts_smp_atomic_inc(&erts_system_block_state.do_block); + + /* Someone else might be waiting for us to block... */ + if (do_block) { + do_block_me: + block_me(NULL, NULL, NULL, 1, 1, 0, &psmq); + } + + ASSERT(!system_block_state.have_blocker); + system_block_state.have_blocker = 1; + system_block_state.blocker_tid = erts_smp_thr_self(); + system_block_state.allowed_activities = allowed_activities; + + if (is_blockable_thread()) + system_block_state.threads_to_block--; + + while (threads_not_under_control() && !system_block_state.emergency) + erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); + + if (system_block_state.emergency) { + system_block_state.have_blocker = 0; + goto do_block_me; + } + } + + erts_smp_mtx_unlock(&system_block_state.mtx); + + if (erts_system_profile_flags.scheduler && psmq.n > 0 ) + dispatch_profile_msg_q(&psmq); +} + +/* + * erts_emergency_block_system() should only be called when we are + * about to write a crash dump... + */ + +int +erts_emergency_block_system(long timeout, Uint32 allowed_activities) +{ + int res = 0; + long another_blocker; + + erts_smp_mtx_lock(&system_block_state.mtx); + + if (system_block_state.emergency) { + /* Argh... */ + res = EINVAL; + goto done; + } + + another_blocker = erts_smp_pending_system_block(); + system_block_state.emergency = 1; + erts_smp_atomic_inc(&erts_system_block_state.do_block); + + if (another_blocker) { + if (is_blocker()) { + erts_smp_atomic_dec(&erts_system_block_state.do_block); + res = 0; + goto done; + } + /* kick the other blocker */ + erts_smp_cnd_broadcast(&system_block_state.cnd); + while (system_block_state.have_blocker) + erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); + } + + ASSERT(!system_block_state.have_blocker); + system_block_state.have_blocker = 1; + system_block_state.blocker_tid = erts_smp_thr_self(); + system_block_state.allowed_activities = allowed_activities; + + if (is_blockable_thread()) + system_block_state.threads_to_block--; + + if (timeout < 0) { + while (threads_not_under_control()) + erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); + } + else { + system_block_state.emergency_timeout = timeout; + erts_smp_cnd_signal(&system_block_state.watchdog_cnd); + + while (system_block_state.emergency_timeout >= 0 + && threads_not_under_control()) { + erts_smp_cnd_wait(&system_block_state.cnd, + &system_block_state.mtx); + } + } + done: + erts_smp_mtx_unlock(&system_block_state.mtx); + return res; +} + +void +erts_release_system(void) +{ + long do_block; + profile_sched_msg_q psmq; + + psmq.n = 0; + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); /* No locks should be locked */ +#endif + + erts_smp_mtx_lock(&system_block_state.mtx); + ASSERT(is_blocker()); + + ASSERT(system_block_state.recursive_block >= 0); + + if (system_block_state.recursive_block) + system_block_state.recursive_block--; + else { + do_block = erts_smp_atomic_dectest(&erts_system_block_state.do_block); + system_block_state.have_blocker = 0; + if (is_blockable_thread()) + system_block_state.threads_to_block++; + else + do_block = 0; + + /* Someone else might be waiting for us to block... */ + if (do_block) + block_me(NULL, NULL, NULL, 1, 0, 0, &psmq); + else + erts_smp_cnd_broadcast(&system_block_state.cnd); + } + + erts_smp_mtx_unlock(&system_block_state.mtx); + + if (erts_system_profile_flags.scheduler && psmq.n > 0) + dispatch_profile_msg_q(&psmq); +} + +#ifdef ERTS_ENABLE_LOCK_CHECK + +void +erts_lc_activity_change_begin(void) +{ + erts_smp_mtx_lock(&system_block_state.mtx); + system_block_state.activity_changing++; + erts_smp_mtx_unlock(&system_block_state.mtx); +} + +void +erts_lc_activity_change_end(void) +{ + erts_smp_mtx_lock(&system_block_state.mtx); + system_block_state.activity_changing--; + if (system_block_state.checking && !system_block_state.activity_changing) + erts_smp_cnd_broadcast(&system_block_state.cnd); + erts_smp_mtx_unlock(&system_block_state.mtx); +} + +#endif + +int +erts_is_system_blocked(erts_activity_t allowed_activities) +{ + int blkd; + + erts_smp_mtx_lock(&system_block_state.mtx); + blkd = (erts_smp_pending_system_block() + && system_block_state.have_blocker + && erts_smp_equal_tids(system_block_state.blocker_tid, + erts_smp_thr_self()) + && !(system_block_state.allowed_activities & ~allowed_activities)); +#ifdef ERTS_ENABLE_LOCK_CHECK + if (blkd) { + system_block_state.checking = 1; + while (system_block_state.activity_changing) + erts_smp_cnd_wait(&system_block_state.cnd, &system_block_state.mtx); + system_block_state.checking = 0; + blkd = !threads_not_under_control(); + } +#endif + erts_smp_mtx_unlock(&system_block_state.mtx); + return blkd; +} + +static void * +emergency_watchdog(void *unused) +{ + erts_smp_mtx_lock(&system_block_state.mtx); + while (1) { + long timeout; + while (system_block_state.emergency_timeout < 0) + erts_smp_cnd_wait(&system_block_state.watchdog_cnd, &system_block_state.mtx); + timeout = system_block_state.emergency_timeout; + erts_smp_mtx_unlock(&system_block_state.mtx); + + if (erts_disable_tolerant_timeofday) + erts_milli_sleep(timeout); + else { + SysTimeval to; + erts_get_timeval(&to); + to.tv_sec += timeout / 1000; + to.tv_usec += timeout % 1000; + + while (1) { + SysTimeval curr; + erts_milli_sleep(timeout); + erts_get_timeval(&curr); + if (curr.tv_sec > to.tv_sec + || (curr.tv_sec == to.tv_sec && curr.tv_usec >= to.tv_usec)) { + break; + } + timeout = (to.tv_sec - curr.tv_sec)*1000; + timeout += (to.tv_usec - curr.tv_usec)/1000; + } + } + + erts_smp_mtx_lock(&system_block_state.mtx); + system_block_state.emergency_timeout = -1; + erts_smp_cnd_broadcast(&system_block_state.cnd); + } + erts_smp_mtx_unlock(&system_block_state.mtx); + return NULL; +} + +void +erts_system_block_init(void) +{ + erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER; + /* Local state... */ + system_block_state.emergency = 0; + system_block_state.emergency_timeout = -1; + erts_smp_cnd_init(&system_block_state.watchdog_cnd); + system_block_state.threads_to_block = 0; + system_block_state.have_blocker = 0; + /* system_block_state.block_tid */ + system_block_state.recursive_block = 0; + system_block_state.allowed_activities = 0; + erts_smp_tsd_key_create(&system_block_state.blockable_key); + erts_smp_mtx_init(&system_block_state.mtx, "system_block"); + erts_smp_cnd_init(&system_block_state.cnd); +#ifdef ERTS_ENABLE_LOCK_CHECK + system_block_state.activity_changing = 0; + system_block_state.checking = 0; +#endif + + thr_opts.suggested_stack_size = 8; + erts_smp_thr_create(&system_block_state.watchdog_tid, + emergency_watchdog, + NULL, + &thr_opts); + + /* Global state... */ + + erts_smp_atomic_init(&erts_system_block_state.do_block, 0L); + erts_smp_atomic_init(&erts_system_block_state.in_activity.wait, 0L); + erts_smp_atomic_init(&erts_system_block_state.in_activity.gc, 0L); + erts_smp_atomic_init(&erts_system_block_state.in_activity.io, 0L); + + /* Make sure blockable threads unregister when exiting... */ + erts_smp_install_exit_handler(erts_unregister_blockable_thread); +} + + +#endif /* #ifdef ERTS_SMP */ + +char * +erts_read_env(char *key) +{ + size_t value_len = 256; + char *value = erts_alloc(ERTS_ALC_T_TMP, value_len); + int res; + while (1) { + res = erts_sys_getenv(key, value, &value_len); + if (res <= 0) + break; + value = erts_realloc(ERTS_ALC_T_TMP, value, value_len); + } + if (res != 0) { + erts_free(ERTS_ALC_T_TMP, value); + return NULL; + } + return value; +} + +void +erts_free_read_env(void *value) +{ + if (value) + erts_free(ERTS_ALC_T_TMP, value); +} + +int +erts_write_env(char *key, char *value) +{ + int ix, res; + size_t key_len = sys_strlen(key), value_len = sys_strlen(value); + char *key_value = erts_alloc_fnf(ERTS_ALC_T_TMP, + key_len + 1 + value_len + 1); + if (!key_value) { + errno = ENOMEM; + return -1; + } + sys_memcpy((void *) key_value, (void *) key, key_len); + ix = key_len; + key_value[ix++] = '='; + sys_memcpy((void *) key_value, (void *) value, value_len); + ix += value_len; + key_value[ix] = '\0'; + res = erts_sys_putenv(key_value, key_len); + erts_free(ERTS_ALC_T_TMP, key_value); + return res; +} + +#ifdef DEBUG +/* + * Handy functions when using a debugger - don't use in the code! + */ + +void upp(buf,sz) +byte* buf; +int sz; +{ + bin_write(ERTS_PRINT_STDERR,NULL,buf,sz); +} + +void pat(Eterm atom) +{ + upp(atom_tab(atom_val(atom))->name, + atom_tab(atom_val(atom))->len); +} + + +void pinfo() +{ + process_info(ERTS_PRINT_STDOUT, NULL); +} + + +void pp(p) +Process *p; +{ + if(p) + print_process_info(ERTS_PRINT_STDERR, NULL, p); +} + +void ppi(Eterm pid) +{ + pp(erts_pid2proc_unlocked(pid)); +} + +void td(Eterm x) +{ + erts_fprintf(stderr, "%T\n", x); +} + +void +ps(Process* p, Eterm* stop) +{ + Eterm* sp = STACK_START(p) - 1; + + if (stop <= STACK_END(p)) { + stop = STACK_END(p) + 1; + } + + while(sp >= stop) { + erts_printf("%p: %.75T\n", sp, *sp); + sp--; + } +} +#endif + + diff --git a/erts/emulator/beam/version.h b/erts/emulator/beam/version.h new file mode 100644 index 0000000000..3952c751b7 --- /dev/null +++ b/erts/emulator/beam/version.h @@ -0,0 +1,19 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +extern char erlversion[], erlhost[], erldate[]; diff --git a/erts/emulator/drivers/common/efile_drv.c b/erts/emulator/drivers/common/efile_drv.c new file mode 100644 index 0000000000..95510a16b2 --- /dev/null +++ b/erts/emulator/drivers/common/efile_drv.c @@ -0,0 +1,3138 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: Provides file and directory operations. + * + * This file is generic, and does the work of decoding the commands + * and encoding the responses. System-specific functions are found in + * the unix_efile.c and win_efile.c files. + */ + +/* Operations */ + +#define FILE_OPEN 1 /* Essential for startup */ +#define FILE_READ 2 +#define FILE_LSEEK 3 +#define FILE_WRITE 4 +#define FILE_FSTAT 5 /* Essential for startup */ +#define FILE_PWD 6 /* Essential for startup */ +#define FILE_READDIR 7 /* Essential for startup */ +#define FILE_CHDIR 8 +#define FILE_FSYNC 9 +#define FILE_MKDIR 10 +#define FILE_DELETE 11 +#define FILE_RENAME 12 +#define FILE_RMDIR 13 +#define FILE_TRUNCATE 14 +#define FILE_READ_FILE 15 /* Essential for startup */ +#define FILE_WRITE_INFO 16 +#define FILE_LSTAT 19 +#define FILE_READLINK 20 +#define FILE_LINK 21 +#define FILE_SYMLINK 22 +#define FILE_CLOSE 23 +#define FILE_PWRITEV 24 +#define FILE_PREADV 25 +#define FILE_SETOPT 26 +#define FILE_IPREAD 27 +#define FILE_ALTNAME 28 +#define FILE_READ_LINE 29 + +/* Return codes */ + +#define FILE_RESP_OK 0 +#define FILE_RESP_ERROR 1 +#define FILE_RESP_DATA 2 +#define FILE_RESP_NUMBER 3 +#define FILE_RESP_INFO 4 +#define FILE_RESP_NUMERR 5 +#define FILE_RESP_LDATA 6 +#define FILE_RESP_N2DATA 7 +#define FILE_RESP_EOF 8 + +/* Options */ + +#define FILE_OPT_DELAYED_WRITE 0 +#define FILE_OPT_READ_AHEAD 1 + +/* IPREAD variants */ + +#define IPREAD_S32BU_P32BU 0 + +/* Limits */ + +#define FILE_SEGMENT_READ (256*1024) +#define FILE_SEGMENT_WRITE (256*1024) + +/* Internal */ + +/* Set to 1 to test having read_ahead implicitly for read_line */ +#define ALWAYS_READ_LINE_AHEAD 0 + + +/* Must not be possible to get from malloc()! */ +#define FILE_FD_INVALID ((Sint)(-1)) + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include +#include "sys.h" +#include "erl_driver.h" +#include "erl_efile.h" +#include "erl_threads.h" +#include "zlib.h" +#include "gzio.h" +#include +#include + +extern void erl_exit(int n, char *fmt, _DOTS_); + +static ErlDrvSysInfo sys_info; + + +/*#define TRACE 1*/ +#ifdef TRACE +# define TRACE_C(c) (putchar(c)) +# define TRACE_S(s) (fputs((s), stdout)) +# define TRACE_F(args) (printf args) +#else +# define TRACE_C(c) ((void)(0)) +# define TRACE_S(s) ((void)(0)) +# define TRACE_F(args) ((void)(0)) +#endif + + +#ifdef USE_THREADS +#define IF_THRDS if (sys_info.async_threads > 0) +#ifdef HARDDEBUG /* HARDDEBUG in io.c is expected too */ +#define TRACE_DRIVER fprintf(stderr, "Efile: ") +#else +#define TRACE_DRIVER +#endif +#define MUTEX_INIT(m, p) do { IF_THRDS { TRACE_DRIVER; (m = driver_pdl_create(p)); } } while (0) +#define MUTEX_LOCK(m) do { IF_THRDS { TRACE_DRIVER; driver_pdl_lock(m); } } while (0) +#define MUTEX_UNLOCK(m) do { IF_THRDS { TRACE_DRIVER; driver_pdl_unlock(m); } } while (0) +#else +#define MUTEX_INIT(m, p) +#define MUTEX_LOCK(m) +#define MUTEX_UNLOCK(m) +#endif + + + +#if 0 +/* Experimental, for forcing all file operations to use the same thread. */ +static unsigned file_fixed_key = 1; +#define KEY(desc) (&file_fixed_key) +#else +#define KEY(desc) (&(desc)->key) +#endif + + + +#if MAXPATHLEN >= BUFSIZ +#define RESBUFSIZE MAXPATHLEN+1 +#else +#define RESBUFSIZE BUFSIZ +#endif + +#define GET_TIME(i, b) \ + (i).year = get_int32((b) + 0 * 4); \ + (i).month = get_int32((b) + 1 * 4); \ + (i).day = get_int32((b) + 2 * 4); \ + (i).hour = get_int32((b) + 3 * 4); \ + (i).minute = get_int32((b) + 4 * 4); \ + (i).second = get_int32((b) + 5 * 4) + +#define PUT_TIME(i, b) \ + put_int32((i).year, (b) + 0 * 4); \ + put_int32((i).month, (b) + 1 * 4); \ + put_int32((i).day, (b) + 2 * 4); \ + put_int32((i).hour, (b) + 3 * 4); \ + put_int32((i).minute,(b) + 4 * 4); \ + put_int32((i).second,(b) + 5 * 4) + + +#if ALWAYS_READ_LINE_AHEAD +#define DEFAULT_LINEBUF_SIZE 2048 +#else +#define DEFAULT_LINEBUF_SIZE 512 /* Small, it's usually discarded anyway */ +#endif + +typedef unsigned char uchar; + +static ErlDrvData file_start(ErlDrvPort port, char* command); +static int file_init(void); +static void file_stop(ErlDrvData); +static void file_output(ErlDrvData, char* buf, int len); +static int file_control(ErlDrvData, unsigned int command, + char* buf, int len, char **rbuf, int rlen); +static void file_timeout(ErlDrvData); +static void file_outputv(ErlDrvData, ErlIOVec*); +static void file_async_ready(ErlDrvData, ErlDrvThreadData); +static void file_flush(ErlDrvData); + + + +enum e_timer {timer_idle, timer_again, timer_write}; + +struct t_data; + +typedef struct { + Sint fd; + ErlDrvPort port; + unsigned key; /* Async queue key */ + unsigned flags; /* Original flags from FILE_OPEN. */ + void (*invoke)(void *); + struct t_data *d; + void (*free)(void *); + struct t_data *cq_head; /* Queue of incoming commands */ + struct t_data *cq_tail; /* -""- */ + enum e_timer timer_state; + size_t read_bufsize; + ErlDrvBinary *read_binp; + size_t read_offset; + size_t read_size; + size_t write_bufsize; + unsigned long write_delay; + int write_error; + Efile_error write_errInfo; + ErlDrvPDL q_mtx; /* Mutex for the driver queue, known by the emulator. Also used for + mutual exclusion when accessing field(s) below. */ + size_t write_buffered; +} file_descriptor; + + +static int reply_error(file_descriptor*, Efile_error* errInfo); + +struct erl_drv_entry efile_driver_entry = { + file_init, + file_start, + file_stop, + file_output, + NULL, + NULL, + "efile", + NULL, + NULL, + file_control, + file_timeout, + file_outputv, + file_async_ready, + file_flush, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL +}; + + + +static int thread_short_circuit; + +#define DRIVER_ASYNC(level, desc, f_invoke, data, f_free) \ +if (thread_short_circuit >= (level)) { \ + (*(f_invoke))(data); \ + file_async_ready((ErlDrvData)(desc), (data)); \ +} else { \ + driver_async((desc)->port, KEY(desc), (f_invoke), (data), (f_free)); \ +} + + + +struct t_pbuf_spec { + Sint64 offset; + size_t size; +}; + +struct t_pwritev { + ErlDrvPort port; + ErlDrvPDL q_mtx; + size_t size; + size_t free_size; + unsigned cnt; + unsigned n; + struct t_pbuf_spec specs[1]; +}; + +struct t_preadv { + ErlIOVec eiov; + unsigned n; + unsigned cnt; + size_t size; + Sint64 offsets[1]; +}; + +#define READDIR_BUFSIZE (8*1024) +#if READDIR_BUFSIZE < (2*MAXPATHLEN) +#undef READDIR_BUFSIZE +#define READDIR_BUFSIZE (2*MAXPATHLEN) +#endif + +struct t_readdir_buf { + struct t_readdir_buf *next; + char buf[READDIR_BUFSIZE]; +}; + +struct t_data +{ + struct t_data *next; + int command; + int level; + void (*invoke)(void *); + void (*free)(void *); + int again; + int reply; + int result_ok; + Efile_error errInfo; + int flags; + Sint fd; + /**/ + Efile_info info; + EFILE_DIR_HANDLE dir_handle; /* Handle to open directory. */ + ErlDrvBinary *bin; + int drive; + size_t n; + /*off_t offset;*/ + /*size_t bytesRead; Bytes read from the file. */ + /**/ + union { + struct { + Sint64 offset; + int origin; + Sint64 location; + } lseek; + struct { + ErlDrvPort port; + ErlDrvPDL q_mtx; + size_t size; + size_t free_size; + size_t reply_size; + } writev; + struct t_pwritev pwritev; + struct t_preadv preadv; + struct { + ErlDrvBinary *binp; + size_t bin_offset; + size_t bin_size; + size_t size; + } read; + struct { + ErlDrvBinary *binp; /* in - out */ + size_t read_offset; /* in - out */ + size_t read_size; /* in - out */ + size_t nl_pos; /* out */ + short nl_skip; /* out, 0 or 1 */ +#if !ALWAYS_READ_LINE_AHEAD + short read_ahead; /* in, bool */ +#endif + } read_line; + struct { + ErlDrvBinary *binp; + int size; + int offset; + char name[1]; + } read_file; + struct { + struct t_readdir_buf *first_buf; + struct t_readdir_buf *last_buf; + } read_dir; + } c; + char b[1]; +}; + + +#define EF_ALLOC(S) driver_alloc((S)) +#define EF_REALLOC(P, S) driver_realloc((P), (S)) +#define EF_SAFE_ALLOC(S) ef_safe_alloc((S)) +#define EF_SAFE_REALLOC(P, S) ef_safe_realloc((P), (S)) +#define EF_FREE(P) do { if((P)) driver_free((P)); } while(0) + +static void *ef_safe_alloc(Uint s) +{ + void *p = EF_ALLOC(s); + if (!p) erl_exit(1, "efile drv: Can't allocate %d bytes of memory\n", s); + return p; +} + +#if 0 /* Currently not used */ + +static void *ef_safe_realloc(void *op, Uint s) +{ + void *p = EF_REALLOC(op, s); + if (!p) erl_exit(1, "efile drv: Can't reallocate %d bytes of memory\n", s); + return p; +} + +#endif + +/********************************************************************* + * ErlIOVec manipulation functions. + */ + +/* char EV_CHAR(ErlIOVec *ev, int p, int q) */ +#define EV_CHAR_P(ev, p, q) \ + (((char *)(ev)->iov[(q)].iov_base) + (p)) + +/* int EV_GET_CHAR(ErlIOVec *ev, char *p, int *pp, int *qp) */ +#define EV_GET_CHAR(ev, p, pp, qp) \ + (*(pp)+1 <= (ev)->iov[*(qp)].iov_len \ + ? (*(p) = *EV_CHAR_P(ev, *(pp), *(qp)), \ + *(pp) = ( *(pp)+1 < (ev)->iov[*(qp)].iov_len \ + ? *(pp)+1 \ + : ((*(qp))++, 0)), \ + !0) \ + : 0) + +/* Uint32 EV_UINT32(ErlIOVec *ev, int p, int q)*/ +#define EV_UINT32(ev, p, q) \ + ((Uint32) *(((unsigned char *)(ev)->iov[(q)].iov_base) + (p))) + +/* int EV_GET_UINT32(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) */ +#define EV_GET_UINT32(ev, p, pp, qp) \ + (*(pp)+4 <= (ev)->iov[*(qp)].iov_len \ + ? (*(p) = (EV_UINT32(ev, *(pp), *(qp)) << 24) \ + | (EV_UINT32(ev, *(pp)+1, *(qp)) << 16) \ + | (EV_UINT32(ev, *(pp)+2, *(qp)) << 8) \ + | (EV_UINT32(ev, *(pp)+3, *(qp))), \ + *(pp) = ( *(pp)+4 < (ev)->iov[*(qp)].iov_len \ + ? *(pp)+4 \ + : ((*(qp))++, 0)), \ + !0) \ + : 0) + +/* Uint64 EV_UINT64(ErlIOVec *ev, int p, int q)*/ +#define EV_UINT64(ev, p, q) \ + ((Uint64) *(((unsigned char *)(ev)->iov[(q)].iov_base) + (p))) + +/* int EV_GET_UINT64(ErlIOVec *ev, Uint32 *p, int *pp, int *qp) */ +#define EV_GET_UINT64(ev, p, pp, qp) \ + (*(pp)+8 <= (ev)->iov[*(qp)].iov_len \ + ? (*(p) = (EV_UINT64(ev, *(pp), *(qp)) << 56) \ + | (EV_UINT64(ev, *(pp)+1, *(qp)) << 48) \ + | (EV_UINT64(ev, *(pp)+2, *(qp)) << 40) \ + | (EV_UINT64(ev, *(pp)+3, *(qp)) << 32) \ + | (EV_UINT64(ev, *(pp)+4, *(qp)) << 24) \ + | (EV_UINT64(ev, *(pp)+5, *(qp)) << 16) \ + | (EV_UINT64(ev, *(pp)+6, *(qp)) << 8) \ + | (EV_UINT64(ev, *(pp)+7, *(qp))), \ + *(pp) = ( *(pp)+8 < (ev)->iov[*(qp)].iov_len \ + ? *(pp)+8 \ + : ((*(qp))++, 0)), \ + !0) \ + : 0) + + + +#if 0 + +static void ev_clear(ErlIOVec *ev) { + ASSERT(ev); + ev->size = 0; + ev->vsize = 0; + ev->iov = NULL; + ev->binv = NULL; +} + +/* Assumes that ->iov and ->binv were allocated with sys_alloc(). + */ +static void ev_free(ErlIOVec *ev) { + if (! ev) { + return; + } + if (ev->vsize > 0) { + int i; + ASSERT(ev->iov); + ASSERT(ev->binv); + for (i = 0; i < ev->vsize; i++) { + if (ev->binv[i]) { + driver_free_binary(ev->binv[i]); + } + } + EF_FREE(ev->iov); + EF_FREE(ev->binv); + } +} + +/* Copy the contents from source to dest. + * Data in binaries is not copied, just the pointers; + * and refc is incremented. + */ +static ErlIOVec *ev_copy(ErlIOVec *dest, ErlIOVec *source) { + int *ip; + ASSERT(dest); + ASSERT(source); + if (source->vsize == 0) { + /* Empty source */ + ev_clear(dest); + return dest; + } + /* Allocate ->iov and ->binv */ + dest->iov = EF_ALLOC(sizeof(*dest->iov) * source->vsize); + if (! dest->iov) { + return NULL; + } + dest->binv = EF_ALLOC(sizeof(*dest->binv) * source->vsize); + if (! dest->binv) { + EF_FREE(dest->iov); + return NULL; + } + dest->size = source->size; + /* Copy one vector element at the time. + * Use *ip as an alias for dest->vsize to improve readabiliy. + * Keep dest consistent in every iteration by using + * dest->vsize==*ip as loop variable. + */ + for (ip = &dest->vsize, *ip = 0; *ip < source->vsize; (*ip)++) { + if (source->iov[*ip].iov_len == 0) { + /* Empty vector element */ + dest->iov[*ip].iov_len = 0; + dest->iov[*ip].iov_base = NULL; + dest->binv[*ip] = NULL; + } else { + /* Non empty vector element */ + if (source->binv[*ip]) { + /* Contents in binary - copy pointers and increment refc */ + dest->iov[*ip] = source->iov[*ip]; + dest->binv[*ip] = source->binv[*ip]; + driver_binary_inc_refc(source->binv[*ip]); + } else { + /* Contents not in binary - allocate new binary and copy data */ + if (! (dest->binv[*ip] = + driver_alloc_binary(source->iov[*ip].iov_len))) { + goto failed; + } + sys_memcpy(dest->binv[*ip]->orig_bytes, + source->iov[*ip].iov_base, + source->iov[*ip].iov_len); + dest->iov[*ip].iov_base = dest->binv[*ip]->orig_bytes; + dest->iov[*ip].iov_len = source->iov[*ip].iov_len; + } + } + } + return dest; + failed: + ev_free(dest); + return NULL; +} + +#endif + + + +/********************************************************************* + * Command queue functions + */ + +static void cq_enq(file_descriptor *desc, struct t_data *d) { + ASSERT(d); + if (desc->cq_head) { + ASSERT(desc->cq_tail); + ASSERT(!desc->cq_tail->next); + desc->cq_tail = desc->cq_tail->next = d; + } else { + ASSERT(desc->cq_tail == NULL); + desc->cq_head = desc->cq_tail = d; + } + d->next = NULL; +} + +static struct t_data *cq_deq(file_descriptor *desc) { + struct t_data *d = desc->cq_head; + ASSERT(d || (!d && !desc->cq_tail)); + if (d) { + ASSERT(!d->next || (d->next && desc->cq_tail != d)); + if ((desc->cq_head = d->next) == NULL) { + ASSERT(desc->cq_tail == d); + desc->cq_tail = NULL; + } + } + return d; +} + + + +/********************************************************************* + * Driver entry point -> init + */ +static int +file_init(void) +{ + char buf[21]; /* enough to hold any 64-bit integer */ + size_t bufsz = sizeof(buf); + thread_short_circuit = (erl_drv_getenv("ERL_EFILE_THREAD_SHORT_CIRCUIT", + buf, + &bufsz) == 0 + ? atoi(buf) + : 0); + driver_system_info(&sys_info, sizeof(ErlDrvSysInfo)); + return 0; +} + +/********************************************************************* + * Driver entry point -> start + */ +static ErlDrvData +file_start(ErlDrvPort port, char* command) + +{ + file_descriptor* desc; + + if ((desc = (file_descriptor*) EF_ALLOC(sizeof(file_descriptor))) + == NULL) { + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + desc->fd = FILE_FD_INVALID; + desc->port = port; + desc->key = (unsigned) (Uint) port; + desc->flags = 0; + desc->invoke = NULL; + desc->d = NULL; + desc->free = NULL; + desc->cq_head = NULL; + desc->cq_tail = NULL; + desc->timer_state = timer_idle; + desc->read_bufsize = 0; + desc->read_binp = NULL; + desc->read_offset = 0; + desc->read_size = 0; + desc->write_delay = 0L; + desc->write_bufsize = 0; + desc->write_error = 0; + MUTEX_INIT(desc->q_mtx, port); /* Refc is one, referenced by emulator now */ + desc->write_buffered = 0; + return (ErlDrvData) desc; +} + +static void free_data(void *data) +{ + EF_FREE(data); +} + +static void do_close(int flags, Sint fd) { + if (flags & EFILE_COMPRESSED) { + erts_gzclose((gzFile)(fd)); + } else { + efile_closefile((int) fd); + } +} + +static void invoke_close(void *data) +{ + struct t_data *d = (struct t_data *) data; + d->again = 0; + do_close(d->flags, d->fd); +} + +/********************************************************************* + * Driver entry point -> stop + */ +static void +file_stop(ErlDrvData e) +{ + file_descriptor* desc = (file_descriptor*)e; + + TRACE_C('p'); + + if (desc->fd != FILE_FD_INVALID) { + do_close(desc->flags, desc->fd); + desc->fd = FILE_FD_INVALID; + desc->flags = 0; + } + if (desc->read_binp) { + driver_free_binary(desc->read_binp); + } + EF_FREE(desc); +} + + +/* + * Sends back an error reply to Erlang. + */ + +static void reply_posix_error(file_descriptor *desc, int posix_errno) { + char response[256]; /* Response buffer. */ + char* s; + char* t; + + /* + * Contents of buffer sent back: + * + * +-----------------------------------------+ + * | FILE_RESP_ERROR | Posix error id string | + * +-----------------------------------------+ + */ + + TRACE_C('E'); + + response[0] = FILE_RESP_ERROR; + for (s = erl_errno_id(posix_errno), t = response+1; *s; s++, t++) + *t = tolower(*s); + driver_output2(desc->port, response, t-response, NULL, 0); +} + +static void reply_Uint_posix_error(file_descriptor *desc, Uint num, + int posix_errno) { + char response[256]; /* Response buffer. */ + char* s; + char* t; + + /* + * Contents of buffer sent back: + * + * +----------------------------------------------------------------------+ + * | FILE_RESP_NUMERR | 64-bit number (big-endian) | Posix error id string | + * +----------------------------------------------------------------------+ + */ + + TRACE_C('N'); + + response[0] = FILE_RESP_NUMERR; +#if SIZEOF_VOID_P == 4 + put_int32(0, response+1); +#else + put_int32(num>>32, response+1); +#endif + put_int32((Uint32)num, response+1+4); + for (s = erl_errno_id(posix_errno), t = response+1+4+4; *s; s++, t++) + *t = tolower(*s); + driver_output2(desc->port, response, t-response, NULL, 0); +} + + + +static int reply_error(file_descriptor *desc, + Efile_error *errInfo) /* The error codes. */ +{ + reply_posix_error(desc, errInfo->posix_errno); + return 0; +} + +static int reply_Uint_error(file_descriptor *desc, Uint num, + Efile_error *errInfo) /* The error codes. */ +{ + reply_Uint_posix_error(desc, num, errInfo->posix_errno); + return 0; +} + +static int reply_ok(file_descriptor *desc) { + char c = FILE_RESP_OK; + + driver_output2(desc->port, &c, 1, NULL, 0); + return 0; +} + +static int reply(file_descriptor *desc, int ok, Efile_error *errInfo) { + if (!ok) { + reply_error(desc, errInfo); + } else { + TRACE_C('K'); + reply_ok(desc); + } + return 0; +} + +static int reply_Uint(file_descriptor *desc, Uint result) { + char tmp[1+4+4]; + + /* + * Contents of buffer sent back: + * + * +-----------------------------------------------+ + * | FILE_RESP_NUMBER | 64-bit number (big-endian) | + * +-----------------------------------------------+ + */ + + TRACE_C('R'); + + tmp[0] = FILE_RESP_NUMBER; +#if SIZEOF_VOID_P == 4 + put_int32(0, tmp+1); +#else + put_int32(result>>32, tmp+1); +#endif + put_int32((Uint32)result, tmp+1+4); + driver_output2(desc->port, tmp, sizeof(tmp), NULL, 0); + return 0; +} + +static int reply_Sint64(file_descriptor *desc, Sint64 result) { + char tmp[1+4+4]; + + /* + * Contents of buffer sent back: + * + * +-----------------------------------------------+ + * | FILE_RESP_NUMBER | 64-bit number (big-endian) | + * +-----------------------------------------------+ + */ + + TRACE_C('R'); + + tmp[0] = FILE_RESP_NUMBER; + put_int64(result, tmp+1); + driver_output2(desc->port, tmp, sizeof(tmp), NULL, 0); + return 0; +} + +#if 0 +static void reply_again(file_descriptor *desc) { + char tmp[1]; + tmp[0] = FILE_RESP_AGAIN; + driver_output2(desc->port, tmp, sizeof(tmp), NULL, 0); +} +#endif + +static void reply_ev(file_descriptor *desc, char response, ErlIOVec *ev) { + char tmp[1]; + /* Data arriving at the Erlang process: + * [Response, Binary0, Binary1, .... | BinaryN-1] + */ + tmp[0] = response; + driver_outputv(desc->port, tmp, sizeof(tmp), ev, 0); +} + +static void reply_data(file_descriptor *desc, + ErlDrvBinary *binp, size_t offset, size_t len) { + char header[1+4+4]; + /* Data arriving at the Erlang process: + * [?FILE_RESP_DATA, 64-bit length (big-endian) | Data] + */ + header[0] = FILE_RESP_DATA; +#if SIZEOF_SIZE_T == 4 + put_int32(0, header+1); +#else + put_int32(len>>32, header+1); +#endif + put_int32((Uint32)len, header+1+4); + driver_output_binary(desc->port, header, sizeof(header), + binp, offset, len); +} + +static void reply_buf(file_descriptor *desc, char *buf, size_t len) { + char header[1+4+4]; + /* Data arriving at the Erlang process: + * [?FILE_RESP_DATA, 64-bit length (big-endian) | Data] + */ + header[0] = FILE_RESP_DATA; +#if SIZEOF_SIZE_T == 4 + put_int32(0, header+1); +#else + put_int32(len>>32, header+1); +#endif + put_int32((Uint32)len, header+1+4); + driver_output2(desc->port, header, sizeof(header), buf, len); +} + +static int reply_eof(file_descriptor *desc) { + char c = FILE_RESP_EOF; + + driver_output2(desc->port, &c, 1, NULL, 0); + return 0; +} + + + +static void invoke_name(void *data, int (*f)(Efile_error *, char *)) +{ + struct t_data *d = (struct t_data *) data; + char *name = (char *) d->b; + + d->again = 0; + d->result_ok = (*f)(&d->errInfo, name); +} + +static void invoke_mkdir(void *data) +{ + invoke_name(data, efile_mkdir); +} + +static void invoke_rmdir(void *data) +{ + invoke_name(data, efile_rmdir); +} + +static void invoke_delete_file(void *data) +{ + invoke_name(data, efile_delete_file); +} + +static void invoke_chdir(void *data) +{ + invoke_name(data, efile_chdir); +} + +static void invoke_fsync(void *data) +{ + struct t_data *d = (struct t_data *) data; + int fd = (int) d->fd; + + d->again = 0; + d->result_ok = efile_fsync(&d->errInfo, fd); +} + +static void invoke_truncate(void *data) +{ + struct t_data *d = (struct t_data *) data; + int fd = (int) d->fd; + + d->again = 0; + d->result_ok = efile_truncate_file(&d->errInfo, &fd, d->flags); +} + +static void invoke_read(void *data) +{ + struct t_data *d = (struct t_data *) data; + int status, segment; + size_t size, read_size; + + segment = d->again && d->c.read.bin_size >= 2*FILE_SEGMENT_READ; + if (segment) { + size = FILE_SEGMENT_READ; + } else { + size = d->c.read.bin_size; + } + read_size = size; + if (d->flags & EFILE_COMPRESSED) { + read_size = erts_gzread((gzFile)d->fd, + d->c.read.binp->orig_bytes + d->c.read.bin_offset, + size); + status = (read_size != -1); + if (!status) { + d->errInfo.posix_errno = EIO; + } + } else { + status = efile_read(&d->errInfo, d->flags, (int) d->fd, + d->c.read.binp->orig_bytes + d->c.read.bin_offset, + size, + &read_size); + } + if ( (d->result_ok = status)) { + ASSERT(read_size <= size); + d->c.read.bin_offset += read_size; + if (read_size < size || !segment) { + d->c.read.bin_size = 0; + d->again = 0; + } else { + d->c.read.bin_size -= read_size; + } + } else { + d->again = 0; + } +} + +static void free_read(void *data) +{ + struct t_data *d = (struct t_data *) data; + + driver_free_binary(d->c.read.binp); + EF_FREE(d); +} + +static void invoke_read_line(void *data) +{ + struct t_data *d = (struct t_data *) data; + int status; + size_t read_size; + int local_loop = (d->again == 0); + + do { + size_t size = (d->c.read_line.binp)->orig_size - + d->c.read_line.read_offset - d->c.read_line.read_size; + if (size == 0) { + /* Need more place */ + size_t need = (d->c.read_line.read_size >= DEFAULT_LINEBUF_SIZE) ? + d->c.read_line.read_size + DEFAULT_LINEBUF_SIZE : DEFAULT_LINEBUF_SIZE; + ErlDrvBinary *newbin = driver_alloc_binary(need); + if (newbin == NULL) { + d->result_ok = 0; + d->errInfo.posix_errno = ENOMEM; + d->again = 0; + break; + } + memcpy(newbin->orig_bytes, (d->c.read_line.binp)->orig_bytes + d->c.read_line.read_offset, + d->c.read_line.read_size); + driver_free_binary(d->c.read_line.binp); + d->c.read_line.binp = newbin; + d->c.read_line.read_offset = 0; + size = need - d->c.read_line.read_size; + } + if (d->flags & EFILE_COMPRESSED) { + read_size = erts_gzread((gzFile)d->fd, + d->c.read_line.binp->orig_bytes + + d->c.read_line.read_offset + d->c.read_line.read_size, + size); + status = (read_size != -1); + if (!status) { + d->errInfo.posix_errno = EIO; + } + } else { + status = efile_read(&d->errInfo, d->flags, (int) d->fd, + d->c.read_line.binp->orig_bytes + + d->c.read_line.read_offset + d->c.read_line.read_size, + size, + &read_size); + } + if ( (d->result_ok = status)) { + void *nl_ptr = memchr((d->c.read_line.binp)->orig_bytes + + d->c.read_line.read_offset + d->c.read_line.read_size,'\n',read_size); + ASSERT(read_size <= size); + d->c.read_line.read_size += read_size; + if (nl_ptr != NULL) { + /* If found, we're done */ + d->c.read_line.nl_pos = ((char *) nl_ptr) - + ((char *) ((d->c.read_line.binp)->orig_bytes)) + 1; + if (d->c.read_line.nl_pos > 1 && + *(((char *) nl_ptr) - 1) == '\r') { + --d->c.read_line.nl_pos; + *(((char *) nl_ptr) - 1) = '\n'; + d->c.read_line.nl_skip = 1; + } else { + d->c.read_line.nl_skip = 0; + } + d->again = 0; +#if !ALWAYS_READ_LINE_AHEAD + if (!(d->c.read_line.read_ahead)) { + /* Ouch! Undo buffering... */ + size_t too_much = d->c.read_line.read_size - d->c.read_line.nl_skip - + (d->c.read_line.nl_pos - d->c.read_line.read_offset); + d->c.read_line.read_size -= too_much; + ASSERT(d->c.read_line.read_size >= 0); + if (d->flags & EFILE_COMPRESSED) { + Sint64 location = erts_gzseek((gzFile)d->fd, + -((Sint64) too_much), EFILE_SEEK_CUR); + if (location == -1) { + d->result_ok = 0; + d->errInfo.posix_errno = errno; + } + } else { + Sint64 location; + d->result_ok = efile_seek(&d->errInfo, (int) d->fd, + -((Sint64) too_much), EFILE_SEEK_CUR, + &location); + } + } +#endif + break; + } else if (read_size == 0) { + d->c.read_line.nl_pos = + d->c.read_line.read_offset + d->c.read_line.read_size; + d->c.read_line.nl_skip = 0; + d->again = 0; + break; + } + } else { + d->again = 0; + break; + } + } while (local_loop); +} + +static void free_read_line(void *data) +{ + struct t_data *d = (struct t_data *) data; + + driver_free_binary(d->c.read_line.binp); + EF_FREE(d); +} + +static void invoke_read_file(void *data) +{ + struct t_data *d = (struct t_data *) data; + size_t read_size; + int chop; + + if (! d->c.read_file.binp) { /* First invocation only */ + int fd; + Sint64 size; + + if (! (d->result_ok = + efile_openfile(&d->errInfo, d->c.read_file.name, + EFILE_MODE_READ, &fd, &size))) { + goto done; + } + d->fd = fd; + d->c.read_file.size = (int) size; + if (size < 0 || size != d->c.read_file.size || + ! (d->c.read_file.binp = + driver_alloc_binary(d->c.read_file.size))) { + d->result_ok = 0; + d->errInfo.posix_errno = ENOMEM; + goto close; + } + d->c.read_file.offset = 0; + } + /* Invariant: d->c.read_file.size >= d->c.read_file.offset */ + + read_size = (size_t) (d->c.read_file.size - d->c.read_file.offset); + if (! read_size) goto close; + chop = d->again && read_size >= FILE_SEGMENT_READ*2; + if (chop) read_size = FILE_SEGMENT_READ; + d->result_ok = + efile_read(&d->errInfo, + EFILE_MODE_READ, + (int) d->fd, + d->c.read_file.binp->orig_bytes + d->c.read_file.offset, + read_size, + &read_size); + if (d->result_ok) { + d->c.read_file.offset += read_size; + if (chop) return; /* again */ + } + close: + efile_closefile((int) d->fd); + done: + d->again = 0; +} + +static void free_read_file(void *data) +{ + struct t_data *d = (struct t_data *) data; + + if (d->c.read_file.binp) driver_free_binary(d->c.read_file.binp); + EF_FREE(d); +} + + + +static void invoke_preadv(void *data) +{ + struct t_data *d = (struct t_data *) data; + struct t_preadv *c = &d->c.preadv; + ErlIOVec *ev = &c->eiov; + size_t bytes_read_so_far = 0; + unsigned char *p = (unsigned char *)ev->iov[0].iov_base + 4+4+8*c->cnt; + + while (c->cnt < c->n) { + size_t read_size = ev->iov[1 + c->cnt].iov_len - c->size; + size_t bytes_read = 0; + int chop = d->again + && bytes_read_so_far + read_size >= 2*FILE_SEGMENT_READ; + if (chop) { + ASSERT(bytes_read_so_far < FILE_SEGMENT_READ); + read_size = FILE_SEGMENT_READ + FILE_SEGMENT_READ/2 + - bytes_read_so_far; + } + if ( (d->result_ok + = efile_pread(&d->errInfo, + (int) d->fd, + c->offsets[c->cnt] + c->size, + ev->iov[1 + c->cnt].iov_base + c->size, + read_size, + &bytes_read))) { + bytes_read_so_far += bytes_read; + if (chop && bytes_read == read_size) { + c->size += bytes_read; + return; + } + ASSERT(bytes_read <= read_size); + ev->iov[1 + c->cnt].iov_len = bytes_read + c->size; + ev->size += bytes_read + c->size; + put_int64(bytes_read + c->size, p); p += 8; + c->size = 0; + c->cnt++; + if (d->again + && bytes_read_so_far >= FILE_SEGMENT_READ + && c->cnt < c->n) { + return; + } + } else { + /* In case of a read error, ev->size will not be correct, + * which does not matter since no read data is returned + * to Erlang. + */ + break; + } + } + d->again = 0; +} + +static void free_preadv(void *data) { + struct t_data *d = data; + int i; + ErlIOVec *ev = &d->c.preadv.eiov; + + for(i = 0; i < ev->vsize; i++) { + driver_free_binary(ev->binv[i]); + } + EF_FREE(d); +} + +static void invoke_ipread(void *data) +{ + struct t_data *d = data; + struct t_preadv *c = &d->c.preadv; + ErlIOVec *ev = &c->eiov; + size_t bytes_read = 0; + char buf[2*sizeof(Uint32)]; + Uint32 offset, size; + + /* Read indirection header */ + if (! efile_pread(&d->errInfo, (int) d->fd, c->offsets[0], + buf, sizeof(buf), &bytes_read)) { + goto error; + } + if (bytes_read != sizeof(buf)) goto done; /* eof */ + size = get_int32(buf); + offset = get_int32(buf+4); + if (size > c->size) goto done; /* eof */ + c->n = 1; + c->cnt = 0; + c->size = 0; + c->offsets[0] = offset; + if (! (ev->binv[0] = driver_alloc_binary(3*8))) { + d->errInfo.posix_errno = ENOMEM; + goto error; + } + ev->vsize = 1; + ev->iov[0].iov_len = 3*8; + ev->iov[0].iov_base = ev->binv[0]->orig_bytes; + ev->size = ev->iov[0].iov_len; + put_int64(offset, ev->iov[0].iov_base); + put_int64(size, ((char *)ev->iov[0].iov_base) + 2*8); + if (size == 0) { + put_int64(size, ((char *)ev->iov[0].iov_base) + 8); + goto done; + } + if (! (ev->binv[1] = driver_alloc_binary(size))) { + d->errInfo.posix_errno = ENOMEM; + goto error; + } + ev->vsize = 2; + ev->iov[1].iov_len = size; + ev->iov[1].iov_base = ev->binv[1]->orig_bytes; + /* Read data block */ + d->invoke = invoke_preadv; + invoke_preadv(data); + return; + error: + d->result_ok = 0; + d->again = 0; + return; + done: + d->result_ok = !0; + d->again = 0; +} + +/* invoke_writev and invoke_pwritev are the only thread functions that + * access non-thread data i.e the port queue and a mutex in the port + * structure that is used to lock the port queue. + * + * The port will normally not be terminated until the port queue is + * empty, but if the port is killed, i.e., exit(Port, kill) is called, + * it will terminate regardless of the port queue state. When the + * port is invalid driver_peekq() returns NULL and set the size to -1, + * and driver_sizeq() returns -1. + */ + +static void invoke_writev(void *data) { + struct t_data *d = (struct t_data *) data; + SysIOVec *iov0; + SysIOVec *iov; + int iovlen; + int iovcnt; + size_t size; + size_t p; + int segment; + + segment = d->again && d->c.writev.size >= 2*FILE_SEGMENT_WRITE; + if (segment) { + size = FILE_SEGMENT_WRITE; + } else { + size = d->c.writev.size; + } + + /* Copy the io vector to avoid locking the port que while writing */ + MUTEX_LOCK(d->c.writev.q_mtx); /* Lock before accessing the port queue */ + iov0 = driver_peekq(d->c.writev.port, &iovlen); + + /* Calculate iovcnt */ + for (p = 0, iovcnt = 0; + p < size && iovcnt < iovlen; + p += iov0[iovcnt++].iov_len) + ; + iov = EF_ALLOC(sizeof(SysIOVec)*iovcnt); + memcpy(iov,iov0,iovcnt*sizeof(SysIOVec)); + MUTEX_UNLOCK(d->c.writev.q_mtx); + /* Let go of lock until we deque from original vector */ + + if (iovlen > 0) { + ASSERT(iov[iovcnt-1].iov_len > p - size); + iov[iovcnt-1].iov_len -= p - size; + if (d->flags & EFILE_COMPRESSED) { + int i, status = 1; + for (i = 0; i < iovcnt; i++) { + if (iov[i].iov_base && iov[i].iov_len > 0) { + /* Just in case, I do not know what gzwrite does + * with errno. + */ + errno = EINVAL; + if (! (status = + erts_gzwrite((gzFile)d->fd, + iov[i].iov_base, + iov[i].iov_len)) == iov[i].iov_len) { + d->errInfo.posix_errno = + d->errInfo.os_errno = errno; /* XXX Correct? */ + break; + } + } + } + d->result_ok = status; + } else { + d->result_ok = efile_writev(&d->errInfo, + d->flags, (int) d->fd, + iov, iovcnt, size); + } + } else if (iovlen == 0) { + d->result_ok = 1; + } + else { /* Port has terminated */ + d->result_ok = 0; + d->errInfo.posix_errno = d->errInfo.os_errno = EINVAL; + } + EF_FREE(iov); + + d->c.writev.free_size = size; + d->c.writev.size -= size; + if (! d->result_ok) { + d->again = 0; + } else { + if (! segment) { + d->again = 0; + } + TRACE_F(("w%lu", (unsigned long)size)); + + } +} + +static void free_writev(void *data) { + struct t_data *d = data; + MUTEX_LOCK(d->c.writev.q_mtx); + driver_deq(d->c.writev.port, d->c.writev.size + d->c.writev.free_size); + MUTEX_UNLOCK(d->c.writev.q_mtx); + EF_FREE(d); +} + +static void invoke_pwd(void *data) +{ + struct t_data *d = (struct t_data *) data; + + d->again = 0; + d->result_ok = efile_getdcwd(&d->errInfo,d->drive, d->b+1, + RESBUFSIZE-1); +} + +static void invoke_readlink(void *data) +{ + struct t_data *d = (struct t_data *) data; + char resbuf[RESBUFSIZE]; /* Result buffer. */ + + d->again = 0; + d->result_ok = efile_readlink(&d->errInfo, d->b, resbuf+1, + RESBUFSIZE-1); + if (d->result_ok != 0) + strcpy((char *) d->b + 1, resbuf+1); +} + +static void invoke_altname(void *data) +{ + struct t_data *d = (struct t_data *) data; + char resbuf[RESBUFSIZE]; /* Result buffer. */ + + d->again = 0; + d->result_ok = efile_altname(&d->errInfo, d->b, resbuf+1, + RESBUFSIZE-1); + if (d->result_ok != 0) + strcpy((char *) d->b + 1, resbuf+1); +} + +static void invoke_pwritev(void *data) { + struct t_data *d = (struct t_data *) data; + SysIOVec *iov0; + SysIOVec *iov; + int iovlen; + int iovcnt; + struct t_pwritev *c = &d->c.pwritev; + size_t p; + int segment; + size_t size, write_size; + + segment = d->again && c->size >= 2*FILE_SEGMENT_WRITE; + if (segment) { + size = FILE_SEGMENT_WRITE; + } else { + size = c->size; + } + d->result_ok = !0; + p = 0; + /* Lock the queue just for a while, we don't want it locked during write */ + MUTEX_LOCK(c->q_mtx); + iov0 = driver_peekq(c->port, &iovlen); + iov = EF_ALLOC(sizeof(SysIOVec)*iovlen); + memcpy(iov,iov0,sizeof(SysIOVec)*iovlen); + MUTEX_UNLOCK(c->q_mtx); + + if (iovlen < 0) + goto error; /* Port terminated */ + for (iovcnt = 0, c->free_size = 0; + c->cnt < c->n && iovcnt < iovlen && c->free_size < size; + c->cnt++) { + int chop; + write_size = c->specs[c->cnt].size; + if (iov[iovcnt].iov_len - p < write_size) { + /* Mismatch between pos/size spec and what is queued */ + d->errInfo.posix_errno = EINVAL; + d->result_ok = 0; + d->again = 0; + goto done; + } + chop = segment && c->free_size + write_size >= 2*FILE_SEGMENT_WRITE; + if (chop) { + ASSERT(c->free_size < FILE_SEGMENT_WRITE); + write_size = FILE_SEGMENT_WRITE + FILE_SEGMENT_WRITE/2 + - c->free_size; + } + d->result_ok = efile_pwrite(&d->errInfo, (int) d->fd, + iov[iovcnt].iov_base + p, + write_size, + c->specs[c->cnt].offset); + if (! d->result_ok) { + d->again = 0; + goto done; + } + c->free_size += write_size; + c->size -= write_size; + if (chop) { + c->specs[c->cnt].offset += write_size; + c->specs[c->cnt].size -= write_size; + /* Schedule out (d->again != 0) */ + goto done; + } + /* Move forward in buffer */ + p += write_size; + ASSERT(iov[iovcnt].iov_len >= p); + if (iov[iovcnt].iov_len == p) { + /* Move to next iov[], we trust that it is not a + * zero length vector, and thereby depend on that + * such are not queued. + */ + iovcnt++; p = 0; + } + } + if (! segment) { + if (c->cnt != c->n) { + /* Mismatch between number of + * pos/size specs vs number of queued buffers . + */ + error: + d->errInfo.posix_errno = EINVAL; + d->result_ok = 0; + d->again = 0; + } else { + ASSERT(c->free_size == size); + d->again = 0; + } + } + done: + EF_FREE(iov); /* Free our copy of the vector, nothing to restore */ +} + +static void free_pwritev(void *data) { + struct t_data *d = data; + + MUTEX_LOCK(d->c.writev.q_mtx); + driver_deq(d->c.pwritev.port, d->c.pwritev.free_size + d->c.pwritev.size); + MUTEX_UNLOCK(d->c.writev.q_mtx); + EF_FREE(d); +} + +static void invoke_flstat(void *data) +{ + struct t_data *d = (struct t_data *) data; + + d->again = 0; + d->result_ok = efile_fileinfo(&d->errInfo, &d->info, + d->b, d->command == FILE_LSTAT); +} + +static void invoke_link(void *data) +{ + struct t_data *d = (struct t_data *) data; + char *name = d->b; + char *new_name; + + d->again = 0; + new_name = name+strlen(name)+1; + d->result_ok = efile_link(&d->errInfo, name, new_name); +} + +static void invoke_symlink(void *data) +{ + struct t_data *d = (struct t_data *) data; + char *name = d->b; + char *new_name; + + d->again = 0; + new_name = name+strlen(name)+1; + d->result_ok = efile_symlink(&d->errInfo, name, new_name); +} + +static void invoke_rename(void *data) +{ + struct t_data *d = (struct t_data *) data; + char *name = d->b; + char *new_name; + + d->again = 0; + new_name = name+strlen(name)+1; + d->result_ok = efile_rename(&d->errInfo, name, new_name); +} + +static void invoke_write_info(void *data) +{ + struct t_data *d = (struct t_data *) data; + + d->again = 0; + d->result_ok = efile_write_info(&d->errInfo, &d->info, d->b); +} + +static void invoke_lseek(void *data) +{ + struct t_data *d = (struct t_data *) data; + int status; + + d->again = 0; + if (d->flags & EFILE_COMPRESSED) { + int offset = (int) d->c.lseek.offset; + + if (offset != d->c.lseek.offset) { + d->errInfo.posix_errno = EINVAL; + status = 0; + } else { + d->c.lseek.location = erts_gzseek((gzFile)d->fd, + offset, d->c.lseek.origin); + if (d->c.lseek.location == -1) { + d->errInfo.posix_errno = errno; + status = 0; + } else { + status = 1; + } + } + } else { + status = efile_seek(&d->errInfo, (int) d->fd, + d->c.lseek.offset, d->c.lseek.origin, + &d->c.lseek.location); + } + d->result_ok = status; +} + +static void invoke_readdir(void *data) +{ + struct t_data *d = (struct t_data *) data; + int s; + char *p = NULL; + int buf_sz = 0; + + d->again = 0; + d->errInfo.posix_errno = 0; + + while (1) { + char *str; + if (buf_sz < (4 /* sz */ + 1 /* cmd */ + MAXPATHLEN + 1 /* '\0' */)) { + struct t_readdir_buf *b; + if (p) { + put_int32(0, p); /* EOB */ + } + b = EF_SAFE_ALLOC(sizeof(struct t_readdir_buf)); + b->next = NULL; + if (d->c.read_dir.last_buf) + d->c.read_dir.last_buf->next = b; + else + d->c.read_dir.first_buf = b; + d->c.read_dir.last_buf = b; + p = &b->buf[0]; + buf_sz = READDIR_BUFSIZE - 4/* EOB */; + } + + p[4] = FILE_RESP_OK; + buf_sz -= 4 + 1; + str = p + 4 + 1; + ASSERT(buf_sz >= MAXPATHLEN + 1); + s = efile_readdir(&d->errInfo, d->b, &d->dir_handle, str, buf_sz); + + if (s) { + int str_sz = strlen(str); + int sz = str_sz + 1; + put_int32(sz, p); + p += 4 + sz; + buf_sz -= str_sz; + } + else { + put_int32(1, p); + p += 4 + 1; + put_int32(0, p); /* EOB */ + d->result_ok = (d->errInfo.posix_errno == 0); + break; + } + } +} + +static void invoke_open(void *data) +{ + struct t_data *d = (struct t_data *) data; + + int status = 1; /* Status of open call. */ + + d->again = 0; + if ((d->flags & EFILE_COMPRESSED) == 0) { + int fd; + status = efile_openfile(&d->errInfo, d->b, d->flags, &fd, NULL); + d->fd = fd; + } else { + char* mode = NULL; + + if (((d->flags & (EFILE_MODE_READ_WRITE)) == EFILE_MODE_READ_WRITE) || + (d->flags & EFILE_MODE_APPEND)) { + status = 0; + d->errInfo.posix_errno = EINVAL; + } else { + status = efile_may_openfile(&d->errInfo, d->b); + if (status || (d->errInfo.posix_errno != EISDIR)) { + mode = (d->flags & EFILE_MODE_READ) ? "rb" : "wb"; + d->fd = (Sint) erts_gzopen(d->b, mode); + if ((gzFile)d->fd) { + status = 1; + } else { + if (errno == 0) { + errno = ENOMEM; + } + d->errInfo.posix_errno = errno; + status = 0; + } + } + } + } + + d->result_ok = status; +} + +static void free_readdir(void *data) +{ + struct t_data *d = (struct t_data *) data; + struct t_readdir_buf *b1 = d->c.read_dir.first_buf; + while (b1) { + struct t_readdir_buf *b2 = b1; + b1 = b1->next; + EF_FREE(b2); + } + EF_FREE(d); +} + + + +static void try_free_read_bin(file_descriptor *desc) { + if ((desc->read_size == 0) + && (desc->read_offset >= desc->read_binp->orig_size)) { + ASSERT(desc->read_offset == desc->read_binp->orig_size); + driver_free_binary(desc->read_binp); + desc->read_binp = NULL; + desc->read_offset = 0; + desc->read_size = 0; + } +} + + + +static int try_again(file_descriptor *desc, struct t_data *d) { + if (! d->again) { + return 0; + } + switch (d->command) { + case FILE_WRITE: + MUTEX_LOCK(d->c.writev.q_mtx); + driver_deq(d->c.writev.port, d->c.writev.free_size); + MUTEX_UNLOCK(d->c.writev.q_mtx); + break; + case FILE_PWRITEV: + MUTEX_LOCK(d->c.writev.q_mtx); + driver_deq(d->c.pwritev.port, d->c.pwritev.free_size); + MUTEX_UNLOCK(d->c.writev.q_mtx); + break; + } + if (desc->timer_state != timer_idle) { + driver_cancel_timer(desc->port); + } + desc->timer_state = timer_again; + desc->invoke = d->invoke; + desc->d = d; + desc->free = d->free; + driver_set_timer(desc->port, 0L); + return !0; +} + + + +static void cq_execute(file_descriptor *desc) { + struct t_data *d; + register void *void_ptr; /* Soft cast variable */ + if (desc->timer_state == timer_again) + return; + if (! (d = cq_deq(desc))) + return; + TRACE_F(("x%i", (int) d->command)); + d->again = sys_info.async_threads == 0; + DRIVER_ASYNC(d->level, desc, d->invoke, void_ptr=d, d->free); +} + +static int async_write(file_descriptor *desc, int *errp, + int reply, Uint32 reply_size) { + struct t_data *d; + if (! (d = EF_ALLOC(sizeof(struct t_data) - 1))) { + if (errp) *errp = ENOMEM; + return -1; + } + TRACE_F(("w%lu", (unsigned long)desc->write_buffered)); + d->command = FILE_WRITE; + d->fd = desc->fd; + d->flags = desc->flags; + d->c.writev.port = desc->port; + d->c.writev.q_mtx = desc->q_mtx; + d->c.writev.size = desc->write_buffered; + d->reply = reply; + d->c.writev.free_size = 0; + d->c.writev.reply_size = reply_size; + d->invoke = invoke_writev; + d->free = free_writev; + d->level = 1; + cq_enq(desc, d); + desc->write_buffered = 0; + return 0; +} + +static int flush_write(file_descriptor *desc, int *errp) { + int result; + MUTEX_LOCK(desc->q_mtx); + if (desc->write_buffered > 0) { + result = async_write(desc, errp, 0, 0); + } else { + result = 0; + } + MUTEX_UNLOCK(desc->q_mtx); + return result; +} + +static int check_write_error(file_descriptor *desc, int *errp) { + if (desc->write_error) { + if (errp) *errp = desc->write_errInfo.posix_errno; + desc->write_error = 0; + return -1; + } + return 0; +} + +static int flush_write_check_error(file_descriptor *desc, int *errp) { + int r; + if ( (r = flush_write(desc, errp)) != 0) { + check_write_error(desc, NULL); + return r; + } else { + return check_write_error(desc, errp); + } +} + +static int async_lseek(file_descriptor *desc, int *errp, int reply, + Sint64 offset, int origin) { + struct t_data *d; + if (! (d = EF_ALLOC(sizeof(struct t_data)))) { + *errp = ENOMEM; + return -1; + } + d->flags = desc->flags; + d->fd = desc->fd; + d->command = FILE_LSEEK; + d->reply = reply; + d->c.lseek.offset = offset; + d->c.lseek.origin = origin; + d->invoke = invoke_lseek; + d->free = free_data; + d->level = 1; + cq_enq(desc, d); + return 0; +} + +static void flush_read(file_descriptor *desc) { + desc->read_offset = 0; + desc->read_size = 0; + if (desc->read_binp) { + driver_free_binary(desc->read_binp); + desc->read_binp = NULL; + } +} + +static int lseek_flush_read(file_descriptor *desc, int *errp) { + int r = 0; + size_t read_size = desc->read_size; + if (read_size != 0) { + flush_read(desc); + if ((r = async_lseek(desc, errp, 0, + -((ssize_t)read_size), EFILE_SEEK_CUR)) + < 0) { + return r; + } + } else { + flush_read(desc); + } + return r; +} + + + +/********************************************************************* + * Driver entry point -> ready_async + */ +static void +file_async_ready(ErlDrvData e, ErlDrvThreadData data) +{ + file_descriptor *desc = (file_descriptor*)e; + struct t_data *d = (struct t_data *) data; + char header[5]; /* result code + count */ + char resbuf[RESBUFSIZE]; /* Result buffer. */ + + + TRACE_C('r'); + + if (try_again(desc, d)) { + return; + } + + switch (d->command) + { + case FILE_READ: + if (!d->result_ok) { + reply_error(desc, &d->errInfo); + } else { + size_t available_bytes = + d->c.read.bin_offset + d->c.read.bin_size - desc->read_offset; + if (available_bytes < d->c.read.size) { + d->c.read.size = available_bytes; + } + TRACE_C('D'); + reply_data(desc, d->c.read.binp, + desc->read_offset, d->c.read.size); + desc->read_offset += d->c.read.size; + desc->read_size = + d->c.read.bin_offset + d->c.read.bin_size - desc->read_offset; + try_free_read_bin(desc); + } + free_read(data); + break; + case FILE_READ_LINE: + /* The read_line stucture differs from the read structure. + The data->read_offset and d->c.read_line.read_offset are copies, as are + data->read_size and d->c.read_line.read_size + The read_line function does not kniow in advance how large the binary has to be, + why new allocation (but not reallocation of the old binary, for obvious reasons) + may happen in the worker thread. */ + if (!d->result_ok) { + reply_error(desc, &d->errInfo); + } else { + size_t len = d->c.read_line.nl_pos - d->c.read_line.read_offset; + TRACE_C('L'); + reply_data(desc, d->c.read_line.binp, + d->c.read_line.read_offset, len); + desc->read_offset = d->c.read_line.read_offset + d->c.read_line.nl_skip + len; + desc->read_size = + d->c.read_line.read_size - d->c.read_line.nl_skip - len; + if (desc->read_binp != d->c.read_line.binp) { /* New binary allocated */ + driver_free_binary(desc->read_binp); + desc->read_binp = d->c.read_line.binp; + driver_binary_inc_refc(desc->read_binp); + } +#if !ALWAYS_READ_LINE_AHEAD + ASSERT(desc->read_bufsize > 0 || desc->read_size == 0); + if (desc->read_bufsize == 0) { + desc->read_offset = desc->read_binp->orig_size; /* triggers cleanup */ + } +#endif + try_free_read_bin(desc); + } + free_read_line(data); + break; + case FILE_READ_FILE: + if (!d->result_ok) + reply_error(desc, &d->errInfo); + else { + header[0] = FILE_RESP_OK; + TRACE_C('R'); + driver_output_binary(desc->port, header, 1, + d->c.read_file.binp, + 0, d->c.read_file.offset); + } + free_read_file(data); + break; + case FILE_WRITE: + if (d->reply) { + if (! d->result_ok) { + reply_error(desc, &d->errInfo); + } else { + reply_Uint(desc, d->c.writev.reply_size); + } + } else { + if (! d->result_ok) { + desc->write_error = !0; + desc->write_errInfo = d->errInfo; + } + } + free_writev(data); + break; + case FILE_LSEEK: + if (d->reply) { + if (d->result_ok) + reply_Sint64(desc, d->c.lseek.location); + else + reply_error(desc, &d->errInfo); + } + free_data(data); + break; + case FILE_MKDIR: + case FILE_RMDIR: + case FILE_CHDIR: + case FILE_DELETE: + case FILE_FSYNC: + case FILE_TRUNCATE: + case FILE_LINK: + case FILE_SYMLINK: + case FILE_RENAME: + case FILE_WRITE_INFO: + reply(desc, d->result_ok, &d->errInfo); + free_data(data); + break; + case FILE_ALTNAME: + case FILE_PWD: + case FILE_READLINK: + { + int length; + char *resbuf = d->b; + + if (!d->result_ok) + reply_error(desc, &d->errInfo); + else { + resbuf[0] = FILE_RESP_OK; + length = 1+strlen((char*) resbuf+1); + TRACE_C('R'); + driver_output2(desc->port, resbuf, length, NULL, 0); + } + free_data(data); + break; + } + case FILE_OPEN: + if (!d->result_ok) { + reply_error(desc, &d->errInfo); + } else { + desc->fd = d->fd; + desc->flags = d->flags; + reply_Uint(desc, d->fd); + } + free_data(data); + break; + case FILE_FSTAT: + case FILE_LSTAT: + { + if (d->result_ok) { + resbuf[0] = FILE_RESP_INFO; + + put_int32(d->info.size_high, &resbuf[1 + (0 * 4)]); + put_int32(d->info.size_low, &resbuf[1 + (1 * 4)]); + put_int32(d->info.type, &resbuf[1 + (2 * 4)]); + + PUT_TIME(d->info.accessTime, resbuf + 1 + 3*4); + PUT_TIME(d->info.modifyTime, resbuf + 1 + 9*4); + PUT_TIME(d->info.cTime, resbuf + 1 + 15*4); + + put_int32(d->info.mode, &resbuf[1 + (21 * 4)]); + put_int32(d->info.links, &resbuf[1 + (22 * 4)]); + put_int32(d->info.major_device, &resbuf[1 + (23 * 4)]); + put_int32(d->info.minor_device, &resbuf[1 + (24 * 4)]); + put_int32(d->info.inode, &resbuf[1 + (25 * 4)]); + put_int32(d->info.uid, &resbuf[1 + (26 * 4)]); + put_int32(d->info.gid, &resbuf[1 + (27 * 4)]); + put_int32(d->info.access, &resbuf[1 + (28 * 4)]); + +#define RESULT_SIZE (1 + (29 * 4)) + TRACE_C('R'); + driver_output2(desc->port, resbuf, RESULT_SIZE, NULL, 0); +#undef RESULT_SIZE + } else + reply_error(desc, &d->errInfo); + } + free_data(data); + break; + case FILE_READDIR: + if (!d->result_ok) + reply_error(desc, &d->errInfo); + else { + struct t_readdir_buf *b1 = d->c.read_dir.first_buf; + TRACE_C('R'); + ASSERT(b1); + while (b1) { + struct t_readdir_buf *b2 = b1; + char *p = &b1->buf[0]; + int sz = get_int32(p); + while (sz) { /* 0 == EOB */ + p += 4; + driver_output2(desc->port, p, sz, NULL, 0); + p += sz; + sz = get_int32(p); + } + b1 = b1->next; + EF_FREE(b2); + } + d->c.read_dir.first_buf = NULL; + d->c.read_dir.last_buf = NULL; + } + free_readdir(data); + break; + /* See file_stop */ + case FILE_CLOSE: + if (d->reply) { + TRACE_C('K'); + reply_ok(desc); + } + free_data(data); + break; + case FILE_PWRITEV: + if (!d->result_ok) { + reply_Uint_error(desc, d->c.pwritev.cnt, &d->errInfo); + } else { + reply_Uint(desc, d->c.pwritev.n); + } + free_pwritev(data); + break; + case FILE_PREADV: + if (!d->result_ok) { + reply_error(desc, &d->errInfo); + } else { + reply_ev(desc, FILE_RESP_LDATA, &d->c.preadv.eiov); + } + free_preadv(data); + break; + case FILE_IPREAD: + if (!d->result_ok) { + reply_error(desc, &d->errInfo); + } else if (!d->c.preadv.eiov.vsize) { + reply_eof(desc); + } else { + reply_ev(desc, FILE_RESP_N2DATA, &d->c.preadv.eiov); + } + free_preadv(data); + break; + default: + abort(); + } + if (desc->write_buffered != 0 && desc->timer_state == timer_idle) { + desc->timer_state = timer_write; + driver_set_timer(desc->port, desc->write_delay); + } + cq_execute(desc); +} + +/********************************************************************* + * Driver entry point -> output + */ +static void +file_output(ErlDrvData e, char* buf, int count) +{ + file_descriptor* desc = (file_descriptor*)e; + Efile_error errInfo; /* The error codes for the last operation. */ + Sint fd; /* The file descriptor for this port, if any, + * -1 if none. + */ + char* name; /* Points to the filename in buf. */ + int command; + struct t_data *d = NULL; + + + TRACE_C('o'); + + fd = desc->fd; + name = buf+1; + command = *(uchar*)buf++; + + switch(command) { + + case FILE_MKDIR: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + strlen(name) + 1); + + strcpy(d->b, name); + d->command = command; + d->invoke = invoke_mkdir; + d->free = free_data; + d->level = 2; + goto done; + } + case FILE_RMDIR: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + strlen(name) + 1); + + strcpy(d->b, name); + d->command = command; + d->invoke = invoke_rmdir; + d->free = free_data; + d->level = 2; + goto done; + } + case FILE_DELETE: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + strlen(name) + 1); + + strcpy(d->b, name); + d->command = command; + d->invoke = invoke_delete_file; + d->free = free_data; + d->level = 2; + goto done; + } + case FILE_RENAME: + { + char* new_name; + + new_name = name+strlen(name)+1; + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + + strlen(name) + 1 + + strlen(new_name) + 1); + + strcpy(d->b, name); + strcpy(d->b + strlen(name) + 1, new_name); + d->flags = desc->flags; + d->fd = fd; + d->command = command; + d->invoke = invoke_rename; + d->free = free_data; + d->level = 2; + goto done; + } + case FILE_CHDIR: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + strlen(name) + 1); + + strcpy(d->b, name); + d->command = command; + d->invoke = invoke_chdir; + d->free = free_data; + d->level = 2; + goto done; + } + case FILE_PWD: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + RESBUFSIZE + 1); + + d->drive = *(uchar*)buf; + d->command = command; + d->invoke = invoke_pwd; + d->free = free_data; + d->level = 2; + goto done; + } + + case FILE_READDIR: +#ifdef USE_THREADS + if (sys_info.async_threads > 0) + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + strlen(name) + 1); + + strcpy(d->b, name); + d->dir_handle = NULL; + d->command = command; + d->invoke = invoke_readdir; + d->free = free_readdir; + d->level = 2; + d->c.read_dir.first_buf = NULL; + d->c.read_dir.last_buf = NULL; + goto done; + } + else +#endif + { + char resbuf[RESBUFSIZE+1]; + EFILE_DIR_HANDLE dir_handle; /* Handle to open directory. */ + + errInfo.posix_errno = 0; + dir_handle = NULL; + resbuf[0] = FILE_RESP_OK; + + while (efile_readdir(&errInfo, name, &dir_handle, + resbuf+1, RESBUFSIZE)) { + int length = 1 + strlen(resbuf+1); + driver_output2(desc->port, resbuf, length, NULL, 0); + } + if (errInfo.posix_errno != 0) { + reply_error(desc, &errInfo); + return; + } + TRACE_C('R'); + driver_output2(desc->port, resbuf, 1, NULL, 0); + return; + } + case FILE_OPEN: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + strlen(buf+4) + 1); + + d->flags = get_int32((uchar*)buf); + name = buf+4; + strcpy(d->b, name); + d->command = command; + d->invoke = invoke_open; + d->free = free_data; + d->level = 2; + goto done; + } + + case FILE_FSYNC: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data)); + + d->fd = fd; + d->command = command; + d->invoke = invoke_fsync; + d->free = free_data; + d->level = 2; + goto done; + } + + + case FILE_FSTAT: + case FILE_LSTAT: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + strlen(name) + 1); + + strcpy(d->b, name); + d->fd = fd; + d->command = command; + d->invoke = invoke_flstat; + d->free = free_data; + d->level = 2; + goto done; + } + + case FILE_TRUNCATE: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data)); + + d->flags = desc->flags; + d->fd = fd; + d->command = command; + d->invoke = invoke_truncate; + d->free = free_data; + d->level = 2; + goto done; + } + + case FILE_WRITE_INFO: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + + strlen(buf+21*4) + 1); + + d->info.mode = get_int32(buf + 0 * 4); + d->info.uid = get_int32(buf + 1 * 4); + d->info.gid = get_int32(buf + 2 * 4); + GET_TIME(d->info.accessTime, buf + 3 * 4); + GET_TIME(d->info.modifyTime, buf + 9 * 4); + GET_TIME(d->info.cTime, buf + 15 * 4); + strcpy(d->b, buf+21*4); + d->command = command; + d->invoke = invoke_write_info; + d->free = free_data; + d->level = 2; + goto done; + } + + case FILE_READLINK: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + RESBUFSIZE + 1); + + strcpy(d->b, name); + d->command = command; + d->invoke = invoke_readlink; + d->free = free_data; + d->level = 2; + goto done; + } + + case FILE_ALTNAME: + { + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + RESBUFSIZE + 1); + strcpy(d->b, name); + d->command = command; + d->invoke = invoke_altname; + d->free = free_data; + d->level = 2; + goto done; + } + + + case FILE_LINK: + { + char* new_name; + + new_name = name+strlen(name)+1; + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + + strlen(name) + 1 + + strlen(new_name) + 1); + + strcpy(d->b, name); + strcpy(d->b + strlen(name) + 1, new_name); + d->flags = desc->flags; + d->fd = fd; + d->command = command; + d->invoke = invoke_link; + d->free = free_data; + d->level = 2; + goto done; + } + + case FILE_SYMLINK: + { + char* new_name; + + new_name = name+strlen(name)+1; + d = EF_SAFE_ALLOC(sizeof(struct t_data) - 1 + + strlen(name) + 1 + + strlen(new_name) + 1); + + strcpy(d->b, name); + strcpy(d->b + strlen(name) + 1, new_name); + d->flags = desc->flags; + d->fd = fd; + d->command = command; + d->invoke = invoke_symlink; + d->free = free_data; + d->level = 2; + goto done; + } + + } + + /* + * Ignore anything else -- let the caller hang. + */ + + return; + + done: + if (d) { + cq_enq(desc, d); + } +} + +/********************************************************************* + * Driver entry point -> flush + */ +static void +file_flush(ErlDrvData e) { + file_descriptor *desc = (file_descriptor *)e; + int r; + + TRACE_C('f'); + + r = flush_write(desc, NULL); + /* Only possible reason for bad return value is ENOMEM, and + * there is nobody to tell... + */ + ASSERT(r == 0); + r = 0; /* Avoiding warning */ + cq_execute(desc); +} + + + +/********************************************************************* + * Driver entry point -> control + */ +static int +file_control(ErlDrvData e, unsigned int command, + char* buf, int len, char **rbuf, int rlen) { + file_descriptor *desc = (file_descriptor *)e; + switch (command) { + default: + return 0; + } /* switch (command) */ + ASSERT(0); + desc = NULL; /* XXX Avoid warning while empty switch */ + return 0; +} + +/********************************************************************* + * Driver entry point -> timeout + */ +static void +file_timeout(ErlDrvData e) { + file_descriptor *desc = (file_descriptor *)e; + enum e_timer timer_state = desc->timer_state; + + TRACE_C('t'); + + desc->timer_state = timer_idle; + switch (timer_state) { + case timer_idle: + ASSERT(0); + break; + case timer_again: + ASSERT(desc->invoke); + ASSERT(desc->free); + driver_async(desc->port, KEY(desc), desc->invoke, desc->d, desc->free); + break; + case timer_write: { + int r = flush_write(desc, NULL); + /* Only possible reason for bad return value is ENOMEM, and + * there is nobody to tell... + */ + ASSERT(r == 0); + r = 0; /* Avoiding warning */ + cq_execute(desc); + } break; + } /* case */ +} + + + +/********************************************************************* + * Driver entry point -> outputv + */ +static void +file_outputv(ErlDrvData e, ErlIOVec *ev) { + file_descriptor* desc = (file_descriptor*)e; + char command; + int p, q; + int err; + + TRACE_C('v'); + + p = 0; q = 1; + if (! EV_GET_CHAR(ev, &command, &p, &q)) { + /* Empty command */ + reply_posix_error(desc, EINVAL); + goto done; + } + /* 'command' contains the decoded command number, + * 'p' and 'q' point out the next byte in the command: + * ((char *)ev->iov[q].iov_base) + p; + */ + + TRACE_F(("%i", (int) command)); + + switch (command) { + + case FILE_CLOSE: { + flush_read(desc); + if (flush_write_check_error(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (ev->size != 1) { + /* Wrong command length */ + reply_posix_error(desc, EINVAL); + goto done; + } + if (desc->fd != FILE_FD_INVALID) { + struct t_data *d; + if (! (d = EF_ALLOC(sizeof(struct t_data)))) { + reply_posix_error(desc, ENOMEM); + } else { + d->command = command; + d->reply = !0; + d->fd = desc->fd; + d->flags = desc->flags; + d->invoke = invoke_close; + d->free = free_data; + d->level = 2; + cq_enq(desc, d); + desc->fd = FILE_FD_INVALID; + desc->flags = 0; + } + } else { + reply_posix_error(desc, EBADF); + } + } goto done; + + case FILE_READ: { + Uint32 sizeH, sizeL; + size_t size, alloc_size; + struct t_data *d; + if (flush_write_check_error(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } +#if ALWAYS_READ_LINE_AHEAD + if (desc->read_bufsize == 0 && desc->read_binp != NULL && desc->read_size > 0) { + /* We have allocated a buffer for line mode but should not really have a + read-ahead buffer... */ + if (lseek_flush_read(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + } +#endif + if (ev->size != 1+8 + || !EV_GET_UINT32(ev, &sizeH, &p, &q) + || !EV_GET_UINT32(ev, &sizeL, &p, &q)) { + /* Wrong buffer length to contain the read count */ + reply_posix_error(desc, EINVAL); + goto done; + } +#if SIZEOF_SIZE_T == 4 + if (sizeH != 0) { + reply_posix_error(desc, EINVAL); + goto done; + } + size = sizeL; +#else + size = ((size_t)sizeH << 32) | sizeL; +#endif + if ((desc->fd == FILE_FD_INVALID) + || (! (desc->flags & EFILE_MODE_READ)) ) { + reply_posix_error(desc, EBADF); + goto done; + } + if (size == 0) { + reply_buf(desc, &command, 0); + goto done; + } + if (desc->read_size >= size) { + /* We already have all data */ + TRACE_C('D'); + reply_data(desc, desc->read_binp, desc->read_offset, size); + desc->read_offset += size; + desc->read_size -= size; + try_free_read_bin(desc); + goto done; + } + /* We may have some of the data + */ + /* Justification for the following strange formula: + * If the read request is for such a large block as more than + * half the buffer size it may lead to a lot of unnecessary copying, + * since the tail of the old buffer is copied to the head of the + * new, and if the tail is almost half the buffer it is a lot + * to copy. Therefore allocate the exact amount needed in + * this case, giving no lingering tail. */ + alloc_size = + size > (desc->read_bufsize>>1) ? + size : desc->read_bufsize; + if (! desc->read_binp) { + /* Need to allocate a new binary for the result */ + if (! (desc->read_binp = driver_alloc_binary(alloc_size))) { + reply_posix_error(desc, ENOMEM); + goto done; + } + } else { + /* We already have a buffer */ + if (desc->read_binp->orig_size - desc->read_offset < size) { + /* Need to allocate a new binary for the result */ + ErlDrvBinary *binp; + if (! (binp = driver_alloc_binary(alloc_size))) { + reply_posix_error(desc, ENOMEM); + goto done; + } + /* Move data we already have to the new binary */ + sys_memcpy(binp->orig_bytes, + desc->read_binp->orig_bytes + desc->read_offset, + desc->read_size); + driver_free_binary(desc->read_binp); + desc->read_offset = 0; + desc->read_binp = binp; + } + } + if (! (d = EF_ALLOC(sizeof(struct t_data)))) { + reply_posix_error(desc, ENOMEM); + goto done; + } + d->command = command; + d->reply = !0; + d->fd = desc->fd; + d->flags = desc->flags; + d->c.read.binp = desc->read_binp; + d->c.read.bin_offset = desc->read_offset + desc->read_size; + d->c.read.bin_size = desc->read_binp->orig_size - d->c.read.bin_offset; + d->c.read.size = size; + driver_binary_inc_refc(d->c.read.binp); + d->invoke = invoke_read; + d->free = free_read; + d->level = 1; + cq_enq(desc, d); + } goto done; /* case FILE_READ: */ + + case FILE_READ_LINE: { + /* + * Icky little creature... We do mostly as ordinary file read, but with a few differences. + * 1) We have to scan for proper newline sequence if there is a buffer already, we cannot know + * in advance if the buffer contains a whole line without scanning. + * 2) We do not know how large the buffer needs to be in advance. We give a default buffer, + * but the worker may need to allocate a new one. Freeing the old and rereferencing a newly + * allocated binary + dealing with offsets and lengts are done in file_async ready + * for this OP. + */ + struct t_data *d; + if (flush_write_check_error(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (ev->size != 1) { + /* Wrong command length */ + reply_posix_error(desc, EINVAL); + goto done; + } + if ((desc->fd == FILE_FD_INVALID) + || (! (desc->flags & EFILE_MODE_READ)) ) { + reply_posix_error(desc, EBADF); + goto done; + } + if (desc->read_size > 0) { + /* look for '\n' in what we'we already got */ + void *nl_ptr = memchr(desc->read_binp->orig_bytes + desc->read_offset,'\n',desc->read_size); + if (nl_ptr != NULL) { + /* If found, we're done */ + int skip = 0; + size_t size = ((char *) nl_ptr) - + ((char *) (desc->read_binp->orig_bytes + desc->read_offset)) + 1; + if (size > 1 && + *(((char *) nl_ptr) - 1) == '\r') { + *(((char *) nl_ptr) - 1) = '\n'; + skip = 1; + --size; + } + reply_data(desc, desc->read_binp, desc->read_offset, size); + desc->read_offset += (size + skip); + desc->read_size -= (size + skip); + try_free_read_bin(desc); + goto done; + } + } + /* Now, it's up to the thread to work out the need for more buffers and such, it's + no use doing it in this thread as we do not have the information required anyway. + Even a NULL buffer could be handled by the thread, but code is simplified by us + allocating it */ + if (! desc->read_binp) { + int alloc_size = (desc->read_bufsize > DEFAULT_LINEBUF_SIZE) ? desc->read_bufsize : + DEFAULT_LINEBUF_SIZE; + /* Allocate a new binary for the result */ + if (! (desc->read_binp = driver_alloc_binary(alloc_size))) { + reply_posix_error(desc, ENOMEM); + goto done; + } + } + if (! (d = EF_ALLOC(sizeof(struct t_data)))) { + reply_posix_error(desc, ENOMEM); + goto done; + } + + d->command = command; + d->reply = !0; + d->fd = desc->fd; + d->flags = desc->flags; + d->c.read_line.binp = desc->read_binp; + d->c.read_line.read_offset = desc->read_offset; + d->c.read_line.read_size = desc->read_size; +#if !ALWAYS_READ_LINE_AHEAD + d->c.read_line.read_ahead = (desc->read_bufsize > 0); +#endif + driver_binary_inc_refc(d->c.read.binp); + d->invoke = invoke_read_line; + d->free = free_read_line; + d->level = 1; + cq_enq(desc, d); + } goto done; + case FILE_WRITE: { + int skip = 1; + int size = ev->size - skip; + if (lseek_flush_read(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (! (desc->flags & EFILE_MODE_WRITE)) { + reply_posix_error(desc, EBADF); + goto done; + } + if (size <= 0) { + reply_Uint(desc, size); + goto done; + } + MUTEX_LOCK(desc->q_mtx); + if (driver_enqv(desc->port, ev, skip)) { + MUTEX_UNLOCK(desc->q_mtx); + reply_posix_error(desc, ENOMEM); + goto done; + } + desc->write_buffered += size; + if (desc->write_buffered < desc->write_bufsize) { + MUTEX_UNLOCK(desc->q_mtx); + reply_Uint(desc, size); + if (desc->timer_state == timer_idle) { + desc->timer_state = timer_write; + driver_set_timer(desc->port, desc->write_delay); + } + } else { + if (async_write(desc, &err, !0, size) != 0) { + MUTEX_UNLOCK(desc->q_mtx); + reply_posix_error(desc, err); + goto done; + } else { + MUTEX_UNLOCK(desc->q_mtx); + } + } + } goto done; /* case FILE_WRITE */ + + case FILE_PWRITEV: { + Uint32 i, j, n; + size_t total; + struct t_data *d; + if (lseek_flush_read(desc, &err) < 0) { + reply_Uint_posix_error(desc, 0, err); + goto done; + } + if (flush_write_check_error(desc, &err) < 0) { + reply_Uint_posix_error(desc, 0, err); + goto done; + } + if (ev->size < 1+4 + || !EV_GET_UINT32(ev, &n, &p, &q)) { + /* Buffer too short to contain even the number of pos/size specs */ + reply_Uint_posix_error(desc, 0, EINVAL); + goto done; + } + if (n == 0) { + /* Trivial case - nothing to write */ + if (ev->size != 1+4) { + reply_posix_error(desc, err); + } else { + reply_Uint(desc, 0); + } + goto done; + } + if (ev->size < 1+4+8*(2*n)) { + /* Buffer too short to contain even the pos/size specs */ + reply_Uint_posix_error(desc, 0, EINVAL); + goto done; + } + d = EF_ALLOC(sizeof(struct t_data) + + (n * sizeof(struct t_pbuf_spec))); + if (! d) { + reply_Uint_posix_error(desc, 0, ENOMEM); + goto done; + } + d->command = command; + d->reply = !0; + d->fd = desc->fd; + d->flags = desc->flags; + d->c.pwritev.port = desc->port; + d->c.pwritev.q_mtx = desc->q_mtx; + d->c.pwritev.n = n; + d->c.pwritev.cnt = 0; + total = 0; + j = 0; + /* Create pos/size specs in the thread data structure + * for all non-zero size binaries. Calculate total size. + */ + for(i = 0; i < n; i++) { + Uint32 sizeH, sizeL; + size_t size; + if ( !EV_GET_UINT64(ev, &d->c.pwritev.specs[i].offset, &p, &q) + || !EV_GET_UINT32(ev, &sizeH, &p, &q) + || !EV_GET_UINT32(ev, &sizeL, &p, &q)) { + /* Misalignment in buffer */ + reply_Uint_posix_error(desc, 0, EINVAL); + EF_FREE(d); + goto done; + } +#if SIZEOF_SIZE_T == 4 + if (sizeH != 0) { + reply_Uint_posix_error(desc, 0, EINVAL); + EF_FREE(d); + goto done; + } + size = sizeL; +#else + size = ((size_t)sizeH<<32) | sizeL; +#endif + if (size > 0) { + total += size; + d->c.pwritev.specs[j].size = size; + j++; + } + } + d->c.pwritev.size = total; + d->c.pwritev.free_size = 0; + if (j == 0) { + /* Trivial case - nothing to write */ + EF_FREE(d); + reply_Uint(desc, 0); + } else { + size_t skip = 1 + 4 + 8*(2*n); + if (skip + total != ev->size) { + /* Actual amount of data does not match + * total of all pos/size specs + */ + EF_FREE(d); + reply_Uint_posix_error(desc, 0, EINVAL); + } else { + /* Enqueue the data */ + MUTEX_LOCK(desc->q_mtx); + driver_enqv(desc->port, ev, skip); + MUTEX_UNLOCK(desc->q_mtx); + /* Execute the command */ + d->invoke = invoke_pwritev; + d->free = free_pwritev; + d->level = 1; + cq_enq(desc, d); + } + } + } goto done; /* case FILE_PWRITEV: */ + + case FILE_PREADV: { + register void * void_ptr; + Uint32 i, n; + struct t_data *d; + ErlIOVec *res_ev; + if (lseek_flush_read(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (flush_write_check_error(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (ev->size < 1+8 + || !EV_GET_UINT32(ev, &n, &p, &q) + || !EV_GET_UINT32(ev, &n, &p, &q)) { + /* Buffer too short to contain even the number of pos/size specs */ + reply_posix_error(desc, EINVAL); + goto done; + } + if (ev->size != 1+8+8*(2*n)) { + /* Buffer wrong length to contain the pos/size specs */ + reply_posix_error(desc, EINVAL); + goto done; + } + /* Create the thread data structure with the contained ErlIOVec + * and corresponding binaries for the response + */ + d = EF_ALLOC(sizeof(*d) + + (n * sizeof(*d->c.preadv.offsets)) + + ((1+n) * (sizeof(*res_ev->iov) + + sizeof(*res_ev->binv)))); + if (! d) { + reply_posix_error(desc, ENOMEM); + goto done; + } + d->command = command; + d->reply = !0; + d->fd = desc->fd; + d->flags = desc->flags; + d->c.preadv.n = n; + d->c.preadv.cnt = 0; + d->c.preadv.size = 0; + res_ev = &d->c.preadv.eiov; + /* XXX possible alignment problems here for weird machines */ + res_ev->vsize = 1+d->c.preadv.n; + res_ev->iov = void_ptr = &d->c.preadv.offsets[d->c.preadv.n]; + res_ev->binv = void_ptr = &res_ev->iov[res_ev->vsize]; + /* Read in the pos/size specs and allocate binaries for the results */ + for (i = 1; i < 1+n; i++) { + Uint32 sizeH, sizeL; + size_t size; + if ( !EV_GET_UINT64(ev, &d->c.preadv.offsets[i-1], &p, &q) + || !EV_GET_UINT32(ev, &sizeH, &p, &q) + || !EV_GET_UINT32(ev, &sizeL, &p, &q)) { + reply_posix_error(desc, EINVAL); + break; + } +#if SIZEOF_SIZE_T == 4 + if (sizeH != 0) { + reply_posix_error(desc, EINVAL); + break; + } + size = sizeL; +#else + size = ((size_t)sizeH<<32) | sizeL; +#endif + if (! (res_ev->binv[i] = driver_alloc_binary(size))) { + reply_posix_error(desc, ENOMEM); + break; + } else { + res_ev->iov[i].iov_len = size; + res_ev->iov[i].iov_base = res_ev->binv[i]->orig_bytes; + } + } + if (i < 1+n) { + for (i--; i > 0; i--) { + driver_free_binary(res_ev->binv[i]); + } + EF_FREE(d); + goto done; + } + /* Allocate the header binary (index 0) */ + res_ev->binv[0] = driver_alloc_binary(4+4+8*n); + if (! res_ev->binv[0]) { + reply_posix_error(desc, ENOMEM); + for (i = 1; i < 1+n; i++) { + driver_free_binary(res_ev->binv[i]); + } + EF_FREE(d); + goto done; + } + res_ev->iov[0].iov_len = 4+4+8*n; + res_ev->iov[0].iov_base = res_ev->binv[0]->orig_bytes; + /* Fill in the number of buffers in the header */ + put_int32(0, res_ev->iov[0].iov_base); + put_int32(n, res_ev->iov[0].iov_base+4); + /**/ + res_ev->size = res_ev->iov[0].iov_len; + if (n == 0) { + /* Trivial case - nothing to read */ + reply_ev(desc, FILE_RESP_LDATA, res_ev); + free_preadv(d); + goto done; + } else { + d->invoke = invoke_preadv; + d->free = free_preadv; + d->level = 1; + cq_enq(desc, d); + } + } goto done; /* case FILE_PREADV: */ + + case FILE_LSEEK: { + Sint64 offset; /* Offset for seek */ + Uint32 origin; /* Origin of seek. */ + if (lseek_flush_read(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (flush_write_check_error(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (ev->size != 1+8+4 + || !EV_GET_UINT64(ev, &offset, &p, &q) + || !EV_GET_UINT32(ev, &origin, &p, &q)) { + /* Wrong length of buffer to contain offset and origin */ + reply_posix_error(desc, EINVAL); + goto done; + } + if (async_lseek(desc, &err, !0, offset, origin) < 0) { + reply_posix_error(desc, err); + goto done; + } + } goto done; + + case FILE_READ_FILE: { + struct t_data *d; + if (ev->size < 1+1) { + /* Buffer contains empty name */ + reply_posix_error(desc, ENOENT); + goto done; + } + if (ev->size-1 != ev->iov[q].iov_len-p) { + /* Name not in one single buffer */ + reply_posix_error(desc, EINVAL); + goto done; + } + d = EF_ALLOC(sizeof(struct t_data) + ev->size); + if (! d) { + reply_posix_error(desc, ENOMEM); + goto done; + } + d->command = command; + d->reply = !0; + /* Copy name */ + memcpy(d->c.read_file.name, EV_CHAR_P(ev, p, q), ev->size-1); + d->c.read_file.name[ev->size-1] = '\0'; + d->c.read_file.binp = NULL; + d->invoke = invoke_read_file; + d->free = free_read_file; + d->level = 2; + cq_enq(desc, d); + } goto done; + + case FILE_IPREAD: { + /* This operation cheets by using invoke_preadv() and free_preadv() + * plus its own invoke_ipread. Therefore the result format is + * a bit awkward - the header binary contains one extra 64 bit + * field that invoke_preadv() fortunately ignores, + * and the first 64 bit field does not contain the number of + * data binaries which invoke_preadv() also ignores. + */ + register void * void_ptr; + char mode; + Sint64 hdr_offset; + Uint32 max_size; + struct t_data *d; + ErlIOVec *res_ev; + int vsize; + if (! EV_GET_CHAR(ev, &mode, &p, &q)) { + /* Empty command */ + reply_posix_error(desc, EINVAL); + goto done; + } + if (mode != IPREAD_S32BU_P32BU) { + reply_posix_error(desc, EINVAL); + goto done; + } + if (lseek_flush_read(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (flush_write_check_error(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (ev->size < 1+1+8+4 + || !EV_GET_UINT64(ev, &hdr_offset, &p, &q) + || !EV_GET_UINT32(ev, &max_size, &p, &q)) { + /* Buffer too short to contain + * the header offset and max size spec */ + reply_posix_error(desc, EINVAL); + goto done; + } + /* Create the thread data structure with the contained ErlIOVec + * and corresponding binaries for the response + */ + vsize = 2; + d = EF_ALLOC(sizeof(*d) + + vsize*(sizeof(*res_ev->iov) + sizeof(*res_ev->binv))); + if (! d) { + reply_posix_error(desc, ENOMEM); + goto done; + } + d->command = command; + d->reply = !0; + d->fd = desc->fd; + d->flags = desc->flags; + d->c.preadv.offsets[0] = hdr_offset; + d->c.preadv.size = max_size; + res_ev = &d->c.preadv.eiov; + /* XXX possible alignment problems here for weird machines */ + res_ev->iov = void_ptr = d + 1; + res_ev->binv = void_ptr = res_ev->iov + vsize; + res_ev->size = 0; + res_ev->vsize = 0; + d->invoke = invoke_ipread; + d->free = free_preadv; + d->level = 1; + cq_enq(desc, d); + } goto done; /* case FILE_IPREAD: */ + + case FILE_SETOPT: { + char opt; + if (ev->size < 1+1 + || !EV_GET_CHAR(ev, &opt, &p, &q)) { + /* Buffer too short to contain even the option type */ + reply_posix_error(desc, EINVAL); + goto done; + } + switch (opt) { + case FILE_OPT_DELAYED_WRITE: { + Uint32 sizeH, sizeL, delayH, delayL; + if (ev->size != 1+1+4*sizeof(Uint32) + || !EV_GET_UINT32(ev, &sizeH, &p, &q) + || !EV_GET_UINT32(ev, &sizeL, &p, &q) + || !EV_GET_UINT32(ev, &delayH, &p, &q) + || !EV_GET_UINT32(ev, &delayL, &p, &q)) { + /* Buffer has wrong length to contain the option values */ + reply_posix_error(desc, EINVAL); + goto done; + } +#if SIZEOF_SIZE_T == 4 + if (sizeH != 0) { + reply_posix_error(desc, EINVAL); + goto done; + } + desc->write_bufsize = sizeL; +#else + desc->write_bufsize = ((size_t)sizeH << 32) | sizeL; +#endif +#if SIZEOF_LONG == 4 + if (delayH != 0) { + reply_posix_error(desc, EINVAL); + goto done; + } + desc->write_delay = delayL; +#else + desc->write_delay = ((unsigned long)delayH << 32) | delayL; +#endif + TRACE_C('K'); + reply_ok(desc); + } goto done; + case FILE_OPT_READ_AHEAD: { + Uint32 sizeH, sizeL; + if (ev->size != 1+1+2*sizeof(Uint32) + || !EV_GET_UINT32(ev, &sizeH, &p, &q) + || !EV_GET_UINT32(ev, &sizeL, &p, &q)) { + /* Buffer has wrong length to contain the option values */ + reply_posix_error(desc, EINVAL); + goto done; + } +#if SIZEOF_SIZE_T == 4 + if (sizeH != 0) { + reply_posix_error(desc, EINVAL); + goto done; + } + desc->read_bufsize = sizeL; +#else + desc->read_bufsize = ((size_t)sizeH << 32) | sizeL; +#endif + TRACE_C('K'); + reply_ok(desc); + } goto done; + default: + reply_posix_error(desc, EINVAL); + goto done; + } /* case FILE_OPT_DELAYED_WRITE: */ + } ASSERT(0); goto done; /* case FILE_SETOPT: */ + + } /* switch(command) */ + + if (lseek_flush_read(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } + if (flush_write_check_error(desc, &err) < 0) { + reply_posix_error(desc, err); + goto done; + } else { + /* Flatten buffer and send it to file_output(desc, buf, len) */ + int len = ev->size; + char *buf = EF_ALLOC(len); + if (! buf) { + reply_posix_error(desc, ENOMEM); + goto done; + } + driver_vec_to_buf(ev, buf, len); + file_output((ErlDrvData) desc, buf, len); + EF_FREE(buf); + goto done; + } + + done: + cq_execute(desc); +} diff --git a/erts/emulator/drivers/common/erl_efile.h b/erts/emulator/drivers/common/erl_efile.h new file mode 100644 index 0000000000..9aa941e550 --- /dev/null +++ b/erts/emulator/drivers/common/erl_efile.h @@ -0,0 +1,152 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Defines the interfaces between the generic efile driver and its + * operating-system dependent helpers. + */ + +#include "sys.h" +#include "erl_driver.h" + +/* + * Open modes for efile_openfile(). + */ +#define EFILE_MODE_READ 1 +#define EFILE_MODE_WRITE 2 /* Implies truncating file when used alone. */ +#define EFILE_MODE_READ_WRITE 3 +#define EFILE_MODE_APPEND 4 +#define EFILE_COMPRESSED 8 +#define EFILE_NO_TRUNCATE 16 /* Special for reopening on VxWorks */ + +/* + * Seek modes for efile_seek(). + */ +#define EFILE_SEEK_SET 0 +#define EFILE_SEEK_CUR 1 +#define EFILE_SEEK_END 2 + +/* + * File types returned by efile_fileinfo(). + */ +#define FT_DEVICE 1 +#define FT_DIRECTORY 2 +#define FT_REGULAR 3 +#define FT_SYMLINK 4 +#define FT_OTHER 5 + +/* + * Access attributes returned by efile_fileinfo() (the bits can be ORed + * together). + */ +#define FA_NONE 0 +#define FA_WRITE 1 +#define FA_READ 2 + +/* + * An handle to an open directory. To be cast to the correct type + * in the system-dependent directory functions. + */ + +typedef struct _Efile_Dir_Handle* EFILE_DIR_HANDLE; + +/* + * Error information from the last call. + */ +typedef struct _Efile_error { + int posix_errno; /* Posix error number, as in . */ + int os_errno; /* Os-dependent error number (not used). */ +} Efile_error; + +/* + * This structure contains date and time. + */ +typedef struct _Efile_time { + unsigned year; /* (4 digits). */ + unsigned month; /* (1..12). */ + unsigned day; /* (1..31). */ + unsigned hour; /* (0..23). */ + unsigned minute; /* (0..59). */ + unsigned second; /* (0..59). */ +} Efile_time; + + +/* + * Describes what is returned by file:file_info/1. + */ + +typedef struct _Efile_info { + Uint32 size_low; /* Size of file, lower 32 bits.. */ + Uint32 size_high; /* Size of file, higher 32 bits. */ + Uint32 type; /* Type of file -- one of FT_*. */ + Uint32 access; /* Access to file -- one of FA_*. */ + Uint32 mode; /* Access permissions -- bit field. */ + Uint32 links; /* Number of links to file. */ + Uint32 major_device; /* Major device or file system. */ + Uint32 minor_device; /* Minor device (for devices). */ + Uint32 inode; /* Inode number. */ + Uint32 uid; /* User id of owner. */ + Uint32 gid; /* Group id of owner. */ + Efile_time accessTime; /* Last time the file was accessed. */ + Efile_time modifyTime; /* Last time the file was modified. */ + Efile_time cTime; /* Creation time (Windows) or last + * inode change (Unix). + */ +} Efile_info; + +/* + * Functions. + */ + +int efile_mkdir(Efile_error* errInfo, char* name); +int efile_rmdir(Efile_error* errInfo, char* name); +int efile_delete_file(Efile_error* errInfo, char* name); +int efile_rename(Efile_error* errInfo, char* src, char* dst); +int efile_chdir(Efile_error* errInfo, char* name); +int efile_getdcwd(Efile_error* errInfo, int drive, + char* buffer, size_t size); +int efile_readdir(Efile_error* errInfo, char* name, + EFILE_DIR_HANDLE* dir_handle, + char* buffer, size_t size); +int efile_openfile(Efile_error* errInfo, char* name, int flags, + int* pfd, Sint64* pSize); +void efile_closefile(int fd); +int efile_fsync(Efile_error* errInfo, int fd); +int efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, + char *name, int info_for_link); +int efile_write_info(Efile_error* errInfo, Efile_info* pInfo, char *name); +int efile_write(Efile_error* errInfo, int flags, int fd, + char* buf, size_t count); +int efile_writev(Efile_error* errInfo, int flags, int fd, + SysIOVec* iov, int iovcnt, size_t size); +int efile_read(Efile_error* errInfo, int flags, int fd, + char* buf, size_t count, size_t* pBytesRead); +int efile_seek(Efile_error* errInfo, int fd, + Sint64 offset, int origin, Sint64* new_location); +int efile_truncate_file(Efile_error* errInfo, int *fd, int flags); +int efile_pwrite(Efile_error* errInfo, int fd, + char* buf, size_t count, Sint64 offset); +int efile_pread(Efile_error* errInfo, int fd, + Sint64 offset, char* buf, size_t count, size_t* pBytesRead); +int efile_readlink(Efile_error* errInfo, char *name, + char* buffer, size_t size); +int efile_altname(Efile_error* errInfo, char *name, + char* buffer, size_t size); +int efile_link(Efile_error* errInfo, char* old, char* new); +int efile_symlink(Efile_error* errInfo, char* old, char* new); +int efile_may_openfile(Efile_error* errInfo, char *name); diff --git a/erts/emulator/drivers/common/gzio.c b/erts/emulator/drivers/common/gzio.c new file mode 100644 index 0000000000..801bc61d4d --- /dev/null +++ b/erts/emulator/drivers/common/gzio.c @@ -0,0 +1,822 @@ +/* + * Original version by Jean-loup Gailly. Modified for use by the + * Erlang run-time system and efile_driver; names of all external + * functions changed to avoid conflicts with the official gzio.c file. + * + * gzio.c -- IO on .gz files + * Copyright (C) 1995-1996 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include +#include +#ifdef HAVE_UNISTD_H +#include +#endif +#include +#include "erl_driver.h" +#include "sys.h" + +#ifdef VXWORKS +/* pull in FOPEN from zutil.h instead */ +#undef F_OPEN +#endif + +#ifdef __WIN32__ +#define HAVE_CONFLICTING_FREAD_DECLARATION +#endif + +#ifdef STDC +# define zstrerror(errnum) strerror(errnum) +#else +# define zstrerror(errnum) "" +#endif + +#include "gzio_zutil.h" +#include "erl_zlib.h" +#include "gzio.h" + +/********struct internal_state {int dummy;}; / * for buggy compilers */ + +#define Z_BUFSIZE 4096 + +#define ALLOC(size) driver_alloc(size) +#define TRYFREE(p) {if (p) driver_free(p);} + +static int gz_magic[2] = {0x1f, 0x8b}; /* gzip magic header */ + +/* gzip flag byte */ +#define ASCII_FLAG 0x01 /* bit 0 set: file probably ascii text */ +#define HEAD_CRC 0x02 /* bit 1 set: header CRC present */ +#define EXTRA_FIELD 0x04 /* bit 2 set: extra field present */ +#define ORIG_NAME 0x08 /* bit 3 set: original file name present */ +#define COMMENT 0x10 /* bit 4 set: file comment present */ +#define RESERVED 0xE0 /* bits 5..7: reserved */ + +typedef struct gz_stream { + z_stream stream; + int z_err; /* error code for last stream operation */ + int z_eof; /* set if end of input file */ +#ifdef UNIX + int file; /* .gz file descriptor */ +#else + FILE *file; /* .gz file */ +#endif + Byte *inbuf; /* input buffer */ + Byte *outbuf; /* output buffer */ + uLong crc; /* crc32 of uncompressed data */ + char *msg; /* error message */ + char *path; /* path name for debugging only */ + int transparent; /* 1 if input file is not a .gz file */ + char mode; /* 'w' or 'r' */ + int position; /* Position (for seek) */ + int (*destroy)OF((struct gz_stream*)); /* Function to destroy + * this structure. */ +} gz_stream; + +local gzFile gz_open OF((const char *path, const char *mode)); +local int get_byte OF((gz_stream *s)); +local void check_header OF((gz_stream *s)); +local int destroy OF((gz_stream *s)); +local uLong getLong OF((gz_stream *s)); + +#ifdef UNIX +/* + * In Solaris 8 and earlier, fopen() and its friends cannot handle + * file descriptors larger than 255. Therefore, we use read()/write() + * on all Unix systems. + */ +# define ERTS_GZWRITE(File, Buf, Count) write((File), (Buf), (Count)) +# define ERTS_GZREAD(File, Buf, Count) read((File), (Buf), (Count)) +#else +/* + * On all other operating systems, using fopen(), fread()/fwrite(), since + * there is not guaranteed to exist any read()/write() (not part of + * ANSI/ISO-C). + */ +# define ERTS_GZWRITE(File, Buf, Count) fwrite((Buf), 1, (Count), (File)) +# define ERTS_GZREAD(File, Buf, Count) fread((Buf), 1, (Count), (File)) +#endif + +/* =========================================================================== + Opens a gzip (.gz) file for reading or writing. The mode parameter + is as in fopen ("rb" or "wb"). The file is given either by file descriptor + or path name (if fd == -1). + gz_open return NULL if the file could not be opened or if there was + insufficient memory to allocate the (de)compression state; errno + can be checked to distinguish the two cases (if errno is zero, the + zlib error is Z_MEM_ERROR). +*/ +local gzFile gz_open (path, mode) + const char *path; + const char *mode; +{ + int err; + int level = Z_DEFAULT_COMPRESSION; /* compression level */ + char *p = (char*)mode; + gz_stream *s; + char fmode[80]; /* copy of mode, without the compression level */ + char *m = fmode; + + if (!path || !mode) return Z_NULL; + + s = (gz_stream *)ALLOC(sizeof(gz_stream)); + if (!s) return Z_NULL; + + erl_zlib_alloc_init(&s->stream); + s->stream.next_in = s->inbuf = Z_NULL; + s->stream.next_out = s->outbuf = Z_NULL; + s->stream.avail_in = s->stream.avail_out = 0; +#ifdef UNIX + s->file = -1; +#else + s->file = NULL; +#endif + s->z_err = Z_OK; + s->z_eof = 0; + s->crc = crc32(0L, Z_NULL, 0); + s->msg = NULL; + s->transparent = 0; + s->position = 0; + s->destroy = destroy; + + s->path = (char*)ALLOC(strlen(path)+1); + if (s->path == NULL) { + return s->destroy(s), (gzFile)Z_NULL; + } + strcpy(s->path, path); /* do this early for debugging */ + + s->mode = '\0'; + do { + if (*p == 'r') + s->mode = 'r'; + if (*p == 'w' || *p == 'a') + s->mode = 'w'; + if (isdigit((int)*p)) { + level = *p - '0'; + } else { + *m++ = *p; /* Copy the mode */ + } + } while (*p++ && m < fmode + sizeof(fmode) - 1); + *m = '\0'; + if (s->mode == '\0') + return s->destroy(s), (gzFile)Z_NULL; + + if (s->mode == 'w') { + err = deflateInit2(&(s->stream), level, + Z_DEFLATED, MAX_WBITS+16, DEF_MEM_LEVEL, 0); + /* windowBits is passed < 0 to suppress zlib header */ + + s->stream.next_out = s->outbuf = (Byte*)ALLOC(Z_BUFSIZE); + + if (err != Z_OK || s->outbuf == Z_NULL) { + return s->destroy(s), (gzFile)Z_NULL; + } + } else { + /* + * It is tempting to use the built-in support in zlib + * for handling GZIP headers, but unfortunately it + * cannot handle multiple GZIP headers (which occur when + * several GZIP files have been concatenated). + */ + + err = inflateInit2(&(s->stream), -MAX_WBITS); + s->stream.next_in = s->inbuf = (Byte*)ALLOC(Z_BUFSIZE); + + if (err != Z_OK || s->inbuf == Z_NULL) { + return s->destroy(s), (gzFile)Z_NULL; + } + } + s->stream.avail_out = Z_BUFSIZE; + + errno = 0; +#ifdef UNIX + if (s->mode == 'r') { + s->file = open(path, O_RDONLY); + } else { + s->file = open(path, O_WRONLY | O_CREAT | O_TRUNC, 0666); + } + if (s->file == -1) { + return s->destroy(s), (gzFile)Z_NULL; + } +#else + s->file = F_OPEN(path, fmode); + if (s->file == NULL) { + return s->destroy(s), (gzFile)Z_NULL; + } +#endif + if (s->mode == 'r') { + check_header(s); /* skip the .gz header */ + } + return (gzFile)s; +} + +/* =========================================================================== + Rewind a gzfile back to the beginning. +*/ + +local int gz_rewind (gz_stream *s) +{ + TRYFREE(s->msg); + +#ifdef UNIX + lseek(s->file, 0L, SEEK_SET); +#else + fseek(s->file, 0L, SEEK_SET); +#endif + inflateReset(&(s->stream)); + s->stream.next_in = Z_NULL; + s->stream.next_out = Z_NULL; + s->stream.avail_in = s->stream.avail_out = 0; + s->z_err = Z_OK; + s->z_eof = 0; + s->crc = crc32(0L, Z_NULL, 0); + s->msg = NULL; + s->position = 0; + s->stream.next_in = s->inbuf; + + s->stream.avail_out = Z_BUFSIZE; + + check_header(s); /* skip the .gz header */ + return 1; +} + +/* =========================================================================== + Opens a gzip (.gz) file for reading or writing. +*/ +gzFile erts_gzopen (path, mode) + const char *path; + const char *mode; +{ + return gz_open (path, mode); +} + + +/* =========================================================================== + Read a byte from a gz_stream; update next_in and avail_in. Return EOF + for end of file. + IN assertion: the stream s has been sucessfully opened for reading. +*/ +local int get_byte(s) + gz_stream *s; +{ + if (s->z_eof) return EOF; + if (s->stream.avail_in == 0) { +#ifdef UNIX + size_t res; + errno = 0; + res = ERTS_GZREAD(s->file, s->inbuf, Z_BUFSIZE); + if (res == 0) { + s->stream.avail_in = 0; + s->z_eof = 1; + return EOF; + } else if (res < 0) { + s->stream.avail_in = 0; + s->z_eof = 1; + s->z_err = Z_ERRNO; + return EOF; + } else { + s->stream.avail_in = (uInt) res; + } +#else + errno = 0; + s->stream.avail_in = ERTS_GZREAD(s->file, s->inbuf, Z_BUFSIZE); + if (s->stream.avail_in == 0) { + s->z_eof = 1; + if (s->file && ferror(s->file)) + s->z_err = Z_ERRNO; + return EOF; + } +#endif + s->stream.next_in = s->inbuf; + } + s->stream.avail_in--; + return *(s->stream.next_in)++; +} + +/* =========================================================================== + Check the gzip header of a gz_stream opened for reading. Set the stream + mode to transparent if the gzip magic header is not present; set s->err + to Z_DATA_ERROR if the magic header is present but the rest of the header + is incorrect. + IN assertion: the stream s has already been created sucessfully; + s->stream.avail_in is zero for the first time, but may be non-zero + for concatenated .gz files. +*/ +local void check_header(s) + gz_stream *s; +{ + int method; /* method byte */ + int flags; /* flags byte */ + uInt len; + int c; + + /* Check the gzip magic header */ + for (len = 0; len < 2; len++) { + c = get_byte(s); + if (c != gz_magic[len]) { + if (len != 0) s->stream.avail_in++, s->stream.next_in--; + if (c != EOF) { + s->stream.avail_in++, s->stream.next_in--; + s->transparent = 1; + } + s->z_err = s->stream.avail_in != 0 ? Z_OK : Z_STREAM_END; + return; + } + } + method = get_byte(s); + flags = get_byte(s); + if (method != Z_DEFLATED || (flags & RESERVED) != 0) { + s->z_err = Z_DATA_ERROR; + return; + } + + /* Discard time, xflags and OS code: */ + for (len = 0; len < 6; len++) (void)get_byte(s); + + if ((flags & EXTRA_FIELD) != 0) { /* skip the extra field */ + len = (uInt)get_byte(s); + len += ((uInt)get_byte(s))<<8; + /* len is garbage if EOF but the loop below will quit anyway */ + while (len-- != 0 && get_byte(s) != EOF) ; + } + if ((flags & ORIG_NAME) != 0) { /* skip the original file name */ + while ((c = get_byte(s)) != 0 && c != EOF) ; + } + if ((flags & COMMENT) != 0) { /* skip the .gz file comment */ + while ((c = get_byte(s)) != 0 && c != EOF) ; + } + if ((flags & HEAD_CRC) != 0) { /* skip the header crc */ + for (len = 0; len < 2; len++) (void)get_byte(s); + } + s->z_err = s->z_eof ? Z_DATA_ERROR : Z_OK; +} + + /* =========================================================================== + * Cleanup then free the given gz_stream. Return a zlib error code. + Try freeing in the reverse order of allocations. + */ +local int destroy (s) + gz_stream *s; +{ + int err = Z_OK; + + if (!s) return Z_STREAM_ERROR; + + TRYFREE(s->msg); + + if (s->stream.state != NULL) { + if (s->mode == 'w') { + err = deflateEnd(&(s->stream)); + } else if (s->mode == 'r') { + err = inflateEnd(&(s->stream)); + } + } +#ifdef UNIX + if (s->file != -1 && close(s->file)) { + err = Z_ERRNO; + } +#else + if (s->file != NULL && fclose(s->file)) { + err = Z_ERRNO; + } +#endif + if (s->z_err < 0) err = s->z_err; + + TRYFREE(s->inbuf); + TRYFREE(s->outbuf); + TRYFREE(s->path); + TRYFREE(s); + return err; +} + +/* =========================================================================== + Reads the given number of uncompressed bytes from the compressed file. + gzread returns the number of bytes actually read (0 for end of file). +*/ +int +erts_gzread(gzFile file, voidp buf, unsigned len) +{ + gz_stream *s = (gz_stream*)file; + Bytef *start = buf; /* starting point for crc computation */ + Byte *next_out; /* == stream.next_out but not forced far (for MSDOS) */ + + if (s == NULL || s->mode != 'r') return Z_STREAM_ERROR; + + if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) return -1; + if (s->z_err == Z_STREAM_END) return 0; /* EOF */ + + s->stream.next_out = next_out = buf; + s->stream.avail_out = len; + + while (s->stream.avail_out != 0) { + + if (s->transparent) { + /* Copy first the lookahead bytes: */ + uInt n = s->stream.avail_in; + if (n > s->stream.avail_out) n = s->stream.avail_out; + if (n > 0) { + zmemcpy(s->stream.next_out, s->stream.next_in, n); + next_out += n; + s->stream.next_out = next_out; + s->stream.next_in += n; + s->stream.avail_out -= n; + s->stream.avail_in -= n; + } + if (s->stream.avail_out > 0) { + s->stream.avail_out -= ERTS_GZREAD(s->file, next_out, + s->stream.avail_out); + } + len -= s->stream.avail_out; + s->stream.total_in += (uLong)len; + s->stream.total_out += (uLong)len; + if (len == 0) s->z_eof = 1; + s->position += (int)len; + return (int)len; + } + if (s->stream.avail_in == 0 && !s->z_eof) { +#ifdef UNIX + size_t res; + errno = 0; + res = ERTS_GZREAD(s->file, s->inbuf, Z_BUFSIZE); + if (res == 0) { + s->stream.avail_in = 0; + s->z_eof = 1; + return EOF; + } else if (res < 0) { + s->stream.avail_in = 0; + s->z_eof = 1; + s->z_err = Z_ERRNO; + return EOF; + } else { + s->stream.avail_in = (uInt) res; + } +#else + errno = 0; + s->stream.avail_in = ERTS_GZREAD(s->file, s->inbuf, Z_BUFSIZE); + if (s->stream.avail_in == 0) { + s->z_eof = 1; + if (s->file && ferror(s->file)) { + s->z_err = Z_ERRNO; + break; + } + } +#endif + s->stream.next_in = s->inbuf; + } + s->z_err = inflate(&(s->stream), Z_NO_FLUSH); + + if (s->z_err == Z_STREAM_END) { + /* Check CRC and original size */ + s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); + start = s->stream.next_out; + + if (getLong(s) != s->crc) { + s->z_err = Z_DATA_ERROR; + } else { + (void)getLong(s); + /* The uncompressed length returned by above getlong() may + * be different from s->stream.total_out) in case of + * concatenated .gz files. Check for such files: + */ + check_header(s); + if (s->z_err == Z_OK) { + uLong total_in = s->stream.total_in; + uLong total_out = s->stream.total_out; + + inflateReset(&(s->stream)); + s->stream.total_in = total_in; + s->stream.total_out = total_out; + s->crc = crc32(0L, Z_NULL, 0); + } + } + } + if (s->z_err != Z_OK || s->z_eof) break; + } + s->crc = crc32(s->crc, start, (uInt)(s->stream.next_out - start)); + + s->position += (int)(len - s->stream.avail_out); + + return (int)(len - s->stream.avail_out); +} + +/* =========================================================================== + Writes the given number of uncompressed bytes into the compressed file. + gzwrite returns the number of bytes actually written (0 in case of error). +*/ +int +erts_gzwrite(gzFile file, voidp buf, unsigned len) +{ + gz_stream *s = (gz_stream*)file; + + if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; + + s->stream.next_in = buf; + s->stream.avail_in = len; + + while (s->stream.avail_in != 0) { + + if (s->stream.avail_out == 0) { + + s->stream.next_out = s->outbuf; + if (ERTS_GZWRITE(s->file, s->outbuf, Z_BUFSIZE) != Z_BUFSIZE) { + s->z_err = Z_ERRNO; + break; + } + s->stream.avail_out = Z_BUFSIZE; + } + s->z_err = deflate(&(s->stream), Z_NO_FLUSH); + if (s->z_err != Z_OK) break; + } + s->position += (int)(len - s->stream.avail_in); + return (int)(len - s->stream.avail_in); +} + +/* + * For use by Erlang file driver. + * + * XXX Limitations: + * - SEEK_END is not allowed (length of file is not known). + * - When writing, only forward seek is supported. + */ + +int +erts_gzseek(gzFile file, int offset, int whence) +{ + int pos; + gz_stream* s = (gz_stream *) file; + + if (s == NULL) { + errno = EINVAL; + return -1; + } + if (s->z_err == Z_DATA_ERROR || s->z_err == Z_ERRNO) { + errno = EIO; + return -1; + } + + switch (whence) { + case SEEK_SET: pos = offset; break; + case SEEK_CUR: pos = s->position+offset; break; + case SEEK_END: + default: + errno = EINVAL; return -1; + } + + if (pos == s->position) { + return pos; + } + + if (pos < s->position) { + if (s->mode == 'w') { + errno = EINVAL; + return -1; + } + gz_rewind(s); + } + + while (s->position < pos) { + char buf[512]; + int n; + + n = pos - s->position; + if (n > sizeof(buf)) + n = sizeof(buf); + + if (s->mode == 'r') { + erts_gzread(file, buf, n); + } else { + memset(buf, '\0', n); + erts_gzwrite(file, buf, n); + } + } + + return s->position; +} + +/* =========================================================================== + Flushes all pending output into the compressed file. The parameter + flush is as in the deflate() function. + gzflush should be called only when strictly necessary because it can + degrade compression. +*/ +int +erts_gzflush(gzFile file, int flush) +{ + uInt len; + int done = 0; + gz_stream *s = (gz_stream*)file; + + if (s == NULL || s->mode != 'w') return Z_STREAM_ERROR; + + s->stream.avail_in = 0; /* should be zero already anyway */ + + for (;;) { + len = Z_BUFSIZE - s->stream.avail_out; + + if (len != 0) { + if ((uInt)ERTS_GZWRITE(s->file, s->outbuf, len) != len) { + s->z_err = Z_ERRNO; + return Z_ERRNO; + } + s->stream.next_out = s->outbuf; + s->stream.avail_out = Z_BUFSIZE; + } + if (done) break; + s->z_err = deflate(&(s->stream), flush); + + /* deflate has finished flushing only when it hasn't used up + * all the available space in the output buffer: + */ + done = (s->stream.avail_out != 0 || s->z_err == Z_STREAM_END); + + if (s->z_err != Z_OK && s->z_err != Z_STREAM_END) break; + } +#ifndef UNIX + fflush(s->file); +#endif + return s->z_err == Z_STREAM_END ? Z_OK : s->z_err; +} + +/* =========================================================================== + Reads a long in LSB order from the given gz_stream. Sets +*/ +local uLong getLong (s) + gz_stream *s; +{ + uLong x = (uLong)get_byte(s); + int c; + + x += ((uLong)get_byte(s))<<8; + x += ((uLong)get_byte(s))<<16; + c = get_byte(s); + if (c == EOF) s->z_err = Z_DATA_ERROR; + x += ((uLong)c)<<24; + return x; +} + +/* =========================================================================== + Flushes all pending output if necessary, closes the compressed file + and deallocates all the (de)compression state. +*/ +int +erts_gzclose(gzFile file) +{ + int err; + gz_stream *s = (gz_stream*)file; + + if (s == NULL) return Z_STREAM_ERROR; + + if (s->mode == 'w') { + err = erts_gzflush (file, Z_FINISH); + if (err != Z_OK) return s->destroy(file); + } + return s->destroy(file); +} + + +/* =========================================================================== + Uncompresses the buffer given and returns a pointer to a binary. + If the buffer was not compressed with gzip, the buffer contents + will be copied unchanged into the binary. + + If a `gzip' header was found, but there were subsequent errors, + a NULL pointer is returned. +*/ + +ErlDrvBinary* +erts_gzinflate_buffer(char* start, uLong size) +{ + ErlDrvBinary* bin; + ErlDrvBinary* bin2; + z_stream zstr; + unsigned char* bptr; + + /* + * Check for the magic bytes beginning a GZIP header. + */ + bptr = (unsigned char *) start; + if (size < 2 || bptr[0] != gz_magic[0] || bptr[1] != gz_magic[1]) { + /* No GZIP header -- just copy the data into a new binary */ + if ((bin = driver_alloc_binary(size)) == NULL) { + return NULL; + } + memcpy(bin->orig_bytes, start, size); + return bin; + } + + /* + * The magic bytes for a GZIP header are there. Now try to decompress. + * It is an error if the GZIP header is not correct. + */ + + zstr.next_in = (unsigned char*) start; + zstr.avail_in = size; + erl_zlib_alloc_init(&zstr); + size *= 2; + if ((bin = driver_alloc_binary(size)) == NULL) { + return NULL; + } + if (inflateInit2(&zstr, 15+16) != Z_OK) { /* Decode GZIP format */ + driver_free(bin); + return NULL; + } + for (;;) { + int status; + + zstr.next_out = (unsigned char *) bin->orig_bytes + zstr.total_out; + zstr.avail_out = size - zstr.total_out; + status = inflate(&zstr, Z_NO_FLUSH); + if (status == Z_OK) { + size *= 2; + if ((bin2 = driver_realloc_binary(bin, size)) == NULL) { + error: + driver_free_binary(bin); + inflateEnd(&zstr); + return NULL; + } + bin = bin2; + } else if (status == Z_STREAM_END) { + if ((bin2 = driver_realloc_binary(bin, zstr.total_out)) == NULL) { + goto error; + } + inflateEnd(&zstr); + return bin2; + } else { + goto error; + } + } +} + +/* =========================================================================== + Compresses the buffer given and returns a pointer to a binary. + A NULL pointer is returned if any error occurs. + Writes a gzip header as well. +*/ + +#define GZIP_HD_SIZE 10 +#define GZIP_TL_SIZE 8 + +#define GZIP_X_SIZE (GZIP_HD_SIZE+GZIP_TL_SIZE) + +ErlDrvBinary* +erts_gzdeflate_buffer(char* start, uLong size) +{ + z_stream c_stream; /* compression stream */ + ErlDrvBinary* bin; + ErlDrvBinary* bin2; + uLong crc; /* crc32 of uncompressed data */ + uLong szIn; + Byte* ptr; + int comprLen = size + (size/1000) + 1 + 12; /* see zlib.h */ + + crc = crc32(0L, Z_NULL, 0); + erl_zlib_alloc_init(&c_stream); + + if (deflateInit2(&c_stream, Z_DEFAULT_COMPRESSION, + Z_DEFLATED, -MAX_WBITS, DEF_MEM_LEVEL, 0) != Z_OK) + return NULL; + + if ((bin = driver_alloc_binary(comprLen+GZIP_X_SIZE)) == NULL) + return NULL; + sprintf(bin->orig_bytes, "%c%c%c%c%c%c%c%c%c%c", gz_magic[0], gz_magic[1], + Z_DEFLATED, 0 /*flags*/, 0,0,0,0 /*time*/, 0 /*xflags*/, OS_CODE); + + c_stream.next_out = ((Byte*) bin->orig_bytes)+GZIP_HD_SIZE; + c_stream.avail_out = (uInt) bin->orig_size - GZIP_HD_SIZE; + c_stream.next_in = (Byte*) start; + c_stream.avail_in = (uInt) size; + + if (deflate(&c_stream, Z_FINISH) != Z_STREAM_END) { + driver_free_binary(bin); + return NULL; + } + crc = crc32(crc, (unsigned char*)start, size); + ptr = c_stream.next_out; + szIn = c_stream.total_in; + + *ptr++ = (crc & 0xff); crc >>= 8; + *ptr++ = (crc & 0xff); crc >>= 8; + *ptr++ = (crc & 0xff); crc >>= 8; + *ptr++ = (crc & 0xff); crc >>= 8; + + *ptr++ = (szIn & 0xff); szIn >>= 8; + *ptr++ = (szIn & 0xff); szIn >>= 8; + *ptr++ = (szIn & 0xff); szIn >>= 8; + *ptr++ = (szIn & 0xff); szIn >>= 8; + + if (deflateEnd(&c_stream) != Z_OK) { + driver_free_binary(bin); + return NULL; + } + size = ptr - (Byte*)bin->orig_bytes; + + if ((bin2 = driver_realloc_binary(bin, size)) == NULL) + driver_free_binary(bin); + return bin2; +} + diff --git a/erts/emulator/drivers/common/gzio.h b/erts/emulator/drivers/common/gzio.h new file mode 100644 index 0000000000..3f1e546140 --- /dev/null +++ b/erts/emulator/drivers/common/gzio.h @@ -0,0 +1,27 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +gzFile erts_gzopen (const char *path, const char *mode); +int erts_gzread(gzFile file, voidp buf, unsigned len); +int erts_gzwrite(gzFile file, voidp buf, unsigned len); +int erts_gzseek(gzFile, int, int); +int erts_gzflush(gzFile file, int flush); +int erts_gzclose(gzFile file); +ErlDrvBinary* erts_gzinflate_buffer(char*, uLong); +ErlDrvBinary* erts_gzdeflate_buffer(char*, uLong); diff --git a/erts/emulator/drivers/common/gzio_zutil.h b/erts/emulator/drivers/common/gzio_zutil.h new file mode 100644 index 0000000000..00eccc80fc --- /dev/null +++ b/erts/emulator/drivers/common/gzio_zutil.h @@ -0,0 +1,82 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* A replacement for zlib internal header file zutil.h. + * Just the minimal things that our gzio.c seems to need. + * We don't want to be dependant on some internal header file + * that may change or not exist at all. + */ + +#ifndef HAVE_LIBZ +/* Use our "real" copy of zutil.h if we don't use shared zlib */ +#include "zutil.h" + +#else /* HAVE_LIBZ: Shared zlib is used */ + +#define local static +#define DEF_MEM_LEVEL 8 +#define zmemcpy sys_memcpy + +#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32)) +# define OS_CODE 0x00 +#endif + +#ifdef AMIGA +# define OS_CODE 0x01 +#endif + +#if defined(VAXC) || defined(VMS) +# define OS_CODE 0x02 +# define F_OPEN(name, mode) \ + fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512") +#endif + +#if defined(ATARI) || defined(atarist) +# define OS_CODE 0x05 +#endif + +#ifdef OS2 +# define OS_CODE 0x06 +#endif + +#if defined(MACOS) || defined(TARGET_OS_MAC) +# define OS_CODE 0x07 +#endif + +#ifdef TOPS20 +# define OS_CODE 0x0a +#endif + +#ifdef WIN32 +# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */ +# define OS_CODE 0x0b +# endif +#endif + +#ifdef __50SERIES /* Prime/PRIMOS */ +# define OS_CODE 0x0f +#endif + +#ifndef OS_CODE +# define OS_CODE 0x03 /* assume Unix */ +#endif + + +#endif /* HAVE_LIBZ */ + diff --git a/erts/emulator/drivers/common/inet_drv.c b/erts/emulator/drivers/common/inet_drv.c new file mode 100644 index 0000000000..b7b577da5b --- /dev/null +++ b/erts/emulator/drivers/common/inet_drv.c @@ -0,0 +1,9949 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +/* If we HAVE_SCTP_H and Solaris, we need to define the following in + order to get SCTP working: +*/ +#if (defined(HAVE_SCTP_H) && defined(__sun) && defined(__SVR4)) +#define SOLARIS10 1 +/* WARNING: This is not quite correct, it may also be Solaris 11! */ +#define _XPG4_2 +#define __EXTENSIONS__ +#endif + +#include +#include +#include +#include +#include + +#define IDENTITY(c) c +#define STRINGIFY_1(b) IDENTITY(#b) +#define STRINGIFY(a) STRINGIFY_1(a) + +#ifndef _OSE_ +#ifdef HAVE_UNISTD_H +#include +#endif +#ifdef HAVE_SYS_UIO_H +#include +#endif +#endif + + +/* All platforms fail on malloc errors. */ +#define FATAL_MALLOC + + +#include "erl_driver.h" + +#ifdef __WIN32__ +#define STRNCASECMP strncasecmp + +#define INCL_WINSOCK_API_TYPEDEFS 1 + +#ifndef WINDOWS_H_INCLUDES_WINSOCK2_H +#include +#endif +#include + +#include /* NEED VC 6.0 !!! */ + +#undef WANT_NONBLOCKING +#include "sys.h" + +#undef EWOULDBLOCK +#undef ETIMEDOUT + +#define HAVE_MULTICAST_SUPPORT + +#define ERRNO_BLOCK WSAEWOULDBLOCK + +#define EWOULDBLOCK WSAEWOULDBLOCK +#define EINPROGRESS WSAEINPROGRESS +#define EALREADY WSAEALREADY +#define ENOTSOCK WSAENOTSOCK +#define EDESTADDRREQ WSAEDESTADDRREQ +#define EMSGSIZE WSAEMSGSIZE +#define EPROTOTYPE WSAEPROTOTYPE +#define ENOPROTOOPT WSAENOPROTOOPT +#define EPROTONOSUPPORT WSAEPROTONOSUPPORT +#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT +#define EOPNOTSUPP WSAEOPNOTSUPP +#define EPFNOSUPPORT WSAEPFNOSUPPORT +#define EAFNOSUPPORT WSAEAFNOSUPPORT +#define EADDRINUSE WSAEADDRINUSE +#define EADDRNOTAVAIL WSAEADDRNOTAVAIL +#define ENETDOWN WSAENETDOWN +#define ENETUNREACH WSAENETUNREACH +#define ENETRESET WSAENETRESET +#define ECONNABORTED WSAECONNABORTED +#define ECONNRESET WSAECONNRESET +#define ENOBUFS WSAENOBUFS +#define EISCONN WSAEISCONN +#define ENOTCONN WSAENOTCONN +#define ESHUTDOWN WSAESHUTDOWN +#define ETOOMANYREFS WSAETOOMANYREFS +#define ETIMEDOUT WSAETIMEDOUT +#define ECONNREFUSED WSAECONNREFUSED +#define ELOOP WSAELOOP +#undef ENAMETOOLONG +#define ENAMETOOLONG WSAENAMETOOLONG +#define EHOSTDOWN WSAEHOSTDOWN +#define EHOSTUNREACH WSAEHOSTUNREACH +#undef ENOTEMPTY +#define ENOTEMPTY WSAENOTEMPTY +#define EPROCLIM WSAEPROCLIM +#define EUSERS WSAEUSERS +#define EDQUOT WSAEDQUOT +#define ESTALE WSAESTALE +#define EREMOTE WSAEREMOTE + +#define INVALID_EVENT WSA_INVALID_EVENT + +static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); + +#define sock_open(af, type, proto) \ + make_noninheritable_handle(socket((af), (type), (proto))) +#define sock_close(s) closesocket((s)) +#define sock_shutdown(s, how) shutdown((s), (how)) + +#define sock_accept(s, addr, len) \ + make_noninheritable_handle(accept((s), (addr), (len))) +#define sock_connect(s, addr, len) connect((s), (addr), (len)) +#define sock_listen(s, b) listen((s), (b)) +#define sock_bind(s, addr, len) bind((s), (addr), (len)) +#define sock_getopt(s,t,n,v,l) getsockopt((s),(t),(n),(v),(l)) +#define sock_setopt(s,t,n,v,l) setsockopt((s),(t),(n),(v),(l)) +#define sock_name(s, addr, len) getsockname((s), (addr), (len)) +#define sock_peer(s, addr, len) getpeername((s), (addr), (len)) +#define sock_ntohs(x) ntohs((x)) +#define sock_ntohl(x) ntohl((x)) +#define sock_htons(x) htons((x)) +#define sock_htonl(x) htonl((x)) +#define sock_send(s,buf,len,flag) send((s),(buf),(len),(flag)) +#define sock_sendv(s, vec, size, np, flag) \ + WSASend((s),(WSABUF*)(vec),\ + (size),(np),(flag),NULL,NULL) +#define sock_recv(s,buf,len,flag) recv((s),(buf),(len),(flag)) + +#define sock_recvfrom(s,buf,blen,flag,addr,alen) \ + recvfrom((s),(buf),(blen),(flag),(addr),(alen)) +#define sock_sendto(s,buf,blen,flag,addr,alen) \ + sendto((s),(buf),(blen),(flag),(addr),(alen)) +#define sock_hostname(buf, len) gethostname((buf), (len)) + +#define sock_getservbyname(name,proto) getservbyname((name),(proto)) +#define sock_getservbyport(port,proto) getservbyport((port),(proto)) + +#define sock_errno() WSAGetLastError() +#define sock_create_event(d) WSACreateEvent() +#define sock_close_event(e) WSACloseEvent(e) + +#define sock_select(D, Flags, OnOff) winsock_event_select(D, Flags, OnOff) + +#define SET_BLOCKING(s) ioctlsocket(s, FIONBIO, &zero_value) +#define SET_NONBLOCKING(s) ioctlsocket(s, FIONBIO, &one_value) + + +static unsigned long zero_value = 0; +static unsigned long one_value = 1; + +#else + +#ifdef VXWORKS +#include +#include +#include +#include +#include +#include +#else +#include +#ifdef NETDB_H_NEEDS_IN_H +#include +#endif +#include +#endif + +#ifndef _OSE_ +#include +#include +#else +/* datatypes and macros from Solaris socket.h */ +struct linger { + int l_onoff; /* option on/off */ + int l_linger; /* linger time */ +}; +#define SO_OOBINLINE 0x0100 /* leave received OOB data in line */ +#define SO_LINGER 0x0080 /* linger on close if data present */ +#endif + +#ifdef VXWORKS +#include +#endif +#ifdef DEF_INADDR_LOOPBACK_IN_RPC_TYPES_H +#include +#endif + +#ifndef _OSE_ +#include +#include +#endif + +#if (!defined(VXWORKS) && !defined(_OSE_)) +#include +#ifdef HAVE_ARPA_NAMESER_H +#include +#endif +#endif + +#ifdef HAVE_SYS_SOCKIO_H +#include +#endif + +#ifdef HAVE_SYS_IOCTL_H +#include +#endif + +#ifndef _OSE_ +#include +#else +#define IFF_MULTICAST 0x00000800 +#endif + +#ifdef _OSE_ +#include "inet.h" +#include "ineterr.h" +#include "ose_inet_drv.h" +#include "nameser.h" +#include "resolv.h" +#define SET_ASYNC(s) setsockopt((s), SOL_SOCKET, SO_OSEEVENT, (&(s)), sizeof(int)) + +extern void select_release(void); + +#endif /* _OSE_ */ + +/* Solaris headers, only to be used with SFK */ +#ifdef _OSE_SFK_ +#include +#include +#endif + +/* SCTP support -- currently for UNIX platforms only: */ +#undef HAVE_SCTP +#if (!defined(VXWORKS) && !defined(_OSE_) && !defined(__WIN32__) && defined(HAVE_SCTP_H)) + +#include + +/* SCTP Socket API Draft from version 11 on specifies that netinet/sctp.h must + explicitly define HAVE_SCTP in case when SCTP is supported, but Solaris 10 + still apparently uses Draft 10, and does not define that symbol, so we have + to define it explicitly: +*/ +#ifndef HAVE_SCTP +# define HAVE_SCTP +#endif + +/* These changed in draft 11, so SOLARIS10 uses the old MSG_* */ +#if ! HAVE_DECL_SCTP_UNORDERED +# define SCTP_UNORDERED MSG_UNORDERED +#endif +#if ! HAVE_DECL_SCTP_ADDR_OVER +# define SCTP_ADDR_OVER MSG_ADDR_OVER +#endif +#if ! HAVE_DECL_SCTP_ABORT +# define SCTP_ABORT MSG_ABORT +#endif +#if ! HAVE_DECL_SCTP_EOF +# define SCTP_EOF MSG_EOF +#endif + +/* New spelling in lksctp 2.6.22 or maybe even earlier: + * adaption -> adaptation + */ +#if !defined(SCTP_ADAPTATION_LAYER) && defined (SCTP_ADAPTION_LAYER) +# define SCTP_ADAPTATION_LAYER SCTP_ADAPTION_LAYER +# define SCTP_ADAPTATION_INDICATION SCTP_ADAPTION_INDICATION +# define sctp_adaptation_event sctp_adaption_event +# define sctp_setadaptation sctp_setadaption +# define sn_adaptation_event sn_adaption_event +# define sai_adaptation_ind sai_adaption_ind +# define ssb_adaptation_ind ssb_adaption_ind +# define sctp_adaptation_layer_event sctp_adaption_layer_event +#endif + +static void *h_libsctp = NULL; +#ifdef __GNUC__ +static typeof(sctp_bindx) *p_sctp_bindx = NULL; +#else +static int (*p_sctp_bindx)(int sd, struct sockaddr *addrs, + int addrcnt, int flags) = NULL; +#endif + +#endif /* SCTP supported */ + +#ifndef WANT_NONBLOCKING +#define WANT_NONBLOCKING +#endif +#include "sys.h" + +/* #define INET_DRV_DEBUG 1 */ +#ifdef INET_DRV_DEBUG +#define DEBUG 1 +#undef DEBUGF +#define DEBUGF(X) printf X +#endif + +#if !defined(__WIN32__) && !defined(HAVE_STRNCASECMP) +#define STRNCASECMP my_strncasecmp + +static int my_strncasecmp(const char *s1, const char *s2, size_t n) +{ + int i; + + for (i=0;is) /* return file descriptor */ +#define sock_close_event(e) /* do nothing */ + +#ifdef _OSE_ +#define inet_driver_select(port, e, mode, on) \ + ose_inet_select(port, e, mode, on) +#else +#define inet_driver_select(port, e, mode, on) \ + driver_select(port, e, mode | (on?ERL_DRV_USE:0), on) +#endif /* _OSE_ */ + +#define sock_select(d, flags, onoff) do { \ + (d)->event_mask = (onoff) ? \ + ((d)->event_mask | (flags)) : \ + ((d)->event_mask & ~(flags)); \ + DEBUGF(("sock_select(%ld): flags=%02X, onoff=%d, event_mask=%02lX\r\n", \ + (long) (d)->port, (flags), (onoff), (unsigned long) (d)->event_mask)); \ + inet_driver_select((d)->port, (ErlDrvEvent)(long)(d)->event, (flags), (onoff)); \ + } while(0) + + +#endif /* __WIN32__ */ + +#include "packet_parser.h" + +#define get_int24(s) ((((unsigned char*) (s))[0] << 16) | \ + (((unsigned char*) (s))[1] << 8) | \ + (((unsigned char*) (s))[2])) + +#define get_little_int32(s) ((((unsigned char*) (s))[3] << 24) | \ + (((unsigned char*) (s))[2] << 16) | \ + (((unsigned char*) (s))[1] << 8) | \ + (((unsigned char*) (s))[0])) + +/*---------------------------------------------------------------------------- +** Interface constants. +** +** This section must be "identical" to the corresponding inet_int.hrl +*/ + +/* general address encode/decode tag */ +#define INET_AF_INET 1 +#define INET_AF_INET6 2 +#define INET_AF_ANY 3 /* INADDR_ANY or IN6ADDR_ANY_INIT */ +#define INET_AF_LOOPBACK 4 /* INADDR_LOOPBACK or IN6ADDR_LOOPBACK_INIT */ + +/* INET_REQ_GETTYPE enumeration */ +#define INET_TYPE_STREAM 1 +#define INET_TYPE_DGRAM 2 +#define INET_TYPE_SEQPACKET 3 + +/* INET_LOPT_MODE options */ +#define INET_MODE_LIST 0 +#define INET_MODE_BINARY 1 + +/* INET_LOPT_DELIVER options */ +#define INET_DELIVER_PORT 0 +#define INET_DELIVER_TERM 1 + +/* INET_LOPT_ACTIVE options */ +#define INET_PASSIVE 0 /* false */ +#define INET_ACTIVE 1 /* true */ +#define INET_ONCE 2 /* true; active once then passive */ + +/* INET_REQ_GETSTATUS enumeration */ +#define INET_F_OPEN 0x0001 +#define INET_F_BOUND 0x0002 +#define INET_F_ACTIVE 0x0004 +#define INET_F_LISTEN 0x0008 +#define INET_F_CON 0x0010 +#define INET_F_ACC 0x0020 +#define INET_F_LST 0x0040 +#define INET_F_BUSY 0x0080 +#define INET_F_MULTI_CLIENT 0x0100 /* Multiple clients for one descriptor, i.e. multi-accept */ + +/* One numberspace for *_REC_* so if an e.g UDP request is issued +** for a TCP socket, the driver can protest. +*/ +#define INET_REQ_OPEN 1 +#define INET_REQ_CLOSE 2 +#define INET_REQ_CONNECT 3 +#define INET_REQ_PEER 4 +#define INET_REQ_NAME 5 +#define INET_REQ_BIND 6 +#define INET_REQ_SETOPTS 7 +#define INET_REQ_GETOPTS 8 +/* #define INET_REQ_GETIX 9 NOT USED ANY MORE */ +/* #define INET_REQ_GETIF 10 REPLACE BY NEW STUFF */ +#define INET_REQ_GETSTAT 11 +#define INET_REQ_GETHOSTNAME 12 +#define INET_REQ_FDOPEN 13 +#define INET_REQ_GETFD 14 +#define INET_REQ_GETTYPE 15 +#define INET_REQ_GETSTATUS 16 +#define INET_REQ_GETSERVBYNAME 17 +#define INET_REQ_GETSERVBYPORT 18 +#define INET_REQ_SETNAME 19 +#define INET_REQ_SETPEER 20 +#define INET_REQ_GETIFLIST 21 +#define INET_REQ_IFGET 22 +#define INET_REQ_IFSET 23 +#define INET_REQ_SUBSCRIBE 24 +/* TCP requests */ +#define TCP_REQ_ACCEPT 40 +#define TCP_REQ_LISTEN 41 +#define TCP_REQ_RECV 42 +#define TCP_REQ_UNRECV 43 +#define TCP_REQ_SHUTDOWN 44 +#define TCP_REQ_MULTI_OP 45 +/* UDP and SCTP requests */ +#define PACKET_REQ_RECV 60 /* Common for UDP and SCTP */ +#define SCTP_REQ_LISTEN 61 /* Different from TCP; not for UDP */ +#define SCTP_REQ_BINDX 62 /* Multi-home SCTP bind */ + +/* INET_REQ_SUBSCRIBE sub-requests */ +#define INET_SUBS_EMPTY_OUT_Q 1 + +/* TCP additional flags */ +#define TCP_ADDF_DELAY_SEND 1 +#define TCP_ADDF_CLOSE_SENT 2 /* Close sent (active mode only) */ +#define TCP_ADDF_DELAYED_CLOSE_RECV 4 /* If receive fails, report {error,closed} (passive mode) */ +#define TCP_ADDF_DELAYED_CLOSE_SEND 8 /* If send fails, report {error,closed} (passive mode) */ + +/* *_REQ_* replies */ +#define INET_REP_ERROR 0 +#define INET_REP_OK 1 +#define INET_REP_SCTP 2 + +/* INET_REQ_SETOPTS and INET_REQ_GETOPTS options */ +#define INET_OPT_REUSEADDR 0 /* enable/disable local address reuse */ +#define INET_OPT_KEEPALIVE 1 /* enable/disable keep connections alive */ +#define INET_OPT_DONTROUTE 2 /* enable/disable routing for messages */ +#define INET_OPT_LINGER 3 /* linger on close if data is present */ +#define INET_OPT_BROADCAST 4 /* enable/disable transmission of broadcast */ +#define INET_OPT_OOBINLINE 5 /* enable/disable out-of-band data in band */ +#define INET_OPT_SNDBUF 6 /* set send buffer size */ +#define INET_OPT_RCVBUF 7 /* set receive buffer size */ +#define INET_OPT_PRIORITY 8 /* set priority */ +#define INET_OPT_TOS 9 /* Set type of service */ +#define TCP_OPT_NODELAY 10 /* don't delay send to coalesce packets */ +#define UDP_OPT_MULTICAST_IF 11 /* set/get IP multicast interface */ +#define UDP_OPT_MULTICAST_TTL 12 /* set/get IP multicast timetolive */ +#define UDP_OPT_MULTICAST_LOOP 13 /* set/get IP multicast loopback */ +#define UDP_OPT_ADD_MEMBERSHIP 14 /* add an IP group membership */ +#define UDP_OPT_DROP_MEMBERSHIP 15 /* drop an IP group membership */ +/* LOPT is local options */ +#define INET_LOPT_BUFFER 20 /* min buffer size hint */ +#define INET_LOPT_HEADER 21 /* list header size */ +#define INET_LOPT_ACTIVE 22 /* enable/disable active receive */ +#define INET_LOPT_PACKET 23 /* packet header type (TCP) */ +#define INET_LOPT_MODE 24 /* list or binary mode */ +#define INET_LOPT_DELIVER 25 /* port or term delivery */ +#define INET_LOPT_EXITONCLOSE 26 /* exit port on active close or not ! */ +#define INET_LOPT_TCP_HIWTRMRK 27 /* set local high watermark */ +#define INET_LOPT_TCP_LOWTRMRK 28 /* set local low watermark */ +#define INET_LOPT_BIT8 29 /* set 8 bit detection */ +#define INET_LOPT_TCP_SEND_TIMEOUT 30 /* set send timeout */ +#define INET_LOPT_TCP_DELAY_SEND 31 /* Delay sends until next poll */ +#define INET_LOPT_PACKET_SIZE 32 /* Max packet size */ +#define INET_LOPT_UDP_READ_PACKETS 33 /* Number of packets to read */ +#define INET_OPT_RAW 34 /* Raw socket options */ +#define INET_LOPT_TCP_SEND_TIMEOUT_CLOSE 35 /* auto-close on send timeout or not */ +/* SCTP options: a separate range, from 100: */ +#define SCTP_OPT_RTOINFO 100 +#define SCTP_OPT_ASSOCINFO 101 +#define SCTP_OPT_INITMSG 102 +#define SCTP_OPT_AUTOCLOSE 103 +#define SCTP_OPT_NODELAY 104 +#define SCTP_OPT_DISABLE_FRAGMENTS 105 +#define SCTP_OPT_I_WANT_MAPPED_V4_ADDR 106 +#define SCTP_OPT_MAXSEG 107 +#define SCTP_OPT_SET_PEER_PRIMARY_ADDR 108 +#define SCTP_OPT_PRIMARY_ADDR 109 +#define SCTP_OPT_ADAPTATION_LAYER 110 +#define SCTP_OPT_PEER_ADDR_PARAMS 111 +#define SCTP_OPT_DEFAULT_SEND_PARAM 112 +#define SCTP_OPT_EVENTS 113 +#define SCTP_OPT_DELAYED_ACK_TIME 114 +#define SCTP_OPT_STATUS 115 +#define SCTP_OPT_GET_PEER_ADDR_INFO 116 + +/* INET_REQ_IFGET and INET_REQ_IFSET options */ +#define INET_IFOPT_ADDR 1 +#define INET_IFOPT_BROADADDR 2 +#define INET_IFOPT_DSTADDR 3 +#define INET_IFOPT_MTU 4 +#define INET_IFOPT_NETMASK 5 +#define INET_IFOPT_FLAGS 6 +#define INET_IFOPT_HWADDR 7 + +/* INET_LOPT_BIT8 options */ +#define INET_BIT8_CLEAR 0 +#define INET_BIT8_SET 1 +#define INET_BIT8_ON 2 +#define INET_BIT8_OFF 3 + +/* INET_REQ_GETSTAT enumeration */ +#define INET_STAT_RECV_CNT 1 +#define INET_STAT_RECV_MAX 2 +#define INET_STAT_RECV_AVG 3 +#define INET_STAT_RECV_DVI 4 +#define INET_STAT_SEND_CNT 5 +#define INET_STAT_SEND_MAX 6 +#define INET_STAT_SEND_AVG 7 +#define INET_STAT_SEND_PND 8 +#define INET_STAT_RECV_OCT 9 /* received octets */ +#define INET_STAT_SEND_OCT 10 /* sent octets */ + +/* INET_IFOPT_FLAGS enumeration */ +#define INET_IFF_UP 0x0001 +#define INET_IFF_BROADCAST 0x0002 +#define INET_IFF_LOOPBACK 0x0004 +#define INET_IFF_POINTTOPOINT 0x0008 +#define INET_IFF_RUNNING 0x0010 +#define INET_IFF_MULTICAST 0x0020 +/* Complement flags for turning them off */ +#define INET_IFF_DOWN 0x0100 +#define INET_IFF_NBROADCAST 0x0200 +/* #define INET_IFF_NLOOPBACK 0x0400 */ +#define INET_IFF_NPOINTTOPOINT 0x0800 +/* #define INET_IFF_NRUNNING 0x1000 */ +/* #define INET_IFF_NMULTICAST 0x2000 */ + +/* Flags for "sctp_sndrcvinfo". Used in a bitmask -- must be powers of 2: +** INET_REQ_SETOPTS:SCTP_OPT_DEFAULT_SEND_PARAM +*/ +#define SCTP_FLAG_UNORDERED (1 /* am_unordered */) +#define SCTP_FLAG_ADDR_OVER (2 /* am_addr_over */) +#define SCTP_FLAG_ABORT (4 /* am_abort */) +#define SCTP_FLAG_EOF (8 /* am_eof */) +#define SCTP_FLAG_SNDALL (16 /* am_sndall, NOT YET IMPLEMENTED */) + +/* Flags for "sctp_set_opts" (actually for SCTP_OPT_PEER_ADDR_PARAMS). +** These flags are also used in a bitmask, so they must be powers of 2: +*/ +#define SCTP_FLAG_HB_ENABLE (1 /* am_hb_enable */) +#define SCTP_FLAG_HB_DISABLE (2 /* am_hb_disable */) +#define SCTP_FLAG_HB_DEMAND (4 /* am_hb_demand */) +#define SCTP_FLAG_PMTUD_ENABLE (8 /* am_pmtud_enable */) +#define SCTP_FLAG_PMTUD_DISABLE (16 /* am_pmtud_disable */) +#define SCTP_FLAG_SACDELAY_ENABLE (32 /* am_sackdelay_enable */) +#define SCTP_FLAG_SACDELAY_DISABLE (64 /* am_sackdelay_disable */) + +/* +** End of interface constants. +**--------------------------------------------------------------------------*/ + +#define INET_STATE_CLOSED 0 +#define INET_STATE_OPEN (INET_F_OPEN) +#define INET_STATE_BOUND (INET_STATE_OPEN | INET_F_BOUND) +#define INET_STATE_CONNECTED (INET_STATE_BOUND | INET_F_ACTIVE) + +#define IS_OPEN(d) \ + (((d)->state & INET_F_OPEN) == INET_F_OPEN) + +#define IS_BOUND(d) \ + (((d)->state & INET_F_BOUND) == INET_F_BOUND) + +#define IS_CONNECTED(d) \ + (((d)->state & INET_STATE_CONNECTED) == INET_STATE_CONNECTED) + +#define IS_CONNECTING(d) \ + (((d)->state & INET_F_CON) == INET_F_CON) + +#define IS_BUSY(d) \ + (((d)->state & INET_F_BUSY) == INET_F_BUSY) + +#define INET_DEF_BUFFER 1460 /* default buffer size */ +#define INET_MIN_BUFFER 1 /* internal min buffer */ +#define INET_MAX_BUFFER (1024*64) /* internal max buffer */ + +/* Note: INET_HIGH_WATERMARK MUST be less than 2*INET_MAX_BUFFER */ +#define INET_HIGH_WATERMARK (1024*8) /* 8k pending high => busy */ +/* Note: INET_LOW_WATERMARK MUST be less than INET_MAX_BUFFER and +** less than INET_HIGH_WATERMARK +*/ +#define INET_LOW_WATERMARK (1024*4) /* 4k pending => allow more */ + +#define INET_INFINITY 0xffffffff /* infinity value */ + +#define INET_MAX_ASYNC 1 /* max number of async queue ops */ + +/* INET_LOPT_UDP_PACKETS */ +#define INET_PACKET_POLL 5 /* maximum number of packets to poll */ + +/* Max interface name */ +#define INET_IFNAMSIZ 16 + +/* Max length of Erlang Term Buffer (for outputting structured terms): */ +#ifdef HAVE_SCTP +#define PACKET_ERL_DRV_TERM_DATA_LEN 512 +#else +#define PACKET_ERL_DRV_TERM_DATA_LEN 32 +#endif + + +#define BIN_REALLOC_LIMIT(x) (((x)*3)/4) /* 75% */ + +/* The general purpose sockaddr */ +typedef union { + struct sockaddr sa; + struct sockaddr_in sai; +#ifdef HAVE_IN6 + struct sockaddr_in6 sai6; +#endif +} inet_address; + + +/* for AF_INET & AF_INET6 */ +#define inet_address_port(x) ((x)->sai.sin_port) + +#if defined(HAVE_IN6) && defined(AF_INET6) +#define addrlen(family) \ + ((family == AF_INET) ? sizeof(struct in_addr) : \ + ((family == AF_INET6) ? sizeof(struct in6_addr) : 0)) +#else +#define addrlen(family) \ + ((family == AF_INET) ? sizeof(struct in_addr) : 0) +#endif + +typedef struct _multi_timer_data { + ErlDrvNowData when; + ErlDrvTermData caller; + void (*timeout_function)(ErlDrvData drv_data, ErlDrvTermData caller); + struct _multi_timer_data *next; + struct _multi_timer_data *prev; +} MultiTimerData; + +static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, + ErlDrvTermData caller, unsigned timeout, + void (*timeout_fun)(ErlDrvData drv_data, + ErlDrvTermData caller)); +static void fire_multi_timers(MultiTimerData **first, ErlDrvPort port, + ErlDrvData data); +static void remove_multi_timer(MultiTimerData **first, ErlDrvPort port, MultiTimerData *p); + +static void tcp_inet_multi_timeout(ErlDrvData e, ErlDrvTermData caller); +static void clean_multi_timers(MultiTimerData **first, ErlDrvPort port); + +typedef struct { + int id; /* id used to identify reply */ + ErlDrvTermData caller; /* recipient of async reply */ + int req; /* Request id (CONNECT/ACCEPT/RECV) */ + union { + unsigned value; /* Request timeout (since op issued,not started) */ + MultiTimerData *mtd; + } tmo; + ErlDrvMonitor monitor; +} inet_async_op; + +typedef struct inet_async_multi_op_ { + inet_async_op op; + struct inet_async_multi_op_ *next; +} inet_async_multi_op; + + +typedef struct subs_list_ { + ErlDrvTermData subscriber; + struct subs_list_ *next; +} subs_list; + +#define NO_PROCESS 0 +#define NO_SUBSCRIBERS(SLP) ((SLP)->subscriber == NO_PROCESS) +static void send_to_subscribers(ErlDrvPort, subs_list *, int, + ErlDrvTermData [], int); +static void free_subscribers(subs_list*); +static int save_subscriber(subs_list *, ErlDrvTermData); + +typedef struct { + SOCKET s; /* the socket or INVALID_SOCKET if not open */ + HANDLE event; /* Event handle (same as s in unix) */ + long event_mask; /* current FD events */ +#ifdef __WIN32__ + long forced_events; /* Mask of events that are forcefully signalled + on windows see winsock_event_select + for details */ + int send_would_block; /* Last send attempt failed with "WOULDBLOCK" */ +#endif + ErlDrvPort port; /* the port identifier */ + ErlDrvTermData dport; /* the port identifier as DriverTermData */ + int state; /* status */ + int prebound; /* only set when opened with inet_fdopen */ + int mode; /* BINARY | LIST + (affect how to interpret hsz) */ + int exitf; /* exit port on close or not */ + int bit8f; /* check if data has bit number 7 set */ + int deliver; /* Delivery mode, TERM or PORT */ + + ErlDrvTermData caller; /* recipient of sync reply */ + ErlDrvTermData busy_caller; /* recipient of sync reply when caller busy. + * Only valid while INET_F_BUSY. */ + + inet_async_op* oph; /* queue head or NULL */ + inet_async_op* opt; /* queue tail or NULL */ + inet_async_op op_queue[INET_MAX_ASYNC]; /* call queue */ + + int active; /* 0 = passive, 1 = active, 2 = active once */ + int stype; /* socket type: + SOCK_STREAM/SOCK_DGRAM/SOCK_SEQPACKET */ + int sprotocol; /* socket protocol: + IPPROTO_TCP|IPPROTO_UDP|IPPROTO_SCTP */ + int sfamily; /* address family */ + enum PacketParseType htype; /* header type (TCP only?) */ + unsigned int psize; /* max packet size (TCP only?) */ + int bit8; /* set if bit8f==true and data some data + seen had the 7th bit set */ + inet_address remote; /* remote address for connected sockets */ + inet_address peer_addr; /* fake peer address */ + inet_address name_addr; /* fake local address */ + + inet_address* peer_ptr; /* fake peername or NULL */ + inet_address* name_ptr; /* fake sockname or NULL */ + + int bufsz; /* minimum buffer constraint */ + unsigned int hsz; /* the list header size, -1 is large !!! */ + /* statistics */ + unsigned long recv_oct[2]; /* number of received octets >= 64 bits */ + unsigned long recv_cnt; /* number of packets received */ + unsigned long recv_max; /* maximum packet size received */ + double recv_avg; /* average packet size received */ + double recv_dvi; /* avarage deviation from avg_size */ + unsigned long send_oct[2]; /* number of octets sent >= 64 bits */ + unsigned long send_cnt; /* number of packets sent */ + unsigned long send_max; /* maximum packet send */ + double send_avg; /* average packet size sent */ + + subs_list empty_out_q_subs; /* Empty out queue subscribers */ +} inet_descriptor; + + + +#define TCP_STATE_CLOSED INET_STATE_CLOSED +#define TCP_STATE_OPEN (INET_F_OPEN) +#define TCP_STATE_BOUND (TCP_STATE_OPEN | INET_F_BOUND) +#define TCP_STATE_CONNECTED (TCP_STATE_BOUND | INET_F_ACTIVE) +#define TCP_STATE_LISTEN (TCP_STATE_BOUND | INET_F_LISTEN) +#define TCP_STATE_CONNECTING (TCP_STATE_BOUND | INET_F_CON) +#define TCP_STATE_ACCEPTING (TCP_STATE_LISTEN | INET_F_ACC) +#define TCP_STATE_MULTI_ACCEPTING (TCP_STATE_ACCEPTING | INET_F_MULTI_CLIENT) + + +#define TCP_MAX_PACKET_SIZE 0x4000000 /* 64 M */ + +#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O + * vector sock_sendv(). + */ + +static int tcp_inet_init(void); +static void tcp_inet_stop(ErlDrvData); +static void tcp_inet_command(ErlDrvData, char*, int); +static void tcp_inet_commandv(ErlDrvData, ErlIOVec*); +static void tcp_inet_flush(ErlDrvData drv_data); +static void tcp_inet_drv_input(ErlDrvData, ErlDrvEvent); +static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event); +static ErlDrvData tcp_inet_start(ErlDrvPort, char* command); +static int tcp_inet_ctl(ErlDrvData, unsigned int, char*, int, char**, int); +static void tcp_inet_timeout(ErlDrvData); +static void tcp_inet_process_exit(ErlDrvData, ErlDrvMonitor *); +static void inet_stop_select(ErlDrvEvent, void*); +#ifdef __WIN32__ +static void tcp_inet_event(ErlDrvData, ErlDrvEvent); +static void find_dynamic_functions(void); +#endif + +static struct erl_drv_entry tcp_inet_driver_entry = +{ + tcp_inet_init, /* inet_init will add this driver !! */ + tcp_inet_start, + tcp_inet_stop, + tcp_inet_command, +#ifdef __WIN32__ + tcp_inet_event, + NULL, +#else + tcp_inet_drv_input, + tcp_inet_drv_output, +#endif + "tcp_inet", + NULL, + NULL, + tcp_inet_ctl, + tcp_inet_timeout, + tcp_inet_commandv, + NULL, + tcp_inet_flush, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING|ERL_DRV_FLAG_SOFT_BUSY, + NULL, + tcp_inet_process_exit, + inet_stop_select +}; + +#define PACKET_STATE_CLOSED INET_STATE_CLOSED +#define PACKET_STATE_OPEN (INET_F_OPEN) +#define PACKET_STATE_BOUND (PACKET_STATE_OPEN | INET_F_BOUND) +#define SCTP_STATE_LISTEN (PACKET_STATE_BOUND | INET_F_LISTEN) +#define SCTP_STATE_CONNECTING (PACKET_STATE_BOUND | INET_F_CON) +#define PACKET_STATE_CONNECTED (PACKET_STATE_BOUND | INET_F_ACTIVE) + + +static int packet_inet_init(void); +static void packet_inet_stop(ErlDrvData); +static void packet_inet_command(ErlDrvData, char*, int); +static void packet_inet_drv_input(ErlDrvData data, ErlDrvEvent event); +static void packet_inet_drv_output(ErlDrvData data, ErlDrvEvent event); +static ErlDrvData udp_inet_start(ErlDrvPort, char* command); +#ifdef HAVE_SCTP +static ErlDrvData sctp_inet_start(ErlDrvPort, char* command); +#endif +static int packet_inet_ctl(ErlDrvData, unsigned int, char*, + int, char**, int); +static void packet_inet_timeout(ErlDrvData); +#ifdef __WIN32__ +static void packet_inet_event(ErlDrvData, ErlDrvEvent); +static SOCKET make_noninheritable_handle(SOCKET s); +static int winsock_event_select(inet_descriptor *, int, int); +#endif + +static struct erl_drv_entry udp_inet_driver_entry = +{ + packet_inet_init, /* inet_init will add this driver !! */ + udp_inet_start, + packet_inet_stop, + packet_inet_command, +#ifdef __WIN32__ + packet_inet_event, + NULL, +#else + packet_inet_drv_input, + packet_inet_drv_output, +#endif + "udp_inet", + NULL, + NULL, + packet_inet_ctl, + packet_inet_timeout, + NULL, + NULL, + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL, + NULL, + inet_stop_select +}; + +#ifdef HAVE_SCTP +static struct erl_drv_entry sctp_inet_driver_entry = +{ + packet_inet_init, /* inet_init will add this driver !! */ + sctp_inet_start, + packet_inet_stop, + packet_inet_command, +#ifdef __WIN32__ + packet_inet_event, + NULL, +#else + packet_inet_drv_input, + packet_inet_drv_output, +#endif + "sctp_inet", + NULL, + NULL, + packet_inet_ctl, + packet_inet_timeout, + NULL, + NULL, + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL, + NULL, /* process_exit */ + inet_stop_select +}; +#endif + +typedef struct { + inet_descriptor inet; /* common data structure (DON'T MOVE) */ + int high; /* high watermark */ + int low; /* low watermark */ + int send_timeout; /* timeout to use in send */ + int send_timeout_close; /* auto-close socket on send_timeout */ + int busy_on_send; /* busy on send with timeout! */ + int i_bufsz; /* current input buffer size (<= bufsz) */ + ErlDrvBinary* i_buf; /* current binary buffer */ + char* i_ptr; /* current pos in buf */ + char* i_ptr_start; /* packet start pos in buf */ + int i_remain; /* remaining chars to read */ + int tcp_add_flags;/* Additional TCP descriptor flags */ + int http_state; /* 0 = response|request 1=headers fields */ + inet_async_multi_op *multi_first;/* NULL == no multi-accept-queue, op is in ordinary queue */ + inet_async_multi_op *multi_last; + MultiTimerData *mtd; /* Timer structures for multiple accept */ +} tcp_descriptor; + +/* send function */ +static int tcp_send(tcp_descriptor* desc, char* ptr, int len); +static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev); +static int tcp_recv(tcp_descriptor* desc, int request_len); +static int tcp_deliver(tcp_descriptor* desc, int len); + +static int tcp_inet_output(tcp_descriptor* desc, HANDLE event); +static int tcp_inet_input(tcp_descriptor* desc, HANDLE event); + +typedef struct { + inet_descriptor inet; /* common data structure (DON'T MOVE) */ + int read_packets; /* Number of packets to read per invocation */ +} udp_descriptor; + + +static int packet_inet_input(udp_descriptor* udesc, HANDLE event); +static int packet_inet_output(udp_descriptor* udesc, HANDLE event); + +/* convert descriptor poiner to inet_descriptor pointer */ +#define INETP(d) (&(d)->inet) + +static int async_ref = 0; /* async reference id generator */ +#define NEW_ASYNC_ID() ((async_ref++) & 0xffff) + + +static ErlDrvTermData am_ok; +static ErlDrvTermData am_tcp; +static ErlDrvTermData am_udp; +static ErlDrvTermData am_error; +static ErlDrvTermData am_inet_async; +static ErlDrvTermData am_inet_reply; +static ErlDrvTermData am_timeout; +static ErlDrvTermData am_closed; +static ErlDrvTermData am_tcp_closed; +static ErlDrvTermData am_tcp_error; +static ErlDrvTermData am_udp_error; +static ErlDrvTermData am_empty_out_q; +static ErlDrvTermData am_ssl_tls; +#ifdef HAVE_SCTP +static ErlDrvTermData am_sctp; +static ErlDrvTermData am_sctp_error; +static ErlDrvTermData am_true; +static ErlDrvTermData am_false; +static ErlDrvTermData am_buffer; +static ErlDrvTermData am_mode; +static ErlDrvTermData am_list; +static ErlDrvTermData am_binary; +static ErlDrvTermData am_active; +static ErlDrvTermData am_once; +static ErlDrvTermData am_buffer; +static ErlDrvTermData am_linger; +static ErlDrvTermData am_recbuf; +static ErlDrvTermData am_sndbuf; +static ErlDrvTermData am_reuseaddr; +static ErlDrvTermData am_dontroute; +static ErlDrvTermData am_priority; +static ErlDrvTermData am_tos; +#endif + +/* speical errors for bad ports and sequences */ +#define EXBADPORT "exbadport" +#define EXBADSEQ "exbadseq" + + +static int inet_init(void); +static int ctl_reply(int, char*, int, char**, int); + +struct erl_drv_entry inet_driver_entry = +{ + inet_init, /* inet_init will add TCP, UDP and SCTP drivers */ + NULL, /* start */ + NULL, /* stop */ + NULL, /* output */ + NULL, /* ready_input */ + NULL, /* ready_output */ + "inet" +}; + +/* XXX: is this a driver interface function ??? */ +extern void erl_exit(int n, char*, _DOTS_); + +/* + * Malloc wrapper, + * we would like to change the behaviour for different + * systems here. + */ + +#ifdef FATAL_MALLOC + +static void *alloc_wrapper(size_t size){ + void *ret = driver_alloc(size); + if(ret == NULL) + erl_exit(1,"Out of virtual memory in malloc (%s)", __FILE__); + return ret; +} +#define ALLOC(X) alloc_wrapper(X) + +static void *realloc_wrapper(void *current, size_t size){ + void *ret = driver_realloc(current,size); + if(ret == NULL) + erl_exit(1,"Out of virtual memory in realloc (%s)", __FILE__); + return ret; +} +#define REALLOC(X,Y) realloc_wrapper(X,Y) +#define FREE(P) driver_free((P)) +#else /* FATAL_MALLOC */ + +#define ALLOC(X) driver_alloc((X)) +#define REALLOC(X,Y) driver_realloc((X), (Y)) +#define FREE(P) driver_free((P)) + +#endif /* FATAL_MALLOC */ + +#define INIT_ATOM(NAME) am_ ## NAME = driver_mk_atom(#NAME) + +#define LOAD_ATOM_CNT 2 +#define LOAD_ATOM(vec, i, atom) \ + (((vec)[(i)] = ERL_DRV_ATOM), \ + ((vec)[(i)+1] = (atom)), \ + ((i)+LOAD_ATOM_CNT)) + +#define LOAD_INT_CNT 2 +#define LOAD_INT(vec, i, val) \ + (((vec)[(i)] = ERL_DRV_INT), \ + ((vec)[(i)+1] = (ErlDrvTermData)(val)), \ + ((i)+LOAD_INT_CNT)) + +#define LOAD_UINT_CNT 2 +#define LOAD_UINT(vec, i, val) \ + (((vec)[(i)] = ERL_DRV_UINT), \ + ((vec)[(i)+1] = (ErlDrvTermData)(val)), \ + ((i)+LOAD_UINT_CNT)) + +#define LOAD_PORT_CNT 2 +#define LOAD_PORT(vec, i, port) \ + (((vec)[(i)] = ERL_DRV_PORT), \ + ((vec)[(i)+1] = (port)), \ + ((i)+LOAD_PORT_CNT)) + +#define LOAD_PID_CNT 2 +#define LOAD_PID(vec, i, pid) \ + (((vec)[(i)] = ERL_DRV_PID), \ + ((vec)[(i)+1] = (pid)), \ + ((i)+LOAD_PID_CNT)) + +#define LOAD_BINARY_CNT 4 +#define LOAD_BINARY(vec, i, bin, offs, len) \ + (((vec)[(i)] = ERL_DRV_BINARY), \ + ((vec)[(i)+1] = (ErlDrvTermData)(bin)), \ + ((vec)[(i)+2] = (len)), \ + ((vec)[(i)+3] = (offs)), \ + ((i)+LOAD_BINARY_CNT)) + +#define LOAD_BUF2BINARY_CNT 3 +#define LOAD_BUF2BINARY(vec, i, buf, len) \ + (((vec)[(i)] = ERL_DRV_BUF2BINARY), \ + ((vec)[(i)+1] = (ErlDrvTermData)(buf)), \ + ((vec)[(i)+2] = (len)), \ + ((i)+LOAD_BUF2BINARY_CNT)) + +#define LOAD_STRING_CNT 3 +#define LOAD_STRING(vec, i, str, len) \ + (((vec)[(i)] = ERL_DRV_STRING), \ + ((vec)[(i)+1] = (ErlDrvTermData)(str)), \ + ((vec)[(i)+2] = (len)), \ + ((i)+LOAD_STRING_CNT)) + +#define LOAD_STRING_CONS_CNT 3 +#define LOAD_STRING_CONS(vec, i, str, len) \ + (((vec)[(i)] = ERL_DRV_STRING_CONS), \ + ((vec)[(i)+1] = (ErlDrvTermData)(str)), \ + ((vec)[(i)+2] = (len)), \ + ((i)+LOAD_STRING_CONS_CNT)) + +#define LOAD_TUPLE_CNT 2 +#define LOAD_TUPLE(vec, i, size) \ + (((vec)[(i)] = ERL_DRV_TUPLE), \ + ((vec)[(i)+1] = (size)), \ + ((i)+LOAD_TUPLE_CNT)) + +#define LOAD_NIL_CNT 1 +#define LOAD_NIL(vec, i) \ + (((vec)[(i)] = ERL_DRV_NIL), \ + ((i)+LOAD_NIL_CNT)) + +#define LOAD_LIST_CNT 2 +#define LOAD_LIST(vec, i, size) \ + (((vec)[(i)] = ERL_DRV_LIST), \ + ((vec)[(i)+1] = (size)), \ + ((i)+LOAD_LIST_CNT)) + + +#ifdef HAVE_SCTP + /* "IS_SCTP": tells the difference between a UDP and an SCTP socket: */ +# define IS_SCTP(desc)((desc)->sprotocol==IPPROTO_SCTP) + + /* For AssocID, 4 bytes should be enough -- checked by "init": */ +# define GET_ASSOC_ID get_int32 +# define ASSOC_ID_LEN 4 +# define LOAD_ASSOC_ID LOAD_INT +# define LOAD_ASSOC_ID_CNT LOAD_INT_CNT +# define SCTP_ANC_BUFF_SIZE INET_DEF_BUFFER/2 /* XXX: not very good... */ +#endif + +static int load_ip_port(ErlDrvTermData* spec, int i, char* buf) +{ + spec[i++] = ERL_DRV_INT; + spec[i++] = (ErlDrvTermData) get_int16(buf); + return i; +} + +static int load_ip_address(ErlDrvTermData* spec, int i, int family, char* buf) +{ + int n; + if (family == AF_INET) { + for (n = 0; n < 4; n++) { + spec[i++] = ERL_DRV_INT; + spec[i++] = (ErlDrvTermData) ((unsigned char)buf[n]); + } + spec[i++] = ERL_DRV_TUPLE; + spec[i++] = 4; + } +#if defined(HAVE_IN6) && defined(AF_INET6) + else if (family == AF_INET6) { + for (n = 0; n < 16; n += 2) { + spec[i++] = ERL_DRV_INT; + spec[i++] = (ErlDrvTermData) get_int16(buf+n); + } + spec[i++] = ERL_DRV_TUPLE; + spec[i++] = 8; + } +#endif + else { + spec[i++] = ERL_DRV_TUPLE; + spec[i++] = 0; + } + return i; +} + + +#ifdef HAVE_SCTP +/* For SCTP, we often need to return {IP, Port} tuples: */ +static int inet_get_address + (int family, char* dst, inet_address* src, unsigned int* len); + +#define LOAD_IP_AND_PORT_CNT \ + (8*LOAD_INT_CNT + LOAD_TUPLE_CNT + LOAD_INT_CNT + LOAD_TUPLE_CNT) + +static int load_ip_and_port + (ErlDrvTermData* spec, int i, inet_descriptor* desc, + struct sockaddr_storage* addr) +{ + /* The size of the buffer used to stringify the addr is the same as + that of "sockaddr_storage" itself: only their layout is different: + */ + unsigned int len = sizeof(struct sockaddr_storage); + unsigned int alen = len; + char abuf [len]; + int res = + inet_get_address(desc->sfamily, abuf, (inet_address*) addr, &alen); + ASSERT(res==0); + res = 0; + /* Now "abuf" contains: Family(1b), Port(2b), IP(4|16b) */ + + /* NB: the following functions are safe to use, as they create tuples + of copied Ints on the "spec", and do not install any String pts -- + a ptr to "abuf" would be dangling upon exiting this function: */ + i = load_ip_address(spec, i, desc->sfamily, abuf+3); + i = load_ip_port (spec, i, abuf+1); + i = LOAD_TUPLE (spec, i, 2); + return i; +} + +/* Loading Boolean flags as Atoms: */ +#define LOAD_BOOL_CNT LOAD_ATOM_CNT +#define LOAD_BOOL(spec, i, flag) \ + LOAD_ATOM((spec), (i), (flag) ? am_true : am_false); +#endif /* HAVE_SCTP */ + +/* +** Binary Buffer Managment +** We keep a stack of usable buffers +*/ +#define BUFFER_STACK_SIZE 16 + +static erts_smp_spinlock_t inet_buffer_stack_lock; +static ErlDrvBinary* buffer_stack[BUFFER_STACK_SIZE]; +static int buffer_stack_pos = 0; + + +/* + * XXX + * The erts_smp_spin_* functions should not be used by drivers (but this + * driver is special). Replace when driver locking api has been implemented. + * /rickard + */ +#define BUFSTK_LOCK erts_smp_spin_lock(&inet_buffer_stack_lock); +#define BUFSTK_UNLOCK erts_smp_spin_unlock(&inet_buffer_stack_lock); + +#ifdef DEBUG +static int tot_buf_allocated = 0; /* memory in use for i_buf */ +static int tot_buf_stacked = 0; /* memory on stack */ +static int max_buf_allocated = 0; /* max allocated */ + +#define COUNT_BUF_ALLOC(sz) do { \ + BUFSTK_LOCK; \ + tot_buf_allocated += (sz); \ + if (tot_buf_allocated > max_buf_allocated) \ + max_buf_allocated = tot_buf_allocated; \ + BUFSTK_UNLOCK; \ +} while(0) + +#define COUNT_BUF_FREE(sz) do { \ + BUFSTK_LOCK; \ + tot_buf_allocated -= (sz); \ + BUFSTK_UNLOCK; \ + } while(0) + +#define COUNT_BUF_STACK(sz) do { \ + BUFSTK_LOCK; \ + tot_buf_stacked += (sz); \ + BUFSTK_UNLOCK; \ + } while(0) + +#else + +#define COUNT_BUF_ALLOC(sz) +#define COUNT_BUF_FREE(sz) +#define COUNT_BUF_STACK(sz) + +#endif + +static ErlDrvBinary* alloc_buffer(long minsz) +{ + ErlDrvBinary* buf = NULL; + + BUFSTK_LOCK; + + DEBUGF(("alloc_buffer: sz = %ld, tot = %d, max = %d\r\n", + minsz, tot_buf_allocated, max_buf_allocated)); + + if (buffer_stack_pos > 0) { + int origsz; + + buf = buffer_stack[--buffer_stack_pos]; + origsz = buf->orig_size; + BUFSTK_UNLOCK; + COUNT_BUF_STACK(-origsz); + if (origsz < minsz) { + if ((buf = driver_realloc_binary(buf, minsz)) == NULL) + return NULL; + COUNT_BUF_ALLOC(buf->orig_size - origsz); + } + } + else { + BUFSTK_UNLOCK; + if ((buf = driver_alloc_binary(minsz)) == NULL) + return NULL; + COUNT_BUF_ALLOC(buf->orig_size); + } + return buf; +} + +/* +** Max buffer memory "cached" BUFFER_STACK_SIZE * INET_MAX_BUFFER +** (16 * 64k ~ 1M) +*/ +/*#define CHECK_DOUBLE_RELEASE 1*/ +static void release_buffer(ErlDrvBinary* buf) +{ + DEBUGF(("release_buffer: %ld\r\n", (buf==NULL) ? 0 : buf->orig_size)); + if (buf == NULL) + return; + BUFSTK_LOCK; + if ((buf->orig_size > INET_MAX_BUFFER) || + (buffer_stack_pos >= BUFFER_STACK_SIZE)) { + BUFSTK_UNLOCK; + COUNT_BUF_FREE(buf->orig_size); + driver_free_binary(buf); + } + else { +#ifdef CHECK_DOUBLE_RELEASE +#ifdef __GNUC__ +#warning CHECK_DOUBLE_RELEASE is enabled, this is a custom build emulator +#endif + int i; + for (i = 0; i < buffer_stack_pos; ++i) { + if (buffer_stack[i] == buf) { + erl_exit(1,"Multiple buffer release in inet_drv, this is a " + "bug, save the core and send it to " + "support@erlang.ericsson.se!"); + } + } +#endif + buffer_stack[buffer_stack_pos++] = buf; + BUFSTK_UNLOCK; + COUNT_BUF_STACK(buf->orig_size); + } +} + +static ErlDrvBinary* realloc_buffer(ErlDrvBinary* buf, long newsz) +{ + ErlDrvBinary* bin; +#ifdef DEBUG + long orig_size = buf->orig_size; +#endif + + if ((bin = driver_realloc_binary(buf,newsz)) != NULL) { + COUNT_BUF_ALLOC(newsz - orig_size); + ; + } + return bin; +} + +/* use a TRICK, access the refc field to see if any one else has + * a ref to this buffer then call driver_free_binary else + * release_buffer instead + */ +static void free_buffer(ErlDrvBinary* buf) +{ + DEBUGF(("free_buffer: %ld\r\n", (buf==NULL) ? 0 : buf->orig_size)); + + if (buf != NULL) { + if (driver_binary_get_refc(buf) == 1) + release_buffer(buf); + else { + COUNT_BUF_FREE(buf->orig_size); + driver_free_binary(buf); + } + } +} + + +#ifdef __WIN32__ + +static ErlDrvData dummy_start(ErlDrvPort port, char* command) +{ + return (ErlDrvData)port; +} + +static int dummy_ctl(ErlDrvData data, unsigned int cmd, char* buf, int len, + char** rbuf, int rsize) +{ + static char error[] = "no_winsock2"; + + driver_failure_atom((ErlDrvPort)data, error); + return ctl_reply(INET_REP_ERROR, error, sizeof(error), rbuf, rsize); +} + +static void dummy_command(ErlDrvData data, char* buf, int len) +{ +} + +static struct erl_drv_entry dummy_tcp_driver_entry = +{ + NULL, /* init */ + dummy_start, /* start */ + NULL, /* stop */ + dummy_command, /* command */ + NULL, /* input */ + NULL, /* output */ + "tcp_inet", /* name */ + NULL, + NULL, + dummy_ctl, + NULL, + NULL +}; + +static struct erl_drv_entry dummy_udp_driver_entry = +{ + NULL, /* init */ + dummy_start, /* start */ + NULL, /* stop */ + dummy_command, /* command */ + NULL, /* input */ + NULL, /* output */ + "udp_inet", /* name */ + NULL, + NULL, + dummy_ctl, + NULL, + NULL +}; + +#ifdef HAVE_SCTP +static struct erl_drv_entry dummy_sctp_driver_entry = +{ /* Though there is no SCTP for Win32 yet... */ + NULL, /* init */ + dummy_start, /* start */ + NULL, /* stop */ + dummy_command, /* command */ + NULL, /* input */ + NULL, /* output */ + "sctp_inet", /* name */ + NULL, + NULL, + dummy_ctl, + NULL, + NULL +}; +#endif + +#endif + +/* general control reply function */ +static int ctl_reply(int rep, char* buf, int len, char** rbuf, int rsize) +{ + char* ptr; + + if ((len+1) > rsize) { + ptr = ALLOC(len+1); + *rbuf = ptr; + } + else + ptr = *rbuf; + *ptr++ = rep; + memcpy(ptr, buf, len); + return len+1; +} + +/* general control error reply function */ +static int ctl_error(int err, char** rbuf, int rsize) +{ + char response[256]; /* Response buffer. */ + char* s; + char* t; + + for (s = erl_errno_id(err), t = response; *s; s++, t++) + *t = tolower(*s); + return ctl_reply(INET_REP_ERROR, response, t-response, rbuf, rsize); +} + +static int ctl_xerror(char* xerr, char** rbuf, int rsize) +{ + int n = strlen(xerr); + return ctl_reply(INET_REP_ERROR, xerr, n, rbuf, rsize); +} + + +static ErlDrvTermData error_atom(int err) +{ + char errstr[256]; + char* s; + char* t; + + for (s = erl_errno_id(err), t = errstr; *s; s++, t++) + *t = tolower(*s); + *t = '\0'; + return driver_mk_atom(errstr); +} + + +static void enq_old_multi_op(tcp_descriptor *desc, int id, int req, + ErlDrvTermData caller, MultiTimerData *timeout, + ErlDrvMonitor *monitorp) +{ + inet_async_multi_op *opp; + + opp = ALLOC(sizeof(inet_async_multi_op)); + + opp->op.id = id; + opp->op.caller = caller; + opp->op.req = req; + opp->op.tmo.mtd = timeout; + memcpy(&(opp->op.monitor), monitorp, sizeof(ErlDrvMonitor)); + opp->next = NULL; + + if (desc->multi_first == NULL) { + desc->multi_first = opp; + } else { + desc->multi_last->next = opp; + } + desc->multi_last = opp; +} + +static void enq_multi_op(tcp_descriptor *desc, char *buf, int req, + ErlDrvTermData caller, MultiTimerData *timeout, + ErlDrvMonitor *monitorp) +{ + int id = NEW_ASYNC_ID(); + enq_old_multi_op(desc,id,req,caller,timeout,monitorp); + if (buf != NULL) + put_int16(id, buf); +} + +static int deq_multi_op(tcp_descriptor *desc, int *id_p, int *req_p, + ErlDrvTermData *caller_p, MultiTimerData **timeout_p, + ErlDrvMonitor *monitorp) +{ + inet_async_multi_op *opp; + opp = desc->multi_first; + if (!opp) { + return -1; + } + desc->multi_first = opp->next; + if (desc->multi_first == NULL) { + desc->multi_last = NULL; + } + *id_p = opp->op.id; + *req_p = opp->op.req; + *caller_p = opp->op.caller; + if (timeout_p != NULL) { + *timeout_p = opp->op.tmo.mtd; + } + if (monitorp != NULL) { + memcpy(monitorp,&(opp->op.monitor),sizeof(ErlDrvMonitor)); + } + FREE(opp); + return 0; +} + +static int remove_multi_op(tcp_descriptor *desc, int *id_p, int *req_p, + ErlDrvTermData caller, MultiTimerData **timeout_p, + ErlDrvMonitor *monitorp) +{ + inet_async_multi_op *opp, *slap; + for (opp = desc->multi_first, slap = NULL; + opp != NULL && opp->op.caller != caller; + slap = opp, opp = opp->next) + ; + if (!opp) { + return -1; + } + if (slap == NULL) { + desc->multi_first = opp->next; + } else { + slap->next = opp->next; + } + if (desc->multi_last == opp) { + desc->multi_last = slap; + } + *id_p = opp->op.id; + *req_p = opp->op.req; + if (timeout_p != NULL) { + *timeout_p = opp->op.tmo.mtd; + } + if (monitorp != NULL) { + memcpy(monitorp,&(opp->op.monitor),sizeof(ErlDrvMonitor)); + } + FREE(opp); + return 0; +} + +/* setup a new async id + caller (format async_id into buf) */ + +static int enq_async_w_tmo(inet_descriptor* desc, char* buf, int req, unsigned timeout, + ErlDrvMonitor *monitorp) +{ + int id = NEW_ASYNC_ID(); + inet_async_op* opp; + + if ((opp = desc->oph) == NULL) /* queue empty */ + opp = desc->oph = desc->opt = desc->op_queue; + else if (desc->oph == desc->opt) { /* queue full */ + DEBUGF(("enq(%ld): queue full\r\n", (long)desc->port)); + return -1; + } + + opp->id = id; + opp->caller = driver_caller(desc->port); + opp->req = req; + opp->tmo.value = timeout; + if (monitorp != NULL) { + memcpy(&(opp->monitor),monitorp,sizeof(ErlDrvMonitor)); + } + + DEBUGF(("enq(%ld): %d %ld %d\r\n", + (long) desc->port, opp->id, opp->caller, opp->req)); + + opp++; + if (opp >= desc->op_queue + INET_MAX_ASYNC) + desc->oph = desc->op_queue; + else + desc->oph = opp; + + if (buf != NULL) + put_int16(id, buf); + return 0; +} + +static int enq_async(inet_descriptor* desc, char* buf, int req) +{ + return enq_async_w_tmo(desc,buf,req,INET_INFINITY, NULL); +} + +static int deq_async_w_tmo(inet_descriptor* desc, int* ap, ErlDrvTermData* cp, + int* rp, unsigned *tp, ErlDrvMonitor *monitorp) +{ + inet_async_op* opp; + + if ((opp = desc->opt) == NULL) { /* queue empty */ + DEBUGF(("deq(%ld): queue empty\r\n", (long)desc->port)); + return -1; + } + *ap = opp->id; + *cp = opp->caller; + *rp = opp->req; + if (tp != NULL) { + *tp = opp->tmo.value; + } + if (monitorp != NULL) { + memcpy(monitorp,&(opp->monitor),sizeof(ErlDrvMonitor)); + } + + DEBUGF(("deq(%ld): %d %ld %d\r\n", + (long)desc->port, opp->id, opp->caller, opp->req)); + + opp++; + if (opp >= desc->op_queue + INET_MAX_ASYNC) + desc->opt = desc->op_queue; + else + desc->opt = opp; + + if (desc->opt == desc->oph) + desc->opt = desc->oph = NULL; + return 0; +} + +static int deq_async(inet_descriptor* desc, int* ap, ErlDrvTermData* cp, int* rp) +{ + return deq_async_w_tmo(desc,ap,cp,rp,NULL,NULL); +} +/* send message: +** {inet_async, Port, Ref, ok} +*/ +static int +send_async_ok(ErlDrvPort port, ErlDrvTermData Port, int Ref, + ErlDrvTermData recipient) +{ + ErlDrvTermData spec[2*LOAD_ATOM_CNT + LOAD_PORT_CNT + + LOAD_INT_CNT + LOAD_TUPLE_CNT]; + int i = 0; + + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, Port); + i = LOAD_INT(spec, i, Ref); + i = LOAD_ATOM(spec, i, am_ok); + i = LOAD_TUPLE(spec, i, 4); + + ASSERT(i == sizeof(spec)/sizeof(*spec)); + + return driver_send_term(port, recipient, spec, i); +} + +/* send message: +** {inet_async, Port, Ref, {ok,Port2}} +*/ +static int +send_async_ok_port(ErlDrvPort port, ErlDrvTermData Port, int Ref, + ErlDrvTermData recipient, ErlDrvTermData Port2) +{ + ErlDrvTermData spec[2*LOAD_ATOM_CNT + 2*LOAD_PORT_CNT + + LOAD_INT_CNT + 2*LOAD_TUPLE_CNT]; + int i = 0; + + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, Port); + i = LOAD_INT(spec, i, Ref); + { + i = LOAD_ATOM(spec, i, am_ok); + i = LOAD_PORT(spec, i, Port2); + i = LOAD_TUPLE(spec, i, 2); + } + i = LOAD_TUPLE(spec, i, 4); + + ASSERT(i == sizeof(spec)/sizeof(*spec)); + + return driver_send_term(port, recipient, spec, i); +} + +/* send message: +** {inet_async, Port, Ref, {error,Reason}} +*/ +static int +send_async_error(ErlDrvPort port, ErlDrvTermData Port, int Ref, + ErlDrvTermData recipient, ErlDrvTermData Reason) +{ + ErlDrvTermData spec[3*LOAD_ATOM_CNT + LOAD_PORT_CNT + + LOAD_INT_CNT + 2*LOAD_TUPLE_CNT]; + int i = 0; + + i = 0; + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, Port); + i = LOAD_INT(spec, i, Ref); + { + i = LOAD_ATOM(spec, i, am_error); + i = LOAD_ATOM(spec, i, Reason); + i = LOAD_TUPLE(spec, i, 2); + } + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i == sizeof(spec)/sizeof(*spec)); + DEBUGF(("send_async_error %ld %ld\r\n", recipient, Reason)); + return driver_send_term(port, recipient, spec, i); +} + + +static int async_ok(inet_descriptor* desc) +{ + int req; + int aid; + ErlDrvTermData caller; + + if (deq_async(desc, &aid, &caller, &req) < 0) + return -1; + return send_async_ok(desc->port, desc->dport, aid, caller); +} + +static int async_ok_port(inet_descriptor* desc, ErlDrvTermData Port2) +{ + int req; + int aid; + ErlDrvTermData caller; + + if (deq_async(desc, &aid, &caller, &req) < 0) + return -1; + return send_async_ok_port(desc->port, desc->dport, aid, caller, Port2); +} + +static int async_error_am(inet_descriptor* desc, ErlDrvTermData reason) +{ + int req; + int aid; + ErlDrvTermData caller; + + if (deq_async(desc, &aid, &caller, &req) < 0) + return -1; + return send_async_error(desc->port, desc->dport, aid, caller, + reason); +} + +/* dequeue all operations */ +static int async_error_am_all(inet_descriptor* desc, ErlDrvTermData reason) +{ + int req; + int aid; + ErlDrvTermData caller; + + while (deq_async(desc, &aid, &caller, &req) == 0) { + send_async_error(desc->port, desc->dport, aid, caller, + reason); + } + return 0; +} + + +static int async_error(inet_descriptor* desc, int err) +{ + return async_error_am(desc, error_atom(err)); +} + +/* send: +** {inet_reply, S, ok} +*/ + +static int inet_reply_ok(inet_descriptor* desc) +{ + ErlDrvTermData spec[2*LOAD_ATOM_CNT + LOAD_PORT_CNT + LOAD_TUPLE_CNT]; + ErlDrvTermData caller = desc->caller; + int i = 0; + + i = LOAD_ATOM(spec, i, am_inet_reply); + i = LOAD_PORT(spec, i, desc->dport); + i = LOAD_ATOM(spec, i, am_ok); + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i == sizeof(spec)/sizeof(*spec)); + + desc->caller = 0; + return driver_send_term(desc->port, caller, spec, i); +} + +/* send: +** {inet_reply, S, {error, Reason}} +*/ +static int inet_reply_error_am(inet_descriptor* desc, ErlDrvTermData reason) +{ + ErlDrvTermData spec[3*LOAD_ATOM_CNT + LOAD_PORT_CNT + 2*LOAD_TUPLE_CNT]; + ErlDrvTermData caller = desc->caller; + int i = 0; + + i = LOAD_ATOM(spec, i, am_inet_reply); + i = LOAD_PORT(spec, i, desc->dport); + i = LOAD_ATOM(spec, i, am_error); + i = LOAD_ATOM(spec, i, reason); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i == sizeof(spec)/sizeof(*spec)); + desc->caller = 0; + + DEBUGF(("inet_reply_error_am %ld %ld\r\n", caller, reason)); + return driver_send_term(desc->port, caller, spec, i); +} + +/* send: +** {inet_reply, S, {error, Reason}} +*/ +static int inet_reply_error(inet_descriptor* desc, int err) +{ + return inet_reply_error_am(desc, error_atom(err)); +} + +/* +** Deliver port data from buffer +*/ +static int inet_port_data(inet_descriptor* desc, const char* buf, int len) +{ + unsigned int hsz = desc->hsz; + + DEBUGF(("inet_port_data(%ld): len = %d\r\n", (long)desc->port, len)); + + if ((desc->mode == INET_MODE_LIST) || (hsz > len)) + return driver_output2(desc->port, (char*)buf, len, NULL, 0); + else if (hsz > 0) + return driver_output2(desc->port, (char*)buf, hsz, (char*)buf+hsz, len-hsz); + else + return driver_output(desc->port, (char*)buf, len); +} + +/* +** Deliver port data from binary (for an active mode socket) +*/ +static int +inet_port_binary_data(inet_descriptor* desc, ErlDrvBinary* bin, int offs, int len) +{ + unsigned int hsz = desc->hsz; + + DEBUGF(("inet_port_binary_data(%ld): offs=%d, len = %d\r\n", + (long)desc->port, offs, len)); + + if ((desc->mode == INET_MODE_LIST) || (hsz > len)) + return driver_output2(desc->port, bin->orig_bytes+offs, len, NULL, 0); + else + return driver_output_binary(desc->port, bin->orig_bytes+offs, hsz, + bin, offs+hsz, len-hsz); +} + +static ErlDrvTermData am_http_eoh; +static ErlDrvTermData am_http_header; +static ErlDrvTermData am_http_request; +static ErlDrvTermData am_http_response; +static ErlDrvTermData am_http_error; +static ErlDrvTermData am_abs_path; +static ErlDrvTermData am_absoluteURI; +static ErlDrvTermData am_star; +static ErlDrvTermData am_undefined; +static ErlDrvTermData am_http; +static ErlDrvTermData am_https; +static ErlDrvTermData am_scheme; + +static int http_load_string(tcp_descriptor* desc, ErlDrvTermData* spec, int i, + const char* str, int len) +{ + if (desc->inet.htype >= TCP_PB_HTTP_BIN) { + ASSERT(desc->inet.htype == TCP_PB_HTTP_BIN || + desc->inet.htype == TCP_PB_HTTPH_BIN); + i = LOAD_BUF2BINARY(spec, i, str, len); + } else { + i = LOAD_STRING(spec, i, str, len); + } + return i; +} + +static int http_response_inetdrv(void *arg, int major, int minor, + int status, const char* phrase, int phrase_len) +{ + tcp_descriptor* desc = (tcp_descriptor*) arg; + int i = 0; + ErlDrvTermData spec[27]; + ErlDrvTermData caller; + + if (desc->inet.active == INET_PASSIVE) { + /* {inet_async,S,Ref,{ok,{http_response,Version,Status,Phrase}}} */ + int req; + int aid; + + if (deq_async(INETP(desc), &aid, &caller, &req) < 0) + return -1; + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_INT(spec, i, aid); + i = LOAD_ATOM(spec, i, am_ok); + } + else { + /* {http, S, {http_response,Version,Status,Phrase}} */ + i = LOAD_ATOM(spec, i, am_http); + i = LOAD_PORT(spec, i, desc->inet.dport); + } + i = LOAD_ATOM(spec, i, am_http_response); + i = LOAD_INT(spec, i, major); + i = LOAD_INT(spec, i, minor); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_INT(spec, i, status); + i = http_load_string(desc, spec, i, phrase, phrase_len); + i = LOAD_TUPLE(spec, i, 4); + + if (desc->inet.active == INET_PASSIVE) { + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i<=27); + return driver_send_term(desc->inet.port, caller, spec, i); + } + else { + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i<=27); + return driver_output_term(desc->inet.port, spec, i); + } +} + +static int http_load_uri(tcp_descriptor* desc, ErlDrvTermData* spec, int i, + const PacketHttpURI* uri) +{ + ErlDrvTermData scheme; + + switch (uri->type) { + case URI_STAR: + i = LOAD_ATOM(spec, i, am_star); + break; + case URI_ABS_PATH: + i = LOAD_ATOM(spec, i, am_abs_path); + i = http_load_string(desc, spec, i, uri->s1_ptr, uri->s1_len); + i = LOAD_TUPLE(spec, i, 2); + break; + case URI_HTTP: + scheme = am_http; + goto http_common; + case URI_HTTPS: + scheme = am_https; + http_common: + i = LOAD_ATOM(spec, i, am_absoluteURI); + i = LOAD_ATOM(spec, i, scheme); + i = http_load_string(desc, spec, i, uri->s1_ptr, uri->s1_len); + if (uri->port == 0) { + i = LOAD_ATOM(spec, i, am_undefined); + } else { + i = LOAD_INT(spec, i, uri->port); + } + i = http_load_string(desc, spec, i, uri->s2_ptr, uri->s2_len); + i = LOAD_TUPLE(spec, i, 5); + break; + + case URI_STRING: + i = http_load_string(desc, spec, i, uri->s1_ptr, uri->s1_len); + break; + case URI_SCHEME: + i = LOAD_ATOM(spec, i, am_scheme); + i = http_load_string(desc, spec, i, uri->s1_ptr, uri->s1_len); + i = http_load_string(desc, spec, i, uri->s2_ptr, uri->s2_len); + i = LOAD_TUPLE(spec, i, 3); + } + return i; +} + + +static int +http_request_inetdrv(void* arg, const http_atom_t* meth, const char* meth_ptr, + int meth_len, const PacketHttpURI* uri, + int major, int minor) +{ + tcp_descriptor* desc = (tcp_descriptor*) arg; + int i = 0; + ErlDrvTermData spec[43]; + ErlDrvTermData caller; + + if (desc->inet.active == INET_PASSIVE) { + /* {inet_async, S, Ref, {ok,{http_request,Meth,Uri,Version}}} */ + int req; + int aid; + + if (deq_async(INETP(desc), &aid, &caller, &req) < 0) + return -1; + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_INT(spec, i, aid); + i = LOAD_ATOM(spec, i, am_ok); + } + else { + /* {http, S, {http_request,Meth,Uri,Version}}} */ + i = LOAD_ATOM(spec, i, am_http); + i = LOAD_PORT(spec, i, desc->inet.dport); + } + + i = LOAD_ATOM(spec, i, am_http_request); + if (meth != NULL) + i = LOAD_ATOM(spec, i, meth->atom); + else + i = http_load_string(desc, spec, i, meth_ptr, meth_len); + i = http_load_uri(desc, spec, i, uri); + i = LOAD_INT(spec, i, major); + i = LOAD_INT(spec, i, minor); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + + if (desc->inet.active == INET_PASSIVE) { + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i <= 43); + return driver_send_term(desc->inet.port, caller, spec, i); + } + else { + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i <= 43); + return driver_output_term(desc->inet.port, spec, i); + } +} + +static int +http_header_inetdrv(void* arg, const http_atom_t* name, const char* name_ptr, + int name_len, const char* value_ptr, int value_len) +{ + tcp_descriptor* desc = (tcp_descriptor*) arg; + int i = 0; + ErlDrvTermData spec[26]; + ErlDrvTermData caller; + + if (desc->inet.active == INET_PASSIVE) { + /* {inet_async,S,Ref,{ok,{http_header,Bit,Name,IValue,Value}} */ + int req; + int aid; + + + if (deq_async(INETP(desc), &aid, &caller, &req) < 0) + return -1; + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_INT(spec, i, aid); + i = LOAD_ATOM(spec, i, am_ok); + } + else { + /* {http, S, {http_header,Bit,Name,IValue,Value}} */ + i = LOAD_ATOM(spec, i, am_http); + i = LOAD_PORT(spec, i, desc->inet.dport); + } + + i = LOAD_ATOM(spec, i, am_http_header); + if (name != NULL) { + i = LOAD_INT(spec, i, name->index+1); + i = LOAD_ATOM(spec, i, name->atom); + } + else { + i = LOAD_INT(spec, i, 0); + i = http_load_string(desc, spec, i, name_ptr, name_len); + } + i = LOAD_ATOM(spec, i, am_undefined); + i = http_load_string(desc, spec, i, value_ptr, value_len); + i = LOAD_TUPLE(spec, i, 5); + + if (desc->inet.active == INET_PASSIVE) { + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i <= 26); + return driver_send_term(desc->inet.port, caller, spec, i); + } + else { + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i <= 26); + return driver_output_term(desc->inet.port, spec, i); + } +} + +static int http_eoh_inetdrv(void* arg) +{ + tcp_descriptor* desc = (tcp_descriptor*) arg; + int i = 0; + ErlDrvTermData spec[14]; + + if (desc->inet.active == INET_PASSIVE) { + /* {inet_async,S,Ref,{ok,http_eoh}} */ + int req; + int aid; + ErlDrvTermData caller; + + if (deq_async(INETP(desc), &aid, &caller, &req) < 0) + return -1; + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_INT(spec, i, aid); + i = LOAD_ATOM(spec, i, am_ok); + i = LOAD_ATOM(spec, i, am_http_eoh); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i <= 14); + return driver_send_term(desc->inet.port, caller, spec, i); + } + else { + /* {http, S, http_eoh} */ + i = LOAD_ATOM(spec, i, am_http); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_ATOM(spec, i, am_http_eoh); + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i <= 14); + return driver_output_term(desc->inet.port, spec, i); + } +} + +static int http_error_inetdrv(void* arg, const char* buf, int len) +{ + tcp_descriptor* desc = (tcp_descriptor*) arg; + int i = 0; + ErlDrvTermData spec[19]; + + if (desc->inet.active == INET_PASSIVE) { + /* {inet_async,S,Ref,{error,{http_error,Line}}} */ + int req; + int aid; + ErlDrvTermData caller; + + if (deq_async(INETP(desc), &aid, &caller, &req) < 0) + return -1; + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_INT(spec, i, aid); + i = LOAD_ATOM(spec, i, am_error); + i = LOAD_ATOM(spec, i, am_http_error); + i = http_load_string(desc, spec, i, buf, len); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i <= 19); + return driver_send_term(desc->inet.port, caller, spec, i); + } + else { + /* {http, S, {http_error,Line} */ + i = LOAD_ATOM(spec, i, am_http); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_ATOM(spec, i, am_http_error); + i = http_load_string(desc, spec, i, buf, len); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i <= 19); + return driver_output_term(desc->inet.port, spec, i); + } +} + + +static +int ssl_tls_inetdrv(void* arg, unsigned type, unsigned major, unsigned minor, + const char* buf, int len, const char* prefix, int plen) +{ + tcp_descriptor* desc = (tcp_descriptor*) arg; + int i = 0; + ErlDrvTermData spec[28]; + ErlDrvTermData caller; + ErlDrvBinary* bin; + int ret; + + if ((bin = driver_alloc_binary(plen+len)) == NULL) + return async_error(&desc->inet, ENOMEM); + memcpy(bin->orig_bytes+plen, buf, len); + if (plen) { + memcpy(bin->orig_bytes, prefix, plen); + len += plen; + } + + if (desc->inet.active == INET_PASSIVE) { + /* {inet_async,S,Ref,{ok,{ssl_tls,...}}} */ + int req; + int aid; + + if (deq_async(INETP(desc), &aid, &caller, &req) < 0) { + ret = -1; + goto done; + } + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_INT(spec, i, aid); + i = LOAD_ATOM(spec, i, am_ok); + } + + /* {ssl_tls,S,ContentType,{Major,Minor},Bin} */ + i = LOAD_ATOM(spec, i, am_ssl_tls); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_INT(spec, i, type); + i = LOAD_INT(spec, i, major); + i = LOAD_INT(spec, i, minor); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_BINARY(spec, i, bin, 0, len); + i = LOAD_TUPLE(spec, i, 5); + + if (desc->inet.active == INET_PASSIVE) { + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i <= 28); + ret = driver_send_term(desc->inet.port, caller, spec, i); + } + else { + ASSERT(i <= 28); + ret = driver_output_term(desc->inet.port, spec, i); + } +done: + driver_free_binary(bin); + return ret; +} + + +static PacketCallbacks packet_callbacks = +{ + http_response_inetdrv, + http_request_inetdrv, + http_eoh_inetdrv, + http_header_inetdrv, + http_error_inetdrv, + ssl_tls_inetdrv +}; + + +/* +** passive mode reply: +** {inet_async, S, Ref, {ok,[H1,...Hsz | Data]}} +** NB: this is for TCP only; +** UDP and SCTP use inet_async_binary_data . +*/ +static int inet_async_data(inet_descriptor* desc, const char* buf, int len) +{ + unsigned int hsz = desc->hsz; + ErlDrvTermData spec[20]; + ErlDrvTermData caller; + int req; + int aid; + int i = 0; + + DEBUGF(("inet_async_data(%ld): len = %d\r\n", (long)desc->port, len)); + + if (deq_async(desc, &aid, &caller, &req) < 0) + return -1; + + i = LOAD_ATOM(spec, i, am_inet_async); + i = LOAD_PORT(spec, i, desc->dport); + i = LOAD_INT(spec, i, aid); + + i = LOAD_ATOM(spec, i, am_ok); + if ((desc->mode == INET_MODE_LIST) || (hsz > len)) { + i = LOAD_STRING(spec, i, buf, len); /* => [H1,H2,...Hn] */ + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i == 15); + desc->caller = 0; + return driver_send_term(desc->port, caller, spec, i); + } + else { + /* INET_MODE_BINARY => [H1,H2,...HSz | Binary] */ + int sz = len - hsz; + int code; + + i = LOAD_BUF2BINARY(spec, i, buf+hsz, sz); + if (hsz > 0) + i = LOAD_STRING_CONS(spec, i, buf, hsz); + i = LOAD_TUPLE(spec, i, 2); + i = LOAD_TUPLE(spec, i, 4); + ASSERT(i <= 20); + desc->caller = 0; + code = driver_send_term(desc->port, caller, spec, i); + return code; + } +} + +#ifdef HAVE_SCTP +/* +** SCTP-related atoms: +*/ +static ErlDrvTermData am_sctp_rtoinfo, /* Option names */ + am_sctp_associnfo, am_sctp_initmsg, + am_sctp_autoclose, am_sctp_nodelay, + am_sctp_disable_fragments, am_sctp_i_want_mapped_v4_addr, + am_sctp_maxseg, am_sctp_set_peer_primary_addr, + am_sctp_primary_addr, am_sctp_adaptation_layer, + am_sctp_peer_addr_params, am_sctp_default_send_param, + am_sctp_events, am_sctp_delayed_ack_time, + am_sctp_status, am_sctp_get_peer_addr_info, + + /* Record names */ + am_sctp_sndrcvinfo, am_sctp_assoc_change, + am_sctp_paddr_change, am_sctp_remote_error, + am_sctp_send_failed, am_sctp_shutdown_event, + am_sctp_adaptation_event, am_sctp_pdapi_event, + am_sctp_assocparams, am_sctp_prim, + am_sctp_setpeerprim, am_sctp_setadaptation, + am_sctp_paddrparams, am_sctp_event_subscribe, + am_sctp_assoc_value, am_sctp_paddrinfo, + + /* For #sctp_sndrcvinfo{}: */ + am_unordered, am_addr_over, + am_abort, am_eof, + + /* For #sctp_assoc_change{}: */ + am_comm_up, am_comm_lost, + am_restart, am_shutdown_comp, + am_cant_assoc, + + /* For #sctp_paddr_change{}: */ + am_addr_available, am_addr_unreachable, + am_addr_removed, am_addr_added, + am_addr_made_prim, am_addr_confirmed, + + /* For #sctp_remote_error{}: */ + am_short_recv, am_wrong_anc_data, + + /* For #sctp_pdap_event{}: */ + am_partial_delivery_aborted, + + /* For #sctp_paddrparams{}: */ + am_hb_enable, am_hb_disable, + am_hb_demand, am_pmtud_enable, + am_pmtud_disable, am_sackdelay_enable, + am_sackdelay_disable, + + /* For #sctp_paddrinfo{}: */ + am_active, am_inactive, + + /* For #sctp_status{}: */ + am_empty, am_closed, + am_cookie_wait, am_cookie_echoed, + am_established, am_shutdown_pending, + am_shutdown_sent, am_shutdown_received, + am_shutdown_ack_sent; + /* Not yet implemented in the Linux kernel: + ** am_bound, am_listen; + */ + +/* +** Parsing of "sctp_sndrcvinfo": ancillary data coming with received msgs. +** This function is mainly used by "sctp_parse_ancillary_data", but also +** by "sctp_parse_async_event" in case of SCTP_SEND_FAILED: +*/ +#define SCTP_PARSE_SNDRCVINFO_CNT \ + (5*LOAD_ATOM_CNT + 5*LOAD_INT_CNT + 2*LOAD_UINT_CNT + \ + LOAD_NIL_CNT + LOAD_LIST_CNT + LOAD_ASSOC_ID_CNT + LOAD_TUPLE_CNT) +static int sctp_parse_sndrcvinfo + (ErlDrvTermData * spec, int i, struct sctp_sndrcvinfo * sri) +{ + int n; + + i = LOAD_ATOM (spec, i, am_sctp_sndrcvinfo); + i = LOAD_INT (spec, i, sri->sinfo_stream); + i = LOAD_INT (spec, i, sri->sinfo_ssn); + /* Now Flags, as a list: */ + n = 0; + if (sri->sinfo_flags & SCTP_UNORDERED) + { i = LOAD_ATOM (spec, i, am_unordered); n++; } + + if (sri->sinfo_flags & SCTP_ADDR_OVER) + { i = LOAD_ATOM (spec, i, am_addr_over); n++; } + + if (sri->sinfo_flags & SCTP_ABORT) + { i = LOAD_ATOM (spec, i, am_abort); n++; } + + if (sri->sinfo_flags & SCTP_EOF) + { i = LOAD_ATOM (spec, i, am_eof); n++; } + + /* SCTP_SENDALL is not yet supported by the Linux kernel */ + i = LOAD_NIL (spec, i); + i = LOAD_LIST (spec, i, n+1); + + /* Continue with other top-level fields: */ + i = LOAD_INT (spec, i, sock_ntohl(sri->sinfo_ppid)); + i = LOAD_INT (spec, i, sri->sinfo_context); + i = LOAD_INT (spec, i, sri->sinfo_timetolive); + i = LOAD_UINT (spec, i, sri->sinfo_tsn); + i = LOAD_UINT (spec, i, sri->sinfo_cumtsn); + i = LOAD_ASSOC_ID (spec, i, sri->sinfo_assoc_id); + + /* Close up the record: */ + i = LOAD_TUPLE (spec, i, 10); + return i; +} + +/* +** This function skips non-SCTP ancillary data, returns SCTP-specific anc.data +** (currently "sctp_sndrcvinfo" only) as a list of records: +*/ +static int sctp_parse_ancillary_data + (ErlDrvTermData * spec, int i, struct msghdr * mptr) +{ + /* First of all, check for ancillary data: */ + struct cmsghdr * cmsg, * frst_msg = CMSG_FIRSTHDR(mptr); + int s = 0; + for (cmsg = frst_msg; cmsg != NULL; cmsg = CMSG_NXTHDR(mptr,cmsg)) + { + struct sctp_sndrcvinfo * sri; + + /* Skip other possible ancillary data, e.g. from IPv6: */ + if (cmsg->cmsg_level != IPPROTO_SCTP || + cmsg->cmsg_type != SCTP_SNDRCV) + continue; + + if (((char*)cmsg + cmsg->cmsg_len) - (char*)frst_msg > + mptr->msg_controllen) + /* MUST check this in Linux -- the returned "cmsg" may actually + go too far! */ + break; + + /* The ONLY kind of ancillary SCTP data which can occur on receiving + is "sctp_sndrcvinfo" (on sending, "sctp_initmsg" can be specified + by the user). So parse this type: + */ + sri = (struct sctp_sndrcvinfo*) CMSG_DATA(cmsg); + i = sctp_parse_sndrcvinfo (spec, i, sri); + s ++; + } + /* Now make the list of tuples created above. Normally, it will be [] or + a singleton list. The list must first be closed with NIL, otherwise + traversing it in Erlang would be problematic: + */ + i = LOAD_NIL (spec, i); + i = LOAD_LIST(spec, i, s+1); + return i; +} + +/* +** Parsing of ERROR and ABORT SCTP chunks. The function returns a list of error +** causes (as atoms). The chunks also contain some extended cause info, but it +** is not very detailed anyway, and of no interest at the user level (it only +** concerns the protocol implementation), so we omit it: +*/ +static int sctp_parse_error_chunk + (ErlDrvTermData * spec, int i, char * chunk, int chlen) +{ + /* The "chunk" itself contains its length, which must not be greater than + the "chlen" derived from the over-all msg size: + */ + char *causes, *cause; + int coff, /* Cause offset */ + ccode, /* Cause code */ + clen, /* cause length */ + s; + int len = sock_ntohs (*((uint16_t*)(chunk+2))); + ASSERT(len >= 4 && len <= chlen); + + causes = chunk + 4; + coff = 0; + len -= 4; /* Total length of the "causes" fields */ + cause = causes; + s = 0; + + while (coff < len) + { + ccode = sock_ntohs (*((uint16_t*)(cause))); + clen = sock_ntohs (*((uint16_t*)(cause + 2))); + if (clen <= 0) + /* Strange, but must guard against that! */ + break; + + /* Install the corresp atom for this "ccode": */ + i = LOAD_INT (spec, i, ccode); + cause += clen; + coff += clen; + s ++; + } + i = LOAD_NIL (spec, i); + i = LOAD_LIST(spec, i, s+1); + return i; +} + +/* +** Parsing of SCTP notification events. NB: they are NOT ancillary data: they +** are sent IN PLACE OF, not in conjunction with, the normal data: +*/ +static int sctp_parse_async_event + (ErlDrvTermData * spec, int i, int ok_pos, + ErlDrvTermData error_atom, inet_descriptor* desc, + ErlDrvBinary * bin, int offs, int sz) +{ + char* body = bin->orig_bytes + offs; + union sctp_notification * nptr = (union sctp_notification *) body; + + switch (nptr->sn_header.sn_type) + { + case SCTP_ASSOC_CHANGE: + { /* {sctp_assoc_change, + State : Atom(), + Error : Atom(), + OutBoundStreams : Int(), + InBoundStreams : Int(), + AssocID : Int(), + // AbortCauses : [Atom()] // NOT YET IMPLEMENTED + } + */ + struct sctp_assoc_change* sptr = &(nptr->sn_assoc_change); + ASSERT(sptr->sac_length <= sz); /* No buffer overrun */ + + i = LOAD_ATOM (spec, i, am_sctp_assoc_change); + + switch (sptr->sac_state) + { + case SCTP_COMM_UP: + i = LOAD_ATOM (spec, i, am_comm_up); + break; + case SCTP_COMM_LOST: + i = LOAD_ATOM (spec, i, am_comm_lost); + break; + case SCTP_RESTART: + i = LOAD_ATOM (spec, i, am_restart); + break; + case SCTP_SHUTDOWN_COMP: + i = LOAD_ATOM (spec, i, am_shutdown_comp); + break; + case SCTP_CANT_STR_ASSOC: + i = LOAD_ATOM (spec, i, am_cant_assoc); + break; + default: + ASSERT(0); + } + i = LOAD_INT (spec, i, sptr->sac_error); + i = LOAD_INT (spec, i, sptr->sac_outbound_streams); + i = LOAD_INT (spec, i, sptr->sac_inbound_streams); + i = LOAD_INT (spec, i, sptr->sac_assoc_id); + + /* The ABORT chunk may or may not be present at the end, depending + on whether there was really an ABORT. In the Linux Kernel SCTP + implementation, this chunk is not delivered anyway, so we leave + it out. Just close up the tuple: + */ + i = LOAD_TUPLE (spec, i, 6); + break; + } + + case SCTP_PEER_ADDR_CHANGE: + { /* {sctp_paddr_change, + AffectedAddr : String(), + State : Atom(), + Error : Atom(), + AssocID : Int() + } + */ + struct sctp_paddr_change* sptr = &(nptr->sn_paddr_change); + ASSERT(sptr->spc_length <= sz); /* No buffer overrun */ + + i = LOAD_ATOM (spec, i, am_sctp_paddr_change); + i = load_ip_and_port(spec, i, desc, &sptr->spc_aaddr); + + switch (sptr->spc_state) + { + case SCTP_ADDR_AVAILABLE: + i = LOAD_ATOM (spec, i, am_addr_available); + break; + case SCTP_ADDR_UNREACHABLE: + i = LOAD_ATOM (spec, i, am_addr_unreachable); + break; + case SCTP_ADDR_REMOVED: + i = LOAD_ATOM (spec, i, am_addr_removed); + break; + case SCTP_ADDR_ADDED: + i = LOAD_ATOM (spec, i, am_addr_added); + break; + case SCTP_ADDR_MADE_PRIM: + i = LOAD_ATOM (spec, i, am_addr_made_prim); + break; +#if HAVE_DECL_SCTP_ADDR_CONFIRMED + case SCTP_ADDR_CONFIRMED: + i = LOAD_ATOM (spec, i, am_addr_confirmed); + break; +#endif + default: + ASSERT(0); + } + i = LOAD_INT (spec, i, sptr->spc_error); + i = LOAD_INT (spec, i, sptr->spc_assoc_id); + i = LOAD_TUPLE (spec, i, 5); + break; + } + + case SCTP_REMOTE_ERROR: + { /* This is an error condition, so we return an error term + {sctp_remote_error, + Error : Int(), + AssocID : Int(), + RemoteCauses : [Atom()] // Remote Error flags + } + */ + char *chunk; + int chlen; + struct sctp_remote_error * sptr = &(nptr->sn_remote_error); + ASSERT(sptr->sre_length <= sz); /* No buffer overrun */ + + /* Over-write the prev part of the response with an error: */ + (void)LOAD_ATOM(spec, ok_pos, error_atom); + + /* Continue from the curr pos: */ + i = LOAD_ATOM (spec, i, am_sctp_remote_error); + + i = LOAD_INT (spec, i, sock_ntohs(sptr->sre_error)); + i = LOAD_INT (spec, i, sptr->sre_assoc_id); + +# ifdef HAVE_STRUCT_SCTP_REMOTE_ERROR_SRE_DATA + chunk = (char*) (&(sptr->sre_data)); +# else + chunk = ((char*)sptr) + sizeof(*sptr); +# endif + chlen = sptr->sre_length - (chunk - (char *)sptr); + i = sctp_parse_error_chunk(spec, i, chunk, chlen); + + i = LOAD_TUPLE (spec, i, 4); + /* The {error, {...}} will be closed by the caller */ + break; + } + + case SCTP_SEND_FAILED: + { /* {sctp_send_failed, + DataSent : Atom() // true or false + Error : Atom(), + OrigInfo : Tuple(), + AssocID : Int(), + OrigData : Binary() + } + This is also an ERROR condition -- overwrite the 'ok': + */ + char *chunk; + int chlen, choff; + struct sctp_send_failed * sptr = &(nptr->sn_send_failed); + ASSERT(sptr->ssf_length <= sz); /* No buffer overrun */ + + /* Over-write 'ok' with 'error', continue from curr "i": */ + (void)LOAD_ATOM(spec, ok_pos, error_atom); + + i = LOAD_ATOM (spec, i, am_sctp_send_failed); + switch (sptr->ssf_flags) { + case SCTP_DATA_SENT: + i = LOAD_ATOM (spec, i, am_true); + break; + case SCTP_DATA_UNSENT: + i = LOAD_ATOM (spec, i, am_false); + break; + default: + ASSERT(0); + } + i = LOAD_INT (spec, i, sptr->ssf_error); + /* Now parse the orig SCTP_SNDRCV info */ + i = sctp_parse_sndrcvinfo (spec, i, &sptr->ssf_info); + i = LOAD_ASSOC_ID (spec, i, sptr->ssf_assoc_id); + + /* Load the orig data chunk, as an unparsed binary. Note that + in LOAD_BINARY below, we must specify the offset wrt bin-> + orig_bytes. In Solaris 10, we don't have ssf_data: + */ +# ifdef HAVE_STRUCT_SCTP_SEND_FAILED_SSF_DATA + chunk = (char*) (&(sptr->ssf_data)); +# else + chunk = ((char*)sptr) + sizeof(*sptr); +# endif + chlen = sptr->ssf_length - (chunk - (char*) sptr); + choff = chunk - bin->orig_bytes; + + i = LOAD_BINARY(spec, i, bin, choff, chlen); + i = LOAD_TUPLE (spec, i, 6); + /* The {error, {...}} tuple is not yet closed */ + break; + } + + case SCTP_SHUTDOWN_EVENT: + { /* {sctp_shutdown_event, + AssocID : Int() + } + */ + struct sctp_shutdown_event * sptr = &(nptr->sn_shutdown_event); + + ASSERT (sptr->sse_length == sizeof(struct sctp_shutdown_event) && + sptr->sse_length <= sz); /* No buffer overrun */ + + i = LOAD_ATOM (spec, i, am_sctp_shutdown_event); + i = LOAD_INT (spec, i, sptr->sse_assoc_id); + i = LOAD_TUPLE (spec, i, 2); + break; + } + + case SCTP_ADAPTATION_INDICATION: + { /* {sctp_adaptation_event, + Indication : Atom(), + AssocID : Int() + } + */ + struct sctp_adaptation_event * sptr = + &(nptr->sn_adaptation_event); + ASSERT (sptr->sai_length == sizeof(struct sctp_adaptation_event) + && sptr->sai_length <= sz); /* No buffer overrun */ + + i = LOAD_ATOM (spec, i, am_sctp_adaptation_event); + i = LOAD_INT (spec, i, sock_ntohl(sptr->sai_adaptation_ind)); + i = LOAD_INT (spec, i, sptr->sai_assoc_id); + i = LOAD_TUPLE (spec, i, 3); + break; + } + + case SCTP_PARTIAL_DELIVERY_EVENT: + { /* It is not clear whether this event is sent to the sender + (when the receiver gets only a part of a message), or to + the receiver itself. In any case, we do not support partial + delivery of msgs in this implementation, so this is an error + condition: + {sctp_pdapi_event, sctp_partial_delivery_aborted, AssocID}: + */ + struct sctp_pdapi_event * sptr; + (void) LOAD_ATOM (spec, ok_pos, error_atom); + + sptr = &(nptr->sn_pdapi_event); + ASSERT (sptr->pdapi_length == sizeof(struct sctp_pdapi_event) && + sptr->pdapi_length <= sz); /* No buffer overrun */ + + i = LOAD_ATOM (spec, i, am_sctp_pdapi_event); + + /* Currently, there is only one indication possible: */ + ASSERT (sptr->pdapi_indication == SCTP_PARTIAL_DELIVERY_ABORTED); + + i = LOAD_ATOM (spec, i, am_partial_delivery_aborted); + i = LOAD_INT (spec, i, sptr->pdapi_assoc_id); + i = LOAD_TUPLE (spec, i, 3); + /* The {error, {...}} tuple is not yet closed */ + break; + } + + /* XXX: No more supported SCTP Event types. The standard also provides + SCTP_AUTHENTICATION_EVENT, but it is not implemented in the Linux + kernel, hence not supported here either. It is not possible to + request delivery of such events in this implementation, so they + cannot occur: + */ + default: ASSERT(0); + } + return i; +} +#endif /* HAVE_SCTP */ + +/* +** passive mode reply: +** for UDP: +** {inet_async, S, Ref, {ok, Data=[H1,...,Hsz | BinData]}} +** or (in the list mode) +** {inet_async, S, Ref, {ok, Data=[H1,...,Hsz]}} +** +** for SCTP: +** {inet_async, S, Ref, {ok, {[H1,...,HSz], [AncilData], Data_OR_Event}}} +** where each AncilDatum:Tuple(); +** Data:List() or Binary(), but if List(), then without the Addr part, +** which is moved in front; +** Event:Tuple(); +** or +** {inet_async, S, Ref, {error, {[H1,...,HSz], [AncilData], ErrorTerm}}} +** +** Cf: the output of send_async_error() is +** {inet_async, S, Ref, {error, Cause:Atom()}} +*/ +static int +inet_async_binary_data + (inet_descriptor* desc, unsigned int phsz, + ErlDrvBinary * bin, int offs, int len, void * extra) +{ + unsigned int hsz = desc->hsz + phsz; + ErlDrvTermData spec [PACKET_ERL_DRV_TERM_DATA_LEN]; + ErlDrvTermData caller = desc->caller; + int aid; + int req; + int i = 0; +#ifdef HAVE_SCTP + int ok_pos; +#endif + + DEBUGF(("inet_async_binary_data(%ld): offs=%d, len=%d\r\n", + (long)desc->port, offs, len)); + + if (deq_async(desc, &aid, &caller, &req) < 0) + return -1; + + i = LOAD_ATOM(spec, i, am_inet_async); /* 'inet_async' */ + i = LOAD_PORT(spec, i, desc->dport); /* S */ + i = LOAD_INT (spec, i, aid); /* Ref */ + +#ifdef HAVE_SCTP + /* Need to memoise the position of the 'ok' atom written, as it may + later be overridden by an 'error': */ + ok_pos = i; +#endif + i = LOAD_ATOM(spec, i, am_ok); + +#ifdef HAVE_SCTP + if (IS_SCTP(desc)) + { /* For SCTP we always have desc->hsz==0 (i.e., no application-level + headers are used), so hsz==phsz (see above): */ + struct msghdr* mptr; + int sz; + + ASSERT (hsz == phsz && hsz != 0); + sz = len - hsz; /* Size of the msg data proper, w/o the addr */ + + /* We always put the Addr as a list in front */ + i = LOAD_STRING(spec, i, bin->orig_bytes+offs, hsz); + + /* Put in the list (possibly empty) of Ancillary Data: */ + mptr = (struct msghdr *) extra; + i = sctp_parse_ancillary_data (spec, i, mptr); + + /* Then: Data or Event (Notification)? */ + if (mptr->msg_flags & MSG_NOTIFICATION) + /* This is an Event, parse it. It may indicate a normal or an error + condition; in the latter case, the 'ok' above is overridden by + an 'error', and the Event we receive contains the error term: */ + i = sctp_parse_async_event + (spec, i, ok_pos, am_error, desc, bin, offs+hsz, sz); + else + /* This is SCTP data, not a notification event. The data can be + returned as a List or as a Binary, similar to the generic case: + */ + if (desc->mode == INET_MODE_LIST) + /* INET_MODE_LIST => [H1,H2,...Hn], addr and data together, + butthe Addr has already been parsed, so start at offs+hsz: + */ + i = LOAD_STRING(spec, i, bin->orig_bytes+offs+hsz, sz); + else + /* INET_MODE_BINARY => Binary */ + i = LOAD_BINARY(spec, i, bin, offs+hsz, sz); + + /* Close up the {[H1,...,HSz], [AncilData], Event_OR_Data} tuple. This + is valid even in the case when Event is a error notification: */ + i = LOAD_TUPLE (spec, i, 3); + } + else +#endif /* HAVE_SCTP */ + /* Generic case. Both Addr and Data (or a single list of them together) are + returned: */ + + if ((desc->mode == INET_MODE_LIST) || (hsz > len)) { + /* INET_MODE_LIST => [H1,H2,...Hn] */ + i = LOAD_STRING(spec, i, bin->orig_bytes+offs, len); + } + else { + /* INET_MODE_BINARY => [H1,H2,...HSz | Binary] or [Binary]: */ + int sz = len - hsz; + i = LOAD_BINARY(spec, i, bin, offs+hsz, sz); + if (hsz > 0) + i = LOAD_STRING_CONS(spec, i, bin->orig_bytes+offs, hsz); + } + /* Close up the {ok, ...} or {error, ...} tuple: */ + i = LOAD_TUPLE(spec, i, 2); + + /* Close up the outer {inet_async, S, Ref, {ok|error, ...}} tuple: */ + i = LOAD_TUPLE(spec, i, 4); + + ASSERT(i <= PACKET_ERL_DRV_TERM_DATA_LEN); + desc->caller = 0; + return driver_send_term(desc->port, caller, spec, i); +} + +/* +** active mode message: +** {tcp, S, [H1,...Hsz | Data]} +*/ +static int tcp_message(inet_descriptor* desc, const char* buf, int len) +{ + unsigned int hsz = desc->hsz; + ErlDrvTermData spec[20]; + int i = 0; + + DEBUGF(("tcp_message(%ld): len = %d\r\n", (long)desc->port, len)); + + i = LOAD_ATOM(spec, i, am_tcp); + i = LOAD_PORT(spec, i, desc->dport); + + if ((desc->mode == INET_MODE_LIST) || (hsz > len)) { + i = LOAD_STRING(spec, i, buf, len); /* => [H1,H2,...Hn] */ + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i <= 20); + return driver_output_term(desc->port, spec, i); + } + else { + /* INET_MODE_BINARY => [H1,H2,...HSz | Binary] */ + int sz = len - hsz; + int code; + + i = LOAD_BUF2BINARY(spec, i, buf+hsz, sz); + if (hsz > 0) + i = LOAD_STRING_CONS(spec, i, buf, hsz); + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i <= 20); + code = driver_output_term(desc->port, spec, i); + return code; + } +} + +/* +** active mode message: +** {tcp, S, [H1,...Hsz | Data]} +*/ +static int +tcp_binary_message(inet_descriptor* desc, ErlDrvBinary* bin, int offs, int len) +{ + unsigned int hsz = desc->hsz; + ErlDrvTermData spec[20]; + int i = 0; + + DEBUGF(("tcp_binary_message(%ld): len = %d\r\n", (long)desc->port, len)); + + i = LOAD_ATOM(spec, i, am_tcp); + i = LOAD_PORT(spec, i, desc->dport); + + if ((desc->mode == INET_MODE_LIST) || (hsz > len)) { + /* INET_MODE_LIST => [H1,H2,...Hn] */ + i = LOAD_STRING(spec, i, bin->orig_bytes+offs, len); + } + else { + /* INET_MODE_BINARY => [H1,H2,...HSz | Binary] */ + int sz = len - hsz; + + i = LOAD_BINARY(spec, i, bin, offs+hsz, sz); + if (hsz > 0) + i = LOAD_STRING_CONS(spec, i, bin->orig_bytes+offs, hsz); + } + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i <= 20); + return driver_output_term(desc->port, spec, i); +} + +/* +** send: active mode {tcp_closed, S} +*/ +static int tcp_closed_message(tcp_descriptor* desc) +{ + ErlDrvTermData spec[6]; + int i = 0; + + DEBUGF(("tcp_closed_message(%ld):\r\n", (long)desc->inet.port)); + if (!(desc->tcp_add_flags & TCP_ADDF_CLOSE_SENT)) { + desc->tcp_add_flags |= TCP_ADDF_CLOSE_SENT; + + i = LOAD_ATOM(spec, i, am_tcp_closed); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_TUPLE(spec, i, 2); + ASSERT(i <= 6); + return driver_output_term(desc->inet.port, spec, i); + } + return 0; +} + +/* +** send active message {tcp_error, S, Error} +*/ +static int tcp_error_message(tcp_descriptor* desc, int err) +{ + ErlDrvTermData spec[8]; + ErlDrvTermData am_err = error_atom(err); + int i = 0; + + DEBUGF(("tcp_error_message(%ld): %d\r\n", (long)desc->inet.port, err)); + + i = LOAD_ATOM(spec, i, am_tcp_error); + i = LOAD_PORT(spec, i, desc->inet.dport); + i = LOAD_ATOM(spec, i, am_err); + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i <= 8); + return driver_output_term(desc->inet.port, spec, i); +} + +/* +** active mode message: +** {udp, S, IP, Port, [H1,...Hsz | Data]} or +** {sctp, S, IP, Port, {[AncilData], Event_or_Data}} +** where +** [H1,...,HSz] are msg headers (without IP/Port, UDP only), +** Data : List() | Binary() +*/ +static int packet_binary_message + (inet_descriptor* desc, ErlDrvBinary* bin, int offs, int len, void* extra) +{ + unsigned int hsz = desc->hsz; + ErlDrvTermData spec [PACKET_ERL_DRV_TERM_DATA_LEN]; + int i = 0; + int alen; + + DEBUGF(("packet_binary_message(%ld): len = %d\r\n", + (long)desc->port, len)); +# ifdef HAVE_SCTP + i = LOAD_ATOM(spec, i, IS_SCTP(desc) ? am_sctp : am_udp); /* UDP|SCTP */ +# else + i = LOAD_ATOM(spec, i, am_udp ); /* UDP only */ +# endif + i = LOAD_PORT(spec, i, desc->dport); /* S */ + + alen = addrlen(desc->sfamily); + i = load_ip_address(spec, i, desc->sfamily, bin->orig_bytes+offs+3); + i = load_ip_port(spec, i, bin->orig_bytes+offs+1); /* IP, Port */ + + offs += (alen + 3); + len -= (alen + 3); + +# ifdef HAVE_SCTP + if (!IS_SCTP(desc)) + { +# endif + if ((desc->mode == INET_MODE_LIST) || (hsz > len)) + /* INET_MODE_LIST, or only headers => [H1,H2,...Hn] */ + i = LOAD_STRING(spec, i, bin->orig_bytes+offs, len); + else { + /* INET_MODE_BINARY => [H1,H2,...HSz | Binary] */ + int sz = len - hsz; + + i = LOAD_BINARY(spec, i, bin, offs+hsz, sz); + if (hsz > 0) + i = LOAD_STRING_CONS(spec, i, bin->orig_bytes+offs, hsz); + } +# ifdef HAVE_SCTP + } + else + { /* For SCTP we always have desc->hsz==0 (i.e., no application-level + headers are used): */ + struct msghdr* mptr; + ASSERT(hsz == 0); + + /* Put in the list (possibly empty) of Ancillary Data: */ + mptr = (struct msghdr *) extra; + i = sctp_parse_ancillary_data (spec, i, mptr); + + /* Then: Data or Event (Notification)? */ + if (mptr->msg_flags & MSG_NOTIFICATION) + /* This is an Event, parse it. It may indicate a normal or an error + condition; in the latter case, the initial 'sctp' atom is over- + ridden by 'sctp_error', and the Event we receive contains the + error term: */ + i = sctp_parse_async_event + (spec, i, 0, am_sctp_error, desc, bin, offs, len); + else + /* This is SCTP data, not a notification event. The data can be + returned as a List or as a Binary, similar to the generic case: + */ + if (desc->mode == INET_MODE_LIST) + /* INET_MODE_LIST => [H1,H2,...Hn], addr and data together, + but the Addr has already been parsed, so start at offs: + */ + i = LOAD_STRING(spec, i, bin->orig_bytes+offs, len); + else + /* INET_MODE_BINARY => Binary */ + i = LOAD_BINARY(spec, i, bin, offs, len); + + /* Close up the {[AncilData], Event_OR_Data} tuple: */ + i = LOAD_TUPLE (spec, i, 2); + } +# endif /* HAVE_SCTP */ + + /* Close up the outer 5-tuple: */ + i = LOAD_TUPLE(spec, i, 5); + ASSERT(i <= PACKET_ERL_DRV_TERM_DATA_LEN); + return driver_output_term(desc->port, spec, i); +} + +/* +** send active message {udp_error|sctp_error, S, Error} +*/ +static int packet_error_message(udp_descriptor* udesc, int err) +{ + inet_descriptor* desc = INETP(udesc); + ErlDrvTermData spec[2*LOAD_ATOM_CNT + LOAD_PORT_CNT + LOAD_TUPLE_CNT]; + ErlDrvTermData am_err = error_atom(err); + int i = 0; + + DEBUGF(("packet_error_message(%ld): %d\r\n", + (long)desc->port, err)); + +# ifdef HAVE_SCTP + if (IS_SCTP(desc) ) + i = LOAD_ATOM(spec, i, am_sctp_error); + else +# endif + i = LOAD_ATOM(spec, i, am_udp_error); + + i = LOAD_PORT(spec, i, desc->dport); + i = LOAD_ATOM(spec, i, am_err); + i = LOAD_TUPLE(spec, i, 3); + ASSERT(i == sizeof(spec)/sizeof(*spec)); + return driver_output_term(desc->port, spec, i); +} + + +/* scan buffer for bit 7 */ +static void scanbit8(inet_descriptor* desc, const char* buf, int len) +{ + int c; + + if (!desc->bit8f || desc->bit8) return; + c = 0; + while(len--) c |= *buf++; + desc->bit8 = ((c & 0x80) != 0); +} + +/* +** active=TRUE: +** (NOTE! distribution MUST use active=TRUE, deliver=PORT) +** deliver=PORT {S, {data, [H1,..Hsz | Data]}} +** deliver=TERM {tcp, S, [H1..Hsz | Data]} +** +** active=FALSE: +** {async, S, Ref, {ok,[H1,...Hsz | Data]}} +*/ +static int tcp_reply_data(tcp_descriptor* desc, char* buf, int len) +{ + int code; + const char* body = buf; + int bodylen = len; + + packet_get_body(desc->inet.htype, &body, &bodylen); + + scanbit8(INETP(desc), body, bodylen); + + if (desc->inet.deliver == INET_DELIVER_PORT) { + code = inet_port_data(INETP(desc), body, bodylen); + } + else if ((code=packet_parse(desc->inet.htype, buf, len, + &desc->http_state, &packet_callbacks, + desc)) == 0) { + /* No body parsing, return raw binary */ + if (desc->inet.active == INET_PASSIVE) + return inet_async_data(INETP(desc), body, bodylen); + else + code = tcp_message(INETP(desc), body, bodylen); + } + + if (code < 0) + return code; + if (desc->inet.active == INET_ONCE) + desc->inet.active = INET_PASSIVE; + return code; +} + +static int +tcp_reply_binary_data(tcp_descriptor* desc, ErlDrvBinary* bin, int offs, int len) +{ + int code; + const char* buf = bin->orig_bytes + offs; + const char* body = buf; + int bodylen = len; + + packet_get_body(desc->inet.htype, &body, &bodylen); + offs = body - bin->orig_bytes; /* body offset now */ + + scanbit8(INETP(desc), body, bodylen); + + if (desc->inet.deliver == INET_DELIVER_PORT) + code = inet_port_binary_data(INETP(desc), bin, offs, bodylen); + else if ((code=packet_parse(desc->inet.htype, buf, len, &desc->http_state, + &packet_callbacks,desc)) == 0) { + /* No body parsing, return raw data */ + if (desc->inet.active == INET_PASSIVE) + return inet_async_binary_data(INETP(desc), 0, bin, offs, bodylen, NULL); + else + code = tcp_binary_message(INETP(desc), bin, offs, bodylen); + } + if (code < 0) + return code; + if (desc->inet.active == INET_ONCE) + desc->inet.active = INET_PASSIVE; + return code; +} + + +static int +packet_reply_binary_data(inet_descriptor* desc, unsigned int hsz, + ErlDrvBinary * bin, int offs, int len, + void * extra) +{ + int code; + + scanbit8(desc, bin->orig_bytes+offs, len); + + if (desc->active == INET_PASSIVE) + /* "inet" is actually for both UDP and SCTP, as well as TCP! */ + return inet_async_binary_data(desc, hsz, bin, offs, len, extra); + else + { /* INET_ACTIVE or INET_ONCE: */ + if (desc->deliver == INET_DELIVER_PORT) + code = inet_port_binary_data(desc, bin, offs, len); + else + code = packet_binary_message(desc, bin, offs, len, extra); + if (code < 0) + return code; + if (desc->active == INET_ONCE) + desc->active = INET_PASSIVE; + return code; + } +} + +/* ---------------------------------------------------------------------------- + + INET + +---------------------------------------------------------------------------- */ + +static int +sock_init(void) /* May be called multiple times. */ +{ +#ifdef __WIN32__ + WORD wVersionRequested; + WSADATA wsaData; + static int res = -1; /* res < 0 == initialization never attempted */ + + if (res >= 0) + return res; + + wVersionRequested = MAKEWORD(2,0); + if (WSAStartup(wVersionRequested, &wsaData) != 0) + goto error; + + if ((LOBYTE(wsaData.wVersion) != 2) || (HIBYTE(wsaData.wVersion) != 0)) + goto error; + + find_dynamic_functions(); + + return res = 1; + + error: + + WSACleanup(); + return res = 0; +#else + return 1; +#endif +} + +#ifdef HAVE_SCTP +static void inet_init_sctp(void) { + INIT_ATOM(sctp); + INIT_ATOM(sctp_error); + INIT_ATOM(true); + INIT_ATOM(false); + INIT_ATOM(buffer); + INIT_ATOM(mode); + INIT_ATOM(list); + INIT_ATOM(binary); + INIT_ATOM(active); + INIT_ATOM(once); + INIT_ATOM(buffer); + INIT_ATOM(linger); + INIT_ATOM(recbuf); + INIT_ATOM(sndbuf); + INIT_ATOM(reuseaddr); + INIT_ATOM(dontroute); + INIT_ATOM(priority); + INIT_ATOM(tos); + + /* Option names */ + INIT_ATOM(sctp_rtoinfo); + INIT_ATOM(sctp_associnfo); + INIT_ATOM(sctp_initmsg); + INIT_ATOM(sctp_autoclose); + INIT_ATOM(sctp_nodelay); + INIT_ATOM(sctp_disable_fragments); + INIT_ATOM(sctp_i_want_mapped_v4_addr); + INIT_ATOM(sctp_maxseg); + INIT_ATOM(sctp_set_peer_primary_addr); + INIT_ATOM(sctp_primary_addr); + INIT_ATOM(sctp_adaptation_layer); + INIT_ATOM(sctp_peer_addr_params); + INIT_ATOM(sctp_default_send_param); + INIT_ATOM(sctp_events); + INIT_ATOM(sctp_delayed_ack_time); + INIT_ATOM(sctp_status); + INIT_ATOM(sctp_get_peer_addr_info); + + /* Record names */ + INIT_ATOM(sctp_sndrcvinfo); + INIT_ATOM(sctp_assoc_change); + INIT_ATOM(sctp_paddr_change); + INIT_ATOM(sctp_remote_error); + INIT_ATOM(sctp_send_failed); + INIT_ATOM(sctp_shutdown_event); + INIT_ATOM(sctp_adaptation_event); + INIT_ATOM(sctp_pdapi_event); + INIT_ATOM(sctp_assocparams); + INIT_ATOM(sctp_prim); + INIT_ATOM(sctp_setpeerprim); + INIT_ATOM(sctp_setadaptation); + INIT_ATOM(sctp_paddrparams); + INIT_ATOM(sctp_event_subscribe); + INIT_ATOM(sctp_assoc_value); + INIT_ATOM(sctp_paddrinfo); + + /* For #sctp_sndrcvinfo{}: */ + INIT_ATOM(unordered); + INIT_ATOM(addr_over); + INIT_ATOM(abort); + INIT_ATOM(eof); + + /* For #sctp_assoc_change{}: */ + INIT_ATOM(comm_up); + INIT_ATOM(comm_lost); + INIT_ATOM(restart); + INIT_ATOM(shutdown_comp); + INIT_ATOM(cant_assoc); + + /* For #sctp_paddr_change{}: */ + INIT_ATOM(addr_available); + INIT_ATOM(addr_unreachable); + INIT_ATOM(addr_removed); + INIT_ATOM(addr_added); + INIT_ATOM(addr_made_prim); + INIT_ATOM(addr_confirmed); + + INIT_ATOM(short_recv); + INIT_ATOM(wrong_anc_data); + + /* For #sctp_pdap_event{}: */ + INIT_ATOM(partial_delivery_aborted); + + /* For #sctp_paddrparams{}: */ + INIT_ATOM(hb_enable); + INIT_ATOM(hb_disable); + INIT_ATOM(hb_demand); + INIT_ATOM(pmtud_enable); + INIT_ATOM(pmtud_disable); + INIT_ATOM(sackdelay_enable); + INIT_ATOM(sackdelay_disable); + + /* For #sctp_paddrinfo{}: */ + INIT_ATOM(active); + INIT_ATOM(inactive); + + /* For #sctp_status{}: */ + INIT_ATOM(empty); + INIT_ATOM(closed); + INIT_ATOM(cookie_wait); + INIT_ATOM(cookie_echoed); + INIT_ATOM(established); + INIT_ATOM(shutdown_pending); + INIT_ATOM(shutdown_sent); + INIT_ATOM(shutdown_received); + INIT_ATOM(shutdown_ack_sent); + /* Not yet implemented in the Linux kernel: + ** INIT_ATOM(bound); + ** INIT_ATOM(listen); + */ +} +#endif /* HAVE_SCTP */ + +static int inet_init() +{ + if (!sock_init()) + goto error; + + buffer_stack_pos = 0; + + erts_smp_spinlock_init(&inet_buffer_stack_lock, "inet_buffer_stack_lock"); + + ASSERT(sizeof(struct in_addr) == 4); +# if defined(HAVE_IN6) && defined(AF_INET6) + ASSERT(sizeof(struct in6_addr) == 16); +# endif + +#ifdef DEBUG + tot_buf_allocated = 0; + max_buf_allocated = 0; + tot_buf_stacked = 0; +#endif + INIT_ATOM(ok); + INIT_ATOM(tcp); + INIT_ATOM(udp); + INIT_ATOM(error); + INIT_ATOM(inet_async); + INIT_ATOM(inet_reply); + INIT_ATOM(timeout); + INIT_ATOM(closed); + INIT_ATOM(tcp_closed); + INIT_ATOM(tcp_error); + INIT_ATOM(udp_error); + INIT_ATOM(empty_out_q); + INIT_ATOM(ssl_tls); + + INIT_ATOM(http_eoh); + INIT_ATOM(http_header); + INIT_ATOM(http_request); + INIT_ATOM(http_response); + INIT_ATOM(http_error); + INIT_ATOM(abs_path); + INIT_ATOM(absoluteURI); + am_star = driver_mk_atom("*"); + INIT_ATOM(undefined); + INIT_ATOM(http); + INIT_ATOM(https); + INIT_ATOM(scheme); + + /* add TCP, UDP and SCTP drivers */ +#ifdef _OSE_ + add_ose_tcp_drv_entry(&tcp_inet_driver_entry); + add_ose_udp_drv_entry(&udp_inet_driver_entry); +#else + add_driver_entry(&tcp_inet_driver_entry); + add_driver_entry(&udp_inet_driver_entry); +# ifdef HAVE_SCTP + /* Check the size of SCTP AssocID -- currently both this driver and the + Erlang part require 32 bit: */ + ASSERT(sizeof(sctp_assoc_t)==ASSOC_ID_LEN); +# ifndef LIBSCTP +# error LIBSCTP not defined +# endif + if (erts_sys_ddll_open_noext(STRINGIFY(LIBSCTP), &h_libsctp, NULL) == 0) { + void *ptr; + if (erts_sys_ddll_sym(h_libsctp, "sctp_bindx", &ptr) == 0) { + p_sctp_bindx = ptr; + inet_init_sctp(); + add_driver_entry(&sctp_inet_driver_entry); + } + } +# endif +#endif /* _OSE_ */ + /* remove the dummy inet driver */ + remove_driver_entry(&inet_driver_entry); + return 0; + + error: + remove_driver_entry(&inet_driver_entry); + return -1; +} + + +/* +** Set a inaddr structure: +** src = [P1,P0,X1,X2,.....] +** dst points to a structure large enugh to keep any kind +** of inaddr. +** *len is set to length of src on call +** and is set to actual length of dst on return +** return NULL on error and ptr after port address on success +*/ +static char* inet_set_address(int family, inet_address* dst, char* src, int* len) +{ + short port; + + if ((family == AF_INET) && (*len >= 2+4)) { + sys_memzero((char*)dst, sizeof(struct sockaddr_in)); + port = get_int16(src); + dst->sai.sin_family = family; + dst->sai.sin_port = sock_htons(port); + sys_memcpy(&dst->sai.sin_addr, src+2, 4); + *len = sizeof(struct sockaddr_in); + return src + 2+4; + } +#if defined(HAVE_IN6) && defined(AF_INET6) + else if ((family == AF_INET6) && (*len >= 2+16)) { + sys_memzero((char*)dst, sizeof(struct sockaddr_in6)); + port = get_int16(src); + dst->sai6.sin6_family = family; + dst->sai6.sin6_port = sock_htons(port); + dst->sai6.sin6_flowinfo = 0; /* XXX this may be set as well ?? */ + sys_memcpy(&dst->sai6.sin6_addr, src+2, 16); + *len = sizeof(struct sockaddr_in6); + return src + 2+16; + } +#endif + return NULL; +} +#ifdef HAVE_SCTP +/* +** Set an inaddr structure, address family comes from source data, +** or from argument if source data specifies constant address. +** +** src = [TAG,P1,P0] when TAG = INET_AF_ANY | INET_AF_LOOPBACK +** src = [TAG,P1,P0,X1,X2,...] when TAG = INET_AF_INET | INET_AF_INET6 +*/ +static char *inet_set_faddress(int family, inet_address* dst, + char *src, int* len) { + int tag; + + if (*len < 1) return NULL; + (*len) --; + tag = *(src ++); + switch (tag) { + case INET_AF_INET: + family = AF_INET; + break; +# if defined(HAVE_IN6) && defined(AF_INET6) + case INET_AF_INET6: + family = AF_INET6; + break; +# endif + case INET_AF_ANY: + case INET_AF_LOOPBACK: { + int port; + + if (*len < 2) return NULL; + port = get_int16(src); + switch (family) { + case AF_INET: { + struct in_addr addr; + switch (tag) { + case INET_AF_ANY: + addr.s_addr = sock_htonl(INADDR_ANY); + break; + case INET_AF_LOOPBACK: + addr.s_addr = sock_htonl(INADDR_LOOPBACK); + break; + default: + return NULL; + } + sys_memzero((char*)dst, sizeof(struct sockaddr_in)); + dst->sai.sin_family = family; + dst->sai.sin_port = sock_htons(port); + dst->sai.sin_addr.s_addr = addr.s_addr; + *len = sizeof(struct sockaddr_in); + } break; +# if defined(HAVE_IN6) && defined(AF_INET6) + case AF_INET6: { + const struct in6_addr* paddr; + switch (tag) { + case INET_AF_ANY: + paddr = &in6addr_any; + break; + case INET_AF_LOOPBACK: + paddr = &in6addr_loopback; + break; + default: + return NULL; + } + sys_memzero((char*)dst, sizeof(struct sockaddr_in6)); + dst->sai6.sin6_family = family; + dst->sai6.sin6_port = sock_htons(port); + dst->sai6.sin6_flowinfo = 0; /* XXX this may be set as well ?? */ + dst->sai6.sin6_addr = *paddr; + *len = sizeof(struct sockaddr_in6); + } break; +# endif + default: + return NULL; + } + return src + 2; + } break; + default: + return NULL; + } + return inet_set_address(family, dst, src, len); +} +#endif /* HAVE_SCTP */ + +/* Get a inaddr structure +** src = inaddr structure +** *len is the lenght of structure +** dst is filled with [F,P1,P0,X1,....] +** where F is the family code (coded) +** and *len is the length of dst on return +** (suitable to deliver to erlang) +*/ +static int inet_get_address(int family, char* dst, inet_address* src, unsigned int* len) +{ + short port; + + if ((family == AF_INET) && (*len >= sizeof(struct sockaddr_in))) { + dst[0] = INET_AF_INET; + port = sock_ntohs(src->sai.sin_port); + put_int16(port, dst+1); + sys_memcpy(dst+3, (char*)&src->sai.sin_addr, sizeof(struct in_addr)); + *len = 3 + sizeof(struct in_addr); + return 0; + } +#if defined(HAVE_IN6) && defined(AF_INET6) + else if ((family == AF_INET6) && (*len >= sizeof(struct sockaddr_in6))) { + dst[0] = INET_AF_INET6; + port = sock_ntohs(src->sai6.sin6_port); + put_int16(port, dst+1); + sys_memcpy(dst+3, (char*)&src->sai6.sin6_addr,sizeof(struct in6_addr)); + *len = 3 + sizeof(struct in6_addr); + return 0; + } +#endif + return -1; +} + +static void desc_close(inet_descriptor* desc) +{ + if (desc->s != INVALID_SOCKET) { +#ifdef __WIN32__ + winsock_event_select(desc, FD_READ|FD_WRITE|FD_CLOSE, 0); + sock_close(desc->s); + desc->forced_events = 0; + desc->send_would_block = 0; +#endif + driver_select(desc->port, (ErlDrvEvent)(long)desc->event, ERL_DRV_USE, 0); + desc->event = INVALID_EVENT; /* closed by stop_select callback */ + desc->s = INVALID_SOCKET; + desc->event_mask = 0; + } +} + +static void desc_close_read(inet_descriptor* desc) +{ + if (desc->s != INVALID_SOCKET) { +#ifdef __WIN32__ + /* This call can not be right??? + * We want to turn off read events but keep any write events. + * But on windows driver_select(...,READ,1) is only used as a + * way to hook into the pollset. sock_select is used to control + * which events to wait for. + * It seems we used to disabled all events for the socket here. + * + driver_select(desc->port, desc->event, DO_READ, 0); REMOVED */ +#endif + sock_select(desc, FD_READ | FD_CLOSE, 0); + } +} + + +static int erl_inet_close(inet_descriptor* desc) +{ + free_subscribers(&desc->empty_out_q_subs); + if ((desc->prebound == 0) && (desc->state & INET_F_OPEN)) { + desc_close(desc); + desc->state = INET_STATE_CLOSED; + } else if (desc->prebound && (desc->s != INVALID_SOCKET)) { + sock_select(desc, FD_READ | FD_WRITE | FD_CLOSE, 0); + desc->event_mask = 0; +#ifdef __WIN32__ + desc->forced_events = 0; + desc->send_would_block = 0; +#endif + } + return 0; +} + + +static int inet_ctl_open(inet_descriptor* desc, int domain, int type, + char** rbuf, int rsize) +{ + if (desc->state != INET_STATE_CLOSED) + return ctl_xerror(EXBADSEQ, rbuf, rsize); + if ((desc->s = sock_open(domain, type, desc->sprotocol)) == INVALID_SOCKET) + return ctl_error(sock_errno(), rbuf, rsize); + if ((desc->event = sock_create_event(desc)) == INVALID_EVENT) + return ctl_error(sock_errno(), rbuf, rsize); + SET_NONBLOCKING(desc->s); +#ifdef __WIN32__ + driver_select(desc->port, desc->event, ERL_DRV_READ, 1); +#endif + desc->state = INET_STATE_OPEN; + desc->stype = type; + desc->sfamily = domain; + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); +} + + +/* as inet_open but pass in an open socket (MUST BE OF RIGHT TYPE) */ +static int inet_ctl_fdopen(inet_descriptor* desc, int domain, int type, + SOCKET s, char** rbuf, int rsize) +{ + inet_address name; + unsigned int sz = sizeof(name); + + /* check that it is a socket and that the socket is bound */ + if (sock_name(s, (struct sockaddr*) &name, &sz) == SOCKET_ERROR) + return ctl_error(sock_errno(), rbuf, rsize); + desc->s = s; + if ((desc->event = sock_create_event(desc)) == INVALID_EVENT) + return ctl_error(sock_errno(), rbuf, rsize); + SET_NONBLOCKING(desc->s); +#ifdef __WIN32__ + driver_select(desc->port, desc->event, ERL_DRV_READ, 1); +#endif + desc->state = INET_STATE_BOUND; /* assume bound */ + if (type == SOCK_STREAM) { /* check if connected */ + sz = sizeof(name); + if (sock_peer(s, (struct sockaddr*) &name, &sz) != SOCKET_ERROR) + desc->state = INET_STATE_CONNECTED; + } + + desc->prebound = 1; /* used to prevent a real close since + * the fd probably comes from an + * external wrapper program, so it is + * not certain that we can open it again */ + desc->stype = type; + desc->sfamily = domain; + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); +} + +/* +** store interface info as: (bytes) +** [Len] Name(Len) Flags(1) addr(4) baddr(4) mask(4) bw(4) +*/ +struct addr_if { + char name[INET_IFNAMSIZ]; + long flags; /* coded flags */ + struct in_addr addr; /* interface address */ + struct in_addr baddr; /* broadcast address */ + struct in_addr mask; /* netmask */ +}; + + +#ifndef SIOCGIFNETMASK +static struct in_addr net_mask(in) +struct in_addr in; +{ + register u_long i = sock_ntohl(in.s_addr); + + if (IN_CLASSA(i)) + in.s_addr = sock_htonl(IN_CLASSA_NET); + else if (IN_CLASSB(i)) + in.s_addr = sock_htonl(IN_CLASSB_NET); + else + in.s_addr = sock_htonl(IN_CLASSC_NET); + return in; +} +#endif + +#if defined(__WIN32__) && defined(SIO_GET_INTERFACE_LIST) + +/* format address in dot notation */ +static char* fmt_addr(unsigned long x, char* ptr) +{ + int i; + for (i = 0; i < 4; i++) { + int nb[3]; + int y = (x >> 24) & 0xff; + x <<= 8; + nb[0] = y % 10; y /= 10; + nb[1] = y % 10; y /= 10; + nb[2] = y % 10; y /= 10; + switch((nb[2] ? 3 : (nb[1] ? 2 : 1))) { + case 3: *ptr++ = nb[2] + '0'; + case 2: *ptr++ = nb[1] + '0'; + case 1: *ptr++ = nb[0] + '0'; + } + *ptr++ = '.'; + } + *(ptr-1) = '\0'; + return ptr; +} + +static int parse_addr(char* ptr, int n, long* x) +{ + long addr = 0; + int dots = 0; + int digs = 0; + int v = 0; + + while(n--) { + switch(*ptr) { + case '0': case '1': case '2':case '3':case '4':case '5': + case '6': case '7': case '8':case '9': + v = v*10 + *ptr - '0'; + if (++digs > 3) return -1; + break; + case '.': + if ((dots>2) || (digs==0) || (digs > 3) || (v > 0xff)) return -1; + dots++; + digs = 0; + addr = (addr << 8) | v; + v = 0; + break; + default: + return -1; + } + ptr++; + } + if ((dots!=3) || (digs==0) || (digs > 3) || (v > 0xff)) return -1; + addr = (addr << 8) | v; + *x = addr; + return 0; +} + +#endif + +#define buf_check(ptr, end, n) \ +do { if ((end)-(ptr) < (n)) goto error; } while(0) + +static char* sockaddr_to_buf(struct sockaddr* addr, char* ptr, char* end) +{ + if (addr->sa_family == AF_INET || addr->sa_family == 0) { + struct in_addr a; + buf_check(ptr,end,sizeof(struct in_addr)); + a = ((struct sockaddr_in*) addr)->sin_addr; + sys_memcpy(ptr, (char*)&a, sizeof(struct in_addr)); + return ptr + sizeof(struct in_addr); + } +#if defined(HAVE_IN6) && defined(AF_INET6) + else if (addr->sa_family == AF_INET6) { + struct in6_addr a; + buf_check(ptr,end,sizeof(struct in6_addr)); + a = ((struct sockaddr_in6*) addr)->sin6_addr; + sys_memcpy(ptr, (char*)&a, sizeof(struct in6_addr)); + return ptr + sizeof(struct in6_addr); + } +#endif + error: + return NULL; + +} + +static char* buf_to_sockaddr(char* ptr, char* end, struct sockaddr* addr) +{ + buf_check(ptr,end,sizeof(struct in_addr)); + sys_memcpy((char*) &((struct sockaddr_in*)addr)->sin_addr, ptr, + sizeof(struct in_addr)); + addr->sa_family = AF_INET; + return ptr + sizeof(struct in_addr); + + error: + return NULL; +} + + + +#if defined(__WIN32__) && defined(SIO_GET_INTERFACE_LIST) + +static int inet_ctl_getiflist(inet_descriptor* desc, char** rbuf, int rsize) +{ + char ifbuf[BUFSIZ]; + char sbuf[BUFSIZ]; + char* sptr; + INTERFACE_INFO* ifp; + DWORD len; + int n; + int err; + + ifp = (INTERFACE_INFO*) ifbuf; + len = 0; + err = WSAIoctl(desc->s, SIO_GET_INTERFACE_LIST, NULL, 0, + (LPVOID) ifp, BUFSIZ, (LPDWORD) &len, + NULL, NULL); + + if (err == SOCKET_ERROR) + return ctl_error(sock_errno(), rbuf, rsize); + + n = (len + sizeof(INTERFACE_INFO) - 1) / sizeof(INTERFACE_INFO); + sptr = sbuf; + + while(n--) { + if (((struct sockaddr*)&ifp->iiAddress)->sa_family == desc->sfamily) { + struct in_addr sina = ((struct sockaddr_in*)&ifp->iiAddress)->sin_addr; + /* discard INADDR_ANY interface address */ + if (sina.s_addr != INADDR_ANY) + sptr = fmt_addr(sock_ntohl(sina.s_addr), sptr); + } + ifp++; + } + return ctl_reply(INET_REP_OK, sbuf, sptr - sbuf, rbuf, rsize); +} + + +/* input is an ip-address in string format i.e A.B.C.D +** scan the INTERFACE_LIST to get the options +*/ +static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len, + char** rbuf, int rsize) +{ + char ifbuf[BUFSIZ]; + int n; + char sbuf[BUFSIZ]; + char* sptr; + char* s_end = sbuf + BUFSIZ; + int namlen; + int err; + INTERFACE_INFO* ifp; + long namaddr; + + if ((len == 0) || ((namlen = buf[0]) > len)) + goto error; + if (parse_addr(buf+1, namlen, &namaddr) < 0) + goto error; + namaddr = sock_ntohl(namaddr); + buf += (namlen+1); + len -= (namlen+1); + + ifp = (INTERFACE_INFO*) ifbuf; + err = WSAIoctl(desc->s, SIO_GET_INTERFACE_LIST, NULL, 0, + (LPVOID) ifp, BUFSIZ, (LPDWORD) &n, + NULL, NULL); + if (err == SOCKET_ERROR) { + return ctl_error(sock_errno(), rbuf, rsize); + } + + n = (n + sizeof(INTERFACE_INFO) - 1) / sizeof(INTERFACE_INFO); + + /* find interface */ + while(n) { + if (((struct sockaddr_in*)&ifp->iiAddress)->sin_addr.s_addr == namaddr) + break; + ifp++; + n--; + } + if (n == 0) + goto error; + + sptr = sbuf; + + while (len--) { + switch(*buf++) { + case INET_IFOPT_ADDR: + buf_check(sptr, s_end, 1); + *sptr++ = INET_IFOPT_ADDR; + if ((sptr = sockaddr_to_buf((struct sockaddr *)&ifp->iiAddress, + sptr, s_end)) == NULL) + goto error; + break; + + case INET_IFOPT_HWADDR: + break; + + case INET_IFOPT_BROADADDR: +#ifdef SIOCGIFBRDADDR + buf_check(sptr, s_end, 1); + *sptr++ = INET_IFOPT_BROADADDR; + if ((sptr=sockaddr_to_buf((struct sockaddr *) + &ifp->iiBroadcastAddress,sptr,s_end)) + == NULL) + goto error; +#endif + break; + + case INET_IFOPT_DSTADDR: + break; + + case INET_IFOPT_NETMASK: + buf_check(sptr, s_end, 1); + *sptr++ = INET_IFOPT_NETMASK; + if ((sptr = sockaddr_to_buf((struct sockaddr *) + &ifp->iiNetmask,sptr,s_end)) == NULL) + goto error; + break; + + case INET_IFOPT_MTU: + break; + + case INET_IFOPT_FLAGS: { + long eflags = 0; + int flags = ifp->iiFlags; + /* just enumerate the interfaces (no names) */ + + /* translate flags */ + if (flags & IFF_UP) + eflags |= INET_IFF_UP; + if (flags & IFF_BROADCAST) + eflags |= INET_IFF_BROADCAST; + if (flags & IFF_LOOPBACK) + eflags |= INET_IFF_LOOPBACK; + if (flags & IFF_POINTTOPOINT) + eflags |= INET_IFF_POINTTOPOINT; + if (flags & IFF_UP) /* emulate runnign ? */ + eflags |= INET_IFF_RUNNING; + if (flags & IFF_MULTICAST) + eflags |= INET_IFF_MULTICAST; + + buf_check(sptr, s_end, 5); + *sptr++ = INET_IFOPT_FLAGS; + put_int32(eflags, sptr); + sptr += 4; + break; + } + default: + goto error; + } + } + return ctl_reply(INET_REP_OK, sbuf, sptr - sbuf, rbuf, rsize); + + error: + return ctl_error(EINVAL, rbuf, rsize); +} + +/* not supported */ +static int inet_ctl_ifset(inet_descriptor* desc, char* buf, int len, + char** rbuf, int rsize) +{ + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); +} + + +#elif defined(SIOCGIFCONF) && defined(SIOCSIFFLAGS) +/* cygwin has SIOCGIFCONF but not SIOCSIFFLAGS (Nov 2002) */ + +#define VOIDP(x) ((void*)(x)) +#if defined(AF_LINK) && !defined(NO_SA_LEN) +#define SIZEA(p) (((p).sa_len > sizeof(p)) ? (p).sa_len : sizeof(p)) +#else +#define SIZEA(p) (sizeof (p)) +#endif + + +static int inet_ctl_getiflist(inet_descriptor* desc, char** rbuf, int rsize) +{ + struct ifconf ifc; + struct ifreq *ifr; + char *buf; + int buflen, ifc_len, i; + char *sbuf, *sp; + + /* Courtesy of Per Bergqvist and W. Richard Stevens */ + + ifc_len = 0; + buflen = 100 * sizeof(struct ifreq); + buf = ALLOC(buflen); + + for (;;) { + ifc.ifc_len = buflen; + ifc.ifc_buf = buf; + if (ioctl(desc->s, SIOCGIFCONF, (char *)&ifc) < 0) { + int res = sock_errno(); + if (res != EINVAL || ifc_len) { + FREE(buf); + return ctl_error(res, rbuf, rsize); + } + } else { + if (ifc.ifc_len == ifc_len) break; /* buf large enough */ + ifc_len = ifc.ifc_len; + } + buflen += 10 * sizeof(struct ifreq); + buf = (char *)REALLOC(buf, buflen); + } + + sp = sbuf = ALLOC(ifc_len+1); + *sp++ = INET_REP_OK; + i = 0; + for (;;) { + int n; + + ifr = (struct ifreq *) VOIDP(buf + i); + n = sizeof(ifr->ifr_name) + SIZEA(ifr->ifr_addr); + if (n < sizeof(*ifr)) n = sizeof(*ifr); + if (i+n > ifc_len) break; + i += n; + + switch (ifr->ifr_addr.sa_family) { +#if defined(HAVE_IN6) && defined(AF_INET6) + case AF_INET6: +#endif + case AF_INET: + ASSERT(sp+IFNAMSIZ+1 < sbuf+buflen+1) + strncpy(sp, ifr->ifr_name, IFNAMSIZ); + sp[IFNAMSIZ] = '\0'; + sp += strlen(sp), ++sp; + } + + if (i >= ifc_len) break; + } + FREE(buf); + *rbuf = sbuf; + return sp - sbuf; +} + + + +static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len, + char** rbuf, int rsize) +{ + char sbuf[BUFSIZ]; + char* sptr; + char* s_end = sbuf + BUFSIZ; + struct ifreq ifreq; + int namlen; + + if ((len == 0) || ((namlen = buf[0]) > len)) + goto error; + sys_memset(ifreq.ifr_name, '\0', IFNAMSIZ); + sys_memcpy(ifreq.ifr_name, buf+1, + (namlen > IFNAMSIZ) ? IFNAMSIZ : namlen); + buf += (namlen+1); + len -= (namlen+1); + sptr = sbuf; + + while (len--) { + switch(*buf++) { + case INET_IFOPT_ADDR: + if (ioctl(desc->s, SIOCGIFADDR, (char *)&ifreq) < 0) + break; + buf_check(sptr, s_end, 1); + *sptr++ = INET_IFOPT_ADDR; + if ((sptr = sockaddr_to_buf(&ifreq.ifr_addr, sptr, s_end)) == NULL) + goto error; + break; + + case INET_IFOPT_HWADDR: { +#ifdef SIOCGIFHWADDR + if (ioctl(desc->s, SIOCGIFHWADDR, (char *)&ifreq) < 0) + break; + buf_check(sptr, s_end, 1+IFHWADDRLEN); + *sptr++ = INET_IFOPT_HWADDR; + /* raw memcpy (fix include autoconf later) */ + sys_memcpy(sptr, (char*)(&ifreq.ifr_hwaddr.sa_data), IFHWADDRLEN); + sptr += IFHWADDRLEN; +#endif + break; + } + + + case INET_IFOPT_BROADADDR: +#ifdef SIOCGIFBRDADDR + if (ioctl(desc->s, SIOCGIFBRDADDR, (char *)&ifreq) < 0) + break; + buf_check(sptr, s_end, 1); + *sptr++ = INET_IFOPT_BROADADDR; + if ((sptr=sockaddr_to_buf(&ifreq.ifr_broadaddr,sptr,s_end)) == NULL) + goto error; +#endif + break; + + case INET_IFOPT_DSTADDR: +#ifdef SIOCGIFDSTADDR + if (ioctl(desc->s, SIOCGIFDSTADDR, (char *)&ifreq) < 0) + break; + buf_check(sptr, s_end, 1); + *sptr++ = INET_IFOPT_DSTADDR; + if ((sptr = sockaddr_to_buf(&ifreq.ifr_dstaddr,sptr,s_end)) == NULL) + goto error; +#endif + break; + + case INET_IFOPT_NETMASK: +#if defined(SIOCGIFNETMASK) + if (ioctl(desc->s, SIOCGIFNETMASK, (char *)&ifreq) < 0) + break; + buf_check(sptr, s_end, 1); + *sptr++ = INET_IFOPT_NETMASK; +#if defined(ifr_netmask) + sptr = sockaddr_to_buf(&ifreq.ifr_netmask,sptr,s_end); +#else + /* SIOCGNETMASK exist but not macro ??? */ + sptr = sockaddr_to_buf(&ifreq.ifr_addr,sptr,s_end); +#endif + if (sptr == NULL) + goto error; +#else + if (ioctl(desc->s, SIOCGIFADDR, (char *)&ifreq) < 0) + break; + else { + struct sockadd_in* ap; + /* emulate netmask, + * (wasted stuff since noone uses classes) + */ + buf_check(sptr, s_end, 1); + *sptr++ = INET_IFOPT_NETMASK; + ap = (struct sockaddr_in*) VOIDP(&ifreq.ifr_addr); + ap->sin_addr = net_mask(ap->sin_addr); + if ((sptr = sockaddr_to_buf(&ifreq.ifr_addr,sptr,s_end)) == NULL) + goto error; + } +#endif + break; + + case INET_IFOPT_MTU: { +#if defined(SIOCGIFMTU) && defined(ifr_mtu) + int n; + + if (ioctl(desc->s, SIOCGIFMTU, (char *)&ifreq) < 0) + break; + buf_check(sptr, s_end, 5); + *sptr++ = INET_IFOPT_MTU; + n = ifreq.ifr_mtu; + put_int32(n, sptr); + sptr += 4; +#endif + break; + } + + case INET_IFOPT_FLAGS: { + int flags; + int eflags = 0; + + if (ioctl(desc->s, SIOCGIFFLAGS, (char*)&ifreq) < 0) + flags = 0; + else + flags = ifreq.ifr_flags; + /* translate flags */ + if (flags & IFF_UP) + eflags |= INET_IFF_UP; + if (flags & IFF_BROADCAST) + eflags |= INET_IFF_BROADCAST; + if (flags & IFF_LOOPBACK) + eflags |= INET_IFF_LOOPBACK; + if (flags & IFF_POINTOPOINT) + eflags |= INET_IFF_POINTTOPOINT; + if (flags & IFF_RUNNING) + eflags |= INET_IFF_RUNNING; + if (flags & IFF_MULTICAST) + eflags |= INET_IFF_MULTICAST; + + buf_check(sptr, s_end, 5); + *sptr++ = INET_IFOPT_FLAGS; + put_int32(eflags, sptr); + sptr += 4; + break; + } + default: + goto error; + } + } + return ctl_reply(INET_REP_OK, sbuf, sptr - sbuf, rbuf, rsize); + + error: + return ctl_error(EINVAL, rbuf, rsize); +} + +/* FIXME: temporary hack */ +#ifndef IFHWADDRLEN +#define IFHWADDRLEN 6 +#endif + +static int inet_ctl_ifset(inet_descriptor* desc, char* buf, int len, + char** rbuf, int rsize) +{ + struct ifreq ifreq; + int namlen; + char* b_end = buf + len; + + if ((len == 0) || ((namlen = buf[0]) > len)) + goto error; + sys_memset(ifreq.ifr_name, '\0', IFNAMSIZ); + sys_memcpy(ifreq.ifr_name, buf+1, + (namlen > IFNAMSIZ) ? IFNAMSIZ : namlen); + buf += (namlen+1); + len -= (namlen+1); + + while(buf < b_end) { + switch(*buf++) { + case INET_IFOPT_ADDR: + if ((buf = buf_to_sockaddr(buf, b_end, &ifreq.ifr_addr)) == NULL) + goto error; + (void) ioctl(desc->s, SIOCSIFADDR, (char*)&ifreq); + break; + + case INET_IFOPT_HWADDR: + buf_check(buf, b_end, IFHWADDRLEN); +#ifdef SIOCSIFHWADDR + /* raw memcpy (fix include autoconf later) */ + sys_memcpy((char*)(&ifreq.ifr_hwaddr.sa_data), buf, IFHWADDRLEN); + + (void) ioctl(desc->s, SIOCSIFHWADDR, (char *)&ifreq); +#endif + buf += IFHWADDRLEN; + break; + + + case INET_IFOPT_BROADADDR: +#ifdef SIOCSIFBRDADDR + if ((buf = buf_to_sockaddr(buf, b_end, &ifreq.ifr_broadaddr)) == NULL) + goto error; + (void) ioctl(desc->s, SIOCSIFBRDADDR, (char *)&ifreq); +#endif + break; + + case INET_IFOPT_DSTADDR: +#ifdef SIOCSIFDSTADDR + if ((buf = buf_to_sockaddr(buf, b_end, &ifreq.ifr_dstaddr)) == NULL) + goto error; + (void) ioctl(desc->s, SIOCSIFDSTADDR, (char *)&ifreq); +#endif + break; + + case INET_IFOPT_NETMASK: +#ifdef SIOCSIFNETMASK + +#if defined(ifr_netmask) + buf = buf_to_sockaddr(buf,b_end, &ifreq.ifr_netmask); +#else + buf = buf_to_sockaddr(buf,b_end, &ifreq.ifr_addr); +#endif + if (buf == NULL) + goto error; + (void) ioctl(desc->s, SIOCSIFNETMASK, (char *)&ifreq); +#endif + break; + + case INET_IFOPT_MTU: + buf_check(buf, b_end, 4); +#if defined(SIOCSIFMTU) && defined(ifr_mtu) + ifreq.ifr_mtu = get_int32(buf); + (void) ioctl(desc->s, SIOCSIFMTU, (char *)&ifreq); +#endif + buf += 4; + break; + + case INET_IFOPT_FLAGS: { + int flags0; + int flags; + int eflags; + + buf_check(buf, b_end, 4); + eflags = get_int32(buf); + + /* read current flags */ + if (ioctl(desc->s, SIOCGIFFLAGS, (char*)&ifreq) < 0) + flags0 = flags = 0; + else + flags0 = flags = ifreq.ifr_flags; + + /* update flags */ + if (eflags & INET_IFF_UP) flags |= IFF_UP; + if (eflags & INET_IFF_DOWN) flags &= ~IFF_UP; + if (eflags & INET_IFF_BROADCAST) flags |= IFF_BROADCAST; + if (eflags & INET_IFF_NBROADCAST) flags &= ~IFF_BROADCAST; + if (eflags & INET_IFF_POINTTOPOINT) flags |= IFF_POINTOPOINT; + if (eflags & INET_IFF_NPOINTTOPOINT) flags &= ~IFF_POINTOPOINT; + + if (flags != flags0) { + ifreq.ifr_flags = flags; + (void) ioctl(desc->s, SIOCSIFFLAGS, (char*)&ifreq); + } + buf += 4; + break; + } + + default: + goto error; + } + } + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + + error: + return ctl_error(EINVAL, rbuf, rsize); +} + +#else + + +static int inet_ctl_getiflist(inet_descriptor* desc, char** rbuf, int rsize) +{ + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); +} + + +static int inet_ctl_ifget(inet_descriptor* desc, char* buf, int len, + char** rbuf, int rsize) +{ + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); +} + + +static int inet_ctl_ifset(inet_descriptor* desc, char* buf, int len, + char** rbuf, int rsize) +{ + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); +} + +#endif + +#ifdef VXWORKS +/* +** THIS is a terrible creature, a bug in the TCP part +** of the old VxWorks stack (non SENS) created a race. +** If (and only if?) a socket got closed from the other +** end and we tried a set/getsockopt on the TCP level, +** the task would generate a bus error... +*/ +static STATUS wrap_sockopt(STATUS (*function)() /* Yep, no parameter + check */, + int s, int level, int optname, + char *optval, unsigned int optlen + /* optlen is a pointer if function + is getsockopt... */) +{ + fd_set rs; + struct timeval timeout; + int to_read; + int ret; + + FD_ZERO(&rs); + FD_SET(s,&rs); + memset(&timeout,0,sizeof(timeout)); + if (level == IPPROTO_TCP) { + taskLock(); + if (select(s+1,&rs,NULL,NULL,&timeout)) { + if (ioctl(s,FIONREAD,(int)&to_read) == ERROR || + to_read == 0) { /* End of file, other end closed? */ + sock_errno() = EBADF; + taskUnlock(); + return ERROR; + } + } + ret = (*function)(s,level,optname,optval,optlen); + taskUnlock(); + } else { + ret = (*function)(s,level,optname,optval,optlen); + } + return ret; +} +#endif + +#if defined(IP_TOS) && defined(SOL_IP) && defined(SO_PRIORITY) +static int setopt_prio_tos_trick + (int fd, int proto, int type, char* arg_ptr, int arg_sz) +{ + /* The relations between SO_PRIORITY, TOS and other options + is not what you (or at least I) would expect...: + If TOS is set after priority, priority is zeroed. + If any other option is set after tos, tos might be zeroed. + Therefore, save tos and priority. If something else is set, + restore both after setting, if tos is set, restore only + prio and if prio is set restore none... All to keep the + user feeling socket options are independent. /PaN */ + int tmp_ival_prio; + int tmp_ival_tos; + int res; +#ifdef HAVE_SOCKLEN_T + socklen_t +#else + int +#endif + tmp_arg_sz_prio = sizeof(tmp_ival_prio), + tmp_arg_sz_tos = sizeof(tmp_ival_tos); + + res = sock_getopt(fd, SOL_SOCKET, SO_PRIORITY, + (char *) &tmp_ival_prio, &tmp_arg_sz_prio); + if (res == 0) { + res = sock_getopt(fd, SOL_IP, IP_TOS, + (char *) &tmp_ival_tos, &tmp_arg_sz_tos); + if (res == 0) { + res = sock_setopt(fd, proto, type, arg_ptr, arg_sz); + if (res == 0) { + if (type != SO_PRIORITY) { + if (type != IP_TOS) { + res = sock_setopt(fd, + SOL_IP, + IP_TOS, + (char *) &tmp_ival_tos, + tmp_arg_sz_tos); + } + if (res == 0) { + res = sock_setopt(fd, + SOL_SOCKET, + SO_PRIORITY, + (char *) &tmp_ival_prio, + tmp_arg_sz_prio); + } + } + } + } + } + return (res); +} +#endif + +/* set socket options: +** return -1 on error +** 0 if ok +** 1 if ok force deliver of queued data +*/ +#ifdef HAVE_SCTP +static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len); +#endif + +static int inet_set_opts(inet_descriptor* desc, char* ptr, int len) +{ + int type; + int proto; + int opt; + struct linger li_val; +#ifdef HAVE_MULTICAST_SUPPORT + struct ip_mreq mreq_val; +#endif + int ival; + char* arg_ptr; + int arg_sz; + enum PacketParseType old_htype = desc->htype; + int old_active = desc->active; + int propagate = 0; /* Set to 1 if failure to set this option + should be propagated to erlang (not all + errors can be propagated for BC reasons) */ + int res; +#ifdef HAVE_SCTP + /* SCTP sockets are treated completely separately: */ + if (IS_SCTP(desc)) + return sctp_set_opts(desc, ptr, len); +#endif + + while(len >= 5) { + opt = *ptr++; + ival = get_int32(ptr); + ptr += 4; + len -= 5; + arg_ptr = (char*) &ival; + arg_sz = sizeof(ival); + proto = SOL_SOCKET; + + switch(opt) { + case INET_LOPT_HEADER: + DEBUGF(("inet_set_opts(%ld): s=%d, HEADER=%d\r\n", + (long)desc->port, desc->s,ival)); + desc->hsz = ival; + continue; + + case INET_LOPT_MODE: + /* List or Binary: */ + DEBUGF(("inet_set_opts(%ld): s=%d, MODE=%d\r\n", + (long)desc->port, desc->s, ival)); + desc->mode = ival; + continue; + + case INET_LOPT_DELIVER: + DEBUGF(("inet_set_opts(%ld): s=%d, DELIVER=%d\r\n", + (long)desc->port, desc->s, ival)); + desc->deliver = ival; + continue; + + case INET_LOPT_BUFFER: + DEBUGF(("inet_set_opts(%ld): s=%d, BUFFER=%d\r\n", + (long)desc->port, desc->s, ival)); + if (ival > INET_MAX_BUFFER) ival = INET_MAX_BUFFER; + else if (ival < INET_MIN_BUFFER) ival = INET_MIN_BUFFER; + desc->bufsz = ival; + continue; + + case INET_LOPT_ACTIVE: + DEBUGF(("inet_set_opts(%ld): s=%d, ACTIVE=%d\r\n", + (long)desc->port, desc->s,ival)); + desc->active = ival; + if ((desc->stype == SOCK_STREAM) && (desc->active != INET_PASSIVE) && + (desc->state == INET_STATE_CLOSED)) { + tcp_closed_message((tcp_descriptor *) desc); + if (desc->exitf) { + driver_exit(desc->port, 0); + return 0; /* Give up on this socket, descriptor lost */ + } else { + desc_close_read(desc); + } + } + continue; + + case INET_LOPT_PACKET: + DEBUGF(("inet_set_opts(%ld): s=%d, PACKET=%d\r\n", + (long)desc->port, desc->s, ival)); + desc->htype = ival; + continue; + + case INET_LOPT_PACKET_SIZE: + DEBUGF(("inet_set_opts(%ld): s=%d, PACKET_SIZE=%d\r\n", + (long)desc->port, desc->s, ival)); + desc->psize = (unsigned int)ival; + continue; + + case INET_LOPT_EXITONCLOSE: + DEBUGF(("inet_set_opts(%ld): s=%d, EXITONCLOSE=%d\r\n", + (long)desc->port, desc->s, ival)); + desc->exitf = ival; + continue; + + case INET_LOPT_BIT8: + DEBUGF(("inet_set_opts(%ld): s=%d, BIT8=%d\r\n", + (long)desc->port, desc->s, ival)); + switch(ival) { + case INET_BIT8_ON: + desc->bit8f = 1; + desc->bit8 = 0; + break; + case INET_BIT8_OFF: + desc->bit8f = 0; + desc->bit8 = 0; + break; + case INET_BIT8_CLEAR: + desc->bit8f = 1; + desc->bit8 = 0; + break; + case INET_BIT8_SET: + desc->bit8f = 1; + desc->bit8 = 1; + break; + } + continue; + + case INET_LOPT_TCP_HIWTRMRK: + if (desc->stype == SOCK_STREAM) { + tcp_descriptor* tdesc = (tcp_descriptor*) desc; + if (ival < 0) ival = 0; + else if (ival > INET_MAX_BUFFER*2) ival = INET_MAX_BUFFER*2; + if (tdesc->low > ival) + tdesc->low = ival; + tdesc->high = ival; + } + continue; + + case INET_LOPT_TCP_LOWTRMRK: + if (desc->stype == SOCK_STREAM) { + tcp_descriptor* tdesc = (tcp_descriptor*) desc; + if (ival < 0) ival = 0; + else if (ival > INET_MAX_BUFFER) ival = INET_MAX_BUFFER; + if (tdesc->high < ival) + tdesc->high = ival; + tdesc->low = ival; + } + continue; + + case INET_LOPT_TCP_SEND_TIMEOUT: + if (desc->stype == SOCK_STREAM) { + tcp_descriptor* tdesc = (tcp_descriptor*) desc; + tdesc->send_timeout = ival; + } + continue; + + case INET_LOPT_TCP_SEND_TIMEOUT_CLOSE: + if (desc->stype == SOCK_STREAM) { + tcp_descriptor* tdesc = (tcp_descriptor*) desc; + tdesc->send_timeout_close = ival; + } + continue; + + + case INET_LOPT_TCP_DELAY_SEND: + if (desc->stype == SOCK_STREAM) { + tcp_descriptor* tdesc = (tcp_descriptor*) desc; + if (ival) + tdesc->tcp_add_flags |= TCP_ADDF_DELAY_SEND; + else + tdesc->tcp_add_flags &= ~TCP_ADDF_DELAY_SEND; + } + continue; + + case INET_LOPT_UDP_READ_PACKETS: + if (desc->stype == SOCK_DGRAM) { + udp_descriptor* udesc = (udp_descriptor*) desc; + if (ival <= 0) return -1; + udesc->read_packets = ival; + } + continue; + + case INET_OPT_REUSEADDR: +#ifdef __WIN32__ + continue; /* Bjorn says */ +#else + type = SO_REUSEADDR; + DEBUGF(("inet_set_opts(%ld): s=%d, SO_REUSEADDR=%d\r\n", + (long)desc->port, desc->s,ival)); + break; +#endif + case INET_OPT_KEEPALIVE: type = SO_KEEPALIVE; + DEBUGF(("inet_set_opts(%ld): s=%d, SO_KEEPALIVE=%d\r\n", + (long)desc->port, desc->s, ival)); + break; + case INET_OPT_DONTROUTE: type = SO_DONTROUTE; + DEBUGF(("inet_set_opts(%ld): s=%d, SO_DONTROUTE=%d\r\n", + (long)desc->port, desc->s, ival)); + break; + case INET_OPT_BROADCAST: type = SO_BROADCAST; + DEBUGF(("inet_set_opts(%ld): s=%d, SO_BROADCAST=%d\r\n", + (long)desc->port, desc->s,ival)); + break; + case INET_OPT_OOBINLINE: type = SO_OOBINLINE; + DEBUGF(("inet_set_opts(%ld): s=%d, SO_OOBINLINE=%d\r\n", + (long)desc->port, desc->s, ival)); + break; + case INET_OPT_SNDBUF: type = SO_SNDBUF; + DEBUGF(("inet_set_opts(%ld): s=%d, SO_SNDBUF=%d\r\n", + (long)desc->port, desc->s, ival)); + /* + * Setting buffer sizes in VxWorks gives unexpected results + * our workaround is to leave it at default. + */ +#ifdef VXWORKS + goto skip_os_setopt; +#else + break; +#endif + case INET_OPT_RCVBUF: type = SO_RCVBUF; + DEBUGF(("inet_set_opts(%ld): s=%d, SO_RCVBUF=%d\r\n", + (long)desc->port, desc->s, ival)); +#ifdef VXWORKS + goto skip_os_setopt; +#else + break; +#endif + case INET_OPT_LINGER: type = SO_LINGER; + if (len < 4) + return -1; + li_val.l_onoff = ival; + li_val.l_linger = get_int32(ptr); + ptr += 4; + len -= 4; + arg_ptr = (char*) &li_val; + arg_sz = sizeof(li_val); + DEBUGF(("inet_set_opts(%ld): s=%d, SO_LINGER=%d,%d", + (long)desc->port, desc->s, li_val.l_onoff,li_val.l_linger)); + break; + + case INET_OPT_PRIORITY: +#ifdef SO_PRIORITY + type = SO_PRIORITY; + propagate = 1; /* We do want to know if this fails */ + DEBUGF(("inet_set_opts(%ld): s=%d, SO_PRIORITY=%d\r\n", + (long)desc->port, desc->s, ival)); + break; +#else + continue; +#endif + case INET_OPT_TOS: +#if defined(IP_TOS) && defined(SOL_IP) + proto = SOL_IP; + type = IP_TOS; + propagate = 1; + DEBUGF(("inet_set_opts(%ld): s=%d, IP_TOS=%d\r\n", + (long)desc->port, desc->s, ival)); + break; +#else + continue; +#endif + + case TCP_OPT_NODELAY: + proto = IPPROTO_TCP; + type = TCP_NODELAY; + DEBUGF(("inet_set_opts(%ld): s=%d, TCP_NODELAY=%d\r\n", + (long)desc->port, desc->s, ival)); + break; + +#ifdef HAVE_MULTICAST_SUPPORT + + case UDP_OPT_MULTICAST_TTL: + proto = IPPROTO_IP; + type = IP_MULTICAST_TTL; + DEBUGF(("inet_set_opts(%ld): s=%d, IP_MULTICAST_TTL=%d\r\n", + (long)desc->port,desc->s,ival)); + break; + + case UDP_OPT_MULTICAST_LOOP: + proto = IPPROTO_IP; + type = IP_MULTICAST_LOOP; + DEBUGF(("inet_set_opts(%ld): s=%d, IP_MULTICAST_LOOP=%d\r\n", + (long)desc->port,desc->s,ival)); + break; + + case UDP_OPT_MULTICAST_IF: + proto = IPPROTO_IP; + type = IP_MULTICAST_IF; + DEBUGF(("inet_set_opts(%ld): s=%d, IP_MULTICAST_IF=%x\r\n", + (long)desc->port, desc->s, ival)); + ival = sock_htonl(ival); + break; + + case UDP_OPT_ADD_MEMBERSHIP: + proto = IPPROTO_IP; + type = IP_ADD_MEMBERSHIP; + DEBUGF(("inet_set_opts(%ld): s=%d, IP_ADD_MEMBERSHIP=%d\r\n", + (long)desc->port, desc->s,ival)); + goto L_set_mreq; + + case UDP_OPT_DROP_MEMBERSHIP: + proto = IPPROTO_IP; + type = IP_DROP_MEMBERSHIP; + DEBUGF(("inet_set_opts(%ld): s=%d, IP_DROP_MEMBERSHIP=%x\r\n", + (long)desc->port, desc->s, ival)); + L_set_mreq: + mreq_val.imr_multiaddr.s_addr = sock_htonl(ival); + ival = get_int32(ptr); + mreq_val.imr_interface.s_addr = sock_htonl(ival); + ptr += 4; + len -= 4; + arg_ptr = (char*)&mreq_val; + arg_sz = sizeof(mreq_val); + break; + +#endif /* HAVE_MULTICAST_SUPPORT */ + + case INET_OPT_RAW: + if (len < 8) { + return -1; + } + proto = ival; + type = get_int32(ptr); + ptr += 4; + arg_sz = get_int32(ptr); + ptr += 4; + len -= 8; + if (len < arg_sz) { + return -1; + } + arg_ptr = ptr; + ptr += arg_sz; + len -= arg_sz; + break; + + default: + return -1; + } +#if defined(IP_TOS) && defined(SOL_IP) && defined(SO_PRIORITY) + res = setopt_prio_tos_trick (desc->s, proto, type, arg_ptr, arg_sz); +#else + res = sock_setopt (desc->s, proto, type, arg_ptr, arg_sz); +#endif + if (propagate && res != 0) { + return -1; + } + DEBUGF(("inet_set_opts(%ld): s=%d returned %d\r\n", + (long)desc->port, desc->s, res)); +#ifdef VXWORKS +skip_os_setopt: +#endif + if (type == SO_RCVBUF) { + /* make sure we have desc->bufsz >= SO_RCVBUF */ + if (ival > desc->bufsz) + desc->bufsz = ival; + } + } + + if ( ((desc->stype == SOCK_STREAM) && IS_CONNECTED(desc)) || + ((desc->stype == SOCK_DGRAM) && IS_OPEN(desc))) { + + if (desc->active != old_active) + sock_select(desc, (FD_READ|FD_CLOSE), (desc->active>0)); + + if ((desc->stype==SOCK_STREAM) && desc->active) { + if (!old_active || (desc->htype != old_htype)) { + /* passive => active change OR header type change in active mode */ + return 1; + } + return 0; + } + } + return 0; +} + +#ifdef HAVE_SCTP + +/* "sctp_get_initmsg": +** Used by both "send*" and "setsockopt". Gets the 4 fields of "sctp_initmsg" +** from the input buffer: +*/ +#define SCTP_GET_INITMSG_LEN (4*2) +static char* sctp_get_initmsg(struct sctp_initmsg* ini, char* curr) +{ + ini->sinit_num_ostreams = get_int16 (curr); curr += 2; + ini->sinit_max_instreams = get_int16 (curr); curr += 2; + ini->sinit_max_attempts = get_int16 (curr); curr += 2; + ini->sinit_max_init_timeo = get_int16 (curr); curr += 2; + return curr; +} + +/* "sctp_get_sendparams": +** Parses (from the command buffer) the 6 user-sprcified parms of +** "sctp_sndrcvinfo": +** stream(u16), flags(u16), ppid(u32), context(u32), +** timetoleave(u32), assoc_id +** Is used by both "send*" and "setsockopt": +*/ +#define SCTP_GET_SENDPARAMS_LEN (2*2 + 3*4 + ASSOC_ID_LEN) +static char* sctp_get_sendparams (struct sctp_sndrcvinfo* sri, char* curr) +{ + int eflags; + int cflags; + + sri->sinfo_stream = get_int16(curr); curr += 2; + sri->sinfo_ssn = 0; + + /* The "flags" are already ORed at the Erlang side, here we + reconstruct the real SCTP flags: + */ + eflags = get_int16(curr); curr += 2; + cflags = 0; + if (eflags & SCTP_FLAG_UNORDERED) cflags |= SCTP_UNORDERED; + if (eflags & SCTP_FLAG_ADDR_OVER) cflags |= SCTP_ADDR_OVER; + if (eflags & SCTP_FLAG_ABORT) cflags |= SCTP_ABORT; + if (eflags & SCTP_FLAG_EOF) cflags |= SCTP_EOF; + + sri->sinfo_flags = cflags; + sri->sinfo_ppid = sock_htonl(get_int32(curr)); + curr += 4; + sri->sinfo_context = get_int32(curr); curr += 4; + sri->sinfo_timetolive = get_int32(curr); curr += 4; + sri->sinfo_tsn = 0; + sri->sinfo_cumtsn = 0; + sri->sinfo_assoc_id = GET_ASSOC_ID (curr); curr += ASSOC_ID_LEN; + + return curr; +} + +/* Set SCTP options: +** return -1 on error +** 0 if ok +** NB: unlike inet_set_opts(), we don't have an active mode here, so there is no +** mode change which could force data delivery on setting an option. +** Arg: "ptr": [(erlang_encoded_opt(u8), value(...)), ...]; thus, multiple opts +** can be set at a time. +*/ +static int sctp_set_opts(inet_descriptor* desc, char* ptr, int len) +{ +# define CHKLEN(Ptr, Len) \ + do { \ + if ((Ptr) + (Len) > ptr + len) return -1; \ + } while (0) + + char * curr = ptr; + int proto, type, res; + + /* The following union is used to hold any arg to "setsockopt": */ + union opts_union + { + int ival; + struct sctp_rtoinfo rtoi; + struct sctp_assocparams ap; + struct sctp_initmsg im; + struct linger lin; + struct sctp_setpeerprim prim; + struct sctp_setadaptation ad; + struct sctp_paddrparams pap; + struct sctp_sndrcvinfo sri; + struct sctp_event_subscribe es; +# ifdef SCTP_DELAYED_ACK_TIME + struct sctp_assoc_value av; /* Not in SOLARIS10 */ +# endif + } + arg; + + char * arg_ptr = NULL; + int arg_sz = 0; + int old_active = desc->active; + + while (curr < ptr + len) + { + /* Get the Erlang-encoded option type -- always 1 byte: */ + int eopt = *curr; + curr++; + + /* Get the option value. XXX: The condition (curr < ptr + len) + does not preclude us from reading from beyond the buffer end, + if the Erlang part of the driver specifies its input wrongly! + */ + CHKLEN(curr, 4); /* All options need at least 4 bytes */ + switch(eopt) + { + /* Local INET options: */ + + case INET_LOPT_BUFFER: + desc->bufsz = get_int32(curr); curr += 4; + + if (desc->bufsz > INET_MAX_BUFFER) + desc->bufsz = INET_MAX_BUFFER; + else + if (desc->bufsz < INET_MIN_BUFFER) + desc->bufsz = INET_MIN_BUFFER; + res = 0; /* This does not affect the kernel buffer size */ + continue; + + case INET_LOPT_MODE: + desc->mode = get_int32(curr); curr += 4; + res = 0; + continue; + + case INET_LOPT_ACTIVE: + desc->active = get_int32(curr); curr += 4; + res = 0; + continue; + + /* SCTP options and applicable generic INET options: */ + + case SCTP_OPT_RTOINFO: + { + CHKLEN(curr, ASSOC_ID_LEN + 3*4); + arg.rtoi.srto_assoc_id = GET_ASSOC_ID(curr); curr += ASSOC_ID_LEN; + arg.rtoi.srto_initial = get_int32 (curr); curr += 4; + arg.rtoi.srto_max = get_int32 (curr); curr += 4; + arg.rtoi.srto_min = get_int32 (curr); curr += 4; + + proto = IPPROTO_SCTP; + type = SCTP_RTOINFO; + arg_ptr = (char*) (&arg.rtoi); + arg_sz = sizeof ( arg.rtoi); + break; + } + case SCTP_OPT_ASSOCINFO: + { + CHKLEN(curr, ASSOC_ID_LEN + 2*2 + 3*4); + + arg.ap.sasoc_assoc_id = GET_ASSOC_ID(curr); curr += ASSOC_ID_LEN; + arg.ap.sasoc_asocmaxrxt = get_int16 (curr); curr += 2; + arg.ap.sasoc_number_peer_destinations = + get_int16 (curr); curr += 2; + arg.ap.sasoc_peer_rwnd = get_int32 (curr); curr += 4; + arg.ap.sasoc_local_rwnd = get_int32 (curr); curr += 4; + arg.ap.sasoc_cookie_life = get_int32 (curr); curr += 4; + + proto = IPPROTO_SCTP; + type = SCTP_ASSOCINFO; + arg_ptr = (char*) (&arg.ap); + arg_sz = sizeof ( arg.ap); + break; + } + case SCTP_OPT_INITMSG: + { + CHKLEN(curr, SCTP_GET_INITMSG_LEN); + curr = sctp_get_initmsg (&arg.im, curr); + + proto = IPPROTO_SCTP; + type = SCTP_INITMSG; + arg_ptr = (char*) (&arg.im); + arg_sz = sizeof ( arg.im); + break; + } + case INET_OPT_LINGER: + { + CHKLEN(curr, ASSOC_ID_LEN + 2 + 4); + arg.lin.l_onoff = get_int16 (curr); curr += 2; + arg.lin.l_linger = get_int32 (curr); curr += 4; + + proto = SOL_SOCKET; + type = SO_LINGER; + arg_ptr = (char*) (&arg.lin); + arg_sz = sizeof ( arg.lin); + break; + } + case SCTP_OPT_NODELAY: + { + arg.ival= get_int32 (curr); curr += 4; + proto = IPPROTO_SCTP; + type = SCTP_NODELAY; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } + case INET_OPT_RCVBUF: + { + arg.ival= get_int32 (curr); curr += 4; + proto = SOL_SOCKET; + type = SO_RCVBUF; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + + /* Adjust the size of the user-level recv buffer, so it's not + smaller than the kernel one: */ + if (desc->bufsz <= arg.ival) + desc->bufsz = arg.ival; + break; + } + case INET_OPT_SNDBUF: + { + arg.ival= get_int32 (curr); curr += 4; + proto = SOL_SOCKET; + type = SO_SNDBUF; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + + /* Adjust the size of the user-level recv buffer, so it's not + smaller than the kernel one: */ + if (desc->bufsz <= arg.ival) + desc->bufsz = arg.ival; + break; + } + case INET_OPT_REUSEADDR: + { + arg.ival= get_int32 (curr); curr += 4; + proto = SOL_SOCKET; + type = SO_REUSEADDR; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } + case INET_OPT_DONTROUTE: + { + arg.ival= get_int32 (curr); curr += 4; + proto = SOL_SOCKET; + type = SO_DONTROUTE; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } + case INET_OPT_PRIORITY: +# ifdef SO_PRIORITY + { + arg.ival= get_int32 (curr); curr += 4; + proto = SOL_SOCKET; + type = SO_PRIORITY; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } +# else + continue; /* Option not supported -- ignore it */ +# endif + + case INET_OPT_TOS: +# if defined(IP_TOS) && defined(SOL_IP) + { + arg.ival= get_int32 (curr); curr += 4; + proto = SOL_IP; + type = IP_TOS; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } +# else + continue; /* Option not supported -- ignore it */ +# endif + + case SCTP_OPT_AUTOCLOSE: + { + arg.ival= get_int32 (curr); curr += 4; + proto = IPPROTO_SCTP; + type = SCTP_AUTOCLOSE; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } + case SCTP_OPT_DISABLE_FRAGMENTS: + { + arg.ival= get_int32 (curr); curr += 4; + proto = IPPROTO_SCTP; + type = SCTP_DISABLE_FRAGMENTS; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } + case SCTP_OPT_I_WANT_MAPPED_V4_ADDR: + { + arg.ival= get_int32 (curr); curr += 4; + proto = IPPROTO_SCTP; + type = SCTP_I_WANT_MAPPED_V4_ADDR; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } + case SCTP_OPT_MAXSEG: + { + arg.ival= get_int32 (curr); curr += 4; + proto = IPPROTO_SCTP; + type = SCTP_MAXSEG; + arg_ptr = (char*) (&arg.ival); + arg_sz = sizeof ( arg.ival); + break; + } + case SCTP_OPT_PRIMARY_ADDR: + case SCTP_OPT_SET_PEER_PRIMARY_ADDR: + { + int alen; + char *after; + + CHKLEN(curr, ASSOC_ID_LEN); + /* XXX: These 2 opts have isomorphic value data structures, + "sctp_setpeerprim" and "sctp_prim" (in Solaris 10, the latter + is called "sctp_setprim"), so we grouped them together: + */ + arg.prim.sspp_assoc_id = GET_ASSOC_ID(curr); curr += ASSOC_ID_LEN; + + /* Fill in "arg.prim.sspp_addr": */ + alen = ptr + len - curr; + after = inet_set_faddress(desc->sfamily, + (inet_address*) (&arg.prim.sspp_addr), + curr, &alen); + if (after == NULL) + return -1; + curr = after; + + proto = IPPROTO_SCTP; + if (eopt == SCTP_OPT_PRIMARY_ADDR) + type = SCTP_PRIMARY_ADDR; + else + type = SCTP_SET_PEER_PRIMARY_ADDR; + + arg_ptr = (char*) (&arg.prim); + arg_sz = sizeof ( arg.prim); + break; + } + case SCTP_OPT_ADAPTATION_LAYER: + { + /* XXX: do we need to convert the Ind into network byte order??? */ + arg.ad.ssb_adaptation_ind = sock_htonl (get_int32(curr)); curr += 4; + + proto = IPPROTO_SCTP; + type = SCTP_ADAPTATION_LAYER; + arg_ptr = (char*) (&arg.ad); + arg_sz = sizeof ( arg.ad); + break; + } + case SCTP_OPT_PEER_ADDR_PARAMS: + { + int alen; + char *after; +# ifdef HAVE_STRUCT_SCTP_PADDRPARAMS_SPP_FLAGS + int eflags, cflags, hb_enable, hb_disable, + pmtud_enable, pmtud_disable, + sackdelay_enable, sackdelay_disable; +# endif + + CHKLEN(curr, ASSOC_ID_LEN); + arg.pap.spp_assoc_id = GET_ASSOC_ID(curr); curr += ASSOC_ID_LEN; + + /* Fill in "pap.spp_address": */ + alen = ptr + len - curr; + after = inet_set_faddress(desc->sfamily, + (inet_address*) (&arg.pap.spp_address), + curr, &alen); + if (after == NULL) + return -1; + curr = after; + + CHKLEN(curr, 4 + 2 + 3*4); + + arg.pap.spp_hbinterval = get_int32(curr); curr += 4; + arg.pap.spp_pathmaxrxt = get_int16(curr); curr += 2; + + /* The following are missing in Solaris 10: */ +# ifdef HAVE_STRUCT_SCTP_PADDRPARAMS_SPP_PATHMTU + arg.pap.spp_pathmtu = get_int32(curr); +# endif + curr += 4; +# ifdef HAVE_STRUCT_SCTP_PADDRPARAMS_SPP_SACKDELAY + arg.pap.spp_sackdelay = get_int32(curr); +# endif + curr += 4; + +# ifdef HAVE_STRUCT_SCTP_PADDRPARAMS_SPP_FLAGS + /* Now re-construct the flags: */ + eflags = get_int32(curr); + cflags = 0; + + hb_enable = eflags & SCTP_FLAG_HB_ENABLE; + hb_disable = eflags & SCTP_FLAG_HB_DISABLE; + if (hb_enable && hb_disable) + return -1; + if (hb_enable) cflags |= SPP_HB_ENABLE; + if (hb_disable) cflags |= SPP_HB_DISABLE; + if (eflags & SCTP_FLAG_HB_DEMAND) cflags |= SPP_HB_DEMAND; + + pmtud_enable = eflags & SCTP_FLAG_PMTUD_ENABLE; + pmtud_disable = eflags & SCTP_FLAG_PMTUD_DISABLE; + if (pmtud_enable && pmtud_disable) + return -1; + if (pmtud_enable) cflags |= SPP_PMTUD_ENABLE; + if (pmtud_disable) cflags |= SPP_PMTUD_DISABLE; + + sackdelay_enable =eflags& SCTP_FLAG_SACDELAY_ENABLE; + sackdelay_disable=eflags& SCTP_FLAG_SACDELAY_DISABLE; + if (sackdelay_enable && sackdelay_disable) + return -1; + if (sackdelay_enable) cflags |= SPP_SACKDELAY_ENABLE; + if (sackdelay_disable) cflags |= SPP_SACKDELAY_DISABLE; + + arg.pap.spp_flags = cflags; +# endif + curr += 4; + + proto = IPPROTO_SCTP; + type = SCTP_PEER_ADDR_PARAMS; + arg_ptr = (char*) (&arg.pap); + arg_sz = sizeof ( arg.pap); + break; + } + case SCTP_OPT_DEFAULT_SEND_PARAM: + { + CHKLEN(curr, SCTP_GET_SENDPARAMS_LEN); + curr = sctp_get_sendparams (&arg.sri, curr); + + proto = IPPROTO_SCTP; + type = SCTP_DEFAULT_SEND_PARAM; + arg_ptr = (char*) (&arg.sri); + arg_sz = sizeof ( arg.sri); + break; + } + case SCTP_OPT_EVENTS: + { + CHKLEN(curr, 9); + /* We do not support "sctp_authentication_event" -- it is not + implemented in Linux Kernel SCTP anyway. Just in case if + the above structure has more fields than we support, zero + it out -- the extraneous events will NOT be used: + */ + memset (&arg.es, 0, sizeof(arg.es)); + + /* The input "buf" must contain the full definition of all the + supported event fields, 1 byte per each, as each event is + either explicitly subscribed or cleared: + */ + arg.es.sctp_data_io_event = get_int8(curr); curr++; + arg.es.sctp_association_event = get_int8(curr); curr++; + arg.es.sctp_address_event = get_int8(curr); curr++; + arg.es.sctp_send_failure_event = get_int8(curr); curr++; + arg.es.sctp_peer_error_event = get_int8(curr); curr++; + arg.es.sctp_shutdown_event = get_int8(curr); curr++; + arg.es.sctp_partial_delivery_event = get_int8(curr); curr++; + arg.es.sctp_adaptation_layer_event = get_int8(curr); curr++; + /* sctp_authentication_event not implemented */ curr++; + + proto = IPPROTO_SCTP; + type = SCTP_EVENTS; + arg_ptr = (char*) (&arg.es); + arg_sz = sizeof ( arg.es); + break; + } + /* The following is not available on Solaris 10: */ +# ifdef SCTP_DELAYED_ACK_TIME + case SCTP_OPT_DELAYED_ACK_TIME: + { + CHKLEN(curr, ASSOC_ID_LEN + 4); + arg.av.assoc_id = GET_ASSOC_ID(curr); curr += ASSOC_ID_LEN; + arg.av.assoc_value = get_int32(curr); curr += 4; + + proto = IPPROTO_SCTP; + type = SCTP_DELAYED_ACK_TIME; + arg_ptr = (char*) (&arg.av); + arg_sz = sizeof ( arg.es); + break; + } +# endif + default: + /* XXX: No more supported SCTP options. In particular, authentica- + tion options (SCTP_AUTH_CHUNK, SCTP_AUTH_KEY, SCTP_PEER_AUTH_ + CHUNKS, SCTP_LOCAL_AUTH_CHUNKS, SCTP_AUTH_SETKEY_ACTIVE) are + not yet implemented in the Linux kernel, hence not supported + here. Also not supported are SCTP_HMAC_IDENT, as well as any + "generic" options except "INET_LOPT_MODE". Raise an error: + */ + return -1; + } +#if defined(IP_TOS) && defined(SOL_IP) && defined(SO_PRIORITY) + res = setopt_prio_tos_trick (desc->s, proto, type, arg_ptr, arg_sz); +#else + res = sock_setopt (desc->s, proto, type, arg_ptr, arg_sz); +#endif + /* The return values of "sock_setopt" can only be 0 or -1: */ + ASSERT(res == 0 || res == -1); + if (res == -1) + { /* Got an error, DO NOT continue with other options. However, on + Solaris 10, we DO allow SO_SNDBUF and SO_RCVBUF to fail, assu- + min that the default kernel versions are good enough: + */ +# ifdef SOLARIS10 + if (type != SO_SNDBUF && type != SO_RCVBUF) +# endif + return res; + } + } + /* If we got here, all "sock_setopt"s above were successful: */ + if (IS_OPEN(desc) && desc->active != old_active) { + sock_select(desc, (FD_READ|FD_CLOSE), (desc->active > 0)); + } + return 0; +# undef CHKLEN +} +#endif /* HAVE_SCTP */ + +/* load all option values into the buf and reply +** return total length of reply filled into ptr +** ptr should point to a buffer with 9*len +1 to be safe!! +*/ + +static int inet_fill_opts(inet_descriptor* desc, + char* buf, int len, char** dest, int destlen) +{ + int type; + int proto; + int opt; + struct linger li_val; + int ival; + char* arg_ptr; + unsigned int arg_sz; + char *ptr = NULL; + int dest_used = 0; + int dest_allocated = destlen; + char *orig_dest = *dest; + + /* Ptr is a name parameter */ +#define RETURN_ERROR() \ + do { \ + if (dest_allocated > destlen) { \ + FREE(*dest); \ + *dest = orig_dest; \ + } \ + return -1; \ + } while(0) + +#define PLACE_FOR(Size,Ptr) \ + do { \ + int need = dest_used + (Size); \ + if (need > INET_MAX_BUFFER) { \ + RETURN_ERROR(); \ + } \ + if (need > dest_allocated) { \ + char *new_buffer; \ + if (dest_allocated == destlen) { \ + new_buffer = ALLOC((dest_allocated = need + 10)); \ + memcpy(new_buffer,*dest,dest_used); \ + } else { \ + new_buffer = REALLOC(*dest, (dest_allocated = need + 10)); \ + } \ + *dest = new_buffer; \ + } \ + (Ptr) = (*dest) + dest_used; \ + dest_used = need; \ + } while (0) + + /* Ptr is a name parameter */ +#define TRUNCATE_TO(Size,Ptr) \ + do { \ + int new_need = ((Ptr) - (*dest)) + (Size); \ + if (new_need > dest_used) { \ + erl_exit(1,"Internal error in inet_drv, " \ + "miscalculated buffer size"); \ + } \ + dest_used = new_need; \ + } while(0) + + + PLACE_FOR(1,ptr); + *ptr = INET_REP_OK; + + while(len--) { + opt = *buf++; + proto = SOL_SOCKET; + ival = 0; /* Windows Vista needs this (only writes part of it) */ + arg_sz = sizeof(ival); + arg_ptr = (char*) &ival; + + PLACE_FOR(5,ptr); + + switch(opt) { + case INET_LOPT_BUFFER: + *ptr++ = opt; + put_int32(desc->bufsz, ptr); + continue; + case INET_LOPT_HEADER: + *ptr++ = opt; + put_int32(desc->hsz, ptr); + continue; + case INET_LOPT_MODE: + *ptr++ = opt; + put_int32(desc->mode, ptr); + continue; + case INET_LOPT_DELIVER: + *ptr++ = opt; + put_int32(desc->deliver, ptr); + continue; + case INET_LOPT_ACTIVE: + *ptr++ = opt; + put_int32(desc->active, ptr); + continue; + case INET_LOPT_PACKET: + *ptr++ = opt; + put_int32(desc->htype, ptr); + continue; + case INET_LOPT_PACKET_SIZE: + *ptr++ = opt; + put_int32(desc->psize, ptr); + continue; + case INET_LOPT_EXITONCLOSE: + *ptr++ = opt; + put_int32(desc->exitf, ptr); + continue; + + case INET_LOPT_BIT8: + *ptr++ = opt; + if (desc->bit8f) { + put_int32(desc->bit8, ptr); + } else { + put_int32(INET_BIT8_OFF, ptr); + } + continue; + + case INET_LOPT_TCP_HIWTRMRK: + if (desc->stype == SOCK_STREAM) { + *ptr++ = opt; + ival = ((tcp_descriptor*)desc)->high; + put_int32(ival, ptr); + } else { + TRUNCATE_TO(0,ptr); + } + continue; + + case INET_LOPT_TCP_LOWTRMRK: + if (desc->stype == SOCK_STREAM) { + *ptr++ = opt; + ival = ((tcp_descriptor*)desc)->low; + put_int32(ival, ptr); + } else { + TRUNCATE_TO(0,ptr); + } + continue; + + case INET_LOPT_TCP_SEND_TIMEOUT: + if (desc->stype == SOCK_STREAM) { + *ptr++ = opt; + ival = ((tcp_descriptor*)desc)->send_timeout; + put_int32(ival, ptr); + } else { + TRUNCATE_TO(0,ptr); + } + continue; + + case INET_LOPT_TCP_SEND_TIMEOUT_CLOSE: + if (desc->stype == SOCK_STREAM) { + *ptr++ = opt; + ival = ((tcp_descriptor*)desc)->send_timeout_close; + put_int32(ival, ptr); + } else { + TRUNCATE_TO(0,ptr); + } + continue; + + case INET_LOPT_TCP_DELAY_SEND: + if (desc->stype == SOCK_STREAM) { + *ptr++ = opt; + ival = !!(((tcp_descriptor*)desc)->tcp_add_flags & TCP_ADDF_DELAY_SEND); + put_int32(ival, ptr); + } else { + TRUNCATE_TO(0,ptr); + } + continue; + + case INET_LOPT_UDP_READ_PACKETS: + if (desc->stype == SOCK_DGRAM) { + *ptr++ = opt; + ival = ((udp_descriptor*)desc)->read_packets; + put_int32(ival, ptr); + } else { + TRUNCATE_TO(0,ptr); + } + continue; + + case INET_OPT_PRIORITY: +#ifdef SO_PRIORITY + type = SO_PRIORITY; + break; +#else + *ptr++ = opt; + put_int32(0, ptr); + continue; +#endif + case INET_OPT_TOS: +#if defined(IP_TOS) && defined(SOL_IP) + proto = SOL_IP; + type = IP_TOS; + break; +#else + *ptr++ = opt; + put_int32(0, ptr); + continue; +#endif + case INET_OPT_REUSEADDR: + type = SO_REUSEADDR; + break; + case INET_OPT_KEEPALIVE: + type = SO_KEEPALIVE; + break; + case INET_OPT_DONTROUTE: + type = SO_DONTROUTE; + break; + case INET_OPT_BROADCAST: + type = SO_BROADCAST; + break; + case INET_OPT_OOBINLINE: + type = SO_OOBINLINE; + break; + case INET_OPT_SNDBUF: + type = SO_SNDBUF; + break; + case INET_OPT_RCVBUF: + type = SO_RCVBUF; + break; + case TCP_OPT_NODELAY: + proto = IPPROTO_TCP; + type = TCP_NODELAY; + break; + +#ifdef HAVE_MULTICAST_SUPPORT + case UDP_OPT_MULTICAST_TTL: + proto = IPPROTO_IP; + type = IP_MULTICAST_TTL; + break; + case UDP_OPT_MULTICAST_LOOP: + proto = IPPROTO_IP; + type = IP_MULTICAST_LOOP; + break; + case UDP_OPT_MULTICAST_IF: + proto = IPPROTO_IP; + type = IP_MULTICAST_IF; + break; + case INET_OPT_LINGER: + arg_sz = sizeof(li_val); + sys_memzero((void *) &li_val, sizeof(li_val)); + arg_ptr = (char*) &li_val; + type = SO_LINGER; + break; +#endif /* HAVE_MULTICAST_SUPPORT */ + + case INET_OPT_RAW: + { + int data_provided; + /* Raw options are icky, handle directly... */ + if (len < 13) { + RETURN_ERROR(); + } + len -= 13; + proto = get_int32(buf); + buf += 4; + type = get_int32(buf); + buf += 4; + data_provided = (int) *buf++; + arg_sz = get_int32(buf); + if (arg_sz > INET_MAX_BUFFER) { + RETURN_ERROR(); + } + buf += 4; + TRUNCATE_TO(0,ptr); + PLACE_FOR(13 + arg_sz,ptr); + arg_ptr = ptr + 13; + if (data_provided) { + if (len < arg_sz) { + RETURN_ERROR(); + } + memcpy(arg_ptr,buf,arg_sz); + buf += arg_sz; + len -= arg_sz; + } + if (sock_getopt(desc->s,proto,type,arg_ptr,&arg_sz) == + SOCKET_ERROR) { + TRUNCATE_TO(0,ptr); + continue; + } + TRUNCATE_TO(arg_sz + 13,ptr); + *ptr++ = opt; + put_int32(proto,ptr); + ptr += 4; + put_int32(type,ptr); + ptr += 4; + put_int32(arg_sz,ptr); + continue; + } + default: + RETURN_ERROR(); + } + /* We have 5 bytes allocated to ptr */ + if (sock_getopt(desc->s,proto,type,arg_ptr,&arg_sz) == SOCKET_ERROR) { + TRUNCATE_TO(0,ptr); + continue; + } + *ptr++ = opt; + if (arg_ptr == (char*)&ival) { + put_int32(ival, ptr); + } + else { + put_int32(((Uint32) li_val.l_onoff), ptr); + PLACE_FOR(4,ptr); + put_int32(((Uint32) li_val.l_linger), ptr); + } + } + return (dest_used); +#undef PLACE_FOR +#undef TRUNCATE_TO +#undef RETURN_ERROR +} + +#ifdef HAVE_SCTP +#define LOAD_PADDRINFO_CNT \ + (2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + LOAD_IP_AND_PORT_CNT + \ + 4*LOAD_INT_CNT + LOAD_TUPLE_CNT) +static int load_paddrinfo (ErlDrvTermData * spec, int i, + inet_descriptor* desc, struct sctp_paddrinfo* pai) +{ + i = LOAD_ATOM (spec, i, am_sctp_paddrinfo); + i = LOAD_ASSOC_ID (spec, i, pai->spinfo_assoc_id); + i = load_ip_and_port(spec, i, desc, &pai->spinfo_address); + switch(pai->spinfo_state) + { + case SCTP_ACTIVE: + i = LOAD_ATOM (spec, i, am_active); + break; + case SCTP_INACTIVE: + i = LOAD_ATOM (spec, i, am_inactive); + break; + default: + ASSERT(0); /* NB: SCTP_UNCONFIRMED modifier not yet supported */ + } + i = LOAD_INT (spec, i, pai->spinfo_cwnd); + i = LOAD_INT (spec, i, pai->spinfo_srtt); + i = LOAD_INT (spec, i, pai->spinfo_rto ); + i = LOAD_INT (spec, i, pai->spinfo_mtu ); + /* Close up the record: */ + i = LOAD_TUPLE (spec, i, 8); + return i; +} + +/* +** "sctp_fill_opts": Returns {ok, Results}, or an error: +*/ +static int sctp_fill_opts(inet_descriptor* desc, char* buf, int buflen, + char** dest, int destlen) +{ + /* In contrast to the generic "inet_fill_opts", the output here is + represented by tuples/records, which are formed in the "spec": + */ + ErlDrvTermData *spec; + int i = 0; + int length = 0; /* Number of result list entries */ + + int spec_allocated = PACKET_ERL_DRV_TERM_DATA_LEN; + spec = ALLOC(sizeof(* spec) * spec_allocated); + +# define RETURN_ERROR(Spec, Errno) \ + do { \ + FREE(Spec); \ + return (Errno); \ + } while(0) + + /* Spec is a name parmeter */ +# define PLACE_FOR(Spec, Index, N) \ + do { \ + int need; \ + if ((Index) > spec_allocated) { \ + erl_exit(1,"Internal error in inet_drv, " \ + "miscalculated buffer size"); \ + } \ + need = (Index) + (N); \ + if (need > INET_MAX_BUFFER/sizeof(ErlDrvTermData)) { \ + RETURN_ERROR((Spec), -ENOMEM); \ + } \ + if (need > spec_allocated) { \ + (Spec) = REALLOC((Spec), \ + sizeof(* (Spec)) \ + * (spec_allocated = need + 20)); \ + } \ + } while (0) + + PLACE_FOR(spec, i, 2*LOAD_ATOM_CNT + LOAD_PORT_CNT); + i = LOAD_ATOM (spec, i, am_inet_reply); + i = LOAD_PORT (spec, i, desc->dport); + i = LOAD_ATOM (spec, i, am_ok); + + while (buflen > 0) { + int eopt = *buf; /* "eopt" is 1-byte encoded */ + buf ++; buflen --; + + switch(eopt) + { + /* Local options allowed for SCTP. For TCP and UDP, the values of + these options are returned via "res" using integer encoding, + but here, we encode them as proper terms the same way as we do + it for all other SCTP options: + */ + case INET_LOPT_BUFFER: + { + PLACE_FOR(spec, i, LOAD_ATOM_CNT + LOAD_INT_CNT + LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_buffer); + i = LOAD_INT (spec, i, desc->bufsz); + i = LOAD_TUPLE(spec, i, 2); + break; + } + case INET_LOPT_MODE: + { + PLACE_FOR(spec, i, 2*LOAD_ATOM_CNT + LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_mode); + switch (desc->mode) + { + case INET_MODE_LIST : + { i = LOAD_ATOM (spec, i, am_list); break; } + + case INET_MODE_BINARY: + { i = LOAD_ATOM (spec, i, am_binary); break; } + + default: ASSERT (0); + } + i = LOAD_TUPLE (spec, i, 2); + break; + } + case INET_LOPT_ACTIVE: + { + PLACE_FOR(spec, i, 2*LOAD_ATOM_CNT + LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_active); + switch (desc->active) + { + case INET_ACTIVE : + { i = LOAD_ATOM (spec, i, am_true); break; } + + case INET_PASSIVE: + { i = LOAD_ATOM (spec, i, am_false); break; } + + case INET_ONCE : + { i = LOAD_ATOM (spec, i, am_once); break; } + + default: ASSERT (0); + } + i = LOAD_TUPLE (spec, i, 2); + break; + } + + /* SCTP and generic INET options: */ + + case SCTP_OPT_RTOINFO: + { + struct sctp_rtoinfo rti; + unsigned int sz = sizeof(rti); + + if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL); + rti.srto_assoc_id = GET_ASSOC_ID(buf); + buf += ASSOC_ID_LEN; + buflen -= ASSOC_ID_LEN; + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_RTOINFO, + &rti, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + 2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + + 3*LOAD_INT_CNT + 2*LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_sctp_rtoinfo); + i = LOAD_ATOM (spec, i, am_sctp_rtoinfo); + i = LOAD_ASSOC_ID (spec, i, rti.srto_assoc_id); + i = LOAD_INT (spec, i, rti.srto_initial); + i = LOAD_INT (spec, i, rti.srto_max); + i = LOAD_INT (spec, i, rti.srto_min); + i = LOAD_TUPLE (spec, i, 5); + i = LOAD_TUPLE (spec, i, 2); + break; + } + case SCTP_OPT_ASSOCINFO: + { + struct sctp_assocparams ap; + unsigned int sz = sizeof(ap); + + if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL); + ap.sasoc_assoc_id = GET_ASSOC_ID(buf); + buf += ASSOC_ID_LEN; + buflen -= ASSOC_ID_LEN; + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_ASSOCINFO, + &ap, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + 2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + + 5*LOAD_INT_CNT + 2*LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_sctp_associnfo); + i = LOAD_ATOM (spec, i, am_sctp_assocparams); + i = LOAD_ASSOC_ID (spec, i, ap.sasoc_assoc_id); + i = LOAD_INT (spec, i, ap.sasoc_asocmaxrxt); + i = LOAD_INT (spec, i, ap.sasoc_number_peer_destinations); + i = LOAD_INT (spec, i, ap.sasoc_peer_rwnd); + i = LOAD_INT (spec, i, ap.sasoc_local_rwnd); + i = LOAD_INT (spec, i, ap.sasoc_cookie_life); + i = LOAD_TUPLE (spec, i, 7); + i = LOAD_TUPLE (spec, i, 2); + break; + } + case SCTP_OPT_INITMSG: + { + struct sctp_initmsg im; + unsigned int sz = sizeof(im); + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_INITMSG, + &im, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + 2*LOAD_ATOM_CNT + + 4*LOAD_INT_CNT + 2*LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_sctp_initmsg); + i = LOAD_ATOM (spec, i, am_sctp_initmsg); + i = LOAD_INT (spec, i, im.sinit_num_ostreams); + i = LOAD_INT (spec, i, im.sinit_max_instreams); + i = LOAD_INT (spec, i, im.sinit_max_attempts); + i = LOAD_INT (spec, i, im.sinit_max_init_timeo); + i = LOAD_TUPLE (spec, i, 5); + i = LOAD_TUPLE (spec, i, 2); + break; + } + /* The following option returns a tuple {bool, int}: */ + case INET_OPT_LINGER: + { + struct linger lg; + unsigned int sz = sizeof(lg); + + if (sock_getopt(desc->s, IPPROTO_SCTP, SO_LINGER, + &lg, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + LOAD_ATOM_CNT + LOAD_BOOL_CNT + + LOAD_INT_CNT + 2*LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_linger); + i = LOAD_BOOL (spec, i, lg.l_onoff); + i = LOAD_INT (spec, i, lg.l_linger); + i = LOAD_TUPLE (spec, i, 2); + i = LOAD_TUPLE (spec, i, 2); + break; + } + /* The following options just return an integer value: */ + case INET_OPT_RCVBUF : + case INET_OPT_SNDBUF : + case INET_OPT_REUSEADDR: + case INET_OPT_DONTROUTE: + case INET_OPT_PRIORITY : + case INET_OPT_TOS : + case SCTP_OPT_AUTOCLOSE: + case SCTP_OPT_MAXSEG : + /* The following options return true or false: */ + case SCTP_OPT_NODELAY : + case SCTP_OPT_DISABLE_FRAGMENTS: + case SCTP_OPT_I_WANT_MAPPED_V4_ADDR: + { + int res = 0; + unsigned int sz = sizeof(res); + int proto = 0, type = 0, is_int = 0; + ErlDrvTermData tag = am_sctp_error; + + switch(eopt) + { + case INET_OPT_RCVBUF : + { + proto = IPPROTO_SCTP; + type = SO_RCVBUF; + is_int = 1; + tag = am_recbuf; + break; + } + case INET_OPT_SNDBUF : + { + proto = IPPROTO_SCTP; + type = SO_SNDBUF; + is_int = 1; + tag = am_sndbuf; + break; + } + case INET_OPT_REUSEADDR: + { + proto = SOL_SOCKET; + type = SO_REUSEADDR; + is_int = 0; + tag = am_reuseaddr; + break; + } + case INET_OPT_DONTROUTE: + { + proto = SOL_SOCKET; + type = SO_DONTROUTE; + is_int = 0; + tag = am_dontroute; + break; + } + case INET_OPT_PRIORITY: + { +# if defined(SO_PRIORITY) + proto = SOL_SOCKET; + type = SO_PRIORITY; + is_int = 1; + tag = am_priority; + break; +# else + /* Not supported -- ignore */ + continue; +# endif + } + case INET_OPT_TOS: + { +# if defined(IP_TOS) && defined(SOL_IP) + proto = SOL_IP; + type = IP_TOS; + is_int = 1; + tag = am_tos; + break; +# else + /* Not supported -- ignore */ + continue; +# endif + } + case SCTP_OPT_AUTOCLOSE: + { + proto = IPPROTO_SCTP; + type = SCTP_AUTOCLOSE; + is_int = 1; + tag = am_sctp_autoclose; + break; + } + case SCTP_OPT_MAXSEG : + { + proto = IPPROTO_SCTP; + type = SCTP_MAXSEG; + is_int = 1; + tag = am_sctp_maxseg; + break; + } + case SCTP_OPT_NODELAY : + { + proto = IPPROTO_SCTP; + type = SCTP_NODELAY; + is_int = 0; + tag = am_sctp_nodelay; + break; + } + case SCTP_OPT_DISABLE_FRAGMENTS: + { + proto = IPPROTO_SCTP; + type = SCTP_DISABLE_FRAGMENTS; + is_int = 0; + tag = am_sctp_disable_fragments; + break; + } + case SCTP_OPT_I_WANT_MAPPED_V4_ADDR: + { + proto = IPPROTO_SCTP; + type = SCTP_I_WANT_MAPPED_V4_ADDR; + is_int = 0; + tag = am_sctp_i_want_mapped_v4_addr; + break; + } + default: ASSERT(0); + } + if (sock_getopt (desc->s, proto, type, &res, &sz) < 0) continue; + /* Form the result: */ + PLACE_FOR(spec, i, LOAD_ATOM_CNT + + (is_int ? LOAD_INT_CNT : LOAD_BOOL_CNT) + + LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, tag); + if (is_int) + i = LOAD_INT (spec, i, res); + else + i = LOAD_BOOL (spec, i, res); + i = LOAD_TUPLE (spec, i, 2); + break; + } + case SCTP_OPT_PRIMARY_ADDR: + case SCTP_OPT_SET_PEER_PRIMARY_ADDR: + { + /* These 2 options use completely isomorphic data structures: */ + struct sctp_setpeerprim sp; + unsigned int sz = sizeof(sp); + + if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL); + sp.sspp_assoc_id = GET_ASSOC_ID(buf); + buf += ASSOC_ID_LEN; + buflen -= ASSOC_ID_LEN; + + if (sock_getopt(desc->s, IPPROTO_SCTP, + (eopt == SCTP_OPT_PRIMARY_ADDR) ? + SCTP_PRIMARY_ADDR : SCTP_SET_PEER_PRIMARY_ADDR, + &sp, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + 2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + + LOAD_IP_AND_PORT_CNT + 2*LOAD_TUPLE_CNT); + switch (eopt) { + case SCTP_OPT_PRIMARY_ADDR: + i = LOAD_ATOM(spec, i, am_sctp_primary_addr); + i = LOAD_ATOM(spec, i, am_sctp_prim); + break; + case SCTP_OPT_SET_PEER_PRIMARY_ADDR: + i = LOAD_ATOM(spec, i, am_sctp_set_peer_primary_addr); + i = LOAD_ATOM(spec, i, am_sctp_setpeerprim); + break; + default: + ASSERT(0); + } + i = LOAD_ASSOC_ID (spec, i, sp.sspp_assoc_id); + i = load_ip_and_port(spec, i, desc, &sp.sspp_addr); + i = LOAD_TUPLE (spec, i, 3); + i = LOAD_TUPLE (spec, i, 2); + break; + } + case SCTP_OPT_ADAPTATION_LAYER: + { + struct sctp_setadaptation ad; + unsigned int sz = sizeof (ad); + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_ADAPTATION_LAYER, + &ad, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + 2*LOAD_ATOM_CNT + LOAD_INT_CNT + 2*LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_sctp_adaptation_layer); + i = LOAD_ATOM (spec, i, am_sctp_setadaptation); + i = LOAD_INT (spec, i, ad.ssb_adaptation_ind); + i = LOAD_TUPLE (spec, i, 2); + i = LOAD_TUPLE (spec, i, 2); + break; + } + case SCTP_OPT_PEER_ADDR_PARAMS: + { + struct sctp_paddrparams ap; + unsigned int sz = sizeof(ap); + int n; + char *after; + int alen; + + if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL); + ap.spp_assoc_id = GET_ASSOC_ID(buf); + buf += ASSOC_ID_LEN; + buflen -= ASSOC_ID_LEN; + alen = buflen; + after = inet_set_faddress(desc->sfamily, + (inet_address*) (&ap.spp_address), + buf, &alen); + if (after == NULL) RETURN_ERROR(spec, -EINVAL); + buflen -= after - buf; + buf = after; + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_PEER_ADDR_PARAMS, + &ap, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + 2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + + LOAD_IP_AND_PORT_CNT + 4*LOAD_INT_CNT); + i = LOAD_ATOM (spec, i, am_sctp_peer_addr_params); + i = LOAD_ATOM (spec, i, am_sctp_paddrparams); + i = LOAD_ASSOC_ID (spec, i, ap.spp_assoc_id); + i = load_ip_and_port(spec, i, desc, &ap.spp_address); + i = LOAD_INT (spec, i, ap.spp_hbinterval); + i = LOAD_INT (spec, i, ap.spp_pathmaxrxt); + + /* The following fields are not suported in SOLARIS10, + ** so put 0s for "spp_pathmtu", "spp_sackdelay", + ** and empty list for "spp_flags": + */ + +# ifdef HAVE_STRUCT_SCTP_PADDRPARAMS_SPP_PATHMTU + i = LOAD_INT (spec, i, ap.spp_pathmtu); +# else + i = LOAD_INT (spec, i, 0); +# endif + +# ifdef HAVE_STRUCT_SCTP_PADDRPARAMS_SPP_SACKDELAY + i = LOAD_INT (spec, i, ap.spp_sackdelay); +# else + i = LOAD_INT (spec, i, 0); +# endif + + n = 0; +# ifdef HAVE_STRUCT_SCTP_PADDRPARAMS_SPP_FLAGS + PLACE_FOR(spec, i, 7*LOAD_ATOM_CNT); + /* Now Flags, as a list: */ + if (ap.spp_flags & SPP_HB_ENABLE) + { i = LOAD_ATOM (spec, i, am_hb_enable); n++; } + + if (ap.spp_flags & SPP_HB_DISABLE) + { i = LOAD_ATOM (spec, i, am_hb_disable); n++; } + + if (ap.spp_flags & SPP_HB_DEMAND) + { i = LOAD_ATOM (spec, i, am_hb_demand); n++; } + + if (ap.spp_flags & SPP_PMTUD_ENABLE) + { i = LOAD_ATOM (spec, i, am_pmtud_enable); n++; } + + if (ap.spp_flags & SPP_PMTUD_DISABLE) + { i = LOAD_ATOM (spec, i, am_pmtud_disable); n++; } + + if (ap.spp_flags & SPP_SACKDELAY_ENABLE) + { i = LOAD_ATOM (spec, i, am_sackdelay_enable); n++; } + + if (ap.spp_flags & SPP_SACKDELAY_DISABLE) + { i = LOAD_ATOM (spec, i, am_sackdelay_disable); n++; } +# endif + + PLACE_FOR(spec, i, + LOAD_NIL_CNT + LOAD_LIST_CNT + 2*LOAD_TUPLE_CNT); + + /* Close up the Flags list: */ + i = LOAD_NIL (spec, i); + i = LOAD_LIST (spec, i, n+1); + + /* Close up the record: */ + i = LOAD_TUPLE (spec, i, 8); + /* Close up the result tuple: */ + i = LOAD_TUPLE (spec, i, 2); + break; + } + case SCTP_OPT_DEFAULT_SEND_PARAM: + { + struct sctp_sndrcvinfo sri; + unsigned int sz = sizeof(sri); + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_DEFAULT_SEND_PARAM, + &sri, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, LOAD_ATOM_CNT + + SCTP_PARSE_SNDRCVINFO_CNT + LOAD_TUPLE_CNT); + i = LOAD_ATOM(spec, i, am_sctp_default_send_param); + i = sctp_parse_sndrcvinfo(spec, i, &sri); + i = LOAD_TUPLE(spec, i, 2); + break; + } + case SCTP_OPT_EVENTS: + { + struct sctp_event_subscribe evs; + unsigned int sz = sizeof(evs); + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_EVENTS, + &evs, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + 2*LOAD_ATOM_CNT + 9*LOAD_BOOL_CNT + 2*LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_sctp_events); + i = LOAD_ATOM (spec, i, am_sctp_event_subscribe); + i = LOAD_BOOL (spec, i, evs.sctp_data_io_event); + i = LOAD_BOOL (spec, i, evs.sctp_association_event); + i = LOAD_BOOL (spec, i, evs.sctp_address_event); + i = LOAD_BOOL (spec, i, evs.sctp_send_failure_event); + i = LOAD_BOOL (spec, i, evs.sctp_peer_error_event); + i = LOAD_BOOL (spec, i, evs.sctp_shutdown_event); + i = LOAD_BOOL (spec, i, evs.sctp_partial_delivery_event); + i = LOAD_BOOL (spec, i, evs.sctp_adaptation_layer_event); + i = LOAD_BOOL (spec, i, 0);/* NB: sctp_authentication_event + * is not yet supported in Linux + */ + i = LOAD_TUPLE (spec, i, 10); + i = LOAD_TUPLE (spec, i, 2); + break; + } + /* The following option is not available in Solaris 10: */ +# ifdef SCTP_DELAYED_ACK_TIME + case SCTP_OPT_DELAYED_ACK_TIME: + { + struct sctp_assoc_value av; + unsigned int sz = sizeof(av); + + if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL); + av.assoc_id = GET_ASSOC_ID(buf); + buf += ASSOC_ID_LEN; + buflen -= ASSOC_ID_LEN; + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_DELAYED_ACK_TIME, + &av, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, 2*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + + LOAD_INT_CNT + 2*LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_sctp_delayed_ack_time); + i = LOAD_ATOM (spec, i, am_sctp_assoc_value); + i = LOAD_ASSOC_ID (spec, i, av.assoc_id); + i = LOAD_INT (spec, i, av.assoc_value); + i = LOAD_TUPLE (spec, i, 3); + i = LOAD_TUPLE (spec, i, 2); + break; + } +# endif + case SCTP_OPT_STATUS: + { + struct sctp_status st; + unsigned int sz = sizeof(st); + + if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL); + st.sstat_assoc_id = GET_ASSOC_ID(buf); + buf += ASSOC_ID_LEN; + buflen -= ASSOC_ID_LEN; + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_STATUS, + &st, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, 3*LOAD_ATOM_CNT + LOAD_ASSOC_ID_CNT + + 6*LOAD_INT_CNT + LOAD_PADDRINFO_CNT + + 2*LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_sctp_status); + i = LOAD_ATOM (spec, i, am_sctp_status); + i = LOAD_ASSOC_ID (spec, i, st.sstat_assoc_id); + switch(st.sstat_state) + { + /* SCTP_EMPTY is not supported on SOLARIS10: */ +# ifdef SCTP_EMPTY + case SCTP_EMPTY: + i = LOAD_ATOM (spec, i, am_empty); + break; +# endif + case SCTP_CLOSED: + i = LOAD_ATOM (spec, i, am_closed); + break; + /* The following states are not supported by Linux Kernel SCTP yet: + case SCTP_BOUND: + i = LOAD_ATOM (spec, i, am_bound); + break; + case SCTP_LISTEN: + i = LOAD_ATOM (spec, i, am_listen); + break; + */ + case SCTP_COOKIE_WAIT: + i = LOAD_ATOM (spec, i, am_cookie_wait); + break; + case SCTP_COOKIE_ECHOED: + i = LOAD_ATOM (spec, i, am_cookie_echoed); + break; + case SCTP_ESTABLISHED: + i = LOAD_ATOM (spec, i, am_established); + break; + case SCTP_SHUTDOWN_PENDING: + i = LOAD_ATOM (spec, i, am_shutdown_pending); + break; + case SCTP_SHUTDOWN_SENT: + i = LOAD_ATOM (spec, i, am_shutdown_sent); + break; + case SCTP_SHUTDOWN_RECEIVED: + i = LOAD_ATOM (spec, i, am_shutdown_received); + break; + case SCTP_SHUTDOWN_ACK_SENT: + i = LOAD_ATOM (spec, i, am_shutdown_ack_sent); + break; + default: + i = LOAD_ATOM (spec, i, am_undefined); + break; + } + i = LOAD_INT (spec, i, st.sstat_rwnd); + i = LOAD_INT (spec, i, st.sstat_unackdata); + i = LOAD_INT (spec, i, st.sstat_penddata); + i = LOAD_INT (spec, i, st.sstat_instrms); + i = LOAD_INT (spec, i, st.sstat_outstrms); + i = LOAD_INT (spec, i, st.sstat_fragmentation_point); + i = load_paddrinfo (spec, i, desc, &st.sstat_primary); + /* Close up the record: */ + i = LOAD_TUPLE (spec, i, 10); + /* Close up the result tuple: */ + i = LOAD_TUPLE (spec, i, 2); + break; + } + case SCTP_OPT_GET_PEER_ADDR_INFO: + { + struct sctp_paddrinfo pai; + unsigned int sz = sizeof(pai); + char *after; + int alen; + + if (buflen < ASSOC_ID_LEN) RETURN_ERROR(spec, -EINVAL); + pai.spinfo_assoc_id = GET_ASSOC_ID(buf); + buf += ASSOC_ID_LEN; + buflen -= ASSOC_ID_LEN; + alen = buflen; + after = inet_set_faddress(desc->sfamily, + (inet_address*) (&pai.spinfo_address), + buf, &alen); + if (after == NULL) RETURN_ERROR(spec, -EINVAL); + buflen -= after - buf; + buf = after; + + if (sock_getopt(desc->s, IPPROTO_SCTP, SCTP_GET_PEER_ADDR_INFO, + &pai, &sz) < 0) continue; + /* Fill in the response: */ + PLACE_FOR(spec, i, + LOAD_ATOM_CNT + LOAD_PADDRINFO_CNT + LOAD_TUPLE_CNT); + i = LOAD_ATOM (spec, i, am_sctp_get_peer_addr_info); + i = load_paddrinfo (spec, i, desc, &pai); + i = LOAD_TUPLE (spec, i, 2); + break; + } + default: + RETURN_ERROR(spec, -EINVAL); /* No more valid options */ + } + /* If we get here one result has been succesfully loaded */ + length ++; + } + if (buflen != 0) RETURN_ERROR(spec, -EINVAL); /* Optparam mismatch */ + + PLACE_FOR(spec, i, LOAD_NIL_CNT + LOAD_LIST_CNT + 2*LOAD_TUPLE_CNT); + + /* If we get here, we have "length" options: */ + i = LOAD_NIL (spec, i); + i = LOAD_LIST (spec, i, length+1); + + /* Close up the {ok, List} response: */ + i = LOAD_TUPLE(spec, i, 2); + /* Close up the {inet_reply, S, {ok, List}} response: */ + i = LOAD_TUPLE(spec, i, 3); + + /* Now, convert "spec" into the returnable term: */ + /* desc->caller = 0; What does it mean? */ + driver_output_term(desc->port, spec, i); + FREE(spec); + + (*dest)[0] = INET_REP_SCTP; + return 1; /* Response length */ +# undef PLACE_FOR +# undef RETURN_ERROR +} +#endif + +/* fill statistics reply, op codes from src and result in dest +** dst area must be a least 5*len + 1 bytes +*/ +static int inet_fill_stat(inet_descriptor* desc, char* src, int len, char* dst) +{ + unsigned long val; + int op; + char* dst_start = dst; + + *dst++ = INET_REP_OK; /* put reply code */ + while (len--) { + op = *src++; + *dst++ = op; /* copy op code */ + switch(op) { + case INET_STAT_RECV_CNT: + val = desc->recv_cnt; + break; + case INET_STAT_RECV_MAX: + val = (unsigned long) desc->recv_max; + break; + case INET_STAT_RECV_AVG: + val = (unsigned long) desc->recv_avg; + break; + case INET_STAT_RECV_DVI: + val = (unsigned long) fabs(desc->recv_dvi); + break; + case INET_STAT_SEND_CNT: + val = desc->send_cnt; + break; + case INET_STAT_SEND_MAX: + val = desc->send_max; + break; + case INET_STAT_SEND_AVG: + val = (unsigned long) desc->send_avg; + break; + case INET_STAT_SEND_PND: + val = driver_sizeq(desc->port); + break; + case INET_STAT_RECV_OCT: + put_int32(desc->recv_oct[1], dst); /* write high 32bit */ + put_int32(desc->recv_oct[0], dst+4); /* write low 32bit */ + dst += 8; + continue; + case INET_STAT_SEND_OCT: + put_int32(desc->send_oct[1], dst); /* write high 32bit */ + put_int32(desc->send_oct[0], dst+4); /* write low 32bit */ + dst += 8; + continue; + default: return -1; /* invalid argument */ + } + put_int32(val, dst); /* write 32bit value */ + dst += 4; + } + return dst - dst_start; /* actual length */ +} + +static void +send_empty_out_q_msgs(inet_descriptor* desc) +{ + ErlDrvTermData msg[6]; + int msg_len = 0; + + if(NO_SUBSCRIBERS(&desc->empty_out_q_subs)) + return; + + msg_len = LOAD_ATOM(msg, msg_len, am_empty_out_q); + msg_len = LOAD_PORT(msg, msg_len, desc->dport); + msg_len = LOAD_TUPLE(msg, msg_len, 2); + + ASSERT(msg_len == sizeof(msg)/sizeof(*msg)); + + send_to_subscribers(desc->port, + &desc->empty_out_q_subs, + 1, + msg, + msg_len); +} + +/* subscribe and fill subscription reply, op codes from src and +** result in dest dst area must be a least 5*len + 1 bytes +*/ +static int inet_subscribe(inet_descriptor* desc, char* src, int len, char* dst) +{ + unsigned long val; + int op; + char* dst_start = dst; + + *dst++ = INET_REP_OK; /* put reply code */ + while (len--) { + op = *src++; + *dst++ = op; /* copy op code */ + switch(op) { + case INET_SUBS_EMPTY_OUT_Q: + val = driver_sizeq(desc->port); + if(val > 0) + if(!save_subscriber(&desc->empty_out_q_subs, + driver_caller(desc->port))) + return 0; + break; + default: return -1; /* invalid argument */ + } + put_int32(val, dst); /* write 32bit value */ + dst += 4; + } + return dst - dst_start; /* actual length */ +} + +/* Terminate socket */ +static void inet_stop(inet_descriptor* desc) +{ + erl_inet_close(desc); + FREE(desc); +} + + +/* Allocate descriptor */ +static ErlDrvData inet_start(ErlDrvPort port, int size, int protocol) +{ + inet_descriptor* desc; + + if ((desc = (inet_descriptor*) ALLOC(size)) == NULL) + return NULL; + + desc->s = INVALID_SOCKET; + desc->event = INVALID_EVENT; + desc->event_mask = 0; +#ifdef __WIN32__ + desc->forced_events = 0; + desc->send_would_block = 0; +#endif + desc->port = port; + desc->dport = driver_mk_port(port); + desc->state = INET_STATE_CLOSED; + desc->prebound = 0; + desc->bufsz = INET_DEF_BUFFER; + desc->hsz = 0; /* list header size */ + desc->htype = TCP_PB_RAW; /* default packet type */ + desc->psize = 0; /* no size check */ + desc->stype = -1; /* bad stype */ + desc->sfamily = -1; + desc->sprotocol = protocol; + desc->mode = INET_MODE_LIST; /* list mode */ + desc->exitf = 1; /* exit port when close on active + socket */ + desc->bit8f = 0; + desc->bit8 = 0; + desc->deliver = INET_DELIVER_TERM; /* standard term format */ + desc->active = INET_PASSIVE; /* start passive */ + desc->oph = NULL; + desc->opt = NULL; + + desc->peer_ptr = NULL; + desc->name_ptr = NULL; + + desc->recv_oct[0] = desc->recv_oct[1] = 0; + desc->recv_cnt = 0; + desc->recv_max = 0; + desc->recv_avg = 0.0; + desc->recv_dvi = 0.0; + desc->send_oct[0] = desc->send_oct[1] = 0; + desc->send_cnt = 0; + desc->send_max = 0; + desc->send_avg = 0.0; + desc->empty_out_q_subs.subscriber = NO_PROCESS; + desc->empty_out_q_subs.next = NULL; + + sys_memzero((char *)&desc->remote,sizeof(desc->remote)); + + return (ErlDrvData)desc; +} + + +#ifndef MAXHOSTNAMELEN +#define MAXHOSTNAMELEN 256 +#endif + +/* +** common TCP/UDP/SCTP control command +*/ +static int inet_ctl(inet_descriptor* desc, int cmd, char* buf, int len, + char** rbuf, int rsize) +{ + switch (cmd) { + + case INET_REQ_GETSTAT: { + char* dst; + int i; + int dstlen = 1; /* Reply code */ + + for (i = 0; i < len; i++) { + switch(buf[i]) { + case INET_STAT_SEND_OCT: dstlen += 9; break; + case INET_STAT_RECV_OCT: dstlen += 9; break; + default: dstlen += 5; break; + } + } + DEBUGF(("inet_ctl(%ld): GETSTAT\r\n", (long) desc->port)); + if (dstlen > INET_MAX_BUFFER) /* sanity check */ + return 0; + if (dstlen > rsize) { + if ((dst = (char*) ALLOC(dstlen)) == NULL) + return 0; + *rbuf = dst; /* call will free this buffer */ + } + else + dst = *rbuf; /* ok we fit in buffer given */ + return inet_fill_stat(desc, buf, len, dst); + } + + case INET_REQ_SUBSCRIBE: { + char* dst; + int dstlen = 1 /* Reply code */ + len*5; + DEBUGF(("inet_ctl(%ld): INET_REQ_SUBSCRIBE\r\n", (long) desc->port)); + if (dstlen > INET_MAX_BUFFER) /* sanity check */ + return 0; + if (dstlen > rsize) { + if ((dst = (char*) ALLOC(dstlen)) == NULL) + return 0; + *rbuf = dst; /* call will free this buffer */ + } + else + dst = *rbuf; /* ok we fit in buffer given */ + return inet_subscribe(desc, buf, len, dst); + } + + case INET_REQ_GETOPTS: { /* get options */ + int replen; + DEBUGF(("inet_ctl(%ld): GETOPTS\r\n", (long)desc->port)); +#ifdef HAVE_SCTP + if (IS_SCTP(desc)) + { + if ((replen = sctp_fill_opts(desc, buf, len, rbuf, rsize)) < 0) + return ctl_error(-replen, rbuf, rsize); + } else +#endif + if ((replen = inet_fill_opts(desc, buf, len, rbuf, rsize)) < 0) { + return ctl_error(EINVAL, rbuf, rsize); + } + return replen; + } + + case INET_REQ_GETIFLIST: { + DEBUGF(("inet_ctl(%ld): GETIFLIST\r\n", (long)desc->port)); + if (!IS_OPEN(desc)) + return ctl_xerror(EXBADPORT, rbuf, rsize); + return inet_ctl_getiflist(desc, rbuf, rsize); + } + + case INET_REQ_IFGET: { + DEBUGF(("inet_ctl(%ld): IFGET\r\n", (long)desc->port)); + if (!IS_OPEN(desc)) + return ctl_xerror(EXBADPORT, rbuf, rsize); + return inet_ctl_ifget(desc, buf, len, rbuf, rsize); + } + + case INET_REQ_IFSET: { + DEBUGF(("inet_ctl(%ld): IFSET\r\n", (long)desc->port)); + if (!IS_OPEN(desc)) + return ctl_xerror(EXBADPORT, rbuf, rsize); + return inet_ctl_ifset(desc, buf, len, rbuf, rsize); + } + + case INET_REQ_SETOPTS: { /* set options */ + DEBUGF(("inet_ctl(%ld): SETOPTS\r\n", (long)desc->port)); + switch(inet_set_opts(desc, buf, len)) { + case -1: + return ctl_error(EINVAL, rbuf, rsize); + case 0: + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + default: /* active/passive change!! */ + /* + * Let's hope that the descriptor really is a tcp_descriptor here. + */ + tcp_deliver((tcp_descriptor *) desc, 0); + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } + } + + case INET_REQ_GETSTATUS: { + char tbuf[4]; + + DEBUGF(("inet_ctl(%ld): GETSTATUS\r\n", (long)desc->port)); + put_int32(desc->state, tbuf); + return ctl_reply(INET_REP_OK, tbuf, 4, rbuf, rsize); + } + + case INET_REQ_GETTYPE: { + char tbuf[8]; + + DEBUGF(("inet_ctl(%ld): GETTYPE\r\n", (long)desc->port)); + if (desc->sfamily == AF_INET) { + put_int32(INET_AF_INET, &tbuf[0]); + } +#if defined(HAVE_IN6) && defined(AF_INET6) + else if (desc->sfamily == AF_INET6) { + put_int32(INET_AF_INET6, &tbuf[0]); + } +#endif + else + return ctl_error(EINVAL, rbuf, rsize); + + if (desc->stype == SOCK_STREAM) { + put_int32(INET_TYPE_STREAM, &tbuf[4]); + } + else if (desc->stype == SOCK_DGRAM) { + put_int32(INET_TYPE_DGRAM, &tbuf[4]); + } +#ifdef HAVE_SCTP + else if (desc->stype == SOCK_SEQPACKET) { + put_int32(INET_TYPE_SEQPACKET, &tbuf[4]); + } +#endif + else + return ctl_error(EINVAL, rbuf, rsize); + return ctl_reply(INET_REP_OK, tbuf, 8, rbuf, rsize); + } + + + case INET_REQ_GETFD: { + char tbuf[4]; + + DEBUGF(("inet_ctl(%ld): GETFD\r\n", (long)desc->port)); + if (!IS_OPEN(desc)) + return ctl_error(EINVAL, rbuf, rsize); + put_int32((long)desc->s, tbuf); + return ctl_reply(INET_REP_OK, tbuf, 4, rbuf, rsize); + } + + case INET_REQ_GETHOSTNAME: { /* get host name */ + char tbuf[MAXHOSTNAMELEN]; + + DEBUGF(("inet_ctl(%ld): GETHOSTNAME\r\n", (long)desc->port)); + if (len != 0) + return ctl_error(EINVAL, rbuf, rsize); + + if (sock_hostname(tbuf, MAXHOSTNAMELEN) == SOCKET_ERROR) + return ctl_error(sock_errno(), rbuf, rsize); + return ctl_reply(INET_REP_OK, tbuf, strlen(tbuf), rbuf, rsize); + } + + case INET_REQ_PEER: { /* get peername */ + char tbuf[sizeof(inet_address)]; + inet_address peer; + inet_address* ptr; + unsigned int sz = sizeof(peer); + + DEBUGF(("inet_ctl(%ld): PEER\r\n", (long)desc->port)); + + if (!(desc->state & INET_F_ACTIVE)) + return ctl_error(ENOTCONN, rbuf, rsize); + if ((ptr = desc->peer_ptr) == NULL) { + ptr = &peer; + if (sock_peer(desc->s, (struct sockaddr*)ptr,&sz) == SOCKET_ERROR) + return ctl_error(sock_errno(), rbuf, rsize); + } + if (inet_get_address(desc->sfamily, tbuf, ptr, &sz) < 0) + return ctl_error(EINVAL, rbuf, rsize); + return ctl_reply(INET_REP_OK, tbuf, sz, rbuf, rsize); + } + + case INET_REQ_SETPEER: { /* set fake peername Port Address */ + if (len == 0) { + desc->peer_ptr = NULL; + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } + else if (len < 2) + return ctl_error(EINVAL, rbuf, rsize); + else if (inet_set_address(desc->sfamily, &desc->peer_addr, + buf, &len) == NULL) + return ctl_error(EINVAL, rbuf, rsize); + else { + desc->peer_ptr = &desc->peer_addr; + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } + } + + case INET_REQ_NAME: { /* get sockname */ + char tbuf[sizeof(inet_address)]; + inet_address name; + inet_address* ptr; + unsigned int sz = sizeof(name); + + DEBUGF(("inet_ctl(%ld): NAME\r\n", (long)desc->port)); + + if (!IS_BOUND(desc)) + return ctl_error(EINVAL, rbuf, rsize); /* address is not valid */ + + if ((ptr = desc->name_ptr) == NULL) { + ptr = &name; + if (sock_name(desc->s, (struct sockaddr*)ptr, &sz) == SOCKET_ERROR) + return ctl_error(sock_errno(), rbuf, rsize); + } + if (inet_get_address(desc->sfamily, tbuf, ptr, &sz) < 0) + return ctl_error(EINVAL, rbuf, rsize); + return ctl_reply(INET_REP_OK, tbuf, sz, rbuf, rsize); + } + + case INET_REQ_SETNAME: { /* set fake peername Port Address */ + if (len == 0) { + desc->name_ptr = NULL; + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } + else if (len < 2) + return ctl_error(EINVAL, rbuf, rsize); + else if (inet_set_address(desc->sfamily, &desc->name_addr, + buf, &len) == NULL) + return ctl_error(EINVAL, rbuf, rsize); + else { + desc->name_ptr = &desc->name_addr; + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } + } + + case INET_REQ_BIND: { /* bind socket */ + char tbuf[2]; + inet_address local; + short port; + + DEBUGF(("inet_ctl(%ld): BIND\r\n", (long)desc->port)); + + if (len < 2) + return ctl_error(EINVAL, rbuf, rsize); + if (desc->state != INET_STATE_OPEN) + return ctl_xerror(EXBADPORT, rbuf, rsize); + + if (inet_set_address(desc->sfamily, &local, buf, &len) == NULL) + return ctl_error(EINVAL, rbuf, rsize); + + if (sock_bind(desc->s,(struct sockaddr*) &local, len) == SOCKET_ERROR) + return ctl_error(sock_errno(), rbuf, rsize); + + desc->state = INET_STATE_BOUND; + + if ((port = inet_address_port(&local)) == 0) { + len = sizeof(local); + sock_name(desc->s, (struct sockaddr*) &local, (unsigned int*)&len); + port = inet_address_port(&local); + } + port = sock_ntohs(port); + put_int16(port, tbuf); + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } + +#ifndef VXWORKS + + case INET_REQ_GETSERVBYNAME: { /* L1 Name-String L2 Proto-String */ + char namebuf[256]; + char protobuf[256]; + char tbuf[2]; + struct servent* srv; + short port; + int n; + + if (len < 2) + return ctl_error(EINVAL, rbuf, rsize); + n = buf[0]; buf++; len--; + if (n >= len) /* the = sign makes the test inklude next length byte */ + return ctl_error(EINVAL, rbuf, rsize); + memcpy(namebuf, buf, n); + namebuf[n] = '\0'; + len -= n; buf += n; + n = buf[0]; buf++; len--; + if (n > len) + return ctl_error(EINVAL, rbuf, rsize); + memcpy(protobuf, buf, n); + protobuf[n] = '\0'; + if ((srv = sock_getservbyname(namebuf, protobuf)) == NULL) + return ctl_error(EINVAL, rbuf, rsize); + port = sock_ntohs(srv->s_port); + put_int16(port, tbuf); + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } + + case INET_REQ_GETSERVBYPORT: { /* P1 P0 L1 Proto-String */ + char protobuf[256]; + unsigned short port; + int n; + struct servent* srv; + + if (len < 3) + return ctl_error(EINVAL, rbuf, rsize); + port = get_int16(buf); + port = sock_htons(port); + buf += 2; + n = buf[0]; buf++; len -= 3; + if (n > len) + return ctl_error(EINVAL, rbuf, rsize); + memcpy(protobuf, buf, n); + protobuf[n] = '\0'; + if ((srv = sock_getservbyport(port, protobuf)) == NULL) + return ctl_error(EINVAL, rbuf, rsize); + len = strlen(srv->s_name); + return ctl_reply(INET_REP_OK, srv->s_name, len, rbuf, rsize); + } + +#endif /* !VXWORKS */ + + default: + return ctl_xerror(EXBADPORT, rbuf, rsize); + } +} + +/* update statistics on output packets */ +static void inet_output_count(inet_descriptor* desc, int len) +{ + unsigned long n = desc->send_cnt + 1; + unsigned long t = desc->send_oct[0] + len; + int c = (t < desc->send_oct[0]); + double avg = desc->send_avg; + + /* at least 64 bit octet count */ + desc->send_oct[0] = t; + desc->send_oct[1] += c; + + if (n == 0) /* WRAP, use old avg as input to a new sequence */ + n = 1; + desc->send_avg += (len - avg) / n; + if (len > desc->send_max) + desc->send_max = len; + desc->send_cnt = n; +} + +/* update statistics on input packets */ +static void inet_input_count(inet_descriptor* desc, int len) +{ + unsigned long n = desc->recv_cnt + 1; + unsigned long t = desc->recv_oct[0] + len; + int c = (t < desc->recv_oct[0]); + double avg = desc->recv_avg; + double dvi; + + /* at least 64 bit octet count */ + desc->recv_oct[0] = t; + desc->recv_oct[1] += c; + + if (n == 0) /* WRAP */ + n = 1; + + /* average packet length */ + avg = avg + (len - avg) / n; + desc->recv_avg = avg; + + if (len > desc->recv_max) + desc->recv_max = len; + + /* average deviation from average packet length */ + dvi = desc->recv_dvi; + desc->recv_dvi = dvi + ((len - avg) - dvi) / n; + desc->recv_cnt = n; +} + +/*---------------------------------------------------------------------------- + + TCP + +-----------------------------------------------------------------------------*/ + +/* +** Set new size on buffer, used when packet size is determined +** and the buffer is to small. +** buffer must have a size of at least len bytes (counting from ptr_start!) +*/ +static int tcp_expand_buffer(tcp_descriptor* desc, int len) +{ + ErlDrvBinary* bin; + int offs1; + int offs2; + int used = desc->i_ptr_start - desc->i_buf->orig_bytes; + int ulen = used + len; + + if (desc->i_bufsz >= ulen) /* packet will fit */ + return 0; + else if (desc->i_buf->orig_size >= ulen) { /* buffer is large enough */ + desc->i_bufsz = ulen; /* set "virtual" size */ + return 0; + } + + DEBUGF(("tcp_expand_buffer(%ld): s=%d, from %ld to %d\r\n", + (long)desc->inet.port, desc->inet.s, desc->i_buf->orig_size, ulen)); + + offs1 = desc->i_ptr_start - desc->i_buf->orig_bytes; + offs2 = desc->i_ptr - desc->i_ptr_start; + + if ((bin = driver_realloc_binary(desc->i_buf, ulen)) == NULL) + return -1; + + desc->i_buf = bin; + desc->i_ptr_start = bin->orig_bytes + offs1; + desc->i_ptr = desc->i_ptr_start + offs2; + desc->i_bufsz = ulen; + return 0; +} + +/* push data into i_buf */ +static int tcp_push_buffer(tcp_descriptor* desc, char* buf, int len) +{ + ErlDrvBinary* bin; + + if (desc->i_buf == NULL) { + bin = alloc_buffer(len); + sys_memcpy(bin->orig_bytes, buf, len); + desc->i_buf = bin; + desc->i_bufsz = len; + desc->i_ptr_start = desc->i_buf->orig_bytes; + desc->i_ptr = desc->i_ptr_start + len; + } + else { + char* start = desc->i_buf->orig_bytes; + int sz_before = desc->i_ptr_start - start; + int sz_filled = desc->i_ptr - desc->i_ptr_start; + + if (len <= sz_before) { + sys_memcpy(desc->i_ptr_start - len, buf, len); + desc->i_ptr_start -= len; + } + else { + bin = alloc_buffer(desc->i_bufsz+len); + sys_memcpy(bin->orig_bytes, buf, len); + sys_memcpy(bin->orig_bytes+len, desc->i_ptr_start, sz_filled); + free_buffer(desc->i_buf); + desc->i_bufsz += len; + desc->i_buf = bin; + desc->i_ptr_start = bin->orig_bytes; + desc->i_ptr = desc->i_ptr_start + sz_filled + len; + } + } + desc->i_remain = 0; + return 0; +} + +/* clear CURRENT input buffer */ +static void tcp_clear_input(tcp_descriptor* desc) +{ + if (desc->i_buf != NULL) + free_buffer(desc->i_buf); + desc->i_buf = NULL; + desc->i_remain = 0; + desc->i_ptr = NULL; + desc->i_ptr_start = NULL; + desc->i_bufsz = 0; +} + +/* clear QUEUED output */ +static void tcp_clear_output(tcp_descriptor* desc) +{ + ErlDrvPort ix = desc->inet.port; + int qsz = driver_sizeq(ix); + + driver_deq(ix, qsz); + send_empty_out_q_msgs(INETP(desc)); +} + + +/* Move data so that ptr_start point at buf->orig_bytes */ +static void tcp_restart_input(tcp_descriptor* desc) +{ + if (desc->i_ptr_start != desc->i_buf->orig_bytes) { + int n = desc->i_ptr - desc->i_ptr_start; + + DEBUGF(("tcp_restart_input: move %d bytes\r\n", n)); + sys_memmove(desc->i_buf->orig_bytes, desc->i_ptr_start, n); + desc->i_ptr_start = desc->i_buf->orig_bytes; + desc->i_ptr = desc->i_ptr_start + n; + } +} + + +static int tcp_inet_init(void) +{ + DEBUGF(("tcp_inet_init() {}\r\n")); + return 0; +} + +/* initialize the TCP descriptor */ + +static ErlDrvData tcp_inet_start(ErlDrvPort port, char* args) +{ + tcp_descriptor* desc; + DEBUGF(("tcp_inet_start(%ld) {\r\n", (long)port)); + + desc = (tcp_descriptor*) + inet_start(port, sizeof(tcp_descriptor), IPPROTO_TCP); + if (desc == NULL) + return ERL_DRV_ERROR_ERRNO; + desc->high = INET_HIGH_WATERMARK; + desc->low = INET_LOW_WATERMARK; + desc->send_timeout = INET_INFINITY; + desc->send_timeout_close = 0; + desc->busy_on_send = 0; + desc->i_buf = NULL; + desc->i_ptr = NULL; + desc->i_ptr_start = NULL; + desc->i_remain = 0; + desc->i_bufsz = 0; + desc->tcp_add_flags = 0; + desc->http_state = 0; + desc->mtd = NULL; + desc->multi_first = desc->multi_last = NULL; + DEBUGF(("tcp_inet_start(%ld) }\r\n", (long)port)); + return (ErlDrvData) desc; +} + +/* Copy a descriptor, by creating a new port with same settings + * as the descriptor desc. + * return NULL on error (ENFILE no ports avail) + */ +static tcp_descriptor* tcp_inet_copy(tcp_descriptor* desc,SOCKET s, + ErlDrvTermData owner, int* err) +{ + ErlDrvPort port = desc->inet.port; + tcp_descriptor* copy_desc; + + copy_desc = (tcp_descriptor*) tcp_inet_start(port, NULL); + + /* Setup event if needed */ + if ((copy_desc->inet.s = s) != INVALID_SOCKET) { + if ((copy_desc->inet.event = sock_create_event(INETP(copy_desc))) == + INVALID_EVENT) { + *err = sock_errno(); + FREE(copy_desc); + return NULL; + } + } + + /* Some flags must be inherited at this point */ + copy_desc->inet.mode = desc->inet.mode; + copy_desc->inet.exitf = desc->inet.exitf; + copy_desc->inet.bit8f = desc->inet.bit8f; + copy_desc->inet.deliver = desc->inet.deliver; + copy_desc->inet.htype = desc->inet.htype; + copy_desc->inet.psize = desc->inet.psize; + copy_desc->inet.stype = desc->inet.stype; + copy_desc->inet.sfamily = desc->inet.sfamily; + copy_desc->inet.hsz = desc->inet.hsz; + copy_desc->inet.bufsz = desc->inet.bufsz; + copy_desc->high = desc->high; + copy_desc->low = desc->low; + copy_desc->send_timeout = desc->send_timeout; + copy_desc->send_timeout_close = desc->send_timeout_close; + + /* The new port will be linked and connected to the original caller */ + port = driver_create_port(port, owner, "tcp_inet", (ErlDrvData) copy_desc); + if ((long)port == -1) { + *err = ENFILE; + FREE(copy_desc); + return NULL; + } + copy_desc->inet.port = port; + copy_desc->inet.dport = driver_mk_port(port); + *err = 0; + return copy_desc; +} + +/* +** Check Special cases: +** 1. we are a listener doing nb accept -> report error on accept ! +** 2. we are doing accept -> restore listener state +*/ +static void tcp_close_check(tcp_descriptor* desc) +{ + /* XXX:PaN - multiple clients to handle! */ + if (desc->inet.state == TCP_STATE_ACCEPTING) { + inet_async_op *this_op = desc->inet.opt; + sock_select(INETP(desc), FD_ACCEPT, 0); + desc->inet.state = TCP_STATE_LISTEN; + if (this_op != NULL) { + driver_demonitor_process(desc->inet.port, &(this_op->monitor)); + } + async_error_am(INETP(desc), am_closed); + } + else if (desc->inet.state == TCP_STATE_MULTI_ACCEPTING) { + int id,req; + ErlDrvTermData caller; + ErlDrvMonitor monitor; + + sock_select(INETP(desc), FD_ACCEPT, 0); + desc->inet.state = TCP_STATE_LISTEN; + while (deq_multi_op(desc,&id,&req,&caller,NULL,&monitor) == 0) { + driver_demonitor_process(desc->inet.port, &monitor); + send_async_error(desc->inet.port, desc->inet.dport, id, caller, am_closed); + } + clean_multi_timers(&(desc->mtd), desc->inet.port); + } + + else if (desc->inet.state == TCP_STATE_CONNECTING) { + async_error_am(INETP(desc), am_closed); + } + else if (desc->inet.state == TCP_STATE_CONNECTED) { + async_error_am_all(INETP(desc), am_closed); + } +} + +/* +** Cleanup & Free +*/ +static void tcp_inet_stop(ErlDrvData e) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + DEBUGF(("tcp_inet_stop(%ld) {s=%d\r\n", + (long)desc->inet.port, desc->inet.s)); + tcp_close_check(desc); + /* free input buffer & output buffer */ + if (desc->i_buf != NULL) + release_buffer(desc->i_buf); + desc->i_buf = NULL; /* net_mess2 may call this function recursively when + faulty messages arrive on dist ports*/ + DEBUGF(("tcp_inet_stop(%ld) }\r\n", (long)desc->inet.port)); + inet_stop(INETP(desc)); +} + + + + +/* TCP requests from Erlang */ +static int tcp_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len, + char** rbuf, int rsize) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + switch(cmd) { + case INET_REQ_OPEN: /* open socket and return internal index */ + DEBUGF(("tcp_inet_ctl(%ld): OPEN\r\n", (long)desc->inet.port)); + if ((len == 1) && (buf[0] == INET_AF_INET)) + return + inet_ctl_open(INETP(desc), AF_INET, SOCK_STREAM, rbuf, rsize); +#if defined(HAVE_IN6) && defined(AF_INET6) + else if ((len == 1) && (buf[0] == INET_AF_INET6)) + return + inet_ctl_open(INETP(desc), AF_INET6, SOCK_STREAM, rbuf, rsize); +#else + else if ((len == 1) && (buf[0] == INET_AF_INET6)) + return ctl_xerror("eafnosupport",rbuf,rsize); +#endif + else + return ctl_error(EINVAL, rbuf, rsize); + + case INET_REQ_FDOPEN: /* pass in an open socket */ + DEBUGF(("tcp_inet_ctl(%ld): FDOPEN\r\n", (long)desc->inet.port)); + if ((len == 5) && (buf[0] == INET_AF_INET)) + return inet_ctl_fdopen(INETP(desc), AF_INET, SOCK_STREAM, + (SOCKET) get_int32(buf+1), rbuf, rsize); +#if defined(HAVE_IN6) && defined(AF_INET6) + else if ((len == 5) && (buf[0] == INET_AF_INET6)) + return inet_ctl_fdopen(INETP(desc), AF_INET6, SOCK_STREAM, + (SOCKET) get_int32(buf+1), rbuf, rsize); +#endif + else + return ctl_error(EINVAL, rbuf, rsize); + + case TCP_REQ_LISTEN: { /* argument backlog */ + + int backlog; + DEBUGF(("tcp_inet_ctl(%ld): LISTEN\r\n", (long)desc->inet.port)); + if (desc->inet.state == TCP_STATE_CLOSED) + return ctl_xerror(EXBADPORT, rbuf, rsize); + if (!IS_OPEN(INETP(desc))) + return ctl_xerror(EXBADPORT, rbuf, rsize); + if (!IS_BOUND(INETP(desc))) + return ctl_xerror(EXBADSEQ, rbuf, rsize); + if (len != 2) + return ctl_error(EINVAL, rbuf, rsize); + backlog = get_int16(buf); + if (sock_listen(desc->inet.s, backlog) == SOCKET_ERROR) + return ctl_error(sock_errno(), rbuf, rsize); + desc->inet.state = TCP_STATE_LISTEN; + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } + + + case INET_REQ_CONNECT: { /* do async connect */ + int code; + char tbuf[2]; + unsigned timeout; + + DEBUGF(("tcp_inet_ctl(%ld): CONNECT\r\n", (long)desc->inet.port)); + /* INPUT: Timeout(4), Port(2), Address(N) */ + + if (!IS_OPEN(INETP(desc))) + return ctl_xerror(EXBADPORT, rbuf, rsize); + if (IS_CONNECTED(INETP(desc))) + return ctl_error(EISCONN, rbuf, rsize); + if (!IS_BOUND(INETP(desc))) + return ctl_xerror(EXBADSEQ, rbuf, rsize); + if (IS_CONNECTING(INETP(desc))) + return ctl_error(EINVAL, rbuf, rsize); + if (len < 6) + return ctl_error(EINVAL, rbuf, rsize); + timeout = get_int32(buf); + buf += 4; + len -= 4; + if (inet_set_address(desc->inet.sfamily, &desc->inet.remote, + buf, &len) == NULL) + return ctl_error(EINVAL, rbuf, rsize); + + code = sock_connect(desc->inet.s, + (struct sockaddr*) &desc->inet.remote, len); + if ((code == SOCKET_ERROR) && + ((sock_errno() == ERRNO_BLOCK) || /* Winsock2 */ + (sock_errno() == EINPROGRESS))) { /* Unix & OSE!! */ + sock_select(INETP(desc), FD_CONNECT, 1); + desc->inet.state = TCP_STATE_CONNECTING; + if (timeout != INET_INFINITY) + driver_set_timer(desc->inet.port, timeout); + enq_async(INETP(desc), tbuf, INET_REQ_CONNECT); + } + else if (code == 0) { /* ok we are connected */ + desc->inet.state = TCP_STATE_CONNECTED; + if (desc->inet.active) + sock_select(INETP(desc), (FD_READ|FD_CLOSE), 1); + enq_async(INETP(desc), tbuf, INET_REQ_CONNECT); + async_ok(INETP(desc)); + } + else { + return ctl_error(sock_errno(), rbuf, rsize); + } + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } + + case TCP_REQ_ACCEPT: { /* do async accept */ + char tbuf[2]; + unsigned timeout; + inet_address remote; + unsigned int n; + SOCKET s; + + DEBUGF(("tcp_inet_ctl(%ld): ACCEPT\r\n", (long)desc->inet.port)); + /* INPUT: Timeout(4) */ + + if ((desc->inet.state != TCP_STATE_LISTEN && desc->inet.state != TCP_STATE_ACCEPTING && + desc->inet.state != TCP_STATE_MULTI_ACCEPTING) || len != 4) { + return ctl_error(EINVAL, rbuf, rsize); + } + + timeout = get_int32(buf); + + if (desc->inet.state == TCP_STATE_ACCEPTING) { + unsigned long time_left; + int oid; + ErlDrvTermData ocaller; + int oreq; + unsigned otimeout; + ErlDrvTermData caller = driver_caller(desc->inet.port); + MultiTimerData *mtd = NULL,*omtd = NULL; + ErlDrvMonitor monitor, omonitor; + + + if (driver_monitor_process(desc->inet.port, caller ,&monitor) != 0) { + return ctl_xerror("noproc", rbuf, rsize); + } + deq_async_w_tmo(INETP(desc),&oid,&ocaller,&oreq,&otimeout,&omonitor); + if (otimeout != INET_INFINITY) { + driver_read_timer(desc->inet.port, &time_left); + driver_cancel_timer(desc->inet.port); + if (time_left <= 0) { + time_left = 1; + } + omtd = add_multi_timer(&(desc->mtd), desc->inet.port, ocaller, + time_left, &tcp_inet_multi_timeout); + } + enq_old_multi_op(desc, oid, oreq, ocaller, omtd, &omonitor); + if (timeout != INET_INFINITY) { + mtd = add_multi_timer(&(desc->mtd), desc->inet.port, caller, + timeout, &tcp_inet_multi_timeout); + } + enq_multi_op(desc, tbuf, TCP_REQ_ACCEPT, caller, mtd, &monitor); + desc->inet.state = TCP_STATE_MULTI_ACCEPTING; + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } else if (desc->inet.state == TCP_STATE_MULTI_ACCEPTING) { + ErlDrvTermData caller = driver_caller(desc->inet.port); + MultiTimerData *mtd = NULL; + ErlDrvMonitor monitor; + + if (driver_monitor_process(desc->inet.port, caller ,&monitor) != 0) { + return ctl_xerror("noproc", rbuf, rsize); + } + if (timeout != INET_INFINITY) { + mtd = add_multi_timer(&(desc->mtd), desc->inet.port, caller, + timeout, &tcp_inet_multi_timeout); + } + enq_multi_op(desc, tbuf, TCP_REQ_ACCEPT, caller, mtd, &monitor); + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } else { + n = sizeof(desc->inet.remote); + s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &n); + if (s == INVALID_SOCKET) { + if (sock_errno() == ERRNO_BLOCK) { + ErlDrvMonitor monitor; + if (driver_monitor_process(desc->inet.port, driver_caller(desc->inet.port), + &monitor) != 0) { + return ctl_xerror("noproc", rbuf, rsize); + } + enq_async_w_tmo(INETP(desc), tbuf, TCP_REQ_ACCEPT, timeout, &monitor); + desc->inet.state = TCP_STATE_ACCEPTING; + sock_select(INETP(desc),FD_ACCEPT,1); + if (timeout != INET_INFINITY) { + driver_set_timer(desc->inet.port, timeout); + } + } else { + return ctl_error(sock_errno(), rbuf, rsize); + } + } else { + ErlDrvTermData caller = driver_caller(desc->inet.port); + tcp_descriptor* accept_desc; + int err; + + if ((accept_desc = tcp_inet_copy(desc,s,caller,&err)) == NULL) { + sock_close(s); + return ctl_error(err, rbuf, rsize); + } + /* FIXME: may MUST lock access_port + * 1 - Port is accessible via the erlang:ports() + * 2 - Port is accessible via callers process_info(links) + */ + accept_desc->inet.remote = remote; + SET_NONBLOCKING(accept_desc->inet.s); +#ifdef __WIN32__ + driver_select(accept_desc->inet.port, accept_desc->inet.event, + ERL_DRV_READ, 1); +#endif + accept_desc->inet.state = TCP_STATE_CONNECTED; + enq_async(INETP(desc), tbuf, TCP_REQ_ACCEPT); + async_ok_port(INETP(desc), accept_desc->inet.dport); + } + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } + } + case INET_REQ_CLOSE: + DEBUGF(("tcp_inet_ctl(%ld): CLOSE\r\n", (long)desc->inet.port)); + tcp_close_check(desc); + erl_inet_close(INETP(desc)); + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + + + case TCP_REQ_RECV: { + unsigned timeout; + char tbuf[2]; + int n; + + DEBUGF(("tcp_inet_ctl(%ld): RECV\r\n", (long)desc->inet.port)); + /* INPUT: Timeout(4), Length(4) */ + if (!IS_CONNECTED(INETP(desc))) { + if (desc->tcp_add_flags & TCP_ADDF_DELAYED_CLOSE_RECV) { + desc->tcp_add_flags &= ~(TCP_ADDF_DELAYED_CLOSE_RECV| + TCP_ADDF_DELAYED_CLOSE_SEND); + return ctl_reply(INET_REP_ERROR, "closed", 6, rbuf, rsize); + } + return ctl_error(ENOTCONN, rbuf, rsize); + } + if (desc->inet.active || (len != 8)) + return ctl_error(EINVAL, rbuf, rsize); + timeout = get_int32(buf); + buf += 4; + n = get_int32(buf); + DEBUGF(("tcp_inet_ctl(%ld) timeout = %d, n = %d\r\n", + (long)desc->inet.port,timeout,n)); + if ((desc->inet.htype != TCP_PB_RAW) && (n != 0)) + return ctl_error(EINVAL, rbuf, rsize); + if (n > TCP_MAX_PACKET_SIZE) + return ctl_error(ENOMEM, rbuf, rsize); + if (enq_async(INETP(desc), tbuf, TCP_REQ_RECV) < 0) + return ctl_error(EALREADY, rbuf, rsize); + + if (tcp_recv(desc, n) == 0) { + if (timeout == 0) + async_error_am(INETP(desc), am_timeout); + else { + if (timeout != INET_INFINITY) + driver_set_timer(desc->inet.port, timeout); + sock_select(INETP(desc),(FD_READ|FD_CLOSE),1); + } + } + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } + + case TCP_REQ_UNRECV: { + DEBUGF(("tcp_inet_ctl(%ld): UNRECV\r\n", (long)desc->inet.port)); + if (!IS_CONNECTED(INETP(desc))) + return ctl_error(ENOTCONN, rbuf, rsize); + tcp_push_buffer(desc, buf, len); + if (desc->inet.active) + tcp_deliver(desc, 0); + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } +#ifndef _OSE_ + case TCP_REQ_SHUTDOWN: { + int how; + DEBUGF(("tcp_inet_ctl(%ld): FDOPEN\r\n", (long)desc->inet.port)); + if (!IS_CONNECTED(INETP(desc))) { + return ctl_error(ENOTCONN, rbuf, rsize); + } + if (len != 1) { + return ctl_error(EINVAL, rbuf, rsize); + } + how = buf[0]; + if (sock_shutdown(INETP(desc)->s, how) == 0) { + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } else { + return ctl_error(sock_errno(), rbuf, rsize); + } + } +#endif + default: + DEBUGF(("tcp_inet_ctl(%ld): %u\r\n", (long)desc->inet.port, cmd)); + return inet_ctl(INETP(desc), cmd, buf, len, rbuf, rsize); + } + +} + +/* +** tcp_inet_timeout: +** called when timer expire: +** TCP socket may be: +** +** a) receiving -- deselect +** b) connecting -- close socket +** c) accepting -- reset listener +** +*/ + +static void tcp_inet_timeout(ErlDrvData e) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + int state = desc->inet.state; + + DEBUGF(("tcp_inet_timeout(%ld) {s=%d\r\n", + (long)desc->inet.port, desc->inet.s)); + if ((state & INET_F_MULTI_CLIENT)) { /* Multi-client always means multi-timers */ + fire_multi_timers(&(desc->mtd), desc->inet.port, e); + } else if ((state & TCP_STATE_CONNECTED) == TCP_STATE_CONNECTED) { + if (desc->busy_on_send) { + ASSERT(IS_BUSY(INETP(desc))); + desc->inet.caller = desc->inet.busy_caller; + desc->inet.state &= ~INET_F_BUSY; + desc->busy_on_send = 0; + set_busy_port(desc->inet.port, 0); + inet_reply_error_am(INETP(desc), am_timeout); + if (desc->send_timeout_close) { + erl_inet_close(INETP(desc)); + } + } + else { + /* assume recv timeout */ + ASSERT(!desc->inet.active); + sock_select(INETP(desc),(FD_READ|FD_CLOSE),0); + desc->i_remain = 0; + async_error_am(INETP(desc), am_timeout); + } + } + else if ((state & TCP_STATE_CONNECTING) == TCP_STATE_CONNECTING) { + /* assume connect timeout */ + /* close the socket since it's not usable (see man pages) */ + erl_inet_close(INETP(desc)); + async_error_am(INETP(desc), am_timeout); + } + else if ((state & TCP_STATE_ACCEPTING) == TCP_STATE_ACCEPTING) { + inet_async_op *this_op = desc->inet.opt; + /* timer is set on accept */ + sock_select(INETP(desc), FD_ACCEPT, 0); + if (this_op != NULL) { + driver_demonitor_process(desc->inet.port, &(this_op->monitor)); + } + desc->inet.state = TCP_STATE_LISTEN; + async_error_am(INETP(desc), am_timeout); + } + DEBUGF(("tcp_inet_timeout(%ld) }\r\n", (long)desc->inet.port)); +} + +static void tcp_inet_multi_timeout(ErlDrvData e, ErlDrvTermData caller) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + int id,req; + ErlDrvMonitor monitor; + + if (remove_multi_op(desc, &id, &req, caller, NULL, &monitor) != 0) { + return; + } + driver_demonitor_process(desc->inet.port, &monitor); + if (desc->multi_first == NULL) { + sock_select(INETP(desc),FD_ACCEPT,0); + desc->inet.state = TCP_STATE_LISTEN; /* restore state */ + } + send_async_error(desc->inet.port, desc->inet.dport, id, caller, am_timeout); +} + + + +/* +** command: +** output on a socket only ! +** a reply code will be sent to connected (caller later) +** {inet_reply, S, Status} +** NOTE! normal sockets use the the tcp_inet_commandv +** but distribution still uses the tcp_inet_command!! +*/ + +static void tcp_inet_command(ErlDrvData e, char *buf, int len) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + desc->inet.caller = driver_caller(desc->inet.port); + + DEBUGF(("tcp_inet_command(%ld) {s=%d\r\n", + (long)desc->inet.port, desc->inet.s)); + if (!IS_CONNECTED(INETP(desc))) + inet_reply_error(INETP(desc), ENOTCONN); + else if (tcp_send(desc, buf, len) == 0) + inet_reply_ok(INETP(desc)); + DEBUGF(("tcp_inet_command(%ld) }\r\n", (long)desc->inet.port)); +} + + +static void tcp_inet_commandv(ErlDrvData e, ErlIOVec* ev) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + desc->inet.caller = driver_caller(desc->inet.port); + + DEBUGF(("tcp_inet_commanv(%ld) {s=%d\r\n", + (long)desc->inet.port, desc->inet.s)); + if (!IS_CONNECTED(INETP(desc))) { + if (desc->tcp_add_flags & TCP_ADDF_DELAYED_CLOSE_SEND) { + desc->tcp_add_flags &= ~TCP_ADDF_DELAYED_CLOSE_SEND; + inet_reply_error_am(INETP(desc), am_closed); + } + else + inet_reply_error(INETP(desc), ENOTCONN); + } + else if (tcp_sendv(desc, ev) == 0) + inet_reply_ok(INETP(desc)); + DEBUGF(("tcp_inet_commandv(%ld) }\r\n", (long)desc->inet.port)); +} + +static void tcp_inet_flush(ErlDrvData e) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + if (!(desc->inet.event_mask & FD_WRITE)) { + /* Discard send queue to avoid hanging port (OTP-7615) */ + tcp_clear_output(desc); + } +} + +static void tcp_inet_process_exit(ErlDrvData e, ErlDrvMonitor *monitorp) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + ErlDrvTermData who = driver_get_monitored_process(desc->inet.port,monitorp); + int state = desc->inet.state; + + if ((state & TCP_STATE_MULTI_ACCEPTING) == TCP_STATE_MULTI_ACCEPTING) { + int id,req; + MultiTimerData *timeout; + if (remove_multi_op(desc, &id, &req, who, &timeout, NULL) != 0) { + return; + } + if (timeout != NULL) { + remove_multi_timer(&(desc->mtd), desc->inet.port, timeout); + } + if (desc->multi_first == NULL) { + sock_select(INETP(desc),FD_ACCEPT,0); + desc->inet.state = TCP_STATE_LISTEN; /* restore state */ + } + } else if ((state & TCP_STATE_ACCEPTING) == TCP_STATE_ACCEPTING) { + int did,drid; + ErlDrvTermData dcaller; + deq_async(INETP(desc), &did, &dcaller, &drid); + driver_cancel_timer(desc->inet.port); + sock_select(INETP(desc),FD_ACCEPT,0); + desc->inet.state = TCP_STATE_LISTEN; /* restore state */ + } +} + +static void inet_stop_select(ErlDrvEvent event, void* _) +{ +#ifdef __WIN32__ + WSACloseEvent((HANDLE)event); +#else + sock_close((SOCKET)(long)event); +#endif +} + +/* The peer socket has closed, cleanup and send event */ +static int tcp_recv_closed(tcp_descriptor* desc) +{ +#ifdef DEBUG + long port = (long) desc->inet.port; /* Used after driver_exit() */ +#endif + DEBUGF(("tcp_recv_closed(%ld): s=%d, in %s, line %d\r\n", + port, desc->inet.s, __FILE__, __LINE__)); + if (IS_BUSY(INETP(desc))) { + /* A send is blocked */ + desc->inet.caller = desc->inet.busy_caller; + tcp_clear_output(desc); + if (desc->busy_on_send) { + driver_cancel_timer(desc->inet.port); + desc->busy_on_send = 0; + DEBUGF(("tcp_recv_closed(%ld): busy on send\r\n", port)); + } + desc->inet.state &= ~INET_F_BUSY; + set_busy_port(desc->inet.port, 0); + inet_reply_error_am(INETP(desc), am_closed); + DEBUGF(("tcp_recv_closed(%ld): busy reply 'closed'\r\n", port)); + } + if (!desc->inet.active) { + /* We must cancel any timer here ! */ + driver_cancel_timer(desc->inet.port); + /* passive mode do not terminate port ! */ + tcp_clear_input(desc); + if (desc->inet.exitf) { + tcp_clear_output(desc); + desc_close(INETP(desc)); + } else { + desc_close_read(INETP(desc)); + } + async_error_am_all(INETP(desc), am_closed); + /* next time EXBADSEQ will be delivered */ + DEBUGF(("tcp_recv_closed(%ld): passive reply all 'closed'\r\n", port)); + } else { + tcp_clear_input(desc); + tcp_closed_message(desc); + if (desc->inet.exitf) { + driver_exit(desc->inet.port, 0); + } else { + desc_close_read(INETP(desc)); + } + DEBUGF(("tcp_recv_closed(%ld): active close\r\n", port)); + } + DEBUGF(("tcp_recv_closed(%ld): done\r\n", port)); + return -1; +} + + +/* We have a read error determine the action */ +static int tcp_recv_error(tcp_descriptor* desc, int err) +{ + if (err != ERRNO_BLOCK) { + if (IS_BUSY(INETP(desc))) { + /* A send is blocked */ + desc->inet.caller = desc->inet.busy_caller; + tcp_clear_output(desc); + if (desc->busy_on_send) { + driver_cancel_timer(desc->inet.port); + desc->busy_on_send = 0; + } + desc->inet.state &= ~INET_F_BUSY; + set_busy_port(desc->inet.port, 0); + inet_reply_error_am(INETP(desc), am_closed); + } + if (!desc->inet.active) { + /* We must cancel any timer here ! */ + driver_cancel_timer(desc->inet.port); + tcp_clear_input(desc); + if (desc->inet.exitf) { + desc_close(INETP(desc)); + } else { + desc_close_read(INETP(desc)); + } + async_error_am_all(INETP(desc), error_atom(err)); + } else { + tcp_clear_input(desc); + tcp_error_message(desc, err); /* first error */ + tcp_closed_message(desc); /* then closed */ + if (desc->inet.exitf) + driver_exit(desc->inet.port, err); + else + desc_close(INETP(desc)); + } + return -1; + } + return 0; +} + + + +/* +** Calculate number of bytes that remain to read before deliver +** Assume buf, ptr_start, ptr has been setup +** +** return > 0 if more to read +** = 0 if holding complete packet +** < 0 on error +** +** if return value == 0 then *len will hold the length of the first packet +** return value > 0 then if *len == 0 then value means upperbound +** *len > 0 then value means exact +** +*/ +static int tcp_remain(tcp_descriptor* desc, int* len) +{ + char* ptr = desc->i_ptr_start; + int nfill = (desc->i_ptr - desc->i_buf->orig_bytes); /* filled */ + int nsz = desc->i_bufsz - nfill; /* remain */ + int n = desc->i_ptr - ptr; /* number of bytes read */ + int tlen; + + DEBUGF(("tcp_remain(%ld): s=%d, n=%d, nfill=%d nsz=%d\r\n", + (long)desc->inet.port, desc->inet.s, n, nfill, nsz)); + + tlen = packet_get_length(desc->inet.htype, ptr, n, + desc->inet.psize, desc->i_bufsz, + &desc->http_state); + if (tlen > 0) { + if (tlen <= n) { /* got a packet */ + *len = tlen; + DEBUGF((" => nothing remain packet=%d\r\n", tlen)); + return 0; + } + else { /* need known more */ + if (tcp_expand_buffer(desc, tlen) < 0) + return -1; + *len = tlen - n; + DEBUGF((" => remain=%d\r\n", *len)); + return *len; + } + } + else if (tlen == 0) { /* need unknown more */ + *len = 0; + if (nsz == 0) { + if (nfill == n) + goto error; + DEBUGF((" => restart more=%d\r\n", nfill - n)); + return nfill - n; + } + else { + DEBUGF((" => more=%d \r\n", nsz)); + return nsz; + } + } + +error: + DEBUGF((" => packet error\r\n")); + return -1; +} + +/* +** Deliver all packets ready +** if len == 0 then check start with a check for ready packet +*/ +static int tcp_deliver(tcp_descriptor* desc, int len) +{ + int count = 0; + int n; + + /* Poll for ready packet */ + if (len == 0) { + /* empty buffer or waiting for more input */ + if ((desc->i_buf == NULL) || (desc->i_remain > 0)) + return count; + if ((n = tcp_remain(desc, &len)) != 0) { + if (n < 0) /* packet error */ + return n; + if (len > 0) /* more data pending */ + desc->i_remain = len; + return count; + } + } + + while (len > 0) { + int code = 0; + + inet_input_count(INETP(desc), len); + + /* deliver binary? */ + if (len*4 >= desc->i_buf->orig_size*3) { /* >=75% */ + /* something after? */ + if (desc->i_ptr_start + len == desc->i_ptr) { /* no */ + code = tcp_reply_binary_data(desc, desc->i_buf, + (desc->i_ptr_start - + desc->i_buf->orig_bytes), + len); + tcp_clear_input(desc); + } + else { /* move trail to beginning of a new buffer */ + ErlDrvBinary* bin; + char* ptr_end = desc->i_ptr_start + len; + int sz = desc->i_ptr - ptr_end; + + bin = alloc_buffer(desc->i_bufsz); + memcpy(bin->orig_bytes, ptr_end, sz); + + code = tcp_reply_binary_data(desc, desc->i_buf, + (desc->i_ptr_start- + desc->i_buf->orig_bytes), + len); + free_buffer(desc->i_buf); + desc->i_buf = bin; + desc->i_ptr_start = desc->i_buf->orig_bytes; + desc->i_ptr = desc->i_ptr_start + sz; + desc->i_remain = 0; + } + } + else { + code = tcp_reply_data(desc, desc->i_ptr_start, len); + /* XXX The buffer gets thrown away on error (code < 0) */ + /* Windows needs workaround for this in tcp_inet_event... */ + desc->i_ptr_start += len; + if (desc->i_ptr_start == desc->i_ptr) + tcp_clear_input(desc); + else + desc->i_remain = 0; + + } + + if (code < 0) + return code; + + count++; + len = 0; + + if (!desc->inet.active) { + driver_cancel_timer(desc->inet.port); + sock_select(INETP(desc),(FD_READ|FD_CLOSE),0); + if (desc->i_buf != NULL) + tcp_restart_input(desc); + } + else if (desc->i_buf != NULL) { + if ((n = tcp_remain(desc, &len)) != 0) { + if (n < 0) /* packet error */ + return n; + tcp_restart_input(desc); + if (len > 0) + desc->i_remain = len; + len = 0; + } + } + } + return count; +} + + +static int tcp_recv(tcp_descriptor* desc, int request_len) +{ + int n; + int len; + int nread; + + if (desc->i_buf == NULL) { /* allocte a read buffer */ + int sz = (request_len > 0) ? request_len : desc->inet.bufsz; + + if ((desc->i_buf = alloc_buffer(sz)) == NULL) + return -1; + /* XXX: changing bufsz during recv SHOULD/MAY? affect + * ongoing operation but is not now + */ + desc->i_bufsz = sz; /* use i_bufsz not i_buf->orig_size ! */ + desc->i_ptr_start = desc->i_buf->orig_bytes; + desc->i_ptr = desc->i_ptr_start; + nread = sz; + if (request_len > 0) + desc->i_remain = request_len; + else + desc->i_remain = 0; + } + else if (request_len > 0) { /* we have a data in buffer and a request */ + n = desc->i_ptr - desc->i_ptr_start; + if (n >= request_len) + return tcp_deliver(desc, request_len); + else if (tcp_expand_buffer(desc, request_len) < 0) + return tcp_recv_error(desc, ENOMEM); + else + desc->i_remain = nread = request_len - n; + } + else if (desc->i_remain == 0) { /* poll remain from buffer data */ + if ((nread = tcp_remain(desc, &len)) < 0) + return tcp_recv_error(desc, EMSGSIZE); + else if (nread == 0) + return tcp_deliver(desc, len); + else if (len > 0) + desc->i_remain = len; /* set remain */ + } + else /* remain already set use it */ + nread = desc->i_remain; + + DEBUGF(("tcp_recv(%ld): s=%d about to read %d bytes...\r\n", + (long)desc->inet.port, desc->inet.s, nread)); + + n = sock_recv(desc->inet.s, desc->i_ptr, nread, 0); + + if (n == SOCKET_ERROR) { + int err = sock_errno(); + if (err == ECONNRESET) { + DEBUGF((" => detected close (connreset)\r\n")); + return tcp_recv_closed(desc); + } + if (err == ERRNO_BLOCK) { + DEBUGF((" => would block\r\n")); + return 0; + } + else { + DEBUGF((" => error: %d\r\n", err)); + return tcp_recv_error(desc, err); + } + } + else if (n == 0) { + DEBUGF((" => detected close\r\n")); + return tcp_recv_closed(desc); + } + + DEBUGF((" => got %d bytes\r\n", n)); + desc->i_ptr += n; + if (desc->i_remain > 0) { + desc->i_remain -= n; + if (desc->i_remain == 0) + return tcp_deliver(desc, desc->i_ptr - desc->i_ptr_start); + } + else { + if ((nread = tcp_remain(desc, &len)) < 0) + return tcp_recv_error(desc, EMSGSIZE); + else if (nread == 0) + return tcp_deliver(desc, len); + else if (len > 0) + desc->i_remain = len; /* set remain */ + } + return 0; +} + + +#ifdef __WIN32__ + + +static int winsock_event_select(inet_descriptor *desc, int flags, int on) +{ + int save_event_mask = desc->event_mask; + + desc->forced_events = 0; + if (on) + desc->event_mask |= flags; + else + desc->event_mask &= (~flags); + DEBUGF(("port %d: winsock_event_select: " + "flags=%02X, on=%d, event_mask=%02X\n", + desc->port, flags, on, desc->event_mask)); + /* The RIGHT WAY (TM) to do this is to make sure: + A) The cancelling of all network events is done with + NULL as the event parameter (bug in NT's winsock), + B) The actual event handle is reset so that it is only + raised if one of the requested network events is active, + C) Avoid race conditions by making sure that the event cannot be set + while we are preparing to set the correct network event mask. + The simplest way to do it is to turn off all events, reset the + event handle and then, if event_mask != 0, turn on the appropriate + events again. */ + if (WSAEventSelect(desc->s, NULL, 0) != 0) { + DEBUGF(("port %d: winsock_event_select: " + "WSAEventSelect returned error, code %d.\n", + sock_errno())); + desc->event_mask = save_event_mask; + return -1; + } + if (!ResetEvent(desc->event)) { + DEBUGF(("port %d: winsock_event_select: " + "ResetEvent returned error, code %d.\n", + GetLastError())); + desc->event_mask = 0; + return -1; + } + if (desc->event_mask != 0) { + if (WSAEventSelect(desc->s, + desc->event, + desc->event_mask) != 0) { + DEBUGF(("port %d: winsock_event_select: " + "WSAEventSelect returned error, code %d.\n", + sock_errno())); + desc->event_mask = 0; + return -1; + } + + /* Now, WSAEventSelect() is trigged only when the queue goes from + full to empty or from empty to full; therefore we need an extra test + to see whether it is writeable, readable or closed... */ + if ((desc->event_mask & FD_WRITE)) { + int do_force = 1; + if (desc->send_would_block) { + TIMEVAL tmo = {0,0}; + FD_SET fds; + int ret; + + FD_ZERO(&fds); + FD_SET(desc->s,&fds); + do_force = (select(desc->s+1,0,&fds,0,&tmo) > 0); + } + if (do_force) { + SetEvent(desc->event); + desc->forced_events |= FD_WRITE; + } + } + if ((desc->event_mask & (FD_READ|FD_CLOSE))) { + int readable = 0; + int closed = 0; + TIMEVAL tmo = {0,0}; + FD_SET fds; + int ret; + unsigned long arg; + + FD_ZERO(&fds); + FD_SET(desc->s,&fds); + ret = select(desc->s+1,&fds,0,0,&tmo); + if (ret > 0) { + ++readable; + if (ioctlsocket(desc->s,FIONREAD,&arg) != 0) { + ++closed; /* Which gives a FD_CLOSE event */ + } else { + closed = (arg == 0); + } + } + if ((desc->event_mask & FD_READ) && readable && !closed) { + SetEvent(desc->event); + desc->forced_events |= FD_READ; + } + if ((desc->event_mask & FD_CLOSE) && closed) { + SetEvent(desc->event); + desc->forced_events |= FD_CLOSE; + } + } + } + return 0; +} + +static void tcp_inet_event(ErlDrvData e, ErlDrvEvent event) +{ + tcp_descriptor* desc = (tcp_descriptor*)e; + WSANETWORKEVENTS netEv; + int err; + + DEBUGF(("tcp_inet_event(%ld) {s=%d\r\n", + (long)desc->inet.port, desc->inet.s)); + if (WSAEnumNetworkEvents(desc->inet.s, desc->inet.event, + &netEv) != 0) { + DEBUGF((" => EnumNetworkEvents = %d\r\n", sock_errno() )); + goto error; + } + + DEBUGF((" => event=%02X, mask=%02X\r\n", + netEv.lNetworkEvents, desc->inet.event_mask)); + + /* Add the forced events. */ + + netEv.lNetworkEvents |= desc->inet.forced_events; + + /* + * Calling WSAEventSelect() with a mask of 0 doesn't always turn off + * all events. To avoid acting on events we don't want, we mask + * the events with mask for the events we really want. + */ + +#ifdef DEBUG + if ((netEv.lNetworkEvents & ~(desc->inet.event_mask)) != 0) { + DEBUGF(("port %d: ... unexpected event: %d\r\n", + desc->inet.port, netEv.lNetworkEvents & ~(desc->inet.event_mask))); + } +#endif + netEv.lNetworkEvents &= desc->inet.event_mask; + + if (netEv.lNetworkEvents & FD_READ) { + if (tcp_inet_input(desc, event) < 0) { + goto error; + } + if (netEv.lNetworkEvents & FD_CLOSE) { + /* + * We must loop to read out the remaining packets (if any). + */ + for (;;) { + DEBUGF(("Retrying read due to closed port\r\n")); + /* XXX The buffer will be thrown away on error (empty que). + Possible SMP FIXME. */ + if (!desc->inet.active && (desc->inet.opt) == NULL) { + goto error; + } + if (tcp_inet_input(desc, event) < 0) { + goto error; + } + } + } + } + if (netEv.lNetworkEvents & FD_WRITE) { + desc->inet.send_would_block = 0; + if (tcp_inet_output(desc, event) < 0) + goto error; + } + if (netEv.lNetworkEvents & FD_CONNECT) { + if ((err = netEv.iErrorCode[FD_CONNECT_BIT]) != 0) { + async_error(INETP(desc), err); + } else { + tcp_inet_output(desc, event); + } + } else if (netEv.lNetworkEvents & FD_ACCEPT) { + if ((err = netEv.iErrorCode[FD_ACCEPT_BIT]) != 0) + async_error(INETP(desc), err); + else + tcp_inet_input(desc, event); + } + if (netEv.lNetworkEvents & FD_CLOSE) { + /* error in err = netEv.iErrorCode[FD_CLOSE_BIT] */ + DEBUGF(("Detected close in %s, line %d\r\n", __FILE__, __LINE__)); + tcp_recv_closed(desc); + } + DEBUGF(("tcp_inet_event(%ld) }\r\n", (long)desc->inet.port)); + return; + + error: + DEBUGF(("tcp_inet_event(%ld) error}\r\n", (long)desc->inet.port)); + return; +} + +#endif /* WIN32 */ + + +/* socket has input: +** 1. TCP_STATE_ACCEPTING => non block accept ? +** 2. TCP_STATE_CONNECTED => read input +*/ +static int tcp_inet_input(tcp_descriptor* desc, HANDLE event) +{ + int ret = 0; +#ifdef DEBUG + long port = (long) desc->inet.port; /* Used after driver_exit() */ +#endif + DEBUGF(("tcp_inet_input(%ld) {s=%d\r\n", port, desc->inet.s)); + if (desc->inet.state == TCP_STATE_ACCEPTING) { + SOCKET s; + unsigned int len; + inet_address remote; + inet_async_op *this_op = desc->inet.opt; + + len = sizeof(desc->inet.remote); + s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &len); + if (s == INVALID_SOCKET && sock_errno() == ERRNO_BLOCK) { + /* Just try again, no real error, just a ghost trigger from poll, + keep the default return code and everything else as is */ + goto done; + } + + sock_select(INETP(desc),FD_ACCEPT,0); + desc->inet.state = TCP_STATE_LISTEN; /* restore state */ + + if (this_op != NULL) { + driver_demonitor_process(desc->inet.port, &(this_op->monitor)); + } + + + driver_cancel_timer(desc->inet.port); /* posssibly cancel a timer */ + + if (s == INVALID_SOCKET) { + ret = async_error(INETP(desc), sock_errno()); + goto done; + } + else { + ErlDrvTermData caller; + tcp_descriptor* accept_desc; + int err; + + if (desc->inet.opt == NULL) { + /* No caller setup */ + sock_close(s); + ret = async_error(INETP(desc), EINVAL); + goto done; + } + caller = desc->inet.opt->caller; + if ((accept_desc = tcp_inet_copy(desc,s,caller,&err)) == NULL) { + sock_close(s); + ret = async_error(INETP(desc), err); + goto done; + } + /* FIXME: may MUST lock port + * 1 - Port is accessible via the erlang:ports() + * 2 - Port is accessible via callers process_info(links) + */ + accept_desc->inet.remote = remote; + SET_NONBLOCKING(accept_desc->inet.s); +#ifdef __WIN32__ + driver_select(accept_desc->inet.port, accept_desc->inet.event, + ERL_DRV_READ, 1); +#endif + accept_desc->inet.state = TCP_STATE_CONNECTED; + ret = async_ok_port(INETP(desc), accept_desc->inet.dport); + goto done; + } + } else if (desc->inet.state == TCP_STATE_MULTI_ACCEPTING) { + SOCKET s; + unsigned int len; + inet_address remote; + int id,req; + ErlDrvTermData caller; + MultiTimerData *timeout; + ErlDrvMonitor monitor; +#ifdef HARDDEBUG + int times = 0; +#endif + + while (desc->inet.state == TCP_STATE_MULTI_ACCEPTING) { + len = sizeof(desc->inet.remote); + s = sock_accept(desc->inet.s, (struct sockaddr*) &remote, &len); + + if (s == INVALID_SOCKET && sock_errno() == ERRNO_BLOCK) { + /* Just try again, no real error, keep the last return code */ + goto done; + } +#ifdef HARDDEBUG + if (++times > 1) { + erts_fprintf(stderr,"Accepts in one suite: %d :-)\r\n",times); + } +#endif + if (deq_multi_op(desc,&id,&req,&caller,&timeout,&monitor) != 0) { + ret = -1; + goto done; + } + + if (desc->multi_first == NULL) { + sock_select(INETP(desc),FD_ACCEPT,0); + desc->inet.state = TCP_STATE_LISTEN; /* restore state */ + } + + if (timeout != NULL) { + remove_multi_timer(&(desc->mtd), desc->inet.port, timeout); + } + + driver_demonitor_process(desc->inet.port, &monitor); + + + if (s == INVALID_SOCKET) { /* Not ERRNO_BLOCK, that's handled right away */ + ret = send_async_error(desc->inet.port, desc->inet.dport, + id, caller, error_atom(sock_errno())); + goto done; + } + else { + tcp_descriptor* accept_desc; + int err; + + if ((accept_desc = tcp_inet_copy(desc,s,caller,&err)) == NULL) { + sock_close(s); + ret = send_async_error(desc->inet.port, desc->inet.dport, + id, caller, error_atom(err)); + goto done; + } + accept_desc->inet.remote = remote; + SET_NONBLOCKING(accept_desc->inet.s); +#ifdef __WIN32__ + driver_select(accept_desc->inet.port, accept_desc->inet.event, + ERL_DRV_READ, 1); +#endif + accept_desc->inet.state = TCP_STATE_CONNECTED; + ret = send_async_ok_port(desc->inet.port, desc->inet.dport, + id, caller, accept_desc->inet.dport); + } + } + } + else if (IS_CONNECTED(INETP(desc))) { + ret = tcp_recv(desc, 0); + goto done; + } + else { + /* maybe a close op from connection attempt?? */ + sock_select(INETP(desc),FD_ACCEPT,0); + DEBUGF(("tcp_inet_input(%ld): s=%d bad state: %04x\r\n", + port, desc->inet.s, desc->inet.state)); + } + done: + DEBUGF(("tcp_inet_input(%ld) }\r\n", port)); + return ret; +} + +static int tcp_send_error(tcp_descriptor* desc, int err) +{ + /* + * If the port is busy, we must do some clean-up before proceeding. + */ + if (IS_BUSY(INETP(desc))) { + desc->inet.caller = desc->inet.busy_caller; + if (desc->busy_on_send) { + driver_cancel_timer(desc->inet.port); + desc->busy_on_send = 0; + } + desc->inet.state &= ~INET_F_BUSY; + set_busy_port(desc->inet.port, 0); + } + + /* + * We used to handle "expected errors" differently from unexpected ones. + * Now we handle all errors in the same way. We just have to distinguish + * between passive and active sockets. + */ + DEBUGF(("driver_failure_eof(%ld) in %s, line %d\r\n", + (long)desc->inet.port, __FILE__, __LINE__)); + if (desc->inet.active) { + tcp_closed_message(desc); + inet_reply_error_am(INETP(desc), am_closed); + if (desc->inet.exitf) + driver_exit(desc->inet.port, 0); + else + desc_close(INETP(desc)); + } else { + tcp_clear_output(desc); + tcp_clear_input(desc); + tcp_close_check(desc); + erl_inet_close(INETP(desc)); + + if (desc->inet.caller) { + inet_reply_error_am(INETP(desc), am_closed); + } + else { + /* No blocking send op to reply to right now. + * If next op is a send, make sure it returns {error,closed} + * rather than {error,enotconn}. + */ + desc->tcp_add_flags |= TCP_ADDF_DELAYED_CLOSE_SEND; + } + + /* + * Make sure that the next receive operation gets an {error,closed} + * result rather than {error,enotconn}. That means that the caller + * can safely ignore errors in the send operations and handle them + * in the receive operation. + */ + desc->tcp_add_flags |= TCP_ADDF_DELAYED_CLOSE_RECV; + } + return -1; +} + +/* +** Send non-blocking vector data +*/ +static int tcp_sendv(tcp_descriptor* desc, ErlIOVec* ev) +{ + int sz; + char buf[4]; + int h_len; + int n; + ErlDrvPort ix = desc->inet.port; + int len = ev->size; + + switch(desc->inet.htype) { + case TCP_PB_1: + put_int8(len, buf); + h_len = 1; + break; + case TCP_PB_2: + put_int16(len, buf); + h_len = 2; + break; + case TCP_PB_4: + put_int32(len, buf); + h_len = 4; + break; + default: + if (len == 0) + return 0; + h_len = 0; + break; + } + + inet_output_count(INETP(desc), len+h_len); + + if (h_len > 0) { + ev->iov[0].iov_base = buf; + ev->iov[0].iov_len = h_len; + ev->size += h_len; + } + + if ((sz = driver_sizeq(ix)) > 0) { + driver_enqv(ix, ev, 0); + if (sz+ev->size >= desc->high) { + DEBUGF(("tcp_sendv(%ld): s=%d, sender forced busy\r\n", + (long)desc->inet.port, desc->inet.s)); + desc->inet.state |= INET_F_BUSY; /* mark for low-watermark */ + desc->inet.busy_caller = desc->inet.caller; + set_busy_port(desc->inet.port, 1); + if (desc->send_timeout != INET_INFINITY) { + desc->busy_on_send = 1; + driver_set_timer(desc->inet.port, desc->send_timeout); + } + return 1; + } + } + else { + int vsize = (ev->vsize > MAX_VSIZE) ? MAX_VSIZE : ev->vsize; + + DEBUGF(("tcp_sendv(%ld): s=%d, about to send %d,%d bytes\r\n", + (long)desc->inet.port, desc->inet.s, h_len, len)); + if (desc->tcp_add_flags & TCP_ADDF_DELAY_SEND) { + n = 0; + } else if (sock_sendv(desc->inet.s, ev->iov, vsize, &n, 0) + == SOCKET_ERROR) { + if ((sock_errno() != ERRNO_BLOCK) && (sock_errno() != EINTR)) { + int err = sock_errno(); + DEBUGF(("tcp_sendv(%ld): s=%d, " + "sock_sendv(size=2) errno = %d\r\n", + (long)desc->inet.port, desc->inet.s, err)); + return tcp_send_error(desc, err); + } +#ifdef __WIN32__ + desc->inet.send_would_block = 1; +#endif + n = 0; + } + else if (n == ev->size) { + ASSERT(NO_SUBSCRIBERS(&INETP(desc)->empty_out_q_subs)); + return 0; + } + else { + DEBUGF(("tcp_sendv(%ld): s=%d, only sent %d/%d of %d/%d bytes/items\r\n", + (long)desc->inet.port, desc->inet.s, n, vsize, ev->size, ev->vsize)); + } + + DEBUGF(("tcp_sendv(%ld): s=%d, Send failed, queuing\r\n", + (long)desc->inet.port, desc->inet.s)); + driver_enqv(ix, ev, n); + sock_select(INETP(desc),(FD_WRITE|FD_CLOSE), 1); + } + return 0; +} + +/* +** Send non blocking data +*/ +static int tcp_send(tcp_descriptor* desc, char* ptr, int len) +{ + int sz; + char buf[4]; + int h_len; + int n; + ErlDrvPort ix = desc->inet.port; + SysIOVec iov[2]; + + switch(desc->inet.htype) { + case TCP_PB_1: + put_int8(len, buf); + h_len = 1; + break; + case TCP_PB_2: + put_int16(len, buf); + h_len = 2; + break; + case TCP_PB_4: + put_int32(len, buf); + h_len = 4; + break; + default: + if (len == 0) + return 0; + h_len = 0; + break; + } + + inet_output_count(INETP(desc), len+h_len); + + + if ((sz = driver_sizeq(ix)) > 0) { + if (h_len > 0) + driver_enq(ix, buf, h_len); + driver_enq(ix, ptr, len); + if (sz+h_len+len >= desc->high) { + DEBUGF(("tcp_send(%ld): s=%d, sender forced busy\r\n", + (long)desc->inet.port, desc->inet.s)); + desc->inet.state |= INET_F_BUSY; /* mark for low-watermark */ + desc->inet.busy_caller = desc->inet.caller; + set_busy_port(desc->inet.port, 1); + if (desc->send_timeout != INET_INFINITY) { + desc->busy_on_send = 1; + driver_set_timer(desc->inet.port, desc->send_timeout); + } + return 1; + } + } + else { + iov[0].iov_base = buf; + iov[0].iov_len = h_len; + iov[1].iov_base = ptr; + iov[1].iov_len = len; + + DEBUGF(("tcp_send(%ld): s=%d, about to send %d,%d bytes\r\n", + (long)desc->inet.port, desc->inet.s, h_len, len)); + if (desc->tcp_add_flags & TCP_ADDF_DELAY_SEND) { + sock_send(desc->inet.s, buf, 0, 0); + n = 0; + } else if (sock_sendv(desc->inet.s,iov,2,&n,0) == SOCKET_ERROR) { + if ((sock_errno() != ERRNO_BLOCK) && (sock_errno() != EINTR)) { + int err = sock_errno(); + DEBUGF(("tcp_send(%ld): s=%d,sock_sendv(size=2) errno = %d\r\n", + (long)desc->inet.port, desc->inet.s, err)); + return tcp_send_error(desc, err); + } +#ifdef __WIN32__ + desc->inet.send_would_block = 1; +#endif + n = 0; + } + else if (n == len+h_len) { + ASSERT(NO_SUBSCRIBERS(&INETP(desc)->empty_out_q_subs)); + return 0; + } + + DEBUGF(("tcp_send(%ld): s=%d, Send failed, queuing", + (long)desc->inet.port, desc->inet.s)); + + if (n < h_len) { + driver_enq(ix, buf+n, h_len-n); + driver_enq(ix, ptr, len); + } + else { + n -= h_len; + driver_enq(ix, ptr+n, len-n); + } + sock_select(INETP(desc),(FD_WRITE|FD_CLOSE), 1); + } + return 0; +} + +static void tcp_inet_drv_output(ErlDrvData data, ErlDrvEvent event) +{ + (void)tcp_inet_output((tcp_descriptor*)data, (HANDLE)event); +} + +static void tcp_inet_drv_input(ErlDrvData data, ErlDrvEvent event) +{ + (void)tcp_inet_input((tcp_descriptor*)data, (HANDLE)event); +} + +/* socket ready for ouput: +** 1. TCP_STATE_CONNECTING => non block connect ? +** 2. TCP_STATE_CONNECTED => write output +*/ +static int tcp_inet_output(tcp_descriptor* desc, HANDLE event) +{ + int ret = 0; + ErlDrvPort ix = desc->inet.port; + + DEBUGF(("tcp_inet_output(%ld) {s=%d\r\n", + (long)desc->inet.port, desc->inet.s)); + if (desc->inet.state == TCP_STATE_CONNECTING) { + sock_select(INETP(desc),FD_CONNECT,0); + + driver_cancel_timer(ix); /* posssibly cancel a timer */ +#ifndef __WIN32__ + /* + * XXX This is strange. This *should* work on Windows NT too, + * but doesn't. An bug in Winsock 2.0 for Windows NT? + * + * See "Unix Netwok Programming", W.R.Stevens, p 412 for a + * discussion about Unix portability and non blocking connect. + */ + +#ifndef SO_ERROR + { + int sz = sizeof(desc->inet.remote); + int code = sock_peer(desc->inet.s, + (struct sockaddr*) &desc->inet.remote, &sz); + + if (code == SOCKET_ERROR) { + desc->inet.state = TCP_STATE_BOUND; /* restore state */ + ret = async_error(INETP(desc), sock_errno()); + goto done; + } + } +#else + { + int error = 0; /* Has to be initiated, we check it */ + unsigned int sz = sizeof(error); /* even if we get -1 */ + int code = sock_getopt(desc->inet.s, SOL_SOCKET, SO_ERROR, + (void *)&error, &sz); + + if ((code < 0) || error) { + desc->inet.state = TCP_STATE_BOUND; /* restore state */ + ret = async_error(INETP(desc), error); + goto done; + } + } +#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* !__WIN32__ */ + + desc->inet.state = TCP_STATE_CONNECTED; + if (desc->inet.active) + sock_select(INETP(desc),(FD_READ|FD_CLOSE),1); + async_ok(INETP(desc)); + } + else if (IS_CONNECTED(INETP(desc))) { + for (;;) { + int vsize; + int n; + SysIOVec* iov; + + if ((iov = driver_peekq(ix, &vsize)) == NULL) { + sock_select(INETP(desc), FD_WRITE, 0); + send_empty_out_q_msgs(INETP(desc)); + goto done; + } + vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; + DEBUGF(("tcp_inet_output(%ld): s=%d, About to send %d items\r\n", + (long)desc->inet.port, desc->inet.s, vsize)); + if (sock_sendv(desc->inet.s, iov, vsize, &n, 0)==SOCKET_ERROR) { + if ((sock_errno() != ERRNO_BLOCK) && (sock_errno() != EINTR)) { + DEBUGF(("tcp_inet_output(%ld): sock_sendv(%d) errno = %d\r\n", + (long)desc->inet.port, vsize, sock_errno())); + ret = tcp_send_error(desc, sock_errno()); + goto done; + } +#ifdef __WIN32__ + desc->inet.send_would_block = 1; +#endif + goto done; + } + if (driver_deq(ix, n) <= desc->low) { + if (IS_BUSY(INETP(desc))) { + desc->inet.caller = desc->inet.busy_caller; + desc->inet.state &= ~INET_F_BUSY; + set_busy_port(desc->inet.port, 0); + /* if we have a timer then cancel and send ok to client */ + if (desc->busy_on_send) { + driver_cancel_timer(desc->inet.port); + desc->busy_on_send = 0; + } + inet_reply_ok(INETP(desc)); + } + } + } + } + else { + sock_select(INETP(desc),FD_CONNECT,0); + DEBUGF(("tcp_inet_output(%ld): bad state: %04x\r\n", + (long)desc->inet.port, desc->inet.state)); + } + done: + DEBUGF(("tcp_inet_output(%ld) }\r\n", (long)desc->inet.port)); + return ret; +} + +/*----------------------------------------------------------------------------- + + UDP & SCTP (the latter in a 1<->M Mode) + +-----------------------------------------------------------------------------*/ + +#if defined(HAVE_SO_BSDCOMPAT) +#if defined(__linux__) +#include +static int should_use_so_bsdcompat(void) +{ + /* SMP: FIXME this is probably not SMP safe but may be ok anyway? */ + static int init_done; + static int so_bsdcompat_is_obsolete; + + if (!init_done) { + struct utsname utsname; + unsigned int version, patchlevel; + + init_done = 1; + if (uname(&utsname) < 0) { + fprintf(stderr, "uname: %s\r\n", strerror(sock_errno())); + return 1; + } + /* Format is .. + where the first three are unsigned integers and the last + is an arbitrary string. We only care about the first two. */ + if (sscanf(utsname.release, "%u.%u", &version, &patchlevel) != 2) { + fprintf(stderr, "uname: unexpected release '%s'\r\n", + utsname.release); + return 1; + } + /* SO_BSDCOMPAT is deprecated and triggers warnings in 2.5 + kernels. It is a no-op in 2.4 but not in 2.2 kernels. */ + if (version > 2 || (version == 2 && patchlevel >= 5)) + so_bsdcompat_is_obsolete = 1; + } + return !so_bsdcompat_is_obsolete; +} +#else /* __linux__ */ +#define should_use_so_bsdcompat() 1 +#endif /* __linux__ */ +#endif /* HAVE_SO_BSDCOMPAT */ + +static int packet_inet_init() +{ + return 0; +} + +static ErlDrvData packet_inet_start(ErlDrvPort port, char* args, int protocol) +{ + /* "inet_start" returns "ErlDrvData", but in fact it is "inet_descriptor*", + so we can preserve it as "ErlDrvData": + */ + ErlDrvData drvd = inet_start(port, sizeof(udp_descriptor), + protocol); + udp_descriptor* desc = (udp_descriptor*) drvd; + + if (desc == NULL) + return ERL_DRV_ERROR_ERRNO; + + desc->read_packets = INET_PACKET_POLL; + return drvd; +} + +static ErlDrvData udp_inet_start(ErlDrvPort port, char *args) +{ + return packet_inet_start(port, args, IPPROTO_UDP); +} + +#ifdef HAVE_SCTP +static ErlDrvData sctp_inet_start(ErlDrvPort port, char *args) +{ + return packet_inet_start(port, args, IPPROTO_SCTP); +} +#endif + +static void packet_inet_stop(ErlDrvData e) +{ + /* There should *never* be any "empty out q" subscribers on + an UDP or SCTP socket! + NB: as in "inet_start", we can always cast "ErlDRvData" + into "udp_descriptor*" or "inet_descriptor*": + */ + udp_descriptor * udesc = (udp_descriptor*) e; + inet_descriptor* descr = INETP(udesc); + + ASSERT(NO_SUBSCRIBERS(&(descr->empty_out_q_subs))); + inet_stop(descr); +} + +static int packet_error(udp_descriptor* udesc, int err) +{ + inet_descriptor * desc = INETP(udesc); + if (!desc->active) + async_error(desc, err); + driver_failure_posix(desc->port, err); + return -1; +} + +/* +** Various functions accessible via "port_control" on the Erlang side: +*/ +static int packet_inet_ctl(ErlDrvData e, unsigned int cmd, char* buf, int len, + char** rbuf, int rsize) +{ + int replen; + udp_descriptor * udesc = (udp_descriptor *) e; + inet_descriptor* desc = INETP(udesc); + int type = SOCK_DGRAM; + int af; +#ifdef HAVE_SCTP + if (IS_SCTP(desc)) type = SOCK_SEQPACKET; +#endif + + switch(cmd) { + case INET_REQ_OPEN: /* open socket and return internal index */ + DEBUGF(("packet_inet_ctl(%ld): OPEN\r\n", (long)desc->port)); + if (len != 1) { + return ctl_error(EINVAL, rbuf, rsize); + } + switch (buf[0]) { + case INET_AF_INET: af = AF_INET; break; +#if defined(HAVE_IN6) && defined(AF_INET6) + case INET_AF_INET6: af = AF_INET6; break; +#endif + default: + return ctl_error(EINVAL, rbuf, rsize); + } + replen = inet_ctl_open(desc, af, type, rbuf, rsize); + + if ((*rbuf)[0] != INET_REP_ERROR) { + if (desc->active) + sock_select(desc,FD_READ,1); +#ifdef HAVE_SO_BSDCOMPAT + /* + * Make sure that sending UDP packets to a non existing port on an + * existing machine doesn't close the socket. (Linux behaves this + * way) + */ + if (should_use_so_bsdcompat()) { + int one = 1; + /* Ignore errors */ + sock_setopt(desc->s, SOL_SOCKET, SO_BSDCOMPAT, &one, + sizeof(one)); + } +#endif + } + return replen; + + + case INET_REQ_FDOPEN: /* pass in an open (and bound) socket */ + DEBUGF(("packet inet_ctl(%ld): FDOPEN\r\n", (long)desc->port)); + if ((len == 5) && (buf[0] == INET_AF_INET)) + replen = inet_ctl_fdopen(desc, AF_INET, SOCK_DGRAM, + (SOCKET)get_int32(buf+1),rbuf,rsize); +#if defined(HAVE_IN6) && defined(AF_INET6) + else if ((len == 5) && (buf[0] == INET_AF_INET6)) + replen = inet_ctl_fdopen(desc, AF_INET6, SOCK_DGRAM, + (SOCKET)get_int32(buf+1),rbuf,rsize); +#endif + else + return ctl_error(EINVAL, rbuf, rsize); + + if ((*rbuf)[0] != INET_REP_ERROR) { + if (desc->active) + sock_select(desc,FD_READ,1); +#ifdef HAVE_SO_BSDCOMPAT + /* + * Make sure that sending UDP packets to a non existing port on an + * existing machine doesn't close the socket. (Linux behaves this + * way) + */ + if (should_use_so_bsdcompat()) { + int one = 1; + /* Ignore errors */ + sock_setopt(desc->s, SOL_SOCKET, SO_BSDCOMPAT, &one, + sizeof(one)); + } +#endif + } + return replen; + + + case INET_REQ_CLOSE: + DEBUGF(("packet_inet_ctl(%ld): CLOSE\r\n", (long)desc->port)); + erl_inet_close(desc); + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + return 0; + + + case INET_REQ_CONNECT: { + /* UDP and SCTP connect operations are completely different. UDP + connect means only setting the default peer addr locally, so + it is always synchronous. SCTP connect means actual establish- + ing of an SCTP association with a remote peer, so it is async- + ronous, and similar to TCP connect. However, unlike TCP, SCTP + allows the socket to have multiple simultaneous associations: + */ + int code; + char tbuf[2]; + unsigned timeout; + + DEBUGF(("packet_inet_ctl(%ld): CONNECT\r\n", (long)desc->port)); + + /* INPUT: [ Timeout(4), Port(2), Address(N) ] */ + + if (!IS_OPEN(desc)) + return ctl_xerror(EXBADPORT, rbuf, rsize); + + if (!IS_BOUND(desc)) + return ctl_xerror(EXBADSEQ, rbuf, rsize); +#ifdef HAVE_SCTP + if (IS_SCTP(desc)) { + inet_address remote; + + if (IS_CONNECTING(desc)) + return ctl_error(EINVAL, rbuf, rsize); + if (len < 6) + return ctl_error(EINVAL, rbuf, rsize); + timeout = get_int32(buf); + buf += 4; + len -= 4; + + /* For SCTP, we do not set the peer's addr in desc->remote, as + multiple peers are possible: */ + if (inet_set_address(desc->sfamily, &remote, buf, &len) == NULL) + return ctl_error(EINVAL, rbuf, rsize); + + sock_select(desc, FD_CONNECT, 1); + code = sock_connect(desc->s, &remote.sa, len); + + if ((code == SOCKET_ERROR) && (sock_errno() == EINPROGRESS)) { + /* XXX: Unix only -- WinSock would have a different cond! */ + desc->state = SCTP_STATE_CONNECTING; + if (timeout != INET_INFINITY) + driver_set_timer(desc->port, timeout); + enq_async(desc, tbuf, INET_REQ_CONNECT); + } + else if (code == 0) { /* OK we are connected */ + sock_select(desc, FD_CONNECT, 0); + desc->state = PACKET_STATE_CONNECTED; + enq_async(desc, tbuf, INET_REQ_CONNECT); + async_ok(desc); + } + else { + sock_select(desc, FD_CONNECT, 0); + return ctl_error(sock_errno(), rbuf, rsize); + } + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } +#endif + /* UDP */ + if (len == 0) { + /* What does it mean??? NULL sockaddr??? */ + sock_connect(desc->s, (struct sockaddr*) NULL, 0); + desc->state &= ~INET_F_ACTIVE; + enq_async(desc, tbuf, INET_REQ_CONNECT); + async_ok (desc); + } + else if (len < 6) + return ctl_error(EINVAL, rbuf, rsize); + else { + timeout = get_int32(buf); /* IGNORED */ + buf += 4; + len -= 4; + if (inet_set_address(desc->sfamily, + &desc->remote, buf, &len) == NULL) + return ctl_error(EINVAL, rbuf, rsize); + + code = sock_connect(desc->s, + (struct sockaddr*) &desc->remote, len); + if (code == SOCKET_ERROR) { + sock_connect(desc->s, (struct sockaddr*) NULL, 0); + desc->state &= ~INET_F_ACTIVE; + return ctl_error(sock_errno(), rbuf, rsize); + } + else /* ok we are connected */ { + enq_async(desc, tbuf, INET_REQ_CONNECT); + desc->state |= INET_F_ACTIVE; + async_ok (desc); + } + } + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } + +#ifdef HAVE_SCTP + case SCTP_REQ_LISTEN: + { /* LISTEN is only for SCTP sockets, not UDP. This code is borrowed + from the TCP section. Returns: {ok,[]} on success. + */ + int flag; + + DEBUGF(("packet_inet_ctl(%ld): LISTEN\r\n", (long)desc->port)); + if (!IS_SCTP(desc)) + return ctl_xerror(EXBADPORT, rbuf, rsize); + if (!IS_OPEN(desc)) + return ctl_xerror(EXBADPORT, rbuf, rsize); + if (!IS_BOUND(desc)) + return ctl_xerror(EXBADSEQ, rbuf, rsize); + + /* The arg is a binary value: 1:enable, 0:disable */ + if (len != 1) + return ctl_error(EINVAL, rbuf, rsize); + flag = get_int8(buf); + + if (sock_listen(desc->s, flag) == SOCKET_ERROR) + return ctl_error(sock_errno(), rbuf, rsize); + + desc->state = SCTP_STATE_LISTEN; /* XXX: not used? */ + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } + + case SCTP_REQ_BINDX: + { /* Multi-homing bind for SCTP: */ + /* Construct the list of addresses we bind to. The curr limit is + 256 addrs. Buff structure: Flags(1), ListItem,...: + */ + struct sockaddr addrs[256]; + char* curr; + int add_flag, n, rflag; + + if (!IS_SCTP(desc)) + return ctl_xerror(EXBADPORT, rbuf, rsize); + + curr = buf; + add_flag = get_int8(curr); + curr++; + + for(n=0; n < 256 && curr < buf+len; n++) + { + /* List item format: Port(2), IP(4|16) -- compatible with + "inet_set_address": */ + inet_address tmp; + int alen = buf + len - curr; + curr = inet_set_address(desc->sfamily, &tmp, curr, &alen); + if (curr == NULL) + return ctl_error(EINVAL, rbuf, rsize); + + /* Now: we need to squeeze "tmp" into the size of "sockaddr", + which is smaller than "tmp" for IPv6 (extra IN6 info will + be cut off): */ + memcpy(addrs + n, &tmp, sizeof(struct sockaddr)); + } + /* Make the real flags: */ + rflag = add_flag ? SCTP_BINDX_ADD_ADDR : SCTP_BINDX_REM_ADDR; + + /* Invoke the call: */ + if (p_sctp_bindx(desc->s, addrs, n, rflag) < 0) + return ctl_error(sock_errno(), rbuf, rsize); + + desc->state = INET_STATE_BOUND; + + return ctl_reply(INET_REP_OK, NULL, 0, rbuf, rsize); + } +#endif /* HAVE_SCTP */ + + case PACKET_REQ_RECV: + { /* THIS IS A FRONT-END for "recv*" requests. It only enqueues the + request and possibly returns the data immediately available. + The actual data returning function is the back-end ("*input"): + */ + unsigned timeout; + char tbuf[2]; + + DEBUGF(("packet_inet_ctl(%ld): RECV\r\n", (long)desc->port)); + /* INPUT: Timeout(4), Length(4) */ + if (!IS_OPEN(desc)) + return ctl_xerror(EXBADPORT, rbuf, rsize); + if (!IS_BOUND(desc)) + return ctl_error(EINVAL, rbuf, rsize); + if (desc->active || (len != 8)) + return ctl_error(EINVAL, rbuf, rsize); + timeout = get_int32(buf); + /* The 2nd arg, Length(4), is ignored for both UDP ans SCTP protocols, + since they are msg-oriented. */ + + if (enq_async(desc, tbuf, PACKET_REQ_RECV) < 0) + return ctl_error(EALREADY, rbuf, rsize); + + if (packet_inet_input(udesc, desc->event) == 0) { + if (timeout == 0) + async_error_am(desc, am_timeout); + else { + if (timeout != INET_INFINITY) + driver_set_timer(desc->port, timeout); + } + } + return ctl_reply(INET_REP_OK, tbuf, 2, rbuf, rsize); + } + + default: + /* Delegate the request to the INET layer. In particular, + INET_REQ_BIND goes here. If the req is not recognised + there either, an error is returned: + */ + return inet_ctl(desc, cmd, buf, len, rbuf, rsize); + } +} + +static void packet_inet_timeout(ErlDrvData e) +{ + udp_descriptor * udesc = (udp_descriptor*) e; + inet_descriptor * desc = INETP(udesc); + if (!(desc->active)) + sock_select(desc, FD_READ, 0); + async_error_am (desc, am_timeout); +} + + +/* THIS IS A "send*" REQUEST; on the Erlang side: "port_command". +** input should be: P1 P0 Address buffer . +** For UDP, buffer (after Address) is just data to be sent. +** For SCTP, buffer contains a list representing 2 items: +** (1) 6 parms for sctp_sndrcvinfo, as in sctp_get_sendparams(); +** (2) 0+ real data bytes. +** There is no destination address -- SCTYP send is performed over +** an existing association, using "sctp_sndrcvinfo" specified. +*/ +static void packet_inet_command(ErlDrvData e, char* buf, int len) +{ + udp_descriptor * udesc= (udp_descriptor*) e; + inet_descriptor* desc = INETP(udesc); + char* ptr = buf; + char* qtr; + int sz; + int code; + inet_address other; + + desc->caller = driver_caller(desc->port); + + if (!IS_OPEN(desc)) { + inet_reply_error(desc, EINVAL); + return; + } + if (!IS_BOUND(desc)) { + inet_reply_error(desc, EINVAL); + return; + } + +#ifdef HAVE_SCTP + if (IS_SCTP(desc)) + { + int data_len; + struct iovec iov[1]; /* For real data */ + struct msghdr mhdr; /* Message wrapper */ + struct sctp_sndrcvinfo *sri; /* The actual ancilary data */ + union { /* For ancilary data */ + struct cmsghdr hdr; + char ancd[CMSG_SPACE(sizeof(*sri))]; + } cmsg; + + if (len < SCTP_GET_SENDPARAMS_LEN) { + inet_reply_error(desc, EINVAL); + return; + } + + /* The ancilary data */ + sri = (struct sctp_sndrcvinfo *) (CMSG_DATA(&cmsg.hdr)); + /* Get the "sndrcvinfo" from the buffer, advancing the "ptr": */ + ptr = sctp_get_sendparams(sri, ptr); + + /* The ancilary data wrapper */ + cmsg.hdr.cmsg_level = IPPROTO_SCTP; + cmsg.hdr.cmsg_type = SCTP_SNDRCV; + cmsg.hdr.cmsg_len = CMSG_LEN(sizeof(*sri)); + + data_len = (buf + len) - ptr; + /* The whole msg. + * Solaris (XPG 4.2) requires iovlen >= 1 even for data_len == 0. + */ + mhdr.msg_name = NULL; /* Already connected */ + mhdr.msg_namelen = 0; + iov[0].iov_len = data_len; + iov[0].iov_base = ptr; /* The real data */ + mhdr.msg_iov = iov; + mhdr.msg_iovlen = 1; + mhdr.msg_control = cmsg.ancd; /* For ancilary data */ + mhdr.msg_controllen = cmsg.hdr.cmsg_len; + mhdr.msg_flags = 0; /* Not used with "sendmsg" */ + + /* Now do the actual sending. NB: "flags" in "sendmsg" itself are NOT + used: */ + code = sock_sendmsg(desc->s, &mhdr, 0); + goto check_result_code; + } +#endif + /* UDP socket. Even if it is connected, there is an address prefix + here -- ignored for connected sockets: */ + sz = len; + qtr = inet_set_address(desc->sfamily, &other, ptr, &sz); + if (qtr == NULL) { + inet_reply_error(desc, EINVAL); + return; + } + len -= (qtr - ptr); + ptr = qtr; + /* Now "ptr" is the user data ptr, "len" is data length: */ + inet_output_count(desc, len); + + if (desc->state & INET_F_ACTIVE) { /* connected (ignore address) */ + code = sock_send(desc->s, ptr, len, 0); + } + else { + code = sock_sendto(desc->s, ptr, len, 0, &other.sa, sz); + } + +#ifdef HAVE_SCTP + check_result_code: + /* "code" analysis is the same for both SCTP and UDP cases above: */ +#endif + if (code == SOCKET_ERROR) { + int err = sock_errno(); + inet_reply_error(desc, err); + } + else + inet_reply_ok(desc); +} + + +#ifdef __WIN32__ +static void packet_inet_event(ErlDrvData e, ErlDrvEvent event) +{ + udp_descriptor * udesc = (udp_descriptor*)e; + inet_descriptor* desc = INETP(udesc); + WSANETWORKEVENTS netEv; + + if ((WSAEnumNetworkEvents)(desc->s, desc->event, &netEv) != 0) { + DEBUGF(( "port %d: EnumNetwrokEvents = %d\r\n", + desc->port, sock_errno() )); + return; /* -1; */ + } + netEv.lNetworkEvents |= desc->forced_events; + if (netEv.lNetworkEvents & FD_READ) { + packet_inet_input(udesc, (HANDLE)event); + } +} + +#endif + +static void packet_inet_drv_input(ErlDrvData e, ErlDrvEvent event) +{ + (void) packet_inet_input((udp_descriptor*)e, (HANDLE)event); +} + +/* +** THIS IS A BACK-END FOR "recv*" REQUEST, which actually receives the +** data requested, and delivers them to the caller: +*/ +static int packet_inet_input(udp_descriptor* udesc, HANDLE event) +{ + inet_descriptor* desc = INETP(udesc); + int n; + unsigned int len; + inet_address other; + char abuf[sizeof(inet_address)]; /* buffer address; enough??? */ + int sz; + char* ptr; + ErlDrvBinary* buf; /* binary */ + int packet_count = udesc->read_packets; + int count = 0; /* number of packets delivered to owner */ +#ifdef HAVE_SCTP + struct msghdr mhdr; /* Top-level msg structure */ + struct iovec iov[1]; /* Data or Notification Event */ + char ancd[SCTP_ANC_BUFF_SIZE]; /* Ancillary Data */ + int short_recv = 0; +#endif + + while(packet_count--) { + len = sizeof(other); + sz = desc->bufsz; + /* Allocate space for message and address. NB: "bufsz" is in "desc", + but the "buf" itself is allocated separately: + */ + if ((buf = alloc_buffer(sz+len)) == NULL) + return packet_error(udesc, ENOMEM); + ptr = buf->orig_bytes + len; /* pointer to message part */ + + /* Note: On Windows NT, recvfrom() fails if the socket is connected. */ +#ifdef HAVE_SCTP + /* For SCTP we must use recvmsg() */ + if (IS_SCTP(desc)) { + iov->iov_base = ptr; /* Data will come here */ + iov->iov_len = sz; /* Remaining buffer space */ + + mhdr.msg_name = &other; /* Peer addr comes into "other" */ + mhdr.msg_namelen = len; + mhdr.msg_iov = iov; + mhdr.msg_iovlen = 1; + mhdr.msg_control = ancd; + mhdr.msg_controllen = SCTP_ANC_BUFF_SIZE; + mhdr.msg_flags = 0; /* To be filled by "recvmsg" */ + + /* Do the actual SCTP receive: */ + n = sock_recvmsg(desc->s, &mhdr, 0); + goto check_result; + } +#endif + /* Use recv() instead on connected sockets. */ + if ((desc->state & INET_F_ACTIVE)) { + n = sock_recv(desc->s, ptr, sz, 0); + other = desc->remote; + } + else + n = sock_recvfrom(desc->s, ptr, sz, 0, &other.sa, &len); + +#ifdef HAVE_SCTP + check_result: +#endif + /* Analyse the result: */ + if (n == SOCKET_ERROR +#ifdef HAVE_SCTP + || (short_recv = (IS_SCTP(desc) && !(mhdr.msg_flags & MSG_EOR))) + /* NB: here we check for EOR not being set -- this is an error as + well, we don't support partial msgs: + */ +#endif + ) { + int err = sock_errno(); + release_buffer(buf); + if (err != ERRNO_BLOCK) { + if (!desc->active) { +#ifdef HAVE_SCTP + if (short_recv) + async_error_am(desc, am_short_recv); + else +#else + async_error(desc, err); +#endif + driver_cancel_timer(desc->port); + sock_select(desc,FD_READ,0); + } + else { + /* This is for an active desc only: */ + packet_error_message(udesc, err); + } + } + else if (!desc->active) + sock_select(desc,FD_READ,1); + return count; /* strange, not ready */ + } + else { + int offs; + int nsz; + int code; + unsigned int alen = len; + void * extra = NULL; + + inet_input_count(desc, n); + inet_get_address(desc->sfamily, abuf, &other, &alen); + /* Copy formatted address to the buffer allocated; "alen" is the + actual length which must be <= than the original reserved "len". + This means that the addr + data in the buffer are contiguous, + but they may start not at the "orig_bytes", but with some "offs" + from them: + */ + ASSERT (alen <= len); + sys_memcpy(ptr - alen, abuf, alen); + ptr -= alen; + nsz = n + alen; /* nsz = data + address */ + offs = ptr - buf->orig_bytes; /* initial pointer offset */ + + /* Check if we need to reallocate binary */ + if ((desc->mode == INET_MODE_BINARY) && + (desc->hsz < n) && (nsz < BIN_REALLOC_LIMIT(sz))) { + ErlDrvBinary* tmp; + if ((tmp = realloc_buffer(buf,nsz+offs)) != NULL) + buf = tmp; + } +#ifdef HAVE_SCTP + if (IS_SCTP(desc)) extra = &mhdr; +#endif + /* Actual parsing and return of the data received, occur here: */ + code = packet_reply_binary_data(desc, (unsigned int)alen, + buf, offs, nsz, extra); + free_buffer(buf); + if (code < 0) + return count; + count++; + if (!desc->active) { + driver_cancel_timer(desc->port); /* possibly cancel */ + sock_select(desc,FD_READ,0); + return count; /* passive mode (read one packet only) */ + } + } + } + return count; +} + +static void packet_inet_drv_output(ErlDrvData e, ErlDrvEvent event) +{ + (void) packet_inet_output((udp_descriptor*)e, (HANDLE)event); +} + +/* UDP/SCTP socket ready for output: +** This is a Back-End for Non-Block SCTP Connect (SCTP_STATE_CONNECTING) +*/ +static int packet_inet_output(udp_descriptor* udesc, HANDLE event) +{ + inet_descriptor* desc = INETP(udesc); + int ret = 0; + ErlDrvPort ix = desc->port; + + DEBUGF(("packet_inet_output(%ld) {s=%d\r\n", + (long)desc->port, desc->s)); + + if (desc->state == SCTP_STATE_CONNECTING) { + sock_select(desc, FD_CONNECT, 0); + + driver_cancel_timer(ix); /* posssibly cancel a timer */ +#ifndef __WIN32__ + /* + * XXX This is strange. This *should* work on Windows NT too, + * but doesn't. An bug in Winsock 2.0 for Windows NT? + * + * See "Unix Netwok Programming", W.R.Stevens, p 412 for a + * discussion about Unix portability and non blocking connect. + */ + +#ifndef SO_ERROR + { + int sz = sizeof(desc->remote); + int code = sock_peer(desc->s, + (struct sockaddr*) &desc->remote, &sz); + + if (code == SOCKET_ERROR) { + desc->state = PACKET_STATE_BOUND; /* restore state */ + ret = async_error(desc, sock_errno()); + goto done; + } + } +#else + { + int error = 0; /* Has to be initiated, we check it */ + unsigned int sz = sizeof(error); /* even if we get -1 */ + int code = sock_getopt(desc->s, SOL_SOCKET, SO_ERROR, + (void *)&error, &sz); + + if ((code < 0) || error) { + desc->state = PACKET_STATE_BOUND; /* restore state */ + ret = async_error(desc, error); + goto done; + } + } +#endif /* SOCKOPT_CONNECT_STAT */ +#endif /* !__WIN32__ */ + + desc->state = PACKET_STATE_CONNECTED; + async_ok(desc); + } + else { + sock_select(desc,FD_CONNECT,0); + + DEBUGF(("packet_inet_output(%ld): bad state: %04x\r\n", + (long)desc->port, desc->state)); + } + done: + DEBUGF(("packet_inet_output(%ld) }\r\n", (long)desc->port)); + return ret; +} + +/*---------------------------------------------------------------------------*/ + +#ifdef __WIN32__ + +/* + * Although we no longer need to lookup all of winsock2 dynamically, + * there are still some function(s) we need to look up. + */ +static void find_dynamic_functions(void) +{ + char kernel_dll_name[] = "kernel32"; + HMODULE module; + module = GetModuleHandle(kernel_dll_name); + fpSetHandleInformation = (module != NULL) ? + (BOOL (WINAPI *)(HANDLE,DWORD,DWORD)) + GetProcAddress(module,"SetHandleInformation") : + NULL; +} + + + +/* + * We must make sure that the socket handles are not inherited + * by port programs (if there are inherited, the sockets will not + * get closed when the emulator terminates, and epmd and other Erlang + * nodes will not notice that we have exited). + * + * XXX It is not clear whether this works/is necessary in Windows 95. + * There could also be problems with Winsock implementations from other + * suppliers than Microsoft. + */ + +static SOCKET +make_noninheritable_handle(SOCKET s) +{ + if (s != INVALID_SOCKET) { + if (fpSetHandleInformation != NULL) { + (*fpSetHandleInformation)((HANDLE) s, HANDLE_FLAG_INHERIT, 0); + } else { + HANDLE non_inherited; + HANDLE this_process = GetCurrentProcess(); + if (DuplicateHandle(this_process, (HANDLE) s, + this_process, &non_inherited, 0, + FALSE, DUPLICATE_SAME_ACCESS)) { + sock_close(s); + s = (SOCKET) non_inherited; + } + } + } + return s; +} + +#endif /* UDP for __WIN32__ */ + +/* + * Multi-timers + */ + +static void absolute_timeout(unsigned millis, ErlDrvNowData *out) +{ + unsigned rest; + unsigned long millipart; + unsigned long secpart; + unsigned long megasecpart; + unsigned tmo_secs = (millis / 1000U); + unsigned tmo_millis = (millis % 1000); + driver_get_now(out); + rest = (out->microsecs) % 1000; + millipart = ((out->microsecs) / 1000UL); + if (rest >= 500) { + ++millipart; + } + secpart = out->secs; + megasecpart = out->megasecs; + millipart += tmo_millis; + secpart += (millipart / 1000000UL); + millipart %= 1000000UL; + secpart += tmo_secs; + megasecpart += (secpart / 1000000UL); + secpart %= 1000000UL; + out->megasecs = megasecpart; + out->secs = secpart; + out->microsecs = (millipart * 1000UL); +} + +static unsigned relative_timeout(ErlDrvNowData *in) +{ + ErlDrvNowData now; + unsigned rest; + unsigned long millipart, in_millis, in_secs, in_megasecs; + + driver_get_now(&now); + + in_secs = in->secs; + in_megasecs = in->megasecs; + + rest = (now.microsecs) % 1000; + millipart = ((now.microsecs) / 1000UL); + if (rest >= 500) { + ++millipart; + } + in_millis = ((in->microsecs) / 1000UL); + if ( in_millis < millipart ) { + if (in_secs > 0) { + --in_secs; + } else { + in_secs = (1000000UL - 1UL); + if (in_megasecs <= now.megasecs) { + return 0; + } else { + --in_megasecs; + } + } + in_millis += 1000UL; + } + in_millis -= millipart; + + if (in_secs < now.secs) { + if (in_megasecs <= now.megasecs) { + return 0; + } else { + --in_megasecs; + } + in_secs += 1000000; + } + in_secs -= now.secs; + if (in_megasecs < now.megasecs) { + return 0; + } else { + in_megasecs -= now.megasecs; + } + return (unsigned) ((in_megasecs * 1000000000UL) + + (in_secs * 1000UL) + + in_millis); +} + +#ifdef DEBUG +static int nowcmp(ErlDrvNowData *d1, ErlDrvNowData *d2) +{ + /* Assume it's not safe to do signed conversion on megasecs... */ + if (d1->megasecs < d2->megasecs) { + return -1; + } else if (d1->megasecs > d2->megasecs) { + return 1; + } else if (d1->secs != d2->secs) { + return ((int) d1->secs) - ((int) d2->secs); + } + return ((int) d1->microsecs) - ((int) d2->microsecs); +} +#endif + +static void fire_multi_timers(MultiTimerData **first, ErlDrvPort port, + ErlDrvData data) +{ + unsigned next_timeout; + if (!*first) { + ASSERT(0); + return; + } +#ifdef DEBUG + { + ErlDrvNowData chk; + driver_get_now(&chk); + chk.microsecs /= 10000UL; + chk.microsecs *= 10000UL; + chk.microsecs += 10000; + ASSERT(nowcmp(&chk,&((*first)->when)) >= 0); + } +#endif + do { + MultiTimerData *save = *first; + *first = save->next; + (*(save->timeout_function))(data,save->caller); + FREE(save); + if (*first == NULL) { + return; + } + (*first)->prev = NULL; + next_timeout = relative_timeout(&((*first)->when)); + } while (next_timeout == 0); + driver_set_timer(port,next_timeout); +} + +static void clean_multi_timers(MultiTimerData **first, ErlDrvPort port) +{ + MultiTimerData *p; + if (*first) { + driver_cancel_timer(port); + } + while (*first) { + p = *first; + *first = p->next; + FREE(p); + } +} +static void remove_multi_timer(MultiTimerData **first, ErlDrvPort port, MultiTimerData *p) +{ + if (p->prev != NULL) { + p->prev->next = p->next; + } else { + driver_cancel_timer(port); + *first = p->next; + if (*first) { + unsigned ntmo = relative_timeout(&((*first)->when)); + driver_set_timer(port,ntmo); + } + } + if (p->next != NULL) { + p->next->prev = p->prev; + } + FREE(p); +} + +static MultiTimerData *add_multi_timer(MultiTimerData **first, ErlDrvPort port, + ErlDrvTermData caller, unsigned timeout, + void (*timeout_fun)(ErlDrvData drv_data, + ErlDrvTermData caller)) +{ + MultiTimerData *mtd, *p, *s; + mtd = ALLOC(sizeof(MultiTimerData)); + absolute_timeout(timeout, &(mtd->when)); + mtd->timeout_function = timeout_fun; + mtd->caller = caller; + mtd->next = mtd->prev = NULL; + for(p = *first,s = NULL; p != NULL; s = p, p = p->next) { + if (p->when.megasecs >= mtd->when.megasecs) { + break; + } + } + if (!p || p->when.megasecs > mtd->when.megasecs) { + goto found; + } + for (; p!= NULL; s = p, p = p->next) { + if (p->when.secs >= mtd->when.secs) { + break; + } + } + if (!p || p->when.secs > mtd->when.secs) { + goto found; + } + for (; p!= NULL; s = p, p = p->next) { + if (p->when.microsecs >= mtd->when.microsecs) { + break; + } + } + found: + if (!p) { + if (!s) { + *first = mtd; + } else { + s->next = mtd; + mtd->prev = s; + } + } else { + if (!s) { + *first = mtd; + } else { + s->next = mtd; + mtd->prev = s; + } + mtd->next = p; + p->prev = mtd; + } + if (!s) { + if (mtd->next) { + driver_cancel_timer(port); + } + driver_set_timer(port,timeout); + } + return mtd; +} + + + + + +/*----------------------------------------------------------------------------- + + Subscription + +-----------------------------------------------------------------------------*/ + +static int +save_subscriber(subs, subs_pid) +subs_list *subs; ErlDrvTermData subs_pid; +{ + subs_list *tmp; + + if(NO_SUBSCRIBERS(subs)) { + subs->subscriber = subs_pid; + subs->next = NULL; + } + else { + tmp = subs->next; + subs->next = ALLOC(sizeof(subs_list)); + if(subs->next == NULL) { + subs->next = tmp; + return 0; + } + subs->next->subscriber = subs_pid; + subs->next->next = tmp; + } + return 1; +} + +static void +free_subscribers(subs) +subs_list *subs; +{ + subs_list *this; + subs_list *next; + + this = subs->next; + while(this) { + next = this->next; + FREE((void *) this); + this = next; + } + + subs->subscriber = NO_PROCESS; + subs->next = NULL; +} + +static void send_to_subscribers +( + ErlDrvPort port, + subs_list *subs, + int free_subs, + ErlDrvTermData msg[], + int msg_len +) +{ + subs_list *this; + subs_list *next; + int first = 1; + + if(NO_SUBSCRIBERS(subs)) + return; + + this = subs; + while(this) { + + (void) driver_send_term(port, this->subscriber, msg, msg_len); + + if(free_subs && !first) { + next = this->next; + FREE((void *) this); + this = next; + } + else + this = this->next; + first = 0; + } + + if(free_subs) { + subs->subscriber = NO_PROCESS; + subs->next = NULL; + } + +} + +/* + * A *very* limited socket interface. Used by the memory tracer + * (erl_mtrace.c). + */ +#include "erl_sock.h" + +erts_sock_t erts_sock_open(void) +{ + SOCKET s; + + if(!sock_init()) + return ERTS_SOCK_INVALID_SOCKET; + + s = sock_open(AF_INET, SOCK_STREAM, 0); + + if (s == INVALID_SOCKET) + return ERTS_SOCK_INVALID_SOCKET; + + return (erts_sock_t) s; +} + +void erts_sock_close(erts_sock_t socket) +{ + if (socket != ERTS_SOCK_INVALID_SOCKET) + sock_close((SOCKET) socket); +} + + +int erts_sock_connect(erts_sock_t socket, byte *ip_addr, int len, Uint16 port) +{ + SOCKET s = (SOCKET) socket; + char buf[2 + 4]; + int blen = 6; + inet_address addr; + + if (socket == ERTS_SOCK_INVALID_SOCKET || len != 4) + return 0; + + put_int16(port, buf); + memcpy((void *) (buf + 2), (void *) ip_addr, 4); + + if (!inet_set_address(AF_INET, &addr, buf, &blen)) + return 0; + + if (SOCKET_ERROR == sock_connect(s, + (struct sockaddr *) &addr, + sizeof(struct sockaddr_in))) + return 0; + return 1; +} + +Sint erts_sock_send(erts_sock_t socket, const void *buf, Sint len) +{ + return (Sint) sock_send((SOCKET) socket, buf, (size_t) len, 0); +} + + +int erts_sock_gethostname(char *buf, int bufsz) +{ + if (sock_hostname(buf, bufsz) == SOCKET_ERROR) + return -1; + return 0; +} + + +int erts_sock_errno() +{ + return sock_errno(); +} diff --git a/erts/emulator/drivers/common/ram_file_drv.c b/erts/emulator/drivers/common/ram_file_drv.c new file mode 100644 index 0000000000..2e3aeb981e --- /dev/null +++ b/erts/emulator/drivers/common/ram_file_drv.c @@ -0,0 +1,692 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * RAM File operations + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +/* Operations */ + +/* defined "file" functions */ +#define RAM_FILE_OPEN 1 +#define RAM_FILE_READ 2 +#define RAM_FILE_LSEEK 3 +#define RAM_FILE_WRITE 4 +#define RAM_FILE_FSYNC 9 +#define RAM_FILE_TRUNCATE 14 +#define RAM_FILE_PREAD 17 +#define RAM_FILE_PWRITE 18 + +/* other operations */ +#define RAM_FILE_GET 30 +#define RAM_FILE_SET 31 +#define RAM_FILE_GET_CLOSE 32 /* get_file/close */ +#define RAM_FILE_COMPRESS 33 /* compress file */ +#define RAM_FILE_UNCOMPRESS 34 /* uncompress file */ +#define RAM_FILE_UUENCODE 35 /* uuencode file */ +#define RAM_FILE_UUDECODE 36 /* uudecode file */ +#define RAM_FILE_SIZE 37 /* get file size */ +/* possible new operations include: + DES_ENCRYPT + DES_DECRYPT + CRC-32, CRC-16, CRC-CCITT + IP-CHECKSUM +*/ + +/* + * Open modes for RAM_FILE_OPEN. + */ +#define RAM_FILE_MODE_READ 1 +#define RAM_FILE_MODE_WRITE 2 /* Implies truncating file + * when used alone. */ +#define RAM_FILE_MODE_READ_WRITE 3 + +/* + * Seek modes for RAM_FILE_LSEEK. + */ +#define RAM_FILE_SEEK_SET 0 +#define RAM_FILE_SEEK_CUR 1 +#define RAM_FILE_SEEK_END 2 + +/* Return codes */ + +#define RAM_FILE_RESP_OK 0 +#define RAM_FILE_RESP_ERROR 1 +#define RAM_FILE_RESP_DATA 2 +#define RAM_FILE_RESP_NUMBER 3 +#define RAM_FILE_RESP_INFO 4 + +#include +#include +#include + +#include "sys.h" +#include "erl_driver.h" +#include "zlib.h" +#include "gzio.h" + +#ifndef NULL +#define NULL ((void*)0) +#endif + +#define BFILE_BLOCK 1024 + +typedef unsigned char uchar; + +static ErlDrvData rfile_start(ErlDrvPort, char*); +static int rfile_init(void); +static void rfile_stop(ErlDrvData); +static void rfile_command(ErlDrvData, char*, int); + + +struct erl_drv_entry ram_file_driver_entry = { + rfile_init, + rfile_start, + rfile_stop, + rfile_command, + NULL, + NULL, + "ram_file_drv" +}; + +/* A File is represented as a array of bytes, this array is + reallocated when needed. A possibly better implementation + whould be to have a vector of blocks. This may be implemented + when we have the commandv/driver_outputv +*/ +typedef struct ram_file { + ErlDrvPort port; /* the associcated port */ + int flags; /* flags read/write */ + ErlDrvBinary* bin; /* binary to hold binary file */ + char* buf; /* buffer start (in binary) */ + int size; /* buffer size (allocated) */ + int cur; /* current position in buffer */ + int end; /* end position in buffer */ +} RamFile; + +#ifdef LOADABLE +static int rfile_finish(DriverEntry* drv) +{ + return 0; +} + +DriverEntry* driver_init(void *handle) +{ + ram_file_driver_entry.handle = handle; + ram_file_driver_entry.driver_name = "ram_file_drv"; + ram_file_driver_entry.finish = rfile_finish; + ram_file_driver_entry.init = rfile_init; + ram_file_driver_entry.start = rfile_start; + ram_file_driver_entry.stop = rfile_stop; + ram_file_driver_entry.output = rfile_command; + ram_file_driver_entry.ready_input = NULL; + ram_file_driver_entry.ready_output = NULL; + return &ram_file_driver_entry; +} +#endif + +static int rfile_init(void) +{ + return 0; +} + +static ErlDrvData rfile_start(ErlDrvPort port, char* buf) +{ + RamFile* f; + + if ((f = (RamFile*) driver_alloc(sizeof(RamFile))) == NULL) { + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + f->port = port; + f->flags = 0; + f->bin = NULL; + f->buf = NULL; + f->size = f->cur = f->end = 0; + return (ErlDrvData)f; +} + +static void rfile_stop(ErlDrvData e) +{ + RamFile* f = (RamFile*)e; + if (f->bin != NULL) + driver_free_binary(f->bin); + driver_free(f); +} + +/* + * Sends back an error reply to Erlang. + */ + +static int error_reply(RamFile *f, int err) +{ + char response[256]; /* Response buffer. */ + char* s; + char* t; + + /* + * Contents of buffer sent back: + * + * +-----------------------------------------+ + * | RAM_FILE_RESP_ERROR | Posix error id string | + * +-----------------------------------------+ + */ + response[0] = RAM_FILE_RESP_ERROR; + for (s = erl_errno_id(err), t = response+1; *s; s++, t++) + *t = tolower(*s); + driver_output2(f->port, response, t-response, NULL, 0); + return 0; +} + +static int reply(RamFile *f, int ok, int err) +{ + if (!ok) + error_reply(f, err); + else { + char c = RAM_FILE_RESP_OK; + driver_output2(f->port, &c, 1, NULL, 0); + } + return 0; +} + +static int numeric_reply(RamFile *f, int result) +{ + char tmp[5]; + + /* + * Contents of buffer sent back: + * + * +-----------------------------------------------+ + * | RAM_FILE_RESP_NUMBER | 32-bit number (big-endian) | + * +-----------------------------------------------+ + */ + + tmp[0] = RAM_FILE_RESP_NUMBER; + put_int32(result, tmp+1); + driver_output2(f->port, tmp, sizeof(tmp), NULL, 0); + return 0; +} + +/* install bin as the new binary reset all pointer */ + +static void ram_file_set(RamFile *f, ErlDrvBinary *bin, int bsize, int len) +{ + f->size = bsize; + f->buf = bin->orig_bytes; + f->cur = 0; + f->end = len; + f->bin = bin; +} + +static int ram_file_init(RamFile *f, char *buf, int count, int *error) +{ + int bsize; + ErlDrvBinary* bin; + + if (count < 0) { + *error = EINVAL; + return -1; + } + if ((bsize = (count+BFILE_BLOCK+(BFILE_BLOCK>>1)) & ~(BFILE_BLOCK-1)) + < 0) { + bsize = INT_MAX; + } + + if (f->bin == NULL) + bin = driver_alloc_binary(bsize); + else + bin = driver_realloc_binary(f->bin, bsize); + if (bin == NULL) { + *error = ENOMEM; + return -1; + } + sys_memzero(bin->orig_bytes, bsize); + sys_memcpy(bin->orig_bytes, buf, count); + ram_file_set(f, bin, bsize, count); + return count; +} + +static int ram_file_expand(RamFile *f, int size, int *error) +{ + int bsize; + ErlDrvBinary* bin; + + if (size < 0) { + *error = EINVAL; + return -1; + } + if ((bsize = (size+BFILE_BLOCK+(BFILE_BLOCK>>1)) & ~(BFILE_BLOCK-1)) + < 0) { + bsize = INT_MAX; + } + + if (bsize <= f->size) + return f->size; + else { + if ((bin = driver_realloc_binary(f->bin, bsize)) == NULL) { + *error = ENOMEM; + return -1; + } + sys_memzero(bin->orig_bytes+f->size, bsize - f->size); + f->size = bsize; + f->buf = bin->orig_bytes; + f->bin = bin; + return bsize; + } +} + + +static int ram_file_write(RamFile *f, char *buf, int len, + int *location, int *error) +{ + int cur = f->cur; + + if (!(f->flags & RAM_FILE_MODE_WRITE)) { + *error = EBADF; + return -1; + } + if (location) cur = *location; + if (cur < 0 || len < 0 || cur+len < 0) { + *error = EINVAL; + return -1; + } + if (cur+len > f->size && ram_file_expand(f, cur+len, error) < 0) { + return -1; + } + if (len) sys_memcpy(f->buf+cur, buf, len); + cur += len; + if (cur > f->end) f->end = cur; + if (! location) f->cur = cur; + return len; +} + +static int ram_file_read(RamFile *f, int len, ErlDrvBinary **bp, + int *location, int *error) +{ + ErlDrvBinary* bin; + int cur = f->cur; + + if (!(f->flags & RAM_FILE_MODE_READ)) { + *error = EBADF; + return -1; + } + if (location) cur = *location; + if (cur < 0 || len < 0) { + *error = EINVAL; + return -1; + } + if (cur < f->end) { + if (len > f->end-cur) len = f->end - cur; + } else { + len = 0; /* eof */ + } + if ((bin = driver_alloc_binary(len)) == NULL) { + *error = ENOMEM; + return -1; + } + if (len) sys_memcpy(bin->orig_bytes, f->buf+cur, len); + *bp = bin; + if (! location) f->cur = cur + len; + return len; +} + +static int ram_file_seek(RamFile *f, int offset, int whence, int *error) +{ + int pos; + + if (f->flags == 0) { + *error = EBADF; + return -1; + } + switch(whence) { + case RAM_FILE_SEEK_SET: pos = offset; break; + case RAM_FILE_SEEK_CUR: pos = f->cur + offset; break; + case RAM_FILE_SEEK_END: pos = f->end + offset; break; + default: *error = EINVAL; return -1; + } + if (pos < 0) { + *error = EINVAL; + return -1; + } + return f->cur = pos; +} + +#define UUMASK(x) ((x)&0x3F) +#define uu_encode(x) (UUMASK(x)+32) + +/* calculate max number of quadrauple bytes given max line length */ +#define UULINE(n) ( (((n)-1) / 4) * 3) + +#define UNIX_LINE 61 /* 61 character lines => 45 uncoded => 60 coded */ + +#define uu_pack(p, c1, c2, c3) \ + (p)[0] = uu_encode((c1) >> 2), \ + (p)[1] = uu_encode(((c1) << 4) | ((c2) >> 4)), \ + (p)[2] = uu_encode(((c2) << 2) | ((c3) >> 6)), \ + (p)[3] = uu_encode(c3) + +static int ram_file_uuencode(RamFile *f) +{ + int code_len = UULINE(UNIX_LINE); + int len = f->end; + int usize = (len*4+2)/3 + 2*(len/code_len+1) + 2 + 1; + ErlDrvBinary* bin; + uchar* inp; + uchar* outp; + int count = 0; + + if ((bin = driver_alloc_binary(usize)) == NULL) + return error_reply(f, ENOMEM); + outp = (uchar*)bin->orig_bytes; + inp = (uchar*)f->buf; + + while(len > 0) { + int c1, c2, c3; + int n = (len >= code_len) ? code_len : len; + + len -= n; + *outp++ = uu_encode(UUMASK(n)); + count++; + while (n >= 3) { + c1 = inp[0]; + c2 = inp[1]; + c3 = inp[2]; + uu_pack(outp, c1, c2, c3); + inp += 3; n -= 3; + outp += 4; count += 4; + } + if (n == 2) { + c1 = inp[0]; + c2 = inp[1]; + uu_pack(outp, c1, c2, 0); + inp += 2; + outp += 4; count += 4; + } + else if (n == 1) { + c1 = inp[0]; + uu_pack(outp, c1, 0, 0); + inp += 1; + outp += 4; count += 4; + } + *outp++ = '\n'; + count++; + } + *outp++ = ' '; /* this end of file 0 length !!! */ + *outp++ = '\n'; + count += 2; + + driver_free_binary(f->bin); + ram_file_set(f, bin, usize, count); + return numeric_reply(f, count); +} + + +#define uu_decode(x) ((x)-32) + +static int ram_file_uudecode(RamFile *f) +{ + int len = f->end; + int usize = ( (len+3) / 4 ) * 3; + ErlDrvBinary* bin; + uchar* inp; + uchar* outp; + int count = 0; + int n; + + if ((bin = driver_alloc_binary(usize)) == NULL) + return error_reply(f, ENOMEM); + outp = (uchar*)bin->orig_bytes; + inp = (uchar*)f->buf; + + while(len > 0) { + if ((n = uu_decode(*inp++)) < 0) + goto error; + len--; + if ((n == 0) && (*inp == '\n')) + break; + count += n; /* count characters */ + while((n > 0) && (len >= 4)) { + int c1, c2, c3, c4; + c1 = uu_decode(inp[0]); + c2 = uu_decode(inp[1]); + c3 = uu_decode(inp[2]); + c4 = uu_decode(inp[3]); + inp += 4; + len -= 4; + + switch(n) { + case 1: + *outp++ = (c1 << 2) | (c2 >> 4); + n = 0; + break; + case 2: + *outp++ = (c1 << 2) | (c2 >> 4); + *outp++ = (c2 << 4) | (c3 >> 2); + n = 0; + break; + default: + *outp++ = (c1 << 2) | (c2 >> 4); + *outp++ = (c2 << 4) | (c3 >> 2); + *outp++ = (c3 << 6) | c4; + n -= 3; + break; + } + } + if ((n != 0) || (*inp++ != '\n')) + goto error; + len--; + } + driver_free_binary(f->bin); + ram_file_set(f, bin, usize, count); + return numeric_reply(f, count); + + error: + driver_free_binary(bin); + return error_reply(f, EINVAL); +} + + +static int ram_file_compress(RamFile *f) +{ + int size = f->end; + ErlDrvBinary* bin; + + if ((bin = erts_gzdeflate_buffer(f->buf, size)) == NULL) { + return error_reply(f, EINVAL); + } + driver_free_binary(f->bin); + size = bin->orig_size; + ram_file_set(f, bin, size, size); + return numeric_reply(f, size); +} + +/* Tricky since we dont know the expanded size !!! */ +/* First attempt is to double the size of input */ +/* loop until we don't get Z_BUF_ERROR */ + +static int ram_file_uncompress(RamFile *f) +{ + int size = f->end; + ErlDrvBinary* bin; + + if ((bin = erts_gzinflate_buffer(f->buf, size)) == NULL) { + return error_reply(f, EINVAL); + } + driver_free_binary(f->bin); + size = bin->orig_size; + ram_file_set(f, bin, size, size); + return numeric_reply(f, size); +} + + +static void rfile_command(ErlDrvData e, char* buf, int count) +{ + RamFile* f = (RamFile*)e; + int error = 0; + ErlDrvBinary* bin; + char header[5]; /* result code + count */ + int offset; + int origin; /* Origin of seek. */ + int n; + + count--; + switch(*(uchar*)buf++) { + case RAM_FILE_OPEN: /* args is initial data */ + f->flags = get_int32(buf); + if (ram_file_init(f, buf+4, count-4, &error) < 0) + error_reply(f, error); + else + numeric_reply(f, 0); /* 0 is not used */ + break; + + case RAM_FILE_FSYNC: + if (f->flags == 0) + error_reply(f, EBADF); + else + reply(f, 1, 0); + break; + + case RAM_FILE_WRITE: + if (ram_file_write(f, buf, count, NULL, &error) < 0) + error_reply(f, error); + else + numeric_reply(f, count); + break; + + case RAM_FILE_PWRITE: + if ((offset = get_int32(buf)) < 0) + error_reply(f, EINVAL); + else if (ram_file_write(f, buf+4, count-4, &offset, &error) < 0) + error_reply(f, error); + else + numeric_reply(f, count-4); + break; + + case RAM_FILE_LSEEK: + offset = get_int32(buf); + origin = get_int32(buf+4); + if ((offset = ram_file_seek(f, offset, origin, &error)) < 0) + error_reply(f, error); + else + numeric_reply(f, offset); + break; + + case RAM_FILE_PREAD: + if ((offset = get_int32(buf)) < 0) { + error_reply(f, EINVAL); + break; + } + + count = get_int32(buf+4); + if ((n = ram_file_read(f, count, &bin, &offset, &error)) < 0) { + error_reply(f, error); + } else { + header[0] = RAM_FILE_RESP_DATA; + put_int32(n, header+1); + driver_output_binary(f->port, header, sizeof(header), + bin, 0, n); + driver_free_binary(bin); + } + break; + + case RAM_FILE_READ: + count = get_int32(buf); + if ((n = ram_file_read(f, count, &bin, NULL, &error)) < 0) + error_reply(f, error); + else { + header[0] = RAM_FILE_RESP_DATA; + put_int32(n, header+1); + driver_output_binary(f->port, header, sizeof(header), + bin, 0, n); + driver_free_binary(bin); + } + break; + + case RAM_FILE_TRUNCATE: + if (!(f->flags & RAM_FILE_MODE_WRITE)) { + error_reply(f, EACCES); + break; + } + if (f->end > f->cur) + sys_memzero(f->buf + f->cur, f->end - f->cur); + f->end = f->cur; + reply(f, 1, 0); + break; + + case RAM_FILE_GET: /* return a copy of the file */ + n = f->end; /* length */ + if ((bin = driver_alloc_binary(n)) == NULL) { + error_reply(f, ENOMEM); + break; + } + sys_memcpy(bin->orig_bytes, f->buf, n); + + header[0] = RAM_FILE_RESP_DATA; + put_int32(n, header+1); + driver_output_binary(f->port, header, sizeof(header), + bin, 0, n); + driver_free_binary(bin); + break; + + case RAM_FILE_GET_CLOSE: /* return the file and close driver */ + n = f->end; /* length */ + bin = f->bin; + f->bin = NULL; /* NUKE IT */ + header[0] = RAM_FILE_RESP_DATA; + put_int32(n, header+1); + driver_output_binary(f->port, header, sizeof(header), + bin, 0, n); + driver_free_binary(bin); + driver_failure(f->port, 0); + break; + + case RAM_FILE_SIZE: + numeric_reply(f, f->end); + break; + + case RAM_FILE_SET: /* re-init file with new data */ + if ((n = ram_file_init(f, buf, count, &error)) < 0) + error_reply(f, error); + else + numeric_reply(f, n); /* 0 is not used */ + break; + + case RAM_FILE_COMPRESS: /* inline compress the file */ + ram_file_compress(f); + break; + + case RAM_FILE_UNCOMPRESS: /* inline uncompress file */ + ram_file_uncompress(f); + break; + + case RAM_FILE_UUENCODE: /* uuencode file */ + ram_file_uuencode(f); + break; + + case RAM_FILE_UUDECODE: /* uudecode file */ + ram_file_uudecode(f); + break; + } + /* + * Ignore anything else -- let the caller hang. + */ +} diff --git a/erts/emulator/drivers/common/zlib_drv.c b/erts/emulator/drivers/common/zlib_drv.c new file mode 100644 index 0000000000..723efeaa13 --- /dev/null +++ b/erts/emulator/drivers/common/zlib_drv.c @@ -0,0 +1,650 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * ZLib interface for erlang + * + */ +#include +#include +#include +#include + +#include "erl_driver.h" + + +#define DEFLATE_INIT 1 +#define DEFLATE_INIT2 2 +#define DEFLATE_SETDICT 3 +#define DEFLATE_RESET 4 +#define DEFLATE_END 5 +#define DEFLATE_PARAMS 6 +#define DEFLATE 7 + +#define INFLATE_INIT 8 +#define INFLATE_INIT2 9 +#define INFLATE_SETDICT 10 +#define INFLATE_SYNC 11 +#define INFLATE_RESET 12 +#define INFLATE_END 13 +#define INFLATE 14 + +#define CRC32_0 15 +#define CRC32_1 16 +#define CRC32_2 17 + +#define SET_BUFSZ 18 +#define GET_BUFSZ 19 +#define GET_QSIZE 20 + +#define ADLER32_1 21 +#define ADLER32_2 22 + +#define CRC32_COMBINE 23 +#define ADLER32_COMBINE 24 + +#define DEFAULT_BUFSZ 4000 + +static int zlib_init(void); +static ErlDrvData zlib_start(ErlDrvPort port, char* buf); +static void zlib_stop(ErlDrvData e); +static int zlib_ctl(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); +static void zlib_outputv(ErlDrvData drv_data, ErlIOVec *ev); + +ErlDrvEntry zlib_driver_entry = { + zlib_init, + zlib_start, + zlib_stop, + NULL, /* output */ + NULL, /* ready_input */ + NULL, /* ready_output */ + "zlib_drv", + NULL, /* finish */ + NULL, /* handle */ + zlib_ctl, + NULL, /* timeout */ + zlib_outputv, + NULL, /* read_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL, /* handle2 */ + NULL, /* process_exit */ +}; + +typedef enum { + ST_NONE = 0, + ST_DEFLATE = 1, + ST_INFLATE = 2 +} ZLibState; + + +typedef struct { + z_stream s; + ZLibState state; + ErlDrvBinary* bin; + int binsz; + int binsz_need; + uLong crc; + int inflate_eos_seen; + int want_crc; /* 1 if crc is calculated on clear text */ + ErlDrvPort port; /* the associcated port */ +} ZLibData; + +static int zlib_inflate(ZLibData* d, int flush); +static int zlib_deflate(ZLibData* d, int flush); + +#if defined(_OSE_) || defined(__WIN32__) +static int i32(char* buf) +#else +static inline int i32(char* buf) +#endif +{ + return (int) ( + (((int)((unsigned char*)buf)[0]) << 24) | + (((int)((unsigned char*)buf)[1]) << 16) | + (((int)((unsigned char*)buf)[2]) << 8) | + (((int)((unsigned char*)buf)[3]) << 0)); +} + +static char* zlib_reason(int code, int* err) +{ + switch(code) { + case Z_OK: + *err = 0; + return "ok"; + case Z_STREAM_END: + *err = 0; + return "stream_end"; + case Z_ERRNO: + *err = 1; + return erl_errno_id(errno); + case Z_STREAM_ERROR: + *err = 1; + return "stream_error"; + case Z_DATA_ERROR: + *err = 1; + return "data_error"; + case Z_MEM_ERROR: + *err = 1; + return "mem_error"; + case Z_BUF_ERROR: + *err = 1; + return "buf_error"; + case Z_VERSION_ERROR: + *err = 1; + return "version_error"; + default: + *err = 1; + return "unknown_error"; + } +} + + +static int zlib_return(int code, char** rbuf, int rlen) +{ + int msg_code = 0; /* 0=ok, 1=error */ + char* dst = *rbuf; + char* src; + int len = 0; + + src = zlib_reason(code, &msg_code); + *dst++ = msg_code; + rlen--; + len = 1; + + while((rlen > 0) && *src) { + *dst++ = *src++; + rlen--; + len++; + } + return len; +} + +static int zlib_value2(int msg_code, int value, char** rbuf, int rlen) +{ + char* dst = *rbuf; + + if (rlen < 5) { + return -1; + } + *dst++ = msg_code; + *dst++ = (value >> 24) & 0xff; + *dst++ = (value >> 16) & 0xff; + *dst++ = (value >> 8) & 0xff; + *dst++ = value & 0xff; + return 5; +} + +static int zlib_value(int value, char** rbuf, int rlen) +{ + return zlib_value2(2, value, rbuf, rlen); +} + +static int zlib_output_init(ZLibData* d) +{ + if (d->bin != NULL) + driver_free_binary(d->bin); + if ((d->bin = driver_alloc_binary(d->binsz_need)) == NULL) + return -1; + d->binsz = d->binsz_need; + d->s.next_out = (unsigned char*)d->bin->orig_bytes; + d->s.avail_out = d->binsz; + return 0; +} + +/* + * Send compressed or uncompressed data + * and restart output procesing + */ +static int zlib_output(ZLibData* d) +{ + if (d->bin != NULL) { + int len = d->binsz - d->s.avail_out; + if (len > 0) { + if (driver_output_binary(d->port, NULL, 0, d->bin, 0, len) < 0) + return -1; + } + driver_free_binary(d->bin); + d->bin = NULL; + d->binsz = 0; + } + return zlib_output_init(d); +} + +static int zlib_inflate(ZLibData* d, int flush) +{ + int res = Z_OK; + + if ((d->bin == NULL) && (zlib_output_init(d) < 0)) { + errno = ENOMEM; + return Z_ERRNO; + } + + while ((driver_sizeq(d->port) > 0) && (res != Z_STREAM_END)) { + int vlen; + SysIOVec* iov = driver_peekq(d->port, &vlen); + int len; + int possibly_more_output = 0; + + d->s.next_in = iov[0].iov_base; + d->s.avail_in = iov[0].iov_len; + while((possibly_more_output || (d->s.avail_in > 0)) && (res != Z_STREAM_END)) { + res = inflate(&d->s, Z_NO_FLUSH); + if (res == Z_NEED_DICT) { + /* Essential to eat the header bytes that zlib has looked at */ + len = iov[0].iov_len - d->s.avail_in; + driver_deq(d->port, len); + return res; + } + if (res == Z_BUF_ERROR) { + /* Was possible more output, but actually not */ + res = Z_OK; + } + else if (res < 0) { + return res; + } + if (d->s.avail_out != 0) { + possibly_more_output = 0; + } else { + if (d->want_crc) + d->crc = crc32(d->crc, (unsigned char*)d->bin->orig_bytes, + d->binsz - d->s.avail_out); + zlib_output(d); + possibly_more_output = 1; + } + } + len = iov[0].iov_len - d->s.avail_in; + driver_deq(d->port, len); + } + + if (d->want_crc) { + d->crc = crc32(d->crc, (unsigned char*) d->bin->orig_bytes, + d->binsz - d->s.avail_out); + } + zlib_output(d); + if (res == Z_STREAM_END) { + d->inflate_eos_seen = 1; + } + return res; +} + +static int zlib_deflate(ZLibData* d, int flush) +{ + int res = Z_OK; + + if ((d->bin == NULL) && (zlib_output_init(d) < 0)) { + errno = ENOMEM; + return Z_ERRNO; + } + + while ((driver_sizeq(d->port) > 0) && (res != Z_STREAM_END)) { + int vlen; + SysIOVec* iov = driver_peekq(d->port, &vlen); + int len; + + d->s.next_in = iov[0].iov_base; + d->s.avail_in = iov[0].iov_len; + + while((d->s.avail_in > 0) && (res != Z_STREAM_END)) { + if ((res = deflate(&d->s, Z_NO_FLUSH)) < 0) { + return res; + } + if (d->s.avail_out == 0) { + zlib_output(d); + } + } + len = iov[0].iov_len - d->s.avail_in; + if (d->want_crc) { + d->crc = crc32(d->crc, iov[0].iov_base, len); + } + driver_deq(d->port, len); + } + + if (flush != Z_NO_FLUSH) { + if ((res = deflate(&d->s, flush)) < 0) { + return res; + } + if (flush == Z_FINISH) { + while (d->s.avail_out < d->binsz) { + zlib_output(d); + if (res == Z_STREAM_END) { + break; + } + if ((res = deflate(&d->s, flush)) < 0) { + return res; + } + } + } else { + while (d->s.avail_out == 0) { + zlib_output(d); + if ((res = deflate(&d->s, flush)) < 0) { + return res; + } + } + if (d->s.avail_out < d->binsz) { + zlib_output(d); + } + } + } + return res; +} + + + +static void* zlib_alloc(void* data, unsigned int items, unsigned int size) +{ + return (void*) driver_alloc(items*size); +} + +static void zlib_free(void* data, void* addr) +{ + driver_free(addr); +} + +static int zlib_init() +{ + return 0; +} + +static ErlDrvData zlib_start(ErlDrvPort port, char* buf) +{ + ZLibData* d; + + if ((d = (ZLibData*) driver_alloc(sizeof(ZLibData))) == NULL) + return ERL_DRV_ERROR_GENERAL; + + memset(&d->s, 0, sizeof(z_stream)); + + d->s.zalloc = zlib_alloc; + d->s.zfree = zlib_free; + d->s.opaque = d; + d->s.data_type = Z_BINARY; + + d->port = port; + d->state = ST_NONE; + d->bin = NULL; + d->binsz = 0; + d->binsz_need = DEFAULT_BUFSZ; + d->crc = crc32(0L, Z_NULL, 0); + d->inflate_eos_seen = 0; + d->want_crc = 0; + return (ErlDrvData)d; +} + + +static void zlib_stop(ErlDrvData e) +{ + ZLibData* d = (ZLibData*)e; + + if (d->state == ST_DEFLATE) + deflateEnd(&d->s); + else if (d->state == ST_INFLATE) + inflateEnd(&d->s); + + if (d->bin != NULL) + driver_free_binary(d->bin); + + driver_free(d); +} + +static int zlib_ctl(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + ZLibData* d = (ZLibData*)drv_data; + int res; + + switch(command) { + case DEFLATE_INIT: + if (len != 4) goto badarg; + if (d->state != ST_NONE) goto badarg; + res = deflateInit(&d->s, i32(buf)); + if (res == Z_OK) { + d->state = ST_DEFLATE; + d->want_crc = 0; + d->crc = crc32(0L, Z_NULL, 0); + } + return zlib_return(res, rbuf, rlen); + + case DEFLATE_INIT2: { + int wbits; + + if (len != 20) goto badarg; + if (d->state != ST_NONE) goto badarg; + wbits = i32(buf+8); + res = deflateInit2(&d->s, i32(buf), i32(buf+4), wbits, + i32(buf+12), i32(buf+16)); + if (res == Z_OK) { + d->state = ST_DEFLATE; + d->want_crc = (wbits < 0); + d->crc = crc32(0L, Z_NULL, 0); + } + return zlib_return(res, rbuf, rlen); + } + + case DEFLATE_SETDICT: + if (d->state != ST_DEFLATE) goto badarg; + res = deflateSetDictionary(&d->s, (unsigned char*)buf, len); + if (res == Z_OK) { + return zlib_value(d->s.adler, rbuf, rlen); + } else { + return zlib_return(res, rbuf, rlen); + } + + case DEFLATE_RESET: + if (len != 0) goto badarg; + if (d->state != ST_DEFLATE) goto badarg; + driver_deq(d->port, driver_sizeq(d->port)); + res = deflateReset(&d->s); + return zlib_return(res, rbuf, rlen); + + case DEFLATE_END: + if (len != 0) goto badarg; + if (d->state != ST_DEFLATE) goto badarg; + driver_deq(d->port, driver_sizeq(d->port)); + res = deflateEnd(&d->s); + d->state = ST_NONE; + return zlib_return(res, rbuf, rlen); + + case DEFLATE_PARAMS: + if (len != 8) goto badarg; + if (d->state != ST_DEFLATE) goto badarg; + res = deflateParams(&d->s, i32(buf), i32(buf+4)); + return zlib_return(res, rbuf, rlen); + + case DEFLATE: + if (d->state != ST_DEFLATE) goto badarg; + if (len != 4) goto badarg; + res = zlib_deflate(d, i32(buf)); + return zlib_return(res, rbuf, rlen); + + case INFLATE_INIT: + if (len != 0) goto badarg; + if (d->state != ST_NONE) goto badarg; + res = inflateInit(&d->s); + if (res == Z_OK) { + d->state = ST_INFLATE; + d->inflate_eos_seen = 0; + d->want_crc = 0; + d->crc = crc32(0L, Z_NULL, 0); + } + return zlib_return(res, rbuf, rlen); + + case INFLATE_INIT2: { + int wbits; + + if (len != 4) goto badarg; + if (d->state != ST_NONE) goto badarg; + wbits = i32(buf); + res = inflateInit2(&d->s, wbits); + if (res == Z_OK) { + d->state = ST_INFLATE; + d->inflate_eos_seen = 0; + d->want_crc = (wbits < 0); + d->crc = crc32(0L, Z_NULL, 0); + } + return zlib_return(res, rbuf, rlen); + } + + case INFLATE_SETDICT: + if (d->state != ST_INFLATE) goto badarg; + res = inflateSetDictionary(&d->s, (unsigned char*)buf, len); + return zlib_return(res, rbuf, rlen); + + case INFLATE_SYNC: + if (d->state != ST_INFLATE) goto badarg; + if (len != 0) goto badarg; + if (driver_sizeq(d->port) == 0) { + res = Z_BUF_ERROR; + } else { + int vlen; + SysIOVec* iov = driver_peekq(d->port, &vlen); + + d->s.next_in = iov[0].iov_base; + d->s.avail_in = iov[0].iov_len; + res = inflateSync(&d->s); + } + return zlib_return(res, rbuf, rlen); + + case INFLATE_RESET: + if (d->state != ST_INFLATE) goto badarg; + if (len != 0) goto badarg; + driver_deq(d->port, driver_sizeq(d->port)); + res = inflateReset(&d->s); + d->inflate_eos_seen = 0; + return zlib_return(res, rbuf, rlen); + + case INFLATE_END: + if (d->state != ST_INFLATE) goto badarg; + if (len != 0) goto badarg; + driver_deq(d->port, driver_sizeq(d->port)); + res = inflateEnd(&d->s); + if (res == Z_OK && d->inflate_eos_seen == 0) { + res = Z_DATA_ERROR; + } + d->state = ST_NONE; + return zlib_return(res, rbuf, rlen); + + case INFLATE: + if (d->state != ST_INFLATE) goto badarg; + if (len != 4) goto badarg; + res = zlib_inflate(d, i32(buf)); + if (res == Z_NEED_DICT) { + return zlib_value2(3, d->s.adler, rbuf, rlen); + } else { + return zlib_return(res, rbuf, rlen); + } + + case GET_QSIZE: + return zlib_value(driver_sizeq(d->port), rbuf, rlen); + + case GET_BUFSZ: + return zlib_value(d->binsz_need, rbuf, rlen); + + case SET_BUFSZ: { + int need; + if (len != 4) goto badarg; + need = i32(buf); + if ((need < 16) || (need > 0x00ffffff)) + goto badarg; + if (d->binsz_need != need) { + d->binsz_need = need; + if (d->bin != NULL) { + if (d->s.avail_out == d->binsz) { + driver_free_binary(d->bin); + d->bin = NULL; + d->binsz = 0; + } + else + zlib_output(d); + } + } + return zlib_return(Z_OK, rbuf, rlen); + } + + case CRC32_0: + return zlib_value(d->crc, rbuf, rlen); + + case CRC32_1: { + uLong crc = crc32(0L, Z_NULL, 0); + crc = crc32(crc, (unsigned char*) buf, len); + return zlib_value(crc, rbuf, rlen); + } + + case CRC32_2: { + uLong crc; + if (len < 4) goto badarg; + crc = (unsigned int) i32(buf); + crc = crc32(crc, (unsigned char*) buf+4, len-4); + return zlib_value(crc, rbuf, rlen); + } + + case ADLER32_1: { + uLong adler = adler32(0L, Z_NULL, 0); + adler = adler32(adler, (unsigned char*) buf, len); + return zlib_value(adler, rbuf, rlen); + } + + case ADLER32_2: { + uLong adler; + if (len < 4) goto badarg; + adler = (unsigned int) i32(buf); + adler = adler32(adler, (unsigned char*) buf+4, len-4); + return zlib_value(adler, rbuf, rlen); + } + + case CRC32_COMBINE: { + uLong crc, crc1, crc2, len2; + if (len != 12) goto badarg; + crc1 = (unsigned int) i32(buf); + crc2 = (unsigned int) i32(buf+4); + len2 = (unsigned int) i32(buf+8); + crc = crc32_combine(crc1, crc2, len2); + return zlib_value(crc, rbuf, rlen); + } + + case ADLER32_COMBINE: { + uLong adler, adler1, adler2, len2; + if (len != 12) goto badarg; + adler1 = (unsigned int) i32(buf); + adler2 = (unsigned int) i32(buf+4); + len2 = (unsigned int) i32(buf+8); + adler = adler32_combine(adler1, adler2, len2); + return zlib_value(adler, rbuf, rlen); + } + } + + badarg: + errno = EINVAL; + return zlib_return(Z_ERRNO, rbuf, rlen); +} + + + +static void zlib_outputv(ErlDrvData drv_data, ErlIOVec *ev) +{ + ZLibData* d = (ZLibData*) drv_data; + + driver_enqv(d->port, ev, 0); +} diff --git a/erts/emulator/drivers/unix/bin_drv.c b/erts/emulator/drivers/unix/bin_drv.c new file mode 100644 index 0000000000..1827187d57 --- /dev/null +++ b/erts/emulator/drivers/unix/bin_drv.c @@ -0,0 +1,224 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Purpose: Binary file driver interface , used for code loading */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include +#include +#include +#include "erl_driver.h" +#include + +#ifdef NO_UMASK +#define FILE_MODE 0644 +#else +#define FILE_MODE 0666 +#endif + +static int this_port; + +static long bin_start(); +static int bin_init(),bin_stop(),bin_erlang_read(); +static int read_fill(), write_fill(); + +const struct erl_drv_entry bin_driver_entry = { + bin_init, + bin_start, + bin_stop, + bin_erlang_read, + NULL, + NULL, + "binary_filer" +}; + + + +static int bin_init() +{ + this_port = -1; + return 0; +} + + +static long bin_start(port,buf) +int port; +char *buf; +{ + + if (this_port != -1) + return(-1); + this_port = port; + return(port); +} + + +static int bin_stop() +{ + this_port = -1; +} + + +static int bin_erlang_read(port,buf,count) +long port; +char *buf; +int count; + +{ + struct stat statbuf; + int i,size,fd,rval; + char *t,*rbuf; + + buf[count] = '\0'; + switch (*buf) { + case 'c' : + if (chdir(buf+1) == 0) /* sucsess */ + driver_output(this_port,"y",1); + else + driver_output(this_port,"n",1); + return 0; + case 'f': +#ifdef MSDOS + if ((fd = open(buf+1,O_RDONLY|O_BINARY)) < 0) { +#else + if ((fd = open(buf+1,O_RDONLY, 0)) < 0) { +#endif + driver_output(this_port,"n",1); + return 0; + } + if (stat(buf+1,&statbuf) < 0) { + driver_output(this_port,"n",1); + close(fd); + return 0; + } + if (S_ISREG(statbuf.st_mode)) + size = statbuf.st_size; + else + size = BUFSIZ; + + if ((rbuf = (char*) driver_alloc(1 + size)) == NULL) { + fprintf(stderr,"Out of memory\n"); + close(fd); + driver_output(this_port,"n",1); + return 0; + } + if (S_ISREG(statbuf.st_mode)) { + if (read_fill(fd,1+rbuf,size) != size) { + driver_free(rbuf); + close(fd); + driver_output(this_port,"n",1); + return 0;; + } + } + /* The idea here is that if it's a regular file read the entire + * entire file and if it's a device file or a tty try to read + * until errno != EINTR + */ + + else { + while (1) { + rval = read(fd,1+rbuf,size); + if (rval < 0 && errno == EINTR) + continue; + if (rval < 0) { + driver_free(rbuf); + close(fd); + driver_output(this_port,"n",1); + return 0; + } + size = rval; + break; + } + } + rbuf[0] = 'y'; + driver_output(this_port,rbuf,1+size); + driver_free(rbuf); + close(fd); + return 0; + case 'w': +#ifdef MSDOS + if ((fd = open(buf+1, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, + FILE_MODE)) < 0) { +#else + if ((fd = open(buf+1, O_WRONLY | O_CREAT | O_TRUNC, FILE_MODE)) < 0) { +#endif + driver_output(this_port,"n",1); + return 0; + } + t = buf+1; i = 1; + while(*t && i++ < count) t++; + t++; + /* t now points to the contents of what we shall write */ + size = count - 1 - i; + + /* gotta write_fill if we are writing to a slow device + such as /dev/audio */ + + if (write_fill (fd,t,size) != size) { + driver_output(this_port,"n",1); + close(fd); + return 0; + } + driver_output(this_port,"y",1); + close(fd); + return 0; + default: + driver_failure(this_port,-1); + return 0; + } +} + + +static int write_fill(fd, buf, len) +char *buf; +{ + int i, done = 0; + + do { + if ((i = write(fd, buf+done, len-done)) < 0) { + if (errno != EINTR) + return (i); + i = 0; + } + done += i; + } while (done < len); + return (len); +} + + +static int read_fill(fd, buf, len) +char *buf; +{ + int i, got = 0; + + do { + if ((i = read(fd, buf+got, len-got)) <= 0) { + if (i == 0 || errno != EINTR) + return (i); + i = 0; + } + got += i; + } while (got < len); + return (len); +} + diff --git a/erts/emulator/drivers/unix/mem_drv.c b/erts/emulator/drivers/unix/mem_drv.c new file mode 100644 index 0000000000..1417ca1121 --- /dev/null +++ b/erts/emulator/drivers/unix/mem_drv.c @@ -0,0 +1,145 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Purpose: Access to elib memory statistics */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_driver.h" +#include "elib_stat.h" + +#define MAP_BUF_SIZE 1000 /* Max map size */ +#define HISTO_BUF_SIZE 100 /* Max histogram buckets */ + +static ErlDrvData mem_start(ErlDrvPort); +static int mem_init(void); +static void mem_stop(ErlDrvData); +static void mem_command(ErlDrvData, char*, int); + +const struct driver_entry mem_driver_entry = { + mem_init, + mem_start, + mem_stop, + mem_command, + NULL, + NULL, + "mem_drv" +}; + +static int mem_init(void) +{ + return 0; +} + +static ErlDrvData mem_start(ErlDrvPort port, char* buf) +{ + return (ErlDrvData)port; +} + +static void mem_stop(ErlDrvData port) +{ +} + +void putint32(p, v) +byte* p; int v; +{ + p[0] = (v >> 24) & 0xff; + p[1] = (v >> 16) & 0xff; + p[2] = (v >> 8) & 0xff; + p[3] = (v) & 0xff; +} + +int getint16(p) +byte* p; +{ + return (p[0] << 8) | p[1]; +} + +/* +** Command: +** m L1 L0 -> a heap map of length L1*256 + L0 is returned +** s -> X3 X2 X1 X0 Y3 Y2 Y1 Y0 Z3 Z2 Z1 Z0 +** X == Total heap size bytes +** Y == Total free bytes +** Z == Size of largest free block in bytes +** +** h L1 L0 B0 -> Generate a logarithm historgram base B with L buckets +** l L1 L0 S0 -> Generate a linear histogram with step S with L buckets +*/ +unsigned char outbuf[HISTO_BUF_SIZE*2*4]; + +static void mem_command(ErlDrvData port, char* buf, int count) +{ + if ((count == 1) && buf[0] == 's') { + struct elib_stat info; + char v[3*4]; + + elib_stat(&info); + + putint32(v, info.mem_total*4); + putint32(v+4, info.mem_free*4); + putint32(v+8, info.max_free*4); + driver_output((ErlDrvPort)port, v, 12); + return; + } + else if ((count == 3) && buf[0] == 'm') { + char w[MAP_BUF_SIZE]; + int n = getint16(buf+1); + + if (n > MAP_BUF_SIZE) + n = MAP_BUF_SIZE; + elib_heap_map(w, n); + driver_output((ErlDrvPort)port, w, n); + return; + } + else if ((count == 4) && (buf[0] == 'h' || buf[0] == 'l')) { + unsigned long vf[HISTO_BUF_SIZE]; + unsigned long va[HISTO_BUF_SIZE]; + int n = getint16(buf+1); + int base = (unsigned char) buf[3]; + + if (n >= HISTO_BUF_SIZE) + n = HISTO_BUF_SIZE; + if (buf[0] == 'l') + base = -base; + if (elib_histo(vf, va, n, base) < 0) { + driver_failure((ErlDrvPort)port, -1); + return; + } + else { + char* p = outbuf; + int i; + + for (i = 0; i < n; i++) { + putint32(p, vf[i]); + p += 4; + } + for (i = 0; i < n; i++) { + putint32(p, va[i]); + p += 4; + } + driver_output((ErlDrvPort)port, outbuf, n*8); + } + return; + } + driver_failure((ErlDrvPort)port, -1); +} diff --git a/erts/emulator/drivers/unix/multi_drv.c b/erts/emulator/drivers/unix/multi_drv.c new file mode 100644 index 0000000000..822c96730c --- /dev/null +++ b/erts/emulator/drivers/unix/multi_drv.c @@ -0,0 +1,105 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Purpose: Multidriver interface + This is an example of a driver which allows multiple instances of itself. + I.e have one erlang process execute open_port(multi......) and + at the same time have an other erlang process open an other port + running multi there as well. +*/ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_driver.h" +#include "sys.h" +#include +#include +#include + +#define MAXCHANNEL 20 + +static char buf[BUFSIZ]; + +static ErlDrvData multi_start(ErlDrvPort, char*); +static int multi_init(void); +static void multi_stop(ErlDrvData),multi_erlang_read(ErlDrvData, char*, int); + +struct driver_entry multi_driver_entry = { + multi_init, + multi_start, + multi_stop, + multi_erlang_read, + NULL, + NULL, + "multi" +}; + + +struct channel { + ErlDrvPort portno; + int channel; +}; + +struct channel channels[MAXCHANNEL]; /* Max MAXCHANNEL instances */ + +static int multi_init(void) +{ + memzero(channels,MAXCHANNEL * sizeof(struct channel)); + return 0; +} + +static ErlDrvData multi_start(ErlDrvPort port, char* buf) +{ + int chan; + chan = get_new_channel(); + channels[port].portno = port; + channels[port].channel = chan; + fprintf(stderr,"Opening channel %d port is %d\n",chan,port); + return (ErlDrvData)port; +} + + +static int multi_stop(ErlDrvData port) +{ + fprintf(stderr,"Closing channel %d\n",channels[port].channel); + remove_channel(channels[(int)port].channel); +} + + +static int multi_erlang_read(ErlDrvData port, char* buf, int count) +{ + fprintf(stderr,"Writing %d bytes to channel %d\n", + count, + channels[(int)port].channel); +} + + +/* These two funs are fake */ + +int get_new_channel() +{ + static int ch = 1; + return(ch++); +} + +void remove_channel(int ch) +{ +} diff --git a/erts/emulator/drivers/unix/sig_drv.c b/erts/emulator/drivers/unix/sig_drv.c new file mode 100644 index 0000000000..aab5d63a40 --- /dev/null +++ b/erts/emulator/drivers/unix/sig_drv.c @@ -0,0 +1,81 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Purpose: demonstrate how to include interupt handlers in erlang */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_driver.h" +#include +#include + +static ErlDrvData sig_start(ErlDrvPort, char*); +static int sig_init(void); +static void sig_stop(ErlDrvData), doio(ErlDrvData, ErlDrvEvent); + +ErlDrvEntry sig_driver_entry = { + sig_init, + sig_start, + sig_stop, + NULL, + doio, + NULL, + "sig_test" +}; + +static ErlDrvPort this_port; + +static int sig_init(void) +{ + this_port = (ErlDrvPort)-1; + return 0; +} + +static sigc(int ino) +{ + driver_interrupt(this_port, ino); +} + +static ErlDrvData sig_start(ErlDrvPort port, char* buf) +{ + if (this_port != (ErlDrvPort)-1) + return ERL_DRV_ERROR_GENERAL; + this_port = port; + signal(SIGUSR1, sigc); + return (ErlDrvData)port; +} + +static void sig_stop(ErlDrvData port) +{ + this_port = (ErlDrvPort)-1; + signal(SIGUSR1, SIG_DFL); +} + +doio(ErlDrvData port, ErlDrvEvent ino) +{ + /* First go get the io, unless we already did that */ + /* In the sighandler */ + + /* Then send it to erlang */ + + driver_output(this_port, "y", 1); +} diff --git a/erts/emulator/drivers/unix/ttsl_drv.c b/erts/emulator/drivers/unix/ttsl_drv.c new file mode 100644 index 0000000000..4c2514669b --- /dev/null +++ b/erts/emulator/drivers/unix/ttsl_drv.c @@ -0,0 +1,1299 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Tty driver that reads one character at the time and provides a + * smart line for output. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "erl_driver.h" + +static int ttysl_init(void); +static ErlDrvData ttysl_start(ErlDrvPort, char*); + +#ifdef HAVE_TERMCAP /* else make an empty driver that can not be opened */ + +#include "sys.h" +#include +#include +#include +#include +#include +#include +#include +#include +#include +#ifdef HAVE_FCNTL_H +#include +#endif +#ifdef HAVE_SYS_IOCTL_H +#include +#endif +#if !defined(HAVE_SETLOCALE) || !defined(HAVE_NL_LANGINFO) || !defined(HAVE_LANGINFO_H) +#define PRIMITIVE_UTF8_CHECK 1 +#else +#include +#endif + +#define TRUE 1 +#define FALSE 0 + +/* Termcap functions. */ +int tgetent(char* bp, char *name); +int tgetnum(char* cap); +int tgetflag(char* cap); +char *tgetstr(char* cap, char** buf); +char *tgoto(char* cm, int col, int line); +int tputs(char* cp, int affcnt, int (*outc)(int c)); + +/* Terminal capabilites in which we are interested. */ +static char *capbuf; +static char *up, *down, *left, *right; +static int cols, xn; +static volatile int cols_needs_update = FALSE; + +/* The various opcodes. */ +#define OP_PUTC 0 +#define OP_MOVE 1 +#define OP_INSC 2 +#define OP_DELC 3 +#define OP_BEEP 4 +/* Control op */ +#define CTRL_OP_GET_WINSIZE 100 +#define CTRL_OP_GET_UNICODE_STATE 101 +#define CTRL_OP_SET_UNICODE_STATE 102 + + + +static int lbuf_size = BUFSIZ; +static Uint32 *lbuf; /* The current line buffer */ +static int llen; /* The current line length */ +static int lpos; /* The current "cursor position" in the line buffer */ + +/* + * Tags used in line buffer to show that these bytes represent special characters, + * Max unicode is 0x0010ffff, so we have lots of place for meta tags... + */ +#define CONTROL_TAG 0x10000000U /* Control character, value in first position */ +#define ESCAPED_TAG 0x01000000U /* Escaped character, value in first position */ +#define TAG_MASK 0xFF000000U + +#define MAXSIZE (1 << 16) + +#define COL(_l) ((_l) % cols) +#define LINE(_l) ((_l) / cols) + +#define NL '\n' + +/* Main interface functions. */ +static void ttysl_stop(ErlDrvData); +static void ttysl_from_erlang(ErlDrvData, char*, int); +static void ttysl_from_tty(ErlDrvData, ErlDrvEvent); +static void ttysl_stop_select(ErlDrvEvent, void*); +static Sint16 get_sint16(char*); + +static ErlDrvPort ttysl_port; +static int ttysl_fd; +static FILE *ttysl_out; + +/* Functions that work on the line buffer. */ +static int start_lbuf(void); +static int stop_lbuf(void); +static int put_chars(byte*,int); +static int move_rel(int); +static int ins_chars(byte *,int); +static int del_chars(int); +static int step_over_chars(int); +static int insert_buf(byte*,int); +static int write_buf(Uint32 *,int); +static int outc(int c); +static int move_cursor(int,int); + +/* Termcap functions. */ +static int start_termcap(void); +static int stop_termcap(void); +static int move_left(int); +static int move_right(int); +static int move_up(int); +static int move_down(int); +static void update_cols(void); + +/* Terminal setting functions. */ +static int tty_init(int,int,int,int); +static int tty_set(int); +static int tty_reset(int); +static int ttysl_control(ErlDrvData, unsigned int, char *, int, char **, int); +static RETSIGTYPE suspend(int); +static RETSIGTYPE cont(int); +static RETSIGTYPE winch(int); + +/*#define LOG_DEBUG*/ + +#ifdef LOG_DEBUG +FILE *debuglog = NULL; + +#define DEBUGLOG(X) \ +do { \ + if (debuglog != NULL) { \ + my_debug_printf X; \ + } \ +} while (0) + +static void my_debug_printf(char *fmt, ...) +{ + char buffer[1024]; + va_list args; + + va_start(args, fmt); + erts_vsnprintf(buffer,1024,fmt,args); + va_end(args); + erts_fprintf(debuglog,"%s\n",buffer); + //erts_printf("Debuglog = %s\n",buffer); +} + +#else + +#define DEBUGLOG(X) + +#endif + +static int utf8_mode = 0; +static byte utf8buf[4]; /* for incomplete input */ +static int utf8buf_size; /* size of incomplete input */ + +# define IF_IMPL(x) x +#else +# define IF_IMPL(x) NULL +#endif /* HAVE_TERMCAP */ + +/* Define the driver table entry. */ +struct erl_drv_entry ttsl_driver_entry = { + ttysl_init, + ttysl_start, + IF_IMPL(ttysl_stop), + IF_IMPL(ttysl_from_erlang), + IF_IMPL(ttysl_from_tty), + NULL, + "tty_sl", + NULL, + NULL, + IF_IMPL(ttysl_control), + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, + NULL, /* process_exit */ + IF_IMPL(ttysl_stop_select) +}; + + +static int ttysl_init(void) +{ +#ifdef HAVE_TERMCAP + ttysl_port = (ErlDrvPort)-1; + ttysl_fd = -1; + lbuf = NULL; /* For line buffer handling */ + capbuf = NULL; /* For termcap handling */ +#endif +#ifdef LOG_DEBUG + { + char *dl; + if ((dl = getenv("TTYSL_DEBUG_LOG")) != NULL && *dl) { + debuglog = fopen(dl,"w+"); + if (debuglog != NULL) + setbuf(debuglog,NULL); + } + DEBUGLOG(("Debuglog = %s(0x%ld)\n",dl,(long) debuglog)); + } +#endif + return 0; +} + +static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) +{ +#ifndef HAVE_TERMCAP + return ERL_DRV_ERROR_GENERAL; +#else + char *s, *t, c, *l; + int canon, echo, sig; /* Terminal characteristics */ + int flag; + extern int using_oldshell; /* set this to let the rest of erts know */ + + utf8buf_size = 0; + if (ttysl_port != (ErlDrvPort)-1) + return ERL_DRV_ERROR_GENERAL; + + if (!isatty(0) || !isatty(1)) + return ERL_DRV_ERROR_GENERAL; + + /* Set the terminal modes to default leave as is. */ + canon = echo = sig = 0; + + /* Parse the input parameters. */ + for (s = strchr(buf, ' '); s; s = t) { + s++; + /* Find end of this argument (start of next) and insert NUL. */ + if ((t = strchr(s, ' '))) { + c = *t; + *t = '\0'; + } + if ((flag = ((*s == '+') ? 1 : ((*s == '-') ? -1 : 0)))) { + if (s[1] == 'c') canon = flag; + if (s[1] == 'e') echo = flag; + if (s[1] == 's') sig = flag; + } + else if ((ttysl_fd = open(s, O_RDWR, 0)) < 0) + return ERL_DRV_ERROR_GENERAL; + } + if (ttysl_fd < 0) + ttysl_fd = 0; + + if (tty_init(ttysl_fd, canon, echo, sig) < 0 || + tty_set(ttysl_fd) < 0) { + ttysl_port = (ErlDrvPort)-1; + tty_reset(ttysl_fd); + return ERL_DRV_ERROR_GENERAL; + } + + /* Set up smart line and termcap stuff. */ + if (!start_lbuf() || !start_termcap()) { + stop_lbuf(); /* Must free this */ + tty_reset(ttysl_fd); + return ERL_DRV_ERROR_GENERAL; + } + + /* Open the terminal and set the terminal */ + ttysl_out = fdopen(ttysl_fd, "w"); + +#ifdef PRIMITIVE_UTF8_CHECK + setlocale(LC_CTYPE, ""); /* Set international environment, + ignore result */ + if (((l = getenv("LC_ALL")) && *l) || + ((l = getenv("LC_CTYPE")) && *l) || + ((l = getenv("LANG")) && *l)) { + if (strstr(l, "UTF-8")) + utf8_mode = 1; + } + +#else + l = setlocale(LC_CTYPE, ""); /* Set international environment */ + if (l != NULL) { + utf8_mode = (strcmp(nl_langinfo(CODESET), "UTF-8") == 0); + DEBUGLOG(("setlocale: %s\n",l)); + } +#endif + DEBUGLOG(("utf8_mode is %s\n",(utf8_mode) ? "on" : "off")); + sys_sigset(SIGCONT, cont); + sys_sigset(SIGWINCH, winch); + + driver_select(port, (ErlDrvEvent)(Uint)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 1); + ttysl_port = port; + + /* we need to know this when we enter the break handler */ + using_oldshell = 0; + + return (ErlDrvData)ttysl_port; /* Nothing important to return */ +#endif /* HAVE_TERMCAP */ +} + +#ifdef HAVE_TERMCAP + +#define DEF_HEIGHT 24 +#define DEF_WIDTH 80 +static void ttysl_get_window_size(Uint32 *width, Uint32 *height) +{ +#ifdef TIOCGWINSZ + struct winsize ws; + if (ioctl(ttysl_fd,TIOCGWINSZ,&ws) == 0) { + *width = (Uint32) ws.ws_col; + *height = (Uint32) ws.ws_row; + if (*width <= 0) + *width = DEF_WIDTH; + if (*height <= 0) + *height = DEF_HEIGHT; + return; + } +#endif + *width = DEF_WIDTH; + *height = DEF_HEIGHT; +} + +static int ttysl_control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + char resbuff[2*sizeof(Uint32)]; + int res_size; + switch (command) { + case CTRL_OP_GET_WINSIZE: + { + Uint32 w,h; + ttysl_get_window_size(&w,&h); + memcpy(resbuff,&w,sizeof(Uint32)); + memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32)); + res_size = 2*sizeof(Uint32); + } + break; + case CTRL_OP_GET_UNICODE_STATE: + *resbuff = (utf8_mode) ? 1 : 0; + res_size = 1; + break; + case CTRL_OP_SET_UNICODE_STATE: + if (len > 0) { + int m = (int) *buf; + *resbuff = (utf8_mode) ? 1 : 0; + res_size = 1; + utf8_mode = (m) ? 1 : 0; + } else { + return 0; + } + break; + default: + return 0; + } + if (rlen < res_size) { + *rbuf = driver_alloc(res_size); + } + memcpy(*rbuf,resbuff,res_size); + return res_size; +} + + +static void ttysl_stop(ErlDrvData ttysl_data) +{ + if (ttysl_port != (ErlDrvPort)-1) { + stop_lbuf(); + stop_termcap(); + tty_reset(ttysl_fd); + driver_select(ttysl_port, (ErlDrvEvent)(Uint)ttysl_fd, ERL_DRV_READ|ERL_DRV_USE, 0); + sys_sigset(SIGCONT, SIG_DFL); + sys_sigset(SIGWINCH, SIG_DFL); + } + ttysl_port = (ErlDrvPort)-1; + ttysl_fd = -1; + /* return TRUE; */ +} + +static int put_utf8(int ch, byte *target, int sz, int *pos) +{ + Uint x = (Uint) ch; + if (x < 0x80) { + if (*pos >= sz) { + return -1; + } + target[(*pos)++] = (byte) x; + } + else if (x < 0x800) { + if (((*pos) + 1) >= sz) { + return -1; + } + target[(*pos)++] = (((byte) (x >> 6)) | + ((byte) 0xC0)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else if (x < 0x10000) { + if ((x >= 0xD800 && x <= 0xDFFF) || + (x == 0xFFFE) || + (x == 0xFFFF)) { /* Invalid unicode range */ + return -1; + } + if (((*pos) + 2) >= sz) { + return -1; + } + + target[(*pos)++] = (((byte) (x >> 12)) | + ((byte) 0xE0)); + target[(*pos)++] = ((((byte) (x >> 6)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else if (x < 0x110000) { /* Standard imposed max */ + if (((*pos) + 3) >= sz) { + return -1; + } + target[(*pos)++] = (((byte) (x >> 18)) | + ((byte) 0xF0)); + target[(*pos)++] = ((((byte) (x >> 12)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = ((((byte) (x >> 6)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else { + return -1; + } + return 0; +} + + +static int pick_utf8(byte *s, int sz, int *pos) +{ + int size = sz - (*pos); + byte *source; + Uint unipoint; + + if (size > 0) { + source = s + (*pos); + if (((*source) & ((byte) 0x80)) == 0) { + unipoint = (int) *source; + ++(*pos); + return (int) unipoint; + } else if (((*source) & ((byte) 0xE0)) == 0xC0) { + if (size < 2) { + return -2; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((*source) < 0xC2) /* overlong */) { + return -1; + } + (*pos) += 2; + unipoint = + (((Uint) ((*source) & ((byte) 0x1F))) << 6) | + ((Uint) (source[1] & ((byte) 0x3F))); + return (int) unipoint; + } else if (((*source) & ((byte) 0xF0)) == 0xE0) { + if (size < 3) { + return -2; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((source[2] & ((byte) 0xC0)) != 0x80) || + (((*source) == 0xE0) && (source[1] < 0xA0)) /* overlong */ ) { + return -1; + } + if ((((*source) & ((byte) 0xF)) == 0xD) && + ((source[1] & 0x20) != 0)) { + return -1; + } + if (((*source) == 0xEF) && (source[1] == 0xBF) && + ((source[2] == 0xBE) || (source[2] == 0xBF))) { + return -1; + } + (*pos) += 3; + unipoint = + (((Uint) ((*source) & ((byte) 0xF))) << 12) | + (((Uint) (source[1] & ((byte) 0x3F))) << 6) | + ((Uint) (source[2] & ((byte) 0x3F))); + return (int) unipoint; + } else if (((*source) & ((byte) 0xF8)) == 0xF0) { + if (size < 4) { + return -2 ; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((source[2] & ((byte) 0xC0)) != 0x80) || + ((source[3] & ((byte) 0xC0)) != 0x80) || + (((*source) == 0xF0) && (source[1] < 0x90)) /* overlong */) { + return -1; + } + if ((((*source) & ((byte)0x7)) > 0x4U) || + ((((*source) & ((byte)0x7)) == 0x4U) && + ((source[1] & ((byte)0x3F)) > 0xFU))) { + return -1; + } + (*pos) += 4; + unipoint = + (((Uint) ((*source) & ((byte) 0x7))) << 18) | + (((Uint) (source[1] & ((byte) 0x3F))) << 12) | + (((Uint) (source[2] & ((byte) 0x3F))) << 6) | + ((Uint) (source[3] & ((byte) 0x3F))); + return (int) unipoint; + } else { + return -1; + } + } else { + return -1; + } +} + +static int octal_or_hex_positions(Uint c) +{ + int x = 0; + Uint ch = c; + if (!ch) { + return 1; + } + while(ch) { + ++x; + ch >>= 3; + } + if (x <= 3) { + return 3; + } + /* \x{H ...} format when larger than \777 */ + x = 0; + ch = c; + while(ch) { + ++x; + ch >>= 4; + } + return x+3; +} + +static void octal_or_hex_format(Uint ch, byte *buf, int *pos) +{ + static byte hex_chars[] = { '0','1','2','3','4','5','6','7','8','9', + 'A','B','C','D','E','F'}; + int num = octal_or_hex_positions(ch); + if (num != 3) { + buf[(*pos)++] = 'x'; + buf[(*pos)++] = '{'; + num -= 3; + while(num--) { + buf[(*pos)++] = hex_chars[((ch >> (4*num)) & 0xFU)]; + } + buf[(*pos)++] = '}'; + } else { + while(num--) { + buf[(*pos)++] = ((byte) ((ch >> (3*num)) & 0x7U) + '0'); + } + } +} + +/* + * Check that there is enough room in all buffers to copy all pad chars + * and stiff we need If not, realloc lbuf. + */ +static int check_buf_size(byte *s, int n) +{ + int pos = 0; + int ch; + int size = 10; + + while(pos < n) { + /* Indata is always UTF-8 */ + if ((ch = pick_utf8(s,n,&pos)) < 0) { + /* XXX temporary allow invalid chars */ + ch = (int) s[pos]; + DEBUGLOG(("Invalid UTF8:%d",ch)); + ++pos; + } + if (utf8_mode) { /* That is, terminal is UTF8 compliant */ + if (ch >= 128 || isprint(ch)) { + DEBUGLOG(("Printable(UTF-8:%d):%d",(pos - opos),ch)); + size++; /* Buffer contains wide characters... */ + } else if (ch == '\t') { + size += 8; + } else { + DEBUGLOG(("Magic(UTF-8:%d):%d",(pos - opos),ch)); + size += 2; + } + } else { + if (ch <= 255 && isprint(ch)) { + DEBUGLOG(("Printable:%d",ch)); + size++; + } else if (ch == '\t') + size += 8; + else if (ch >= 128) { + DEBUGLOG(("Non printable:%d",ch)); + size += (octal_or_hex_positions(ch) + 1); + } + else { + DEBUGLOG(("Magic:%d",ch)); + size += 2; + } + } + } + + if (size + lpos >= lbuf_size) { + + lbuf_size = size + lpos + BUFSIZ; + if ((lbuf = driver_realloc(lbuf, lbuf_size * sizeof(Uint32))) == NULL) { + driver_failure(ttysl_port, -1); + return(0); + } + } + return(1); +} + + +static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, int count) +{ + if (lpos > MAXSIZE) + put_chars((byte*)"\n", 1); + + switch (buf[0]) { + case OP_PUTC: + DEBUGLOG(("OP: Putc(%d)",count-1)); + if (check_buf_size((byte*)buf+1, count-1) == 0) + return; + put_chars((byte*)buf+1, count-1); + break; + case OP_MOVE: + move_rel(get_sint16(buf+1)); + break; + case OP_INSC: + if (check_buf_size((byte*)buf+1, count-1) == 0) + return; + ins_chars((byte*)buf+1, count-1); + break; + case OP_DELC: + del_chars(get_sint16(buf+1)); + break; + case OP_BEEP: + outc('\007'); + break; + default: + /* Unknown op, just ignore. */ + break; + } + fflush(ttysl_out); + return; /* TRUE; */ +} + +static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) +{ + byte b[1024]; + ssize_t i; + int ch = 0, pos = 0; + int left = 1024; + byte *p = b; + byte t[1024]; + int tpos; + + if (utf8buf_size > 0) { + memcpy(b,utf8buf,utf8buf_size); + left -= utf8buf_size; + p += utf8buf_size; + utf8buf_size = 0; + } + + if ((i = read((int)(Sint)fd, (char *) p, left)) >= 0) { + if (p != b) { + i += (p - b); + } + if (utf8_mode) { /* Hopefully an UTF8 terminal */ + while(pos < i && (ch = pick_utf8(b,i,&pos)) >= 0) + ; + if (ch == -2 && i - pos <= 4) { + /* bytes left to care for */ + utf8buf_size = i -pos; + memcpy(utf8buf,b+pos,utf8buf_size); + } else if (ch == -1) { + DEBUGLOG(("Giving up on UTF8 mode, invalid character")); + utf8_mode = 0; + goto latin_terminal; + } + driver_output(ttysl_port, (char *) b, pos); + } else { + latin_terminal: + tpos = 0; + while (pos < i) { + while (tpos < 1020 && pos < i) { /* Max 4 bytes for UTF8 */ + put_utf8((int) b[pos++], t, 1024, &tpos); + } + driver_output(ttysl_port, (char *) t, tpos); + tpos = 0; + } + } + } else { + driver_failure(ttysl_port, -1); + } +} + +static void ttysl_stop_select(ErlDrvEvent e, void* _) +{ + int fd = (int)(long)e; + if (fd != 0) { + close(fd); + } +} + +/* Procedures for putting and getting integers to/from strings. */ +static Sint16 get_sint16(char *s) +{ + return ((*s << 8) | ((byte*)s)[1]); +} + +static int start_lbuf(void) +{ + if (!lbuf && !(lbuf = ( Uint32*) driver_alloc(lbuf_size * sizeof(Uint32)))) + return FALSE; + llen = 0; + lpos = 0; + return TRUE; +} + +static int stop_lbuf(void) +{ + if (lbuf) { + driver_free(lbuf); + lbuf = NULL; + } + return TRUE; +} + +/* Put l bytes (in UTF8) from s into the buffer and output them. */ +static int put_chars(byte *s, int l) +{ + int n; + + n = insert_buf(s, l); + if (n > 0) + write_buf(lbuf + lpos - n, n); + if (lpos > llen) + llen = lpos; + return TRUE; +} + +/* + * Move the current postition forwards or backwards within the current + * line. We know about padding. + */ +static int move_rel(int n) +{ + int npos; /* The new position */ + + /* Step forwards or backwards over the buffer. */ + npos = step_over_chars(n); + + /* Calculate move, updates pointers and move the cursor. */ + move_cursor(lpos, npos); + lpos = npos; + return TRUE; +} + +/* Insert characters into the buffer at the current position. */ +static int ins_chars(byte *s, int l) +{ + int n, tl; + Uint32 *tbuf = NULL; /* Suppress warning about use-before-set */ + + /* Move tail of buffer to make space. */ + if ((tl = llen - lpos) > 0) { + if ((tbuf = driver_alloc(tl * sizeof(Uint32))) == NULL) + return FALSE; + memcpy(tbuf, lbuf + lpos, tl * sizeof(Uint32)); + } + n = insert_buf(s, l); + if (tl > 0) { + memcpy(lbuf + lpos, tbuf, tl * sizeof(Uint32)); + driver_free(tbuf); + } + llen += n; + write_buf(lbuf + (lpos - n), llen - (lpos - n)); + move_cursor(llen, lpos); + return TRUE; +} + +/* + * Delete characters in the buffer. Can delete characters before (n < 0) + * and after (n > 0) the current position. Cursor left at beginning of + * deleted block. + */ +static int del_chars(int n) +{ + int i, l, r; + int pos; + + update_cols(); + + /* Step forward or backwards over n logical characters. */ + pos = step_over_chars(n); + + if (pos > lpos) { + l = pos - lpos; /* Buffer characters to delete */ + r = llen - lpos - l; /* Characters after deleted */ + /* Fix up buffer and buffer pointers. */ + if (r > 0) + memcpy(lbuf + lpos, lbuf + pos, r * sizeof(Uint32)); + llen -= l; + /* Write out characters after, blank the tail and jump back to lpos. */ + write_buf(lbuf + lpos, r); + for (i = l ; i > 0; --i) + outc(' '); + if (COL(llen+l) == 0 && xn) + { + outc(' '); + move_left(1); + } + move_cursor(llen + l, lpos); + } + else if (pos < lpos) { + l = lpos - pos; /* Buffer characters */ + r = llen - lpos; /* Characters after deleted */ + move_cursor(lpos, lpos-l); /* Move back */ + /* Fix up buffer and buffer pointers. */ + if (r > 0) + memcpy(lbuf + pos, lbuf + lpos, r * sizeof(Uint32)); + lpos -= l; + llen -= l; + /* Write out characters after, blank the tail and jump back to lpos. */ + write_buf(lbuf + lpos, r); + for (i = l ; i > 0; --i) + outc(' '); + if (COL(llen+l) == 0 && xn) + { + outc(' '); + move_left(1); + } + move_cursor(llen + l, lpos); + } + return TRUE; +} + +/* Step over n logical characters, check for overflow. */ +static int step_over_chars(int n) +{ + Uint32 *c, *beg, *end; + + beg = lbuf; + end = lbuf + llen; + c = lbuf + lpos; + for ( ; n > 0 && c < end; --n) { + c++; + while (c < end && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0)) + c++; + } + for ( ; n < 0 && c > beg; n++) { + --c; + while (c > beg && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0)) + --c; + } + return c - lbuf; +} + +/* + * Insert n characters into the buffer at lpos. + * Know about pad characters and treat \n specially. + */ + +static int insert_buf(byte *s, int n) +{ + int pos = 0; + int buffpos = lpos; + int ch; + + while (pos < n) { + if ((ch = pick_utf8(s,n,&pos)) < 0) { + /* XXX temporary allow invalid chars */ + ch = (int) s[pos]; + DEBUGLOG(("insert_buf: Invalid UTF8:%d",ch)); + ++pos; + } + if ((utf8_mode && (ch >= 128 || isprint(ch))) || (ch <= 255 && isprint(ch))) { + DEBUGLOG(("insert_buf: Printable(UTF-8):%d",ch)); + lbuf[lpos++] = (Uint32) ch; + } else if (ch >= 128) { /* not utf8 mode */ + int nc = octal_or_hex_positions(ch); + lbuf[lpos++] = ((Uint32) ch) | ESCAPED_TAG; + while (nc--) { + lbuf[lpos++] = ESCAPED_TAG; + } + } else if (ch == '\t') { + do { + lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch)); + ch = 0; + } while (lpos % 8); + } else if (ch == '\n' || ch == '\r') { + write_buf(lbuf + buffpos, lpos - buffpos); + outc('\r'); + if (ch == '\n') + outc('\n'); + if (llen > lpos) { + memcpy(lbuf, lbuf + lpos, llen - lpos); + } + llen -= lpos; + lpos = buffpos = 0; + } else { + DEBUGLOG(("insert_buf: Magic(UTF-8):%d",ch)); + lbuf[lpos++] = ch | CONTROL_TAG; + lbuf[lpos++] = CONTROL_TAG; + } + } + return lpos - buffpos; /* characters "written" into + current buffer (may be less due to newline) */ +} + + + +/* + * Write n characters in line buffer starting at s. Be smart about + * non-printables. Know about pad characters and that \n can never + * occur normally. + */ + +static int write_buf(Uint32 *s, int n) +{ + byte ubuf[4]; + int ubytes = 0, i; + byte lastput = ' '; + + update_cols(); + + while (n > 0) { + if (!(*s & TAG_MASK) ) { + if (utf8_mode) { + ubytes = 0; + if (put_utf8((int) *s, ubuf, 4, &ubytes) == 0) { + for (i = 0; i < ubytes; ++i) { + outc(ubuf[i]); + } + lastput = 0; /* Means the last written character was multibyte UTF8 */ + } + } else { + outc((byte) *s); + lastput = (byte) *s; + } + --n; + ++s; + } + else if (*s == (CONTROL_TAG | ((Uint32) '\t'))) { + outc(lastput = ' '); + --n; s++; + while (n > 0 && *s == CONTROL_TAG) { + outc(lastput = ' '); + --n; s++; + } + } else if (*s & CONTROL_TAG) { + outc('^'); + outc(lastput = ((byte) ((*s == 0177) ? '?' : *s | 0x40))); + n -= 2; + s += 2; + } else if (*s & ESCAPED_TAG) { + Uint32 ch = *s & ~(TAG_MASK); + byte *octbuff; + byte octtmp[256]; + int octbytes; + DEBUGLOG(("Escaped: %d", ch)); + octbytes = octal_or_hex_positions(ch); + if (octbytes > 256) { + octbuff = driver_alloc(octbytes); + } else { + octbuff = octtmp; + } + octbytes = 0; + octal_or_hex_format(ch, octbuff, &octbytes); + DEBUGLOG(("octbytes: %d", octbytes)); + outc('\\'); + for (i = 0; i < octbytes; ++i) { + outc(lastput = octbuff[i]); + DEBUGLOG(("outc: %d", (int) lastput)); + } + n -= octbytes+1; + s += octbytes+1; + if (octbuff != octtmp) { + driver_free(octbuff); + } + } else { + DEBUGLOG(("Very unexpected character %d",(int) *s)); + ++n; + --s; + } + } + /* Check landed in first column of new line and have 'xn' bug. */ + n = s - lbuf; + if (COL(n) == 0 && xn && n != 0) { + if (n >= llen) { + outc(' '); + } else if (lastput == 0) { /* A multibyte UTF8 character */ + for (i = 0; i < ubytes; ++i) { + outc(ubuf[i]); + } + } else { + outc(lastput); + } + move_left(1); + } + return TRUE; +} + + +/* The basic procedure for outputting one character. */ +static int outc(int c) +{ + return (int)putc(c, ttysl_out); +} + +static int move_cursor(int from, int to) +{ + int dc, dl; + + update_cols(); + + dc = COL(to) - COL(from); + dl = LINE(to) - LINE(from); + if (dl > 0) + move_down(dl); + else if (dl < 0) + move_up(-dl); + if (dc > 0) + move_right(dc); + else if (dc < 0) + move_left(-dc); + return TRUE; +} + +static int start_termcap(void) +{ + int eres; + size_t envsz = 1024; + char *env = NULL; + char *c; + + capbuf = driver_alloc(1024); + if (!capbuf) + goto false; + eres = erl_drv_getenv("TERM", capbuf, &envsz); + if (eres == 0) + env = capbuf; + else if (eres < 0) + goto false; + else /* if (eres > 1) */ { + char *envbuf = driver_alloc(envsz); + if (!envbuf) + goto false; + while (1) { + char *newenvbuf; + eres = erl_drv_getenv("TERM", envbuf, &envsz); + if (eres == 0) + break; + newenvbuf = driver_realloc(envbuf, envsz); + if (eres < 0 || !newenvbuf) { + env = newenvbuf ? newenvbuf : envbuf; + goto false; + } + envbuf = newenvbuf; + } + env = envbuf; + } + if (tgetent((char*)lbuf, env) <= 0) + goto false; + if (env != capbuf) { + env = NULL; + driver_free(env); + } + c = capbuf; + cols = tgetnum("co"); + if (cols <= 0) + cols = DEF_WIDTH; + xn = tgetflag("xn"); + up = tgetstr("up", &c); + if (!(down = tgetstr("do", &c))) + down = "\n"; + if (!(left = tgetflag("bs") ? "\b" : tgetstr("bc", &c))) + left = "\b"; /* Can't happen - but does on Solaris 2 */ + right = tgetstr("nd", &c); + if (up && down && left && right) + return TRUE; + false: + if (env && env != capbuf) + driver_free(env); + if (capbuf) + driver_free(capbuf); + capbuf = NULL; + return FALSE; +} + +static int stop_termcap(void) +{ + if (capbuf) driver_free(capbuf); + capbuf = NULL; + return TRUE; +} + +static int move_left(int n) +{ + while (n-- > 0) + tputs(left, 1, outc); + return TRUE; +} + +static int move_right(int n) +{ + while (n-- > 0) + tputs(right, 1, outc); + return TRUE; +} + +static int move_up(int n) +{ + while (n-- > 0) + tputs(up, 1, outc); + return TRUE; +} + +static int move_down(int n) +{ + while (n-- > 0) + tputs(down, 1, outc); + return TRUE; +} + + +/* + * Updates cols if terminal has resized (SIGWINCH). Should be called + * at the start of any function that uses the COL or LINE macros. If + * the terminal is resized after calling this function but before use + * of the macros, then we may write to the wrong screen location. + * + * We cannot call this from the SIGWINCH handler because it uses + * ioctl() which is not a safe function as listed in the signal(7) + * man page. + */ +static void update_cols(void) +{ + Uint32 width, height; + + if (cols_needs_update) { + cols_needs_update = FALSE; + ttysl_get_window_size(&width, &height); + cols = width; + } +} + + +/* + * Put a terminal device into non-canonical mode with ECHO off. + * Before doing so we first save the terminal's current mode, + * assuming the caller will call the tty_reset() function + * (also in this file) when it's done with raw mode. + */ + +static struct termios tty_smode, tty_rmode; + +static int tty_init(int fd, int canon, int echo, int sig) +{ + if (tcgetattr(fd, &tty_rmode) < 0) + return -1; + tty_smode = tty_rmode; + + /* Default characteristics for all usage including termcap output. */ + tty_smode.c_iflag &= ~ISTRIP; + + /* Turn canonical (line mode) on off. */ + if (canon > 0) { + tty_smode.c_iflag |= ICRNL; + tty_smode.c_lflag |= ICANON; + tty_smode.c_oflag |= OPOST; + tty_smode.c_cc[VEOF] = tty_rmode.c_cc[VEOF]; +#ifdef VDSUSP + tty_smode.c_cc[VDSUSP] = tty_rmode.c_cc[VDSUSP]; +#endif + } + if (canon < 0) { + tty_smode.c_iflag &= ~ICRNL; + tty_smode.c_lflag &= ~ICANON; + tty_smode.c_oflag &= ~OPOST; + /* Must get these really right or funny effects can occur. */ + tty_smode.c_cc[VMIN] = 1; + tty_smode.c_cc[VTIME] = 0; +#ifdef VDSUSP + tty_smode.c_cc[VDSUSP] = 0; +#endif + } + + /* Turn echo on or off. */ + if (echo > 0) + tty_smode.c_lflag |= ECHO; + if (echo < 0) + tty_smode.c_lflag &= ~ECHO; + + /* Set extra characteristics for "RAW" mode, no signals. */ + if (sig > 0) { + /* Ignore IMAXBEL as not POSIX. */ +#ifndef QNX + tty_smode.c_iflag |= (BRKINT|IGNPAR|ICRNL|IXON|IXANY); +#else + tty_smode.c_iflag |= (BRKINT|IGNPAR|ICRNL|IXON); +#endif + tty_smode.c_lflag |= (ISIG|IEXTEN); + } + if (sig < 0) { + /* Ignore IMAXBEL as not POSIX. */ +#ifndef QNX + tty_smode.c_iflag &= ~(BRKINT|IGNPAR|ICRNL|IXON|IXANY); +#else + tty_smode.c_iflag &= ~(BRKINT|IGNPAR|ICRNL|IXON); +#endif + tty_smode.c_lflag &= ~(ISIG|IEXTEN); + } + return 0; +} + +/* + * Set/restore a terminal's mode to whatever it was on the most + * recent call to the tty_init() function above. + */ + +static int tty_set(int fd) +{ + DEBUGF(("Setting tty...\n")); + + if (tcsetattr(fd, TCSANOW, &tty_smode) < 0) + return(-1); + return(0); +} + +static int tty_reset(int fd) /* of terminal device */ +{ + DEBUGF(("Resetting tty...\n")); + + if (tcsetattr(fd, TCSANOW, &tty_rmode) < 0) + return(-1); + + return(0); +} + +/* + * Signal handler to cope with signals so that we can reset the tty + * to the orignal settings + */ + +static RETSIGTYPE suspend(int sig) +{ + if (tty_reset(ttysl_fd) < 0) { + fprintf(stderr,"Can't reset tty \n"); + exit(1); + } + + sys_sigset(sig, SIG_DFL); /* Set signal handler to default */ + sys_sigrelease(sig); /* Allow 'sig' to come through */ + kill(getpid(), sig); /* Send ourselves the signal */ + sys_sigblock(sig); /* Reset to old mask */ + sys_sigset(sig, suspend); /* Reset signal handler */ + + if (tty_set(ttysl_fd) < 0) { + fprintf(stderr,"Can't set tty raw \n"); + exit(1); + } +} + +static RETSIGTYPE cont(int sig) +{ + if (tty_set(ttysl_fd) < 0) { + fprintf(stderr,"Can't set tty raw\n"); + exit(1); + } +} + +static RETSIGTYPE winch(int sig) +{ + cols_needs_update = TRUE; +} +#endif /* HAVE_TERMCAP */ diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c new file mode 100644 index 0000000000..d395b68691 --- /dev/null +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -0,0 +1,1505 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: Provides file and directory operations for Unix. + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_driver.h" +#include "erl_efile.h" +#include +#ifdef HAVE_UNISTD_H +#include +#endif +#ifdef HAVE_SYS_UIO_H +#include +#include +#endif + +#ifdef _OSE_ +#include "efs.h" +#include +#include +#include + +#ifdef _OSE_SFK_ +#include +#endif +#endif /* _OSE_ */ + +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define DARWIN 1 +#endif + +#ifdef DARWIN +#include +#endif /* DARWIN */ + +#ifdef VXWORKS +#include +#include +#include +#include +/* +** Not nice to include usrLib.h as MANY normal variable names get reported +** as shadowing globals, like 'i' for example. +** Instead we declare the only function we use here +*/ +/* + * #include + */ +extern STATUS copy(char *, char *); +#include +#endif + +#ifdef SUNOS4 +# define getcwd(buf, size) getwd(buf) +#endif + +/* Find a definition of MAXIOV, that is used in the code later. */ +#if defined IOV_MAX +#define MAXIOV IOV_MAX +#elif defined UIO_MAXIOV +#define MAXIOV UIO_MAXIOV +#else +#define MAXIOV 16 +#endif + + +/* + * Macros for testing file types. + */ + +#ifdef _OSE_ + +#define ISDIR(st) S_ISDIR(((st).st_mode)) +#define ISREG(st) S_ISREG(((st).st_mode)) +#define ISDEV(st) (S_ISCHR(((st).st_mode)) || S_ISBLK(((st).st_mode))) +#define ISLNK(st) S_ISLNK(((st).st_mode)) +#ifdef NO_UMASK +#define FILE_MODE (S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH) +#define DIR_MODE (S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IXGRP | S_IROTH | S_IXOTH) +#else +#define FILE_MODE (S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH) +#define DIR_MODE (S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | \ + S_IWOTH | S_IXOTH) +#endif + +#else /* !_OSE_ */ + +#define ISDIR(st) (((st).st_mode & S_IFMT) == S_IFDIR) +#define ISREG(st) (((st).st_mode & S_IFMT) == S_IFREG) +#define ISDEV(st) \ + (((st).st_mode&S_IFMT) == S_IFCHR || ((st).st_mode&S_IFMT) == S_IFBLK) +#define ISLNK(st) (((st).st_mode & S_IFLNK) == S_IFLNK) +#ifdef NO_UMASK +#define FILE_MODE 0644 +#define DIR_MODE 0755 +#else +#define FILE_MODE 0666 +#define DIR_MODE 0777 +#endif + +#endif /* _OSE_ */ + +#ifdef VXWORKS /* Currently only used on vxworks */ + +#define EF_ALLOC(S) driver_alloc((S)) +#define EF_REALLOC(P, S) driver_realloc((P), (S)) +#define EF_SAFE_ALLOC(S) ef_safe_alloc((S)) +#define EF_SAFE_REALLOC(P, S) ef_safe_realloc((P), (S)) +#define EF_FREE(P) do { if((P)) driver_free((P)); } while(0) + +extern void erl_exit(int n, char *fmt, _DOTS_); + +static void *ef_safe_alloc(Uint s) +{ + void *p = EF_ALLOC(s); + if (!p) erl_exit(1, + "unix efile drv: Can't allocate %d bytes of memory\n", + s); + return p; +} + +#if 0 /* Currently not used */ + +static void *ef_safe_realloc(void *op, Uint s) +{ + void *p = EF_REALLOC(op, s); + if (!p) erl_exit(1, + "unix efile drv: Can't reallocate %d bytes of memory\n", + s); + return p; +} + +#endif /* #if 0 */ +#endif /* #ifdef VXWORKS */ + +#define IS_DOT_OR_DOTDOT(s) \ + (s[0] == '.' && (s[1] == '\0' || (s[1] == '.' && s[2] == '\0'))) + +#ifdef VXWORKS +static FUNCTION(int, vxworks_to_posix, (int vx_errno)); +#endif + +/* +** VxWorks (not) strikes again. Too long RESULTING paths +** may give the infamous bus error. Have to check ALL +** filenames and pathnames. No wonder the emulator is slow on +** these cards... +*/ +#ifdef VXWORKS +#define CHECK_PATHLEN(Name, ErrInfo) \ + if (path_size(Name) > PATH_MAX) { \ + errno = ENAMETOOLONG; \ + return check_error(-1, ErrInfo); \ + } +#else +#define CHECK_PATHLEN(X,Y) /* Nothing */ +#endif + +static FUNCTION(int, check_error, (int result, Efile_error* errInfo)); + +static int +check_error(int result, Efile_error *errInfo) +{ + if (result < 0) { +#ifdef VXWORKS + errInfo->posix_errno = errInfo->os_errno = vxworks_to_posix(errno); +#else + errInfo->posix_errno = errInfo->os_errno = errno; +#endif + return 0; + } + return 1; +} + +#ifdef VXWORKS + +/* + * VxWorks has different error codes for different file systems. + * We map those to POSIX ones. + */ +static int +vxworks_to_posix(int vx_errno) +{ + DEBUGF(("[vxworks_to_posix] vx_errno: %08x\n", vx_errno)); + switch (vx_errno) { + /* dosFsLib mapping */ +#ifdef S_dosFsLib_FILE_ALREADY_EXISTS + case S_dosFsLib_FILE_ALREADY_EXISTS: return EEXIST; +#else + case S_dosFsLib_FILE_EXISTS: return EEXIST; +#endif +#ifdef S_dosFsLib_BAD_DISK + case S_dosFsLib_BAD_DISK: return EIO; +#endif +#ifdef S_dosFsLib_CANT_CHANGE_ROOT + case S_dosFsLib_CANT_CHANGE_ROOT: return EINVAL; +#endif +#ifdef S_dosFsLib_NO_BLOCK_DEVICE + case S_dosFsLib_NO_BLOCK_DEVICE: return ENOTBLK; +#endif +#ifdef S_dosFsLib_BAD_SEEK + case S_dosFsLib_BAD_SEEK: return ESPIPE; +#endif + case S_dosFsLib_VOLUME_NOT_AVAILABLE: return ENXIO; + case S_dosFsLib_DISK_FULL: return ENOSPC; + case S_dosFsLib_FILE_NOT_FOUND: return ENOENT; + case S_dosFsLib_NO_FREE_FILE_DESCRIPTORS: return ENFILE; + case S_dosFsLib_INVALID_NUMBER_OF_BYTES: return EINVAL; + case S_dosFsLib_ILLEGAL_NAME: return EINVAL; + case S_dosFsLib_CANT_DEL_ROOT: return EACCES; + case S_dosFsLib_NOT_FILE: return EISDIR; + case S_dosFsLib_NOT_DIRECTORY: return ENOTDIR; + case S_dosFsLib_NOT_SAME_VOLUME: return EXDEV; + case S_dosFsLib_READ_ONLY: return EACCES; + case S_dosFsLib_ROOT_DIR_FULL: return ENOSPC; + case S_dosFsLib_DIR_NOT_EMPTY: return EEXIST; + case S_dosFsLib_NO_LABEL: return ENXIO; + case S_dosFsLib_INVALID_PARAMETER: return EINVAL; + case S_dosFsLib_NO_CONTIG_SPACE: return ENOSPC; + case S_dosFsLib_FD_OBSOLETE: return EBADF; + case S_dosFsLib_DELETED: return EINVAL; + case S_dosFsLib_INTERNAL_ERROR: return EIO; + case S_dosFsLib_WRITE_ONLY: return EACCES; + /* nfsLib mapping - is needed since Windriver has used */ + /* inconsistent error codes (errno.h/nfsLib.h). */ + case S_nfsLib_NFS_OK: return 0; + case S_nfsLib_NFSERR_PERM: return EPERM; + case S_nfsLib_NFSERR_NOENT: return ENOENT; + case S_nfsLib_NFSERR_IO: return EIO; + case S_nfsLib_NFSERR_NXIO: return ENXIO; +#ifdef S_nfsLib_NFSERR_ACCES + case S_nfsLib_NFSERR_ACCES: return EACCES; +#else + case S_nfsLib_NFSERR_ACCESS: return EACCES; +#endif + case S_nfsLib_NFSERR_EXIST: return EEXIST; + case S_nfsLib_NFSERR_NODEV: return ENODEV; + case S_nfsLib_NFSERR_NOTDIR: return ENOTDIR; + case S_nfsLib_NFSERR_ISDIR: return EISDIR; + case S_nfsLib_NFSERR_FBIG: return EFBIG; + case S_nfsLib_NFSERR_NOSPC: return ENOSPC; + case S_nfsLib_NFSERR_ROFS: return EROFS; + case S_nfsLib_NFSERR_NAMETOOLONG: return ENAMETOOLONG; + case S_nfsLib_NFSERR_NOTEMPTY: return EEXIST; + case S_nfsLib_NFSERR_DQUOT: return ENOSPC; + case S_nfsLib_NFSERR_STALE: return EINVAL; + case S_nfsLib_NFSERR_WFLUSH: return ENXIO; + /* And sometimes (...) the error codes are from ioLib (as in the */ + /* case of the (for nfsLib) unimplemented rename function) */ + case S_ioLib_DISK_NOT_PRESENT: return EIO; +#if S_ioLib_DISK_NOT_PRESENT != S_ioLib_NO_DRIVER + case S_ioLib_NO_DRIVER: return ENXIO; +#endif + case S_ioLib_UNKNOWN_REQUEST: return ENOSYS; + case S_ioLib_DEVICE_TIMEOUT: return EIO; +#ifdef S_ioLib_UNFORMATED + /* Added (VxWorks 5.2 -> 5.3.1) */ + #if S_ioLib_UNFORMATED != S_ioLib_DEVICE_TIMEOUT + case S_ioLib_UNFORMATED: return EIO; + #endif +#endif +#if S_ioLib_DEVICE_TIMEOUT != S_ioLib_DEVICE_ERROR + case S_ioLib_DEVICE_ERROR: return ENXIO; +#endif + case S_ioLib_WRITE_PROTECTED: return EACCES; + case S_ioLib_NO_FILENAME: return EINVAL; + case S_ioLib_CANCELLED: return EINTR; + case S_ioLib_NO_DEVICE_NAME_IN_PATH: return EINVAL; + case S_ioLib_NAME_TOO_LONG: return ENAMETOOLONG; +#ifdef S_objLib_OBJ_UNAVAILABLE + case S_objLib_OBJ_UNAVAILABLE: return ENOENT; +#endif + + /* Temporary workaround for a weird error in passFs + (VxWorks Simsparc only). File operation fails because of + ENOENT, but errno is not set. */ +#ifdef SIMSPARCSOLARIS + case 0: return ENOENT; +#endif + + } + /* If the error code matches none of the above, assume */ + /* it is a POSIX one already. The upper bits (>=16) are */ + /* cleared since VxWorks uses those bits to indicate in */ + /* what module the error occured. */ + return vx_errno & 0xffff; +} + +static int +vxworks_enotsup(Efile_error *errInfo) +{ + errInfo->posix_errno = errInfo->os_errno = ENOTSUP; + return 0; +} + +static int +count_path_length(char *pathname, char *pathname2) +{ + static int stack[PATH_MAX / 2 + 1]; + int sp = 0; + char *tmp; + char *cpy = NULL; + int i; + int sum; + for(i = 0;i < 2;++i) { + if (!i) { + cpy = EF_SAFE_ALLOC(strlen(pathname)+1); + strcpy(cpy, pathname); + } else if (pathname2 != NULL) { + EF_FREE(cpy); + cpy = EF_SAFE_ALLOC(strlen(pathname2)+1); + strcpy(cpy, pathname2); + } else + break; + + for (tmp = strtok(cpy,"/"); tmp != NULL; tmp = strtok(NULL,"/")) { + if (!strcmp(tmp,"..") && sp > 0) + --sp; + else if (strcmp(tmp,".")) + stack[sp++] = strlen(tmp); + } + } + if (cpy != NULL) + EF_FREE(cpy); + sum = 0; + for(i = 0;i < sp; ++i) + sum += stack[i]+1; + return (sum) ? sum : 1; +} + +static int +path_size(char *pathname) +{ + static char currdir[PATH_MAX+2]; + if (*pathname == '/') + return count_path_length(pathname,NULL); + ioDefPathGet(currdir); + strcat(currdir,"/"); + return count_path_length(currdir,pathname); +} + +#endif /* VXWORKS */ + +#ifdef _OSE_ +static int +ose_enotsup(Efile_error *errInfo) +{ + errInfo->posix_errno = errInfo->os_errno = ENOTSUP; + return 0; +} +#endif /* _OSE_ */ + +int +efile_mkdir(Efile_error* errInfo, /* Where to return error codes. */ + char* name) /* Name of directory to create. */ +{ + CHECK_PATHLEN(name,errInfo); +#ifdef NO_MKDIR_MODE +#ifdef VXWORKS + /* This is a VxWorks/nfs workaround for erl_tar to create + * non-existant directories. (of some reason (...) VxWorks + * returns, the *non-module-prefixed*, 0xd code when + * trying to create a directory in a directory that doesn't exist). + * (see efile_openfile) + */ + if (mkdir(name) < 0) { + struct stat sb; + if (name[0] == '\0') { + /* Return the correct error code enoent */ + errno = S_nfsLib_NFSERR_NOENT; + } else if (stat(name, &sb) == OK) { + errno = S_nfsLib_NFSERR_EXIST; + } else if((strchr(name, '/') != NULL) && (errno == 0xd)) { + /* Return the correct error code enoent */ + errno = S_nfsLib_NFSERR_NOENT; + } + return check_error(-1, errInfo); + } else return 1; +#else + return check_error(mkdir(name), errInfo); +#endif +#else + return check_error(mkdir(name, DIR_MODE), errInfo); +#endif +} + +int +efile_rmdir(Efile_error* errInfo, /* Where to return error codes. */ + char* name) /* Name of directory to delete. */ +{ + CHECK_PATHLEN(name, errInfo); + if (rmdir(name) == 0) { + return 1; + } +#ifdef VXWORKS + if (name[0] == '\0') { + /* Return the correct error code enoent */ + errno = S_nfsLib_NFSERR_NOENT; + } +#else + if (errno == ENOTEMPTY) { + errno = EEXIST; + } + if (errno == EEXIST) { + int saved_errno = errno; + struct stat file_stat; + struct stat cwd_stat; + + /* + * The error code might be wrong if this is the current directory. + */ + + if (stat(name, &file_stat) == 0 && stat(".", &cwd_stat) == 0 && + file_stat.st_ino == cwd_stat.st_ino && + file_stat.st_dev == cwd_stat.st_dev) { + saved_errno = EINVAL; + } + errno = saved_errno; + } +#endif + return check_error(-1, errInfo); +} + +int +efile_delete_file(Efile_error* errInfo, /* Where to return error codes. */ + char* name) /* Name of file to delete. */ +{ + CHECK_PATHLEN(name,errInfo); +#ifdef _OSE_ + if (remove(name) == 0) { + return 1; + } +#else + if (unlink(name) == 0) { + return 1; + } + if (errno == EISDIR) { /* Linux sets the wrong error code. */ + errno = EPERM; + } +#endif + return check_error(-1, errInfo); +} + +/* + *--------------------------------------------------------------------------- + * + * Changes the name of an existing file or directory, from src to dst. + * If src and dst refer to the same file or directory, does nothing + * and returns success. Otherwise if dst already exists, it will be + * deleted and replaced by src subject to the following conditions: + * If src is a directory, dst may be an empty directory. + * If src is a file, dst may be a file. + * In any other situation where dst already exists, the rename will + * fail. + * + * Results: + * If the directory was successfully created, returns 1. + * Otherwise the return value is 0 and errno is set to + * indicate the error. Some possible values for errno are: + * + * EACCES: src or dst parent directory can't be read and/or written. + * EEXIST: dst is a non-empty directory. + * EINVAL: src is a root directory or dst is a subdirectory of src. + * EISDIR: dst is a directory, but src is not. + * ENOENT: src doesn't exist, or src or dst is "". + * ENOTDIR: src is a directory, but dst is not. + * EXDEV: src and dst are on different filesystems. + * + * Side effects: + * The implementation of rename may allow cross-filesystem renames, + * but the caller should be prepared to emulate it with copy and + * delete if errno is EXDEV. + * + *--------------------------------------------------------------------------- + */ + +int +efile_rename(Efile_error* errInfo, /* Where to return error codes. */ + char* src, /* Original name. */ + char* dst) /* New name. */ +{ + CHECK_PATHLEN(src,errInfo); + CHECK_PATHLEN(dst,errInfo); +#ifdef VXWORKS + + /* First check if src == dst, if so, just return. */ + /* VxWorks dos file system destroys the file otherwise, */ + /* VxWorks nfs file system rename doesn't work at all. */ + if(strcmp(src, dst) == 0) + return 1; +#endif + if (rename(src, dst) == 0) { + return 1; + } +#ifdef VXWORKS + /* nfs for VxWorks doesn't support rename. We try to emulate it */ + /* (by first copying src to dst and then deleting src). */ + if(errno == S_ioLib_UNKNOWN_REQUEST && /* error code returned + by ioLib (!) */ + copy(src, dst) == OK && + unlink(src) == OK) + return 1; +#endif + if (errno == ENOTEMPTY) { + errno = EEXIST; + } +#if defined (sparc) && !defined(VXWORKS) && !defined(_OSE_) + /* + * SunOS 4.1.4 reports overwriting a non-empty directory with a + * directory as EINVAL instead of EEXIST (first rule out the correct + * EINVAL result code for moving a directory into itself). Must be + * conditionally compiled because realpath() is only defined on SunOS. + */ + + if (errno == EINVAL) { + char srcPath[MAXPATHLEN], dstPath[MAXPATHLEN]; + DIR *dirPtr; + struct dirent *dirEntPtr; + +#ifdef PURIFY + memset(srcPath, '\0', sizeof(srcPath)); + memset(dstPath, '\0', sizeof(dstPath)); +#endif + + if ((realpath(src, srcPath) != NULL) + && (realpath(dst, dstPath) != NULL) + && (strncmp(srcPath, dstPath, strlen(srcPath)) != 0)) { + dirPtr = opendir(dst); + if (dirPtr != NULL) { + while ((dirEntPtr = readdir(dirPtr)) != NULL) { + if ((strcmp(dirEntPtr->d_name, ".") != 0) && + (strcmp(dirEntPtr->d_name, "..") != 0)) { + errno = EEXIST; + closedir(dirPtr); + return check_error(-1, errInfo); + } + } + closedir(dirPtr); + } + } + errno = EINVAL; + } +#endif /* sparc */ + + if (strcmp(src, "/") == 0) { + /* + * Alpha reports renaming / as EBUSY and Linux reports it as EACCES, + * instead of EINVAL. + */ + + errno = EINVAL; + } + + /* + * DEC Alpha OSF1 V3.0 returns EACCES when attempting to move a + * file across filesystems and the parent directory of that file is + * not writable. Most other systems return EXDEV. Does nothing to + * correct this behavior. + */ + + return check_error(-1, errInfo); +} + +int +efile_chdir(Efile_error* errInfo, /* Where to return error codes. */ + char* name) /* Name of directory to make current. */ +{ + CHECK_PATHLEN(name, errInfo); + return check_error(chdir(name), errInfo); +} + + +int +efile_getdcwd(Efile_error* errInfo, /* Where to return error codes. */ + int drive, /* 0 - current, 1 - A, 2 - B etc. */ + char* buffer, /* Where to return the current + directory. */ + size_t size) /* Size of buffer. */ +{ + if (drive == 0) { + if (getcwd(buffer, size) == NULL) + return check_error(-1, errInfo); + +#ifdef SIMSPARCSOLARIS + /* We get "host:" prepended to the dirname - remove!. */ + { + int i = 0; + int j = 0; + while ((buffer[i] != ':') && (buffer[i] != '\0')) i++; + if (buffer[i] == ':') { + i++; + while ((buffer[j++] = buffer[i++]) != '\0'); + } + } +#endif + return 1; + } + + /* + * Drives other than 0 is not supported on Unix. + */ + + errno = ENOTSUP; + return check_error(-1, errInfo); +} + +int +efile_readdir(Efile_error* errInfo, /* Where to return error codes. */ + char* name, /* Name of directory to open. */ + EFILE_DIR_HANDLE* p_dir_handle, /* Pointer to directory + handle of + open directory.*/ + char* buffer, /* Pointer to buffer for + one filename. */ + size_t size) /* Size of buffer. */ +{ + DIR *dp; /* Pointer to directory structure. */ + struct dirent* dirp; /* Pointer to directory entry. */ + + /* + * If this is the first call, we must open the directory. + */ + + CHECK_PATHLEN(name, errInfo); + + if (*p_dir_handle == NULL) { + dp = opendir(name); + if (dp == NULL) + return check_error(-1, errInfo); + *p_dir_handle = (EFILE_DIR_HANDLE) dp; + } + + /* + * Retrieve the name of the next file using the directory handle. + */ + + dp = *((DIR **)((void *)p_dir_handle)); + for (;;) { + dirp = readdir(dp); + if (dirp == NULL) { + closedir(dp); + return 0; + } + if (IS_DOT_OR_DOTDOT(dirp->d_name)) + continue; + buffer[0] = '\0'; + strncat(buffer, dirp->d_name, size-1); + return 1; + } +} + +int +efile_openfile(Efile_error* errInfo, /* Where to return error codes. */ + char* name, /* Name of directory to open. */ + int flags, /* Flags to user for opening. */ + int* pfd, /* Where to store the file + descriptor. */ + Sint64 *pSize) /* Where to store the size of the + file. */ +{ + struct stat statbuf; + int fd; + int mode; /* Open mode. */ +#ifdef VXWORKS + char pathbuff[PATH_MAX+2]; + char sbuff[PATH_MAX*2]; + char *totbuff = sbuff; + int nameneed; +#endif + + + CHECK_PATHLEN(name, errInfo); + +#ifdef VXWORKS + /* Have to check that it's not a directory. */ + if (stat(name,&statbuf) != ERROR && ISDIR(statbuf)) { + errno = EISDIR; + return check_error(-1, errInfo); + } +#endif + + if (stat(name, &statbuf) >= 0 && !ISREG(statbuf)) { +#if !defined(VXWORKS) && !defined(OSE) + /* + * For UNIX only, here is some ugly code to allow + * /dev/null to be opened as a file. + * + * Assumption: The i-node number for /dev/null cannot be zero. + */ + static ino_t dev_null_ino = 0; + + if (dev_null_ino == 0) { + struct stat nullstatbuf; + + if (stat("/dev/null", &nullstatbuf) >= 0) { + dev_null_ino = nullstatbuf.st_ino; + } + } + if (!(dev_null_ino && statbuf.st_ino == dev_null_ino)) { +#endif + errno = EISDIR; + return check_error(-1, errInfo); +#if !defined(VXWORKS) && !defined(OSE) + } +#endif + } + + switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) { + case EFILE_MODE_READ: + mode = O_RDONLY; + break; + case EFILE_MODE_WRITE: + if (flags & EFILE_NO_TRUNCATE) + mode = O_WRONLY | O_CREAT; + else + mode = O_WRONLY | O_CREAT | O_TRUNC; + break; + case EFILE_MODE_READ_WRITE: + mode = O_RDWR | O_CREAT; + break; + default: + errno = EINVAL; + return check_error(-1, errInfo); + } + + + if (flags & EFILE_MODE_APPEND) { + mode &= ~O_TRUNC; +#ifndef VXWORKS + mode |= O_APPEND; /* Dont make VxWorks think things it shouldn't */ +#endif + } + + +#ifdef VXWORKS + if (*name != '/') { + /* Make sure it is an absolute pathname, because ftruncate needs it */ + ioDefPathGet(pathbuff); + strcat(pathbuff,"/"); + nameneed = strlen(pathbuff) + strlen(name) + 1; + if (nameneed > PATH_MAX*2) + totbuff = EF_SAFE_ALLOC(nameneed); + strcpy(totbuff,pathbuff); + strcat(totbuff,name); + fd = open(totbuff, mode, FILE_MODE); + if (totbuff != sbuff) + EF_FREE(totbuff); + } else { + fd = open(name, mode, FILE_MODE); + } +#else + fd = open(name, mode, FILE_MODE); +#endif + +#ifdef VXWORKS + + /* This is a VxWorks/nfs workaround for erl_tar to create + * non-existant directories. (of some reason (...) VxWorks + * returns, the *non-module-prefixed*, 0xd code when + * trying to write a file in a directory that doesn't exist). + * (see efile_mkdir) + */ + if ((fd < 0) && (strchr(name, '/') != NULL) && (errno == 0xd)) { + /* Return the correct error code enoent */ + errno = S_nfsLib_NFSERR_NOENT; + return check_error(-1, errInfo); + } +#endif + + if (!check_error(fd, errInfo)) + return 0; + + *pfd = fd; + if (pSize) { + *pSize = statbuf.st_size; + } + return 1; +} + +int +efile_may_openfile(Efile_error* errInfo, char *name) { + struct stat statbuf; /* Information about the file */ + int result; + + result = stat(name, &statbuf); + if (!check_error(result, errInfo)) + return 0; + if (!ISREG(statbuf)) { + errno = EISDIR; + return check_error(-1, errInfo); + } + return 1; +} + +void +efile_closefile(int fd) +{ + close(fd); +} + +int +efile_fsync(Efile_error *errInfo, /* Where to return error codes. */ + int fd) /* File descriptor for file to sync. */ +{ +#ifdef NO_FSYNC +#ifdef VXWORKS + return check_error(ioctl(fd, FIOSYNC, 0), errInfo); +#else + undefined fsync +#endif /* VXWORKS */ +#else +#if defined(DARWIN) && defined(F_FULLFSYNC) + return check_error(fcntl(fd, F_FULLFSYNC), errInfo); +#else + return check_error(fsync(fd), errInfo); +#endif /* DARWIN */ +#endif /* NO_FSYNC */ +} + +int +efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, + char* name, int info_for_link) +{ + struct stat statbuf; /* Information about the file */ + struct tm *timep; /* Broken-apart filetime. */ + int result; + +#ifdef VXWORKS + if (*name == '\0') { + errInfo->posix_errno = errInfo->os_errno = ENOENT; + return 0; + } +#endif + + CHECK_PATHLEN(name, errInfo); + + if (info_for_link) { +#if (defined(VXWORKS) || defined(_OSE_)) + result = stat(name, &statbuf); +#else + result = lstat(name, &statbuf); +#endif + } else { + result = stat(name, &statbuf); + } + if (!check_error(result, errInfo)) { + return 0; + } + +#if SIZEOF_OFF_T == 4 + pInfo->size_high = 0; +#else + pInfo->size_high = (Uint32)(statbuf.st_size >> 32); +#endif + pInfo->size_low = (Uint32)statbuf.st_size; + +#ifdef NO_ACCESS + /* Just look at read/write access for owner. */ +#ifdef VXWORKS + + pInfo->access = FA_NONE; + if(statbuf.st_mode & S_IRUSR) + pInfo->access |= FA_READ; + if(statbuf.st_mode & S_IWUSR) + pInfo->access |= FA_WRITE; + +#else + + pInfo->access = ((statbuf.st_mode >> 6) & 07) >> 1; + +#endif /* VXWORKS */ +#else + pInfo->access = FA_NONE; + if (access(name, R_OK) == 0) + pInfo->access |= FA_READ; + if (access(name, W_OK) == 0) + pInfo->access |= FA_WRITE; + +#endif + + if (ISDEV(statbuf)) + pInfo->type = FT_DEVICE; + else if (ISDIR(statbuf)) + pInfo->type = FT_DIRECTORY; + else if (ISREG(statbuf)) + pInfo->type = FT_REGULAR; + else if (ISLNK(statbuf)) + pInfo->type = FT_SYMLINK; + else + pInfo->type = FT_OTHER; + +#if defined(HAVE_LOCALTIME_R) || defined(VXWORKS) + { + /* Use the reentrant version of localtime() */ + static struct tm local_tm; +#define localtime(a) (localtime_r((a), &local_tm), &local_tm) +#endif + + +#define GET_TIME(dst, src) \ + timep = localtime(&statbuf.src); \ + (dst).year = timep->tm_year+1900; \ + (dst).month = timep->tm_mon+1; \ + (dst).day = timep->tm_mday; \ + (dst).hour = timep->tm_hour; \ + (dst).minute = timep->tm_min; \ + (dst).second = timep->tm_sec + + GET_TIME(pInfo->accessTime, st_atime); + GET_TIME(pInfo->modifyTime, st_mtime); + GET_TIME(pInfo->cTime, st_ctime); + +#undef GET_TIME + +#if defined(HAVE_LOCALTIME_R) || defined(VXWORKS) + } +#endif + + pInfo->mode = statbuf.st_mode; + pInfo->links = statbuf.st_nlink; + pInfo->major_device = statbuf.st_dev; +#ifdef _OSE_ + pInfo->minor_device = 0; +#else + pInfo->minor_device = statbuf.st_rdev; +#endif + pInfo->inode = statbuf.st_ino; + pInfo->uid = statbuf.st_uid; + pInfo->gid = statbuf.st_gid; + + return 1; +} + +int +efile_write_info(Efile_error *errInfo, Efile_info *pInfo, char *name) +{ + CHECK_PATHLEN(name, errInfo); + +#ifdef VXWORKS + + if (pInfo->mode != -1) { + int fd; + struct stat statbuf; + + fd = open(name, O_RDONLY, 0); + if (!check_error(fd, errInfo)) + return 0; + if (fstat(fd, &statbuf) < 0) { + close(fd); + return check_error(-1, errInfo); + } + if (pInfo->mode & S_IWUSR) { + /* clear read only bit */ + statbuf.st_attrib &= ~DOS_ATTR_RDONLY; + } else { + /* set read only bit */ + statbuf.st_attrib |= DOS_ATTR_RDONLY; + } + /* This should work for dos files but not for nfs ditos, so don't + * report errors (to avoid problems when running e.g. erl_tar) + */ + ioctl(fd, FIOATTRIBSET, statbuf.st_attrib); + close(fd); + } +#else + /* + * On some systems chown will always fail for a non-root user unless + * POSIX_CHOWN_RESTRICTED is not set. Others will succeed as long as + * you don't try to chown a file to someone besides youself. + */ + +#ifndef _OSE_ + if (chown(name, pInfo->uid, pInfo->gid) && errno != EPERM) { + return check_error(-1, errInfo); + } +#endif + + if (pInfo->mode != -1) { + mode_t newMode = pInfo->mode & (S_ISUID | S_ISGID | + S_IRWXU | S_IRWXG | S_IRWXO); + if (chmod(name, newMode)) { + newMode &= ~(S_ISUID | S_ISGID); + if (chmod(name, newMode)) { + return check_error(-1, errInfo); + } + } + } + +#endif /* !VXWORKS */ + +#ifndef _OSE_ + + if (pInfo->accessTime.year != -1 && pInfo->modifyTime.year != -1) { + struct utimbuf tval; + struct tm timebuf; + +#define MKTIME(tb, ts) \ + timebuf.tm_year = ts.year-1900; \ + timebuf.tm_mon = ts.month-1; \ + timebuf.tm_mday = ts.day; \ + timebuf.tm_hour = ts.hour; \ + timebuf.tm_min = ts.minute; \ + timebuf.tm_sec = ts.second; \ + timebuf.tm_isdst = -1; \ + if ((tb = mktime(&timebuf)) == (time_t) -1) { \ + errno = EINVAL; \ + return check_error(-1, errInfo); \ + } + + MKTIME(tval.actime, pInfo->accessTime); + MKTIME(tval.modtime, pInfo->modifyTime); +#undef MKTIME + +#ifdef VXWORKS + /* VxWorks' utime doesn't work when the file is a nfs mounted + * one, don't report error if utime fails. + */ + utime(name, &tval); + return 1; +#else + return check_error(utime(name, &tval), errInfo); +#endif + } +#endif /* !_OSE_ */ + return 1; +} + + +int +efile_write(Efile_error* errInfo, /* Where to return error codes. */ + int flags, /* Flags given when file was + opened. */ + int fd, /* File descriptor to write to. */ + char* buf, /* Buffer to write. */ + size_t count) /* Number of bytes to write. */ +{ + ssize_t written; /* Bytes written in last operation. */ + +#ifdef VXWORKS + if (flags & EFILE_MODE_APPEND) { + lseek(fd, 0, SEEK_END); /* Naive append emulation on VXWORKS */ + } +#endif + while (count > 0) { + if ((written = write(fd, buf, count)) < 0) { + if (errno != EINTR) + return check_error(-1, errInfo); + else + written = 0; + } + ASSERT(written <= count); + buf += written; + count -= written; + } + return 1; +} + +int +efile_writev(Efile_error* errInfo, /* Where to return error codes */ + int flags, /* Flags given when file was + * opened */ + int fd, /* File descriptor to write to */ + SysIOVec* iov, /* Vector of buffer structs. + * The structs are unchanged + * after the call */ + int iovcnt, /* Number of structs in vector */ + size_t size) /* Number of bytes to write */ +{ + int cnt = 0; /* Buffers so far written */ + int p = 0; /* Position in next buffer */ + + ASSERT(iovcnt >= 0); + +#ifdef VXWORKS + if (flags & EFILE_MODE_APPEND) { + lseek(fd, 0, SEEK_END); /* Naive append emulation on VXWORKS */ + } +#endif + + while (cnt < iovcnt) { +#ifdef HAVE_WRITEV + int w; /* Bytes written in this call */ + int b = iovcnt - cnt; /* Buffers to write */ + if (b > MAXIOV) + b = MAXIOV; + if (iov[cnt].iov_base && iov[cnt].iov_len > 0) { + if (b == 1) { + /* Degenerated io vector */ + do { + w = write(fd, iov[cnt].iov_base + p, iov[cnt].iov_len - p); + } while (w < 0 && errno == EINTR); + } else { + /* Non-empty vector first. + * Adjust pos in first buffer in case of + * previous incomplete writev */ + iov[cnt].iov_base += p; + iov[cnt].iov_len -= p; + do { + w = writev(fd, &iov[cnt], b); + } while (w < 0 && errno == EINTR); + iov[cnt].iov_base -= p; + iov[cnt].iov_len += p; + } + if (w < 0) + return check_error(-1, errInfo); + } else { + /* Empty vector first - skip */ + cnt++; + continue; + } + ASSERT(w >= 0); + /* Move forward to next vector to write */ + for (; cnt < iovcnt; cnt++) { + if (iov[cnt].iov_base && iov[cnt].iov_len > 0) { + if (w < iov[cnt].iov_len) + break; + else + w -= iov[cnt].iov_len; + } + } + ASSERT(w >= 0); + p = w > 0 ? w : 0; /* Skip p bytes next writev */ +#else /* #ifdef HAVE_WRITEV */ + if (iov[cnt].iov_base && iov[cnt].iov_len > 0) { + /* Non-empty vector */ + int w; /* Bytes written in this call */ + while (p < iov[cnt].iov_len) { + do { + w = write(fd, iov[cnt].iov_base + p, iov[cnt].iov_len - p); + } while (w < 0 && errno == EINTR); + if (w < 0) + return check_error(-1, errInfo); + p += w; + } + } + cnt++; + p = 0; +#endif /* #ifdef HAVE_WRITEV */ + } /* while (cnt< iovcnt) */ + size = 0; /* Avoid compiler warning */ + return 1; +} + +int +efile_read(Efile_error* errInfo, /* Where to return error codes. */ + int flags, /* Flags given when file was opened. */ + int fd, /* File descriptor to read from. */ + char* buf, /* Buffer to read into. */ + size_t count, /* Number of bytes to read. */ + size_t *pBytesRead) /* Where to return number of + bytes read. */ +{ + ssize_t n; + + for (;;) { + if ((n = read(fd, buf, count)) >= 0) + break; + else if (errno != EINTR) + return check_error(-1, errInfo); + } + *pBytesRead = (size_t) n; + return 1; +} + + +/* pread() and pwrite() */ +/* Some unix systems, notably Solaris has these syscalls */ +/* It is especially nice for i.e. the dets module to have support */ +/* for this, even if the underlying OS dosn't support it, it is */ +/* reasonably easy to work around by first calling seek, and then */ +/* calling read(). */ +/* This later strategy however changes the file pointer, which pread() */ +/* does not do. We choose to ignore this and say that the location */ +/* of the file pointer is undefined after a call to any of the p functions*/ + + +int +efile_pread(Efile_error* errInfo, /* Where to return error codes. */ + int fd, /* File descriptor to read from. */ + Sint64 offset, /* Offset in bytes from BOF. */ + char* buf, /* Buffer to read into. */ + size_t count, /* Number of bytes to read. */ + size_t *pBytesRead) /* Where to return + number of bytes read. */ +{ +#if defined(HAVE_PREAD) && defined(HAVE_PWRITE) + ssize_t n; + off_t off = (off_t) offset; + if (off != offset) { + errno = EINVAL; + return check_error(-1, errInfo); + } + for (;;) { + if ((n = pread(fd, buf, count, offset)) >= 0) + break; + else if (errno != EINTR) + return check_error(-1, errInfo); + } + *pBytesRead = (size_t) n; + return 1; +#else + { + int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + if (res) { + return efile_read(errInfo, 0, fd, buf, count, pBytesRead); + } else { + return res; + } + } +#endif +} + + + +int +efile_pwrite(Efile_error* errInfo, /* Where to return error codes. */ + int fd, /* File descriptor to write to. */ + char* buf, /* Buffer to write. */ + size_t count, /* Number of bytes to write. */ + Sint64 offset) /* where to write it */ +{ +#if defined(HAVE_PREAD) && defined(HAVE_PWRITE) + ssize_t written; /* Bytes written in last operation. */ + off_t off = (off_t) offset; + if (off != offset) { + errno = EINVAL; + return check_error(-1, errInfo); + } + + while (count > 0) { + if ((written = pwrite(fd, buf, count, offset)) < 0) { + if (errno != EINTR) + return check_error(-1, errInfo); + else + written = 0; + } + ASSERT(written <= count); + buf += written; + count -= written; + offset += written; + } + return 1; +#else /* For unix systems that don't support pread() and pwrite() */ + { + int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + + if (res) { + return efile_write(errInfo, 0, fd, buf, count); + } else { + return res; + } + } +#endif +} + + +int +efile_seek(Efile_error* errInfo, /* Where to return error codes. */ + int fd, /* File descriptor to do the seek on. */ + Sint64 offset, /* Offset in bytes from the given + origin. */ + int origin, /* Origin of seek (SEEK_SET, SEEK_CUR, + SEEK_END). */ + Sint64 *new_location) /* Resulting new location in file. */ +{ + off_t off, result; + + switch (origin) { + case EFILE_SEEK_SET: origin = SEEK_SET; break; + case EFILE_SEEK_CUR: origin = SEEK_CUR; break; + case EFILE_SEEK_END: origin = SEEK_END; break; + default: + errno = EINVAL; + return check_error(-1, errInfo); + } + off = (off_t) offset; + if (off != offset) { + errno = EINVAL; + return check_error(-1, errInfo); + } + + errno = 0; + result = lseek(fd, off, origin); + + /* + * Note that the man page for lseek (on SunOs 5) says: + * + * "if fildes is a remote file descriptor and offset is + * negative, lseek() returns the file pointer even if it is + * negative." + */ + + if (result < 0 && errno == 0) + errno = EINVAL; + if (result < 0) + return check_error(-1, errInfo); + if (new_location) { + *new_location = result; + } + return 1; +} + + +int +efile_truncate_file(Efile_error* errInfo, int *fd, int flags) +{ +#ifdef VXWORKS + off_t offset; + char namebuf[PATH_MAX+1]; + char namebuf2[PATH_MAX+10]; + int new; + int dummy; + int i; + int left; + static char buff[1024]; + struct stat st; + Efile_error tmperr; + + if ((offset = lseek(*fd, 0, 1)) < 0) { + return check_error((int) offset,errInfo); + } + if (ftruncate(*fd, offset) < 0) { + if (vxworks_to_posix(errno) != EINVAL) { + return check_error(-1, errInfo); + } + /* + ** Kludge + */ + if(ioctl(*fd,FIOGETNAME,(int) namebuf) < 0) { + return check_error(-1, errInfo); + } + for(i=0;i<1000;++i) { + sprintf(namebuf2,"%s%d",namebuf,i); + CHECK_PATHLEN(namebuf2,errInfo); + if (stat(namebuf2,&st) < 0) { + break; + } + } + if (i > 1000) { + errno = EINVAL; + return check_error(-1, errInfo); + } + if (close(*fd) < 0) { + return check_error(-1, errInfo); + } + if (efile_rename(&tmperr,namebuf,namebuf2) < 0) { + i = check_error(-1,&tmperr); + if (!efile_openfile(errInfo,namebuf,flags | EFILE_NO_TRUNCATE, + fd,&dummy)) { + *fd = -1; + } else { + *errInfo = tmperr; + } + return i; + } + if ((*fd = open(namebuf2, O_RDONLY, 0)) < 0) { + i = check_error(-1,errInfo); + efile_rename(&tmperr,namebuf2,namebuf); /* at least try */ + if (!efile_openfile(errInfo,namebuf,flags | EFILE_NO_TRUNCATE, + fd,&dummy)) { + *fd = -1; + } else { + lseek(*fd,offset,SEEK_SET); + } + return i; + } + /* Point of no return... */ + + if ((new = open(namebuf,O_RDWR | O_CREAT, FILE_MODE)) < 0) { + close(*fd); + *fd = -1; + return 0; + } + left = offset; + + while (left) { + if ((i = read(*fd,buff,(left > 1024) ? 1024 : left)) < 0) { + i = check_error(-1,errInfo); + close(new); + close(*fd); + unlink(namebuf); + efile_rename(&tmperr,namebuf2,namebuf); /* at least try */ + if (!efile_openfile(errInfo,namebuf,flags | EFILE_NO_TRUNCATE, + fd,&dummy)) { + *fd = -1; + } else { + lseek(*fd,offset,SEEK_SET); + } + return i; + } + left -= i; + if (write(new,buff,i) < 0) { + i = check_error(-1,errInfo); + close(new); + close(*fd); + unlink(namebuf); + rename(namebuf2,namebuf); /* at least try */ + if (!efile_openfile(errInfo,namebuf,flags | EFILE_NO_TRUNCATE, + fd,&dummy)) { + *fd = -1; + } else { + lseek(*fd,offset,SEEK_SET); + } + return i; + } + } + close(*fd); + unlink(namebuf2); + close(new); + i = efile_openfile(errInfo,namebuf,flags | EFILE_NO_TRUNCATE,fd, + &dummy); + if (i) { + lseek(*fd,offset,SEEK_SET); + } + return i; + } + return 1; +#else +#ifndef NO_FTRUNCATE + off_t offset; + + return check_error((offset = lseek(*fd, 0, 1)) >= 0 && + ftruncate(*fd, offset) == 0 ? 1 : -1, + errInfo); +#else + return 1; +#endif +#endif +} + +int +efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) +{ +#ifdef _OSE_ + return ose_enotsup(errInfo); +#else +#ifdef VXWORKS + return vxworks_enotsup(errInfo); +#else + int len; + ASSERT(size > 0); + len = readlink(name, buffer, size-1); + if (len == -1) { + return check_error(-1, errInfo); + } + buffer[len] = '\0'; + return 1; +#endif +#endif +} + +int +efile_altname(Efile_error* errInfo, char* name, char* buffer, size_t size) +{ + errno = ENOTSUP; + return check_error(-1, errInfo); +} + +int +efile_link(Efile_error* errInfo, char* old, char* new) +{ +#ifdef _OSE_ + return ose_enotsup(errInfo); +#else +#ifdef VXWORKS + return vxworks_enotsup(errInfo); +#else + return check_error(link(old, new), errInfo); +#endif +#endif +} + +int +efile_symlink(Efile_error* errInfo, char* old, char* new) +{ +#ifdef _OSE_ + return ose_enotsup(errInfo); +#else +#ifdef VXWORKS + return vxworks_enotsup(errInfo); +#else + return check_error(symlink(old, new), errInfo); +#endif +#endif +} diff --git a/erts/emulator/drivers/vxworks/vxworks_resolv.c b/erts/emulator/drivers/vxworks/vxworks_resolv.c new file mode 100644 index 0000000000..8fcbb736f7 --- /dev/null +++ b/erts/emulator/drivers/vxworks/vxworks_resolv.c @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Interface functions to different versions of gethostbyname. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "netdb.h" +#include "erl_resolv.h" + +struct hostent *erl_gethostbyname(name) + char *name; +{ + return gethostbyname(name); +} + +struct hostent *erl_gethostbyaddr(addr, len, type) + char *addr; + int len; + int type; +{ + return gethostbyaddr(addr, len, type); +} + + diff --git a/erts/emulator/drivers/win32/mem_drv.c b/erts/emulator/drivers/win32/mem_drv.c new file mode 100644 index 0000000000..fa7c46eca8 --- /dev/null +++ b/erts/emulator/drivers/win32/mem_drv.c @@ -0,0 +1,141 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* Purpose: Access to elib memory statistics */ + +#include "sys.h" +#include "erl_driver.h" +#include "elib_stat.h" + +#define MAP_BUF_SIZE 1000 /* Max map size */ +#define HISTO_BUF_SIZE 100 /* Max histogram buckets */ + +static ErlDrvData mem_start(ErlDrvPort, char*); +static int mem_init(void); +static void mem_stop(ErlDrvData); +static void mem_command(ErlDrvData); + +ErlDrvEntry mem_driver_entry = { + mem_init, + mem_start, + mem_stop, + mem_command, + NULL, + NULL, + "mem_drv" +}; + +static int mem_init(void) +{ + return 0; +} + +static ErlDrvData mem_start(ErlDrvPort port, char* buf) +{ + return (ErlDrvData)port; +} + +static void mem_stop(ErlDrvData port) +{ +} + +void putint32(p, v) +byte* p; int v; +{ + p[0] = (v >> 24) & 0xff; + p[1] = (v >> 16) & 0xff; + p[2] = (v >> 8) & 0xff; + p[3] = (v) & 0xff; +} + +int getint16(p) +byte* p; +{ + return (p[0] << 8) | p[1]; +} + +/* +** Command: +** m L1 L0 -> a heap map of length L1*256 + L0 is returned +** s -> X3 X2 X1 X0 Y3 Y2 Y1 Y0 Z3 Z2 Z1 Z0 +** X == Total heap size bytes +** Y == Total free bytes +** Z == Size of largest free block in bytes +** +** h L1 L0 B0 -> Generate a logarithm histogram base B with L buckets +** l L1 L0 S0 -> Generate a linear histogram with step S with L buckets +*/ +unsigned char outbuf[HISTO_BUF_SIZE*2*4]; + +static void mem_command(ErlDrvData port, char* buf, int count) +{ + if ((count == 1) && buf[0] == 's') { + struct elib_stat info; + char v[3*4]; + + elib_stat(&info); + + putint32(v, info.mem_total*4); + putint32(v+4, info.mem_free*4); + putint32(v+8, info.max_free*4); + driver_output((ErlDrvPort)port, v, 12); + return; + } + else if ((count == 3) && buf[0] == 'm') { + char w[MAP_BUF_SIZE]; + int n = getint16(buf+1); + + if (n > MAP_BUF_SIZE) + n = MAP_BUF_SIZE; + elib_heap_map(w, n); + driver_output((ErlDrvPort)port, w, n); + return; + } + else if ((count == 4) && (buf[0] == 'h' || buf[0] == 'l')) { + unsigned long vf[HISTO_BUF_SIZE]; + unsigned long va[HISTO_BUF_SIZE]; + int n = getint16(buf+1); + int base = (unsigned char) buf[3]; + + if (n >= HISTO_BUF_SIZE) + n = HISTO_BUF_SIZE; + if (buf[0] == 'l') + base = -base; + if (elib_histo(vf, va, n, base) < 0) { + driver_failure((ErlDrvPort)port, -1); + return; + } + else { + char* p = outbuf; + int i; + + for (i = 0; i < n; i++) { + putint32(p, vf[i]); + p += 4; + } + for (i = 0; i < n; i++) { + putint32(p, va[i]); + p += 4; + } + driver_output((ErlDrvPort)port, outbuf, n*8); + } + return; + } + driver_failure((ErlDrvPort)port, -1); +} + diff --git a/erts/emulator/drivers/win32/registry_drv.c b/erts/emulator/drivers/win32/registry_drv.c new file mode 100644 index 0000000000..05fd2ea55f --- /dev/null +++ b/erts/emulator/drivers/win32/registry_drv.c @@ -0,0 +1,535 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Purpose: Interface to the registry API. + */ + +#include +#include "erl_driver.h" +#include "sys.h" + +/* + * Commands recognised by this driver. + */ + +#define CMD_GET_CURRENT 0 +#define CMD_OPEN_KEY 1 +#define CMD_CREATE_KEY 2 +#define CMD_GET_ALL_SUBKEYS 3 +#define CMD_GET_VALUE 4 +#define CMD_GET_ALL_VALUES 5 +#define CMD_SET_VALUE 6 +#define CMD_DELETE_KEY 7 +#define CMD_DELETE_VALUE 8 + +/* + * Microsoft-specific function to map a WIN32 error code to a Posix errno. + */ + +extern void _dosmaperr(DWORD); + +/* + * Information kept for a registry port (since there is no controlling + * Erlang process, all state must be kept here). + */ + +typedef struct { + ErlDrvPort port; /* Port handle. */ + REGSAM sam; /* Access for handles. */ + HKEY hkey; /* Handle to open key. */ + HKEY hkey_root; /* Root handle for current key. */ + char* key; /* Name of key. */ + DWORD key_size; /* Size of key. */ + LPSTR name_buf; /* Buffer for names. */ + DWORD name_buf_size; /* Size of name buffer. */ + LPSTR value_buf; /* Buffer for values. */ + DWORD value_buf_size; /* Size of value buffer. */ +} RegPort; + + +/* + * Local functions. + */ + +static void reply(RegPort* rp, LONG result); +static BOOL fix_value_result(RegPort* rp, LONG result, DWORD type, + LPSTR name, DWORD nameSize, LPSTR value, + DWORD valueSize); +static int key_reply(RegPort* rp, LPSTR name, DWORD nameSize); +static int value_reply(RegPort* rp, DWORD type, LPSTR name, DWORD nameSize, + LPSTR value, DWORD valueSize); +static int state_reply(RegPort* rp, HKEY root, LPSTR name, DWORD nameSize); +static int maperror(DWORD error); +/* + * Local variables. + */ + +static int reg_init(void); +static ErlDrvData reg_start(ErlDrvPort, char*); +static void reg_stop(ErlDrvData); +static void reg_from_erlang(ErlDrvData, char*, int); + +struct erl_drv_entry registry_driver_entry = { + reg_init, + reg_start, + reg_stop, + reg_from_erlang, + NULL, + NULL, + "registry__drv__", + NULL, + NULL, + NULL, + NULL, + NULL +}; + +static int +reg_init(void) +{ + DEBUGF(("reg_init()\n")); + return 0; +} + +static ErlDrvData +reg_start(ErlDrvPort port, char* buf) +{ + RegPort* rp; + char* s; + REGSAM sam = KEY_READ; + + if ((s = strchr(buf, ' ')) != NULL) { + while (isspace(*s)) + s++; + while (*s != '\0') { + if (*s == 'r') { + sam |= KEY_READ; + } else if (*s == 'w') { + sam |= KEY_WRITE; + } + s++; + } + } + + rp = driver_alloc(sizeof(RegPort)); + if (rp == NULL) { + return ERL_DRV_ERROR_GENERAL; + } + rp->port = port; + rp->hkey = rp->hkey_root = HKEY_CLASSES_ROOT; + rp->sam = sam; + rp->key = driver_alloc(1); + rp->key_size = 0; + rp->name_buf_size = 64; + rp->name_buf = driver_alloc(rp->name_buf_size); + rp->value_buf_size = 64; + rp->value_buf = driver_alloc(rp->value_buf_size); + return (ErlDrvData) rp; +} + +static void +reg_stop(ErlDrvData clientData) +{ + RegPort* rp = (RegPort *) clientData; + + (void) RegCloseKey(rp->hkey); + driver_free(rp->name_buf); + driver_free(rp->value_buf); + driver_free(rp->key); + driver_free(rp); + /* return 1; */ +} + +static void +reg_from_erlang(ErlDrvData clientData, char* buf, int count) +{ + RegPort* rp = (RegPort *) clientData; + int cmd; + HKEY hkey; + LONG result; + DWORD nameSize; + DWORD type; /* Type of data in buffer. */ + DWORD valueSize; /* Size of value buffer. */ + + cmd = buf[0]; + buf++, count--; + switch (cmd) { + case CMD_GET_CURRENT: + state_reply(rp, rp->hkey_root, rp->key, rp->key_size); + break; + case CMD_OPEN_KEY: + { + char* key; + HKEY newKey; + + /* + * [HKEY(DWORD), KeyString(string)] + */ + + hkey = (HKEY) get_int32(buf+0); + rp->hkey_root = hkey; + key = buf+4; + result = RegOpenKeyEx(hkey, key, 0, rp->sam, &newKey); + if (result == ERROR_SUCCESS) { + RegCloseKey(rp->hkey); + rp->hkey = newKey; + driver_free(rp->key); + rp->key_size = strlen(key); + rp->key = driver_alloc(rp->key_size+1); + strcpy(rp->key, key); + } + reply(rp, result); + return; + } + break; + case CMD_CREATE_KEY: + { + char* key; + HKEY newKey; + DWORD disposition; + + hkey = (HKEY) get_int32(buf+0); + rp->hkey_root = hkey; + key = buf+4; + result = RegCreateKeyEx(hkey, key, 0, "", 0, rp->sam, NULL, + &newKey, &disposition); + if (result == ERROR_SUCCESS) { + RegCloseKey(rp->hkey); + rp->hkey = newKey; + driver_free(rp->key); + rp->key_size = strlen(key); + rp->key = driver_alloc(rp->key_size+1); + strcpy(rp->key, key); + } + reply(rp, result); + return; + } + break; + case CMD_GET_ALL_SUBKEYS: + { + int i; + + i = 0; + for (;;) { + nameSize = rp->name_buf_size; + result = RegEnumKeyEx(rp->hkey, i, rp->name_buf, &nameSize, + NULL, NULL, NULL, NULL); + if (result == ERROR_MORE_DATA) { + rp->name_buf_size *= 2; + rp->name_buf = driver_realloc(rp->name_buf, + rp->name_buf_size); + continue; + } else if (result == ERROR_NO_MORE_ITEMS) { + reply(rp, ERROR_SUCCESS); + return; + } else if (result != ERROR_SUCCESS) { + reply(rp, result); + return; + } + key_reply(rp, rp->name_buf, nameSize); + i++; + } + } + break; + case CMD_GET_VALUE: + do { + valueSize = rp->value_buf_size; + result = RegQueryValueEx(rp->hkey, buf, NULL, &type, + rp->value_buf, &valueSize); + } while (!fix_value_result(rp, result, type, buf, strlen(buf), + rp->value_buf, valueSize)); + break; + case CMD_GET_ALL_VALUES: + { + int i; + + i = 0; + for (;;) { + nameSize = rp->name_buf_size; + valueSize = rp->value_buf_size; + result = RegEnumValue(rp->hkey, i, rp->name_buf, &nameSize, + NULL, &type, rp->value_buf, &valueSize); + if (result == ERROR_NO_MORE_ITEMS) { + reply(rp, ERROR_SUCCESS); + return; + } + if (fix_value_result(rp, result, type, rp->name_buf, nameSize, + rp->value_buf, valueSize)) { + i++; + } + } + } + break; + case CMD_SET_VALUE: + { + LPSTR name; + DWORD dword; + + /* + * [Type(DWORD), Name(string), Value(bytes)] + */ + + type = get_int32(buf); + buf += 4; + count -= 4; + name = buf; + nameSize = strlen(buf) + 1; + buf += nameSize; + count -= nameSize; + if (type == REG_DWORD) { + /* + * Must pass a pointer to a DWORD in host byte order. + */ + dword = get_int32(buf); + buf = (char *) &dword; + ASSERT(count == 4); + } + result = RegSetValueEx(rp->hkey, name, 0, type, buf, count); + reply(rp, result); + } + break; + case CMD_DELETE_KEY: + result = RegDeleteKey(rp->hkey, NULL); + reply(rp, result); + break; + case CMD_DELETE_VALUE: + result = RegDeleteValue(rp->hkey, buf); + reply(rp, result); + break; + } + /* return 1; */ +} + +static BOOL +fix_value_result(RegPort* rp, LONG result, DWORD type, + LPSTR name, DWORD nameSize, LPSTR value, DWORD valueSize) +{ + if (result == ERROR_MORE_DATA) { + DWORD max_name1; + DWORD max_name2; + DWORD max_value; + int ok; + + ok = RegQueryInfoKey(rp->hkey, NULL, NULL, NULL, + NULL, &max_name1, NULL, NULL, &max_name2, + &max_value, NULL, NULL); +#ifdef DEBUG + if (ok != ERROR_SUCCESS) { + char buff[256]; + sprintf(buff,"Failure in registry_drv line %d, error = %d", + __LINE__, GetLastError()); + MessageBox(NULL, buff, "Internal error", MB_OK); + ASSERT(ok == ERROR_SUCCESS); + } +#endif + rp->name_buf_size = (max_name1 > max_name2 ? max_name1 : max_name2) + + 1; + rp->value_buf_size = max_value + 1; + rp->name_buf = driver_realloc(rp->name_buf, rp->name_buf_size); + rp->value_buf = driver_realloc(rp->value_buf, rp->value_buf_size); + return FALSE; + } else if (result != ERROR_SUCCESS) { + reply(rp, result); + return TRUE; + } + + /* + * Do some data conversion which is easier to do here + * than in Erlang. + */ + + switch (type) { + case REG_SZ: + case REG_EXPAND_SZ: + valueSize--; /* No reason to send the '\0' to Erlang. */ + break; + case REG_DWORD_LITTLE_ENDIAN: + case REG_DWORD_BIG_ENDIAN: + /* + * The value is a DWORD stored in host byte order. + * We must retrieve it and store it in network byte order. + */ + { + DWORD dword = * ((DWORD *) value); + put_int32(dword, value); + type = REG_DWORD; /* Simplify life for Erlang code. */ + break; + } + } + + return value_reply(rp, type, name, nameSize, value, valueSize); +} + +/* + * Sends one of the following replies back to Erlang, + * depending on result: + * + * [$e|Posix error(string)] Error + * [$o] Ok + */ + +static void +reply(RegPort* rp, LONG result) +{ + char sbuf[256]; + + if (result == ERROR_SUCCESS) { + sbuf[0] = 'o'; + driver_output(rp->port, sbuf, 1); + } else { + char* s; + char* t; + int err; + + sbuf[0] = 'e'; + err = maperror(result); + for (s = erl_errno_id(err), t = sbuf+1; *s; s++, t++) { + *t = tolower(*s); + } + driver_output(rp->port, sbuf, t-sbuf); + } + /* return 1; */ +} + +/* + * Sends a key to Erlang: + * + * [$k, Keyname(string)] + */ + +static int +key_reply(RegPort* rp, /* Pointer to port structure. */ + LPSTR name, /* Pointer to name. */ + DWORD nameSize) /* Length of name. */ +{ + char sbuf[512]; + char* s = sbuf; + int needed = 1+nameSize; + + if (sizeof sbuf < needed) { + s = driver_alloc(needed); + } + + s[0] = 'k'; + memcpy(s+1, name, nameSize); + driver_output(rp->port, s, needed); + + if (s != sbuf) { + driver_free(s); + } + return 1; +} + +/* + * Sends a value to Erlang: + * + * [$v, Type(DWORD), Valuename(string), 0, Value(bytes)] + */ + +static int +value_reply(RegPort* rp, /* Pointer to port structure. */ + DWORD type, /* Type of value */ + LPSTR name, /* Pointer to name. */ + DWORD nameSize, /* Length of name. */ + LPSTR value, /* Pointer to value. */ + DWORD valueSize) /* Size of value. */ +{ + char sbuf[512]; + char* s = sbuf; + int needed = 1+4+nameSize+1+valueSize; + int i; + + if (sizeof sbuf < needed) { + s = driver_alloc(needed); + } + + s[0] = 'v'; + i = 1; + put_int32(type, s+i); + i += 4; + memcpy(s+i, name, nameSize); + i += nameSize; + s[i++] = '\0'; + memcpy(s+i, value, valueSize); + ASSERT(i+valueSize == needed); + driver_output(rp->port, s, needed); + + if (s != sbuf) { + driver_free(s); + } + return 1; +} + +/* + * Sends a key to Erlang: + * + * [$s, HKEY(DWORD), Keyname(string)] State + */ + +static int +state_reply(RegPort* rp, /* Pointer to port structure. */ + HKEY root, /* Handle to root key for this key. */ + LPSTR name, /* Pointer to name. */ + DWORD nameSize) /* Length of name. */ +{ + char sbuf[512]; + char* s = sbuf; + int needed = 1+4+nameSize; + int i; + + if (sizeof sbuf < needed) { + s = driver_alloc(needed); + } + + s[0] = 's'; + i = 1; + put_int32((DWORD) root, s+i); + i += 4; + memcpy(s+i, name, nameSize); + ASSERT(i+nameSize == needed); + driver_output(rp->port, s, needed); + + if (s != sbuf) { + driver_free(s); + } + return 1; +} + +static int +maperror(DWORD error) +{ + DEBUGF(("Mapping %d\n", error)); + switch (error) { + case ERROR_BADDB: + case ERROR_BADKEY: + case ERROR_CANTOPEN: + case ERROR_CANTWRITE: + case ERROR_REGISTRY_RECOVERED: + case ERROR_REGISTRY_CORRUPT: + case ERROR_REGISTRY_IO_FAILED: + case ERROR_NOT_REGISTRY_FILE: + return EIO; + case ERROR_KEY_DELETED: + return EINVAL; + default: + _dosmaperr(error); + return errno; + } +} diff --git a/erts/emulator/drivers/win32/ttsl_drv.c b/erts/emulator/drivers/win32/ttsl_drv.c new file mode 100644 index 0000000000..fd88dafd34 --- /dev/null +++ b/erts/emulator/drivers/win32/ttsl_drv.c @@ -0,0 +1,751 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Tty driver that reads one character at the time and provides a + * smart line for output. + */ + +#include "sys.h" +#include +#include +#include +#include +#include + +#include "erl_driver.h" +#include "win_con.h" + +#define TRUE 1 +#define FALSE 0 + +static int cols; /* Number of columns available. */ +static int rows; /* Number of rows available. */ + +/* The various opcodes. */ +#define OP_PUTC 0 +#define OP_MOVE 1 +#define OP_INSC 2 +#define OP_DELC 3 +#define OP_BEEP 4 + +/* Control op */ +#define CTRL_OP_GET_WINSIZE 100 +#define CTRL_OP_GET_UNICODE_STATE 101 +#define CTRL_OP_SET_UNICODE_STATE 102 + +static int lbuf_size = BUFSIZ; +Uint32 *lbuf; /* The current line buffer */ +int llen; /* The current line length */ +int lpos; /* The current "cursor position" in the line buffer */ + +/* + * Tags used in line buffer to show that these bytes represent special characters, + * Max unicode is 0x0010ffff, so we have lots of place for meta tags... + */ +#define CONTROL_TAG 0x10000000U /* Control character, value in first position */ +#define ESCAPED_TAG 0x01000000U /* Escaped character, value in first position */ +#define TAG_MASK 0xFF000000U + +#define MAXSIZE (1 << 16) + +#define ISPRINT(c) (isprint(c) || (128+32 <= (c) && (c) < 256)) + +#define DEBUGLOG(X) /* nothing */ + +/* + * XXX These are used by win_con.c (for command history). + * Should be cleaned up. + */ + + +#define NL '\n' + +/* Main interface functions. */ +static int ttysl_init(void); +static ErlDrvData ttysl_start(ErlDrvPort, char*); +static void ttysl_stop(ErlDrvData); +static int ttysl_control(ErlDrvData, unsigned int, char *, int, char **, int); +static void ttysl_from_erlang(ErlDrvData, char*, int); +static void ttysl_from_tty(ErlDrvData, ErlDrvEvent); +static Sint16 get_sint16(char *s); + +static ErlDrvPort ttysl_port; + +extern ErlDrvEvent console_input_event; +extern HANDLE console_thread; + +static HANDLE ttysl_in = INVALID_HANDLE_VALUE; /* Handle for console input. */ +static HANDLE ttysl_out = INVALID_HANDLE_VALUE; /* Handle for console output */ + +/* Functions that work on the line buffer. */ +static int start_lbuf(); +static int stop_lbuf(); +static int put_chars(); +static int move_rel(); +static int ins_chars(); +static int del_chars(); +static int step_over_chars(int n); +static int insert_buf(); +static int write_buf(); +static void move_cursor(int, int); + +/* Define the driver table entry. */ +struct erl_drv_entry ttsl_driver_entry = { + ttysl_init, + ttysl_start, + ttysl_stop, + ttysl_from_erlang, + ttysl_from_tty, + NULL, + "tty_sl", + NULL, + NULL, + ttysl_control, + NULL +}; + +static int utf8_mode = 0; + +static int ttysl_init() +{ + lbuf = NULL; /* For line buffer handling */ + ttysl_port = (ErlDrvPort)-1; + return 0; +} + +static ErlDrvData ttysl_start(ErlDrvPort port, char* buf) +{ + if ((int)ttysl_port != -1 || console_thread == NULL) { + return ERL_DRV_ERROR_GENERAL; + } + start_lbuf(); + utf8_mode = 1; + driver_select(port, console_input_event, ERL_DRV_READ, 1); + ttysl_port = port; + return (ErlDrvData)ttysl_port;/* Nothing important to return */ +} + +#define DEF_HEIGHT 24 +#define DEF_WIDTH 80 + +static void ttysl_get_window_size(Uint32 *width, Uint32 *height) +{ + *width = ConGetColumns(); + *height = ConGetRows(); +} + + +static int ttysl_control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + char resbuff[2*sizeof(Uint32)]; + int res_size; + switch (command) { + case CTRL_OP_GET_WINSIZE: + { + Uint32 w,h; + ttysl_get_window_size(&w,&h); + memcpy(resbuff,&w,sizeof(Uint32)); + memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32)); + res_size = 2*sizeof(Uint32); + } + break; + case CTRL_OP_GET_UNICODE_STATE: + *resbuff = (utf8_mode) ? 1 : 0; + res_size = 1; + break; + case CTRL_OP_SET_UNICODE_STATE: + if (len > 0) { + int m = (int) *buf; + *resbuff = (utf8_mode) ? 1 : 0; + res_size = 1; + utf8_mode = (m) ? 1 : 0; + } else { + return 0; + } + break; + default: + return 0; + } + if (rlen < res_size) { + *rbuf = driver_alloc(res_size); + } + memcpy(*rbuf,resbuff,res_size); + return res_size; +} + + +static void ttysl_stop(ErlDrvData ttysl_data) +{ + if ((int)ttysl_port != -1) { + driver_select(ttysl_port, console_input_event, ERL_DRV_READ, 0); + } + + ttysl_in = ttysl_out = INVALID_HANDLE_VALUE; + stop_lbuf(); + ttysl_port = (ErlDrvPort)-1; +} + +static int put_utf8(int ch, byte *target, int sz, int *pos) +{ + Uint x = (Uint) ch; + if (x < 0x80) { + if (*pos >= sz) { + return -1; + } + target[(*pos)++] = (byte) x; + } + else if (x < 0x800) { + if (((*pos) + 1) >= sz) { + return -1; + } + target[(*pos)++] = (((byte) (x >> 6)) | + ((byte) 0xC0)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else if (x < 0x10000) { + if ((x >= 0xD800 && x <= 0xDFFF) || + (x == 0xFFFE) || + (x == 0xFFFF)) { /* Invalid unicode range */ + return -1; + } + if (((*pos) + 2) >= sz) { + return -1; + } + + target[(*pos)++] = (((byte) (x >> 12)) | + ((byte) 0xE0)); + target[(*pos)++] = ((((byte) (x >> 6)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else if (x < 0x110000) { /* Standard imposed max */ + if (((*pos) + 3) >= sz) { + return -1; + } + target[(*pos)++] = (((byte) (x >> 18)) | + ((byte) 0xF0)); + target[(*pos)++] = ((((byte) (x >> 12)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = ((((byte) (x >> 6)) & 0x3F) | + ((byte) 0x80)); + target[(*pos)++] = (((byte) (x & 0x3F)) | + ((byte) 0x80)); + } else { + return -1; + } + return 0; +} + + +static int pick_utf8(byte *s, int sz, int *pos) +{ + int size = sz - (*pos); + byte *source; + Uint unipoint; + + if (size > 0) { + source = s + (*pos); + if (((*source) & ((byte) 0x80)) == 0) { + unipoint = (int) *source; + ++(*pos); + return (int) unipoint; + } else if (((*source) & ((byte) 0xE0)) == 0xC0) { + if (size < 2) { + return -2; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((*source) < 0xC2) /* overlong */) { + return -1; + } + (*pos) += 2; + unipoint = + (((Uint) ((*source) & ((byte) 0x1F))) << 6) | + ((Uint) (source[1] & ((byte) 0x3F))); + return (int) unipoint; + } else if (((*source) & ((byte) 0xF0)) == 0xE0) { + if (size < 3) { + return -2; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((source[2] & ((byte) 0xC0)) != 0x80) || + (((*source) == 0xE0) && (source[1] < 0xA0)) /* overlong */ ) { + return -1; + } + if ((((*source) & ((byte) 0xF)) == 0xD) && + ((source[1] & 0x20) != 0)) { + return -1; + } + if (((*source) == 0xEF) && (source[1] == 0xBF) && + ((source[2] == 0xBE) || (source[2] == 0xBF))) { + return -1; + } + (*pos) += 3; + unipoint = + (((Uint) ((*source) & ((byte) 0xF))) << 12) | + (((Uint) (source[1] & ((byte) 0x3F))) << 6) | + ((Uint) (source[2] & ((byte) 0x3F))); + return (int) unipoint; + } else if (((*source) & ((byte) 0xF8)) == 0xF0) { + if (size < 4) { + return -2 ; + } + if (((source[1] & ((byte) 0xC0)) != 0x80) || + ((source[2] & ((byte) 0xC0)) != 0x80) || + ((source[3] & ((byte) 0xC0)) != 0x80) || + (((*source) == 0xF0) && (source[1] < 0x90)) /* overlong */) { + return -1; + } + if ((((*source) & ((byte)0x7)) > 0x4U) || + ((((*source) & ((byte)0x7)) == 0x4U) && + ((source[1] & ((byte)0x3F)) > 0xFU))) { + return -1; + } + (*pos) += 4; + unipoint = + (((Uint) ((*source) & ((byte) 0x7))) << 18) | + (((Uint) (source[1] & ((byte) 0x3F))) << 12) | + (((Uint) (source[2] & ((byte) 0x3F))) << 6) | + ((Uint) (source[3] & ((byte) 0x3F))); + return (int) unipoint; + } else { + return -1; + } + } else { + return -1; + } +} + +static int octal_or_hex_positions(Uint c) +{ + int x = 0; + Uint ch = c; + if (!ch) { + return 1; + } + while(ch) { + ++x; + ch >>= 3; + } + if (x <= 3) { + return 3; + } + /* \x{H ...} format when larger than \777 */ + x = 0; + ch = c; + while(ch) { + ++x; + ch >>= 4; + } + return x+3; +} + +static void octal_or_hex_format(Uint ch, byte *buf, int *pos) +{ + static byte hex_chars[] = { '0','1','2','3','4','5','6','7','8','9', + 'A','B','C','D','E','F'}; + int num = octal_or_hex_positions(ch); + if (num != 3) { + buf[(*pos)++] = 'x'; + buf[(*pos)++] = '{'; + num -= 3; + while(num--) { + buf[(*pos)++] = hex_chars[((ch >> (4*num)) & 0xFU)]; + } + buf[(*pos)++] = '}'; + } else { + while(num--) { + buf[(*pos)++] = ((byte) ((ch >> (3*num)) & 0x7U) + '0'); + } + } +} + +/* + * Check that there is enough room in all buffers to copy all pad chars + * and stiff we need If not, realloc lbuf. + */ +static int check_buf_size(byte *s, int n) +{ + int pos = 0; + int ch; + int size = 10; + + while(pos < n) { + /* Indata is always UTF-8 */ + if ((ch = pick_utf8(s,n,&pos)) < 0) { + /* XXX temporary allow invalid chars */ + ch = (int) s[pos]; + DEBUGLOG(("Invalid UTF8:%d",ch)); + ++pos; + } + if (utf8_mode) { /* That is, terminal is UTF8 compliant */ + if (ch >= 128 || isprint(ch)) { + DEBUGLOG(("Printable(UTF-8:%d):%d",(pos - opos),ch)); + size++; /* Buffer contains wide characters... */ + } else if (ch == '\t') { + size += 8; + } else { + DEBUGLOG(("Magic(UTF-8:%d):%d",(pos - opos),ch)); + size += 2; + } + } else { + if (ch <= 255 && isprint(ch)) { + DEBUGLOG(("Printable:%d",ch)); + size++; + } else if (ch == '\t') + size += 8; + else if (ch >= 128) { + DEBUGLOG(("Non printable:%d",ch)); + size += (octal_or_hex_positions(ch) + 1); + } + else { + DEBUGLOG(("Magic:%d",ch)); + size += 2; + } + } + } + + if (size + lpos >= lbuf_size) { + + lbuf_size = size + lpos + BUFSIZ; + if ((lbuf = driver_realloc(lbuf, lbuf_size * sizeof(Uint32))) == NULL) { + driver_failure(ttysl_port, -1); + return(0); + } + } + return(1); +} + + +static void ttysl_from_erlang(ErlDrvData ttysl_data, char* buf, int count) +{ + if (lpos > MAXSIZE) + put_chars((byte*)"\n", 1); + + switch (buf[0]) { + case OP_PUTC: + DEBUGLOG(("OP: Putc(%d)",count-1)); + if (check_buf_size((byte*)buf+1, count-1) == 0) + return; + put_chars((byte*)buf+1, count-1); + break; + case OP_MOVE: + move_rel(get_sint16(buf+1)); + break; + case OP_INSC: + if (check_buf_size((byte*)buf+1, count-1) == 0) + return; + ins_chars((byte*)buf+1, count-1); + break; + case OP_DELC: + del_chars(get_sint16(buf+1)); + break; + case OP_BEEP: + ConBeep(); + break; + default: + /* Unknown op, just ignore. */ + break; + } + return; +} + +extern int read_inbuf(char *data, int n); + +static void ttysl_from_tty(ErlDrvData ttysl_data, ErlDrvEvent fd) +{ + Uint32 inbuf[64]; + byte t[1024]; + int i,pos,tpos; + + i = ConReadInput(inbuf,1); + + pos = 0; + tpos = 0; + + while (pos < i) { + while (tpos < 1020 && pos < i) { /* Max 4 bytes for UTF8 */ + put_utf8((int) inbuf[pos++], t, 1024, &tpos); + } + driver_output(ttysl_port, (char *) t, tpos); + tpos = 0; + } +} + +/* + * Gets signed 16 bit integer from binary buffer. + */ +static Sint16 +get_sint16(char *s) +{ + return ((*s << 8) | ((byte*)s)[1]); +} + + +static int start_lbuf(void) +{ + if (!lbuf && !(lbuf = ( Uint32*) driver_alloc(lbuf_size * sizeof(Uint32)))) + return FALSE; + llen = 0; + lpos = 0; + return TRUE; +} + +static int stop_lbuf(void) +{ + if (lbuf) { + driver_free(lbuf); + lbuf = NULL; + } + llen = 0; /* To avoid access error in win_con:AddToCmdHistory during exit*/ + return TRUE; +} + +/* Put l bytes (in UTF8) from s into the buffer and output them. */ +static int put_chars(byte *s, int l) +{ + int n; + + n = insert_buf(s, l); + if (n > 0) + write_buf(lbuf + lpos - n, n); + if (lpos > llen) + llen = lpos; + return TRUE; +} + +/* + * Move the current postition forwards or backwards within the current + * line. We know about padding. + */ +static int move_rel(int n) +{ + int npos; /* The new position */ + + /* Step forwards or backwards over the buffer. */ + npos = step_over_chars(n); + + /* Calculate move, updates pointers and move the cursor. */ + move_cursor(lpos, npos); + lpos = npos; + return TRUE; +} + +/* Insert characters into the buffer at the current position. */ +static int ins_chars(byte *s, int l) +{ + int n, tl; + Uint32 *tbuf = NULL; /* Suppress warning about use-before-set */ + + /* Move tail of buffer to make space. */ + if ((tl = llen - lpos) > 0) { + if ((tbuf = driver_alloc(tl * sizeof(Uint32))) == NULL) + return FALSE; + memcpy(tbuf, lbuf + lpos, tl * sizeof(Uint32)); + } + n = insert_buf(s, l); + if (tl > 0) { + memcpy(lbuf + lpos, tbuf, tl * sizeof(Uint32)); + driver_free(tbuf); + } + llen += n; + write_buf(lbuf + (lpos - n), llen - (lpos - n)); + move_cursor(llen, lpos); + return TRUE; +} + +/* + * Delete characters in the buffer. Can delete characters before (n < 0) + * and after (n > 0) the current position. Cursor left at beginning of + * deleted block. + */ +static int del_chars(int n) +{ + int i, l, r; + int pos; + + /*update_cols();*/ + + /* Step forward or backwards over n logical characters. */ + pos = step_over_chars(n); + + if (pos > lpos) { + l = pos - lpos; /* Buffer characters to delete */ + r = llen - lpos - l; /* Characters after deleted */ + /* Fix up buffer and buffer pointers. */ + if (r > 0) + memcpy(lbuf + lpos, lbuf + pos, r * sizeof(Uint32)); + llen -= l; + /* Write out characters after, blank the tail and jump back to lpos. */ + write_buf(lbuf + lpos, r); + for (i = l ; i > 0; --i) + ConPutChar(' '); + move_cursor(llen + l, lpos); + } + else if (pos < lpos) { + l = lpos - pos; /* Buffer characters */ + r = llen - lpos; /* Characters after deleted */ + move_cursor(lpos, lpos-l); /* Move back */ + /* Fix up buffer and buffer pointers. */ + if (r > 0) + memcpy(lbuf + pos, lbuf + lpos, r * sizeof(Uint32)); + lpos -= l; + llen -= l; + /* Write out characters after, blank the tail and jump back to lpos. */ + write_buf(lbuf + lpos, r); + for (i = l ; i > 0; --i) + ConPutChar(' '); + move_cursor(llen + l, lpos); + } + return TRUE; +} + + +/* Step over n logical characters, check for overflow. */ +static int step_over_chars(int n) +{ + Uint32 *c, *beg, *end; + + beg = lbuf; + end = lbuf + llen; + c = lbuf + lpos; + for ( ; n > 0 && c < end; --n) { + c++; + while (c < end && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0)) + c++; + } + for ( ; n < 0 && c > beg; n++) { + --c; + while (c > beg && (*c & TAG_MASK) && ((*c & ~TAG_MASK) == 0)) + --c; + } + return c - lbuf; +} + +static int insert_buf(byte *s, int n) +{ + int pos = 0; + int buffpos = lpos; + int ch; + + while (pos < n) { + if ((ch = pick_utf8(s,n,&pos)) < 0) { + /* XXX temporary allow invalid chars */ + ch = (int) s[pos]; + DEBUGLOG(("insert_buf: Invalid UTF8:%d",ch)); + ++pos; + } + if ((utf8_mode && (ch >= 128 || isprint(ch))) || (ch <= 255 && isprint(ch))) { + DEBUGLOG(("insert_buf: Printable(UTF-8):%d",ch)); + lbuf[lpos++] = (Uint32) ch; + } else if (ch >= 128) { /* not utf8 mode */ + int nc = octal_or_hex_positions(ch); + lbuf[lpos++] = ((Uint32) ch) | ESCAPED_TAG; + while (nc--) { + lbuf[lpos++] = ESCAPED_TAG; + } + } else if (ch == '\t') { + do { + lbuf[lpos++] = (CONTROL_TAG | ((Uint32) ch)); + ch = 0; + } while (lpos % 8); + } else if (ch == '\n' || ch == '\r') { + write_buf(lbuf + buffpos, lpos - buffpos); + ConPutChar('\r'); + if (ch == '\n') + ConPutChar('\n'); + if (llen > lpos) { + memcpy(lbuf, lbuf + lpos, llen - lpos); + } + llen -= lpos; + lpos = buffpos = 0; + } else { + DEBUGLOG(("insert_buf: Magic(UTF-8):%d",ch)); + lbuf[lpos++] = ch | CONTROL_TAG; + lbuf[lpos++] = CONTROL_TAG; + } + } + return lpos - buffpos; /* characters "written" into + current buffer (may be less due to newline) */ +} +static int write_buf(Uint32 *s, int n) +{ + int i; + + /*update_cols();*/ + + while (n > 0) { + if (!(*s & TAG_MASK) ) { + ConPutChar(*s); + --n; + ++s; + } + else if (*s == (CONTROL_TAG | ((Uint32) '\t'))) { + ConPutChar(' '); + --n; s++; + while (n > 0 && *s == CONTROL_TAG) { + ConPutChar(' '); + --n; s++; + } + } else if (*s & CONTROL_TAG) { + ConPutChar('^'); + ConPutChar((*s == 0177) ? '?' : *s | 0x40); + n -= 2; + s += 2; + } else if (*s & ESCAPED_TAG) { + Uint32 ch = *s & ~(TAG_MASK); + byte *octbuff; + byte octtmp[256]; + int octbytes; + DEBUGLOG(("Escaped: %d", ch)); + octbytes = octal_or_hex_positions(ch); + if (octbytes > 256) { + octbuff = driver_alloc(octbytes); + } else { + octbuff = octtmp; + } + octbytes = 0; + octal_or_hex_format(ch, octbuff, &octbytes); + DEBUGLOG(("octbytes: %d", octbytes)); + ConPutChar('\\'); + for (i = 0; i < octbytes; ++i) { + ConPutChar(octbuff[i]); + } + n -= octbytes+1; + s += octbytes+1; + if (octbuff != octtmp) { + driver_free(octbuff); + } + } else { + DEBUGLOG(("Very unexpected character %d",(int) *s)); + ++n; + --s; + } + } + return TRUE; +} + + +static void +move_cursor(int from, int to) +{ + ConSetCursor(from,to); +} diff --git a/erts/emulator/drivers/win32/win_con.c b/erts/emulator/drivers/win32/win_con.c new file mode 100644 index 0000000000..2202ca655f --- /dev/null +++ b/erts/emulator/drivers/win32/win_con.c @@ -0,0 +1,2259 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#define UNICODE 1 +#define _UNICODE 1 +#include +#include +#include "sys.h" +#include +#include "resource.h" +#include "erl_version.h" +#include +#include +#include "erl_driver.h" +#include "win_con.h" + +#define ALLOC(X) malloc(X) +#define REALLOC(X,Y) realloc(X,Y) +#define FREE(X) free(X) + +#ifndef STATE_SYSTEM_INVISIBLE +/* Mingw problem with oleacc.h and WIN32_LEAN_AND_MEAN */ +#define STATE_SYSTEM_INVISIBLE 0x00008000 +#endif + +#define WM_CONTEXT (0x0401) +#define WM_CONBEEP (0x0402) +#define WM_SAVE_PREFS (0x0403) + +#define USER_KEY TEXT("Software\\Ericsson\\Erlang\\") TEXT(ERLANG_VERSION) + +#define FRAME_HEIGHT ((2*GetSystemMetrics(SM_CYEDGE))+(2*GetSystemMetrics(SM_CYFRAME))+GetSystemMetrics(SM_CYCAPTION)) +#define FRAME_WIDTH (2*GetSystemMetrics(SM_CXFRAME)+(2*GetSystemMetrics(SM_CXFRAME))+GetSystemMetrics(SM_CXVSCROLL)) + +#define LINE_LENGTH canvasColumns +#define COL(_l) ((_l) % LINE_LENGTH) +#define LINE(_l) ((_l) / LINE_LENGTH) + +#ifdef UNICODE +/* + * We use a character in the invalid unicode range + */ +#define SET_CURSOR (0xD8FF) +#else +/* + * XXX There is no escape to send a character 0x80. Fortunately, + * the ttsl driver currently replaces 0x80 with an octal sequence. + */ +#define SET_CURSOR (0x80) +#endif + +#define SCAN_CODE_BREAK 0x46 /* scan code for Ctrl-Break */ + + +typedef struct ScreenLine_s { + struct ScreenLine_s* next; + struct ScreenLine_s* prev; + int width; +#ifdef HARDDEBUG + int allocated; +#endif + int newline; /* Ends with hard newline: 1, wrapped at end: 0 */ + TCHAR *text; +} ScreenLine_t; + +extern Uint32 *lbuf; /* The current line buffer */ +extern int llen; /* The current line length */ +extern int lpos; + +HANDLE console_input_event; +HANDLE console_thread = NULL; + +#define DEF_CANVAS_COLUMNS 80 +#define DEF_CANVAS_ROWS 26 + +#define BUFSIZE 4096 +#define MAXBUFSIZE 32768 +typedef struct { + TCHAR *data; + int size; + int wrPos; + int rdPos; +} buffer_t; + +static buffer_t inbuf; +static buffer_t outbuf; + +static CHOOSEFONT cf; + +static TCHAR szFrameClass[] = TEXT("FrameClass"); +static TCHAR szClientClass[] = TEXT("ClientClass"); +static HWND hFrameWnd; +static HWND hClientWnd; +static HWND hTBWnd; +static HWND hComboWnd; +static HANDLE console_input; +static HANDLE console_output; +static int cxChar,cyChar, cxCharMax; +static int cxClient,cyClient; +static int cyToolBar; +static int iVscrollPos,iHscrollPos; +static int iVscrollMax,iHscrollMax; +static int nBufLines; +static int cur_x; +static int cur_y; +static int canvasColumns = DEF_CANVAS_COLUMNS; +static int canvasRows = DEF_CANVAS_ROWS; +static ScreenLine_t *buffer_top,*buffer_bottom; +static ScreenLine_t* cur_line; +static POINT editBeg,editEnd; +static BOOL fSelecting = FALSE; +static BOOL fTextSelected = FALSE; +static HKEY key; +static BOOL has_key = FALSE; +static LOGFONT logfont; +static DWORD fgColor; +static DWORD bkgColor; +static FILE *logfile = NULL; +static RECT winPos; +static BOOL toolbarVisible; +static BOOL destroyed = FALSE; + +static int lines_to_save = 1000; /* Maximum number of screen lines to save. */ + +#define TITLE_BUF_SZ 256 + +struct title_buf { + TCHAR *name; + TCHAR buf[TITLE_BUF_SZ]; +}; + +static TCHAR *erlang_window_title = TEXT("Erlang"); + +static unsigned __stdcall ConThreadInit(LPVOID param); +static LRESULT CALLBACK ClientWndProc(HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam); +static LRESULT CALLBACK FrameWndProc(HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam); +static BOOL CALLBACK AboutDlgProc(HWND hDlg, UINT iMsg, WPARAM wParam, LPARAM lParam); +static ScreenLine_t *ConNewLine(void); +static void DeleteTopLine(void); +static void ensure_line_below(void); +static ScreenLine_t *GetLineFromY(int y); +static void LoadUserPreferences(void); +static void SaveUserPreferences(void); +static void set_scroll_info(HWND hwnd); +static void ConCarriageFeed(int); +static void ConScrollScreen(void); +static BOOL ConChooseFont(HWND hwnd); +static void ConFontInitialize(HWND hwnd); +static void ConSetFont(HWND hwnd); +static void ConChooseColor(HWND hwnd); +static void DrawSelection(HWND hwnd, POINT pt1, POINT pt2); +static void InvertSelectionArea(HWND hwnd); +static void OnEditCopy(HWND hwnd); +static void OnEditPaste(HWND hwnd); +static void OnEditSelAll(HWND hwnd); +static void GetFileName(HWND hwnd, TCHAR *pFile); +static void OpenLogFile(HWND hwnd); +static void CloseLogFile(HWND hwnd); +static void LogFileWrite(TCHAR *buf, int n); +static int write_inbuf(TCHAR *data, int n); +static void init_buffers(void); +static void AddToCmdHistory(void); +static int write_outbuf(TCHAR *data, int num_chars); +static void ConDrawText(HWND hwnd); +static BOOL (WINAPI *ctrl_handler)(DWORD); +static HWND InitToolBar(HWND hwndParent); +static void window_title(struct title_buf *); +static void free_window_title(struct title_buf *); +static void Client_OnMouseMove(HWND hwnd, int x, int y, UINT keyFlags); + +#define CON_VPRINTF_BUF_INC_SIZE 1024 + +static erts_dsprintf_buf_t * +grow_con_vprintf_buf(erts_dsprintf_buf_t *dsbufp, size_t need) +{ + char *buf; + size_t size; + + ASSERT(dsbufp); + + if (!dsbufp->str) { + size = (((need + CON_VPRINTF_BUF_INC_SIZE - 1) + / CON_VPRINTF_BUF_INC_SIZE) + * CON_VPRINTF_BUF_INC_SIZE); + buf = (char *) ALLOC(size * sizeof(char)); + } + else { + size_t free_size = dsbufp->size - dsbufp->str_len; + + if (need <= free_size) + return dsbufp; + + size = need - free_size + CON_VPRINTF_BUF_INC_SIZE; + size = (((size + CON_VPRINTF_BUF_INC_SIZE - 1) + / CON_VPRINTF_BUF_INC_SIZE) + * CON_VPRINTF_BUF_INC_SIZE); + size += dsbufp->size; + buf = (char *) REALLOC((void *) dsbufp->str, + size * sizeof(char)); + } + if (!buf) + return NULL; + if (buf != dsbufp->str) + dsbufp->str = buf; + dsbufp->size = size; + return dsbufp; +} + +static int con_vprintf(char *format, va_list arg_list) +{ + int res,i; + erts_dsprintf_buf_t dsbuf = ERTS_DSPRINTF_BUF_INITER(grow_con_vprintf_buf); + res = erts_vdsprintf(&dsbuf, format, arg_list); + if (res >= 0) { + TCHAR *tmp = ALLOC(dsbuf.str_len*sizeof(TCHAR)); + for (i=0;iwidth < xpos) { + return (canvasColumns-hscroll)*cxChar; + } + /* Not needed (?): SelectObject(hdc,CreateFontIndirect(&logfont)); */ + if (GetTextExtentPoint32(hdc,pLine->text,xpos,&size)) { +#ifdef HARDDEBUG + fprintf(stderr,"size.cx:%d\n",(int)size.cx); + fflush(stderr); +#endif + if (hscrollPix >= size.cx) { + return 0; + } + return ((int) size.cx) - hscrollPix; + } else { + return (xpos-hscroll)*cxChar; + } +} + +static int GetXFromCurrentY(HDC hdc, int hscroll, int xpos) { + return GetXFromLine(hdc, hscroll, xpos, GetLineFromY(cur_y)); +} + +void ConSetCursor(int from, int to) +{ TCHAR cmd[9]; + int *p; + //DebugBreak(); + cmd[0] = SET_CURSOR; + /* + * XXX Expect trouble on CPUs which don't allow misaligned read and writes. + */ + p = (int *)&cmd[1]; + *p++ = from; + *p = to; + write_outbuf(cmd, 1 + (2*sizeof(int)/sizeof(TCHAR))); +} + +void ConPrintf(char *format, ...) +{ + va_list va; + + va_start(va, format); + (void) con_vprintf(format, va); + va_end(va); +} + +void ConBeep(void) +{ + SendMessage(hClientWnd, WM_CONBEEP, 0L, 0L); +} + +int ConReadInput(Uint32 *data, int num_chars) +{ + TCHAR *buf; + int nread; + WaitForSingleObject(console_input,INFINITE); + nread = num_chars = min(num_chars,inbuf.wrPos-inbuf.rdPos); + buf = &inbuf.data[inbuf.rdPos]; + inbuf.rdPos += nread; + while (nread--) + *data++ = *buf++; + if (inbuf.rdPos >= inbuf.wrPos) { + inbuf.rdPos = 0; + inbuf.wrPos = 0; + ResetEvent(console_input_event); + } + ReleaseSemaphore(console_input,1,NULL); + return num_chars; +} + +int ConGetKey(void) +{ + Uint32 c; + WaitForSingleObject(console_input,INFINITE); + ResetEvent(console_input_event); + inbuf.rdPos = inbuf.wrPos = 0; + ReleaseSemaphore(console_input,1,NULL); + WaitForSingleObject(console_input_event,INFINITE); + ConReadInput(&c, 1); + return (int) c; +} + +int ConGetColumns(void) +{ + return (int) canvasColumns; /* 32bit atomic on windows */ +} + +int ConGetRows(void) { + return (int) canvasRows; +} + + +static HINSTANCE hInstance; +extern HMODULE beam_module; + +static unsigned __stdcall +ConThreadInit(LPVOID param) +{ + MSG msg; + WNDCLASSEX wndclass; + int iCmdShow; + STARTUPINFO StartupInfo; + HACCEL hAccel; + int x, y, w, h; + struct title_buf title; + + /*DebugBreak();*/ + hInstance = GetModuleHandle(NULL); + StartupInfo.dwFlags = 0; + GetStartupInfo(&StartupInfo); + iCmdShow = StartupInfo.dwFlags & STARTF_USESHOWWINDOW ? + StartupInfo.wShowWindow : SW_SHOWDEFAULT; + + LoadUserPreferences(); + + /* frame window class */ + wndclass.cbSize = sizeof (wndclass); + wndclass.style = CS_HREDRAW | CS_VREDRAW | CS_BYTEALIGNCLIENT; + wndclass.lpfnWndProc = FrameWndProc; + wndclass.cbClsExtra = 0; + wndclass.cbWndExtra = 0; + wndclass.hInstance = hInstance; + wndclass.hIcon = LoadIcon (hInstance, MAKEINTRESOURCE(1)); + wndclass.hCursor = LoadCursor (NULL, IDC_ARROW); + wndclass.hbrBackground = NULL; + wndclass.lpszMenuName = NULL; + wndclass.lpszClassName = szFrameClass; + wndclass.hIconSm = LoadIcon (hInstance, MAKEINTRESOURCE(1)); + RegisterClassExW (&wndclass); + + /* client window class */ + wndclass.cbSize = sizeof (wndclass); + wndclass.style = CS_HREDRAW | CS_VREDRAW | CS_OWNDC; + wndclass.lpfnWndProc = ClientWndProc; + wndclass.cbClsExtra = 0; + wndclass.cbWndExtra = 0; + wndclass.hInstance = hInstance; + wndclass.hIcon = LoadIcon (hInstance, MAKEINTRESOURCE(1)); + wndclass.hCursor = LoadCursor (NULL, IDC_ARROW); + wndclass.hbrBackground = CreateSolidBrush(bkgColor); + wndclass.lpszMenuName = NULL; + wndclass.lpszClassName = szClientClass; + wndclass.hIconSm = LoadIcon (hInstance, MAKEINTRESOURCE(1)); + RegisterClassExW (&wndclass); + + InitCommonControls(); + init_buffers(); + + nBufLines = 0; + buffer_top = cur_line = ConNewLine(); + cur_line->next = buffer_bottom = ConNewLine(); + buffer_bottom->prev = cur_line; + + /* Create Frame Window */ + window_title(&title); + hFrameWnd = CreateWindowEx(0, szFrameClass, title.name, + WS_OVERLAPPEDWINDOW,CW_USEDEFAULT, + CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT, + NULL,LoadMenu(beam_module,MAKEINTRESOURCE(1)), + hInstance,NULL); + free_window_title(&title); + + /* XXX OTP-5522: + The window position is not saved correctly and if the window + is closed when minimized, it's not possible to start werl again + with the window open. Temporary fix so far is to ignore saved values + and always start with initial settings. */ + /* Original: if (winPos.left == -1) { */ + /* Temporary: if (1) { */ + if (1) { + + /* initial window position */ + x = 0; + y = 0; + w = cxChar*LINE_LENGTH+FRAME_WIDTH+GetSystemMetrics(SM_CXVSCROLL); + h = cyChar*30+FRAME_HEIGHT; + } else { + /* saved window position */ + x = winPos.left; + y = winPos.top; + w = winPos.right - x; + h = winPos.bottom - y; + } + SetWindowPos(hFrameWnd, NULL, x, y, w, h, SWP_NOZORDER); + + ShowWindow(hFrameWnd, iCmdShow); + UpdateWindow(hFrameWnd); + + hAccel = LoadAccelerators(beam_module,MAKEINTRESOURCE(1)); + + ReleaseSemaphore(console_input, 1, NULL); + ReleaseSemaphore(console_output, 1, NULL); + + + /* Main message loop */ + while (GetMessage (&msg, NULL, 0, 0)) + { + if (!TranslateAccelerator(hFrameWnd,hAccel,&msg)) + { + TranslateMessage (&msg); + DispatchMessage (&msg); + } + } + /* + PostQuitMessage() results in WM_QUIT which makes GetMessage() + return 0 (which stops the main loop). Before we return from + the console thread, the ctrl_handler is called to do erl_exit. + */ + (*ctrl_handler)(CTRL_CLOSE_EVENT); + return msg.wParam; +} + +static LRESULT CALLBACK +FrameWndProc(HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam) +{ + RECT r; + int cy,i,bufsize; + TCHAR c; + unsigned long l; + TCHAR buf[128]; + struct title_buf title; + + switch (iMsg) { + case WM_CREATE: + /* client window creation */ + window_title(&title); + hClientWnd = CreateWindowEx(WS_EX_CLIENTEDGE, szClientClass, title.name, + WS_CHILD|WS_VISIBLE|WS_VSCROLL|WS_HSCROLL, + CW_USEDEFAULT, CW_USEDEFAULT, + CW_USEDEFAULT, CW_USEDEFAULT, + hwnd, (HMENU)0, hInstance, NULL); + free_window_title(&title); + hTBWnd = InitToolBar(hwnd); + UpdateWindow (hClientWnd); + return 0; + case WM_SIZE : + if (IsWindowVisible(hTBWnd)) { + SendMessage(hTBWnd,TB_AUTOSIZE,0,0L); + GetWindowRect(hTBWnd,&r); + cy = r.bottom-r.top; + } else cy = 0; + MoveWindow(hClientWnd,0,cy,LOWORD(lParam),HIWORD(lParam)-cy,TRUE); + return 0; + case WM_ERASEBKGND: + return 1; + case WM_SETFOCUS : + CreateCaret(hClientWnd, NULL, cxChar, cyChar); + SetCaretPos(GetXFromCurrentY(GetDC(hwnd),0,cur_x), (cur_y-iVscrollPos)*cyChar); + ShowCaret(hClientWnd); + return 0; + case WM_KILLFOCUS: + HideCaret(hClientWnd); + DestroyCaret(); + return 0; + case WM_INITMENUPOPUP : + if (lParam == 0) /* File popup menu */ + { + EnableMenuItem((HMENU)wParam, IDMENU_STARTLOG, + logfile ? MF_GRAYED : MF_ENABLED); + EnableMenuItem((HMENU)wParam, IDMENU_STOPLOG, + logfile ? MF_ENABLED : MF_GRAYED); + return 0; + } + else if (lParam == 1) /* Edit popup menu */ + { + EnableMenuItem((HMENU)wParam, IDMENU_COPY, + fTextSelected ? MF_ENABLED : MF_GRAYED); + EnableMenuItem((HMENU)wParam, IDMENU_PASTE, + IsClipboardFormatAvailable(CF_TEXT) ? MF_ENABLED : MF_GRAYED); + return 0; + } + else if (lParam == 3) /* View popup menu */ + { + CheckMenuItem((HMENU)wParam,IDMENU_TOOLBAR, + IsWindowVisible(hTBWnd) ? MF_CHECKED : MF_UNCHECKED); + return 0; + } + break; + case WM_NOTIFY: + switch (((LPNMHDR) lParam)->code) { + case TTN_NEEDTEXT: + { + LPTOOLTIPTEXT lpttt; + lpttt = (LPTOOLTIPTEXT) lParam; + lpttt->hinst = hInstance; + /* check for combobox handle */ + if (lpttt->uFlags&TTF_IDISHWND) { + if ((lpttt->hdr.idFrom == (UINT) hComboWnd)) { + lstrcpy(lpttt->lpszText,TEXT("Command History")); + break; + } + } + /* check for toolbar buttons */ + switch (lpttt->hdr.idFrom) { + case IDMENU_COPY: + lstrcpy(lpttt->lpszText,TEXT("Copy (Ctrl+C)")); + break; + case IDMENU_PASTE: + lstrcpy(lpttt->lpszText,TEXT("Paste (Ctrl+V)")); + break; + case IDMENU_FONT: + lstrcpy(lpttt->lpszText,TEXT("Fonts")); + break; + case IDMENU_ABOUT: + lstrcpy(lpttt->lpszText,TEXT("Help")); + break; + } + } + } + break; + case WM_COMMAND: + switch(LOWORD(wParam)) + { + case IDMENU_STARTLOG: + OpenLogFile(hwnd); + return 0; + case IDMENU_STOPLOG: + CloseLogFile(hwnd); + return 0; + case IDMENU_EXIT: + SendMessage(hwnd, WM_CLOSE, 0, 0L); + return 0; + case IDMENU_COPY: + if (fTextSelected) + OnEditCopy(hClientWnd); + return 0; + case IDMENU_PASTE: + OnEditPaste(hClientWnd); + return 0; + case IDMENU_SELALL: + OnEditSelAll(hClientWnd); + return 0; + case IDMENU_FONT: + if (ConChooseFont(hClientWnd)) { + ConSetFont(hClientWnd); + } + SaveUserPreferences(); + return 0; + case IDMENU_SELECTBKG: + ConChooseColor(hClientWnd); + SaveUserPreferences(); + return 0; + case IDMENU_TOOLBAR: + if (toolbarVisible) { + ShowWindow(hTBWnd,SW_HIDE); + toolbarVisible = FALSE; + } else { + ShowWindow(hTBWnd,SW_SHOW); + toolbarVisible = TRUE; + } + GetClientRect(hwnd,&r); + PostMessage(hwnd,WM_SIZE,0,MAKELPARAM(r.right,r.bottom)); + return 0; + case IDMENU_ABOUT: + DialogBox(beam_module,TEXT("AboutBox"),hwnd,AboutDlgProc); + return 0; + case ID_COMBOBOX: + switch (HIWORD(wParam)) { + case CBN_SELENDOK: + i = SendMessage(hComboWnd,CB_GETCURSEL,0,0); + if (i != CB_ERR) { + buf[0] = 0x01; /* CTRL+A */ + buf[1] = 0x0B; /* CTRL+K */ + bufsize = SendMessage(hComboWnd,CB_GETLBTEXT,i,(LPARAM)&buf[2]); + if (bufsize != CB_ERR) + write_inbuf(buf,bufsize+2); + SetFocus(hwnd); + } + break; + case CBN_SELENDCANCEL: + break; + } + break; + case ID_BREAK: /* CTRL+BRK */ + /* pass on break char if the ctrl_handler is disabled */ + if ((*ctrl_handler)(CTRL_C_EVENT) == FALSE) { + c = 0x03; + write_inbuf(&c,1); + } + return 0; + } + break; + case WM_KEYDOWN : + switch (wParam) { + case VK_UP: c = 'P'-'@'; break; + case VK_DOWN : c = 'N'-'@'; break; + case VK_RIGHT : c = 'F'-'@'; break; + case VK_LEFT : c = 'B'-'@'; break; + case VK_DELETE : c = 'D' -'@'; break; + case VK_HOME : c = 'A'-'@'; break; + case VK_END : c = 'E'-'@'; break; + case VK_RETURN : AddToCmdHistory(); return 0; + case VK_PRIOR : /* PageUp */ + PostMessage(hClientWnd, WM_VSCROLL, SB_PAGEUP, 0); + return 0; + case VK_NEXT : /* PageDown */ + PostMessage(hClientWnd, WM_VSCROLL, SB_PAGEDOWN, 0); + return 0; + default: return 0; + } + write_inbuf(&c, 1); + return 0; + case WM_CHAR: + c = (TCHAR)wParam; + write_inbuf(&c,1); + return 0; + case WM_CLOSE : + break; + case WM_DESTROY : + SaveUserPreferences(); + destroyed = TRUE; + PostQuitMessage(0); + return 0; + case WM_SAVE_PREFS : + SaveUserPreferences(); + return 0; + } + return DefWindowProc(hwnd, iMsg, wParam, lParam); +} + +static BOOL +Client_OnCreate(HWND hwnd, LPCREATESTRUCT lpCreateStruct) +{ + ConFontInitialize(hwnd); + cur_x = cur_y = 0; + iVscrollPos = 0; + iHscrollPos = 0; + return TRUE; +} + +static void +Client_OnPaint(HWND hwnd) +{ + ScreenLine_t *pLine; + int x,y,i,iTop,iBot; + PAINTSTRUCT ps; + RECT rcInvalid; + HDC hdc; + + hdc = BeginPaint(hwnd, &ps); + rcInvalid = ps.rcPaint; + hdc = ps.hdc; + iTop = max(0, iVscrollPos + rcInvalid.top/cyChar); + iBot = min(nBufLines, iVscrollPos + rcInvalid.bottom/cyChar+1); + pLine = GetLineFromY(iTop); + for (i = iTop; i < iBot && pLine != NULL; i++) { + y = cyChar*(i-iVscrollPos); + x = -cxChar*iHscrollPos; + TextOut(hdc, x, y, &pLine->text[0], pLine->width); + pLine = pLine->next; + } + if (fTextSelected || fSelecting) { + InvertSelectionArea(hwnd); + } + SetCaretPos(GetXFromCurrentY(hdc,iHscrollPos,cur_x), (cur_y-iVscrollPos)*cyChar); + EndPaint(hwnd, &ps); +} +#ifdef HARDDEBUG +static void dump_linebufs(void) { + char *buff; + ScreenLine_t *s = buffer_top; + fprintf(stderr,"LinebufDump------------------------\n"); + while(s) { + if (s == buffer_top) fprintf(stderr,"BT-> "); + if (s == buffer_bottom) fprintf(stderr,"BB-> "); + if (s == cur_line) fprintf(stderr,"CL-> "); + + buff = (char *) ALLOC(s->width+1); + memcpy(buff,s->text,s->width); + buff[s->width] = '\0'; + fprintf(stderr,"{\"%s\",%d,%d}\n",buff,s->newline,s->allocated); + FREE(buff); + s = s->next; + } + fprintf(stderr,"LinebufDumpEnd---------------------\n"); + fflush(stderr); +} +#endif + +static void reorganize_linebufs(HWND hwnd) { + ScreenLine_t *otop = buffer_top; + ScreenLine_t *obot = buffer_bottom; + ScreenLine_t *next; + int i,cpos; + + cpos = 0; + i = nBufLines - cur_y; + while (i > 1) { + cpos += obot->width; + obot = obot->prev; + i--; + } + cpos += (obot->width - cur_x); +#ifdef HARDDEBUG + fprintf(stderr,"nBufLines = %d, cur_x = %d, cur_y = %d, cpos = %d\n", + nBufLines,cur_x,cur_y,cpos); + fflush(stderr); +#endif + + + nBufLines = 0; + buffer_top = cur_line = ConNewLine(); + cur_line->next = buffer_bottom = ConNewLine(); + buffer_bottom->prev = cur_line; + + cur_x = cur_y = 0; + iVscrollPos = 0; + iHscrollPos = 0; + + while(otop) { + for(i=0;iwidth;++i) { + cur_line->text[cur_x] = otop->text[i]; + cur_x++; + if (cur_x > cur_line->width) + cur_line->width = cur_x; + if (GetXFromCurrentY(GetDC(hwnd),0,cur_x) + cxChar > + (LINE_LENGTH * cxChar)) { + ConCarriageFeed(0); + } + } + if (otop->newline) { + ConCarriageFeed(1); + /*ConScrollScreen();*/ + } + next = otop->next; + FREE(otop->text); + FREE(otop); + otop = next; + } + while (cpos) { + cur_x--; + if (cur_x < 0) { + cur_y--; + cur_line = cur_line->prev; + cur_x = cur_line->width-1; + } + cpos--; + } + SetCaretPos(GetXFromCurrentY(GetDC(hwnd),iHscrollPos,cur_x), (cur_y-iVscrollPos)*cyChar); +#ifdef HARDDEBUG + fprintf(stderr,"canvasColumns = %d,nBufLines = %d, cur_x = %d, cur_y = %d\n", + canvasColumns,nBufLines,cur_x,cur_y); + fflush(stderr); +#endif +} + + +static void +Client_OnSize(HWND hwnd, UINT state, int cx, int cy) +{ + RECT r; + SCROLLBARINFO sbi; + int w,h,columns; + int scrollheight; + cxClient = cx; + cyClient = cy; + set_scroll_info(hwnd); + GetClientRect(hwnd,&r); + w = r.right - r.left; + h = r.bottom - r.top; + sbi.cbSize = sizeof(SCROLLBARINFO); + if (!GetScrollBarInfo(hwnd, OBJID_HSCROLL,&sbi) || + (sbi.rgstate[0] & STATE_SYSTEM_INVISIBLE)) { + scrollheight = 0; + } else { + scrollheight = sbi.rcScrollBar.bottom - sbi.rcScrollBar.top; + } + canvasRows = (h - scrollheight) / cyChar; + if (canvasRows < DEF_CANVAS_ROWS) { + canvasRows = DEF_CANVAS_ROWS; + } + columns = (w - GetSystemMetrics(SM_CXVSCROLL)) /cxChar; + if (columns < DEF_CANVAS_COLUMNS) + columns = DEF_CANVAS_COLUMNS; + if (columns != canvasColumns) { + canvasColumns = columns; + /*dump_linebufs();*/ + reorganize_linebufs(hwnd); + fSelecting = fTextSelected = FALSE; + InvalidateRect(hwnd, NULL, TRUE); +#ifdef HARDDEBUG + fprintf(stderr,"Paint: cols = %d, rows = %d\n",canvasColumns,canvasRows); + fflush(stderr); +#endif + } + + SetCaretPos(GetXFromCurrentY(GetDC(hwnd),iHscrollPos,cur_x), (cur_y-iVscrollPos)*cyChar); +} + +static void calc_charpoint_from_point(HDC dc, int x, int y, int y_offset, POINT *pt) +{ + int r; + int hscrollPix = iHscrollPos * cxChar; + + pt->y = y/cyChar + iVscrollPos + y_offset; + + if (x > (LINE_LENGTH-iHscrollPos) * cxChar) { + x = (LINE_LENGTH-iHscrollPos) * cxChar; + } + if (pt->y - y_offset > 0 && GetLineFromY(pt->y - y_offset) == NULL) { + pt->y = nBufLines - 1 + y_offset; + pt->x = GetLineFromY(pt->y - y_offset)->width; + } else { + for (pt->x = 1; + (r = GetXFromLine(dc, 0, pt->x, GetLineFromY(pt->y - y_offset))) != 0 && + (r - hscrollPix) < x; + ++(pt->x)) + ; + if ((r - hscrollPix) > x) + --(pt->x); +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"pt->x = %d, iHscrollPos = %d\n",(int) pt->x, iHscrollPos); + fflush(stderr); +#endif + if (pt->x <= 0) { + pt->x = x/cxChar + iHscrollPos; + } + } +} + + +static void +Client_OnLButtonDown(HWND hwnd, BOOL fDoubleClick, int x, int y, UINT keyFlags) +{ + int r; + SetFocus(GetParent(hwnd)); /* In case combobox steals the focus */ +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"OnLButtonDown fSelecting = %d, fTextSelected = %d:\n", + fSelecting,fTextSelected); + fflush(stderr); +#endif + if (fTextSelected) { + InvertSelectionArea(hwnd); + } + fTextSelected = FALSE; + + calc_charpoint_from_point(GetDC(hwnd), x, y, 0, &editBeg); + + editEnd.x = editBeg.x; + editEnd.y = editBeg.y + 1; + fSelecting = TRUE; + SetCapture(hwnd); +} + +static void +Client_OnRButtonDown(HWND hwnd, BOOL fDoubleClick, int x, int y, UINT keyFlags) +{ + if (fTextSelected) { + fSelecting = TRUE; + Client_OnMouseMove(hwnd,x,y,keyFlags); + fSelecting = FALSE; + } +} + +static void +Client_OnLButtonUp(HWND hwnd, int x, int y, UINT keyFlags) +{ +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"OnLButtonUp fSelecting = %d, fTextSelected = %d:\n", + fSelecting,fTextSelected); + fprintf(stderr,"(Beg.x = %d, Beg.y = %d, " + "End.x = %d, End.y = %d)\n",editBeg.x,editBeg.y, + editEnd.x,editEnd.y); +#endif + if (fSelecting && + !(editBeg.x == editEnd.x && editBeg.y == (editEnd.y - 1))) { + fTextSelected = TRUE; + } +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"OnLButtonUp fTextSelected = %d:\n", + fTextSelected); + fflush(stderr); +#endif + fSelecting = FALSE; + ReleaseCapture(); +} + +#define EMPTY_RECT(R) \ +(((R).bottom - (R).top == 0) || ((R).right - (R).left == 0)) +#define ABS(X) (((X)< 0) ? -1 * (X) : X) +#define DIFF(A,B) ABS(((int)(A)) - ((int)(B))) + +static int diff_sel_area(RECT old[3], RECT new[3], RECT result[6]) +{ + int absposold = old[0].left + old[0].top * canvasColumns; + int absposnew = new[0].left + new[0].top * canvasColumns; + int absendold = absposold, absendnew = absposnew; + int i, x, ret = 0; + int abspos[2],absend[2]; + for(i = 0; i < 3; ++i) { + if (!EMPTY_RECT(old[i])) { + absendold += (old[i].right - old[i].left) * + (old[i].bottom - old[i].top); + } + if (!EMPTY_RECT(new[i])) { + absendnew += (new[i].right - new[i].left) * + (new[i].bottom - new[i].top); + } + } + abspos[0] = min(absposold, absposnew); + absend[0] = DIFF(absposold, absposnew) + abspos[0]; + abspos[1] = min(absendold, absendnew); + absend[1] = DIFF(absendold, absendnew) + abspos[1]; +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"abspos[0] = %d, absend[0] = %d, abspos[1] = %d, absend[1] = %d\n",abspos[0],absend[0],abspos[1],absend[1]); + fflush(stderr); +#endif + i = 0; + for (x = 0; x < 2; ++x) { + if (abspos[x] != absend[x]) { + int consumed = 0; + result[i].left = abspos[x] % canvasColumns; + result[i].top = abspos[x] / canvasColumns; + result[i].bottom = result[i].top + 1; + if ((absend[x] - abspos[x]) + result[i].left < canvasColumns) { +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"Nowrap, %d < canvasColumns\n", + (absend[x] - abspos[x]) + result[i].left); + fflush(stderr); +#endif + result[i].right = (absend[x] - abspos[x]) + result[i].left; + consumed += result[i].right - result[i].left; + } else { +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"Wrap, %d >= canvasColumns\n", + (absend[x] - abspos[x]) + result[i].left); + fflush(stderr); +#endif + result[i].right = canvasColumns; + consumed += result[i].right - result[i].left; + if (absend[x] - abspos[x] - consumed >= canvasColumns) { + ++i; + result[i].top = result[i-1].bottom; + result[i].left = 0; + result[i].right = canvasColumns; + result[i].bottom = (absend[x] - abspos[x] - consumed) / canvasColumns + result[i].top; + consumed += (result[i].bottom - result[i].top) * canvasColumns; + } + if (absend[x] - abspos[x] - consumed > 0) { + ++i; + result[i].top = result[i-1].bottom; + result[i].bottom = result[i].top + 1; + result[i].left = 0; + result[i].right = absend[x] - abspos[x] - consumed; + } + } + ++i; + } + } +#ifdef HARD_SEL_DEBUG + if (i > 2) { + int x; + fprintf(stderr,"i = %d\n",i); + fflush(stderr); + for (x = 0; x < i; ++x) { + fprintf(stderr, "result[%d]: top = %d, left = %d, " + "bottom = %d. right = %d\n", + x, result[x].top, result[x].left, + result[x].bottom, result[x].right); + } + } +#endif + return i; +} + + + +static void calc_sel_area(RECT rects[3], POINT beg, POINT end) +{ + /* These are not really rects and points, these are character + based positions, need to be multiplied by cxChar and cyChar to + make up canvas coordinates */ + memset(rects,0,3*sizeof(RECT)); + rects[0].left = beg.x; + rects[0].top = beg.y; + rects[0].bottom = beg.y+1; + if (end.y - beg.y == 1) { /* Only one row */ + rects[0].right = end.x; + goto out; + } + rects[0].right = canvasColumns; + if (end.y - beg.y > 2) { + rects[1].left = 0; + rects[1].top = rects[0].bottom; + rects[1].right = canvasColumns; + rects[1].bottom = end.y - 1; + } + rects[2].left = 0; + rects[2].top = end.y - 1; + rects[2].bottom = end.y; + rects[2].right = end.x; + + out: +#ifdef HARD_SEL_DEBUG + { + int i; + fprintf(stderr,"beg.x = %d, beg.y = %d, end.x = %d, end.y = %d\n", + beg.x,beg.y,end.x,end.y); + for (i = 0; i < 3; ++i) { + fprintf(stderr,"[%d] left = %d, top = %d, " + "right = %d, bottom = %d\n", + i, rects[i].left, rects[i].top, + rects[i].right, rects[i].bottom); + } + fflush(stderr); + } +#endif + return; +} + +static void calc_sel_area_turned(RECT rects[3], POINT eBeg, POINT eEnd) { + POINT from,to; + if (eBeg.y >= eEnd.y || + (eBeg.y == eEnd.y - 1 && eBeg.x > eEnd.x)) { +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"Reverting (Beg.x = %d, Beg.y = %d, " + "End.x = %d, End.y = %d)\n",eBeg.x,eBeg.y, + eEnd.x,eEnd.y); + fflush(stderr); +#endif + from.x = eEnd.x; + from.y = eEnd.y - 1; + to.x = eBeg.x; + to.y = eBeg.y + 1; + calc_sel_area(rects,from,to); + } else { + calc_sel_area(rects,eBeg,eEnd); + } +} + + +static void InvertSelectionArea(HWND hwnd) +{ + RECT rects[3]; + POINT from,to; + int i; + calc_sel_area_turned(rects,editBeg,editEnd); + for (i = 0; i < 3; ++i) { + if (!EMPTY_RECT(rects[i])) { + from.x = rects[i].left; + to.x = rects[i].right; + from.y = rects[i].top; + to.y = rects[i].bottom; + DrawSelection(hwnd,from,to); + } + } +} + +static void +Client_OnMouseMove(HWND hwnd, int x, int y, UINT keyFlags) +{ + if (fSelecting) { + RECT rold[3], rnew[3], rupdate[6]; + int num_updates,i,r; + POINT from,to; + calc_sel_area_turned(rold,editBeg,editEnd); + + calc_charpoint_from_point(GetDC(hwnd), x, y, 1, &editEnd); + + calc_sel_area_turned(rnew,editBeg,editEnd); + num_updates = diff_sel_area(rold,rnew,rupdate); + for (i = 0; i < num_updates;++i) { + from.x = rupdate[i].left; + to.x = rupdate[i].right; + from.y = rupdate[i].top; + to.y = rupdate[i].bottom; +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"from: x=%d,y=%d, to: x=%d, y=%d\n", + from.x, from.y,to.x,to.y); + fflush(stderr); +#endif + DrawSelection(hwnd,from,to); + } + } +} + +static void +Client_OnVScroll(HWND hwnd, HWND hwndCtl, UINT code, int pos) +{ + int iVscroll; + + switch(code) { + case SB_LINEDOWN: + iVscroll = 1; + break; + case SB_LINEUP: + iVscroll = -1; + break; + case SB_PAGEDOWN: + iVscroll = max(1, cyClient/cyChar); + break; + case SB_PAGEUP: + iVscroll = min(-1, -cyClient/cyChar); + break; + case SB_THUMBTRACK: + iVscroll = pos - iVscrollPos; + break; + default: + iVscroll = 0; + } + iVscroll = max(-iVscrollPos, min(iVscroll, iVscrollMax-iVscrollPos)); + if (iVscroll != 0) { + iVscrollPos += iVscroll; + ScrollWindowEx(hwnd, 0, -cyChar*iVscroll, NULL, NULL, + NULL, NULL, SW_ERASE | SW_INVALIDATE); + SetScrollPos(hwnd, SB_VERT, iVscrollPos, TRUE); + iVscroll = GetScrollPos(hwnd, SB_VERT); + UpdateWindow(hwnd); + } +} + +static void +Client_OnHScroll(HWND hwnd, HWND hwndCtl, UINT code, int pos) +{ + int iHscroll, curCharWidth = cxClient/cxChar; + + switch(code) { + case SB_LINEDOWN: + iHscroll = 1; + break; + case SB_LINEUP: + iHscroll = -1; + break; + case SB_PAGEDOWN: + iHscroll = max(1,curCharWidth-1); + break; + case SB_PAGEUP: + iHscroll = min(-1,-(curCharWidth-1)); + break; + case SB_THUMBTRACK: + iHscroll = pos - iHscrollPos; + break; + default: + iHscroll = 0; + } + iHscroll = max(-iHscrollPos, min(iHscroll, iHscrollMax-iHscrollPos-(curCharWidth-1))); + if (iHscroll != 0) { + iHscrollPos += iHscroll; + ScrollWindow(hwnd, -cxChar*iHscroll, 0, NULL, NULL); + SetScrollPos(hwnd, SB_HORZ, iHscrollPos, TRUE); + UpdateWindow(hwnd); + } +} + +static LRESULT CALLBACK +ClientWndProc(HWND hwnd, UINT iMsg, WPARAM wParam, LPARAM lParam) +{ + switch (iMsg) { + HANDLE_MSG(hwnd, WM_CREATE, Client_OnCreate); + HANDLE_MSG(hwnd, WM_SIZE, Client_OnSize); + HANDLE_MSG(hwnd, WM_PAINT, Client_OnPaint); + HANDLE_MSG(hwnd, WM_LBUTTONDOWN, Client_OnLButtonDown); + HANDLE_MSG(hwnd, WM_RBUTTONDOWN, Client_OnRButtonDown); + HANDLE_MSG(hwnd, WM_LBUTTONUP, Client_OnLButtonUp); + HANDLE_MSG(hwnd, WM_MOUSEMOVE, Client_OnMouseMove); + HANDLE_MSG(hwnd, WM_VSCROLL, Client_OnVScroll); + HANDLE_MSG(hwnd, WM_HSCROLL, Client_OnHScroll); + case WM_CONBEEP: + if (0) Beep(440, 400); + return 0; + case WM_CONTEXT: + ConDrawText(hwnd); + return 0; + case WM_CLOSE: + break; + case WM_DESTROY: + PostQuitMessage(0); + return 0; + } + return DefWindowProc (hwnd, iMsg, wParam, lParam); +} + +static void +LoadUserPreferences(void) +{ + DWORD size; + DWORD res; + DWORD type; + + /* default prefs */ + GetObject(GetStockObject(SYSTEM_FIXED_FONT),sizeof(LOGFONT),(PSTR)&logfont); + fgColor = GetSysColor(COLOR_WINDOWTEXT); + bkgColor = GetSysColor(COLOR_WINDOW); + winPos.left = -1; + toolbarVisible = TRUE; + + if (RegCreateKeyEx(HKEY_CURRENT_USER, USER_KEY, 0, 0, + REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NULL, + &key, &res) != ERROR_SUCCESS) + return; + has_key = TRUE; + if (res == REG_CREATED_NEW_KEY) + return; + size = sizeof(logfont); + res = RegQueryValueEx(key,TEXT("Font"),NULL,&type,(LPBYTE)&logfont,&size); + size = sizeof(fgColor); + res = RegQueryValueEx(key,TEXT("FgColor"),NULL,&type,(LPBYTE)&fgColor,&size); + size = sizeof(bkgColor); + res = RegQueryValueEx(key,TEXT("BkColor"),NULL,&type,(LPBYTE)&bkgColor,&size); + size = sizeof(winPos); + res = RegQueryValueEx(key,TEXT("Pos"),NULL,&type,(LPBYTE)&winPos,&size); + size = sizeof(toolbarVisible); + res = RegQueryValueEx(key,TEXT("Toolbar"),NULL,&type,(LPBYTE)&toolbarVisible,&size); +} + +static void +SaveUserPreferences(void) +{ + WINDOWPLACEMENT wndPlace; + + if (has_key == TRUE) { + RegSetValueEx(key,TEXT("Font"),0,REG_BINARY,(CONST BYTE *)&logfont,sizeof(LOGFONT)); + RegSetValueEx(key,TEXT("FgColor"),0,REG_DWORD,(CONST BYTE *)&fgColor,sizeof(fgColor)); + RegSetValueEx(key,TEXT("BkColor"),0,REG_DWORD,(CONST BYTE *)&bkgColor,sizeof(bkgColor)); + RegSetValueEx(key,TEXT("Toolbar"),0,REG_DWORD,(CONST BYTE *)&toolbarVisible,sizeof(toolbarVisible)); + + wndPlace.length = sizeof(WINDOWPLACEMENT); + GetWindowPlacement(hFrameWnd,&wndPlace); + /* If wndPlace.showCmd == SW_MINIMIZE, then the window is minimized. + We don't care, wndPlace.rcNormalPosition always holds the last known position. */ + winPos = wndPlace.rcNormalPosition; + RegSetValueEx(key,TEXT("Pos"),0,REG_BINARY,(CONST BYTE *)&winPos,sizeof(winPos)); + } +} + + +static void +set_scroll_info(HWND hwnd) +{ + SCROLLINFO info; + int hScrollBy; + /* + * Set vertical scrolling range and scroll box position. + */ + + iVscrollMax = nBufLines-1; + iVscrollPos = min(iVscrollPos, iVscrollMax); + info.cbSize = sizeof(info); + info.fMask = SIF_PAGE|SIF_RANGE|SIF_POS; + info.nMin = 0; + info.nPos = iVscrollPos; + info.nPage = min(cyClient/cyChar, iVscrollMax); + info.nMax = iVscrollMax; + SetScrollInfo(hwnd, SB_VERT, &info, TRUE); + + /* + * Set horizontal scrolling range and scroll box position. + */ + + iHscrollMax = LINE_LENGTH-1; + hScrollBy = max(0, (iHscrollPos - (iHscrollMax-cxClient/cxChar))*cxChar); + iHscrollPos = min(iHscrollPos, iHscrollMax); + info.nPos = iHscrollPos; + info.nPage = cxClient/cxChar; + info.nMax = iHscrollMax; + SetScrollInfo(hwnd, SB_HORZ, &info, TRUE); + /*ScrollWindow(hwnd, hScrollBy, 0, NULL, NULL);*/ +} + + +static void +ensure_line_below(void) +{ + if (cur_line->next == NULL) { + if (nBufLines >= lines_to_save) { + ScreenLine_t* pLine = buffer_top->next; + FREE(buffer_top->text); + FREE(buffer_top); + buffer_top = pLine; + buffer_top->prev = NULL; + nBufLines--; + } + cur_line->next = ConNewLine(); + cur_line->next->prev = cur_line; + buffer_bottom = cur_line->next; + set_scroll_info(hClientWnd); + } +} + +static ScreenLine_t* +ConNewLine(void) +{ + ScreenLine_t *pLine; + + pLine = (ScreenLine_t *)ALLOC(sizeof(ScreenLine_t)); + if (!pLine) + return NULL; + pLine->text = (TCHAR *) ALLOC(canvasColumns * sizeof(TCHAR)); +#ifdef HARDDEBUG + pLine->allocated = canvasColumns; +#endif + pLine->width = 0; + pLine->prev = pLine->next = NULL; + pLine->newline = 0; + nBufLines++; + return pLine; +} + +static ScreenLine_t* +GetLineFromY(int y) +{ + ScreenLine_t *pLine = buffer_top; + int i; + + for (i = 0; i < nBufLines && pLine != NULL; i++) { + if (i == y) + return pLine; + pLine = pLine->next; + } + return NULL; +} + +void ConCarriageFeed(int hard_newline) +{ + cur_x = 0; + ensure_line_below(); + cur_line->newline = hard_newline; + cur_line = cur_line->next; + if (cur_y < nBufLines-1) { + cur_y++; + } else if (iVscrollPos > 0) { + iVscrollPos--; + } +} + +/* + * Scroll screen if cursor is not visible. + */ +static void +ConScrollScreen(void) +{ + if (cur_y >= iVscrollPos + cyClient/cyChar) { + int iVscroll; + + iVscroll = cur_y - iVscrollPos - cyClient/cyChar + 1; + iVscrollPos += iVscroll; + ScrollWindowEx(hClientWnd, 0, -cyChar*iVscroll, NULL, NULL, + NULL, NULL, SW_ERASE | SW_INVALIDATE); + SetScrollPos(hClientWnd, SB_VERT, iVscrollPos, TRUE); + UpdateWindow(hClientWnd); + } +} + +static void +DrawSelection(HWND hwnd, POINT pt1, POINT pt2) +{ + HDC hdc; + int width,height; +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"pt1.x = %d, pt1.y = %d, pt2.x = %d, pt2.y = %d\n", + (int) pt1.x, (int) pt1.y, (int) pt2.x, (int) pt2.y); +#endif + pt1.x = GetXFromLine(GetDC(hwnd),iHscrollPos,pt1.x,GetLineFromY(pt1.y)); + pt2.x = GetXFromLine(GetDC(hwnd),iHscrollPos,pt2.x,GetLineFromY(pt2.y-1)); + pt1.y -= iVscrollPos; + pt2.y -= iVscrollPos; + pt1.y *= cyChar; + pt2.y *= cyChar; +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"pt1.x = %d, pt1.y = %d, pt2.x = %d, pt2.y = %d\n", + (int) pt1.x, (int) pt1.y, (int) pt2.x, (int) pt2.y); + fflush(stderr); +#endif + width = pt2.x-pt1.x; + height = pt2.y - pt1.y; + hdc = GetDC(hwnd); + PatBlt(hdc,pt1.x,pt1.y,width,height,DSTINVERT); + ReleaseDC(hwnd,hdc); +} + +static void +OnEditCopy(HWND hwnd) +{ + HGLOBAL hMem; + TCHAR *pMem; + ScreenLine_t *pLine; + RECT rects[3]; + POINT from,to; + int i,j,sum,len; + if (editBeg.y >= editEnd.y || + (editBeg.y == editEnd.y - 1 && editBeg.x > editEnd.x)) { +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"CopyReverting (Beg.x = %d, Beg.y = %d, " + "End.x = %d, End.y = %d)\n",editBeg.x,editBeg.y, + editEnd.x,editEnd.y); + fflush(stderr); +#endif + from.x = editEnd.x; + from.y = editEnd.y - 1; + to.x = editBeg.x; + to.y = editBeg.y + 1; + calc_sel_area(rects,from,to); + } else { + calc_sel_area(rects,editBeg,editEnd); + } + sum = 1; + for (i = 0; i < 3; ++i) { + if (!EMPTY_RECT(rects[i])) { + pLine = GetLineFromY(rects[i].top); + for (j = rects[i].top; j < rects[i].bottom ;++j) { + if (pLine == NULL) { + sum += 2; + break; + } + if (pLine->width > rects[i].left) { + sum += (pLine->width < rects[i].right) ? + pLine->width - rects[i].left : + rects[i].right - rects[i].left; + } + if(pLine->newline && rects[i].right >= pLine->width) { + sum += 2; + } + pLine = pLine->next; + } + } + } +#ifdef HARD_SEL_DEBUG + fprintf(stderr,"sum = %d\n",sum); + fflush(stderr); +#endif + hMem = GlobalAlloc(GHND, sum * sizeof(TCHAR)); + pMem = GlobalLock(hMem); + for (i = 0; i < 3; ++i) { + if (!EMPTY_RECT(rects[i])) { + pLine = GetLineFromY(rects[i].top); + for (j = rects[i].top; j < rects[i].bottom; ++j) { + if (pLine == NULL) { + memcpy(pMem,TEXT("\r\n"),2 * sizeof(TCHAR)); + pMem += 2; + break; + } + if (pLine->width > rects[i].left) { + len = (pLine->width < rects[i].right) ? + pLine->width - rects[i].left : + rects[i].right - rects[i].left; + memcpy(pMem,pLine->text + rects[i].left,len * sizeof(TCHAR)); + pMem +=len; + } + if(pLine->newline && rects[i].right >= pLine->width) { + memcpy(pMem,TEXT("\r\n"),2 * sizeof(TCHAR)); + pMem += 2; + } + pLine = pLine->next; + } + } + } + *pMem = TEXT('\0'); + /* Flash de selection area to give user feedback about copying */ + InvertSelectionArea(hwnd); + Sleep(100); + InvertSelectionArea(hwnd); + + OpenClipboard(hwnd); + EmptyClipboard(); + GlobalUnlock(hMem); + SetClipboardData(CF_UNICODETEXT,hMem); + CloseClipboard(); +} + +/* XXX:PaN Tchar or char? */ +static void +OnEditPaste(HWND hwnd) +{ + HANDLE hClipMem; + TCHAR *pClipMem,*pMem,*pMem2; + if (!OpenClipboard(hwnd)) + return; + if ((hClipMem = GetClipboardData(CF_UNICODETEXT)) != NULL) { + pClipMem = GlobalLock(hClipMem); + pMem = (TCHAR *)ALLOC(GlobalSize(hClipMem) * sizeof(TCHAR)); + pMem2 = pMem; + while ((*pMem2 = *pClipMem) != TEXT('\0')) { + if (*pClipMem == TEXT('\r')) + *pMem2 = TEXT('\n'); + ++pMem2; + ++pClipMem; + } + GlobalUnlock(hClipMem); + write_inbuf(pMem, _tcsclen(pMem)); + } + CloseClipboard(); +} + +static void +OnEditSelAll(HWND hwnd) +{ + editBeg.x = 0; + editBeg.y = 0; + editEnd.x = LINE_LENGTH-1; + editEnd.y = cur_y; + fTextSelected = TRUE; + InvalidateRect(hwnd, NULL, TRUE); +} + +UINT APIENTRY CFHookProc(HWND hDlg,UINT iMsg,WPARAM wParam,LPARAM lParam) +{ + /* Hook procedure for font dialog box */ + HWND hOwner; + RECT rc,rcOwner,rcDlg; + switch (iMsg) { + case WM_INITDIALOG: + /* center dialogbox within its owner window */ + if ((hOwner = GetParent(hDlg)) == NULL) + hOwner = GetDesktopWindow(); + GetWindowRect(hOwner, &rcOwner); + GetWindowRect(hDlg, &rcDlg); + CopyRect(&rc, &rcOwner); + OffsetRect(&rcDlg, -rcDlg.left, -rcDlg.top); + OffsetRect(&rc, -rc.left, -rc.top); + OffsetRect(&rc, -rcDlg.right, -rcDlg.bottom); + SetWindowPos(hDlg,HWND_TOP,rcOwner.left + (rc.right / 2), + rcOwner.top + (rc.bottom / 2),0,0,SWP_NOSIZE); + return 1; + default: + break; + } + return 0; /* Let the default procedure process the message */ +} + +static BOOL +ConChooseFont(HWND hwnd) +{ + HDC hdc; + hdc = GetDC(hwnd); + cf.lStructSize = sizeof(CHOOSEFONT); + cf.hwndOwner = hwnd; + cf.hDC = NULL; + cf.lpLogFont = &logfont; + cf.iPointSize = 0; + cf.Flags = CF_INITTOLOGFONTSTRUCT|CF_SCREENFONTS|CF_FIXEDPITCHONLY|CF_EFFECTS|CF_ENABLEHOOK; + cf.rgbColors = GetTextColor(hdc); + cf.lCustData = 0L; + cf.lpfnHook = CFHookProc; + cf.lpTemplateName = NULL; + cf.hInstance = NULL; + cf.lpszStyle = NULL; + cf.nFontType = 0; + cf.nSizeMin = 0; + cf.nSizeMax = 0; + ReleaseDC(hwnd,hdc); + return ChooseFont(&cf); +} + +static void +ConFontInitialize(HWND hwnd) +{ + HDC hdc; + TEXTMETRIC tm; + HFONT hFont; + + hFont = CreateFontIndirect(&logfont); + hdc = GetDC(hwnd); + SelectObject(hdc, hFont); + SetTextColor(hdc,fgColor); + SetBkColor(hdc,bkgColor); + GetTextMetrics(hdc, &tm); + cxChar = tm.tmAveCharWidth; + cxCharMax = tm.tmMaxCharWidth; + cyChar = tm.tmHeight + tm.tmExternalLeading; + ReleaseDC(hwnd, hdc); +} + +static void +ConSetFont(HWND hwnd) +{ + HDC hdc; + TEXTMETRIC tm; + HFONT hFontNew; + + hFontNew = CreateFontIndirect(&logfont); + SendMessage(hComboWnd,WM_SETFONT,(WPARAM)hFontNew, + MAKELPARAM(1,0)); + hdc = GetDC(hwnd); + DeleteObject(SelectObject(hdc, hFontNew)); + GetTextMetrics(hdc, &tm); + cxChar = tm.tmAveCharWidth; + cxCharMax = tm.tmMaxCharWidth; + cyChar = tm.tmHeight + tm.tmExternalLeading; + fgColor = cf.rgbColors; + SetTextColor(hdc,fgColor); + ReleaseDC(hwnd, hdc); + set_scroll_info(hwnd); + HideCaret(hwnd); + if (DestroyCaret()) { + CreateCaret(hwnd, NULL, cxChar, cyChar); + SetCaretPos(GetXFromCurrentY(hdc,iHscrollPos,cur_x), (cur_y-iVscrollPos)*cyChar); + } + ShowCaret(hwnd); + InvalidateRect(hwnd, NULL, TRUE); +} + +UINT APIENTRY +CCHookProc(HWND hDlg,UINT iMsg,WPARAM wParam,LPARAM lParam) +{ + /* Hook procedure for choose color dialog box */ + HWND hOwner; + RECT rc,rcOwner,rcDlg; + switch (iMsg) { + case WM_INITDIALOG: + /* center dialogbox within its owner window */ + if ((hOwner = GetParent(hDlg)) == NULL) + hOwner = GetDesktopWindow(); + GetWindowRect(hOwner, &rcOwner); + GetWindowRect(hDlg, &rcDlg); + CopyRect(&rc, &rcOwner); + OffsetRect(&rcDlg, -rcDlg.left, -rcDlg.top); + OffsetRect(&rc, -rc.left, -rc.top); + OffsetRect(&rc, -rcDlg.right, -rcDlg.bottom); + SetWindowPos(hDlg,HWND_TOP,rcOwner.left + (rc.right / 2), + rcOwner.top + (rc.bottom / 2),0,0,SWP_NOSIZE); + return 1; + default: + break; + } + return 0; /* Let the default procedure process the message */ +} + +void ConChooseColor(HWND hwnd) +{ + CHOOSECOLOR cc; + static COLORREF acrCustClr[16]; + HBRUSH hbrush; + HDC hdc; + + /* Initialize CHOOSECOLOR */ + ZeroMemory(&cc, sizeof(CHOOSECOLOR)); + cc.lStructSize = sizeof(CHOOSECOLOR); + cc.hwndOwner = hwnd; + cc.lpCustColors = (LPDWORD) acrCustClr; + cc.rgbResult = bkgColor; + cc.lpfnHook = CCHookProc; + cc.Flags = CC_FULLOPEN|CC_RGBINIT|CC_SOLIDCOLOR|CC_ENABLEHOOK; + + if (ChooseColor(&cc)==TRUE) { + bkgColor = cc.rgbResult; + hdc = GetDC(hwnd); + SetBkColor(hdc,bkgColor); + ReleaseDC(hwnd,hdc); + hbrush = CreateSolidBrush(bkgColor); + DeleteObject((HBRUSH)SetClassLong(hClientWnd,GCL_HBRBACKGROUND,(LONG)hbrush)); + InvalidateRect(hwnd,NULL,TRUE); + } +} + +UINT APIENTRY OFNHookProc(HWND hwndDlg,UINT iMsg,WPARAM wParam,LPARAM lParam) +{ + /* Hook procedure for open file dialog box */ + HWND hOwner,hDlg; + RECT rc,rcOwner,rcDlg; + hDlg = GetParent(hwndDlg); + switch (iMsg) { + case WM_INITDIALOG: + /* center dialogbox within its owner window */ + if ((hOwner = GetParent(hDlg)) == NULL) + hOwner = GetDesktopWindow(); + GetWindowRect(hOwner, &rcOwner); + GetWindowRect(hDlg, &rcDlg); + CopyRect(&rc, &rcOwner); + OffsetRect(&rcDlg, -rcDlg.left, -rcDlg.top); + OffsetRect(&rc, -rc.left, -rc.top); + OffsetRect(&rc, -rcDlg.right, -rcDlg.bottom); + SetWindowPos(hDlg,HWND_TOP,rcOwner.left + (rc.right / 2), + rcOwner.top + (rc.bottom / 2),0,0,SWP_NOSIZE); + return 1; + default: + break; + } + return 0; /* the let default procedure process the message */ +} + +static void +GetFileName(HWND hwnd, TCHAR *pFile) +{ + /* Open the File Open dialog box and */ + /* retrieve the file name */ + OPENFILENAME ofn; + TCHAR szFilterSpec [128] = TEXT("logfiles (*.log)\0*.log\0All files (*.*)\0*.*\0\0"); + #define MAXFILENAME 256 + TCHAR szFileName[MAXFILENAME]; + TCHAR szFileTitle[MAXFILENAME]; + + /* these need to be filled in */ + _tcscpy(szFileName, TEXT("erlshell.log")); + _tcscpy(szFileTitle, TEXT("")); /* must be NULL */ + + ofn.lStructSize = sizeof(OPENFILENAME); + ofn.hwndOwner = NULL; + ofn.lpstrFilter = szFilterSpec; + ofn.lpstrCustomFilter = NULL; + ofn.nMaxCustFilter = 0; + ofn.nFilterIndex = 0; + ofn.lpstrFile = szFileName; + ofn.nMaxFile = MAXFILENAME; + ofn.lpstrInitialDir = NULL; + ofn.lpstrFileTitle = szFileTitle; + ofn.nMaxFileTitle = MAXFILENAME; + ofn.lpstrTitle = TEXT("Open logfile"); + ofn.lpstrDefExt = TEXT("log"); + ofn.Flags = OFN_CREATEPROMPT|OFN_HIDEREADONLY|OFN_EXPLORER|OFN_ENABLEHOOK|OFN_NOCHANGEDIR; /* OFN_NOCHANGEDIR only works in Vista :( */ + ofn.lpfnHook = OFNHookProc; + + if (!GetOpenFileName ((LPOPENFILENAME)&ofn)){ + *pFile = TEXT('\0'); + } else { + _tcscpy(pFile, ofn.lpstrFile); + } +} + +void OpenLogFile(HWND hwnd) +{ + /* open a file for logging */ + TCHAR filename[_MAX_PATH]; + + GetFileName(hwnd, filename); + if (filename[0] == '\0') + return; + if (NULL == (logfile = _tfopen(filename,TEXT("w,ccs=UNICODE")))) + return; +} + +void CloseLogFile(HWND hwnd) +{ + /* close log file */ + fclose(logfile); + logfile = NULL; +} + +void LogFileWrite(TCHAR *buf, int num_chars) +{ + /* write to logfile */ + int from,to; + while (num_chars-- > 0) { + switch (*buf) { + case SET_CURSOR: + buf++; + from = *((int *)buf); + buf += sizeof(int)/sizeof(TCHAR); + to = *((int *)buf); + buf += (sizeof(int)/sizeof(TCHAR))-1; + num_chars -= 2 * (sizeof(int)/sizeof(TCHAR)); + // Wont seek in Unicode file, sorry... + // fseek(logfile,to-from *sizeof(TCHAR),SEEK_CUR); + break; + default: + _fputtc(*buf,logfile); + break; + } + buf++; + } +} + +static void +init_buffers(void) +{ + inbuf.data = (TCHAR *) ALLOC(BUFSIZE * sizeof(TCHAR)); + outbuf.data = (TCHAR *) ALLOC(BUFSIZE * sizeof(TCHAR)); + inbuf.size = BUFSIZE; + inbuf.rdPos = inbuf.wrPos = 0; + outbuf.size = BUFSIZE; + outbuf.rdPos = outbuf.wrPos = 0; +} + +static int +check_realloc(buffer_t *buf, int num_chars) +{ + if (buf->wrPos + num_chars >= buf->size) { + if (buf->size > MAXBUFSIZE) + return 0; + buf->size += num_chars + BUFSIZE; + if (!(buf->data = (TCHAR *)REALLOC(buf->data, buf->size * sizeof(TCHAR)))) { + buf->size = buf->rdPos = buf->wrPos = 0; + return 0; + } + } + return 1; +} + +static int +write_inbuf(TCHAR *data, int num_chars) +{ + TCHAR *buf; + int nwrite; + WaitForSingleObject(console_input,INFINITE); + if (!check_realloc(&inbuf,num_chars)) { + ReleaseSemaphore(console_input,1,NULL); + return -1; + } + buf = &inbuf.data[inbuf.wrPos]; + inbuf.wrPos += num_chars; + nwrite = num_chars; + while (nwrite--) + *buf++ = *data++; + SetEvent(console_input_event); + ReleaseSemaphore(console_input,1,NULL); + return num_chars; +} + +static int +write_outbuf(TCHAR *data, int num_chars) +{ + TCHAR *buf; + int nwrite; + + WaitForSingleObject(console_output,INFINITE); + if (!check_realloc(&outbuf, num_chars)) { + ReleaseSemaphore(console_output,1,NULL); + return -1; + } + if (outbuf.rdPos == outbuf.wrPos) + PostMessage(hClientWnd, WM_CONTEXT, 0L, 0L); + buf = &outbuf.data[outbuf.wrPos]; + outbuf.wrPos += num_chars; + nwrite = num_chars; + while (nwrite--) + *buf++ = *data++; + ReleaseSemaphore(console_output,1,NULL); + return num_chars; +} + +BOOL CALLBACK AboutDlgProc(HWND hDlg, UINT iMsg, WPARAM wParam, LPARAM lParam) +{ + HWND hOwner; + RECT rc,rcOwner,rcDlg; + + switch (iMsg) { + case WM_INITDIALOG: + /* center dialogbox within its owner window */ + if ((hOwner = GetParent(hDlg)) == NULL) + hOwner = GetDesktopWindow(); + GetWindowRect(hOwner, &rcOwner); + GetWindowRect(hDlg, &rcDlg); + CopyRect(&rc, &rcOwner); + OffsetRect(&rcDlg, -rcDlg.left, -rcDlg.top); + OffsetRect(&rc, -rc.left, -rc.top); + OffsetRect(&rc, -rcDlg.right, -rcDlg.bottom); + SetWindowPos(hDlg,HWND_TOP,rcOwner.left + (rc.right / 2), + rcOwner.top + (rc.bottom / 2),0,0,SWP_NOSIZE); + SetDlgItemText(hDlg, ID_VERSIONSTRING, + TEXT("Erlang emulator version ") TEXT(ERLANG_VERSION)); + return TRUE; + case WM_COMMAND: + switch (LOWORD(wParam)) { + case IDOK: + case IDCANCEL: + EndDialog(hDlg,0); + return TRUE; + } + break; + } + return FALSE; +} + +static void +ConDrawText(HWND hwnd) +{ + int num_chars; + int nchars; + TCHAR *buf; + int from, to; + int dl; + int dc; + RECT rc; + + WaitForSingleObject(console_output, INFINITE); + nchars = 0; + num_chars = outbuf.wrPos - outbuf.rdPos; + buf = &outbuf.data[outbuf.rdPos]; + if (logfile != NULL) + LogFileWrite(buf, num_chars); + + +#ifdef HARDDEBUG + { + TCHAR *bu = (TCHAR *) ALLOC((num_chars+1) * sizeof(TCHAR)); + memcpy(bu,buf,num_chars * sizeof(TCHAR)); + bu[num_chars]='\0'; + fprintf(stderr,TEXT("ConDrawText\"%s\"\n"),bu); + FREE(bu); + fflush(stderr); + } +#endif + /* + * Don't draw any text in the window; just update the line buffers + * and invalidate the appropriate part of the window. The window + * will be updated on the next WM_PAINT message. + */ + + while (num_chars-- > 0) { + switch (*buf) { + case '\r': + break; + case '\n': + if (nchars > 0) { + rc.left = GetXFromCurrentY(GetDC(hwnd),iHscrollPos,cur_x - nchars); + rc.right = rc.left + cxCharMax*nchars; + rc.top = cyChar * (cur_y-iVscrollPos); + rc.bottom = rc.top + cyChar; + InvalidateRect(hwnd, &rc, TRUE); + nchars = 0; + } + ConCarriageFeed(1); + ConScrollScreen(); + break; + case SET_CURSOR: + if (nchars > 0) { + rc.left = GetXFromCurrentY(GetDC(hwnd),iHscrollPos,cur_x - nchars); + rc.right = rc.left + cxCharMax*nchars; + rc.top = cyChar * (cur_y-iVscrollPos); + rc.bottom = rc.top + cyChar; + InvalidateRect(hwnd, &rc, TRUE); + nchars = 0; + } + buf++; + from = *((int *)buf); + buf += sizeof(int)/sizeof(TCHAR); + to = *((int *)buf); + buf += (sizeof(int)/sizeof(TCHAR))-1; + num_chars -= 2 * (sizeof(int)/sizeof(TCHAR)); + while (to > from) { + cur_x++; + if (GetXFromCurrentY(GetDC(hwnd),0,cur_x)+cxChar > + (LINE_LENGTH * cxChar)) { + cur_x = 0; + cur_y++; + ensure_line_below(); + cur_line = cur_line->next; + } + from++; + } + while (to < from) { + cur_x--; + if (cur_x < 0) { + cur_y--; + cur_line = cur_line->prev; + cur_x = cur_line->width-1; + } + from--; + } + + break; + default: + nchars++; + cur_line->text[cur_x] = *buf; + cur_x++; + if (cur_x > cur_line->width) + cur_line->width = cur_x; + if (GetXFromCurrentY(GetDC(hwnd),0,cur_x)+cxChar > + (LINE_LENGTH * cxChar)) { + if (nchars > 0) { + rc.left = GetXFromCurrentY(GetDC(hwnd),iHscrollPos,cur_x - nchars); + rc.right = rc.left + cxCharMax*nchars; + rc.top = cyChar * (cur_y-iVscrollPos); + rc.bottom = rc.top + cyChar; + InvalidateRect(hwnd, &rc, TRUE); + } + ConCarriageFeed(0); + nchars = 0; + } + } + buf++; + } + if (nchars > 0) { + rc.left = GetXFromCurrentY(GetDC(hwnd),iHscrollPos,cur_x - nchars); + rc.right = rc.left + cxCharMax*nchars; + rc.top = cyChar * (cur_y-iVscrollPos); + rc.bottom = rc.top + cyChar; + InvalidateRect(hwnd, &rc, TRUE); + } + ConScrollScreen(); + SetCaretPos(GetXFromCurrentY(GetDC(hwnd),iHscrollPos,cur_x), (cur_y-iVscrollPos)*cyChar); + outbuf.wrPos = outbuf.rdPos = 0; + ReleaseSemaphore(console_output, 1, NULL); +} + +static void +AddToCmdHistory(void) +{ + int i; + int size; + Uint32 *buf; + wchar_t cmdBuf[128]; + + if (llen != 0) { + for (i = 0, size = 0; i < llen-1; i++) { + /* + * Find end of prompt. + */ + if ((lbuf[i] == '>') && lbuf[i+1] == ' ') { + buf = &lbuf[i+2]; + size = llen-i-2; + break; + } + } + if (size > 0 && size < 128) { + for (i = 0;i < size; ++i) { + cmdBuf[i] = (wchar_t) buf[i]; + } + cmdBuf[size] = 0; + SendMessage(hComboWnd,CB_INSERTSTRING,0,(LPARAM)cmdBuf); + } + } +} + +static TBBUTTON tbb[] = +{ + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, + 0, IDMENU_COPY, TBSTATE_ENABLED, TBSTYLE_AUTOSIZE, 0, 0, 0, 0, + 1, IDMENU_PASTE, TBSTATE_ENABLED, TBSTYLE_AUTOSIZE, 0, 0, 0, 0, + 2, IDMENU_FONT, TBSTATE_ENABLED, TBSTYLE_AUTOSIZE, 0, 0, 0, 0, + 3, IDMENU_ABOUT, TBSTATE_ENABLED, TBSTYLE_AUTOSIZE, 0, 0, 0, 0, + 0, 0, TBSTATE_ENABLED, TBSTYLE_SEP, 0, 0, 0, 0, +}; + +static TBADDBITMAP tbbitmap = +{ + HINST_COMMCTRL, IDB_STD_SMALL_COLOR, +}; + + +static HWND +InitToolBar(HWND hwndParent) +{ + int x,y,cx; + HWND hwndTB,hwndTT; + RECT r; + TOOLINFO ti; + HFONT hFontNew; + DWORD backgroundColor = GetSysColor(COLOR_BTNFACE); + COLORMAP colorMap; + colorMap.from = RGB(192, 192, 192); + colorMap.to = backgroundColor; + + /* Create toolbar window with tooltips */ + hwndTB = CreateWindowEx(0,TOOLBARCLASSNAME,(TCHAR *)NULL, + WS_CHILD|CCS_TOP|WS_CLIPSIBLINGS|TBSTYLE_TOOLTIPS, + 0,0,0,0,hwndParent, + (HMENU)2,hInstance,NULL); + SendMessage(hwndTB,TB_BUTTONSTRUCTSIZE, + (WPARAM) sizeof(TBBUTTON),0); + tbbitmap.hInst = NULL; + tbbitmap.nID = (UINT) CreateMappedBitmap(beam_module, 1,0, &colorMap, 1); + SendMessage(hwndTB, TB_ADDBITMAP, (WPARAM) 4, + (WPARAM) &tbbitmap); + SendMessage(hwndTB,TB_ADDBUTTONS, (WPARAM) 30, + (LPARAM) (LPTBBUTTON) tbb); + if (toolbarVisible) + ShowWindow(hwndTB, SW_SHOW); + + /* Create combobox window */ + SendMessage(hwndTB,TB_GETITEMRECT,0,(LPARAM)&r); + x = r.left; y = r.top; + SendMessage(hwndTB,TB_GETITEMRECT,23,(LPARAM)&r); + cx = r.right - x + 1; + hComboWnd = CreateWindow(TEXT("combobox"),NULL,WS_VSCROLL|WS_CHILD|WS_VISIBLE|CBS_DROPDOWNLIST, + x,y,cx,100,hwndParent,(HMENU)ID_COMBOBOX, hInstance,NULL); + SetParent(hComboWnd,hwndTB); + hFontNew = CreateFontIndirect(&logfont); + SendMessage(hComboWnd,WM_SETFONT,(WPARAM)hFontNew, + MAKELPARAM(1,0)); + + /* Add tooltip for combo box */ + ZeroMemory(&ti,sizeof(TOOLINFO)); + ti.cbSize = sizeof(TOOLINFO); + ti.uFlags = TTF_IDISHWND|TTF_CENTERTIP|TTF_SUBCLASS; + ti.hwnd = hwndTB;; + ti.uId = (UINT)hComboWnd; + ti.lpszText = LPSTR_TEXTCALLBACK; + hwndTT = (HWND)SendMessage(hwndTB,TB_GETTOOLTIPS,0,0); + SendMessage(hwndTT,TTM_ADDTOOL,0,(LPARAM)&ti); + + return hwndTB; +} + +static void +window_title(struct title_buf *tbuf) +{ + int res, i; + size_t bufsz = TITLE_BUF_SZ; + unsigned char charbuff[TITLE_BUF_SZ]; + + res = erl_drv_getenv("ERL_WINDOW_TITLE", charbuff, &bufsz); + if (res < 0) + tbuf->name = erlang_window_title; + else if (res == 0) { + for (i = 0; i < bufsz; ++i) { + tbuf->buf[i] = charbuff[i]; + } + tbuf->buf[bufsz - 1] = 0; + tbuf->name = &tbuf->buf[0]; + } else { + char *buf = ALLOC(bufsz); + if (!buf) + tbuf->name = erlang_window_title; + else { + while (1) { + char *newbuf; + res = erl_drv_getenv("ERL_WINDOW_TITLE", buf, &bufsz); + if (res <= 0) { + if (res == 0) { + TCHAR *wbuf = ALLOC(bufsz *sizeof(TCHAR)); + for (i = 0; i < bufsz ; ++i) { + wbuf[i] = buf[i]; + } + wbuf[bufsz - 1] = 0; + FREE(buf); + tbuf->name = wbuf; + } else { + tbuf->name = erlang_window_title; + FREE(buf); + } + break; + } + newbuf = REALLOC(buf, bufsz); + if (newbuf) + buf = newbuf; + else { + tbuf->name = erlang_window_title; + FREE(buf); + break; + } + } + } + } +} + +static void +free_window_title(struct title_buf *tbuf) +{ + if (tbuf->name != erlang_window_title && tbuf->name != &tbuf->buf[0]) + FREE(tbuf->name); +} diff --git a/erts/emulator/drivers/win32/win_con.h b/erts/emulator/drivers/win32/win_con.h new file mode 100644 index 0000000000..d46af86ca5 --- /dev/null +++ b/erts/emulator/drivers/win32/win_con.h @@ -0,0 +1,39 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * External API for the windows console (aka werl window) + * used by ttsl_drv.c + */ +#ifndef _WIN_CON_H_VISITED +#define _WIN_CON_H_VISITED 1 +void ConNormalExit(void); +void ConWaitForExit(void); +void ConSetCtrlHandler(BOOL (WINAPI *handler)(DWORD)); +int ConPutChar(Uint32 c); +void ConSetCursor(int from, int to); +void ConPrintf(char *format, ...); +void ConVprintf(char *format, va_list va); +void ConBeep(void); +int ConReadInput(Uint32 *data, int nbytes); +int ConGetKey(void); +int ConGetColumns(void); +int ConGetRows(void); +void ConInit(void); +#endif /* _WIN_CON_H_VISITED */ diff --git a/erts/emulator/drivers/win32/win_efile.c b/erts/emulator/drivers/win32/win_efile.c new file mode 100644 index 0000000000..89aaad31da --- /dev/null +++ b/erts/emulator/drivers/win32/win_efile.c @@ -0,0 +1,1426 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: Provides file and directory operations for Windows. + */ + +#include +#include "sys.h" +#include + +#include "erl_efile.h" + +/* + * Microsoft-specific function to map a WIN32 error code to a Posix errno. + */ + +#define ISSLASH(a) ((a) == '\\' || (a) == '/') + +#define ISDIR(st) (((st).st_mode&S_IFMT) == S_IFDIR) +#define ISREG(st) (((st).st_mode&S_IFMT) == S_IFREG) + +#define IS_DOT_OR_DOTDOT(s) \ + (s[0] == '.' && (s[1] == '\0' || (s[1] == '.' && s[2] == '\0'))) + +#ifndef INVALID_FILE_ATTRIBUTES +#define INVALID_FILE_ATTRIBUTES ((DWORD) 0xFFFFFFFF) +#endif + +static int check_error(int result, Efile_error* errInfo); +static int set_error(Efile_error* errInfo); +static int IsRootUNCName(const char* path); +static int extract_root(char* name); +static unsigned short dos_to_posix_mode(int attr, const char *name); + +static int errno_map(DWORD last_error) { + + switch (last_error) { + case ERROR_SUCCESS: + return 0; + case ERROR_INVALID_FUNCTION: + case ERROR_INVALID_DATA: + case ERROR_INVALID_PARAMETER: + case ERROR_INVALID_TARGET_HANDLE: + case ERROR_INVALID_CATEGORY: + case ERROR_NEGATIVE_SEEK: + return EINVAL; + case ERROR_DIR_NOT_EMPTY: + return EEXIST; + case ERROR_BAD_FORMAT: + return ENOEXEC; + case ERROR_PATH_NOT_FOUND: + case ERROR_FILE_NOT_FOUND: + case ERROR_NO_MORE_FILES: + return ENOENT; + case ERROR_TOO_MANY_OPEN_FILES: + return EMFILE; + case ERROR_ACCESS_DENIED: + case ERROR_INVALID_ACCESS: + case ERROR_CURRENT_DIRECTORY: + case ERROR_SHARING_VIOLATION: + case ERROR_LOCK_VIOLATION: + case ERROR_INVALID_PASSWORD: + case ERROR_DRIVE_LOCKED: + return EACCES; + case ERROR_INVALID_HANDLE: + return EBADF; + case ERROR_NOT_ENOUGH_MEMORY: + case ERROR_OUTOFMEMORY: + case ERROR_OUT_OF_STRUCTURES: + return ENOMEM; + case ERROR_INVALID_DRIVE: + case ERROR_BAD_UNIT: + case ERROR_NOT_READY: + case ERROR_REM_NOT_LIST: + case ERROR_DUP_NAME: + case ERROR_BAD_NETPATH: + case ERROR_NETWORK_BUSY: + case ERROR_DEV_NOT_EXIST: + case ERROR_BAD_NET_NAME: + return ENXIO; + case ERROR_NOT_SAME_DEVICE: + return EXDEV; + case ERROR_WRITE_PROTECT: + return EROFS; + case ERROR_BAD_LENGTH: + case ERROR_BUFFER_OVERFLOW: + return E2BIG; + case ERROR_SEEK: + case ERROR_SECTOR_NOT_FOUND: + return ESPIPE; + case ERROR_NOT_DOS_DISK: + return ENODEV; + case ERROR_GEN_FAILURE: + return ENODEV; + case ERROR_SHARING_BUFFER_EXCEEDED: + case ERROR_NO_MORE_SEARCH_HANDLES: + return EMFILE; + case ERROR_HANDLE_EOF: + case ERROR_BROKEN_PIPE: + return EPIPE; + case ERROR_HANDLE_DISK_FULL: + case ERROR_DISK_FULL: + return ENOSPC; + case ERROR_NOT_SUPPORTED: + return ENOTSUP; + case ERROR_FILE_EXISTS: + case ERROR_ALREADY_EXISTS: + case ERROR_CANNOT_MAKE: + return EEXIST; + case ERROR_ALREADY_ASSIGNED: + return EBUSY; + case ERROR_NO_PROC_SLOTS: + return EAGAIN; + case ERROR_ARENA_TRASHED: + case ERROR_INVALID_BLOCK: + case ERROR_BAD_ENVIRONMENT: + case ERROR_BAD_COMMAND: + case ERROR_CRC: + case ERROR_OUT_OF_PAPER: + case ERROR_READ_FAULT: + case ERROR_WRITE_FAULT: + case ERROR_WRONG_DISK: + case ERROR_NET_WRITE_FAULT: + return EIO; + default: /* not to do with files I expect. */ + return EIO; + } +} + +static int +check_error(int result, Efile_error* errInfo) +{ + if (result < 0) { + errInfo->posix_errno = errno; + errInfo->os_errno = GetLastError(); + return 0; + } + return 1; +} + +/* + * Fills the provided error information structure with information + * with the error code given by GetLastError() and its corresponding + * Posix error number. + * + * Returns 0. + */ + +static int +set_error(Efile_error* errInfo) +{ + errInfo->posix_errno = errno_map(errInfo->os_errno = GetLastError()); + return 0; +} + +/* + * A writev with Unix semantics, but with Windows arguments + */ +static int +win_writev(Efile_error* errInfo, + HANDLE fd, /* handle to file */ + FILE_SEGMENT_ELEMENT iov[], /* array of buffer pointers */ + DWORD *size) /* number of bytes to write */ +{ + OVERLAPPED ov; + ov.Offset = 0L; + ov.OffsetHigh = 0L; + ov.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL); + if (ov.hEvent == NULL) + return set_error(errInfo); + if (! write_file_gather(fd, iov, *size, NULL, &ov)) + return set_error(errInfo); + if (WaitForSingleObject(ov.hEvent, INFINITE) != WAIT_OBJECT_0) + return set_error(errInfo); + if (! GetOverlappedResult(fd, &ov, size, FALSE)) + return set_error(errInfo); + return 1; +} + + + +int +efile_mkdir(errInfo, name) +Efile_error* errInfo; /* Where to return error codes. */ +char* name; /* Name of directory to create. */ +{ + return check_error(mkdir(name), errInfo); +} + +int +efile_rmdir(errInfo, name) +Efile_error* errInfo; /* Where to return error codes. */ +char* name; /* Name of directory to delete. */ +{ + OSVERSIONINFO os; + DWORD attr; + + if (RemoveDirectory(name) != FALSE) { + return 1; + } + errno = errno_map(GetLastError()); + if (errno == EACCES) { + attr = GetFileAttributes(name); + if (attr != (DWORD) -1) { + if ((attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { + /* + * Windows 95 reports calling RemoveDirectory on a file as an + * EACCES, not an ENOTDIR. + */ + + errno = ENOTDIR; + goto end; + } + + /* + * Windows 95 reports removing a non-empty directory as + * an EACCES, not an EEXIST. If the directory is not empty, + * change errno so caller knows what's going on. + */ + + os.dwOSVersionInfoSize = sizeof(os); + GetVersionEx(&os); + if (os.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) { + HANDLE handle; + WIN32_FIND_DATA data; + char buffer[2*MAX_PATH]; + int len; + + len = strlen(name); + strcpy(buffer, name); + if (buffer[0] && buffer[len-1] != '\\' && buffer[len-1] != '/') { + strcat(buffer, "\\"); + } + strcat(buffer, "*.*"); + handle = FindFirstFile(buffer, &data); + if (handle != INVALID_HANDLE_VALUE) { + while (1) { + if ((strcmp(data.cFileName, ".") != 0) + && (strcmp(data.cFileName, "..") != 0)) { + /* + * Found something in this directory. + */ + + errno = EEXIST; + break; + } + if (FindNextFile(handle, &data) == FALSE) { + break; + } + } + FindClose(handle); + } + } + } + } + + if (errno == ENOTEMPTY) { + /* + * Posix allows both EEXIST or ENOTEMPTY, but we'll always + * return EEXIST to allow easy matching in Erlang code. + */ + + errno = EEXIST; + } + + end: + return check_error(-1, errInfo); +} + +int +efile_delete_file(errInfo, name) +Efile_error* errInfo; /* Where to return error codes. */ +char* name; /* Name of file to delete. */ +{ + DWORD attr; + + if (DeleteFile(name) != FALSE) { + return 1; + } + + errno = errno_map(GetLastError()); + if (errno == EACCES) { + attr = GetFileAttributes(name); + if (attr != (DWORD) -1) { + if (attr & FILE_ATTRIBUTE_DIRECTORY) { + /* + * Windows NT reports removing a directory as EACCES instead + * of EPERM. + */ + + errno = EPERM; + } + } + } else if (errno == ENOENT) { + attr = GetFileAttributes(name); + if (attr != (DWORD) -1) { + if (attr & FILE_ATTRIBUTE_DIRECTORY) { + /* + * Windows 95 reports removing a directory as ENOENT instead + * of EPERM. + */ + + errno = EPERM; + } + } + } else if (errno == EINVAL) { + /* + * Windows NT reports removing a char device as EINVAL instead of + * EACCES. + */ + + errno = EACCES; + } + + return check_error(-1, errInfo); +} + +/* + *--------------------------------------------------------------------------- + * + * Changes the name of an existing file or directory, from src to dst. + * If src and dst refer to the same file or directory, does nothing + * and returns success. Otherwise if dst already exists, it will be + * deleted and replaced by src subject to the following conditions: + * If src is a directory, dst may be an empty directory. + * If src is a file, dst may be a file. + * In any other situation where dst already exists, the rename will + * fail. + * + * Some possible error codes: + * + * EACCES: src or dst parent directory can't be read and/or written. + * EEXIST: dst is a non-empty directory. + * EINVAL: src is a root directory or dst is a subdirectory of src. + * EISDIR: dst is a directory, but src is not. + * ENOENT: src doesn't exist, or src or dst is "". + * ENOTDIR: src is a directory, but dst is not. + * EXDEV: src and dst are on different filesystems. + * + * Side effects: + * The implementation of rename may allow cross-filesystem renames, + * but the caller should be prepared to emulate it with copy and + * delete if errno is EXDEV. + * + *--------------------------------------------------------------------------- + */ + +int +efile_rename(errInfo, src, dst) +Efile_error* errInfo; /* Where to return error codes. */ +char* src; /* Original name. */ +char* dst; /* New name. */ +{ + DWORD srcAttr, dstAttr; + + if (MoveFile(src, dst) != FALSE) { + return 1; + } + + errno = errno_map(GetLastError()); + srcAttr = GetFileAttributes(src); + dstAttr = GetFileAttributes(dst); + if (srcAttr == (DWORD) -1) { + srcAttr = 0; + } + if (dstAttr == (DWORD) -1) { + dstAttr = 0; + } + + if (errno == EBADF) { + errno = EACCES; + return check_error(-1, errInfo); + } + if (errno == EACCES) { + decode: + if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { + char srcPath[MAX_PATH], dstPath[MAX_PATH]; + char *srcRest, *dstRest; + int size; + + size = GetFullPathName(src, sizeof(srcPath), srcPath, &srcRest); + if ((size == 0) || (size > sizeof(srcPath))) { + return check_error(-1, errInfo); + } + size = GetFullPathName(dst, sizeof(dstPath), dstPath, &dstRest); + if ((size == 0) || (size > sizeof(dstPath))) { + return check_error(-1, errInfo); + } + if (srcRest == NULL) { + srcRest = srcPath + strlen(srcPath); + } + if (strnicmp(srcPath, dstPath, srcRest - srcPath) == 0) { + /* + * Trying to move a directory into itself. + */ + + errno = EINVAL; + } + if (extract_root(srcPath)) { + /* + * Attempt to move a root directory. Never allowed. + */ + errno = EINVAL; + } + + (void) extract_root(dstPath); + if (dstPath[0] == '\0') { + /* + * The filename was invalid. (Don't know why, + * but play it safe.) + */ + errno = EINVAL; + } + if (stricmp(srcPath, dstPath) != 0) { + /* + * If src is a directory and dst filesystem != src + * filesystem, errno should be EXDEV. It is very + * important to get this behavior, so that the caller + * can respond to a cross filesystem rename by + * simulating it with copy and delete. The MoveFile + * system call already handles the case of moving a + * *file* between filesystems. + */ + + errno = EXDEV; + } + } + + /* + * Other types of access failure is that dst is a read-only + * filesystem, that an open file referred to src or dest, or that + * src or dest specified the current working directory on the + * current filesystem. EACCES is returned for those cases. + */ + + } else if (errno == EEXIST) { + /* + * Reports EEXIST any time the target already exists. If it makes + * sense, remove the old file and try renaming again. + */ + + if (srcAttr & FILE_ATTRIBUTE_DIRECTORY) { + if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { + /* + * Overwrite empty dst directory with src directory. The + * following call will remove an empty directory. If it + * fails, it's because it wasn't empty. + */ + + if (RemoveDirectory(dst)) { + /* + * Now that that empty directory is gone, we can try + * renaming again. If that fails, we'll put this empty + * directory back, for completeness. + */ + + if (MoveFile(src, dst) != FALSE) { + return 1; + } + + /* + * Some new error has occurred. Don't know what it + * could be, but report this one. + */ + + errno = errno_map(GetLastError()); + CreateDirectory(dst, NULL); + SetFileAttributes(dst, dstAttr); + if (errno == EACCES) { + /* + * Decode the EACCES to a more meaningful error. + */ + + goto decode; + } + } + } else { /* (dstAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ + errno = ENOTDIR; + } + } else { /* (srcAttr & FILE_ATTRIBUTE_DIRECTORY) == 0 */ + if (dstAttr & FILE_ATTRIBUTE_DIRECTORY) { + errno = EISDIR; + } else { + /* + * Overwrite existing file by: + * + * 1. Rename existing file to temp name. + * 2. Rename old file to new name. + * 3. If success, delete temp file. If failure, + * put temp file back to old name. + */ + + char tempName[MAX_PATH]; + int result, size; + char *rest; + + size = GetFullPathName(dst, sizeof(tempName), tempName, &rest); + if ((size == 0) || (size > sizeof(tempName)) || (rest == NULL)) { + return check_error(-1, errInfo); + } + *rest = '\0'; + result = -1; + if (GetTempFileName(tempName, "erlr", 0, tempName) != 0) { + /* + * Strictly speaking, need the following DeleteFile and + * MoveFile to be joined as an atomic operation so no + * other app comes along in the meantime and creates the + * same temp file. + */ + + DeleteFile(tempName); + if (MoveFile(dst, tempName) != FALSE) { + if (MoveFile(src, dst) != FALSE) { + SetFileAttributes(tempName, FILE_ATTRIBUTE_NORMAL); + DeleteFile(tempName); + return 1; + } else { + DeleteFile(dst); + MoveFile(tempName, dst); + } + } + + /* + * Can't backup dst file or move src file. Return that + * error. Could happen if an open file refers to dst. + */ + + errno = errno_map(GetLastError()); + if (errno == EACCES) { + /* + * Decode the EACCES to a more meaningful error. + */ + + goto decode; + } + } + return result; + } + } + } + return check_error(-1, errInfo); +} + +int +efile_chdir(errInfo, name) +Efile_error* errInfo; /* Where to return error codes. */ +char* name; /* Name of directory to make current. */ +{ + int success = check_error(chdir(name), errInfo); + if (!success && errInfo->posix_errno == EINVAL) + /* POSIXification of errno */ + errInfo->posix_errno = ENOENT; + return success; +} + +int +efile_getdcwd(errInfo, drive, buffer, size) +Efile_error* errInfo; /* Where to return error codes. */ +int drive; /* 0 - current, 1 - A, 2 - B etc. */ +char* buffer; /* Where to return the current directory. */ +size_t size; /* Size of buffer. */ +{ + if (_getdcwd(drive, buffer, size) == NULL) + return check_error(-1, errInfo); + for ( ; *buffer; buffer++) + if (*buffer == '\\') + *buffer = '/'; + return 1; +} + +int +efile_readdir(errInfo, name, dir_handle, buffer, size) +Efile_error* errInfo; /* Where to return error codes. */ +char* name; /* Name of directory to open. */ +EFILE_DIR_HANDLE* dir_handle; /* Directory handle of open directory. */ +char* buffer; /* Pointer to buffer for one filename. */ +size_t size; /* Size of buffer. */ +{ + HANDLE dir; /* Handle to directory. */ + char wildcard[MAX_PATH]; /* Wildcard to search for. */ + WIN32_FIND_DATA findData; /* Data found by FindFirstFile() or FindNext(). */ + + /* + * First time we must setup everything. + */ + + if (*dir_handle == NULL) { + int length = strlen(name); + char* s; + + if (length+3 >= MAX_PATH) { + errno = ENAMETOOLONG; + return check_error(-1, errInfo); + } + + strcpy(wildcard, name); + s = wildcard+length-1; + if (*s != '/' && *s != '\\') + *++s = '\\'; + *++s = '*'; + *++s = '\0'; + DEBUGF(("Reading %s\n", wildcard)); + dir = FindFirstFile(wildcard, &findData); + if (dir == INVALID_HANDLE_VALUE) + return set_error(errInfo); + *dir_handle = (EFILE_DIR_HANDLE) dir; + + if (!IS_DOT_OR_DOTDOT(findData.cFileName)) { + strcpy(buffer, findData.cFileName); + return 1; + } + } + + + /* + * Retrieve the name of the next file using the directory handle. + */ + + dir = (HANDLE) *dir_handle; + + for (;;) { + if (FindNextFile(dir, &findData)) { + if (IS_DOT_OR_DOTDOT(findData.cFileName)) + continue; + strcpy(buffer, findData.cFileName); + return 1; + } + + if (GetLastError() == ERROR_NO_MORE_FILES) { + FindClose(dir); + errInfo->posix_errno = errInfo->os_errno = 0; + return 0; + } + + set_error(errInfo); + FindClose(dir); + return 0; + } +} + +int +efile_openfile(errInfo, name, flags, pfd, pSize) +Efile_error* errInfo; /* Where to return error codes. */ +char* name; /* Name of directory to open. */ +int flags; /* Flags to use for opening. */ +int* pfd; /* Where to store the file descriptor. */ +Sint64* pSize; /* Where to store the size of the file. */ +{ + BY_HANDLE_FILE_INFORMATION fileInfo; /* File information from a handle. */ + HANDLE fd; /* Handle to open file. */ + DWORD access; /* Access mode: GENERIC_READ, GENERIC_WRITE. */ + DWORD crFlags; + + switch (flags & (EFILE_MODE_READ|EFILE_MODE_WRITE)) { + case EFILE_MODE_READ: + access = GENERIC_READ; + crFlags = OPEN_EXISTING; + break; + case EFILE_MODE_WRITE: + access = GENERIC_WRITE; + crFlags = CREATE_ALWAYS; + break; + case EFILE_MODE_READ_WRITE: + access = GENERIC_READ|GENERIC_WRITE; + crFlags = OPEN_ALWAYS; + break; + default: + errno = EINVAL; + check_error(-1, errInfo); + return 0; + } + + if (flags & EFILE_MODE_APPEND) { + crFlags = OPEN_ALWAYS; + } + fd = CreateFile(name, access, FILE_SHARE_READ | FILE_SHARE_WRITE, + NULL, crFlags, FILE_ATTRIBUTE_NORMAL, NULL); + + /* + * Check for errors. + */ + + if (fd == INVALID_HANDLE_VALUE) { + DWORD attr; + + set_error(errInfo); + + /* + * If the error is EACESS, the reason could be that we tried to + * open a directory. In that case, we'll change the error code + * to EISDIR. + */ + if (errInfo->posix_errno && + (attr = GetFileAttributes(name)) != INVALID_FILE_ATTRIBUTES && + (attr & FILE_ATTRIBUTE_DIRECTORY)) { + errInfo->posix_errno = EISDIR; + } + return 0; + } + + /* + * Get and return the length of the open file. + */ + + if (!GetFileInformationByHandle(fd, &fileInfo)) + return set_error(errInfo); + *pfd = (int) fd; + if (pSize) { + *pSize = (Sint64) + (((Uint64)fileInfo.nFileSizeHigh << 32) | + (Uint64)fileInfo.nFileSizeLow); + } + return 1; +} + +int +efile_may_openfile(Efile_error* errInfo, char *name) { + DWORD attr; + + if ((attr = GetFileAttributes(name)) == INVALID_FILE_ATTRIBUTES) { + return check_error(-1, errInfo); + } + + if (attr & FILE_ATTRIBUTE_DIRECTORY) { + errno = EISDIR; + return check_error(-1, errInfo); + } + return 1; +#if 0 + struct stat statbuf; + + if (stat(name, &statbuf)) { + return check_error(-1, errInfo); + } + if (ISDIR(statbuf)) { + errno = EISDIR; + return check_error(-1, errInfo); + } + return 1; +#endif +} + +void +efile_closefile(fd) +int fd; /* File descriptor for file to close. */ +{ + CloseHandle((HANDLE) fd); +} + +int +efile_fsync(errInfo, fd) +Efile_error* errInfo; /* Where to return error codes. */ +int fd; /* File descriptor for file to sync. */ +{ + if (!FlushFileBuffers((HANDLE) fd)) { + return check_error(-1, errInfo); + } + return 1; +} + +int +efile_fileinfo(Efile_error* errInfo, Efile_info* pInfo, + char* orig_name, int info_for_link) +{ + HANDLE findhandle; /* Handle returned by FindFirstFile(). */ + WIN32_FIND_DATA findbuf; /* Data return by FindFirstFile(). */ + char name[_MAX_PATH]; + int name_len; + char* path; + char pathbuf[_MAX_PATH]; + int drive; /* Drive for filename (1 = A:, 2 = B: etc). */ + + /* Don't allow wildcards to be interpreted by system */ + + if (strpbrk(orig_name, "?*")) { + enoent: + errInfo->posix_errno = ENOENT; + errInfo->os_errno = ERROR_FILE_NOT_FOUND; + return 0; + } + + /* + * Move the name to a buffer and make sure to remove a trailing + * slash, because it causes FindFirstFile() to fail on Win95. + */ + + if ((name_len = strlen(orig_name)) >= _MAX_PATH) { + goto enoent; + } else { + strcpy(name, orig_name); + if (name_len > 2 && ISSLASH(name[name_len-1]) && + name[name_len-2] != ':') { + name[name_len-1] = '\0'; + } + } + + /* Try to get disk from name. If none, get current disk. */ + + if (name[1] != ':') { + drive = 0; + if (GetCurrentDirectory(sizeof(pathbuf), pathbuf) && + pathbuf[1] == ':') { + drive = tolower(pathbuf[0]) - 'a' + 1; + } + } else if (*name && name[2] == '\0') { + /* + * X: and nothing more is an error. + */ + errInfo->posix_errno = ENOENT; + errInfo->os_errno = ERROR_FILE_NOT_FOUND; + return 0; + } else + drive = tolower(*name) - 'a' + 1; + + findhandle = FindFirstFile(name, &findbuf); + if (findhandle == INVALID_HANDLE_VALUE) { + if (!(strpbrk(name, "./\\") && + (path = _fullpath(pathbuf, name, _MAX_PATH)) && + /* root dir. ('C:\') or UNC root dir. ('\\server\share\') */ + ((strlen(path) == 3) || IsRootUNCName(path)) && + (GetDriveType(path) > 1) ) ) { + errInfo->posix_errno = ENOENT; + errInfo->os_errno = ERROR_FILE_NOT_FOUND; + return 0; + } + + /* + * Root directories (such as C:\ or \\server\share\ are fabricated. + */ + + findbuf.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY; + findbuf.nFileSizeHigh = 0; + findbuf.nFileSizeLow = 0; + findbuf.cFileName[0] = '\0'; + + pInfo->modifyTime.year = 1980; + pInfo->modifyTime.month = 1; + pInfo->modifyTime.day = 1; + pInfo->modifyTime.hour = 0; + pInfo->modifyTime.minute = 0; + pInfo->modifyTime.second = 0; + + pInfo->accessTime = pInfo->modifyTime; + } else { + SYSTEMTIME SystemTime; + FILETIME LocalFTime; + +#define GET_TIME(dst, src) \ +if (!FileTimeToLocalFileTime(&findbuf.src, &LocalFTime) || \ + !FileTimeToSystemTime(&LocalFTime, &SystemTime)) { \ + return set_error(errInfo); \ +} \ +(dst).year = SystemTime.wYear; \ +(dst).month = SystemTime.wMonth; \ +(dst).day = SystemTime.wDay; \ +(dst).hour = SystemTime.wHour; \ +(dst).minute = SystemTime.wMinute; \ +(dst).second = SystemTime.wSecond; + + GET_TIME(pInfo->modifyTime, ftLastWriteTime); + + if (findbuf.ftLastAccessTime.dwLowDateTime == 0 && + findbuf.ftLastAccessTime.dwHighDateTime == 0) { + pInfo->accessTime = pInfo->modifyTime; + } else { + GET_TIME(pInfo->accessTime, ftLastAccessTime); + } + + if (findbuf.ftCreationTime.dwLowDateTime == 0 && + findbuf.ftCreationTime.dwHighDateTime == 0) { + pInfo->cTime = pInfo->modifyTime; + } else { + GET_TIME(pInfo->cTime, ftCreationTime); + } +#undef GET_TIME + FindClose(findhandle); + } + + pInfo->size_low = findbuf.nFileSizeLow; + pInfo->size_high = findbuf.nFileSizeHigh; + + if (findbuf.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) + pInfo->type = FT_DIRECTORY; + else + pInfo->type = FT_REGULAR; + + if (findbuf.dwFileAttributes & FILE_ATTRIBUTE_READONLY) + pInfo->access = FA_READ; + else + pInfo->access = FA_READ|FA_WRITE; + + pInfo->mode = dos_to_posix_mode(findbuf.dwFileAttributes, name); + pInfo->links = 1; + pInfo->major_device = drive; + pInfo->minor_device = 0; + pInfo->inode = 0; + pInfo->uid = 0; + pInfo->gid = 0; + + return 1; +} + +int +efile_write_info(errInfo, pInfo, name) +Efile_error* errInfo; +Efile_info* pInfo; +char* name; +{ + SYSTEMTIME timebuf; + FILETIME LocalFileTime; + FILETIME ModifyFileTime; + FILETIME AccessFileTime; + FILETIME CreationFileTime; + HANDLE fd; + FILETIME* mtime = NULL; + FILETIME* atime = NULL; + FILETIME* ctime = NULL; + DWORD attr; + DWORD tempAttr; + BOOL modifyTime = FALSE; + + /* + * Get the attributes for the file. + */ + + tempAttr = attr = GetFileAttributes((LPTSTR)name); + if (attr == 0xffffffff) { + return set_error(errInfo); + } + if (pInfo->mode != -1) { + if (pInfo->mode & _S_IWRITE) { + /* clear read only bit */ + attr &= ~FILE_ATTRIBUTE_READONLY; + } else { + /* set read only bit */ + attr |= FILE_ATTRIBUTE_READONLY; + } + } + + /* + * Construct all file times. + */ + +#define MKTIME(tb, ts, ptr) \ + timebuf.wYear = ts.year; \ + timebuf.wMonth = ts.month; \ + timebuf.wDay = ts.day; \ + timebuf.wHour = ts.hour; \ + timebuf.wMinute = ts.minute; \ + timebuf.wSecond = ts.second; \ + timebuf.wMilliseconds = 0; \ + if (ts.year != -1) { \ + modifyTime = TRUE; \ + ptr = &tb; \ + if (!SystemTimeToFileTime(&timebuf, &LocalFileTime ) || \ + !LocalFileTimeToFileTime(&LocalFileTime, &tb)) { \ + errno = EINVAL; \ + return check_error(-1, errInfo); \ + } \ + } + + MKTIME(ModifyFileTime, pInfo->accessTime, mtime); + MKTIME(AccessFileTime, pInfo->modifyTime, atime); + MKTIME(CreationFileTime, pInfo->cTime, ctime); +#undef MKTIME + + /* + * If necessary, set the file times. + */ + + if (modifyTime) { + /* + * If the has read only access, we must temporarily turn on + * write access (this is necessary for native filesystems, + * but not for NFS filesystems). + */ + + if (tempAttr & FILE_ATTRIBUTE_READONLY) { + tempAttr &= ~FILE_ATTRIBUTE_READONLY; + if (!SetFileAttributes((LPTSTR) name, tempAttr)) { + return set_error(errInfo); + } + } + + fd = CreateFile(name, GENERIC_READ|GENERIC_WRITE, + FILE_SHARE_READ | FILE_SHARE_WRITE, + NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + if (fd != INVALID_HANDLE_VALUE) { + BOOL result = SetFileTime(fd, ctime, atime, mtime); + if (!result) { + return set_error(errInfo); + } + CloseHandle(fd); + } + } + + /* + * If the file doesn't have the correct attributes, set them now. + * (It could have been done before setting the file times, above). + */ + + if (tempAttr != attr) { + if (!SetFileAttributes((LPTSTR) name, attr)) { + return set_error(errInfo); + } + } + return 1; +} + + +int +efile_pwrite(errInfo, fd, buf, count, offset) +Efile_error* errInfo; /* Where to return error codes. */ +int fd; /* File descriptor to write to. */ +char* buf; /* Buffer to write. */ +size_t count; /* Number of bytes to write. */ +Sint64 offset; /* where to write it */ +{ + int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + if (res) { + return efile_write(errInfo, EFILE_MODE_WRITE, fd, buf, count); + } else { + return res; + } +} + +/* position and read/write as a single atomic op */ +int +efile_pread(errInfo, fd, offset, buf, count, pBytesRead) +Efile_error* errInfo; /* Where to return error codes. */ +int fd; /* File descriptor to read from. */ +Sint64 offset; /* Offset in bytes from BOF. */ +char* buf; /* Buffer to read into. */ +size_t count; /* Number of bytes to read. */ +size_t* pBytesRead; /* Where to return number of bytes read. */ +{ + int res = efile_seek(errInfo, fd, offset, EFILE_SEEK_SET, NULL); + if (res) { + return efile_read(errInfo, EFILE_MODE_READ, fd, buf, count, pBytesRead); + } else { + return res; + } +} + + + +int +efile_write(errInfo, flags, fd, buf, count) +Efile_error* errInfo; /* Where to return error codes. */ +int flags; /* Flags given when file was opened. */ +int fd; /* File descriptor to write to. */ +char* buf; /* Buffer to write. */ +size_t count; /* Number of bytes to write. */ +{ + DWORD written; /* Bytes written in last operation. */ + + if (flags & EFILE_MODE_APPEND) { + (void) SetFilePointer((HANDLE) fd, 0, NULL, FILE_END); + } + while (count > 0) { + if (!WriteFile((HANDLE) fd, buf, count, &written, NULL)) + return set_error(errInfo); + buf += written; + count -= written; + } + return 1; +} + +int +efile_writev(Efile_error* errInfo, /* Where to return error codes */ + int flags, /* Flags given when file was + * opened */ + int fd, /* File descriptor to write to */ + SysIOVec* iov, /* Vector of buffer structs. + * The structs are unchanged + * after the call */ + int iovcnt, /* Number of structs in vector */ + size_t size) /* Number of bytes to write */ +{ + int cnt; /* Buffers so far written */ + + ASSERT(iovcnt >= 0); + + if (flags & EFILE_MODE_APPEND) { + (void) SetFilePointer((HANDLE) fd, 0, NULL, FILE_END); + } + for (cnt = 0; cnt < iovcnt; cnt++) { + if (iov[cnt].iov_base && iov[cnt].iov_len > 0) { + /* Non-empty buffer */ + int p; /* Position in buffer */ + int w = iov[cnt].iov_len;/* Bytes written in this call */ + for (p = 0; p < iov[cnt].iov_len; p += w) { + if (!WriteFile((HANDLE) fd, + iov[cnt].iov_base + p, + iov[cnt].iov_len - p, + &w, + NULL)) + return set_error(errInfo); + } + } + } + return 1; +} + +int +efile_read(errInfo, flags, fd, buf, count, pBytesRead) +Efile_error* errInfo; /* Where to return error codes. */ +int flags; /* Flags given when file was opened. */ +int fd; /* File descriptor to read from. */ +char* buf; /* Buffer to read into. */ +size_t count; /* Number of bytes to read. */ +size_t* pBytesRead; /* Where to return number of bytes read. */ +{ + if (!ReadFile((HANDLE) fd, buf, count, (DWORD *) pBytesRead, NULL)) + return set_error(errInfo); + return 1; +} + +int +efile_seek(errInfo, fd, offset, origin, new_location) +Efile_error* errInfo; /* Where to return error codes. */ +int fd; /* File descriptor to do the seek on. */ +Sint64 offset; /* Offset in bytes from the given origin. */ +int origin; /* Origin of seek (SEEK_SET, SEEK_CUR, + * SEEK_END). + */ +Sint64* new_location; /* Resulting new location in file. */ +{ + LARGE_INTEGER off, new_loc; + + switch (origin) { + case EFILE_SEEK_SET: origin = FILE_BEGIN; break; + case EFILE_SEEK_CUR: origin = FILE_CURRENT; break; + case EFILE_SEEK_END: origin = FILE_END; break; + default: + errno = EINVAL; + check_error(-1, errInfo); + break; + } + + off.QuadPart = offset; + if (! SetFilePointerEx((HANDLE) fd, off, + new_location ? &new_loc : NULL, origin)) { + return set_error(errInfo); + } + if (new_location) { + *new_location = new_loc.QuadPart; + DEBUGF(("efile_seek(offset=%ld, origin=%d) -> %ld\n", + (long) offset, origin, (long) *new_location)); + } else { + DEBUGF(("efile_seek(offset=%ld, origin=%d)\n", (long) offset, origin)); + } + return 1; +} + +int +efile_truncate_file(errInfo, fd, flags) +Efile_error* errInfo; /* Where to return error codes. */ +int *fd; /* File descriptor for file to truncate. */ +int flags; +{ + if (!SetEndOfFile((HANDLE) (*fd))) + return set_error(errInfo); + return 1; +} + + +/* + * IsRootUNCName - returns TRUE if the argument is a UNC name specifying + * a root share. That is, if it is of the form \\server\share\. + * This routine will also return true if the argument is of the + * form \\server\share (no trailing slash) but Win32 currently + * does not like that form. + * + * Forward slashes ('/') may be used instead of backslashes ('\'). + */ + +static int +IsRootUNCName(const char* path) +{ + /* + * If a root UNC name, path will start with 2 (but not 3) slashes + */ + + if ((strlen(path) >= 5) /* minimum string is "//x/y" */ + && ISSLASH(path[0]) && ISSLASH(path[1])) + { + const char * p = path + 2 ; + + /* + * find the slash between the server name and share name + */ + while ( * ++ p ) + if ( ISSLASH(*p) ) + break ; + + if ( *p && p[1] ) + { + /* + * is there a further slash? + */ + while ( * ++ p ) + if ( ISSLASH(*p) ) + break ; + + /* + * just final slash (or no final slash) + */ + if ( !*p || !p[1]) + return 1; + } + } + + return 0 ; +} + +/* + * Extracts the root part of an absolute filename (by modifying the string + * pointed to by the name argument). The name can start + * with either a driver letter (for example, C:\), or a UNC name + * (for example, \\guinness\bjorn). + * + * If the name is invalid, the buffer will be modified to point to + * an empty string. + * + * Returns: 1 if the name consists of just the root part, 0 if + * the name was longer. + */ + +static int +extract_root(char* name) +{ + int len = strlen(name); + + if (isalpha(name[0]) && name[1] == ':' && ISSLASH(name[2])) { + int c = name[3]; + name[3] = '\0'; + return c == '\0'; + } else if (len < 5 || !ISSLASH(name[0]) || !ISSLASH(name[1])) { + goto error; + } else { /* Try to find the end of the UNC name. */ + char* p; + int c; + + /* + * Find the slash between the server name and share name. + */ + + for (p = name + 2; *p; p++) + if (ISSLASH(*p)) + break; + if (*p == '\0') + goto error; + + /* + * Find the slash after the share name. + */ + + for (p++; *p; p++) + if (ISSLASH(*p)) + break; + c = *p; + *p = '\0'; + return c == '\0' || p[1] == '\0'; + } + + error: + *name = '\0'; + return 1; +} + +static unsigned short +dos_to_posix_mode(int attr, const char *name) +{ + register unsigned short uxmode; + unsigned dosmode; + register const char *p; + + dosmode = attr & 0xff; + if ((p = name)[1] == ':') + p += 2; + + /* check to see if this is a directory - note we must make a special + * check for the root, which DOS thinks is not a directory + */ + + uxmode = (unsigned short) + (((ISSLASH(*p) && !p[1]) || (dosmode & FILE_ATTRIBUTE_DIRECTORY) || + *p == '\0') ? _S_IFDIR|_S_IEXEC : _S_IFREG); + + /* If attribute byte does not have read-only bit, it is read-write */ + + uxmode |= (dosmode & FILE_ATTRIBUTE_READONLY) ? + _S_IREAD : (_S_IREAD|_S_IWRITE); + + /* see if file appears to be executable - check extension of name */ + + if (p = strrchr(name, '.')) { + if (!stricmp(p, ".exe") || + !stricmp(p, ".cmd") || + !stricmp(p, ".bat") || + !stricmp(p, ".com")) + uxmode |= _S_IEXEC; + } + + /* propagate user read/write/execute bits to group/other fields */ + + uxmode |= (uxmode & 0700) >> 3; + uxmode |= (uxmode & 0700) >> 6; + + return uxmode; +} + +int +efile_readlink(Efile_error* errInfo, char* name, char* buffer, size_t size) +{ + errno = ENOTSUP; + return check_error(-1, errInfo); +} + + +int +efile_altname(Efile_error* errInfo, char* orig_name, char* buffer, size_t size) +{ + WIN32_FIND_DATA wfd; + HANDLE fh; + char name[_MAX_PATH]; + int name_len; + char* path; + char pathbuf[_MAX_PATH]; + int drive; /* Drive for filename (1 = A:, 2 = B: etc). */ + + /* Don't allow wildcards to be interpreted by system */ + + if (strpbrk(orig_name, "?*")) { + enoent: + errInfo->posix_errno = ENOENT; + errInfo->os_errno = ERROR_FILE_NOT_FOUND; + return 0; + } + + /* + * Move the name to a buffer and make sure to remove a trailing + * slash, because it causes FindFirstFile() to fail on Win95. + */ + + if ((name_len = strlen(orig_name)) >= _MAX_PATH) { + goto enoent; + } else { + strcpy(name, orig_name); + if (name_len > 2 && ISSLASH(name[name_len-1]) && + name[name_len-2] != ':') { + name[name_len-1] = '\0'; + } + } + + /* Try to get disk from name. If none, get current disk. */ + + if (name[1] != ':') { + drive = 0; + if (GetCurrentDirectory(sizeof(pathbuf), pathbuf) && + pathbuf[1] == ':') { + drive = tolower(pathbuf[0]) - 'a' + 1; + } + } else if (*name && name[2] == '\0') { + /* + * X: and nothing more is an error. + */ + goto enoent; + } else { + drive = tolower(*name) - 'a' + 1; + } + fh = FindFirstFile(name,&wfd); + if (fh == INVALID_HANDLE_VALUE) { + if (!(strpbrk(name, "./\\") && + (path = _fullpath(pathbuf, name, _MAX_PATH)) && + /* root dir. ('C:\') or UNC root dir. ('\\server\share\') */ + ((strlen(path) == 3) || IsRootUNCName(path)) && + (GetDriveType(path) > 1) ) ) { + errno = errno_map(GetLastError()); + return check_error(-1, errInfo); + } + /* + * Root directories (such as C:\ or \\server\share\ are fabricated. + */ + strcpy(buffer,name); + return 1; + } + + strcpy(buffer,wfd.cAlternateFileName); + if (!*buffer) { + strcpy(buffer,wfd.cFileName); + } + + return 1; +} + +int +efile_link(Efile_error* errInfo, char* old, char* new) +{ + errno = ENOTSUP; + return check_error(-1, errInfo); +} + +int +efile_symlink(Efile_error* errInfo, char* old, char* new) +{ + errno = ENOTSUP; + return check_error(-1, errInfo); +} diff --git a/erts/emulator/drivers/win32/winsock_func.h b/erts/emulator/drivers/win32/winsock_func.h new file mode 100644 index 0000000000..9d2c099c4d --- /dev/null +++ b/erts/emulator/drivers/win32/winsock_func.h @@ -0,0 +1,102 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +typedef struct _WinSockFuncs { + int (WSAAPI *WSAStartup)(WORD wVersionRequired, LPWSADATA lpWSAData); + int (WSAAPI *WSACleanup)(void); + int (WSAAPI *WSAGetLastError)(void); + DWORD (WSAAPI *WSAWaitForMultipleEvents) (DWORD cEvents, + const WSAEVENT FAR * lphEvents, + BOOL fWaitAll, + DWORD dwTimeout, + BOOL fAlertable); + WSAEVENT (WSAAPI *WSACreateEvent)(void); + BOOL (WSAAPI *WSACloseEvent)(WSAEVENT hEvent); + + BOOL (WSAAPI *WSASetEvent)(WSAEVENT hEvent); + BOOL (WSAAPI *WSAResetEvent)(WSAEVENT hEvent); + int (WSAAPI *WSAEventSelect)(SOCKET s, WSAEVENT hEventObject, + long lNetworkEvents); + int (WSAAPI *WSAEnumNetworkEvents)(SOCKET s, + WSAEVENT hEventObject, + LPWSANETWORKEVENTS lpNetworkEvents); + int (WSAAPI *WSAIoctl)(SOCKET s, + DWORD dwIoControlCode, + LPVOID lpvInBuffer, + DWORD cbInBuffer, + LPVOID lpvOUTBuffer, + DWORD cbOUTBuffer, + LPDWORD lpcbBytesReturned, + LPWSAOVERLAPPED lpOverlapped, + LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionROUTINE + ); + SOCKET (WSAAPI *accept)(SOCKET s, struct sockaddr FAR *addr, + int FAR *addrlen); + int (WSAAPI *bind)(SOCKET s, const struct sockaddr FAR *addr, + int namelen); + int (WSAAPI *closesocket)(SOCKET s); + int (WSAAPI *connect)(SOCKET s, const struct sockaddr FAR *name, + int namelen); + int (WSAAPI *ioctlsocket)(SOCKET s, long cmd, u_long FAR *argp); + int (WSAAPI *getsockopt)(SOCKET s, int level, int optname, + char FAR * optval, int FAR *optlen); + u_long (WSAAPI *htonl)(u_long hostlong); + u_short (WSAAPI *htons)(u_short hostshort); + unsigned long (WSAAPI *inet_addr)(const char FAR * cp); + char FAR * (WSAAPI *inet_ntoa)(struct in_addr in); + int (WSAAPI *listen)(SOCKET s, int backlog); + u_short (WSAAPI *ntohs)(u_short netshort); + int (WSAAPI *recv)(SOCKET s, char FAR * buf, int len, int flags); + int (WSAAPI *send)(SOCKET s, const char FAR * buf, int len, int flags); + int (WSAAPI *setsockopt)(SOCKET s, int level, int optname, + const char FAR * optval, int optlen); + int (WSAAPI *shutdown)(SOCKET s, int how); + SOCKET (WSAAPI *socket)(int af, int type, int protocol); + struct hostent FAR * (WSAAPI *gethostbyname)(const char FAR * name); + struct hostent FAR * (WSAAPI *gethostbyaddr)(const char FAR *addr, + int addrlen, int addrtype); + int (WSAAPI *gethostname)(char FAR * name, int namelen); + struct servent FAR * (WSAAPI *getservbyname)(const char FAR * name, + const char FAR * proto); + struct servent FAR * (WSAAPI *getservbyport)(int port, + const char FAR * proto); + int (WSAAPI *getsockname)(SOCKET sock, struct sockaddr FAR *name, + int FAR *namelen); + + /* + * New, added for inet_drv. + */ + + int (WSAAPI *getpeername)(SOCKET s, struct sockaddr FAR * name, + int FAR * namelen); + u_long (WSAAPI *ntohl)(u_long netlong); + int (WSAAPI *WSASend)(SOCKET s, LPWSABUF lpBuffers, DWORD dwBufferCount, + LPDWORD lpNumberOfBytesSent, DWORD dwFlags, + LPWSAOVERLAPPED lpOverlapped, + LPWSAOVERLAPPED_COMPLETION_ROUTINE lpCompletionRoutine); + int (WSAAPI *sendto)(SOCKET s, const char FAR * buf, int len, + int flags, const struct sockaddr FAR * to, int tolen); + int (WSAAPI *recvfrom)(SOCKET s, char FAR * buf, int len, int flags, + struct sockaddr FAR * from, int FAR * fromlen); +} WinSockFuncs; + + +extern WinSockFuncs winSock; + +extern int tcp_lookup_functions(void); diff --git a/erts/emulator/hipe/TODO b/erts/emulator/hipe/TODO new file mode 100644 index 0000000000..624ab560e7 --- /dev/null +++ b/erts/emulator/hipe/TODO @@ -0,0 +1,30 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 2004-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +PowerPC: +* create and use trampolines for long calls + +X86: + +SPARC: +* The inc_stack code saves more argument registers than + necessary: a C callee won't clobber %l or %i regs. +* Does noproc_primop_interface_N really need to save and + restore FCALLS/HP/RA/NSP around P-less primop calls? + (x86 doesn't save and restore HP in this interface.) + Ditto for nocons_nofail_primop_interface_0. diff --git a/erts/emulator/hipe/elf64ppc.x b/erts/emulator/hipe/elf64ppc.x new file mode 100644 index 0000000000..299eed8192 --- /dev/null +++ b/erts/emulator/hipe/elf64ppc.x @@ -0,0 +1,224 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* Default linker script, for normal executables */ +OUTPUT_FORMAT("elf64-powerpc", "elf64-powerpc", + "elf64-powerpc") +OUTPUT_ARCH(powerpc:common64) +ENTRY(_start) +SEARCH_DIR("/mnt/archive/cross-ppc64/ppc64-unknown-linux/lib"); +/* Do we need any of these for elf? + __DYNAMIC = 0; */ +SECTIONS +{ + /* Read-only sections, merged into text segment: */ + PROVIDE (__executable_start = 0x0180000); . = 0x01800000 + SIZEOF_HEADERS; + .interp : { *(.interp) } + .hash : { *(.hash) } + .dynsym : { *(.dynsym) } + .dynstr : { *(.dynstr) } + .gnu.version : { *(.gnu.version) } + .gnu.version_d : { *(.gnu.version_d) } + .gnu.version_r : { *(.gnu.version_r) } + .rel.init : { *(.rel.init) } + .rela.init : { *(.rela.init) } + .rel.text : { *(.rel.text .rel.text.* .rel.gnu.linkonce.t.*) } + .rela.text : { *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*) } + .rel.fini : { *(.rel.fini) } + .rela.fini : { *(.rela.fini) } + .rel.rodata : { *(.rel.rodata .rel.rodata.* .rel.gnu.linkonce.r.*) } + .rela.rodata : { *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*) } + .rel.data : { *(.rel.data .rel.data.* .rel.gnu.linkonce.d.*) } + .rela.data : { *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*) } + .rel.tdata : { *(.rel.tdata .rel.tdata.* .rel.gnu.linkonce.td.*) } + .rela.tdata : { *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*) } + .rel.tbss : { *(.rel.tbss .rel.tbss.* .rel.gnu.linkonce.tb.*) } + .rela.tbss : { *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*) } + .rel.ctors : { *(.rel.ctors) } + .rela.ctors : { *(.rela.ctors) } + .rel.dtors : { *(.rel.dtors) } + .rela.dtors : { *(.rela.dtors) } + .rel.got : { *(.rel.got) } + .rela.got : { *(.rela.got) } + .rela.toc : { *(.rela.toc) } + .rel.sdata : { *(.rel.sdata .rel.sdata.* .rel.gnu.linkonce.s.*) } + .rela.sdata : { *(.rela.sdata .rela.sdata.* .rela.gnu.linkonce.s.*) } + .rel.sbss : { *(.rel.sbss .rel.sbss.* .rel.gnu.linkonce.sb.*) } + .rela.sbss : { *(.rela.sbss .rela.sbss.* .rela.gnu.linkonce.sb.*) } + .rel.sdata2 : { *(.rel.sdata2 .rel.sdata2.* .rel.gnu.linkonce.s2.*) } + .rela.sdata2 : { *(.rela.sdata2 .rela.sdata2.* .rela.gnu.linkonce.s2.*) } + .rel.sbss2 : { *(.rel.sbss2 .rel.sbss2.* .rel.gnu.linkonce.sb2.*) } + .rela.sbss2 : { *(.rela.sbss2 .rela.sbss2.* .rela.gnu.linkonce.sb2.*) } + .rel.bss : { *(.rel.bss .rel.bss.* .rel.gnu.linkonce.b.*) } + .rela.bss : { *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*) } + .rel.plt : { *(.rel.plt) } + .rela.plt : { *(.rela.plt) } + .rela.tocbss : { *(.rela.tocbss) } + .init : + { + KEEP (*(.init)) + } =0x60000000 + .text : + { + *(.text .stub .text.* .gnu.linkonce.t.*) + /* .gnu.warning sections are handled specially by elf32.em. */ + *(.gnu.warning) + *(.sfpr .glink) + } =0x60000000 + .fini : + { + KEEP (*(.fini)) + } =0x60000000 + PROVIDE (__etext = .); + PROVIDE (_etext = .); + PROVIDE (etext = .); + .rodata : { *(.rodata .rodata.* .gnu.linkonce.r.*) } + .rodata1 : { *(.rodata1) } + .sdata2 : { *(.sdata2 .sdata2.* .gnu.linkonce.s2.*) } + .sbss2 : { *(.sbss2 .sbss2.* .gnu.linkonce.sb2.*) } + .eh_frame_hdr : { *(.eh_frame_hdr) } + /* Adjust the address for the data segment. We want to adjust up to + the same address within the page on the next page up. */ + . = ALIGN (0x10000) - ((0x10000 - .) & (0x10000 - 1)); . = DATA_SEGMENT_ALIGN (0x10000, 0x1000); + /* Ensure the __preinit_array_start label is properly aligned. We + could instead move the label definition inside the section, but + the linker would then create the section even if it turns out to + be empty, which isn't pretty. */ + . = ALIGN(64 / 8); + PROVIDE (__preinit_array_start = .); + .preinit_array : { *(.preinit_array) } + PROVIDE (__preinit_array_end = .); + PROVIDE (__init_array_start = .); + .init_array : { *(.init_array) } + PROVIDE (__init_array_end = .); + PROVIDE (__fini_array_start = .); + .fini_array : { *(.fini_array) } + PROVIDE (__fini_array_end = .); + .data : + { + *(.data .data.* .gnu.linkonce.d.*) + SORT(CONSTRUCTORS) + } + .data1 : { *(.data1) } + .tdata : { *(.tdata .tdata.* .gnu.linkonce.td.*) } + .tbss : { *(.tbss .tbss.* .gnu.linkonce.tb.*) *(.tcommon) } + .eh_frame : { KEEP (*(.eh_frame)) } + .gcc_except_table : { *(.gcc_except_table) } + .toc1 ALIGN(8) : { *(.toc1) } + .opd ALIGN(8) : { KEEP (*(.opd)) } + .dynamic : { *(.dynamic) } + .ctors : + { + /* gcc uses crtbegin.o to find the start of + the constructors, so we make sure it is + first. Because this is a wildcard, it + doesn't matter if the user does not + actually link against crtbegin.o; the + linker won't look for a file to match a + wildcard. The wildcard also means that it + doesn't matter which directory crtbegin.o + is in. */ + KEEP (*crtbegin*.o(.ctors)) + /* We don't want to include the .ctor section from + from the crtend.o file until after the sorted ctors. + The .ctor section from the crtend file contains the + end of ctors marker and it must be last */ + KEEP (*(EXCLUDE_FILE (*crtend*.o ) .ctors)) + KEEP (*(SORT(.ctors.*))) + KEEP (*(.ctors)) + } + .dtors : + { + KEEP (*crtbegin*.o(.dtors)) + KEEP (*(EXCLUDE_FILE (*crtend*.o ) .dtors)) + KEEP (*(SORT(.dtors.*))) + KEEP (*(.dtors)) + } + .jcr : { KEEP (*(.jcr)) } + .got ALIGN(8) : { *(.got .toc) } + /* We want the small data sections together, so single-instruction offsets + can access them all, and initialized data all before uninitialized, so + we can shorten the on-disk segment size. */ + .sdata : + { + *(.sdata .sdata.* .gnu.linkonce.s.*) + } + _edata = .; + PROVIDE (edata = .); + __bss_start = .; + .tocbss ALIGN(8) : { *(.tocbss)} + .sbss : + { + PROVIDE (__sbss_start = .); + PROVIDE (___sbss_start = .); + *(.dynsbss) + *(.sbss .sbss.* .gnu.linkonce.sb.*) + *(.scommon) + PROVIDE (__sbss_end = .); + PROVIDE (___sbss_end = .); + } + .plt : { *(.plt) } + .bss : + { + *(.dynbss) + *(.bss .bss.* .gnu.linkonce.b.*) + *(COMMON) + /* Align here to ensure that the .bss section occupies space up to + _end. Align after .bss to ensure correct alignment even if the + .bss section disappears because there are no input sections. */ + . = ALIGN(64 / 8); + } + . = ALIGN(64 / 8); + _end = .; + PROVIDE (end = .); + . = DATA_SEGMENT_END (.); + /* Stabs debugging sections. */ + .stab 0 : { *(.stab) } + .stabstr 0 : { *(.stabstr) } + .stab.excl 0 : { *(.stab.excl) } + .stab.exclstr 0 : { *(.stab.exclstr) } + .stab.index 0 : { *(.stab.index) } + .stab.indexstr 0 : { *(.stab.indexstr) } + .comment 0 : { *(.comment) } + /* DWARF debug sections. + Symbols in the DWARF debugging sections are relative to the beginning + of the section so we begin them at 0. */ + /* DWARF 1 */ + .debug 0 : { *(.debug) } + .line 0 : { *(.line) } + /* GNU DWARF 1 extensions */ + .debug_srcinfo 0 : { *(.debug_srcinfo) } + .debug_sfnames 0 : { *(.debug_sfnames) } + /* DWARF 1.1 and DWARF 2 */ + .debug_aranges 0 : { *(.debug_aranges) } + .debug_pubnames 0 : { *(.debug_pubnames) } + /* DWARF 2 */ + .debug_info 0 : { *(.debug_info .gnu.linkonce.wi.*) } + .debug_abbrev 0 : { *(.debug_abbrev) } + .debug_line 0 : { *(.debug_line) } + .debug_frame 0 : { *(.debug_frame) } + .debug_str 0 : { *(.debug_str) } + .debug_loc 0 : { *(.debug_loc) } + .debug_macinfo 0 : { *(.debug_macinfo) } + /* SGI/MIPS DWARF 2 extensions */ + .debug_weaknames 0 : { *(.debug_weaknames) } + .debug_funcnames 0 : { *(.debug_funcnames) } + .debug_typenames 0 : { *(.debug_typenames) } + .debug_varnames 0 : { *(.debug_varnames) } + /DISCARD/ : { *(.note.GNU-stack) } +} diff --git a/erts/emulator/hipe/hipe_abi.txt b/erts/emulator/hipe/hipe_abi.txt new file mode 100644 index 0000000000..aea30d262d --- /dev/null +++ b/erts/emulator/hipe/hipe_abi.txt @@ -0,0 +1,72 @@ + + %CopyrightBegin% + %CopyrightEnd% + +$Id$ + +HiPE ABI +======== +This document describes aspects of HiPE's runtime system +that are common for all supported architectures. + +Calling Convention +------------------ +The first NR_ARG_REGS parameters (an architecture parameter) +are passed in registers. +Remaining parameters are pushed on the stack, in left-to-right order. +Left-to-right order is used to cater for the BEAM interpreter's +calling convention for closures. + +The callee deallocates the stacked actual parameters from the stack +before returning. This is required for correct implementation of +tailcalls. + +Stack Descriptors +----------------- +For each native code call site there is a stack descriptor which +describes certain static properties of that call: +- The call site's return address, used as key for lookups. +- The caller's local exception handler code address, if present. +- The caller's (fixed) frame size, in words. +- The set of live and traceable words in the caller's frame. +- The caller's arity. If f/N recursively calls g/M, then the + call site's arity is N, not M. (M is not a function of the + return address, due to the presence of tailcalls.) + +Exceptions +---------- +A recursive call occurring within the scope of a local exception +handler is indicated by having a stack descriptor with a non-NULL +exception handler code address. + +If an exception is thrown, the runtime system will unwind the native +stack one frame at a time, using the stack descriptors associated +with each frame's return address. + +When a frame with an active exception handler is found, the stack +pointer is reset to the low address of the fixed portion of that frame, +and a branch is made to the handler. + +Garbage Collection Interface +---------------------------- +[gc-points are call sites. each call site has a stack descriptor. +the descriptor allows the gc to traverse the stack and to find +all live Erlang terms.] + +BIFs +---- +C BIFs are called on the C stack, not the current native stack. + +A C BIF returns a single tagged Erlang value. To indicate an +exceptional condition, it puts an error code in p->freason +and returns THE_NON_VALUE (zero, except in debug mode). + +If p->freason == TRAP, then the BIF redirects its call to some +other function, given by p->def_arg_reg[]. +The BIF and the new callee may have different arities. + +The "hipe_${ARCH}_bifs.m4" macro files take care of these issues +by automatically generating assembly code which performs the +necessary stack switching, parameter copying, and checking for +and handling of exceptional conditions. To compiled Erlang code, +a call to a C BIF looks like an ordinary function call. diff --git a/erts/emulator/hipe/hipe_amd64.c b/erts/emulator/hipe/hipe_amd64.c new file mode 100644 index 0000000000..ff87492f4d --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64.c @@ -0,0 +1,376 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#include /* offsetof() */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" +#include +#include "error.h" +#include "bif.h" +#include "big.h" /* term_to_Sint() */ + +#include "hipe_arch.h" +#include "hipe_bif0.h" +#include "hipe_native_bif.h" /* nbif_callemu() */ + +#undef F_TIMO +#undef THE_NON_VALUE +#undef ERL_FUN_SIZE +#include "hipe_literals.h" + +const Uint sse2_fnegate_mask[2] = {0x8000000000000000,0}; + +void hipe_patch_load_fe(Uint64 *address, Uint64 value) +{ + /* address points to an imm64 operand */ + *address = value; + hipe_flush_icache_word(address); +} + +int hipe_patch_insn(void *address, Uint64 value, Eterm type) +{ + switch (type) { + case am_closure: + case am_constant: + *(Uint64*)address = value; + break; + case am_c_const: + case am_atom: + /* check that value fits in an unsigned imm32 */ + /* XXX: are we sure it's not really a signed imm32? */ + if ((Uint)(Uint32)value != value) + return -1; + *(Uint32*)address = (Uint32)value; + break; + default: + return -1; + } + hipe_flush_icache_word(address); + return 0; +} + +int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline) +{ + Sint rel32; + + if (trampoline) + return -1; + rel32 = (Sint)destAddress - (Sint)callAddress - 4; + if ((Sint)(Sint32)rel32 != rel32) + return -1; + *(Uint32*)callAddress = (Uint32)rel32; + hipe_flush_icache_word(callAddress); + return 0; +} + +/* + * Memory allocator for executable code. + * + * This is required on AMD64 because some Linux kernels + * (including 2.6.10-rc1 and newer www.kernel.org ones) + * default to non-executable memory mappings, causing + * ordinary malloc() memory to be non-executable. + * + * Implementing this properly also allows us to ensure that + * executable code ends up in the low 2GB of the address space, + * as required by HiPE/AMD64's small code model. + */ +static unsigned int code_bytes; +static char *code_next; + +#if 0 /* change to non-zero to get allocation statistics at exit() */ +static unsigned int total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs, nr_large, total_lost; +static unsigned int atexit_done; + +static void alloc_code_stats(void) +{ + printf("\r\nalloc_code_stats: %u bytes mapped, %u joins, %u splits, %u bytes allocated, %u average alloc, %u large allocs, %u bytes lost\r\n", + total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs ? total_alloc/nr_allocs : 0, nr_large, total_lost); +} + +static void atexit_alloc_code_stats(void) +{ + if (!atexit_done) { + atexit_done = 1; + (void)atexit(alloc_code_stats); + } +} + +#define ALLOC_CODE_STATS(X) do{X;}while(0) +#else +#define ALLOC_CODE_STATS(X) do{}while(0) +#endif + +/* FreeBSD 6.1 breakage */ +#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) +#define MAP_ANONYMOUS MAP_ANON +#endif + +static void morecore(unsigned int alloc_bytes) +{ + unsigned int map_bytes; + char *map_hint, *map_start; + + /* Page-align the amount to allocate. */ + map_bytes = (alloc_bytes + 4095) & ~4095; + + /* Round up small allocations. */ + if (map_bytes < 1024*1024) + map_bytes = 1024*1024; + else + ALLOC_CODE_STATS(++nr_large); + + /* Create a new memory mapping, ensuring it is executable + and in the low 2GB of the address space. Also attempt + to make it adjacent to the previous mapping. */ + map_hint = code_next + code_bytes; +#if !defined(MAP_32BIT) + /* FreeBSD doesn't have MAP_32BIT, and it doesn't respect + a plain map_hint (returns high mappings even though the + hint refers to a free area), so we have to use both map_hint + and MAP_FIXED to get addresses below the 2GB boundary. + This is even worse than the Linux/ppc64 case. + Similarly, Solaris 10 doesn't have MAP_32BIT, + and it doesn't respect a plain map_hint. */ + if (!map_hint) /* first call */ + map_hint = (char*)(512*1024*1024); /* 0.5GB */ +#endif + if ((unsigned long)map_hint & 4095) + abort(); + map_start = mmap(map_hint, map_bytes, + PROT_EXEC|PROT_READ|PROT_WRITE, + MAP_PRIVATE|MAP_ANONYMOUS +#if defined(MAP_32BIT) + |MAP_32BIT +#elif defined(__FreeBSD__) || defined(__sun__) + |MAP_FIXED +#endif + , + -1, 0); + ALLOC_CODE_STATS(fprintf(stderr, "%s: mmap(%p,%u,...) == %p\r\n", __FUNCTION__, map_hint, map_bytes, map_start)); +#if !defined(MAP_32BIT) + if (map_start != MAP_FAILED && + (((unsigned long)map_start + (map_bytes-1)) & ~0x7FFFFFFFUL)) { + fprintf(stderr, "mmap with hint %p returned code memory %p\r\n", map_hint, map_start); + abort(); + } +#endif + if (map_start == MAP_FAILED) { + perror("mmap"); + abort(); + } + ALLOC_CODE_STATS(total_mapped += map_bytes); + + /* Merge adjacent mappings, so the trailing portion of the previous + mapping isn't lost. In practice this is quite successful. */ + if (map_start == map_hint) { + ALLOC_CODE_STATS(++nr_joins); + code_bytes += map_bytes; +#if !defined(MAP_32BIT) + if (!code_next) /* first call */ + code_next = map_start; +#endif + } else { + ALLOC_CODE_STATS(++nr_splits); + ALLOC_CODE_STATS(total_lost += code_bytes); + code_next = map_start; + code_bytes = map_bytes; + } + + ALLOC_CODE_STATS(atexit_alloc_code_stats()); +} + +static void *alloc_code(unsigned int alloc_bytes) +{ + void *res; + + /* Align function entries. */ + alloc_bytes = (alloc_bytes + 3) & ~3; + + if (code_bytes < alloc_bytes) + morecore(alloc_bytes); + ALLOC_CODE_STATS(++nr_allocs); + ALLOC_CODE_STATS(total_alloc += alloc_bytes); + res = code_next; + code_next += alloc_bytes; + code_bytes -= alloc_bytes; + return res; +} + +void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p) +{ + if (is_not_nil(callees)) + return NULL; + *trampolines = NIL; + return alloc_code(nrbytes); +} + +/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() + and hipe_bif0.c:hipe_make_stub() */ +void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +{ + /* + * This creates a native code stub with the following contents: + * + * movq $Address, P_BEAM_IP(%ebp) %% Actually two movl + * movb $Arity, P_ARITY(%ebp) + * jmp callemu + * + * The stub has variable size, depending on whether the P_BEAM_IP + * and P_ARITY offsets fit in 8-bit signed displacements or not. + * The rel32 offset in the final jmp depends on its actual location, + * which also depends on the size of the previous instructions. + * Arity is stored with a movb because (a) Björn tells me arities + * are <= 255, and (b) a movb is smaller and faster than a movl. + */ + unsigned int codeSize; + unsigned char *code, *codep; + unsigned int callEmuOffset; + + codeSize = /* 23, 26, 29, or 32 bytes */ + 23 + /* 23 when all offsets are 8-bit */ + (P_BEAM_IP >= 128 ? 3 : 0) + + ((P_BEAM_IP + 4) >= 128 ? 3 : 0) + + (P_ARITY >= 128 ? 3 : 0); + codep = code = alloc_code(codeSize); + + /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */ + codep[0] = 0xc7; +#if P_BEAM_IP >= 128 + codep[1] = 0x85; /* disp32[EBP] */ + codep[2] = P_BEAM_IP & 0xFF; + codep[3] = (P_BEAM_IP >> 8) & 0xFF; + codep[4] = (P_BEAM_IP >> 16) & 0xFF; + codep[5] = (P_BEAM_IP >> 24) & 0xFF; + codep += 6; +#else + codep[1] = 0x45; /* disp8[EBP] */ + codep[2] = P_BEAM_IP; + codep += 3; +#endif + codep[0] = ((unsigned long)beamAddress ) & 0xFF; + codep[1] = ((unsigned long)beamAddress >> 8) & 0xFF; + codep[2] = ((unsigned long)beamAddress >> 16) & 0xFF; + codep[3] = ((unsigned long)beamAddress >> 24) & 0xFF; + codep += 4; + + /* movl (shl 32 $beamAddress), P_BEAM_IP+4(%ebp); 3 or 6 bytes, plus 4 */ + codep[0] = 0xc7; +#if P_BEAM_IP+4 >= 128 + codep[1] = 0x85; /* disp32[EBP] */ + codep[2] = (P_BEAM_IP+4) & 0xFF; + codep[3] = ((P_BEAM_IP+4) >> 8) & 0xFF; + codep[4] = ((P_BEAM_IP+4) >> 16) & 0xFF; + codep[5] = ((P_BEAM_IP+4) >> 24) & 0xFF; + codep += 6; +#else + codep[1] = 0x45; /* disp8[EBP] */ + codep[2] = (P_BEAM_IP+4); + codep += 3; +#endif + codep[0] = ((unsigned long)beamAddress >> 32) & 0xFF; + codep[1] = ((unsigned long)beamAddress >> 40) & 0xFF; + codep[2] = ((unsigned long)beamAddress >> 48) & 0xFF; + codep[3] = ((unsigned long)beamAddress >> 56) & 0xFF; + codep += 4; + + /* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */ + codep[0] = 0xc6; +#if P_ARITY >= 128 + codep[1] = 0x85; /* disp32[EBP] */ + codep[2] = P_ARITY & 0xFF; + codep[3] = (P_ARITY >> 8) & 0xFF; + codep[4] = (P_ARITY >> 16) & 0xFF; + codep[5] = (P_ARITY >> 24) & 0xFF; + codep += 6; +#else + codep[1] = 0x45; /* disp8[EBP] */ + codep[2] = P_ARITY; + codep += 3; +#endif + codep[0] = beamArity; + codep += 1; + + /* jmp callemu; 5 bytes */ + callEmuOffset = (unsigned char*)nbif_callemu - (code + codeSize); + codep[0] = 0xe9; + codep[1] = callEmuOffset & 0xFF; + codep[2] = (callEmuOffset >> 8) & 0xFF; + codep[3] = (callEmuOffset >> 16) & 0xFF; + codep[4] = (callEmuOffset >> 24) & 0xFF; + codep += 5; + + ASSERT(codep == code + codeSize); + + /* I-cache flush? */ + + return code; +} + +void hipe_arch_print_pcb(struct hipe_process_state *p) +{ +#define U(n,x) \ + printf(" % 4d | %s | 0x%0*lx | %*s |\r\n", (int)offsetof(struct hipe_process_state,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2+2*(int)sizeof(long), "") + U("ncsp ", ncsp); + U("narity ", narity); +#undef U +} + +/* + * XXX: The following should really be moved to a generic hipe_bifs_64 file. + */ + +#if 0 /* unused */ +static int term_to_Sint64(Eterm term, Sint64 *sp) +{ + return term_to_Sint(term, sp); +} + +BIF_RETTYPE hipe_bifs_write_s64_2(BIF_ALIST_2) +{ + Sint64 *address; + Sint64 value; + + address = term_to_address(BIF_ARG_1); + if (!address || !hipe_word64_address_ok(address)) + BIF_ERROR(BIF_P, BADARG); + if (!term_to_Sint64(BIF_ARG_2, &value)) + BIF_ERROR(BIF_P, BADARG); + *address = value; + BIF_RET(NIL); +} +#endif + +BIF_RETTYPE hipe_bifs_write_u64_2(BIF_ALIST_2) +{ + Uint64 *address; + Uint64 value; + + address = term_to_address(BIF_ARG_1); + if (!address || !hipe_word64_address_ok(address)) + BIF_ERROR(BIF_P, BADARG); + if (!term_to_Uint(BIF_ARG_2, &value)) + BIF_ERROR(BIF_P, BADARG); + *address = value; + hipe_flush_icache_word(address); + BIF_RET(NIL); +} diff --git a/erts/emulator/hipe/hipe_amd64.h b/erts/emulator/hipe/hipe_amd64.h new file mode 100644 index 0000000000..532d47c092 --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64.h @@ -0,0 +1,37 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_AMD64_H +#define HIPE_AMD64_H + +#include "hipe_x86.h" +#undef hipe_arch_name + +/* for hipe_bifs_{read,write}_{s,u}64 */ +static __inline__ int hipe_word64_address_ok(void *address) +{ + return 1; +} + +#define hipe_arch_name am_amd64 + +extern const Uint sse2_fnegate_mask[]; + +#endif /* HIPE_AMD64_H */ diff --git a/erts/emulator/hipe/hipe_amd64.tab b/erts/emulator/hipe/hipe_amd64.tab new file mode 100644 index 0000000000..3787bbf23b --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64.tab @@ -0,0 +1,28 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# $Id$ +# AMD64-specific atoms and bifs + +atom amd64 +atom handle_fp_exception +atom inc_stack_0 +atom sse2_fnegate_mask + +# bif hipe_bifs:write_s64/2 +bif hipe_bifs:write_u64/2 diff --git a/erts/emulator/hipe/hipe_amd64_abi.txt b/erts/emulator/hipe/hipe_amd64_abi.txt new file mode 100644 index 0000000000..27beff4ea2 --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64_abi.txt @@ -0,0 +1,150 @@ + + %CopyrightBegin% + %CopyrightEnd% + +$Id$ + +HiPE AMD64 ABI +============== +This document describes aspects of HiPE's runtime system +that are specific for the AMD64 (x86-64) architecture. + +Register Usage +-------------- +%rsp and %rbp are fixed and must be preserved by calls (callee-save). +%rax, %rbx, %rcx, %rdx, %rsi, %rdi, %r8, %r9, %r10, %r11, %r12, %r13, %r14 +are clobbered by calls (caller-save). +%r15 is a fixed global register (unallocatable). + +%rsp is the native code stack pointer, growing towards lower addresses. +%rbp (aka P) is the current process' "Process*". +%r15 (aka HP) is the current process' heap pointer. (If HP_IN_R15 is true.) + +Notes: +- C/AMD64 16-byte aligns %rsp, presumably for SSE and signal handling. + HiPE/AMD64 does not need that, so our %rsp is only 8-byte aligned. +- HiPE/x86 uses %esi for HP, but C/AMD64 uses %rsi for parameter passing, + so HiPE/AMD64 should not use %rsi for HP. +- Using %r15 for HP requires a REX instruction prefix, but performing + 64-bit stores needs one anyway, so the only REX-prefix overhead + occurs when incrementing or copying HP [not true (we need REX for 64 + bit add and mov too); only overhead is when accessing floats on the + heap /Luna]. +- XXX: HiPE/x86 could just as easily use %ebx for HP. HiPE/AMD64 could use + %rbx, but the performance impact is probably minor. Try&measure? +- XXX: Cache SP_LIMIT, HP_LIMIT, and FCALLS in registers? Try&measure. + +Calling Convention +------------------ +Same as in the HiPE/x86 ABI, with the following adjustments: + +The first NR_ARG_REGS (a tunable parameter between 0 and 6, inclusive) +parameters are passed in %rsi, %rdx, %rcx, %r8, %r9, and %rdi. + +The first return value from a function is placed in %rax, the second +(if any) is placed in %rdx. + +Notes: +- Currently, NR_ARG_REGS==0. +- C BIFs expect P in C parameter register 1: %rdi. By making Erlang + parameter registers 1-5 coincide with C parameter registers 2-6, + our BIF wrappers can simply move P to %rdi without having to shift + the remaining parameter registers. +- A few primop calls target C functions that do not take a P parameter. + For these, the code generator should have a "ccall" instruction which + passes parameters starting with %rdi instead of %rsi. +- %rdi can still be used for Erlang parameter passing. The BIF wrappers + will push it to the C stack, but \emph{parameter \#6 would have been + pushed anyway}, so there is no additional overhead. +- We could pass more parameters in %rax, %rbx, %r10, %r11, %r12, %r13, + and %r14. However: + * we may need a scratch register for distant call trampolines + * using >6 argument registers complicates the mode-switch interface + (needs hacks and special-case optimisations) + * it is questionable whether using more than 6 improves performance; + it may be better to just cache more P state in registers + +Instruction Encoding / Code Model +--------------------------------- +AMD64 maintains x86's limit of <= 32 bits for PC-relative offsets +in call and jmp instructions. HiPE/AMD64 handles this as follows: +- The compiler emits ordinary call/jmp instructions for + recursive calls and tailcalls. +- The runtime system code is loaded into the low 32 bits of the + address space. (C/AMD64 small or medium code model.) By using mmap() + with the MAP_32BIT flag when allocating memory for code, all + code will be in the low 32 bits of the address space, and hence + no trampolines will be necessary. + +When generating code for non-immediate literals (boxed objects in +the constants pool), the code generator should use AMD64's new +instruction for loading a 64-bit immediate into a register: +mov reg,imm with a rex prefix. + +Notes: +- The loader/linker could redirect a distant call (where the offset + does not fit in a 32-bit signed immediate) to a linker-generated + trampoline. However, managing trampolines requires changes in the + loaders and possibly also the object code format, since the trampoline + must be close to the call site, which implies that code and its + trampolines must be created as a unit. This is the better long-term + solution, not just for AMD64 but also for SPARC32 and PowerPC, + both of which have similar problems. +- The constants pool could also be restricted to the low 32 bits of + the address space. However: + * We want to move away from a single constants pool. With multiple + areas, the address space restriction may be unrealistic. + * Creating the address of a literal is an infrequent operation, so + the performance impact of using 64-bit immediates should be minor. + +Stack Frame Layout +Garbage Collection Interface +BIFs +Stacks and Unix Signal Handlers +------------------------------- +Same as in the HiPE/x86 ABI. + + +Standard C/AMD64 Calling Conventions +==================================== +See . + +%rax, %rdx, %rcx, %rsi, %rdi, %r8, %r9, %r10, %r11 are clobbered by calls (caller-save) +%rsp, %rbp, %rbx, %r12, %r13, %r14, %r15 are preserved by calls (callee-save) +[note: %rsi and %rdi are calleR-save, not calleE-save as in the x86 ABI] +%rsp is the stack pointer (fixed). It is required that ((%rsp+8) & 15) == 0 +when a function is entered. (Section 3.2.2 in the ABI document.) +%rbp is optional frame pointer or local variable +The first six integer parameters are passed in %rdi, %rsi, %rdx, %rcx, %r8, and %r9. +Remaining integer parameters are pushed right-to-left on the stack. +When calling a variadic function, %rax (%al actually) must contain an upper +bound on the number of SSE parameter registers, 0-8 inclusive. +%r10 is used for passing a function's static chain pointer. +%r11 is available for PLT code when computing the target address. +The first integer return value is put in %rax, the second (for __int128) in %rdx. +A memory return value (exact definition is complicated, but basically "large struct"), +is implemented as follows: the caller passes a pointer in %rdi as a hidden first +parameter, the callee stores the result there and returns this pointer in %rax. +The caller deallocates stacked parameters after return (addq $N, %rsp). + +Windows 64-bit C Calling Conventions +==================================== +See "Calling Convention for x64 64-Bit Environments" in msdn. + +%rax, %rcx, %rdx, %r8, %r9, %r10, %r11 are clobbered by calls (caller-save). +%rsp, %rbp, %rbx, %rsi, %rdi, %r12, %r13, %r14, %r15 are preserved +by calls (callee-save). +[Note: %rsi and %rdi are calleE-save not calleR-save as in the Linux/Solaris ABI] +%rsp is the stack pointer (fixed). %rsp & 15 should be 0 at all times, +except at the start of a function's prologue when ((%rsp+8) & 15) == 0. +Leaf functions may leave (%rsp & 15) != 0. +The first four integer parameters are passed in %rcx, %rdx, %r8, and %r9. +Remaining integer parameters are pushed right-to-left on the stack, +starting at the fifth slot above the caller's stack pointer. +The bottom of the caller's frame must contain 4 slots where the callee +can save the four integer parameter registers, even if fewer than 4 +parameters are passed in registers. +An integer return value is put in %rax. Large integers (_m128), floats, +and doubles are returned in %xmm0. Larger return values cause the caller +to pass a pointer to a result buffer in %rcx as a hidden first parameter. +The caller may deallocate stacked parameters after return (addq $N, %rsp). diff --git a/erts/emulator/hipe/hipe_amd64_asm.m4 b/erts/emulator/hipe/hipe_amd64_asm.m4 new file mode 100644 index 0000000000..9ce9b4fc5b --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64_asm.m4 @@ -0,0 +1,244 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ +`#ifndef HIPE_AMD64_ASM_H +#define HIPE_AMD64_ASM_H' + +dnl +dnl Tunables. +dnl +define(LEAF_WORDS,24)dnl number of stack words for leaf functions +define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive +define(HP_IN_REGISTER,1)dnl 1 to reserve a global register for HP +define(FCALLS_IN_REGISTER,0)dnl 1 to reserve global register for FCALLS +define(HEAP_LIMIT_IN_REGISTER,0)dnl global for HL +define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns + +`#define AMD64_LEAF_WORDS 'LEAF_WORDS +`#define LEAF_WORDS 'LEAF_WORDS + +/* + * Reserved registers. + */ +`#define P %rbp' + +`#define AMD64_HP_IN_REGISTER 'HP_IN_REGISTER +`#if AMD64_HP_IN_REGISTER +#define AMD64_HEAP_POINTER 15' +define(HP,%r15)dnl Only change this together with above +`#define SAVE_HP movq 'HP`, P_HP(P) +#define RESTORE_HP movq P_HP(P), 'HP` +#else +#define SAVE_HP /*empty*/ +#define RESTORE_HP /*empty*/ +#endif' + +`#define AMD64_FCALLS_IN_REGISTER 'FCALLS_IN_REGISTER +`#if AMD64_FCALLS_IN_REGISTER +#define AMD64_FCALLS_REGISTER 11' +define(FCALLS,%r11)dnl This goes together with line above +`#define SAVE_FCALLS movq 'FCALLS`, P_FCALLS(P) +#define RESTORE_FCALLS movq P_FCALLS(P), 'FCALLS` +#else +#define SAVE_FCALLS /*empty*/ +#define RESTORE_FCALLS /*empty*/ +#endif' + +`#define AMD64_HEAP_LIMIT_IN_REGISTER 'HEAP_LIMIT_IN_REGISTER +`#if AMD64_HEAP_LIMIT_IN_REGISTER +#define AMD64_HEAP_LIMIT_REGISTER 12' +define(HEAP_LIMIT,%r12)dnl Change this together with line above +`#define RESTORE_HEAP_LIMIT movq P_HP_LIMIT(P), 'HEAP_LIMIT` +#else +#define RESTORE_HEAP_LIMIT /*empty*/ +#endif' + +define(NSP,%rsp)dnl +`#define NSP 'NSP +`#define SAVE_CSP movq %rsp, P_CSP(P) +#define RESTORE_CSP movq P_CSP(P), %rsp' + +`#define AMD64_SIMULATE_NSP 'SIMULATE_NSP + +/* + * Context switching macros. + */ +`#define SWITCH_C_TO_ERLANG_QUICK \ + SAVE_CSP; \ + movq P_NSP(P), NSP' + +`#define SWITCH_ERLANG_TO_C_QUICK \ + movq NSP, P_NSP(P); \ + RESTORE_CSP' + +`#define SAVE_CACHED_STATE \ + SAVE_HP; \ + SAVE_FCALLS' + +`#define RESTORE_CACHED_STATE \ + RESTORE_HP; \ + RESTORE_HEAP_LIMIT; \ + RESTORE_FCALLS' + +`#define SWITCH_C_TO_ERLANG \ + RESTORE_CACHED_STATE; \ + SWITCH_C_TO_ERLANG_QUICK' + +`#define SWITCH_ERLANG_TO_C \ + SAVE_CACHED_STATE; \ + SWITCH_ERLANG_TO_C_QUICK' + +/* + * Argument (parameter) registers. + */ +`#define AMD64_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +define(defarg,`define(ARG$1,`$2')dnl +#`define ARG'$1 $2' +)dnl + +ifelse(eval(NR_ARG_REGS >= 1),0,, +`defarg(0,`%rsi')')dnl +ifelse(eval(NR_ARG_REGS >= 2),0,, +`defarg(1,`%rdx')')dnl +ifelse(eval(NR_ARG_REGS >= 3),0,, +`defarg(2,`%rcx')')dnl +ifelse(eval(NR_ARG_REGS >= 4),0,, +`defarg(3,`%r8')')dnl +ifelse(eval(NR_ARG_REGS >= 5),0,, +`defarg(4,`%r9')')dnl +ifelse(eval(NR_ARG_REGS >= 6),0,, +`defarg(5,`%rdi')')dnl + +/* + * TEMP_RV: + * Used in nbif_stack_trap_ra to preserve the return value. + * Must be a C callee-save register. + * Must be otherwise unused in the return path. + */ +`#define TEMP_RV %rbx' + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_amd64_glue.S support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl LOAD_ARG_REGS +dnl (identical to x86 version except for movq) +dnl +define(LAR_1,`movq P_ARG$1(P), ARG$1 ; ')dnl +define(LAR_N,`ifelse(eval($1 >= 0),0,,`LAR_N(eval($1-1))LAR_1($1)')')dnl +define(LOAD_ARG_REGS,`LAR_N(eval(NR_ARG_REGS-1))')dnl +`#define LOAD_ARG_REGS 'LOAD_ARG_REGS + +dnl +dnl STORE_ARG_REGS +dnl (identical to x86 version except for movq) +dnl +define(SAR_1,`movq ARG$1, P_ARG$1(P) ; ')dnl +define(SAR_N,`ifelse(eval($1 >= 0),0,,`SAR_N(eval($1-1))SAR_1($1)')')dnl +define(STORE_ARG_REGS,`SAR_N(eval(NR_ARG_REGS-1))')dnl +`#define STORE_ARG_REGS 'STORE_ARG_REGS + +dnl +dnl NSP_CALL(FUN) +dnl Emit a CALL FUN instruction, or simulate it. +dnl FUN must not be an NSP-based memory operand. +dnl +ifelse(eval(SIMULATE_NSP),0, +``#define NSP_CALL(FUN) call FUN'', +``#define NSP_CALL(FUN) subq $8,NSP; leaq 1f(%rip),%rax; movq %rax,(NSP); jmp FUN; 1:'')dnl + +dnl +dnl NSP_RETN(NPOP) +dnl Emit a RET $NPOP instruction, or simulate it. +dnl NPOP should be non-zero. +dnl +ifelse(eval(SIMULATE_NSP),0, +``#define NSP_RETN(NPOP) ret $NPOP'', +``#define NSP_RETN(NPOP) movq (NSP),TEMP_RV; addq $8+NPOP,NSP; jmp *TEMP_RV'')dnl + +dnl +dnl NSP_RET0 +dnl Emit a RET instruction, or simulate it. +dnl +ifelse(eval(SIMULATE_NSP),0, +``#define NSP_RET0 ret'', +``#define NSP_RET0 movq (NSP),TEMP_RV; addq $8,NSP; jmp *TEMP_RV'')dnl + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_amd64_bifs.m4 support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl NBIF_ARG(DST,ARITY,ARGNO) +dnl Access a formal parameter. +dnl It will be a memory load via NSP when ARGNO >= NR_ARG_REGS. +dnl It will be a register move when 0 <= ARGNO < NR_ARG_REGS; if +dnl the source and destination are the same, the move is suppressed. +dnl +dnl This must be called before SWITCH_ERLANG_TO_C{,QUICK}. +dnl This must not be called if the C BIF's arity > 6. +dnl +define(NBIF_MOVE_REG,`ifelse($1,$2,`# movq $2, $1',`movq $2, $1')')dnl +define(NBIF_REG_ARG,`NBIF_MOVE_REG($1,ARG$2)')dnl +define(NBIF_STK_LOAD,`movq $2(NSP), $1')dnl +define(NBIF_STK_ARG,`NBIF_STK_LOAD($1,eval(8*($2-$3)))')dnl +define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_STK_ARG($1,$2,$3)')')dnl +`/* #define NBIF_ARG_1_0 'NBIF_ARG(%rsi,1,0)` */' +`/* #define NBIF_ARG_2_0 'NBIF_ARG(%rsi,2,0)` */' +`/* #define NBIF_ARG_2_1 'NBIF_ARG(%rdx,2,1)` */' +`/* #define NBIF_ARG_3_0 'NBIF_ARG(%rsi,3,0)` */' +`/* #define NBIF_ARG_3_1 'NBIF_ARG(%rdx,3,1)` */' +`/* #define NBIF_ARG_3_2 'NBIF_ARG(%rcx,3,2)` */' +`/* #define NBIF_ARG_5_0 'NBIF_ARG(%rsi,5,0)` */' +`/* #define NBIF_ARG_5_1 'NBIF_ARG(%rdx,5,1)` */' +`/* #define NBIF_ARG_5_2 'NBIF_ARG(%rcx,5,2)` */' +`/* #define NBIF_ARG_5_3 'NBIF_ARG(%r8,5,3)` */' +`/* #define NBIF_ARG_5_4 'NBIF_ARG(%r9,5,4)` */' + +dnl XXX: For >6 arity C BIFs, we need: +dnl NBIF_COPY_NSP(ARITY) +dnl SWITCH_ERLANG_TO_C +dnl NBIF_GE6_ARG_MOVE(DSTREG,ARITY,ARGNO) +dnl pushq NBIF_GE6_ARG_OPND(ARITY,ARGNO) <-- uses NSP copied above + +dnl +dnl NBIF_RET(ARITY) +dnl Generates a return from a native BIF, taking care to pop +dnl any stacked formal parameters. +dnl +define(RET_POP,`ifelse(eval($1 > NR_ARG_REGS),0,0,eval(8*($1 - NR_ARG_REGS)))')dnl +define(NBIF_RET_N,`ifelse(eval($1),0,`NSP_RET0',`NSP_RETN($1)')')dnl +define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl +`/* #define NBIF_RET_0 'NBIF_RET(0)` */' +`/* #define NBIF_RET_1 'NBIF_RET(1)` */' +`/* #define NBIF_RET_2 'NBIF_RET(2)` */' +`/* #define NBIF_RET_3 'NBIF_RET(3)` */' +`/* #define NBIF_RET_5 'NBIF_RET(5)` */' + +`#endif /* HIPE_AMD64_ASM_H */' diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4 new file mode 100644 index 0000000000..66fd167f47 --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64_bifs.m4 @@ -0,0 +1,555 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ + +include(`hipe/hipe_amd64_asm.m4') +#`include' "hipe_literals.h" + +`#if THE_NON_VALUE == 0 +#define TEST_GOT_EXN testq %rax, %rax +#else +#define TEST_GOT_EXN cmpq $THE_NON_VALUE, %rax +#endif' + +`#define TEST_GOT_MBUF movq P_MBUF(P), %rdx; testq %rdx, %rdx; jnz 3f; 2: +#define JOIN3(A,B,C) A##B##C +#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); jmp 2b' + +/* + * standard_bif_interface_1(nbif_name, cbif_name) + * standard_bif_interface_2(nbif_name, cbif_name) + * standard_bif_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 1-3 parameters and + * standard failure mode. + */ +define(standard_bif_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,1,0) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + call $2 + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_1_simple_exception + NBIF_RET(1) + HANDLE_GOT_MBUF(1) + .size $1,.-$1 + .type $1,@function +#endif') + +define(standard_bif_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,2,0) + NBIF_ARG(%rdx,2,1) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + call $2 + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_2_simple_exception + NBIF_RET(2) + HANDLE_GOT_MBUF(2) + .size $1,.-$1 + .type $1,@function +#endif') + +define(standard_bif_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,3,0) + NBIF_ARG(%rdx,3,1) + NBIF_ARG(%rcx,3,2) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + call $2 + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_3_simple_exception + NBIF_RET(3) + HANDLE_GOT_MBUF(3) + .size $1,.-$1 + .type $1,@function +#endif') + +/* + * fail_bif_interface_0(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 0 parameters and + * standard failure mode. + */ +define(fail_bif_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + call $2 + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_0_simple_exception + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + .size $1,.-$1 + .type $1,@function +#endif') + +/* + * nofail_primop_interface_0(nbif_name, cbif_name) + * nofail_primop_interface_1(nbif_name, cbif_name) + * nofail_primop_interface_2(nbif_name, cbif_name) + * nofail_primop_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 ordinary parameters and no failure mode. + * Also used for guard BIFs. + */ +define(nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + call $2 + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* return */ + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + .size $1,.-$1 + .type $1,@function +#endif') + +define(nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,1,0) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + call $2 + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* return */ + NBIF_RET(1) + HANDLE_GOT_MBUF(1) + .size $1,.-$1 + .type $1,@function +#endif') + +define(nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,2,0) + NBIF_ARG(%rdx,2,1) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + call $2 + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* return */ + NBIF_RET(2) + HANDLE_GOT_MBUF(2) + .size $1,.-$1 + .type $1,@function +#endif') + +define(nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,3,0) + NBIF_ARG(%rdx,3,1) + NBIF_ARG(%rcx,3,2) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C + call $2 + TEST_GOT_MBUF + SWITCH_C_TO_ERLANG + + /* return */ + NBIF_RET(3) + HANDLE_GOT_MBUF(3) + .size $1,.-$1 + .type $1,@function +#endif') + +/* + * nocons_nofail_primop_interface_0(nbif_name, cbif_name) + * nocons_nofail_primop_interface_1(nbif_name, cbif_name) + * nocons_nofail_primop_interface_2(nbif_name, cbif_name) + * nocons_nofail_primop_interface_3(nbif_name, cbif_name) + * nocons_nofail_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(nocons_nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(0) + .size $1,.-$1 + .type $1,@function +#endif') + +define(nocons_nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,1,0) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(1) + .size $1,.-$1 + .type $1,@function +#endif') + +define(nocons_nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,2,0) + NBIF_ARG(%rdx,2,1) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(2) + .size $1,.-$1 + .type $1,@function +#endif') + +define(nocons_nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,3,0) + NBIF_ARG(%rdx,3,1) + NBIF_ARG(%rcx,3,2) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(3) + .size $1,.-$1 + .type $1,@function +#endif') + +define(nocons_nofail_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + movq P, %rdi + NBIF_ARG(%rsi,5,0) + NBIF_ARG(%rdx,5,1) + NBIF_ARG(%rcx,5,2) + NBIF_ARG(%r8,5,3) + NBIF_ARG(%r9,5,4) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(5) + .size $1,.-$1 + .type $1,@function +#endif') + +/* + * noproc_primop_interface_0(nbif_name, cbif_name) + * noproc_primop_interface_1(nbif_name, cbif_name) + * noproc_primop_interface_2(nbif_name, cbif_name) + * noproc_primop_interface_3(nbif_name, cbif_name) + * noproc_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with no implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(noproc_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(0) + .size $1,.-$1 + .type $1,@function +#endif') + +define(noproc_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + NBIF_ARG(%rdi,1,0) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(1) + .size $1,.-$1 + .type $1,@function +#endif') + +define(noproc_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + NBIF_ARG(%rdi,2,0) + NBIF_ARG(%rsi,2,1) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(2) + .size $1,.-$1 + .type $1,@function +#endif') + +define(noproc_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + NBIF_ARG(%rdi,3,0) + NBIF_ARG(%rsi,3,1) + NBIF_ARG(%rdx,3,2) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(3) + .size $1,.-$1 + .type $1,@function +#endif') + +define(noproc_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .section ".text" + .align 4 + .global $1 +$1: + /* set up the parameters */ + NBIF_ARG(%rdi,5,0) + NBIF_ARG(%rsi,5,1) + NBIF_ARG(%rdx,5,2) + NBIF_ARG(%rcx,5,3) + NBIF_ARG(%r8,5,4) + + /* make the call on the C stack */ + SWITCH_ERLANG_TO_C_QUICK + call $2 + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(5) + .size $1,.-$1 + .type $1,@function +#endif') + +/* + * AMD64-specific primops. + */ +noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu) + +/* + * Implement gc_bif_interface_0 as nofail_primop_interface_0. + */ +define(gc_bif_interface_0,`nofail_primop_interface_0($1, $2)') + +/* + * Implement gc_bif_interface_N as standard_bif_interface_N (N=1,2). + */ +define(gc_bif_interface_1,`standard_bif_interface_1($1, $2)') +define(gc_bif_interface_2,`standard_bif_interface_2($1, $2)') + +/* + * Implement gc_nofail_primop_interface_1 as nofail_primop_interface_1. + */ +define(gc_nofail_primop_interface_1,`nofail_primop_interface_1($1, $2)') + +include(`hipe/hipe_bif_list.m4') + +`#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif' diff --git a/erts/emulator/hipe/hipe_amd64_gc.h b/erts/emulator/hipe/hipe_amd64_gc.h new file mode 100644 index 0000000000..56650901d6 --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64_gc.h @@ -0,0 +1,30 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * Stack walking helpers for native stack GC procedures. + */ +#ifndef HIPE_AMD64_GC_H +#define HIPE_AMD64_GC_H + +#include "hipe_amd64_asm.h" /* for NR_ARG_REGS */ + +#define HIPE_X86_ASM_H +#include "hipe_x86_gc.h" + +#endif /* HIPE_AMD64_GC_H */ diff --git a/erts/emulator/hipe/hipe_amd64_glue.S b/erts/emulator/hipe/hipe_amd64_glue.S new file mode 100644 index 0000000000..872c5dc9e3 --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64_glue.S @@ -0,0 +1,443 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ + +#include "hipe_amd64_asm.h" +#include "hipe_literals.h" +#define ASM +#include "hipe_mode_switch.h" + +/* + * Note: the mode-switch entry points in hipe_amd64_glue.S have + * the same names as in hipe_x86_glue.S. This is intentional, + * as it allows using hipe_x86_glue.h with AMD64. + */ + +/* + * Set up frame on C stack, + * save C callee-save registers, + * retrieve the process pointer from the parameters from C, + * SWITCH_C_TO_ERLANG. + * + * The end of the frame must be 16-byte aligned, otherwise + * calls to C may break. %rsp+8 is 16-byte aligned on entry, + * and six registers are to be saved, so a seventh word is + * added to make the resulting %rsp 16-byte aligned. + */ +#define ENTER_FROM_C \ + /* save C callee-save registers on the C stack */ \ + subq $(7*8), %rsp; \ + movq %r15, 40(%rsp); \ + movq %r14, 32(%rsp); \ + movq %r13, 24(%rsp); \ + movq %r12, 16(%rsp); \ + movq %rbx, 8(%rsp); \ + movq %rbp, (%rsp); \ + /* get the process pointer */ \ + movq %rdi, P; \ + /* switch to native stack */ \ + SWITCH_C_TO_ERLANG + + .section ".text" + +/* + * int x86_call_to_native(Process *p); + * Emulated code recursively calls native code. + */ + .align 4 + .global x86_call_to_native + .global nbif_return +x86_call_to_native: + ENTER_FROM_C + /* get argument registers */ + LOAD_ARG_REGS + /* call the target */ + NSP_CALL(*P_NCALLEE(P)) +/* + * We export this return address so that hipe_mode_switch() can discover + * when native code tailcalls emulated code. + * + * This is where native code returns to emulated code. + */ +nbif_return: + movq %rax, P_ARG0(P) # save retval + movl $HIPE_MODE_SWITCH_RES_RETURN, %eax +/* FALLTHROUGH to .flush_exit + * + * Return to the calling C function with result token in %eax. + * + * .nosave_exit saves no state + * .flush_exit saves cached P state + * .suspend_exit also saves RA + */ +.suspend_exit: + /* save RA, no-op on x86 */ +.flush_exit: + /* flush cached P state */ + SAVE_CACHED_STATE +.nosave_exit: + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + /* restore C callee-save registers, drop frame, return */ + movq (%rsp), %rbp # kills P + movq 8(%rsp), %rbx + movq 16(%rsp), %r12 + movq 24(%rsp), %r13 + movq 32(%rsp), %r14 + movq 40(%rsp), %r15 # kills HP + addq $(7*8), %rsp + ret + +/* + * Native code calls emulated code via a linker-generated + * stub (hipe_x86_loader.erl) which should look as follows: + * + * stub for f/N: + * movq $, P_BEAM_IP(P) + * movb $, P_ARITY(P) + * jmp nbif_callemu + * + * XXX: Different stubs for different number of register parameters? + */ + .align 4 + .global nbif_callemu +nbif_callemu: + STORE_ARG_REGS + movl $HIPE_MODE_SWITCH_RES_CALL, %eax + jmp .suspend_exit + +/* + * nbif_apply + */ + .align 4 + .global nbif_apply +nbif_apply: + STORE_ARG_REGS + movl $HIPE_MODE_SWITCH_RES_APPLY, %eax + jmp .suspend_exit + +/* + * Native code calls an emulated-mode closure via a stub defined below. + * + * The closure is appended as the last actual parameter, and parameters + * beyond the first few passed in registers are pushed onto the stack in + * left-to-right order. + * Hence, the location of the closure parameter only depends on the number + * of parameters in registers, not the total number of parameters. + */ +#if NR_ARG_REGS >= 6 + .align 4 + .global nbif_ccallemu6 +nbif_ccallemu6: + movq ARG5, P_ARG5(P) +#if NR_ARG_REGS > 6 + movq ARG6, ARG5 +#else + movq 8(NSP), ARG5 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 5 + .align 4 + .global nbif_ccallemu5 +nbif_ccallemu5: + movq ARG4, P_ARG4(P) +#if NR_ARG_REGS > 5 + movq ARG5, ARG4 +#else + movq 8(NSP), ARG4 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 4 + .align 4 + .global nbif_ccallemu4 +nbif_ccallemu4: + movq ARG3, P_ARG3(P) +#if NR_ARG_REGS > 4 + movq ARG4, ARG3 +#else + movq 8(NSP), ARG3 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 3 + .align 4 + .global nbif_ccallemu3 +nbif_ccallemu3: + movq ARG2, P_ARG2(P) +#if NR_ARG_REGS > 3 + movq ARG3, ARG2 +#else + movq 8(NSP), ARG2 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 2 + .align 4 + .global nbif_ccallemu2 +nbif_ccallemu2: + movq ARG1, P_ARG1(P) +#if NR_ARG_REGS > 2 + movq ARG2, ARG1 +#else + movq 8(NSP), ARG1 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 1 + .align 4 + .global nbif_ccallemu1 +nbif_ccallemu1: + movq ARG0, P_ARG0(P) +#if NR_ARG_REGS > 1 + movq ARG1, ARG0 +#else + movq 8(NSP), ARG0 +#endif + /*FALLTHROUGH*/ +#endif + + .align 4 + .global nbif_ccallemu0 +nbif_ccallemu0: + /* We use %rsi not ARG0 here because ARG0 is not + defined when NR_ARG_REGS == 0. */ +#if NR_ARG_REGS == 0 + movq 8(NSP), %rsi +#endif + movq %rsi, P_CLOSURE(P) + movl $HIPE_MODE_SWITCH_RES_CALL_CLOSURE, %eax + jmp .suspend_exit + +/* + * This is where native code suspends. + */ + .align 4 + .global nbif_suspend_0 +nbif_suspend_0: + movl $HIPE_MODE_SWITCH_RES_SUSPEND, %eax + jmp .suspend_exit + +/* + * Suspend from a receive (waiting for a message) + */ + .align 4 + .global nbif_suspend_msg +nbif_suspend_msg: + movl $HIPE_MODE_SWITCH_RES_WAIT, %eax + jmp .suspend_exit + +/* + * Suspend from a receive with a timeout (waiting for a message) + * if (!(p->flags & F_TIMO)) { suspend } + * else { return 0; } + */ + .align 4 + .global nbif_suspend_msg_timeout +nbif_suspend_msg_timeout: + movq P_FLAGS(P), %rax + /* this relies on F_TIMO (1<<2) fitting in a byte */ + testb $F_TIMO, %al # F_TIMO set? + jz .no_timeout # if not set, suspend + /* timeout has occurred */ + xorl %eax, %eax # return 0 to signal timeout + NSP_RET0 +.no_timeout: + movl $HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT, %eax + jmp .suspend_exit + +/* + * int x86_return_to_native(Process *p); + * Emulated code returns to its native code caller. + */ + .align 4 + .global x86_return_to_native +x86_return_to_native: + ENTER_FROM_C + /* get return value */ + movq P_ARG0(P), %rax + /* + * Return using the stacked return address. + * The parameters were popped at the original native-to-emulated + * call (hipe_call_from_native_is_recursive), so a plain ret suffices. + */ + NSP_RET0 + +/* + * int x86_tailcall_to_native(Process *p); + * Emulated code tailcalls native code. + */ + .align 4 + .global x86_tailcall_to_native +x86_tailcall_to_native: + ENTER_FROM_C + /* get argument registers */ + LOAD_ARG_REGS + /* jump to the target label */ + jmp *P_NCALLEE(P) + +/* + * int x86_throw_to_native(Process *p); + * Emulated code throws an exception to its native code caller. + */ + .align 4 + .global x86_throw_to_native +x86_throw_to_native: + ENTER_FROM_C + /* invoke the handler */ + jmp *P_NCALLEE(P) # set by hipe_find_handler() + +/* + * This is the default exception handler for native code. + */ + .align 4 + .global nbif_fail +nbif_fail: + movl $HIPE_MODE_SWITCH_RES_THROW, %eax + jmp .flush_exit + + .global nbif_0_gc_after_bif + .global nbif_1_gc_after_bif + .global nbif_2_gc_after_bif + .global nbif_3_gc_after_bif + .align 4 +nbif_0_gc_after_bif: + xorl %edx, %edx + jmp .gc_after_bif + .align 4 +nbif_1_gc_after_bif: + movl $1, %edx + jmp .gc_after_bif + .align 4 +nbif_2_gc_after_bif: + movl $2, %edx + jmp .gc_after_bif + .align 4 +nbif_3_gc_after_bif: + movl $3, %edx + /*FALLTHROUGH*/ + .align 4 +.gc_after_bif: + movl %edx, P_NARITY(P) # Note: narity is a 32-bit field + subq $(16-8), %rsp + movq P, %rdi + movq %rax, %rsi + call erts_gc_after_bif_call + addq $(16-8), %rsp + movl $0, P_NARITY(P) # Note: narity is a 32-bit field + ret + +/* + * We end up here when a BIF called from native signals an + * exceptional condition. + * The stack/heap registers were just read from P. + */ + .global nbif_0_simple_exception + .global nbif_1_simple_exception + .global nbif_2_simple_exception + .global nbif_3_simple_exception + .align 4 +nbif_0_simple_exception: + xorl %eax, %eax + jmp .nbif_simple_exception + .align 4 +nbif_1_simple_exception: + movl $1, %eax + jmp .nbif_simple_exception + .align 4 +nbif_2_simple_exception: + movl $2, %eax + jmp .nbif_simple_exception + .align 4 +nbif_3_simple_exception: + movl $3, %eax + /*FALLTHROUGH*/ + .align 4 +.nbif_simple_exception: + cmpq $FREASON_TRAP, P_FREASON(P) + je .handle_trap + /* + * Find and invoke catch handler (it must exist). + * The stack/heap registers were just read from P. + * - %eax should contain the current call's arity + */ + movl %eax, P_NARITY(P) # Note: narity is a 32-bit field + /* find and prepare to invoke the handler */ + SWITCH_ERLANG_TO_C_QUICK # The cached state is clean and need not be saved. + movq P, %rdi + call hipe_handle_exception # Note: hipe_handle_exception() conses + SWITCH_C_TO_ERLANG # %rsp updated by hipe_find_handler() + /* now invoke the handler */ + jmp *P_NCALLEE(P) # set by hipe_find_handler() + + /* + * A BIF failed with freason TRAP: + * - the BIF's arity is in %rax + * - the native heap/stack/reds registers are saved in P + */ +.handle_trap: + movq %rax, P_NARITY(P) + movl $HIPE_MODE_SWITCH_RES_TRAP, %eax + jmp .nosave_exit + +/* + * nbif_stack_trap_ra: trap return address for maintaining + * the gray/white stack boundary + */ + .global nbif_stack_trap_ra + .align 4 +nbif_stack_trap_ra: # a return address, not a function + # This only handles a single return value. + # If we have more, we need to save them in the PCB. + movq %rax, TEMP_RV # save retval + SWITCH_ERLANG_TO_C_QUICK + movq P, %rdi + call hipe_handle_stack_trap # must not cons; preserves TEMP_RV + movq %rax, %rdx # original RA + SWITCH_C_TO_ERLANG_QUICK + movq TEMP_RV, %rax # restore retval + jmp *%rdx # resume at original RA + +/* + * nbif_inc_stack_0 + */ + .global nbif_inc_stack_0 + .align 4 +nbif_inc_stack_0: + SWITCH_ERLANG_TO_C_QUICK + STORE_ARG_REGS + movq P, %rdi + # hipe_inc_nstack reads and writes NSP and NSP_LIMIT, + # but does not access HP or FCALLS (or the non-amd64 NRA). + call hipe_inc_nstack + LOAD_ARG_REGS + SWITCH_C_TO_ERLANG_QUICK + NSP_RET0 + +#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif diff --git a/erts/emulator/hipe/hipe_amd64_glue.h b/erts/emulator/hipe/hipe_amd64_glue.h new file mode 100644 index 0000000000..c92eb842cb --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64_glue.h @@ -0,0 +1,30 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ +#ifndef HIPE_AMD64_GLUE_H +#define HIPE_AMD64_GLUE_H + +#include "hipe_amd64_asm.h" /* for NR_ARG_REGS */ + +#define HIPE_X86_ASM_H +#include "hipe_x86_glue.h" + +#endif /* HIPE_AMD64_GLUE_H */ diff --git a/erts/emulator/hipe/hipe_amd64_primops.h b/erts/emulator/hipe/hipe_amd64_primops.h new file mode 100644 index 0000000000..dcfa8be92a --- /dev/null +++ b/erts/emulator/hipe/hipe_amd64_primops.h @@ -0,0 +1,23 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +PRIMOP_LIST(am_inc_stack_0, &nbif_inc_stack_0) +PRIMOP_LIST(am_handle_fp_exception, &nbif_handle_fp_exception) +PRIMOP_LIST(am_sse2_fnegate_mask, &sse2_fnegate_mask) diff --git a/erts/emulator/hipe/hipe_arch.h b/erts/emulator/hipe/hipe_arch.h new file mode 100644 index 0000000000..7803543ef1 --- /dev/null +++ b/erts/emulator/hipe/hipe_arch.h @@ -0,0 +1,54 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_ARCH_H +#define HIPE_ARCH_H + +extern const void *hipe_arch_primop_address(Eterm key); + +/* used by beam_load.c:patch(). patchtype == am_load_fe, Value is an ErlFunEntry* */ +extern void hipe_patch_address(Uint *address, Eterm patchtype, Uint value); +extern void hipe_patch_load_fe(Uint *address, Uint value); +extern int hipe_patch_insn(void *address, Uint value, Eterm type); +extern int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline); + +extern void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity); + +#if defined(__sparc__) +#include "hipe_sparc.h" +#endif +#if defined(__i386__) +#include "hipe_x86.h" +#endif +#if defined(__x86_64__) +#include "hipe_amd64.h" +#endif +#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#include "hipe_ppc.h" +#endif +#if defined(__arm__) +#include "hipe_arm.h" +#endif + +#if !defined(AEXTERN) +#define AEXTERN(RET,NAME,PROTO) extern RET NAME PROTO +#endif + +#endif /* HIPE_ARCH_H */ diff --git a/erts/emulator/hipe/hipe_arm.c b/erts/emulator/hipe/hipe_arm.c new file mode 100644 index 0000000000..b70b32947b --- /dev/null +++ b/erts/emulator/hipe/hipe_arm.c @@ -0,0 +1,401 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#include /* offsetof() */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" +#include "erl_binary.h" +#include + +#include "hipe_arch.h" +#include "hipe_native_bif.h" /* nbif_callemu() */ +#include "hipe_bif0.h" + +/* Flush dcache and invalidate icache for a range of addresses. */ +void hipe_flush_icache_range(void *address, unsigned int nbytes) +{ +#if defined(__ARM_EABI__) + register unsigned long beg __asm__("r0") = (unsigned long)address; + register unsigned long end __asm__("r1") = (unsigned long)address + nbytes; + register unsigned long flg __asm__("r2") = 0; + register unsigned long scno __asm__("r7") = 0xf0002; + __asm__ __volatile__("swi 0" /* sys_cacheflush() */ + : "=r"(beg) + : "0"(beg), "r"(end), "r"(flg), "r"(scno)); +#else + register unsigned long beg __asm__("r0") = (unsigned long)address; + register unsigned long end __asm__("r1") = (unsigned long)address + nbytes; + register unsigned long flg __asm__("r2") = 0; + __asm__ __volatile__("swi 0x9f0002" /* sys_cacheflush() */ + : "=r"(beg) + : "0"(beg), "r"(end), "r"(flg)); +#endif +} + +void hipe_flush_icache_word(void *address) +{ + hipe_flush_icache_range(address, 4); +} + +/* + * Management of 32MB code segments for regular code and trampolines. + */ + +#define SEGMENT_NRBYTES (32*1024*1024) /* named constant, _not_ a tunable */ + +static struct segment { + unsigned int *base; /* [base,base+32MB[ */ + unsigned int *code_pos; /* INV: base <= code_pos <= tramp_pos */ + unsigned int *tramp_pos; /* INV: tramp_pos <= base+32MB */ + /* On ARM we always allocate a trampoline at base+32MB-8 for + nbif_callemu, so tramp_pos <= base+32MB-8. */ +} curseg; + +#define in_area(ptr,start,nbytes) \ + ((unsigned long)((char*)(ptr) - (char*)(start)) < (nbytes)) + +static void *new_code_mapping(void) +{ + return mmap(0, SEGMENT_NRBYTES, + PROT_EXEC|PROT_READ|PROT_WRITE, + MAP_PRIVATE|MAP_ANONYMOUS, + -1, 0); +} + +static int check_callees(Eterm callees) +{ + Eterm *tuple; + Uint arity; + Uint i; + + if (is_not_tuple(callees)) + return -1; + tuple = tuple_val(callees); + arity = arityval(tuple[0]); + for (i = 1; i <= arity; ++i) { + Eterm mfa = tuple[i]; + if (is_atom(mfa)) + continue; + if (is_not_tuple(mfa) || + tuple_val(mfa)[0] != make_arityval(3) || + is_not_atom(tuple_val(mfa)[1]) || + is_not_atom(tuple_val(mfa)[2]) || + is_not_small(tuple_val(mfa)[3]) || + unsigned_val(tuple_val(mfa)[3]) > 255) + return -1; + } + return arity; +} + +static unsigned int *try_alloc(Uint nrwords, int nrcallees, Eterm callees, unsigned int **trampvec) +{ + unsigned int *base, *address, *tramp_pos, nrfreewords; + int trampnr; + Eterm mfa, m, f; + unsigned int a, *trampoline; + + m = NIL; f = NIL; a = 0; /* silence stupid compiler warning */ + tramp_pos = curseg.tramp_pos; + address = curseg.code_pos; + nrfreewords = tramp_pos - address; + if (nrwords > nrfreewords) + return NULL; + curseg.code_pos = address + nrwords; + nrfreewords -= nrwords; + + base = curseg.base; + for (trampnr = 1; trampnr <= nrcallees; ++trampnr) { + mfa = tuple_val(callees)[trampnr]; + if (is_atom(mfa)) + trampoline = hipe_primop_get_trampoline(mfa); + else { + m = tuple_val(mfa)[1]; + f = tuple_val(mfa)[2]; + a = unsigned_val(tuple_val(mfa)[3]); + trampoline = hipe_mfa_get_trampoline(m, f, a); + } + if (!in_area(trampoline, base, SEGMENT_NRBYTES)) { + if (nrfreewords < 2) + return NULL; + nrfreewords -= 2; + tramp_pos = trampoline = tramp_pos - 2; + trampoline[0] = 0xE51FF004; /* ldr pc, [pc,#-4] */ + trampoline[1] = 0; /* callee's address */ + hipe_flush_icache_range(trampoline, 2*sizeof(int)); + if (is_atom(mfa)) + hipe_primop_set_trampoline(mfa, trampoline); + else + hipe_mfa_set_trampoline(m, f, a, trampoline); + } + trampvec[trampnr-1] = trampoline; + } + curseg.tramp_pos = tramp_pos; + return address; +} + +void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p) +{ + Uint nrwords; + int nrcallees; + Eterm trampvecbin; + unsigned int **trampvec; + unsigned int *address; + unsigned int *base; + struct segment oldseg; + + if (nrbytes & 0x3) + return NULL; + nrwords = nrbytes >> 2; + + nrcallees = check_callees(callees); + if (nrcallees < 0) + return NULL; + trampvecbin = new_binary(p, NULL, nrcallees*sizeof(unsigned int*)); + trampvec = (unsigned int**)binary_bytes(trampvecbin); + + address = try_alloc(nrwords, nrcallees, callees, trampvec); + if (!address) { + base = new_code_mapping(); + if (base == MAP_FAILED) + return NULL; + oldseg = curseg; + curseg.base = base; + curseg.code_pos = base; + curseg.tramp_pos = (unsigned int*)((char*)base + SEGMENT_NRBYTES); +#if defined(__arm__) + curseg.tramp_pos -= 2; + curseg.tramp_pos[0] = 0xE51FF004; /* ldr pc, [pc,#-4] */ + curseg.tramp_pos[1] = (unsigned int)&nbif_callemu; +#endif + + address = try_alloc(nrwords, nrcallees, callees, trampvec); + if (!address) { + munmap(base, SEGMENT_NRBYTES); + curseg = oldseg; + return NULL; + } + /* commit to new segment, ignore leftover space in old segment */ + } + *trampolines = trampvecbin; + return address; +} + +static unsigned int *alloc_stub(Uint nrwords, unsigned int **tramp_callemu) +{ + unsigned int *address; + unsigned int *base; + struct segment oldseg; + + address = try_alloc(nrwords, 0, NIL, NULL); + if (!address) { + base = new_code_mapping(); + if (base == MAP_FAILED) + return NULL; + oldseg = curseg; + curseg.base = base; + curseg.code_pos = base; + curseg.tramp_pos = (unsigned int*)((char*)base + SEGMENT_NRBYTES); +#if defined(__arm__) + curseg.tramp_pos -= 2; + curseg.tramp_pos[0] = 0xE51FF004; /* ldr pc, [pc,#-4] */ + curseg.tramp_pos[1] = (unsigned int)&nbif_callemu; +#endif + + address = try_alloc(nrwords, 0, NIL, NULL); + if (!address) { + munmap(base, SEGMENT_NRBYTES); + curseg = oldseg; + return NULL; + } + /* commit to new segment, ignore leftover space in old segment */ + } + *tramp_callemu = (unsigned int*)((char*)curseg.base + SEGMENT_NRBYTES) - 2; + return address; +} + +/* + * ARMv5's support for 32-bit immediates is effectively non-existent. + * Hence, every 32-bit immediate is stored in memory and loaded via + * a PC-relative addressing mode. Relocation entries refer to those + * data words, NOT the load instructions, so patching is trivial. + */ +static void patch_imm32(Uint32 *address, unsigned int imm32) +{ + *address = imm32; + hipe_flush_icache_word(address); +} + +void hipe_patch_load_fe(Uint32 *address, Uint value) +{ + patch_imm32(address, value); +} + +int hipe_patch_insn(void *address, Uint32 value, Eterm type) +{ + switch (type) { + case am_closure: + case am_constant: + case am_atom: + case am_c_const: + break; + default: + return -1; + } + patch_imm32((Uint32*)address, value); + return 0; +} + +/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() + and hipe_bif0.c:hipe_make_stub() */ +void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +{ + unsigned int *code; +#if defined(__arm__) + unsigned int *tramp_callemu; + int callemu_offset; +#endif + + /* + * Native code calls BEAM via a stub looking as follows: + * + * mov r0, #beamArity + * ldr r8, [pc,#0] // beamAddress + * b nbif_callemu + * .long beamAddress + * + * I'm using r0 and r8 since they aren't used for + * parameter passing in native code. The branch to + * nbif_callemu may need to go via a trampoline. + * (Trampolines are allowed to modify r12, but they don't.) + */ + +#if !defined(__arm__) + /* verify that 'ba' can reach nbif_callemu */ + if ((unsigned long)&nbif_callemu & ~0x01FFFFFCUL) + abort(); +#endif + +#if defined(__arm__) + code = alloc_stub(4, &tramp_callemu); + callemu_offset = ((int)&nbif_callemu - ((int)&code[2] + 8)) >> 2; + if (!(callemu_offset >= -0x00800000 && callemu_offset <= 0x007FFFFF)) { + callemu_offset = ((int)tramp_callemu - ((int)&code[2] + 8)) >> 2; + if (!(callemu_offset >= -0x00800000 && callemu_offset <= 0x007FFFFF)) + abort(); + } +#else + code = alloc_stub(4, &trampoline); +#endif + +#if defined(__arm__) + /* mov r0, #beamArity */ + code[0] = 0xE3A00000 | (beamArity & 0xFF); + /* ldr r8, [pc,#0] // beamAddress */ + code[1] = 0xE59F8000; + /* b nbif_callemu */ + code[2] = 0xEA000000 | (callemu_offset & 0x00FFFFFF); + /* .long beamAddress */ + code[3] = (unsigned int)beamAddress; +#else + /* addi r12,0,beamAddress@l */ + code[0] = 0x39800000 | ((unsigned long)beamAddress & 0xFFFF); + /* addi r0,0,beamArity */ + code[1] = 0x38000000 | (beamArity & 0x7FFF); + /* addis r12,r12,beamAddress@ha */ + code[2] = 0x3D8C0000 | at_ha((unsigned long)beamAddress); + /* ba nbif_callemu */ + code[3] = 0x48000002 | (unsigned long)&nbif_callemu; +#endif + + hipe_flush_icache_range(code, 4*sizeof(int)); + + return code; +} + +static void patch_b(Uint32 *address, Sint32 offset, Uint32 AA) +{ + Uint32 oldI = *address; +#if defined(__arm__) + Uint32 newI = (oldI & 0xFF000000) | (offset & 0x00FFFFFF); +#else + Uint32 newI = (oldI & 0xFC000001) | ((offset & 0x00FFFFFF) << 2) | (AA & 2); +#endif + *address = newI; + hipe_flush_icache_word(address); +} + +int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline) +{ +#if !defined(__arm__) + if ((Uint32)destAddress == ((Uint32)destAddress & 0x01FFFFFC)) { + /* The destination is in the [0,32MB[ range. + We can reach it with a ba/bla instruction. + This is the typical case for BIFs and primops. + It's also common for trap-to-BEAM stubs (on ppc32). */ + patch_b((Uint32*)callAddress, (Uint32)destAddress >> 2, 2); + } else { +#endif +#if defined(__arm__) + Sint32 destOffset = ((Sint32)destAddress - ((Sint32)callAddress+8)) >> 2; +#else + Sint32 destOffset = ((Sint32)destAddress - (Sint32)callAddress) >> 2; +#endif + if (destOffset >= -0x800000 && destOffset <= 0x7FFFFF) { + /* The destination is within a [-32MB,+32MB[ range from us. + We can reach it with a b/bl instruction. + This is typical for nearby Erlang code. */ + patch_b((Uint32*)callAddress, destOffset, 0); + } else { + /* The destination is too distant for b/bl/ba/bla. + Must do a b/bl to the trampoline. */ +#if defined(__arm__) + Sint32 trampOffset = ((Sint32)trampoline - ((Sint32)callAddress+8)) >> 2; +#else + Sint32 trampOffset = ((Sint32)trampoline - (Sint32)callAddress) >> 2; +#endif + if (trampOffset >= -0x800000 && trampOffset <= 0x7FFFFF) { + /* Update the trampoline's address computation. + (May be redundant, but we can't tell.) */ +#if defined(__arm__) + patch_imm32((Uint32*)trampoline+1, (Uint32)destAddress); +#else + patch_li((Uint32*)trampoline, (Uint32)destAddress); +#endif + /* Update this call site. */ + patch_b((Uint32*)callAddress, trampOffset, 0); + } else + return -1; + } +#if !defined(__arm__) + } +#endif + return 0; +} + +void hipe_arch_print_pcb(struct hipe_process_state *p) +{ +#define U(n,x) \ + printf(" % 4d | %s | 0x%0*lx | %*s |\r\n", (int)offsetof(struct hipe_process_state,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2+2*(int)sizeof(long), "") + U("nra ", nra); + U("narity ", narity); +#undef U +} diff --git a/erts/emulator/hipe/hipe_arm.h b/erts/emulator/hipe/hipe_arm.h new file mode 100644 index 0000000000..84f58a681f --- /dev/null +++ b/erts/emulator/hipe/hipe_arm.h @@ -0,0 +1,47 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_ARM_H +#define HIPE_ARM_H + +extern void hipe_flush_icache_word(void *address); +extern void hipe_flush_icache_range(void *address, unsigned int nbytes); + +/* for stack descriptor hash lookup */ +#define HIPE_RA_LSR_COUNT 2 /* low 2 bits are always zero */ + +/* for hipe_bifs_{read,write}_{s,u}32 */ +static __inline__ int hipe_word32_address_ok(void *address) +{ + return ((unsigned long)address & 0x3) == 0; +} + +/* Native stack growth direction. */ +#define HIPE_NSTACK_GROWS_DOWN + +#define hipe_arch_name am_arm + +extern void hipe_arm_inc_stack(void); + +/* for hipe_bifs_enter_code_2 */ +extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); +#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p)) + +#endif /* HIPE_ARM_H */ diff --git a/erts/emulator/hipe/hipe_arm.tab b/erts/emulator/hipe/hipe_arm.tab new file mode 100644 index 0000000000..81626796a7 --- /dev/null +++ b/erts/emulator/hipe/hipe_arm.tab @@ -0,0 +1,23 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# $Id$ +# ARM-specific atoms and bifs + +atom arm +atom inc_stack_0 diff --git a/erts/emulator/hipe/hipe_arm_abi.txt b/erts/emulator/hipe/hipe_arm_abi.txt new file mode 100644 index 0000000000..6868704d62 --- /dev/null +++ b/erts/emulator/hipe/hipe_arm_abi.txt @@ -0,0 +1,95 @@ + + %CopyrightBegin% + %CopyrightEnd% + +$Id$ + +HiPE ARM ABI +================ +This document describes aspects of HiPE's runtime system +that are specific for the ARM architecture. + +Register Usage +-------------- +r13 is reserved for the C runtime system. +XXX: r10 should be reserved too if stack checking is enabled + +r9-r11 and r15 are fixed (unallocatable). +r9 (HP) is the current process' heap pointer. +r10 (NSP) is the current process' native stack pointer. +r11 (P) is the current process' "Process" pointer. +r15 (pc) is the program counter. + +r0-r8, r12, and r14 (lr) are caller-save. They are used as temporary +scratch registers and for function call parameters and results. + +The runtime system uses temporaries in specific contexts: +r8 (TEMP_LR) is used to preserve lr around BIF calls, +and to pass the callee address in native-to-BEAM traps. +r7 (TEMP_ARG0) is used to preserve the return value in nbif_stack_trap_ra, +and lr in hipe_arm_inc_stack (the caller saved its lr in TEMP_LR). +r1 (ARG0) is used for MBUF-after-BIF checks, for storing the +arity if a BIF that throws an exception or does GC due to MBUF, +and for checking P->flags for pending timeout. +r0 is used to inspect the type of a thrown exception, return a +result token from glue.S back to hipe_mode_switch(), and to pass +the callee arity in native-to-BEAM traps. + +Calling Convention +------------------ +The first NR_ARG_REGS parameters (a tunable parameter between 0 and 6, +inclusive) are passed in r1-r6. + +r0 is not used for parameter passing. This allows the BIF wrappers to +simply move P to r0 without shifting the remaining parameter registers. + +r12 is not used for parameter passing since it may be modified +during function linkage. + +r14 contains the return address during function calls. + +The return value from a function is placed in r0. + +Notes: +- We could pass more parameters in r7, r8, r0, and r12. However: + * distant call and trap-to-BEAM trampolines may need scratch registers + * using >6 argument registers complicates the mode-switch interface + (needs hacks and special-case optimisations) + * it is questionable whether using more than 6 improves performance; + it may be better to just cache more P state in registers + +Stack Frame Layout +------------------ +[From top to bottom: formals in left-to-right order, incoming return +address, fixed-size chunk for locals & spills, variable-size area +for actuals, outgoing return address. NSP normally points at the +bottom of the fixed-size chunk, except during a recursive call. +The callee pops the actuals, so no NSP adjustment at return.] + +Stack Descriptors +----------------- +sdesc_fsize() is the frame size excluding the return address word. + +Standard Linux ARM Calling Conventions +====================================== + +Reg Status Role +--- ------ ---- +r0-r3 calleR-save Argument/result/scratch registers. +r4-r8 calleE-save Local variables. +r9 calleE-save PIC base if PIC and stack checking are both enabled. + Otherwise a local variable. +r10 calleE-save (sl) Stack limit (fixed) if stack checking is enabled. + PIC base if PIC is enabled and stack checking is not. + Otherwise a local variable. +r11 calleE-save (fp) Local variable or frame pointer. +r12 calleR-save (ip) Scratch register, may be modified during + function linkage. +r13 calleE-save (sp) Stack pointer (fixed). Must be 4-byte aligned + at all times. Must be 8-byte aligned during transfers + to/from functions. +r14 calleR-save (lr) Link register or scratch variable. +r15 fixed (pc) Program counter. + +The stack grows from high to low addresses. +Excess parameters are stored on the stack, at SP+0 and up. diff --git a/erts/emulator/hipe/hipe_arm_asm.m4 b/erts/emulator/hipe/hipe_arm_asm.m4 new file mode 100644 index 0000000000..b9a696ffff --- /dev/null +++ b/erts/emulator/hipe/hipe_arm_asm.m4 @@ -0,0 +1,199 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ +`#ifndef HIPE_ARM_ASM_H +#define HIPE_ARM_ASM_H' + +/* + * Tunables. + */ +define(LEAF_WORDS,16)dnl number of stack words for leaf functions +define(NR_ARG_REGS,3)dnl admissible values are 0 to 6, inclusive + +`#define ARM_LEAF_WORDS 'LEAF_WORDS + +/* + * Reserved registers. + */ +`#define P r11' +`#define NSP r10' +`#define HP r9' +`#define TEMP_LR r8' + +/* + * Context switching macros. + * + * RESTORE_CONTEXT and RESTORE_CONTEXT_QUICK do not affect + * the condition register. + */ +`#define SAVE_CONTEXT_QUICK \ + mov TEMP_LR, lr' + +`#define RESTORE_CONTEXT_QUICK \ + mov lr, TEMP_LR' + +`#define SAVE_CACHED_STATE \ + str HP, [P, #P_HP]; \ + str NSP, [P, #P_NSP]' + +`#define RESTORE_CACHED_STATE \ + ldr HP, [P, #P_HP]; \ + ldr NSP, [P, #P_NSP]' + +`#define SAVE_CONTEXT_BIF \ + mov TEMP_LR, lr; \ + str HP, [P, #P_HP]' + +`#define RESTORE_CONTEXT_BIF \ + ldr HP, [P, #P_HP]' + +`#define SAVE_CONTEXT_GC \ + mov TEMP_LR, lr; \ + str lr, [P, #P_NRA]; \ + str NSP, [P, #P_NSP]; \ + str HP, [P, #P_HP]' + +`#define RESTORE_CONTEXT_GC \ + ldr HP, [P, #P_HP]' + +/* + * Argument (parameter) registers. + */ +`#define ARM_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +define(defarg,`define(ARG$1,`$2')dnl +#`define ARG'$1 $2' +)dnl + +ifelse(eval(NR_ARG_REGS >= 1),0,, +`defarg(0,`r1')')dnl +ifelse(eval(NR_ARG_REGS >= 2),0,, +`defarg(1,`r2')')dnl +ifelse(eval(NR_ARG_REGS >= 3),0,, +`defarg(2,`r3')')dnl +ifelse(eval(NR_ARG_REGS >= 4),0,, +`defarg(3,`r4')')dnl +ifelse(eval(NR_ARG_REGS >= 5),0,, +`defarg(4,`r5')')dnl +ifelse(eval(NR_ARG_REGS >= 6),0,, +`defarg(5,`r6')')dnl + +/* + * TEMP_ARG0: + * Used in nbif_stack_trap_ra to preserve the return value. + * Must be a C callee-save register. + * Must be otherwise unused in the return path. + * + * TEMP_ARG0: + * Used in hipe_arm_inc_stack to preserve the return address + * (TEMP_LR contains the caller's saved return address). + * Must be a C callee-save register. + * Must be otherwise unused in the call path. + */ +`#define TEMP_ARG0 r7' + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_arm_glue.S support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl LOAD_ARG_REGS +dnl +define(LAR_1,`ldr ARG$1, [P, #P_ARG$1] ; ')dnl +define(LAR_N,`ifelse(eval($1 >= 0),0,,`LAR_N(eval($1-1))LAR_1($1)')')dnl +define(LOAD_ARG_REGS,`LAR_N(eval(NR_ARG_REGS-1))')dnl +`#define LOAD_ARG_REGS 'LOAD_ARG_REGS + +dnl +dnl STORE_ARG_REGS +dnl +define(SAR_1,`str ARG$1, [P, #P_ARG$1] ; ')dnl +define(SAR_N,`ifelse(eval($1 >= 0),0,,`SAR_N(eval($1-1))SAR_1($1)')')dnl +define(STORE_ARG_REGS,`SAR_N(eval(NR_ARG_REGS-1))')dnl +`#define STORE_ARG_REGS 'STORE_ARG_REGS + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_arm_bifs.m4 support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl NBIF_ARG(DST,ARITY,ARGNO) +dnl Access a formal parameter. +dnl It will be a memory load via NSP when ARGNO >= NR_ARG_REGS. +dnl It will be a register move when 0 <= ARGNO < NR_ARG_REGS; if +dnl the source and destination are the same, the move is suppressed. +dnl +define(NBIF_MOVE_REG,`ifelse($1,$2,`# mov $1, $2',`mov $1, $2')')dnl +define(NBIF_REG_ARG,`NBIF_MOVE_REG($1,ARG$2)')dnl +define(NBIF_STK_LOAD,`ldr $1, [NSP, #$2]')dnl +define(NBIF_STK_ARG,`NBIF_STK_LOAD($1,eval(4*(($2-$3)-1)))')dnl +define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_STK_ARG($1,$2,$3)')')dnl +`/* #define NBIF_ARG_1_0 'NBIF_ARG(r1,1,0)` */' +`/* #define NBIF_ARG_2_0 'NBIF_ARG(r1,2,0)` */' +`/* #define NBIF_ARG_2_1 'NBIF_ARG(r2,2,1)` */' +`/* #define NBIF_ARG_3_0 'NBIF_ARG(r1,3,0)` */' +`/* #define NBIF_ARG_3_1 'NBIF_ARG(r2,3,1)` */' +`/* #define NBIF_ARG_3_2 'NBIF_ARG(r3,3,2)` */' +`/* #define NBIF_ARG_5_0 'NBIF_ARG(r1,5,0)` */' +`/* #define NBIF_ARG_5_1 'NBIF_ARG(r2,5,1)` */' +`/* #define NBIF_ARG_5_2 'NBIF_ARG(r3,5,2)` */' +`/* #define NBIF_ARG_5_3 'NBIF_ARG(r4,5,3)` */' +`/* #define NBIF_ARG_5_4 'NBIF_ARG(r5,5,4)` */' + +dnl +dnl NBIF_RET(ARITY) +dnl Generates a return from a native BIF, taking care to pop +dnl any stacked formal parameters. +dnl May only be used in BIF/primop wrappers where SAVE_CONTEXT +dnl has saved LR in TEMP_LR. +dnl +define(NSP_RETN,`add NSP, NSP, #$1 + mov pc, TEMP_LR')dnl +define(NSP_RET0,`mov pc, TEMP_LR')dnl +define(RET_POP,`ifelse(eval($1 > NR_ARG_REGS),0,0,eval(4*($1 - NR_ARG_REGS)))')dnl +define(NBIF_RET_N,`ifelse(eval($1),0,`NSP_RET0',`NSP_RETN($1)')')dnl +define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl +`/* #define NBIF_RET_0 'NBIF_RET(0)` */' +`/* #define NBIF_RET_1 'NBIF_RET(1)` */' +`/* #define NBIF_RET_2 'NBIF_RET(2)` */' +`/* #define NBIF_RET_3 'NBIF_RET(3)` */' +`/* #define NBIF_RET_5 'NBIF_RET(5)` */' + +dnl +dnl QUICK_CALL_RET(CFUN,ARITY) +dnl Used in nocons_nofail and noproc primop interfaces to optimise +dnl SAVE_CONTEXT_QUICK; bl CFUN; RESTORE_CONTEXT_QUICK; NBIF_RET(ARITY). +dnl +define(NBIF_POP_N,`ifelse(eval($1),0,`',`add NSP, NSP, #$1 ; ')')dnl +define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl +`/* #define QUICK_CALL_RET_F_0 'QUICK_CALL_RET(F,0)` */' +`/* #define QUICK_CALL_RET_F_1 'QUICK_CALL_RET(F,1)` */' +`/* #define QUICK_CALL_RET_F_2 'QUICK_CALL_RET(F,2)` */' +`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' +`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' + +`#endif /* HIPE_ARM_ASM_H */' diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 new file mode 100644 index 0000000000..4d8636e711 --- /dev/null +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -0,0 +1,549 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ + +include(`hipe/hipe_arm_asm.m4') +#`include' "hipe_literals.h" + + .text + .p2align 2 + +`#define JOIN3(A,B,C) A##B##C +#define TEST_GOT_MBUF(ARITY) ldr r1, [P, #P_MBUF]; cmp r1, #0; blne JOIN3(nbif_,ARITY,_gc_after_bif)' + +/* + * standard_bif_interface_1(nbif_name, cbif_name) + * standard_bif_interface_2(nbif_name, cbif_name) + * standard_bif_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 1-3 parameters and + * standard failure mode. + */ +define(standard_bif_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl $2 + TEST_GOT_MBUF(1) + + /* Restore registers. Check for exception. */ + cmp r0, #THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq nbif_1_simple_exception + NBIF_RET(1) + .size $1, .-$1 + .type $1, %function +#endif') + +define(standard_bif_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,2,0) + NBIF_ARG(r2,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl $2 + TEST_GOT_MBUF(2) + + /* Restore registers. Check for exception. */ + cmp r0, #THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq nbif_2_simple_exception + NBIF_RET(2) + .size $1, .-$1 + .type $1, %function +#endif') + +define(standard_bif_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,3,0) + NBIF_ARG(r2,3,1) + NBIF_ARG(r3,3,2) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl $2 + TEST_GOT_MBUF(3) + + /* Restore registers. Check for exception. */ + cmp r0, #THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq nbif_3_simple_exception + NBIF_RET(3) + .size $1, .-$1 + .type $1, %function +#endif') + +/* + * fail_bif_interface_0(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 0 parameters and + * standard failure mode. + */ +define(fail_bif_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl $2 + TEST_GOT_MBUF(0) + + /* Restore registers. Check for exception. */ + cmp r0, #THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq nbif_0_simple_exception + NBIF_RET(0) + .size $1, .-$1 + .type $1, %function +#endif') + +/* + * gc_bif_interface_0(nbif_name, cbif_name) + * gc_bif_interface_1(nbif_name, cbif_name) + * gc_bif_interface_2(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 0-2 parameters and + * standard failure mode. + * The BIF may do a GC. + */ +define(gc_bif_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + bl $2 + TEST_GOT_MBUF(0) + + /* Restore registers. */ + RESTORE_CONTEXT_GC + NBIF_RET(0) + .size $1, .-$1 + .type $1, %function +#endif') + +define(gc_bif_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + bl $2 + TEST_GOT_MBUF(1) + + /* Restore registers. Check for exception. */ + cmp r0, #THE_NON_VALUE + RESTORE_CONTEXT_GC + beq nbif_1_simple_exception + NBIF_RET(1) + .size $1, .-$1 + .type $1, %function +#endif') + +define(gc_bif_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,2,0) + NBIF_ARG(r2,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + bl $2 + TEST_GOT_MBUF(2) + + /* Restore registers. Check for exception. */ + cmp r0, #THE_NON_VALUE + RESTORE_CONTEXT_GC + beq nbif_2_simple_exception + NBIF_RET(2) + .size $1, .-$1 + .type $1, %function +#endif') + +/* + * gc_nofail_primop_interface_1(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 1 ordinary parameter and no failure mode. + * The primop may do a GC. + */ +define(gc_nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + bl $2 + + /* Restore registers. */ + RESTORE_CONTEXT_GC + NBIF_RET(1) + .size $1, .-$1 + .type $1, %function +#endif') + +/* + * nofail_primop_interface_0(nbif_name, cbif_name) + * nofail_primop_interface_1(nbif_name, cbif_name) + * nofail_primop_interface_2(nbif_name, cbif_name) + * nofail_primop_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 ordinary parameters and no failure mode. + * Also used for guard BIFs. + */ +define(nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl $2 + TEST_GOT_MBUF(0) + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(0) + .size $1, .-$1 + .type $1, %function +#endif') + +define(nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl $2 + TEST_GOT_MBUF(1) + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(1) + .size $1, .-$1 + .type $1, %function +#endif') + +define(nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,2,0) + NBIF_ARG(r2,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl $2 + TEST_GOT_MBUF(2) + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(2) + .size $1, .-$1 + .type $1, %function +#endif') + +define(nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,3,0) + NBIF_ARG(r2,3,1) + NBIF_ARG(r3,3,2) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl $2 + TEST_GOT_MBUF(3) + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(3) + .size $1, .-$1 + .type $1, %function +#endif') + +/* + * nocons_nofail_primop_interface_0(nbif_name, cbif_name) + * nocons_nofail_primop_interface_1(nbif_name, cbif_name) + * nocons_nofail_primop_interface_2(nbif_name, cbif_name) + * nocons_nofail_primop_interface_3(nbif_name, cbif_name) + * nocons_nofail_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(nocons_nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,0) + .size $1, .-$1 + .type $1, %function +#endif') + +define(nocons_nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,1,0) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,1) + .size $1, .-$1 + .type $1, %function +#endif') + +define(nocons_nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,2,0) + NBIF_ARG(r2,2,1) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,2) + .size $1, .-$1 + .type $1, %function +#endif') + +define(nocons_nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,3,0) + NBIF_ARG(r2,3,1) + NBIF_ARG(r3,3,2) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,3) + .size $1, .-$1 + .type $1, %function +#endif') + +define(nocons_nofail_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument stack. */ + NBIF_ARG(r0,5,3) + str r0, [sp, #0] + NBIF_ARG(r0,5,4) + str r0, [sp, #4] + + /* Set up C argument registers. */ + mov r0, P + NBIF_ARG(r1,5,0) + NBIF_ARG(r2,5,1) + NBIF_ARG(r3,5,2) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,5) + .size $1, .-$1 + .type $1, %function +#endif') + +/* + * noproc_primop_interface_0(nbif_name, cbif_name) + * noproc_primop_interface_1(nbif_name, cbif_name) + * noproc_primop_interface_2(nbif_name, cbif_name) + * noproc_primop_interface_3(nbif_name, cbif_name) + * noproc_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with no implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(noproc_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* XXX: this case is always trivial; how to suppress the branch? */ + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,0) + .size $1, .-$1 + .type $1, %function +#endif') + +define(noproc_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + NBIF_ARG(r0,1,0) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,1) + .size $1, .-$1 + .type $1, %function +#endif') + +define(noproc_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + NBIF_ARG(r0,2,0) + NBIF_ARG(r1,2,1) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,2) + .size $1, .-$1 + .type $1, %function +#endif') + +define(noproc_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + NBIF_ARG(r0,3,0) + NBIF_ARG(r1,3,1) + NBIF_ARG(r2,3,2) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,3) + .size $1, .-$1 + .type $1, %function +#endif') + +define(noproc_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + NBIF_ARG(r0,5,0) + NBIF_ARG(r1,5,1) + NBIF_ARG(r2,5,2) + NBIF_ARG(r3,5,3) + NBIF_ARG(r4,5,4) + str r4, [sp, #0] + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,5) + .size $1, .-$1 + .type $1, %function +#endif') + +include(`hipe/hipe_bif_list.m4') + +`#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif' diff --git a/erts/emulator/hipe/hipe_arm_gc.h b/erts/emulator/hipe/hipe_arm_gc.h new file mode 100644 index 0000000000..a2a919e3d7 --- /dev/null +++ b/erts/emulator/hipe/hipe_arm_gc.h @@ -0,0 +1,29 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * Stack walking helpers for native stack GC procedures. + * ARM version. + */ +#ifndef HIPE_ARM_GC_H +#define HIPE_ARM_GC_H + +#include "hipe_arm_asm.h" /* for NR_ARG_REGS */ +#include "hipe_risc_gc.h" + +#endif /* HIPE_ARM_GC_H */ diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S new file mode 100644 index 0000000000..5d626a5f69 --- /dev/null +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -0,0 +1,417 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#include "hipe_arm_asm.h" +#include "hipe_literals.h" +#define ASM +#include "hipe_mode_switch.h" + + .text + .p2align 2 + +/* + * Enter Erlang from C. + * Create a new frame on the C stack. + * Save C callee-save registers in the frame. + * Do not clobber the C argument registers. + * Retrieve the process pointer from the C argument registers. + * + * Our C frame includes: + * - 9*4 == 36 bytes for saving r4-r11 and lr + * - 2*4 == 8 bytes for calls to hipe_bs_put_{big_integer,small_float}. + * They take 5-6 parameter words: 4 in registers and 1-2 on the stack. + * (They take 5 regular parameters, and an additional P parameter on SMP.) + * - 4 bytes to pad the frame size to a multiple of 8 + */ +#define ENTER_FROM_C \ + stmfd sp!, {r4,r5,r6,r7,r8,r9,r10,r11,lr}; \ + sub sp, sp, #12; \ + mov P, r0; \ + RESTORE_CACHED_STATE + +/* + * Return to the calling C function. + * The return value is in r0. + * + * .nosave_exit saves no state + * .flush_exit saves NSP and other cached P state. + * .suspend_exit also saves RA. + */ +.suspend_exit: + /* save RA, so we can be resumed */ + str lr, [P, #P_NRA] +.flush_exit: + /* flush cached P state */ + SAVE_CACHED_STATE +.nosave_exit: + /* restore callee-save registers, drop frame, return */ + add sp, sp, #12 + ldmfd sp!, {r4,r5,r6,r7,r8,r9,r10,r11,pc} + +/* + * int hipe_arm_call_to_native(Process *p); + * Emulated code recursively calls native code. + */ + .global hipe_arm_call_to_native +hipe_arm_call_to_native: + ENTER_FROM_C + /* get argument registers */ + LOAD_ARG_REGS + /* call the target */ + mov lr, pc + ldr pc, [P, #P_NCALLEE] +/* FALLTHROUGH + * + * We export this return address so that hipe_mode_switch() can discover + * when native code tailcalls emulated code. + * + * This is where native code returns to emulated code. + */ + .global nbif_return +nbif_return: + str r0, [P, #P_ARG0] /* save retval */ + mov r0, #HIPE_MODE_SWITCH_RES_RETURN + b .flush_exit + +/* + * int hipe_arm_return_to_native(Process *p); + * Emulated code returns to its native code caller. + */ + .global hipe_arm_return_to_native +hipe_arm_return_to_native: + ENTER_FROM_C + /* get return value */ + ldr r0, [P, #P_ARG0] + /* + * Return using the current return address. + * The parameters were popped at the original native-to-emulated + * call (hipe_call_from_native_is_recursive), so a plain ret suffices. + */ + ldr pc, [P, #P_NRA] + +/* + * int hipe_arm_tailcall_to_native(Process *p); + * Emulated code tailcalls native code. + */ + .global hipe_arm_tailcall_to_native +hipe_arm_tailcall_to_native: + ENTER_FROM_C + /* get argument registers */ + LOAD_ARG_REGS + /* restore return address */ + ldr lr, [P, #P_NRA] + /* call the target */ + ldr pc, [P, #P_NCALLEE] + +/* + * int hipe_arm_throw_to_native(Process *p); + * Emulated code throws an exception to its native code caller. + */ + .global hipe_arm_throw_to_native +hipe_arm_throw_to_native: + ENTER_FROM_C + /* invoke the handler */ + ldr pc, [P, #P_NCALLEE] /* set by hipe_find_handler() */ + +/* + * Native code calls emulated code via a stub + * which should look as follows: + * + * stub for f/N: + * + * + * b nbif_callemu + * + * XXX: Different stubs for different number of register parameters? + */ + .global nbif_callemu +nbif_callemu: + str r8, [P, #P_BEAM_IP] + str r0, [P, #P_ARITY] + STORE_ARG_REGS + mov r0, #HIPE_MODE_SWITCH_RES_CALL + b .suspend_exit + +/* + * nbif_apply + */ + .global nbif_apply +nbif_apply: + STORE_ARG_REGS + mov r0, #HIPE_MODE_SWITCH_RES_APPLY + b .suspend_exit + +/* + * Native code calls an emulated-mode closure via a stub defined below. + * + * The closure is appended as the last actual parameter, and parameters + * beyond the first few passed in registers are pushed onto the stack in + * left-to-right order. + * Hence, the location of the closure parameter only depends on the number + * of parameters in registers, not the total number of parameters. + */ +#if NR_ARG_REGS >= 6 + .global nbif_ccallemu6 +nbif_ccallemu6: + str ARG5, [P, #P_ARG5] +#if NR_ARG_REGS > 6 + mov ARG5, ARG6 +#else + ldr ARG5, [NSP, #0] +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 5 + .global nbif_ccallemu5 +nbif_ccallemu5: + str ARG4, [P, #P_ARG4] +#if NR_ARG_REGS > 5 + mov ARG4, ARG5 +#else + ldr ARG4, [NSP, #0] +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 4 + .global nbif_ccallemu4 +nbif_ccallemu4: + str ARG3, [P, #P_ARG3] +#if NR_ARG_REGS > 4 + mov ARG3, ARG4 +#else + ldr ARG3, [NSP, #0] +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 3 + .global nbif_ccallemu3 +nbif_ccallemu3: + str ARG2, [P, #P_ARG2] +#if NR_ARG_REGS > 3 + mov ARG2, ARG3 +#else + ldr ARG2, [NSP, #0] +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 2 + .global nbif_ccallemu2 +nbif_ccallemu2: + str ARG1, [P, #P_ARG1] +#if NR_ARG_REGS > 2 + mov ARG1, ARG2 +#else + ldr ARG1, [NSP, #0] +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 1 + .global nbif_ccallemu1 +nbif_ccallemu1: + str ARG0, [P, #P_ARG0] +#if NR_ARG_REGS > 1 + mov ARG0, ARG1 +#else + ldr ARG0, [NSP, #0] +#endif + /*FALLTHROUGH*/ +#endif + + .global nbif_ccallemu0 +nbif_ccallemu0: + /* We use r1 not ARG0 here because ARG0 is not + defined when NR_ARG_REGS == 0. */ +#if NR_ARG_REGS == 0 + ldr r1, [NSP, #0] /* get the closure */ +#endif + str r1, [P, #P_CLOSURE] /* save the closure */ + mov r0, #HIPE_MODE_SWITCH_RES_CALL_CLOSURE + b .suspend_exit + +/* + * This is where native code suspends. + */ + .global nbif_suspend_0 +nbif_suspend_0: + mov r0, #HIPE_MODE_SWITCH_RES_SUSPEND + b .suspend_exit + +/* + * Suspend from a receive (waiting for a message) + */ + .global nbif_suspend_msg +nbif_suspend_msg: + mov r0, #HIPE_MODE_SWITCH_RES_WAIT + b .suspend_exit + +/* + * Suspend from a receive with a timeout (waiting for a message) + * if (!(p->flags & F_TIMO)) { suspend } + * else { return 0; } + */ + .global nbif_suspend_msg_timeout +nbif_suspend_msg_timeout: + ldr r1, [P, #P_FLAGS] + mov r0, #HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT + /* this relies on F_TIMO (1<<2) fitting in a uimm16 */ + tst r1, #F_TIMO + beq .suspend_exit + /* timeout has occurred */ + mov r0, #0 + mov pc, lr + +/* + * This is the default exception handler for native code. + */ + .global nbif_fail +nbif_fail: + mov r0, #HIPE_MODE_SWITCH_RES_THROW + b .flush_exit /* no need to save RA */ + + .global nbif_0_gc_after_bif + .global nbif_1_gc_after_bif + .global nbif_2_gc_after_bif + .global nbif_3_gc_after_bif +nbif_0_gc_after_bif: + mov r1, #0 + b .gc_after_bif +nbif_1_gc_after_bif: + mov r1, #1 + b .gc_after_bif +nbif_2_gc_after_bif: + mov r1, #2 + b .gc_after_bif +nbif_3_gc_after_bif: + mov r1, #3 + /*FALLTHROUGH*/ +.gc_after_bif: + str r1, [P, #P_NARITY] + str TEMP_LR, [P, #P_NRA] + str NSP, [P, #P_NSP] + mov TEMP_LR, lr + mov r1, r0 + mov r0, P + bl erts_gc_after_bif_call + mov lr, TEMP_LR + ldr TEMP_LR, [P, #P_NRA] + mov r1, #0 + str r1, [P, #P_NARITY] + mov pc, lr + +/* + * We end up here when a BIF called from native signals an + * exceptional condition. + * HP was just read from P. + * NSP has not been saved in P. + * TEMP_LR contains a copy of LR + */ + .global nbif_0_simple_exception +nbif_0_simple_exception: + mov r1, #0 + b .nbif_simple_exception + .global nbif_1_simple_exception +nbif_1_simple_exception: + mov r1, #1 + b .nbif_simple_exception + .global nbif_2_simple_exception +nbif_2_simple_exception: + mov r1, #2 + b .nbif_simple_exception + .global nbif_3_simple_exception +nbif_3_simple_exception: + mov r1, #3 + /*FALLTHROUGH*/ +.nbif_simple_exception: + ldr r0, [P, #P_FREASON] + cmp r0, #FREASON_TRAP + beq .handle_trap + /* + * Find and invoke catch handler (it must exist). + * HP was just read from P. + * NSP has not been saved in P. + * TEMP_LR should contain the current call's return address. + * r1 should contain the current call's arity. + */ + str NSP, [P, #P_NSP] + str TEMP_LR, [P, #P_NRA] + str r1, [P, #P_NARITY] + /* find and prepare to invoke the handler */ + mov r0, P + bl hipe_handle_exception /* Note: hipe_handle_exception() conses */ + RESTORE_CACHED_STATE /* NSP updated by hipe_find_handler() */ + /* now invoke the handler */ + ldr pc, [P, #P_NCALLEE] /* set by hipe_find_handler() */ + + /* + * A BIF failed with freason TRAP: + * - the BIF's arity is in r1 + * - the native RA was saved in TEMP_LR before the BIF call + * - HP was just read from P + * - NSP has not been saved in P + */ +.handle_trap: + mov r0, #HIPE_MODE_SWITCH_RES_TRAP + str NSP, [P, #P_NSP] + str r1, [P, #P_NARITY] + str TEMP_LR, [P, #P_NRA] + b .nosave_exit + +/* + * nbif_stack_trap_ra: trap return address for maintaining + * the gray/white stack boundary + */ + .global nbif_stack_trap_ra +nbif_stack_trap_ra: /* a return address, not a function */ + # This only handles a single return value. + # If we have more, we need to save them in the PCB. + mov TEMP_ARG0, r0 /* save retval */ + str NSP, [P, #P_NSP] + mov r0, P + bl hipe_handle_stack_trap /* must not cons */ + mov lr, r0 /* original RA */ + mov r0, TEMP_ARG0 /* restore retval */ + mov pc, lr /* resume at original RA */ + +/* + * hipe_arm_inc_stack + * Caller saved its LR in TEMP_LR (== TEMP1) before calling us. + */ + .global hipe_arm_inc_stack +hipe_arm_inc_stack: + STORE_ARG_REGS + mov TEMP_ARG0, lr + str NSP, [P, #P_NSP] + mov r0, P + # hipe_inc_nstack reads and writes NSP and NSP_LIMIT, + # but does not access LR/RA, HP, or FCALLS. + bl hipe_inc_nstack + ldr NSP, [P, #P_NSP] + LOAD_ARG_REGS + # this relies on LOAD_ARG_REGS not clobbering TEMP_ARG0 + mov pc, TEMP_ARG0 + +#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif diff --git a/erts/emulator/hipe/hipe_arm_glue.h b/erts/emulator/hipe/hipe_arm_glue.h new file mode 100644 index 0000000000..e840c3dc0f --- /dev/null +++ b/erts/emulator/hipe/hipe_arm_glue.h @@ -0,0 +1,32 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_ARM_GLUE_H +#define HIPE_ARM_GLUE_H + +#include "hipe_arm_asm.h" /* for NR_ARG_REGS, ARM_LEAF_WORDS */ +#define NR_LEAF_WORDS ARM_LEAF_WORDS +#define HIPE_ARCH_CALL_TO_NATIVE hipe_arm_call_to_native +#define HIPE_ARCH_RETURN_TO_NATIVE hipe_arm_return_to_native +#define HIPE_ARCH_TAILCALL_TO_NATIVE hipe_arm_tailcall_to_native +#define HIPE_ARCH_THROW_TO_NATIVE hipe_arm_throw_to_native +#include "hipe_risc_glue.h" + +#endif /* HIPE_ARM_GLUE_H */ diff --git a/erts/emulator/hipe/hipe_arm_primops.h b/erts/emulator/hipe/hipe_arm_primops.h new file mode 100644 index 0000000000..a28b509eee --- /dev/null +++ b/erts/emulator/hipe/hipe_arm_primops.h @@ -0,0 +1,21 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +PRIMOP_LIST(am_inc_stack_0, &hipe_arm_inc_stack) diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c new file mode 100644 index 0000000000..032bf2e896 --- /dev/null +++ b/erts/emulator/hipe/hipe_bif0.c @@ -0,0 +1,1945 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_bif0.c + * + * Compiler and linker support. + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "sys.h" +#include "error.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "bif.h" +#include "big.h" +#include "beam_load.h" +#include "erl_db.h" +#include "hash.h" +#include "erl_bits.h" +#include "erl_binary.h" +#ifdef HIPE +#include /* offsetof() */ +#include "hipe_arch.h" +#include "hipe_stack.h" +#include "hipe_mode_switch.h" +#include "hipe_native_bif.h" +#include "hipe_bif0.h" +/* We need hipe_literals.h for HIPE_SYSTEM_CRC, but it redefines + a few constants. #undef them here to avoid warnings. */ +#undef F_TIMO +#undef THE_NON_VALUE +#undef ERL_FUN_SIZE +#include "hipe_literals.h" +#endif + +#define BeamOpCode(Op) ((Uint)BeamOp(Op)) + +int term_to_Sint32(Eterm term, Sint *sp) +{ + Sint val; + + if (!term_to_Sint(term, &val)) + return 0; + if ((Sint)(Sint32)val != val) + return 0; + *sp = val; + return 1; +} + +static Eterm Uint_to_term(Uint x, Process *p) +{ + if (IS_USMALL(0, x)) { + return make_small(x); + } else { + Eterm *hp = HAlloc(p, BIG_UINT_HEAP_SIZE); + return uint_to_big(x, hp); + } +} + +void *term_to_address(Eterm arg) +{ + Uint u; + return term_to_Uint(arg, &u) ? (void*)u : NULL; +} + +static Eterm address_to_term(const void *address, Process *p) +{ + return Uint_to_term((Uint)address, p); +} + +/* + * BIFs for reading and writing memory. Used internally by HiPE. + */ +#if 0 /* XXX: unused */ +BIF_RETTYPE hipe_bifs_read_u8_1(BIF_ALIST_1) +{ + unsigned char *address = term_to_address(BIF_ARG_1); + if (!address) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(make_small(*address)); +} +#endif + +#if 0 /* XXX: unused */ +BIF_RETTYPE hipe_bifs_read_u32_1(BIF_ALIST_1) +{ + Uint32 *address = term_to_address(BIF_ARG_1); + if (!address || !hipe_word32_address_ok(address)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(Uint_to_term(*address, BIF_P)); +} +#endif + +BIF_RETTYPE hipe_bifs_write_u8_2(BIF_ALIST_2) +{ + unsigned char *address; + + address = term_to_address(BIF_ARG_1); + if (!address || is_not_small(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + *address = unsigned_val(BIF_ARG_2); + BIF_RET(NIL); +} + +#if 0 /* XXX: unused */ +BIF_RETTYPE hipe_bifs_write_s32_2(BIF_ALIST_2) +{ + Sint32 *address; + Sint value; + + address = term_to_address(BIF_ARG_1); + if (!address || !hipe_word32_address_ok(address)) + BIF_ERROR(BIF_P, BADARG); + if (!term_to_Sint32(BIF_ARG_2, &value)) + BIF_ERROR(BIF_P, BADARG); + *address = value; + BIF_RET(NIL); +} +#endif + +BIF_RETTYPE hipe_bifs_write_u32_2(BIF_ALIST_2) +{ + Uint32 *address; + Uint value; + + address = term_to_address(BIF_ARG_1); + if (!address || !hipe_word32_address_ok(address)) + BIF_ERROR(BIF_P, BADARG); + if (!term_to_Uint(BIF_ARG_2, &value)) + BIF_ERROR(BIF_P, BADARG); + if ((Uint)(Uint32)value != value) + BIF_ERROR(BIF_P, BADARG); + *address = value; + hipe_flush_icache_word(address); + BIF_RET(NIL); +} + +/* + * BIFs for mutable bytearrays. + */ +BIF_RETTYPE hipe_bifs_bytearray_2(BIF_ALIST_2) +{ + Sint nelts; + Eterm bin; + + if (is_not_small(BIF_ARG_1) || + (nelts = signed_val(BIF_ARG_1)) < 0 || + !is_byte(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + bin = new_binary(BIF_P, NULL, nelts); + memset(binary_bytes(bin), unsigned_val(BIF_ARG_2), nelts); + BIF_RET(bin); +} + +static inline unsigned char *bytearray_lvalue(Eterm bin, Eterm idx) +{ + Sint i; + unsigned char *bytes; + Uint bitoffs; + Uint bitsize; + + if (is_not_binary(bin) || + is_not_small(idx) || + (i = unsigned_val(idx)) >= binary_size(bin)) + return NULL; + ERTS_GET_BINARY_BYTES(bin, bytes, bitoffs, bitsize); + ASSERT(bitoffs == 0); + ASSERT(bitsize == 0); + return bytes + i; +} + +BIF_RETTYPE hipe_bifs_bytearray_sub_2(BIF_ALIST_2) +{ + unsigned char *bytep; + + bytep = bytearray_lvalue(BIF_ARG_1, BIF_ARG_2); + if (!bytep) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(make_small(*bytep)); +} + +BIF_RETTYPE hipe_bifs_bytearray_update_3(BIF_ALIST_3) +{ + unsigned char *bytep; + + bytep = bytearray_lvalue(BIF_ARG_1, BIF_ARG_2); + if (!bytep || !is_byte(BIF_ARG_3)) + BIF_ERROR(BIF_P, BADARG); + *bytep = unsigned_val(BIF_ARG_3); + BIF_RET(BIF_ARG_1); +} + +BIF_RETTYPE hipe_bifs_bitarray_2(BIF_ALIST_2) +{ + Sint nbits; + Uint nbytes; + Eterm bin; + int bytemask; + + if (is_not_small(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + nbits = signed_val(BIF_ARG_1); + if (nbits < 0) + BIF_ERROR(BIF_P, BADARG); + if (BIF_ARG_2 == am_false) + bytemask = 0; + else if (BIF_ARG_2 == am_true) + bytemask = ~0; + else + BIF_ERROR(BIF_P, BADARG); + nbytes = ((Uint)nbits + ((1 << 3) - 1)) >> 3; + bin = new_binary(BIF_P, NULL, nbytes); + memset(binary_bytes(bin), bytemask, nbytes); + BIF_RET(bin); +} + +BIF_RETTYPE hipe_bifs_bitarray_update_3(BIF_ALIST_3) +{ + unsigned char *bytes, bytemask; + Uint bitoffs, bitsize; + Uint bitnr, bytenr; + int set; + + if (is_not_binary(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + if (is_not_small(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + bitnr = unsigned_val(BIF_ARG_2); + bytenr = bitnr >> 3; + if (bytenr >= binary_size(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + if (BIF_ARG_3 == am_false) + set = 0; + else if (BIF_ARG_3 == am_true) + set = 1; + else + BIF_ERROR(BIF_P, BADARG); + ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize); + ASSERT(bitoffs == 0); + ASSERT(bitsize == 0); + bytemask = 1 << (bitnr & ((1 << 3) - 1)); + if (set) + bytes[bytenr] |= bytemask; + else + bytes[bytenr] &= ~bytemask; + BIF_RET(BIF_ARG_1); +} + +BIF_RETTYPE hipe_bifs_bitarray_sub_2(BIF_ALIST_2) +{ + unsigned char *bytes, bytemask; + Uint bitoffs, bitsize; + Uint bitnr, bytenr; + + if (is_not_binary(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + if (is_not_small(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + bitnr = unsigned_val(BIF_ARG_2); + bytenr = bitnr >> 3; + if (bytenr >= binary_size(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize); + ASSERT(bitoffs == 0); + ASSERT(bitsize == 0); + bytemask = 1 << (bitnr & ((1 << 3) - 1)); + if ((bytes[bytenr] & bytemask) == 0) + BIF_RET(am_false); + else + BIF_RET(am_true); +} + +/* + * BIFs for SML-like mutable arrays and reference cells. + * For now, limited to containing immediate data. + */ +#if 1 /* use bignums as carriers, easier on the gc */ +#define make_array_header(sz) make_pos_bignum_header((sz)) +#define array_header_arity(h) header_arity((h)) +#define make_array(hp) make_big((hp)) +#define is_not_array(x) is_not_big((x)) +#define array_val(x) big_val((x)) +#else /* use tuples as carriers, easier debugging, harder on the gc */ +#define make_array_header(sz) make_arityval((sz)) +#define array_header_arity(h) arityval((h)) +#define make_array(hp) make_tuple((hp)) +#define is_not_array(x) is_not_tuple((x)) +#define array_val(x) tuple_val((x)) +#endif +#define array_length(a) array_header_arity(array_val((a))[0]) + +BIF_RETTYPE hipe_bifs_array_2(BIF_ALIST_2) +{ + Eterm *hp; + Sint nelts, i; + + if (is_not_small(BIF_ARG_1) || + (nelts = signed_val(BIF_ARG_1)) < 0 || + is_not_immed(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + if (nelts == 0) /* bignums must not be empty */ + BIF_RET(make_small(0)); + hp = HAlloc(BIF_P, 1+nelts); + hp[0] = make_array_header(nelts); + for (i = 1; i <= nelts; ++i) + hp[i] = BIF_ARG_2; + BIF_RET(make_array(hp)); +} + +BIF_RETTYPE hipe_bifs_array_length_1(BIF_ALIST_1) +{ + if (is_not_array(BIF_ARG_1)) { + if (BIF_ARG_1 == make_small(0)) /* fixnum 0 represents empty arrays */ + BIF_RET(make_small(0)); + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(make_small(array_header_arity(array_val(BIF_ARG_1)[0]))); +} + +BIF_RETTYPE hipe_bifs_array_sub_2(BIF_ALIST_2) +{ + Uint i; + + if (is_not_small(BIF_ARG_2) || + is_not_array(BIF_ARG_1) || + (i = unsigned_val(BIF_ARG_2)) >= array_length(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(array_val(BIF_ARG_1)[i+1]); +} + +BIF_RETTYPE hipe_bifs_array_update_3(BIF_ALIST_3) +{ + Uint i; + + if (is_not_immed(BIF_ARG_3) || + is_not_small(BIF_ARG_2) || + is_not_array(BIF_ARG_1) || + (i = unsigned_val(BIF_ARG_2)) >= array_length(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + array_val(BIF_ARG_1)[i+1] = BIF_ARG_3; + BIF_RET(BIF_ARG_1); +} + +BIF_RETTYPE hipe_bifs_ref_1(BIF_ALIST_1) +{ + Eterm *hp; + + if (is_not_immed(BIF_ARG_1)) + BIF_RET(BADARG); + hp = HAlloc(BIF_P, 1+1); + hp[0] = make_array_header(1); + hp[1] = BIF_ARG_1; + BIF_RET(make_array(hp)); +} + +BIF_RETTYPE hipe_bifs_ref_get_1(BIF_ALIST_1) +{ + if (is_not_array(BIF_ARG_1) || + array_val(BIF_ARG_1)[0] != make_array_header(1)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(array_val(BIF_ARG_1)[1]); +} + +BIF_RETTYPE hipe_bifs_ref_set_2(BIF_ALIST_2) +{ + if (is_not_immed(BIF_ARG_2) || + is_not_array(BIF_ARG_1) || + array_val(BIF_ARG_1)[0] != make_array_header(1)) + BIF_ERROR(BIF_P, BADARG); + array_val(BIF_ARG_1)[1] = BIF_ARG_2; + BIF_RET(BIF_ARG_1); +} + +/* + * Allocate memory and copy machine code to it. + */ +BIF_RETTYPE hipe_bifs_enter_code_2(BIF_ALIST_2) +{ + Uint nrbytes; + void *bytes; + void *address; + Uint bitoffs; + Uint bitsize; + Eterm trampolines; + Eterm *hp; + + if (is_not_binary(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + nrbytes = binary_size(BIF_ARG_1); + ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize); + ASSERT(bitoffs == 0); + ASSERT(bitsize == 0); + trampolines = NIL; +#ifdef HIPE_ALLOC_CODE + address = HIPE_ALLOC_CODE(nrbytes, BIF_ARG_2, &trampolines, BIF_P); + if (!address) + BIF_ERROR(BIF_P, BADARG); +#else + if (is_not_nil(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + address = erts_alloc(ERTS_ALC_T_HIPE, nrbytes); +#endif + memcpy(address, bytes, nrbytes); + hipe_flush_icache_range(address, nrbytes); + hp = HAlloc(BIF_P, 3); + hp[0] = make_arityval(2); + hp[1] = address_to_term(address, BIF_P); + hp[2] = trampolines; + BIF_RET(make_tuple(hp)); +} + +/* + * Allocate memory for arbitrary non-Erlang data. + */ +BIF_RETTYPE hipe_bifs_alloc_data_2(BIF_ALIST_2) +{ + Uint align, nrbytes; + void *block; + + if (is_not_small(BIF_ARG_1) || is_not_small(BIF_ARG_2) || + (align = unsigned_val(BIF_ARG_1), + align != sizeof(long) && align != sizeof(double))) + BIF_ERROR(BIF_P, BADARG); + nrbytes = unsigned_val(BIF_ARG_2); + block = erts_alloc(ERTS_ALC_T_HIPE, nrbytes); + if ((unsigned long)block & (align-1)) + fprintf(stderr, "Yikes! erts_alloc() returned misaligned address %p\r\n", block); + BIF_RET(address_to_term(block, BIF_P)); +} + +/* + * Memory area for constant Erlang terms. + * + * These constants must not be forwarded by the gc. + * Therefore, the gc needs to be able to distinguish between + * collectible objects and constants. Unfortunately, an Erlang + * process' collectible objects are scattered around in two + * heaps and a list of message buffers, so testing "is X a + * collectible object?" can be expensive. + * + * Instead, constants are placed in a single contiguous area, + * which allows for an inexpensive "is X a constant?" test. + * + * XXX: Allow this area to be grown. + */ + +/* not static, needed by garbage collector */ +Eterm *hipe_constants_start = NULL; +Eterm *hipe_constants_next = NULL; +static unsigned constants_avail_words = 0; +#define CONSTANTS_BYTES (1536*1024*sizeof(Eterm)) /* 1.5 M words */ + +static Eterm *constants_alloc(unsigned nwords) +{ + Eterm *next; + + /* initialise at the first call */ + if ((next = hipe_constants_next) == NULL) { + next = (Eterm*)erts_alloc(ERTS_ALC_T_HIPE, CONSTANTS_BYTES); + hipe_constants_start = next; + hipe_constants_next = next; + constants_avail_words = CONSTANTS_BYTES / sizeof(Eterm); + } + if (nwords > constants_avail_words) { + fprintf(stderr, "Native code constants pool depleted!\r\n"); + /* Must terminate immediately. erl_exit() seems to + continue running some code which then SIGSEGVs. */ + exit(1); + } + constants_avail_words -= nwords; + hipe_constants_next = next + nwords; + return next; +} + +BIF_RETTYPE hipe_bifs_constants_size_0(BIF_ALIST_0) +{ + BIF_RET(make_small(hipe_constants_next - hipe_constants_start)); +} + +/* + * Merging constant Erlang terms. + * Uses the constants pool and a hash table of all top-level + * terms merged so far. (Sub-terms are not merged.) + */ +struct const_term { + HashBucket bucket; + Eterm val; /* tagged pointer to mem[0] */ + Eterm mem[1]; /* variable size */ +}; + +static Hash const_term_table; +static ErlOffHeap const_term_table_off_heap; + +static HashValue const_term_hash(void *tmpl) +{ + return make_hash2((Eterm)tmpl); +} + +static int const_term_cmp(void *tmpl, void *bucket) +{ + return !eq((Eterm)tmpl, ((struct const_term*)bucket)->val); +} + +static void *const_term_alloc(void *tmpl) +{ + Eterm obj; + Uint size; + Eterm *hp; + struct const_term *p; + + obj = (Eterm)tmpl; + ASSERT(is_not_immed(obj)); + size = size_object(obj); + + p = (struct const_term*)constants_alloc(size + (offsetof(struct const_term, mem)/sizeof(Eterm))); + + /* I have absolutely no idea if having a private 'off_heap' + works or not. _Some_ off_heap object is required for + REFC_BINARY and FUN values, but _where_ it should be is + a complete mystery to me. */ + hp = &p->mem[0]; + p->val = copy_struct(obj, size, &hp, &const_term_table_off_heap); + + return &p->bucket; +} + +static void init_const_term_table(void) +{ + HashFunctions f; + f.hash = (H_FUN) const_term_hash; + f.cmp = (HCMP_FUN) const_term_cmp; + f.alloc = (HALLOC_FUN) const_term_alloc; + f.free = (HFREE_FUN) NULL; + hash_init(ERTS_ALC_T_HIPE, &const_term_table, "const_term_table", 97, f); +} + +BIF_RETTYPE hipe_bifs_merge_term_1(BIF_ALIST_1) +{ + static int init_done = 0; + struct const_term *p; + Eterm val; + + val = BIF_ARG_1; + if (is_not_immed(val)) { + if (!init_done) { + init_const_term_table(); + init_done = 1; + } + p = (struct const_term*)hash_put(&const_term_table, (void*)val); + val = p->val; + } + BIF_RET(val); +} + +struct mfa { + Eterm mod; + Eterm fun; + Uint ari; +}; + +static int term_to_mfa(Eterm term, struct mfa *mfa) +{ + Eterm mod, fun, a; + Uint ari; + + if (is_not_tuple(term)) + return 0; + if (tuple_val(term)[0] != make_arityval(3)) + return 0; + mod = tuple_val(term)[1]; + if (is_not_atom(mod)) + return 0; + mfa->mod = mod; + fun = tuple_val(term)[2]; + if (is_not_atom(fun)) + return 0; + mfa->fun = fun; + a = tuple_val(term)[3]; + if (is_not_small(a)) + return 0; + ari = unsigned_val(a); + if (ari > 255) + return 0; + mfa->ari = ari; + return 1; +} + +#ifdef DEBUG_LINKER +static void print_mfa(Eterm mod, Eterm fun, unsigned int ari) +{ + erts_printf("%T:%T/%u", mod, fun, ari); +} +#endif + +/* + * Convert {M,F,A} to pointer to first insn after initial func_info. + */ +static Uint *hipe_find_emu_address(Eterm mod, Eterm name, unsigned int arity) +{ + Module *modp; + Uint *code_base; + int i, n; + + modp = erts_get_module(mod); + if (modp == NULL || (code_base = modp->code) == NULL) + return NULL; + n = code_base[MI_NUM_FUNCTIONS]; + for (i = 0; i < n; ++i) { + Uint *code_ptr = (Uint*)code_base[MI_FUNCTIONS+i]; + ASSERT(code_ptr[0] == BeamOpCode(op_i_func_info_IaaI)); + if (code_ptr[3] == name && code_ptr[4] == arity) + return code_ptr+5; + } + return NULL; +} + +Uint *hipe_bifs_find_pc_from_mfa(Eterm term) +{ + struct mfa mfa; + + if (!term_to_mfa(term, &mfa)) + return NULL; + return hipe_find_emu_address(mfa.mod, mfa.fun, mfa.ari); +} + +BIF_RETTYPE hipe_bifs_fun_to_address_1(BIF_ALIST_1) +{ + Eterm *pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); + if (!pc) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(address_to_term(pc, BIF_P)); +} + +static void *hipe_get_emu_address(Eterm m, Eterm f, unsigned int arity, int is_remote) +{ + void *address = NULL; + if (!is_remote) + address = hipe_find_emu_address(m, f, arity); + if (!address) { + /* if not found, stub it via the export entry */ + Export *export_entry = erts_export_get_or_make_stub(m, f, arity); + address = export_entry->address; + } + return address; +} + +#if 0 /* XXX: unused */ +BIF_RETTYPE hipe_bifs_get_emu_address_1(BIF_ALIST_1) +{ + struct mfa mfa; + void *address; + + if (!term_to_mfa(BIF_ARG_1, &mfa)) + BIF_ERROR(BIF_P, BADARG); + address = hipe_get_emu_address(mfa.mod, mfa.fun, mfa.ari); + BIF_RET(address_to_term(address, BIF_P)); +} +#endif + +BIF_RETTYPE hipe_bifs_set_native_address_3(BIF_ALIST_3) +{ + Eterm *pc; + void *address; + int is_closure; + struct mfa mfa; + + switch (BIF_ARG_3) { + case am_false: + is_closure = 0; + break; + case am_true: + is_closure = 1; + break; + default: + BIF_ERROR(BIF_P, BADARG); + } + address = term_to_address(BIF_ARG_2); + if (!address) + BIF_ERROR(BIF_P, BADARG); + + /* The mfa is needed again later, otherwise we could + simply have called hipe_bifs_find_pc_from_mfa(). */ + if (!term_to_mfa(BIF_ARG_1, &mfa)) + BIF_ERROR(BIF_P, BADARG); + pc = hipe_find_emu_address(mfa.mod, mfa.fun, mfa.ari); + + if (pc) { + hipe_mfa_save_orig_beam_op(mfa.mod, mfa.fun, mfa.ari, pc); +#if HIPE +#ifdef DEBUG_LINKER + printf("%s: ", __FUNCTION__); + print_mfa(mfa.mod, mfa.fun, mfa.ari); + printf(": planting call trap to %p at BEAM pc %p\r\n", address, pc); +#endif + hipe_set_call_trap(pc, address, is_closure); + BIF_RET(am_true); +#endif + } +#ifdef DEBUG_LINKER + printf("%s: ", __FUNCTION__); + print_mfa(mfa.mod, mfa.fun, mfa.ari); + printf(": no BEAM pc found\r\n"); +#endif + BIF_RET(am_false); +} + +#if 0 /* XXX: unused */ +/* + * hipe_bifs_address_to_fun(Address) + * - Address is the address of the start of a emu function's code + * - returns {Module, Function, Arity} + */ +BIF_RETTYPE hipe_bifs_address_to_fun_1(BIF_ALIST_1) +{ + Eterm *pc; + Eterm *funcinfo; + Eterm *hp; + + pc = term_to_address(BIF_ARG_1); + if (!pc) + BIF_ERROR(BIF_P, BADARG); + funcinfo = find_function_from_pc(pc); + if (!funcinfo) + BIF_RET(am_false); + hp = HAlloc(BIF_P, 4); + hp[0] = make_arityval(3); + hp[1] = funcinfo[0]; + hp[2] = funcinfo[1]; + hp[3] = make_small(funcinfo[2]); + BIF_RET(make_tuple(hp)); +} +#endif + +BIF_RETTYPE hipe_bifs_enter_sdesc_1(BIF_ALIST_1) +{ + struct sdesc *sdesc; + + sdesc = hipe_decode_sdesc(BIF_ARG_1); + if (!sdesc) { + fprintf(stderr, "%s: bad sdesc!\r\n", __FUNCTION__); + BIF_ERROR(BIF_P, BADARG); + } + if (hipe_put_sdesc(sdesc) != sdesc) { + fprintf(stderr, "%s: duplicate entry!\r\n", __FUNCTION__); + BIF_ERROR(BIF_P, BADARG); + } + BIF_RET(NIL); +} + +/* + * Hash table mapping {M,F,A} to nbif address. + */ +struct nbif { + HashBucket bucket; + Eterm mod; + Eterm fun; + unsigned arity; + const void *address; +}; + +static struct nbif nbifs[BIF_SIZE] = { +#define BIF_LIST(MOD,FUN,ARY,CFUN,IX) \ + { {0,0}, MOD, FUN, ARY, &nbif_##CFUN }, +#include "erl_bif_list.h" +#undef BIF_LIST +}; + +#define NBIF_HASH(m,f,a) ((m)*(f)+(a)) +static Hash nbif_table; + +static HashValue nbif_hash(struct nbif *x) +{ + return NBIF_HASH(x->mod, x->fun, x->arity); +} + +static int nbif_cmp(struct nbif *x, struct nbif *y) +{ + return !(x->mod == y->mod && x->fun == y->fun && x->arity == y->arity); +} + +static struct nbif *nbif_alloc(struct nbif *x) +{ + return x; /* pre-allocated */ +} + +static void init_nbif_table(void) +{ + HashFunctions f; + int i; + + f.hash = (H_FUN) nbif_hash; + f.cmp = (HCMP_FUN) nbif_cmp; + f.alloc = (HALLOC_FUN) nbif_alloc; + f.free = NULL; + + hash_init(ERTS_ALC_T_NBIF_TABLE, &nbif_table, "nbif_table", 500, f); + + for (i = 0; i < BIF_SIZE; ++i) + hash_put(&nbif_table, &nbifs[i]); +} + +static const void *nbif_address(Eterm mod, Eterm fun, unsigned arity) +{ + struct nbif tmpl; + struct nbif *nbif; + + tmpl.mod = mod; + tmpl.fun = fun; + tmpl.arity = arity; + + nbif = hash_get(&nbif_table, &tmpl); + return nbif ? nbif->address : NULL; +} + +/* + * hipe_bifs_bif_address(M,F,A) -> address or false + */ +BIF_RETTYPE hipe_bifs_bif_address_3(BIF_ALIST_3) +{ + const void *address; + static int init_done = 0; + + if (!init_done) { + init_nbif_table(); + init_done = 1; + } + + if (is_not_atom(BIF_ARG_1) || + is_not_atom(BIF_ARG_2) || + is_not_small(BIF_ARG_3) || + signed_val(BIF_ARG_3) < 0) + BIF_RET(am_false); + + address = nbif_address(BIF_ARG_1, BIF_ARG_2, unsigned_val(BIF_ARG_3)); + if (address) + BIF_RET(address_to_term(address, BIF_P)); + BIF_RET(am_false); +} + +/* + * Hash table mapping primops to their addresses. + */ +struct primop { + HashBucket bucket; /* bucket.hvalue == atom_val(name) */ + const void *address; +#if defined(__arm__) + void *trampoline; +#endif +}; + +static struct primop primops[] = { +#define PRIMOP_LIST(ATOM,ADDRESS) { {0,_unchecked_atom_val(ATOM)}, ADDRESS }, +#include "hipe_primops.h" +#undef PRIMOP_LIST +}; + +static Hash primop_table; + +static HashValue primop_hash(void *tmpl) +{ + return ((struct primop*)tmpl)->bucket.hvalue; /* pre-initialised */ +} + +static int primop_cmp(void *tmpl, void *bucket) +{ + return 0; /* hvalue matched so nothing further to do */ +} + +static void *primop_alloc(void *tmpl) +{ + return tmpl; /* pre-allocated */ +} + +static void init_primop_table(void) +{ + HashFunctions f; + int i; + static int init_done = 0; + + if (init_done) + return; + init_done = 1; + + f.hash = (H_FUN) primop_hash; + f.cmp = (HCMP_FUN) primop_cmp; + f.alloc = (HALLOC_FUN) primop_alloc; + f.free = NULL; + + hash_init(ERTS_ALC_T_HIPE, &primop_table, "primop_table", 50, f); + + for (i = 0; i < sizeof(primops)/sizeof(primops[0]); ++i) + hash_put(&primop_table, &primops[i]); +} + +static struct primop *primop_table_get(Eterm name) +{ + struct primop tmpl; + + init_primop_table(); + tmpl.bucket.hvalue = atom_val(name); + return hash_get(&primop_table, &tmpl); +} + +#if defined(__arm__) +static struct primop *primop_table_put(Eterm name) +{ + struct primop tmpl; + + init_primop_table(); + tmpl.bucket.hvalue = atom_val(name); + return hash_put(&primop_table, &tmpl); +} + +void *hipe_primop_get_trampoline(Eterm name) +{ + struct primop *primop = primop_table_get(name); + return primop ? primop->trampoline : NULL; +} + +void hipe_primop_set_trampoline(Eterm name, void *trampoline) +{ + struct primop *primop = primop_table_put(name); + primop->trampoline = trampoline; +} +#endif + +/* + * hipe_bifs_primop_address(Atom) -> address or false + */ +BIF_RETTYPE hipe_bifs_primop_address_1(BIF_ALIST_1) +{ + const struct primop *primop; + + if (is_not_atom(BIF_ARG_1)) + BIF_RET(am_false); + primop = primop_table_get(BIF_ARG_1); + if (!primop) + BIF_RET(am_false); + BIF_RET(address_to_term(primop->address, BIF_P)); +} + +#if 0 /* XXX: unused */ +/* + * hipe_bifs_gbif_address(F,A) -> address or false + */ +#define GBIF_LIST(ATOM,ARY,CFUN) extern Eterm gbif_##CFUN(void); +#include "hipe_gbif_list.h" +#undef GBIF_LIST + +BIF_RETTYPE hipe_bifs_gbif_address_2(BIF_ALIST_2) +{ + Uint arity; + void *address; + + if (is_not_atom(BIF_ARG_1) || is_not_small(BIF_ARG_2)) + BIF_RET(am_false); /* error or false, does it matter? */ + arity = signed_val(BIF_ARG_2); + /* XXX: replace with a hash table later */ + do { /* trick to let us use 'break' instead of 'goto' */ +#define GBIF_LIST(ATOM,ARY,CFUN) if (BIF_ARG_1 == ATOM && arity == ARY) { address = CFUN; break; } +#include "hipe_gbif_list.h" +#undef GBIF_LIST + printf("\r\n%s: guard BIF ", __FUNCTION__); + fflush(stdout); + erts_printf("%T", BIF_ARG_1); + printf("/%lu isn't listed in hipe_gbif_list.h\r\n", arity); + BIF_RET(am_false); + } while (0); + BIF_RET(address_to_term(address, BIF_P)); +} +#endif + +BIF_RETTYPE hipe_bifs_atom_to_word_1(BIF_ALIST_1) +{ + if (is_not_atom(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(Uint_to_term(BIF_ARG_1, BIF_P)); +} + +BIF_RETTYPE hipe_bifs_term_to_word_1(BIF_ALIST_1) +{ + BIF_RET(Uint_to_term(BIF_ARG_1, BIF_P)); +} + +/* XXX: this is really a primop, not a BIF */ +BIF_RETTYPE hipe_conv_big_to_float(BIF_ALIST_1) +{ + Eterm res; + Eterm *hp; + FloatDef f; + + if (is_not_big(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + if (big_to_double(BIF_ARG_1, &f.fd) < 0) + BIF_ERROR(BIF_P, BADARG); + hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f, hp); + BIF_RET(res); +} + +#if 0 /* XXX: unused */ +/* + * At least parts of this should be inlined in native code. + * The rest could be made a primop used by both the emulator and + * native code... + */ +BIF_RETTYPE hipe_bifs_make_fun_3(BIF_ALIST_3) +{ + Eterm free_vars; + Eterm mod; + Eterm *tp; + Uint index; + Uint uniq; + Uint num_free; + Eterm tmp_var; + Uint *tmp_ptr; + unsigned needed; + ErlFunThing *funp; + Eterm *hp; + int i; + + if (is_not_list(BIF_ARG_1) && is_not_nil(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + free_vars = BIF_ARG_1; + + if (is_not_atom(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + mod = BIF_ARG_2; + + if (is_not_tuple(BIF_ARG_3) || + (arityval(*tuple_val(BIF_ARG_3)) != 3)) + BIF_ERROR(BIF_P, BADARG); + tp = tuple_val(BIF_ARG_3); + + if (term_to_Uint(tp[1], &index) == 0) + BIF_ERROR(BIF_P, BADARG); + if (term_to_Uint(tp[2], &uniq) == 0) + BIF_ERROR(BIF_P, BADARG); + if (term_to_Uint(tp[3], &num_free) == 0) + BIF_ERROR(BIF_P, BADARG); + + needed = ERL_FUN_SIZE + num_free; + funp = (ErlFunThing *) HAlloc(BIF_P, needed); + hp = funp->env; + + funp->thing_word = HEADER_FUN; + + /* Need a ErlFunEntry *fe + * fe->refc++; + * funp->fe = fe; + */ + + funp->num_free = num_free; + funp->creator = BIF_P->id; + for (i = 0; i < num_free; i++) { + if (is_nil(free_vars)) + BIF_ERROR(BIF_P, BADARG); + tmp_ptr = list_val(free_vars); + tmp_var = CAR(tmp_ptr); + free_vars = CDR(tmp_ptr); + *hp++ = tmp_var; + } + if (is_not_nil(free_vars)) + BIF_ERROR(BIF_P, BADARG); + +#ifndef HYBRID /* FIND ME! */ + funp->next = MSO(BIF_P).funs; + MSO(BIF_P).funs = funp; +#endif + + BIF_RET(make_fun(funp)); +} +#endif + +/* + * args: Nativecodeaddress, Module, {Uniq, Index, BeamAddress} + */ +BIF_RETTYPE hipe_bifs_make_fe_3(BIF_ALIST_3) +{ + Eterm mod; + Uint index; + Uint uniq; + void *beam_address; + ErlFunEntry *fe; + Eterm *tp; + void *native_address; + + native_address = term_to_address(BIF_ARG_1); + if (!native_address) + BIF_ERROR(BIF_P, BADARG); + + if (is_not_atom(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + mod = BIF_ARG_2; + + if (is_not_tuple(BIF_ARG_3) || + (arityval(*tuple_val(BIF_ARG_3)) != 3)) + BIF_ERROR(BIF_P, BADARG); + tp = tuple_val(BIF_ARG_3); + if (term_to_Uint(tp[1], &uniq) == 0) + BIF_ERROR(BIF_P, BADARG); + if (term_to_Uint(tp[2], &index) == 0) + BIF_ERROR(BIF_P, BADARG); + + beam_address = term_to_address(tp[3]); + if (!beam_address) + BIF_ERROR(BIF_P, BADARG); + + fe = erts_get_fun_entry(mod, uniq, index); + if (fe == NULL) { + int i = atom_val(mod); + char atom_buf[256]; + + atom_buf[0] = '\0'; + strncat(atom_buf, (char*)atom_tab(i)->name, atom_tab(i)->len); + printf("no fun entry for %s %ld:%ld\n", atom_buf, uniq, index); + BIF_ERROR(BIF_P, BADARG); + } + fe->native_address = native_address; + if (erts_refc_dectest(&fe->refc, 0) == 0) + erts_erase_fun_entry(fe); + BIF_RET(address_to_term((void *)fe, BIF_P)); +} + +#if 0 /* XXX: unused */ +BIF_RETTYPE hipe_bifs_make_native_stub_2(BIF_ALIST_2) +{ + void *beamAddress; + Uint beamArity; + void *stubAddress; + + if ((beamAddress = term_to_address(BIF_ARG_1)) == 0 || + is_not_small(BIF_ARG_2) || + (beamArity = unsigned_val(BIF_ARG_2)) >= 256) + BIF_ERROR(BIF_P, BADARG); + stubAddress = hipe_make_native_stub(beamAddress, beamArity); + BIF_RET(address_to_term(stubAddress, BIF_P)); +} +#endif + +/* + * MFA info hash table: + * - maps MFA to native code entry point + * - the MFAs it calls (refers_to) + * - the references to it (referred_from) + * - maps MFA to most recent trampoline [if powerpc or arm] + */ +struct hipe_mfa_info { + struct { + unsigned long hvalue; + struct hipe_mfa_info *next; + } bucket; + Eterm m; /* atom */ + Eterm f; /* atom */ + unsigned int a; + void *remote_address; + void *local_address; + Eterm *beam_code; + Uint orig_beam_op; + struct hipe_mfa_info_list *refers_to; + struct ref *referred_from; +#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) + void *trampoline; +#endif +}; + +static struct { + unsigned int log2size; + unsigned int mask; /* INV: mask == (1 << log2size)-1 */ + unsigned int used; + struct hipe_mfa_info **bucket; +} hipe_mfa_info_table; + +#define HIPE_MFA_HASH(M,F,A) ((M) * (F) + (A)) + +static struct hipe_mfa_info **hipe_mfa_info_table_alloc_bucket(unsigned int size) +{ + unsigned long nbytes = size * sizeof(struct hipe_mfa_info*); + struct hipe_mfa_info **bucket = erts_alloc(ERTS_ALC_T_HIPE, nbytes); + sys_memzero(bucket, nbytes); + return bucket; +} + +static void hipe_mfa_info_table_grow(void) +{ + unsigned int old_size, new_size, new_mask; + struct hipe_mfa_info **old_bucket, **new_bucket; + unsigned int i; + + old_size = 1 << hipe_mfa_info_table.log2size; + hipe_mfa_info_table.log2size += 1; + new_size = 1 << hipe_mfa_info_table.log2size; + new_mask = new_size - 1; + hipe_mfa_info_table.mask = new_mask; + old_bucket = hipe_mfa_info_table.bucket; + new_bucket = hipe_mfa_info_table_alloc_bucket(new_size); + hipe_mfa_info_table.bucket = new_bucket; + for (i = 0; i < old_size; ++i) { + struct hipe_mfa_info *b = old_bucket[i]; + while (b != NULL) { + struct hipe_mfa_info *next = b->bucket.next; + unsigned int j = b->bucket.hvalue & new_mask; + b->bucket.next = new_bucket[j]; + new_bucket[j] = b; + b = next; + } + } + erts_free(ERTS_ALC_T_HIPE, old_bucket); +} + +static struct hipe_mfa_info *hipe_mfa_info_table_alloc(Eterm m, Eterm f, unsigned int arity) +{ + struct hipe_mfa_info *res; + + res = (struct hipe_mfa_info*)erts_alloc(ERTS_ALC_T_HIPE, sizeof(*res)); + res->m = m; + res->f = f; + res->a = arity; + res->remote_address = NULL; + res->local_address = NULL; + res->beam_code = NULL; + res->orig_beam_op = 0; + res->refers_to = NULL; + res->referred_from = NULL; +#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) + res->trampoline = NULL; +#endif + + return res; +} + +void hipe_mfa_info_table_init(void) +{ + unsigned int log2size, size; + + log2size = 10; + size = 1 << log2size; + hipe_mfa_info_table.log2size = log2size; + hipe_mfa_info_table.mask = size - 1; + hipe_mfa_info_table.used = 0; + hipe_mfa_info_table.bucket = hipe_mfa_info_table_alloc_bucket(size); +} + +static inline struct hipe_mfa_info *hipe_mfa_info_table_get(Eterm m, Eterm f, unsigned int arity) +{ + unsigned long h; + unsigned int i; + struct hipe_mfa_info *p; + + h = HIPE_MFA_HASH(m, f, arity); + i = h & hipe_mfa_info_table.mask; + p = hipe_mfa_info_table.bucket[i]; + for (; p; p = p->bucket.next) + /* XXX: do we want to compare p->bucket.hvalue as well? */ + if (p->m == m && p->f == f && p->a == arity) + return p; + return NULL; +} + +#if 0 /* XXX: unused */ +void *hipe_mfa_find_na(Eterm m, Eterm f, unsigned int arity) +{ + const struct hipe_mfa_info *p; + + p = hipe_mfa_info_table_get(m, f, arity); + return p ? p->address : NULL; +} +#endif + +static struct hipe_mfa_info *hipe_mfa_info_table_put(Eterm m, Eterm f, unsigned int arity) +{ + unsigned long h; + unsigned int i; + struct hipe_mfa_info *p; + unsigned int size; + + h = HIPE_MFA_HASH(m, f, arity); + i = h & hipe_mfa_info_table.mask; + p = hipe_mfa_info_table.bucket[i]; + for (; p; p = p->bucket.next) + /* XXX: do we want to compare p->bucket.hvalue as well? */ + if (p->m == m && p->f == f && p->a == arity) + return p; + p = hipe_mfa_info_table_alloc(m, f, arity); + p->bucket.hvalue = h; + p->bucket.next = hipe_mfa_info_table.bucket[i]; + hipe_mfa_info_table.bucket[i] = p; + hipe_mfa_info_table.used += 1; + size = 1 << hipe_mfa_info_table.log2size; + if (hipe_mfa_info_table.used > (4*size/5)) /* rehash at 80% */ + hipe_mfa_info_table_grow(); + return p; +} + +static void hipe_mfa_set_na(Eterm m, Eterm f, unsigned int arity, void *address, int is_exported) +{ + struct hipe_mfa_info *p = hipe_mfa_info_table_put(m, f, arity); +#ifdef DEBUG_LINKER + printf("%s: ", __FUNCTION__); + print_mfa(m, f, arity); + printf(": changing address from %p to %p\r\n", p->local_address, address); +#endif + p->local_address = address; + if (is_exported) + p->remote_address = address; +} + +#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) +void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int arity) +{ + struct hipe_mfa_info *p = hipe_mfa_info_table_put(m, f, arity); + return p->trampoline; +} + +void hipe_mfa_set_trampoline(Eterm m, Eterm f, unsigned int arity, void *trampoline) +{ + struct hipe_mfa_info *p = hipe_mfa_info_table_put(m, f, arity); + p->trampoline = trampoline; +} +#endif + +BIF_RETTYPE hipe_bifs_set_funinfo_native_address_3(BIF_ALIST_3) +{ + struct mfa mfa; + void *address; + int is_exported; + + if (!term_to_mfa(BIF_ARG_1, &mfa)) + BIF_ERROR(BIF_P, BADARG); + address = term_to_address(BIF_ARG_2); + if (!address) + BIF_ERROR(BIF_P, BADARG); + if (BIF_ARG_3 == am_true) + is_exported = 1; + else if (BIF_ARG_3 == am_false) + is_exported = 0; + else + BIF_ERROR(BIF_P, BADARG); + hipe_mfa_set_na(mfa.mod, mfa.fun, mfa.ari, address, is_exported); + BIF_RET(NIL); +} + +BIF_RETTYPE hipe_bifs_invalidate_funinfo_native_addresses_1(BIF_ALIST_1) +{ + Eterm lst; + struct mfa mfa; + struct hipe_mfa_info *p; + + lst = BIF_ARG_1; + while (is_list(lst)) { + if (!term_to_mfa(CAR(list_val(lst)), &mfa)) + BIF_ERROR(BIF_P, BADARG); + lst = CDR(list_val(lst)); + p = hipe_mfa_info_table_get(mfa.mod, mfa.fun, mfa.ari); + if (p) { + p->remote_address = NULL; + p->local_address = NULL; + if (p->beam_code) { +#ifdef DEBUG_LINKER + printf("%s: ", __FUNCTION__); + print_mfa(mfa.mod, mfa.fun, mfa.ari); + printf(": removing call trap from BEAM pc %p (new op %#lx)\r\n", + p->beam_code, p->orig_beam_op); +#endif + p->beam_code[0] = p->orig_beam_op; + p->beam_code = NULL; + p->orig_beam_op = 0; + } else { +#ifdef DEBUG_LINKER + printf("%s: ", __FUNCTION__); + print_mfa(mfa.mod, mfa.fun, mfa.ari); + printf(": no call trap to remove\r\n"); +#endif + } + } + } + if (is_not_nil(lst)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(NIL); +} + +void hipe_mfa_save_orig_beam_op(Eterm mod, Eterm fun, unsigned int ari, Eterm *pc) +{ + Uint orig_beam_op; + struct hipe_mfa_info *p; + + orig_beam_op = pc[0]; + if (orig_beam_op != BeamOpCode(op_hipe_trap_call_closure) && + orig_beam_op != BeamOpCode(op_hipe_trap_call)) { + p = hipe_mfa_info_table_put(mod, fun, ari); +#ifdef DEBUG_LINKER + printf("%s: ", __FUNCTION__); + print_mfa(mod, fun, ari); + printf(": saving orig op %#lx from BEAM pc %p\r\n", orig_beam_op, pc); +#endif + p->beam_code = pc; + p->orig_beam_op = orig_beam_op; + } else { +#ifdef DEBUG_LINKER + printf("%s: ", __FUNCTION__); + print_mfa(mod, fun, ari); + printf(": orig op %#lx already saved\r\n", orig_beam_op); +#endif + } +} + +static void *hipe_make_stub(Eterm m, Eterm f, unsigned int arity, int is_remote) +{ + void *BEAMAddress; + void *StubAddress; + +#if 0 + if (is_not_atom(m) || is_not_atom(f) || arity > 255) + return NULL; +#endif + BEAMAddress = hipe_get_emu_address(m, f, arity, is_remote); + StubAddress = hipe_make_native_stub(BEAMAddress, arity); +#if 0 + hipe_mfa_set_na(m, f, arity, StubAddress); +#endif + return StubAddress; +} + +static void *hipe_get_na_nofail(Eterm m, Eterm f, unsigned int a, int is_remote) +{ + struct hipe_mfa_info *p; + void *address; + + p = hipe_mfa_info_table_get(m, f, a); + if (p) { + /* find address, predicting for a runtime apply call */ + address = p->remote_address; + if (!is_remote) + address = p->local_address; + if (address) + return address; + + /* bummer, install stub, checking if one already existed */ + address = p->remote_address; + if (address) + return address; + } else + p = hipe_mfa_info_table_put(m, f, a); + address = hipe_make_stub(m, f, a, is_remote); + /* XXX: how to tell if a BEAM MFA is exported or not? */ + p->remote_address = address; + return address; +} + +/* used for apply/3 in hipe_mode_switch */ +void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a) +{ + if (is_not_atom(m) || is_not_atom(f) || a > 255) + return NULL; + return hipe_get_na_nofail(m, f, a, 1); +} + +/* primop, but called like a BIF for error handling purposes */ +BIF_RETTYPE hipe_find_na_or_make_stub(BIF_ALIST_3) +{ + Uint arity; + void *address; + + if (is_not_atom(BIF_ARG_1) || is_not_atom(BIF_ARG_2)) + BIF_ERROR(BIF_P, BADARG); + arity = unsigned_val(BIF_ARG_3); /* no error check */ + address = hipe_get_na_nofail(BIF_ARG_1, BIF_ARG_2, arity, 1); + BIF_RET((Eterm)address); /* semi-Ok */ +} + +BIF_RETTYPE hipe_bifs_find_na_or_make_stub_2(BIF_ALIST_2) +{ + struct mfa mfa; + void *address; + int is_remote; + + if (!term_to_mfa(BIF_ARG_1, &mfa)) + BIF_ERROR(BIF_P, BADARG); + if (BIF_ARG_2 == am_true) + is_remote = 1; + else if (BIF_ARG_2 == am_false) + is_remote = 0; + else + BIF_ERROR(BIF_P, BADARG); + address = hipe_get_na_nofail(mfa.mod, mfa.fun, mfa.ari, is_remote); + BIF_RET(address_to_term(address, BIF_P)); +} + +/* primop, but called like a BIF for error handling purposes */ +BIF_RETTYPE hipe_nonclosure_address(BIF_ALIST_2) +{ + Eterm hdr, m, f; + void *address; + + if (!is_boxed(BIF_ARG_1)) + goto badfun; + hdr = *boxed_val(BIF_ARG_1); + if (is_export_header(hdr)) { + Export *ep = (Export*)(export_val(BIF_ARG_1)[1]); + unsigned int actual_arity = ep->code[2]; + if (actual_arity != BIF_ARG_2) + goto badfun; + m = ep->code[0]; + f = ep->code[1]; + } else if (hdr == make_arityval(2)) { + Eterm *tp = tuple_val(BIF_ARG_1); + m = tp[1]; + f = tp[2]; + if (is_not_atom(m) || is_not_atom(f)) + goto badfun; + if (!erts_find_export_entry(m, f, BIF_ARG_2)) + goto badfun; + } else + goto badfun; + address = hipe_get_na_nofail(m, f, BIF_ARG_2, 1); + BIF_RET((Eterm)address); + + badfun: + BIF_P->current = NULL; + BIF_P->fvalue = BIF_ARG_1; + BIF_ERROR(BIF_P, EXC_BADFUN); +} + +int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a) +{ + struct hipe_mfa_info *mfa; + long mfa_offset, ra_offset; + struct hipe_mfa_info **bucket; + unsigned int i, nrbuckets; + + /* Note about locking: the table is only updated from the + loader, which runs with the rest of the system suspended. */ + bucket = hipe_mfa_info_table.bucket; + nrbuckets = 1 << hipe_mfa_info_table.log2size; + mfa = NULL; + mfa_offset = LONG_MAX; + for (i = 0; i < nrbuckets; ++i) { + struct hipe_mfa_info *b = bucket[i]; + while (b != NULL) { + ra_offset = (char*)ra - (char*)b->local_address; + if (ra_offset > 0 && ra_offset < mfa_offset) { + mfa_offset = ra_offset; + mfa = b; + } + b = b->bucket.next; + } + } + if (!mfa) + return 0; + *m = mfa->m; + *f = mfa->f; + *a = mfa->a; + return 1; +} + +/* + * Patch Reference Handling. + */ +struct hipe_mfa_info_list { + struct hipe_mfa_info *mfa; + struct hipe_mfa_info_list *next; +}; + +struct ref { + struct hipe_mfa_info *caller_mfa; + void *address; + void *trampoline; + unsigned int flags; + struct ref *next; +}; +#define REF_FLAG_IS_LOAD_MFA 1 /* bit 0: 0 == call, 1 == load_mfa */ +#define REF_FLAG_IS_REMOTE 2 /* bit 1: 0 == local, 1 == remote */ +#define REF_FLAG_PENDING_REDIRECT 4 /* bit 2: 1 == pending redirect */ +#define REF_FLAG_PENDING_REMOVE 8 /* bit 3: 1 == pending remove */ + +/* add_ref(CalleeMFA, {CallerMFA,Address,'call'|'load_mfa',Trampoline,'remote'|'local'}) + */ +BIF_RETTYPE hipe_bifs_add_ref_2(BIF_ALIST_2) +{ + struct mfa callee; + Eterm *tuple; + struct mfa caller; + void *address; + void *trampoline; + unsigned int flags; + struct hipe_mfa_info *callee_mfa; + struct hipe_mfa_info *caller_mfa; + struct hipe_mfa_info_list *refers_to; + struct ref *ref; + + if (!term_to_mfa(BIF_ARG_1, &callee)) + goto badarg; + if (is_not_tuple(BIF_ARG_2)) + goto badarg; + tuple = tuple_val(BIF_ARG_2); + if (tuple[0] != make_arityval(5)) + goto badarg; + if (!term_to_mfa(tuple[1], &caller)) + goto badarg; + address = term_to_address(tuple[2]); + if (!address) + goto badarg; + switch (tuple[3]) { + case am_call: + flags = 0; + break; + case am_load_mfa: + flags = REF_FLAG_IS_LOAD_MFA; + break; + default: + goto badarg; + } + if (is_nil(tuple[4])) + trampoline = NULL; + else { + trampoline = term_to_address(tuple[4]); + if (!trampoline) + goto badarg; + } + switch (tuple[5]) { + case am_local: + break; + case am_remote: + flags |= REF_FLAG_IS_REMOTE; + break; + default: + goto badarg; + } + callee_mfa = hipe_mfa_info_table_put(callee.mod, callee.fun, callee.ari); + caller_mfa = hipe_mfa_info_table_put(caller.mod, caller.fun, caller.ari); + + refers_to = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*refers_to)); + refers_to->mfa = callee_mfa; + refers_to->next = caller_mfa->refers_to; + caller_mfa->refers_to = refers_to; + + ref = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*ref)); + ref->caller_mfa = caller_mfa; + ref->address = address; + ref->trampoline = trampoline; + ref->flags = flags; + ref->next = callee_mfa->referred_from; + callee_mfa->referred_from = ref; + + BIF_RET(NIL); + + badarg: + BIF_ERROR(BIF_P, BADARG); +} + +/* Given a CalleeMFA, mark each ref to it as pending-redirect. + * This ensures that remove_refs_from() won't remove them: any + * removal is instead done at the end of redirect_referred_from(). + */ +BIF_RETTYPE hipe_bifs_mark_referred_from_1(BIF_ALIST_1) /* get_refs_from */ +{ + struct mfa mfa; + const struct hipe_mfa_info *p; + struct ref *ref; + + if (!term_to_mfa(BIF_ARG_1, &mfa)) + BIF_ERROR(BIF_P, BADARG); + p = hipe_mfa_info_table_get(mfa.mod, mfa.fun, mfa.ari); + if (p) + for (ref = p->referred_from; ref != NULL; ref = ref->next) + ref->flags |= REF_FLAG_PENDING_REDIRECT; + BIF_RET(NIL); +} + +BIF_RETTYPE hipe_bifs_remove_refs_from_1(BIF_ALIST_1) +{ + struct mfa mfa; + struct hipe_mfa_info *caller_mfa, *callee_mfa; + struct hipe_mfa_info_list *refers_to, *tmp_refers_to; + struct ref **prev, *ref; + + if (!term_to_mfa(BIF_ARG_1, &mfa)) + BIF_ERROR(BIF_P, BADARG); + caller_mfa = hipe_mfa_info_table_get(mfa.mod, mfa.fun, mfa.ari); + if (caller_mfa) { + refers_to = caller_mfa->refers_to; + while (refers_to) { + callee_mfa = refers_to->mfa; + prev = &callee_mfa->referred_from; + ref = *prev; + while (ref) { + if (ref->caller_mfa == caller_mfa) { + if (ref->flags & REF_FLAG_PENDING_REDIRECT) { + ref->flags |= REF_FLAG_PENDING_REMOVE; + prev = &ref->next; + ref = ref->next; + } else { + struct ref *tmp = ref; + ref = ref->next; + *prev = ref; + erts_free(ERTS_ALC_T_HIPE, tmp); + } + } else { + prev = &ref->next; + ref = ref->next; + } + } + tmp_refers_to = refers_to; + refers_to = refers_to->next; + erts_free(ERTS_ALC_T_HIPE, tmp_refers_to); + } + caller_mfa->refers_to = NULL; + } + BIF_RET(NIL); +} + +/* redirect_referred_from(CalleeMFA) + * Redirect all pending-redirect refs in CalleeMFA's referred_from. + * Then remove any pending-redirect && pending-remove refs from CalleeMFA's referred_from. + */ +BIF_RETTYPE hipe_bifs_redirect_referred_from_1(BIF_ALIST_1) +{ + struct mfa mfa; + struct hipe_mfa_info *p; + struct ref **prev, *ref; + int is_remote, res; + void *new_address; + + if (!term_to_mfa(BIF_ARG_1, &mfa)) + BIF_ERROR(BIF_P, BADARG); + p = hipe_mfa_info_table_get(mfa.mod, mfa.fun, mfa.ari); + if (p) { + prev = &p->referred_from; + ref = *prev; + while (ref) { + if (ref->flags & REF_FLAG_PENDING_REDIRECT) { + is_remote = ref->flags & REF_FLAG_IS_REMOTE; + new_address = hipe_get_na_nofail(p->m, p->f, p->a, is_remote); + if (ref->flags & REF_FLAG_IS_LOAD_MFA) + res = hipe_patch_insn(ref->address, (Uint)new_address, am_load_mfa); + else + res = hipe_patch_call(ref->address, new_address, ref->trampoline); + if (res) + fprintf(stderr, "%s: patch failed\r\n", __FUNCTION__); + ref->flags &= ~REF_FLAG_PENDING_REDIRECT; + if (ref->flags & REF_FLAG_PENDING_REMOVE) { + struct ref *tmp = ref; + ref = ref->next; + *prev = ref; + erts_free(ERTS_ALC_T_HIPE, tmp); + } else { + prev = &ref->next; + ref = ref->next; + } + } else { + prev = &ref->next; + ref = ref->next; + } + } + } + BIF_RET(NIL); +} + +BIF_RETTYPE hipe_bifs_check_crc_1(BIF_ALIST_1) +{ + Uint crc; + + if (!term_to_Uint(BIF_ARG_1, &crc)) + BIF_ERROR(BIF_P, BADARG); + if (crc == HIPE_SYSTEM_CRC) + BIF_RET(am_true); + BIF_RET(am_false); +} + +BIF_RETTYPE hipe_bifs_system_crc_1(BIF_ALIST_1) +{ + Uint crc; + + if (!term_to_Uint(BIF_ARG_1, &crc)) + BIF_ERROR(BIF_P, BADARG); + crc ^= (HIPE_SYSTEM_CRC ^ HIPE_LITERALS_CRC); + BIF_RET(Uint_to_term(crc, BIF_P)); +} + +BIF_RETTYPE hipe_bifs_get_rts_param_1(BIF_ALIST_1) +{ + unsigned int is_defined; + unsigned long value; + + if (is_not_small(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + is_defined = 1; + value = 0; + switch (unsigned_val(BIF_ARG_1)) { + RTS_PARAMS_CASES + default: + BIF_ERROR(BIF_P, BADARG); + } + if (!is_defined) + BIF_RET(NIL); + BIF_RET(Uint_to_term(value, BIF_P)); +} + +void hipe_patch_address(Uint *address, Eterm patchtype, Uint value) +{ + switch (patchtype) { + case am_load_fe: + hipe_patch_load_fe(address, value); + return; + default: + fprintf(stderr, "%s: unknown patchtype %#lx\r\n", + __FUNCTION__, patchtype); + return; + } +} + +struct modinfo { + HashBucket bucket; /* bucket.hvalue == atom_val(the module name) */ + unsigned int code_size; +}; + +static Hash modinfo_table; + +static HashValue modinfo_hash(void *tmpl) +{ + Eterm mod = (Eterm)tmpl; + return atom_val(mod); +} + +static int modinfo_cmp(void *tmpl, void *bucket) +{ + /* bucket->hvalue == modinfo_hash(tmpl), so just return 0 (match) */ + return 0; +} + +static void *modinfo_alloc(void *tmpl) +{ + struct modinfo *p; + + p = (struct modinfo*)erts_alloc(ERTS_ALC_T_HIPE, sizeof(*p)); + p->code_size = 0; + return &p->bucket; +} + +static void init_modinfo_table(void) +{ + HashFunctions f; + static int init_done = 0; + + if (init_done) + return; + init_done = 1; + f.hash = (H_FUN) modinfo_hash; + f.cmp = (HCMP_FUN) modinfo_cmp; + f.alloc = (HALLOC_FUN) modinfo_alloc; + f.free = (HFREE_FUN) NULL; + hash_init(ERTS_ALC_T_HIPE, &modinfo_table, "modinfo_table", 11, f); +} + +BIF_RETTYPE hipe_bifs_update_code_size_3(BIF_ALIST_3) +{ + struct modinfo *p; + Sint code_size; + + init_modinfo_table(); + + if (is_not_atom(BIF_ARG_1) || + is_not_small(BIF_ARG_3) || + (code_size = signed_val(BIF_ARG_3)) < 0) + BIF_ERROR(BIF_P, BADARG); + + p = (struct modinfo*)hash_put(&modinfo_table, (void*)BIF_ARG_1); + + if (is_nil(BIF_ARG_2)) /* some MFAs, not whole module */ + p->code_size += code_size; + else /* whole module */ + p->code_size = code_size; + BIF_RET(NIL); +} + +BIF_RETTYPE hipe_bifs_code_size_1(BIF_ALIST_1) +{ + struct modinfo *p; + unsigned int code_size; + + init_modinfo_table(); + + if (is_not_atom(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + + p = (struct modinfo*)hash_get(&modinfo_table, (void*)BIF_ARG_1); + + code_size = p ? p->code_size : 0; + BIF_RET(make_small(code_size)); +} + +BIF_RETTYPE hipe_bifs_patch_insn_3(BIF_ALIST_3) +{ + Uint *address, value; + + address = term_to_address(BIF_ARG_1); + if (!address) + BIF_ERROR(BIF_P, BADARG); + if (!term_to_Uint(BIF_ARG_2, &value)) + BIF_ERROR(BIF_P, BADARG); + if (hipe_patch_insn(address, value, BIF_ARG_3)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(NIL); +} + +BIF_RETTYPE hipe_bifs_patch_call_3(BIF_ALIST_3) +{ + Uint *callAddress, *destAddress, *trampAddress; + + callAddress = term_to_address(BIF_ARG_1); + if (!callAddress) + BIF_ERROR(BIF_P, BADARG); + destAddress = term_to_address(BIF_ARG_2); + if (!destAddress) + BIF_ERROR(BIF_P, BADARG); + if (is_nil(BIF_ARG_3)) + trampAddress = NULL; + else { + trampAddress = term_to_address(BIF_ARG_3); + if (!trampAddress) + BIF_ERROR(BIF_P, BADARG); + } + if (hipe_patch_call(callAddress, destAddress, trampAddress)) + BIF_ERROR(BIF_P, BADARG); + BIF_RET(NIL); +} diff --git a/erts/emulator/hipe/hipe_bif0.h b/erts/emulator/hipe/hipe_bif0.h new file mode 100644 index 0000000000..ed27d5616a --- /dev/null +++ b/erts/emulator/hipe/hipe_bif0.h @@ -0,0 +1,53 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_bif0.h + * + * Compiler and linker support. + */ +#ifndef HIPE_BIF0_H +#define HIPE_BIF0_H + +extern Uint *hipe_bifs_find_pc_from_mfa(Eterm mfa); + +/* shared with ggc.c -- NOT an official API */ +extern Eterm *hipe_constants_start; +extern Eterm *hipe_constants_next; + +extern void hipe_mfa_info_table_init(void); +extern void *hipe_get_remote_na(Eterm m, Eterm f, unsigned int a); +extern Eterm hipe_find_na_or_make_stub(Process*, Eterm, Eterm, Eterm); +extern int hipe_find_mfa_from_ra(const void *ra, Eterm *m, Eterm *f, unsigned int *a); +#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) +extern void *hipe_mfa_get_trampoline(Eterm m, Eterm f, unsigned int a); +extern void hipe_mfa_set_trampoline(Eterm m, Eterm f, unsigned int a, void *trampoline); +#endif +#if defined(__arm__) +extern void *hipe_primop_get_trampoline(Eterm name); +extern void hipe_primop_set_trampoline(Eterm name, void *trampoline); +#endif + +/* needed in beam_load.c */ +void hipe_mfa_save_orig_beam_op(Eterm m, Eterm f, unsigned int a, Eterm *pc); + +/* these are also needed in hipe_amd64.c */ +extern void *term_to_address(Eterm); +extern int term_to_Sint32(Eterm, Sint *); + +#endif /* HIPE_BIF0_H */ diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab new file mode 100644 index 0000000000..46c0a3d67d --- /dev/null +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -0,0 +1,142 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# $Id$ +# HiPE level 0 bifs: compiler and linker support +# +# bif hipe_bifs:name/arity + +#bif hipe_bifs:read_u8/1 +#bif hipe_bifs:read_u32/1 +bif hipe_bifs:write_u8/2 +#bif hipe_bifs:write_s32/2 +bif hipe_bifs:write_u32/2 +# bif hipe_bifs:write_s64/2 +# bif hipe_bifs:write_u64/2 + +bif hipe_bifs:bytearray/2 +bif hipe_bifs:bytearray_sub/2 +bif hipe_bifs:bytearray_update/3 +bif hipe_bifs:bitarray/2 +bif hipe_bifs:bitarray_sub/2 +bif hipe_bifs:bitarray_update/3 +bif hipe_bifs:array/2 +bif hipe_bifs:array_length/1 +bif hipe_bifs:array_sub/2 +bif hipe_bifs:array_update/3 +bif hipe_bifs:ref/1 +bif hipe_bifs:ref_get/1 +bif hipe_bifs:ref_set/2 + +bif hipe_bifs:enter_code/2 +bif hipe_bifs:alloc_data/2 +bif hipe_bifs:constants_size/0 +bif hipe_bifs:merge_term/1 + +bif hipe_bifs:fun_to_address/1 +#bif hipe_bifs:get_emu_address/1 +bif hipe_bifs:set_native_address/3 +#bif hipe_bifs:address_to_fun/1 + +bif hipe_bifs:set_funinfo_native_address/3 +bif hipe_bifs:invalidate_funinfo_native_addresses/1 + +bif hipe_bifs:update_code_size/3 +bif hipe_bifs:code_size/1 + +bif hipe_bifs:enter_sdesc/1 + +bif hipe_bifs:bif_address/3 +bif hipe_bifs:primop_address/1 +#bif hipe_bifs:gbif_address/2 + +bif hipe_bifs:atom_to_word/1 +bif hipe_bifs:term_to_word/1 + +#bif hipe_bifs:make_fun/3 +bif hipe_bifs:make_fe/3 + +#bif hipe_bifs:make_native_stub/2 +bif hipe_bifs:find_na_or_make_stub/2 + +bif hipe_bifs:check_crc/1 +bif hipe_bifs:system_crc/1 +bif hipe_bifs:get_rts_param/1 + +#bif hipe_bifs:tuple_to_float/1 + +bif hipe_bifs:patch_insn/3 +bif hipe_bifs:patch_call/3 + +bif hipe_bifs:add_ref/2 +bif hipe_bifs:mark_referred_from/1 +bif hipe_bifs:remove_refs_from/1 +bif hipe_bifs:redirect_referred_from/1 + +# atoms used by add_ref/2 +atom call +atom load_mfa +atom local +atom remote + +# atoms used by hipe_bifs:patch_insn/3 +atom atom +atom c_const +atom call +atom closure +atom constant +atom load_mfa +atom x86_abs_pcrel + +# atom used by hipe_patch_address() +atom load_fe + +atom suspend_msg +atom suspend_msg_timeout +atom suspend_0 +atom gc_1 +atom hipe_apply +atom rethrow +atom find_na_or_make_stub +atom nonclosure_address +atom atomic_inc +atom clear_timeout +atom check_get_msg +atom select_msg +atom set_timeout +atom cmp_2 +atom op_exact_eqeq_2 +atom conv_big_to_float +atom fclearerror_error +atom bs_put_big_integer +atom bs_put_small_float +atom bs_put_bits +atom bs_allocate +atom bs_get_integer_2 +atom bs_get_float_2 +atom bs_get_binary_2 +atom bs_reallocate +atom bs_utf8_size +atom bs_put_utf8 +atom bs_get_utf8 +atom bs_utf16_size +atom bs_put_utf16be +atom bs_put_utf16le +atom bs_get_utf16 +atom bs_validate_unicode +atom bs_validate_unicode_retract diff --git a/erts/emulator/hipe/hipe_bif1.c b/erts/emulator/hipe/hipe_bif1.c new file mode 100644 index 0000000000..5188950e17 --- /dev/null +++ b/erts/emulator/hipe/hipe_bif1.c @@ -0,0 +1,937 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_bif1.c + * + * Performance analysis support. + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "sys.h" +#include "global.h" +#include "bif.h" +#include "big.h" +#include "error.h" +#include "beam_load.h" +#include "hipe_bif0.h" +#include "hipe_bif1.h" + +#define BeamOpCode(Op) ((Uint)BeamOp(Op)) + +BIF_RETTYPE hipe_bifs_call_count_on_1(BIF_ALIST_1) +{ + Eterm *pc; + struct hipe_call_count *hcc; + + pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); + if (!pc) + BIF_ERROR(BIF_P, BADARG); + ASSERT(pc[-5] == BeamOpCode(op_i_func_info_IaaI)); + if (pc[0] == BeamOpCode(op_hipe_trap_call)) + BIF_ERROR(BIF_P, BADARG); + if (pc[0] == BeamOpCode(op_hipe_call_count)) + BIF_RET(NIL); + hcc = erts_alloc(ERTS_ALC_T_HIPE, sizeof(*hcc)); + hcc->count = 0; + hcc->opcode = pc[0]; + pc[-4] = (Eterm)hcc; + pc[0] = BeamOpCode(op_hipe_call_count); + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_call_count_off_1(BIF_ALIST_1) +{ + Eterm *pc; + struct hipe_call_count *hcc; + unsigned count; + + pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); + if (!pc) + BIF_ERROR(BIF_P, BADARG); + ASSERT(pc[-5] == BeamOpCode(op_i_func_info_IaaI)); + if (pc[0] != BeamOpCode(op_hipe_call_count)) + BIF_RET(am_false); + hcc = (struct hipe_call_count*)pc[-4]; + count = hcc->count; + pc[0] = hcc->opcode; + pc[-4] = (Eterm)NULL; + erts_free(ERTS_ALC_T_HIPE, hcc); + BIF_RET(make_small(count)); +} + +BIF_RETTYPE hipe_bifs_call_count_get_1(BIF_ALIST_1) +{ + Eterm *pc; + struct hipe_call_count *hcc; + + pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); + if (!pc) + BIF_ERROR(BIF_P, BADARG); + ASSERT(pc[-5] == BeamOpCode(op_i_func_info_IaaI)); + if (pc[0] != BeamOpCode(op_hipe_call_count)) + BIF_RET(am_false); + hcc = (struct hipe_call_count*)pc[-4]; + BIF_RET(make_small(hcc->count)); +} + +BIF_RETTYPE hipe_bifs_call_count_clear_1(BIF_ALIST_1) +{ + Eterm *pc; + struct hipe_call_count *hcc; + unsigned count; + + pc = hipe_bifs_find_pc_from_mfa(BIF_ARG_1); + if (!pc) + BIF_ERROR(BIF_P, BADARG); + ASSERT(pc[-5] == BeamOpCode(op_i_func_info_IaaI)); + if (pc[0] != BeamOpCode(op_hipe_call_count)) + BIF_RET(am_false); + hcc = (struct hipe_call_count*)pc[-4]; + count = hcc->count; + hcc->count = 0; + BIF_RET(make_small(count)); +} + +unsigned int hipe_trap_count; + +BIF_RETTYPE hipe_bifs_trap_count_get_0(BIF_ALIST_0) +{ + BIF_RET(make_small(hipe_trap_count)); +} + +BIF_RETTYPE hipe_bifs_trap_count_clear_0(BIF_ALIST_0) +{ + unsigned int count = hipe_trap_count; + hipe_trap_count = 0; + BIF_RET(make_small(count)); +} + +/***************************************************************************** + * BIFs for benchmarking. These only do useful things if + * __BENCHMARK__ is defined in beam/benchmark.h. For documentation + * about how to add new counters or maintain the existing counters, + * see benchmark.h. + * + * If benchmarking is not enabled all BIFs will return false. If the + * required benchmark feature is not enabled, the counter will remain + * zero. + * + * process_info/0 -> { Number of live processes, + * Processes spawned in total } + * + * Live processes are increased when a new process is created, and + * decreased when a process dies. Processes spawned is increased + * when a process is created. + * + * + * process_info_clear/0 -> true + * + * Will reset the processes spawned-counters to zero. If this is + * done at some improper time, live processes may become a negative + * value. This is not a problem in itself, just as long as you know + * about it. + * + * + * message_info/0 -> { Messages sent, + * Messages copied, + * Ego messages (sender = receiver), + * Words sent, + * Words copied, + * Words preallocated } + * + * Counting the words sent in a shared heap system will affect + * runtime performance since it means that we have to calculate the + * size of the mesage. With private heaps, this is done anyway and + * will not affect performance. + * + * + * message_info_clear/0 -> true + * + * Reset the message counters to zero. + * + * + * message_sizes/0 -> true + * + * Displays a text-mode bar diagram with message sizes. There are no + * guaranties that this is printed in a way the Erlang system is + * supposed to print things. + * + * + * gc_info/0 -> { Minor collections, + * Major collections, + * Used heap, + * Allocated heap, + * Max used heap, + * Max allocated heap } + * + * Information about private heap garbage collections. Number of + * minor and major collections, how much heap is used and allocated + * and how much heap has been in use and allocated at most since the + * counters were reset. + * + * + * shared_gc_info/0 -> { Minor collections of the shared heap, + * Major collections of the shared heap, + * Used shared heap, + * Allocated shared heap, + * Max used shared heap, + * Max allocated shared heap } + * + * The same as above, but for the shared heap / message area. Note, + * that in a shared heap system the max used heap and max allocated + * heap are mostly the same, since the heap allways is filled before + * a garbage collection, and most garbage collections do not enlarge + * the heap. The private heap numbers are much more interesting. + * + * + * incremental_gc_info/0 -> { Complete minor GC cycles, + * Complete major GC cycles, + * Minor GC stages, + * Major GC stages } + * + * + * gc_info_clear/0 -> true + * + * Reset counters for both private and shared garbage collection. + * + * + * BM Timers + * --------- + * + * All timers returns tuples of the kind: { Minutes, Seconds, Milliseconds } + * except for the max times in garbage collection where times are normally + * small. The tuple is therefor: { Seconds, Milliseconds, Microseconds } + * + * system_timer/0 -> Mutator time + * + * This timer is not a real-time clock, it only runs when a process + * is scheduled to run. You can not find out the accual time a + * program has taken to run using this timer. + * + * + * system_timer_clear/0 -> true + * + * Reset system timer to zero. + * + * + * send_timer/0 -> { Send time, + * Copy time, + * Size time } + * + * Time spent in sending messages. The copy time and size time are + * only active if the copying is needed in send. Copying of data + * into ETS-tables etc is not timed with this timer. + * + * + * send_timer_clear/0 -> true + * + * Reset send timers to zero. + * + * + * gc_timer/0 -> { Time in minor collection, + * Time in major collection, + * Max time in minor collection (µs), + * Max time in major collection (µs) } + * + * Total time spent in garbage collection of the private heaps. The + * max times are for one separate collection. + * + * + * shared_gc_timer/0 -> { Time in minor collection, + * Time in major collection, + * Max time in minor collection (µs), + * Max time in major collection (µs) } + * + * Total time spent in garbage collection of the shared heap / + * message area. The max times are for one separate collection. + * + * + * gc_timer_clear/0 -> true + * + * Reset private and shared garbage collection timers to zero. Note, + * that the max-times are also reset. + * + * + * misc_timer/0 -> { Misc 0, Misc 1, Misc 2 } + * + * Timers for debug purposes. In a normal system, these timers are + * never used. Add these timers at places where you want to time + * something not covered here. Use BM_SWAP_TIMER(from,to) to start + * one of the misc timers. + * + * ... code timed by the system timer ... + * BM_SWAP_TIMER(system,misc1); + * ... code we want to time ... + * BM_SWAP_TIMER(misc1,system); + * ... back on system time ... + * + * + * misc_timer_clear/0 -> true + * + * Reset misc timers to zero. + */ + +BIF_RETTYPE hipe_bifs_process_info_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ +#ifndef BM_COUNTERS + Uint processes_busy = 0; + Uint processes_spawned = 0; +#endif + Eterm *hp; + + hp = HAlloc(BIF_P, 3); + BIF_RET(TUPLE2(hp, + make_small(processes_busy), + make_small(processes_spawned))); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_process_info_clear_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ +#ifdef BM_COUNTERS + processes_spawned = 0; +#endif + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_message_info_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ + Eterm *hp; +#ifndef BM_COUNTERS + unsigned long messages_sent = 0; + unsigned long messages_copied = 0; + unsigned long messages_ego = 0; +#endif +#ifndef BM_MESSAGE_SIZES + unsigned long words_sent = 0; + unsigned long words_copied = 0; + unsigned long words_prealloc = 0; +#endif + + hp = HAlloc(BIF_P, 7); + BIF_RET(TUPLE6(hp, + make_small(messages_sent), + make_small(messages_copied), + make_small(messages_ego), + make_small(words_sent), + make_small(words_copied), + make_small(words_prealloc))); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_message_info_clear_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ +#ifdef BM_COUNTERS + messages_sent = 0; + messages_copied = 0; + messages_ego = 0; +#endif +#ifdef BM_MESSAGE_SIZES + words_sent = 0; + words_copied = 0; + words_prealloc = 0; + { + int i; + for (i = 0; i < 1000; i++) + message_sizes[i] = 0; + } +#endif + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_message_sizes_0(BIF_ALIST_0) +{ +#ifdef BM_MESSAGE_SIZES + int i, j, max = 0; + int tmp[12] = {0,0,0,0,0,0,0,0,0,0,0,0}; + + for (i = 0; i < 65; i++) { + tmp[0] += message_sizes[i]; + if (tmp[0] > max) + max = tmp[0]; + } + for (i = 65; i < 999; i++) { + tmp[i / 100 + 1] += message_sizes[i]; + if (tmp[i / 100 + 1] > max) + max = tmp[i / 100 + 1]; + } + tmp[11] = message_sizes[999]; + if (tmp[11] > max) + max = tmp[11]; + for (i = -1; i < 11; i++) { + int num = (tmp[i + 1] * 50) / max; + if (i == -1) + printf("\n\r 0 - 64: (%6d) |", tmp[0]); + else if (i == 0) + printf("\n\r 65 - 99: (%6d) |", tmp[1]); + else if (i == 10) + printf("\n\r >= 1000: (%6d) |", tmp[11]); + else + printf("\n\r%3d - %3d: (%6d) |", i * 100, i * 100 + 99, + tmp[i + 1]); + + for (j = 0; j < num; j++) + printf("."); + } + printf("\n\r"); + + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_gc_info_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ +#ifndef BM_COUNTERS + Uint minor_gc = 0; + Uint major_gc = 0; +#endif +#ifndef BM_HEAP_SIZES + Uint max_used_heap = 0; + Uint max_allocated_heap = 0; +#endif + Eterm *hp; + Uint used_heap = (BIF_P->htop - BIF_P->heap) + + (OLD_HTOP(BIF_P) - OLD_HEAP(BIF_P)) + + MBUF_SIZE(BIF_P); + + Uint alloc_heap = (BIF_P->hend - BIF_P->heap) + + (OLD_HEND(BIF_P) - OLD_HEAP(BIF_P)) + + MBUF_SIZE(BIF_P); + + hp = HAlloc(BIF_P, 7); + BIF_RET(TUPLE6(hp, + make_small((Uint)minor_gc), + make_small((Uint)major_gc), + make_small((Uint)used_heap), + make_small((Uint)alloc_heap), + make_small(max_used_heap), + make_small(max_allocated_heap))); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_shared_gc_info_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ +#if !(defined(BM_COUNTERS) && defined(HYBRID)) + Uint minor_global_gc = 0; + Uint major_global_gc = 0; +#endif +#ifndef BM_HEAP_SIZES + Uint max_used_global_heap = 0; + Uint max_allocated_global_heap = 0; +#endif + Eterm *hp; + +#if defined(HYBRID) + Uint tmp_used_heap = (Uint)((BIF_P->htop - BIF_P->heap) + + (OLD_HTOP(BIF_P) - OLD_HEAP(BIF_P)) + + MBUF_SIZE(BIF_P)); + Uint tmp_allocated_heap = (Uint)((BIF_P->hend - BIF_P->heap) + + (OLD_HEND(BIF_P) - OLD_HEAP(BIF_P)) + + MBUF_SIZE(BIF_P)); +#else + Uint tmp_used_heap = 0; + Uint tmp_allocated_heap = 0; +#endif + hp = HAlloc(BIF_P, 7); + BIF_RET(TUPLE6(hp, + make_small((uint)minor_global_gc), + make_small((uint)major_global_gc), + make_small(tmp_used_heap), + make_small(tmp_allocated_heap), + make_small(max_used_global_heap), + make_small(max_allocated_global_heap))); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_incremental_gc_info_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ +#if !(defined(BM_COUNTERS) && defined(INCREMENTAL)) + Uint minor_gc_cycles = 0; + Uint major_gc_cycles = 0; + Uint minor_gc_stages = 0; + Uint major_gc_stages = 0; +#endif + Eterm *hp; + + hp = HAlloc(BIF_P, 5); + BIF_RET(TUPLE4(hp, + make_small(minor_gc_cycles), + make_small(major_gc_cycles), + make_small(minor_gc_stages), + make_small(major_gc_stages))); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_gc_info_clear_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ + +#ifdef BM_COUNTERS + minor_gc = 0; + major_gc = 0; +#ifdef HYBRID + minor_global_gc = 0; + major_global_gc = 0; + gc_in_copy = 0; +#ifdef INCREMENTAL + minor_gc_cycles = 0; + major_gc_cycles = 0; + minor_gc_stages = 0; + major_gc_stages = 0; +#endif +#endif +#endif + +#ifdef BM_HEAP_SIZES + max_used_heap = 0; + max_allocated_heap = 0; + max_used_global_heap = 0; + max_allocated_global_heap = 0; +#endif + + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_pause_times_0(BIF_ALIST_0) +{ +#ifdef BM_TIMERS + int i; + int total_time = 0, n = 0; + int left = 0, right = 0, mid = 0; + + printf("Pause times in minor collection:\r\n"); + for (i = 0; i < MAX_PAUSE_TIME; i++) { + if (pause_times[i] > 0) { + printf("%d: %ld\r\n", i, pause_times[i]); + total_time += pause_times[i] * i; + n += pause_times[i]; + + if (i > mid) + right += pause_times[i]; + + while (right > left) { + left += pause_times[mid++]; + right -= pause_times[mid]; + } + } + } + + printf("Number of collections: %d\r\n", n); + printf("Total collection time: %d\r\n", total_time); + if (n > 0) + printf("Mean pause time: %d\r\n", total_time / n); + + printf("Geometrical mean: %d\r\n", mid); + + total_time = 0; n = 0; + left = 0; right = 0; mid = 0; + printf("Pause times in major collection:\r\n"); + for (i = 0; i < MAX_PAUSE_TIME; i++) { + if (pause_times_old[i] > 0) { + printf("%d: %ld\r\n", i, pause_times_old[i]); + total_time += pause_times_old[i] * i; + n += pause_times_old[i]; + } + } + + printf("Number of collections: %d\r\n", n); + printf("Total collection time: %d\r\n", total_time); + if (n > 0) + printf("Mean pause time: %d\r\n", total_time / n); + + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +/* XXX: these macros have free variables */ +#ifdef BM_TIMERS +#if USE_PERFCTR +#define MAKE_TIME(_timer_) { \ + BM_TIMER_T tmp = _timer_##_time; \ + milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ + tmp /= 1000; \ + sec = (uint)(tmp - ((int)(tmp / 60)) * 60); \ + min = (uint)tmp / 60; } + +#define MAKE_MICRO_TIME(_timer_) { \ + BM_TIMER_T tmp = _timer_##_time * 1000; \ + micro = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ + tmp /= 1000; \ + milli = (uint)(tmp - ((int)(tmp / 1000)) * 1000); \ + sec = (uint)tmp / 1000; } + +#else +#define MAKE_TIME(_timer_) { \ + BM_TIMER_T tmp = _timer_##_time / 1000000; \ + milli = tmp % 1000; \ + tmp /= 1000; \ + sec = tmp % 60; \ + min = tmp / 60; } + +#define MAKE_MICRO_TIME(_timer_) { \ + BM_TIMER_T tmp = _timer_##_time / 1000; \ + micro = tmp % 1000; \ + tmp /= 1000; \ + milli = tmp % 1000; \ + sec = tmp / 1000; } + +#endif +#else +#define MAKE_TIME(_timer_) +#define MAKE_MICRO_TIME(_timer_) +#endif + +BIF_RETTYPE hipe_bifs_system_timer_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ + uint min = 0; + uint sec = 0; + uint milli = 0; + Eterm *hp; + + hp = HAlloc(BIF_P, 4); + MAKE_TIME(system); + BIF_RET(TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli))); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_system_timer_clear_0(BIF_ALIST_0) +{ +#ifdef BM_TIMERS + system_time = 0; + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_send_timer_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ + uint min = 0; + uint sec = 0; + uint milli = 0; + Eterm *hp; + Eterm sendtime, copytime, sizetime; + + hp = HAlloc(BIF_P, 4 * 4); + + MAKE_TIME(send); + sendtime = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + + MAKE_TIME(copy); + copytime = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + + MAKE_TIME(size); + sizetime = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + BIF_RET(TUPLE3(hp, sendtime, copytime, sizetime)); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_send_timer_clear_0(BIF_ALIST_0) +{ +#ifdef BM_TIMERS + send_time = 0; + copy_time = 0; + size_time = 0; + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_gc_timer_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ + Eterm *hp; + uint min = 0; + uint sec = 0; + uint milli = 0; + uint micro = 0; + Eterm minor, major, max_min, max_maj; + + hp = HAlloc(BIF_P, 4 * 4 + 5); + + MAKE_TIME(minor_gc); + minor = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + + MAKE_TIME(major_gc); + major = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + + MAKE_MICRO_TIME(max_minor); + max_min = TUPLE3(hp, + make_small(sec), + make_small(milli), + make_small(micro)); + hp += 4; + + MAKE_MICRO_TIME(max_major); + max_maj = TUPLE3(hp, + make_small(sec), + make_small(milli), + make_small(micro)); + hp += 4; + + BIF_RET(TUPLE4(hp, minor, major, max_min, max_maj)); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_shared_gc_timer_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ + Eterm *hp; + uint min = 0; + uint sec = 0; + uint milli = 0; + uint micro = 0; + Eterm minor, major, max_min, max_maj; + + hp = HAlloc(BIF_P, 4 * 4 + 5); + + MAKE_TIME(minor_global_gc); + minor = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + + MAKE_TIME(major_global_gc); + major = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + + MAKE_MICRO_TIME(max_global_minor); + max_min = TUPLE3(hp, + make_small(sec), + make_small(milli), + make_small(micro)); + hp += 4; + + MAKE_MICRO_TIME(max_global_major); + max_maj = TUPLE3(hp, + make_small(sec), + make_small(milli), + make_small(micro)); + hp += 4; + + BIF_RET(TUPLE4(hp, minor, major, max_min, max_maj)); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_gc_timer_clear_0(BIF_ALIST_0) +{ +#ifdef BM_TIMERS + minor_gc_time = 0; + major_gc_time = 0; + max_minor_time = 0; + max_major_time = 0; + minor_global_gc_time = 0; + major_global_gc_time = 0; + max_global_minor_time = 0; + max_global_major_time = 0; + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_misc_timer_0(BIF_ALIST_0) +{ +#ifdef __BENCHMARK__ + uint min = 0; + uint sec = 0; + uint milli = 0; + Eterm *hp; + Eterm misctime1, misctime2, misctime3; + + hp = HAlloc(BIF_P, 4 * 4); + + MAKE_TIME(misc0); + misctime1 = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + + MAKE_TIME(misc1); + misctime2 = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + + MAKE_TIME(misc2); + misctime3 = TUPLE3(hp, + make_small(min), + make_small(sec), + make_small(milli)); + hp += 4; + BIF_RET(TUPLE3(hp, misctime1, misctime2, misctime3)); +#else + BIF_RET(am_false); +#endif +} + +BIF_RETTYPE hipe_bifs_misc_timer_clear_0(BIF_ALIST_0) +{ +#ifdef BM_TIMERS + misc0_time = 0; + misc1_time = 0; + misc2_time = 0; + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} + +#undef MAKE_TIME +#undef MAKE_MICRO_TIME + +/* + * HiPE hrvtime(). + * These implementations are currently available: + * + On Linux with the perfctr extension we can use the process' + * virtualised time-stamp counter. To enable this mode you must + * pass `--with-perfctr=/path/to/perfctr' when configuring. + * + The fallback, which is the same as {X,_} = runtime(statistics). + */ + +#if USE_PERFCTR + +#include "hipe_perfctr.h" +static int hrvtime_is_open; +#define hrvtime_is_started() hrvtime_is_open + +static void start_hrvtime(void) +{ + if (hipe_perfctr_hrvtime_open() >= 0) + hrvtime_is_open = 1; +} + +#define get_hrvtime() hipe_perfctr_hrvtime_get() +#define stop_hrvtime() hipe_perfctr_hrvtime_close() + +#else + +/* + * Fallback, if nothing better exists. + * This is the same as {X,_} = statistics(runtime), which uses + * times(2) on Unix systems. + */ + +#define hrvtime_is_started() 1 +#define start_hrvtime() do{}while(0) +#define stop_hrvtime() do{}while(0) + +static double get_hrvtime(void) +{ + unsigned long ms_user; + elapsed_time_both(&ms_user, NULL, NULL, NULL); + return (double)ms_user; +} + +#endif /* hrvtime support */ + +BIF_RETTYPE hipe_bifs_get_hrvtime_0(BIF_ALIST_0) +{ + Eterm *hp; + Eterm res; + FloatDef f; + + if (!hrvtime_is_started()) { + start_hrvtime(); + if (!hrvtime_is_started()) + BIF_RET(NIL); /* arity 0 BIFs may not fail */ + } + f.fd = get_hrvtime(); + hp = HAlloc(BIF_P, FLOAT_SIZE_OBJECT); + res = make_float(hp); + PUT_DOUBLE(f, hp); + BIF_RET(res); +} + +BIF_RETTYPE hipe_bifs_stop_hrvtime_0(BIF_ALIST_0) +{ + stop_hrvtime(); + BIF_RET(am_true); +} diff --git a/erts/emulator/hipe/hipe_bif1.h b/erts/emulator/hipe/hipe_bif1.h new file mode 100644 index 0000000000..c3b607565d --- /dev/null +++ b/erts/emulator/hipe/hipe_bif1.h @@ -0,0 +1,34 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_bif1.h + * + * Performance analysis support. + */ +#ifndef HIPE_BIF1_H +#define HIPE_BIF1_H + +struct hipe_call_count { + unsigned count; + Uint opcode; +}; + +extern unsigned int hipe_trap_count; + +#endif /* HIPE_BIF1_H */ diff --git a/erts/emulator/hipe/hipe_bif1.tab b/erts/emulator/hipe/hipe_bif1.tab new file mode 100644 index 0000000000..eb445d56f7 --- /dev/null +++ b/erts/emulator/hipe/hipe_bif1.tab @@ -0,0 +1,49 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# HiPE level 1 bifs: performance analysis support +# +# bif hipe_bifs:name/arity + +bif hipe_bifs:call_count_on/1 +bif hipe_bifs:call_count_off/1 +bif hipe_bifs:call_count_get/1 +bif hipe_bifs:call_count_clear/1 +bif hipe_bifs:trap_count_get/0 +bif hipe_bifs:trap_count_clear/0 +bif hipe_bifs:process_info/0 +bif hipe_bifs:process_info_clear/0 +bif hipe_bifs:message_info/0 +bif hipe_bifs:message_info_clear/0 +bif hipe_bifs:message_sizes/0 +bif hipe_bifs:gc_info/0 +bif hipe_bifs:shared_gc_info/0 +bif hipe_bifs:incremental_gc_info/0 +bif hipe_bifs:gc_info_clear/0 +bif hipe_bifs:pause_times/0 +bif hipe_bifs:system_timer/0 +bif hipe_bifs:system_timer_clear/0 +bif hipe_bifs:send_timer/0 +bif hipe_bifs:send_timer_clear/0 +bif hipe_bifs:gc_timer/0 +bif hipe_bifs:shared_gc_timer/0 +bif hipe_bifs:gc_timer_clear/0 +bif hipe_bifs:misc_timer/0 +bif hipe_bifs:misc_timer_clear/0 +bif hipe_bifs:get_hrvtime/0 +bif hipe_bifs:stop_hrvtime/0 diff --git a/erts/emulator/hipe/hipe_bif2.c b/erts/emulator/hipe/hipe_bif2.c new file mode 100644 index 0000000000..f992b758be --- /dev/null +++ b/erts/emulator/hipe/hipe_bif2.c @@ -0,0 +1,170 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_bif2.c + * + * Miscellaneous add-ons. + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "sys.h" +#include "error.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "bif.h" +#include "big.h" +#include "hipe_debug.h" +#include "hipe_mode_switch.h" +#include "hipe_bif0.h" /* hipe_constants_{start,next} */ +#include "hipe_arch.h" +#include "hipe_stack.h" + +BIF_RETTYPE hipe_bifs_show_estack_1(BIF_ALIST_1) +{ + Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCKS_ALL); + if (!rp) + BIF_ERROR(BIF_P, BADARG); + hipe_print_estack(rp); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_ALL); + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_show_heap_1(BIF_ALIST_1) +{ + Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCKS_ALL); + if (!rp) + BIF_ERROR(BIF_P, BADARG); + hipe_print_heap(rp); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_ALL); + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_show_nstack_1(BIF_ALIST_1) +{ + Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCKS_ALL); + if (!rp) + BIF_ERROR(BIF_P, BADARG); + hipe_print_nstack(rp); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_ALL); + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_nstack_used_size_0(BIF_ALIST_0) +{ + BIF_RET(make_small(hipe_nstack_used(BIF_P))); +} + +BIF_RETTYPE hipe_bifs_show_pcb_1(BIF_ALIST_1) +{ + Process *rp = erts_pid2proc(BIF_P, ERTS_PROC_LOCK_MAIN, + BIF_ARG_1, ERTS_PROC_LOCKS_ALL); + if (!rp) + BIF_ERROR(BIF_P, BADARG); + hipe_print_pcb(rp); + erts_smp_proc_unlock(rp, ERTS_PROC_LOCKS_ALL); + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_show_term_1(BIF_ALIST_1) +{ + Eterm obj = BIF_ARG_1; + + printf("0x%0*lx\r\n", 2*(int)sizeof(long), obj); + do { + Eterm *objp; + int i, ary; + + if (is_list(obj)) { + objp = list_val(obj); + ary = 2; + } else if (is_boxed(obj)) { + Eterm header; + + objp = boxed_val(obj); + header = objp[0]; + if (is_thing(header)) + ary = thing_arityval(header); + else if (is_arity_value(header)) + ary = arityval(header); + else { + printf("bad header %#lx\r\n", header); + break; + } + ary += 1; + } else + break; + for (i = 0; i < ary; ++i) + printf("0x%0*lx: 0x%0*lx\r\n", + 2*(int)sizeof(long), (unsigned long)&objp[i], + 2*(int)sizeof(long), objp[i]); + } while (0); + erts_printf("%T", obj); + printf("\r\n"); + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_show_literals_0(BIF_ALIST_0) +{ + Eterm *p; + + p = hipe_constants_start; + for (; p < hipe_constants_next; ++p) + printf("0x%0*lx: 0x%0*lx\r\n", + 2*(int)sizeof(long), (unsigned long)p, + 2*(int)sizeof(long), *p); + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_in_native_0(BIF_ALIST_0) +{ + BIF_RET(am_false); +} + +BIF_RETTYPE hipe_bifs_modeswitch_debug_on_0(BIF_ALIST_0) +{ + hipe_modeswitch_debug = 1; + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_modeswitch_debug_off_0(BIF_ALIST_0) +{ + hipe_modeswitch_debug = 0; + BIF_RET(am_true); +} + +/* BIFs for handling the message area */ + +BIF_RETTYPE hipe_bifs_show_message_area_0(BIF_ALIST_0) +{ +#ifdef HYBRID +#ifdef DEBUG + print_message_area(); +#else + printf("Only available in debug compiled emulator\r\n"); +#endif + BIF_RET(am_true); +#else + BIF_RET(am_false); +#endif +} diff --git a/erts/emulator/hipe/hipe_bif2.tab b/erts/emulator/hipe/hipe_bif2.tab new file mode 100644 index 0000000000..d8d627e370 --- /dev/null +++ b/erts/emulator/hipe/hipe_bif2.tab @@ -0,0 +1,33 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# HiPE level 2 bifs: miscellaneous add-ons +# +# bif hipe_bifs:name/arity + +bif hipe_bifs:show_estack/1 +bif hipe_bifs:show_heap/1 +bif hipe_bifs:show_nstack/1 +bif hipe_bifs:nstack_used_size/0 +bif hipe_bifs:show_pcb/1 +bif hipe_bifs:show_term/1 +bif hipe_bifs:show_literals/0 +bif hipe_bifs:in_native/0 +bif hipe_bifs:modeswitch_debug_on/0 +bif hipe_bifs:modeswitch_debug_off/0 +bif hipe_bifs:show_message_area/0 diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 new file mode 100644 index 0000000000..c92d94ed9d --- /dev/null +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -0,0 +1,280 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * + * List all non architecture-specific BIFs and primops, and + * classify each as belonging to one of the classes below. + * This list is included in hipe_${ARCH}_bifs.m4, which is + * responsible for translating these classifications to the + * best possible native code wrappers. + * + * XXX: We should have a more detailed BIF classification + * with a number of orthogonal properties (e.g., UPDATES_HP, + * NEEDS_NSP, CAN_FAIL, CAN_GC, etc), from which we should + * generate appropriate interfaces. + * + * The classification is expressed in terms of the resources + * and BIF failure modes described below. + * + * Resources: + * - NSP: native stack pointer + * NSP is read by GC BIFs and primops, and hipe_handle_exception(). + * NSP is updated at compiler-inserted calls to hipe_inc_nstack(). + * No other BIF or primop may access NSP. + * - NSP_LIMIT: native stack limit + * NSP_LIMIT is only updated at compiler-inserted calls to inc_stack. + * Everywhere else, the cached value equals the value stored in P. + * - NRA: native return address + * NRA is read by GC BIFs and primops, and hipe_handle_exception(). + * No BIF or primop may update NRA. + * - HP: heap pointer + * All BIFs can read and update HP. + * Primops with access to P that do not access HP are called "nocons". + * - HP_LIMIT: heap limit + * HP_LIMIT is only updated by GC BIFs and primops. + * Everywhere else, the cached value equals the value stored in P. + * - FCALLS: reduction counter + * All BIFs can read and update FCALLS (because BEAM abuses FCALLS + * to trigger GCs). XXX: can we avoid that overhead? + * All nocons primops do not access FCALLS. + * All other primops with access to P can read and update FCALLS. + * - P: pointer to the state record for the process + * + * BIF failure modes: + * - none: may not signal any exception + * The BIF wrapper needs no checks before returning. + * - standard: may signal any exception + * The BIF wrapper must check for an exception before returning. + * Zero-arity BIFs signal no exceptions, except in a small number + * of cases explicitly enumerated here. + */ + +/**************************************************************** + * BIF CLASS DESCRIPTIONS * + ****************************************************************/ + +/* + * standard_bif_interface_1(nbif_name, cbif_name) + * standard_bif_interface_2(nbif_name, cbif_name) + * standard_bif_interface_3(nbif_name, cbif_name) + * + * A BIF with implicit P parameter, 1-3 ordinary parameters, + * which may fail. + * HP and FCALLS may be read and updated. + * HP_LIMIT, NSP, NSP_LIMIT, and NRA may not be accessed. + */ + +/* + * fail_bif_interface_0(nbif_name, cbif_name) + * + * A zero-arity BIF which may fail, otherwise + * identical to standard_bif_interface_N. + */ + +/* + * nofail_primop_interface_0(nbif_name, cbif_name) + * nofail_primop_interface_1(nbif_name, cbif_name) + * nofail_primop_interface_2(nbif_name, cbif_name) + * nofail_primop_interface_3(nbif_name, cbif_name) + * + * A primop or guard BIF with no failure mode, otherwise + * identical to standard_bif_interface_N. + */ + +/* + * gc_bif_interface_0(nbif_name, cbif_name) + * gc_bif_interface_1(nbif_name, cbif_name) + * gc_bif_interface_2(nbif_name, cbif_name) + * + * A BIF which may do a GC or walk the native stack. + * May read NSP, NSP_LIMIT, NRA, HP, HP_LIMIT, and FCALLS. + * May update HP, HP_LIMIT, and FCALLS. + * May not update NSP, NSP_LIMIT, or NRA. + * Otherwise identical to standard_bif_interface_N. + */ + +/* + * gc_nofail_primop_interface_1(nbif_name, cbif_name) + * + * A primop with implicit P parameter, 1 ordinary parameter, + * and no failure mode. + * May read NSP, NSP_LIMIT, NRA, HP, HP_LIMIT, and FCALLS. + * May update HP, HP_LIMIT, and FCALLS. + * May not update NSP, NSP_LIMIT, or NRA. + */ + +/* + * nocons_nofail_primop_interface_0(nbif_name, cbif_name) + * nocons_nofail_primop_interface_1(nbif_name, cbif_name) + * nocons_nofail_primop_interface_2(nbif_name, cbif_name) + * nocons_nofail_primop_interface_3(nbif_name, cbif_name) + * nocons_nofail_primop_interface_5(nbif_name, cbif_name) + * + * A primop with implicit P parameter, 0-3 or 5 ordinary parameters, + * and no failure mode. + * HP, HP_LIMIT, FCALLS, NSP, NSP_LIMIT, and NRA may not be accessed. + */ + +/* + * noproc_primop_interface_0(nbif_name, cbif_name) + * noproc_primop_interface_1(nbif_name, cbif_name) + * noproc_primop_interface_2(nbif_name, cbif_name) + * noproc_primop_interface_3(nbif_name, cbif_name) + * noproc_primop_interface_5(nbif_name, cbif_name) + * + * A primop with no P parameter, 0-3 or 5 ordinary parameters, + * and no failure mode. + * HP, HP_LIMIT, FCALLS, NSP, NSP_LIMIT, and NRA may not be accessed. + */ + +/**************************************************************** + * BIF CLASSIFICATION * + ****************************************************************/ + +/* + * Zero-arity BIFs that can fail. + */ +fail_bif_interface_0(nbif_memory_0, memory_0) +fail_bif_interface_0(nbif_processes_0, processes_0) + +/* + * BIFs and primops that may do a GC (change heap limit and walk the native stack). + * XXX: erase/1 and put/2 cannot fail + */ +gc_bif_interface_2(nbif_check_process_code_2, hipe_check_process_code_2) +gc_bif_interface_1(nbif_erase_1, erase_1) +gc_bif_interface_0(nbif_garbage_collect_0, garbage_collect_0) +gc_bif_interface_1(nbif_garbage_collect_1, hipe_garbage_collect_1) +gc_nofail_primop_interface_1(nbif_gc_1, hipe_gc) +gc_bif_interface_2(nbif_put_2, put_2) + +/* + * Debug BIFs that need read access to the full state. + * hipe_bifs:nstack_used_size/0 only needs read access to NSP. + * They are classified as GC BIFs for simplicity. + */ +gc_bif_interface_1(nbif_hipe_bifs_show_nstack_1, hipe_show_nstack_1) +gc_bif_interface_1(nbif_hipe_bifs_show_pcb_1, hipe_bifs_show_pcb_1) +gc_bif_interface_0(nbif_hipe_bifs_nstack_used_size_0, hipe_bifs_nstack_used_size_0) + +/* + * Arithmetic operators called indirectly by the HiPE compiler. + */ +standard_bif_interface_2(nbif_add_2, erts_mixed_plus) +standard_bif_interface_2(nbif_sub_2, erts_mixed_minus) +standard_bif_interface_2(nbif_mul_2, erts_mixed_times) +standard_bif_interface_2(nbif_div_2, erts_mixed_div) +standard_bif_interface_2(nbif_intdiv_2, intdiv_2) +standard_bif_interface_2(nbif_rem_2, rem_2) +standard_bif_interface_2(nbif_bsl_2, bsl_2) +standard_bif_interface_2(nbif_bsr_2, bsr_2) +standard_bif_interface_2(nbif_band_2, band_2) +standard_bif_interface_2(nbif_bor_2, bor_2) +standard_bif_interface_2(nbif_bxor_2, bxor_2) +standard_bif_interface_1(nbif_bnot_1, bnot_1) + +/* + * Miscellaneous primops. + */ +standard_bif_interface_1(nbif_set_timeout, hipe_set_timeout) +standard_bif_interface_1(nbif_conv_big_to_float, hipe_conv_big_to_float) +standard_bif_interface_2(nbif_rethrow, hipe_rethrow) +standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub) +standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address) +nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error) + +/* + * Mbox primops with implicit P parameter. + */ +nocons_nofail_primop_interface_0(nbif_select_msg, hipe_select_msg) + +/* + * Primops without any P parameter. + * These cannot CONS or gc. + */ +noproc_primop_interface_2(nbif_cmp_2, cmp) +noproc_primop_interface_2(nbif_eq_2, eq) + +/* + * Bit-syntax primops with implicit P parameter. + * XXX: all of the _2 versions cons on the ordinary heap + * XXX: all of them can cons and thus update FCALLS + */ +nofail_primop_interface_3(nbif_bs_get_integer_2, erts_bs_get_integer_2) +nofail_primop_interface_3(nbif_bs_get_binary_2, erts_bs_get_binary_2) +nofail_primop_interface_3(nbif_bs_get_float_2, erts_bs_get_float_2) +standard_bif_interface_3(nbif_bs_put_utf8, hipe_bs_put_utf8) +standard_bif_interface_3(nbif_bs_put_utf16be, hipe_bs_put_utf16be) +standard_bif_interface_3(nbif_bs_put_utf16le, hipe_bs_put_utf16le) +standard_bif_interface_1(nbif_bs_validate_unicode, hipe_bs_validate_unicode) + +/* + * Bit-syntax primops without any P parameter. + * These cannot CONS or gc. + */ +noproc_primop_interface_1(nbif_bs_allocate, hipe_bs_allocate) +noproc_primop_interface_2(nbif_bs_reallocate, hipe_bs_reallocate) +noproc_primop_interface_1(nbif_bs_utf8_size, hipe_bs_utf8_size) +noproc_primop_interface_1(nbif_bs_get_utf8, erts_bs_get_utf8) +noproc_primop_interface_1(nbif_bs_utf16_size, hipe_bs_utf16_size) +noproc_primop_interface_2(nbif_bs_get_utf16, erts_bs_get_utf16) +noproc_primop_interface_2(nbif_bs_validate_unicode_retract, hipe_bs_validate_unicode_retract) + +/* + * Bit-syntax primops. The ERTS_SMP runtime system requires P, + * hence the use of nocons_nofail_primop_interface_N(). + * When ERTS_SMP is disabled, noproc_primop_interface_N() + * should be used instead. + */ +nocons_nofail_primop_interface_5(nbif_bs_put_small_float, hipe_bs_put_small_float) +noproc_primop_interface_5(nbif_bs_put_bits, hipe_bs_put_bits) +ifelse(ERTS_SMP,1,` +nocons_nofail_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_integer) +',` +noproc_primop_interface_5(nbif_bs_put_big_integer, hipe_bs_put_big_integer) +')dnl + +gc_bif_interface_0(nbif_check_get_msg, hipe_check_get_msg) + +/* + * SMP-specific stuff + */ +ifelse(ERTS_SMP,1,` +nocons_nofail_primop_interface_0(nbif_clear_timeout, hipe_clear_timeout) +noproc_primop_interface_1(nbif_atomic_inc, hipe_atomic_inc) +',)dnl + +/* + * Implement standard_bif_interface_0 as nofail_primop_interface_0. + */ +define(standard_bif_interface_0,`nofail_primop_interface_0($1, $2)') + +/* + * Standard BIFs. + * BIF_LIST(ModuleAtom,FunctionAtom,Arity,CFun,Index) + */ +define(BIF_LIST,`standard_bif_interface_$3(nbif_$4, $4)') +include(TARGET/`erl_bif_list.h') + +/* + * Guard BIFs. + * GBIF_LIST(FunctionAtom,Arity,CFun) + */ +define(GBIF_LIST,`nofail_primop_interface_$2(gbif_$3, $3)') +include(`hipe/hipe_gbif_list.h') diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c new file mode 100644 index 0000000000..548998b7b7 --- /dev/null +++ b/erts/emulator/hipe/hipe_debug.c @@ -0,0 +1,242 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_debug.c + * + * TODO: + * - detect mode-switch native return addresses (ARCH-specific) + * - map user-code native return addresses to symbolic names + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include /* offsetof() */ +#include +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "beam_catches.h" +#include "beam_load.h" +#include "hipe_mode_switch.h" +#include "hipe_debug.h" + +static const char dashes[2*sizeof(long)+5] = { + [0 ... 2*sizeof(long)+3] = '-' +}; + +static const char dots[2*sizeof(long)+5] = { + [0 ... 2*sizeof(long)+3] = '.' +}; + +static const char stars[2*sizeof(long)+5] = { + [0 ... 2*sizeof(long)+3] = '*' +}; + +extern Uint beam_apply[]; + +static void print_beam_pc(Uint *pc) +{ + if (pc == hipe_beam_pc_return) { + printf("return-to-native"); + } else if (pc == hipe_beam_pc_throw) { + printf("throw-to-native"); + } else if (pc == &beam_apply[1]) { + printf("normal-process-exit"); + } else { + Eterm *mfa = find_function_from_pc(pc); + if (mfa) + erts_printf("%T:%T/%bpu + 0x%bpx", + mfa[0], mfa[1], mfa[2], pc - &mfa[3]); + else + printf("?"); + } +} + +static void catch_slot(Eterm *pos, Eterm val) +{ + Uint *pc = catch_pc(val); + printf(" | 0x%0*lx | 0x%0*lx | CATCH 0x%0*lx (BEAM ", + 2*(int)sizeof(long), (unsigned long)pos, + 2*(int)sizeof(long), (unsigned long)val, + 2*(int)sizeof(long), (unsigned long)pc); + print_beam_pc(pc); + printf(")\r\n"); +} + +static void print_beam_cp(Eterm *pos, Eterm val) +{ + printf(" |%s|%s| BEAM ACTIVATION RECORD\r\n", dashes, dashes); + printf(" | 0x%0*lx | 0x%0*lx | BEAM PC ", + 2*(int)sizeof(long), (unsigned long)pos, + 2*(int)sizeof(long), (unsigned long)val); + print_beam_pc(cp_val(val)); + printf("\r\n"); +} + +static void print_catch(Eterm *pos, Eterm val) +{ + printf(" |%s|%s| BEAM CATCH FRAME\r\n", dots, dots); + catch_slot(pos, val); + printf(" |%s|%s|\r\n", stars, stars); +} + +static void print_stack(Eterm *sp, Eterm *end) +{ + printf(" | %*s | %*s |\r\n", + 2+2*(int)sizeof(long), "Address", + 2+2*(int)sizeof(long), "Contents"); + while (sp < end) { + Eterm val = sp[0]; + if (is_CP(val)) + print_beam_cp(sp, val); + else if (is_catch(val)) + print_catch(sp, val); + else { + printf(" | 0x%0*lx | 0x%0*lx | ", + 2*(int)sizeof(long), (unsigned long)sp, + 2*(int)sizeof(long), (unsigned long)val); + erts_printf("%.30T", val); + printf("\r\n"); + } + sp += 1; + } + printf(" |%s|%s|\r\n", dashes, dashes); +} + +void hipe_print_estack(Process *p) +{ + printf(" | BEAM STACK |\r\n"); + print_stack(p->stop, STACK_START(p)); +} + +static void print_heap(Eterm *pos, Eterm *end) +{ + printf("From: 0x%0*lx to 0x%0*lx\n\r", + 2*(int)sizeof(long), (unsigned long)pos, + 2*(int)sizeof(long), (unsigned long)end); + printf(" | H E A P |\r\n"); + printf(" | %*s | %*s |\r\n", + 2+2*(int)sizeof(long), "Address", + 2+2*(int)sizeof(long), "Contents"); + printf(" |%s|%s|\r\n", dashes, dashes); + while (pos < end) { + Eterm val = pos[0]; + printf(" | 0x%0*lx | 0x%0*lx | ", + 2*(int)sizeof(long), (unsigned long)pos, + 2*(int)sizeof(long), (unsigned long)val); + ++pos; + if (is_arity_value(val)) + printf("Arity(%lu)", arityval(val)); + else if (is_thing(val)) { + unsigned int ari = thing_arityval(val); + printf("Thing Arity(%u) Tag(%lu)", ari, thing_subtag(val)); + while (ari) { + printf("\r\n | 0x%0*lx | 0x%0*lx | THING", + 2*(int)sizeof(long), (unsigned long)pos, + 2*(int)sizeof(long), (unsigned long)*pos); + ++pos; + --ari; + } + } else + erts_printf("%.30T", val); + printf("\r\n"); + } + printf(" |%s|%s|\r\n", dashes, dashes); +} + +void hipe_print_heap(Process *p) +{ + print_heap(p->heap, p->htop); +} + +void hipe_print_pcb(Process *p) +{ + printf("P: 0x%0*lx\r\n", 2*(int)sizeof(long), (unsigned long)p); + printf("-----------------------------------------------\r\n"); + printf("Offset| Name | Value | *Value |\r\n"); +#define U(n,x) \ + printf(" % 4d | %s | 0x%0*lx | |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x) +#define P(n,x) \ + printf(" % 4d | %s | 0x%0*lx | 0x%0*lx |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2*(int)sizeof(long), p->x ? (unsigned long)*(p->x) : -1UL) + + U("htop ", htop); + U("hend ", hend); + U("heap ", heap); + U("heap_sz ", heap_sz); + U("stop ", stop); + U("gen_gcs ", gen_gcs); + U("max_gen_gcs", max_gen_gcs); + U("high_water ", high_water); + U("old_hend ", old_hend); + U("old_htop ", old_htop); + U("old_head ", old_heap); + U("min_heap_..", min_heap_size); + U("status ", status); + U("rstatus ", rstatus); + U("rcount ", rcount); + U("id ", id); + U("prio ", prio); + U("reds ", reds); + U("tracer_pr..", tracer_proc); + U("trace_fla..", trace_flags); + U("group_lea..", group_leader); + U("flags ", flags); + U("fvalue ", fvalue); + U("freason ", freason); + U("fcalls ", fcalls); + /*XXX: ErlTimer tm; */ + U("next ", next); + /*XXX: ErlOffHeap off_heap; */ + U("reg ", reg); + U("nlinks ", nlinks); + /*XXX: ErlMessageQueue msg; */ + U("mbuf ", mbuf); + U("mbuf_sz ", mbuf_sz); + U("dictionary ", dictionary); + U("seq..clock ", seq_trace_clock); + U("seq..astcnt", seq_trace_lastcnt); + U("seq..token ", seq_trace_token); + U("intial[0] ", initial[0]); + U("intial[1] ", initial[1]); + U("intial[2] ", initial[2]); + P("current ", current); + P("cp ", cp); + P("i ", i); + U("catches ", catches); + U("arity ", arity); + P("arg_reg ", arg_reg); + U("max_arg_reg", max_arg_reg); + U("def..reg[0]", def_arg_reg[0]); + U("def..reg[1]", def_arg_reg[1]); + U("def..reg[2]", def_arg_reg[2]); + U("def..reg[3]", def_arg_reg[3]); + U("def..reg[4]", def_arg_reg[4]); + U("def..reg[5]", def_arg_reg[5]); +#ifdef HIPE + U("nsp ", hipe.nsp); + U("nstack ", hipe.nstack); + U("nstend ", hipe.nstend); + U("ncallee ", hipe.ncallee); + hipe_arch_print_pcb(&p->hipe); +#endif /* HIPE */ +#undef U +#undef P + printf("-----------------------------------------------\r\n"); +} diff --git a/erts/emulator/hipe/hipe_debug.h b/erts/emulator/hipe/hipe_debug.h new file mode 100644 index 0000000000..3980bc8230 --- /dev/null +++ b/erts/emulator/hipe/hipe_debug.h @@ -0,0 +1,29 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_debug.h + */ +#ifndef HIPE_DEBUG_H +#define HIPE_DEBUG_H + +extern void hipe_print_estack(Process *p); +extern void hipe_print_heap(Process *p); +extern void hipe_print_pcb(Process *p); + +#endif /* HIPE_DEBUG_H */ diff --git a/erts/emulator/hipe/hipe_gbif_list.h b/erts/emulator/hipe/hipe_gbif_list.h new file mode 100644 index 0000000000..659f74b5e5 --- /dev/null +++ b/erts/emulator/hipe/hipe_gbif_list.h @@ -0,0 +1,23 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * GBIF_LIST(FunctionAtom,Arity,CFun) + * manually maintained for now -- expand when necessary + */ +GBIF_LIST(am_node,1,node_1) diff --git a/erts/emulator/hipe/hipe_gc.c b/erts/emulator/hipe/hipe_gc.c new file mode 100644 index 0000000000..e57e293547 --- /dev/null +++ b/erts/emulator/hipe/hipe_gc.c @@ -0,0 +1,556 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * GC support procedures + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" + +#include "erl_gc.h" + +#include "hipe_stack.h" +#include "hipe_gc.h" +#include "hipe_bif0.h" /* for hipe_constants_{start,next} */ + +Eterm *fullsweep_nstack(Process *p, Eterm *n_htop) +{ + /* known nstack walk state */ + Eterm *nsp; + Eterm *nsp_end; + const struct sdesc *sdesc; + unsigned int sdesc_size; + unsigned long ra; + unsigned int i; + unsigned int mask; + /* arch-specific nstack walk state */ + struct nstack_walk_state walk_state; + + /* fullsweep-specific state */ + char *src, *oh; + Uint src_size, oh_size; + + if (!nstack_walk_init_check(p)) + return n_htop; + + nsp = nstack_walk_nsp_begin(p); + nsp_end = p->hipe.nstgraylim; + if (nsp_end) + nstack_walk_kill_trap(p, nsp_end); + nsp_end = nstack_walk_nsp_end(p); + + sdesc = nstack_walk_init_sdesc(p, &walk_state); + + src = (char*)HEAP_START(p); + src_size = (char*)HEAP_TOP(p) - src; + oh = (char*)OLD_HEAP(p); + oh_size = (char*)OLD_HTOP(p) - oh; + + for (;;) { + if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { + if (nsp == nsp_end) { + if (nsp) { + /* see the HIGH_WATER update in fullsweep_heap() */ + p->hipe.nstblacklim = nsp; /* nsp == nsp_end */ + nstack_walk_update_trap(p, walk_state.sdesc0); + } + return n_htop; + } + fprintf(stderr, "%s: passed end of stack\r\n", __FUNCTION__); + break; + } + sdesc_size = nstack_walk_frame_size(sdesc); + i = 0; + mask = sdesc->livebits[0]; + for (;;) { + if (mask & 1) { + Eterm *nsp_i = nstack_walk_frame_index(nsp, i); + Eterm gval = *nsp_i; + if (is_boxed(gval)) { + Eterm *ptr = boxed_val(gval); + Eterm val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *nsp_i = val; + } else if (in_area(ptr, src, src_size) || + in_area(ptr, oh, oh_size)) { + MOVE_BOXED(ptr, val, n_htop, nsp_i); + } + } else if (is_list(gval)) { + Eterm *ptr = list_val(gval); + Eterm val = *ptr; + if (is_non_value(val)) { + *nsp_i = ptr[1]; + } else if (in_area(ptr, src, src_size) || + in_area(ptr, oh, oh_size)) { + ASSERT(within(ptr, p)); + MOVE_CONS(ptr, val, n_htop, nsp_i); + } + } + } + if (++i >= sdesc_size) + break; + if (i & 31) + mask >>= 1; + else + mask = sdesc->livebits[i >> 5]; + } + ra = nstack_walk_frame_ra(nsp, sdesc); + sdesc = hipe_find_sdesc(ra); + nsp = nstack_walk_next_frame(nsp, sdesc_size); + } + abort(); +} + +void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) +{ + /* known nstack walk state */ + Eterm *nsp; + Eterm *nsp_end; + const struct sdesc *sdesc; + unsigned int sdesc_size; + unsigned long ra; + unsigned int i; + unsigned int mask; + /* arch-specific nstack walk state */ + struct nstack_walk_state walk_state; + + /* gensweep-specific state */ + Eterm *old_htop, *n_htop; + char *heap; + Uint heap_size, mature_size; + + if (!nstack_walk_init_check(p)) + return; + + nsp = nstack_walk_nsp_begin(p); + nsp_end = p->hipe.nstgraylim; + if (nsp_end) { + /* if gray limit passed black limit, reset black limit */ + if (nstack_walk_gray_passed_black(nsp_end, p->hipe.nstblacklim)) + p->hipe.nstblacklim = nsp_end; + nstack_walk_kill_trap(p, nsp_end); + nsp_end = p->hipe.nstblacklim; + } else + nsp_end = nstack_walk_nsp_end(p); + + sdesc = nstack_walk_init_sdesc(p, &walk_state); + + old_htop = *ptr_old_htop; + n_htop = *ptr_n_htop; + heap = (char*)HEAP_START(p); + heap_size = (char*)HEAP_TOP(p) - heap; + mature_size = (char*)HIGH_WATER(p) - heap; + + for (;;) { + if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { + if (nsp == nsp_end) { + *ptr_old_htop = old_htop; + *ptr_n_htop = n_htop; + if (nsp) { + /* see the HIGH_WATER update in gen_gc() */ + if (HEAP_START(p) != HIGH_WATER(p)) { + p->hipe.nstblacklim = + p->hipe.nstgraylim + ? p->hipe.nstgraylim + : nsp; /* nsp == nsp_end */ + } else { + /* blacklim = graylim ? blacklim : end */ + if (!p->hipe.nstgraylim) + p->hipe.nstblacklim = nsp; /* nsp == nsp_end */ + } + nstack_walk_update_trap(p, walk_state.sdesc0); + } + return; + } + fprintf(stderr, "%s: passed end of stack\r\n", __FUNCTION__); + break; + } + sdesc_size = nstack_walk_frame_size(sdesc); + i = 0; + mask = sdesc->livebits[0]; + for (;;) { + if (mask & 1) { + Eterm *nsp_i = nstack_walk_frame_index(nsp, i); + Eterm gval = *nsp_i; + if (is_boxed(gval)) { + Eterm *ptr = boxed_val(gval); + Eterm val = *ptr; + if (IS_MOVED(val)) { + ASSERT(is_boxed(val)); + *nsp_i = val; + } else if (in_area(ptr, heap, mature_size)) { + MOVE_BOXED(ptr, val, old_htop, nsp_i); + } else if (in_area(ptr, heap, heap_size)) { + ASSERT(within(ptr, p)); + MOVE_BOXED(ptr, val, n_htop, nsp_i); + } + } else if (is_list(gval)) { + Eterm *ptr = list_val(gval); + Eterm val = *ptr; + if (is_non_value(val)) { + *nsp_i = ptr[1]; + } else if (in_area(ptr, heap, mature_size)) { + MOVE_CONS(ptr, val, old_htop, nsp_i); + } else if (in_area(ptr, heap, heap_size)) { + ASSERT(within(ptr, p)); + MOVE_CONS(ptr, val, n_htop, nsp_i); + } + } + } + if (++i >= sdesc_size) + break; + if (i & 31) + mask >>= 1; + else + mask = sdesc->livebits[i >> 5]; + } + ra = nstack_walk_frame_ra(nsp, sdesc); + sdesc = hipe_find_sdesc(ra); + nsp = nstack_walk_next_frame(nsp, sdesc_size); + } + abort(); +} + +#ifdef HYBRID + +#ifdef INCREMENTAL +Eterm *ma_fullsweep_nstack(Process *p, Eterm *n_htop, Eterm *n_hend) +{ + /* known nstack walk state */ + Eterm *nsp; + Eterm *nsp_end; + const struct sdesc *sdesc; + unsigned int sdesc_size; + unsigned long ra; + unsigned int i; + unsigned int mask; + /* arch-specific nstack walk state */ + struct nstack_walk_state walk_state; + + if (!nstack_walk_init_check(p)) + return n_htop; + + nsp = nstack_walk_nsp_begin(p); + nsp_end = nstack_walk_nsp_end(p); + + sdesc = nstack_walk_init_sdesc(p, &walk_state); + + for (;;) { + if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { + if (nsp == nsp_end) + return n_htop; + fprintf(stderr, "%s: passed end of stack\r\n", __FUNCTION__); + break; + } + sdesc_size = nstack_walk_frame_size(sdesc); + i = 0; + mask = sdesc->livebits[0]; + for (;;) { + if (mask & 1) { + Eterm *nsp_i = nstack_walk_frame_index(nsp, i); + Eterm val = *nsp_i; + Eterm *obj_ptr = ptr_val(val); + switch (primary_tag(val)) { + case TAG_PRIMARY_LIST: + COPYMARK_CONS(obj_ptr, n_htop, nsp_i, n_hend); + break; + case TAG_PRIMARY_BOXED: + COPYMARK_BOXED(obj_ptr, n_htop, nsp_i, n_hend); + break; + default: + break; + } + } + if (++i >= sdesc_size) + break; + if (i & 31) + mask >>= 1; + else + mask = sdesc->livebits[i >> 5]; + } + ra = nstack_walk_frame_ra(nsp, sdesc); + if (ra == (unsigned long)nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + sdesc = hipe_find_sdesc(ra); + nsp = nstack_walk_next_frame(nsp, sdesc_size); + } + abort(); +} + +void ma_gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) +{ + /* known nstack walk state */ + Eterm *nsp; + Eterm *nsp_end; + const struct sdesc *sdesc; + unsigned int sdesc_size; + unsigned long ra; + unsigned int i; + unsigned int mask; + /* arch-specific nstack walk state */ + struct nstack_walk_state walk_state; + + /* ma_gensweep-specific state */ + Eterm *low_water, *high_water, *surface; + Eterm *n_htop; + Eterm *old_htop; + + if (!nstack_walk_init_check(p)) + return; + + nsp = nstack_walk_nsp_begin(p); + nsp_end = nstack_walk_nsp_end(p); + + low_water = global_heap; + //high_water = global_high_water; + surface = global_htop; + + old_htop = *ptr_old_htop; + n_htop = *ptr_n_htop; + + sdesc = nstack_walk_init_sdesc(p, &walk_state); + + for (;;) { + if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { + if (nsp == nsp_end) { + *ptr_old_htop = old_htop; + *ptr_n_htop = n_htop; + return; + } + fprintf(stderr, "%s: passed end of stack\r\n", __FUNCTION__); + break; + } + sdesc_size = nstack_walk_frame_size(sdesc); + i = 0; + mask = sdesc->livebits[0]; + for (;;) { + if (mask & 1) { + Eterm *nsp_i = nstack_walk_frame_index(nsp, i); + Eterm gval = *nsp_i; + if (is_boxed(gval)) { + Eterm *ptr = boxed_val(gval); + Eterm val = *ptr; + if (MY_IS_MOVED(val)) { + *nsp_i = val; + } else if (ptr_within(ptr, low_water, high_water)) { + MOVE_BOXED(ptr, val, old_htop, nsp_i); + } else if (ptr_within(ptr, high_water, surface)) { + MOVE_BOXED(ptr, val, n_htop, nsp_i); + } + } else if (is_list(gval)) { + Eterm *ptr = list_val(gval); + Eterm val = *ptr; + if (is_non_value(val)) { + *nsp_i = ptr[1]; + } else if (ptr_within(ptr, low_water, high_water)) { + MOVE_CONS(ptr, val, old_htop, nsp_i); + } else if (ptr_within(ptr, high_water, surface)) { + MOVE_CONS(ptr, val, n_htop, nsp_i); + } + } + } + if (++i >= sdesc_size) + break; + if (i & 31) + mask >>= 1; + else + mask = sdesc->livebits[i >> 5]; + } + ra = nstack_walk_frame_ra(nsp, sdesc); + if (ra == (unsigned long)nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + sdesc = hipe_find_sdesc(ra); + nsp = nstack_walk_next_frame(nsp, sdesc_size); + } + abort(); +} + +#else /* not INCREMENTAL */ + +Eterm *ma_fullsweep_nstack(Process *p, Eterm *n_htop) +{ + /* known nstack walk state */ + Eterm *nsp; + Eterm *nsp_end; + const struct sdesc *sdesc; + unsigned int sdesc_size; + unsigned long ra; + unsigned int i; + unsigned int mask; + /* arch-specific nstack walk state */ + struct nstack_walk_state walk_state; + + /* ma_fullsweep-specific state */ + Eterm *gheap = global_heap; + Eterm *ghtop = global_htop; + Eterm *goheap = global_old_heap; + Eterm *gohtop = global_old_htop; + + if (!nstack_walk_init_check(p)) + return n_htop; + + nsp = nstack_walk_nsp_begin(p); + nsp_end = nstack_walk_nsp_end(p); + + sdesc = nstack_walk_init_sdesc(p, &walk_state); + + for (;;) { + if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { + if (nsp == nsp_end) + return n_htop; + fprintf(stderr, "%s: passed end of stack\r\n", __FUNCTION__); + break; + } + sdesc_size = nstack_walk_frame_size(sdesc); + i = 0; + mask = sdesc->livebits[0]; + for (;;) { + if (mask & 1) { + Eterm *nsp_i = nstack_walk_frame_index(nsp, i); + Eterm gval = *nsp_i; + if (is_boxed(gval)) { + Eterm *ptr = boxed_val(gval); + Eterm val = *ptr; + if (MY_IS_MOVED(val)) { + *nsp_i = val; + } else if (ptr_within(ptr, gheap, ghtop)) { + MOVE_BOXED(ptr, val, n_htop, nsp_i); + } else if (ptr_within(ptr, goheap, gohtop)) { + MOVE_BOXED(ptr, val, n_htop, nsp_i); + } + } else if (is_list(gval)) { + Eterm *ptr = list_val(gval); + Eterm val = *ptr; + if (is_non_value(val)) { + *nsp_i = ptr[1]; + } else if (ptr_within(ptr, gheap, ghtop)) { + MOVE_CONS(ptr, val, n_htop, nsp_i); + } else if (ptr_within(ptr, gheap, ghtop)) { + MOVE_CONS(ptr, val, n_htop, nsp_i); + } + } + } + if (++i >= sdesc_size) + break; + if (i & 31) + mask >>= 1; + else + mask = sdesc->livebits[i >> 5]; + } + ra = nstack_walk_frame_ra(nsp, sdesc); + if (ra == (unsigned long)nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + sdesc = hipe_find_sdesc(ra); + nsp = nstack_walk_next_frame(nsp, sdesc_size); + } + abort(); +} + +void ma_gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop) +{ + /* known nstack walk state */ + Eterm *nsp; + Eterm *nsp_end; + const struct sdesc *sdesc; + unsigned int sdesc_size; + unsigned long ra; + unsigned int i; + unsigned int mask; + /* arch-specific nstack walk state */ + struct nstack_walk_state walk_state; + + /* ma_gensweep-specific state */ + Eterm *low_water, *high_water, *surface; + Eterm *n_htop; + Eterm *old_htop; + + if (!nstack_walk_init_check(p)) + return; + + nsp = nstack_walk_nsp_begin(p); + nsp_end = nstack_walk_nsp_end(p); + + low_water = global_heap; + high_water = global_high_water; + surface = global_htop; + + old_htop = *ptr_old_htop; + n_htop = *ptr_n_htop; + + sdesc = nstack_walk_init_sdesc(p, &walk_state); + + for (;;) { + if (nstack_walk_nsp_reached_end(nsp, nsp_end)) { + if (nsp == nsp_end) { + *ptr_old_htop = old_htop; + *ptr_n_htop = n_htop; + return; + } + fprintf(stderr, "%s: passed end of stack\r\n", __FUNCTION__); + break; + } + sdesc_size = nstack_walk_frame_size(sdesc); + i = 0; + mask = sdesc->livebits[0]; + for (;;) { + if (mask & 1) { + Eterm *nsp_i = nstack_walk_frame_index(nsp, i); + Eterm gval = *nsp_i; + if (is_boxed(gval)) { + Eterm *ptr = boxed_val(gval); + Eterm val = *ptr; + if (MY_IS_MOVED(val)) { + *nsp_i = val; + } else if (ptr_within(ptr, low_water, high_water)) { + MOVE_BOXED(ptr, val, old_htop, nsp_i); + } else if (ptr_within(ptr, high_water, surface)) { + MOVE_BOXED(ptr, val, n_htop, nsp_i); + } + } else if (is_list(gval)) { + Eterm *ptr = list_val(gval); + Eterm val = *ptr; + if (is_non_value(val)) { + *nsp_i = ptr[1]; + } else if (ptr_within(ptr, low_water, high_water)) { + MOVE_CONS(ptr, val, old_htop, nsp_i); + } else if (ptr_within(ptr, high_water, surface)) { + MOVE_CONS(ptr, val, n_htop, nsp_i); + } + } + } + if (++i >= sdesc_size) + break; + if (i & 31) + mask >>= 1; + else + mask = sdesc->livebits[i >> 5]; + } + ra = nstack_walk_frame_ra(nsp, sdesc); + if (ra == (unsigned long)nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + sdesc = hipe_find_sdesc(ra); + nsp = nstack_walk_next_frame(nsp, sdesc_size); + } + abort(); +} +#endif /* INCREMENTAL */ + +#endif /* HYBRID */ diff --git a/erts/emulator/hipe/hipe_gc.h b/erts/emulator/hipe/hipe_gc.h new file mode 100644 index 0000000000..712d0ffa78 --- /dev/null +++ b/erts/emulator/hipe/hipe_gc.h @@ -0,0 +1,40 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_GC_H +#define HIPE_GC_H + +#if defined(__sparc__) +#include "hipe_sparc_gc.h" +#endif +#if defined(__i386__) +#include "hipe_x86_gc.h" +#endif +#if defined(__x86_64__) +#include "hipe_amd64_gc.h" +#endif +#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#include "hipe_ppc_gc.h" +#endif +#if defined(__arm__) +#include "hipe_arm_gc.h" +#endif + +#endif /* HIPE_GC_H */ diff --git a/erts/emulator/hipe/hipe_mkliterals.c b/erts/emulator/hipe/hipe_mkliterals.c new file mode 100644 index 0000000000..a77aec7919 --- /dev/null +++ b/erts/emulator/hipe/hipe_mkliterals.c @@ -0,0 +1,631 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include +#include +#include +#include +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "erl_bits.h" +#include "erl_message.h" +/* this sucks, but the compiler needs data for all platforms */ +#include "hipe_arm_asm.h" +#undef P +#undef NSP +#undef HP +#undef TEMP_LR +#undef SAVE_CACHED_STATE +#undef RESTORE_CACHED_STATE +#undef SAVE_CONTEXT_QUICK +#undef RESTORE_CONTEXT_QUICK +#undef SAVE_CONTEXT_BIF +#undef RESTORE_CONTEXT_BIF +#undef SAVE_CONTEXT_GC +#undef RESTORE_CONTEXT_GC +#undef NR_ARG_REGS +#undef LOAD_ARG_REGS +#undef STORE_ARG_REGS +#undef TEMP_ARG0 +#undef TEMP_ARG1 +#undef TEMP_ARG2 +#undef ARG0 +#undef ARG1 +#undef ARG2 +#undef ARG3 +#undef ARG4 +#undef ARG5 +#include "hipe_ppc_asm.h" +#undef P +#undef NSP +#undef HP +#undef TEMP_LR +#undef SAVE_CACHED_STATE +#undef RESTORE_CACHED_STATE +#undef SAVE_CONTEXT_QUICK +#undef RESTORE_CONTEXT_QUICK +#undef SAVE_CONTEXT_BIF +#undef RESTORE_CONTEXT_BIF +#undef SAVE_CONTEXT_GC +#undef RESTORE_CONTEXT_GC +#undef NR_ARG_REGS +#undef LOAD_ARG_REGS +#undef STORE_ARG_REGS +#undef TEMP_ARG0 +#undef TEMP_ARG1 +#undef TEMP_ARG2 +#undef ARG0 +#undef ARG1 +#undef ARG2 +#undef ARG3 +#undef ARG4 +#undef ARG5 +#include "hipe_amd64_asm.h" +#undef P +#undef HP +#undef NSP +#undef TEMP_ARG0 +#undef TEMP_ARG1 +#undef TEMP_ARG2 +#undef ARG0 +#undef ARG1 +#undef ARG2 +#undef ARG3 +#undef ARG4 +#undef ARG5 +#undef SAVE_HP +#undef RESTORE_HP +#undef SAVE_CSP +#undef RESTORE_CSP +#undef SAVE_CACHED_STATE +#undef RESTORE_CACHED_STATE +#undef SWITCH_C_TO_ERLANG_QUICK +#undef SWITCH_ERLANG_TO_C_QUICK +#undef SWITCH_C_TO_ERLANG +#undef SWITCH_ERLANG_TO_C +#undef NR_ARG_REGS +#undef LEAF_WORDS +#undef TEMP_RV +#undef LOAD_ARG_REGS +#undef STORE_ARG_REGS +#undef NSP_CALL +#undef NSP_RETN +#undef NSP_RET0 +#include "hipe_x86_asm.h" +#undef P +#undef HP +#undef NSP +#undef TEMP0 +#undef TEMP1 +#undef ARG0 +#undef ARG1 +#undef ARG2 +#undef SAVE_HP +#undef RESTORE_HP +#undef SAVE_CSP +#undef RESTORE_CSP +#undef SAVE_CACHED_STATE +#undef RESTORE_CACHED_STATE +#undef SWITCH_C_TO_ERLANG_QUICK +#undef SWITCH_ERLANG_TO_C_QUICK +#undef NR_ARG_REGS +#undef LEAF_WORDS +#undef TEMP_RV +#undef LOAD_ARG_REGS +#undef STORE_ARG_REGS +#include "hipe_sparc_asm.h" +#include "erl_binary.h" + +#define ARRAY_SIZE(x) (sizeof(x) / sizeof((x)[0])) + +#define field_sizeof(STRUCT, FIELD) (sizeof(((STRUCT *)0)->FIELD)) + +static const unsigned int CRCTABLE[256] = { + 0x00000000, 0x77073096, 0xEE0E612C, 0x990951BA, + 0x076DC419, 0x706AF48F, 0xE963A535, 0x9E6495A3, + 0x0EDB8832, 0x79DCB8A4, 0xE0D5E91E, 0x97D2D988, + 0x09B64C2B, 0x7EB17CBD, 0xE7B82D07, 0x90BF1D91, + 0x1DB71064, 0x6AB020F2, 0xF3B97148, 0x84BE41DE, + 0x1ADAD47D, 0x6DDDE4EB, 0xF4D4B551, 0x83D385C7, + 0x136C9856, 0x646BA8C0, 0xFD62F97A, 0x8A65C9EC, + 0x14015C4F, 0x63066CD9, 0xFA0F3D63, 0x8D080DF5, + 0x3B6E20C8, 0x4C69105E, 0xD56041E4, 0xA2677172, + 0x3C03E4D1, 0x4B04D447, 0xD20D85FD, 0xA50AB56B, + 0x35B5A8FA, 0x42B2986C, 0xDBBBC9D6, 0xACBCF940, + 0x32D86CE3, 0x45DF5C75, 0xDCD60DCF, 0xABD13D59, + 0x26D930AC, 0x51DE003A, 0xC8D75180, 0xBFD06116, + 0x21B4F4B5, 0x56B3C423, 0xCFBA9599, 0xB8BDA50F, + 0x2802B89E, 0x5F058808, 0xC60CD9B2, 0xB10BE924, + 0x2F6F7C87, 0x58684C11, 0xC1611DAB, 0xB6662D3D, + 0x76DC4190, 0x01DB7106, 0x98D220BC, 0xEFD5102A, + 0x71B18589, 0x06B6B51F, 0x9FBFE4A5, 0xE8B8D433, + 0x7807C9A2, 0x0F00F934, 0x9609A88E, 0xE10E9818, + 0x7F6A0DBB, 0x086D3D2D, 0x91646C97, 0xE6635C01, + 0x6B6B51F4, 0x1C6C6162, 0x856530D8, 0xF262004E, + 0x6C0695ED, 0x1B01A57B, 0x8208F4C1, 0xF50FC457, + 0x65B0D9C6, 0x12B7E950, 0x8BBEB8EA, 0xFCB9887C, + 0x62DD1DDF, 0x15DA2D49, 0x8CD37CF3, 0xFBD44C65, + 0x4DB26158, 0x3AB551CE, 0xA3BC0074, 0xD4BB30E2, + 0x4ADFA541, 0x3DD895D7, 0xA4D1C46D, 0xD3D6F4FB, + 0x4369E96A, 0x346ED9FC, 0xAD678846, 0xDA60B8D0, + 0x44042D73, 0x33031DE5, 0xAA0A4C5F, 0xDD0D7CC9, + 0x5005713C, 0x270241AA, 0xBE0B1010, 0xC90C2086, + 0x5768B525, 0x206F85B3, 0xB966D409, 0xCE61E49F, + 0x5EDEF90E, 0x29D9C998, 0xB0D09822, 0xC7D7A8B4, + 0x59B33D17, 0x2EB40D81, 0xB7BD5C3B, 0xC0BA6CAD, + 0xEDB88320, 0x9ABFB3B6, 0x03B6E20C, 0x74B1D29A, + 0xEAD54739, 0x9DD277AF, 0x04DB2615, 0x73DC1683, + 0xE3630B12, 0x94643B84, 0x0D6D6A3E, 0x7A6A5AA8, + 0xE40ECF0B, 0x9309FF9D, 0x0A00AE27, 0x7D079EB1, + 0xF00F9344, 0x8708A3D2, 0x1E01F268, 0x6906C2FE, + 0xF762575D, 0x806567CB, 0x196C3671, 0x6E6B06E7, + 0xFED41B76, 0x89D32BE0, 0x10DA7A5A, 0x67DD4ACC, + 0xF9B9DF6F, 0x8EBEEFF9, 0x17B7BE43, 0x60B08ED5, + 0xD6D6A3E8, 0xA1D1937E, 0x38D8C2C4, 0x4FDFF252, + 0xD1BB67F1, 0xA6BC5767, 0x3FB506DD, 0x48B2364B, + 0xD80D2BDA, 0xAF0A1B4C, 0x36034AF6, 0x41047A60, + 0xDF60EFC3, 0xA867DF55, 0x316E8EEF, 0x4669BE79, + 0xCB61B38C, 0xBC66831A, 0x256FD2A0, 0x5268E236, + 0xCC0C7795, 0xBB0B4703, 0x220216B9, 0x5505262F, + 0xC5BA3BBE, 0xB2BD0B28, 0x2BB45A92, 0x5CB36A04, + 0xC2D7FFA7, 0xB5D0CF31, 0x2CD99E8B, 0x5BDEAE1D, + 0x9B64C2B0, 0xEC63F226, 0x756AA39C, 0x026D930A, + 0x9C0906A9, 0xEB0E363F, 0x72076785, 0x05005713, + 0x95BF4A82, 0xE2B87A14, 0x7BB12BAE, 0x0CB61B38, + 0x92D28E9B, 0xE5D5BE0D, 0x7CDCEFB7, 0x0BDBDF21, + 0x86D3D2D4, 0xF1D4E242, 0x68DDB3F8, 0x1FDA836E, + 0x81BE16CD, 0xF6B9265B, 0x6FB077E1, 0x18B74777, + 0x88085AE6, 0xFF0F6A70, 0x66063BCA, 0x11010B5C, + 0x8F659EFF, 0xF862AE69, 0x616BFFD3, 0x166CCF45, + 0xA00AE278, 0xD70DD2EE, 0x4E048354, 0x3903B3C2, + 0xA7672661, 0xD06016F7, 0x4969474D, 0x3E6E77DB, + 0xAED16A4A, 0xD9D65ADC, 0x40DF0B66, 0x37D83BF0, + 0xA9BCAE53, 0xDEBB9EC5, 0x47B2CF7F, 0x30B5FFE9, + 0xBDBDF21C, 0xCABAC28A, 0x53B39330, 0x24B4A3A6, + 0xBAD03605, 0xCDD70693, 0x54DE5729, 0x23D967BF, + 0xB3667A2E, 0xC4614AB8, 0x5D681B02, 0x2A6F2B94, + 0xB40BBE37, 0xC30C8EA1, 0x5A05DF1B, 0x2D02EF8D, +}; + +/* + * The algorithm for calculating the 32 bit CRC checksum is based upon + * documentation and algorithms provided by Dr. Ross N. Williams in the + * document "A Painless Guide to CRC Error Detection Algorithms." + * This document may be downloaded from + * ftp://ftp.rocksoft.com/cliens/rocksoft/papers/crc_v3.txt + * as of 12/15/1998. Dr. Williams has placed this document and algorithms + * in the public domain. + */ +static unsigned int crc_init(void) +{ + return 0xFFFFFFFF; +} + +static unsigned int +crc_update_buf(unsigned int crc_value, + const void *buf, + unsigned int length) +{ + const unsigned char *tab; + + tab = (const unsigned char*)buf; + for (; length > 0; --length) { + unsigned char t = (crc_value >> 24) & 0xFF; + crc_value = (crc_value << 8) | *tab++; + crc_value ^= CRCTABLE[t]; + } + return crc_value; +} + +static unsigned int +crc_update_int(unsigned int crc_value, const unsigned int *p) +{ + return crc_update_buf(crc_value, p, sizeof *p); +} + +/* + * Runtime system parameters. + * Invariant for a given CPU architecture. + * (Would be invariant for 32 bit CPUs if SPARC didn't + * enlarge the def_arg_reg[] array.) + */ +static const struct literal { + const char *name; + unsigned int value; +} literals[] = { + /* Field offsets in a process struct */ + { "P_HP", offsetof(struct process, htop) }, + { "P_HP_LIMIT", offsetof(struct process, stop) }, + { "P_OFF_HEAP_MSO", offsetof(struct process, off_heap.mso) }, + { "P_MBUF", offsetof(struct process, mbuf) }, + { "P_ID", offsetof(struct process, id) }, + { "P_FLAGS", offsetof(struct process, flags) }, + { "P_FVALUE", offsetof(struct process, fvalue) }, + { "P_FREASON", offsetof(struct process, freason) }, + { "P_FTRACE", offsetof(struct process, ftrace) }, + { "P_FCALLS", offsetof(struct process, fcalls) }, + { "P_BEAM_IP", offsetof(struct process, i) }, + { "P_ARITY", offsetof(struct process, arity) }, + { "P_ARG0", offsetof(struct process, def_arg_reg[0]) }, + { "P_ARG1", offsetof(struct process, def_arg_reg[1]) }, + { "P_ARG2", offsetof(struct process, def_arg_reg[2]) }, + { "P_ARG3", offsetof(struct process, def_arg_reg[3]) }, + { "P_ARG4", offsetof(struct process, def_arg_reg[4]) }, + { "P_ARG5", offsetof(struct process, def_arg_reg[5]) }, +#ifdef HIPE + { "P_NSP", offsetof(struct process, hipe.nsp) }, + { "P_NCALLEE", offsetof(struct process, hipe.ncallee) }, + { "P_CLOSURE", offsetof(struct process, hipe.closure) }, +#if defined(__i386__) || defined(__x86_64__) + { "P_NSP_LIMIT", offsetof(struct process, hipe.nstack) }, + { "P_CSP", offsetof(struct process, hipe.ncsp) }, +#elif defined(__sparc__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) + { "P_NSP_LIMIT", offsetof(struct process, hipe.nstack) }, + { "P_NRA", offsetof(struct process, hipe.nra) }, +#endif + { "P_NARITY", offsetof(struct process, hipe.narity) }, +#endif /* HIPE */ + + /* process flags bits */ + { "F_TIMO", F_TIMO }, + + /* freason codes */ + { "FREASON_TRAP", TRAP }, + + /* special Erlang constants */ + { "THE_NON_VALUE", THE_NON_VALUE }, + + /* funs */ +#ifdef HIPE + { "EFE_NATIVE_ADDRESS", offsetof(struct erl_fun_entry, native_address) }, +#endif + { "EFE_REFC", offsetof(struct erl_fun_entry, refc) }, + { "EFT_THING", offsetof(struct erl_fun_thing, thing_word) }, + + /* bit syntax */ + { "BSF_ALIGNED", BSF_ALIGNED}, + { "PB_ACTIVE_WRITER", PB_ACTIVE_WRITER}, + { "PB_IS_WRITABLE", PB_IS_WRITABLE}, + { "MB_ORIG", offsetof(struct erl_bin_match_buffer, orig) }, + { "MB_BASE", offsetof(struct erl_bin_match_buffer, base) }, + { "MB_OFFSET", offsetof(struct erl_bin_match_buffer, offset) }, + { "MB_SIZE", offsetof(struct erl_bin_match_buffer, size) }, + { "PROC_BIN_THING_WORD", offsetof(struct proc_bin, thing_word) }, + { "PROC_BIN_BINSIZE", offsetof(struct proc_bin, size) }, + { "PROC_BIN_NEXT", offsetof(struct proc_bin, next) }, + { "PROC_BIN_VAL", offsetof(struct proc_bin, val) }, + { "PROC_BIN_BYTES", offsetof(struct proc_bin, bytes) }, + { "PROC_BIN_FLAGS", offsetof(struct proc_bin, flags) }, + { "PROC_BIN_WORDSIZE", PROC_BIN_SIZE}, + { "SUB_BIN_THING_WORD", offsetof(struct erl_sub_bin, thing_word) }, + { "SUB_BIN_BINSIZE", offsetof(struct erl_sub_bin, size) }, + { "SUB_BIN_BITSIZE", offsetof(struct erl_sub_bin, bitsize) }, + { "SUB_BIN_OFFS", offsetof(struct erl_sub_bin, offs) }, + { "SUB_BIN_BITOFFS", offsetof(struct erl_sub_bin, bitoffs) }, + { "SUB_BIN_WRITABLE", offsetof(struct erl_sub_bin, is_writable) }, + { "SUB_BIN_ORIG", offsetof(struct erl_sub_bin, orig) }, + { "SUB_BIN_WORDSIZE", ERL_SUB_BIN_SIZE}, + { "HEAP_BIN_THING_WORD", offsetof(struct erl_heap_bin, thing_word) }, + { "HEAP_BIN_SIZE", offsetof(struct erl_heap_bin, size) }, + { "HEAP_BIN_DATA", offsetof(struct erl_heap_bin, data) }, + { "BINARY_ORIG_SIZE", offsetof(struct binary, orig_size) }, + { "BINARY_ORIG_BYTES", offsetof(struct binary, orig_bytes) }, + { "MAX_HEAP_BIN_SIZE", ERL_ONHEAP_BIN_LIMIT}, + { "MS_THING_WORD", offsetof(struct erl_bin_match_struct, thing_word)}, + { "MS_MATCHBUFFER", offsetof(struct erl_bin_match_struct, mb)}, + { "MS_SAVEOFFSET", offsetof(struct erl_bin_match_struct, save_offset)}, + + { "MS_MIN_SIZE", ERL_BIN_MATCHSTATE_SIZE(0)}, + + { "MB_ORIG_SIZE", field_sizeof(struct erl_bin_match_buffer, orig) }, + { "MB_BASE_SIZE", field_sizeof(struct erl_bin_match_buffer, base) }, + { "MB_OFFSET_SIZE", field_sizeof(struct erl_bin_match_buffer, offset) }, + { "MB_SIZE_SIZE", field_sizeof(struct erl_bin_match_buffer, size) }, + { "PROC_BIN_THING_WORD_SIZE", field_sizeof(struct proc_bin, thing_word) }, + { "PROC_BIN_BINSIZE_SIZE", field_sizeof(struct proc_bin, size) }, + { "PROC_BIN_NEXT_SIZE", field_sizeof(struct proc_bin, next) }, + { "PROC_BIN_VAL_SIZE", field_sizeof(struct proc_bin, val) }, + { "PROC_BIN_BYTES_SIZE", field_sizeof(struct proc_bin, bytes) }, + { "PROC_BIN_FLAGS_SIZE", field_sizeof(struct proc_bin, flags) }, + { "SUB_BIN_THING_WORD_SIZE", field_sizeof(struct erl_sub_bin, thing_word) }, + { "SUB_BIN_BINSIZE_SIZE", field_sizeof(struct erl_sub_bin, size) }, + { "SUB_BIN_BITSIZE_SIZE", field_sizeof(struct erl_sub_bin, bitsize) }, + { "SUB_BIN_OFFS_SIZE", field_sizeof(struct erl_sub_bin, offs) }, + { "SUB_BIN_BITOFFS_SIZE", field_sizeof(struct erl_sub_bin, bitoffs) }, + { "SUB_BIN_WRITABLE_SIZE", field_sizeof(struct erl_sub_bin, is_writable) }, + { "SUB_BIN_ORIG_SIZE", field_sizeof(struct erl_sub_bin, orig) }, + { "HEAP_BIN_THING_WORD_SIZE", field_sizeof(struct erl_heap_bin, thing_word) }, + { "HEAP_BIN_SIZE_SIZE", field_sizeof(struct erl_heap_bin, size) }, + { "HEAP_BIN_DATA_SIZE", field_sizeof(struct erl_heap_bin, data) }, + { "BINARY_ORIG_SIZE_SIZE", field_sizeof(struct binary, orig_size) }, + { "BINARY_ORIG_BYTES_SIZE", field_sizeof(struct binary, orig_bytes) }, + { "MS_THING_WORD_SIZE", field_sizeof(struct erl_bin_match_struct, thing_word)}, + { "MS_SAVEOFFSET_SIZE", field_sizeof(struct erl_bin_match_struct, save_offset)}, + + /* messages */ + { "P_MSG_FIRST", offsetof(struct process, msg.first) }, + { "P_MSG_SAVE", offsetof(struct process, msg.save) }, + { "MSG_NEXT", offsetof(struct erl_mesg, next) }, + + /* ARM */ + { "ARM_LEAF_WORDS", ARM_LEAF_WORDS }, + { "ARM_NR_ARG_REGS", ARM_NR_ARG_REGS }, + { "ARM_IS_BIG_ENDIAN", +#if defined(__arm__) && defined(__ARMEB__) + 1 +#else + 0 +#endif + }, + + /* PowerPC */ + { "PPC_LEAF_WORDS", PPC_LEAF_WORDS }, + { "PPC_NR_ARG_REGS", PPC_NR_ARG_REGS }, + + /* Amd64 */ + { "AMD64_LEAF_WORDS", AMD64_LEAF_WORDS }, + { "AMD64_NR_ARG_REGS", AMD64_NR_ARG_REGS }, +#if AMD64_HP_IN_REGISTER + { "AMD64_HP_IN_REGISTER", 1 }, + { "AMD64_HEAP_POINTER", AMD64_HEAP_POINTER }, +#endif +#if AMD64_FCALLS_IN_REGISTER + { "AMD64_FCALLS_IN_REGISTER", 1 }, + { "AMD64_FCALLS_REGISTER", AMD64_FCALLS_REGISTER }, +#endif +#if AMD64_HEAP_LIMIT_IN_REGISTER + { "AMD64_HEAP_LIMIT_IN_REGISTER", 1 }, + { "AMD64_HEAP_LIMIT_REGISTER", AMD64_HEAP_LIMIT_REGISTER }, +#endif +#if AMD64_SIMULATE_NSP + { "AMD64_SIMULATE_NSP", 1 }, +#endif + + /* x86 */ + { "X86_LEAF_WORDS", X86_LEAF_WORDS }, + { "X86_NR_ARG_REGS", X86_NR_ARG_REGS }, + /* Jag vet att detta suger.. temp dock. */ + { "X86_NR_RET_REGS", 3}, +#if X86_HP_IN_ESI + { "X86_HP_IN_ESI", 1 }, +#endif +#if X86_SIMULATE_NSP + { "X86_SIMULATE_NSP", 1 }, +#endif + + /* SPARC */ + { "SPARC_LEAF_WORDS", SPARC_LEAF_WORDS }, + { "SPARC_NR_ARG_REGS", SPARC_NR_ARG_REGS}, +}; + +#define NR_LITERALS ARRAY_SIZE(literals) + +/* + * Runtime system parameters that generate Erlang atoms. + */ +static const struct atom_literal { + const char *name; + const char *value; +} atom_literals[] = { + { "ARM_ENDIANESS", +#if defined(__arm__) && defined(__ARMEB__) + "big" +#else + "little" +#endif + }, +}; + +#define NR_ATOM_LITERALS ARRAY_SIZE(atom_literals) + +/* + * Runtime system parameters. + * These depend on configuration options such as heap architecture. + * The compiler accesses these through hipe_bifs:get_rts_param/1. + */ +static const struct rts_param { + unsigned int nr; + const char *name; + unsigned int is_defined; + unsigned int value; +} rts_params[] = { + { 1, "P_OFF_HEAP_FUNS", +#if !defined(HYBRID) + 1, offsetof(struct process, off_heap.funs) +#endif + }, + + { 4, "EFT_NEXT", +#if !defined(HYBRID) + 1, offsetof(struct erl_fun_thing, next) +#endif + }, + + /* These are always defined, but their values depend on the + presence or absence of struct erl_fun_thing's "next" field. */ + { 5, "EFT_CREATOR", 1, offsetof(struct erl_fun_thing, creator) }, + { 6, "EFT_FE", 1, offsetof(struct erl_fun_thing, fe) }, +#ifdef HIPE + { 7, "EFT_NATIVE_ADDRESS", 1, offsetof(struct erl_fun_thing, native_address) }, +#endif + { 8, "EFT_ARITY", 1, offsetof(struct erl_fun_thing, arity) }, + { 9, "EFT_NUM_FREE", 1, offsetof(struct erl_fun_thing, num_free) }, + { 10, "EFT_ENV", 1, offsetof(struct erl_fun_thing, env[0]) }, + { 11, "ERL_FUN_SIZE", 1, ERL_FUN_SIZE }, + + { 12, "P_SCHED_DATA", +#ifdef ERTS_SMP + 1, offsetof(struct process, scheduler_data) +#endif + }, + { 14, "P_FP_EXCEPTION", +#if !defined(NO_FPE_SIGNALS) + 1, offsetof(struct process, fp_exception) +#endif + }, + /* This flag is always defined, but its value is configuration-dependent. */ + { 15, "ERTS_IS_SMP", + 1, +#if defined(ERTS_SMP) + 1 +#else + 0 +#endif + }, + /* This parameter is always defined, but its value depends on ERTS_SMP. */ + { 19, "MSG_MESSAGE", + 1, offsetof(struct erl_mesg, m[0]) + }, + /* highest entry ever used == 21 */ +}; + +#define NR_PARAMS ARRAY_SIZE(rts_params) + +static unsigned int literals_crc; +static unsigned int system_crc; + +static void compute_crc(void) +{ + unsigned int crc_value; + unsigned int i; + + crc_value = crc_init(); + for (i = 0; i < NR_LITERALS; ++i) + crc_value = crc_update_int(crc_value, &literals[i].value); + crc_value &= 0x07FFFFFF; + literals_crc = crc_value; + for (i = 0; i < NR_PARAMS; ++i) + if (rts_params[i].is_defined) + crc_value = crc_update_int(crc_value, &rts_params[i].value); + crc_value &= 0x07FFFFFF; + system_crc = crc_value; +} + +static void c_define_literal(FILE *fp, const struct literal *literal) +{ + fprintf(fp, "#define %s %u\n", literal->name, literal->value); +} + +static void e_define_literal(FILE *fp, const struct literal *literal) +{ + fprintf(fp, "-define(%s, %u).\n", literal->name, literal->value); +} + +static void print_literals(FILE *fp, void (*print_literal)(FILE*, const struct literal*)) +{ + unsigned int i; + + for (i = 0; i < NR_LITERALS; ++i) + (*print_literal)(fp, &literals[i]); +} + +static void e_define_atom_literal(FILE *fp, const struct atom_literal *atom_literal) +{ + fprintf(fp, "-define(%s, %s).\n", atom_literal->name, atom_literal->value); +} + +static void print_atom_literals(FILE *fp, void (*print_atom_literal)(FILE*, const struct atom_literal*)) +{ + unsigned int i; + + for (i = 0; i < NR_ATOM_LITERALS; ++i) + (*print_atom_literal)(fp, &atom_literals[i]); +} + +static void c_define_param(FILE *fp, const struct rts_param *param) +{ + if (param->is_defined) + fprintf(fp, "#define %s %u\n", param->name, param->value); +} + +static void c_case_param(FILE *fp, const struct rts_param *param) +{ + fprintf(fp, " \\\n"); + fprintf(fp, "\tcase %u: ", param->nr); + if (param->is_defined) + fprintf(fp, "value = %u", param->value); + else + fprintf(fp, "is_defined = 0"); + fprintf(fp, "; break;"); +} + +static void e_define_param(FILE *fp, const struct rts_param *param) +{ + fprintf(fp, "-define(%s, hipe_bifs:get_rts_param(%u)).\n", param->name, param->nr); +} + +static void print_params(FILE *fp, void (*print_param)(FILE*,const struct rts_param*)) +{ + unsigned int i; + + for (i = 0; i < NR_PARAMS; ++i) + (*print_param)(fp, &rts_params[i]); +} + +static int do_c(FILE *fp) +{ + fprintf(fp, "/* File: hipe_literals.h, generated by hipe_mkliterals */\n"); + fprintf(fp, "#ifndef __HIPE_LITERALS_H__\n"); + fprintf(fp, "#define __HIPE_LITERALS_H__\n\n"); + print_literals(fp, c_define_literal); + print_params(fp, c_define_param); + fprintf(fp, "#define HIPE_LITERALS_CRC %uU\n", literals_crc); + fprintf(fp, "#define HIPE_SYSTEM_CRC %uU\n", system_crc); + fprintf(fp, "\n"); + fprintf(fp, "#define RTS_PARAMS_CASES"); + print_params(fp, c_case_param); + fprintf(fp, "\n#endif\n"); + return 0; +} + +static int do_e(FILE *fp) +{ + fprintf(fp, "%%%% File: hipe_literals.hrl, generated by hipe_mkliterals"); + fprintf(fp, "\n\n"); + print_literals(fp, e_define_literal); + fprintf(fp, "\n"); + print_atom_literals(fp, e_define_atom_literal); + fprintf(fp, "\n"); + print_params(fp, e_define_param); + fprintf(fp, "\n"); + fprintf(fp, "-define(HIPE_SYSTEM_CRC, hipe_bifs:system_crc(%u)).\n", literals_crc); + return 0; +} + +int main(int argc, const char **argv) +{ + compute_crc(); + if (argc == 2) { + if (strcmp(argv[1], "-c") == 0) + return do_c(stdout); + if (strcmp(argv[1], "-e") == 0) + return do_e(stdout); + } + fprintf(stderr, "usage: %s [-c | -e] > output-file\n", argv[0]); + return 1; +} diff --git a/erts/emulator/hipe/hipe_mode_switch.c b/erts/emulator/hipe/hipe_mode_switch.c new file mode 100644 index 0000000000..e5de244d25 --- /dev/null +++ b/erts/emulator/hipe/hipe_mode_switch.c @@ -0,0 +1,641 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_mode_switch.c + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "beam_load.h" /* which includes beam_opcodes.h */ +#include "beam_catches.h" +#include "hipe_mode_switch.h" +#include "bif.h" +#include "error.h" +#include "hipe_stack.h" +#include "hipe_bif0.h" /* hipe_mfa_info_table_init() */ + +/* + * Internal debug support. + * #define HIPE_DEBUG to the desired debug level: + * 0 no checks + * 1 check PCB consistency at mode-switches + * 2 log commands and results at mode-switches + * 3 log commands, results, and PCB contents at mode-switches + * + * TODO: check PCB consistency at native BIF calls + */ +int hipe_modeswitch_debug = 0; + +#define HIPE_DEBUG 0 + +#if HIPE_DEBUG > 1 /* include DPRINTF() logging */ + +#define DPRINTF(fmt, args...) \ +do { \ + if (hipe_modeswitch_debug > 0) { \ + printf("%s, line %u: " fmt "\r\n", __FUNCTION__, __LINE__ , ##args); \ + fflush(stdout); \ + } \ +} while (0) + +static const char *code_str(unsigned code) +{ + static const char *cmd_str[] = { + "call from beam", + "return from beam", + "throw from beam", + "resume from beam", + "return to beam", + "call to beam", + "throw to beam", + "suspend to beam", + "wait from native", + "wait_timeout from native", + "trap from native", + "call closure from beam", + "call closure to beam", + }; + unsigned cmd = code & 0xFF; + + if (cmd < (sizeof(cmd_str)/sizeof(cmd_str[0]))) + return cmd_str[cmd]; + else + return "???"; +} + +#else /* HIPE_DEBUG > 1 */ + +#define DPRINTF(fmt, args...) do{}while(0) + +#endif /* HIPE_DEBUG > 1 */ + +#if HIPE_DEBUG > 0 /* include HIPE_ASSERT and PCB checking */ + +static void __noreturn +hipe_abort(const char *expr, const char *file, unsigned line) +{ + erl_exit(1, "ASSERTION FAILED, file %s, line %u: %s\r\n", file, line, expr); +} + +#define HIPE_ASSERT3(expr, file, line) \ +do { \ + if (!(expr)) \ + hipe_abort(#expr, file, line); \ +} while (0) +#define HIPE_ASSERT(expr) HIPE_ASSERT3(expr, __FILE__, __LINE__) + +void hipe_check_pcb(Process *p, const char *file, unsigned line) +{ +#if HIPE_DEBUG > 2 + if (hipe_modeswitch_debug > 0) { + printf("%s, line %u: p %p = {htop %p, stop %p, nstack %p, nsp %p, nstend %p}\r\n", file, line, p, p->htop, p->stop, p->hipe.nstack, p->hipe.nsp, p->hipe.nstend); + } +#endif + HIPE_ASSERT3(p != NULL, file, line); + HIPE_ASSERT3(p->htop <= p->stop, file, line); + HIPE_ASSERT3(p->hipe.nstack <= p->hipe.nstend, file, line); + HIPE_ASSERT3(p->hipe.nsp >= p->hipe.nstack, file, line); + HIPE_ASSERT3(p->hipe.nsp <= p->hipe.nstend, file, line); +} +#define HIPE_CHECK_PCB(P) hipe_check_pcb((P), __FILE__, __LINE__) + +#else /* HIPE_DEBUG > 0 */ + +#define HIPE_ASSERT(expr) do{}while(0) +#define HIPE_CHECK_PCB(P) do{}while(0) + +#endif /* HIPE_DEBUG > 0 */ + +/* ensure that at least nwords words are available on the native stack */ +static void hipe_check_nstack(Process *p, unsigned nwords); + +#if defined(__sparc__) +#include "hipe_sparc_glue.h" +#elif defined(__i386__) +#include "hipe_x86_glue.h" +#elif defined(__x86_64__) +#include "hipe_amd64_glue.h" +#elif defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#include "hipe_ppc_glue.h" +#elif defined(__arm__) +#include "hipe_arm_glue.h" +#endif + +#define BeamOpCode(Op) ((Uint)BeamOp(Op)) + +Uint hipe_beam_pc_return[1]; /* needed in hipe_debug.c */ +Uint hipe_beam_pc_throw[1]; /* needed in hipe_debug.c */ +Uint hipe_beam_pc_resume[1]; /* needed by hipe_set_timeout() */ +static Eterm hipe_beam_catch_throw; + +void hipe_mode_switch_init(void) +{ + hipe_arch_glue_init(); + + hipe_beam_pc_return[0] = BeamOpCode(op_hipe_trap_return); + hipe_beam_pc_throw[0] = BeamOpCode(op_hipe_trap_throw); + hipe_beam_pc_resume[0] = BeamOpCode(op_hipe_trap_resume); + + hipe_beam_catch_throw = + make_catch(beam_catches_cons(hipe_beam_pc_throw, BEAM_CATCHES_NIL)); + + hipe_mfa_info_table_init(); +} + +void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure) +{ + HIPE_ASSERT(bfun[-5] == BeamOpCode(op_i_func_info_IaaI)); + bfun[0] = + is_closure + ? BeamOpCode(op_hipe_trap_call_closure) + : BeamOpCode(op_hipe_trap_call); + bfun[-4] = (Uint)nfun; +} + +static __inline__ void +hipe_push_beam_trap_frame(Process *p, Eterm reg[], unsigned arity) +{ + /* ensure that at least 2 words are available on the BEAM stack */ + if ((p->stop - 2) < p->htop) { + DPRINTF("calling gc to increase BEAM stack size"); + p->fcalls -= erts_garbage_collect(p, 2, reg, arity); + } + p->stop -= 2; + p->stop[1] = hipe_beam_catch_throw; + p->stop[0] = make_cp(p->cp); + ++p->catches; + p->cp = hipe_beam_pc_return; +} + +static __inline__ void hipe_pop_beam_trap_frame(Process *p) +{ + p->cp = cp_val(p->stop[0]); + --p->catches; + p->stop += 2; +} + +Process *hipe_mode_switch(Process *p, unsigned cmd, Eterm reg[]) +{ + unsigned result; +#if NR_ARG_REGS > 5 + /* When NR_ARG_REGS > 5, we need to protect the process' input + reduction count (which BEAM stores in def_arg_reg[5]) from + being clobbered by the arch glue code. */ + Eterm reds_in = p->def_arg_reg[5]; +#endif +#if NR_ARG_REGS > 4 + Eterm o_reds = p->def_arg_reg[4]; +#endif + + p->i = NULL; + + DPRINTF("cmd == %#x (%s)", cmd, code_str(cmd)); + HIPE_CHECK_PCB(p); + p->arity = 0; + switch (cmd & 0xFF) { + case HIPE_MODE_SWITCH_CMD_CALL: { + /* BEAM calls a native code function */ + unsigned arity = cmd >> 8; + + /* p->hipe.ncallee set in beam_emu */ + if (p->cp == hipe_beam_pc_return) { + /* Native called BEAM, which now tailcalls native. */ + hipe_pop_beam_trap_frame(p); + result = hipe_tailcall_to_native(p, arity, reg); + break; + } + DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity); + result = hipe_call_to_native(p, arity, reg); + break; + } + case HIPE_MODE_SWITCH_CMD_CALL_CLOSURE: { + /* BEAM calls a native code closure */ + unsigned arity = cmd >> 8; /* #formals + #fvs (closure not counted) */ + Eterm fun; + ErlFunThing *funp; + + /* drop the fvs, move the closure, correct arity */ + fun = reg[arity]; + HIPE_ASSERT(is_fun(fun)); + funp = (ErlFunThing*)fun_val(fun); + HIPE_ASSERT(funp->num_free <= arity); + arity -= funp->num_free; /* arity == #formals */ + reg[arity] = fun; + ++arity; /* correct for having added the closure */ + /* HIPE_ASSERT(p->hipe.ncallee == (void(*)(void))funp->native_address); */ + + /* just like a normal call from now on */ + + /* p->hipe.ncallee set in beam_emu */ + if (p->cp == hipe_beam_pc_return) { + /* Native called BEAM, which now tailcalls native. */ + hipe_pop_beam_trap_frame(p); + result = hipe_tailcall_to_native(p, arity, reg); + break; + } + DPRINTF("calling %#lx/%u", (long)p->hipe.ncallee, arity); + result = hipe_call_to_native(p, arity, reg); + break; + } + case HIPE_MODE_SWITCH_CMD_THROW: { + /* BEAM just executed hipe_beam_pc_throw[] */ + /* Native called BEAM, which now throws an exception back to native. */ + DPRINTF("beam throws freason %#lx fvalue %#lx", p->freason, p->fvalue); + hipe_pop_beam_trap_frame(p); + do_throw_to_native: + p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(p->freason)]; + hipe_find_handler(p); + result = hipe_throw_to_native(p); + break; + } + case HIPE_MODE_SWITCH_CMD_RETURN: { + /* BEAM just executed hipe_beam_pc_return[] */ + /* Native called BEAM, which now returns back to native. */ + /* pop trap frame off estack */ + hipe_pop_beam_trap_frame(p); + p->def_arg_reg[0] = reg[0]; + result = hipe_return_to_native(p); + break; + } + do_resume: + case HIPE_MODE_SWITCH_CMD_RESUME: { + /* BEAM just executed hipe_beam_pc_resume[] */ + /* BEAM called native, which suspended. */ + if (p->flags & F_TIMO) { + /* XXX: The process will immediately execute 'clear_timeout', + repeating these two statements. Remove them? */ + p->flags &= ~F_TIMO; + JOIN_MESSAGE(p); + p->def_arg_reg[0] = 0; /* make_small(0)? */ + } else + p->def_arg_reg[0] = 1; /* make_small(1)? */ + result = hipe_return_to_native(p); + break; + } + default: + erl_exit(1, "hipe_mode_switch: cmd %#x\r\n", cmd); + } + do_return_from_native: + DPRINTF("result == %#x (%s)", result, code_str(result)); + HIPE_CHECK_PCB(p); + switch (result) { + case HIPE_MODE_SWITCH_RES_RETURN: { + hipe_return_from_native(p); + reg[0] = p->def_arg_reg[0]; + DPRINTF("returning with r(0) == %#lx", reg[0]); + break; + } + case HIPE_MODE_SWITCH_RES_THROW: { + DPRINTF("native throws freason %#lx fvalue %#lx", p->freason, p->fvalue); + hipe_throw_from_native(p); + break; + } + case HIPE_MODE_SWITCH_RES_TRAP: { + /* + * Native code called a BIF, which "failed" with a TRAP to BEAM. + * Prior to returning, the BIF stored (see BIF_TRAP): + + * the callee's address in p->def_arg_reg[3] + * the callee's parameters in p->def_arg_reg[0..2] + * the callee's arity in p->arity (for BEAM gc purposes) + * + * We need to remove the BIF's parameters from the native + * stack: to this end hipe_${ARCH}_glue.S stores the BIF's + * arity in p->hipe.narity. + */ + unsigned int i, is_recursive, callee_arity; + + /* Save p->arity, then update it with the original BIF's arity. + Get rid of any stacked parameters in that call. */ + /* XXX: hipe_call_from_native_is_recursive() copies data to + reg[], which is useless in the TRAP case. Maybe write a + specialised hipe_trap_from_native_is_recursive() later. */ + callee_arity = p->arity; + p->arity = p->hipe.narity; /* caller's arity */ + is_recursive = hipe_call_from_native_is_recursive(p, reg); + + p->i = (Eterm *)(p->def_arg_reg[3]); + p->arity = callee_arity; + + for (i = 0; i < p->arity; ++i) + reg[i] = p->def_arg_reg[i]; + + if (is_recursive) + hipe_push_beam_trap_frame(p, reg, p->arity); + + result = HIPE_MODE_SWITCH_RES_CALL; + break; + } + case HIPE_MODE_SWITCH_RES_CALL: { + /* Native code calls or tailcalls BEAM. + * + * p->i is the callee's BEAM code + * p->arity is the callee's arity + * p->def_arg_reg[] contains the register parameters + * p->hipe.nsp[] contains the stacked parameters + */ + if (hipe_call_from_native_is_recursive(p, reg)) { + /* BEAM called native, which now calls BEAM */ + hipe_push_beam_trap_frame(p, reg, p->arity); + } + break; + } + case HIPE_MODE_SWITCH_RES_CALL_CLOSURE: { + /* Native code calls or tailcalls a closure in BEAM + * + * In native code a call to a closure of arity n looks like + * F(A1, ..., AN, Closure), + * The BEAM code for a closure expects to get: + * F(A1, ..., AN, FV1, ..., FVM, Closure) + * (Where Ai is argument i and FVj is free variable j) + * + * p->hipe.closure contains the closure + * p->def_arg_reg[] contains the register parameters + * p->hipe.nsp[] contains the stacked parameters + */ + ErlFunThing *closure; + unsigned num_free, arity, i, is_recursive; + + HIPE_ASSERT(is_fun(p->hipe.closure)); + closure = (ErlFunThing*)fun_val(p->hipe.closure); + num_free = closure->num_free; + arity = closure->fe->arity; + + /* Store the arity in p->arity for the stack popping. */ + /* Note: we already have the closure so only need to move arity + values to reg[]. However, there are arity+1 parameters in the + native code state that need to be removed. */ + p->arity = arity+1; /* +1 for the closure */ + + /* Get parameters, don't do GC just yet. */ + is_recursive = hipe_call_from_native_is_recursive(p, reg); + + if ((Sint)closure->fe->address[-1] < 0) { + /* Unloaded. Let beam_emu.c:call_fun() deal with it. */ + result = HIPE_MODE_SWITCH_RES_CALL_CLOSURE; + } else { + /* The BEAM code is present. Prepare to call it. */ + + /* Append the free vars after the actual parameters. */ + for (i = 0; i < num_free; ++i) + reg[arity+i] = closure->env[i]; + + /* Update arity to reflect the new parameters. */ + arity += i; + + /* Make a call to the closure's BEAM code. */ + p->i = closure->fe->address; + + /* Change result code to the faster plain CALL type. */ + result = HIPE_MODE_SWITCH_RES_CALL; + } + /* Append the closure as the last parameter. Don't increment arity. */ + reg[arity] = p->hipe.closure; + + if (is_recursive) { + /* BEAM called native, which now calls BEAM. + Need to put a trap-frame on the beam stack. + This may cause GC, which is safe now that + the arguments, free vars, and most + importantly the closure, all are in reg[]. */ + hipe_push_beam_trap_frame(p, reg, arity+1); + } + break; + } + case HIPE_MODE_SWITCH_RES_SUSPEND: { + p->i = hipe_beam_pc_resume; + p->arity = 0; + erts_smp_proc_lock(p, ERTS_PROC_LOCK_STATUS); + if (p->status != P_SUSPENDED) + erts_add_to_runq(p); + erts_smp_proc_unlock(p, ERTS_PROC_LOCK_STATUS); + goto do_schedule; + } + case HIPE_MODE_SWITCH_RES_WAIT: + case HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT: { + /* same semantics, different debug trace messages */ +#ifdef ERTS_SMP + /* XXX: BEAM has different entries for the locked and unlocked + cases. HiPE doesn't, so we must check dynamically. */ + if (p->hipe_smp.have_receive_locks) + p->hipe_smp.have_receive_locks = 0; + else + erts_smp_proc_lock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); +#endif + p->i = hipe_beam_pc_resume; + p->arity = 0; + p->status = P_WAITING; + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); + do_schedule: + { +#if !(NR_ARG_REGS > 5) + int reds_in = p->def_arg_reg[5]; +#endif + p = schedule(p, reds_in - p->fcalls); +#ifdef ERTS_SMP + p->hipe_smp.have_receive_locks = 0; + reg = p->scheduler_data->save_reg; +#endif + } + { + Eterm *argp; + int i; + + argp = p->arg_reg; + for (i = p->arity; --i >= 0;) + reg[i] = argp[i]; + } + { +#if !(NR_ARG_REGS > 5) + Eterm reds_in; +#endif +#if !(NR_ARG_REGS > 4) + Eterm o_reds; +#endif + + reds_in = p->fcalls; + o_reds = 0; + if (ERTS_PROC_GET_SAVED_CALLS_BUF(p)) { + o_reds = reds_in; + reds_in = 0; + p->fcalls = 0; + } + p->def_arg_reg[4] = o_reds; + p->def_arg_reg[5] = reds_in; + if (p->i == hipe_beam_pc_resume) { + p->i = NULL; + p->arity = 0; + goto do_resume; + } + } + HIPE_CHECK_PCB(p); + result = HIPE_MODE_SWITCH_RES_CALL; + p->def_arg_reg[3] = result; + return p; + } + case HIPE_MODE_SWITCH_RES_APPLY: { + Eterm mfa[3], args; + unsigned int arity; + void *address; + + hipe_pop_params(p, 3, &mfa[0]); + + /* Unroll the arglist onto reg[]. */ + args = mfa[2]; + arity = 0; + while (is_list(args)) { + if (arity < 255) { + reg[arity++] = CAR(list_val(args)); + args = CDR(list_val(args)); + } else + goto do_apply_fail; + } + if (is_not_nil(args)) + goto do_apply_fail; + + /* find a native code entry point for {M,F,A} for a remote call */ + address = hipe_get_remote_na(mfa[0], mfa[1], arity); + if (!address) + goto do_apply_fail; + p->hipe.ncallee = (void(*)(void)) address; + result = hipe_tailcall_to_native(p, arity, reg); + goto do_return_from_native; + do_apply_fail: + p->freason = BADARG; + goto do_throw_to_native; + } + default: + erl_exit(1, "hipe_mode_switch: result %#x\r\n", result); + } + HIPE_CHECK_PCB(p); + p->def_arg_reg[3] = result; +#if NR_ARG_REGS > 4 + p->def_arg_reg[4] = o_reds; +#endif +#if NR_ARG_REGS > 5 + p->def_arg_reg[5] = reds_in; +#endif + return p; +} + +#define HIPE_INITIAL_NSTACK_SIZE 128 + +/* PRE: size is zero or a power of two */ +static unsigned hipe_next_nstack_size(unsigned size) +{ + return size ? size * 2 : HIPE_INITIAL_NSTACK_SIZE; +} + +#if 0 && defined(HIPE_NSTACK_GROWS_UP) +#define hipe_nstack_avail(p) ((p)->hipe.nstend - (p)->hipe.nsp) +void hipe_inc_nstack(Process *p) +{ + Eterm *old_nstack = p->hipe.nstack; + unsigned old_size = p->hipe.nstend - old_nstack; + unsigned new_size = hipe_next_nstack_size(old_size); + Eterm *new_nstack = erts_realloc(ERTS_ALC_T_HIPE, + (char *) old_nstack, + new_size*sizeof(Eterm)); + p->hipe.nstend = new_nstack + new_size; + if (new_nstack != old_nstack) { + p->hipe.nsp = new_nstack + (p->hipe.nsp - old_nstack); + p->hipe.nstack = new_nstack; + if (p->hipe.nstgraylim) + p->hipe.nstgraylim = + new_nstack + (p->hipe.nstgraylim - old_nstack); + if (p->hipe.nstblacklim) + p->hipe.nstblacklim = + new_nstack + (p->hipe.nstblacklim - old_nstack); + } +} +#endif + +#if defined(HIPE_NSTACK_GROWS_DOWN) +#define hipe_nstack_avail(p) ((unsigned)((p)->hipe.nsp - (p)->hipe.nstack)) +void hipe_inc_nstack(Process *p) +{ + unsigned old_size = p->hipe.nstend - p->hipe.nstack; + unsigned new_size = hipe_next_nstack_size(old_size); + Eterm *new_nstack = erts_alloc(ERTS_ALC_T_HIPE, new_size*sizeof(Eterm)); + unsigned used_size = p->hipe.nstend - p->hipe.nsp; + + sys_memcpy(new_nstack+new_size-used_size, p->hipe.nsp, used_size*sizeof(Eterm)); + if (p->hipe.nstgraylim) + p->hipe.nstgraylim = new_nstack + new_size - (p->hipe.nstend - p->hipe.nstgraylim); + if (p->hipe.nstblacklim) + p->hipe.nstblacklim = new_nstack + new_size - (p->hipe.nstend - p->hipe.nstblacklim); + if (p->hipe.nstack) + erts_free(ERTS_ALC_T_HIPE, p->hipe.nstack); + p->hipe.nstack = new_nstack; + p->hipe.nstend = new_nstack + new_size; + p->hipe.nsp = new_nstack + new_size - used_size; +} +#endif + +static void hipe_check_nstack(Process *p, unsigned nwords) +{ + while (hipe_nstack_avail(p) < nwords) + hipe_inc_nstack(p); +} + +void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free) +{ + unsigned arity; + + arity = fe->arity; + fe->native_address = (Eterm*) hipe_closure_stub_address(arity); +} + +Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s) +{ + int depth, i; + Uint heap_size; + Eterm *hp, *hp_end, mfa, m, f, head, *next_p, next; + const void *ra; + unsigned int a; + + depth = s->depth; + if (depth < 1) + return NIL; + + heap_size = 6 * depth; /* each [{M,F,A}|_] is 2+4 == 6 words */ + hp = HAlloc(p, heap_size); + hp_end = hp + heap_size; + + head = NIL; + next_p = &head; + + for (i = 0; i < depth; ++i) { + ra = (const void*)s->trace[i]; + if (!hipe_find_mfa_from_ra(ra, &m, &f, &a)) + continue; + mfa = TUPLE3(hp, m, f, make_small(a)); + hp += 4; + next = CONS(hp, mfa, NIL); + *next_p = next; + next_p = &CDR(list_val(next)); + hp += 2; + } + HRelease(p, hp_end, hp); + return head; +} diff --git a/erts/emulator/hipe/hipe_mode_switch.h b/erts/emulator/hipe/hipe_mode_switch.h new file mode 100644 index 0000000000..187b9145e2 --- /dev/null +++ b/erts/emulator/hipe/hipe_mode_switch.h @@ -0,0 +1,66 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_mode_switch.h + */ +#ifndef HIPE_MODE_SWITCH_H +#define HIPE_MODE_SWITCH_H + +/* command codes for beam_emu -> hipe_mode_switch() call */ +#define HIPE_MODE_SWITCH_CMD_CALL 0 +#define HIPE_MODE_SWITCH_CMD_RETURN 1 +#define HIPE_MODE_SWITCH_CMD_THROW 2 +#define HIPE_MODE_SWITCH_CMD_RESUME 3 + +/* result codes for beam_emu <- hipe_mode_switch() return */ +#define HIPE_MODE_SWITCH_RES_RETURN 4 +#define HIPE_MODE_SWITCH_RES_CALL 5 +#define HIPE_MODE_SWITCH_RES_THROW 6 + +/* additional result codes for hipe_mode_switch() <- native return */ +#define HIPE_MODE_SWITCH_RES_SUSPEND 7 +#define HIPE_MODE_SWITCH_RES_WAIT 8 +#define HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT 9 +#define HIPE_MODE_SWITCH_RES_TRAP 10 + +#define HIPE_MODE_SWITCH_CMD_CALL_CLOSURE 11 /* BEAM -> mode_switch */ +#define HIPE_MODE_SWITCH_RES_CALL_CLOSURE 12 /* mode_switch <- native */ + +#define HIPE_MODE_SWITCH_RES_APPLY 13 /* mode_switch <- native */ + +#ifndef ASM + +#include "error.h" + +int hipe_modeswitch_debug; + +void hipe_mode_switch_init(void); +void hipe_set_call_trap(Uint *bfun, void *nfun, int is_closure); +Process *hipe_mode_switch(Process*, unsigned, Eterm*); +void hipe_inc_nstack(Process *p); +void hipe_set_closure_stub(ErlFunEntry *fe, unsigned num_free); +Eterm hipe_build_stacktrace(Process *p, struct StackTrace *s); + +extern Uint hipe_beam_pc_return[]; +extern Uint hipe_beam_pc_throw[]; +extern Uint hipe_beam_pc_resume[]; + +#endif /* ASM */ + +#endif /* HIPE_MODE_SWITCH_H */ diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c new file mode 100644 index 0000000000..f8c2502522 --- /dev/null +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -0,0 +1,590 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_native_bif.c + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include "erl_process.h" +#include "error.h" +#include "bif.h" +#include "erl_bits.h" +#include "erl_binary.h" +#include "hipe_mode_switch.h" +#include "hipe_native_bif.h" +#include "hipe_arch.h" +#include "hipe_stack.h" + +/* + * These are wrappers for BIFs that may trigger a native + * stack walk with p->hipe.narity != 0. + */ + +/* for -Wmissing-prototypes :-( */ +extern Eterm hipe_check_process_code_2(Process*, Eterm, Eterm); +extern Eterm hipe_garbage_collect_1(Process*, Eterm); +extern Eterm hipe_show_nstack_1(Process*, Eterm); + +/* Used when a BIF can trigger a stack walk. */ +static __inline__ void hipe_set_narity(Process *p, unsigned int arity) +{ + p->hipe.narity = arity; +} + +Eterm hipe_check_process_code_2(BIF_ALIST_2) +{ + Eterm ret; + + hipe_set_narity(BIF_P, 2); + ret = check_process_code_2(BIF_P, BIF_ARG_1, BIF_ARG_2); + hipe_set_narity(BIF_P, 0); + return ret; +} + +Eterm hipe_garbage_collect_1(BIF_ALIST_1) +{ + Eterm ret; + + hipe_set_narity(BIF_P, 1); + ret = garbage_collect_1(BIF_P, BIF_ARG_1); + hipe_set_narity(BIF_P, 0); + return ret; +} + +Eterm hipe_show_nstack_1(BIF_ALIST_1) +{ + Eterm ret; + + hipe_set_narity(BIF_P, 1); + ret = hipe_bifs_show_nstack_1(BIF_P, BIF_ARG_1); + hipe_set_narity(BIF_P, 0); + return ret; +} + +/* + * This is called when inlined heap allocation in native code fails. + * The 'need' parameter is the number of heap words needed. + * The value is tagged as a fixnum to avoid untagged data on + * the x86 stack while the gc is running. + */ +void hipe_gc(Process *p, Eterm need) +{ + hipe_set_narity(p, 1); + p->fcalls -= erts_garbage_collect(p, unsigned_val(need), NULL, 0); + hipe_set_narity(p, 0); +} + +/* This is like the OP_setTimeout JAM instruction. + * Transformation to the BEAM instruction wait_timeout_fs + * has begun. + * XXX: BUG: native code should check return status + */ +Eterm hipe_set_timeout(Process *p, Eterm timeout_value) +{ +#if !defined(ARCH_64) + Uint time_val; +#endif + /* XXX: This should be converted to follow BEAM conventions, + * but that requires some compiler changes. + * + * In BEAM, set_timeout saves TWO CP values, and suspends. + * p->def_arg_reg[0] and p->i are both defined and used. + * If a message arrives, BEAM resumes at p->i. + * If a timeout fires, BEAM resumes at p->def_arg_reg[0]. + * (See set_timer() and timeout_proc() in erl_process.c.) + * + * Here we set p->def_arg_reg[0] to hipe_beam_pc_resume. + * Assuming our caller invokes suspend immediately after + * our return, then hipe_mode_switch() will also set + * p->i to hipe_beam_pc_resume. Thus we'll resume in the same + * way regardless of the cause (message or timeout). + * hipe_mode_switch() checks for F_TIMO and returns a + * flag to native code indicating the cause. + */ + + /* + * def_arg_reg[0] is (re)set unconditionally, in case this is the + * 2nd/3rd/... iteration through the receive loop: in order to pass + * a boolean flag to native code indicating timeout or new message, + * our mode switch has to clobber def_arg_reg[0]. This is ok, but if + * we re-suspend (because we ignored a received message) we also have + * to reinitialise def_arg_reg[0] with the BEAM resume label. + * + * XXX: A better solution would be to pass two parameters to + * set_timeout: the timeout and the on-timeout resume label. + * We could put the resume label in def_arg_reg[1] and resume + * at it without having to load a flag in a register and generate + * code to test it. Requires a HiPE compiler change though. + */ + p->def_arg_reg[0] = (Eterm) hipe_beam_pc_resume; + + /* + * If we have already set the timer, we must NOT set it again. Therefore, + * we must test the F_INSLPQUEUE flag as well as the F_TIMO flag. + */ + if (p->flags & (F_INSLPQUEUE | F_TIMO)) + return NIL; /* caller had better call nbif_suspend ASAP! */ + if (is_small(timeout_value) && signed_val(timeout_value) >= 0 && +#if defined(ARCH_64) + (unsigned_val(timeout_value) >> 32) == 0 +#else + 1 +#endif + ) { + set_timer(p, unsigned_val(timeout_value)); + } else if (timeout_value == am_infinity) { + /* p->flags |= F_TIMO; */ /* XXX: nbif_suspend_msg_timeout */ +#if !defined(ARCH_64) + } else if (term_to_Uint(timeout_value, &time_val)) { + set_timer(p, time_val); +#endif + } else { +#ifdef ERTS_SMP + if (p->hipe_smp.have_receive_locks) { + p->hipe_smp.have_receive_locks = 0; + erts_smp_proc_unlock(p, ERTS_PROC_LOCKS_MSG_RECEIVE); + } +#endif + BIF_ERROR(p, EXC_TIMEOUT_VALUE); + } + return NIL; /* caller had better call nbif_suspend ASAP! */ +} + +/* This is like the remove_message BEAM instruction + */ +void hipe_select_msg(Process *p) +{ + ErlMessage *msgp; + + msgp = PEEK_MESSAGE(p); + UNLINK_MESSAGE(p, msgp); /* decrements global 'erts_proc_tot_mem' variable */ + JOIN_MESSAGE(p); + CANCEL_TIMER(p); /* calls erl_cancel_timer() */ + free_message(msgp); +} + +void hipe_fclearerror_error(Process *p) +{ +#if !defined(NO_FPE_SIGNALS) + erts_fp_check_init_error(&p->fp_exception); +#endif +} + +/* Saving a stacktrace from native mode. Right now, we only create a + * minimal struct with no fields filled in except freason. The flag + * EXF_NATIVE is set, so that build_stacktrace (in beam_emu.c) does not + * try to interpret any other field. + */ +static void hipe_save_stacktrace(Process* c_p, Eterm args) +{ + Eterm *hp; + struct StackTrace* s; + int sz; + int depth = erts_backtrace_depth; /* max depth (never negative) */ + + /* Create a container for the exception data. This must be done just + as in the save_stacktrace function in beam_emu.c */ + sz = (offsetof(struct StackTrace, trace) + sizeof(Eterm)*depth + + sizeof(Eterm) - 1) / sizeof(Eterm); + hp = HAlloc(c_p, 2 + 1 + sz); + s = (struct StackTrace *) (hp + 2); + c_p->ftrace = CONS(hp, args, make_big((Eterm *) s)); + s->header = make_pos_bignum_header(sz); + s->current = NULL; + s->pc = NULL; + + s->depth = hipe_fill_stacktrace(c_p, depth, s->trace); + + /* Must mark this as a native-code exception. */ + s->freason = NATIVE_EXCEPTION(c_p->freason); + return; +} + +/* + * hipe_handle_exception() is called from hipe_${ARCH}_glue.S when an + * exception has been thrown, to expand the exception value, set the + * stack trace, and locate the current handler. + */ +void hipe_handle_exception(Process *c_p) +{ + Eterm Value = c_p->fvalue; + Eterm Args = am_true; + + ASSERT(c_p->freason != TRAP); /* Should have been handled earlier. */ + + if (c_p->mbuf) { + erts_printf("%s line %u: p==%p, p->mbuf==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf); + //erts_garbage_collect(c_p, 0, NULL, 0); + } + + /* + * Check if we have an arglist for the top level call. If so, this + * is encoded in Value, so we have to dig out the real Value as well + * as the Arglist. + */ + if (c_p->freason & EXF_ARGLIST) { + Eterm *tp; + ASSERT(is_tuple(Value)); + tp = tuple_val(Value); + Value = tp[1]; + Args = tp[2]; + } + + /* If necessary, build a stacktrace object. */ + if (c_p->freason & EXF_SAVETRACE) + hipe_save_stacktrace(c_p, Args); + + /* Get the fully expanded error term */ + Value = expand_error_value(c_p, c_p->freason, Value); + + /* Save final error term and stabilize the exception flags so no + further expansion is done. */ + c_p->fvalue = Value; + c_p->freason = PRIMARY_EXCEPTION(c_p->freason); + + /* Synthesized to avoid having to generate code for it. */ + c_p->def_arg_reg[0] = exception_tag[GET_EXC_CLASS(c_p->freason)]; + + if (c_p->mbuf) { + //erts_printf("%s line %u: p==%p, p->mbuf==%p, p->lastbif==%p\n", __FUNCTION__, __LINE__, c_p, c_p->mbuf, c_p->hipe.lastbif); + erts_garbage_collect(c_p, 0, NULL, 0); + } + + hipe_find_handler(c_p); +} + +/* This is duplicated from beam_emu.c for now */ +static struct StackTrace *get_trace_from_exc(Eterm exc) +{ + if (exc == NIL) + return NULL; + else + return (struct StackTrace *) big_val(CDR(list_val(exc))); +} + +/* + * This does what the (misnamed) Beam instruction 'raise_ss' does, + * namely, a proper re-throw of an exception that was caught by 'try'. + */ +Eterm hipe_rethrow(Process *c_p, Eterm exc, Eterm value) +{ + c_p->fvalue = value; + if (c_p->freason == EXC_NULL) { + /* a safety check for the R10-0 case; should not happen */ + c_p->ftrace = NIL; + BIF_ERROR(c_p, EXC_ERROR); + } + /* For R10-0 code, 'exc' might be an atom. In that case, just + keep the existing c_p->ftrace. */ + switch (exc) { + case am_throw: + BIF_ERROR(c_p, (EXC_THROWN & ~EXF_SAVETRACE)); + break; + case am_error: + BIF_ERROR(c_p, (EXC_ERROR & ~EXF_SAVETRACE)); + break; + case am_exit: + BIF_ERROR(c_p, (EXC_EXIT & ~EXF_SAVETRACE)); + break; + default: + {/* R10-1 and later + XXX note: should do sanity check on given exception if it can be + passed from a user! Currently only expecting generated calls. + */ + struct StackTrace *s; + c_p->ftrace = exc; + s = get_trace_from_exc(exc); + if (s == NULL) { + BIF_ERROR(c_p, EXC_ERROR); + } else { + BIF_ERROR(c_p, PRIMARY_EXCEPTION(s->freason)); + } + } + } +} + +/* + * Support for compiled binary syntax operations. + */ + +char *hipe_bs_allocate(int len) +{ + Binary *bptr; + + bptr = erts_bin_nrml_alloc(len); + bptr->flags = 0; + bptr->orig_size = len; + erts_smp_atomic_init(&bptr->refc, 1); + return bptr->orig_bytes; +} + +Binary *hipe_bs_reallocate(Binary* oldbptr, int newsize) +{ + Binary *bptr; + + bptr = erts_bin_realloc(oldbptr, newsize); + bptr->orig_size = newsize; + return bptr; +} + +int hipe_bs_put_big_integer( +#ifdef ERTS_SMP + Process *p, +#endif + Eterm arg, Uint num_bits, byte* base, unsigned offset, unsigned flags) +{ + byte *save_bin_buf; + Uint save_bin_offset; + int res; + ERL_BITS_DEFINE_STATEP(p); + + save_bin_buf = erts_current_bin; + save_bin_offset = erts_bin_offset; + erts_current_bin = base; + erts_bin_offset = offset; + res = erts_new_bs_put_integer(ERL_BITS_ARGS_3(arg, num_bits, flags)); + erts_current_bin = save_bin_buf; + erts_bin_offset = save_bin_offset; + return res; +} + +int hipe_bs_put_small_float( + Process *p, + Eterm arg, Uint num_bits, byte* base, unsigned offset, unsigned flags) +{ + byte *save_bin_buf; + Uint save_bin_offset; + int res; + ERL_BITS_DEFINE_STATEP(p); + + save_bin_buf = erts_current_bin; + save_bin_offset = erts_bin_offset; + erts_current_bin = base; + erts_bin_offset = offset; + res = erts_new_bs_put_float(p, arg, num_bits, flags); + erts_current_bin = save_bin_buf; + erts_bin_offset = save_bin_offset; + return res; +} + +void hipe_bs_put_bits( + Eterm arg, Uint num_bits, byte* base, unsigned offset, unsigned flags) +{ + Uint Bitoffs, Bitsize; + byte *Bytep; + + ERTS_GET_BINARY_BYTES(arg, Bytep, Bitoffs, Bitsize); + erts_copy_bits(Bytep, Bitoffs, 1, base, offset, 1, num_bits); +} + +Eterm hipe_bs_utf8_size(Eterm arg) +{ + /* See beam_emu.c:OpCase(i_bs_utf8_size_sd): error handling + is delayed to the subsequent put_utf8 operation. */ + if (arg < make_small(0x80UL)) + return make_small(1); + else if (arg < make_small(0x800UL)) + return make_small(2); + else if (arg < make_small(0x10000UL)) + return make_small(3); + else + return make_small(4); +} + +Eterm hipe_bs_put_utf8(Process *p, Eterm arg, byte *base, unsigned int offset) +{ + byte *save_bin_buf; + Uint save_bin_offset; + int res; + unsigned int new_offset; + ERL_BITS_DEFINE_STATEP(p); + + save_bin_buf = erts_current_bin; + save_bin_offset = erts_bin_offset; + erts_current_bin = base; + erts_bin_offset = offset; + res = erts_bs_put_utf8(ERL_BITS_ARGS_1(arg)); + new_offset = erts_bin_offset; + erts_current_bin = save_bin_buf; + erts_bin_offset = save_bin_offset; + if (res == 0) + BIF_ERROR(p, BADARG); + return new_offset; +} + +Eterm hipe_bs_utf16_size(Eterm arg) +{ + /* See beam_emu.c:OpCase(i_bs_utf16_size_sd): error handling + is delayed to the subsequent put_utf16 operation. */ + if (arg >= make_small(0x10000UL)) + return make_small(4); + else + return make_small(2); +} + +/* This would have used standard_bif_interface_4, which doesn't exist. + * Instead we call it via wrappers for the two relevant cases: + * (flags & BSF_LITTLE) != 0 and (flags & BSF_LITTLE) == 0. + */ +static +Eterm hipe_bs_put_utf16(Process *p, Eterm arg, byte *base, unsigned int offset, Uint flags) +{ + byte *save_bin_buf; + Uint save_bin_offset; + int res; + unsigned int new_offset; + ERL_BITS_DEFINE_STATEP(p); + + save_bin_buf = erts_current_bin; + save_bin_offset = erts_bin_offset; + erts_current_bin = base; + erts_bin_offset = offset; + res = erts_bs_put_utf16(ERL_BITS_ARGS_2(arg, flags)); + new_offset = erts_bin_offset; + erts_current_bin = save_bin_buf; + erts_bin_offset = save_bin_offset; + if (res == 0) + BIF_ERROR(p, BADARG); + return new_offset; +} + +Eterm hipe_bs_put_utf16be(Process *p, Eterm arg, byte *base, unsigned int offset) +{ + return hipe_bs_put_utf16(p, arg, base, offset, 0); +} + +Eterm hipe_bs_put_utf16le(Process *p, Eterm arg, byte *base, unsigned int offset) +{ + return hipe_bs_put_utf16(p, arg, base, offset, BSF_LITTLE); +} + +static int validate_unicode(Eterm arg) +{ + if (is_not_small(arg) || + arg > make_small(0x10FFFFUL) || + (make_small(0xD800UL) <= arg && arg <= make_small(0xDFFFUL)) || + arg == make_small(0xFFFEUL) || + arg == make_small(0xFFFFUL)) + return 0; + return 1; +} + +Eterm hipe_bs_validate_unicode(Process *p, Eterm arg) +{ + if (!validate_unicode(arg)) + BIF_ERROR(p, BADARG); + return NIL; +} + +int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg) +{ + if (!validate_unicode(arg)) { + mb->offset -= 32; + return 0; + } + return 1; +} + +/* This is like the loop_rec_fr BEAM instruction + */ +Eterm hipe_check_get_msg(Process *c_p) +{ + Eterm ret; + ErlMessage *msgp; + + next_message: + + msgp = PEEK_MESSAGE(c_p); + + if (!msgp) { +#ifdef ERTS_SMP + erts_smp_proc_lock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + /* Make sure messages wont pass exit signals... */ + if (ERTS_PROC_PENDING_EXIT(c_p)) { + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + return THE_NON_VALUE; /* Will be rescheduled for exit */ + } + ERTS_SMP_MSGQ_MV_INQ2PRIVQ(c_p); + msgp = PEEK_MESSAGE(c_p); + if (msgp) + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + else { + /* XXX: BEAM doesn't need this */ + c_p->hipe_smp.have_receive_locks = 1; +#endif + return THE_NON_VALUE; +#ifdef ERTS_SMP + } +#endif + } + ErtsMoveMsgAttachmentIntoProc(msgp, c_p, c_p->stop, HEAP_TOP(c_p), + c_p->fcalls, (void) 0, (void) 0); + ret = ERL_MESSAGE_TERM(msgp); + if (is_non_value(ret)) { + /* + * A corrupt distribution message that we weren't able to decode; + * remove it... + */ + ASSERT(!msgp->data.attached); + UNLINK_MESSAGE(c_p, msgp); + free_message(msgp); + goto next_message; + } + return ret; +} + +/* + * SMP-specific stuff + */ +#ifdef ERTS_SMP + +/* + * This is like the timeout BEAM instruction. + */ +void hipe_clear_timeout(Process *c_p) +{ + /* + * A timeout has occurred. Reset the save pointer so that the next + * receive statement will examine the first message first. + */ +#ifdef ERTS_SMP + /* XXX: BEAM has different entries for the locked and unlocked + cases. HiPE doesn't, so we must check dynamically. */ + if (c_p->hipe_smp.have_receive_locks) { + c_p->hipe_smp.have_receive_locks = 0; + erts_smp_proc_unlock(c_p, ERTS_PROC_LOCKS_MSG_RECEIVE); + } +#endif + if (IS_TRACED_FL(c_p, F_TRACE_RECEIVE)) { + trace_receive(c_p, am_timeout); + } + c_p->flags &= ~F_TIMO; + JOIN_MESSAGE(c_p); +} + +void hipe_atomic_inc(int *counter) +{ + erts_smp_atomic_inc((erts_smp_atomic_t*)counter); +} + +#endif diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h new file mode 100644 index 0000000000..3b55b64a41 --- /dev/null +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -0,0 +1,121 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_native_bif.h + */ + +#ifndef HIPE_NATIVE_BIF_H +#define HIPE_NATIVE_BIF_H + +#include "hipe_arch.h" + +/* + * Prototypes for entry points used by native code. + */ +AEXTERN(Eterm,nbif_callemu,(void)); +AEXTERN(int,nbif_suspend_0,(void)); /* caller ignores retval */ +AEXTERN(int,nbif_suspend_msg,(void)); +AEXTERN(int,nbif_suspend_msg_timeout,(void)); + +AEXTERN(Eterm,nbif_rethrow,(Process*, Eterm, Eterm)); +AEXTERN(Eterm,nbif_set_timeout,(Process*, Eterm)); + +AEXTERN(Eterm,nbif_gc_1,(void)); + +AEXTERN(Eterm,nbif_apply,(void)); +AEXTERN(Eterm,nbif_find_na_or_make_stub,(void)); +AEXTERN(Eterm,nbif_nonclosure_address,(void)); + +AEXTERN(Eterm,nbif_add_2,(void)); +AEXTERN(Eterm,nbif_sub_2,(void)); +AEXTERN(Eterm,nbif_mul_2,(void)); + +AEXTERN(Eterm,nbif_conv_big_to_float,(void)); +AEXTERN(void,nbif_fclearerror_error,(Process*)); + +AEXTERN(int,nbif_bs_put_big_integer,(void)); +AEXTERN(int,nbif_bs_put_small_float,(void)); +AEXTERN(void,nbif_bs_put_bits,(void)); +AEXTERN(Eterm,nbif_bs_get_integer_2,(void)); +AEXTERN(Eterm,nbif_bs_get_float_2,(void)); +AEXTERN(Eterm,nbif_bs_get_binary_2,(void)); +AEXTERN(char*,nbif_bs_allocate,(void)); +AEXTERN(Binary*,nbif_bs_reallocate,(void)); +AEXTERN(Eterm,nbif_bs_utf8_size,(Eterm)); +AEXTERN(Eterm,nbif_bs_put_utf8,(Process*,Eterm,byte*,unsigned int)); +AEXTERN(Eterm,nbif_bs_get_utf8,(void)); +AEXTERN(Eterm,nbif_bs_utf16_size,(Eterm)); +AEXTERN(Eterm,nbif_bs_put_utf16be,(Process*,Eterm,byte*,unsigned int)); +AEXTERN(Eterm,nbif_bs_put_utf16le,(Process*,Eterm,byte*,unsigned int)); +AEXTERN(Eterm,nbif_bs_get_utf16,(void)); +AEXTERN(Eterm,nbif_bs_validate_unicode,(Process*,Eterm)); +AEXTERN(Eterm,nbif_bs_validate_unicode_retract,(void)); + +AEXTERN(void,nbif_select_msg,(Process*)); +AEXTERN(Eterm,nbif_cmp_2,(void)); +AEXTERN(Eterm,nbif_eq_2,(void)); + +Eterm hipe_nonclosure_address(Process*, Eterm, Uint); +Eterm hipe_conv_big_to_float(Process*, Eterm); +void hipe_fclearerror_error(Process*); +void hipe_select_msg(Process*); +void hipe_gc(Process*, Eterm); +Eterm hipe_set_timeout(Process*, Eterm); +void hipe_handle_exception(Process*); +Eterm hipe_rethrow(Process *c_p, Eterm exc, Eterm value); +char *hipe_bs_allocate(int); +Binary *hipe_bs_reallocate(Binary*, int); +int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned); +void hipe_bs_put_bits(Eterm, Uint, byte*, unsigned, unsigned); +Eterm hipe_bs_utf8_size(Eterm); +Eterm hipe_bs_put_utf8(Process*, Eterm, byte*, unsigned int); +Eterm hipe_bs_utf16_size(Eterm); +Eterm hipe_bs_put_utf16be(Process*, Eterm, byte*, unsigned int); +Eterm hipe_bs_put_utf16le(Process*, Eterm, byte*, unsigned int); +Eterm hipe_bs_validate_unicode(Process*, Eterm); +struct erl_bin_match_buffer; +int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm); + +/* + * Stuff that is different in SMP and non-SMP. + */ +#ifdef ERTS_SMP +int hipe_bs_put_big_integer(Process*, Eterm, Uint, byte*, unsigned, unsigned); +#else +int hipe_bs_put_big_integer(Eterm, Uint, byte*, unsigned, unsigned); +#endif + +AEXTERN(Eterm,nbif_check_get_msg,(Process*)); +Eterm hipe_check_get_msg(Process*); + +/* + * SMP-specific stuff + */ +#ifdef ERTS_SMP +AEXTERN(void,nbif_atomic_inc,(void)); +AEXTERN(void,nbif_clear_timeout,(Process*)); +void hipe_atomic_inc(int*); +void hipe_clear_timeout(Process*); +#endif + +#define BIF_LIST(M,F,A,C,I) AEXTERN(Eterm,nbif_##C,(void)); +#include "erl_bif_list.h" +#undef BIF_LIST + +#endif /* HIPE_NATIVE_BIF_H */ diff --git a/erts/emulator/hipe/hipe_ops.tab b/erts/emulator/hipe/hipe_ops.tab new file mode 100644 index 0000000000..eb6f824d1c --- /dev/null +++ b/erts/emulator/hipe/hipe_ops.tab @@ -0,0 +1,25 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +hipe_trap_call +hipe_trap_call_closure +hipe_trap_return +hipe_trap_throw +hipe_trap_resume +hipe_call_count diff --git a/erts/emulator/hipe/hipe_perfctr.c b/erts/emulator/hipe/hipe_perfctr.c new file mode 100644 index 0000000000..69bb648854 --- /dev/null +++ b/erts/emulator/hipe/hipe_perfctr.c @@ -0,0 +1,229 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "sys.h" +#include "error.h" +#include "global.h" +#include "bif.h" +#include "big.h" +#include "erl_binary.h" +#include "hipe_perfctr.h" +#include "libperfctr.h" + +static struct vperfctr *vperfctr; +static unsigned int have_rdtsc; +static double tsc_to_ms; +static unsigned int tsc_on; /* control calls must set tsc_on if have_rdtsc is true */ +static unsigned int nractrs; +static unsigned int users; +#define USER_BIFS (1<<0) +#define USER_HRVTIME (1<<1) + +static int hipe_perfctr_open(unsigned int user) +{ + struct perfctr_info info; + + if (!vperfctr) { + vperfctr = vperfctr_open(); + if (!vperfctr) + return -1; + if (vperfctr_info(vperfctr, &info) >= 0) { + tsc_to_ms = (double)(info.tsc_to_cpu_mult ? : 1) / (double)info.cpu_khz; + have_rdtsc = (info.cpu_features & PERFCTR_FEATURE_RDTSC) ? 1 : 0; + } + tsc_on = 0; + nractrs = 0; + } + users |= user; + return 0; +} + +static void hipe_perfctr_reset(void) +{ + struct vperfctr_control control; + + memset(&control, 0, sizeof control); + if (have_rdtsc) + control.cpu_control.tsc_on = 1; + nractrs = 0; + if (vperfctr_control(vperfctr, &control) >= 0) + tsc_on = 1; +} + +static void hipe_perfctr_close(unsigned int user) +{ + if (!vperfctr) + return; + users &= ~user; + switch (users) { + case 0: + vperfctr_unlink(vperfctr); + vperfctr_close(vperfctr); + vperfctr = NULL; + tsc_on = 0; + nractrs = 0; + break; + case USER_HRVTIME: + hipe_perfctr_reset(); + } +} + +/* + * Interface for HiPE's hrvtime code. + */ + +int hipe_perfctr_hrvtime_open(void) +{ + if (hipe_perfctr_open(USER_HRVTIME) < 0) + return -1; + if (have_rdtsc) { + if (!tsc_on) + hipe_perfctr_reset(); /* note: updates tsc_on */ + if (tsc_on) + return 0; + } + hipe_perfctr_hrvtime_close(); + return -1; +} + +void hipe_perfctr_hrvtime_close(void) +{ + hipe_perfctr_close(USER_HRVTIME); +} + +double hipe_perfctr_hrvtime_get(void) +{ + return (double)vperfctr_read_tsc(vperfctr) * tsc_to_ms; +} + +/* + * BIF interface for user-programmable performance counters. + */ + +BIF_RETTYPE hipe_bifs_vperfctr_open_0(BIF_ALIST_0) +{ + if (hipe_perfctr_open(USER_BIFS) < 0) + BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */ + BIF_RET(am_true); +} + +BIF_RETTYPE hipe_bifs_vperfctr_close_0(BIF_ALIST_0) +{ + hipe_perfctr_close(USER_BIFS); + BIF_RET(NIL); +} + +static Eterm ull_to_integer(unsigned long long x, Process *p) +{ + unsigned long long tmpx; + unsigned int ds, i; + size_t sz; + Eterm *hp; + ErtsDigit *xp; + + if (x <= (unsigned long long)MAX_SMALL) + return make_small(x); + + /* Calculate number of digits. */ + ds = 0; + tmpx = x; + do { + ++ds; + tmpx = (tmpx >> (D_EXP / 2)) >> (D_EXP / 2); + } while (tmpx != 0); + + sz = BIG_NEED_SIZE(ds); /* number of words including arity */ + hp = HAlloc(p, sz); + *hp = make_pos_bignum_header(sz-1); + + xp = (ErtsDigit*)(hp+1); + i = 0; + do { + xp[i++] = (ErtsDigit)x; + x = (x >> (D_EXP / 2)) >> (D_EXP / 2); + } while (i < ds); + while (i & (BIG_DIGITS_PER_WORD-1)) + xp[i++] = 0; + + return make_big(hp); +} + +BIF_RETTYPE hipe_bifs_vperfctr_info_0(BIF_ALIST_0) +{ + struct perfctr_info info; + + if (!vperfctr || vperfctr_info(vperfctr, &info) < 0) + BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */ + BIF_RET(new_binary(BIF_P, (void*)&info, sizeof info)); +} + +BIF_RETTYPE hipe_bifs_vperfctr_read_tsc_0(BIF_ALIST_0) +{ + unsigned long long val; + + if (!vperfctr || !tsc_on) + BIF_RET(am_false); /* arity 0 BIFs can't fail :-( */ + val = vperfctr_read_tsc(vperfctr); + BIF_RET(ull_to_integer(val, BIF_P)); +} + +BIF_RETTYPE hipe_bifs_vperfctr_read_pmc_1(BIF_ALIST_1) +{ + Uint pmc; + unsigned long long val; + + if (!vperfctr || + is_not_small(BIF_ARG_1) || + (pmc = unsigned_val(BIF_ARG_1), pmc >= nractrs)) + BIF_RET(am_false); /* for consistency with the arity 0 BIFs */ + val = vperfctr_read_pmc(vperfctr, pmc); + BIF_RET(ull_to_integer(val, BIF_P)); +} + +BIF_RETTYPE hipe_bifs_vperfctr_control_1(BIF_ALIST_1) +{ + void *bytes; + struct vperfctr_control control; + Uint bitoffs; + Uint bitsize; + + if (!vperfctr) + BIF_ERROR(BIF_P, BADARG); + if (is_not_binary(BIF_ARG_1)) + BIF_ERROR(BIF_P, BADARG); + if (binary_size(BIF_ARG_1) != sizeof control) + BIF_ERROR(BIF_P, BADARG); + ERTS_GET_BINARY_BYTES(BIF_ARG_1, bytes, bitoffs, bitsize); + ASSERT(bitoffs == 0); + ASSERT(bitsize == 0); + memcpy(&control, bytes, sizeof control); + if (have_rdtsc) + control.cpu_control.tsc_on = 1; + if (vperfctr_control(vperfctr, &control) < 0) { + hipe_perfctr_reset(); + BIF_ERROR(BIF_P, BADARG); + } + tsc_on = control.cpu_control.tsc_on; + nractrs = control.cpu_control.nractrs; + BIF_RET(NIL); +} diff --git a/erts/emulator/hipe/hipe_perfctr.h b/erts/emulator/hipe/hipe_perfctr.h new file mode 100644 index 0000000000..7b20c68cac --- /dev/null +++ b/erts/emulator/hipe/hipe_perfctr.h @@ -0,0 +1,24 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ + +extern int hipe_perfctr_hrvtime_open(void); +extern void hipe_perfctr_hrvtime_close(void); +extern double hipe_perfctr_hrvtime_get(void); diff --git a/erts/emulator/hipe/hipe_perfctr.tab b/erts/emulator/hipe/hipe_perfctr.tab new file mode 100644 index 0000000000..663522f85e --- /dev/null +++ b/erts/emulator/hipe/hipe_perfctr.tab @@ -0,0 +1,26 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# $Id$ + +bif hipe_bifs:vperfctr_open/0 +bif hipe_bifs:vperfctr_close/0 +bif hipe_bifs:vperfctr_info/0 +bif hipe_bifs:vperfctr_read_tsc/0 +bif hipe_bifs:vperfctr_read_pmc/1 +bif hipe_bifs:vperfctr_control/1 diff --git a/erts/emulator/hipe/hipe_ppc.c b/erts/emulator/hipe/hipe_ppc.c new file mode 100644 index 0000000000..3a0beedb68 --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc.c @@ -0,0 +1,487 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#include /* offsetof() */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" +#include "erl_binary.h" +#include + +#include "hipe_arch.h" +#include "hipe_native_bif.h" /* nbif_callemu() */ +#include "hipe_bif0.h" + +#if !defined(__powerpc64__) +const unsigned int fconv_constant[2] = { 0x43300000, 0x80000000 }; +#endif + +/* Flush dcache and invalidate icache for a range of addresses. */ +void hipe_flush_icache_range(void *address, unsigned int nbytes) +{ + const unsigned int L1_CACHE_SHIFT = 5; + const unsigned long L1_CACHE_BYTES = 1 << L1_CACHE_SHIFT; + unsigned long start, p; + unsigned int nlines, n; + + if (!nbytes) + return; + + start = (unsigned long)address & ~(L1_CACHE_BYTES-1); + nlines = + (((unsigned long)address & (L1_CACHE_BYTES-1)) + + nbytes + + (L1_CACHE_BYTES-1)) >> L1_CACHE_SHIFT; + + p = start; + n = nlines; + do { + asm volatile("dcbst 0,%0" : : "r"(p) : "memory"); + p += L1_CACHE_BYTES; + } while (--n != 0); + asm volatile("sync"); + p = start; + n = nlines; + do { + asm volatile("icbi 0,%0" : : "r"(p) : "memory"); + p += L1_CACHE_BYTES; + } while (--n != 0); + asm volatile("sync\n\tisync"); +} + +/* + * Management of 32MB code segments for regular code and trampolines. + */ + +#define SEGMENT_NRBYTES (32*1024*1024) /* named constant, _not_ a tunable */ + +static struct segment { + unsigned int *base; /* [base,base+32MB[ */ + unsigned int *code_pos; /* INV: base <= code_pos <= tramp_pos */ + unsigned int *tramp_pos; /* INV: tramp_pos <= base+32MB */ +} curseg; + +#define in_area(ptr,start,nbytes) \ + ((unsigned long)((char*)(ptr) - (char*)(start)) < (nbytes)) + +/* Darwin breakage */ +#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) +#define MAP_ANONYMOUS MAP_ANON +#endif + +#if defined(__powerpc64__) +static void *new_code_mapping(void) +{ + char *map_hint, *map_start; + + /* + * Allocate a new 32MB code segment in the low 2GB of the address space. + * + * This is problematic for several reasons: + * - Linux/ppc64 lacks the MAP_32BIT flag that Linux/x86-64 has. + * - The address space hint to mmap is only respected if that + * area is available. If it isn't, then mmap falls back to its + * defaults, which (according to testing) results in very high + * (and thus useless for us) addresses being returned. + * - Another mapping, presumably the brk, also occupies low addresses. + * + * As initial implementation, simply start allocating at the 0.5GB + * boundary. This leaves plenty of space for the brk before malloc + * needs to switch to mmap, while allowing for 1.5GB of code. + * + * A more robust implementation would be to parse /proc/self/maps, + * reserve all available space between (say) 0.5GB and 2GB with + * PROT_NONE MAP_NORESERVE mappings, and then allocate by releasing + * 32MB segments and re-mapping them properly. This would work on + * Linux/ppc64, I have no idea how things should be done on Darwin64. + */ + if (curseg.base) + map_hint = (char*)curseg.base + SEGMENT_NRBYTES; + else + map_hint = (char*)(512*1024*1024); /* 0.5GB */ + map_start = mmap(map_hint, SEGMENT_NRBYTES, + PROT_EXEC|PROT_READ|PROT_WRITE, + MAP_PRIVATE|MAP_ANONYMOUS, + -1, 0); + if (map_start != MAP_FAILED && + (((unsigned long)map_start + (SEGMENT_NRBYTES-1)) & ~0x7FFFFFFFUL)) { + fprintf(stderr, "mmap with hint %p returned code memory %p\r\n", map_hint, map_start); + abort(); + } + return map_start; +} +#else +static void *new_code_mapping(void) +{ + return mmap(0, SEGMENT_NRBYTES, + PROT_EXEC|PROT_READ|PROT_WRITE, + MAP_PRIVATE|MAP_ANONYMOUS, + -1, 0); +} +#endif + +static int check_callees(Eterm callees) +{ + Eterm *tuple; + Uint arity; + Uint i; + + if (is_not_tuple(callees)) + return -1; + tuple = tuple_val(callees); + arity = arityval(tuple[0]); + for (i = 1; i <= arity; ++i) { + Eterm mfa = tuple[i]; + if (is_not_tuple(mfa) || + tuple_val(mfa)[0] != make_arityval(3) || + is_not_atom(tuple_val(mfa)[1]) || + is_not_atom(tuple_val(mfa)[2]) || + is_not_small(tuple_val(mfa)[3]) || + unsigned_val(tuple_val(mfa)[3]) > 255) + return -1; + } + return arity; +} + +static unsigned int *try_alloc(Uint nrwords, int nrcallees, Eterm callees, unsigned int **trampvec) +{ + unsigned int *base, *address, *tramp_pos, nrfreewords; + int trampnr; + + tramp_pos = curseg.tramp_pos; + address = curseg.code_pos; + nrfreewords = tramp_pos - address; + if (nrwords > nrfreewords) + return NULL; + curseg.code_pos = address + nrwords; + nrfreewords -= nrwords; + + base = curseg.base; + for (trampnr = 1; trampnr <= nrcallees; ++trampnr) { + Eterm mfa = tuple_val(callees)[trampnr]; + Eterm m = tuple_val(mfa)[1]; + Eterm f = tuple_val(mfa)[2]; + unsigned int a = unsigned_val(tuple_val(mfa)[3]); + unsigned int *trampoline = hipe_mfa_get_trampoline(m, f, a); + if (!in_area(trampoline, base, SEGMENT_NRBYTES)) { + if (nrfreewords < 4) + return NULL; + nrfreewords -= 4; + tramp_pos = trampoline = tramp_pos - 4; +#if defined(__powerpc64__) + trampoline[0] = 0x3D600000; /* addis r11,0,0 */ + trampoline[1] = 0x616B0000; /* ori r11,r11,0 */ +#else + trampoline[0] = 0x39600000; /* addi r11,r0,0 */ + trampoline[1] = 0x3D6B0000; /* addis r11,r11,0 */ +#endif + trampoline[2] = 0x7D6903A6; /* mtctr r11 */ + trampoline[3] = 0x4E800420; /* bctr */ + hipe_flush_icache_range(trampoline, 4*sizeof(int)); + hipe_mfa_set_trampoline(m, f, a, trampoline); + } + trampvec[trampnr-1] = trampoline; + } + curseg.tramp_pos = tramp_pos; + return address; +} + +void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p) +{ + Uint nrwords; + int nrcallees; + Eterm trampvecbin; + unsigned int **trampvec; + unsigned int *address; + unsigned int *base; + struct segment oldseg; + + if (nrbytes & 0x3) + return NULL; + nrwords = nrbytes >> 2; + + nrcallees = check_callees(callees); + if (nrcallees < 0) + return NULL; + trampvecbin = new_binary(p, NULL, nrcallees*sizeof(unsigned int*)); + trampvec = (unsigned int**)binary_bytes(trampvecbin); + + address = try_alloc(nrwords, nrcallees, callees, trampvec); + if (!address) { + base = new_code_mapping(); + if (base == MAP_FAILED) + return NULL; + oldseg = curseg; + curseg.base = base; + curseg.code_pos = base; + curseg.tramp_pos = (unsigned int*)((char*)base + SEGMENT_NRBYTES); + + address = try_alloc(nrwords, nrcallees, callees, trampvec); + if (!address) { + munmap(base, SEGMENT_NRBYTES); + curseg = oldseg; + return NULL; + } + /* commit to new segment, ignore leftover space in old segment */ + } + *trampolines = trampvecbin; + return address; +} + +static unsigned int *alloc_stub(Uint nrwords) +{ + unsigned int *address; + unsigned int *base; + struct segment oldseg; + + address = try_alloc(nrwords, 0, NIL, NULL); + if (!address) { + base = new_code_mapping(); + if (base == MAP_FAILED) + return NULL; + oldseg = curseg; + curseg.base = base; + curseg.code_pos = base; + curseg.tramp_pos = (unsigned int*)((char*)base + SEGMENT_NRBYTES); + + address = try_alloc(nrwords, 0, NIL, NULL); + if (!address) { + munmap(base, SEGMENT_NRBYTES); + curseg = oldseg; + return NULL; + } + /* commit to new segment, ignore leftover space in old segment */ + } + return address; +} + +static void patch_imm16(Uint32 *address, unsigned int imm16) +{ + unsigned int insn = *address; + *address = (insn & ~0xFFFF) | (imm16 & 0xFFFF); + hipe_flush_icache_word(address); +} + +#if defined(__powerpc64__) +static void patch_li64(Uint32 *address, Uint64 value) +{ + patch_imm16(address+0, value >> 48);/* addis r,0,value@highest */ + patch_imm16(address+1, value >> 32);/* ori r,r,value@higher */ + /* sldi r,r,32 */ + patch_imm16(address+3, value >> 16);/* oris r,r,value@h */ + patch_imm16(address+4, value); /* ori r,r,value@l */ +} + +static int patch_li31(Uint32 *address, Uint32 value) +{ + if ((value >> 31) != 0) + return -1; + patch_imm16(address, value >> 16); /* addis r,0,value@h */ + patch_imm16(address+1, value); /* ori r,r,value@l */ +} + +void hipe_patch_load_fe(Uint *address, Uint value) +{ + patch_li64((Uint32*)address, value); +} + +int hipe_patch_insn(void *address, Uint64 value, Eterm type) +{ + switch (type) { + case am_closure: + case am_constant: + patch_li64((Uint32*)address, value); + return 0; + case am_atom: + case am_c_const: + return patch_li31((Uint32*)address, value); + default: + return -1; + } +} + +void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +{ + unsigned int *code; + + if ((unsigned long)&nbif_callemu & ~0x01FFFFFCUL) + abort(); + + code = alloc_stub(7); + + /* addis r12,0,beamAddress@highest */ + code[0] = 0x3d800000 | (((unsigned long)beamAddress >> 48) & 0xffff); + /* ori r12,r12,beamAddress@higher */ + code[1] = 0x618c0000 | (((unsigned long)beamAddress >> 32) & 0xffff); + /* sldi r12,r12,32 (rldicr r12,r12,32,31) */ + code[2] = 0x798c07c6; + /* oris r12,r12,beamAddress@h */ + code[3] = 0x658c0000 | (((unsigned long)beamAddress >> 16) & 0xffff); + /* ori r12,r12,beamAddress@l */ + code[4] = 0x618c0000 | ((unsigned long)beamAddress & 0xffff); + /* addi r0,0,beamArity */ + code[5] = 0x38000000 | (beamArity & 0x7FFF); + /* ba nbif_callemu */ + code[6] = 0x48000002 | (unsigned long)&nbif_callemu; + + hipe_flush_icache_range(code, 7*sizeof(int)); + + return code; +} +#else /* !__powerpc64__ */ +/* + * To load a 32-bit immediate value 'val' into Rd (Rd != R0): + * + * addi Rd, 0, val@l // val & 0xFFFF + * addis Rd, Rd, val@ha // ((val + 0x8000) >> 16) & 0xFFFF + * + * The first addi sign-extends the low 16 bits, so if + * val&(1<<15), the high portion of Rd will be -1 not 0. + * val@ha compensates by adding 1 if val&(1<<15). + */ +static unsigned int at_ha(unsigned int val) +{ + return ((val + 0x8000) >> 16) & 0xFFFF; +} + +static void patch_li(Uint32 *address, Uint32 value) +{ + patch_imm16(address, value); + patch_imm16(address+1, at_ha(value)); +} + +void hipe_patch_load_fe(Uint32 *address, Uint value) +{ + patch_li(address, value); +} + +int hipe_patch_insn(void *address, Uint32 value, Eterm type) +{ + switch (type) { + case am_closure: + case am_constant: + case am_atom: + case am_c_const: + break; + default: + return -1; + } + patch_li((Uint32*)address, value); + return 0; +} + +/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() + and hipe_bif0.c:hipe_make_stub() */ +void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +{ + unsigned int *code; + + /* + * Native code calls BEAM via a stub looking as follows: + * + * addi r12,0,beamAddress@l + * addi r0,0,beamArity + * addis r12,r12,beamAddress@ha + * ba nbif_callemu + * + * I'm using r0 and r12 since the standard SVR4 ABI allows + * them to be modified during function linkage. Trampolines + * (for b/bl to distant targets) may modify r11. + * + * The runtime system code is linked completely below the + * 32MB address boundary. Hence the branch to nbif_callemu + * is done with a 'ba' instruction. + */ + + /* verify that 'ba' can reach nbif_callemu */ + if ((unsigned long)&nbif_callemu & ~0x01FFFFFCUL) + abort(); + + code = alloc_stub(4); + + /* addi r12,0,beamAddress@l */ + code[0] = 0x39800000 | ((unsigned long)beamAddress & 0xFFFF); + /* addi r0,0,beamArity */ + code[1] = 0x38000000 | (beamArity & 0x7FFF); + /* addis r12,r12,beamAddress@ha */ + code[2] = 0x3D8C0000 | at_ha((unsigned long)beamAddress); + /* ba nbif_callemu */ + code[3] = 0x48000002 | (unsigned long)&nbif_callemu; + + hipe_flush_icache_range(code, 4*sizeof(int)); + + return code; +} +#endif /* !__powerpc64__ */ + +static void patch_b(Uint32 *address, Sint32 offset, Uint32 AA) +{ + Uint32 oldI = *address; + Uint32 newI = (oldI & 0xFC000001) | ((offset & 0x00FFFFFF) << 2) | (AA & 2); + *address = newI; + hipe_flush_icache_word(address); +} + +int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline) +{ + if ((Uint32)destAddress == ((Uint32)destAddress & 0x01FFFFFC)) { + /* The destination is in the [0,32MB[ range. + We can reach it with a ba/bla instruction. + This is the typical case for BIFs and primops. + It's also common for trap-to-BEAM stubs (on ppc32). */ + patch_b((Uint32*)callAddress, (Uint32)destAddress >> 2, 2); + } else { + Sint32 destOffset = ((Sint32)destAddress - (Sint32)callAddress) >> 2; + if (destOffset >= -0x800000 && destOffset <= 0x7FFFFF) { + /* The destination is within a [-32MB,+32MB[ range from us. + We can reach it with a b/bl instruction. + This is typical for nearby Erlang code. */ + patch_b((Uint32*)callAddress, destOffset, 0); + } else { + /* The destination is too distant for b/bl/ba/bla. + Must do a b/bl to the trampoline. */ + Sint32 trampOffset = ((Sint32)trampoline - (Sint32)callAddress) >> 2; + if (trampOffset >= -0x800000 && trampOffset <= 0x7FFFFF) { + /* Update the trampoline's address computation. + (May be redundant, but we can't tell.) */ +#if defined(__powerpc64__) + /* This relies on the fact that we allocate code below 2GB. */ + patch_li31((Uint32*)trampoline, (Uint32)destAddress); +#else + patch_li((Uint32*)trampoline, (Uint32)destAddress); +#endif + /* Update this call site. */ + patch_b((Uint32*)callAddress, trampOffset, 0); + } else + return -1; + } + } + return 0; +} + +void hipe_arch_print_pcb(struct hipe_process_state *p) +{ +#define U(n,x) \ + printf(" % 4d | %s | 0x%0*lx | %*s |\r\n", (int)offsetof(struct hipe_process_state,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2+2*(int)sizeof(long), "") + U("nra ", nra); + U("narity ", narity); +#undef U +} diff --git a/erts/emulator/hipe/hipe_ppc.h b/erts/emulator/hipe/hipe_ppc.h new file mode 100644 index 0000000000..e30ce30ed2 --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc.h @@ -0,0 +1,67 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_PPC_H +#define HIPE_PPC_H + +static __inline__ void hipe_flush_icache_word(void *address) +{ + asm volatile("dcbst 0,%0\n" + "\tsync\n" + "\ticbi 0,%0\n" + "\tsync\n" + "\tisync" + : + : "r"(address) + : "memory"); +} + +extern void hipe_flush_icache_range(void *address, unsigned int nbytes); + +/* for stack descriptor hash lookup */ +#define HIPE_RA_LSR_COUNT 2 /* low 2 bits are always zero */ + +/* for hipe_bifs_{read,write}_{s,u}32 */ +static __inline__ int hipe_word32_address_ok(void *address) +{ + return ((unsigned long)address & 0x3) == 0; +} + +/* Native stack growth direction. */ +#define HIPE_NSTACK_GROWS_DOWN + +#if defined(__powerpc64__) +#define hipe_arch_name am_ppc64 +#define AEXTERN(RET,NAME,PROTO) extern const int NAME +AEXTERN(void,hipe_ppc_inc_stack,(void)); +#else +#define hipe_arch_name am_powerpc +extern void hipe_ppc_inc_stack(void); /* we don't have the AEXTERN() fallback :-( */ +#endif + +/* for hipe_bifs_enter_code_2 */ +extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); +#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p)) + +#if !defined(__powerpc64__) +extern const unsigned int fconv_constant[]; +#endif + +#endif /* HIPE_PPC_H */ diff --git a/erts/emulator/hipe/hipe_ppc.tab b/erts/emulator/hipe/hipe_ppc.tab new file mode 100644 index 0000000000..a32dd820e7 --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc.tab @@ -0,0 +1,24 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# $Id$ +# PowerPC-specific atoms + +atom fconv_constant +atom inc_stack_0 +atom powerpc diff --git a/erts/emulator/hipe/hipe_ppc64.tab b/erts/emulator/hipe/hipe_ppc64.tab new file mode 100644 index 0000000000..513182721c --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc64.tab @@ -0,0 +1,23 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# $Id$ +# PPC64-specific atoms + +atom inc_stack_0 +atom ppc64 diff --git a/erts/emulator/hipe/hipe_ppc_abi.txt b/erts/emulator/hipe/hipe_ppc_abi.txt new file mode 100644 index 0000000000..4bf41e02b2 --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc_abi.txt @@ -0,0 +1,138 @@ + + %CopyrightBegin% + %CopyrightEnd% + +$Id$ + +HiPE PowerPC ABI +================ +This document describes aspects of HiPE's runtime system +that are specific for the 32 and 64-bit PowerPC architectures. + +Register Usage +-------------- +r1, r2, and r13 are reserved for the C runtime system. + +r29-r31 are fixed (unallocatable). +r29 (HP) is the current process' heap pointer. +r30 (NSP) is the current process' native stack pointer. +r31 (P) is the current process' "Process" pointer. + +r0, r3-r12, and r14-r28 are caller-save. They are used as temporary +scratch registers and for function call parameters and results. + +The runtime system uses temporaries in specific contexts: +r28 (TEMP_LR) is used to preserve LR around BIF calls. +r27 (TEMP_ARG0) is used to preserve the return value in nbif_stack_trap_ra, +and LR in hipe_ppc_inc_stack (the caller saved its LR in TEMP_LR). +r12 is used to pass the callee address in native-to-BEAM traps. +r11 is used to construct callee addresses in calls via trampolines. +r4 (ARG0) is used for MBUF-after-BIF checks, for storing the +arity of a BIF that throws an exception or does GC due to MBUF, +and for checking P->flags for pending timeout. +r3 is used to inspect the type of a thrown exception, and to +return a result token from glue.S back to hipe_mode_switch(). +r0 is used to pass the callee arity in native-to-BEAM traps. + +LR and CTR are caller-save. + +Calling Convention +------------------ +The first NR_ARG_REGS parameters (a tunable parameter between 0 and 7, +inclusive) are passed in r4-r10. + +r3 is not used for parameter passing. This allows the BIF wrappers to +simply move P to r3 without shifting the remaining parameter registers. + +r0/r11/r12 are not used for parameter passing since they may be modified +during function linkage. + +The return value from a function is placed in r3. + +Stack Frame Layout +------------------ +[From top to bottom: formals in left-to-right order, incoming return +address, fixed-size chunk for locals & spills, variable-size area +for actuals, outgoing return address. NSP normally points at the +bottom of the fixed-size chunk, except during a recursive call. +The callee pops the actuals, so no NSP adjustment at return.] + +Stack Descriptors +----------------- +sdesc_fsize() is the frame size excluding the return address word. + +Standard Linux PowerPC Calling Conventions (32-bit) +=================================================== + +Reg Status Role +--- ------ ---- +r0 calleR-save volatile + may be modified during function linkage + r0 cannot be base reg in load/store insns +r1 calleE-save stack pointer, 16-byte aligned, must point + to valid frame with link to previous frame +r2 reserved thread register + (TOC in AIX, GOT in 64-bit, caller-save in OSX) +r3-r4 calleR-save volatile, parameters, return values +r5-r10 calleR-save volatile, parameters +r11 calleR-save volatile, + may be modified during function linkage + (calls by pointer & environment pointer in AIX) +r12 calleR-save volatile, + may be modified during function linkage +r13 reserved small data area pointer + (callee-save in AIX, thread reg in 64-bit, + callee-save in OSX) +r14-r30 calleE-save local variables +r31 calleE-save local variable or "environment pointer" +f0 calleR-save volatile +f1 calleR-save volatile, parameters, return values +f2-f8 calleR-save volatile, parameters +f9-f13 calleR-save volatile +f14-f31 calleE-save local variables +CR0/1/5/6/7 calleR-save condition codes, CR1 used in stdarg calls +CR2/3/4 calleE-save condition codes +LR calleR-save return address +CTR calleR-save counter, indirect jump address +XER calleR-save fixed-point exception register + +Standard PPC64 ELF ABI Calling Conventions +========================================== + +Reg Status Role +--- ------ ---- +r0 calleR-save volatile + may be modified during function linkage + r0 cannot be base reg in load/store insns +r1 calleE-save stack pointer, 16-byte aligned, must point + to valid frame with link to previous frame +r2 reserved TOC pointer +r3 calleR-save volatile, parameters, return values +r4-r10 calleR-save volatile, parameters +r11 calleR-save volatile, + may be modified during function linkage + (calls by pointer & environment pointer) +r12 calleR-save volatile, + may be modified during function linkage + (exception handling and glink code) +r13 reserved system thread ID +r14-r31 calleE-save local variables + +f0 calleR-save volatile +f1-f4 calleR-save volatile, parameters, return values +f5-f13 calleR-save volatile, parameters +f14-f31 calleE-save local variables + +CR0/1/5/6/7 calleR-save volatile condition codes +CR2/3/4 calleE-save non-volatile condition codes + +LR calleR-save return address, volatile +CTR calleR-save counter, indirect jump address (volatile) +XER calleR-save fixed-point exception register (volatile) +FPSCR calleR-save floating-point status and control (volatile) + +v0-v1 calleR-save volatile, scratch +v2-v13 calleR-save volatile, parameters +v14-v19 calleR-save volatile, scratch +v20-v31 calleE-save non-volatile local variables +vrsave calleE-save non-volatile diff --git a/erts/emulator/hipe/hipe_ppc_asm.m4 b/erts/emulator/hipe/hipe_ppc_asm.m4 new file mode 100644 index 0000000000..a0f8b78679 --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc_asm.m4 @@ -0,0 +1,286 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ +`#ifndef HIPE_PPC_ASM_H +#define HIPE_PPC_ASM_H' + +/* + * Handle 32 vs 64-bit. + */ +ifelse(ARCH,ppc64,` +/* 64-bit PowerPC */ +define(LOAD,ld)dnl +define(STORE,std)dnl +define(CMPI,cmpdi)dnl +define(WSIZE,8)dnl +',` +/* 32-bit PowerPC */ +define(LOAD,lwz)dnl +define(STORE,stw)dnl +define(CMPI,cmpwi)dnl +define(WSIZE,4)dnl +')dnl +`#define LOAD 'LOAD +`#define STORE 'STORE +`#define CMPI 'CMPI + +/* + * Tunables. + */ +define(LEAF_WORDS,16)dnl number of stack words for leaf functions +define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive + +`#define PPC_LEAF_WORDS 'LEAF_WORDS + +/* + * Workarounds for Darwin. + */ +ifelse(OPSYS,darwin,`` +/* Darwin */ +#define JOIN(X,Y) X##Y +#define CSYM(NAME) JOIN(_,NAME) +#define ASYM(NAME) CSYM(NAME) +#define GLOBAL(NAME) .globl NAME +#define SEMI @ +#define SET_SIZE(NAME) /*empty*/ +#define TYPE_FUNCTION(NAME) /*empty*/ +'',`` +/* Not Darwin */'' +`ifelse(ARCH,ppc64,`` +/* 64-bit */ +#define JOIN(X,Y) X##Y +#define CSYM(NAME) JOIN(.,NAME) +'',`` +/* 32-bit */ +#define CSYM(NAME) NAME +'')' +``#define ASYM(NAME) NAME +#define GLOBAL(NAME) .global NAME +#define SEMI ; +#define SET_SIZE(NAME) .size NAME,.-NAME +#define TYPE_FUNCTION(NAME) .type NAME,@function +#define lo16(X) X@l +#define ha16(X) X@ha + +/* + * Standard register names. + */ +#define r0 0 +#define r1 1 +#define r2 2 +#define r3 3 +#define r4 4 +#define r5 5 +#define r6 6 +#define r7 7 +#define r8 8 +#define r9 9 +#define r10 10 +#define r11 11 +#define r12 12 +#define r13 13 +#define r14 14 +#define r15 15 +#define r16 16 +#define r17 17 +#define r18 18 +#define r19 19 +#define r20 20 +#define r21 21 +#define r22 22 +#define r23 23 +#define r24 24 +#define r25 25 +#define r26 26 +#define r27 27 +#define r28 28 +#define r29 29 +#define r30 30 +#define r31 31 +'')dnl + +/* + * Reserved registers. + */ +`#define P r31' +`#define NSP r30' +`#define HP r29' +`#define TEMP_LR r28' + +/* + * Context switching macros. + * + * RESTORE_CONTEXT and RESTORE_CONTEXT_QUICK do not affect + * the condition register. + */ +`#define SAVE_CONTEXT_QUICK \ + mflr TEMP_LR' + +`#define RESTORE_CONTEXT_QUICK \ + mtlr TEMP_LR' + +`#define SAVE_CACHED_STATE \ + STORE HP, P_HP(P) SEMI\ + STORE NSP, P_NSP(P)' + +`#define RESTORE_CACHED_STATE \ + LOAD HP, P_HP(P) SEMI\ + LOAD NSP, P_NSP(P)' + +`#define SAVE_CONTEXT_BIF \ + mflr TEMP_LR SEMI \ + STORE HP, P_HP(P)' + +`#define RESTORE_CONTEXT_BIF \ + mtlr TEMP_LR SEMI \ + LOAD HP, P_HP(P)' + +`#define SAVE_CONTEXT_GC \ + mflr TEMP_LR SEMI \ + STORE TEMP_LR, P_NRA(P) SEMI \ + STORE NSP, P_NSP(P) SEMI \ + STORE HP, P_HP(P)' + +`#define RESTORE_CONTEXT_GC \ + mtlr TEMP_LR SEMI \ + LOAD HP, P_HP(P)' + +/* + * Argument (parameter) registers. + */ +`#define PPC_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +define(defarg,`define(ARG$1,`$2')dnl +#`define ARG'$1 $2' +)dnl + +ifelse(eval(NR_ARG_REGS >= 1),0,, +`defarg(0,`r4')')dnl +ifelse(eval(NR_ARG_REGS >= 2),0,, +`defarg(1,`r5')')dnl +ifelse(eval(NR_ARG_REGS >= 3),0,, +`defarg(2,`r6')')dnl +ifelse(eval(NR_ARG_REGS >= 4),0,, +`defarg(3,`r7')')dnl +ifelse(eval(NR_ARG_REGS >= 5),0,, +`defarg(4,`r8')')dnl +ifelse(eval(NR_ARG_REGS >= 6),0,, +`defarg(5,`r9')')dnl + +/* + * TEMP_ARG0: + * Used in nbif_stack_trap_ra to preserve the return value. + * Must be a C callee-save register. + * Must be otherwise unused in the return path. + * + * TEMP_ARG0: + * Used in hipe_ppc_inc_stack to preserve the return address + * (TEMP_LR contains the caller's saved return address). + * Must be a C callee-save register. + * Must be otherwise unused in the call path. + */ +`#define TEMP_ARG0 r27' + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_ppc_glue.S support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl LOAD_ARG_REGS +dnl +define(LAR_1,`LOAD ARG$1, P_ARG$1(P) SEMI ')dnl +define(LAR_N,`ifelse(eval($1 >= 0),0,,`LAR_N(eval($1-1))LAR_1($1)')')dnl +define(LOAD_ARG_REGS,`LAR_N(eval(NR_ARG_REGS-1))')dnl +`#define LOAD_ARG_REGS 'LOAD_ARG_REGS + +dnl +dnl STORE_ARG_REGS +dnl +define(SAR_1,`STORE ARG$1, P_ARG$1(P) SEMI ')dnl +define(SAR_N,`ifelse(eval($1 >= 0),0,,`SAR_N(eval($1-1))SAR_1($1)')')dnl +define(STORE_ARG_REGS,`SAR_N(eval(NR_ARG_REGS-1))')dnl +`#define STORE_ARG_REGS 'STORE_ARG_REGS + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_ppc_bifs.m4 support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl NBIF_ARG(DST,ARITY,ARGNO) +dnl Access a formal parameter. +dnl It will be a memory load via NSP when ARGNO >= NR_ARG_REGS. +dnl It will be a register move when 0 <= ARGNO < NR_ARG_REGS; if +dnl the source and destination are the same, the move is suppressed. +dnl +define(NBIF_MOVE_REG,`ifelse($1,$2,`# mr $1, $2',`mr $1, $2')')dnl +define(NBIF_REG_ARG,`NBIF_MOVE_REG($1,ARG$2)')dnl +define(NBIF_STK_LOAD,`LOAD $1, $2(NSP)')dnl +define(NBIF_STK_ARG,`NBIF_STK_LOAD($1,eval(WSIZE*(($2-$3)-1)))')dnl +define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_STK_ARG($1,$2,$3)')')dnl +`/* #define NBIF_ARG_1_0 'NBIF_ARG(r3,1,0)` */' +`/* #define NBIF_ARG_2_0 'NBIF_ARG(r3,2,0)` */' +`/* #define NBIF_ARG_2_1 'NBIF_ARG(r3,2,1)` */' +`/* #define NBIF_ARG_3_0 'NBIF_ARG(r3,3,0)` */' +`/* #define NBIF_ARG_3_1 'NBIF_ARG(r3,3,1)` */' +`/* #define NBIF_ARG_3_2 'NBIF_ARG(r3,3,2)` */' +`/* #define NBIF_ARG_5_0 'NBIF_ARG(r3,5,0)` */' +`/* #define NBIF_ARG_5_1 'NBIF_ARG(r3,5,1)` */' +`/* #define NBIF_ARG_5_2 'NBIF_ARG(r3,5,2)` */' +`/* #define NBIF_ARG_5_3 'NBIF_ARG(r3,5,3)` */' +`/* #define NBIF_ARG_5_4 'NBIF_ARG(r3,5,4)` */' + +dnl +dnl NBIF_RET(ARITY) +dnl Generates a return from a native BIF, taking care to pop +dnl any stacked formal parameters. +dnl +define(NSP_RETN,`addi NSP, NSP, $1 + blr')dnl +define(NSP_RET0,`blr')dnl +define(RET_POP,`ifelse(eval($1 > NR_ARG_REGS),0,0,eval(WSIZE*($1 - NR_ARG_REGS)))')dnl +define(NBIF_RET_N,`ifelse(eval($1),0,`NSP_RET0',`NSP_RETN($1)')')dnl +define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl +`/* #define NBIF_RET_0 'NBIF_RET(0)` */' +`/* #define NBIF_RET_1 'NBIF_RET(1)` */' +`/* #define NBIF_RET_2 'NBIF_RET(2)` */' +`/* #define NBIF_RET_3 'NBIF_RET(3)` */' +`/* #define NBIF_RET_5 'NBIF_RET(5)` */' + +dnl +dnl QUICK_CALL_RET(CFUN,ARITY) +dnl Used in nocons_nofail and noproc primop interfaces to optimise +dnl SAVE_CONTEXT_QUICK; bl CFUN; RESTORE_CONTEXT_QUICK; NBIF_RET(ARITY). +dnl +define(NBIF_POP_N,`ifelse(eval($1),0,`',`addi NSP, NSP, $1 SEMI ')')dnl +define(QUICK_CALL_RET,`NBIF_POP_N(eval(RET_POP($2)))b $1')dnl +`/* #define QUICK_CALL_RET_F_0 'QUICK_CALL_RET(F,0)` */' +`/* #define QUICK_CALL_RET_F_1 'QUICK_CALL_RET(F,1)` */' +`/* #define QUICK_CALL_RET_F_2 'QUICK_CALL_RET(F,2)` */' +`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' +`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' + +`#endif /* HIPE_PPC_ASM_H */' diff --git a/erts/emulator/hipe/hipe_ppc_bifs.m4 b/erts/emulator/hipe/hipe_ppc_bifs.m4 new file mode 100644 index 0000000000..3849d9113a --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc_bifs.m4 @@ -0,0 +1,568 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ + +include(`hipe/hipe_ppc_asm.m4') +#`include' "hipe_literals.h" + + .text + .p2align 2 + +`#define TEST_GOT_MBUF LOAD r4, P_MBUF(P) SEMI CMPI r4, 0 SEMI bne- 3f SEMI 2: +#define JOIN3(A,B,C) A##B##C +#define HANDLE_GOT_MBUF(ARITY) 3: bl CSYM(JOIN3(nbif_,ARITY,_gc_after_bif)) SEMI b 2b' + +/* + * standard_bif_interface_1(nbif_name, cbif_name) + * standard_bif_interface_2(nbif_name, cbif_name) + * standard_bif_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 1-3 parameters and + * standard failure mode. + */ +define(standard_bif_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + CMPI r3, THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq- 1f + NBIF_RET(1) +1: /* workaround for bc:s small offset operand */ + b CSYM(nbif_1_simple_exception) + HANDLE_GOT_MBUF(1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(standard_bif_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,2,0) + NBIF_ARG(r5,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + CMPI r3, THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq- 1f + NBIF_RET(2) +1: /* workaround for bc:s small offset operand */ + b CSYM(nbif_2_simple_exception) + HANDLE_GOT_MBUF(2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(standard_bif_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,3,0) + NBIF_ARG(r5,3,1) + NBIF_ARG(r6,3,2) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + CMPI r3, THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq- 1f + NBIF_RET(3) +1: /* workaround for bc:s small offset operand */ + b CSYM(nbif_3_simple_exception) + HANDLE_GOT_MBUF(3) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * fail_bif_interface_0(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 0 parameters and + * standard failure mode. + */ +define(fail_bif_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + CMPI r3, THE_NON_VALUE + RESTORE_CONTEXT_BIF + beq- 1f + NBIF_RET(0) +1: /* workaround for bc:s small offset operand */ + b CSYM(nbif_0_simple_exception) + HANDLE_GOT_MBUF(0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * gc_bif_interface_0(nbif_name, cbif_name) + * gc_bif_interface_1(nbif_name, cbif_name) + * gc_bif_interface_2(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 0-2 parameters and + * standard failure mode. + * The BIF may do a GC. + */ +define(gc_bif_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_GC + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(gc_bif_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + CMPI r3, THE_NON_VALUE + RESTORE_CONTEXT_GC + beq- 1f + NBIF_RET(1) +1: /* workaround for bc:s small offset operand */ + b CSYM(nbif_1_simple_exception) + HANDLE_GOT_MBUF(1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(gc_bif_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,2,0) + NBIF_ARG(r5,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + CMPI r3, THE_NON_VALUE + RESTORE_CONTEXT_GC + beq- 1f + NBIF_RET(2) +1: /* workaround for bc:s small offset operand */ + b CSYM(nbif_2_simple_exception) + HANDLE_GOT_MBUF(2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * gc_nofail_primop_interface_1(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 1 ordinary parameter and no failure mode. + * The primop may do a GC. + */ +define(gc_nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + bl CSYM($2) + + /* Restore registers. */ + RESTORE_CONTEXT_GC + NBIF_RET(1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * nofail_primop_interface_0(nbif_name, cbif_name) + * nofail_primop_interface_1(nbif_name, cbif_name) + * nofail_primop_interface_2(nbif_name, cbif_name) + * nofail_primop_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 ordinary parameters and no failure mode. + * Also used for guard BIFs. + */ +define(nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(1) + HANDLE_GOT_MBUF(1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,2,0) + NBIF_ARG(r5,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(2) + HANDLE_GOT_MBUF(2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,3,0) + NBIF_ARG(r5,3,1) + NBIF_ARG(r6,3,2) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + bl CSYM($2) + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(3) + HANDLE_GOT_MBUF(3) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * nocons_nofail_primop_interface_0(nbif_name, cbif_name) + * nocons_nofail_primop_interface_1(nbif_name, cbif_name) + * nocons_nofail_primop_interface_2(nbif_name, cbif_name) + * nocons_nofail_primop_interface_3(nbif_name, cbif_name) + * nocons_nofail_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(nocons_nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nocons_nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,1,0) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nocons_nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,2,0) + NBIF_ARG(r5,2,1) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nocons_nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,3,0) + NBIF_ARG(r5,3,1) + NBIF_ARG(r6,3,2) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),3) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nocons_nofail_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + mr r3, P + NBIF_ARG(r4,5,0) + NBIF_ARG(r5,5,1) + NBIF_ARG(r6,5,2) + NBIF_ARG(r7,5,3) + NBIF_ARG(r8,5,4) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),5) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * noproc_primop_interface_0(nbif_name, cbif_name) + * noproc_primop_interface_1(nbif_name, cbif_name) + * noproc_primop_interface_2(nbif_name, cbif_name) + * noproc_primop_interface_3(nbif_name, cbif_name) + * noproc_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with no implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(noproc_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* XXX: this case is always trivial; how to suppress the branch? */ + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(noproc_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + NBIF_ARG(r3,1,0) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(noproc_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + NBIF_ARG(r3,2,0) + NBIF_ARG(r4,2,1) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(noproc_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + NBIF_ARG(r3,3,0) + NBIF_ARG(r4,3,1) + NBIF_ARG(r5,3,2) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),3) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(noproc_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + GLOBAL(ASYM($1)) +ASYM($1): + /* Set up C argument registers. */ + NBIF_ARG(r3,5,0) + NBIF_ARG(r4,5,1) + NBIF_ARG(r5,5,2) + NBIF_ARG(r6,5,3) + NBIF_ARG(r7,5,4) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET(CSYM($2),5) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +include(`hipe/hipe_bif_list.m4') + +`#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif' diff --git a/erts/emulator/hipe/hipe_ppc_gc.h b/erts/emulator/hipe/hipe_ppc_gc.h new file mode 100644 index 0000000000..796ebeb20a --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc_gc.h @@ -0,0 +1,29 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * Stack walking helpers for native stack GC procedures. + * PowerPC version. + */ +#ifndef HIPE_PPC_GC_H +#define HIPE_PPC_GC_H + +#include "hipe_ppc_asm.h" /* for NR_ARG_REGS */ +#include "hipe_risc_gc.h" + +#endif /* HIPE_PPC_GC_H */ diff --git a/erts/emulator/hipe/hipe_ppc_glue.S b/erts/emulator/hipe/hipe_ppc_glue.S new file mode 100644 index 0000000000..97b07353f9 --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc_glue.S @@ -0,0 +1,582 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#include "hipe_ppc_asm.h" +#include "hipe_literals.h" +#define ASM +#include "hipe_mode_switch.h" + + .text + .p2align 2 + +#if defined(__powerpc64__) +/* + * Enter Erlang from C. + * Create a new frame on the C stack. + * Save C callee-save registers (r14-r31) in the frame. + * Save r0 (C return address) in the caller's LR save slot. + * Retrieve the process pointer from the C argument registers. + * Return to LR. + * Do not clobber the C argument registers (r3-r10). + * + * Usage: mflr r0 SEMI bl .enter + */ +.enter: + # Our PPC64 ELF ABI frame must include: + # - 48 (6*8) bytes for AIX-like linkage area + # - 64 (8*8) bytes for AIX-like parameter area for + # recursive C calls with up to 8 parameter words + # - padding to make the frame a multiple of 16 bytes + # - 144 (18*8) bytes for saving r14-r31 + # The final size is 256 bytes. + # stdu is required for atomic alloc+init + stdu r1,-256(r1) /* 0(r1) contains r1+256 */ + std r14, 112(r1) + std r15, 120(r1) + std r16, 128(r1) + std r17, 136(r1) + std r18, 144(r1) + std r19, 152(r1) + std r20, 160(r1) + std r21, 168(r1) + std r22, 176(r1) + std r23, 184(r1) + std r24, 192(r1) + std r25, 200(r1) + std r26, 208(r1) + std r27, 216(r1) + std r28, 224(r1) + std r29, 232(r1) + std r30, 240(r1) + std r31, 248(r1) + std r0, 256+16(r1) /* caller saved LR in r0 */ + mr P, r3 /* get the process pointer */ + blr + +/* + * Return to the calling C function. + * The return value is in r3. + * + * .nosave_exit saves no state + * .flush_exit saves NSP and other cached P state. + * .suspend_exit also saves RA. + */ +.suspend_exit: + /* save RA, so we can be resumed */ + mflr r0 + std r0, P_NRA(P) +.flush_exit: + /* flush cached P state */ + SAVE_CACHED_STATE +.nosave_exit: + /* restore callee-save registers, drop frame, return */ + ld r0, 256+16(r1) + mtlr r0 + ld r14, 112(r1) + ld r15, 120(r1) + ld r16, 128(r1) + ld r17, 136(r1) + ld r18, 144(r1) + ld r19, 152(r1) + ld r20, 160(r1) + ld r21, 168(r1) + ld r22, 176(r1) + ld r23, 184(r1) + ld r24, 192(r1) + ld r25, 200(r1) + ld r26, 208(r1) + ld r27, 216(r1) + ld r28, 224(r1) + ld r29, 232(r1) /* kills HP */ + ld r30, 240(r1) /* kills NSP */ + ld r31, 248(r1) /* kills P */ + addi r1, r1, 256 + blr +#else /* !__powerpc64__ */ +/* + * Enter Erlang from C. + * Create a new frame on the C stack. + * Save C callee-save registers (r14-r31) in the frame. + * Save r0 (C return address) in the frame's LR save slot. + * Retrieve the process pointer from the C argument registers. + * Return to LR. + * Do not clobber the C argument registers (r3-r10). + * + * Usage: mflr r0 SEMI bl .enter + */ +.enter: + # A unified Linux/OSX C frame must include: + # - 24 bytes for AIX/OSX-like linkage area + # - 28 bytes for AIX/OSX-like parameter area for + # recursive C calls with up to 7 parameter words + # - 76 bytes for saving r14-r31 and LR + # - padding to make it a multiple of 16 bytes + # The final size is 128 bytes. + # stwu is required for atomic alloc+init + stwu r1,-128(r1) /* 0(r1) contains r1+128 */ + stw r14, 52(r1) + stw r15, 56(r1) + stw r16, 60(r1) + stw r17, 64(r1) + stw r18, 68(r1) + stw r19, 72(r1) + stw r20, 76(r1) + stw r21, 80(r1) + stw r22, 84(r1) + stw r23, 88(r1) + stw r24, 92(r1) + stw r25, 96(r1) + stw r26, 100(r1) + stw r27, 104(r1) + stw r28, 108(r1) + stw r29, 112(r1) + stw r30, 116(r1) + stw r31, 120(r1) + stw r0, 124(r1) /* caller saved LR in r0 */ + mr P, r3 /* get the process pointer */ + blr + +/* + * Return to the calling C function. + * The return value is in r3. + * + * .nosave_exit saves no state + * .flush_exit saves NSP and other cached P state. + * .suspend_exit also saves RA. + */ +.suspend_exit: + /* save RA, so we can be resumed */ + mflr r0 + stw r0, P_NRA(P) +.flush_exit: + /* flush cached P state */ + SAVE_CACHED_STATE +.nosave_exit: + /* restore callee-save registers, drop frame, return */ + lwz r0, 124(r1) + mtlr r0 + lwz r14, 52(r1) + lwz r15, 56(r1) + lwz r16, 60(r1) + lwz r17, 64(r1) + lwz r18, 68(r1) + lwz r19, 72(r1) + lwz r20, 76(r1) + lwz r21, 80(r1) + lwz r22, 84(r1) + lwz r23, 88(r1) + lwz r24, 92(r1) + lwz r25, 96(r1) + lwz r26, 100(r1) + lwz r27, 104(r1) + lwz r28, 108(r1) + lwz r29, 112(r1) /* kills HP */ + lwz r30, 116(r1) /* kills NSP */ + lwz r31, 120(r1) /* kills P */ + addi r1, r1, 128 + blr +#endif /* !__powerpc64__ */ + +/* + * int hipe_ppc_call_to_native(Process *p); + * Emulated code recursively calls native code. + */ + GLOBAL(CSYM(hipe_ppc_call_to_native)) +CSYM(hipe_ppc_call_to_native): + /* save C context */ + mflr r0 + bl .enter + /* prepare to call the target */ + LOAD r0, P_NCALLEE(P) + mtctr r0 + /* get argument registers */ + LOAD_ARG_REGS + /* cache some P state in registers */ + RESTORE_CACHED_STATE + /* call the target */ + bctrl /* defines LR (a.k.a. NRA) */ +/* FALLTHROUGH + * + * We export this return address so that hipe_mode_switch() can discover + * when native code tailcalls emulated code. + * + * This is where native code returns to emulated code. + */ + GLOBAL(ASYM(nbif_return)) +ASYM(nbif_return): + STORE r3, P_ARG0(P) /* save retval */ + li r3, HIPE_MODE_SWITCH_RES_RETURN + b .flush_exit + +/* + * int hipe_ppc_return_to_native(Process *p); + * Emulated code returns to its native code caller. + */ + GLOBAL(CSYM(hipe_ppc_return_to_native)) +CSYM(hipe_ppc_return_to_native): + /* save C context */ + mflr r0 + bl .enter + /* restore return address */ + LOAD r0, P_NRA(P) + mtlr r0 + /* cache some P state in registers */ + RESTORE_CACHED_STATE + /* get return value */ + LOAD r3, P_ARG0(P) + /* + * Return using the current return address. + * The parameters were popped at the original native-to-emulated + * call (hipe_call_from_native_is_recursive), so a plain ret suffices. + */ + blr + +/* + * int hipe_ppc_tailcall_to_native(Process *p); + * Emulated code tailcalls native code. + */ + GLOBAL(CSYM(hipe_ppc_tailcall_to_native)) +CSYM(hipe_ppc_tailcall_to_native): + /* save C context */ + mflr r0 + bl .enter + /* prepare to call the target */ + LOAD r0, P_NCALLEE(P) + mtctr r0 + /* get argument registers */ + LOAD_ARG_REGS + /* restore return address */ + LOAD r0, P_NRA(P) + mtlr r0 + /* cache some P state in registers */ + RESTORE_CACHED_STATE + /* call the target */ + bctr + +/* + * int hipe_ppc_throw_to_native(Process *p); + * Emulated code throws an exception to its native code caller. + */ + GLOBAL(CSYM(hipe_ppc_throw_to_native)) +CSYM(hipe_ppc_throw_to_native): + /* save C context */ + mflr r0 + bl .enter + /* prepare to invoke handler */ + LOAD r0, P_NCALLEE(P) /* set by hipe_find_handler() */ + mtctr r0 + /* cache some P state in registers */ + RESTORE_CACHED_STATE + /* invoke the handler */ + bctr + +/* + * Native code calls emulated code via a stub + * which should look as follows: + * + * stub for f/N: + * + * + * b nbif_callemu + * + * The stub may need to create &nbif_callemu as a 32-bit immediate + * in a scratch register if the branch needs a trampoline. The code + * for creating a 32-bit immediate in r0 is potentially slower than + * for other registers (an add must be replaced by an or, and adds + * are potentially faster than ors), so it is better to use r0 for + * the arity (a small immediate), making r11 available for trampolines. + * (See "The PowerPC Compiler Writer's Guide, section 3.2.3.1.) + * + * XXX: Different stubs for different number of register parameters? + */ + GLOBAL(ASYM(nbif_callemu)) +ASYM(nbif_callemu): + STORE r12, P_BEAM_IP(P) + STORE r0, P_ARITY(P) + STORE_ARG_REGS + li r3, HIPE_MODE_SWITCH_RES_CALL + b .suspend_exit + +/* + * nbif_apply + */ + GLOBAL(ASYM(nbif_apply)) +ASYM(nbif_apply): + STORE_ARG_REGS + li r3, HIPE_MODE_SWITCH_RES_APPLY + b .suspend_exit + +/* + * Native code calls an emulated-mode closure via a stub defined below. + * + * The closure is appended as the last actual parameter, and parameters + * beyond the first few passed in registers are pushed onto the stack in + * left-to-right order. + * Hence, the location of the closure parameter only depends on the number + * of parameters in registers, not the total number of parameters. + */ +#if NR_ARG_REGS >= 6 + GLOBAL(ASYM(nbif_ccallemu6)) +ASYM(nbif_ccallemu6): + STORE ARG5, P_ARG5(P) +#if NR_ARG_REGS > 6 + mr ARG5, ARG6 +#else + LOAD ARG5, 0(NSP) +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 5 + GLOBAL(ASYM(nbif_ccallemu5)) +ASYM(nbif_ccallemu5): + STORE ARG4, P_ARG4(P) +#if NR_ARG_REGS > 5 + mr ARG4, ARG5 +#else + LOAD ARG4, 0(NSP) +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 4 + GLOBAL(ASYM(nbif_ccallemu4)) +ASYM(nbif_ccallemu4): + STORE ARG3, P_ARG3(P) +#if NR_ARG_REGS > 4 + mr ARG3, ARG4 +#else + LOAD ARG3, 0(NSP) +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 3 + GLOBAL(ASYM(nbif_ccallemu3)) +ASYM(nbif_ccallemu3): + STORE ARG2, P_ARG2(P) +#if NR_ARG_REGS > 3 + mr ARG2, ARG3 +#else + LOAD ARG2, 0(NSP) +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 2 + GLOBAL(ASYM(nbif_ccallemu2)) +ASYM(nbif_ccallemu2): + STORE ARG1, P_ARG1(P) +#if NR_ARG_REGS > 2 + mr ARG1, ARG2 +#else + LOAD ARG1, 0(NSP) +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 1 + GLOBAL(ASYM(nbif_ccallemu1)) +ASYM(nbif_ccallemu1): + STORE ARG0, P_ARG0(P) +#if NR_ARG_REGS > 1 + mr ARG0, ARG1 +#else + LOAD ARG0, 0(NSP) +#endif + /*FALLTHROUGH*/ +#endif + + GLOBAL(ASYM(nbif_ccallemu0)) +ASYM(nbif_ccallemu0): + /* We use r4 not ARG0 here because ARG0 is not + defined when NR_ARG_REGS == 0. */ +#if NR_ARG_REGS == 0 + LOAD r4, 0(NSP) /* get the closure */ +#endif + STORE r4, P_CLOSURE(P) /* save the closure */ + li r3, HIPE_MODE_SWITCH_RES_CALL_CLOSURE + b .suspend_exit + +/* + * This is where native code suspends. + */ + GLOBAL(ASYM(nbif_suspend_0)) +ASYM(nbif_suspend_0): + li r3, HIPE_MODE_SWITCH_RES_SUSPEND + b .suspend_exit + +/* + * Suspend from a receive (waiting for a message) + */ + GLOBAL(ASYM(nbif_suspend_msg)) +ASYM(nbif_suspend_msg): + li r3, HIPE_MODE_SWITCH_RES_WAIT + b .suspend_exit + +/* + * Suspend from a receive with a timeout (waiting for a message) + * if (!(p->flags & F_TIMO)) { suspend } + * else { return 0; } + */ + GLOBAL(ASYM(nbif_suspend_msg_timeout)) +ASYM(nbif_suspend_msg_timeout): + LOAD r4, P_FLAGS(P) + li r3, HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT + /* this relies on F_TIMO (1<<2) fitting in a uimm16 */ + andi. r0, r4, F_TIMO + beq- .suspend_exit /* sees the CR state from andi. above */ + /* timeout has occurred */ + li r3, 0 + blr + +/* + * This is the default exception handler for native code. + */ + GLOBAL(ASYM(nbif_fail)) +ASYM(nbif_fail): + li r3, HIPE_MODE_SWITCH_RES_THROW + b .flush_exit /* no need to save RA */ + + GLOBAL(CSYM(nbif_0_gc_after_bif)) + GLOBAL(CSYM(nbif_1_gc_after_bif)) + GLOBAL(CSYM(nbif_2_gc_after_bif)) + GLOBAL(CSYM(nbif_3_gc_after_bif)) +CSYM(nbif_0_gc_after_bif): + li r4, 0 + b .gc_after_bif +CSYM(nbif_1_gc_after_bif): + li r4, 1 + b .gc_after_bif +CSYM(nbif_2_gc_after_bif): + li r4, 2 + b .gc_after_bif +CSYM(nbif_3_gc_after_bif): + li r4, 3 + /*FALLTHROUGH*/ +.gc_after_bif: + stw r4, P_NARITY(P) /* Note: narity is a 32-bit field */ + STORE TEMP_LR, P_NRA(P) + STORE NSP, P_NSP(P) + mflr TEMP_LR + mr r4, r3 + mr r3, P + bl CSYM(erts_gc_after_bif_call) + mtlr TEMP_LR + LOAD TEMP_LR, P_NRA(P) + li r4, 0 + stw r4, P_NARITY(P) /* Note: narity is a 32-bit field */ + blr + +/* + * We end up here when a BIF called from native signals an + * exceptional condition. + * The heap pointer was just read from P. + * TEMP_LR contains a copy of LR + */ + GLOBAL(CSYM(nbif_0_simple_exception)) +CSYM(nbif_0_simple_exception): + li r4, 0 + b .nbif_simple_exception + GLOBAL(CSYM(nbif_1_simple_exception)) +CSYM(nbif_1_simple_exception): + li r4, 1 + b .nbif_simple_exception + GLOBAL(CSYM(nbif_2_simple_exception)) +CSYM(nbif_2_simple_exception): + li r4, 2 + b .nbif_simple_exception + GLOBAL(CSYM(nbif_3_simple_exception)) +CSYM(nbif_3_simple_exception): + li r4, 3 + /*FALLTHROUGH*/ +.nbif_simple_exception: + LOAD r3, P_FREASON(P) + CMPI r3, FREASON_TRAP + beq- .handle_trap + /* + * Find and invoke catch handler (it must exist). + * The heap pointer was just read from P. + * TEMP_LR should contain the current call's return address. + * r4 should contain the current call's arity. + */ + STORE NSP, P_NSP(P) + STORE TEMP_LR, P_NRA(P) + stw r4, P_NARITY(P) /* Note: narity is a 32-bit field */ + /* find and prepare to invoke the handler */ + mr r3, P + bl CSYM(hipe_handle_exception) /* Note: hipe_handle_exception() conses */ + /* prepare to invoke handler */ + LOAD r0, P_NCALLEE(P) /* set by hipe_find_handler() */ + mtctr r0 + RESTORE_CACHED_STATE /* NSP updated by hipe_find_handler() */ + /* now invoke the handler */ + bctr + + /* + * A BIF failed with freason TRAP: + * - the BIF's arity is in r4 + * - the native RA was saved in TEMP_LR before the BIF call + * - the native heap/stack/reds registers are saved in P + */ +.handle_trap: + li r3, HIPE_MODE_SWITCH_RES_TRAP + STORE NSP, P_NSP(P) + STORE r4, P_NARITY(P) + STORE TEMP_LR, P_NRA(P) + b .nosave_exit + +/* + * nbif_stack_trap_ra: trap return address for maintaining + * the gray/white stack boundary + */ + GLOBAL(ASYM(nbif_stack_trap_ra)) +ASYM(nbif_stack_trap_ra): /* a return address, not a function */ + # This only handles a single return value. + # If we have more, we need to save them in the PCB. + mr TEMP_ARG0, r3 /* save retval */ + STORE NSP, P_NSP(P) + mr r3, P + bl CSYM(hipe_handle_stack_trap) /* must not cons */ + mtctr r3 /* original RA */ + mr r3, TEMP_ARG0 /* restore retval */ + bctr /* resume at original RA */ + +/* + * hipe_ppc_inc_stack + * Caller saved its LR in TEMP_LR (== TEMP1) before calling us. + */ + GLOBAL(ASYM(hipe_ppc_inc_stack)) +ASYM(hipe_ppc_inc_stack): + STORE_ARG_REGS + mflr TEMP_ARG0 + STORE NSP, P_NSP(P) + mr r3, P + # hipe_inc_nstack reads and writes NSP and NSP_LIMIT, + # but does not access LR/RA, HP, or FCALLS. + bl CSYM(hipe_inc_nstack) + mtlr TEMP_ARG0 + LOAD NSP, P_NSP(P) + LOAD_ARG_REGS + blr + +#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif diff --git a/erts/emulator/hipe/hipe_ppc_glue.h b/erts/emulator/hipe/hipe_ppc_glue.h new file mode 100644 index 0000000000..dcf5ec7644 --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc_glue.h @@ -0,0 +1,32 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_PPC_GLUE_H +#define HIPE_PPC_GLUE_H + +#include "hipe_ppc_asm.h" /* for NR_ARG_REGS, PPC_LEAF_WORDS */ +#define NR_LEAF_WORDS PPC_LEAF_WORDS +#define HIPE_ARCH_CALL_TO_NATIVE hipe_ppc_call_to_native +#define HIPE_ARCH_RETURN_TO_NATIVE hipe_ppc_return_to_native +#define HIPE_ARCH_TAILCALL_TO_NATIVE hipe_ppc_tailcall_to_native +#define HIPE_ARCH_THROW_TO_NATIVE hipe_ppc_throw_to_native +#include "hipe_risc_glue.h" + +#endif /* HIPE_PPC_GLUE_H */ diff --git a/erts/emulator/hipe/hipe_ppc_primops.h b/erts/emulator/hipe/hipe_ppc_primops.h new file mode 100644 index 0000000000..67205fe1d1 --- /dev/null +++ b/erts/emulator/hipe/hipe_ppc_primops.h @@ -0,0 +1,24 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#if !defined(__powerpc64__) +PRIMOP_LIST(am_fconv_constant, &fconv_constant) +#endif +PRIMOP_LIST(am_inc_stack_0, &hipe_ppc_inc_stack) diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h new file mode 100644 index 0000000000..cc2fc425d5 --- /dev/null +++ b/erts/emulator/hipe/hipe_primops.h @@ -0,0 +1,96 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_PRIMOPS_H +#define HIPE_PRIMOPS_H + +PRIMOP_LIST(am_suspend_msg, &nbif_suspend_msg) +PRIMOP_LIST(am_suspend_msg_timeout, &nbif_suspend_msg_timeout) +PRIMOP_LIST(am_suspend_0, &nbif_suspend_0) + +PRIMOP_LIST(am_Plus, &nbif_add_2) +PRIMOP_LIST(am_Minus, &nbif_sub_2) +PRIMOP_LIST(am_Times, &nbif_mul_2) +PRIMOP_LIST(am_Div, &nbif_div_2) +PRIMOP_LIST(am_div, &nbif_intdiv_2) +PRIMOP_LIST(am_rem, &nbif_rem_2) +PRIMOP_LIST(am_bsl, &nbif_bsl_2) +PRIMOP_LIST(am_bsr, &nbif_bsr_2) +PRIMOP_LIST(am_band, &nbif_band_2) +PRIMOP_LIST(am_bor, &nbif_bor_2) +PRIMOP_LIST(am_bxor, &nbif_bxor_2) +PRIMOP_LIST(am_bnot, &nbif_bnot_1) + +PRIMOP_LIST(am_gc_1, &nbif_gc_1) +PRIMOP_LIST(am_check_get_msg, &nbif_check_get_msg) +#ifdef ERTS_SMP +PRIMOP_LIST(am_atomic_inc, &nbif_atomic_inc) +PRIMOP_LIST(am_clear_timeout, &nbif_clear_timeout) +#endif +PRIMOP_LIST(am_select_msg, &nbif_select_msg) +PRIMOP_LIST(am_set_timeout, &nbif_set_timeout) +PRIMOP_LIST(am_rethrow, &nbif_rethrow) + + +PRIMOP_LIST(am_bs_get_integer_2, &nbif_bs_get_integer_2) +PRIMOP_LIST(am_bs_get_float_2, &nbif_bs_get_float_2) +PRIMOP_LIST(am_bs_get_binary_2, &nbif_bs_get_binary_2) +PRIMOP_LIST(am_bs_allocate, &nbif_bs_allocate) +PRIMOP_LIST(am_bs_reallocate, &nbif_bs_reallocate) +PRIMOP_LIST(am_bs_put_big_integer, &nbif_bs_put_big_integer) +PRIMOP_LIST(am_bs_put_small_float, &nbif_bs_put_small_float) +PRIMOP_LIST(am_bs_put_bits, &nbif_bs_put_bits) +PRIMOP_LIST(am_bs_utf8_size, &nbif_bs_utf8_size) +PRIMOP_LIST(am_bs_put_utf8, &nbif_bs_put_utf8) +PRIMOP_LIST(am_bs_get_utf8, &nbif_bs_get_utf8) +PRIMOP_LIST(am_bs_utf16_size, &nbif_bs_utf16_size) +PRIMOP_LIST(am_bs_put_utf16be, &nbif_bs_put_utf16be) +PRIMOP_LIST(am_bs_put_utf16le, &nbif_bs_put_utf16le) +PRIMOP_LIST(am_bs_get_utf16, &nbif_bs_get_utf16) +PRIMOP_LIST(am_bs_validate_unicode, &nbif_bs_validate_unicode) +PRIMOP_LIST(am_bs_validate_unicode_retract, &nbif_bs_validate_unicode_retract) + +PRIMOP_LIST(am_cmp_2, &nbif_cmp_2) +PRIMOP_LIST(am_op_exact_eqeq_2, &nbif_eq_2) + +PRIMOP_LIST(am_hipe_apply, &nbif_apply) +PRIMOP_LIST(am_find_na_or_make_stub, &nbif_find_na_or_make_stub) +PRIMOP_LIST(am_nonclosure_address, &nbif_nonclosure_address) + +PRIMOP_LIST(am_conv_big_to_float, &nbif_conv_big_to_float) +PRIMOP_LIST(am_fclearerror_error, &nbif_fclearerror_error) + +#if defined(__sparc__) +#include "hipe_sparc_primops.h" +#endif +#if defined(__i386__) +#include "hipe_x86_primops.h" +#endif +#if defined(__x86_64__) +#include "hipe_amd64_primops.h" +#endif +#if defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#include "hipe_ppc_primops.h" +#endif +#if defined(__arm__) +#include "hipe_arm_primops.h" +#endif + +#endif /* HIPE_PRIMOPS_H */ diff --git a/erts/emulator/hipe/hipe_process.h b/erts/emulator/hipe/hipe_process.h new file mode 100644 index 0000000000..5528e68826 --- /dev/null +++ b/erts/emulator/hipe/hipe_process.h @@ -0,0 +1,80 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * HiPE-specific process fields + */ +#ifndef HIPE_PROCESS_H +#define HIPE_PROCESS_H + +#include "erl_alloc.h" + +struct hipe_process_state { + Eterm *nsp; /* Native stack pointer. */ + Eterm *nstack; /* Native stack block start. */ + Eterm *nstend; /* Native stack block end (start+size). */ + /* XXX: ncallee and closure could share space in a union */ + void (*ncallee)(void); /* Native code callee (label) to invoke. */ + Eterm closure; /* Used to pass a closure from native code. */ + Eterm *nstgraylim; /* Gray/white stack boundary. */ + Eterm *nstblacklim; /* Black/gray stack boundary. Must exist if + graylim exists. Ignored if no graylim. */ + void (*ngra)(void); /* Saved original RA from graylim frame. */ +#if defined(__i386__) || defined(__x86_64__) + Eterm *ncsp; /* Saved C stack pointer. */ +#endif +#if defined(__sparc__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) + void (*nra)(void); /* Native code return address. */ +#endif + unsigned int narity; /* Arity of BIF call, for stack walks. */ +}; + +extern void hipe_arch_print_pcb(struct hipe_process_state *p); + +static __inline__ void hipe_init_process(struct hipe_process_state *p) +{ + p->nsp = NULL; + p->nstack = NULL; + p->nstend = NULL; + p->nstgraylim = NULL; + p->nstblacklim = NULL; + p->ngra = NULL; +#if defined(__sparc__) || defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) || defined(__arm__) + p->nra = NULL; +#endif + p->narity = 0; +} + +static __inline__ void hipe_delete_process(struct hipe_process_state *p) +{ + if (p->nstack) + erts_free(ERTS_ALC_T_HIPE, (void*)p->nstack); +} + +#ifdef ERTS_SMP +struct hipe_process_state_smp { + int have_receive_locks; +}; + +static __inline__ void hipe_init_process_smp(struct hipe_process_state_smp *p) +{ + p->have_receive_locks = 0; +} +#endif + +#endif /* HIPE_PROCESS_H */ diff --git a/erts/emulator/hipe/hipe_risc_gc.h b/erts/emulator/hipe/hipe_risc_gc.h new file mode 100644 index 0000000000..4a9a7878f0 --- /dev/null +++ b/erts/emulator/hipe/hipe_risc_gc.h @@ -0,0 +1,113 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * Stack walking helpers for native stack GC procedures. + * Generic RISC version. + */ +#ifndef HIPE_RISC_GC_H +#define HIPE_RISC_GC_H + +/* arch wrapper includes hipe_${arch}_asm.h to define NR_ARG_REGS */ + +struct nstack_walk_state { + const struct sdesc *sdesc0; /* .sdesc0 must be a pointer rvalue */ +}; + +static inline int nstack_walk_init_check(const Process *p) +{ + return p->hipe.nra ? 1 : 0; +} + +static inline Eterm *nstack_walk_nsp_begin(const Process *p) +{ + unsigned int nstkarity = p->hipe.narity - NR_ARG_REGS; + if ((int)nstkarity < 0) + nstkarity = 0; + return p->hipe.nsp + nstkarity; +} + +static inline const struct sdesc* +nstack_walk_init_sdesc(const Process *p, struct nstack_walk_state *state) +{ + const struct sdesc *sdesc = hipe_find_sdesc((unsigned long)p->hipe.nra); + state->sdesc0 = sdesc; + return sdesc; +} + +static inline void nstack_walk_update_trap(Process *p, const struct sdesc *sdesc0) +{ + Eterm *nsp = p->hipe.nsp; + p->hipe.nsp = nstack_walk_nsp_begin(p); + hipe_update_stack_trap(p, sdesc0); + p->hipe.nsp = nsp; +} + +static inline Eterm *nstack_walk_nsp_end(const Process *p) +{ + return p->hipe.nstend - 1; +} + +static inline void nstack_walk_kill_trap(Process *p, Eterm *nsp_end) +{ + /* remove gray/white boundary trap */ + if ((unsigned long)p->hipe.nra == (unsigned long)&nbif_stack_trap_ra) { + p->hipe.nra = p->hipe.ngra; + } else { + for (;;) { + --nsp_end; + if (nsp_end[0] == (unsigned long)&nbif_stack_trap_ra) { + nsp_end[0] = (unsigned long)p->hipe.ngra; + break; + } + } + } +} + +static inline int nstack_walk_gray_passed_black(const Eterm *gray, const Eterm *black) +{ + return gray > black; +} + +static inline int nstack_walk_nsp_reached_end(const Eterm *nsp, const Eterm *nsp_end) +{ + return nsp >= nsp_end; +} + +static inline unsigned int nstack_walk_frame_size(const struct sdesc *sdesc) +{ + return sdesc_fsize(sdesc) + 1 + sdesc_arity(sdesc); +} + +static inline Eterm *nstack_walk_frame_index(Eterm *nsp, unsigned int i) +{ + return &nsp[i]; +} + +static inline unsigned long +nstack_walk_frame_ra(const Eterm *nsp, const struct sdesc *sdesc) +{ + return nsp[sdesc_fsize(sdesc)]; +} + +static inline Eterm *nstack_walk_next_frame(Eterm *nsp, unsigned int sdesc_size) +{ + return nsp + sdesc_size; +} + +#endif /* HIPE_RISC_GC_H */ diff --git a/erts/emulator/hipe/hipe_risc_glue.h b/erts/emulator/hipe/hipe_risc_glue.h new file mode 100644 index 0000000000..3b2d6498d3 --- /dev/null +++ b/erts/emulator/hipe/hipe_risc_glue.h @@ -0,0 +1,266 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_RISC_GLUE_H +#define HIPE_RISC_GLUE_H + +/* arch wrapper does: + * #include "hipe_${arch}_asm.h" // for NR_ARG_REGS, ${ARCH}_LEAF_WORDS + * #define NR_LEAF_WORDS ${ARCH}_LEAF_WORDS + * #define HIPE_ARCH_CALL_TO_NATIVE hipe_${arch}_call_to_native + * #define HIPE_ARCH_RETURN_TO_NATIVE hipe_${arch}_return_to_native + * #define HIPE_ARCH_TAILCALL_TO_NATIVE hipe_${arch}_tailcall_to_native + * #define HIPE_ARCH_THROW_TO_NATIVE hipe_${arch}_throw_to_native + * #include "hipe_risc_glue.h" + */ + +/* Emulated code recursively calls native code. + The return address is `nbif_return', which is exported so that + tailcalls from native to emulated code can be identified. */ +unsigned int HIPE_ARCH_CALL_TO_NATIVE(Process*); +AEXTERN(void,nbif_return,(void)); + +/* Native-mode stubs for calling emulated-mode closures. */ +AEXTERN(void,nbif_ccallemu0,(void)); +AEXTERN(void,nbif_ccallemu1,(void)); +AEXTERN(void,nbif_ccallemu2,(void)); +AEXTERN(void,nbif_ccallemu3,(void)); +AEXTERN(void,nbif_ccallemu4,(void)); +AEXTERN(void,nbif_ccallemu5,(void)); +AEXTERN(void,nbif_ccallemu6,(void)); + +/* Default exception handler for native code. */ +AEXTERN(void,nbif_fail,(void)); + +/* Emulated code returns to its native code caller. */ +unsigned int HIPE_ARCH_RETURN_TO_NATIVE(Process*); + +/* Emulated code tailcalls native code. */ +unsigned int HIPE_ARCH_TAILCALL_TO_NATIVE(Process*); + +/* Emulated code throws an exception to its native code caller. */ +unsigned int HIPE_ARCH_THROW_TO_NATIVE(Process*); + +static __inline__ unsigned int max(unsigned int x, unsigned int y) +{ + return (x > y) ? x : y; +} + +static __inline__ void hipe_arch_glue_init(void) +{ + static struct sdesc_with_exnra nbif_return_sdesc = { + .exnra = (unsigned long)&nbif_fail, + .sdesc = { + .bucket = { .hvalue = (unsigned long)&nbif_return }, + .summary = (1<<8), + }, + }; + hipe_init_sdesc_table(&nbif_return_sdesc.sdesc); +} + +static __inline__ void hipe_push_risc_nra_frame(Process *p) +{ + p->hipe.nsp -= 1; + p->hipe.nsp[0] = (Eterm)p->hipe.nra; +} + +static __inline__ void hipe_pop_risc_nra_frame(Process *p) +{ + p->hipe.nra = (void(*)(void))p->hipe.nsp[0]; + p->hipe.nsp += 1; +} + +/* PRE: arity <= NR_ARG_REGS */ +static __inline__ void +hipe_write_risc_regs(Process *p, unsigned int arity, Eterm reg[]) +{ +#if NR_ARG_REGS > 0 + int i; + for (i = arity; --i >= 0;) + p->def_arg_reg[i] = reg[i]; +#endif +} + +/* PRE: arity <= NR_ARG_REGS */ +static __inline__ void +hipe_read_risc_regs(Process *p, unsigned int arity, Eterm reg[]) +{ +#if NR_ARG_REGS > 0 + int i; + for (i = arity; --i >= 0;) + reg[i] = p->def_arg_reg[i]; +#endif +} + +static __inline__ void +hipe_push_risc_params(Process *p, unsigned int arity, Eterm reg[]) +{ + unsigned int i; + + i = arity; + if (i > NR_ARG_REGS) { + Eterm *nsp = p->hipe.nsp; + i = NR_ARG_REGS; + do { + *--nsp = reg[i++]; + } while (i < arity); + p->hipe.nsp = nsp; + i = NR_ARG_REGS; + } + /* INV: i <= NR_ARG_REGS */ + hipe_write_risc_regs(p, i, reg); +} + +static __inline__ void +hipe_pop_risc_params(Process *p, unsigned int arity, Eterm reg[]) +{ + unsigned int i; + + i = arity; + if (i > NR_ARG_REGS) { + Eterm *nsp = p->hipe.nsp; + do { + reg[--i] = *nsp++; + } while (i > NR_ARG_REGS); + p->hipe.nsp = nsp; + /* INV: i == NR_ARG_REGS */ + } + /* INV: i <= NR_ARG_REGS */ + hipe_read_risc_regs(p, i, reg); +} + +/* BEAM recursively calls native code. */ +static __inline__ unsigned int +hipe_call_to_native(Process *p, unsigned int arity, Eterm reg[]) +{ + int nstkargs; + + if ((nstkargs = arity - NR_ARG_REGS) < 0) + nstkargs = 0; + hipe_check_nstack(p, max(nstkargs + 1, NR_LEAF_WORDS)); + hipe_push_risc_nra_frame(p); /* needs 1 word */ + hipe_push_risc_params(p, arity, reg); /* needs nstkargs words */ + return HIPE_ARCH_CALL_TO_NATIVE(p); +} + +/* Native called BEAM, which now tailcalls native. */ +static __inline__ unsigned int +hipe_tailcall_to_native(Process *p, unsigned int arity, Eterm reg[]) +{ + int nstkargs; + + if ((nstkargs = arity - NR_ARG_REGS) < 0) + nstkargs = 0; + hipe_check_nstack(p, max(nstkargs, NR_LEAF_WORDS)); + hipe_push_risc_params(p, arity, reg); /* needs nstkargs words */ + return HIPE_ARCH_TAILCALL_TO_NATIVE(p); +} + +/* BEAM called native, which has returned. Clean up. */ +static __inline__ void hipe_return_from_native(Process *p) +{ + hipe_pop_risc_nra_frame(p); +} + +/* BEAM called native, which has thrown an exception. Clean up. */ +static __inline__ void hipe_throw_from_native(Process *p) +{ + hipe_pop_risc_nra_frame(p); +} + +/* BEAM called native, which now calls BEAM. + Move the parameters to reg[]. + Return zero if this is a tailcall, non-zero if the call is recursive. + If tailcall, also clean up native stub continuation. */ +static __inline__ int +hipe_call_from_native_is_recursive(Process *p, Eterm reg[]) +{ + hipe_pop_risc_params(p, p->arity, reg); + if (p->hipe.nra != (void(*)(void))&nbif_return) + return 1; + hipe_pop_risc_nra_frame(p); + return 0; +} + +/* Native makes a call which needs to unload the parameters. + This differs from hipe_call_from_native_is_recursive() in + that it doesn't check for or pop the BEAM-calls-native frame. + It's currently only used in the implementation of apply. */ +static __inline__ void +hipe_pop_params(Process *p, unsigned int arity, Eterm reg[]) +{ + hipe_pop_risc_params(p, arity, reg); +} + +/* Native called BEAM, which now returns back to native. */ +static __inline__ unsigned int hipe_return_to_native(Process *p) +{ + return HIPE_ARCH_RETURN_TO_NATIVE(p); +} + +/* Native called BEAM, which now throws an exception back to native. */ +static __inline__ unsigned int hipe_throw_to_native(Process *p) +{ + return HIPE_ARCH_THROW_TO_NATIVE(p); +} + +/* Return the address of a stub switching a native closure call to BEAM. */ +static __inline__ const void *hipe_closure_stub_address(unsigned int arity) +{ +#if NR_ARG_REGS == 0 + return &nbif_ccallemu0; +#else /* > 0 */ + switch (arity) { + case 0: return &nbif_ccallemu0; +#if NR_ARG_REGS == 1 + default: return &nbif_ccallemu1; +#else /* > 1 */ + case 1: return &nbif_ccallemu1; +#if NR_ARG_REGS == 2 + default: return &nbif_ccallemu2; +#else /* > 2 */ + case 2: return &nbif_ccallemu2; +#if NR_ARG_REGS == 3 + default: return &nbif_ccallemu3; +#else /* > 3 */ + case 3: return &nbif_ccallemu3; +#if NR_ARG_REGS == 4 + default: return &nbif_ccallemu4; +#else /* > 4 */ + case 4: return &nbif_ccallemu4; +#if NR_ARG_REGS == 5 + default: return &nbif_ccallemu5; +#else /* > 5 */ + case 5: return &nbif_ccallemu5; +#if NR_ARG_REGS == 6 + default: return &nbif_ccallemu6; +#else +#error "NR_ARG_REGS > 6 NOT YET IMPLEMENTED" +#endif /* > 6 */ +#endif /* > 5 */ +#endif /* > 4 */ +#endif /* > 3 */ +#endif /* > 2 */ +#endif /* > 1 */ + } +#endif /* > 0 */ +} + +#endif /* HIPE_RISC_GLUE_H */ diff --git a/erts/emulator/hipe/hipe_risc_stack.c b/erts/emulator/hipe/hipe_risc_stack.c new file mode 100644 index 0000000000..976ca0b85d --- /dev/null +++ b/erts/emulator/hipe/hipe_risc_stack.c @@ -0,0 +1,312 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" +#include "bif.h" +#include "hipe_stack.h" + +/* get NR_ARG_REGS from the arch */ +#if defined(__arm__) +#include "hipe_arm_asm.h" +#elif defined(__powerpc__) || defined(__ppc__) || defined(__powerpc64__) +#include "hipe_ppc_asm.h" +#elif defined(__sparc__) +#include "hipe_sparc_asm.h" +#endif + +AEXTERN(void,nbif_fail,(void)); +AEXTERN(void,nbif_stack_trap_ra,(void)); + +/* + * hipe_print_nstack() is called from hipe_bifs:show_nstack/1. + */ +static void print_slot(Eterm *sp, unsigned int live) +{ + Eterm val = *sp; + printf(" | 0x%0*lx | 0x%0*lx | ", + 2*(int)sizeof(long), (unsigned long)sp, + 2*(int)sizeof(long), val); + if (live) + erts_printf("%.30T", val); + printf("\r\n"); +} + +void hipe_print_nstack(Process *p) +{ + Eterm *nsp; + Eterm *nsp_end; + const struct sdesc *sdesc1; + const struct sdesc *sdesc; + unsigned long ra; + unsigned long exnra; + unsigned int mask; + unsigned int sdesc_size; + unsigned int i; + unsigned int nstkarity; + static const char dashes[2*sizeof(long)+5] = { + [0 ... 2*sizeof(long)+3] = '-' + }; + + printf(" | NATIVE STACK |\r\n"); + printf(" |%s|%s|\r\n", dashes, dashes); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "heap", + 2*(int)sizeof(long), (unsigned long)p->heap); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "high_water", + 2*(int)sizeof(long), (unsigned long)p->high_water); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "hend", + 2*(int)sizeof(long), (unsigned long)p->htop); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "old_heap", + 2*(int)sizeof(long), (unsigned long)p->old_heap); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "old_hend", + 2*(int)sizeof(long), (unsigned long)p->old_hend); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "nsp", + 2*(int)sizeof(long), (unsigned long)p->hipe.nsp); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "nstend", + 2*(int)sizeof(long), (unsigned long)p->hipe.nstend); + printf(" | %*s| 0x%0*lx |\r\n", + 2+2*(int)sizeof(long)+1, "nstblacklim", + 2*(int)sizeof(long), (unsigned long)p->hipe.nstblacklim); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "nstgraylim", + 2*(int)sizeof(long), (unsigned long)p->hipe.nstgraylim); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "nra", + 2*(int)sizeof(long), (unsigned long)p->hipe.nra); + printf(" | %*s | 0x%0*x |\r\n", + 2+2*(int)sizeof(long), "narity", + 2*(int)sizeof(long), p->hipe.narity); + printf(" |%s|%s|\r\n", dashes, dashes); + printf(" | %*s | %*s |\r\n", + 2+2*(int)sizeof(long), "Address", + 2+2*(int)sizeof(long), "Contents"); + + ra = (unsigned long)p->hipe.nra; + if (!ra) + return; + nsp = p->hipe.nsp; + nsp_end = p->hipe.nstend - 1; + + nstkarity = p->hipe.narity - NR_ARG_REGS; + if ((int)nstkarity < 0) + nstkarity = 0; + + /* First RA not on stack. Dump current args first. */ + printf(" |%s|%s|\r\n", dashes, dashes); + for (i = 0; i < nstkarity; ++i) + print_slot(&nsp[i], 1); + nsp += nstkarity; + + if (ra == (unsigned long)&nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + sdesc = hipe_find_sdesc(ra); + + for (;;) { /* INV: nsp at bottom of frame described by sdesc */ + printf(" |%s|%s|\r\n", dashes, dashes); + if (nsp >= nsp_end) { + if (nsp == nsp_end) + return; + fprintf(stderr, "%s: passed end of stack\r\n", __FUNCTION__); + break; + } + ra = nsp[sdesc_fsize(sdesc)]; + if (ra == (unsigned long)&nbif_stack_trap_ra) + sdesc1 = hipe_find_sdesc((unsigned long)p->hipe.ngra); + else + sdesc1 = hipe_find_sdesc(ra); + sdesc_size = sdesc_fsize(sdesc) + 1 + sdesc_arity(sdesc); + i = 0; + mask = sdesc->livebits[0]; + for (;;) { + if (i == sdesc_fsize(sdesc)) { + printf(" | 0x%0*lx | 0x%0*lx | ", + 2*(int)sizeof(long), (unsigned long)&nsp[i], + 2*(int)sizeof(long), ra); + if (ra == (unsigned long)&nbif_stack_trap_ra) + printf("STACK TRAP, ORIG RA 0x%lx", (unsigned long)p->hipe.ngra); + else + printf("NATIVE RA"); + if ((exnra = sdesc_exnra(sdesc1)) != 0) + printf(", EXNRA 0x%lx", exnra); + printf("\r\n"); + } else + print_slot(&nsp[i], (mask & 1)); + if (++i >= sdesc_size) + break; + if (i & 31) + mask >>= 1; + else + mask = sdesc->livebits[i >> 5]; + } + nsp += sdesc_size; + sdesc = sdesc1; + } + abort(); +} + +/* XXX: x86's values, not yet tuned for anyone else */ +#define MINSTACK 128 +#define NSKIPFRAMES 4 + +void hipe_update_stack_trap(Process *p, const struct sdesc *sdesc) +{ + Eterm *nsp; + Eterm *nsp_end; + unsigned long ra; + int n; + + nsp = p->hipe.nsp; + nsp_end = p->hipe.nstend - 1; + if ((unsigned long)((char*)nsp_end - (char*)nsp) < MINSTACK*sizeof(Eterm*)) { + p->hipe.nstgraylim = NULL; + return; + } + n = NSKIPFRAMES; + for (;;) { + nsp += sdesc_fsize(sdesc); + if (nsp >= nsp_end) { + p->hipe.nstgraylim = NULL; + return; + } + ra = nsp[0]; + if (--n <= 0) + break; + nsp += 1 + sdesc_arity(sdesc); + sdesc = hipe_find_sdesc(ra); + } + p->hipe.nstgraylim = nsp + 1 + sdesc_arity(sdesc); + p->hipe.ngra = (void(*)(void))ra; + nsp[0] = (unsigned long)&nbif_stack_trap_ra; +} + +/* + * hipe_handle_stack_trap() is called when the mutator returns to + * nbif_stack_trap_ra, which marks the gray/white stack boundary frame. + * The gray/white boundary is moved back one or more frames. + * + * The function head below is "interesting". + */ +void (*hipe_handle_stack_trap(Process *p))(void) +{ + void (*ngra)(void) = p->hipe.ngra; + const struct sdesc *sdesc = hipe_find_sdesc((unsigned long)ngra); + hipe_update_stack_trap(p, sdesc); + return ngra; +} + +/* + * hipe_find_handler() is called from hipe_handle_exception() to locate + * the current exception handler's PC and SP. + * The native stack MUST contain a stack frame as it appears on + * entry to a function (actuals, caller's frame, caller's return address). + * p->hipe.narity MUST contain the arity (number of actuals). + * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp + * is set to its SP (low address of its stack frame). + */ +void hipe_find_handler(Process *p) +{ + Eterm *nsp; + Eterm *nsp_end; + unsigned long ra; + unsigned long exnra; + unsigned int arity; + const struct sdesc *sdesc; + + nsp = p->hipe.nsp; + nsp_end = p->hipe.nstend; + arity = p->hipe.narity - NR_ARG_REGS; + if ((int)arity < 0) + arity = 0; + + ra = (unsigned long)p->hipe.nra; + + while (nsp < nsp_end) { + nsp += arity; /* skip actuals */ + if (ra == (unsigned long)&nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + sdesc = hipe_find_sdesc(ra); + if ((exnra = sdesc_exnra(sdesc)) != 0 && + (p->catches >= 0 || + exnra == (unsigned long)&nbif_fail)) { + p->hipe.ncallee = (void(*)(void)) exnra; + p->hipe.nsp = nsp; + p->hipe.narity = 0; + /* update the gray/white boundary if we threw past it */ + if (p->hipe.nstgraylim && nsp >= p->hipe.nstgraylim) + hipe_update_stack_trap(p, sdesc); + return; + } + nsp += sdesc_fsize(sdesc); /* skip locals */ + arity = sdesc_arity(sdesc); + ra = *nsp++; /* fetch & skip saved ra */ + } + fprintf(stderr, "%s: no native CATCH found!\r\n", __FUNCTION__); + abort(); +} + +int hipe_fill_stacktrace(Process *p, int depth, Eterm **trace) +{ + Eterm *nsp; + Eterm *nsp_end; + unsigned long ra, prev_ra; + unsigned int arity; + const struct sdesc *sdesc; + int i; + + if (depth < 1) + return 0; + + nsp = p->hipe.nsp; + nsp_end = p->hipe.nstend; + arity = p->hipe.narity - NR_ARG_REGS; + if ((int)arity < 0) + arity = 0; + + ra = (unsigned long)p->hipe.nra; + prev_ra = 0; + i = 0; + for (;;) { + if (ra == (unsigned long)nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + if (ra != prev_ra) { + trace[i] = (Eterm*)ra; + ++i; + if (i == depth) + break; + prev_ra = ra; + } + if (nsp >= nsp_end) + break; + sdesc = hipe_find_sdesc(ra); + nsp += arity + sdesc_fsize(sdesc); + arity = sdesc_arity(sdesc); + ra = *nsp++; + } + return i; +} diff --git a/erts/emulator/hipe/hipe_signal.h b/erts/emulator/hipe/hipe_signal.h new file mode 100644 index 0000000000..3c3c844d52 --- /dev/null +++ b/erts/emulator/hipe/hipe_signal.h @@ -0,0 +1,39 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_signal.h + * + * Architecture-specific initialisation of Unix signals. + */ +#ifndef HIPE_SIGNAL_H +#define HIPE_SIGNAL_H + +#if defined(__i386__) || defined(__x86_64__) +extern void hipe_signal_init(void); +#else +static __inline__ void hipe_signal_init(void) { } +#endif + +#if defined(ERTS_SMP) && (defined(__i386__) || defined(__x86_64__)) +extern void hipe_thread_signal_init(void); +#else +static __inline__ void hipe_thread_signal_init(void) { } +#endif + +#endif /* HIPE_SIGNAL_H */ diff --git a/erts/emulator/hipe/hipe_sparc.c b/erts/emulator/hipe/hipe_sparc.c new file mode 100644 index 0000000000..661b42130a --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc.c @@ -0,0 +1,243 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#include /* offsetof() */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" +#include + +#include "hipe_arch.h" +#include "hipe_native_bif.h" /* nbif_callemu() */ + +/* Flush dcache and invalidate icache for a range of addresses. */ +void hipe_flush_icache_range(void *address, unsigned int nbytes) +{ + char *a = (char*)address; + int n = nbytes; + + while (n > 0) { + hipe_flush_icache_word(a); + a += 4; + n -= 4; + } +} + +static void patch_sethi(Uint32 *address, unsigned int imm22) +{ + unsigned int insn = *address; + *address = (insn & 0xFFC00000) | (imm22 & 0x003FFFFF); + hipe_flush_icache_word(address); +} + +static void patch_ori(Uint32 *address, unsigned int imm10) +{ + /* address points to an OR reg,imm,reg insn */ + unsigned int insn = *address; + *address = (insn & 0xFFFFE000) | (imm10 & 0x3FF); + hipe_flush_icache_word(address); +} + +static void patch_sethi_ori(Uint32 *address, Uint32 value) +{ + patch_sethi(address, value >> 10); + patch_ori(address+1, value); +} + +void hipe_patch_load_fe(Uint32 *address, Uint32 value) +{ + patch_sethi_ori(address, value); +} + +int hipe_patch_insn(void *address, Uint32 value, Eterm type) +{ + switch (type) { + case am_load_mfa: + case am_atom: + case am_constant: + case am_closure: + case am_c_const: + break; + default: + return -1; + } + patch_sethi_ori((Uint32*)address, value); + return 0; +} + +int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline) +{ + Uint32 relDest, newI; + + if (trampoline) + return -1; + relDest = (Uint32)((Sint32)destAddress - (Sint32)callAddress); + newI = (1 << 30) | (relDest >> 2); + *(Uint32*)callAddress = newI; + hipe_flush_icache_word(callAddress); + return 0; +} + +/* + * Memory allocator for executable code. + * + * This is required on x86 because some combinations + * of Linux kernels and CPU generations default to + * non-executable memory mappings, causing ordinary + * malloc() memory to be non-executable. + */ +static unsigned int code_bytes; +static char *code_next; + +#if 0 /* change to non-zero to get allocation statistics at exit() */ +static unsigned int total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs, nr_large, total_lost; +static unsigned int atexit_done; + +static void alloc_code_stats(void) +{ + printf("\r\nalloc_code_stats: %u bytes mapped, %u joins, %u splits, %u bytes allocated, %u average alloc, %u large allocs, %u bytes lost\r\n", + total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs ? total_alloc/nr_allocs : 0, nr_large, total_lost); +} + +static void atexit_alloc_code_stats(void) +{ + if (!atexit_done) { + atexit_done = 1; + (void)atexit(alloc_code_stats); + } +} + +#define ALLOC_CODE_STATS(X) do{X;}while(0) +#else +#define ALLOC_CODE_STATS(X) do{}while(0) +#endif + +static void morecore(unsigned int alloc_bytes) +{ + unsigned int map_bytes; + char *map_hint, *map_start; + + /* Page-align the amount to allocate. */ + map_bytes = (alloc_bytes + 4095) & ~4095; + + /* Round up small allocations. */ + if (map_bytes < 1024*1024) + map_bytes = 1024*1024; + else + ALLOC_CODE_STATS(++nr_large); + + /* Create a new memory mapping, ensuring it is executable + and in the low 2GB of the address space. Also attempt + to make it adjacent to the previous mapping. */ + map_hint = code_next + code_bytes; + if ((unsigned long)map_hint & 4095) + abort(); + map_start = mmap(map_hint, map_bytes, + PROT_EXEC|PROT_READ|PROT_WRITE, + MAP_PRIVATE|MAP_ANONYMOUS +#ifdef __x86_64__ + |MAP_32BIT +#endif + , + -1, 0); + if (map_start == MAP_FAILED) { + perror("mmap"); + abort(); + } + ALLOC_CODE_STATS(total_mapped += map_bytes); + + /* Merge adjacent mappings, so the trailing portion of the previous + mapping isn't lost. In practice this is quite successful. */ + if (map_start == map_hint) { + ALLOC_CODE_STATS(++nr_joins); + code_bytes += map_bytes; + } else { + ALLOC_CODE_STATS(++nr_splits); + ALLOC_CODE_STATS(total_lost += code_bytes); + code_next = map_start; + code_bytes = map_bytes; + } + + ALLOC_CODE_STATS(atexit_alloc_code_stats()); +} + +static void *alloc_code(unsigned int alloc_bytes) +{ + void *res; + + /* Align function entries. */ + alloc_bytes = (alloc_bytes + 3) & ~3; + + if (code_bytes < alloc_bytes) + morecore(alloc_bytes); + ALLOC_CODE_STATS(++nr_allocs); + ALLOC_CODE_STATS(total_alloc += alloc_bytes); + res = code_next; + code_next += alloc_bytes; + code_bytes -= alloc_bytes; + return res; +} + +void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p) +{ + if (is_not_nil(callees)) + return NULL; + *trampolines = NIL; + return alloc_code(nrbytes); +} + +/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() + and hipe_bif0.c:hipe_make_stub() */ +void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +{ + unsigned int *code; + unsigned int callEmuOffset; + int i; + + code = alloc_code(5*sizeof(int)); + + /* sethi %hi(Address), %i4 */ + code[0] = 0x39000000 | (((unsigned int)beamAddress >> 10) & 0x3FFFFF); + /* or %g0, %o7, %i3 ! mov %o7, %i3 */ + code[1] = 0xB610000F; + /* or %i4, %lo(Address), %i4 */ + code[2] = 0xB8172000 | ((unsigned int)beamAddress & 0x3FF); + /* call callemu */ + callEmuOffset = (char*)nbif_callemu - (char*)&code[3]; + code[3] = (1 << 30) | ((callEmuOffset >> 2) & 0x3FFFFFFF); + /* or %g0, Arity, %i5 ! mov Arity, %i5 */ + code[4] = 0xBA102000 | (beamArity & 0x0FFF); + + /* flush I-cache as if by write_u32() */ + for (i = 0; i < 5; ++i) + hipe_flush_icache_word(&code[i]); + + return code; +} + +void hipe_arch_print_pcb(struct hipe_process_state *p) +{ +#define U(n,x) \ + printf(" % 4d | %s | 0x%0*lx | %*s |\r\n", (int)offsetof(struct hipe_process_state,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2+2*(int)sizeof(long), "") + U("nra ", nra); + U("narity ", narity); +#undef U +} diff --git a/erts/emulator/hipe/hipe_sparc.h b/erts/emulator/hipe/hipe_sparc.h new file mode 100644 index 0000000000..53cb18ee45 --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc.h @@ -0,0 +1,54 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_SPARC_H +#define HIPE_SPARC_H + +static __inline__ void hipe_flush_icache_word(void *address) +{ + asm volatile("flush %0" + : /* no outputs */ + : "r"(address) + : "memory"); +} + +extern void hipe_flush_icache_range(void *address, unsigned int nbytes); + +/* for stack descriptor hash lookup */ +#define HIPE_RA_LSR_COUNT 2 /* low 2 bits are always zero */ + +/* for hipe_bifs_{read,write}_{s,u}32 */ +static __inline__ int hipe_word32_address_ok(void *address) +{ + return ((unsigned long)address & 0x3) == 0; +} + +/* Native stack growth direction. */ +#define HIPE_NSTACK_GROWS_DOWN + +#define hipe_arch_name am_ultrasparc + +extern void hipe_sparc_inc_stack(void); + +/* for hipe_bifs_enter_code_2 */ +extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); +#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p)) + +#endif /* HIPE_SPARC_H */ diff --git a/erts/emulator/hipe/hipe_sparc.tab b/erts/emulator/hipe/hipe_sparc.tab new file mode 100644 index 0000000000..f192e1f81c --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc.tab @@ -0,0 +1,23 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# $Id$ +# SPARC-specific atoms + +atom inc_stack_0 +atom ultrasparc diff --git a/erts/emulator/hipe/hipe_sparc_abi.txt b/erts/emulator/hipe/hipe_sparc_abi.txt new file mode 100644 index 0000000000..d016a96c1c --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc_abi.txt @@ -0,0 +1,78 @@ + + %CopyrightBegin% + %CopyrightEnd% + +$Id$ + +HiPE SPARC ABI +============== +This document describes aspects of HiPE's runtime system +that are specific for the SPARC architecture. + +Register Usage +-------------- +%g6, %g7, %o6 (%sp), and %i6 (%fp) are reserved for the C runtime system. + +%i0-%i2 are fixed (unallocatable). +%i0 (P) is the current process' "Process" pointer. +%i1 (NSP) is the current process' native stack pointer. +%i2 (HP) is the current process' heap pointer. + +%g1-%g5, %o0-%o5, %o7 (RA), %l0-%l7, %i3-%i5, and %i7 are caller-save. +They are used as temporary scratch registers and for function call +parameters and results. + +The runtime system uses temporaries in specific contexts: +%i5 (TEMP_ARG1) is used to pass the callee arity in native-to-BEAM traps. +%i4 (TEMP_ARG0) is used to preserve the return value in nbif_stack_trap_ra, +preserve RA in hipe_sparc_inc_stack (the caller saved its RA in +TEMP_RA), to pass the callee address in native-to-BEAM traps, +and to contain the target in BEAM-to-native calls. +%i3 (TEMP_RA) is used to preserve RA around BIF calls. +%o1 (ARG0) is used for MBUF-after-BIF checks, for storing the +arity of a BIF that throws an exception or does GC due to MBUF, +and for checking P->flags for pending timeout. +%o0 is used to inspect the type of a thrown exception, and to +return a result token from glue.S back to hipe_mode_switch(). + +Calling Convention +------------------ +The first NR_ARG_REGS parameters (a tunable parameter between 0 and 6, +inclusive) are passed in %o1-%o5 and %o0. + +%o0 is not used for parameter passing. This allows the BIF wrappers to +simply move P to %o0 without shifting the remaining parameter registers. + +%o7 (RA) contains the return address during function calls. + +The return value from a function is placed in %o0. + +Stack Frame Layout +Stack Descriptors +----------------- +Same as AMD64/ARM/PowerPC/x86. + +Standard SPARC Calling Conventions +================================== + +Reg Status Role +--- ------ ---- +%g0 reserved constant 0 +%g1-%g5 calleR-save volatile +%g6-%g7 reserved thread register? got? +%o0 calleR-save volatile, parameter, return value +%o1-%o5 calleR-save volatile, parameters +%o6 reserved stack pointer, 8-byte aligned +%o7 reserved return address +%l0-%l7 calleE-save local variables +%i0-%i5 calleE-save input parameters, local variables +%i6 calleE-save frame pointer (caller's stack pointer) +%i7 calleE-save input return address, local variable + +The stack grows from high to low addresses. +Excess parameters are stored on the stack, at %sp+92 and up. + +See also: +http://soldc.sun.com/articles/sparcv9abi.html +http://www.users.qwest.net/~eballen1/sparc.tech.links.html +http://compilers.iecc.com/comparch/article/93-12-073 diff --git a/erts/emulator/hipe/hipe_sparc_asm.m4 b/erts/emulator/hipe/hipe_sparc_asm.m4 new file mode 100644 index 0000000000..7a4403ac09 --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc_asm.m4 @@ -0,0 +1,214 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ +`#ifndef HIPE_SPARC_ASM_H +#define HIPE_SPARC_ASM_H' + +/* + * Tunables. + */ +define(LEAF_WORDS,16)dnl number of stack words for leaf functions +define(NR_ARG_REGS,4)dnl admissible values are 0 to 6, inclusive + +`#define SPARC_LEAF_WORDS 'LEAF_WORDS + +/* + * Reserved registers. + */ +`#define RA %o7' +`#define P %i0' +`#define NSP %i1' +`#define HP %i2' +`#define TEMP_RA %i3' + +/* + * Context switching macros. + * + * RESTORE_CONTEXT and RESTORE_CONTEXT_QUICK do not affect + * the condition register. + */ +`#define SAVE_CONTEXT_QUICK \ + mov RA, TEMP_RA' + +`#define RESTORE_CONTEXT_QUICK \ + mov TEMP_RA, RA' + +`#define SAVE_CACHED_STATE \ + st HP, [P+P_HP]; \ + st NSP, [P+P_NSP]' + +`#define RESTORE_CACHED_STATE \ + ld [P+P_HP], HP; \ + ld [P+P_NSP], NSP' + +`#define SAVE_CONTEXT_BIF \ + mov RA, TEMP_RA; \ + st HP, [P+P_HP]' + +`#define RESTORE_CONTEXT_BIF \ + mov TEMP_RA, RA; /* XXX unnecessary */\ + ld [P+P_HP], HP' + +`#define SAVE_CONTEXT_GC \ + mov RA, TEMP_RA; \ + st RA, [P+P_NRA]; \ + st NSP, [P+P_NSP]; \ + st HP, [P+P_HP]' + +`#define RESTORE_CONTEXT_GC \ + mov TEMP_RA, RA; /* XXX unnecessary */\ + ld [P+P_HP], HP' + +/* + * Argument (parameter) registers. + */ +`#define SPARC_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +define(defarg,`define(ARG$1,`$2')dnl +#`define ARG'$1 $2' +)dnl + +ifelse(eval(NR_ARG_REGS >= 1),0,, +`defarg(0,`%o1')')dnl +ifelse(eval(NR_ARG_REGS >= 2),0,, +`defarg(1,`%o2')')dnl +ifelse(eval(NR_ARG_REGS >= 3),0,, +`defarg(2,`%o3')')dnl +ifelse(eval(NR_ARG_REGS >= 4),0,, +`defarg(3,`%o4')')dnl +ifelse(eval(NR_ARG_REGS >= 5),0,, +`defarg(4,`%o5')')dnl +ifelse(eval(NR_ARG_REGS >= 6),0,, +`defarg(5,`%o0')')dnl + +/* + * TEMP_ARG0: + * Used in nbif_stack_trap_ra to preserve the return value. + * Must be a C callee-save register. + * Must be otherwise unused in the return path. + * + * TEMP_ARG0: + * Used in hipe_sparc_inc_stack to preserve the return address + * (TEMP_RA contains the caller's saved return address). + * Must be a C callee-save register. + * Must be otherwise unused in the call path. + * + * TEMP_ARG0: + * Used to pass the callee address in native-to-BEAM traps + * (nbif_callemu). + * Must be otherwise unused in the call path. + * + * TEMP_ARG1: + * Used to pass the callee arity in native-to-BEAM traps + * (nbif_callemu). + * Must be otherwise unused in the call path. + */ +`#define TEMP_ARG0 %i4' +`#define TEMP_ARG1 %i5' + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_sparc_glue.S support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl LOAD_ARG_REGS +dnl +define(LAR_1,`ld [P+P_ARG$1], ARG$1 ; ')dnl +define(LAR_N,`ifelse(eval($1 >= 0),0,,`LAR_N(eval($1-1))LAR_1($1)')')dnl +define(LOAD_ARG_REGS,`LAR_N(eval(NR_ARG_REGS-1))')dnl +`#define LOAD_ARG_REGS 'LOAD_ARG_REGS + +dnl +dnl STORE_ARG_REGS +dnl +define(SAR_1,`st ARG$1, [P+P_ARG$1] ; ')dnl +define(SAR_N,`ifelse(eval($1 >= 0),0,,`SAR_N(eval($1-1))SAR_1($1)')')dnl +define(STORE_ARG_REGS,`SAR_N(eval(NR_ARG_REGS-1))')dnl +`#define STORE_ARG_REGS 'STORE_ARG_REGS + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_arm_bifs.m4 support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl NBIF_ARG(DST,ARITY,ARGNO) +dnl Access a formal parameter. +dnl It will be a memory load via NSP when ARGNO >= NR_ARG_REGS. +dnl It will be a register move when 0 <= ARGNO < NR_ARG_REGS; if +dnl the source and destination are the same, the move is suppressed. +dnl +define(NBIF_MOVE_REG,`ifelse($1,$2,`! mov $2, $1',`mov $2, $1')')dnl +define(NBIF_REG_ARG,`NBIF_MOVE_REG($1,ARG$2)')dnl +define(NBIF_STK_LOAD,`ld [NSP+$2], $1')dnl +define(NBIF_STK_ARG,`NBIF_STK_LOAD($1,eval(4*(($2-$3)-1)))')dnl +define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_REG_ARG($1,$3)',`NBIF_STK_ARG($1,$2,$3)')')dnl +`/* #define NBIF_ARG_1_0 'NBIF_ARG(r1,1,0)` */' +`/* #define NBIF_ARG_2_0 'NBIF_ARG(r1,2,0)` */' +`/* #define NBIF_ARG_2_1 'NBIF_ARG(r2,2,1)` */' +`/* #define NBIF_ARG_3_0 'NBIF_ARG(r1,3,0)` */' +`/* #define NBIF_ARG_3_1 'NBIF_ARG(r2,3,1)` */' +`/* #define NBIF_ARG_3_2 'NBIF_ARG(r3,3,2)` */' +`/* #define NBIF_ARG_5_0 'NBIF_ARG(r1,5,0)` */' +`/* #define NBIF_ARG_5_1 'NBIF_ARG(r2,5,1)` */' +`/* #define NBIF_ARG_5_2 'NBIF_ARG(r3,5,2)` */' +`/* #define NBIF_ARG_5_3 'NBIF_ARG(r4,5,3)` */' +`/* #define NBIF_ARG_5_4 'NBIF_ARG(r5,5,4)` */' + +dnl +dnl NBIF_RET(ARITY) +dnl Generates a return from a native BIF, taking care to pop +dnl any stacked formal parameters. +dnl May only be used in BIF/primop wrappers where SAVE_CONTEXT +dnl has saved RA in TEMP_RA. +dnl +define(NSP_RETN,`jmpl TEMP_RA+8, %g0 + add NSP, $1, NSP')dnl +define(NSP_RET0,`jmpl TEMP_RA+8, %g0 + nop')dnl +define(RET_POP,`ifelse(eval($1 > NR_ARG_REGS),0,0,eval(4*($1 - NR_ARG_REGS)))')dnl +define(NBIF_RET_N,`ifelse(eval($1),0,`NSP_RET0',`NSP_RETN($1)')')dnl +define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl +`/* #define NBIF_RET_0 'NBIF_RET(0)` */' +`/* #define NBIF_RET_1 'NBIF_RET(1)` */' +`/* #define NBIF_RET_2 'NBIF_RET(2)` */' +`/* #define NBIF_RET_3 'NBIF_RET(3)` */' +`/* #define NBIF_RET_5 'NBIF_RET(5)` */' + +dnl +dnl QUICK_CALL_RET(CFUN,ARITY) +dnl Used in nocons_nofail and noproc primop interfaces to optimise +dnl SAVE_CONTEXT_QUICK; call CFUN; nop; RESTORE_CONTEXT_QUICK; NBIF_RET(ARITY). +dnl +define(NBIF_POP_N,`ifelse(eval($1),0,`nop',`add NSP, $1, NSP')')dnl +define(QUICK_CALL_RET,`ba $1; NBIF_POP_N(eval(RET_POP($2)))')dnl +`/* #define QUICK_CALL_RET_F_0 'QUICK_CALL_RET(F,0)` */' +`/* #define QUICK_CALL_RET_F_1 'QUICK_CALL_RET(F,1)` */' +`/* #define QUICK_CALL_RET_F_2 'QUICK_CALL_RET(F,2)` */' +`/* #define QUICK_CALL_RET_F_3 'QUICK_CALL_RET(F,3)` */' +`/* #define QUICK_CALL_RET_F_5 'QUICK_CALL_RET(F,5)` */' + +`#endif /* HIPE_SPARC_ASM_H */' diff --git a/erts/emulator/hipe/hipe_sparc_bifs.m4 b/erts/emulator/hipe/hipe_sparc_bifs.m4 new file mode 100644 index 0000000000..f3753b3847 --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc_bifs.m4 @@ -0,0 +1,578 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ + +include(`hipe/hipe_sparc_asm.m4') +#`include' "hipe_literals.h" + + .section ".text" + .align 4 + +/* + * Test for exception. This macro executes its delay slot. + */ +`#define __TEST_GOT_EXN(LABEL) cmp %o0, THE_NON_VALUE; bz,pn %icc, LABEL +#define TEST_GOT_EXN(ARITY) __TEST_GOT_EXN(JOIN3(nbif_,ARITY,_simple_exception))' + +`#define TEST_GOT_MBUF ld [P+P_MBUF], %o1; cmp %o1, 0; bne 3f; nop; 2: +#define JOIN3(A,B,C) A##B##C +#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); nop; b 2b; nop' + +/* + * standard_bif_interface_1(nbif_name, cbif_name) + * standard_bif_interface_2(nbif_name, cbif_name) + * standard_bif_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 1-3 parameters and + * standard failure mode. + */ +define(standard_bif_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + TEST_GOT_EXN(1) + RESTORE_CONTEXT_BIF + NBIF_RET(1) + HANDLE_GOT_MBUF(1) + .size $1, .-$1 + .type $1, #function +#endif') + +define(standard_bif_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,2,0) + NBIF_ARG(%o2,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + TEST_GOT_EXN(2) + RESTORE_CONTEXT_BIF + NBIF_RET(2) + HANDLE_GOT_MBUF(2) + .size $1, .-$1 + .type $1, #function +#endif') + +define(standard_bif_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,3,0) + NBIF_ARG(%o2,3,1) + NBIF_ARG(%o3,3,2) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + TEST_GOT_EXN(3) + RESTORE_CONTEXT_BIF + NBIF_RET(3) + HANDLE_GOT_MBUF(3) + .size $1, .-$1 + .type $1, #function +#endif') + +/* + * fail_bif_interface_0(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 0 parameters and + * standard failure mode. + */ +define(fail_bif_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + TEST_GOT_EXN(0) + RESTORE_CONTEXT_BIF + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + .size $1, .-$1 + .type $1, #function +#endif') + +/* + * gc_bif_interface_0(nbif_name, cbif_name) + * gc_bif_interface_1(nbif_name, cbif_name) + * gc_bif_interface_2(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 0-2 parameters and + * standard failure mode. + * The BIF may do a GC. + */ +define(gc_bif_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_GC + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + .size $1, .-$1 + .type $1, #function +#endif') + +define(gc_bif_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + TEST_GOT_EXN(1) + RESTORE_CONTEXT_GC + NBIF_RET(1) + HANDLE_GOT_MBUF(1) + .size $1, .-$1 + .type $1, #function +#endif') + +define(gc_bif_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,2,0) + NBIF_ARG(%o2,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. Check for exception. */ + TEST_GOT_EXN(2) + RESTORE_CONTEXT_GC + NBIF_RET(2) + HANDLE_GOT_MBUF(2) + .size $1, .-$1 + .type $1, #function +#endif') + +/* + * gc_nofail_primop_interface_1(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 1 ordinary parameter and no failure mode. + * The primop may do a GC. + */ +define(gc_nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_GC + call $2 + nop + + /* Restore register. */ + RESTORE_CONTEXT_GC + NBIF_RET(1) + .size $1, .-$1 + .type $1, #function +#endif') + +/* + * nofail_primop_interface_0(nbif_name, cbif_name) + * nofail_primop_interface_1(nbif_name, cbif_name) + * nofail_primop_interface_2(nbif_name, cbif_name) + * nofail_primop_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 ordinary parameters and no failure mode. + * Also used for guard BIFs. + */ +define(nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + .size $1, .-$1 + .type $1, #function +#endif') + +define(nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,1,0) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(1) + HANDLE_GOT_MBUF(1) + .size $1, .-$1 + .type $1, #function +#endif') + +define(nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,2,0) + NBIF_ARG(%o2,2,1) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(2) + HANDLE_GOT_MBUF(2) + .size $1, .-$1 + .type $1, #function +#endif') + +define(nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,3,0) + NBIF_ARG(%o2,3,1) + NBIF_ARG(%o3,3,2) + + /* Save caller-save registers and call the C function. */ + SAVE_CONTEXT_BIF + call $2 + nop + TEST_GOT_MBUF + + /* Restore registers. */ + RESTORE_CONTEXT_BIF + NBIF_RET(3) + HANDLE_GOT_MBUF(3) + .size $1, .-$1 + .type $1, #function +#endif') + +/* + * nocons_nofail_primop_interface_0(nbif_name, cbif_name) + * nocons_nofail_primop_interface_1(nbif_name, cbif_name) + * nocons_nofail_primop_interface_2(nbif_name, cbif_name) + * nocons_nofail_primop_interface_3(nbif_name, cbif_name) + * nocons_nofail_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(nocons_nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,0) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +define(nocons_nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,1,0) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,1) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +define(nocons_nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,2,0) + NBIF_ARG(%o2,2,1) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,2) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +define(nocons_nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,3,0) + NBIF_ARG(%o2,3,1) + NBIF_ARG(%o3,3,2) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,3) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +define(nocons_nofail_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + mov P, %o0 + NBIF_ARG(%o1,5,0) + NBIF_ARG(%o2,5,1) + NBIF_ARG(%o3,5,2) + NBIF_ARG(%o4,5,3) + NBIF_ARG(%o5,5,4) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,5) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +/* + * noproc_primop_interface_0(nbif_name, cbif_name) + * noproc_primop_interface_1(nbif_name, cbif_name) + * noproc_primop_interface_2(nbif_name, cbif_name) + * noproc_primop_interface_3(nbif_name, cbif_name) + * noproc_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with no implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(noproc_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* XXX: this case is always trivial; how to suppress the branch? */ + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,0) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +define(noproc_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + NBIF_ARG(%o0,1,0) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,1) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +define(noproc_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + NBIF_ARG(%o0,2,0) + NBIF_ARG(%o1,2,1) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,2) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +define(noproc_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + NBIF_ARG(%o0,3,0) + NBIF_ARG(%o1,3,1) + NBIF_ARG(%o2,3,2) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,3) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +define(noproc_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + .global $1 +$1: + /* Set up C argument registers. */ + NBIF_ARG(%o0,5,0) + NBIF_ARG(%o1,5,1) + NBIF_ARG(%o2,5,2) + NBIF_ARG(%o3,5,3) + NBIF_ARG(%o4,5,4) + + /* Perform a quick save;call;restore;ret sequence. */ + QUICK_CALL_RET($2,5) + nop + .size $1, .-$1 + .type $1, #function +#endif') + +include(`hipe/hipe_bif_list.m4') + +`#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif' diff --git a/erts/emulator/hipe/hipe_sparc_gc.h b/erts/emulator/hipe/hipe_sparc_gc.h new file mode 100644 index 0000000000..9035f5baee --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc_gc.h @@ -0,0 +1,29 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * Stack walking helpers for native stack GC procedures. + * SPARC version. + */ +#ifndef HIPE_SPARC_GC_H +#define HIPE_SPARC_GC_H + +#include "hipe_sparc_asm.h" /* for NR_ARG_REGS */ +#include "hipe_risc_gc.h" + +#endif /* HIPE_SPARC_GC_H */ diff --git a/erts/emulator/hipe/hipe_sparc_glue.S b/erts/emulator/hipe/hipe_sparc_glue.S new file mode 100644 index 0000000000..d1af5c43f5 --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc_glue.S @@ -0,0 +1,448 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#include "hipe_sparc_asm.h" +#include "hipe_literals.h" +#define ASM +#include "hipe_mode_switch.h" + + .section ".text" + .align 4 + +/* + * Enter Erlang from C. + * Switch to a new register window. + * Create a new frame on the C stack. + * Save C return address in the frame. + * Retrieve the process pointer from the C argument registers. + */ +#define ENTER_FROM_C \ + save %sp, -112, %sp; \ + st %i7, [%sp+96] + +/* + * Return to the calling C function. + * The return value is in %o0. + * + * .flush_exit saves NSP and other cached P state. + * .suspend_exit also saves RA. + */ +.suspend_exit: + /* save RA, so we can be resumed */ + st RA, [P+P_NRA] +.flush_exit: + /* restore C return address (hoisted to avoid stall) */ + ld [%sp+96], %i7 + /* flush cached P state */ + SAVE_CACHED_STATE + /* restore callee-save registers, drop frame, return */ + jmp %i7+8 /* ret */ + restore %g0, %o0, %o0 /* kills P, moves our %o0 to caller's %o0 */ + +/* + * int hipe_sparc_call_to_native(Process *p); + * Emulated code recursively calls native code. + */ + .global hipe_sparc_call_to_native + .type hipe_sparc_call_to_native, #function + .proc 04 /* ??? */ +hipe_sparc_call_to_native: + ENTER_FROM_C + /* prepare to call the target */ + ld [P+P_NCALLEE], TEMP_ARG0 + /* get argument registers */ + LOAD_ARG_REGS + /* cache some P state in registers */ + RESTORE_CACHED_STATE +/* FALLTHROUGH + * + * We export this return address so that hipe_mode_switch() can discover + * when native code tailcalls emulated code. + * Note: this is SPARC, so the value in the return address register + * is the address of the call/jmpl instruction itself. + */ + .global nbif_return +nbif_return: + /* call the target */ + jmpl TEMP_ARG0, RA + nop +/* FALLTHROUGH + * + * This is where native code returns to emulated code. + */ + st %o0, [P+P_ARG0] /* save retval */ + ba .flush_exit + mov HIPE_MODE_SWITCH_RES_RETURN, %o0 + +/* + * int hipe_sparc_return_to_native(Process *p); + * Emulated code returns to its native code caller. + */ + .global hipe_sparc_return_to_native + .type hipe_sparc_return_to_native, #function + .proc 04 /* ??? */ +hipe_sparc_return_to_native: + ENTER_FROM_C + /* restore return address */ + ld [P+P_NRA], RA + /* cache some P state in registers */ + RESTORE_CACHED_STATE + /* + * Return using the current return address. + * The parameters were popped at the original native-to-emulated + * call (hipe_call_from_native_is_recursive), so a plain ret suffices. + */ + jmp RA+8 + ld [P+P_ARG0], %o0 /* delay slot: get return value */ + +/* + * int hipe_sparc_tailcall_to_native(Process *); + * Emulated code tailcalls native code. + */ + .global hipe_sparc_tailcall_to_native + .type hipe_sparc_tailcall_to_native, #function + .proc 04 /* ??? */ +hipe_sparc_tailcall_to_native: + ENTER_FROM_C + /* prepare to call the target */ + ld [P+P_NCALLEE], TEMP_ARG0 + /* get argument registers */ + LOAD_ARG_REGS + /* cache some P state in registers */ + RESTORE_CACHED_STATE + /* call the target */ + jmp TEMP_ARG0 + ld [P+P_NRA], RA /* delay slot: restore return address */ + +/* + * int hipe_sparc_throw_to_native(Process *p); + * Emulated code throws an exception to its native code caller. + */ + .align 4 + .global hipe_sparc_throw_to_native + .type hipe_sparc_throw_to_native, #function + .proc 04 /* ??? */ +hipe_sparc_throw_to_native: + ENTER_FROM_C + /* prepare to invoke handler */ + ld [P+P_NCALLEE], TEMP_ARG0 /* set by hipe_find_handler() */ + /* cache some P state in registers */ + RESTORE_CACHED_STATE + /* invoke the handler */ + jmp TEMP_ARG0 + nop + +/* + * Native code calls emulated code via a stub + * which should look as follows: + * + * stub for f/N: + * sethi %hi(f's BEAM code address), TEMP_ARG0 + * mov RA, TEMP_RA ! because the call below clobbers RA (%o7) + * or TEMP_ARG0, %lo(f's BEAM code address), TEMP_ARG0 + * call nbif_callemu ! clobbers RA! + * mov N, TEMP_ARG1 ! delay slot: TEMP_ARG1 := ARITY + * + * XXX. Different stubs for different number of register parameters? + */ + .global nbif_callemu +nbif_callemu: + st TEMP_ARG0, [P+P_BEAM_IP] + st TEMP_ARG1, [P+P_ARITY] + st TEMP_RA, [P+P_NRA] + STORE_ARG_REGS + ba .flush_exit + mov HIPE_MODE_SWITCH_RES_CALL, %o0 + +/* + * nbif_apply + */ + .global nbif_apply +nbif_apply: + STORE_ARG_REGS + ba .suspend_exit + mov HIPE_MODE_SWITCH_RES_APPLY, %o0 + +/* + * Native code calls an emulated-mode closure via a stub defined below. + * + * The closure is appended as the last actual parameter, and parameters + * beyond the first few passed in registers are pushed onto the stack in + * left-to-right order. + * Hence, the location of the closure parameter only depends on the number + * of parameters in registers, not the total number of parameters. + */ +#if NR_ARG_REGS >= 6 + .global nbif_ccallemu6 +nbif_ccallemu6: + st ARG5, [P+P_ARG5] +#if NR_ARG_REGS > 6 + mov ARG6, ARG5 +#else + ld [NSP+0], ARG5 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 5 + .global nbif_ccallemu5 +nbif_ccallemu5: + st ARG4, [P+P_ARG4] +#if NR_ARG_REGS > 5 + mov ARG5, ARG4 +#else + ld [NSP+0], ARG4 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 4 + .global nbif_ccallemu4 +nbif_ccallemu4: + st ARG3, [P+P_ARG3] +#if NR_ARG_REGS > 4 + mov ARG4, ARG3 +#else + ld [NSP+0], ARG3 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 3 + .global nbif_ccallemu3 +nbif_ccallemu3: + st ARG2, [P+P_ARG2] +#if NR_ARG_REGS > 3 + mov ARG3, ARG2 +#else + ld [NSP+0], ARG2 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 2 + .global nbif_ccallemu2 +nbif_ccallemu2: + st ARG1, [P+P_ARG1] +#if NR_ARG_REGS > 2 + mov ARG2, ARG1 +#else + ld [NSP+0], ARG1 +#endif + /*FALLTHROUGH*/ +#endif + +#if NR_ARG_REGS >= 1 + .global nbif_ccallemu1 +nbif_ccallemu1: + st ARG0, [P+P_ARG0] +#if NR_ARG_REGS > 1 + mov ARG1, ARG0 +#else + ld [NSP+0], ARG0 +#endif + /*FALLTHROUGH*/ +#endif + + .global nbif_ccallemu0 +nbif_ccallemu0: + /* We use %o1 not ARG0 here because ARG0 is not + defined when NR_ARG_REGS == 0. */ +#if NR_ARG_REGS == 0 + ld [NSP+0], %o1 /* get the closure */ +#endif + st %o1, [P+P_CLOSURE] /* save the closure */ + ba .suspend_exit + mov HIPE_MODE_SWITCH_RES_CALL_CLOSURE, %o0 + +/* + * This is where native code suspends. + */ + .global nbif_suspend_0 +nbif_suspend_0: + ba .suspend_exit + mov HIPE_MODE_SWITCH_RES_SUSPEND, %o0 + +/* + * Suspend from a receive (waiting for a message) + */ + .global nbif_suspend_msg +nbif_suspend_msg: + ba .suspend_exit + mov HIPE_MODE_SWITCH_RES_WAIT, %o0 + +/* + * Suspend from a receive with a timeout (waiting for a message) + * if (!(p->flags & F_TIMO)) { suspend } + * else { return 0; } + */ + .global nbif_suspend_msg_timeout +nbif_suspend_msg_timeout: + ld [P+P_FLAGS], %o1 + /* this relies on F_TIMO (1<<2) fitting in a simm13 */ + andcc %o1, F_TIMO, %g0 + bz,a .suspend_exit + mov HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT, %o0 /* delay slot */ + /* timeout has occurred */ + jmp RA+8 + mov 0, %o0 + +/* + * This is the default exception handler for native code. + */ + .global nbif_fail +nbif_fail: + ba .flush_exit + mov HIPE_MODE_SWITCH_RES_THROW, %o0 + + .global nbif_0_gc_after_bif + .global nbif_1_gc_after_bif + .global nbif_2_gc_after_bif + .global nbif_3_gc_after_bif +nbif_0_gc_after_bif: + ba .gc_after_bif + mov 0, %o1 /* delay slot */ +nbif_1_gc_after_bif: + ba .gc_after_bif + mov 1, %o1 /* delay slot */ +nbif_2_gc_after_bif: + ba .gc_after_bif + mov 2, %o1 /* delay slot */ +nbif_3_gc_after_bif: + mov 3, %o1 + /*FALLTHROUGH*/ +.gc_after_bif: + st %o1, [P+P_NARITY] + st TEMP_RA, [P+P_NRA] + st NSP, [P+P_NSP] + mov RA, TEMP_RA + mov %o0, %o1 + call erts_gc_after_bif_call + mov P, %o0 /* delay slot */ + mov TEMP_RA, RA + ld [P+P_NRA], TEMP_RA + jmp RA+8 + st %g0, [P+P_NARITY] /* delay slot */ + +/* + * We end up here when a BIF called from native signals an + * exceptional condition. + * HP has not been read from P. + * NSP has not been saved in P. + * TEMP_LR contains a copy of LR + */ + .global nbif_0_simple_exception +nbif_0_simple_exception: + ba .nbif_simple_exception + mov 0, %o1 /* delay slot */ + .global nbif_1_simple_exception +nbif_1_simple_exception: + ba .nbif_simple_exception + mov 1, %o1 /* delay slot */ + .global nbif_2_simple_exception +nbif_2_simple_exception: + ba .nbif_simple_exception + mov 2, %o1 /* delay slot */ + .global nbif_3_simple_exception +nbif_3_simple_exception: + mov 3, %o1 + /*FALLTHROUGH*/ +.nbif_simple_exception: + ld [P+P_FREASON], %o0 + cmp %o0, FREASON_TRAP + beq .handle_trap + nop + /* + * Find and invoke catch handler (it must exist). + * HP has not been read from P. + * NSP has not been saved in P. + * TEMP_RA should contain the current call's return address. + * %o1 should contain the current call's arity. + */ + st NSP, [P+P_NSP] + st TEMP_RA, [P+P_NRA] + st %o1, [P+P_NARITY] + /* find and prepare to invoke the handler */ + call hipe_handle_exception /* Note: hipe_handle_exception() conses */ + mov P, %o0 /* delay slot */ + /* prepare to invoke the handler */ + ld [P+P_NCALLEE], %o0 /* set by hipe_find_handler() */ + RESTORE_CACHED_STATE + /* now invoke the handler */ + jmp %o0 + nop + + /* + * A BIF failed with freason TRAP: + * - the BIF's arity is in %o1 + * - the native RA was saved in TEMP_RA before the BIF call + * - HP has not been read from P + * - NSP has not been saved in P + */ +.handle_trap: + mov HIPE_MODE_SWITCH_RES_TRAP, %o0 +.bif_exit: + /* restore C return address (hoisted to avoid stall) */ + ld [%sp+96], %i7 + st NSP, [P+P_NSP] + st %o1, [P+P_NARITY] + st TEMP_RA, [P+P_NRA] + jmp %i7+8 + restore %g0, %o0, %o0 + +/* + * nbif_stack_trap_ra: trap return address for maintaining + * the gray/white stack boundary + */ + .global nbif_stack_trap_ra +nbif_stack_trap_ra: /* a return address, not a function */ + nop /* ditto */ + nop /* ditto */ + /* This only handles a single return value. + If we have more, we need to save them in the PCB. */ + mov %o0, TEMP_ARG0 /* save retval */ + st NSP, [P+P_NSP] + call hipe_handle_stack_trap /* must not cons */ + mov P, %o0 /* delay slot */ + mov %o0, RA /* original RA */ + jmp RA+8 /* resume at original RA */ + mov TEMP_ARG0, %o0 /* delay slot: restore retval */ + +/* + * hipe_sparc_inc_stack + * Caller saved its RA in TEMP_RA (== TEMP1) before calling us. + */ + .global hipe_sparc_inc_stack +hipe_sparc_inc_stack: + STORE_ARG_REGS + mov RA, TEMP_ARG0 + st NSP, [P+P_NSP] + /* hipe_inc_nstack reads and writes NSP and NSP_LIMIT, + but does not access LR/RA, HP, or FCALLS. */ + call hipe_inc_nstack + mov P, %o0 /* delay slot */ + LOAD_ARG_REGS + /* this relies on LOAD_ARG_REGS not clobbering TEMP_ARG0 */ + jmp TEMP_ARG0+8 + ld [P+P_NSP], NSP /* delay slot */ + +#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif diff --git a/erts/emulator/hipe/hipe_sparc_glue.h b/erts/emulator/hipe/hipe_sparc_glue.h new file mode 100644 index 0000000000..3f881d2140 --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc_glue.h @@ -0,0 +1,32 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_SPARC_GLUE_H +#define HIPE_SPARC_GLUE_H + +#include "hipe_sparc_asm.h" /* for NR_ARG_REGS, SPARC_LEAF_WORDS */ +#define NR_LEAF_WORDS SPARC_LEAF_WORDS +#define HIPE_ARCH_CALL_TO_NATIVE hipe_sparc_call_to_native +#define HIPE_ARCH_RETURN_TO_NATIVE hipe_sparc_return_to_native +#define HIPE_ARCH_TAILCALL_TO_NATIVE hipe_sparc_tailcall_to_native +#define HIPE_ARCH_THROW_TO_NATIVE hipe_sparc_throw_to_native +#include "hipe_risc_glue.h" + +#endif /* HIPE_SPARC_GLUE_H */ diff --git a/erts/emulator/hipe/hipe_sparc_primops.h b/erts/emulator/hipe/hipe_sparc_primops.h new file mode 100644 index 0000000000..1fbb261c67 --- /dev/null +++ b/erts/emulator/hipe/hipe_sparc_primops.h @@ -0,0 +1,21 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +PRIMOP_LIST(am_inc_stack_0, &hipe_sparc_inc_stack) diff --git a/erts/emulator/hipe/hipe_stack.c b/erts/emulator/hipe/hipe_stack.c new file mode 100644 index 0000000000..82f7f022b6 --- /dev/null +++ b/erts/emulator/hipe/hipe_stack.c @@ -0,0 +1,187 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" + +#include "hipe_stack.h" + +/* + * Native-code stack descriptor hash table. + * + * This uses a specialised version of BEAM's hash table code: + * - Hash table size is always a power of two. + * Permits replacing an expensive integer division operation + * with a cheap bitwise 'and' in the hash index calculation + * - Lookups assume the key is in the table. + * Permits removing NULL checks. + * - Switched order of the hash bucket next and hvalue fields. + * The hvalue field, which must always be checked, gets a zero + * structure offset, which is faster on some architectures; + * the next field is only referenced if hvalue didn't match. + * These changes yield a much more efficient lookup operation. + */ +struct hipe_sdesc_table hipe_sdesc_table; + +static struct sdesc **alloc_bucket(unsigned int size) +{ + unsigned long nbytes = size * sizeof(struct sdesc*); + struct sdesc **bucket = erts_alloc(ERTS_ALC_T_HIPE, nbytes); + sys_memzero(bucket, nbytes); + return bucket; +} + +static void hipe_grow_sdesc_table(void) +{ + unsigned int old_size, new_size, new_mask; + struct sdesc **old_bucket, **new_bucket; + unsigned int i; + + old_size = 1 << hipe_sdesc_table.log2size; + hipe_sdesc_table.log2size += 1; + new_size = 1 << hipe_sdesc_table.log2size; + new_mask = new_size - 1; + hipe_sdesc_table.mask = new_mask; + old_bucket = hipe_sdesc_table.bucket; + new_bucket = alloc_bucket(new_size); + hipe_sdesc_table.bucket = new_bucket; + for (i = 0; i < old_size; ++i) { + struct sdesc *b = old_bucket[i]; + while (b != NULL) { + struct sdesc *next = b->bucket.next; + unsigned int j = (b->bucket.hvalue >> HIPE_RA_LSR_COUNT) & new_mask; + b->bucket.next = new_bucket[j]; + new_bucket[j] = b; + b = next; + } + } + erts_free(ERTS_ALC_T_HIPE, old_bucket); +} + +struct sdesc *hipe_put_sdesc(struct sdesc *sdesc) +{ + unsigned long ra; + unsigned int i; + struct sdesc *chain; + unsigned int size; + + ra = sdesc->bucket.hvalue; + i = (ra >> HIPE_RA_LSR_COUNT) & hipe_sdesc_table.mask; + chain = hipe_sdesc_table.bucket[i]; + + for (; chain != NULL; chain = chain->bucket.next) + if (chain->bucket.hvalue == ra) + return chain; /* collision! (shouldn't happen) */ + + sdesc->bucket.next = hipe_sdesc_table.bucket[i]; + hipe_sdesc_table.bucket[i] = sdesc; + hipe_sdesc_table.used += 1; + size = 1 << hipe_sdesc_table.log2size; + if (hipe_sdesc_table.used > (4*size)/5) /* rehash at 80% */ + hipe_grow_sdesc_table(); + return sdesc; +} + +void hipe_init_sdesc_table(struct sdesc *sdesc) +{ + unsigned int log2size, size; + + log2size = 10; + size = 1 << log2size; + hipe_sdesc_table.log2size = log2size; + hipe_sdesc_table.mask = size - 1; + hipe_sdesc_table.used = 0; + hipe_sdesc_table.bucket = alloc_bucket(size); + + hipe_put_sdesc(sdesc); +} + +/* + * XXX: x86 and SPARC currently use the same stack descriptor + * representation. If different representations are needed in + * the future, this code has to be made target dependent. + */ +struct sdesc *hipe_decode_sdesc(Eterm arg) +{ + Uint ra, exnra; + Eterm *live; + Uint fsize, arity, nlive, i, nslots, off; + Uint livebitswords, sdescbytes; + void *p; + struct sdesc *sdesc; + + if (is_not_tuple(arg) || + (tuple_val(arg))[0] != make_arityval(5) || + term_to_Uint((tuple_val(arg))[1], &ra) == 0 || + term_to_Uint((tuple_val(arg))[2], &exnra) == 0 || + is_not_small((tuple_val(arg))[3]) || + (fsize = unsigned_val((tuple_val(arg))[3])) > 65535 || + is_not_small((tuple_val(arg))[4]) || + (arity = unsigned_val((tuple_val(arg))[4])) > 255 || + is_not_tuple((tuple_val(arg))[5])) + return 0; + /* Get tuple with live slots */ + live = tuple_val((tuple_val(arg))[5]) + 1; + /* Get number of live slots */ + nlive = arityval(live[-1]); + /* Calculate size of frame = locals + ra + arguments */ + nslots = fsize + 1 + arity; + /* Check that only valid slots are given. */ + for (i = 0; i < nlive; ++i) { + if (is_not_small(live[i]) || + (off = unsigned_val(live[i]), off >= nslots) || + off == fsize) + return 0; + } + + /* Calculate number of words for the live bitmap. */ + livebitswords = (fsize + arity + 1 + 31) / 32; + /* Calculate number of bytes needed for the stack descriptor. */ + sdescbytes = + (exnra + ? offsetof(struct sdesc_with_exnra, sdesc.livebits) + : offsetof(struct sdesc, livebits)) + + livebitswords * sizeof(int); + p = erts_alloc(ERTS_ALC_T_HIPE, sdescbytes); + /* If we have an exception handler use the + special sdesc_with_exnra structure. */ + if (exnra) { + struct sdesc_with_exnra *sdesc_we = p; + sdesc_we->exnra = exnra; + sdesc = &(sdesc_we->sdesc); + } else + sdesc = p; + + /* Initialise head of sdesc. */ + sdesc->bucket.next = 0; + sdesc->bucket.hvalue = ra; + sdesc->summary = (fsize << 9) | (exnra ? (1<<8) : 0) | arity; + /* Clear all live-bits */ + for (i = 0; i < livebitswords; ++i) + sdesc->livebits[i] = 0; + /* Set live-bits given by caller. */ + for (i = 0; i < nlive; ++i) { + off = unsigned_val(live[i]); + sdesc->livebits[off / 32] |= (1 << (off & 31)); + } + return sdesc; +} diff --git a/erts/emulator/hipe/hipe_stack.h b/erts/emulator/hipe/hipe_stack.h new file mode 100644 index 0000000000..354ac81b4c --- /dev/null +++ b/erts/emulator/hipe/hipe_stack.h @@ -0,0 +1,128 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_STACK_H +#define HIPE_STACK_H + +#include "hipe_arch.h" + +/* + * Stack descriptors. + */ + +#include /* offsetof() */ + +struct sdesc { + struct { + unsigned long hvalue; /* return address */ + struct sdesc *next; /* hash collision chain */ + } bucket; + unsigned int summary; /* frame size, exn handler presence flag, arity */ + unsigned int livebits[1]; /* size depends on arch & data in summary field */ +}; + +struct sdesc_with_exnra { + unsigned long exnra; + struct sdesc sdesc; +}; + +static __inline__ unsigned int sdesc_fsize(const struct sdesc *sdesc) +{ + return sdesc->summary >> 9; +} + +static __inline__ unsigned int sdesc_arity(const struct sdesc *sdesc) +{ + return sdesc->summary & 0xFF; +} + +static __inline__ unsigned long sdesc_exnra(const struct sdesc *sdesc) +{ + if ((sdesc->summary & (1<<8))) { + const char *tmp; + tmp = (const char*)sdesc - offsetof(struct sdesc_with_exnra, sdesc); + return ((const struct sdesc_with_exnra*)tmp)->exnra; + } + return 0; +} + +struct hipe_sdesc_table { + unsigned int log2size; + unsigned int mask; /* INV: mask == (1 << log2size)-1 */ + unsigned int used; + struct sdesc **bucket; +}; +extern struct hipe_sdesc_table hipe_sdesc_table; + +extern struct sdesc *hipe_put_sdesc(struct sdesc*); +extern void hipe_init_sdesc_table(struct sdesc*); +extern struct sdesc *hipe_decode_sdesc(Eterm); + +#if !defined(__GNUC__) || (__GNUC__ < 2) || (__GNUC__ == 2 && __GNUC_MINOR__ < 96) +#define __builtin_expect(x, expected_value) (x) +#endif +#define likely(x) __builtin_expect((x),1) +#define unlikely(x) __builtin_expect((x),0) + +static __inline__ const struct sdesc *hipe_find_sdesc(unsigned long ra) +{ + unsigned int i = (ra >> HIPE_RA_LSR_COUNT) & hipe_sdesc_table.mask; + const struct sdesc *sdesc = hipe_sdesc_table.bucket[i]; + if (likely(sdesc->bucket.hvalue == ra)) + return sdesc; + do { + sdesc = sdesc->bucket.next; + } while (sdesc->bucket.hvalue != ra); + return sdesc; +} + +AEXTERN(void,nbif_stack_trap_ra,(void)); + +extern void hipe_print_nstack(Process*); +extern void hipe_find_handler(Process*); +extern void (*hipe_handle_stack_trap(Process*))(void); +extern void hipe_update_stack_trap(Process*, const struct sdesc*); +extern int hipe_fill_stacktrace(Process*, int, Eterm**); + +#if 0 && defined(HIPE_NSTACK_GROWS_UP) +#define hipe_nstack_start(p) ((p)->hipe.nstack) +#define hipe_nstack_used(p) ((p)->hipe.nsp - (p)->hipe.nstack) +#endif +#if defined(HIPE_NSTACK_GROWS_DOWN) +#define hipe_nstack_start(p) ((p)->hipe.nsp) +#define hipe_nstack_used(p) ((p)->hipe.nstend - (p)->hipe.nsp) +#endif + +/* + * GC support procedures + */ +extern Eterm *fullsweep_nstack(Process *p, Eterm *n_htop); +extern void gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop); + +#ifdef HYBRID +#ifdef INCREMENTAL +extern Eterm *ma_fullsweep_nstack(Process *p, Eterm *n_htop, Eterm *n_hend); +#else +extern Eterm *ma_fullsweep_nstack(Process *p, Eterm *n_htop); +#endif +extern void ma_gensweep_nstack(Process *p, Eterm **ptr_old_htop, Eterm **ptr_n_htop); +#endif /* HYBRID */ + +#endif /* HIPE_STACK_H */ diff --git a/erts/emulator/hipe/hipe_x86.c b/erts/emulator/hipe/hipe_x86.c new file mode 100644 index 0000000000..f79a2d53f4 --- /dev/null +++ b/erts/emulator/hipe/hipe_x86.c @@ -0,0 +1,272 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#include /* offsetof() */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" +#include + +#include "hipe_arch.h" +#include "hipe_native_bif.h" /* nbif_callemu() */ + +#undef F_TIMO +#undef THE_NON_VALUE +#undef ERL_FUN_SIZE +#include "hipe_literals.h" + +void hipe_patch_load_fe(Uint32 *address, Uint32 value) +{ + /* address points to a disp32 or imm32 operand */ + *address = value; +} + +int hipe_patch_insn(void *address, Uint32 value, Eterm type) +{ + switch (type) { + case am_closure: + case am_constant: + case am_atom: + case am_c_const: + break; + case am_x86_abs_pcrel: + value += (Uint)address; + break; + default: + return -1; + } + *(Uint32*)address = value; + return 0; +} + +int hipe_patch_call(void *callAddress, void *destAddress, void *trampoline) +{ + Uint rel32; + + if (trampoline) + return -1; + rel32 = (Uint)destAddress - (Uint)callAddress - 4; + *(Uint32*)callAddress = rel32; + hipe_flush_icache_word(callAddress); + return 0; +} + +/* + * Memory allocator for executable code. + * + * This is required on x86 because some combinations + * of Linux kernels and CPU generations default to + * non-executable memory mappings, causing ordinary + * malloc() memory to be non-executable. + */ +static unsigned int code_bytes; +static char *code_next; + +#if 0 /* change to non-zero to get allocation statistics at exit() */ +static unsigned int total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs, nr_large, total_lost; +static unsigned int atexit_done; + +static void alloc_code_stats(void) +{ + printf("\r\nalloc_code_stats: %u bytes mapped, %u joins, %u splits, %u bytes allocated, %u average alloc, %u large allocs, %u bytes lost\r\n", + total_mapped, nr_joins, nr_splits, total_alloc, nr_allocs ? total_alloc/nr_allocs : 0, nr_large, total_lost); +} + +static void atexit_alloc_code_stats(void) +{ + if (!atexit_done) { + atexit_done = 1; + (void)atexit(alloc_code_stats); + } +} + +#define ALLOC_CODE_STATS(X) do{X;}while(0) +#else +#define ALLOC_CODE_STATS(X) do{}while(0) +#endif + +/* FreeBSD 6.1 and Darwin breakage */ +#if !defined(MAP_ANONYMOUS) && defined(MAP_ANON) +#define MAP_ANONYMOUS MAP_ANON +#endif + +static void morecore(unsigned int alloc_bytes) +{ + unsigned int map_bytes; + char *map_hint, *map_start; + + /* Page-align the amount to allocate. */ + map_bytes = (alloc_bytes + 4095) & ~4095; + + /* Round up small allocations. */ + if (map_bytes < 1024*1024) + map_bytes = 1024*1024; + else + ALLOC_CODE_STATS(++nr_large); + + /* Create a new memory mapping, ensuring it is executable + and in the low 2GB of the address space. Also attempt + to make it adjacent to the previous mapping. */ + map_hint = code_next + code_bytes; + if ((unsigned long)map_hint & 4095) + abort(); + map_start = mmap(map_hint, map_bytes, + PROT_EXEC|PROT_READ|PROT_WRITE, + MAP_PRIVATE|MAP_ANONYMOUS +#ifdef __x86_64__ + |MAP_32BIT +#endif + , + -1, 0); + if (map_start == MAP_FAILED) { + perror("mmap"); + abort(); + } + ALLOC_CODE_STATS(total_mapped += map_bytes); + + /* Merge adjacent mappings, so the trailing portion of the previous + mapping isn't lost. In practice this is quite successful. */ + if (map_start == map_hint) { + ALLOC_CODE_STATS(++nr_joins); + code_bytes += map_bytes; + } else { + ALLOC_CODE_STATS(++nr_splits); + ALLOC_CODE_STATS(total_lost += code_bytes); + code_next = map_start; + code_bytes = map_bytes; + } + + ALLOC_CODE_STATS(atexit_alloc_code_stats()); +} + +static void *alloc_code(unsigned int alloc_bytes) +{ + void *res; + + /* Align function entries. */ + alloc_bytes = (alloc_bytes + 3) & ~3; + + if (code_bytes < alloc_bytes) + morecore(alloc_bytes); + ALLOC_CODE_STATS(++nr_allocs); + ALLOC_CODE_STATS(total_alloc += alloc_bytes); + res = code_next; + code_next += alloc_bytes; + code_bytes -= alloc_bytes; + return res; +} + +void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p) +{ + if (is_not_nil(callees)) + return NULL; + *trampolines = NIL; + return alloc_code(nrbytes); +} + +/* called from hipe_bif0.c:hipe_bifs_make_native_stub_2() + and hipe_bif0.c:hipe_make_stub() */ +void *hipe_make_native_stub(void *beamAddress, unsigned int beamArity) +{ + /* + * This creates a native code stub with the following contents: + * + * movl $Address, P_BEAM_IP(%ebp) + * movb $Arity, P_ARITY(%ebp) + * jmp callemu + * + * The stub has variable size, depending on whether the P_BEAM_IP + * and P_ARITY offsets fit in 8-bit signed displacements or not. + * The rel32 offset in the final jmp depends on its actual location, + * which also depends on the size of the previous instructions. + * Arity is stored with a movb because (a) Björn tells me arities + * are <= 255, and (b) a movb is smaller and faster than a movl. + */ + unsigned int codeSize; + unsigned char *code, *codep; + unsigned int callEmuOffset; + + codeSize = /* 16, 19, or 22 bytes */ + 16 + /* 16 when both offsets are 8-bit */ + (P_BEAM_IP >= 128 ? 3 : 0) + + (P_ARITY >= 128 ? 3 : 0); + codep = code = alloc_code(codeSize); + + /* movl $beamAddress, P_BEAM_IP(%ebp); 3 or 6 bytes, plus 4 */ + codep[0] = 0xc7; +#if P_BEAM_IP >= 128 + codep[1] = 0x85; /* disp32[EBP] */ + codep[2] = P_BEAM_IP & 0xFF; + codep[3] = (P_BEAM_IP >> 8) & 0xFF; + codep[4] = (P_BEAM_IP >> 16) & 0xFF; + codep[5] = (P_BEAM_IP >> 24) & 0xFF; + codep += 6; +#else + codep[1] = 0x45; /* disp8[EBP] */ + codep[2] = P_BEAM_IP; + codep += 3; +#endif + codep[0] = ((unsigned int)beamAddress) & 0xFF; + codep[1] = ((unsigned int)beamAddress >> 8) & 0xFF; + codep[2] = ((unsigned int)beamAddress >> 16) & 0xFF; + codep[3] = ((unsigned int)beamAddress >> 24) & 0xFF; + codep += 4; + + /* movb $beamArity, P_ARITY(%ebp); 3 or 6 bytes */ + codep[0] = 0xc6; +#if P_ARITY >= 128 + codep[1] = 0x85; /* disp32[EBP] */ + codep[2] = P_ARITY & 0xFF; + codep[3] = (P_ARITY >> 8) & 0xFF; + codep[4] = (P_ARITY >> 16) & 0xFF; + codep[5] = (P_ARITY >> 24) & 0xFF; + codep += 6; +#else + codep[1] = 0x45; /* disp8[EBP] */ + codep[2] = P_ARITY; + codep += 3; +#endif + codep[0] = beamArity; + codep += 1; + + /* jmp callemu; 5 bytes */ + callEmuOffset = (unsigned char*)nbif_callemu - (code + codeSize); + codep[0] = 0xe9; + codep[1] = callEmuOffset & 0xFF; + codep[2] = (callEmuOffset >> 8) & 0xFF; + codep[3] = (callEmuOffset >> 16) & 0xFF; + codep[4] = (callEmuOffset >> 24) & 0xFF; + codep += 5; + ASSERT(codep == code + codeSize); + + /* I-cache flush? */ + + return code; +} + +void hipe_arch_print_pcb(struct hipe_process_state *p) +{ +#define U(n,x) \ + printf(" % 4d | %s | 0x%08x | |\r\n", offsetof(struct hipe_process_state,x), n, (unsigned)p->x) + U("ncsp ", ncsp); + U("narity ", narity); +#undef U +} diff --git a/erts/emulator/hipe/hipe_x86.h b/erts/emulator/hipe/hipe_x86.h new file mode 100644 index 0000000000..94ca39fc4f --- /dev/null +++ b/erts/emulator/hipe/hipe_x86.h @@ -0,0 +1,58 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifndef HIPE_X86_H +#define HIPE_X86_H + +static __inline__ void hipe_flush_icache_word(void *address) +{ + /* Do nothing. This works as long as compiled code is + executed by a single CPU thread. */ +} + +static __inline__ void +hipe_flush_icache_range(void *address, unsigned int nbytes) +{ + /* Do nothing. This works as long as compiled code is + executed by a single CPU thread. */ +} + +/* for stack descriptor hash lookup */ +#define HIPE_RA_LSR_COUNT 0 /* all bits are significant */ + +/* for hipe_bifs_{read,write}_{s,u}32 */ +static __inline__ int hipe_word32_address_ok(void *address) +{ + return 1; +} + +/* Native stack growth direction. */ +#define HIPE_NSTACK_GROWS_DOWN + +#define hipe_arch_name am_x86 + +extern void nbif_inc_stack_0(void); +extern void nbif_handle_fp_exception(void); + +/* for hipe_bifs_enter_code_2 */ +extern void *hipe_alloc_code(Uint nrbytes, Eterm callees, Eterm *trampolines, Process *p); +#define HIPE_ALLOC_CODE(n,c,t,p) hipe_alloc_code((n),(c),(t),(p)) + +#endif /* HIPE_X86_H */ diff --git a/erts/emulator/hipe/hipe_x86.tab b/erts/emulator/hipe/hipe_x86.tab new file mode 100644 index 0000000000..a38fe49156 --- /dev/null +++ b/erts/emulator/hipe/hipe_x86.tab @@ -0,0 +1,24 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# $Id$ +# x86-specific atoms + +atom handle_fp_exception +atom inc_stack_0 +atom x86 diff --git a/erts/emulator/hipe/hipe_x86_abi.txt b/erts/emulator/hipe/hipe_x86_abi.txt new file mode 100644 index 0000000000..62a704eef3 --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_abi.txt @@ -0,0 +1,128 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 2001-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +$Id$ + +HiPE x86 ABI +============ +This document describes aspects of HiPE's runtime system +that are specific for the x86 (IA32) architecture. + +Register Usage +-------------- +%esp and %ebp are fixed and must be preserved by calls (callee-save). +%eax, %edx, %ecx, %ebx, %edi are clobbered by calls (caller-save). +%esi is a fixed global register (unallocatable). + +%esp is the native code stack pointer, growing towards lower addresses. +%ebp (aka P) is the current process' "Process*". +%esi (aka HP) is the current process' heap pointer. (If HP_IN_ESI is true.) + +The caller-save registers are used as temporary scratch registers +and for parameters in function calls. + +[XXX: Eventually, when we have better register allocation in place, +the current "Process*" may be put in %fs instead, which will make +%ebp available as a general-purpose register.] + +Calling Convention +------------------ +The first NR_ARG_REGS (a tunable parameter between 0 and 5, inclusive) +parameters are passed in %eax, %edx, %ecx, %ebx, and %edi. + +The first return value from a function is placed in %eax, the second +(if any) is placed in %edx. + +The callee returns by using the "ret $N" instruction, which also +deallocates the stacked actual parameters. + +Stack Frame Layout +------------------ +[From top to bottom: formals in left-to-right order, incoming return +address, fixed-size chunk for locals & spills, variable-size area +for actuals, outgoing return address. %esp normally points at the +bottom of the fixed-size chunk, except during a recursive call. +The callee pops the actuals, so no %esp adjustment at return.] + +Stack Descriptors +----------------- +sdesc_fsize() is the frame size excluding the return address word. + +Stacks and Unix Signal Handlers +------------------------------- +Each Erlang process has its own private native code stack. +This stack is managed by the compiler and the runtime system. +It is not guaranteed to have space for a Unix signal handler. +The Unix process MUST employ an "alternate signal stack" using +sigaltstack(), and all user-defined signal handlers MUST be +registered with sigaction() and the SA_ONSTACK flag. Failure +to observe these rules may lead to memory corruption errors. + + +Standard Unix x86 Calling Conventions +===================================== + +%eax, %edx, %ecx are clobbered by calls (caller-save) +%esp, %ebp, %ebx, %esi, %edi are preserved by calls (callee-save) +%eax and %edx receive function call return values +%esp is the stack pointer (fixed) +%ebp is optional frame pointer or local variable +actual parameters are pushed right-to-left +caller deallocates parameters after return (addl $N,%esp) + +Windows 32-bit C Calling Conventions +==================================== + +%esp, %ebp, %ebx, %esi, %edi are preserved by calls (callee-save) +%eax and %edx receive function call return values +Parameters not passed in registers are pushed right-to-left on the stack. + +Windows supports several calling conventions on x86 that differ +in whether caller or callee pops off stacked parameters, whether +any parameters are passed in registers, and how function names +are mangled. + +The __cdecl convention +---------------------- +Default for C and C++ application code. +No parameters are passed in registers. +Caller deallocates parameters after return (addl $N, %esp). +A function name is prefixed by a "_". + +The __stdcall convention +------------------------ +Used for calling Win32 API functions. +No parameters are passed in registers. +Callee deallocates parameters during return (ret $N). +A function name is prefixed by a "_" and suffixed by "@" and the +number of bytes of stack space the parameters use in decimal. +Prototypes are required. Varargs functions are converted to __cdecl. + +The __fastcall convention +------------------------ +The first two parameters are passed in %ecx and %edx. +Callee deallocates stacked parameters during return (ret $N). +A function name is prefixed by a "@" and suffixed by "@" and the +number of bytes of stack space the parameters use in decimal. + +The __thiscall convention +------------------------- +Used for C++ member functions. +Similar to __cdecl except for the implicit 'this' parameter +which is passed in %ecx rather than being pushed on the stack. +No name mangling occurs. diff --git a/erts/emulator/hipe/hipe_x86_asm.m4 b/erts/emulator/hipe/hipe_x86_asm.m4 new file mode 100644 index 0000000000..4c1d612ccd --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_asm.m4 @@ -0,0 +1,286 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ +`#ifndef HIPE_X86_ASM_H +#define HIPE_X86_ASM_H' + +/* + * Tunables. + */ +define(LEAF_WORDS,24)dnl number of stack words for leaf functions +define(NR_ARG_REGS,3)dnl admissible values are 0 to 5, inclusive +define(HP_IN_ESI,1)dnl change to 0 to not reserve a global register for HP +define(SIMULATE_NSP,0)dnl change to 1 to simulate call/ret insns + +`#define X86_LEAF_WORDS 'LEAF_WORDS +`#define LEAF_WORDS 'LEAF_WORDS + +/* + * Workarounds for Darwin. + */ +ifelse(OPSYS,darwin,`` +/* Darwin */ +#define TEXT .text +#define JOIN(X,Y) X##Y +#define CSYM(NAME) JOIN(_,NAME) +#define ASYM(NAME) CSYM(NAME) +#define GLOBAL(NAME) .globl NAME +#define SET_SIZE(NAME) /*empty*/ +#define TYPE_FUNCTION(NAME) /*empty*/ +'',`` +/* Not Darwin */ +#define TEXT .section ".text" +#define CSYM(NAME) NAME +#define ASYM(NAME) NAME +#define GLOBAL(NAME) .global NAME +#define SET_SIZE(NAME) .size NAME,.-NAME +#define TYPE_FUNCTION(NAME) .type NAME,@function +'')dnl + +/* + * Reserved registers. + */ +`#define P %ebp' + +`#define X86_HP_IN_ESI 'HP_IN_ESI +`#if X86_HP_IN_ESI +#define SAVE_HP movl %esi, P_HP(P) +#define RESTORE_HP movl P_HP(P), %esi +#else +#define SAVE_HP /*empty*/ +#define RESTORE_HP /*empty*/ +#endif' + +`#define NSP %esp +#define SAVE_CSP movl %esp, P_CSP(P) +#define RESTORE_CSP movl P_CSP(P), %esp' + +`#define X86_SIMULATE_NSP 'SIMULATE_NSP + +/* + * Context switching macros. + */ +`#define SWITCH_C_TO_ERLANG_QUICK \ + SAVE_CSP; \ + movl P_NSP(P), NSP' + +`#define SWITCH_ERLANG_TO_C_QUICK \ + movl NSP, P_NSP(P); \ + RESTORE_CSP' + +`#define SAVE_CACHED_STATE \ + SAVE_HP' + +`#define RESTORE_CACHED_STATE \ + RESTORE_HP' + +`#define SWITCH_C_TO_ERLANG \ + RESTORE_CACHED_STATE; \ + SWITCH_C_TO_ERLANG_QUICK' + +`#define SWITCH_ERLANG_TO_C \ + SAVE_CACHED_STATE; \ + SWITCH_ERLANG_TO_C_QUICK' + +/* + * Argument (parameter) registers. + */ +`#define X86_NR_ARG_REGS 'NR_ARG_REGS +`#define NR_ARG_REGS 'NR_ARG_REGS + +ifelse(eval(NR_ARG_REGS >= 1),0,, +``#define ARG0 %eax +'')dnl +ifelse(eval(NR_ARG_REGS >= 2),0,, +``#define ARG1 %edx +'')dnl +ifelse(eval(NR_ARG_REGS >= 3),0,, +``#define ARG2 %ecx +'')dnl +ifelse(eval(NR_ARG_REGS >= 4),0,, +``#define ARG3 %ebx +'')dnl +ifelse(eval(NR_ARG_REGS >= 5),0,, +``#define ARG4 %edi +'')dnl + +/* + * TEMP_RV: + * Used in nbif_stack_trap_ra to preserve the return value. + * Must be a C callee-save register. + * Must be otherwise unused in the return path. + */ +`#define TEMP_RV %ebx' + +/* + * TEMP_NSP: + * Used in BIF wrappers to permit copying stacked parameter from + * the native stack to the C stack. + * Set up by NBIF_COPY_NSP(arity) and used by NBIF_ARG(arity,argno). + * TEMP_NSP may alias the last BIF argument register. + * NBIF_COPY_NSP and NBIF_ARG currently fail if ARITY > NR_ARG_REGS! + */ +`#define TEMP_NSP %edi' + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_x86_glue.S support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl LOAD_ARG_REGS +dnl +define(LAR_1,`movl P_ARG$1(P), ARG$1 ; ')dnl +define(LAR_N,`ifelse(eval($1 >= 0),0,,`LAR_N(eval($1-1))LAR_1($1)')')dnl +define(LOAD_ARG_REGS,`LAR_N(eval(NR_ARG_REGS-1))')dnl +`#define LOAD_ARG_REGS 'LOAD_ARG_REGS + +dnl +dnl STORE_ARG_REGS +dnl +define(SAR_1,`movl ARG$1, P_ARG$1(P) ; ')dnl +define(SAR_N,`ifelse(eval($1 >= 0),0,,`SAR_N(eval($1-1))SAR_1($1)')')dnl +define(STORE_ARG_REGS,`SAR_N(eval(NR_ARG_REGS-1))')dnl +`#define STORE_ARG_REGS 'STORE_ARG_REGS + +dnl +dnl NSP_CALL(FUN) +dnl Emit a CALL FUN instruction, or simulate it. +dnl FUN must not be an NSP-based memory operand. +dnl +ifelse(eval(SIMULATE_NSP),0, +``#define NSP_CALL(FUN) call FUN'', +``#define NSP_CALL(FUN) subl $4,NSP; movl $1f,(NSP); jmp FUN; 1:'')dnl + +dnl +dnl NSP_RETN(NPOP) +dnl Emit a RET $NPOP instruction, or simulate it. +dnl NPOP should be non-zero. +dnl +ifelse(eval(SIMULATE_NSP),0, +``#define NSP_RETN(NPOP) ret $NPOP'', +``#define NSP_RETN(NPOP) movl (NSP),TEMP_RV; addl $4+NPOP,NSP; jmp *TEMP_RV'')dnl + +dnl +dnl NSP_RET0 +dnl Emit a RET instruction, or simulate it. +dnl +ifelse(eval(SIMULATE_NSP),0, +``#define NSP_RET0 ret'', +``#define NSP_RET0 movl (NSP),TEMP_RV; addl $4,NSP; jmp *TEMP_RV'')dnl + +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX +dnl X X +dnl X hipe_x86_bifs.m4 support X +dnl X X +dnl XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX + +dnl +dnl NBIF_COPY_NSP(ARITY) +dnl if ARITY > NR_ARG_REGS then TEMP_NSP := %esp. +dnl Allows the stacked formals to be referenced via TEMP_NSP after the stack switch. +dnl +define(NBIF_COPY_NSP,`ifelse(eval($1 > NR_ARG_REGS),0,,`movl %esp, TEMP_NSP')')dnl +`/* #define NBIF_COPY_NSP_0 'NBIF_COPY_NSP(0)` */' +`/* #define NBIF_COPY_NSP_1 'NBIF_COPY_NSP(1)` */' +`/* #define NBIF_COPY_NSP_2 'NBIF_COPY_NSP(2)` */' +`/* #define NBIF_COPY_NSP_3 'NBIF_COPY_NSP(3)` */' +`/* #define NBIF_COPY_NSP_5 'NBIF_COPY_NSP(5)` */' + +dnl +dnl BASE_OFFSET(N) +dnl Generates a base-register offset operand for the value N. +dnl When N is zero the offset becomes the empty string, as this +dnl may allow the assembler to choose a more compat encoding. +dnl +define(BASE_OFFSET,`ifelse(eval($1),0,`',`$1')')dnl + +dnl +dnl NBIF_ARG_OPND(ARITY,ARGNO) +dnl Generates an operand for this formal parameter. +dnl It will be a register operand when 0 <= ARGNO < NR_ARG_REGS. +dnl It will be a memory operand via TEMP_NSP when ARGNO >= NR_ARG_REGS. +dnl +define(NBIF_ARG_OPND,`ifelse(eval($2 >= NR_ARG_REGS),0,`ARG'$2,BASE_OFFSET(eval(($1-NR_ARG_REGS)*4-($2-NR_ARG_REGS)*4))`(TEMP_NSP)')')dnl +`/* #define NBIF_ARG_OPND_1_0 'NBIF_ARG_OPND(1,0)` */' +`/* #define NBIF_ARG_OPND_2_0 'NBIF_ARG_OPND(2,0)` */' +`/* #define NBIF_ARG_OPND_2_1 'NBIF_ARG_OPND(2,1)` */' +`/* #define NBIF_ARG_OPND_3_0 'NBIF_ARG_OPND(3,0)` */' +`/* #define NBIF_ARG_OPND_3_1 'NBIF_ARG_OPND(3,1)` */' +`/* #define NBIF_ARG_OPND_3_2 'NBIF_ARG_OPND(3,2)` */' +`/* #define NBIF_ARG_OPND_5_0 'NBIF_ARG_OPND(5,0)` */' +`/* #define NBIF_ARG_OPND_5_1 'NBIF_ARG_OPND(5,1)` */' +`/* #define NBIF_ARG_OPND_5_2 'NBIF_ARG_OPND(5,2)` */' +`/* #define NBIF_ARG_OPND_5_3 'NBIF_ARG_OPND(5,3)` */' +`/* #define NBIF_ARG_OPND_5_4 'NBIF_ARG_OPND(5,4)` */' + +dnl +dnl NBIF_ARG_REG(CARGNO,REG) +dnl Generates code to move REG to C argument number CARGNO. +dnl +define(NBIF_ARG_REG,`movl $2,BASE_OFFSET(eval(4*$1))(%esp)')dnl +`/* #define NBIF_ARG_REG_0_P 'NBIF_ARG_REG(0,P)` */' + +dnl +dnl NBIF_ARG(CARGNO,ARITY,ARGNO) +dnl Generates code to move Erlang parameter number ARGNO +dnl in a BIF of arity ARITY to C parameter number CARGNO. +dnl +dnl This must be called after NBIF_COPY_NSP(ARITY). +dnl +dnl NBIF_ARG(_,_,ARGNO2) must be called after NBIF_ARG(_,_,ARGNO1) +dnl if ARGNO2 > ARGNO1. (ARG0 may be reused as a temporary register +dnl for Erlang parameters passed on the stack.) +dnl +define(NBIF_ARG_MEM,`movl NBIF_ARG_OPND($2,$3),%eax; NBIF_ARG_REG($1,%eax)')dnl +define(NBIF_ARG,`ifelse(eval($3 >= NR_ARG_REGS),0,`NBIF_ARG_REG($1,`ARG'$3)',`NBIF_ARG_MEM($1,$2,$3)')')dnl + +dnl +dnl NBIF_RET(ARITY) +dnl Generates a return from a native BIF, taking care to pop +dnl any stacked formal parameters. +dnl +define(RET_POP,`ifelse(eval($1 > NR_ARG_REGS),0,0,eval(4*($1 - NR_ARG_REGS)))')dnl +define(NBIF_RET_N,`ifelse(eval($1),0,`NSP_RET0',`NSP_RETN($1)')')dnl +define(NBIF_RET,`NBIF_RET_N(eval(RET_POP($1)))')dnl +`/* #define NBIF_RET_0 'NBIF_RET(0)` */' +`/* #define NBIF_RET_1 'NBIF_RET(1)` */' +`/* #define NBIF_RET_2 'NBIF_RET(2)` */' +`/* #define NBIF_RET_3 'NBIF_RET(3)` */' +`/* #define NBIF_RET_5 'NBIF_RET(5)` */' + +dnl +dnl STORE_CALLER_SAVE +dnl LOAD_CALLER_SAVE +dnl Used to save and restore C caller-save argument registers around +dnl calls to hipe_inc_nstack. The first 3 arguments registers are C +dnl caller-save, remaining ones are C callee-save. +dnl +define(NBIF_MIN,`ifelse(eval($1 > $2),0,$1,$2)')dnl +define(NR_CALLER_SAVE,NBIF_MIN(NR_ARG_REGS,3))dnl +define(STORE_CALLER_SAVE,`SAR_N(eval(NR_CALLER_SAVE-1))')dnl +define(LOAD_CALLER_SAVE,`LAR_N(eval(NR_CALLER_SAVE-1))')dnl +`#define STORE_CALLER_SAVE 'STORE_CALLER_SAVE +`#define LOAD_CALLER_SAVE 'LOAD_CALLER_SAVE + +`#endif /* HIPE_X86_ASM_H */' diff --git a/erts/emulator/hipe/hipe_x86_bifs.m4 b/erts/emulator/hipe/hipe_x86_bifs.m4 new file mode 100644 index 0000000000..80be74f7b2 --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_bifs.m4 @@ -0,0 +1,635 @@ +changecom(`/*', `*/')dnl +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ + +include(`hipe/hipe_x86_asm.m4') +#`include' "hipe_literals.h" + +`#if THE_NON_VALUE == 0 +#define TEST_GOT_EXN testl %eax,%eax +#else +#define TEST_GOT_EXN cmpl $THE_NON_VALUE,%eax +#endif' + +`#define TEST_GOT_MBUF movl P_MBUF(P), %edx; testl %edx, %edx; jnz 3f; 2: +#define JOIN3(A,B,C) A##B##C +#define HANDLE_GOT_MBUF(ARITY) 3: call JOIN3(nbif_,ARITY,_gc_after_bif); jmp 2b' + +/* + * standard_bif_interface_1(nbif_name, cbif_name) + * standard_bif_interface_2(nbif_name, cbif_name) + * standard_bif_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 1-3 parameters and + * standard failure mode. + */ +define(standard_bif_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(1) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,1,0) + call CSYM($2) + TEST_GOT_MBUF + + /* switch to native stack */ + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_1_simple_exception + NBIF_RET(1) + HANDLE_GOT_MBUF(1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(standard_bif_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(2) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,2,0) + NBIF_ARG(2,2,1) + call CSYM($2) + TEST_GOT_MBUF + + /* switch to native stack */ + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_2_simple_exception + NBIF_RET(2) + HANDLE_GOT_MBUF(2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(standard_bif_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(3) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,3,0) + NBIF_ARG(2,3,1) + NBIF_ARG(3,3,2) + call CSYM($2) + TEST_GOT_MBUF + + /* switch to native stack */ + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_3_simple_exception + NBIF_RET(3) + HANDLE_GOT_MBUF(3) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * fail_bif_interface_0(nbif_name, cbif_name) + * + * Generate native interface for a BIF with 0 parameters and + * standard failure mode. + */ +define(fail_bif_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + call CSYM($2) + TEST_GOT_MBUF + + /* switch to native stack */ + SWITCH_C_TO_ERLANG + + /* throw exception if failure, otherwise return */ + TEST_GOT_EXN + jz nbif_0_simple_exception + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * nofail_primop_interface_0(nbif_name, cbif_name) + * nofail_primop_interface_1(nbif_name, cbif_name) + * nofail_primop_interface_2(nbif_name, cbif_name) + * nofail_primop_interface_3(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 ordinary parameters and no failure mode. + * Also used for guard BIFs. + */ +define(nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + call CSYM($2) + TEST_GOT_MBUF + + /* switch to native stack */ + SWITCH_C_TO_ERLANG + + /* return */ + NBIF_RET(0) + HANDLE_GOT_MBUF(0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(1) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,1,0) + call CSYM($2) + TEST_GOT_MBUF + + /* switch to native stack */ + SWITCH_C_TO_ERLANG + + /* return */ + NBIF_RET(1) + HANDLE_GOT_MBUF(1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(2) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,2,0) + NBIF_ARG(2,2,1) + call CSYM($2) + TEST_GOT_MBUF + + /* switch to native stack */ + SWITCH_C_TO_ERLANG + + /* return */ + NBIF_RET(2) + HANDLE_GOT_MBUF(2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(3) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,3,0) + NBIF_ARG(2,3,1) + NBIF_ARG(3,3,2) + call CSYM($2) + TEST_GOT_MBUF + + /* switch to native stack */ + SWITCH_C_TO_ERLANG + + /* return */ + NBIF_RET(3) + HANDLE_GOT_MBUF(3) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * nocons_nofail_primop_interface_0(nbif_name, cbif_name) + * nocons_nofail_primop_interface_1(nbif_name, cbif_name) + * nocons_nofail_primop_interface_2(nbif_name, cbif_name) + * nocons_nofail_primop_interface_3(nbif_name, cbif_name) + * nocons_nofail_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(nocons_nofail_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nocons_nofail_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(1) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,1,0) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nocons_nofail_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(2) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,2,0) + NBIF_ARG(2,2,1) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nocons_nofail_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(3) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,3,0) + NBIF_ARG(2,3,1) + NBIF_ARG(3,3,2) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(3) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(nocons_nofail_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(5) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG_REG(0,P) + NBIF_ARG(1,5,0) + NBIF_ARG(2,5,1) + NBIF_ARG(3,5,2) + NBIF_ARG(4,5,3) + NBIF_ARG(5,5,4) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(5) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * noproc_primop_interface_0(nbif_name, cbif_name) + * noproc_primop_interface_1(nbif_name, cbif_name) + * noproc_primop_interface_2(nbif_name, cbif_name) + * noproc_primop_interface_3(nbif_name, cbif_name) + * noproc_primop_interface_5(nbif_name, cbif_name) + * + * Generate native interface for a primop with no implicit P + * parameter, 0-3 or 5 ordinary parameters, and no failure mode. + * The primop cannot CONS or gc. + */ +define(noproc_primop_interface_0, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(0) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(noproc_primop_interface_1, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(1) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG(0,1,0) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(1) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(noproc_primop_interface_2, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(2) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG(0,2,0) + NBIF_ARG(1,2,1) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(2) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(noproc_primop_interface_3, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(3) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG(0,3,0) + NBIF_ARG(1,3,1) + NBIF_ARG(2,3,2) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(3) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +define(noproc_primop_interface_5, +` +#ifndef HAVE_$1 +#`define' HAVE_$1 + TEXT + .align 4 + GLOBAL(ASYM($1)) +ASYM($1): + /* copy native stack pointer */ + NBIF_COPY_NSP(5) + + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + + /* make the call on the C stack */ + NBIF_ARG(0,5,0) + NBIF_ARG(1,5,1) + NBIF_ARG(2,5,2) + NBIF_ARG(3,5,3) + NBIF_ARG(4,5,4) + call CSYM($2) + + /* switch to native stack */ + SWITCH_C_TO_ERLANG_QUICK + + /* return */ + NBIF_RET(5) + SET_SIZE(ASYM($1)) + TYPE_FUNCTION(ASYM($1)) +#endif') + +/* + * x86-specific primops. + */ +noproc_primop_interface_0(nbif_handle_fp_exception, erts_restore_fpu) + +/* + * Implement gc_bif_interface_0 as nofail_primop_interface_0. + */ +define(gc_bif_interface_0,`nofail_primop_interface_0($1, $2)') + +/* + * Implement gc_bif_interface_N as standard_bif_interface_N (N=1,2). + */ +define(gc_bif_interface_1,`standard_bif_interface_1($1, $2)') +define(gc_bif_interface_2,`standard_bif_interface_2($1, $2)') + +/* + * Implement gc_nofail_primop_interface_1 as nofail_primop_interface_1. + */ +define(gc_nofail_primop_interface_1,`nofail_primop_interface_1($1, $2)') + +include(`hipe/hipe_bif_list.m4') + +`#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif' diff --git a/erts/emulator/hipe/hipe_x86_gc.h b/erts/emulator/hipe/hipe_x86_gc.h new file mode 100644 index 0000000000..4f17f767df --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_gc.h @@ -0,0 +1,138 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * Stack walking helpers for native stack GC procedures. + */ +#ifndef HIPE_X86_GC_H +#define HIPE_X86_GC_H + +#include "hipe_x86_asm.h" /* for NR_ARG_REGS */ + +/* uncomment to simulate & test what the initial PowerPC port will do */ +//#define SKIP_YOUNGEST_FRAME + +struct nstack_walk_state { +#ifdef SKIP_YOUNGEST_FRAME + const struct sdesc *sdesc0; /* .sdesc0 must be a pointer rvalue */ +#else + struct sdesc sdesc0[1]; /* .sdesc0 must be a pointer rvalue */ +#endif +}; + +static inline int nstack_walk_init_check(const Process *p) +{ +#ifdef SKIP_YOUNGEST_FRAME + if (!p->hipe.nsp || p->hipe.nsp == p->hipe.nstend) + return 0; +#endif + return 1; +} + +static inline Eterm *nstack_walk_nsp_begin(const Process *p) +{ +#ifdef SKIP_YOUNGEST_FRAME + unsigned int nstkarity = p->hipe.narity - NR_ARG_REGS; + if ((int)nstkarity < 0) + nstkarity = 0; + return p->hipe.nsp + 1 + nstkarity; +#else + return p->hipe.nsp; +#endif +} + +static inline const struct sdesc* +nstack_walk_init_sdesc(const Process *p, struct nstack_walk_state *state) +{ +#ifdef SKIP_YOUNGEST_FRAME + const struct sdesc *sdesc = hipe_find_sdesc(p->hipe.nsp[0]); + state->sdesc0 = sdesc; + return sdesc; +#else + unsigned int nstkarity = p->hipe.narity - NR_ARG_REGS; + if ((int)nstkarity < 0) + nstkarity = 0; + state->sdesc0[0].summary = (0 << 9) | (0 << 8) | nstkarity; + state->sdesc0[0].livebits[0] = 0; + /* XXX: this appears to prevent a gcc-4.1.1 bug on x86 */ + __asm__ __volatile__("" : : "m"(*state) : "memory"); + return &state->sdesc0[0]; +#endif +} + +static inline void nstack_walk_update_trap(Process *p, const struct sdesc *sdesc0) +{ +#ifdef SKIP_YOUNGEST_FRAME + Eterm *nsp = p->hipe.nsp; + p->hipe.nsp = nstack_walk_nsp_begin(p); + hipe_update_stack_trap(p, sdesc0); + p->hipe.nsp = nsp; +#else + hipe_update_stack_trap(p, sdesc0); +#endif +} + +static inline Eterm *nstack_walk_nsp_end(const Process *p) +{ + return p->hipe.nstend; +} + +static inline void nstack_walk_kill_trap(Process *p, Eterm *nsp_end) +{ + /* remove gray/white boundary trap */ + for (;;) { + --nsp_end; + if (nsp_end[0] == (unsigned long)nbif_stack_trap_ra) { + nsp_end[0] = (unsigned long)p->hipe.ngra; + break; + } + } +} + +static inline int nstack_walk_gray_passed_black(const Eterm *gray, const Eterm *black) +{ + return gray > black; +} + +static inline int nstack_walk_nsp_reached_end(const Eterm *nsp, const Eterm *nsp_end) +{ + return nsp >= nsp_end; +} + +static inline unsigned int nstack_walk_frame_size(const struct sdesc *sdesc) +{ + return sdesc_fsize(sdesc) + 1 + sdesc_arity(sdesc); +} + +static inline Eterm *nstack_walk_frame_index(Eterm *nsp, unsigned int i) +{ + return &nsp[i]; +} + +static inline unsigned long +nstack_walk_frame_ra(const Eterm *nsp, const struct sdesc *sdesc) +{ + return nsp[sdesc_fsize(sdesc)]; +} + +static inline Eterm *nstack_walk_next_frame(Eterm *nsp, unsigned int sdesc_size) +{ + return nsp + sdesc_size; +} + +#endif /* HIPE_X86_GC_H */ diff --git a/erts/emulator/hipe/hipe_x86_glue.S b/erts/emulator/hipe/hipe_x86_glue.S new file mode 100644 index 0000000000..2f7dff39f5 --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_glue.S @@ -0,0 +1,420 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ + +#include "hipe_x86_asm.h" +#include "hipe_literals.h" +#define ASM +#include "hipe_mode_switch.h" + +/* + * Enter Erlang from C. + * Create a new frame on the C stack. + * Save C callee-save registers in the frame. + * Retrieve the process pointer from the C parameters. + * SWITCH_C_TO_ERLANG. + * + * Our C frame includes: + * - 4*4 == 16 bytes for saving %edi, %esi, %ebx, and %ebp + * - 6*4 == 24 bytes of parameter area for recursive calls + * to C BIFs: actual parameters are moved to it, not pushed + * - 8 bytes to pad the frame to a multiple of 16 bytes, + * minus 4 bytes for the return address pushed by the caller. + * OSX requires 16-byte alignment of %esp at calls (for SSE2). + */ +#define ENTER_FROM_C \ + /* create stack frame and save C callee-save registers in it */ \ + subl $44, %esp; \ + movl %edi, 28(%esp); \ + movl %esi, 32(%esp); \ + movl %ebx, 36(%esp); \ + movl %ebp, 40(%esp); \ + /* get the process pointer */ \ + movl 48(%esp), P; \ + /* switch to native stack */ \ + SWITCH_C_TO_ERLANG + + TEXT + +/* + * int x86_call_to_native(Process *p); + * Emulated code recursively calls native code. + */ + .align 4 + GLOBAL(CSYM(x86_call_to_native)) + GLOBAL(ASYM(nbif_return)) +CSYM(x86_call_to_native): + ENTER_FROM_C + /* get argument registers */ + LOAD_ARG_REGS + /* call the target */ + NSP_CALL(*P_NCALLEE(P)) +/* + * We export this return address so that hipe_mode_switch() can discover + * when native code tailcalls emulated code. + * + * This is where native code returns to emulated code. + */ +ASYM(nbif_return): + movl %eax, P_ARG0(P) # save retval + movl $HIPE_MODE_SWITCH_RES_RETURN, %eax +/* FALLTHROUGH to .flush_exit + * + * Return to the calling C function with result token in %eax. + * + * .nosave_exit saves no state + * .flush_exit saves cached P state + * .suspend_exit also saves RA + */ +.suspend_exit: + /* save RA, no-op on x86 */ +.flush_exit: + /* flush cached P state */ + SAVE_CACHED_STATE +.nosave_exit: + /* switch to C stack */ + SWITCH_ERLANG_TO_C_QUICK + /* restore C callee-save registers, drop frame, return */ + movl 28(%esp), %edi + movl 32(%esp), %esi # kills HP, if HP_IN_ESI is true + movl 36(%esp), %ebx + movl 40(%esp), %ebp # kills P + addl $44, %esp + ret + +/* + * Native code calls emulated code via a linker-generated + * stub (hipe_x86_loader.erl) which should look as follows: + * + * stub for f/N: + * movl $, P_BEAM_IP(P) + * movb $, P_ARITY(P) + * jmp nbif_callemu + * + * XXX: Different stubs for different number of register parameters? + */ + .align 4 + GLOBAL(ASYM(nbif_callemu)) +ASYM(nbif_callemu): + STORE_ARG_REGS + movl $HIPE_MODE_SWITCH_RES_CALL, %eax + jmp .suspend_exit + +/* + * nbif_apply + */ + .align 4 + GLOBAL(ASYM(nbif_apply)) +ASYM(nbif_apply): + STORE_ARG_REGS + movl $HIPE_MODE_SWITCH_RES_APPLY, %eax + jmp .suspend_exit + +/* + * Native code calls an emulated-mode closure via a stub defined below. + * + * The closure is appended as the last actual parameter, and parameters + * beyond the first few passed in registers are pushed onto the stack in + * left-to-right order. + * Hence, the location of the closure parameter only depends on the number + * of parameters in registers, not the total number of parameters. + */ +#if X86_NR_ARG_REGS == 5 + .align 4 + GLOBAL(ASYM(nbif_ccallemu5)) +ASYM(nbif_ccallemu5): + movl ARG4, P_ARG4(P) + movl 4(NSP), ARG4 + /*FALLTHROUGH*/ +#endif + +#if X86_NR_ARG_REGS >= 4 + .align 4 + GLOBAL(ASYM(nbif_ccallemu4)) +ASYM(nbif_ccallemu4): + movl ARG3, P_ARG3(P) +#if X86_NR_ARG_REGS > 4 + movl ARG4, ARG3 +#else + movl 4(NSP), ARG3 +#endif + /*FALLTHROUGH*/ +#endif + +#if X86_NR_ARG_REGS >= 3 + .align 4 + GLOBAL(ASYM(nbif_ccallemu3)) +ASYM(nbif_ccallemu3): + movl ARG2, P_ARG2(P) +#if X86_NR_ARG_REGS > 3 + movl ARG3, ARG2 +#else + movl 4(NSP), ARG2 +#endif + /*FALLTHROUGH*/ +#endif + +#if X86_NR_ARG_REGS >= 2 + .align 4 + GLOBAL(ASYM(nbif_ccallemu2)) +ASYM(nbif_ccallemu2): + movl ARG1, P_ARG1(P) +#if X86_NR_ARG_REGS > 2 + movl ARG2, ARG1 +#else + movl 4(NSP), ARG1 +#endif + /*FALLTHROUGH*/ +#endif + +#if X86_NR_ARG_REGS >= 1 + .align 4 + GLOBAL(ASYM(nbif_ccallemu1)) +ASYM(nbif_ccallemu1): + movl ARG0, P_ARG0(P) +#if X86_NR_ARG_REGS > 1 + movl ARG1, ARG0 +#else + movl 4(NSP), ARG0 +#endif + /*FALLTHROUGH*/ +#endif + + .align 4 + GLOBAL(ASYM(nbif_ccallemu0)) +ASYM(nbif_ccallemu0): + /* We use %eax not ARG0 here because ARG0 is not + defined when NR_ARG_REGS == 0. */ +#if X86_NR_ARG_REGS == 0 + movl 4(NSP), %eax +#endif + movl %eax, P_CLOSURE(P) + movl $HIPE_MODE_SWITCH_RES_CALL_CLOSURE, %eax + jmp .suspend_exit + +/* + * This is where native code suspends. + */ + .align 4 + GLOBAL(ASYM(nbif_suspend_0)) +ASYM(nbif_suspend_0): + movl $HIPE_MODE_SWITCH_RES_SUSPEND, %eax + jmp .suspend_exit + +/* + * Suspend from a receive (waiting for a message) + */ + .align 4 + GLOBAL(ASYM(nbif_suspend_msg)) +ASYM(nbif_suspend_msg): + movl $HIPE_MODE_SWITCH_RES_WAIT, %eax + jmp .suspend_exit + +/* + * Suspend from a receive with a timeout (waiting for a message) + * if (!(p->flags & F_TIMO)) { suspend } + * else { return 0; } + */ + .align 4 + GLOBAL(ASYM(nbif_suspend_msg_timeout)) +ASYM(nbif_suspend_msg_timeout): + movl P_FLAGS(P), %eax + /* this relies on F_TIMO (1<<2) fitting in a byte */ + testb $F_TIMO, %al # F_TIMO set? + jz .no_timeout # if not set, suspend + /* timeout has occurred */ + xorl %eax, %eax # return 0 to signal timeout + NSP_RET0 +.no_timeout: + movl $HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT, %eax + jmp .suspend_exit + +/* + * int x86_return_to_native(Process *p); + * Emulated code returns to its native code caller. + */ + .align 4 + GLOBAL(CSYM(x86_return_to_native)) +CSYM(x86_return_to_native): + ENTER_FROM_C + /* get return value */ + movl P_ARG0(P), %eax + /* + * Return using the stacked return address. + * The parameters were popped at the original native-to-emulated + * call (hipe_call_from_native_is_recursive), so a plain ret suffices. + */ + NSP_RET0 + +/* + * int x86_tailcall_to_native(Process *p); + * Emulated code tailcalls native code. + */ + .align 4 + GLOBAL(CSYM(x86_tailcall_to_native)) +CSYM(x86_tailcall_to_native): + ENTER_FROM_C + /* get argument registers */ + LOAD_ARG_REGS + /* jump to the target label */ + jmp *P_NCALLEE(P) + +/* + * int x86_throw_to_native(Process *p); + * Emulated code throws an exception to its native code caller. + */ + .align 4 + GLOBAL(CSYM(x86_throw_to_native)) +CSYM(x86_throw_to_native): + ENTER_FROM_C + /* invoke the handler */ + jmp *P_NCALLEE(P) # set by hipe_find_handler() + +/* + * This is the default exception handler for native code. + */ + .align 4 + GLOBAL(ASYM(nbif_fail)) +ASYM(nbif_fail): + movl $HIPE_MODE_SWITCH_RES_THROW, %eax + jmp .flush_exit + + GLOBAL(nbif_0_gc_after_bif) + GLOBAL(nbif_1_gc_after_bif) + GLOBAL(nbif_2_gc_after_bif) + GLOBAL(nbif_3_gc_after_bif) + .align 4 +nbif_0_gc_after_bif: + xorl %edx, %edx + jmp .gc_after_bif + .align 4 +nbif_1_gc_after_bif: + movl $1, %edx + jmp .gc_after_bif + .align 4 +nbif_2_gc_after_bif: + movl $2, %edx + jmp .gc_after_bif + .align 4 +nbif_3_gc_after_bif: + movl $3, %edx + /*FALLTHROUGH*/ + .align 4 +.gc_after_bif: + movl %edx, P_NARITY(P) + subl $(16-4), %esp + movl P, (%esp) + movl %eax, 4(%esp) + call CSYM(erts_gc_after_bif_call) + addl $(16-4), %esp + movl $0, P_NARITY(P) + ret + +/* + * We end up here when a BIF called from native signals an + * exceptional condition. + * The stack/heap registers were just read from P. + */ + GLOBAL(nbif_0_simple_exception) + GLOBAL(nbif_1_simple_exception) + GLOBAL(nbif_2_simple_exception) + GLOBAL(nbif_3_simple_exception) + .align 4 +nbif_0_simple_exception: + xorl %eax, %eax + jmp .nbif_simple_exception + .align 4 +nbif_1_simple_exception: + movl $1, %eax + jmp .nbif_simple_exception + .align 4 +nbif_2_simple_exception: + movl $2, %eax + jmp .nbif_simple_exception + .align 4 +nbif_3_simple_exception: + movl $3, %eax + /*FALLTHROUGH*/ + .align 4 +.nbif_simple_exception: + cmpl $FREASON_TRAP, P_FREASON(P) + je .handle_trap + /* + * Find and invoke catch handler (it must exist). + * The stack/heap registers were just read from P. + * - %eax should contain the current call's arity + */ + movl %eax, P_NARITY(P) + /* find and prepare to invoke the handler */ + SWITCH_ERLANG_TO_C_QUICK # The cached state is clean and need not be saved. + movl P, (%esp) + call CSYM(hipe_handle_exception) # Note: hipe_handle_exception() conses + SWITCH_C_TO_ERLANG # %esp updated by hipe_find_handler() + /* now invoke the handler */ + jmp *P_NCALLEE(P) # set by hipe_find_handler() + + /* + * A BIF failed with freason TRAP: + * - the BIF's arity is in %eax + * - the native heap/stack/reds registers are saved in P + */ +.handle_trap: + movl %eax, P_NARITY(P) + movl $HIPE_MODE_SWITCH_RES_TRAP, %eax + jmp .nosave_exit + +/* + * nbif_stack_trap_ra: trap return address for maintaining + * the gray/white stack boundary + */ + GLOBAL(ASYM(nbif_stack_trap_ra)) + .align 4 +ASYM(nbif_stack_trap_ra): # a return address, not a function + # This only handles a single return value. + # If we have more, we need to save them in the PCB. + movl %eax, TEMP_RV # save retval + SWITCH_ERLANG_TO_C_QUICK + movl P, (%esp) + call CSYM(hipe_handle_stack_trap) # must not cons; preserves TEMP_RV + movl %eax, %edx # original RA + SWITCH_C_TO_ERLANG_QUICK + movl TEMP_RV, %eax # restore retval + jmp *%edx # resume at original RA + +/* + * nbif_inc_stack_0 + */ + .align 4 + GLOBAL(ASYM(nbif_inc_stack_0)) +ASYM(nbif_inc_stack_0): + SWITCH_ERLANG_TO_C_QUICK + STORE_CALLER_SAVE + movl P, (%esp) + # hipe_inc_nstack reads and writes NSP and NSP_LIMIT, + # but does not access HP or FCALLS (or the non-x86 NRA). + call CSYM(hipe_inc_nstack) + LOAD_CALLER_SAVE + SWITCH_C_TO_ERLANG_QUICK + NSP_RET0 + +#if defined(__linux__) && defined(__ELF__) +.section .note.GNU-stack,"",%progbits +#endif diff --git a/erts/emulator/hipe/hipe_x86_glue.h b/erts/emulator/hipe/hipe_x86_glue.h new file mode 100644 index 0000000000..4c9c92c52f --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_glue.h @@ -0,0 +1,265 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * $Id$ + */ +#ifndef HIPE_X86_GLUE_H +#define HIPE_X86_GLUE_H + +#include "hipe_x86_asm.h" /* for NR_ARG_REGS and LEAF_WORDS */ + +/* Emulated code recursively calls native code. + The return address is `nbif_return', which is exported so that + tailcalls from native to emulated code can be identified. */ +extern unsigned int x86_call_to_native(Process*); +extern void nbif_return(void); + +/* Native-mode stubs for calling emulated-mode closures. */ +extern void nbif_ccallemu0(void); +extern void nbif_ccallemu1(void); +extern void nbif_ccallemu2(void); +extern void nbif_ccallemu3(void); +extern void nbif_ccallemu4(void); +extern void nbif_ccallemu5(void); +extern void nbif_ccallemu6(void); + +/* Default exception handler for native code. */ +extern void nbif_fail(void); + +/* Emulated code returns to its native code caller. */ +extern unsigned int x86_return_to_native(Process*); + +/* Emulated code tailcalls native code. */ +extern unsigned int x86_tailcall_to_native(Process*); + +/* Emulated code throws an exception to its native code caller. */ +extern unsigned int x86_throw_to_native(Process*); + +static __inline__ unsigned int max(unsigned int x, unsigned int y) +{ + return (x > y) ? x : y; +} + +static __inline__ void hipe_arch_glue_init(void) +{ + static struct sdesc_with_exnra nbif_return_sdesc = { + .exnra = (unsigned long)nbif_fail, + .sdesc = { + .bucket = { .hvalue = (unsigned long)nbif_return }, + .summary = (1<<8), + }, + }; + hipe_init_sdesc_table(&nbif_return_sdesc.sdesc); +} + +/* PRE: arity <= NR_ARG_REGS */ +static __inline__ void +hipe_write_x86_regs(Process *p, unsigned int arity, Eterm reg[]) +{ +#if NR_ARG_REGS > 0 + int i; + for (i = arity; --i >= 0;) + p->def_arg_reg[i] = reg[i]; +#endif +} + +/* PRE: arity <= NR_ARG_REGS */ +static __inline__ void +hipe_read_x86_regs(Process *p, unsigned int arity, Eterm reg[]) +{ +#if NR_ARG_REGS > 0 + int i; + for (i = arity; --i >= 0;) + reg[i] = p->def_arg_reg[i]; +#endif +} + +static __inline__ void +hipe_push_x86_params(Process *p, unsigned int arity, Eterm reg[]) +{ + unsigned int i; + + i = arity; + if (i > NR_ARG_REGS) { + Eterm *nsp = p->hipe.nsp; + i = NR_ARG_REGS; + do { + *--nsp = reg[i++]; + } while (i < arity); + p->hipe.nsp = nsp; + i = NR_ARG_REGS; + } + /* INV: i <= NR_ARG_REGS */ + hipe_write_x86_regs(p, i, reg); +} + +static __inline__ void +hipe_pop_x86_params(Process *p, unsigned int arity, Eterm reg[]) +{ + unsigned int i; + + i = arity; + if (i > NR_ARG_REGS) { + Eterm *nsp = p->hipe.nsp; + do { + reg[--i] = *nsp++; + } while (i > NR_ARG_REGS); + p->hipe.nsp = nsp; + /* INV: i == NR_ARG_REGS */ + } + /* INV: i <= NR_ARG_REGS */ + hipe_read_x86_regs(p, i, reg); +} + +/* BEAM recursively calls native code. */ +static __inline__ unsigned int +hipe_call_to_native(Process *p, unsigned int arity, Eterm reg[]) +{ + int nstkargs; + + /* Note that call_to_native() needs two words on the stack: + one for the nbif_return return address, and one for the + callee's return address should it need to call inc_stack_0. */ + if ((nstkargs = arity - NR_ARG_REGS) < 0) + nstkargs = 0; + hipe_check_nstack(p, max(nstkargs+1+1, LEAF_WORDS)); + hipe_push_x86_params(p, arity, reg); /* needs nstkargs words */ + return x86_call_to_native(p); /* needs 1+1 words */ +} + +/* Native called BEAM, which now tailcalls native. */ +static __inline__ unsigned int +hipe_tailcall_to_native(Process *p, unsigned int arity, Eterm reg[]) +{ + int nstkargs; + + if ((nstkargs = arity - NR_ARG_REGS) < 0) + nstkargs = 0; + /* +1 so callee can call inc_stack_0 */ + hipe_check_nstack(p, max(nstkargs+1, LEAF_WORDS)); + if (nstkargs) { + Eterm nra; + nra = *(p->hipe.nsp++); + hipe_push_x86_params(p, arity, reg); + *--(p->hipe.nsp) = nra; + } else + hipe_write_x86_regs(p, arity, reg); + return x86_tailcall_to_native(p); +} + +/* BEAM called native, which has returned. Clean up. */ +static __inline__ void hipe_return_from_native(Process *p) { } + +/* BEAM called native, which has thrown an exception. Clean up. */ +static __inline__ void hipe_throw_from_native(Process *p) { } + +/* BEAM called native, which now calls BEAM. + Move the parameters to reg[]. + Return zero if this is a tailcall, non-zero if the call is recursive. + If tailcall, also clean up native stub continuation. */ +static __inline__ int +hipe_call_from_native_is_recursive(Process *p, Eterm reg[]) +{ + Eterm nra; + + nra = *(p->hipe.nsp++); + hipe_pop_x86_params(p, p->arity, reg); + if (nra != (Eterm)nbif_return) { + *--(p->hipe.nsp) = nra; + return 1; + } + return 0; +} + +/* Native makes a call which needs to unload the parameters. + This differs from hipe_call_from_native_is_recursive() in + that it doesn't check for or pop the BEAM-calls-native frame. + It's currently only used in the implementation of apply. */ +static __inline__ void +hipe_pop_params(Process *p, unsigned int arity, Eterm reg[]) +{ + if (arity > NR_ARG_REGS) { + /* for apply/3 this will only happen if we configure + the runtime system with fewer argument registers + than default (i.e., 3) */ + Eterm nra = *(p->hipe.nsp++); + hipe_pop_x86_params(p, arity, reg); + *--(p->hipe.nsp) = nra; + } else { + /* arity <= NR_ARG_REGS so we optimise and + use hipe_read_x86_regs() directly */ + hipe_read_x86_regs(p, arity, reg); + } +} + +/* Native called BEAM, which now returns back to native. */ +static __inline__ unsigned int hipe_return_to_native(Process *p) +{ + return x86_return_to_native(p); +} + +/* Native called BEAM, which now throws an exception back to native. */ +static __inline__ unsigned int hipe_throw_to_native(Process *p) +{ + return x86_throw_to_native(p); +} + +/* Return the address of a stub switching a native closure call to BEAM. */ +static __inline__ void *hipe_closure_stub_address(unsigned int arity) +{ +#if NR_ARG_REGS == 0 + return nbif_ccallemu0; +#else /* > 0 */ + switch (arity) { + case 0: return nbif_ccallemu0; +#if NR_ARG_REGS == 1 + default: return nbif_ccallemu1; +#else /* > 1 */ + case 1: return nbif_ccallemu1; +#if NR_ARG_REGS == 2 + default: return nbif_ccallemu2; +#else /* > 2 */ + case 2: return nbif_ccallemu2; +#if NR_ARG_REGS == 3 + default: return nbif_ccallemu3; +#else /* > 3 */ + case 3: return nbif_ccallemu3; +#if NR_ARG_REGS == 4 + default: return nbif_ccallemu4; +#else /* > 4 */ + case 4: return nbif_ccallemu4; +#if NR_ARG_REGS == 5 + default: return nbif_ccallemu5; +#else /* > 5 */ + case 5: return nbif_ccallemu5; +#if NR_ARG_REGS == 6 + default: return nbif_ccallemu6; +#else +#error "NR_ARG_REGS > 6 NOT YET IMPLEMENTED" +#endif /* > 6 */ +#endif /* > 5 */ +#endif /* > 4 */ +#endif /* > 3 */ +#endif /* > 2 */ +#endif /* > 1 */ + } +#endif /* > 0 */ +} + +#endif /* HIPE_X86_GLUE_H */ diff --git a/erts/emulator/hipe/hipe_x86_primops.h b/erts/emulator/hipe/hipe_x86_primops.h new file mode 100644 index 0000000000..757da484ad --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_primops.h @@ -0,0 +1,22 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +PRIMOP_LIST(am_inc_stack_0, &nbif_inc_stack_0) +PRIMOP_LIST(am_handle_fp_exception, &nbif_handle_fp_exception) diff --git a/erts/emulator/hipe/hipe_x86_signal.c b/erts/emulator/hipe/hipe_x86_signal.c new file mode 100644 index 0000000000..a4fff4ce31 --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_signal.c @@ -0,0 +1,355 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + * hipe_x86_signal.c + * + * Erlang code compiled to x86 native code uses the x86 %esp as its + * stack pointer. This improves performance in several ways: + * - It permits the use of the x86 call and ret instructions, which + * reduces code volume and improves branch prediction. + * - It avoids stealing a gp register to act as a stack pointer. + * + * Unix signal handlers are by default delivered onto the current + * stack, i.e. %esp. This is a problem since our native-code stacks + * are small and may not have room for the Unix signal handler. + * + * There is a way to redirect signal handlers to an "alternate" signal + * stack by using the SA_ONSTACK flag with the sigaction() library call. + * Unfortunately, this has to be specified explicitly for each signal, + * and it is difficult to enforce given the presence of libraries. + * + * Our solution is to override the C library's signal handler setup + * procedure with our own which enforces the SA_ONSTACK flag. + * + * XXX: This code only supports Linux with glibc-2.1 or above, + * and Solaris 8. + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include +#include +#include +#ifdef ERTS_SMP +#include "sys.h" +#include "erl_alloc.h" +#endif +#include "hipe_signal.h" + +#if __GLIBC__ == 2 && (__GLIBC_MINOR__ >= 3) +/* See comment below for glibc 2.2. */ +#ifndef __USE_GNU +#define __USE_GNU /* to un-hide RTLD_NEXT */ +#endif +#include +static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); +#define init_done() (__next_sigaction != 0) +extern int __sigaction(int, const struct sigaction*, struct sigaction*); +#define __SIGACTION __sigaction +static void do_init(void) +{ + __next_sigaction = dlsym(RTLD_NEXT, "__sigaction"); + if (__next_sigaction != 0) + return; + perror("dlsym"); + abort(); +} +#define INIT() do { if (!init_done()) do_init(); } while (0) +#endif /* glibc 2.3 */ + +#if __GLIBC__ == 2 && (__GLIBC_MINOR__ == 2 /*|| __GLIBC_MINOR__ == 3*/) +/* + * __libc_sigaction() is the core routine. + * Without libpthread, sigaction() and __sigaction() are both aliases + * for __libc_sigaction(). + * libpthread redefines __sigaction() as a non-trivial wrapper around + * __libc_sigaction(), and makes sigaction() an alias for __sigaction(). + * glibc has internal calls to both sigaction() and __sigaction(). + * + * Overriding __libc_sigaction() would be ideal, but doing so breaks + * libpthread (threads hang). + * + * Overriding __sigaction(), using dlsym RTLD_NEXT to find glibc's + * version of __sigaction(), works with glibc-2.2.4 and 2.2.5. + * Unfortunately, this solution doesn't work with earlier versions, + * including glibc-2.2.2 and glibc-2.1.92 (2.2 despite its name): + * 2.2.2 SIGSEGVs in dlsym RTLD_NEXT (known glibc bug), and 2.1.92 + * SIGSEGVs inexplicably in two test cases in the HiPE test suite. + * + * Instead we only override sigaction() and call __sigaction() + * directly. This should work for HiPE/x86 as long as only the Posix + * signal interface is used, i.e. there are no calls to simulated + * old BSD or SysV interfaces. + * glibc's internal calls to __sigaction() appear to be mostly safe. + * hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler. + * + * Tested with glibc-2.1.92 on RedHat 7.0, glibc-2.2.2 on RedHat 7.1, + * glibc-2.2.4 on RedHat 7.2, and glibc-2.2.5 on RedHat 7.3. + */ +#if 0 +/* works with 2.2.5 and 2.2.4, but not 2.2.2 or 2.1.92 */ +#define __USE_GNU /* to un-hide RTLD_NEXT */ +#include +static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); +#define init_done() (__next_sigaction != 0) +#define __SIGACTION __sigaction +static void do_init(void) +{ + __next_sigaction = dlsym(RTLD_NEXT, "__sigaction"); + if (__next_sigaction != 0) + return; + perror("dlsym"); + abort(); +} +#define INIT() do { if (!init_done()) do_init(); } while (0) +#else +/* semi-works with all 2.2 versions so far */ +extern int __sigaction(int, const struct sigaction*, struct sigaction*); +#define __next_sigaction __sigaction /* pthreads-aware version */ +#undef __SIGACTION /* we can't override __sigaction() */ +#define INIT() do{}while(0) +#endif +#endif /* glibc 2.2 */ + +#if __GLIBC__ == 2 && __GLIBC_MINOR__ == 1 +/* + * __sigaction() is the core routine. + * Without libpthread, sigaction() is an alias for __sigaction(). + * libpthread redefines sigaction() as a non-trivial wrapper around + * __sigaction(). + * glibc has internal calls to both sigaction() and __sigaction(). + * + * Overriding __sigaction() would be ideal, but doing so breaks + * libpthread (threads hang). Instead we override sigaction() and + * use dlsym RTLD_NEXT to find glibc's version of sigaction(). + * glibc's internal calls to __sigaction() appear to be mostly safe. + * hipe_signal_init() fixes some unsafe ones, e.g. the SIGPROF handler. + * + * Tested with glibc-2.1.3 on RedHat 6.2. + */ +#include +static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); +#define init_done() (__next_sigaction != 0) +#undef __SIGACTION +static void do_init(void) +{ + __next_sigaction = dlsym(RTLD_NEXT, "sigaction"); + if (__next_sigaction != 0) + return; + perror("dlsym"); + abort(); +} +#define INIT() do { if (!init_done()) do_init(); } while (0) +#endif /* glibc 2.1 */ + +/* Is there no standard identifier for Darwin/MacOSX ? */ +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define __DARWIN__ 1 +#endif + +#if defined(__DARWIN__) +/* + * Assumes Mac OS X >= 10.3 (dlsym operations not available in 10.2 and + * earlier). + * + * The code below assumes that is is part of the main image (earlier + * in the load order than libSystem and certainly before any dylib + * that might use sigaction) -- a standard RTLD_NEXT caveat. + * + * _sigaction lives in /usr/lib/libSystem.B.dylib and can be found + * with the standard dlsym(RTLD_NEXT) call. The proviso on Mac OS X + * being that the symbol for dlsym doesn't include a leading '_'. + * + * The other _sigaction, _sigaction_no_bind I don't understand the purpose + * of and don't modify. + */ +#include +static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); +#define init_done() (__next_sigaction != 0) +#define __SIGACTION _sigaction +static void do_init(void) +{ + __next_sigaction = dlsym(RTLD_NEXT, "sigaction"); + if (__next_sigaction != 0) + return; + perror("dlsym_darwin"); + abort(); +} +#define _NSIG NSIG +#define INIT() do { if (!init_done()) do_init(); } while (0) +#endif /* __DARWIN__ */ + +#if !defined(__GLIBC__) && !defined(__DARWIN__) +/* + * Assume Solaris/x86 2.8. + * There is a number of sigaction() procedures in libc: + * * sigaction(): weak reference to _sigaction(). + * * _sigaction(): apparently a simple wrapper around __sigaction(). + * * __sigaction(): apparently the procedure doing the actual system call. + * * _libc_sigaction(): apparently some thread-related wrapper, which ends + * up calling __sigaction(). + * The threads library redefines sigaction() and _sigaction() to its + * own wrapper, which checks for and restricts access to threads-related + * signals. The wrapper appears to eventually call libc's __sigaction(). + * + * We catch and override _sigaction() since overriding __sigaction() + * causes fatal errors in some cases. + * + * When linked with thread support, there are calls to sigaction() before + * our init routine has had a chance to find _sigaction()'s address. + * This forces us to initialise at the first call. + */ +#include +static int (*__next_sigaction)(int, const struct sigaction*, struct sigaction*); +#define init_done() (__next_sigaction != 0) +#define __SIGACTION _sigaction +static void do_init(void) +{ + __next_sigaction = dlsym(RTLD_NEXT, "_sigaction"); + if (__next_sigaction != 0) + return; + perror("dlsym"); + abort(); +} +#define _NSIG NSIG +#define INIT() do { if (!init_done()) do_init(); } while (0) +#endif /* not glibc or darwin */ + +/* + * This is our wrapper for sigaction(). sigaction() can be called before + * hipe_signal_init() has been executed, especially when threads support + * has been linked with the executable. Therefore, we must initialise + * __next_sigaction() dynamically, the first time it's needed. + */ +static int my_sigaction(int signum, const struct sigaction *act, struct sigaction *oldact) +{ + struct sigaction newact; + + INIT(); + + if (act && + act->sa_handler != SIG_DFL && + act->sa_handler != SIG_IGN && + !(act->sa_flags & SA_ONSTACK)) { + newact = *act; + newact.sa_flags |= SA_ONSTACK; + act = &newact; + } + return __next_sigaction(signum, act, oldact); +} + +/* + * This overrides the C library's core sigaction() procedure, catching + * all its internal calls. + */ +#ifdef __SIGACTION +int __SIGACTION(int signum, const struct sigaction *act, struct sigaction *oldact) +{ + return my_sigaction(signum, act, oldact); +} +#endif + +/* + * This catches the application's own sigaction() calls. + */ +#if !defined(__DARWIN__) +int sigaction(int signum, const struct sigaction *act, struct sigaction *oldact) +{ + return my_sigaction(signum, act, oldact); +} +#endif + +/* + * Set alternate signal stack for the invoking thread. + */ +static void hipe_sigaltstack(void *ss_sp) +{ + stack_t ss; + + ss.ss_sp = ss_sp; + ss.ss_flags = SS_ONSTACK; + ss.ss_size = SIGSTKSZ; + if (sigaltstack(&ss, NULL) < 0) { + /* might be a broken pre-2.4 Linux kernel, try harder */ + ss.ss_flags = 0; + if (sigaltstack(&ss, NULL) < 0) { + perror("sigaltstack"); + abort(); + } + } +} + +#ifdef ERTS_SMP +/* + * Set up alternate signal stack for an Erlang process scheduler thread. + */ +void hipe_thread_signal_init(void) +{ + hipe_sigaltstack(erts_alloc(ERTS_ALC_T_HIPE, SIGSTKSZ)); +} +#endif + +/* + * Set up alternate signal stack for the main thread, + * unless this is a multithreaded runtime system. + */ +static void hipe_sigaltstack_init(void) +{ +#if !defined(ERTS_SMP) + static unsigned long my_sigstack[SIGSTKSZ/sizeof(long)]; + hipe_sigaltstack(my_sigstack); +#endif +} + +/* + * 1. Set up alternate signal stack for the main thread. + * 2. Add SA_ONSTACK to existing user-defined signal handlers. + */ +void hipe_signal_init(void) +{ + struct sigaction sa; + int i; + + INIT(); + + hipe_sigaltstack_init(); + + for (i = 1; i < _NSIG; ++i) { + if (sigaction(i, NULL, &sa)) { + /* This will fail with EINVAL on Solaris if 'i' is one of the + thread library's private signals. We DO catch the initial + setup of these signals, so things MAY be OK anyway. */ + continue; + } + if (sa.sa_handler == SIG_DFL || + sa.sa_handler == SIG_IGN || + (sa.sa_flags & SA_ONSTACK)) + continue; + sa.sa_flags |= SA_ONSTACK; + if (sigaction(i, &sa, NULL)) { +#ifdef SIGCANCEL + /* Solaris 9 x86 refuses to let us modify SIGCANCEL. */ + if (i == SIGCANCEL) + continue; +#endif + perror("sigaction"); + abort(); + } + } +} diff --git a/erts/emulator/hipe/hipe_x86_stack.c b/erts/emulator/hipe/hipe_x86_stack.c new file mode 100644 index 0000000000..b459593883 --- /dev/null +++ b/erts/emulator/hipe/hipe_x86_stack.c @@ -0,0 +1,296 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* $Id$ + */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif +#include "global.h" +#include "bif.h" +#include "hipe_stack.h" +#ifdef __x86_64__ +#include "hipe_amd64_asm.h" /* for NR_ARG_REGS */ +#else +#include "hipe_x86_asm.h" /* for NR_ARG_REGS */ +#endif + +extern void nbif_fail(void); +extern void nbif_stack_trap_ra(void); + +/* + * hipe_print_nstack() is called from hipe_bifs:show_nstack/1. + */ +static void print_slot(Eterm *sp, unsigned int live) +{ + Eterm val = *sp; + printf(" | 0x%0*lx | 0x%0*lx | ", + 2*(int)sizeof(long), (unsigned long)sp, + 2*(int)sizeof(long), val); + if (live) + erts_printf("%.30T", val); + printf("\r\n"); +} + +void hipe_print_nstack(Process *p) +{ + Eterm *nsp; + Eterm *nsp_end; + struct sdesc sdesc0; + const struct sdesc *sdesc1; + const struct sdesc *sdesc; + unsigned long ra; + unsigned long exnra; + unsigned int mask; + unsigned int sdesc_size; + unsigned int i; + unsigned int nstkarity; + static const char dashes[2*sizeof(long)+5] = { + [0 ... 2*sizeof(long)+3] = '-' + }; + + nsp = p->hipe.nsp; + nsp_end = p->hipe.nstend; + + nstkarity = p->hipe.narity - NR_ARG_REGS; + if ((int)nstkarity < 0) + nstkarity = 0; + sdesc0.summary = nstkarity; + sdesc0.livebits[0] = ~1; + sdesc = &sdesc0; + + printf(" | NATIVE STACK |\r\n"); + printf(" |%s|%s|\r\n", dashes, dashes); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "heap", + 2*(int)sizeof(long), (unsigned long)p->heap); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "high_water", + 2*(int)sizeof(long), (unsigned long)p->high_water); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "hend", + 2*(int)sizeof(long), (unsigned long)p->htop); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "old_heap", + 2*(int)sizeof(long), (unsigned long)p->old_heap); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "old_hend", + 2*(int)sizeof(long), (unsigned long)p->old_hend); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "nsp", + 2*(int)sizeof(long), (unsigned long)p->hipe.nsp); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "nstend", + 2*(int)sizeof(long), (unsigned long)p->hipe.nstend); + printf(" | %*s| 0x%0*lx |\r\n", + 2+2*(int)sizeof(long)+1, "nstblacklim", + 2*(int)sizeof(long), (unsigned long)p->hipe.nstblacklim); + printf(" | %*s | 0x%0*lx |\r\n", + 2+2*(int)sizeof(long), "nstgraylim", + 2*(int)sizeof(long), (unsigned long)p->hipe.nstgraylim); + printf(" | %*s | 0x%0*x |\r\n", + 2+2*(int)sizeof(long), "narity", + 2*(int)sizeof(long), p->hipe.narity); + printf(" |%s|%s|\r\n", dashes, dashes); + printf(" | %*s | %*s |\r\n", + 2+2*(int)sizeof(long), "Address", + 2+2*(int)sizeof(long), "Contents"); + + for (;;) { + printf(" |%s|%s|\r\n", dashes, dashes); + if (nsp >= nsp_end) { + if (nsp == nsp_end) + return; + fprintf(stderr, "%s: passed end of stack\r\n", __FUNCTION__); + break; + } + ra = nsp[sdesc_fsize(sdesc)]; + if (ra == (unsigned long)nbif_stack_trap_ra) + sdesc1 = hipe_find_sdesc((unsigned long)p->hipe.ngra); + else + sdesc1 = hipe_find_sdesc(ra); + sdesc_size = sdesc_fsize(sdesc) + 1 + sdesc_arity(sdesc); + i = 0; + mask = sdesc->livebits[0]; + for (;;) { + if (i == sdesc_fsize(sdesc)) { + printf(" | 0x%0*lx | 0x%0*lx | ", + 2*(int)sizeof(long), (unsigned long)&nsp[i], + 2*(int)sizeof(long), ra); + if (ra == (unsigned long)nbif_stack_trap_ra) + printf("STACK TRAP, ORIG RA 0x%lx", (unsigned long)p->hipe.ngra); + else + printf("NATIVE RA"); + if ((exnra = sdesc_exnra(sdesc1)) != 0) + printf(", EXNRA 0x%lx", exnra); + printf("\r\n"); + } else + print_slot(&nsp[i], (mask & 1)); + if (++i >= sdesc_size) + break; + if (i & 31) + mask >>= 1; + else + mask = sdesc->livebits[i >> 5]; + } + nsp += sdesc_size; + sdesc = sdesc1; + } + abort(); +} + +#define MINSTACK 128 +#define NSKIPFRAMES 4 + +void hipe_update_stack_trap(Process *p, const struct sdesc *sdesc) +{ + Eterm *nsp; + Eterm *nsp_end; + unsigned long ra; + int n; + + nsp = p->hipe.nsp; + nsp_end = p->hipe.nstend; + if ((unsigned long)((char*)nsp_end - (char*)nsp) < MINSTACK*sizeof(Eterm*)) { + p->hipe.nstgraylim = NULL; + return; + } + n = NSKIPFRAMES; + for (;;) { + nsp += sdesc_fsize(sdesc); + if (nsp >= nsp_end) { + p->hipe.nstgraylim = NULL; + return; + } + ra = nsp[0]; + if (--n <= 0) + break; + nsp += 1 + sdesc_arity(sdesc); + sdesc = hipe_find_sdesc(ra); + } + p->hipe.nstgraylim = nsp + 1 + sdesc_arity(sdesc); + p->hipe.ngra = (void(*)(void))ra; + nsp[0] = (unsigned long)nbif_stack_trap_ra; +} + +/* + * hipe_handle_stack_trap() is called when the mutator returns to + * nbif_stack_trap_ra, which marks the gray/white stack boundary frame. + * The gray/white boundary is moved back one or more frames. + * + * The function head below is "interesting". + */ +void (*hipe_handle_stack_trap(Process *p))(void) +{ + void (*ngra)(void) = p->hipe.ngra; + const struct sdesc *sdesc = hipe_find_sdesc((unsigned long)ngra); + hipe_update_stack_trap(p, sdesc); + return ngra; +} + +/* + * hipe_find_handler() is called from hipe_handle_exception() to locate + * the current exception handler's PC and SP. + * The native stack MUST contain a stack frame as it appears on + * entry to a function (return address, actuals, caller's frame). + * p->hipe.narity MUST contain the arity (number of actuals). + * On exit, p->hipe.ncallee is set to the handler's PC and p->hipe.nsp + * is set to its SP (low address of its stack frame). + */ +void hipe_find_handler(Process *p) +{ + Eterm *nsp; + Eterm *nsp_end; + unsigned long ra; + unsigned long exnra; + unsigned int arity; + const struct sdesc *sdesc; + unsigned int nstkarity; + + nsp = p->hipe.nsp; + nsp_end = p->hipe.nstend; + nstkarity = p->hipe.narity - NR_ARG_REGS; + if ((int)nstkarity < 0) + nstkarity = 0; + arity = nstkarity; + + while (nsp < nsp_end) { + ra = nsp[0]; + if (ra == (unsigned long)nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + sdesc = hipe_find_sdesc(ra); + /* nsp = nsp + 1 + arity + sdesc_fsize(sdesc); */ + nsp += 1; /* skip ra */ + nsp += arity; /* skip actuals */ + if ((exnra = sdesc_exnra(sdesc)) != 0 && + (p->catches >= 0 || + exnra == (unsigned long)nbif_fail)) { + p->hipe.ncallee = (void(*)(void)) exnra; + p->hipe.nsp = nsp; + p->hipe.narity = 0; + /* update the gray/white boundary if we threw past it */ + if (p->hipe.nstgraylim && nsp >= p->hipe.nstgraylim) + hipe_update_stack_trap(p, sdesc); + return; + } + nsp += sdesc_fsize(sdesc); + arity = sdesc_arity(sdesc); + } + fprintf(stderr, "%s: no native CATCH found!\r\n", __FUNCTION__); + abort(); +} + +int hipe_fill_stacktrace(Process *p, int depth, Eterm **trace) +{ + Eterm *nsp; + Eterm *nsp_end; + unsigned long ra, prev_ra; + unsigned int arity; + const struct sdesc *sdesc; + unsigned int nstkarity; + int i; + + if (depth < 1) + return 0; + + nsp = p->hipe.nsp; + nsp_end = p->hipe.nstend; + nstkarity = p->hipe.narity - NR_ARG_REGS; + if ((int)nstkarity < 0) + nstkarity = 0; + arity = nstkarity; + + prev_ra = 0; + i = 0; + while (nsp < nsp_end) { /* INV: i < depth */ + ra = nsp[0]; + if (ra == (unsigned long)nbif_stack_trap_ra) + ra = (unsigned long)p->hipe.ngra; + if (ra != prev_ra) { + trace[i] = (Eterm*)ra; + ++i; + if (i == depth) + break; + prev_ra = ra; + } + sdesc = hipe_find_sdesc(ra); + nsp += 1 + arity + sdesc_fsize(sdesc); + arity = sdesc_arity(sdesc); + } + return i; +} diff --git a/erts/emulator/internal_doc/erl_ext_dist.txt b/erts/emulator/internal_doc/erl_ext_dist.txt new file mode 100644 index 0000000000..1cbbbcc7b8 --- /dev/null +++ b/erts/emulator/internal_doc/erl_ext_dist.txt @@ -0,0 +1,23 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 1997-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +-------------------------------------------------------------------------------- + +The information in this text file has been moved to +the Erts User's Guide (the sections named "External Term Format" +and "Distribution Protocol"). diff --git a/erts/emulator/obsolete/driver.h b/erts/emulator/obsolete/driver.h new file mode 100644 index 0000000000..708fe68e1a --- /dev/null +++ b/erts/emulator/obsolete/driver.h @@ -0,0 +1,263 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * OLD, OBSOLETE include file for erlang driver writers. + * New drivers should use erl_driver.h instead. + */ + +#ifndef __DRIVER_H__ +#define __DRIVER_H__ + +#include +#include "driver_int.h" + +#undef _ANSI_ARGS_ +#undef CONST + +#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE) +# define _USING_PROTOTYPES_ 1 +# define _ANSI_ARGS_(x) x +# define CONST const +#else +# define _ANSI_ARGS_(x) () +# define CONST +#endif + +#ifdef __cplusplus +# define EXTERN extern "C" +#else +# define EXTERN extern +#endif + +/* Values for mode arg to driver_select() */ + +#define DO_READ (1 << 0) +#define DO_WRITE (1 << 1) + +/* Flags for set_port_control_flags() */ +#define PORT_CONTROL_FLAG_BINARY 1 +#define PORT_CONTROL_FLAG_HEAVY 2 + +/* This macro is used to name a dynamic driver's init function in */ +/* a way that doesn't lead to conflicts. This is crucial when using */ +/* operating systems that has one namespace for all symbols */ +/* (e.g. VxWorks). Example: if you have an dynamic driver C source */ +/* file named echo_drv.c, you use the macro like this: */ +/* int DRIVER_INIT(echo_drv)(void *handle) */ +#if defined(VXWORKS) +# define DRIVER_INIT(DRIVER_NAME) DRIVER_NAME ## _init +#elif defined(__WIN32__) +# define DRIVER_INIT(DRIVER_NAME) __declspec(dllexport) driver_init +#else +# define DRIVER_INIT(DRIVER_NAME) driver_init +#endif + +typedef int (*F_PTR)(); /* a function pointer */ +typedef long (*L_PTR)(); /* pointer to a function returning long */ + +extern int null_func(); + +/* This structure MUST match Binary in global.h exactly!!! */ +typedef struct driver_binary { + int orig_size; /* total length of binary */ + char orig_bytes[1]; /* the data (char instead of byte!) */ +} DriverBinary; + +typedef struct { + int vsize; /* length of vectors */ + int size; /* total size in bytes */ + SysIOVec* iov; + DriverBinary** binv; +} ErlIOVec; + +/* + * OLD, OBSOLETE driver entry structure. + */ + +typedef struct driver_entry { + F_PTR init; /* called at system start up (no args) */ + L_PTR start; /* called when some one does an open_port + args: port, command (nul-terminated), + additional/alternate args for fd/vanilla/spawn driver. + return value -1 means failure, other + is saved and passed to the other funcs */ + F_PTR stop; /* called when port is closed, and when the + emulator is halted - arg: start_return */ + F_PTR output; /* called when we have output from erlang to the port + args: start_return, buf, buflen */ + F_PTR ready_input; /* called when we have input from one of the driver's + file descriptors - args: start_return, fd */ + F_PTR ready_output; /* called when output is possible to one of the driver's + file descriptors - args: start_return, fd */ + char *driver_name; /* name supplied as {driver,Name,Args} to open_port */ + + F_PTR finish; /* called before unloading (DYNAMIC DRIVERS ONLY) */ + void *handle; /* file handle (DYNAMIC DRIVERS ONLY) */ + F_PTR control; /* "ioctl" for drivers (invoked by port_command/3) */ + F_PTR timeout; /* Reserved */ + F_PTR outputv; /* Reserved */ + F_PTR ready_async; /* Completion routine for driver_async */ + F_PTR padding1[3]; /* pad to match size of modern driver struct */ + int padding2[4]; /* more pad */ + F_PTR padding3[3]; /* even more padding */ +} DriverEntry; + + +/* These are the kernel functions available for driver writers */ + +EXTERN int driver_select _ANSI_ARGS_((int,int,int,int)); + +EXTERN int driver_output _ANSI_ARGS_((int, char*, int)); +EXTERN int driver_output2 _ANSI_ARGS_((int, char*, int, char*, int)); +EXTERN int driver_output_binary _ANSI_ARGS_((int, char*, int, + DriverBinary*, int, int)); +EXTERN int driver_outputv _ANSI_ARGS_((int, char*,int,ErlIOVec*,int)); + +EXTERN int driver_vec_to_buf _ANSI_ARGS_((ErlIOVec*, char*, int)); + +EXTERN int driver_set_timer _ANSI_ARGS_((int, unsigned long)); +EXTERN int driver_cancel_timer _ANSI_ARGS_((int)); + +/* + * The following functions are used to initiate a close of a port + * from a driver. + */ +EXTERN int driver_failure_eof _ANSI_ARGS_((int)); +EXTERN int driver_failure_atom _ANSI_ARGS_((int, char *)); +EXTERN int driver_failure_posix _ANSI_ARGS_((int, int)); +EXTERN int driver_failure _ANSI_ARGS_((int, int)); +EXTERN int driver_exit _ANSI_ARGS_ ((int, int)); + +EXTERN char* erl_errno_id _ANSI_ARGS_((int error)); +EXTERN void set_busy_port _ANSI_ARGS_((int, int)); +EXTERN void add_driver_entry _ANSI_ARGS_((DriverEntry *)); +EXTERN int remove_driver_entry _ANSI_ARGS_((DriverEntry *)); +EXTERN void set_port_control_flags _ANSI_ARGS_((int, int)); + +/* Binary interface */ +/* NOTE: DO NOT overwrite a binary with new data (if the data is delivered); +** since the binary is a shared object it MUST be written once. +*/ + +EXTERN DriverBinary* driver_alloc_binary _ANSI_ARGS_((int)); +EXTERN DriverBinary* driver_realloc_binary _ANSI_ARGS_((DriverBinary*, int)); +EXTERN void driver_free_binary _ANSI_ARGS_((DriverBinary*)); + + +/* Queue interface */ +EXTERN int driver_enqv _ANSI_ARGS_((int, ErlIOVec*, int)); +EXTERN int driver_pushqv _ANSI_ARGS_((int, ErlIOVec*, int)); +EXTERN int driver_deq _ANSI_ARGS_((int, int)); +EXTERN SysIOVec* driver_peekq _ANSI_ARGS_((int, int*)); +EXTERN int driver_sizeq _ANSI_ARGS_((int)); +EXTERN int driver_enq_bin _ANSI_ARGS_((int, DriverBinary*, int, int)); +EXTERN int driver_enq _ANSI_ARGS_((int, char*, int)); +EXTERN int driver_pushq_bin _ANSI_ARGS_((int, DriverBinary*, int, int)); +EXTERN int driver_pushq _ANSI_ARGS_((int, char*, int)); + +/* Memory management */ +EXTERN void *driver_alloc _ANSI_ARGS_((size_t)); +EXTERN void *driver_realloc _ANSI_ARGS_((void*, size_t)); +EXTERN void driver_free _ANSI_ARGS_((void*)); + +/* Shared / dynamic link libraries */ +EXTERN void *driver_dl_open _ANSI_ARGS_((char *)); +EXTERN void *driver_dl_sym _ANSI_ARGS_((void *, char *)); +EXTERN int driver_dl_close _ANSI_ARGS_((void *)); +EXTERN char *driver_dl_error _ANSI_ARGS_((void)); + +/* Async IO functions */ +EXTERN long driver_async _ANSI_ARGS_((int, + unsigned int*, + void (*)(void*), + void *, + void (*)(void*))); +EXTERN int driver_async_cancel _ANSI_ARGS_((long)); + +EXTERN int driver_lock_driver _ANSI_ARGS_((int)); + +/* Threads */ +typedef void* erl_mutex_t; +typedef void* erl_cond_t; +typedef void* erl_thread_t; + +EXTERN erl_mutex_t erts_mutex_create _ANSI_ARGS_((void)); +EXTERN int erts_mutex_destroy _ANSI_ARGS_((erl_mutex_t)); +EXTERN int erts_mutex_lock _ANSI_ARGS_((erl_mutex_t)); +EXTERN int erts_mutex_unlock _ANSI_ARGS_((erl_mutex_t)); + +EXTERN erl_cond_t erts_cond_create _ANSI_ARGS_((void)); +EXTERN int erts_cond_destroy _ANSI_ARGS_((erl_cond_t)); +EXTERN int erts_cond_signal _ANSI_ARGS_((erl_cond_t)); +EXTERN int erts_cond_broadcast _ANSI_ARGS_((erl_cond_t)); +EXTERN int erts_cond_wait _ANSI_ARGS_((erl_cond_t, erl_mutex_t)); +EXTERN int erts_cond_timedwait _ANSI_ARGS_((erl_cond_t, erl_mutex_t, long)); + +EXTERN int erts_thread_create _ANSI_ARGS_((erl_thread_t*, + void* (*func)(void*), + void* arg, + int detached)); +EXTERN erl_thread_t erts_thread_self _ANSI_ARGS_((void)); +EXTERN void erts_thread_exit _ANSI_ARGS_((void*)); +EXTERN int erts_thread_join _ANSI_ARGS_((erl_thread_t, void**)); +EXTERN int erts_thread_kill _ANSI_ARGS_((erl_thread_t)); + + +typedef unsigned long DriverTermData; + +#define TERM_DATA(x) ((DriverTermData) (x)) + +/* Possible types to send from driver Argument type */ +#define ERL_DRV_NIL ((DriverTermData) 1) /* None */ +#define ERL_DRV_ATOM ((DriverTermData) 2) /* driver_mk_atom(string) */ +#define ERL_DRV_INT ((DriverTermData) 3) /* int */ +#define ERL_DRV_PORT ((DriverTermData) 4) /* driver_mk_port(ix) */ +#define ERL_DRV_BINARY ((DriverTermData) 5) /* ErlDriverBinary*, int */ +#define ERL_DRV_STRING ((DriverTermData) 6) /* char*, int */ +#define ERL_DRV_TUPLE ((DriverTermData) 7) /* int */ +#define ERL_DRV_LIST ((DriverTermData) 8) /* int */ +#define ERL_DRV_STRING_CONS ((DriverTermData) 9) /* char*, int */ +#define ERL_DRV_PID ((DriverTermData) 10) /* driver_connected,... */ + +/* DriverTermData is the type to use for casts when building + * terms that should be sent to connected process, + * for instance a tuple on the form {tcp, Port, [Tag|Binary]} + * + * DriverTermData spec[] = { + * ERL_DRV_ATOM, driver_mk_atom("tcp"), + * ERL_DRV_PORT, driver_mk_port(drv->ix), + * ERL_DRV_INT, REPLY_TAG, + * ERL_DRV_BIN, 50, TERM_DATA(buffer), + * ERL_DRV_LIST, 2, + * ERL_DRV_TUPLE, 3, + * } + * + */ + +EXTERN DriverTermData driver_mk_atom _ANSI_ARGS_ ((char*)); +EXTERN DriverTermData driver_mk_port _ANSI_ARGS_ ((int)); +EXTERN DriverTermData driver_connected _ANSI_ARGS_((int)); +EXTERN DriverTermData driver_caller _ANSI_ARGS_((int)); + +EXTERN int driver_output_term _ANSI_ARGS_((int, DriverTermData *, int)); +EXTERN int driver_send_term _ANSI_ARGS_((int, DriverTermData, DriverTermData *, int)); + +#endif + + diff --git a/erts/emulator/pcre/Makefile b/erts/emulator/pcre/Makefile new file mode 100644 index 0000000000..72eea01130 --- /dev/null +++ b/erts/emulator/pcre/Makefile @@ -0,0 +1,26 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2008-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# Invoke with GNU make or clearmake -C gnu. +# + +include $(ERL_TOP)/make/run_make.mk + +table: + $(MAKE) -f $(TARGET)/Makefile $@ \ No newline at end of file diff --git a/erts/emulator/pcre/Makefile.in b/erts/emulator/pcre/Makefile.in new file mode 100644 index 0000000000..f62700ec4e --- /dev/null +++ b/erts/emulator/pcre/Makefile.in @@ -0,0 +1,165 @@ +# Makefile for zlib +# Copyright (C) 1995-1996 Jean-loup Gailly. +# For conditions of distribution and use, see copyright notice in zlib.h + +# To compile and test, type: +# ./configure; make test +# The call of configure is optional if you don't have special requirements + +# To install /usr/local/lib/libz.* and /usr/local/include/zlib.h, type: +# make install +# To install in $HOME instead of /usr/local, use: +# make install prefix=$HOME + +# %ExternalCopyright% + +ARFLAGS = rc + +O = \ +pcre_latin_1_table.o \ +pcre_compile.o \ +pcre_config.o \ +pcre_dfa_exec.o \ +pcre_exec.o \ +pcre_fullinfo.o \ +pcre_get.o \ +pcre_globals.o \ +pcre_info.o \ +pcre_maketables.o \ +pcre_newline.o \ +pcre_ord2utf8.o \ +pcre_refcount.o \ +pcre_study.o \ +pcre_tables.o \ +pcre_try_flipped.o \ +pcre_ucp_searchfuncs.o \ +pcre_valid_utf8.o \ +pcre_version.o \ +pcre_xclass.o + +OBJS = $(O:%=$(OBJDIR)/%) + +GENINC = pcre_exec_loop_break_cases.inc + +#### Begin OTP targets + +include $(ERL_TOP)/make/target.mk + +# On windows we need a separate zlib during debug build +ifeq ($(TARGET),win32) + +ifeq ($(TYPE),debug) +CFLAGS = $(subst -O2, -g, @CFLAGS@ @DEFS@ @DEBUG_FLAGS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION) +else # debug +CFLAGS = @CFLAGS@ @DEFS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION +endif # debug + +else # win32 + +ifeq ($(TYPE),debug) +TYPE_FLAGS = @DEBUG_CFLAGS@ +else # debug +ifeq ($(TYPE),gcov) +TYPE_FLAGS = -O0 -fprofile-arcs -ftest-coverage +else # gcov +TYPE_FLAGS = -O3 +endif # gcov +endif # debug + +CFLAGS = $(TYPE_FLAGS) $(subst -O2,, @CFLAGS@) @DEFS@ @EMU_THR_DEFS@ -DERLANG_INTEGRATION + +endif # win32 + +OBJDIR = $(ERL_TOP)/erts/emulator/pcre/obj/$(TARGET)/$(TYPE) + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +ifeq ($(TARGET), win32) +LIBRARY=$(OBJDIR)/epcre.lib +else +LIBRARY=$(OBJDIR)/libepcre.a +endif + +all: $(LIBRARY) + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + +tests release_tests: + +docs release_docs release_docs_spec: + +clean: + rm -f $(OBJS) $(OBJDIR)/libepcre.a + +#### end OTP targets + +ifeq ($(TARGET), win32) +$(LIBRARY): $(OBJS) + $(AR) -out:$@ $(OBJS) +else +$(LIBRARY): $(OBJS) + $(AR) $(ARFLAGS) $@ $(OBJS) + -@ ($(RANLIB) $@ || true) 2>/dev/null +endif + +$(OBJDIR)/%.o: %.c + $(CC) -c $(CFLAGS) -o $@ $< + +$(GENINC): pcre_exec.c + for x in `grep -n COST_CHK pcre_exec.c | grep -v 'COST_CHK(N)' | awk -F: '{print $$1}'`; \ + do \ + N=`expr $$x + 100`; \ + echo "case $$N: goto L_LOOP_COUNT_$${x};"; \ + done > $(GENINC) + +table: ./gen_table + ./gen_table pcre_latin_1_table.c + +./gen_table: pcre_make_latin1_default.c make_latin1_table.c + $(CC) $(CFLAGS) -o gen_table pcre_make_latin1_default.c make_latin1_table.c + +# DO NOT DELETE THIS LINE -- make depend depends on it. + +$(OBJDIR)/pcre_chartables.o: pcre_chartables.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_compile.o: pcre_compile.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_config.o: pcre_config.c pcre_internal.h local_config.h pcre.h \ + ucp.h +$(OBJDIR)/pcre_dfa_exec.o: pcre_dfa_exec.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_exec.o: pcre_exec.c pcre_internal.h local_config.h pcre.h ucp.h \ + $(GENINC) +$(OBJDIR)/pcre_fullinfo.o: pcre_fullinfo.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_get.o: pcre_get.c pcre_internal.h local_config.h pcre.h ucp.h +$(OBJDIR)/pcre_globals.o: pcre_globals.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_info.o: pcre_info.c pcre_internal.h local_config.h pcre.h ucp.h +$(OBJDIR)/pcre_maketables.o: pcre_maketables.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_newline.o: pcre_newline.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_ord2utf8.o: pcre_ord2utf8.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_refcount.o: pcre_refcount.c pcre_internal.h local_config.h \ + pcre.h ucp.h +$(OBJDIR)/pcre_study.o: pcre_study.c pcre_internal.h local_config.h pcre.h \ + ucp.h +$(OBJDIR)/pcre_tables.o: pcre_tables.c pcre_internal.h local_config.h pcre.h \ + ucp.h +$(OBJDIR)/pcre_try_flipped.o: pcre_try_flipped.c pcre_internal.h \ + local_config.h pcre.h ucp.h +$(OBJDIR)/pcre_ucp_searchfuncs.o: pcre_ucp_searchfuncs.c pcre_internal.h \ + local_config.h pcre.h ucp.h ucpinternal.h ucptable.h +$(OBJDIR)/pcre_valid_utf8.o: pcre_valid_utf8.c pcre_internal.h local_config.h \ + pcre.h ucp.h +pcre_version.o: pcre_version.c pcre_internal.h local_config.h pcre.h \ + ucp.h +$(OBJDIR)/pcre_xclass.o: pcre_xclass.c pcre_internal.h local_config.h pcre.h \ + ucp.h diff --git a/erts/emulator/pcre/local_config.h b/erts/emulator/pcre/local_config.h new file mode 100644 index 0000000000..0c85410363 --- /dev/null +++ b/erts/emulator/pcre/local_config.h @@ -0,0 +1,81 @@ +/* %ExternalCopyright% */ + +#define HAVE_ZLIB_H 1 +/* The value of LINK_SIZE determines the number of bytes used to store links + as offsets within the compiled regex. The default is 2, which allows for + compiled patterns up to 64K long. This covers the vast majority of cases. + However, PCRE can also be compiled to use 3 or 4 bytes instead. This allows + for longer patterns in extreme cases. On systems that support it, + "configure" can be used to override this default. */ +#define LINK_SIZE 2 + +/* The value of MATCH_LIMIT determines the default number of times the + internal match() function can be called during a single execution of + pcre_exec(). There is a runtime interface for setting a different limit. + The limit exists in order to catch runaway regular expressions that take + for ever to determine that they do not match. The default is set very large + so that it does not accidentally catch legitimate cases. On systems that + support it, "configure" can be used to override this default default. */ +#define MATCH_LIMIT 10000000 + +/* The above limit applies to all calls of match(), whether or not they + increase the recursion depth. In some environments it is desirable to limit + the depth of recursive calls of match() more strictly, in order to restrict + the maximum amount of stack (or heap, if NO_RECURSE is defined) that is + used. The value of MATCH_LIMIT_RECURSION applies only to recursive calls of + match(). To have any useful effect, it must be less than the value of + MATCH_LIMIT. The default is to use the same value as MATCH_LIMIT. There is + a runtime method for setting a different limit. On systems that support it, + "configure" can be used to override the default. */ +#define MATCH_LIMIT_RECURSION MATCH_LIMIT + +/* This limit is parameterized just in case anybody ever wants to change it. + Care must be taken if it is increased, because it guards against integer + overflow caused by enormously large patterns. */ +#define MAX_NAME_COUNT 10000 + +/* This limit is parameterized just in case anybody ever wants to change it. + Care must be taken if it is increased, because it guards against integer + overflow caused by enormously large patterns. */ +#define MAX_NAME_SIZE 32 + +/* The value of NEWLINE determines the newline character sequence. On systems + that support it, "configure" can be used to override the default, which is + 10. The possible values are 10 (LF), 13 (CR), 3338 (CRLF), -1 (ANY), or -2 + (ANYCRLF). */ +#define NEWLINE 10 + +/* PCRE uses recursive function calls to handle backtracking while matching. + This can sometimes be a problem on systems that have stacks of limited + size. Define NO_RECURSE to get a version that doesn't use recursion in the + match() function; instead it creates its own stack by steam using + pcre_recurse_malloc() to obtain memory from the heap. For more detail, see + the comments and other stuff just above the match() function. On systems + that support it, "configure" can be used to set this in the Makefile (use + --disable-stack-for-recursion). */ +#define NO_RECURSE + +/* Define if linking statically (TODO: make nice with Libtool) */ +#define PCRE_STATIC 1 + +/* When calling PCRE via the POSIX interface, additional working storage is + required for holding the pointers to capturing substrings because PCRE + requires three integers per substring, whereas the POSIX interface provides + only two. If the number of expected substrings is small, the wrapper + function uses space on the stack, because this is faster than using + malloc() for each call. The threshold above which the stack is no longer + used is defined by POSIX_MALLOC_THRESHOLD. On systems that support it, + "configure" can be used to override this default. */ +#define POSIX_MALLOC_THRESHOLD 10 + +/* Define to 1 if you have the ANSI C header files. */ +#define STDC_HEADERS 1 + +/* Define to enable support for Unicode properties */ +#define SUPPORT_UCP + +/* Define to enable support for the UTF-8 Unicode encoding. */ +#define SUPPORT_UTF8 + +/* Version number of package */ +#define VERSION "7.6" diff --git a/erts/emulator/pcre/make_latin1_table.c b/erts/emulator/pcre/make_latin1_table.c new file mode 100644 index 0000000000..cec4524d18 --- /dev/null +++ b/erts/emulator/pcre/make_latin1_table.c @@ -0,0 +1,201 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + +/* %ExternalCopyright% */ + +/* This is a freestanding support program to generate a file containing +character tables for PCRE. The tables are built according to the current +locale. Now that pcre_maketables is a function visible to the outside world, we +make use of its code from here in order to be consistent. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include +#include +#include +#include + +#include "pcre_internal.h" + +extern const unsigned char *pcre_make_latin1_tables(void); + +static int my_isprint(int x) { + if (x < 160) + return isprint(x); + else + return 1; +} + + +int main(int argc, char **argv) +{ +FILE *f; +int i = 1; +const unsigned char *tables; +const unsigned char *base_of_tables; + +/* By default, the default C locale is used rather than what the building user +happens to have set. However, if the -L option is given, set the locale from +the LC_xxx environment variables. */ +setlocale(LC_ALL, "C"); + +if (argc < i + 1) + { + fprintf(stderr, "make_latin1_table: one filename argument is required\n"); + return 1; + } + +tables = pcre_make_latin1_tables(); +base_of_tables = tables; + +f = fopen(argv[i], "wb"); +if (f == NULL) + { + fprintf(stderr, "make_latin1_table: failed to open %s for writing\n", argv[1]); + return 1; + } + +/* There are several fprintf() calls here, because gcc in pedantic mode +complains about the very long string otherwise. */ + +fprintf(f, + "/*************************************************\n" + "* Perl-Compatible Regular Expressions *\n" + "*************************************************/\n\n" + "/* This file was automatically written by the make_latin1_table auxiliary\n" + "program. It contains character tables that are used when no external\n" + "tables are passed to PCRE by the application that calls it. The tables\n" + "are used only for characters whose code values are less than 256.\n\n"); +fprintf(f, + "The following #includes are present because without them gcc 4.x may remove\n" + "the array definition from the final binary if PCRE is built into a static\n" + "library and dead code stripping is activated. This leads to link errors.\n" + "Pulling in the header ensures that the array gets flagged as \"someone\n" + "outside this compilation unit might reference this\" and so it will always\n" + "be supplied to the linker. */\n\n" + "#ifdef HAVE_CONFIG_H\n" + "#include \"config.h\"\n" + "#endif\n\n" + "#include \"pcre_internal.h\"\n\n"); +fprintf(f, + "const unsigned char _erts_pcre_default_tables[] = {\n\n" + "/* This table is a lower casing table. */\n\n"); + +fprintf(f, " "); +for (i = 0; i < 256; i++) + { + if ((i & 7) == 0 && i != 0) fprintf(f, "\n "); + fprintf(f, "%3d", *tables++); + if (i != 255) fprintf(f, ","); + } +fprintf(f, ",\n\n"); + +fprintf(f, "/* This table is a case flipping table. */\n\n"); + +fprintf(f, " "); +for (i = 0; i < 256; i++) + { + if ((i & 7) == 0 && i != 0) fprintf(f, "\n "); + fprintf(f, "%3d", *tables++); + if (i != 255) fprintf(f, ","); + } +fprintf(f, ",\n\n"); + +fprintf(f, + "/* This table contains bit maps for various character classes.\n" + "Each map is 32 bytes long and the bits run from the least\n" + "significant end of each byte. The classes that have their own\n" + "maps are: space, xdigit, digit, upper, lower, word, graph\n" + "print, punct, and cntrl. Other classes are built from combinations. */\n\n"); + +fprintf(f, " "); +for (i = 0; i < cbit_length; i++) + { + if ((i & 7) == 0 && i != 0) + { + if ((i & 31) == 0) fprintf(f, "\n"); + fprintf(f, "\n "); + } + fprintf(f, "0x%02x", *tables++); + if (i != cbit_length - 1) fprintf(f, ","); + } +fprintf(f, ",\n\n"); + +fprintf(f, + "/* This table identifies various classes of character by individual bits:\n" + " 0x%02x white space character\n" + " 0x%02x letter\n" + " 0x%02x decimal digit\n" + " 0x%02x hexadecimal digit\n" + " 0x%02x alphanumeric or '_'\n" + " 0x%02x regular expression metacharacter or binary zero\n*/\n\n", + ctype_space, ctype_letter, ctype_digit, ctype_xdigit, ctype_word, + ctype_meta); + +fprintf(f, " "); +for (i = 0; i < 256; i++) + { + if ((i & 7) == 0 && i != 0) + { + fprintf(f, " /* "); + if (my_isprint(i-8)) fprintf(f, " %c -", i-8); + else fprintf(f, "%3d-", i-8); + if (my_isprint(i-1)) fprintf(f, " %c ", i-1); + else fprintf(f, "%3d", i-1); + fprintf(f, " */\n "); + } + fprintf(f, "0x%02x", *tables++); + if (i != 255) fprintf(f, ","); + } + +fprintf(f, "};/* "); +if (my_isprint(i-8)) fprintf(f, " %c -", i-8); + else fprintf(f, "%3d-", i-8); +if (my_isprint(i-1)) fprintf(f, " %c ", i-1); + else fprintf(f, "%3d", i-1); +fprintf(f, " */\n\n/* End of pcre_chartables.c */\n"); + +fclose(f); +free((void *)base_of_tables); +return 0; +} + +/* End of make_latin1_table.c */ diff --git a/erts/emulator/pcre/pcre-7.6.tar.bz2 b/erts/emulator/pcre/pcre-7.6.tar.bz2 new file mode 100644 index 0000000000..66b11115fc Binary files /dev/null and b/erts/emulator/pcre/pcre-7.6.tar.bz2 differ diff --git a/erts/emulator/pcre/pcre.h b/erts/emulator/pcre/pcre.h new file mode 100644 index 0000000000..1701bd112b --- /dev/null +++ b/erts/emulator/pcre/pcre.h @@ -0,0 +1,319 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* This is the public header file for the PCRE library, to be #included by +applications that call the PCRE functions. + + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + +/* %ExternalCopyright% */ +#ifndef _PCRE_H +#define _PCRE_H + +/* The current PCRE version information. */ + +#define PCRE_MAJOR 7 +#define PCRE_MINOR 6 +#define PCRE_PRERELEASE +#define PCRE_DATE 2008-01-28 + +/* When an application links to a PCRE DLL in Windows, the symbols that are +imported have to be identified as such. When building PCRE, the appropriate +export setting is defined in pcre_internal.h, which includes this file. So we +don't change existing definitions of PCRE_EXP_DECL and PCRECPP_EXP_DECL. */ + +#if defined(_WIN32) && !defined(PCRE_STATIC) +# ifndef PCRE_EXP_DECL +# define PCRE_EXP_DECL extern __declspec(dllimport) +# endif +# ifdef __cplusplus +# ifndef PCRECPP_EXP_DECL +# define PCRECPP_EXP_DECL extern __declspec(dllimport) +# endif +# ifndef PCRECPP_EXP_DEFN +# define PCRECPP_EXP_DEFN __declspec(dllimport) +# endif +# endif +#endif + +/* By default, we use the standard "extern" declarations. */ + +#ifndef PCRE_EXP_DECL +# ifdef __cplusplus +# define PCRE_EXP_DECL extern "C" +# else +# define PCRE_EXP_DECL extern +# endif +#endif + +#ifdef __cplusplus +# ifndef PCRECPP_EXP_DECL +# define PCRECPP_EXP_DECL extern +# endif +# ifndef PCRECPP_EXP_DEFN +# define PCRECPP_EXP_DEFN +# endif +#endif + +/* Have to include stdlib.h in order to ensure that size_t is defined; +it is needed here for malloc. */ + +#include + +/* Allow for C++ users */ + +#ifdef __cplusplus +extern "C" { +#endif + +/* Options */ + +#define PCRE_CASELESS 0x00000001 +#define PCRE_MULTILINE 0x00000002 +#define PCRE_DOTALL 0x00000004 +#define PCRE_EXTENDED 0x00000008 +#define PCRE_ANCHORED 0x00000010 +#define PCRE_DOLLAR_ENDONLY 0x00000020 +#define PCRE_EXTRA 0x00000040 +#define PCRE_NOTBOL 0x00000080 +#define PCRE_NOTEOL 0x00000100 +#define PCRE_UNGREEDY 0x00000200 +#define PCRE_NOTEMPTY 0x00000400 +#define PCRE_UTF8 0x00000800 +#define PCRE_NO_AUTO_CAPTURE 0x00001000 +#define PCRE_NO_UTF8_CHECK 0x00002000 +#define PCRE_AUTO_CALLOUT 0x00004000 +#define PCRE_PARTIAL 0x00008000 +#define PCRE_DFA_SHORTEST 0x00010000 +#define PCRE_DFA_RESTART 0x00020000 +#define PCRE_FIRSTLINE 0x00040000 +#define PCRE_DUPNAMES 0x00080000 +#define PCRE_NEWLINE_CR 0x00100000 +#define PCRE_NEWLINE_LF 0x00200000 +#define PCRE_NEWLINE_CRLF 0x00300000 +#define PCRE_NEWLINE_ANY 0x00400000 +#define PCRE_NEWLINE_ANYCRLF 0x00500000 +#define PCRE_BSR_ANYCRLF 0x00800000 +#define PCRE_BSR_UNICODE 0x01000000 + +/* Exec-time and get/set-time error codes */ + +#define PCRE_ERROR_NOMATCH (-1) +#define PCRE_ERROR_NULL (-2) +#define PCRE_ERROR_BADOPTION (-3) +#define PCRE_ERROR_BADMAGIC (-4) +#define PCRE_ERROR_UNKNOWN_OPCODE (-5) +#define PCRE_ERROR_UNKNOWN_NODE (-5) /* For backward compatibility */ +#define PCRE_ERROR_NOMEMORY (-6) +#define PCRE_ERROR_NOSUBSTRING (-7) +#define PCRE_ERROR_MATCHLIMIT (-8) +#define PCRE_ERROR_CALLOUT (-9) /* Never used by PCRE itself */ +#define PCRE_ERROR_BADUTF8 (-10) +#define PCRE_ERROR_BADUTF8_OFFSET (-11) +#define PCRE_ERROR_PARTIAL (-12) +#define PCRE_ERROR_BADPARTIAL (-13) +#define PCRE_ERROR_INTERNAL (-14) +#define PCRE_ERROR_BADCOUNT (-15) +#define PCRE_ERROR_DFA_UITEM (-16) +#define PCRE_ERROR_DFA_UCOND (-17) +#define PCRE_ERROR_DFA_UMLIMIT (-18) +#define PCRE_ERROR_DFA_WSSIZE (-19) +#define PCRE_ERROR_DFA_RECURSE (-20) +#define PCRE_ERROR_RECURSIONLIMIT (-21) +#define PCRE_ERROR_NULLWSLIMIT (-22) /* No longer actually used */ +#define PCRE_ERROR_BADNEWLINE (-23) +#ifdef ERLANG_INTEGRATION +#define PCRE_ERROR_LOOP_LIMIT (-24) +#endif + +/* Request types for pcre_fullinfo() */ + +#define PCRE_INFO_OPTIONS 0 +#define PCRE_INFO_SIZE 1 +#define PCRE_INFO_CAPTURECOUNT 2 +#define PCRE_INFO_BACKREFMAX 3 +#define PCRE_INFO_FIRSTBYTE 4 +#define PCRE_INFO_FIRSTCHAR 4 /* For backwards compatibility */ +#define PCRE_INFO_FIRSTTABLE 5 +#define PCRE_INFO_LASTLITERAL 6 +#define PCRE_INFO_NAMEENTRYSIZE 7 +#define PCRE_INFO_NAMECOUNT 8 +#define PCRE_INFO_NAMETABLE 9 +#define PCRE_INFO_STUDYSIZE 10 +#define PCRE_INFO_DEFAULT_TABLES 11 +#define PCRE_INFO_OKPARTIAL 12 +#define PCRE_INFO_JCHANGED 13 +#define PCRE_INFO_HASCRORLF 14 + +/* Request types for erts_pcre_config(). Do not re-arrange, in order to remain +compatible. */ + +#define PCRE_CONFIG_UTF8 0 +#define PCRE_CONFIG_NEWLINE 1 +#define PCRE_CONFIG_LINK_SIZE 2 +#define PCRE_CONFIG_POSIX_MALLOC_THRESHOLD 3 +#define PCRE_CONFIG_MATCH_LIMIT 4 +#define PCRE_CONFIG_STACKRECURSE 5 +#define PCRE_CONFIG_UNICODE_PROPERTIES 6 +#define PCRE_CONFIG_MATCH_LIMIT_RECURSION 7 +#define PCRE_CONFIG_BSR 8 + +/* Bit flags for the pcre_extra structure. Do not re-arrange or redefine +these bits, just add new ones on the end, in order to remain compatible. */ + +#define PCRE_EXTRA_STUDY_DATA 0x0001 +#define PCRE_EXTRA_MATCH_LIMIT 0x0002 +#define PCRE_EXTRA_CALLOUT_DATA 0x0004 +#define PCRE_EXTRA_TABLES 0x0008 +#define PCRE_EXTRA_MATCH_LIMIT_RECURSION 0x0010 +#ifdef ERLANG_INTEGRATION +#define PCRE_EXTRA_LOOP_LIMIT 0x0020 +#endif + +/* Types */ + +struct real_pcre; /* declaration; the definition is private */ +typedef struct real_pcre pcre; + +/* When PCRE is compiled as a C++ library, the subject pointer type can be +replaced with a custom type. For conventional use, the public interface is a +const char *. */ + +#ifndef PCRE_SPTR +#define PCRE_SPTR const char * +#endif + +/* The structure for passing additional data to pcre_exec(). This is defined in +such as way as to be extensible. Always add new fields at the end, in order to +remain compatible. */ + +typedef struct pcre_extra { + unsigned long int flags; /* Bits for which fields are set */ + void *study_data; /* Opaque data from pcre_study() */ + unsigned long int match_limit; /* Maximum number of calls to match() */ + void *callout_data; /* Data passed back in callouts */ + const unsigned char *tables; /* Pointer to character tables */ + unsigned long int match_limit_recursion; /* Max recursive calls to match() */ +#ifdef ERLANG_INTEGRATION + unsigned long int loop_limit; + unsigned long *loop_counter_return; + void **restart_data; /* in/out */ + int restart_flags; +#endif +} pcre_extra; + +/* The structure for passing out data via the pcre_callout_function. We use a +structure so that new fields can be added on the end in future versions, +without changing the API of the function, thereby allowing old clients to work +without modification. */ + +typedef struct pcre_callout_block { + int version; /* Identifies version of block */ + /* ------------------------ Version 0 ------------------------------- */ + int callout_number; /* Number compiled into pattern */ + int *offset_vector; /* The offset vector */ + PCRE_SPTR subject; /* The subject being matched */ + int subject_length; /* The length of the subject */ + int start_match; /* Offset to start of this match attempt */ + int current_position; /* Where we currently are in the subject */ + int capture_top; /* Max current capture */ + int capture_last; /* Most recently closed capture */ + void *callout_data; /* Data passed in with the call */ + /* ------------------- Added for Version 1 -------------------------- */ + int pattern_position; /* Offset to next item in the pattern */ + int next_item_length; /* Length of next item in the pattern */ + /* ------------------------------------------------------------------ */ +} pcre_callout_block; + +/* Indirection for store get and free functions. These can be set to +alternative malloc/free functions if required. Special ones are used in the +non-recursive case for "frames". There is also an optional callout function +that is triggered by the (?) regex item. For Virtual Pascal, these definitions +have to take another form. */ + +#ifndef VPCOMPAT +PCRE_EXP_DECL void *(*erts_pcre_malloc)(size_t); +PCRE_EXP_DECL void (*erts_pcre_free)(void *); +PCRE_EXP_DECL void *(*erts_pcre_stack_malloc)(size_t); +PCRE_EXP_DECL void (*erts_pcre_stack_free)(void *); +PCRE_EXP_DECL int (*erts_pcre_callout)(pcre_callout_block *); +#else /* VPCOMPAT */ +PCRE_EXP_DECL void *erts_pcre_malloc(size_t); +PCRE_EXP_DECL void erts_pcre_free(void *); +PCRE_EXP_DECL void *erts_pcre_stack_malloc(size_t); +PCRE_EXP_DECL void erts_pcre_stack_free(void *); +PCRE_EXP_DECL int erts_pcre_callout(pcre_callout_block *); +#endif /* VPCOMPAT */ + +/* Exported PCRE functions */ + +PCRE_EXP_DECL pcre *erts_pcre_compile(const char *, int, const char **, int *, + const unsigned char *); +PCRE_EXP_DECL pcre *erts_pcre_compile2(const char *, int, int *, const char **, + int *, const unsigned char *); +PCRE_EXP_DECL int erts_pcre_config(int, void *); +PCRE_EXP_DECL int erts_pcre_copy_named_substring(const pcre *, const char *, + int *, int, const char *, char *, int); +PCRE_EXP_DECL int erts_pcre_copy_substring(const char *, int *, int, int, char *, + int); +PCRE_EXP_DECL int erts_pcre_dfa_exec(const pcre *, const pcre_extra *, + const char *, int, int, int, int *, int , int *, int); +PCRE_EXP_DECL int erts_pcre_exec(const pcre *, const pcre_extra *, PCRE_SPTR, + int, int, int, int *, int); +PCRE_EXP_DECL void erts_pcre_free_substring(const char *); +PCRE_EXP_DECL void erts_pcre_free_substring_list(const char **); +PCRE_EXP_DECL int erts_pcre_fullinfo(const pcre *, const pcre_extra *, int, + void *); +PCRE_EXP_DECL int erts_pcre_get_named_substring(const pcre *, const char *, + int *, int, const char *, const char **); +PCRE_EXP_DECL int erts_pcre_get_stringnumber(const pcre *, const char *); +PCRE_EXP_DECL int erts_pcre_get_stringtable_entries(const pcre *, const char *, + char **, char **); +PCRE_EXP_DECL int erts_pcre_get_substring(const char *, int *, int, int, + const char **); +PCRE_EXP_DECL int erts_pcre_get_substring_list(const char *, int *, int, + const char ***); +PCRE_EXP_DECL int erts_pcre_info(const pcre *, int *, int *); +PCRE_EXP_DECL const unsigned char *erts_pcre_maketables(void); +PCRE_EXP_DECL int erts_pcre_refcount(pcre *, int); +PCRE_EXP_DECL pcre_extra *erts_pcre_study(const pcre *, int, const char **); +PCRE_EXP_DECL const char *erts_pcre_version(void); + +#ifdef ERLANG_INTEGRATION +PCRE_EXP_DECL void erts_pcre_free_restart_data(void *restart_data); +#endif +#ifdef __cplusplus +} /* extern "C" */ +#endif + +#endif /* End of pcre.h */ diff --git a/erts/emulator/pcre/pcre_chartables.c b/erts/emulator/pcre/pcre_chartables.c new file mode 100644 index 0000000000..f851b1b261 --- /dev/null +++ b/erts/emulator/pcre/pcre_chartables.c @@ -0,0 +1,199 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* This file contains character tables that are used when no external tables +are passed to PCRE by the application that calls it. The tables are used only +for characters whose code values are less than 256. + +This is a default version of the tables that assumes ASCII encoding. A program +called dftables (which is distributed with PCRE) can be used to build +alternative versions of this file. This is necessary if you are running in an +EBCDIC environment, or if you want to default to a different encoding, for +example ISO-8859-1. When dftables is run, it creates these tables in the +current locale. If PCRE is configured with --enable-rebuild-chartables, this +happens automatically. + +The following #includes are present because without the gcc 4.x may remove the +array definition from the final binary if PCRE is built into a static library +and dead code stripping is activated. This leads to link errors. Pulling in the +header ensures that the array gets flagged as "someone outside this compilation +unit might reference this" and so it will always be supplied to the linker. */ + +/* %ExternalCopyright% */ +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + +const unsigned char _erts_pcre_default_tables[] = { + +/* This table is a lower casing table. */ + + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 97, 98, 99,100,101,102,103, + 104,105,106,107,108,109,110,111, + 112,113,114,115,116,117,118,119, + 120,121,122, 91, 92, 93, 94, 95, + 96, 97, 98, 99,100,101,102,103, + 104,105,106,107,108,109,110,111, + 112,113,114,115,116,117,118,119, + 120,121,122,123,124,125,126,127, + 128,129,130,131,132,133,134,135, + 136,137,138,139,140,141,142,143, + 144,145,146,147,148,149,150,151, + 152,153,154,155,156,157,158,159, + 160,161,162,163,164,165,166,167, + 168,169,170,171,172,173,174,175, + 176,177,178,179,180,181,182,183, + 184,185,186,187,188,189,190,191, + 192,193,194,195,196,197,198,199, + 200,201,202,203,204,205,206,207, + 208,209,210,211,212,213,214,215, + 216,217,218,219,220,221,222,223, + 224,225,226,227,228,229,230,231, + 232,233,234,235,236,237,238,239, + 240,241,242,243,244,245,246,247, + 248,249,250,251,252,253,254,255, + +/* This table is a case flipping table. */ + + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 97, 98, 99,100,101,102,103, + 104,105,106,107,108,109,110,111, + 112,113,114,115,116,117,118,119, + 120,121,122, 91, 92, 93, 94, 95, + 96, 65, 66, 67, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90,123,124,125,126,127, + 128,129,130,131,132,133,134,135, + 136,137,138,139,140,141,142,143, + 144,145,146,147,148,149,150,151, + 152,153,154,155,156,157,158,159, + 160,161,162,163,164,165,166,167, + 168,169,170,171,172,173,174,175, + 176,177,178,179,180,181,182,183, + 184,185,186,187,188,189,190,191, + 192,193,194,195,196,197,198,199, + 200,201,202,203,204,205,206,207, + 208,209,210,211,212,213,214,215, + 216,217,218,219,220,221,222,223, + 224,225,226,227,228,229,230,231, + 232,233,234,235,236,237,238,239, + 240,241,242,243,244,245,246,247, + 248,249,250,251,252,253,254,255, + +/* This table contains bit maps for various character classes. Each map is 32 +bytes long and the bits run from the least significant end of each byte. The +classes that have their own maps are: space, xdigit, digit, upper, lower, word, +graph, print, punct, and cntrl. Other classes are built from combinations. */ + + 0x00,0x3e,0x00,0x00,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x03, + 0x7e,0x00,0x00,0x00,0x7e,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x03, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x03, + 0xfe,0xff,0xff,0x87,0xfe,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0xfe,0xff,0x00,0xfc, + 0x01,0x00,0x00,0xf8,0x01,0x00,0x00,0x78, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + +/* This table identifies various classes of character by individual bits: + 0x01 white space character + 0x02 letter + 0x04 decimal digit + 0x08 hexadecimal digit + 0x10 alphanumeric or '_' + 0x80 regular expression metacharacter or binary zero +*/ + + 0x80,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0- 7 */ + 0x00,0x01,0x01,0x00,0x01,0x01,0x00,0x00, /* 8- 15 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 16- 23 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 24- 31 */ + 0x01,0x00,0x00,0x00,0x80,0x00,0x00,0x00, /* - ' */ + 0x80,0x80,0x80,0x80,0x00,0x00,0x80,0x00, /* ( - / */ + 0x1c,0x1c,0x1c,0x1c,0x1c,0x1c,0x1c,0x1c, /* 0 - 7 */ + 0x1c,0x1c,0x00,0x00,0x00,0x00,0x00,0x80, /* 8 - ? */ + 0x00,0x1a,0x1a,0x1a,0x1a,0x1a,0x1a,0x12, /* @ - G */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* H - O */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* P - W */ + 0x12,0x12,0x12,0x80,0x80,0x00,0x80,0x10, /* X - _ */ + 0x00,0x1a,0x1a,0x1a,0x1a,0x1a,0x1a,0x12, /* ` - g */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* h - o */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* p - w */ + 0x12,0x12,0x12,0x80,0x80,0x00,0x00,0x00, /* x -127 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 128-135 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 136-143 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 144-151 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 152-159 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 160-167 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 168-175 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 176-183 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 184-191 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 192-199 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 200-207 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 208-215 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 216-223 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 224-231 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 232-239 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 240-247 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00};/* 248-255 */ + +/* End of pcre_chartables.c */ diff --git a/erts/emulator/pcre/pcre_compile.c b/erts/emulator/pcre/pcre_compile.c new file mode 100644 index 0000000000..235617fc06 --- /dev/null +++ b/erts/emulator/pcre/pcre_compile.c @@ -0,0 +1,6221 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_compile(), along with +supporting internal functions that are not used by other modules. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#define NLBLOCK cd /* Block containing newline information */ +#define PSSTART start_pattern /* Field containing processed string start */ +#define PSEND end_pattern /* Field containing processed string end */ + +#include "pcre_internal.h" + + +/* When DEBUG is defined, we need the pcre_printint() function, which is also +used by pcretest. DEBUG is not defined when building a production library. */ + +#ifdef DEBUG +#include "pcre_printint.src" +#endif + + +/* Macro for setting individual bits in class bitmaps. */ + +#define SETBIT(a,b) a[b/8] |= (1 << (b%8)) + +/* Maximum length value to check against when making sure that the integer that +holds the compiled pattern length does not overflow. We make it a bit less than +INT_MAX to allow for adding in group terminating bytes, so that we don't have +to check them every time. */ + +#define OFLOW_MAX (INT_MAX - 20) + + +/************************************************* +* Code parameters and static tables * +*************************************************/ + +/* This value specifies the size of stack workspace that is used during the +first pre-compile phase that determines how much memory is required. The regex +is partly compiled into this space, but the compiled parts are discarded as +soon as they can be, so that hopefully there will never be an overrun. The code +does, however, check for an overrun. The largest amount I've seen used is 218, +so this number is very generous. + +The same workspace is used during the second, actual compile phase for +remembering forward references to groups so that they can be filled in at the +end. Each entry in this list occupies LINK_SIZE bytes, so even when LINK_SIZE +is 4 there is plenty of room. */ + +#define COMPILE_WORK_SIZE (4096) + + +/* Table for handling escaped characters in the range '0'-'z'. Positive returns +are simple data values; negative values are for special things like \d and so +on. Zero means further processing is needed (for things like \x), or the escape +is invalid. */ + +#ifndef EBCDIC /* This is the "normal" table for ASCII systems */ +static const short int escapes[] = { + 0, 0, 0, 0, 0, 0, 0, 0, /* 0 - 7 */ + 0, 0, ':', ';', '<', '=', '>', '?', /* 8 - ? */ + '@', -ESC_A, -ESC_B, -ESC_C, -ESC_D, -ESC_E, 0, -ESC_G, /* @ - G */ +-ESC_H, 0, 0, -ESC_K, 0, 0, 0, 0, /* H - O */ +-ESC_P, -ESC_Q, -ESC_R, -ESC_S, 0, 0, -ESC_V, -ESC_W, /* P - W */ +-ESC_X, 0, -ESC_Z, '[', '\\', ']', '^', '_', /* X - _ */ + '`', 7, -ESC_b, 0, -ESC_d, ESC_e, ESC_f, 0, /* ` - g */ +-ESC_h, 0, 0, -ESC_k, 0, 0, ESC_n, 0, /* h - o */ +-ESC_p, 0, ESC_r, -ESC_s, ESC_tee, 0, -ESC_v, -ESC_w, /* p - w */ + 0, 0, -ESC_z /* x - z */ +}; + +#else /* This is the "abnormal" table for EBCDIC systems */ +static const short int escapes[] = { +/* 48 */ 0, 0, 0, '.', '<', '(', '+', '|', +/* 50 */ '&', 0, 0, 0, 0, 0, 0, 0, +/* 58 */ 0, 0, '!', '$', '*', ')', ';', '~', +/* 60 */ '-', '/', 0, 0, 0, 0, 0, 0, +/* 68 */ 0, 0, '|', ',', '%', '_', '>', '?', +/* 70 */ 0, 0, 0, 0, 0, 0, 0, 0, +/* 78 */ 0, '`', ':', '#', '@', '\'', '=', '"', +/* 80 */ 0, 7, -ESC_b, 0, -ESC_d, ESC_e, ESC_f, 0, +/* 88 */-ESC_h, 0, 0, '{', 0, 0, 0, 0, +/* 90 */ 0, 0, -ESC_k, 'l', 0, ESC_n, 0, -ESC_p, +/* 98 */ 0, ESC_r, 0, '}', 0, 0, 0, 0, +/* A0 */ 0, '~', -ESC_s, ESC_tee, 0,-ESC_v, -ESC_w, 0, +/* A8 */ 0,-ESC_z, 0, 0, 0, '[', 0, 0, +/* B0 */ 0, 0, 0, 0, 0, 0, 0, 0, +/* B8 */ 0, 0, 0, 0, 0, ']', '=', '-', +/* C0 */ '{',-ESC_A, -ESC_B, -ESC_C, -ESC_D,-ESC_E, 0, -ESC_G, +/* C8 */-ESC_H, 0, 0, 0, 0, 0, 0, 0, +/* D0 */ '}', 0, -ESC_K, 0, 0, 0, 0, -ESC_P, +/* D8 */-ESC_Q,-ESC_R, 0, 0, 0, 0, 0, 0, +/* E0 */ '\\', 0, -ESC_S, 0, 0,-ESC_V, -ESC_W, -ESC_X, +/* E8 */ 0,-ESC_Z, 0, 0, 0, 0, 0, 0, +/* F0 */ 0, 0, 0, 0, 0, 0, 0, 0, +/* F8 */ 0, 0, 0, 0, 0, 0, 0, 0 +}; +#endif + + +/* Table of special "verbs" like (*PRUNE). This is a short table, so it is +searched linearly. Put all the names into a single string, in order to reduce +the number of relocations when a shared library is dynamically linked. */ + +typedef struct verbitem { + int len; + int op; +} verbitem; + +static const char verbnames[] = + "ACCEPT\0" + "COMMIT\0" + "F\0" + "FAIL\0" + "PRUNE\0" + "SKIP\0" + "THEN"; + +static verbitem verbs[] = { + { 6, OP_ACCEPT }, + { 6, OP_COMMIT }, + { 1, OP_FAIL }, + { 4, OP_FAIL }, + { 5, OP_PRUNE }, + { 4, OP_SKIP }, + { 4, OP_THEN } +}; + +static int verbcount = sizeof(verbs)/sizeof(verbitem); + + +/* Tables of names of POSIX character classes and their lengths. The names are +now all in a single string, to reduce the number of relocations when a shared +library is dynamically loaded. The list of lengths is terminated by a zero +length entry. The first three must be alpha, lower, upper, as this is assumed +for handling case independence. */ + +static const char posix_names[] = + "alpha\0" "lower\0" "upper\0" "alnum\0" "ascii\0" "blank\0" + "cntrl\0" "digit\0" "graph\0" "print\0" "punct\0" "space\0" + "word\0" "xdigit"; + +static const uschar posix_name_lengths[] = { + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 4, 6, 0 }; + +/* Table of class bit maps for each POSIX class. Each class is formed from a +base map, with an optional addition or removal of another map. Then, for some +classes, there is some additional tweaking: for [:blank:] the vertical space +characters are removed, and for [:alpha:] and [:alnum:] the underscore +character is removed. The triples in the table consist of the base map offset, +second map offset or -1 if no second map, and a non-negative value for map +addition or a negative value for map subtraction (if there are two maps). The +absolute value of the third field has these meanings: 0 => no tweaking, 1 => +remove vertical space characters, 2 => remove underscore. */ + +static const int posix_class_maps[] = { + cbit_word, cbit_digit, -2, /* alpha */ + cbit_lower, -1, 0, /* lower */ + cbit_upper, -1, 0, /* upper */ + cbit_word, -1, 2, /* alnum - word without underscore */ + cbit_print, cbit_cntrl, 0, /* ascii */ + cbit_space, -1, 1, /* blank - a GNU extension */ + cbit_cntrl, -1, 0, /* cntrl */ + cbit_digit, -1, 0, /* digit */ + cbit_graph, -1, 0, /* graph */ + cbit_print, -1, 0, /* print */ + cbit_punct, -1, 0, /* punct */ + cbit_space, -1, 0, /* space */ + cbit_word, -1, 0, /* word - a Perl extension */ + cbit_xdigit,-1, 0 /* xdigit */ +}; + + +#define STRING(a) # a +#define XSTRING(s) STRING(s) + +/* The texts of compile-time error messages. These are "char *" because they +are passed to the outside world. Do not ever re-use any error number, because +they are documented. Always add a new error instead. Messages marked DEAD below +are no longer used. This used to be a table of strings, but in order to reduce +the number of relocations needed when a shared library is loaded dynamically, +it is now one long string. We cannot use a table of offsets, because the +lengths of inserts such as XSTRING(MAX_NAME_SIZE) are not known. Instead, we +simply count through to the one we want - this isn't a performance issue +because these strings are used only when there is a compilation error. */ + +static const char error_texts[] = + "no error\0" + "\\ at end of pattern\0" + "\\c at end of pattern\0" + "unrecognized character follows \\\0" + "numbers out of order in {} quantifier\0" + /* 5 */ + "number too big in {} quantifier\0" + "missing terminating ] for character class\0" + "invalid escape sequence in character class\0" + "range out of order in character class\0" + "nothing to repeat\0" + /* 10 */ + "operand of unlimited repeat could match the empty string\0" /** DEAD **/ + "internal error: unexpected repeat\0" + "unrecognized character after (? or (?-\0" + "POSIX named classes are supported only within a class\0" + "missing )\0" + /* 15 */ + "reference to non-existent subpattern\0" + "erroffset passed as NULL\0" + "unknown option bit(s) set\0" + "missing ) after comment\0" + "parentheses nested too deeply\0" /** DEAD **/ + /* 20 */ + "regular expression is too large\0" + "failed to get memory\0" + "unmatched parentheses\0" + "internal error: code overflow\0" + "unrecognized character after (?<\0" + /* 25 */ + "lookbehind assertion is not fixed length\0" + "malformed number or name after (?(\0" + "conditional group contains more than two branches\0" + "assertion expected after (?(\0" + "(?R or (?[+-]digits must be followed by )\0" + /* 30 */ + "unknown POSIX class name\0" + "POSIX collating elements are not supported\0" + "this version of PCRE is not compiled with PCRE_UTF8 support\0" + "spare error\0" /** DEAD **/ + "character value in \\x{...} sequence is too large\0" + /* 35 */ + "invalid condition (?(0)\0" + "\\C not allowed in lookbehind assertion\0" + "PCRE does not support \\L, \\l, \\N, \\U, or \\u\0" + "number after (?C is > 255\0" + "closing ) for (?C expected\0" + /* 40 */ + "recursive call could loop indefinitely\0" + "unrecognized character after (?P\0" + "syntax error in subpattern name (missing terminator)\0" + "two named subpatterns have the same name\0" + "invalid UTF-8 string\0" + /* 45 */ + "support for \\P, \\p, and \\X has not been compiled\0" + "malformed \\P or \\p sequence\0" + "unknown property name after \\P or \\p\0" + "subpattern name is too long (maximum " XSTRING(MAX_NAME_SIZE) " characters)\0" + "too many named subpatterns (maximum " XSTRING(MAX_NAME_COUNT) ")\0" + /* 50 */ + "repeated subpattern is too long\0" /** DEAD **/ + "octal value is greater than \\377 (not in UTF-8 mode)\0" + "internal error: overran compiling workspace\0" + "internal error: previously-checked referenced subpattern not found\0" + "DEFINE group contains more than one branch\0" + /* 55 */ + "repeating a DEFINE group is not allowed\0" + "inconsistent NEWLINE options\0" + "\\g is not followed by a braced name or an optionally braced non-zero number\0" + "(?+ or (?- or (?(+ or (?(- must be followed by a non-zero number\0" + "(*VERB) with an argument is not supported\0" + /* 60 */ + "(*VERB) not recognized\0" + "number is too big\0" + "subpattern name expected\0" + "digit expected after (?+"; + + +/* Table to identify digits and hex digits. This is used when compiling +patterns. Note that the tables in chartables are dependent on the locale, and +may mark arbitrary characters as digits - but the PCRE compiling code expects +to handle only 0-9, a-z, and A-Z as digits when compiling. That is why we have +a private table here. It costs 256 bytes, but it is a lot faster than doing +character value tests (at least in some simple cases I timed), and in some +applications one wants PCRE to compile efficiently as well as match +efficiently. + +For convenience, we use the same bit definitions as in chartables: + + 0x04 decimal digit + 0x08 hexadecimal digit + +Then we can use ctype_digit and ctype_xdigit in the code. */ + +#ifndef EBCDIC /* This is the "normal" case, for ASCII systems */ +static const unsigned char digitab[] = + { + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0- 7 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 8- 15 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 16- 23 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 24- 31 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* - ' */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* ( - / */ + 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c, /* 0 - 7 */ + 0x0c,0x0c,0x00,0x00,0x00,0x00,0x00,0x00, /* 8 - ? */ + 0x00,0x08,0x08,0x08,0x08,0x08,0x08,0x00, /* @ - G */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* H - O */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* P - W */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* X - _ */ + 0x00,0x08,0x08,0x08,0x08,0x08,0x08,0x00, /* ` - g */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* h - o */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* p - w */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* x -127 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 128-135 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 136-143 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 144-151 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 152-159 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 160-167 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 168-175 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 176-183 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 184-191 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 192-199 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 200-207 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 208-215 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 216-223 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 224-231 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 232-239 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 240-247 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00};/* 248-255 */ + +#else /* This is the "abnormal" case, for EBCDIC systems */ +static const unsigned char digitab[] = + { + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0- 7 0 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 8- 15 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 16- 23 10 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 24- 31 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 32- 39 20 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 40- 47 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 48- 55 30 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 56- 63 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* - 71 40 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 72- | */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* & - 87 50 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 88- 95 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* - -103 60 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 104- ? */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 112-119 70 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 120- " */ + 0x00,0x08,0x08,0x08,0x08,0x08,0x08,0x00, /* 128- g 80 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* h -143 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 144- p 90 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* q -159 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 160- x A0 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* y -175 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* ^ -183 B0 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 184-191 */ + 0x00,0x08,0x08,0x08,0x08,0x08,0x08,0x00, /* { - G C0 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* H -207 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* } - P D0 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* Q -223 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* \ - X E0 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* Y -239 */ + 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c, /* 0 - 7 F0 */ + 0x0c,0x0c,0x00,0x00,0x00,0x00,0x00,0x00};/* 8 -255 */ + +static const unsigned char ebcdic_chartab[] = { /* chartable partial dup */ + 0x80,0x00,0x00,0x00,0x00,0x01,0x00,0x00, /* 0- 7 */ + 0x00,0x00,0x00,0x00,0x01,0x01,0x00,0x00, /* 8- 15 */ + 0x00,0x00,0x00,0x00,0x00,0x01,0x00,0x00, /* 16- 23 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 24- 31 */ + 0x00,0x00,0x00,0x00,0x00,0x01,0x00,0x00, /* 32- 39 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 40- 47 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 48- 55 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 56- 63 */ + 0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* - 71 */ + 0x00,0x00,0x00,0x80,0x00,0x80,0x80,0x80, /* 72- | */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* & - 87 */ + 0x00,0x00,0x00,0x80,0x80,0x80,0x00,0x00, /* 88- 95 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* - -103 */ + 0x00,0x00,0x00,0x00,0x00,0x10,0x00,0x80, /* 104- ? */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 112-119 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 120- " */ + 0x00,0x1a,0x1a,0x1a,0x1a,0x1a,0x1a,0x12, /* 128- g */ + 0x12,0x12,0x00,0x00,0x00,0x00,0x00,0x00, /* h -143 */ + 0x00,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* 144- p */ + 0x12,0x12,0x00,0x00,0x00,0x00,0x00,0x00, /* q -159 */ + 0x00,0x00,0x12,0x12,0x12,0x12,0x12,0x12, /* 160- x */ + 0x12,0x12,0x00,0x00,0x00,0x00,0x00,0x00, /* y -175 */ + 0x80,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* ^ -183 */ + 0x00,0x00,0x80,0x00,0x00,0x00,0x00,0x00, /* 184-191 */ + 0x80,0x1a,0x1a,0x1a,0x1a,0x1a,0x1a,0x12, /* { - G */ + 0x12,0x12,0x00,0x00,0x00,0x00,0x00,0x00, /* H -207 */ + 0x00,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* } - P */ + 0x12,0x12,0x00,0x00,0x00,0x00,0x00,0x00, /* Q -223 */ + 0x00,0x00,0x12,0x12,0x12,0x12,0x12,0x12, /* \ - X */ + 0x12,0x12,0x00,0x00,0x00,0x00,0x00,0x00, /* Y -239 */ + 0x1c,0x1c,0x1c,0x1c,0x1c,0x1c,0x1c,0x1c, /* 0 - 7 */ + 0x1c,0x1c,0x00,0x00,0x00,0x00,0x00,0x00};/* 8 -255 */ +#endif + + +/* Definition to allow mutual recursion */ + +static BOOL + compile_regex(int, int, uschar **, const uschar **, int *, BOOL, BOOL, int, + int *, int *, branch_chain *, compile_data *, int *); + + + +/************************************************* +* Find an error text * +*************************************************/ + +/* The error texts are now all in one long string, to save on relocations. As +some of the text is of unknown length, we can't use a table of offsets. +Instead, just count through the strings. This is not a performance issue +because it happens only when there has been a compilation error. + +Argument: the error number +Returns: pointer to the error string +*/ + +static const char * +find_error_text(int n) +{ +const char *s = error_texts; +for (; n > 0; n--) while (*s++ != 0); +return s; +} + + +/************************************************* +* Handle escapes * +*************************************************/ + +/* This function is called when a \ has been encountered. It either returns a +positive value for a simple escape such as \n, or a negative value which +encodes one of the more complicated things such as \d. A backreference to group +n is returned as -(ESC_REF + n); ESC_REF is the highest ESC_xxx macro. When +UTF-8 is enabled, a positive value greater than 255 may be returned. On entry, +ptr is pointing at the \. On exit, it is on the final character of the escape +sequence. + +Arguments: + ptrptr points to the pattern position pointer + errorcodeptr points to the errorcode variable + bracount number of previous extracting brackets + options the options bits + isclass TRUE if inside a character class + +Returns: zero or positive => a data character + negative => a special escape sequence + on error, errorcodeptr is set +*/ + +static int +check_escape(const uschar **ptrptr, int *errorcodeptr, int bracount, + int options, BOOL isclass) +{ +BOOL utf8 = (options & PCRE_UTF8) != 0; +const uschar *ptr = *ptrptr + 1; +int c, i; + +GETCHARINCTEST(c, ptr); /* Get character value, increment pointer */ +ptr--; /* Set pointer back to the last byte */ + +/* If backslash is at the end of the pattern, it's an error. */ +if (c == 0) *errorcodeptr = ERR1; + +/* Non-alphanumerics are literals. For digits or letters, do an initial lookup +in a table. A non-zero result is something that can be returned immediately. +Otherwise further processing may be required. */ + +#ifndef EBCDIC /* ASCII coding */ +else if (c < '0' || c > 'z') {} /* Not alphanumeric */ +else if ((i = escapes[c - '0']) != 0) c = i; + +#else /* EBCDIC coding */ +else if (c < 'a' || (ebcdic_chartab[c] & 0x0E) == 0) {} /* Not alphanumeric */ +else if ((i = escapes[c - 0x48]) != 0) c = i; +#endif + +/* Escapes that need further processing, or are illegal. */ + +else + { + const uschar *oldptr; + BOOL braced, negated; + + switch (c) + { + /* A number of Perl escapes are not handled by PCRE. We give an explicit + error. */ + + case 'l': + case 'L': + case 'N': + case 'u': + case 'U': + *errorcodeptr = ERR37; + break; + + /* \g must be followed by a number, either plain or braced. If positive, it + is an absolute backreference. If negative, it is a relative backreference. + This is a Perl 5.10 feature. Perl 5.10 also supports \g{name} as a + reference to a named group. This is part of Perl's movement towards a + unified syntax for back references. As this is synonymous with \k{name}, we + fudge it up by pretending it really was \k. */ + + case 'g': + if (ptr[1] == '{') + { + const uschar *p; + for (p = ptr+2; *p != 0 && *p != '}'; p++) + if (*p != '-' && (digitab[*p] & ctype_digit) == 0) break; + if (*p != 0 && *p != '}') + { + c = -ESC_k; + break; + } + braced = TRUE; + ptr++; + } + else braced = FALSE; + + if (ptr[1] == '-') + { + negated = TRUE; + ptr++; + } + else negated = FALSE; + + c = 0; + while ((digitab[ptr[1]] & ctype_digit) != 0) + c = c * 10 + *(++ptr) - '0'; + + if (c < 0) + { + *errorcodeptr = ERR61; + break; + } + + if (c == 0 || (braced && *(++ptr) != '}')) + { + *errorcodeptr = ERR57; + break; + } + + if (negated) + { + if (c > bracount) + { + *errorcodeptr = ERR15; + break; + } + c = bracount - (c - 1); + } + + c = -(ESC_REF + c); + break; + + /* The handling of escape sequences consisting of a string of digits + starting with one that is not zero is not straightforward. By experiment, + the way Perl works seems to be as follows: + + Outside a character class, the digits are read as a decimal number. If the + number is less than 10, or if there are that many previous extracting + left brackets, then it is a back reference. Otherwise, up to three octal + digits are read to form an escaped byte. Thus \123 is likely to be octal + 123 (cf \0123, which is octal 012 followed by the literal 3). If the octal + value is greater than 377, the least significant 8 bits are taken. Inside a + character class, \ followed by a digit is always an octal number. */ + + case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': + + if (!isclass) + { + oldptr = ptr; + c -= '0'; + while ((digitab[ptr[1]] & ctype_digit) != 0) + c = c * 10 + *(++ptr) - '0'; + if (c < 0) + { + *errorcodeptr = ERR61; + break; + } + if (c < 10 || c <= bracount) + { + c = -(ESC_REF + c); + break; + } + ptr = oldptr; /* Put the pointer back and fall through */ + } + + /* Handle an octal number following \. If the first digit is 8 or 9, Perl + generates a binary zero byte and treats the digit as a following literal. + Thus we have to pull back the pointer by one. */ + + if ((c = *ptr) >= '8') + { + ptr--; + c = 0; + break; + } + + /* \0 always starts an octal number, but we may drop through to here with a + larger first octal digit. The original code used just to take the least + significant 8 bits of octal numbers (I think this is what early Perls used + to do). Nowadays we allow for larger numbers in UTF-8 mode, but no more + than 3 octal digits. */ + + case '0': + c -= '0'; + while(i++ < 2 && ptr[1] >= '0' && ptr[1] <= '7') + c = c * 8 + *(++ptr) - '0'; + if (!utf8 && c > 255) *errorcodeptr = ERR51; + break; + + /* \x is complicated. \x{ddd} is a character number which can be greater + than 0xff in utf8 mode, but only if the ddd are hex digits. If not, { is + treated as a data character. */ + + case 'x': + if (ptr[1] == '{') + { + const uschar *pt = ptr + 2; + int count = 0; + + c = 0; + while ((digitab[*pt] & ctype_xdigit) != 0) + { + register int cc = *pt++; + if (c == 0 && cc == '0') continue; /* Leading zeroes */ + count++; + +#ifndef EBCDIC /* ASCII coding */ + if (cc >= 'a') cc -= 32; /* Convert to upper case */ + c = (c << 4) + cc - ((cc < 'A')? '0' : ('A' - 10)); +#else /* EBCDIC coding */ + if (cc >= 'a' && cc <= 'z') cc += 64; /* Convert to upper case */ + c = (c << 4) + cc - ((cc >= '0')? '0' : ('A' - 10)); +#endif + } + + if (*pt == '}') + { + if (c < 0 || count > (utf8? 8 : 2)) *errorcodeptr = ERR34; + ptr = pt; + break; + } + + /* If the sequence of hex digits does not end with '}', then we don't + recognize this construct; fall through to the normal \x handling. */ + } + + /* Read just a single-byte hex-defined char */ + + c = 0; + while (i++ < 2 && (digitab[ptr[1]] & ctype_xdigit) != 0) + { + int cc; /* Some compilers don't like ++ */ + cc = *(++ptr); /* in initializers */ +#ifndef EBCDIC /* ASCII coding */ + if (cc >= 'a') cc -= 32; /* Convert to upper case */ + c = c * 16 + cc - ((cc < 'A')? '0' : ('A' - 10)); +#else /* EBCDIC coding */ + if (cc <= 'z') cc += 64; /* Convert to upper case */ + c = c * 16 + cc - ((cc >= '0')? '0' : ('A' - 10)); +#endif + } + break; + + /* For \c, a following letter is upper-cased; then the 0x40 bit is flipped. + This coding is ASCII-specific, but then the whole concept of \cx is + ASCII-specific. (However, an EBCDIC equivalent has now been added.) */ + + case 'c': + c = *(++ptr); + if (c == 0) + { + *errorcodeptr = ERR2; + break; + } + +#ifndef EBCDIC /* ASCII coding */ + if (c >= 'a' && c <= 'z') c -= 32; + c ^= 0x40; +#else /* EBCDIC coding */ + if (c >= 'a' && c <= 'z') c += 64; + c ^= 0xC0; +#endif + break; + + /* PCRE_EXTRA enables extensions to Perl in the matter of escapes. Any + other alphanumeric following \ is an error if PCRE_EXTRA was set; + otherwise, for Perl compatibility, it is a literal. This code looks a bit + odd, but there used to be some cases other than the default, and there may + be again in future, so I haven't "optimized" it. */ + + default: + if ((options & PCRE_EXTRA) != 0) switch(c) + { + default: + *errorcodeptr = ERR3; + break; + } + break; + } + } + +*ptrptr = ptr; +return c; +} + + + +#ifdef SUPPORT_UCP +/************************************************* +* Handle \P and \p * +*************************************************/ + +/* This function is called after \P or \p has been encountered, provided that +PCRE is compiled with support for Unicode properties. On entry, ptrptr is +pointing at the P or p. On exit, it is pointing at the final character of the +escape sequence. + +Argument: + ptrptr points to the pattern position pointer + negptr points to a boolean that is set TRUE for negation else FALSE + dptr points to an int that is set to the detailed property value + errorcodeptr points to the error code variable + +Returns: type value from ucp_type_table, or -1 for an invalid type +*/ + +static int +get_ucp(const uschar **ptrptr, BOOL *negptr, int *dptr, int *errorcodeptr) +{ +int c, i, bot, top; +const uschar *ptr = *ptrptr; +char name[32]; + +c = *(++ptr); +if (c == 0) goto ERROR_RETURN; + +*negptr = FALSE; + +/* \P or \p can be followed by a name in {}, optionally preceded by ^ for +negation. */ + +if (c == '{') + { + if (ptr[1] == '^') + { + *negptr = TRUE; + ptr++; + } + for (i = 0; i < (int)sizeof(name) - 1; i++) + { + c = *(++ptr); + if (c == 0) goto ERROR_RETURN; + if (c == '}') break; + name[i] = c; + } + if (c !='}') goto ERROR_RETURN; + name[i] = 0; + } + +/* Otherwise there is just one following character */ + +else + { + name[0] = c; + name[1] = 0; + } + +*ptrptr = ptr; + +/* Search for a recognized property name using binary chop */ + +bot = 0; +top = _erts_pcre_utt_size; + +while (bot < top) + { + i = (bot + top) >> 1; + c = strcmp(name, _erts_pcre_utt_names + _erts_pcre_utt[i].name_offset); + if (c == 0) + { + *dptr = _erts_pcre_utt[i].value; + return _erts_pcre_utt[i].type; + } + if (c > 0) bot = i + 1; else top = i; + } + +*errorcodeptr = ERR47; +*ptrptr = ptr; +return -1; + +ERROR_RETURN: +*errorcodeptr = ERR46; +*ptrptr = ptr; +return -1; +} +#endif + + + + +/************************************************* +* Check for counted repeat * +*************************************************/ + +/* This function is called when a '{' is encountered in a place where it might +start a quantifier. It looks ahead to see if it really is a quantifier or not. +It is only a quantifier if it is one of the forms {ddd} {ddd,} or {ddd,ddd} +where the ddds are digits. + +Arguments: + p pointer to the first char after '{' + +Returns: TRUE or FALSE +*/ + +static BOOL +is_counted_repeat(const uschar *p) +{ +if ((digitab[*p++] & ctype_digit) == 0) return FALSE; +while ((digitab[*p] & ctype_digit) != 0) p++; +if (*p == '}') return TRUE; + +if (*p++ != ',') return FALSE; +if (*p == '}') return TRUE; + +if ((digitab[*p++] & ctype_digit) == 0) return FALSE; +while ((digitab[*p] & ctype_digit) != 0) p++; + +return (*p == '}'); +} + + + +/************************************************* +* Read repeat counts * +*************************************************/ + +/* Read an item of the form {n,m} and return the values. This is called only +after is_counted_repeat() has confirmed that a repeat-count quantifier exists, +so the syntax is guaranteed to be correct, but we need to check the values. + +Arguments: + p pointer to first char after '{' + minp pointer to int for min + maxp pointer to int for max + returned as -1 if no max + errorcodeptr points to error code variable + +Returns: pointer to '}' on success; + current ptr on error, with errorcodeptr set non-zero +*/ + +static const uschar * +read_repeat_counts(const uschar *p, int *minp, int *maxp, int *errorcodeptr) +{ +int min = 0; +int max = -1; + +/* Read the minimum value and do a paranoid check: a negative value indicates +an integer overflow. */ + +while ((digitab[*p] & ctype_digit) != 0) min = min * 10 + *p++ - '0'; +if (min < 0 || min > 65535) + { + *errorcodeptr = ERR5; + return p; + } + +/* Read the maximum value if there is one, and again do a paranoid on its size. +Also, max must not be less than min. */ + +if (*p == '}') max = min; else + { + if (*(++p) != '}') + { + max = 0; + while((digitab[*p] & ctype_digit) != 0) max = max * 10 + *p++ - '0'; + if (max < 0 || max > 65535) + { + *errorcodeptr = ERR5; + return p; + } + if (max < min) + { + *errorcodeptr = ERR4; + return p; + } + } + } + +/* Fill in the required variables, and pass back the pointer to the terminating +'}'. */ + +*minp = min; +*maxp = max; +return p; +} + + + +/************************************************* +* Find forward referenced subpattern * +*************************************************/ + +/* This function scans along a pattern's text looking for capturing +subpatterns, and counting them. If it finds a named pattern that matches the +name it is given, it returns its number. Alternatively, if the name is NULL, it +returns when it reaches a given numbered subpattern. This is used for forward +references to subpatterns. We know that if (?P< is encountered, the name will +be terminated by '>' because that is checked in the first pass. + +Arguments: + ptr current position in the pattern + count current count of capturing parens so far encountered + name name to seek, or NULL if seeking a numbered subpattern + lorn name length, or subpattern number if name is NULL + xmode TRUE if we are in /x mode + +Returns: the number of the named subpattern, or -1 if not found +*/ + +static int +find_parens(const uschar *ptr, int count, const uschar *name, int lorn, + BOOL xmode) +{ +const uschar *thisname; + +for (; *ptr != 0; ptr++) + { + int term; + + /* Skip over backslashed characters and also entire \Q...\E */ + + if (*ptr == '\\') + { + if (*(++ptr) == 0) return -1; + if (*ptr == 'Q') for (;;) + { + while (*(++ptr) != 0 && *ptr != '\\'); + if (*ptr == 0) return -1; + if (*(++ptr) == 'E') break; + } + continue; + } + + /* Skip over character classes */ + + if (*ptr == '[') + { + while (*(++ptr) != ']') + { + if (*ptr == 0) return -1; + if (*ptr == '\\') + { + if (*(++ptr) == 0) return -1; + if (*ptr == 'Q') for (;;) + { + while (*(++ptr) != 0 && *ptr != '\\'); + if (*ptr == 0) return -1; + if (*(++ptr) == 'E') break; + } + continue; + } + } + continue; + } + + /* Skip comments in /x mode */ + + if (xmode && *ptr == '#') + { + while (*(++ptr) != 0 && *ptr != '\n'); + if (*ptr == 0) return -1; + continue; + } + + /* An opening parens must now be a real metacharacter */ + + if (*ptr != '(') continue; + if (ptr[1] != '?' && ptr[1] != '*') + { + count++; + if (name == NULL && count == lorn) return count; + continue; + } + + ptr += 2; + if (*ptr == 'P') ptr++; /* Allow optional P */ + + /* We have to disambiguate (? */ + + if ((*ptr != '<' || ptr[1] == '!' || ptr[1] == '=') && + *ptr != '\'') + continue; + + count++; + + if (name == NULL && count == lorn) return count; + term = *ptr++; + if (term == '<') term = '>'; + thisname = ptr; + while (*ptr != term) ptr++; + if (name != NULL && lorn == ptr - thisname && + strncmp((const char *)name, (const char *)thisname, lorn) == 0) + return count; + } + +return -1; +} + + + +/************************************************* +* Find first significant op code * +*************************************************/ + +/* This is called by several functions that scan a compiled expression looking +for a fixed first character, or an anchoring op code etc. It skips over things +that do not influence this. For some calls, a change of option is important. +For some calls, it makes sense to skip negative forward and all backward +assertions, and also the \b assertion; for others it does not. + +Arguments: + code pointer to the start of the group + options pointer to external options + optbit the option bit whose changing is significant, or + zero if none are + skipassert TRUE if certain assertions are to be skipped + +Returns: pointer to the first significant opcode +*/ + +static const uschar* +first_significant_code(const uschar *code, int *options, int optbit, + BOOL skipassert) +{ +for (;;) + { + switch ((int)*code) + { + case OP_OPT: + if (optbit > 0 && ((int)code[1] & optbit) != (*options & optbit)) + *options = (int)code[1]; + code += 2; + break; + + case OP_ASSERT_NOT: + case OP_ASSERTBACK: + case OP_ASSERTBACK_NOT: + if (!skipassert) return code; + do code += GET(code, 1); while (*code == OP_ALT); + code += _erts_pcre_OP_lengths[*code]; + break; + + case OP_WORD_BOUNDARY: + case OP_NOT_WORD_BOUNDARY: + if (!skipassert) return code; + /* Fall through */ + + case OP_CALLOUT: + case OP_CREF: + case OP_RREF: + case OP_DEF: + code += _erts_pcre_OP_lengths[*code]; + break; + + default: + return code; + } + } +/* Control never reaches here */ +} + + + + +/************************************************* +* Find the fixed length of a pattern * +*************************************************/ + +/* Scan a pattern and compute the fixed length of subject that will match it, +if the length is fixed. This is needed for dealing with backward assertions. +In UTF8 mode, the result is in characters rather than bytes. + +Arguments: + code points to the start of the pattern (the bracket) + options the compiling options + +Returns: the fixed length, or -1 if there is no fixed length, + or -2 if \C was encountered +*/ + +static int +find_fixedlength(uschar *code, int options) +{ +int length = -1; + +register int branchlength = 0; +register uschar *cc = code + 1 + LINK_SIZE; + +/* Scan along the opcodes for this branch. If we get to the end of the +branch, check the length against that of the other branches. */ + +for (;;) + { + int d; + register int op = *cc; + switch (op) + { + case OP_CBRA: + case OP_BRA: + case OP_ONCE: + case OP_COND: + d = find_fixedlength(cc + ((op == OP_CBRA)? 2:0), options); + if (d < 0) return d; + branchlength += d; + do cc += GET(cc, 1); while (*cc == OP_ALT); + cc += 1 + LINK_SIZE; + break; + + /* Reached end of a branch; if it's a ket it is the end of a nested + call. If it's ALT it is an alternation in a nested call. If it is + END it's the end of the outer call. All can be handled by the same code. */ + + case OP_ALT: + case OP_KET: + case OP_KETRMAX: + case OP_KETRMIN: + case OP_END: + if (length < 0) length = branchlength; + else if (length != branchlength) return -1; + if (*cc != OP_ALT) return length; + cc += 1 + LINK_SIZE; + branchlength = 0; + break; + + /* Skip over assertive subpatterns */ + + case OP_ASSERT: + case OP_ASSERT_NOT: + case OP_ASSERTBACK: + case OP_ASSERTBACK_NOT: + do cc += GET(cc, 1); while (*cc == OP_ALT); + /* Fall through */ + + /* Skip over things that don't match chars */ + + case OP_REVERSE: + case OP_CREF: + case OP_RREF: + case OP_DEF: + case OP_OPT: + case OP_CALLOUT: + case OP_SOD: + case OP_SOM: + case OP_EOD: + case OP_EODN: + case OP_CIRC: + case OP_DOLL: + case OP_NOT_WORD_BOUNDARY: + case OP_WORD_BOUNDARY: + cc += _erts_pcre_OP_lengths[*cc]; + break; + + /* Handle literal characters */ + + case OP_CHAR: + case OP_CHARNC: + case OP_NOT: + branchlength++; + cc += 2; +#ifdef SUPPORT_UTF8 + if ((options & PCRE_UTF8) != 0) + { + while ((*cc & 0xc0) == 0x80) cc++; + } +#endif + break; + + /* Handle exact repetitions. The count is already in characters, but we + need to skip over a multibyte character in UTF8 mode. */ + + case OP_EXACT: + branchlength += GET2(cc,1); + cc += 4; +#ifdef SUPPORT_UTF8 + if ((options & PCRE_UTF8) != 0) + { + while((*cc & 0x80) == 0x80) cc++; + } +#endif + break; + + case OP_TYPEEXACT: + branchlength += GET2(cc,1); + if (cc[3] == OP_PROP || cc[3] == OP_NOTPROP) cc += 2; + cc += 4; + break; + + /* Handle single-char matchers */ + + case OP_PROP: + case OP_NOTPROP: + cc += 2; + /* Fall through */ + + case OP_NOT_DIGIT: + case OP_DIGIT: + case OP_NOT_WHITESPACE: + case OP_WHITESPACE: + case OP_NOT_WORDCHAR: + case OP_WORDCHAR: + case OP_ANY: + branchlength++; + cc++; + break; + + /* The single-byte matcher isn't allowed */ + + case OP_ANYBYTE: + return -2; + + /* Check a class for variable quantification */ + +#ifdef SUPPORT_UTF8 + case OP_XCLASS: + cc += GET(cc, 1) - 33; + /* Fall through */ +#endif + + case OP_CLASS: + case OP_NCLASS: + cc += 33; + + switch (*cc) + { + case OP_CRSTAR: + case OP_CRMINSTAR: + case OP_CRQUERY: + case OP_CRMINQUERY: + return -1; + + case OP_CRRANGE: + case OP_CRMINRANGE: + if (GET2(cc,1) != GET2(cc,3)) return -1; + branchlength += GET2(cc,1); + cc += 5; + break; + + default: + branchlength++; + } + break; + + /* Anything else is variable length */ + + default: + return -1; + } + } +/* Control never gets here */ +} + + + + +/************************************************* +* Scan compiled regex for numbered bracket * +*************************************************/ + +/* This little function scans through a compiled pattern until it finds a +capturing bracket with the given number. + +Arguments: + code points to start of expression + utf8 TRUE in UTF-8 mode + number the required bracket number + +Returns: pointer to the opcode for the bracket, or NULL if not found +*/ + +static const uschar * +find_bracket(const uschar *code, BOOL utf8, int number) +{ +for (;;) + { + register int c = *code; + if (c == OP_END) return NULL; + + /* XCLASS is used for classes that cannot be represented just by a bit + map. This includes negated single high-valued characters. The length in + the table is zero; the actual length is stored in the compiled code. */ + + if (c == OP_XCLASS) code += GET(code, 1); + + /* Handle capturing bracket */ + + else if (c == OP_CBRA) + { + int n = GET2(code, 1+LINK_SIZE); + if (n == number) return (uschar *)code; + code += _erts_pcre_OP_lengths[c]; + } + + /* Otherwise, we can get the item's length from the table, except that for + repeated character types, we have to test for \p and \P, which have an extra + two bytes of parameters. */ + + else + { + switch(c) + { + case OP_TYPESTAR: + case OP_TYPEMINSTAR: + case OP_TYPEPLUS: + case OP_TYPEMINPLUS: + case OP_TYPEQUERY: + case OP_TYPEMINQUERY: + case OP_TYPEPOSSTAR: + case OP_TYPEPOSPLUS: + case OP_TYPEPOSQUERY: + if (code[1] == OP_PROP || code[1] == OP_NOTPROP) code += 2; + break; + + case OP_TYPEUPTO: + case OP_TYPEMINUPTO: + case OP_TYPEEXACT: + case OP_TYPEPOSUPTO: + if (code[3] == OP_PROP || code[3] == OP_NOTPROP) code += 2; + break; + } + + /* Add in the fixed length from the table */ + + code += _erts_pcre_OP_lengths[c]; + + /* In UTF-8 mode, opcodes that are followed by a character may be followed by + a multi-byte character. The length in the table is a minimum, so we have to + arrange to skip the extra bytes. */ + +#ifdef SUPPORT_UTF8 + if (utf8) switch(c) + { + case OP_CHAR: + case OP_CHARNC: + case OP_EXACT: + case OP_UPTO: + case OP_MINUPTO: + case OP_POSUPTO: + case OP_STAR: + case OP_MINSTAR: + case OP_POSSTAR: + case OP_PLUS: + case OP_MINPLUS: + case OP_POSPLUS: + case OP_QUERY: + case OP_MINQUERY: + case OP_POSQUERY: + if (code[-1] >= 0xc0) code += _erts_pcre_utf8_table4[code[-1] & 0x3f]; + break; + } +#endif + } + } +} + + + +/************************************************* +* Scan compiled regex for recursion reference * +*************************************************/ + +/* This little function scans through a compiled pattern until it finds an +instance of OP_RECURSE. + +Arguments: + code points to start of expression + utf8 TRUE in UTF-8 mode + +Returns: pointer to the opcode for OP_RECURSE, or NULL if not found +*/ + +static const uschar * +find_recurse(const uschar *code, BOOL utf8) +{ +for (;;) + { + register int c = *code; + if (c == OP_END) return NULL; + if (c == OP_RECURSE) return code; + + /* XCLASS is used for classes that cannot be represented just by a bit + map. This includes negated single high-valued characters. The length in + the table is zero; the actual length is stored in the compiled code. */ + + if (c == OP_XCLASS) code += GET(code, 1); + + /* Otherwise, we can get the item's length from the table, except that for + repeated character types, we have to test for \p and \P, which have an extra + two bytes of parameters. */ + + else + { + switch(c) + { + case OP_TYPESTAR: + case OP_TYPEMINSTAR: + case OP_TYPEPLUS: + case OP_TYPEMINPLUS: + case OP_TYPEQUERY: + case OP_TYPEMINQUERY: + case OP_TYPEPOSSTAR: + case OP_TYPEPOSPLUS: + case OP_TYPEPOSQUERY: + if (code[1] == OP_PROP || code[1] == OP_NOTPROP) code += 2; + break; + + case OP_TYPEPOSUPTO: + case OP_TYPEUPTO: + case OP_TYPEMINUPTO: + case OP_TYPEEXACT: + if (code[3] == OP_PROP || code[3] == OP_NOTPROP) code += 2; + break; + } + + /* Add in the fixed length from the table */ + + code += _erts_pcre_OP_lengths[c]; + + /* In UTF-8 mode, opcodes that are followed by a character may be followed + by a multi-byte character. The length in the table is a minimum, so we have + to arrange to skip the extra bytes. */ + +#ifdef SUPPORT_UTF8 + if (utf8) switch(c) + { + case OP_CHAR: + case OP_CHARNC: + case OP_EXACT: + case OP_UPTO: + case OP_MINUPTO: + case OP_POSUPTO: + case OP_STAR: + case OP_MINSTAR: + case OP_POSSTAR: + case OP_PLUS: + case OP_MINPLUS: + case OP_POSPLUS: + case OP_QUERY: + case OP_MINQUERY: + case OP_POSQUERY: + if (code[-1] >= 0xc0) code += _erts_pcre_utf8_table4[code[-1] & 0x3f]; + break; + } +#endif + } + } +} + + + +/************************************************* +* Scan compiled branch for non-emptiness * +*************************************************/ + +/* This function scans through a branch of a compiled pattern to see whether it +can match the empty string or not. It is called from could_be_empty() +below and from compile_branch() when checking for an unlimited repeat of a +group that can match nothing. Note that first_significant_code() skips over +backward and negative forward assertions when its final argument is TRUE. If we +hit an unclosed bracket, we return "empty" - this means we've struck an inner +bracket whose current branch will already have been scanned. + +Arguments: + code points to start of search + endcode points to where to stop + utf8 TRUE if in UTF8 mode + +Returns: TRUE if what is matched could be empty +*/ + +static BOOL +could_be_empty_branch(const uschar *code, const uschar *endcode, BOOL utf8) +{ +register int c; +for (code = first_significant_code(code + _erts_pcre_OP_lengths[*code], NULL, 0, TRUE); + code < endcode; + code = first_significant_code(code + _erts_pcre_OP_lengths[c], NULL, 0, TRUE)) + { + const uschar *ccode; + + c = *code; + + /* Skip over forward assertions; the other assertions are skipped by + first_significant_code() with a TRUE final argument. */ + + if (c == OP_ASSERT) + { + do code += GET(code, 1); while (*code == OP_ALT); + c = *code; + continue; + } + + /* Groups with zero repeats can of course be empty; skip them. */ + + if (c == OP_BRAZERO || c == OP_BRAMINZERO) + { + code += _erts_pcre_OP_lengths[c]; + do code += GET(code, 1); while (*code == OP_ALT); + c = *code; + continue; + } + + /* For other groups, scan the branches. */ + + if (c == OP_BRA || c == OP_CBRA || c == OP_ONCE || c == OP_COND) + { + BOOL empty_branch; + if (GET(code, 1) == 0) return TRUE; /* Hit unclosed bracket */ + + /* Scan a closed bracket */ + + empty_branch = FALSE; + do + { + if (!empty_branch && could_be_empty_branch(code, endcode, utf8)) + empty_branch = TRUE; + code += GET(code, 1); + } + while (*code == OP_ALT); + if (!empty_branch) return FALSE; /* All branches are non-empty */ + c = *code; + continue; + } + + /* Handle the other opcodes */ + + switch (c) + { + /* Check for quantifiers after a class. XCLASS is used for classes that + cannot be represented just by a bit map. This includes negated single + high-valued characters. The length in _erts_pcre_OP_lengths[] is zero; the + actual length is stored in the compiled code, so we must update "code" + here. */ + +#ifdef SUPPORT_UTF8 + case OP_XCLASS: + ccode = code += GET(code, 1); + goto CHECK_CLASS_REPEAT; +#endif + + case OP_CLASS: + case OP_NCLASS: + ccode = code + 33; + +#ifdef SUPPORT_UTF8 + CHECK_CLASS_REPEAT: +#endif + + switch (*ccode) + { + case OP_CRSTAR: /* These could be empty; continue */ + case OP_CRMINSTAR: + case OP_CRQUERY: + case OP_CRMINQUERY: + break; + + default: /* Non-repeat => class must match */ + case OP_CRPLUS: /* These repeats aren't empty */ + case OP_CRMINPLUS: + return FALSE; + + case OP_CRRANGE: + case OP_CRMINRANGE: + if (GET2(ccode, 1) > 0) return FALSE; /* Minimum > 0 */ + break; + } + break; + + /* Opcodes that must match a character */ + + case OP_PROP: + case OP_NOTPROP: + case OP_EXTUNI: + case OP_NOT_DIGIT: + case OP_DIGIT: + case OP_NOT_WHITESPACE: + case OP_WHITESPACE: + case OP_NOT_WORDCHAR: + case OP_WORDCHAR: + case OP_ANY: + case OP_ANYBYTE: + case OP_CHAR: + case OP_CHARNC: + case OP_NOT: + case OP_PLUS: + case OP_MINPLUS: + case OP_POSPLUS: + case OP_EXACT: + case OP_NOTPLUS: + case OP_NOTMINPLUS: + case OP_NOTPOSPLUS: + case OP_NOTEXACT: + case OP_TYPEPLUS: + case OP_TYPEMINPLUS: + case OP_TYPEPOSPLUS: + case OP_TYPEEXACT: + return FALSE; + + /* These are going to continue, as they may be empty, but we have to + fudge the length for the \p and \P cases. */ + + case OP_TYPESTAR: + case OP_TYPEMINSTAR: + case OP_TYPEPOSSTAR: + case OP_TYPEQUERY: + case OP_TYPEMINQUERY: + case OP_TYPEPOSQUERY: + if (code[1] == OP_PROP || code[1] == OP_NOTPROP) code += 2; + break; + + /* Same for these */ + + case OP_TYPEUPTO: + case OP_TYPEMINUPTO: + case OP_TYPEPOSUPTO: + if (code[3] == OP_PROP || code[3] == OP_NOTPROP) code += 2; + break; + + /* End of branch */ + + case OP_KET: + case OP_KETRMAX: + case OP_KETRMIN: + case OP_ALT: + return TRUE; + + /* In UTF-8 mode, STAR, MINSTAR, POSSTAR, QUERY, MINQUERY, POSQUERY, UPTO, + MINUPTO, and POSUPTO may be followed by a multibyte character */ + +#ifdef SUPPORT_UTF8 + case OP_STAR: + case OP_MINSTAR: + case OP_POSSTAR: + case OP_QUERY: + case OP_MINQUERY: + case OP_POSQUERY: + case OP_UPTO: + case OP_MINUPTO: + case OP_POSUPTO: + if (utf8) while ((code[2] & 0xc0) == 0x80) code++; + break; +#endif + } + } + +return TRUE; +} + + + +/************************************************* +* Scan compiled regex for non-emptiness * +*************************************************/ + +/* This function is called to check for left recursive calls. We want to check +the current branch of the current pattern to see if it could match the empty +string. If it could, we must look outwards for branches at other levels, +stopping when we pass beyond the bracket which is the subject of the recursion. + +Arguments: + code points to start of the recursion + endcode points to where to stop (current RECURSE item) + bcptr points to the chain of current (unclosed) branch starts + utf8 TRUE if in UTF-8 mode + +Returns: TRUE if what is matched could be empty +*/ + +static BOOL +could_be_empty(const uschar *code, const uschar *endcode, branch_chain *bcptr, + BOOL utf8) +{ +while (bcptr != NULL && bcptr->current >= code) + { + if (!could_be_empty_branch(bcptr->current, endcode, utf8)) return FALSE; + bcptr = bcptr->outer; + } +return TRUE; +} + + + +/************************************************* +* Check for POSIX class syntax * +*************************************************/ + +/* This function is called when the sequence "[:" or "[." or "[=" is +encountered in a character class. It checks whether this is followed by a +sequence of characters terminated by a matching ":]" or ".]" or "=]". If we +reach an unescaped ']' without the special preceding character, return FALSE. + +Originally, this function only recognized a sequence of letters between the +terminators, but it seems that Perl recognizes any sequence of characters, +though of course unknown POSIX names are subsequently rejected. Perl gives an +"Unknown POSIX class" error for [:f\oo:] for example, where previously PCRE +didn't consider this to be a POSIX class. Likewise for [:1234:]. + +The problem in trying to be exactly like Perl is in the handling of escapes. We +have to be sure that [abc[:x\]pqr] is *not* treated as containing a POSIX +class, but [abc[:x\]pqr:]] is (so that an error can be generated). The code +below handles the special case of \], but does not try to do any other escape +processing. This makes it different from Perl for cases such as [:l\ower:] +where Perl recognizes it as the POSIX class "lower" but PCRE does not recognize +"l\ower". This is a lesser evil that not diagnosing bad classes when Perl does, +I think. + +Arguments: + ptr pointer to the initial [ + endptr where to return the end pointer + +Returns: TRUE or FALSE +*/ + +static BOOL +check_posix_syntax(const uschar *ptr, const uschar **endptr) +{ +int terminator; /* Don't combine these lines; the Solaris cc */ +terminator = *(++ptr); /* compiler warns about "non-constant" initializer. */ +for (++ptr; *ptr != 0; ptr++) + { + if (*ptr == '\\' && ptr[1] == ']') ptr++; else + { + if (*ptr == ']') return FALSE; + if (*ptr == terminator && ptr[1] == ']') + { + *endptr = ptr; + return TRUE; + } + } + } +return FALSE; +} + + + + +/************************************************* +* Check POSIX class name * +*************************************************/ + +/* This function is called to check the name given in a POSIX-style class entry +such as [:alnum:]. + +Arguments: + ptr points to the first letter + len the length of the name + +Returns: a value representing the name, or -1 if unknown +*/ + +static int +check_posix_name(const uschar *ptr, int len) +{ +const char *pn = posix_names; +register int yield = 0; +while (posix_name_lengths[yield] != 0) + { + if (len == posix_name_lengths[yield] && + strncmp((const char *)ptr, pn, len) == 0) return yield; + pn += posix_name_lengths[yield] + 1; + yield++; + } +return -1; +} + + +/************************************************* +* Adjust OP_RECURSE items in repeated group * +*************************************************/ + +/* OP_RECURSE items contain an offset from the start of the regex to the group +that is referenced. This means that groups can be replicated for fixed +repetition simply by copying (because the recursion is allowed to refer to +earlier groups that are outside the current group). However, when a group is +optional (i.e. the minimum quantifier is zero), OP_BRAZERO is inserted before +it, after it has been compiled. This means that any OP_RECURSE items within it +that refer to the group itself or any contained groups have to have their +offsets adjusted. That one of the jobs of this function. Before it is called, +the partially compiled regex must be temporarily terminated with OP_END. + +This function has been extended with the possibility of forward references for +recursions and subroutine calls. It must also check the list of such references +for the group we are dealing with. If it finds that one of the recursions in +the current group is on this list, it adjusts the offset in the list, not the +value in the reference (which is a group number). + +Arguments: + group points to the start of the group + adjust the amount by which the group is to be moved + utf8 TRUE in UTF-8 mode + cd contains pointers to tables etc. + save_hwm the hwm forward reference pointer at the start of the group + +Returns: nothing +*/ + +static void +adjust_recurse(uschar *group, int adjust, BOOL utf8, compile_data *cd, + uschar *save_hwm) +{ +uschar *ptr = group; + +while ((ptr = (uschar *)find_recurse(ptr, utf8)) != NULL) + { + int offset; + uschar *hc; + + /* See if this recursion is on the forward reference list. If so, adjust the + reference. */ + + for (hc = save_hwm; hc < cd->hwm; hc += LINK_SIZE) + { + offset = GET(hc, 0); + if (cd->start_code + offset == ptr + 1) + { + PUT(hc, 0, offset + adjust); + break; + } + } + + /* Otherwise, adjust the recursion offset if it's after the start of this + group. */ + + if (hc >= cd->hwm) + { + offset = GET(ptr, 1); + if (cd->start_code + offset >= group) PUT(ptr, 1, offset + adjust); + } + + ptr += 1 + LINK_SIZE; + } +} + + + +/************************************************* +* Insert an automatic callout point * +*************************************************/ + +/* This function is called when the PCRE_AUTO_CALLOUT option is set, to insert +callout points before each pattern item. + +Arguments: + code current code pointer + ptr current pattern pointer + cd pointers to tables etc + +Returns: new code pointer +*/ + +static uschar * +auto_callout(uschar *code, const uschar *ptr, compile_data *cd) +{ +*code++ = OP_CALLOUT; +*code++ = 255; +PUT(code, 0, ptr - cd->start_pattern); /* Pattern offset */ +PUT(code, LINK_SIZE, 0); /* Default length */ +return code + 2*LINK_SIZE; +} + + + +/************************************************* +* Complete a callout item * +*************************************************/ + +/* A callout item contains the length of the next item in the pattern, which +we can't fill in till after we have reached the relevant point. This is used +for both automatic and manual callouts. + +Arguments: + previous_callout points to previous callout item + ptr current pattern pointer + cd pointers to tables etc + +Returns: nothing +*/ + +static void +complete_callout(uschar *previous_callout, const uschar *ptr, compile_data *cd) +{ +int length = ptr - cd->start_pattern - GET(previous_callout, 2); +PUT(previous_callout, 2 + LINK_SIZE, length); +} + + + +#ifdef SUPPORT_UCP +/************************************************* +* Get othercase range * +*************************************************/ + +/* This function is passed the start and end of a class range, in UTF-8 mode +with UCP support. It searches up the characters, looking for internal ranges of +characters in the "other" case. Each call returns the next one, updating the +start address. + +Arguments: + cptr points to starting character value; updated + d end value + ocptr where to put start of othercase range + odptr where to put end of othercase range + +Yield: TRUE when range returned; FALSE when no more +*/ + +static BOOL +get_othercase_range(unsigned int *cptr, unsigned int d, unsigned int *ocptr, + unsigned int *odptr) +{ +unsigned int c, othercase, next; + +for (c = *cptr; c <= d; c++) + { if ((othercase = _erts_pcre_ucp_othercase(c)) != NOTACHAR) break; } + +if (c > d) return FALSE; + +*ocptr = othercase; +next = othercase + 1; + +for (++c; c <= d; c++) + { + if (_erts_pcre_ucp_othercase(c) != next) break; + next++; + } + +*odptr = next - 1; +*cptr = c; + +return TRUE; +} +#endif /* SUPPORT_UCP */ + + + +/************************************************* +* Check if auto-possessifying is possible * +*************************************************/ + +/* This function is called for unlimited repeats of certain items, to see +whether the next thing could possibly match the repeated item. If not, it makes +sense to automatically possessify the repeated item. + +Arguments: + op_code the repeated op code + this data for this item, depends on the opcode + utf8 TRUE in UTF-8 mode + utf8_char used for utf8 character bytes, NULL if not relevant + ptr next character in pattern + options options bits + cd contains pointers to tables etc. + +Returns: TRUE if possessifying is wanted +*/ + +static BOOL +check_auto_possessive(int op_code, int item, BOOL utf8, uschar *utf8_char, + const uschar *ptr, int options, compile_data *cd) +{ +int next; + +/* Skip whitespace and comments in extended mode */ + +if ((options & PCRE_EXTENDED) != 0) + { + for (;;) + { + while ((cd->ctypes[*ptr] & ctype_space) != 0) ptr++; + if (*ptr == '#') + { + while (*(++ptr) != 0) + if (IS_NEWLINE(ptr)) { ptr += cd->nllen; break; } + } + else break; + } + } + +/* If the next item is one that we can handle, get its value. A non-negative +value is a character, a negative value is an escape value. */ + +if (*ptr == '\\') + { + int temperrorcode = 0; + next = check_escape(&ptr, &temperrorcode, cd->bracount, options, FALSE); + if (temperrorcode != 0) return FALSE; + ptr++; /* Point after the escape sequence */ + } + +else if ((cd->ctypes[*ptr] & ctype_meta) == 0) + { +#ifdef SUPPORT_UTF8 + if (utf8) { GETCHARINC(next, ptr); } else +#endif + next = *ptr++; + } + +else return FALSE; + +/* Skip whitespace and comments in extended mode */ + +if ((options & PCRE_EXTENDED) != 0) + { + for (;;) + { + while ((cd->ctypes[*ptr] & ctype_space) != 0) ptr++; + if (*ptr == '#') + { + while (*(++ptr) != 0) + if (IS_NEWLINE(ptr)) { ptr += cd->nllen; break; } + } + else break; + } + } + +/* If the next thing is itself optional, we have to give up. */ + +if (*ptr == '*' || *ptr == '?' || strncmp((char *)ptr, "{0,", 3) == 0) + return FALSE; + +/* Now compare the next item with the previous opcode. If the previous is a +positive single character match, "item" either contains the character or, if +"item" is greater than 127 in utf8 mode, the character's bytes are in +utf8_char. */ + + +/* Handle cases when the next item is a character. */ + +if (next >= 0) switch(op_code) + { + case OP_CHAR: +#ifdef SUPPORT_UTF8 + if (utf8 && item > 127) { GETCHAR(item, utf8_char); } +#endif + return item != next; + + /* For CHARNC (caseless character) we must check the other case. If we have + Unicode property support, we can use it to test the other case of + high-valued characters. */ + + case OP_CHARNC: +#ifdef SUPPORT_UTF8 + if (utf8 && item > 127) { GETCHAR(item, utf8_char); } +#endif + if (item == next) return FALSE; +#ifdef SUPPORT_UTF8 + if (utf8) + { + unsigned int othercase; + if (next < 128) othercase = cd->fcc[next]; else +#ifdef SUPPORT_UCP + othercase = _erts_pcre_ucp_othercase((unsigned int)next); +#else + othercase = NOTACHAR; +#endif + return (unsigned int)item != othercase; + } + else +#endif /* SUPPORT_UTF8 */ + return (item != cd->fcc[next]); /* Non-UTF-8 mode */ + + /* For OP_NOT, "item" must be a single-byte character. */ + + case OP_NOT: + if (next < 0) return FALSE; /* Not a character */ + if (item == next) return TRUE; + if ((options & PCRE_CASELESS) == 0) return FALSE; +#ifdef SUPPORT_UTF8 + if (utf8) + { + unsigned int othercase; + if (next < 128) othercase = cd->fcc[next]; else +#ifdef SUPPORT_UCP + othercase = _erts_pcre_ucp_othercase(next); +#else + othercase = NOTACHAR; +#endif + return (unsigned int)item == othercase; + } + else +#endif /* SUPPORT_UTF8 */ + return (item == cd->fcc[next]); /* Non-UTF-8 mode */ + + case OP_DIGIT: + return next > 127 || (cd->ctypes[next] & ctype_digit) == 0; + + case OP_NOT_DIGIT: + return next <= 127 && (cd->ctypes[next] & ctype_digit) != 0; + + case OP_WHITESPACE: + return next > 127 || (cd->ctypes[next] & ctype_space) == 0; + + case OP_NOT_WHITESPACE: + return next <= 127 && (cd->ctypes[next] & ctype_space) != 0; + + case OP_WORDCHAR: + return next > 127 || (cd->ctypes[next] & ctype_word) == 0; + + case OP_NOT_WORDCHAR: + return next <= 127 && (cd->ctypes[next] & ctype_word) != 0; + + case OP_HSPACE: + case OP_NOT_HSPACE: + switch(next) + { + case 0x09: + case 0x20: + case 0xa0: + case 0x1680: + case 0x180e: + case 0x2000: + case 0x2001: + case 0x2002: + case 0x2003: + case 0x2004: + case 0x2005: + case 0x2006: + case 0x2007: + case 0x2008: + case 0x2009: + case 0x200A: + case 0x202f: + case 0x205f: + case 0x3000: + return op_code != OP_HSPACE; + default: + return op_code == OP_HSPACE; + } + + case OP_VSPACE: + case OP_NOT_VSPACE: + switch(next) + { + case 0x0a: + case 0x0b: + case 0x0c: + case 0x0d: + case 0x85: + case 0x2028: + case 0x2029: + return op_code != OP_VSPACE; + default: + return op_code == OP_VSPACE; + } + + default: + return FALSE; + } + + +/* Handle the case when the next item is \d, \s, etc. */ + +switch(op_code) + { + case OP_CHAR: + case OP_CHARNC: +#ifdef SUPPORT_UTF8 + if (utf8 && item > 127) { GETCHAR(item, utf8_char); } +#endif + switch(-next) + { + case ESC_d: + return item > 127 || (cd->ctypes[item] & ctype_digit) == 0; + + case ESC_D: + return item <= 127 && (cd->ctypes[item] & ctype_digit) != 0; + + case ESC_s: + return item > 127 || (cd->ctypes[item] & ctype_space) == 0; + + case ESC_S: + return item <= 127 && (cd->ctypes[item] & ctype_space) != 0; + + case ESC_w: + return item > 127 || (cd->ctypes[item] & ctype_word) == 0; + + case ESC_W: + return item <= 127 && (cd->ctypes[item] & ctype_word) != 0; + + case ESC_h: + case ESC_H: + switch(item) + { + case 0x09: + case 0x20: + case 0xa0: + case 0x1680: + case 0x180e: + case 0x2000: + case 0x2001: + case 0x2002: + case 0x2003: + case 0x2004: + case 0x2005: + case 0x2006: + case 0x2007: + case 0x2008: + case 0x2009: + case 0x200A: + case 0x202f: + case 0x205f: + case 0x3000: + return -next != ESC_h; + default: + return -next == ESC_h; + } + + case ESC_v: + case ESC_V: + switch(item) + { + case 0x0a: + case 0x0b: + case 0x0c: + case 0x0d: + case 0x85: + case 0x2028: + case 0x2029: + return -next != ESC_v; + default: + return -next == ESC_v; + } + + default: + return FALSE; + } + + case OP_DIGIT: + return next == -ESC_D || next == -ESC_s || next == -ESC_W || + next == -ESC_h || next == -ESC_v; + + case OP_NOT_DIGIT: + return next == -ESC_d; + + case OP_WHITESPACE: + return next == -ESC_S || next == -ESC_d || next == -ESC_w; + + case OP_NOT_WHITESPACE: + return next == -ESC_s || next == -ESC_h || next == -ESC_v; + + case OP_HSPACE: + return next == -ESC_S || next == -ESC_H || next == -ESC_d || next == -ESC_w; + + case OP_NOT_HSPACE: + return next == -ESC_h; + + /* Can't have \S in here because VT matches \S (Perl anomaly) */ + case OP_VSPACE: + return next == -ESC_V || next == -ESC_d || next == -ESC_w; + + case OP_NOT_VSPACE: + return next == -ESC_v; + + case OP_WORDCHAR: + return next == -ESC_W || next == -ESC_s || next == -ESC_h || next == -ESC_v; + + case OP_NOT_WORDCHAR: + return next == -ESC_w || next == -ESC_d; + + default: + return FALSE; + } + +/* Control does not reach here */ +} + + + +/************************************************* +* Compile one branch * +*************************************************/ + +/* Scan the pattern, compiling it into the a vector. If the options are +changed during the branch, the pointer is used to change the external options +bits. This function is used during the pre-compile phase when we are trying +to find out the amount of memory needed, as well as during the real compile +phase. The value of lengthptr distinguishes the two phases. + +Arguments: + optionsptr pointer to the option bits + codeptr points to the pointer to the current code point + ptrptr points to the current pattern pointer + errorcodeptr points to error code variable + firstbyteptr set to initial literal character, or < 0 (REQ_UNSET, REQ_NONE) + reqbyteptr set to the last literal character required, else < 0 + bcptr points to current branch chain + cd contains pointers to tables etc. + lengthptr NULL during the real compile phase + points to length accumulator during pre-compile phase + +Returns: TRUE on success + FALSE, with *errorcodeptr set non-zero on error +*/ + +static BOOL +compile_branch(int *optionsptr, uschar **codeptr, const uschar **ptrptr, + int *errorcodeptr, int *firstbyteptr, int *reqbyteptr, branch_chain *bcptr, + compile_data *cd, int *lengthptr) +{ +int repeat_type, op_type; +int repeat_min = 0, repeat_max = 0; /* To please picky compilers */ +int bravalue = 0; +int greedy_default, greedy_non_default; +int firstbyte, reqbyte; +int zeroreqbyte, zerofirstbyte; +int req_caseopt, reqvary, tempreqvary; +int options = *optionsptr; +int after_manual_callout = 0; +int length_prevgroup = 0; +register int c; +register uschar *code = *codeptr; +uschar *last_code = code; +uschar *orig_code = code; +uschar *tempcode; +BOOL inescq = FALSE; +BOOL groupsetfirstbyte = FALSE; +const uschar *ptr = *ptrptr; +const uschar *tempptr; +uschar *previous = NULL; +uschar *previous_callout = NULL; +uschar *save_hwm = NULL; +uschar classbits[32]; + +#ifdef SUPPORT_UTF8 +BOOL class_utf8; +BOOL utf8 = (options & PCRE_UTF8) != 0; +uschar *class_utf8data; +uschar *class_utf8data_base; +uschar utf8_char[6]; +#else +BOOL utf8 = FALSE; +uschar *utf8_char = NULL; +#endif + +#ifdef DEBUG +if (lengthptr != NULL) DPRINTF((">> start branch\n")); +#endif + +/* Set up the default and non-default settings for greediness */ + +greedy_default = ((options & PCRE_UNGREEDY) != 0); +greedy_non_default = greedy_default ^ 1; + +/* Initialize no first byte, no required byte. REQ_UNSET means "no char +matching encountered yet". It gets changed to REQ_NONE if we hit something that +matches a non-fixed char first char; reqbyte just remains unset if we never +find one. + +When we hit a repeat whose minimum is zero, we may have to adjust these values +to take the zero repeat into account. This is implemented by setting them to +zerofirstbyte and zeroreqbyte when such a repeat is encountered. The individual +item types that can be repeated set these backoff variables appropriately. */ + +firstbyte = reqbyte = zerofirstbyte = zeroreqbyte = REQ_UNSET; + +/* The variable req_caseopt contains either the REQ_CASELESS value or zero, +according to the current setting of the caseless flag. REQ_CASELESS is a bit +value > 255. It is added into the firstbyte or reqbyte variables to record the +case status of the value. This is used only for ASCII characters. */ + +req_caseopt = ((options & PCRE_CASELESS) != 0)? REQ_CASELESS : 0; + +/* Switch on next character until the end of the branch */ + +for (;; ptr++) + { + BOOL negate_class; + BOOL should_flip_negation; + BOOL possessive_quantifier; + BOOL is_quantifier; + BOOL is_recurse; + BOOL reset_bracount; + int class_charcount; + int class_lastchar; + int newoptions; + int recno; + int refsign; + int skipbytes; + int subreqbyte; + int subfirstbyte; + int terminator; + int mclength; + uschar mcbuffer[8]; + + /* Get next byte in the pattern */ + + c = *ptr; + + /* If we are in the pre-compile phase, accumulate the length used for the + previous cycle of this loop. */ + + if (lengthptr != NULL) + { +#ifdef DEBUG + if (code > cd->hwm) cd->hwm = code; /* High water info */ +#endif + if (code > cd->start_workspace + COMPILE_WORK_SIZE) /* Check for overrun */ + { + *errorcodeptr = ERR52; + goto FAILED; + } + + /* There is at least one situation where code goes backwards: this is the + case of a zero quantifier after a class (e.g. [ab]{0}). At compile time, + the class is simply eliminated. However, it is created first, so we have to + allow memory for it. Therefore, don't ever reduce the length at this point. + */ + + if (code < last_code) code = last_code; + + /* Paranoid check for integer overflow */ + + if (OFLOW_MAX - *lengthptr < code - last_code) + { + *errorcodeptr = ERR20; + goto FAILED; + } + + *lengthptr += code - last_code; + DPRINTF(("length=%d added %d c=%c\n", *lengthptr, code - last_code, c)); + + /* If "previous" is set and it is not at the start of the work space, move + it back to there, in order to avoid filling up the work space. Otherwise, + if "previous" is NULL, reset the current code pointer to the start. */ + + if (previous != NULL) + { + if (previous > orig_code) + { + memmove(orig_code, previous, code - previous); + code -= previous - orig_code; + previous = orig_code; + } + } + else code = orig_code; + + /* Remember where this code item starts so we can pick up the length + next time round. */ + + last_code = code; + } + + /* In the real compile phase, just check the workspace used by the forward + reference list. */ + + else if (cd->hwm > cd->start_workspace + COMPILE_WORK_SIZE) + { + *errorcodeptr = ERR52; + goto FAILED; + } + + /* If in \Q...\E, check for the end; if not, we have a literal */ + + if (inescq && c != 0) + { + if (c == '\\' && ptr[1] == 'E') + { + inescq = FALSE; + ptr++; + continue; + } + else + { + if (previous_callout != NULL) + { + if (lengthptr == NULL) /* Don't attempt in pre-compile phase */ + complete_callout(previous_callout, ptr, cd); + previous_callout = NULL; + } + if ((options & PCRE_AUTO_CALLOUT) != 0) + { + previous_callout = code; + code = auto_callout(code, ptr, cd); + } + goto NORMAL_CHAR; + } + } + + /* Fill in length of a previous callout, except when the next thing is + a quantifier. */ + + is_quantifier = c == '*' || c == '+' || c == '?' || + (c == '{' && is_counted_repeat(ptr+1)); + + if (!is_quantifier && previous_callout != NULL && + after_manual_callout-- <= 0) + { + if (lengthptr == NULL) /* Don't attempt in pre-compile phase */ + complete_callout(previous_callout, ptr, cd); + previous_callout = NULL; + } + + /* In extended mode, skip white space and comments */ + + if ((options & PCRE_EXTENDED) != 0) + { + if ((cd->ctypes[c] & ctype_space) != 0) continue; + if (c == '#') + { + while (*(++ptr) != 0) + { + if (IS_NEWLINE(ptr)) { ptr += cd->nllen - 1; break; } + } + if (*ptr != 0) continue; + + /* Else fall through to handle end of string */ + c = 0; + } + } + + /* No auto callout for quantifiers. */ + + if ((options & PCRE_AUTO_CALLOUT) != 0 && !is_quantifier) + { + previous_callout = code; + code = auto_callout(code, ptr, cd); + } + + switch(c) + { + /* ===================================================================*/ + case 0: /* The branch terminates at string end */ + case '|': /* or | or ) */ + case ')': + *firstbyteptr = firstbyte; + *reqbyteptr = reqbyte; + *codeptr = code; + *ptrptr = ptr; + if (lengthptr != NULL) + { + if (OFLOW_MAX - *lengthptr < code - last_code) + { + *errorcodeptr = ERR20; + goto FAILED; + } + *lengthptr += code - last_code; /* To include callout length */ + DPRINTF((">> end branch\n")); + } + return TRUE; + + + /* ===================================================================*/ + /* Handle single-character metacharacters. In multiline mode, ^ disables + the setting of any following char as a first character. */ + + case '^': + if ((options & PCRE_MULTILINE) != 0) + { + if (firstbyte == REQ_UNSET) firstbyte = REQ_NONE; + } + previous = NULL; + *code++ = OP_CIRC; + break; + + case '$': + previous = NULL; + *code++ = OP_DOLL; + break; + + /* There can never be a first char if '.' is first, whatever happens about + repeats. The value of reqbyte doesn't change either. */ + + case '.': + if (firstbyte == REQ_UNSET) firstbyte = REQ_NONE; + zerofirstbyte = firstbyte; + zeroreqbyte = reqbyte; + previous = code; + *code++ = OP_ANY; + break; + + + /* ===================================================================*/ + /* Character classes. If the included characters are all < 256, we build a + 32-byte bitmap of the permitted characters, except in the special case + where there is only one such character. For negated classes, we build the + map as usual, then invert it at the end. However, we use a different opcode + so that data characters > 255 can be handled correctly. + + If the class contains characters outside the 0-255 range, a different + opcode is compiled. It may optionally have a bit map for characters < 256, + but those above are are explicitly listed afterwards. A flag byte tells + whether the bitmap is present, and whether this is a negated class or not. + */ + + case '[': + previous = code; + + /* PCRE supports POSIX class stuff inside a class. Perl gives an error if + they are encountered at the top level, so we'll do that too. */ + + if ((ptr[1] == ':' || ptr[1] == '.' || ptr[1] == '=') && + check_posix_syntax(ptr, &tempptr)) + { + *errorcodeptr = (ptr[1] == ':')? ERR13 : ERR31; + goto FAILED; + } + + /* If the first character is '^', set the negation flag and skip it. Also, + if the first few characters (either before or after ^) are \Q\E or \E we + skip them too. This makes for compatibility with Perl. */ + + negate_class = FALSE; + for (;;) + { + c = *(++ptr); + if (c == '\\') + { + if (ptr[1] == 'E') ptr++; + else if (strncmp((const char *)ptr+1, "Q\\E", 3) == 0) ptr += 3; + else break; + } + else if (!negate_class && c == '^') + negate_class = TRUE; + else break; + } + + /* If a class contains a negative special such as \S, we need to flip the + negation flag at the end, so that support for characters > 255 works + correctly (they are all included in the class). */ + + should_flip_negation = FALSE; + + /* Keep a count of chars with values < 256 so that we can optimize the case + of just a single character (as long as it's < 256). However, For higher + valued UTF-8 characters, we don't yet do any optimization. */ + + class_charcount = 0; + class_lastchar = -1; + + /* Initialize the 32-char bit map to all zeros. We build the map in a + temporary bit of memory, in case the class contains only 1 character (less + than 256), because in that case the compiled code doesn't use the bit map. + */ + + memset(classbits, 0, 32 * sizeof(uschar)); + +#ifdef SUPPORT_UTF8 + class_utf8 = FALSE; /* No chars >= 256 */ + class_utf8data = code + LINK_SIZE + 2; /* For UTF-8 items */ + class_utf8data_base = class_utf8data; /* For resetting in pass 1 */ +#endif + + /* Process characters until ] is reached. By writing this as a "do" it + means that an initial ] is taken as a data character. At the start of the + loop, c contains the first byte of the character. */ + + if (c != 0) do + { + const uschar *oldptr; + +#ifdef SUPPORT_UTF8 + if (utf8 && c > 127) + { /* Braces are required because the */ + GETCHARLEN(c, ptr, ptr); /* macro generates multiple statements */ + } + + /* In the pre-compile phase, accumulate the length of any UTF-8 extra + data and reset the pointer. This is so that very large classes that + contain a zillion UTF-8 characters no longer overwrite the work space + (which is on the stack). */ + + if (lengthptr != NULL) + { + *lengthptr += class_utf8data - class_utf8data_base; + class_utf8data = class_utf8data_base; + } + +#endif + + /* Inside \Q...\E everything is literal except \E */ + + if (inescq) + { + if (c == '\\' && ptr[1] == 'E') /* If we are at \E */ + { + inescq = FALSE; /* Reset literal state */ + ptr++; /* Skip the 'E' */ + continue; /* Carry on with next */ + } + goto CHECK_RANGE; /* Could be range if \E follows */ + } + + /* Handle POSIX class names. Perl allows a negation extension of the + form [:^name:]. A square bracket that doesn't match the syntax is + treated as a literal. We also recognize the POSIX constructions + [.ch.] and [=ch=] ("collating elements") and fault them, as Perl + 5.6 and 5.8 do. */ + + if (c == '[' && + (ptr[1] == ':' || ptr[1] == '.' || ptr[1] == '=') && + check_posix_syntax(ptr, &tempptr)) + { + BOOL local_negate = FALSE; + int posix_class, taboffset, tabopt; + register const uschar *cbits = cd->cbits; + uschar pbits[32]; + + if (ptr[1] != ':') + { + *errorcodeptr = ERR31; + goto FAILED; + } + + ptr += 2; + if (*ptr == '^') + { + local_negate = TRUE; + should_flip_negation = TRUE; /* Note negative special */ + ptr++; + } + + posix_class = check_posix_name(ptr, tempptr - ptr); + if (posix_class < 0) + { + *errorcodeptr = ERR30; + goto FAILED; + } + + /* If matching is caseless, upper and lower are converted to + alpha. This relies on the fact that the class table starts with + alpha, lower, upper as the first 3 entries. */ + + if ((options & PCRE_CASELESS) != 0 && posix_class <= 2) + posix_class = 0; + + /* We build the bit map for the POSIX class in a chunk of local store + because we may be adding and subtracting from it, and we don't want to + subtract bits that may be in the main map already. At the end we or the + result into the bit map that is being built. */ + + posix_class *= 3; + + /* Copy in the first table (always present) */ + + memcpy(pbits, cbits + posix_class_maps[posix_class], + 32 * sizeof(uschar)); + + /* If there is a second table, add or remove it as required. */ + + taboffset = posix_class_maps[posix_class + 1]; + tabopt = posix_class_maps[posix_class + 2]; + + if (taboffset >= 0) + { + if (tabopt >= 0) + for (c = 0; c < 32; c++) pbits[c] |= cbits[c + taboffset]; + else + for (c = 0; c < 32; c++) pbits[c] &= ~cbits[c + taboffset]; + } + + /* Not see if we need to remove any special characters. An option + value of 1 removes vertical space and 2 removes underscore. */ + + if (tabopt < 0) tabopt = -tabopt; + if (tabopt == 1) pbits[1] &= ~0x3c; + else if (tabopt == 2) pbits[11] &= 0x7f; + + /* Add the POSIX table or its complement into the main table that is + being built and we are done. */ + + if (local_negate) + for (c = 0; c < 32; c++) classbits[c] |= ~pbits[c]; + else + for (c = 0; c < 32; c++) classbits[c] |= pbits[c]; + + ptr = tempptr + 1; + class_charcount = 10; /* Set > 1; assumes more than 1 per class */ + continue; /* End of POSIX syntax handling */ + } + + /* Backslash may introduce a single character, or it may introduce one + of the specials, which just set a flag. The sequence \b is a special + case. Inside a class (and only there) it is treated as backspace. + Elsewhere it marks a word boundary. Other escapes have preset maps ready + to 'or' into the one we are building. We assume they have more than one + character in them, so set class_charcount bigger than one. */ + + if (c == '\\') + { + c = check_escape(&ptr, errorcodeptr, cd->bracount, options, TRUE); + if (*errorcodeptr != 0) goto FAILED; + + if (-c == ESC_b) c = '\b'; /* \b is backspace in a class */ + else if (-c == ESC_X) c = 'X'; /* \X is literal X in a class */ + else if (-c == ESC_R) c = 'R'; /* \R is literal R in a class */ + else if (-c == ESC_Q) /* Handle start of quoted string */ + { + if (ptr[1] == '\\' && ptr[2] == 'E') + { + ptr += 2; /* avoid empty string */ + } + else inescq = TRUE; + continue; + } + else if (-c == ESC_E) continue; /* Ignore orphan \E */ + + if (c < 0) + { + register const uschar *cbits = cd->cbits; + class_charcount += 2; /* Greater than 1 is what matters */ + + /* Save time by not doing this in the pre-compile phase. */ + + if (lengthptr == NULL) switch (-c) + { + case ESC_d: + for (c = 0; c < 32; c++) classbits[c] |= cbits[c+cbit_digit]; + continue; + + case ESC_D: + should_flip_negation = TRUE; + for (c = 0; c < 32; c++) classbits[c] |= ~cbits[c+cbit_digit]; + continue; + + case ESC_w: + for (c = 0; c < 32; c++) classbits[c] |= cbits[c+cbit_word]; + continue; + + case ESC_W: + should_flip_negation = TRUE; + for (c = 0; c < 32; c++) classbits[c] |= ~cbits[c+cbit_word]; + continue; + + case ESC_s: + for (c = 0; c < 32; c++) classbits[c] |= cbits[c+cbit_space]; + classbits[1] &= ~0x08; /* Perl 5.004 onwards omits VT from \s */ + continue; + + case ESC_S: + should_flip_negation = TRUE; + for (c = 0; c < 32; c++) classbits[c] |= ~cbits[c+cbit_space]; + classbits[1] |= 0x08; /* Perl 5.004 onwards omits VT from \s */ + continue; + + default: /* Not recognized; fall through */ + break; /* Need "default" setting to stop compiler warning. */ + } + + /* In the pre-compile phase, just do the recognition. */ + + else if (c == -ESC_d || c == -ESC_D || c == -ESC_w || + c == -ESC_W || c == -ESC_s || c == -ESC_S) continue; + + /* We need to deal with \H, \h, \V, and \v in both phases because + they use extra memory. */ + + if (-c == ESC_h) + { + SETBIT(classbits, 0x09); /* VT */ + SETBIT(classbits, 0x20); /* SPACE */ + SETBIT(classbits, 0xa0); /* NSBP */ +#ifdef SUPPORT_UTF8 + if (utf8) + { + class_utf8 = TRUE; + *class_utf8data++ = XCL_SINGLE; + class_utf8data += _erts_pcre_ord2utf8(0x1680, class_utf8data); + *class_utf8data++ = XCL_SINGLE; + class_utf8data += _erts_pcre_ord2utf8(0x180e, class_utf8data); + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x2000, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x200A, class_utf8data); + *class_utf8data++ = XCL_SINGLE; + class_utf8data += _erts_pcre_ord2utf8(0x202f, class_utf8data); + *class_utf8data++ = XCL_SINGLE; + class_utf8data += _erts_pcre_ord2utf8(0x205f, class_utf8data); + *class_utf8data++ = XCL_SINGLE; + class_utf8data += _erts_pcre_ord2utf8(0x3000, class_utf8data); + } +#endif + continue; + } + + if (-c == ESC_H) + { + for (c = 0; c < 32; c++) + { + int x = 0xff; + switch (c) + { + case 0x09/8: x ^= 1 << (0x09%8); break; + case 0x20/8: x ^= 1 << (0x20%8); break; + case 0xa0/8: x ^= 1 << (0xa0%8); break; + default: break; + } + classbits[c] |= x; + } + +#ifdef SUPPORT_UTF8 + if (utf8) + { + class_utf8 = TRUE; + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x0100, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x167f, class_utf8data); + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x1681, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x180d, class_utf8data); + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x180f, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x1fff, class_utf8data); + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x200B, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x202e, class_utf8data); + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x2030, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x205e, class_utf8data); + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x2060, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x2fff, class_utf8data); + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x3001, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x7fffffff, class_utf8data); + } +#endif + continue; + } + + if (-c == ESC_v) + { + SETBIT(classbits, 0x0a); /* LF */ + SETBIT(classbits, 0x0b); /* VT */ + SETBIT(classbits, 0x0c); /* FF */ + SETBIT(classbits, 0x0d); /* CR */ + SETBIT(classbits, 0x85); /* NEL */ +#ifdef SUPPORT_UTF8 + if (utf8) + { + class_utf8 = TRUE; + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x2028, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x2029, class_utf8data); + } +#endif + continue; + } + + if (-c == ESC_V) + { + for (c = 0; c < 32; c++) + { + int x = 0xff; + switch (c) + { + case 0x0a/8: x ^= 1 << (0x0a%8); + x ^= 1 << (0x0b%8); + x ^= 1 << (0x0c%8); + x ^= 1 << (0x0d%8); + break; + case 0x85/8: x ^= 1 << (0x85%8); break; + default: break; + } + classbits[c] |= x; + } + +#ifdef SUPPORT_UTF8 + if (utf8) + { + class_utf8 = TRUE; + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x0100, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x2027, class_utf8data); + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(0x2029, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(0x7fffffff, class_utf8data); + } +#endif + continue; + } + + /* We need to deal with \P and \p in both phases. */ + +#ifdef SUPPORT_UCP + if (-c == ESC_p || -c == ESC_P) + { + BOOL negated; + int pdata; + int ptype = get_ucp(&ptr, &negated, &pdata, errorcodeptr); + if (ptype < 0) goto FAILED; + class_utf8 = TRUE; + *class_utf8data++ = ((-c == ESC_p) != negated)? + XCL_PROP : XCL_NOTPROP; + *class_utf8data++ = ptype; + *class_utf8data++ = pdata; + class_charcount -= 2; /* Not a < 256 character */ + continue; + } +#endif + /* Unrecognized escapes are faulted if PCRE is running in its + strict mode. By default, for compatibility with Perl, they are + treated as literals. */ + + if ((options & PCRE_EXTRA) != 0) + { + *errorcodeptr = ERR7; + goto FAILED; + } + + class_charcount -= 2; /* Undo the default count from above */ + c = *ptr; /* Get the final character and fall through */ + } + + /* Fall through if we have a single character (c >= 0). This may be + greater than 256 in UTF-8 mode. */ + + } /* End of backslash handling */ + + /* A single character may be followed by '-' to form a range. However, + Perl does not permit ']' to be the end of the range. A '-' character + at the end is treated as a literal. Perl ignores orphaned \E sequences + entirely. The code for handling \Q and \E is messy. */ + + CHECK_RANGE: + while (ptr[1] == '\\' && ptr[2] == 'E') + { + inescq = FALSE; + ptr += 2; + } + + oldptr = ptr; + + /* Remember \r or \n */ + + if (c == '\r' || c == '\n') cd->external_flags |= PCRE_HASCRORLF; + + /* Check for range */ + + if (!inescq && ptr[1] == '-') + { + int d; + ptr += 2; + while (*ptr == '\\' && ptr[1] == 'E') ptr += 2; + + /* If we hit \Q (not followed by \E) at this point, go into escaped + mode. */ + + while (*ptr == '\\' && ptr[1] == 'Q') + { + ptr += 2; + if (*ptr == '\\' && ptr[1] == 'E') { ptr += 2; continue; } + inescq = TRUE; + break; + } + + if (*ptr == 0 || (!inescq && *ptr == ']')) + { + ptr = oldptr; + goto LONE_SINGLE_CHARACTER; + } + +#ifdef SUPPORT_UTF8 + if (utf8) + { /* Braces are required because the */ + GETCHARLEN(d, ptr, ptr); /* macro generates multiple statements */ + } + else +#endif + d = *ptr; /* Not UTF-8 mode */ + + /* The second part of a range can be a single-character escape, but + not any of the other escapes. Perl 5.6 treats a hyphen as a literal + in such circumstances. */ + + if (!inescq && d == '\\') + { + d = check_escape(&ptr, errorcodeptr, cd->bracount, options, TRUE); + if (*errorcodeptr != 0) goto FAILED; + + /* \b is backspace; \X is literal X; \R is literal R; any other + special means the '-' was literal */ + + if (d < 0) + { + if (d == -ESC_b) d = '\b'; + else if (d == -ESC_X) d = 'X'; + else if (d == -ESC_R) d = 'R'; else + { + ptr = oldptr; + goto LONE_SINGLE_CHARACTER; /* A few lines below */ + } + } + } + + /* Check that the two values are in the correct order. Optimize + one-character ranges */ + + if (d < c) + { + *errorcodeptr = ERR8; + goto FAILED; + } + + if (d == c) goto LONE_SINGLE_CHARACTER; /* A few lines below */ + + /* Remember \r or \n */ + + if (d == '\r' || d == '\n') cd->external_flags |= PCRE_HASCRORLF; + + /* In UTF-8 mode, if the upper limit is > 255, or > 127 for caseless + matching, we have to use an XCLASS with extra data items. Caseless + matching for characters > 127 is available only if UCP support is + available. */ + +#ifdef SUPPORT_UTF8 + if (utf8 && (d > 255 || ((options & PCRE_CASELESS) != 0 && d > 127))) + { + class_utf8 = TRUE; + + /* With UCP support, we can find the other case equivalents of + the relevant characters. There may be several ranges. Optimize how + they fit with the basic range. */ + +#ifdef SUPPORT_UCP + if ((options & PCRE_CASELESS) != 0) + { + unsigned int occ, ocd; + unsigned int cc = c; + unsigned int origd = d; + while (get_othercase_range(&cc, origd, &occ, &ocd)) + { + if (occ >= (unsigned int)c && + ocd <= (unsigned int)d) + continue; /* Skip embedded ranges */ + + if (occ < (unsigned int)c && + ocd >= (unsigned int)c - 1) /* Extend the basic range */ + { /* if there is overlap, */ + c = occ; /* noting that if occ < c */ + continue; /* we can't have ocd > d */ + } /* because a subrange is */ + if (ocd > (unsigned int)d && + occ <= (unsigned int)d + 1) /* always shorter than */ + { /* the basic range. */ + d = ocd; + continue; + } + + if (occ == ocd) + { + *class_utf8data++ = XCL_SINGLE; + } + else + { + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(occ, class_utf8data); + } + class_utf8data += _erts_pcre_ord2utf8(ocd, class_utf8data); + } + } +#endif /* SUPPORT_UCP */ + + /* Now record the original range, possibly modified for UCP caseless + overlapping ranges. */ + + *class_utf8data++ = XCL_RANGE; + class_utf8data += _erts_pcre_ord2utf8(c, class_utf8data); + class_utf8data += _erts_pcre_ord2utf8(d, class_utf8data); + + /* With UCP support, we are done. Without UCP support, there is no + caseless matching for UTF-8 characters > 127; we can use the bit map + for the smaller ones. */ + +#ifdef SUPPORT_UCP + continue; /* With next character in the class */ +#else + if ((options & PCRE_CASELESS) == 0 || c > 127) continue; + + /* Adjust upper limit and fall through to set up the map */ + + d = 127; + +#endif /* SUPPORT_UCP */ + } +#endif /* SUPPORT_UTF8 */ + + /* We use the bit map for all cases when not in UTF-8 mode; else + ranges that lie entirely within 0-127 when there is UCP support; else + for partial ranges without UCP support. */ + + class_charcount += d - c + 1; + class_lastchar = d; + + /* We can save a bit of time by skipping this in the pre-compile. */ + + if (lengthptr == NULL) for (; c <= d; c++) + { + classbits[c/8] |= (1 << (c&7)); + if ((options & PCRE_CASELESS) != 0) + { + int uc = cd->fcc[c]; /* flip case */ + classbits[uc/8] |= (1 << (uc&7)); + } + } + + continue; /* Go get the next char in the class */ + } + + /* Handle a lone single character - we can get here for a normal + non-escape char, or after \ that introduces a single character or for an + apparent range that isn't. */ + + LONE_SINGLE_CHARACTER: + + /* Handle a character that cannot go in the bit map */ + +#ifdef SUPPORT_UTF8 + if (utf8 && (c > 255 || ((options & PCRE_CASELESS) != 0 && c > 127))) + { + class_utf8 = TRUE; + *class_utf8data++ = XCL_SINGLE; + class_utf8data += _erts_pcre_ord2utf8(c, class_utf8data); + +#ifdef SUPPORT_UCP + if ((options & PCRE_CASELESS) != 0) + { + unsigned int othercase; + if ((othercase = _erts_pcre_ucp_othercase(c)) != NOTACHAR) + { + *class_utf8data++ = XCL_SINGLE; + class_utf8data += _erts_pcre_ord2utf8(othercase, class_utf8data); + } + } +#endif /* SUPPORT_UCP */ + + } + else +#endif /* SUPPORT_UTF8 */ + + /* Handle a single-byte character */ + { + classbits[c/8] |= (1 << (c&7)); + if ((options & PCRE_CASELESS) != 0) + { + c = cd->fcc[c]; /* flip case */ + classbits[c/8] |= (1 << (c&7)); + } + class_charcount++; + class_lastchar = c; + } + } + + /* Loop until ']' reached. This "while" is the end of the "do" above. */ + + while ((c = *(++ptr)) != 0 && (c != ']' || inescq)); + + if (c == 0) /* Missing terminating ']' */ + { + *errorcodeptr = ERR6; + goto FAILED; + } + + +/* This code has been disabled because it would mean that \s counts as +an explicit \r or \n reference, and that's not really what is wanted. Now +we set the flag only if there is a literal "\r" or "\n" in the class. */ + +#if 0 + /* Remember whether \r or \n are in this class */ + + if (negate_class) + { + if ((classbits[1] & 0x24) != 0x24) cd->external_flags |= PCRE_HASCRORLF; + } + else + { + if ((classbits[1] & 0x24) != 0) cd->external_flags |= PCRE_HASCRORLF; + } +#endif + + + /* If class_charcount is 1, we saw precisely one character whose value is + less than 256. As long as there were no characters >= 128 and there was no + use of \p or \P, in other words, no use of any XCLASS features, we can + optimize. + + In UTF-8 mode, we can optimize the negative case only if there were no + characters >= 128 because OP_NOT and the related opcodes like OP_NOTSTAR + operate on single-bytes only. This is an historical hangover. Maybe one day + we can tidy these opcodes to handle multi-byte characters. + + The optimization throws away the bit map. We turn the item into a + 1-character OP_CHAR[NC] if it's positive, or OP_NOT if it's negative. Note + that OP_NOT does not support multibyte characters. In the positive case, it + can cause firstbyte to be set. Otherwise, there can be no first char if + this item is first, whatever repeat count may follow. In the case of + reqbyte, save the previous value for reinstating. */ + +#ifdef SUPPORT_UTF8 + if (class_charcount == 1 && !class_utf8 && + (!utf8 || !negate_class || class_lastchar < 128)) +#else + if (class_charcount == 1) +#endif + { + zeroreqbyte = reqbyte; + + /* The OP_NOT opcode works on one-byte characters only. */ + + if (negate_class) + { + if (firstbyte == REQ_UNSET) firstbyte = REQ_NONE; + zerofirstbyte = firstbyte; + *code++ = OP_NOT; + *code++ = class_lastchar; + break; + } + + /* For a single, positive character, get the value into mcbuffer, and + then we can handle this with the normal one-character code. */ + +#ifdef SUPPORT_UTF8 + if (utf8 && class_lastchar > 127) + mclength = _erts_pcre_ord2utf8(class_lastchar, mcbuffer); + else +#endif + { + mcbuffer[0] = class_lastchar; + mclength = 1; + } + goto ONE_CHAR; + } /* End of 1-char optimization */ + + /* The general case - not the one-char optimization. If this is the first + thing in the branch, there can be no first char setting, whatever the + repeat count. Any reqbyte setting must remain unchanged after any kind of + repeat. */ + + if (firstbyte == REQ_UNSET) firstbyte = REQ_NONE; + zerofirstbyte = firstbyte; + zeroreqbyte = reqbyte; + + /* If there are characters with values > 255, we have to compile an + extended class, with its own opcode, unless there was a negated special + such as \S in the class, because in that case all characters > 255 are in + the class, so any that were explicitly given as well can be ignored. If + (when there are explicit characters > 255 that must be listed) there are no + characters < 256, we can omit the bitmap in the actual compiled code. */ + +#ifdef SUPPORT_UTF8 + if (class_utf8 && !should_flip_negation) + { + *class_utf8data++ = XCL_END; /* Marks the end of extra data */ + *code++ = OP_XCLASS; + code += LINK_SIZE; + *code = negate_class? XCL_NOT : 0; + + /* If the map is required, move up the extra data to make room for it; + otherwise just move the code pointer to the end of the extra data. */ + + if (class_charcount > 0) + { + *code++ |= XCL_MAP; + memmove(code + 32, code, class_utf8data - code); + memcpy(code, classbits, 32); + code = class_utf8data + 32; + } + else code = class_utf8data; + + /* Now fill in the complete length of the item */ + + PUT(previous, 1, code - previous); + break; /* End of class handling */ + } +#endif + + /* If there are no characters > 255, set the opcode to OP_CLASS or + OP_NCLASS, depending on whether the whole class was negated and whether + there were negative specials such as \S in the class. Then copy the 32-byte + map into the code vector, negating it if necessary. */ + + *code++ = (negate_class == should_flip_negation) ? OP_CLASS : OP_NCLASS; + if (negate_class) + { + if (lengthptr == NULL) /* Save time in the pre-compile phase */ + for (c = 0; c < 32; c++) code[c] = ~classbits[c]; + } + else + { + memcpy(code, classbits, 32); + } + code += 32; + break; + + + /* ===================================================================*/ + /* Various kinds of repeat; '{' is not necessarily a quantifier, but this + has been tested above. */ + + case '{': + if (!is_quantifier) goto NORMAL_CHAR; + ptr = read_repeat_counts(ptr+1, &repeat_min, &repeat_max, errorcodeptr); + if (*errorcodeptr != 0) goto FAILED; + goto REPEAT; + + case '*': + repeat_min = 0; + repeat_max = -1; + goto REPEAT; + + case '+': + repeat_min = 1; + repeat_max = -1; + goto REPEAT; + + case '?': + repeat_min = 0; + repeat_max = 1; + + REPEAT: + if (previous == NULL) + { + *errorcodeptr = ERR9; + goto FAILED; + } + + if (repeat_min == 0) + { + firstbyte = zerofirstbyte; /* Adjust for zero repeat */ + reqbyte = zeroreqbyte; /* Ditto */ + } + + /* Remember whether this is a variable length repeat */ + + reqvary = (repeat_min == repeat_max)? 0 : REQ_VARY; + + op_type = 0; /* Default single-char op codes */ + possessive_quantifier = FALSE; /* Default not possessive quantifier */ + + /* Save start of previous item, in case we have to move it up to make space + for an inserted OP_ONCE for the additional '+' extension. */ + + tempcode = previous; + + /* If the next character is '+', we have a possessive quantifier. This + implies greediness, whatever the setting of the PCRE_UNGREEDY option. + If the next character is '?' this is a minimizing repeat, by default, + but if PCRE_UNGREEDY is set, it works the other way round. We change the + repeat type to the non-default. */ + + if (ptr[1] == '+') + { + repeat_type = 0; /* Force greedy */ + possessive_quantifier = TRUE; + ptr++; + } + else if (ptr[1] == '?') + { + repeat_type = greedy_non_default; + ptr++; + } + else repeat_type = greedy_default; + + /* If previous was a character match, abolish the item and generate a + repeat item instead. If a char item has a minumum of more than one, ensure + that it is set in reqbyte - it might not be if a sequence such as x{3} is + the first thing in a branch because the x will have gone into firstbyte + instead. */ + + if (*previous == OP_CHAR || *previous == OP_CHARNC) + { + /* Deal with UTF-8 characters that take up more than one byte. It's + easier to write this out separately than try to macrify it. Use c to + hold the length of the character in bytes, plus 0x80 to flag that it's a + length rather than a small character. */ + +#ifdef SUPPORT_UTF8 + if (utf8 && (code[-1] & 0x80) != 0) + { + uschar *lastchar = code - 1; + while((*lastchar & 0xc0) == 0x80) lastchar--; + c = code - lastchar; /* Length of UTF-8 character */ + memcpy(utf8_char, lastchar, c); /* Save the char */ + c |= 0x80; /* Flag c as a length */ + } + else +#endif + + /* Handle the case of a single byte - either with no UTF8 support, or + with UTF-8 disabled, or for a UTF-8 character < 128. */ + + { + c = code[-1]; + if (repeat_min > 1) reqbyte = c | req_caseopt | cd->req_varyopt; + } + + /* If the repetition is unlimited, it pays to see if the next thing on + the line is something that cannot possibly match this character. If so, + automatically possessifying this item gains some performance in the case + where the match fails. */ + + if (!possessive_quantifier && + repeat_max < 0 && + check_auto_possessive(*previous, c, utf8, utf8_char, ptr + 1, + options, cd)) + { + repeat_type = 0; /* Force greedy */ + possessive_quantifier = TRUE; + } + + goto OUTPUT_SINGLE_REPEAT; /* Code shared with single character types */ + } + + /* If previous was a single negated character ([^a] or similar), we use + one of the special opcodes, replacing it. The code is shared with single- + character repeats by setting opt_type to add a suitable offset into + repeat_type. We can also test for auto-possessification. OP_NOT is + currently used only for single-byte chars. */ + + else if (*previous == OP_NOT) + { + op_type = OP_NOTSTAR - OP_STAR; /* Use "not" opcodes */ + c = previous[1]; + if (!possessive_quantifier && + repeat_max < 0 && + check_auto_possessive(OP_NOT, c, utf8, NULL, ptr + 1, options, cd)) + { + repeat_type = 0; /* Force greedy */ + possessive_quantifier = TRUE; + } + goto OUTPUT_SINGLE_REPEAT; + } + + /* If previous was a character type match (\d or similar), abolish it and + create a suitable repeat item. The code is shared with single-character + repeats by setting op_type to add a suitable offset into repeat_type. Note + the the Unicode property types will be present only when SUPPORT_UCP is + defined, but we don't wrap the little bits of code here because it just + makes it horribly messy. */ + + else if (*previous < OP_EODN) + { + uschar *oldcode; + int prop_type, prop_value; + op_type = OP_TYPESTAR - OP_STAR; /* Use type opcodes */ + c = *previous; + + if (!possessive_quantifier && + repeat_max < 0 && + check_auto_possessive(c, 0, utf8, NULL, ptr + 1, options, cd)) + { + repeat_type = 0; /* Force greedy */ + possessive_quantifier = TRUE; + } + + OUTPUT_SINGLE_REPEAT: + if (*previous == OP_PROP || *previous == OP_NOTPROP) + { + prop_type = previous[1]; + prop_value = previous[2]; + } + else prop_type = prop_value = -1; + + oldcode = code; + code = previous; /* Usually overwrite previous item */ + + /* If the maximum is zero then the minimum must also be zero; Perl allows + this case, so we do too - by simply omitting the item altogether. */ + + if (repeat_max == 0) goto END_REPEAT; + + /* All real repeats make it impossible to handle partial matching (maybe + one day we will be able to remove this restriction). */ + + if (repeat_max != 1) cd->external_flags |= PCRE_NOPARTIAL; + + /* Combine the op_type with the repeat_type */ + + repeat_type += op_type; + + /* A minimum of zero is handled either as the special case * or ?, or as + an UPTO, with the maximum given. */ + + if (repeat_min == 0) + { + if (repeat_max == -1) *code++ = OP_STAR + repeat_type; + else if (repeat_max == 1) *code++ = OP_QUERY + repeat_type; + else + { + *code++ = OP_UPTO + repeat_type; + PUT2INC(code, 0, repeat_max); + } + } + + /* A repeat minimum of 1 is optimized into some special cases. If the + maximum is unlimited, we use OP_PLUS. Otherwise, the original item is + left in place and, if the maximum is greater than 1, we use OP_UPTO with + one less than the maximum. */ + + else if (repeat_min == 1) + { + if (repeat_max == -1) + *code++ = OP_PLUS + repeat_type; + else + { + code = oldcode; /* leave previous item in place */ + if (repeat_max == 1) goto END_REPEAT; + *code++ = OP_UPTO + repeat_type; + PUT2INC(code, 0, repeat_max - 1); + } + } + + /* The case {n,n} is just an EXACT, while the general case {n,m} is + handled as an EXACT followed by an UPTO. */ + + else + { + *code++ = OP_EXACT + op_type; /* NB EXACT doesn't have repeat_type */ + PUT2INC(code, 0, repeat_min); + + /* If the maximum is unlimited, insert an OP_STAR. Before doing so, + we have to insert the character for the previous code. For a repeated + Unicode property match, there are two extra bytes that define the + required property. In UTF-8 mode, long characters have their length in + c, with the 0x80 bit as a flag. */ + + if (repeat_max < 0) + { +#ifdef SUPPORT_UTF8 + if (utf8 && c >= 128) + { + memcpy(code, utf8_char, c & 7); + code += c & 7; + } + else +#endif + { + *code++ = c; + if (prop_type >= 0) + { + *code++ = prop_type; + *code++ = prop_value; + } + } + *code++ = OP_STAR + repeat_type; + } + + /* Else insert an UPTO if the max is greater than the min, again + preceded by the character, for the previously inserted code. If the + UPTO is just for 1 instance, we can use QUERY instead. */ + + else if (repeat_max != repeat_min) + { +#ifdef SUPPORT_UTF8 + if (utf8 && c >= 128) + { + memcpy(code, utf8_char, c & 7); + code += c & 7; + } + else +#endif + *code++ = c; + if (prop_type >= 0) + { + *code++ = prop_type; + *code++ = prop_value; + } + repeat_max -= repeat_min; + + if (repeat_max == 1) + { + *code++ = OP_QUERY + repeat_type; + } + else + { + *code++ = OP_UPTO + repeat_type; + PUT2INC(code, 0, repeat_max); + } + } + } + + /* The character or character type itself comes last in all cases. */ + +#ifdef SUPPORT_UTF8 + if (utf8 && c >= 128) + { + memcpy(code, utf8_char, c & 7); + code += c & 7; + } + else +#endif + *code++ = c; + + /* For a repeated Unicode property match, there are two extra bytes that + define the required property. */ + +#ifdef SUPPORT_UCP + if (prop_type >= 0) + { + *code++ = prop_type; + *code++ = prop_value; + } +#endif + } + + /* If previous was a character class or a back reference, we put the repeat + stuff after it, but just skip the item if the repeat was {0,0}. */ + + else if (*previous == OP_CLASS || + *previous == OP_NCLASS || +#ifdef SUPPORT_UTF8 + *previous == OP_XCLASS || +#endif + *previous == OP_REF) + { + if (repeat_max == 0) + { + code = previous; + goto END_REPEAT; + } + + /* All real repeats make it impossible to handle partial matching (maybe + one day we will be able to remove this restriction). */ + + if (repeat_max != 1) cd->external_flags |= PCRE_NOPARTIAL; + + if (repeat_min == 0 && repeat_max == -1) + *code++ = OP_CRSTAR + repeat_type; + else if (repeat_min == 1 && repeat_max == -1) + *code++ = OP_CRPLUS + repeat_type; + else if (repeat_min == 0 && repeat_max == 1) + *code++ = OP_CRQUERY + repeat_type; + else + { + *code++ = OP_CRRANGE + repeat_type; + PUT2INC(code, 0, repeat_min); + if (repeat_max == -1) repeat_max = 0; /* 2-byte encoding for max */ + PUT2INC(code, 0, repeat_max); + } + } + + /* If previous was a bracket group, we may have to replicate it in certain + cases. */ + + else if (*previous == OP_BRA || *previous == OP_CBRA || + *previous == OP_ONCE || *previous == OP_COND) + { + register int i; + int ketoffset = 0; + int len = code - previous; + uschar *bralink = NULL; + + /* Repeating a DEFINE group is pointless */ + + if (*previous == OP_COND && previous[LINK_SIZE+1] == OP_DEF) + { + *errorcodeptr = ERR55; + goto FAILED; + } + + /* If the maximum repeat count is unlimited, find the end of the bracket + by scanning through from the start, and compute the offset back to it + from the current code pointer. There may be an OP_OPT setting following + the final KET, so we can't find the end just by going back from the code + pointer. */ + + if (repeat_max == -1) + { + register uschar *ket = previous; + do ket += GET(ket, 1); while (*ket != OP_KET); + ketoffset = code - ket; + } + + /* The case of a zero minimum is special because of the need to stick + OP_BRAZERO in front of it, and because the group appears once in the + data, whereas in other cases it appears the minimum number of times. For + this reason, it is simplest to treat this case separately, as otherwise + the code gets far too messy. There are several special subcases when the + minimum is zero. */ + + if (repeat_min == 0) + { + /* If the maximum is also zero, we just omit the group from the output + altogether. */ + + if (repeat_max == 0) + { + code = previous; + goto END_REPEAT; + } + + /* If the maximum is 1 or unlimited, we just have to stick in the + BRAZERO and do no more at this point. However, we do need to adjust + any OP_RECURSE calls inside the group that refer to the group itself or + any internal or forward referenced group, because the offset is from + the start of the whole regex. Temporarily terminate the pattern while + doing this. */ + + if (repeat_max <= 1) + { + *code = OP_END; + adjust_recurse(previous, 1, utf8, cd, save_hwm); + memmove(previous+1, previous, len); + code++; + *previous++ = OP_BRAZERO + repeat_type; + } + + /* If the maximum is greater than 1 and limited, we have to replicate + in a nested fashion, sticking OP_BRAZERO before each set of brackets. + The first one has to be handled carefully because it's the original + copy, which has to be moved up. The remainder can be handled by code + that is common with the non-zero minimum case below. We have to + adjust the value or repeat_max, since one less copy is required. Once + again, we may have to adjust any OP_RECURSE calls inside the group. */ + + else + { + int offset; + *code = OP_END; + adjust_recurse(previous, 2 + LINK_SIZE, utf8, cd, save_hwm); + memmove(previous + 2 + LINK_SIZE, previous, len); + code += 2 + LINK_SIZE; + *previous++ = OP_BRAZERO + repeat_type; + *previous++ = OP_BRA; + + /* We chain together the bracket offset fields that have to be + filled in later when the ends of the brackets are reached. */ + + offset = (bralink == NULL)? 0 : previous - bralink; + bralink = previous; + PUTINC(previous, 0, offset); + } + + repeat_max--; + } + + /* If the minimum is greater than zero, replicate the group as many + times as necessary, and adjust the maximum to the number of subsequent + copies that we need. If we set a first char from the group, and didn't + set a required char, copy the latter from the former. If there are any + forward reference subroutine calls in the group, there will be entries on + the workspace list; replicate these with an appropriate increment. */ + + else + { + if (repeat_min > 1) + { + /* In the pre-compile phase, we don't actually do the replication. We + just adjust the length as if we had. Do some paranoid checks for + potential integer overflow. */ + + if (lengthptr != NULL) + { + int delta = (repeat_min - 1)*length_prevgroup; + if ((double)(repeat_min - 1)*(double)length_prevgroup > + (double)INT_MAX || + OFLOW_MAX - *lengthptr < delta) + { + *errorcodeptr = ERR20; + goto FAILED; + } + *lengthptr += delta; + } + + /* This is compiling for real */ + + else + { + if (groupsetfirstbyte && reqbyte < 0) reqbyte = firstbyte; + for (i = 1; i < repeat_min; i++) + { + uschar *hc; + uschar *this_hwm = cd->hwm; + memcpy(code, previous, len); + for (hc = save_hwm; hc < this_hwm; hc += LINK_SIZE) + { + PUT(cd->hwm, 0, GET(hc, 0) + len); + cd->hwm += LINK_SIZE; + } + save_hwm = this_hwm; + code += len; + } + } + } + + if (repeat_max > 0) repeat_max -= repeat_min; + } + + /* This code is common to both the zero and non-zero minimum cases. If + the maximum is limited, it replicates the group in a nested fashion, + remembering the bracket starts on a stack. In the case of a zero minimum, + the first one was set up above. In all cases the repeat_max now specifies + the number of additional copies needed. Again, we must remember to + replicate entries on the forward reference list. */ + + if (repeat_max >= 0) + { + /* In the pre-compile phase, we don't actually do the replication. We + just adjust the length as if we had. For each repetition we must add 1 + to the length for BRAZERO and for all but the last repetition we must + add 2 + 2*LINKSIZE to allow for the nesting that occurs. Do some + paranoid checks to avoid integer overflow. */ + + if (lengthptr != NULL && repeat_max > 0) + { + int delta = repeat_max * (length_prevgroup + 1 + 2 + 2*LINK_SIZE) - + 2 - 2*LINK_SIZE; /* Last one doesn't nest */ + if ((double)repeat_max * + (double)(length_prevgroup + 1 + 2 + 2*LINK_SIZE) + > (double)INT_MAX || + OFLOW_MAX - *lengthptr < delta) + { + *errorcodeptr = ERR20; + goto FAILED; + } + *lengthptr += delta; + } + + /* This is compiling for real */ + + else for (i = repeat_max - 1; i >= 0; i--) + { + uschar *hc; + uschar *this_hwm = cd->hwm; + + *code++ = OP_BRAZERO + repeat_type; + + /* All but the final copy start a new nesting, maintaining the + chain of brackets outstanding. */ + + if (i != 0) + { + int offset; + *code++ = OP_BRA; + offset = (bralink == NULL)? 0 : code - bralink; + bralink = code; + PUTINC(code, 0, offset); + } + + memcpy(code, previous, len); + for (hc = save_hwm; hc < this_hwm; hc += LINK_SIZE) + { + PUT(cd->hwm, 0, GET(hc, 0) + len + ((i != 0)? 2+LINK_SIZE : 1)); + cd->hwm += LINK_SIZE; + } + save_hwm = this_hwm; + code += len; + } + + /* Now chain through the pending brackets, and fill in their length + fields (which are holding the chain links pro tem). */ + + while (bralink != NULL) + { + int oldlinkoffset; + int offset = code - bralink + 1; + uschar *bra = code - offset; + oldlinkoffset = GET(bra, 1); + bralink = (oldlinkoffset == 0)? NULL : bralink - oldlinkoffset; + *code++ = OP_KET; + PUTINC(code, 0, offset); + PUT(bra, 1, offset); + } + } + + /* If the maximum is unlimited, set a repeater in the final copy. We + can't just offset backwards from the current code point, because we + don't know if there's been an options resetting after the ket. The + correct offset was computed above. + + Then, when we are doing the actual compile phase, check to see whether + this group is a non-atomic one that could match an empty string. If so, + convert the initial operator to the S form (e.g. OP_BRA -> OP_SBRA) so + that runtime checking can be done. [This check is also applied to + atomic groups at runtime, but in a different way.] */ + + else + { + uschar *ketcode = code - ketoffset; + uschar *bracode = ketcode - GET(ketcode, 1); + *ketcode = OP_KETRMAX + repeat_type; + if (lengthptr == NULL && *bracode != OP_ONCE) + { + uschar *scode = bracode; + do + { + if (could_be_empty_branch(scode, ketcode, utf8)) + { + *bracode += OP_SBRA - OP_BRA; + break; + } + scode += GET(scode, 1); + } + while (*scode == OP_ALT); + } + } + } + + /* Else there's some kind of shambles */ + + else + { + *errorcodeptr = ERR11; + goto FAILED; + } + + /* If the character following a repeat is '+', or if certain optimization + tests above succeeded, possessive_quantifier is TRUE. For some of the + simpler opcodes, there is an special alternative opcode for this. For + anything else, we wrap the entire repeated item inside OP_ONCE brackets. + The '+' notation is just syntactic sugar, taken from Sun's Java package, + but the special opcodes can optimize it a bit. The repeated item starts at + tempcode, not at previous, which might be the first part of a string whose + (former) last char we repeated. + + Possessifying an 'exact' quantifier has no effect, so we can ignore it. But + an 'upto' may follow. We skip over an 'exact' item, and then test the + length of what remains before proceeding. */ + + if (possessive_quantifier) + { + int len; + if (*tempcode == OP_EXACT || *tempcode == OP_TYPEEXACT || + *tempcode == OP_NOTEXACT) + tempcode += _erts_pcre_OP_lengths[*tempcode] + + ((*tempcode == OP_TYPEEXACT && + (tempcode[3] == OP_PROP || tempcode[3] == OP_NOTPROP))? 2:0); + len = code - tempcode; + if (len > 0) switch (*tempcode) + { + case OP_STAR: *tempcode = OP_POSSTAR; break; + case OP_PLUS: *tempcode = OP_POSPLUS; break; + case OP_QUERY: *tempcode = OP_POSQUERY; break; + case OP_UPTO: *tempcode = OP_POSUPTO; break; + + case OP_TYPESTAR: *tempcode = OP_TYPEPOSSTAR; break; + case OP_TYPEPLUS: *tempcode = OP_TYPEPOSPLUS; break; + case OP_TYPEQUERY: *tempcode = OP_TYPEPOSQUERY; break; + case OP_TYPEUPTO: *tempcode = OP_TYPEPOSUPTO; break; + + case OP_NOTSTAR: *tempcode = OP_NOTPOSSTAR; break; + case OP_NOTPLUS: *tempcode = OP_NOTPOSPLUS; break; + case OP_NOTQUERY: *tempcode = OP_NOTPOSQUERY; break; + case OP_NOTUPTO: *tempcode = OP_NOTPOSUPTO; break; + + default: + memmove(tempcode + 1+LINK_SIZE, tempcode, len); + code += 1 + LINK_SIZE; + len += 1 + LINK_SIZE; + tempcode[0] = OP_ONCE; + *code++ = OP_KET; + PUTINC(code, 0, len); + PUT(tempcode, 1, len); + break; + } + } + + /* In all case we no longer have a previous item. We also set the + "follows varying string" flag for subsequently encountered reqbytes if + it isn't already set and we have just passed a varying length item. */ + + END_REPEAT: + previous = NULL; + cd->req_varyopt |= reqvary; + break; + + + /* ===================================================================*/ + /* Start of nested parenthesized sub-expression, or comment or lookahead or + lookbehind or option setting or condition or all the other extended + parenthesis forms. */ + + case '(': + newoptions = options; + skipbytes = 0; + bravalue = OP_CBRA; + save_hwm = cd->hwm; + reset_bracount = FALSE; + + /* First deal with various "verbs" that can be introduced by '*'. */ + + if (*(++ptr) == '*' && (cd->ctypes[ptr[1]] & ctype_letter) != 0) + { + int i, namelen; + const char *vn = verbnames; + const uschar *name = ++ptr; + previous = NULL; + while ((cd->ctypes[*++ptr] & ctype_letter) != 0); + if (*ptr == ':') + { + *errorcodeptr = ERR59; /* Not supported */ + goto FAILED; + } + if (*ptr != ')') + { + *errorcodeptr = ERR60; + goto FAILED; + } + namelen = ptr - name; + for (i = 0; i < verbcount; i++) + { + if (namelen == verbs[i].len && + strncmp((char *)name, vn, namelen) == 0) + { + *code = verbs[i].op; + if (*code++ == OP_ACCEPT) cd->had_accept = TRUE; + break; + } + vn += verbs[i].len + 1; + } + if (i < verbcount) continue; + *errorcodeptr = ERR60; + goto FAILED; + } + + /* Deal with the extended parentheses; all are introduced by '?', and the + appearance of any of them means that this is not a capturing group. */ + + else if (*ptr == '?') + { + int i, set, unset, namelen; + int *optset; + const uschar *name; + uschar *slot; + + switch (*(++ptr)) + { + case '#': /* Comment; skip to ket */ + ptr++; + while (*ptr != 0 && *ptr != ')') ptr++; + if (*ptr == 0) + { + *errorcodeptr = ERR18; + goto FAILED; + } + continue; + + + /* ------------------------------------------------------------ */ + case '|': /* Reset capture count for each branch */ + reset_bracount = TRUE; + /* Fall through */ + + /* ------------------------------------------------------------ */ + case ':': /* Non-capturing bracket */ + bravalue = OP_BRA; + ptr++; + break; + + + /* ------------------------------------------------------------ */ + case '(': + bravalue = OP_COND; /* Conditional group */ + + /* A condition can be an assertion, a number (referring to a numbered + group), a name (referring to a named group), or 'R', referring to + recursion. R and R&name are also permitted for recursion tests. + + There are several syntaxes for testing a named group: (?(name)) is used + by Python; Perl 5.10 onwards uses (?() or (?('name')). + + There are two unfortunate ambiguities, caused by history. (a) 'R' can + be the recursive thing or the name 'R' (and similarly for 'R' followed + by digits), and (b) a number could be a name that consists of digits. + In both cases, we look for a name first; if not found, we try the other + cases. */ + + /* For conditions that are assertions, check the syntax, and then exit + the switch. This will take control down to where bracketed groups, + including assertions, are processed. */ + + if (ptr[1] == '?' && (ptr[2] == '=' || ptr[2] == '!' || ptr[2] == '<')) + break; + + /* Most other conditions use OP_CREF (a couple change to OP_RREF + below), and all need to skip 3 bytes at the start of the group. */ + + code[1+LINK_SIZE] = OP_CREF; + skipbytes = 3; + refsign = -1; + + /* Check for a test for recursion in a named group. */ + + if (ptr[1] == 'R' && ptr[2] == '&') + { + terminator = -1; + ptr += 2; + code[1+LINK_SIZE] = OP_RREF; /* Change the type of test */ + } + + /* Check for a test for a named group's having been set, using the Perl + syntax (?() or (?('name') */ + + else if (ptr[1] == '<') + { + terminator = '>'; + ptr++; + } + else if (ptr[1] == '\'') + { + terminator = '\''; + ptr++; + } + else + { + terminator = 0; + if (ptr[1] == '-' || ptr[1] == '+') refsign = *(++ptr); + } + + /* We now expect to read a name; any thing else is an error */ + + if ((cd->ctypes[ptr[1]] & ctype_word) == 0) + { + ptr += 1; /* To get the right offset */ + *errorcodeptr = ERR28; + goto FAILED; + } + + /* Read the name, but also get it as a number if it's all digits */ + + recno = 0; + name = ++ptr; + while ((cd->ctypes[*ptr] & ctype_word) != 0) + { + if (recno >= 0) + recno = ((digitab[*ptr] & ctype_digit) != 0)? + recno * 10 + *ptr - '0' : -1; + ptr++; + } + namelen = ptr - name; + + if ((terminator > 0 && *ptr++ != terminator) || *ptr++ != ')') + { + ptr--; /* Error offset */ + *errorcodeptr = ERR26; + goto FAILED; + } + + /* Do no further checking in the pre-compile phase. */ + + if (lengthptr != NULL) break; + + /* In the real compile we do the work of looking for the actual + reference. If the string started with "+" or "-" we require the rest to + be digits, in which case recno will be set. */ + + if (refsign > 0) + { + if (recno <= 0) + { + *errorcodeptr = ERR58; + goto FAILED; + } + recno = (refsign == '-')? + cd->bracount - recno + 1 : recno +cd->bracount; + if (recno <= 0 || recno > cd->final_bracount) + { + *errorcodeptr = ERR15; + goto FAILED; + } + PUT2(code, 2+LINK_SIZE, recno); + break; + } + + /* Otherwise (did not start with "+" or "-"), start by looking for the + name. */ + + slot = cd->name_table; + for (i = 0; i < cd->names_found; i++) + { + if (strncmp((char *)name, (char *)slot+2, namelen) == 0) break; + slot += cd->name_entry_size; + } + + /* Found a previous named subpattern */ + + if (i < cd->names_found) + { + recno = GET2(slot, 0); + PUT2(code, 2+LINK_SIZE, recno); + } + + /* Search the pattern for a forward reference */ + + else if ((i = find_parens(ptr, cd->bracount, name, namelen, + (options & PCRE_EXTENDED) != 0)) > 0) + { + PUT2(code, 2+LINK_SIZE, i); + } + + /* If terminator == 0 it means that the name followed directly after + the opening parenthesis [e.g. (?(abc)...] and in this case there are + some further alternatives to try. For the cases where terminator != 0 + [things like (?(... or (?('name')... or (?(R&name)... ] we have + now checked all the possibilities, so give an error. */ + + else if (terminator != 0) + { + *errorcodeptr = ERR15; + goto FAILED; + } + + /* Check for (?(R) for recursion. Allow digits after R to specify a + specific group number. */ + + else if (*name == 'R') + { + recno = 0; + for (i = 1; i < namelen; i++) + { + if ((digitab[name[i]] & ctype_digit) == 0) + { + *errorcodeptr = ERR15; + goto FAILED; + } + recno = recno * 10 + name[i] - '0'; + } + if (recno == 0) recno = RREF_ANY; + code[1+LINK_SIZE] = OP_RREF; /* Change test type */ + PUT2(code, 2+LINK_SIZE, recno); + } + + /* Similarly, check for the (?(DEFINE) "condition", which is always + false. */ + + else if (namelen == 6 && strncmp((char *)name, "DEFINE", 6) == 0) + { + code[1+LINK_SIZE] = OP_DEF; + skipbytes = 1; + } + + /* Check for the "name" actually being a subpattern number. We are + in the second pass here, so final_bracount is set. */ + + else if (recno > 0 && recno <= cd->final_bracount) + { + PUT2(code, 2+LINK_SIZE, recno); + } + + /* Either an unidentified subpattern, or a reference to (?(0) */ + + else + { + *errorcodeptr = (recno == 0)? ERR35: ERR15; + goto FAILED; + } + break; + + + /* ------------------------------------------------------------ */ + case '=': /* Positive lookahead */ + bravalue = OP_ASSERT; + ptr++; + break; + + + /* ------------------------------------------------------------ */ + case '!': /* Negative lookahead */ + ptr++; + if (*ptr == ')') /* Optimize (?!) */ + { + *code++ = OP_FAIL; + previous = NULL; + continue; + } + bravalue = OP_ASSERT_NOT; + break; + + + /* ------------------------------------------------------------ */ + case '<': /* Lookbehind or named define */ + switch (ptr[1]) + { + case '=': /* Positive lookbehind */ + bravalue = OP_ASSERTBACK; + ptr += 2; + break; + + case '!': /* Negative lookbehind */ + bravalue = OP_ASSERTBACK_NOT; + ptr += 2; + break; + + default: /* Could be name define, else bad */ + if ((cd->ctypes[ptr[1]] & ctype_word) != 0) goto DEFINE_NAME; + ptr++; /* Correct offset for error */ + *errorcodeptr = ERR24; + goto FAILED; + } + break; + + + /* ------------------------------------------------------------ */ + case '>': /* One-time brackets */ + bravalue = OP_ONCE; + ptr++; + break; + + + /* ------------------------------------------------------------ */ + case 'C': /* Callout - may be followed by digits; */ + previous_callout = code; /* Save for later completion */ + after_manual_callout = 1; /* Skip one item before completing */ + *code++ = OP_CALLOUT; + { + int n = 0; + while ((digitab[*(++ptr)] & ctype_digit) != 0) + n = n * 10 + *ptr - '0'; + if (*ptr != ')') + { + *errorcodeptr = ERR39; + goto FAILED; + } + if (n > 255) + { + *errorcodeptr = ERR38; + goto FAILED; + } + *code++ = n; + PUT(code, 0, ptr - cd->start_pattern + 1); /* Pattern offset */ + PUT(code, LINK_SIZE, 0); /* Default length */ + code += 2 * LINK_SIZE; + } + previous = NULL; + continue; + + + /* ------------------------------------------------------------ */ + case 'P': /* Python-style named subpattern handling */ + if (*(++ptr) == '=' || *ptr == '>') /* Reference or recursion */ + { + is_recurse = *ptr == '>'; + terminator = ')'; + goto NAMED_REF_OR_RECURSE; + } + else if (*ptr != '<') /* Test for Python-style definition */ + { + *errorcodeptr = ERR41; + goto FAILED; + } + /* Fall through to handle (?P< as (?< is handled */ + + + /* ------------------------------------------------------------ */ + DEFINE_NAME: /* Come here from (?< handling */ + case '\'': + { + terminator = (*ptr == '<')? '>' : '\''; + name = ++ptr; + + while ((cd->ctypes[*ptr] & ctype_word) != 0) ptr++; + namelen = ptr - name; + + /* In the pre-compile phase, just do a syntax check. */ + + if (lengthptr != NULL) + { + if (*ptr != terminator) + { + *errorcodeptr = ERR42; + goto FAILED; + } + if (cd->names_found >= MAX_NAME_COUNT) + { + *errorcodeptr = ERR49; + goto FAILED; + } + if (namelen + 3 > cd->name_entry_size) + { + cd->name_entry_size = namelen + 3; + if (namelen > MAX_NAME_SIZE) + { + *errorcodeptr = ERR48; + goto FAILED; + } + } + } + + /* In the real compile, create the entry in the table */ + + else + { + slot = cd->name_table; + for (i = 0; i < cd->names_found; i++) + { + int crc = memcmp(name, slot+2, namelen); + if (crc == 0) + { + if (slot[2+namelen] == 0) + { + if ((options & PCRE_DUPNAMES) == 0) + { + *errorcodeptr = ERR43; + goto FAILED; + } + } + else crc = -1; /* Current name is substring */ + } + if (crc < 0) + { + memmove(slot + cd->name_entry_size, slot, + (cd->names_found - i) * cd->name_entry_size); + break; + } + slot += cd->name_entry_size; + } + + PUT2(slot, 0, cd->bracount + 1); + memcpy(slot + 2, name, namelen); + slot[2+namelen] = 0; + } + } + + /* In both cases, count the number of names we've encountered. */ + + ptr++; /* Move past > or ' */ + cd->names_found++; + goto NUMBERED_GROUP; + + + /* ------------------------------------------------------------ */ + case '&': /* Perl recursion/subroutine syntax */ + terminator = ')'; + is_recurse = TRUE; + /* Fall through */ + + /* We come here from the Python syntax above that handles both + references (?P=name) and recursion (?P>name), as well as falling + through from the Perl recursion syntax (?&name). We also come here from + the Perl \k or \k'name' back reference syntax and the \k{name} + .NET syntax. */ + + NAMED_REF_OR_RECURSE: + name = ++ptr; + while ((cd->ctypes[*ptr] & ctype_word) != 0) ptr++; + namelen = ptr - name; + + /* In the pre-compile phase, do a syntax check and set a dummy + reference number. */ + + if (lengthptr != NULL) + { + if (namelen == 0) + { + *errorcodeptr = ERR62; + goto FAILED; + } + if (*ptr != terminator) + { + *errorcodeptr = ERR42; + goto FAILED; + } + if (namelen > MAX_NAME_SIZE) + { + *errorcodeptr = ERR48; + goto FAILED; + } + recno = 0; + } + + /* In the real compile, seek the name in the table. We check the name + first, and then check that we have reached the end of the name in the + table. That way, if the name that is longer than any in the table, + the comparison will fail without reading beyond the table entry. */ + + else + { + slot = cd->name_table; + for (i = 0; i < cd->names_found; i++) + { + if (strncmp((char *)name, (char *)slot+2, namelen) == 0 && + slot[2+namelen] == 0) + break; + slot += cd->name_entry_size; + } + + if (i < cd->names_found) /* Back reference */ + { + recno = GET2(slot, 0); + } + else if ((recno = /* Forward back reference */ + find_parens(ptr, cd->bracount, name, namelen, + (options & PCRE_EXTENDED) != 0)) <= 0) + { + *errorcodeptr = ERR15; + goto FAILED; + } + } + + /* In both phases, we can now go to the code than handles numerical + recursion or backreferences. */ + + if (is_recurse) goto HANDLE_RECURSION; + else goto HANDLE_REFERENCE; + + + /* ------------------------------------------------------------ */ + case 'R': /* Recursion */ + ptr++; /* Same as (?0) */ + /* Fall through */ + + + /* ------------------------------------------------------------ */ + case '-': case '+': + case '0': case '1': case '2': case '3': case '4': /* Recursion or */ + case '5': case '6': case '7': case '8': case '9': /* subroutine */ + { + const uschar *called; + + if ((refsign = *ptr) == '+') + { + ptr++; + if ((digitab[*ptr] & ctype_digit) == 0) + { + *errorcodeptr = ERR63; + goto FAILED; + } + } + else if (refsign == '-') + { + if ((digitab[ptr[1]] & ctype_digit) == 0) + goto OTHER_CHAR_AFTER_QUERY; + ptr++; + } + + recno = 0; + while((digitab[*ptr] & ctype_digit) != 0) + recno = recno * 10 + *ptr++ - '0'; + + if (*ptr != ')') + { + *errorcodeptr = ERR29; + goto FAILED; + } + + if (refsign == '-') + { + if (recno == 0) + { + *errorcodeptr = ERR58; + goto FAILED; + } + recno = cd->bracount - recno + 1; + if (recno <= 0) + { + *errorcodeptr = ERR15; + goto FAILED; + } + } + else if (refsign == '+') + { + if (recno == 0) + { + *errorcodeptr = ERR58; + goto FAILED; + } + recno += cd->bracount; + } + + /* Come here from code above that handles a named recursion */ + + HANDLE_RECURSION: + + previous = code; + called = cd->start_code; + + /* When we are actually compiling, find the bracket that is being + referenced. Temporarily end the regex in case it doesn't exist before + this point. If we end up with a forward reference, first check that + the bracket does occur later so we can give the error (and position) + now. Then remember this forward reference in the workspace so it can + be filled in at the end. */ + + if (lengthptr == NULL) + { + *code = OP_END; + if (recno != 0) called = find_bracket(cd->start_code, utf8, recno); + + /* Forward reference */ + + if (called == NULL) + { + if (find_parens(ptr, cd->bracount, NULL, recno, + (options & PCRE_EXTENDED) != 0) < 0) + { + *errorcodeptr = ERR15; + goto FAILED; + } + called = cd->start_code + recno; + PUTINC(cd->hwm, 0, code + 2 + LINK_SIZE - cd->start_code); + } + + /* If not a forward reference, and the subpattern is still open, + this is a recursive call. We check to see if this is a left + recursion that could loop for ever, and diagnose that case. */ + + else if (GET(called, 1) == 0 && + could_be_empty(called, code, bcptr, utf8)) + { + *errorcodeptr = ERR40; + goto FAILED; + } + } + + /* Insert the recursion/subroutine item, automatically wrapped inside + "once" brackets. Set up a "previous group" length so that a + subsequent quantifier will work. */ + + *code = OP_ONCE; + PUT(code, 1, 2 + 2*LINK_SIZE); + code += 1 + LINK_SIZE; + + *code = OP_RECURSE; + PUT(code, 1, called - cd->start_code); + code += 1 + LINK_SIZE; + + *code = OP_KET; + PUT(code, 1, 2 + 2*LINK_SIZE); + code += 1 + LINK_SIZE; + + length_prevgroup = 3 + 3*LINK_SIZE; + } + + /* Can't determine a first byte now */ + + if (firstbyte == REQ_UNSET) firstbyte = REQ_NONE; + continue; + + + /* ------------------------------------------------------------ */ + default: /* Other characters: check option setting */ + OTHER_CHAR_AFTER_QUERY: + set = unset = 0; + optset = &set; + + while (*ptr != ')' && *ptr != ':') + { + switch (*ptr++) + { + case '-': optset = &unset; break; + + case 'J': /* Record that it changed in the external options */ + *optset |= PCRE_DUPNAMES; + cd->external_flags |= PCRE_JCHANGED; + break; + + case 'i': *optset |= PCRE_CASELESS; break; + case 'm': *optset |= PCRE_MULTILINE; break; + case 's': *optset |= PCRE_DOTALL; break; + case 'x': *optset |= PCRE_EXTENDED; break; + case 'U': *optset |= PCRE_UNGREEDY; break; + case 'X': *optset |= PCRE_EXTRA; break; + + default: *errorcodeptr = ERR12; + ptr--; /* Correct the offset */ + goto FAILED; + } + } + + /* Set up the changed option bits, but don't change anything yet. */ + + newoptions = (options | set) & (~unset); + + /* If the options ended with ')' this is not the start of a nested + group with option changes, so the options change at this level. If this + item is right at the start of the pattern, the options can be + abstracted and made external in the pre-compile phase, and ignored in + the compile phase. This can be helpful when matching -- for instance in + caseless checking of required bytes. + + If the code pointer is not (cd->start_code + 1 + LINK_SIZE), we are + definitely *not* at the start of the pattern because something has been + compiled. In the pre-compile phase, however, the code pointer can have + that value after the start, because it gets reset as code is discarded + during the pre-compile. However, this can happen only at top level - if + we are within parentheses, the starting BRA will still be present. At + any parenthesis level, the length value can be used to test if anything + has been compiled at that level. Thus, a test for both these conditions + is necessary to ensure we correctly detect the start of the pattern in + both phases. + + If we are not at the pattern start, compile code to change the ims + options if this setting actually changes any of them. We also pass the + new setting back so that it can be put at the start of any following + branches, and when this group ends (if we are in a group), a resetting + item can be compiled. */ + + if (*ptr == ')') + { + if (code == cd->start_code + 1 + LINK_SIZE && + (lengthptr == NULL || *lengthptr == 2 + 2*LINK_SIZE)) + { + cd->external_options = newoptions; + options = newoptions; + } + else + { + if ((options & PCRE_IMS) != (newoptions & PCRE_IMS)) + { + *code++ = OP_OPT; + *code++ = newoptions & PCRE_IMS; + } + + /* Change options at this level, and pass them back for use + in subsequent branches. Reset the greedy defaults and the case + value for firstbyte and reqbyte. */ + + *optionsptr = options = newoptions; + greedy_default = ((newoptions & PCRE_UNGREEDY) != 0); + greedy_non_default = greedy_default ^ 1; + req_caseopt = ((options & PCRE_CASELESS) != 0)? REQ_CASELESS : 0; + } + + previous = NULL; /* This item can't be repeated */ + continue; /* It is complete */ + } + + /* If the options ended with ':' we are heading into a nested group + with possible change of options. Such groups are non-capturing and are + not assertions of any kind. All we need to do is skip over the ':'; + the newoptions value is handled below. */ + + bravalue = OP_BRA; + ptr++; + } /* End of switch for character following (? */ + } /* End of (? handling */ + + /* Opening parenthesis not followed by '?'. If PCRE_NO_AUTO_CAPTURE is set, + all unadorned brackets become non-capturing and behave like (?:...) + brackets. */ + + else if ((options & PCRE_NO_AUTO_CAPTURE) != 0) + { + bravalue = OP_BRA; + } + + /* Else we have a capturing group. */ + + else + { + NUMBERED_GROUP: + cd->bracount += 1; + PUT2(code, 1+LINK_SIZE, cd->bracount); + skipbytes = 2; + } + + /* Process nested bracketed regex. Assertions may not be repeated, but + other kinds can be. All their opcodes are >= OP_ONCE. We copy code into a + non-register variable in order to be able to pass its address because some + compilers complain otherwise. Pass in a new setting for the ims options if + they have changed. */ + + previous = (bravalue >= OP_ONCE)? code : NULL; + *code = bravalue; + tempcode = code; + tempreqvary = cd->req_varyopt; /* Save value before bracket */ + length_prevgroup = 0; /* Initialize for pre-compile phase */ + + if (!compile_regex( + newoptions, /* The complete new option state */ + options & PCRE_IMS, /* The previous ims option state */ + &tempcode, /* Where to put code (updated) */ + &ptr, /* Input pointer (updated) */ + errorcodeptr, /* Where to put an error message */ + (bravalue == OP_ASSERTBACK || + bravalue == OP_ASSERTBACK_NOT), /* TRUE if back assert */ + reset_bracount, /* True if (?| group */ + skipbytes, /* Skip over bracket number */ + &subfirstbyte, /* For possible first char */ + &subreqbyte, /* For possible last char */ + bcptr, /* Current branch chain */ + cd, /* Tables block */ + (lengthptr == NULL)? NULL : /* Actual compile phase */ + &length_prevgroup /* Pre-compile phase */ + )) + goto FAILED; + + /* At the end of compiling, code is still pointing to the start of the + group, while tempcode has been updated to point past the end of the group + and any option resetting that may follow it. The pattern pointer (ptr) + is on the bracket. */ + + /* If this is a conditional bracket, check that there are no more than + two branches in the group, or just one if it's a DEFINE group. We do this + in the real compile phase, not in the pre-pass, where the whole group may + not be available. */ + + if (bravalue == OP_COND && lengthptr == NULL) + { + uschar *tc = code; + int condcount = 0; + + do { + condcount++; + tc += GET(tc,1); + } + while (*tc != OP_KET); + + /* A DEFINE group is never obeyed inline (the "condition" is always + false). It must have only one branch. */ + + if (code[LINK_SIZE+1] == OP_DEF) + { + if (condcount > 1) + { + *errorcodeptr = ERR54; + goto FAILED; + } + bravalue = OP_DEF; /* Just a flag to suppress char handling below */ + } + + /* A "normal" conditional group. If there is just one branch, we must not + make use of its firstbyte or reqbyte, because this is equivalent to an + empty second branch. */ + + else + { + if (condcount > 2) + { + *errorcodeptr = ERR27; + goto FAILED; + } + if (condcount == 1) subfirstbyte = subreqbyte = REQ_NONE; + } + } + + /* Error if hit end of pattern */ + + if (*ptr != ')') + { + *errorcodeptr = ERR14; + goto FAILED; + } + + /* In the pre-compile phase, update the length by the length of the group, + less the brackets at either end. Then reduce the compiled code to just a + set of non-capturing brackets so that it doesn't use much memory if it is + duplicated by a quantifier.*/ + + if (lengthptr != NULL) + { + if (OFLOW_MAX - *lengthptr < length_prevgroup - 2 - 2*LINK_SIZE) + { + *errorcodeptr = ERR20; + goto FAILED; + } + *lengthptr += length_prevgroup - 2 - 2*LINK_SIZE; + *code++ = OP_BRA; + PUTINC(code, 0, 1 + LINK_SIZE); + *code++ = OP_KET; + PUTINC(code, 0, 1 + LINK_SIZE); + break; /* No need to waste time with special character handling */ + } + + /* Otherwise update the main code pointer to the end of the group. */ + + code = tempcode; + + /* For a DEFINE group, required and first character settings are not + relevant. */ + + if (bravalue == OP_DEF) break; + + /* Handle updating of the required and first characters for other types of + group. Update for normal brackets of all kinds, and conditions with two + branches (see code above). If the bracket is followed by a quantifier with + zero repeat, we have to back off. Hence the definition of zeroreqbyte and + zerofirstbyte outside the main loop so that they can be accessed for the + back off. */ + + zeroreqbyte = reqbyte; + zerofirstbyte = firstbyte; + groupsetfirstbyte = FALSE; + + if (bravalue >= OP_ONCE) + { + /* If we have not yet set a firstbyte in this branch, take it from the + subpattern, remembering that it was set here so that a repeat of more + than one can replicate it as reqbyte if necessary. If the subpattern has + no firstbyte, set "none" for the whole branch. In both cases, a zero + repeat forces firstbyte to "none". */ + + if (firstbyte == REQ_UNSET) + { + if (subfirstbyte >= 0) + { + firstbyte = subfirstbyte; + groupsetfirstbyte = TRUE; + } + else firstbyte = REQ_NONE; + zerofirstbyte = REQ_NONE; + } + + /* If firstbyte was previously set, convert the subpattern's firstbyte + into reqbyte if there wasn't one, using the vary flag that was in + existence beforehand. */ + + else if (subfirstbyte >= 0 && subreqbyte < 0) + subreqbyte = subfirstbyte | tempreqvary; + + /* If the subpattern set a required byte (or set a first byte that isn't + really the first byte - see above), set it. */ + + if (subreqbyte >= 0) reqbyte = subreqbyte; + } + + /* For a forward assertion, we take the reqbyte, if set. This can be + helpful if the pattern that follows the assertion doesn't set a different + char. For example, it's useful for /(?=abcde).+/. We can't set firstbyte + for an assertion, however because it leads to incorrect effect for patterns + such as /(?=a)a.+/ when the "real" "a" would then become a reqbyte instead + of a firstbyte. This is overcome by a scan at the end if there's no + firstbyte, looking for an asserted first char. */ + + else if (bravalue == OP_ASSERT && subreqbyte >= 0) reqbyte = subreqbyte; + break; /* End of processing '(' */ + + + /* ===================================================================*/ + /* Handle metasequences introduced by \. For ones like \d, the ESC_ values + are arranged to be the negation of the corresponding OP_values. For the + back references, the values are ESC_REF plus the reference number. Only + back references and those types that consume a character may be repeated. + We can test for values between ESC_b and ESC_Z for the latter; this may + have to change if any new ones are ever created. */ + + case '\\': + tempptr = ptr; + c = check_escape(&ptr, errorcodeptr, cd->bracount, options, FALSE); + if (*errorcodeptr != 0) goto FAILED; + + if (c < 0) + { + if (-c == ESC_Q) /* Handle start of quoted string */ + { + if (ptr[1] == '\\' && ptr[2] == 'E') ptr += 2; /* avoid empty string */ + else inescq = TRUE; + continue; + } + + if (-c == ESC_E) continue; /* Perl ignores an orphan \E */ + + /* For metasequences that actually match a character, we disable the + setting of a first character if it hasn't already been set. */ + + if (firstbyte == REQ_UNSET && -c > ESC_b && -c < ESC_Z) + firstbyte = REQ_NONE; + + /* Set values to reset to if this is followed by a zero repeat. */ + + zerofirstbyte = firstbyte; + zeroreqbyte = reqbyte; + + /* \k or \k'name' is a back reference by name (Perl syntax). + We also support \k{name} (.NET syntax) */ + + if (-c == ESC_k && (ptr[1] == '<' || ptr[1] == '\'' || ptr[1] == '{')) + { + is_recurse = FALSE; + terminator = (*(++ptr) == '<')? '>' : (*ptr == '\'')? '\'' : '}'; + goto NAMED_REF_OR_RECURSE; + } + + /* Back references are handled specially; must disable firstbyte if + not set to cope with cases like (?=(\w+))\1: which would otherwise set + ':' later. */ + + if (-c >= ESC_REF) + { + recno = -c - ESC_REF; + + HANDLE_REFERENCE: /* Come here from named backref handling */ + if (firstbyte == REQ_UNSET) firstbyte = REQ_NONE; + previous = code; + *code++ = OP_REF; + PUT2INC(code, 0, recno); + cd->backref_map |= (recno < 32)? (1 << recno) : 1; + if (recno > cd->top_backref) cd->top_backref = recno; + } + + /* So are Unicode property matches, if supported. */ + +#ifdef SUPPORT_UCP + else if (-c == ESC_P || -c == ESC_p) + { + BOOL negated; + int pdata; + int ptype = get_ucp(&ptr, &negated, &pdata, errorcodeptr); + if (ptype < 0) goto FAILED; + previous = code; + *code++ = ((-c == ESC_p) != negated)? OP_PROP : OP_NOTPROP; + *code++ = ptype; + *code++ = pdata; + } +#else + + /* If Unicode properties are not supported, \X, \P, and \p are not + allowed. */ + + else if (-c == ESC_X || -c == ESC_P || -c == ESC_p) + { + *errorcodeptr = ERR45; + goto FAILED; + } +#endif + + /* For the rest (including \X when Unicode properties are supported), we + can obtain the OP value by negating the escape value. */ + + else + { + previous = (-c > ESC_b && -c < ESC_Z)? code : NULL; + *code++ = -c; + } + continue; + } + + /* We have a data character whose value is in c. In UTF-8 mode it may have + a value > 127. We set its representation in the length/buffer, and then + handle it as a data character. */ + +#ifdef SUPPORT_UTF8 + if (utf8 && c > 127) + mclength = _erts_pcre_ord2utf8(c, mcbuffer); + else +#endif + + { + mcbuffer[0] = c; + mclength = 1; + } + goto ONE_CHAR; + + + /* ===================================================================*/ + /* Handle a literal character. It is guaranteed not to be whitespace or # + when the extended flag is set. If we are in UTF-8 mode, it may be a + multi-byte literal character. */ + + default: + NORMAL_CHAR: + mclength = 1; + mcbuffer[0] = c; + +#ifdef SUPPORT_UTF8 + if (utf8 && c >= 0xc0) + { + while ((ptr[1] & 0xc0) == 0x80) + mcbuffer[mclength++] = *(++ptr); + } +#endif + + /* At this point we have the character's bytes in mcbuffer, and the length + in mclength. When not in UTF-8 mode, the length is always 1. */ + + ONE_CHAR: + previous = code; + *code++ = ((options & PCRE_CASELESS) != 0)? OP_CHARNC : OP_CHAR; + for (c = 0; c < mclength; c++) *code++ = mcbuffer[c]; + + /* Remember if \r or \n were seen */ + + if (mcbuffer[0] == '\r' || mcbuffer[0] == '\n') + cd->external_flags |= PCRE_HASCRORLF; + + /* Set the first and required bytes appropriately. If no previous first + byte, set it from this character, but revert to none on a zero repeat. + Otherwise, leave the firstbyte value alone, and don't change it on a zero + repeat. */ + + if (firstbyte == REQ_UNSET) + { + zerofirstbyte = REQ_NONE; + zeroreqbyte = reqbyte; + + /* If the character is more than one byte long, we can set firstbyte + only if it is not to be matched caselessly. */ + + if (mclength == 1 || req_caseopt == 0) + { + firstbyte = mcbuffer[0] | req_caseopt; + if (mclength != 1) reqbyte = code[-1] | cd->req_varyopt; + } + else firstbyte = reqbyte = REQ_NONE; + } + + /* firstbyte was previously set; we can set reqbyte only the length is + 1 or the matching is caseful. */ + + else + { + zerofirstbyte = firstbyte; + zeroreqbyte = reqbyte; + if (mclength == 1 || req_caseopt == 0) + reqbyte = code[-1] | req_caseopt | cd->req_varyopt; + } + + break; /* End of literal character handling */ + } + } /* end of big loop */ + + +/* Control never reaches here by falling through, only by a goto for all the +error states. Pass back the position in the pattern so that it can be displayed +to the user for diagnosing the error. */ + +FAILED: +*ptrptr = ptr; +return FALSE; +} + + + + +/************************************************* +* Compile sequence of alternatives * +*************************************************/ + +/* On entry, ptr is pointing past the bracket character, but on return it +points to the closing bracket, or vertical bar, or end of string. The code +variable is pointing at the byte into which the BRA operator has been stored. +If the ims options are changed at the start (for a (?ims: group) or during any +branch, we need to insert an OP_OPT item at the start of every following branch +to ensure they get set correctly at run time, and also pass the new options +into every subsequent branch compile. + +This function is used during the pre-compile phase when we are trying to find +out the amount of memory needed, as well as during the real compile phase. The +value of lengthptr distinguishes the two phases. + +Arguments: + options option bits, including any changes for this subpattern + oldims previous settings of ims option bits + codeptr -> the address of the current code pointer + ptrptr -> the address of the current pattern pointer + errorcodeptr -> pointer to error code variable + lookbehind TRUE if this is a lookbehind assertion + reset_bracount TRUE to reset the count for each branch + skipbytes skip this many bytes at start (for brackets and OP_COND) + firstbyteptr place to put the first required character, or a negative number + reqbyteptr place to put the last required character, or a negative number + bcptr pointer to the chain of currently open branches + cd points to the data block with tables pointers etc. + lengthptr NULL during the real compile phase + points to length accumulator during pre-compile phase + +Returns: TRUE on success +*/ + +static BOOL +compile_regex(int options, int oldims, uschar **codeptr, const uschar **ptrptr, + int *errorcodeptr, BOOL lookbehind, BOOL reset_bracount, int skipbytes, + int *firstbyteptr, int *reqbyteptr, branch_chain *bcptr, compile_data *cd, + int *lengthptr) +{ +const uschar *ptr = *ptrptr; +uschar *code = *codeptr; +uschar *last_branch = code; +uschar *start_bracket = code; +uschar *reverse_count = NULL; +int firstbyte, reqbyte; +int branchfirstbyte, branchreqbyte; +int length; +int orig_bracount; +int max_bracount; +branch_chain bc; + +bc.outer = bcptr; +bc.current = code; + +firstbyte = reqbyte = REQ_UNSET; + +/* Accumulate the length for use in the pre-compile phase. Start with the +length of the BRA and KET and any extra bytes that are required at the +beginning. We accumulate in a local variable to save frequent testing of +lenthptr for NULL. We cannot do this by looking at the value of code at the +start and end of each alternative, because compiled items are discarded during +the pre-compile phase so that the work space is not exceeded. */ + +length = 2 + 2*LINK_SIZE + skipbytes; + +/* WARNING: If the above line is changed for any reason, you must also change +the code that abstracts option settings at the start of the pattern and makes +them global. It tests the value of length for (2 + 2*LINK_SIZE) in the +pre-compile phase to find out whether anything has yet been compiled or not. */ + +/* Offset is set zero to mark that this bracket is still open */ + +PUT(code, 1, 0); +code += 1 + LINK_SIZE + skipbytes; + +/* Loop for each alternative branch */ + +orig_bracount = max_bracount = cd->bracount; +for (;;) + { + /* For a (?| group, reset the capturing bracket count so that each branch + uses the same numbers. */ + + if (reset_bracount) cd->bracount = orig_bracount; + + /* Handle a change of ims options at the start of the branch */ + + if ((options & PCRE_IMS) != oldims) + { + *code++ = OP_OPT; + *code++ = options & PCRE_IMS; + length += 2; + } + + /* Set up dummy OP_REVERSE if lookbehind assertion */ + + if (lookbehind) + { + *code++ = OP_REVERSE; + reverse_count = code; + PUTINC(code, 0, 0); + length += 1 + LINK_SIZE; + } + + /* Now compile the branch; in the pre-compile phase its length gets added + into the length. */ + + if (!compile_branch(&options, &code, &ptr, errorcodeptr, &branchfirstbyte, + &branchreqbyte, &bc, cd, (lengthptr == NULL)? NULL : &length)) + { + *ptrptr = ptr; + return FALSE; + } + + /* Keep the highest bracket count in case (?| was used and some branch + has fewer than the rest. */ + + if (cd->bracount > max_bracount) max_bracount = cd->bracount; + + /* In the real compile phase, there is some post-processing to be done. */ + + if (lengthptr == NULL) + { + /* If this is the first branch, the firstbyte and reqbyte values for the + branch become the values for the regex. */ + + if (*last_branch != OP_ALT) + { + firstbyte = branchfirstbyte; + reqbyte = branchreqbyte; + } + + /* If this is not the first branch, the first char and reqbyte have to + match the values from all the previous branches, except that if the + previous value for reqbyte didn't have REQ_VARY set, it can still match, + and we set REQ_VARY for the regex. */ + + else + { + /* If we previously had a firstbyte, but it doesn't match the new branch, + we have to abandon the firstbyte for the regex, but if there was + previously no reqbyte, it takes on the value of the old firstbyte. */ + + if (firstbyte >= 0 && firstbyte != branchfirstbyte) + { + if (reqbyte < 0) reqbyte = firstbyte; + firstbyte = REQ_NONE; + } + + /* If we (now or from before) have no firstbyte, a firstbyte from the + branch becomes a reqbyte if there isn't a branch reqbyte. */ + + if (firstbyte < 0 && branchfirstbyte >= 0 && branchreqbyte < 0) + branchreqbyte = branchfirstbyte; + + /* Now ensure that the reqbytes match */ + + if ((reqbyte & ~REQ_VARY) != (branchreqbyte & ~REQ_VARY)) + reqbyte = REQ_NONE; + else reqbyte |= branchreqbyte; /* To "or" REQ_VARY */ + } + + /* If lookbehind, check that this branch matches a fixed-length string, and + put the length into the OP_REVERSE item. Temporarily mark the end of the + branch with OP_END. */ + + if (lookbehind) + { + int fixed_length; + *code = OP_END; + fixed_length = find_fixedlength(last_branch, options); + DPRINTF(("fixed length = %d\n", fixed_length)); + if (fixed_length < 0) + { + *errorcodeptr = (fixed_length == -2)? ERR36 : ERR25; + *ptrptr = ptr; + return FALSE; + } + PUT(reverse_count, 0, fixed_length); + } + } + + /* Reached end of expression, either ')' or end of pattern. In the real + compile phase, go back through the alternative branches and reverse the chain + of offsets, with the field in the BRA item now becoming an offset to the + first alternative. If there are no alternatives, it points to the end of the + group. The length in the terminating ket is always the length of the whole + bracketed item. If any of the ims options were changed inside the group, + compile a resetting op-code following, except at the very end of the pattern. + Return leaving the pointer at the terminating char. */ + + if (*ptr != '|') + { + if (lengthptr == NULL) + { + int branch_length = code - last_branch; + do + { + int prev_length = GET(last_branch, 1); + PUT(last_branch, 1, branch_length); + branch_length = prev_length; + last_branch -= branch_length; + } + while (branch_length > 0); + } + + /* Fill in the ket */ + + *code = OP_KET; + PUT(code, 1, code - start_bracket); + code += 1 + LINK_SIZE; + + /* Resetting option if needed */ + + if ((options & PCRE_IMS) != oldims && *ptr == ')') + { + *code++ = OP_OPT; + *code++ = oldims; + length += 2; + } + + /* Retain the highest bracket number, in case resetting was used. */ + + cd->bracount = max_bracount; + + /* Set values to pass back */ + + *codeptr = code; + *ptrptr = ptr; + *firstbyteptr = firstbyte; + *reqbyteptr = reqbyte; + if (lengthptr != NULL) + { + if (OFLOW_MAX - *lengthptr < length) + { + *errorcodeptr = ERR20; + return FALSE; + } + *lengthptr += length; + } + return TRUE; + } + + /* Another branch follows. In the pre-compile phase, we can move the code + pointer back to where it was for the start of the first branch. (That is, + pretend that each branch is the only one.) + + In the real compile phase, insert an ALT node. Its length field points back + to the previous branch while the bracket remains open. At the end the chain + is reversed. It's done like this so that the start of the bracket has a + zero offset until it is closed, making it possible to detect recursion. */ + + if (lengthptr != NULL) + { + code = *codeptr + 1 + LINK_SIZE + skipbytes; + length += 1 + LINK_SIZE; + } + else + { + *code = OP_ALT; + PUT(code, 1, code - last_branch); + bc.current = last_branch = code; + code += 1 + LINK_SIZE; + } + + ptr++; + } +/* Control never reaches here */ +} + + + + +/************************************************* +* Check for anchored expression * +*************************************************/ + +/* Try to find out if this is an anchored regular expression. Consider each +alternative branch. If they all start with OP_SOD or OP_CIRC, or with a bracket +all of whose alternatives start with OP_SOD or OP_CIRC (recurse ad lib), then +it's anchored. However, if this is a multiline pattern, then only OP_SOD +counts, since OP_CIRC can match in the middle. + +We can also consider a regex to be anchored if OP_SOM starts all its branches. +This is the code for \G, which means "match at start of match position, taking +into account the match offset". + +A branch is also implicitly anchored if it starts with .* and DOTALL is set, +because that will try the rest of the pattern at all possible matching points, +so there is no point trying again.... er .... + +.... except when the .* appears inside capturing parentheses, and there is a +subsequent back reference to those parentheses. We haven't enough information +to catch that case precisely. + +At first, the best we could do was to detect when .* was in capturing brackets +and the highest back reference was greater than or equal to that level. +However, by keeping a bitmap of the first 31 back references, we can catch some +of the more common cases more precisely. + +Arguments: + code points to start of expression (the bracket) + options points to the options setting + bracket_map a bitmap of which brackets we are inside while testing; this + handles up to substring 31; after that we just have to take + the less precise approach + backref_map the back reference bitmap + +Returns: TRUE or FALSE +*/ + +static BOOL +is_anchored(register const uschar *code, int *options, unsigned int bracket_map, + unsigned int backref_map) +{ +do { + const uschar *scode = first_significant_code(code + _erts_pcre_OP_lengths[*code], + options, PCRE_MULTILINE, FALSE); + register int op = *scode; + + /* Non-capturing brackets */ + + if (op == OP_BRA) + { + if (!is_anchored(scode, options, bracket_map, backref_map)) return FALSE; + } + + /* Capturing brackets */ + + else if (op == OP_CBRA) + { + int n = GET2(scode, 1+LINK_SIZE); + int new_map = bracket_map | ((n < 32)? (1 << n) : 1); + if (!is_anchored(scode, options, new_map, backref_map)) return FALSE; + } + + /* Other brackets */ + + else if (op == OP_ASSERT || op == OP_ONCE || op == OP_COND) + { + if (!is_anchored(scode, options, bracket_map, backref_map)) return FALSE; + } + + /* .* is not anchored unless DOTALL is set and it isn't in brackets that + are or may be referenced. */ + + else if ((op == OP_TYPESTAR || op == OP_TYPEMINSTAR || + op == OP_TYPEPOSSTAR) && + (*options & PCRE_DOTALL) != 0) + { + if (scode[1] != OP_ANY || (bracket_map & backref_map) != 0) return FALSE; + } + + /* Check for explicit anchoring */ + + else if (op != OP_SOD && op != OP_SOM && + ((*options & PCRE_MULTILINE) != 0 || op != OP_CIRC)) + return FALSE; + code += GET(code, 1); + } +while (*code == OP_ALT); /* Loop for each alternative */ +return TRUE; +} + + + +/************************************************* +* Check for starting with ^ or .* * +*************************************************/ + +/* This is called to find out if every branch starts with ^ or .* so that +"first char" processing can be done to speed things up in multiline +matching and for non-DOTALL patterns that start with .* (which must start at +the beginning or after \n). As in the case of is_anchored() (see above), we +have to take account of back references to capturing brackets that contain .* +because in that case we can't make the assumption. + +Arguments: + code points to start of expression (the bracket) + bracket_map a bitmap of which brackets we are inside while testing; this + handles up to substring 31; after that we just have to take + the less precise approach + backref_map the back reference bitmap + +Returns: TRUE or FALSE +*/ + +static BOOL +is_startline(const uschar *code, unsigned int bracket_map, + unsigned int backref_map) +{ +do { + const uschar *scode = first_significant_code(code + _erts_pcre_OP_lengths[*code], + NULL, 0, FALSE); + register int op = *scode; + + /* Non-capturing brackets */ + + if (op == OP_BRA) + { + if (!is_startline(scode, bracket_map, backref_map)) return FALSE; + } + + /* Capturing brackets */ + + else if (op == OP_CBRA) + { + int n = GET2(scode, 1+LINK_SIZE); + int new_map = bracket_map | ((n < 32)? (1 << n) : 1); + if (!is_startline(scode, new_map, backref_map)) return FALSE; + } + + /* Other brackets */ + + else if (op == OP_ASSERT || op == OP_ONCE || op == OP_COND) + { if (!is_startline(scode, bracket_map, backref_map)) return FALSE; } + + /* .* means "start at start or after \n" if it isn't in brackets that + may be referenced. */ + + else if (op == OP_TYPESTAR || op == OP_TYPEMINSTAR || op == OP_TYPEPOSSTAR) + { + if (scode[1] != OP_ANY || (bracket_map & backref_map) != 0) return FALSE; + } + + /* Check for explicit circumflex */ + + else if (op != OP_CIRC) return FALSE; + + /* Move on to the next alternative */ + + code += GET(code, 1); + } +while (*code == OP_ALT); /* Loop for each alternative */ +return TRUE; +} + + + +/************************************************* +* Check for asserted fixed first char * +*************************************************/ + +/* During compilation, the "first char" settings from forward assertions are +discarded, because they can cause conflicts with actual literals that follow. +However, if we end up without a first char setting for an unanchored pattern, +it is worth scanning the regex to see if there is an initial asserted first +char. If all branches start with the same asserted char, or with a bracket all +of whose alternatives start with the same asserted char (recurse ad lib), then +we return that char, otherwise -1. + +Arguments: + code points to start of expression (the bracket) + options pointer to the options (used to check casing changes) + inassert TRUE if in an assertion + +Returns: -1 or the fixed first char +*/ + +static int +find_firstassertedchar(const uschar *code, int *options, BOOL inassert) +{ +register int c = -1; +do { + int d; + const uschar *scode = + first_significant_code(code + 1+LINK_SIZE, options, PCRE_CASELESS, TRUE); + register int op = *scode; + + switch(op) + { + default: + return -1; + + case OP_BRA: + case OP_CBRA: + case OP_ASSERT: + case OP_ONCE: + case OP_COND: + if ((d = find_firstassertedchar(scode, options, op == OP_ASSERT)) < 0) + return -1; + if (c < 0) c = d; else if (c != d) return -1; + break; + + case OP_EXACT: /* Fall through */ + scode += 2; + + case OP_CHAR: + case OP_CHARNC: + case OP_PLUS: + case OP_MINPLUS: + case OP_POSPLUS: + if (!inassert) return -1; + if (c < 0) + { + c = scode[1]; + if ((*options & PCRE_CASELESS) != 0) c |= REQ_CASELESS; + } + else if (c != scode[1]) return -1; + break; + } + + code += GET(code, 1); + } +while (*code == OP_ALT); +return c; +} + + + +/************************************************* +* Compile a Regular Expression * +*************************************************/ + +/* This function takes a string and returns a pointer to a block of store +holding a compiled version of the expression. The original API for this +function had no error code return variable; it is retained for backwards +compatibility. The new function is given a new name. + +Arguments: + pattern the regular expression + options various option bits + errorcodeptr pointer to error code variable (erts_pcre_compile2() only) + can be NULL if you don't want a code value + errorptr pointer to pointer to error text + erroroffset ptr offset in pattern where error was detected + tables pointer to character tables or NULL + +Returns: pointer to compiled data block, or NULL on error, + with errorptr and erroroffset set +*/ + +PCRE_EXP_DEFN pcre * +erts_pcre_compile(const char *pattern, int options, const char **errorptr, + int *erroroffset, const unsigned char *tables) +{ +return erts_pcre_compile2(pattern, options, NULL, errorptr, erroroffset, tables); +} + + +PCRE_EXP_DEFN pcre * +erts_pcre_compile2(const char *pattern, int options, int *errorcodeptr, + const char **errorptr, int *erroroffset, const unsigned char *tables) +{ +real_pcre *re; +int length = 1; /* For final END opcode */ +int firstbyte, reqbyte, newline; +int errorcode = 0; +int skipatstart = 0; +#ifdef SUPPORT_UTF8 +BOOL utf8; +#endif +size_t size; +uschar *code; +const uschar *codestart; +const uschar *ptr; +compile_data compile_block; +compile_data *cd = &compile_block; + +/* This space is used for "compiling" into during the first phase, when we are +computing the amount of memory that is needed. Compiled items are thrown away +as soon as possible, so that a fairly large buffer should be sufficient for +this purpose. The same space is used in the second phase for remembering where +to fill in forward references to subpatterns. */ + +uschar cworkspace[COMPILE_WORK_SIZE]; + +/* Set this early so that early errors get offset 0. */ + +ptr = (const uschar *)pattern; + +/* We can't pass back an error message if errorptr is NULL; I guess the best we +can do is just return NULL, but we can set a code value if there is a code +pointer. */ + +if (errorptr == NULL) + { + if (errorcodeptr != NULL) *errorcodeptr = 99; + return NULL; + } + +*errorptr = NULL; +if (errorcodeptr != NULL) *errorcodeptr = ERR0; + +/* However, we can give a message for this error */ + +if (erroroffset == NULL) + { + errorcode = ERR16; + goto PCRE_EARLY_ERROR_RETURN2; + } + +*erroroffset = 0; + +/* Can't support UTF8 unless PCRE has been compiled to include the code. */ + +#ifdef SUPPORT_UTF8 +utf8 = (options & PCRE_UTF8) != 0; +if (utf8 && (options & PCRE_NO_UTF8_CHECK) == 0 && + (*erroroffset = _erts_pcre_valid_utf8((uschar *)pattern, -1)) >= 0) + { + errorcode = ERR44; + goto PCRE_EARLY_ERROR_RETURN2; + } +#else +if ((options & PCRE_UTF8) != 0) + { + errorcode = ERR32; + goto PCRE_EARLY_ERROR_RETURN; + } +#endif + +if ((options & ~PUBLIC_OPTIONS) != 0) + { + errorcode = ERR17; + goto PCRE_EARLY_ERROR_RETURN; + } + +/* Set up pointers to the individual character tables */ + +if (tables == NULL) tables = _erts_pcre_default_tables; +cd->lcc = tables + lcc_offset; +cd->fcc = tables + fcc_offset; +cd->cbits = tables + cbits_offset; +cd->ctypes = tables + ctypes_offset; + +/* Check for global one-time settings at the start of the pattern, and remember +the offset for later. */ + +while (ptr[skipatstart] == '(' && ptr[skipatstart+1] == '*') + { + int newnl = 0; + int newbsr = 0; + + if (strncmp((char *)(ptr+skipatstart+2), "CR)", 3) == 0) + { skipatstart += 5; newnl = PCRE_NEWLINE_CR; } + else if (strncmp((char *)(ptr+skipatstart+2), "LF)", 3) == 0) + { skipatstart += 5; newnl = PCRE_NEWLINE_LF; } + else if (strncmp((char *)(ptr+skipatstart+2), "CRLF)", 5) == 0) + { skipatstart += 7; newnl = PCRE_NEWLINE_CR + PCRE_NEWLINE_LF; } + else if (strncmp((char *)(ptr+skipatstart+2), "ANY)", 4) == 0) + { skipatstart += 6; newnl = PCRE_NEWLINE_ANY; } + else if (strncmp((char *)(ptr+skipatstart+2), "ANYCRLF)", 8) == 0) + { skipatstart += 10; newnl = PCRE_NEWLINE_ANYCRLF; } + + else if (strncmp((char *)(ptr+skipatstart+2), "BSR_ANYCRLF)", 12) == 0) + { skipatstart += 14; newbsr = PCRE_BSR_ANYCRLF; } + else if (strncmp((char *)(ptr+skipatstart+2), "BSR_UNICODE)", 12) == 0) + { skipatstart += 14; newbsr = PCRE_BSR_UNICODE; } + + if (newnl != 0) + options = (options & ~PCRE_NEWLINE_BITS) | newnl; + else if (newbsr != 0) + options = (options & ~(PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE)) | newbsr; + else break; + } + +/* Check validity of \R options. */ + +switch (options & (PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE)) + { + case 0: + case PCRE_BSR_ANYCRLF: + case PCRE_BSR_UNICODE: + break; + default: errorcode = ERR56; goto PCRE_EARLY_ERROR_RETURN; + } + +/* Handle different types of newline. The three bits give seven cases. The +current code allows for fixed one- or two-byte sequences, plus "any" and +"anycrlf". */ + +switch (options & PCRE_NEWLINE_BITS) + { + case 0: newline = NEWLINE; break; /* Build-time default */ + case PCRE_NEWLINE_CR: newline = '\r'; break; + case PCRE_NEWLINE_LF: newline = '\n'; break; + case PCRE_NEWLINE_CR+ + PCRE_NEWLINE_LF: newline = ('\r' << 8) | '\n'; break; + case PCRE_NEWLINE_ANY: newline = -1; break; + case PCRE_NEWLINE_ANYCRLF: newline = -2; break; + default: errorcode = ERR56; goto PCRE_EARLY_ERROR_RETURN; + } + +if (newline == -2) + { + cd->nltype = NLTYPE_ANYCRLF; + } +else if (newline < 0) + { + cd->nltype = NLTYPE_ANY; + } +else + { + cd->nltype = NLTYPE_FIXED; + if (newline > 255) + { + cd->nllen = 2; + cd->nl[0] = (newline >> 8) & 255; + cd->nl[1] = newline & 255; + } + else + { + cd->nllen = 1; + cd->nl[0] = newline; + } + } + +/* Maximum back reference and backref bitmap. The bitmap records up to 31 back +references to help in deciding whether (.*) can be treated as anchored or not. +*/ + +cd->top_backref = 0; +cd->backref_map = 0; + +/* Reflect pattern for debugging output */ + +DPRINTF(("------------------------------------------------------------------\n")); +DPRINTF(("%s\n", pattern)); + +/* Pretend to compile the pattern while actually just accumulating the length +of memory required. This behaviour is triggered by passing a non-NULL final +argument to compile_regex(). We pass a block of workspace (cworkspace) for it +to compile parts of the pattern into; the compiled code is discarded when it is +no longer needed, so hopefully this workspace will never overflow, though there +is a test for its doing so. */ + +cd->bracount = cd->final_bracount = 0; +cd->names_found = 0; +cd->name_entry_size = 0; +cd->name_table = NULL; +cd->start_workspace = cworkspace; +cd->start_code = cworkspace; +cd->hwm = cworkspace; +cd->start_pattern = (const uschar *)pattern; +cd->end_pattern = (const uschar *)(pattern + strlen(pattern)); +cd->req_varyopt = 0; +cd->external_options = options; +cd->external_flags = 0; + +/* Now do the pre-compile. On error, errorcode will be set non-zero, so we +don't need to look at the result of the function here. The initial options have +been put into the cd block so that they can be changed if an option setting is +found within the regex right at the beginning. Bringing initial option settings +outside can help speed up starting point checks. */ + +ptr += skipatstart; +code = cworkspace; +*code = OP_BRA; +(void)compile_regex(cd->external_options, cd->external_options & PCRE_IMS, + &code, &ptr, &errorcode, FALSE, FALSE, 0, &firstbyte, &reqbyte, NULL, cd, + &length); +if (errorcode != 0) goto PCRE_EARLY_ERROR_RETURN; + +DPRINTF(("end pre-compile: length=%d workspace=%d\n", length, + cd->hwm - cworkspace)); + +if (length > MAX_PATTERN_SIZE) + { + errorcode = ERR20; + goto PCRE_EARLY_ERROR_RETURN; + } + +/* Compute the size of data block needed and get it, either from malloc or +externally provided function. Integer overflow should no longer be possible +because nowadays we limit the maximum value of cd->names_found and +cd->name_entry_size. */ + +size = length + sizeof(real_pcre) + cd->names_found * (cd->name_entry_size + 3); +re = (real_pcre *)(erts_pcre_malloc)(size); + +if (re == NULL) + { + errorcode = ERR21; + goto PCRE_EARLY_ERROR_RETURN; + } + +/* Put in the magic number, and save the sizes, initial options, internal +flags, and character table pointer. NULL is used for the default character +tables. The nullpad field is at the end; it's there to help in the case when a +regex compiled on a system with 4-byte pointers is run on another with 8-byte +pointers. */ + +re->magic_number = MAGIC_NUMBER; +re->size = size; +re->options = cd->external_options; +re->flags = cd->external_flags; +re->dummy1 = 0; +re->first_byte = 0; +re->req_byte = 0; +re->name_table_offset = sizeof(real_pcre); +re->name_entry_size = cd->name_entry_size; +re->name_count = cd->names_found; +re->ref_count = 0; +re->tables = (tables == _erts_pcre_default_tables)? NULL : tables; +re->nullpad = NULL; + +/* The starting points of the name/number translation table and of the code are +passed around in the compile data block. The start/end pattern and initial +options are already set from the pre-compile phase, as is the name_entry_size +field. Reset the bracket count and the names_found field. Also reset the hwm +field; this time it's used for remembering forward references to subpatterns. +*/ + +cd->final_bracount = cd->bracount; /* Save for checking forward references */ +cd->bracount = 0; +cd->names_found = 0; +cd->name_table = (uschar *)re + re->name_table_offset; +codestart = cd->name_table + re->name_entry_size * re->name_count; +cd->start_code = codestart; +cd->hwm = cworkspace; +cd->req_varyopt = 0; +cd->had_accept = FALSE; + +/* Set up a starting, non-extracting bracket, then compile the expression. On +error, errorcode will be set non-zero, so we don't need to look at the result +of the function here. */ + +ptr = (const uschar *)pattern + skipatstart; +code = (uschar *)codestart; +*code = OP_BRA; +(void)compile_regex(re->options, re->options & PCRE_IMS, &code, &ptr, + &errorcode, FALSE, FALSE, 0, &firstbyte, &reqbyte, NULL, cd, NULL); +re->top_bracket = cd->bracount; +re->top_backref = cd->top_backref; +re->flags = cd->external_flags; + +if (cd->had_accept) reqbyte = -1; /* Must disable after (*ACCEPT) */ + +/* If not reached end of pattern on success, there's an excess bracket. */ + +if (errorcode == 0 && *ptr != 0) errorcode = ERR22; + +/* Fill in the terminating state and check for disastrous overflow, but +if debugging, leave the test till after things are printed out. */ + +*code++ = OP_END; + +#ifndef DEBUG +if (code - codestart > length) errorcode = ERR23; +#endif + +/* Fill in any forward references that are required. */ + +while (errorcode == 0 && cd->hwm > cworkspace) + { + int offset, recno; + const uschar *groupptr; + cd->hwm -= LINK_SIZE; + offset = GET(cd->hwm, 0); + recno = GET(codestart, offset); + groupptr = find_bracket(codestart, (re->options & PCRE_UTF8) != 0, recno); + if (groupptr == NULL) errorcode = ERR53; + else PUT(((uschar *)codestart), offset, groupptr - codestart); + } + +/* Give an error if there's back reference to a non-existent capturing +subpattern. */ + +if (errorcode == 0 && re->top_backref > re->top_bracket) errorcode = ERR15; + +/* Failed to compile, or error while post-processing */ + +if (errorcode != 0) + { + (erts_pcre_free)(re); + PCRE_EARLY_ERROR_RETURN: + *erroroffset = ptr - (const uschar *)pattern; + PCRE_EARLY_ERROR_RETURN2: + *errorptr = find_error_text(errorcode); + if (errorcodeptr != NULL) *errorcodeptr = errorcode; + return NULL; + } + +/* If the anchored option was not passed, set the flag if we can determine that +the pattern is anchored by virtue of ^ characters or \A or anything else (such +as starting with .* when DOTALL is set). + +Otherwise, if we know what the first byte has to be, save it, because that +speeds up unanchored matches no end. If not, see if we can set the +PCRE_STARTLINE flag. This is helpful for multiline matches when all branches +start with ^. and also when all branches start with .* for non-DOTALL matches. +*/ + +if ((re->options & PCRE_ANCHORED) == 0) + { + int temp_options = re->options; /* May get changed during these scans */ + if (is_anchored(codestart, &temp_options, 0, cd->backref_map)) + re->options |= PCRE_ANCHORED; + else + { + if (firstbyte < 0) + firstbyte = find_firstassertedchar(codestart, &temp_options, FALSE); + if (firstbyte >= 0) /* Remove caseless flag for non-caseable chars */ + { + int ch = firstbyte & 255; + re->first_byte = ((firstbyte & REQ_CASELESS) != 0 && + cd->fcc[ch] == ch)? ch : firstbyte; + re->flags |= PCRE_FIRSTSET; + } + else if (is_startline(codestart, 0, cd->backref_map)) + re->flags |= PCRE_STARTLINE; + } + } + +/* For an anchored pattern, we use the "required byte" only if it follows a +variable length item in the regex. Remove the caseless flag for non-caseable +bytes. */ + +if (reqbyte >= 0 && + ((re->options & PCRE_ANCHORED) == 0 || (reqbyte & REQ_VARY) != 0)) + { + int ch = reqbyte & 255; + re->req_byte = ((reqbyte & REQ_CASELESS) != 0 && + cd->fcc[ch] == ch)? (reqbyte & ~REQ_CASELESS) : reqbyte; + re->flags |= PCRE_REQCHSET; + } + +/* Print out the compiled data if debugging is enabled. This is never the +case when building a production library. */ + +#ifdef DEBUG + +printf("Length = %d top_bracket = %d top_backref = %d\n", + length, re->top_bracket, re->top_backref); + +printf("Options=%08x\n", re->options); + +if ((re->flags & PCRE_FIRSTSET) != 0) + { + int ch = re->first_byte & 255; + const char *caseless = ((re->first_byte & REQ_CASELESS) == 0)? + "" : " (caseless)"; + if (isprint(ch)) printf("First char = %c%s\n", ch, caseless); + else printf("First char = \\x%02x%s\n", ch, caseless); + } + +if ((re->flags & PCRE_REQCHSET) != 0) + { + int ch = re->req_byte & 255; + const char *caseless = ((re->req_byte & REQ_CASELESS) == 0)? + "" : " (caseless)"; + if (isprint(ch)) printf("Req char = %c%s\n", ch, caseless); + else printf("Req char = \\x%02x%s\n", ch, caseless); + } + +pcre_printint(re, stdout, TRUE); + +/* This check is done here in the debugging case so that the code that +was compiled can be seen. */ + +if (code - codestart > length) + { + (erts_pcre_free)(re); + *errorptr = find_error_text(ERR23); + *erroroffset = ptr - (uschar *)pattern; + if (errorcodeptr != NULL) *errorcodeptr = ERR23; + return NULL; + } +#endif /* DEBUG */ + +return (pcre *)re; +} + +/* End of pcre_compile.c */ diff --git a/erts/emulator/pcre/pcre_config.c b/erts/emulator/pcre/pcre_config.c new file mode 100644 index 0000000000..122327d67d --- /dev/null +++ b/erts/emulator/pcre/pcre_config.c @@ -0,0 +1,129 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_config(). */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Return info about what features are configured * +*************************************************/ + +/* This function has an extensible interface so that additional items can be +added compatibly. + +Arguments: + what what information is required + where where to put the information + +Returns: 0 if data returned, negative on error +*/ + +PCRE_EXP_DEFN int +erts_pcre_config(int what, void *where) +{ +switch (what) + { + case PCRE_CONFIG_UTF8: +#ifdef SUPPORT_UTF8 + *((int *)where) = 1; +#else + *((int *)where) = 0; +#endif + break; + + case PCRE_CONFIG_UNICODE_PROPERTIES: +#ifdef SUPPORT_UCP + *((int *)where) = 1; +#else + *((int *)where) = 0; +#endif + break; + + case PCRE_CONFIG_NEWLINE: + *((int *)where) = NEWLINE; + break; + + case PCRE_CONFIG_BSR: +#ifdef BSR_ANYCRLF + *((int *)where) = 1; +#else + *((int *)where) = 0; +#endif + break; + + case PCRE_CONFIG_LINK_SIZE: + *((int *)where) = LINK_SIZE; + break; + + case PCRE_CONFIG_POSIX_MALLOC_THRESHOLD: + *((int *)where) = POSIX_MALLOC_THRESHOLD; + break; + + case PCRE_CONFIG_MATCH_LIMIT: + *((unsigned int *)where) = MATCH_LIMIT; + break; + + case PCRE_CONFIG_MATCH_LIMIT_RECURSION: + *((unsigned int *)where) = MATCH_LIMIT_RECURSION; + break; + + case PCRE_CONFIG_STACKRECURSE: +#ifdef NO_RECURSE + *((int *)where) = 0; +#else + *((int *)where) = 1; +#endif + break; + + default: return PCRE_ERROR_BADOPTION; + } + +return 0; +} + +/* End of pcre_config.c */ diff --git a/erts/emulator/pcre/pcre_dfa_exec.c b/erts/emulator/pcre/pcre_dfa_exec.c new file mode 100644 index 0000000000..a6e501317f --- /dev/null +++ b/erts/emulator/pcre/pcre_dfa_exec.c @@ -0,0 +1,2897 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_dfa_exec(), which is an +alternative matching function that uses a sort of DFA algorithm (not a true +FSM). This is NOT Perl- compatible, but it has advantages in certain +applications. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#define NLBLOCK md /* Block containing newline information */ +#define PSSTART start_subject /* Field containing processed string start */ +#define PSEND end_subject /* Field containing processed string end */ + +#include "pcre_internal.h" + + +/* For use to indent debugging output */ + +#define SP " " + + + +/************************************************* +* Code parameters and static tables * +*************************************************/ + +/* These are offsets that are used to turn the OP_TYPESTAR and friends opcodes +into others, under special conditions. A gap of 20 between the blocks should be +enough. The resulting opcodes don't have to be less than 256 because they are +never stored, so we push them well clear of the normal opcodes. */ + +#define OP_PROP_EXTRA 300 +#define OP_EXTUNI_EXTRA 320 +#define OP_ANYNL_EXTRA 340 +#define OP_HSPACE_EXTRA 360 +#define OP_VSPACE_EXTRA 380 + + +/* This table identifies those opcodes that are followed immediately by a +character that is to be tested in some way. This makes is possible to +centralize the loading of these characters. In the case of Type * etc, the +"character" is the opcode for \D, \d, \S, \s, \W, or \w, which will always be a +small value. ***NOTE*** If the start of this table is modified, the two tables +that follow must also be modified. */ + +static uschar coptable[] = { + 0, /* End */ + 0, 0, 0, 0, 0, /* \A, \G, \K, \B, \b */ + 0, 0, 0, 0, 0, 0, /* \D, \d, \S, \s, \W, \w */ + 0, 0, /* Any, Anybyte */ + 0, 0, 0, /* NOTPROP, PROP, EXTUNI */ + 0, 0, 0, 0, 0, /* \R, \H, \h, \V, \v */ + 0, 0, 0, 0, 0, /* \Z, \z, Opt, ^, $ */ + 1, /* Char */ + 1, /* Charnc */ + 1, /* not */ + /* Positive single-char repeats */ + 1, 1, 1, 1, 1, 1, /* *, *?, +, +?, ?, ?? */ + 3, 3, 3, /* upto, minupto, exact */ + 1, 1, 1, 3, /* *+, ++, ?+, upto+ */ + /* Negative single-char repeats - only for chars < 256 */ + 1, 1, 1, 1, 1, 1, /* NOT *, *?, +, +?, ?, ?? */ + 3, 3, 3, /* NOT upto, minupto, exact */ + 1, 1, 1, 3, /* NOT *+, ++, ?+, updo+ */ + /* Positive type repeats */ + 1, 1, 1, 1, 1, 1, /* Type *, *?, +, +?, ?, ?? */ + 3, 3, 3, /* Type upto, minupto, exact */ + 1, 1, 1, 3, /* Type *+, ++, ?+, upto+ */ + /* Character class & ref repeats */ + 0, 0, 0, 0, 0, 0, /* *, *?, +, +?, ?, ?? */ + 0, 0, /* CRRANGE, CRMINRANGE */ + 0, /* CLASS */ + 0, /* NCLASS */ + 0, /* XCLASS - variable length */ + 0, /* REF */ + 0, /* RECURSE */ + 0, /* CALLOUT */ + 0, /* Alt */ + 0, /* Ket */ + 0, /* KetRmax */ + 0, /* KetRmin */ + 0, /* Assert */ + 0, /* Assert not */ + 0, /* Assert behind */ + 0, /* Assert behind not */ + 0, /* Reverse */ + 0, 0, 0, 0, /* ONCE, BRA, CBRA, COND */ + 0, 0, 0, /* SBRA, SCBRA, SCOND */ + 0, /* CREF */ + 0, /* RREF */ + 0, /* DEF */ + 0, 0, /* BRAZERO, BRAMINZERO */ + 0, 0, 0, 0, /* PRUNE, SKIP, THEN, COMMIT */ + 0, 0 /* FAIL, ACCEPT */ +}; + +/* These 2 tables allow for compact code for testing for \D, \d, \S, \s, \W, +and \w */ + +static uschar toptable1[] = { + 0, 0, 0, 0, 0, 0, + ctype_digit, ctype_digit, + ctype_space, ctype_space, + ctype_word, ctype_word, + 0 /* OP_ANY */ +}; + +static uschar toptable2[] = { + 0, 0, 0, 0, 0, 0, + ctype_digit, 0, + ctype_space, 0, + ctype_word, 0, + 1 /* OP_ANY */ +}; + + +/* Structure for holding data about a particular state, which is in effect the +current data for an active path through the match tree. It must consist +entirely of ints because the working vector we are passed, and which we put +these structures in, is a vector of ints. */ + +typedef struct stateblock { + int offset; /* Offset to opcode */ + int count; /* Count for repeats */ + int ims; /* ims flag bits */ + int data; /* Some use extra data */ +} stateblock; + +#define INTS_PER_STATEBLOCK (sizeof(stateblock)/sizeof(int)) + + +#ifdef DEBUG +/************************************************* +* Print character string * +*************************************************/ + +/* Character string printing function for debugging. + +Arguments: + p points to string + length number of bytes + f where to print + +Returns: nothing +*/ + +static void +pchars(unsigned char *p, int length, FILE *f) +{ +int c; +while (length-- > 0) + { + if (isprint(c = *(p++))) + fprintf(f, "%c", c); + else + fprintf(f, "\\x%02x", c); + } +} +#endif + + + +/************************************************* +* Execute a Regular Expression - DFA engine * +*************************************************/ + +/* This internal function applies a compiled pattern to a subject string, +starting at a given point, using a DFA engine. This function is called from the +external one, possibly multiple times if the pattern is not anchored. The +function calls itself recursively for some kinds of subpattern. + +Arguments: + md the match_data block with fixed information + this_start_code the opening bracket of this subexpression's code + current_subject where we currently are in the subject string + start_offset start offset in the subject string + offsets vector to contain the matching string offsets + offsetcount size of same + workspace vector of workspace + wscount size of same + ims the current ims flags + rlevel function call recursion level + recursing regex recursive call level + +Returns: > 0 => + = 0 => + -1 => failed to match + < -1 => some kind of unexpected problem + +The following macros are used for adding states to the two state vectors (one +for the current character, one for the following character). */ + +#define ADD_ACTIVE(x,y) \ + if (active_count++ < wscount) \ + { \ + next_active_state->offset = (x); \ + next_active_state->count = (y); \ + next_active_state->ims = ims; \ + next_active_state++; \ + DPRINTF(("%.*sADD_ACTIVE(%d,%d)\n", rlevel*2-2, SP, (x), (y))); \ + } \ + else return PCRE_ERROR_DFA_WSSIZE + +#define ADD_ACTIVE_DATA(x,y,z) \ + if (active_count++ < wscount) \ + { \ + next_active_state->offset = (x); \ + next_active_state->count = (y); \ + next_active_state->ims = ims; \ + next_active_state->data = (z); \ + next_active_state++; \ + DPRINTF(("%.*sADD_ACTIVE_DATA(%d,%d,%d)\n", rlevel*2-2, SP, (x), (y), (z))); \ + } \ + else return PCRE_ERROR_DFA_WSSIZE + +#define ADD_NEW(x,y) \ + if (new_count++ < wscount) \ + { \ + next_new_state->offset = (x); \ + next_new_state->count = (y); \ + next_new_state->ims = ims; \ + next_new_state++; \ + DPRINTF(("%.*sADD_NEW(%d,%d)\n", rlevel*2-2, SP, (x), (y))); \ + } \ + else return PCRE_ERROR_DFA_WSSIZE + +#define ADD_NEW_DATA(x,y,z) \ + if (new_count++ < wscount) \ + { \ + next_new_state->offset = (x); \ + next_new_state->count = (y); \ + next_new_state->ims = ims; \ + next_new_state->data = (z); \ + next_new_state++; \ + DPRINTF(("%.*sADD_NEW_DATA(%d,%d,%d)\n", rlevel*2-2, SP, (x), (y), (z))); \ + } \ + else return PCRE_ERROR_DFA_WSSIZE + +/* And now, here is the code */ + +static int +internal_dfa_exec( + dfa_match_data *md, + const uschar *this_start_code, + const uschar *current_subject, + int start_offset, + int *offsets, + int offsetcount, + int *workspace, + int wscount, + int ims, + int rlevel, + int recursing) +{ +stateblock *active_states, *new_states, *temp_states; +stateblock *next_active_state, *next_new_state; + +const uschar *ctypes, *lcc, *fcc; +const uschar *ptr; +const uschar *end_code, *first_op; + +int active_count, new_count, match_count; + +/* Some fields in the md block are frequently referenced, so we load them into +independent variables in the hope that this will perform better. */ + +const uschar *start_subject = md->start_subject; +const uschar *end_subject = md->end_subject; +const uschar *start_code = md->start_code; + +#ifdef SUPPORT_UTF8 +BOOL utf8 = (md->poptions & PCRE_UTF8) != 0; +#else +BOOL utf8 = FALSE; +#endif + +rlevel++; +offsetcount &= (-2); + +wscount -= 2; +wscount = (wscount - (wscount % (INTS_PER_STATEBLOCK * 2))) / + (2 * INTS_PER_STATEBLOCK); + +DPRINTF(("\n%.*s---------------------\n" + "%.*sCall to internal_dfa_exec f=%d r=%d\n", + rlevel*2-2, SP, rlevel*2-2, SP, rlevel, recursing)); + +ctypes = md->tables + ctypes_offset; +lcc = md->tables + lcc_offset; +fcc = md->tables + fcc_offset; + +match_count = PCRE_ERROR_NOMATCH; /* A negative number */ + +active_states = (stateblock *)(workspace + 2); +next_new_state = new_states = active_states + wscount; +new_count = 0; + +first_op = this_start_code + 1 + LINK_SIZE + + ((*this_start_code == OP_CBRA || *this_start_code == OP_SCBRA)? 2:0); + +/* The first thing in any (sub) pattern is a bracket of some sort. Push all +the alternative states onto the list, and find out where the end is. This +makes is possible to use this function recursively, when we want to stop at a +matching internal ket rather than at the end. + +If the first opcode in the first alternative is OP_REVERSE, we are dealing with +a backward assertion. In that case, we have to find out the maximum amount to +move back, and set up each alternative appropriately. */ + +if (*first_op == OP_REVERSE) + { + int max_back = 0; + int gone_back; + + end_code = this_start_code; + do + { + int back = GET(end_code, 2+LINK_SIZE); + if (back > max_back) max_back = back; + end_code += GET(end_code, 1); + } + while (*end_code == OP_ALT); + + /* If we can't go back the amount required for the longest lookbehind + pattern, go back as far as we can; some alternatives may still be viable. */ + +#ifdef SUPPORT_UTF8 + /* In character mode we have to step back character by character */ + + if (utf8) + { + for (gone_back = 0; gone_back < max_back; gone_back++) + { + if (current_subject <= start_subject) break; + current_subject--; + while (current_subject > start_subject && + (*current_subject & 0xc0) == 0x80) + current_subject--; + } + } + else +#endif + + /* In byte-mode we can do this quickly. */ + + { + gone_back = (current_subject - max_back < start_subject)? + current_subject - start_subject : max_back; + current_subject -= gone_back; + } + + /* Now we can process the individual branches. */ + + end_code = this_start_code; + do + { + int back = GET(end_code, 2+LINK_SIZE); + if (back <= gone_back) + { + int bstate = end_code - start_code + 2 + 2*LINK_SIZE; + ADD_NEW_DATA(-bstate, 0, gone_back - back); + } + end_code += GET(end_code, 1); + } + while (*end_code == OP_ALT); + } + +/* This is the code for a "normal" subpattern (not a backward assertion). The +start of a whole pattern is always one of these. If we are at the top level, +we may be asked to restart matching from the same point that we reached for a +previous partial match. We still have to scan through the top-level branches to +find the end state. */ + +else + { + end_code = this_start_code; + + /* Restarting */ + + if (rlevel == 1 && (md->moptions & PCRE_DFA_RESTART) != 0) + { + do { end_code += GET(end_code, 1); } while (*end_code == OP_ALT); + new_count = workspace[1]; + if (!workspace[0]) + memcpy(new_states, active_states, new_count * sizeof(stateblock)); + } + + /* Not restarting */ + + else + { + int length = 1 + LINK_SIZE + + ((*this_start_code == OP_CBRA || *this_start_code == OP_SCBRA)? 2:0); + do + { + ADD_NEW(end_code - start_code + length, 0); + end_code += GET(end_code, 1); + length = 1 + LINK_SIZE; + } + while (*end_code == OP_ALT); + } + } + +workspace[0] = 0; /* Bit indicating which vector is current */ + +DPRINTF(("%.*sEnd state = %d\n", rlevel*2-2, SP, end_code - start_code)); + +/* Loop for scanning the subject */ + +ptr = current_subject; +for (;;) + { + int i, j; + int clen, dlen; + unsigned int c, d; + + /* Make the new state list into the active state list and empty the + new state list. */ + + temp_states = active_states; + active_states = new_states; + new_states = temp_states; + active_count = new_count; + new_count = 0; + + workspace[0] ^= 1; /* Remember for the restarting feature */ + workspace[1] = active_count; + +#ifdef DEBUG + printf("%.*sNext character: rest of subject = \"", rlevel*2-2, SP); + pchars((uschar *)ptr, strlen((char *)ptr), stdout); + printf("\"\n"); + + printf("%.*sActive states: ", rlevel*2-2, SP); + for (i = 0; i < active_count; i++) + printf("%d/%d ", active_states[i].offset, active_states[i].count); + printf("\n"); +#endif + + /* Set the pointers for adding new states */ + + next_active_state = active_states + active_count; + next_new_state = new_states; + + /* Load the current character from the subject outside the loop, as many + different states may want to look at it, and we assume that at least one + will. */ + + if (ptr < end_subject) + { + clen = 1; /* Number of bytes in the character */ +#ifdef SUPPORT_UTF8 + if (utf8) { GETCHARLEN(c, ptr, clen); } else +#endif /* SUPPORT_UTF8 */ + c = *ptr; + } + else + { + clen = 0; /* This indicates the end of the subject */ + c = NOTACHAR; /* This value should never actually be used */ + } + + /* Scan up the active states and act on each one. The result of an action + may be to add more states to the currently active list (e.g. on hitting a + parenthesis) or it may be to put states on the new list, for considering + when we move the character pointer on. */ + + for (i = 0; i < active_count; i++) + { + stateblock *current_state = active_states + i; + const uschar *code; + int state_offset = current_state->offset; + int count, codevalue; +#ifdef SUPPORT_UCP + int chartype, script; +#endif + +#ifdef DEBUG + printf ("%.*sProcessing state %d c=", rlevel*2-2, SP, state_offset); + if (clen == 0) printf("EOL\n"); + else if (c > 32 && c < 127) printf("'%c'\n", c); + else printf("0x%02x\n", c); +#endif + + /* This variable is referred to implicity in the ADD_xxx macros. */ + + ims = current_state->ims; + + /* A negative offset is a special case meaning "hold off going to this + (negated) state until the number of characters in the data field have + been skipped". */ + + if (state_offset < 0) + { + if (current_state->data > 0) + { + DPRINTF(("%.*sSkipping this character\n", rlevel*2-2, SP)); + ADD_NEW_DATA(state_offset, current_state->count, + current_state->data - 1); + continue; + } + else + { + current_state->offset = state_offset = -state_offset; + } + } + + /* Check for a duplicate state with the same count, and skip if found. */ + + for (j = 0; j < i; j++) + { + if (active_states[j].offset == state_offset && + active_states[j].count == current_state->count) + { + DPRINTF(("%.*sDuplicate state: skipped\n", rlevel*2-2, SP)); + goto NEXT_ACTIVE_STATE; + } + } + + /* The state offset is the offset to the opcode */ + + code = start_code + state_offset; + codevalue = *code; + + /* If this opcode is followed by an inline character, load it. It is + tempting to test for the presence of a subject character here, but that + is wrong, because sometimes zero repetitions of the subject are + permitted. + + We also use this mechanism for opcodes such as OP_TYPEPLUS that take an + argument that is not a data character - but is always one byte long. We + have to take special action to deal with \P, \p, \H, \h, \V, \v and \X in + this case. To keep the other cases fast, convert these ones to new opcodes. + */ + + if (coptable[codevalue] > 0) + { + dlen = 1; +#ifdef SUPPORT_UTF8 + if (utf8) { GETCHARLEN(d, (code + coptable[codevalue]), dlen); } else +#endif /* SUPPORT_UTF8 */ + d = code[coptable[codevalue]]; + if (codevalue >= OP_TYPESTAR) + { + switch(d) + { + case OP_ANYBYTE: return PCRE_ERROR_DFA_UITEM; + case OP_NOTPROP: + case OP_PROP: codevalue += OP_PROP_EXTRA; break; + case OP_ANYNL: codevalue += OP_ANYNL_EXTRA; break; + case OP_EXTUNI: codevalue += OP_EXTUNI_EXTRA; break; + case OP_NOT_HSPACE: + case OP_HSPACE: codevalue += OP_HSPACE_EXTRA; break; + case OP_NOT_VSPACE: + case OP_VSPACE: codevalue += OP_VSPACE_EXTRA; break; + default: break; + } + } + } + else + { + dlen = 0; /* Not strictly necessary, but compilers moan */ + d = NOTACHAR; /* if these variables are not set. */ + } + + + /* Now process the individual opcodes */ + + switch (codevalue) + { + +/* ========================================================================== */ + /* Reached a closing bracket. If not at the end of the pattern, carry + on with the next opcode. Otherwise, unless we have an empty string and + PCRE_NOTEMPTY is set, save the match data, shifting up all previous + matches so we always have the longest first. */ + + case OP_KET: + case OP_KETRMIN: + case OP_KETRMAX: + if (code != end_code) + { + ADD_ACTIVE(state_offset + 1 + LINK_SIZE, 0); + if (codevalue != OP_KET) + { + ADD_ACTIVE(state_offset - GET(code, 1), 0); + } + } + else if (ptr > current_subject || (md->moptions & PCRE_NOTEMPTY) == 0) + { + if (match_count < 0) match_count = (offsetcount >= 2)? 1 : 0; + else if (match_count > 0 && ++match_count * 2 >= offsetcount) + match_count = 0; + count = ((match_count == 0)? offsetcount : match_count * 2) - 2; + if (count > 0) memmove(offsets + 2, offsets, count * sizeof(int)); + if (offsetcount >= 2) + { + offsets[0] = current_subject - start_subject; + offsets[1] = ptr - start_subject; + DPRINTF(("%.*sSet matched string = \"%.*s\"\n", rlevel*2-2, SP, + offsets[1] - offsets[0], current_subject)); + } + if ((md->moptions & PCRE_DFA_SHORTEST) != 0) + { + DPRINTF(("%.*sEnd of internal_dfa_exec %d: returning %d\n" + "%.*s---------------------\n\n", rlevel*2-2, SP, rlevel, + match_count, rlevel*2-2, SP)); + return match_count; + } + } + break; + +/* ========================================================================== */ + /* These opcodes add to the current list of states without looking + at the current character. */ + + /*-----------------------------------------------------------------*/ + case OP_ALT: + do { code += GET(code, 1); } while (*code == OP_ALT); + ADD_ACTIVE(code - start_code, 0); + break; + + /*-----------------------------------------------------------------*/ + case OP_BRA: + case OP_SBRA: + do + { + ADD_ACTIVE(code - start_code + 1 + LINK_SIZE, 0); + code += GET(code, 1); + } + while (*code == OP_ALT); + break; + + /*-----------------------------------------------------------------*/ + case OP_CBRA: + case OP_SCBRA: + ADD_ACTIVE(code - start_code + 3 + LINK_SIZE, 0); + code += GET(code, 1); + while (*code == OP_ALT) + { + ADD_ACTIVE(code - start_code + 1 + LINK_SIZE, 0); + code += GET(code, 1); + } + break; + + /*-----------------------------------------------------------------*/ + case OP_BRAZERO: + case OP_BRAMINZERO: + ADD_ACTIVE(state_offset + 1, 0); + code += 1 + GET(code, 2); + while (*code == OP_ALT) code += GET(code, 1); + ADD_ACTIVE(code - start_code + 1 + LINK_SIZE, 0); + break; + + /*-----------------------------------------------------------------*/ + case OP_CIRC: + if ((ptr == start_subject && (md->moptions & PCRE_NOTBOL) == 0) || + ((ims & PCRE_MULTILINE) != 0 && + ptr != end_subject && + WAS_NEWLINE(ptr))) + { ADD_ACTIVE(state_offset + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + case OP_EOD: + if (ptr >= end_subject) { ADD_ACTIVE(state_offset + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + case OP_OPT: + ims = code[1]; + ADD_ACTIVE(state_offset + 2, 0); + break; + + /*-----------------------------------------------------------------*/ + case OP_SOD: + if (ptr == start_subject) { ADD_ACTIVE(state_offset + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + case OP_SOM: + if (ptr == start_subject + start_offset) { ADD_ACTIVE(state_offset + 1, 0); } + break; + + +/* ========================================================================== */ + /* These opcodes inspect the next subject character, and sometimes + the previous one as well, but do not have an argument. The variable + clen contains the length of the current character and is zero if we are + at the end of the subject. */ + + /*-----------------------------------------------------------------*/ + case OP_ANY: + if (clen > 0 && ((ims & PCRE_DOTALL) != 0 || !IS_NEWLINE(ptr))) + { ADD_NEW(state_offset + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + case OP_EODN: + if (clen == 0 || (IS_NEWLINE(ptr) && ptr == end_subject - md->nllen)) + { ADD_ACTIVE(state_offset + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + case OP_DOLL: + if ((md->moptions & PCRE_NOTEOL) == 0) + { + if (clen == 0 || + (IS_NEWLINE(ptr) && + ((ims & PCRE_MULTILINE) != 0 || ptr == end_subject - md->nllen) + )) + { ADD_ACTIVE(state_offset + 1, 0); } + } + else if ((ims & PCRE_MULTILINE) != 0 && IS_NEWLINE(ptr)) + { ADD_ACTIVE(state_offset + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + + case OP_DIGIT: + case OP_WHITESPACE: + case OP_WORDCHAR: + if (clen > 0 && c < 256 && + ((ctypes[c] & toptable1[codevalue]) ^ toptable2[codevalue]) != 0) + { ADD_NEW(state_offset + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + case OP_NOT_DIGIT: + case OP_NOT_WHITESPACE: + case OP_NOT_WORDCHAR: + if (clen > 0 && (c >= 256 || + ((ctypes[c] & toptable1[codevalue]) ^ toptable2[codevalue]) != 0)) + { ADD_NEW(state_offset + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + case OP_WORD_BOUNDARY: + case OP_NOT_WORD_BOUNDARY: + { + int left_word, right_word; + + if (ptr > start_subject) + { + const uschar *temp = ptr - 1; +#ifdef SUPPORT_UTF8 + if (utf8) BACKCHAR(temp); +#endif + GETCHARTEST(d, temp); + left_word = d < 256 && (ctypes[d] & ctype_word) != 0; + } + else left_word = 0; + + if (clen > 0) right_word = c < 256 && (ctypes[c] & ctype_word) != 0; + else right_word = 0; + + if ((left_word == right_word) == (codevalue == OP_NOT_WORD_BOUNDARY)) + { ADD_ACTIVE(state_offset + 1, 0); } + } + break; + + + /*-----------------------------------------------------------------*/ + /* Check the next character by Unicode property. We will get here only + if the support is in the binary; otherwise a compile-time error occurs. + */ + +#ifdef SUPPORT_UCP + case OP_PROP: + case OP_NOTPROP: + if (clen > 0) + { + BOOL OK; + int category = _erts_pcre_ucp_findprop(c, &chartype, &script); + switch(code[1]) + { + case PT_ANY: + OK = TRUE; + break; + + case PT_LAMP: + OK = chartype == ucp_Lu || chartype == ucp_Ll || chartype == ucp_Lt; + break; + + case PT_GC: + OK = category == code[2]; + break; + + case PT_PC: + OK = chartype == code[2]; + break; + + case PT_SC: + OK = script == code[2]; + break; + + /* Should never occur, but keep compilers from grumbling. */ + + default: + OK = codevalue != OP_PROP; + break; + } + + if (OK == (codevalue == OP_PROP)) { ADD_NEW(state_offset + 3, 0); } + } + break; +#endif + + + +/* ========================================================================== */ + /* These opcodes likewise inspect the subject character, but have an + argument that is not a data character. It is one of these opcodes: + OP_ANY, OP_DIGIT, OP_NOT_DIGIT, OP_WHITESPACE, OP_NOT_SPACE, OP_WORDCHAR, + OP_NOT_WORDCHAR. The value is loaded into d. */ + + case OP_TYPEPLUS: + case OP_TYPEMINPLUS: + case OP_TYPEPOSPLUS: + count = current_state->count; /* Already matched */ + if (count > 0) { ADD_ACTIVE(state_offset + 2, 0); } + if (clen > 0) + { + if ((c >= 256 && d != OP_DIGIT && d != OP_WHITESPACE && d != OP_WORDCHAR) || + (c < 256 && + (d != OP_ANY || + (ims & PCRE_DOTALL) != 0 || + !IS_NEWLINE(ptr) + ) && + ((ctypes[c] & toptable1[d]) ^ toptable2[d]) != 0)) + { + if (count > 0 && codevalue == OP_TYPEPOSPLUS) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + count++; + ADD_NEW(state_offset, count); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_TYPEQUERY: + case OP_TYPEMINQUERY: + case OP_TYPEPOSQUERY: + ADD_ACTIVE(state_offset + 2, 0); + if (clen > 0) + { + if ((c >= 256 && d != OP_DIGIT && d != OP_WHITESPACE && d != OP_WORDCHAR) || + (c < 256 && + (d != OP_ANY || + (ims & PCRE_DOTALL) != 0 || + !IS_NEWLINE(ptr) + ) && + ((ctypes[c] & toptable1[d]) ^ toptable2[d]) != 0)) + { + if (codevalue == OP_TYPEPOSQUERY) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + ADD_NEW(state_offset + 2, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_TYPESTAR: + case OP_TYPEMINSTAR: + case OP_TYPEPOSSTAR: + ADD_ACTIVE(state_offset + 2, 0); + if (clen > 0) + { + if ((c >= 256 && d != OP_DIGIT && d != OP_WHITESPACE && d != OP_WORDCHAR) || + (c < 256 && + (d != OP_ANY || + (ims & PCRE_DOTALL) != 0 || + !IS_NEWLINE(ptr) + ) && + ((ctypes[c] & toptable1[d]) ^ toptable2[d]) != 0)) + { + if (codevalue == OP_TYPEPOSSTAR) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + ADD_NEW(state_offset, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_TYPEEXACT: + count = current_state->count; /* Number already matched */ + if (clen > 0) + { + if ((c >= 256 && d != OP_DIGIT && d != OP_WHITESPACE && d != OP_WORDCHAR) || + (c < 256 && + (d != OP_ANY || + (ims & PCRE_DOTALL) != 0 || + !IS_NEWLINE(ptr) + ) && + ((ctypes[c] & toptable1[d]) ^ toptable2[d]) != 0)) + { + if (++count >= GET2(code, 1)) + { ADD_NEW(state_offset + 4, 0); } + else + { ADD_NEW(state_offset, count); } + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_TYPEUPTO: + case OP_TYPEMINUPTO: + case OP_TYPEPOSUPTO: + ADD_ACTIVE(state_offset + 4, 0); + count = current_state->count; /* Number already matched */ + if (clen > 0) + { + if ((c >= 256 && d != OP_DIGIT && d != OP_WHITESPACE && d != OP_WORDCHAR) || + (c < 256 && + (d != OP_ANY || + (ims & PCRE_DOTALL) != 0 || + !IS_NEWLINE(ptr) + ) && + ((ctypes[c] & toptable1[d]) ^ toptable2[d]) != 0)) + { + if (codevalue == OP_TYPEPOSUPTO) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + if (++count >= GET2(code, 1)) + { ADD_NEW(state_offset + 4, 0); } + else + { ADD_NEW(state_offset, count); } + } + } + break; + +/* ========================================================================== */ + /* These are virtual opcodes that are used when something like + OP_TYPEPLUS has OP_PROP, OP_NOTPROP, OP_ANYNL, or OP_EXTUNI as its + argument. It keeps the code above fast for the other cases. The argument + is in the d variable. */ + +#ifdef SUPPORT_UCP + case OP_PROP_EXTRA + OP_TYPEPLUS: + case OP_PROP_EXTRA + OP_TYPEMINPLUS: + case OP_PROP_EXTRA + OP_TYPEPOSPLUS: + count = current_state->count; /* Already matched */ + if (count > 0) { ADD_ACTIVE(state_offset + 4, 0); } + if (clen > 0) + { + BOOL OK; + int category = _erts_pcre_ucp_findprop(c, &chartype, &script); + switch(code[2]) + { + case PT_ANY: + OK = TRUE; + break; + + case PT_LAMP: + OK = chartype == ucp_Lu || chartype == ucp_Ll || chartype == ucp_Lt; + break; + + case PT_GC: + OK = category == code[3]; + break; + + case PT_PC: + OK = chartype == code[3]; + break; + + case PT_SC: + OK = script == code[3]; + break; + + /* Should never occur, but keep compilers from grumbling. */ + + default: + OK = codevalue != OP_PROP; + break; + } + + if (OK == (d == OP_PROP)) + { + if (count > 0 && codevalue == OP_PROP_EXTRA + OP_TYPEPOSPLUS) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + count++; + ADD_NEW(state_offset, count); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_EXTUNI_EXTRA + OP_TYPEPLUS: + case OP_EXTUNI_EXTRA + OP_TYPEMINPLUS: + case OP_EXTUNI_EXTRA + OP_TYPEPOSPLUS: + count = current_state->count; /* Already matched */ + if (count > 0) { ADD_ACTIVE(state_offset + 2, 0); } + if (clen > 0 && _erts_pcre_ucp_findprop(c, &chartype, &script) != ucp_M) + { + const uschar *nptr = ptr + clen; + int ncount = 0; + if (count > 0 && codevalue == OP_EXTUNI_EXTRA + OP_TYPEPOSPLUS) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + while (nptr < end_subject) + { + int nd; + int ndlen = 1; + GETCHARLEN(nd, nptr, ndlen); + if (_erts_pcre_ucp_findprop(nd, &chartype, &script) != ucp_M) break; + ncount++; + nptr += ndlen; + } + count++; + ADD_NEW_DATA(-state_offset, count, ncount); + } + break; +#endif + + /*-----------------------------------------------------------------*/ + case OP_ANYNL_EXTRA + OP_TYPEPLUS: + case OP_ANYNL_EXTRA + OP_TYPEMINPLUS: + case OP_ANYNL_EXTRA + OP_TYPEPOSPLUS: + count = current_state->count; /* Already matched */ + if (count > 0) { ADD_ACTIVE(state_offset + 2, 0); } + if (clen > 0) + { + int ncount = 0; + switch (c) + { + case 0x000b: + case 0x000c: + case 0x0085: + case 0x2028: + case 0x2029: + if ((md->moptions & PCRE_BSR_ANYCRLF) != 0) break; + goto ANYNL01; + + case 0x000d: + if (ptr + 1 < end_subject && ptr[1] == 0x0a) ncount = 1; + /* Fall through */ + + ANYNL01: + case 0x000a: + if (count > 0 && codevalue == OP_ANYNL_EXTRA + OP_TYPEPOSPLUS) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + count++; + ADD_NEW_DATA(-state_offset, count, ncount); + break; + + default: + break; + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_VSPACE_EXTRA + OP_TYPEPLUS: + case OP_VSPACE_EXTRA + OP_TYPEMINPLUS: + case OP_VSPACE_EXTRA + OP_TYPEPOSPLUS: + count = current_state->count; /* Already matched */ + if (count > 0) { ADD_ACTIVE(state_offset + 2, 0); } + if (clen > 0) + { + BOOL OK; + switch (c) + { + case 0x000a: + case 0x000b: + case 0x000c: + case 0x000d: + case 0x0085: + case 0x2028: + case 0x2029: + OK = TRUE; + break; + + default: + OK = FALSE; + break; + } + + if (OK == (d == OP_VSPACE)) + { + if (count > 0 && codevalue == OP_VSPACE_EXTRA + OP_TYPEPOSPLUS) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + count++; + ADD_NEW_DATA(-state_offset, count, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_HSPACE_EXTRA + OP_TYPEPLUS: + case OP_HSPACE_EXTRA + OP_TYPEMINPLUS: + case OP_HSPACE_EXTRA + OP_TYPEPOSPLUS: + count = current_state->count; /* Already matched */ + if (count > 0) { ADD_ACTIVE(state_offset + 2, 0); } + if (clen > 0) + { + BOOL OK; + switch (c) + { + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + OK = TRUE; + break; + + default: + OK = FALSE; + break; + } + + if (OK == (d == OP_HSPACE)) + { + if (count > 0 && codevalue == OP_HSPACE_EXTRA + OP_TYPEPOSPLUS) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + count++; + ADD_NEW_DATA(-state_offset, count, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ +#ifdef SUPPORT_UCP + case OP_PROP_EXTRA + OP_TYPEQUERY: + case OP_PROP_EXTRA + OP_TYPEMINQUERY: + case OP_PROP_EXTRA + OP_TYPEPOSQUERY: + count = 4; + goto QS1; + + case OP_PROP_EXTRA + OP_TYPESTAR: + case OP_PROP_EXTRA + OP_TYPEMINSTAR: + case OP_PROP_EXTRA + OP_TYPEPOSSTAR: + count = 0; + + QS1: + + ADD_ACTIVE(state_offset + 4, 0); + if (clen > 0) + { + BOOL OK; + int category = _erts_pcre_ucp_findprop(c, &chartype, &script); + switch(code[2]) + { + case PT_ANY: + OK = TRUE; + break; + + case PT_LAMP: + OK = chartype == ucp_Lu || chartype == ucp_Ll || chartype == ucp_Lt; + break; + + case PT_GC: + OK = category == code[3]; + break; + + case PT_PC: + OK = chartype == code[3]; + break; + + case PT_SC: + OK = script == code[3]; + break; + + /* Should never occur, but keep compilers from grumbling. */ + + default: + OK = codevalue != OP_PROP; + break; + } + + if (OK == (d == OP_PROP)) + { + if (codevalue == OP_PROP_EXTRA + OP_TYPEPOSSTAR || + codevalue == OP_PROP_EXTRA + OP_TYPEPOSQUERY) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + ADD_NEW(state_offset + count, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_EXTUNI_EXTRA + OP_TYPEQUERY: + case OP_EXTUNI_EXTRA + OP_TYPEMINQUERY: + case OP_EXTUNI_EXTRA + OP_TYPEPOSQUERY: + count = 2; + goto QS2; + + case OP_EXTUNI_EXTRA + OP_TYPESTAR: + case OP_EXTUNI_EXTRA + OP_TYPEMINSTAR: + case OP_EXTUNI_EXTRA + OP_TYPEPOSSTAR: + count = 0; + + QS2: + + ADD_ACTIVE(state_offset + 2, 0); + if (clen > 0 && _erts_pcre_ucp_findprop(c, &chartype, &script) != ucp_M) + { + const uschar *nptr = ptr + clen; + int ncount = 0; + if (codevalue == OP_EXTUNI_EXTRA + OP_TYPEPOSSTAR || + codevalue == OP_EXTUNI_EXTRA + OP_TYPEPOSQUERY) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + while (nptr < end_subject) + { + int nd; + int ndlen = 1; + GETCHARLEN(nd, nptr, ndlen); + if (_erts_pcre_ucp_findprop(nd, &chartype, &script) != ucp_M) break; + ncount++; + nptr += ndlen; + } + ADD_NEW_DATA(-(state_offset + count), 0, ncount); + } + break; +#endif + + /*-----------------------------------------------------------------*/ + case OP_ANYNL_EXTRA + OP_TYPEQUERY: + case OP_ANYNL_EXTRA + OP_TYPEMINQUERY: + case OP_ANYNL_EXTRA + OP_TYPEPOSQUERY: + count = 2; + goto QS3; + + case OP_ANYNL_EXTRA + OP_TYPESTAR: + case OP_ANYNL_EXTRA + OP_TYPEMINSTAR: + case OP_ANYNL_EXTRA + OP_TYPEPOSSTAR: + count = 0; + + QS3: + ADD_ACTIVE(state_offset + 2, 0); + if (clen > 0) + { + int ncount = 0; + switch (c) + { + case 0x000b: + case 0x000c: + case 0x0085: + case 0x2028: + case 0x2029: + if ((md->moptions & PCRE_BSR_ANYCRLF) != 0) break; + goto ANYNL02; + + case 0x000d: + if (ptr + 1 < end_subject && ptr[1] == 0x0a) ncount = 1; + /* Fall through */ + + ANYNL02: + case 0x000a: + if (codevalue == OP_ANYNL_EXTRA + OP_TYPEPOSSTAR || + codevalue == OP_ANYNL_EXTRA + OP_TYPEPOSQUERY) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + ADD_NEW_DATA(-(state_offset + count), 0, ncount); + break; + + default: + break; + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_VSPACE_EXTRA + OP_TYPEQUERY: + case OP_VSPACE_EXTRA + OP_TYPEMINQUERY: + case OP_VSPACE_EXTRA + OP_TYPEPOSQUERY: + count = 2; + goto QS4; + + case OP_VSPACE_EXTRA + OP_TYPESTAR: + case OP_VSPACE_EXTRA + OP_TYPEMINSTAR: + case OP_VSPACE_EXTRA + OP_TYPEPOSSTAR: + count = 0; + + QS4: + ADD_ACTIVE(state_offset + 2, 0); + if (clen > 0) + { + BOOL OK; + switch (c) + { + case 0x000a: + case 0x000b: + case 0x000c: + case 0x000d: + case 0x0085: + case 0x2028: + case 0x2029: + OK = TRUE; + break; + + default: + OK = FALSE; + break; + } + if (OK == (d == OP_VSPACE)) + { + if (codevalue == OP_VSPACE_EXTRA + OP_TYPEPOSSTAR || + codevalue == OP_VSPACE_EXTRA + OP_TYPEPOSQUERY) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + ADD_NEW_DATA(-(state_offset + count), 0, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_HSPACE_EXTRA + OP_TYPEQUERY: + case OP_HSPACE_EXTRA + OP_TYPEMINQUERY: + case OP_HSPACE_EXTRA + OP_TYPEPOSQUERY: + count = 2; + goto QS5; + + case OP_HSPACE_EXTRA + OP_TYPESTAR: + case OP_HSPACE_EXTRA + OP_TYPEMINSTAR: + case OP_HSPACE_EXTRA + OP_TYPEPOSSTAR: + count = 0; + + QS5: + ADD_ACTIVE(state_offset + 2, 0); + if (clen > 0) + { + BOOL OK; + switch (c) + { + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + OK = TRUE; + break; + + default: + OK = FALSE; + break; + } + + if (OK == (d == OP_HSPACE)) + { + if (codevalue == OP_HSPACE_EXTRA + OP_TYPEPOSSTAR || + codevalue == OP_HSPACE_EXTRA + OP_TYPEPOSQUERY) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + ADD_NEW_DATA(-(state_offset + count), 0, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ +#ifdef SUPPORT_UCP + case OP_PROP_EXTRA + OP_TYPEEXACT: + case OP_PROP_EXTRA + OP_TYPEUPTO: + case OP_PROP_EXTRA + OP_TYPEMINUPTO: + case OP_PROP_EXTRA + OP_TYPEPOSUPTO: + if (codevalue != OP_PROP_EXTRA + OP_TYPEEXACT) + { ADD_ACTIVE(state_offset + 6, 0); } + count = current_state->count; /* Number already matched */ + if (clen > 0) + { + BOOL OK; + int category = _erts_pcre_ucp_findprop(c, &chartype, &script); + switch(code[4]) + { + case PT_ANY: + OK = TRUE; + break; + + case PT_LAMP: + OK = chartype == ucp_Lu || chartype == ucp_Ll || chartype == ucp_Lt; + break; + + case PT_GC: + OK = category == code[5]; + break; + + case PT_PC: + OK = chartype == code[5]; + break; + + case PT_SC: + OK = script == code[5]; + break; + + /* Should never occur, but keep compilers from grumbling. */ + + default: + OK = codevalue != OP_PROP; + break; + } + + if (OK == (d == OP_PROP)) + { + if (codevalue == OP_PROP_EXTRA + OP_TYPEPOSUPTO) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + if (++count >= GET2(code, 1)) + { ADD_NEW(state_offset + 6, 0); } + else + { ADD_NEW(state_offset, count); } + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_EXTUNI_EXTRA + OP_TYPEEXACT: + case OP_EXTUNI_EXTRA + OP_TYPEUPTO: + case OP_EXTUNI_EXTRA + OP_TYPEMINUPTO: + case OP_EXTUNI_EXTRA + OP_TYPEPOSUPTO: + if (codevalue != OP_EXTUNI_EXTRA + OP_TYPEEXACT) + { ADD_ACTIVE(state_offset + 4, 0); } + count = current_state->count; /* Number already matched */ + if (clen > 0 && _erts_pcre_ucp_findprop(c, &chartype, &script) != ucp_M) + { + const uschar *nptr = ptr + clen; + int ncount = 0; + if (codevalue == OP_EXTUNI_EXTRA + OP_TYPEPOSUPTO) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + while (nptr < end_subject) + { + int nd; + int ndlen = 1; + GETCHARLEN(nd, nptr, ndlen); + if (_erts_pcre_ucp_findprop(nd, &chartype, &script) != ucp_M) break; + ncount++; + nptr += ndlen; + } + if (++count >= GET2(code, 1)) + { ADD_NEW_DATA(-(state_offset + 4), 0, ncount); } + else + { ADD_NEW_DATA(-state_offset, count, ncount); } + } + break; +#endif + + /*-----------------------------------------------------------------*/ + case OP_ANYNL_EXTRA + OP_TYPEEXACT: + case OP_ANYNL_EXTRA + OP_TYPEUPTO: + case OP_ANYNL_EXTRA + OP_TYPEMINUPTO: + case OP_ANYNL_EXTRA + OP_TYPEPOSUPTO: + if (codevalue != OP_ANYNL_EXTRA + OP_TYPEEXACT) + { ADD_ACTIVE(state_offset + 4, 0); } + count = current_state->count; /* Number already matched */ + if (clen > 0) + { + int ncount = 0; + switch (c) + { + case 0x000b: + case 0x000c: + case 0x0085: + case 0x2028: + case 0x2029: + if ((md->moptions & PCRE_BSR_ANYCRLF) != 0) break; + goto ANYNL03; + + case 0x000d: + if (ptr + 1 < end_subject && ptr[1] == 0x0a) ncount = 1; + /* Fall through */ + + ANYNL03: + case 0x000a: + if (codevalue == OP_ANYNL_EXTRA + OP_TYPEPOSUPTO) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + if (++count >= GET2(code, 1)) + { ADD_NEW_DATA(-(state_offset + 4), 0, ncount); } + else + { ADD_NEW_DATA(-state_offset, count, ncount); } + break; + + default: + break; + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_VSPACE_EXTRA + OP_TYPEEXACT: + case OP_VSPACE_EXTRA + OP_TYPEUPTO: + case OP_VSPACE_EXTRA + OP_TYPEMINUPTO: + case OP_VSPACE_EXTRA + OP_TYPEPOSUPTO: + if (codevalue != OP_VSPACE_EXTRA + OP_TYPEEXACT) + { ADD_ACTIVE(state_offset + 4, 0); } + count = current_state->count; /* Number already matched */ + if (clen > 0) + { + BOOL OK; + switch (c) + { + case 0x000a: + case 0x000b: + case 0x000c: + case 0x000d: + case 0x0085: + case 0x2028: + case 0x2029: + OK = TRUE; + break; + + default: + OK = FALSE; + } + + if (OK == (d == OP_VSPACE)) + { + if (codevalue == OP_VSPACE_EXTRA + OP_TYPEPOSUPTO) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + if (++count >= GET2(code, 1)) + { ADD_NEW_DATA(-(state_offset + 4), 0, 0); } + else + { ADD_NEW_DATA(-state_offset, count, 0); } + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_HSPACE_EXTRA + OP_TYPEEXACT: + case OP_HSPACE_EXTRA + OP_TYPEUPTO: + case OP_HSPACE_EXTRA + OP_TYPEMINUPTO: + case OP_HSPACE_EXTRA + OP_TYPEPOSUPTO: + if (codevalue != OP_HSPACE_EXTRA + OP_TYPEEXACT) + { ADD_ACTIVE(state_offset + 4, 0); } + count = current_state->count; /* Number already matched */ + if (clen > 0) + { + BOOL OK; + switch (c) + { + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + OK = TRUE; + break; + + default: + OK = FALSE; + break; + } + + if (OK == (d == OP_HSPACE)) + { + if (codevalue == OP_HSPACE_EXTRA + OP_TYPEPOSUPTO) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + if (++count >= GET2(code, 1)) + { ADD_NEW_DATA(-(state_offset + 4), 0, 0); } + else + { ADD_NEW_DATA(-state_offset, count, 0); } + } + } + break; + +/* ========================================================================== */ + /* These opcodes are followed by a character that is usually compared + to the current subject character; it is loaded into d. We still get + here even if there is no subject character, because in some cases zero + repetitions are permitted. */ + + /*-----------------------------------------------------------------*/ + case OP_CHAR: + if (clen > 0 && c == d) { ADD_NEW(state_offset + dlen + 1, 0); } + break; + + /*-----------------------------------------------------------------*/ + case OP_CHARNC: + if (clen == 0) break; + +#ifdef SUPPORT_UTF8 + if (utf8) + { + if (c == d) { ADD_NEW(state_offset + dlen + 1, 0); } else + { + unsigned int othercase; + if (c < 128) othercase = fcc[c]; else + + /* If we have Unicode property support, we can use it to test the + other case of the character. */ + +#ifdef SUPPORT_UCP + othercase = _erts_pcre_ucp_othercase(c); +#else + othercase = NOTACHAR; +#endif + + if (d == othercase) { ADD_NEW(state_offset + dlen + 1, 0); } + } + } + else +#endif /* SUPPORT_UTF8 */ + + /* Non-UTF-8 mode */ + { + if (lcc[c] == lcc[d]) { ADD_NEW(state_offset + 2, 0); } + } + break; + + +#ifdef SUPPORT_UCP + /*-----------------------------------------------------------------*/ + /* This is a tricky one because it can match more than one character. + Find out how many characters to skip, and then set up a negative state + to wait for them to pass before continuing. */ + + case OP_EXTUNI: + if (clen > 0 && _erts_pcre_ucp_findprop(c, &chartype, &script) != ucp_M) + { + const uschar *nptr = ptr + clen; + int ncount = 0; + while (nptr < end_subject) + { + int nclen = 1; + GETCHARLEN(c, nptr, nclen); + if (_erts_pcre_ucp_findprop(c, &chartype, &script) != ucp_M) break; + ncount++; + nptr += nclen; + } + ADD_NEW_DATA(-(state_offset + 1), 0, ncount); + } + break; +#endif + + /*-----------------------------------------------------------------*/ + /* This is a tricky like EXTUNI because it too can match more than one + character (when CR is followed by LF). In this case, set up a negative + state to wait for one character to pass before continuing. */ + + case OP_ANYNL: + if (clen > 0) switch(c) + { + case 0x000b: + case 0x000c: + case 0x0085: + case 0x2028: + case 0x2029: + if ((md->moptions & PCRE_BSR_ANYCRLF) != 0) break; + + case 0x000a: + ADD_NEW(state_offset + 1, 0); + break; + + case 0x000d: + if (ptr + 1 < end_subject && ptr[1] == 0x0a) + { + ADD_NEW_DATA(-(state_offset + 1), 0, 1); + } + else + { + ADD_NEW(state_offset + 1, 0); + } + break; + } + break; + + /*-----------------------------------------------------------------*/ + case OP_NOT_VSPACE: + if (clen > 0) switch(c) + { + case 0x000a: + case 0x000b: + case 0x000c: + case 0x000d: + case 0x0085: + case 0x2028: + case 0x2029: + break; + + default: + ADD_NEW(state_offset + 1, 0); + break; + } + break; + + /*-----------------------------------------------------------------*/ + case OP_VSPACE: + if (clen > 0) switch(c) + { + case 0x000a: + case 0x000b: + case 0x000c: + case 0x000d: + case 0x0085: + case 0x2028: + case 0x2029: + ADD_NEW(state_offset + 1, 0); + break; + + default: break; + } + break; + + /*-----------------------------------------------------------------*/ + case OP_NOT_HSPACE: + if (clen > 0) switch(c) + { + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + break; + + default: + ADD_NEW(state_offset + 1, 0); + break; + } + break; + + /*-----------------------------------------------------------------*/ + case OP_HSPACE: + if (clen > 0) switch(c) + { + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + ADD_NEW(state_offset + 1, 0); + break; + } + break; + + /*-----------------------------------------------------------------*/ + /* Match a negated single character. This is only used for one-byte + characters, that is, we know that d < 256. The character we are + checking (c) can be multibyte. */ + + case OP_NOT: + if (clen > 0) + { + unsigned int otherd = ((ims & PCRE_CASELESS) != 0)? fcc[d] : d; + if (c != d && c != otherd) { ADD_NEW(state_offset + dlen + 1, 0); } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_PLUS: + case OP_MINPLUS: + case OP_POSPLUS: + case OP_NOTPLUS: + case OP_NOTMINPLUS: + case OP_NOTPOSPLUS: + count = current_state->count; /* Already matched */ + if (count > 0) { ADD_ACTIVE(state_offset + dlen + 1, 0); } + if (clen > 0) + { + unsigned int otherd = NOTACHAR; + if ((ims & PCRE_CASELESS) != 0) + { +#ifdef SUPPORT_UTF8 + if (utf8 && d >= 128) + { +#ifdef SUPPORT_UCP + otherd = _erts_pcre_ucp_othercase(d); +#endif /* SUPPORT_UCP */ + } + else +#endif /* SUPPORT_UTF8 */ + otherd = fcc[d]; + } + if ((c == d || c == otherd) == (codevalue < OP_NOTSTAR)) + { + if (count > 0 && + (codevalue == OP_POSPLUS || codevalue == OP_NOTPOSPLUS)) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + count++; + ADD_NEW(state_offset, count); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_QUERY: + case OP_MINQUERY: + case OP_POSQUERY: + case OP_NOTQUERY: + case OP_NOTMINQUERY: + case OP_NOTPOSQUERY: + ADD_ACTIVE(state_offset + dlen + 1, 0); + if (clen > 0) + { + unsigned int otherd = NOTACHAR; + if ((ims & PCRE_CASELESS) != 0) + { +#ifdef SUPPORT_UTF8 + if (utf8 && d >= 128) + { +#ifdef SUPPORT_UCP + otherd = _erts_pcre_ucp_othercase(d); +#endif /* SUPPORT_UCP */ + } + else +#endif /* SUPPORT_UTF8 */ + otherd = fcc[d]; + } + if ((c == d || c == otherd) == (codevalue < OP_NOTSTAR)) + { + if (codevalue == OP_POSQUERY || codevalue == OP_NOTPOSQUERY) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + ADD_NEW(state_offset + dlen + 1, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_STAR: + case OP_MINSTAR: + case OP_POSSTAR: + case OP_NOTSTAR: + case OP_NOTMINSTAR: + case OP_NOTPOSSTAR: + ADD_ACTIVE(state_offset + dlen + 1, 0); + if (clen > 0) + { + unsigned int otherd = NOTACHAR; + if ((ims & PCRE_CASELESS) != 0) + { +#ifdef SUPPORT_UTF8 + if (utf8 && d >= 128) + { +#ifdef SUPPORT_UCP + otherd = _erts_pcre_ucp_othercase(d); +#endif /* SUPPORT_UCP */ + } + else +#endif /* SUPPORT_UTF8 */ + otherd = fcc[d]; + } + if ((c == d || c == otherd) == (codevalue < OP_NOTSTAR)) + { + if (codevalue == OP_POSSTAR || codevalue == OP_NOTPOSSTAR) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + ADD_NEW(state_offset, 0); + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_EXACT: + case OP_NOTEXACT: + count = current_state->count; /* Number already matched */ + if (clen > 0) + { + unsigned int otherd = NOTACHAR; + if ((ims & PCRE_CASELESS) != 0) + { +#ifdef SUPPORT_UTF8 + if (utf8 && d >= 128) + { +#ifdef SUPPORT_UCP + otherd = _erts_pcre_ucp_othercase(d); +#endif /* SUPPORT_UCP */ + } + else +#endif /* SUPPORT_UTF8 */ + otherd = fcc[d]; + } + if ((c == d || c == otherd) == (codevalue < OP_NOTSTAR)) + { + if (++count >= GET2(code, 1)) + { ADD_NEW(state_offset + dlen + 3, 0); } + else + { ADD_NEW(state_offset, count); } + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_UPTO: + case OP_MINUPTO: + case OP_POSUPTO: + case OP_NOTUPTO: + case OP_NOTMINUPTO: + case OP_NOTPOSUPTO: + ADD_ACTIVE(state_offset + dlen + 3, 0); + count = current_state->count; /* Number already matched */ + if (clen > 0) + { + unsigned int otherd = NOTACHAR; + if ((ims & PCRE_CASELESS) != 0) + { +#ifdef SUPPORT_UTF8 + if (utf8 && d >= 128) + { +#ifdef SUPPORT_UCP + otherd = _erts_pcre_ucp_othercase(d); +#endif /* SUPPORT_UCP */ + } + else +#endif /* SUPPORT_UTF8 */ + otherd = fcc[d]; + } + if ((c == d || c == otherd) == (codevalue < OP_NOTSTAR)) + { + if (codevalue == OP_POSUPTO || codevalue == OP_NOTPOSUPTO) + { + active_count--; /* Remove non-match possibility */ + next_active_state--; + } + if (++count >= GET2(code, 1)) + { ADD_NEW(state_offset + dlen + 3, 0); } + else + { ADD_NEW(state_offset, count); } + } + } + break; + + +/* ========================================================================== */ + /* These are the class-handling opcodes */ + + case OP_CLASS: + case OP_NCLASS: + case OP_XCLASS: + { + BOOL isinclass = FALSE; + int next_state_offset; + const uschar *ecode; + + /* For a simple class, there is always just a 32-byte table, and we + can set isinclass from it. */ + + if (codevalue != OP_XCLASS) + { + ecode = code + 33; + if (clen > 0) + { + isinclass = (c > 255)? (codevalue == OP_NCLASS) : + ((code[1 + c/8] & (1 << (c&7))) != 0); + } + } + + /* An extended class may have a table or a list of single characters, + ranges, or both, and it may be positive or negative. There's a + function that sorts all this out. */ + + else + { + ecode = code + GET(code, 1); + if (clen > 0) isinclass = _erts_pcre_xclass(c, code + 1 + LINK_SIZE); + } + + /* At this point, isinclass is set for all kinds of class, and ecode + points to the byte after the end of the class. If there is a + quantifier, this is where it will be. */ + + next_state_offset = ecode - start_code; + + switch (*ecode) + { + case OP_CRSTAR: + case OP_CRMINSTAR: + ADD_ACTIVE(next_state_offset + 1, 0); + if (isinclass) { ADD_NEW(state_offset, 0); } + break; + + case OP_CRPLUS: + case OP_CRMINPLUS: + count = current_state->count; /* Already matched */ + if (count > 0) { ADD_ACTIVE(next_state_offset + 1, 0); } + if (isinclass) { count++; ADD_NEW(state_offset, count); } + break; + + case OP_CRQUERY: + case OP_CRMINQUERY: + ADD_ACTIVE(next_state_offset + 1, 0); + if (isinclass) { ADD_NEW(next_state_offset + 1, 0); } + break; + + case OP_CRRANGE: + case OP_CRMINRANGE: + count = current_state->count; /* Already matched */ + if (count >= GET2(ecode, 1)) + { ADD_ACTIVE(next_state_offset + 5, 0); } + if (isinclass) + { + int max = GET2(ecode, 3); + if (++count >= max && max != 0) /* Max 0 => no limit */ + { ADD_NEW(next_state_offset + 5, 0); } + else + { ADD_NEW(state_offset, count); } + } + break; + + default: + if (isinclass) { ADD_NEW(next_state_offset, 0); } + break; + } + } + break; + +/* ========================================================================== */ + /* These are the opcodes for fancy brackets of various kinds. We have + to use recursion in order to handle them. */ + + case OP_ASSERT: + case OP_ASSERT_NOT: + case OP_ASSERTBACK: + case OP_ASSERTBACK_NOT: + { + int rc; + int local_offsets[2]; + int local_workspace[1000]; + const uschar *endasscode = code + GET(code, 1); + + while (*endasscode == OP_ALT) endasscode += GET(endasscode, 1); + + rc = internal_dfa_exec( + md, /* static match data */ + code, /* this subexpression's code */ + ptr, /* where we currently are */ + ptr - start_subject, /* start offset */ + local_offsets, /* offset vector */ + sizeof(local_offsets)/sizeof(int), /* size of same */ + local_workspace, /* workspace vector */ + sizeof(local_workspace)/sizeof(int), /* size of same */ + ims, /* the current ims flags */ + rlevel, /* function recursion level */ + recursing); /* pass on regex recursion */ + + if ((rc >= 0) == (codevalue == OP_ASSERT || codevalue == OP_ASSERTBACK)) + { ADD_ACTIVE(endasscode + LINK_SIZE + 1 - start_code, 0); } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_COND: + case OP_SCOND: + { + int local_offsets[1000]; + int local_workspace[1000]; + int condcode = code[LINK_SIZE+1]; + + /* Back reference conditions are not supported */ + + if (condcode == OP_CREF) return PCRE_ERROR_DFA_UCOND; + + /* The DEFINE condition is always false */ + + if (condcode == OP_DEF) + { + ADD_ACTIVE(state_offset + GET(code, 1) + LINK_SIZE + 1, 0); + } + + /* The only supported version of OP_RREF is for the value RREF_ANY, + which means "test if in any recursion". We can't test for specifically + recursed groups. */ + + else if (condcode == OP_RREF) + { + int value = GET2(code, LINK_SIZE+2); + if (value != RREF_ANY) return PCRE_ERROR_DFA_UCOND; + if (recursing > 0) { ADD_ACTIVE(state_offset + LINK_SIZE + 4, 0); } + else { ADD_ACTIVE(state_offset + GET(code, 1) + LINK_SIZE + 1, 0); } + } + + /* Otherwise, the condition is an assertion */ + + else + { + int rc; + const uschar *asscode = code + LINK_SIZE + 1; + const uschar *endasscode = asscode + GET(asscode, 1); + + while (*endasscode == OP_ALT) endasscode += GET(endasscode, 1); + + rc = internal_dfa_exec( + md, /* fixed match data */ + asscode, /* this subexpression's code */ + ptr, /* where we currently are */ + ptr - start_subject, /* start offset */ + local_offsets, /* offset vector */ + sizeof(local_offsets)/sizeof(int), /* size of same */ + local_workspace, /* workspace vector */ + sizeof(local_workspace)/sizeof(int), /* size of same */ + ims, /* the current ims flags */ + rlevel, /* function recursion level */ + recursing); /* pass on regex recursion */ + + if ((rc >= 0) == + (condcode == OP_ASSERT || condcode == OP_ASSERTBACK)) + { ADD_ACTIVE(endasscode + LINK_SIZE + 1 - start_code, 0); } + else + { ADD_ACTIVE(state_offset + GET(code, 1) + LINK_SIZE + 1, 0); } + } + } + break; + + /*-----------------------------------------------------------------*/ + case OP_RECURSE: + { + int local_offsets[1000]; + int local_workspace[1000]; + int rc; + + DPRINTF(("%.*sStarting regex recursion %d\n", rlevel*2-2, SP, + recursing + 1)); + + rc = internal_dfa_exec( + md, /* fixed match data */ + start_code + GET(code, 1), /* this subexpression's code */ + ptr, /* where we currently are */ + ptr - start_subject, /* start offset */ + local_offsets, /* offset vector */ + sizeof(local_offsets)/sizeof(int), /* size of same */ + local_workspace, /* workspace vector */ + sizeof(local_workspace)/sizeof(int), /* size of same */ + ims, /* the current ims flags */ + rlevel, /* function recursion level */ + recursing + 1); /* regex recurse level */ + + DPRINTF(("%.*sReturn from regex recursion %d: rc=%d\n", rlevel*2-2, SP, + recursing + 1, rc)); + + /* Ran out of internal offsets */ + + if (rc == 0) return PCRE_ERROR_DFA_RECURSE; + + /* For each successful matched substring, set up the next state with a + count of characters to skip before trying it. Note that the count is in + characters, not bytes. */ + + if (rc > 0) + { + for (rc = rc*2 - 2; rc >= 0; rc -= 2) + { + const uschar *p = start_subject + local_offsets[rc]; + const uschar *pp = start_subject + local_offsets[rc+1]; + int charcount = local_offsets[rc+1] - local_offsets[rc]; + while (p < pp) if ((*p++ & 0xc0) == 0x80) charcount--; + if (charcount > 0) + { + ADD_NEW_DATA(-(state_offset + LINK_SIZE + 1), 0, (charcount - 1)); + } + else + { + ADD_ACTIVE(state_offset + LINK_SIZE + 1, 0); + } + } + } + else if (rc != PCRE_ERROR_NOMATCH) return rc; + } + break; + + /*-----------------------------------------------------------------*/ + case OP_ONCE: + { + int local_offsets[2]; + int local_workspace[1000]; + + int rc = internal_dfa_exec( + md, /* fixed match data */ + code, /* this subexpression's code */ + ptr, /* where we currently are */ + ptr - start_subject, /* start offset */ + local_offsets, /* offset vector */ + sizeof(local_offsets)/sizeof(int), /* size of same */ + local_workspace, /* workspace vector */ + sizeof(local_workspace)/sizeof(int), /* size of same */ + ims, /* the current ims flags */ + rlevel, /* function recursion level */ + recursing); /* pass on regex recursion */ + + if (rc >= 0) + { + const uschar *end_subpattern = code; + int charcount = local_offsets[1] - local_offsets[0]; + int next_state_offset, repeat_state_offset; + + do { end_subpattern += GET(end_subpattern, 1); } + while (*end_subpattern == OP_ALT); + next_state_offset = end_subpattern - start_code + LINK_SIZE + 1; + + /* If the end of this subpattern is KETRMAX or KETRMIN, we must + arrange for the repeat state also to be added to the relevant list. + Calculate the offset, or set -1 for no repeat. */ + + repeat_state_offset = (*end_subpattern == OP_KETRMAX || + *end_subpattern == OP_KETRMIN)? + end_subpattern - start_code - GET(end_subpattern, 1) : -1; + + /* If we have matched an empty string, add the next state at the + current character pointer. This is important so that the duplicate + checking kicks in, which is what breaks infinite loops that match an + empty string. */ + + if (charcount == 0) + { + ADD_ACTIVE(next_state_offset, 0); + } + + /* Optimization: if there are no more active states, and there + are no new states yet set up, then skip over the subject string + right here, to save looping. Otherwise, set up the new state to swing + into action when the end of the substring is reached. */ + + else if (i + 1 >= active_count && new_count == 0) + { + ptr += charcount; + clen = 0; + ADD_NEW(next_state_offset, 0); + + /* If we are adding a repeat state at the new character position, + we must fudge things so that it is the only current state. + Otherwise, it might be a duplicate of one we processed before, and + that would cause it to be skipped. */ + + if (repeat_state_offset >= 0) + { + next_active_state = active_states; + active_count = 0; + i = -1; + ADD_ACTIVE(repeat_state_offset, 0); + } + } + else + { + const uschar *p = start_subject + local_offsets[0]; + const uschar *pp = start_subject + local_offsets[1]; + while (p < pp) if ((*p++ & 0xc0) == 0x80) charcount--; + ADD_NEW_DATA(-next_state_offset, 0, (charcount - 1)); + if (repeat_state_offset >= 0) + { ADD_NEW_DATA(-repeat_state_offset, 0, (charcount - 1)); } + } + + } + else if (rc != PCRE_ERROR_NOMATCH) return rc; + } + break; + + +/* ========================================================================== */ + /* Handle callouts */ + + case OP_CALLOUT: + if (erts_pcre_callout != NULL) + { + int rrc; + pcre_callout_block cb; + cb.version = 1; /* Version 1 of the callout block */ + cb.callout_number = code[1]; + cb.offset_vector = offsets; + cb.subject = (PCRE_SPTR)start_subject; + cb.subject_length = end_subject - start_subject; + cb.start_match = current_subject - start_subject; + cb.current_position = ptr - start_subject; + cb.pattern_position = GET(code, 2); + cb.next_item_length = GET(code, 2 + LINK_SIZE); + cb.capture_top = 1; + cb.capture_last = -1; + cb.callout_data = md->callout_data; + if ((rrc = (*erts_pcre_callout)(&cb)) < 0) return rrc; /* Abandon */ + if (rrc == 0) { ADD_ACTIVE(state_offset + 2 + 2*LINK_SIZE, 0); } + } + break; + + +/* ========================================================================== */ + default: /* Unsupported opcode */ + return PCRE_ERROR_DFA_UITEM; + } + + NEXT_ACTIVE_STATE: continue; + + } /* End of loop scanning active states */ + + /* We have finished the processing at the current subject character. If no + new states have been set for the next character, we have found all the + matches that we are going to find. If we are at the top level and partial + matching has been requested, check for appropriate conditions. */ + + if (new_count <= 0) + { + if (match_count < 0 && /* No matches found */ + rlevel == 1 && /* Top level match function */ + (md->moptions & PCRE_PARTIAL) != 0 && /* Want partial matching */ + ptr >= end_subject && /* Reached end of subject */ + ptr > current_subject) /* Matched non-empty string */ + { + if (offsetcount >= 2) + { + offsets[0] = current_subject - start_subject; + offsets[1] = end_subject - start_subject; + } + match_count = PCRE_ERROR_PARTIAL; + } + + DPRINTF(("%.*sEnd of internal_dfa_exec %d: returning %d\n" + "%.*s---------------------\n\n", rlevel*2-2, SP, rlevel, match_count, + rlevel*2-2, SP)); + break; /* In effect, "return", but see the comment below */ + } + + /* One or more states are active for the next character. */ + + ptr += clen; /* Advance to next subject character */ + } /* Loop to move along the subject string */ + +/* Control gets here from "break" a few lines above. We do it this way because +if we use "return" above, we have compiler trouble. Some compilers warn if +there's nothing here because they think the function doesn't return a value. On +the other hand, if we put a dummy statement here, some more clever compilers +complain that it can't be reached. Sigh. */ + +return match_count; +} + + + + +/************************************************* +* Execute a Regular Expression - DFA engine * +*************************************************/ + +/* This external function applies a compiled re to a subject string using a DFA +engine. This function calls the internal function multiple times if the pattern +is not anchored. + +Arguments: + argument_re points to the compiled expression + extra_data points to extra data or is NULL + subject points to the subject string + length length of subject string (may contain binary zeros) + start_offset where to start in the subject string + options option bits + offsets vector of match offsets + offsetcount size of same + workspace workspace vector + wscount size of same + +Returns: > 0 => number of match offset pairs placed in offsets + = 0 => offsets overflowed; longest matches are present + -1 => failed to match + < -1 => some kind of unexpected problem +*/ + +PCRE_EXP_DEFN int +erts_pcre_dfa_exec(const pcre *argument_re, const pcre_extra *extra_data, + const char *subject, int length, int start_offset, int options, int *offsets, + int offsetcount, int *workspace, int wscount) +{ +real_pcre *re = (real_pcre *)argument_re; +dfa_match_data match_block; +dfa_match_data *md = &match_block; +BOOL utf8, anchored, startline, firstline; +const uschar *current_subject, *end_subject, *lcc; + +pcre_study_data internal_study; +const pcre_study_data *study = NULL; +real_pcre internal_re; + +const uschar *req_byte_ptr; +const uschar *start_bits = NULL; +BOOL first_byte_caseless = FALSE; +BOOL req_byte_caseless = FALSE; +int first_byte = -1; +int req_byte = -1; +int req_byte2 = -1; +int newline; + +/* Plausibility checks */ + +if ((options & ~PUBLIC_DFA_EXEC_OPTIONS) != 0) return PCRE_ERROR_BADOPTION; +if (re == NULL || subject == NULL || workspace == NULL || + (offsets == NULL && offsetcount > 0)) return PCRE_ERROR_NULL; +if (offsetcount < 0) return PCRE_ERROR_BADCOUNT; +if (wscount < 20) return PCRE_ERROR_DFA_WSSIZE; + +/* We need to find the pointer to any study data before we test for byte +flipping, so we scan the extra_data block first. This may set two fields in the +match block, so we must initialize them beforehand. However, the other fields +in the match block must not be set until after the byte flipping. */ + +md->tables = re->tables; +md->callout_data = NULL; + +if (extra_data != NULL) + { + unsigned int flags = extra_data->flags; + if ((flags & PCRE_EXTRA_STUDY_DATA) != 0) + study = (const pcre_study_data *)extra_data->study_data; + if ((flags & PCRE_EXTRA_MATCH_LIMIT) != 0) return PCRE_ERROR_DFA_UMLIMIT; + if ((flags & PCRE_EXTRA_MATCH_LIMIT_RECURSION) != 0) + return PCRE_ERROR_DFA_UMLIMIT; + if ((flags & PCRE_EXTRA_CALLOUT_DATA) != 0) + md->callout_data = extra_data->callout_data; + if ((flags & PCRE_EXTRA_TABLES) != 0) + md->tables = extra_data->tables; + } + +/* Check that the first field in the block is the magic number. If it is not, +test for a regex that was compiled on a host of opposite endianness. If this is +the case, flipped values are put in internal_re and internal_study if there was +study data too. */ + +if (re->magic_number != MAGIC_NUMBER) + { + re = _erts_pcre_try_flipped(re, &internal_re, study, &internal_study); + if (re == NULL) return PCRE_ERROR_BADMAGIC; + if (study != NULL) study = &internal_study; + } + +/* Set some local values */ + +current_subject = (const unsigned char *)subject + start_offset; +end_subject = (const unsigned char *)subject + length; +req_byte_ptr = current_subject - 1; + +#ifdef SUPPORT_UTF8 +utf8 = (re->options & PCRE_UTF8) != 0; +#else +utf8 = FALSE; +#endif + +anchored = (options & (PCRE_ANCHORED|PCRE_DFA_RESTART)) != 0 || + (re->options & PCRE_ANCHORED) != 0; + +/* The remaining fixed data for passing around. */ + +md->start_code = (const uschar *)argument_re + + re->name_table_offset + re->name_count * re->name_entry_size; +md->start_subject = (const unsigned char *)subject; +md->end_subject = end_subject; +md->moptions = options; +md->poptions = re->options; + +/* If the BSR option is not set at match time, copy what was set +at compile time. */ + +if ((md->moptions & (PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE)) == 0) + { + if ((re->options & (PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE)) != 0) + md->moptions |= re->options & (PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE); +#ifdef BSR_ANYCRLF + else md->moptions |= PCRE_BSR_ANYCRLF; +#endif + } + +/* Handle different types of newline. The three bits give eight cases. If +nothing is set at run time, whatever was used at compile time applies. */ + +switch ((((options & PCRE_NEWLINE_BITS) == 0)? re->options : (pcre_uint32)options) & + PCRE_NEWLINE_BITS) + { + case 0: newline = NEWLINE; break; /* Compile-time default */ + case PCRE_NEWLINE_CR: newline = '\r'; break; + case PCRE_NEWLINE_LF: newline = '\n'; break; + case PCRE_NEWLINE_CR+ + PCRE_NEWLINE_LF: newline = ('\r' << 8) | '\n'; break; + case PCRE_NEWLINE_ANY: newline = -1; break; + case PCRE_NEWLINE_ANYCRLF: newline = -2; break; + default: return PCRE_ERROR_BADNEWLINE; + } + +if (newline == -2) + { + md->nltype = NLTYPE_ANYCRLF; + } +else if (newline < 0) + { + md->nltype = NLTYPE_ANY; + } +else + { + md->nltype = NLTYPE_FIXED; + if (newline > 255) + { + md->nllen = 2; + md->nl[0] = (newline >> 8) & 255; + md->nl[1] = newline & 255; + } + else + { + md->nllen = 1; + md->nl[0] = newline; + } + } + +/* Check a UTF-8 string if required. Unfortunately there's no way of passing +back the character offset. */ + +#ifdef SUPPORT_UTF8 +if (utf8 && (options & PCRE_NO_UTF8_CHECK) == 0) + { + if (_erts_pcre_valid_utf8((uschar *)subject, length) >= 0) + return PCRE_ERROR_BADUTF8; + if (start_offset > 0 && start_offset < length) + { + int tb = ((uschar *)subject)[start_offset]; + if (tb > 127) + { + tb &= 0xc0; + if (tb != 0 && tb != 0xc0) return PCRE_ERROR_BADUTF8_OFFSET; + } + } + } +#endif + +/* If the exec call supplied NULL for tables, use the inbuilt ones. This +is a feature that makes it possible to save compiled regex and re-use them +in other programs later. */ + +if (md->tables == NULL) md->tables = _erts_pcre_default_tables; + +/* The lower casing table and the "must be at the start of a line" flag are +used in a loop when finding where to start. */ + +lcc = md->tables + lcc_offset; +startline = (re->flags & PCRE_STARTLINE) != 0; +firstline = (re->options & PCRE_FIRSTLINE) != 0; + +/* Set up the first character to match, if available. The first_byte value is +never set for an anchored regular expression, but the anchoring may be forced +at run time, so we have to test for anchoring. The first char may be unset for +an unanchored pattern, of course. If there's no first char and the pattern was +studied, there may be a bitmap of possible first characters. */ + +if (!anchored) + { + if ((re->flags & PCRE_FIRSTSET) != 0) + { + first_byte = re->first_byte & 255; + if ((first_byte_caseless = ((re->first_byte & REQ_CASELESS) != 0)) == TRUE) + first_byte = lcc[first_byte]; + } + else + { + if (startline && study != NULL && + (study->options & PCRE_STUDY_MAPPED) != 0) + start_bits = study->start_bits; + } + } + +/* For anchored or unanchored matches, there may be a "last known required +character" set. */ + +if ((re->flags & PCRE_REQCHSET) != 0) + { + req_byte = re->req_byte & 255; + req_byte_caseless = (re->req_byte & REQ_CASELESS) != 0; + req_byte2 = (md->tables + fcc_offset)[req_byte]; /* case flipped */ + } + +/* Call the main matching function, looping for a non-anchored regex after a +failed match. Unless restarting, optimize by moving to the first match +character if possible, when not anchored. Then unless wanting a partial match, +check for a required later character. */ + +for (;;) + { + int rc; + + if ((options & PCRE_DFA_RESTART) == 0) + { + const uschar *save_end_subject = end_subject; + + /* Advance to a unique first char if possible. If firstline is TRUE, the + start of the match is constrained to the first line of a multiline string. + Implement this by temporarily adjusting end_subject so that we stop + scanning at a newline. If the match fails at the newline, later code breaks + this loop. */ + + if (firstline) + { + const uschar *t = current_subject; + while (t < md->end_subject && !IS_NEWLINE(t)) t++; + end_subject = t; + } + + if (first_byte >= 0) + { + if (first_byte_caseless) + while (current_subject < end_subject && + lcc[*current_subject] != first_byte) + current_subject++; + else + while (current_subject < end_subject && *current_subject != first_byte) + current_subject++; + } + + /* Or to just after a linebreak for a multiline match if possible */ + + else if (startline) + { + if (current_subject > md->start_subject + start_offset) + { + while (current_subject <= end_subject && !WAS_NEWLINE(current_subject)) + current_subject++; + + /* If we have just passed a CR and the newline option is ANY or + ANYCRLF, and we are now at a LF, advance the match position by one more + character. */ + + if (current_subject[-1] == '\r' && + (md->nltype == NLTYPE_ANY || md->nltype == NLTYPE_ANYCRLF) && + current_subject < end_subject && + *current_subject == '\n') + current_subject++; + } + } + + /* Or to a non-unique first char after study */ + + else if (start_bits != NULL) + { + while (current_subject < end_subject) + { + register unsigned int c = *current_subject; + if ((start_bits[c/8] & (1 << (c&7))) == 0) current_subject++; + else break; + } + } + + /* Restore fudged end_subject */ + + end_subject = save_end_subject; + } + + /* If req_byte is set, we know that that character must appear in the subject + for the match to succeed. If the first character is set, req_byte must be + later in the subject; otherwise the test starts at the match point. This + optimization can save a huge amount of work in patterns with nested unlimited + repeats that aren't going to match. Writing separate code for cased/caseless + versions makes it go faster, as does using an autoincrement and backing off + on a match. + + HOWEVER: when the subject string is very, very long, searching to its end can + take a long time, and give bad performance on quite ordinary patterns. This + showed up when somebody was matching /^C/ on a 32-megabyte string... so we + don't do this when the string is sufficiently long. + + ALSO: this processing is disabled when partial matching is requested. + */ + + if (req_byte >= 0 && + end_subject - current_subject < REQ_BYTE_MAX && + (options & PCRE_PARTIAL) == 0) + { + register const uschar *p = current_subject + ((first_byte >= 0)? 1 : 0); + + /* We don't need to repeat the search if we haven't yet reached the + place we found it at last time. */ + + if (p > req_byte_ptr) + { + if (req_byte_caseless) + { + while (p < end_subject) + { + register int pp = *p++; + if (pp == req_byte || pp == req_byte2) { p--; break; } + } + } + else + { + while (p < end_subject) + { + if (*p++ == req_byte) { p--; break; } + } + } + + /* If we can't find the required character, break the matching loop, + which will cause a return or PCRE_ERROR_NOMATCH. */ + + if (p >= end_subject) break; + + /* If we have found the required character, save the point where we + found it, so that we don't search again next time round the loop if + the start hasn't passed this character yet. */ + + req_byte_ptr = p; + } + } + + /* OK, now we can do the business */ + + rc = internal_dfa_exec( + md, /* fixed match data */ + md->start_code, /* this subexpression's code */ + current_subject, /* where we currently are */ + start_offset, /* start offset in subject */ + offsets, /* offset vector */ + offsetcount, /* size of same */ + workspace, /* workspace vector */ + wscount, /* size of same */ + re->options & (PCRE_CASELESS|PCRE_MULTILINE|PCRE_DOTALL), /* ims flags */ + 0, /* function recurse level */ + 0); /* regex recurse level */ + + /* Anything other than "no match" means we are done, always; otherwise, carry + on only if not anchored. */ + + if (rc != PCRE_ERROR_NOMATCH || anchored) return rc; + + /* Advance to the next subject character unless we are at the end of a line + and firstline is set. */ + + if (firstline && IS_NEWLINE(current_subject)) break; + current_subject++; + if (utf8) + { + while (current_subject < end_subject && (*current_subject & 0xc0) == 0x80) + current_subject++; + } + if (current_subject > end_subject) break; + + /* If we have just passed a CR and we are now at a LF, and the pattern does + not contain any explicit matches for \r or \n, and the newline option is CRLF + or ANY or ANYCRLF, advance the match position by one more character. */ + + if (current_subject[-1] == '\r' && + current_subject < end_subject && + *current_subject == '\n' && + (re->flags & PCRE_HASCRORLF) == 0 && + (md->nltype == NLTYPE_ANY || + md->nltype == NLTYPE_ANYCRLF || + md->nllen == 2)) + current_subject++; + + } /* "Bumpalong" loop */ + +return PCRE_ERROR_NOMATCH; +} + +/* End of pcre_dfa_exec.c */ diff --git a/erts/emulator/pcre/pcre_exec.c b/erts/emulator/pcre/pcre_exec.c new file mode 100644 index 0000000000..51625130c3 --- /dev/null +++ b/erts/emulator/pcre/pcre_exec.c @@ -0,0 +1,5394 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ +//#define ERLANG_DEBUG 1 + +/* This module contains erts_pcre_exec(), the externally visible function that does +pattern matching using an NFA algorithm, trying to mimic Perl as closely as +possible. There are also some static supporting functions. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#define NLBLOCK md /* Block containing newline information */ +#define PSSTART start_subject /* Field containing processed string start */ +#define PSEND end_subject /* Field containing processed string end */ + +#include "pcre_internal.h" + +/* Undefine some potentially clashing cpp symbols */ + +#undef min +#undef max + +/* Flag bits for the match() function */ + +#define match_condassert 0x01 /* Called to check a condition assertion */ +#define match_cbegroup 0x02 /* Could-be-empty unlimited repeat group */ + +/* Non-error returns from the match() function. Error returns are externally +defined PCRE_ERROR_xxx codes, which are all negative. */ + +#define MATCH_MATCH 1 +#define MATCH_NOMATCH 0 + +/* Special internal returns from the match() function. Make them sufficiently +negative to avoid the external error codes. */ + +#define MATCH_COMMIT (-999) +#define MATCH_PRUNE (-998) +#define MATCH_SKIP (-997) +#define MATCH_THEN (-996) + +/* Maximum number of ints of offset to save on the stack for recursive calls. +If the offset vector is bigger, malloc is used. This should be a multiple of 3, +because the offset vector is always a multiple of 3 long. */ + +#define REC_STACK_SAVE_MAX 30 + +/* Min and max values for the common repeats; for the maxima, 0 => infinity */ + +static const char rep_min[] = { 0, 0, 1, 1, 0, 0 }; +static const char rep_max[] = { 0, 0, 0, 0, 1, 1 }; + + + +#ifdef DEBUG +/************************************************* +* Debugging function to print chars * +*************************************************/ + +/* Print a sequence of chars in printable format, stopping at the end of the +subject if the requested. + +Arguments: + p points to characters + length number to print + is_subject TRUE if printing from within md->start_subject + md pointer to matching data block, if is_subject is TRUE + +Returns: nothing +*/ + +static void +pchars(const uschar *p, int length, BOOL is_subject, match_data *md) +{ +unsigned int c; +if (is_subject && length > md->end_subject - p) length = md->end_subject - p; +while (length-- > 0) + if (isprint(c = *(p++))) printf("%c", c); else printf("\\x%02x", c); +} +#endif + +#ifdef ERLANG_INTEGRATION +#ifdef ERLANG_DEBUG +#include +static void +edebug_printf(const char *format, ...) +{ + va_list args; + + va_start(args, format); + fprintf(stderr, "PCRE: "); + vfprintf(stderr, format, args); + va_end(args); + fprintf(stderr, "\r\n"); +} +#endif +#endif + +/************************************************* +* Match a back-reference * +*************************************************/ + +/* If a back reference hasn't been set, the length that is passed is greater +than the number of characters left in the string, so the match fails. + +Arguments: + offset index into the offset vector + eptr points into the subject + length length to be matched + md points to match data block + ims the ims flags + +Returns: TRUE if matched +*/ + +static BOOL +match_ref(int offset, register USPTR eptr, int length, match_data *md, + unsigned long int ims) +{ +USPTR p = md->start_subject + md->offset_vector[offset]; + +#ifdef DEBUG +if (eptr >= md->end_subject) + printf("matching subject "); +else + { + printf("matching subject "); + pchars(eptr, length, TRUE, md); + } +printf(" against backref "); +pchars(p, length, FALSE, md); +printf("\n"); +#endif + +/* Always fail if not enough characters left */ + +if (length > md->end_subject - eptr) return FALSE; + +/* Separate the caselesss case for speed */ + +if ((ims & PCRE_CASELESS) != 0) + { + while (length-- > 0) + if (md->lcc[*p++] != md->lcc[*eptr++]) return FALSE; + } +else + { while (length-- > 0) if (*p++ != *eptr++) return FALSE; } + +return TRUE; +} + + + +/*************************************************************************** +**************************************************************************** + RECURSION IN THE match() FUNCTION + +The match() function is highly recursive, though not every recursive call +increases the recursive depth. Nevertheless, some regular expressions can cause +it to recurse to a great depth. I was writing for Unix, so I just let it call +itself recursively. This uses the stack for saving everything that has to be +saved for a recursive call. On Unix, the stack can be large, and this works +fine. + +It turns out that on some non-Unix-like systems there are problems with +programs that use a lot of stack. (This despite the fact that every last chip +has oodles of memory these days, and techniques for extending the stack have +been known for decades.) So.... + +There is a fudge, triggered by defining NO_RECURSE, which avoids recursive +calls by keeping local variables that need to be preserved in blocks of memory +obtained from malloc() instead instead of on the stack. Macros are used to +achieve this so that the actual code doesn't look very different to what it +always used to. + +The original heap-recursive code used longjmp(). However, it seems that this +can be very slow on some operating systems. Following a suggestion from Stan +Switzer, the use of longjmp() has been abolished, at the cost of having to +provide a unique number for each call to RMATCH. There is no way of generating +a sequence of numbers at compile time in C. I have given them names, to make +them stand out more clearly. + +Crude tests on x86 Linux show a small speedup of around 5-8%. However, on +FreeBSD, avoiding longjmp() more than halves the time taken to run the standard +tests. Furthermore, not using longjmp() means that local dynamic variables +don't have indeterminate values; this has meant that the frame size can be +reduced because the result can be "passed back" by straight setting of the +variable instead of being passed in the frame. +**************************************************************************** +***************************************************************************/ + +/* Numbers for RMATCH calls. When this list is changed, the code at HEAP_RETURN +below must be updated in sync. */ + +enum { RM1=1, RM2, RM3, RM4, RM5, RM6, RM7, RM8, RM9, RM10, + RM11, RM12, RM13, RM14, RM15, RM16, RM17, RM18, RM19, RM20, + RM21, RM22, RM23, RM24, RM25, RM26, RM27, RM28, RM29, RM30, + RM31, RM32, RM33, RM34, RM35, RM36, RM37, RM38, RM39, RM40, + RM41, RM42, RM43, RM44, RM45, RM46, RM47, RM48, RM49, RM50, + RM51, RM52, RM53, RM54 +}; +/* These versions of the macros use the stack, as normal. There are debugging +versions and production versions. Note that the "rw" argument of RMATCH isn't +actuall used in this definition. */ + +#ifndef NO_RECURSE +#ifdef ERLANG_INTEGRATION +#error ERLANG_INTEGRATION only together with NO_RECURSE +#endif +#define REGISTER register + +#ifdef DEBUG +#define RMATCH(ra,rb,rc,rd,re,rf,rg,rw) \ + { \ + printf("match() called in line %d\n", __LINE__); \ + rrc = match(ra,rb,mstart,rc,rd,re,rf,rg,rdepth+1); \ + printf("to line %d\n", __LINE__); \ + } +#define RRETURN(ra) \ + { \ + printf("match() returned %d from line %d ", ra, __LINE__); \ + return ra; \ + } +#else +#define RMATCH(ra,rb,rc,rd,re,rf,rg,rw) \ + rrc = match(ra,rb,mstart,rc,rd,re,rf,rg,rdepth+1) +#define RRETURN(ra) return ra +#endif + +#else + + +/* These versions of the macros manage a private stack on the heap. Note that +the "rd" argument of RMATCH isn't actually used in this definition. It's the md +argument of match(), which never changes. */ + +#define REGISTER + +#define RMATCH(ra,rb,rc,rd,re,rf,rg,rw)\ + {\ + heapframe *newframe = (erts_pcre_stack_malloc)(sizeof(heapframe));\ + frame->Xwhere = rw; \ + newframe->Xeptr = ra;\ + newframe->Xecode = rb;\ + newframe->Xmstart = mstart;\ + newframe->Xoffset_top = rc;\ + newframe->Xims = re;\ + newframe->Xeptrb = rf;\ + newframe->Xflags = rg;\ + newframe->Xrdepth = frame->Xrdepth + 1;\ + newframe->Xprevframe = frame;\ + frame = newframe;\ + DPRINTF(("restarting from line %d\n", __LINE__));\ + goto HEAP_RECURSE;\ + L_##rw:\ + DPRINTF(("jumped back to line %d\n", __LINE__));\ + } + +#ifdef ERLANG_INTEGRATION +#define RRETURN(ra)\ + {\ + heapframe *newframe = frame;\ + frame = newframe->Xprevframe;\ + (erts_pcre_stack_free)(newframe);\ + if (frame != NULL)\ + {\ + rrc = ra;\ + goto HEAP_RETURN;\ + }\ + if (LOOP_LIMIT != 0) \ + { \ + md->loop_limit -= LOOP_COUNT; \ + } \ + return ra;\ + } +#else +#define RRETURN(ra)\ + {\ + heapframe *newframe = frame;\ + frame = newframe->Xprevframe;\ + (erts_pcre_stack_free)(newframe);\ + if (frame != NULL)\ + {\ + rrc = ra;\ + goto HEAP_RETURN;\ + }\ + return ra;\ + } +#endif + + +/* Structure for remembering the local variables in a private frame */ + +typedef struct heapframe { + struct heapframe *Xprevframe; + + /* Function arguments that may change */ + + const uschar *Xeptr; + const uschar *Xecode; + const uschar *Xmstart; + int Xoffset_top; + long int Xims; + eptrblock *Xeptrb; + int Xflags; + unsigned int Xrdepth; + + /* Function local variables */ + + const uschar *Xcallpat; + const uschar *Xcharptr; + const uschar *Xdata; + const uschar *Xnext; + const uschar *Xpp; + const uschar *Xprev; + const uschar *Xsaved_eptr; + + recursion_info Xnew_recursive; + + BOOL Xcur_is_word; + BOOL Xcondition; + BOOL Xprev_is_word; + + unsigned long int Xoriginal_ims; + +#ifdef SUPPORT_UCP + int Xprop_type; + int Xprop_value; + int Xprop_fail_result; + int Xprop_category; + int Xprop_chartype; + int Xprop_script; + int Xoclength; + uschar Xocchars[8]; +#endif + + int Xctype; + unsigned int Xfc; + int Xfi; + int Xlength; + int Xmax; + int Xmin; + int Xnumber; + int Xoffset; + int Xop; + int Xsave_capture_last; + int Xsave_offset1, Xsave_offset2, Xsave_offset3; + int Xstacksave[REC_STACK_SAVE_MAX]; + + eptrblock Xnewptrb; + + /* Where to jump back to */ + + int Xwhere; + +} heapframe; + +#endif + + +/*************************************************************************** +***************************************************************************/ + + + +/************************************************* +* Match from current position * +*************************************************/ + +/* This function is called recursively in many circumstances. Whenever it +returns a negative (error) response, the outer incarnation must also return the +same response. + +Performance note: It might be tempting to extract commonly used fields from the +md structure (e.g. utf8, end_subject) into individual variables to improve +performance. Tests using gcc on a SPARC disproved this; in the first case, it +made performance worse. + +Arguments: + eptr pointer to current character in subject + ecode pointer to current position in compiled code + mstart pointer to the current match start position (can be modified + by encountering \K) + offset_top current top pointer + md pointer to "static" info for the match + ims current /i, /m, and /s options + eptrb pointer to chain of blocks containing eptr at start of + brackets - for testing for empty matches + flags can contain + match_condassert - this is an assertion condition + match_cbegroup - this is the start of an unlimited repeat + group that can match an empty string + rdepth the recursion depth + +Returns: MATCH_MATCH if matched ) these values are >= 0 + MATCH_NOMATCH if failed to match ) + a negative PCRE_ERROR_xxx value if aborted by an error condition + (e.g. stopped by repeated call or recursion limit) +*/ + +static int +match(REGISTER USPTR eptr, REGISTER const uschar *ecode, const uschar *mstart, + int offset_top, match_data *md, unsigned long int ims, eptrblock *eptrb, + int flags, unsigned int rdepth) +{ +/* These variables do not need to be preserved over recursion in this function, +so they can be ordinary variables in all cases. Mark some of them with +"register" because they are used a lot in loops. */ + +register int rrc; /* Returns from recursive calls */ +register int i; /* Used for loops not involving calls to RMATCH() */ +register unsigned int c; /* Character values not kept over RMATCH() calls */ +register BOOL utf8; /* Local copy of UTF-8 flag for speed */ + +BOOL minimize, possessive; /* Quantifier options */ + +/* When recursion is not being used, all "local" variables that have to be +preserved over calls to RMATCH() are part of a "frame" which is obtained from +heap storage. Set up the top-level frame here; others are obtained from the +heap whenever RMATCH() does a "recursion". See the macro definitions above. */ + +#ifdef NO_RECURSE +#ifdef ERLANG_INTEGRATION +#define LOOP_COUNT loop_count +#define LOOP_LIMIT loop_limit +#ifdef ERLANG_DEBUG +#define EDEBUGF(X) edebug_printf X +#else +#define EDEBUGF(X) +#endif +#define COST(N) (LOOP_COUNT += (N)) +#define LABEL_XCAT(A,B) A##B +#define LABEL_CAT(A,B) LABEL_XCAT(A,B) + +#define COST_CHK(N) \ +do { \ + LOOP_COUNT += (N); \ + if (LOOP_LIMIT != 0) { \ + if (LOOP_COUNT > LOOP_LIMIT) { \ + frame->Xwhere = __LINE__ + 100; \ + goto LOOP_COUNT_BREAK; \ + LABEL_CAT(L_LOOP_COUNT_,__LINE__): \ + ; \ + } \ + } \ +} while (0) + +register int loop_count = 0; +register int loop_limit = md->loop_limit; +heapframe *frame; +if (md->state_save) { + frame = md->state_save; + /* ASSERT(frame != NULL); */ + EDEBUGF(("Break restore!")); + goto LOOP_COUNT_RETURN; +} +frame = (erts_pcre_stack_malloc)(sizeof(heapframe)); +#else +#define COST(N) +#define COST_CHK(N) +heapframe *frame = (erts_pcre_stack_malloc)(sizeof(heapframe)); +#endif + +frame->Xprevframe = NULL; /* Marks the top level */ + +/* Copy in the original argument variables */ + +frame->Xeptr = eptr; +frame->Xecode = ecode; +frame->Xmstart = mstart; +frame->Xoffset_top = offset_top; +frame->Xims = ims; +frame->Xeptrb = eptrb; +frame->Xflags = flags; +frame->Xrdepth = rdepth; + +/* This is where control jumps back to to effect "recursion" */ + +HEAP_RECURSE: + +/* Macros make the argument variables come from the current frame */ + +#define eptr frame->Xeptr +#define ecode frame->Xecode +#define mstart frame->Xmstart +#define offset_top frame->Xoffset_top +#define ims frame->Xims +#define eptrb frame->Xeptrb +#define flags frame->Xflags +#define rdepth frame->Xrdepth + +/* Ditto for the local variables */ + +#ifdef SUPPORT_UTF8 +#define charptr frame->Xcharptr +#endif +#define callpat frame->Xcallpat +#define data frame->Xdata +#define next frame->Xnext +#define pp frame->Xpp +#define prev frame->Xprev +#define saved_eptr frame->Xsaved_eptr + +#define new_recursive frame->Xnew_recursive + +#define cur_is_word frame->Xcur_is_word +#define condition frame->Xcondition +#define prev_is_word frame->Xprev_is_word + +#define original_ims frame->Xoriginal_ims + +#ifdef SUPPORT_UCP +#define prop_type frame->Xprop_type +#define prop_value frame->Xprop_value +#define prop_fail_result frame->Xprop_fail_result +#define prop_category frame->Xprop_category +#define prop_chartype frame->Xprop_chartype +#define prop_script frame->Xprop_script +#define oclength frame->Xoclength +#define occhars frame->Xocchars +#endif + +#define ctype frame->Xctype +#define fc frame->Xfc +#define fi frame->Xfi +#define length frame->Xlength +#define max frame->Xmax +#define min frame->Xmin +#define number frame->Xnumber +#define offset frame->Xoffset +#define op frame->Xop +#define save_capture_last frame->Xsave_capture_last +#define save_offset1 frame->Xsave_offset1 +#define save_offset2 frame->Xsave_offset2 +#define save_offset3 frame->Xsave_offset3 +#define stacksave frame->Xstacksave + +#define newptrb frame->Xnewptrb + +/* When recursion is being used, local variables are allocated on the stack and +get preserved during recursion in the normal way. In this environment, fi and +i, and fc and c, can be the same variables. */ + +#else /* NO_RECURSE not defined */ +#define COST(N) +#define COST_CHK(N) +#define fi i +#define fc c + + +#ifdef SUPPORT_UTF8 /* Many of these variables are used only */ +const uschar *charptr; /* in small blocks of the code. My normal */ +#endif /* style of coding would have declared */ +const uschar *callpat; /* them within each of those blocks. */ +const uschar *data; /* However, in order to accommodate the */ +const uschar *next; /* version of this code that uses an */ +USPTR pp; /* external "stack" implemented on the */ +const uschar *prev; /* heap, it is easier to declare them all */ +USPTR saved_eptr; /* here, so the declarations can be cut */ + /* out in a block. The only declarations */ +recursion_info new_recursive; /* within blocks below are for variables */ + /* that do not have to be preserved over */ +BOOL cur_is_word; /* a recursive call to RMATCH(). */ +BOOL condition; +BOOL prev_is_word; + +unsigned long int original_ims; + +#ifdef SUPPORT_UCP +int prop_type; +int prop_value; +int prop_fail_result; +int prop_category; +int prop_chartype; +int prop_script; +int oclength; +uschar occhars[8]; +#endif + +int ctype; +int length; +int max; +int min; +int number; +int offset; +int op; +int save_capture_last; +int save_offset1, save_offset2, save_offset3; +int stacksave[REC_STACK_SAVE_MAX]; + +eptrblock newptrb; +#endif /* NO_RECURSE */ + +/* These statements are here to stop the compiler complaining about unitialized +variables. */ + +#ifdef SUPPORT_UCP +prop_value = 0; +prop_fail_result = 0; +#endif + + +/* This label is used for tail recursion, which is used in a few cases even +when NO_RECURSE is not defined, in order to reduce the amount of stack that is +used. Thanks to Ian Taylor for noticing this possibility and sending the +original patch. */ + +TAIL_RECURSE: + +/* OK, now we can get on with the real code of the function. Recursive calls +are specified by the macro RMATCH and RRETURN is used to return. When +NO_RECURSE is *not* defined, these just turn into a recursive call to match() +and a "return", respectively (possibly with some debugging if DEBUG is +defined). However, RMATCH isn't like a function call because it's quite a +complicated macro. It has to be used in one particular way. This shouldn't, +however, impact performance when true recursion is being used. */ + +#ifdef SUPPORT_UTF8 +utf8 = md->utf8; /* Local copy of the flag */ +#else +utf8 = FALSE; +#endif + +/* First check that we haven't called match() too many times, or that we +haven't exceeded the recursive call limit. */ + +if (md->match_call_count++ >= md->match_limit) RRETURN(PCRE_ERROR_MATCHLIMIT); +if (rdepth >= md->match_limit_recursion) RRETURN(PCRE_ERROR_RECURSIONLIMIT); + +original_ims = ims; /* Save for resetting on ')' */ + +/* At the start of a group with an unlimited repeat that may match an empty +string, the match_cbegroup flag is set. When this is the case, add the current +subject pointer to the chain of such remembered pointers, to be checked when we +hit the closing ket, in order to break infinite loops that match no characters. +When match() is called in other circumstances, don't add to the chain. The +match_cbegroup flag must NOT be used with tail recursion, because the memory +block that is used is on the stack, so a new one may be required for each +match(). */ + +if ((flags & match_cbegroup) != 0) + { + newptrb.epb_saved_eptr = eptr; + newptrb.epb_prev = eptrb; + eptrb = &newptrb; + } + +/* Now start processing the opcodes. */ + +for (;;) + { + COST_CHK(1); + minimize = possessive = FALSE; + op = *ecode; + EDEBUGF(("Op = %d",op)); + + /* For partial matching, remember if we ever hit the end of the subject after + matching at least one subject character. */ + + if (md->partial && + eptr >= md->end_subject && + eptr > mstart) + md->hitend = TRUE; + + switch(op) + { + case OP_FAIL: + RRETURN(MATCH_NOMATCH); + + case OP_PRUNE: + RMATCH(eptr, ecode + _erts_pcre_OP_lengths[*ecode], offset_top, md, + ims, eptrb, flags, RM51); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + RRETURN(MATCH_PRUNE); + + case OP_COMMIT: + RMATCH(eptr, ecode + _erts_pcre_OP_lengths[*ecode], offset_top, md, + ims, eptrb, flags, RM52); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + RRETURN(MATCH_COMMIT); + + case OP_SKIP: + RMATCH(eptr, ecode + _erts_pcre_OP_lengths[*ecode], offset_top, md, + ims, eptrb, flags, RM53); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + md->start_match_ptr = eptr; /* Pass back current position */ + RRETURN(MATCH_SKIP); + + case OP_THEN: + RMATCH(eptr, ecode + _erts_pcre_OP_lengths[*ecode], offset_top, md, + ims, eptrb, flags, RM54); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + RRETURN(MATCH_THEN); + + /* Handle a capturing bracket. If there is space in the offset vector, save + the current subject position in the working slot at the top of the vector. + We mustn't change the current values of the data slot, because they may be + set from a previous iteration of this group, and be referred to by a + reference inside the group. + + If the bracket fails to match, we need to restore this value and also the + values of the final offsets, in case they were set by a previous iteration + of the same bracket. + + If there isn't enough space in the offset vector, treat this as if it were + a non-capturing bracket. Don't worry about setting the flag for the error + case here; that is handled in the code for KET. */ + + case OP_CBRA: + case OP_SCBRA: + number = GET2(ecode, 1+LINK_SIZE); + offset = number << 1; + +#ifdef DEBUG + printf("start bracket %d\n", number); + printf("subject="); + pchars(eptr, 16, TRUE, md); + printf("\n"); +#endif + + if (offset < md->offset_max) + { + save_offset1 = md->offset_vector[offset]; + save_offset2 = md->offset_vector[offset+1]; + save_offset3 = md->offset_vector[md->offset_end - number]; + save_capture_last = md->capture_last; + + DPRINTF(("saving %d %d %d\n", save_offset1, save_offset2, save_offset3)); + md->offset_vector[md->offset_end - number] = eptr - md->start_subject; + + flags = (op == OP_SCBRA)? match_cbegroup : 0; + do /* PaN: OK */ + { + RMATCH(eptr, ecode + _erts_pcre_OP_lengths[*ecode], offset_top, md, + ims, eptrb, flags, RM1); + if (rrc != MATCH_NOMATCH && rrc != MATCH_THEN) RRETURN(rrc); + md->capture_last = save_capture_last; + ecode += GET(ecode, 1); + } + while (*ecode == OP_ALT); + + DPRINTF(("bracket %d failed\n", number)); + + md->offset_vector[offset] = save_offset1; + md->offset_vector[offset+1] = save_offset2; + md->offset_vector[md->offset_end - number] = save_offset3; + + RRETURN(MATCH_NOMATCH); + } + + /* FALL THROUGH ... Insufficient room for saving captured contents. Treat + as a non-capturing bracket. */ + + /* VVVVVVVVVVVVVVVVVVVVVVVVV */ + /* VVVVVVVVVVVVVVVVVVVVVVVVV */ + + DPRINTF(("insufficient capture room: treat as non-capturing\n")); + + /* VVVVVVVVVVVVVVVVVVVVVVVVV */ + /* VVVVVVVVVVVVVVVVVVVVVVVVV */ + + /* Non-capturing bracket. Loop for all the alternatives. When we get to the + final alternative within the brackets, we would return the result of a + recursive call to match() whatever happened. We can reduce stack usage by + turning this into a tail recursion, except in the case when match_cbegroup + is set.*/ + + case OP_BRA: + case OP_SBRA: + DPRINTF(("start non-capturing bracket\n")); + flags = (op >= OP_SBRA)? match_cbegroup : 0; + for (;;) /* PaN: OK */ + { + if (ecode[GET(ecode, 1)] != OP_ALT) /* Final alternative */ + { + if (flags == 0) /* Not a possibly empty group */ + { + ecode += _erts_pcre_OP_lengths[*ecode]; + DPRINTF(("bracket 0 tail recursion\n")); + goto TAIL_RECURSE; + } + + /* Possibly empty group; can't use tail recursion. */ + + RMATCH(eptr, ecode + _erts_pcre_OP_lengths[*ecode], offset_top, md, ims, + eptrb, flags, RM48); + RRETURN(rrc); + } + + /* For non-final alternatives, continue the loop for a NOMATCH result; + otherwise return. */ + + RMATCH(eptr, ecode + _erts_pcre_OP_lengths[*ecode], offset_top, md, ims, + eptrb, flags, RM2); + if (rrc != MATCH_NOMATCH && rrc != MATCH_THEN) RRETURN(rrc); + ecode += GET(ecode, 1); + } + /* Control never reaches here. */ + + /* Conditional group: compilation checked that there are no more than + two branches. If the condition is false, skipping the first branch takes us + past the end if there is only one branch, but that's OK because that is + exactly what going to the ket would do. As there is only one branch to be + obeyed, we can use tail recursion to avoid using another stack frame. */ + + case OP_COND: + case OP_SCOND: + if (ecode[LINK_SIZE+1] == OP_RREF) /* Recursion test */ + { + offset = GET2(ecode, LINK_SIZE + 2); /* Recursion group number*/ + condition = md->recursive != NULL && + (offset == RREF_ANY || offset == md->recursive->group_num); + ecode += condition? 3 : GET(ecode, 1); + } + + else if (ecode[LINK_SIZE+1] == OP_CREF) /* Group used test */ + { + offset = GET2(ecode, LINK_SIZE+2) << 1; /* Doubled ref number */ + condition = offset < offset_top && md->offset_vector[offset] >= 0; + ecode += condition? 3 : GET(ecode, 1); + } + + else if (ecode[LINK_SIZE+1] == OP_DEF) /* DEFINE - always false */ + { + condition = FALSE; + ecode += GET(ecode, 1); + } + + /* The condition is an assertion. Call match() to evaluate it - setting + the final argument match_condassert causes it to stop at the end of an + assertion. */ + + else + { + RMATCH(eptr, ecode + 1 + LINK_SIZE, offset_top, md, ims, NULL, + match_condassert, RM3); + if (rrc == MATCH_MATCH) + { + condition = TRUE; + ecode += 1 + LINK_SIZE + GET(ecode, LINK_SIZE + 2); + while (*ecode == OP_ALT) ecode += GET(ecode, 1); /* PaN: Check */ + } + else if (rrc != MATCH_NOMATCH && rrc != MATCH_THEN) + { + RRETURN(rrc); /* Need braces because of following else */ + } + else + { + condition = FALSE; + ecode += GET(ecode, 1); + } + } + + /* We are now at the branch that is to be obeyed. As there is only one, + we can use tail recursion to avoid using another stack frame, except when + match_cbegroup is required for an unlimited repeat of a possibly empty + group. If the second alternative doesn't exist, we can just plough on. */ + + if (condition || *ecode == OP_ALT) + { + ecode += 1 + LINK_SIZE; + if (op == OP_SCOND) /* Possibly empty group */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, match_cbegroup, RM49); + RRETURN(rrc); + } + else /* Group must match something */ + { + flags = 0; + goto TAIL_RECURSE; + } + } + else /* Condition false & no 2nd alternative */ + { + ecode += 1 + LINK_SIZE; + } + break; + + + /* End of the pattern, either real or forced. If we are in a top-level + recursion, we should restore the offsets appropriately and continue from + after the call. */ + + case OP_ACCEPT: + case OP_END: + if (md->recursive != NULL && md->recursive->group_num == 0) + { + recursion_info *rec = md->recursive; + DPRINTF(("End of pattern in a (?0) recursion\n")); + md->recursive = rec->prevrec; + memmove(md->offset_vector, rec->offset_save, + rec->saved_max * sizeof(int)); + mstart = rec->save_start; + ims = original_ims; + ecode = rec->after_call; + break; + } + + /* Otherwise, if PCRE_NOTEMPTY is set, fail if we have matched an empty + string - backtracking will then try other alternatives, if any. */ + + if (md->notempty && eptr == mstart) RRETURN(MATCH_NOMATCH); + md->end_match_ptr = eptr; /* Record where we ended */ + md->end_offset_top = offset_top; /* and how many extracts were taken */ + md->start_match_ptr = mstart; /* and the start (\K can modify) */ + RRETURN(MATCH_MATCH); + + /* Change option settings */ + + case OP_OPT: + ims = ecode[1]; + ecode += 2; + DPRINTF(("ims set to %02lx\n", ims)); + break; + + /* Assertion brackets. Check the alternative branches in turn - the + matching won't pass the KET for an assertion. If any one branch matches, + the assertion is true. Lookbehind assertions have an OP_REVERSE item at the + start of each branch to move the current point backwards, so the code at + this level is identical to the lookahead case. */ + + case OP_ASSERT: + case OP_ASSERTBACK: + do /* PaN: OK */ + { + RMATCH(eptr, ecode + 1 + LINK_SIZE, offset_top, md, ims, NULL, 0, + RM4); + if (rrc == MATCH_MATCH) break; + if (rrc != MATCH_NOMATCH && rrc != MATCH_THEN) RRETURN(rrc); + ecode += GET(ecode, 1); + } + while (*ecode == OP_ALT); + if (*ecode == OP_KET) RRETURN(MATCH_NOMATCH); + + /* If checking an assertion for a condition, return MATCH_MATCH. */ + + if ((flags & match_condassert) != 0) RRETURN(MATCH_MATCH); + + /* Continue from after the assertion, updating the offsets high water + mark, since extracts may have been taken during the assertion. */ + + do ecode += GET(ecode,1); while (*ecode == OP_ALT); /* PaN: OK */ + ecode += 1 + LINK_SIZE; + offset_top = md->end_offset_top; + continue; + + /* Negative assertion: all branches must fail to match */ + + case OP_ASSERT_NOT: + case OP_ASSERTBACK_NOT: + do /* PaN: OK */ + { + RMATCH(eptr, ecode + 1 + LINK_SIZE, offset_top, md, ims, NULL, 0, + RM5); + if (rrc == MATCH_MATCH) RRETURN(MATCH_NOMATCH); + if (rrc != MATCH_NOMATCH && rrc != MATCH_THEN) RRETURN(rrc); + ecode += GET(ecode,1); + } + while (*ecode == OP_ALT); + + if ((flags & match_condassert) != 0) RRETURN(MATCH_MATCH); + + ecode += 1 + LINK_SIZE; + continue; + + /* Move the subject pointer back. This occurs only at the start of + each branch of a lookbehind assertion. If we are too close to the start to + move back, this match function fails. When working with UTF-8 we move + back a number of characters, not bytes. */ + + case OP_REVERSE: +#ifdef SUPPORT_UTF8 + if (utf8) + { + i = GET(ecode, 1); + COST(i); + while (i-- > 0) /* PaN: OK */ + { + eptr--; + if (eptr < md->start_subject) RRETURN(MATCH_NOMATCH); + BACKCHAR(eptr); + } + } + else +#endif + + /* No UTF-8 support, or not in UTF-8 mode: count is byte count */ + + { + eptr -= GET(ecode, 1); + if (eptr < md->start_subject) RRETURN(MATCH_NOMATCH); + } + + /* Skip to next op code */ + + ecode += 1 + LINK_SIZE; + break; + + /* The callout item calls an external function, if one is provided, passing + details of the match so far. This is mainly for debugging, though the + function is able to force a failure. */ + + case OP_CALLOUT: + if (erts_pcre_callout != NULL) + { + pcre_callout_block cb; + cb.version = 1; /* Version 1 of the callout block */ + cb.callout_number = ecode[1]; + cb.offset_vector = md->offset_vector; + cb.subject = (PCRE_SPTR)md->start_subject; + cb.subject_length = md->end_subject - md->start_subject; + cb.start_match = mstart - md->start_subject; + cb.current_position = eptr - md->start_subject; + cb.pattern_position = GET(ecode, 2); + cb.next_item_length = GET(ecode, 2 + LINK_SIZE); + cb.capture_top = offset_top/2; + cb.capture_last = md->capture_last; + cb.callout_data = md->callout_data; + if ((rrc = (*erts_pcre_callout)(&cb)) > 0) RRETURN(MATCH_NOMATCH); + if (rrc < 0) RRETURN(rrc); + } + ecode += 2 + 2*LINK_SIZE; + break; + + /* Recursion either matches the current regex, or some subexpression. The + offset data is the offset to the starting bracket from the start of the + whole pattern. (This is so that it works from duplicated subpatterns.) + + If there are any capturing brackets started but not finished, we have to + save their starting points and reinstate them after the recursion. However, + we don't know how many such there are (offset_top records the completed + total) so we just have to save all the potential data. There may be up to + 65535 such values, which is too large to put on the stack, but using malloc + for small numbers seems expensive. As a compromise, the stack is used when + there are no more than REC_STACK_SAVE_MAX values to store; otherwise malloc + is used. A problem is what to do if the malloc fails ... there is no way of + returning to the top level with an error. Save the top REC_STACK_SAVE_MAX + values on the stack, and accept that the rest may be wrong. + + There are also other values that have to be saved. We use a chained + sequence of blocks that actually live on the stack. Thanks to Robin Houston + for the original version of this logic. */ + + case OP_RECURSE: + { + callpat = md->start_code + GET(ecode, 1); + new_recursive.group_num = (callpat == md->start_code)? 0 : + GET2(callpat, 1 + LINK_SIZE); + + /* Add to "recursing stack" */ + + new_recursive.prevrec = md->recursive; + md->recursive = &new_recursive; + + /* Find where to continue from afterwards */ + + ecode += 1 + LINK_SIZE; + new_recursive.after_call = ecode; + + /* Now save the offset data. */ + + new_recursive.saved_max = md->offset_end; + if (new_recursive.saved_max <= REC_STACK_SAVE_MAX) + new_recursive.offset_save = stacksave; + else + { + new_recursive.offset_save = + (int *)(erts_pcre_malloc)(new_recursive.saved_max * sizeof(int)); + if (new_recursive.offset_save == NULL) RRETURN(PCRE_ERROR_NOMEMORY); + } + + memcpy(new_recursive.offset_save, md->offset_vector, + new_recursive.saved_max * sizeof(int)); + new_recursive.save_start = mstart; + mstart = eptr; + + /* OK, now we can do the recursion. For each top-level alternative we + restore the offset and recursion data. */ + + DPRINTF(("Recursing into group %d\n", new_recursive.group_num)); + flags = (*callpat >= OP_SBRA)? match_cbegroup : 0; + do /* PaN: OK */ + { + RMATCH(eptr, callpat + _erts_pcre_OP_lengths[*callpat], offset_top, + md, ims, eptrb, flags, RM6); + if (rrc == MATCH_MATCH) + { + DPRINTF(("Recursion matched\n")); + md->recursive = new_recursive.prevrec; + if (new_recursive.offset_save != stacksave) + (erts_pcre_free)(new_recursive.offset_save); + RRETURN(MATCH_MATCH); + } + else if (rrc != MATCH_NOMATCH && rrc != MATCH_THEN) + { + DPRINTF(("Recursion gave error %d\n", rrc)); + RRETURN(rrc); + } + + md->recursive = &new_recursive; + memcpy(md->offset_vector, new_recursive.offset_save, + new_recursive.saved_max * sizeof(int)); + callpat += GET(callpat, 1); + } + while (*callpat == OP_ALT); + + DPRINTF(("Recursion didn't match\n")); + md->recursive = new_recursive.prevrec; + if (new_recursive.offset_save != stacksave) + (erts_pcre_free)(new_recursive.offset_save); + RRETURN(MATCH_NOMATCH); + } + /* Control never reaches here */ + + /* "Once" brackets are like assertion brackets except that after a match, + the point in the subject string is not moved back. Thus there can never be + a move back into the brackets. Friedl calls these "atomic" subpatterns. + Check the alternative branches in turn - the matching won't pass the KET + for this kind of subpattern. If any one branch matches, we carry on as at + the end of a normal bracket, leaving the subject pointer. */ + + case OP_ONCE: + prev = ecode; + saved_eptr = eptr; + + do /* PaN: OK */ + { + RMATCH(eptr, ecode + 1 + LINK_SIZE, offset_top, md, ims, eptrb, 0, RM7); + if (rrc == MATCH_MATCH) break; + if (rrc != MATCH_NOMATCH && rrc != MATCH_THEN) RRETURN(rrc); + ecode += GET(ecode,1); + } + while (*ecode == OP_ALT); + + /* If hit the end of the group (which could be repeated), fail */ + + if (*ecode != OP_ONCE && *ecode != OP_ALT) RRETURN(MATCH_NOMATCH); + + /* Continue as from after the assertion, updating the offsets high water + mark, since extracts may have been taken. */ + + do ecode += GET(ecode, 1); while (*ecode == OP_ALT); /* PaN: OK */ + + offset_top = md->end_offset_top; + eptr = md->end_match_ptr; + + /* For a non-repeating ket, just continue at this level. This also + happens for a repeating ket if no characters were matched in the group. + This is the forcible breaking of infinite loops as implemented in Perl + 5.005. If there is an options reset, it will get obeyed in the normal + course of events. */ + + if (*ecode == OP_KET || eptr == saved_eptr) + { + ecode += 1+LINK_SIZE; + break; + } + + /* The repeating kets try the rest of the pattern or restart from the + preceding bracket, in the appropriate order. The second "call" of match() + uses tail recursion, to avoid using another stack frame. We need to reset + any options that changed within the bracket before re-running it, so + check the next opcode. */ + + if (ecode[1+LINK_SIZE] == OP_OPT) + { + ims = (ims & ~PCRE_IMS) | ecode[4]; + DPRINTF(("ims set to %02lx at group repeat\n", ims)); + } + + if (*ecode == OP_KETRMIN) + { + RMATCH(eptr, ecode + 1 + LINK_SIZE, offset_top, md, ims, eptrb, 0, RM8); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + ecode = prev; + flags = 0; + goto TAIL_RECURSE; + } + else /* OP_KETRMAX */ + { + RMATCH(eptr, prev, offset_top, md, ims, eptrb, match_cbegroup, RM9); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + ecode += 1 + LINK_SIZE; + flags = 0; + goto TAIL_RECURSE; + } + /* Control never gets here */ + + /* An alternation is the end of a branch; scan along to find the end of the + bracketed group and go to there. */ + + case OP_ALT: + do ecode += GET(ecode,1); while (*ecode == OP_ALT); /* PaN: OK */ + break; + + /* BRAZERO and BRAMINZERO occur just before a bracket group, indicating + that it may occur zero times. It may repeat infinitely, or not at all - + i.e. it could be ()* or ()? in the pattern. Brackets with fixed upper + repeat limits are compiled as a number of copies, with the optional ones + preceded by BRAZERO or BRAMINZERO. */ + + case OP_BRAZERO: + { + next = ecode+1; + RMATCH(eptr, next, offset_top, md, ims, eptrb, 0, RM10); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + do next += GET(next,1); while (*next == OP_ALT); /* PaN: OK */ + ecode = next + 1 + LINK_SIZE; + } + break; + + case OP_BRAMINZERO: + { + next = ecode+1; + do next += GET(next, 1); while (*next == OP_ALT); /* PaN: OK */ + RMATCH(eptr, next + 1+LINK_SIZE, offset_top, md, ims, eptrb, 0, RM11); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + ecode++; + } + break; + + /* End of a group, repeated or non-repeating. */ + + case OP_KET: + case OP_KETRMIN: + case OP_KETRMAX: + prev = ecode - GET(ecode, 1); + + /* If this was a group that remembered the subject start, in order to break + infinite repeats of empty string matches, retrieve the subject start from + the chain. Otherwise, set it NULL. */ + + if (*prev >= OP_SBRA) + { + saved_eptr = eptrb->epb_saved_eptr; /* Value at start of group */ + eptrb = eptrb->epb_prev; /* Backup to previous group */ + } + else saved_eptr = NULL; + + /* If we are at the end of an assertion group, stop matching and return + MATCH_MATCH, but record the current high water mark for use by positive + assertions. Do this also for the "once" (atomic) groups. */ + + if (*prev == OP_ASSERT || *prev == OP_ASSERT_NOT || + *prev == OP_ASSERTBACK || *prev == OP_ASSERTBACK_NOT || + *prev == OP_ONCE) + { + md->end_match_ptr = eptr; /* For ONCE */ + md->end_offset_top = offset_top; + RRETURN(MATCH_MATCH); + } + + /* For capturing groups we have to check the group number back at the start + and if necessary complete handling an extraction by setting the offsets and + bumping the high water mark. Note that whole-pattern recursion is coded as + a recurse into group 0, so it won't be picked up here. Instead, we catch it + when the OP_END is reached. Other recursion is handled here. */ + + if (*prev == OP_CBRA || *prev == OP_SCBRA) + { + number = GET2(prev, 1+LINK_SIZE); + offset = number << 1; + +#ifdef DEBUG + printf("end bracket %d", number); + printf("\n"); +#endif + + md->capture_last = number; + if (offset >= md->offset_max) md->offset_overflow = TRUE; else + { + md->offset_vector[offset] = + md->offset_vector[md->offset_end - number]; + md->offset_vector[offset+1] = eptr - md->start_subject; + if (offset_top <= offset) offset_top = offset + 2; + } + + /* Handle a recursively called group. Restore the offsets + appropriately and continue from after the call. */ + + if (md->recursive != NULL && md->recursive->group_num == number) + { + recursion_info *rec = md->recursive; + DPRINTF(("Recursion (%d) succeeded - continuing\n", number)); + md->recursive = rec->prevrec; + mstart = rec->save_start; + memcpy(md->offset_vector, rec->offset_save, + rec->saved_max * sizeof(int)); + ecode = rec->after_call; + ims = original_ims; + break; + } + } + + /* For both capturing and non-capturing groups, reset the value of the ims + flags, in case they got changed during the group. */ + + ims = original_ims; + DPRINTF(("ims reset to %02lx\n", ims)); + + /* For a non-repeating ket, just continue at this level. This also + happens for a repeating ket if no characters were matched in the group. + This is the forcible breaking of infinite loops as implemented in Perl + 5.005. If there is an options reset, it will get obeyed in the normal + course of events. */ + + if (*ecode == OP_KET || eptr == saved_eptr) + { + ecode += 1 + LINK_SIZE; + break; + } + + /* The repeating kets try the rest of the pattern or restart from the + preceding bracket, in the appropriate order. In the second case, we can use + tail recursion to avoid using another stack frame, unless we have an + unlimited repeat of a group that can match an empty string. */ + + flags = (*prev >= OP_SBRA)? match_cbegroup : 0; + + if (*ecode == OP_KETRMIN) + { + RMATCH(eptr, ecode + 1 + LINK_SIZE, offset_top, md, ims, eptrb, 0, RM12); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (flags != 0) /* Could match an empty string */ + { + RMATCH(eptr, prev, offset_top, md, ims, eptrb, flags, RM50); + RRETURN(rrc); + } + ecode = prev; + goto TAIL_RECURSE; + } + else /* OP_KETRMAX */ + { + RMATCH(eptr, prev, offset_top, md, ims, eptrb, flags, RM13); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + ecode += 1 + LINK_SIZE; + flags = 0; + goto TAIL_RECURSE; + } + /* Control never gets here */ + + /* Start of subject unless notbol, or after internal newline if multiline */ + + case OP_CIRC: + if (md->notbol && eptr == md->start_subject) RRETURN(MATCH_NOMATCH); + if ((ims & PCRE_MULTILINE) != 0) + { + if (eptr != md->start_subject && + (eptr >= md->end_subject || !WAS_NEWLINE(eptr))) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + } + /* ... else fall through */ + + /* Start of subject assertion */ + + case OP_SOD: + if (eptr != md->start_subject) RRETURN(MATCH_NOMATCH); + ecode++; + break; + + /* Start of match assertion */ + + case OP_SOM: + if (eptr != md->start_subject + md->start_offset) RRETURN(MATCH_NOMATCH); + ecode++; + break; + + /* Reset the start of match point */ + + case OP_SET_SOM: + mstart = eptr; + ecode++; + break; + + /* Assert before internal newline if multiline, or before a terminating + newline unless endonly is set, else end of subject unless noteol is set. */ + + case OP_DOLL: + if ((ims & PCRE_MULTILINE) != 0) + { + if (eptr < md->end_subject) + { if (!IS_NEWLINE(eptr)) RRETURN(MATCH_NOMATCH); } + else + { if (md->noteol) RRETURN(MATCH_NOMATCH); } + ecode++; + break; + } + else + { + if (md->noteol) RRETURN(MATCH_NOMATCH); + if (!md->endonly) + { + if (eptr != md->end_subject && + (!IS_NEWLINE(eptr) || eptr != md->end_subject - md->nllen)) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + } + } + /* ... else fall through for endonly */ + + /* End of subject assertion (\z) */ + + case OP_EOD: + if (eptr < md->end_subject) RRETURN(MATCH_NOMATCH); + ecode++; + break; + + /* End of subject or ending \n assertion (\Z) */ + + case OP_EODN: + if (eptr != md->end_subject && + (!IS_NEWLINE(eptr) || eptr != md->end_subject - md->nllen)) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + + /* Word boundary assertions */ + + case OP_NOT_WORD_BOUNDARY: + case OP_WORD_BOUNDARY: + { + + /* Find out if the previous and current characters are "word" characters. + It takes a bit more work in UTF-8 mode. Characters > 255 are assumed to + be "non-word" characters. */ + +#ifdef SUPPORT_UTF8 + if (utf8) + { + if (eptr == md->start_subject) prev_is_word = FALSE; else + { + const uschar *lastptr = eptr - 1; + while((*lastptr & 0xc0) == 0x80) lastptr--; /* PaN: OK */ + GETCHAR(c, lastptr); + prev_is_word = c < 256 && (md->ctypes[c] & ctype_word) != 0; + } + if (eptr >= md->end_subject) cur_is_word = FALSE; else + { + GETCHAR(c, eptr); + cur_is_word = c < 256 && (md->ctypes[c] & ctype_word) != 0; + } + } + else +#endif + + /* More streamlined when not in UTF-8 mode */ + + { + prev_is_word = (eptr != md->start_subject) && + ((md->ctypes[eptr[-1]] & ctype_word) != 0); + cur_is_word = (eptr < md->end_subject) && + ((md->ctypes[*eptr] & ctype_word) != 0); + } + + /* Now see if the situation is what we want */ + + if ((*ecode++ == OP_WORD_BOUNDARY)? + cur_is_word == prev_is_word : cur_is_word != prev_is_word) + RRETURN(MATCH_NOMATCH); + } + break; + + /* Match a single character type; inline for speed */ + + case OP_ANY: + if ((ims & PCRE_DOTALL) == 0) + { + if (IS_NEWLINE(eptr)) RRETURN(MATCH_NOMATCH); + } + if (eptr++ >= md->end_subject) RRETURN(MATCH_NOMATCH); + if (utf8) + while (eptr < md->end_subject && (*eptr & 0xc0) == 0x80) eptr++; /* PaN: OK */ + ecode++; + break; + + /* Match a single byte, even in UTF-8 mode. This opcode really does match + any byte, even newline, independent of the setting of PCRE_DOTALL. */ + + case OP_ANYBYTE: + if (eptr++ >= md->end_subject) RRETURN(MATCH_NOMATCH); + ecode++; + break; + + case OP_NOT_DIGIT: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + if ( +#ifdef SUPPORT_UTF8 + c < 256 && +#endif + (md->ctypes[c] & ctype_digit) != 0 + ) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + + case OP_DIGIT: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + if ( +#ifdef SUPPORT_UTF8 + c >= 256 || +#endif + (md->ctypes[c] & ctype_digit) == 0 + ) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + + case OP_NOT_WHITESPACE: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + if ( +#ifdef SUPPORT_UTF8 + c < 256 && +#endif + (md->ctypes[c] & ctype_space) != 0 + ) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + + case OP_WHITESPACE: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + if ( +#ifdef SUPPORT_UTF8 + c >= 256 || +#endif + (md->ctypes[c] & ctype_space) == 0 + ) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + + case OP_NOT_WORDCHAR: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + if ( +#ifdef SUPPORT_UTF8 + c < 256 && +#endif + (md->ctypes[c] & ctype_word) != 0 + ) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + + case OP_WORDCHAR: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + if ( +#ifdef SUPPORT_UTF8 + c >= 256 || +#endif + (md->ctypes[c] & ctype_word) == 0 + ) + RRETURN(MATCH_NOMATCH); + ecode++; + break; + + case OP_ANYNL: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x000d: + if (eptr < md->end_subject && *eptr == 0x0a) eptr++; + break; + + case 0x000a: + break; + + case 0x000b: + case 0x000c: + case 0x0085: + case 0x2028: + case 0x2029: + if (md->bsr_anycrlf) RRETURN(MATCH_NOMATCH); + break; + } + ecode++; + break; + + case OP_NOT_HSPACE: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + switch(c) + { + default: break; + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + RRETURN(MATCH_NOMATCH); + } + ecode++; + break; + + case OP_HSPACE: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + break; + } + ecode++; + break; + + case OP_NOT_VSPACE: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + switch(c) + { + default: break; + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + case 0x2028: /* LINE SEPARATOR */ + case 0x2029: /* PARAGRAPH SEPARATOR */ + RRETURN(MATCH_NOMATCH); + } + ecode++; + break; + + case OP_VSPACE: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + case 0x2028: /* LINE SEPARATOR */ + case 0x2029: /* PARAGRAPH SEPARATOR */ + break; + } + ecode++; + break; + +#ifdef SUPPORT_UCP + /* Check the next character by Unicode property. We will get here only + if the support is in the binary; otherwise a compile-time error occurs. */ + + case OP_PROP: + case OP_NOTPROP: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + { + int chartype, script; + int category = _erts_pcre_ucp_findprop(c, &chartype, &script); + + switch(ecode[1]) + { + case PT_ANY: + if (op == OP_NOTPROP) RRETURN(MATCH_NOMATCH); + break; + + case PT_LAMP: + if ((chartype == ucp_Lu || + chartype == ucp_Ll || + chartype == ucp_Lt) == (op == OP_NOTPROP)) + RRETURN(MATCH_NOMATCH); + break; + + case PT_GC: + if ((ecode[2] != category) == (op == OP_PROP)) + RRETURN(MATCH_NOMATCH); + break; + + case PT_PC: + if ((ecode[2] != chartype) == (op == OP_PROP)) + RRETURN(MATCH_NOMATCH); + break; + + case PT_SC: + if ((ecode[2] != script) == (op == OP_PROP)) + RRETURN(MATCH_NOMATCH); + break; + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } + + ecode += 3; + } + break; + + /* Match an extended Unicode sequence. We will get here only if the support + is in the binary; otherwise a compile-time error occurs. */ + + case OP_EXTUNI: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + { + int chartype, script; + int category = _erts_pcre_ucp_findprop(c, &chartype, &script); + if (category == ucp_M) RRETURN(MATCH_NOMATCH); + while (eptr < md->end_subject) /* PaN: OK */ + { + int len = 1; + if (!utf8) c = *eptr; else + { + GETCHARLEN(c, eptr, len); + } + category = _erts_pcre_ucp_findprop(c, &chartype, &script); + if (category != ucp_M) break; + eptr += len; + COST_CHK(1); + } + } + ecode++; + break; +#endif + + + /* Match a back reference, possibly repeatedly. Look past the end of the + item to see if there is repeat information following. The code is similar + to that for character classes, but repeated for efficiency. Then obey + similar code to character type repeats - written out again for speed. + However, if the referenced string is the empty string, always treat + it as matched, any number of times (otherwise there could be infinite + loops). */ + + case OP_REF: + { + offset = GET2(ecode, 1) << 1; /* Doubled ref number */ + ecode += 3; /* Advance past item */ + + /* If the reference is unset, set the length to be longer than the amount + of subject left; this ensures that every attempt at a match fails. We + can't just fail here, because of the possibility of quantifiers with zero + minima. */ + + length = (offset >= offset_top || md->offset_vector[offset] < 0)? + md->end_subject - eptr + 1 : + md->offset_vector[offset+1] - md->offset_vector[offset]; + + /* Set up for repetition, or handle the non-repeated case */ + + switch (*ecode) + { + case OP_CRSTAR: + case OP_CRMINSTAR: + case OP_CRPLUS: + case OP_CRMINPLUS: + case OP_CRQUERY: + case OP_CRMINQUERY: + c = *ecode++ - OP_CRSTAR; + minimize = (c & 1) != 0; + min = rep_min[c]; /* Pick up values from tables; */ + max = rep_max[c]; /* zero for max => infinity */ + if (max == 0) max = INT_MAX; + break; + + case OP_CRRANGE: + case OP_CRMINRANGE: + minimize = (*ecode == OP_CRMINRANGE); + min = GET2(ecode, 1); + max = GET2(ecode, 3); + if (max == 0) max = INT_MAX; + ecode += 5; + break; + + default: /* No repeat follows */ + if (!match_ref(offset, eptr, length, md, ims)) RRETURN(MATCH_NOMATCH); + eptr += length; + continue; /* With the main loop */ + } + + /* If the length of the reference is zero, just continue with the + main loop. */ + + if (length == 0) continue; + + /* First, ensure the minimum number of matches are present. We get back + the length of the reference string explicitly rather than passing the + address of eptr, so that eptr can be a register variable. */ + + COST(min); + for (i = 1; i <= min; i++) + { + if (!match_ref(offset, eptr, length, md, ims)) RRETURN(MATCH_NOMATCH); + eptr += length; + } + + /* If min = max, continue at the same level without recursion. + They are not both allowed to be zero. */ + + if (min == max) continue; + + /* If minimizing, keep trying and advancing the pointer */ + + if (minimize) + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM14); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || !match_ref(offset, eptr, length, md, ims)) + RRETURN(MATCH_NOMATCH); + eptr += length; + } + /* Control never gets here */ + } + + /* If maximizing, find the longest string and work backwards */ + + else + { + pp = eptr; + for (i = min; i < max; i++) /* PaN: OK */ + { + if (!match_ref(offset, eptr, length, md, ims)) break; + eptr += length; + COST_CHK(1); + } + while (eptr >= pp) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM15); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + eptr -= length; + } + RRETURN(MATCH_NOMATCH); + } + } + /* Control never gets here */ + + + + /* Match a bit-mapped character class, possibly repeatedly. This op code is + used when all the characters in the class have values in the range 0-255, + and either the matching is caseful, or the characters are in the range + 0-127 when UTF-8 processing is enabled. The only difference between + OP_CLASS and OP_NCLASS occurs when a data character outside the range is + encountered. + + First, look past the end of the item to see if there is repeat information + following. Then obey similar code to character type repeats - written out + again for speed. */ + + case OP_NCLASS: + case OP_CLASS: + { + data = ecode + 1; /* Save for matching */ + ecode += 33; /* Advance past the item */ +#ifdef ERLANG_INTEGRATION + EDEBUGF(("OP_(N)CLASS (%d)...",*ecode)); +#endif + + switch (*ecode) + { + case OP_CRSTAR: + case OP_CRMINSTAR: + case OP_CRPLUS: + case OP_CRMINPLUS: + case OP_CRQUERY: + case OP_CRMINQUERY: + c = *ecode++ - OP_CRSTAR; + minimize = (c & 1) != 0; + min = rep_min[c]; /* Pick up values from tables; */ + max = rep_max[c]; /* zero for max => infinity */ + if (max == 0) max = INT_MAX; + break; + + case OP_CRRANGE: + case OP_CRMINRANGE: + minimize = (*ecode == OP_CRMINRANGE); + min = GET2(ecode, 1); + max = GET2(ecode, 3); + if (max == 0) max = INT_MAX; + ecode += 5; + break; + + default: /* No repeat follows */ + min = max = 1; + break; + } + + /* First, ensure the minimum number of matches are present. */ + +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + if (c > 255) + { + if (op == OP_CLASS) RRETURN(MATCH_NOMATCH); + } + else + { + if ((data[c/8] & (1 << (c&7))) == 0) RRETURN(MATCH_NOMATCH); + } + } + } + else +#endif + /* Not UTF-8 mode */ + { + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + c = *eptr++; + if ((data[c/8] & (1 << (c&7))) == 0) RRETURN(MATCH_NOMATCH); + } + } + + /* If max == min we can continue with the main loop without the + need to recurse. */ + + if (min == max) continue; + + /* If minimizing, keep testing the rest of the expression and advancing + the pointer while it matches the class. */ + + if (minimize) + { +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM16); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + if (c > 255) + { + if (op == OP_CLASS) RRETURN(MATCH_NOMATCH); + } + else + { + if ((data[c/8] & (1 << (c&7))) == 0) RRETURN(MATCH_NOMATCH); + } + } + } + else +#endif + /* Not UTF-8 mode */ + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM17); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + c = *eptr++; + if ((data[c/8] & (1 << (c&7))) == 0) RRETURN(MATCH_NOMATCH); + } + } + /* Control never gets here */ + } + + /* If maximizing, find the longest possible run, then work backwards. */ + + else + { + pp = eptr; + +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + for (i = min; i < max; i++) /* PaN: OK */ + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (c > 255) + { + if (op == OP_CLASS) break; + } + else + { + if ((data[c/8] & (1 << (c&7))) == 0) break; + } + eptr += len; + COST_CHK(1); + } + for (;;) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM18); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (eptr-- == pp) break; /* Stop if tried at original pos */ + BACKCHAR(eptr); + } + } + else +#endif + /* Not UTF-8 mode */ + { + for (i = min; i < max; i++) /* PaN: OK */ + { + if (eptr >= md->end_subject) break; + c = *eptr; + if ((data[c/8] & (1 << (c&7))) == 0) break; + eptr++; + COST_CHK(1); + } + while (eptr >= pp) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM19); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + eptr--; + } + } + + RRETURN(MATCH_NOMATCH); + } + } + /* Control never gets here */ + + + /* Match an extended character class. This opcode is encountered only + in UTF-8 mode, because that's the only time it is compiled. */ + +#ifdef SUPPORT_UTF8 + case OP_XCLASS: + { + data = ecode + 1 + LINK_SIZE; /* Save for matching */ + ecode += GET(ecode, 1); /* Advance past the item */ + + switch (*ecode) + { + case OP_CRSTAR: + case OP_CRMINSTAR: + case OP_CRPLUS: + case OP_CRMINPLUS: + case OP_CRQUERY: + case OP_CRMINQUERY: + c = *ecode++ - OP_CRSTAR; + minimize = (c & 1) != 0; + min = rep_min[c]; /* Pick up values from tables; */ + max = rep_max[c]; /* zero for max => infinity */ + if (max == 0) max = INT_MAX; + break; + + case OP_CRRANGE: + case OP_CRMINRANGE: + minimize = (*ecode == OP_CRMINRANGE); + min = GET2(ecode, 1); + max = GET2(ecode, 3); + if (max == 0) max = INT_MAX; + ecode += 5; + break; + + default: /* No repeat follows */ + min = max = 1; + break; + } + + /* First, ensure the minimum number of matches are present. */ + + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + if (!_erts_pcre_xclass(c, data)) RRETURN(MATCH_NOMATCH); + } + + /* If max == min we can continue with the main loop without the + need to recurse. */ + + if (min == max) continue; + + /* If minimizing, keep testing the rest of the expression and advancing + the pointer while it matches the class. */ + + if (minimize) + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM20); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + if (!_erts_pcre_xclass(c, data)) RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + } + + /* If maximizing, find the longest possible run, then work backwards. */ + + else + { + pp = eptr; + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (!_erts_pcre_xclass(c, data)) break; + eptr += len; + COST_CHK(1); + } + for(;;) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM21); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (eptr-- == pp) break; /* Stop if tried at original pos */ + if (utf8) BACKCHAR(eptr); + } + RRETURN(MATCH_NOMATCH); + } + + /* Control never gets here */ + } +#endif /* End of XCLASS */ + + /* Match a single character, casefully */ + + case OP_CHAR: +#ifdef SUPPORT_UTF8 + if (utf8) + { + length = 1; + ecode++; + GETCHARLEN(fc, ecode, length); + if (length > md->end_subject - eptr) RRETURN(MATCH_NOMATCH); + while (length-- > 0) if (*ecode++ != *eptr++) RRETURN(MATCH_NOMATCH); /* PaN: OK */ + } + else +#endif + + /* Non-UTF-8 mode */ + { + if (md->end_subject - eptr < 1) RRETURN(MATCH_NOMATCH); + EDEBUGF(("code to match:%d, code is:%d",ecode[1],*eptr)); + if (ecode[1] != *eptr++) RRETURN(MATCH_NOMATCH); + ecode += 2; + } + break; + + /* Match a single character, caselessly */ + + case OP_CHARNC: +#ifdef SUPPORT_UTF8 + if (utf8) + { + length = 1; + ecode++; + GETCHARLEN(fc, ecode, length); + + if (length > md->end_subject - eptr) RRETURN(MATCH_NOMATCH); + + /* If the pattern character's value is < 128, we have only one byte, and + can use the fast lookup table. */ + + if (fc < 128) + { + if (md->lcc[*ecode++] != md->lcc[*eptr++]) RRETURN(MATCH_NOMATCH); + } + + /* Otherwise we must pick up the subject character */ + + else + { + unsigned int dc; + GETCHARINC(dc, eptr); + ecode += length; + + /* If we have Unicode property support, we can use it to test the other + case of the character, if there is one. */ + + if (fc != dc) + { +#ifdef SUPPORT_UCP + if (dc != _erts_pcre_ucp_othercase(fc)) +#endif + RRETURN(MATCH_NOMATCH); + } + } + } + else +#endif /* SUPPORT_UTF8 */ + + /* Non-UTF-8 mode */ + { + if (md->end_subject - eptr < 1) RRETURN(MATCH_NOMATCH); + if (md->lcc[ecode[1]] != md->lcc[*eptr++]) RRETURN(MATCH_NOMATCH); + ecode += 2; + } + break; + + /* Match a single character repeatedly. */ + + case OP_EXACT: + min = max = GET2(ecode, 1); + ecode += 3; + goto REPEATCHAR; + + case OP_POSUPTO: + possessive = TRUE; + /* Fall through */ + + case OP_UPTO: + case OP_MINUPTO: + min = 0; + max = GET2(ecode, 1); + minimize = *ecode == OP_MINUPTO; + ecode += 3; + goto REPEATCHAR; + + case OP_POSSTAR: + possessive = TRUE; + min = 0; + max = INT_MAX; + ecode++; + goto REPEATCHAR; + + case OP_POSPLUS: + possessive = TRUE; + min = 1; + max = INT_MAX; + ecode++; + goto REPEATCHAR; + + case OP_POSQUERY: + possessive = TRUE; + min = 0; + max = 1; + ecode++; + goto REPEATCHAR; + + case OP_STAR: + case OP_MINSTAR: + case OP_PLUS: + case OP_MINPLUS: + case OP_QUERY: + case OP_MINQUERY: + c = *ecode++ - OP_STAR; + minimize = (c & 1) != 0; + min = rep_min[c]; /* Pick up values from tables; */ + max = rep_max[c]; /* zero for max => infinity */ + if (max == 0) max = INT_MAX; + + /* Common code for all repeated single-character matches. We can give + up quickly if there are fewer than the minimum number of characters left in + the subject. */ + + REPEATCHAR: +#ifdef SUPPORT_UTF8 + if (utf8) + { + length = 1; + charptr = ecode; + GETCHARLEN(fc, ecode, length); + if (min * length > md->end_subject - eptr) RRETURN(MATCH_NOMATCH); + ecode += length; + + /* Handle multibyte character matching specially here. There is + support for caseless matching if UCP support is present. */ + + if (length > 1) + { +#ifdef SUPPORT_UCP + unsigned int othercase; + if ((ims & PCRE_CASELESS) != 0 && + (othercase = _erts_pcre_ucp_othercase(fc)) != NOTACHAR) + oclength = _erts_pcre_ord2utf8(othercase, occhars); + else oclength = 0; +#endif /* SUPPORT_UCP */ + COST(min); + for (i = 1; i <= min; i++) /* PaN: Cost min (?) */ + { + if (memcmp(eptr, charptr, length) == 0) eptr += length; +#ifdef SUPPORT_UCP + /* Need braces because of following else */ + else if (oclength == 0) { RRETURN(MATCH_NOMATCH); } + else + { + if (memcmp(eptr, occhars, oclength) != 0) RRETURN(MATCH_NOMATCH); + eptr += oclength; + } +#else /* without SUPPORT_UCP */ + else { RRETURN(MATCH_NOMATCH); } +#endif /* SUPPORT_UCP */ + } + + if (min == max) continue; + + if (minimize) + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM22); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + if (memcmp(eptr, charptr, length) == 0) eptr += length; +#ifdef SUPPORT_UCP + /* Need braces because of following else */ + else if (oclength == 0) { RRETURN(MATCH_NOMATCH); } + else + { + if (memcmp(eptr, occhars, oclength) != 0) RRETURN(MATCH_NOMATCH); + eptr += oclength; + } +#else /* without SUPPORT_UCP */ + else { RRETURN (MATCH_NOMATCH); } +#endif /* SUPPORT_UCP */ + } + /* Control never gets here */ + } + + else /* Maximize */ + { + pp = eptr; + for (i = min; i < max; i++) + { + if (eptr > md->end_subject - length) break; + if (memcmp(eptr, charptr, length) == 0) eptr += length; +#ifdef SUPPORT_UCP + else if (oclength == 0) break; + else + { + if (memcmp(eptr, occhars, oclength) != 0) break; + eptr += oclength; + } +#else /* without SUPPORT_UCP */ + else break; +#endif /* SUPPORT_UCP */ + COST_CHK(1); + } + + if (possessive) continue; + for(;;) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM23); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (eptr == pp) RRETURN(MATCH_NOMATCH); +#ifdef SUPPORT_UCP + eptr--; + BACKCHAR(eptr); +#else /* without SUPPORT_UCP */ + eptr -= length; +#endif /* SUPPORT_UCP */ + } + } + /* Control never gets here */ + } + + /* If the length of a UTF-8 character is 1, we fall through here, and + obey the code as for non-UTF-8 characters below, though in this case the + value of fc will always be < 128. */ + } + else +#endif /* SUPPORT_UTF8 */ + + /* When not in UTF-8 mode, load a single-byte character. */ + { + if (min > md->end_subject - eptr) RRETURN(MATCH_NOMATCH); + fc = *ecode++; + } + + /* The value of fc at this point is always less than 256, though we may or + may not be in UTF-8 mode. The code is duplicated for the caseless and + caseful cases, for speed, since matching characters is likely to be quite + common. First, ensure the minimum number of matches are present. If min = + max, continue at the same level without recursing. Otherwise, if + minimizing, keep trying the rest of the expression and advancing one + matching character if failing, up to the maximum. Alternatively, if + maximizing, find the maximum number of characters and work backwards. */ + + DPRINTF(("matching %c{%d,%d} against subject %.*s\n", fc, min, max, + max, eptr)); + + if ((ims & PCRE_CASELESS) != 0) + { + fc = md->lcc[fc]; + COST(min); + for (i = 1; i <= min; i++) + if (fc != md->lcc[*eptr++]) RRETURN(MATCH_NOMATCH); + if (min == max) continue; + if (minimize) + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM24); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject || + fc != md->lcc[*eptr++]) + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + } + else /* Maximize */ + { + pp = eptr; + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || fc != md->lcc[*eptr]) break; + eptr++; + COST_CHK(1); + } + if (possessive) continue; + while (eptr >= pp) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM25); + eptr--; + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + } + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + } + + /* Caseful comparisons (includes all multi-byte characters) */ + + else + { + COST(min); + for (i = 1; i <= min; i++) if (fc != *eptr++) RRETURN(MATCH_NOMATCH); + if (min == max) continue; + if (minimize) + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM26); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject || fc != *eptr++) + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + } + else /* Maximize */ + { + pp = eptr; + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || fc != *eptr) break; + eptr++; + COST_CHK(1); + } + if (possessive) continue; + while (eptr >= pp) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM27); + eptr--; + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + } + RRETURN(MATCH_NOMATCH); + } + } + /* Control never gets here */ + + /* Match a negated single one-byte character. The character we are + checking can be multibyte. */ + + case OP_NOT: + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + ecode++; + GETCHARINCTEST(c, eptr); + if ((ims & PCRE_CASELESS) != 0) + { +#ifdef SUPPORT_UTF8 + if (c < 256) +#endif + c = md->lcc[c]; + if (md->lcc[*ecode++] == c) RRETURN(MATCH_NOMATCH); + } + else + { + if (*ecode++ == c) RRETURN(MATCH_NOMATCH); + } + break; + + /* Match a negated single one-byte character repeatedly. This is almost a + repeat of the code for a repeated single character, but I haven't found a + nice way of commoning these up that doesn't require a test of the + positive/negative option for each character match. Maybe that wouldn't add + very much to the time taken, but character matching *is* what this is all + about... */ + + case OP_NOTEXACT: + min = max = GET2(ecode, 1); + ecode += 3; + goto REPEATNOTCHAR; + + case OP_NOTUPTO: + case OP_NOTMINUPTO: + min = 0; + max = GET2(ecode, 1); + minimize = *ecode == OP_NOTMINUPTO; + ecode += 3; + goto REPEATNOTCHAR; + + case OP_NOTPOSSTAR: + possessive = TRUE; + min = 0; + max = INT_MAX; + ecode++; + goto REPEATNOTCHAR; + + case OP_NOTPOSPLUS: + possessive = TRUE; + min = 1; + max = INT_MAX; + ecode++; + goto REPEATNOTCHAR; + + case OP_NOTPOSQUERY: + possessive = TRUE; + min = 0; + max = 1; + ecode++; + goto REPEATNOTCHAR; + + case OP_NOTPOSUPTO: + possessive = TRUE; + min = 0; + max = GET2(ecode, 1); + ecode += 3; + goto REPEATNOTCHAR; + + case OP_NOTSTAR: + case OP_NOTMINSTAR: + case OP_NOTPLUS: + case OP_NOTMINPLUS: + case OP_NOTQUERY: + case OP_NOTMINQUERY: + c = *ecode++ - OP_NOTSTAR; + minimize = (c & 1) != 0; + min = rep_min[c]; /* Pick up values from tables; */ + max = rep_max[c]; /* zero for max => infinity */ + if (max == 0) max = INT_MAX; + + /* Common code for all repeated single-byte matches. We can give up quickly + if there are fewer than the minimum number of bytes left in the + subject. */ + + REPEATNOTCHAR: + if (min > md->end_subject - eptr) RRETURN(MATCH_NOMATCH); + fc = *ecode++; + + /* The code is duplicated for the caseless and caseful cases, for speed, + since matching characters is likely to be quite common. First, ensure the + minimum number of matches are present. If min = max, continue at the same + level without recursing. Otherwise, if minimizing, keep trying the rest of + the expression and advancing one matching character if failing, up to the + maximum. Alternatively, if maximizing, find the maximum number of + characters and work backwards. */ + + DPRINTF(("negative matching %c{%d,%d} against subject %.*s\n", fc, min, max, + max, eptr)); + + if ((ims & PCRE_CASELESS) != 0) + { + fc = md->lcc[fc]; + +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + register unsigned int d; + COST(min); + for (i = 1; i <= min; i++) + { + GETCHARINC(d, eptr); + if (d < 256) d = md->lcc[d]; + if (fc == d) RRETURN(MATCH_NOMATCH); + } + } + else +#endif + + /* Not UTF-8 mode */ + { + COST(min); + for (i = 1; i <= min; i++) + if (fc == md->lcc[*eptr++]) RRETURN(MATCH_NOMATCH); + } + + if (min == max) continue; + + if (minimize) + { +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + register unsigned int d; + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM28); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + GETCHARINC(d, eptr); + if (d < 256) d = md->lcc[d]; + if (fi >= max || eptr >= md->end_subject || fc == d) + RRETURN(MATCH_NOMATCH); + } + } + else +#endif + /* Not UTF-8 mode */ + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM29); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject || fc == md->lcc[*eptr++]) + RRETURN(MATCH_NOMATCH); + } + } + /* Control never gets here */ + } + + /* Maximize case */ + + else + { + pp = eptr; + +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + register unsigned int d; + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(d, eptr, len); + if (d < 256) d = md->lcc[d]; + if (fc == d) break; + eptr += len; + COST_CHK(1); + } + if (possessive) continue; + for(;;) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM30); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (eptr-- == pp) break; /* Stop if tried at original pos */ + BACKCHAR(eptr); + } + } + else +#endif + /* Not UTF-8 mode */ + { + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || fc == md->lcc[*eptr]) break; + eptr++; + COST_CHK(1); + } + if (possessive) continue; + while (eptr >= pp) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM31); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + eptr--; + } + } + + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + } + + /* Caseful comparisons */ + + else + { +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + register unsigned int d; + COST(min); + for (i = 1; i <= min; i++) + { + GETCHARINC(d, eptr); + if (fc == d) RRETURN(MATCH_NOMATCH); + } + } + else +#endif + /* Not UTF-8 mode */ + { + COST(min); + for (i = 1; i <= min; i++) + if (fc == *eptr++) RRETURN(MATCH_NOMATCH); + } + + if (min == max) continue; + + if (minimize) + { +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + register unsigned int d; + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM32); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + GETCHARINC(d, eptr); + if (fi >= max || eptr >= md->end_subject || fc == d) + RRETURN(MATCH_NOMATCH); + } + } + else +#endif + /* Not UTF-8 mode */ + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM33); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject || fc == *eptr++) + RRETURN(MATCH_NOMATCH); + } + } + /* Control never gets here */ + } + + /* Maximize case */ + + else + { + pp = eptr; + +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + register unsigned int d; + COST(min); + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(d, eptr, len); + if (fc == d) break; + eptr += len; + } + if (possessive) continue; + for(;;) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM34); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (eptr-- == pp) break; /* Stop if tried at original pos */ + BACKCHAR(eptr); + } + } + else +#endif + /* Not UTF-8 mode */ + { + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || fc == *eptr) break; + eptr++; + COST_CHK(1); + } + if (possessive) continue; + while (eptr >= pp) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM35); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + eptr--; + } + } + + RRETURN(MATCH_NOMATCH); + } + } + /* Control never gets here */ + + /* Match a single character type repeatedly; several different opcodes + share code. This is very similar to the code for single characters, but we + repeat it in the interests of efficiency. */ + + case OP_TYPEEXACT: + min = max = GET2(ecode, 1); + minimize = TRUE; + ecode += 3; + goto REPEATTYPE; + + case OP_TYPEUPTO: + case OP_TYPEMINUPTO: + min = 0; + max = GET2(ecode, 1); + minimize = *ecode == OP_TYPEMINUPTO; + ecode += 3; + goto REPEATTYPE; + + case OP_TYPEPOSSTAR: + possessive = TRUE; + min = 0; + max = INT_MAX; + ecode++; + goto REPEATTYPE; + + case OP_TYPEPOSPLUS: + possessive = TRUE; + min = 1; + max = INT_MAX; + ecode++; + goto REPEATTYPE; + + case OP_TYPEPOSQUERY: + possessive = TRUE; + min = 0; + max = 1; + ecode++; + goto REPEATTYPE; + + case OP_TYPEPOSUPTO: + possessive = TRUE; + min = 0; + max = GET2(ecode, 1); + ecode += 3; + goto REPEATTYPE; + + case OP_TYPESTAR: + case OP_TYPEMINSTAR: + case OP_TYPEPLUS: + case OP_TYPEMINPLUS: + case OP_TYPEQUERY: + case OP_TYPEMINQUERY: + c = *ecode++ - OP_TYPESTAR; + minimize = (c & 1) != 0; + min = rep_min[c]; /* Pick up values from tables; */ + max = rep_max[c]; /* zero for max => infinity */ + if (max == 0) max = INT_MAX; + + /* Common code for all repeated single character type matches. Note that + in UTF-8 mode, '.' matches a character of any length, but for the other + character types, the valid characters are all one-byte long. */ + + REPEATTYPE: + ctype = *ecode++; /* Code for the character type */ + +#ifdef SUPPORT_UCP + if (ctype == OP_PROP || ctype == OP_NOTPROP) + { + prop_fail_result = ctype == OP_NOTPROP; + prop_type = *ecode++; + prop_value = *ecode++; + } + else prop_type = -1; +#endif + + /* First, ensure the minimum number of matches are present. Use inline + code for maximizing the speed, and do the type test once at the start + (i.e. keep it out of the loop). Also we can test that there are at least + the minimum number of bytes before we start. This isn't as effective in + UTF-8 mode, but it does no harm. Separate the UTF-8 code completely as that + is tidier. Also separate the UCP code, which can be the same for both UTF-8 + and single-bytes. */ + + if (min > md->end_subject - eptr) RRETURN(MATCH_NOMATCH); + if (min > 0) + { +#ifdef SUPPORT_UCP + if (prop_type >= 0) + { + COST(min); + switch(prop_type) + { + case PT_ANY: + if (prop_fail_result) RRETURN(MATCH_NOMATCH); + for (i = 1; i <= min; i++) /* PaN: OK (cost above) */ + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + } + break; + + case PT_LAMP: + for (i = 1; i <= min; i++) /* PaN: OK (cost above) */ + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_chartype == ucp_Lu || + prop_chartype == ucp_Ll || + prop_chartype == ucp_Lt) == prop_fail_result) + RRETURN(MATCH_NOMATCH); + } + break; + + case PT_GC: + for (i = 1; i <= min; i++) /* PaN: OK (cost above) */ + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_category == prop_value) == prop_fail_result) + RRETURN(MATCH_NOMATCH); + } + break; + + case PT_PC: + for (i = 1; i <= min; i++) /* PaN: OK (cost above) */ + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_chartype == prop_value) == prop_fail_result) + RRETURN(MATCH_NOMATCH); + } + break; + + case PT_SC: + for (i = 1; i <= min; i++) /* PaN: OK (cost above) */ + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_script == prop_value) == prop_fail_result) + RRETURN(MATCH_NOMATCH); + } + break; + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } + } + + /* Match extended Unicode sequences. We will get here only if the + support is in the binary; otherwise a compile-time error occurs. */ + + else if (ctype == OP_EXTUNI) + { + COST(min); + for (i = 1; i <= min; i++) + { + GETCHARINCTEST(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if (prop_category == ucp_M) RRETURN(MATCH_NOMATCH); + while (eptr < md->end_subject) + { + int len = 1; + if (!utf8) c = *eptr; else + { + GETCHARLEN(c, eptr, len); + } + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if (prop_category != ucp_M) break; + eptr += len; + COST_CHK(1); + } + } + } + + else +#endif /* SUPPORT_UCP */ + +/* Handle all other cases when the coding is UTF-8 */ + +#ifdef SUPPORT_UTF8 + if (utf8) switch(ctype) + { + case OP_ANY: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject || + ((ims & PCRE_DOTALL) == 0 && IS_NEWLINE(eptr))) + RRETURN(MATCH_NOMATCH); + eptr++; + while (eptr < md->end_subject && (*eptr & 0xc0) == 0x80) eptr++; + } + break; + + case OP_ANYBYTE: + eptr += min; + break; + + case OP_ANYNL: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x000d: + if (eptr < md->end_subject && *eptr == 0x0a) eptr++; + break; + + case 0x000a: + break; + + case 0x000b: + case 0x000c: + case 0x0085: + case 0x2028: + case 0x2029: + if (md->bsr_anycrlf) RRETURN(MATCH_NOMATCH); + break; + } + } + break; + + case OP_NOT_HSPACE: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + switch(c) + { + default: break; + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + RRETURN(MATCH_NOMATCH); + } + } + break; + + case OP_HSPACE: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + break; + } + } + break; + + case OP_NOT_VSPACE: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + switch(c) + { + default: break; + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + case 0x2028: /* LINE SEPARATOR */ + case 0x2029: /* PARAGRAPH SEPARATOR */ + RRETURN(MATCH_NOMATCH); + } + } + break; + + case OP_VSPACE: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + case 0x2028: /* LINE SEPARATOR */ + case 0x2029: /* PARAGRAPH SEPARATOR */ + break; + } + } + break; + + case OP_NOT_DIGIT: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + if (c < 128 && (md->ctypes[c] & ctype_digit) != 0) + RRETURN(MATCH_NOMATCH); + } + break; + + case OP_DIGIT: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject || + *eptr >= 128 || (md->ctypes[*eptr++] & ctype_digit) == 0) + RRETURN(MATCH_NOMATCH); + /* No need to skip more bytes - we know it's a 1-byte character */ + } + break; + + case OP_NOT_WHITESPACE: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject || + (*eptr < 128 && (md->ctypes[*eptr] & ctype_space) != 0)) + RRETURN(MATCH_NOMATCH); + while (++eptr < md->end_subject && (*eptr & 0xc0) == 0x80); /* PaN: Check */ + } + break; + + case OP_WHITESPACE: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject || + *eptr >= 128 || (md->ctypes[*eptr++] & ctype_space) == 0) + RRETURN(MATCH_NOMATCH); + /* No need to skip more bytes - we know it's a 1-byte character */ + } + break; + + case OP_NOT_WORDCHAR: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject || + (*eptr < 128 && (md->ctypes[*eptr] & ctype_word) != 0)) + RRETURN(MATCH_NOMATCH); + while (++eptr < md->end_subject && (*eptr & 0xc0) == 0x80); /* PaN: Check */ + } + break; + + case OP_WORDCHAR: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject || + *eptr >= 128 || (md->ctypes[*eptr++] & ctype_word) == 0) + RRETURN(MATCH_NOMATCH); + /* No need to skip more bytes - we know it's a 1-byte character */ + } + break; + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } /* End switch(ctype) */ + + else +#endif /* SUPPORT_UTF8 */ + + /* Code for the non-UTF-8 case for minimum matching of operators other + than OP_PROP and OP_NOTPROP. We can assume that there are the minimum + number of bytes present, as this was tested above. */ + + switch(ctype) + { + case OP_ANY: + if ((ims & PCRE_DOTALL) == 0) + { + COST(min); + for (i = 1; i <= min; i++) + { + if (IS_NEWLINE(eptr)) RRETURN(MATCH_NOMATCH); + eptr++; + } + } + else eptr += min; + break; + + case OP_ANYBYTE: + eptr += min; + break; + + /* Because of the CRLF case, we can't assume the minimum number of + bytes are present in this case. */ + + case OP_ANYNL: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + switch(*eptr++) + { + default: RRETURN(MATCH_NOMATCH); + case 0x000d: + if (eptr < md->end_subject && *eptr == 0x0a) eptr++; + break; + case 0x000a: + break; + + case 0x000b: + case 0x000c: + case 0x0085: + if (md->bsr_anycrlf) RRETURN(MATCH_NOMATCH); + break; + } + } + break; + + case OP_NOT_HSPACE: + COST(min); + for (i = 1; i <= min; i++) /* PaN: Check */ + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + switch(*eptr++) + { + default: break; + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + RRETURN(MATCH_NOMATCH); + } + } + break; + + case OP_HSPACE: + COST(min); + for (i = 1; i <= min; i++) /* PaN: Check */ + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + switch(*eptr++) + { + default: RRETURN(MATCH_NOMATCH); + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + break; + } + } + break; + + case OP_NOT_VSPACE: + COST(min); + for (i = 1; i <= min; i++) /* PaN: Check */ + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + switch(*eptr++) + { + default: break; + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + RRETURN(MATCH_NOMATCH); + } + } + break; + + case OP_VSPACE: + COST(min); + for (i = 1; i <= min; i++) + { + if (eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + switch(*eptr++) + { + default: RRETURN(MATCH_NOMATCH); + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + break; + } + } + break; + + case OP_NOT_DIGIT: + COST(min); + for (i = 1; i <= min; i++) + if ((md->ctypes[*eptr++] & ctype_digit) != 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_DIGIT: + COST(min); + for (i = 1; i <= min; i++) + if ((md->ctypes[*eptr++] & ctype_digit) == 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_NOT_WHITESPACE: + COST(min); + for (i = 1; i <= min; i++) + if ((md->ctypes[*eptr++] & ctype_space) != 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_WHITESPACE: + COST(min); + for (i = 1; i <= min; i++) + if ((md->ctypes[*eptr++] & ctype_space) == 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_NOT_WORDCHAR: + COST(min); + for (i = 1; i <= min; i++) + if ((md->ctypes[*eptr++] & ctype_word) != 0) + RRETURN(MATCH_NOMATCH); + break; + + case OP_WORDCHAR: + COST(min); + for (i = 1; i <= min; i++) + if ((md->ctypes[*eptr++] & ctype_word) == 0) + RRETURN(MATCH_NOMATCH); + break; + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } + } + + /* If min = max, continue at the same level without recursing */ + + if (min == max) continue; + + /* If minimizing, we have to test the rest of the pattern before each + subsequent match. Again, separate the UTF-8 case for speed, and also + separate the UCP cases. */ + + if (minimize) + { +#ifdef SUPPORT_UCP + if (prop_type >= 0) + { + switch(prop_type) + { + case PT_ANY: + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM36); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + if (prop_fail_result) RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + + case PT_LAMP: + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM37); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_chartype == ucp_Lu || + prop_chartype == ucp_Ll || + prop_chartype == ucp_Lt) == prop_fail_result) + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + + case PT_GC: + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM38); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_category == prop_value) == prop_fail_result) + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + + case PT_PC: + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM39); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_chartype == prop_value) == prop_fail_result) + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + + case PT_SC: + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM40); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINC(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_script == prop_value) == prop_fail_result) + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } + } + + /* Match extended Unicode sequences. We will get here only if the + support is in the binary; otherwise a compile-time error occurs. */ + + else if (ctype == OP_EXTUNI) + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM41); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject) RRETURN(MATCH_NOMATCH); + GETCHARINCTEST(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if (prop_category == ucp_M) RRETURN(MATCH_NOMATCH); + while (eptr < md->end_subject) /* PaN: Check */ + { + int len = 1; + if (!utf8) c = *eptr; else + { + GETCHARLEN(c, eptr, len); + } + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if (prop_category != ucp_M) break; + eptr += len; + } + } + } + + else +#endif /* SUPPORT_UCP */ + +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + if (utf8) + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM42); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject || + (ctype == OP_ANY && (ims & PCRE_DOTALL) == 0 && + IS_NEWLINE(eptr))) + RRETURN(MATCH_NOMATCH); + + GETCHARINC(c, eptr); + switch(ctype) + { + case OP_ANY: /* This is the DOTALL case */ + break; + + case OP_ANYBYTE: + break; + + case OP_ANYNL: + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x000d: + if (eptr < md->end_subject && *eptr == 0x0a) eptr++; + break; + case 0x000a: + break; + + case 0x000b: + case 0x000c: + case 0x0085: + case 0x2028: + case 0x2029: + if (md->bsr_anycrlf) RRETURN(MATCH_NOMATCH); + break; + } + break; + + case OP_NOT_HSPACE: + switch(c) + { + default: break; + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + RRETURN(MATCH_NOMATCH); + } + break; + + case OP_HSPACE: + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + break; + } + break; + + case OP_NOT_VSPACE: + switch(c) + { + default: break; + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + case 0x2028: /* LINE SEPARATOR */ + case 0x2029: /* PARAGRAPH SEPARATOR */ + RRETURN(MATCH_NOMATCH); + } + break; + + case OP_VSPACE: + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + case 0x2028: /* LINE SEPARATOR */ + case 0x2029: /* PARAGRAPH SEPARATOR */ + break; + } + break; + + case OP_NOT_DIGIT: + if (c < 256 && (md->ctypes[c] & ctype_digit) != 0) + RRETURN(MATCH_NOMATCH); + break; + + case OP_DIGIT: + if (c >= 256 || (md->ctypes[c] & ctype_digit) == 0) + RRETURN(MATCH_NOMATCH); + break; + + case OP_NOT_WHITESPACE: + if (c < 256 && (md->ctypes[c] & ctype_space) != 0) + RRETURN(MATCH_NOMATCH); + break; + + case OP_WHITESPACE: + if (c >= 256 || (md->ctypes[c] & ctype_space) == 0) + RRETURN(MATCH_NOMATCH); + break; + + case OP_NOT_WORDCHAR: + if (c < 256 && (md->ctypes[c] & ctype_word) != 0) + RRETURN(MATCH_NOMATCH); + break; + + case OP_WORDCHAR: + if (c >= 256 || (md->ctypes[c] & ctype_word) == 0) + RRETURN(MATCH_NOMATCH); + break; + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } + } + } + else +#endif + /* Not UTF-8 mode */ + { + for (fi = min;; fi++) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM43); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (fi >= max || eptr >= md->end_subject || + ((ims & PCRE_DOTALL) == 0 && IS_NEWLINE(eptr))) + RRETURN(MATCH_NOMATCH); + + c = *eptr++; + switch(ctype) + { + case OP_ANY: /* This is the DOTALL case */ + break; + + case OP_ANYBYTE: + break; + + case OP_ANYNL: + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x000d: + if (eptr < md->end_subject && *eptr == 0x0a) eptr++; + break; + + case 0x000a: + break; + + case 0x000b: + case 0x000c: + case 0x0085: + if (md->bsr_anycrlf) RRETURN(MATCH_NOMATCH); + break; + } + break; + + case OP_NOT_HSPACE: + switch(c) + { + default: break; + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + RRETURN(MATCH_NOMATCH); + } + break; + + case OP_HSPACE: + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + break; + } + break; + + case OP_NOT_VSPACE: + switch(c) + { + default: break; + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + RRETURN(MATCH_NOMATCH); + } + break; + + case OP_VSPACE: + switch(c) + { + default: RRETURN(MATCH_NOMATCH); + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + break; + } + break; + + case OP_NOT_DIGIT: + if ((md->ctypes[c] & ctype_digit) != 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_DIGIT: + if ((md->ctypes[c] & ctype_digit) == 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_NOT_WHITESPACE: + if ((md->ctypes[c] & ctype_space) != 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_WHITESPACE: + if ((md->ctypes[c] & ctype_space) == 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_NOT_WORDCHAR: + if ((md->ctypes[c] & ctype_word) != 0) RRETURN(MATCH_NOMATCH); + break; + + case OP_WORDCHAR: + if ((md->ctypes[c] & ctype_word) == 0) RRETURN(MATCH_NOMATCH); + break; + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } + } + } + /* Control never gets here */ + } + + /* If maximizing, it is worth using inline code for speed, doing the type + test once at the start (i.e. keep it out of the loop). Again, keep the + UTF-8 and UCP stuff separate. */ + + else + { + pp = eptr; /* Remember where we started */ + +#ifdef SUPPORT_UCP + if (prop_type >= 0) + { + switch(prop_type) + { + case PT_ANY: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (prop_fail_result) break; + eptr+= len; + COST_CHK(1); + } + break; + + case PT_LAMP: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_chartype == ucp_Lu || + prop_chartype == ucp_Ll || + prop_chartype == ucp_Lt) == prop_fail_result) + break; + eptr+= len; + COST_CHK(1); + } + break; + + case PT_GC: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_category == prop_value) == prop_fail_result) + break; + eptr+= len; + COST_CHK(1); + } + break; + + case PT_PC: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_chartype == prop_value) == prop_fail_result) + break; + eptr+= len; + COST_CHK(1); + } + break; + + case PT_SC: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if ((prop_script == prop_value) == prop_fail_result) + break; + eptr+= len; + COST_CHK(1); + } + break; + } + + /* eptr is now past the end of the maximum run */ + + if (possessive) continue; + for(;;) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM44); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (eptr-- == pp) break; /* Stop if tried at original pos */ + if (utf8) BACKCHAR(eptr); + } + } + + /* Match extended Unicode sequences. We will get here only if the + support is in the binary; otherwise a compile-time error occurs. */ + + else if (ctype == OP_EXTUNI) + { + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject) break; + GETCHARINCTEST(c, eptr); + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if (prop_category == ucp_M) break; + while (eptr < md->end_subject) + { + int len = 1; + if (!utf8) c = *eptr; else + { + GETCHARLEN(c, eptr, len); + } + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if (prop_category != ucp_M) break; + eptr += len; + COST_CHK(1); + } + COST_CHK(1); + } + + /* eptr is now past the end of the maximum run */ + + if (possessive) continue; + for(;;) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM45); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (eptr-- == pp) break; /* Stop if tried at original pos */ + for (;;) /* Move back over one extended */ /* PaN: Check */ + { + int len = 1; + if (!utf8) c = *eptr; else + { + BACKCHAR(eptr); + GETCHARLEN(c, eptr, len); + } + prop_category = _erts_pcre_ucp_findprop(c, &prop_chartype, &prop_script); + if (prop_category != ucp_M) break; + eptr--; + } + } + } + + else +#endif /* SUPPORT_UCP */ + +#ifdef SUPPORT_UTF8 + /* UTF-8 mode */ + + if (utf8) + { + switch(ctype) + { + case OP_ANY: + if (max < INT_MAX) + { + if ((ims & PCRE_DOTALL) == 0) + { + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || IS_NEWLINE(eptr)) break; + eptr++; + while (eptr < md->end_subject && (*eptr & 0xc0) == 0x80) eptr++; + COST_CHK(1); + } + } + else + { + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject) break; + eptr++; + while (eptr < md->end_subject && (*eptr & 0xc0) == 0x80) eptr++; /* PaN: Check */ + COST_CHK(1); + } + } + } + + /* Handle unlimited UTF-8 repeat */ + + else + { + if ((ims & PCRE_DOTALL) == 0) + { + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || IS_NEWLINE(eptr)) break; + eptr++; + while (eptr < md->end_subject && (*eptr & 0xc0) == 0x80) eptr++; + COST_CHK(1); + } + } + else + { + eptr = md->end_subject; + } + } + break; + + /* The byte case is the same as non-UTF8 */ + + case OP_ANYBYTE: + c = max - min; + if (c > (unsigned int)(md->end_subject - eptr)) + c = md->end_subject - eptr; + eptr += c; + break; + + case OP_ANYNL: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (c == 0x000d) + { + if (++eptr >= md->end_subject) break; + if (*eptr == 0x000a) eptr++; + } + else + { + if (c != 0x000a && + (md->bsr_anycrlf || + (c != 0x000b && c != 0x000c && + c != 0x0085 && c != 0x2028 && c != 0x2029))) + break; + eptr += len; + } + COST_CHK(1); + } + break; + + case OP_NOT_HSPACE: + case OP_HSPACE: + for (i = min; i < max; i++) + { + BOOL gotspace; + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + switch(c) + { + default: gotspace = FALSE; break; + case 0x09: /* HT */ + case 0x20: /* SPACE */ + case 0xa0: /* NBSP */ + case 0x1680: /* OGHAM SPACE MARK */ + case 0x180e: /* MONGOLIAN VOWEL SEPARATOR */ + case 0x2000: /* EN QUAD */ + case 0x2001: /* EM QUAD */ + case 0x2002: /* EN SPACE */ + case 0x2003: /* EM SPACE */ + case 0x2004: /* THREE-PER-EM SPACE */ + case 0x2005: /* FOUR-PER-EM SPACE */ + case 0x2006: /* SIX-PER-EM SPACE */ + case 0x2007: /* FIGURE SPACE */ + case 0x2008: /* PUNCTUATION SPACE */ + case 0x2009: /* THIN SPACE */ + case 0x200A: /* HAIR SPACE */ + case 0x202f: /* NARROW NO-BREAK SPACE */ + case 0x205f: /* MEDIUM MATHEMATICAL SPACE */ + case 0x3000: /* IDEOGRAPHIC SPACE */ + gotspace = TRUE; + break; + } + if (gotspace == (ctype == OP_NOT_HSPACE)) break; + eptr += len; + COST_CHK(1); + } + break; + + case OP_NOT_VSPACE: + case OP_VSPACE: + for (i = min; i < max; i++) + { + BOOL gotspace; + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + switch(c) + { + default: gotspace = FALSE; break; + case 0x0a: /* LF */ + case 0x0b: /* VT */ + case 0x0c: /* FF */ + case 0x0d: /* CR */ + case 0x85: /* NEL */ + case 0x2028: /* LINE SEPARATOR */ + case 0x2029: /* PARAGRAPH SEPARATOR */ + gotspace = TRUE; + break; + } + if (gotspace == (ctype == OP_NOT_VSPACE)) break; + eptr += len; + COST_CHK(1); + } + break; + + case OP_NOT_DIGIT: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (c < 256 && (md->ctypes[c] & ctype_digit) != 0) break; + eptr+= len; + COST_CHK(1); + } + break; + + case OP_DIGIT: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (c >= 256 ||(md->ctypes[c] & ctype_digit) == 0) break; + eptr+= len; + COST_CHK(1); + } + break; + + case OP_NOT_WHITESPACE: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (c < 256 && (md->ctypes[c] & ctype_space) != 0) break; + eptr+= len; + COST_CHK(1); + } + break; + + case OP_WHITESPACE: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (c >= 256 ||(md->ctypes[c] & ctype_space) == 0) break; + eptr+= len; + COST_CHK(1); + } + break; + + case OP_NOT_WORDCHAR: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (c < 256 && (md->ctypes[c] & ctype_word) != 0) break; + eptr+= len; + COST_CHK(1); + } + break; + + case OP_WORDCHAR: + for (i = min; i < max; i++) + { + int len = 1; + if (eptr >= md->end_subject) break; + GETCHARLEN(c, eptr, len); + if (c >= 256 || (md->ctypes[c] & ctype_word) == 0) break; + eptr+= len; + COST_CHK(1); + } + break; + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } + + /* eptr is now past the end of the maximum run */ + + if (possessive) continue; + for(;;) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM46); + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + if (eptr-- == pp) break; /* Stop if tried at original pos */ + BACKCHAR(eptr); + } + } + else +#endif /* SUPPORT_UTF8 */ + + /* Not UTF-8 mode */ + { + switch(ctype) + { + case OP_ANY: + if ((ims & PCRE_DOTALL) == 0) + { + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || IS_NEWLINE(eptr)) break; + eptr++; + COST_CHK(1); + } + break; + } + /* For DOTALL case, fall through and treat as \C */ + + case OP_ANYBYTE: + c = max - min; + if (c > (unsigned int)(md->end_subject - eptr)) + c = md->end_subject - eptr; + eptr += c; + break; + + case OP_ANYNL: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject) break; + c = *eptr; + if (c == 0x000d) + { + if (++eptr >= md->end_subject) break; + if (*eptr == 0x000a) eptr++; + } + else + { + if (c != 0x000a && + (md->bsr_anycrlf || + (c != 0x000b && c != 0x000c && c != 0x0085))) + break; + eptr++; + } + COST_CHK(1); + } + break; + + case OP_NOT_HSPACE: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject) break; + c = *eptr; + if (c == 0x09 || c == 0x20 || c == 0xa0) break; + eptr++; + COST_CHK(1); + } + break; + + case OP_HSPACE: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject) break; + c = *eptr; + if (c != 0x09 && c != 0x20 && c != 0xa0) break; + eptr++; + COST_CHK(1); + } + break; + + case OP_NOT_VSPACE: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject) break; + c = *eptr; + if (c == 0x0a || c == 0x0b || c == 0x0c || c == 0x0d || c == 0x85) + break; + eptr++; + COST_CHK(1); + } + break; + + case OP_VSPACE: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject) break; + c = *eptr; + if (c != 0x0a && c != 0x0b && c != 0x0c && c != 0x0d && c != 0x85) + break; + eptr++; + COST_CHK(1); + } + break; + + case OP_NOT_DIGIT: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || (md->ctypes[*eptr] & ctype_digit) != 0) + break; + eptr++; + COST_CHK(1); + } + break; + + case OP_DIGIT: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || (md->ctypes[*eptr] & ctype_digit) == 0) + break; + eptr++; + COST_CHK(1); + } + break; + + case OP_NOT_WHITESPACE: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || (md->ctypes[*eptr] & ctype_space) != 0) + break; + eptr++; + COST_CHK(1); + } + break; + + case OP_WHITESPACE: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || (md->ctypes[*eptr] & ctype_space) == 0) + break; + eptr++; + COST_CHK(1); + } + break; + + case OP_NOT_WORDCHAR: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || (md->ctypes[*eptr] & ctype_word) != 0) + break; + eptr++; + COST_CHK(1); + } + break; + + case OP_WORDCHAR: + for (i = min; i < max; i++) + { + if (eptr >= md->end_subject || (md->ctypes[*eptr] & ctype_word) == 0) + break; + eptr++; + COST_CHK(1); + } + break; + + default: + RRETURN(PCRE_ERROR_INTERNAL); + } + + /* eptr is now past the end of the maximum run */ + + if (possessive) continue; + while (eptr >= pp) /* PaN: OK */ + { + RMATCH(eptr, ecode, offset_top, md, ims, eptrb, 0, RM47); + eptr--; + if (rrc != MATCH_NOMATCH) RRETURN(rrc); + } + } + + /* Get here if we can't make it match with any permitted repetitions */ + + RRETURN(MATCH_NOMATCH); + } + /* Control never gets here */ + + /* There's been some horrible disaster. Arrival here can only mean there is + something seriously wrong in the code above or the OP_xxx definitions. */ + + default: + DPRINTF(("Unknown opcode %d\n", *ecode)); + RRETURN(PCRE_ERROR_UNKNOWN_OPCODE); + } + + /* Do not stick any code in here without much thought; it is assumed + that "continue" in the code above comes out to here to repeat the main + loop. */ + + } /* End of main loop */ +/* Control never reaches here */ + + +/* When compiling to use the heap rather than the stack for recursive calls to +match(), the RRETURN() macro jumps here. The number that is saved in +frame->Xwhere indicates which label we actually want to return to. */ + +#ifdef NO_RECURSE +#define LBL(val) case val: goto L_RM##val; +HEAP_RETURN: +switch (frame->Xwhere) + { + LBL( 1) LBL( 2) LBL( 3) LBL( 4) LBL( 5) LBL( 6) LBL( 7) LBL( 8) + LBL( 9) LBL(10) LBL(11) LBL(12) LBL(13) LBL(14) LBL(15) LBL(17) + LBL(19) LBL(24) LBL(25) LBL(26) LBL(27) LBL(29) LBL(31) LBL(33) + LBL(35) LBL(43) LBL(47) LBL(48) LBL(49) LBL(50) LBL(51) LBL(52) + LBL(53) LBL(54) +#ifdef SUPPORT_UTF8 + LBL(16) LBL(18) LBL(20) LBL(21) LBL(22) LBL(23) LBL(28) LBL(30) + LBL(32) LBL(34) LBL(42) LBL(46) +#ifdef SUPPORT_UCP + LBL(36) LBL(37) LBL(38) LBL(39) LBL(40) LBL(41) LBL(44) LBL(45) +#endif /* SUPPORT_UCP */ +#endif /* SUPPORT_UTF8 */ + default: + DPRINTF(("jump error in pcre match: label %d non-existent\n", frame->Xwhere)); + return PCRE_ERROR_INTERNAL; + } +#undef LBL + + +#ifdef ERLANG_INTEGRATION +LOOP_COUNT_RETURN: + /* Restore the saved register variables in the upper dummy frame, description below */ + { + heapframe *newframe = frame; + frame = newframe->Xprevframe; + rrc = newframe->Xop; + i = newframe->Xfi; + c = newframe->Xfc; + utf8 = newframe->Xcur_is_word; + minimize = newframe->Xcondition; + possessive = newframe->Xprev_is_word; + (erts_pcre_stack_free)(newframe); + EDEBUGF(("LOOP_COUNT_RETURN: %d",frame->Xwhere)); + switch (frame->Xwhere) + { +#include "pcre_exec_loop_break_cases.inc" + default: + DPRINTF(("jump error in pcre match: label %d non-existent\n", frame->Xwhere)); + return PCRE_ERROR_INTERNAL; + } + } + +LOOP_COUNT_BREAK: + /* Save the local register variables in a dummy frame, to keep the + * every frame of equal size rule */ + /* + * Store Local in + * ------------------------------ -------------- + * rrc Xop + * i Xfi + * c Xfc + * utf8 Xcur_is_word + * minimize Xcondition + * possessive Xprev_is_word + */ + { + heapframe *newframe = (erts_pcre_stack_malloc)(sizeof(heapframe)); + newframe->Xprevframe = frame; + newframe->Xop = rrc; + newframe->Xfi = i; + newframe->Xfc = c; + newframe->Xcur_is_word = utf8; + newframe->Xcondition = minimize; + newframe->Xprev_is_word = possessive; + md->state_save = newframe; + md->loop_limit = 0; + EDEBUGF(("Break loop!")); + return PCRE_ERROR_LOOP_LIMIT; + } +#endif + +#endif /* NO_RECURSE */ +} + +#ifdef ERLANG_INTEGRATION +static void free_saved_match_state(heapframe *top) { + while (top != NULL) { + heapframe *nxt = top->Xprevframe; + (erts_pcre_stack_free)(top); + top = nxt; + } +} +#endif + + +/*************************************************************************** +**************************************************************************** + RECURSION IN THE match() FUNCTION + +Undefine all the macros that were defined above to handle this. */ + +#ifdef NO_RECURSE +#undef eptr +#undef ecode +#undef mstart +#undef offset_top +#undef ims +#undef eptrb +#undef flags + +#undef callpat +#undef charptr +#undef data +#undef next +#undef pp +#undef prev +#undef saved_eptr + +#undef new_recursive + +#undef cur_is_word +#undef condition +#undef prev_is_word + +#undef original_ims + +#undef ctype +#undef length +#undef max +#undef min +#undef number +#undef offset +#undef op +#undef save_capture_last +#undef save_offset1 +#undef save_offset2 +#undef save_offset3 +#undef stacksave + +#undef newptrb + +#endif + +/* These two are defined as macros in both cases */ + +#undef fc +#undef fi + +/*************************************************************************** +***************************************************************************/ + + + +/************************************************* +* Execute a Regular Expression * +*************************************************/ + +/* This function applies a compiled re to a subject string and picks out +portions of the string if it matches. Two elements in the vector are set for +each substring: the offsets to the start and end of the substring. + +Arguments: + argument_re points to the compiled expression + extra_data points to extra data or is NULL + subject points to the subject string + length length of subject string (may contain binary zeros) + start_offset where to start in the subject string + options option bits + offsets points to a vector of ints to be filled in with offsets + offsetcount the number of elements in the vector + +Returns: > 0 => success; value is the number of elements filled in + = 0 => success, but offsets is not big enough + -1 => failed to match + < -1 => some kind of unexpected problem +*/ +#ifdef ERLANG_INTEGRATION +typedef struct { + int Xresetcount; + int Xfirst_byte; + BOOL Xfirst_byte_caseless; + int Xreq_byte; + int Xreq_byte2; + unsigned long int Xims; + BOOL Xreq_byte_caseless; + BOOL Xusing_temporary_offsets; + BOOL Xanchored; + BOOL Xstartline; + BOOL Xfirstline; + BOOL Xutf8; + match_data Xmatch_block; + match_data *Xmd; + const uschar *Xtables; /* may point to extra_data->tables, so the tables cannot be relocated + between restarts */ + const uschar *Xstart_bits; /* Points into study, so if studies are used, *they* + cannot be relocated between restarts */ + /* The following points into the subject, so the sublect needs to stay put too */ + USPTR Xstart_match; + USPTR Xend_subject; + USPTR Xreq_byte_ptr; + /* We'll handle internal studies and re's although this will not happen + in the erlang emulator in current implementation */ + pcre_study_data Xinternal_study; + const pcre_study_data *Xstudy; + + real_pcre Xinternal_re; + const real_pcre *Xexternal_re; + const real_pcre *Xre; + /* Original function parameters that need be saved */ + int Xstart_offset; + int Xoffsetcount; + int *Xoffsets; +} PcreExecContext; +#endif + +PCRE_EXP_DEFN int +erts_pcre_exec(const pcre *argument_re, const pcre_extra *extra_data, + PCRE_SPTR subject, int length, int start_offset, int options, int *offsets, + int offsetcount) +{ +#ifndef ERLANG_INTEGRATION +int rc, resetcount, ocount; +int first_byte = -1; +int req_byte = -1; +int req_byte2 = -1; +int newline; +unsigned long int ims; +BOOL using_temporary_offsets = FALSE; +BOOL anchored; +BOOL startline; +BOOL firstline; +BOOL first_byte_caseless = FALSE; +BOOL req_byte_caseless = FALSE; +BOOL utf8; +match_data match_block; +match_data *md = &match_block; +const uschar *tables; +const uschar *start_bits = NULL; +USPTR start_match = (USPTR)subject + start_offset; +USPTR end_subject; +USPTR req_byte_ptr = start_match - 1; + +pcre_study_data internal_study; +const pcre_study_data *study; + +real_pcre internal_re; +const real_pcre *external_re = (const real_pcre *)argument_re; +const real_pcre *re = external_re; + +#else + +/* "local" variables in faked stackframe instead */ +#define resetcount (exec_context->Xresetcount) +#define req_byte2 (exec_context->Xreq_byte2) +#define using_temporary_offsets (exec_context->Xusing_temporary_offsets) +#define anchored (exec_context->Xanchored) +#define startline (exec_context->Xstartline) +#define firstline (exec_context->Xfirstline) +#define first_byte_caseless (exec_context->Xfirst_byte_caseless) +#define req_byte_caseless (exec_context->Xreq_byte_caseless) +#define match_block (exec_context->Xmatch_block) +#define md (exec_context->Xmd) +#define start_match (exec_context->Xstart_match) +#define req_byte_ptr (exec_context->Xreq_byte_ptr) +#define internal_study (exec_context->Xinternal_study) +#define study (exec_context->Xstudy) +#define internal_re (exec_context->Xinternal_re) +#define external_re (exec_context->Xexternal_re) +#define re (exec_context->Xre) +#define ims (exec_context->Xims) + +#define SWAPIN() do { \ + utf8 = exec_context->Xutf8; \ + first_byte = exec_context->Xfirst_byte; \ + tables = exec_context->Xtables; \ + start_bits = exec_context->Xstart_bits; \ + end_subject = exec_context->Xend_subject; \ + req_byte = exec_context->Xreq_byte; \ + start_offset = exec_context->Xstart_offset; \ + offsetcount = exec_context->Xoffsetcount; \ + offsets = exec_context->Xoffsets; \ +} while (0) + +#define SWAPOUT() do { \ + exec_context->Xutf8 = utf8; \ + exec_context->Xfirst_byte = first_byte; \ + exec_context->Xtables = tables; \ + exec_context->Xstart_bits = start_bits; \ + exec_context->Xend_subject = end_subject; \ + exec_context->Xreq_byte = req_byte; \ + exec_context->Xstart_offset = start_offset; \ + exec_context->Xoffsetcount = offsetcount; \ + exec_context->Xoffsets = offsets; \ +} while (0) + +PcreExecContext *exec_context; +PcreExecContext internal_context; + +int rc, ocount; +int newline; + +/* special variables follow, swapped in and out */ +BOOL utf8; +int first_byte; +const uschar *tables; +const uschar *start_bits; +USPTR end_subject; +int req_byte; +/* End special swapped variables */ + + if (extra_data != NULL && + (extra_data->flags & PCRE_EXTRA_LOOP_LIMIT) && + *(extra_data->restart_data) != NULL) { + /* we are restarting, every initialization is skipped and we jump directly into the loop */ + exec_context = (PcreExecContext *) *(extra_data->restart_data); + SWAPIN(); + goto RESTART_INTERRUPTED; + } else { + if (extra_data != NULL && + (extra_data->flags & PCRE_EXTRA_LOOP_LIMIT)) { + exec_context = (PcreExecContext *) (erts_pcre_malloc)(sizeof(PcreExecContext)); + *(extra_data->restart_data) = (void *) exec_context; + /* need freeing by special routine from client */ + } else { + exec_context = &internal_context; + } + + /* OK, no restart here, initialize variables instead */ + first_byte = -1; + req_byte = -1; + req_byte2 = -1; + using_temporary_offsets = FALSE; + first_byte_caseless = FALSE; + req_byte_caseless = FALSE; + md = &match_block; + start_bits = NULL; + start_match = (USPTR)subject + start_offset; + req_byte_ptr = start_match - 1; + external_re = (const real_pcre *)argument_re; + re = external_re; + + md->state_save = NULL; + +} + +#endif /* ERLANG_INTEGRATION */ + + +/* Plausibility checks */ + +if ((options & ~PUBLIC_EXEC_OPTIONS) != 0) return PCRE_ERROR_BADOPTION; +if (re == NULL || subject == NULL || + (offsets == NULL && offsetcount > 0)) return PCRE_ERROR_NULL; +if (offsetcount < 0) return PCRE_ERROR_BADCOUNT; + +/* Fish out the optional data from the extra_data structure, first setting +the default values. */ + +study = NULL; +md->match_limit = MATCH_LIMIT; +md->match_limit_recursion = MATCH_LIMIT_RECURSION; +md->callout_data = NULL; + +/* The table pointer is always in native byte order. */ + +tables = external_re->tables; + +if (extra_data != NULL) + { + register unsigned int flags = extra_data->flags; + if ((flags & PCRE_EXTRA_STUDY_DATA) != 0) + study = (const pcre_study_data *)extra_data->study_data; + if ((flags & PCRE_EXTRA_MATCH_LIMIT) != 0) + md->match_limit = extra_data->match_limit; + if ((flags & PCRE_EXTRA_MATCH_LIMIT_RECURSION) != 0) + md->match_limit_recursion = extra_data->match_limit_recursion; + if ((flags & PCRE_EXTRA_CALLOUT_DATA) != 0) + md->callout_data = extra_data->callout_data; + if ((flags & PCRE_EXTRA_TABLES) != 0) tables = extra_data->tables; +#ifdef ERLANG_INTEGRATION + if ((flags & PCRE_EXTRA_LOOP_LIMIT) != 0) + { + md->loop_limit = extra_data->loop_limit; + } +#endif + } + +/* If the exec call supplied NULL for tables, use the inbuilt ones. This +is a feature that makes it possible to save compiled regex and re-use them +in other programs later. */ + +if (tables == NULL) tables = _erts_pcre_default_tables; + +/* Check that the first field in the block is the magic number. If it is not, +test for a regex that was compiled on a host of opposite endianness. If this is +the case, flipped values are put in internal_re and internal_study if there was +study data too. */ + +if (re->magic_number != MAGIC_NUMBER) + { + re = _erts_pcre_try_flipped(re, &internal_re, study, &internal_study); + if (re == NULL) return PCRE_ERROR_BADMAGIC; + if (study != NULL) study = &internal_study; + } + +/* Set up other data */ + +anchored = ((re->options | options) & PCRE_ANCHORED) != 0; +startline = (re->flags & PCRE_STARTLINE) != 0; +firstline = (re->options & PCRE_FIRSTLINE) != 0; + +/* The code starts after the real_pcre block and the capture name table. */ + +md->start_code = (const uschar *)external_re + re->name_table_offset + + re->name_count * re->name_entry_size; + +md->start_subject = (USPTR)subject; +md->start_offset = start_offset; +md->end_subject = md->start_subject + length; +end_subject = md->end_subject; + +md->endonly = (re->options & PCRE_DOLLAR_ENDONLY) != 0; +utf8 = md->utf8 = (re->options & PCRE_UTF8) != 0; + +md->notbol = (options & PCRE_NOTBOL) != 0; +md->noteol = (options & PCRE_NOTEOL) != 0; +md->notempty = (options & PCRE_NOTEMPTY) != 0; +md->partial = (options & PCRE_PARTIAL) != 0; +md->hitend = FALSE; + +md->recursive = NULL; /* No recursion at top level */ + +md->lcc = tables + lcc_offset; +md->ctypes = tables + ctypes_offset; + +/* Handle different \R options. */ + +switch (options & (PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE)) + { + case 0: + if ((re->options & (PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE)) != 0) + md->bsr_anycrlf = (re->options & PCRE_BSR_ANYCRLF) != 0; + else +#ifdef BSR_ANYCRLF + md->bsr_anycrlf = TRUE; +#else + md->bsr_anycrlf = FALSE; +#endif + break; + + case PCRE_BSR_ANYCRLF: + md->bsr_anycrlf = TRUE; + break; + + case PCRE_BSR_UNICODE: + md->bsr_anycrlf = FALSE; + break; + + default: return PCRE_ERROR_BADNEWLINE; + } + +/* Handle different types of newline. The three bits give eight cases. If +nothing is set at run time, whatever was used at compile time applies. */ + +switch ((((options & PCRE_NEWLINE_BITS) == 0)? re->options : + (pcre_uint32)options) & PCRE_NEWLINE_BITS) + { + case 0: newline = NEWLINE; break; /* Compile-time default */ + case PCRE_NEWLINE_CR: newline = '\r'; break; + case PCRE_NEWLINE_LF: newline = '\n'; break; + case PCRE_NEWLINE_CR+ + PCRE_NEWLINE_LF: newline = ('\r' << 8) | '\n'; break; + case PCRE_NEWLINE_ANY: newline = -1; break; + case PCRE_NEWLINE_ANYCRLF: newline = -2; break; + default: return PCRE_ERROR_BADNEWLINE; + } + +if (newline == -2) + { + md->nltype = NLTYPE_ANYCRLF; + } +else if (newline < 0) + { + md->nltype = NLTYPE_ANY; + } +else + { + md->nltype = NLTYPE_FIXED; + if (newline > 255) + { + md->nllen = 2; + md->nl[0] = (newline >> 8) & 255; + md->nl[1] = newline & 255; + } + else + { + md->nllen = 1; + md->nl[0] = newline; + } + } + +/* Partial matching is supported only for a restricted set of regexes at the +moment. */ + +if (md->partial && (re->flags & PCRE_NOPARTIAL) != 0) + return PCRE_ERROR_BADPARTIAL; + +/* Check a UTF-8 string if required. Unfortunately there's no way of passing +back the character offset. */ + +#ifdef SUPPORT_UTF8 +if (utf8 && (options & PCRE_NO_UTF8_CHECK) == 0) + { + if (_erts_pcre_valid_utf8((uschar *)subject, length) >= 0) + return PCRE_ERROR_BADUTF8; + if (start_offset > 0 && start_offset < length) + { + int tb = ((uschar *)subject)[start_offset]; + if (tb > 127) + { + tb &= 0xc0; + if (tb != 0 && tb != 0xc0) return PCRE_ERROR_BADUTF8_OFFSET; + } + } + } +#endif + +/* The ims options can vary during the matching as a result of the presence +of (?ims) items in the pattern. They are kept in a local variable so that +restoring at the exit of a group is easy. */ + +ims = re->options & (PCRE_CASELESS|PCRE_MULTILINE|PCRE_DOTALL); + +/* If the expression has got more back references than the offsets supplied can +hold, we get a temporary chunk of working store to use during the matching. +Otherwise, we can use the vector supplied, rounding down its size to a multiple +of 3. */ + +ocount = offsetcount - (offsetcount % 3); + +if (re->top_backref > 0 && re->top_backref >= ocount/3) + { + ocount = re->top_backref * 3 + 3; + md->offset_vector = (int *)(erts_pcre_malloc)(ocount * sizeof(int)); + if (md->offset_vector == NULL) return PCRE_ERROR_NOMEMORY; + using_temporary_offsets = TRUE; + DPRINTF(("Got memory to hold back references\n")); + } +else md->offset_vector = offsets; + +md->offset_end = ocount; +md->offset_max = (2*ocount)/3; +md->offset_overflow = FALSE; +md->capture_last = -1; + +/* Compute the minimum number of offsets that we need to reset each time. Doing +this makes a huge difference to execution time when there aren't many brackets +in the pattern. */ + +resetcount = 2 + re->top_bracket * 2; +if (resetcount > offsetcount) resetcount = ocount; + +/* Reset the working variable associated with each extraction. These should +never be used unless previously set, but they get saved and restored, and so we +initialize them to avoid reading uninitialized locations. */ + +if (md->offset_vector != NULL) + { + register int *iptr = md->offset_vector + ocount; + register int *iend = iptr - resetcount/2 + 1; + while (--iptr >= iend) *iptr = -1; + } + +/* Set up the first character to match, if available. The first_byte value is +never set for an anchored regular expression, but the anchoring may be forced +at run time, so we have to test for anchoring. The first char may be unset for +an unanchored pattern, of course. If there's no first char and the pattern was +studied, there may be a bitmap of possible first characters. */ + +if (!anchored) + { + if ((re->flags & PCRE_FIRSTSET) != 0) + { + first_byte = re->first_byte & 255; + if ((first_byte_caseless = ((re->first_byte & REQ_CASELESS) != 0)) == TRUE) + first_byte = md->lcc[first_byte]; + } + else + if (!startline && study != NULL && + (study->options & PCRE_STUDY_MAPPED) != 0) + start_bits = study->start_bits; + } + +/* For anchored or unanchored matches, there may be a "last known required +character" set. */ + +if ((re->flags & PCRE_REQCHSET) != 0) + { + req_byte = re->req_byte & 255; + req_byte_caseless = (re->req_byte & REQ_CASELESS) != 0; + req_byte2 = (tables + fcc_offset)[req_byte]; /* case flipped */ + } + + +/* ==========================================================================*/ + +/* Loop for handling unanchored repeated matching attempts; for anchored regexs +the loop runs just once. */ + +for(;;) + { + USPTR save_end_subject = end_subject; + USPTR new_start_match; + + /* Reset the maximum number of extractions we might see. */ + + if (md->offset_vector != NULL) + { + register int *iptr = md->offset_vector; + register int *iend = iptr + resetcount; + while (iptr < iend) *iptr++ = -1; + } + + /* Advance to a unique first char if possible. If firstline is TRUE, the + start of the match is constrained to the first line of a multiline string. + That is, the match must be before or at the first newline. Implement this by + temporarily adjusting end_subject so that we stop scanning at a newline. If + the match fails at the newline, later code breaks this loop. */ + + if (firstline) + { + USPTR t = start_match; + while (t < md->end_subject && !IS_NEWLINE(t)) t++; + end_subject = t; + } + + /* Now test for a unique first byte */ + + if (first_byte >= 0) + { + if (first_byte_caseless) + while (start_match < end_subject && + md->lcc[*start_match] != first_byte) + { NEXTCHAR(start_match,end_subject); } + else + while (start_match < end_subject && *start_match != first_byte) + { NEXTCHAR(start_match,end_subject); } + } + + /* Or to just after a linebreak for a multiline match if possible */ + + else if (startline) + { + if (start_match > md->start_subject + start_offset) + { + while (start_match <= end_subject && !WAS_NEWLINE(start_match)) + { NEXTCHAR(start_match,end_subject); } + + /* If we have just passed a CR and the newline option is ANY or ANYCRLF, + and we are now at a LF, advance the match position by one more character. + */ + + if (start_match <= end_subject && start_match[-1] == '\r' && + (md->nltype == NLTYPE_ANY || md->nltype == NLTYPE_ANYCRLF) && + start_match < end_subject && + *start_match == '\n') + start_match++; + } + } + + /* Or to a non-unique first char after study */ + + else if (start_bits != NULL) + { + while (start_match < end_subject) + { + register unsigned int c = *start_match; + if ((start_bits[c/8] & (1 << (c&7))) == 0) + { NEXTCHAR(start_match,end_subject); } +#ifdef ERLANG_INTEGRATION + else { + if ((extra_data->flags & PCRE_EXTRA_LOOP_LIMIT) != 0) + { + *extra_data->loop_counter_return = + (extra_data->loop_limit - md->loop_limit); + } + break; + } +#else + else break; +#endif + } + } + + /* Restore fudged end_subject */ + + end_subject = save_end_subject; + +#ifdef DEBUG /* Sigh. Some compilers never learn. */ + printf(">>>> Match against: "); + pchars(start_match, end_subject - start_match, TRUE, md); + printf("\n"); +#endif + + /* If req_byte is set, we know that that character must appear in the subject + for the match to succeed. If the first character is set, req_byte must be + later in the subject; otherwise the test starts at the match point. This + optimization can save a huge amount of backtracking in patterns with nested + unlimited repeats that aren't going to match. Writing separate code for + cased/caseless versions makes it go faster, as does using an autoincrement + and backing off on a match. + + HOWEVER: when the subject string is very, very long, searching to its end can + take a long time, and give bad performance on quite ordinary patterns. This + showed up when somebody was matching something like /^\d+C/ on a 32-megabyte + string... so we don't do this when the string is sufficiently long. + + ALSO: this processing is disabled when partial matching is requested. + */ + + if (req_byte >= 0 && + end_subject - start_match < REQ_BYTE_MAX && + !md->partial) + { + register USPTR p = start_match + ((first_byte >= 0)? 1 : 0); + + /* We don't need to repeat the search if we haven't yet reached the + place we found it at last time. */ + + if (p > req_byte_ptr) + { + if (req_byte_caseless) + { + while (p < end_subject) + { + register int pp = *p++; + if (pp == req_byte || pp == req_byte2) { p--; break; } + } + } + else + { + while (p < end_subject) + { + if (*p++ == req_byte) { p--; break; } + } + } + + /* If we can't find the required character, break the matching loop, + forcing a match failure. */ + + if (p >= end_subject) + { + rc = MATCH_NOMATCH; +#ifdef ERLANG_INTEGRATION + if ((extra_data->flags & PCRE_EXTRA_LOOP_LIMIT) != 0) + { + *extra_data->loop_counter_return = + (extra_data->loop_limit - md->loop_limit); + } +#endif + break; + } + + /* If we have found the required character, save the point where we + found it, so that we don't search again next time round the loop if + the start hasn't passed this character yet. */ + + req_byte_ptr = p; + } + } + + /* OK, we can now run the match. */ + + md->start_match_ptr = start_match; + md->match_call_count = 0; + EDEBUGF(("Calling match...")); + rc = match(start_match, md->start_code, start_match, 2, md, ims, NULL, 0, 0); +#ifdef ERLANG_INTEGRATION + if ((extra_data->flags & PCRE_EXTRA_LOOP_LIMIT) != 0) + { + *extra_data->loop_counter_return = + (extra_data->loop_limit - md->loop_limit); + } + SWAPOUT(); + while(rc == PCRE_ERROR_LOOP_LIMIT) { + EDEBUGF(("Loop limit break detected")); + return PCRE_ERROR_LOOP_LIMIT; + RESTART_INTERRUPTED: + md->match_call_count = 0; + md->loop_limit = extra_data->loop_limit; + rc = match(NULL,NULL,NULL,0,md,0,NULL,0,0); + *extra_data->loop_counter_return = + (extra_data->loop_limit - md->loop_limit); + } + md->state_save = NULL; /* So that next call to free_saved... does not crash */ +#endif + + switch(rc) + { + /* NOMATCH and PRUNE advance by one character. THEN at this level acts + exactly like PRUNE. */ + + case MATCH_NOMATCH: + case MATCH_PRUNE: + case MATCH_THEN: + new_start_match = start_match + 1; +#ifdef SUPPORT_UTF8 + if (utf8) + while(new_start_match < end_subject && (*new_start_match & 0xc0) == 0x80) + new_start_match++; +#endif + break; + + /* SKIP passes back the next starting point explicitly. */ + + case MATCH_SKIP: + new_start_match = md->start_match_ptr; + break; + + /* COMMIT disables the bumpalong, but otherwise behaves as NOMATCH. */ + + case MATCH_COMMIT: + rc = MATCH_NOMATCH; + goto ENDLOOP; + + /* Any other return is some kind of error. */ + + default: + goto ENDLOOP; + } + + /* Control reaches here for the various types of "no match at this point" + result. Reset the code to MATCH_NOMATCH for subsequent checking. */ + + rc = MATCH_NOMATCH; + + /* If PCRE_FIRSTLINE is set, the match must happen before or at the first + newline in the subject (though it may continue over the newline). Therefore, + if we have just failed to match, starting at a newline, do not continue. */ + + if (firstline && IS_NEWLINE(start_match)) break; + + /* Advance to new matching position */ + + start_match = new_start_match; + + /* Break the loop if the pattern is anchored or if we have passed the end of + the subject. */ + + if (anchored || start_match > end_subject) break; + + /* If we have just passed a CR and we are now at a LF, and the pattern does + not contain any explicit matches for \r or \n, and the newline option is CRLF + or ANY or ANYCRLF, advance the match position by one more character. */ + + if (start_match[-1] == '\r' && + start_match < end_subject && + *start_match == '\n' && + (re->flags & PCRE_HASCRORLF) == 0 && + (md->nltype == NLTYPE_ANY || + md->nltype == NLTYPE_ANYCRLF || + md->nllen == 2)) + start_match++; + + } /* End of for(;;) "bumpalong" loop */ + +/* ==========================================================================*/ + +/* We reach here when rc is not MATCH_NOMATCH, or if one of the stopping +conditions is true: + +(1) The pattern is anchored or the match was failed by (*COMMIT); + +(2) We are past the end of the subject; + +(3) PCRE_FIRSTLINE is set and we have failed to match at a newline, because + this option requests that a match occur at or before the first newline in + the subject. + +When we have a match and the offset vector is big enough to deal with any +backreferences, captured substring offsets will already be set up. In the case +where we had to get some local store to hold offsets for backreference +processing, copy those that we can. In this case there need not be overflow if +certain parts of the pattern were not used, even though there are more +capturing parentheses than vector slots. */ + +ENDLOOP: + +if (rc == MATCH_MATCH) + { + if (using_temporary_offsets) + { + if (offsetcount >= 4) + { + memcpy(offsets + 2, md->offset_vector + 2, + (offsetcount - 2) * sizeof(int)); + DPRINTF(("Copied offsets from temporary memory\n")); + } + if (md->end_offset_top > offsetcount) md->offset_overflow = TRUE; + DPRINTF(("Freeing temporary memory\n")); +#ifdef ERLANG_INTEGRATION + if (extra_data == NULL || + !(extra_data->flags & PCRE_EXTRA_LOOP_LIMIT)) { + (erts_pcre_free)(md->offset_vector); + } +#else + (erts_pcre_free)(md->offset_vector); +#endif + } + + /* Set the return code to the number of captured strings, or 0 if there are + too many to fit into the vector. */ + + rc = md->offset_overflow? 0 : md->end_offset_top/2; + + /* If there is space, set up the whole thing as substring 0. The value of + md->start_match_ptr might be modified if \K was encountered on the success + matching path. */ + + if (offsetcount < 2) rc = 0; else + { + offsets[0] = md->start_match_ptr - md->start_subject; + offsets[1] = md->end_match_ptr - md->start_subject; + } + + DPRINTF((">>>> returning %d\n", rc)); + return rc; + } + +/* Control gets here if there has been an error, or if the overall match +attempt has failed at all permitted starting positions. */ + +if (using_temporary_offsets) + { + DPRINTF(("Freeing temporary memory\n")); + (erts_pcre_free)(md->offset_vector); + } + +if (rc != MATCH_NOMATCH) + { + DPRINTF((">>>> error: returning %d\n", rc)); + return rc; + } +else if (md->partial && md->hitend) + { + DPRINTF((">>>> returning PCRE_ERROR_PARTIAL\n")); + return PCRE_ERROR_PARTIAL; + } +else + { + DPRINTF((">>>> returning PCRE_ERROR_NOMATCH\n")); + return PCRE_ERROR_NOMATCH; + } +} +#ifdef ERLANG_INTEGRATION +#undef resetcount +#undef req_byte2 +#undef using_temporary_offsets +#undef anchored +#undef startline +#undef firstline +#undef first_byte_caseless +#undef req_byte_caseless +#undef match_block +#undef md +#undef start_match +#undef req_byte_ptr +#undef internal_study +#undef study +#undef internal_re +#undef external_re +#undef re +#undef ims + +void erts_pcre_free_restart_data(void *restart_data) { + PcreExecContext *top = (PcreExecContext *) restart_data; + /* We might be done, or we might not, so there might be some saved match_states here */ + if (top != NULL) { + match_data *md = top->Xmd; + if (top->Xusing_temporary_offsets && md->offset_vector != NULL) { + (erts_pcre_free)(md->offset_vector); + } + free_saved_match_state(top->Xmd->state_save); + (erts_pcre_free)(top); + } +} +#endif + +/* End of pcre_exec.c */ diff --git a/erts/emulator/pcre/pcre_fullinfo.c b/erts/emulator/pcre/pcre_fullinfo.c new file mode 100644 index 0000000000..559c4e27b4 --- /dev/null +++ b/erts/emulator/pcre/pcre_fullinfo.c @@ -0,0 +1,166 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_fullinfo(), which returns +information about a compiled pattern. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Return info about compiled pattern * +*************************************************/ + +/* This is a newer "info" function which has an extensible interface so +that additional items can be added compatibly. + +Arguments: + argument_re points to compiled code + extra_data points extra data, or NULL + what what information is required + where where to put the information + +Returns: 0 if data returned, negative on error +*/ + +PCRE_EXP_DEFN int +erts_pcre_fullinfo(const pcre *argument_re, const pcre_extra *extra_data, int what, + void *where) +{ +real_pcre internal_re; +pcre_study_data internal_study; +const real_pcre *re = (const real_pcre *)argument_re; +const pcre_study_data *study = NULL; + +if (re == NULL || where == NULL) return PCRE_ERROR_NULL; + +if (extra_data != NULL && (extra_data->flags & PCRE_EXTRA_STUDY_DATA) != 0) + study = (const pcre_study_data *)extra_data->study_data; + +if (re->magic_number != MAGIC_NUMBER) + { + re = _erts_pcre_try_flipped(re, &internal_re, study, &internal_study); + if (re == NULL) return PCRE_ERROR_BADMAGIC; + if (study != NULL) study = &internal_study; + } + +switch (what) + { + case PCRE_INFO_OPTIONS: + *((unsigned long int *)where) = re->options & PUBLIC_OPTIONS; + break; + + case PCRE_INFO_SIZE: + *((size_t *)where) = re->size; + break; + + case PCRE_INFO_STUDYSIZE: + *((size_t *)where) = (study == NULL)? 0 : study->size; + break; + + case PCRE_INFO_CAPTURECOUNT: + *((int *)where) = re->top_bracket; + break; + + case PCRE_INFO_BACKREFMAX: + *((int *)where) = re->top_backref; + break; + + case PCRE_INFO_FIRSTBYTE: + *((int *)where) = + ((re->flags & PCRE_FIRSTSET) != 0)? re->first_byte : + ((re->flags & PCRE_STARTLINE) != 0)? -1 : -2; + break; + + /* Make sure we pass back the pointer to the bit vector in the external + block, not the internal copy (with flipped integer fields). */ + + case PCRE_INFO_FIRSTTABLE: + *((const uschar **)where) = + (study != NULL && (study->options & PCRE_STUDY_MAPPED) != 0)? + ((const pcre_study_data *)extra_data->study_data)->start_bits : NULL; + break; + + case PCRE_INFO_LASTLITERAL: + *((int *)where) = + ((re->flags & PCRE_REQCHSET) != 0)? re->req_byte : -1; + break; + + case PCRE_INFO_NAMEENTRYSIZE: + *((int *)where) = re->name_entry_size; + break; + + case PCRE_INFO_NAMECOUNT: + *((int *)where) = re->name_count; + break; + + case PCRE_INFO_NAMETABLE: + *((const uschar **)where) = (const uschar *)re + re->name_table_offset; + break; + + case PCRE_INFO_DEFAULT_TABLES: + *((const uschar **)where) = (const uschar *)(_erts_pcre_default_tables); + break; + + case PCRE_INFO_OKPARTIAL: + *((int *)where) = (re->flags & PCRE_NOPARTIAL) == 0; + break; + + case PCRE_INFO_JCHANGED: + *((int *)where) = (re->flags & PCRE_JCHANGED) != 0; + break; + + case PCRE_INFO_HASCRORLF: + *((int *)where) = (re->flags & PCRE_HASCRORLF) != 0; + break; + + default: return PCRE_ERROR_BADOPTION; + } + +return 0; +} + +/* End of pcre_fullinfo.c */ diff --git a/erts/emulator/pcre/pcre_get.c b/erts/emulator/pcre/pcre_get.c new file mode 100644 index 0000000000..0bfd2e19a3 --- /dev/null +++ b/erts/emulator/pcre/pcre_get.c @@ -0,0 +1,466 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains some convenience functions for extracting substrings +from the subject string after a regex match has succeeded. The original idea +for these functions came from Scott Wimer. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Find number for named string * +*************************************************/ + +/* This function is used by the get_first_set() function below, as well +as being generally available. It assumes that names are unique. + +Arguments: + code the compiled regex + stringname the name whose number is required + +Returns: the number of the named parentheses, or a negative number + (PCRE_ERROR_NOSUBSTRING) if not found +*/ + +int +erts_pcre_get_stringnumber(const pcre *code, const char *stringname) +{ +int rc; +int entrysize; +int top, bot; +uschar *nametable; + +if ((rc = erts_pcre_fullinfo(code, NULL, PCRE_INFO_NAMECOUNT, &top)) != 0) + return rc; +if (top <= 0) return PCRE_ERROR_NOSUBSTRING; + +if ((rc = erts_pcre_fullinfo(code, NULL, PCRE_INFO_NAMEENTRYSIZE, &entrysize)) != 0) + return rc; +if ((rc = erts_pcre_fullinfo(code, NULL, PCRE_INFO_NAMETABLE, &nametable)) != 0) + return rc; + +bot = 0; +while (top > bot) + { + int mid = (top + bot) / 2; + uschar *entry = nametable + entrysize*mid; + int c = strcmp(stringname, (char *)(entry + 2)); + if (c == 0) return (entry[0] << 8) + entry[1]; + if (c > 0) bot = mid + 1; else top = mid; + } + +return PCRE_ERROR_NOSUBSTRING; +} + + + +/************************************************* +* Find (multiple) entries for named string * +*************************************************/ + +/* This is used by the get_first_set() function below, as well as being +generally available. It is used when duplicated names are permitted. + +Arguments: + code the compiled regex + stringname the name whose entries required + firstptr where to put the pointer to the first entry + lastptr where to put the pointer to the last entry + +Returns: the length of each entry, or a negative number + (PCRE_ERROR_NOSUBSTRING) if not found +*/ + +int +erts_pcre_get_stringtable_entries(const pcre *code, const char *stringname, + char **firstptr, char **lastptr) +{ +int rc; +int entrysize; +int top, bot; +uschar *nametable, *lastentry; + +if ((rc = erts_pcre_fullinfo(code, NULL, PCRE_INFO_NAMECOUNT, &top)) != 0) + return rc; +if (top <= 0) return PCRE_ERROR_NOSUBSTRING; + +if ((rc = erts_pcre_fullinfo(code, NULL, PCRE_INFO_NAMEENTRYSIZE, &entrysize)) != 0) + return rc; +if ((rc = erts_pcre_fullinfo(code, NULL, PCRE_INFO_NAMETABLE, &nametable)) != 0) + return rc; + +lastentry = nametable + entrysize * (top - 1); +bot = 0; +while (top > bot) + { + int mid = (top + bot) / 2; + uschar *entry = nametable + entrysize*mid; + int c = strcmp(stringname, (char *)(entry + 2)); + if (c == 0) + { + uschar *first = entry; + uschar *last = entry; + while (first > nametable) + { + if (strcmp(stringname, (char *)(first - entrysize + 2)) != 0) break; + first -= entrysize; + } + while (last < lastentry) + { + if (strcmp(stringname, (char *)(last + entrysize + 2)) != 0) break; + last += entrysize; + } + *firstptr = (char *)first; + *lastptr = (char *)last; + return entrysize; + } + if (c > 0) bot = mid + 1; else top = mid; + } + +return PCRE_ERROR_NOSUBSTRING; +} + + + +/************************************************* +* Find first set of multiple named strings * +*************************************************/ + +/* This function allows for duplicate names in the table of named substrings. +It returns the number of the first one that was set in a pattern match. + +Arguments: + code the compiled regex + stringname the name of the capturing substring + ovector the vector of matched substrings + +Returns: the number of the first that is set, + or the number of the last one if none are set, + or a negative number on error +*/ + +static int +get_first_set(const pcre *code, const char *stringname, int *ovector) +{ +const real_pcre *re = (const real_pcre *)code; +int entrysize; +char *first, *last; +uschar *entry; +if ((re->options & PCRE_DUPNAMES) == 0 && (re->flags & PCRE_JCHANGED) == 0) + return erts_pcre_get_stringnumber(code, stringname); +entrysize = erts_pcre_get_stringtable_entries(code, stringname, &first, &last); +if (entrysize <= 0) return entrysize; +for (entry = (uschar *)first; entry <= (uschar *)last; entry += entrysize) + { + int n = (entry[0] << 8) + entry[1]; + if (ovector[n*2] >= 0) return n; + } +return (first[0] << 8) + first[1]; +} + + + + +/************************************************* +* Copy captured string to given buffer * +*************************************************/ + +/* This function copies a single captured substring into a given buffer. +Note that we use memcpy() rather than strncpy() in case there are binary zeros +in the string. + +Arguments: + subject the subject string that was matched + ovector pointer to the offsets table + stringcount the number of substrings that were captured + (i.e. the yield of the pcre_exec call, unless + that was zero, in which case it should be 1/3 + of the offset table size) + stringnumber the number of the required substring + buffer where to put the substring + size the size of the buffer + +Returns: if successful: + the length of the copied string, not including the zero + that is put on the end; can be zero + if not successful: + PCRE_ERROR_NOMEMORY (-6) buffer too small + PCRE_ERROR_NOSUBSTRING (-7) no such captured substring +*/ + +int +erts_pcre_copy_substring(const char *subject, int *ovector, int stringcount, + int stringnumber, char *buffer, int size) +{ +int yield; +if (stringnumber < 0 || stringnumber >= stringcount) + return PCRE_ERROR_NOSUBSTRING; +stringnumber *= 2; +yield = ovector[stringnumber+1] - ovector[stringnumber]; +if (size < yield + 1) return PCRE_ERROR_NOMEMORY; +memcpy(buffer, subject + ovector[stringnumber], yield); +buffer[yield] = 0; +return yield; +} + + + +/************************************************* +* Copy named captured string to given buffer * +*************************************************/ + +/* This function copies a single captured substring into a given buffer, +identifying it by name. If the regex permits duplicate names, the first +substring that is set is chosen. + +Arguments: + code the compiled regex + subject the subject string that was matched + ovector pointer to the offsets table + stringcount the number of substrings that were captured + (i.e. the yield of the pcre_exec call, unless + that was zero, in which case it should be 1/3 + of the offset table size) + stringname the name of the required substring + buffer where to put the substring + size the size of the buffer + +Returns: if successful: + the length of the copied string, not including the zero + that is put on the end; can be zero + if not successful: + PCRE_ERROR_NOMEMORY (-6) buffer too small + PCRE_ERROR_NOSUBSTRING (-7) no such captured substring +*/ + +int +erts_pcre_copy_named_substring(const pcre *code, const char *subject, int *ovector, + int stringcount, const char *stringname, char *buffer, int size) +{ +int n = get_first_set(code, stringname, ovector); +if (n <= 0) return n; +return erts_pcre_copy_substring(subject, ovector, stringcount, n, buffer, size); +} + + + +/************************************************* +* Copy all captured strings to new store * +*************************************************/ + +/* This function gets one chunk of store and builds a list of pointers and all +of the captured substrings in it. A NULL pointer is put on the end of the list. + +Arguments: + subject the subject string that was matched + ovector pointer to the offsets table + stringcount the number of substrings that were captured + (i.e. the yield of the pcre_exec call, unless + that was zero, in which case it should be 1/3 + of the offset table size) + listptr set to point to the list of pointers + +Returns: if successful: 0 + if not successful: + PCRE_ERROR_NOMEMORY (-6) failed to get store +*/ + +int +erts_pcre_get_substring_list(const char *subject, int *ovector, int stringcount, + const char ***listptr) +{ +int i; +int size = sizeof(char *); +int double_count = stringcount * 2; +char **stringlist; +char *p; + +for (i = 0; i < double_count; i += 2) + size += sizeof(char *) + ovector[i+1] - ovector[i] + 1; + +stringlist = (char **)(erts_pcre_malloc)(size); +if (stringlist == NULL) return PCRE_ERROR_NOMEMORY; + +*listptr = (const char **)stringlist; +p = (char *)(stringlist + stringcount + 1); + +for (i = 0; i < double_count; i += 2) + { + int len = ovector[i+1] - ovector[i]; + memcpy(p, subject + ovector[i], len); + *stringlist++ = p; + p += len; + *p++ = 0; + } + +*stringlist = NULL; +return 0; +} + + + +/************************************************* +* Free store obtained by get_substring_list * +*************************************************/ + +/* This function exists for the benefit of people calling PCRE from non-C +programs that can call its functions, but not free() or (erts_pcre_free)() directly. + +Argument: the result of a previous erts_pcre_get_substring_list() +Returns: nothing +*/ + +void +erts_pcre_free_substring_list(const char **pointer) +{ +(erts_pcre_free)((void *)pointer); +} + + + +/************************************************* +* Copy captured string to new store * +*************************************************/ + +/* This function copies a single captured substring into a piece of new +store + +Arguments: + subject the subject string that was matched + ovector pointer to the offsets table + stringcount the number of substrings that were captured + (i.e. the yield of the pcre_exec call, unless + that was zero, in which case it should be 1/3 + of the offset table size) + stringnumber the number of the required substring + stringptr where to put a pointer to the substring + +Returns: if successful: + the length of the string, not including the zero that + is put on the end; can be zero + if not successful: + PCRE_ERROR_NOMEMORY (-6) failed to get store + PCRE_ERROR_NOSUBSTRING (-7) substring not present +*/ + +int +erts_pcre_get_substring(const char *subject, int *ovector, int stringcount, + int stringnumber, const char **stringptr) +{ +int yield; +char *substring; +if (stringnumber < 0 || stringnumber >= stringcount) + return PCRE_ERROR_NOSUBSTRING; +stringnumber *= 2; +yield = ovector[stringnumber+1] - ovector[stringnumber]; +substring = (char *)(erts_pcre_malloc)(yield + 1); +if (substring == NULL) return PCRE_ERROR_NOMEMORY; +memcpy(substring, subject + ovector[stringnumber], yield); +substring[yield] = 0; +*stringptr = substring; +return yield; +} + + + +/************************************************* +* Copy named captured string to new store * +*************************************************/ + +/* This function copies a single captured substring, identified by name, into +new store. If the regex permits duplicate names, the first substring that is +set is chosen. + +Arguments: + code the compiled regex + subject the subject string that was matched + ovector pointer to the offsets table + stringcount the number of substrings that were captured + (i.e. the yield of the pcre_exec call, unless + that was zero, in which case it should be 1/3 + of the offset table size) + stringname the name of the required substring + stringptr where to put the pointer + +Returns: if successful: + the length of the copied string, not including the zero + that is put on the end; can be zero + if not successful: + PCRE_ERROR_NOMEMORY (-6) couldn't get memory + PCRE_ERROR_NOSUBSTRING (-7) no such captured substring +*/ + +int +erts_pcre_get_named_substring(const pcre *code, const char *subject, int *ovector, + int stringcount, const char *stringname, const char **stringptr) +{ +int n = get_first_set(code, stringname, ovector); +if (n <= 0) return n; +return erts_pcre_get_substring(subject, ovector, stringcount, n, stringptr); +} + + + + +/************************************************* +* Free store obtained by get_substring * +*************************************************/ + +/* This function exists for the benefit of people calling PCRE from non-C +programs that can call its functions, but not free() or (erts_pcre_free)() directly. + +Argument: the result of a previous erts_pcre_get_substring() +Returns: nothing +*/ + +void +erts_pcre_free_substring(const char *pointer) +{ +(erts_pcre_free)((void *)pointer); +} + +/* End of pcre_get.c */ diff --git a/erts/emulator/pcre/pcre_globals.c b/erts/emulator/pcre/pcre_globals.c new file mode 100644 index 0000000000..1dd8d81714 --- /dev/null +++ b/erts/emulator/pcre/pcre_globals.c @@ -0,0 +1,65 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains global variables that are exported by the PCRE library. +PCRE is thread-clean and doesn't use any global variables in the normal sense. +However, it calls memory allocation and freeing functions via the four +indirections below, and it can optionally do callouts, using the fifth +indirection. These values can be changed by the caller, but are shared between +all threads. However, when compiling for Virtual Pascal, things are done +differently, and global variables are not used (see pcre.in). */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + +#ifndef VPCOMPAT +PCRE_EXP_DATA_DEFN void *(*erts_pcre_malloc)(size_t) = malloc; +PCRE_EXP_DATA_DEFN void (*erts_pcre_free)(void *) = free; +PCRE_EXP_DATA_DEFN void *(*erts_pcre_stack_malloc)(size_t) = malloc; +PCRE_EXP_DATA_DEFN void (*erts_pcre_stack_free)(void *) = free; +PCRE_EXP_DATA_DEFN int (*erts_pcre_callout)(pcre_callout_block *) = NULL; +#endif + +/* End of pcre_globals.c */ diff --git a/erts/emulator/pcre/pcre_info.c b/erts/emulator/pcre/pcre_info.c new file mode 100644 index 0000000000..86e957b0cc --- /dev/null +++ b/erts/emulator/pcre/pcre_info.c @@ -0,0 +1,94 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_info(), which gives some +information about a compiled pattern. However, use of this function is now +deprecated, as it has been superseded by pcre_fullinfo(). */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* (Obsolete) Return info about compiled pattern * +*************************************************/ + +/* This is the original "info" function. It picks potentially useful data out +of the private structure, but its interface was too rigid. It remains for +backwards compatibility. The public options are passed back in an int - though +the re->options field has been expanded to a long int, all the public options +at the low end of it, and so even on 16-bit systems this will still be OK. +Therefore, I haven't changed the API for erts_pcre_info(). + +Arguments: + argument_re points to compiled code + optptr where to pass back the options + first_byte where to pass back the first character, + or -1 if multiline and all branches start ^, + or -2 otherwise + +Returns: number of capturing subpatterns + or negative values on error +*/ + +PCRE_EXP_DEFN int +erts_pcre_info(const pcre *argument_re, int *optptr, int *first_byte) +{ +real_pcre internal_re; +const real_pcre *re = (const real_pcre *)argument_re; +if (re == NULL) return PCRE_ERROR_NULL; +if (re->magic_number != MAGIC_NUMBER) + { + re = _erts_pcre_try_flipped(re, &internal_re, NULL, NULL); + if (re == NULL) return PCRE_ERROR_BADMAGIC; + } +if (optptr != NULL) *optptr = (int)(re->options & PUBLIC_OPTIONS); +if (first_byte != NULL) + *first_byte = ((re->flags & PCRE_FIRSTSET) != 0)? re->first_byte : + ((re->flags & PCRE_STARTLINE) != 0)? -1 : -2; +return re->top_bracket; +} + +/* End of pcre_info.c */ diff --git a/erts/emulator/pcre/pcre_internal.h b/erts/emulator/pcre/pcre_internal.h new file mode 100644 index 0000000000..6aafabb0c9 --- /dev/null +++ b/erts/emulator/pcre/pcre_internal.h @@ -0,0 +1,1136 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + +/* This header contains definitions that are shared between the different +modules, but which are not relevant to the exported API. This includes some +functions whose names all begin with "_erts_pcre_". */ + +/* %ExternalCopyright% */ + +#ifndef PCRE_INTERNAL_H +#define PCRE_INTERNAL_H + +#ifdef ERLANG_INTEGRATION +#include "local_config.h" +#endif + +/* Define DEBUG to get debugging output on stdout. */ + +#if 0 +#define DEBUG +#endif + +/* Use a macro for debugging printing, 'cause that eliminates the use of #ifdef +inline, and there are *still* stupid compilers about that don't like indented +pre-processor statements, or at least there were when I first wrote this. After +all, it had only been about 10 years then... + +It turns out that the Mac Debugging.h header also defines the macro DPRINTF, so +be absolutely sure we get our version. */ + +#undef DPRINTF +#ifdef DEBUG +#define DPRINTF(p) printf p +#else +#define DPRINTF(p) /* Nothing */ +#endif + + +/* Standard C headers plus the external interface definition. The only time +setjmp and stdarg are used is when NO_RECURSE is set. */ + +#include +#include +#include +#include +#include +#include +#include +#include + +/* When compiling a DLL for Windows, the exported symbols have to be declared +using some MS magic. I found some useful information on this web page: +http://msdn2.microsoft.com/en-us/library/y4h7bcy6(VS.80).aspx. According to the +information there, using __declspec(dllexport) without "extern" we have a +definition; with "extern" we have a declaration. The settings here override the +setting in pcre.h (which is included below); it defines only PCRE_EXP_DECL, +which is all that is needed for applications (they just import the symbols). We +use: + + PCRE_EXP_DECL for declarations + PCRE_EXP_DEFN for definitions of exported functions + PCRE_EXP_DATA_DEFN for definitions of exported variables + +The reason for the two DEFN macros is that in non-Windows environments, one +does not want to have "extern" before variable definitions because it leads to +compiler warnings. So we distinguish between functions and variables. In +Windows, the two should always be the same. + +The reason for wrapping this in #ifndef PCRE_EXP_DECL is so that pcretest, +which is an application, but needs to import this file in order to "peek" at +internals, can #include pcre.h first to get an application's-eye view. + +In principle, people compiling for non-Windows, non-Unix-like (i.e. uncommon, +special-purpose environments) might want to stick other stuff in front of +exported symbols. That's why, in the non-Windows case, we set PCRE_EXP_DEFN and +PCRE_EXP_DATA_DEFN only if they are not already set. */ + +#ifndef PCRE_EXP_DECL +# ifdef _WIN32 +# ifndef PCRE_STATIC +# define PCRE_EXP_DECL extern __declspec(dllexport) +# define PCRE_EXP_DEFN __declspec(dllexport) +# define PCRE_EXP_DATA_DEFN __declspec(dllexport) +# else +# define PCRE_EXP_DECL extern +# define PCRE_EXP_DEFN +# define PCRE_EXP_DATA_DEFN +# endif +# else +# ifdef __cplusplus +# define PCRE_EXP_DECL extern "C" +# else +# define PCRE_EXP_DECL extern +# endif +# ifndef PCRE_EXP_DEFN +# define PCRE_EXP_DEFN PCRE_EXP_DECL +# endif +# ifndef PCRE_EXP_DATA_DEFN +# define PCRE_EXP_DATA_DEFN +# endif +# endif +#endif + +/* We need to have types that specify unsigned 16-bit and 32-bit integers. We +cannot determine these outside the compilation (e.g. by running a program as +part of "configure") because PCRE is often cross-compiled for use on other +systems. Instead we make use of the maximum sizes that are available at +preprocessor time in standard C environments. */ + +#if USHRT_MAX == 65535 + typedef unsigned short pcre_uint16; +#elif UINT_MAX == 65535 + typedef unsigned int pcre_uint16; +#else + #error Cannot determine a type for 16-bit unsigned integers +#endif + +#if UINT_MAX == 4294967295 + typedef unsigned int pcre_uint32; +#elif ULONG_MAX == 4294967295 + typedef unsigned long int pcre_uint32; +#else + #error Cannot determine a type for 32-bit unsigned integers +#endif + +/* All character handling must be done as unsigned characters. Otherwise there +are problems with top-bit-set characters and functions such as isspace(). +However, we leave the interface to the outside world as char *, because that +should make things easier for callers. We define a short type for unsigned char +to save lots of typing. I tried "uchar", but it causes problems on Digital +Unix, where it is defined in sys/types, so use "uschar" instead. */ + +typedef unsigned char uschar; + +/* This is an unsigned int value that no character can ever have. UTF-8 +characters only go up to 0x7fffffff (though Unicode doesn't go beyond +0x0010ffff). */ + +#define NOTACHAR 0xffffffff + +/* PCRE is able to support several different kinds of newline (CR, LF, CRLF, +"any" and "anycrlf" at present). The following macros are used to package up +testing for newlines. NLBLOCK, PSSTART, and PSEND are defined in the various +modules to indicate in which datablock the parameters exist, and what the +start/end of string field names are. */ + +#define NLTYPE_FIXED 0 /* Newline is a fixed length string */ +#define NLTYPE_ANY 1 /* Newline is any Unicode line ending */ +#define NLTYPE_ANYCRLF 2 /* Newline is CR, LF, or CRLF */ + +/* This macro checks for a newline at the given position */ + +#define IS_NEWLINE(p) \ + ((NLBLOCK->nltype != NLTYPE_FIXED)? \ + ((p) < NLBLOCK->PSEND && \ + _erts_pcre_is_newline((p), NLBLOCK->nltype, NLBLOCK->PSEND, &(NLBLOCK->nllen),\ + utf8)) \ + : \ + ((p) <= NLBLOCK->PSEND - NLBLOCK->nllen && \ + (p)[0] == NLBLOCK->nl[0] && \ + (NLBLOCK->nllen == 1 || (p)[1] == NLBLOCK->nl[1]) \ + ) \ + ) + +/* This macro checks for a newline immediately preceding the given position */ + +#define WAS_NEWLINE(p) \ + ((NLBLOCK->nltype != NLTYPE_FIXED)? \ + ((p) > NLBLOCK->PSSTART && \ + _erts_pcre_was_newline((p), NLBLOCK->nltype, NLBLOCK->PSSTART, \ + &(NLBLOCK->nllen), utf8)) \ + : \ + ((p) >= NLBLOCK->PSSTART + NLBLOCK->nllen && \ + (p)[-NLBLOCK->nllen] == NLBLOCK->nl[0] && \ + (NLBLOCK->nllen == 1 || (p)[-NLBLOCK->nllen+1] == NLBLOCK->nl[1]) \ + ) \ + ) + +/* When PCRE is compiled as a C++ library, the subject pointer can be replaced +with a custom type. This makes it possible, for example, to allow pcre_exec() +to process subject strings that are discontinuous by using a smart pointer +class. It must always be possible to inspect all of the subject string in +pcre_exec() because of the way it backtracks. Two macros are required in the +normal case, for sign-unspecified and unsigned char pointers. The former is +used for the external interface and appears in pcre.h, which is why its name +must begin with PCRE_. */ + +#ifdef CUSTOM_SUBJECT_PTR +#define PCRE_SPTR CUSTOM_SUBJECT_PTR +#define USPTR CUSTOM_SUBJECT_PTR +#else +#define PCRE_SPTR const char * +#define USPTR const unsigned char * +#endif + + + +/* Include the public PCRE header and the definitions of UCP character property +values. */ + +#include "pcre.h" +#include "ucp.h" + +/* When compiling for use with the Virtual Pascal compiler, these functions +need to have their names changed. PCRE must be compiled with the -DVPCOMPAT +option on the command line. */ + +#ifdef VPCOMPAT +#define strlen(s) _strlen(s) +#define strncmp(s1,s2,m) _strncmp(s1,s2,m) +#define memcmp(s,c,n) _memcmp(s,c,n) +#define memcpy(d,s,n) _memcpy(d,s,n) +#define memmove(d,s,n) _memmove(d,s,n) +#define memset(s,c,n) _memset(s,c,n) +#else /* VPCOMPAT */ + +/* To cope with SunOS4 and other systems that lack memmove() but have bcopy(), +define a macro for memmove() if HAVE_MEMMOVE is false, provided that HAVE_BCOPY +is set. Otherwise, include an emulating function for those systems that have +neither (there some non-Unix environments where this is the case). */ + +#ifndef HAVE_MEMMOVE +#undef memmove /* some systems may have a macro */ +#ifdef HAVE_BCOPY +#define memmove(a, b, c) bcopy(b, a, c) +#else /* HAVE_BCOPY */ +static void * +pcre_memmove(void *d, const void *s, size_t n) +{ +size_t i; +unsigned char *dest = (unsigned char *)d; +const unsigned char *src = (const unsigned char *)s; +if (dest > src) + { + dest += n; + src += n; + for (i = 0; i < n; ++i) *(--dest) = *(--src); + return (void *)dest; + } +else + { + for (i = 0; i < n; ++i) *dest++ = *src++; + return (void *)(dest - n); + } +} +#define memmove(a, b, c) pcre_memmove(a, b, c) +#endif /* not HAVE_BCOPY */ +#endif /* not HAVE_MEMMOVE */ +#endif /* not VPCOMPAT */ + + +/* PCRE keeps offsets in its compiled code as 2-byte quantities (always stored +in big-endian order) by default. These are used, for example, to link from the +start of a subpattern to its alternatives and its end. The use of 2 bytes per +offset limits the size of the compiled regex to around 64K, which is big enough +for almost everybody. However, I received a request for an even bigger limit. +For this reason, and also to make the code easier to maintain, the storing and +loading of offsets from the byte string is now handled by the macros that are +defined here. + +The macros are controlled by the value of LINK_SIZE. This defaults to 2 in +the config.h file, but can be overridden by using -D on the command line. This +is automated on Unix systems via the "configure" command. */ + +#if LINK_SIZE == 2 + +#define PUT(a,n,d) \ + (a[n] = (d) >> 8), \ + (a[(n)+1] = (d) & 255) + +#define GET(a,n) \ + (((a)[n] << 8) | (a)[(n)+1]) + +#define MAX_PATTERN_SIZE (1 << 16) + + +#elif LINK_SIZE == 3 + +#define PUT(a,n,d) \ + (a[n] = (d) >> 16), \ + (a[(n)+1] = (d) >> 8), \ + (a[(n)+2] = (d) & 255) + +#define GET(a,n) \ + (((a)[n] << 16) | ((a)[(n)+1] << 8) | (a)[(n)+2]) + +#define MAX_PATTERN_SIZE (1 << 24) + + +#elif LINK_SIZE == 4 + +#define PUT(a,n,d) \ + (a[n] = (d) >> 24), \ + (a[(n)+1] = (d) >> 16), \ + (a[(n)+2] = (d) >> 8), \ + (a[(n)+3] = (d) & 255) + +#define GET(a,n) \ + (((a)[n] << 24) | ((a)[(n)+1] << 16) | ((a)[(n)+2] << 8) | (a)[(n)+3]) + +#define MAX_PATTERN_SIZE (1 << 30) /* Keep it positive */ + + +#else +#error LINK_SIZE must be either 2, 3, or 4 +#endif + + +/* Convenience macro defined in terms of the others */ + +#define PUTINC(a,n,d) PUT(a,n,d), a += LINK_SIZE + + +/* PCRE uses some other 2-byte quantities that do not change when the size of +offsets changes. There are used for repeat counts and for other things such as +capturing parenthesis numbers in back references. */ + +#define PUT2(a,n,d) \ + a[n] = (d) >> 8; \ + a[(n)+1] = (d) & 255 + +#define GET2(a,n) \ + (((a)[n] << 8) | (a)[(n)+1]) + +#define PUT2INC(a,n,d) PUT2(a,n,d), a += 2 + + +/* When UTF-8 encoding is being used, a character is no longer just a single +byte. The macros for character handling generate simple sequences when used in +byte-mode, and more complicated ones for UTF-8 characters. BACKCHAR should +never be called in byte mode. To make sure it can never even appear when UTF-8 +support is omitted, we don't even define it. */ + +#ifndef SUPPORT_UTF8 +#define NEXTCHAR(p,end) p++; +#define GETCHAR(c, eptr) c = *eptr; +#define GETCHARTEST(c, eptr) c = *eptr; +#define GETCHARINC(c, eptr) c = *eptr++; +#define GETCHARINCTEST(c, eptr) c = *eptr++; +#define GETCHARLEN(c, eptr, len) c = *eptr; +/* #define BACKCHAR(eptr) */ + +#else /* SUPPORT_UTF8 */ + +/* Advance a character pointer one byte in non-UTF-8 mode and by one character +in UTF-8 mode. */ + +#define NEXTCHAR(p,end) \ + p++; \ + if (utf8) { while(p < end && (*p & 0xc0) == 0x80) p++; } + +/* Get the next UTF-8 character, not advancing the pointer. This is called when +we know we are in UTF-8 mode. */ + +#define GETCHAR(c, eptr) \ + c = *eptr; \ + if (c >= 0xc0) \ + { \ + int gcii; \ + int gcaa = _erts_pcre_utf8_table4[c & 0x3f]; /* Number of additional bytes */ \ + int gcss = 6*gcaa; \ + c = (c & _erts_pcre_utf8_table3[gcaa]) << gcss; \ + for (gcii = 1; gcii <= gcaa; gcii++) \ + { \ + gcss -= 6; \ + c |= (eptr[gcii] & 0x3f) << gcss; \ + } \ + } + +/* Get the next UTF-8 character, testing for UTF-8 mode, and not advancing the +pointer. */ + +#define GETCHARTEST(c, eptr) \ + c = *eptr; \ + if (utf8 && c >= 0xc0) \ + { \ + int gcii; \ + int gcaa = _erts_pcre_utf8_table4[c & 0x3f]; /* Number of additional bytes */ \ + int gcss = 6*gcaa; \ + c = (c & _erts_pcre_utf8_table3[gcaa]) << gcss; \ + for (gcii = 1; gcii <= gcaa; gcii++) \ + { \ + gcss -= 6; \ + c |= (eptr[gcii] & 0x3f) << gcss; \ + } \ + } + +/* Get the next UTF-8 character, advancing the pointer. This is called when we +know we are in UTF-8 mode. */ + +#define GETCHARINC(c, eptr) \ + c = *eptr++; \ + if (c >= 0xc0) \ + { \ + int gcaa = _erts_pcre_utf8_table4[c & 0x3f]; /* Number of additional bytes */ \ + int gcss = 6*gcaa; \ + c = (c & _erts_pcre_utf8_table3[gcaa]) << gcss; \ + while (gcaa-- > 0) \ + { \ + gcss -= 6; \ + c |= (*eptr++ & 0x3f) << gcss; \ + } \ + } + +/* Get the next character, testing for UTF-8 mode, and advancing the pointer */ + +#define GETCHARINCTEST(c, eptr) \ + c = *eptr++; \ + if (utf8 && c >= 0xc0) \ + { \ + int gcaa = _erts_pcre_utf8_table4[c & 0x3f]; /* Number of additional bytes */ \ + int gcss = 6*gcaa; \ + c = (c & _erts_pcre_utf8_table3[gcaa]) << gcss; \ + while (gcaa-- > 0) \ + { \ + gcss -= 6; \ + c |= (*eptr++ & 0x3f) << gcss; \ + } \ + } + +/* Get the next UTF-8 character, not advancing the pointer, incrementing length +if there are extra bytes. This is called when we know we are in UTF-8 mode. */ + +#define GETCHARLEN(c, eptr, len) \ + c = *eptr; \ + if (c >= 0xc0) \ + { \ + int gcii; \ + int gcaa = _erts_pcre_utf8_table4[c & 0x3f]; /* Number of additional bytes */ \ + int gcss = 6*gcaa; \ + c = (c & _erts_pcre_utf8_table3[gcaa]) << gcss; \ + for (gcii = 1; gcii <= gcaa; gcii++) \ + { \ + gcss -= 6; \ + c |= (eptr[gcii] & 0x3f) << gcss; \ + } \ + len += gcaa; \ + } + +/* If the pointer is not at the start of a character, move it back until +it is. This is called only in UTF-8 mode - we don't put a test within the macro +because almost all calls are already within a block of UTF-8 only code. */ + +#define BACKCHAR(eptr) while((*eptr & 0xc0) == 0x80) eptr-- + +#endif + + +/* In case there is no definition of offsetof() provided - though any proper +Standard C system should have one. */ + +#ifndef offsetof +#define offsetof(p_type,field) ((size_t)&(((p_type *)0)->field)) +#endif + + +/* These are the public options that can change during matching. */ + +#define PCRE_IMS (PCRE_CASELESS|PCRE_MULTILINE|PCRE_DOTALL) + +/* Private flags containing information about the compiled regex. They used to +live at the top end of the options word, but that got almost full, so now they +are in a 16-bit flags word. */ + +#define PCRE_NOPARTIAL 0x0001 /* can't use partial with this regex */ +#define PCRE_FIRSTSET 0x0002 /* first_byte is set */ +#define PCRE_REQCHSET 0x0004 /* req_byte is set */ +#define PCRE_STARTLINE 0x0008 /* start after \n for multiline */ +#define PCRE_JCHANGED 0x0010 /* j option used in regex */ +#define PCRE_HASCRORLF 0x0020 /* explicit \r or \n in pattern */ + +/* Options for the "extra" block produced by pcre_study(). */ + +#define PCRE_STUDY_MAPPED 0x01 /* a map of starting chars exists */ + +/* Masks for identifying the public options that are permitted at compile +time, run time, or study time, respectively. */ + +#define PCRE_NEWLINE_BITS (PCRE_NEWLINE_CR|PCRE_NEWLINE_LF|PCRE_NEWLINE_ANY| \ + PCRE_NEWLINE_ANYCRLF) + +#define PUBLIC_OPTIONS \ + (PCRE_CASELESS|PCRE_EXTENDED|PCRE_ANCHORED|PCRE_MULTILINE| \ + PCRE_DOTALL|PCRE_DOLLAR_ENDONLY|PCRE_EXTRA|PCRE_UNGREEDY|PCRE_UTF8| \ + PCRE_NO_AUTO_CAPTURE|PCRE_NO_UTF8_CHECK|PCRE_AUTO_CALLOUT|PCRE_FIRSTLINE| \ + PCRE_DUPNAMES|PCRE_NEWLINE_BITS|PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE) + +#define PUBLIC_EXEC_OPTIONS \ + (PCRE_ANCHORED|PCRE_NOTBOL|PCRE_NOTEOL|PCRE_NOTEMPTY|PCRE_NO_UTF8_CHECK| \ + PCRE_PARTIAL|PCRE_NEWLINE_BITS|PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE) + +#define PUBLIC_DFA_EXEC_OPTIONS \ + (PCRE_ANCHORED|PCRE_NOTBOL|PCRE_NOTEOL|PCRE_NOTEMPTY|PCRE_NO_UTF8_CHECK| \ + PCRE_PARTIAL|PCRE_DFA_SHORTEST|PCRE_DFA_RESTART|PCRE_NEWLINE_BITS| \ + PCRE_BSR_ANYCRLF|PCRE_BSR_UNICODE) + +#define PUBLIC_STUDY_OPTIONS 0 /* None defined */ + +/* Magic number to provide a small check against being handed junk. Also used +to detect whether a pattern was compiled on a host of different endianness. */ + +#define MAGIC_NUMBER 0x50435245UL /* 'PCRE' */ + +/* Negative values for the firstchar and reqchar variables */ + +#define REQ_UNSET (-2) +#define REQ_NONE (-1) + +/* The maximum remaining length of subject we are prepared to search for a +req_byte match. */ + +#define REQ_BYTE_MAX 1000 + +/* Flags added to firstbyte or reqbyte; a "non-literal" item is either a +variable-length repeat, or a anything other than literal characters. */ + +#define REQ_CASELESS 0x0100 /* indicates caselessness */ +#define REQ_VARY 0x0200 /* reqbyte followed non-literal item */ + +/* Miscellaneous definitions */ + +typedef int BOOL; + +#define FALSE 0 +#define TRUE 1 + +/* Escape items that are just an encoding of a particular data value. */ + +#ifndef ESC_e +#define ESC_e 27 +#endif + +#ifndef ESC_f +#define ESC_f '\f' +#endif + +#ifndef ESC_n +#define ESC_n '\n' +#endif + +#ifndef ESC_r +#define ESC_r '\r' +#endif + +/* We can't officially use ESC_t because it is a POSIX reserved identifier +(presumably because of all the others like size_t). */ + +#ifndef ESC_tee +#define ESC_tee '\t' +#endif + +/* Codes for different types of Unicode property */ + +#define PT_ANY 0 /* Any property - matches all chars */ +#define PT_LAMP 1 /* L& - the union of Lu, Ll, Lt */ +#define PT_GC 2 /* General characteristic (e.g. L) */ +#define PT_PC 3 /* Particular characteristic (e.g. Lu) */ +#define PT_SC 4 /* Script (e.g. Han) */ + +/* Flag bits and data types for the extended class (OP_XCLASS) for classes that +contain UTF-8 characters with values greater than 255. */ + +#define XCL_NOT 0x01 /* Flag: this is a negative class */ +#define XCL_MAP 0x02 /* Flag: a 32-byte map is present */ + +#define XCL_END 0 /* Marks end of individual items */ +#define XCL_SINGLE 1 /* Single item (one multibyte char) follows */ +#define XCL_RANGE 2 /* A range (two multibyte chars) follows */ +#define XCL_PROP 3 /* Unicode property (2-byte property code follows) */ +#define XCL_NOTPROP 4 /* Unicode inverted property (ditto) */ + +/* These are escaped items that aren't just an encoding of a particular data +value such as \n. They must have non-zero values, as check_escape() returns +their negation. Also, they must appear in the same order as in the opcode +definitions below, up to ESC_z. There's a dummy for OP_ANY because it +corresponds to "." rather than an escape sequence. The final one must be +ESC_REF as subsequent values are used for backreferences (\1, \2, \3, etc). +There are two tests in the code for an escape greater than ESC_b and less than +ESC_Z to detect the types that may be repeated. These are the types that +consume characters. If any new escapes are put in between that don't consume a +character, that code will have to change. */ + +enum { ESC_A = 1, ESC_G, ESC_K, ESC_B, ESC_b, ESC_D, ESC_d, ESC_S, ESC_s, + ESC_W, ESC_w, ESC_dum1, ESC_C, ESC_P, ESC_p, ESC_R, ESC_H, ESC_h, + ESC_V, ESC_v, ESC_X, ESC_Z, ESC_z, ESC_E, ESC_Q, ESC_k, ESC_REF }; + + +/* Opcode table: Starting from 1 (i.e. after OP_END), the values up to +OP_EOD must correspond in order to the list of escapes immediately above. + +*** NOTE NOTE NOTE *** Whenever this list is updated, the two macro definitions +that follow must also be updated to match. There is also a table called +"coptable" in pcre_dfa_exec.c that must be updated. */ + +enum { + OP_END, /* 0 End of pattern */ + + /* Values corresponding to backslashed metacharacters */ + + OP_SOD, /* 1 Start of data: \A */ + OP_SOM, /* 2 Start of match (subject + offset): \G */ + OP_SET_SOM, /* 3 Set start of match (\K) */ + OP_NOT_WORD_BOUNDARY, /* 4 \B */ + OP_WORD_BOUNDARY, /* 5 \b */ + OP_NOT_DIGIT, /* 6 \D */ + OP_DIGIT, /* 7 \d */ + OP_NOT_WHITESPACE, /* 8 \S */ + OP_WHITESPACE, /* 9 \s */ + OP_NOT_WORDCHAR, /* 10 \W */ + OP_WORDCHAR, /* 11 \w */ + OP_ANY, /* 12 Match any character */ + OP_ANYBYTE, /* 13 Match any byte (\C); different to OP_ANY for UTF-8 */ + OP_NOTPROP, /* 14 \P (not Unicode property) */ + OP_PROP, /* 15 \p (Unicode property) */ + OP_ANYNL, /* 16 \R (any newline sequence) */ + OP_NOT_HSPACE, /* 17 \H (not horizontal whitespace) */ + OP_HSPACE, /* 18 \h (horizontal whitespace) */ + OP_NOT_VSPACE, /* 19 \V (not vertical whitespace) */ + OP_VSPACE, /* 20 \v (vertical whitespace) */ + OP_EXTUNI, /* 21 \X (extended Unicode sequence */ + OP_EODN, /* 22 End of data or \n at end of data: \Z. */ + OP_EOD, /* 23 End of data: \z */ + + OP_OPT, /* 24 Set runtime options */ + OP_CIRC, /* 25 Start of line - varies with multiline switch */ + OP_DOLL, /* 26 End of line - varies with multiline switch */ + OP_CHAR, /* 27 Match one character, casefully */ + OP_CHARNC, /* 28 Match one character, caselessly */ + OP_NOT, /* 29 Match one character, not the following one */ + + OP_STAR, /* 30 The maximizing and minimizing versions of */ + OP_MINSTAR, /* 31 these six opcodes must come in pairs, with */ + OP_PLUS, /* 32 the minimizing one second. */ + OP_MINPLUS, /* 33 This first set applies to single characters.*/ + OP_QUERY, /* 34 */ + OP_MINQUERY, /* 35 */ + + OP_UPTO, /* 36 From 0 to n matches */ + OP_MINUPTO, /* 37 */ + OP_EXACT, /* 38 Exactly n matches */ + + OP_POSSTAR, /* 39 Possessified star */ + OP_POSPLUS, /* 40 Possessified plus */ + OP_POSQUERY, /* 41 Posesssified query */ + OP_POSUPTO, /* 42 Possessified upto */ + + OP_NOTSTAR, /* 43 The maximizing and minimizing versions of */ + OP_NOTMINSTAR, /* 44 these six opcodes must come in pairs, with */ + OP_NOTPLUS, /* 45 the minimizing one second. They must be in */ + OP_NOTMINPLUS, /* 46 exactly the same order as those above. */ + OP_NOTQUERY, /* 47 This set applies to "not" single characters. */ + OP_NOTMINQUERY, /* 48 */ + + OP_NOTUPTO, /* 49 From 0 to n matches */ + OP_NOTMINUPTO, /* 50 */ + OP_NOTEXACT, /* 51 Exactly n matches */ + + OP_NOTPOSSTAR, /* 52 Possessified versions */ + OP_NOTPOSPLUS, /* 53 */ + OP_NOTPOSQUERY, /* 54 */ + OP_NOTPOSUPTO, /* 55 */ + + OP_TYPESTAR, /* 56 The maximizing and minimizing versions of */ + OP_TYPEMINSTAR, /* 57 these six opcodes must come in pairs, with */ + OP_TYPEPLUS, /* 58 the minimizing one second. These codes must */ + OP_TYPEMINPLUS, /* 59 be in exactly the same order as those above. */ + OP_TYPEQUERY, /* 60 This set applies to character types such as \d */ + OP_TYPEMINQUERY, /* 61 */ + + OP_TYPEUPTO, /* 62 From 0 to n matches */ + OP_TYPEMINUPTO, /* 63 */ + OP_TYPEEXACT, /* 64 Exactly n matches */ + + OP_TYPEPOSSTAR, /* 65 Possessified versions */ + OP_TYPEPOSPLUS, /* 66 */ + OP_TYPEPOSQUERY, /* 67 */ + OP_TYPEPOSUPTO, /* 68 */ + + OP_CRSTAR, /* 69 The maximizing and minimizing versions of */ + OP_CRMINSTAR, /* 70 all these opcodes must come in pairs, with */ + OP_CRPLUS, /* 71 the minimizing one second. These codes must */ + OP_CRMINPLUS, /* 72 be in exactly the same order as those above. */ + OP_CRQUERY, /* 73 These are for character classes and back refs */ + OP_CRMINQUERY, /* 74 */ + OP_CRRANGE, /* 75 These are different to the three sets above. */ + OP_CRMINRANGE, /* 76 */ + + OP_CLASS, /* 77 Match a character class, chars < 256 only */ + OP_NCLASS, /* 78 Same, but the bitmap was created from a negative + class - the difference is relevant only when a UTF-8 + character > 255 is encountered. */ + + OP_XCLASS, /* 79 Extended class for handling UTF-8 chars within the + class. This does both positive and negative. */ + + OP_REF, /* 80 Match a back reference */ + OP_RECURSE, /* 81 Match a numbered subpattern (possibly recursive) */ + OP_CALLOUT, /* 82 Call out to external function if provided */ + + OP_ALT, /* 83 Start of alternation */ + OP_KET, /* 84 End of group that doesn't have an unbounded repeat */ + OP_KETRMAX, /* 85 These two must remain together and in this */ + OP_KETRMIN, /* 86 order. They are for groups the repeat for ever. */ + + /* The assertions must come before BRA, CBRA, ONCE, and COND.*/ + + OP_ASSERT, /* 87 Positive lookahead */ + OP_ASSERT_NOT, /* 88 Negative lookahead */ + OP_ASSERTBACK, /* 89 Positive lookbehind */ + OP_ASSERTBACK_NOT, /* 90 Negative lookbehind */ + OP_REVERSE, /* 91 Move pointer back - used in lookbehind assertions */ + + /* ONCE, BRA, CBRA, and COND must come after the assertions, with ONCE first, + as there's a test for >= ONCE for a subpattern that isn't an assertion. */ + + OP_ONCE, /* 92 Atomic group */ + OP_BRA, /* 93 Start of non-capturing bracket */ + OP_CBRA, /* 94 Start of capturing bracket */ + OP_COND, /* 95 Conditional group */ + + /* These three must follow the previous three, in the same order. There's a + check for >= SBRA to distinguish the two sets. */ + + OP_SBRA, /* 96 Start of non-capturing bracket, check empty */ + OP_SCBRA, /* 97 Start of capturing bracket, check empty */ + OP_SCOND, /* 98 Conditional group, check empty */ + + OP_CREF, /* 99 Used to hold a capture number as condition */ + OP_RREF, /* 100 Used to hold a recursion number as condition */ + OP_DEF, /* 101 The DEFINE condition */ + + OP_BRAZERO, /* 102 These two must remain together and in this */ + OP_BRAMINZERO, /* 103 order. */ + + /* These are backtracking control verbs */ + + OP_PRUNE, /* 104 */ + OP_SKIP, /* 105 */ + OP_THEN, /* 106 */ + OP_COMMIT, /* 107 */ + + /* These are forced failure and success verbs */ + + OP_FAIL, /* 108 */ + OP_ACCEPT /* 109 */ +}; + + +/* This macro defines textual names for all the opcodes. These are used only +for debugging. The macro is referenced only in pcre_printint.c. */ + +#define OP_NAME_LIST \ + "End", "\\A", "\\G", "\\K", "\\B", "\\b", "\\D", "\\d", \ + "\\S", "\\s", "\\W", "\\w", "Any", "Anybyte", \ + "notprop", "prop", "\\R", "\\H", "\\h", "\\V", "\\v", \ + "extuni", "\\Z", "\\z", \ + "Opt", "^", "$", "char", "charnc", "not", \ + "*", "*?", "+", "+?", "?", "??", "{", "{", "{", \ + "*+","++", "?+", "{", \ + "*", "*?", "+", "+?", "?", "??", "{", "{", "{", \ + "*+","++", "?+", "{", \ + "*", "*?", "+", "+?", "?", "??", "{", "{", "{", \ + "*+","++", "?+", "{", \ + "*", "*?", "+", "+?", "?", "??", "{", "{", \ + "class", "nclass", "xclass", "Ref", "Recurse", "Callout", \ + "Alt", "Ket", "KetRmax", "KetRmin", "Assert", "Assert not", \ + "AssertB", "AssertB not", "Reverse", \ + "Once", "Bra", "CBra", "Cond", "SBra", "SCBra", "SCond", \ + "Cond ref", "Cond rec", "Cond def", "Brazero", "Braminzero", \ + "*PRUNE", "*SKIP", "*THEN", "*COMMIT", "*FAIL", "*ACCEPT" + + +/* This macro defines the length of fixed length operations in the compiled +regex. The lengths are used when searching for specific things, and also in the +debugging printing of a compiled regex. We use a macro so that it can be +defined close to the definitions of the opcodes themselves. + +As things have been extended, some of these are no longer fixed lenths, but are +minima instead. For example, the length of a single-character repeat may vary +in UTF-8 mode. The code that uses this table must know about such things. */ + +#define OP_LENGTHS \ + 1, /* End */ \ + 1, 1, 1, 1, 1, /* \A, \G, \K, \B, \b */ \ + 1, 1, 1, 1, 1, 1, /* \D, \d, \S, \s, \W, \w */ \ + 1, 1, /* Any, Anybyte */ \ + 3, 3, 1, /* NOTPROP, PROP, EXTUNI */ \ + 1, 1, 1, 1, 1, /* \R, \H, \h, \V, \v */ \ + 1, 1, 2, 1, 1, /* \Z, \z, Opt, ^, $ */ \ + 2, /* Char - the minimum length */ \ + 2, /* Charnc - the minimum length */ \ + 2, /* not */ \ + /* Positive single-char repeats ** These are */ \ + 2, 2, 2, 2, 2, 2, /* *, *?, +, +?, ?, ?? ** minima in */ \ + 4, 4, 4, /* upto, minupto, exact ** UTF-8 mode */ \ + 2, 2, 2, 4, /* *+, ++, ?+, upto+ */ \ + /* Negative single-char repeats - only for chars < 256 */ \ + 2, 2, 2, 2, 2, 2, /* NOT *, *?, +, +?, ?, ?? */ \ + 4, 4, 4, /* NOT upto, minupto, exact */ \ + 2, 2, 2, 4, /* Possessive *, +, ?, upto */ \ + /* Positive type repeats */ \ + 2, 2, 2, 2, 2, 2, /* Type *, *?, +, +?, ?, ?? */ \ + 4, 4, 4, /* Type upto, minupto, exact */ \ + 2, 2, 2, 4, /* Possessive *+, ++, ?+, upto+ */ \ + /* Character class & ref repeats */ \ + 1, 1, 1, 1, 1, 1, /* *, *?, +, +?, ?, ?? */ \ + 5, 5, /* CRRANGE, CRMINRANGE */ \ + 33, /* CLASS */ \ + 33, /* NCLASS */ \ + 0, /* XCLASS - variable length */ \ + 3, /* REF */ \ + 1+LINK_SIZE, /* RECURSE */ \ + 2+2*LINK_SIZE, /* CALLOUT */ \ + 1+LINK_SIZE, /* Alt */ \ + 1+LINK_SIZE, /* Ket */ \ + 1+LINK_SIZE, /* KetRmax */ \ + 1+LINK_SIZE, /* KetRmin */ \ + 1+LINK_SIZE, /* Assert */ \ + 1+LINK_SIZE, /* Assert not */ \ + 1+LINK_SIZE, /* Assert behind */ \ + 1+LINK_SIZE, /* Assert behind not */ \ + 1+LINK_SIZE, /* Reverse */ \ + 1+LINK_SIZE, /* ONCE */ \ + 1+LINK_SIZE, /* BRA */ \ + 3+LINK_SIZE, /* CBRA */ \ + 1+LINK_SIZE, /* COND */ \ + 1+LINK_SIZE, /* SBRA */ \ + 3+LINK_SIZE, /* SCBRA */ \ + 1+LINK_SIZE, /* SCOND */ \ + 3, /* CREF */ \ + 3, /* RREF */ \ + 1, /* DEF */ \ + 1, 1, /* BRAZERO, BRAMINZERO */ \ + 1, 1, 1, 1, /* PRUNE, SKIP, THEN, COMMIT, */ \ + 1, 1 /* FAIL, ACCEPT */ + + +/* A magic value for OP_RREF to indicate the "any recursion" condition. */ + +#define RREF_ANY 0xffff + +/* Error code numbers. They are given names so that they can more easily be +tracked. */ + +enum { ERR0, ERR1, ERR2, ERR3, ERR4, ERR5, ERR6, ERR7, ERR8, ERR9, + ERR10, ERR11, ERR12, ERR13, ERR14, ERR15, ERR16, ERR17, ERR18, ERR19, + ERR20, ERR21, ERR22, ERR23, ERR24, ERR25, ERR26, ERR27, ERR28, ERR29, + ERR30, ERR31, ERR32, ERR33, ERR34, ERR35, ERR36, ERR37, ERR38, ERR39, + ERR40, ERR41, ERR42, ERR43, ERR44, ERR45, ERR46, ERR47, ERR48, ERR49, + ERR50, ERR51, ERR52, ERR53, ERR54, ERR55, ERR56, ERR57, ERR58, ERR59, + ERR60, ERR61, ERR62, ERR63 }; + +/* The real format of the start of the pcre block; the index of names and the +code vector run on as long as necessary after the end. We store an explicit +offset to the name table so that if a regex is compiled on one host, saved, and +then run on another where the size of pointers is different, all might still +be well. For the case of compiled-on-4 and run-on-8, we include an extra +pointer that is always NULL. For future-proofing, a few dummy fields were +originally included - even though you can never get this planning right - but +there is only one left now. + +NOTE NOTE NOTE: +Because people can now save and re-use compiled patterns, any additions to this +structure should be made at the end, and something earlier (e.g. a new +flag in the options or one of the dummy fields) should indicate that the new +fields are present. Currently PCRE always sets the dummy fields to zero. +NOTE NOTE NOTE: +*/ + +typedef struct real_pcre { + pcre_uint32 magic_number; + pcre_uint32 size; /* Total that was malloced */ + pcre_uint32 options; /* Public options */ + pcre_uint16 flags; /* Private flags */ + pcre_uint16 dummy1; /* For future use */ + pcre_uint16 top_bracket; + pcre_uint16 top_backref; + pcre_uint16 first_byte; + pcre_uint16 req_byte; + pcre_uint16 name_table_offset; /* Offset to name table that follows */ + pcre_uint16 name_entry_size; /* Size of any name items */ + pcre_uint16 name_count; /* Number of name items */ + pcre_uint16 ref_count; /* Reference count */ + + const unsigned char *tables; /* Pointer to tables or NULL for std */ + const unsigned char *nullpad; /* NULL padding */ +} real_pcre; + +/* The format of the block used to store data from pcre_study(). The same +remark (see NOTE above) about extending this structure applies. */ + +typedef struct pcre_study_data { + pcre_uint32 size; /* Total that was malloced */ + pcre_uint32 options; + uschar start_bits[32]; +} pcre_study_data; + +/* Structure for passing "static" information around between the functions +doing the compiling, so that they are thread-safe. */ + +typedef struct compile_data { + const uschar *lcc; /* Points to lower casing table */ + const uschar *fcc; /* Points to case-flipping table */ + const uschar *cbits; /* Points to character type table */ + const uschar *ctypes; /* Points to table of type maps */ + const uschar *start_workspace;/* The start of working space */ + const uschar *start_code; /* The start of the compiled code */ + const uschar *start_pattern; /* The start of the pattern */ + const uschar *end_pattern; /* The end of the pattern */ + uschar *hwm; /* High watermark of workspace */ + uschar *name_table; /* The name/number table */ + int names_found; /* Number of entries so far */ + int name_entry_size; /* Size of each entry */ + int bracount; /* Count of capturing parens as we compile */ + int final_bracount; /* Saved value after first pass */ + int top_backref; /* Maximum back reference */ + unsigned int backref_map; /* Bitmap of low back refs */ + int external_options; /* External (initial) options */ + int external_flags; /* External flag bits to be set */ + int req_varyopt; /* "After variable item" flag for reqbyte */ + BOOL had_accept; /* (*ACCEPT) encountered */ + int nltype; /* Newline type */ + int nllen; /* Newline string length */ + uschar nl[4]; /* Newline string when fixed length */ +} compile_data; + +/* Structure for maintaining a chain of pointers to the currently incomplete +branches, for testing for left recursion. */ + +typedef struct branch_chain { + struct branch_chain *outer; + uschar *current; +} branch_chain; + +/* Structure for items in a linked list that represents an explicit recursive +call within the pattern. */ + +typedef struct recursion_info { + struct recursion_info *prevrec; /* Previous recursion record (or NULL) */ + int group_num; /* Number of group that was called */ + const uschar *after_call; /* "Return value": points after the call in the expr */ + USPTR save_start; /* Old value of mstart */ + int *offset_save; /* Pointer to start of saved offsets */ + int saved_max; /* Number of saved offsets */ +} recursion_info; + +/* Structure for building a chain of data for holding the values of the subject +pointer at the start of each subpattern, so as to detect when an empty string +has been matched by a subpattern - to break infinite loops. */ + +typedef struct eptrblock { + struct eptrblock *epb_prev; + USPTR epb_saved_eptr; +} eptrblock; + + +/* Structure for passing "static" information around between the functions +doing traditional NFA matching, so that they are thread-safe. */ + +typedef struct match_data { +#ifdef ERLANG_INTEGRATION + unsigned long int loop_limit; + void *state_save; +#endif + unsigned long int match_call_count; /* As it says */ + unsigned long int match_limit; /* As it says */ + unsigned long int match_limit_recursion; /* As it says */ + int *offset_vector; /* Offset vector */ + int offset_end; /* One past the end */ + int offset_max; /* The maximum usable for return data */ + int nltype; /* Newline type */ + int nllen; /* Newline string length */ + uschar nl[4]; /* Newline string when fixed */ + const uschar *lcc; /* Points to lower casing table */ + const uschar *ctypes; /* Points to table of type maps */ + BOOL offset_overflow; /* Set if too many extractions */ + BOOL notbol; /* NOTBOL flag */ + BOOL noteol; /* NOTEOL flag */ + BOOL utf8; /* UTF8 flag */ + BOOL endonly; /* Dollar not before final \n */ + BOOL notempty; /* Empty string match not wanted */ + BOOL partial; /* PARTIAL flag */ + BOOL hitend; /* Hit the end of the subject at some point */ + BOOL bsr_anycrlf; /* \R is just any CRLF, not full Unicode */ + const uschar *start_code; /* For use when recursing */ + USPTR start_subject; /* Start of the subject string */ + USPTR end_subject; /* End of the subject string */ + USPTR start_match_ptr; /* Start of matched string */ + USPTR end_match_ptr; /* Subject position at end match */ + int end_offset_top; /* Highwater mark at end of match */ + int capture_last; /* Most recent capture number */ + int start_offset; /* The start offset value */ + eptrblock *eptrchain; /* Chain of eptrblocks for tail recursions */ + int eptrn; /* Next free eptrblock */ + recursion_info *recursive; /* Linked list of recursion data */ + void *callout_data; /* To pass back to callouts */ +} match_data; + +/* A similar structure is used for the same purpose by the DFA matching +functions. */ + +typedef struct dfa_match_data { + const uschar *start_code; /* Start of the compiled pattern */ + const uschar *start_subject; /* Start of the subject string */ + const uschar *end_subject; /* End of subject string */ + const uschar *tables; /* Character tables */ + int moptions; /* Match options */ + int poptions; /* Pattern options */ + int nltype; /* Newline type */ + int nllen; /* Newline string length */ + uschar nl[4]; /* Newline string when fixed */ + void *callout_data; /* To pass back to callouts */ +} dfa_match_data; + +/* Bit definitions for entries in the pcre_ctypes table. */ + +#define ctype_space 0x01 +#define ctype_letter 0x02 +#define ctype_digit 0x04 +#define ctype_xdigit 0x08 +#define ctype_word 0x10 /* alphanumeric or '_' */ +#define ctype_meta 0x80 /* regexp meta char or zero (end pattern) */ + +/* Offsets for the bitmap tables in pcre_cbits. Each table contains a set +of bits for a class map. Some classes are built by combining these tables. */ + +#define cbit_space 0 /* [:space:] or \s */ +#define cbit_xdigit 32 /* [:xdigit:] */ +#define cbit_digit 64 /* [:digit:] or \d */ +#define cbit_upper 96 /* [:upper:] */ +#define cbit_lower 128 /* [:lower:] */ +#define cbit_word 160 /* [:word:] or \w */ +#define cbit_graph 192 /* [:graph:] */ +#define cbit_print 224 /* [:print:] */ +#define cbit_punct 256 /* [:punct:] */ +#define cbit_cntrl 288 /* [:cntrl:] */ +#define cbit_length 320 /* Length of the cbits table */ + +/* Offsets of the various tables from the base tables pointer, and +total length. */ + +#define lcc_offset 0 +#define fcc_offset 256 +#define cbits_offset 512 +#define ctypes_offset (cbits_offset + cbit_length) +#define tables_length (ctypes_offset + 256) + +/* Layout of the UCP type table that translates property names into types and +codes. Each entry used to point directly to a name, but to reduce the number of +relocations in shared libraries, it now has an offset into a single string +instead. */ + +typedef struct { + pcre_uint16 name_offset; + pcre_uint16 type; + pcre_uint16 value; +} ucp_type_table; + + +/* Internal shared data tables. These are tables that are used by more than one +of the exported public functions. They have to be "external" in the C sense, +but are not part of the PCRE public API. The data for these tables is in the +pcre_tables.c module. */ + +extern const int _erts_pcre_utf8_table1[]; +extern const int _erts_pcre_utf8_table2[]; +extern const int _erts_pcre_utf8_table3[]; +extern const uschar _erts_pcre_utf8_table4[]; + +extern const int _erts_pcre_utf8_table1_size; + +extern const char _erts_pcre_utt_names[]; +extern const ucp_type_table _erts_pcre_utt[]; +extern const int _erts_pcre_utt_size; + +extern const uschar _erts_pcre_default_tables[]; + +extern const uschar _erts_pcre_OP_lengths[]; + + +/* Internal shared functions. These are functions that are used by more than +one of the exported public functions. They have to be "external" in the C +sense, but are not part of the PCRE public API. */ + +extern BOOL _erts_pcre_is_newline(const uschar *, int, const uschar *, + int *, BOOL); +extern int _erts_pcre_ord2utf8(int, uschar *); +extern real_pcre *_erts_pcre_try_flipped(const real_pcre *, real_pcre *, + const pcre_study_data *, pcre_study_data *); +extern int _erts_pcre_ucp_findprop(const unsigned int, int *, int *); +extern unsigned int _erts_pcre_ucp_othercase(const unsigned int); +extern int _erts_pcre_valid_utf8(const uschar *, int); +extern BOOL _erts_pcre_was_newline(const uschar *, int, const uschar *, + int *, BOOL); +extern BOOL _erts_pcre_xclass(int, const uschar *); + +#endif + +/* End of pcre_internal.h */ diff --git a/erts/emulator/pcre/pcre_latin_1_table.c b/erts/emulator/pcre/pcre_latin_1_table.c new file mode 100644 index 0000000000..69d888026b --- /dev/null +++ b/erts/emulator/pcre/pcre_latin_1_table.c @@ -0,0 +1,193 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* This file was automatically written by the make_latin1_table auxiliary +program. It contains character tables that are used when no external +tables are passed to PCRE by the application that calls it. The tables +are used only for characters whose code values are less than 256. + +The following #includes are present because without them gcc 4.x may remove +the array definition from the final binary if PCRE is built into a static +library and dead code stripping is activated. This leads to link errors. +Pulling in the header ensures that the array gets flagged as "someone +outside this compilation unit might reference this" and so it will always +be supplied to the linker. */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + +const unsigned char _erts_pcre_default_tables[] = { + +/* This table is a lower casing table. */ + + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 97, 98, 99,100,101,102,103, + 104,105,106,107,108,109,110,111, + 112,113,114,115,116,117,118,119, + 120,121,122, 91, 92, 93, 94, 95, + 96, 97, 98, 99,100,101,102,103, + 104,105,106,107,108,109,110,111, + 112,113,114,115,116,117,118,119, + 120,121,122,123,124,125,126,127, + 128,129,130,131,132,133,134,135, + 136,137,138,139,140,141,142,143, + 144,145,146,147,148,149,150,151, + 152,153,154,155,156,157,158,159, + 160,161,162,163,164,165,166,167, + 168,169,170,171,172,173,174,175, + 176,177,178,179,180,181,182,183, + 184,185,186,187,188,189,190,191, + 224,225,226,227,228,229,230,231, + 232,233,234,235,236,237,238,239, + 240,241,242,243,244,245,246,215, + 248,249,250,251,252,253,254,223, + 224,225,226,227,228,229,230,231, + 232,233,234,235,236,237,238,239, + 240,241,242,243,244,245,246,247, + 248,249,250,251,252,253,254,255, + +/* This table is a case flipping table. */ + + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, + 64, 97, 98, 99,100,101,102,103, + 104,105,106,107,108,109,110,111, + 112,113,114,115,116,117,118,119, + 120,121,122, 91, 92, 93, 94, 95, + 96, 65, 66, 67, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, + 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90,123,124,125,126,127, + 128,129,130,131,132,133,134,135, + 136,137,138,139,140,141,142,143, + 144,145,146,147,148,149,150,151, + 152,153,154,155,156,157,158,159, + 160,161,162,163,164,165,166,167, + 168,169,170,171,172,173,174,175, + 176,177,178,179,180,181,182,183, + 184,185,186,187,188,189,190,191, + 224,225,226,227,228,229,230,231, + 232,233,234,235,236,237,238,239, + 240,241,242,243,244,245,246,215, + 248,249,250,251,252,253,254,223, + 192,193,194,195,196,197,198,199, + 200,201,202,203,204,205,206,207, + 208,209,210,211,212,213,214,247, + 216,217,218,219,220,221,222,255, + +/* This table contains bit maps for various character classes. +Each map is 32 bytes long and the bits run from the least +significant end of each byte. The classes that have their own +maps are: space, xdigit, digit, upper, lower, word, graph +print, punct, and cntrl. Other classes are built from combinations. */ + + 0x00,0x3e,0x00,0x00,0x01,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x03, + 0x7e,0x00,0x00,0x00,0x7e,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x03, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xfe,0xff,0xff,0x07,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0xff,0xff,0x7f,0x7f,0x00,0x00,0x00,0x00, + + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x00, + 0x00,0x00,0x00,0x80,0xff,0xff,0x7f,0xff, + + 0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x03, + 0xfe,0xff,0xff,0x87,0xfe,0xff,0xff,0x07, + 0x00,0x00,0x00,0x00,0x00,0x04,0x20,0x04, + 0xff,0xff,0x7f,0xff,0xff,0xff,0x7f,0xff, + + 0x00,0x00,0x00,0x00,0xfe,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, + 0x00,0x00,0x00,0x00,0xff,0xff,0xff,0xff, + 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, + + 0x00,0x00,0x00,0x00,0xfe,0xff,0x00,0xfc, + 0x01,0x00,0x00,0xf8,0x01,0x00,0x00,0x78, + 0x00,0x00,0x00,0x00,0xff,0xfb,0xdf,0xfb, + 0x00,0x00,0x80,0x00,0x00,0x00,0x80,0x00, + + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80, + 0xff,0xff,0xff,0xff,0x00,0x00,0x00,0x00, + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, + +/* This table identifies various classes of character by individual bits: + 0x01 white space character + 0x02 letter + 0x04 decimal digit + 0x08 hexadecimal digit + 0x10 alphanumeric or '_' + 0x80 regular expression metacharacter or binary zero +*/ + + 0x80,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 0- 7 */ + 0x00,0x01,0x01,0x00,0x01,0x01,0x00,0x00, /* 8- 15 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 16- 23 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 24- 31 */ + 0x01,0x00,0x00,0x00,0x80,0x00,0x00,0x00, /* - ' */ + 0x80,0x80,0x80,0x80,0x00,0x00,0x80,0x00, /* ( - / */ + 0x1c,0x1c,0x1c,0x1c,0x1c,0x1c,0x1c,0x1c, /* 0 - 7 */ + 0x1c,0x1c,0x00,0x00,0x00,0x00,0x00,0x80, /* 8 - ? */ + 0x00,0x1a,0x1a,0x1a,0x1a,0x1a,0x1a,0x12, /* @ - G */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* H - O */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* P - W */ + 0x12,0x12,0x12,0x80,0x80,0x00,0x80,0x10, /* X - _ */ + 0x00,0x1a,0x1a,0x1a,0x1a,0x1a,0x1a,0x12, /* ` - g */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* h - o */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* p - w */ + 0x12,0x12,0x12,0x80,0x80,0x00,0x00,0x00, /* x -127 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 128-135 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 136-143 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 144-151 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /* 152-159 */ + 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00, /*   - § */ + 0x00,0x00,0x12,0x00,0x00,0x00,0x00,0x00, /* ¨ - ¯ */ + 0x00,0x00,0x00,0x00,0x00,0x12,0x00,0x00, /* ° - · */ + 0x00,0x00,0x12,0x00,0x00,0x00,0x00,0x00, /* ¸ - ¿ */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* À - Ç */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* È - Ï */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x00, /* Ð - × */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* Ø - ß */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* à - ç */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12, /* è - ï */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x00, /* ð - ÷ */ + 0x12,0x12,0x12,0x12,0x12,0x12,0x12,0x12};/* ø - ÿ */ + +/* End of pcre_chartables.c */ diff --git a/erts/emulator/pcre/pcre_make_latin1_default.c b/erts/emulator/pcre/pcre_make_latin1_default.c new file mode 100644 index 0000000000..b8a8062764 --- /dev/null +++ b/erts/emulator/pcre/pcre_make_latin1_default.c @@ -0,0 +1,367 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ +/* This is a "hacked" version of pcre_maketables that + * will generate an acceptable character table for any + * iso-latin-1 language when running in 8-bit mode. + */ + + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + +/* %ExternalCopyright% */ + +/* This module contains the external function pcre_maketables(), which builds +character tables for PCRE in the current locale. The file is compiled on its +own as part of the PCRE library. However, it is also included in the +compilation of dftables.c, in which case the macro DFTABLES is defined. */ + + +#ifndef DFTABLES +# ifdef HAVE_CONFIG_H +# include "config.h" +# endif +# include "pcre_internal.h" +#endif + + +/************************************************* +* Create PCRE character tables * +*************************************************/ + +/* This function builds a set of character tables for use by PCRE and returns +a pointer to them. They are build using the ctype functions, and consequently +their contents will depend upon the current locale setting. When compiled as +part of the library, the store is obtained via pcre_malloc(), but when compiled +inside dftables, use malloc(). + +Arguments: none +Returns: pointer to the contiguous block of data +*/ + +typedef struct { + int is_alpha,is_upper,is_lower,is_alnum,is_space,is_xdigit,is_graph,is_punct,is_cntrl; + int upcase; + int lowcase; +} HiCharProp; + +static HiCharProp hicharprop[] = { + {0,0,0,0,0,0,1,1,0, 0,0}, /* 160 NO-BREAK SPACE */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 161 ¡ INVERTED EXCLAMATION MARK */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 162 ¢ CENT SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 163 £ POUND SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 164 ¤ CURRENCY SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 165 ¥ YEN SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 166 ¦ BROKEN BAR */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 167 § SECTION SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 168 ¨ DIAERESIS */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 169 © COPYRIGHT SIGN */ + {1,0,0,1,0,0,1,0,0, 0,0}, /* 170 ª FEMININE ORDINAL INDICATOR */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 171 « LEFT-POINTING DOUBLE ANGLE QUOTATION MARK */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 172 ¬ NOT SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 173 ­ SOFT HYPHEN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 174 ® REGISTERED SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 175 ¯ MACRON */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 176 ° DEGREE SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 177 ± PLUS-MINUS SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 178 ² SUPERSCRIPT TWO */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 179 ³ SUPERSCRIPT THREE */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 180 ´ ACUTE ACCENT */ + {1,0,1,1,0,0,1,0,0, 0,0}, /* 181 µ MICRO SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 182 ¶ PILCROW SIGN */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 183 · MIDDLE DOT */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 184 ¸ CEDILLA */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 185 ¹ SUPERSCRIPT ONE */ + {1,0,0,1,0,0,1,0,0, 0,0}, /* 186 º MASCULINE ORDINAL INDICATOR */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 187 » RIGHT-POINTING DOUBLE ANGLE QUOTATION MARK */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 188 ¼ VULGAR FRACTION ONE QUARTER */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 189 ½ VULGAR FRACTION ONE HALF */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 190 ¾ VULGAR FRACTION THREE QUARTERS */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 191 ¿ INVERTED QUESTION MARK */ + {1,1,0,1,0,0,1,0,0, 0,224}, /* 192 À LATIN CAPITAL LETTER A WITH GRAVE */ + {1,1,0,1,0,0,1,0,0, 0,225}, /* 193 Á LATIN CAPITAL LETTER A WITH ACUTE */ + {1,1,0,1,0,0,1,0,0, 0,226}, /* 194 Â LATIN CAPITAL LETTER A WITH CIRCUMFLEX */ + {1,1,0,1,0,0,1,0,0, 0,227}, /* 195 Ã LATIN CAPITAL LETTER A WITH TILDE */ + {1,1,0,1,0,0,1,0,0, 0,228}, /* 196 Ä LATIN CAPITAL LETTER A WITH DIAERESIS */ + {1,1,0,1,0,0,1,0,0, 0,229}, /* 197 Å LATIN CAPITAL LETTER A WITH RING ABOVE */ + {1,1,0,1,0,0,1,0,0, 0,230}, /* 198 Æ LATIN CAPITAL LETTER AE */ + {1,1,0,1,0,0,1,0,0, 0,231}, /* 199 Ç LATIN CAPITAL LETTER C WITH CEDILLA */ + {1,1,0,1,0,0,1,0,0, 0,232}, /* 200 È LATIN CAPITAL LETTER E WITH GRAVE */ + {1,1,0,1,0,0,1,0,0, 0,233}, /* 201 É LATIN CAPITAL LETTER E WITH ACUTE */ + {1,1,0,1,0,0,1,0,0, 0,234}, /* 202 Ê LATIN CAPITAL LETTER E WITH CIRCUMFLEX */ + {1,1,0,1,0,0,1,0,0, 0,235}, /* 203 Ë LATIN CAPITAL LETTER E WITH DIAERESIS */ + {1,1,0,1,0,0,1,0,0, 0,236}, /* 204 Ì LATIN CAPITAL LETTER I WITH GRAVE */ + {1,1,0,1,0,0,1,0,0, 0,237}, /* 205 Í LATIN CAPITAL LETTER I WITH ACUTE */ + {1,1,0,1,0,0,1,0,0, 0,238}, /* 206 Î LATIN CAPITAL LETTER I WITH CIRCUMFLEX */ + {1,1,0,1,0,0,1,0,0, 0,239}, /* 207 Ï LATIN CAPITAL LETTER I WITH DIAERESIS */ + {1,1,0,1,0,0,1,0,0, 0,240}, /* 208 Ð LATIN CAPITAL LETTER ETH */ + {1,1,0,1,0,0,1,0,0, 0,241}, /* 209 Ñ LATIN CAPITAL LETTER N WITH TILDE */ + {1,1,0,1,0,0,1,0,0, 0,242}, /* 210 Ò LATIN CAPITAL LETTER O WITH GRAVE */ + {1,1,0,1,0,0,1,0,0, 0,243}, /* 211 Ó LATIN CAPITAL LETTER O WITH ACUTE */ + {1,1,0,1,0,0,1,0,0, 0,244}, /* 212 Ô LATIN CAPITAL LETTER O WITH CIRCUMFLEX */ + {1,1,0,1,0,0,1,0,0, 0,245}, /* 213 Õ LATIN CAPITAL LETTER O WITH TILDE */ + {1,1,0,1,0,0,1,0,0, 0,246}, /* 214 Ö LATIN CAPITAL LETTER O WITH DIAERESIS */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 215 × MULTIPLICATION SIGN */ + {1,1,0,1,0,0,1,0,0, 0,248}, /* 216 Ø LATIN CAPITAL LETTER O WITH STROKE */ + {1,1,0,1,0,0,1,0,0, 0,249}, /* 217 Ù LATIN CAPITAL LETTER U WITH GRAVE */ + {1,1,0,1,0,0,1,0,0, 0,250}, /* 218 Ú LATIN CAPITAL LETTER U WITH ACUTE */ + {1,1,0,1,0,0,1,0,0, 0,251}, /* 219 Û LATIN CAPITAL LETTER U WITH CIRCUMFLEX */ + {1,1,0,1,0,0,1,0,0, 0,252}, /* 220 Ü LATIN CAPITAL LETTER U WITH DIAERESIS */ + {1,1,0,1,0,0,1,0,0, 0,253}, /* 221 Ý LATIN CAPITAL LETTER Y WITH ACUTE */ + {1,1,0,1,0,0,1,0,0, 0,254}, /* 222 Þ LATIN CAPITAL LETTER THORN */ + {1,0,1,1,0,0,1,0,0, 223,0}, /* 223 ß LATIN SMALL LETTER SHARP S Ouch! */ + {1,0,1,1,0,0,1,0,0, 192,0}, /* 224 à LATIN SMALL LETTER A WITH GRAVE */ + {1,0,1,1,0,0,1,0,0, 193,0}, /* 225 á LATIN SMALL LETTER A WITH ACUTE */ + {1,0,1,1,0,0,1,0,0, 194,0}, /* 226 â LATIN SMALL LETTER A WITH CIRCUMFLEX */ + {1,0,1,1,0,0,1,0,0, 195,0}, /* 227 ã LATIN SMALL LETTER A WITH TILDE */ + {1,0,1,1,0,0,1,0,0, 196,0}, /* 228 ä LATIN SMALL LETTER A WITH DIAERESIS */ + {1,0,1,1,0,0,1,0,0, 197,0}, /* 229 å LATIN SMALL LETTER A WITH RING ABOVE */ + {1,0,1,1,0,0,1,0,0, 198,0}, /* 230 æ LATIN SMALL LETTER AE */ + {1,0,1,1,0,0,1,0,0, 199,0}, /* 231 ç LATIN SMALL LETTER C WITH CEDILLA */ + {1,0,1,1,0,0,1,0,0, 200,0}, /* 232 è LATIN SMALL LETTER E WITH GRAVE */ + {1,0,1,1,0,0,1,0,0, 201,0}, /* 233 é LATIN SMALL LETTER E WITH ACUTE */ + {1,0,1,1,0,0,1,0,0, 202,0}, /* 234 ê LATIN SMALL LETTER E WITH CIRCUMFLEX */ + {1,0,1,1,0,0,1,0,0, 203,0}, /* 235 ë LATIN SMALL LETTER E WITH DIAERESIS */ + {1,0,1,1,0,0,1,0,0, 204,0}, /* 236 ì LATIN SMALL LETTER I WITH GRAVE */ + {1,0,1,1,0,0,1,0,0, 205,0}, /* 237 í LATIN SMALL LETTER I WITH ACUTE */ + {1,0,1,1,0,0,1,0,0, 206,0}, /* 238 î LATIN SMALL LETTER I WITH CIRCUMFLEX */ + {1,0,1,1,0,0,1,0,0, 207,0}, /* 239 ï LATIN SMALL LETTER I WITH DIAERESIS */ + {1,0,1,1,0,0,1,0,0, 208,0}, /* 240 ð LATIN SMALL LETTER ETH */ + {1,0,1,1,0,0,1,0,0, 209,0}, /* 241 ñ LATIN SMALL LETTER N WITH TILDE */ + {1,0,1,1,0,0,1,0,0, 210,0}, /* 242 ò LATIN SMALL LETTER O WITH GRAVE */ + {1,0,1,1,0,0,1,0,0, 211,0}, /* 243 ó LATIN SMALL LETTER O WITH ACUTE */ + {1,0,1,1,0,0,1,0,0, 212,0}, /* 244 ô LATIN SMALL LETTER O WITH CIRCUMFLEX */ + {1,0,1,1,0,0,1,0,0, 213,0}, /* 245 õ LATIN SMALL LETTER O WITH TILDE */ + {1,0,1,1,0,0,1,0,0, 214,0}, /* 246 ö LATIN SMALL LETTER O WITH DIAERESIS */ + {0,0,0,0,0,0,1,1,0, 0,0}, /* 247 ÷ DIVISION SIGN */ + {1,0,1,1,0,0,1,0,0, 216,0}, /* 248 ø LATIN SMALL LETTER O WITH STROKE */ + {1,0,1,1,0,0,1,0,0, 217,0}, /* 249 ù LATIN SMALL LETTER U WITH GRAVE */ + {1,0,1,1,0,0,1,0,0, 218,0}, /* 250 ú LATIN SMALL LETTER U WITH ACUTE */ + {1,0,1,1,0,0,1,0,0, 219,0}, /* 251 û LATIN SMALL LETTER U WITH CIRCUMFLEX */ + {1,0,1,1,0,0,1,0,0, 220,0}, /* 252 ü LATIN SMALL LETTER U WITH DIAERESIS */ + {1,0,1,1,0,0,1,0,0, 221,0}, /* 253 ý LATIN SMALL LETTER Y WITH ACUTE */ + {1,0,1,1,0,0,1,0,0, 222,0}, /* 254 þ LATIN SMALL LETTER THORN */ + {1,0,1,1,0,0,1,0,0, 255,0}}; /* 255 ÿ LATIN SMALL LETTER Y WITH DIAERESIS */ + + +static int my_tolower(int x) { + if (x < 128) + return tolower(x); + else if (x < 160) + return x; + else if (hicharprop[x - 160].lowcase == 0) + return x; + else + return hicharprop[x - 160].lowcase; +} + +static int my_toupper(int x) { + if (x < 128) + return toupper(x); + else if (x < 160) + return x; + else if (hicharprop[x - 160].upcase == 0) + return x; + else + return hicharprop[x - 160].upcase; +} + +static int my_islower(int x) { + if (x < 128) + return islower(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_lower; +} + +static int my_isupper(int x) { + if (x < 128) + return isupper(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_upper; +} + +static int my_isdigit(int x) { + if (x < 128) + return isdigit(x); + else + return 0; +} + +static int my_isalpha(int x) { + if (x < 128) + return isalpha(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_alpha; +} + +static int my_isalnum(int x) { + if (x < 128) + return isalnum(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_alnum; +} + +static int my_isspace(int x) { + if (x < 128) + return isspace(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_space; +} + +static int my_isxdigit(int x) { + if (x < 128) + return isxdigit(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_xdigit; +} +static int my_isgraph(int x) { + if (x < 128) + return isgraph(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_graph; +} +static int my_isprint(int x) { + if (x < 128) + return isprint(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_graph | hicharprop[x - 160].is_space ; +} + +static int my_ispunct(int x) { + if (x < 128) + return ispunct(x); + else if (x < 160) + return 0; + else + return hicharprop[x - 160].is_punct; +} + + +static int my_iscntrl(int x) { + if (x < 128) + return iscntrl(x); + else if (x < 160) + return 1; + else + return hicharprop[x - 160].is_cntrl; +} +const unsigned char * +pcre_make_latin1_tables(void) +{ +unsigned char *yield, *p; +int i; + +yield = (unsigned char*)malloc(tables_length); + +if (yield == NULL) return NULL; +p = yield; + +/* First comes the lower casing table */ + +for (i = 0; i < 256; i++) *p++ = my_tolower(i); + +/* Next the case-flipping table */ + +for (i = 0; i < 256; i++) *p++ = my_islower(i)? my_toupper(i) : my_tolower(i); + +/* Then the character class tables. Don't try to be clever and save effort on +exclusive ones - in some locales things may be different. Note that the table +for "space" includes everything "isspace" gives, including VT in the default +locale. This makes it work for the POSIX class [:space:]. Note also that it is +possible for a character to be alnum or alpha without being lower or upper, +such as "male and female ordinals" (\xAA and \xBA) in the fr_FR locale (at +least under Debian Linux's locales as of 12/2005). So we must test for alnum +specially. */ + +memset(p, 0, cbit_length); +for (i = 0; i < 256; i++) + { + if (my_isdigit(i)) p[cbit_digit + i/8] |= 1 << (i&7); + if (my_isupper(i)) p[cbit_upper + i/8] |= 1 << (i&7); + if (my_islower(i)) p[cbit_lower + i/8] |= 1 << (i&7); + if (my_isalnum(i)) p[cbit_word + i/8] |= 1 << (i&7); + if (i == '_') p[cbit_word + i/8] |= 1 << (i&7); + if (my_isspace(i)) p[cbit_space + i/8] |= 1 << (i&7); + if (my_isxdigit(i))p[cbit_xdigit + i/8] |= 1 << (i&7); + if (my_isgraph(i)) p[cbit_graph + i/8] |= 1 << (i&7); + if (my_isprint(i)) p[cbit_print + i/8] |= 1 << (i&7); + if (my_ispunct(i)) p[cbit_punct + i/8] |= 1 << (i&7); + if (my_iscntrl(i)) p[cbit_cntrl + i/8] |= 1 << (i&7); + } +p += cbit_length; + +/* Finally, the character type table. In this, we exclude VT from the white +space chars, because Perl doesn't recognize it as such for \s and for comments +within regexes. */ + +for (i = 0; i < 256; i++) + { + int x = 0; + if (i != 0x0b && my_isspace(i)) x += ctype_space; + if (my_isalpha(i)) x += ctype_letter; + if (my_isdigit(i)) x += ctype_digit; + if (my_isxdigit(i)) x += ctype_xdigit; + if (my_isalnum(i) || i == '_') x += ctype_word; + + /* Note: strchr includes the terminating zero in the characters it considers. + In this instance, that is ok because we want binary zero to be flagged as a + meta-character, which in this sense is any character that terminates a run + of data characters. */ + + if (strchr("\\*+?{^.$|()[", i) != 0) x += ctype_meta; + *p++ = x; + } + +return yield; +} + +/* End of pcre_maketables.c */ diff --git a/erts/emulator/pcre/pcre_maketables.c b/erts/emulator/pcre/pcre_maketables.c new file mode 100644 index 0000000000..a695bb26ad --- /dev/null +++ b/erts/emulator/pcre/pcre_maketables.c @@ -0,0 +1,144 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_maketables(), which builds +character tables for PCRE in the current locale. The file is compiled on its +own as part of the PCRE library. However, it is also included in the +compilation of dftables.c, in which case the macro DFTABLES is defined. */ + +/* %ExternalCopyright% */ + +#ifndef DFTABLES +# ifdef HAVE_CONFIG_H +# include "config.h" +# endif +# include "pcre_internal.h" +#endif + + +/************************************************* +* Create PCRE character tables * +*************************************************/ + +/* This function builds a set of character tables for use by PCRE and returns +a pointer to them. They are build using the ctype functions, and consequently +their contents will depend upon the current locale setting. When compiled as +part of the library, the store is obtained via erts_pcre_malloc(), but when compiled +inside dftables, use malloc(). + +Arguments: none +Returns: pointer to the contiguous block of data +*/ + +const unsigned char * +erts_pcre_maketables(void) +{ +unsigned char *yield, *p; +int i; + +#ifndef DFTABLES +yield = (unsigned char*)(erts_pcre_malloc)(tables_length); +#else +yield = (unsigned char*)malloc(tables_length); +#endif + +if (yield == NULL) return NULL; +p = yield; + +/* First comes the lower casing table */ + +for (i = 0; i < 256; i++) *p++ = tolower(i); + +/* Next the case-flipping table */ + +for (i = 0; i < 256; i++) *p++ = islower(i)? toupper(i) : tolower(i); + +/* Then the character class tables. Don't try to be clever and save effort on +exclusive ones - in some locales things may be different. Note that the table +for "space" includes everything "isspace" gives, including VT in the default +locale. This makes it work for the POSIX class [:space:]. Note also that it is +possible for a character to be alnum or alpha without being lower or upper, +such as "male and female ordinals" (\xAA and \xBA) in the fr_FR locale (at +least under Debian Linux's locales as of 12/2005). So we must test for alnum +specially. */ + +memset(p, 0, cbit_length); +for (i = 0; i < 256; i++) + { + if (isdigit(i)) p[cbit_digit + i/8] |= 1 << (i&7); + if (isupper(i)) p[cbit_upper + i/8] |= 1 << (i&7); + if (islower(i)) p[cbit_lower + i/8] |= 1 << (i&7); + if (isalnum(i)) p[cbit_word + i/8] |= 1 << (i&7); + if (i == '_') p[cbit_word + i/8] |= 1 << (i&7); + if (isspace(i)) p[cbit_space + i/8] |= 1 << (i&7); + if (isxdigit(i))p[cbit_xdigit + i/8] |= 1 << (i&7); + if (isgraph(i)) p[cbit_graph + i/8] |= 1 << (i&7); + if (isprint(i)) p[cbit_print + i/8] |= 1 << (i&7); + if (ispunct(i)) p[cbit_punct + i/8] |= 1 << (i&7); + if (iscntrl(i)) p[cbit_cntrl + i/8] |= 1 << (i&7); + } +p += cbit_length; + +/* Finally, the character type table. In this, we exclude VT from the white +space chars, because Perl doesn't recognize it as such for \s and for comments +within regexes. */ + +for (i = 0; i < 256; i++) + { + int x = 0; + if (i != 0x0b && isspace(i)) x += ctype_space; + if (isalpha(i)) x += ctype_letter; + if (isdigit(i)) x += ctype_digit; + if (isxdigit(i)) x += ctype_xdigit; + if (isalnum(i) || i == '_') x += ctype_word; + + /* Note: strchr includes the terminating zero in the characters it considers. + In this instance, that is ok because we want binary zero to be flagged as a + meta-character, which in this sense is any character that terminates a run + of data characters. */ + + if (strchr("\\*+?{^.$|()[", i) != 0) x += ctype_meta; + *p++ = x; + } + +return yield; +} + +/* End of pcre_maketables.c */ diff --git a/erts/emulator/pcre/pcre_newline.c b/erts/emulator/pcre/pcre_newline.c new file mode 100644 index 0000000000..7dbda88aff --- /dev/null +++ b/erts/emulator/pcre/pcre_newline.c @@ -0,0 +1,165 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains internal functions for testing newlines when more than +one kind of newline is to be recognized. When a newline is found, its length is +returned. In principle, we could implement several newline "types", each +referring to a different set of newline characters. At present, PCRE supports +only NLTYPE_FIXED, which gets handled without these functions, NLTYPE_ANYCRLF, +and NLTYPE_ANY. The full list of Unicode newline characters is taken from +http://unicode.org/unicode/reports/tr18/. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + + +/************************************************* +* Check for newline at given position * +*************************************************/ + +/* It is guaranteed that the initial value of ptr is less than the end of the +string that is being processed. + +Arguments: + ptr pointer to possible newline + type the newline type + endptr pointer to the end of the string + lenptr where to return the length + utf8 TRUE if in utf8 mode + +Returns: TRUE or FALSE +*/ + +BOOL +_erts_pcre_is_newline(const uschar *ptr, int type, const uschar *endptr, + int *lenptr, BOOL utf8) +{ +int c; +if (utf8) { GETCHAR(c, ptr); } else c = *ptr; + +if (type == NLTYPE_ANYCRLF) switch(c) + { + case 0x000a: *lenptr = 1; return TRUE; /* LF */ + case 0x000d: *lenptr = (ptr < endptr - 1 && ptr[1] == 0x0a)? 2 : 1; + return TRUE; /* CR */ + default: return FALSE; + } + +/* NLTYPE_ANY */ + +else switch(c) + { + case 0x000a: /* LF */ + case 0x000b: /* VT */ + case 0x000c: *lenptr = 1; return TRUE; /* FF */ + case 0x000d: *lenptr = (ptr < endptr - 1 && ptr[1] == 0x0a)? 2 : 1; + return TRUE; /* CR */ + case 0x0085: *lenptr = utf8? 2 : 1; return TRUE; /* NEL */ + case 0x2028: /* LS */ + case 0x2029: *lenptr = 3; return TRUE; /* PS */ + default: return FALSE; + } +} + + + +/************************************************* +* Check for newline at previous position * +*************************************************/ + +/* It is guaranteed that the initial value of ptr is greater than the start of +the string that is being processed. + +Arguments: + ptr pointer to possible newline + type the newline type + startptr pointer to the start of the string + lenptr where to return the length + utf8 TRUE if in utf8 mode + +Returns: TRUE or FALSE +*/ + +BOOL +_erts_pcre_was_newline(const uschar *ptr, int type, const uschar *startptr, + int *lenptr, BOOL utf8) +{ +int c; +ptr--; +#ifdef SUPPORT_UTF8 +if (utf8) + { + BACKCHAR(ptr); + GETCHAR(c, ptr); + } +else c = *ptr; +#else /* no UTF-8 support */ +c = *ptr; +#endif /* SUPPORT_UTF8 */ + +if (type == NLTYPE_ANYCRLF) switch(c) + { + case 0x000a: *lenptr = (ptr > startptr && ptr[-1] == 0x0d)? 2 : 1; + return TRUE; /* LF */ + case 0x000d: *lenptr = 1; return TRUE; /* CR */ + default: return FALSE; + } + +else switch(c) + { + case 0x000a: *lenptr = (ptr > startptr && ptr[-1] == 0x0d)? 2 : 1; + return TRUE; /* LF */ + case 0x000b: /* VT */ + case 0x000c: /* FF */ + case 0x000d: *lenptr = 1; return TRUE; /* CR */ + case 0x0085: *lenptr = utf8? 2 : 1; return TRUE; /* NEL */ + case 0x2028: /* LS */ + case 0x2029: *lenptr = 3; return TRUE; /* PS */ + default: return FALSE; + } +} + +/* End of pcre_newline.c */ diff --git a/erts/emulator/pcre/pcre_ord2utf8.c b/erts/emulator/pcre/pcre_ord2utf8.c new file mode 100644 index 0000000000..dd9c934e20 --- /dev/null +++ b/erts/emulator/pcre/pcre_ord2utf8.c @@ -0,0 +1,87 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This file contains a private PCRE function that converts an ordinal +character value into a UTF8 string. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Convert character value to UTF-8 * +*************************************************/ + +/* This function takes an integer value in the range 0 - 0x7fffffff +and encodes it as a UTF-8 character in 0 to 6 bytes. + +Arguments: + cvalue the character value + buffer pointer to buffer for result - at least 6 bytes long + +Returns: number of characters placed in the buffer +*/ + +int +_erts_pcre_ord2utf8(int cvalue, uschar *buffer) +{ +#ifdef SUPPORT_UTF8 +register int i, j; +for (i = 0; i < _erts_pcre_utf8_table1_size; i++) + if (cvalue <= _erts_pcre_utf8_table1[i]) break; +buffer += i; +for (j = i; j > 0; j--) + { + *buffer-- = 0x80 | (cvalue & 0x3f); + cvalue >>= 6; + } +*buffer = _erts_pcre_utf8_table2[i] | cvalue; +return i + 1; +#else +return 0; /* Keep compiler happy; this function won't ever be */ +#endif /* called when SUPPORT_UTF8 is not defined. */ +} + +/* End of pcre_ord2utf8.c */ diff --git a/erts/emulator/pcre/pcre_refcount.c b/erts/emulator/pcre/pcre_refcount.c new file mode 100644 index 0000000000..a2077b9d52 --- /dev/null +++ b/erts/emulator/pcre/pcre_refcount.c @@ -0,0 +1,83 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_refcount(), which is an +auxiliary function that can be used to maintain a reference count in a compiled +pattern data block. This might be helpful in applications where the block is +shared by different users. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Maintain reference count * +*************************************************/ + +/* The reference count is a 16-bit field, initialized to zero. It is not +possible to transfer a non-zero count from one host to a different host that +has a different byte order - though I can't see why anyone in their right mind +would ever want to do that! + +Arguments: + argument_re points to compiled code + adjust value to add to the count + +Returns: the (possibly updated) count value (a non-negative number), or + a negative error number +*/ + +PCRE_EXP_DEFN int +erts_pcre_refcount(pcre *argument_re, int adjust) +{ +real_pcre *re = (real_pcre *)argument_re; +if (re == NULL) return PCRE_ERROR_NULL; +re->ref_count = (-adjust > re->ref_count)? 0 : + (adjust + re->ref_count > 65535)? 65535 : + re->ref_count + adjust; +return re->ref_count; +} + +/* End of pcre_refcount.c */ diff --git a/erts/emulator/pcre/pcre_study.c b/erts/emulator/pcre/pcre_study.c new file mode 100644 index 0000000000..25bd6bde07 --- /dev/null +++ b/erts/emulator/pcre/pcre_study.c @@ -0,0 +1,580 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_study(), along with local +supporting functions. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/* Returns from set_start_bits() */ + +enum { SSB_FAIL, SSB_DONE, SSB_CONTINUE }; + + +/************************************************* +* Set a bit and maybe its alternate case * +*************************************************/ + +/* Given a character, set its bit in the table, and also the bit for the other +version of a letter if we are caseless. + +Arguments: + start_bits points to the bit map + c is the character + caseless the caseless flag + cd the block with char table pointers + +Returns: nothing +*/ + +static void +set_bit(uschar *start_bits, unsigned int c, BOOL caseless, compile_data *cd) +{ +start_bits[c/8] |= (1 << (c&7)); +if (caseless && (cd->ctypes[c] & ctype_letter) != 0) + start_bits[cd->fcc[c]/8] |= (1 << (cd->fcc[c]&7)); +} + + + +/************************************************* +* Create bitmap of starting bytes * +*************************************************/ + +/* This function scans a compiled unanchored expression recursively and +attempts to build a bitmap of the set of possible starting bytes. As time goes +by, we may be able to get more clever at doing this. The SSB_CONTINUE return is +useful for parenthesized groups in patterns such as (a*)b where the group +provides some optional starting bytes but scanning must continue at the outer +level to find at least one mandatory byte. At the outermost level, this +function fails unless the result is SSB_DONE. + +Arguments: + code points to an expression + start_bits points to a 32-byte table, initialized to 0 + caseless the current state of the caseless flag + utf8 TRUE if in UTF-8 mode + cd the block with char table pointers + +Returns: SSB_FAIL => Failed to find any starting bytes + SSB_DONE => Found mandatory starting bytes + SSB_CONTINUE => Found optional starting bytes +*/ + +static int +set_start_bits(const uschar *code, uschar *start_bits, BOOL caseless, + BOOL utf8, compile_data *cd) +{ +register int c; +int yield = SSB_DONE; + +#if 0 +/* ========================================================================= */ +/* The following comment and code was inserted in January 1999. In May 2006, +when it was observed to cause compiler warnings about unused values, I took it +out again. If anybody is still using OS/2, they will have to put it back +manually. */ + +/* This next statement and the later reference to dummy are here in order to +trick the optimizer of the IBM C compiler for OS/2 into generating correct +code. Apparently IBM isn't going to fix the problem, and we would rather not +disable optimization (in this module it actually makes a big difference, and +the pcre module can use all the optimization it can get). */ + +volatile int dummy; +/* ========================================================================= */ +#endif + +do + { + const uschar *tcode = code + (((int)*code == OP_CBRA)? 3:1) + LINK_SIZE; + BOOL try_next = TRUE; + + while (try_next) /* Loop for items in this branch */ + { + int rc; + switch(*tcode) + { + /* Fail if we reach something we don't understand */ + + default: + return SSB_FAIL; + + /* If we hit a bracket or a positive lookahead assertion, recurse to set + bits from within the subpattern. If it can't find anything, we have to + give up. If it finds some mandatory character(s), we are done for this + branch. Otherwise, carry on scanning after the subpattern. */ + + case OP_BRA: + case OP_SBRA: + case OP_CBRA: + case OP_SCBRA: + case OP_ONCE: + case OP_ASSERT: + rc = set_start_bits(tcode, start_bits, caseless, utf8, cd); + if (rc == SSB_FAIL) return SSB_FAIL; + if (rc == SSB_DONE) try_next = FALSE; else + { + do tcode += GET(tcode, 1); while (*tcode == OP_ALT); + tcode += 1 + LINK_SIZE; + } + break; + + /* If we hit ALT or KET, it means we haven't found anything mandatory in + this branch, though we might have found something optional. For ALT, we + continue with the next alternative, but we have to arrange that the final + result from subpattern is SSB_CONTINUE rather than SSB_DONE. For KET, + return SSB_CONTINUE: if this is the top level, that indicates failure, + but after a nested subpattern, it causes scanning to continue. */ + + case OP_ALT: + yield = SSB_CONTINUE; + try_next = FALSE; + break; + + case OP_KET: + case OP_KETRMAX: + case OP_KETRMIN: + return SSB_CONTINUE; + + /* Skip over callout */ + + case OP_CALLOUT: + tcode += 2 + 2*LINK_SIZE; + break; + + /* Skip over lookbehind and negative lookahead assertions */ + + case OP_ASSERT_NOT: + case OP_ASSERTBACK: + case OP_ASSERTBACK_NOT: + do tcode += GET(tcode, 1); while (*tcode == OP_ALT); + tcode += 1 + LINK_SIZE; + break; + + /* Skip over an option setting, changing the caseless flag */ + + case OP_OPT: + caseless = (tcode[1] & PCRE_CASELESS) != 0; + tcode += 2; + break; + + /* BRAZERO does the bracket, but carries on. */ + + case OP_BRAZERO: + case OP_BRAMINZERO: + if (set_start_bits(++tcode, start_bits, caseless, utf8, cd) == SSB_FAIL) + return SSB_FAIL; +/* ========================================================================= + See the comment at the head of this function concerning the next line, + which was an old fudge for the benefit of OS/2. + dummy = 1; + ========================================================================= */ + do tcode += GET(tcode,1); while (*tcode == OP_ALT); + tcode += 1 + LINK_SIZE; + break; + + /* Single-char * or ? sets the bit and tries the next item */ + + case OP_STAR: + case OP_MINSTAR: + case OP_POSSTAR: + case OP_QUERY: + case OP_MINQUERY: + case OP_POSQUERY: + set_bit(start_bits, tcode[1], caseless, cd); + tcode += 2; +#ifdef SUPPORT_UTF8 + if (utf8 && tcode[-1] >= 0xc0) + tcode += _erts_pcre_utf8_table4[tcode[-1] & 0x3f]; +#endif + break; + + /* Single-char upto sets the bit and tries the next */ + + case OP_UPTO: + case OP_MINUPTO: + case OP_POSUPTO: + set_bit(start_bits, tcode[3], caseless, cd); + tcode += 4; +#ifdef SUPPORT_UTF8 + if (utf8 && tcode[-1] >= 0xc0) + tcode += _erts_pcre_utf8_table4[tcode[-1] & 0x3f]; +#endif + break; + + /* At least one single char sets the bit and stops */ + + case OP_EXACT: /* Fall through */ + tcode += 2; + + case OP_CHAR: + case OP_CHARNC: + case OP_PLUS: + case OP_MINPLUS: + case OP_POSPLUS: + set_bit(start_bits, tcode[1], caseless, cd); + try_next = FALSE; + break; + + /* Single character type sets the bits and stops */ + + case OP_NOT_DIGIT: + for (c = 0; c < 32; c++) + start_bits[c] |= ~cd->cbits[c+cbit_digit]; + try_next = FALSE; + break; + + case OP_DIGIT: + for (c = 0; c < 32; c++) + start_bits[c] |= cd->cbits[c+cbit_digit]; + try_next = FALSE; + break; + + /* The cbit_space table has vertical tab as whitespace; we have to + discard it. */ + + case OP_NOT_WHITESPACE: + for (c = 0; c < 32; c++) + { + int d = cd->cbits[c+cbit_space]; + if (c == 1) d &= ~0x08; + start_bits[c] |= ~d; + } + try_next = FALSE; + break; + + /* The cbit_space table has vertical tab as whitespace; we have to + discard it. */ + + case OP_WHITESPACE: + for (c = 0; c < 32; c++) + { + int d = cd->cbits[c+cbit_space]; + if (c == 1) d &= ~0x08; + start_bits[c] |= d; + } + try_next = FALSE; + break; + + case OP_NOT_WORDCHAR: + for (c = 0; c < 32; c++) + start_bits[c] |= ~cd->cbits[c+cbit_word]; + try_next = FALSE; + break; + + case OP_WORDCHAR: + for (c = 0; c < 32; c++) + start_bits[c] |= cd->cbits[c+cbit_word]; + try_next = FALSE; + break; + + /* One or more character type fudges the pointer and restarts, knowing + it will hit a single character type and stop there. */ + + case OP_TYPEPLUS: + case OP_TYPEMINPLUS: + tcode++; + break; + + case OP_TYPEEXACT: + tcode += 3; + break; + + /* Zero or more repeats of character types set the bits and then + try again. */ + + case OP_TYPEUPTO: + case OP_TYPEMINUPTO: + case OP_TYPEPOSUPTO: + tcode += 2; /* Fall through */ + + case OP_TYPESTAR: + case OP_TYPEMINSTAR: + case OP_TYPEPOSSTAR: + case OP_TYPEQUERY: + case OP_TYPEMINQUERY: + case OP_TYPEPOSQUERY: + switch(tcode[1]) + { + case OP_ANY: + return SSB_FAIL; + + case OP_NOT_DIGIT: + for (c = 0; c < 32; c++) + start_bits[c] |= ~cd->cbits[c+cbit_digit]; + break; + + case OP_DIGIT: + for (c = 0; c < 32; c++) + start_bits[c] |= cd->cbits[c+cbit_digit]; + break; + + /* The cbit_space table has vertical tab as whitespace; we have to + discard it. */ + + case OP_NOT_WHITESPACE: + for (c = 0; c < 32; c++) + { + int d = cd->cbits[c+cbit_space]; + if (c == 1) d &= ~0x08; + start_bits[c] |= ~d; + } + break; + + /* The cbit_space table has vertical tab as whitespace; we have to + discard it. */ + + case OP_WHITESPACE: + for (c = 0; c < 32; c++) + { + int d = cd->cbits[c+cbit_space]; + if (c == 1) d &= ~0x08; + start_bits[c] |= d; + } + break; + + case OP_NOT_WORDCHAR: + for (c = 0; c < 32; c++) + start_bits[c] |= ~cd->cbits[c+cbit_word]; + break; + + case OP_WORDCHAR: + for (c = 0; c < 32; c++) + start_bits[c] |= cd->cbits[c+cbit_word]; + break; + } + + tcode += 2; + break; + + /* Character class where all the information is in a bit map: set the + bits and either carry on or not, according to the repeat count. If it was + a negative class, and we are operating with UTF-8 characters, any byte + with a value >= 0xc4 is a potentially valid starter because it starts a + character with a value > 255. */ + + case OP_NCLASS: +#ifdef SUPPORT_UTF8 + if (utf8) + { + start_bits[24] |= 0xf0; /* Bits for 0xc4 - 0xc8 */ + memset(start_bits+25, 0xff, 7); /* Bits for 0xc9 - 0xff */ + } +#endif + /* Fall through */ + + case OP_CLASS: + { + tcode++; + + /* In UTF-8 mode, the bits in a bit map correspond to character + values, not to byte values. However, the bit map we are constructing is + for byte values. So we have to do a conversion for characters whose + value is > 127. In fact, there are only two possible starting bytes for + characters in the range 128 - 255. */ + +#ifdef SUPPORT_UTF8 + if (utf8) + { + for (c = 0; c < 16; c++) start_bits[c] |= tcode[c]; + for (c = 128; c < 256; c++) + { + if ((tcode[c/8] && (1 << (c&7))) != 0) + { + int d = (c >> 6) | 0xc0; /* Set bit for this starter */ + start_bits[d/8] |= (1 << (d&7)); /* and then skip on to the */ + c = (c & 0xc0) + 0x40 - 1; /* next relevant character. */ + } + } + } + + /* In non-UTF-8 mode, the two bit maps are completely compatible. */ + + else +#endif + { + for (c = 0; c < 32; c++) start_bits[c] |= tcode[c]; + } + + /* Advance past the bit map, and act on what follows */ + + tcode += 32; + switch (*tcode) + { + case OP_CRSTAR: + case OP_CRMINSTAR: + case OP_CRQUERY: + case OP_CRMINQUERY: + tcode++; + break; + + case OP_CRRANGE: + case OP_CRMINRANGE: + if (((tcode[1] << 8) + tcode[2]) == 0) tcode += 5; + else try_next = FALSE; + break; + + default: + try_next = FALSE; + break; + } + } + break; /* End of bitmap class handling */ + + } /* End of switch */ + } /* End of try_next loop */ + + code += GET(code, 1); /* Advance to next branch */ + } +while (*code == OP_ALT); +return yield; +} + + + +/************************************************* +* Study a compiled expression * +*************************************************/ + +/* This function is handed a compiled expression that it must study to produce +information that will speed up the matching. It returns a pcre_extra block +which then gets handed back to pcre_exec(). + +Arguments: + re points to the compiled expression + options contains option bits + errorptr points to where to place error messages; + set NULL unless error + +Returns: pointer to a pcre_extra block, with study_data filled in and the + appropriate flag set; + NULL on error or if no optimization possible +*/ + +PCRE_EXP_DEFN pcre_extra * +erts_pcre_study(const pcre *external_re, int options, const char **errorptr) +{ +uschar start_bits[32]; +pcre_extra *extra; +pcre_study_data *study; +const uschar *tables; +uschar *code; +compile_data compile_block; +const real_pcre *re = (const real_pcre *)external_re; + +*errorptr = NULL; + +if (re == NULL || re->magic_number != MAGIC_NUMBER) + { + *errorptr = "argument is not a compiled regular expression"; + return NULL; + } + +if ((options & ~PUBLIC_STUDY_OPTIONS) != 0) + { + *errorptr = "unknown or incorrect option bit(s) set"; + return NULL; + } + +code = (uschar *)re + re->name_table_offset + + (re->name_count * re->name_entry_size); + +/* For an anchored pattern, or an unanchored pattern that has a first char, or +a multiline pattern that matches only at "line starts", no further processing +at present. */ + +if ((re->options & PCRE_ANCHORED) != 0 || + (re->flags & (PCRE_FIRSTSET|PCRE_STARTLINE)) != 0) + return NULL; + +/* Set the character tables in the block that is passed around */ + +tables = re->tables; +if (tables == NULL) + (void)erts_pcre_fullinfo(external_re, NULL, PCRE_INFO_DEFAULT_TABLES, + (void *)(&tables)); + +compile_block.lcc = tables + lcc_offset; +compile_block.fcc = tables + fcc_offset; +compile_block.cbits = tables + cbits_offset; +compile_block.ctypes = tables + ctypes_offset; + +/* See if we can find a fixed set of initial characters for the pattern. */ + +memset(start_bits, 0, 32 * sizeof(uschar)); +if (set_start_bits(code, start_bits, (re->options & PCRE_CASELESS) != 0, + (re->options & PCRE_UTF8) != 0, &compile_block) != SSB_DONE) return NULL; + +/* Get a pcre_extra block and a pcre_study_data block. The study data is put in +the latter, which is pointed to by the former, which may also get additional +data set later by the calling program. At the moment, the size of +pcre_study_data is fixed. We nevertheless save it in a field for returning via +the erts_pcre_fullinfo() function so that if it becomes variable in the future, we +don't have to change that code. */ + +extra = (pcre_extra *)(erts_pcre_malloc) + (sizeof(pcre_extra) + sizeof(pcre_study_data)); + +if (extra == NULL) + { + *errorptr = "failed to get memory"; + return NULL; + } + +study = (pcre_study_data *)((char *)extra + sizeof(pcre_extra)); +extra->flags = PCRE_EXTRA_STUDY_DATA; +extra->study_data = study; + +study->size = sizeof(pcre_study_data); +study->options = PCRE_STUDY_MAPPED; +memcpy(study->start_bits, start_bits, sizeof(start_bits)); + +return extra; +} + +/* End of pcre_study.c */ diff --git a/erts/emulator/pcre/pcre_tables.c b/erts/emulator/pcre/pcre_tables.c new file mode 100644 index 0000000000..72772de1dc --- /dev/null +++ b/erts/emulator/pcre/pcre_tables.c @@ -0,0 +1,319 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains some fixed tables that are used by more than one of the +PCRE code modules. The tables are also #included by the pcretest program, which +uses macros to change their names from _erts_pcre_xxx to xxxx, thereby avoiding name +clashes with the library. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/* Table of sizes for the fixed-length opcodes. It's defined in a macro so that +the definition is next to the definition of the opcodes in pcre_internal.h. */ + +const uschar _erts_pcre_OP_lengths[] = { OP_LENGTHS }; + + + +/************************************************* +* Tables for UTF-8 support * +*************************************************/ + +/* These are the breakpoints for different numbers of bytes in a UTF-8 +character. */ + +#ifdef SUPPORT_UTF8 + +const int _erts_pcre_utf8_table1[] = + { 0x7f, 0x7ff, 0xffff, 0x1fffff, 0x3ffffff, 0x7fffffff}; + +const int _erts_pcre_utf8_table1_size = sizeof(_erts_pcre_utf8_table1)/sizeof(int); + +/* These are the indicator bits and the mask for the data bits to set in the +first byte of a character, indexed by the number of additional bytes. */ + +const int _erts_pcre_utf8_table2[] = { 0, 0xc0, 0xe0, 0xf0, 0xf8, 0xfc}; +const int _erts_pcre_utf8_table3[] = { 0xff, 0x1f, 0x0f, 0x07, 0x03, 0x01}; + +/* Table of the number of extra bytes, indexed by the first byte masked with +0x3f. The highest number for a valid UTF-8 first byte is in fact 0x3d. */ + +const uschar _erts_pcre_utf8_table4[] = { + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, + 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, + 3,3,3,3,3,3,3,3,4,4,4,4,5,5,5,5 }; + +/* The pcre_utt[] table below translates Unicode property names into type and +code values. It is searched by binary chop, so must be in collating sequence of +name. Originally, the table contained pointers to the name strings in the first +field of each entry. However, that leads to a large number of relocations when +a shared library is dynamically loaded. A significant reduction is made by +putting all the names into a single, large string and then using offsets in the +table itself. Maintenance is more error-prone, but frequent changes to this +data is unlikely. */ + +const char _erts_pcre_utt_names[] = + "Any\0" + "Arabic\0" + "Armenian\0" + "Balinese\0" + "Bengali\0" + "Bopomofo\0" + "Braille\0" + "Buginese\0" + "Buhid\0" + "C\0" + "Canadian_Aboriginal\0" + "Cc\0" + "Cf\0" + "Cherokee\0" + "Cn\0" + "Co\0" + "Common\0" + "Coptic\0" + "Cs\0" + "Cuneiform\0" + "Cypriot\0" + "Cyrillic\0" + "Deseret\0" + "Devanagari\0" + "Ethiopic\0" + "Georgian\0" + "Glagolitic\0" + "Gothic\0" + "Greek\0" + "Gujarati\0" + "Gurmukhi\0" + "Han\0" + "Hangul\0" + "Hanunoo\0" + "Hebrew\0" + "Hiragana\0" + "Inherited\0" + "Kannada\0" + "Katakana\0" + "Kharoshthi\0" + "Khmer\0" + "L\0" + "L&\0" + "Lao\0" + "Latin\0" + "Limbu\0" + "Linear_B\0" + "Ll\0" + "Lm\0" + "Lo\0" + "Lt\0" + "Lu\0" + "M\0" + "Malayalam\0" + "Mc\0" + "Me\0" + "Mn\0" + "Mongolian\0" + "Myanmar\0" + "N\0" + "Nd\0" + "New_Tai_Lue\0" + "Nko\0" + "Nl\0" + "No\0" + "Ogham\0" + "Old_Italic\0" + "Old_Persian\0" + "Oriya\0" + "Osmanya\0" + "P\0" + "Pc\0" + "Pd\0" + "Pe\0" + "Pf\0" + "Phags_Pa\0" + "Phoenician\0" + "Pi\0" + "Po\0" + "Ps\0" + "Runic\0" + "S\0" + "Sc\0" + "Shavian\0" + "Sinhala\0" + "Sk\0" + "Sm\0" + "So\0" + "Syloti_Nagri\0" + "Syriac\0" + "Tagalog\0" + "Tagbanwa\0" + "Tai_Le\0" + "Tamil\0" + "Telugu\0" + "Thaana\0" + "Thai\0" + "Tibetan\0" + "Tifinagh\0" + "Ugaritic\0" + "Yi\0" + "Z\0" + "Zl\0" + "Zp\0" + "Zs\0"; + +const ucp_type_table _erts_pcre_utt[] = { + { 0, PT_ANY, 0 }, + { 4, PT_SC, ucp_Arabic }, + { 11, PT_SC, ucp_Armenian }, + { 20, PT_SC, ucp_Balinese }, + { 29, PT_SC, ucp_Bengali }, + { 37, PT_SC, ucp_Bopomofo }, + { 46, PT_SC, ucp_Braille }, + { 54, PT_SC, ucp_Buginese }, + { 63, PT_SC, ucp_Buhid }, + { 69, PT_GC, ucp_C }, + { 71, PT_SC, ucp_Canadian_Aboriginal }, + { 91, PT_PC, ucp_Cc }, + { 94, PT_PC, ucp_Cf }, + { 97, PT_SC, ucp_Cherokee }, + { 106, PT_PC, ucp_Cn }, + { 109, PT_PC, ucp_Co }, + { 112, PT_SC, ucp_Common }, + { 119, PT_SC, ucp_Coptic }, + { 126, PT_PC, ucp_Cs }, + { 129, PT_SC, ucp_Cuneiform }, + { 139, PT_SC, ucp_Cypriot }, + { 147, PT_SC, ucp_Cyrillic }, + { 156, PT_SC, ucp_Deseret }, + { 164, PT_SC, ucp_Devanagari }, + { 175, PT_SC, ucp_Ethiopic }, + { 184, PT_SC, ucp_Georgian }, + { 193, PT_SC, ucp_Glagolitic }, + { 204, PT_SC, ucp_Gothic }, + { 211, PT_SC, ucp_Greek }, + { 217, PT_SC, ucp_Gujarati }, + { 226, PT_SC, ucp_Gurmukhi }, + { 235, PT_SC, ucp_Han }, + { 239, PT_SC, ucp_Hangul }, + { 246, PT_SC, ucp_Hanunoo }, + { 254, PT_SC, ucp_Hebrew }, + { 261, PT_SC, ucp_Hiragana }, + { 270, PT_SC, ucp_Inherited }, + { 280, PT_SC, ucp_Kannada }, + { 288, PT_SC, ucp_Katakana }, + { 297, PT_SC, ucp_Kharoshthi }, + { 308, PT_SC, ucp_Khmer }, + { 314, PT_GC, ucp_L }, + { 316, PT_LAMP, 0 }, + { 319, PT_SC, ucp_Lao }, + { 323, PT_SC, ucp_Latin }, + { 329, PT_SC, ucp_Limbu }, + { 335, PT_SC, ucp_Linear_B }, + { 344, PT_PC, ucp_Ll }, + { 347, PT_PC, ucp_Lm }, + { 350, PT_PC, ucp_Lo }, + { 353, PT_PC, ucp_Lt }, + { 356, PT_PC, ucp_Lu }, + { 359, PT_GC, ucp_M }, + { 361, PT_SC, ucp_Malayalam }, + { 371, PT_PC, ucp_Mc }, + { 374, PT_PC, ucp_Me }, + { 377, PT_PC, ucp_Mn }, + { 380, PT_SC, ucp_Mongolian }, + { 390, PT_SC, ucp_Myanmar }, + { 398, PT_GC, ucp_N }, + { 400, PT_PC, ucp_Nd }, + { 403, PT_SC, ucp_New_Tai_Lue }, + { 415, PT_SC, ucp_Nko }, + { 419, PT_PC, ucp_Nl }, + { 422, PT_PC, ucp_No }, + { 425, PT_SC, ucp_Ogham }, + { 431, PT_SC, ucp_Old_Italic }, + { 442, PT_SC, ucp_Old_Persian }, + { 454, PT_SC, ucp_Oriya }, + { 460, PT_SC, ucp_Osmanya }, + { 468, PT_GC, ucp_P }, + { 470, PT_PC, ucp_Pc }, + { 473, PT_PC, ucp_Pd }, + { 476, PT_PC, ucp_Pe }, + { 479, PT_PC, ucp_Pf }, + { 482, PT_SC, ucp_Phags_Pa }, + { 491, PT_SC, ucp_Phoenician }, + { 502, PT_PC, ucp_Pi }, + { 505, PT_PC, ucp_Po }, + { 508, PT_PC, ucp_Ps }, + { 511, PT_SC, ucp_Runic }, + { 517, PT_GC, ucp_S }, + { 519, PT_PC, ucp_Sc }, + { 522, PT_SC, ucp_Shavian }, + { 530, PT_SC, ucp_Sinhala }, + { 538, PT_PC, ucp_Sk }, + { 541, PT_PC, ucp_Sm }, + { 544, PT_PC, ucp_So }, + { 547, PT_SC, ucp_Syloti_Nagri }, + { 560, PT_SC, ucp_Syriac }, + { 567, PT_SC, ucp_Tagalog }, + { 575, PT_SC, ucp_Tagbanwa }, + { 584, PT_SC, ucp_Tai_Le }, + { 591, PT_SC, ucp_Tamil }, + { 597, PT_SC, ucp_Telugu }, + { 604, PT_SC, ucp_Thaana }, + { 611, PT_SC, ucp_Thai }, + { 616, PT_SC, ucp_Tibetan }, + { 624, PT_SC, ucp_Tifinagh }, + { 633, PT_SC, ucp_Ugaritic }, + { 642, PT_SC, ucp_Yi }, + { 645, PT_GC, ucp_Z }, + { 647, PT_PC, ucp_Zl }, + { 650, PT_PC, ucp_Zp }, + { 653, PT_PC, ucp_Zs } +}; + +const int _erts_pcre_utt_size = sizeof(_erts_pcre_utt)/sizeof(ucp_type_table); + +#endif /* SUPPORT_UTF8 */ + +/* End of pcre_tables.c */ diff --git a/erts/emulator/pcre/pcre_try_flipped.c b/erts/emulator/pcre/pcre_try_flipped.c new file mode 100644 index 0000000000..7b6c85cb26 --- /dev/null +++ b/erts/emulator/pcre/pcre_try_flipped.c @@ -0,0 +1,138 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains an internal function that tests a compiled pattern to +see if it was compiled with the opposite endianness. If so, it uses an +auxiliary local function to flip the appropriate bytes. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Flip bytes in an integer * +*************************************************/ + +/* This function is called when the magic number in a regex doesn't match, in +order to flip its bytes to see if we are dealing with a pattern that was +compiled on a host of different endianness. If so, this function is used to +flip other byte values. + +Arguments: + value the number to flip + n the number of bytes to flip (assumed to be 2 or 4) + +Returns: the flipped value +*/ + +static unsigned long int +byteflip(unsigned long int value, int n) +{ +if (n == 2) return ((value & 0x00ff) << 8) | ((value & 0xff00) >> 8); +return ((value & 0x000000ff) << 24) | + ((value & 0x0000ff00) << 8) | + ((value & 0x00ff0000) >> 8) | + ((value & 0xff000000) >> 24); +} + + + +/************************************************* +* Test for a byte-flipped compiled regex * +*************************************************/ + +/* This function is called from pcre_exec(), pcre_dfa_exec(), and also from +pcre_fullinfo(). Its job is to test whether the regex is byte-flipped - that +is, it was compiled on a system of opposite endianness. The function is called +only when the native MAGIC_NUMBER test fails. If the regex is indeed flipped, +we flip all the relevant values into a different data block, and return it. + +Arguments: + re points to the regex + study points to study data, or NULL + internal_re points to a new regex block + internal_study points to a new study block + +Returns: the new block if is is indeed a byte-flipped regex + NULL if it is not +*/ + +real_pcre * +_erts_pcre_try_flipped(const real_pcre *re, real_pcre *internal_re, + const pcre_study_data *study, pcre_study_data *internal_study) +{ +if (byteflip(re->magic_number, sizeof(re->magic_number)) != MAGIC_NUMBER) + return NULL; + +*internal_re = *re; /* To copy other fields */ +internal_re->size = byteflip(re->size, sizeof(re->size)); +internal_re->options = byteflip(re->options, sizeof(re->options)); +internal_re->flags = (pcre_uint16)byteflip(re->flags, sizeof(re->flags)); +internal_re->top_bracket = + (pcre_uint16)byteflip(re->top_bracket, sizeof(re->top_bracket)); +internal_re->top_backref = + (pcre_uint16)byteflip(re->top_backref, sizeof(re->top_backref)); +internal_re->first_byte = + (pcre_uint16)byteflip(re->first_byte, sizeof(re->first_byte)); +internal_re->req_byte = + (pcre_uint16)byteflip(re->req_byte, sizeof(re->req_byte)); +internal_re->name_table_offset = + (pcre_uint16)byteflip(re->name_table_offset, sizeof(re->name_table_offset)); +internal_re->name_entry_size = + (pcre_uint16)byteflip(re->name_entry_size, sizeof(re->name_entry_size)); +internal_re->name_count = + (pcre_uint16)byteflip(re->name_count, sizeof(re->name_count)); + +if (study != NULL) + { + *internal_study = *study; /* To copy other fields */ + internal_study->size = byteflip(study->size, sizeof(study->size)); + internal_study->options = byteflip(study->options, sizeof(study->options)); + } + +return internal_re; +} + +/* End of pcre_tryflipped.c */ diff --git a/erts/emulator/pcre/pcre_ucp_searchfuncs.c b/erts/emulator/pcre/pcre_ucp_searchfuncs.c new file mode 100644 index 0000000000..6a20c227cf --- /dev/null +++ b/erts/emulator/pcre/pcre_ucp_searchfuncs.c @@ -0,0 +1,181 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains code for searching the table of Unicode character +properties. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + +#include "ucp.h" /* Category definitions */ +#include "ucpinternal.h" /* Internal table details */ +#include "ucptable.h" /* The table itself */ + + +/* Table to translate from particular type value to the general value. */ + +static const int ucp_gentype[] = { + ucp_C, ucp_C, ucp_C, ucp_C, ucp_C, /* Cc, Cf, Cn, Co, Cs */ + ucp_L, ucp_L, ucp_L, ucp_L, ucp_L, /* Ll, Lu, Lm, Lo, Lt */ + ucp_M, ucp_M, ucp_M, /* Mc, Me, Mn */ + ucp_N, ucp_N, ucp_N, /* Nd, Nl, No */ + ucp_P, ucp_P, ucp_P, ucp_P, ucp_P, /* Pc, Pd, Pe, Pf, Pi */ + ucp_P, ucp_P, /* Ps, Po */ + ucp_S, ucp_S, ucp_S, ucp_S, /* Sc, Sk, Sm, So */ + ucp_Z, ucp_Z, ucp_Z /* Zl, Zp, Zs */ +}; + + + +/************************************************* +* Search table and return type * +*************************************************/ + +/* Three values are returned: the category is ucp_C, ucp_L, etc. The detailed +character type is ucp_Lu, ucp_Nd, etc. The script is ucp_Latin, etc. + +Arguments: + c the character value + type_ptr the detailed character type is returned here + script_ptr the script is returned here + +Returns: the character type category +*/ + +int +_erts_pcre_ucp_findprop(const unsigned int c, int *type_ptr, int *script_ptr) +{ +int bot = 0; +int top = sizeof(ucp_table)/sizeof(cnode); +int mid; + +/* The table is searched using a binary chop. You might think that using +intermediate variables to hold some of the common expressions would speed +things up, but tests with gcc 3.4.4 on Linux showed that, on the contrary, it +makes things a lot slower. */ + +for (;;) + { + if (top <= bot) + { + *type_ptr = ucp_Cn; + *script_ptr = ucp_Common; + return ucp_C; + } + mid = (bot + top) >> 1; + if (c == (ucp_table[mid].f0 & f0_charmask)) break; + if (c < (ucp_table[mid].f0 & f0_charmask)) top = mid; + else + { + if ((ucp_table[mid].f0 & f0_rangeflag) != 0 && + c <= (ucp_table[mid].f0 & f0_charmask) + + (ucp_table[mid].f1 & f1_rangemask)) break; + bot = mid + 1; + } + } + +/* Found an entry in the table. Set the script and detailed type values, and +return the general type. */ + +*script_ptr = (ucp_table[mid].f0 & f0_scriptmask) >> f0_scriptshift; +*type_ptr = (ucp_table[mid].f1 & f1_typemask) >> f1_typeshift; + +return ucp_gentype[*type_ptr]; +} + + + +/************************************************* +* Search table and return other case * +*************************************************/ + +/* If the given character is a letter, and there is another case for the +letter, return the other case. Otherwise, return -1. + +Arguments: + c the character value + +Returns: the other case or NOTACHAR if none +*/ + +unsigned int +_erts_pcre_ucp_othercase(const unsigned int c) +{ +int bot = 0; +int top = sizeof(ucp_table)/sizeof(cnode); +int mid, offset; + +/* The table is searched using a binary chop. You might think that using +intermediate variables to hold some of the common expressions would speed +things up, but tests with gcc 3.4.4 on Linux showed that, on the contrary, it +makes things a lot slower. */ + +for (;;) + { + if (top <= bot) return -1; + mid = (bot + top) >> 1; + if (c == (ucp_table[mid].f0 & f0_charmask)) break; + if (c < (ucp_table[mid].f0 & f0_charmask)) top = mid; + else + { + if ((ucp_table[mid].f0 & f0_rangeflag) != 0 && + c <= (ucp_table[mid].f0 & f0_charmask) + + (ucp_table[mid].f1 & f1_rangemask)) break; + bot = mid + 1; + } + } + +/* Found an entry in the table. Return NOTACHAR for a range entry. Otherwise +return the other case if there is one, else NOTACHAR. */ + +if ((ucp_table[mid].f0 & f0_rangeflag) != 0) return NOTACHAR; + +offset = ucp_table[mid].f1 & f1_casemask; +if ((offset & f1_caseneg) != 0) offset |= f1_caseneg; +return (offset == 0)? NOTACHAR : c + offset; +} + + +/* End of pcre_ucp_searchfuncs.c */ diff --git a/erts/emulator/pcre/pcre_valid_utf8.c b/erts/emulator/pcre/pcre_valid_utf8.c new file mode 100644 index 0000000000..30af207ae3 --- /dev/null +++ b/erts/emulator/pcre/pcre_valid_utf8.c @@ -0,0 +1,163 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains an internal function for validating UTF-8 character +strings. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Validate a UTF-8 string * +*************************************************/ + +/* This function is called (optionally) at the start of compile or match, to +validate that a supposed UTF-8 string is actually valid. The early check means +that subsequent code can assume it is dealing with a valid string. The check +can be turned off for maximum performance, but the consequences of supplying +an invalid string are then undefined. + +Originally, this function checked according to RFC 2279, allowing for values in +the range 0 to 0x7fffffff, up to 6 bytes long, but ensuring that they were in +the canonical format. Once somebody had pointed out RFC 3629 to me (it +obsoletes 2279), additional restrictions were applied. The values are now +limited to be between 0 and 0x0010ffff, no more than 4 bytes long, and the +subrange 0xd000 to 0xdfff is excluded. + +Arguments: + string points to the string + length length of string, or -1 if the string is zero-terminated + +Returns: < 0 if the string is a valid UTF-8 string + >= 0 otherwise; the value is the offset of the bad byte +*/ + +int +_erts_pcre_valid_utf8(const uschar *string, int length) +{ +#ifdef SUPPORT_UTF8 +register const uschar *p; + +if (length < 0) + { + for (p = string; *p != 0; p++); + length = p - string; + } + +for (p = string; length-- > 0; p++) + { + register int ab; + register int c = *p; + if (c < 128) continue; + if (c < 0xc0) return p - string; + ab = _erts_pcre_utf8_table4[c & 0x3f]; /* Number of additional bytes */ + if (length < ab || ab > 3) return p - string; + length -= ab; + + /* Check top bits in the second byte */ + if ((*(++p) & 0xc0) != 0x80) return p - string; + + /* Check for overlong sequences for each different length, and for the + excluded range 0xd000 to 0xdfff. */ + + switch (ab) + { + /* Check for xx00 000x (overlong sequence) */ + + case 1: + if ((c & 0x3e) == 0) return p - string; + continue; /* We know there aren't any more bytes to check */ + + /* Check for 1110 0000, xx0x xxxx (overlong sequence) or + 1110 1101, 1010 xxxx (0xd000 - 0xdfff) */ + + case 2: + if ((c == 0xe0 && (*p & 0x20) == 0) || + (c == 0xed && *p >= 0xa0)) + return p - string; + break; + + /* Check for 1111 0000, xx00 xxxx (overlong sequence) or + greater than 0x0010ffff (f4 8f bf bf) */ + + case 3: + if ((c == 0xf0 && (*p & 0x30) == 0) || + (c > 0xf4 ) || + (c == 0xf4 && *p > 0x8f)) + return p - string; + break; + +#if 0 + /* These cases can no longer occur, as we restrict to a maximum of four + bytes nowadays. Leave the code here in case we ever want to add an option + for longer sequences. */ + + /* Check for 1111 1000, xx00 0xxx */ + case 4: + if (c == 0xf8 && (*p & 0x38) == 0) return p - string; + break; + + /* Check for leading 0xfe or 0xff, and then for 1111 1100, xx00 00xx */ + case 5: + if (c == 0xfe || c == 0xff || + (c == 0xfc && (*p & 0x3c) == 0)) return p - string; + break; +#endif + + } + + /* Check for valid bytes after the 2nd, if any; all must start 10 */ + while (--ab > 0) + { + if ((*(++p) & 0xc0) != 0x80) return p - string; + } + } +#endif + +return -1; +} + +/* End of pcre_valid_utf8.c */ diff --git a/erts/emulator/pcre/pcre_version.c b/erts/emulator/pcre/pcre_version.c new file mode 100644 index 0000000000..b8a5b555ef --- /dev/null +++ b/erts/emulator/pcre/pcre_version.c @@ -0,0 +1,91 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains the external function erts_pcre_version(), which returns a +string that identifies the PCRE version that is in use. */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Return version string * +*************************************************/ + +/* These macros are the standard way of turning unquoted text into C strings. +They allow macros like PCRE_MAJOR to be defined without quotes, which is +convenient for user programs that want to test its value. */ + +#define STRING(a) # a +#define XSTRING(s) STRING(s) + +/* A problem turned up with PCRE_PRERELEASE, which is defined empty for +production releases. Originally, it was used naively in this code: + + return XSTRING(PCRE_MAJOR) + "." XSTRING(PCRE_MINOR) + XSTRING(PCRE_PRERELEASE) + " " XSTRING(PCRE_DATE); + +However, when PCRE_PRERELEASE is empty, this leads to an attempted expansion of +STRING(). The C standard states: "If (before argument substitution) any +argument consists of no preprocessing tokens, the behavior is undefined." It +turns out the gcc treats this case as a single empty string - which is what we +really want - but Visual C grumbles about the lack of an argument for the +macro. Unfortunately, both are within their rights. To cope with both ways of +handling this, I had resort to some messy hackery that does a test at run time. +I could find no way of detecting that a macro is defined as an empty string at +pre-processor time. This hack uses a standard trick for avoiding calling +the STRING macro with an empty argument when doing the test. */ + +PCRE_EXP_DEFN const char * +erts_pcre_version(void) +{ +return (XSTRING(Z PCRE_PRERELEASE)[1] == 0)? + XSTRING(PCRE_MAJOR.PCRE_MINOR PCRE_DATE) : + XSTRING(PCRE_MAJOR.PCRE_MINOR) XSTRING(PCRE_PRERELEASE PCRE_DATE); +} + +/* End of pcre_version.c */ diff --git a/erts/emulator/pcre/pcre_xclass.c b/erts/emulator/pcre/pcre_xclass.c new file mode 100644 index 0000000000..1172cd17ac --- /dev/null +++ b/erts/emulator/pcre/pcre_xclass.c @@ -0,0 +1,149 @@ +/************************************************* +* Perl-Compatible Regular Expressions * +*************************************************/ + +/* PCRE is a library of functions to support regular expressions whose syntax +and semantics are as close as possible to those of the Perl 5 language. + + Written by Philip Hazel + Copyright (c) 1997-2008 University of Cambridge + +----------------------------------------------------------------------------- +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + + * Neither the name of the University of Cambridge nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. +----------------------------------------------------------------------------- +*/ + + +/* This module contains an internal function that is used to match an extended +class (one that contains characters whose values are > 255). It is used by both +pcre_exec() and pcre_def_exec(). */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "pcre_internal.h" + + +/************************************************* +* Match character against an XCLASS * +*************************************************/ + +/* This function is called to match a character against an extended class that +might contain values > 255. + +Arguments: + c the character + data points to the flag byte of the XCLASS data + +Returns: TRUE if character matches, else FALSE +*/ + +BOOL +_erts_pcre_xclass(int c, const uschar *data) +{ +int t; +BOOL negated = (*data & XCL_NOT) != 0; + +/* Character values < 256 are matched against a bitmap, if one is present. If +not, we still carry on, because there may be ranges that start below 256 in the +additional data. */ + +if (c < 256) + { + if ((*data & XCL_MAP) != 0 && (data[1 + c/8] & (1 << (c&7))) != 0) + return !negated; /* char found */ + } + +/* First skip the bit map if present. Then match against the list of Unicode +properties or large chars or ranges that end with a large char. We won't ever +encounter XCL_PROP or XCL_NOTPROP when UCP support is not compiled. */ + +if ((*data++ & XCL_MAP) != 0) data += 32; + +while ((t = *data++) != XCL_END) + { + int x, y; + if (t == XCL_SINGLE) + { + GETCHARINC(x, data); + if (c == x) return !negated; + } + else if (t == XCL_RANGE) + { + GETCHARINC(x, data); + GETCHARINC(y, data); + if (c >= x && c <= y) return !negated; + } + +#ifdef SUPPORT_UCP + else /* XCL_PROP & XCL_NOTPROP */ + { + int chartype, script; + int category = _erts_pcre_ucp_findprop(c, &chartype, &script); + + switch(*data) + { + case PT_ANY: + if (t == XCL_PROP) return !negated; + break; + + case PT_LAMP: + if ((chartype == ucp_Lu || chartype == ucp_Ll || chartype == ucp_Lt) == + (t == XCL_PROP)) return !negated; + break; + + case PT_GC: + if ((data[1] == category) == (t == XCL_PROP)) return !negated; + break; + + case PT_PC: + if ((data[1] == chartype) == (t == XCL_PROP)) return !negated; + break; + + case PT_SC: + if ((data[1] == script) == (t == XCL_PROP)) return !negated; + break; + + /* This should never occur, but compilers may mutter if there is no + default. */ + + default: + return FALSE; + } + + data += 2; + } +#endif /* SUPPORT_UCP */ + } + +return negated; /* char did not match */ +} + +/* End of pcre_xclass.c */ diff --git a/erts/emulator/pcre/ucp.h b/erts/emulator/pcre/ucp.h new file mode 100644 index 0000000000..52f91f1a65 --- /dev/null +++ b/erts/emulator/pcre/ucp.h @@ -0,0 +1,135 @@ +/************************************************* +* Unicode Property Table handler * +*************************************************/ + +/* %ExternalCopyright% */ + +#ifndef _UCP_H +#define _UCP_H + +/* This file contains definitions of the property values that are returned by +the function _erts_pcre_ucp_findprop(). New values that are added for new releases +of Unicode should always be at the end of each enum, for backwards +compatibility. */ + +/* These are the general character categories. */ + +enum { + ucp_C, /* Other */ + ucp_L, /* Letter */ + ucp_M, /* Mark */ + ucp_N, /* Number */ + ucp_P, /* Punctuation */ + ucp_S, /* Symbol */ + ucp_Z /* Separator */ +}; + +/* These are the particular character types. */ + +enum { + ucp_Cc, /* Control */ + ucp_Cf, /* Format */ + ucp_Cn, /* Unassigned */ + ucp_Co, /* Private use */ + ucp_Cs, /* Surrogate */ + ucp_Ll, /* Lower case letter */ + ucp_Lm, /* Modifier letter */ + ucp_Lo, /* Other letter */ + ucp_Lt, /* Title case letter */ + ucp_Lu, /* Upper case letter */ + ucp_Mc, /* Spacing mark */ + ucp_Me, /* Enclosing mark */ + ucp_Mn, /* Non-spacing mark */ + ucp_Nd, /* Decimal number */ + ucp_Nl, /* Letter number */ + ucp_No, /* Other number */ + ucp_Pc, /* Connector punctuation */ + ucp_Pd, /* Dash punctuation */ + ucp_Pe, /* Close punctuation */ + ucp_Pf, /* Final punctuation */ + ucp_Pi, /* Initial punctuation */ + ucp_Po, /* Other punctuation */ + ucp_Ps, /* Open punctuation */ + ucp_Sc, /* Currency symbol */ + ucp_Sk, /* Modifier symbol */ + ucp_Sm, /* Mathematical symbol */ + ucp_So, /* Other symbol */ + ucp_Zl, /* Line separator */ + ucp_Zp, /* Paragraph separator */ + ucp_Zs /* Space separator */ +}; + +/* These are the script identifications. */ + +enum { + ucp_Arabic, + ucp_Armenian, + ucp_Bengali, + ucp_Bopomofo, + ucp_Braille, + ucp_Buginese, + ucp_Buhid, + ucp_Canadian_Aboriginal, + ucp_Cherokee, + ucp_Common, + ucp_Coptic, + ucp_Cypriot, + ucp_Cyrillic, + ucp_Deseret, + ucp_Devanagari, + ucp_Ethiopic, + ucp_Georgian, + ucp_Glagolitic, + ucp_Gothic, + ucp_Greek, + ucp_Gujarati, + ucp_Gurmukhi, + ucp_Han, + ucp_Hangul, + ucp_Hanunoo, + ucp_Hebrew, + ucp_Hiragana, + ucp_Inherited, + ucp_Kannada, + ucp_Katakana, + ucp_Kharoshthi, + ucp_Khmer, + ucp_Lao, + ucp_Latin, + ucp_Limbu, + ucp_Linear_B, + ucp_Malayalam, + ucp_Mongolian, + ucp_Myanmar, + ucp_New_Tai_Lue, + ucp_Ogham, + ucp_Old_Italic, + ucp_Old_Persian, + ucp_Oriya, + ucp_Osmanya, + ucp_Runic, + ucp_Shavian, + ucp_Sinhala, + ucp_Syloti_Nagri, + ucp_Syriac, + ucp_Tagalog, + ucp_Tagbanwa, + ucp_Tai_Le, + ucp_Tamil, + ucp_Telugu, + ucp_Thaana, + ucp_Thai, + ucp_Tibetan, + ucp_Tifinagh, + ucp_Ugaritic, + ucp_Yi, + ucp_Balinese, /* New for Unicode 5.0.0 */ + ucp_Cuneiform, /* New for Unicode 5.0.0 */ + ucp_Nko, /* New for Unicode 5.0.0 */ + ucp_Phags_Pa, /* New for Unicode 5.0.0 */ + ucp_Phoenician /* New for Unicode 5.0.0 */ +}; + +#endif + +/* End of ucp.h */ diff --git a/erts/emulator/pcre/ucpinternal.h b/erts/emulator/pcre/ucpinternal.h new file mode 100644 index 0000000000..9893d39672 --- /dev/null +++ b/erts/emulator/pcre/ucpinternal.h @@ -0,0 +1,94 @@ +/************************************************* +* Unicode Property Table handler * +*************************************************/ + +/* %ExternalCopyright% */ + +#ifndef _UCPINTERNAL_H +#define _UCPINTERNAL_H + +/* Internal header file defining the layout of the bits in each pair of 32-bit +words that form a data item in the table. */ + +typedef struct cnode { + pcre_uint32 f0; + pcre_uint32 f1; +} cnode; + +/* Things for the f0 field */ + +#define f0_scriptmask 0xff000000 /* Mask for script field */ +#define f0_scriptshift 24 /* Shift for script value */ +#define f0_rangeflag 0x00f00000 /* Flag for a range item */ +#define f0_charmask 0x001fffff /* Mask for code point value */ + +/* Things for the f1 field */ + +#define f1_typemask 0xfc000000 /* Mask for char type field */ +#define f1_typeshift 26 /* Shift for the type field */ +#define f1_rangemask 0x0000ffff /* Mask for a range offset */ +#define f1_casemask 0x0000ffff /* Mask for a case offset */ +#define f1_caseneg 0xffff8000 /* Bits for negation */ + +/* The data consists of a vector of structures of type cnode. The two unsigned +32-bit integers are used as follows: + +(f0) (1) The most significant byte holds the script number. The numbers are + defined by the enum in ucp.h. + + (2) The 0x00800000 bit is set if this entry defines a range of characters. + It is not set if this entry defines a single character + + (3) The 0x00600000 bits are spare. + + (4) The 0x001fffff bits contain the code point. No Unicode code point will + ever be greater than 0x0010ffff, so this should be OK for ever. + +(f1) (1) The 0xfc000000 bits contain the character type number. The numbers are + defined by an enum in ucp.h. + + (2) The 0x03ff0000 bits are spare. + + (3) The 0x0000ffff bits contain EITHER the unsigned offset to the top of + range if this entry defines a range, OR the *signed* offset to the + character's "other case" partner if this entry defines a single + character. There is no partner if the value is zero. + +------------------------------------------------------------------------------- +| script (8) |.|.|.| codepoint (21) || type (6) |.|.| spare (8) | offset (16) | +------------------------------------------------------------------------------- + | | | | | + | | |-> spare | |-> spare + | | | + | |-> spare |-> spare + | + |-> range flag + +The upper/lower casing information is set only for characters that come in +pairs. The non-one-to-one mappings in the Unicode data are ignored. + +When searching the data, proceed as follows: + +(1) Set up for a binary chop search. + +(2) If the top is not greater than the bottom, the character is not in the + table. Its type must therefore be "Cn" ("Undefined"). + +(3) Find the middle vector element. + +(4) Extract the code point and compare. If equal, we are done. + +(5) If the test character is smaller, set the top to the current point, and + goto (2). + +(6) If the current entry defines a range, compute the last character by adding + the offset, and see if the test character is within the range. If it is, + we are done. + +(7) Otherwise, set the bottom to one element past the current point and goto + (2). +*/ + +#endif /* _UCPINTERNAL_H */ + +/* End of ucpinternal.h */ diff --git a/erts/emulator/pcre/ucptable.h b/erts/emulator/pcre/ucptable.h new file mode 100644 index 0000000000..a274d443ee --- /dev/null +++ b/erts/emulator/pcre/ucptable.h @@ -0,0 +1,3088 @@ +/* This source module is automatically generated from the Unicode +property table. See ucpinternal.h for a description of the layout. +This version was made from the Unicode 5.0.0 tables. */ + +static const cnode ucp_table[] = { + { 0x09800000, 0x0000001f }, + { 0x09000020, 0x74000000 }, + { 0x09800021, 0x54000002 }, + { 0x09000024, 0x5c000000 }, + { 0x09800025, 0x54000002 }, + { 0x09000028, 0x58000000 }, + { 0x09000029, 0x48000000 }, + { 0x0900002a, 0x54000000 }, + { 0x0900002b, 0x64000000 }, + { 0x0900002c, 0x54000000 }, + { 0x0900002d, 0x44000000 }, + { 0x0980002e, 0x54000001 }, + { 0x09800030, 0x34000009 }, + { 0x0980003a, 0x54000001 }, + { 0x0980003c, 0x64000002 }, + { 0x0980003f, 0x54000001 }, + { 0x21000041, 0x24000020 }, + { 0x21000042, 0x24000020 }, + { 0x21000043, 0x24000020 }, + { 0x21000044, 0x24000020 }, + { 0x21000045, 0x24000020 }, + { 0x21000046, 0x24000020 }, + { 0x21000047, 0x24000020 }, + { 0x21000048, 0x24000020 }, + { 0x21000049, 0x24000020 }, + { 0x2100004a, 0x24000020 }, + { 0x2100004b, 0x24000020 }, + { 0x2100004c, 0x24000020 }, + { 0x2100004d, 0x24000020 }, + { 0x2100004e, 0x24000020 }, + { 0x2100004f, 0x24000020 }, + { 0x21000050, 0x24000020 }, + { 0x21000051, 0x24000020 }, + { 0x21000052, 0x24000020 }, + { 0x21000053, 0x24000020 }, + { 0x21000054, 0x24000020 }, + { 0x21000055, 0x24000020 }, + { 0x21000056, 0x24000020 }, + { 0x21000057, 0x24000020 }, + { 0x21000058, 0x24000020 }, + { 0x21000059, 0x24000020 }, + { 0x2100005a, 0x24000020 }, + { 0x0900005b, 0x58000000 }, + { 0x0900005c, 0x54000000 }, + { 0x0900005d, 0x48000000 }, + { 0x0900005e, 0x60000000 }, + { 0x0900005f, 0x40000000 }, + { 0x09000060, 0x60000000 }, + { 0x21000061, 0x1400ffe0 }, + { 0x21000062, 0x1400ffe0 }, + { 0x21000063, 0x1400ffe0 }, + { 0x21000064, 0x1400ffe0 }, + { 0x21000065, 0x1400ffe0 }, + { 0x21000066, 0x1400ffe0 }, + { 0x21000067, 0x1400ffe0 }, + { 0x21000068, 0x1400ffe0 }, + { 0x21000069, 0x1400ffe0 }, + { 0x2100006a, 0x1400ffe0 }, + { 0x2100006b, 0x1400ffe0 }, + { 0x2100006c, 0x1400ffe0 }, + { 0x2100006d, 0x1400ffe0 }, + { 0x2100006e, 0x1400ffe0 }, + { 0x2100006f, 0x1400ffe0 }, + { 0x21000070, 0x1400ffe0 }, + { 0x21000071, 0x1400ffe0 }, + { 0x21000072, 0x1400ffe0 }, + { 0x21000073, 0x1400ffe0 }, + { 0x21000074, 0x1400ffe0 }, + { 0x21000075, 0x1400ffe0 }, + { 0x21000076, 0x1400ffe0 }, + { 0x21000077, 0x1400ffe0 }, + { 0x21000078, 0x1400ffe0 }, + { 0x21000079, 0x1400ffe0 }, + { 0x2100007a, 0x1400ffe0 }, + { 0x0900007b, 0x58000000 }, + { 0x0900007c, 0x64000000 }, + { 0x0900007d, 0x48000000 }, + { 0x0900007e, 0x64000000 }, + { 0x0980007f, 0x00000020 }, + { 0x090000a0, 0x74000000 }, + { 0x090000a1, 0x54000000 }, + { 0x098000a2, 0x5c000003 }, + { 0x098000a6, 0x68000001 }, + { 0x090000a8, 0x60000000 }, + { 0x090000a9, 0x68000000 }, + { 0x210000aa, 0x14000000 }, + { 0x090000ab, 0x50000000 }, + { 0x090000ac, 0x64000000 }, + { 0x090000ad, 0x04000000 }, + { 0x090000ae, 0x68000000 }, + { 0x090000af, 0x60000000 }, + { 0x090000b0, 0x68000000 }, + { 0x090000b1, 0x64000000 }, + { 0x098000b2, 0x3c000001 }, + { 0x090000b4, 0x60000000 }, + { 0x090000b5, 0x140002e7 }, + { 0x090000b6, 0x68000000 }, + { 0x090000b7, 0x54000000 }, + { 0x090000b8, 0x60000000 }, + { 0x090000b9, 0x3c000000 }, + { 0x210000ba, 0x14000000 }, + { 0x090000bb, 0x4c000000 }, + { 0x098000bc, 0x3c000002 }, + { 0x090000bf, 0x54000000 }, + { 0x210000c0, 0x24000020 }, + { 0x210000c1, 0x24000020 }, + { 0x210000c2, 0x24000020 }, + { 0x210000c3, 0x24000020 }, + { 0x210000c4, 0x24000020 }, + { 0x210000c5, 0x24000020 }, + { 0x210000c6, 0x24000020 }, + { 0x210000c7, 0x24000020 }, + { 0x210000c8, 0x24000020 }, + { 0x210000c9, 0x24000020 }, + { 0x210000ca, 0x24000020 }, + { 0x210000cb, 0x24000020 }, + { 0x210000cc, 0x24000020 }, + { 0x210000cd, 0x24000020 }, + { 0x210000ce, 0x24000020 }, + { 0x210000cf, 0x24000020 }, + { 0x210000d0, 0x24000020 }, + { 0x210000d1, 0x24000020 }, + { 0x210000d2, 0x24000020 }, + { 0x210000d3, 0x24000020 }, + { 0x210000d4, 0x24000020 }, + { 0x210000d5, 0x24000020 }, + { 0x210000d6, 0x24000020 }, + { 0x090000d7, 0x64000000 }, + { 0x210000d8, 0x24000020 }, + { 0x210000d9, 0x24000020 }, + { 0x210000da, 0x24000020 }, + { 0x210000db, 0x24000020 }, + { 0x210000dc, 0x24000020 }, + { 0x210000dd, 0x24000020 }, + { 0x210000de, 0x24000020 }, + { 0x210000df, 0x14000000 }, + { 0x210000e0, 0x1400ffe0 }, + { 0x210000e1, 0x1400ffe0 }, + { 0x210000e2, 0x1400ffe0 }, + { 0x210000e3, 0x1400ffe0 }, + { 0x210000e4, 0x1400ffe0 }, + { 0x210000e5, 0x1400ffe0 }, + { 0x210000e6, 0x1400ffe0 }, + { 0x210000e7, 0x1400ffe0 }, + { 0x210000e8, 0x1400ffe0 }, + { 0x210000e9, 0x1400ffe0 }, + { 0x210000ea, 0x1400ffe0 }, + { 0x210000eb, 0x1400ffe0 }, + { 0x210000ec, 0x1400ffe0 }, + { 0x210000ed, 0x1400ffe0 }, + { 0x210000ee, 0x1400ffe0 }, + { 0x210000ef, 0x1400ffe0 }, + { 0x210000f0, 0x1400ffe0 }, + { 0x210000f1, 0x1400ffe0 }, + { 0x210000f2, 0x1400ffe0 }, + { 0x210000f3, 0x1400ffe0 }, + { 0x210000f4, 0x1400ffe0 }, + { 0x210000f5, 0x1400ffe0 }, + { 0x210000f6, 0x1400ffe0 }, + { 0x090000f7, 0x64000000 }, + { 0x210000f8, 0x1400ffe0 }, + { 0x210000f9, 0x1400ffe0 }, + { 0x210000fa, 0x1400ffe0 }, + { 0x210000fb, 0x1400ffe0 }, + { 0x210000fc, 0x1400ffe0 }, + { 0x210000fd, 0x1400ffe0 }, + { 0x210000fe, 0x1400ffe0 }, + { 0x210000ff, 0x14000079 }, + { 0x21000100, 0x24000001 }, + { 0x21000101, 0x1400ffff }, + { 0x21000102, 0x24000001 }, + { 0x21000103, 0x1400ffff }, + { 0x21000104, 0x24000001 }, + { 0x21000105, 0x1400ffff }, + { 0x21000106, 0x24000001 }, + { 0x21000107, 0x1400ffff }, + { 0x21000108, 0x24000001 }, + { 0x21000109, 0x1400ffff }, + { 0x2100010a, 0x24000001 }, + { 0x2100010b, 0x1400ffff }, + { 0x2100010c, 0x24000001 }, + { 0x2100010d, 0x1400ffff }, + { 0x2100010e, 0x24000001 }, + { 0x2100010f, 0x1400ffff }, + { 0x21000110, 0x24000001 }, + { 0x21000111, 0x1400ffff }, + { 0x21000112, 0x24000001 }, + { 0x21000113, 0x1400ffff }, + { 0x21000114, 0x24000001 }, + { 0x21000115, 0x1400ffff }, + { 0x21000116, 0x24000001 }, + { 0x21000117, 0x1400ffff }, + { 0x21000118, 0x24000001 }, + { 0x21000119, 0x1400ffff }, + { 0x2100011a, 0x24000001 }, + { 0x2100011b, 0x1400ffff }, + { 0x2100011c, 0x24000001 }, + { 0x2100011d, 0x1400ffff }, + { 0x2100011e, 0x24000001 }, + { 0x2100011f, 0x1400ffff }, + { 0x21000120, 0x24000001 }, + { 0x21000121, 0x1400ffff }, + { 0x21000122, 0x24000001 }, + { 0x21000123, 0x1400ffff }, + { 0x21000124, 0x24000001 }, + { 0x21000125, 0x1400ffff }, + { 0x21000126, 0x24000001 }, + { 0x21000127, 0x1400ffff }, + { 0x21000128, 0x24000001 }, + { 0x21000129, 0x1400ffff }, + { 0x2100012a, 0x24000001 }, + { 0x2100012b, 0x1400ffff }, + { 0x2100012c, 0x24000001 }, + { 0x2100012d, 0x1400ffff }, + { 0x2100012e, 0x24000001 }, + { 0x2100012f, 0x1400ffff }, + { 0x21000130, 0x2400ff39 }, + { 0x21000131, 0x1400ff18 }, + { 0x21000132, 0x24000001 }, + { 0x21000133, 0x1400ffff }, + { 0x21000134, 0x24000001 }, + { 0x21000135, 0x1400ffff }, + { 0x21000136, 0x24000001 }, + { 0x21000137, 0x1400ffff }, + { 0x21000138, 0x14000000 }, + { 0x21000139, 0x24000001 }, + { 0x2100013a, 0x1400ffff }, + { 0x2100013b, 0x24000001 }, + { 0x2100013c, 0x1400ffff }, + { 0x2100013d, 0x24000001 }, + { 0x2100013e, 0x1400ffff }, + { 0x2100013f, 0x24000001 }, + { 0x21000140, 0x1400ffff }, + { 0x21000141, 0x24000001 }, + { 0x21000142, 0x1400ffff }, + { 0x21000143, 0x24000001 }, + { 0x21000144, 0x1400ffff }, + { 0x21000145, 0x24000001 }, + { 0x21000146, 0x1400ffff }, + { 0x21000147, 0x24000001 }, + { 0x21000148, 0x1400ffff }, + { 0x21000149, 0x14000000 }, + { 0x2100014a, 0x24000001 }, + { 0x2100014b, 0x1400ffff }, + { 0x2100014c, 0x24000001 }, + { 0x2100014d, 0x1400ffff }, + { 0x2100014e, 0x24000001 }, + { 0x2100014f, 0x1400ffff }, + { 0x21000150, 0x24000001 }, + { 0x21000151, 0x1400ffff }, + { 0x21000152, 0x24000001 }, + { 0x21000153, 0x1400ffff }, + { 0x21000154, 0x24000001 }, + { 0x21000155, 0x1400ffff }, + { 0x21000156, 0x24000001 }, + { 0x21000157, 0x1400ffff }, + { 0x21000158, 0x24000001 }, + { 0x21000159, 0x1400ffff }, + { 0x2100015a, 0x24000001 }, + { 0x2100015b, 0x1400ffff }, + { 0x2100015c, 0x24000001 }, + { 0x2100015d, 0x1400ffff }, + { 0x2100015e, 0x24000001 }, + { 0x2100015f, 0x1400ffff }, + { 0x21000160, 0x24000001 }, + { 0x21000161, 0x1400ffff }, + { 0x21000162, 0x24000001 }, + { 0x21000163, 0x1400ffff }, + { 0x21000164, 0x24000001 }, + { 0x21000165, 0x1400ffff }, + { 0x21000166, 0x24000001 }, + { 0x21000167, 0x1400ffff }, + { 0x21000168, 0x24000001 }, + { 0x21000169, 0x1400ffff }, + { 0x2100016a, 0x24000001 }, + { 0x2100016b, 0x1400ffff }, + { 0x2100016c, 0x24000001 }, + { 0x2100016d, 0x1400ffff }, + { 0x2100016e, 0x24000001 }, + { 0x2100016f, 0x1400ffff }, + { 0x21000170, 0x24000001 }, + { 0x21000171, 0x1400ffff }, + { 0x21000172, 0x24000001 }, + { 0x21000173, 0x1400ffff }, + { 0x21000174, 0x24000001 }, + { 0x21000175, 0x1400ffff }, + { 0x21000176, 0x24000001 }, + { 0x21000177, 0x1400ffff }, + { 0x21000178, 0x2400ff87 }, + { 0x21000179, 0x24000001 }, + { 0x2100017a, 0x1400ffff }, + { 0x2100017b, 0x24000001 }, + { 0x2100017c, 0x1400ffff }, + { 0x2100017d, 0x24000001 }, + { 0x2100017e, 0x1400ffff }, + { 0x2100017f, 0x1400fed4 }, + { 0x21000180, 0x140000c3 }, + { 0x21000181, 0x240000d2 }, + { 0x21000182, 0x24000001 }, + { 0x21000183, 0x1400ffff }, + { 0x21000184, 0x24000001 }, + { 0x21000185, 0x1400ffff }, + { 0x21000186, 0x240000ce }, + { 0x21000187, 0x24000001 }, + { 0x21000188, 0x1400ffff }, + { 0x21000189, 0x240000cd }, + { 0x2100018a, 0x240000cd }, + { 0x2100018b, 0x24000001 }, + { 0x2100018c, 0x1400ffff }, + { 0x2100018d, 0x14000000 }, + { 0x2100018e, 0x2400004f }, + { 0x2100018f, 0x240000ca }, + { 0x21000190, 0x240000cb }, + { 0x21000191, 0x24000001 }, + { 0x21000192, 0x1400ffff }, + { 0x21000193, 0x240000cd }, + { 0x21000194, 0x240000cf }, + { 0x21000195, 0x14000061 }, + { 0x21000196, 0x240000d3 }, + { 0x21000197, 0x240000d1 }, + { 0x21000198, 0x24000001 }, + { 0x21000199, 0x1400ffff }, + { 0x2100019a, 0x140000a3 }, + { 0x2100019b, 0x14000000 }, + { 0x2100019c, 0x240000d3 }, + { 0x2100019d, 0x240000d5 }, + { 0x2100019e, 0x14000082 }, + { 0x2100019f, 0x240000d6 }, + { 0x210001a0, 0x24000001 }, + { 0x210001a1, 0x1400ffff }, + { 0x210001a2, 0x24000001 }, + { 0x210001a3, 0x1400ffff }, + { 0x210001a4, 0x24000001 }, + { 0x210001a5, 0x1400ffff }, + { 0x210001a6, 0x240000da }, + { 0x210001a7, 0x24000001 }, + { 0x210001a8, 0x1400ffff }, + { 0x210001a9, 0x240000da }, + { 0x218001aa, 0x14000001 }, + { 0x210001ac, 0x24000001 }, + { 0x210001ad, 0x1400ffff }, + { 0x210001ae, 0x240000da }, + { 0x210001af, 0x24000001 }, + { 0x210001b0, 0x1400ffff }, + { 0x210001b1, 0x240000d9 }, + { 0x210001b2, 0x240000d9 }, + { 0x210001b3, 0x24000001 }, + { 0x210001b4, 0x1400ffff }, + { 0x210001b5, 0x24000001 }, + { 0x210001b6, 0x1400ffff }, + { 0x210001b7, 0x240000db }, + { 0x210001b8, 0x24000001 }, + { 0x210001b9, 0x1400ffff }, + { 0x210001ba, 0x14000000 }, + { 0x210001bb, 0x1c000000 }, + { 0x210001bc, 0x24000001 }, + { 0x210001bd, 0x1400ffff }, + { 0x210001be, 0x14000000 }, + { 0x210001bf, 0x14000038 }, + { 0x218001c0, 0x1c000003 }, + { 0x210001c4, 0x24000002 }, + { 0x210001c5, 0x2000ffff }, + { 0x210001c6, 0x1400fffe }, + { 0x210001c7, 0x24000002 }, + { 0x210001c8, 0x2000ffff }, + { 0x210001c9, 0x1400fffe }, + { 0x210001ca, 0x24000002 }, + { 0x210001cb, 0x2000ffff }, + { 0x210001cc, 0x1400fffe }, + { 0x210001cd, 0x24000001 }, + { 0x210001ce, 0x1400ffff }, + { 0x210001cf, 0x24000001 }, + { 0x210001d0, 0x1400ffff }, + { 0x210001d1, 0x24000001 }, + { 0x210001d2, 0x1400ffff }, + { 0x210001d3, 0x24000001 }, + { 0x210001d4, 0x1400ffff }, + { 0x210001d5, 0x24000001 }, + { 0x210001d6, 0x1400ffff }, + { 0x210001d7, 0x24000001 }, + { 0x210001d8, 0x1400ffff }, + { 0x210001d9, 0x24000001 }, + { 0x210001da, 0x1400ffff }, + { 0x210001db, 0x24000001 }, + { 0x210001dc, 0x1400ffff }, + { 0x210001dd, 0x1400ffb1 }, + { 0x210001de, 0x24000001 }, + { 0x210001df, 0x1400ffff }, + { 0x210001e0, 0x24000001 }, + { 0x210001e1, 0x1400ffff }, + { 0x210001e2, 0x24000001 }, + { 0x210001e3, 0x1400ffff }, + { 0x210001e4, 0x24000001 }, + { 0x210001e5, 0x1400ffff }, + { 0x210001e6, 0x24000001 }, + { 0x210001e7, 0x1400ffff }, + { 0x210001e8, 0x24000001 }, + { 0x210001e9, 0x1400ffff }, + { 0x210001ea, 0x24000001 }, + { 0x210001eb, 0x1400ffff }, + { 0x210001ec, 0x24000001 }, + { 0x210001ed, 0x1400ffff }, + { 0x210001ee, 0x24000001 }, + { 0x210001ef, 0x1400ffff }, + { 0x210001f0, 0x14000000 }, + { 0x210001f1, 0x24000002 }, + { 0x210001f2, 0x2000ffff }, + { 0x210001f3, 0x1400fffe }, + { 0x210001f4, 0x24000001 }, + { 0x210001f5, 0x1400ffff }, + { 0x210001f6, 0x2400ff9f }, + { 0x210001f7, 0x2400ffc8 }, + { 0x210001f8, 0x24000001 }, + { 0x210001f9, 0x1400ffff }, + { 0x210001fa, 0x24000001 }, + { 0x210001fb, 0x1400ffff }, + { 0x210001fc, 0x24000001 }, + { 0x210001fd, 0x1400ffff }, + { 0x210001fe, 0x24000001 }, + { 0x210001ff, 0x1400ffff }, + { 0x21000200, 0x24000001 }, + { 0x21000201, 0x1400ffff }, + { 0x21000202, 0x24000001 }, + { 0x21000203, 0x1400ffff }, + { 0x21000204, 0x24000001 }, + { 0x21000205, 0x1400ffff }, + { 0x21000206, 0x24000001 }, + { 0x21000207, 0x1400ffff }, + { 0x21000208, 0x24000001 }, + { 0x21000209, 0x1400ffff }, + { 0x2100020a, 0x24000001 }, + { 0x2100020b, 0x1400ffff }, + { 0x2100020c, 0x24000001 }, + { 0x2100020d, 0x1400ffff }, + { 0x2100020e, 0x24000001 }, + { 0x2100020f, 0x1400ffff }, + { 0x21000210, 0x24000001 }, + { 0x21000211, 0x1400ffff }, + { 0x21000212, 0x24000001 }, + { 0x21000213, 0x1400ffff }, + { 0x21000214, 0x24000001 }, + { 0x21000215, 0x1400ffff }, + { 0x21000216, 0x24000001 }, + { 0x21000217, 0x1400ffff }, + { 0x21000218, 0x24000001 }, + { 0x21000219, 0x1400ffff }, + { 0x2100021a, 0x24000001 }, + { 0x2100021b, 0x1400ffff }, + { 0x2100021c, 0x24000001 }, + { 0x2100021d, 0x1400ffff }, + { 0x2100021e, 0x24000001 }, + { 0x2100021f, 0x1400ffff }, + { 0x21000220, 0x2400ff7e }, + { 0x21000221, 0x14000000 }, + { 0x21000222, 0x24000001 }, + { 0x21000223, 0x1400ffff }, + { 0x21000224, 0x24000001 }, + { 0x21000225, 0x1400ffff }, + { 0x21000226, 0x24000001 }, + { 0x21000227, 0x1400ffff }, + { 0x21000228, 0x24000001 }, + { 0x21000229, 0x1400ffff }, + { 0x2100022a, 0x24000001 }, + { 0x2100022b, 0x1400ffff }, + { 0x2100022c, 0x24000001 }, + { 0x2100022d, 0x1400ffff }, + { 0x2100022e, 0x24000001 }, + { 0x2100022f, 0x1400ffff }, + { 0x21000230, 0x24000001 }, + { 0x21000231, 0x1400ffff }, + { 0x21000232, 0x24000001 }, + { 0x21000233, 0x1400ffff }, + { 0x21800234, 0x14000005 }, + { 0x2100023a, 0x24002a2b }, + { 0x2100023b, 0x24000001 }, + { 0x2100023c, 0x1400ffff }, + { 0x2100023d, 0x2400ff5d }, + { 0x2100023e, 0x24002a28 }, + { 0x2180023f, 0x14000001 }, + { 0x21000241, 0x24000001 }, + { 0x21000242, 0x1400ffff }, + { 0x21000243, 0x2400ff3d }, + { 0x21000244, 0x24000045 }, + { 0x21000245, 0x24000047 }, + { 0x21000246, 0x24000001 }, + { 0x21000247, 0x1400ffff }, + { 0x21000248, 0x24000001 }, + { 0x21000249, 0x1400ffff }, + { 0x2100024a, 0x24000001 }, + { 0x2100024b, 0x1400ffff }, + { 0x2100024c, 0x24000001 }, + { 0x2100024d, 0x1400ffff }, + { 0x2100024e, 0x24000001 }, + { 0x2100024f, 0x1400ffff }, + { 0x21800250, 0x14000002 }, + { 0x21000253, 0x1400ff2e }, + { 0x21000254, 0x1400ff32 }, + { 0x21000255, 0x14000000 }, + { 0x21000256, 0x1400ff33 }, + { 0x21000257, 0x1400ff33 }, + { 0x21000258, 0x14000000 }, + { 0x21000259, 0x1400ff36 }, + { 0x2100025a, 0x14000000 }, + { 0x2100025b, 0x1400ff35 }, + { 0x2180025c, 0x14000003 }, + { 0x21000260, 0x1400ff33 }, + { 0x21800261, 0x14000001 }, + { 0x21000263, 0x1400ff31 }, + { 0x21800264, 0x14000003 }, + { 0x21000268, 0x1400ff2f }, + { 0x21000269, 0x1400ff2d }, + { 0x2100026a, 0x14000000 }, + { 0x2100026b, 0x140029f7 }, + { 0x2180026c, 0x14000002 }, + { 0x2100026f, 0x1400ff2d }, + { 0x21800270, 0x14000001 }, + { 0x21000272, 0x1400ff2b }, + { 0x21800273, 0x14000001 }, + { 0x21000275, 0x1400ff2a }, + { 0x21800276, 0x14000006 }, + { 0x2100027d, 0x140029e7 }, + { 0x2180027e, 0x14000001 }, + { 0x21000280, 0x1400ff26 }, + { 0x21800281, 0x14000001 }, + { 0x21000283, 0x1400ff26 }, + { 0x21800284, 0x14000003 }, + { 0x21000288, 0x1400ff26 }, + { 0x21000289, 0x1400ffbb }, + { 0x2100028a, 0x1400ff27 }, + { 0x2100028b, 0x1400ff27 }, + { 0x2100028c, 0x1400ffb9 }, + { 0x2180028d, 0x14000004 }, + { 0x21000292, 0x1400ff25 }, + { 0x21000293, 0x14000000 }, + { 0x21000294, 0x1c000000 }, + { 0x21800295, 0x1400001a }, + { 0x218002b0, 0x18000008 }, + { 0x098002b9, 0x18000008 }, + { 0x098002c2, 0x60000003 }, + { 0x098002c6, 0x1800000b }, + { 0x098002d2, 0x6000000d }, + { 0x218002e0, 0x18000004 }, + { 0x098002e5, 0x60000008 }, + { 0x090002ee, 0x18000000 }, + { 0x098002ef, 0x60000010 }, + { 0x1b800300, 0x30000044 }, + { 0x1b000345, 0x30000054 }, + { 0x1b800346, 0x30000029 }, + { 0x13800374, 0x60000001 }, + { 0x1300037a, 0x18000000 }, + { 0x1300037b, 0x14000082 }, + { 0x1300037c, 0x14000082 }, + { 0x1300037d, 0x14000082 }, + { 0x0900037e, 0x54000000 }, + { 0x13800384, 0x60000001 }, + { 0x13000386, 0x24000026 }, + { 0x09000387, 0x54000000 }, + { 0x13000388, 0x24000025 }, + { 0x13000389, 0x24000025 }, + { 0x1300038a, 0x24000025 }, + { 0x1300038c, 0x24000040 }, + { 0x1300038e, 0x2400003f }, + { 0x1300038f, 0x2400003f }, + { 0x13000390, 0x14000000 }, + { 0x13000391, 0x24000020 }, + { 0x13000392, 0x24000020 }, + { 0x13000393, 0x24000020 }, + { 0x13000394, 0x24000020 }, + { 0x13000395, 0x24000020 }, + { 0x13000396, 0x24000020 }, + { 0x13000397, 0x24000020 }, + { 0x13000398, 0x24000020 }, + { 0x13000399, 0x24000020 }, + { 0x1300039a, 0x24000020 }, + { 0x1300039b, 0x24000020 }, + { 0x1300039c, 0x24000020 }, + { 0x1300039d, 0x24000020 }, + { 0x1300039e, 0x24000020 }, + { 0x1300039f, 0x24000020 }, + { 0x130003a0, 0x24000020 }, + { 0x130003a1, 0x24000020 }, + { 0x130003a3, 0x24000020 }, + { 0x130003a4, 0x24000020 }, + { 0x130003a5, 0x24000020 }, + { 0x130003a6, 0x24000020 }, + { 0x130003a7, 0x24000020 }, + { 0x130003a8, 0x24000020 }, + { 0x130003a9, 0x24000020 }, + { 0x130003aa, 0x24000020 }, + { 0x130003ab, 0x24000020 }, + { 0x130003ac, 0x1400ffda }, + { 0x130003ad, 0x1400ffdb }, + { 0x130003ae, 0x1400ffdb }, + { 0x130003af, 0x1400ffdb }, + { 0x130003b0, 0x14000000 }, + { 0x130003b1, 0x1400ffe0 }, + { 0x130003b2, 0x1400ffe0 }, + { 0x130003b3, 0x1400ffe0 }, + { 0x130003b4, 0x1400ffe0 }, + { 0x130003b5, 0x1400ffe0 }, + { 0x130003b6, 0x1400ffe0 }, + { 0x130003b7, 0x1400ffe0 }, + { 0x130003b8, 0x1400ffe0 }, + { 0x130003b9, 0x1400ffe0 }, + { 0x130003ba, 0x1400ffe0 }, + { 0x130003bb, 0x1400ffe0 }, + { 0x130003bc, 0x1400ffe0 }, + { 0x130003bd, 0x1400ffe0 }, + { 0x130003be, 0x1400ffe0 }, + { 0x130003bf, 0x1400ffe0 }, + { 0x130003c0, 0x1400ffe0 }, + { 0x130003c1, 0x1400ffe0 }, + { 0x130003c2, 0x1400ffe1 }, + { 0x130003c3, 0x1400ffe0 }, + { 0x130003c4, 0x1400ffe0 }, + { 0x130003c5, 0x1400ffe0 }, + { 0x130003c6, 0x1400ffe0 }, + { 0x130003c7, 0x1400ffe0 }, + { 0x130003c8, 0x1400ffe0 }, + { 0x130003c9, 0x1400ffe0 }, + { 0x130003ca, 0x1400ffe0 }, + { 0x130003cb, 0x1400ffe0 }, + { 0x130003cc, 0x1400ffc0 }, + { 0x130003cd, 0x1400ffc1 }, + { 0x130003ce, 0x1400ffc1 }, + { 0x130003d0, 0x1400ffc2 }, + { 0x130003d1, 0x1400ffc7 }, + { 0x138003d2, 0x24000002 }, + { 0x130003d5, 0x1400ffd1 }, + { 0x130003d6, 0x1400ffca }, + { 0x130003d7, 0x14000000 }, + { 0x130003d8, 0x24000001 }, + { 0x130003d9, 0x1400ffff }, + { 0x130003da, 0x24000001 }, + { 0x130003db, 0x1400ffff }, + { 0x130003dc, 0x24000001 }, + { 0x130003dd, 0x1400ffff }, + { 0x130003de, 0x24000001 }, + { 0x130003df, 0x1400ffff }, + { 0x130003e0, 0x24000001 }, + { 0x130003e1, 0x1400ffff }, + { 0x0a0003e2, 0x24000001 }, + { 0x0a0003e3, 0x1400ffff }, + { 0x0a0003e4, 0x24000001 }, + { 0x0a0003e5, 0x1400ffff }, + { 0x0a0003e6, 0x24000001 }, + { 0x0a0003e7, 0x1400ffff }, + { 0x0a0003e8, 0x24000001 }, + { 0x0a0003e9, 0x1400ffff }, + { 0x0a0003ea, 0x24000001 }, + { 0x0a0003eb, 0x1400ffff }, + { 0x0a0003ec, 0x24000001 }, + { 0x0a0003ed, 0x1400ffff }, + { 0x0a0003ee, 0x24000001 }, + { 0x0a0003ef, 0x1400ffff }, + { 0x130003f0, 0x1400ffaa }, + { 0x130003f1, 0x1400ffb0 }, + { 0x130003f2, 0x14000007 }, + { 0x130003f3, 0x14000000 }, + { 0x130003f4, 0x2400ffc4 }, + { 0x130003f5, 0x1400ffa0 }, + { 0x130003f6, 0x64000000 }, + { 0x130003f7, 0x24000001 }, + { 0x130003f8, 0x1400ffff }, + { 0x130003f9, 0x2400fff9 }, + { 0x130003fa, 0x24000001 }, + { 0x130003fb, 0x1400ffff }, + { 0x130003fc, 0x14000000 }, + { 0x130003fd, 0x2400ff7e }, + { 0x130003fe, 0x2400ff7e }, + { 0x130003ff, 0x2400ff7e }, + { 0x0c000400, 0x24000050 }, + { 0x0c000401, 0x24000050 }, + { 0x0c000402, 0x24000050 }, + { 0x0c000403, 0x24000050 }, + { 0x0c000404, 0x24000050 }, + { 0x0c000405, 0x24000050 }, + { 0x0c000406, 0x24000050 }, + { 0x0c000407, 0x24000050 }, + { 0x0c000408, 0x24000050 }, + { 0x0c000409, 0x24000050 }, + { 0x0c00040a, 0x24000050 }, + { 0x0c00040b, 0x24000050 }, + { 0x0c00040c, 0x24000050 }, + { 0x0c00040d, 0x24000050 }, + { 0x0c00040e, 0x24000050 }, + { 0x0c00040f, 0x24000050 }, + { 0x0c000410, 0x24000020 }, + { 0x0c000411, 0x24000020 }, + { 0x0c000412, 0x24000020 }, + { 0x0c000413, 0x24000020 }, + { 0x0c000414, 0x24000020 }, + { 0x0c000415, 0x24000020 }, + { 0x0c000416, 0x24000020 }, + { 0x0c000417, 0x24000020 }, + { 0x0c000418, 0x24000020 }, + { 0x0c000419, 0x24000020 }, + { 0x0c00041a, 0x24000020 }, + { 0x0c00041b, 0x24000020 }, + { 0x0c00041c, 0x24000020 }, + { 0x0c00041d, 0x24000020 }, + { 0x0c00041e, 0x24000020 }, + { 0x0c00041f, 0x24000020 }, + { 0x0c000420, 0x24000020 }, + { 0x0c000421, 0x24000020 }, + { 0x0c000422, 0x24000020 }, + { 0x0c000423, 0x24000020 }, + { 0x0c000424, 0x24000020 }, + { 0x0c000425, 0x24000020 }, + { 0x0c000426, 0x24000020 }, + { 0x0c000427, 0x24000020 }, + { 0x0c000428, 0x24000020 }, + { 0x0c000429, 0x24000020 }, + { 0x0c00042a, 0x24000020 }, + { 0x0c00042b, 0x24000020 }, + { 0x0c00042c, 0x24000020 }, + { 0x0c00042d, 0x24000020 }, + { 0x0c00042e, 0x24000020 }, + { 0x0c00042f, 0x24000020 }, + { 0x0c000430, 0x1400ffe0 }, + { 0x0c000431, 0x1400ffe0 }, + { 0x0c000432, 0x1400ffe0 }, + { 0x0c000433, 0x1400ffe0 }, + { 0x0c000434, 0x1400ffe0 }, + { 0x0c000435, 0x1400ffe0 }, + { 0x0c000436, 0x1400ffe0 }, + { 0x0c000437, 0x1400ffe0 }, + { 0x0c000438, 0x1400ffe0 }, + { 0x0c000439, 0x1400ffe0 }, + { 0x0c00043a, 0x1400ffe0 }, + { 0x0c00043b, 0x1400ffe0 }, + { 0x0c00043c, 0x1400ffe0 }, + { 0x0c00043d, 0x1400ffe0 }, + { 0x0c00043e, 0x1400ffe0 }, + { 0x0c00043f, 0x1400ffe0 }, + { 0x0c000440, 0x1400ffe0 }, + { 0x0c000441, 0x1400ffe0 }, + { 0x0c000442, 0x1400ffe0 }, + { 0x0c000443, 0x1400ffe0 }, + { 0x0c000444, 0x1400ffe0 }, + { 0x0c000445, 0x1400ffe0 }, + { 0x0c000446, 0x1400ffe0 }, + { 0x0c000447, 0x1400ffe0 }, + { 0x0c000448, 0x1400ffe0 }, + { 0x0c000449, 0x1400ffe0 }, + { 0x0c00044a, 0x1400ffe0 }, + { 0x0c00044b, 0x1400ffe0 }, + { 0x0c00044c, 0x1400ffe0 }, + { 0x0c00044d, 0x1400ffe0 }, + { 0x0c00044e, 0x1400ffe0 }, + { 0x0c00044f, 0x1400ffe0 }, + { 0x0c000450, 0x1400ffb0 }, + { 0x0c000451, 0x1400ffb0 }, + { 0x0c000452, 0x1400ffb0 }, + { 0x0c000453, 0x1400ffb0 }, + { 0x0c000454, 0x1400ffb0 }, + { 0x0c000455, 0x1400ffb0 }, + { 0x0c000456, 0x1400ffb0 }, + { 0x0c000457, 0x1400ffb0 }, + { 0x0c000458, 0x1400ffb0 }, + { 0x0c000459, 0x1400ffb0 }, + { 0x0c00045a, 0x1400ffb0 }, + { 0x0c00045b, 0x1400ffb0 }, + { 0x0c00045c, 0x1400ffb0 }, + { 0x0c00045d, 0x1400ffb0 }, + { 0x0c00045e, 0x1400ffb0 }, + { 0x0c00045f, 0x1400ffb0 }, + { 0x0c000460, 0x24000001 }, + { 0x0c000461, 0x1400ffff }, + { 0x0c000462, 0x24000001 }, + { 0x0c000463, 0x1400ffff }, + { 0x0c000464, 0x24000001 }, + { 0x0c000465, 0x1400ffff }, + { 0x0c000466, 0x24000001 }, + { 0x0c000467, 0x1400ffff }, + { 0x0c000468, 0x24000001 }, + { 0x0c000469, 0x1400ffff }, + { 0x0c00046a, 0x24000001 }, + { 0x0c00046b, 0x1400ffff }, + { 0x0c00046c, 0x24000001 }, + { 0x0c00046d, 0x1400ffff }, + { 0x0c00046e, 0x24000001 }, + { 0x0c00046f, 0x1400ffff }, + { 0x0c000470, 0x24000001 }, + { 0x0c000471, 0x1400ffff }, + { 0x0c000472, 0x24000001 }, + { 0x0c000473, 0x1400ffff }, + { 0x0c000474, 0x24000001 }, + { 0x0c000475, 0x1400ffff }, + { 0x0c000476, 0x24000001 }, + { 0x0c000477, 0x1400ffff }, + { 0x0c000478, 0x24000001 }, + { 0x0c000479, 0x1400ffff }, + { 0x0c00047a, 0x24000001 }, + { 0x0c00047b, 0x1400ffff }, + { 0x0c00047c, 0x24000001 }, + { 0x0c00047d, 0x1400ffff }, + { 0x0c00047e, 0x24000001 }, + { 0x0c00047f, 0x1400ffff }, + { 0x0c000480, 0x24000001 }, + { 0x0c000481, 0x1400ffff }, + { 0x0c000482, 0x68000000 }, + { 0x0c800483, 0x30000003 }, + { 0x0c800488, 0x2c000001 }, + { 0x0c00048a, 0x24000001 }, + { 0x0c00048b, 0x1400ffff }, + { 0x0c00048c, 0x24000001 }, + { 0x0c00048d, 0x1400ffff }, + { 0x0c00048e, 0x24000001 }, + { 0x0c00048f, 0x1400ffff }, + { 0x0c000490, 0x24000001 }, + { 0x0c000491, 0x1400ffff }, + { 0x0c000492, 0x24000001 }, + { 0x0c000493, 0x1400ffff }, + { 0x0c000494, 0x24000001 }, + { 0x0c000495, 0x1400ffff }, + { 0x0c000496, 0x24000001 }, + { 0x0c000497, 0x1400ffff }, + { 0x0c000498, 0x24000001 }, + { 0x0c000499, 0x1400ffff }, + { 0x0c00049a, 0x24000001 }, + { 0x0c00049b, 0x1400ffff }, + { 0x0c00049c, 0x24000001 }, + { 0x0c00049d, 0x1400ffff }, + { 0x0c00049e, 0x24000001 }, + { 0x0c00049f, 0x1400ffff }, + { 0x0c0004a0, 0x24000001 }, + { 0x0c0004a1, 0x1400ffff }, + { 0x0c0004a2, 0x24000001 }, + { 0x0c0004a3, 0x1400ffff }, + { 0x0c0004a4, 0x24000001 }, + { 0x0c0004a5, 0x1400ffff }, + { 0x0c0004a6, 0x24000001 }, + { 0x0c0004a7, 0x1400ffff }, + { 0x0c0004a8, 0x24000001 }, + { 0x0c0004a9, 0x1400ffff }, + { 0x0c0004aa, 0x24000001 }, + { 0x0c0004ab, 0x1400ffff }, + { 0x0c0004ac, 0x24000001 }, + { 0x0c0004ad, 0x1400ffff }, + { 0x0c0004ae, 0x24000001 }, + { 0x0c0004af, 0x1400ffff }, + { 0x0c0004b0, 0x24000001 }, + { 0x0c0004b1, 0x1400ffff }, + { 0x0c0004b2, 0x24000001 }, + { 0x0c0004b3, 0x1400ffff }, + { 0x0c0004b4, 0x24000001 }, + { 0x0c0004b5, 0x1400ffff }, + { 0x0c0004b6, 0x24000001 }, + { 0x0c0004b7, 0x1400ffff }, + { 0x0c0004b8, 0x24000001 }, + { 0x0c0004b9, 0x1400ffff }, + { 0x0c0004ba, 0x24000001 }, + { 0x0c0004bb, 0x1400ffff }, + { 0x0c0004bc, 0x24000001 }, + { 0x0c0004bd, 0x1400ffff }, + { 0x0c0004be, 0x24000001 }, + { 0x0c0004bf, 0x1400ffff }, + { 0x0c0004c0, 0x2400000f }, + { 0x0c0004c1, 0x24000001 }, + { 0x0c0004c2, 0x1400ffff }, + { 0x0c0004c3, 0x24000001 }, + { 0x0c0004c4, 0x1400ffff }, + { 0x0c0004c5, 0x24000001 }, + { 0x0c0004c6, 0x1400ffff }, + { 0x0c0004c7, 0x24000001 }, + { 0x0c0004c8, 0x1400ffff }, + { 0x0c0004c9, 0x24000001 }, + { 0x0c0004ca, 0x1400ffff }, + { 0x0c0004cb, 0x24000001 }, + { 0x0c0004cc, 0x1400ffff }, + { 0x0c0004cd, 0x24000001 }, + { 0x0c0004ce, 0x1400ffff }, + { 0x0c0004cf, 0x1400fff1 }, + { 0x0c0004d0, 0x24000001 }, + { 0x0c0004d1, 0x1400ffff }, + { 0x0c0004d2, 0x24000001 }, + { 0x0c0004d3, 0x1400ffff }, + { 0x0c0004d4, 0x24000001 }, + { 0x0c0004d5, 0x1400ffff }, + { 0x0c0004d6, 0x24000001 }, + { 0x0c0004d7, 0x1400ffff }, + { 0x0c0004d8, 0x24000001 }, + { 0x0c0004d9, 0x1400ffff }, + { 0x0c0004da, 0x24000001 }, + { 0x0c0004db, 0x1400ffff }, + { 0x0c0004dc, 0x24000001 }, + { 0x0c0004dd, 0x1400ffff }, + { 0x0c0004de, 0x24000001 }, + { 0x0c0004df, 0x1400ffff }, + { 0x0c0004e0, 0x24000001 }, + { 0x0c0004e1, 0x1400ffff }, + { 0x0c0004e2, 0x24000001 }, + { 0x0c0004e3, 0x1400ffff }, + { 0x0c0004e4, 0x24000001 }, + { 0x0c0004e5, 0x1400ffff }, + { 0x0c0004e6, 0x24000001 }, + { 0x0c0004e7, 0x1400ffff }, + { 0x0c0004e8, 0x24000001 }, + { 0x0c0004e9, 0x1400ffff }, + { 0x0c0004ea, 0x24000001 }, + { 0x0c0004eb, 0x1400ffff }, + { 0x0c0004ec, 0x24000001 }, + { 0x0c0004ed, 0x1400ffff }, + { 0x0c0004ee, 0x24000001 }, + { 0x0c0004ef, 0x1400ffff }, + { 0x0c0004f0, 0x24000001 }, + { 0x0c0004f1, 0x1400ffff }, + { 0x0c0004f2, 0x24000001 }, + { 0x0c0004f3, 0x1400ffff }, + { 0x0c0004f4, 0x24000001 }, + { 0x0c0004f5, 0x1400ffff }, + { 0x0c0004f6, 0x24000001 }, + { 0x0c0004f7, 0x1400ffff }, + { 0x0c0004f8, 0x24000001 }, + { 0x0c0004f9, 0x1400ffff }, + { 0x0c0004fa, 0x24000001 }, + { 0x0c0004fb, 0x1400ffff }, + { 0x0c0004fc, 0x24000001 }, + { 0x0c0004fd, 0x1400ffff }, + { 0x0c0004fe, 0x24000001 }, + { 0x0c0004ff, 0x1400ffff }, + { 0x0c000500, 0x24000001 }, + { 0x0c000501, 0x1400ffff }, + { 0x0c000502, 0x24000001 }, + { 0x0c000503, 0x1400ffff }, + { 0x0c000504, 0x24000001 }, + { 0x0c000505, 0x1400ffff }, + { 0x0c000506, 0x24000001 }, + { 0x0c000507, 0x1400ffff }, + { 0x0c000508, 0x24000001 }, + { 0x0c000509, 0x1400ffff }, + { 0x0c00050a, 0x24000001 }, + { 0x0c00050b, 0x1400ffff }, + { 0x0c00050c, 0x24000001 }, + { 0x0c00050d, 0x1400ffff }, + { 0x0c00050e, 0x24000001 }, + { 0x0c00050f, 0x1400ffff }, + { 0x0c000510, 0x24000001 }, + { 0x0c000511, 0x1400ffff }, + { 0x0c000512, 0x24000001 }, + { 0x0c000513, 0x1400ffff }, + { 0x01000531, 0x24000030 }, + { 0x01000532, 0x24000030 }, + { 0x01000533, 0x24000030 }, + { 0x01000534, 0x24000030 }, + { 0x01000535, 0x24000030 }, + { 0x01000536, 0x24000030 }, + { 0x01000537, 0x24000030 }, + { 0x01000538, 0x24000030 }, + { 0x01000539, 0x24000030 }, + { 0x0100053a, 0x24000030 }, + { 0x0100053b, 0x24000030 }, + { 0x0100053c, 0x24000030 }, + { 0x0100053d, 0x24000030 }, + { 0x0100053e, 0x24000030 }, + { 0x0100053f, 0x24000030 }, + { 0x01000540, 0x24000030 }, + { 0x01000541, 0x24000030 }, + { 0x01000542, 0x24000030 }, + { 0x01000543, 0x24000030 }, + { 0x01000544, 0x24000030 }, + { 0x01000545, 0x24000030 }, + { 0x01000546, 0x24000030 }, + { 0x01000547, 0x24000030 }, + { 0x01000548, 0x24000030 }, + { 0x01000549, 0x24000030 }, + { 0x0100054a, 0x24000030 }, + { 0x0100054b, 0x24000030 }, + { 0x0100054c, 0x24000030 }, + { 0x0100054d, 0x24000030 }, + { 0x0100054e, 0x24000030 }, + { 0x0100054f, 0x24000030 }, + { 0x01000550, 0x24000030 }, + { 0x01000551, 0x24000030 }, + { 0x01000552, 0x24000030 }, + { 0x01000553, 0x24000030 }, + { 0x01000554, 0x24000030 }, + { 0x01000555, 0x24000030 }, + { 0x01000556, 0x24000030 }, + { 0x01000559, 0x18000000 }, + { 0x0180055a, 0x54000005 }, + { 0x01000561, 0x1400ffd0 }, + { 0x01000562, 0x1400ffd0 }, + { 0x01000563, 0x1400ffd0 }, + { 0x01000564, 0x1400ffd0 }, + { 0x01000565, 0x1400ffd0 }, + { 0x01000566, 0x1400ffd0 }, + { 0x01000567, 0x1400ffd0 }, + { 0x01000568, 0x1400ffd0 }, + { 0x01000569, 0x1400ffd0 }, + { 0x0100056a, 0x1400ffd0 }, + { 0x0100056b, 0x1400ffd0 }, + { 0x0100056c, 0x1400ffd0 }, + { 0x0100056d, 0x1400ffd0 }, + { 0x0100056e, 0x1400ffd0 }, + { 0x0100056f, 0x1400ffd0 }, + { 0x01000570, 0x1400ffd0 }, + { 0x01000571, 0x1400ffd0 }, + { 0x01000572, 0x1400ffd0 }, + { 0x01000573, 0x1400ffd0 }, + { 0x01000574, 0x1400ffd0 }, + { 0x01000575, 0x1400ffd0 }, + { 0x01000576, 0x1400ffd0 }, + { 0x01000577, 0x1400ffd0 }, + { 0x01000578, 0x1400ffd0 }, + { 0x01000579, 0x1400ffd0 }, + { 0x0100057a, 0x1400ffd0 }, + { 0x0100057b, 0x1400ffd0 }, + { 0x0100057c, 0x1400ffd0 }, + { 0x0100057d, 0x1400ffd0 }, + { 0x0100057e, 0x1400ffd0 }, + { 0x0100057f, 0x1400ffd0 }, + { 0x01000580, 0x1400ffd0 }, + { 0x01000581, 0x1400ffd0 }, + { 0x01000582, 0x1400ffd0 }, + { 0x01000583, 0x1400ffd0 }, + { 0x01000584, 0x1400ffd0 }, + { 0x01000585, 0x1400ffd0 }, + { 0x01000586, 0x1400ffd0 }, + { 0x01000587, 0x14000000 }, + { 0x09000589, 0x54000000 }, + { 0x0100058a, 0x44000000 }, + { 0x19800591, 0x3000002c }, + { 0x190005be, 0x54000000 }, + { 0x190005bf, 0x30000000 }, + { 0x190005c0, 0x54000000 }, + { 0x198005c1, 0x30000001 }, + { 0x190005c3, 0x54000000 }, + { 0x198005c4, 0x30000001 }, + { 0x190005c6, 0x54000000 }, + { 0x190005c7, 0x30000000 }, + { 0x198005d0, 0x1c00001a }, + { 0x198005f0, 0x1c000002 }, + { 0x198005f3, 0x54000001 }, + { 0x09800600, 0x04000003 }, + { 0x0000060b, 0x5c000000 }, + { 0x0900060c, 0x54000000 }, + { 0x0000060d, 0x54000000 }, + { 0x0080060e, 0x68000001 }, + { 0x00800610, 0x30000005 }, + { 0x0900061b, 0x54000000 }, + { 0x0000061e, 0x54000000 }, + { 0x0900061f, 0x54000000 }, + { 0x00800621, 0x1c000019 }, + { 0x09000640, 0x18000000 }, + { 0x00800641, 0x1c000009 }, + { 0x1b80064b, 0x3000000a }, + { 0x00800656, 0x30000008 }, + { 0x09800660, 0x34000009 }, + { 0x0080066a, 0x54000003 }, + { 0x0080066e, 0x1c000001 }, + { 0x1b000670, 0x30000000 }, + { 0x00800671, 0x1c000062 }, + { 0x000006d4, 0x54000000 }, + { 0x000006d5, 0x1c000000 }, + { 0x008006d6, 0x30000006 }, + { 0x090006dd, 0x04000000 }, + { 0x000006de, 0x2c000000 }, + { 0x008006df, 0x30000005 }, + { 0x008006e5, 0x18000001 }, + { 0x008006e7, 0x30000001 }, + { 0x000006e9, 0x68000000 }, + { 0x008006ea, 0x30000003 }, + { 0x008006ee, 0x1c000001 }, + { 0x008006f0, 0x34000009 }, + { 0x008006fa, 0x1c000002 }, + { 0x008006fd, 0x68000001 }, + { 0x000006ff, 0x1c000000 }, + { 0x31800700, 0x5400000d }, + { 0x3100070f, 0x04000000 }, + { 0x31000710, 0x1c000000 }, + { 0x31000711, 0x30000000 }, + { 0x31800712, 0x1c00001d }, + { 0x31800730, 0x3000001a }, + { 0x3180074d, 0x1c000002 }, + { 0x00800750, 0x1c00001d }, + { 0x37800780, 0x1c000025 }, + { 0x378007a6, 0x3000000a }, + { 0x370007b1, 0x1c000000 }, + { 0x3f8007c0, 0x34000009 }, + { 0x3f8007ca, 0x1c000020 }, + { 0x3f8007eb, 0x30000008 }, + { 0x3f8007f4, 0x18000001 }, + { 0x3f0007f6, 0x68000000 }, + { 0x3f8007f7, 0x54000002 }, + { 0x3f0007fa, 0x18000000 }, + { 0x0e800901, 0x30000001 }, + { 0x0e000903, 0x28000000 }, + { 0x0e800904, 0x1c000035 }, + { 0x0e00093c, 0x30000000 }, + { 0x0e00093d, 0x1c000000 }, + { 0x0e80093e, 0x28000002 }, + { 0x0e800941, 0x30000007 }, + { 0x0e800949, 0x28000003 }, + { 0x0e00094d, 0x30000000 }, + { 0x0e000950, 0x1c000000 }, + { 0x0e800951, 0x30000003 }, + { 0x0e800958, 0x1c000009 }, + { 0x0e800962, 0x30000001 }, + { 0x09800964, 0x54000001 }, + { 0x0e800966, 0x34000009 }, + { 0x09000970, 0x54000000 }, + { 0x0e80097b, 0x1c000004 }, + { 0x02000981, 0x30000000 }, + { 0x02800982, 0x28000001 }, + { 0x02800985, 0x1c000007 }, + { 0x0280098f, 0x1c000001 }, + { 0x02800993, 0x1c000015 }, + { 0x028009aa, 0x1c000006 }, + { 0x020009b2, 0x1c000000 }, + { 0x028009b6, 0x1c000003 }, + { 0x020009bc, 0x30000000 }, + { 0x020009bd, 0x1c000000 }, + { 0x028009be, 0x28000002 }, + { 0x028009c1, 0x30000003 }, + { 0x028009c7, 0x28000001 }, + { 0x028009cb, 0x28000001 }, + { 0x020009cd, 0x30000000 }, + { 0x020009ce, 0x1c000000 }, + { 0x020009d7, 0x28000000 }, + { 0x028009dc, 0x1c000001 }, + { 0x028009df, 0x1c000002 }, + { 0x028009e2, 0x30000001 }, + { 0x028009e6, 0x34000009 }, + { 0x028009f0, 0x1c000001 }, + { 0x028009f2, 0x5c000001 }, + { 0x028009f4, 0x3c000005 }, + { 0x020009fa, 0x68000000 }, + { 0x15800a01, 0x30000001 }, + { 0x15000a03, 0x28000000 }, + { 0x15800a05, 0x1c000005 }, + { 0x15800a0f, 0x1c000001 }, + { 0x15800a13, 0x1c000015 }, + { 0x15800a2a, 0x1c000006 }, + { 0x15800a32, 0x1c000001 }, + { 0x15800a35, 0x1c000001 }, + { 0x15800a38, 0x1c000001 }, + { 0x15000a3c, 0x30000000 }, + { 0x15800a3e, 0x28000002 }, + { 0x15800a41, 0x30000001 }, + { 0x15800a47, 0x30000001 }, + { 0x15800a4b, 0x30000002 }, + { 0x15800a59, 0x1c000003 }, + { 0x15000a5e, 0x1c000000 }, + { 0x15800a66, 0x34000009 }, + { 0x15800a70, 0x30000001 }, + { 0x15800a72, 0x1c000002 }, + { 0x14800a81, 0x30000001 }, + { 0x14000a83, 0x28000000 }, + { 0x14800a85, 0x1c000008 }, + { 0x14800a8f, 0x1c000002 }, + { 0x14800a93, 0x1c000015 }, + { 0x14800aaa, 0x1c000006 }, + { 0x14800ab2, 0x1c000001 }, + { 0x14800ab5, 0x1c000004 }, + { 0x14000abc, 0x30000000 }, + { 0x14000abd, 0x1c000000 }, + { 0x14800abe, 0x28000002 }, + { 0x14800ac1, 0x30000004 }, + { 0x14800ac7, 0x30000001 }, + { 0x14000ac9, 0x28000000 }, + { 0x14800acb, 0x28000001 }, + { 0x14000acd, 0x30000000 }, + { 0x14000ad0, 0x1c000000 }, + { 0x14800ae0, 0x1c000001 }, + { 0x14800ae2, 0x30000001 }, + { 0x14800ae6, 0x34000009 }, + { 0x14000af1, 0x5c000000 }, + { 0x2b000b01, 0x30000000 }, + { 0x2b800b02, 0x28000001 }, + { 0x2b800b05, 0x1c000007 }, + { 0x2b800b0f, 0x1c000001 }, + { 0x2b800b13, 0x1c000015 }, + { 0x2b800b2a, 0x1c000006 }, + { 0x2b800b32, 0x1c000001 }, + { 0x2b800b35, 0x1c000004 }, + { 0x2b000b3c, 0x30000000 }, + { 0x2b000b3d, 0x1c000000 }, + { 0x2b000b3e, 0x28000000 }, + { 0x2b000b3f, 0x30000000 }, + { 0x2b000b40, 0x28000000 }, + { 0x2b800b41, 0x30000002 }, + { 0x2b800b47, 0x28000001 }, + { 0x2b800b4b, 0x28000001 }, + { 0x2b000b4d, 0x30000000 }, + { 0x2b000b56, 0x30000000 }, + { 0x2b000b57, 0x28000000 }, + { 0x2b800b5c, 0x1c000001 }, + { 0x2b800b5f, 0x1c000002 }, + { 0x2b800b66, 0x34000009 }, + { 0x2b000b70, 0x68000000 }, + { 0x2b000b71, 0x1c000000 }, + { 0x35000b82, 0x30000000 }, + { 0x35000b83, 0x1c000000 }, + { 0x35800b85, 0x1c000005 }, + { 0x35800b8e, 0x1c000002 }, + { 0x35800b92, 0x1c000003 }, + { 0x35800b99, 0x1c000001 }, + { 0x35000b9c, 0x1c000000 }, + { 0x35800b9e, 0x1c000001 }, + { 0x35800ba3, 0x1c000001 }, + { 0x35800ba8, 0x1c000002 }, + { 0x35800bae, 0x1c00000b }, + { 0x35800bbe, 0x28000001 }, + { 0x35000bc0, 0x30000000 }, + { 0x35800bc1, 0x28000001 }, + { 0x35800bc6, 0x28000002 }, + { 0x35800bca, 0x28000002 }, + { 0x35000bcd, 0x30000000 }, + { 0x35000bd7, 0x28000000 }, + { 0x35800be6, 0x34000009 }, + { 0x35800bf0, 0x3c000002 }, + { 0x35800bf3, 0x68000005 }, + { 0x35000bf9, 0x5c000000 }, + { 0x35000bfa, 0x68000000 }, + { 0x36800c01, 0x28000002 }, + { 0x36800c05, 0x1c000007 }, + { 0x36800c0e, 0x1c000002 }, + { 0x36800c12, 0x1c000016 }, + { 0x36800c2a, 0x1c000009 }, + { 0x36800c35, 0x1c000004 }, + { 0x36800c3e, 0x30000002 }, + { 0x36800c41, 0x28000003 }, + { 0x36800c46, 0x30000002 }, + { 0x36800c4a, 0x30000003 }, + { 0x36800c55, 0x30000001 }, + { 0x36800c60, 0x1c000001 }, + { 0x36800c66, 0x34000009 }, + { 0x1c800c82, 0x28000001 }, + { 0x1c800c85, 0x1c000007 }, + { 0x1c800c8e, 0x1c000002 }, + { 0x1c800c92, 0x1c000016 }, + { 0x1c800caa, 0x1c000009 }, + { 0x1c800cb5, 0x1c000004 }, + { 0x1c000cbc, 0x30000000 }, + { 0x1c000cbd, 0x1c000000 }, + { 0x1c000cbe, 0x28000000 }, + { 0x1c000cbf, 0x30000000 }, + { 0x1c800cc0, 0x28000004 }, + { 0x1c000cc6, 0x30000000 }, + { 0x1c800cc7, 0x28000001 }, + { 0x1c800cca, 0x28000001 }, + { 0x1c800ccc, 0x30000001 }, + { 0x1c800cd5, 0x28000001 }, + { 0x1c000cde, 0x1c000000 }, + { 0x1c800ce0, 0x1c000001 }, + { 0x1c800ce2, 0x30000001 }, + { 0x1c800ce6, 0x34000009 }, + { 0x1c800cf1, 0x68000001 }, + { 0x24800d02, 0x28000001 }, + { 0x24800d05, 0x1c000007 }, + { 0x24800d0e, 0x1c000002 }, + { 0x24800d12, 0x1c000016 }, + { 0x24800d2a, 0x1c00000f }, + { 0x24800d3e, 0x28000002 }, + { 0x24800d41, 0x30000002 }, + { 0x24800d46, 0x28000002 }, + { 0x24800d4a, 0x28000002 }, + { 0x24000d4d, 0x30000000 }, + { 0x24000d57, 0x28000000 }, + { 0x24800d60, 0x1c000001 }, + { 0x24800d66, 0x34000009 }, + { 0x2f800d82, 0x28000001 }, + { 0x2f800d85, 0x1c000011 }, + { 0x2f800d9a, 0x1c000017 }, + { 0x2f800db3, 0x1c000008 }, + { 0x2f000dbd, 0x1c000000 }, + { 0x2f800dc0, 0x1c000006 }, + { 0x2f000dca, 0x30000000 }, + { 0x2f800dcf, 0x28000002 }, + { 0x2f800dd2, 0x30000002 }, + { 0x2f000dd6, 0x30000000 }, + { 0x2f800dd8, 0x28000007 }, + { 0x2f800df2, 0x28000001 }, + { 0x2f000df4, 0x54000000 }, + { 0x38800e01, 0x1c00002f }, + { 0x38000e31, 0x30000000 }, + { 0x38800e32, 0x1c000001 }, + { 0x38800e34, 0x30000006 }, + { 0x09000e3f, 0x5c000000 }, + { 0x38800e40, 0x1c000005 }, + { 0x38000e46, 0x18000000 }, + { 0x38800e47, 0x30000007 }, + { 0x38000e4f, 0x54000000 }, + { 0x38800e50, 0x34000009 }, + { 0x38800e5a, 0x54000001 }, + { 0x20800e81, 0x1c000001 }, + { 0x20000e84, 0x1c000000 }, + { 0x20800e87, 0x1c000001 }, + { 0x20000e8a, 0x1c000000 }, + { 0x20000e8d, 0x1c000000 }, + { 0x20800e94, 0x1c000003 }, + { 0x20800e99, 0x1c000006 }, + { 0x20800ea1, 0x1c000002 }, + { 0x20000ea5, 0x1c000000 }, + { 0x20000ea7, 0x1c000000 }, + { 0x20800eaa, 0x1c000001 }, + { 0x20800ead, 0x1c000003 }, + { 0x20000eb1, 0x30000000 }, + { 0x20800eb2, 0x1c000001 }, + { 0x20800eb4, 0x30000005 }, + { 0x20800ebb, 0x30000001 }, + { 0x20000ebd, 0x1c000000 }, + { 0x20800ec0, 0x1c000004 }, + { 0x20000ec6, 0x18000000 }, + { 0x20800ec8, 0x30000005 }, + { 0x20800ed0, 0x34000009 }, + { 0x20800edc, 0x1c000001 }, + { 0x39000f00, 0x1c000000 }, + { 0x39800f01, 0x68000002 }, + { 0x39800f04, 0x5400000e }, + { 0x39800f13, 0x68000004 }, + { 0x39800f18, 0x30000001 }, + { 0x39800f1a, 0x68000005 }, + { 0x39800f20, 0x34000009 }, + { 0x39800f2a, 0x3c000009 }, + { 0x39000f34, 0x68000000 }, + { 0x39000f35, 0x30000000 }, + { 0x39000f36, 0x68000000 }, + { 0x39000f37, 0x30000000 }, + { 0x39000f38, 0x68000000 }, + { 0x39000f39, 0x30000000 }, + { 0x39000f3a, 0x58000000 }, + { 0x39000f3b, 0x48000000 }, + { 0x39000f3c, 0x58000000 }, + { 0x39000f3d, 0x48000000 }, + { 0x39800f3e, 0x28000001 }, + { 0x39800f40, 0x1c000007 }, + { 0x39800f49, 0x1c000021 }, + { 0x39800f71, 0x3000000d }, + { 0x39000f7f, 0x28000000 }, + { 0x39800f80, 0x30000004 }, + { 0x39000f85, 0x54000000 }, + { 0x39800f86, 0x30000001 }, + { 0x39800f88, 0x1c000003 }, + { 0x39800f90, 0x30000007 }, + { 0x39800f99, 0x30000023 }, + { 0x39800fbe, 0x68000007 }, + { 0x39000fc6, 0x30000000 }, + { 0x39800fc7, 0x68000005 }, + { 0x39000fcf, 0x68000000 }, + { 0x39800fd0, 0x54000001 }, + { 0x26801000, 0x1c000021 }, + { 0x26801023, 0x1c000004 }, + { 0x26801029, 0x1c000001 }, + { 0x2600102c, 0x28000000 }, + { 0x2680102d, 0x30000003 }, + { 0x26001031, 0x28000000 }, + { 0x26001032, 0x30000000 }, + { 0x26801036, 0x30000001 }, + { 0x26001038, 0x28000000 }, + { 0x26001039, 0x30000000 }, + { 0x26801040, 0x34000009 }, + { 0x2680104a, 0x54000005 }, + { 0x26801050, 0x1c000005 }, + { 0x26801056, 0x28000001 }, + { 0x26801058, 0x30000001 }, + { 0x100010a0, 0x24001c60 }, + { 0x100010a1, 0x24001c60 }, + { 0x100010a2, 0x24001c60 }, + { 0x100010a3, 0x24001c60 }, + { 0x100010a4, 0x24001c60 }, + { 0x100010a5, 0x24001c60 }, + { 0x100010a6, 0x24001c60 }, + { 0x100010a7, 0x24001c60 }, + { 0x100010a8, 0x24001c60 }, + { 0x100010a9, 0x24001c60 }, + { 0x100010aa, 0x24001c60 }, + { 0x100010ab, 0x24001c60 }, + { 0x100010ac, 0x24001c60 }, + { 0x100010ad, 0x24001c60 }, + { 0x100010ae, 0x24001c60 }, + { 0x100010af, 0x24001c60 }, + { 0x100010b0, 0x24001c60 }, + { 0x100010b1, 0x24001c60 }, + { 0x100010b2, 0x24001c60 }, + { 0x100010b3, 0x24001c60 }, + { 0x100010b4, 0x24001c60 }, + { 0x100010b5, 0x24001c60 }, + { 0x100010b6, 0x24001c60 }, + { 0x100010b7, 0x24001c60 }, + { 0x100010b8, 0x24001c60 }, + { 0x100010b9, 0x24001c60 }, + { 0x100010ba, 0x24001c60 }, + { 0x100010bb, 0x24001c60 }, + { 0x100010bc, 0x24001c60 }, + { 0x100010bd, 0x24001c60 }, + { 0x100010be, 0x24001c60 }, + { 0x100010bf, 0x24001c60 }, + { 0x100010c0, 0x24001c60 }, + { 0x100010c1, 0x24001c60 }, + { 0x100010c2, 0x24001c60 }, + { 0x100010c3, 0x24001c60 }, + { 0x100010c4, 0x24001c60 }, + { 0x100010c5, 0x24001c60 }, + { 0x108010d0, 0x1c00002a }, + { 0x090010fb, 0x54000000 }, + { 0x100010fc, 0x18000000 }, + { 0x17801100, 0x1c000059 }, + { 0x1780115f, 0x1c000043 }, + { 0x178011a8, 0x1c000051 }, + { 0x0f801200, 0x1c000048 }, + { 0x0f80124a, 0x1c000003 }, + { 0x0f801250, 0x1c000006 }, + { 0x0f001258, 0x1c000000 }, + { 0x0f80125a, 0x1c000003 }, + { 0x0f801260, 0x1c000028 }, + { 0x0f80128a, 0x1c000003 }, + { 0x0f801290, 0x1c000020 }, + { 0x0f8012b2, 0x1c000003 }, + { 0x0f8012b8, 0x1c000006 }, + { 0x0f0012c0, 0x1c000000 }, + { 0x0f8012c2, 0x1c000003 }, + { 0x0f8012c8, 0x1c00000e }, + { 0x0f8012d8, 0x1c000038 }, + { 0x0f801312, 0x1c000003 }, + { 0x0f801318, 0x1c000042 }, + { 0x0f00135f, 0x30000000 }, + { 0x0f001360, 0x68000000 }, + { 0x0f801361, 0x54000007 }, + { 0x0f801369, 0x3c000013 }, + { 0x0f801380, 0x1c00000f }, + { 0x0f801390, 0x68000009 }, + { 0x088013a0, 0x1c000054 }, + { 0x07801401, 0x1c00026b }, + { 0x0780166d, 0x54000001 }, + { 0x0780166f, 0x1c000007 }, + { 0x28001680, 0x74000000 }, + { 0x28801681, 0x1c000019 }, + { 0x2800169b, 0x58000000 }, + { 0x2800169c, 0x48000000 }, + { 0x2d8016a0, 0x1c00004a }, + { 0x098016eb, 0x54000002 }, + { 0x2d8016ee, 0x38000002 }, + { 0x32801700, 0x1c00000c }, + { 0x3280170e, 0x1c000003 }, + { 0x32801712, 0x30000002 }, + { 0x18801720, 0x1c000011 }, + { 0x18801732, 0x30000002 }, + { 0x09801735, 0x54000001 }, + { 0x06801740, 0x1c000011 }, + { 0x06801752, 0x30000001 }, + { 0x33801760, 0x1c00000c }, + { 0x3380176e, 0x1c000002 }, + { 0x33801772, 0x30000001 }, + { 0x1f801780, 0x1c000033 }, + { 0x1f8017b4, 0x04000001 }, + { 0x1f0017b6, 0x28000000 }, + { 0x1f8017b7, 0x30000006 }, + { 0x1f8017be, 0x28000007 }, + { 0x1f0017c6, 0x30000000 }, + { 0x1f8017c7, 0x28000001 }, + { 0x1f8017c9, 0x3000000a }, + { 0x1f8017d4, 0x54000002 }, + { 0x1f0017d7, 0x18000000 }, + { 0x1f8017d8, 0x54000002 }, + { 0x1f0017db, 0x5c000000 }, + { 0x1f0017dc, 0x1c000000 }, + { 0x1f0017dd, 0x30000000 }, + { 0x1f8017e0, 0x34000009 }, + { 0x1f8017f0, 0x3c000009 }, + { 0x25801800, 0x54000001 }, + { 0x09801802, 0x54000001 }, + { 0x25001804, 0x54000000 }, + { 0x09001805, 0x54000000 }, + { 0x25001806, 0x44000000 }, + { 0x25801807, 0x54000003 }, + { 0x2580180b, 0x30000002 }, + { 0x2500180e, 0x74000000 }, + { 0x25801810, 0x34000009 }, + { 0x25801820, 0x1c000022 }, + { 0x25001843, 0x18000000 }, + { 0x25801844, 0x1c000033 }, + { 0x25801880, 0x1c000028 }, + { 0x250018a9, 0x30000000 }, + { 0x22801900, 0x1c00001c }, + { 0x22801920, 0x30000002 }, + { 0x22801923, 0x28000003 }, + { 0x22801927, 0x30000001 }, + { 0x22801929, 0x28000002 }, + { 0x22801930, 0x28000001 }, + { 0x22001932, 0x30000000 }, + { 0x22801933, 0x28000005 }, + { 0x22801939, 0x30000002 }, + { 0x22001940, 0x68000000 }, + { 0x22801944, 0x54000001 }, + { 0x22801946, 0x34000009 }, + { 0x34801950, 0x1c00001d }, + { 0x34801970, 0x1c000004 }, + { 0x27801980, 0x1c000029 }, + { 0x278019b0, 0x28000010 }, + { 0x278019c1, 0x1c000006 }, + { 0x278019c8, 0x28000001 }, + { 0x278019d0, 0x34000009 }, + { 0x278019de, 0x54000001 }, + { 0x1f8019e0, 0x6800001f }, + { 0x05801a00, 0x1c000016 }, + { 0x05801a17, 0x30000001 }, + { 0x05801a19, 0x28000002 }, + { 0x05801a1e, 0x54000001 }, + { 0x3d801b00, 0x30000003 }, + { 0x3d001b04, 0x28000000 }, + { 0x3d801b05, 0x1c00002e }, + { 0x3d001b34, 0x30000000 }, + { 0x3d001b35, 0x28000000 }, + { 0x3d801b36, 0x30000004 }, + { 0x3d001b3b, 0x28000000 }, + { 0x3d001b3c, 0x30000000 }, + { 0x3d801b3d, 0x28000004 }, + { 0x3d001b42, 0x30000000 }, + { 0x3d801b43, 0x28000001 }, + { 0x3d801b45, 0x1c000006 }, + { 0x3d801b50, 0x34000009 }, + { 0x3d801b5a, 0x54000006 }, + { 0x3d801b61, 0x68000009 }, + { 0x3d801b6b, 0x30000008 }, + { 0x3d801b74, 0x68000008 }, + { 0x21801d00, 0x14000025 }, + { 0x13801d26, 0x14000004 }, + { 0x0c001d2b, 0x14000000 }, + { 0x21801d2c, 0x18000030 }, + { 0x13801d5d, 0x18000004 }, + { 0x21801d62, 0x14000003 }, + { 0x13801d66, 0x14000004 }, + { 0x21801d6b, 0x1400000c }, + { 0x0c001d78, 0x18000000 }, + { 0x21801d79, 0x14000003 }, + { 0x21001d7d, 0x14000ee6 }, + { 0x21801d7e, 0x1400001c }, + { 0x21801d9b, 0x18000023 }, + { 0x13001dbf, 0x18000000 }, + { 0x1b801dc0, 0x3000000a }, + { 0x1b801dfe, 0x30000001 }, + { 0x21001e00, 0x24000001 }, + { 0x21001e01, 0x1400ffff }, + { 0x21001e02, 0x24000001 }, + { 0x21001e03, 0x1400ffff }, + { 0x21001e04, 0x24000001 }, + { 0x21001e05, 0x1400ffff }, + { 0x21001e06, 0x24000001 }, + { 0x21001e07, 0x1400ffff }, + { 0x21001e08, 0x24000001 }, + { 0x21001e09, 0x1400ffff }, + { 0x21001e0a, 0x24000001 }, + { 0x21001e0b, 0x1400ffff }, + { 0x21001e0c, 0x24000001 }, + { 0x21001e0d, 0x1400ffff }, + { 0x21001e0e, 0x24000001 }, + { 0x21001e0f, 0x1400ffff }, + { 0x21001e10, 0x24000001 }, + { 0x21001e11, 0x1400ffff }, + { 0x21001e12, 0x24000001 }, + { 0x21001e13, 0x1400ffff }, + { 0x21001e14, 0x24000001 }, + { 0x21001e15, 0x1400ffff }, + { 0x21001e16, 0x24000001 }, + { 0x21001e17, 0x1400ffff }, + { 0x21001e18, 0x24000001 }, + { 0x21001e19, 0x1400ffff }, + { 0x21001e1a, 0x24000001 }, + { 0x21001e1b, 0x1400ffff }, + { 0x21001e1c, 0x24000001 }, + { 0x21001e1d, 0x1400ffff }, + { 0x21001e1e, 0x24000001 }, + { 0x21001e1f, 0x1400ffff }, + { 0x21001e20, 0x24000001 }, + { 0x21001e21, 0x1400ffff }, + { 0x21001e22, 0x24000001 }, + { 0x21001e23, 0x1400ffff }, + { 0x21001e24, 0x24000001 }, + { 0x21001e25, 0x1400ffff }, + { 0x21001e26, 0x24000001 }, + { 0x21001e27, 0x1400ffff }, + { 0x21001e28, 0x24000001 }, + { 0x21001e29, 0x1400ffff }, + { 0x21001e2a, 0x24000001 }, + { 0x21001e2b, 0x1400ffff }, + { 0x21001e2c, 0x24000001 }, + { 0x21001e2d, 0x1400ffff }, + { 0x21001e2e, 0x24000001 }, + { 0x21001e2f, 0x1400ffff }, + { 0x21001e30, 0x24000001 }, + { 0x21001e31, 0x1400ffff }, + { 0x21001e32, 0x24000001 }, + { 0x21001e33, 0x1400ffff }, + { 0x21001e34, 0x24000001 }, + { 0x21001e35, 0x1400ffff }, + { 0x21001e36, 0x24000001 }, + { 0x21001e37, 0x1400ffff }, + { 0x21001e38, 0x24000001 }, + { 0x21001e39, 0x1400ffff }, + { 0x21001e3a, 0x24000001 }, + { 0x21001e3b, 0x1400ffff }, + { 0x21001e3c, 0x24000001 }, + { 0x21001e3d, 0x1400ffff }, + { 0x21001e3e, 0x24000001 }, + { 0x21001e3f, 0x1400ffff }, + { 0x21001e40, 0x24000001 }, + { 0x21001e41, 0x1400ffff }, + { 0x21001e42, 0x24000001 }, + { 0x21001e43, 0x1400ffff }, + { 0x21001e44, 0x24000001 }, + { 0x21001e45, 0x1400ffff }, + { 0x21001e46, 0x24000001 }, + { 0x21001e47, 0x1400ffff }, + { 0x21001e48, 0x24000001 }, + { 0x21001e49, 0x1400ffff }, + { 0x21001e4a, 0x24000001 }, + { 0x21001e4b, 0x1400ffff }, + { 0x21001e4c, 0x24000001 }, + { 0x21001e4d, 0x1400ffff }, + { 0x21001e4e, 0x24000001 }, + { 0x21001e4f, 0x1400ffff }, + { 0x21001e50, 0x24000001 }, + { 0x21001e51, 0x1400ffff }, + { 0x21001e52, 0x24000001 }, + { 0x21001e53, 0x1400ffff }, + { 0x21001e54, 0x24000001 }, + { 0x21001e55, 0x1400ffff }, + { 0x21001e56, 0x24000001 }, + { 0x21001e57, 0x1400ffff }, + { 0x21001e58, 0x24000001 }, + { 0x21001e59, 0x1400ffff }, + { 0x21001e5a, 0x24000001 }, + { 0x21001e5b, 0x1400ffff }, + { 0x21001e5c, 0x24000001 }, + { 0x21001e5d, 0x1400ffff }, + { 0x21001e5e, 0x24000001 }, + { 0x21001e5f, 0x1400ffff }, + { 0x21001e60, 0x24000001 }, + { 0x21001e61, 0x1400ffff }, + { 0x21001e62, 0x24000001 }, + { 0x21001e63, 0x1400ffff }, + { 0x21001e64, 0x24000001 }, + { 0x21001e65, 0x1400ffff }, + { 0x21001e66, 0x24000001 }, + { 0x21001e67, 0x1400ffff }, + { 0x21001e68, 0x24000001 }, + { 0x21001e69, 0x1400ffff }, + { 0x21001e6a, 0x24000001 }, + { 0x21001e6b, 0x1400ffff }, + { 0x21001e6c, 0x24000001 }, + { 0x21001e6d, 0x1400ffff }, + { 0x21001e6e, 0x24000001 }, + { 0x21001e6f, 0x1400ffff }, + { 0x21001e70, 0x24000001 }, + { 0x21001e71, 0x1400ffff }, + { 0x21001e72, 0x24000001 }, + { 0x21001e73, 0x1400ffff }, + { 0x21001e74, 0x24000001 }, + { 0x21001e75, 0x1400ffff }, + { 0x21001e76, 0x24000001 }, + { 0x21001e77, 0x1400ffff }, + { 0x21001e78, 0x24000001 }, + { 0x21001e79, 0x1400ffff }, + { 0x21001e7a, 0x24000001 }, + { 0x21001e7b, 0x1400ffff }, + { 0x21001e7c, 0x24000001 }, + { 0x21001e7d, 0x1400ffff }, + { 0x21001e7e, 0x24000001 }, + { 0x21001e7f, 0x1400ffff }, + { 0x21001e80, 0x24000001 }, + { 0x21001e81, 0x1400ffff }, + { 0x21001e82, 0x24000001 }, + { 0x21001e83, 0x1400ffff }, + { 0x21001e84, 0x24000001 }, + { 0x21001e85, 0x1400ffff }, + { 0x21001e86, 0x24000001 }, + { 0x21001e87, 0x1400ffff }, + { 0x21001e88, 0x24000001 }, + { 0x21001e89, 0x1400ffff }, + { 0x21001e8a, 0x24000001 }, + { 0x21001e8b, 0x1400ffff }, + { 0x21001e8c, 0x24000001 }, + { 0x21001e8d, 0x1400ffff }, + { 0x21001e8e, 0x24000001 }, + { 0x21001e8f, 0x1400ffff }, + { 0x21001e90, 0x24000001 }, + { 0x21001e91, 0x1400ffff }, + { 0x21001e92, 0x24000001 }, + { 0x21001e93, 0x1400ffff }, + { 0x21001e94, 0x24000001 }, + { 0x21001e95, 0x1400ffff }, + { 0x21801e96, 0x14000004 }, + { 0x21001e9b, 0x1400ffc5 }, + { 0x21001ea0, 0x24000001 }, + { 0x21001ea1, 0x1400ffff }, + { 0x21001ea2, 0x24000001 }, + { 0x21001ea3, 0x1400ffff }, + { 0x21001ea4, 0x24000001 }, + { 0x21001ea5, 0x1400ffff }, + { 0x21001ea6, 0x24000001 }, + { 0x21001ea7, 0x1400ffff }, + { 0x21001ea8, 0x24000001 }, + { 0x21001ea9, 0x1400ffff }, + { 0x21001eaa, 0x24000001 }, + { 0x21001eab, 0x1400ffff }, + { 0x21001eac, 0x24000001 }, + { 0x21001ead, 0x1400ffff }, + { 0x21001eae, 0x24000001 }, + { 0x21001eaf, 0x1400ffff }, + { 0x21001eb0, 0x24000001 }, + { 0x21001eb1, 0x1400ffff }, + { 0x21001eb2, 0x24000001 }, + { 0x21001eb3, 0x1400ffff }, + { 0x21001eb4, 0x24000001 }, + { 0x21001eb5, 0x1400ffff }, + { 0x21001eb6, 0x24000001 }, + { 0x21001eb7, 0x1400ffff }, + { 0x21001eb8, 0x24000001 }, + { 0x21001eb9, 0x1400ffff }, + { 0x21001eba, 0x24000001 }, + { 0x21001ebb, 0x1400ffff }, + { 0x21001ebc, 0x24000001 }, + { 0x21001ebd, 0x1400ffff }, + { 0x21001ebe, 0x24000001 }, + { 0x21001ebf, 0x1400ffff }, + { 0x21001ec0, 0x24000001 }, + { 0x21001ec1, 0x1400ffff }, + { 0x21001ec2, 0x24000001 }, + { 0x21001ec3, 0x1400ffff }, + { 0x21001ec4, 0x24000001 }, + { 0x21001ec5, 0x1400ffff }, + { 0x21001ec6, 0x24000001 }, + { 0x21001ec7, 0x1400ffff }, + { 0x21001ec8, 0x24000001 }, + { 0x21001ec9, 0x1400ffff }, + { 0x21001eca, 0x24000001 }, + { 0x21001ecb, 0x1400ffff }, + { 0x21001ecc, 0x24000001 }, + { 0x21001ecd, 0x1400ffff }, + { 0x21001ece, 0x24000001 }, + { 0x21001ecf, 0x1400ffff }, + { 0x21001ed0, 0x24000001 }, + { 0x21001ed1, 0x1400ffff }, + { 0x21001ed2, 0x24000001 }, + { 0x21001ed3, 0x1400ffff }, + { 0x21001ed4, 0x24000001 }, + { 0x21001ed5, 0x1400ffff }, + { 0x21001ed6, 0x24000001 }, + { 0x21001ed7, 0x1400ffff }, + { 0x21001ed8, 0x24000001 }, + { 0x21001ed9, 0x1400ffff }, + { 0x21001eda, 0x24000001 }, + { 0x21001edb, 0x1400ffff }, + { 0x21001edc, 0x24000001 }, + { 0x21001edd, 0x1400ffff }, + { 0x21001ede, 0x24000001 }, + { 0x21001edf, 0x1400ffff }, + { 0x21001ee0, 0x24000001 }, + { 0x21001ee1, 0x1400ffff }, + { 0x21001ee2, 0x24000001 }, + { 0x21001ee3, 0x1400ffff }, + { 0x21001ee4, 0x24000001 }, + { 0x21001ee5, 0x1400ffff }, + { 0x21001ee6, 0x24000001 }, + { 0x21001ee7, 0x1400ffff }, + { 0x21001ee8, 0x24000001 }, + { 0x21001ee9, 0x1400ffff }, + { 0x21001eea, 0x24000001 }, + { 0x21001eeb, 0x1400ffff }, + { 0x21001eec, 0x24000001 }, + { 0x21001eed, 0x1400ffff }, + { 0x21001eee, 0x24000001 }, + { 0x21001eef, 0x1400ffff }, + { 0x21001ef0, 0x24000001 }, + { 0x21001ef1, 0x1400ffff }, + { 0x21001ef2, 0x24000001 }, + { 0x21001ef3, 0x1400ffff }, + { 0x21001ef4, 0x24000001 }, + { 0x21001ef5, 0x1400ffff }, + { 0x21001ef6, 0x24000001 }, + { 0x21001ef7, 0x1400ffff }, + { 0x21001ef8, 0x24000001 }, + { 0x21001ef9, 0x1400ffff }, + { 0x13001f00, 0x14000008 }, + { 0x13001f01, 0x14000008 }, + { 0x13001f02, 0x14000008 }, + { 0x13001f03, 0x14000008 }, + { 0x13001f04, 0x14000008 }, + { 0x13001f05, 0x14000008 }, + { 0x13001f06, 0x14000008 }, + { 0x13001f07, 0x14000008 }, + { 0x13001f08, 0x2400fff8 }, + { 0x13001f09, 0x2400fff8 }, + { 0x13001f0a, 0x2400fff8 }, + { 0x13001f0b, 0x2400fff8 }, + { 0x13001f0c, 0x2400fff8 }, + { 0x13001f0d, 0x2400fff8 }, + { 0x13001f0e, 0x2400fff8 }, + { 0x13001f0f, 0x2400fff8 }, + { 0x13001f10, 0x14000008 }, + { 0x13001f11, 0x14000008 }, + { 0x13001f12, 0x14000008 }, + { 0x13001f13, 0x14000008 }, + { 0x13001f14, 0x14000008 }, + { 0x13001f15, 0x14000008 }, + { 0x13001f18, 0x2400fff8 }, + { 0x13001f19, 0x2400fff8 }, + { 0x13001f1a, 0x2400fff8 }, + { 0x13001f1b, 0x2400fff8 }, + { 0x13001f1c, 0x2400fff8 }, + { 0x13001f1d, 0x2400fff8 }, + { 0x13001f20, 0x14000008 }, + { 0x13001f21, 0x14000008 }, + { 0x13001f22, 0x14000008 }, + { 0x13001f23, 0x14000008 }, + { 0x13001f24, 0x14000008 }, + { 0x13001f25, 0x14000008 }, + { 0x13001f26, 0x14000008 }, + { 0x13001f27, 0x14000008 }, + { 0x13001f28, 0x2400fff8 }, + { 0x13001f29, 0x2400fff8 }, + { 0x13001f2a, 0x2400fff8 }, + { 0x13001f2b, 0x2400fff8 }, + { 0x13001f2c, 0x2400fff8 }, + { 0x13001f2d, 0x2400fff8 }, + { 0x13001f2e, 0x2400fff8 }, + { 0x13001f2f, 0x2400fff8 }, + { 0x13001f30, 0x14000008 }, + { 0x13001f31, 0x14000008 }, + { 0x13001f32, 0x14000008 }, + { 0x13001f33, 0x14000008 }, + { 0x13001f34, 0x14000008 }, + { 0x13001f35, 0x14000008 }, + { 0x13001f36, 0x14000008 }, + { 0x13001f37, 0x14000008 }, + { 0x13001f38, 0x2400fff8 }, + { 0x13001f39, 0x2400fff8 }, + { 0x13001f3a, 0x2400fff8 }, + { 0x13001f3b, 0x2400fff8 }, + { 0x13001f3c, 0x2400fff8 }, + { 0x13001f3d, 0x2400fff8 }, + { 0x13001f3e, 0x2400fff8 }, + { 0x13001f3f, 0x2400fff8 }, + { 0x13001f40, 0x14000008 }, + { 0x13001f41, 0x14000008 }, + { 0x13001f42, 0x14000008 }, + { 0x13001f43, 0x14000008 }, + { 0x13001f44, 0x14000008 }, + { 0x13001f45, 0x14000008 }, + { 0x13001f48, 0x2400fff8 }, + { 0x13001f49, 0x2400fff8 }, + { 0x13001f4a, 0x2400fff8 }, + { 0x13001f4b, 0x2400fff8 }, + { 0x13001f4c, 0x2400fff8 }, + { 0x13001f4d, 0x2400fff8 }, + { 0x13001f50, 0x14000000 }, + { 0x13001f51, 0x14000008 }, + { 0x13001f52, 0x14000000 }, + { 0x13001f53, 0x14000008 }, + { 0x13001f54, 0x14000000 }, + { 0x13001f55, 0x14000008 }, + { 0x13001f56, 0x14000000 }, + { 0x13001f57, 0x14000008 }, + { 0x13001f59, 0x2400fff8 }, + { 0x13001f5b, 0x2400fff8 }, + { 0x13001f5d, 0x2400fff8 }, + { 0x13001f5f, 0x2400fff8 }, + { 0x13001f60, 0x14000008 }, + { 0x13001f61, 0x14000008 }, + { 0x13001f62, 0x14000008 }, + { 0x13001f63, 0x14000008 }, + { 0x13001f64, 0x14000008 }, + { 0x13001f65, 0x14000008 }, + { 0x13001f66, 0x14000008 }, + { 0x13001f67, 0x14000008 }, + { 0x13001f68, 0x2400fff8 }, + { 0x13001f69, 0x2400fff8 }, + { 0x13001f6a, 0x2400fff8 }, + { 0x13001f6b, 0x2400fff8 }, + { 0x13001f6c, 0x2400fff8 }, + { 0x13001f6d, 0x2400fff8 }, + { 0x13001f6e, 0x2400fff8 }, + { 0x13001f6f, 0x2400fff8 }, + { 0x13001f70, 0x1400004a }, + { 0x13001f71, 0x1400004a }, + { 0x13001f72, 0x14000056 }, + { 0x13001f73, 0x14000056 }, + { 0x13001f74, 0x14000056 }, + { 0x13001f75, 0x14000056 }, + { 0x13001f76, 0x14000064 }, + { 0x13001f77, 0x14000064 }, + { 0x13001f78, 0x14000080 }, + { 0x13001f79, 0x14000080 }, + { 0x13001f7a, 0x14000070 }, + { 0x13001f7b, 0x14000070 }, + { 0x13001f7c, 0x1400007e }, + { 0x13001f7d, 0x1400007e }, + { 0x13001f80, 0x14000008 }, + { 0x13001f81, 0x14000008 }, + { 0x13001f82, 0x14000008 }, + { 0x13001f83, 0x14000008 }, + { 0x13001f84, 0x14000008 }, + { 0x13001f85, 0x14000008 }, + { 0x13001f86, 0x14000008 }, + { 0x13001f87, 0x14000008 }, + { 0x13001f88, 0x2000fff8 }, + { 0x13001f89, 0x2000fff8 }, + { 0x13001f8a, 0x2000fff8 }, + { 0x13001f8b, 0x2000fff8 }, + { 0x13001f8c, 0x2000fff8 }, + { 0x13001f8d, 0x2000fff8 }, + { 0x13001f8e, 0x2000fff8 }, + { 0x13001f8f, 0x2000fff8 }, + { 0x13001f90, 0x14000008 }, + { 0x13001f91, 0x14000008 }, + { 0x13001f92, 0x14000008 }, + { 0x13001f93, 0x14000008 }, + { 0x13001f94, 0x14000008 }, + { 0x13001f95, 0x14000008 }, + { 0x13001f96, 0x14000008 }, + { 0x13001f97, 0x14000008 }, + { 0x13001f98, 0x2000fff8 }, + { 0x13001f99, 0x2000fff8 }, + { 0x13001f9a, 0x2000fff8 }, + { 0x13001f9b, 0x2000fff8 }, + { 0x13001f9c, 0x2000fff8 }, + { 0x13001f9d, 0x2000fff8 }, + { 0x13001f9e, 0x2000fff8 }, + { 0x13001f9f, 0x2000fff8 }, + { 0x13001fa0, 0x14000008 }, + { 0x13001fa1, 0x14000008 }, + { 0x13001fa2, 0x14000008 }, + { 0x13001fa3, 0x14000008 }, + { 0x13001fa4, 0x14000008 }, + { 0x13001fa5, 0x14000008 }, + { 0x13001fa6, 0x14000008 }, + { 0x13001fa7, 0x14000008 }, + { 0x13001fa8, 0x2000fff8 }, + { 0x13001fa9, 0x2000fff8 }, + { 0x13001faa, 0x2000fff8 }, + { 0x13001fab, 0x2000fff8 }, + { 0x13001fac, 0x2000fff8 }, + { 0x13001fad, 0x2000fff8 }, + { 0x13001fae, 0x2000fff8 }, + { 0x13001faf, 0x2000fff8 }, + { 0x13001fb0, 0x14000008 }, + { 0x13001fb1, 0x14000008 }, + { 0x13001fb2, 0x14000000 }, + { 0x13001fb3, 0x14000009 }, + { 0x13001fb4, 0x14000000 }, + { 0x13801fb6, 0x14000001 }, + { 0x13001fb8, 0x2400fff8 }, + { 0x13001fb9, 0x2400fff8 }, + { 0x13001fba, 0x2400ffb6 }, + { 0x13001fbb, 0x2400ffb6 }, + { 0x13001fbc, 0x2000fff7 }, + { 0x13001fbd, 0x60000000 }, + { 0x13001fbe, 0x1400e3db }, + { 0x13801fbf, 0x60000002 }, + { 0x13001fc2, 0x14000000 }, + { 0x13001fc3, 0x14000009 }, + { 0x13001fc4, 0x14000000 }, + { 0x13801fc6, 0x14000001 }, + { 0x13001fc8, 0x2400ffaa }, + { 0x13001fc9, 0x2400ffaa }, + { 0x13001fca, 0x2400ffaa }, + { 0x13001fcb, 0x2400ffaa }, + { 0x13001fcc, 0x2000fff7 }, + { 0x13801fcd, 0x60000002 }, + { 0x13001fd0, 0x14000008 }, + { 0x13001fd1, 0x14000008 }, + { 0x13801fd2, 0x14000001 }, + { 0x13801fd6, 0x14000001 }, + { 0x13001fd8, 0x2400fff8 }, + { 0x13001fd9, 0x2400fff8 }, + { 0x13001fda, 0x2400ff9c }, + { 0x13001fdb, 0x2400ff9c }, + { 0x13801fdd, 0x60000002 }, + { 0x13001fe0, 0x14000008 }, + { 0x13001fe1, 0x14000008 }, + { 0x13801fe2, 0x14000002 }, + { 0x13001fe5, 0x14000007 }, + { 0x13801fe6, 0x14000001 }, + { 0x13001fe8, 0x2400fff8 }, + { 0x13001fe9, 0x2400fff8 }, + { 0x13001fea, 0x2400ff90 }, + { 0x13001feb, 0x2400ff90 }, + { 0x13001fec, 0x2400fff9 }, + { 0x13801fed, 0x60000002 }, + { 0x13001ff2, 0x14000000 }, + { 0x13001ff3, 0x14000009 }, + { 0x13001ff4, 0x14000000 }, + { 0x13801ff6, 0x14000001 }, + { 0x13001ff8, 0x2400ff80 }, + { 0x13001ff9, 0x2400ff80 }, + { 0x13001ffa, 0x2400ff82 }, + { 0x13001ffb, 0x2400ff82 }, + { 0x13001ffc, 0x2000fff7 }, + { 0x13801ffd, 0x60000001 }, + { 0x09802000, 0x7400000a }, + { 0x0900200b, 0x04000000 }, + { 0x1b80200c, 0x04000001 }, + { 0x0980200e, 0x04000001 }, + { 0x09802010, 0x44000005 }, + { 0x09802016, 0x54000001 }, + { 0x09002018, 0x50000000 }, + { 0x09002019, 0x4c000000 }, + { 0x0900201a, 0x58000000 }, + { 0x0980201b, 0x50000001 }, + { 0x0900201d, 0x4c000000 }, + { 0x0900201e, 0x58000000 }, + { 0x0900201f, 0x50000000 }, + { 0x09802020, 0x54000007 }, + { 0x09002028, 0x6c000000 }, + { 0x09002029, 0x70000000 }, + { 0x0980202a, 0x04000004 }, + { 0x0900202f, 0x74000000 }, + { 0x09802030, 0x54000008 }, + { 0x09002039, 0x50000000 }, + { 0x0900203a, 0x4c000000 }, + { 0x0980203b, 0x54000003 }, + { 0x0980203f, 0x40000001 }, + { 0x09802041, 0x54000002 }, + { 0x09002044, 0x64000000 }, + { 0x09002045, 0x58000000 }, + { 0x09002046, 0x48000000 }, + { 0x09802047, 0x5400000a }, + { 0x09002052, 0x64000000 }, + { 0x09002053, 0x54000000 }, + { 0x09002054, 0x40000000 }, + { 0x09802055, 0x54000009 }, + { 0x0900205f, 0x74000000 }, + { 0x09802060, 0x04000003 }, + { 0x0980206a, 0x04000005 }, + { 0x09002070, 0x3c000000 }, + { 0x21002071, 0x14000000 }, + { 0x09802074, 0x3c000005 }, + { 0x0980207a, 0x64000002 }, + { 0x0900207d, 0x58000000 }, + { 0x0900207e, 0x48000000 }, + { 0x2100207f, 0x14000000 }, + { 0x09802080, 0x3c000009 }, + { 0x0980208a, 0x64000002 }, + { 0x0900208d, 0x58000000 }, + { 0x0900208e, 0x48000000 }, + { 0x21802090, 0x18000004 }, + { 0x098020a0, 0x5c000015 }, + { 0x1b8020d0, 0x3000000c }, + { 0x1b8020dd, 0x2c000003 }, + { 0x1b0020e1, 0x30000000 }, + { 0x1b8020e2, 0x2c000002 }, + { 0x1b8020e5, 0x3000000a }, + { 0x09802100, 0x68000001 }, + { 0x09002102, 0x24000000 }, + { 0x09802103, 0x68000003 }, + { 0x09002107, 0x24000000 }, + { 0x09802108, 0x68000001 }, + { 0x0900210a, 0x14000000 }, + { 0x0980210b, 0x24000002 }, + { 0x0980210e, 0x14000001 }, + { 0x09802110, 0x24000002 }, + { 0x09002113, 0x14000000 }, + { 0x09002114, 0x68000000 }, + { 0x09002115, 0x24000000 }, + { 0x09802116, 0x68000002 }, + { 0x09802119, 0x24000004 }, + { 0x0980211e, 0x68000005 }, + { 0x09002124, 0x24000000 }, + { 0x09002125, 0x68000000 }, + { 0x13002126, 0x2400e2a3 }, + { 0x09002127, 0x68000000 }, + { 0x09002128, 0x24000000 }, + { 0x09002129, 0x68000000 }, + { 0x2100212a, 0x2400df41 }, + { 0x2100212b, 0x2400dfba }, + { 0x0980212c, 0x24000001 }, + { 0x0900212e, 0x68000000 }, + { 0x0900212f, 0x14000000 }, + { 0x09802130, 0x24000001 }, + { 0x21002132, 0x2400001c }, + { 0x09002133, 0x24000000 }, + { 0x09002134, 0x14000000 }, + { 0x09802135, 0x1c000003 }, + { 0x09002139, 0x14000000 }, + { 0x0980213a, 0x68000001 }, + { 0x0980213c, 0x14000001 }, + { 0x0980213e, 0x24000001 }, + { 0x09802140, 0x64000004 }, + { 0x09002145, 0x24000000 }, + { 0x09802146, 0x14000003 }, + { 0x0900214a, 0x68000000 }, + { 0x0900214b, 0x64000000 }, + { 0x0980214c, 0x68000001 }, + { 0x2100214e, 0x1400ffe4 }, + { 0x09802153, 0x3c00000c }, + { 0x09002160, 0x38000010 }, + { 0x09002161, 0x38000010 }, + { 0x09002162, 0x38000010 }, + { 0x09002163, 0x38000010 }, + { 0x09002164, 0x38000010 }, + { 0x09002165, 0x38000010 }, + { 0x09002166, 0x38000010 }, + { 0x09002167, 0x38000010 }, + { 0x09002168, 0x38000010 }, + { 0x09002169, 0x38000010 }, + { 0x0900216a, 0x38000010 }, + { 0x0900216b, 0x38000010 }, + { 0x0900216c, 0x38000010 }, + { 0x0900216d, 0x38000010 }, + { 0x0900216e, 0x38000010 }, + { 0x0900216f, 0x38000010 }, + { 0x09002170, 0x3800fff0 }, + { 0x09002171, 0x3800fff0 }, + { 0x09002172, 0x3800fff0 }, + { 0x09002173, 0x3800fff0 }, + { 0x09002174, 0x3800fff0 }, + { 0x09002175, 0x3800fff0 }, + { 0x09002176, 0x3800fff0 }, + { 0x09002177, 0x3800fff0 }, + { 0x09002178, 0x3800fff0 }, + { 0x09002179, 0x3800fff0 }, + { 0x0900217a, 0x3800fff0 }, + { 0x0900217b, 0x3800fff0 }, + { 0x0900217c, 0x3800fff0 }, + { 0x0900217d, 0x3800fff0 }, + { 0x0900217e, 0x3800fff0 }, + { 0x0900217f, 0x3800fff0 }, + { 0x09802180, 0x38000002 }, + { 0x09002183, 0x24000001 }, + { 0x21002184, 0x1400ffff }, + { 0x09802190, 0x64000004 }, + { 0x09802195, 0x68000004 }, + { 0x0980219a, 0x64000001 }, + { 0x0980219c, 0x68000003 }, + { 0x090021a0, 0x64000000 }, + { 0x098021a1, 0x68000001 }, + { 0x090021a3, 0x64000000 }, + { 0x098021a4, 0x68000001 }, + { 0x090021a6, 0x64000000 }, + { 0x098021a7, 0x68000006 }, + { 0x090021ae, 0x64000000 }, + { 0x098021af, 0x6800001e }, + { 0x098021ce, 0x64000001 }, + { 0x098021d0, 0x68000001 }, + { 0x090021d2, 0x64000000 }, + { 0x090021d3, 0x68000000 }, + { 0x090021d4, 0x64000000 }, + { 0x098021d5, 0x6800001e }, + { 0x098021f4, 0x6400010b }, + { 0x09802300, 0x68000007 }, + { 0x09802308, 0x64000003 }, + { 0x0980230c, 0x68000013 }, + { 0x09802320, 0x64000001 }, + { 0x09802322, 0x68000006 }, + { 0x09002329, 0x58000000 }, + { 0x0900232a, 0x48000000 }, + { 0x0980232b, 0x68000050 }, + { 0x0900237c, 0x64000000 }, + { 0x0980237d, 0x6800001d }, + { 0x0980239b, 0x64000018 }, + { 0x098023b4, 0x68000027 }, + { 0x098023dc, 0x64000005 }, + { 0x098023e2, 0x68000005 }, + { 0x09802400, 0x68000026 }, + { 0x09802440, 0x6800000a }, + { 0x09802460, 0x3c00003b }, + { 0x0980249c, 0x68000019 }, + { 0x090024b6, 0x6800001a }, + { 0x090024b7, 0x6800001a }, + { 0x090024b8, 0x6800001a }, + { 0x090024b9, 0x6800001a }, + { 0x090024ba, 0x6800001a }, + { 0x090024bb, 0x6800001a }, + { 0x090024bc, 0x6800001a }, + { 0x090024bd, 0x6800001a }, + { 0x090024be, 0x6800001a }, + { 0x090024bf, 0x6800001a }, + { 0x090024c0, 0x6800001a }, + { 0x090024c1, 0x6800001a }, + { 0x090024c2, 0x6800001a }, + { 0x090024c3, 0x6800001a }, + { 0x090024c4, 0x6800001a }, + { 0x090024c5, 0x6800001a }, + { 0x090024c6, 0x6800001a }, + { 0x090024c7, 0x6800001a }, + { 0x090024c8, 0x6800001a }, + { 0x090024c9, 0x6800001a }, + { 0x090024ca, 0x6800001a }, + { 0x090024cb, 0x6800001a }, + { 0x090024cc, 0x6800001a }, + { 0x090024cd, 0x6800001a }, + { 0x090024ce, 0x6800001a }, + { 0x090024cf, 0x6800001a }, + { 0x090024d0, 0x6800ffe6 }, + { 0x090024d1, 0x6800ffe6 }, + { 0x090024d2, 0x6800ffe6 }, + { 0x090024d3, 0x6800ffe6 }, + { 0x090024d4, 0x6800ffe6 }, + { 0x090024d5, 0x6800ffe6 }, + { 0x090024d6, 0x6800ffe6 }, + { 0x090024d7, 0x6800ffe6 }, + { 0x090024d8, 0x6800ffe6 }, + { 0x090024d9, 0x6800ffe6 }, + { 0x090024da, 0x6800ffe6 }, + { 0x090024db, 0x6800ffe6 }, + { 0x090024dc, 0x6800ffe6 }, + { 0x090024dd, 0x6800ffe6 }, + { 0x090024de, 0x6800ffe6 }, + { 0x090024df, 0x6800ffe6 }, + { 0x090024e0, 0x6800ffe6 }, + { 0x090024e1, 0x6800ffe6 }, + { 0x090024e2, 0x6800ffe6 }, + { 0x090024e3, 0x6800ffe6 }, + { 0x090024e4, 0x6800ffe6 }, + { 0x090024e5, 0x6800ffe6 }, + { 0x090024e6, 0x6800ffe6 }, + { 0x090024e7, 0x6800ffe6 }, + { 0x090024e8, 0x6800ffe6 }, + { 0x090024e9, 0x6800ffe6 }, + { 0x098024ea, 0x3c000015 }, + { 0x09802500, 0x680000b6 }, + { 0x090025b7, 0x64000000 }, + { 0x098025b8, 0x68000008 }, + { 0x090025c1, 0x64000000 }, + { 0x098025c2, 0x68000035 }, + { 0x098025f8, 0x64000007 }, + { 0x09802600, 0x6800006e }, + { 0x0900266f, 0x64000000 }, + { 0x09802670, 0x6800002c }, + { 0x098026a0, 0x68000012 }, + { 0x09802701, 0x68000003 }, + { 0x09802706, 0x68000003 }, + { 0x0980270c, 0x6800001b }, + { 0x09802729, 0x68000022 }, + { 0x0900274d, 0x68000000 }, + { 0x0980274f, 0x68000003 }, + { 0x09002756, 0x68000000 }, + { 0x09802758, 0x68000006 }, + { 0x09802761, 0x68000006 }, + { 0x09002768, 0x58000000 }, + { 0x09002769, 0x48000000 }, + { 0x0900276a, 0x58000000 }, + { 0x0900276b, 0x48000000 }, + { 0x0900276c, 0x58000000 }, + { 0x0900276d, 0x48000000 }, + { 0x0900276e, 0x58000000 }, + { 0x0900276f, 0x48000000 }, + { 0x09002770, 0x58000000 }, + { 0x09002771, 0x48000000 }, + { 0x09002772, 0x58000000 }, + { 0x09002773, 0x48000000 }, + { 0x09002774, 0x58000000 }, + { 0x09002775, 0x48000000 }, + { 0x09802776, 0x3c00001d }, + { 0x09002794, 0x68000000 }, + { 0x09802798, 0x68000017 }, + { 0x098027b1, 0x6800000d }, + { 0x098027c0, 0x64000004 }, + { 0x090027c5, 0x58000000 }, + { 0x090027c6, 0x48000000 }, + { 0x098027c7, 0x64000003 }, + { 0x098027d0, 0x64000015 }, + { 0x090027e6, 0x58000000 }, + { 0x090027e7, 0x48000000 }, + { 0x090027e8, 0x58000000 }, + { 0x090027e9, 0x48000000 }, + { 0x090027ea, 0x58000000 }, + { 0x090027eb, 0x48000000 }, + { 0x098027f0, 0x6400000f }, + { 0x04802800, 0x680000ff }, + { 0x09802900, 0x64000082 }, + { 0x09002983, 0x58000000 }, + { 0x09002984, 0x48000000 }, + { 0x09002985, 0x58000000 }, + { 0x09002986, 0x48000000 }, + { 0x09002987, 0x58000000 }, + { 0x09002988, 0x48000000 }, + { 0x09002989, 0x58000000 }, + { 0x0900298a, 0x48000000 }, + { 0x0900298b, 0x58000000 }, + { 0x0900298c, 0x48000000 }, + { 0x0900298d, 0x58000000 }, + { 0x0900298e, 0x48000000 }, + { 0x0900298f, 0x58000000 }, + { 0x09002990, 0x48000000 }, + { 0x09002991, 0x58000000 }, + { 0x09002992, 0x48000000 }, + { 0x09002993, 0x58000000 }, + { 0x09002994, 0x48000000 }, + { 0x09002995, 0x58000000 }, + { 0x09002996, 0x48000000 }, + { 0x09002997, 0x58000000 }, + { 0x09002998, 0x48000000 }, + { 0x09802999, 0x6400003e }, + { 0x090029d8, 0x58000000 }, + { 0x090029d9, 0x48000000 }, + { 0x090029da, 0x58000000 }, + { 0x090029db, 0x48000000 }, + { 0x098029dc, 0x6400001f }, + { 0x090029fc, 0x58000000 }, + { 0x090029fd, 0x48000000 }, + { 0x098029fe, 0x64000101 }, + { 0x09802b00, 0x6800001a }, + { 0x09802b20, 0x68000003 }, + { 0x11002c00, 0x24000030 }, + { 0x11002c01, 0x24000030 }, + { 0x11002c02, 0x24000030 }, + { 0x11002c03, 0x24000030 }, + { 0x11002c04, 0x24000030 }, + { 0x11002c05, 0x24000030 }, + { 0x11002c06, 0x24000030 }, + { 0x11002c07, 0x24000030 }, + { 0x11002c08, 0x24000030 }, + { 0x11002c09, 0x24000030 }, + { 0x11002c0a, 0x24000030 }, + { 0x11002c0b, 0x24000030 }, + { 0x11002c0c, 0x24000030 }, + { 0x11002c0d, 0x24000030 }, + { 0x11002c0e, 0x24000030 }, + { 0x11002c0f, 0x24000030 }, + { 0x11002c10, 0x24000030 }, + { 0x11002c11, 0x24000030 }, + { 0x11002c12, 0x24000030 }, + { 0x11002c13, 0x24000030 }, + { 0x11002c14, 0x24000030 }, + { 0x11002c15, 0x24000030 }, + { 0x11002c16, 0x24000030 }, + { 0x11002c17, 0x24000030 }, + { 0x11002c18, 0x24000030 }, + { 0x11002c19, 0x24000030 }, + { 0x11002c1a, 0x24000030 }, + { 0x11002c1b, 0x24000030 }, + { 0x11002c1c, 0x24000030 }, + { 0x11002c1d, 0x24000030 }, + { 0x11002c1e, 0x24000030 }, + { 0x11002c1f, 0x24000030 }, + { 0x11002c20, 0x24000030 }, + { 0x11002c21, 0x24000030 }, + { 0x11002c22, 0x24000030 }, + { 0x11002c23, 0x24000030 }, + { 0x11002c24, 0x24000030 }, + { 0x11002c25, 0x24000030 }, + { 0x11002c26, 0x24000030 }, + { 0x11002c27, 0x24000030 }, + { 0x11002c28, 0x24000030 }, + { 0x11002c29, 0x24000030 }, + { 0x11002c2a, 0x24000030 }, + { 0x11002c2b, 0x24000030 }, + { 0x11002c2c, 0x24000030 }, + { 0x11002c2d, 0x24000030 }, + { 0x11002c2e, 0x24000030 }, + { 0x11002c30, 0x1400ffd0 }, + { 0x11002c31, 0x1400ffd0 }, + { 0x11002c32, 0x1400ffd0 }, + { 0x11002c33, 0x1400ffd0 }, + { 0x11002c34, 0x1400ffd0 }, + { 0x11002c35, 0x1400ffd0 }, + { 0x11002c36, 0x1400ffd0 }, + { 0x11002c37, 0x1400ffd0 }, + { 0x11002c38, 0x1400ffd0 }, + { 0x11002c39, 0x1400ffd0 }, + { 0x11002c3a, 0x1400ffd0 }, + { 0x11002c3b, 0x1400ffd0 }, + { 0x11002c3c, 0x1400ffd0 }, + { 0x11002c3d, 0x1400ffd0 }, + { 0x11002c3e, 0x1400ffd0 }, + { 0x11002c3f, 0x1400ffd0 }, + { 0x11002c40, 0x1400ffd0 }, + { 0x11002c41, 0x1400ffd0 }, + { 0x11002c42, 0x1400ffd0 }, + { 0x11002c43, 0x1400ffd0 }, + { 0x11002c44, 0x1400ffd0 }, + { 0x11002c45, 0x1400ffd0 }, + { 0x11002c46, 0x1400ffd0 }, + { 0x11002c47, 0x1400ffd0 }, + { 0x11002c48, 0x1400ffd0 }, + { 0x11002c49, 0x1400ffd0 }, + { 0x11002c4a, 0x1400ffd0 }, + { 0x11002c4b, 0x1400ffd0 }, + { 0x11002c4c, 0x1400ffd0 }, + { 0x11002c4d, 0x1400ffd0 }, + { 0x11002c4e, 0x1400ffd0 }, + { 0x11002c4f, 0x1400ffd0 }, + { 0x11002c50, 0x1400ffd0 }, + { 0x11002c51, 0x1400ffd0 }, + { 0x11002c52, 0x1400ffd0 }, + { 0x11002c53, 0x1400ffd0 }, + { 0x11002c54, 0x1400ffd0 }, + { 0x11002c55, 0x1400ffd0 }, + { 0x11002c56, 0x1400ffd0 }, + { 0x11002c57, 0x1400ffd0 }, + { 0x11002c58, 0x1400ffd0 }, + { 0x11002c59, 0x1400ffd0 }, + { 0x11002c5a, 0x1400ffd0 }, + { 0x11002c5b, 0x1400ffd0 }, + { 0x11002c5c, 0x1400ffd0 }, + { 0x11002c5d, 0x1400ffd0 }, + { 0x11002c5e, 0x1400ffd0 }, + { 0x21002c60, 0x24000001 }, + { 0x21002c61, 0x1400ffff }, + { 0x21002c62, 0x2400d609 }, + { 0x21002c63, 0x2400f11a }, + { 0x21002c64, 0x2400d619 }, + { 0x21002c65, 0x1400d5d5 }, + { 0x21002c66, 0x1400d5d8 }, + { 0x21002c67, 0x24000001 }, + { 0x21002c68, 0x1400ffff }, + { 0x21002c69, 0x24000001 }, + { 0x21002c6a, 0x1400ffff }, + { 0x21002c6b, 0x24000001 }, + { 0x21002c6c, 0x1400ffff }, + { 0x21002c74, 0x14000000 }, + { 0x21002c75, 0x24000001 }, + { 0x21002c76, 0x1400ffff }, + { 0x21002c77, 0x14000000 }, + { 0x0a002c80, 0x24000001 }, + { 0x0a002c81, 0x1400ffff }, + { 0x0a002c82, 0x24000001 }, + { 0x0a002c83, 0x1400ffff }, + { 0x0a002c84, 0x24000001 }, + { 0x0a002c85, 0x1400ffff }, + { 0x0a002c86, 0x24000001 }, + { 0x0a002c87, 0x1400ffff }, + { 0x0a002c88, 0x24000001 }, + { 0x0a002c89, 0x1400ffff }, + { 0x0a002c8a, 0x24000001 }, + { 0x0a002c8b, 0x1400ffff }, + { 0x0a002c8c, 0x24000001 }, + { 0x0a002c8d, 0x1400ffff }, + { 0x0a002c8e, 0x24000001 }, + { 0x0a002c8f, 0x1400ffff }, + { 0x0a002c90, 0x24000001 }, + { 0x0a002c91, 0x1400ffff }, + { 0x0a002c92, 0x24000001 }, + { 0x0a002c93, 0x1400ffff }, + { 0x0a002c94, 0x24000001 }, + { 0x0a002c95, 0x1400ffff }, + { 0x0a002c96, 0x24000001 }, + { 0x0a002c97, 0x1400ffff }, + { 0x0a002c98, 0x24000001 }, + { 0x0a002c99, 0x1400ffff }, + { 0x0a002c9a, 0x24000001 }, + { 0x0a002c9b, 0x1400ffff }, + { 0x0a002c9c, 0x24000001 }, + { 0x0a002c9d, 0x1400ffff }, + { 0x0a002c9e, 0x24000001 }, + { 0x0a002c9f, 0x1400ffff }, + { 0x0a002ca0, 0x24000001 }, + { 0x0a002ca1, 0x1400ffff }, + { 0x0a002ca2, 0x24000001 }, + { 0x0a002ca3, 0x1400ffff }, + { 0x0a002ca4, 0x24000001 }, + { 0x0a002ca5, 0x1400ffff }, + { 0x0a002ca6, 0x24000001 }, + { 0x0a002ca7, 0x1400ffff }, + { 0x0a002ca8, 0x24000001 }, + { 0x0a002ca9, 0x1400ffff }, + { 0x0a002caa, 0x24000001 }, + { 0x0a002cab, 0x1400ffff }, + { 0x0a002cac, 0x24000001 }, + { 0x0a002cad, 0x1400ffff }, + { 0x0a002cae, 0x24000001 }, + { 0x0a002caf, 0x1400ffff }, + { 0x0a002cb0, 0x24000001 }, + { 0x0a002cb1, 0x1400ffff }, + { 0x0a002cb2, 0x24000001 }, + { 0x0a002cb3, 0x1400ffff }, + { 0x0a002cb4, 0x24000001 }, + { 0x0a002cb5, 0x1400ffff }, + { 0x0a002cb6, 0x24000001 }, + { 0x0a002cb7, 0x1400ffff }, + { 0x0a002cb8, 0x24000001 }, + { 0x0a002cb9, 0x1400ffff }, + { 0x0a002cba, 0x24000001 }, + { 0x0a002cbb, 0x1400ffff }, + { 0x0a002cbc, 0x24000001 }, + { 0x0a002cbd, 0x1400ffff }, + { 0x0a002cbe, 0x24000001 }, + { 0x0a002cbf, 0x1400ffff }, + { 0x0a002cc0, 0x24000001 }, + { 0x0a002cc1, 0x1400ffff }, + { 0x0a002cc2, 0x24000001 }, + { 0x0a002cc3, 0x1400ffff }, + { 0x0a002cc4, 0x24000001 }, + { 0x0a002cc5, 0x1400ffff }, + { 0x0a002cc6, 0x24000001 }, + { 0x0a002cc7, 0x1400ffff }, + { 0x0a002cc8, 0x24000001 }, + { 0x0a002cc9, 0x1400ffff }, + { 0x0a002cca, 0x24000001 }, + { 0x0a002ccb, 0x1400ffff }, + { 0x0a002ccc, 0x24000001 }, + { 0x0a002ccd, 0x1400ffff }, + { 0x0a002cce, 0x24000001 }, + { 0x0a002ccf, 0x1400ffff }, + { 0x0a002cd0, 0x24000001 }, + { 0x0a002cd1, 0x1400ffff }, + { 0x0a002cd2, 0x24000001 }, + { 0x0a002cd3, 0x1400ffff }, + { 0x0a002cd4, 0x24000001 }, + { 0x0a002cd5, 0x1400ffff }, + { 0x0a002cd6, 0x24000001 }, + { 0x0a002cd7, 0x1400ffff }, + { 0x0a002cd8, 0x24000001 }, + { 0x0a002cd9, 0x1400ffff }, + { 0x0a002cda, 0x24000001 }, + { 0x0a002cdb, 0x1400ffff }, + { 0x0a002cdc, 0x24000001 }, + { 0x0a002cdd, 0x1400ffff }, + { 0x0a002cde, 0x24000001 }, + { 0x0a002cdf, 0x1400ffff }, + { 0x0a002ce0, 0x24000001 }, + { 0x0a002ce1, 0x1400ffff }, + { 0x0a002ce2, 0x24000001 }, + { 0x0a002ce3, 0x1400ffff }, + { 0x0a002ce4, 0x14000000 }, + { 0x0a802ce5, 0x68000005 }, + { 0x0a802cf9, 0x54000003 }, + { 0x0a002cfd, 0x3c000000 }, + { 0x0a802cfe, 0x54000001 }, + { 0x10002d00, 0x1400e3a0 }, + { 0x10002d01, 0x1400e3a0 }, + { 0x10002d02, 0x1400e3a0 }, + { 0x10002d03, 0x1400e3a0 }, + { 0x10002d04, 0x1400e3a0 }, + { 0x10002d05, 0x1400e3a0 }, + { 0x10002d06, 0x1400e3a0 }, + { 0x10002d07, 0x1400e3a0 }, + { 0x10002d08, 0x1400e3a0 }, + { 0x10002d09, 0x1400e3a0 }, + { 0x10002d0a, 0x1400e3a0 }, + { 0x10002d0b, 0x1400e3a0 }, + { 0x10002d0c, 0x1400e3a0 }, + { 0x10002d0d, 0x1400e3a0 }, + { 0x10002d0e, 0x1400e3a0 }, + { 0x10002d0f, 0x1400e3a0 }, + { 0x10002d10, 0x1400e3a0 }, + { 0x10002d11, 0x1400e3a0 }, + { 0x10002d12, 0x1400e3a0 }, + { 0x10002d13, 0x1400e3a0 }, + { 0x10002d14, 0x1400e3a0 }, + { 0x10002d15, 0x1400e3a0 }, + { 0x10002d16, 0x1400e3a0 }, + { 0x10002d17, 0x1400e3a0 }, + { 0x10002d18, 0x1400e3a0 }, + { 0x10002d19, 0x1400e3a0 }, + { 0x10002d1a, 0x1400e3a0 }, + { 0x10002d1b, 0x1400e3a0 }, + { 0x10002d1c, 0x1400e3a0 }, + { 0x10002d1d, 0x1400e3a0 }, + { 0x10002d1e, 0x1400e3a0 }, + { 0x10002d1f, 0x1400e3a0 }, + { 0x10002d20, 0x1400e3a0 }, + { 0x10002d21, 0x1400e3a0 }, + { 0x10002d22, 0x1400e3a0 }, + { 0x10002d23, 0x1400e3a0 }, + { 0x10002d24, 0x1400e3a0 }, + { 0x10002d25, 0x1400e3a0 }, + { 0x3a802d30, 0x1c000035 }, + { 0x3a002d6f, 0x18000000 }, + { 0x0f802d80, 0x1c000016 }, + { 0x0f802da0, 0x1c000006 }, + { 0x0f802da8, 0x1c000006 }, + { 0x0f802db0, 0x1c000006 }, + { 0x0f802db8, 0x1c000006 }, + { 0x0f802dc0, 0x1c000006 }, + { 0x0f802dc8, 0x1c000006 }, + { 0x0f802dd0, 0x1c000006 }, + { 0x0f802dd8, 0x1c000006 }, + { 0x09802e00, 0x54000001 }, + { 0x09002e02, 0x50000000 }, + { 0x09002e03, 0x4c000000 }, + { 0x09002e04, 0x50000000 }, + { 0x09002e05, 0x4c000000 }, + { 0x09802e06, 0x54000002 }, + { 0x09002e09, 0x50000000 }, + { 0x09002e0a, 0x4c000000 }, + { 0x09002e0b, 0x54000000 }, + { 0x09002e0c, 0x50000000 }, + { 0x09002e0d, 0x4c000000 }, + { 0x09802e0e, 0x54000008 }, + { 0x09002e17, 0x44000000 }, + { 0x09002e1c, 0x50000000 }, + { 0x09002e1d, 0x4c000000 }, + { 0x16802e80, 0x68000019 }, + { 0x16802e9b, 0x68000058 }, + { 0x16802f00, 0x680000d5 }, + { 0x09802ff0, 0x6800000b }, + { 0x09003000, 0x74000000 }, + { 0x09803001, 0x54000002 }, + { 0x09003004, 0x68000000 }, + { 0x16003005, 0x18000000 }, + { 0x09003006, 0x1c000000 }, + { 0x16003007, 0x38000000 }, + { 0x09003008, 0x58000000 }, + { 0x09003009, 0x48000000 }, + { 0x0900300a, 0x58000000 }, + { 0x0900300b, 0x48000000 }, + { 0x0900300c, 0x58000000 }, + { 0x0900300d, 0x48000000 }, + { 0x0900300e, 0x58000000 }, + { 0x0900300f, 0x48000000 }, + { 0x09003010, 0x58000000 }, + { 0x09003011, 0x48000000 }, + { 0x09803012, 0x68000001 }, + { 0x09003014, 0x58000000 }, + { 0x09003015, 0x48000000 }, + { 0x09003016, 0x58000000 }, + { 0x09003017, 0x48000000 }, + { 0x09003018, 0x58000000 }, + { 0x09003019, 0x48000000 }, + { 0x0900301a, 0x58000000 }, + { 0x0900301b, 0x48000000 }, + { 0x0900301c, 0x44000000 }, + { 0x0900301d, 0x58000000 }, + { 0x0980301e, 0x48000001 }, + { 0x09003020, 0x68000000 }, + { 0x16803021, 0x38000008 }, + { 0x1b80302a, 0x30000005 }, + { 0x09003030, 0x44000000 }, + { 0x09803031, 0x18000004 }, + { 0x09803036, 0x68000001 }, + { 0x16803038, 0x38000002 }, + { 0x1600303b, 0x18000000 }, + { 0x0900303c, 0x1c000000 }, + { 0x0900303d, 0x54000000 }, + { 0x0980303e, 0x68000001 }, + { 0x1a803041, 0x1c000055 }, + { 0x1b803099, 0x30000001 }, + { 0x0980309b, 0x60000001 }, + { 0x1a80309d, 0x18000001 }, + { 0x1a00309f, 0x1c000000 }, + { 0x090030a0, 0x44000000 }, + { 0x1d8030a1, 0x1c000059 }, + { 0x090030fb, 0x54000000 }, + { 0x090030fc, 0x18000000 }, + { 0x1d8030fd, 0x18000001 }, + { 0x1d0030ff, 0x1c000000 }, + { 0x03803105, 0x1c000027 }, + { 0x17803131, 0x1c00005d }, + { 0x09803190, 0x68000001 }, + { 0x09803192, 0x3c000003 }, + { 0x09803196, 0x68000009 }, + { 0x038031a0, 0x1c000017 }, + { 0x098031c0, 0x6800000f }, + { 0x1d8031f0, 0x1c00000f }, + { 0x17803200, 0x6800001e }, + { 0x09803220, 0x3c000009 }, + { 0x0980322a, 0x68000019 }, + { 0x09003250, 0x68000000 }, + { 0x09803251, 0x3c00000e }, + { 0x17803260, 0x6800001d }, + { 0x0980327e, 0x68000001 }, + { 0x09803280, 0x3c000009 }, + { 0x0980328a, 0x68000026 }, + { 0x098032b1, 0x3c00000e }, + { 0x098032c0, 0x6800003e }, + { 0x09803300, 0x680000ff }, + { 0x16803400, 0x1c0019b5 }, + { 0x09804dc0, 0x6800003f }, + { 0x16804e00, 0x1c0051bb }, + { 0x3c80a000, 0x1c000014 }, + { 0x3c00a015, 0x18000000 }, + { 0x3c80a016, 0x1c000476 }, + { 0x3c80a490, 0x68000036 }, + { 0x0980a700, 0x60000016 }, + { 0x0980a717, 0x18000003 }, + { 0x0980a720, 0x60000001 }, + { 0x3080a800, 0x1c000001 }, + { 0x3000a802, 0x28000000 }, + { 0x3080a803, 0x1c000002 }, + { 0x3000a806, 0x30000000 }, + { 0x3080a807, 0x1c000003 }, + { 0x3000a80b, 0x30000000 }, + { 0x3080a80c, 0x1c000016 }, + { 0x3080a823, 0x28000001 }, + { 0x3080a825, 0x30000001 }, + { 0x3000a827, 0x28000000 }, + { 0x3080a828, 0x68000003 }, + { 0x4080a840, 0x1c000033 }, + { 0x4080a874, 0x54000003 }, + { 0x1780ac00, 0x1c002ba3 }, + { 0x0980d800, 0x1000037f }, + { 0x0980db80, 0x1000007f }, + { 0x0980dc00, 0x100003ff }, + { 0x0980e000, 0x0c0018ff }, + { 0x1680f900, 0x1c00012d }, + { 0x1680fa30, 0x1c00003a }, + { 0x1680fa70, 0x1c000069 }, + { 0x2180fb00, 0x14000006 }, + { 0x0180fb13, 0x14000004 }, + { 0x1900fb1d, 0x1c000000 }, + { 0x1900fb1e, 0x30000000 }, + { 0x1980fb1f, 0x1c000009 }, + { 0x1900fb29, 0x64000000 }, + { 0x1980fb2a, 0x1c00000c }, + { 0x1980fb38, 0x1c000004 }, + { 0x1900fb3e, 0x1c000000 }, + { 0x1980fb40, 0x1c000001 }, + { 0x1980fb43, 0x1c000001 }, + { 0x1980fb46, 0x1c000009 }, + { 0x0080fb50, 0x1c000061 }, + { 0x0080fbd3, 0x1c00016a }, + { 0x0900fd3e, 0x58000000 }, + { 0x0900fd3f, 0x48000000 }, + { 0x0080fd50, 0x1c00003f }, + { 0x0080fd92, 0x1c000035 }, + { 0x0080fdf0, 0x1c00000b }, + { 0x0000fdfc, 0x5c000000 }, + { 0x0900fdfd, 0x68000000 }, + { 0x1b80fe00, 0x3000000f }, + { 0x0980fe10, 0x54000006 }, + { 0x0900fe17, 0x58000000 }, + { 0x0900fe18, 0x48000000 }, + { 0x0900fe19, 0x54000000 }, + { 0x1b80fe20, 0x30000003 }, + { 0x0900fe30, 0x54000000 }, + { 0x0980fe31, 0x44000001 }, + { 0x0980fe33, 0x40000001 }, + { 0x0900fe35, 0x58000000 }, + { 0x0900fe36, 0x48000000 }, + { 0x0900fe37, 0x58000000 }, + { 0x0900fe38, 0x48000000 }, + { 0x0900fe39, 0x58000000 }, + { 0x0900fe3a, 0x48000000 }, + { 0x0900fe3b, 0x58000000 }, + { 0x0900fe3c, 0x48000000 }, + { 0x0900fe3d, 0x58000000 }, + { 0x0900fe3e, 0x48000000 }, + { 0x0900fe3f, 0x58000000 }, + { 0x0900fe40, 0x48000000 }, + { 0x0900fe41, 0x58000000 }, + { 0x0900fe42, 0x48000000 }, + { 0x0900fe43, 0x58000000 }, + { 0x0900fe44, 0x48000000 }, + { 0x0980fe45, 0x54000001 }, + { 0x0900fe47, 0x58000000 }, + { 0x0900fe48, 0x48000000 }, + { 0x0980fe49, 0x54000003 }, + { 0x0980fe4d, 0x40000002 }, + { 0x0980fe50, 0x54000002 }, + { 0x0980fe54, 0x54000003 }, + { 0x0900fe58, 0x44000000 }, + { 0x0900fe59, 0x58000000 }, + { 0x0900fe5a, 0x48000000 }, + { 0x0900fe5b, 0x58000000 }, + { 0x0900fe5c, 0x48000000 }, + { 0x0900fe5d, 0x58000000 }, + { 0x0900fe5e, 0x48000000 }, + { 0x0980fe5f, 0x54000002 }, + { 0x0900fe62, 0x64000000 }, + { 0x0900fe63, 0x44000000 }, + { 0x0980fe64, 0x64000002 }, + { 0x0900fe68, 0x54000000 }, + { 0x0900fe69, 0x5c000000 }, + { 0x0980fe6a, 0x54000001 }, + { 0x0080fe70, 0x1c000004 }, + { 0x0080fe76, 0x1c000086 }, + { 0x0900feff, 0x04000000 }, + { 0x0980ff01, 0x54000002 }, + { 0x0900ff04, 0x5c000000 }, + { 0x0980ff05, 0x54000002 }, + { 0x0900ff08, 0x58000000 }, + { 0x0900ff09, 0x48000000 }, + { 0x0900ff0a, 0x54000000 }, + { 0x0900ff0b, 0x64000000 }, + { 0x0900ff0c, 0x54000000 }, + { 0x0900ff0d, 0x44000000 }, + { 0x0980ff0e, 0x54000001 }, + { 0x0980ff10, 0x34000009 }, + { 0x0980ff1a, 0x54000001 }, + { 0x0980ff1c, 0x64000002 }, + { 0x0980ff1f, 0x54000001 }, + { 0x2100ff21, 0x24000020 }, + { 0x2100ff22, 0x24000020 }, + { 0x2100ff23, 0x24000020 }, + { 0x2100ff24, 0x24000020 }, + { 0x2100ff25, 0x24000020 }, + { 0x2100ff26, 0x24000020 }, + { 0x2100ff27, 0x24000020 }, + { 0x2100ff28, 0x24000020 }, + { 0x2100ff29, 0x24000020 }, + { 0x2100ff2a, 0x24000020 }, + { 0x2100ff2b, 0x24000020 }, + { 0x2100ff2c, 0x24000020 }, + { 0x2100ff2d, 0x24000020 }, + { 0x2100ff2e, 0x24000020 }, + { 0x2100ff2f, 0x24000020 }, + { 0x2100ff30, 0x24000020 }, + { 0x2100ff31, 0x24000020 }, + { 0x2100ff32, 0x24000020 }, + { 0x2100ff33, 0x24000020 }, + { 0x2100ff34, 0x24000020 }, + { 0x2100ff35, 0x24000020 }, + { 0x2100ff36, 0x24000020 }, + { 0x2100ff37, 0x24000020 }, + { 0x2100ff38, 0x24000020 }, + { 0x2100ff39, 0x24000020 }, + { 0x2100ff3a, 0x24000020 }, + { 0x0900ff3b, 0x58000000 }, + { 0x0900ff3c, 0x54000000 }, + { 0x0900ff3d, 0x48000000 }, + { 0x0900ff3e, 0x60000000 }, + { 0x0900ff3f, 0x40000000 }, + { 0x0900ff40, 0x60000000 }, + { 0x2100ff41, 0x1400ffe0 }, + { 0x2100ff42, 0x1400ffe0 }, + { 0x2100ff43, 0x1400ffe0 }, + { 0x2100ff44, 0x1400ffe0 }, + { 0x2100ff45, 0x1400ffe0 }, + { 0x2100ff46, 0x1400ffe0 }, + { 0x2100ff47, 0x1400ffe0 }, + { 0x2100ff48, 0x1400ffe0 }, + { 0x2100ff49, 0x1400ffe0 }, + { 0x2100ff4a, 0x1400ffe0 }, + { 0x2100ff4b, 0x1400ffe0 }, + { 0x2100ff4c, 0x1400ffe0 }, + { 0x2100ff4d, 0x1400ffe0 }, + { 0x2100ff4e, 0x1400ffe0 }, + { 0x2100ff4f, 0x1400ffe0 }, + { 0x2100ff50, 0x1400ffe0 }, + { 0x2100ff51, 0x1400ffe0 }, + { 0x2100ff52, 0x1400ffe0 }, + { 0x2100ff53, 0x1400ffe0 }, + { 0x2100ff54, 0x1400ffe0 }, + { 0x2100ff55, 0x1400ffe0 }, + { 0x2100ff56, 0x1400ffe0 }, + { 0x2100ff57, 0x1400ffe0 }, + { 0x2100ff58, 0x1400ffe0 }, + { 0x2100ff59, 0x1400ffe0 }, + { 0x2100ff5a, 0x1400ffe0 }, + { 0x0900ff5b, 0x58000000 }, + { 0x0900ff5c, 0x64000000 }, + { 0x0900ff5d, 0x48000000 }, + { 0x0900ff5e, 0x64000000 }, + { 0x0900ff5f, 0x58000000 }, + { 0x0900ff60, 0x48000000 }, + { 0x0900ff61, 0x54000000 }, + { 0x0900ff62, 0x58000000 }, + { 0x0900ff63, 0x48000000 }, + { 0x0980ff64, 0x54000001 }, + { 0x1d80ff66, 0x1c000009 }, + { 0x0900ff70, 0x18000000 }, + { 0x1d80ff71, 0x1c00002c }, + { 0x0980ff9e, 0x18000001 }, + { 0x1780ffa0, 0x1c00001e }, + { 0x1780ffc2, 0x1c000005 }, + { 0x1780ffca, 0x1c000005 }, + { 0x1780ffd2, 0x1c000005 }, + { 0x1780ffda, 0x1c000002 }, + { 0x0980ffe0, 0x5c000001 }, + { 0x0900ffe2, 0x64000000 }, + { 0x0900ffe3, 0x60000000 }, + { 0x0900ffe4, 0x68000000 }, + { 0x0980ffe5, 0x5c000001 }, + { 0x0900ffe8, 0x68000000 }, + { 0x0980ffe9, 0x64000003 }, + { 0x0980ffed, 0x68000001 }, + { 0x0980fff9, 0x04000002 }, + { 0x0980fffc, 0x68000001 }, + { 0x23810000, 0x1c00000b }, + { 0x2381000d, 0x1c000019 }, + { 0x23810028, 0x1c000012 }, + { 0x2381003c, 0x1c000001 }, + { 0x2381003f, 0x1c00000e }, + { 0x23810050, 0x1c00000d }, + { 0x23810080, 0x1c00007a }, + { 0x09810100, 0x54000001 }, + { 0x09010102, 0x68000000 }, + { 0x09810107, 0x3c00002c }, + { 0x09810137, 0x68000008 }, + { 0x13810140, 0x38000034 }, + { 0x13810175, 0x3c000003 }, + { 0x13810179, 0x68000010 }, + { 0x1301018a, 0x3c000000 }, + { 0x29810300, 0x1c00001e }, + { 0x29810320, 0x3c000003 }, + { 0x12810330, 0x1c000010 }, + { 0x12010341, 0x38000000 }, + { 0x12810342, 0x1c000007 }, + { 0x1201034a, 0x38000000 }, + { 0x3b810380, 0x1c00001d }, + { 0x3b01039f, 0x54000000 }, + { 0x2a8103a0, 0x1c000023 }, + { 0x2a8103c8, 0x1c000007 }, + { 0x2a0103d0, 0x54000000 }, + { 0x2a8103d1, 0x38000004 }, + { 0x0d010400, 0x24000028 }, + { 0x0d010401, 0x24000028 }, + { 0x0d010402, 0x24000028 }, + { 0x0d010403, 0x24000028 }, + { 0x0d010404, 0x24000028 }, + { 0x0d010405, 0x24000028 }, + { 0x0d010406, 0x24000028 }, + { 0x0d010407, 0x24000028 }, + { 0x0d010408, 0x24000028 }, + { 0x0d010409, 0x24000028 }, + { 0x0d01040a, 0x24000028 }, + { 0x0d01040b, 0x24000028 }, + { 0x0d01040c, 0x24000028 }, + { 0x0d01040d, 0x24000028 }, + { 0x0d01040e, 0x24000028 }, + { 0x0d01040f, 0x24000028 }, + { 0x0d010410, 0x24000028 }, + { 0x0d010411, 0x24000028 }, + { 0x0d010412, 0x24000028 }, + { 0x0d010413, 0x24000028 }, + { 0x0d010414, 0x24000028 }, + { 0x0d010415, 0x24000028 }, + { 0x0d010416, 0x24000028 }, + { 0x0d010417, 0x24000028 }, + { 0x0d010418, 0x24000028 }, + { 0x0d010419, 0x24000028 }, + { 0x0d01041a, 0x24000028 }, + { 0x0d01041b, 0x24000028 }, + { 0x0d01041c, 0x24000028 }, + { 0x0d01041d, 0x24000028 }, + { 0x0d01041e, 0x24000028 }, + { 0x0d01041f, 0x24000028 }, + { 0x0d010420, 0x24000028 }, + { 0x0d010421, 0x24000028 }, + { 0x0d010422, 0x24000028 }, + { 0x0d010423, 0x24000028 }, + { 0x0d010424, 0x24000028 }, + { 0x0d010425, 0x24000028 }, + { 0x0d010426, 0x24000028 }, + { 0x0d010427, 0x24000028 }, + { 0x0d010428, 0x1400ffd8 }, + { 0x0d010429, 0x1400ffd8 }, + { 0x0d01042a, 0x1400ffd8 }, + { 0x0d01042b, 0x1400ffd8 }, + { 0x0d01042c, 0x1400ffd8 }, + { 0x0d01042d, 0x1400ffd8 }, + { 0x0d01042e, 0x1400ffd8 }, + { 0x0d01042f, 0x1400ffd8 }, + { 0x0d010430, 0x1400ffd8 }, + { 0x0d010431, 0x1400ffd8 }, + { 0x0d010432, 0x1400ffd8 }, + { 0x0d010433, 0x1400ffd8 }, + { 0x0d010434, 0x1400ffd8 }, + { 0x0d010435, 0x1400ffd8 }, + { 0x0d010436, 0x1400ffd8 }, + { 0x0d010437, 0x1400ffd8 }, + { 0x0d010438, 0x1400ffd8 }, + { 0x0d010439, 0x1400ffd8 }, + { 0x0d01043a, 0x1400ffd8 }, + { 0x0d01043b, 0x1400ffd8 }, + { 0x0d01043c, 0x1400ffd8 }, + { 0x0d01043d, 0x1400ffd8 }, + { 0x0d01043e, 0x1400ffd8 }, + { 0x0d01043f, 0x1400ffd8 }, + { 0x0d010440, 0x1400ffd8 }, + { 0x0d010441, 0x1400ffd8 }, + { 0x0d010442, 0x1400ffd8 }, + { 0x0d010443, 0x1400ffd8 }, + { 0x0d010444, 0x1400ffd8 }, + { 0x0d010445, 0x1400ffd8 }, + { 0x0d010446, 0x1400ffd8 }, + { 0x0d010447, 0x1400ffd8 }, + { 0x0d010448, 0x1400ffd8 }, + { 0x0d010449, 0x1400ffd8 }, + { 0x0d01044a, 0x1400ffd8 }, + { 0x0d01044b, 0x1400ffd8 }, + { 0x0d01044c, 0x1400ffd8 }, + { 0x0d01044d, 0x1400ffd8 }, + { 0x0d01044e, 0x1400ffd8 }, + { 0x0d01044f, 0x1400ffd8 }, + { 0x2e810450, 0x1c00002f }, + { 0x2c810480, 0x1c00001d }, + { 0x2c8104a0, 0x34000009 }, + { 0x0b810800, 0x1c000005 }, + { 0x0b010808, 0x1c000000 }, + { 0x0b81080a, 0x1c00002b }, + { 0x0b810837, 0x1c000001 }, + { 0x0b01083c, 0x1c000000 }, + { 0x0b01083f, 0x1c000000 }, + { 0x41810900, 0x1c000015 }, + { 0x41810916, 0x3c000003 }, + { 0x4101091f, 0x54000000 }, + { 0x1e010a00, 0x1c000000 }, + { 0x1e810a01, 0x30000002 }, + { 0x1e810a05, 0x30000001 }, + { 0x1e810a0c, 0x30000003 }, + { 0x1e810a10, 0x1c000003 }, + { 0x1e810a15, 0x1c000002 }, + { 0x1e810a19, 0x1c00001a }, + { 0x1e810a38, 0x30000002 }, + { 0x1e010a3f, 0x30000000 }, + { 0x1e810a40, 0x3c000007 }, + { 0x1e810a50, 0x54000008 }, + { 0x3e812000, 0x1c00036e }, + { 0x3e812400, 0x38000062 }, + { 0x3e812470, 0x54000003 }, + { 0x0981d000, 0x680000f5 }, + { 0x0981d100, 0x68000026 }, + { 0x0981d12a, 0x6800003a }, + { 0x0981d165, 0x28000001 }, + { 0x1b81d167, 0x30000002 }, + { 0x0981d16a, 0x68000002 }, + { 0x0981d16d, 0x28000005 }, + { 0x0981d173, 0x04000007 }, + { 0x1b81d17b, 0x30000007 }, + { 0x0981d183, 0x68000001 }, + { 0x1b81d185, 0x30000006 }, + { 0x0981d18c, 0x6800001d }, + { 0x1b81d1aa, 0x30000003 }, + { 0x0981d1ae, 0x6800002f }, + { 0x1381d200, 0x68000041 }, + { 0x1381d242, 0x30000002 }, + { 0x1301d245, 0x68000000 }, + { 0x0981d300, 0x68000056 }, + { 0x0981d360, 0x3c000011 }, + { 0x0981d400, 0x24000019 }, + { 0x0981d41a, 0x14000019 }, + { 0x0981d434, 0x24000019 }, + { 0x0981d44e, 0x14000006 }, + { 0x0981d456, 0x14000011 }, + { 0x0981d468, 0x24000019 }, + { 0x0981d482, 0x14000019 }, + { 0x0901d49c, 0x24000000 }, + { 0x0981d49e, 0x24000001 }, + { 0x0901d4a2, 0x24000000 }, + { 0x0981d4a5, 0x24000001 }, + { 0x0981d4a9, 0x24000003 }, + { 0x0981d4ae, 0x24000007 }, + { 0x0981d4b6, 0x14000003 }, + { 0x0901d4bb, 0x14000000 }, + { 0x0981d4bd, 0x14000006 }, + { 0x0981d4c5, 0x1400000a }, + { 0x0981d4d0, 0x24000019 }, + { 0x0981d4ea, 0x14000019 }, + { 0x0981d504, 0x24000001 }, + { 0x0981d507, 0x24000003 }, + { 0x0981d50d, 0x24000007 }, + { 0x0981d516, 0x24000006 }, + { 0x0981d51e, 0x14000019 }, + { 0x0981d538, 0x24000001 }, + { 0x0981d53b, 0x24000003 }, + { 0x0981d540, 0x24000004 }, + { 0x0901d546, 0x24000000 }, + { 0x0981d54a, 0x24000006 }, + { 0x0981d552, 0x14000019 }, + { 0x0981d56c, 0x24000019 }, + { 0x0981d586, 0x14000019 }, + { 0x0981d5a0, 0x24000019 }, + { 0x0981d5ba, 0x14000019 }, + { 0x0981d5d4, 0x24000019 }, + { 0x0981d5ee, 0x14000019 }, + { 0x0981d608, 0x24000019 }, + { 0x0981d622, 0x14000019 }, + { 0x0981d63c, 0x24000019 }, + { 0x0981d656, 0x14000019 }, + { 0x0981d670, 0x24000019 }, + { 0x0981d68a, 0x1400001b }, + { 0x0981d6a8, 0x24000018 }, + { 0x0901d6c1, 0x64000000 }, + { 0x0981d6c2, 0x14000018 }, + { 0x0901d6db, 0x64000000 }, + { 0x0981d6dc, 0x14000005 }, + { 0x0981d6e2, 0x24000018 }, + { 0x0901d6fb, 0x64000000 }, + { 0x0981d6fc, 0x14000018 }, + { 0x0901d715, 0x64000000 }, + { 0x0981d716, 0x14000005 }, + { 0x0981d71c, 0x24000018 }, + { 0x0901d735, 0x64000000 }, + { 0x0981d736, 0x14000018 }, + { 0x0901d74f, 0x64000000 }, + { 0x0981d750, 0x14000005 }, + { 0x0981d756, 0x24000018 }, + { 0x0901d76f, 0x64000000 }, + { 0x0981d770, 0x14000018 }, + { 0x0901d789, 0x64000000 }, + { 0x0981d78a, 0x14000005 }, + { 0x0981d790, 0x24000018 }, + { 0x0901d7a9, 0x64000000 }, + { 0x0981d7aa, 0x14000018 }, + { 0x0901d7c3, 0x64000000 }, + { 0x0981d7c4, 0x14000005 }, + { 0x0901d7ca, 0x24000000 }, + { 0x0901d7cb, 0x14000000 }, + { 0x0981d7ce, 0x34000031 }, + { 0x16820000, 0x1c00a6d6 }, + { 0x1682f800, 0x1c00021d }, + { 0x090e0001, 0x04000000 }, + { 0x098e0020, 0x0400005f }, + { 0x1b8e0100, 0x300000ef }, + { 0x098f0000, 0x0c00fffd }, + { 0x09900000, 0x0c00fffd }, +}; diff --git a/erts/emulator/sys/common/erl_check_io.c b/erts/emulator/sys/common/erl_check_io.c new file mode 100644 index 0000000000..218bd79584 --- /dev/null +++ b/erts/emulator/sys/common/erl_check_io.c @@ -0,0 +1,1912 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Check I/O + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define ERL_CHECK_IO_C__ +#define ERTS_WANT_BREAK_HANDLING +#ifndef WANT_NONBLOCKING +# define WANT_NONBLOCKING +#endif +#include "sys.h" +#include "global.h" +#include "erl_check_io.h" + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS +# define ERTS_DRV_EV_STATE_EXTRA_SIZE 128 +#else +# include "safe_hash.h" +# define DRV_EV_STATE_HTAB_SIZE 1024 +#endif + +typedef char EventStateType; +#define ERTS_EV_TYPE_NONE ((EventStateType) 0) +#define ERTS_EV_TYPE_DRV_SEL ((EventStateType) 1) /* driver_select */ +#define ERTS_EV_TYPE_DRV_EV ((EventStateType) 2) /* driver_event */ +#define ERTS_EV_TYPE_STOP_USE ((EventStateType) 3) /* pending stop_select */ + +typedef char EventStateFlags; +#define ERTS_EV_FLAG_USED ((EventStateFlags) 1) /* ERL_DRV_USE has been turned on */ + + +#if defined(ERTS_KERNEL_POLL_VERSION) +# define ERTS_CIO_EXPORT(FUNC) FUNC ## _kp +#elif defined(ERTS_NO_KERNEL_POLL_VERSION) +# define ERTS_CIO_EXPORT(FUNC) FUNC ## _nkp +#else +# define ERTS_CIO_EXPORT(FUNC) FUNC +#endif + +#define ERTS_CIO_HAVE_DRV_EVENT \ + (ERTS_POLL_USE_POLL && !ERTS_POLL_USE_KERNEL_POLL) + +#define ERTS_CIO_POLL_CTL ERTS_POLL_EXPORT(erts_poll_control) +#define ERTS_CIO_POLL_WAIT ERTS_POLL_EXPORT(erts_poll_wait) +#define ERTS_CIO_POLL_INTR ERTS_POLL_EXPORT(erts_poll_interrupt) +#define ERTS_CIO_POLL_INTR_TMD ERTS_POLL_EXPORT(erts_poll_interrupt_timed) +#define ERTS_CIO_NEW_POLLSET ERTS_POLL_EXPORT(erts_poll_create_pollset) +#define ERTS_CIO_FREE_POLLSET ERTS_POLL_EXPORT(erts_poll_destroy_pollset) +#define ERTS_CIO_POLL_MAX_FDS ERTS_POLL_EXPORT(erts_poll_max_fds) +#define ERTS_CIO_POLL_INIT ERTS_POLL_EXPORT(erts_poll_init) +#define ERTS_CIO_POLL_INFO ERTS_POLL_EXPORT(erts_poll_info) + +static struct pollset_info +{ + ErtsPollSet ps; + erts_smp_atomic_t in_poll_wait; /* set while doing poll */ +#ifdef ERTS_SMP + struct removed_fd* removed_list; /* list of deselected fd's*/ + erts_smp_spinlock_t removed_list_lock; +#endif +}pollset; +#define NUM_OF_POLLSETS 1 + +typedef struct { +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + SafeHashBucket hb; +#endif + ErtsSysFdType fd; + union { + ErtsDrvEventDataState *event; /* ERTS_EV_TYPE_DRV_EV */ + ErtsDrvSelectDataState *select; /* ERTS_EV_TYPE_DRV_SEL */ + erts_driver_t* drv_ptr; /* ERTS_EV_TYPE_STOP_USE */ + } driver; + ErtsPollEvents events; + unsigned short remove_cnt; /* number of removed_fd's referring to this fd */ + EventStateType type; + EventStateFlags flags; +} ErtsDrvEventState; + +#ifdef ERTS_SMP +struct removed_fd { + struct removed_fd *next; +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + ErtsSysFdType fd; +#else + ErtsDrvEventState* state; + #ifdef DEBUG + ErtsSysFdType fd; + #endif +#endif + +}; +#endif + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS +static int max_fds = -1; +#endif +#define DRV_EV_STATE_LOCK_CNT 16 +static union { + erts_smp_mtx_t lck; + byte _cache_line_alignment[64]; +}drv_ev_state_locks[DRV_EV_STATE_LOCK_CNT]; + +#ifdef ERTS_SMP +static ERTS_INLINE erts_smp_mtx_t* fd_mtx(ErtsSysFdType fd) +{ + int hash = (int)fd; +# ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + hash ^= (hash >> 9); +# endif + return &drv_ev_state_locks[hash % DRV_EV_STATE_LOCK_CNT].lck; +} +#else +# define fd_mtx(fd) NULL +#endif + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + +static erts_smp_atomic_t drv_ev_state_len; +static ErtsDrvEventState *drv_ev_state; +static erts_smp_mtx_t drv_ev_state_grow_lock; /* prevent lock-hogging of racing growers */ + +#else +static SafeHash drv_ev_state_tab; +static int num_state_prealloc; +static ErtsDrvEventState *state_prealloc_first; +erts_smp_spinlock_t state_prealloc_lock; + +static ERTS_INLINE ErtsDrvEventState *hash_get_drv_ev_state(ErtsSysFdType fd) +{ + ErtsDrvEventState tmpl; + tmpl.fd = fd; + return (ErtsDrvEventState *) safe_hash_get(&drv_ev_state_tab, (void *) &tmpl); +} + +static ERTS_INLINE ErtsDrvEventState* hash_new_drv_ev_state(ErtsSysFdType fd) +{ + ErtsDrvEventState tmpl; + tmpl.fd = fd; + tmpl.driver.select = NULL; + tmpl.events = 0; + tmpl.remove_cnt = 0; + tmpl.type = ERTS_EV_TYPE_NONE; + tmpl.flags = 0; + return (ErtsDrvEventState *) safe_hash_put(&drv_ev_state_tab, (void *) &tmpl); +} + +static ERTS_INLINE void hash_erase_drv_ev_state(ErtsDrvEventState *state) +{ + ASSERT(state->remove_cnt == 0); + safe_hash_erase(&drv_ev_state_tab, (void *) state); +} + +#endif /* !ERTS_SYS_CONTINOUS_FD_NUMBERS */ + +static void stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode); +static void select_steal(ErlDrvPort ix, ErtsDrvEventState *state, + int mode, int on); +static void print_select_op(erts_dsprintf_buf_t *dsbufp, + ErlDrvPort ix, ErtsSysFdType fd, int mode, int on); +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS +static void select_large_fd_error(ErlDrvPort, ErtsSysFdType, int, int); +#endif +#if ERTS_CIO_HAVE_DRV_EVENT +static void event_steal(ErlDrvPort ix, ErtsDrvEventState *state, + ErlDrvEventData event_data); +static void print_event_op(erts_dsprintf_buf_t *dsbufp, + ErlDrvPort, ErtsSysFdType, ErlDrvEventData); +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS +static void event_large_fd_error(ErlDrvPort, ErtsSysFdType, ErlDrvEventData); +#endif +#endif +static void steal_pending_stop_select(erts_dsprintf_buf_t*, ErlDrvPort, + ErtsDrvEventState*, int mode, int on); +static ERTS_INLINE Eterm +drvport2id(ErlDrvPort dp) +{ + Port *pp = erts_drvport2port(dp); + if (pp) + return pp->id; + else { + ASSERT(0); + return am_undefined; + } +} + +#ifdef ERTS_SMP +ERTS_SCHED_PREF_QUICK_ALLOC_IMPL(removed_fd, struct removed_fd, 64, ERTS_ALC_T_FD_LIST) +#endif + +static ERTS_INLINE void +remember_removed(ErtsDrvEventState *state, struct pollset_info* psi) +{ +#ifdef ERTS_SMP + struct removed_fd *fdlp; + ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(fd_mtx(state->fd))); + if (erts_smp_atomic_read(&psi->in_poll_wait)) { + state->remove_cnt++; + ASSERT(state->remove_cnt > 0); + fdlp = removed_fd_alloc(); + #if defined(ERTS_SYS_CONTINOUS_FD_NUMBERS) || defined(DEBUG) + fdlp->fd = state->fd; + #endif + #ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + fdlp->state = state; + #endif + erts_smp_spin_lock(&psi->removed_list_lock); + fdlp->next = psi->removed_list; + psi->removed_list = fdlp; + erts_smp_spin_unlock(&psi->removed_list_lock); + } +#endif +} + + +static ERTS_INLINE int +is_removed(ErtsDrvEventState *state) +{ +#ifdef ERTS_SMP + /* Note that there is a possible race here, where an fd is removed + (increasing remove_cnt) and then added again just before erts_poll_wait + is called by erts_check_io. Any polled event on the re-added fd will then + be falsely ignored. But that does not matter, as the event will trigger + again next time erl_check_io is called. */ + return state->remove_cnt > 0; +#else + return 0; +#endif +} + +static void +forget_removed(struct pollset_info* psi) +{ +#ifdef ERTS_SMP + struct removed_fd* fdlp; + struct removed_fd* tofree; + + /* Fast track: if (atomic_ptr(removed_list)==NULL) return; */ + + erts_smp_spin_lock(&psi->removed_list_lock); + fdlp = psi->removed_list; + psi->removed_list = NULL; + erts_smp_spin_unlock(&psi->removed_list_lock); + + while (fdlp) { + erts_driver_t* drv_ptr = NULL; + erts_smp_mtx_t* mtx; + ErtsSysFdType fd; + ErtsDrvEventState *state; + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + fd = fdlp->fd; + mtx = fd_mtx(fd); + erts_smp_mtx_lock(mtx); + state = &drv_ev_state[(int) fd]; +#else + state = fdlp->state; + fd = state->fd; + ASSERT(fd == fdlp->fd); + mtx = fd_mtx(fd); + erts_smp_mtx_lock(mtx); +#endif + ASSERT(state->remove_cnt > 0); + if (--state->remove_cnt == 0) { + switch (state->type) { + case ERTS_EV_TYPE_STOP_USE: + /* Now we can call stop_select */ + drv_ptr = state->driver.drv_ptr; + ASSERT(drv_ptr); + state->type = ERTS_EV_TYPE_NONE; + state->flags = 0; + state->driver.drv_ptr = NULL; + /* Fall through */ + case ERTS_EV_TYPE_NONE: +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + hash_erase_drv_ev_state(state); +#endif + break; + case ERTS_EV_TYPE_DRV_SEL: + case ERTS_EV_TYPE_DRV_EV: + break; + default: + ASSERT(0); + } + } + erts_smp_mtx_unlock(mtx); + if (drv_ptr) { + int was_unmasked = erts_block_fpe(); + (*drv_ptr->stop_select) (fd, NULL); + erts_unblock_fpe(was_unmasked); + if (drv_ptr->handle) { + erts_ddll_dereference_driver(drv_ptr->handle); + } + } + tofree = fdlp; + fdlp = fdlp->next; + removed_fd_free(tofree); + } +#endif /* ERTS_SMP */ +} + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS +static void +grow_drv_ev_state(int min_ix) +{ + int i; + int new_len = min_ix + 1 + ERTS_DRV_EV_STATE_EXTRA_SIZE; + if (new_len > max_fds) + new_len = max_fds; + + erts_smp_mtx_lock(&drv_ev_state_grow_lock); + if (erts_smp_atomic_read(&drv_ev_state_len) <= min_ix) { + for (i=0; itype) { +#if ERTS_CIO_HAVE_DRV_EVENT + case ERTS_EV_TYPE_DRV_EV: + abort_task(state->driver.event->port, + &state->driver.event->task, + ERTS_EV_TYPE_DRV_EV); + return; +#endif + case ERTS_EV_TYPE_NONE: + return; + default: + ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL); + /* Fall through */ + } + case ERL_DRV_READ|ERL_DRV_WRITE: + case ERL_DRV_WRITE: + ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL); + abort_task(state->driver.select->outport, + &state->driver.select->outtask, + state->type); + if (mode == ERL_DRV_WRITE) + break; + case ERL_DRV_READ: + ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL); + abort_task(state->driver.select->inport, + &state->driver.select->intask, + state->type); + break; + default: + goto check_type; + } +} + +static void +deselect(ErtsDrvEventState *state, int mode) +{ + int do_wake = 0; + ErtsPollEvents rm_events; + ERTS_SMP_LC_ASSERT(erts_smp_lc_mtx_is_locked(fd_mtx(state->fd))); + ASSERT(state->events); + + abort_tasks(state, mode); + + if (!mode) + rm_events = state->events; + else { + rm_events = 0; + ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL); + if (mode & ERL_DRV_READ) { + state->driver.select->inport = NIL; + rm_events |= ERTS_POLL_EV_IN; + } + if (mode & ERL_DRV_WRITE) { + state->driver.select->outport = NIL; + rm_events |= ERTS_POLL_EV_OUT; + } + } + + state->events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, rm_events, 0, &do_wake); + + if (!(state->events)) { + switch (state->type) { + case ERTS_EV_TYPE_DRV_SEL: + ASSERT(!erts_port_task_is_scheduled(&state->driver.select->intask)); + ASSERT(!erts_port_task_is_scheduled(&state->driver.select->outtask)); + erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, + state->driver.select); + break; +#if ERTS_CIO_HAVE_DRV_EVENT + case ERTS_EV_TYPE_DRV_EV: + ASSERT(!erts_port_task_is_scheduled(&state->driver.event->task)); + erts_free(ERTS_ALC_T_DRV_EV_D_STATE, + state->driver.event); + break; +#endif + case ERTS_EV_TYPE_NONE: + break; + default: + ASSERT(0); + break; + } + + state->driver.select = NULL; + state->type = ERTS_EV_TYPE_NONE; + state->flags = 0; + remember_removed(state, &pollset); + } +} + + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS +# define IS_FD_UNKNOWN(state) ((state)->type == ERTS_EV_TYPE_NONE && (state)->remove_cnt == 0) +#else +# define IS_FD_UNKNOWN(state) ((state) == NULL) +#endif + + +int +ERTS_CIO_EXPORT(driver_select)(ErlDrvPort ix, + ErlDrvEvent e, + int mode, + int on) +{ + void (*stop_select_fn)(ErlDrvEvent, void*) = NULL; + Eterm id = drvport2id(ix); + ErtsSysFdType fd = (ErtsSysFdType) e; + ErtsPollEvents ctl_events = (ErtsPollEvents) 0; + ErtsPollEvents new_events, old_events; + ErtsDrvEventState *state; + int wake_poller; + int ret; + + ERTS_SMP_LC_ASSERT(erts_drvport2port(ix) + && erts_lc_is_port_locked(erts_drvport2port(ix))); + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + if ((unsigned)fd >= (unsigned)erts_smp_atomic_read(&drv_ev_state_len)) { + if (fd < 0) { + return -1; + } + if (fd >= max_fds) { + select_large_fd_error(ix, fd, mode, on); + return -1; + } + grow_drv_ev_state(fd); + } +#endif + + erts_smp_mtx_lock(fd_mtx(fd)); + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + state = &drv_ev_state[(int) fd]; +#else + state = hash_get_drv_ev_state(fd); /* may be NULL! */ +#endif + + if (!on && (mode&ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { + if (IS_FD_UNKNOWN(state)) { + /* fast track to stop_select callback */ + stop_select_fn = erts_drvport2port(ix)->drv_ptr->stop_select; + ret = 0; + goto done_unknown; + } + mode |= (ERL_DRV_READ | ERL_DRV_WRITE); + wake_poller = 1; /* to eject fd from pollset (if needed) */ + } + else wake_poller = 0; + +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (state == NULL) { + state = hash_new_drv_ev_state(fd); + } +#endif + +#if ERTS_CIO_HAVE_DRV_EVENT + if (state->type == ERTS_EV_TYPE_DRV_EV) + select_steal(ix, state, mode, on); +#endif + if (state->type == ERTS_EV_TYPE_STOP_USE) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + print_select_op(dsbufp, ix, state->fd, mode, on); + steal_pending_stop_select(dsbufp, ix, state, mode, on); + if (state->type == ERTS_EV_TYPE_STOP_USE) { + ret = 0; + goto done; /* stop_select still pending */ + } + ASSERT(state->type == ERTS_EV_TYPE_NONE); + } + + if (mode & ERL_DRV_READ) { + if (state->type == ERTS_EV_TYPE_DRV_SEL) { + Eterm owner = state->driver.select->inport; + if (owner != id && is_not_nil(owner)) + select_steal(ix, state, mode, on); + } + ctl_events |= ERTS_POLL_EV_IN; + } + if (mode & ERL_DRV_WRITE) { + if (state->type == ERTS_EV_TYPE_DRV_SEL) { + Eterm owner = state->driver.select->outport; + if (owner != id && is_not_nil(owner)) + select_steal(ix, state, mode, on); + } + ctl_events |= ERTS_POLL_EV_OUT; + } + + ASSERT((state->type == ERTS_EV_TYPE_DRV_SEL) || + (state->type == ERTS_EV_TYPE_NONE && !state->events)); + + if (!on && !(state->flags & ERTS_EV_FLAG_USED) + && state->events && !(state->events & ~ctl_events)) { + /* Old driver removing all events. At least wake poller. + It will not make close() 100% safe but it will prevent + actions delayed by poll timeout. */ + wake_poller = 1; + } + + new_events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, ctl_events, on, &wake_poller); + + if (new_events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) { + if (state->type == ERTS_EV_TYPE_DRV_SEL && !state->events) { + state->type = ERTS_EV_TYPE_NONE; + state->flags = 0; + erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, state->driver.select); + state->driver.select = NULL; + } + ret = -1; + goto done; + } + + old_events = state->events; + + ASSERT(on + ? (new_events == (state->events | ctl_events)) + : (new_events == (state->events & ~ctl_events))); + + ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL + || state->type == ERTS_EV_TYPE_NONE); + + state->events = new_events; + if (ctl_events) { + if (on) { + if (state->type == ERTS_EV_TYPE_NONE) { + ErtsDrvSelectDataState *dsdsp + = erts_alloc(ERTS_ALC_T_DRV_SEL_D_STATE, + sizeof(ErtsDrvSelectDataState)); + dsdsp->inport = NIL; + dsdsp->outport = NIL; + erts_port_task_handle_init(&dsdsp->intask); + erts_port_task_handle_init(&dsdsp->outtask); + ASSERT(state->driver.select == NULL); + state->driver.select = dsdsp; + state->type = ERTS_EV_TYPE_DRV_SEL; + } + ASSERT(state->type == ERTS_EV_TYPE_DRV_SEL); + if (ctl_events & ERTS_POLL_EV_IN) + state->driver.select->inport = id; + if (ctl_events & ERTS_POLL_EV_OUT) + state->driver.select->outport = id; + if (mode & ERL_DRV_USE) { + state->flags |= ERTS_EV_FLAG_USED; + } + } + else { /* off */ + if (state->type == ERTS_EV_TYPE_DRV_SEL) { + if (ctl_events & ERTS_POLL_EV_IN) { + abort_tasks(state, ERL_DRV_READ); + state->driver.select->inport = NIL; + } + if (ctl_events & ERTS_POLL_EV_OUT) { + abort_tasks(state, ERL_DRV_WRITE); + state->driver.select->outport = NIL; + } + if (new_events == 0) { + ASSERT(!erts_port_task_is_scheduled(&state->driver.select->intask)); + ASSERT(!erts_port_task_is_scheduled(&state->driver.select->outtask)); + if (old_events != 0) { + remember_removed(state, &pollset); + } + if ((mode & ERL_DRV_USE) || !(state->flags & ERTS_EV_FLAG_USED)) { + state->type = ERTS_EV_TYPE_NONE; + state->flags = 0; + erts_free(ERTS_ALC_T_DRV_SEL_D_STATE, + state->driver.select); + state->driver.select = NULL; + } + /*else keep it, as fd will probably be selected upon again */ + } + } + if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { + erts_driver_t* drv_ptr = erts_drvport2port(ix)->drv_ptr; + ASSERT(new_events==0); + if (state->remove_cnt == 0 || !wake_poller) { + /* Safe to close fd now as it is not in pollset + or there was no need to eject fd (kernel poll) */ + stop_select_fn = drv_ptr->stop_select; + } + else { + /* Not safe to close fd, postpone stop_select callback. */ + state->type = ERTS_EV_TYPE_STOP_USE; + state->driver.drv_ptr = drv_ptr; + if (drv_ptr->handle) { + erts_ddll_reference_referenced_driver(drv_ptr->handle); + } + } + } + } + } + + ret = 0; + +done:; +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (state->type == ERTS_EV_TYPE_NONE && state->remove_cnt == 0) { + hash_erase_drv_ev_state(state); + } +#endif +done_unknown: + erts_smp_mtx_unlock(fd_mtx(fd)); + if (stop_select_fn) { + int was_unmasked = erts_block_fpe(); + (*stop_select_fn)(e, NULL); + erts_unblock_fpe(was_unmasked); + } + return ret; +} + +int +ERTS_CIO_EXPORT(driver_event)(ErlDrvPort ix, + ErlDrvEvent e, + ErlDrvEventData event_data) +{ +#if !ERTS_CIO_HAVE_DRV_EVENT + return -1; +#else + ErtsSysFdType fd = (ErtsSysFdType) e; + ErtsPollEvents events; + ErtsPollEvents add_events; + ErtsPollEvents remove_events; + Eterm id = drvport2id(ix); + ErtsDrvEventState *state; + int do_wake = 0; + int ret; + + ERTS_SMP_LC_ASSERT(erts_drvport2port(ix) + && erts_lc_is_port_locked(erts_drvport2port(ix))); + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + if ((unsigned)fd >= (unsigned)erts_smp_atomic_read(&drv_ev_state_len)) { + if (fd < 0) + return -1; + if (fd >= max_fds) { + event_large_fd_error(ix, fd, event_data); + return -1; + } + grow_drv_ev_state(fd); + } +#endif + + erts_smp_mtx_lock(fd_mtx(fd)); + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + state = &drv_ev_state[(int) fd]; +#else + /* Could use hash_new directly, but want to keep the normal case fast */ + state = hash_get_drv_ev_state(fd); + if (state == NULL) { + state = hash_new_drv_ev_state(fd); + } +#endif + + switch (state->type) { + case ERTS_EV_TYPE_DRV_EV: + if (state->driver.event->port == id) break; + /*fall through*/ + case ERTS_EV_TYPE_DRV_SEL: + event_steal(ix, state, event_data); + break; + case ERTS_EV_TYPE_STOP_USE: { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + print_event_op(dsbufp, ix, fd, event_data); + steal_pending_stop_select(dsbufp, ix, state, 0, 1); + break; + } + } + + ASSERT(state->type == ERTS_EV_TYPE_DRV_EV + || state->type == ERTS_EV_TYPE_NONE); + + events = state->events; + + if (!event_data) { + remove_events = events; + add_events = 0; + } + else { + remove_events = ~event_data->events & events; + add_events = ~events & event_data->events; + } + + if (add_events) { + events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, add_events, 1, &do_wake); + if (events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) { + ret = -1; + goto done; + } + } + if (remove_events) { + events = ERTS_CIO_POLL_CTL(pollset.ps, state->fd, remove_events, 0, &do_wake); + if (events & (ERTS_POLL_EV_ERR|ERTS_POLL_EV_NVAL)) { + ret = -1; + goto done; + } + } + if (event_data && event_data->events != 0) { + if (state->type == ERTS_EV_TYPE_DRV_EV) { + state->driver.event->removed_events &= ~add_events; + state->driver.event->removed_events |= remove_events; + } + else { + state->driver.event + = erts_alloc(ERTS_ALC_T_DRV_EV_D_STATE, + sizeof(ErtsDrvEventDataState)); + erts_port_task_handle_init(&state->driver.event->task); + state->driver.event->port = id; + state->driver.event->removed_events = (ErtsPollEvents) 0; + state->type = ERTS_EV_TYPE_DRV_EV; + } + state->driver.event->data = event_data; + } + else { + if (state->type == ERTS_EV_TYPE_DRV_EV) { + abort_tasks(state, 0); + erts_free(ERTS_ALC_T_DRV_EV_D_STATE, + state->driver.event); + } + state->driver.select = NULL; + state->type = ERTS_EV_TYPE_NONE; + remember_removed(state, &pollset); + } + state->events = events; + ASSERT(event_data ? events == event_data->events : events == 0); + + ret = 0; + +done: +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (state->type == ERTS_EV_TYPE_NONE && state->remove_cnt == 0) { + hash_erase_drv_ev_state(state); + } +#endif + erts_smp_mtx_unlock(fd_mtx(fd)); + return ret; +#endif +} + +static ERTS_INLINE int +chk_stale(Eterm id, ErtsDrvEventState *state, int mode) +{ + if (is_nil(id)) + return 0; + if (erts_is_port_alive(id)) + return 1; /* Steal */ + stale_drv_select(id, state, mode); + return 0; +} + +static int +need2steal(ErtsDrvEventState *state, int mode) +{ + int do_steal = 0; + switch (state->type) { + case ERTS_EV_TYPE_DRV_SEL: + if (mode & ERL_DRV_READ) + do_steal |= chk_stale(state->driver.select->inport, + state, + ERL_DRV_READ); + if (mode & ERL_DRV_WRITE) + do_steal |= chk_stale(state->driver.select->outport, + state, + ERL_DRV_WRITE); + break; +#if ERTS_CIO_HAVE_DRV_EVENT + case ERTS_EV_TYPE_DRV_EV: + do_steal |= chk_stale(state->driver.event->port, state, 0); + break; +#endif + case ERTS_EV_TYPE_STOP_USE: + ASSERT(0); + break; + default: + break; + } + return do_steal; +} + +static void +print_driver_name(erts_dsprintf_buf_t *dsbufp, Eterm id) +{ + ErtsPortNames *pnp = erts_get_port_names(id); + if (!pnp->name && !pnp->driver_name) + erts_dsprintf(dsbufp, "%s ", ""); + else { + if (pnp->name) { + if (!pnp->driver_name || strcmp(pnp->driver_name, pnp->name) == 0) + erts_dsprintf(dsbufp, "%s ", pnp->name); + else + erts_dsprintf(dsbufp, "%s (%s) ", pnp->driver_name, pnp->name); + } + else if (pnp->driver_name) { + erts_dsprintf(dsbufp, "%s ", pnp->driver_name); + } + } + erts_free_port_names(pnp); +} + +static void +steal(erts_dsprintf_buf_t *dsbufp, ErtsDrvEventState *state, int mode) +{ + erts_dsprintf(dsbufp, "stealing control of fd=%d from ", (int) state->fd); + switch (state->type) { + case ERTS_EV_TYPE_DRV_SEL: { + int deselect_mode = 0; + Eterm iid = state->driver.select->inport; + Eterm oid = state->driver.select->outport; + if ((mode & ERL_DRV_READ) && (is_not_nil(iid))) { + erts_dsprintf(dsbufp, "input driver "); + print_driver_name(dsbufp, iid); + erts_dsprintf(dsbufp, "%T ", iid); + deselect_mode |= ERL_DRV_READ; + } + if ((mode & ERL_DRV_WRITE) && is_not_nil(oid)) { + if (deselect_mode) { + erts_dsprintf(dsbufp, "and "); + } + erts_dsprintf(dsbufp, "output driver "); + print_driver_name(dsbufp, oid); + erts_dsprintf(dsbufp, "%T ", oid); + deselect_mode |= ERL_DRV_WRITE; + } + if (deselect_mode) + deselect(state, deselect_mode); + else { + erts_dsprintf(dsbufp, "no one", (int) state->fd); + ASSERT(0); + } + erts_dsprintf(dsbufp, "\n"); + break; + } +#if ERTS_CIO_HAVE_DRV_EVENT + case ERTS_EV_TYPE_DRV_EV: { + Eterm eid = state->driver.event->port; + if (is_nil(eid)) { + erts_dsprintf(dsbufp, "no one", (int) state->fd); + ASSERT(0); + } + else { + erts_dsprintf(dsbufp, "event driver "); + print_driver_name(dsbufp, eid); + erts_dsprintf(dsbufp, "%T ", eid); + } + erts_dsprintf(dsbufp, "\n"); + deselect(state, 0); + break; + } +#endif + case ERTS_EV_TYPE_STOP_USE: { + ASSERT(0); + break; + } + default: + erts_dsprintf(dsbufp, "no one\n", (int) state->fd); + ASSERT(0); + } +} + +static void +print_select_op(erts_dsprintf_buf_t *dsbufp, + ErlDrvPort ix, ErtsSysFdType fd, int mode, int on) +{ + Port *pp = erts_drvport2port(ix); + erts_dsprintf(dsbufp, + "driver_select(%p, %d,%s%s%s%s, %d) " + "by ", + ix, + (int) fd, + mode & ERL_DRV_READ ? " ERL_DRV_READ" : "", + mode & ERL_DRV_WRITE ? " ERL_DRV_WRITE" : "", + mode & ERL_DRV_USE ? " ERL_DRV_USE" : "", + mode & (ERL_DRV_USE_NO_CALLBACK & ~ERL_DRV_USE) ? "_NO_CALLBACK" : "", + on); + print_driver_name(dsbufp, pp->id); + erts_dsprintf(dsbufp, "driver %T ", pp ? pp->id : NIL); +} + +static void +select_steal(ErlDrvPort ix, ErtsDrvEventState *state, int mode, int on) +{ + if (need2steal(state, mode)) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + print_select_op(dsbufp, ix, state->fd, mode, on); + steal(dsbufp, state, mode); + erts_send_error_to_logger_nogl(dsbufp); + } +} + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS +static void +large_fd_error_common(erts_dsprintf_buf_t *dsbufp, ErtsSysFdType fd) +{ + erts_dsprintf(dsbufp, + "fd=%d is larger than the largest allowed fd=%d\n", + (int) fd, max_fds - 1); +} + +static void +select_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, int mode, int on) +{ + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + print_select_op(dsbufp, ix, fd, mode, on); + erts_dsprintf(dsbufp, "failed: "); + large_fd_error_common(dsbufp, fd); + erts_send_error_to_logger_nogl(dsbufp); +} +#endif /* ERTS_SYS_CONTINOUS_FD_NUMBERS */ + + + +static void +steal_pending_stop_select(erts_dsprintf_buf_t *dsbufp, ErlDrvPort ix, + ErtsDrvEventState *state, int mode, int on) +{ + ASSERT(state->type == ERTS_EV_TYPE_STOP_USE); + erts_dsprintf(dsbufp, "failed: fd=%d (re)selected before stop_select " + "was called for driver %s\n", + (int) state->fd, state->driver.drv_ptr->name); + erts_send_error_to_logger_nogl(dsbufp); + + if (on) { + /* Either fd-owner changed its mind about closing + * or closed fd before stop_select callback and fd is now reused. + * In either case stop_select should not be called. + */ + state->type = ERTS_EV_TYPE_NONE; + state->flags = 0; + if (state->driver.drv_ptr->handle) { + erts_ddll_dereference_driver(state->driver.drv_ptr->handle); + } + state->driver.drv_ptr = NULL; + } + else if ((mode & ERL_DRV_USE_NO_CALLBACK) == ERL_DRV_USE) { + erts_driver_t* drv_ptr = erts_drvport2port(ix)->drv_ptr; + if (drv_ptr != state->driver.drv_ptr) { + /* Some other driver wants the stop_select callback */ + if (state->driver.drv_ptr->handle) { + erts_ddll_dereference_driver(state->driver.drv_ptr->handle); + } + if (drv_ptr->handle) { + erts_ddll_reference_referenced_driver(drv_ptr->handle); + } + state->driver.drv_ptr = drv_ptr; + } + } + +} + + +#if ERTS_CIO_HAVE_DRV_EVENT + +static void +print_event_op(erts_dsprintf_buf_t *dsbufp, + ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data) +{ + Port *pp = erts_drvport2port(ix); + erts_dsprintf(dsbufp, "driver_event(%p, %d, ", ix, (int) fd); + if (!event_data) + erts_dsprintf(dsbufp, "NULL"); + else + erts_dsprintf(dsbufp, "{0x%x, 0x%x}", + (unsigned int) event_data->events, + (unsigned int) event_data->revents); + erts_dsprintf(dsbufp, ") by "); + print_driver_name(dsbufp, pp->id); + erts_dsprintf(dsbufp, "driver %T ", pp ? pp->id : NIL); +} + +static void +event_steal(ErlDrvPort ix, ErtsDrvEventState *state, ErlDrvEventData event_data) +{ + if (need2steal(state, ERL_DRV_READ|ERL_DRV_WRITE)) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + print_event_op(dsbufp, ix, state->fd, event_data); + steal(dsbufp, state, ERL_DRV_READ|ERL_DRV_WRITE); + erts_send_error_to_logger_nogl(dsbufp); + } + else if (state->type == ERTS_EV_TYPE_DRV_SEL) { + ASSERT(state->flags & ERTS_EV_FLAG_USED); + deselect(state, 0); + } +} + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS +static void +event_large_fd_error(ErlDrvPort ix, ErtsSysFdType fd, ErlDrvEventData event_data) +{ + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + print_event_op(dsbufp, ix, fd, event_data); + erts_dsprintf(dsbufp, "failed: "); + large_fd_error_common(dsbufp, fd); + erts_send_error_to_logger_nogl(dsbufp); +} +#endif +#endif + +static ERTS_INLINE void +iready(Eterm id, ErtsDrvEventState *state) +{ + if (erts_port_task_schedule(id, + &state->driver.select->intask, + ERTS_PORT_TASK_INPUT, + (ErlDrvEvent) state->fd, + NULL) != 0) { + stale_drv_select(id, state, ERL_DRV_READ); + } +} + +static ERTS_INLINE void +oready(Eterm id, ErtsDrvEventState *state) +{ + if (erts_port_task_schedule(id, + &state->driver.select->outtask, + ERTS_PORT_TASK_OUTPUT, + (ErlDrvEvent) state->fd, + NULL) != 0) { + stale_drv_select(id, state, ERL_DRV_WRITE); + } +} + +#if ERTS_CIO_HAVE_DRV_EVENT +static ERTS_INLINE void +eready(Eterm id, ErtsDrvEventState *state, ErlDrvEventData event_data) +{ + if (erts_port_task_schedule(id, + &state->driver.event->task, + ERTS_PORT_TASK_EVENT, + (ErlDrvEvent) state->fd, + event_data) != 0) { + stale_drv_select(id, state, 0); + } +} +#endif + +static void bad_fd_in_pollset( ErtsDrvEventState *, Eterm, Eterm, ErtsPollEvents); + +void +ERTS_CIO_EXPORT(erts_check_io_interrupt)(int set) +{ + ERTS_CIO_POLL_INTR(pollset.ps, set); +} + +void +ERTS_CIO_EXPORT(erts_check_io_interrupt_timed)(int set, long msec) +{ + ERTS_CIO_POLL_INTR_TMD(pollset.ps, set, msec); +} + +void +ERTS_CIO_EXPORT(erts_check_io)(int do_wait) +{ + ErtsPollResFd pollres[256]; + int pollres_len; + SysTimeval wait_time; + int poll_ret, i; + + restart: + + /* Figure out timeout value */ + if (do_wait) { + erts_time_remaining(&wait_time); + } else { /* poll only */ + wait_time.tv_sec = 0; + wait_time.tv_usec = 0; + } + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); /* No locks should be locked */ +#endif + erts_smp_activity_begin(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); + pollres_len = sizeof(pollres)/sizeof(ErtsPollResFd); + + erts_smp_atomic_set(&pollset.in_poll_wait, 1); + + poll_ret = ERTS_CIO_POLL_WAIT(pollset.ps, pollres, &pollres_len, &wait_time); + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); /* No locks should be locked */ +#endif + erts_smp_activity_end(ERTS_ACTIVITY_WAIT, NULL, NULL, NULL); + + erts_deliver_time(); /* sync the machine's idea of time */ + +#ifdef ERTS_BREAK_REQUESTED + if (ERTS_BREAK_REQUESTED) + erts_do_break_handling(); +#endif + + if (poll_ret != 0) { + erts_smp_atomic_set(&pollset.in_poll_wait, 0); + forget_removed(&pollset); + if (poll_ret == EAGAIN) { + goto restart; + } + + if (poll_ret != ETIMEDOUT + && poll_ret != EINTR +#ifdef ERRNO_BLOCK + && poll_ret != ERRNO_BLOCK +#endif + ) { + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, "erts_poll_wait() failed: %s (%d)\n", + erl_errno_id(poll_ret), poll_ret); + erts_send_error_to_logger_nogl(dsbufp); + } + return; + } + + for (i = 0; i < pollres_len; i++) { + + ErtsSysFdType fd = (ErtsSysFdType) pollres[i].fd; + ErtsDrvEventState *state; + + erts_smp_mtx_lock(fd_mtx(fd)); + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + state = &drv_ev_state[ (int) fd]; +#else + state = hash_get_drv_ev_state(fd); + if (!state) { + goto next_pollres; + } +#endif + + /* Skip this fd if it was removed from pollset */ + if (is_removed(state)) { + goto next_pollres; + } + + switch (state->type) { + case ERTS_EV_TYPE_DRV_SEL: { /* Requested via driver_select()... */ + ErtsPollEvents revents; + ErtsPollEvents revent_mask; + + revent_mask = ~(ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT); + revent_mask |= state->events; + revents = pollres[i].events & revent_mask; + + if (revents & ERTS_POLL_EV_ERR) { + /* + * Let the driver handle the error condition. Only input, + * only output, or nothing might have been selected. + * We *do not* want to call a callback that corresponds + * to an event not selected. revents might give us a clue + * on which one to call. + */ + if ((revents & ERTS_POLL_EV_IN) + || (!(revents & ERTS_POLL_EV_OUT) + && state->events & ERTS_POLL_EV_IN)) { + iready(state->driver.select->inport, state); + } + else if (state->events & ERTS_POLL_EV_OUT) { + oready(state->driver.select->outport, state); + } + } + else if (revents & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) { + if (revents & ERTS_POLL_EV_OUT) { + oready(state->driver.select->outport, state); + } + /* Someone might have deselected input since revents + was read (true also on the non-smp emulator since + oready() may have been called); therefore, update + revents... */ + revents &= ~(~state->events & ERTS_POLL_EV_IN); + if (revents & ERTS_POLL_EV_IN) { + iready(state->driver.select->inport, state); + } + } + else if (revents & ERTS_POLL_EV_NVAL) { + bad_fd_in_pollset(state, + state->driver.select->inport, + state->driver.select->outport, + state->events); + } + break; + } + +#if ERTS_CIO_HAVE_DRV_EVENT + case ERTS_EV_TYPE_DRV_EV: { /* Requested via driver_event()... */ + ErlDrvEventData event_data; + ErtsPollEvents revents; + ASSERT(state->driver.event); + ASSERT(state->driver.event->data); + event_data = state->driver.event->data; + revents = pollres[i].events; + revents &= ~state->driver.event->removed_events; + + if (revents) { + event_data->events = state->events; + event_data->revents = revents; + + eready(state->driver.event->port, state, event_data); + } + break; + } +#endif + + case ERTS_EV_TYPE_NONE: /* Deselected ... */ + break; + + default: { /* Error */ + erts_dsprintf_buf_t *dsbufp; + dsbufp = erts_create_logger_dsbuf(); + erts_dsprintf(dsbufp, + "Invalid event request type for fd in erts_poll()! " + "fd=%d, event request type=%sd\n", (int) state->fd, + (int) state->type); + ASSERT(0); + deselect(state, 0); + break; + } + } + + next_pollres:; +#ifdef ERTS_SMP + erts_smp_mtx_unlock(fd_mtx(fd)); +#endif + } + + erts_smp_atomic_set(&pollset.in_poll_wait, 0); + forget_removed(&pollset); +} + +static void +bad_fd_in_pollset(ErtsDrvEventState *state, Eterm inport, + Eterm outport, ErtsPollEvents events) +{ + erts_dsprintf_buf_t *dsbufp = erts_create_logger_dsbuf(); + + if (events & (ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) { + char *io_str; + Eterm port = NIL; + if ((events & ERTS_POLL_EV_IN) && (events & ERTS_POLL_EV_OUT)) { + io_str = "input/output"; + if (inport == outport) + port = inport; + } + else { + if (events & ERTS_POLL_EV_IN) { + io_str = "input"; + port = inport; + } + else { + io_str = "output"; + port = outport; + } + } + erts_dsprintf(dsbufp, + "Bad %s fd in erts_poll()! fd=%d, ", + io_str, (int) state->fd); + if (is_nil(port)) { + ErtsPortNames *ipnp = erts_get_port_names(inport); + ErtsPortNames *opnp = erts_get_port_names(outport); + erts_dsprintf(dsbufp, "ports=%T/%T, drivers=%s/%s, names=%s/%s\n", + is_nil(inport) ? am_undefined : inport, + is_nil(outport) ? am_undefined : outport, + ipnp->driver_name ? ipnp->driver_name : "", + opnp->driver_name ? opnp->driver_name : "", + ipnp->name ? ipnp->name : "", + opnp->name ? opnp->name : ""); + erts_free_port_names(ipnp); + erts_free_port_names(opnp); + } + else { + ErtsPortNames *pnp = erts_get_port_names(port); + erts_dsprintf(dsbufp, "port=%T, driver=%s, name=%s\n", + is_nil(port) ? am_undefined : port, + pnp->driver_name ? pnp->driver_name : "", + pnp->name ? pnp->name : ""); + erts_free_port_names(pnp); + } + } + else { + erts_dsprintf(dsbufp, "Bad fd in erts_poll()! fd=%d\n", (int) state->fd); + } + erts_send_error_to_logger_nogl(dsbufp); + + /* unmap entry */ + deselect(state, 0); +} + +static void +stale_drv_select(Eterm id, ErtsDrvEventState *state, int mode) +{ + erts_stale_drv_select(id, (ErlDrvEvent) state->fd, mode, 0); + deselect(state, mode); +} + +#ifndef ERTS_SYS_CONTINOUS_FD_NUMBERS +static SafeHashValue drv_ev_state_hash(void *des) +{ + SafeHashValue val = (SafeHashValue) ((ErtsDrvEventState *) des)->fd; + return val ^ (val >> 8); /* Good enough for aligned pointer values? */ +} + +static int drv_ev_state_cmp(void *des1, void *des2) +{ + return ( ((ErtsDrvEventState *) des1)->fd == ((ErtsDrvEventState *) des2)->fd + ? 0 : 1); +} + +static void *drv_ev_state_alloc(void *des_tmpl) +{ + ErtsDrvEventState *evstate; + erts_smp_spin_lock(&state_prealloc_lock); + if (state_prealloc_first == NULL) { + erts_smp_spin_unlock(&state_prealloc_lock); + evstate = (ErtsDrvEventState *) + erts_alloc(ERTS_ALC_T_DRV_EV_STATE, sizeof(ErtsDrvEventState)); + } else { + evstate = state_prealloc_first; + state_prealloc_first = (ErtsDrvEventState *) evstate->hb.next; + --num_state_prealloc; + erts_smp_spin_unlock(&state_prealloc_lock); + } + /* XXX: Already valid data if prealloced, could ignore template! */ + *evstate = *((ErtsDrvEventState *) des_tmpl); + + return (void *) evstate; +} + +static void drv_ev_state_free(void *des) +{ + erts_smp_spin_lock(&state_prealloc_lock); + ((ErtsDrvEventState *) des)->hb.next = &state_prealloc_first->hb; + state_prealloc_first = (ErtsDrvEventState *) des; + ++num_state_prealloc; + erts_smp_spin_unlock(&state_prealloc_lock); +} +#endif + +void +ERTS_CIO_EXPORT(erts_init_check_io)(void) +{ + erts_smp_atomic_init(&pollset.in_poll_wait, 0); + ERTS_CIO_POLL_INIT(); + pollset.ps = ERTS_CIO_NEW_POLLSET(); + +#ifdef ERTS_SMP + init_removed_fd_alloc(); + pollset.removed_list = NULL; + erts_smp_spinlock_init(&pollset.removed_list_lock, + "pollset_rm_list"); + { + int i; + for (i=0; ievents; + ErtsSysFdType fd = state->fd; +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + int internal = 0; + ErtsPollEvents ep_events = counters->epep[(int) fd]; +#endif + int err = 0; + +#if defined(HAVE_FSTAT) && !defined(NO_FSTAT_ON_SYS_FD_TYPE) + struct stat stat_buf; +#endif + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (state->events || ep_events) { + if (ep_events & ERTS_POLL_EV_NVAL) { + ep_events &= ~ERTS_POLL_EV_NVAL; + internal = 1; + counters->internal_fds++; + } + else + counters->used_fds++; +#else + if (state->events) { + counters->used_fds++; +#endif + + erts_printf("fd=%d ", (int) fd); + +#if defined(HAVE_FSTAT) && !defined(NO_FSTAT_ON_SYS_FD_TYPE) + if (fstat((int) fd, &stat_buf) < 0) + erts_printf("type=unknown "); + else { + erts_printf("type="); +#ifdef S_ISSOCK + if (S_ISSOCK(stat_buf.st_mode)) + erts_printf("sock "); + else +#endif +#ifdef S_ISFIFO + if (S_ISFIFO(stat_buf.st_mode)) + erts_printf("fifo "); + else +#endif +#ifdef S_ISCHR + if (S_ISCHR(stat_buf.st_mode)) + erts_printf("chr "); + else +#endif +#ifdef S_ISDIR + if (S_ISDIR(stat_buf.st_mode)) + erts_printf("dir "); + else +#endif +#ifdef S_ISBLK + if (S_ISBLK(stat_buf.st_mode)) + erts_printf("blk "); + else +#endif +#ifdef S_ISREG + if (S_ISREG(stat_buf.st_mode)) + erts_printf("reg "); + else +#endif +#ifdef S_ISLNK + if (S_ISLNK(stat_buf.st_mode)) + erts_printf("lnk "); + else +#endif +#ifdef S_ISDOOR + if (S_ISDOOR(stat_buf.st_mode)) + erts_printf("door "); + else +#endif +#ifdef S_ISWHT + if (S_ISWHT(stat_buf.st_mode)) + erts_printf("wht "); + else +#endif +#ifdef S_ISXATTR + if (S_ISXATTR(stat_buf.st_mode)) + erts_printf("xattr "); + else +#endif + erts_printf("unknown "); + } +#else + erts_printf("type=unknown "); +#endif + + if (state->type == ERTS_EV_TYPE_DRV_SEL) { + erts_printf("driver_select "); + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (internal) { + erts_printf("internal "); + err = 1; + } + + if (cio_events == ep_events) { + erts_printf("ev="); + if (print_events(cio_events) != 0) + err = 1; + } + else { + err = 1; + erts_printf("cio_ev="); + print_events(cio_events); + erts_printf(" ep_ev="); + print_events(ep_events); + } +#else + if (print_events(cio_events) != 0) + err = 1; +#endif + erts_printf(" "); + if (cio_events & ERTS_POLL_EV_IN) { + Eterm id = state->driver.select->inport; + if (is_nil(id)) { + erts_printf("inport=none inname=none indrv=none "); + err = 1; + } + else { + ErtsPortNames *pnp = erts_get_port_names(id); + erts_printf(" inport=%T inname=%s indrv=%s ", + id, + pnp->name ? pnp->name : "unknown", + (pnp->driver_name + ? pnp->driver_name + : "unknown")); + erts_free_port_names(pnp); + } + } + if (cio_events & ERTS_POLL_EV_OUT) { + Eterm id = state->driver.select->outport; + if (is_nil(id)) { + erts_printf("outport=none outname=none outdrv=none "); + err = 1; + } + else { + ErtsPortNames *pnp = erts_get_port_names(id); + erts_printf(" outport=%T outname=%s outdrv=%s ", + id, + pnp->name ? pnp->name : "unknown", + (pnp->driver_name + ? pnp->driver_name + : "unknown")); + erts_free_port_names(pnp); + } + } + } + else if (state->type == ERTS_EV_TYPE_DRV_EV) { + Eterm id; + erts_printf("driver_event "); +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (internal) { + erts_printf("internal "); + err = 1; + } + if (cio_events == ep_events) { + erts_printf("ev=0x%b32x", (Uint32) cio_events); + } + else { + err = 1; + erts_printf("cio_ev=0x%b32x", (Uint32) cio_events); + erts_printf(" ep_ev=0x%b32x", (Uint32) ep_events); + } +#else + erts_printf("ev=0x%b32x", (Uint32) cio_events); +#endif + id = state->driver.event->port; + if (is_nil(id)) { + erts_printf(" port=none name=none drv=none "); + err = 1; + } + else { + ErtsPortNames *pnp = erts_get_port_names(id); + erts_printf(" port=%T name=%s drv=%s ", + id, + pnp->name ? pnp->name : "unknown", + (pnp->driver_name + ? pnp->driver_name + : "unknown")); + erts_free_port_names(pnp); + } + } +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + else if (internal) { + erts_printf("internal "); + if (cio_events) { + err = 1; + erts_printf("cio_ev="); + print_events(cio_events); + } + if (ep_events) { + erts_printf("ep_ev="); + print_events(ep_events); + } + } +#endif + else { + err = 1; + erts_printf("control_type=%d ", (int)state->type); +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + if (cio_events == ep_events) { + erts_printf("ev=0x%b32x", (Uint32) cio_events); + } + else { + erts_printf("cio_ev=0x%b32x", (Uint32) cio_events); + erts_printf(" ep_ev=0x%b32x", (Uint32) ep_events); + } +#else + erts_printf("ev=0x%b32x", (Uint32) cio_events); +#endif + } + + if (err) { + counters->num_errors++; + erts_printf(" ERROR"); + } + erts_printf("\n"); + } +} + +int +ERTS_CIO_EXPORT(erts_check_io_debug)(void) +{ +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + int fd, len; +#endif + IterDebugCounters counters; + ErtsDrvEventState null_des; + + null_des.driver.select = NULL; + null_des.events = 0; + null_des.remove_cnt = 0; + null_des.type = ERTS_EV_TYPE_NONE; + + erts_printf("--- fds in pollset --------------------------------------\n"); + +#ifdef ERTS_SMP +# ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_check_exact(NULL, 0); /* No locks should be locked */ +# endif + erts_block_system(0); /* stop the world to avoid messy locking */ +#endif + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + counters.epep = erts_alloc(ERTS_ALC_T_TMP, sizeof(ErtsPollEvents)*max_fds); + ERTS_POLL_EXPORT(erts_poll_get_selected_events)(pollset.ps, counters.epep, max_fds); + counters.internal_fds = 0; +#endif + counters.used_fds = 0; + counters.num_errors = 0; + +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + len = erts_smp_atomic_read(&drv_ev_state_len); + for (fd = 0; fd < len; fd++) { + doit_erts_check_io_debug((void *) &drv_ev_state[fd], (void *) &counters); + } + for ( ; fd < max_fds; fd++) { + null_des.fd = fd; + doit_erts_check_io_debug((void *) &null_des, (void *) &counters); + } +#else + safe_hash_for_each(&drv_ev_state_tab, &doit_erts_check_io_debug, (void *) &counters); +#endif + +#ifdef ERTS_SMP + erts_release_system(); +#endif + + erts_printf("\n"); + erts_printf("used fds=%d\n", counters.used_fds); +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + erts_printf("internal fds=%d\n", counters.internal_fds); +#endif + erts_printf("---------------------------------------------------------\n"); + fflush(stdout); +#ifdef ERTS_SYS_CONTINOUS_FD_NUMBERS + erts_free(ERTS_ALC_T_TMP, (void *) counters.epep); +#endif + return counters.num_errors; +} + diff --git a/erts/emulator/sys/common/erl_check_io.h b/erts/emulator/sys/common/erl_check_io.h new file mode 100644 index 0000000000..9b45a63913 --- /dev/null +++ b/erts/emulator/sys/common/erl_check_io.h @@ -0,0 +1,96 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Check I/O + * + * Author: Rickard Green + */ + +#ifndef ERL_CHECK_IO_H__ +#define ERL_CHECK_IO_H__ + +#include "erl_sys_driver.h" + +#ifdef ERTS_ENABLE_KERNEL_POLL + +int driver_select_kp(ErlDrvPort, ErlDrvEvent, int, int); +int driver_select_nkp(ErlDrvPort, ErlDrvEvent, int, int); +int driver_event_kp(ErlDrvPort, ErlDrvEvent, ErlDrvEventData); +int driver_event_nkp(ErlDrvPort, ErlDrvEvent, ErlDrvEventData); +Uint erts_check_io_size_kp(void); +Uint erts_check_io_size_nkp(void); +Eterm erts_check_io_info_kp(void *); +Eterm erts_check_io_info_nkp(void *); +int erts_check_io_max_files_kp(void); +int erts_check_io_max_files_nkp(void); +void erts_check_io_interrupt_kp(int); +void erts_check_io_interrupt_nkp(int); +void erts_check_io_interrupt_timed_kp(int, long); +void erts_check_io_interrupt_timed_nkp(int, long); +void erts_check_io_kp(int); +void erts_check_io_nkp(int); +void erts_init_check_io_kp(void); +void erts_init_check_io_nkp(void); +int erts_check_io_debug_kp(void); +int erts_check_io_debug_nkp(void); + +#else /* !ERTS_ENABLE_KERNEL_POLL */ + +Uint erts_check_io_size(void); +Eterm erts_check_io_info(void *); +int erts_check_io_max_files(void); +void erts_check_io_interrupt(int); +void erts_check_io_interrupt_timed(int, long); +void erts_check_io(int); +void erts_init_check_io(void); + +#endif + +#endif /* ERL_CHECK_IO_H__ */ + +#if !defined(ERL_CHECK_IO_C__) && !defined(ERTS_ALLOC_C__) +#define ERL_CHECK_IO_INTERNAL__ +#endif + +#ifndef ERL_CHECK_IO_INTERNAL__ +#define ERL_CHECK_IO_INTERNAL__ +#include "erl_poll.h" +#include "erl_port_task.h" + +/* + * ErtsDrvEventDataState is used by driver_event() which is almost never + * used. We allocate ErtsDrvEventDataState separate since we dont wan't + * the size of ErtsDrvEventState to increase due to driver_event() + * information. + */ +typedef struct { + Eterm port; + ErlDrvEventData data; + ErtsPollEvents removed_events; + ErtsPortTaskHandle task; +} ErtsDrvEventDataState; + +typedef struct { + Eterm inport; + Eterm outport; + ErtsPortTaskHandle intask; + ErtsPortTaskHandle outtask; +} ErtsDrvSelectDataState; +#endif /* #ifndef ERL_CHECK_IO_INTERNAL__ */ diff --git a/erts/emulator/sys/common/erl_mseg.c b/erts/emulator/sys/common/erl_mseg.c new file mode 100644 index 0000000000..f4e21bc05f --- /dev/null +++ b/erts/emulator/sys/common/erl_mseg.c @@ -0,0 +1,1452 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: A memory segment allocator. Segments that are deallocated + * are kept for a while in a segment "cache" before they are + * destroyed. When segments are allocated, cached segments + * are used if possible instead of creating new segments. + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_mseg.h" +#include "global.h" +#include "erl_threads.h" +#include "erl_mtrace.h" +#include "big.h" + +#if HAVE_ERTS_MSEG + +#if defined(USE_THREADS) && !defined(ERTS_SMP) +# define ERTS_THREADS_NO_SMP +#endif + +#define SEGTYPE ERTS_MTRACE_SEGMENT_ID + +#ifndef HAVE_GETPAGESIZE +#define HAVE_GETPAGESIZE 0 +#endif + +#ifdef _SC_PAGESIZE +# define GET_PAGE_SIZE sysconf(_SC_PAGESIZE) +#elif HAVE_GETPAGESIZE +# define GET_PAGE_SIZE getpagesize() +#else +# error "Page size unknown" + /* Implement some other way to get the real page size if needed! */ +#endif + +#define MAX_CACHE_SIZE 30 + +#undef MIN +#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) +#undef MAX +#define MAX(X, Y) ((X) > (Y) ? (X) : (Y)) + +#undef PAGE_MASK +#define INV_PAGE_MASK ((Uint) (page_size - 1)) +#define PAGE_MASK (~INV_PAGE_MASK) +#define PAGE_FLOOR(X) ((X) & PAGE_MASK) +#define PAGE_CEILING(X) PAGE_FLOOR((X) + INV_PAGE_MASK) +#define PAGES(X) ((X) >> page_shift) + +static int atoms_initialized; + +static Uint cache_check_interval; + +static void check_cache(void *unused); +static void mseg_clear_cache(void); +static int is_cache_check_scheduled; +#ifdef ERTS_THREADS_NO_SMP +static int is_cache_check_requested; +#endif + +#if HAVE_MMAP +/* Mmap ... */ + +#define MMAP_PROT (PROT_READ|PROT_WRITE) +#ifdef MAP_ANON +# define MMAP_FLAGS (MAP_ANON|MAP_PRIVATE) +# define MMAP_FD (-1) +#else +# define MMAP_FLAGS (MAP_PRIVATE) +# define MMAP_FD mmap_fd +static int mmap_fd; +#endif + +#if HAVE_MREMAP +# define HAVE_MSEG_RECREATE 1 +#else +# define HAVE_MSEG_RECREATE 0 +#endif + +#define CAN_PARTLY_DESTROY 1 +#else /* #if HAVE_MMAP */ +#define CAN_PARTLY_DESTROY 0 +#error "Not supported" +#endif /* #if HAVE_MMAP */ + + +#if defined(ERTS_MSEG_FAKE_SEGMENTS) +#undef CAN_PARTLY_DESTROY +#define CAN_PARTLY_DESTROY 0 +#endif + +static const ErtsMsegOpt_t default_opt = ERTS_MSEG_DEFAULT_OPT_INITIALIZER; + +typedef struct cache_desc_t_ { + void *seg; + Uint size; + struct cache_desc_t_ *next; + struct cache_desc_t_ *prev; +} cache_desc_t; + +typedef struct { + Uint32 giga_no; + Uint32 no; +} CallCounter; + +static int is_init_done; +static Uint page_size; +static Uint page_shift; + +static struct { + CallCounter alloc; + CallCounter dealloc; + CallCounter realloc; + CallCounter create; + CallCounter destroy; +#if HAVE_MSEG_RECREATE + CallCounter recreate; +#endif + CallCounter clear_cache; + CallCounter check_cache; +} calls; + +static cache_desc_t cache_descs[MAX_CACHE_SIZE]; +static cache_desc_t *free_cache_descs; +static cache_desc_t *cache; +static cache_desc_t *cache_end; +static Uint cache_hits; +static Uint cache_size; +static Uint min_cached_seg_size; +static Uint max_cached_seg_size; + +static Uint max_cache_size; +static Uint abs_max_cache_bad_fit; +static Uint rel_max_cache_bad_fit; + +#if CAN_PARTLY_DESTROY +static Uint min_seg_size; +#endif + +struct { + struct { + Uint watermark; + Uint no; + Uint sz; + } current; + struct { + Uint no; + Uint sz; + } max; + struct { + Uint no; + Uint sz; + } max_ever; +} segments; + +#define ERTS_MSEG_ALLOC_STAT(SZ) \ +do { \ + segments.current.no++; \ + if (segments.max.no < segments.current.no) \ + segments.max.no = segments.current.no; \ + if (segments.current.watermark < segments.current.no) \ + segments.current.watermark = segments.current.no; \ + segments.current.sz += (SZ); \ + if (segments.max.sz < segments.current.sz) \ + segments.max.sz = segments.current.sz; \ +} while (0) + +#define ERTS_MSEG_DEALLOC_STAT(SZ) \ +do { \ + ASSERT(segments.current.no > 0); \ + segments.current.no--; \ + ASSERT(segments.current.sz >= (SZ)); \ + segments.current.sz -= (SZ); \ +} while (0) + +#define ERTS_MSEG_REALLOC_STAT(OSZ, NSZ) \ +do { \ + ASSERT(segments.current.sz >= (OSZ)); \ + segments.current.sz -= (OSZ); \ + segments.current.sz += (NSZ); \ +} while (0) + +#define ONE_GIGA (1000000000) + +#define ZERO_CC(CC) (calls.CC.no = 0, calls.CC.giga_no = 0) + +#define INC_CC(CC) (calls.CC.no == ONE_GIGA - 1 \ + ? (calls.CC.giga_no++, calls.CC.no = 0) \ + : calls.CC.no++) + +#define DEC_CC(CC) (calls.CC.no == 0 \ + ? (calls.CC.giga_no--, \ + calls.CC.no = ONE_GIGA - 1) \ + : calls.CC.no--) + + +static erts_mtx_t mseg_mutex; /* Also needed when !USE_THREADS */ +static erts_mtx_t init_atoms_mutex; /* Also needed when !USE_THREADS */ + +#ifdef USE_THREADS +#ifdef ERTS_THREADS_NO_SMP +static erts_tid_t main_tid; +static int async_handle = -1; +#endif + +static void thread_safe_init(void) +{ + erts_mtx_init(&init_atoms_mutex, "mseg_init_atoms"); + erts_mtx_init(&mseg_mutex, "mseg"); +#ifdef ERTS_THREADS_NO_SMP + main_tid = erts_thr_self(); +#endif +} + +#endif + +static ErlTimer cache_check_timer; + +static ERTS_INLINE void +schedule_cache_check(void) +{ + if (!is_cache_check_scheduled && is_init_done) { +#ifdef ERTS_THREADS_NO_SMP + if (!erts_equal_tids(erts_thr_self(), main_tid)) { + if (!is_cache_check_requested) { + is_cache_check_requested = 1; + sys_async_ready(async_handle); + } + } + else +#endif + { + cache_check_timer.active = 0; + erl_set_timer(&cache_check_timer, + check_cache, + NULL, + NULL, + cache_check_interval); + is_cache_check_scheduled = 1; +#ifdef ERTS_THREADS_NO_SMP + is_cache_check_requested = 0; +#endif + } + } +} + +#ifdef ERTS_THREADS_NO_SMP + +static void +check_schedule_cache_check(void) +{ + erts_mtx_lock(&mseg_mutex); + if (is_cache_check_requested + && !is_cache_check_scheduled) { + schedule_cache_check(); + } + erts_mtx_unlock(&mseg_mutex); +} + +#endif + +static void +mseg_shutdown(void) +{ +#ifdef ERTS_SMP + erts_mtx_lock(&mseg_mutex); +#endif + mseg_clear_cache(); +#ifdef ERTS_SMP + erts_mtx_unlock(&mseg_mutex); +#endif +} + +static ERTS_INLINE void * +mseg_create(Uint size) +{ + void *seg; + + ASSERT(size % page_size == 0); + +#if defined(ERTS_MSEG_FAKE_SEGMENTS) + seg = erts_sys_alloc(ERTS_ALC_N_INVALID, NULL, size); +#elif HAVE_MMAP + seg = (void *) mmap((void *) 0, (size_t) size, + MMAP_PROT, MMAP_FLAGS, MMAP_FD, 0); + if (seg == (void *) MAP_FAILED) + seg = NULL; +#else +#error "Missing mseg_create() implementation" +#endif + + INC_CC(create); + + return seg; +} + +static ERTS_INLINE void +mseg_destroy(void *seg, Uint size) +{ +#if defined(ERTS_MSEG_FAKE_SEGMENTS) + erts_sys_free(ERTS_ALC_N_INVALID, NULL, seg); +#elif HAVE_MMAP + +#ifdef DEBUG + int res = +#endif + + munmap((void *) seg, size); + + ASSERT(size % page_size == 0); + ASSERT(res == 0); +#else +#error "Missing mseg_destroy() implementation" +#endif + + INC_CC(destroy); + +} + +#if HAVE_MSEG_RECREATE + +static ERTS_INLINE void * +mseg_recreate(void *old_seg, Uint old_size, Uint new_size) +{ + void *new_seg; + + ASSERT(old_size % page_size == 0); + ASSERT(new_size % page_size == 0); + +#if defined(ERTS_MSEG_FAKE_SEGMENTS) + new_seg = erts_sys_realloc(ERTS_ALC_N_INVALID, NULL, old_seg, new_size); +#elif HAVE_MREMAP + new_seg = (void *) mremap((void *) old_seg, + (size_t) old_size, + (size_t) new_size, + MREMAP_MAYMOVE); + if (new_seg == (void *) MAP_FAILED) + new_seg = NULL; +#else +#error "Missing mseg_recreate() implementation" +#endif + + INC_CC(recreate); + + return new_seg; +} + +#endif /* #if HAVE_MSEG_RECREATE */ + + +static ERTS_INLINE cache_desc_t * +alloc_cd(void) +{ + cache_desc_t *cd = free_cache_descs; + if (cd) + free_cache_descs = cd->next; + return cd; +} + +static ERTS_INLINE void +free_cd(cache_desc_t *cd) +{ + cd->next = free_cache_descs; + free_cache_descs = cd; +} + + +static ERTS_INLINE void +link_cd(cache_desc_t *cd) +{ + if (cache) + cache->prev = cd; + cd->next = cache; + cd->prev = NULL; + cache = cd; + + if (!cache_end) { + ASSERT(!cd->next); + cache_end = cd; + } + + cache_size++; +} + +static ERTS_INLINE void +end_link_cd(cache_desc_t *cd) +{ + if (cache_end) + cache_end->next = cd; + cd->next = NULL; + cd->prev = cache_end; + cache_end = cd; + + if (!cache) { + ASSERT(!cd->prev); + cache = cd; + } + + cache_size++; +} + +static ERTS_INLINE void +unlink_cd(cache_desc_t *cd) +{ + + if (cd->next) + cd->next->prev = cd->prev; + else + cache_end = cd->prev; + + if (cd->prev) + cd->prev->next = cd->next; + else + cache = cd->next; + ASSERT(cache_size > 0); + cache_size--; +} + +static ERTS_INLINE void +check_cache_limits(void) +{ + cache_desc_t *cd; + max_cached_seg_size = 0; + min_cached_seg_size = ~((Uint) 0); + for (cd = cache; cd; cd = cd->next) { + if (cd->size < min_cached_seg_size) + min_cached_seg_size = cd->size; + if (cd->size > max_cached_seg_size) + max_cached_seg_size = cd->size; + } + +} + +static ERTS_INLINE void +adjust_cache_size(int force_check_limits) +{ + cache_desc_t *cd; + int check_limits = force_check_limits; + Sint max_cached = ((Sint) segments.current.watermark + - (Sint) segments.current.no); + + while (((Sint) cache_size) > max_cached && ((Sint) cache_size) > 0) { + ASSERT(cache_end); + cd = cache_end; + if (!check_limits && + !(min_cached_seg_size < cd->size + && cd->size < max_cached_seg_size)) { + check_limits = 1; + } + if (erts_mtrace_enabled) + erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); + mseg_destroy(cd->seg, cd->size); + unlink_cd(cd); + free_cd(cd); + } + + if (check_limits) + check_cache_limits(); + +} + +static void +check_cache(void *unused) +{ +#ifdef ERTS_SMP + erts_mtx_lock(&mseg_mutex); +#endif + + is_cache_check_scheduled = 0; + + if (segments.current.watermark > segments.current.no) + segments.current.watermark--; + adjust_cache_size(0); + + if (cache_size) + schedule_cache_check(); + + INC_CC(check_cache); + +#ifdef ERTS_SMP + erts_mtx_unlock(&mseg_mutex); +#endif + +} + +static void +mseg_clear_cache(void) +{ + segments.current.watermark = 0; + + adjust_cache_size(1); + + ASSERT(!cache); + ASSERT(!cache_end); + ASSERT(!cache_size); + + segments.current.watermark = segments.current.no; + + INC_CC(clear_cache); +} + +static void * +mseg_alloc(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) +{ + + Uint max, min, diff_size, size; + cache_desc_t *cd, *cand_cd; + void *seg; + + INC_CC(alloc); + + size = PAGE_CEILING(*size_p); + +#if CAN_PARTLY_DESTROY + if (size < min_seg_size) + min_seg_size = size; +#endif + + if (!opt->cache) { + create_seg: + adjust_cache_size(0); + seg = mseg_create(size); + if (!seg) { + mseg_clear_cache(); + seg = mseg_create(size); + if (!seg) + size = 0; + } + + *size_p = size; + if (seg) { + if (erts_mtrace_enabled) + erts_mtrace_crr_alloc(seg, atype, ERTS_MTRACE_SEGMENT_ID, size); + ERTS_MSEG_ALLOC_STAT(size); + } + return seg; + } + + if (size > max_cached_seg_size) + goto create_seg; + + if (size < min_cached_seg_size) { + + diff_size = min_cached_seg_size - size; + + if (diff_size > abs_max_cache_bad_fit) + goto create_seg; + + if (100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size)) + goto create_seg; + + } + + max = 0; + min = ~((Uint) 0); + cand_cd = NULL; + + for (cd = cache; cd; cd = cd->next) { + if (cd->size >= size) { + if (!cand_cd) { + cand_cd = cd; + continue; + } + else if (cd->size < cand_cd->size) { + if (max < cand_cd->size) + max = cand_cd->size; + if (min > cand_cd->size) + min = cand_cd->size; + cand_cd = cd; + continue; + } + } + if (max < cd->size) + max = cd->size; + if (min > cd->size) + min = cd->size; + } + + min_cached_seg_size = min; + max_cached_seg_size = max; + + if (!cand_cd) + goto create_seg; + + diff_size = cand_cd->size - size; + + if (diff_size > abs_max_cache_bad_fit + || 100*PAGES(diff_size) > rel_max_cache_bad_fit*PAGES(size)) { + if (max_cached_seg_size < cand_cd->size) + max_cached_seg_size = cand_cd->size; + if (min_cached_seg_size > cand_cd->size) + min_cached_seg_size = cand_cd->size; + goto create_seg; + } + + cache_hits++; + + size = cand_cd->size; + seg = cand_cd->seg; + + unlink_cd(cand_cd); + free_cd(cand_cd); + + *size_p = size; + + if (erts_mtrace_enabled) { + erts_mtrace_crr_free(SEGTYPE, SEGTYPE, seg); + erts_mtrace_crr_alloc(seg, atype, SEGTYPE, size); + } + + if (seg) + ERTS_MSEG_ALLOC_STAT(size); + return seg; +} + + +static void +mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size, + const ErtsMsegOpt_t *opt) +{ + cache_desc_t *cd; + + ERTS_MSEG_DEALLOC_STAT(size); + + if (!opt->cache || max_cache_size == 0) { + if (erts_mtrace_enabled) + erts_mtrace_crr_free(atype, SEGTYPE, seg); + mseg_destroy(seg, size); + } + else { + int check_limits = 0; + + if (size < min_cached_seg_size) + min_cached_seg_size = size; + if (size > max_cached_seg_size) + max_cached_seg_size = size; + + if (!free_cache_descs) { + cd = cache_end; + if (!(min_cached_seg_size < cd->size + && cd->size < max_cached_seg_size)) { + check_limits = 1; + } + if (erts_mtrace_enabled) + erts_mtrace_crr_free(SEGTYPE, SEGTYPE, cd->seg); + mseg_destroy(cd->seg, cd->size); + unlink_cd(cd); + free_cd(cd); + } + + cd = alloc_cd(); + ASSERT(cd); + cd->seg = seg; + cd->size = size; + link_cd(cd); + + if (erts_mtrace_enabled) { + erts_mtrace_crr_free(atype, SEGTYPE, seg); + erts_mtrace_crr_alloc(seg, SEGTYPE, SEGTYPE, size); + } + + /* ASSERT(segments.current.watermark >= segments.current.no + cache_size); */ + + if (check_limits) + check_cache_limits(); + + schedule_cache_check(); + + } + + INC_CC(dealloc); +} + +static void * +mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, Uint *new_size_p, + const ErtsMsegOpt_t *opt) +{ + void *new_seg; + Uint new_size; + + if (!seg || !old_size) { + new_seg = mseg_alloc(atype, new_size_p, opt); + DEC_CC(alloc); + return new_seg; + } + + if (!(*new_size_p)) { + mseg_dealloc(atype, seg, old_size, opt); + DEC_CC(dealloc); + return NULL; + } + + new_seg = seg; + new_size = PAGE_CEILING(*new_size_p); + + if (new_size == old_size) + ; + else if (new_size < old_size) { + Uint shrink_sz = old_size - new_size; + +#if CAN_PARTLY_DESTROY + if (new_size < min_seg_size) + min_seg_size = new_size; +#endif + + if (shrink_sz < opt->abs_shrink_th + && 100*PAGES(shrink_sz) < opt->rel_shrink_th*PAGES(old_size)) { + new_size = old_size; + } + else { + +#if CAN_PARTLY_DESTROY + + if (shrink_sz > min_seg_size + && free_cache_descs + && opt->cache) { + cache_desc_t *cd; + + cd = alloc_cd(); + ASSERT(cd); + cd->seg = ((char *) seg) + new_size; + cd->size = shrink_sz; + end_link_cd(cd); + + if (erts_mtrace_enabled) { + erts_mtrace_crr_realloc(new_seg, + atype, + SEGTYPE, + seg, + new_size); + erts_mtrace_crr_alloc(cd->seg, SEGTYPE, SEGTYPE, cd->size); + } + schedule_cache_check(); + } + else { + if (erts_mtrace_enabled) + erts_mtrace_crr_realloc(new_seg, + atype, + SEGTYPE, + seg, + new_size); + mseg_destroy(((char *) seg) + new_size, shrink_sz); + } + +#elif HAVE_MSEG_RECREATE + + goto do_recreate; + +#else + + new_seg = mseg_alloc(atype, &new_size, opt); + if (!new_seg) + new_size = old_size; + else { + sys_memcpy(((char *) new_seg), + ((char *) seg), + MIN(new_size, old_size)); + mseg_dealloc(atype, seg, old_size, opt); + } + +#endif + + } + } + else { + + if (!opt->preserv) { + mseg_dealloc(atype, seg, old_size, opt); + new_seg = mseg_alloc(atype, &new_size, opt); + } + else { +#if HAVE_MSEG_RECREATE +#if !CAN_PARTLY_DESTROY + do_recreate: +#endif + new_seg = mseg_recreate((void *) seg, old_size, new_size); + if (erts_mtrace_enabled) + erts_mtrace_crr_realloc(new_seg, atype, SEGTYPE, seg, new_size); + if (!new_seg) + new_size = old_size; +#else + new_seg = mseg_alloc(atype, &new_size, opt); + if (!new_seg) + new_size = old_size; + else { + sys_memcpy(((char *) new_seg), + ((char *) seg), + MIN(new_size, old_size)); + mseg_dealloc(atype, seg, old_size, opt); + } +#endif + } + } + + INC_CC(realloc); + + *new_size_p = new_size; + + ERTS_MSEG_REALLOC_STAT(old_size, new_size); + + return new_seg; +} + +/* --- Info stuff ---------------------------------------------------------- */ + +static struct { + Eterm version; + + Eterm options; + Eterm amcbf; + Eterm rmcbf; + Eterm mcs; + Eterm cci; + + Eterm status; + Eterm cached_segments; + Eterm cache_hits; + Eterm segments; + Eterm segments_size; + Eterm segments_watermark; + + + Eterm calls; + Eterm mseg_alloc; + Eterm mseg_dealloc; + Eterm mseg_realloc; + Eterm mseg_create; + Eterm mseg_destroy; +#if HAVE_MSEG_RECREATE + Eterm mseg_recreate; +#endif + Eterm mseg_clear_cache; + Eterm mseg_check_cache; + +#ifdef DEBUG + Eterm end_of_atoms; +#endif +} am; + +static void ERTS_INLINE atom_init(Eterm *atom, char *name) +{ + *atom = am_atom_put(name, strlen(name)); +} +#define AM_INIT(AM) atom_init(&am.AM, #AM) + +static void +init_atoms(void) +{ +#ifdef DEBUG + Eterm *atom; +#endif + + erts_mtx_unlock(&mseg_mutex); + erts_mtx_lock(&init_atoms_mutex); + + if (!atoms_initialized) { +#ifdef DEBUG + for (atom = (Eterm *) &am; atom <= &am.end_of_atoms; atom++) { + *atom = THE_NON_VALUE; + } +#endif + + AM_INIT(version); + + AM_INIT(options); + AM_INIT(amcbf); + AM_INIT(rmcbf); + AM_INIT(mcs); + AM_INIT(cci); + + AM_INIT(status); + AM_INIT(cached_segments); + AM_INIT(cache_hits); + AM_INIT(segments); + AM_INIT(segments_size); + AM_INIT(segments_watermark); + + AM_INIT(calls); + AM_INIT(mseg_alloc); + AM_INIT(mseg_dealloc); + AM_INIT(mseg_realloc); + AM_INIT(mseg_create); + AM_INIT(mseg_destroy); +#if HAVE_MSEG_RECREATE + AM_INIT(mseg_recreate); +#endif + AM_INIT(mseg_clear_cache); + AM_INIT(mseg_check_cache); + +#ifdef DEBUG + for (atom = (Eterm *) &am; atom < &am.end_of_atoms; atom++) { + ASSERT(*atom != THE_NON_VALUE); + } +#endif + } + + erts_mtx_lock(&mseg_mutex); + atoms_initialized = 1; + erts_mtx_unlock(&init_atoms_mutex); +} + + +#define bld_uint erts_bld_uint +#define bld_cons erts_bld_cons +#define bld_tuple erts_bld_tuple +#define bld_string erts_bld_string +#define bld_2tup_list erts_bld_2tup_list + + +/* + * bld_unstable_uint() (instead of bld_uint()) is used when values may + * change between size check and actual build. This because a value + * that would fit a small when size check is done may need to be built + * as a big when the actual build is performed. Caller is required to + * HRelease after build. + */ +static ERTS_INLINE Eterm +bld_unstable_uint(Uint **hpp, Uint *szp, Uint ui) +{ + Eterm res = THE_NON_VALUE; + if (szp) + *szp += BIG_UINT_HEAP_SIZE; + if (hpp) { + if (IS_USMALL(0, ui)) + res = make_small(ui); + else { + res = uint_to_big(ui, *hpp); + *hpp += BIG_UINT_HEAP_SIZE; + } + } + return res; +} + +static ERTS_INLINE void +add_2tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 2, el1, el2), *lp); +} + +static ERTS_INLINE void +add_3tup(Uint **hpp, Uint *szp, Eterm *lp, Eterm el1, Eterm el2, Eterm el3) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 3, el1, el2, el3), *lp); +} + +static ERTS_INLINE void +add_4tup(Uint **hpp, Uint *szp, Eterm *lp, + Eterm el1, Eterm el2, Eterm el3, Eterm el4) +{ + *lp = bld_cons(hpp, szp, bld_tuple(hpp, szp, 4, el1, el2, el3, el4), *lp); +} + +static Eterm +info_options(char *prefix, + int *print_to_p, + void *print_to_arg, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + erts_print(to, arg, "%samcbf: %bpu\n", prefix, abs_max_cache_bad_fit); + erts_print(to, arg, "%srmcbf: %bpu\n", prefix, rel_max_cache_bad_fit); + erts_print(to, arg, "%smcs: %bpu\n", prefix, max_cache_size); + erts_print(to, arg, "%scci: %bpu\n", prefix, cache_check_interval); + } + + if (hpp || szp) { + + if (!atoms_initialized) + init_atoms(); + + res = NIL; + add_2tup(hpp, szp, &res, + am.cci, + bld_uint(hpp, szp, cache_check_interval)); + add_2tup(hpp, szp, &res, + am.mcs, + bld_uint(hpp, szp, max_cache_size)); + add_2tup(hpp, szp, &res, + am.rmcbf, + bld_uint(hpp, szp, rel_max_cache_bad_fit)); + add_2tup(hpp, szp, &res, + am.amcbf, + bld_uint(hpp, szp, abs_max_cache_bad_fit)); + + } + + return res; +} + +static Eterm +info_calls(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + +#define PRINT_CC(TO, TOA, CC) \ + if (calls.CC.giga_no == 0) \ + erts_print(TO, TOA, "mseg_%s calls: %bpu\n", #CC, calls.CC.no); \ + else \ + erts_print(TO, TOA, "mseg_%s calls: %bpu%09bpu\n", #CC, \ + calls.CC.giga_no, calls.CC.no) + + int to = *print_to_p; + void *arg = print_to_arg; + + PRINT_CC(to, arg, alloc); + PRINT_CC(to, arg, dealloc); + PRINT_CC(to, arg, realloc); + PRINT_CC(to, arg, create); + PRINT_CC(to, arg, destroy); +#if HAVE_MSEG_RECREATE + PRINT_CC(to, arg, recreate); +#endif + PRINT_CC(to, arg, clear_cache); + PRINT_CC(to, arg, check_cache); + +#undef PRINT_CC + + } + + if (hpp || szp) { + + res = NIL; + + add_3tup(hpp, szp, &res, + am.mseg_check_cache, + bld_unstable_uint(hpp, szp, calls.check_cache.giga_no), + bld_unstable_uint(hpp, szp, calls.check_cache.no)); + add_3tup(hpp, szp, &res, + am.mseg_clear_cache, + bld_unstable_uint(hpp, szp, calls.clear_cache.giga_no), + bld_unstable_uint(hpp, szp, calls.clear_cache.no)); + +#if HAVE_MSEG_RECREATE + add_3tup(hpp, szp, &res, + am.mseg_recreate, + bld_unstable_uint(hpp, szp, calls.recreate.giga_no), + bld_unstable_uint(hpp, szp, calls.recreate.no)); +#endif + add_3tup(hpp, szp, &res, + am.mseg_destroy, + bld_unstable_uint(hpp, szp, calls.destroy.giga_no), + bld_unstable_uint(hpp, szp, calls.destroy.no)); + add_3tup(hpp, szp, &res, + am.mseg_create, + bld_unstable_uint(hpp, szp, calls.create.giga_no), + bld_unstable_uint(hpp, szp, calls.create.no)); + + + add_3tup(hpp, szp, &res, + am.mseg_realloc, + bld_unstable_uint(hpp, szp, calls.realloc.giga_no), + bld_unstable_uint(hpp, szp, calls.realloc.no)); + add_3tup(hpp, szp, &res, + am.mseg_dealloc, + bld_unstable_uint(hpp, szp, calls.dealloc.giga_no), + bld_unstable_uint(hpp, szp, calls.dealloc.no)); + add_3tup(hpp, szp, &res, + am.mseg_alloc, + bld_unstable_uint(hpp, szp, calls.alloc.giga_no), + bld_unstable_uint(hpp, szp, calls.alloc.no)); + } + + return res; +} + +static Eterm +info_status(int *print_to_p, + void *print_to_arg, + int begin_new_max_period, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + if (segments.max_ever.no < segments.max.no) + segments.max_ever.no = segments.max.no; + if (segments.max_ever.sz < segments.max.sz) + segments.max_ever.sz = segments.max.sz; + + if (print_to_p) { + int to = *print_to_p; + void *arg = print_to_arg; + + erts_print(to, arg, "cached_segments: %bpu\n", cache_size); + erts_print(to, arg, "cache_hits: %bpu\n", cache_hits); + erts_print(to, arg, "segments: %bpu %bpu %bpu\n", + segments.current.no, segments.max.no, segments.max_ever.no); + erts_print(to, arg, "segments_size: %bpu %bpu %bpu\n", + segments.current.sz, segments.max.sz, segments.max_ever.sz); + erts_print(to, arg, "segments_watermark: %bpu\n", + segments.current.watermark); + } + + if (hpp || szp) { + res = NIL; + add_2tup(hpp, szp, &res, + am.segments_watermark, + bld_unstable_uint(hpp, szp, segments.current.watermark)); + add_4tup(hpp, szp, &res, + am.segments_size, + bld_unstable_uint(hpp, szp, segments.current.sz), + bld_unstable_uint(hpp, szp, segments.max.sz), + bld_unstable_uint(hpp, szp, segments.max_ever.sz)); + add_4tup(hpp, szp, &res, + am.segments, + bld_unstable_uint(hpp, szp, segments.current.no), + bld_unstable_uint(hpp, szp, segments.max.no), + bld_unstable_uint(hpp, szp, segments.max_ever.no)); + add_2tup(hpp, szp, &res, + am.cache_hits, + bld_unstable_uint(hpp, szp, cache_hits)); + add_2tup(hpp, szp, &res, + am.cached_segments, + bld_unstable_uint(hpp, szp, cache_size)); + + } + + if (begin_new_max_period) { + segments.max.no = segments.current.no; + segments.max.sz = segments.current.sz; + } + + return res; +} + +static Eterm +info_version(int *print_to_p, void *print_to_arg, Uint **hpp, Uint *szp) +{ + Eterm res = THE_NON_VALUE; + + if (print_to_p) { + erts_print(*print_to_p, print_to_arg, "version: %s\n", + ERTS_MSEG_VSN_STR); + } + + if (hpp || szp) { + res = bld_string(hpp, szp, ERTS_MSEG_VSN_STR); + } + + return res; +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Exported functions * +\* */ + +Eterm +erts_mseg_info_options(int *print_to_p, void *print_to_arg, + Uint **hpp, Uint *szp) +{ + Eterm res; + + erts_mtx_lock(&mseg_mutex); + + res = info_options("option ", print_to_p, print_to_arg, hpp, szp); + + erts_mtx_unlock(&mseg_mutex); + + return res; +} + +Eterm +erts_mseg_info(int *print_to_p, + void *print_to_arg, + int begin_max_per, + Uint **hpp, + Uint *szp) +{ + Eterm res = THE_NON_VALUE; + Eterm atoms[4]; + Eterm values[4]; + + erts_mtx_lock(&mseg_mutex); + + if (hpp || szp) { + + if (!atoms_initialized) + init_atoms(); + + atoms[0] = am.version; + atoms[1] = am.options; + atoms[2] = am.status; + atoms[3] = am.calls; + } + + values[0] = info_version(print_to_p, print_to_arg, hpp, szp); + values[1] = info_options("option ", print_to_p, print_to_arg, hpp, szp); + values[2] = info_status(print_to_p, print_to_arg, begin_max_per, hpp, szp); + values[3] = info_calls(print_to_p, print_to_arg, hpp, szp); + + if (hpp || szp) + res = bld_2tup_list(hpp, szp, 4, atoms, values); + + erts_mtx_unlock(&mseg_mutex); + + return res; +} + +void * +erts_mseg_alloc_opt(ErtsAlcType_t atype, Uint *size_p, const ErtsMsegOpt_t *opt) +{ + void *seg; + erts_mtx_lock(&mseg_mutex); + seg = mseg_alloc(atype, size_p, opt); + erts_mtx_unlock(&mseg_mutex); + return seg; +} + +void * +erts_mseg_alloc(ErtsAlcType_t atype, Uint *size_p) +{ + return erts_mseg_alloc_opt(atype, size_p, &default_opt); +} + +void +erts_mseg_dealloc_opt(ErtsAlcType_t atype, void *seg, Uint size, + const ErtsMsegOpt_t *opt) +{ + erts_mtx_lock(&mseg_mutex); + mseg_dealloc(atype, seg, size, opt); + erts_mtx_unlock(&mseg_mutex); +} + +void +erts_mseg_dealloc(ErtsAlcType_t atype, void *seg, Uint size) +{ + erts_mseg_dealloc_opt(atype, seg, size, &default_opt); +} + +void * +erts_mseg_realloc_opt(ErtsAlcType_t atype, void *seg, Uint old_size, + Uint *new_size_p, const ErtsMsegOpt_t *opt) +{ + void *new_seg; + erts_mtx_lock(&mseg_mutex); + new_seg = mseg_realloc(atype, seg, old_size, new_size_p, opt); + erts_mtx_unlock(&mseg_mutex); + return new_seg; +} + +void * +erts_mseg_realloc(ErtsAlcType_t atype, void *seg, Uint old_size, + Uint *new_size_p) +{ + return erts_mseg_realloc_opt(atype, seg, old_size, new_size_p, &default_opt); +} + +void +erts_mseg_clear_cache(void) +{ + erts_mtx_lock(&mseg_mutex); + mseg_clear_cache(); + erts_mtx_unlock(&mseg_mutex); +} + +Uint +erts_mseg_no(void) +{ + Uint n; + erts_mtx_lock(&mseg_mutex); + n = segments.current.no; + erts_mtx_unlock(&mseg_mutex); + return n; +} + +Uint +erts_mseg_unit_size(void) +{ + return page_size; +} + +void +erts_mseg_init(ErtsMsegInit_t *init) +{ + unsigned i; + + atoms_initialized = 0; + is_init_done = 0; + + /* Options ... */ + + abs_max_cache_bad_fit = init->amcbf; + rel_max_cache_bad_fit = init->rmcbf; + max_cache_size = init->mcs; + cache_check_interval = init->cci; + + /* */ + +#ifdef USE_THREADS + thread_safe_init(); +#endif + +#if HAVE_MMAP && !defined(MAP_ANON) + mmap_fd = open("/dev/zero", O_RDWR); + if (mmap_fd < 0) + erl_exit(ERTS_ABORT_EXIT, "erts_mseg: unable to open /dev/zero\n"); +#endif + + page_size = GET_PAGE_SIZE; + + page_shift = 1; + while ((page_size >> page_shift) != 1) { + if ((page_size & (1 << (page_shift - 1))) != 0) + erl_exit(ERTS_ABORT_EXIT, + "erts_mseg: Unexpected page_size %bpu\n", page_size); + page_shift++; + } + + sys_memzero((void *) &calls, sizeof(calls)); + +#if CAN_PARTLY_DESTROY + min_seg_size = ~((Uint) 0); +#endif + + cache = NULL; + cache_end = NULL; + cache_hits = 0; + max_cached_seg_size = 0; + min_cached_seg_size = ~((Uint) 0); + cache_size = 0; + + is_cache_check_scheduled = 0; +#ifdef ERTS_THREADS_NO_SMP + is_cache_check_requested = 0; +#endif + + if (max_cache_size > MAX_CACHE_SIZE) + max_cache_size = MAX_CACHE_SIZE; + + if (max_cache_size > 0) { + for (i = 0; i < max_cache_size - 1; i++) + cache_descs[i].next = &cache_descs[i + 1]; + cache_descs[max_cache_size - 1].next = NULL; + free_cache_descs = &cache_descs[0]; + } + else + free_cache_descs = NULL; + + segments.current.watermark = 0; + segments.current.no = 0; + segments.current.sz = 0; + segments.max.no = 0; + segments.max.sz = 0; + segments.max_ever.no = 0; + segments.max_ever.sz = 0; +} + + +/* + * erts_mseg_late_init() have to be called after all allocators, + * threads and timers have been initialized. + */ +void +erts_mseg_late_init(void) +{ +#ifdef ERTS_THREADS_NO_SMP + int handle = + erts_register_async_ready_callback( + check_schedule_cache_check); +#endif + erts_mtx_lock(&mseg_mutex); + is_init_done = 1; +#ifdef ERTS_THREADS_NO_SMP + async_handle = handle; +#endif + if (cache_size) + schedule_cache_check(); + erts_mtx_unlock(&mseg_mutex); +} + +void +erts_mseg_exit(void) +{ + mseg_shutdown(); +} + +#endif /* #if HAVE_ERTS_MSEG */ + +unsigned long +erts_mseg_test(unsigned long op, + unsigned long a1, + unsigned long a2, + unsigned long a3) +{ + switch (op) { +#if HAVE_ERTS_MSEG + case 0x400: /* Have erts_mseg */ + return (unsigned long) 1; + case 0x401: + return (unsigned long) erts_mseg_alloc(ERTS_ALC_A_INVALID, (Uint *) a1); + case 0x402: + erts_mseg_dealloc(ERTS_ALC_A_INVALID, (void *) a1, (Uint) a2); + return (unsigned long) 0; + case 0x403: + return (unsigned long) erts_mseg_realloc(ERTS_ALC_A_INVALID, + (void *) a1, + (Uint) a2, + (Uint *) a3); + case 0x404: + erts_mseg_clear_cache(); + return (unsigned long) 0; + case 0x405: + return (unsigned long) erts_mseg_no(); + case 0x406: { + unsigned long res; + erts_mtx_lock(&mseg_mutex); + res = (unsigned long) cache_size; + erts_mtx_unlock(&mseg_mutex); + return res; + } +#else /* #if HAVE_ERTS_MSEG */ + case 0x400: /* Have erts_mseg */ + return (unsigned long) 0; +#endif /* #if HAVE_ERTS_MSEG */ + default: ASSERT(0); return ~((unsigned long) 0); + } + +} + + diff --git a/erts/emulator/sys/common/erl_mseg.h b/erts/emulator/sys/common/erl_mseg.h new file mode 100644 index 0000000000..1c5aa63e90 --- /dev/null +++ b/erts/emulator/sys/common/erl_mseg.h @@ -0,0 +1,97 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_MSEG_H_ +#define ERL_MSEG_H_ + +#include "sys.h" +#include "erl_alloc_types.h" + +#ifndef HAVE_MMAP +# define HAVE_MMAP 0 +#endif +#ifndef HAVE_MREMAP +# define HAVE_MREMAP 0 +#endif + +#if HAVE_MMAP +# define HAVE_ERTS_MSEG 1 +#else +# define HAVE_ERTS_MSEG 0 +#endif + +#if HAVE_ERTS_MSEG + +#define ERTS_MSEG_VSN_STR "0.9" + +typedef struct { + Uint amcbf; + Uint rmcbf; + Uint mcs; + Uint cci; +} ErtsMsegInit_t; + +#define ERTS_MSEG_INIT_DEFAULT_INITIALIZER \ +{ \ + 4*1024*1024, /* amcbf: Absolute max cache bad fit */ \ + 20, /* rmcbf: Relative max cache bad fit */ \ + 5, /* mcs: Max cache size */ \ + 1000 /* cci: Cache check interval */ \ +} + +typedef struct { + int cache; + int preserv; + Uint abs_shrink_th; + Uint rel_shrink_th; +} ErtsMsegOpt_t; + +#define ERTS_MSEG_DEFAULT_OPT_INITIALIZER \ +{ \ + 1, /* Use cache */ \ + 1, /* Preserv data */ \ + 0, /* Absolute shrink threshold */ \ + 0 /* Relative shrink threshold */ \ +} + +void *erts_mseg_alloc(ErtsAlcType_t, Uint *); +void *erts_mseg_alloc_opt(ErtsAlcType_t, Uint *, const ErtsMsegOpt_t *); +void erts_mseg_dealloc(ErtsAlcType_t, void *, Uint); +void erts_mseg_dealloc_opt(ErtsAlcType_t, void *, Uint, const ErtsMsegOpt_t *); +void *erts_mseg_realloc(ErtsAlcType_t, void *, Uint, Uint *); +void *erts_mseg_realloc_opt(ErtsAlcType_t, void *, Uint, Uint *, + const ErtsMsegOpt_t *); +void erts_mseg_clear_cache(void); +Uint erts_mseg_no(void); +Uint erts_mseg_unit_size(void); +void erts_mseg_init(ErtsMsegInit_t *init); +void erts_mseg_late_init(void); /* Have to be called after all allocators, + threads and timers have been initialized. */ +void erts_mseg_exit(void); +Eterm erts_mseg_info_options(int *, void*, Uint **, Uint *); +Eterm erts_mseg_info(int *, void*, int, Uint **, Uint *); + +#endif /* #if HAVE_ERTS_MSEG */ + +unsigned long erts_mseg_test(unsigned long, + unsigned long, + unsigned long, + unsigned long); + +#endif /* #ifndef ERL_MSEG_H_ */ diff --git a/erts/emulator/sys/common/erl_mtrace_sys_wrap.c b/erts/emulator/sys/common/erl_mtrace_sys_wrap.c new file mode 100644 index 0000000000..408aa7e016 --- /dev/null +++ b/erts/emulator/sys/common/erl_mtrace_sys_wrap.c @@ -0,0 +1,245 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_mtrace.h" + +#ifdef ERTS_CAN_TRACK_MALLOC +#if defined(HAVE_END_SYMBOL) +extern char end; +#elif defined(HAVE__END_SYMBOL) +extern char _end; +#endif + +static int inited = 0; +static int init(void); + +static volatile char *heap_start = NULL; +static volatile char *heap_end = NULL; + +#if defined(ERTS___AFTER_MORECORE_HOOK_CAN_TRACK_MALLOC) /* ----------------- */ + +#ifdef HAVE_MALLOC_H +# include +#endif + +#undef SBRK_0 +#define SBRK_0 sbrk(0) + +static void +init_hook(void) +{ + __after_morecore_hook = erts_mtrace_update_heap_size; + if (inited) + return; + heap_end = NULL; +#if defined(HAVE_END_SYMBOL) + heap_start = &end; +#elif defined(HAVE__END_SYMBOL) + heap_start = &_end; +#else + heap_start = SBRK_0; + if (heap_start == (SBRK_RET_TYPE) -1) { + heap_start = NULL; + return; + } +#endif + inited = 1; +} + +static int +init(void) +{ + init_hook(); + return inited; +} + +void (*__malloc_initialize_hook)(void) = init_hook; + +#elif defined(ERTS_BRK_WRAPPERS_CAN_TRACK_MALLOC) /* ------------------------ */ +#ifdef HAVE_DLFCN_H +# include +#endif + +#undef SBRK_0 +#define SBRK_0 (*real_sbrk)(0) + +#ifndef HAVE_SBRK +# error no sbrk() +#endif +#if !defined(HAVE_END_SYMBOL) && !defined(HAVE__END_SYMBOL) +# error no 'end' nor '_end' +#endif + +static void update_heap_size(char *new_end); + +#define SBRK_IMPL(RET_TYPE, FUNC, ARG_TYPE) \ +RET_TYPE FUNC (ARG_TYPE); \ +static RET_TYPE (*real_ ## FUNC)(ARG_TYPE) = NULL; \ +RET_TYPE FUNC (ARG_TYPE arg) \ +{ \ + RET_TYPE res; \ + if (!inited && !init()) \ + return (RET_TYPE) -1; \ + res = (*real_ ## FUNC)(arg); \ + if (erts_mtrace_enabled && res != ((RET_TYPE) -1)) \ + update_heap_size((char *) (*real_ ## FUNC)(0)); \ + return res; \ +} + +#define BRK_IMPL(RET_TYPE, FUNC, ARG_TYPE) \ +RET_TYPE FUNC (ARG_TYPE); \ +static RET_TYPE (*real_ ## FUNC)(ARG_TYPE) = NULL; \ +RET_TYPE FUNC (ARG_TYPE arg) \ +{ \ + RET_TYPE res; \ + if (!inited && !init()) \ + return (RET_TYPE) -1; \ + res = (*real_ ## FUNC)(arg); \ + if (erts_mtrace_enabled && res != ((RET_TYPE) -1)) \ + update_heap_size((char *) arg); \ + return res; \ +} + +SBRK_IMPL(SBRK_RET_TYPE, sbrk, SBRK_ARG_TYPE) +#ifdef HAVE_BRK + BRK_IMPL(BRK_RET_TYPE, brk, BRK_ARG_TYPE) +#endif + +#ifdef HAVE__SBRK + SBRK_IMPL(SBRK_RET_TYPE, _sbrk, SBRK_ARG_TYPE) +#endif +#ifdef HAVE__BRK + BRK_IMPL(BRK_RET_TYPE, _brk, BRK_ARG_TYPE) +#endif + +#ifdef HAVE___SBRK + SBRK_IMPL(SBRK_RET_TYPE, __sbrk, SBRK_ARG_TYPE) +#endif +#ifdef HAVE___BRK + BRK_IMPL(BRK_RET_TYPE, __brk, BRK_ARG_TYPE) +#endif + +static int +init(void) +{ + if (inited) + return 1; + +#define INIT_XBRK_SYM(SYM) \ +do { \ + if (!real_ ## SYM) { \ + real_ ## SYM = dlsym(RTLD_NEXT, #SYM); \ + if (!real_ ## SYM) { \ + errno = ENOMEM; \ + return 0; \ + } \ + } \ +} while (0) + + heap_end = NULL; +#if defined(HAVE_END_SYMBOL) + heap_start = &end; +#elif defined(HAVE__END_SYMBOL) + heap_start = &_end; +#endif + + INIT_XBRK_SYM(sbrk); +#ifdef HAVE_BRK + INIT_XBRK_SYM(brk); +#endif +#ifdef HAVE__SBRK + INIT_XBRK_SYM(_sbrk); +#endif +#ifdef HAVE__BRK + INIT_XBRK_SYM(_brk); +#endif +#ifdef HAVE___SBRK + INIT_XBRK_SYM(__sbrk); +#endif +#ifdef HAVE___BRK + INIT_XBRK_SYM(__brk); +#endif + + return inited = 1; +#undef INIT_XBRK_SYM +} + +#endif /* #elif defined(ERTS_BRK_WRAPPERS_CAN_TRACK_MALLOC) */ /* ----------- */ + +static void +update_heap_size(char *new_end) +{ + volatile char *new_start, *old_start, *old_end; + Uint size; + + if (new_end == ((char *) -1)) + return; + + new_start = (old_start = heap_start); + old_end = heap_end; + heap_end = new_end; + if (new_end < old_start || !old_start) + heap_start = (new_start = new_end); + + size = (Uint) (new_end - new_start); + + if (!old_end) { + if (size) + erts_mtrace_crr_alloc((void *) new_start, + ERTS_ALC_A_SYSTEM, + ERTS_MTRACE_SEGMENT_ID, + size); + else + heap_end = NULL; + } + else { + if (old_end != new_end || old_start != new_start) { + + if (size) + erts_mtrace_crr_realloc((void *) new_start, + ERTS_ALC_A_SYSTEM, + ERTS_MTRACE_SEGMENT_ID, + (void *) old_start, + size); + else { + if (old_start) + erts_mtrace_crr_free(ERTS_ALC_A_SYSTEM, + ERTS_MTRACE_SEGMENT_ID, + (void *) old_start); + heap_end = NULL; + } + } + } +} + +#endif /* #ifdef ERTS_CAN_TRACK_MALLOC */ + +void +erts_mtrace_update_heap_size(void) +{ +#ifdef ERTS_CAN_TRACK_MALLOC + if (erts_mtrace_enabled && (inited || init())) + update_heap_size((char *) SBRK_0); +#endif +} + diff --git a/erts/emulator/sys/common/erl_poll.c b/erts/emulator/sys/common/erl_poll.c new file mode 100644 index 0000000000..169d4579a2 --- /dev/null +++ b/erts/emulator/sys/common/erl_poll.c @@ -0,0 +1,2693 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Poll interface suitable for ERTS with or without + * SMP support. + * + * The interface is currently implemented using: + * - select + * - poll + * - /dev/poll + * - epoll with poll or select as fallback + * - kqueue with poll or select as fallback + * + * Some time in the future it will also be + * implemented using Solaris ports. + * + * + * + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifndef WANT_NONBLOCKING +# define WANT_NONBLOCKING +#endif +#define ERTS_WANT_GOT_SIGUSR1 + +#include "erl_poll.h" +#if ERTS_POLL_USE_KQUEUE +# include +# include +# include +#endif +#if ERTS_POLL_USE_SELECT +# ifdef SYS_SELECT_H +# include +# endif +# ifdef VXWORKS +# include +# endif +#endif +#ifndef VXWORKS +# ifdef NO_SYSCONF +# if ERTS_POLL_USE_SELECT +# include +# else +# include +# endif +# endif +#endif +#include "erl_driver.h" +#include "erl_alloc.h" + +#if !defined(ERTS_POLL_USE_EPOLL) \ + && !defined(ERTS_POLL_USE_DEVPOLL) \ + && !defined(ERTS_POLL_USE_POLL) \ + && !defined(ERTS_POLL_USE_SELECT) +#error "Missing implementation of erts_poll()" +#endif + +#if defined(ERTS_KERNEL_POLL_VERSION) && !ERTS_POLL_USE_KERNEL_POLL +#error "Missing kernel poll implementation of erts_poll()" +#endif + +#if defined(ERTS_NO_KERNEL_POLL_VERSION) && ERTS_POLL_USE_KERNEL_POLL +#error "Kernel poll used when it shouldn't be used" +#endif + +#if 0 +#define ERTS_POLL_DEBUG_PRINT +#endif + +#if defined(DEBUG) && 0 +#define HARD_DEBUG +#endif + +#define ERTS_POLL_USE_BATCH_UPDATE_POLLSET (ERTS_POLL_USE_DEVPOLL \ + || ERTS_POLL_USE_KQUEUE) +#define ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE \ + (defined(ERTS_SMP) || ERTS_POLL_USE_KERNEL_POLL || ERTS_POLL_USE_POLL) + +#define ERTS_POLL_USE_CONCURRENT_UPDATE \ + (defined(ERTS_SMP) && ERTS_POLL_USE_EPOLL) + +#define ERTS_POLL_COALESCE_KP_RES (ERTS_POLL_USE_KQUEUE || ERTS_POLL_USE_EPOLL) + +#define FDS_STATUS_EXTRA_FREE_SIZE 128 +#define POLL_FDS_EXTRA_FREE_SIZE 128 + +#ifdef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +# define ERTS_POLL_ASYNC_INTERRUPT_SUPPORT 1 +#else +# define ERTS_POLL_ASYNC_INTERRUPT_SUPPORT 0 +#endif + +#define ERTS_POLL_USE_WAKEUP_PIPE \ + (ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP)) + +#ifdef ERTS_SMP + +#define ERTS_POLLSET_LOCK(PS) \ + erts_smp_mtx_lock(&(PS)->mtx) +#define ERTS_POLLSET_UNLOCK(PS) \ + erts_smp_mtx_unlock(&(PS)->mtx) + +#define ERTS_POLLSET_SET_POLLED_CHK(PS) \ + ((int) erts_smp_atomic_xchg(&(PS)->polled, (long) 1)) +#define ERTS_POLLSET_UNSET_POLLED(PS) \ + erts_smp_atomic_set(&(PS)->polled, (long) 0) +#define ERTS_POLLSET_IS_POLLED(PS) \ + ((int) erts_smp_atomic_read(&(PS)->polled)) + +#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) \ + ((int) erts_smp_atomic_xchg(&(PS)->woken, (long) 1)) +#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \ + erts_smp_atomic_set(&(PS)->woken, (long) 1) +#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \ + erts_smp_atomic_set(&(PS)->woken, (long) 0) +#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \ + ((int) erts_smp_atomic_read(&(PS)->woken)) + +#else + +#define ERTS_POLLSET_LOCK(PS) +#define ERTS_POLLSET_UNLOCK(PS) +#define ERTS_POLLSET_SET_POLLED_CHK(PS) 0 +#define ERTS_POLLSET_UNSET_POLLED(PS) +#define ERTS_POLLSET_IS_POLLED(PS) 0 + +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + +/* + * Ideally, the ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) operation would + * be atomic. This operation isn't, but we will do okay anyway. The + * "woken check" is only an optimization. The only requirement we have: + * If (PS)->woken is set to a value != 0 when interrupting, we have to + * write on the the wakeup pipe at least once. Multiple writes are okay. + */ +#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) ((PS)->woken++) +#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) ((PS)->woken = 1, (void) 0) +#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) ((PS)->woken = 0, (void) 0) +#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) ((PS)->woken) + +#else + +#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) 1 +#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) +#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) +#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) 1 + +#endif + +#endif + +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE +#define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS) \ + erts_smp_atomic_set(&(PS)->have_update_requests, (long) 1) +#define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS) \ + erts_smp_atomic_set(&(PS)->have_update_requests, (long) 0) +#define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) \ + ((int) erts_smp_atomic_read(&(PS)->have_update_requests)) +#else +#define ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(PS) +#define ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(PS) +#define ERTS_POLLSET_HAVE_UPDATE_REQUESTS(PS) 0 +#endif + +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) + +#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) unset_interrupted_chk((PS)) +#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) ((PS)->interrupt = 0, (void) 0) +#define ERTS_POLLSET_SET_INTERRUPTED(PS) ((PS)->interrupt = 1, (void) 0) +#define ERTS_POLLSET_IS_INTERRUPTED(PS) ((PS)->interrupt) + +#else + +#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) \ + ((int) erts_smp_atomic_xchg(&(PS)->interrupt, (long) 0)) +#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \ + erts_smp_atomic_set(&(PS)->interrupt, (long) 0) +#define ERTS_POLLSET_SET_INTERRUPTED(PS) \ + erts_smp_atomic_set(&(PS)->interrupt, (long) 1) +#define ERTS_POLLSET_IS_INTERRUPTED(PS) \ + ((int) erts_smp_atomic_read(&(PS)->interrupt)) + +#endif + +#if ERTS_POLL_USE_FALLBACK +# if ERTS_POLL_USE_POLL +# define ERTS_POLL_NEED_FALLBACK(PS) ((PS)->no_poll_fds > 1) +# elif ERTS_POLL_USE_SELECT +# define ERTS_POLL_NEED_FALLBACK(PS) ((PS)->no_select_fds > 1) +# endif +#endif +/* + * --- Data types ------------------------------------------------------------ + */ + +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE +#define ERTS_POLLSET_UPDATE_REQ_BLOCK_SIZE 128 + +typedef struct ErtsPollSetUpdateRequestsBlock_ ErtsPollSetUpdateRequestsBlock; +struct ErtsPollSetUpdateRequestsBlock_ { + ErtsPollSetUpdateRequestsBlock *next; + int len; + int fds[ERTS_POLLSET_UPDATE_REQ_BLOCK_SIZE]; +}; + +#endif + + +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE +# define ERTS_POLL_FD_FLG_INURQ (((unsigned short) 1) << 0) +#endif +#if ERTS_POLL_USE_FALLBACK +# define ERTS_POLL_FD_FLG_INFLBCK (((unsigned short) 1) << 1) +# define ERTS_POLL_FD_FLG_USEFLBCK (((unsigned short) 1) << 2) +#endif +#if ERTS_POLL_USE_KERNEL_POLL || defined(ERTS_SMP) +# define ERTS_POLL_FD_FLG_RST (((unsigned short) 1) << 3) +#endif +typedef struct { +#if ERTS_POLL_USE_POLL + int pix; +#endif + ErtsPollEvents used_events; + ErtsPollEvents events; +#if ERTS_POLL_COALESCE_KP_RES + unsigned short res_ev_ix; +#endif +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE || ERTS_POLL_USE_FALLBACK + unsigned short flags; +#endif + +} ErtsFdStatus; + + +#if ERTS_POLL_COALESCE_KP_RES +/* res_ev_ix max value */ +#define ERTS_POLL_MAX_RES ((1 << sizeof(unsigned short)*8) - 1) +#endif + +#if ERTS_POLL_USE_KQUEUE + +#define ERTS_POLL_KQ_OP_HANDLED 1 +#define ERTS_POLL_KQ_OP_DEL_R 2 +#define ERTS_POLL_KQ_OP_DEL_W 3 +#define ERTS_POLL_KQ_OP_ADD_R 4 +#define ERTS_POLL_KQ_OP_ADD_W 5 +#define ERTS_POLL_KQ_OP_ADD2_R 6 +#define ERTS_POLL_KQ_OP_ADD2_W 7 + +#endif + +struct ErtsPollSet_ { + ErtsPollSet next; + int internal_fd_limit; + ErtsFdStatus *fds_status; + int no_of_user_fds; + int fds_status_len; +#if ERTS_POLL_USE_KERNEL_POLL + int kp_fd; + int res_events_len; +#if ERTS_POLL_USE_EPOLL + struct epoll_event *res_events; +#elif ERTS_POLL_USE_KQUEUE + struct kevent *res_events; +#elif ERTS_POLL_USE_DEVPOLL + struct pollfd *res_events; +#endif +#endif /* ERTS_POLL_USE_KERNEL_POLL */ +#if ERTS_POLL_USE_POLL + int next_poll_fds_ix; + int no_poll_fds; + int poll_fds_len; + struct pollfd*poll_fds; +#elif ERTS_POLL_USE_SELECT + int next_sel_fd; + int max_fd; +#if ERTS_POLL_USE_FALLBACK + int no_select_fds; +#endif + fd_set input_fds; + fd_set res_input_fds; + fd_set output_fds; + fd_set res_output_fds; +#endif +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + ErtsPollSetUpdateRequestsBlock update_requests; + ErtsPollSetUpdateRequestsBlock *curr_upd_req_block; + erts_smp_atomic_t have_update_requests; +#endif +#ifdef ERTS_SMP + erts_smp_atomic_t polled; + erts_smp_atomic_t woken; + erts_smp_mtx_t mtx; +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + volatile int woken; +#endif +#if ERTS_POLL_USE_WAKEUP_PIPE + int wake_fds[2]; +#endif +#if ERTS_POLL_USE_FALLBACK + int fallback_used; +#endif +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) + volatile int interrupt; +#else + erts_smp_atomic_t interrupt; +#endif + erts_smp_atomic_t timeout; +#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS + erts_smp_atomic_t no_avoided_wakeups; + erts_smp_atomic_t no_avoided_interrupts; + erts_smp_atomic_t no_interrupt_timed; +#endif +}; + +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) + +static ERTS_INLINE int +unset_interrupted_chk(ErtsPollSet ps) +{ + /* This operation isn't atomic, but we have no need at all for an + atomic operation here... */ + int res = ps->interrupt; + ps->interrupt = 0; + return res; +} + +#endif + +static void fatal_error(char *format, ...); +static void fatal_error_async_signal_safe(char *error_str); + +static int max_fds = -1; +static ErtsPollSet pollsets; +static erts_smp_spinlock_t pollsets_lock; + +#if ERTS_POLL_USE_POLL + +static ERTS_INLINE short +ev2pollev(ErtsPollEvents ev) +{ +#if !ERTS_POLL_USE_FALLBACK || ERTS_POLL_USE_KQUEUE + return ERTS_POLL_EV_E2N(ev); +#else /* Note, we only map events we are interested in */ + short res_ev = (short) 0; + if (ev & ERTS_POLL_EV_IN) + res_ev |= ERTS_POLL_EV_NKP_IN; + if (ev & ERTS_POLL_EV_OUT) + res_ev |= ERTS_POLL_EV_NKP_OUT; + return res_ev; +#endif +} + +static ERTS_INLINE ErtsPollEvents +pollev2ev(short ev) +{ +#if !ERTS_POLL_USE_FALLBACK || ERTS_POLL_USE_KQUEUE + return ERTS_POLL_EV_N2E(ev); +#else /* Note, we only map events we are interested in */ + ErtsPollEvents res_ev = (ErtsPollEvents) 0; + if (ev & ERTS_POLL_EV_NKP_IN) + res_ev |= ERTS_POLL_EV_IN; + if (ev & ERTS_POLL_EV_NKP_OUT) + res_ev |= ERTS_POLL_EV_OUT; + if (ev & ERTS_POLL_EV_NKP_ERR) + res_ev |= ERTS_POLL_EV_ERR; + if (ev & ERTS_POLL_EV_NKP_NVAL) + res_ev |= ERTS_POLL_EV_NVAL; + return res_ev; +#endif +} + +#endif + +#ifdef HARD_DEBUG +static void check_poll_result(ErtsPollResFd pr[], int len); +#if ERTS_POLL_USE_DEVPOLL +static void check_poll_status(ErtsPollSet ps); +#endif /* ERTS_POLL_USE_DEVPOLL */ +#endif /* HARD_DEBUG */ +#ifdef ERTS_POLL_DEBUG_PRINT +static void print_misc_debug_info(void); +#endif + +/* + * --- Wakeup pipe ----------------------------------------------------------- + */ + +#if ERTS_POLL_USE_WAKEUP_PIPE + +static ERTS_INLINE void +wake_poller(ErtsPollSet ps) +{ + /* + * NOTE: This function might be called from signal handlers in the + * non-smp case; therefore, it has to be async-signal safe in + * the non-smp case. + */ + if (!ERTS_POLLSET_SET_POLLER_WOKEN_CHK(ps)) { + ssize_t res; + if (ps->wake_fds[1] < 0) + return; /* Not initialized yet */ + do { + /* write() is async-signal safe (according to posix) */ + res = write(ps->wake_fds[1], "!", 1); + } while (res < 0 && errno == EINTR); + if (res <= 0 && errno != ERRNO_BLOCK) { + fatal_error_async_signal_safe(__FILE__ + ":XXX:wake_poller(): " + "Failed to write on wakeup pipe\n"); + } + } +} + +static ERTS_INLINE void +cleanup_wakeup_pipe(ErtsPollSet ps) +{ + int fd = ps->wake_fds[0]; + int res; + do { + char buf[32]; + res = read(fd, buf, sizeof(buf)); + } while (res > 0 || (res < 0 && errno == EINTR)); + if (res < 0 && errno != ERRNO_BLOCK) { + fatal_error("%s:%d:cleanup_wakeup_pipe(): " + "Failed to read on wakeup pipe fd=%d: " + "%s (%d)\n", + __FILE__, __LINE__, + fd, + erl_errno_id(errno), errno); + } +} + +static void +create_wakeup_pipe(ErtsPollSet ps) +{ + int do_wake = 0; + int wake_fds[2]; + ps->wake_fds[0] = -1; + ps->wake_fds[1] = -1; + if (pipe(wake_fds) < 0) { + fatal_error("%s:%d:create_wakeup_pipe(): " + "Failed to create pipe: %s (%d)\n", + __FILE__, + __LINE__, + erl_errno_id(errno), + errno); + } + SET_NONBLOCKING(wake_fds[0]); + SET_NONBLOCKING(wake_fds[1]); + +#ifdef ERTS_POLL_DEBUG_PRINT + erts_printf("wakeup fds = {%d, %d}\n", wake_fds[0], wake_fds[1]); +#endif + + ERTS_POLL_EXPORT(erts_poll_control)(ps, + wake_fds[0], + ERTS_POLL_EV_IN, + 1, &do_wake); +#if ERTS_POLL_USE_FALLBACK + /* We depend on the wakeup pipe being handled by kernel poll */ + if (ps->fds_status[wake_fds[0]].flags & ERTS_POLL_FD_FLG_INFLBCK) + fatal_error("%s:%d:create_wakeup_pipe(): Internal error\n", + __FILE__, __LINE__); +#endif + if (ps->internal_fd_limit <= wake_fds[1]) + ps->internal_fd_limit = wake_fds[1] + 1; + if (ps->internal_fd_limit <= wake_fds[0]) + ps->internal_fd_limit = wake_fds[0] + 1; + ps->wake_fds[0] = wake_fds[0]; + ps->wake_fds[1] = wake_fds[1]; +} + +#endif /* ERTS_POLL_USE_WAKEUP_PIPE */ + +/* + * --- Poll set update requests ---------------------------------------------- + */ +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + +static ERTS_INLINE void +enqueue_update_request(ErtsPollSet ps, int fd) +{ + ErtsPollSetUpdateRequestsBlock *urqbp; + + ASSERT(fd < ps->fds_status_len); + + if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INURQ) + return; + + if (ps->update_requests.len == 0) + ERTS_POLLSET_SET_HAVE_UPDATE_REQUESTS(ps); + + urqbp = ps->curr_upd_req_block; + + if (urqbp->len == ERTS_POLLSET_UPDATE_REQ_BLOCK_SIZE) { + ASSERT(!urqbp->next); + urqbp = erts_alloc(ERTS_ALC_T_POLLSET_UPDREQ, + sizeof(ErtsPollSetUpdateRequestsBlock)); + ps->curr_upd_req_block->next = urqbp; + ps->curr_upd_req_block = urqbp; + urqbp->next = NULL; + urqbp->len = 0; + } + + ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_INURQ; + urqbp->fds[urqbp->len++] = fd; +} + +static ERTS_INLINE void +free_update_requests_block(ErtsPollSet ps, + ErtsPollSetUpdateRequestsBlock *urqbp) +{ + if (urqbp != &ps->update_requests) + erts_free(ERTS_ALC_T_POLLSET_UPDREQ, (void *) urqbp); + else { + urqbp->next = NULL; + urqbp->len = 0; + } +} + +#endif /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */ + +/* + * --- Growing poll set structures ------------------------------------------- + */ + +#if ERTS_POLL_USE_KERNEL_POLL +static void +grow_res_events(ErtsPollSet ps, int new_len) +{ + size_t new_size = sizeof( +#if ERTS_POLL_USE_EPOLL + struct epoll_event +#elif ERTS_POLL_USE_DEVPOLL + struct pollfd +#elif ERTS_POLL_USE_KQUEUE + struct kevent +#endif + )*new_len; + /* We do not need to save previously stored data */ + if (ps->res_events) + erts_free(ERTS_ALC_T_POLL_RES_EVS, ps->res_events); + ps->res_events = erts_alloc(ERTS_ALC_T_POLL_RES_EVS, new_size); + ps->res_events_len = new_len; +} +#endif /* ERTS_POLL_USE_KERNEL_POLL */ + +#if ERTS_POLL_USE_POLL +static void +grow_poll_fds(ErtsPollSet ps, int min_ix) +{ + int i; + int new_len = min_ix + 1 + POLL_FDS_EXTRA_FREE_SIZE; + if (new_len > max_fds) + new_len = max_fds; + ps->poll_fds = (ps->poll_fds_len + ? erts_realloc(ERTS_ALC_T_POLL_FDS, + ps->poll_fds, + sizeof(struct pollfd)*new_len) + : erts_alloc(ERTS_ALC_T_POLL_FDS, + sizeof(struct pollfd)*new_len)); + for (i = ps->poll_fds_len; i < new_len; i++) { + ps->poll_fds[i].fd = -1; + ps->poll_fds[i].events = (short) 0; + ps->poll_fds[i].revents = (short) 0; + } + ps->poll_fds_len = new_len; +} +#endif + +static void +grow_fds_status(ErtsPollSet ps, int min_fd) +{ + int i; + int new_len = min_fd + 1 + FDS_STATUS_EXTRA_FREE_SIZE; + ASSERT(min_fd < max_fds); + if (new_len > max_fds) + new_len = max_fds; + ps->fds_status = (ps->fds_status_len + ? erts_realloc(ERTS_ALC_T_FD_STATUS, + ps->fds_status, + sizeof(ErtsFdStatus)*new_len) + : erts_alloc(ERTS_ALC_T_FD_STATUS, + sizeof(ErtsFdStatus)*new_len)); + for (i = ps->fds_status_len; i < new_len; i++) { +#if ERTS_POLL_USE_POLL + ps->fds_status[i].pix = -1; +#endif + ps->fds_status[i].used_events = (ErtsPollEvents) 0; + ps->fds_status[i].events = (ErtsPollEvents) 0; +#if ERTS_POLL_COALESCE_KP_RES + ps->fds_status[i].res_ev_ix = (unsigned short) ERTS_POLL_MAX_RES; +#endif +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE || ERTS_POLL_USE_FALLBACK + ps->fds_status[i].flags = (unsigned short) 0; +#endif + } + ps->fds_status_len = new_len; +} + +/* + * --- Selecting fd to poll on ----------------------------------------------- + */ + +#if ERTS_POLL_USE_FALLBACK +static int update_fallback_pollset(ErtsPollSet ps, int fd); +#endif + +static ERTS_INLINE int +need_update(ErtsPollSet ps, int fd) +{ +#if ERTS_POLL_USE_KERNEL_POLL + int reset; +#endif + + ASSERT(fd < ps->fds_status_len); + +#if ERTS_POLL_USE_KERNEL_POLL + reset = (int) (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST); + if (reset && !ps->fds_status[fd].used_events) { + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST; + reset = 0; + } +#elif defined(ERTS_SMP) + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST; +#endif + + if (ps->fds_status[fd].used_events != ps->fds_status[fd].events) + return 1; + +#if ERTS_POLL_USE_KERNEL_POLL + return reset; +#else + return 0; +#endif +} + +#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET + +#if ERTS_POLL_USE_KQUEUE +#define ERTS_POLL_MIN_BATCH_BUF_SIZE 128 +#else +#define ERTS_POLL_MIN_BATCH_BUF_SIZE 64 +#endif + +typedef struct { + int len; + int size; +#if ERTS_POLL_USE_DEVPOLL + struct pollfd *buf; +#elif ERTS_POLL_USE_KQUEUE + struct kevent *buf; + struct kevent *ebuf; +#endif +} ErtsPollBatchBuf; + + +static ERTS_INLINE void +setup_batch_buf(ErtsPollSet ps, ErtsPollBatchBuf *bbp) +{ + bbp->len = 0; +#if ERTS_POLL_USE_DEVPOLL + bbp->size = ps->res_events_len; + bbp->buf = ps->res_events; +#elif ERTS_POLL_USE_KQUEUE + bbp->size = ps->res_events_len/2; + bbp->buf = ps->res_events; + bbp->ebuf = bbp->buf + bbp->size; +#endif +} + + +#if ERTS_POLL_USE_DEVPOLL + +static void +write_batch_buf(ErtsPollSet ps, ErtsPollBatchBuf *bbp) +{ + ssize_t wres; + char *buf = (char *) bbp->buf; + size_t buf_size = sizeof(struct pollfd)*bbp->len; + + while (1) { + wres = write(ps->kp_fd, (void *) buf, buf_size); + if (wres < 0) { + if (errno == EINTR) + continue; + fatal_error("%s:%d:write_batch_buf(): " + "Failed to write to /dev/poll: " + "%s (%d)\n", + __FILE__, __LINE__, + erl_errno_id(errno), errno); + } + buf_size -= wres; + if (buf_size <= 0) + break; + buf += wres; + } + + if (buf_size < 0) { + fatal_error("%s:%d:write_devpoll_buf(): Internal error\n", + __FILE__, __LINE__); + } + bbp->len = 0; +} + +#elif ERTS_POLL_USE_KQUEUE + +static void +write_batch_buf(ErtsPollSet ps, ErtsPollBatchBuf *bbp) +{ + int res; + int len = bbp->len; + struct kevent *buf = bbp->buf; + struct timespec ts = {0, 0}; + + do { + res = kevent(ps->kp_fd, buf, len, NULL, 0, &ts); + } while (res < 0 && errno == EINTR); + if (res < 0) { + int i; + struct kevent *ebuf = bbp->ebuf; + do { + res = kevent(ps->kp_fd, buf, len, ebuf, len, &ts); + } while (res < 0 && errno == EINTR); + if (res < 0) { + fatal_error("%s:%d: kevent() failed: %s (%d)\n", + __FILE__, __LINE__, erl_errno_id(errno), errno); + } + for (i = 0; i < res; i++) { + if (ebuf[i].flags & EV_ERROR) { + short filter; + int fd = (int) ebuf[i].ident; + + switch ((int) ebuf[i].udata) { + + /* + * Since we use a lazy update approach EV_DELETE will + * frequently fail. This since kqueue automatically + * removes a file descriptor that is closed from the + * poll set. + */ + case ERTS_POLL_KQ_OP_DEL_R: + case ERTS_POLL_KQ_OP_DEL_W: + case ERTS_POLL_KQ_OP_HANDLED: + break; + + /* + * According to the kqueue man page EVFILT_READ support + * does not imply EVFILT_WRITE support; therefore, + * if an EV_ADD fail, we may have to remove other + * events on this fd in the kqueue pollset before + * adding fd to the fallback pollset. + */ + case ERTS_POLL_KQ_OP_ADD_W: + if (ps->fds_status[fd].used_events & ERTS_POLL_EV_IN) { + filter = EVFILT_READ; + goto rm_add_fb; + } + goto add_fb; + case ERTS_POLL_KQ_OP_ADD_R: + if (ps->fds_status[fd].used_events & ERTS_POLL_EV_OUT) { + filter = EVFILT_WRITE; + goto rm_add_fb; + } + goto add_fb; + case ERTS_POLL_KQ_OP_ADD2_W: + case ERTS_POLL_KQ_OP_ADD2_R: { + int j; + for (j = i+1; j < res; j++) { + if (fd == (int) ebuf[j].ident) { + ebuf[j].udata = (void *) ERTS_POLL_KQ_OP_HANDLED; + if (!(ebuf[j].flags & EV_ERROR)) { + switch ((int) ebuf[j].udata) { + case ERTS_POLL_KQ_OP_ADD2_W: + filter = EVFILT_WRITE; + goto rm_add_fb; + case ERTS_POLL_KQ_OP_ADD2_R: + filter = EVFILT_READ; + goto rm_add_fb; + default: + fatal_error("%s:%d:write_batch_buf(): " + "Internal error", + __FILE__, __LINE__); + break; + } + } + goto add_fb; + } + } + /* The other add succeded... */ + filter = (((int) ebuf[i].udata == ERTS_POLL_KQ_OP_ADD2_W) + ? EVFILT_READ + : EVFILT_WRITE); + rm_add_fb: + { + struct kevent kev; + struct timespec ts = {0, 0}; + EV_SET(&kev, fd, filter, EV_DELETE, 0, 0, 0); + (void) kevent(ps->kp_fd, &kev, 1, NULL, 0, &ts); + } + + add_fb: + ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_USEFLBCK; + ASSERT(ps->fds_status[fd].used_events); + ps->fds_status[fd].used_events = 0; + ps->no_of_user_fds--; + update_fallback_pollset(ps, fd); + ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK); + break; + } + default: + fatal_error("%s:%d:write_batch_buf(): Internal error", + __FILE__, __LINE__); + break; + } + } + } + } + bbp->len = 0; +} + +#endif /* ERTS_POLL_USE_KQUEUE */ + +static ERTS_INLINE void +batch_update_pollset(ErtsPollSet ps, int fd, ErtsPollBatchBuf *bbp) +{ + int buf_len; +#if ERTS_POLL_USE_DEVPOLL + short events; + struct pollfd *buf; +#elif ERTS_POLL_USE_KQUEUE + struct kevent *buf; +#endif + +#ifdef ERTS_POLL_DEBUG_PRINT + erts_printf("Doing lazy update on fd=%d\n", fd); +#endif + + if (!need_update(ps, fd)) + return; + + /* Make sure we have room for at least maximum no of entries + per fd */ + if (bbp->size - bbp->len < 2) + write_batch_buf(ps, bbp); + + buf_len = bbp->len; + buf = bbp->buf; + + ASSERT(fd < ps->fds_status_len); + +#if ERTS_POLL_USE_DEVPOLL + events = ERTS_POLL_EV_E2N(ps->fds_status[fd].events); + if (!events) { + buf[buf_len].events = POLLREMOVE; + ps->no_of_user_fds--; + } + else if (!ps->fds_status[fd].used_events) { + buf[buf_len].events = events; + ps->no_of_user_fds++; + } + else { + if ((ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST) + || (ps->fds_status[fd].used_events & ~events)) { + /* Reset or removed events... */ + buf[buf_len].fd = fd; + buf[buf_len].events = POLLREMOVE; + buf[buf_len++].revents = 0; + } + buf[buf_len].events = events; + } + buf[buf_len].fd = fd; + buf[buf_len++].revents = 0; + +#elif ERTS_POLL_USE_KQUEUE + + if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK) { + if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_USEFLBCK) + update_fallback_pollset(ps, fd); + else { /* Remove from fallback and try kqueue */ + ErtsPollEvents events = ps->fds_status[fd].events; + ps->fds_status[fd].events = (ErtsPollEvents) 0; + update_fallback_pollset(ps, fd); + ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)); + if (events) { + ps->fds_status[fd].events = events; + goto try_kqueue; + } + } + } + else { + ErtsPollEvents events, used_events; + int mod_w, mod_r; + try_kqueue: + events = ERTS_POLL_EV_E2N(ps->fds_status[fd].events); + used_events = ERTS_POLL_EV_E2N(ps->fds_status[fd].used_events); + if (!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST)) { + if (!used_events && + (events & ERTS_POLL_EV_IN) && (events & ERTS_POLL_EV_OUT)) + goto do_add_rw; + mod_r = ((events & ERTS_POLL_EV_IN) + != (used_events & ERTS_POLL_EV_IN)); + mod_w = ((events & ERTS_POLL_EV_OUT) + != (used_events & ERTS_POLL_EV_OUT)); + goto do_mod; + } + else { /* Reset */ + if ((events & ERTS_POLL_EV_IN) && (events & ERTS_POLL_EV_OUT)) { + do_add_rw: + EV_SET(&buf[buf_len], fd, EVFILT_READ, EV_ADD, + 0, 0, (void *) ERTS_POLL_KQ_OP_ADD2_R); + buf_len++; + EV_SET(&buf[buf_len], fd, EVFILT_WRITE, EV_ADD, + 0, 0, (void *) ERTS_POLL_KQ_OP_ADD2_W); + buf_len++; + + } + else { + mod_r = 1; + mod_w = 1; + do_mod: + if (mod_r) { + if (events & ERTS_POLL_EV_IN) { + EV_SET(&buf[buf_len], fd, EVFILT_READ, EV_ADD, + 0, 0, (void *) ERTS_POLL_KQ_OP_ADD_R); + buf_len++; + } + else if (used_events & ERTS_POLL_EV_IN) { + EV_SET(&buf[buf_len], fd, EVFILT_READ, EV_DELETE, + 0, 0, (void *) ERTS_POLL_KQ_OP_DEL_R); + buf_len++; + } + } + if (mod_w) { + if (events & ERTS_POLL_EV_OUT) { + EV_SET(&buf[buf_len], fd, EVFILT_WRITE, EV_ADD, + 0, 0, (void *) ERTS_POLL_KQ_OP_ADD_W); + buf_len++; + } + else if (used_events & ERTS_POLL_EV_OUT) { + EV_SET(&buf[buf_len], fd, EVFILT_WRITE, EV_DELETE, + 0, 0, (void *) ERTS_POLL_KQ_OP_DEL_W); + buf_len++; + } + } + } + } + if (used_events) { + if (!events) { + ps->no_of_user_fds--; + } + } + else { + if (events) + ps->no_of_user_fds++; + } + ASSERT((events & ~(ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) == 0); + ASSERT((used_events & ~(ERTS_POLL_EV_IN|ERTS_POLL_EV_OUT)) == 0); + } + +#endif + + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST; + ps->fds_status[fd].used_events = ps->fds_status[fd].events; + + bbp->len = buf_len; +} + +#else /* !ERTS_POLL_USE_BATCH_UPDATE_POLLSET */ + +#if ERTS_POLL_USE_EPOLL +static int +#if ERTS_POLL_USE_CONCURRENT_UPDATE +conc_update_pollset(ErtsPollSet ps, int fd, int *update_fallback) +#else +update_pollset(ErtsPollSet ps, int fd) +#endif +{ + int res; + int op; + struct epoll_event epe_templ; + struct epoll_event epe; + + ASSERT(fd < ps->fds_status_len); + + if (!need_update(ps, fd)) + return 0; + +#ifdef ERTS_POLL_DEBUG_PRINT + erts_printf("Doing update on fd=%d\n", fd); +#endif + if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK) { +#if ERTS_POLL_USE_CONCURRENT_UPDATE + if (!*update_fallback) { + *update_fallback = 1; + return 0; + } +#endif + if (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_USEFLBCK) { + return update_fallback_pollset(ps, fd); + } + else { /* Remove from fallback and try epoll */ + ErtsPollEvents events = ps->fds_status[fd].events; + ps->fds_status[fd].events = (ErtsPollEvents) 0; + res = update_fallback_pollset(ps, fd); + ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)); + if (!events) + return res; + ps->fds_status[fd].events = events; + } + } + + epe_templ.events = ERTS_POLL_EV_E2N(ps->fds_status[fd].events); + epe_templ.data.fd = fd; + +#ifdef VALGRIND + /* Silence invalid valgrind warning ... */ + memset((void *) &epe.data, 0, sizeof(epoll_data_t)); +#endif + + if (epe_templ.events && ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST) { + do { + /* We init 'epe' every time since epoll_ctl() may modify it + (not declared const and not documented as const). */ + epe.events = epe_templ.events; + epe.data.fd = epe_templ.data.fd; + res = epoll_ctl(ps->kp_fd, EPOLL_CTL_DEL, fd, &epe); + } while (res != 0 && errno == EINTR); + ps->no_of_user_fds--; + ps->fds_status[fd].used_events = 0; + } + + if (!epe_templ.events) { + /* A note on EPOLL_CTL_DEL: linux kernel versions before 2.6.9 + need a non-NULL event pointer even though it is ignored... */ + op = EPOLL_CTL_DEL; + ps->no_of_user_fds--; + } + else if (!ps->fds_status[fd].used_events) { + op = EPOLL_CTL_ADD; + ps->no_of_user_fds++; + } + else { + op = EPOLL_CTL_MOD; + } + + do { + /* We init 'epe' every time since epoll_ctl() may modify it + (not declared const and not documented as const). */ + epe.events = epe_templ.events; + epe.data.fd = epe_templ.data.fd; + res = epoll_ctl(ps->kp_fd, op, fd, &epe); + } while (res != 0 && errno == EINTR); + +#if defined(ERTS_POLL_DEBUG_PRINT) && 1 + { + int saved_errno = errno; + erts_printf("%s = epoll_ctl(%d, %s, %d, {Ox%x, %d})\n", + res == 0 ? "0" : erl_errno_id(errno), + ps->kp_fd, + (op == EPOLL_CTL_ADD + ? "EPOLL_CTL_ADD" + : (op == EPOLL_CTL_MOD + ? "EPOLL_CTL_MOD" + : (op == EPOLL_CTL_DEL + ? "EPOLL_CTL_DEL" + : "UNKNOWN"))), + fd, + epe_templ.events, + fd); + errno = saved_errno; + } +#endif + if (res == 0) + ps->fds_status[fd].used_events = ps->fds_status[fd].events; + else { + switch (op) { + case EPOLL_CTL_MOD: + epe.events = 0; + do { + /* We init 'epe' every time since epoll_ctl() may modify it + (not declared const and not documented as const). */ + epe.events = 0; + epe.data.fd = fd; + res = epoll_ctl(ps->kp_fd, EPOLL_CTL_DEL, fd, &epe); + } while (res != 0 && errno == EINTR); + ps->fds_status[fd].used_events = 0; + /* Fall through ... */ + case EPOLL_CTL_ADD: { + ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_USEFLBCK; + ps->no_of_user_fds--; +#if ERTS_POLL_USE_CONCURRENT_UPDATE + if (!*update_fallback) { + *update_fallback = 1; + return 0; + } +#endif + ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)); + res = update_fallback_pollset(ps, fd); + ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK); + break; + } + case EPOLL_CTL_DEL: { + /* + * Since we use a lazy update approach EPOLL_CTL_DEL will + * frequently fail. This since epoll automatically removes + * a filedescriptor that is closed from the poll set. + */ + ps->fds_status[fd].used_events = 0; + res = 0; + break; + } + default: + fatal_error("%s:%d:update_pollset(): Internal error\n", + __FILE__, __LINE__); + break; + } + } + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST; + return res; +} + +#if ERTS_POLL_USE_CONCURRENT_UPDATE +static int +update_pollset(ErtsPollSet ps, int fd) +{ + int update_fallback = 1; + return conc_update_pollset(ps, fd, &update_fallback); +} +#endif + +#endif /* ERTS_POLL_USE_EPOLL */ + +#endif /* ERTS_POLL_USE_BATCH_UPDATE_POLLSET */ + +#if ERTS_POLL_USE_POLL || ERTS_POLL_USE_SELECT || ERTS_POLL_USE_FALLBACK + +#if ERTS_POLL_USE_FALLBACK +static int update_fallback_pollset(ErtsPollSet ps, int fd) +#else +static int update_pollset(ErtsPollSet ps, int fd) +#endif +{ +#ifdef ERTS_POLL_DEBUG_PRINT +#if ERTS_POLL_USE_FALLBACK + erts_printf("Doing fallback update on fd=%d\n", fd); +#else + erts_printf("Doing update on fd=%d\n", fd); +#endif +#endif + + ASSERT(fd < ps->fds_status_len); +#if ERTS_POLL_USE_FALLBACK + ASSERT(ps->fds_status[fd].used_events + ? (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK) + : (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_USEFLBCK)); +#endif + + if (!need_update(ps, fd)) + return 0; + +#if ERTS_POLL_USE_FALLBACK + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_RST; +#endif + +#if ERTS_POLL_USE_POLL /* --- poll -------------------------------- */ + if (!ps->fds_status[fd].events) { + int pix = ps->fds_status[fd].pix; + int last_pix; + if (pix < 0) { +#if ERTS_POLL_USE_FALLBACK + ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)); +#endif + return -1; + } +#if ERTS_POLL_USE_FALLBACK + ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK); +#endif + ps->no_of_user_fds--; + last_pix = --ps->no_poll_fds; + if (pix != last_pix) { + /* Move last pix to this pix */ + ps->poll_fds[pix].fd = ps->poll_fds[last_pix].fd; + ps->poll_fds[pix].events = ps->poll_fds[last_pix].events; + ps->poll_fds[pix].revents = ps->poll_fds[last_pix].revents; + ps->fds_status[ps->poll_fds[pix].fd].pix = pix; + } + /* Clear last pix */ + ps->poll_fds[last_pix].fd = -1; + ps->poll_fds[last_pix].events = (short) 0; + ps->poll_fds[last_pix].revents = (short) 0; + /* Clear this fd status */ + ps->fds_status[fd].pix = -1; + ps->fds_status[fd].used_events = (ErtsPollEvents) 0; +#if ERTS_POLL_USE_FALLBACK + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_INFLBCK; +#endif + } + else { + int pix = ps->fds_status[fd].pix; + if (pix < 0) { +#if ERTS_POLL_USE_FALLBACK + ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK) + || fd == ps->kp_fd); +#endif + ps->no_of_user_fds++; + ps->fds_status[fd].pix = pix = ps->no_poll_fds++; + if (pix >= ps->poll_fds_len) + grow_poll_fds(ps, pix); + ps->poll_fds[pix].fd = fd; + ps->fds_status[fd].pix = pix; +#if ERTS_POLL_USE_FALLBACK + ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_INFLBCK; +#endif + } + +#if ERTS_POLL_USE_FALLBACK + ASSERT(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK); +#endif + + /* Events to be used in next poll */ + ps->poll_fds[pix].events = ev2pollev(ps->fds_status[fd].events); + if (ps->poll_fds[pix].revents) { + /* Remove result events that we should not poll for anymore */ + ps->poll_fds[pix].revents + &= ev2pollev(~(~ps->fds_status[fd].used_events + & ps->fds_status[fd].events)); + } + /* Save events to be used in next poll */ + ps->fds_status[fd].used_events = ps->fds_status[fd].events; + } + return 0; +#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ + { + ErtsPollEvents events = ps->fds_status[fd].events; + if ((ERTS_POLL_EV_IN & events) + != (ERTS_POLL_EV_IN & ps->fds_status[fd].used_events)) { + if (ERTS_POLL_EV_IN & events) { + FD_SET(fd, &ps->input_fds); + } + else { + FD_CLR(fd, &ps->input_fds); + } + } + if ((ERTS_POLL_EV_OUT & events) + != (ERTS_POLL_EV_OUT & ps->fds_status[fd].used_events)) { + if (ERTS_POLL_EV_OUT & events) { + FD_SET(fd, &ps->output_fds); + } + else { + FD_CLR(fd, &ps->output_fds); + } + } + + if (!ps->fds_status[fd].used_events) { + ASSERT(events); + ps->no_of_user_fds++; +#if ERTS_POLL_USE_FALLBACK + ps->no_select_fds++; + ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_INFLBCK; +#endif + } + else if (!events) { + ASSERT(ps->fds_status[fd].used_events); + ps->no_of_user_fds--; + ps->fds_status[fd].events = events; +#if ERTS_POLL_USE_FALLBACK + ps->no_select_fds--; + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_INFLBCK; +#endif + } + + ps->fds_status[fd].used_events = events; + + if (events && fd > ps->max_fd) + ps->max_fd = fd; + else if (!events && fd == ps->max_fd) { + int max = ps->max_fd; + for (max = ps->max_fd; max >= 0; max--) + if (ps->fds_status[max].used_events) + break; + ps->max_fd = max; + } + } + return 0; +#endif +} + +#endif /* ERTS_POLL_USE_POLL || ERTS_POLL_USE_SELECT || ERTS_POLL_USE_FALLBACK */ + +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + +static void +handle_update_requests(ErtsPollSet ps) +{ + ErtsPollSetUpdateRequestsBlock *urqbp = &ps->update_requests; +#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET + ErtsPollBatchBuf bb; + setup_batch_buf(ps, &bb); +#endif + + while (urqbp) { + ErtsPollSetUpdateRequestsBlock *free_urqbp = urqbp; + int i; + int len = urqbp->len; + for (i = 0; i < len; i++) { + int fd = urqbp->fds[i]; + ASSERT(fd < ps->fds_status_len); + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_INURQ; +#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET + batch_update_pollset(ps, fd, &bb); +#else + update_pollset(ps, fd); +#endif + } + + free_urqbp = urqbp; + urqbp = urqbp->next; + + free_update_requests_block(ps, free_urqbp); + + } + +#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET + if (bb.len) + write_batch_buf(ps, &bb); +#endif + + ps->curr_upd_req_block = &ps->update_requests; + +#if ERTS_POLL_USE_DEVPOLL && defined(HARD_DEBUG) + check_poll_status(ps); +#endif + + ERTS_POLLSET_UNSET_HAVE_UPDATE_REQUESTS(ps); +} + +#endif /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */ + +static ERTS_INLINE ErtsPollEvents +poll_control(ErtsPollSet ps, int fd, ErtsPollEvents events, int on, + int *have_set_have_update_requests, + int *do_wake) +{ + ErtsPollEvents new_events; + + if (fd < ps->internal_fd_limit || fd >= max_fds) { + if (fd < 0) { + new_events = ERTS_POLL_EV_ERR; + goto done; + } +#if ERTS_POLL_USE_KERNEL_POLL + if (fd == ps->kp_fd) { + new_events = ERTS_POLL_EV_NVAL; + goto done; + } +#endif +#if ERTS_POLL_USE_WAKEUP_PIPE + if (fd == ps->wake_fds[0] || fd == ps->wake_fds[1]) { + new_events = ERTS_POLL_EV_NVAL; + goto done; + } +#endif + } + + if (fd >= ps->fds_status_len) + grow_fds_status(ps, fd); + + ASSERT(fd < ps->fds_status_len); + + new_events = ps->fds_status[fd].events; + + if (events == 0) { + *do_wake = 0; + goto done; + } + + if (on) + new_events |= events; + else + new_events &= ~events; + + if (new_events == (ErtsPollEvents) 0) { +#if ERTS_POLL_USE_KERNEL_POLL || defined(ERTS_SMP) + ps->fds_status[fd].flags |= ERTS_POLL_FD_FLG_RST; +#endif +#if ERTS_POLL_USE_FALLBACK + ps->fds_status[fd].flags &= ~ERTS_POLL_FD_FLG_USEFLBCK; +#endif + } + + ps->fds_status[fd].events = new_events; + + if (new_events == ps->fds_status[fd].used_events +#if ERTS_POLL_USE_KERNEL_POLL || defined(ERTS_SMP) + && !(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST) +#endif + ) { + *do_wake = 0; + goto done; + } + +#if !ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + if (update_pollset(ps, fd) != 0) + new_events = ERTS_POLL_EV_ERR; +#else /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */ + +#if ERTS_POLL_USE_CONCURRENT_UPDATE + if (ERTS_POLLSET_IS_POLLED(ps)) { + int update_fallback = 0; + conc_update_pollset(ps, fd, &update_fallback); + if (!update_fallback) { + *do_wake = 0; /* no need to wake kernel poller */ + goto done; + } + } +#endif + + enqueue_update_request(ps, fd); + +#ifdef ERTS_SMP + /* + * If new events have been added, we need to wake up the + * polling thread, but if events have been removed we don't. + */ + if ((new_events && (ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_RST)) + || (~ps->fds_status[fd].used_events & new_events)) + *do_wake = 1; +#endif /* ERTS_SMP */ + +#endif /* ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE */ + + done: +#ifdef ERTS_POLL_DEBUG_PRINT + erts_printf("0x%x = poll_control(ps, %d, 0x%x, %s) do_wake=%d\n", + (int) new_events, fd, (int) events, (on ? "on" : "off"), *do_wake); +#endif + return new_events; +} + +void +ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet ps, + ErtsPollControlEntry pcev[], + int len) +{ + int i; + int hshur = 0; + int do_wake; + int final_do_wake = 0; + + ERTS_POLLSET_LOCK(ps); + + for (i = 0; i < len; i++) { + do_wake = 0; + pcev[i].events = poll_control(ps, + pcev[i].fd, + pcev[i].events, + pcev[i].on, + &hshur, + &do_wake); + final_do_wake |= do_wake; + } + +#ifdef ERTS_SMP + if (final_do_wake) + wake_poller(ps); +#endif /* ERTS_SMP */ + + ERTS_POLLSET_UNLOCK(ps); +} + +ErtsPollEvents +ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet ps, + ErtsSysFdType fd, + ErtsPollEvents events, + int on, + int* do_wake) /* In: Wake up polling thread */ + /* Out: Poller is woken */ +{ + int hshur = 0; + ErtsPollEvents res; + + ERTS_POLLSET_LOCK(ps); + + res = poll_control(ps, fd, events, on, &hshur, do_wake); + +#ifdef ERTS_SMP + if (*do_wake) { + wake_poller(ps); + } +#endif /* ERTS_SMP */ + + ERTS_POLLSET_UNLOCK(ps); + return res; +} + +/* + * --- Wait on poll set ------------------------------------------------------ + */ + +#if ERTS_POLL_USE_KERNEL_POLL + +static ERTS_INLINE int +save_kp_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, int chk_fds_res) +{ + int res = 0; + int i; + int n = chk_fds_res < max_res ? chk_fds_res : max_res; +#if ERTS_POLL_USE_WAKEUP_PIPE + int wake_fd = ps->wake_fds[0]; +#endif + + for (i = 0; i < n; i++) { + +#if ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */ + + if (ps->res_events[i].events) { + int fd = ps->res_events[i].data.fd; + int ix; + ErtsPollEvents revents; +#if ERTS_POLL_USE_WAKEUP_PIPE + if (fd == wake_fd) { + cleanup_wakeup_pipe(ps); + continue; + } +#endif + ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)); + /* epoll_wait() can repeat the same fd in result array... */ + ix = (int) ps->fds_status[fd].res_ev_ix; + ASSERT(ix >= 0); + if (ix >= res || pr[ix].fd != fd) { + ix = res; + pr[ix].fd = fd; + pr[ix].events = (ErtsPollEvents) 0; + } + + revents = ERTS_POLL_EV_N2E(ps->res_events[i].events); + pr[ix].events |= revents; + if (revents) { + if (res == ix) { + ps->fds_status[fd].res_ev_ix = (unsigned short) ix; + res++; + } + } + } + +#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ + + struct kevent *ev; + int fd; + int ix; + + ev = &ps->res_events[i]; + fd = (int) ev->ident; + ASSERT(fd < ps->fds_status_len); + ASSERT(!(ps->fds_status[fd].flags & ERTS_POLL_FD_FLG_INFLBCK)); + ix = (int) ps->fds_status[fd].res_ev_ix; + + ASSERT(ix >= 0); + if (ix >= res || pr[ix].fd != fd) { + ix = res; + pr[ix].fd = (int) ev->ident; + pr[ix].events = (ErtsPollEvents) 0; + } + + if (ev->filter == EVFILT_READ) { +#if ERTS_POLL_USE_WAKEUP_PIPE + if (fd == wake_fd) { + cleanup_wakeup_pipe(ps); + continue; + } +#endif + pr[ix].events |= ERTS_POLL_EV_IN; + } + else if (ev->filter == EVFILT_WRITE) + pr[ix].events |= ERTS_POLL_EV_OUT; + if (ev->flags & (EV_ERROR|EV_EOF)) { + if ((ev->flags & EV_ERROR) && (((int) ev->data) == EBADF)) + pr[ix].events |= ERTS_POLL_EV_NVAL; + else + pr[ix].events |= ERTS_POLL_EV_ERR; + } + if (pr[ix].events) { + if (res == ix) { + ps->fds_status[fd].res_ev_ix = (unsigned short) ix; + res++; + } + } + +#elif ERTS_POLL_USE_DEVPOLL /* --- devpoll ----------------------------- */ + + if (ps->res_events[i].revents) { + int fd = ps->res_events[i].fd; + ErtsPollEvents revents; +#if ERTS_POLL_USE_WAKEUP_PIPE + if (fd == wake_fd) { + cleanup_wakeup_pipe(ps); + continue; + } +#endif + revents = ERTS_POLL_EV_N2E(ps->res_events[i].events); + pr[res].fd = fd; + pr[res].events = revents; + res++; + } + +#endif + + } + + return res; +} + +#endif /* ERTS_POLL_USE_KERNEL_POLL */ + +#if ERTS_POLL_USE_FALLBACK + +static int +get_kp_results(ErtsPollSet ps, ErtsPollResFd pr[], int max_res) +{ + int res; +#if ERTS_POLL_USE_KQUEUE + struct timespec ts = {0, 0}; +#endif + + if (max_res > ps->res_events_len) + grow_res_events(ps, max_res); + + do { +#if ERTS_POLL_USE_EPOLL + res = epoll_wait(ps->kp_fd, ps->res_events, max_res, 0); +#elif ERTS_POLL_USE_KQUEUE + res = kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts); +#endif + } while (res < 0 && errno == EINTR); + + if (res < 0) { + fatal_error("%s:%d: %s() failed: %s (%d)\n", + __FILE__, __LINE__, +#if ERTS_POLL_USE_EPOLL + "epoll_wait", +#elif ERTS_POLL_USE_KQUEUE + "kevent", +#endif + erl_errno_id(errno), errno); + } + + return save_kp_result(ps, pr, max_res, res); +} + +#endif /* ERTS_POLL_USE_FALLBACK */ + + + +static ERTS_INLINE int +save_poll_result(ErtsPollSet ps, ErtsPollResFd pr[], int max_res, + int chk_fds_res, int ebadf) +{ +#if ERTS_POLL_USE_DEVPOLL + return save_kp_result(ps, pr, max_res, chk_fds_res); +#elif ERTS_POLL_USE_FALLBACK + if (!ps->fallback_used) + return save_kp_result(ps, pr, max_res, chk_fds_res); + else +#endif /* ERTS_POLL_USE_FALLBACK */ + { + +#if ERTS_POLL_USE_POLL /* --- poll -------------------------------- */ + int res = 0; +#if ERTS_POLL_USE_WAKEUP_PIPE && !ERTS_POLL_USE_FALLBACK + int wake_fd = ps->wake_fds[0]; +#endif + int i, first_ix, end_ix; + + /* + * In order to be somewhat fair, we continue on the poll_fds + * index where we stopped last time. + */ + first_ix = i = ((ps->next_poll_fds_ix < ps->no_poll_fds) + ? ps->next_poll_fds_ix + : 0); + end_ix = ps->no_poll_fds; + + while (1) { + while (i < end_ix && res < max_res) { + if (ps->poll_fds[i].revents != (short) 0) { + int fd = ps->poll_fds[i].fd; + ErtsPollEvents revents; +#if ERTS_POLL_USE_FALLBACK + if (fd == ps->kp_fd) { + res += get_kp_results(ps, &pr[res], max_res-res); + i++; + continue; + } +#elif ERTS_POLL_USE_WAKEUP_PIPE + if (fd == wake_fd) { + cleanup_wakeup_pipe(ps); + i++; + continue; + } +#endif + revents = pollev2ev(ps->poll_fds[i].revents); + pr[res].fd = fd; + pr[res].events = revents; + res++; + } + i++; + } + if (res == max_res || i == first_ix) + break; + ASSERT(i == ps->no_poll_fds); + i = 0; + end_ix = first_ix; + } + + ps->next_poll_fds_ix = i; + return res; + +#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ + int res = 0; +#if ERTS_POLL_USE_WAKEUP_PIPE && !ERTS_POLL_USE_FALLBACK + int wake_fd = ps->wake_fds[0]; +#endif + int fd, first_fd, end_fd; + + /* + * In order to be fair, we continue on the fd where we stopped + * last time. + */ + first_fd = fd = ps->next_sel_fd <= ps->max_fd ? ps->next_sel_fd : 0; + end_fd = ps->max_fd + 1; + + if (!ebadf) { + while (1) { + while (fd < end_fd && res < max_res) { + + pr[res].events = (ErtsPollEvents) 0; + if (FD_ISSET(fd, &ps->res_input_fds)) { +#if ERTS_POLL_USE_FALLBACK + if (fd == ps->kp_fd) { + res += get_kp_results(ps, &pr[res], max_res-res); + fd++; + continue; + } +#elif ERTS_POLL_USE_WAKEUP_PIPE + if (fd == wake_fd) { + cleanup_wakeup_pipe(ps); + fd++; + continue; + } +#endif + pr[res].events |= ERTS_POLL_EV_IN; + } + if (FD_ISSET(fd, &ps->res_output_fds)) + pr[res].events |= ERTS_POLL_EV_OUT; + if (pr[res].events) { + pr[res].fd = fd; + res++; + } + fd++; + } + if (res == max_res || fd == first_fd) + break; + ASSERT(fd == ps->max_fd + 1); + fd = 0; + end_fd = first_fd; + } + } + else { + /* + * Bad file descriptors in poll set. + * + * This only happens when running poorly written + * drivers. This code could be optimized, but we + * don't bother since it should never happen... + */ + while (1) { + while (fd < end_fd && res < max_res) { + if (ps->fds_status[fd].events) { + int sres; + fd_set *iset = NULL; + fd_set *oset = NULL; + if (ps->fds_status[fd].events & ERTS_POLL_EV_IN) { + iset = &ps->res_input_fds; + FD_ZERO(iset); + FD_SET(fd, iset); + } + if (ps->fds_status[fd].events & ERTS_POLL_EV_OUT) { + oset = &ps->res_output_fds; + FD_ZERO(oset); + FD_SET(fd, oset); + + } + do { + /* Initiate 'tv' each time; + select() may modify it */ + SysTimeval tv = {0, 0}; + sres = select(ps->max_fd+1, iset, oset, NULL, &tv); + } while (sres < 0 && errno == EINTR); + if (sres < 0) { +#if ERTS_POLL_USE_FALLBACK + if (fd == ps->kp_fd) { + res += get_kp_results(ps, + &pr[res], + max_res-res); + fd++; + continue; + } +#elif ERTS_POLL_USE_WAKEUP_PIPE + if (fd == wake_fd) { + cleanup_wakeup_pipe(ps); + fd++; + continue; + } +#endif + pr[res].fd = fd; + pr[res].events = ERTS_POLL_EV_NVAL; + res++; + } + else if (sres > 0) { + pr[res].fd = fd; + if (iset && FD_ISSET(fd, iset)) { +#if ERTS_POLL_USE_FALLBACK + if (fd == ps->kp_fd) { + res += get_kp_results(ps, + &pr[res], + max_res-res); + fd++; + continue; + } +#elif ERTS_POLL_USE_WAKEUP_PIPE + if (fd == wake_fd) { + cleanup_wakeup_pipe(ps); + fd++; + continue; + } +#endif + pr[res].events |= ERTS_POLL_EV_IN; + } + if (oset && FD_ISSET(fd, oset)) { + pr[res].events |= ERTS_POLL_EV_OUT; + } + ASSERT(pr[res].events); + res++; + } + } + fd++; + } + if (res == max_res || fd == first_fd) + break; + ASSERT(fd == ps->max_fd + 1); + fd = 0; + end_fd = first_fd; + } + } + ps->next_sel_fd = fd; + return res; +#endif + } +} + +static ERTS_INLINE int +check_fd_events(ErtsPollSet ps, SysTimeval *tv, int max_res, int *ps_locked) +{ + ASSERT(!*ps_locked); + if (ps->no_of_user_fds == 0 && tv->tv_usec == 0 && tv->tv_sec == 0) { + /* Nothing to poll and zero timeout; done... */ + return 0; + } + else { + long timeout = tv->tv_sec*1000 + tv->tv_usec/1000; + ASSERT(timeout >= 0); + erts_smp_atomic_set(&ps->timeout, timeout); +#if ERTS_POLL_USE_FALLBACK + if (!(ps->fallback_used = ERTS_POLL_NEED_FALLBACK(ps))) { + +#if ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */ + if (timeout > INT_MAX) + timeout = INT_MAX; + if (max_res > ps->res_events_len) + grow_res_events(ps, max_res); + return epoll_wait(ps->kp_fd, ps->res_events, max_res, (int)timeout); +#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ + struct timespec ts; + ts.tv_sec = tv->tv_sec; + ts.tv_nsec = tv->tv_usec*1000; + if (max_res > ps->res_events_len) + grow_res_events(ps, max_res); + return kevent(ps->kp_fd, NULL, 0, ps->res_events, max_res, &ts); +#endif /* ----------------------------------------- */ + + } + else /* use fallback (i.e. poll() or select()) */ +#endif /* ERTS_POLL_USE_FALLBACK */ + { + +#if ERTS_POLL_USE_DEVPOLL /* --- devpoll ----------------------------- */ + /* + * The ioctl() will fail with EINVAL on Solaris 10 if dp_nfds + * is set too high. dp_nfds should not be set greater than + * the maximum number of file descriptors in the poll set. + */ + struct dvpoll poll_res; + int nfds = ps->no_of_user_fds; +#ifdef ERTS_SMP + nfds++; /* Wakeup pipe */ +#endif + if (timeout > INT_MAX) + timeout = INT_MAX; + poll_res.dp_nfds = nfds < max_res ? nfds : max_res; + if (poll_res.dp_nfds > ps->res_events_len) + grow_res_events(ps, poll_res.dp_nfds); + poll_res.dp_fds = ps->res_events; + poll_res.dp_timeout = (int) timeout; + return ioctl(ps->kp_fd, DP_POLL, &poll_res); +#elif ERTS_POLL_USE_POLL /* --- poll -------------------------------- */ + if (timeout > INT_MAX) + timeout = INT_MAX; + return poll(ps->poll_fds, ps->no_poll_fds, (int) timeout); +#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ + int res; + ps->res_input_fds = ps->input_fds; + ps->res_output_fds = ps->output_fds; + res = select(ps->max_fd + 1, + &ps->res_input_fds, + &ps->res_output_fds, + NULL, + tv); +#ifdef ERTS_SMP + if (res < 0 + && errno == EBADF + && ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) { + /* + * This may have happened because another thread deselected + * a fd in our poll set and then closed it, i.e. the driver + * behaved correctly. We wan't to avoid looking for a bad + * fd, that may even not exist anymore. Therefore, handle + * update requests and try again. + * + * We don't know how much of the timeout is left; therfore, + * we use a zero timeout. If no error occur and no events + * have triggered, we fake an EAGAIN error and let the caller + * restart us. + */ + SysTimeval zero_tv = {0, 0}; + *ps_locked = 1; + ERTS_POLLSET_LOCK(ps); + handle_update_requests(ps); + res = select(ps->max_fd + 1, + &ps->res_input_fds, + &ps->res_output_fds, + NULL, + &zero_tv); + if (res == 0) { + errno = EAGAIN; + res = -1; + } + } +#endif /* ERTS_SMP */ + return res; +#endif /* ----------------------------------------- */ + } + } +} + +int +ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet ps, + ErtsPollResFd pr[], + int *len, + SysTimeval *utvp) +{ + int res, no_fds; + int ebadf = 0; + int ps_locked; + SysTimeval *tvp; + SysTimeval itv; + + no_fds = *len; +#ifdef ERTS_POLL_MAX_RES + if (no_fds >= ERTS_POLL_MAX_RES) + no_fds = ERTS_POLL_MAX_RES; +#endif + + *len = 0; + + ASSERT(utvp); + + tvp = utvp; + +#ifdef ERTS_POLL_DEBUG_PRINT + erts_printf("Entering erts_poll_wait(), timeout=%d\n", + (int) tv->tv_sec*1000 + tv->tv_usec/1000); +#endif + + ERTS_POLLSET_UNSET_POLLER_WOKEN(ps); + if (ERTS_POLLSET_SET_POLLED_CHK(ps)) { + res = EINVAL; /* Another thread is in erts_poll_wait() + on this pollset... */ + goto done; + } + + if (ERTS_POLLSET_IS_INTERRUPTED(ps)) { + /* Interrupt use zero timeout */ + itv.tv_sec = 0; + itv.tv_usec = 0; + tvp = &itv; + } + +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + if (ERTS_POLLSET_HAVE_UPDATE_REQUESTS(ps)) { + ERTS_POLLSET_LOCK(ps); + handle_update_requests(ps); + ERTS_POLLSET_UNLOCK(ps); + } +#endif + + ps_locked = 0; + res = check_fd_events(ps, tvp, no_fds, &ps_locked); + + ERTS_POLLSET_SET_POLLER_WOKEN(ps); + + if (res == 0) { + res = ETIMEDOUT; + } + else if (res < 0) { +#if ERTS_POLL_USE_SELECT + if (errno == EBADF) { + ebadf = 1; + goto save_results; + } +#endif + res = errno; + } + else { +#if ERTS_POLL_USE_SELECT + save_results: +#endif + +#ifdef ERTS_SMP + if (!ps_locked) { + ps_locked = 1; + ERTS_POLLSET_LOCK(ps); + } +#endif + + no_fds = save_poll_result(ps, pr, no_fds, res, ebadf); + +#ifdef HARD_DEBUG + check_poll_result(pr, no_fds); +#endif + + res = (no_fds == 0 + ? (ERTS_POLLSET_UNSET_INTERRUPTED_CHK(ps) ? EINTR : EAGAIN) + : 0); + *len = no_fds; + } + +#ifdef ERTS_SMP + if (ps_locked) + ERTS_POLLSET_UNLOCK(ps); + ERTS_POLLSET_UNSET_POLLED(ps); +#endif + + done: + erts_smp_atomic_set(&ps->timeout, LONG_MAX); +#ifdef ERTS_POLL_DEBUG_PRINT + erts_printf("Leaving %s = erts_poll_wait()\n", + res == 0 ? "0" : erl_errno_id(res)); +#endif + + return res; +} + +/* + * --- Interrupt a thread doing erts_poll_wait() ----------------------------- + */ + +void +ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet ps, int set) +{ + /* + * NOTE: This function might be called from signal handlers in the + * non-smp case; therefore, it has to be async-signal safe in + * the non-smp case. + */ + if (set) { + ERTS_POLLSET_SET_INTERRUPTED(ps); +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) + wake_poller(ps); +#endif + } + else { + ERTS_POLLSET_UNSET_INTERRUPTED(ps); + } +} + +/* + * erts_poll_interrupt_timed(): + * If 'set' != 0, interrupt thread blocked in erts_poll_wait() if it + * is not guaranteed that it will timeout before 'msec' milli seconds. + */ +void +ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet ps, int set, long msec) +{ + if (set) { + if (erts_smp_atomic_read(&ps->timeout) > msec) { + ERTS_POLLSET_SET_INTERRUPTED(ps); +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT || defined(ERTS_SMP) + wake_poller(ps); +#endif + } +#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS + else { + if (ERTS_POLLSET_IS_POLLED(ps)) + erts_smp_atomic_inc(&ps->no_avoided_wakeups); + erts_smp_atomic_inc(&ps->no_avoided_interrupts); + } + erts_smp_atomic_inc(&ps->no_interrupt_timed); +#endif + } + else { + ERTS_POLLSET_UNSET_INTERRUPTED(ps); + } +} + +int +ERTS_POLL_EXPORT(erts_poll_max_fds)(void) +{ + return max_fds; +} +/* + * --- Initialization -------------------------------------------------------- + */ + +#ifdef VXWORKS +extern int erts_vxworks_max_files; +#endif + +void +ERTS_POLL_EXPORT(erts_poll_init)(void) +{ + erts_smp_spinlock_init(&pollsets_lock, "pollsets_lock"); + pollsets = NULL; + + errno = 0; + +#if defined(VXWORKS) + max_fds = erts_vxworks_max_files; +#elif !defined(NO_SYSCONF) + max_fds = sysconf(_SC_OPEN_MAX); +#elif ERTS_POLL_USE_SELECT + max_fds = NOFILE; +#else + max_fds = OPEN_MAX; +#endif + +#if ERTS_POLL_USE_SELECT && defined(FD_SETSIZE) + if (max_fds > FD_SETSIZE) + max_fds = FD_SETSIZE; +#endif + + if (max_fds < 0) + fatal_error("erts_poll_init(): Failed to get max number of files: %s\n", + erl_errno_id(errno)); + +#ifdef ERTS_POLL_DEBUG_PRINT + print_misc_debug_info(); +#endif +} + +ErtsPollSet +ERTS_POLL_EXPORT(erts_poll_create_pollset)(void) +{ +#if ERTS_POLL_USE_KERNEL_POLL + int kp_fd; +#endif + ErtsPollSet ps = erts_alloc(ERTS_ALC_T_POLLSET, + sizeof(struct ErtsPollSet_)); + ps->internal_fd_limit = 0; + ps->fds_status = NULL; + ps->fds_status_len = 0; + ps->no_of_user_fds = 0; +#if ERTS_POLL_USE_KERNEL_POLL + ps->kp_fd = -1; +#if ERTS_POLL_USE_EPOLL + kp_fd = epoll_create(256); + ps->res_events_len = 0; + ps->res_events = NULL; +#elif ERTS_POLL_USE_DEVPOLL + kp_fd = open("/dev/poll", O_RDWR); + ps->res_events_len = 0; + ps->res_events = NULL; +#elif ERTS_POLL_USE_KQUEUE + kp_fd = kqueue(); + ps->res_events_len = 0; + ps->res_events = NULL; +#endif + if (kp_fd < 0) + fatal_error("erts_poll_create_pollset(): Failed to " +#if ERTS_POLL_USE_EPOLL + "create epoll set" +#elif ERTS_POLL_USE_DEVPOLL + "to open /dev/poll" +#elif ERTS_POLL_USE_KQUEUE + "create kqueue" +#endif + ": %s (%d)\n", + erl_errno_id(errno), errno); +#endif /* ERTS_POLL_USE_KERNEL_POLL */ +#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET + /* res_events is also used as write buffer */ + grow_res_events(ps, ERTS_POLL_MIN_BATCH_BUF_SIZE); +#endif +#if ERTS_POLL_USE_POLL + ps->next_poll_fds_ix = 0; + ps->no_poll_fds = 0; + ps->poll_fds_len = 0; + ps->poll_fds = NULL; +#elif ERTS_POLL_USE_SELECT + ps->next_sel_fd = 0; + ps->max_fd = -1; +#if ERTS_POLL_USE_FALLBACK + ps->no_select_fds = 0; +#endif + FD_ZERO(&ps->input_fds); + FD_ZERO(&ps->res_input_fds); + FD_ZERO(&ps->output_fds); + FD_ZERO(&ps->res_output_fds); +#endif +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + ps->update_requests.next = NULL; + ps->update_requests.len = 0; + ps->curr_upd_req_block = &ps->update_requests; + erts_smp_atomic_init(&ps->have_update_requests, 0); +#endif +#ifdef ERTS_SMP + erts_smp_atomic_init(&ps->polled, 0); + erts_smp_atomic_init(&ps->woken, 0); + erts_smp_mtx_init(&ps->mtx, "pollset"); +#elif ERTS_POLL_ASYNC_INTERRUPT_SUPPORT + ps->woken = 0; +#endif +#if ERTS_POLL_USE_WAKEUP_PIPE + create_wakeup_pipe(ps); +#endif +#if ERTS_POLL_USE_FALLBACK + if (kp_fd >= ps->fds_status_len) + grow_fds_status(ps, kp_fd); + /* Force kernel poll fd into fallback (poll/select) set */ + ps->fds_status[kp_fd].flags + |= ERTS_POLL_FD_FLG_INFLBCK|ERTS_POLL_FD_FLG_USEFLBCK; + { + int do_wake = 0; + ERTS_POLL_EXPORT(erts_poll_control)(ps, kp_fd, ERTS_POLL_EV_IN, 1, + &do_wake); + } +#endif +#if ERTS_POLL_USE_KERNEL_POLL + if (ps->internal_fd_limit <= kp_fd) + ps->internal_fd_limit = kp_fd + 1; + ps->kp_fd = kp_fd; +#endif +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) + ps->interrupt = 0; +#else + erts_smp_atomic_init(&ps->interrupt, 0); +#endif + erts_smp_atomic_init(&ps->timeout, LONG_MAX); +#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS + erts_smp_atomic_init(&ps->no_avoided_wakeups, 0); + erts_smp_atomic_init(&ps->no_avoided_interrupts, 0); + erts_smp_atomic_init(&ps->no_interrupt_timed, 0); +#endif +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + handle_update_requests(ps); +#endif +#if ERTS_POLL_USE_FALLBACK + ps->fallback_used = 0; +#endif + ps->no_of_user_fds = 0; /* Don't count wakeup pipe and fallback fd */ + + erts_smp_spin_lock(&pollsets_lock); + ps->next = pollsets; + pollsets = ps; + erts_smp_spin_unlock(&pollsets_lock); + + return ps; +} + +void +ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet ps) +{ + + if (ps->fds_status) + erts_free(ERTS_ALC_T_FD_STATUS, (void *) ps->fds_status); + +#if ERTS_POLL_USE_EPOLL + if (ps->kp_fd >= 0) + close(ps->kp_fd); + if (ps->res_events) + erts_free(ERTS_ALC_T_POLL_RES_EVS, (void *) ps->res_events); +#elif ERTS_POLL_USE_DEVPOLL + if (ps->kp_fd >= 0) + close(ps->kp_fd); + if (ps->res_events) + erts_free(ERTS_ALC_T_POLL_RES_EVS, (void *) ps->res_events); +#elif ERTS_POLL_USE_POLL + if (ps->poll_fds) + erts_free(ERTS_ALC_T_POLL_FDS, (void *) ps->poll_fds); +#elif ERTS_POLL_USE_SELECT +#endif +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + { + ErtsPollSetUpdateRequestsBlock *urqbp = ps->update_requests.next; + while (urqbp) { + ErtsPollSetUpdateRequestsBlock *free_urqbp = urqbp; + urqbp = urqbp->next; + free_update_requests_block(ps, free_urqbp); + } + } +#endif +#ifdef ERTS_SMP + erts_smp_mtx_destroy(&ps->mtx); +#endif +#if ERTS_POLL_USE_WAKEUP_PIPE + if (ps->wake_fds[0] >= 0) + close(ps->wake_fds[0]); + if (ps->wake_fds[1] >= 0) + close(ps->wake_fds[1]); +#endif + + erts_smp_spin_lock(&pollsets_lock); + if (ps == pollsets) + pollsets = pollsets->next; + else { + ErtsPollSet prev_ps; + for (prev_ps = pollsets; ps != prev_ps->next; prev_ps = prev_ps->next); + ASSERT(ps == prev_ps->next); + prev_ps->next = ps->next; + } + erts_smp_spin_unlock(&pollsets_lock); + + erts_free(ERTS_ALC_T_POLLSET, (void *) ps); +} + +/* + * --- Info ------------------------------------------------------------------ + */ + +void +ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet ps, ErtsPollInfo *pip) +{ +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + int pending_updates; +#endif + Uint size = 0; + + ERTS_POLLSET_LOCK(ps); + + size += sizeof(struct ErtsPollSet_); + size += ps->fds_status_len*sizeof(ErtsFdStatus); + +#if ERTS_POLL_USE_EPOLL + size += ps->res_events_len*sizeof(struct epoll_event); +#elif ERTS_POLL_USE_DEVPOLL + size += ps->res_events_len*sizeof(struct pollfd); +#elif ERTS_POLL_USE_KQUEUE + size += ps->res_events_len*sizeof(struct kevent); +#endif + +#if ERTS_POLL_USE_POLL + size += ps->poll_fds_len*sizeof(struct pollfd); +#elif ERTS_POLL_USE_SELECT +#endif + +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + { + ErtsPollSetUpdateRequestsBlock *urqbp = ps->update_requests.next; + pending_updates = ps->update_requests.len; + while (urqbp) { + size += sizeof(ErtsPollSetUpdateRequestsBlock); + pending_updates += urqbp->len; + } + } +#endif + + pip->primary = +#if ERTS_POLL_USE_KQUEUE + "kqueue" +#elif ERTS_POLL_USE_EPOLL + "epoll" +#elif ERTS_POLL_USE_DEVPOLL + "/dev/poll" +#elif ERTS_POLL_USE_POLL + "poll" +#elif ERTS_POLL_USE_SELECT + "select" +#endif + ; + + pip->fallback = +#if !ERTS_POLL_USE_FALLBACK + NULL +#elif ERTS_POLL_USE_POLL + "poll" +#elif ERTS_POLL_USE_SELECT + "select" +#endif + ; + + pip->kernel_poll = +#if !ERTS_POLL_USE_KERNEL_POLL + NULL +#elif ERTS_POLL_USE_KQUEUE + "kqueue" +#elif ERTS_POLL_USE_EPOLL + "epoll" +#elif ERTS_POLL_USE_DEVPOLL + "/dev/poll" +#endif + ; + + pip->memory_size = size; + + pip->poll_set_size = ps->no_of_user_fds; +#ifdef ERTS_SMP + pip->poll_set_size++; /* Wakeup pipe */ +#endif + + pip->fallback_poll_set_size = +#if !ERTS_POLL_USE_FALLBACK + 0 +#elif ERTS_POLL_USE_POLL + ps->no_poll_fds +#elif ERTS_POLL_USE_SELECT + ps->no_select_fds +#endif + ; + +#if ERTS_POLL_USE_FALLBACK + /* If only kp_fd is in fallback poll set we don't use fallback... */ + if (pip->fallback_poll_set_size == 1) + pip->fallback_poll_set_size = 0; + else + pip->poll_set_size++; /* kp_fd */ +#endif + + pip->lazy_updates = +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + 1 +#else + 0 +#endif + ; + + pip->pending_updates = +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + pending_updates +#else + 0 +#endif + ; + + pip->batch_updates = +#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET + 1 +#else + 0 +#endif + ; + + pip->concurrent_updates = +#if ERTS_POLL_USE_CONCURRENT_UPDATE + 1 +#else + 0 +#endif + ; + + pip->max_fds = max_fds; + +#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS + pip->no_avoided_wakeups = erts_smp_atomic_read(&ps->no_avoided_wakeups); + pip->no_avoided_interrupts = erts_smp_atomic_read(&ps->no_avoided_interrupts); + pip->no_interrupt_timed = erts_smp_atomic_read(&ps->no_interrupt_timed); +#endif + + ERTS_POLLSET_UNLOCK(ps); + +} + +/* + * Fatal error... + */ + +#ifndef ERTS_GOT_SIGUSR1 +# define ERTS_GOT_SIGUSR1 0 +#endif + +static void +fatal_error(char *format, ...) +{ + va_list ap; + + if (ERTS_IS_CRASH_DUMPING || ERTS_GOT_SIGUSR1) { + /* + * Crash dump writing and reception of sigusr1 (which will + * result in a crash dump) closes all file descriptors. This + * typically results in a fatal error for erts_poll() (wakeup + * pipes and kernel poll fds are closed). + * + * We ignore the error and let the crash dump writing continue... + */ + return; + } + va_start(ap, format); + erts_vfprintf(stderr, format, ap); + va_end(ap); + abort(); +} + +static void +fatal_error_async_signal_safe(char *error_str) +{ + if (ERTS_IS_CRASH_DUMPING || ERTS_GOT_SIGUSR1) { + /* See comment above in fatal_error() */ + return; + } + if (error_str) { + int len = 0; + while (error_str[len]) + len++; + if (len) + (void) write(2, error_str, len); /* async signal safe */ + } + abort(); +} + +/* + * --- Debug ----------------------------------------------------------------- + */ + +void +ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet ps, + ErtsPollEvents ev[], + int len) +{ + int fd; + ERTS_POLLSET_LOCK(ps); + for (fd = 0; fd < len; fd++) { + if (fd >= ps->fds_status_len) + ev[fd] = 0; + else { + ev[fd] = ps->fds_status[fd].events; +#if ERTS_POLL_USE_WAKEUP_PIPE + if (fd == ps->wake_fds[0] || fd == ps->wake_fds[1]) + ev[fd] |= ERTS_POLL_EV_NVAL; +#endif +#if ERTS_POLL_USE_KERNEL_POLL + if (fd == ps->kp_fd) + ev[fd] |= ERTS_POLL_EV_NVAL; +#endif + } + } + ERTS_POLLSET_UNLOCK(ps); + +} + +#ifdef HARD_DEBUG + +static void +check_poll_result(ErtsPollResFd pr[], int len) +{ + int i, j; + + for (i = 0; i < len; i++) { + ASSERT(pr[i].fd >= 0); + ASSERT(pr[i].fd < max_fds); + for (j = 0; j < len; j++) { + ASSERT(i == j || pr[i].fd != pr[j].fd); + } + } +} + + +#if ERTS_POLL_USE_DEVPOLL + +static void +check_poll_status(ErtsPollSet ps) +{ + int i; + for (i = 0; i < ps->fds_status_len; i++) { + int ires; + struct pollfd dp_fd; + short events = ERTS_POLL_EV_E2N(ps->fds_status[i].events); + + dp_fd.fd = i; + dp_fd.events = (short) 0; + dp_fd.revents = (short) 0; + + ires = ioctl(ps->kp_fd, DP_ISPOLLED, &dp_fd); + + if (ires == 0) { + ASSERT(!events); + } + else if (ires == 1) { + ASSERT(events); + ASSERT(events == dp_fd.revents); + } + else { + ASSERT(0); + } + ASSERT(dp_fd.fd == i); + ASSERT(ps->fds_status[i].events == ps->fds_status[i].used_events); + } +} + +#endif /* ERTS_POLL_USE_DEVPOLL */ +#endif /* HARD_DEBUG */ + +#ifdef ERTS_POLL_DEBUG_PRINT +static void +print_misc_debug_info(void) +{ + erts_printf("erts_poll using: %s lazy_updates:%s batch_updates:%s\n", +#if ERTS_POLL_USE_KQUEUE + "kqueue" +#elif ERTS_POLL_USE_EPOLL + "epoll" +#elif ERTS_POLL_USE_DEVPOLL + "/dev/poll" +#endif +#if ERTS_POLL_USE_FALLBACK + "-" +#endif +#if ERTS_POLL_USE_POLL + "poll" +#elif ERTS_POLL_USE_SELECT + "select" +#endif + , +#if ERTS_POLL_USE_UPDATE_REQUESTS_QUEUE + "true" +#else + "false" +#endif + , +#if ERTS_POLL_USE_BATCH_UPDATE_POLLSET + "true" +#else + "false" +#endif + ); + + erts_printf("ERTS_POLL_EV_IN=0x%x\n" + "ERTS_POLL_EV_OUT=0x%x\n" + "ERTS_POLL_EV_NVAL=0x%x\n" + "ERTS_POLL_EV_ERR=0x%x\n", + ERTS_POLL_EV_IN, + ERTS_POLL_EV_OUT, + ERTS_POLL_EV_NVAL, + ERTS_POLL_EV_ERR); + +#ifdef FD_SETSIZE + erts_printf("FD_SETSIZE=%d\n", FD_SETSIZE); +#endif +} + +#endif diff --git a/erts/emulator/sys/common/erl_poll.h b/erts/emulator/sys/common/erl_poll.h new file mode 100644 index 0000000000..725a77a152 --- /dev/null +++ b/erts/emulator/sys/common/erl_poll.h @@ -0,0 +1,246 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Poll interface suitable for ERTS with or without + * SMP support. + * + * Author: Rickard Green + */ + +#ifndef ERL_POLL_H__ +#define ERL_POLL_H__ + +#include "sys.h" + +#if 0 +#define ERTS_POLL_COUNT_AVOIDED_WAKEUPS +#endif + +#ifdef ERTS_ENABLE_KERNEL_POLL +# if defined(ERTS_KERNEL_POLL_VERSION) +# define ERTS_POLL_EXPORT(FUNC) FUNC ## _kp +# else +# define ERTS_POLL_EXPORT(FUNC) FUNC ## _nkp +# undef ERTS_POLL_DISABLE_KERNEL_POLL +# define ERTS_POLL_DISABLE_KERNEL_POLL +# endif +#else +# define ERTS_POLL_EXPORT(FUNC) FUNC +# undef ERTS_POLL_DISABLE_KERNEL_POLL +# define ERTS_POLL_DISABLE_KERNEL_POLL +#endif + +#ifdef ERTS_POLL_DISABLE_KERNEL_POLL +# undef HAVE_SYS_EPOLL_H +# undef HAVE_SYS_EVENT_H +# undef HAVE_SYS_DEVPOLL_H +#endif + +#undef ERTS_POLL_USE_KERNEL_POLL +#define ERTS_POLL_USE_KERNEL_POLL 0 + +#undef ERTS_POLL_USE_KQUEUE +#define ERTS_POLL_USE_KQUEUE 0 +#undef ERTS_POLL_USE_EPOLL +#define ERTS_POLL_USE_EPOLL 0 +#undef ERTS_POLL_USE_DEVPOLL +#define ERTS_POLL_USE_DEVPOLL 0 +#undef ERTS_POLL_USE_POLL +#define ERTS_POLL_USE_POLL 0 +#undef ERTS_POLL_USE_SELECT +#define ERTS_POLL_USE_SELECT 0 + +#if defined(HAVE_SYS_EVENT_H) +# undef ERTS_POLL_USE_KQUEUE +# define ERTS_POLL_USE_KQUEUE 1 +# undef ERTS_POLL_USE_KERNEL_POLL +# define ERTS_POLL_USE_KERNEL_POLL 1 +#elif defined(HAVE_SYS_EPOLL_H) +# undef ERTS_POLL_USE_EPOLL +# define ERTS_POLL_USE_EPOLL 1 +# undef ERTS_POLL_USE_KERNEL_POLL +# define ERTS_POLL_USE_KERNEL_POLL 1 +#elif defined(HAVE_SYS_DEVPOLL_H) +# undef ERTS_POLL_USE_DEVPOLL +# define ERTS_POLL_USE_DEVPOLL 1 +# undef ERTS_POLL_USE_KERNEL_POLL +# define ERTS_POLL_USE_KERNEL_POLL 1 +#endif + +#define ERTS_POLL_USE_FALLBACK (ERTS_POLL_USE_KQUEUE || ERTS_POLL_USE_EPOLL) + +#if !ERTS_POLL_USE_KERNEL_POLL || ERTS_POLL_USE_FALLBACK +# if defined(ERTS_USE_POLL) +# undef ERTS_POLL_USE_POLL +# define ERTS_POLL_USE_POLL 1 +# elif !defined(__WIN32__) +# undef ERTS_POLL_USE_SELECT +# define ERTS_POLL_USE_SELECT 1 +# endif +#endif + +typedef Uint32 ErtsPollEvents; +#undef ERTS_POLL_EV_E2N + +#if defined(__WIN32__) /* --- win32 ------------------------------- */ + +#define ERTS_POLL_EV_IN 1 +#define ERTS_POLL_EV_OUT 2 +#define ERTS_POLL_EV_ERR 4 +#define ERTS_POLL_EV_NVAL 8 + +#elif ERTS_POLL_USE_EPOLL /* --- epoll ------------------------------- */ + +#include + +#define ERTS_POLL_EV_E2N(EV) \ + ((__uint32_t) (EV)) +#define ERTS_POLL_EV_N2E(EV) \ + ((ErtsPollEvents) (EV)) + +#define ERTS_POLL_EV_IN ERTS_POLL_EV_N2E(EPOLLIN) +#define ERTS_POLL_EV_OUT ERTS_POLL_EV_N2E(EPOLLOUT) +#define ERTS_POLL_EV_NVAL ERTS_POLL_EV_N2E(EPOLLET) +#define ERTS_POLL_EV_ERR ERTS_POLL_EV_N2E(EPOLLERR|EPOLLHUP) + +#elif ERTS_POLL_USE_DEVPOLL /* --- devpoll ----------------------------- */ + +#include + +#define ERTS_POLL_EV_E2N(EV) \ + ((short) ((EV) & ~((~((ErtsPollEvents) 0)) << 8*SIZEOF_SHORT))) +#define ERTS_POLL_EV_N2E(EV) \ + ((ErtsPollEvents) ((unsigned short) (EV))) + +#define ERTS_POLL_EV_IN ERTS_POLL_EV_N2E(POLLIN) +#define ERTS_POLL_EV_OUT ERTS_POLL_EV_N2E(POLLOUT) +#define ERTS_POLL_EV_NVAL ERTS_POLL_EV_N2E(POLLNVAL) +#define ERTS_POLL_EV_ERR ERTS_POLL_EV_N2E(POLLERR|POLLHUP) + +#elif ERTS_POLL_USE_KQUEUE /* --- kqueue ------------------------------ */ +/* Kqueue use fallback defines (poll() or select()) */ +#endif + +#if ERTS_POLL_USE_POLL /* --- poll -------------------------------- */ + +#include + +#define ERTS_POLL_EV_NKP_E2N(EV) \ + ((short) ((EV) & ~((~((ErtsPollEvents) 0)) << 8*SIZEOF_SHORT))) +#define ERTS_POLL_EV_NKP_N2E(EV) \ + ((ErtsPollEvents) ((unsigned short) (EV))) + +/* At least on FreeBSD, we need POLLRDNORM for normal files, not POLLIN. */ +/* Whether this is a bug in FreeBSD, I don't know. */ +#ifdef POLLRDNORM +#define ERTS_POLL_EV_NKP_IN ERTS_POLL_EV_N2E(POLLIN|POLLRDNORM) +#else +#define ERTS_POLL_EV_NKP_IN ERTS_POLL_EV_N2E(POLLIN) +#endif +#define ERTS_POLL_EV_NKP_OUT ERTS_POLL_EV_N2E(POLLOUT) +#define ERTS_POLL_EV_NKP_NVAL ERTS_POLL_EV_N2E(POLLNVAL) +#define ERTS_POLL_EV_NKP_ERR ERTS_POLL_EV_N2E(POLLERR|POLLHUP) + +#elif ERTS_POLL_USE_SELECT /* --- select ------------------------------ */ + +#define ERTS_POLL_EV_NKP_E2N(EV) (EV) +#define ERTS_POLL_EV_NKP_N2E(EV) (EV) + +#define ERTS_POLL_EV_NKP_IN (((ErtsPollEvents) 1) << 0) +#define ERTS_POLL_EV_NKP_OUT (((ErtsPollEvents) 1) << 1) +#define ERTS_POLL_EV_NKP_NVAL (((ErtsPollEvents) 1) << 2) +#define ERTS_POLL_EV_NKP_ERR (((ErtsPollEvents) 1) << 3) + +#endif /* ----------------------------------------- */ + + +#if !defined(ERTS_POLL_EV_E2N) && defined(ERTS_POLL_EV_NKP_E2N) +/* poll(), select(), and kqueue() */ + +#define ERTS_POLL_EV_E2N(EV) ERTS_POLL_EV_NKP_E2N((EV)) +#define ERTS_POLL_EV_N2E(EV) ERTS_POLL_EV_NKP_N2E((EV)) + +#define ERTS_POLL_EV_IN ERTS_POLL_EV_NKP_IN +#define ERTS_POLL_EV_OUT ERTS_POLL_EV_NKP_OUT +#define ERTS_POLL_EV_NVAL ERTS_POLL_EV_NKP_NVAL +#define ERTS_POLL_EV_ERR ERTS_POLL_EV_NKP_ERR + +#endif + +typedef struct ErtsPollSet_ *ErtsPollSet; + +typedef struct { + ErtsSysFdType fd; + ErtsPollEvents events; + int on; +} ErtsPollControlEntry; + +typedef struct { + ErtsSysFdType fd; + ErtsPollEvents events; +} ErtsPollResFd; + +typedef struct { + char *primary; + char *fallback; + char *kernel_poll; + Uint memory_size; + int poll_set_size; + int fallback_poll_set_size; + int lazy_updates; + int pending_updates; + int batch_updates; + int concurrent_updates; + int max_fds; +#ifdef ERTS_POLL_COUNT_AVOIDED_WAKEUPS + long no_avoided_wakeups; + long no_avoided_interrupts; + long no_interrupt_timed; +#endif +} ErtsPollInfo; + +void ERTS_POLL_EXPORT(erts_poll_interrupt)(ErtsPollSet, + int); +void ERTS_POLL_EXPORT(erts_poll_interrupt_timed)(ErtsPollSet, + int, + long); +ErtsPollEvents ERTS_POLL_EXPORT(erts_poll_control)(ErtsPollSet, + ErtsSysFdType, + ErtsPollEvents, + int on, + int* wake_poller); +void ERTS_POLL_EXPORT(erts_poll_controlv)(ErtsPollSet, + ErtsPollControlEntry [], + int on); +int ERTS_POLL_EXPORT(erts_poll_wait)(ErtsPollSet, + ErtsPollResFd [], + int *, + SysTimeval *); +int ERTS_POLL_EXPORT(erts_poll_max_fds)(void); +void ERTS_POLL_EXPORT(erts_poll_info)(ErtsPollSet, + ErtsPollInfo *); +ErtsPollSet ERTS_POLL_EXPORT(erts_poll_create_pollset)(void); +void ERTS_POLL_EXPORT(erts_poll_destroy_pollset)(ErtsPollSet); +void ERTS_POLL_EXPORT(erts_poll_init)(void); +void ERTS_POLL_EXPORT(erts_poll_get_selected_events)(ErtsPollSet, + ErtsPollEvents [], + int); + +#endif /* #ifndef ERL_POLL_H__ */ diff --git a/erts/emulator/sys/unix/driver_int.h b/erts/emulator/sys/unix/driver_int.h new file mode 100644 index 0000000000..a7ee8087ab --- /dev/null +++ b/erts/emulator/sys/unix/driver_int.h @@ -0,0 +1,41 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * System dependant driver declarations + */ + +#ifndef __DRIVER_INT_H__ +#define __DRIVER_INT_H__ + +#ifdef HAVE_SYS_UIO_H +#include +#include + +typedef struct iovec SysIOVec; + +#else + +typedef struct { + char* iov_base; + int iov_len; +} SysIOVec; + +#endif + +#endif diff --git a/erts/emulator/sys/unix/erl9_start.c b/erts/emulator/sys/unix/erl9_start.c new file mode 100644 index 0000000000..578062d7e2 --- /dev/null +++ b/erts/emulator/sys/unix/erl9_start.c @@ -0,0 +1,130 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#include +#include +#include + +/* + * XXX This is a temporary dummy to make sys.c happy until we'll rewrite it. + */ +unsigned preloaded_size_ring0 = 1; +unsigned char preloaded_ring0[1] = {0}; + +Preload pre_loaded[] = { + {"ring0", 1, preloaded_ring0}, + {0, 0, 0} +}; + +int +main(int argc, char** argv) +{ + char sbuf[1024]; + struct { + void* p; + int sz; + } bins[2]; + int bin_num = 0; + FILE* fp; + char* progname = argv[0]; + char* eq; + + argv++, argc--; + + if (argc > 0 && argv[0][0] == '-') { + argv++, argc--; + } + if (argc < 1) { + abort(); + } + if ((fp = fopen(argv[0], "r")) == NULL) { + abort(); + } + + /* Needs to be called before any memory allocation */ + erts_short_init(); + + while (fgets(sbuf, sizeof sbuf, fp)) { + if (sbuf[0] == '#') { + continue; /* Comment */ + } else if (sbuf[0] == 'e' && strncmp("exec", sbuf, 4) == 0) { + continue; /* Comment ;-) */ + } else if ((eq = strchr(sbuf, '=')) != NULL) { + char* val; + char* p = strchr(sbuf, '\n'); + if (p) { + *p = '\0'; + } + *eq = '\0'; + val = erts_read_env(sbuf); + if (val == NULL) { + *eq = '='; + erts_sys_putenv(sbuf, eq - &sbuf[0]); + } + erts_free_read_env(val); + } else if (sbuf[0] == ':' && '0' <= sbuf[1] && sbuf[1] <= '9') { + int load_size = atoi(sbuf+1); + void* bin; + + bin = malloc(load_size); + if (fread(bin, 1, load_size, fp) != load_size) { + abort(); + } + bins[bin_num].p = bin; + bins[bin_num].sz = load_size; + bin_num++; + } else if (strcmp(sbuf, "--end--\n") == 0) { + int rval; + Eterm mod = NIL; + char *val; + + fclose(fp); + + if (bin_num != 2) { + abort(); + } + + val = erts_read_env("ERLBREAKHANDLER"); + if (val) { + init_break_handler(); + } + erts_free_read_env(val); + + if ((rval = erts_load_module(NULL, 0, NIL, &mod, bins[0].p, bins[0].sz)) < 0) { + fprintf(stderr, "%s: Load of initial module failed: %d\n", + progname, rval); + abort(); + } + erts_first_process(mod, bins[1].p, bins[1].sz, argc, argv); + free(bins[0].p); + free(bins[1].p); + process_main(); + abort(); + } else { + fprintf(stderr, "%s: bad line: %s\n", progname, sbuf); + abort(); + } + } + abort(); +} diff --git a/erts/emulator/sys/unix/erl_child_setup.c b/erts/emulator/sys/unix/erl_child_setup.c new file mode 100644 index 0000000000..7c6e4a2f37 --- /dev/null +++ b/erts/emulator/sys/unix/erl_child_setup.c @@ -0,0 +1,122 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * After a vfork() (or fork()) the child exec()s to this program which + * sets up the child and exec()s to the user program (see spawn_start() + * in sys.c and ticket OTP-4389). + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define NEED_CHILD_SETUP_DEFINES +#include "sys.h" +#include "erl_misc_utils.h" + +#ifdef SIG_SIGSET /* Old SysV */ +void sys_sigrelease(int sig) +{ + sigrelse(sig); +} +#else /* !SIG_SIGSET */ +#ifdef SIG_SIGNAL /* Old BSD */ +sys_sigrelease(int sig) +{ + sigsetmask(sigblock(0) & ~sigmask(sig)); +} +#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */ +void sys_sigrelease(int sig) +{ + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL); +} +#endif /* !SIG_SIGNAL */ +#endif /* !SIG_SIGSET */ + +int +main(int argc, char *argv[]) +{ + int i, from, to; + int erts_spawn_executable = 0; + + /* OBSERVE! + * Keep child setup after fork() (implemented in sys.c) up to date + * if changes are made here. + */ + + if (argc != CS_ARGV_NO_OF_ARGS) { + if (argc < CS_ARGV_NO_OF_ARGS) { + return 1; + } else { + erts_spawn_executable = 1; + } + } + + if (strcmp("false", argv[CS_ARGV_UNBIND_IX]) != 0) + if (erts_unbind_from_cpu_str(argv[CS_ARGV_UNBIND_IX]) != 0) + return 1; + + for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) { + if (argv[CS_ARGV_DUP2_OP_IX(i)][0] == '-' + && argv[CS_ARGV_DUP2_OP_IX(i)][1] == '\0') + break; + if (sscanf(argv[CS_ARGV_DUP2_OP_IX(i)], "%d:%d", &from, &to) != 2) + return 1; + if (dup2(from, to) < 0) + return 1; + } + + if (sscanf(argv[CS_ARGV_FD_CR_IX], "%d:%d", &from, &to) != 2) + return 1; + for (i = from; i <= to; i++) + (void) close(i); + + if (!(argv[CS_ARGV_WD_IX][0] == '.' && argv[CS_ARGV_WD_IX][1] == '\0') + && chdir(argv[CS_ARGV_WD_IX]) < 0) + return 1; + +#if defined(USE_SETPGRP_NOARGS) /* SysV */ + (void) setpgrp(); +#elif defined(USE_SETPGRP) /* BSD */ + (void) setpgrp(0, getpid()); +#else /* POSIX */ + (void) setsid(); +#endif + + sys_sigrelease(SIGCHLD); + sys_sigrelease(SIGINT); + sys_sigrelease(SIGUSR1); + + if (erts_spawn_executable) { + if (argv[CS_ARGV_NO_OF_ARGS + 1] == NULL) { + execl(argv[CS_ARGV_NO_OF_ARGS],argv[CS_ARGV_NO_OF_ARGS], + (char *) NULL); + } else { + execv(argv[CS_ARGV_NO_OF_ARGS],&(argv[CS_ARGV_NO_OF_ARGS + 1])); + } + } else { + execl("/bin/sh", "sh", "-c", argv[CS_ARGV_CMD_IX], (char *) NULL); + } + return 1; +} diff --git a/erts/emulator/sys/unix/erl_main.c b/erts/emulator/sys/unix/erl_main.c new file mode 100644 index 0000000000..b26f93f77e --- /dev/null +++ b/erts/emulator/sys/unix/erl_main.c @@ -0,0 +1,31 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" +#include "global.h" + +int +main(int argc, char **argv) +{ + erl_start(argc, argv); + return 0; +} diff --git a/erts/emulator/sys/unix/erl_unix_sys.h b/erts/emulator/sys/unix/erl_unix_sys.h new file mode 100644 index 0000000000..2d5ef882f6 --- /dev/null +++ b/erts/emulator/sys/unix/erl_unix_sys.h @@ -0,0 +1,339 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + * This file handles differences between different Unix systems. + * This should be the only place with conditional compilation + * depending on the type of OS. + */ + +#ifndef _ERL_UNIX_SYS_H +#define _ERL_UNIX_SYS_H + +#include +#include +#include +#include +#include +#ifndef QNX +#include +#endif + +#if defined(__sun__) && defined(__SVR4) && !defined(__EXTENSIONS__) +# define __EXTENSIONS__ +# include +# undef __EXTENSIONS__ +#else +# include +#endif +#include +#include +#include +#include "erl_errno.h" +#include + + +#if HAVE_SYS_SOCKETIO_H +# include +#endif +#if HAVE_SYS_SOCKIO_H +# include +#endif + +#ifdef HAVE_NET_ERRNO_H +#include +#endif + +#ifdef HAVE_DIRENT_H +# include +#endif + +#ifdef HAVE_UNISTD_H +# include +#endif + +#ifndef HAVE_MMAP +# define HAVE_MMAP 0 +#endif + +#if HAVE_MMAP +# include +#endif + +#if TIME_WITH_SYS_TIME +# include +# include +#else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif + +#include + +#ifdef HAVE_IEEEFP_H +#include +#endif + +#ifdef QNX +#include +#include +#endif + +#include + +#ifndef HZ +#define HZ 60 +#endif + +#ifdef NETDB_H_NEEDS_IN_H +#include +#endif +#include + +/* + * Make sure that MAXPATHLEN is defined. + */ +#ifdef GETHRTIME_WITH_CLOCK_GETTIME +#undef HAVE_GETHRTIME +#define HAVE_GETHRTIME 1 +#endif + +#ifndef MAXPATHLEN +# ifdef PATH_MAX +# define MAXPATHLEN PATH_MAX +# else +# define MAXPATHLEN 2048 +# endif +#endif + +/* File descriptors are numbers anc consecutively allocated on Unix */ +#define ERTS_SYS_CONTINOUS_FD_NUMBERS + +#define HAVE_ERTS_CHECK_IO_DEBUG +int erts_check_io_debug(void); + + +#ifndef ENABLE_CHILD_WAITER_THREAD +# undef ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +# define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT +# ifdef ERTS_SMP +# define ERTS_SMP_SCHEDULERS_NEED_TO_CHECK_CHILDREN +void erts_check_children(void); +# endif +#endif + +typedef void *GETENV_STATE; + +/* +** For the erl_timer_sup module. +*/ + +typedef struct timeval SysTimeval; + +#define sys_gettimeofday(Arg) ((void) gettimeofday((Arg), NULL)) + +typedef struct tms SysTimes; + +extern int erts_ticks_per_sec; + +#define SYS_CLK_TCK (erts_ticks_per_sec) + +#define sys_times(Arg) times(Arg) + +#define ERTS_WRAP_SYS_TIMES 1 +extern int erts_ticks_per_sec_wrap; +#define SYS_CLK_TCK_WRAP (erts_ticks_per_sec_wrap) +extern clock_t sys_times_wrap(void); + +#ifdef HAVE_GETHRTIME +#ifdef GETHRTIME_WITH_CLOCK_GETTIME +typedef long long SysHrTime; + +extern SysHrTime sys_gethrtime(void); +#define sys_init_hrtime() /* Nothing */ + +#else /* Real gethrtime (Solaris) */ + +typedef hrtime_t SysHrTime; + +#define sys_gethrtime() gethrtime() +#define sys_init_hrtime() /* Nothing */ + +#endif /* GETHRTIME_WITH_CLOCK_GETTIME */ +#endif /* HAVE_GETHRTIME */ + +#if (defined(HAVE_GETHRVTIME) || defined(HAVE_CLOCK_GETTIME)) +typedef long long SysCpuTime; +typedef struct timespec SysTimespec; + +#if defined(HAVE_GETHRVTIME) +#define sys_gethrvtime() gethrvtime() +#define sys_get_proc_cputime(t,tp) (t) = sys_gethrvtime(), \ + (tp).tv_sec = (time_t)((t)/1000000000LL), \ + (tp).tv_nsec = (long)((t)%1000000000LL) +int sys_start_hrvtime(void); +int sys_stop_hrvtime(void); + +#elif defined(HAVE_CLOCK_GETTIME) +#define sys_clock_gettime(cid,tp) clock_gettime((cid),&(tp)) +#define sys_get_proc_cputime(t,tp) sys_clock_gettime(CLOCK_PROCESS_CPUTIME_ID,(tp)) + +#endif +#endif + +/* No use in having other resolutions than 1 Ms. */ +#define SYS_CLOCK_RESOLUTION 1 + +/* These are defined in sys.c */ +#if defined(SIG_SIGSET) /* Old SysV */ +RETSIGTYPE (*sys_sigset())(); +#elif defined(SIG_SIGNAL) /* Old BSD */ +RETSIGTYPE (*sys_sigset())(); +#else +RETSIGTYPE (*sys_sigset(int, RETSIGTYPE (*func)(int)))(int); +#endif +extern void sys_sigrelease(int); +extern void sys_sigblock(int); +extern void sys_stop_cat(void); + +/* + * Handling of floating point exceptions. + */ + +#ifdef USE_ISINF_ISNAN /* simulate finite() */ +# define finite(f) (!isinf(f) && !isnan(f)) +# define HAVE_FINITE +#endif + +#ifdef NO_FPE_SIGNALS + +#define erts_get_current_fp_exception() NULL +#ifdef ERTS_SMP +#define erts_thread_init_fp_exception() do{}while(0) +#endif +# define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0) +# define __ERTS_FP_ERROR(fpexnp, f, Action) if (!finite(f)) { Action; } else {} +# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action) +# define __ERTS_SAVE_FP_EXCEPTION(fpexnp) +# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) + +#define erts_sys_block_fpe() 0 +#define erts_sys_unblock_fpe(x) do{}while(0) + +#else /* !NO_FPE_SIGNALS */ + +extern volatile unsigned long *erts_get_current_fp_exception(void); +#ifdef ERTS_SMP +extern void erts_thread_init_fp_exception(void); +#endif +# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) +# define erts_fwait(fpexnp,f) \ + __asm__ __volatile__("fwait" : "=m"(*(fpexnp)) : "m"(f)) +# elif (defined(__powerpc__) || defined(__ppc__)) && defined(__GNUC__) +# define erts_fwait(fpexnp,f) \ + __asm__ __volatile__("" : "=m"(*(fpexnp)) : "fm"(f)) +# elif defined(__sparc__) && defined(__linux__) && defined(__GNUC__) +# define erts_fwait(fpexnp,f) \ + __asm__ __volatile__("" : "=m"(*(fpexnp)) : "em"(f)) +# else +# define erts_fwait(fpexnp,f) \ + __asm__ __volatile__("" : "=m"(*(fpexnp)) : "g"(f)) +# endif +# if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) + extern void erts_restore_fpu(void); +# else +# define erts_restore_fpu() /*empty*/ +# endif +# if (!defined(__GNUC__) || \ + (__GNUC__ < 2) || \ + (__GNUC__ == 2 && __GNUC_MINOR < 96)) && \ + !defined(__builtin_expect) +# define __builtin_expect(x, expected_value) (x) +# endif +static __inline__ int erts_check_fpe(volatile unsigned long *fp_exception, double f) +{ + erts_fwait(fp_exception, f); + if (__builtin_expect(*fp_exception == 0, 1)) + return 0; + *fp_exception = 0; + erts_restore_fpu(); + return 1; +} +# undef erts_fwait +# undef erts_restore_fpu +extern void erts_fp_check_init_error(volatile unsigned long *fp_exception); +static __inline__ void __ERTS_FP_CHECK_INIT(volatile unsigned long *fp_exception) +{ + if (__builtin_expect(*fp_exception == 0, 1)) + return; + erts_fp_check_init_error(fp_exception); +} +# define __ERTS_FP_ERROR(fpexnp, f, Action) do { if (erts_check_fpe((fpexnp),(f))) { Action; } } while (0) +# define __ERTS_SAVE_FP_EXCEPTION(fpexnp) unsigned long old_erl_fp_exception = *(fpexnp) +# define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) \ + do { *(fpexnp) = old_erl_fp_exception; } while (0) + /* This is for library calls where we don't trust the external + code to always throw floating-point exceptions on errors. */ +static __inline__ int erts_check_fpe_thorough(volatile unsigned long *fp_exception, double f) +{ + return erts_check_fpe(fp_exception, f) || !finite(f); +} +# define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) \ + do { if (erts_check_fpe_thorough((fpexnp),(f))) { Action; } } while (0) + +int erts_sys_block_fpe(void); +void erts_sys_unblock_fpe(int); + +#endif /* !NO_FPE_SIGNALS */ + +#define ERTS_FP_CHECK_INIT(p) __ERTS_FP_CHECK_INIT(&(p)->fp_exception) +#define ERTS_FP_ERROR(p, f, A) __ERTS_FP_ERROR(&(p)->fp_exception, f, A) +#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A) + + +#ifdef NEED_CHILD_SETUP_DEFINES +/* The child setup argv[] */ +#define CS_ARGV_PROGNAME_IX 0 /* Program name */ +#define CS_ARGV_UNBIND_IX 1 /* Unbind from cpu */ +#define CS_ARGV_WD_IX 2 /* Working directory */ +#define CS_ARGV_CMD_IX 3 /* Command */ +#define CS_ARGV_FD_CR_IX 4 /* Fd close range */ +#define CS_ARGV_DUP2_OP_IX(N) ((N) + 5) /* dup2 operations */ + +#define CS_ARGV_NO_OF_DUP2_OPS 3 /* Number of dup2 ops */ +#define CS_ARGV_NO_OF_ARGS 8 /* Number of arguments */ +#endif /* #ifdef NEED_CHILD_SETUP_DEFINES */ + +/* Threads */ +#ifdef USE_THREADS +extern int init_async(int); +extern int exit_async(void); +#endif + +#define ERTS_EXIT_AFTER_DUMP _exit + +#ifdef ERTS_TIMER_THREAD +struct erts_iwait; /* opaque for clients */ +extern struct erts_iwait *erts_iwait_init(void); +extern void erts_iwait_wait(struct erts_iwait *iwait, struct timeval *delay); +extern void erts_iwait_interrupt(struct erts_iwait *iwait); +#endif /* ERTS_TIMER_THREAD */ + +#endif /* #ifndef _ERL_UNIX_SYS_H */ diff --git a/erts/emulator/sys/unix/erl_unix_sys_ddll.c b/erts/emulator/sys/unix/erl_unix_sys_ddll.c new file mode 100644 index 0000000000..336d9586c4 --- /dev/null +++ b/erts/emulator/sys/unix/erl_unix_sys_ddll.c @@ -0,0 +1,280 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Interface functions to the dynamic linker using dl* functions. + * (As far as I know it works on SunOS 4, 5, Linux and FreeBSD. /Seb) + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_vm.h" +#include "global.h" +#ifdef HAVE_DLFCN_H +#include +#endif + + +/* some systems do not have RTLD_NOW defined, and require the "mode" + * argument to dload() always be 1. + */ +#ifndef RTLD_NOW +# define RTLD_NOW 1 +#endif + +#define MAX_NAME_LEN 255 /* XXX should we get the system path size? */ +#define EXT_LEN 3 +#define FILE_EXT ".so" /* extension appended to the filename */ + +static char **errcodes = NULL; +static int num_errcodes = 0; +static int num_errcodes_allocated = 0; + +#define my_strdup(WHAT) my_strdup_in(ERTS_ALC_T_DDLL_ERRCODES, WHAT); + +static char *my_strdup_in(ErtsAlcType_t type, char *what) +{ + char *res = erts_alloc(type, strlen(what) + 1); + strcpy(res, what); + return res; +} + + +static int find_errcode(char *string, ErtsSysDdllError* err) +{ + int i; + + if (err != NULL) { + erts_sys_ddll_free_error(err); /* in case we ignored an earlier error */ + err->str = my_strdup_in(ERTS_ALC_T_DDLL_TMP_BUF, string); + return 0; + } + for(i=0;i ERL_DE_DYNAMIC_ERROR_OFFSET) { + return "Unspecified error"; + } + actual_code = -1*(code - ERL_DE_DYNAMIC_ERROR_OFFSET); +#if defined(HAVE_DLOPEN) + { + char *msg; + + if (actual_code >= num_errcodes) { + msg = "Unknown dlload error"; + } else { + msg = errcodes[actual_code]; + } + return msg; + } +#endif + return "no error"; +} + +void erts_sys_ddll_free_error(ErtsSysDdllError* err) +{ + if (err->str != NULL) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, err->str); + } +} + diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c new file mode 100644 index 0000000000..183525b222 --- /dev/null +++ b/erts/emulator/sys/unix/sys.c @@ -0,0 +1,3346 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef ISC32 +#define _POSIX_SOURCE +#define _XOPEN_SOURCE +#endif + +#include /* ! */ +#include +#include +#include +#include +#include +#include +#include + +#ifdef ISC32 +#include +#endif + +#include +#ifdef HAVE_FCNTL_H +#include +#endif +#ifdef HAVE_SYS_IOCTL_H +#include +#endif + +#define NEED_CHILD_SETUP_DEFINES +#define ERTS_WANT_BREAK_HANDLING +#define ERTS_WANT_GOT_SIGUSR1 +#define WANT_NONBLOCKING /* must define this to pull in defs from sys.h */ +#include "sys.h" + +#ifdef USE_THREADS +#include "erl_threads.h" +#endif + +#include "erl_mseg.h" + +extern char **environ; +static erts_smp_rwmtx_t environ_rwmtx; + +#define MAX_VSIZE 16 /* Max number of entries allowed in an I/O + * vector sock_sendv(). + */ + +/* + * Don't need global.h, but bif_table.h (included by bif.h), + * won't compile otherwise + */ +#include "global.h" +#include "bif.h" + +#include "erl_sys_driver.h" +#include "erl_check_io.h" + +#ifndef DISABLE_VFORK +#define DISABLE_VFORK 0 +#endif + +#ifdef USE_THREADS +# ifdef ENABLE_CHILD_WAITER_THREAD +# define CHLDWTHR ENABLE_CHILD_WAITER_THREAD +# else +# define CHLDWTHR 0 +# endif +#else +# define CHLDWTHR 0 +#endif +/* + * [OTP-3906] + * Solaris signal management gets confused when threads are used and a + * lot of child processes dies. The confusion results in that SIGCHLD + * signals aren't delivered to the emulator which in turn results in + * a lot of defunct processes in the system. + * + * The problem seems to appear when a signal is frequently + * blocked/unblocked at the same time as the signal is frequently + * propagated. The child waiter thread is a workaround for this problem. + * The SIGCHLD signal is always blocked (in all threads), and the child + * waiter thread fetches the signal by a call to sigwait(). See + * child_waiter(). + */ + +typedef struct ErtsSysReportExit_ ErtsSysReportExit; +struct ErtsSysReportExit_ { + ErtsSysReportExit *next; + Eterm port; + int pid; + int ifd; + int ofd; +#if CHLDWTHR && !defined(ERTS_SMP) + int status; +#endif +}; + +static ErtsSysReportExit *report_exit_list; +#if CHLDWTHR && !defined(ERTS_SMP) +static ErtsSysReportExit *report_exit_transit_list; +#endif + +extern int check_async_ready(void); +extern int driver_interrupt(int, int); +/*EXTERN_FUNCTION(void, increment_time, (int));*/ +/*EXTERN_FUNCTION(int, next_time, (_VOID_));*/ +extern void do_break(void); + +extern void erl_sys_args(int*, char**); + +/* The following two defs should probably be moved somewhere else */ + +extern void erts_sys_init_float(void); + +extern void erl_crash_dump(char* file, int line, char* fmt, ...); + +#define DIR_SEPARATOR_CHAR '/' + +#if defined(DEBUG) +#define ERL_BUILD_TYPE_MARKER ".debug" +#elif defined(PURIFY) +#define ERL_BUILD_TYPE_MARKER ".purify" +#elif defined(QUANTIFY) +#define ERL_BUILD_TYPE_MARKER ".quantify" +#elif defined(PURECOV) +#define ERL_BUILD_TYPE_MARKER ".purecov" +#elif defined(VALGRIND) +#define ERL_BUILD_TYPE_MARKER ".valgrind" +#else /* opt */ +#define ERL_BUILD_TYPE_MARKER +#endif + +#define CHILD_SETUP_PROG_NAME "child_setup" ERL_BUILD_TYPE_MARKER +#if !DISABLE_VFORK +static char *child_setup_prog; +#endif + +#ifdef DEBUG +static int debug_log = 0; +#endif + +#ifdef ERTS_SMP +erts_smp_atomic_t erts_got_sigusr1; +#define ERTS_SET_GOT_SIGUSR1 \ + erts_smp_atomic_set(&erts_got_sigusr1, 1) +#define ERTS_UNSET_GOT_SIGUSR1 \ + erts_smp_atomic_set(&erts_got_sigusr1, 0) +static erts_smp_atomic_t have_prepared_crash_dump; +#define ERTS_PREPARED_CRASH_DUMP \ + ((int) erts_smp_atomic_xchg(&have_prepared_crash_dump, 1)) +#else +volatile int erts_got_sigusr1; +#define ERTS_SET_GOT_SIGUSR1 (erts_got_sigusr1 = 1) +#define ERTS_UNSET_GOT_SIGUSR1 (erts_got_sigusr1 = 0) +static volatile int have_prepared_crash_dump; +#define ERTS_PREPARED_CRASH_DUMP \ + (have_prepared_crash_dump++) +#endif + +static erts_smp_atomic_t sys_misc_mem_sz; + +#if defined(ERTS_SMP) +static void smp_sig_notify(char c); +static int sig_notify_fds[2] = {-1, -1}; +#elif defined(USE_THREADS) +static int async_fd[2]; +#endif + +#if CHLDWTHR || defined(ERTS_SMP) +erts_mtx_t chld_stat_mtx; +#endif +#if CHLDWTHR +static erts_tid_t child_waiter_tid; +/* chld_stat_mtx is used to protect against concurrent accesses + of the driver_data fields pid, alive, and status. */ +erts_cnd_t chld_stat_cnd; +static long children_alive; +#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) +#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) +#define CHLD_STAT_WAIT erts_cnd_wait(&chld_stat_cnd, &chld_stat_mtx) +#define CHLD_STAT_SIGNAL erts_cnd_signal(&chld_stat_cnd) +#elif defined(ERTS_SMP) /* ------------------------------------------------- */ +#define CHLD_STAT_LOCK erts_mtx_lock(&chld_stat_mtx) +#define CHLD_STAT_UNLOCK erts_mtx_unlock(&chld_stat_mtx) + +#else /* ------------------------------------------------------------------- */ +#define CHLD_STAT_LOCK +#define CHLD_STAT_UNLOCK +static volatile int children_died; +#endif + + +static struct fd_data { + char pbuf[4]; /* hold partial packet bytes */ + int psz; /* size of pbuf */ + char *buf; + char *cpos; + int sz; + int remain; /* for input on fd */ +} *fd_data; /* indexed by fd */ + +/* static FUNCTION(int, write_fill, (int, char*, int)); unused? */ +static FUNCTION(void, note_child_death, (int, int)); + +#if CHLDWTHR +static FUNCTION(void *, child_waiter, (void *)); +#endif + +/********************* General functions ****************************/ + +/* This is used by both the drivers and general I/O, must be set early */ +static int max_files = -1; + +/* + * a few variables used by the break handler + */ +#ifdef ERTS_SMP +erts_smp_atomic_t erts_break_requested; +#define ERTS_SET_BREAK_REQUESTED \ + erts_smp_atomic_set(&erts_break_requested, (long) 1) +#define ERTS_UNSET_BREAK_REQUESTED \ + erts_smp_atomic_set(&erts_break_requested, (long) 0) +#else +volatile int erts_break_requested = 0; +#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) +#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0) +#endif +/* set early so the break handler has access to initial mode */ +static struct termios initial_tty_mode; +static int replace_intr = 0; +/* assume yes initially, ttsl_init will clear it */ +int using_oldshell = 1; + +#ifdef ERTS_ENABLE_KERNEL_POLL + +int erts_use_kernel_poll = 0; + +struct { + int (*select)(ErlDrvPort, ErlDrvEvent, int, int); + int (*event)(ErlDrvPort, ErlDrvEvent, ErlDrvEventData); + void (*check_io_interrupt)(int); + void (*check_io_interrupt_tmd)(int, long); + void (*check_io)(int); + Uint (*size)(void); + Eterm (*info)(void *); + int (*check_io_debug)(void); +} io_func = {0}; + + +int +driver_select(ErlDrvPort port, ErlDrvEvent event, int mode, int on) +{ + return (*io_func.select)(port, event, mode, on); +} + +int +driver_event(ErlDrvPort port, ErlDrvEvent event, ErlDrvEventData event_data) +{ + return (*io_func.event)(port, event, event_data); +} + +Eterm erts_check_io_info(void *p) +{ + return (*io_func.info)(p); +} + +int +erts_check_io_debug(void) +{ + return (*io_func.check_io_debug)(); +} + + +static void +init_check_io(void) +{ + if (erts_use_kernel_poll) { + io_func.select = driver_select_kp; + io_func.event = driver_event_kp; + io_func.check_io_interrupt = erts_check_io_interrupt_kp; + io_func.check_io_interrupt_tmd = erts_check_io_interrupt_timed_kp; + io_func.check_io = erts_check_io_kp; + io_func.size = erts_check_io_size_kp; + io_func.info = erts_check_io_info_kp; + io_func.check_io_debug = erts_check_io_debug_kp; + erts_init_check_io_kp(); + max_files = erts_check_io_max_files_kp(); + } + else { + io_func.select = driver_select_nkp; + io_func.event = driver_event_nkp; + io_func.check_io_interrupt = erts_check_io_interrupt_nkp; + io_func.check_io_interrupt_tmd = erts_check_io_interrupt_timed_nkp; + io_func.check_io = erts_check_io_nkp; + io_func.size = erts_check_io_size_nkp; + io_func.info = erts_check_io_info_nkp; + io_func.check_io_debug = erts_check_io_debug_nkp; + erts_init_check_io_nkp(); + max_files = erts_check_io_max_files_nkp(); + } +} + +#define ERTS_CHK_IO_INTR (*io_func.check_io_interrupt) +#define ERTS_CHK_IO_INTR_TMD (*io_func.check_io_interrupt_tmd) +#define ERTS_CHK_IO (*io_func.check_io) +#define ERTS_CHK_IO_SZ (*io_func.size) + +#else /* !ERTS_ENABLE_KERNEL_POLL */ + +static void +init_check_io(void) +{ + erts_init_check_io(); + max_files = erts_check_io_max_files(); +} + +#define ERTS_CHK_IO_INTR erts_check_io_interrupt +#define ERTS_CHK_IO_INTR_TMD erts_check_io_interrupt_timed +#define ERTS_CHK_IO erts_check_io +#define ERTS_CHK_IO_SZ erts_check_io_size + +#endif + +#ifdef ERTS_SMP +void +erts_sys_schedule_interrupt(int set) +{ + ERTS_CHK_IO_INTR(set); +} + +void +erts_sys_schedule_interrupt_timed(int set, long msec) +{ + ERTS_CHK_IO_INTR_TMD(set, msec); +} +#endif + +Uint +erts_sys_misc_mem_sz(void) +{ + Uint res = ERTS_CHK_IO_SZ(); + res += erts_smp_atomic_read(&sys_misc_mem_sz); + return res; +} + +/* + * reset the terminal to the original settings on exit + */ +void sys_tty_reset(void) +{ + if (using_oldshell && !replace_intr) { + SET_BLOCKING(0); + } + else if (isatty(0)) { + tcsetattr(0,TCSANOW,&initial_tty_mode); + } +} + +#ifdef __tile__ +/* Direct malloc to spread memory around the caches of multiple tiles. */ +#include +MALLOC_USE_HASH(1); +#endif + +#ifdef USE_THREADS +static void *ethr_internal_alloc(size_t size) +{ + return erts_alloc_fnf(ERTS_ALC_T_ETHR_INTERNAL, (Uint) size); +} +static void *ethr_internal_realloc(void *ptr, size_t size) +{ + return erts_realloc_fnf(ERTS_ALC_T_ETHR_INTERNAL, ptr, (Uint) size); +} +static void ethr_internal_free(void *ptr) +{ + erts_free(ERTS_ALC_T_ETHR_INTERNAL, ptr); +} + +#ifdef ERTS_THR_HAVE_SIG_FUNCS +/* + * Child thread inherits parents signal mask at creation. In order to + * guarantee that the main thread will receive all SIGINT, SIGCHLD, and + * SIGUSR1 signals sent to the process, we block these signals in the + * parent thread when creating a new thread. + */ + +static sigset_t thr_create_sigmask; + +#endif /* #ifdef ERTS_THR_HAVE_SIG_FUNCS */ + +typedef struct { +#ifdef ERTS_THR_HAVE_SIG_FUNCS + sigset_t saved_sigmask; +#endif + int unbind_child; +} erts_thr_create_data_t; + +/* + * thr_create_prepare() is called in parent thread before thread creation. + * Returned value is passed as argument to thr_create_cleanup(). + */ +static void * +thr_create_prepare(void) +{ + erts_thr_create_data_t *tcdp; + ErtsSchedulerData *esdp; + + tcdp = erts_alloc(ERTS_ALC_T_TMP, sizeof(erts_thr_create_data_t)); + +#ifdef ERTS_THR_HAVE_SIG_FUNCS + erts_thr_sigmask(SIG_BLOCK, &thr_create_sigmask, &tcdp->saved_sigmask); +#endif + esdp = erts_get_scheduler_data(); + tcdp->unbind_child = esdp && erts_is_scheduler_bound(esdp); + + return (void *) tcdp; +} + + +/* thr_create_cleanup() is called in parent thread after thread creation. */ +static void +thr_create_cleanup(void *vtcdp) +{ + erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp; + +#ifdef ERTS_THR_HAVE_SIG_FUNCS + /* Restore signalmask... */ + erts_thr_sigmask(SIG_SETMASK, &tcdp->saved_sigmask, NULL); +#endif + + erts_free(ERTS_ALC_T_TMP, tcdp); +} + +static void +thr_create_prepare_child(void *vtcdp) +{ + erts_thr_create_data_t *tcdp = (erts_thr_create_data_t *) vtcdp; + +#ifndef NO_FPE_SIGNALS + /* + * We do not want fp exeptions in other threads than the + * scheduler threads. We enable fpe explicitly in the scheduler + * threads after this. + */ + erts_thread_disable_fpe(); +#endif + + if (tcdp->unbind_child) { + erts_smp_rwmtx_rlock(&erts_cpu_bind_rwmtx); + erts_unbind_from_cpu(erts_cpuinfo); + erts_smp_rwmtx_runlock(&erts_cpu_bind_rwmtx); + } + +} + +#endif /* #ifdef USE_THREADS */ + +void +erts_sys_pre_init(void) +{ + erts_printf_add_cr_to_stdout = 1; + erts_printf_add_cr_to_stderr = 1; +#ifdef USE_THREADS + { + erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER; + eid.alloc = ethr_internal_alloc; + eid.realloc = ethr_internal_realloc; + eid.free = ethr_internal_free; + + eid.thread_create_child_func = thr_create_prepare_child; + /* Before creation in parent */ + eid.thread_create_prepare_func = thr_create_prepare; + /* After creation in parent */ + eid.thread_create_parent_func = thr_create_cleanup, + +#ifdef ERTS_THR_HAVE_SIG_FUNCS + sigemptyset(&thr_create_sigmask); + sigaddset(&thr_create_sigmask, SIGINT); /* block interrupt */ + sigaddset(&thr_create_sigmask, SIGCHLD); /* block child signals */ + sigaddset(&thr_create_sigmask, SIGUSR1); /* block user defined signal */ +#endif + + erts_thr_init(&eid); + + report_exit_list = NULL; + +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init(); +#endif + +#if CHLDWTHR || defined(ERTS_SMP) + erts_mtx_init(&chld_stat_mtx, "child_status"); +#endif +#if CHLDWTHR +#ifndef ERTS_SMP + report_exit_transit_list = NULL; +#endif + erts_cnd_init(&chld_stat_cnd); + children_alive = 0; +#endif + } +#ifdef ERTS_SMP + erts_smp_atomic_init(&erts_break_requested, 0); + erts_smp_atomic_init(&erts_got_sigusr1, 0); + erts_smp_atomic_init(&have_prepared_crash_dump, 0); +#else + erts_break_requested = 0; + erts_got_sigusr1 = 0; + have_prepared_crash_dump = 0; +#endif +#if !CHLDWTHR && !defined(ERTS_SMP) + children_died = 0; +#endif +#endif /* USE_THREADS */ + erts_smp_atomic_init(&sys_misc_mem_sz, 0); + erts_smp_rwmtx_init(&environ_rwmtx, "environ"); +} + +void +erl_sys_init(void) +{ +#if !DISABLE_VFORK + int res; + char bindir[MAXPATHLEN]; + size_t bindirsz = sizeof(bindir); + Uint csp_path_sz; + + res = erts_sys_getenv("BINDIR", bindir, &bindirsz); + if (res != 0) { + if (res < 0) + erl_exit(-1, + "Environment variable BINDIR is not set\n"); + if (res > 0) + erl_exit(-1, + "Value of environment variable BINDIR is too large\n"); + } + if (bindir[0] != DIR_SEPARATOR_CHAR) + erl_exit(-1, + "Environment variable BINDIR does not contain an" + " absolute path\n"); + csp_path_sz = (strlen(bindir) + + 1 /* DIR_SEPARATOR_CHAR */ + + sizeof(CHILD_SETUP_PROG_NAME) + + 1); + child_setup_prog = erts_alloc(ERTS_ALC_T_CS_PROG_PATH, csp_path_sz); + erts_smp_atomic_add(&sys_misc_mem_sz, csp_path_sz); + sprintf(child_setup_prog, + "%s%c%s", + bindir, + DIR_SEPARATOR_CHAR, + CHILD_SETUP_PROG_NAME); +#endif + +#ifdef USE_SETLINEBUF + setlinebuf(stdout); +#else + setvbuf(stdout, (char *)NULL, _IOLBF, BUFSIZ); +#endif + + erts_sys_init_float(); + + /* we save this so the break handler can set and reset it properly */ + /* also so that we can reset on exit (break handler or not) */ + if (isatty(0)) { + tcgetattr(0,&initial_tty_mode); + } + tzset(); /* Required at least for NetBSD with localtime_r() */ +} + +/* signal handling */ + +#ifdef SIG_SIGSET /* Old SysV */ +RETSIGTYPE (*sys_sigset(sig, func))() +int sig; +RETSIGTYPE (*func)(); +{ + return(sigset(sig, func)); +} +void sys_sigblock(int sig) +{ + sighold(sig); +} +void sys_sigrelease(int sig) +{ + sigrelse(sig); +} +#else /* !SIG_SIGSET */ +#ifdef SIG_SIGNAL /* Old BSD */ +RETSIGTYPE (*sys_sigset(sig, func))(int, int) +int sig; +RETSIGTYPE (*func)(); +{ + return(signal(sig, func)); +} +sys_sigblock(int sig) +{ + sigblock(sig); +} +sys_sigrelease(int sig) +{ + sigsetmask(sigblock(0) & ~sigmask(sig)); +} +#else /* !SIG_SIGNAL */ /* The True Way - POSIX!:-) */ +RETSIGTYPE (*sys_sigset(int sig, RETSIGTYPE (*func)(int)))(int) +{ + struct sigaction act, oact; + + sigemptyset(&act.sa_mask); + act.sa_flags = 0; + act.sa_handler = func; + sigaction(sig, &act, &oact); + return(oact.sa_handler); +} + +#ifdef USE_THREADS +#undef sigprocmask +#define sigprocmask erts_thr_sigmask +#endif + +void sys_sigblock(int sig) +{ + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_BLOCK, &mask, (sigset_t *)NULL); +} + +void sys_sigrelease(int sig) +{ + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL); +} +#endif /* !SIG_SIGNAL */ +#endif /* !SIG_SIGSET */ + +#if (0) /* not used? -- gordon */ +static void (*break_func)(); +static RETSIGTYPE break_handler(int sig) +{ +#ifdef QNX + /* Turn off SIGCHLD during break processing */ + sys_sigblock(SIGCHLD); +#endif + (*break_func)(); +#ifdef QNX + sys_sigrelease(SIGCHLD); +#endif +} +#endif /* 0 */ + +static ERTS_INLINE void +prepare_crash_dump(void) +{ + int i, max; + char env[21]; /* enough to hold any 64-bit integer */ + size_t envsz; + + if (ERTS_PREPARED_CRASH_DUMP) + return; /* We have already been called */ + + /* Make sure we unregister at epmd (unknown fd) and get at least + one free filedescriptor (for erl_crash.dump) */ + max = max_files; + if (max < 1024) + max = 1024; + for (i = 3; i < max; i++) { +#if defined(ERTS_SMP) + /* We don't want to close the signal notification pipe... */ + if (i == sig_notify_fds[0] || i == sig_notify_fds[1]) + continue; +#elif defined(USE_THREADS) + /* We don't want to close the async notification pipe... */ + if (i == async_fd[0] || i == async_fd[1]) + continue; +#endif + close(i); + } + + envsz = sizeof(env); + i = erts_sys_getenv("ERL_CRASH_DUMP_NICE", env, &envsz); + if (i >= 0) { + int nice_val; + nice_val = i != 0 ? 0 : atoi(env); + if (nice_val > 39) { + nice_val = 39; + } + nice(nice_val); + } + + envsz = sizeof(env); + i = erts_sys_getenv("ERL_CRASH_DUMP_SECONDS", env, &envsz); + if (i >= 0) { + unsigned sec; + sec = (unsigned) i != 0 ? 0 : atoi(env); + alarm(sec); + } + +} + +void +erts_sys_prepare_crash_dump(void) +{ + prepare_crash_dump(); +} + +static ERTS_INLINE void +break_requested(void) +{ + /* + * just set a flag - checked for and handled by + * scheduler threads erts_check_io() (not signal handler). + */ +#ifdef DEBUG + fprintf(stderr,"break!\n"); +#endif + if (ERTS_BREAK_REQUESTED) + erl_exit(ERTS_INTR_EXIT, ""); + + ERTS_SET_BREAK_REQUESTED; + ERTS_CHK_IO_INTR(1); /* Make sure we don't sleep in poll */ +} + +/* set up signal handlers for break and quit */ +#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) +static RETSIGTYPE request_break(void) +#else +static RETSIGTYPE request_break(int signum) +#endif +{ +#ifdef ERTS_SMP + smp_sig_notify('I'); +#else + break_requested(); +#endif +} + +static ERTS_INLINE void +sigusr1_exit(void) +{ + /* We do this at interrupt level, since the main reason for + wanting to generate a crash dump in this way is that the emulator + is hung somewhere, so it won't be able to poll any flag we set here. + */ + ERTS_SET_GOT_SIGUSR1; + prepare_crash_dump(); + erl_exit(1, "Received SIGUSR1\n"); +} + +#ifdef ETHR_UNUSABLE_SIGUSRX +#warning "Unusable SIGUSR1 & SIGUSR2. Disabling use of these signals" +#endif + +#ifndef ETHR_UNUSABLE_SIGUSRX + +#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) +static RETSIGTYPE user_signal1(void) +#else +static RETSIGTYPE user_signal1(int signum) +#endif +{ +#ifdef ERTS_SMP + smp_sig_notify('1'); +#else + sigusr1_exit(); +#endif +} + +#ifdef QUANTIFY +#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) +static RETSIGTYPE user_signal2(void) +#else +static RETSIGTYPE user_signal2(int signum) +#endif +{ +#ifdef ERTS_SMP + smp_sig_notify('2'); +#else + quantify_save_data(); +#endif +} +#endif + +#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ + +static void +quit_requested(void) +{ + erl_exit(ERTS_INTR_EXIT, ""); +} + +#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) +static RETSIGTYPE do_quit(void) +#else +static RETSIGTYPE do_quit(int signum) +#endif +{ +#ifdef ERTS_SMP + smp_sig_notify('Q'); +#else + quit_requested(); +#endif +} + +/* Disable break */ +void erts_set_ignore_break(void) { + sys_sigset(SIGINT, SIG_IGN); + sys_sigset(SIGQUIT, SIG_IGN); + sys_sigset(SIGTSTP, SIG_IGN); +} + +/* Don't use ctrl-c for break handler but let it be + used by the shell instead (see user_drv.erl) */ +void erts_replace_intr(void) { + struct termios mode; + + if (isatty(0)) { + tcgetattr(0, &mode); + + /* here's an example of how to replace ctrl-c with ctrl-u */ + /* mode.c_cc[VKILL] = 0; + mode.c_cc[VINTR] = CKILL; */ + + mode.c_cc[VINTR] = 0; /* disable ctrl-c */ + tcsetattr(0, TCSANOW, &mode); + replace_intr = 1; + } +} + +void init_break_handler(void) +{ + sys_sigset(SIGINT, request_break); +#ifndef ETHR_UNUSABLE_SIGUSRX + sys_sigset(SIGUSR1, user_signal1); +#ifdef QUANTIFY + sys_sigset(SIGUSR2, user_signal2); +#endif +#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ + sys_sigset(SIGQUIT, do_quit); +} + +int sys_max_files(void) +{ + return(max_files); +} + +static void block_signals(void) +{ +#if !CHLDWTHR + sys_sigblock(SIGCHLD); +#endif +#ifndef ERTS_SMP + sys_sigblock(SIGINT); +#ifndef ETHR_UNUSABLE_SIGUSRX + sys_sigblock(SIGUSR1); +#endif +#endif +} + +static void unblock_signals(void) +{ + /* Update erl_child_setup.c if changed */ +#if !CHLDWTHR + sys_sigrelease(SIGCHLD); +#endif +#ifndef ERTS_SMP + sys_sigrelease(SIGINT); +#ifndef ETHR_UNUSABLE_SIGUSRX + sys_sigrelease(SIGUSR1); +#endif /* #ifndef ETHR_UNUSABLE_SIGUSRX */ +#endif +} +/************************** Time stuff **************************/ +#ifdef HAVE_GETHRTIME +#ifdef GETHRTIME_WITH_CLOCK_GETTIME + +SysHrTime sys_gethrtime(void) +{ + struct timespec ts; + long long result; + if (clock_gettime(CLOCK_MONOTONIC,&ts) != 0) { + erl_exit(1,"Fatal, could not get clock_monotonic value!, " + "errno = %d\n", errno); + } + result = ((long long) ts.tv_sec) * 1000000000LL + + ((long long) ts.tv_nsec); + return (SysHrTime) result; +} +#endif +#endif + +/************************** OS info *******************************/ + +/* Used by erlang:info/1. */ +/* (This code was formerly in drv.XXX/XXX_os_drv.c) */ + +char os_type[] = "unix"; + +static int +get_number(char **str_ptr) +{ + char* s = *str_ptr; /* Pointer to beginning of string. */ + char* dot; /* Pointer to dot in string or NULL. */ + + if (!isdigit((int) *s)) + return 0; + if ((dot = strchr(s, '.')) == NULL) { + *str_ptr = s+strlen(s); + return atoi(s); + } else { + *dot = '\0'; + *str_ptr = dot+1; + return atoi(s); + } +} + +void +os_flavor(char* namebuf, /* Where to return the name. */ + unsigned size) /* Size of name buffer. */ +{ + static int called = 0; + static struct utsname uts; /* Information about the system. */ + + if (!called) { + char* s; + + (void) uname(&uts); + called = 1; + for (s = uts.sysname; *s; s++) { + if (isupper((int) *s)) { + *s = tolower((int) *s); + } + } + } + strcpy(namebuf, uts.sysname); +} + +void +os_version(pMajor, pMinor, pBuild) +int* pMajor; /* Pointer to major version. */ +int* pMinor; /* Pointer to minor version. */ +int* pBuild; /* Pointer to build number. */ +{ + struct utsname uts; /* Information about the system. */ + char* release; /* Pointer to the release string: + * X.Y or X.Y.Z. + */ + + (void) uname(&uts); + release = uts.release; + *pMajor = get_number(&release); + *pMinor = get_number(&release); + *pBuild = get_number(&release); +} + +void init_getenv_state(GETENV_STATE *state) +{ + erts_smp_rwmtx_rlock(&environ_rwmtx); + *state = NULL; +} + +char *getenv_string(GETENV_STATE *state0) +{ + char **state = (char **) *state0; + char *cp; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); + + if (state == NULL) + state = environ; + + cp = *state++; + *state0 = (GETENV_STATE) state; + + return cp; +} + +void fini_getenv_state(GETENV_STATE *state) +{ + *state = NULL; + erts_smp_rwmtx_runlock(&environ_rwmtx); +} + + +/************************** Port I/O *******************************/ + + + +/* I. Common stuff */ + +/* + * Decreasing the size of it below 16384 is not allowed. + */ + +/* II. The spawn/fd/vanilla drivers */ + +#define ERTS_SYS_READ_BUF_SZ (64*1024) + +/* This data is shared by these drivers - initialized by spawn_init() */ +static struct driver_data { + int port_num, ofd, packet_bytes; + ErtsSysReportExit *report_exit; + int pid; + int alive; + int status; +} *driver_data; /* indexed by fd */ + +/* Driver interfaces */ +static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); +static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); +static int fd_control(ErlDrvData, unsigned int, char *, int, char **, int); +static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); +static int spawn_init(void); +static void fd_stop(ErlDrvData); +static void stop(ErlDrvData); +static void ready_input(ErlDrvData, ErlDrvEvent); +static void ready_output(ErlDrvData, ErlDrvEvent); +static void output(ErlDrvData, char*, int); +static void outputv(ErlDrvData, ErlIOVec*); +static void stop_select(ErlDrvEvent, void*); + +struct erl_drv_entry spawn_driver_entry = { + spawn_init, + spawn_start, + stop, + output, + ready_input, + ready_output, + "spawn", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL, NULL, + stop_select +}; +struct erl_drv_entry fd_driver_entry = { + NULL, + fd_start, + fd_stop, + output, + ready_input, + ready_output, + "fd", + NULL, + NULL, + fd_control, + NULL, + outputv, + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, /* handle2 */ + NULL, /* process_exit */ + stop_select +}; +struct erl_drv_entry vanilla_driver_entry = { + NULL, + vanilla_start, + stop, + output, + ready_input, + ready_output, + "vanilla", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, /* handle2 */ + NULL, /* process_exit */ + stop_select +}; + +#if defined(USE_THREADS) && !defined(ERTS_SMP) +static int async_drv_init(void); +static ErlDrvData async_drv_start(ErlDrvPort, char*, SysDriverOpts*); +static void async_drv_stop(ErlDrvData); +static void async_drv_input(ErlDrvData, ErlDrvEvent); + +/* INTERNAL use only */ + +struct erl_drv_entry async_driver_entry = { + async_drv_init, + async_drv_start, + async_drv_stop, + NULL, + async_drv_input, + NULL, + "async", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL +}; +#endif + +/* Handle SIGCHLD signals. */ +#if (defined(SIG_SIGSET) || defined(SIG_SIGNAL)) +static RETSIGTYPE onchld(void) +#else +static RETSIGTYPE onchld(int signum) +#endif +{ +#if CHLDWTHR + ASSERT(0); /* We should *never* catch a SIGCHLD signal */ +#elif defined(ERTS_SMP) + smp_sig_notify('C'); +#else + children_died = 1; + ERTS_CHK_IO_INTR(1); /* Make sure we don't sleep in poll */ +#endif +} + +static int set_driver_data(int port_num, + int ifd, + int ofd, + int packet_bytes, + int read_write, + int exit_status, + int pid) +{ + ErtsSysReportExit *report_exit; + + if (!exit_status) + report_exit = NULL; + else { + report_exit = erts_alloc(ERTS_ALC_T_PRT_REP_EXIT, + sizeof(ErtsSysReportExit)); + report_exit->next = report_exit_list; + report_exit->port = erts_port[port_num].id; + report_exit->pid = pid; + report_exit->ifd = read_write & DO_READ ? ifd : -1; + report_exit->ofd = read_write & DO_WRITE ? ofd : -1; +#if CHLDWTHR && !defined(ERTS_SMP) + report_exit->status = 0; +#endif + report_exit_list = report_exit; + } + + if (read_write & DO_READ) { + driver_data[ifd].packet_bytes = packet_bytes; + driver_data[ifd].port_num = port_num; + driver_data[ifd].report_exit = report_exit; + driver_data[ifd].pid = pid; + driver_data[ifd].alive = 1; + driver_data[ifd].status = 0; + if (read_write & DO_WRITE) { + driver_data[ifd].ofd = ofd; + if (ifd != ofd) + driver_data[ofd] = driver_data[ifd]; /* structure copy */ + } else { /* DO_READ only */ + driver_data[ifd].ofd = -1; + } + (void) driver_select(port_num, ifd, (ERL_DRV_READ|ERL_DRV_USE), 1); + return(ifd); + } else { /* DO_WRITE only */ + driver_data[ofd].packet_bytes = packet_bytes; + driver_data[ofd].port_num = port_num; + driver_data[ofd].report_exit = report_exit; + driver_data[ofd].ofd = ofd; + driver_data[ofd].pid = pid; + driver_data[ofd].alive = 1; + driver_data[ofd].status = 0; + return(ofd); + } +} + +static int spawn_init() +{ + int i; +#if CHLDWTHR + erts_thr_opts_t thr_opts = ERTS_THR_OPTS_DEFAULT_INITER; + thr_opts.detached = 0; + thr_opts.suggested_stack_size = 0; /* Smallest possible */ +#endif + + sys_sigset(SIGPIPE, SIG_IGN); /* Ignore - we'll handle the write failure */ + driver_data = (struct driver_data *) + erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data)); + erts_smp_atomic_add(&sys_misc_mem_sz, + max_files * sizeof(struct driver_data)); + + for (i = 0; i < max_files; i++) + driver_data[i].pid = -1; + +#if CHLDWTHR + sys_sigblock(SIGCHLD); +#endif + + sys_sigset(SIGCHLD, onchld); /* Reap children */ + +#if CHLDWTHR + erts_thr_create(&child_waiter_tid, child_waiter, NULL, &thr_opts); +#endif + + return 1; +} + +static void close_pipes(int ifd[2], int ofd[2], int read_write) +{ + if (read_write & DO_READ) { + (void) close(ifd[0]); + (void) close(ifd[1]); + } + if (read_write & DO_WRITE) { + (void) close(ofd[0]); + (void) close(ofd[1]); + } +} + +static void init_fd_data(int fd, int prt) +{ + fd_data[fd].buf = NULL; + fd_data[fd].cpos = NULL; + fd_data[fd].remain = 0; + fd_data[fd].sz = 0; + fd_data[fd].psz = 0; +} + +static char **build_unix_environment(char *block) +{ + int i; + int j; + int len; + char *cp; + char **cpp; + char** old_env; + + ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); + + cp = block; + len = 0; + while (*cp != '\0') { + cp += strlen(cp) + 1; + len++; + } + old_env = environ; + while (*old_env++ != NULL) { + len++; + } + + cpp = (char **) erts_alloc_fnf(ERTS_ALC_T_ENVIRONMENT, + sizeof(char *) * (len+1)); + if (cpp == NULL) { + return NULL; + } + + cp = block; + len = 0; + while (*cp != '\0') { + cpp[len] = cp; + cp += strlen(cp) + 1; + len++; + } + + i = len; + for (old_env = environ; *old_env; old_env++) { + char* old = *old_env; + + for (j = 0; j < len; j++) { + char *s, *t; + + s = cpp[j]; + t = old; + while (*s == *t && *s != '=') { + s++, t++; + } + if (*s == '=' && *t == '=') { + break; + } + } + + if (j == len) { /* New version not found */ + cpp[len++] = old; + } + } + + for (j = 0; j < i; j++) { + if (cpp[j][strlen(cpp[j])-1] == '=') { + cpp[j] = cpp[--len]; + } + } + + cpp[len] = NULL; + return cpp; +} + +/* + [arndt] In most Unix systems, including Solaris 2.5, 'fork' allocates memory + in swap space for the child of a 'fork', whereas 'vfork' does not do this. + The natural call to use here is therefore 'vfork'. Due to a bug in + 'vfork' in Solaris 2.5 (apparently fixed in 2.6), using 'vfork' + can be dangerous in what seems to be these circumstances: + If the child code under a vfork sets the signal action to SIG_DFL + (or SIG_IGN) + for any signal which was previously set to a signal handler, the + state of the parent is clobbered, so that the later arrival of + such a signal yields a sigsegv in the parent. If the signal was + not set to a signal handler, but ignored, all seems to work. + If you change the forking code below, beware of this. + */ + +static ErlDrvData spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) +{ +#define CMD_LINE_PREFIX_STR "exec " +#define CMD_LINE_PREFIX_STR_SZ (sizeof(CMD_LINE_PREFIX_STR) - 1) + + int ifd[2], ofd[2], len, pid, i; + char **volatile new_environ; /* volatile since a vfork() then cannot + cause 'new_environ' to be clobbered + in the parent process. */ + int saved_errno; + long res; + char *cmd_line; +#ifndef QNX + int unbind; +#endif +#if !DISABLE_VFORK + int no_vfork; + size_t no_vfork_sz = sizeof(no_vfork); + + no_vfork = (erts_sys_getenv("ERL_NO_VFORK", + (char *) &no_vfork, + &no_vfork_sz) >= 0); +#endif + + switch (opts->read_write) { + case DO_READ: + if (pipe(ifd) < 0) + return ERL_DRV_ERROR_ERRNO; + if (ifd[0] >= max_files) { + close_pipes(ifd, ofd, opts->read_write); + errno = EMFILE; + return ERL_DRV_ERROR_ERRNO; + } + ofd[1] = -1; /* keep purify happy */ + break; + case DO_WRITE: + if (pipe(ofd) < 0) return ERL_DRV_ERROR_ERRNO; + if (ofd[1] >= max_files) { + close_pipes(ifd, ofd, opts->read_write); + errno = EMFILE; + return ERL_DRV_ERROR_ERRNO; + } + ifd[0] = -1; /* keep purify happy */ + break; + case DO_READ|DO_WRITE: + if (pipe(ifd) < 0) return ERL_DRV_ERROR_ERRNO; + errno = EMFILE; /* default for next two conditions */ + if (ifd[0] >= max_files || pipe(ofd) < 0) { + close_pipes(ifd, ofd, DO_READ); + return ERL_DRV_ERROR_ERRNO; + } + if (ofd[1] >= max_files) { + close_pipes(ifd, ofd, opts->read_write); + errno = EMFILE; + return ERL_DRV_ERROR_ERRNO; + } + break; + default: + ASSERT(0); + return ERL_DRV_ERROR_GENERAL; + } + + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + /* started with spawn_executable, not with spawn */ + len = strlen(name); + cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, len + 1); + if (!cmd_line) { + close_pipes(ifd, ofd, opts->read_write); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + memcpy((void *) cmd_line,(void *) name, len); + cmd_line[len] = '\0'; + if (access(cmd_line,X_OK) != 0) { + int save_errno = errno; + erts_free(ERTS_ALC_T_TMP, cmd_line); + errno = save_errno; + return ERL_DRV_ERROR_ERRNO; + } + } else { + /* make the string suitable for giving to "sh" */ + len = strlen(name); + cmd_line = (char *) erts_alloc_fnf(ERTS_ALC_T_TMP, + CMD_LINE_PREFIX_STR_SZ + len + 1); + if (!cmd_line) { + close_pipes(ifd, ofd, opts->read_write); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + memcpy((void *) cmd_line, + (void *) CMD_LINE_PREFIX_STR, + CMD_LINE_PREFIX_STR_SZ); + memcpy((void *) (cmd_line + CMD_LINE_PREFIX_STR_SZ), (void *) name, len); + cmd_line[CMD_LINE_PREFIX_STR_SZ + len] = '\0'; + } + + erts_smp_rwmtx_rlock(&environ_rwmtx); + + if (opts->envir == NULL) { + new_environ = environ; + } else if ((new_environ = build_unix_environment(opts->envir)) == NULL) { + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + +#ifndef QNX + /* Block child from SIGINT and SIGUSR1. Must be before fork() + to be safe. */ + block_signals(); + + CHLD_STAT_LOCK; + + unbind = erts_is_scheduler_bound(NULL); + if (unbind) + erts_smp_rwmtx_rlock(&erts_cpu_bind_rwmtx); + +#if !DISABLE_VFORK + /* See fork/vfork discussion before this function. */ + if (no_vfork) { +#endif + + DEBUGF(("Using fork\n")); + pid = fork(); + + if (pid == 0) { + /* The child! Setup child... */ + + if (unbind && erts_unbind_from_cpu(erts_cpuinfo) != 0) + goto child_error; + + /* OBSERVE! + * Keep child setup after vfork() (implemented below and in + * erl_child_setup.c) up to date if changes are made here. + */ + + if (opts->use_stdio) { + if (opts->read_write & DO_READ) { + /* stdout for process */ + if (dup2(ifd[1], 1) < 0) + goto child_error; + if(opts->redir_stderr) + /* stderr for process */ + if (dup2(ifd[1], 2) < 0) + goto child_error; + } + if (opts->read_write & DO_WRITE) + /* stdin for process */ + if (dup2(ofd[0], 0) < 0) + goto child_error; + } + else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ + if (opts->read_write & DO_READ) + if (dup2(ifd[1], 4) < 0) + goto child_error; + if (opts->read_write & DO_WRITE) + if (dup2(ofd[0], 3) < 0) + goto child_error; + } + + for (i = opts->use_stdio ? 3 : 5; i < max_files; i++) + (void) close(i); + + if (opts->wd && chdir(opts->wd) < 0) + goto child_error; + +#if defined(USE_SETPGRP_NOARGS) /* SysV */ + (void) setpgrp(); +#elif defined(USE_SETPGRP) /* BSD */ + (void) setpgrp(0, getpid()); +#else /* POSIX */ + (void) setsid(); +#endif + + unblock_signals(); + + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + if (opts->argv == NULL) { + execle(cmd_line,cmd_line,(char *) NULL, new_environ); + } else { + if (opts->argv[0] == erts_default_arg0) { + opts->argv[0] = cmd_line; + } + execve(cmd_line, opts->argv, new_environ); + if (opts->argv[0] == cmd_line) { + opts->argv[0] = erts_default_arg0; + } + } + } else { + execle("/bin/sh", "sh", "-c", cmd_line, (char *) NULL, new_environ); + } + child_error: + _exit(1); + } +#if !DISABLE_VFORK + } + else { /* Use vfork() */ + char **cs_argv= erts_alloc(ERTS_ALC_T_TMP,(CS_ARGV_NO_OF_ARGS + 1)* + sizeof(char *)); + char fd_close_range[44]; /* 44 bytes are enough to */ + char dup2_op[CS_ARGV_NO_OF_DUP2_OPS][44]; /* hold any "%d:%d" string */ + /* on a 64-bit machine. */ + + /* Setup argv[] for the child setup program (implemented in + erl_child_setup.c) */ + i = 0; + if (opts->use_stdio) { + if (opts->read_write & DO_READ){ + /* stdout for process */ + sprintf(&dup2_op[i++][0], "%d:%d", ifd[1], 1); + if(opts->redir_stderr) + /* stderr for process */ + sprintf(&dup2_op[i++][0], "%d:%d", ifd[1], 2); + } + if (opts->read_write & DO_WRITE) + /* stdin for process */ + sprintf(&dup2_op[i++][0], "%d:%d", ofd[0], 0); + } else { /* XXX will fail if ofd[0] == 4 (unlikely..) */ + if (opts->read_write & DO_READ) + sprintf(&dup2_op[i++][0], "%d:%d", ifd[1], 4); + if (opts->read_write & DO_WRITE) + sprintf(&dup2_op[i++][0], "%d:%d", ofd[0], 3); + } + for (; i < CS_ARGV_NO_OF_DUP2_OPS; i++) + strcpy(&dup2_op[i][0], "-"); + sprintf(fd_close_range, "%d:%d", opts->use_stdio ? 3 : 5, max_files-1); + + cs_argv[CS_ARGV_PROGNAME_IX] = child_setup_prog; + cs_argv[CS_ARGV_WD_IX] = opts->wd ? opts->wd : "."; + cs_argv[CS_ARGV_UNBIND_IX] + = (unbind ? erts_get_unbind_from_cpu_str(erts_cpuinfo) : "false"); + cs_argv[CS_ARGV_FD_CR_IX] = fd_close_range; + for (i = 0; i < CS_ARGV_NO_OF_DUP2_OPS; i++) + cs_argv[CS_ARGV_DUP2_OP_IX(i)] = &dup2_op[i][0]; + + if (opts->spawn_type == ERTS_SPAWN_EXECUTABLE) { + int num = 0; + int j = 0; + if (opts->argv != NULL) { + for(; opts->argv[num] != NULL; ++num) + ; + } + cs_argv = erts_realloc(ERTS_ALC_T_TMP,cs_argv, (CS_ARGV_NO_OF_ARGS + 1 + num + 1) * sizeof(char *)); + cs_argv[CS_ARGV_CMD_IX] = "-"; + cs_argv[CS_ARGV_NO_OF_ARGS] = cmd_line; + if (opts->argv != NULL) { + for (;opts->argv[j] != NULL; ++j) { + if (opts->argv[j] == erts_default_arg0) { + cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = cmd_line; + } else { + cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = opts->argv[j]; + } + } + } + cs_argv[CS_ARGV_NO_OF_ARGS + 1 + j] = NULL; + } else { + cs_argv[CS_ARGV_CMD_IX] = cmd_line; /* Command */ + cs_argv[CS_ARGV_NO_OF_ARGS] = NULL; + } + DEBUGF(("Using vfork\n")); + pid = vfork(); + + if (pid == 0) { + /* The child! */ + + /* Observe! + * OTP-4389: The child setup program (implemented in + * erl_child_setup.c) will perform the necessary setup of the + * child before it execs to the user program. This because + * vfork() only allow an *immediate* execve() or _exit() in the + * child. + */ + execve(child_setup_prog, cs_argv, new_environ); + _exit(1); + } + erts_free(ERTS_ALC_T_TMP,cs_argv); + } +#endif + + if (unbind) + erts_smp_rwmtx_runlock(&erts_cpu_bind_rwmtx); + + if (pid == -1) { + saved_errno = errno; + CHLD_STAT_UNLOCK; + erts_smp_rwmtx_runlock(&environ_rwmtx); + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + unblock_signals(); + close_pipes(ifd, ofd, opts->read_write); + errno = saved_errno; + return ERL_DRV_ERROR_ERRNO; + } +#else /* QNX */ + if (opts->use_stdio) { + if (opts->read_write & DO_READ) + qnx_spawn_options.iov[1] = ifd[1]; /* stdout for process */ + if (opts->read_write & DO_WRITE) + qnx_spawn_options.iov[0] = ofd[0]; /* stdin for process */ + } + else { + if (opts->read_write & DO_READ) + qnx_spawn_options.iov[4] = ifd[1]; + if (opts->read_write & DO_WRITE) + qnx_spawn_options.iov[3] = ofd[0]; + } + /* Close fds on exec */ + for (i = 3; i < max_files; i++) + fcntl(i, F_SETFD, 1); + + qnx_spawn_options.flags = _SPAWN_SETSID; + if ((pid = spawnl(P_NOWAIT, "/bin/sh", "/bin/sh", "-c", cmd_line, + (char *) 0)) < 0) { + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + reset_qnx_spawn(); + erts_smp_rwmtx_runlock(&environ_rwmtx); + close_pipes(ifd, ofd, opts->read_write); + return ERL_DRV_ERROR_GENERAL; + } + reset_qnx_spawn(); +#endif /* QNX */ + + erts_free(ERTS_ALC_T_TMP, (void *) cmd_line); + + if (new_environ != environ) + erts_free(ERTS_ALC_T_ENVIRONMENT, (void *) new_environ); + + if (opts->read_write & DO_READ) + (void) close(ifd[1]); + if (opts->read_write & DO_WRITE) + (void) close(ofd[0]); + + if (opts->read_write & DO_READ) { + SET_NONBLOCKING(ifd[0]); + init_fd_data(ifd[0], port_num); + } + if (opts->read_write & DO_WRITE) { + SET_NONBLOCKING(ofd[1]); + init_fd_data(ofd[1], port_num); + } + + res = set_driver_data(port_num, ifd[0], ofd[1], opts->packet_bytes, + opts->read_write, opts->exit_status, pid); + /* Don't unblock SIGCHLD until now, since the call above must + first complete putting away the info about our new subprocess. */ + unblock_signals(); + +#if CHLDWTHR + ASSERT(children_alive >= 0); + + if (!(children_alive++)) + CHLD_STAT_SIGNAL; /* Wake up child waiter thread if no children + was alive before we fork()ed ... */ +#endif + /* Don't unlock chld_stat_mtx until now of the same reason as above */ + CHLD_STAT_UNLOCK; + + erts_smp_rwmtx_runlock(&environ_rwmtx); + + return (ErlDrvData)res; +#undef CMD_LINE_PREFIX_STR +#undef CMD_LINE_PREFIX_STR_SZ +} + +#ifdef QNX +static reset_qnx_spawn() +{ + int i; + + /* Reset qnx_spawn_options */ + qnx_spawn_options.flags = 0; + qnx_spawn_options.iov[0] = 0xff; + qnx_spawn_options.iov[1] = 0xff; + qnx_spawn_options.iov[2] = 0xff; + qnx_spawn_options.iov[3] = 0xff; +} +#endif + +#define FD_DEF_HEIGHT 24 +#define FD_DEF_WIDTH 80 +/* Control op */ +#define FD_CTRL_OP_GET_WINSIZE 100 + +static int fd_get_window_size(int fd, Uint32 *width, Uint32 *height) +{ +#ifdef TIOCGWINSZ + struct winsize ws; + if (ioctl(fd,TIOCGWINSZ,&ws) == 0) { + *width = (Uint32) ws.ws_col; + *height = (Uint32) ws.ws_row; + return 0; + } +#endif + return -1; +} + +static int fd_control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + int fd = (int)(long)drv_data; + char resbuff[2*sizeof(Uint32)]; + switch (command) { + case FD_CTRL_OP_GET_WINSIZE: + { + Uint32 w,h; + if (fd_get_window_size(fd,&w,&h)) + return 0; + memcpy(resbuff,&w,sizeof(Uint32)); + memcpy(resbuff+sizeof(Uint32),&h,sizeof(Uint32)); + } + break; + default: + return 0; + } + if (rlen < 2*sizeof(Uint32)) { + *rbuf = driver_alloc(2*sizeof(Uint32)); + } + memcpy(*rbuf,resbuff,2*sizeof(Uint32)); + return 2*sizeof(Uint32); +} + +static ErlDrvData fd_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) +{ + ErlDrvData res; + + if (((opts->read_write & DO_READ) && opts->ifd >= max_files) || + ((opts->read_write & DO_WRITE) && opts->ofd >= max_files)) + return ERL_DRV_ERROR_GENERAL; + + /* + * Historical: + * + * "Note about nonblocking I/O. + * + * At least on Solaris, setting the write end of a TTY to nonblocking, + * will set the input end to nonblocking as well (and vice-versa). + * If erl is run in a pipeline like this: cat | erl + * the input end of the TTY will be the standard input of cat. + * And cat is not prepared to handle nonblocking I/O." + * + * Actually, the reason for this is not that the tty itself gets set + * in non-blocking mode, but that the "input end" (cat's stdin) and + * the "output end" (erlang's stdout) are typically the "same" file + * descriptor, dup()'ed from a single fd by one of this process' + * ancestors. + * + * The workaround for this problem used to be a rather bad kludge, + * interposing an extra process ("internal cat") between erlang's + * stdout and the original stdout, allowing erlang to set its stdout + * in non-blocking mode without affecting the stdin of the preceding + * process in the pipeline - and being a kludge, it caused all kinds + * of weird problems. + * + * So, this is the current logic: + * + * The only reason to set non-blocking mode on the output fd at all is + * if it's something that can cause a write() to block, of course, + * i.e. primarily if it points to a tty, socket, pipe, or fifo. + * + * If we don't set non-blocking mode when we "should" have, and output + * becomes blocked, the entire runtime system will be suspended - this + * is normally bad of course, and can happen fairly "easily" - e.g. user + * hits ^S on tty - but doesn't necessarily happen. + * + * If we do set non-blocking mode when we "shouldn't" have, the runtime + * system will end up seeing EOF on the input fd (due to the preceding + * process dying), which typically will cause the entire runtime system + * to terminate immediately (due to whatever erlang process is seeing + * the EOF taking it as a signal to halt the system). This is *very* bad. + * + * I.e. we should take a conservative approach, and only set non- + * blocking mode when we a) need to, and b) are reasonably certain + * that it won't be a problem. And as in the example above, the problem + * occurs when input fd and output fd point to different "things". + * + * However, determining that they are not just the same "type" of + * "thing", but actually the same instance of that type of thing, is + * unreasonably complex in many/most cases. + * + * Also, with pipes, sockets, and fifos it's far from obvious that the + * user *wants* non-blocking output: If you're running erlang inside + * some complex pipeline, you're probably not running a real-time system + * that must never stop, but rather *want* it to suspend if the output + * channel is "full". + * + * So, the bottom line: We will only set the output fd non-blocking if + * it points to a tty, and either a) the input fd also points to a tty, + * or b) we can make sure that setting the output fd non-blocking + * doesn't interfere with someone else's input, via a somewhat milder + * kludge than the above. + * + * Also keep in mind that while this code is almost exclusively run as + * a result of an erlang open_port({fd,0,1}, ...), that isn't the only + * case - it can be called with any old pre-existing file descriptors, + * the relations between which (if they're even two) we can only guess + * at - still, we try our best... + */ + + if (opts->read_write & DO_READ) { + init_fd_data(opts->ifd, port_num); + } + if (opts->read_write & DO_WRITE) { + init_fd_data(opts->ofd, port_num); + + /* If we don't have a read end, all bets are off - no non-blocking. */ + if (opts->read_write & DO_READ) { + + if (isatty(opts->ofd)) { /* output fd is a tty:-) */ + + if (isatty(opts->ifd)) { /* input fd is also a tty */ + + /* To really do this "right", we should also check that + input and output fd point to the *same* tty - but + this seems like overkill; ttyname() isn't for free, + and this is a very common case - and it's hard to + imagine a scenario where setting non-blocking mode + here would cause problems - go ahead and do it. */ + + SET_NONBLOCKING(opts->ofd); + + } else { /* output fd is a tty, input fd isn't */ + + /* This is a "problem case", but also common (see the + example above) - i.e. it makes sense to try a bit + harder before giving up on non-blocking mode: Try to + re-open the tty that the output fd points to, and if + successful replace the original one with the "new" fd + obtained this way, and set *that* one in non-blocking + mode. (Yes, this is a kludge.) + + However, re-opening the tty may fail in a couple of + (unusual) cases: + + 1) The name of the tty (or an equivalent one, i.e. + same major/minor number) can't be found, because + it actually lives somewhere other than /dev (or + wherever ttyname() looks for it), and isn't + equivalent to any of those that do live in the + "standard" place - this should be *very* unusual. + + 2) Permissions on the tty don't allow us to open it - + it's perfectly possible to have an fd open to an + object whose permissions wouldn't allow us to open + it. This is not as unusual as it sounds, one case + is if the user has su'ed to someone else (not + root) - we have a read/write fd open to the tty + (because it has been inherited all the way down + here), but we have neither read nor write + permission for the tty. + + In these cases, we finally give up, and don't set the + output fd in non-blocking mode. */ + + char *tty; + int nfd; + + if ((tty = ttyname(opts->ofd)) != NULL && + (nfd = open(tty, O_WRONLY)) != -1) { + dup2(nfd, opts->ofd); + close(nfd); + SET_NONBLOCKING(opts->ofd); + } + } + } + } + } + CHLD_STAT_LOCK; + res = (ErlDrvData)(long)set_driver_data(port_num, opts->ifd, opts->ofd, + opts->packet_bytes, + opts->read_write, 0, -1); + CHLD_STAT_UNLOCK; + return res; +} + +static void clear_fd_data(int fd) +{ + if (fd_data[fd].sz > 0) { + erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf); + ASSERT(erts_smp_atomic_read(&sys_misc_mem_sz) >= fd_data[fd].sz); + erts_smp_atomic_add(&sys_misc_mem_sz, -1*fd_data[fd].sz); + } + fd_data[fd].buf = NULL; + fd_data[fd].sz = 0; + fd_data[fd].remain = 0; + fd_data[fd].cpos = NULL; + fd_data[fd].psz = 0; +} + +static void nbio_stop_fd(int prt, int fd) +{ + driver_select(prt,fd,DO_READ|DO_WRITE,0); + clear_fd_data(fd); + SET_BLOCKING(fd); +} + +static void fd_stop(ErlDrvData fd) /* Does not close the fds */ +{ + int ofd; + + nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)fd); + ofd = driver_data[(int)(long)fd].ofd; + if (ofd != (int)(long)fd && ofd != -1) + nbio_stop_fd(driver_data[(int)(long)fd].port_num, (int)(long)ofd); +} + +static ErlDrvData vanilla_start(ErlDrvPort port_num, char* name, + SysDriverOpts* opts) +{ + int flags, fd; + ErlDrvData res; + + flags = (opts->read_write == DO_READ ? O_RDONLY : + opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC : + O_RDWR|O_CREAT); + if ((fd = open(name, flags, 0666)) < 0) + return ERL_DRV_ERROR_GENERAL; + if (fd >= max_files) { + close(fd); + return ERL_DRV_ERROR_GENERAL; + } + SET_NONBLOCKING(fd); + init_fd_data(fd, port_num); + + CHLD_STAT_LOCK; + res = (ErlDrvData)(long)set_driver_data(port_num, fd, fd, + opts->packet_bytes, + opts->read_write, 0, -1); + CHLD_STAT_UNLOCK; + return res; +} + +/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */ +/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */ + +static void stop(ErlDrvData fd) +{ + int prt, ofd; + + prt = driver_data[(int)(long)fd].port_num; + nbio_stop_fd(prt, (int)(long)fd); + + ofd = driver_data[(int)(long)fd].ofd; + if (ofd != (int)(long)fd && (int)(long)ofd != -1) + nbio_stop_fd(prt, ofd); + else + ofd = -1; + + CHLD_STAT_LOCK; + + /* Mark as unused. Maybe resetting the 'port_num' slot is better? */ + driver_data[(int)(long)fd].pid = -1; + + CHLD_STAT_UNLOCK; + + /* SMP note: Close has to be last thing done (open file descriptors work + as locks on driver_data[] entries) */ + driver_select(prt, (int)(long)fd, ERL_DRV_USE, 0); /* close(fd); */ + if (ofd >= 0) { + driver_select(prt, (int)(long)ofd, ERL_DRV_USE, 0); /* close(ofd); */ + } +} + +static void outputv(ErlDrvData e, ErlIOVec* ev) +{ + int fd = (int)(long)e; + int ix = driver_data[fd].port_num; + int pb = driver_data[fd].packet_bytes; + int ofd = driver_data[fd].ofd; + int n; + int sz; + char lb[4]; + char* lbp; + int len = ev->size; + + /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ + if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { + driver_failure_posix(ix, EINVAL); + return; /* -1; */ + } + put_int32(len, lb); + lbp = lb + (4-pb); + + ev->iov[0].iov_base = lbp; + ev->iov[0].iov_len = pb; + ev->size += pb; + if ((sz = driver_sizeq(ix)) > 0) { + driver_enqv(ix, ev, 0); + if (sz + ev->size >= (1 << 13)) + set_busy_port(ix, 1); + } + else { + int vsize = ev->vsize > MAX_VSIZE ? MAX_VSIZE : ev->vsize; + + n = writev(ofd, (const void *) (ev->iov), vsize); + if (n == ev->size) + return; /* 0;*/ + if (n < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { + driver_failure_posix(ix, errno); + return; /* -1;*/ + } + n = 0; + } + driver_enqv(ix, ev, n); /* n is the skip value */ + driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + } + /* return 0;*/ +} + + +static void output(ErlDrvData e, char* buf, int len) +{ + int fd = (int)(long)e; + int ix = driver_data[fd].port_num; + int pb = driver_data[fd].packet_bytes; + int ofd = driver_data[fd].ofd; + int n; + int sz; + char lb[4]; + char* lbp; + struct iovec iv[2]; + + /* (len > ((unsigned long)-1 >> (4-pb)*8)) */ + if (((pb == 2) && (len > 0xffff)) || (pb == 1 && len > 0xff)) { + driver_failure_posix(ix, EINVAL); + return; /* -1; */ + } + put_int32(len, lb); + lbp = lb + (4-pb); + + if ((sz = driver_sizeq(ix)) > 0) { + driver_enq(ix, lbp, pb); + driver_enq(ix, buf, len); + if (sz + len + pb >= (1 << 13)) + set_busy_port(ix, 1); + } + else { + iv[0].iov_base = lbp; + iv[0].iov_len = pb; /* should work for pb=0 */ + iv[1].iov_base = buf; + iv[1].iov_len = len; + n = writev(ofd, iv, 2); + if (n == pb+len) + return; /* 0; */ + if (n < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) { + driver_failure_posix(ix, errno); + return; /* -1; */ + } + n = 0; + } + if (n < pb) { + driver_enq(ix, lbp+n, pb-n); + driver_enq(ix, buf, len); + } + else { + n -= pb; + driver_enq(ix, buf+n, len-n); + } + driver_select(ix, ofd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + } + return; /* 0; */ +} + +static int port_inp_failure(int port_num, int ready_fd, int res) + /* Result: 0 (eof) or -1 (error) */ +{ + int err = errno; + + ASSERT(res <= 0); + (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); + clear_fd_data(ready_fd); + if (res == 0) { + if (driver_data[ready_fd].report_exit) { + CHLD_STAT_LOCK; + + if (driver_data[ready_fd].alive) { + /* + * We have eof and want to report exit status, but the process + * hasn't exited yet. When it does report_exit_status() will + * driver_select() this fd which will make sure that we get + * back here with driver_data[ready_fd].alive == 0 and + * driver_data[ready_fd].status set. + */ + CHLD_STAT_UNLOCK; + return 0; + } + else { + int status = driver_data[ready_fd].status; + CHLD_STAT_UNLOCK; + + /* We need not be prepared for stopped/continued processes. */ + if (WIFSIGNALED(status)) + status = 128 + WTERMSIG(status); + else + status = WEXITSTATUS(status); + + driver_report_exit(driver_data[ready_fd].port_num, status); + } + } + driver_failure_eof(port_num); + } else { + driver_failure_posix(port_num, err); + } + return 0; +} + +/* fd is the drv_data that is returned from the */ +/* initial start routine */ +/* ready_fd is the descriptor that is ready to read */ + +static void ready_input(ErlDrvData e, ErlDrvEvent ready_fd) +{ + int fd = (int)(long)e; + int port_num; + int packet_bytes; + int res; + Uint h; + + port_num = driver_data[fd].port_num; + packet_bytes = driver_data[fd].packet_bytes; + + if (packet_bytes == 0) { + byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, + ERTS_SYS_READ_BUF_SZ); + res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(port_num, ready_fd, res); + } + else if (res == 0) + port_inp_failure(port_num, ready_fd, res); + else + driver_output(port_num, (char*) read_buf, res); + erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); + } + else if (fd_data[ready_fd].remain > 0) { /* We try to read the remainder */ + /* space is allocated in buf */ + res = read(ready_fd, fd_data[ready_fd].cpos, + fd_data[ready_fd].remain); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(port_num, ready_fd, res); + } + else if (res == 0) { + port_inp_failure(port_num, ready_fd, res); + } + else if (res == fd_data[ready_fd].remain) { /* we're done */ + driver_output(port_num, fd_data[ready_fd].buf, + fd_data[ready_fd].sz); + clear_fd_data(ready_fd); + } + else { /* if (res < fd_data[ready_fd].remain) */ + fd_data[ready_fd].cpos += res; + fd_data[ready_fd].remain -= res; + } + } + else if (fd_data[ready_fd].remain == 0) { /* clean fd */ + byte *read_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_READ_BUF, + ERTS_SYS_READ_BUF_SZ); + /* We make one read attempt and see what happens */ + res = read(ready_fd, read_buf, ERTS_SYS_READ_BUF_SZ); + if (res < 0) { + if ((errno != EINTR) && (errno != ERRNO_BLOCK)) + port_inp_failure(port_num, ready_fd, res); + } + else if (res == 0) { /* eof */ + port_inp_failure(port_num, ready_fd, res); + } + else if (res < packet_bytes - fd_data[ready_fd].psz) { + memcpy(fd_data[ready_fd].pbuf+fd_data[ready_fd].psz, + read_buf, res); + fd_data[ready_fd].psz += res; + } + else { /* if (res >= packet_bytes) */ + unsigned char* cpos = read_buf; + int bytes_left = res; + + while (1) { + int psz = fd_data[ready_fd].psz; + char* pbp = fd_data[ready_fd].pbuf + psz; + + while(bytes_left && (psz < packet_bytes)) { + *pbp++ = *cpos++; + bytes_left--; + psz++; + } + + if (psz < packet_bytes) { + fd_data[ready_fd].psz = psz; + break; + } + fd_data[ready_fd].psz = 0; + + switch (packet_bytes) { + case 1: h = get_int8(fd_data[ready_fd].pbuf); break; + case 2: h = get_int16(fd_data[ready_fd].pbuf); break; + case 4: h = get_int32(fd_data[ready_fd].pbuf); break; + default: ASSERT(0); return; /* -1; */ + } + + if (h <= (bytes_left)) { + driver_output(port_num, (char*) cpos, h); + cpos += h; + bytes_left -= h; + continue; + } + else { /* The last message we got was split */ + char *buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); + if (!buf) { + errno = ENOMEM; + port_inp_failure(port_num, ready_fd, -1); + } + else { + erts_smp_atomic_add(&sys_misc_mem_sz, h); + sys_memcpy(buf, cpos, bytes_left); + fd_data[ready_fd].buf = buf; + fd_data[ready_fd].sz = h; + fd_data[ready_fd].remain = h - bytes_left; + fd_data[ready_fd].cpos = buf + bytes_left; + } + break; + } + } + } + erts_free(ERTS_ALC_T_SYS_READ_BUF, (void *) read_buf); + } +} + + +/* fd is the drv_data that is returned from the */ +/* initial start routine */ +/* ready_fd is the descriptor that is ready to read */ + +static void ready_output(ErlDrvData e, ErlDrvEvent ready_fd) +{ + int fd = (int)(long)e; + int ix = driver_data[fd].port_num; + int n; + struct iovec* iv; + int vsize; + + + if ((iv = (struct iovec*) driver_peekq(ix, &vsize)) == NULL) { + driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + return; /* 0; */ + } + vsize = vsize > MAX_VSIZE ? MAX_VSIZE : vsize; + if ((n = writev(ready_fd, iv, vsize)) > 0) { + if (driver_deq(ix, n) == 0) + set_busy_port(ix, 0); + } + else if (n < 0) { + if (errno == ERRNO_BLOCK || errno == EINTR) + return; /* 0; */ + else { + int res = errno; + driver_select(ix, ready_fd, ERL_DRV_WRITE, 0); + driver_failure_posix(ix, res); + return; /* -1; */ + } + } + return; /* 0; */ +} + +static void stop_select(ErlDrvEvent fd, void* _) +{ + close((int)fd); +} + +/* +** Async opertation support +*/ +#if defined(USE_THREADS) && !defined(ERTS_SMP) +static void +sys_async_ready_failed(int fd, int r, int err) +{ + char buf[120]; + sprintf(buf, "sys_async_ready(): Fatal error: fd=%d, r=%d, errno=%d\n", + fd, r, err); + (void) write(2, buf, strlen(buf)); + abort(); +} + +/* called from threads !! */ +void sys_async_ready(int fd) +{ + int r; + while (1) { + r = write(fd, "0", 1); /* signal main thread fd MUST be async_fd[1] */ + if (r == 1) { + DEBUGF(("sys_async_ready(): r = 1\r\n")); + break; + } + if (r < 0 && errno == EINTR) { + DEBUGF(("sys_async_ready(): r = %d\r\n", r)); + continue; + } + sys_async_ready_failed(fd, r, errno); + } +} + +static int async_drv_init(void) +{ + async_fd[0] = -1; + async_fd[1] = -1; + return 0; +} + +static ErlDrvData async_drv_start(ErlDrvPort port_num, + char* name, SysDriverOpts* opts) +{ + if (async_fd[0] != -1) + return ERL_DRV_ERROR_GENERAL; + if (pipe(async_fd) < 0) + return ERL_DRV_ERROR_GENERAL; + + DEBUGF(("async_drv_start: %d\r\n", port_num)); + + SET_NONBLOCKING(async_fd[0]); + driver_select(port_num, async_fd[0], ERL_DRV_READ, 1); + + if (init_async(async_fd[1]) < 0) + return ERL_DRV_ERROR_GENERAL; + return (ErlDrvData)port_num; +} + +static void async_drv_stop(ErlDrvData e) +{ + int port_num = (int)(long)e; + + DEBUGF(("async_drv_stop: %d\r\n", port_num)); + + exit_async(); + + driver_select(port_num, async_fd[0], ERL_DRV_READ, 0); + + close(async_fd[0]); + close(async_fd[1]); + async_fd[0] = async_fd[1] = -1; +} + + +static void async_drv_input(ErlDrvData e, ErlDrvEvent fd) +{ + char *buf[32]; + DEBUGF(("async_drv_input\r\n")); + while (read((int) fd, (void *) buf, 32) > 0); /* fd MUST be async_fd[0] */ + check_async_ready(); /* invoke all async_ready */ +} +#endif + +void erts_do_break_handling(void) +{ + struct termios temp_mode; + int saved = 0; + + /* + * Most functions that do_break() calls are intentionally not thread safe; + * therefore, make sure that all threads but this one are blocked before + * proceeding! + */ + erts_smp_block_system(0); + /* + * NOTE: since we allow gc we are not allowed to lock + * (any) process main locks while blocking system... + */ + + /* during break we revert to initial settings */ + /* this is done differently for oldshell */ + if (using_oldshell && !replace_intr) { + SET_BLOCKING(1); + } + else if (isatty(0)) { + tcgetattr(0,&temp_mode); + tcsetattr(0,TCSANOW,&initial_tty_mode); + saved = 1; + } + + /* call the break handling function, reset the flag */ + do_break(); + + ERTS_UNSET_BREAK_REQUESTED; + + fflush(stdout); + + /* after break we go back to saved settings */ + if (using_oldshell && !replace_intr) { + SET_NONBLOCKING(1); + } + else if (saved) { + tcsetattr(0,TCSANOW,&temp_mode); + } + + erts_smp_release_system(); +} + +/* Fills in the systems representation of the jam/beam process identifier. +** The Pid is put in STRING representation in the supplied buffer, +** no interpretatione of this should be done by the rest of the +** emulator. The buffer should be at least 21 bytes long. +*/ +void sys_get_pid(char *buffer){ + pid_t p = getpid(); + /* Assume the pid is scalar and can rest in an unsigned long... */ + sprintf(buffer,"%lu",(unsigned long) p); +} + +int +erts_sys_putenv(char *buffer, int sep_ix) +{ + int res; + char *env; +#ifdef HAVE_COPYING_PUTENV + env = buffer; +#else + Uint sz = strlen(buffer)+1; + env = erts_alloc(ERTS_ALC_T_PUTENV_STR, sz); + erts_smp_atomic_add(&sys_misc_mem_sz, sz); + strcpy(env,buffer); +#endif + erts_smp_rwmtx_rwlock(&environ_rwmtx); + res = putenv(env); + erts_smp_rwmtx_rwunlock(&environ_rwmtx); + return res; +} + +int +erts_sys_getenv(char *key, char *value, size_t *size) +{ + char *orig_value; + int res; + erts_smp_rwmtx_rlock(&environ_rwmtx); + orig_value = getenv(key); + if (!orig_value) + res = -1; + else { + size_t len = sys_strlen(orig_value); + if (len >= *size) { + *size = len + 1; + res = 1; + } + else { + *size = len; + sys_memcpy((void *) value, (void *) orig_value, len+1); + res = 0; + } + } + erts_smp_rwmtx_runlock(&environ_rwmtx); + return res; +} + +void +sys_init_io(void) +{ + fd_data = (struct fd_data *) + erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data)); + erts_smp_atomic_add(&sys_misc_mem_sz, + max_files * sizeof(struct fd_data)); + +#ifdef USE_THREADS +#ifdef ERTS_SMP + if (init_async(-1) < 0) + erl_exit(1, "Failed to initialize async-threads\n"); +#else + { + /* This is speical stuff, starting a driver from the + * system routines, but is a nice way of handling stuff + * the erlang way + */ + SysDriverOpts dopts; + int ret; + + sys_memset((void*)&dopts, 0, sizeof(SysDriverOpts)); + add_driver_entry(&async_driver_entry); + ret = erts_open_driver(NULL, NIL, "async", &dopts, NULL); + DEBUGF(("open_driver = %d\n", ret)); + if (ret < 0) + erl_exit(1, "Failed to open async driver\n"); + erts_port[ret].status |= ERTS_PORT_SFLG_IMMORTAL; + } +#endif +#endif + +} + +#if (0) /* unused? */ +static int write_fill(fd, buf, len) +int fd, len; +char *buf; +{ + int i, done = 0; + + do { + if ((i = write(fd, buf+done, len-done)) < 0) { + if (errno != EINTR) + return (i); + i = 0; + } + done += i; + } while (done < len); + return (len); +} +#endif + +extern const char pre_loaded_code[]; +extern Preload pre_loaded[]; + +void erts_sys_alloc_init(void) +{ + elib_ensure_initialized(); +} + +void *erts_sys_alloc(ErtsAlcType_t t, void *x, Uint sz) +{ + void *res = malloc((size_t) sz); +#if HAVE_ERTS_MSEG + if (!res) { + erts_mseg_clear_cache(); + return malloc((size_t) sz); + } +#endif + return res; +} + +void *erts_sys_realloc(ErtsAlcType_t t, void *x, void *p, Uint sz) +{ + void *res = realloc(p, (size_t) sz); +#if HAVE_ERTS_MSEG + if (!res) { + erts_mseg_clear_cache(); + return realloc(p, (size_t) sz); + } +#endif + return res; +} + +void erts_sys_free(ErtsAlcType_t t, void *x, void *p) +{ + free(p); +} + +/* Return a pointer to a vector of names of preloaded modules */ + +Preload* +sys_preloaded(void) +{ + return pre_loaded; +} + +/* Return a pointer to preloaded code for module "module" */ +unsigned char* +sys_preload_begin(Preload* p) +{ + return p->code; +} + +/* Clean up if allocated */ +void sys_preload_end(Preload* p) +{ + /* Nothing */ +} + +/* Read a key from console (?) */ + +int sys_get_key(fd) +int fd; +{ + int c; + unsigned char rbuf[64]; + + fflush(stdout); /* Flush query ??? */ + + if ((c = read(fd,rbuf,64)) <= 0) { + return c; + } + + return rbuf[0]; +} + + +#ifdef DEBUG + +extern int erts_initialized; +void +erl_assert_error(char* expr, char* file, int line) +{ + fflush(stdout); + fprintf(stderr, "Assertion failed: %s in %s, line %d\n", + expr, file, line); + fflush(stderr); +#if !defined(ERTS_SMP) && 0 + /* Writing a crashdump from a failed assertion when smp support + * is enabled almost a guaranteed deadlocking, don't even bother. + * + * It could maybe be useful (but I'm not convinced) to write the + * crashdump if smp support is disabled... + */ + if (erts_initialized) + erl_crash_dump(file, line, "Assertion failed: %s\n", expr); +#endif + abort(); +} + +void +erl_debug(char* fmt, ...) +{ + char sbuf[1024]; /* Temporary buffer. */ + va_list va; + + if (debug_log) { + va_start(va, fmt); + vsprintf(sbuf, fmt, va); + va_end(va); + fprintf(stderr, "%s", sbuf); + } +} + +#endif /* DEBUG */ + +static ERTS_INLINE void +report_exit_status(ErtsSysReportExit *rep, int status) +{ + Port *pp; +#ifdef ERTS_SMP + CHLD_STAT_UNLOCK; +#endif + pp = erts_id2port_sflgs(rep->port, + NULL, + 0, + ERTS_PORT_SFLGS_INVALID_DRIVER_LOOKUP); +#ifdef ERTS_SMP + CHLD_STAT_LOCK; +#endif + if (pp) { + if (rep->ifd >= 0) { + driver_data[rep->ifd].alive = 0; + driver_data[rep->ifd].status = status; + (void) driver_select((ErlDrvPort) internal_port_index(pp->id), + rep->ifd, + (ERL_DRV_READ|ERL_DRV_USE), + 1); + } + if (rep->ofd >= 0) { + driver_data[rep->ofd].alive = 0; + driver_data[rep->ofd].status = status; + (void) driver_select((ErlDrvPort) internal_port_index(pp->id), + rep->ofd, + (ERL_DRV_WRITE|ERL_DRV_USE), + 1); + } + erts_port_release(pp); + } + erts_free(ERTS_ALC_T_PRT_REP_EXIT, rep); +} + +#if !CHLDWTHR /* ---------------------------------------------------------- */ + +#define ERTS_REPORT_EXIT_STATUS report_exit_status + +static int check_children(void) +{ + int res = 0; + int pid; + int status; + +#ifndef ERTS_SMP + if (children_died) +#endif + { + sys_sigblock(SIGCHLD); + CHLD_STAT_LOCK; + while ((pid = waitpid(-1, &status, WNOHANG)) > 0) + note_child_death(pid, status); +#ifndef ERTS_SMP + children_died = 0; +#endif + CHLD_STAT_UNLOCK; + sys_sigrelease(SIGCHLD); + res = 1; + } + return res; +} + +#ifdef ERTS_SMP + +void +erts_check_children(void) +{ + (void) check_children(); +} + +#endif + +#elif CHLDWTHR && defined(ERTS_SMP) /* ------------------------------------- */ + +#define ERTS_REPORT_EXIT_STATUS report_exit_status + +#define check_children() (0) + + +#else /* CHLDWTHR && !defined(ERTS_SMP) ------------------------------------ */ + +#define ERTS_REPORT_EXIT_STATUS initiate_report_exit_status + +static ERTS_INLINE void +initiate_report_exit_status(ErtsSysReportExit *rep, int status) +{ + rep->next = report_exit_transit_list; + rep->status = status; + report_exit_transit_list = rep; + /* + * We need the scheduler thread to call check_children(). + * If the scheduler thread is sleeping in a poll with a + * timeout, we need to wake the scheduler thread. We use the + * functionality of the async driver to do this, instead of + * implementing yet another driver doing the same thing. A + * little bit ugly, but it works... + */ + sys_async_ready(async_fd[1]); +} + +static int check_children(void) +{ + int res; + ErtsSysReportExit *rep; + CHLD_STAT_LOCK; + rep = report_exit_transit_list; + res = rep != NULL; + while (rep) { + ErtsSysReportExit *curr_rep = rep; + rep = rep->next; + report_exit_status(curr_rep, curr_rep->status); + } + report_exit_transit_list = NULL; + CHLD_STAT_UNLOCK; + return res; +} + +#endif /* ------------------------------------------------------------------ */ + +static void note_child_death(int pid, int status) +{ + ErtsSysReportExit **repp = &report_exit_list; + ErtsSysReportExit *rep = report_exit_list; + + while (rep) { + if (pid == rep->pid) { + *repp = rep->next; + ERTS_REPORT_EXIT_STATUS(rep, status); + break; + } + repp = &rep->next; + rep = rep->next; + } +} + +#if CHLDWTHR + +static void * +child_waiter(void *unused) +{ + int pid; + int status; + +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_set_thread_name("child waiter"); +#endif + + while(1) { +#ifdef DEBUG + int waitpid_errno; +#endif + pid = waitpid(-1, &status, 0); +#ifdef DEBUG + waitpid_errno = errno; +#endif + CHLD_STAT_LOCK; + if (pid < 0) { + ASSERT(waitpid_errno == ECHILD); + } + else { + children_alive--; + ASSERT(children_alive >= 0); + note_child_death(pid, status); + } + while (!children_alive) + CHLD_STAT_WAIT; /* Wait for children to wait on... :) */ + CHLD_STAT_UNLOCK; + } + + return NULL; +} + +#endif + +/* + * Called from schedule() when it runs out of runnable processes, + * or when Erlang code has performed INPUT_REDUCTIONS reduction + * steps. runnable == 0 iff there are no runnable Erlang processes. + */ +void +erl_sys_schedule(int runnable) +{ +#ifdef ERTS_SMP + ERTS_CHK_IO(!runnable); + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); +#else + ERTS_CHK_IO_INTR(0); + if (runnable) { + ERTS_CHK_IO(0); /* Poll for I/O */ + check_async_ready(); /* Check async completions */ + } else { + int wait_for_io = !check_async_ready(); + if (wait_for_io) + wait_for_io = !check_children(); + ERTS_CHK_IO(wait_for_io); + } + (void) check_children(); +#endif +} + + +#ifdef ERTS_SMP + +static erts_smp_tid_t sig_dispatcher_tid; + +static void +smp_sig_notify(char c) +{ + int res; + do { + /* write() is async-signal safe (according to posix) */ + res = write(sig_notify_fds[1], &c, 1); + } while (res < 0 && errno == EINTR); + if (res != 1) { + char msg[] = + "smp_sig_notify(): Failed to notify signal-dispatcher thread " + "about received signal"; + (void) write(2, msg, sizeof(msg)); + abort(); + } +} + +static void * +signal_dispatcher_thread_func(void *unused) +{ + int initialized = 0; +#if !CHLDWTHR + int notify_check_children = 0; +#endif +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_set_thread_name("signal_dispatcher"); +#endif + while (1) { + char buf[32]; + int res, i; + /* Block on read() waiting for a signal notification to arrive... */ + res = read(sig_notify_fds[0], (void *) &buf[0], 32); + if (res < 0) { + if (errno == EINTR) + continue; + erl_exit(ERTS_ABORT_EXIT, + "signal-dispatcher thread got unexpected error: %s (%d)\n", + erl_errno_id(errno), + errno); + } + for (i = 0; i < res; i++) { + /* + * NOTE 1: The signal dispatcher thread should not do work + * that takes a substantial amount of time (except + * perhaps in test and debug builds). It needs to + * be responsive, i.e, it should only dispatch work + * to other threads. + * + * NOTE 2: The signal dispatcher thread is not a blockable + * thread (i.e., it hasn't called + * erts_register_blockable_thread()). This is + * intentional. We want to be able to interrupt + * writing of a crash dump by hitting C-c twice. + * Since it isn't a blockable thread it is important + * that it doesn't change the state of any data that + * a blocking thread expects to have exclusive access + * to (unless the signal dispatcher itself explicitly + * is blocking all blockable threads). + */ + switch (buf[i]) { + case 0: /* Emulator initialized */ + initialized = 1; +#if !CHLDWTHR + if (!notify_check_children) +#endif + break; +#if !CHLDWTHR + case 'C': /* SIGCHLD */ + if (initialized) + erts_smp_notify_check_children_needed(); + else + notify_check_children = 1; + break; +#endif + case 'I': /* SIGINT */ + break_requested(); + break; + case 'Q': /* SIGQUIT */ + quit_requested(); + break; + case '1': /* SIGUSR1 */ + sigusr1_exit(); + break; +#ifdef QUANTIFY + case '2': /* SIGUSR2 */ + quantify_save_data(); /* Might take a substantial amount of + time, but this is a test/debug + build */ + break; +#endif + default: + erl_exit(ERTS_ABORT_EXIT, + "signal-dispatcher thread received unknown " + "signal notification: '%c'\n", + buf[i]); + } + } + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); + } + return NULL; +} + +static void +init_smp_sig_notify(void) +{ + erts_smp_thr_opts_t thr_opts = ERTS_SMP_THR_OPTS_DEFAULT_INITER; + thr_opts.detached = 1; + + if (pipe(sig_notify_fds) < 0) { + erl_exit(ERTS_ABORT_EXIT, + "Failed to create signal-dispatcher pipe: %s (%d)\n", + erl_errno_id(errno), + errno); + } + + /* Start signal handler thread */ + erts_smp_thr_create(&sig_dispatcher_tid, + signal_dispatcher_thread_func, + NULL, + &thr_opts); +} + +void +erts_sys_main_thread(void) +{ + erts_thread_disable_fpe(); + /* Become signal receiver thread... */ +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_set_thread_name("signal_receiver"); +#endif + + smp_sig_notify(0); /* Notify initialized */ + while (1) { + /* Wait for a signal to arrive... */ +#ifdef DEBUG + int res = +#else + (void) +#endif + select(0, NULL, NULL, NULL, NULL); + ASSERT(res < 0); + ASSERT(errno == EINTR); + } +} + +#endif /* ERTS_SMP */ + +#ifdef ERTS_ENABLE_KERNEL_POLL /* get_value() is currently only used when + kernel-poll is enabled */ + +/* Get arg marks argument as handled by + putting NULL in argv */ +static char * +get_value(char* rest, char** argv, int* ip) +{ + char *param = argv[*ip]+1; + argv[*ip] = NULL; + if (*rest == '\0') { + char *next = argv[*ip + 1]; + if (next[0] == '-' + && next[1] == '-' + && next[2] == '\0') { + erts_fprintf(stderr, "bad \"%s\" value: \n", param); + erts_usage(); + } + (*ip)++; + argv[*ip] = NULL; + return next; + } + return rest; +} + +#endif /* ERTS_ENABLE_KERNEL_POLL */ + +void +erl_sys_args(int* argc, char** argv) +{ + int i, j; + + i = 1; + + ASSERT(argc && argv); + + while (i < *argc) { + if(argv[i][0] == '-') { + switch (argv[i][1]) { +#ifdef ERTS_ENABLE_KERNEL_POLL + case 'K': { + char *arg = get_value(argv[i] + 2, argv, &i); + if (strcmp("true", arg) == 0) { + erts_use_kernel_poll = 1; + } + else if (strcmp("false", arg) == 0) { + erts_use_kernel_poll = 0; + } + else { + erts_fprintf(stderr, "bad \"K\" value: %s\n", arg); + erts_usage(); + } + break; + } +#endif + case '-': + goto done_parsing; + default: + break; + } + } + i++; + } + + done_parsing: + +#ifdef ERTS_ENABLE_KERNEL_POLL + if (erts_use_kernel_poll) { + char no_kp[10]; + size_t no_kp_sz = sizeof(no_kp); + int res = erts_sys_getenv("ERL_NO_KERNEL_POLL", no_kp, &no_kp_sz); + if (res > 0 + || (res == 0 + && sys_strcmp("false", no_kp) != 0 + && sys_strcmp("FALSE", no_kp) != 0)) { + erts_use_kernel_poll = 0; + } + } +#endif + + init_check_io(); + +#ifdef ERTS_SMP + init_smp_sig_notify(); +#endif + + /* Handled arguments have been marked with NULL. Slide arguments + not handled towards the beginning of argv. */ + for (i = 0, j = 0; i < *argc; i++) { + if (argv[i]) + argv[j++] = argv[i]; + } + *argc = j; +} + + +#ifdef ERTS_TIMER_THREAD + +/* + * Interruptible-wait facility: low-level synchronisation state + * and methods that are implementation dependent. + * + * Constraint: Every implementation must define 'struct erts_iwait' + * with a field 'erts_smp_atomic_t state;'. + */ + +/* values for struct erts_iwait's state field */ +#define IWAIT_WAITING 0 +#define IWAIT_AWAKE 1 +#define IWAIT_INTERRUPT 2 + +#if 0 /* XXX: needs feature test in erts/configure.in */ + +/* + * This is an implementation of the interruptible wait facility on + * top of Linux-specific futexes. + */ +#include +#define FUTEX_WAIT 0 +#define FUTEX_WAKE 1 +static int sys_futex(void *futex, int op, int val, const struct timespec *timeout) +{ + return syscall(__NR_futex, futex, op, val, timeout); +} + +struct erts_iwait { + erts_smp_atomic_t state; /* &state.counter is our futex */ +}; + +static void iwait_lowlevel_init(struct erts_iwait *iwait) { /* empty */ } + +static void iwait_lowlevel_wait(struct erts_iwait *iwait, struct timeval *delay) +{ + struct timespec timeout; + int res; + + timeout.tv_sec = delay->tv_sec; + timeout.tv_nsec = delay->tv_usec * 1000; + res = sys_futex((void*)&iwait->state.counter, FUTEX_WAIT, IWAIT_WAITING, &timeout); + if (res < 0 && errno != ETIMEDOUT && errno != EWOULDBLOCK && errno != EINTR) + perror("FUTEX_WAIT"); +} + +static void iwait_lowlevel_interrupt(struct erts_iwait *iwait) +{ + int res = sys_futex((void*)&iwait->state.counter, FUTEX_WAKE, 1, NULL); + if (res < 0) + perror("FUTEX_WAKE"); +} + +#else /* using poll() or select() */ + +/* + * This is an implementation of the interruptible wait facility on + * top of pipe(), poll() or select(), read(), and write(). + */ +struct erts_iwait { + erts_smp_atomic_t state; + int read_fd; /* wait polls and reads this fd */ + int write_fd; /* interrupt writes this fd */ +}; + +static void iwait_lowlevel_init(struct erts_iwait *iwait) +{ + int fds[2]; + + if (pipe(fds) < 0) { + perror("pipe()"); + exit(1); + } + iwait->read_fd = fds[0]; + iwait->write_fd = fds[1]; +} + +#if defined(ERTS_USE_POLL) + +#include +#define PERROR_POLL "poll()" + +static int iwait_lowlevel_poll(int read_fd, struct timeval *delay) +{ + struct pollfd pollfd; + int timeout; + + pollfd.fd = read_fd; + pollfd.events = POLLIN; + pollfd.revents = 0; + timeout = delay->tv_sec * 1000 + delay->tv_usec / 1000; + return poll(&pollfd, 1, timeout); +} + +#else /* !ERTS_USE_POLL */ + +#include +#define PERROR_POLL "select()" + +static int iwait_lowlevel_poll(int read_fd, struct timeval *delay) +{ + fd_set readfds; + + FD_ZERO(&readfds); + FD_SET(read_fd, &readfds); + return select(read_fd + 1, &readfds, NULL, NULL, delay); +} + +#endif /* !ERTS_USE_POLL */ + +static void iwait_lowlevel_wait(struct erts_iwait *iwait, struct timeval *delay) +{ + int res; + char buf[64]; + + res = iwait_lowlevel_poll(iwait->read_fd, delay); + if (res > 0) + (void)read(iwait->read_fd, buf, sizeof buf); + else if (res < 0 && errno != EINTR) + perror(PERROR_POLL); +} + +static void iwait_lowlevel_interrupt(struct erts_iwait *iwait) +{ + int res = write(iwait->write_fd, "!", 1); + if (res < 0) + perror("write()"); +} + +#endif /* using poll() or select() */ + +#if 0 /* not using poll() or select() */ +/* + * This is an implementation of the interruptible wait facility on + * top of pthread_cond_timedwait(). This has two problems: + * 1. pthread_cond_timedwait() requires an absolute time point, + * so the relative delay must be converted to absolute time. + * Worse, this breaks if the machine's time is adjusted while + * we're preparing to wait. + * 2. Each cond operation requires additional mutex lock/unlock operations. + * + * Problem 2 is probably not too bad on Linux (they'll just become + * relatively cheap futex operations), but problem 1 is the real killer. + * Only use this implementation if no better alternatives are available! + */ +struct erts_iwait { + erts_smp_atomic_t state; + pthread_cond_t cond; + pthread_mutex_t mutex; +}; + +static void iwait_lowlevel_init(struct erts_iwait *iwait) +{ + iwait->cond = (pthread_cond_t) PTHREAD_COND_INITIALIZER; + iwait->mutex = (pthread_mutex_t) PTHREAD_MUTEX_INITIALIZER; +} + +static void iwait_lowlevel_wait(struct erts_iwait *iwait, struct timeval *delay) +{ + struct timeval tmp; + struct timespec timeout; + + /* Due to pthread_cond_timedwait()'s use of absolute + time, this must be the real gettimeofday(), _not_ + the "smoothed" one beam/erl_time_sup.c implements. */ + gettimeofday(&tmp, NULL); + + tmp.tv_sec += delay->tv_sec; + tmp.tv_usec += delay->tv_usec; + if (tmp.tv_usec >= 1000*1000) { + tmp.tv_usec -= 1000*1000; + tmp.tv_sec += 1; + } + timeout.tv_sec = tmp.tv_sec; + timeout.tv_nsec = tmp.tv_usec * 1000; + pthread_mutex_lock(&iwait->mutex); + pthread_cond_timedwait(&iwait->cond, &iwait->mutex, &timeout); + pthread_mutex_unlock(&iwait->mutex); +} + +static void iwait_lowlevel_interrupt(struct erts_iwait *iwait) +{ + pthread_mutex_lock(&iwait->mutex); + pthread_cond_signal(&iwait->cond); + pthread_mutex_unlock(&iwait->mutex); +} + +#endif /* not using POLL */ + +/* + * Interruptible-wait facility. This is just a wrapper around the + * low-level synchronisation code, where we maintain our logical + * state in order to suppress some state transitions. + */ + +struct erts_iwait *erts_iwait_init(void) +{ + struct erts_iwait *iwait = malloc(sizeof *iwait); + if (!iwait) { + perror("malloc"); + exit(1); + } + iwait_lowlevel_init(iwait); + erts_smp_atomic_init(&iwait->state, IWAIT_AWAKE); + return iwait; +} + +void erts_iwait_wait(struct erts_iwait *iwait, struct timeval *delay) +{ + if (erts_smp_atomic_xchg(&iwait->state, IWAIT_WAITING) != IWAIT_INTERRUPT) + iwait_lowlevel_wait(iwait, delay); + erts_smp_atomic_set(&iwait->state, IWAIT_AWAKE); +} + +void erts_iwait_interrupt(struct erts_iwait *iwait) +{ + if (erts_smp_atomic_xchg(&iwait->state, IWAIT_INTERRUPT) == IWAIT_WAITING) + iwait_lowlevel_interrupt(iwait); +} + +#endif /* ERTS_TIMER_THREAD */ diff --git a/erts/emulator/sys/unix/sys_float.c b/erts/emulator/sys/unix/sys_float.c new file mode 100644 index 0000000000..15da6ab45c --- /dev/null +++ b/erts/emulator/sys/unix/sys_float.c @@ -0,0 +1,815 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2001-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "global.h" +#include "erl_process.h" + + +#ifdef NO_FPE_SIGNALS + +void +erts_sys_init_float(void) +{ +# ifdef SIGFPE + sys_sigset(SIGFPE, SIG_IGN); /* Ignore so we can test for NaN and Inf */ +# endif +} + +static ERTS_INLINE void set_current_fp_exception(unsigned long pc) +{ + /* nothing to do */ +} + +#else /* !NO_FPE_SIGNALS */ + +#ifdef ERTS_SMP +static erts_tsd_key_t fpe_key; + +/* once-only initialisation early in the main thread (via erts_sys_init_float()) */ +static void erts_init_fp_exception(void) +{ + /* XXX: the wrappers prevent using a pthread destructor to + deallocate the key's value; so when/where do we do that? */ + erts_tsd_key_create(&fpe_key); +} + +void erts_thread_init_fp_exception(void) +{ + unsigned long *fpe = erts_alloc(ERTS_ALC_T_FP_EXCEPTION, sizeof(*fpe)); + *fpe = 0L; + erts_tsd_set(fpe_key, fpe); +} + +static ERTS_INLINE volatile unsigned long *erts_thread_get_fp_exception(void) +{ + return (volatile unsigned long*)erts_tsd_get(fpe_key); +} +#else /* !SMP */ +#define erts_init_fp_exception() /*empty*/ +static volatile unsigned long fp_exception; +#define erts_thread_get_fp_exception() (&fp_exception) +#endif /* SMP */ + +volatile unsigned long *erts_get_current_fp_exception(void) +{ + Process *c_p; + + c_p = erts_get_current_process(); + if (c_p) + return &c_p->fp_exception; + return erts_thread_get_fp_exception(); +} + +static void set_current_fp_exception(unsigned long pc) +{ + volatile unsigned long *fpexnp = erts_get_current_fp_exception(); + ASSERT(fpexnp != NULL); + *fpexnp = pc; +} + +void erts_fp_check_init_error(volatile unsigned long *fpexnp) +{ + char buf[64]; + snprintf(buf, sizeof buf, "ERTS_FP_CHECK_INIT at %p: detected unhandled FPE at %p\r\n", + __builtin_return_address(0), (void*)*fpexnp); + write(2, buf, strlen(buf)); + *fpexnp = 0; +#if defined(__i386__) || defined(__x86_64__) + erts_restore_fpu(); +#endif +} + +/* Is there no standard identifier for Darwin/MacOSX ? */ +#if defined(__APPLE__) && defined(__MACH__) && !defined(__DARWIN__) +#define __DARWIN__ 1 +#endif + +#if (defined(__i386__) || defined(__x86_64__)) && defined(__GNUC__) + +static void unmask_x87(void) +{ + unsigned short cw; + + __asm__ __volatile__("fstcw %0" : "=m"(cw)); + cw &= ~(0x01|0x04|0x08); /* unmask IM, ZM, OM */ + __asm__ __volatile__("fldcw %0" : : "m"(cw)); +} + +/* mask x87 FPE, return true if the previous state was unmasked */ +static int mask_x87(void) +{ + unsigned short cw; + int unmasked; + + __asm__ __volatile__("fstcw %0" : "=m"(cw)); + unmasked = (cw & (0x01|0x04|0x08)) == 0; + /* or just set cw = 0x37f */ + cw |= (0x01|0x04|0x08); /* mask IM, ZM, OM */ + __asm__ __volatile__("fldcw %0" : : "m"(cw)); + return unmasked; +} + +static void unmask_sse2(void) +{ + unsigned int mxcsr; + + __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr)); + mxcsr &= ~(0x003F|0x0680); /* clear exn flags, unmask OM, ZM, IM (not PM, UM, DM) */ + __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); +} + +/* mask SSE2 FPE, return true if the previous state was unmasked */ +static int mask_sse2(void) +{ + unsigned int mxcsr; + int unmasked; + + __asm__ __volatile__("stmxcsr %0" : "=m"(mxcsr)); + unmasked = (mxcsr & 0x0680) == 0; + /* or just set mxcsr = 0x1f80 */ + mxcsr &= ~0x003F; /* clear exn flags */ + mxcsr |= 0x0680; /* mask OM, ZM, IM (not PM, UM, DM) */ + __asm__ __volatile__("ldmxcsr %0" : : "m"(mxcsr)); + return unmasked; +} + +#if defined(__x86_64__) + +static inline int cpu_has_sse2(void) { return 1; } + +#else /* !__x86_64__ */ + +/* + * Check if an x86-32 processor has SSE2. + */ +static unsigned int xor_eflags(unsigned int mask) +{ + unsigned int eax, edx; + + eax = mask; /* eax = mask */ + __asm__("pushfl\n\t" + "popl %0\n\t" /* edx = original EFLAGS */ + "xorl %0, %1\n\t" /* eax = mask ^ EFLAGS */ + "pushl %1\n\t" + "popfl\n\t" /* new EFLAGS = mask ^ original EFLAGS */ + "pushfl\n\t" + "popl %1\n\t" /* eax = new EFLAGS */ + "xorl %0, %1\n\t" /* eax = new EFLAGS ^ old EFLAGS */ + "pushl %0\n\t" + "popfl" /* restore original EFLAGS */ + : "=d"(edx), "=a"(eax) + : "1"(eax)); + return eax; +} + +static __inline__ unsigned int cpuid_eax(unsigned int op) +{ + unsigned int eax, save_ebx; + + /* In PIC mode i386 reserves EBX. So we must save + and restore it ourselves to not upset gcc. */ + __asm__( + "movl %%ebx, %1\n\t" + "cpuid\n\t" + "movl %1, %%ebx" + : "=a"(eax), "=m"(save_ebx) + : "0"(op) + : "cx", "dx"); + return eax; +} + +static __inline__ unsigned int cpuid_edx(unsigned int op) +{ + unsigned int eax, edx, save_ebx; + + /* In PIC mode i386 reserves EBX. So we must save + and restore it ourselves to not upset gcc. */ + __asm__( + "movl %%ebx, %2\n\t" + "cpuid\n\t" + "movl %2, %%ebx" + : "=a"(eax), "=d"(edx), "=m"(save_ebx) + : "0"(op) + : "cx"); + return edx; +} + +/* The AC bit, bit #18, is a new bit introduced in the EFLAGS + * register on the Intel486 processor to generate alignment + * faults. This bit cannot be set on the Intel386 processor. + */ +static __inline__ int is_386(void) +{ + return ((xor_eflags(1<<18) >> 18) & 1) == 0; +} + +/* Newer x86 processors have a CPUID instruction, as indicated by + * the ID bit (#21) in EFLAGS being modifiable. + */ +static __inline__ int has_CPUID(void) +{ + return (xor_eflags(1<<21) >> 21) & 1; +} + +static int cpu_has_sse2(void) +{ + unsigned int maxlev, features; + static int has_sse2 = -1; + + if (has_sse2 >= 0) + return has_sse2; + has_sse2 = 0; + + if (is_386()) + return 0; + if (!has_CPUID()) + return 0; + maxlev = cpuid_eax(0); + /* Intel A-step Pentium had a preliminary version of CPUID. + It also didn't have SSE2. */ + if ((maxlev & 0xFFFFFF00) == 0x0500) + return 0; + /* If max level is zero then CPUID cannot report any features. */ + if (maxlev == 0) + return 0; + features = cpuid_edx(1); + has_sse2 = (features & (1 << 26)) != 0; + + return has_sse2; +} +#endif /* !__x86_64__ */ + +static void unmask_fpe(void) +{ + __asm__ __volatile__("fnclex"); + unmask_x87(); + if (cpu_has_sse2()) + unmask_sse2(); +} + +static void unmask_fpe_conditional(int unmasked) +{ + if (unmasked) + unmask_fpe(); +} + +/* mask x86 FPE, return true if the previous state was unmasked */ +static int mask_fpe(void) +{ + int unmasked; + + unmasked = mask_x87(); + if (cpu_has_sse2()) + unmasked |= mask_sse2(); + return unmasked; +} + +void erts_restore_fpu(void) +{ + __asm__ __volatile__("fninit"); + unmask_x87(); + if (cpu_has_sse2()) + unmask_sse2(); +} + +#elif defined(__sparc__) && defined(__linux__) + +#if defined(__arch64__) +#define LDX "ldx" +#define STX "stx" +#else +#define LDX "ld" +#define STX "st" +#endif + +static void unmask_fpe(void) +{ + unsigned long fsr; + + __asm__(STX " %%fsr, %0" : "=m"(fsr)); + fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */ + fsr |= (0x1AUL << 23); /* enable NV, OF, DZ exceptions */ + __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); +} + +static void unmask_fpe_conditional(int unmasked) +{ + if (unmasked) + unmask_fpe(); +} + +/* mask SPARC FPE, return true if the previous state was unmasked */ +static int mask_fpe(void) +{ + unsigned long fsr; + int unmasked; + + __asm__(STX " %%fsr, %0" : "=m"(fsr)); + unmasked = ((fsr >> 23) & 0x1A) == 0x1A; + fsr &= ~(0x1FUL << 23); /* clear FSR[TEM] field */ + __asm__ __volatile__(LDX " %0, %%fsr" : : "m"(fsr)); + return unmasked; +} + +#elif (defined(__powerpc__) && defined(__linux__)) || (defined(__ppc__) && defined(__DARWIN__)) + +#if defined(__linux__) +#include + +static void set_fpexc_precise(void) +{ + if (prctl(PR_SET_FPEXC, PR_FP_EXC_PRECISE) < 0) { + perror("PR_SET_FPEXC"); + exit(1); + } +} + +#elif defined(__DARWIN__) + +#include +#include + +/* + * FE0 FE1 MSR bits + * 0 0 floating-point exceptions disabled + * 0 1 floating-point imprecise nonrecoverable + * 1 0 floating-point imprecise recoverable + * 1 1 floating-point precise mode + * + * Apparently: + * - Darwin 5.5 (MacOS X <= 10.1) starts with FE0 == FE1 == 0, + * and resets FE0 and FE1 to 0 after each SIGFPE. + * - Darwin 6.0 (MacOS X 10.2) starts with FE0 == FE1 == 1, + * and does not reset FE0 or FE1 after a SIGFPE. + */ +#define FE0_MASK (1<<11) +#define FE1_MASK (1<<8) + +/* a thread cannot get or set its own MSR bits */ +static void *fpu_fpe_enable(void *arg) +{ + thread_t t = *(thread_t*)arg; + struct ppc_thread_state state; + unsigned int state_size = PPC_THREAD_STATE_COUNT; + + if (thread_get_state(t, PPC_THREAD_STATE, (natural_t*)&state, &state_size) != KERN_SUCCESS) { + perror("thread_get_state"); + exit(1); + } + if ((state.srr1 & (FE1_MASK|FE0_MASK)) != (FE1_MASK|FE0_MASK)) { +#if 1 + /* This would also have to be performed in the SIGFPE handler + to work around the MSR reset older Darwin releases do. */ + state.srr1 |= (FE1_MASK|FE0_MASK); + thread_set_state(t, PPC_THREAD_STATE, (natural_t*)&state, state_size); +#else + fprintf(stderr, "srr1 == 0x%08x, your Darwin is too old\n", state.srr1); + exit(1); +#endif + } + return NULL; /* Ok, we appear to be on Darwin 6.0 or later */ +} + +static void set_fpexc_precise(void) +{ + thread_t self = mach_thread_self(); + pthread_t enabler; + + if (pthread_create(&enabler, NULL, fpu_fpe_enable, &self)) { + perror("pthread_create"); + } else if (pthread_join(enabler, NULL)) { + perror("pthread_join"); + } +} + +#endif + +static void set_fpscr(unsigned int fpscr) +{ + union { + double d; + unsigned int fpscr[2]; + } u; + + u.fpscr[0] = 0xFFF80000; + u.fpscr[1] = fpscr; + __asm__ __volatile__("mtfsf 255,%0" : : "f"(u.d)); +} + +static unsigned int get_fpscr(void) +{ + union { + double d; + unsigned int fpscr[2]; + } u; + + __asm__("mffs %0" : "=f"(u.d)); + return u.fpscr[1]; +} + +static void unmask_fpe(void) +{ + set_fpexc_precise(); + set_fpscr(0x80|0x40|0x10); /* VE, OE, ZE; not UE or XE */ +} + +static void unmask_fpe_conditional(int unmasked) +{ + if (unmasked) + unmask_fpe(); +} + +/* mask PowerPC FPE, return true if the previous state was unmasked */ +static int mask_fpe(void) +{ + int unmasked; + + unmasked = (get_fpscr() & (0x80|0x40|0x10)) == (0x80|0x40|0x10); + set_fpscr(0x00); + return unmasked; +} + +#else + +static void unmask_fpe(void) +{ + fpsetmask(FP_X_INV | FP_X_OFL | FP_X_DZ); +} + +static void unmask_fpe_conditional(int unmasked) +{ + if (unmasked) + unmask_fpe(); +} + +/* mask IEEE FPE, return true if previous state was unmasked */ +static int mask_fpe(void) +{ + const fp_except unmasked_mask = FP_X_INV | FP_X_OFL | FP_X_DZ; + fp_except old_mask; + + old_mask = fpsetmask(0); + return (old_mask & unmasked_mask) == unmasked_mask; +} + +#endif + +#if (defined(__linux__) && (defined(__i386__) || defined(__x86_64__) || defined(__sparc__) || defined(__powerpc__))) || (defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__) || defined(__ppc__))) || (defined(__FreeBSD__) && (defined(__x86_64__) || defined(__i386__))) || (defined(__OpenBSD__) && defined(__x86_64__)) || (defined(__sun__) && defined(__x86_64__)) + +#if defined(__linux__) && defined(__i386__) +#if !defined(X86_FXSR_MAGIC) +#define X86_FXSR_MAGIC 0x0000 +#endif +#elif defined(__FreeBSD__) && defined(__x86_64__) +#include +#include +#elif defined(__FreeBSD__) && defined(__i386__) +#include +#include +#elif defined(__DARWIN__) +#include +#elif defined(__OpenBSD__) && defined(__x86_64__) +#include +#include +#endif +#if !(defined(__OpenBSD__) && defined(__x86_64__)) +#include +#endif +#include + +#if defined(__linux__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->gregs[REG_RIP]) +#elif defined(__linux__) && defined(__i386__) +#define mc_pc(mc) ((mc)->gregs[REG_EIP]) +#elif defined(__DARWIN__) && defined(__i386__) +#ifdef DARWIN_MODERN_MCONTEXT +#define mc_pc(mc) ((mc)->__ss.__eip) +#else +#define mc_pc(mc) ((mc)->ss.eip) +#endif +#elif defined(__DARWIN__) && defined(__x86_64__) +#ifdef DARWIN_MODERN_MCONTEXT +#define mc_pc(mc) ((mc)->__ss.__rip) +#else +#define mc_pc(mc) ((mc)->ss.rip) +#endif +#elif defined(__FreeBSD__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->mc_rip) +#elif defined(__FreeBSD__) && defined(__i386__) +#define mc_pc(mc) ((mc)->mc_eip) +#elif defined(__OpenBSD__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->sc_rip) +#elif defined(__sun__) && defined(__x86_64__) +#define mc_pc(mc) ((mc)->gregs[REG_RIP]) +#endif + +static void fpe_sig_action(int sig, siginfo_t *si, void *puc) +{ + ucontext_t *uc = puc; + unsigned long pc; + +#if defined(__linux__) +#if defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + fpregset_t fpstate = mc->fpregs; + pc = mc_pc(mc); + /* A failed SSE2 instruction will restart. To avoid + looping we mask SSE2 exceptions now and unmask them + again later in erts_check_fpe()/erts_restore_fpu(). + On RISCs we update PC to skip the failed instruction, + but the ever increasing complexity of the x86 instruction + set encoding makes that a poor solution here. */ + fpstate->mxcsr = 0x1F80; + fpstate->swd &= ~0xFF; +#elif defined(__i386__) + mcontext_t *mc = &uc->uc_mcontext; + fpregset_t fpstate = mc->fpregs; + pc = mc_pc(mc); + if ((fpstate->status >> 16) == X86_FXSR_MAGIC) + ((struct _fpstate*)fpstate)->mxcsr = 0x1F80; + fpstate->sw &= ~0xFF; +#elif defined(__sparc__) && defined(__arch64__) + /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ + struct sigcontext *sc = (struct sigcontext*)puc; + pc = sc->sigc_regs.tpc; + sc->sigc_regs.tpc = sc->sigc_regs.tnpc; + sc->sigc_regs.tnpc += 4; +#elif defined(__sparc__) + /* on SPARC the 3rd parameter points to a sigcontext not a ucontext */ + struct sigcontext *sc = (struct sigcontext*)puc; + pc = sc->si_regs.pc; + sc->si_regs.pc = sc->si_regs.npc; + sc->si_regs.npc = (unsigned long)sc->si_regs.npc + 4; +#elif defined(__powerpc__) +#if defined(__powerpc64__) + mcontext_t *mc = &uc->uc_mcontext; + unsigned long *regs = &mc->gp_regs[0]; +#else + mcontext_t *mc = uc->uc_mcontext.uc_regs; + unsigned long *regs = &mc->gregs[0]; +#endif + pc = regs[PT_NIP]; + regs[PT_NIP] += 4; + regs[PT_FPSCR] = 0x80|0x40|0x10; /* VE, OE, ZE; not UE or XE */ +#endif +#elif defined(__DARWIN__) && (defined(__i386__) || defined(__x86_64__)) +#ifdef DARWIN_MODERN_MCONTEXT + mcontext_t mc = uc->uc_mcontext; + pc = mc_pc(mc); + mc->__fs.__fpu_mxcsr = 0x1F80; + *(unsigned short *)&mc->__fs.__fpu_fsw &= ~0xFF; +#else + mcontext_t mc = uc->uc_mcontext; + pc = mc_pc(mc); + mc->fs.fpu_mxcsr = 0x1F80; + *(unsigned short *)&mc->fs.fpu_fsw &= ~0xFF; +#endif /* DARWIN_MODERN_MCONTEXT */ +#elif defined(__DARWIN__) && defined(__ppc__) + mcontext_t mc = uc->uc_mcontext; + pc = mc->ss.srr0; + mc->ss.srr0 += 4; + mc->fs.fpscr = 0x80|0x40|0x10; +#elif defined(__FreeBSD__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct savefpu *savefpu = (struct savefpu*)&mc->mc_fpstate; + struct envxmm *envxmm = &savefpu->sv_env; + pc = mc_pc(mc); + envxmm->en_mxcsr = 0x1F80; + envxmm->en_sw &= ~0xFF; +#elif defined(__FreeBSD__) && defined(__i386__) + mcontext_t *mc = &uc->uc_mcontext; + union savefpu *savefpu = (union savefpu*)&mc->mc_fpstate; + pc = mc_pc(mc); + if (mc->mc_fpformat == _MC_FPFMT_XMM) { + struct envxmm *envxmm = &savefpu->sv_xmm.sv_env; + envxmm->en_mxcsr = 0x1F80; + envxmm->en_sw &= ~0xFF; + } else { + struct env87 *env87 = &savefpu->sv_87.sv_env; + env87->en_sw &= ~0xFF; + } +#elif defined(__OpenBSD__) && defined(__x86_64__) + struct fxsave64 *fxsave = uc->sc_fpstate; + pc = mc_pc(uc); + fxsave->fx_mxcsr = 0x1F80; + fxsave->fx_fsw &= ~0xFF; +#elif defined(__sun__) && defined(__x86_64__) + mcontext_t *mc = &uc->uc_mcontext; + struct fpchip_state *fpstate = &mc->fpregs.fp_reg_set.fpchip_state; + pc = mc_pc(mc); + fpstate->mxcsr = 0x1F80; + fpstate->sw &= ~0xFF; +#endif +#if 0 + { + char buf[64]; + snprintf(buf, sizeof buf, "%s: FPE at %p\r\n", __FUNCTION__, (void*)pc); + write(2, buf, strlen(buf)); + } +#endif + set_current_fp_exception(pc); +} + +static void erts_thread_catch_fp_exceptions(void) +{ + struct sigaction act; + memset(&act, 0, sizeof act); + act.sa_sigaction = fpe_sig_action; + act.sa_flags = SA_SIGINFO; + sigaction(SIGFPE, &act, NULL); + unmask_fpe(); +} + +#else /* !((__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */ + +static void fpe_sig_handler(int sig) +{ + set_current_fp_exception(1); /* XXX: convert to sigaction so we can get the trap PC */ +} + +static void erts_thread_catch_fp_exceptions(void) +{ + sys_sigset(SIGFPE, fpe_sig_handler); + unmask_fpe(); +} + +#endif /* (__linux__ && (__i386__ || __x86_64__ || __powerpc__)) || (__DARWIN__ && (__i386__ || __x86_64__ || __ppc__))) */ + +/* once-only initialisation early in the main thread */ +void erts_sys_init_float(void) +{ + erts_init_fp_exception(); + erts_thread_catch_fp_exceptions(); + erts_printf_block_fpe = erts_sys_block_fpe; + erts_printf_unblock_fpe = erts_sys_unblock_fpe; +} + +#endif /* NO_FPE_SIGNALS */ + +void erts_thread_init_float(void) +{ +#ifdef ERTS_SMP + /* This allows Erlang schedulers to leave Erlang-process context + and still have working FP exceptions. XXX: is this needed? */ + erts_thread_init_fp_exception(); +#endif + +#ifndef NO_FPE_SIGNALS + /* NOTE: + * erts_thread_disable_fpe() is called in all threads at + * creation. We at least need to call unmask_fpe() + */ +#if defined(__DARWIN__) || defined(__FreeBSD__) + /* Darwin (7.9.0) does not appear to propagate FP exception settings + to a new thread from its parent. So if we want FP exceptions, we + must manually re-enable them in each new thread. + FreeBSD 6.1 appears to suffer from a similar issue. */ + erts_thread_catch_fp_exceptions(); +#else + unmask_fpe(); +#endif + +#endif +} + +void erts_thread_disable_fpe(void) +{ +#if !defined(NO_FPE_SIGNALS) + (void)mask_fpe(); +#endif +} + +#if !defined(NO_FPE_SIGNALS) +int erts_sys_block_fpe(void) +{ + return mask_fpe(); +} + +void erts_sys_unblock_fpe(int unmasked) +{ + unmask_fpe_conditional(unmasked); +} +#endif + +/* The following check is incorporated from the Vee machine */ + +#define ISDIGIT(d) ((d) >= '0' && (d) <= '9') + +/* + ** Convert a double to ascii format 0.dddde[+|-]ddd + ** return number of characters converted + ** + ** These two functions should maybe use localeconv() to pick up + ** the current radix character, but since it is uncertain how + ** expensive such a system call is, and since no-one has heard + ** of other radix characters than '.' and ',' an ad-hoc + ** low execution time solution is used instead. + */ + +int +sys_double_to_chars(double fp, char *buf) +{ + char *s = buf; + + (void) sprintf(buf, "%.20e", fp); + /* Search upto decimal point */ + if (*s == '+' || *s == '-') s++; + while (ISDIGIT(*s)) s++; + if (*s == ',') *s++ = '.'; /* Replace ',' with '.' */ + /* Scan to end of string */ + while (*s) s++; + return s-buf; /* i.e strlen(buf) */ +} + +/* Float conversion */ + +int +sys_chars_to_double(char* buf, double* fp) +{ +#ifndef NO_FPE_SIGNALS + volatile unsigned long *fpexnp = erts_get_current_fp_exception(); +#endif + char *s = buf, *t, *dp; + + /* Robert says that something like this is what he really wanted: + * (The [.,] radix test is NOT what Robert wanted - it was added later) + * + * 7 == sscanf(Tbuf, "%[+-]%[0-9][.,]%[0-9]%[eE]%[+-]%[0-9]%s", ....); + * if (*s2 == 0 || *s3 == 0 || *s4 == 0 || *s6 == 0 || *s7) + * break; + */ + + /* Scan string to check syntax. */ + if (*s == '+' || *s == '-') s++; + if (!ISDIGIT(*s)) /* Leading digits. */ + return -1; + while (ISDIGIT(*s)) s++; + if (*s != '.' && *s != ',') /* Decimal part. */ + return -1; + dp = s++; /* Remember decimal point pos just in case */ + if (!ISDIGIT(*s)) + return -1; + while (ISDIGIT(*s)) s++; + if (*s == 'e' || *s == 'E') { + /* There is an exponent. */ + s++; + if (*s == '+' || *s == '-') s++; + if (!ISDIGIT(*s)) + return -1; + while (ISDIGIT(*s)) s++; + } + if (*s) /* That should be it */ + return -1; + +#ifdef NO_FPE_SIGNALS + errno = 0; +#endif + __ERTS_FP_CHECK_INIT(fpexnp); + *fp = strtod(buf, &t); + __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1); + if (t != s) { /* Whole string not scanned */ + /* Try again with other radix char */ + *dp = (*dp == '.') ? ',' : '.'; + errno = 0; + __ERTS_FP_CHECK_INIT(fpexnp); + *fp = strtod(buf, &t); + __ERTS_FP_ERROR_THOROUGH(fpexnp, *fp, return -1); + } + +#ifdef NO_FPE_SIGNALS + if (errno == ERANGE && (*fp == 0.0 || *fp == HUGE_VAL || *fp == -HUGE_VAL)) { + return -1; + } +#endif + return 0; +} + +int +matherr(struct exception *exc) +{ +#if !defined(NO_FPE_SIGNALS) + set_current_fp_exception((unsigned long)__builtin_return_address(0)); +#endif + return 1; +} diff --git a/erts/emulator/sys/unix/sys_time.c b/erts/emulator/sys/unix/sys_time.c new file mode 100644 index 0000000000..fcce54a2c4 --- /dev/null +++ b/erts/emulator/sys/unix/sys_time.c @@ -0,0 +1,134 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +/* These need to be undef:ed to not break activation of + * micro level process accounting on /proc/self + */ +#ifdef _LARGEFILE_SOURCE +# undef _LARGEFILE_SOURCE +#endif +#ifdef _FILE_OFFSET_BITS +# undef _FILE_OFFSET_BITS +#endif + +#include "sys.h" +#include "global.h" + +#ifdef NO_SYSCONF +# define TICKS_PER_SEC() HZ +#else +#define TICKS_PER_SEC() sysconf(_SC_CLK_TCK) +#endif + +#ifdef HAVE_GETHRVTIME_PROCFS_IOCTL +# include +# include +# include +# include +# include +# include +# include +# include +#endif + +/******************* Routines for time measurement *********************/ + +int erts_ticks_per_sec = 0; /* Will be SYS_CLK_TCK in erl_unix_sys.h */ +int erts_ticks_per_sec_wrap = 0; /* Will be SYS_CLK_TCK_WRAP */ +static int ticks_bsr = 0; /* Shift wrapped tick value this much to the right */ + +/* + * init timers, chose a tick length, and return it. + * Unix is priviliged when it comes to time, as erl_time_sup.c + * does almost everything. Other platforms have to + * emulate Unix in this sense. + */ +int sys_init_time(void) +{ + /* + * This (erts_ticks_per_sec) is only for times() (CLK_TCK), + * the resolution is always one millisecond.. + */ + if ((erts_ticks_per_sec = TICKS_PER_SEC()) < 0) + erl_exit(1, "Can't get clock ticks/sec\n"); + if (erts_ticks_per_sec >= 1000) { + /* Workaround for beta linux kernels, need to be done in runtime + to make erlang run on both 2.4 and 2.5 kernels. In the future, + the kernel ticks might as + well be used as a high res timer instead, but that's for when the + majority uses kernels with HZ == 1024 */ + ticks_bsr = 3; + } else { + ticks_bsr = 0; + } + erts_ticks_per_sec_wrap = (erts_ticks_per_sec >> ticks_bsr); + return SYS_CLOCK_RESOLUTION; +} + +clock_t sys_times_wrap(void) +{ + SysTimes dummy; + clock_t result = (sys_times(&dummy) >> ticks_bsr); + return result; +} + + + + +#ifdef HAVE_GETHRVTIME_PROCFS_IOCTL + +int sys_start_hrvtime(void) +{ + long msacct = PR_MSACCT; + int fd; + + if ( (fd = open("/proc/self", O_WRONLY)) == -1) { + return -1; + } + if (ioctl(fd, PIOCSET, &msacct) < 0) { + close(fd); + return -2; + } + close(fd); + return 0; +} + +int sys_stop_hrvtime(void) +{ + long msacct = PR_MSACCT; + int fd; + + if ( (fd = open("/proc/self", O_WRONLY)) == -1) { + return -1; + } + if (ioctl(fd, PIOCRESET, &msacct) < 0) { + close(fd); + return -2; + } + close(fd); + return 0; +} + +#endif /* HAVE_GETHRVTIME_PROCFS_IOCTL */ + + diff --git a/erts/emulator/sys/vxworks/driver_int.h b/erts/emulator/sys/vxworks/driver_int.h new file mode 100644 index 0000000000..f6bc71a799 --- /dev/null +++ b/erts/emulator/sys/vxworks/driver_int.h @@ -0,0 +1,30 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/*---------------------------------------------------------------------- +** Purpose : System dependant driver declarations +**---------------------------------------------------------------------- */ + +#ifndef __DRIVER_INT_H__ +#define __DRIVER_INT_H__ + +#include + +typedef struct iovec SysIOVec; + +#endif diff --git a/erts/emulator/sys/vxworks/erl_main.c b/erts/emulator/sys/vxworks/erl_main.c new file mode 100644 index 0000000000..c9b44a635a --- /dev/null +++ b/erts/emulator/sys/vxworks/erl_main.c @@ -0,0 +1,45 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "erl_vm.h" + +#if defined(__GNUC__) +/* + * The generated assembler does the usual trick (relative + * branch-and-link to next instruction) to get a copy of the + * instruction ptr. Instead of branching to an explicit zero offset, + * it branches to the symbol `__eabi' --- which is expected to be + * undefined and thus zero (if it is defined as non-zero, things will + * be interesting --- as in the Chinese curse). To shut up the VxWorks + * linker, we define `__eabi' as zero. + * + * This is just a work around. It's really Wind River's GCC's code + * generator that should be fixed. + */ +__asm__(".equ __eabi, 0"); +#endif + +void +erl_main(int argc, char **argv) +{ + erl_start(argc, argv); +} diff --git a/erts/emulator/sys/vxworks/erl_vxworks_sys.h b/erts/emulator/sys/vxworks/erl_vxworks_sys.h new file mode 100644 index 0000000000..ae46403600 --- /dev/null +++ b/erts/emulator/sys/vxworks/erl_vxworks_sys.h @@ -0,0 +1,183 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef __ERL_VXWORKS_SYS_H__ +#define __ERL_VXWORKS_SYS_H__ + +/* stdarg.h don't work without this one... */ +#include + +#include +#include +#include +#include +#define index StringIndexFunctionThatIDontWantDeclared +#include +#undef index + + + +#include +#include /* xxxP */ + +#include +#include + +/* xxxP from unix_sys.h begin */ + +/* + * Make sure that MAXPATHLEN is defined. + */ + +#ifndef MAXPATHLEN +# ifdef PATH_MAX +# define MAXPATHLEN PATH_MAX +# else +# define MAXPATHLEN 2048 +# endif +#endif + +/* xxxP end */ + + +/* Unimplemented math functions */ +#define NO_ASINH +#define NO_ACOSH +#define NO_ATANH +#define NO_ERF +#define NO_ERFC + +/* Stuff that is useful for port programs, drivers, etc */ +#ifndef VXWORKS +#define VXWORKS +#endif + +#define DONT_USE_MAIN +#define NO_FSYNC +#define NO_MKDIR_MODE +#define NO_UMASK +#define NO_SYMBOLIC_LINKS +#define NO_DEVICE_FILES +#define NO_UID +#define NO_ACCESS +#define NO_FCNTL +#define NO_SYSLOG +#define NO_SYSCONF +#define NO_PWD /* XXX Means what? */ +#define NO_DAEMON +/* This chooses ~250 reductions instead of 500 in config.h */ +#if (CPU == CPU32) +#define SLOW_PROCESSOR +#endif + +/* + * Even though we does not always have small memories on VxWorks + * we certainly does not have virtual memory. + */ +#if !defined(LARGE_MEMORY) +#define SMALL_MEMORY +#endif + +/*************** Floating point exception handling ***************/ + +/* There are no known ways to customize the handling of invalid floating + point operations, such as matherr() or ieee_handler(), in VxWorks 5.1. */ + +#if (CPU == MC68040 || CPU == CPU32 || CPU == PPC860 || CPU == PPC32 || \ + CPU == PPC603 || CPU == PPC604 || CPU == SIMSPARCSOLARIS) + +/* VxWorks 5.1 on Motorola 68040 never generates SIGFPE, but sets the + result of invalid floating point ops to Inf and NaN - unfortunately + the way to test for those values is undocumented and hidden in a + "private" include file... */ +/* Haven't found any better way, as of yet, for ppc860 xxxP*/ + +#include +#define NO_FPE_SIGNALS +#define erts_get_current_fp_exception() NULL +#define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0) +#define __ERTS_FP_ERROR(fpexnp, f, Action) if (isInf(f) || isNan(f)) { Action; } else {} +#define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action) +#define __ERTS_SAVE_FP_EXCEPTION(fpexnp) +#define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) + +#define ERTS_FP_CHECK_INIT(p) __ERTS_FP_CHECK_INIT(&(p)->fp_exception) +#define ERTS_FP_ERROR(p, f, A) __ERTS_FP_ERROR(&(p)->fp_exception, f, A) +#define ERTS_SAVE_FP_EXCEPTION(p) __ERTS_SAVE_FP_EXCEPTION(&(p)->fp_exception) +#define ERTS_RESTORE_FP_EXCEPTION(p) __ERTS_RESTORE_FP_EXCEPTION(&(p)->fp_exception) +#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A) + +#define erts_sys_block_fpe() 0 +#define erts_sys_unblock_fpe(x) do{}while(0) + +#if (CPU == PPC603) +/* Need fppLib to change the Floating point registers + (fix_registers in sys.c)*/ + +#include + +#endif /* PPC603 */ + +#else + +Unsupported CPU value ! + +#endif + +typedef void *GETENV_STATE; + +#define HAVE_GETHRTIME + +extern int erts_clock_rate; + +#define SYS_CLK_TCK (erts_clock_rate) + +#define SYS_CLOCK_RESOLUTION 1 + +typedef struct _vxworks_tms { + clock_t tms_utime; + clock_t tms_stime; + clock_t tms_cutime; + clock_t tms_cstime; +} SysTimes; + +typedef long long SysHrTime; + +typedef struct timeval SysTimeval; + +extern int sys_init_hrtime(void); +extern SysHrTime sys_gethrtime(void); +extern void sys_gettimeofday(SysTimeval *tvp); +extern clock_t sys_times(SysTimes *t); + +#define SIZEOF_SHORT 2 +#define SIZEOF_INT 4 +#define SIZEOF_LONG 4 +#define SIZEOF_VOID_P 4 +#define SIZEOF_SIZE_T 4 +#define SIZEOF_OFF_T 4 + +/* + * Temporary buffer *only* used in sys code. + */ +#define SYS_TMP_BUF_SIZE 65536 + +/* Need to be able to interrupt erts_poll_wait() from signal handler */ +#define ERTS_POLL_NEED_ASYNC_INTERRUPT_SUPPORT + +#endif /* __ERL_VXWORKS_SYS_H__ */ diff --git a/erts/emulator/sys/vxworks/erl_vxworks_sys_ddll.c b/erts/emulator/sys/vxworks/erl_vxworks_sys_ddll.c new file mode 100644 index 0000000000..c56c633b2f --- /dev/null +++ b/erts/emulator/sys/vxworks/erl_vxworks_sys_ddll.c @@ -0,0 +1,253 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Interface functions to the dynamic linker using dl* functions. + * (As far as I know it works on SunOS 4, 5, Linux and FreeBSD. /Seb) + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include "sys.h" +#include "global.h" +#include "erl_alloc.h" +#include "erl_driver.h" + +#define EXT_LEN 4 +#define FILE_EXT ".eld" +#define ALT_FILE_EXT ".o" +/* ALT_FILE_EXT must not be longer than FILE_EXT */ +#define DRIVER_INIT_SUFFIX "_init" + +static MODULE_ID get_mid(char *); +static FUNCPTR lookup(char *); + +typedef enum { + NoError, + ModuleNotFound, + ModuleNotUnloadable, + UnknownError +} FakeSytemError; + +static char *errcode_tab[] = { + "No error", + "Module/file not found", + "Module cannot be unloaded", + "Unknown error" +}; + +void erl_sys_ddll_init(void) { + return; +} +/* + * Open a shared object + */ +int erts_sys_ddll_open2(char *full_name, void **handle, ErtsSysDdllError* err) +{ + int len; + + if (erts_sys_ddll_open_noext(full_name, handle, err) == ERL_DE_NO_ERROR) { + return ERL_DE_NO_ERROR; + } + if ((len = sys_strlen(full_name)) > PATH_MAX-EXT_LEN) { + return ERL_DE_LOAD_ERROR_NAME_TO_LONG; + } else { + static char dlname[PATH_MAX + 1]; + + sys_strcpy(dlname, full_name); + sys_strcpy(dlname+len, FILE_EXT); + if (erts_sys_ddll_open_noext(dlname, handle, err) == ERL_DE_NO_ERROR) { + return ERL_DE_NO_ERROR; + } + sys_strcpy(dlname+len, ALT_FILE_EXT); + return erts_sys_ddll_open_noext(dlname, handle, err); + } +} +int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err) +{ + MODULE_ID mid; + + if((mid = get_mid(dlname)) == NULL) { + return ERL_DE_DYNAMIC_ERROR_OFFSET - ((int) ModuleNotFound); + } + *handle = (void *) mid; + return ERL_DE_NO_ERROR; +} + +/* + * Find a symbol in the shared object + */ +#define PREALLOC_BUFFER_SIZE 256 +int erts_sys_ddll_sym2(void *handle, char *func_name, void **function, ErtsSysDdllError* err) +{ + FUNCPTR proc; + static char statbuf[PREALLOC_BUFFER_SIZE]; + char *buf = statbuf; + int need; + + if ((proc = lookup(func_name)) == NULL) { + if ((need = strlen(func_name)+2) > PREALLOC_BUFFER_SIZE) { + buf = erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF,need); + } + buf[0] = '_'; + sys_strcpy(buf+1,func_name); + proc = lookup(buf); + if (buf != statbuf) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, buf); + } + if (proc == NULL) { + return ERL_DE_LOOKUP_ERROR_NOT_FOUND; + } + } + *function = (void *) proc; + return ERL_DE_NO_ERROR; +} + +/* XXX:PaN These two will be changed with new driver interface! */ + +/* + * Load the driver init function, might appear under different names depending on object arch... + */ + +int erts_sys_ddll_load_driver_init(void *handle, void **function) +{ + MODULE_ID mid = (MODULE_ID) handle; + char *modname; + char *cp; + static char statbuf[PREALLOC_BUFFER_SIZE]; + char *fname = statbuf; + int len; + int res; + void *func; + int need; + + if((modname = moduleNameGet(mid)) == NULL) { + return ERL_DE_DYNAMIC_ERROR_OFFSET - ((int) ModuleNotFound); + } + + if((cp = strrchr(modname, '.')) == NULL) { + len = strlen(modname); + } else { + len = cp - modname; + } + + need = len + strlen(DRIVER_INIT_SUFFIX) + 1; + if (need > PREALLOC_BUFFER_SIZE) { + fname = erts_alloc(ERTS_ALC_T_DDLL_TMP_BUF, need); /* erts_alloc exits on failure */ + } + sys_strncpy(fname, modname, len); + fname[len] = '\0'; + sys_strcat(fname, DRIVER_INIT_SUFFIX); + res = erts_sys_ddll_sym(handle, fname, &func); + if (fname != statbuf) { + erts_free(ERTS_ALC_T_DDLL_TMP_BUF, fname); + } + if ( res != ERL_DE_NO_ERROR) { + return res; + } + *function = func; + return ERL_DE_NO_ERROR; +} + +int erts_sys_ddll_load_nif_init(void *handle, void **function, ErtsSysDdllError* err) +{ + /* NIFs not implemented for vxworks */ + return ERL_DE_ERROR_NO_DDLL_FUNCTIONALITY; +} + +/* + * Call the driver_init function, whatever it's really called, simple on unix... +*/ +void *erts_sys_ddll_call_init(void *function) { + void *(*initfn)(void) = function; + return (*initfn)(); +} +void *erts_sys_ddll_call_nif_init(void *function) { + return erts_sys_ddll_call_init(function); +} + + +/* + * Close a chared object + */ +int erts_sys_ddll_close2(void *handle, ErtsSysDdllError* err) +{ + MODULE_ID mid = (MODULE_ID) handle; + if (unld(mid, 0) < 0) { + return ERL_DE_DYNAMIC_ERROR_OFFSET - ((int) ModuleNotUnloadable); + } + return ERL_DE_NO_ERROR; +} + +/* + * Return string that describes the (current) error + */ +char *erts_sys_ddll_error(int code) +{ + int actual_code; + if (code > ERL_DE_DYNAMIC_ERROR_OFFSET) { + return "Unspecified error"; + } + actual_code = -1*(code - ERL_DE_DYNAMIC_ERROR_OFFSET); + if (actual_code > ((int) UnknownError)) { + actual_code = UnknownError; + } + return errcode_tab[actual_code]; +} + +static FUNCPTR lookup(char *sym) +{ + FUNCPTR entry; + SYM_TYPE type; + + if (symFindByNameAndType(sysSymTbl, sym, (char **)&entry, + &type, N_EXT | N_TEXT, N_EXT | N_TEXT) != OK) { + return NULL ; + } + return entry; +} + +static MODULE_ID get_mid(char* name) +{ + int fd; + MODULE_ID mid = NULL; + + if((fd = open(name, O_RDONLY, 0664)) >= 0) { + mid = loadModule(fd, GLOBAL_SYMBOLS); + close(fd); + } + return mid; +} + +void erts_sys_ddll_free_error(ErtsSysDdllError* err) +{ + /* NYI */ +} + diff --git a/erts/emulator/sys/vxworks/sys.c b/erts/emulator/sys/vxworks/sys.c new file mode 100644 index 0000000000..abddc7e107 --- /dev/null +++ b/erts/emulator/sys/vxworks/sys.c @@ -0,0 +1,2594 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * system-dependent functions + * + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + + +#ifndef WANT_NONBLOCKING +#define WANT_NONBLOCKING +#endif + +#include "sys.h" +#include "erl_alloc.h" + +/* don't need global.h, but bif_table.h (included by bif.h) won't compile otherwise */ +#include "global.h" +#include "bif.h" + +#include "erl_sys_driver.h" + +#include "elib_stat.h" + +#include "reclaim_private.h" /* Some more or less private reclaim facilities */ + +#ifndef RETSIGTYPE +#define RETSIGTYPE void +#endif + +EXTERN_FUNCTION(void, erl_start, (int, char**)); +EXTERN_FUNCTION(void, erl_exit, (int n, char*, _DOTS_)); +EXTERN_FUNCTION(void, erl_error, (char*, va_list)); +EXTERN_FUNCTION(int, driver_interrupt, (int, int)); +EXTERN_FUNCTION(void, increment_time, (int)); +EXTERN_FUNCTION(int, next_time, (_VOID_)); +EXTERN_FUNCTION(void, set_reclaim_free_function, (FreeFunction)); +EXTERN_FUNCTION(int, erl_mem_info_get, (MEM_PART_STATS *)); +EXTERN_FUNCTION(void, erl_crash_dump, (char* file, int line, char* fmt, ...)); + +#define ISREG(st) (((st).st_mode&S_IFMT) == S_IFREG) + +/* these are defined in usrLib.c */ +extern int spTaskPriority, spTaskOptions; + +/* forward declarations */ +static FUNCTION(FUNCPTR, lookup, (char*)); +static FUNCTION(int, read_fill, (int, char*, int)); +#if (CPU == SPARC) +static FUNCTION(RETSIGTYPE, fpe_sig_handler, (int)); /*where is this fun? */ +#elif (CPU == PPC603) +static FUNCTION(void, fix_registers, (void)); +#endif +static FUNCTION(void, close_pipes, (int*, int*, int)); +static FUNCTION(void, delete_hook, (void)); +static FUNCTION(void, initialize_allocation, (void)); + +FUNCTION(STATUS, uxPipeDrv, (void)); +FUNCTION(STATUS, pipe, (int*)); +FUNCTION(void, uxPipeShow, (int)); + +void erl_main(int argc, char **argv); +void argcall(char *args); + +/* Malloc-realted functions called from the VxWorks shell */ +EXTERN_FUNCTION(int, erl_set_memory_block, + (int, int, int, int, int, int, int, int, int, int)); +EXTERN_FUNCTION(int, erl_memory_show, + (int, int, int, int, int, int, int, int, int, int)); + +#define DEFAULT_PORT_STACK_SIZE 100000 +static int port_stack_size; + +static int erlang_id = 0; /* Inited at loading, set/reset at each run */ + +/* interval time reported to emulator */ +static int sys_itime; + +/* XXX - This is defined in .../config/all/configAll.h (NUM_FILES), + and not easily accessible at compile or run time - however, + in VxWorks 5.1 it is stored in the (undocumented?) maxFiles variable; + probably shouldn't depend on it, but we try to pick it up... */ +static int max_files = 50; /* default configAll.h */ + +int erts_vxworks_max_files; + +/* + * used by the break handler (set by signal handler on ctl-c) + */ +volatile int erts_break_requested; + +/********************* General functions ****************************/ + +Uint +erts_sys_misc_mem_sz(void) +{ + Uint res = erts_check_io_size(); + /* res += FIXME */ + return res; +} + +/* + * XXX This declaration should not be here. + */ +void erl_sys_schedule_loop(void); + +#ifdef SOFTDEBUG +static void do_trace(int line, char *file, char *format, ...) +{ + va_list va; + int tid = taskIdSelf(); + char buff[512]; + + va_start(va, format); + sprintf(buff,"Trace: Task: 0x%08x, %s:%d - ", + tid, file, line); + vsprintf(buff + strlen(buff), format, va); + va_end(va); + strcat(buff,"\r\n"); + write(2,buff,strlen(buff)); +} + +#define TRACE() do_trace(__LINE__, __FILE__,"") +#define TRACEF(Args...) do_trace(__LINE__,__FILE__, ## Args) +#endif + +void +erts_sys_pre_init(void) +{ + if (erlang_id != 0) { + /* NOTE: This particular case must *not* call erl_exit() */ + erts_fprintf(stderr, "Sorry, erlang is already running (as task %d)\n", + erlang_id); + exit(1); + } + + /* This must be done as early as possible... */ + if(!reclaim_init()) + fprintf(stderr, "Warning : reclaim facility should be initiated before " + "erlang is started!\n"); + erts_vxworks_max_files = max_files = reclaim_max_files(); + + /* Floating point exceptions */ +#if (CPU == SPARC) + sys_sigset(SIGFPE, fpe_sig_handler); +#elif (CPU == PPC603) + fix_registers(); +#endif + + /* register the private delete hook in reclaim */ + save_delete_hook((FUNCPTR)delete_hook, (caddr_t)0); + erlang_id = taskIdSelf(); +#ifdef DEBUG + printf("emulator task id = 0x%x\n", erlang_id); +#endif +} + +void erts_sys_alloc_init(void) +{ + initialize_allocation(); +} + +void +erl_sys_init(void) +{ + setvbuf(stdout, (char *)NULL, _IOLBF, BUFSIZ); + /* XXX Bug in VxWorks stdio loses fputch()'ed output after the + setvbuf() but before a *printf(), and possibly worse (malloc + errors, crash?) - so let's give it a *printf().... */ + fprintf(stdout, "%s",""); +} + +void +erl_sys_args(int* argc, char** argv) +{ + erts_init_check_io(); + max_files = erts_check_io_max_files(); + ASSERT(max_files <= erts_vxworks_max_files); +} + +/* + * Called from schedule() when it runs out of runnable processes, + * or when Erlang code has performed INPUT_REDUCTIONS reduction + * steps. runnable == 0 iff there are no runnable Erlang processes. + */ +void +erl_sys_schedule(int runnable) +{ + erts_check_io_interrupt(0); + erts_check_io(!runnable); +} + +void erts_do_break_handling(void) +{ + SET_BLOCKING(0); + /* call the break handling function, reset the flag */ + do_break(); + erts_break_requested = 0; + SET_NONBLOCKING(0); +} + +/* signal handling */ +RETSIGTYPE (*sys_sigset(sig, func))() + int sig; + RETSIGTYPE (*func)(); +{ + struct sigaction act, oact; + + sigemptyset(&act.sa_mask); + act.sa_flags = 0; + act.sa_handler = func; + sigaction(sig, &act, &oact); + return(oact.sa_handler); +} + +void sys_sigblock(int sig) +{ + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_BLOCK, &mask, (sigset_t *)NULL); +} + +void sys_sigrelease(int sig) +{ + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL); +} + +void +erts_sys_prepare_crash_dump(void) +{ + +} + +/* register signal handlers XXX - they don't work, need to find out why... */ +/* set up signal handlers for break and quit */ +static void request_break(void) +{ + /* just set a flag - checked for and handled + * in main thread (not signal handler). + * see check_io() + */ +#ifdef DEBUG + fprintf(stderr,"break!\n"); +#endif + erts_break_requested = 1; + erts_check_io_interrupt(1); /* Make sure we don't sleep in erts_poll_wait */ +} + +static void do_quit(void) +{ + halt_0(0); +} + +void erts_set_ignore_break(void) { +} + +void init_break_handler(void) +{ + sys_sigset(SIGINT, request_break); + sys_sigset(SIGQUIT, do_quit); +} + +void erts_replace_intr(void) { +} + +int sys_max_files(void) +{ + return(max_files); +} + +/******************* Routines for time measurement *********************/ + +int sys_init_time(void) +{ + erts_clock_rate = sysClkRateGet(); + /* + ** One could imagine that it would be better returning + ** a resolution more near the clock rate, like in: + ** return 1000 / erts_clock_rate; + ** but tests show that such isn't the case (rounding errors?) + ** Well, we go for the Unix variant of returning 1 + ** as a constant virtual clock rate. + */ + return SYS_CLOCK_RESOLUTION; +} + +int erts_clock_rate; +static volatile int ticks_inuse; +static volatile unsigned long ticks_collected; /* will wrap */ +static WDOG_ID watchdog_id; +static ULONG user_time; +static int this_task_id, sys_itime; +static SysHrTime hrtime_wrap; +static unsigned long last_tick_count; + +static void tolerant_time_clockint(int count) +{ + if (watchdog_id != NULL) { + if (taskIsReady(this_task_id)) + user_time += 1; + ++count; + if (!ticks_inuse) { + ticks_collected += count; + count = 0; + } + wdStart(watchdog_id, 1, (FUNCPTR)tolerant_time_clockint, count); + } +} + +int sys_init_hrtime(void) +{ + this_task_id = taskIdSelf(); /* OK, this only works for one single task + in the system... */ + user_time = 0; + + ticks_inuse = 0; + ticks_collected = 0; + hrtime_wrap = 0; + last_tick_count = 0; + + sys_itime = 1000 / erts_clock_rate; + watchdog_id = wdCreate(); + wdStart(watchdog_id, 1, (FUNCPTR) tolerant_time_clockint, 0); + return 0; +} + +SysHrTime sys_gethrtime(void) +{ + SysHrTime ticks; + + ++ticks_inuse; + ticks = (SysHrTime) (ticks_collected & 0x7FFFFFFF); + ticks_inuse = 0; + if (ticks < (SysHrTime) last_tick_count) { + hrtime_wrap += 1UL << 31; + } + last_tick_count = ticks; + return (ticks + hrtime_wrap) * ((SysHrTime) (1000000000UL / + erts_clock_rate)); +} + +void sys_gettimeofday(SysTimeval *tvp) +{ + struct timespec now; + + clock_gettime(CLOCK_REALTIME, &now); + tvp->tv_sec = now.tv_sec; + tvp->tv_usec = now.tv_nsec / 1000; +} + +clock_t sys_times(SysTimes *t) +{ + t->tms_stime = t->tms_cutime = t->tms_cstime = 0; + ++ticks_inuse; + t->tms_utime = user_time; + ticks_inuse = 0; + return tickGet(); /* The best we can do... */ +} + +/* This is called when *this task* is deleted */ +static void delete_hook(void) +{ + if (watchdog_id != NULL) { + wdDelete(watchdog_id); + watchdog_id = NULL; + } + erlang_id = 0; + this_task_id = 0; +} + +/************************** OS info *******************************/ + +/* Used by erlang:info/1. */ +/* (This code was formerly in drv.XXX/XXX_os_drv.c) */ + +#define MAX_VER_STR 9 /* Number of characters to + consider in version string */ + +static FUNCTION(int, get_number, (char** str_ptr)); + +char os_type[] = "vxworks"; + +static int +get_number(char **str_ptr) +{ + char* s = *str_ptr; /* Pointer to beginning of string. */ + char* dot; /* Pointer to dot in string or NULL. */ + + if (!isdigit(*s)) + return 0; + if ((dot = strchr(s, '.')) == NULL) { + *str_ptr = s+strlen(s); + return atoi(s); + } else { + *dot = '\0'; + *str_ptr = dot+1; + return atoi(s); + } +} + +/* namebuf; Where to return the name. */ +/* size; Size of name buffer. */ +void +os_flavor(char *namebuf, unsigned size) +{ + strcpy(namebuf, "-"); +} + +/* int* pMajor; Pointer to major version. */ +/* int* pMinor; Pointer to minor version. */ +/* int* pBuild; Pointer to build number. */ +void +os_version(int *pMajor, int *pMinor, int *pBuild) +{ + char os_ver[MAX_VER_STR+2]; + char* release; /* Pointer to the release string: + * X.Y or X.Y.Z. + */ + strncpy(os_ver, vxWorksVersion, MAX_VER_STR); + release = os_ver; + *pMajor = get_number(&release); + *pMinor = get_number(&release); + *pBuild = get_number(&release); +} + +void init_getenv_state(GETENV_STATE *state) +{ + *state = NULL; +} + +char *getenv_string(GETENV_STATE *state0) +{ + return NULL; +} + +void fini_getenv_state(GETENV_STATE *state) +{ + *state = NULL; +} + +/************************** Port I/O *******************************/ + + +/* I. Common stuff */ + +#define TMP_BUF_MAX (tmp_buf_size - 1024) +static byte *tmp_buf; +static Uint tmp_buf_size; + +/* II. The spawn/fd/vanilla drivers */ + +/* This data is shared by these drivers - initialized by spawn_init() */ +static struct driver_data { + int port_num, ofd, packet_bytes, report_exit; + int exitcode, exit_reported; /* For returning of exit codes. */ +} *driver_data; /* indexed by fd */ + +/* + * Locking only for exitcodes and exit_reported, one global sem for all + * spawn ports as this is rare. + */ +static SEM_ID driver_data_sem = NULL; +/* + * Also locking when looking up entries in the load table + */ +static SEM_ID entry_data_sem = NULL; + +/* We maintain a linked fifo queue of these structs in order */ +/* to manage unfinnished reads/and writes on differenet fd's */ + +typedef struct pend { + char *cpos; + int fd; + int remain; + struct pend *next; + char buf[1]; /* this is a trick to be able to malloc one chunk */ +} Pend; + +static struct fd_data { + int inport, outport; + char *buf, *cpos; + int sz, remain; /* for input on fd */ + Pend* pending; /* pending outputs */ + +} *fd_data; /* indexed by fd */ + + +/* Driver interfaces */ +static ErlDrvData spawn_start(ErlDrvPort port_num, char *name, SysDriverOpts* opts); +static ErlDrvData fd_start(ErlDrvPort port_num, char *name, SysDriverOpts* opts); +static ErlDrvData vanilla_start(ErlDrvPort port_num, char *name, SysDriverOpts* opts); +static int spawn_init(void); +static void fd_stop(ErlDrvData); +static void stop(ErlDrvData); +static void ready_input(ErlDrvData fd, ErlDrvEvent ready_fd); +static void ready_output(ErlDrvData fd, ErlDrvEvent ready_fd); +static void output(ErlDrvData fd, char *buf, int len); +static void stop_select(ErlDrvEvent, void*); + +struct erl_drv_entry spawn_driver_entry = { + spawn_init, + spawn_start, + stop, + output, + ready_input, + ready_output, + "spawn", + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, /* handle2 */ + NULL, /* process_exit */ + stop_select + +}; +struct erl_drv_entry fd_driver_entry = { + NULL, + fd_start, + fd_stop, + output, + ready_input, + ready_output, + "fd", + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, /* handle2 */ + NULL, /* process_exit */ + stop_select +}; +struct erl_drv_entry vanilla_driver_entry = { + NULL, + vanilla_start, + stop, + output, + ready_input, + ready_output, + "vanilla", + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, /* handle2 */ + NULL, /* process_exit */ + stop_select +}; + +/* +** Set up enough of the driver_data structure to be able to report exit status. +** Some things may be initiated again, but that is no real problem. +*/ +static int pre_set_driver_data(int ifd, int ofd, + int read_write, int report_exit) { + if (read_write & DO_READ) { + driver_data[ifd].report_exit = report_exit; + driver_data[ifd].exitcode = 0; + driver_data[ifd].exit_reported = 0; + if (read_write & DO_WRITE) { + driver_data[ifd].ofd = ofd; + if (ifd != ofd) { + driver_data[ofd] = driver_data[ifd]; + driver_data[ofd].report_exit = 0; + } + } else { /* DO_READ only */ + driver_data[ifd].ofd = -1; + } + return(ifd); + } else { /* DO_WRITE only */ + driver_data[ofd].report_exit = 0; + driver_data[ofd].exitcode = 0; + driver_data[ofd].exit_reported = 0; + driver_data[ofd].ofd = ofd; + return(ofd); + } +} + +/* +** Set up the driver_data structure, it may have been initiated +** partly by the function above, but we dont care. +*/ +static int set_driver_data(int port_num, int ifd, int ofd, + int packet_bytes, int read_write, + int report_exit) +{ + if (read_write & DO_READ) { + driver_data[ifd].packet_bytes = packet_bytes; + driver_data[ifd].port_num = port_num; + driver_data[ifd].report_exit = report_exit; + if (read_write & DO_WRITE) { + driver_data[ifd].ofd = ofd; + if (ifd != ofd) { + driver_data[ofd] = driver_data[ifd]; + driver_data[ofd].report_exit = 0; + } + } else { /* DO_READ only */ + driver_data[ifd].ofd = -1; + } + (void) driver_select(port_num, ifd, ERL_DRV_READ|ERL_DRV_USE, 1); + return(ifd); + } else { /* DO_WRITE only */ + driver_data[ofd].packet_bytes = packet_bytes; + driver_data[ofd].port_num = port_num; + driver_data[ofd].report_exit = 0; + driver_data[ofd].ofd = ofd; + return(ofd); + } +} + +static int need_new_sems = 1; + +static int spawn_init(void) +{ + char *stackenv; + int size; + driver_data = (struct driver_data *) + erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data)); + if (need_new_sems) { + driver_data_sem = semMCreate + (SEM_Q_PRIORITY | SEM_DELETE_SAFE | SEM_INVERSION_SAFE); + entry_data_sem = semMCreate + (SEM_Q_PRIORITY | SEM_DELETE_SAFE | SEM_INVERSION_SAFE); + } + if (driver_data_sem == NULL || entry_data_sem == NULL) { + erl_exit(1,"Could not allocate driver locking semaphore."); + } + need_new_sems = 0; + + (void)uxPipeDrv(); /* Install pipe driver */ + + if ((stackenv = getenv("ERLPORTSTACKSIZE")) != NULL && + (size = atoi(stackenv)) > 0) + port_stack_size = size; + else + port_stack_size = DEFAULT_PORT_STACK_SIZE; + return 0; +} + +/* Argv has to be built vith the save_xxx routines, not with whathever + sys_xxx2 has in mind... */ +#define argv_alloc save_malloc +#define argv_realloc save_realloc +#define argv_free save_free +/* Build argv, return argc or -1 on failure */ +static int build_argv(char *name, char ***argvp) +{ + int argvsize = 10, argc = 0; + char *args, *arglast = NULL, *argp; + char **argv; + +#ifdef DEBUG + fdprintf(2, "Building argv, %s =>\n", name); +#endif + if ((argv = (char **)argv_alloc(argvsize * sizeof(char *))) == NULL) + return(-1); + if ((args = argv_alloc(strlen(name) + 1)) == NULL) + return(-1); + strcpy(args, name); + argp = strtok_r(args, " \t", &arglast); + while (argp != NULL) { + if (argc + 1 >= argvsize) { + argvsize += 10; + argv = (char **)argv_realloc((char *)argv, argvsize*sizeof(char *)); + if (argv == NULL) { + argv_free(args); + return(-1); + } + } +#ifdef DEBUG + fdprintf(2, "%s\n", argp); +#endif + argv[argc++] = argp; + argp = strtok_r((char *)NULL, " \t", &arglast); + } + argv[argc] = NULL; + *argvp = argv; + return(argc); +} +#undef argv_alloc +#undef argv_realloc +#undef argv_free + + +/* Lookup and return global text symbol or NULL on failure + Symbol name is null-terminated and without the leading '_' */ +static FUNCPTR +lookup(char *sym) +{ + char buf[256]; + char *symname = buf; + int len; + FUNCPTR entry; + SYM_TYPE type; + + len = strlen(sym); + if (len > 254 && (symname = malloc(len+2)) == NULL) + return(NULL); +#if defined _ARCH_PPC || defined SIMSPARCSOLARIS + /* GCC for PPC and SIMSPARC doesn't add a leading _ to symbols */ + strcpy(symname, sym); +#else + sprintf(symname, "_%s", sym); +#endif + if (symFindByNameAndType(sysSymTbl, symname, (char **)&entry, + &type, N_EXT | N_TEXT, N_EXT | N_TEXT) != OK) + entry = NULL; + if (symname != buf) + free(symname); + return(entry); +} + +/* This function is spawned to build argc, argv, lookup the symbol to call, + connect and set up file descriptors, and make the actual call. + N.B. 'name' was allocated by the Erlang task (through plain_malloc) and + is freed by this port program task. + Note: 'name' may be a path containing '/'. */ + +static void call_proc(char *name, int ifd, int ofd, int read_write, + int redir_stderr, int driver_index, + int p6, int p7, int p8, int p9) +{ + int argc; + char **argv, *bname; + FUNCPTR entry; + int ret = -1; + + /* Must consume 'name' */ + argc = build_argv(name, &argv); + plain_free(name); + /* Find basename of path */ + if ((bname = strrchr(argv[0], '/')) != NULL) { + bname++; + } else { + bname = argv[0]; + } +#ifdef DEBUG + fdprintf(2, "Port program name: %s\n", bname); +#endif + semTake(entry_data_sem, WAIT_FOREVER); + + if (argc > 0) { + if ((entry = lookup(bname)) == NULL) { + int fd; + char *fn; + /* NOTE: We don't check the return value of loadModule, + since that was incompatibly changed from 5.0.2b to 5.1, + but rather do a repeated lookup(). */ + if ((fd = open(argv[0], O_RDONLY)) > 0) { + (void) loadModule(fd, GLOBAL_SYMBOLS); + close(fd); + entry = lookup(bname); + } + if (entry == NULL) { + /* filename == func failed, try func.o */ + if ((fn = malloc(strlen(argv[0]) + 3)) != NULL) { /* ".o\0" */ + strcpy(fn, argv[0]); + strcat(fn, ".o"); + if ((fd = open(fn, O_RDONLY)) > 0) { + (void) loadModule(fd, GLOBAL_SYMBOLS); + close(fd); + entry = lookup(bname); + } + free(fn); + } + } + } + } else { + entry = NULL; + } + semGive(entry_data_sem); + + if (read_write & DO_READ) { /* emulator read */ + save_fd(ofd); + ioTaskStdSet(0, 1, ofd); /* stdout for process */ + if(redir_stderr) + ioTaskStdSet(0, 2, ofd);/* stderr for process */ + } + if (read_write & DO_WRITE) { /* emulator write */ + save_fd(ifd); + ioTaskStdSet(0, 0, ifd); /* stdin for process */ + } + if (entry != NULL) { + ret = (*entry)(argc, argv, (char **)NULL); /* NULL for envp */ + } else { + fdprintf(2, "Could not exec \"%s\"\n", argv[0]); + ret = -1; + } + if (driver_data[driver_index].report_exit) { + semTake(driver_data_sem, WAIT_FOREVER); + driver_data[driver_index].exitcode = ret; + driver_data[driver_index].exit_reported = 1; + semGive(driver_data_sem); + } + /* We *don't* want to close the pipes here, but let the delete + hook take care of it - it might want to flush stdout and there'd + better be an open descriptor to flush to... */ + exit(ret); +} + +static void close_pipes(int ifd[2], int ofd[2], int read_write) +{ + if (read_write & DO_READ) { + (void) close(ifd[0]); + (void) close(ifd[1]); + } + if (read_write & DO_WRITE) { + (void) close(ofd[0]); + (void) close(ofd[1]); + } +} + +static void init_fd_data(int fd, int port_unused_argument) +{ + SET_NONBLOCKING(fd); + fd_data[fd].pending = NULL; + fd_data[fd].buf = fd_data[fd].cpos = NULL; + fd_data[fd].remain = fd_data[fd].sz = 0; +} + +static ErlDrvData spawn_start(ErlDrvPort port_num, char *name,SysDriverOpts* opts) +{ + int ifd[2], ofd[2], len, nl, id; + char taskname[11], *progname, *bname; + char *space_in_command; + int packet_bytes = opts->packet_bytes; + int read_write = opts->read_write; + int use_stdio = opts->use_stdio; + int redir_stderr = opts->redir_stderr; + int driver_index; + + if (!use_stdio){ + return (ErlDrvData) -3; + } + + /* Create pipes and set the Erlang task as owner of its + * read and write ends (through save_fd()). + */ + switch (read_write) { + case DO_READ: + if (pipe(ifd) < 0){ + return (ErlDrvData) -2; + } + if (ifd[0] >= max_files) { + close_pipes(ifd, ofd, read_write); + errno = ENFILE; + return (ErlDrvData) -2; + } + save_fd(ifd[0]); + break; + case DO_WRITE: + if (pipe(ofd) < 0) { + return (ErlDrvData) -2; + } + if (ofd[1] >= max_files) { + close_pipes(ifd, ofd, read_write); + errno = ENFILE; + return (ErlDrvData) -2; + } + save_fd(ofd[1]); + break; + case DO_READ|DO_WRITE: + if (pipe(ifd) < 0){ + return (ErlDrvData) -2; + } + if (ifd[0] >= max_files || pipe(ofd) < 0) { + close_pipes(ifd, ofd, DO_READ); + errno = ENFILE; + return (ErlDrvData) -2; + } + if (ofd[1] >= max_files) { + close_pipes(ifd, ofd, read_write); + errno = ENFILE; + return (ErlDrvData) -2; + } + save_fd(ifd[0]); + save_fd(ofd[1]); + break; + default: + return (ErlDrvData) -1; + } + + /* Allocate space for program name to be freed by the + * spawned task. We use plain_malloc so that the allocated + * space is not owned by the Erlang task. + */ + + if ((progname = plain_malloc(strlen(name) + 1)) == NULL) { + close_pipes(ifd, ofd, read_write); + errno = ENOMEM; + return (ErlDrvData) -2; + } + strcpy(progname, name); + + /* Check if name contains a space + * (e.g "port_test -o/home/gandalf/tornado/wind/target/erlang") + */ + if ((space_in_command = strrchr(progname, ' ')) != NULL) { + *space_in_command = '\0'; + } + + /* resulting in "port_test" */ + if ((bname = strrchr(progname, '/')) != NULL) + bname++; + else + bname = progname; + + /* resulting in "port_test" */ + len = strlen(bname); + nl = len > 10 ? 10 : len; + strncpy(taskname, bname, nl); + taskname[nl] = '\0'; + if (space_in_command != NULL) + *space_in_command = ' '; + driver_index = pre_set_driver_data(ifd[0], ofd[1], + read_write, opts->exit_status); + + /* resetting to "port_test -o/home/gandalf/tornado/wind/target/erlang" */ + if ((id = taskSpawn(taskname, spTaskPriority, spTaskOptions, + port_stack_size, (FUNCPTR)call_proc, (int)progname, + ofd[0], ifd[1], read_write, redir_stderr, driver_index, + 0,0,0,0)) + == ERROR) { + close_pipes(ifd, ofd, read_write); + plain_free(progname); /* only when spawn fails */ + errno = ENOMEM; + return (ErlDrvData) -2; + } +#ifdef DEBUG + fdprintf(2, "Spawned %s as %s[0x%x]\n", name, taskname, id); +#endif + if (read_write & DO_READ) + init_fd_data(ifd[0], port_num); + if (read_write & DO_WRITE) + init_fd_data(ofd[1], port_num); + return (ErlDrvData) (set_driver_data(port_num, ifd[0], ofd[1], + packet_bytes,read_write, + opts->exit_status)); +} + +static ErlDrvData fd_start(ErlDrvPort port_num, char *name, SysDriverOpts* opts) +{ + if (((opts->read_write & DO_READ) && opts->ifd >= max_files) || + ((opts->read_write & DO_WRITE) && opts->ofd >= max_files)) { + return (ErlDrvData) -1; + } + + if (opts->read_write & DO_READ) + init_fd_data(opts->ifd, port_num); + if (opts->read_write & DO_WRITE) + init_fd_data(opts->ofd, port_num); + return (ErlDrvData) (set_driver_data(port_num, opts->ifd, opts->ofd, + opts->packet_bytes, opts->read_write, 0)); +} + +static void clear_fd_data(int fd) +{ + + if (fd_data[fd].sz > 0) + erts_free(ERTS_ALC_T_FD_ENTRY_BUF, (void *) fd_data[fd].buf); + fd_data[fd].buf = NULL; + fd_data[fd].sz = 0; + fd_data[fd].remain = 0; + fd_data[fd].cpos = NULL; +} + +static void nbio_stop_fd(int port_num, int fd) +{ + Pend *p, *p1; + + driver_select(port_num, fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); + clear_fd_data(fd); + p = fd_data[fd].pending; + SET_BLOCKING(fd); + while (p) { + p1 = p->next; + free(p); + p = p1; + } + fd_data[fd].pending = NULL; +} + +static void fd_stop(ErlDrvData drv_data) +{ + int ofd; + int fd = (int) drv_data; + + nbio_stop_fd(driver_data[fd].port_num, (int)fd); + ofd = driver_data[fd].ofd; + if (ofd != fd && ofd != -1) + nbio_stop_fd(driver_data[fd].port_num, (int)ofd); /* XXX fd = ofd? */ +} + +static ErlDrvData +vanilla_start(ErlDrvPort port_num, char *name, SysDriverOpts* opts) +{ + int flags, fd; + struct stat statbuf; + + DEBUGF(("vanilla_start, name: %s [r=%1i w=%1i]\n", name, + opts->read_write & DO_READ, + opts->read_write & DO_WRITE)); + + flags = (opts->read_write == DO_READ ? O_RDONLY : + opts->read_write == DO_WRITE ? O_WRONLY|O_CREAT|O_TRUNC : + O_RDWR|O_CREAT); + if ((fd = open(name, flags, 0666)) < 0){ + errno = ENFILE; + return (ErlDrvData) -2; + } + if (fd >= max_files) { + close(fd); + errno = ENFILE; + return (ErlDrvData) -2; + } + if (fstat(fd, &statbuf) < 0) { + close(fd); + errno = ENFILE; + return (ErlDrvData) -2; + } + + /* Return error for reading regular files (doesn't work) */ + if (ISREG(statbuf) && ((opts->read_write) & DO_READ)) { + close(fd); + return (ErlDrvData) -3; + } + init_fd_data(fd, port_num); + return (ErlDrvData) (set_driver_data(port_num, fd, fd, + opts->packet_bytes, opts->read_write, 0)); +} + +/* Note that driver_data[fd].ifd == fd if the port was opened for reading, */ +/* otherwise (i.e. write only) driver_data[fd].ofd = fd. */ + +static void stop(ErlDrvData drv_data) +{ + int port_num, ofd; + int fd = (int) drv_data; + + port_num = driver_data[fd].port_num; + nbio_stop_fd(port_num, fd); + driver_select(port_num, fd, ERL_DRV_USE, 0); /* close(fd) */ + + ofd = driver_data[fd].ofd; + if (ofd != fd && ofd != -1) { + nbio_stop_fd(port_num, ofd); + driver_select(port_num, ofd, ERL_DRV_USE, 0); /* close(fd) */ + } +} + +static int sched_write(int port_num,int fd, char *buf, int len, int pb) +{ + Pend *p, *p2, *p3; + int p_bytes = len; + + p = (Pend*) erts_alloc_fnf(ERTS_ALC_T_PEND_DATA, pb + len + sizeof(Pend)); + if (!p) { + driver_failure(port_num, -1); + return(-1); + } + + switch(pb) { + case 4: put_int32(len, p->buf); break; + case 2: put_int16(len, p->buf); break; + case 1: put_int8(len, p->buf); break; + case 0: break; /* Handles this case too */ + } + sys_memcpy(p->buf + pb, buf, len); + driver_select(port_num, fd, ERL_DRV_WRITE|ERL_DRV_USE, 1); + p->cpos = p->buf; + p->fd = fd; + p->next = NULL; + p->remain = len + pb; + p2 = fd_data[fd].pending; + if (p2 == NULL) + fd_data[fd].pending = p; + else { + p3 = p2->next; + while(p3) { + p_bytes += p2->remain; + p2 = p2->next; + p3 = p3->next; + } + p2->next = p; + } + if (p_bytes > (1 << 13)) /* More than 8 k pending */ + set_busy_port(port_num, 1); + return(0); +} + +/* Fd is the value returned as drv_data by the start func */ +static void output(ErlDrvData drv_data, char *buf, int len) +{ + int buf_done, port_num, wval, pb, ofd; + byte lb[4]; + struct iovec iv[2]; + int fd = (int) drv_data; + + pb = driver_data[fd].packet_bytes; + port_num = driver_data[fd].port_num; + + if ((ofd = driver_data[fd].ofd) == -1) { + return; + } + + if (fd_data[ofd].pending) { + sched_write(port_num, ofd, buf, len, pb); + return; + } + + if ((pb == 2 && len > 65535) || (pb == 1 && len > 255)) { + driver_failure_posix(port_num, EINVAL); + return; + } + if (pb == 0) { + wval = write(ofd, buf, len); + } else { + lb[0] = (len >> 24) & 255; /* MSB */ + lb[1] = (len >> 16) & 255; + lb[2] = (len >> 8) & 255; + lb[3] = len & 255; /* LSB */ + iv[0].iov_base = (char*) lb + (4 - pb); + iv[0].iov_len = pb; + iv[1].iov_base = buf; + iv[1].iov_len = len; + wval = writev(ofd, iv, 2); + } + if (wval == pb + len ) { + return; + } + if (wval < 0) { + if ((errno == EINTR) || (errno == ERRNO_BLOCK)) { + if (pb) { + sched_write(port_num, ofd, buf ,len, pb); + } else if (pb == 0) { + sched_write(port_num, ofd, buf ,len, 0); + } + return; + } + driver_failure_posix(driver_data[fd].port_num, EINVAL); + return; + } + if (wval < pb) { + sched_write(port_num, ofd, (lb +4 -pb) + wval, pb-wval, 0); + sched_write(port_num, ofd, buf ,len, 0); + return; + } + + /* we now know that wval < (pb + len) */ + buf_done = wval - pb; + sched_write(port_num, ofd, buf + buf_done, len - buf_done,0); +} + +static void stop_select(ErlDrvEvent fd, void* _) +{ + close((int)fd); +} + +static int ensure_header(int fd,char *buf,int packet_size, int sofar) +{ + int res = 0; + int remaining = packet_size - sofar; + + SET_BLOCKING(fd); + if (read_fill(fd, buf+sofar, remaining) != remaining) + return -1; + switch (packet_size) { + case 1: res = get_int8(buf); break; + case 2: res = get_int16(buf); break; + case 4: res = get_int32(buf); break; + } + SET_NONBLOCKING(fd); + return(res); +} + +static int port_inp_failure(int port_num, int ready_fd, int res) +{ + (void) driver_select(port_num, ready_fd, ERL_DRV_READ|ERL_DRV_WRITE, 0); + clear_fd_data(ready_fd); + if (res == 0) { + if (driver_data[ready_fd].report_exit) { + int tmpexit = 0; + int reported; + /* Lock the driver_data structure */ + semTake(driver_data_sem, WAIT_FOREVER); + if ((reported = driver_data[ready_fd].exit_reported)) + tmpexit = driver_data[ready_fd].exitcode; + semGive(driver_data_sem); + if (reported) { + erts_fprintf(stderr,"Exitcode %d reported\r\n", tmpexit); + driver_report_exit(port_num, tmpexit); + } + } + driver_failure_eof(port_num); + } else { + driver_failure(port_num, res); + } + return 0; +} + +/* fd is the drv_data that is returned from the */ +/* initial start routine */ +/* ready_fd is the descriptor that is ready to read */ + +static void ready_input(ErlDrvData drv_data, ErlDrvEvent drv_event) +{ + int port_num, packet_bytes, res; + Uint h = 0; + char *buf; + int fd = (int) drv_data; + int ready_fd = (int) drv_event; + + port_num = driver_data[fd].port_num; + packet_bytes = driver_data[fd].packet_bytes; + + if (packet_bytes == 0) { + if ((res = read(ready_fd, tmp_buf, tmp_buf_size)) > 0) { + driver_output(port_num, (char*)tmp_buf, res); + return; + } + port_inp_failure(port_num, ready_fd, res); + return; + } + + if (fd_data[ready_fd].remain > 0) { /* We try to read the remainder */ + /* space is allocated in buf */ + res = read(ready_fd, fd_data[ready_fd].cpos, + fd_data[ready_fd].remain); + if (res < 0) { + if ((errno == EINTR) || (errno == ERRNO_BLOCK)) { + ; + } else { + port_inp_failure(port_num, ready_fd, res); + } + } else if (res == 0) { + port_inp_failure(port_num, ready_fd, res); + } else if (res == fd_data[ready_fd].remain) { /* we're done */ + driver_output(port_num, fd_data[ready_fd].buf, + fd_data[ready_fd].sz); + clear_fd_data(ready_fd); + } else { /* if (res < fd_data[ready_fd].remain) */ + fd_data[ready_fd].cpos += res; + fd_data[ready_fd].remain -= res; + } + return; + } + + + if (fd_data[ready_fd].remain == 0) { /* clean fd */ + /* We make one read attempt and see what happens */ + res = read(ready_fd, tmp_buf, tmp_buf_size); + if (res < 0) { + if ((errno == EINTR) || (errno == ERRNO_BLOCK)) + return; + port_inp_failure(port_num, ready_fd, res); + return; + } + else if (res == 0) { /* eof */ + port_inp_failure(port_num, ready_fd, res); + return; + } + else if (res < packet_bytes) { /* Ugly case... get at least */ + if ((h = ensure_header(ready_fd, tmp_buf, packet_bytes, res))==-1) { + port_inp_failure(port_num, ready_fd, -1); + return; + } + buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); + if (!buf) { + port_inp_failure(port_num, ready_fd, -1); + return; + } + fd_data[ready_fd].buf = buf; + fd_data[ready_fd].sz = h; + fd_data[ready_fd].remain = h; + fd_data[ready_fd].cpos = buf; + return; + } + else { /* if (res >= packet_bytes) */ + unsigned char* cpos = tmp_buf; + int bytes_left = res; + while (1) { /* driver_output as many as possible */ + if (bytes_left == 0) { + clear_fd_data(ready_fd); + return; + } + if (bytes_left < packet_bytes) { /* Yet an ugly case */ + if((h=ensure_header(ready_fd, cpos, + packet_bytes, bytes_left))==-1) { + port_inp_failure(port_num, ready_fd, -1); + return; + } + buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); + if (!buf) + port_inp_failure(port_num, ready_fd, -1); + fd_data[ready_fd].buf = buf; + fd_data[ready_fd].sz = h; + fd_data[ready_fd].remain = h; + fd_data[ready_fd].cpos = buf; + return; + } + switch (packet_bytes) { + case 1: h = get_int8(cpos); cpos += 1; break; + case 2: h = get_int16(cpos); cpos += 2; break; + case 4: h = get_int32(cpos); cpos += 4; break; + } + bytes_left -= packet_bytes; + /* we've got the header, now check if we've got the data */ + if (h <= (bytes_left)) { + driver_output(port_num, (char*) cpos, h); + cpos += h; + bytes_left -= h; + continue; + } + else { /* The last message we got was split */ + buf = erts_alloc_fnf(ERTS_ALC_T_FD_ENTRY_BUF, h); + if (!buf) { + port_inp_failure(port_num, ready_fd, -1); + } + sys_memcpy(buf, cpos, bytes_left); + fd_data[ready_fd].buf = buf; + fd_data[ready_fd].sz = h; + fd_data[ready_fd].remain = h - bytes_left; + fd_data[ready_fd].cpos = buf + bytes_left; + return; + } + } + return; + } + } + fprintf(stderr, "remain %d \n", fd_data[ready_fd].remain); + port_inp_failure(port_num, ready_fd, -1); +} + + +/* fd is the drv_data that is returned from the */ +/* initial start routine */ +/* ready_fd is the descriptor that is ready to read */ + +static void ready_output(ErlDrvData drv_data, ErlDrvEvent drv_event) +{ + Pend *p; + int wval; + + int fd = (int) drv_data; + int ready_fd = (int) drv_event; + + while(1) { + if ((p = fd_data[ready_fd].pending) == NULL) { + driver_select(driver_data[fd].port_num, ready_fd, + ERL_DRV_WRITE, 0); + return; + } + wval = write(p->fd, p->cpos, p->remain); + if (wval == p->remain) { + fd_data[ready_fd].pending = p->next; + erts_free(ERTS_ALC_T_PEND_DATA, p); + if (fd_data[ready_fd].pending == NULL) { + driver_select(driver_data[fd].port_num, ready_fd, + ERL_DRV_WRITE, 0); + set_busy_port(driver_data[fd].port_num, 0); + return; + } + else + continue; + } + else if (wval < 0) { + if (errno == ERRNO_BLOCK || errno == EINTR) + return; + else { + driver_select(driver_data[fd].port_num, ready_fd, + ERL_DRV_WRITE, 0); + driver_failure(driver_data[fd].port_num, -1); + return; + } + } + else if (wval < p->remain) { + p->cpos += wval; + p->remain -= wval; + return; + } + } +} + +/* Fills in the systems representation of the jam/beam process identifier. +** The Pid is put in STRING representation in the supplied buffer, +** no interpretatione of this should be done by the rest of the +** emulator. The buffer should be at least 21 bytes long. +*/ +void sys_get_pid(char *buffer){ + int p = taskIdSelf(); /* Hmm, may be negative??? requires some GB of + memory to make the TCB address convert to a + negative value. */ + sprintf(buffer,"%d", p); +} + +int +erts_sys_putenv(char *buffer, int sep_ix) +{ + return putenv(buffer); +} + +int +erts_sys_getenv(char *key, char *value, size_t *size) +{ + char *orig_value; + int res; + orig_value = getenv(key); + if (!orig_value) + res = -1; + else { + size_t len = sys_strlen(orig_value); + if (len >= *size) { + *size = len + 1; + res = 1; + } + else { + *size = len; + sys_memcpy((void *) value, (void *) orig_value, len+1); + res = 0; + } + } + return res; +} + +void +sys_init_io(void) +{ + tmp_buf = (byte *) erts_alloc(ERTS_ALC_T_SYS_TMP_BUF, SYS_TMP_BUF_SIZE); + tmp_buf_size = SYS_TMP_BUF_SIZE; + fd_data = (struct fd_data *) + erts_alloc(ERTS_ALC_T_FD_TAB, max_files * sizeof(struct fd_data)); +} + + +/* Fill buffer, return buffer length, 0 for EOF, < 0 for error. */ + +static int read_fill(int fd, char *buf, int len) +{ + int i, got = 0; + do { + if ((i = read(fd, buf+got, len-got)) <= 0) { + return i; + } + got += i; + } while (got < len); + return (len); +} + + +/************************** Misc... *******************************/ + +extern const char pre_loaded_code[]; +extern char* const pre_loaded[]; + + +/* Float conversion */ + +int sys_chars_to_double(char *buf, double *fp) +{ + char *s = buf; + + /* The following check is incorporated from the Vee machine */ + +#define ISDIGIT(d) ((d) >= '0' && (d) <= '9') + + /* Robert says that something like this is what he really wanted: + * + * 7 == sscanf(Tbuf, "%[+-]%[0-9].%[0-9]%[eE]%[+-]%[0-9]%s", ....); + * if (*s2 == 0 || *s3 == 0 || *s4 == 0 || *s6 == 0 || *s7) + * break; + */ + + /* Scan string to check syntax. */ + if (*s == '+' || *s == '-') + s++; + + if (!ISDIGIT(*s)) /* Leading digits. */ + return -1; + while (ISDIGIT(*s)) s++; + if (*s++ != '.') /* Decimal part. */ + return -1; + if (!ISDIGIT(*s)) + return -1; + while (ISDIGIT(*s)) s++; + if (*s == 'e' || *s == 'E') { + /* There is an exponent. */ + s++; + if (*s == '+' || *s == '-') + s++; + if (!ISDIGIT(*s)) + return -1; + while (ISDIGIT(*s)) s++; + } + if (*s) /* That should be it */ + return -1; + + if (sscanf(buf, "%lf", fp) != 1) + return -1; + return 0; +} + +/* + ** Convert a double to ascii format 0.dddde[+|-]ddd + ** return number of characters converted + */ + +int sys_double_to_chars(double fp, char *buf) +{ + (void) sprintf(buf, "%.20e", fp); + return strlen(buf); +} + + +/* Floating point exceptions */ + +#if (CPU == SPARC) +jmp_buf fpe_jmp; + +RETSIGTYPE fpe_sig_handler(int sig) +{ + longjmp(fpe_jmp, 1); +} + +#elif (CPU == PPC603) +static void fix_registers(void){ + FP_CONTEXT fpcontext; + fppSave(&fpcontext); + fpcontext.fpcsr &= ~(_PPC_FPSCR_INIT); + fppRestore(&fpcontext); +} +#endif + + +/* Return a pointer to a vector of names of preloaded modules */ + +Preload* sys_preloaded(void) +{ + return (Preload *) pre_loaded; +} + +/* Return a pointer to preloaded code for module "module" */ +unsigned char* sys_preload_begin(Preload *pp) +{ + return pp->code; +} + +/* Clean up if allocated */ +void sys_preload_end(Preload *pp) +{ + /* Nothing */ +} + +/* Read a key from console (?) */ + +int sys_get_key(int fd) +{ + int c; + unsigned char rbuf[64]; + + fflush(stdout); /* Flush query ??? */ + + if ((c = read(fd,rbuf,64)) <= 0) + return c; + return rbuf[0]; +} + + +/* A real printf that does the equivalent of fprintf(stdout, ...) */ + +/* ARGSUSED */ +static STATUS +stdio_write(char *buf, int nchars, int fp) +{ + if (fwrite(buf, sizeof(char), nchars, (FILE *)fp) == 0) + return(ERROR); + return(OK); +} + +int real_printf(const char *fmt, ...) +{ + va_list ap; + int err; + + va_start(ap, fmt); + err = fioFormatV(fmt, ap, stdio_write, (int)stdout); + va_end(ap); + return(err); +} + + +/* + * Little function to do argc, argv calls from (e.g.) VxWorks shell + * The arguments should be in the form of a single ""-enclosed string + * NOTE: This isn't really part of the emulator, just included here + * so we can use the handy functions and memory reclamation. + */ +void argcall(char *args) +{ + int argc; + char **argv; + FUNCPTR entry; + + if (args != NULL) { + if ((argc = build_argv(args, &argv)) > 0) { + if ((entry = lookup(argv[0])) != NULL) + (*entry)(argc, argv, (char **)NULL); /* NULL for envp */ + else + fprintf(stderr, "Couldn't find %s\n", argv[0]); + } else + fprintf(stderr, "Failed to build argv!\n"); + } else + fprintf(stderr, "No argument list!\n"); +} + + +/* That concludes the Erlang stuff - now we just need to implement an OS... + - Just kidding, but resource reclamation isn't the strength of VxWorks */ +#undef calloc +#undef free +#undef cfree +#undef malloc +#undef realloc +#undef open +#undef creat +#undef socket +#undef accept +#undef close +#undef fopen +#undef fdopen +#undef freopen +#undef fclose + +/********************* Using elib_malloc ****************************/ +/* This gives us yet another level of malloc wrappers. The purpouse */ +/* is to be able to select between different varieties of memory */ +/* allocation without recompiling. */ +/* Maybe the performance is somewhat degraded by this, but */ +/* on the other hand, performance may be much better if the most */ +/* suiting malloc is used (not to mention the much lower */ +/* fragmentation). */ +/* /Patrik N */ +/********************************************************************/ + +/* + * I don't want to include the whole elib header, especially + * as it uses char * for generic pointers. Let's fool ANSI C instead. + */ +extern void *elib_malloc(size_t); +extern void *elib_realloc(void *, size_t); +extern void elib_free(void *); +extern void elib_init(void *, int); +extern void elib_force_init(void *, int); +extern size_t elib_sizeof(void *); + +/* Flags */ +#define USING_ELIB_MALLOC 1 /* We are using the elib_malloc */ +#define WARN_MALLOC_MIX 2 /* Warn if plain malloc or save_malloc + is mixed with sys_free2 or + sys_realloc2 */ +#define REALLOC_MOVES 4 /* Always move on realloc + (less fragmentation) */ +#define USER_POOL 8 /* The user supplied the memory + pool, it was not save_alloced. */ +#define RECLAIM_USER_POOL 16 /* Use the reclaim mechanism in the + user pool. */ +#define NEW_USER_POOL 32 /* The user pool is newly suppllied, + any old pool should be discarded */ + + +#define ELIB_LOCK \ +if(alloc_flags & USING_ELIB_MALLOC) \ + semTake(elib_malloc_sem, WAIT_FOREVER) + +#define ELIB_UNLOCK \ +if(alloc_flags & USING_ELIB_MALLOC) \ + semGive(elib_malloc_sem) + +#define USER_RECLAIM() ((alloc_flags & USING_ELIB_MALLOC) && \ + (alloc_flags & USER_POOL) && \ + (alloc_flags & RECLAIM_USER_POOL)) + +/* + * Global state + * The use of function pointers for the malloc/realloc/free functions + * is actually only useful in the malloc case, we must know what kind of + * realloc/free we are going to use, so we could call elib_xxx directly. + * However, as the overhead is small and this construction makes it + * fairly easy to add another malloc algorithm, the function pointers + * are used in realloc/free to. + */ +static MallocFunction actual_alloc = &save_malloc; +static ReallocFunction actual_realloc = &save_realloc; +static FreeFunction actual_free = &save_free; +static int alloc_flags = 0; +static int alloc_pool_size = 0; +static void *alloc_pool_ptr = NULL; +static SEM_ID elib_malloc_sem = NULL; + +/* + * Descide if we should use the save_free instead of elib_free or, + * in the case of the free used in a delete hook, if we should + * use plain free instead of elib_free. + */ +static int use_save_free(void *ptr){ + register int diff = ((char *) ptr) - ((char *) alloc_pool_ptr); + /* + * Hmmm... should it be save_free even if diff is exactly 0? + * The answer is Yes if the whole area is save_alloced and No if not, + * so reclaim_free_hook is NOT run in the case of one save_alloced area. + */ + return (!(alloc_flags & USING_ELIB_MALLOC) || + (diff < 0 || diff >= alloc_pool_size)); +} + +/* + * A free function used by the task deletion hook for the save_xxx functions. + * Set with the set_reclaim_free_function function. + */ +static void reclaim_free_hook(void *ptr){ + if(use_save_free(ptr)){ + free(ptr); + } else { + ELIB_LOCK; + (*actual_free)(ptr); + ELIB_UNLOCK; + } +} + + +/* + * Initialize, sets the values of pointers based on + * either nothing (the default) or what's set previously by the + * erl_set_memory_block function. + */ +static void initialize_allocation(void){ + set_reclaim_free_function(NULL); + if(alloc_pool_size == 0){ + actual_alloc = (void *(*)(size_t))&save_malloc; + actual_realloc = (void *(*)(void *, size_t))&save_realloc; + actual_free = &save_free; + alloc_flags &= ~(USING_ELIB_MALLOC | USER_POOL | RECLAIM_USER_POOL); + } else { + if(elib_malloc_sem == NULL) + elib_malloc_sem = semMCreate + (SEM_Q_PRIORITY | SEM_DELETE_SAFE | SEM_INVERSION_SAFE); + if(elib_malloc_sem == NULL) + erl_exit(1,"Could not create mutex semaphore for elib_malloc"); + if(!(alloc_flags & USER_POOL)){ + if((alloc_pool_ptr = save_malloc(alloc_pool_size)) == NULL) + erl_exit(1,"Erlang set to allocate a %d byte block initially;" + " not enough memory available.", alloc_pool_size); + elib_force_init(alloc_pool_ptr, alloc_pool_size); + } else if(alloc_flags & NEW_USER_POOL){ + elib_force_init(alloc_pool_ptr, alloc_pool_size); + } + actual_alloc=&elib_malloc; + actual_realloc=&elib_realloc; + actual_free=&elib_free; + alloc_flags |= USING_ELIB_MALLOC; + /* We MUST see to that the right free function is used + otherwise we'll get a very nasty crash! */ + if(USER_RECLAIM()) + set_reclaim_free_function(&reclaim_free_hook); + } + alloc_flags &= ~(NEW_USER_POOL); /* It's never new after initialization*/ +} + +/* This does not exist on other platforms, we just use it in sys.c + and the BSD resolver */ +void *sys_calloc2(Uint nelem, Uint elsize){ + void *ptr = erts_alloc_fnf(ERTS_ALC_T_UNDEF, nelem*elsize); + if(ptr != NULL) + memset(ptr,0,nelem*elsize); + return ptr; +} + +/* + * The malloc wrapper + */ +void * +erts_sys_alloc(ErtsAlcType_t type, void *extra, Uint size) +{ + register void *ret; + ELIB_LOCK; + if(USER_RECLAIM()) + ret = save_malloc2((size_t)size,actual_alloc); + else + ret = (*actual_alloc)((size_t)size); + ELIB_UNLOCK; + return ret; +} + +/* + * The realloc wrapper, may respond to the "realloc-always-moves" flag + * if the area is initially allocated with elib_malloc. + */ +void * +erts_sys_realloc(ErtsAlcType_t type, void *extra, void *ptr, Uint size) +{ + register void *ret; + if(use_save_free(ptr)){ + if((alloc_flags & WARN_MALLOC_MIX) && + (alloc_flags & USING_ELIB_MALLOC)) + erts_fprintf(stderr,"Warning, save_malloced data realloced " + "by sys_realloc2\n"); + return save_realloc(ptr, (size_t) size); + } else { + ELIB_LOCK; + if((alloc_flags & REALLOC_MOVES) && + (alloc_flags & USING_ELIB_MALLOC)){ + size_t osz = elib_sizeof(ptr); + if(USER_RECLAIM()) + ret = save_malloc2((size_t) size, actual_alloc); + else + ret = (*actual_alloc)((size_t) size); + if(ret != NULL){ + memcpy(ret,ptr,(((size_t)size) < osz) ? ((size_t)size) : osz); + if(USER_RECLAIM()) + save_free2(ptr,actual_free); + else + (*actual_free)(ptr); + } + } else { + if(USER_RECLAIM()) + ret = save_realloc2(ptr,(size_t)size,actual_realloc); + else + ret = (*actual_realloc)(ptr,(size_t)size); + } + ELIB_UNLOCK; + return ret; + } +} + +/* + * Wrapped free(). + */ +void +erts_sys_free(ErtsAlcType_t type, void *extra, void *ptr) +{ + if(use_save_free(ptr)){ + /* + * This might happen when linked in drivers use save_malloc etc + * directly. + */ + if((alloc_flags & WARN_MALLOC_MIX) && + (alloc_flags & USING_ELIB_MALLOC)) + erts_fprintf(stderr,"Warning, save_malloced data freed by " + "sys_free2\n"); + save_free(ptr); + } else { + ELIB_LOCK; + if(USER_RECLAIM()) + save_free2(ptr,actual_free); + else + (*actual_free)(ptr); + ELIB_UNLOCK; + } +} + +/* + * External interface to be called before erlang is started + * Parameters: + * isize: The size of the memory block where erlang should malloc(). + * iptr: (optional) A pointer to a user supplied memory block of + * size isize. + * warn_save: Instructs sys_free2 and sys_realloc2 to warn if + * memory allocation/reallocation/freeing is mixed between + * pure malloc/save_malloc/sys_alloc2 routines (only + * warns if elib is actually used in the sys_alloc2 routines). + * realloc_moves: Always allocate a fresh memory block on reallocation + * (less fragmentation). + * reclaim_in_supplied: Use memory reclaim mechanisms inside the user + * supplied area, this makes one area reusable between + * starts of erlang and might be nice for drivers etc. + */ + +int erl_set_memory_block(int isize, int iptr, int warn_save, + int realloc_moves, int reclaim_in_supplied, int p5, + int p6, int p7, int p8, int p9){ + if(erlang_id != 0){ + erts_fprintf(stderr,"Error, cannot set erlang memory block while an " + "erlang task is running!\n"); + return 1; + } + if(isize < 8 * 1024 *1024) + erts_fprintf(stderr, + "Warning, the memory pool of %dMb may be to small to " + "run erlang in!\n", isize / (1024 * 1024)); + alloc_pool_size = (size_t) isize; + alloc_pool_ptr = (void *) iptr; + alloc_flags = 0; + /* USING_ELIB_MALLOC gets set by the initialization routine */ + if((void *)iptr != NULL) + alloc_flags |= (USER_POOL | NEW_USER_POOL); + if(realloc_moves) + alloc_flags |= REALLOC_MOVES; + if(warn_save) + alloc_flags |= WARN_MALLOC_MIX; + if((void *)iptr != NULL && reclaim_in_supplied) + alloc_flags |= RECLAIM_USER_POOL; + return 0; +} + +/* External statistics interface */ +int erl_memory_show(int p0, int p1, int p2, int p3, int p4, int p5, + int p6, int p7, int p8, int p9){ + struct elib_stat statistics; + if(!(alloc_flags & USING_ELIB_MALLOC) && erlang_id != 0){ + erts_printf("Using plain save_alloc, use memShow instead.\n"); + return 1; + } + if(erlang_id == 0 && !((alloc_flags & USER_POOL) && + !(alloc_flags & NEW_USER_POOL))){ + erts_printf("Sorry, no allocation statistics until erlang " + "is started.\n"); + return 1; + } + erts_printf("Allocation settings:\n"); + erts_printf("Using elib_malloc with memory pool size of %lu bytes.\n", + (unsigned long) alloc_pool_size); + erts_printf("Realloc-always-moves is %s\n", + (alloc_flags & REALLOC_MOVES) ? "on" : "off"); + erts_printf("Warnings about mixed malloc/free's are %s\n", + (alloc_flags & WARN_MALLOC_MIX) ? "on" : "off"); + if(alloc_flags & USER_POOL){ + erts_printf("The memory block used by elib is user supplied " + "at 0x%08x.\n", (unsigned int) alloc_pool_ptr); + if(alloc_flags & RECLAIM_USER_POOL) + erts_printf("Allocated memory within the user supplied pool\n" + " will be automatically reclaimed at task exit.\n"); + } else { + erts_printf("The memory block used by elib is save_malloc'ed " + "at 0x%08x.\n", (unsigned int) alloc_pool_ptr); + } +#ifdef NO_FIX_ALLOC + erts_printf("Fix_alloc is disabled in this build\n"); +#endif + erts_printf("Statistics from elib_malloc:\n"); + ELIB_LOCK; + + elib_stat(&statistics); + ELIB_UNLOCK; + erts_printf("Type Size (bytes) Number of blocks\n"); + erts_printf("============= ============ ================\n"); + erts_printf("Total: %12lu %16lu\n", + (unsigned long) statistics.mem_total*4, + (unsigned long) statistics.mem_blocks); + erts_printf("Allocated: %12lu %16lu\n", + (unsigned long) statistics.mem_alloc*4, + (unsigned long) statistics.mem_blocks-statistics.free_blocks); + erts_printf("Free: %12lu %16lu\n", + (unsigned long) statistics.mem_free*4, + (unsigned long) statistics.free_blocks); + erts_printf("Largest free: %12lu -\n\n", + (unsigned long) statistics.max_free*4); + return 0; +} + + +/* +** More programmer friendly (as opposed to user friendly ;-) interface +** to the memory statistics. Resembles the VxWorks memPartInfoGet but +** does not take a partition id as parameter... +*/ +int erl_mem_info_get(MEM_PART_STATS *stats){ + struct elib_stat statistics; + if(!(alloc_flags & USING_ELIB_MALLOC)) + return -1; + ELIB_LOCK; + elib_stat(&statistics); + ELIB_UNLOCK; + stats->numBytesFree = statistics.mem_free*4; + stats->numBlocksFree = statistics.free_blocks; + stats->maxBlockSizeFree = statistics.max_free*4; + stats->numBytesAlloc = statistics.mem_alloc*4; + stats->numBlocksAlloc = statistics.mem_blocks-statistics.free_blocks; + return 0; +} + +/********************* Pipe driver **********************************/ +/* + * Purpose: Pipe driver with Unix (unnamed) pipe semantics. + * Author: Peter Hogfeldt (peter@erix.ericsson.se) from an outline + * by Per Hedeland (per@erix.ericsson.se). + * + * Note: This driver must *not* use the reclaim facilities, hence it + * is placed here. (after the #undef's of open,malloc etc) + * + * This driver supports select() and non-blocking I/O via + * ioctl(fd, FIONBIO, val). + * + * 1997-03-21 Peter Hogfeldt + * Added non-blocking I/O. + * + */ + +/* + * SEMAPHORES + * + * Each end of a pipe has two semaphores: semExcl for serialising access to + * the pipe end, and semBlock for blocking I/O. + * + * reader->semBlock is available (full) if and only if the pipe is + * not empty, or the write end is closed. Otherwise + * it is unavailable (empty). It is initially + * unavailable. + * + * writer->semBlock is available (full) if and only if the pipe is + * not full, or if the reader end is closed. + * Otherwise it is unavailable. It is initially + * available. + */ + +#define UXPIPE_SIZE 4096 + +/* Forward declaration */ +typedef struct uxPipeDev UXPIPE_DEV; + +/* + * Pipe descriptor (one for each open pipe). + */ +typedef struct { + int drvNum; + UXPIPE_DEV *reader, *writer; + RING_ID ringId; +} UXPIPE; + +/* + * Device descriptor (one for each of the read and write + * ends of an open pipe). + */ +struct uxPipeDev { + UXPIPE *pipe; + int blocking; + SEL_WAKEUP_LIST wakeupList; + SEM_ID semExcl; + SEM_ID semBlock; +}; + +int uxPipeDrvNum = 0; /* driver number of pipe driver */ + +#define PIPE_NAME "/uxpipe" /* only used internally */ +#define PIPE_READ "/r" /* ditto */ +#define PIPE_WRITE "/w" /* ditto */ + +LOCAL char pipeRead[64], pipeWrite[64]; +LOCAL DEV_HDR devHdr; +LOCAL UXPIPE *newPipe; /* communicate btwn open()s in pipe() */ +LOCAL SEM_ID pipeSem; /* mutual exclusion in pipe() */ + +/* forward declarations */ +LOCAL int uxPipeOpen(DEV_HDR *pDv, char *name, int mode); +LOCAL int uxPipeClose(UXPIPE_DEV *pDev); +LOCAL int uxPipeRead(UXPIPE_DEV *pDev, char *buffer, int maxbytes); +LOCAL int uxPipeWrite(UXPIPE_DEV *pDev, char *buffer, int nbytes); +LOCAL STATUS uxPipeIoctl(FAST UXPIPE_DEV *pDev, FAST int function, int arg); + + +/*************************************************************************** + * + * uxPipeDrv - install Unix pipe driver + * + * This routine initializes the Unix pipe driver. It must be called + * before any other routine in this driver. + * + * RETURNS: + * OK, or ERROR if I/O system is unable to install driver. + */ + +STATUS +uxPipeDrv(void) +{ + if (uxPipeDrvNum > 0) + return (OK); /* driver already installed */ + if ((uxPipeDrvNum = iosDrvInstall((FUNCPTR) NULL, (FUNCPTR) NULL, + uxPipeOpen, uxPipeClose, uxPipeRead, + uxPipeWrite, uxPipeIoctl)) == ERROR) + return (ERROR); + if (iosDevAdd(&devHdr, PIPE_NAME, uxPipeDrvNum) == ERROR) + return (ERROR); + strcpy(pipeRead, PIPE_NAME); + strcat(pipeRead, PIPE_READ); + strcpy(pipeWrite, PIPE_NAME); + strcat(pipeWrite, PIPE_WRITE); + if ((pipeSem = semMCreate(SEM_Q_PRIORITY | SEM_DELETE_SAFE)) == NULL) + return (ERROR); + return (OK); +} + +/*************************************************************************** + * + * uxPipeOpen - open a pipe + * + * RETURNS: Pointer to device descriptor, or ERROR if memory cannot be + * allocated (errno = ENOMEM), or invalid argument (errno = EINVAL). + */ + +/* + * DEV_HDR *pDv; pointer to device header (dummy) + * char *name; name of pipe to open ("/r" or "/w") + * int mode; access mode (O_RDONLY or O_WRONLY) + */ +LOCAL int +uxPipeOpen(DEV_HDR *pDv, char *name, int mode) +{ + UXPIPE_DEV *reader, *writer; + + if (mode == O_RDONLY && strcmp(name, PIPE_READ) == 0) { + /* reader open */ + if ((newPipe = (UXPIPE *) malloc(sizeof(UXPIPE))) != NULL) { + if ((newPipe->ringId = rngCreate(UXPIPE_SIZE)) != NULL) { + if ((reader = (UXPIPE_DEV *) malloc(sizeof(UXPIPE_DEV))) != NULL) { + if ((reader->semExcl = semBCreate(SEM_Q_FIFO, SEM_FULL)) != NULL) { + if ((reader->semBlock = semBCreate(SEM_Q_FIFO, SEM_EMPTY)) != NULL) { + reader->pipe = newPipe; + reader->blocking = 1; + selWakeupListInit(&reader->wakeupList); + newPipe->reader = reader; + newPipe->writer = NULL; + newPipe->drvNum = uxPipeDrvNum; + return ((int) reader); + } + semDelete(reader->semExcl); + } + free(reader); + } + rngDelete(newPipe->ringId); + } + free(newPipe); + newPipe = NULL; + errno = ENOMEM; + } + } else if (mode == O_WRONLY && strcmp(name, PIPE_WRITE) == 0) { + /* writer open */ + if (newPipe != NULL && + (writer = (UXPIPE_DEV *) malloc(sizeof(UXPIPE_DEV))) != NULL) { + if ((writer->semExcl = semBCreate(SEM_Q_FIFO, SEM_FULL)) != NULL) { + if ((writer->semBlock = semBCreate(SEM_Q_FIFO, SEM_FULL)) != NULL) { + writer->blocking = 1; + writer->pipe = newPipe; + selWakeupListInit(&writer->wakeupList); + newPipe->writer = writer; + newPipe = NULL; + return ((int) writer); + } + semDelete(writer->semExcl); + } + free(writer); + } + if (newPipe != NULL) + free(newPipe); + newPipe = NULL; + errno = ENOMEM; + } else { + errno = EINVAL; + } + return (ERROR); +} + +/*************************************************************************** + * + * uxPipeClose - close read or write end of a pipe. + * + * RETURNS: + * OK, or ERROR if device descriptor does not refer to an open read or + write end of a pipe (errno = EBADF). + */ + +LOCAL int +uxPipeClose(UXPIPE_DEV *pDev) +{ + UXPIPE *pajp = pDev->pipe; + + taskLock(); + if (pDev == pajp->reader) { + /* Close this end */ + semDelete(pDev->semExcl); + semDelete(pDev->semBlock); + free(pDev); + pajp->reader = NULL; + /* Inform the other end */ + if (pajp->writer != NULL) { + selWakeupAll(&pajp->writer->wakeupList, SELWRITE); + semGive(pajp->writer->semBlock); + } + } else if (pDev == pajp->writer) { + /* Close this end */ + semDelete(pDev->semExcl); + semDelete(pDev->semBlock); + free(pDev); + pajp->writer = NULL; + /* Inform the other end */ + if (pajp->reader != NULL) { + selWakeupAll(&pajp->reader->wakeupList, SELREAD); + semGive(pajp->reader->semBlock); + } + } else { + errno = EBADF; + taskUnlock(); + return (ERROR); + } + if (pajp->reader == NULL && pajp->writer == NULL) { + rngDelete(pajp->ringId); + pajp->drvNum = 0; + free(pajp); + } + taskUnlock(); + return (OK); +} +/*************************************************************************** + * + * uxPipeRead - read from a pipe. + * + * Reads at most maxbytes bytes from the pipe. Blocks if blocking mode is + * set and the pipe is empty. + * + * RETURNS: + * number of bytes read, 0 on EOF, or ERROR if device descriptor does + * not refer to an open read end of a pipe (errno = EBADF), or if + * non-blocking mode is set and the pipe is empty (errno = EWOULDBLOCK). + */ + +LOCAL int +uxPipeRead(UXPIPE_DEV *pDev, char *buffer, int maxbytes) +{ + UXPIPE *pajp = pDev->pipe; + int nbytes = 0; + + if (pDev != pajp->reader) { + errno = EBADF; + return (ERROR); + } + if (maxbytes == 0) + return (0); + semTake(pDev->semExcl, WAIT_FOREVER); + /* + * Note that semBlock may be full, although there is nothing to read. + * This happens e.g. after the following sequence of operations: a + * reader task blocks, a writer task writes two times (the first + * write unblocks the reader task, the second write makes semBlock + * full). + */ + while (nbytes == 0) { + if (pDev->blocking) + semTake(pDev->semBlock, WAIT_FOREVER); + /* + * Reading and updating of the write end must not be interleaved + * with a write from another task - hence we lock this task. + */ + taskLock(); + nbytes = rngBufGet(pajp->ringId, buffer, maxbytes); + if (nbytes > 0) { + /* Give own semaphore if bytes remain or if write end is closed */ + if ((!rngIsEmpty(pajp->ringId) || pajp->writer == NULL) && + pDev->blocking) + semGive(pDev->semBlock); + /* Inform write end */ + if (pajp->writer != NULL) { + if (pajp->writer->blocking) + semGive(pajp->writer->semBlock); + selWakeupAll(&pajp->writer->wakeupList, SELWRITE); + } + } else if (pajp->writer == NULL) { + nbytes = 0; /* EOF */ + /* Give semaphore when write end is closed */ + if (pDev->blocking) + semGive(pDev->semBlock); + taskUnlock(); + semGive(pDev->semExcl); + return (nbytes); + } else if (!pDev->blocking) { + taskUnlock(); + semGive(pDev->semExcl); + errno = EWOULDBLOCK; + return (ERROR); + } + taskUnlock(); + } + semGive(pDev->semExcl); + return (nbytes); +} + +/*************************************************************************** + * + * uxPipeWrite - write to a pipe. + * + * Writes nbytes bytes to the pipe. Blocks if blocking mode is set, and if + * the pipe is full. + * + * RETURNS: + * number of bytes written, or ERROR if the device descriptor does not + * refer to an open write end of a pipe (errno = EBADF); or if the read end + * of the pipe is closed (errno = EPIPE); or if non-blocking mode is set + * and the pipe is full (errno = EWOULDBLOCK). + * + */ + +LOCAL int +uxPipeWrite(UXPIPE_DEV *pDev, char *buffer, int nbytes) +{ + + UXPIPE *pajp = pDev->pipe; + int sofar = 0, written; + + if (pDev != pajp->writer) { + errno = EBADF; + return (ERROR); + } + if (pajp->reader == NULL) { + errno = EPIPE; + return (ERROR); + } + if (nbytes == 0) + return (0); + semTake(pDev->semExcl, WAIT_FOREVER); + while (sofar < nbytes) { + if (pDev->blocking) + semTake(pDev->semBlock, WAIT_FOREVER); + if (pajp->reader == NULL) { + errno = EPIPE; + semGive(pDev->semBlock); + semGive(pDev->semExcl); + return (ERROR); + } + /* Writing and updating of the read end must not be interleaved + * with a read from another task - hence we lock this task. + */ + taskLock(); + written = rngBufPut(pajp->ringId, buffer + sofar, nbytes - sofar); + sofar += written; + /* Inform the read end if we really wrote something */ + if (written > 0 && pajp->reader != NULL) { + selWakeupAll(&pajp->reader->wakeupList, SELREAD); + if (pajp->reader->blocking) + semGive(pajp->reader->semBlock); + } + taskUnlock(); + if (!pDev->blocking) { + if (sofar == 0) { + errno = EWOULDBLOCK; + sofar = ERROR; + } + break; + } + } + /* Give own semaphore if space remains */ + if (!rngIsFull(pajp->ringId) && pDev->blocking) + semGive(pDev->semBlock); + semGive(pDev->semExcl); + return (sofar); +} + +/*************************************************************************** + * + * uxPipeIoctl - do device specific I/O control + * + * RETURNS: + * OK or ERROR. + */ + +LOCAL STATUS +uxPipeIoctl(FAST UXPIPE_DEV *pDev, FAST int function, int arg) + +{ + UXPIPE *pajp = pDev->pipe; + int status = OK; + + switch (function) { + case FIONBIO: + pDev->blocking = (*(int *)arg) ? 0 : 1; + break; + case FIOSELECT: + taskLock(); + selNodeAdd(&pDev->wakeupList, (SEL_WAKEUP_NODE *) arg); + if (selWakeupType((SEL_WAKEUP_NODE *) arg) == SELREAD && + pDev == pajp->reader && + (!rngIsEmpty(pajp->ringId) || pajp->writer == NULL)) + selWakeup((SEL_WAKEUP_NODE *) arg); + if (selWakeupType((SEL_WAKEUP_NODE *) arg) == SELWRITE && + pDev == pajp->writer && + (!rngIsFull(pajp->ringId) || pajp->reader == NULL)) + selWakeup((SEL_WAKEUP_NODE *) arg); + taskUnlock(); + break; + case FIOUNSELECT: + selNodeDelete(&pDev->wakeupList, (SEL_WAKEUP_NODE *) arg); + break; + default: + status = ERROR; + break; + } + return (status); +} + +/*************************************************************************** + * + * pipe - create an intertask channel + * + * Creates a pipe. fd[0] (fd[1]) is the read (write) file descriptor. + * + * RETURNS: + * OK or ERROR, if the pipe could not be created. + */ + +STATUS +pipe(int fd[2]) +{ + semTake(pipeSem, WAIT_FOREVER); + if ((fd[0] = open(pipeRead, O_RDONLY, 0)) != ERROR) { + if ((fd[1] = open(pipeWrite, O_WRONLY, 0)) != ERROR) { + semGive(pipeSem); + return (OK); + } + (void) close(fd[0]); + } + errno &= 0xFFFF; + if((errno & 0xFFFF) == EINTR) /* Why on earth EINTR??? */ + errno = ENFILE; /* It means we are out of file descriptors...*/ + semGive(pipeSem); + return (ERROR); +} + +/*************************************************************************** + * + * uxPipeShow - display pipe information + * + * RETURNS: + * N/A. + */ + +void +uxPipeShow(int fd) +{ + UXPIPE_DEV *pDev; + UXPIPE *pajp; + int drvValue; + + if ((drvValue = iosFdValue(fd)) == ERROR) { + erts_fprintf(stderr, "Error: file descriptor invalid\n"); + return; + } + pDev = (UXPIPE_DEV *)drvValue; + pajp = pDev->pipe; + if (pajp->drvNum != uxPipeDrvNum) { + erts_fprintf(stderr, "Error: Not a ux pipe device\n"); + return; + } + erts_fprintf(stderr, "Device : 0x%x\n", (int) pDev); + erts_fprintf(stderr, "Buffer size : %d\n", UXPIPE_SIZE); + erts_fprintf(stderr, "Bytes in buffer : %d\n\n", rngNBytes(pajp->ringId)); + erts_fprintf(stderr, "READ END\n\n"); + if (pajp->reader != NULL) { + erts_fprintf(stderr, "Mode : "); + erts_fprintf(stderr, "%s\n", + (pajp->reader->blocking) ? "blocking" : "non-blocking"); + } + erts_fprintf(stderr, "Status : "); + if (pajp->reader != NULL) { + erts_fprintf(stderr, "OPEN\n"); + erts_fprintf(stderr, "Wake-up list : %d\n\n", + selWakeupListLen(&pajp->reader->wakeupList)); + erts_fprintf(stderr, "Exclusion Semaphore\n"); + semShow(pajp->reader->semExcl, 1); + erts_fprintf(stderr, "Blocking Semaphore\n"); + semShow(pajp->reader->semBlock, 1); + } else + erts_fprintf(stderr, "CLOSED\n\n"); + erts_fprintf(stderr, "WRITE END\n\n"); + if (pajp->writer != NULL) { + erts_fprintf(stderr, "Mode : "); + erts_fprintf(stderr, "%s\n", + (pajp->writer->blocking) ? "blocking" : "non-blocking"); + } + erts_fprintf(stderr, "Status : "); + if (pajp->writer != NULL) { + erts_fprintf(stderr, "OPEN\n"); + erts_fprintf(stderr, "Wake-up list : %d\n\n", + selWakeupListLen(&pajp->writer->wakeupList)); + erts_fprintf(stderr, "Exclusion Semaphore\n"); + semShow(pajp->writer->semExcl, 1); + erts_fprintf(stderr, "Blocking Semaphore\n"); + semShow(pajp->writer->semBlock, 1); + } else + erts_fprintf(stderr, "CLOSED\n\n"); +} + +#ifdef DEBUG +void +erl_assert_error(char* expr, char* file, int line) +{ + fflush(stdout); + fprintf(stderr, "Assertion failed: %s in %s, line %d\n", + expr, file, line); + fflush(stderr); + erl_crash_dump(file, line, "Assertion failed: %s\n", expr); + abort(); +} +void +erl_debug(char* fmt, ...) +{ + char sbuf[1024]; /* Temporary buffer. */ + va_list va; + + va_start(va, fmt); + vsprintf(sbuf, fmt, va); + va_end(va); + fprintf(stderr, "%s\n", sbuf); +} +#endif diff --git a/erts/emulator/sys/win32/dosmap.c b/erts/emulator/sys/win32/dosmap.c new file mode 100644 index 0000000000..15416a66c5 --- /dev/null +++ b/erts/emulator/sys/win32/dosmap.c @@ -0,0 +1,282 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * _dosmaperr: maps Windows OS errors to Unix System V errno values + * + * Contributor: Michael Regen + */ + +/* Only use for win32 if linking to MSVCR??.DLL and not if statically linking + to LIBCMT.LIB */ +#if defined(WIN32) && defined(_MT) && defined(_DLL) + +#include +#include +#include + +/* Position in table = Windows OS error -> Posix errno +** An exception for ERROR_NOT_ENOUGH_QUOTA - 1816 is in _dosmaperr +*/ +static const unsigned char errMapTable[] = { + EINVAL, /* ERROR_SUCCESS 0 */ + EINVAL, /* ERROR_INVALID_FUNCTION 1 */ + ENOENT, /* ERROR_FILE_NOT_FOUND 2 */ + ENOENT, /* ERROR_PATH_NOT_FOUND 3 */ + EMFILE, /* ERROR_TOO_MANY_OPEN_FILES 4 */ + EACCES, /* ERROR_ACCESS_DENIED 5 */ + EBADF, /* ERROR_INVALID_HANDLE 6 */ + ENOMEM, /* ERROR_ARENA_TRASHED 7 */ + ENOMEM, /* ERROR_NOT_ENOUGH_MEMORY 8 */ + ENOMEM, /* ERROR_INVALID_BLOCK 9 */ + E2BIG, /* ERROR_BAD_ENVIRONMENT 10 */ + ENOEXEC, /* ERROR_BAD_FORMAT 11 */ + EINVAL, /* ERROR_INVALID_ACCESS 12 */ + EINVAL, /* ERROR_INVALID_DATA 13 */ + EINVAL, /* ERROR_OUTOFMEMORY 14 */ + ENOENT, /* ERROR_INVALID_DRIVE 15 */ + EACCES, /* ERROR_CURRENT_DIRECTORY 16 */ + EXDEV, /* ERROR_NOT_SAME_DEVICE 17 */ + ENOENT, /* ERROR_NO_MORE_FILES 18 */ + EACCES, /* ERROR_WRITE_PROTECT 19 */ + EACCES, /* ERROR_BAD_UNIT 20 */ + EACCES, /* ERROR_NOT_READY 21 */ + EACCES, /* ERROR_BAD_COMMAND 22 */ + EACCES, /* ERROR_CRC 23 */ + EACCES, /* ERROR_BAD_LENGTH 24 */ + EACCES, /* ERROR_SEEK 25 */ + EACCES, /* ERROR_NOT_DOS_DISK 26 */ + EACCES, /* ERROR_SECTOR_NOT_FOUND 27 */ + EACCES, /* ERROR_OUT_OF_PAPER 28 */ + EACCES, /* ERROR_WRITE_FAULT 29 */ + EACCES, /* ERROR_READ_FAULT 30 */ + EACCES, /* ERROR_GEN_FAILURE 31 */ + EACCES, /* ERROR_SHARING_VIOLATION 32 */ + EACCES, /* ERROR_LOCK_VIOLATION 33 */ + EACCES, /* ERROR_WRONG_DISK 34 */ + EACCES, /* 35 */ + EACCES, /* ERROR_SHARING_BUFFER_EXCEEDED 36 */ + EINVAL, /* 37 */ + EINVAL, /* ERROR_HANDLE_EOF 38 */ + EINVAL, /* ERROR_HANDLE_DISK_FULL 39 */ + EINVAL, /* 40 */ + EINVAL, /* 41 */ + EINVAL, /* 42 */ + EINVAL, /* 43 */ + EINVAL, /* 44 */ + EINVAL, /* 45 */ + EINVAL, /* 46 */ + EINVAL, /* 47 */ + EINVAL, /* 48 */ + EINVAL, /* 49 */ + EINVAL, /* ERROR_NOT_SUPPORTED 50 */ + EINVAL, /* ERROR_REM_NOT_LIST 51 */ + EINVAL, /* ERROR_DUP_NAME 52 */ + ENOENT, /* ERROR_BAD_NETPATH 53 */ + EINVAL, /* ERROR_NETWORK_BUSY 54 */ + EINVAL, /* ERROR_DEV_NOT_EXIST 55 */ + EINVAL, /* ERROR_TOO_MANY_CMDS 56 */ + EINVAL, /* ERROR_ADAP_HDW_ERR 57 */ + EINVAL, /* ERROR_BAD_NET_RESP 58 */ + EINVAL, /* ERROR_UNEXP_NET_ERR 59 */ + EINVAL, /* ERROR_BAD_REM_ADAP 60 */ + EINVAL, /* ERROR_PRINTQ_FULL 61 */ + EINVAL, /* ERROR_NO_SPOOL_SPACE 62 */ + EINVAL, /* ERROR_PRINT_CANCELLED 63 */ + EINVAL, /* ERROR_NETNAME_DELETED 64 */ + EACCES, /* ERROR_NETWORK_ACCESS_DENIED 65 */ + EINVAL, /* ERROR_BAD_DEV_TYPE 66 */ + ENOENT, /* ERROR_BAD_NET_NAME 67 */ + EINVAL, /* ERROR_TOO_MANY_NAMES 68 */ + EINVAL, /* ERROR_TOO_MANY_SESS 69 */ + EINVAL, /* ERROR_SHARING_PAUSED 70 */ + EINVAL, /* ERROR_REQ_NOT_ACCEP 71 */ + EINVAL, /* ERROR_REDIR_PAUSED 72 */ + EINVAL, /* 73 */ + EINVAL, /* 74 */ + EINVAL, /* 75 */ + EINVAL, /* 76 */ + EINVAL, /* 77 */ + EINVAL, /* 78 */ + EINVAL, /* 79 */ + EEXIST, /* ERROR_FILE_EXISTS 80 */ + EINVAL, /* 81 */ + EACCES, /* ERROR_CANNOT_MAKE 82 */ + EACCES, /* ERROR_FAIL_I24 83 */ + EINVAL, /* ERROR_OUT_OF_STRUCTURES 84 */ + EINVAL, /* ERROR_ALREADY_ASSIGNED 85 */ + EINVAL, /* ERROR_INVALID_PASSWORD 86 */ + EINVAL, /* ERROR_INVALID_PARAMETER 87 */ + EINVAL, /* ERROR_NET_WRITE_FAULT 88 */ + EAGAIN, /* ERROR_NO_PROC_SLOTS 89 */ + EINVAL, /* 90 */ + EINVAL, /* 91 */ + EINVAL, /* 92 */ + EINVAL, /* 93 */ + EINVAL, /* 94 */ + EINVAL, /* 95 */ + EINVAL, /* 96 */ + EINVAL, /* 97 */ + EINVAL, /* 98 */ + EINVAL, /* 99 */ + EINVAL, /* ERROR_TOO_MANY_SEMAPHORES 100 */ + EINVAL, /* ERROR_EXCL_SEM_ALREADY_OWNED 101 */ + EINVAL, /* ERROR_SEM_IS_SET 102 */ + EINVAL, /* ERROR_TOO_MANY_SEM_REQUESTS 103 */ + EINVAL, /* ERROR_INVALID_AT_INTERRUPT_TIME 104 */ + EINVAL, /* ERROR_SEM_OWNER_DIED 105 */ + EINVAL, /* ERROR_SEM_USER_LIMIT 106 */ + EINVAL, /* ERROR_DISK_CHANGE 107 */ + EACCES, /* ERROR_DRIVE_LOCKED 108 */ + EPIPE, /* ERROR_BROKEN_PIPE 109 */ + EINVAL, /* ERROR_OPEN_FAILED 110 */ + EINVAL, /* ERROR_BUFFER_OVERFLOW 111 */ + ENOSPC, /* ERROR_DISK_FULL 112 */ + EINVAL, /* ERROR_NO_MORE_SEARCH_HANDLES 113 */ + EBADF, /* ERROR_INVALID_TARGET_HANDLE 114 */ + EINVAL, /* 115 */ + EINVAL, /* 116 */ + EINVAL, /* ERROR_INVALID_CATEGORY 117 */ + EINVAL, /* ERROR_INVALID_VERIFY_SWITCH 118 */ + EINVAL, /* ERROR_BAD_DRIVER_LEVEL 119 */ + EINVAL, /* ERROR_CALL_NOT_IMPLEMENTED 120 */ + EINVAL, /* ERROR_SEM_TIMEOUT 121 */ + EINVAL, /* ERROR_INSUFFICIENT_BUFFER 122 */ + EINVAL, /* ERROR_INVALID_NAME 123 */ + EINVAL, /* ERROR_INVALID_LEVEL 124 */ + EINVAL, /* ERROR_NO_VOLUME_LABEL 125 */ + EINVAL, /* ERROR_MOD_NOT_FOUND 126 */ + EINVAL, /* ERROR_PROC_NOT_FOUND 127 */ + ECHILD, /* ERROR_WAIT_NO_CHILDREN 128 */ + ECHILD, /* ERROR_CHILD_NOT_COMPLETE 129 */ + EBADF, /* ERROR_DIRECT_ACCESS_HANDLE 130 */ + EINVAL, /* ERROR_NEGATIVE_SEEK 131 */ + EACCES, /* ERROR_SEEK_ON_DEVICE 132 */ + EINVAL, /* ERROR_IS_JOIN_TARGET 133 */ + EINVAL, /* ERROR_IS_JOINED 134 */ + EINVAL, /* ERROR_IS_SUBSTED 135 */ + EINVAL, /* ERROR_NOT_JOINED 136 */ + EINVAL, /* ERROR_NOT_SUBSTED 137 */ + EINVAL, /* ERROR_JOIN_TO_JOIN 138 */ + EINVAL, /* ERROR_SUBST_TO_SUBST 139 */ + EINVAL, /* ERROR_JOIN_TO_SUBST 140 */ + EINVAL, /* ERROR_SUBST_TO_JOIN 141 */ + EINVAL, /* ERROR_BUSY_DRIVE 142 */ + EINVAL, /* ERROR_SAME_DRIVE 143 */ + EINVAL, /* ERROR_DIR_NOT_ROOT 144 */ + ENOTEMPTY, /* ERROR_DIR_NOT_EMPTY 145 */ + EINVAL, /* ERROR_IS_SUBST_PATH 146 */ + EINVAL, /* ERROR_IS_JOIN_PATH 147 */ + EINVAL, /* ERROR_PATH_BUSY 148 */ + EINVAL, /* ERROR_IS_SUBST_TARGET 149 */ + EINVAL, /* ERROR_SYSTEM_TRACE 150 */ + EINVAL, /* ERROR_INVALID_EVENT_COUNT 151 */ + EINVAL, /* ERROR_TOO_MANY_MUXWAITERS 152 */ + EINVAL, /* ERROR_INVALID_LIST_FORMAT 153 */ + EINVAL, /* ERROR_LABEL_TOO_LONG 154 */ + EINVAL, /* ERROR_TOO_MANY_TCBS 155 */ + EINVAL, /* ERROR_SIGNAL_REFUSED 156 */ + EINVAL, /* ERROR_DISCARDED 157 */ + EACCES, /* ERROR_NOT_LOCKED 158 */ + EINVAL, /* ERROR_BAD_THREADID_ADDR 159 */ + EINVAL, /* ERROR_BAD_ARGUMENTS 160 */ + ENOENT, /* ERROR_BAD_PATHNAME 161 */ + EINVAL, /* ERROR_SIGNAL_PENDING 162 */ + EINVAL, /* 163 */ + EAGAIN, /* ERROR_MAX_THRDS_REACHED 164 */ + EINVAL, /* 165 */ + EINVAL, /* 166 */ + EACCES, /* ERROR_LOCK_FAILED 167 */ + EINVAL, /* 168 */ + EINVAL, /* 169 */ + EINVAL, /* ERROR_BUSY 170 */ + EINVAL, /* 171 */ + EINVAL, /* 172 */ + EINVAL, /* ERROR_CANCEL_VIOLATION 173 */ + EINVAL, /* ERROR_ATOMIC_LOCKS_NOT_SUPPORTED 174 */ + EINVAL, /* 175 */ + EINVAL, /* 176 */ + EINVAL, /* 177 */ + EINVAL, /* 178 */ + EINVAL, /* 179 */ + EINVAL, /* ERROR_INVALID_SEGMENT_NUMBER 180 */ + EINVAL, /* 181 */ + EINVAL, /* ERROR_INVALID_ORDINAL 182 */ + EEXIST, /* ERROR_ALREADY_EXISTS 183 */ + EINVAL, /* 184 */ + EINVAL, /* 185 */ + EINVAL, /* ERROR_INVALID_FLAG_NUMBER 186 */ + EINVAL, /* ERROR_SEM_NOT_FOUND 187 */ + ENOEXEC, /* ERROR_INVALID_STARTING_CODESEG 188 */ + ENOEXEC, /* ERROR_INVALID_STACKSEG 189 */ + ENOEXEC, /* ERROR_INVALID_MODULETYPE 190 */ + ENOEXEC, /* ERROR_INVALID_EXE_SIGNATURE 191 */ + ENOEXEC, /* ERROR_EXE_MARKED_INVALID 192 */ + ENOEXEC, /* ERROR_BAD_EXE_FORMAT 193 */ + ENOEXEC, /* ERROR_ITERATED_DATA_EXCEEDS_64k 194 */ + ENOEXEC, /* ERROR_INVALID_MINALLOCSIZE 195 */ + ENOEXEC, /* ERROR_DYNLINK_FROM_INVALID_RING 196 */ + ENOEXEC, /* ERROR_IOPL_NOT_ENABLED 197 */ + ENOEXEC, /* ERROR_INVALID_SEGDPL 198 */ + ENOEXEC, /* ERROR_AUTODATASEG_EXCEEDS_64k 199 */ + ENOEXEC, /* ERROR_RING2SEG_MUST_BE_MOVABLE 200 */ + ENOEXEC, /* ERROR_RELOC_CHAIN_XEEDS_SEGLIM 201 */ + ENOEXEC, /* ERROR_INFLOOP_IN_RELOC_CHAIN 202 */ + EINVAL, /* ERROR_ENVVAR_NOT_FOUND 203 */ + EINVAL, /* 204 */ + EINVAL, /* ERROR_NO_SIGNAL_SENT 205 */ + ENOENT, /* ERROR_FILENAME_EXCED_RANGE 206 */ + EINVAL, /* ERROR_RING2_STACK_IN_USE 207 */ + EINVAL, /* ERROR_META_EXPANSION_TOO_LONG 208 */ + EINVAL, /* ERROR_INVALID_SIGNAL_NUMBER 209 */ + EINVAL, /* ERROR_THREAD_1_INACTIVE 210 */ + EINVAL, /* 211 */ + EINVAL, /* ERROR_LOCKED 212 */ + EINVAL, /* 213 */ + EINVAL, /* ERROR_TOO_MANY_MODULES 214 */ + EAGAIN /* ERROR_NESTING_NOT_ALLOWED 215 */ +}; + +/* size of the table */ +#define ERRMAPTABLESIZE (sizeof(errMapTable)/sizeof(errMapTable[0])) + +/* +** void __cdecl _dosmaperr(winerrno) +** +** Takes a Windows error number and tries to map it to a Unix System V errno. +** Sets: +** _doserrno = Windows error number +** errno = Unix System V errno. +*/ +void __cdecl _dosmaperr(unsigned long winerrno) +{ + _doserrno = winerrno; + + if (winerrno >= ERRMAPTABLESIZE) { + if (winerrno == ERROR_NOT_ENOUGH_QUOTA) { /* exception for 1816 */ + errno = ENOMEM; + } else { + errno = EINVAL; + } + } else { + errno = (unsigned int) errMapTable[winerrno]; + } +} + +#endif /* WIN32 && _MT && _DLL */ + diff --git a/erts/emulator/sys/win32/driver_int.h b/erts/emulator/sys/win32/driver_int.h new file mode 100644 index 0000000000..97e188816e --- /dev/null +++ b/erts/emulator/sys/win32/driver_int.h @@ -0,0 +1,39 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/*---------------------------------------------------------------------- +** Purpose : System dependant driver declarations +**---------------------------------------------------------------------- */ + +#ifndef __DRIVER_INT_H__ +#define __DRIVER_INT_H__ + +#if !defined __WIN32__ +# define __WIN32__ +#endif + +/* + * This structure can be cast to a WSABUF structure. + */ + +typedef struct _SysIOVec { + unsigned long iov_len; + char* iov_base; +} SysIOVec; + +#endif diff --git a/erts/emulator/sys/win32/erl.def b/erts/emulator/sys/win32/erl.def new file mode 100644 index 0000000000..59e940847d --- /dev/null +++ b/erts/emulator/sys/win32/erl.def @@ -0,0 +1,4 @@ +EXPORTS + erl_start + sys_get_key + sys_primitive_init diff --git a/erts/emulator/sys/win32/erl_main.c b/erts/emulator/sys/win32/erl_main.c new file mode 100644 index 0000000000..5471bffb52 --- /dev/null +++ b/erts/emulator/sys/win32/erl_main.c @@ -0,0 +1,29 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2000-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "sys.h" +#include "global.h" + +void +main(int argc, char **argv) +{ + erl_start(argc, argv); +} diff --git a/erts/emulator/sys/win32/erl_poll.c b/erts/emulator/sys/win32/erl_poll.c new file mode 100644 index 0000000000..d816cc2c07 --- /dev/null +++ b/erts/emulator/sys/win32/erl_poll.c @@ -0,0 +1,1361 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#define WANT_NONBLOCKING + +#include "sys.h" +#include "erl_alloc.h" +#include "erl_poll.h" + +/* + * Some debug macros + */ + +/*#define HARDDEBUG */ +#ifdef HARDDEBUG +#ifdef HARDTRACE +#define HARDTRACEF(X) my_debug_printf##X +#else +#define HARDTRACEF(X) +#endif + +#define HARDDEBUGF(X) my_debug_printf##X +static void my_debug_printf(char *fmt, ...) +{ + char buffer[1024]; + va_list args; + + va_start(args, fmt); + erts_vsnprintf(buffer,1024,fmt,args); + va_end(args); + erts_fprintf(stderr,"%s\r\n",buffer); +} +#else +#define HARDTRACEF(X) +#define HARDDEBUGF(X) +#endif + +#ifdef DEBUG +#define NoMansLandFill 0xFD /* fill no-man's land with this */ +#define DeadLandFill 0xDD /* fill free objects with this */ +#define CleanLandFill 0xCD /* fill new objects with this */ + +static void consistency_check(struct _Waiter* w); +static void* debug_alloc(ErtsAlcType_t, Uint); +static void* debug_realloc(ErtsAlcType_t, void *, Uint, Uint); + +# define SEL_ALLOC debug_alloc +# define SEL_REALLOC debug_realloc +# define SEL_FREE erts_free + +static void *debug_alloc(ErtsAlcType_t type, Uint size) +{ + void* p = erts_alloc(type, size); + memset(p, CleanLandFill, size); + return p; +} + +static void *debug_realloc(ErtsAlcType_t type, void *ptr, Uint prev_size, + Uint size) +{ + void *p; + size_t fill_size; + void *fill_ptr; + + if (prev_size > size) { + size_t fill_size = (size_t) (prev_size - size); + void *fill_ptr = (void *) (((char *) ptr) + size); + memset(fill_ptr, NoMansLandFill, fill_size); + } + + p = erts_realloc(type, ptr, size); + + if (size > prev_size) { + size_t fill_size = (size_t) (size - prev_size); + void *fill_ptr = (void *) (((char *) p) + prev_size); + memset(fill_ptr, CleanLandFill, fill_size); + } + + return p; +} +#else +# define SEL_ALLOC erts_alloc +# define SEL_REALLOC realloc_wrap +# define SEL_FREE erts_free + +static ERTS_INLINE void * +realloc_wrap(ErtsAlcType_t t, void *p, Uint ps, Uint s) +{ + return erts_realloc(t, p, s); +} +#endif + + +#ifdef HARD_POLL_DEBUG +#define OP_SELECT 1 +#define OP_DESELECT 2 +#define OP_FIRED 3 +#define OP_READ_BEGIN 4 +#define OP_READ_DONE 5 +#define OP_WRITE_BEGIN 6 +#define OP_WRITE_DONE 7 +#define OP_REPORTED 8 +#define OP_DIED 9 +#define OP_ASYNC_INIT 10 +#define OP_ASYNC_IMMED 11 +#define OP_FD_MOVED 12 + +static struct { + int op; + ErtsSysFdType active; + int xdata; +} debug_save_ops[1024]; + +static int num_debug_save_ops = 0; + +static ErtsSysFdType active_debug_fd; +static int active_debug_fd_set = 0; + +static erts_mtx_t save_ops_mtx; + +static void poll_debug_init(void) +{ + erts_mtx_init(&save_ops_mtx, "save_ops_lock"); +} + +void poll_debug_set_active_fd(ErtsSysFdType fd) +{ + erts_mtx_lock(&save_ops_mtx); + active_debug_fd_set = 1; + active_debug_fd = fd; + erts_mtx_unlock(&save_ops_mtx); +} + +static void do_save_op(ErtsSysFdType fd, int op, int xdata) +{ + erts_mtx_lock(&save_ops_mtx); + if (fd == active_debug_fd && num_debug_save_ops < 1024) { + int x = num_debug_save_ops++; + debug_save_ops[x].op = op; + debug_save_ops[x].active = fd; + debug_save_ops[x].xdata = xdata; + } + erts_mtx_unlock(&save_ops_mtx); +} + +void poll_debug_moved(ErtsSysFdType fd, int s1, int s2) +{ + do_save_op(fd,OP_FD_MOVED,s1 | (s2 << 16)); +} + +void poll_debug_select(ErtsSysFdType fd, int mode) +{ + do_save_op(fd,OP_SELECT,mode); +} + +void poll_debug_deselect(ErtsSysFdType fd) +{ + do_save_op(fd,OP_DESELECT,0); +} + +void poll_debug_fired(ErtsSysFdType fd) +{ + do_save_op(fd,OP_FIRED,0); +} + +void poll_debug_read_begin(ErtsSysFdType fd) +{ + do_save_op(fd,OP_READ_BEGIN,0); +} + +void poll_debug_read_done(ErtsSysFdType fd, int bytes) +{ + do_save_op(fd,OP_READ_DONE,bytes); +} + +void poll_debug_async_initialized(ErtsSysFdType fd) +{ + do_save_op(fd,OP_ASYNC_INIT,0); +} + +void poll_debug_async_immediate(ErtsSysFdType fd, int bytes) +{ + do_save_op(fd,OP_ASYNC_IMMED,bytes); +} + +void poll_debug_write_begin(ErtsSysFdType fd) +{ + do_save_op(fd,OP_WRITE_BEGIN,0); +} + +void poll_debug_write_done(ErtsSysFdType fd, int bytes) +{ + do_save_op(fd,OP_WRITE_DONE,bytes); +} + +void poll_debug_reported(ErtsSysFdType fd, int mode) +{ + do_save_op(fd,OP_REPORTED,mode); +} + +void poll_debug_died(ErtsSysFdType fd) +{ + do_save_op(fd,OP_DIED,0); +} + +#endif /* DEBUG */ + +/* + * End of debug macros + */ + + + +/* + * Handles that we poll, but that are actually signalled from outside + * this module + */ + +extern HANDLE erts_service_event; +extern HANDLE erts_sys_break_event; + + +/* + * The structure we hold for each event (i.e. fd) + */ +typedef struct _EventData { + HANDLE event; /* For convenience. */ + ErtsPollEvents mode; /* The current select mode. */ + struct _EventData *next; /* Next in free or delete lists. */ +} EventData; + +/* + * The structure to represent a waiter thread + */ +typedef struct _Waiter { + HANDLE events[MAXIMUM_WAIT_OBJECTS]; /* The events. */ + EventData* evdata[MAXIMUM_WAIT_OBJECTS]; /* Pointers to associated data. */ + int active_events; /* Number of events to wait for */ + int total_events; /* Total number of events in the arrays. */ + int highwater; /* Events processed up to here */ + EventData evdata_heap[MAXIMUM_WAIT_OBJECTS]; /* Pre-allocated EventDatas */ + EventData* first_free_evdata; /* Index of first free EventData object. */ + HANDLE go_ahead; /* The waiter may continue. (Auto-reset) */ + void *xdata; /* used when thread parameter */ + erts_tid_t this; /* Thread "handle" of this waiter */ + erts_mtx_t mtx; /* Mutex for updating/reading pollset, but the + currently used set require thread stopping + to be updated */ +} Waiter; + +/* + * The structure for a pollset. There can currently be only one... + */ +struct ErtsPollSet_ { + Waiter** waiter; + int allocated_waiters; /* Size ow waiter array */ + int num_waiters; /* Number of waiter threads. */ + erts_atomic_t sys_io_ready; /* Tells us there is I/O ready (already). */ + int restore_events; /* Tells us to restore waiters events + next time around */ + HANDLE event_io_ready; /* To be used when waiting for io */ + /* These are used to wait for workers to enter standby */ + volatile int standby_wait_counter; /* Number of threads to wait for */ + CRITICAL_SECTION standby_crit; /* CS to guard the counter */ + HANDLE standby_wait_event; /* Event signalled when counte == 0 */ +#ifdef ERTS_SMP + erts_smp_atomic_t woken; + erts_smp_mtx_t mtx; + erts_smp_atomic_t interrupt; +#endif + erts_smp_atomic_t timeout; +}; + +#ifdef ERTS_SMP + +#define ERTS_POLLSET_LOCK(PS) \ + erts_smp_mtx_lock(&(PS)->mtx) +#define ERTS_POLLSET_UNLOCK(PS) \ + erts_smp_mtx_unlock(&(PS)->mtx) +#define ERTS_POLLSET_SET_POLLED_CHK(PS) \ + ((int) erts_smp_atomic_xchg(&(PS)->polled, (long) 1)) +#define ERTS_POLLSET_SET_POLLED(PS) \ + erts_smp_atomic_set(&(PS)->polled, (long) 1) +#define ERTS_POLLSET_UNSET_POLLED(PS) \ + erts_smp_atomic_set(&(PS)->polled, (long) 0) +#define ERTS_POLLSET_IS_POLLED(PS) \ + ((int) erts_smp_atomic_read(&(PS)->polled)) +#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) \ + ((int) erts_smp_atomic_xchg(&(PS)->woken, (long) 1)) +#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) \ + erts_smp_atomic_set(&(PS)->woken, (long) 1) +#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) \ + erts_smp_atomic_set(&(PS)->woken, (long) 0) +#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) \ + ((int) erts_smp_atomic_read(&(PS)->woken)) + +#define ERTS_POLLSET_UNSET_INTERRUPTED_CHK(PS) \ + ((int) erts_smp_atomic_xchg(&(PS)->interrupt, (long) 0)) +#define ERTS_POLLSET_UNSET_INTERRUPTED(PS) \ + erts_smp_atomic_set(&(PS)->interrupt, (long) 0) +#define ERTS_POLLSET_SET_INTERRUPTED(PS) \ + erts_smp_atomic_set(&(PS)->interrupt, (long) 1) +#define ERTS_POLLSET_IS_INTERRUPTED(PS) \ + ((int) erts_smp_atomic_read(&(PS)->interrupt)) + +#else + +#define ERTS_POLLSET_LOCK(PS) +#define ERTS_POLLSET_UNLOCK(PS) +#define ERTS_POLLSET_SET_POLLED_CHK(PS) 0 +#define ERTS_POLLSET_UNSET_POLLED(PS) +#define ERTS_POLLSET_IS_POLLED(PS) 0 +#define ERTS_POLLSET_SET_POLLER_WOKEN_CHK(PS) 1 +#define ERTS_POLLSET_SET_POLLER_WOKEN(PS) +#define ERTS_POLLSET_UNSET_POLLER_WOKEN(PS) +#define ERTS_POLLSET_IS_POLLER_WOKEN(PS) 1 + + +#endif + +/* + * While atomics are not yet implemented for windows in the common library... + * + * MSDN doc states that SMP machines and old compilers require + * InterLockedExchange to properly read and write interlocked + * variables, otherwise the processors might reschedule + * the access and order of atomics access is destroyed... + * While they only mention it in white-papers, the problem + * in VS2003 is due to the IA64 arch, so we can still count + * on the CPU not rescheduling the access to volatile in X86 arch using + * even the slightly older compiler... + * + * So here's (hopefully) a subset of the generally working atomic + * variable access... + */ + +#if defined(__GNUC__) +# if defined(__i386__) || defined(__x86_64__) +# define VOLATILE_IN_SEQUENCE 1 +# else +# define VOLATILE_IN_SEQUENCE 0 +# endif +#elif defined(_MSC_VER) +# if _MSC_VER < 1300 +# define VOLATILE_IN_SEQUENCE 0 /* Dont trust really old compilers */ +# else +# if defined(_M_IX86) +# define VOLATILE_IN_SEQUENCE 1 +# else /* I.e. IA64 */ +# if _MSC_VER >= 1400 +# define VOLATILE_IN_SEQUENCE 1 +# else +# define VOLATILE_IN_SEQUENCE 0 +# endif +# endif +# endif +#else +# define VOLATILE_IN_SEQUENCE 0 +#endif + + + +/* + * Communication with sys_interrupt + */ + +#ifdef ERTS_SMP +extern erts_smp_atomic_t erts_break_requested; +#define ERTS_SET_BREAK_REQUESTED \ + erts_smp_atomic_set(&erts_break_requested, (long) 1) +#define ERTS_UNSET_BREAK_REQUESTED \ + erts_smp_atomic_set(&erts_break_requested, (long) 0) +#else +extern volatile int erts_break_requested; +#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) +#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0) +#endif + +static erts_mtx_t break_waiter_lock; +static HANDLE break_happened_event; +static erts_atomic_t break_waiter_state; +#define BREAK_WAITER_GOT_BREAK 1 +#define BREAK_WAITER_GOT_HALT 2 + + +/* + * Forward declarations + */ + +static void *threaded_waiter(void *param); +static void *break_waiter(void *param); + +/* + * Sychronization macros and functions + */ +#define START_WAITER(PS, w) \ + SetEvent((w)->go_ahead) + +#define STOP_WAITER(PS,w) \ +do { \ + setup_standby_wait((PS),1); \ + SetEvent((w)->events[0]); \ + wait_standby(PS); \ +} while(0) + +#define START_WAITERS(PS) \ +do { \ + int i; \ + for (i = 0; i < (PS)->num_waiters; i++) { \ + SetEvent((PS)->waiter[i]->go_ahead); \ + } \ + } while(0) + +#define STOP_WAITERS(PS) \ +do { \ + int i; \ + setup_standby_wait((PS),(PS)->num_waiters); \ + for (i = 0; i < (PS)->num_waiters; i++) { \ + SetEvent((PS)->waiter[i]->events[0]); \ + } \ + wait_standby(PS); \ + } while(0) + +#if ERTS_POLL_ASYNC_INTERRUPT_SUPPORT && !defined(ERTS_SMP) + +static ERTS_INLINE int +unset_interrupted_chk(ErtsPollSet ps) +{ + /* This operation isn't atomic, but we have no need at all for an + atomic operation here... */ + int res = ps->interrupt; + ps->interrupt = 0; + return res; +} + +#endif + +#ifdef ERTS_SMP +static ERTS_INLINE void +wake_poller(ErtsPollSet ps) +{ + if (!ERTS_POLLSET_SET_POLLER_WOKEN_CHK(ps)) { + SetEvent(ps->event_io_ready); + } +} +#endif + +static void setup_standby_wait(ErtsPollSet ps, int num_threads) +{ + EnterCriticalSection(&(ps->standby_crit)); + ps->standby_wait_counter = num_threads; + ResetEvent(ps->standby_wait_event); + LeaveCriticalSection(&(ps->standby_crit)); +} + +static void signal_standby(ErtsPollSet ps) +{ + EnterCriticalSection(&(ps->standby_crit)); + --(ps->standby_wait_counter); + if (ps->standby_wait_counter < 0) { + LeaveCriticalSection(&(ps->standby_crit)); + erl_exit(1,"Standby signalled by more threads than expected"); + } + if (!(ps->standby_wait_counter)) { + SetEvent(ps->standby_wait_event); + } + LeaveCriticalSection(&(ps->standby_crit)); +} + +static void wait_standby(ErtsPollSet ps) +{ + WaitForSingleObject(ps->standby_wait_event,INFINITE); +} + +static void remove_event_from_set(Waiter *w, int j) +{ + w->evdata[j]->event = INVALID_HANDLE_VALUE; + w->evdata[j]->mode = 0; + w->evdata[j]->next = w->first_free_evdata; + w->first_free_evdata = w->evdata[j]; + + /* + * If the event is active, we will overwrite it + * with the last active event and make the hole + * the first non-active event. + */ + + if (j < w->active_events) { + w->active_events--; + w->highwater--; + w->total_events--; + w->events[j] = w->events[w->active_events]; + w->evdata[j] = w->evdata[w->active_events]; + w->events[w->active_events] = w->events[w->highwater]; + w->evdata[w->active_events] = w->evdata[w->highwater]; + w->events[w->highwater] = w->events[w->total_events]; + w->evdata[w->highwater] = w->evdata[w->total_events]; + } else if (j < w->highwater) { + w->highwater--; + w->total_events--; + w->events[j] = w->events[w->highwater]; + w->evdata[j] = w->evdata[w->highwater]; + w->events[w->highwater] = w->events[w->total_events]; + w->evdata[w->highwater] = w->evdata[w->total_events]; + } else { + w->total_events--; + w->events[j] = w->events[w->total_events]; + w->evdata[j] = w->evdata[w->total_events]; + } + +#ifdef DEBUG + w->events[w->total_events] = (HANDLE) CleanLandFill; + w->evdata[w->total_events] = (EventData *) CleanLandFill; + consistency_check(w); +#endif +} + +/* + * Thread handling + */ + +#ifdef DEBUG +static void consistency_check(Waiter* w) +{ + int i; + + ASSERT(w->active_events <= w->total_events); + ASSERT(w->evdata[0] == NULL); + + for (i = 1; i < w->total_events; i++) { + ASSERT(w->events[i] == w->evdata[i]->event); + ASSERT(w->evdata[i]->mode != 0); + } +} + +#endif + +static void new_waiter(ErtsPollSet ps) +{ + register Waiter* w; + DWORD tid; /* Id for thread. */ + erts_tid_t thread; + int i; + int tres; + + if (ps->num_waiters == ps->allocated_waiters) { + Uint old_size = sizeof(Waiter *)*ps->allocated_waiters; + ps->allocated_waiters += 64; + ps->waiter = SEL_REALLOC(ERTS_ALC_T_WAITER_OBJ, + (void *) ps->waiter, + old_size, + sizeof(Waiter *) * (ps->allocated_waiters)); + } + + w = (Waiter *) SEL_ALLOC(ERTS_ALC_T_WAITER_OBJ, sizeof(Waiter)); + ps->waiter[ps->num_waiters] = w; + + w->events[0] = CreateAutoEvent(FALSE); + w->evdata[0] = NULL; /* Should never be used. */ + w->active_events = 1; + w->highwater = 1; + w->total_events = 1; + erts_mtx_init(&w->mtx, "pollwaiter"); + + + /* + * Form the free list of EventData objects. + */ + + w->evdata_heap[0].next = 0; /* Last in free list. */ + for (i = 1; i < MAXIMUM_WAIT_OBJECTS; i++) { + w->evdata_heap[i].next = w->evdata_heap+i-1; + } + w->first_free_evdata = w->evdata_heap+MAXIMUM_WAIT_OBJECTS-1; + + /* + * Create the other events. + */ + + w->go_ahead = CreateAutoEvent(FALSE); + + /* + * Create the thread. + */ + w->xdata = ps; + erts_thr_create(&thread, &threaded_waiter, w, NULL); + w->this = thread; + + /* + * Finally, done. + */ + + (ps->num_waiters)++; +} + +static void *break_waiter(void *param) +{ + HANDLE harr[2]; + int i = 0; + harr[i++] = erts_sys_break_event; + if (erts_service_event != NULL) { + harr[i++] = erts_service_event; + } + + for(;;) { + switch (WaitForMultipleObjects(i,harr,FALSE,INFINITE)) { + case WAIT_OBJECT_0: + ResetEvent(harr[0]); + erts_mtx_lock(&break_waiter_lock); + erts_atomic_set(&break_waiter_state,BREAK_WAITER_GOT_BREAK); + SetEvent(break_happened_event); + erts_mtx_unlock(&break_waiter_lock); + break; + case (WAIT_OBJECT_0+1): + ResetEvent(harr[1]); + erts_mtx_lock(&break_waiter_lock); + erts_atomic_set(&break_waiter_state,BREAK_WAITER_GOT_HALT); + SetEvent(break_happened_event); + erts_mtx_unlock(&break_waiter_lock); + break; + default: + erl_exit(1,"Unexpected event in break_waiter"); + } + } +} + +static void *threaded_waiter(void *param) +{ + register Waiter* w = (Waiter *) param; + ErtsPollSet ps = (ErtsPollSet) w->xdata; +#ifdef HARD_POLL_DEBUG2 + HANDLE oold_fired[64]; + int num_oold_fired; + HANDLE old_fired[64]; + int num_old_fired = 0; + HANDLE fired[64]; + int num_fired = 0; + HANDLE errors[1024]; + int num_errors = 0; + HANDLE save_events[64]; + int save_active_events; + int save_total_events; + int save_highwater; +#endif + + again: + WaitForSingleObject(w->go_ahead, INFINITE); + /* Atomic enough when just checking, skip lock */ + if (w->total_events == 0) { + return NULL; + } + if (w->active_events == 0) { + goto again; + } + ASSERT(w->evdata[0] == NULL); +#ifdef HARD_POLL_DEBUG2 + num_oold_fired = num_old_fired; + memcpy(oold_fired,old_fired,num_old_fired*sizeof(HANDLE)); + num_old_fired = num_fired; + memcpy(old_fired,fired,num_fired*sizeof(HANDLE)); + num_fired = 0; +#endif + for (;;) { + int i; + int j; +#ifdef HARD_POLL_DEBUG2 + erts_mtx_lock(&w->mtx); + memcpy(save_events,w->events,w->active_events*sizeof(HANDLE)); + save_active_events = w->active_events; + save_total_events = w->total_events; + save_highwater = w->highwater; + erts_mtx_unlock(&w->mtx); +#endif + i = WaitForMultipleObjects(w->active_events, w->events, FALSE, INFINITE); + switch (i) { + case WAIT_FAILED: + DEBUGF(("Wait failed: %s\n", last_error())); + erts_mtx_lock(&w->mtx); + /* Dont wait for our signal event */ + for (j = 1; j < w->active_events; j++) { + int tmp; + if ((tmp = WaitForSingleObject(w->events[j], 0)) + == WAIT_FAILED) { + DEBUGF(("Invalid handle: i = %d, handle = 0x%0x\n", + j, w->events[j])); +#ifdef HARD_POLL_DEBUG2 + if (num_errors < 1024) + errors[num_errors++] = w->events[j]; +#endif +#ifdef HARD_POLL_DEBUG + poll_debug_died(w->events[j]); +#endif + remove_event_from_set(w,j); +#ifdef DEBUG + consistency_check(w); +#endif + } else if (tmp == WAIT_OBJECT_0) { + i = WAIT_OBJECT_0 + j; + goto event_happened; + } + } + erts_mtx_unlock(&w->mtx); + break; + case WAIT_OBJECT_0: + signal_standby(ps); + goto again; +#ifdef DEBUG + case WAIT_TIMEOUT: + ASSERT(0); +#endif + default: + erts_mtx_lock(&w->mtx); +#ifdef HARD_POLL_DEBUG2 + { + int x = memcmp(save_events,w->events,w->active_events*sizeof(HANDLE)); + ASSERT(x == 0 && save_active_events == w->active_events); + } +#endif +event_happened: +#ifdef DEBUG + consistency_check(w); +#endif + ASSERT(WAIT_OBJECT_0 < i && i < WAIT_OBJECT_0+w->active_events); + if (!erts_atomic_xchg(&ps->sys_io_ready,1)) { + HARDDEBUGF(("SET EventIoReady (%d)",erts_atomic_read(&ps->sys_io_ready))); + SetEvent(ps->event_io_ready); + } else { + HARDDEBUGF(("DONT SET EventIoReady")); + } + + /* + * The main thread wont start working on our arrays untill we're + * stopped, so we can work in peace although the main thread runs + */ + ASSERT(i >= WAIT_OBJECT_0+1); + i -= WAIT_OBJECT_0; + ASSERT(i >= 1); + w->active_events--; + HARDDEBUGF(("i = %d, a,h,t = %d,%d,%d",i, + w->active_events, w->highwater, w->total_events)); +#ifdef HARD_POLL_DEBUG2 + fired[num_fired++] = w->events[i]; +#endif +#ifdef HARD_POLL_DEBUG + poll_debug_fired(w->events[i]); +#endif + if (i < w->active_events) { + HANDLE te = w->events[i]; + EventData* tp = w->evdata[i]; + w->events[i] = w->events[w->active_events]; + w->evdata[i] = w->evdata[w->active_events]; + w->events[w->active_events] = te; + w->evdata[w->active_events] = tp; + } + HARDDEBUGF(("i = %d, a,h,t = %d,%d,%d",i, + w->active_events, w->highwater, w->total_events)); +#ifdef DEBUG + consistency_check(w); +#endif + erts_mtx_unlock(&w->mtx); + break; + } + } +} + +/* + * The actual adding and removing from pollset utilities + */ + +static int set_driver_select(ErtsPollSet ps, HANDLE event, ErtsPollEvents mode) +{ + int i; + int best_waiter = -1; /* The waiter with lowest number of events. */ + int lowest = MAXIMUM_WAIT_OBJECTS; /* Lowest number of events + * in any waiter. + */ + EventData* ev; + Waiter* w; + + /* + * Find the waiter which is least busy. + */ + +#ifdef HARD_POLL_DEBUG + poll_debug_select(event, mode); +#endif + + /* total_events can no longer be read without the lock, it's changed in the waiter */ + for (i = 0; i < ps->num_waiters; i++) { + erts_mtx_lock(&(ps->waiter[i]->mtx)); + if (ps->waiter[i]->total_events < lowest) { + lowest = ps->waiter[i]->total_events; + best_waiter = i; + } + erts_mtx_unlock(&(ps->waiter[i]->mtx)); + } + + /* + * Stop the selected waiter, or start a new waiter if all were busy. + */ + + if (best_waiter >= 0) { + w = ps->waiter[best_waiter]; + STOP_WAITER(ps,w); + erts_mtx_lock(&w->mtx); + } else { + new_waiter(ps); + w = ps->waiter[(ps->num_waiters)-1]; + erts_mtx_lock(&w->mtx); + } + +#ifdef DEBUG + consistency_check(w); +#endif + + /* + * Allocate and initialize an EventData structure. + */ + + ev = w->first_free_evdata; + w->first_free_evdata = ev->next; + ev->event = event; + ev->mode = mode; + ev->next = NULL; + + /* + * At this point, the selected waiter (newly-created or not) is + * standing by. Put the new event into the active part of the array. + */ + + if (w->active_events < w->total_events) { + /* + * Move the first event beyond the active part of the array to + * the very end to make place for the new event. + */ + +#ifdef HARD_POLL_DEBUG + poll_debug_moved(w->events[w->highwater],w->highwater,w->total_events); +#endif + w->events[w->total_events] = w->events[w->highwater]; + w->evdata[w->total_events] = w->evdata[w->highwater]; +#ifdef HARD_POLL_DEBUG + poll_debug_moved(w->events[w->active_events],w->active_events,w->highwater); +#endif + w->events[w->highwater] = w->events[w->active_events]; + w->evdata[w->highwater] = w->evdata[w->active_events]; + + } + w->events[w->active_events] = event; + w->evdata[w->active_events] = ev; + w->active_events++; + w->highwater++; + w->total_events++; + +#ifdef DEBUG + consistency_check(w); +#endif + erts_mtx_unlock(&w->mtx); + START_WAITER(ps,w); + HARDDEBUGF(("add select %d %d %d %d",best_waiter, + w->active_events,w->highwater,w->total_events)); + return mode; +} + + +static int cancel_driver_select(ErtsPollSet ps, HANDLE event) +{ + int i; + + ASSERT(event != INVALID_HANDLE_VALUE); + restart: + for (i = 0; i < ps->num_waiters; i++) { + Waiter* w = ps->waiter[i]; + int j; + + erts_mtx_lock(&w->mtx); +#ifdef DEBUG + consistency_check(w); +#endif + for (j = 0; j < w->total_events; j++) { + if (w->events[j] == event) { + int stopped = 0; + /* + * Free the event's EventData structure. + */ + + if (j < w->active_events) { + HARDDEBUGF(("Stopped in remove select")); + stopped = 1; + erts_mtx_unlock(&w->mtx); + STOP_WAITER(ps,w); + erts_mtx_lock(&w->mtx); + if ( j >= w->active_events || w->events[j] != event) { + /* things happened while unlocked */ + START_WAITER(ps,w); + erts_mtx_unlock(&w->mtx); + goto restart; + } + } +#ifdef HARD_POLL_DEBUG + poll_debug_deselect(w->events[j]); +#endif + remove_event_from_set(w, j); + if (stopped) { + START_WAITER(ps,w); + } + HARDDEBUGF(("removed select %d,%d %d %d %d",i,j, + w->active_events,w->highwater,w->total_events)); + break; + } + } + erts_mtx_unlock(&w->mtx); + } + return 0; +} + +/* + * Interface functions + */ + +void erts_poll_interrupt(ErtsPollSet ps, int set /* bool */) +{ + HARDTRACEF(("In erts_poll_interrupt(%d)",set)); +#ifdef ERTS_SMP + if (set) { + ERTS_POLLSET_SET_INTERRUPTED(ps); + wake_poller(ps); + } + else { + ERTS_POLLSET_UNSET_INTERRUPTED(ps); + } +#endif + HARDTRACEF(("Out erts_poll_interrupt(%d)",set)); +} + +void erts_poll_interrupt_timed(ErtsPollSet ps, + int set /* bool */, + long msec) +{ + HARDTRACEF(("In erts_poll_interrupt_timed(%d,%ld)",set,msec)); +#ifdef ERTS_SMP + if (set) { + if (erts_smp_atomic_read(&ps->timeout) > msec) { + ERTS_POLLSET_SET_INTERRUPTED(ps); + wake_poller(ps); + } + } + else { + ERTS_POLLSET_UNSET_INTERRUPTED(ps); + } +#endif + HARDTRACEF(("Out erts_poll_interrupt_timed")); +} + + +/* + * Windows is special, there is actually only one event type, and + * the only difference between ERTS_POLL_EV_IN and ERTS_POLL_EV_OUT + * is which driver callback will eventually be called. + */ +static ErtsPollEvents do_poll_control(ErtsPollSet ps, + ErtsSysFdType fd, + ErtsPollEvents pe, + int on /* bool */) +{ + HANDLE event = (HANDLE) fd; + ErtsPollEvents mode; + ErtsPollEvents result; + ASSERT(event != INVALID_HANDLE_VALUE); + + if (on) { + if (pe & ERTS_POLL_EV_IN || !(pe & ERTS_POLL_EV_OUT )) { + mode = ERTS_POLL_EV_IN; + } else { + mode = ERTS_POLL_EV_OUT; /* ready output only in this case */ + } + result = set_driver_select(ps, event, mode); + } else { + result = cancel_driver_select(ps, event); + } + return result; +} + +ErtsPollEvents erts_poll_control(ErtsPollSet ps, + ErtsSysFdType fd, + ErtsPollEvents pe, + int on, + int* do_wake) /* In: Wake up polling thread */ + /* Out: Poller is woken */ +{ + ErtsPollEvents result; + HARDTRACEF(("In erts_poll_control(0x%08X, %u, %d)",(unsigned long) fd, (unsigned) pe, on)); + ERTS_POLLSET_LOCK(ps); + result=do_poll_control(ps,fd,pe,on); + ERTS_POLLSET_UNLOCK(ps); + *do_wake = 0; /* Never any need to wake polling threads on windows */ + HARDTRACEF(("Out erts_poll_control -> %u",(unsigned) result)); + return result; +} + +void erts_poll_controlv(ErtsPollSet ps, + ErtsPollControlEntry pcev[], + int len) +{ + int i; + int hshur = 0; + int do_wake = 0; + + HARDTRACEF(("In erts_poll_controlv(%d)",len)); + ERTS_POLLSET_LOCK(ps); + + for (i = 0; i < len; i++) { + pcev[i].events = do_poll_control(ps, + pcev[i].fd, + pcev[i].events, + pcev[i].on); + } + ERTS_POLLSET_LOCK(ps); + HARDTRACEF(("Out erts_poll_controlv")); +} + +int erts_poll_wait(ErtsPollSet ps, + ErtsPollResFd pr[], + int *len, + SysTimeval *utvp) +{ + SysTimeval *tvp = utvp; + SysTimeval itv; + int no_fds; + DWORD timeout; + EventData* ev; + int res = 0; + int num = 0; + int n; + int i; + int break_state; + + HARDTRACEF(("In erts_poll_wait")); + ERTS_POLLSET_LOCK(ps); + + if (!erts_atomic_read(&ps->sys_io_ready) && ps->restore_events) { + HARDDEBUGF(("Restore events: %d",ps->num_waiters)); + ps->restore_events = 0; + for (i = 0; i < ps->num_waiters; ++i) { + Waiter* w = ps->waiter[i]; + erts_mtx_lock(&w->mtx); + HARDDEBUGF(("Maybe reset %d %d %d %d",i, + w->active_events,w->highwater,w->total_events)); + if (w->active_events < w->total_events) { + erts_mtx_unlock(&w->mtx); + STOP_WAITER(ps,w); + HARDDEBUGF(("Need reset %d %d %d %d",i, + w->active_events,w->highwater,w->total_events)); + erts_mtx_lock(&w->mtx); + /* Need reset, just check that it doesn't have got more to tell */ + if (w->highwater != w->active_events) { + HARDDEBUGF(("Oups!")); + /* Oups, got signalled before we took the lock, can't reset */ + if(erts_atomic_read(&ps->sys_io_ready) == 0) { + erl_exit(1,"Internal error: " + "Inconsistent io structures in erl_poll.\n"); + } + START_WAITER(ps,w); + erts_mtx_unlock(&w->mtx); + ps->restore_events = 1; + continue; + } + w->active_events = w->highwater = w->total_events; + START_WAITER(ps,w); + erts_mtx_unlock(&w->mtx); + } else { + erts_mtx_unlock(&w->mtx); + } + } + } + + no_fds = *len; + +#ifdef ERTS_POLL_MAX_RES + if (no_fds >= ERTS_POLL_MAX_RES) + no_fds = ERTS_POLL_MAX_RES; +#endif + + + ResetEvent(ps->event_io_ready); + ERTS_POLLSET_UNSET_POLLER_WOKEN(ps); + +#ifdef ERTS_SMP + if (ERTS_POLLSET_IS_INTERRUPTED(ps)) { + /* Interrupt use zero timeout */ + itv.tv_sec = 0; + itv.tv_usec = 0; + tvp = &itv; + } +#endif + + timeout = tvp->tv_sec * 1000 + tvp->tv_usec / 1000; + /*HARDDEBUGF(("timeout = %ld",(long) timeout));*/ + erts_smp_atomic_set(&ps->timeout, timeout); + + if (timeout > 0 && ! erts_atomic_read(&ps->sys_io_ready) && ! erts_atomic_read(&break_waiter_state)) { + HANDLE harr[2] = {ps->event_io_ready, break_happened_event}; + int num_h = 2; + + HARDDEBUGF(("Start waiting %d [%d]",num_h, (long) timeout)); + ERTS_POLLSET_UNLOCK(ps); + WaitForMultipleObjects(num_h, harr, FALSE, timeout); + ERTS_POLLSET_LOCK(ps); + HARDDEBUGF(("Stop waiting %d [%d]",num_h, (long) timeout)); + } + + ERTS_UNSET_BREAK_REQUESTED; + if(erts_atomic_read(&break_waiter_state)) { + erts_mtx_lock(&break_waiter_lock); + break_state = erts_atomic_read(&break_waiter_state); + erts_atomic_set(&break_waiter_state,0); + ResetEvent(break_happened_event); + erts_mtx_unlock(&break_waiter_lock); + switch (break_state) { + case BREAK_WAITER_GOT_BREAK: + ERTS_SET_BREAK_REQUESTED; + break; + case BREAK_WAITER_GOT_HALT: + erl_exit(0,""); + break; + default: + break; + } + } + + ERTS_POLLSET_SET_POLLER_WOKEN(ps); + + if (!erts_atomic_read(&ps->sys_io_ready)) { + res = EINTR; + HARDDEBUGF(("EINTR!")); + goto done; + } + + erts_atomic_set(&ps->sys_io_ready,0); + + n = ps->num_waiters; + + for (i = 0; i < n; i++) { + Waiter* w = ps->waiter[i]; + int j; + int first; + int last; + erts_mtx_lock(&w->mtx); +#ifdef DEBUG + consistency_check(w); +#endif + + first = w->active_events; + last = w->highwater; + w->highwater = w->active_events; + + for (j = last-1; j >= first; --j) { + if (num >= no_fds) { + w->highwater=j+1; + erts_mtx_unlock(&w->mtx); + /* This might mean we still have data to report, set + back the global flag! */ + erts_atomic_set(&ps->sys_io_ready,1); + HARDDEBUGF(("To many FD's to report!")); + goto done; + } + HARDDEBUGF(("SET! Restore events")); + ps->restore_events = 1; + HARDDEBUGF(("Report %d,%d",i,j)); + pr[num].fd = (ErtsSysFdType) w->events[j]; + pr[num].events = w->evdata[j]->mode; +#ifdef HARD_POLL_DEBUG + poll_debug_reported(w->events[j],w->highwater | (j << 16)); + poll_debug_reported(w->events[j],first | (last << 16)); +#endif + ++num; + } + +#ifdef DEBUG + consistency_check(w); +#endif + erts_mtx_unlock(&w->mtx); + } + done: + erts_smp_atomic_set(&ps->timeout, LONG_MAX); + *len = num; + ERTS_POLLSET_UNLOCK(ps); + HARDTRACEF(("Out erts_poll_wait")); + return res; + +} + +int erts_poll_max_fds(void) +{ + int res = sys_max_files(); + HARDTRACEF(("In/Out erts_poll_max_fds -> %d",res)); + return res; +} + +void erts_poll_info(ErtsPollSet ps, + ErtsPollInfo *pip) +{ + Uint size = 0; + Uint num_events = 0; + int i; + + HARDTRACEF(("In erts_poll_info")); + ERTS_POLLSET_LOCK(ps); + + size += sizeof(struct ErtsPollSet_); + size += sizeof(Waiter *) * ps->allocated_waiters; + for (i = 0; i < ps->num_waiters; ++i) { + Waiter *w = ps->waiter[i]; + if (w != NULL) { + size += sizeof(Waiter); + erts_mtx_lock(&w->mtx); + size += sizeof(EventData) * w->total_events; + num_events += (w->total_events - 1); /* First event is internal */ + erts_mtx_unlock(&w->mtx); + } + } + + pip->primary = "WaitForMultipleObjects"; + + pip->fallback = NULL; + + pip->kernel_poll = NULL; + + pip->memory_size = size; + + pip->poll_set_size = num_events; + + pip->fallback_poll_set_size = 0; + + pip->lazy_updates = 0; + + pip->pending_updates = 0; + + pip->batch_updates = 0; + + pip->concurrent_updates = 0; + ERTS_POLLSET_UNLOCK(ps); + + pip->max_fds = erts_poll_max_fds(); + HARDTRACEF(("Out erts_poll_info")); + +} + +ErtsPollSet erts_poll_create_pollset(void) +{ + ErtsPollSet ps = SEL_ALLOC(ERTS_ALC_T_POLLSET, + sizeof(struct ErtsPollSet_)); + HARDTRACEF(("In erts_poll_create_pollset")); + + ps->num_waiters = 0; + ps->allocated_waiters = 64; + ps->waiter = SEL_ALLOC(ERTS_ALC_T_WAITER_OBJ, + sizeof(Waiter *)*ps->allocated_waiters); + InitializeCriticalSection(&(ps->standby_crit)); + ps->standby_wait_counter = 0; + ps->event_io_ready = CreateManualEvent(FALSE); + ps->standby_wait_event = CreateManualEvent(FALSE); + erts_atomic_init(&ps->sys_io_ready,0); + ps->restore_events = 0; + +#ifdef ERTS_SMP + erts_smp_atomic_init(&ps->woken, 0); + erts_smp_mtx_init(&ps->mtx, "pollset"); + erts_smp_atomic_init(&ps->interrupt, 0); +#endif + erts_smp_atomic_init(&ps->timeout, LONG_MAX); + + HARDTRACEF(("Out erts_poll_create_pollset")); + return ps; +} + +void erts_poll_destroy_pollset(ErtsPollSet ps) +{ + int i; + HARDTRACEF(("In erts_poll_destroy_pollset")); + ERTS_POLLSET_LOCK(ps); + STOP_WAITERS(ps); + for (i=0;inum_waiters;++i) { + Waiter *w = ps->waiter[i]; + void *dummy; + erts_tid_t t = w->this; + /* Assume we're alone, no locking here... */ + w->active_events = w->total_events = w->highwater = 0; + START_WAITER(ps,w); + erts_thr_join(t,&dummy); + CloseHandle(w->go_ahead); + CloseHandle(w->events[0]); + erts_mtx_destroy(&w->mtx); + SEL_FREE(ERTS_ALC_T_WAITER_OBJ, (void *) w); + } + SEL_FREE(ERTS_ALC_T_WAITER_OBJ,ps->waiter); + CloseHandle(ps->event_io_ready); + CloseHandle(ps->standby_wait_event); + ERTS_POLLSET_UNLOCK(ps); +#ifdef ERTS_SMP + erts_smp_mtx_destroy(&ps->mtx); +#endif + SEL_FREE(ERTS_ALC_T_POLLSET, (void *) ps); + HARDTRACEF(("Out erts_poll_destroy_pollset")); +} + +/* + * Actually mostly initializes the friend module sys_interrupt... + */ +void erts_poll_init(void) +{ + erts_tid_t thread; + +#ifdef HARD_POLL_DEBUG + poll_debug_init(); +#endif + + HARDTRACEF(("In erts_poll_init")); + erts_sys_break_event = CreateManualEvent(FALSE); + + erts_mtx_init(&break_waiter_lock,"break_waiter_lock"); + break_happened_event = CreateManualEvent(FALSE); + erts_atomic_init(&break_waiter_state, 0); + + erts_thr_create(&thread, &break_waiter, NULL, NULL); + ERTS_UNSET_BREAK_REQUESTED; + HARDTRACEF(("Out erts_poll_init")); +} + +/* + * Non windows friendly interface, not used when fd's are not continous + */ +void erts_poll_get_selected_events(ErtsPollSet ps, + ErtsPollEvents ev[], + int len) +{ + int i; + HARDTRACEF(("In erts_poll_get_selected_events")); + for (i = 0; i < len; ++i) + ev[i] = 0; + HARDTRACEF(("Out erts_poll_get_selected_events")); +} diff --git a/erts/emulator/sys/win32/erl_win32_sys_ddll.c b/erts/emulator/sys/win32/erl_win32_sys_ddll.c new file mode 100644 index 0000000000..a19f49af10 --- /dev/null +++ b/erts/emulator/sys/win32/erl_win32_sys_ddll.c @@ -0,0 +1,206 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Interface functions to the dynamic linker using dl* functions. + * (As far as I know it works on SunOS 4, 5, Linux and FreeBSD. /Seb) + */ + +#include + +#define GET_ERTS_ALC_TEST +#include "sys.h" +#include "global.h" +#include "erl_alloc.h" + +#include "erl_driver.h" +#include "erl_win_dyn_driver.h" + +#include "erl_nif.h" + +#define EXT_LEN 4 +#define FILE_EXT ".dll" + +static DWORD tls_index = 0; +static TWinDynDriverCallbacks wddc; +static TWinDynNifCallbacks nif_callbacks; + +void erl_sys_ddll_init(void) { + tls_index = TlsAlloc(); + ERL_INIT_CALLBACK_STRUCTURE(wddc); + +#define ERL_NIF_API_FUNC_DECL(RET,NAME,ARGS) nif_callbacks.NAME = NAME +#include "erl_nif_api_funcs.h" +#undef ERL_NIF_API_FUNC_DECL + + return; +} + +/* + * Open a shared object + */ +int erts_sys_ddll_open2(char *full_name, void **handle, ErtsSysDdllError* err) +{ + int len; + char dlname[MAXPATHLEN + 1]; + + if ((len = sys_strlen(full_name)) >= MAXPATHLEN - EXT_LEN) { + if (err != NULL) { + err->str = "Library name too long"; + } + return ERL_DE_LOAD_ERROR_NAME_TO_LONG; + } + sys_strcpy(dlname, full_name); + sys_strcpy(dlname+len, FILE_EXT); + return erts_sys_ddll_open_noext(dlname, handle, err); +} +int erts_sys_ddll_open_noext(char *dlname, void **handle, ErtsSysDdllError* err) +{ + HINSTANCE hinstance; + + if ((hinstance = LoadLibrary(dlname)) == NULL) { + int code = ERL_DE_DYNAMIC_ERROR_OFFSET - GetLastError(); + if (err != NULL) { + err->str = erts_sys_ddll_error(code); + } + return code; + } else { + *handle = (void *) hinstance; + return ERL_DE_NO_ERROR; + } +} + +/* + * Find a symbol in the shared object + */ +int erts_sys_ddll_sym2(void *handle, char *func_name, void **function, + ErtsSysDdllError* err) +{ + FARPROC proc; + if ((proc = GetProcAddress( (HINSTANCE) handle, func_name)) == NULL) { + int code = ERL_DE_DYNAMIC_ERROR_OFFSET - GetLastError(); + if (err != NULL) { + err->str = erts_sys_ddll_error(code); + } + return code; + } + *function = (void *) proc; + return ERL_DE_NO_ERROR; +} + +/* XXX:PaN These two will be changed with new driver interface! */ + +/* + * Load the driver init function, might appear under different names depending on object arch... + */ + +int erts_sys_ddll_load_driver_init(void *handle, void **function) +{ + void *fn; + int res; + if ((res = erts_sys_ddll_sym(handle, "driver_init", &fn)) != ERL_DE_NO_ERROR) { + return res; + } + *function = fn; + return res; +} + +int erts_sys_ddll_load_nif_init(void *handle, void **function, ErtsSysDdllError* err) +{ + void *fn; + int res; + if ((res = erts_sys_ddll_sym2(handle, "nif_init", &fn, err)) != ERL_DE_NO_ERROR) { + return res; + } + *function = fn; + return res; +} + + +/* + * Call the driver_init function, whatever it's really called, simple on unix... +*/ +void *erts_sys_ddll_call_init(void *function) { + void *(*initfn)(TWinDynDriverCallbacks *) = function; + return (*initfn)(&wddc); +} + +void *erts_sys_ddll_call_nif_init(void *function) { + void *(*initfn)(TWinDynNifCallbacks *) = function; + return (*initfn)(&nif_callbacks); +} + + +/* + * Close a chared object + */ +int erts_sys_ddll_close2(void *handle, ErtsSysDdllError* err) +{ + if (!FreeLibrary((HINSTANCE) handle)) { + int code = ERL_DE_DYNAMIC_ERROR_OFFSET - GetLastError(); + if (err != NULL) { + err->str = erts_sys_ddll_error(code); + } + return code; + } + return ERL_DE_NO_ERROR; +} + +/* + * Return string that describes the (current) error + */ +#define MAX_ERROR 255 +char *erts_sys_ddll_error(int code) +{ + int actual_code; + char *local_ptr; + if (code > ERL_DE_DYNAMIC_ERROR_OFFSET) { + return "Unspecified error"; + } + actual_code = -1*(code - ERL_DE_DYNAMIC_ERROR_OFFSET); + + local_ptr = TlsGetValue(tls_index); + if (local_ptr == NULL) { + local_ptr = erts_alloc(ERTS_ALC_T_DDLL_ERRCODES, MAX_ERROR); + TlsSetValue(tls_index,local_ptr); + } + if (!FormatMessage( + FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + (DWORD) actual_code, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + local_ptr, + MAX_ERROR, NULL )) { + return "Unspecified error"; + } else { + char *ptr = local_ptr + strlen(local_ptr) - 1; + while (ptr >= local_ptr && (*ptr == '\r' || *ptr == '\n')) { + *ptr-- = '\0'; + } + } + return local_ptr; +} + +void erts_sys_ddll_free_error(ErtsSysDdllError* err) +{ + /* err->str may be either a static string or reused as thread local data, + * so wo don't bother free it. + */ +} + diff --git a/erts/emulator/sys/win32/erl_win_dyn_driver.h b/erts/emulator/sys/win32/erl_win_dyn_driver.h new file mode 100644 index 0000000000..4949998abc --- /dev/null +++ b/erts/emulator/sys/win32/erl_win_dyn_driver.h @@ -0,0 +1,489 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Include file for erlang driver writers using dynamic drivers on windows. + */ + +/* Maybe this should be auto generated, but I'll leave that for now... */ + +#ifndef _ERL_WIN_DYN_DRIVER_H +#define _ERL_WIN_DYN_DRIVER_H + +#define WDD_FTYPE(FunctionName) TWinDynDriver##FunctionName + +#define WDD_TYPEDEF(RetType, FunctionName, Params) \ + typedef RetType WDD_FTYPE(FunctionName) Params + +WDD_TYPEDEF(int, null_func,(void)); +WDD_TYPEDEF(int, driver_failure_atom,(ErlDrvPort, char *)); +WDD_TYPEDEF(int, driver_failure_posix,(ErlDrvPort, int)); +WDD_TYPEDEF(int, driver_failure,(ErlDrvPort, int)); +WDD_TYPEDEF(int, driver_exit, (ErlDrvPort, int)); +WDD_TYPEDEF(int, driver_failure_eof, (ErlDrvPort)); +WDD_TYPEDEF(int, driver_select, (ErlDrvPort, ErlDrvEvent, int, int)); +WDD_TYPEDEF(int, driver_event, (ErlDrvPort, ErlDrvEvent,ErlDrvEventData)); +WDD_TYPEDEF(int, driver_output, (ErlDrvPort, char *, int)); +WDD_TYPEDEF(int, driver_output2, (ErlDrvPort, char *, int,char *, int)); +WDD_TYPEDEF(int, driver_output_binary, (ErlDrvPort, char *, int,ErlDrvBinary*, int, int)); +WDD_TYPEDEF(int, driver_outputv, (ErlDrvPort, char*, int, ErlIOVec *,int)); +WDD_TYPEDEF(int, driver_vec_to_buf, (ErlIOVec *, char *, int)); +WDD_TYPEDEF(int, driver_set_timer, (ErlDrvPort, unsigned long)); +WDD_TYPEDEF(int, driver_cancel_timer, (ErlDrvPort)); +WDD_TYPEDEF(int, driver_read_timer, (ErlDrvPort, unsigned long *)); +WDD_TYPEDEF(char *, erl_errno_id, (int)); +WDD_TYPEDEF(void, set_busy_port, (ErlDrvPort, int)); +WDD_TYPEDEF(void, set_port_control_flags, (ErlDrvPort, int)); +WDD_TYPEDEF(int, get_port_flags, (ErlDrvPort)); +WDD_TYPEDEF(ErlDrvBinary *, driver_alloc_binary, (int)); +WDD_TYPEDEF(ErlDrvBinary *, driver_realloc_binary, (ErlDrvBinary *, int)); +WDD_TYPEDEF(void, driver_free_binary, (ErlDrvBinary *)); +WDD_TYPEDEF(void *, driver_alloc, (size_t)); +WDD_TYPEDEF(void *, driver_realloc, (void *, size_t)); +WDD_TYPEDEF(void, driver_free, (void *)); +WDD_TYPEDEF(int, driver_enq, (ErlDrvPort, char*, int)); +WDD_TYPEDEF(int, driver_pushq, (ErlDrvPort, char*, int)); +WDD_TYPEDEF(int, driver_deq, (ErlDrvPort, int)); +WDD_TYPEDEF(int, driver_sizeq, (ErlDrvPort)); +WDD_TYPEDEF(int, driver_enq_bin, (ErlDrvPort, ErlDrvBinary *, int,int)); +WDD_TYPEDEF(int, driver_pushq_bin, (ErlDrvPort, ErlDrvBinary *, int,int)); +WDD_TYPEDEF(int, driver_peekqv, (ErlDrvPort, ErlIOVec *)); +WDD_TYPEDEF(SysIOVec *, driver_peekq, (ErlDrvPort, int *)); +WDD_TYPEDEF(int, driver_enqv, (ErlDrvPort, ErlIOVec *, int)); +WDD_TYPEDEF(int, driver_pushqv, (ErlDrvPort, ErlIOVec *, int)); +WDD_TYPEDEF(void, add_driver_entry, (ErlDrvEntry *)); +WDD_TYPEDEF(int, remove_driver_entry, (ErlDrvEntry *)); +WDD_TYPEDEF(ErlDrvTermData, driver_mk_atom, (char*)); +WDD_TYPEDEF(ErlDrvTermData, driver_mk_port,(ErlDrvPort)); +WDD_TYPEDEF(ErlDrvTermData, driver_connected,(ErlDrvPort)); +WDD_TYPEDEF(ErlDrvTermData, driver_caller,(ErlDrvPort)); +WDD_TYPEDEF(ErlDrvTermData, driver_mk_term_nil,(void)); +WDD_TYPEDEF(int, driver_output_term, (ErlDrvPort, ErlDrvTermData*, int)); +WDD_TYPEDEF(int, driver_send_term, (ErlDrvPort, ErlDrvTermData, ErlDrvTermData*, int)); +WDD_TYPEDEF(long, driver_async, (ErlDrvPort,unsigned int*,void (*)(void*),void*,void (*)(void*))); +WDD_TYPEDEF(int, driver_async_cancel, (unsigned int)); +WDD_TYPEDEF(int, driver_lock_driver, (ErlDrvPort)); +WDD_TYPEDEF(void *, driver_dl_open, (char *)); +WDD_TYPEDEF(void *, driver_dl_sym, (void *, char *)); +WDD_TYPEDEF(int, driver_dl_close, (void *)); +WDD_TYPEDEF(char *, driver_dl_error, (void)); +WDD_TYPEDEF(unsigned long, erts_alc_test, (unsigned long, + unsigned long, + unsigned long, + unsigned long)); +WDD_TYPEDEF(long, driver_binary_get_refc, (ErlDrvBinary *dbp)); +WDD_TYPEDEF(long, driver_binary_inc_refc, (ErlDrvBinary *dbp)); +WDD_TYPEDEF(long, driver_binary_dec_refc, (ErlDrvBinary *dbp)); +WDD_TYPEDEF(ErlDrvPDL, driver_pdl_create, (ErlDrvPort)); +WDD_TYPEDEF(void, driver_pdl_lock, (ErlDrvPDL)); +WDD_TYPEDEF(void, driver_pdl_unlock, (ErlDrvPDL)); +WDD_TYPEDEF(long, driver_pdl_get_refc, (ErlDrvPDL)); +WDD_TYPEDEF(long, driver_pdl_inc_refc, (ErlDrvPDL)); +WDD_TYPEDEF(long, driver_pdl_dec_refc, (ErlDrvPDL)); +WDD_TYPEDEF(void, driver_system_info, (ErlDrvSysInfo *, size_t)); +WDD_TYPEDEF(int, driver_get_now, (ErlDrvNowData *)); +WDD_TYPEDEF(int, driver_monitor_process, (ErlDrvPort port, + ErlDrvTermData process, + ErlDrvMonitor *monitor)); +WDD_TYPEDEF(int, driver_demonitor_process, (ErlDrvPort port, + const ErlDrvMonitor *monitor)); +WDD_TYPEDEF(ErlDrvTermData, driver_get_monitored_process, + (ErlDrvPort port, const ErlDrvMonitor *monitor)); +WDD_TYPEDEF(int, driver_compare_monitors, + (const ErlDrvMonitor *, const ErlDrvMonitor *)); +WDD_TYPEDEF(ErlDrvMutex *, erl_drv_mutex_create, (char *name)); +WDD_TYPEDEF(void, erl_drv_mutex_destroy, (ErlDrvMutex *mtx)); +WDD_TYPEDEF(int, erl_drv_mutex_trylock, (ErlDrvMutex *mtx)); +WDD_TYPEDEF(void, erl_drv_mutex_lock, (ErlDrvMutex *mtx)); +WDD_TYPEDEF(void, erl_drv_mutex_unlock, (ErlDrvMutex *mtx)); +WDD_TYPEDEF(ErlDrvCond *, erl_drv_cond_create, (char *name)); +WDD_TYPEDEF(void, erl_drv_cond_destroy, (ErlDrvCond *cnd)); +WDD_TYPEDEF(void, erl_drv_cond_signal, (ErlDrvCond *cnd)); +WDD_TYPEDEF(void, erl_drv_cond_broadcast, (ErlDrvCond *cnd)); +WDD_TYPEDEF(void, erl_drv_cond_wait, (ErlDrvCond *cnd, ErlDrvMutex *mtx)); +WDD_TYPEDEF(ErlDrvRWLock *, erl_drv_rwlock_create, (char *name)); +WDD_TYPEDEF(void, erl_drv_rwlock_destroy, (ErlDrvRWLock *rwlck)); +WDD_TYPEDEF(int, erl_drv_rwlock_tryrlock, (ErlDrvRWLock *rwlck)); +WDD_TYPEDEF(void, erl_drv_rwlock_rlock, (ErlDrvRWLock *rwlck)); +WDD_TYPEDEF(void, erl_drv_rwlock_runlock, (ErlDrvRWLock *rwlck)); +WDD_TYPEDEF(int, erl_drv_rwlock_tryrwlock, (ErlDrvRWLock *rwlck)); +WDD_TYPEDEF(void, erl_drv_rwlock_rwlock, (ErlDrvRWLock *rwlck)); +WDD_TYPEDEF(void, erl_drv_rwlock_rwunlock, (ErlDrvRWLock *rwlck)); +WDD_TYPEDEF(int, erl_drv_tsd_key_create, (char *name, ErlDrvTSDKey *key)); +WDD_TYPEDEF(void, erl_drv_tsd_key_destroy, (ErlDrvTSDKey key)); +WDD_TYPEDEF(void, erl_drv_tsd_set, (ErlDrvTSDKey key, void *data)); +WDD_TYPEDEF(void *, erl_drv_tsd_get, (ErlDrvTSDKey key)); +WDD_TYPEDEF(ErlDrvThreadOpts *, erl_drv_thread_opts_create, (char *name)); +WDD_TYPEDEF(void, erl_drv_thread_opts_destroy, (ErlDrvThreadOpts *opts)); +WDD_TYPEDEF(int, erl_drv_thread_create, (char *name, + ErlDrvTid *tid, + void * (*func)(void *), + void *args, + ErlDrvThreadOpts *opts)); +WDD_TYPEDEF(ErlDrvTid, erl_drv_thread_self, (void)); +WDD_TYPEDEF(int, erl_drv_equal_tids, (ErlDrvTid tid1, ErlDrvTid tid2)); +WDD_TYPEDEF(void, erl_drv_thread_exit, (void *resp)); +WDD_TYPEDEF(int, erl_drv_thread_join, (ErlDrvTid, void **respp)); +WDD_TYPEDEF(int, erl_drv_putenv, (char *key, char *value)); +WDD_TYPEDEF(int, erl_drv_getenv, (char *key, char *value, size_t *value_size)); + +typedef struct { + WDD_FTYPE(null_func) *null_func; + WDD_FTYPE(driver_failure_atom) *driver_failure_atom; + WDD_FTYPE(driver_failure_posix) *driver_failure_posix; + WDD_FTYPE(driver_failure) *driver_failure; + WDD_FTYPE(driver_exit) *driver_exit; + WDD_FTYPE(driver_failure_eof) *driver_failure_eof; + WDD_FTYPE(driver_select) *driver_select; + WDD_FTYPE(driver_event) *driver_event; + WDD_FTYPE(driver_output) *driver_output; + WDD_FTYPE(driver_output2) *driver_output2; + WDD_FTYPE(driver_output_binary) *driver_output_binary; + WDD_FTYPE(driver_outputv) *driver_outputv; + WDD_FTYPE(driver_vec_to_buf) *driver_vec_to_buf; + WDD_FTYPE(driver_set_timer) *driver_set_timer; + WDD_FTYPE(driver_cancel_timer) *driver_cancel_timer; + WDD_FTYPE(driver_read_timer) *driver_read_timer; + WDD_FTYPE(erl_errno_id) *erl_errno_id; + WDD_FTYPE(set_busy_port)* set_busy_port; + WDD_FTYPE(set_port_control_flags) *set_port_control_flags; + WDD_FTYPE(get_port_flags) *get_port_flags; + WDD_FTYPE(driver_alloc_binary) *driver_alloc_binary; + WDD_FTYPE(driver_realloc_binary) *driver_realloc_binary; + WDD_FTYPE(driver_free_binary) *driver_free_binary; + WDD_FTYPE(driver_alloc) *driver_alloc; + WDD_FTYPE(driver_realloc) *driver_realloc; + WDD_FTYPE(driver_free) *driver_free; + WDD_FTYPE(driver_enq) *driver_enq; + WDD_FTYPE(driver_pushq) *driver_pushq; + WDD_FTYPE(driver_deq) *driver_deq; + WDD_FTYPE(driver_sizeq) *driver_sizeq; + WDD_FTYPE(driver_enq_bin)* driver_enq_bin; + WDD_FTYPE(driver_pushq_bin) *driver_pushq_bin; + WDD_FTYPE(driver_peekqv) *driver_peekqv; + WDD_FTYPE(driver_peekq) *driver_peekq; + WDD_FTYPE(driver_enqv) *driver_enqv; + WDD_FTYPE(driver_pushqv) *driver_pushqv; + WDD_FTYPE(add_driver_entry) *add_driver_entry; + WDD_FTYPE(remove_driver_entry) *remove_driver_entry; + WDD_FTYPE(driver_mk_atom) *driver_mk_atom; + WDD_FTYPE(driver_mk_port) *driver_mk_port; + WDD_FTYPE(driver_connected) *driver_connected; + WDD_FTYPE(driver_caller) *driver_caller; + WDD_FTYPE(driver_mk_term_nil) *driver_mk_term_nil; + WDD_FTYPE(driver_output_term) *driver_output_term; + WDD_FTYPE(driver_send_term) *driver_send_term; + WDD_FTYPE(driver_async) *driver_async; + WDD_FTYPE(driver_async_cancel) *driver_async_cancel; + WDD_FTYPE(driver_lock_driver) *driver_lock_driver; + WDD_FTYPE(driver_dl_open) *driver_dl_open; + WDD_FTYPE(driver_dl_sym) *driver_dl_sym; + WDD_FTYPE(driver_dl_close) *driver_dl_close; + WDD_FTYPE(driver_dl_error) *driver_dl_error; + WDD_FTYPE(erts_alc_test) *erts_alc_test; + WDD_FTYPE(driver_binary_get_refc) *driver_binary_get_refc; + WDD_FTYPE(driver_binary_inc_refc) *driver_binary_inc_refc; + WDD_FTYPE(driver_binary_dec_refc) *driver_binary_dec_refc; + WDD_FTYPE(driver_pdl_create) *driver_pdl_create; + WDD_FTYPE(driver_pdl_lock) *driver_pdl_lock; + WDD_FTYPE(driver_pdl_unlock) *driver_pdl_unlock; + WDD_FTYPE(driver_pdl_get_refc) *driver_pdl_get_refc; + WDD_FTYPE(driver_pdl_inc_refc) *driver_pdl_inc_refc; + WDD_FTYPE(driver_pdl_dec_refc) *driver_pdl_dec_refc; + WDD_FTYPE(driver_system_info) *driver_system_info; + WDD_FTYPE(driver_get_now) *driver_get_now; + WDD_FTYPE(driver_monitor_process) *driver_monitor_process; + WDD_FTYPE(driver_demonitor_process) *driver_demonitor_process; + WDD_FTYPE(driver_get_monitored_process) *driver_get_monitored_process; + WDD_FTYPE(driver_compare_monitors) *driver_compare_monitors; + WDD_FTYPE(erl_drv_mutex_create) *erl_drv_mutex_create; + WDD_FTYPE(erl_drv_mutex_destroy) *erl_drv_mutex_destroy; + WDD_FTYPE(erl_drv_mutex_trylock) *erl_drv_mutex_trylock; + WDD_FTYPE(erl_drv_mutex_lock) *erl_drv_mutex_lock; + WDD_FTYPE(erl_drv_mutex_unlock) *erl_drv_mutex_unlock; + WDD_FTYPE(erl_drv_cond_create) *erl_drv_cond_create; + WDD_FTYPE(erl_drv_cond_destroy) *erl_drv_cond_destroy; + WDD_FTYPE(erl_drv_cond_signal) *erl_drv_cond_signal; + WDD_FTYPE(erl_drv_cond_broadcast) *erl_drv_cond_broadcast; + WDD_FTYPE(erl_drv_cond_wait) *erl_drv_cond_wait; + WDD_FTYPE(erl_drv_rwlock_create) *erl_drv_rwlock_create; + WDD_FTYPE(erl_drv_rwlock_destroy) *erl_drv_rwlock_destroy; + WDD_FTYPE(erl_drv_rwlock_tryrlock) *erl_drv_rwlock_tryrlock; + WDD_FTYPE(erl_drv_rwlock_rlock) *erl_drv_rwlock_rlock; + WDD_FTYPE(erl_drv_rwlock_runlock) *erl_drv_rwlock_runlock; + WDD_FTYPE(erl_drv_rwlock_tryrwlock) *erl_drv_rwlock_tryrwlock; + WDD_FTYPE(erl_drv_rwlock_rwlock) *erl_drv_rwlock_rwlock; + WDD_FTYPE(erl_drv_rwlock_rwunlock) *erl_drv_rwlock_rwunlock; + WDD_FTYPE(erl_drv_tsd_key_create) *erl_drv_tsd_key_create; + WDD_FTYPE(erl_drv_tsd_key_destroy) *erl_drv_tsd_key_destroy; + WDD_FTYPE(erl_drv_tsd_set) *erl_drv_tsd_set; + WDD_FTYPE(erl_drv_tsd_get) *erl_drv_tsd_get; + WDD_FTYPE(erl_drv_thread_opts_create) *erl_drv_thread_opts_create; + WDD_FTYPE(erl_drv_thread_opts_destroy) *erl_drv_thread_opts_destroy; + WDD_FTYPE(erl_drv_thread_create) *erl_drv_thread_create; + WDD_FTYPE(erl_drv_thread_self) *erl_drv_thread_self; + WDD_FTYPE(erl_drv_equal_tids) *erl_drv_equal_tids; + WDD_FTYPE(erl_drv_thread_exit) *erl_drv_thread_exit; + WDD_FTYPE(erl_drv_thread_join) *erl_drv_thread_join; + WDD_FTYPE(erl_drv_putenv) *erl_drv_putenv; + WDD_FTYPE(erl_drv_getenv) *erl_drv_getenv; + /* Add new calls here */ +} TWinDynDriverCallbacks; + +/* This header is included explicitly by the ddll static driver, it musn't define things then */ +#ifndef STATIC_ERLANG_DRIVER + +extern TWinDynDriverCallbacks WinDynDriverCallbacks; + +#define null_func (WinDynDriverCallbacks.null_func) +#define driver_failure_atom (WinDynDriverCallbacks.driver_failure_atom) +#define driver_failure_posix (WinDynDriverCallbacks.driver_failure_posix) +#define driver_failure (WinDynDriverCallbacks.driver_failure) +#define driver_exit (WinDynDriverCallbacks.driver_exit) +#define driver_failure_eof (WinDynDriverCallbacks.driver_failure_eof) +#define driver_select (WinDynDriverCallbacks.driver_select) +#define driver_event (WinDynDriverCallbacks.driver_event) +#define driver_output (WinDynDriverCallbacks.driver_output) +#define driver_output2 (WinDynDriverCallbacks.driver_output2) +#define driver_output_binary (WinDynDriverCallbacks.driver_output_binary) +#define driver_outputv (WinDynDriverCallbacks.driver_outputv) +#define driver_vec_to_buf (WinDynDriverCallbacks.driver_vec_to_buf) +#define driver_set_timer (WinDynDriverCallbacks.driver_set_timer) +#define driver_cancel_timer (WinDynDriverCallbacks.driver_cancel_timer) +#define driver_read_timer (WinDynDriverCallbacks.driver_read_timer) +#define erl_errno_id (WinDynDriverCallbacks.erl_errno_id) +#define set_busy_port (WinDynDriverCallbacks.set_busy_port) +#define set_port_control_flags (WinDynDriverCallbacks.set_port_control_flags) +#define get_port_flags (WinDynDriverCallbacks.get_port_flags) +#define driver_alloc_binary (WinDynDriverCallbacks.driver_alloc_binary) +#define driver_realloc_binary (WinDynDriverCallbacks.driver_realloc_binary) +#define driver_free_binary (WinDynDriverCallbacks.driver_free_binary) +#define driver_alloc (WinDynDriverCallbacks.driver_alloc) +#define driver_realloc (WinDynDriverCallbacks.driver_realloc) +#define driver_free (WinDynDriverCallbacks.driver_free) +#define driver_enq (WinDynDriverCallbacks.driver_enq) +#define driver_pushq (WinDynDriverCallbacks.driver_pushq) +#define driver_deq (WinDynDriverCallbacks.driver_deq) +#define driver_sizeq (WinDynDriverCallbacks.driver_sizeq) +#define driver_enq_bin (WinDynDriverCallbacks.driver_enq_bin) +#define driver_pushq_bin (WinDynDriverCallbacks.driver_pushq_bin) +#define driver_peekqv (WinDynDriverCallbacks.driver_peekqv) +#define driver_peekq (WinDynDriverCallbacks.driver_peekq) +#define driver_enqv (WinDynDriverCallbacks.driver_enqv) +#define driver_pushqv (WinDynDriverCallbacks.driver_pushqv) +#define add_driver_entry (WinDynDriverCallbacks.add_driver_entry) +#define remove_driver_entry (WinDynDriverCallbacks.remove_driver_entry) +#define driver_mk_atom (WinDynDriverCallbacks.driver_mk_atom) +#define driver_mk_port (WinDynDriverCallbacks.driver_mk_port) +#define driver_connected (WinDynDriverCallbacks.driver_connected) +#define driver_caller (WinDynDriverCallbacks.driver_caller) +#define driver_mk_term_nil (WinDynDriverCallbacks.driver_mk_term_nil) +#define driver_output_term (WinDynDriverCallbacks.driver_output_term) +#define driver_send_term (WinDynDriverCallbacks.driver_send_term) +#define driver_async (WinDynDriverCallbacks.driver_async) +#define driver_async_cancel (WinDynDriverCallbacks.driver_async_cancel) +#define driver_lock_driver (WinDynDriverCallbacks.driver_lock_driver) +#define driver_dl_open (WinDynDriverCallbacks.driver_dl_open) +#define driver_dl_sym (WinDynDriverCallbacks.driver_dl_sym) +#define driver_dl_close (WinDynDriverCallbacks.driver_dl_close) +#define driver_dl_error (WinDynDriverCallbacks.driver_dl_error) +#define erts_alc_test (WinDynDriverCallbacks.erts_alc_test) +#define driver_binary_get_refc (WinDynDriverCallbacks.driver_binary_get_refc) +#define driver_binary_inc_refc (WinDynDriverCallbacks.driver_binary_inc_refc) +#define driver_binary_dec_refc (WinDynDriverCallbacks.driver_binary_dec_refc) +#define driver_pdl_create (WinDynDriverCallbacks.driver_pdl_create) +#define driver_pdl_lock (WinDynDriverCallbacks.driver_pdl_lock) +#define driver_pdl_unlock (WinDynDriverCallbacks.driver_pdl_unlock) +#define driver_pdl_get_refc (WinDynDriverCallbacks.driver_pdl_get_refc) +#define driver_pdl_inc_refc (WinDynDriverCallbacks.driver_pdl_inc_refc) +#define driver_pdl_dec_refc (WinDynDriverCallbacks.driver_pdl_dec_refc) +#define driver_system_info (WinDynDriverCallbacks.driver_system_info) +#define driver_get_now (WinDynDriverCallbacks.driver_get_now) +#define driver_monitor_process \ +(WinDynDriverCallbacks.driver_monitor_process) +#define driver_demonitor_process \ +(WinDynDriverCallbacks.driver_demonitor_process) +#define driver_get_monitored_process \ +(WinDynDriverCallbacks.driver_get_monitored_process) +#define driver_compare_monitors \ +(WinDynDriverCallbacks.driver_compare_monitors) +#define erl_drv_mutex_create (WinDynDriverCallbacks.erl_drv_mutex_create) +#define erl_drv_mutex_destroy (WinDynDriverCallbacks.erl_drv_mutex_destroy) +#define erl_drv_mutex_trylock (WinDynDriverCallbacks.erl_drv_mutex_trylock) +#define erl_drv_mutex_lock (WinDynDriverCallbacks.erl_drv_mutex_lock) +#define erl_drv_mutex_unlock (WinDynDriverCallbacks.erl_drv_mutex_unlock) +#define erl_drv_cond_create (WinDynDriverCallbacks.erl_drv_cond_create) +#define erl_drv_cond_destroy (WinDynDriverCallbacks.erl_drv_cond_destroy) +#define erl_drv_cond_signal (WinDynDriverCallbacks.erl_drv_cond_signal) +#define erl_drv_cond_broadcast (WinDynDriverCallbacks.erl_drv_cond_broadcast) +#define erl_drv_cond_wait (WinDynDriverCallbacks.erl_drv_cond_wait) +#define erl_drv_rwlock_create (WinDynDriverCallbacks.erl_drv_rwlock_create) +#define erl_drv_rwlock_destroy (WinDynDriverCallbacks.erl_drv_rwlock_destroy) +#define erl_drv_rwlock_tryrlock (WinDynDriverCallbacks.erl_drv_rwlock_tryrlock) +#define erl_drv_rwlock_rlock (WinDynDriverCallbacks.erl_drv_rwlock_rlock) +#define erl_drv_rwlock_runlock (WinDynDriverCallbacks.erl_drv_rwlock_runlock) +#define erl_drv_rwlock_tryrwlock \ +(WinDynDriverCallbacks.erl_drv_rwlock_tryrwlock) +#define erl_drv_rwlock_rwlock (WinDynDriverCallbacks.erl_drv_rwlock_rwlock) +#define erl_drv_rwlock_rwunlock (WinDynDriverCallbacks.erl_drv_rwlock_rwunlock) +#define erl_drv_tsd_key_create (WinDynDriverCallbacks.erl_drv_tsd_key_create) +#define erl_drv_tsd_key_destroy (WinDynDriverCallbacks.erl_drv_tsd_key_destroy) +#define erl_drv_tsd_set (WinDynDriverCallbacks.erl_drv_tsd_set) +#define erl_drv_tsd_get (WinDynDriverCallbacks.erl_drv_tsd_get) +#define erl_drv_thread_opts_create \ +(WinDynDriverCallbacks.erl_drv_thread_opts_create) +#define erl_drv_thread_opts_destroy \ +(WinDynDriverCallbacks.erl_drv_thread_opts_destroy) +#define erl_drv_thread_create (WinDynDriverCallbacks.erl_drv_thread_create) +#define erl_drv_thread_self (WinDynDriverCallbacks.erl_drv_thread_self) +#define erl_drv_equal_tids (WinDynDriverCallbacks.erl_drv_equal_tids) +#define erl_drv_thread_exit (WinDynDriverCallbacks.erl_drv_thread_exit) +#define erl_drv_thread_join (WinDynDriverCallbacks.erl_drv_thread_join) +#define erl_drv_putenv (WinDynDriverCallbacks.erl_drv_putenv) +#define erl_drv_getenv (WinDynDriverCallbacks.erl_drv_getenv) + +/* The only variable in the interface... */ +#define driver_term_nil (driver_mk_term_nil()) + +#include +#include + +#define DRIVER_INIT(DriverName) \ +ErlDrvEntry *erl_dyndriver_real_driver_init(void); \ +TWinDynDriverCallbacks WinDynDriverCallbacks; \ +__declspec(dllexport) ErlDrvEntry *driver_init(TWinDynDriverCallbacks *callbacks) \ +{ \ + memcpy(&WinDynDriverCallbacks,callbacks,sizeof(TWinDynDriverCallbacks)); \ + return erl_dyndriver_real_driver_init(); \ +} \ +ErlDrvEntry *erl_dyndriver_real_driver_init(void) + +/* This is to make erl_driver.h avoid changing what's done here */ +#define ERL_DRIVER_TYPES_ONLY + +#else /* defined(STATIC_ERLANG_DRIVER) */ +/* This is for the ddll driver */ + +#define ERL_INIT_CALLBACK_STRUCTURE(W) \ +do { \ +((W).null_func) = null_func; \ +((W).driver_failure_atom) = driver_failure_atom; \ +((W).driver_failure_posix) = driver_failure_posix; \ +((W).driver_failure) = driver_failure; \ +((W).driver_exit) = driver_exit; \ +((W).driver_failure_eof) = driver_failure_eof; \ +((W).driver_select) = driver_select; \ +((W).driver_event) = driver_event; \ +((W).driver_output) = driver_output; \ +((W).driver_output2) = driver_output2; \ +((W).driver_output_binary) = driver_output_binary; \ +((W).driver_outputv) = driver_outputv; \ +((W).driver_vec_to_buf) = driver_vec_to_buf; \ +((W).driver_set_timer) = driver_set_timer; \ +((W).driver_cancel_timer) = driver_cancel_timer; \ +((W).driver_read_timer) = driver_read_timer; \ +((W).erl_errno_id) = erl_errno_id; \ +((W).set_busy_port) = set_busy_port; \ +((W).set_port_control_flags) = set_port_control_flags; \ +((W).get_port_flags) = get_port_flags; \ +((W).driver_alloc_binary) = driver_alloc_binary; \ +((W).driver_realloc_binary) = driver_realloc_binary; \ +((W).driver_free_binary) = driver_free_binary; \ +((W).driver_alloc) = driver_alloc; \ +((W).driver_realloc) = driver_realloc; \ +((W).driver_free) = driver_free; \ +((W).driver_enq) = driver_enq; \ +((W).driver_pushq) = driver_pushq; \ +((W).driver_deq) = driver_deq; \ +((W).driver_sizeq) = driver_sizeq; \ +((W).driver_enq_bin) = driver_enq_bin; \ +((W).driver_pushq_bin) = driver_pushq_bin; \ +((W).driver_peekqv) = driver_peekqv; \ +((W).driver_peekq) = driver_peekq; \ +((W).driver_enqv) = driver_enqv; \ +((W).driver_pushqv) = driver_pushqv; \ +((W).add_driver_entry) = add_driver_entry; \ +((W).remove_driver_entry) = remove_driver_entry; \ +((W).driver_mk_atom) = driver_mk_atom; \ +((W).driver_mk_port) = driver_mk_port; \ +((W).driver_connected) = driver_connected; \ +((W).driver_caller) = driver_caller; \ +((W).driver_mk_term_nil) = driver_mk_term_nil; \ +((W).driver_output_term) = driver_output_term; \ +((W).driver_send_term) = driver_send_term; \ +((W).driver_async) = driver_async; \ +((W).driver_async_cancel) = driver_async_cancel; \ +((W).driver_lock_driver) = driver_lock_driver; \ +((W).driver_dl_open) = driver_dl_open; \ +((W).driver_dl_sym) = driver_dl_sym; \ +((W).driver_dl_close) = driver_dl_close; \ +((W).driver_dl_error) = driver_dl_error; \ +((W).erts_alc_test) = erts_alc_test; \ +((W).driver_binary_get_refc) = driver_binary_get_refc; \ +((W).driver_binary_inc_refc) = driver_binary_inc_refc; \ +((W).driver_binary_dec_refc) = driver_binary_dec_refc; \ +((W).driver_pdl_create) = driver_pdl_create; \ +((W).driver_pdl_lock) = driver_pdl_lock; \ +((W).driver_pdl_unlock) = driver_pdl_unlock; \ +((W).driver_pdl_get_refc) = driver_pdl_get_refc; \ +((W).driver_pdl_inc_refc) = driver_pdl_inc_refc; \ +((W).driver_pdl_dec_refc) = driver_pdl_dec_refc; \ +((W).driver_system_info) = driver_system_info; \ +((W).driver_get_now) = driver_get_now; \ +((W).driver_monitor_process) = driver_monitor_process; \ +((W).driver_demonitor_process) = driver_demonitor_process; \ +((W).driver_get_monitored_process) = driver_get_monitored_process; \ +((W).driver_compare_monitors) = driver_compare_monitors;\ +((W).erl_drv_mutex_create) = erl_drv_mutex_create; \ +((W).erl_drv_mutex_destroy) = erl_drv_mutex_destroy; \ +((W).erl_drv_mutex_trylock) = erl_drv_mutex_trylock; \ +((W).erl_drv_mutex_lock) = erl_drv_mutex_lock; \ +((W).erl_drv_mutex_unlock) = erl_drv_mutex_unlock; \ +((W).erl_drv_cond_create) = erl_drv_cond_create; \ +((W).erl_drv_cond_destroy) = erl_drv_cond_destroy; \ +((W).erl_drv_cond_signal) = erl_drv_cond_signal; \ +((W).erl_drv_cond_broadcast) = erl_drv_cond_broadcast; \ +((W).erl_drv_cond_wait) = erl_drv_cond_wait; \ +((W).erl_drv_rwlock_create) = erl_drv_rwlock_create; \ +((W).erl_drv_rwlock_destroy) = erl_drv_rwlock_destroy; \ +((W).erl_drv_rwlock_tryrlock) = erl_drv_rwlock_tryrlock;\ +((W).erl_drv_rwlock_rlock) = erl_drv_rwlock_rlock; \ +((W).erl_drv_rwlock_runlock) = erl_drv_rwlock_runlock; \ +((W).erl_drv_rwlock_tryrwlock) = erl_drv_rwlock_tryrwlock;\ +((W).erl_drv_rwlock_rwlock) = erl_drv_rwlock_rwlock; \ +((W).erl_drv_rwlock_rwunlock) = erl_drv_rwlock_rwunlock;\ +((W).erl_drv_tsd_key_create) = erl_drv_tsd_key_create; \ +((W).erl_drv_tsd_key_destroy) = erl_drv_tsd_key_destroy;\ +((W).erl_drv_tsd_set) = erl_drv_tsd_set; \ +((W).erl_drv_tsd_get) = erl_drv_tsd_get; \ +((W).erl_drv_thread_opts_create) = erl_drv_thread_opts_create;\ +((W).erl_drv_thread_opts_destroy) = erl_drv_thread_opts_destroy;\ +((W).erl_drv_thread_create) = erl_drv_thread_create; \ +((W).erl_drv_thread_self) = erl_drv_thread_self; \ +((W).erl_drv_equal_tids) = erl_drv_equal_tids; \ +((W).erl_drv_thread_exit) = erl_drv_thread_exit; \ +((W).erl_drv_thread_join) = erl_drv_thread_join; \ +((W).erl_drv_putenv) = erl_drv_putenv; \ +((W).erl_drv_getenv) = erl_drv_getenv; \ +} while (0) + + + +#endif /* STATIC_ERLANG_DRIVER */ +#endif /* _ERL_WIN_DYN_DRIVER_H */ diff --git a/erts/emulator/sys/win32/erl_win_sys.h b/erts/emulator/sys/win32/erl_win_sys.h new file mode 100644 index 0000000000..92d8577537 --- /dev/null +++ b/erts/emulator/sys/win32/erl_win_sys.h @@ -0,0 +1,212 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * This file handles differences between operating systems. + * This should be the only place with conditional compilation + * depending on the type of OS. + */ + +#ifndef _ERL_WIN_SYS_H +#define _ERL_WIN_SYS_H + +#define HAS_STDARG + +#ifdef __GNUC__ +#ifdef pid_t +/* Really... */ +#undef pid_t +#endif +#endif +#include +#include +#include +#include +#include +#include +#include +#include +#ifndef __GNUC__ +#include +#endif +#include "erl_errno.h" +#include +#include +#include +#include +#include +#include +#pragma comment(linker,"/manifestdependency:\"type='win32' "\ + "name='Microsoft.Windows.Common-Controls' "\ + "version='6.0.0.0' processorArchitecture='*' "\ + "publicKeyToken='6595b64144ccf1df' language='*'\"") + +#define WIN32_LEAN_AND_MEAN +#include +#undef WIN32_LEAN_AND_MEAN + +/* + * Define MAXPATHLEN in terms of MAXPATH if available. + */ + +#ifndef MAXPATH +#define MAXPATH MAX_PATH +#endif /* MAXPATH */ + +#ifndef MAXPATHLEN +#define MAXPATHLEN MAXPATH +#endif /* MAXPATHLEN */ + +/* + * Various configuration options, used to be in the Makefile. + */ + +#define NO_ASINH +#define NO_ACOSH +#define NO_ATANH +#define NO_ERF +#define NO_ERFC + +#define NO_SYSLOG +#define NO_SYSCONF +#define NO_DAEMON +#define NO_PWD +/*#define HAVE_MEMMOVE*/ + +#define strncasecmp _strnicmp + +/* + * Practial Windows specific macros. + */ + +#define CreateAutoEvent(state) CreateEvent(NULL, FALSE, state, NULL) +#define CreateManualEvent(state) CreateEvent(NULL, TRUE, state, NULL) + + +/* + * Our own type of "FD's" + */ +#define ERTS_SYS_FD_TYPE HANDLE +#define NO_FSTAT_ON_SYS_FD_TYPE 1 /* They are events, not files */ + +#define HAVE_ERTS_CHECK_IO_DEBUG +int erts_check_io_debug(void); + +/* + * For erl_time_sup + */ +#define HAVE_GETHRTIME + +#define sys_init_hrtime() /* Nothing */ + +#define SYS_CLK_TCK 1000 +#define SYS_CLOCK_RESOLUTION 1 + +typedef struct { + long tv_sec; + long tv_usec; +} SysTimeval; + +typedef struct { + clock_t tms_utime; + clock_t tms_stime; + clock_t tms_cutime; + clock_t tms_cstime; +} SysTimes; + +#define HAVE_INT64 1 +#if defined (__GNUC__) +typedef unsigned long long Uint64; +typedef long long Sint64; + +typedef long long SysHrTime; +#else +typedef ULONGLONG Uint64; +typedef LONGLONG Sint64; + +typedef LONGLONG SysHrTime; +#endif + +extern int sys_init_time(void); +extern void sys_gettimeofday(SysTimeval *tv); +extern SysHrTime sys_gethrtime(void); +extern clock_t sys_times(SysTimes *buffer); + +extern char *win_build_environment(char *); + +typedef struct { + char *environment_strings; + char *next_string; +} GETENV_STATE; + +void erts_sys_env_init(void); + +/* + ** These are to avoid irritating warnings + */ +#pragma warning(disable : 4244) +#pragma warning(disable : 4018) + +/* + * Floating point support. + */ + +extern volatile int erl_fp_exception; + +#include +#if defined (__GNUC__) +int _finite(double x); +#endif +#endif + +/*#define NO_FPE_SIGNALS*/ +#define erts_get_current_fp_exception() NULL +#define __ERTS_FP_CHECK_INIT(fpexnp) do {} while (0) +#define __ERTS_FP_ERROR(fpexnp, f, Action) if (!_finite(f)) { Action; } else {} +#define __ERTS_FP_ERROR_THOROUGH(fpexnp, f, Action) __ERTS_FP_ERROR(fpexnp, f, Action) +#define __ERTS_SAVE_FP_EXCEPTION(fpexnp) +#define __ERTS_RESTORE_FP_EXCEPTION(fpexnp) + +#define ERTS_FP_CHECK_INIT(p) __ERTS_FP_CHECK_INIT(&(p)->fp_exception) +#define ERTS_FP_ERROR(p, f, A) __ERTS_FP_ERROR(&(p)->fp_exception, f, A) +#define ERTS_SAVE_FP_EXCEPTION(p) __ERTS_SAVE_FP_EXCEPTION(&(p)->fp_exception) +#define ERTS_RESTORE_FP_EXCEPTION(p) __ERTS_RESTORE_FP_EXCEPTION(&(p)->fp_exception) +#define ERTS_FP_ERROR_THOROUGH(p, f, A) __ERTS_FP_ERROR_THOROUGH(&(p)->fp_exception, f, A) + +#define erts_sys_block_fpe() 0 +#define erts_sys_unblock_fpe(x) do{}while(0) + +#define SIZEOF_SHORT 2 +#define SIZEOF_INT 4 +#define SIZEOF_LONG 4 +#define SIZEOF_VOID_P 4 +#define SIZEOF_SIZE_T 4 +#define SIZEOF_OFF_T 4 + +/* + * Seems to be missing. + */ +#ifndef __GNUC__ +typedef long ssize_t; +#endif + +/* Threads */ +#ifdef USE_THREADS +int init_async(int); +int exit_async(void); +#endif diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c new file mode 100644 index 0000000000..3194493ac8 --- /dev/null +++ b/erts/emulator/sys/win32/sys.c @@ -0,0 +1,3093 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * system-dependent functions + * + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_alloc.h" +#include "erl_sys_driver.h" +#include "global.h" +#include "erl_threads.h" +#include "../../drivers/win32/win_con.h" + + +void erts_sys_init_float(void); + +void erl_start(int, char**); +void erl_exit(int n, char*, _DOTS_); +void erl_error(char*, va_list); +void erl_crash_dump(char*, int, char*, ...); + +/* + * Microsoft-specific function to map a WIN32 error code to a Posix errno. + */ +extern void _dosmaperr(DWORD); + +#ifdef ERL_RUN_SHARED_LIB +#ifdef __argc +#undef __argc +#endif +#define __argc e_argc +#ifdef __argv +#undef __argv +#endif +#define __argv e_argv +#endif + +static void init_console(); +static int get_and_remove_option(int* argc, char** argv, const char* option); +static char *get_and_remove_option2(int *argc, char **argv, + const char *option); +static int init_async_io(struct async_io* aio, int use_threads); +static void release_async_io(struct async_io* aio, ErlDrvPort); +static void async_read_file(struct async_io* aio, LPVOID buf, DWORD numToRead); +static int async_write_file(struct async_io* aio, LPVOID buf, DWORD numToWrite); +static int get_overlapped_result(struct async_io* aio, + LPDWORD pBytesRead, BOOL wait); +static FUNCTION(BOOL, CreateChildProcess, (char *, HANDLE, HANDLE, + HANDLE, LPHANDLE, BOOL, + LPVOID, LPTSTR, unsigned, + char **, int *)); +static int create_pipe(LPHANDLE, LPHANDLE, BOOL, BOOL); +static int ApplicationType(const char* originalName, char fullPath[MAX_PATH], + BOOL search_in_path, BOOL handle_quotes, + int *error_return); + +HANDLE erts_service_event; + +#ifdef ERTS_SMP +static erts_smp_tsd_key_t win32_errstr_key; +#endif + +static erts_smp_atomic_t pipe_creation_counter; + +static erts_smp_mtx_t sys_driver_data_lock; + + +/* Results from ApplicationType is one of */ +#define APPL_NONE 0 +#define APPL_DOS 1 +#define APPL_WIN3X 2 +#define APPL_WIN32 3 + +static FUNCTION(int, driver_write, (long, HANDLE, byte*, int)); +static void common_stop(int); +static int create_file_thread(struct async_io* aio, int mode); +static DWORD WINAPI threaded_reader(LPVOID param); +static DWORD WINAPI threaded_writer(LPVOID param); +static DWORD WINAPI threaded_exiter(LPVOID param); + +#ifdef DEBUG +static void debug_console(void); +#endif + +BOOL WINAPI ctrl_handler(DWORD dwCtrlType); + +#define PORT_BUFSIZ 4096 + +#define PORT_FREE (-1) +#define PORT_EXITING (-2) + +#define DRV_BUF_ALLOC(SZ) \ + erts_alloc_fnf(ERTS_ALC_T_DRV_DATA_BUF, (SZ)) +#define DRV_BUF_REALLOC(P, SZ) \ + erts_realloc_fnf(ERTS_ALC_T_DRV_DATA_BUF, (P), (SZ)) +#define DRV_BUF_FREE(P) \ + erts_free(ERTS_ALC_T_DRV_DATA_BUF, (P)) + +/********************* General functions ****************************/ + +/* + * Whether create_pipe() should use a named pipe or an anonymous. + * (Named pipes are not supported on Windows 95.) + */ + +static int max_files = 1024; + +static BOOL use_named_pipes; +static BOOL win_console = FALSE; + + +static OSVERSIONINFO int_os_version; /* Version information for Win32. */ + + +/* This is the system's main function (which may or may not be called "main") + - do general system-dependent initialization + - call erl_start() to parse arguments and do other init +*/ + +static erts_smp_atomic_t sys_misc_mem_sz; + +HMODULE beam_module = NULL; + +void erl_sys_init(); + +void erl_sys_args(int* argc, char** argv); + +int nohup; +#ifndef __GNUC__ +void erts_sys_invalid_parameter_handler(const wchar_t * expression, + const wchar_t * function, + const wchar_t * file, + unsigned int line, + uintptr_t pReserved + ) +{ +#ifdef DEBUG + fprintf(stderr, + "Debug: Invalid parameter\"%ls\" " + "(detected in \"%ls\" [%ls:%d]) \n", + (expression) ? expression : L"(unknown)", + (function) ? function : L"(unknown)", + (file) ? file : L"(unknown)", + line); +#endif + return; +} +#endif + +void sys_primitive_init(HMODULE beam) +{ +#ifndef __GNUC__ + /* Initialize this module handle (the beam.dll module handle) and + take care of the standard library's aggressive invalid parameter + handling... */ + _set_invalid_parameter_handler(&erts_sys_invalid_parameter_handler); +#endif + beam_module = (HMODULE) beam; +} + +Uint +erts_sys_misc_mem_sz(void) +{ + Uint res = (Uint) erts_check_io_size(); + res += (Uint) erts_smp_atomic_read(&sys_misc_mem_sz); + return res; +} + +void erl_sys_args(int* argc, char** argv) +{ + char *event_name; + nohup = get_and_remove_option(argc, argv, "-nohup"); + +#ifdef DEBUG + /* + * Start a debug console if -console option given. + */ + + if (get_and_remove_option(argc, argv, "-console")) { + debug_console(); + } +#endif + + if (nohup && (event_name = get_and_remove_option2(argc, argv, + "-service_event"))) { + if ((erts_service_event = + OpenEvent(EVENT_ALL_ACCESS,FALSE,event_name)) == NULL) { + erts_fprintf(stderr, + "Warning: could not open service event: %s\r\n", + event_name); + } + } else { + erts_service_event = NULL; + } + +#ifdef DEBUG + /* + * Given the "-threads" option, always use threads instead of + * named pipes. + */ + + if (get_and_remove_option(argc, argv, "-threads")) { + use_named_pipes = FALSE; + } +#endif +} + +void +erts_sys_prepare_crash_dump(void) +{ + /* Windows - free file descriptors are hopefully available */ + return; +} + +static void +init_console() +{ + char* mode = erts_read_env("ERL_CONSOLE_MODE"); + + if (!mode || strcmp(mode, "window") == 0) { + win_console = TRUE; + ConInit(); + /*nohup = 0;*/ + } else if (strncmp(mode, "tty:", 4) == 0) { + if (mode[5] == 'c') { + setvbuf(stdout, NULL, _IONBF, 0); + } + if (mode[6] == 'c') { + setvbuf(stderr, NULL, _IONBF, 0); + } + } + + erts_free_read_env(mode); +} + +int sys_max_files() +{ + return max_files; +} + +/* + * Looks for the given option in the argv vector. If it is found, + * it will be removed from the argv vector. + * + * If the return value indicates that the option was found and removed, + * it is the responsibility of the caller to decrement the value of argc. + * + * Returns: 0 if the option wasn't found, 1 if it was found + */ + +static int +get_and_remove_option(argc, argv, option) + int* argc; /* Number of arguments. */ + char* argv[]; /* The argument vector. */ + const char* option; /* Option to search for and remove. */ +{ + int i; + + for (i = 1; i < *argc; i++) { + if (strcmp(argv[i], option) == 0) { + (*argc)--; + while (i < *argc) { + argv[i] = argv[i+1]; + i++; + } + argv[i] = NULL; + return 1; + } + } + return 0; +} + +static char *get_and_remove_option2(int *argc, char **argv, + const char *option) +{ + char *ret; + int i; + + for (i = 1; i < *argc; i++) { + if (strcmp(argv[i], option) == 0) { + if (i+1 < *argc) { + ret = argv[i+1]; + (*argc) -= 2; + while (i < *argc) { + argv[i] = argv[i+2]; + i++; + } + argv[i] = NULL; + return ret; + } + } + } + return NULL; +} + + +/************************** OS info *******************************/ + +/* Used by erlang:info/1. */ +/* (This code was formerly in drv.XXX/XXX_os_drv.c) */ + +char os_type[] = "win32"; + +void +os_flavor(namebuf, size) +char* namebuf; /* Where to return the name. */ +unsigned size; /* Size of name buffer. */ +{ + switch (int_os_version.dwPlatformId) { + case VER_PLATFORM_WIN32_WINDOWS: + strcpy(namebuf, "windows"); + break; + case VER_PLATFORM_WIN32_NT: + strcpy(namebuf, "nt"); + break; + default: /* Can't happen. */ + strcpy(namebuf, "unknown"); + break; + } +} + +void +os_version(pMajor, pMinor, pBuild) +int* pMajor; /* Pointer to major version. */ +int* pMinor; /* Pointer to minor version. */ +int* pBuild; /* Pointer to build number. */ +{ + *pMajor = int_os_version.dwMajorVersion; + *pMinor = int_os_version.dwMinorVersion; + *pBuild = int_os_version.dwBuildNumber; +} + +/************************** Port I/O *******************************/ + +/* I. Common stuff */ + +/* II. The spawn/fd/vanilla drivers */ + +/* + * Definitions for driver flags. + */ + +#define DF_OVR_READY 1 /* Overlapped result is ready. */ +#define DF_EXIT_THREAD 2 /* The thread should exit. */ +#define DF_XLAT_CR 4 /* The thread should translate CRs. */ +#define DF_DROP_IF_INVH 8 /* Drop packages instead of crash if + invalid handle (stderr) */ + +#define OV_BUFFER_PTR(dp) ((LPVOID) ((dp)->ov.Internal)) +#define OV_NUM_TO_READ(dp) ((dp)->ov.InternalHigh) + +/* + * This data is used to make overlapped I/O operations work on both + * Windows NT (using true overlapped I/O) and Windows 95 (using threads). + */ + +typedef struct async_io { + unsigned flags; /* Driver flags, definitions found above. */ + HANDLE thread; /* If -1, overlapped I/O is used (Windows NT). + * Otherwise, it is the handle of the thread used + * for simulating overlapped I/O (Windows 95 and + * the console for Windows NT). + */ + HANDLE fd; /* Handle for file or pipe. */ +#ifdef ERTS_SMP + int async_io_active; /* if true, a close of the file will signal the event in ov */ +#endif + OVERLAPPED ov; /* Control structure for overlapped reading. + * When overlapped reading is simulated with + * a thread, the fields are used as follows: + * ov.Internal - Read buffer. + * ov.InternalHigh - Number of bytes to read. + * See macros above. + */ + HANDLE ioAllowed; /* The thread will wait for this event + * before starting a new read or write. + */ + DWORD pendingError; /* Used to delay presentating an error to Erlang + * until the check_io function is entered. + */ + DWORD bytesTransferred; /* Bytes read or write in the last operation. + * Valid only when DF_OVR_READY is set. + */ +} AsyncIo; + + +/* + * Input thread for fd_driver (if fd_driver is running). + */ +static AsyncIo* fd_driver_input = NULL; +static BOOL (WINAPI *fpSetHandleInformation)(HANDLE,DWORD,DWORD); + +/* + * This data is used by the spawn and vanilla drivers. + * There will be one entry for each port, even if the input + * and output HANDLES are different. Since handles are not + * guaranteed to be small numbers in Win32, we cannot index + * with them. I.e. the index for each entry is not equal to + * none of the file handles. + */ + +typedef struct driver_data { + int totalNeeded; /* Total number of bytes needed to fill + * up the packet header or packet. */ + int bytesInBuffer; /* Number of bytes read so far in + * the input buffer. + */ + int inBufSize; /* Size of input buffer. */ + byte *inbuf; /* Buffer to use for overlapped read. */ + int outBufSize; /* Size of output buffer. */ + byte *outbuf; /* Buffer to use for overlapped write. */ + ErlDrvPort port_num; /* The port number. */ + int packet_bytes; /* 0: continous stream, 1, 2, or 4: the number + * of bytes in the packet header. + */ + HANDLE port_pid; /* PID of the port process. */ + AsyncIo in; /* Control block for overlapped reading. */ + AsyncIo out; /* Control block for overlapped writing. */ + int report_exit; /* Do report exit status for the port */ +} DriverData; + +static DriverData* driver_data; /* Pointer to array of driver data. */ + +/* Driver interfaces */ +static ErlDrvData spawn_start(ErlDrvPort, char*, SysDriverOpts*); +static ErlDrvData fd_start(ErlDrvPort, char*, SysDriverOpts*); +static ErlDrvData vanilla_start(ErlDrvPort, char*, SysDriverOpts*); +static int spawn_init(void); +static int fd_init(void); +static void fd_stop(ErlDrvData); +static void stop(ErlDrvData); +static void output(ErlDrvData, char*, int); +static void ready_input(ErlDrvData, ErlDrvEvent); +static void ready_output(ErlDrvData, ErlDrvEvent); +static void stop_select(ErlDrvEvent, void*); + +struct erl_drv_entry spawn_driver_entry = { + spawn_init, + spawn_start, + stop, + output, + ready_input, + ready_output, + "spawn", + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, + NULL, /* process_exit */ + stop_select +}; + +#ifdef HARD_POLL_DEBUG +extern void poll_debug_set_active_fd(ErtsSysFdType fd); +extern void poll_debug_read_begin(ErtsSysFdType fd); +extern void poll_debug_read_done(ErtsSysFdType fd, int bytes); +extern void poll_debug_async_initialized(ErtsSysFdType fd); +extern void poll_debug_async_immediate(ErtsSysFdType fd, int bytes); +extern void poll_debug_write_begin(ErtsSysFdType fd); +extern void poll_debug_write_done(ErtsSysFdType fd, int bytes); +#endif + +extern int null_func(void); + +struct erl_drv_entry fd_driver_entry = { + fd_init, + fd_start, + fd_stop, + output, + ready_input, + ready_output, + "fd", + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, + NULL, /* process_exit */ + stop_select +}; + +struct erl_drv_entry vanilla_driver_entry = { + null_func, + vanilla_start, + stop, + output, + ready_input, + ready_output, + "vanilla", + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, + NULL, /* process_exit */ + stop_select +}; + +#if defined(USE_THREADS) && !defined(ERTS_SMP) + +static int async_drv_init(void); +static ErlDrvData async_drv_start(ErlDrvPort, char*, SysDriverOpts*); +static void async_drv_stop(ErlDrvData); +static void async_drv_input(ErlDrvData, ErlDrvEvent); + +/* INTERNAL use only */ + +void null_output(ErlDrvData drv_data, char* buf, int len) +{ +} + +void null_ready_output(ErlDrvData drv_data, ErlDrvEvent event) +{ +} + +struct erl_drv_entry async_driver_entry = { + async_drv_init, + async_drv_start, + async_drv_stop, + null_output, + async_drv_input, + null_ready_output, + "async", + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL, /* event */ + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, /* ERL_DRV_FLAGs */ + NULL, + NULL, /* process_exit */ + stop_select +}; + +#endif + +/* + * Initialises a DriverData structure. + * + * Results: Returns a pointer to a DriverData structure, or NULL + * if the initialsation failed. + */ + +static DriverData* +new_driver_data(port_num, packet_bytes, wait_objs_required, use_threads) + int port_num; /* The port number. */ + int packet_bytes; /* Number of bytes in header. */ + int wait_objs_required; /* The number objects this port is going + /* wait for (typically 1 or 2). */ + int use_threads; /* TRUE if threads are intended to be used. */ +{ + DriverData* dp; + + erts_smp_mtx_lock(&sys_driver_data_lock); + + DEBUGF(("new_driver_data(port_num %d, pb %d)\n", + port_num, packet_bytes)); + + /* + * We used to test first at all that there is enough room in the + * array used by WaitForMultipleObjects(), but that is not necessary + * any more, since driver_select() can't fail. + */ + + /* + * Search for a free slot. + */ + + for (dp = driver_data; dp < driver_data+max_files; dp++) { + if (dp->port_num == PORT_FREE) { + dp->bytesInBuffer = 0; + dp->totalNeeded = packet_bytes; + dp->inBufSize = PORT_BUFSIZ; + dp->inbuf = DRV_BUF_ALLOC(dp->inBufSize); + if (dp->inbuf == NULL) { + erts_smp_mtx_unlock(&sys_driver_data_lock); + return NULL; + } + erts_smp_atomic_add(&sys_misc_mem_sz, dp->inBufSize); + dp->outBufSize = 0; + dp->outbuf = NULL; + dp->port_num = port_num; + dp->packet_bytes = packet_bytes; + dp->port_pid = INVALID_HANDLE_VALUE; + if (init_async_io(&dp->in, use_threads) == -1) + break; + if (init_async_io(&dp->out, use_threads) == -1) + break; + erts_smp_mtx_unlock(&sys_driver_data_lock); + return dp; + } + } + + /* + * Error or no free driver data. + */ + + if (dp < driver_data+max_files) { + release_async_io(&dp->in, dp->port_num); + release_async_io(&dp->out, dp->port_num); + } + erts_smp_mtx_unlock(&sys_driver_data_lock); + return NULL; +} + +static void +release_driver_data(DriverData* dp) +{ + erts_smp_mtx_lock(&sys_driver_data_lock); + +#ifdef ERTS_SMP + /* This is a workaround for the fact that CancelIo cant cancel + requests issued by another thread and that we still cant use + CancelIoEx as that's only availabele in Vista etc. */ + if(dp->in.async_io_active && dp->in.fd != INVALID_HANDLE_VALUE) { + CloseHandle(dp->in.fd); + dp->in.fd = INVALID_HANDLE_VALUE; + DEBUGF(("Waiting for the in event thingie")); + WaitForSingleObject(dp->in.ov.hEvent,INFINITE); + DEBUGF(("...done\n")); + } + if(dp->out.async_io_active && dp->out.fd != INVALID_HANDLE_VALUE) { + CloseHandle(dp->out.fd); + dp->out.fd = INVALID_HANDLE_VALUE; + DEBUGF(("Waiting for the out event thingie")); + WaitForSingleObject(dp->out.ov.hEvent,INFINITE); + DEBUGF(("...done\n")); + } +#else + if (dp->out.thread == (HANDLE) -1 && dp->in.fd != INVALID_HANDLE_VALUE) { + CancelIo(dp->in.fd); + } + if (dp->out.thread == (HANDLE) -1 && dp->out.fd != INVALID_HANDLE_VALUE) { + CancelIo(dp->out.fd); + } +#endif + + if (dp->inbuf != NULL) { + ASSERT(erts_smp_atomic_read(&sys_misc_mem_sz) >= dp->inBufSize); + erts_smp_atomic_add(&sys_misc_mem_sz, -1*dp->inBufSize); + DRV_BUF_FREE(dp->inbuf); + dp->inBufSize = 0; + dp->inbuf = NULL; + } + ASSERT(dp->inBufSize == 0); + + if (dp->outbuf != NULL) { + ASSERT(erts_smp_atomic_read(&sys_misc_mem_sz) >= dp->outBufSize); + erts_smp_atomic_add(&sys_misc_mem_sz, -1*dp->outBufSize); + DRV_BUF_FREE(dp->outbuf); + dp->outBufSize = 0; + dp->outbuf = NULL; + } + ASSERT(dp->outBufSize == 0); + + if (dp->port_pid != INVALID_HANDLE_VALUE) { + CloseHandle(dp->port_pid); + dp->port_pid = INVALID_HANDLE_VALUE; + } + + release_async_io(&dp->in, dp->port_num); + release_async_io(&dp->out, dp->port_num); + + /* + * This must be last, because this function might be executed from + * the exit thread. + */ + + dp->port_num = PORT_FREE; + erts_smp_mtx_unlock(&sys_driver_data_lock); +} + +/* + * Stores input and output file descriptors in the DriverData structure, + * and calls driver_select(). + * + * This function fortunately can't fail! + */ + +static ErlDrvData +set_driver_data(dp, ifd, ofd, read_write, report_exit) + DriverData* dp; + HANDLE ifd; + HANDLE ofd; + int read_write; + int report_exit; +{ + int index = dp - driver_data; + int result; + + dp->in.fd = ifd; + dp->out.fd = ofd; + dp->report_exit = report_exit; + + if (read_write & DO_READ) { + result = driver_select(dp->port_num, (ErlDrvEvent)dp->in.ov.hEvent, + ERL_DRV_READ|ERL_DRV_USE, 1); + ASSERT(result != -1); + async_read_file(&dp->in, dp->inbuf, dp->inBufSize); + } + + if (read_write & DO_WRITE) { + result = driver_select(dp->port_num, (ErlDrvEvent)dp->out.ov.hEvent, + ERL_DRV_WRITE|ERL_DRV_USE, 1); + ASSERT(result != -1); + } + return (ErlDrvData)index; +} + +/* + * Initialises an AsyncIo structure. + */ + +static int +init_async_io(AsyncIo* aio, int use_threads) +{ + aio->flags = 0; + aio->thread = (HANDLE) -1; + aio->fd = INVALID_HANDLE_VALUE; + aio->ov.hEvent = NULL; + aio->ov.Offset = 0L; + aio->ov.OffsetHigh = 0L; + aio->ioAllowed = NULL; + aio->pendingError = 0; + aio->bytesTransferred = 0; +#ifdef ERTS_SMP + aio->async_io_active = 0; +#endif + aio->ov.hEvent = CreateManualEvent(FALSE); + if (aio->ov.hEvent == NULL) + return -1; + if (use_threads) { + aio->ioAllowed = CreateAutoEvent(FALSE); + if (aio->ioAllowed == NULL) + return -1; + } + return 0; +} + +/* + * Releases everything allocated in an AsyncIo structure. + */ + +static void +release_async_io(AsyncIo* aio, ErlDrvPort port_num) +{ + aio->flags = 0; + + if (aio->thread != (HANDLE) -1) + CloseHandle(aio->thread); + aio->thread = (HANDLE) -1; + + if (aio->fd != INVALID_HANDLE_VALUE) + CloseHandle(aio->fd); + aio->fd = INVALID_HANDLE_VALUE; + + if (aio->ov.hEvent != NULL) { + (void) driver_select(port_num, + (ErlDrvEvent)aio->ov.hEvent, + ERL_DRV_USE, 0); + /* was CloseHandle(aio->ov.hEvent); */ + } + + aio->ov.hEvent = NULL; + + if (aio->ioAllowed != NULL) + CloseHandle(aio->ioAllowed); + aio->ioAllowed = NULL; +} + +/* ---------------------------------------------------------------------- + * async_read_file -- + * Initiaties an asynchronous file read, or simulates that using + * the thread associated with this driver data. To get the results, + * call get_overlapped_result(). + * + * Results: + * None. + * ---------------------------------------------------------------------- + */ + +static void +async_read_file(aio, buf, numToRead) + AsyncIo* aio; /* Pointer to driver data. */ + LPVOID buf; /* Pointer to buffer to receive data. */ + DWORD numToRead; /* Number of bytes to read. */ +{ + aio->pendingError = NO_ERROR; +#ifdef HARD_POLL_DEBUG + poll_debug_async_initialized(aio->ov.hEvent); +#endif + if (aio->thread != (HANDLE) -1) { + DEBUGF(("async_read_file: signaling thread 0x%x, event 0x%x\n", + aio->thread, aio->ioAllowed)); + OV_BUFFER_PTR(aio) = buf; + OV_NUM_TO_READ(aio) = numToRead; + ResetEvent(aio->ov.hEvent); + SetEvent(aio->ioAllowed); + } else { +#ifdef ERTS_SMP + aio->async_io_active = 1; /* Will get 0 when the event actually happened */ +#endif + if (ReadFile(aio->fd, buf, numToRead, + &aio->bytesTransferred, &aio->ov)) { + DEBUGF(("async_read_file: ReadFile() suceeded: %d bytes\n", + aio->bytesTransferred)); +#ifdef HARD_POLL_DEBUG + poll_debug_async_immediate(aio->ov.hEvent, aio->bytesTransferred); +#endif + aio->flags |= DF_OVR_READY; + SetEvent(aio->ov.hEvent); + } else { + DWORD error = GetLastError(); + if (error != ERROR_IO_PENDING) { +#ifdef HARD_POLL_DEBUG + poll_debug_async_immediate(aio->ov.hEvent, 0); +#endif + aio->pendingError = error; + SetEvent(aio->ov.hEvent); + } + DEBUGF(("async_read_file: ReadFile() -> %s\n", win32_errorstr(error))); + } + } +} + +/* ---------------------------------------------------------------------- + * async_write_file -- + * Initiaties an asynchronous file write, or simulates that using + * the output thread associated with this driver data. + * To get the results, call get_overlapped_result(). + * + * Results: + * None. + * ---------------------------------------------------------------------- + */ +static int +async_write_file(aio, buf, numToWrite) + AsyncIo* aio; /* Pointer to async control block. */ + LPVOID buf; /* Pointer to buffer with data to write. */ + DWORD numToWrite; /* Number of bytes to write. */ +{ + aio->pendingError = NO_ERROR; + if (aio->thread != (HANDLE) -1) { + DEBUGF(("async_write_file: signaling thread 0x%x, event 0x%x\n", + aio->thread, aio->ioAllowed)); + OV_BUFFER_PTR(aio) = buf; + OV_NUM_TO_READ(aio) = numToWrite; + ResetEvent(aio->ov.hEvent); + SetEvent(aio->ioAllowed); + } else { +#ifdef ERTS_SMP + aio->async_io_active = 1; /* Will get 0 when the event actually happened */ +#endif + if (WriteFile(aio->fd, buf, numToWrite, + &aio->bytesTransferred, &aio->ov)) { + DEBUGF(("async_write_file: WriteFile() suceeded: %d bytes\n", + aio->bytesTransferred)); +#ifdef ERTS_SMP + aio->async_io_active = 0; /* The event will not be signalled */ +#endif + ResetEvent(aio->ov.hEvent); + return TRUE; + } else { + DWORD error = GetLastError(); + if (error != ERROR_IO_PENDING) { + aio->pendingError = error; + SetEvent(aio->ov.hEvent); + } + DEBUGF(("async_write_file: WriteFile() -> %s\n", win32_errorstr(error))); + } + } + return FALSE; +} + +/* ---------------------------------------------------------------------- + * get_overlapped_result -- + * + * Results: + * Returns the error code for the overlapped result, or NO_ERROR + * if no error. + * ---------------------------------------------------------------------- + */ +static int +get_overlapped_result(aio, pBytesRead, wait) + AsyncIo* aio; /* Pointer to async control block. */ + LPDWORD pBytesRead; /* Where to place the number of bytes + * transferred. + */ + BOOL wait; /* If true, wait until result is ready. */ +{ + DWORD error = NO_ERROR; /* Error status from last function. */ + + if (aio->thread != (HANDLE) -1) { + + /* + * Simulate overlapped io with a thread. + */ + DEBUGF(("get_overlapped_result: about to wait for event 0x%x\n", + aio->ov.hEvent)); + error = WaitForSingleObject(aio->ov.hEvent, wait ? INFINITE : 0); + switch (error) { + case WAIT_OBJECT_0: + error = aio->pendingError; + aio->pendingError = NO_ERROR; + *pBytesRead = aio->bytesTransferred; + ResetEvent(aio->ov.hEvent); + DEBUGF(("get_overlapped_result -> %s\n", + win32_errorstr(error))); + return error; + case WAIT_TIMEOUT: + DEBUGF(("get_overlapped_result -> %s\n", + ERROR_IO_INCOMPLETE)); + return ERROR_IO_INCOMPLETE; + case WAIT_FAILED: /* XXX: Shouldn't happen? */ + error = GetLastError(); + DEBUGF(("get_overlapped_result (WAIT_FAILED) -> %s\n", + win32_errorstr(error))); + return error; + } + } else if (aio->pendingError != NO_ERROR) { /* Pending error. */ + error = aio->pendingError; + aio->pendingError = NO_ERROR; + ResetEvent(aio->ov.hEvent); + DEBUGF(("get_overlapped_result: pending error: %s\n", + win32_errorstr(error))); + return error; + } else if (aio->flags & DF_OVR_READY) { /* Operation succeded. */ + aio->flags &= ~DF_OVR_READY; + *pBytesRead = aio->bytesTransferred; + ResetEvent(aio->ov.hEvent); + DEBUGF(("get_overlapped_result: delayed success: %d bytes\n", + aio->bytesTransferred)); + } else if (!GetOverlappedResult(aio->fd, &aio->ov, pBytesRead, wait)) { + error = GetLastError(); + ResetEvent(aio->ov.hEvent); + DEBUGF(("get_overlapped_result: error: %s\n", win32_errorstr(error))); + return error; + } else { /* Success. */ + DEBUGF(("get_overlapped_result: success\n")); + ResetEvent(aio->ov.hEvent); + } + return NO_ERROR; +} + +static int +fd_init(void) +{ + char kernel_dll_name[] = "kernel32"; + HMODULE module; + module = GetModuleHandle(kernel_dll_name); + fpSetHandleInformation = (module != NULL) ? + (BOOL (WINAPI *)(HANDLE,DWORD,DWORD)) + GetProcAddress(module,"SetHandleInformation") : + NULL; + + return 0; +} +static int +spawn_init() +{ + int i; + + driver_data = (struct driver_data *) + erts_alloc(ERTS_ALC_T_DRV_TAB, max_files * sizeof(struct driver_data)); + erts_smp_atomic_add(&sys_misc_mem_sz, max_files*sizeof(struct driver_data)); + for (i = 0; i < max_files; i++) + driver_data[i].port_num = PORT_FREE; + return 0; +} + +static ErlDrvData +spawn_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) +{ + HANDLE hToChild = INVALID_HANDLE_VALUE; /* Write handle to child. */ + HANDLE hFromChild = INVALID_HANDLE_VALUE; /* Read handle from child. */ + HANDLE hChildStdin = INVALID_HANDLE_VALUE; /* Child's stdin. */ + HANDLE hChildStdout = INVALID_HANDLE_VALUE; /* Child's stout. */ + HANDLE hChildStderr = INVALID_HANDLE_VALUE; /* Child's sterr. */ + int close_child_stderr = 0; + DriverData* dp; /* Pointer to driver data. */ + ErlDrvData retval = ERL_DRV_ERROR_GENERAL; /* Return value. */ + int ok; + int neededSelects = 0; + SECURITY_ATTRIBUTES sa = {sizeof(SECURITY_ATTRIBUTES), NULL, TRUE}; + char* envir = opts->envir; + int errno_return = -1; + + if (opts->read_write & DO_READ) + neededSelects++; + if (opts->read_write & DO_WRITE) + neededSelects++; + + if ((dp = new_driver_data(port_num, opts->packet_bytes, neededSelects, + !use_named_pipes)) == NULL) + return ERL_DRV_ERROR_GENERAL; + + /* + * Create two pipes to communicate with the port program. + */ + + if (opts->read_write & DO_READ) { + if (!create_pipe(&hFromChild, &hChildStdout, FALSE, + opts->overlapped_io)) + goto error; + } else { + hChildStdout = CreateFile("nul", GENERIC_WRITE, 0, + &sa, OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, NULL); + DEBUGF(("Created nul file for hChildStdout = %d\n",hChildStdout)); + } + if (opts->read_write & DO_WRITE) { + if (!create_pipe(&hChildStdin, &hToChild, TRUE, opts->overlapped_io)) { + CloseHandle(hFromChild); + hFromChild = INVALID_HANDLE_VALUE; + CloseHandle(hChildStdout); + goto error; + } + } else { + hChildStdin = CreateFile("nul", GENERIC_READ, 0, + &sa, OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, NULL); + DEBUGF(("Created nul file for hChildStdin = %d\n",hChildStdin)); + } + + /* + * Make sure that standard error is valid handle, because a Command Prompt + * window not work properly otherwise. We leave standard error alone if + * it is okay and no redirection was specified. + */ + hChildStderr = GetStdHandle(STD_ERROR_HANDLE); + if (opts->redir_stderr) { + hChildStderr = hChildStdout; + } else if (hChildStderr == INVALID_HANDLE_VALUE || hChildStderr == 0) { + hChildStderr = CreateFile("nul", GENERIC_WRITE, 0, &sa, OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, NULL); + close_child_stderr = 1; + } + if (fpSetHandleInformation != NULL) { + (*fpSetHandleInformation)(hChildStderr, HANDLE_FLAG_INHERIT, 1); + } + /* + * Spawn the port program. + */ + + DEBUGF(("Spawning \"%s\"\n", name)); + envir = win_build_environment(envir); + ok = CreateChildProcess(name, + hChildStdin, + hChildStdout, + hChildStderr, + &dp->port_pid, + opts->hide_window, + (LPVOID) envir, + (LPTSTR) opts->wd, + opts->spawn_type, + opts->argv, + &errno_return); + CloseHandle(hChildStdin); + CloseHandle(hChildStdout); + if (close_child_stderr && hChildStderr != INVALID_HANDLE_VALUE && + hChildStderr != 0) { + CloseHandle(hChildStderr); + } + if (envir != NULL) { + erts_free(ERTS_ALC_T_ENVIRONMENT, envir); + } + + if (!ok) { + dp->port_pid = INVALID_HANDLE_VALUE; + if (errno_return >= 0) { + retval = ERL_DRV_ERROR_ERRNO; + } + } else { + if (!use_named_pipes) { + if ((opts->read_write & DO_READ) && + !create_file_thread(&dp->in, DO_READ)) + goto error; + if ((opts->read_write & DO_WRITE) && + !create_file_thread(&dp->out, DO_WRITE)) { + dp->in.flags = DF_EXIT_THREAD; + SetEvent(dp->in.ioAllowed); + WaitForSingleObject(dp->in.thread, INFINITE); + dp->in.thread = (HANDLE) -1; + goto error; + } + } +#ifdef HARD_POLL_DEBUG + if (strncmp(name,"inet_gethost",12) == 0) { + erts_printf("Debugging \"%s\"\n", name); + poll_debug_set_active_fd(dp->in.ov.hEvent); + } +#endif + retval = set_driver_data(dp, hFromChild, hToChild, opts->read_write, + opts->exit_status); + } + + if (retval != ERL_DRV_ERROR_GENERAL && retval != ERL_DRV_ERROR_ERRNO) + return retval; + + error: + if (hFromChild != INVALID_HANDLE_VALUE) + CloseHandle(hFromChild); + if (hToChild != INVALID_HANDLE_VALUE) + CloseHandle(hToChild); + release_driver_data(dp); + if (retval == ERL_DRV_ERROR_ERRNO) { + errno = errno_return; + } + return retval; +} + +static int +create_file_thread(AsyncIo* aio, int mode) +{ + DWORD tid; /* Id for thread. */ + + aio->thread = (HANDLE) + _beginthreadex(NULL, 0, + (mode & DO_WRITE) ? threaded_writer : threaded_reader, + aio, 0, &tid); + + return aio->thread != (HANDLE) -1; +} + +/* + * A helper function used by CreateChildProcess(). + * Parses a command line with arguments and returns the length of the + * first part containing the program name. + * Example: input = "\"Program Files\"\\erl arg1 arg2" + * gives 19 as result. + * The length returned is equivalent with length(argv[0]) if the + * comman line should have been prepared by _setargv for the main function +*/ +int parse_command(char* cmd){ +#define NORMAL 2 +#define STRING 1 +#define STOP 0 + int i =0; + int state = NORMAL; + while (cmd[i]) { + switch (cmd[i]) { + case '"': + if (state == NORMAL) + state = STRING; + else + state = NORMAL; + break; + case '\\': + if ((state == STRING) && (cmd[i+1]=='"')) + i++; + break; + case ' ': + if (state == NORMAL) + state = STOP; + break; + default: + break; + } + if (state == STOP) { + return i; + } + i++; + } + return i; +} + +BOOL need_quotes(char *str) +{ + int in_quote = 0; + int backslashed = 0; + int naked_space = 0; + while (*str != '\0') { + switch (*str) { + case '\\' : + backslashed = !backslashed; + break; + case '"': + if (backslashed) { + backslashed=0; + } else { + in_quote = !in_quote; + } + break; + case ' ': + backslashed = 0; + if (!(backslashed || in_quote)) { + naked_space++; + } + break; + default: + backslashed = 0; + } + ++str; + } + return (naked_space > 0); +} + + + +/* + *---------------------------------------------------------------------- + * + * CreateChildProcess -- + * + * Create a child process that has pipes as its + * standard input, output, and error. The child process runs + * synchronously under Win32s and asynchronously under Windows NT + * and Windows 95, and runs with the same environment variables + * as the creating process. + * + * The complete Windows search path is searched to find the specified + * executable. If an executable by the given name is not found, + * automatically tries appending ".com", ".exe", and ".bat" to the + * executable name. + * + * Results: + * The return value is FALSE if there was a problem creating the child process. + * Otherwise, the return value is 0 and *phPid is + * filled with the process id of the child process. + * + * Side effects: + * A process is created. + * + *---------------------------------------------------------------------- + */ + +static BOOL +CreateChildProcess +( + char *origcmd, /* Command line for child process (including + * name of executable). Or whole executable if st is + * ERTS_SPAWN_EXECUTABLE + */ + HANDLE hStdin, /* The standard input handle for child. */ + HANDLE hStdout, /* The standard output handle for child. */ + HANDLE hStderr, /* The standard error handle for child. */ + LPHANDLE phPid, /* Pointer to variable to received PID. */ + BOOL hide, /* Hide the window unconditionally. */ + LPVOID env, /* Environment for the child */ + LPTSTR wd, /* Working dir for the child */ + unsigned st, /* Flags for spawn, tells us how to interpret origcmd */ + char **argv, /* Argument vector if given. */ + int *errno_return /* Place to put an errno in in case of failure */ + ) +{ + PROCESS_INFORMATION piProcInfo = {0}; + STARTUPINFO siStartInfo = {0}; + BOOL ok = FALSE; + int applType; + /* Not to be changed for different types of executables */ + int staticCreateFlags = GetPriorityClass(GetCurrentProcess()); + int createFlags = DETACHED_PROCESS; + char *newcmdline = NULL; + char execPath[MAX_PATH]; + int cmdlength; + char* thecommand; + LPTSTR appname = NULL; + HANDLE hProcess = GetCurrentProcess(); + + *errno_return = -1; + + siStartInfo.cb = sizeof(STARTUPINFO); + siStartInfo.dwFlags = STARTF_USESTDHANDLES; + siStartInfo.hStdInput = hStdin; + siStartInfo.hStdOutput = hStdout; + siStartInfo.hStdError = hStderr; + + + if (st != ERTS_SPAWN_EXECUTABLE) { + /* + * Parse out the program name from the command line (it can be quoted and + * contain spaces). + */ + newcmdline = erts_alloc(ERTS_ALC_T_TMP, 2048); + cmdlength = parse_command(origcmd); + thecommand = (char *) erts_alloc(ERTS_ALC_T_TMP, cmdlength+1); + strncpy(thecommand, origcmd, cmdlength); + thecommand[cmdlength] = '\0'; + DEBUGF(("spawn command: %s\n", thecommand)); + + applType = ApplicationType(thecommand, execPath, TRUE, + TRUE, errno_return); + DEBUGF(("ApplicationType returned for (%s) is %d\n", thecommand, applType)); + erts_free(ERTS_ALC_T_TMP, (void *) thecommand); + if (applType == APPL_NONE) { + erts_free(ERTS_ALC_T_TMP,newcmdline); + return FALSE; + } + newcmdline[0] = '\0'; + + if (applType == APPL_DOS) { + /* + * Under NT, 16-bit DOS applications will not run unless they + * can be attached to a console. Run the 16-bit program as + * a normal process inside of a hidden console application, + * and then run that hidden console as a detached process. + */ + + siStartInfo.wShowWindow = SW_HIDE; + siStartInfo.dwFlags |= STARTF_USESHOWWINDOW; + createFlags = CREATE_NEW_CONSOLE; + strcat(newcmdline, "cmd.exe /c "); + } else if (hide) { + DEBUGF(("hiding window\n")); + siStartInfo.wShowWindow = SW_HIDE; + siStartInfo.dwFlags |= STARTF_USESHOWWINDOW; + createFlags = 0; + } + + strcat(newcmdline, execPath); + strcat(newcmdline, origcmd+cmdlength); + } else { /* ERTS_SPAWN_EXECUTABLE */ + int run_cmd = 0; + applType = ApplicationType(origcmd, execPath, FALSE, FALSE, + errno_return); + if (applType == APPL_NONE) { + return FALSE; + } + if (applType == APPL_DOS) { + /* + * See comment above + */ + + siStartInfo.wShowWindow = SW_HIDE; + siStartInfo.dwFlags |= STARTF_USESHOWWINDOW; + createFlags = CREATE_NEW_CONSOLE; + run_cmd = 1; + } else if (hide) { + DEBUGF(("hiding window\n")); + siStartInfo.wShowWindow = SW_HIDE; + siStartInfo.dwFlags |= STARTF_USESHOWWINDOW; + createFlags = 0; + } + if (run_cmd) { + char cmdPath[MAX_PATH]; + int cmdType; + cmdType = ApplicationType("cmd.exe", cmdPath, TRUE, FALSE, errno_return); + if (cmdType == APPL_NONE || cmdType == APPL_DOS) { + return FALSE; + } + appname = (char *) erts_alloc(ERTS_ALC_T_TMP, strlen(cmdPath)+1); + strcpy(appname,cmdPath); + } else { + appname = (char *) erts_alloc(ERTS_ALC_T_TMP, strlen(execPath)+1); + strcpy(appname,execPath); + } + if (argv == NULL) { + BOOL orig_need_q = need_quotes(execPath); + char *ptr; + int ocl = strlen(execPath); + if (run_cmd) { + newcmdline = (char *) erts_alloc(ERTS_ALC_T_TMP, + ocl + ((orig_need_q) ? 3 : 1) + + 11); + memcpy(newcmdline,"cmd.exe /c ",11); + ptr = newcmdline + 11; + } else { + newcmdline = (char *) erts_alloc(ERTS_ALC_T_TMP, + ocl + ((orig_need_q) ? 3 : 1)); + ptr = newcmdline; + } + if (orig_need_q) { + *ptr++ = '"'; + } + memcpy(ptr,execPath,ocl); + ptr += ocl; + if (orig_need_q) { + *ptr++ = '"'; + } + *ptr = '\0'; + } else { + int sum = 1; /* '\0' */ + char **ar = argv; + char *n; + char *save_arg0 = NULL; + if (argv[0] == erts_default_arg0 || run_cmd) { + save_arg0 = argv[0]; + argv[0] = execPath; + } + if (run_cmd) { + sum += 11; /* cmd.exe /c */ + } + while (*ar != NULL) { + sum += strlen(*ar); + if (need_quotes(*ar)) { + sum += 2; /* quotes */ + } + sum++; /* space */ + ++ar; + } + ar = argv; + newcmdline = erts_alloc(ERTS_ALC_T_TMP, sum); + n = newcmdline; + if (run_cmd) { + memcpy(n,"cmd.exe /c ",11); + n += 11; + } + while (*ar != NULL) { + int q = need_quotes(*ar); + sum = strlen(*ar); + if (q) { + *n++ = '"'; + } + memcpy(n,*ar,sum); + n += sum; + if (q) { + *n++ = '"'; + } + *n++ = ' '; + ++ar; + } + ASSERT(n > newcmdline); + *(n-1) = '\0'; + if (save_arg0 != NULL) { + argv[0] = save_arg0; + } + } + + } + DEBUGF(("Creating child process: %s, createFlags = %d\n", newcmdline, createFlags)); + ok = CreateProcess(appname, + newcmdline, + NULL, + NULL, + TRUE, + createFlags | staticCreateFlags, + env, + wd, + &siStartInfo, + &piProcInfo); + + if (newcmdline != NULL) { + erts_free(ERTS_ALC_T_TMP,newcmdline); + } + if (appname != NULL) { + erts_free(ERTS_ALC_T_TMP,appname); + } + if (!ok) { + DEBUGF(("CreateProcess failed: %s\n", last_error())); + if (*errno_return < 0) { + *errno_return = EACCES; + } + return FALSE; + } + CloseHandle(piProcInfo.hThread); /* Necessary to avoid resource leak. */ + *phPid = piProcInfo.hProcess; + + if (applType == APPL_DOS) { + WaitForSingleObject(hProcess, 50); + } + + /* + * When an application spawns a process repeatedly, a new thread + * instance will be created for each process but the previous + * instances may not be cleaned up. This results in a significant + * virtual memory loss each time the process is spawned. If there + * is a WaitForInputIdle() call between CreateProcess() and + * CloseHandle(), the problem does not occur. PSS ID Number: Q124121 + */ + + WaitForInputIdle(piProcInfo.hProcess, 5000); + + return ok; +} + +/* + * Note, inheritRead == FALSE means "inhetitWrite", i e one of the + * pipe ends is always expected to be inherited. The pipe end that should + * be inherited is opened without overlapped io flags, as the child program + * would expect stdout not to demand overlapped I/O. + */ +static int create_pipe(HANDLE *phRead, HANDLE *phWrite, BOOL inheritRead, BOOL overlapped_io) +{ + SECURITY_ATTRIBUTES sa = {sizeof(SECURITY_ATTRIBUTES), NULL, TRUE}; + char pipe_name[128]; /* Name of pipe. */ + Uint calls; + + /* + * If we should't use named pipes, create anonmous pipes. + */ + + if (!use_named_pipes) { + int success; + HANDLE non_inherited; /* Non-inherited copy of handle. */ + + if (!CreatePipe(phRead, phWrite, &sa, 0)) { + DEBUGF(("Error creating anonyomous pipe: %s\n", last_error())); + return FALSE; + } + + if (inheritRead) { + success = DuplicateHandle(GetCurrentProcess(), *phWrite, + GetCurrentProcess(), &non_inherited, 0, + FALSE, DUPLICATE_SAME_ACCESS); + CloseHandle(*phWrite); + *phWrite = non_inherited; + } else { + success = DuplicateHandle(GetCurrentProcess(), *phRead, + GetCurrentProcess(), &non_inherited, 0, + FALSE, DUPLICATE_SAME_ACCESS); + CloseHandle(*phRead); + *phRead = non_inherited; + } + return success; + } + + + /* + * Otherwise, create named pipes. + */ + + calls = (Uint) erts_smp_atomic_inctest(&pipe_creation_counter); + sprintf(pipe_name, "\\\\.\\pipe\\erlang44_%d_%d", + getpid(), calls); + + DEBUGF(("Creating pipe %s\n", pipe_name)); + sa.bInheritHandle = inheritRead; + if ((*phRead = CreateNamedPipe(pipe_name, + PIPE_ACCESS_INBOUND | + ((inheritRead && !overlapped_io) ? 0 : FILE_FLAG_OVERLAPPED), + PIPE_TYPE_BYTE | PIPE_READMODE_BYTE, + 1, + 0, + 0, + 2000, + &sa)) == NULL) { + DEBUGF(("Error creating pipe: %s\n", last_error())); + return FALSE; + } + + sa.bInheritHandle = !inheritRead; + if ((*phWrite = CreateFile(pipe_name, + GENERIC_WRITE, + 0, /* No sharing */ + &sa, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL | + ((inheritRead || overlapped_io) ? FILE_FLAG_OVERLAPPED : 0), + NULL)) == INVALID_HANDLE_VALUE) { + CloseHandle(*phRead); + DEBUGF(("Error opening other end of pipe: %s\n", last_error())); + return FALSE; + } + return TRUE; +} + + + + +static int ApplicationType +( + const char *originalName, /* Name of the application to find. */ + char fullPath[MAX_PATH], /* Filled with complete path to + * application. */ + BOOL search_in_path, /* If we should search the system wide path */ + BOOL handle_quotes, /* If we should handle quotes around executable */ + int *error_return /* A place to put an error code */ + ) +{ + int applType, i; + HANDLE hFile; + char *ext, *rest; + char buf[2]; + DWORD read; + IMAGE_DOS_HEADER header; + static char extensions[][5] = {"", ".com", ".exe", ".bat"}; + int is_quoted; + int len; + + /* Look for the program as an external program. First try the name + * as it is, then try adding .com, .exe, and .bat, in that order, to + * the name, looking for an executable. + * NOTE! that we does not support execution of .com programs on Windows NT + * + * + * Using the raw SearchPath() procedure doesn't do quite what is + * necessary. If the name of the executable already contains a '.' + * character, it will not try appending the specified extension when + * searching (in other words, SearchPath will not find the program + * "a.b.exe" if the arguments specified "a.b" and ".exe"). + * So, first look for the file as it is named. Then manually append + * the extensions, looking for a match. (') + */ + + len = strlen(originalName); + is_quoted = handle_quotes && len > 0 && originalName[0] == '"' && + originalName[len-1] == '"'; + + applType = APPL_NONE; + *error_return = ENOENT; + for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { + if(is_quoted) { + lstrcpyn(fullPath, originalName+1, MAX_PATH - 7); + len = strlen(fullPath); + if(len > 0) { + fullPath[len-1] = '\0'; + } + } else { + lstrcpyn(fullPath, originalName, MAX_PATH - 5); + } + lstrcat(fullPath, extensions[i]); + SearchPath((search_in_path) ? NULL : ".", fullPath, NULL, MAX_PATH, fullPath, &rest); + + /* + * Ignore matches on directories or data files, return if identified + * a known type. + */ + + if (GetFileAttributes(fullPath) & FILE_ATTRIBUTE_DIRECTORY) { + continue; + } + + ext = strrchr(fullPath, '.'); + if ((ext != NULL) && (strcmpi(ext, ".bat") == 0)) { + *error_return = EACCES; + applType = APPL_DOS; + break; + } + + hFile = CreateFile(fullPath, GENERIC_READ, FILE_SHARE_READ, NULL, + OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + if (hFile == INVALID_HANDLE_VALUE) { + continue; + } + + *error_return = EACCES; /* If considered an error, + it's an access error */ + header.e_magic = 0; + ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL); + if (header.e_magic != IMAGE_DOS_SIGNATURE) { + /* + * Doesn't have the magic number for relocatable executables. If + * filename ends with .com, assume it's a DOS application anyhow. + * Note that we didn't make this assumption at first, because some + * supposed .com files are really 32-bit executables with all the + * magic numbers and everything. + */ + + CloseHandle(hFile); + if ((ext != NULL) && (strcmpi(ext, ".com") == 0)) { + applType = APPL_DOS; + break; + } + continue; + } + if (header.e_lfarlc != sizeof(header)) { + /* + * All Windows 3.X and Win32 and some DOS programs have this value + * set here. If it doesn't, assume that since it already had the + * other magic number it was a DOS application. + */ + + CloseHandle(hFile); + applType = APPL_DOS; + break; + } + + /* + * The DWORD at header.e_lfanew points to yet another magic number. + */ + + buf[0] = '\0'; + SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN); + ReadFile(hFile, (void *) buf, 2, &read, NULL); + CloseHandle(hFile); + + if ((buf[0] == 'L') && (buf[1] == 'E')) { + applType = APPL_DOS; + } else if ((buf[0] == 'N') && (buf[1] == 'E')) { + applType = APPL_WIN3X; + } else if ((buf[0] == 'P') && (buf[1] == 'E')) { + applType = APPL_WIN32; + } else { + continue; + } + break; + } + + if (applType == APPL_NONE) { + return APPL_NONE; + } + + if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) { + /* + * Replace long path name of executable with short path name for + * 16-bit applications. Otherwise the application may not be able + * to correctly parse its own command line to separate off the + * application name from the arguments. + */ + + GetShortPathName(fullPath, fullPath, MAX_PATH); + } + if (is_quoted) { + /* restore quotes on quoted program name */ + len = strlen(fullPath); + memmove(fullPath+1,fullPath,len); + fullPath[0]='"'; + fullPath[len+1]='"'; + fullPath[len+2]='\0'; + } + return applType; +} + +/* + * Thread function used to emulate overlapped reading. + */ + +DWORD WINAPI +threaded_reader(LPVOID param) +{ + AsyncIo* aio = (AsyncIo *) param; + HANDLE thread = GetCurrentThread(); + char* buf; + DWORD numToRead; + + for (;;) { + WaitForSingleObject(aio->ioAllowed, INFINITE); + if (aio->flags & DF_EXIT_THREAD) + break; + buf = OV_BUFFER_PTR(aio); + numToRead = OV_NUM_TO_READ(aio); + aio->pendingError = 0; + if (!ReadFile(aio->fd, buf, numToRead, &aio->bytesTransferred, NULL)) + aio->pendingError = GetLastError(); + else if (aio->flags & DF_XLAT_CR) { + char *s; + int n; + + n = aio->bytesTransferred; + for (s = buf; s < buf+n; s++) { + if (*s == '\r') { + if (s < buf + n - 1 && s[1] == '\n') { + memmove(s, s+1, (buf+n - s - 1)); + --n; + } else { + *s = '\n'; + } + } + } + aio->bytesTransferred = n; + } + SetEvent(aio->ov.hEvent); + if ((aio->flags & DF_XLAT_CR) == 0 && aio->bytesTransferred == 0) { + break; + } + if (aio->pendingError != NO_ERROR) { + break; + } + if (aio->flags & DF_EXIT_THREAD) + break; + } + return 0; +} + +/* + * Thread function used to emulate overlapped writing + */ + +DWORD WINAPI +threaded_writer(LPVOID param) +{ + AsyncIo* aio = (AsyncIo *) param; + HANDLE thread = GetCurrentThread(); + char* buf; + DWORD numToWrite; + int ok; + + for (;;) { + WaitForSingleObject(aio->ioAllowed, INFINITE); + if (aio->flags & DF_EXIT_THREAD) + break; + buf = OV_BUFFER_PTR(aio); + numToWrite = OV_NUM_TO_READ(aio); + aio->pendingError = 0; + ok = WriteFile(aio->fd, buf, numToWrite, &aio->bytesTransferred, NULL); + if (!ok) { + aio->pendingError = GetLastError(); + if (aio->pendingError == ERROR_INVALID_HANDLE && + aio->flags & DF_DROP_IF_INVH) { + /* This is standard error and we'we got an + invalid standard error FD (non-inheritable) from parent. + Just drop the message and be happy. */ + aio->pendingError = 0; + aio->bytesTransferred = numToWrite; + } else if (aio->pendingError == ERROR_NOT_ENOUGH_MEMORY) { + /* This could be a console, which limits utput to 64kbytes, + which might translate to less on a unicode system. + Try 16k chunks and see if it works before giving up. */ + int done = 0; + DWORD transferred; + aio->pendingError = 0; + aio->bytesTransferred = 0; + ok = 1; + while (ok && (numToWrite - done) > 0x4000) { + ok = WriteFile(aio->fd, buf + done, 0x4000, &transferred, NULL); + aio->bytesTransferred += transferred; + done += 0x4000; + } + if (ok && (numToWrite - done) > 0) { + ok = WriteFile(aio->fd, buf + done, (numToWrite - done), + &transferred, NULL); + aio->bytesTransferred += transferred; + } + if (!ok) { + aio->pendingError = GetLastError(); + } + } + } + SetEvent(aio->ov.hEvent); + if (aio->pendingError != NO_ERROR || aio->bytesTransferred == 0) + break; + if (aio->flags & DF_EXIT_THREAD) + break; + } + CloseHandle(aio->fd); + aio->fd = INVALID_HANDLE_VALUE; + return 0; +} + +static HANDLE +translate_fd(int fd) +{ + DWORD access; + HANDLE handle; + + switch (fd) { + case 0: + access = GENERIC_READ; + handle = GetStdHandle(STD_INPUT_HANDLE); + break; + case 1: + access = GENERIC_WRITE; + handle = GetStdHandle(STD_OUTPUT_HANDLE); + break; + case 2: + access = GENERIC_WRITE; + handle = GetStdHandle(STD_ERROR_HANDLE); + break; + default: + return (HANDLE) fd; + } + DEBUGF(("translate_fd(%d) -> std(%d)\n", fd, handle)); + + if (handle == INVALID_HANDLE_VALUE || handle == 0) { + handle = CreateFile("nul", access, 0, + NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + } + DEBUGF(("translate_fd(%d) -> %d\n", fd, handle)); + return handle; +} + +static ErlDrvData +fd_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) +{ + DriverData* dp; + int is_std_error = (opts->ofd == 2); + + opts->ifd = (int) translate_fd(opts->ifd); + opts->ofd = (int) translate_fd(opts->ofd); + if ((dp = new_driver_data(port_num, opts->packet_bytes, 2, TRUE)) == NULL) + return ERL_DRV_ERROR_GENERAL; + + if (!create_file_thread(&dp->in, DO_READ)) { + dp->port_num = PORT_FREE; + return ERL_DRV_ERROR_GENERAL; + } + + if (!create_file_thread(&dp->out, DO_WRITE)) { + dp->port_num = PORT_FREE; + return ERL_DRV_ERROR_GENERAL; + } + + fd_driver_input = &(dp->in); + dp->in.flags = DF_XLAT_CR; + if (is_std_error) { + dp->out.flags |= DF_DROP_IF_INVH; /* Just drop messages if stderror + is an invalid handle */ + } + return set_driver_data(dp, opts->ifd, opts->ofd, opts->read_write, 0); +} + +static void fd_stop(ErlDrvData d) +{ + int fd = (int)d; + /* + * I don't know a clean way to terminate the threads + * (TerminateThread() doesn't release the stack), + * so will we'll let the threads live. Normally, the fd + * driver is only used to support the -oldshell option, + * so this shouldn't be a problem in practice. + * + * Since we will not attempt to terminate the threads, + * better not close the input or output files either. + */ + + driver_data[fd].in.thread = (HANDLE) -1; + driver_data[fd].out.thread = (HANDLE) -1; + driver_data[fd].in.fd = INVALID_HANDLE_VALUE; + driver_data[fd].out.fd = INVALID_HANDLE_VALUE; + + /*return */ common_stop(fd); +} + +static ErlDrvData +vanilla_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) +{ + HANDLE ofd,ifd; + DriverData* dp; + DWORD access; /* Access mode: GENERIC_READ, GENERIC_WRITE. */ + DWORD crFlags; + HANDLE this_process = GetCurrentProcess(); + + access = 0; + if (opts->read_write == DO_READ) + access |= GENERIC_READ; + if (opts->read_write == DO_WRITE) + access |= GENERIC_WRITE; + + if (opts->read_write == DO_READ) + crFlags = OPEN_EXISTING; + else if (opts->read_write == DO_WRITE) + crFlags = CREATE_ALWAYS; + else + crFlags = OPEN_ALWAYS; + + if ((dp = new_driver_data(port_num, opts->packet_bytes, 2, FALSE)) == NULL) + return ERL_DRV_ERROR_GENERAL; + ofd = CreateFile(name, access, FILE_SHARE_READ | FILE_SHARE_WRITE, + NULL, crFlags, FILE_ATTRIBUTE_NORMAL, NULL); + if (!DuplicateHandle(this_process, (HANDLE) ofd, + this_process, &ifd, 0, + FALSE, DUPLICATE_SAME_ACCESS)) { + CloseHandle(ofd); + ofd = INVALID_HANDLE_VALUE; + } + if (ofd == INVALID_HANDLE_VALUE) + return ERL_DRV_ERROR_GENERAL; + return set_driver_data(dp, ifd, ofd, opts->read_write,0); +} + +static void +stop(ErlDrvData index) +{ + common_stop((int)index); +} + +static void common_stop(int index) +{ + DriverData* dp = driver_data+index; + + DEBUGF(("common_stop(%d)\n", index)); + + if (dp->in.ov.hEvent != NULL) { + (void) driver_select(dp->port_num, + (ErlDrvEvent)dp->in.ov.hEvent, + ERL_DRV_READ, 0); + } + if (dp->out.ov.hEvent != NULL) { + (void) driver_select(dp->port_num, + (ErlDrvEvent)dp->out.ov.hEvent, + ERL_DRV_WRITE, 0); + } + + if (dp->out.thread == (HANDLE) -1 && dp->in.thread == (HANDLE) -1) { + release_driver_data(dp); + } else { + /* + * If there are read or write threads, start a thread which will + * wait for them to finish. + */ + HANDLE thread; + DWORD tid; + dp->port_num = PORT_EXITING; + thread = (HANDLE *) _beginthreadex(NULL, 0, threaded_exiter, dp, 0, &tid); + CloseHandle(thread); + } +} + +DWORD WINAPI +threaded_exiter(LPVOID param) +{ + DriverData* dp = (DriverData *) param; + HANDLE handles[2]; + int i; + + /* + * Ask the threads to terminated. + * + * Note that we can't reliable test the state of the ioAllowed event, + * because it is an auto reset event. Therefore, always set the + * exit flag and signal the event. + */ + + i = 0; + if (dp->out.thread != (HANDLE) -1) { + dp->out.flags = DF_EXIT_THREAD; + SetEvent(dp->out.ioAllowed); + handles[i++] = dp->out.thread; + } + if (dp->in.thread != (HANDLE) -1) { + dp->in.flags = DF_EXIT_THREAD; + SetEvent(dp->in.ioAllowed); + handles[i++] = dp->in.thread; + } + + /* + * If we were lucky, the following happened above: + * 1) The output thread terminated (and closed the pipe). + * 2) As a consequence of that, the port program received + * EOF on its standard input. + * 3) Hopefully, because of (2), the port program terminated. + * 4) Because of (3), the input thread terminated. + * + * But this might need some time; therefore, we must wait for + * both threads to terminate. + */ + + if (i > 0) { + switch (WaitForMultipleObjects(i, handles, TRUE, 5000)) { + case WAIT_TIMEOUT: + DEBUGF(("Timeout waiting for %d threads failed\n", i)); + break; + case WAIT_FAILED: + DEBUGF(("Wait for %d threads failed: %s\n", + i, win32_errorstr(GetLastError()))); + break; + default: + break; + } + } + + /* + * Wait for threads to terminate didn't help. Now use some force. + * TerminateThread() is *not* a good idea, because it doesn't clean + * up the thread's stack. + * + * Instead we well terminate the port program and wait for the + * threads to terminate themselves when they receive end of file. + */ + + if (dp->out.thread != (HANDLE) -1) { + int error; + + if (WaitForSingleObject(dp->out.thread, 0) == WAIT_OBJECT_0) { + CloseHandle(dp->out.thread); + dp->out.thread = (HANDLE) -1; + } else if (dp->port_pid != INVALID_HANDLE_VALUE) { + DEBUGF(("Killing port process 0x%x (output thread)\n", dp->port_pid)); + TerminateProcess(dp->port_pid, 0); + if (!CloseHandle(dp->port_pid)) + DEBUGF(("Failed to close output handle!!!\n")); + dp->port_pid = INVALID_HANDLE_VALUE; + DEBUGF(("Waiting for output thread 0x%x to finish\n", dp->out.thread)); + error = WaitForSingleObject(dp->out.thread, INFINITE); + } + } + + if (dp->in.thread != (HANDLE) -1) { + if (WaitForSingleObject(dp->in.thread, 0) == WAIT_OBJECT_0) { + CloseHandle(dp->in.thread); + dp->in.thread = (HANDLE) -1; + } else if (dp->port_pid != INVALID_HANDLE_VALUE) { + DEBUGF(("Killing port process 0x%x (input thread)\n", dp->port_pid)); + TerminateProcess(dp->port_pid, 0); + if (!CloseHandle(dp->port_pid)) + DEBUGF(("Failed to close input handle!!!\n")); + dp->port_pid = INVALID_HANDLE_VALUE; + + DEBUGF(("Waiting for input thread 0x%x to finish\n", dp->in.thread)); + switch (WaitForSingleObject(dp->in.thread, INFINITE)) { + case WAIT_OBJECT_0: + CloseHandle(dp->in.thread); + dp->in.thread = (HANDLE) -1; + break; + default: + DEBUGF(("Wait for input thread to finish failed: %s\n", + win32_errorstr(GetLastError()))); + break; + } + } + } + + release_driver_data(dp); + return 0; +} + +/* ---------------------------------------------------------------------- + * output -- + * Outputs data from Erlang to the port program. + * + * Results: + * Returns the actual number of bytes written (including the + * packet header) or -1 if an error occurred. + * ---------------------------------------------------------------------- + */ + +static void +output(ErlDrvData drv_data, char* buf, int len) +/* long drv_data; /* The slot to use in the driver data table. + * For Windows NT, this is *NOT* a file handle. + * The handle is found in the driver data. + */ +/* char *buf; /* Pointer to data to write to the port program. */ +/* int len; /* Number of bytes to write. */ +{ + DriverData* dp; + int pb; /* The header size for this port. */ + int port_num; /* The actual port number (for diagnostics). */ + char* current; + + dp = driver_data + (int)drv_data; + if ((port_num = dp->port_num) == -1) + return ; /*-1;*/ + + pb = dp->packet_bytes; + + if ((pb+len) == 0) + return ; /* 0; */ + + /* + * Check that the message can be sent with given header length. + */ + + if ((pb == 2 && len > 65535) || (pb == 1 && len > 255)) { + driver_failure_posix(port_num, EINVAL); + return ; /* -1; */ + } + + /* + * Allocate memory for both the message and the header. + */ + + ASSERT(dp->outbuf == NULL); + ASSERT(dp->outBufSize == 0); + + ASSERT(!dp->outbuf); + dp->outbuf = DRV_BUF_ALLOC(pb+len); + if (!dp->outbuf) { + driver_failure_posix(port_num, ENOMEM); + return ; /* -1; */ + } + + dp->outBufSize = pb+len; + erts_smp_atomic_add(&sys_misc_mem_sz, dp->outBufSize); + + /* + * Store header bytes (if any). + */ + + current = dp->outbuf; + switch (pb) { + case 4: + *current++ = (len >> 24) & 255; + *current++ = (len >> 16) & 255; + case 2: + *current++ = (len >> 8) & 255; + case 1: + *current++ = len & 255; + } + + /* + * Start the write. + */ + + if (len) + memcpy(current, buf, len); + + if (!async_write_file(&dp->out, dp->outbuf, pb+len)) { + set_busy_port(port_num, 1); + } else { + dp->out.ov.Offset += pb+len; /* For vanilla driver. */ + /* XXX OffsetHigh should be changed too. */ + ASSERT(erts_smp_atomic_read(&sys_misc_mem_sz) >= dp->outBufSize); + erts_smp_atomic_add(&sys_misc_mem_sz, -1*dp->outBufSize); + DRV_BUF_FREE(dp->outbuf); + dp->outBufSize = 0; + dp->outbuf = NULL; + } + /*return 0;*/ +} + + +/* ---------------------------------------------------------------------- + * ready_input -- + * This function is called (indirectly) from check_io() when an + * event object has been signaled, indicating that there is + * something to read on the corresponding file handle. + * + * If the port is working in the continous stream mode (packet_bytes == 0), + * whatever data read will be sent straight to Erlang. + * + * Results: + * Always 0. + * ---------------------------------------------------------------------- + */ + +static void +ready_input(ErlDrvData drv_data, ErlDrvEvent ready_event) +/* long drv_data; /* Driver data. */ +/* HANDLE ready_event; /* The handle for the ready event. */ +{ + int error = 0; /* The error code (assume initially no errors). */ + DWORD bytesRead; /* Number of bytes read. */ + DriverData* dp; + int pb; + + dp = driver_data+(int)drv_data; + pb = dp->packet_bytes; +#ifdef ERTS_SMP + if(dp->in.thread == (HANDLE) -1) { + dp->in.async_io_active = 0; + } +#endif + DEBUGF(("ready_input: dp %p, event 0x%x\n", dp, ready_event)); + + /* + * Evaluate the result of the overlapped read. + */ + +#ifdef HARD_POLL_DEBUG + poll_debug_read_begin(dp->in.ov.hEvent); +#endif + + error = get_overlapped_result(&dp->in, &bytesRead, TRUE); + +#ifdef HARD_POLL_DEBUG + poll_debug_read_done(dp->in.ov.hEvent,bytesRead); +#endif + + if (error == NO_ERROR) { + if (pb == 0) { /* Continous stream. */ +#ifdef DEBUG + DEBUGF(("ready_input: %d: ", bytesRead)); + erl_bin_write(dp->inbuf, 16, bytesRead); + DEBUGF(("\n")); +#endif + driver_output(dp->port_num, dp->inbuf, bytesRead); + } else { /* Packet mode */ + dp->bytesInBuffer += bytesRead; + + /* + * Loop until we've exhausted the data in the buffer. + */ + + for (;;) { + + /* + * Check for completion of a header read. + */ + + if (dp->bytesInBuffer >= dp->totalNeeded && + dp->totalNeeded == pb) { + + /* + * We have successfully read the packet header + * (and perhaps even the packet). Get the packet size + * from the header and update dp->totalNeeded to include + * the packet size. + */ + + int packet_size = 0; + unsigned char *header = (unsigned char *) dp->inbuf; + + switch (pb) { + case 4: + packet_size = (packet_size << 8) | *header++; + packet_size = (packet_size << 8) | *header++; + case 2: + packet_size = (packet_size << 8) | *header++; + case 1: + packet_size = (packet_size << 8) | *header++; + } + + dp->totalNeeded += packet_size; + + /* + * Make sure that the receive buffer is big enough. + */ + + if (dp->inBufSize < dp->totalNeeded) { + char* new_buf; + + new_buf = DRV_BUF_REALLOC(dp->inbuf, dp->totalNeeded); + if (new_buf == NULL) { + error = ERROR_NOT_ENOUGH_MEMORY; + break; /* Break out of loop into error handler. */ + } + ASSERT(erts_smp_atomic_read(&sys_misc_mem_sz) >= dp->inBufSize); + erts_smp_atomic_add(&sys_misc_mem_sz, + dp->totalNeeded - dp->inBufSize); + dp->inBufSize = dp->totalNeeded; + dp->inbuf = new_buf; + } + } + + /* + * Check for completion of a packet read. + */ + + if (dp->bytesInBuffer < dp->totalNeeded) { + /* + * Not enough bytes in the buffer. Break out of + * the loop and initiate a new read. + */ + + break; + } else { + + /* + * We have successfully read a complete packet, which + * can be passed to Erlang. + */ + + driver_output(dp->port_num, dp->inbuf+pb, dp->totalNeeded-pb); + + /* + * Update the number of bytes remaining in the buffer, + * and move the data remaining (if any) to the beginning + * of the buffer. + */ + + dp->bytesInBuffer -= dp->totalNeeded; + if (dp->bytesInBuffer > 0) { + memmove(dp->inbuf, dp->inbuf+dp->totalNeeded, + dp->bytesInBuffer); + } + + /* + * Indicate that we need the size of a header, and + * go through the loop once more (to either process + * remaining bytes or initiate reading more). + */ + + dp->totalNeeded = pb; + } + } + } + } + + /* + * Start a new overlapped read, or report the error. + */ + + if (error == NO_ERROR) { + async_read_file(&dp->in, dp->inbuf+dp->bytesInBuffer, + dp->inBufSize - dp->bytesInBuffer); + } else { + DEBUGF(("ready_input(): error: %s\n", win32_errorstr(error))); + if (error == ERROR_BROKEN_PIPE || error == ERROR_HANDLE_EOF) { + /* Maybe check exit status */ + if (dp->report_exit) { + DWORD exitcode; + if (GetExitCodeProcess(dp->port_pid, &exitcode) && + exitcode != STILL_ACTIVE) { + driver_report_exit(dp->port_num, exitcode); + } + } + driver_failure_eof(dp->port_num); + } else { /* Report real errors. */ + int error = GetLastError(); + (void) driver_select(dp->port_num, ready_event, ERL_DRV_READ, 0); + _dosmaperr(error); + driver_failure_posix(dp->port_num, errno); + } + } + + /*return 0;*/ +} + +static void +ready_output(ErlDrvData drv_data, ErlDrvEvent ready_event) +{ + DWORD bytesWritten; + DriverData* dp = driver_data + (int)drv_data; + int error; + +#ifdef ERTS_SMP + if(dp->out.thread == (HANDLE) -1) { + dp->out.async_io_active = 0; + } +#endif + DEBUGF(("ready_output(%d, 0x%x)\n", drv_data, ready_event)); + set_busy_port(dp->port_num, 0); + if (!(dp->outbuf)) { + /* Happens because event sometimes get signalled during a succesful + write... */ + return; + } + ASSERT(erts_smp_atomic_read(&sys_misc_mem_sz) >= dp->outBufSize); + erts_smp_atomic_add(&sys_misc_mem_sz, -1*dp->outBufSize); + DRV_BUF_FREE(dp->outbuf); + dp->outBufSize = 0; + dp->outbuf = NULL; +#ifdef HARD_POLL_DEBUG + poll_debug_write_begin(dp->out.ov.hEvent); +#endif + error = get_overlapped_result(&dp->out, &bytesWritten, TRUE); +#ifdef HARD_POLL_DEBUG + poll_debug_write_done(dp->out.ov.hEvent,bytesWritten); +#endif + + if (error == NO_ERROR) { + dp->out.ov.Offset += bytesWritten; /* For vanilla driver. */ + return ; /* 0; */ + } + + (void) driver_select(dp->port_num, ready_event, ERL_DRV_WRITE, 0); + _dosmaperr(error); + driver_failure_posix(dp->port_num, errno); + /* return 0; */ +} + +static void stop_select(ErlDrvEvent e, void* _) +{ + CloseHandle((HANDLE)e); +} + +/* Fills in the systems representation of the beam process identifier. +** The Pid is put in STRING representation in the supplied buffer, +** no interpretation of this should be done by the rest of the +** emulator. The buffer should be at least 21 bytes long. +*/ +void sys_get_pid(char *buffer){ + DWORD p = GetCurrentProcessId(); + /* The pid is scalar and is an unsigned long. */ + sprintf(buffer,"%lu",(unsigned long) p); +} + +void +sys_init_io(void) +{ + + /* Now heres an icky one... This is called before drivers are, so we + can change our view of the number of open files possible. + We estimate the number to twice the amount of ports. + We really dont know on windows, do we? */ + max_files = 2*erts_max_ports; + +#ifdef USE_THREADS +#ifdef ERTS_SMP + if (init_async(-1) < 0) + erl_exit(1, "Failed to initialize async-threads\n"); +#else + { + /* This is special stuff, starting a driver from the + * system routines, but is a nice way of handling stuff + * the erlang way + */ + SysDriverOpts dopts; + int ret; + + sys_memset((void*)&dopts, 0, sizeof(SysDriverOpts)); + add_driver_entry(&async_driver_entry); + ret = erts_open_driver(NULL, NIL, "async", &dopts, NULL); + DEBUGF(("open_driver = %d\n", ret)); + if (ret < 0) + erl_exit(1, "Failed to open async driver\n"); + erts_port[ret].status |= ERTS_PORT_SFLG_IMMORTAL; + } +#endif +#endif +} + +#ifdef ERTS_SMP +void +erts_sys_main_thread(void) +{ + HANDLE dummy; +#ifdef ERTS_ENABLE_LOCK_CHECK + erts_lc_set_thread_name("parent_thread"); +#endif + dummy = CreateEvent(NULL, FALSE, FALSE, NULL); + for(;;) { + WaitForSingleObject(dummy, INFINITE); + } +} +#endif + +void erts_sys_alloc_init(void) +{ + elib_ensure_initialized(); +} + +void *erts_sys_alloc(ErtsAlcType_t t, void *x, Uint sz) +{ + return malloc((size_t) sz); +} + +void *erts_sys_realloc(ErtsAlcType_t t, void *x, void *p, Uint sz) +{ + return realloc(p, (size_t) sz); +} + +void erts_sys_free(ErtsAlcType_t t, void *x, void *p) +{ + free(p); +} + +static Preload* preloaded = NULL; +static unsigned* res_name = NULL; +static int num_preloaded = 0; + +/* Return a pointer to a vector of names of preloaded modules */ + +Preload* sys_preloaded(void) +{ + HRSRC hRes; + unsigned char* data; + +#define GETWORD(p) (0[p] | 1[p] << 8) +#define GETDWORD(p) (GETWORD(p) | GETWORD(p+2) << 16) + + + if (preloaded == NULL) { + int i; + ASSERT(beam_module != NULL); + hRes = FindResource(beam_module, 0, "ERLANG_DICT"); + /* We might have a resource compiler laying out the 0 resource with + "0" as a textual name instead... */ + if (hRes == NULL) { + hRes = FindResource(beam_module, "0", "ERLANG_DICT"); + } + if (hRes == NULL) { + DWORD n = GetLastError(); + fprintf(stderr, "No ERLANG_DICT resource\n"); + exit(1); + } + data = (unsigned char *) LoadResource(beam_module, hRes); + + num_preloaded = GETWORD(data); + if (num_preloaded == 0) { + fprintf(stderr, "No preloaded modules\n"); + exit(1); + } + + data += 2; + preloaded = erts_alloc(ERTS_ALC_T_PRELOADED, + (num_preloaded+1)*sizeof(Preload)); + res_name = erts_alloc(ERTS_ALC_T_PRELOADED, + (num_preloaded+1)*sizeof(unsigned)); + erts_smp_atomic_add(&sys_misc_mem_sz, + (num_preloaded+1)*sizeof(Preload) + + (num_preloaded+1)*sizeof(unsigned)); + for (i = 0; i < num_preloaded; i++) { + int n; + + preloaded[i].size = GETDWORD(data); + data += 4; + res_name[i] = GETWORD(data); + data += 2; + n = GETWORD(data); + data += 2; + preloaded[i].name = erts_alloc(ERTS_ALC_T_PRELOADED, n+1); + erts_smp_atomic_add(&sys_misc_mem_sz, n+1); + sys_memcpy(preloaded[i].name, data, n); + preloaded[i].name[n] = '\0'; + data += n; + DEBUGF(("name: %s; size: %d; resource: %p\n", + preloaded[i].name, preloaded[i].size, res_name[i])); + } + preloaded[i].name = NULL; + } + +#undef GETWORD +#undef GETDWORD + return preloaded; +} + +/* Return a pointer to preloaded code for module "module" */ +unsigned char* sys_preload_begin(Preload* pp) +{ + HRSRC hRes; + unsigned resource; + + ASSERT(beam_module != NULL); + + resource = res_name[pp-preloaded]; + DEBUGF(("Loading name: %s; size: %d; resource: %p\n", + pp->name, pp->size, resource)); + hRes = FindResource(beam_module, (char *) resource, "ERLANG_CODE"); + return pp->code = LoadResource(beam_module, hRes); +} + +/* Clean up if allocated */ +void sys_preload_end(Preload* pp) +{ +} + +/* Read a key from console */ + +int +sys_get_key(int fd) +{ + ASSERT(fd == 0); + + if (win_console) { + return ConGetKey(); + } + + /* + * Black magic follows. (Code stolen from get_overlapped_result()) + */ + + if (fd_driver_input != NULL && fd_driver_input->thread != (HANDLE)-1) { + DWORD error; + int key; + + error = WaitForSingleObject(fd_driver_input->ov.hEvent, INFINITE); + if (error == WAIT_OBJECT_0) { + if (fd_driver_input->bytesTransferred > 0) { + int n; + int i; + char* buf = OV_BUFFER_PTR(fd_driver_input); + + fd_driver_input->bytesTransferred--; + n = fd_driver_input->bytesTransferred; + key = buf[0]; + for (i = n; i > 0; i--) { + buf[i-1] = buf[i]; + } + return key; + } + } + } + return '*'; /* Error! */ +} + +/* + * Returns a human-readable description of the last error. + * The returned pointer will be valid only as long as last-error() + * isn't called again. + */ + +char* win32_errorstr(int error) +{ +#ifdef SMP + LPTSTR lpBufPtr = erts_smp_tsd_get(win32_errstr_key); +#else + static LPTSTR lpBufPtr = NULL; +#endif + if (lpBufPtr) { + LocalFree(lpBufPtr); + } + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | + FORMAT_MESSAGE_IGNORE_INSERTS, + NULL, + error, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &lpBufPtr, + 0, + NULL); + SetLastError(error); +#ifdef ERTS_SMP + erts_smp_tsd_set(win32_errstr_key,lpBufPtr); +#endif + return lpBufPtr; +} + +char* last_error(void) +{ + return win32_errorstr(GetLastError()); +} + +static void* sys_func_memzero(void* s, size_t n) +{ + return sys_memzero(s, n); +} + +#ifdef DEBUG +static HANDLE hDebugWrite = INVALID_HANDLE_VALUE; + +void erl_debug(char *fmt,...) +{ + char sbuf[1024]; /* Temporary buffer. */ + DWORD written; /* Actual number of chars written. */ + va_list va; + + if (hDebugWrite != INVALID_HANDLE_VALUE) { + va_start(va, fmt); + vsprintf(sbuf, fmt, va); + WriteFile(hDebugWrite, sbuf, strlen(sbuf), &written, NULL); + va_end(va); + } +} + +static void debug_console(void) +{ + HANDLE hRead; /* Handle to read end of pipe. */ + SECURITY_ATTRIBUTES sa; + PROCESS_INFORMATION procInfo; + STARTUPINFO startInfo; + BOOL ok; + + /* + * Create a pipe for communicating with the sub process. + */ + + sa.nLength = sizeof(sa); + sa.lpSecurityDescriptor = NULL; + sa.bInheritHandle = TRUE; + if (!CreatePipe(&hRead, &hDebugWrite, &sa, 0)) { + fprintf(stderr, "Failed to create pipe: %d\n", + GetLastError()); + exit(1); + } + + startInfo.cb = sizeof(STARTUPINFO); + startInfo.lpTitle = "Erlang Debug Log"; + startInfo.lpReserved = NULL; + startInfo.lpReserved2 = NULL; + startInfo.cbReserved2 = 0; + startInfo.lpDesktop = NULL; + startInfo.dwFlags = STARTF_USESTDHANDLES; + startInfo.hStdInput = hRead; + + /* The following handles are not intended to be used. */ + startInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + startInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE); + + ok = CreateProcess(NULL, + "erl_log.exe", /* Application */ + NULL, /* Process security attributes. */ + NULL, /* Thread security attributes. */ + TRUE, /* Handle inheritance flag. */ + CREATE_NEW_CONSOLE, /* Flags. */ + NULL, /* Environment. */ + NULL, /* Current directory. */ + &startInfo,/* Startup info. */ + &procInfo /* Process information. */ + ); + + CloseHandle(hRead); + + if (ok) { + /* + * Since we don't use these, close them at once to avoid a resource + * leak. + */ + CloseHandle(procInfo.hProcess); + CloseHandle(procInfo.hThread); + } else { + fprintf(stderr, "Create process failed: %s\n", last_error()); + exit(1); + } +} + +void +erl_bin_write(buf, sz, max) + unsigned char* buf; + int sz; + int max; +{ + int i, imax; + char comma[5] = ","; + + if (hDebugWrite == INVALID_HANDLE_VALUE) + return; + + if (!sz) + return; + if (sz > max) + imax = max; + else + imax = sz; + + for (i=0; i max) + strcpy(comma, ",..."); + else + comma[0] = 0; + } + if (isdigit(buf[i])) + erl_debug("%u%s", (int)(buf[i]), comma); + else { + if (isalpha(buf[i])) { + erl_debug("%c%s", buf[i], comma); + } + else + erl_debug("%u%s", (int)(buf[i]), comma); + } + } +} + +void +erl_assert_error(char* expr, char* file, int line) +{ + char message[1024]; + + sprintf(message, "File %hs, line %d: %hs", file, line, expr); + MessageBox(GetActiveWindow(), message, "Assertion failed", + MB_OK | MB_ICONERROR); +#if 0 + erl_crash_dump(file, line, "Assertion failed: %hs\n", expr); +#endif + DebugBreak(); +} + +#endif /* DEBUG */ + +static void +check_supported_os_version(void) +{ +#if defined(_WIN32_WINNT) + { + DWORD major = (_WIN32_WINNT >> 8) & 0xff; + DWORD minor = _WIN32_WINNT & 0xff; + + if (int_os_version.dwPlatformId != VER_PLATFORM_WIN32_NT + || int_os_version.dwMajorVersion < major + || (int_os_version.dwMajorVersion == major + && int_os_version.dwMinorVersion < minor)) + erl_exit(-1, + "Windows version not supported " + "(min required: winnt %d.%d)\n", + major, minor); + } +#else + erl_exit(-1, + "Windows version not supported " + "(min required: win %d.%d)\n", + nt_major, nt_minor); +#endif +} + +#ifdef USE_THREADS +static void *ethr_internal_alloc(size_t size) +{ + return erts_alloc_fnf(ERTS_ALC_T_ETHR_INTERNAL, (Uint) size); +} +static void *ethr_internal_realloc(void *ptr, size_t size) +{ + return erts_realloc_fnf(ERTS_ALC_T_ETHR_INTERNAL, ptr, (Uint) size); +} +static void ethr_internal_free(void *ptr) +{ + erts_free(ERTS_ALC_T_ETHR_INTERNAL, ptr); +} +#endif + +void +erts_sys_pre_init(void) +{ + int_os_version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + GetVersionEx(&int_os_version); + check_supported_os_version(); +#ifdef USE_THREADS + { + erts_thr_init_data_t eid = ERTS_THR_INIT_DATA_DEF_INITER; + eid.alloc = ethr_internal_alloc; + eid.realloc = ethr_internal_realloc; + eid.free = ethr_internal_free; + erts_thr_init(&eid); +#ifdef ERTS_ENABLE_LOCK_COUNT + erts_lcnt_init(); +#endif + } +#endif + erts_smp_atomic_init(&sys_misc_mem_sz, 0); + erts_sys_env_init(); +} + +/* + * the last two only used for standalone erlang + * they should are used by sae_main in beam dll to + * enable standalone execution via erl_api-routines + */ + +void noinherit_std_handle(DWORD type) +{ + HANDLE h = GetStdHandle(type); + if (h != 0 && h != INVALID_HANDLE_VALUE) { + SetHandleInformation(h,HANDLE_FLAG_INHERIT,0); + } +} + + +void erl_sys_init(void) +{ + HANDLE handle; + + noinherit_std_handle(STD_OUTPUT_HANDLE); + noinherit_std_handle(STD_INPUT_HANDLE); + noinherit_std_handle(STD_ERROR_HANDLE); + + + erts_smp_mtx_init(&sys_driver_data_lock, "sys_driver_data_lock"); + +#ifdef ERTS_SMP + erts_smp_tsd_key_create(&win32_errstr_key); +#endif + erts_smp_atomic_init(&pipe_creation_counter,0); + /* + * Test if we have named pipes or not. + */ + + switch (int_os_version.dwPlatformId) { + case VER_PLATFORM_WIN32_WINDOWS: + DEBUGF(("Running on Windows 95")); + use_named_pipes = FALSE; + break; + case VER_PLATFORM_WIN32_NT: + DEBUGF(("Running on Windows NT")); +#ifdef DISABLE_NAMED_PIPES + use_named_pipes = FALSE; +#else + use_named_pipes = TRUE; +#endif + break; + default: /* Unsupported platform. */ + exit(1); + } + DEBUGF((" %d.%d, build %d, %s\n", + int_os_version.dwMajorVersion, int_os_version.dwMinorVersion, + int_os_version.dwBuildNumber, int_os_version.szCSDVersion)); + + ASSERT(beam_module != NULL); + init_console(); + + /* + * The following makes sure that the current directory for the current drive + * is remembered (in the environment). + */ + + chdir("."); + + /* + * Make sure that the standard error handle is valid. + */ + handle = GetStdHandle(STD_ERROR_HANDLE); + if (handle == INVALID_HANDLE_VALUE || handle == 0) { + SetStdHandle(STD_ERROR_HANDLE, GetStdHandle(STD_OUTPUT_HANDLE)); + } + erts_sys_init_float(); + erts_init_check_io(); + + /* Suppress windows error message popups */ + SetErrorMode(SetErrorMode(0) | + SEM_FAILCRITICALERRORS | SEM_NOOPENFILEERRORBOX); +} + +#ifdef ERTS_SMP +void +erts_sys_schedule_interrupt(int set) +{ + erts_check_io_interrupt(set); +} + +void +erts_sys_schedule_interrupt_timed(int set, long msec) +{ + erts_check_io_interrupt_timed(set, msec); +} +#endif + +/* + * Called from schedule() when it runs out of runnable processes, + * or when Erlang code has performed INPUT_REDUCTIONS reduction + * steps. runnable == 0 iff there are no runnable Erlang processes. + */ +void +erl_sys_schedule(int runnable) +{ +#ifdef ERTS_SMP + erts_check_io(!runnable); + ERTS_SMP_LC_ASSERT(!ERTS_LC_IS_BLOCKING); +#else + erts_check_io_interrupt(0); + if (runnable) { + erts_check_io(0); /* Poll for I/O */ + check_async_ready(); /* Check async completions */ + } else { + erts_check_io(check_async_ready() ? 0 : 1); + } +#endif +} + +#if defined(USE_THREADS) && !defined(ERTS_SMP) +/* + * Async operation support. + */ + +static ErlDrvEvent async_drv_event; + +void +sys_async_ready(int fd) +{ + SetEvent((HANDLE)async_drv_event); +} + +static int +async_drv_init(void) +{ + async_drv_event = (ErlDrvEvent) NULL; + return 0; +} + +static ErlDrvData +async_drv_start(ErlDrvPort port_num, char* name, SysDriverOpts* opts) +{ + if (async_drv_event != (ErlDrvEvent) NULL) { + return ERL_DRV_ERROR_GENERAL; + } + if ((async_drv_event = (ErlDrvEvent)CreateAutoEvent(FALSE)) == (ErlDrvEvent) NULL) { + return ERL_DRV_ERROR_GENERAL; + } + + driver_select(port_num, async_drv_event, ERL_DRV_READ|ERL_DRV_USE, 1); + if (init_async(async_drv_event) < 0) { + return ERL_DRV_ERROR_GENERAL; + } + return (ErlDrvData)port_num; +} + +static void +async_drv_stop(ErlDrvData port_num) +{ + exit_async(); + driver_select((ErlDrvPort)port_num, async_drv_event, ERL_DRV_READ|ERL_DRV_USE, 0); + /*CloseHandle((HANDLE)async_drv_event);*/ + async_drv_event = (ErlDrvEvent) NULL; +} + + +static void +async_drv_input(ErlDrvData port_num, ErlDrvEvent e) +{ + check_async_ready(); + + /* + * Our event is auto-resetting. + */ +} + +#endif + diff --git a/erts/emulator/sys/win32/sys_env.c b/erts/emulator/sys/win32/sys_env.c new file mode 100644 index 0000000000..ac4be3f316 --- /dev/null +++ b/erts/emulator/sys/win32/sys_env.c @@ -0,0 +1,261 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_sys_driver.h" +#include "erl_alloc.h" + +static char* merge_environment(char *current, char *add); +static char* arg_to_env(char **arg); +static char** env_to_arg(char *env); +static char** find_arg(char **arg, char *str); +static int compare(const void *a, const void *b); + +static erts_smp_rwmtx_t environ_rwmtx; + +void +erts_sys_env_init(void) +{ + erts_smp_rwmtx_init(&environ_rwmtx, "environ"); +} + +int +erts_sys_putenv(char *key_value, int sep_ix) +{ + int res; + char sep = key_value[sep_ix]; + ASSERT(sep == '='); + key_value[sep_ix] = '\0'; + erts_smp_rwmtx_rwlock(&environ_rwmtx); + res = (SetEnvironmentVariable((LPCTSTR) key_value, + (LPCTSTR) &key_value[sep_ix+1]) ? 0 : 1); + erts_smp_rwmtx_rwunlock(&environ_rwmtx); + key_value[sep_ix] = sep; + return res; +} + +int +erts_sys_getenv(char *key, char *value, size_t *size) +{ + size_t req_size = 0; + int res = 0; + DWORD new_size; + + erts_smp_rwmtx_rlock(&environ_rwmtx); + SetLastError(0); + new_size = GetEnvironmentVariable((LPCTSTR) key, + (LPTSTR) value, + (DWORD) *size); + res = !new_size && GetLastError() == ERROR_ENVVAR_NOT_FOUND ? -1 : 0; + erts_smp_rwmtx_runlock(&environ_rwmtx); + if (res < 0) + return res; + res = new_size > *size ? 1 : 0; + *size = new_size; + return res; +} + +struct win32_getenv_state { + char *env; + char *next; +}; + + +void init_getenv_state(GETENV_STATE *state) +{ + erts_smp_rwmtx_rlock(&environ_rwmtx); + state->environment_strings = (char *) GetEnvironmentStrings(); + state->next_string = state->environment_strings; +} + +char *getenv_string(GETENV_STATE *state) +{ + ERTS_SMP_LC_ASSERT(erts_smp_lc_rwmtx_is_rlocked(&environ_rwmtx)); + if (state->next_string[0] == '\0') + return NULL; + else { + char *res = state->next_string; + state->next_string += sys_strlen(res) + 1; + return res; + } +} + +void fini_getenv_state(GETENV_STATE *state) +{ + FreeEnvironmentStrings(state->environment_strings); + state->environment_strings = state->next_string = NULL; + erts_smp_rwmtx_runlock(&environ_rwmtx); +} + +char* +win_build_environment(char* new_env) +{ + if (new_env == NULL) { + return NULL; + } else { + char *tmp, *merged; + + erts_smp_rwmtx_rlock(&environ_rwmtx); + tmp = GetEnvironmentStrings(); + merged = merge_environment(tmp, new_env); + + FreeEnvironmentStrings(tmp); + erts_smp_rwmtx_runlock(&environ_rwmtx); + return merged; + } +} + +static char* +merge_environment(char *old, char *add) +{ + char **a_arg = env_to_arg(add); + char **c_arg = env_to_arg(old); + char *ret; + int i, j; + + for(i = 0; c_arg[i] != NULL; ++i) + ; + + for(j = 0; a_arg[j] != NULL; ++j) + ; + + c_arg = erts_realloc(ERTS_ALC_T_TMP, + c_arg, (i+j+1) * sizeof(char *)); + + for(j = 0; a_arg[j] != NULL; ++j){ + char **tmp; + char *current = a_arg[j]; + + if ((tmp = find_arg(c_arg, current)) != NULL) { + if (current[strlen(current)-1] != '=') { + *tmp = current; + } else { + *tmp = c_arg[--i]; + c_arg[i] = NULL; + } + } else if (current[strlen(current)-1] != '=') { + c_arg[i++] = current; + c_arg[i] = NULL; + } + } + ret = arg_to_env(c_arg); + erts_free(ERTS_ALC_T_TMP, c_arg); + erts_free(ERTS_ALC_T_TMP, a_arg); + return ret; +} + +static char** +find_arg(char **arg, char *str) +{ + char *tmp; + int len; + + if ((tmp = strchr(str, '=')) != NULL) { + tmp++; + len = tmp - str; + while (*arg != NULL){ + if (_strnicmp(*arg, str, len) == 0){ + return arg; + } + ++arg; + } + } + return NULL; +} + +static int +compare(const void *a, const void *b) +{ + char *s1 = *((char **) a); + char *s2 = *((char **) b); + char *e1 = strchr(s1,'='); + char *e2 = strchr(s2,'='); + int ret; + int len; + + if(!e1) + e1 = s1 + strlen(s1); + if(!e2) + e2 = s2 + strlen(s2); + + if((e1 - s1) > (e2 - s2)) + len = (e2 - s2); + else + len = (e1 - s1); + + ret = _strnicmp(s1,s2,len); + if (ret == 0) + return ((e1 - s1) - (e2 - s2)); + else + return ret; +} + +static char** +env_to_arg(char *env) +{ + char **ret; + char *tmp; + int i; + int num_strings = 0; + + for(tmp = env; *tmp != '\0'; tmp += strlen(tmp)+1) { + ++num_strings; + } + ret = erts_alloc(ERTS_ALC_T_TMP, sizeof(char *) * (num_strings + 1)); + i = 0; + for(tmp = env; *tmp != '\0'; tmp += strlen(tmp)+1){ + ret[i++] = tmp; + } + ret[i] = NULL; + return ret; +} + +static char* +arg_to_env(char **arg) +{ + char *block; + char *ptr; + int i; + int totlen = 1; /* extra '\0' */ + + for(i = 0; arg[i] != NULL; ++i) { + totlen += strlen(arg[i])+1; + } + + /* sort the environment vector */ + qsort(arg, i, sizeof(char *), &compare); + + if (totlen == 1){ + block = erts_alloc(ERTS_ALC_T_ENVIRONMENT, 2); + block[0] = block[1] = '\0'; + } else { + block = erts_alloc(ERTS_ALC_T_ENVIRONMENT, totlen); + ptr = block; + for(i=0; arg[i] != NULL; ++i){ + strcpy(ptr, arg[i]); + ptr += strlen(ptr)+1; + } + *ptr = '\0'; + } + return block; +} diff --git a/erts/emulator/sys/win32/sys_float.c b/erts/emulator/sys/win32/sys_float.c new file mode 100644 index 0000000000..9e67ca7f48 --- /dev/null +++ b/erts/emulator/sys/win32/sys_float.c @@ -0,0 +1,145 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* Float conversions */ + +#include "sys.h" +#include "signal.h" + +/* global variable for floating point checks, (see sys.h) */ +/* Note! This is part of the interface Machine <---> sys.c */ +volatile int erl_fp_exception = 0; + +static void fpe_exception(int sig); + +void +erts_sys_init_float(void) +{ +} +void erts_thread_init_float(void) +{ +} +void erts_thread_disable_fpe(void) +{ +} + +/* + ** These two functions should maybe use localeconv() to pick up + ** the current radix character, but since it is uncertain how + ** expensive such a system call is, and since no-one has heard + ** of other radix characters than '.' and ',' an ad-hoc + ** low execution time solution is used instead. + */ + +int +sys_chars_to_double(char *buf, double *fp) +{ + char *s = buf, *t, *dp; + + /* Robert says that something like this is what he really wanted: + * (The [.,] radix test is NOT what Robert wanted - it was added later) + * + * 7 == sscanf(Tbuf, "%[+-]%[0-9][.,]%[0-9]%[eE]%[+-]%[0-9]%s", ....); + * if (*s2 == 0 || *s3 == 0 || *s4 == 0 || *s6 == 0 || *s7) + * break; + */ + + /* Scan string to check syntax. */ + if (*s == '+' || *s == '-') s++; + if (!isdigit(*s)) /* Leading digits. */ + return -1; + while (isdigit(*s)) s++; + if (*s != '.' && *s != ',')/* Decimal part. */ + return -1; + dp = s++; /* Remember decimal point pos just in case */ + if (!isdigit(*s)) + return -1; + while (isdigit(*s)) s++; + if (*s == 'e' || *s == 'E') { + /* There is an exponent. */ + s++; + if (*s == '+' || *s == '-') s++; + if (!isdigit(*s)) + return -1; + while (isdigit(*s)) s++; + } + if (*s) /* That should be it */ + return -1; + + errno = 0; + *fp = strtod(buf, &t); + if (t != s) { /* Whole string not scanned */ + /* Try again with other radix char */ + *dp = (*dp == '.') ? ',' : '.'; + errno = 0; + *fp = strtod(buf, &t); + if (t != s) { /* Whole string not scanned */ + return -1; + } + } + if (*fp < -1.0e-307 || 1.0e-307 < *fp) { + if (errno == ERANGE) { + return -1; + } + } else { + if (errno == ERANGE) { + /* Special case: Windows (at least some) regard very small + * i.e non-normalized numbers as a range error for strtod(). + * But not for atof. + */ + *fp = atof(buf); + } + } + + return 0; +} + +/* +** Convert a double to ascii format 0.dddde[+|-]ddd +** return number of characters converted +*/ + +int +sys_double_to_chars(double fp, char *buf) +{ + char *s = buf; + + (void) sprintf(buf, "%.20e", fp); + /* Search upto decimal point */ + if (*s == '+' || *s == '-') s++; + while (isdigit(*s)) s++; + if (*s == ',') *s++ = '.'; /* Replace ',' with '.' */ + /* Scan to end of string */ + while (*s) s++; + return s-buf; /* i.e strlen(buf) */ +} + +int +matherr(struct _exception *exc) +{ + erl_fp_exception = 1; + DEBUGF(("FP exception (matherr) (0x%x) (%d)\n", exc->type, erl_fp_exception)); + return 1; +} + +static void +fpe_exception(int sig) +{ + erl_fp_exception = 1; + DEBUGF(("FP exception\n")); +} diff --git a/erts/emulator/sys/win32/sys_interrupt.c b/erts/emulator/sys/win32/sys_interrupt.c new file mode 100644 index 0000000000..d2449a1bdb --- /dev/null +++ b/erts/emulator/sys/win32/sys_interrupt.c @@ -0,0 +1,142 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: Interrupt handling in windows. + */ +#include "sys.h" +#include "erl_alloc.h" +#include "erl_driver.h" +#include "../../drivers/win32/win_con.h" + +#if defined(__GNUC__) +# define WIN_SYS_INLINE __inline__ +#elif defined(__WIN32__) +# define WIN_SYS_INLINE __forceinline +#endif + +#ifdef ERTS_SMP +erts_smp_atomic_t erts_break_requested; +#define ERTS_SET_BREAK_REQUESTED \ + erts_smp_atomic_set(&erts_break_requested, (long) 1) +#define ERTS_UNSET_BREAK_REQUESTED \ + erts_smp_atomic_set(&erts_break_requested, (long) 0) +#else +volatile int erts_break_requested = 0; +#define ERTS_SET_BREAK_REQUESTED (erts_break_requested = 1) +#define ERTS_UNSET_BREAK_REQUESTED (erts_break_requested = 0) +#endif + +extern int nohup; +HANDLE erts_sys_break_event = NULL; + +void erts_do_break_handling(void) +{ + /* + * Most functions that do_break() calls are intentionally not thread safe; + * therefore, make sure that all threads but this one are blocked before + * proceeding! + */ + erts_smp_block_system(0); + /* call the break handling function, reset the flag */ + do_break(); + + ResetEvent(erts_sys_break_event); + ERTS_UNSET_BREAK_REQUESTED; + + erts_smp_release_system(); +} + + +BOOL WINAPI ctrl_handler_ignore_break(DWORD dwCtrlType) +{ + switch (dwCtrlType) { + case CTRL_C_EVENT: + case CTRL_BREAK_EVENT: + return TRUE; + break; + case CTRL_LOGOFF_EVENT: + if (nohup) + return TRUE; + /* else pour through... */ + case CTRL_CLOSE_EVENT: + case CTRL_SHUTDOWN_EVENT: + erl_exit(0, ""); + break; + } + return TRUE; +} + +void erts_set_ignore_break(void) { + ConSetCtrlHandler(ctrl_handler_ignore_break); + SetConsoleCtrlHandler(ctrl_handler_ignore_break, TRUE); +} + +BOOL WINAPI ctrl_handler_replace_intr(DWORD dwCtrlType) +{ + switch (dwCtrlType) { + case CTRL_C_EVENT: + return FALSE; + case CTRL_BREAK_EVENT: + SetEvent(erts_sys_break_event); + break; + case CTRL_LOGOFF_EVENT: + if (nohup) + return TRUE; + /* else pour through... */ + case CTRL_CLOSE_EVENT: + case CTRL_SHUTDOWN_EVENT: + erl_exit(0, ""); + break; + } + return TRUE; +} + + +/* Don't use ctrl-c for break handler but let it be + used by the shell instead (see user_drv.erl) */ +void erts_replace_intr(void) { + ConSetCtrlHandler(ctrl_handler_replace_intr); + SetConsoleCtrlHandler(ctrl_handler_replace_intr, TRUE); +} + +BOOL WINAPI ctrl_handler(DWORD dwCtrlType) +{ + switch (dwCtrlType) { + case CTRL_C_EVENT: + case CTRL_BREAK_EVENT: + SetEvent(erts_sys_break_event); + break; + case CTRL_LOGOFF_EVENT: + if (nohup) + return TRUE; + /* else pour through... */ + case CTRL_CLOSE_EVENT: + case CTRL_SHUTDOWN_EVENT: + erl_exit(0, ""); + break; + } + return TRUE; +} + +void init_break_handler() +{ + ConSetCtrlHandler(ctrl_handler); + SetConsoleCtrlHandler(ctrl_handler, TRUE); +} + diff --git a/erts/emulator/sys/win32/sys_time.c b/erts/emulator/sys/win32/sys_time.c new file mode 100644 index 0000000000..50e43065b5 --- /dev/null +++ b/erts/emulator/sys/win32/sys_time.c @@ -0,0 +1,96 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: System-dependent time functions. + */ + +#include "sys.h" +#include "assert.h" + +#ifdef __GNUC__ +#define LL_LITERAL(X) X##LL +#else +#define LL_LITERAL(X) X##i64 +#endif + +/******************* Routines for time measurement *********************/ + +#define EPOCH_JULIAN_DIFF LL_LITERAL(11644473600) + +static SysHrTime wrap = 0; +static DWORD last_tick_count = 0; + +int +sys_init_time(void) +{ + return 1; +} + +void +sys_gettimeofday(SysTimeval *tv) +{ + SYSTEMTIME t; + FILETIME ft; + LONGLONG lft; + + GetSystemTime(&t); + SystemTimeToFileTime(&t, &ft); + memcpy(&lft, &ft, sizeof(lft)); + tv->tv_usec = (long) ((lft / LL_LITERAL(10)) % LL_LITERAL(1000000)); + tv->tv_sec = (long) ((lft / LL_LITERAL(10000000)) - EPOCH_JULIAN_DIFF); +} + +SysHrTime +sys_gethrtime(void) +{ + DWORD ticks = (SysHrTime) (GetTickCount() & 0x7FFFFFFF); + if (ticks < (SysHrTime) last_tick_count) { + wrap += LL_LITERAL(1) << 31; + } + last_tick_count = ticks; + return ((((LONGLONG) ticks) + wrap) * LL_LITERAL(1000000)); +} + +clock_t +sys_times(SysTimes *buffer) { + clock_t kernel_ticks = (GetTickCount() / + (1000 / SYS_CLK_TCK)) & 0x7FFFFFFF; + FILETIME dummy; + LONGLONG user; + LONGLONG system; + + buffer->tms_utime = buffer->tms_stime = buffer->tms_cutime = + buffer->tms_cstime = 0; + + if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, + (FILETIME *) &system, (FILETIME *) &user) == 0) + return kernel_ticks; + system /= (LONGLONG)(10000000 / SYS_CLK_TCK); + user /= (LONGLONG)(10000000 / SYS_CLK_TCK); + + buffer->tms_utime = (clock_t) (user & LL_LITERAL(0x7FFFFFFF)); + buffer->tms_stime = (clock_t) (system & LL_LITERAL(0x7FFFFFFF)); + return kernel_ticks; +} + + + + + + diff --git a/erts/emulator/test/Makefile b/erts/emulator/test/Makefile new file mode 100644 index 0000000000..b1374950b2 --- /dev/null +++ b/erts/emulator/test/Makefile @@ -0,0 +1,194 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include $(ERL_TOP)/make/target.mk + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +EBIN = . + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES= \ + a_SUITE \ + after_SUITE \ + alloc_SUITE \ + beam_SUITE \ + beam_literals_SUITE \ + bif_SUITE \ + big_SUITE \ + binary_SUITE \ + bs_bincomp_SUITE \ + bs_bit_binaries_SUITE \ + bs_construct_SUITE \ + bs_match_bin_SUITE \ + bs_match_int_SUITE \ + bs_match_tail_SUITE \ + bs_match_misc_SUITE \ + bs_utf_SUITE \ + busy_port_SUITE \ + call_trace_SUITE \ + code_SUITE \ + crypto_SUITE \ + ddll_SUITE \ + decode_packet_SUITE \ + distribution_SUITE \ + driver_SUITE \ + efile_SUITE \ + erts_debug_SUITE \ + estone_SUITE \ + erl_link_SUITE \ + erl_drv_thread_SUITE \ + evil_SUITE \ + exception_SUITE \ + float_SUITE \ + fun_SUITE \ + fun_r11_SUITE \ + gc_SUITE \ + guard_SUITE \ + hash_SUITE \ + hibernate_SUITE \ + list_bif_SUITE \ + match_spec_SUITE \ + module_info_SUITE \ + monitor_SUITE \ + nested_SUITE \ + nif_SUITE \ + node_container_SUITE \ + nofrag_SUITE \ + num_bif_SUITE \ + obsolete_SUITE \ + op_SUITE \ + port_SUITE \ + port_bif_SUITE \ + process_SUITE \ + pseudoknot_SUITE \ + ref_SUITE \ + register_SUITE \ + save_calls_SUITE \ + send_term_SUITE \ + sensitive_SUITE \ + signal_SUITE \ + statistics_SUITE \ + system_info_SUITE \ + system_profile_SUITE \ + time_SUITE \ + timer_bif_SUITE \ + trace_SUITE \ + trace_bif_SUITE \ + trace_nif_SUITE \ + trace_port_SUITE \ + tuple_SUITE \ + trace_local_SUITE \ + trace_meta_SUITE \ + trace_call_count_SUITE \ + scheduler_SUITE \ + old_scheduler_SUITE \ + z_SUITE \ + old_mod \ + long_timers_test \ + ignore_cores \ + dgawd_handler \ + random_iolist \ + crypto_reference + +NO_OPT= bs_bincomp \ + bs_bit_binaries \ + bs_construct \ + bs_match_bin \ + bs_match_int \ + bs_match_tail \ + bs_match_misc \ + bs_utf + + +NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE) +NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl) + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +EMAKEFILE=Emakefile + +TEST_SPEC_FILES = emulator.spec \ + emulator.spec.win \ + emulator.spec.vxworks \ + emulator.spec.ose +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/emulator_test + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +make_emakefile: $(NO_OPT_ERL_FILES) + # This special rule can be removed when communication with R7B nodes + # is no longer supported. + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) +compressed -o$(EBIN) \ + '*_SUITE_make' > $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) +compressed -o$(EBIN) \ + $(MODULES) >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile +no_copt +no_postopt $(ERL_COMPILE_FLAGS) \ + -o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE) + +tests debug opt: make_emakefile + erl $(ERL_MAKE_FLAGS) -make + +clean: + rm -f $(EMAKEFILE) + rm -f $(TARGET_FILES) + rm -f core *~ + +docs: + +# ---------------------------------------------------- +# Special targets +# ---------------------------------------------------- + +%_no_opt_SUITE.erl: %_SUITE.erl + sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@ + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: + +release_tests_spec: make_emakefile + $(INSTALL_DIR) $(RELSYSDIR) + $(INSTALL_DATA) $(EMAKEFILE) $(TEST_SPEC_FILES) \ + $(ERL_FILES) $(RELSYSDIR) + $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(RELSYSDIR) + chmod -f -R u+w $(RELSYSDIR) + tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) + +release_docs_spec: + diff --git a/erts/emulator/test/a_SUITE.erl b/erts/emulator/test/a_SUITE.erl new file mode 100644 index 0000000000..e9d653a7c4 --- /dev/null +++ b/erts/emulator/test/a_SUITE.erl @@ -0,0 +1,99 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : a_SUITE.erl +%%% Author : Rickard Green +%%% Description : Misc tests that should be run first +%%% +%%% Created : 21 Aug 2006 by Rickard Green +%%%------------------------------------------------------------------- +-module(a_SUITE). + +-include("test_server.hrl"). + +-export([all/1, long_timers/1, pollset_size/1]). + +all(doc) -> + []; +all(suite) -> + [long_timers, pollset_size]. + +long_timers(doc) -> + []; +long_timers(suite) -> + []; +long_timers(Config) when is_list(Config) -> + Dir = ?config(data_dir, Config), + ?line long_timers_test:start(Dir), + ?line {comment, + "Testcase started! This test will run in parallel with the " + "erts testsuite and ends in the z_SUITE:long_timers testcase."}. + +pollset_size(doc) -> + []; +pollset_size(suite) -> + []; +pollset_size(Config) when is_list(Config) -> + ?line Parent = self(), + ?line Go = make_ref(), + ?line spawn(fun () -> + Name = pollset_size_testcase_initial_state_holder, + true = register(Name, self()), + ChkIo = get_check_io_info(), + io:format("Initial: ~p~n", [ChkIo]), + Parent ! Go, + receive + {get_initial_check_io_result, Pid} -> + Pid ! {initial_check_io_result, ChkIo} + end + end), + ?line receive Go -> ok end, + ?line {comment, + "Testcase started! This test will run in parallel with the " + "erts testsuite and ends in the z_SUITE:pollset_size testcase."}. + +%% +%% Internal functions... +%% + +display_check_io(ChkIo) -> + catch erlang:display('--- CHECK IO INFO ---'), + catch erlang:display(ChkIo), + catch erts_debug:set_internal_state(available_internal_state, true), + NoOfErrorFds = (catch erts_debug:get_internal_state(check_io_debug)), + catch erlang:display({'NoOfErrorFds', NoOfErrorFds}), + catch erts_debug:set_internal_state(available_internal_state, false), + catch erlang:display('--- CHECK IO INFO ---'), + ok. + +get_check_io_info() -> + ChkIo = erlang:system_info(check_io), + case lists:keysearch(pending_updates, 1, ChkIo) of + {value, {pending_updates, 0}} -> + display_check_io(ChkIo), + ChkIo; + false -> + ChkIo; + _ -> + receive after 10 -> ok end, + get_check_io_info() + end. + + diff --git a/erts/emulator/test/a_SUITE_data/Makefile.src b/erts/emulator/test/a_SUITE_data/Makefile.src new file mode 100644 index 0000000000..b4f1c4a2a5 --- /dev/null +++ b/erts/emulator/test/a_SUITE_data/Makefile.src @@ -0,0 +1,10 @@ +# +# NOTE: +# Suites with makefiles are run first. We want a_SUITE to be run first; +# therefore, keep this makefile even if it should be empty. +# + +all: timer_driver@dll@ + +@SHLIB_RULES@ + diff --git a/erts/emulator/test/a_SUITE_data/timer_driver.c b/erts/emulator/test/a_SUITE_data/timer_driver.c new file mode 100644 index 0000000000..ef4dcdf501 --- /dev/null +++ b/erts/emulator/test/a_SUITE_data/timer_driver.c @@ -0,0 +1,77 @@ +/* + * Copied from driver_SUITE and modified... + */ + +#include +#include "erl_driver.h" + +#define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \ + (((unsigned char*) (s))[1] << 16) | \ + (((unsigned char*) (s))[2] << 8) | \ + (((unsigned char*) (s))[3])) + +#define START_TIMER 0 +#define CANCEL_TIMER 1 +#define DELAY_START_TIMER 2 +#define TIMER 3 +#define CANCELLED 4 + +static ErlDrvData timer_start(ErlDrvPort, char*); +static void timer_stop(ErlDrvData), timer_read(ErlDrvData, char*, int), timer(ErlDrvData); + +static ErlDrvEntry timer_driver_entry = +{ + NULL, + timer_start, + timer_stop, + timer_read, + NULL, + NULL, + "timer_driver", + NULL, + NULL, + NULL, + timer, + NULL, + NULL +}; + +DRIVER_INIT(timer_drv) +{ + return &timer_driver_entry; +} + +static ErlDrvData timer_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData)port; +} + +/* set the timer, this is monitored from erlang measuring the time */ +static void timer_read(ErlDrvData port, char *buf, int len) +{ + char reply[1]; + + if (buf[0] == START_TIMER) { + /* fprintf(stderr, "[timer_drv] Setting timeout: %i\n", get_int32(buf + 1)); */ + driver_set_timer(port, get_int32(buf + 1)); + } else if (buf[0] == CANCEL_TIMER) { + /* fprintf(stderr, "[timer_drv] Timer cancelled\n"); */ + driver_cancel_timer(port); + reply[0] = CANCELLED; + driver_output(port, reply, 1); + } +} + +static void timer_stop(ErlDrvData port) +{ + driver_cancel_timer(port); +} + +static void timer(ErlDrvData port) +{ + char reply[1]; + + /* fprintf(stderr, "[timer_drv] timer timed out\n"); */ + reply[0] = TIMER; + driver_output((ErlDrvPort)port, reply, 1); +} diff --git a/erts/emulator/test/after_SUITE.erl b/erts/emulator/test/after_SUITE.erl new file mode 100644 index 0000000000..3e1a871408 --- /dev/null +++ b/erts/emulator/test/after_SUITE.erl @@ -0,0 +1,233 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(after_SUITE). + +%% Tests receive after. + +-include("test_server.hrl"). + +-export([all/1, t_after/1, receive_after/1, receive_after_big/1, + receive_after_errors/1, receive_var_zero/1, receive_zero/1, + multi_timeout/1, receive_after_32bit/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +%% Internal exports. + +-export([timeout_g/0]). + +all(suite) -> + [t_after, receive_after, receive_after_big, receive_after_errors, + receive_var_zero, receive_zero, multi_timeout, receive_after_32bit]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(3)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +%% Tests for an old round-off error in 'receive after'." +t_after(Config) when is_list(Config) -> + ?line spawn(fun frequent_process/0), + ?line Period = test_server:minutes(1), + ?line Before = erlang:now(), + receive + after Period -> + ?line After = erlang:now(), + ?line report(Period, Before, After) + end. + + +report(Period, Before, After) -> + ?line Elapsed = (element(1, After)*1000000000 + +element(2, After)*1000 + +element(3, After) div 1000) - + (element(1,Before)*1000000000 + + element(2,Before)*1000 + element(3,Before) div 1000), + ?line case Elapsed*100 / Period of + Percent when Percent > 100.10 -> + ?line test_server:fail({too_inaccurate, Percent}); + Percent when Percent < 100.0 -> + ?line test_server:fail({too_early, Percent}); + Percent -> + ?line Comment = io_lib:format("Elapsed/expected: ~.2f %", + [Percent]), + {comment, lists:flatten(Comment)} + end. + +frequent_process() -> + receive + after 100 -> + ?line frequent_process() + end. + +receive_after(doc) -> + "Test that 'receive after' works (doesn't hang). " + "The test takes 10 seconds to complete."; +receive_after(Config) when is_list(Config) -> + ?line receive_after1(5000). + +receive_after1(1) -> + ?line io:format("Testing: receive after ~p~n", [1]), + ?line receive after 1 -> ok end; +receive_after1(N) -> + ?line io:format("Testing: receive after ~p~n", [N]), + ?line receive after N -> receive_after1(N div 2) end. + +receive_after_big(Config) when is_list(Config) -> + %% Test that 'receive after' with a 32 bit number works. + receive_after_big1(16#f7654321), + receive_after_big2(). + +receive_after_big1(Timeout) -> + Self = self(), + erlang:yield(), + spawn(fun() -> Self ! here_is_a_message end), + ok = receive + here_is_a_message -> + ok + after Timeout -> + %% We test that the timeout can be set, + %% not that an timeout occurs after the appropriate delay + %% (48 days, 56 minutes, 48 seconds)! + timeout + end. + +receive_after_big2() -> + Self = self(), + erlang:yield(), + spawn(fun() -> Self ! here_is_a_message end), + ok = receive + here_is_a_message -> + ok + after 16#f7999977 -> + %% We only test that the timeout can be set. + timeout + end. + +-define(TryAfter(Timeout), + {'EXIT',{timeout_value,_}} = (catch receive mission -> exit(impossible) after Timeout -> ok end), + {'EXIT',{timeout_value,_}} = (catch receive after Timeout -> ok end), + try_after(Timeout)). + +%% Test error cases for 'receive after'. +receive_after_errors(Config) when is_list(Config) -> + ?line ?TryAfter(-1), + ?line ?TryAfter(0.0), + ?line ?TryAfter(3.14), + ?line ?TryAfter(16#100000000), + ?line ?TryAfter(392347129847294724972398472984729847129874), + ?line ?TryAfter(16#3fffffffffffffff), + ?line ?TryAfter(16#ffffffffffffffff), + ?line ?TryAfter(-16#100000000), + ?line ?TryAfter(-3891278094774921784123987129848), + ?line ?TryAfter(xxx), + ok. + +try_after(Timeout) -> + {'EXIT',{timeout_value,_}} = (catch receive after Timeout -> ok end). + +receive_var_zero(doc) -> "Test 'after Z', when Z == 0."; +receive_var_zero(Config) when is_list(Config) -> + self() ! x, + self() ! y, + Z = zero(), + timeout = receive + z -> ok + after Z -> timeout + end, + timeout = receive + after Z -> timeout + end, + self() ! w, + receive + x -> ok; + Other -> + ?line ?t:fail({bad_message,Other}) + end. + +zero() -> 0. + +%% Test 'after 0'. +receive_zero(Config) when is_list(Config) -> + self() ! x, + self() ! y, + timeout = receive + z -> ok + after 0 -> + timeout + end, + self() ! w, + timeout = receive + after 0 -> timeout + end, + receive + x -> ok; + Other -> + ?line ?t:fail({bad_message,Other}) + end. + +multi_timeout(doc) -> + "Test for catching invalid assertion in erl_message.c (in queue_message)." + "This failed (dumped core) with debug-compiled emulator."; +multi_timeout(Config) when is_list(Config) -> + ?line P = spawn(?MODULE, timeout_g, []), + ?line P ! a, + ?line P ! b, + ?line receive + after 1000 -> ok + end, + ?line P ! c, + ?line receive + after 1000 -> ok + end, + ?line P ! d, + ok. + +timeout_g() -> + ?line receive + a -> ok + end, + ?line receive + after 100000 -> ok + end, + ok. + +%% OTP-7493: Timeout for 32 bit numbers (such as 16#ffffFFFF) could +%% timeout at once. +receive_after_32bit(Config) when is_list(Config) -> + T = 16#ffffFFFF, + Pids = [spawn_link(fun() -> recv_after_32bit(I, T) end) || + I <- lists:seq(1, 2048)], + + %% Wait two seconds for any of the processes to timeout too early. + receive after 2000 -> ok end, + + %% Kill the processes. + [begin unlink(Pid), exit(Pid, kill) end || Pid <- Pids], + ok. + +recv_after_32bit(I, T) when I rem 2 =:= 0 -> + receive after T -> exit(timeout) end; +recv_after_32bit(_, _) -> + receive after 16#ffffFFFF -> exit(timeout) end. + diff --git a/erts/emulator/test/alloc_SUITE.erl b/erts/emulator/test/alloc_SUITE.erl new file mode 100644 index 0000000000..94766dc6e9 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE.erl @@ -0,0 +1,179 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +-module(alloc_SUITE). +-author('rickard.green@uab.ericsson.se'). +-export([all/1]). + +-export([basic/1, + coalesce/1, + threads/1, + realloc_copy/1, + bucket_index/1, + bucket_mask/1, + rbtree/1, + mseg_clear_cache/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-include("test_server.hrl"). + +-define(DEFAULT_TIMETRAP_SECS, 240). + +all(doc) -> []; +all(suite) -> [basic, + coalesce, + threads, + realloc_copy, + bucket_index, + bucket_mask, + rbtree, + mseg_clear_cache]. + + +init_per_testcase(Case, Config) when is_list(Config) -> + Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), + [{watchdog, Dog},{testcase, Case}|Config]. + +fin_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Testcases %% +%% %% + +basic(suite) -> []; +basic(doc) -> []; +basic(Cfg) -> ?line drv_case(Cfg). + +coalesce(suite) -> []; +coalesce(doc) -> []; +coalesce(Cfg) -> ?line drv_case(Cfg). + +threads(suite) -> []; +threads(doc) -> []; +threads(Cfg) -> ?line drv_case(Cfg). + +realloc_copy(suite) -> []; +realloc_copy(doc) -> []; +realloc_copy(Cfg) -> ?line drv_case(Cfg). + +bucket_index(suite) -> []; +bucket_index(doc) -> []; +bucket_index(Cfg) -> ?line drv_case(Cfg). + +bucket_mask(suite) -> []; +bucket_mask(doc) -> []; +bucket_mask(Cfg) -> ?line drv_case(Cfg). + +rbtree(suite) -> []; +rbtree(doc) -> []; +rbtree(Cfg) -> ?line drv_case(Cfg). + +mseg_clear_cache(suite) -> []; +mseg_clear_cache(doc) -> []; +mseg_clear_cache(Cfg) -> ?line drv_case(Cfg). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Internal functions %% +%% %% + +drv_case(Config) -> + drv_case(Config, ""). + +drv_case(Config, Command) when is_list(Config), + is_list(Command) -> + case ?t:os_type() of + {Family, _} when Family == unix; Family == win32 -> + ?line {ok, Node} = start_node(Config), + ?line Self = self(), + ?line Ref = make_ref(), + ?line spawn_link(Node, + fun () -> + Res = run_drv_case(Config, Command), + Self ! {Ref, Res} + end), + ?line Result = receive {Ref, Rslt} -> Rslt end, + ?line stop_node(Node), + ?line Result; + SkipOs -> + ?line {skipped, + lists:flatten(["Not run on " + | io_lib:format("~p",[SkipOs])])} + end. + +run_drv_case(Config, Command) -> + ?line DataDir = ?config(data_dir,Config), + ?line CaseName = ?config(testcase,Config), + case erl_ddll:load_driver(DataDir, CaseName) of + ok -> ok; + {error, Error} -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + ?line ?t:fail() + end, + ?line Port = open_port({spawn, atom_to_list(CaseName)}, []), + ?line true = is_port(Port), + ?line Port ! {self(), {command, Command}}, + ?line Result = receive_drv_result(Port, CaseName), + ?line Port ! {self(), close}, + ?line receive + {Port, closed} -> + ok + end, + ?line ok = erl_ddll:unload_driver(CaseName), + ?line Result. + +receive_drv_result(Port, CaseName) -> + ?line receive + {print, Port, CaseName, Str} -> + ?line ?t:format("~s", [Str]), + ?line receive_drv_result(Port, CaseName); + {'EXIT', Port, Error} -> + ?line ?t:fail(Error); + {'EXIT', error, Error} -> + ?line ?t:fail(Error); + {failed, Port, CaseName, Comment} -> + ?line ?t:fail(Comment); + {skipped, Port, CaseName, Comment} -> + ?line {skipped, Comment}; + {succeeded, Port, CaseName, ""} -> + ?line succeeded; + {succeeded, Port, CaseName, Comment} -> + ?line {comment, Comment} + end. + +start_node(Config) when is_list(Config) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {A, B, C} = now(), + ?line Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)), + ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). + +stop_node(Node) -> + ?t:stop_node(Node). diff --git a/erts/emulator/test/alloc_SUITE_data/Makefile.src b/erts/emulator/test/alloc_SUITE_data/Makefile.src new file mode 100644 index 0000000000..035415d73e --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/Makefile.src @@ -0,0 +1,41 @@ +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved via the world wide web at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# The Initial Developer of the Original Code is Ericsson Utvecklings AB. +# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +# AB. All Rights Reserved.'' +# +# $Id$ +# + +TEST_DRVS = basic@dll@ \ + coalesce@dll@ \ + threads@dll@ \ + realloc_copy@dll@ \ + bucket_index@dll@ \ + bucket_mask@dll@ \ + rbtree@dll@ \ + mseg_clear_cache@dll@ + +CC = @CC@ +LD = @LD@ +CFLAGS = @SHLIB_CFLAGS@ -I@erl_include@ @DEFS@ +SHLIB_EXTRA_LDLIBS = testcase_driver@obj@ + +all: $(TEST_DRVS) + +@SHLIB_RULES@ + +testcase_driver@obj@: testcase_driver.c testcase_driver.h +$(TEST_DRVS): testcase_driver@obj@ allocator_test.h + + + diff --git a/erts/emulator/test/alloc_SUITE_data/allocator_test.h b/erts/emulator/test/alloc_SUITE_data/allocator_test.h new file mode 100644 index 0000000000..b869a4079c --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/allocator_test.h @@ -0,0 +1,131 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#ifndef ALLOCATOR_TEST_H__ +#define ALLOCATOR_TEST_H__ + +typedef unsigned long Ulong; + +#ifndef __WIN32__ +Ulong erts_alc_test(Ulong, Ulong, Ulong, Ulong); +#endif + +#define UNDEF__ ~((Ulong) 0) + +#define ALC_TEST0(OP) \ + erts_alc_test((Ulong) (OP), UNDEF__, UNDEF__, UNDEF__) +#define ALC_TEST1(OP, A1) \ + erts_alc_test((Ulong) (OP), (Ulong) (A1), UNDEF__, UNDEF__) +#define ALC_TEST2(OP, A1, A2) \ + erts_alc_test((Ulong) (OP), (Ulong) (A1), (Ulong) (A2), UNDEF__) +#define ALC_TEST3(OP, A1, A2, A3) \ + erts_alc_test((Ulong) (OP), (Ulong) (A1), (Ulong) (A2), (Ulong) (A3)) + +typedef Ulong Block_t; +typedef Ulong Carrier_t; +typedef Ulong Allctr_t; +typedef Ulong RBT_t; +typedef Ulong RBTL_t; +typedef void* erts_thread; +typedef void* erts_mutex; +typedef void* erts_cond; + +/* From erl_alloc_util.c */ + +#define BLK_SZ(B) ((Ulong) ALC_TEST1(0x000, (B))) +#define UMEM_SZ(B) ((Ulong) ALC_TEST1(0x001, (B))) +#define IS_PREV_FREE_BLK(B) ((Ulong) ALC_TEST1(0x002, (B))) +#define IS_FREE_BLK(B) ((Ulong) ALC_TEST1(0x003, (B))) +#define IS_LAST_BLK(B) ((Ulong) ALC_TEST1(0x004, (B))) +#define UMEM2BLK(U) ((Block_t *) ALC_TEST1(0x005, (U))) +#define BLK2UMEM(B) ((void *) ALC_TEST1(0x006, (B))) +#define IS_SBC(C) ((Ulong) ALC_TEST1(0x007, (C))) +#define IS_SBC_BLK(B) ((Ulong) ALC_TEST1(0x008, (B))) +#define IS_MBC(C) ((Ulong) ALC_TEST1(0x009, (C))) +#define IS_MMAP_C(C) ((Ulong) ALC_TEST1(0x00a, (C))) +#define C_SZ(C) ((Ulong) ALC_TEST1(0x00b, (C))) +#define SBC2BLK(A, C) ((Block_t *) ALC_TEST2(0x00c, (A), (C))) +#define BLK2SBC(A, B) ((Carrier_t *) ALC_TEST2(0x00d, (A), (B))) +#define MBC2FBLK(A, C) ((Block_t *) ALC_TEST2(0x00e, (A), (C))) +#define FBLK2MBC(A, B) ((Carrier_t *) ALC_TEST2(0x00f, (A), (B))) +#define FIRST_MBC(A) ((Carrier_t *) ALC_TEST1(0x010, (A))) +#define LAST_MBC(A) ((Carrier_t *) ALC_TEST1(0x011, (A))) +#define FIRST_SBC(A) ((Carrier_t *) ALC_TEST1(0x012, (A))) +#define LAST_SBC(A) ((Carrier_t *) ALC_TEST1(0x013, (A))) +#define NEXT_C(C) ((Carrier_t *) ALC_TEST1(0x014, (C))) +#define PREV_C(C) ((Carrier_t *) ALC_TEST1(0x015, (C))) +#define ABLK_HDR_SZ ((Ulong) ALC_TEST0(0x016)) +#define MIN_BLK_SZ(A) ((Ulong) ALC_TEST1(0x017, (A))) +#define NXT_BLK(B) ((Block_t *) ALC_TEST1(0x018, (B))) +#define PREV_BLK(B) ((Block_t *) ALC_TEST1(0x019, (B))) +#define IS_FIRST_BLK(B) ((Ulong) ALC_TEST1(0x01a, (B))) +#define UNIT_SZ ((Ulong) ALC_TEST0(0x01b)) + +/* From erl_goodfit_alloc.c */ +#define BKT_IX(A, S) ((Ulong) ALC_TEST2(0x100, (A), (S))) +#define BKT_MIN_SZ(A, I) ((Ulong) ALC_TEST2(0x101, (A), (I))) +#define NO_OF_BKTS ((Ulong) ALC_TEST0(0x102)) +#define FIND_BKT(A, I) ((int) ALC_TEST2(0x103, (A), (I))) + +/* From erl_bestfit_alloc.c */ +#define IS_AOBF(A) ((Ulong) ALC_TEST1(0x200, (A))) +#define RBT_ROOT(A) ((RBT_t *) ALC_TEST1(0x201, (A))) +#define RBT_PARENT(T) ((RBT_t *) ALC_TEST1(0x202, (T))) +#define RBT_LEFT(T) ((RBT_t *) ALC_TEST1(0x203, (T))) +#define RBT_RIGHT(T) ((RBT_t *) ALC_TEST1(0x204, (T))) +#define RBT_NEXT(T) ((RBTL_t *) ALC_TEST1(0x205, (T))) +#define RBT_IS_BLACK(T) ((Ulong) ALC_TEST1(0x206, (T))) +#define RBT_IS_TREE(T) ((Ulong) ALC_TEST1(0x207, (T))) + +/* From erl_mseg.c */ +#define HAVE_MSEG() ((int) ALC_TEST0(0x400)) +#define MSEG_ALLOC(SP) ((void *) ALC_TEST1(0x401, (SP))) +#define MSEG_DEALLOC(P, S) ((void) ALC_TEST2(0x402, (P), (S))) +#define MSEG_REALLOC(P, OS, SP) ((void *) ALC_TEST3(0x403, (P), (OS), \ + (SP))) +#define MSEG_CLEAR_CACHE() ((void) ALC_TEST0(0x404)) +#define MSEG_NO() ((Ulong) ALC_TEST0(0x405)) +#define MSEG_CACHE_SIZE() ((Ulong) ALC_TEST0(0x406)) + +/* From erl_alloc.c */ + +#undef ALLOC +#undef REALLOC +#undef FREE + +#define ALLOC(A, S) ((void *) ALC_TEST2(0xf00, (A), (S))) +#define REALLOC(A, P, S) ((void *) ALC_TEST3(0xf01, (A), (P), (S))) +#define FREE(A, P) ((void) ALC_TEST2(0xf02, (A), (P))) +#define START_ALC(N, T, A) ((Allctr_t *) ALC_TEST3(0xf03, (N), (T), (A))) +#define STOP_ALC(A) ((void) ALC_TEST1(0xf04, (A))) +#define IS_THREADS_ENABLED ((int) ALC_TEST0(0xf05)) +#define IS_ALLOC_THREAD_SAFE(A) ((int) ALC_TEST1(0xf06, (A))) +#define IS_ALLOC_FORK_SAFE(A) ((int) ALC_TEST1(0xf07, (A))) +#define THR_MTX_CREATE() ((erts_mutex) ALC_TEST0(0xf08)) +#define THR_MTX_DESTROY(M) ((void) ALC_TEST1(0xf09, (M))) +#define THR_MTX_LOCK(M) ((void) ALC_TEST1(0xf0a, (M))) +#define THR_MTX_UNLOCK(M) ((void) ALC_TEST1(0xf0b, (M))) +#define THR_COND_CREATE() ((erts_cond) ALC_TEST0(0xf0c)) +#define THR_COND_DESTROY(C) ((void) ALC_TEST1(0xf0d, (C))) +#define THR_COND_BCAST(C) ((void) ALC_TEST1(0xf0e, (C))) +#define THR_COND_WAIT(C, M) ((void) ALC_TEST2(0xf0f, (C), (M))) +#define THR_CREATE(F, A) ((erts_thread) ALC_TEST2(0xf10, (F), (A))) +#define THR_JOIN(T) ((void) ALC_TEST1(0xf11, (T))) +#define THR_EXIT(R) ((void) ALC_TEST1(0xf12, (R))) + +#endif diff --git a/erts/emulator/test/alloc_SUITE_data/basic.c b/erts/emulator/test/alloc_SUITE_data/basic.c new file mode 100644 index 0000000000..4a5e888161 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/basic.c @@ -0,0 +1,61 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include "allocator_test.h" + +char * +testcase_name(void) +{ + return "basic"; +} + +void +testcase_run(TestCaseState_t *tcs) +{ + Carrier_t *c; + Block_t *blk; + void *p; + Allctr_t *a = START_ALC("basic_", 0, NULL); + tcs->extra = (void *) a; + + ASSERT(tcs, a); + + p = ALLOC(a, 10); + ASSERT(tcs, p); + p = REALLOC(a, p, 15); + ASSERT(tcs, p); + FREE(a, p); + + c = FIRST_MBC(a); + ASSERT(tcs, !NEXT_C(c)); + blk = MBC2FBLK(a, c); + ASSERT(tcs, IS_LAST_BLK(blk)); + ASSERT(tcs, IS_FREE_BLK(blk)); + + STOP_ALC((Allctr_t *) a); + tcs->extra = NULL; + +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + if (tcs->extra) + STOP_ALC((Allctr_t *) tcs->extra); +} diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_index.c b/erts/emulator/test/alloc_SUITE_data/bucket_index.c new file mode 100644 index 0000000000..32fd16fc10 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/bucket_index.c @@ -0,0 +1,114 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include "allocator_test.h" +#include + +#define MAX_TEST_SIZE 100000000 + +char * +testcase_name(void) +{ + return "bucket_index"; +} + +void test_it(TestCaseState_t *tcs, unsigned sbct); + +void +testcase_run(TestCaseState_t *tcs) +{ + testcase_printf(tcs, "No of buckets = %lu:\n\n", NO_OF_BKTS); + + test_it(tcs, 1); + test_it(tcs, 0); + test_it(tcs, 1024); + test_it(tcs, 10240); +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + if (tcs->extra) { + STOP_ALC(tcs->extra); + tcs->extra = NULL; + } +} + +void +test_it(TestCaseState_t *tcs, unsigned sbct) +{ + Ulong max_cont_test_sz; + char sbct_buf[21]; + char *argv[] = {"-tas", "gf", "-tsbct", NULL, NULL}; + int no_changes; + Ulong bi; + Ulong min_sz; + Ulong prev_bi; + Ulong sz; + Allctr_t *a; + + no_changes = 0; + prev_bi = -1; + + if (sbct) { + sprintf(sbct_buf, "%d", sbct); + argv[3] = sbct_buf; + } + else + argv[2] = NULL; + + max_cont_test_sz = 2*sbct*1024; + if (max_cont_test_sz < 1000000) + max_cont_test_sz = 1000000; + + testcase_printf(tcs, "Testing with sbct = %s\n", + sbct ? sbct_buf : "default"); + a = START_ALC("bkt_ix_", 0, argv); + tcs->extra = (void *) a; + ASSERT(tcs, a); + + sz = MIN_BLK_SZ(a); + while(sz < ((((Ulong)1) << 31) - 1)) { + bi = BKT_IX(a, sz); + if (prev_bi != bi) { + ASSERT(tcs, prev_bi + 1 == bi); + + min_sz = BKT_MIN_SZ(a, bi); + + ASSERT(tcs, sz == min_sz); + + testcase_printf(tcs, "sz=%d->ix=%d ", sz, bi); + no_changes++; + } + prev_bi = bi; + if (sz < max_cont_test_sz) + sz++; + else + sz += 100000000; + } + testcase_printf(tcs, "\n\n"); + ASSERT(tcs, no_changes == NO_OF_BKTS); + + STOP_ALC(a); + tcs->extra = NULL; + + testcase_printf(tcs, "Test with sbct=%s succeeded\n", + sbct ? sbct_buf : "default"); +} + diff --git a/erts/emulator/test/alloc_SUITE_data/bucket_mask.c b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c new file mode 100644 index 0000000000..13af7d861a --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/bucket_mask.c @@ -0,0 +1,147 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include "allocator_test.h" +#include + +#define SBCT (512*1024) + +char * +testcase_name(void) +{ + return "bucket_mask"; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + if (tcs->extra) { + STOP_ALC(tcs->extra); + tcs->extra = NULL; + } +} + +void +testcase_run(TestCaseState_t *tcs) +{ + void *tmp; + void **fence; + void **blk; + Ulong sz; + Ulong smbcs; + int i; + int bi; + int bi_tests; + Ulong sbct = (SBCT/1024)*1024; + Ulong min_blk_sz; + Ulong ablk_hdr_sz = ABLK_HDR_SZ; + char smbcs_buf[30]; + char sbct_buf[30]; + int no_bkts = (int) NO_OF_BKTS; + char *argv1[] = {"-tasgf", "-tmmbcs0", sbct_buf, NULL}; + char *argv2[] = {"-tasgf", "-tmmbcs0", sbct_buf, NULL, NULL}; + Allctr_t *a; + + sprintf(sbct_buf, "-tsbct%lu", sbct/1024); + + a = START_ALC("bkt_mask_1_", 0, argv1); + tcs->extra = (void *) a; + ASSERT(tcs, a); + + min_blk_sz = MIN_BLK_SZ(a); + smbcs = 2*(no_bkts*sizeof(void *) + min_blk_sz) + min_blk_sz; + for (i = 0; i < no_bkts; i++) { + sz = BKT_MIN_SZ(a, i); + if (sz >= sbct) + break; + smbcs += sz + min_blk_sz; + } + + bi_tests = i; + testcase_printf(tcs, "Will test %d buckets\n", bi_tests); + + STOP_ALC(a); + tcs->extra = NULL; + + smbcs /= 1024; + smbcs++; + + testcase_printf(tcs, "smbcs = %lu\n", smbcs); + sprintf(smbcs_buf, "-tsmbcs%lu", smbcs); + argv2[3] = smbcs_buf; + + a = START_ALC("bkt_mask_2_", 0, argv2); + tcs->extra = (void *) a; + ASSERT(tcs, a); + + blk = (void **) ALLOC(a, no_bkts*sizeof(void *)); + fence = (void **) ALLOC(a, no_bkts*sizeof(void *)); + + ASSERT(tcs, blk && fence); + + testcase_printf(tcs, "Allocating blocks and fences\n"); + for (i = 0; i < bi_tests; i++) { + sz = BKT_MIN_SZ(a, i); + blk[i] = ALLOC(a, sz - ablk_hdr_sz); + fence[i] = ALLOC(a, 1); + ASSERT(tcs, blk[i] && fence[i]); + } + + tmp = (void *) UMEM2BLK(fence[bi_tests - 1]); + tmp = (void *) NXT_BLK((Block_t *) tmp); + ASSERT(tcs, IS_LAST_BLK(tmp)); + sz = BLK_SZ((Block_t *) tmp); + testcase_printf(tcs, "Allocating leftover size = %lu\n", sz); + tmp = ALLOC(a, sz - ablk_hdr_sz); + ASSERT(tcs, tmp); + + bi = FIND_BKT(a, 0); + ASSERT(tcs, bi < 0); + + for (i = 0; i < bi_tests; i++) { + sz = BKT_MIN_SZ(a, i); + testcase_printf(tcs, "Testing bucket %d\n", i); + FREE(a, blk[i]); + bi = FIND_BKT(a, i); + ASSERT(tcs, bi == i); + blk[i] = ALLOC(a, sz - ablk_hdr_sz); + bi = FIND_BKT(a, i); + ASSERT(tcs, bi != i); + } + + for (i = 0; i < bi_tests; i++) { + FREE(a, blk[i]); + FREE(a, fence[i]); + } + + FREE(a, (void *) blk); + FREE(a, (void *) fence); + + bi = FIND_BKT(a, 0); + ASSERT(tcs, bi == no_bkts - 1); + + FREE(a, tmp); + + bi = FIND_BKT(a, 0); + ASSERT(tcs, bi < 0); + + STOP_ALC(a); + tcs->extra = NULL; +} + diff --git a/erts/emulator/test/alloc_SUITE_data/coalesce.c b/erts/emulator/test/alloc_SUITE_data/coalesce.c new file mode 100644 index 0000000000..c84da97d35 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/coalesce.c @@ -0,0 +1,318 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include "allocator_test.h" +#include + +#define CEILING(X, U) ((((X)+(U)-1)/(U))*(U)) + +void +check_ablk(TestCaseState_t *tcs, Allctr_t *a, void *ptr, Ulong umem_sz) +{ + Ulong unit_sz = UNIT_SZ; + Block_t *blk = UMEM2BLK(ptr); + Block_t *nxt_blk = NXT_BLK(blk); + Ulong real_sz = ((Ulong) nxt_blk) - ((Ulong) (blk)); + ASSERT(tcs, real_sz == BLK_SZ(blk)); + ASSERT(tcs, !IS_FREE_BLK(blk)); + ASSERT(tcs, real_sz >= CEILING(ABLK_HDR_SZ + umem_sz, unit_sz)); + if (real_sz > MIN_BLK_SZ(a) + && real_sz > CEILING(ABLK_HDR_SZ+umem_sz, unit_sz)) { + ASSERT(tcs, + real_sz <= CEILING(MIN_BLK_SZ(a)+ABLK_HDR_SZ+umem_sz, + unit_sz)); + ASSERT(tcs, IS_LAST_BLK(blk) || !IS_FREE_BLK(nxt_blk)); + } +} + +void +setup_sequence(TestCaseState_t *tcs, Allctr_t *a, Ulong bsz, int no, + void *res[]) +{ + Carrier_t *c; + Block_t *blk; + int i; + + testcase_printf(tcs, + "Setting up a sequence of %d blocks of size %lu\n", + no, bsz); + c = FIRST_MBC(a); + ASSERT(tcs, !NEXT_C(c)); + blk = MBC2FBLK(a, c); + ASSERT(tcs, IS_LAST_BLK(blk)); + + for (i = 0; i < no; i++) + res[i] = ALLOC(a, bsz); + for (i = 0; i < no; i++) + ASSERT(tcs, res[i]); + + testcase_printf(tcs, "Checking that sequence was set up as expected\n"); + + for (i = 1; i < no; i++) + ASSERT(tcs, NXT_BLK(UMEM2BLK(res[i-1])) == UMEM2BLK(res[i])); + + blk = NXT_BLK(UMEM2BLK(res[no-1])); + ASSERT(tcs, IS_LAST_BLK(blk)); + + testcase_printf(tcs, "Sequence ok\n"); + + /* If we fail in setup_sequence(), it doesn't mean that something is + wrong. It is just a faulty assumption in setup_sequence() about + how blocks are going to be placed. + Fix setup_sequence()... */ +} + +static void +test_free(TestCaseState_t *tcs, Allctr_t *a, Ulong bsz) +{ + Block_t *blk; + void *p[7]; + + testcase_printf(tcs," --- Testing free() with block size %lu ---\n",bsz); + + setup_sequence(tcs, a, bsz, 7, p); + + check_ablk(tcs, a, p[0], bsz); + check_ablk(tcs, a, p[1], bsz); + check_ablk(tcs, a, p[2], bsz); + check_ablk(tcs, a, p[3], bsz); + check_ablk(tcs, a, p[4], bsz); + check_ablk(tcs, a, p[5], bsz); + check_ablk(tcs, a, p[6], bsz); + + /* Coalescing with previous block */ + FREE(a, p[2]); + FREE(a, p[3]); + + blk = NXT_BLK(UMEM2BLK(p[1])); + ASSERT(tcs, IS_FREE_BLK(blk)); + ASSERT(tcs, NXT_BLK(blk) == UMEM2BLK(p[4])); + + /* Coalescing with next block */ + + FREE(a, p[1]); + blk = NXT_BLK(UMEM2BLK(p[0])); + ASSERT(tcs, IS_FREE_BLK(blk)); + ASSERT(tcs, NXT_BLK(blk) == UMEM2BLK(p[4])); + + /* Coalescing with next and previous block */ + + FREE(a, p[5]); + FREE(a, p[4]); + + blk = NXT_BLK(UMEM2BLK(p[0])); + ASSERT(tcs, IS_FREE_BLK(blk)); + ASSERT(tcs, NXT_BLK(blk) == UMEM2BLK(p[6])); + + /* Cleanup */ + + FREE(a, p[0]); + FREE(a, p[6]); + + testcase_printf(tcs," --- free() with block size %lu succeded ---\n",bsz); +} + +static void +test_realloc(TestCaseState_t *tcs, Allctr_t *a, Ulong bsz) +{ + Block_t *blk; + void *ptr; + void *p[3]; + Ulong nbsz; + + testcase_printf(tcs," --- Testing realloc() with block size %lu ---\n", + bsz); + + setup_sequence(tcs, a, bsz, 3, p); + + check_ablk(tcs, a, p[0], bsz); + check_ablk(tcs, a, p[1], bsz); + check_ablk(tcs, a, p[2], bsz); + + /* Grow to the end of the carrier */ + blk = NXT_BLK(UMEM2BLK(p[2])); + ASSERT(tcs, IS_FREE_BLK(blk)); + ASSERT(tcs, IS_LAST_BLK(blk)); + nbsz = bsz + BLK_SZ(blk); + ptr = REALLOC(a, p[2], nbsz); + ASSERT(tcs, p[2] == ptr); + check_ablk(tcs, a, p[2], nbsz); + blk = UMEM2BLK(p[2]); + ASSERT(tcs, IS_LAST_BLK(blk)); + + /* Shrink from the end of the carrier */ + ptr = REALLOC(a, p[2], bsz); + ASSERT(tcs, p[2] == ptr); + blk = UMEM2BLK(p[2]); + ASSERT(tcs, !IS_LAST_BLK(blk)); + blk = NXT_BLK(blk); + ASSERT(tcs, IS_LAST_BLK(blk)); + check_ablk(tcs, a, p[2], bsz); + + /* Shrink and coalecse with next free */ + + FREE(a, p[1]); + + blk = NXT_BLK(UMEM2BLK(p[0])); + ASSERT(tcs, IS_FREE_BLK(blk)); + + nbsz = bsz/2; + ptr = REALLOC(a, p[0], nbsz); + ASSERT(tcs, p[0] == ptr); + + check_ablk(tcs, a, p[0], nbsz); + + blk = NXT_BLK(UMEM2BLK(p[0])); + ASSERT(tcs, IS_FREE_BLK(blk)); + ASSERT(tcs, NXT_BLK(blk) == UMEM2BLK(p[2])); + + /* Grow into next free; but leave free block at end */ + + nbsz *= 3; + ptr = REALLOC(a, p[0], nbsz); + ASSERT(tcs, p[0] == ptr); + + check_ablk(tcs, a, p[0], nbsz); + blk = NXT_BLK(UMEM2BLK(p[0])); + + ASSERT(tcs, IS_FREE_BLK(blk)); + ASSERT(tcs, NXT_BLK(blk) == UMEM2BLK(p[2])); + + /* Grow upto next alloced block by allocating just enough so that no + free block fits between them */ + nbsz = BLK_SZ(blk) + UMEM_SZ(UMEM2BLK(p[0])); + nbsz -= MIN_BLK_SZ(a) - 1; + + ptr = REALLOC(a, p[0], nbsz); + ASSERT(tcs, p[0] == ptr); + check_ablk(tcs, a, p[0], nbsz); + blk = NXT_BLK(UMEM2BLK(p[0])); + ASSERT(tcs, !IS_FREE_BLK(blk)); + ASSERT(tcs, blk == UMEM2BLK(p[2])); + + /* Grow into unused part at end */ + nbsz += MIN_BLK_SZ(a) - 1; + ptr = REALLOC(a, p[0], nbsz); + ASSERT(tcs, p[0] == ptr); + check_ablk(tcs, a, p[0], nbsz); + ASSERT(tcs, !IS_FREE_BLK(blk)); + ASSERT(tcs, blk == UMEM2BLK(p[2])); + + /* Shrink *almost* as much so that a free block would fit between the + allocated blocks, and make sure that we don't get a free block + in between */ + nbsz -= MIN_BLK_SZ(a) - 1; + ptr = REALLOC(a, p[0], nbsz); + ASSERT(tcs, p[0] == ptr); + check_ablk(tcs, a, p[0], nbsz); + blk = NXT_BLK(UMEM2BLK(p[0])); + ASSERT(tcs, !IS_FREE_BLK(blk)); + ASSERT(tcs, blk == UMEM2BLK(p[2])); + + /* Shrink just as much so that a free block can fit between + the alloced blocks */ + nbsz -= 1; + ptr = REALLOC(a, p[0], nbsz); + ASSERT(tcs, p[0] == ptr); + check_ablk(tcs, a, p[0], nbsz); + blk = NXT_BLK(UMEM2BLK(p[0])); + ASSERT(tcs, IS_FREE_BLK(blk)); + ASSERT(tcs, blk < UMEM2BLK(p[2])); + ASSERT(tcs, NXT_BLK(blk) == UMEM2BLK(p[2])); + + /* Shrink so little that no free block would fit between allocated + blocks, and make sure that we shrink the allocated block and + coalesce the extra free part with the next free block. */ + nbsz -= MIN_BLK_SZ(a) - 1; + ptr = REALLOC(a, p[0], nbsz); + ASSERT(tcs, p[0] == ptr); + check_ablk(tcs, a, p[0], nbsz); + blk = NXT_BLK(UMEM2BLK(p[0])); + ASSERT(tcs, IS_FREE_BLK(blk)); + ASSERT(tcs, blk < UMEM2BLK(p[2])); + ASSERT(tcs, NXT_BLK(blk) == UMEM2BLK(p[2])); + + /* Cleanup */ + FREE(a, p[0]); + FREE(a, p[2]); + + testcase_printf(tcs, " --- realloc() with block size %lu succeded ---\n", + bsz); + +} + +char * +testcase_name(void) +{ + return "coalesce"; +} + +void +testcase_run(TestCaseState_t *tcs) +{ + char *argv_org[] = {"-tmmbcs1024", "-tsbct2048", "-trmbcmt100", "-tas", NULL, NULL}; + char *alg[] = {"af", "gf", "bf", "aobf", NULL}; + int i; + + for (i = 0; alg[i]; i++) { + Ulong sz; + Allctr_t *a; + char *argv[sizeof(argv_org)/sizeof(argv_org[0])]; + memcpy((void *) argv, (void *) argv_org, sizeof(argv_org)); + + argv[4] = alg[i]; + testcase_printf(tcs, " *** Starting \"%s\" allocator *** \n", alg[i]); + a = START_ALC("coalesce_", 0, argv); + ASSERT(tcs, a); + tcs->extra = (void *) a; + + sz = MIN_BLK_SZ(a) - ABLK_HDR_SZ; + test_free(tcs, a, sz); + sz += 1; + test_free(tcs, a, sz); + sz *= 4; + test_free(tcs, a, sz); + sz += 1; + test_free(tcs, a, sz); + sz *= 10; + test_free(tcs, a, sz); + + sz = MIN_BLK_SZ(a)*4 - ABLK_HDR_SZ; + test_realloc(tcs, a, sz); + sz += 1; + test_realloc(tcs, a, sz); + sz *= 4; + test_realloc(tcs, a, sz); + sz += 1; + test_realloc(tcs, a, sz); + sz *= 10; + test_realloc(tcs, a, sz); + + testcase_printf(tcs, " *** Stopping \"%s\" allocator *** \n", alg[i]); + STOP_ALC(a); + tcs->extra = NULL; + } +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + if (tcs->extra) + STOP_ALC((Allctr_t *) tcs->extra); +} diff --git a/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c new file mode 100644 index 0000000000..0277616bd0 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/mseg_clear_cache.c @@ -0,0 +1,102 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include "allocator_test.h" + +#define MAX_SEGS 10 + +typedef struct { + void *ptr; + Ulong size; +} seg_t; + +char * +testcase_name(void) +{ + return "mseg_clear_cache"; +} + +void +testcase_run(TestCaseState_t *tcs) +{ + int i; + Ulong n; + seg_t *seg; + + if (!HAVE_MSEG()) + testcase_skipped(tcs, "No mseg_alloc; nothing to test"); + + seg = (seg_t *) testcase_alloc(sizeof(seg_t)*(MAX_SEGS+1)); + + ASSERT(tcs, seg); + + for (i = 0; i <= MAX_SEGS; i++) + seg[i].ptr = NULL; + + tcs->extra = &seg[0]; + + for (i = 0; i < MAX_SEGS; i++) { + seg[i].size = 1000; + seg[i].ptr = MSEG_ALLOC(&seg[i].size); + ASSERT(tcs, seg[i].ptr); + ASSERT(tcs, seg[i].size >= 1000); + } + + n = MSEG_NO(); + testcase_printf(tcs, "MSEG_NO() = %lu\n", n); + + ASSERT(tcs, n >= MAX_SEGS); + + testcase_printf(tcs, "Deallocating half of the segments\n"); + for (i = MAX_SEGS-1; i >= MAX_SEGS/2; i--) { + MSEG_DEALLOC(seg[i].ptr, seg[i].size); + seg[i].ptr = NULL; + } + + n = MSEG_NO(); + testcase_printf(tcs, "MSEG_NO() = %lu\n", n); + + ASSERT(tcs, n >= MAX_SEGS/2); + + n = MSEG_CACHE_SIZE(); + testcase_printf(tcs, "MSEG_CACHE_SIZE() = %lu\n", n); + ASSERT(tcs, n > 0); + + testcase_printf(tcs, "MSEG_CLEAR_CACHE()\n"); + MSEG_CLEAR_CACHE(); + + n = MSEG_CACHE_SIZE(); + testcase_printf(tcs, "MSEG_CACHE_SIZE() = %lu\n", n); + + ASSERT(tcs, n == 0); + +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + if (tcs->extra) { + seg_t *seg = (seg_t *) tcs->extra; + int i; + for (i = 0; seg[i].ptr; i++) + MSEG_DEALLOC(seg[i].ptr, seg[i].size); + testcase_free((void *) seg); + tcs->extra = NULL; + } +} diff --git a/erts/emulator/test/alloc_SUITE_data/rbtree.c b/erts/emulator/test/alloc_SUITE_data/rbtree.c new file mode 100644 index 0000000000..c97e0aac1a --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/rbtree.c @@ -0,0 +1,386 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include "allocator_test.h" + +#define NO_BLOCKS 100000 + +#define RIGHT_VISITED (1 << 0) +#define LEFT_VISITED (1 << 1) + +typedef struct { + Allctr_t *allocator; + void **blk; + void **fence; +} rbtree_test_data; + +#if 0 +#define PRINT_TREE +#endif + +#ifdef PRINT_TREE + +#define INDENT_STEP 5 + +#include +static void +print_tree_aux(TestCaseState_t *tcs, RBT_t *x, int indent) +{ + if (!x) { + char frmt[20]; + sprintf(frmt, "%%%ds%%s\n", indent); + testcase_printf(tcs, frmt, "", "BLACK: nil"); + } + else { + print_tree_aux(tcs, RBT_RIGHT(x), indent + INDENT_STEP); + { + char frmt[40]; + sprintf(frmt, "%%%ds%%s: sz=%%lu addr=0x%%lx\n", indent); + testcase_printf(tcs, + frmt, + "", + RBT_IS_BLACK(x) ? "BLACK" : "RED", + BLK_SZ(x), + (Ulong) x); + } + print_tree_aux(tcs, RBT_LEFT(x), indent + INDENT_STEP); + } +} + + +static void +print_tree(TestCaseState_t *tcs, RBT_t *root, int aobf) +{ + char *type = aobf ? "Size-Adress" : "Size"; + testcase_printf(tcs, " --- %s tree begin ---\r\n", type); + print_tree_aux(tcs, root, 0); + testcase_printf(tcs, " --- %s tree end ---\r\n", type); +} + +#endif + +static RBT_t * +check_tree(TestCaseState_t *tcs, Allctr_t *alc, Ulong size) +{ + int i, max_i, address_order; + char stk[128]; + RBT_t *root, *x, *y, *res; + Ulong x_sz, y_sz, is_x_black; + long blacks, curr_blacks; + + res = NULL; + + address_order = IS_AOBF(alc); + root = RBT_ROOT(alc); + +#ifdef PRINT_TREE + print_tree(tcs, root, address_order); +#endif + + max_i = i = -1; + curr_blacks = 0; + blacks = -1; + + if (!root) + goto done; + + stk[++i] = 0; + + ASSERT(tcs, RBT_IS_BLACK(root)); + ASSERT(tcs, !RBT_PARENT(root)); + x = root; + curr_blacks++; + + while (x) { + + ASSERT(tcs, i <= 128); + + if (!(stk[i] & LEFT_VISITED)) { + stk[i] |= LEFT_VISITED; + y = RBT_LEFT(x); + if (RBT_IS_BLACK(y)) + curr_blacks++; + if (y) { + x = y; + stk[++i] = 0; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + ASSERT(tcs, blacks == curr_blacks); + curr_blacks--; + } + } + + if (!(stk[i] & RIGHT_VISITED)) { + stk[i] |= RIGHT_VISITED; + y = RBT_RIGHT(x); + if (RBT_IS_BLACK(y)) + curr_blacks++; + if (y) { + x = y; + stk[++i] = 0; + continue; + } + else { + if (blacks < 0) + blacks = curr_blacks; + ASSERT(tcs, blacks == curr_blacks); + curr_blacks--; + } + } + + + /* Check x ... */ + + is_x_black = RBT_IS_BLACK(x); + x_sz = BLK_SZ(x); + + + if (!is_x_black) { + ASSERT(tcs, RBT_IS_BLACK(RBT_RIGHT(x))); + ASSERT(tcs, RBT_IS_BLACK(RBT_LEFT(x))); + } + + ASSERT(tcs, RBT_PARENT(x) || x == root); + + y = RBT_LEFT(x); + if (y) { + y_sz = BLK_SZ(y); + ASSERT(tcs, RBT_PARENT(y) == x); + if (address_order) { + ASSERT(tcs, y_sz < x_sz || (y_sz == x_sz && y < x)); + } + else { + ASSERT(tcs, RBT_IS_TREE(y)); + ASSERT(tcs, y_sz < x_sz); + } + } + + y = RBT_RIGHT(x); + if (y) { + y_sz = BLK_SZ(y); + ASSERT(tcs, RBT_PARENT(y) == x); + if (address_order) { + ASSERT(tcs, y_sz > x_sz || (y_sz == x_sz && y > x)); + } + else { + ASSERT(tcs, RBT_IS_TREE(y)); + ASSERT(tcs, y_sz > x_sz); + } + } + + if (!address_order) { + Ulong l_sz; + RBTL_t *l = RBT_NEXT(x); + for (l = RBT_NEXT(x); l; l = RBT_NEXT(l)) { + l_sz = BLK_SZ(l); + ASSERT(tcs, l_sz == x_sz); + ASSERT(tcs, !RBT_IS_TREE(l)); + } + } + + if (size && x_sz >= size) { + if (!res) + res = x; + else { + y_sz = BLK_SZ(res); + if (address_order) { + if (x_sz < y_sz || (x_sz == y_sz && x < res)) + res = x; + } + else { + if (!res || x_sz < y_sz) + res = x; + } + } + } + + if (max_i < i) + max_i = i; + if (is_x_black) + curr_blacks--; + x = RBT_PARENT(x); + i--; + } + + done: + ASSERT(tcs, curr_blacks == 0); + ASSERT(tcs, i == -1); + + testcase_printf(tcs, "Red-Black Tree OK! Max depth = %d; " + "Black depth = %d\n", max_i+1, blacks < 0 ? 0 : blacks); + + return res; + +} + +static void +do_check(TestCaseState_t *tcs, Allctr_t *a, Ulong size) +{ + Ulong sz = ((size + 7) / 8)*8; + void *tmp; + Block_t *x, *y; + + x = (Block_t *) check_tree(tcs, a, sz); + tmp = ALLOC(a, sz - ABLK_HDR_SZ); + ASSERT(tcs, tmp); + y = UMEM2BLK(tmp); + if (IS_AOBF(a)) { + ASSERT(tcs, x == y); + } + else { + ASSERT(tcs, BLK_SZ(x) == BLK_SZ(y)); + } + FREE(a, tmp); +} + + +static void +test_it(TestCaseState_t *tcs) +{ + int i; + Allctr_t a = ((rbtree_test_data *) tcs->extra)->allocator; + void **blk = ((rbtree_test_data *) tcs->extra)->blk; + void **fence = ((rbtree_test_data *) tcs->extra)->fence; + Ulong min_blk_sz; + + min_blk_sz = MIN_BLK_SZ(a); + + for (i = 0; i < NO_BLOCKS; i++) { + blk[i] = ALLOC(a, min_blk_sz + i % 500); + fence[i] = ALLOC(a, 1); + ASSERT(tcs, blk[i] && fence[i]); + } + + for (i = 0; i < NO_BLOCKS; i++) { + if (i % 3 == 0) { + FREE(a, blk[i]); + blk[i] = NULL; + } + if (i % (NO_BLOCKS/2) == 0) + do_check(tcs, a, 50); + } + + for (i = 0; i < NO_BLOCKS; i++) { + if (i % 5 == 0 && blk[i]) { + FREE(a, blk[i]); + blk[i] = NULL; + } + if (i % (NO_BLOCKS/2) == 0) + do_check(tcs, a, 200); + } + + for (i = 0; i < NO_BLOCKS; i++) { + if (blk[i]) { + FREE(a, blk[i]); + blk[i] = NULL; + } + if (i % (NO_BLOCKS/2) == 0) + do_check(tcs, a, 100); + } + + do_check(tcs, a, 250); + + for (i = 0; i < NO_BLOCKS; i++) { + FREE(a, fence[i]); + if (i % (NO_BLOCKS/3) == 0) + do_check(tcs, a, 300); + } + + ASSERT(tcs, RBT_ROOT(a)); + ASSERT(tcs, !RBT_LEFT(RBT_ROOT(a))); + ASSERT(tcs, !RBT_RIGHT(RBT_ROOT(a))); +} + + +char * +testcase_name(void) +{ + return "rbtree"; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + if (tcs->extra) { + rbtree_test_data *td = tcs->extra; + tcs->extra = NULL; + if (td->allocator) + STOP_ALC(td->allocator); + if (td->blk) + testcase_free((void *) td->blk); + if (td->fence) + testcase_free((void *) td->fence); + testcase_free((void *) td); + } +} + +void +testcase_run(TestCaseState_t *tcs) +{ + char *argv1[] = {"-tasbf", NULL}; + char *argv2[] = {"-tasaobf", NULL}; + Allctr_t *a; + rbtree_test_data *td; + + /* Best fit... */ + + testcase_printf(tcs, "Setup...\n"); + + td = (rbtree_test_data *) testcase_alloc(sizeof(rbtree_test_data)); + ASSERT(tcs, td); + tcs->extra = (void *) td; + td->allocator = NULL; + td->blk = (void **) testcase_alloc(sizeof(void *)*NO_BLOCKS); + td->fence = (void **) testcase_alloc(sizeof(void *)*NO_BLOCKS); + ASSERT(tcs, td->blk && td->fence); + + testcase_printf(tcs, "Starting test of best fit...\n"); + + td->allocator = a = START_ALC("rbtree_bf_", 0, argv1); + + ASSERT(tcs, a); + ASSERT(tcs, !IS_AOBF(a)); + + test_it(tcs); + + STOP_ALC(a); + td->allocator = NULL; + + testcase_printf(tcs, "Best fit test succeeded!\n"); + + /* Address order best fit... */ + + testcase_printf(tcs, "Starting test of address order best fit...\n"); + + td->allocator = a = START_ALC("rbtree_aobf_", 0, argv2); + + ASSERT(tcs, a); + ASSERT(tcs, IS_AOBF(a)); + + test_it(tcs); + + STOP_ALC(a); + td->allocator = NULL; + + testcase_printf(tcs, "Address order best fit test succeeded!\n"); + +} diff --git a/erts/emulator/test/alloc_SUITE_data/realloc_copy.c b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c new file mode 100644 index 0000000000..12454c75e4 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/realloc_copy.c @@ -0,0 +1,279 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include "allocator_test.h" +#include +#include + +#if 1 +#define PRINT_ALLOC_OPS +#endif + +#define SBC_THRESHOLD 8192 +#define NO_OF_BLOCKS 7 +#define NO_OF_ALLOC_OPS_PER_BLOCK 700 + +typedef struct { + unsigned char *p; + Ulong s; + int i; + Ulong *as; +} block; + +Ulong alloc_seq_1[] = { + SBC_THRESHOLD, /* mmap */ + SBC_THRESHOLD*4, /* mmap to new mmap */ + SBC_THRESHOLD/50, /* mmap to malloc */ + SBC_THRESHOLD, /* malloc to mmap */ + 0 +}; + + +Ulong alloc_seq_2[] = { + 1, + SBC_THRESHOLD/10, + SBC_THRESHOLD/9, + SBC_THRESHOLD/8, + SBC_THRESHOLD/7, + SBC_THRESHOLD/6, + SBC_THRESHOLD/5, + SBC_THRESHOLD/4, + SBC_THRESHOLD/3, + SBC_THRESHOLD/2, + SBC_THRESHOLD*1, + SBC_THRESHOLD*2, + SBC_THRESHOLD*3, + SBC_THRESHOLD*4, + SBC_THRESHOLD*5, + SBC_THRESHOLD*6, + SBC_THRESHOLD*7, + SBC_THRESHOLD*8, + SBC_THRESHOLD*9, + SBC_THRESHOLD*10, + SBC_THRESHOLD*9, + SBC_THRESHOLD*8, + SBC_THRESHOLD*7, + SBC_THRESHOLD*6, + SBC_THRESHOLD*5, + SBC_THRESHOLD*4, + SBC_THRESHOLD*3, + SBC_THRESHOLD*2, + SBC_THRESHOLD*1, + SBC_THRESHOLD/2, + SBC_THRESHOLD/3, + SBC_THRESHOLD/4, + SBC_THRESHOLD/5, + SBC_THRESHOLD/6, + SBC_THRESHOLD/7, + SBC_THRESHOLD/8, + SBC_THRESHOLD/9, + SBC_THRESHOLD/10, + 1, + 0 +}; + +Ulong alloc_seq_3[] = { + SBC_THRESHOLD*11, + SBC_THRESHOLD*10, + SBC_THRESHOLD*9, + SBC_THRESHOLD*8, + SBC_THRESHOLD*7, + SBC_THRESHOLD*6, + SBC_THRESHOLD*5, + SBC_THRESHOLD*4, + SBC_THRESHOLD*3, + SBC_THRESHOLD*2, + SBC_THRESHOLD*1, + SBC_THRESHOLD/2, + SBC_THRESHOLD/3, + SBC_THRESHOLD/4, + SBC_THRESHOLD/5, + SBC_THRESHOLD/6, + SBC_THRESHOLD/7, + SBC_THRESHOLD/8, + SBC_THRESHOLD/9, + SBC_THRESHOLD/10, + 1, + SBC_THRESHOLD/10, + SBC_THRESHOLD/9, + SBC_THRESHOLD/8, + SBC_THRESHOLD/7, + SBC_THRESHOLD/6, + SBC_THRESHOLD/5, + SBC_THRESHOLD/4, + SBC_THRESHOLD/3, + SBC_THRESHOLD/2, + SBC_THRESHOLD*1, + SBC_THRESHOLD*2, + SBC_THRESHOLD*3, + SBC_THRESHOLD*4, + SBC_THRESHOLD*5, + SBC_THRESHOLD*6, + SBC_THRESHOLD*7, + SBC_THRESHOLD*8, + SBC_THRESHOLD*9, + SBC_THRESHOLD*10, + 0 +}; + +Ulong alloc_seq_4[] = { + SBC_THRESHOLD*1, + SBC_THRESHOLD*10, + SBC_THRESHOLD*1, + 0 +}; + +Ulong alloc_seq_5[] = { + SBC_THRESHOLD/50, + SBC_THRESHOLD*10, + SBC_THRESHOLD/50, + 0 +}; + +Ulong alloc_seq_6[] = { + SBC_THRESHOLD/50, + SBC_THRESHOLD*10, + SBC_THRESHOLD/50, + SBC_THRESHOLD*10, + 0 +}; + +Ulong alloc_seq_7[] = { + 1, + SBC_THRESHOLD/50, + SBC_THRESHOLD*10, + SBC_THRESHOLD/50, + 0 +}; + + +block blocks[NO_OF_BLOCKS] = {{NULL, 0, 0, alloc_seq_1}, + {NULL, 0, 0, alloc_seq_2}, + {NULL, 0, 0, alloc_seq_3}, + {NULL, 0, 0, alloc_seq_4}, + {NULL, 0, 0, alloc_seq_5}, + {NULL, 0, 0, alloc_seq_6}, + {NULL, 0, 0, alloc_seq_7}}; + +#define CHECK_BLOCK_DATA(T, P, S, D) \ + check_block_data(__FILE__, __LINE__, (T), (P), (S), (D)) + +static void +check_block_data(char *file, int line, + TestCaseState_t *tcs, unsigned char *p, Ulong sz, int d) +{ + Ulong i; + for (i = 0; i < sz; i++) + if (p[i] != (unsigned char) d) + testcase_failed(tcs, "%s:%d: Data clobbered! found id=%d; " + "expected id=%d\n", file, line, (int) p[i], d); +} + + +static void +alloc_op(TestCaseState_t *tcs, Allctr_t *a, block *bp, int id, int clean_up) +{ + if(bp->p) + CHECK_BLOCK_DATA(tcs, bp->p, bp->s, id); + + if(bp->as[bp->i] == 0 || clean_up) { + FREE(a, bp->p); +#ifdef PRINT_ALLOC_OPS + testcase_printf(tcs, "FREE(0x%lx) [id=%d]\n", (Ulong) bp->p, id); +#endif + bp->p = NULL; + bp->s = 0; + bp->i = 0; /* start from the beginning again */ + return; + } + + if(!bp->p) { + bp->s = bp->as[bp->i]; + bp->p = (unsigned char *) ALLOC(a, bp->s); +#ifdef PRINT_ALLOC_OPS + testcase_printf(tcs, "0x%lx = ALLOC(%lu) [id=%d]\n", + (Ulong) bp->p, bp->s, id); +#endif + if(!bp->p) + testcase_failed(tcs, "ALLOC(%lu) failed [id=%d])\n", bp->s, id); + memset((void *) bp->p, id, (size_t) bp->s); + } + else { + unsigned char *p = (unsigned char *) REALLOC(a, bp->p, bp->as[bp->i]); +#ifdef PRINT_ALLOC_OPS + testcase_printf(tcs, "0x%lx = REALLOC(0x%lx, %lu) [id=%d]\n", + (Ulong) p, (Ulong) bp->p, bp->as[bp->i], id); +#endif + if(!p) { + testcase_failed(tcs, "REALLOC(0x%lx, %lu) failed [id=%d]\n", + (Ulong) bp->p, bp->as[bp->i], id); + } + + if(bp->s < bp->as[bp->i]) { + CHECK_BLOCK_DATA(tcs, p, bp->s, id); + memset((void *) p, id, (size_t) bp->as[bp->i]); + } + else + CHECK_BLOCK_DATA(tcs, p, bp->as[bp->i], id); + + bp->s = bp->as[bp->i]; + bp->p = p; + } + + bp->i++; +} + +char * +testcase_name(void) +{ + return "realloc_copy"; +} + +void +testcase_run(TestCaseState_t *tcs) +{ + int i, j; + char sbct_buf[20]; + char *argv[] = {"-tmmsbc", "5000", "-tsbct", &sbct_buf[0], NULL}; + Allctr_t *a; + + sprintf(sbct_buf, "%d", SBC_THRESHOLD/1024); + + a = START_ALC("realloc_copy_", 0, argv); + ASSERT(tcs, a); + tcs->extra = (void *) a; + + for(i = 0; i < NO_OF_ALLOC_OPS_PER_BLOCK; i++) + for(j = 0; j < NO_OF_BLOCKS; j++) + alloc_op(tcs, a, &blocks[j], j + 1, 0); + + for(j = 0; j < NO_OF_BLOCKS; j++) + alloc_op(tcs, a, &blocks[j], j + 1, 1); + + STOP_ALC((Allctr_t *) tcs->extra); + tcs->extra = NULL; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + if (tcs->extra) + STOP_ALC((Allctr_t *) tcs->extra); +} + diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.c b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c new file mode 100644 index 0000000000..1e98844838 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.c @@ -0,0 +1,260 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include +#include +#include +#include +#include + +#ifdef __WIN32__ +#undef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 1 +#define vsnprintf _vsnprintf +#endif + +#ifndef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 0 +#endif + +#define COMMENT_BUF_SZ 4096 + +#define TESTCASE_FAILED 0 +#define TESTCASE_SKIPPED 1 +#define TESTCASE_SUCCEEDED 2 + +typedef struct { + TestCaseState_t visible; + ErlDrvPort port; + int result; + jmp_buf done_jmp_buf; + char *comment; + char comment_buf[COMMENT_BUF_SZ]; +} InternalTestCaseState_t; + +ErlDrvData testcase_drv_start(ErlDrvPort port, char *command); +void testcase_drv_stop(ErlDrvData drv_data); +void testcase_drv_run(ErlDrvData drv_data, char *buf, int len); + +static ErlDrvEntry testcase_drv_entry = { + NULL, + testcase_drv_start, + testcase_drv_stop, + testcase_drv_run +}; + + +DRIVER_INIT(testcase_drv) +{ + testcase_drv_entry.driver_name = testcase_name(); + return &testcase_drv_entry; +} + +ErlDrvData +testcase_drv_start(ErlDrvPort port, char *command) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) + driver_alloc(sizeof(InternalTestCaseState_t)); + if (!itcs) { + return ERL_DRV_ERROR_GENERAL; + } + + itcs->visible.testcase_name = testcase_name(); + itcs->visible.extra = NULL; + itcs->port = port; + itcs->result = TESTCASE_FAILED; + itcs->comment = ""; + + return (ErlDrvData) itcs; +} + +void +testcase_drv_stop(ErlDrvData drv_data) +{ + testcase_cleanup((TestCaseState_t *) drv_data); + driver_free((void *) drv_data); +} + +void +testcase_drv_run(ErlDrvData drv_data, char *buf, int len) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) drv_data; + ErlDrvTermData result_atom; + ErlDrvTermData msg[12]; + + itcs->visible.command = buf; + itcs->visible.command_len = len; + + if (setjmp(itcs->done_jmp_buf) == 0) { + testcase_run((TestCaseState_t *) itcs); + itcs->result = TESTCASE_SUCCEEDED; + } + + switch (itcs->result) { + case TESTCASE_SUCCEEDED: + result_atom = driver_mk_atom("succeeded"); + break; + case TESTCASE_SKIPPED: + result_atom = driver_mk_atom("skipped"); + break; + case TESTCASE_FAILED: + default: + result_atom = driver_mk_atom("failed"); + break; + } + + msg[0] = ERL_DRV_ATOM; + msg[1] = (ErlDrvTermData) result_atom; + + msg[2] = ERL_DRV_PORT; + msg[3] = driver_mk_port(itcs->port); + + msg[4] = ERL_DRV_ATOM; + msg[5] = driver_mk_atom(itcs->visible.testcase_name); + + msg[6] = ERL_DRV_STRING; + msg[7] = (ErlDrvTermData) itcs->comment; + msg[8] = (ErlDrvTermData) strlen(itcs->comment); + + msg[9] = ERL_DRV_TUPLE; + msg[10] = (ErlDrvTermData) 4; + + driver_output_term(itcs->port, msg, 11); +} + +int +testcase_assertion_failed(TestCaseState_t *tcs, + char *file, int line, char *assertion) +{ + testcase_failed(tcs, "%s:%d: Assertion failed: \"%s\"", + file, line, assertion); + return 0; +} + +void +testcase_printf(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + ErlDrvTermData msg[12]; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + msg[0] = ERL_DRV_ATOM; + msg[1] = (ErlDrvTermData) driver_mk_atom("print"); + + msg[2] = ERL_DRV_PORT; + msg[3] = driver_mk_port(itcs->port); + + msg[4] = ERL_DRV_ATOM; + msg[5] = driver_mk_atom(itcs->visible.testcase_name); + + msg[6] = ERL_DRV_STRING; + msg[7] = (ErlDrvTermData) itcs->comment_buf; + msg[8] = (ErlDrvTermData) strlen(itcs->comment_buf); + + msg[9] = ERL_DRV_TUPLE; + msg[10] = (ErlDrvTermData) 4; + + driver_output_term(itcs->port, msg, 11); +} + + +void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_SUCCEEDED; + itcs->comment = itcs->comment_buf; + + longjmp(itcs->done_jmp_buf, 1); +} + +void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_SKIPPED; + itcs->comment = itcs->comment_buf; + + longjmp(itcs->done_jmp_buf, 1); +} + +void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + char buf[10]; + size_t bufsz = sizeof(buf); + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_FAILED; + itcs->comment = itcs->comment_buf; + + if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + && strcmp("true", buf) == 0) { + fprintf(stderr, "Testcase \"%s\" failed: %s\n", + itcs->visible.testcase_name, itcs->comment); + abort(); + } + + longjmp(itcs->done_jmp_buf, 1); +} + +void *testcase_alloc(size_t size) +{ + return driver_alloc(size); +} + +void *testcase_realloc(void *ptr, size_t size) +{ + return driver_realloc(ptr, size); +} + +void testcase_free(void *ptr) +{ + driver_free(ptr); +} diff --git a/erts/emulator/test/alloc_SUITE_data/testcase_driver.h b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h new file mode 100644 index 0000000000..66d567cb44 --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/testcase_driver.h @@ -0,0 +1,51 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#ifndef TESTCASE_DRIVER_H__ +#define TESTCASE_DRIVER_H__ + +#include "erl_driver.h" +#include + +typedef struct { + char *testcase_name; + char *command; + int command_len; + void *extra; +} TestCaseState_t; + +#define ASSERT(TCS, B) \ + ((void) ((B) ? 1 : testcase_assertion_failed((TCS), __FILE__, __LINE__, #B))) + + +void testcase_printf(TestCaseState_t *tcs, char *frmt, ...); +void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...); +void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...); +void testcase_failed(TestCaseState_t *tcs, char *frmt, ...); +int testcase_assertion_failed(TestCaseState_t *tcs, char *file, int line, + char *assertion); +void *testcase_alloc(size_t size); +void *testcase_realloc(void *ptr, size_t size); +void testcase_free(void *ptr); + + +char *testcase_name(void); +void testcase_run(TestCaseState_t *tcs); +void testcase_cleanup(TestCaseState_t *tcs); + +#endif diff --git a/erts/emulator/test/alloc_SUITE_data/threads.c b/erts/emulator/test/alloc_SUITE_data/threads.c new file mode 100644 index 0000000000..1247e5d7dd --- /dev/null +++ b/erts/emulator/test/alloc_SUITE_data/threads.c @@ -0,0 +1,447 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + + +#ifndef __WIN32__ +#include +#include +#include +#endif +#include +#include +#include +#include "testcase_driver.h" +#include "allocator_test.h" + +#ifdef __WIN32__ +#undef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 1 +#define vsnprintf _vsnprintf +#endif + +#ifndef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 0 +#endif + +#define NO_OF_ALLOC_SEQS 6 +#define NO_OF_THREADS (18) +#define NO_OF_BLOCKS 10 +#define NO_OF_OPS_PER_BL 200 +#define SBC_THRESHOLD 8192 + +#define BLOCK_ID(TN, BN) ((TN) << 4 | (BN)) + +#define ERR_BUF_SZ 4096 +static char err_buf[ERR_BUF_SZ]; +static volatile int tc_failed; +static int dead_thread_no; +static erts_mutex tc_mutex; +static erts_cond tc_cond; + +static void exit_thread(int t_no, int do_lock) +{ + if (do_lock) + THR_MTX_LOCK(tc_mutex); + + while (dead_thread_no >= 0) + THR_COND_WAIT(tc_cond, tc_mutex); + dead_thread_no = t_no; + + THR_COND_BCAST(tc_cond); + THR_MTX_UNLOCK(tc_mutex); + THR_EXIT(NULL); +} + +static void fail(int t_no, char *frmt, ...) +{ + char buf[10]; + size_t bufsz = sizeof(buf); + va_list va; + + THR_MTX_LOCK(tc_mutex); + + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(err_buf, ERR_BUF_SZ, frmt, va); +#else + vsprintf(err_buf, frmt, va); +#endif + va_end(va); + + tc_failed = 1; + + if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + && strcmp("true", buf) == 0) { + fprintf(stderr, "Testcase \"%s\" failed: %s\n", + testcase_name(), err_buf); + abort(); + } + + exit_thread(t_no, 0); +} + +static Allctr_t *alloc_not_ts = NULL; +static Allctr_t *alloc_ts_1 = NULL; +static Allctr_t *alloc_ts_2 = NULL; + +static void stop_allocators(void) +{ + if (alloc_not_ts) { + STOP_ALC(alloc_not_ts); + alloc_not_ts = NULL; + } + if (alloc_ts_1) { + STOP_ALC(alloc_ts_1); + alloc_ts_1 = NULL; + } + if (alloc_ts_2) { + STOP_ALC(alloc_ts_2); + alloc_ts_2 = NULL; + } +} + + +void *thread_func(void *arg); + +typedef struct { + Allctr_t *a; + int t_no; + int no_ops_per_bl; +} ThreadData; + + +char * +testcase_name(void) +{ + return "threads"; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + stop_allocators(); +} + +void +testcase_run(TestCaseState_t *tcs) +{ + struct { + erts_thread tid; + ThreadData arg; + } threads[NO_OF_THREADS+1] = {{0}}; + int no_threads; + int i; + char sbct_buf[10]; + char *argv_org[] = {"-tasaobf", "-tmmsbc5000", "-tmmmbc5000", "-tsbct", + &sbct_buf[0], NULL}; + char *argv[sizeof(argv_org)/sizeof(argv_org[0])]; + + if (!IS_THREADS_ENABLED) + testcase_skipped(tcs, "Threads not enabled"); + + alloc_not_ts = NULL; + alloc_ts_1 = NULL; + alloc_ts_2 = NULL; + + err_buf[0] = '\0'; + + sprintf(sbct_buf, "%d", SBC_THRESHOLD/1024); + + memcpy((void *) argv, argv_org, sizeof(argv_org)); + alloc_not_ts = START_ALC("threads_not_ts", 0, argv); + ASSERT(tcs, alloc_not_ts); + memcpy((void *) argv, argv_org, sizeof(argv_org)); + alloc_ts_1 = START_ALC("threads_ts_1", 1, argv); + ASSERT(tcs, alloc_ts_1); + memcpy((void *) argv, argv_org, sizeof(argv_org)); + alloc_ts_2 = START_ALC("threads_ts_2", 1, argv); + ASSERT(tcs, alloc_ts_2); + + ASSERT(tcs, !IS_ALLOC_THREAD_SAFE(alloc_not_ts)); + ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_1)); + ASSERT(tcs, IS_ALLOC_THREAD_SAFE(alloc_ts_2)); + + tc_mutex = THR_MTX_CREATE(); + tc_cond = THR_COND_CREATE(); + + THR_MTX_LOCK(tc_mutex); + + dead_thread_no = -1; + no_threads = 0; + + for(i = 1; i <= NO_OF_THREADS; i++) { + char *alc; + int res; + + threads[i].arg.no_ops_per_bl = NO_OF_OPS_PER_BL; + + if (i == 1) { + alc = "threads_not_ts"; + threads[i].arg.no_ops_per_bl *= 2; + threads[i].arg.a = alloc_not_ts; + } + else if (i % 2 == 0) { + alc = "threads_ts_1"; + threads[i].arg.a = alloc_ts_1; + } + else { + alc = "threads_ts_2"; + threads[i].arg.a = alloc_ts_2; + } + threads[i].arg.t_no = i; + + threads[i].tid = THR_CREATE(thread_func, (void *) &threads[i].arg); + if (threads[i].tid) { + testcase_printf(tcs, "Successfully created thread %d " + "using %s_alloc\n", i, alc); + no_threads++; + } + else { + tc_failed = 1; + sprintf(err_buf, "Failed to create thread %d\n", i); + break; + } + + } + + while (no_threads) { + THR_COND_WAIT(tc_cond, tc_mutex); + if (dead_thread_no >= 0) { + no_threads--; + THR_JOIN(threads[dead_thread_no].tid); + testcase_printf(tcs, "Thread %d died\n", dead_thread_no); + dead_thread_no = -1; + THR_COND_BCAST(tc_cond); + } + } + + THR_MTX_UNLOCK(tc_mutex); + THR_MTX_DESTROY(tc_mutex); + THR_COND_DESTROY(tc_cond); + + stop_allocators(); + + if (tc_failed) + testcase_failed(tcs, "%s", err_buf); +} + +Ulong alloc_seq_1[] = { + 17, + SBC_THRESHOLD*2, + SBC_THRESHOLD*20, + SBC_THRESHOLD*2, + 17, + 0 +}; + +Ulong alloc_seq_2[] = { + SBC_THRESHOLD*20, + SBC_THRESHOLD*2, + 17, + SBC_THRESHOLD*2, + SBC_THRESHOLD*20, + 0 +}; + +Ulong alloc_seq_3[] = { + 1, + SBC_THRESHOLD/10, + SBC_THRESHOLD/9, + SBC_THRESHOLD/8, + SBC_THRESHOLD/7, + SBC_THRESHOLD/6, + SBC_THRESHOLD/5, + SBC_THRESHOLD/4, + SBC_THRESHOLD/3, + SBC_THRESHOLD/2, + SBC_THRESHOLD/1, + SBC_THRESHOLD*1, + SBC_THRESHOLD*2, + SBC_THRESHOLD*3, + SBC_THRESHOLD*4, + SBC_THRESHOLD*5, + SBC_THRESHOLD*6, + SBC_THRESHOLD*7, + SBC_THRESHOLD*8, + SBC_THRESHOLD*9, + SBC_THRESHOLD*10, + SBC_THRESHOLD*9, + SBC_THRESHOLD*8, + SBC_THRESHOLD*7, + SBC_THRESHOLD*6, + SBC_THRESHOLD*5, + SBC_THRESHOLD*4, + SBC_THRESHOLD*3, + SBC_THRESHOLD*2, + SBC_THRESHOLD*1, + SBC_THRESHOLD/2, + SBC_THRESHOLD/3, + SBC_THRESHOLD/4, + SBC_THRESHOLD/5, + SBC_THRESHOLD/6, + SBC_THRESHOLD/7, + SBC_THRESHOLD/8, + SBC_THRESHOLD/9, + SBC_THRESHOLD/10, + 1, + 0 +}; + +Ulong alloc_seq_4[] = { + SBC_THRESHOLD*2, + SBC_THRESHOLD*3, + SBC_THRESHOLD*7, + SBC_THRESHOLD*8, + SBC_THRESHOLD*5, + SBC_THRESHOLD*6, + SBC_THRESHOLD*1, + SBC_THRESHOLD*10, + SBC_THRESHOLD*4, + SBC_THRESHOLD*2, + 0 +}; + +Ulong alloc_seq_5[] = { + SBC_THRESHOLD/2, + SBC_THRESHOLD/3, + SBC_THRESHOLD/7, + SBC_THRESHOLD/8, + SBC_THRESHOLD/5, + SBC_THRESHOLD/6, + SBC_THRESHOLD/1, + SBC_THRESHOLD/10, + SBC_THRESHOLD/4, + SBC_THRESHOLD/2, + SBC_THRESHOLD/3, + SBC_THRESHOLD/7, + SBC_THRESHOLD/8, + SBC_THRESHOLD/5, + SBC_THRESHOLD/6, + SBC_THRESHOLD/1, + SBC_THRESHOLD/10, + SBC_THRESHOLD/4, + SBC_THRESHOLD/2, + 0 +}; + +Ulong alloc_seq_6[] = { + 1, 50, 100, 50, 23, 46, 2345, 23, 54, 2, 0 +}; + +Ulong *alloc_seqs[NO_OF_ALLOC_SEQS] = { + alloc_seq_1, + alloc_seq_2, + alloc_seq_3, + alloc_seq_4, + alloc_seq_5, + alloc_seq_6 +}; + +typedef struct { + unsigned char *p; + Ulong s; + int i; + Ulong *as; +} block; + +#define CHECK_BLOCK_DATA(T, P, S, D) \ + check_block_data(__FILE__, __LINE__, (T), (P), (S), (D)) + +static void +check_block_data(char *file, int line, int t_no, + unsigned char *p, Ulong sz, int d) +{ + Ulong i; + for (i = 0; i < sz; i++) + if (p[i] != (unsigned char) d) + fail(t_no, "%s:%d: Thread no %d found clobbered data! " + "found id=%d; expected id=%d\n", + file, line, t_no, (int) p[i], d); +} + +static void +alloc_op(int t_no, Allctr_t *a, block *bp, int id, int clean_up) +{ + if (tc_failed) + exit_thread(t_no, 1); + + if(bp->p) + CHECK_BLOCK_DATA(t_no, bp->p, bp->s, id); + + if(bp->as[bp->i] == 0 || clean_up) { + FREE(a, bp->p); + bp->p = NULL; + bp->s = 0; + bp->i = 0; /* start from the beginning again */ + return; + } + + if(!bp->p) { + bp->s = bp->as[bp->i]; + bp->p = (unsigned char *) ALLOC(a, bp->s); + if(!bp->p) + fail(t_no, "ALLOC(%lu) failed [id=%d])\n", bp->s, id); + memset((void *) bp->p, id, (size_t) bp->s); + } + else { + unsigned char *p = (unsigned char *) REALLOC(a, bp->p, bp->as[bp->i]); + if(!p) + fail(t_no, "REALLOC(0x%lx, %lu) failed [id=%d]\n", + (Ulong) bp->p, bp->as[bp->i], id); + + if(bp->s < bp->as[bp->i]) { + CHECK_BLOCK_DATA(t_no, p, bp->s, id); + memset((void *) p, id, (size_t) bp->as[bp->i]); + } + else + CHECK_BLOCK_DATA(t_no, p, bp->as[bp->i], id); + + bp->s = bp->as[bp->i]; + bp->p = p; + } + + bp->i++; +} + + +void * +thread_func(void *arg) +{ + int i, j; + ThreadData *td = ((ThreadData *) arg); + block bs[NO_OF_BLOCKS]; + + for(i = 0; i < NO_OF_BLOCKS; i++) { + bs[i].p = NULL; + bs[i].s = 0; + bs[i].i = 0; + bs[i].as = alloc_seqs[i % NO_OF_ALLOC_SEQS]; + } + + for(i = 0; i < td->no_ops_per_bl; i++) { + + for(j = 0; j < NO_OF_BLOCKS; j++) + alloc_op(td->t_no, td->a, &bs[j], BLOCK_ID(td->t_no, j), 0); + } + + for(j = 0; j < NO_OF_BLOCKS; j++) + alloc_op(td->t_no, td->a, &bs[j], BLOCK_ID(td->t_no, j), 1); + + exit_thread(td->t_no, 1); + return NULL; +} diff --git a/erts/emulator/test/beam_SUITE.erl b/erts/emulator/test/beam_SUITE.erl new file mode 100644 index 0000000000..cc1626630b --- /dev/null +++ b/erts/emulator/test/beam_SUITE.erl @@ -0,0 +1,281 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_SUITE). + +-export([all/1, packed_registers/1, apply_last/1, apply_last_bif/1, + buildo_mucho/1, heap_sizes/1, big_lists/1]). + +-export([applied/2]). + +-include("test_server.hrl"). + +all(suite) -> + [packed_registers, apply_last, apply_last_bif, buildo_mucho, + heap_sizes, big_lists]. + + +%% Verify that apply(M, F, A) is really tail recursive. +apply_last(Config) when is_list(Config) -> + Pid=spawn(?MODULE, applied, [self(), 10000]), + Size = + receive + {Pid, finished} -> + stack_size(Pid) + after 30000 -> + ?t:fail("applied/2 timed out.") + end, + Pid ! die, + ?t:format("Size: ~p~n", [Size]), + if + Size < 700 -> + ok; + true -> + ?t:fail("10000 apply() grew stack too much.") + end, + ok. + +stack_size(Pid) -> + {heap_size, HS}=process_info(Pid, heap_size), + {stack_size,SS}=process_info(Pid, stack_size), + HS+SS. + +applied(Starter, 0) -> + Starter ! {self(), finished}, + receive + die -> + ok + end, + ok; +applied(Starter, N) -> + apply(?MODULE, applied, [Starter, N-1]). + +%% Verify that tail-recursive use of apply(M,F,A) on a Bif works." +apply_last_bif(Config) when is_list(Config) -> + apply(erlang, abs, [1]). + +%% Test three high register numbers in a put_list instruction +%% (to test whether packing works properly). +packed_registers(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line Mod = packed_regs, + ?line Name = filename:join(PrivDir, atom_to_list(Mod) ++ ".erl"), + + %% Generate a module which generates a list of tuples. + %% put_list(A) -> [{A, 600}, {A, 999}, ... {A, 0}]. + ?line Code = gen_packed_regs(600, ["-module("++atom_to_list(Mod)++").\n", + "-export([put_list/1]).\n", + "put_list(A) ->\n["]), + ?line ok = file:write_file(Name, Code), + + %% Compile the module. + ?line io:format("Compiling: ~s\n", [Name]), + ?line CompRc = compile:file(Name, [{outdir, PrivDir}, report]), + ?line io:format("Result: ~p\n",[CompRc]), + ?line {ok, Mod} = CompRc, + + %% Load it. + ?line io:format("Loading...\n",[]), + ?line LoadRc = code:load_abs(filename:join(PrivDir, atom_to_list(Mod))), + ?line {module,_Module} = LoadRc, + + %% Call it and verify result. + ?line Term = {a, b}, + ?line L = Mod:put_list(Term), + ?line verify_packed_regs(L, Term, 600), + ok. + +gen_packed_regs(0, Acc) -> + [Acc|"{A,0}].\n"]; +gen_packed_regs(N, Acc) -> + gen_packed_regs(N-1, [Acc,"{A,",integer_to_list(N)|"},\n"]). + +verify_packed_regs([], _, -1) -> ok; +verify_packed_regs([{Term, N}| T], Term, N) -> + verify_packed_regs(T, Term, N-1); +verify_packed_regs(L, Term, N) -> + ?line ok = io:format("Expected [{~p, ~p}|T]; got\n~p\n", [Term, N, L]), + ?line test_server:fail(). + +buildo_mucho(Config) when is_list(Config) -> + ?line buildo_mucho_1(), + ok. + +buildo_mucho_1() -> + %% Thanks to Per Gustafsson, HiPE. + [{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}, + {<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1},{<<>>,1}]. + +heap_sizes(Config) when is_list(Config) -> + ?line Sizes = erlang:system_info(heap_sizes), + ?line io:format("~p heap sizes\n", [length(Sizes)]), + ?line io:format("~p\n", [Sizes]), + + %% Verify that heap sizes increase monotonically. + ?line Largest = lists:foldl(fun(E, P) when is_integer(P), E > P -> E; + (E, []) -> E + end, [], Sizes), + + %% Verify that the largest heap size consists of 31 or 63 bits. + ?line + case Largest bsr (erlang:system_info(wordsize)*8-2) of + R when R > 0 -> ok + end, + ok. + +%% Thanks to Igor Goryachev. + +big_lists(Config) when is_list(Config) -> + b(), + ok. + +a() -> + {selected, + ["uid", + "nickname", + "n_family", + "n_given", + "email_pref", + "tel_home_number", + "tel_cellular_number", + "adr_home_country", + "adr_home_locality", + "adr_home_region", + "url", + "gender", + "bday", + "constitution", + "height", + "weight", + "hair", + "routine", + "smoke", + "maritalstatus", + "children", + "independence", + "school_number", + "school_locality", + "school_title", + "school_period", + "org_orgname", + "title", + "adr_work_locality", + "photo_type", + "photo_binval"], + [{"test"}]}. + +b() -> + case a() of + {selected, + ["uid", + "nickname", + "n_family", + "n_given", + "email_pref", + "tel_home_number", + "tel_cellular_number", + "adr_home_country", + "adr_home_locality", + "adr_home_region", + "url", + "gender", + "bday", + "constitution", + "height", + "weight", + "hair", + "routine", + "smoke", + "maritalstatus", + "children", + "independence", + "school_number", + "school_locality", + "school_title", + "school_period", + "org_orgname", + "title", + "adr_work_locality", + "photo_type", + "photo_binval"], + _} -> + ok + end. diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl new file mode 100644 index 0000000000..75841adbfc --- /dev/null +++ b/erts/emulator/test/beam_literals_SUITE.erl @@ -0,0 +1,433 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(beam_literals_SUITE). +-export([all/1]). +-export([putting/1, matching_smalls/1, matching_smalls_jt/1, + matching_bigs/1, matching_more_bigs/1, + matching_bigs_and_smalls/1, badmatch/1, case_clause/1, + receiving/1, literal_type_tests/1, + put_list/1, fconv/1, literal_case_expression/1]). + +-include("test_server.hrl"). + +all(suite) -> + [putting, matching_smalls, matching_smalls_jt, + matching_bigs, matching_more_bigs, + matching_bigs_and_smalls, badmatch, case_clause, + receiving, literal_type_tests, + put_list, fconv, literal_case_expression]. + +putting(doc) -> "Test creating lists and tuples containing big number literals."; +putting(Config) when is_list(Config) -> + -773973888575883407313908 = chksum(putting1(8987697898797)). + +putting1(X) -> + {8797987987987987872256443, [1324483773773], {3.1415, 2.71, [2.5, 35.125|9.31]}, + [X|349873987387373], + [329878349873|-387394729872], -773973937933873929749873}. + +matching_bigs(doc) -> "Test matching of a few big number literals (in Beam," + "select_val/3 will NOT be used)."; +matching_bigs(Config) when is_list(Config) -> + a = matching1(3972907842873739), + b = matching1(-389789298378939783333333333333333333784), + other = matching1(42). + +matching_smalls(doc) -> "Test matching small numbers (both positive and negative)."; +matching_smalls(Config) when is_list(Config) -> + ?line a = m_small(-42), + ?line b = m_small(0), + ?line c = m_small(105), + ?line d = m_small(-13), + ?line e = m_small(337848), + ?line other = m_small(324), + ?line other = m_small(-7), + ok. + +m_small(-42) -> a; +m_small(0) -> b; +m_small(105) -> c; +m_small(-13) -> d; +m_small(337848) -> e; +m_small(_) -> other. + +matching_smalls_jt(doc) -> + "Test matching small numbers (both positive and negative). " + "Make sure that a jump table is used."; +matching_smalls_jt(Config) when is_list(Config) -> + ?line a = m_small_jt(-2), + ?line b = m_small_jt(-1), + ?line c = m_small_jt(0), + ?line d = m_small_jt(2), + ?line e = m_small_jt(3), + ?line other = m_small(324), + ?line other = m_small(-7), + ok. + +m_small_jt(-2) -> a; +m_small_jt(-1) -> b; +m_small_jt(0) -> c; +m_small_jt(2) -> d; +m_small_jt(3) -> e; +m_small_jt(_) -> other. + +%% Big numbers, no select_val. + +matching1(3972907842873739) -> a; +matching1(-389789298378939783333333333333333333784) -> b; +matching1(_) -> other. + + +matching_more_bigs(doc) -> "Test matching of a big number literals (in Beam," + "a select_val/3 instruction will be used)."; +matching_more_bigs(Config) when is_list(Config) -> + a = matching2(-999766349740978337), + b = matching2(9734097866575478), + c = matching2(-966394677364879734), + d = matching2(13987294872948990), + e = matching2(777723896192459245), + other = matching2(7), + other = matching2(39789827988888888888888888888347474444444444444444444). + +%% Big numbers with select_val. + +matching2(-999766349740978337) -> a; +matching2(9734097866575478) -> b; +matching2(-966394677364879734) -> c; +matching2(13987294872948990) -> d; +matching2(777723896192459245) -> e; +matching2(_) -> other. + +matching_bigs_and_smalls(doc) -> "Test matching of a mix of big numbers and literals."; +matching_bigs_and_smalls(suite) -> []; +matching_bigs_and_smalls(Config) when is_list(Config) -> + a = matching3(38472928723987239873873), + b = matching3(0), + c = matching3(-3873973932710954671207461057614287561348756348743634876436784367873), + d = matching3(3978429867297393873), + e = matching3(42), + f = matching3(-4533), + other = matching3(77), + other = matching3(39274120984379249874219748). + +%% Mixed small and big. + +matching3(38472928723987239873873) -> a; +matching3(0) -> b; +matching3(-3873973932710954671207461057614287561348756348743634876436784367873) -> c; +matching3(3978429867297393873) -> d; +matching3(42) -> e; +matching3(-4533) -> f; +matching3(_) -> other. + +badmatch(doc) -> "Test literal badmatches with big number and floats."; +badmatch(Config) when is_list(Config) -> + %% We are satisfied if we can load this module and run it. + Big = id(32984798729847892498297824872982972978239874), + Float = id(3.1415927), + ?line catch a = Big, + ?line catch b = Float, + ?line {'EXIT',{{badmatch,3879373498378993387},_}} = + (catch c = 3879373498378993387), + ?line {'EXIT',{{badmatch,7.0},_}} = (catch d = 7.0), + ?line case Big of + Big -> ok + end, + ?line case Float of + Float -> ok + end, + ok. + +case_clause(Config) when is_list(Config) -> + ?line {'EXIT',{{case_clause,337.0},_}} = (catch case_clause_float()), + ?line {'EXIT',{{try_clause,42.0},_}} = (catch try_case_clause_float()), + ?line {'EXIT',{{case_clause,37932749837839747383847398743789348734987},_}} = + (catch case_clause_big()), + ?line {'EXIT',{{try_clause,977387349872349870423364354398566348},_}} = + (catch try_case_clause_big()), + ok. + +case_clause_float() -> + case 337.0 of + blurf -> ok + end. + +try_case_clause_float() -> + try 42.0 of + blurf -> ok + catch _:_ -> + error + end. + +case_clause_big() -> + case 37932749837839747383847398743789348734987 of + blurf -> ok + end. + +try_case_clause_big() -> + try 977387349872349870423364354398566348 of + blurf -> ok + catch _:_ -> + error + end. + +receiving(doc) -> "Test receive with a big number literal (more than 27 bits, " + "less than 32 bits)."; +receiving(Config) when is_list(Config) -> + Self = self(), + spawn(fun() -> Self ! here_is_a_message end), + ok = receive + here_is_a_message -> + ok + after 16#f1234567 -> + timeout + end. + +literal_type_tests(doc) -> "Test type tests on literal values."; +literal_type_tests(Config) when is_list(Config) -> + %% Generate an Erlang module with all different type of type tests. + ?line Tests = make_test([{T, L} || T <- type_tests(), L <- literals()]), + ?line Mod = literal_test, + ?line Func = {function, 0, test, 0, [{clause,0,[],[],Tests}]}, + ?line Form = [{attribute,0,module,Mod}, + {attribute,0,compile,export_all}, + Func, {eof,0}], + + %% Print generated code for inspection. + ?line lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form), + + %% Test compile:form/1. This implies full optimization (default). + ?line {ok,Mod,Code1} = compile:forms(Form), + ?line {module,Mod} = code:load_binary(Mod, Mod, Code1), + ?line Mod:test(), + ?line true = code:delete(Mod), + ?line code:purge(Mod), + + %% Test compile:form/2. Turn off all optimizations. + ?line {ok,Mod,Code2} = compile:forms(Form, [binary,report,time, + no_copt,no_postopt]), + ?line {module,Mod} = code:load_binary(Mod, Mod, Code2), + ?line Mod:test(), + ?line true = code:delete(Mod), + ?line code:purge(Mod), + ok. + +make_test([{is_function=T,L}|Ts]) -> + [test(T, L),test(T, 0, L)|make_test(Ts)]; +make_test([{T,L}|Ts]) -> + [test(T, L)|make_test(Ts)]; +make_test([]) -> []. + +test(T, L) -> + S = lists:flatten(io_lib:format("begin io:format(\"~~p~~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])), + {ok,Toks,_Line} = erl_scan:string(S), + {ok,E} = erl_parse:parse_exprs(Toks), + {value,Val,_Bs} = erl_eval:exprs(E, []), + {match,0,{atom,0,Val},hd(E)}. + +test(T, A, L) -> + S = lists:flatten(io_lib:format("begin io:format(\"~~p~~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", + [T,L,A,T,L,A])), + {ok,Toks,_Line} = erl_scan:string(S), + {ok,E} = erl_parse:parse_exprs(Toks), + {value,Val,_Bs} = erl_eval:exprs(E, []), + {match,0,{atom,0,Val},hd(E)}. + +literals() -> + [42, + 3.14, + -3, + 32982724987789283473473838474, + [], + xxxx]. + +type_tests() -> + [is_boolean, + is_integer, + is_float, + is_number, + is_atom, + is_list, + is_tuple, + is_pid, + is_reference, + is_port, + is_binary, + is_function]. + +put_list(Config) when is_list(Config) -> + %% put_list x0 Literal Reg + ?line [Config|8739757395764] = put_list_rqr(Config), + ?line {[Config|7779757395764],Config} = put_list_rqx(Config), + ?line [Config|98765432100000] = put_list_rqy(Config), + + %% put_list x Literal Reg + ?line [Config|16#FFFFF77777137483769] = put_list_xqr(ignore, Config), + ?line {[Config|16#AAAAAFFFFF77777],{a,b},Config} = put_list_xqx({a,b}, Config), + ?line [Config|12777765432979879] = put_list_xqy(ignore, Config), + + %% put_list y Literal Reg + ?line [Config|17424134793676869867] = put_list_yqr(Config), + ?line {[Config|77424134793676869867],Config} = put_list_yqx(Config), + ?line {Config,[Config|16#BCDEFF4241676869867]} = put_list_yqy(Config), + + %% put_list Literal x0 Reg + ?line [42.0|Config] = put_list_qrr(Config), + ?line [Config,42.0|Config] = put_list_qrx(Config), + ?line [100.0|Config] = put_list_qry(Config), + + %% put_list Literal x1 Reg + ?line [127.0|Config] = put_list_qxr({ignore,me}, Config), + ?line [Config,130.0|Config] = put_list_qxx(ignore, Config), + ?line [99.0|Config] = put_list_qxy(Config), + + %% put_list Literal y0 Reg + ?line [200.0|Config] = put_list_qyr(Config), + ?line [Config,210.0|Config] = put_list_qyx(Config), + ?line [[300.0|Config]|Config] = put_list_qyy(Config), + + ok. + +%% put_list x0 Literal x0 +put_list_rqr(Config) -> [Config|8739757395764]. + +%% put_list x0 Literal x1 +put_list_rqx(Config) -> {[Config|7779757395764],Config}. + +%% put_list x0 Literal y0 +put_list_rqy(Config) -> + Res = [Config|98765432100000], + id(42), + Res. + +%% put_list x1 Literal x0 +put_list_xqr(_, Config) -> [Config|16#FFFFF77777137483769]. + +%% put_list x1 Literal x2 +put_list_xqx(A, Config) -> {[Config|16#AAAAAFFFFF77777],A,Config}. + +%% put_list x1 Literal y0 +put_list_xqy(_, Config) -> + Res = [Config|12777765432979879], + id(42), + Res. + +%% put_list y0 Literal x0 +put_list_yqr(Config) -> + id(Config), + [Config|17424134793676869867]. + +%% put_list y0 Literal x1 +put_list_yqx(Config) -> + id(Config), + {[Config|77424134793676869867],Config}. + +%% put_list y1 Literal y0 +put_list_yqy(Config) -> + id(Config), + Res = [Config|16#BCDEFF4241676869867], + id(Config), + {Config,Res}. + +%% put_list Literal x0 x0 +put_list_qrr(Config) -> + [42.0|Config]. + +%% put_list Literal x0 x1 +put_list_qrx(Config) -> + [Config,42.0|Config]. + +%% put_list Literal x0 y0 +put_list_qry(Config) -> + Res = [100.0|Config], + id(0), + Res. + +%% put_list Literal x1 x0 +put_list_qxr(_, Config) -> + [127.0|Config]. + +%% put_list Literal x1 x2 +put_list_qxx(_, Config) -> + [Config,130.0|Config]. + +%% put_list Literal x1 y0 +put_list_qxy(Config) -> + Res = [99.0|Config], + id(0), + Res. + +%% put_list Literal y0 x0 +put_list_qyr(Config) -> + id(Config), + [200.0|Config]. + +%% put_list Literal y0 x1 +put_list_qyx(Config) -> + id(Config), + [Config,210.0|Config]. + +%% put_list Literal y1 y0 +put_list_qyy(Config) -> + id(Config), + Res = [300.0|Config], + id(Config), + [Res|Config]. + +fconv(Config) when is_list(Config) -> + ?line 5.0 = fconv_1(-34444444450.0), + ?line 13.0 = fconv_2(7.0), + ok. + +fconv_1(F) when is_float(F) -> + 34444444455 + F. + +fconv_2(F) when is_float(F) -> + 6.0 + F. + +literal_case_expression(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line Src = filename:join(DataDir, "literal_case_expression"), + ?line {ok,literal_case_expression=Mod,Code} = compile:file(Src, [from_asm,binary]), + ?line {module,Mod} = code:load_binary(Mod, Src, Code), + ?line ok = Mod:x(), + ?line ok = Mod:y(), + ?line true = code:delete(Mod), + ?line code:purge(Mod), + ok. + +%% Help functions. + +chksum(Term) -> + chksum(Term, 0). + +chksum([List|T], Sum) when is_list(List) -> + chksum(T, chksum(List, Sum)); +chksum([H|T], Sum) -> + chksum(T, chksum(H, Sum)); +chksum([], Sum) -> Sum; +chksum(Tuple, Sum) when is_tuple(Tuple) -> + chksum(tuple_to_list(Tuple), Sum); +chksum(Int, Sum) when is_integer(Int) -> + Sum * 5 + Int; +chksum(Other, Sum) -> + erlang:phash2([Other|Sum], 39729747). + +id(I) -> I. diff --git a/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S b/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S new file mode 100644 index 0000000000..c0ffe9ab53 --- /dev/null +++ b/erts/emulator/test/beam_literals_SUITE_data/literal_case_expression.S @@ -0,0 +1,70 @@ +{module, literal_case_expression}. %% version = 0 + +{exports, [{module_info,0},{module_info,1},{x,0},{y,0}]}. + +{attributes, []}. + +{labels, 15}. + + +{function, x, 0, 2}. + {label,1}. + {func_info,{atom,literal_case_expression},{atom,x},0}. + {label,2}. + {test,is_integer,{f,5},[{integer,343434343434}]}. + {select_val,{integer,343434343434}, + {f,5}, + {list,[{integer,343434343434}, + {f,3}, + {integer,397439}, + {f,4}, + {integer,3976554567454}, + {f,4}]}}. + {label,3}. + {move,{atom,ok},{x,0}}. + return. + {label,4}. + {move,{atom,error},{x,0}}. + return. + {label,5}. + {case_end,{integer,343434343434}}. + + +{function, y, 0, 7}. + {label,6}. + {func_info,{atom,literal_case_expression},{atom,y},0}. + {label,7}. + {test,is_float,{f,10},[{float,34.0000}]}. + {select_val,{float,34.0000}, + {f,10}, + {list,[{float,34.0000}, + {f,8}, + {float,397.655}, + {f,9}, + {float,39.7439}, + {f,9}]}}. + {label,8}. + {move,{atom,ok},{x,0}}. + return. + {label,9}. + {move,{atom,error},{x,0}}. + return. + {label,10}. + {case_end,{float,34.0000}}. + + +{function, module_info, 0, 12}. + {label,11}. + {func_info,{atom,literal_case_expression},{atom,module_info},0}. + {label,12}. + {move,{atom,literal_case_expression},{x,0}}. + {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. + + +{function, module_info, 1, 14}. + {label,13}. + {func_info,{atom,literal_case_expression},{atom,module_info},1}. + {label,14}. + {move,{x,0},{x,1}}. + {move,{atom,literal_case_expression},{x,0}}. + {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/erts/emulator/test/bif_SUITE.erl b/erts/emulator/test/bif_SUITE.erl new file mode 100644 index 0000000000..cfbc5dfe81 --- /dev/null +++ b/erts/emulator/test/bif_SUITE.erl @@ -0,0 +1,317 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(bif_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + t_list_to_existing_atom/1,os_env/1,otp_7526/1, + binary_to_atom/1,binary_to_existing_atom/1, + atom_to_binary/1,min_max/1]). + +all(suite) -> + [t_list_to_existing_atom,os_env,otp_7526, + atom_to_binary,binary_to_atom,binary_to_existing_atom, + min_max]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(1)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +t_list_to_existing_atom(Config) when is_list(Config) -> + ?line all = list_to_existing_atom("all"), + ?line ?MODULE = list_to_existing_atom(?MODULE_STRING), + ?line UnlikelyStr = "dsfj923874390867er869fds9864y97jhg3973qerueoru", + try + ?line list_to_existing_atom(UnlikelyStr), + ?line ?t:fail() + catch + error:badarg -> ok + end, + + %% The compiler has become smarter! We need the call to id/1 in + %% the next line. + ?line UnlikelyAtom = list_to_atom(id(UnlikelyStr)), + ?line UnlikelyAtom = list_to_existing_atom(UnlikelyStr), + ok. + +os_env(doc) -> + []; +os_env(suite) -> + []; +os_env(Config) when is_list(Config) -> + ?line EnvVar1 = "MjhgvFDrresdCghN mnjkUYg vfrD", + ?line false = os:getenv(EnvVar1), + ?line true = os:putenv(EnvVar1, "mors"), + ?line "mors" = os:getenv(EnvVar1), + ?line true = os:putenv(EnvVar1, ""), + ?line case os:getenv(EnvVar1) of + "" -> ?line ok; + false -> ?line ok; + BadVal -> ?line ?t:fail(BadVal) + end, + %% os:putenv and os:getenv currently uses a temp buf of size 1024 + %% for storing key+value + ?line os_env_long(1010, 1030, "hej hopp"). + +os_env_long(Min, Max, _Value) when Min > Max -> + ?line ok; +os_env_long(Min, Max, Value) -> + ?line EnvVar = lists:duplicate(Min, $X), + ?line true = os:putenv(EnvVar, Value), + ?line Value = os:getenv(EnvVar), + ?line true = os:putenv(EnvVar, ""), + ?line os_env_long(Min+1, Max, Value). + +otp_7526(doc) -> + ["Test that string:to_integer does not Halloc in wrong order."]; +otp_7526(Config) when is_list(Config) -> + ok = test_7526(256). + +iterate_7526(0, Acc) -> Acc; +iterate_7526(N, Acc) -> + iterate_7526(N - 1, + [case string:to_integer("9223372036854775808,\n") of + {Int, _Foo} -> Int + end | Acc]). + +do_test_7526(N,M) -> + {Self, Ref} = {self(), make_ref()}, + T = erlang:make_tuple(M,0), + spawn_opt(fun()-> + L = iterate_7526(N, []), + BadList = [X || X <- L, X =/= 9223372036854775808], + BadLen = length(BadList), + M = length(tuple_to_list(T)), + %%io:format("~b bad conversions: ~p~n", [BadLen, BadList]), + Self ! {done, Ref, BadLen} + end, + [link,{fullsweep_after,0}]), + receive {done, Ref, Len} -> Len end. + + +test_7526(0) -> + ok; +test_7526(N) -> + case do_test_7526(1000,N) of + 0 -> test_7526(N-1); + Other -> + {error,N,Other} + end. + +-define(BADARG(E), {'EXIT',{badarg,_}} = (catch E)). +-define(SYS_LIMIT(E), {'EXIT',{system_limit,_}} = (catch E)). + +binary_to_atom(Config) when is_list(Config) -> + HalfLong = lists:seq(0, 127), + HalfLongAtom = list_to_atom(HalfLong), + HalfLongBin = list_to_binary(HalfLong), + Long = lists:seq(0, 254), + LongAtom = list_to_atom(Long), + LongBin = list_to_binary(Long), + + %% latin1 + ?line '' = test_binary_to_atom(<<>>, latin1), + ?line '\377' = test_binary_to_atom(<<255>>, latin1), + ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, latin1), + ?line LongAtom = test_binary_to_atom(LongBin, latin1), + + %% utf8 + ?line '' = test_binary_to_atom(<<>>, utf8), + ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, utf8), + ?line HalfLongAtom = test_binary_to_atom(HalfLongBin, unicode), + ?line [] = [C || C <- lists:seq(128, 255), + begin + list_to_atom([C]) =/= + test_binary_to_atom(<>, utf8) + end], + + %% badarg failures. + ?line fail_binary_to_atom(atom), + ?line fail_binary_to_atom(42), + ?line fail_binary_to_atom({a,b,c}), + ?line fail_binary_to_atom([1,2,3]), + ?line fail_binary_to_atom([]), + ?line fail_binary_to_atom(42.0), + ?line fail_binary_to_atom(self()), + ?line fail_binary_to_atom(make_ref()), + ?line fail_binary_to_atom(<<0:7>>), + ?line fail_binary_to_atom(<<42:13>>), + ?line ?BADARG(binary_to_atom(id(<<>>), blurf)), + ?line ?BADARG(binary_to_atom(id(<<>>), [])), + + %% Bad UTF8 sequences. + ?line ?BADARG(binary_to_atom(id(<<255>>), utf8)), + ?line ?BADARG(binary_to_atom(id(<<255,0>>), utf8)), + ?line ?BADARG(binary_to_atom(id(<<0:512/unit:8,255>>), utf8)), + ?line ?BADARG(binary_to_atom(id(<<0:512/unit:8,255,0>>), utf8)), + ?line ?BADARG(binary_to_atom(id(<<16#C0,16#80>>), utf8)), %Overlong 0. + ?line [?BADARG(binary_to_atom(<>, utf8)) || + C <- lists:seq(256, 16#D7FF)], + ?line [?BADARG(binary_to_atom(<>, utf8)) || + C <- lists:seq(16#E000, 16#FFFD)], + ?line [?BADARG(binary_to_atom(<>, utf8)) || + C <- lists:seq(16#10000, 16#8FFFF)], + ?line [?BADARG(binary_to_atom(<>, utf8)) || + C <- lists:seq(16#90000, 16#10FFFF)], + + %% system_limit failures. + ?line ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, latin1)), + ?line ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, latin1)), + ?line ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, latin1)), + ?line ?SYS_LIMIT(binary_to_atom(<<0:256/unit:8>>, utf8)), + ?line ?SYS_LIMIT(binary_to_atom(<<0:257/unit:8>>, utf8)), + ?line ?SYS_LIMIT(binary_to_atom(<<0:512/unit:8>>, utf8)), + ok. + +test_binary_to_atom(Bin0, Encoding) -> + Res = binary_to_atom(Bin0, Encoding), + Res = binary_to_existing_atom(Bin0, Encoding), + Bin1 = id(<<7:3,Bin0/binary,32:5>>), + Sz = byte_size(Bin0), + <<_:3,UnalignedBin:Sz/binary,_:5>> = Bin1, + Res = binary_to_atom(UnalignedBin, Encoding). + +fail_binary_to_atom(Bin) -> + try + binary_to_atom(Bin, latin1) + catch + error:badarg -> + ok + end, + try + binary_to_atom(Bin, utf8) + catch + error:badarg -> + ok + end, + try + binary_to_existing_atom(Bin, latin1) + catch + error:badarg -> + ok + end, + try + binary_to_existing_atom(Bin, utf8) + catch + error:badarg -> + ok + end. + + +binary_to_existing_atom(Config) when is_list(Config) -> + ?line UnlikelyBin = <<"ou0897979655678dsfj923874390867er869fds973qerueoru">>, + try + ?line binary_to_existing_atom(UnlikelyBin, latin1), + ?line ?t:fail() + catch + error:badarg -> ok + end, + + try + ?line binary_to_existing_atom(UnlikelyBin, utf8), + ?line ?t:fail() + catch + error:badarg -> ok + end, + + ?line UnlikelyAtom = binary_to_atom(id(UnlikelyBin), latin1), + ?line UnlikelyAtom = binary_to_existing_atom(UnlikelyBin, latin1), + ok. + + +atom_to_binary(Config) when is_list(Config) -> + HalfLong = lists:seq(0, 127), + HalfLongAtom = list_to_atom(HalfLong), + HalfLongBin = list_to_binary(HalfLong), + Long = lists:seq(0, 254), + LongAtom = list_to_atom(Long), + LongBin = list_to_binary(Long), + + %% latin1 + ?line <<>> = atom_to_binary('', latin1), + ?line <<"abc">> = atom_to_binary(abc, latin1), + ?line <<127>> = atom_to_binary('\177', latin1), + ?line HalfLongBin = atom_to_binary(HalfLongAtom, latin1), + ?line LongBin = atom_to_binary(LongAtom, latin1), + + %% utf8. + ?line <<>> = atom_to_binary('', utf8), + ?line <<>> = atom_to_binary('', unicode), + ?line <<127>> = atom_to_binary('\177', utf8), + ?line <<"abcdef">> = atom_to_binary(abcdef, utf8), + ?line HalfLongBin = atom_to_binary(HalfLongAtom, utf8), + ?line LongAtomBin = atom_to_binary(LongAtom, utf8), + ?line verify_long_atom_bin(LongAtomBin, 0), + + %% Failing cases. + ?line fail_atom_to_binary(<<1>>), + ?line fail_atom_to_binary(42), + ?line fail_atom_to_binary({a,b,c}), + ?line fail_atom_to_binary([1,2,3]), + ?line fail_atom_to_binary([]), + ?line fail_atom_to_binary(42.0), + ?line fail_atom_to_binary(self()), + ?line fail_atom_to_binary(make_ref()), + ?line ?BADARG(atom_to_binary(id(a), blurf)), + ?line ?BADARG(atom_to_binary(id(b), [])), + ok. + +verify_long_atom_bin(<>, I) -> + verify_long_atom_bin(T, I+1); +verify_long_atom_bin(<<>>, 255) -> ok. + +fail_atom_to_binary(Term) -> + try + atom_to_binary(Term, latin1) + catch + error:badarg -> + ok + end, + try + atom_to_binary(Term, utf8) + catch + error:badarg -> + ok + end. + +min_max(Config) when is_list(Config) -> + ?line a = erlang:min(id(a), a), + ?line a = erlang:min(id(a), b), + ?line a = erlang:min(id(b), a), + ?line b = erlang:min(id(b), b), + ?line a = erlang:max(id(a), a), + ?line b = erlang:max(id(a), b), + ?line b = erlang:max(id(b), a), + ?line b = erlang:max(id(b), b), + + ?line 42.0 = erlang:min(42.0, 42), + ?line 42.0 = erlang:max(42.0, 42), + + ok. + +%% Helpers + +id(I) -> I. + diff --git a/erts/emulator/test/big_SUITE.erl b/erts/emulator/test/big_SUITE.erl new file mode 100644 index 0000000000..6cedd39009 --- /dev/null +++ b/erts/emulator/test/big_SUITE.erl @@ -0,0 +1,396 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(big_SUITE). + + +-export([all/1]). +-export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1, + borders/1, negative/1, big_float/1, big_float_1/1, big_float_2/1, + shift_limit_1/1, powmod/1, system_limit/1, otp_6692/1]). + +%% Internal exports. +-export([eval/1, funcall/2]). +-export([init/3]). + +-export([fac/1, fib/1, pow/2, gcd/2, lcm/2]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-include("test_server.hrl"). + +all(suite) -> + [t_div, eq_28, eq_32, eq_big, eq_math, big_literals, borders, + negative, big_float, shift_limit_1, powmod, system_limit, otp_6692]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(3)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +%% +%% Syntax of data files: +%% Expr1 = Expr2. +%% ... +%% built in functions are: +%% fac(N). +%% fib(N). +%% pow(X, N) == X ^ N +%% gcd(Q, R) +%% lcm(Q, R) +%% +eq_28(Config) when is_list(Config) -> + TestFile = test_file(Config, "eq_28.dat"), + test(TestFile). + +eq_32(Config) when is_list(Config) -> + TestFile = test_file(Config, "eq_32.dat"), + test(TestFile). + +eq_big(Config) when is_list(Config) -> + TestFile = test_file(Config, "eq_big.dat"), + test(TestFile). + +eq_math(Config) when is_list(Config) -> + TestFile = test_file(Config, "eq_math.dat"), + test(TestFile). + + +borders(doc) -> "Tests border cases between small/big."; +borders(Config) when is_list(Config) -> + TestFile = test_file(Config, "borders.dat"), + test(TestFile). + +negative(Config) when is_list(Config) -> + TestFile = test_file(Config, "negative.dat"), + test(TestFile). + + +%% Find test file +test_file(Config, Name) -> + DataDir = ?config(data_dir, Config), + filename:join(DataDir, Name). + +%% +%% +%% Run test on file test_big_seq.erl +%% +%% +test(File) -> + test(File, [node()]). + +test(File, Nodes) -> + ?line {ok,Fd} = file:open(File, [read]), + Res = test(File, Fd, Nodes), + file:close(Fd), + case Res of + {0,Cases} -> {comment, integer_to_list(Cases) ++ " cases"}; + {_,_} -> test_server:fail() + end. + +test(File, Fd, Ns) -> + test(File, Fd, Ns, 0, 0, 0). + +test(File, Fd, Ns, L, Cases, Err) -> + case io:parse_erl_exprs(Fd, '') of + {eof,_} -> {Err, Cases}; + {error, {Line,_Mod,Message}, _} -> + Fmt = erl_parse:format_error(Message), + io:format("~s:~w: error ~s~n", [File, Line+L, Fmt]), + {Err+1, Cases}; + {ok, [{match,ThisLine,Expr1,Expr2}], Line} -> + case multi_match(Ns, {op,0,'-',Expr1,Expr2}) of + [] -> + test(File, Fd, Ns, Line+L-1,Cases+1, Err); + [_|_] -> + PP = erl_pp:expr({op,0,'=/=',Expr1,Expr2}), + io:format("~s:~w : error ~s~n", [File,ThisLine+L, PP]), + test(File, Fd, Ns, Line+L-1,Cases+1, Err+1) + end; + {ok, Exprs, Line} -> + PP = erl_pp:exprs(Exprs), + io:format("~s: ~w: equation expected not ~s~n", [File,Line+L,PP]), + test(File, Fd, Ns, Line+L-1,Cases+1, Err+1) + end. + +multi_match(Ns, Expr) -> + multi_match(Ns, Expr, []). + +multi_match([Node|Ns], Expr, Rs) -> + ?line X = rpc:call(Node, big_SUITE, eval, [Expr]), + if X == 0 -> multi_match(Ns, Expr, Rs); + true -> multi_match(Ns, Expr, [{Node,X}|Rs]) + end; +multi_match([], _, Rs) -> Rs. + +eval(Expr) -> + Fun = {?MODULE,funcall}, + {value,V,_} = erl_eval:expr(Expr, [], Fun), %Applied arithmetic BIFs. + V = eval(Expr, Fun), %Real arithmetic instructions. + V. + +funcall(F, As) -> apply(?MODULE, F, As). + +%% Like a subset of erl_eval:expr/3, but uses real arithmetic instructions instead of +%% applying them (it does make a difference). + +eval({op,_,Op,A0}, LFH) -> + A = eval(A0, LFH), + Res = eval_op(Op, A), + erlang:garbage_collect(), + Res; +eval({op,_,Op,A0,B0}, LFH) -> + [A,B] = eval_list([A0,B0], LFH), + Res = eval_op(Op, A, B), + erlang:garbage_collect(), + Res; +eval({integer,_,I}, _) -> I; +eval({call,_,{atom,_,Local},Args0}, LFH) -> + Args = eval_list(Args0, LFH), + LFH(Local, Args). + +eval_list([E|Es], LFH) -> + [eval(E, LFH)|eval_list(Es, LFH)]; +eval_list([], _) -> []. + +eval_op('-', A) -> -A; +eval_op('+', A) -> +A; +eval_op('bnot', A) -> bnot A. + +eval_op('-', A, B) -> A - B; +eval_op('+', A, B) -> A + B; +eval_op('*', A, B) -> A * B; +eval_op('div', A, B) -> A div B; +eval_op('rem', A, B) -> A rem B; +eval_op('band', A, B) -> A band B; +eval_op('bor', A, B) -> A bor B; +eval_op('bxor', A, B) -> A bxor B; +eval_op('bsl', A, B) -> A bsl B; +eval_op('bsr', A, B) -> A bsr B. + +%% Built in test functions + +fac(0) -> 1; +fac(1) -> 1; +fac(N) -> N * fac(N-1). + +%% +%% X ^ N +%% +pow(_, 0) -> 1; +pow(X, 1) -> X; +pow(X, N) when (N band 1) == 1 -> + X2 = pow(X, N bsr 1), + X*X2*X2; +pow(X, N) -> + X2 = pow(X, N bsr 1), + X2*X2. + +fib(0) -> 1; +fib(1) -> 1; +fib(N) -> fib(N-1) + fib(N-2). + +%% +%% Gcd +%% +gcd(Q, 0) -> Q; +gcd(Q, R) -> gcd(R, Q rem R). + +%% +%% Least common multiple +%% +lcm(Q, R) -> + Q*R div gcd(Q, R). + + +%% Test case t_div cut in from R2D test suite. + +t_div(Config) when is_list(Config) -> + ?line 'try'(fun() -> 98765432101234 div 98765432101235 end, 0), + + % Big remainder, small quotient. + ?line 'try'(fun() -> 339254531512 div 68719476736 end, 4), + ok. + +'try'(Fun, Result) -> + 'try'(89, Fun, Result, []). + +'try'(0, _, _, _) -> + ok; +'try'(Iter, Fun, Result, Filler) -> + spawn(?MODULE, init, [self(), Fun, list_to_tuple(Filler)]), + receive + {result, Result} -> + 'try'(Iter-1, Fun, Result, [0|Filler]); + {result, Other} -> + io:format("Expected ~p; got ~p~n", [Result, Other]), + test_server:fail() + end. + +init(ReplyTo, Fun, _Filler) -> + ReplyTo ! {result, Fun()}. + +big_literals(doc) -> + "Tests that big-number literals work correctly."; +big_literals(Config) when is_list(Config) -> + %% Note: The literal test cannot be compiler on a pre-R4 Beam emulator, + %% so we compile it now. + ?line DataDir = ?config(data_dir, Config), + ?line Test = filename:join(DataDir, "literal_test"), + ?line {ok, Mod, Bin} = compile:file(Test, [binary]), + ?line {module, Mod} = code:load_binary(Mod, Mod, Bin), + ?line ok = Mod:t(), + ok. + +big_float(doc) -> + ["Test cases for mixing bignums and floats"]; +big_float(suite) -> + [big_float_1, big_float_2]. + +big_float_1(doc) -> + ["OTP-2436, part 1"]; +big_float_1(Config) when is_list(Config) -> + %% F is a number very close to a maximum float. + ?line F = id(1.7e308), + ?line I = trunc(F), + ?line true = (I == F), + ?line false = (I /= F), + ?line true = (I > F/2), + ?line false = (I =< F/2), + ?line true = (I*2 >= F), + ?line false = (I*2 < F), + ?line true = (I*I > F), + ?line false = (I*I =< F), + + ?line true = (F == I), + ?line false = (F /= I), + ?line false = (F/2 > I), + ?line true = (F/2 =< I), + ?line false = (F >= I*2), + ?line true = (F < I*2), + ?line false = (F > I*I), + ?line true = (F =< I*I), + ok. + +big_float_2(doc) -> + ["OTP-2436, part 2"]; +big_float_2(Config) when is_list(Config) -> + ?line F = id(1.7e308), + ?line I = trunc(F), + ?line {'EXIT', _} = (catch 1/(2*I)), + ?line _Ignore = 2/I, + ?line {'EXIT', _} = (catch 4/(2*I)), + ok. + +shift_limit_1(doc) -> + ["OTP-3256"]; +shift_limit_1(Config) when is_list(Config) -> + ?line case catch (id(1) bsl 100000000) of + {'EXIT', {system_limit, _}} -> + ok + end, + ok. + +powmod(Config) when is_list(Config) -> + A = 1696192905348584855517250509684275447603964214606878827319923580493120589769459602596313014087329389174229999430092223701630077631205171572331191216670754029016160388576759960413039261647653627052707047, + B = 43581177444506616087519351724629421082877485633442736512567383077022781906420535744195118099822189576169114064491200598595995538299156626345938812352676950427869649947439032133573270227067833308153431095, + C = 52751775381034251994634567029696659541685100826881826508158083211003576763074162948462801435204697796532659535818017760528684167216110865807581759669824808936751316879636014972704885388116861127856231, + 42092892863788727404752752803608028634538446791189806757622214958680350350975318060071308251566643822307995215323107194784213893808887471095918905937046217646432382915847269148913963434734284563536888 = powmod(A, B, C), + ok. + +powmod(A, 1, C) -> + A rem C; +powmod(A, 2, C) -> + A*A rem C; +powmod(A, B, C) -> + B1 = B div 2, + B2 = B - B1, + P = powmod(A, B1, C), + case B2 of + B1 -> + (P*P) rem C; + _ -> + (P*P*A) rem C + end. + +system_limit(Config) when is_list(Config) -> + ?line Maxbig = maxbig(), + ?line {'EXIT',{system_limit,_}} = (catch Maxbig+1), + ?line {'EXIT',{system_limit,_}} = (catch -Maxbig-1), + ?line {'EXIT',{system_limit,_}} = (catch 2*Maxbig), + ?line {'EXIT',{system_limit,_}} = (catch bnot Maxbig), + ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])), + ?line {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2), + ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])), + ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)), + ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)), + ok. + +maxbig() -> + %% We assume that the maximum arity is (1 bsl 19) - 1. + Ws = erlang:system_info(wordsize), + (((1 bsl ((16777184 * (Ws div 4))-1)) - 1) bsl 1) + 1. + +id(I) -> I. + +otp_6692(suite) -> + []; +otp_6692(doc) -> + ["Tests for DIV/REM bug reported in OTP-6692"]; +otp_6692(Config) when is_list(Config)-> + ?line loop1(1,1000). + +fact(N) -> + fact(N,1). + +fact(0,P) -> P; +fact(N,P) -> fact(N-1,P*N). + +raised(X,1) -> + X; +raised(X,N) -> + X*raised(X,N-1). + +loop1(M,M) -> + ok; +loop1(N,M) -> + loop2(fact(N),raised(7,7),1,8), + loop1(N+1,M). + +loop2(_,_,M,M) -> + ok; +loop2(X,Y,N,M) -> + Z = raised(Y,N), + case X rem Z of + Z -> + exit({failed,X,'REM',Z,'=',Z}); + 0 -> + case (X div Z) * Z of + X -> + ok; + Wrong -> + exit({failed,X,'DIV',Z,'*',Z,'=',Wrong}) + end; + _ -> + ok + end, + loop2(X,Y,N+1,M). + diff --git a/erts/emulator/test/big_SUITE_data/borders.dat b/erts/emulator/test/big_SUITE_data/borders.dat new file mode 100644 index 0000000000..52e4f35861 --- /dev/null +++ b/erts/emulator/test/big_SUITE_data/borders.dat @@ -0,0 +1,1116 @@ +33554427 = 33554429 + (-2). +-33554433 = -33554435 - (-2). +33554428 = 33554429 + (-1). +-33554434 = -33554435 - (-1). +33554429 = 33554429 + 0. +-33554435 = -33554435 - 0. +33554430 = 33554429 + 1. +-33554436 = -33554435 - 1. +33554431 = 33554429 + 2. +-33554437 = -33554435 - 2. +33554432 = 33554429 + 3. +-33554438 = -33554435 - 3. +33554433 = 33554429 + 4. +-33554439 = -33554435 - 4. +33554434 = 33554429 + 5. +-33554440 = -33554435 - 5. +33554435 = 33554429 + 6. +-33554441 = -33554435 - 6. +33554428 = 33554430 + (-2). +-33554432 = -33554434 - (-2). +33554429 = 33554430 + (-1). +-33554433 = -33554434 - (-1). +33554430 = 33554430 + 0. +-33554434 = -33554434 - 0. +33554431 = 33554430 + 1. +-33554435 = -33554434 - 1. +33554432 = 33554430 + 2. +-33554436 = -33554434 - 2. +33554433 = 33554430 + 3. +-33554437 = -33554434 - 3. +33554434 = 33554430 + 4. +-33554438 = -33554434 - 4. +33554435 = 33554430 + 5. +-33554439 = -33554434 - 5. +33554436 = 33554430 + 6. +-33554440 = -33554434 - 6. +33554429 = 33554431 + (-2). +-33554431 = -33554433 - (-2). +33554430 = 33554431 + (-1). +-33554432 = -33554433 - (-1). +33554431 = 33554431 + 0. +-33554433 = -33554433 - 0. +33554432 = 33554431 + 1. +-33554434 = -33554433 - 1. +33554433 = 33554431 + 2. +-33554435 = -33554433 - 2. +33554434 = 33554431 + 3. +-33554436 = -33554433 - 3. +33554435 = 33554431 + 4. +-33554437 = -33554433 - 4. +33554436 = 33554431 + 5. +-33554438 = -33554433 - 5. +33554437 = 33554431 + 6. +-33554439 = -33554433 - 6. +33554430 = 33554432 + (-2). +-33554430 = -33554432 - (-2). +33554431 = 33554432 + (-1). +-33554431 = -33554432 - (-1). +33554432 = 33554432 + 0. +-33554432 = -33554432 - 0. +33554433 = 33554432 + 1. +-33554433 = -33554432 - 1. +33554434 = 33554432 + 2. +-33554434 = -33554432 - 2. +33554435 = 33554432 + 3. +-33554435 = -33554432 - 3. +33554436 = 33554432 + 4. +-33554436 = -33554432 - 4. +33554437 = 33554432 + 5. +-33554437 = -33554432 - 5. +33554438 = 33554432 + 6. +-33554438 = -33554432 - 6. +33554431 = 33554433 + (-2). +-33554429 = -33554431 - (-2). +33554432 = 33554433 + (-1). +-33554430 = -33554431 - (-1). +33554433 = 33554433 + 0. +-33554431 = -33554431 - 0. +33554434 = 33554433 + 1. +-33554432 = -33554431 - 1. +33554435 = 33554433 + 2. +-33554433 = -33554431 - 2. +33554436 = 33554433 + 3. +-33554434 = -33554431 - 3. +33554437 = 33554433 + 4. +-33554435 = -33554431 - 4. +33554438 = 33554433 + 5. +-33554436 = -33554431 - 5. +33554439 = 33554433 + 6. +-33554437 = -33554431 - 6. +33554432 = 33554434 + (-2). +-33554428 = -33554430 - (-2). +33554433 = 33554434 + (-1). +-33554429 = -33554430 - (-1). +33554434 = 33554434 + 0. +-33554430 = -33554430 - 0. +33554435 = 33554434 + 1. +-33554431 = -33554430 - 1. +33554436 = 33554434 + 2. +-33554432 = -33554430 - 2. +33554437 = 33554434 + 3. +-33554433 = -33554430 - 3. +33554438 = 33554434 + 4. +-33554434 = -33554430 - 4. +33554439 = 33554434 + 5. +-33554435 = -33554430 - 5. +33554440 = 33554434 + 6. +-33554436 = -33554430 - 6. +33554432 = 33554430 - (-2). +-33554432 = -33554430 + (-2). +33554431 = 33554430 - (-1). +-33554431 = -33554430 + (-1). +33554430 = 33554430 - 0. +-33554430 = -33554430 + 0. +33554429 = 33554430 - 1. +-33554429 = -33554430 + 1. +33554428 = 33554430 - 2. +-33554428 = -33554430 + 2. +33554427 = 33554430 - 3. +-33554427 = -33554430 + 3. +33554426 = 33554430 - 4. +-33554426 = -33554430 + 4. +33554425 = 33554430 - 5. +-33554425 = -33554430 + 5. +33554424 = 33554430 - 6. +-33554424 = -33554430 + 6. +33554433 = 33554431 - (-2). +-33554433 = -33554431 + (-2). +33554432 = 33554431 - (-1). +-33554432 = -33554431 + (-1). +33554431 = 33554431 - 0. +-33554431 = -33554431 + 0. +33554430 = 33554431 - 1. +-33554430 = -33554431 + 1. +33554429 = 33554431 - 2. +-33554429 = -33554431 + 2. +33554428 = 33554431 - 3. +-33554428 = -33554431 + 3. +33554427 = 33554431 - 4. +-33554427 = -33554431 + 4. +33554426 = 33554431 - 5. +-33554426 = -33554431 + 5. +33554425 = 33554431 - 6. +-33554425 = -33554431 + 6. +33554434 = 33554432 - (-2). +-33554434 = -33554432 + (-2). +33554433 = 33554432 - (-1). +-33554433 = -33554432 + (-1). +33554432 = 33554432 - 0. +-33554432 = -33554432 + 0. +33554431 = 33554432 - 1. +-33554431 = -33554432 + 1. +33554430 = 33554432 - 2. +-33554430 = -33554432 + 2. +33554429 = 33554432 - 3. +-33554429 = -33554432 + 3. +33554428 = 33554432 - 4. +-33554428 = -33554432 + 4. +33554427 = 33554432 - 5. +-33554427 = -33554432 + 5. +33554426 = 33554432 - 6. +-33554426 = -33554432 + 6. +33554435 = 33554433 - (-2). +-33554435 = -33554433 + (-2). +33554434 = 33554433 - (-1). +-33554434 = -33554433 + (-1). +33554433 = 33554433 - 0. +-33554433 = -33554433 + 0. +33554432 = 33554433 - 1. +-33554432 = -33554433 + 1. +33554431 = 33554433 - 2. +-33554431 = -33554433 + 2. +33554430 = 33554433 - 3. +-33554430 = -33554433 + 3. +33554429 = 33554433 - 4. +-33554429 = -33554433 + 4. +33554428 = 33554433 - 5. +-33554428 = -33554433 + 5. +33554427 = 33554433 - 6. +-33554427 = -33554433 + 6. +33554436 = 33554434 - (-2). +-33554436 = -33554434 + (-2). +33554435 = 33554434 - (-1). +-33554435 = -33554434 + (-1). +33554434 = 33554434 - 0. +-33554434 = -33554434 + 0. +33554433 = 33554434 - 1. +-33554433 = -33554434 + 1. +33554432 = 33554434 - 2. +-33554432 = -33554434 + 2. +33554431 = 33554434 - 3. +-33554431 = -33554434 + 3. +33554430 = 33554434 - 4. +-33554430 = -33554434 + 4. +33554429 = 33554434 - 5. +-33554429 = -33554434 + 5. +33554428 = 33554434 - 6. +-33554428 = -33554434 + 6. +33554437 = 33554435 - (-2). +-33554437 = -33554435 + (-2). +33554436 = 33554435 - (-1). +-33554436 = -33554435 + (-1). +33554435 = 33554435 - 0. +-33554435 = -33554435 + 0. +33554434 = 33554435 - 1. +-33554434 = -33554435 + 1. +33554433 = 33554435 - 2. +-33554433 = -33554435 + 2. +33554432 = 33554435 - 3. +-33554432 = -33554435 + 3. +33554431 = 33554435 - 4. +-33554431 = -33554435 + 4. +33554430 = 33554435 - 5. +-33554430 = -33554435 + 5. +33554429 = 33554435 - 6. +-33554429 = -33554435 + 6. +67108859 = 67108861 + (-2). +-67108865 = -67108867 - (-2). +67108860 = 67108861 + (-1). +-67108866 = -67108867 - (-1). +67108861 = 67108861 + 0. +-67108867 = -67108867 - 0. +67108862 = 67108861 + 1. +-67108868 = -67108867 - 1. +67108863 = 67108861 + 2. +-67108869 = -67108867 - 2. +67108864 = 67108861 + 3. +-67108870 = -67108867 - 3. +67108865 = 67108861 + 4. +-67108871 = -67108867 - 4. +67108866 = 67108861 + 5. +-67108872 = -67108867 - 5. +67108867 = 67108861 + 6. +-67108873 = -67108867 - 6. +67108860 = 67108862 + (-2). +-67108864 = -67108866 - (-2). +67108861 = 67108862 + (-1). +-67108865 = -67108866 - (-1). +67108862 = 67108862 + 0. +-67108866 = -67108866 - 0. +67108863 = 67108862 + 1. +-67108867 = -67108866 - 1. +67108864 = 67108862 + 2. +-67108868 = -67108866 - 2. +67108865 = 67108862 + 3. +-67108869 = -67108866 - 3. +67108866 = 67108862 + 4. +-67108870 = -67108866 - 4. +67108867 = 67108862 + 5. +-67108871 = -67108866 - 5. +67108868 = 67108862 + 6. +-67108872 = -67108866 - 6. +67108861 = 67108863 + (-2). +-67108863 = -67108865 - (-2). +67108862 = 67108863 + (-1). +-67108864 = -67108865 - (-1). +67108863 = 67108863 + 0. +-67108865 = -67108865 - 0. +67108864 = 67108863 + 1. +-67108866 = -67108865 - 1. +67108865 = 67108863 + 2. +-67108867 = -67108865 - 2. +67108866 = 67108863 + 3. +-67108868 = -67108865 - 3. +67108867 = 67108863 + 4. +-67108869 = -67108865 - 4. +67108868 = 67108863 + 5. +-67108870 = -67108865 - 5. +67108869 = 67108863 + 6. +-67108871 = -67108865 - 6. +67108862 = 67108864 + (-2). +-67108862 = -67108864 - (-2). +67108863 = 67108864 + (-1). +-67108863 = -67108864 - (-1). +67108864 = 67108864 + 0. +-67108864 = -67108864 - 0. +67108865 = 67108864 + 1. +-67108865 = -67108864 - 1. +67108866 = 67108864 + 2. +-67108866 = -67108864 - 2. +67108867 = 67108864 + 3. +-67108867 = -67108864 - 3. +67108868 = 67108864 + 4. +-67108868 = -67108864 - 4. +67108869 = 67108864 + 5. +-67108869 = -67108864 - 5. +67108870 = 67108864 + 6. +-67108870 = -67108864 - 6. +67108863 = 67108865 + (-2). +-67108861 = -67108863 - (-2). +67108864 = 67108865 + (-1). +-67108862 = -67108863 - (-1). +67108865 = 67108865 + 0. +-67108863 = -67108863 - 0. +67108866 = 67108865 + 1. +-67108864 = -67108863 - 1. +67108867 = 67108865 + 2. +-67108865 = -67108863 - 2. +67108868 = 67108865 + 3. +-67108866 = -67108863 - 3. +67108869 = 67108865 + 4. +-67108867 = -67108863 - 4. +67108870 = 67108865 + 5. +-67108868 = -67108863 - 5. +67108871 = 67108865 + 6. +-67108869 = -67108863 - 6. +67108864 = 67108866 + (-2). +-67108860 = -67108862 - (-2). +67108865 = 67108866 + (-1). +-67108861 = -67108862 - (-1). +67108866 = 67108866 + 0. +-67108862 = -67108862 - 0. +67108867 = 67108866 + 1. +-67108863 = -67108862 - 1. +67108868 = 67108866 + 2. +-67108864 = -67108862 - 2. +67108869 = 67108866 + 3. +-67108865 = -67108862 - 3. +67108870 = 67108866 + 4. +-67108866 = -67108862 - 4. +67108871 = 67108866 + 5. +-67108867 = -67108862 - 5. +67108872 = 67108866 + 6. +-67108868 = -67108862 - 6. +67108864 = 67108862 - (-2). +-67108864 = -67108862 + (-2). +67108863 = 67108862 - (-1). +-67108863 = -67108862 + (-1). +67108862 = 67108862 - 0. +-67108862 = -67108862 + 0. +67108861 = 67108862 - 1. +-67108861 = -67108862 + 1. +67108860 = 67108862 - 2. +-67108860 = -67108862 + 2. +67108859 = 67108862 - 3. +-67108859 = -67108862 + 3. +67108858 = 67108862 - 4. +-67108858 = -67108862 + 4. +67108857 = 67108862 - 5. +-67108857 = -67108862 + 5. +67108856 = 67108862 - 6. +-67108856 = -67108862 + 6. +67108865 = 67108863 - (-2). +-67108865 = -67108863 + (-2). +67108864 = 67108863 - (-1). +-67108864 = -67108863 + (-1). +67108863 = 67108863 - 0. +-67108863 = -67108863 + 0. +67108862 = 67108863 - 1. +-67108862 = -67108863 + 1. +67108861 = 67108863 - 2. +-67108861 = -67108863 + 2. +67108860 = 67108863 - 3. +-67108860 = -67108863 + 3. +67108859 = 67108863 - 4. +-67108859 = -67108863 + 4. +67108858 = 67108863 - 5. +-67108858 = -67108863 + 5. +67108857 = 67108863 - 6. +-67108857 = -67108863 + 6. +67108866 = 67108864 - (-2). +-67108866 = -67108864 + (-2). +67108865 = 67108864 - (-1). +-67108865 = -67108864 + (-1). +67108864 = 67108864 - 0. +-67108864 = -67108864 + 0. +67108863 = 67108864 - 1. +-67108863 = -67108864 + 1. +67108862 = 67108864 - 2. +-67108862 = -67108864 + 2. +67108861 = 67108864 - 3. +-67108861 = -67108864 + 3. +67108860 = 67108864 - 4. +-67108860 = -67108864 + 4. +67108859 = 67108864 - 5. +-67108859 = -67108864 + 5. +67108858 = 67108864 - 6. +-67108858 = -67108864 + 6. +67108867 = 67108865 - (-2). +-67108867 = -67108865 + (-2). +67108866 = 67108865 - (-1). +-67108866 = -67108865 + (-1). +67108865 = 67108865 - 0. +-67108865 = -67108865 + 0. +67108864 = 67108865 - 1. +-67108864 = -67108865 + 1. +67108863 = 67108865 - 2. +-67108863 = -67108865 + 2. +67108862 = 67108865 - 3. +-67108862 = -67108865 + 3. +67108861 = 67108865 - 4. +-67108861 = -67108865 + 4. +67108860 = 67108865 - 5. +-67108860 = -67108865 + 5. +67108859 = 67108865 - 6. +-67108859 = -67108865 + 6. +67108868 = 67108866 - (-2). +-67108868 = -67108866 + (-2). +67108867 = 67108866 - (-1). +-67108867 = -67108866 + (-1). +67108866 = 67108866 - 0. +-67108866 = -67108866 + 0. +67108865 = 67108866 - 1. +-67108865 = -67108866 + 1. +67108864 = 67108866 - 2. +-67108864 = -67108866 + 2. +67108863 = 67108866 - 3. +-67108863 = -67108866 + 3. +67108862 = 67108866 - 4. +-67108862 = -67108866 + 4. +67108861 = 67108866 - 5. +-67108861 = -67108866 + 5. +67108860 = 67108866 - 6. +-67108860 = -67108866 + 6. +67108869 = 67108867 - (-2). +-67108869 = -67108867 + (-2). +67108868 = 67108867 - (-1). +-67108868 = -67108867 + (-1). +67108867 = 67108867 - 0. +-67108867 = -67108867 + 0. +67108866 = 67108867 - 1. +-67108866 = -67108867 + 1. +67108865 = 67108867 - 2. +-67108865 = -67108867 + 2. +67108864 = 67108867 - 3. +-67108864 = -67108867 + 3. +67108863 = 67108867 - 4. +-67108863 = -67108867 + 4. +67108862 = 67108867 - 5. +-67108862 = -67108867 + 5. +67108861 = 67108867 - 6. +-67108861 = -67108867 + 6. +134217723 = 134217725 + (-2). +-134217729 = -134217731 - (-2). +134217724 = 134217725 + (-1). +-134217730 = -134217731 - (-1). +134217725 = 134217725 + 0. +-134217731 = -134217731 - 0. +134217726 = 134217725 + 1. +-134217732 = -134217731 - 1. +134217727 = 134217725 + 2. +-134217733 = -134217731 - 2. +134217728 = 134217725 + 3. +-134217734 = -134217731 - 3. +134217729 = 134217725 + 4. +-134217735 = -134217731 - 4. +134217730 = 134217725 + 5. +-134217736 = -134217731 - 5. +134217731 = 134217725 + 6. +-134217737 = -134217731 - 6. +134217724 = 134217726 + (-2). +-134217728 = -134217730 - (-2). +134217725 = 134217726 + (-1). +-134217729 = -134217730 - (-1). +134217726 = 134217726 + 0. +-134217730 = -134217730 - 0. +134217727 = 134217726 + 1. +-134217731 = -134217730 - 1. +134217728 = 134217726 + 2. +-134217732 = -134217730 - 2. +134217729 = 134217726 + 3. +-134217733 = -134217730 - 3. +134217730 = 134217726 + 4. +-134217734 = -134217730 - 4. +134217731 = 134217726 + 5. +-134217735 = -134217730 - 5. +134217732 = 134217726 + 6. +-134217736 = -134217730 - 6. +134217725 = 134217727 + (-2). +-134217727 = -134217729 - (-2). +134217726 = 134217727 + (-1). +-134217728 = -134217729 - (-1). +134217727 = 134217727 + 0. +-134217729 = -134217729 - 0. +134217728 = 134217727 + 1. +-134217730 = -134217729 - 1. +134217729 = 134217727 + 2. +-134217731 = -134217729 - 2. +134217730 = 134217727 + 3. +-134217732 = -134217729 - 3. +134217731 = 134217727 + 4. +-134217733 = -134217729 - 4. +134217732 = 134217727 + 5. +-134217734 = -134217729 - 5. +134217733 = 134217727 + 6. +-134217735 = -134217729 - 6. +134217726 = 134217728 + (-2). +-134217726 = -134217728 - (-2). +134217727 = 134217728 + (-1). +-134217727 = -134217728 - (-1). +134217728 = 134217728 + 0. +-134217728 = -134217728 - 0. +134217729 = 134217728 + 1. +-134217729 = -134217728 - 1. +134217730 = 134217728 + 2. +-134217730 = -134217728 - 2. +134217731 = 134217728 + 3. +-134217731 = -134217728 - 3. +134217732 = 134217728 + 4. +-134217732 = -134217728 - 4. +134217733 = 134217728 + 5. +-134217733 = -134217728 - 5. +134217734 = 134217728 + 6. +-134217734 = -134217728 - 6. +134217727 = 134217729 + (-2). +-134217725 = -134217727 - (-2). +134217728 = 134217729 + (-1). +-134217726 = -134217727 - (-1). +134217729 = 134217729 + 0. +-134217727 = -134217727 - 0. +134217730 = 134217729 + 1. +-134217728 = -134217727 - 1. +134217731 = 134217729 + 2. +-134217729 = -134217727 - 2. +134217732 = 134217729 + 3. +-134217730 = -134217727 - 3. +134217733 = 134217729 + 4. +-134217731 = -134217727 - 4. +134217734 = 134217729 + 5. +-134217732 = -134217727 - 5. +134217735 = 134217729 + 6. +-134217733 = -134217727 - 6. +134217728 = 134217730 + (-2). +-134217724 = -134217726 - (-2). +134217729 = 134217730 + (-1). +-134217725 = -134217726 - (-1). +134217730 = 134217730 + 0. +-134217726 = -134217726 - 0. +134217731 = 134217730 + 1. +-134217727 = -134217726 - 1. +134217732 = 134217730 + 2. +-134217728 = -134217726 - 2. +134217733 = 134217730 + 3. +-134217729 = -134217726 - 3. +134217734 = 134217730 + 4. +-134217730 = -134217726 - 4. +134217735 = 134217730 + 5. +-134217731 = -134217726 - 5. +134217736 = 134217730 + 6. +-134217732 = -134217726 - 6. +134217728 = 134217726 - (-2). +-134217728 = -134217726 + (-2). +134217727 = 134217726 - (-1). +-134217727 = -134217726 + (-1). +134217726 = 134217726 - 0. +-134217726 = -134217726 + 0. +134217725 = 134217726 - 1. +-134217725 = -134217726 + 1. +134217724 = 134217726 - 2. +-134217724 = -134217726 + 2. +134217723 = 134217726 - 3. +-134217723 = -134217726 + 3. +134217722 = 134217726 - 4. +-134217722 = -134217726 + 4. +134217721 = 134217726 - 5. +-134217721 = -134217726 + 5. +134217720 = 134217726 - 6. +-134217720 = -134217726 + 6. +134217729 = 134217727 - (-2). +-134217729 = -134217727 + (-2). +134217728 = 134217727 - (-1). +-134217728 = -134217727 + (-1). +134217727 = 134217727 - 0. +-134217727 = -134217727 + 0. +134217726 = 134217727 - 1. +-134217726 = -134217727 + 1. +134217725 = 134217727 - 2. +-134217725 = -134217727 + 2. +134217724 = 134217727 - 3. +-134217724 = -134217727 + 3. +134217723 = 134217727 - 4. +-134217723 = -134217727 + 4. +134217722 = 134217727 - 5. +-134217722 = -134217727 + 5. +134217721 = 134217727 - 6. +-134217721 = -134217727 + 6. +134217730 = 134217728 - (-2). +-134217730 = -134217728 + (-2). +134217729 = 134217728 - (-1). +-134217729 = -134217728 + (-1). +134217728 = 134217728 - 0. +-134217728 = -134217728 + 0. +134217727 = 134217728 - 1. +-134217727 = -134217728 + 1. +134217726 = 134217728 - 2. +-134217726 = -134217728 + 2. +134217725 = 134217728 - 3. +-134217725 = -134217728 + 3. +134217724 = 134217728 - 4. +-134217724 = -134217728 + 4. +134217723 = 134217728 - 5. +-134217723 = -134217728 + 5. +134217722 = 134217728 - 6. +-134217722 = -134217728 + 6. +134217731 = 134217729 - (-2). +-134217731 = -134217729 + (-2). +134217730 = 134217729 - (-1). +-134217730 = -134217729 + (-1). +134217729 = 134217729 - 0. +-134217729 = -134217729 + 0. +134217728 = 134217729 - 1. +-134217728 = -134217729 + 1. +134217727 = 134217729 - 2. +-134217727 = -134217729 + 2. +134217726 = 134217729 - 3. +-134217726 = -134217729 + 3. +134217725 = 134217729 - 4. +-134217725 = -134217729 + 4. +134217724 = 134217729 - 5. +-134217724 = -134217729 + 5. +134217723 = 134217729 - 6. +-134217723 = -134217729 + 6. +134217732 = 134217730 - (-2). +-134217732 = -134217730 + (-2). +134217731 = 134217730 - (-1). +-134217731 = -134217730 + (-1). +134217730 = 134217730 - 0. +-134217730 = -134217730 + 0. +134217729 = 134217730 - 1. +-134217729 = -134217730 + 1. +134217728 = 134217730 - 2. +-134217728 = -134217730 + 2. +134217727 = 134217730 - 3. +-134217727 = -134217730 + 3. +134217726 = 134217730 - 4. +-134217726 = -134217730 + 4. +134217725 = 134217730 - 5. +-134217725 = -134217730 + 5. +134217724 = 134217730 - 6. +-134217724 = -134217730 + 6. +134217733 = 134217731 - (-2). +-134217733 = -134217731 + (-2). +134217732 = 134217731 - (-1). +-134217732 = -134217731 + (-1). +134217731 = 134217731 - 0. +-134217731 = -134217731 + 0. +134217730 = 134217731 - 1. +-134217730 = -134217731 + 1. +134217729 = 134217731 - 2. +-134217729 = -134217731 + 2. +134217728 = 134217731 - 3. +-134217728 = -134217731 + 3. +134217727 = 134217731 - 4. +-134217727 = -134217731 + 4. +134217726 = 134217731 - 5. +-134217726 = -134217731 + 5. +134217725 = 134217731 - 6. +-134217725 = -134217731 + 6. +268435451 = 268435453 + (-2). +-268435457 = -268435459 - (-2). +268435452 = 268435453 + (-1). +-268435458 = -268435459 - (-1). +268435453 = 268435453 + 0. +-268435459 = -268435459 - 0. +268435454 = 268435453 + 1. +-268435460 = -268435459 - 1. +268435455 = 268435453 + 2. +-268435461 = -268435459 - 2. +268435456 = 268435453 + 3. +-268435462 = -268435459 - 3. +268435457 = 268435453 + 4. +-268435463 = -268435459 - 4. +268435458 = 268435453 + 5. +-268435464 = -268435459 - 5. +268435459 = 268435453 + 6. +-268435465 = -268435459 - 6. +268435452 = 268435454 + (-2). +-268435456 = -268435458 - (-2). +268435453 = 268435454 + (-1). +-268435457 = -268435458 - (-1). +268435454 = 268435454 + 0. +-268435458 = -268435458 - 0. +268435455 = 268435454 + 1. +-268435459 = -268435458 - 1. +268435456 = 268435454 + 2. +-268435460 = -268435458 - 2. +268435457 = 268435454 + 3. +-268435461 = -268435458 - 3. +268435458 = 268435454 + 4. +-268435462 = -268435458 - 4. +268435459 = 268435454 + 5. +-268435463 = -268435458 - 5. +268435460 = 268435454 + 6. +-268435464 = -268435458 - 6. +268435453 = 268435455 + (-2). +-268435455 = -268435457 - (-2). +268435454 = 268435455 + (-1). +-268435456 = -268435457 - (-1). +268435455 = 268435455 + 0. +-268435457 = -268435457 - 0. +268435456 = 268435455 + 1. +-268435458 = -268435457 - 1. +268435457 = 268435455 + 2. +-268435459 = -268435457 - 2. +268435458 = 268435455 + 3. +-268435460 = -268435457 - 3. +268435459 = 268435455 + 4. +-268435461 = -268435457 - 4. +268435460 = 268435455 + 5. +-268435462 = -268435457 - 5. +268435461 = 268435455 + 6. +-268435463 = -268435457 - 6. +268435454 = 268435456 + (-2). +-268435454 = -268435456 - (-2). +268435455 = 268435456 + (-1). +-268435455 = -268435456 - (-1). +268435456 = 268435456 + 0. +-268435456 = -268435456 - 0. +268435457 = 268435456 + 1. +-268435457 = -268435456 - 1. +268435458 = 268435456 + 2. +-268435458 = -268435456 - 2. +268435459 = 268435456 + 3. +-268435459 = -268435456 - 3. +268435460 = 268435456 + 4. +-268435460 = -268435456 - 4. +268435461 = 268435456 + 5. +-268435461 = -268435456 - 5. +268435462 = 268435456 + 6. +-268435462 = -268435456 - 6. +268435455 = 268435457 + (-2). +-268435453 = -268435455 - (-2). +268435456 = 268435457 + (-1). +-268435454 = -268435455 - (-1). +268435457 = 268435457 + 0. +-268435455 = -268435455 - 0. +268435458 = 268435457 + 1. +-268435456 = -268435455 - 1. +268435459 = 268435457 + 2. +-268435457 = -268435455 - 2. +268435460 = 268435457 + 3. +-268435458 = -268435455 - 3. +268435461 = 268435457 + 4. +-268435459 = -268435455 - 4. +268435462 = 268435457 + 5. +-268435460 = -268435455 - 5. +268435463 = 268435457 + 6. +-268435461 = -268435455 - 6. +268435456 = 268435458 + (-2). +-268435452 = -268435454 - (-2). +268435457 = 268435458 + (-1). +-268435453 = -268435454 - (-1). +268435458 = 268435458 + 0. +-268435454 = -268435454 - 0. +268435459 = 268435458 + 1. +-268435455 = -268435454 - 1. +268435460 = 268435458 + 2. +-268435456 = -268435454 - 2. +268435461 = 268435458 + 3. +-268435457 = -268435454 - 3. +268435462 = 268435458 + 4. +-268435458 = -268435454 - 4. +268435463 = 268435458 + 5. +-268435459 = -268435454 - 5. +268435464 = 268435458 + 6. +-268435460 = -268435454 - 6. +268435456 = 268435454 - (-2). +-268435456 = -268435454 + (-2). +268435455 = 268435454 - (-1). +-268435455 = -268435454 + (-1). +268435454 = 268435454 - 0. +-268435454 = -268435454 + 0. +268435453 = 268435454 - 1. +-268435453 = -268435454 + 1. +268435452 = 268435454 - 2. +-268435452 = -268435454 + 2. +268435451 = 268435454 - 3. +-268435451 = -268435454 + 3. +268435450 = 268435454 - 4. +-268435450 = -268435454 + 4. +268435449 = 268435454 - 5. +-268435449 = -268435454 + 5. +268435448 = 268435454 - 6. +-268435448 = -268435454 + 6. +268435457 = 268435455 - (-2). +-268435457 = -268435455 + (-2). +268435456 = 268435455 - (-1). +-268435456 = -268435455 + (-1). +268435455 = 268435455 - 0. +-268435455 = -268435455 + 0. +268435454 = 268435455 - 1. +-268435454 = -268435455 + 1. +268435453 = 268435455 - 2. +-268435453 = -268435455 + 2. +268435452 = 268435455 - 3. +-268435452 = -268435455 + 3. +268435451 = 268435455 - 4. +-268435451 = -268435455 + 4. +268435450 = 268435455 - 5. +-268435450 = -268435455 + 5. +268435449 = 268435455 - 6. +-268435449 = -268435455 + 6. +268435458 = 268435456 - (-2). +-268435458 = -268435456 + (-2). +268435457 = 268435456 - (-1). +-268435457 = -268435456 + (-1). +268435456 = 268435456 - 0. +-268435456 = -268435456 + 0. +268435455 = 268435456 - 1. +-268435455 = -268435456 + 1. +268435454 = 268435456 - 2. +-268435454 = -268435456 + 2. +268435453 = 268435456 - 3. +-268435453 = -268435456 + 3. +268435452 = 268435456 - 4. +-268435452 = -268435456 + 4. +268435451 = 268435456 - 5. +-268435451 = -268435456 + 5. +268435450 = 268435456 - 6. +-268435450 = -268435456 + 6. +268435459 = 268435457 - (-2). +-268435459 = -268435457 + (-2). +268435458 = 268435457 - (-1). +-268435458 = -268435457 + (-1). +268435457 = 268435457 - 0. +-268435457 = -268435457 + 0. +268435456 = 268435457 - 1. +-268435456 = -268435457 + 1. +268435455 = 268435457 - 2. +-268435455 = -268435457 + 2. +268435454 = 268435457 - 3. +-268435454 = -268435457 + 3. +268435453 = 268435457 - 4. +-268435453 = -268435457 + 4. +268435452 = 268435457 - 5. +-268435452 = -268435457 + 5. +268435451 = 268435457 - 6. +-268435451 = -268435457 + 6. +268435460 = 268435458 - (-2). +-268435460 = -268435458 + (-2). +268435459 = 268435458 - (-1). +-268435459 = -268435458 + (-1). +268435458 = 268435458 - 0. +-268435458 = -268435458 + 0. +268435457 = 268435458 - 1. +-268435457 = -268435458 + 1. +268435456 = 268435458 - 2. +-268435456 = -268435458 + 2. +268435455 = 268435458 - 3. +-268435455 = -268435458 + 3. +268435454 = 268435458 - 4. +-268435454 = -268435458 + 4. +268435453 = 268435458 - 5. +-268435453 = -268435458 + 5. +268435452 = 268435458 - 6. +-268435452 = -268435458 + 6. +268435461 = 268435459 - (-2). +-268435461 = -268435459 + (-2). +268435460 = 268435459 - (-1). +-268435460 = -268435459 + (-1). +268435459 = 268435459 - 0. +-268435459 = -268435459 + 0. +268435458 = 268435459 - 1. +-268435458 = -268435459 + 1. +268435457 = 268435459 - 2. +-268435457 = -268435459 + 2. +268435456 = 268435459 - 3. +-268435456 = -268435459 + 3. +268435455 = 268435459 - 4. +-268435455 = -268435459 + 4. +268435454 = 268435459 - 5. +-268435454 = -268435459 + 5. +268435453 = 268435459 - 6. +-268435453 = -268435459 + 6. +536870907 = 536870909 + (-2). +-536870913 = -536870915 - (-2). +536870908 = 536870909 + (-1). +-536870914 = -536870915 - (-1). +536870909 = 536870909 + 0. +-536870915 = -536870915 - 0. +536870910 = 536870909 + 1. +-536870916 = -536870915 - 1. +536870911 = 536870909 + 2. +-536870917 = -536870915 - 2. +536870912 = 536870909 + 3. +-536870918 = -536870915 - 3. +536870913 = 536870909 + 4. +-536870919 = -536870915 - 4. +536870914 = 536870909 + 5. +-536870920 = -536870915 - 5. +536870915 = 536870909 + 6. +-536870921 = -536870915 - 6. +536870908 = 536870910 + (-2). +-536870912 = -536870914 - (-2). +536870909 = 536870910 + (-1). +-536870913 = -536870914 - (-1). +536870910 = 536870910 + 0. +-536870914 = -536870914 - 0. +536870911 = 536870910 + 1. +-536870915 = -536870914 - 1. +536870912 = 536870910 + 2. +-536870916 = -536870914 - 2. +536870913 = 536870910 + 3. +-536870917 = -536870914 - 3. +536870914 = 536870910 + 4. +-536870918 = -536870914 - 4. +536870915 = 536870910 + 5. +-536870919 = -536870914 - 5. +536870916 = 536870910 + 6. +-536870920 = -536870914 - 6. +536870909 = 536870911 + (-2). +-536870911 = -536870913 - (-2). +536870910 = 536870911 + (-1). +-536870912 = -536870913 - (-1). +536870911 = 536870911 + 0. +-536870913 = -536870913 - 0. +536870912 = 536870911 + 1. +-536870914 = -536870913 - 1. +536870913 = 536870911 + 2. +-536870915 = -536870913 - 2. +536870914 = 536870911 + 3. +-536870916 = -536870913 - 3. +536870915 = 536870911 + 4. +-536870917 = -536870913 - 4. +536870916 = 536870911 + 5. +-536870918 = -536870913 - 5. +536870917 = 536870911 + 6. +-536870919 = -536870913 - 6. +536870910 = 536870912 + (-2). +-536870910 = -536870912 - (-2). +536870911 = 536870912 + (-1). +-536870911 = -536870912 - (-1). +536870912 = 536870912 + 0. +-536870912 = -536870912 - 0. +536870913 = 536870912 + 1. +-536870913 = -536870912 - 1. +536870914 = 536870912 + 2. +-536870914 = -536870912 - 2. +536870915 = 536870912 + 3. +-536870915 = -536870912 - 3. +536870916 = 536870912 + 4. +-536870916 = -536870912 - 4. +536870917 = 536870912 + 5. +-536870917 = -536870912 - 5. +536870918 = 536870912 + 6. +-536870918 = -536870912 - 6. +536870911 = 536870913 + (-2). +-536870909 = -536870911 - (-2). +536870912 = 536870913 + (-1). +-536870910 = -536870911 - (-1). +536870913 = 536870913 + 0. +-536870911 = -536870911 - 0. +536870914 = 536870913 + 1. +-536870912 = -536870911 - 1. +536870915 = 536870913 + 2. +-536870913 = -536870911 - 2. +536870916 = 536870913 + 3. +-536870914 = -536870911 - 3. +536870917 = 536870913 + 4. +-536870915 = -536870911 - 4. +536870918 = 536870913 + 5. +-536870916 = -536870911 - 5. +536870919 = 536870913 + 6. +-536870917 = -536870911 - 6. +536870912 = 536870914 + (-2). +-536870908 = -536870910 - (-2). +536870913 = 536870914 + (-1). +-536870909 = -536870910 - (-1). +536870914 = 536870914 + 0. +-536870910 = -536870910 - 0. +536870915 = 536870914 + 1. +-536870911 = -536870910 - 1. +536870916 = 536870914 + 2. +-536870912 = -536870910 - 2. +536870917 = 536870914 + 3. +-536870913 = -536870910 - 3. +536870918 = 536870914 + 4. +-536870914 = -536870910 - 4. +536870919 = 536870914 + 5. +-536870915 = -536870910 - 5. +536870920 = 536870914 + 6. +-536870916 = -536870910 - 6. +536870912 = 536870910 - (-2). +-536870912 = -536870910 + (-2). +536870911 = 536870910 - (-1). +-536870911 = -536870910 + (-1). +536870910 = 536870910 - 0. +-536870910 = -536870910 + 0. +536870909 = 536870910 - 1. +-536870909 = -536870910 + 1. +536870908 = 536870910 - 2. +-536870908 = -536870910 + 2. +536870907 = 536870910 - 3. +-536870907 = -536870910 + 3. +536870906 = 536870910 - 4. +-536870906 = -536870910 + 4. +536870905 = 536870910 - 5. +-536870905 = -536870910 + 5. +536870904 = 536870910 - 6. +-536870904 = -536870910 + 6. +536870913 = 536870911 - (-2). +-536870913 = -536870911 + (-2). +536870912 = 536870911 - (-1). +-536870912 = -536870911 + (-1). +536870911 = 536870911 - 0. +-536870911 = -536870911 + 0. +536870910 = 536870911 - 1. +-536870910 = -536870911 + 1. +536870909 = 536870911 - 2. +-536870909 = -536870911 + 2. +536870908 = 536870911 - 3. +-536870908 = -536870911 + 3. +536870907 = 536870911 - 4. +-536870907 = -536870911 + 4. +536870906 = 536870911 - 5. +-536870906 = -536870911 + 5. +536870905 = 536870911 - 6. +-536870905 = -536870911 + 6. +536870914 = 536870912 - (-2). +-536870914 = -536870912 + (-2). +536870913 = 536870912 - (-1). +-536870913 = -536870912 + (-1). +536870912 = 536870912 - 0. +-536870912 = -536870912 + 0. +536870911 = 536870912 - 1. +-536870911 = -536870912 + 1. +536870910 = 536870912 - 2. +-536870910 = -536870912 + 2. +536870909 = 536870912 - 3. +-536870909 = -536870912 + 3. +536870908 = 536870912 - 4. +-536870908 = -536870912 + 4. +536870907 = 536870912 - 5. +-536870907 = -536870912 + 5. +536870906 = 536870912 - 6. +-536870906 = -536870912 + 6. +536870915 = 536870913 - (-2). +-536870915 = -536870913 + (-2). +536870914 = 536870913 - (-1). +-536870914 = -536870913 + (-1). +536870913 = 536870913 - 0. +-536870913 = -536870913 + 0. +536870912 = 536870913 - 1. +-536870912 = -536870913 + 1. +536870911 = 536870913 - 2. +-536870911 = -536870913 + 2. +536870910 = 536870913 - 3. +-536870910 = -536870913 + 3. +536870909 = 536870913 - 4. +-536870909 = -536870913 + 4. +536870908 = 536870913 - 5. +-536870908 = -536870913 + 5. +536870907 = 536870913 - 6. +-536870907 = -536870913 + 6. +536870916 = 536870914 - (-2). +-536870916 = -536870914 + (-2). +536870915 = 536870914 - (-1). +-536870915 = -536870914 + (-1). +536870914 = 536870914 - 0. +-536870914 = -536870914 + 0. +536870913 = 536870914 - 1. +-536870913 = -536870914 + 1. +536870912 = 536870914 - 2. +-536870912 = -536870914 + 2. +536870911 = 536870914 - 3. +-536870911 = -536870914 + 3. +536870910 = 536870914 - 4. +-536870910 = -536870914 + 4. +536870909 = 536870914 - 5. +-536870909 = -536870914 + 5. +536870908 = 536870914 - 6. +-536870908 = -536870914 + 6. +536870917 = 536870915 - (-2). +-536870917 = -536870915 + (-2). +536870916 = 536870915 - (-1). +-536870916 = -536870915 + (-1). +536870915 = 536870915 - 0. +-536870915 = -536870915 + 0. +536870914 = 536870915 - 1. +-536870914 = -536870915 + 1. +536870913 = 536870915 - 2. +-536870913 = -536870915 + 2. +536870912 = 536870915 - 3. +-536870912 = -536870915 + 3. +536870911 = 536870915 - 4. +-536870911 = -536870915 + 4. +536870910 = 536870915 - 5. +-536870910 = -536870915 + 5. +536870909 = 536870915 - 6. +-536870909 = -536870915 + 6. + +%% Thanks to Mikael Pettersson. Most negative fixnum (for 32/64 bits architecture). +16#8000000 = -16#8000000 div (-1). +16#8000000 = -16#8000000 * (-1). +16#8000000 = 0 - (-16#8000000). +16#800000000000000 = -16#800000000000000 div (-1). +16#800000000000000 = -16#800000000000000 * (-1). +16#800000000000000 = 0 - (-16#800000000000000). + +%% The absolute valute of the most negative fixnum used in all combinations. +1 = -16#8000000 div (-16#8000000). +1 = 16#8000000 div 16#8000000. +-1 = -16#8000000 div 16#8000000. +-1 = 16#8000000 div (-16#8000000). +1 = -16#800000000000000 div (-16#800000000000000). +1 = 16#800000000000000 div 16#800000000000000. +-1 = -16#800000000000000 div 16#800000000000000. +-1 = 16#800000000000000 div (-16#800000000000000). +0 = -16#8000000 rem (-16#8000000). +0 = 16#8000000 rem 16#8000000. +0 = -16#8000000 rem 16#8000000. +0 = 16#8000000 rem (-16#8000000). +0 = -16#800000000000000 rem (-16#800000000000000). +0 = 16#800000000000000 rem 16#800000000000000. +0 = -16#800000000000000 rem 16#800000000000000. +0 = 16#800000000000000 rem (-16#800000000000000). + +%% More border values regarding rem... +-16#8000000 = -16#8000000 rem (-16#8000001). +-16#8000000 = -16#8000000 rem 16#8000001. +1 = 16#8000001 rem (-16#8000000). +-16#800000000000000 = -16#800000000000000 rem (-16#800000000000001). +-16#800000000000000 = -16#800000000000000 rem 16#800000000000001. +1 = 16#800000000000001 rem (-16#800000000000000). +0 = 16#FFFFFFFFFFFFFFF800000000 rem 16#FFFFFFFFFFFFFFF80. + diff --git a/erts/emulator/test/big_SUITE_data/eq_28.dat b/erts/emulator/test/big_SUITE_data/eq_28.dat new file mode 100644 index 0000000000..7464632e01 --- /dev/null +++ b/erts/emulator/test/big_SUITE_data/eq_28.dat @@ -0,0 +1,3000 @@ +2639222 = -30710410 band 11032439. +-22317193 = -30710410 bor 11032439. +-24956415 = -30710410 bxor 11032439. +72453188 = -10637340 band 80972877. +-2117651 = -10637340 bor 80972877. +-74570839 = -10637340 bxor 80972877. +54550530 = 56648450 band 62977043. +65074963 = 56648450 bor 62977043. +10524433 = 56648450 bxor 62977043. +-133062592 = -46668208 band -86400951. +-6567 = -46668208 bor -86400951. +133056025 = -46668208 bxor -86400951. +11840590 = -17453746 band 29146735. +-147601 = -17453746 bor 29146735. +-11988191 = -17453746 bxor 29146735. +1052676 = -130214020 band 85129221. +-46137475 = -130214020 bor 85129221. +-47190151 = -130214020 bxor 85129221. +-117420022 = -108834726 band -16723317. +-8138021 = -108834726 bor -16723317. +109282001 = -108834726 bxor -16723317. +33558272 = 100806504 band -70250623. +-3002391 = 100806504 bor -70250623. +-36560663 = 100806504 bxor -70250623. +50333734 = -82438106 band 120065127. +-12706713 = -82438106 bor 120065127. +-63040447 = -82438106 bxor 120065127. +7078420 = -25241068 band 32318141. +-1347 = -25241068 bor 32318141. +-7079767 = -25241068 bxor 32318141. +-124059646 = -38039374 band -90241021. +-4220749 = -38039374 bor -90241021. +119838897 = -38039374 bxor -90241021. +21496192 = -8813696 band 30289337. +-20551 = -8813696 bor 30289337. +-21516743 = -8813696 bxor 30289337. +-134217378 = -53606914 band -100654753. +-20044289 = -53606914 bor -100654753. +114173089 = -53606914 bxor -100654753. +-99466204 = -88909908 band -31789963. +-21233667 = -88909908 bor -31789963. +78232537 = -88909908 bxor -31789963. +-117439478 = -50297846 band -80776069. +-13634437 = -50297846 bor -80776069. +103805041 = -50297846 bxor -80776069. +34620048 = -86752616 band 37411569. +-83961095 = -86752616 bor 37411569. +-118581143 = -86752616 bxor 37411569. +2282582 = -114633002 band 70704471. +-46211113 = -114633002 bor 70704471. +-48493695 = -114633002 bxor 70704471. +-99602428 = -82382780 band -24038099. +-6818451 = -82382780 bor -24038099. +92783977 = -82382780 bxor -24038099. +130122338 = -2782622 band 132249587. +-655373 = -2782622 bor 132249587. +-130777711 = -2782622 bxor 132249587. +-63912928 = -38482768 band -59181271. +-33751111 = -38482768 bor -59181271. +30161817 = -38482768 bxor -59181271. +8206 = -41555282 band 1712207. +-39851281 = -41555282 bor 1712207. +-39859487 = -41555282 bxor 1712207. +67109060 = -49151012 band 100719845. +-15540227 = -49151012 bor 100719845. +-82649287 = -49151012 bxor 100719845. +33686058 = -3537990 band 33714795. +-3509253 = -3537990 bor 33714795. +-37195311 = -3537990 bxor 33714795. +18939968 = 61440456 band -43556255. +-1055767 = 61440456 bor -43556255. +-19995735 = 61440456 bxor -43556255. +83918854 = -50028154 band 131320391. +-2626617 = -50028154 bor 131320391. +-86545471 = -50028154 bxor 131320391. +1098260 = 112783988 band 5686173. +117371901 = 112783988 bor 5686173. +116273641 = 112783988 bxor 5686173. +-59228158 = -50769902 band -59194397. +-50736141 = -50769902 bor -59194397. +8492017 = -50769902 bxor -59194397. +44089472 = -5455392 band 48299161. +-1245703 = -5455392 bor 48299161. +-45335175 = -5455392 bxor 48299161. +67640094 = -31958178 band 82426687. +-17171585 = -31958178 bor 82426687. +-84811679 = -31958178 bxor 82426687. +526340 = 4987916 band -29636267. +-25174691 = 4987916 bor -29636267. +-25701031 = 4987916 bxor -29636267. +50908234 = 59428714 band 55102555. +63623035 = 59428714 bor 55102555. +12714801 = 59428714 bxor 55102555. +-47930160 = -39523080 band -12802607. +-4395527 = -39523080 bor -12802607. +43534633 = -39523080 bxor -12802607. +129781814 = 134117430 band -4336841. +-1225 = 134117430 bor -4336841. +-129783039 = 134117430 bxor -4336841. +9748484 = -38281052 band 9752077. +-38277459 = -38281052 bor 9752077. +-48025943 = -38281052 bxor 9752077. +17850818 = 20046274 band 51538899. +53734355 = 20046274 bor 51538899. +35883537 = 20046274 bxor 51538899. +12853760 = 65299216 band -53658103. +-1212647 = 65299216 bor -53658103. +-14066407 = 65299216 bxor -53658103. +20494 = 4216846 band -15863249. +-11666897 = 4216846 bor -15863249. +-11687391 = 4216846 bxor -15863249. +40964 = -132865988 band 67285445. +-65621507 = -132865988 bor 67285445. +-65662471 = -132865988 bxor 67285445. +8487434 = -89266406 band 9536075. +-88217765 = -89266406 bor 9536075. +-96705199 = -89266406 bxor 9536075. +2196480 = 78218280 band 23176513. +99198313 = 78218280 bor 23176513. +97001833 = 78218280 bxor 23176513. +3364902 = -130852122 band 125040679. +-9176345 = -130852122 bor 125040679. +-12541247 = -130852122 bxor 125040679. +69341268 = 119978708 band -60664707. +-10027267 = 119978708 bor -60664707. +-79368535 = 119978708 bxor -60664707. +536386 = 21643122 band 1961923. +23068659 = 21643122 bor 1961923. +22532273 = 21643122 bxor 1961923. +25473088 = -6377408 band 29670265. +-2180231 = -6377408 bor 29670265. +-27653319 = -6377408 bxor 29670265. +-94322658 = -92741442 band -85605089. +-84023873 = -92741442 bor -85605089. +10298785 = -92741442 bxor -85605089. +5017636 = -86077332 band 5019189. +-86075779 = -86077332 bor 5019189. +-91093415 = -86077332 bxor 5019189. +-133562358 = -128038198 band -47475653. +-41951493 = -128038198 bor -47475653. +91610865 = -128038198 bxor -47475653. +18366480 = 56248152 band 87908529. +125790201 = 56248152 bor 87908529. +107423721 = 56248152 bxor 87908529. +-130807530 = -125941354 band -130729705. +-125863529 = -125941354 bor -130729705. +4944001 = -125941354 bxor -130729705. +76546052 = 81297668 band 76961517. +81713133 = 81297668 bor 76961517. +5167081 = 81297668 bxor 76961517. +13125922 = -87201502 band 30035891. +-70291533 = -87201502 bor 30035891. +-83417455 = -87201502 bxor 30035891. +-133291936 = -18962064 band -116493079. +-2163207 = -18962064 bor -116493079. +131128729 = -18962064 bxor -116493079. +43004942 = 134018414 band -91212785. +-199313 = 134018414 bor -91212785. +-43204255 = 134018414 bxor -91212785. +30434436 = 31255708 band 131102373. +131923645 = 31255708 bor 131102373. +101489209 = 31255708 bxor 131102373. +393770 = 8845946 band -31063509. +-22611333 = 8845946 bor -31063509. +-23005103 = 8845946 bxor -31063509. +51515392 = 52049544 band 66508833. +67042985 = 52049544 bor 66508833. +15527593 = 52049544 bxor 66508833. +1030 = 8012870 band -117402105. +-109390265 = 8012870 bor -117402105. +-109391295 = 8012870 bxor -117402105. +20975892 = 56636212 band -37235363. +-1575043 = 56636212 bor -37235363. +-22550935 = 56636212 bxor -37235363. +395906 = 67526354 band 428963. +67559411 = 67526354 bor 428963. +67163505 = 67526354 bxor 428963. +2181632 = 73879200 band -105813415. +-34115847 = 73879200 bor -105813415. +-36297479 = 73879200 bxor -105813415. +12850718 = -121137634 band 99368703. +-34619649 = -121137634 bor 99368703. +-47470367 = -121137634 bxor 99368703. +-117436412 = -117263156 band -83537131. +-83363875 = -117263156 bor -83537131. +34072537 = -117263156 bxor -83537131. +37929994 = 131266090 band -95433701. +-2097605 = 131266090 bor -95433701. +-40027599 = 131266090 bxor -95433701. +-66846320 = -66301512 band -25883759. +-25338951 = -66301512 bor -25883759. +41507369 = -66301512 bxor -25883759. +75500278 = 75647734 band -23785737. +-23638281 = 75647734 bor -23785737. +-99138559 = 75647734 bxor -23785737. +49476 = -99561116 band 5099469. +-94511123 = -99561116 bor 5099469. +-94560599 = -99561116 bxor 5099469. +-67100542 = -67100542 band -58612845. +-58612845 = -67100542 bor -58612845. +8487697 = -67100542 bxor -58612845. +-131032128 = -105144368 band -93021239. +-67133479 = -105144368 bor -93021239. +63898649 = -105144368 bxor -93021239. +9486542 = 26460878 band -90642961. +-73668625 = 26460878 bor -90642961. +-83155167 = 26460878 bxor -90642961. +100804740 = -16586500 band 102902661. +-14488579 = -16586500 bor 102902661. +-115293319 = -16586500 bxor 102902661. +35991562 = 61685210 band -96996853. +-71303205 = 61685210 bor -96996853. +-107294767 = 61685210 bxor -96996853. +85104640 = 85170408 band -44107007. +-44041239 = 85170408 bor -44107007. +-129145879 = 85170408 bxor -44107007. +19988902 = 95509926 band -76438553. +-917529 = 95509926 bor -76438553. +-20906431 = 95509926 bxor -76438553. +-130203116 = -84059244 band -130070979. +-83927107 = -84059244 bor -130070979. +46276009 = -84059244 bxor -130070979. +41977346 = -91902414 band 44734339. +-89145421 = -91902414 bor 44734339. +-131122767 = -91902414 bxor 44734339. +18745600 = -14770944 band 31394105. +-2122439 = -14770944 bor 31394105. +-20868039 = -14770944 bxor 31394105. +-69982114 = -69436546 band -67819297. +-67273729 = -69436546 bor -67819297. +2708385 = -69436546 bxor -67819297. +17860900 = 89164076 band 18743285. +90046461 = 89164076 bor 18743285. +72185561 = 89164076 bxor 18743285. +-134196854 = -96415350 band -131238917. +-93457413 = -96415350 bor -131238917. +40739441 = -96415350 bxor -131238917. +18023440 = 64162840 band 18589297. +64728697 = 64162840 bor 18589297. +46705257 = 64162840 bxor 18589297. +29381718 = 31620182 band -2796329. +-557865 = 31620182 bor -2796329. +-29939583 = 31620182 bxor -2796329. +7344260 = 49861060 band 91437229. +133954029 = 49861060 bor 91437229. +126609769 = 49861060 bxor 91437229. +2099042 = 2230242 band 129001331. +129132531 = 2230242 bor 129001331. +127033489 = 2230242 bxor 129001331. +34800160 = -74234320 band 104313513. +-4720967 = -74234320 bor 104313513. +-39521127 = -74234320 bxor 104313513. +16777230 = 98353198 band 52430799. +134006767 = 98353198 bor 52430799. +117229537 = 98353198 bxor 52430799. +954436 = 2004316 band -5255067. +-4205187 = 2004316 bor -5255067. +-5159623 = 2004316 bxor -5255067. +3674410 = 41464122 band 4149739. +41939451 = 41464122 bor 4149739. +38265041 = 41464122 bxor 4149739. +8390976 = -55727288 band 30543329. +-33574935 = -55727288 bor 30543329. +-41965911 = -55727288 bxor 30543329. +28320006 = 61908742 band -104914489. +-71325753 = 61908742 bor -104914489. +-99645759 = 61908742 bxor -104914489. +-109042924 = -107596812 band -75454691. +-74008579 = -107596812 bor -75454691. +35034345 = -107596812 bxor -75454691. +33554690 = 102772114 band -92138653. +-22921229 = 102772114 bor -92138653. +-56475919 = 102772114 bxor -92138653. +-58419200 = -52651168 band -41576423. +-35808391 = -52651168 bor -41576423. +22610809 = -52651168 bxor -41576423. +42500254 = 42963166 band -17268033. +-16805121 = 42963166 bor -17268033. +-59305375 = 42963166 bxor -17268033. +4197508 = 106958220 band 21929173. +124689885 = 106958220 bor 21929173. +120492377 = 106958220 bxor 21929173. +3967178 = 67099882 band 3967963. +67100667 = 67099882 bor 3967963. +63133489 = 67099882 bxor 3967963. +37761104 = 46560888 band -9883311. +-1083527 = 46560888 bor -9883311. +-38844631 = 46560888 bxor -9883311. +6686902 = 41344438 band 82709175. +117366711 = 41344438 bor 82709175. +110679809 = 41344438 bxor 82709175. +19431428 = 19431972 band 29266317. +29266861 = 19431972 bor 29266317. +9835433 = 19431972 bxor 29266317. +42605378 = -24436926 band 63871827. +-3170477 = -24436926 bor 63871827. +-45775855 = -24436926 bxor 63871827. +84777088 = 125672592 band -40912503. +-16999 = 125672592 bor -40912503. +-84794087 = 125672592 bxor -40912503. +887182 = -105910898 band 69048751. +-37749329 = -105910898 bor 69048751. +-38636511 = -105910898 bxor 69048751. +16867588 = 29880764 band 20014405. +33027581 = 29880764 bor 20014405. +16159993 = 29880764 bxor 20014405. +117440650 = 121722010 band 129245643. +133527003 = 121722010 bor 129245643. +16086353 = 121722010 bxor 129245643. +128 = -134189656 band 25694401. +-108495383 = -134189656 bor 25694401. +-108495511 = -134189656 bxor 25694401. +37748774 = 38805606 band -85913689. +-84856857 = 38805606 bor -85913689. +-122605631 = 38805606 bxor -85913689. +37925972 = 113425492 band 54786045. +130285565 = 113425492 bor 54786045. +92359593 = 113425492 bxor 54786045. +67427394 = 70114546 band 100990787. +103677939 = 70114546 bor 100990787. +36250545 = 70114546 bxor 100990787. +43581632 = 112806336 band -69396743. +-172039 = 112806336 bor -69396743. +-43753671 = 112806336 bxor -69396743. +78136350 = 129553982 band -51491681. +-74049 = 129553982 bor -51491681. +-78210399 = 129553982 bxor -51491681. +105447844 = -20364820 band 105851317. +-19961347 = -20364820 bor 105851317. +-125409191 = -20364820 bxor 105851317. +90181642 = 90708042 band 133501883. +134028283 = 90708042 bor 133501883. +43846641 = 90708042 bxor 133501883. +76840976 = -50425640 band 127249457. +-17159 = -50425640 bor 127249457. +-76858135 = -50425640 bxor 127249457. +1515542 = 68644630 band 47657111. +114786199 = 68644630 bor 47657111. +113270657 = 68644630 bxor 47657111. +36160004 = 37216900 band -18359699. +-17302803 = 37216900 bor -18359699. +-53462807 = 37216900 bxor -18359699. +-133159390 = -91003230 band -44810445. +-2654285 = -91003230 bor -44810445. +130505105 = -91003230 bxor -44810445. +-57630624 = -57498896 band -38490007. +-38358279 = -57498896 bor -38490007. +19272345 = -57498896 bxor -38490007. +-108983666 = -35304722 band -108422257. +-34743313 = -35304722 bor -108422257. +74240353 = -35304722 bxor -108422257. +1501700 = -57213412 band 56551973. +-2163139 = -57213412 bor 56551973. +-3664839 = -57213412 bxor 56551973. +926122 = -127981574 band 68051371. +-60856325 = -127981574 bor 68051371. +-61782447 = -127981574 bxor 68051371. +2162688 = 19128328 band -122092639. +-105126999 = 19128328 bor -122092639. +-107289687 = 19128328 bxor -122092639. +21449094 = 90687942 band 30371207. +99610055 = 90687942 bor 30371207. +78160961 = 90687942 bxor 30371207. +100675732 = 102429876 band 121714909. +123469053 = 102429876 bor 121714909. +22793321 = 102429876 bxor 121714909. +-33417214 = -33113006 band -5547229. +-5243021 = -33113006 bor -5547229. +28174193 = -33113006 bxor -5547229. +819200 = 30189600 band -132282919. +-102912519 = 30189600 bor -132282919. +-103731719 = 30189600 bxor -132282919. +33554974 = 36719518 band -3242369. +-77825 = 36719518 bor -3242369. +-33632799 = 36719518 bxor -3242369. +67380740 = -47962548 band 114796181. +-547107 = -47962548 bor 114796181. +-67927847 = -47962548 bxor 114796181. +12649354 = -86932566 band 13568923. +-86012997 = -86932566 bor 13568923. +-98662351 = -86932566 bxor 13568923. +43062032 = 43211576 band 64558865. +64708409 = 43211576 bor 64558865. +21646377 = 43211576 bxor 64558865. +8913014 = 10236022 band -91699593. +-90376585 = 10236022 bor -91699593. +-99289599 = 10236022 bxor -91699593. +44438084 = -4263196 band 44503885. +-4197395 = -4263196 bor 44503885. +-48635479 = -4263196 bxor 44503885. +9458178 = 59956738 band -54963437. +-4464877 = 59956738 bor -54963437. +-13923055 = 59956738 bxor -54963437. +97128768 = 99244368 band -2189495. +-73895 = 99244368 bor -2189495. +-97202663 = 99244368 bxor -2189495. +-78378930 = -11216818 band -77853329. +-10691217 = -11216818 bor -77853329. +67687713 = -11216818 bxor -77853329. +2103812 = 86227580 band -84910331. +-786563 = 86227580 bor -84910331. +-2890375 = 86227580 bxor -84910331. +131338 = -131454118 band 80089483. +-51495973 = -131454118 bor 80089483. +-51627311 = -131454118 bxor 80089483. +-32505344 = -30408088 band -6494591. +-4397335 = -30408088 bor -6494591. +28108009 = -30408088 bxor -6494591. +-58580186 = -53501146 band -41796761. +-36717721 = -53501146 bor -41796761. +21862465 = -53501146 bxor -41796761. +53496084 = 121036052 band -80713283. +-13173315 = 121036052 bor -80713283. +-66669399 = 121036052 bxor -80713283. +-117439742 = -117257294 band -34789629. +-34607181 = -117257294 bor -34789629. +82832561 = -117257294 bxor -34789629. +-114383744 = -13715840 band -109124423. +-8456519 = -13715840 bor -109124423. +105927225 = -13715840 bxor -109124423. +75575390 = 80605438 band -40816545. +-35786497 = 80605438 bor -40816545. +-111361887 = 80605438 bxor -40816545. +67113508 = -66536788 band 94376821. +-39273475 = -66536788 bor 94376821. +-106386983 = -66536788 bxor 94376821. +-134212854 = -57401590 band -129862789. +-53051525 = -57401590 bor -129862789. +81161329 = -57401590 bxor -129862789. +-100118128 = -6498920 band -93621775. +-2567 = -6498920 bor -93621775. +100115561 = -6498920 bxor -93621775. +-120061866 = -35839530 band -117781417. +-33559081 = -35839530 bor -117781417. +86502785 = -35839530 bxor -117781417. +-32231420 = -11160764 band -21742547. +-671891 = -11160764 bor -21742547. +31559529 = -11160764 bxor -21742547. +73499746 = 81888610 band 108386035. +116774899 = 81888610 bor 108386035. +43275153 = 81888610 bxor 108386035. +-133943776 = -90390608 band -112890327. +-69337159 = -90390608 bor -112890327. +64606617 = -90390608 bxor -112890327. +75793678 = 114726318 band -41095345. +-2162705 = 114726318 bor -41095345. +-77956383 = 114726318 bxor -41095345. +-133954876 = -66705700 band -123878427. +-56629251 = -66705700 bor -123878427. +77325625 = -66705700 bxor -123878427. +72486954 = 83517114 band 89338219. +100368379 = 83517114 bor 89338219. +27881425 = 83517114 bxor 89338219. +2658368 = 20763848 band -93603487. +-75498007 = 20763848 bor -93603487. +-78156375 = 20763848 bxor -93603487. +5318662 = 73378950 band -118392505. +-50332217 = 73378950 bor -118392505. +-55650879 = 73378950 bxor -118392505. +76021780 = 95319412 band -20346211. +-1048579 = 95319412 bor -20346211. +-77070359 = 95319412 bxor -20346211. +37880322 = 108661522 band 54682339. +125463539 = 108661522 bor 54682339. +87583217 = 108661522 bxor 54682339. +53555328 = -67668768 band 54080409. +-67143687 = -67668768 bor 54080409. +-120699015 = -67668768 bxor 54080409. +-131579362 = -26622370 band -131184065. +-26227073 = -26622370 bor -131184065. +105352289 = -26622370 bxor -131184065. +28676 = 34537228 band 23097429. +57605981 = 34537228 bor 23097429. +57577305 = 34537228 bxor 23097429. +117918282 = -16258454 band 130501467. +-3675269 = -16258454 bor 130501467. +-121593551 = -16258454 bxor 130501467. +-67060528 = -63766536 band -41632559. +-38338567 = -63766536 bor -41632559. +28721961 = -63766536 bxor -41632559. +86000182 = -38649034 band 119882295. +-4766921 = -38649034 bor 119882295. +-90767103 = -38649034 bxor 119882295. +8651012 = 43262884 band 13063437. +47675309 = 43262884 bor 13063437. +39024297 = 43262884 bxor 13063437. +16861378 = 98000066 band -83768621. +-2629933 = 98000066 bor -83768621. +-19491311 = 98000066 bxor -83768621. +-117369856 = -37628400 band -81709815. +-1968359 = -37628400 bor -81709815. +115401497 = -37628400 bxor -81709815. +270 = -113081586 band 1327407. +-111754449 = -113081586 bor 1327407. +-111754719 = -113081586 bxor 1327407. +-115998716 = -36289732 band -115402555. +-35693571 = -36289732 bor -115402555. +80305145 = -36289732 bxor -115402555. +-114966518 = -114834918 band -47333045. +-47201445 = -114834918 bor -47333045. +67765073 = -114834918 bxor -47333045. +-130001920 = -127772888 band -111313855. +-109084823 = -127772888 bor -111313855. +20917097 = -127772888 bxor -111313855. +50668838 = 66053606 band -82499801. +-67115033 = 66053606 bor -82499801. +-117783871 = 66053606 bxor -82499801. +-117401260 = -115753516 band -37446787. +-35799043 = -115753516 bor -37446787. +81602217 = -115753516 bxor -37446787. +33557058 = 63208050 band -31256893. +-1605901 = 63208050 bor -31256893. +-35162959 = 63208050 bxor -31256893. +287296 = 20898624 band 75788921. +96400249 = 20898624 bor 75788921. +96112953 = 20898624 bxor 75788921. +-107364322 = -103035970 band -39988193. +-35659841 = -103035970 bor -39988193. +71704481 = -103035970 bxor -39988193. +12628260 = 30339948 band 80788789. +98500477 = 30339948 bor 80788789. +85872217 = 30339948 bxor 80788789. +8683786 = 42264010 band 81105723. +114685947 = 42264010 bor 81105723. +106002161 = 42264010 bxor 81105723. +-129183216 = -59909544 band -77793359. +-8519687 = -59909544 bor -77793359. +120663529 = -59909544 bxor -77793359. +-134217706 = -34368362 band -100653033. +-803689 = -34368362 bor -100653033. +133414017 = -34368362 bxor -100653033. +34620420 = 118637572 band 43539949. +127557101 = 118637572 bor 43539949. +92936681 = 118637572 bxor 43539949. +12854306 = -104045534 band 114634419. +-2265421 = -104045534 bor 114634419. +-15119727 = -104045534 bxor 114634419. +35752032 = -26108816 band 44690409. +-17170439 = -26108816 bor 44690409. +-52922471 = -26108816 bxor 44690409. +106954766 = 124821614 band -18218225. +-351377 = 124821614 bor -18218225. +-107306143 = 124821614 bxor -18218225. +19664260 = 53219228 band 86793637. +120348605 = 53219228 bor 86793637. +100684345 = 53219228 bxor 86793637. +-83345110 = -83208838 band -3292885. +-3156613 = -83208838 bor -3292885. +80188497 = -83208838 bxor -3292885. +-123205376 = -38237816 band -123064543. +-38096983 = -38237816 bor -123064543. +85108393 = -38237816 bxor -123064543. +104875270 = -10989754 band 115688711. +-176313 = -10989754 bor 115688711. +-105051583 = -10989754 bxor 115688711. +84972564 = 84981300 band -2515875. +-2507139 = 84981300 bor -2515875. +-87479703 = 84981300 bxor -2515875. +-134084478 = -96855598 band -116970845. +-79741965 = -96855598 bor -116970845. +54342513 = -96855598 bxor -116970845. +1573120 = 69009824 band -124214951. +-56778247 = 69009824 bor -124214951. +-58351367 = 69009824 bxor -124214951. +97779998 = -33816290 band 131583487. +-12801 = -33816290 bor 131583487. +-97792799 = -33816290 bxor 131583487. +10523140 = -102721588 band 111737365. +-1507363 = -102721588 bor 111737365. +-12030503 = -102721588 bxor 111737365. +6357258 = 56824106 band 15026971. +65493819 = 56824106 bor 15026971. +59136561 = 56824106 bxor 15026971. +2367632 = 6644920 band -30661999. +-26384711 = 6644920 bor -30661999. +-28752343 = 6644920 bxor -30661999. +71158 = -126282250 band 42171895. +-84181513 = -126282250 bor 42171895. +-84252671 = -126282250 bxor 42171895. +4723780 = 107484260 band -102803763. +-43283 = 107484260 bor -102803763. +-4767063 = 107484260 bxor -102803763. +524930 = 1612674 band 40370835. +41458579 = 1612674 bor 40370835. +40933649 = 1612674 bxor 40370835. +17044160 = 130290384 band -115895607. +-2649383 = 130290384 bor -115895607. +-19693543 = 130290384 bxor -115895607. +33563854 = -29823538 band 33961199. +-29426193 = -29823538 bor 33961199. +-62990047 = -29823538 bxor 33961199. +1933956 = 10456060 band 25006725. +33528829 = 10456060 bor 25006725. +31594873 = 10456060 bxor 25006725. +-55963638 = -50718502 band -55889653. +-50644517 = -50718502 bor -55889653. +5319121 = -50718502 bxor -55889653. +82432 = 123169768 band 9032193. +132119529 = 123169768 bor 9032193. +132037097 = 123169768 bxor 9032193. +38846630 = 108062886 band -77999385. +-8783129 = 108062886 bor -77999385. +-47629759 = 108062886 bxor -77999385. +-134214636 = -114598252 band -121598659. +-101982275 = -114598252 bor -121598659. +32232361 = -114598252 bxor -121598659. +-98394110 = -13440718 band -93931901. +-8978509 = -13440718 bor -93931901. +89415601 = -13440718 bxor -93931901. +78233600 = 95014912 band 112050233. +128831545 = 95014912 bor 112050233. +50597945 = 95014912 bxor 112050233. +-58710434 = -39688578 band -53200929. +-34179073 = -39688578 bor -53200929. +24531361 = -39688578 bxor -53200929. +8463396 = 81521708 band -106879243. +-33820931 = 81521708 bor -106879243. +-42284327 = 81521708 bxor -106879243. +-110468982 = -101028726 band -110202117. +-100761861 = -101028726 bor -110202117. +9707121 = -101028726 bxor -110202117. +69213456 = 70360856 band -64340623. +-63193223 = 70360856 bor -64340623. +-132406679 = 70360856 bxor -64340623. +16925526 = 52086614 band -39369769. +-4208681 = 52086614 bor -39369769. +-21134207 = 52086614 bxor -39369769. +267396 = 103650500 band -128696403. +-25313299 = 103650500 bor -128696403. +-25580695 = 103650500 bxor -128696403. +1049186 = 68420322 band 36849267. +104220403 = 68420322 bor 36849267. +103171217 = 68420322 bxor 36849267. +8399136 = 13711664 band 60959145. +66271673 = 13711664 bor 60959145. +57872537 = 13711664 bxor 60959145. +73417230 = 108227374 band -43985201. +-9175057 = 108227374 bor -43985201. +-82592287 = 108227374 bxor -43985201. +113815620 = 113817692 band -20269211. +-20267139 = 113817692 bor -20269211. +-134082759 = 113817692 bxor -20269211. +-49414102 = -45151174 band -12709653. +-8446725 = -45151174 bor -12709653. +40967377 = -45151174 bxor -12709653. +85222464 = 123141704 band 87319777. +125239017 = 123141704 bor 87319777. +40016553 = 123141704 bxor 87319777. +16814086 = 85045766 band 57331911. +125563591 = 85045766 bor 57331911. +108749505 = 85045766 bxor 57331911. +75284 = 16889588 band -130978275. +-114163971 = 16889588 bor -130978275. +-114239255 = 16889588 bxor -130978275. +67149826 = 67561618 band 79278691. +79690483 = 67561618 bor 79278691. +12540657 = 67561618 bxor 79278691. +16338432 = 50155104 band 33279769. +67096441 = 50155104 bor 33279769. +50758009 = 50155104 bxor 33279769. +109187486 = 128383966 band -24440385. +-5243905 = 128383966 bor -24440385. +-114431391 = 128383966 bxor -24440385. +-128958332 = -111611764 band -59685931. +-42339363 = -111611764 bor -59685931. +86618969 = -111611764 bxor -59685931. +44040906 = -89982998 band 132713179. +-1310725 = -89982998 bor 132713179. +-45351631 = -89982998 bxor 132713179. +126486608 = -1406600 band 126830673. +-1062535 = -1406600 bor 126830673. +-127549143 = -1406600 bxor 126830673. +69216438 = -5199690 band 73628087. +-788041 = -5199690 bor 73628087. +-70004479 = -5199690 bxor 73628087. +61472772 = 133874980 band -72410995. +-8787 = 133874980 bor -72410995. +-61481559 = 133874980 bxor -72410995. +67279426 = -48850366 band 111934035. +-4195757 = -48850366 bor 111934035. +-71475183 = -48850366 bxor 111934035. +8454272 = -55505008 band 58830985. +-5128295 = -55505008 bor 58830985. +-13582567 = -55505008 bxor 58830985. +15730830 = 83368078 band 15853743. +83490991 = 83368078 bor 15853743. +67760161 = 83368078 bxor 15853743. +754692 = 37721276 band -104084411. +-67117827 = 37721276 bor -104084411. +-67872519 = 37721276 bxor -104084411. +106963082 = 107032474 band -16883509. +-16814117 = 107032474 bor -16883509. +-123777199 = 107032474 bxor -16883509. +46219392 = -70303576 band 115468225. +-1054743 = -70303576 bor 115468225. +-47274135 = -70303576 bxor 115468225. +34613798 = 51555174 band 101727911. +118669287 = 51555174 bor 101727911. +84055489 = 51555174 bxor 101727911. +2113108 = 69975892 band -102482179. +-34619395 = 69975892 bor -102482179. +-36732503 = 69975892 bxor -102482179. +101193282 = 101586930 band 108535363. +108929011 = 101586930 bor 108535363. +7735729 = 101586930 bxor 108535363. +19549376 = 86998208 band -105198087. +-37749255 = 86998208 bor -105198087. +-57298631 = 86998208 bxor -105198087. +48251166 = 115458366 band -84649057. +-17441857 = 115458366 bor -84649057. +-65693023 = 115458366 bxor -84649057. +-104791900 = -101735188 band -103722827. +-100666115 = -101735188 bor -103722827. +4125785 = -101735188 bxor -103722827. +25432586 = 95728458 band 30216891. +100512763 = 95728458 bor 30216891. +75080177 = 95728458 bxor 30216891. +109052688 = 128459736 band -23903439. +-4496391 = 128459736 bor -23903439. +-113549079 = 128459736 bxor -23903439. +-133162474 = -65881578 band -72343657. +-5062761 = -65881578 bor -72343657. +128099713 = -65881578 bxor -72343657. +-114843388 = -110647932 band -39329427. +-35133971 = -110647932 bor -39329427. +79709417 = -110647932 bxor -39329427. +-62390238 = -25665118 band -62054861. +-25329741 = -25665118 bor -62054861. +37060497 = -25665118 bxor -62054861. +6948192 = -92563984 band 99493737. +-18439 = -92563984 bor 99493737. +-6966631 = -92563984 bxor 99493737. +-124755826 = -90245650 band -122590577. +-88080401 = -90245650 bor -122590577. +36675425 = -90245650 bxor -122590577. +-82312956 = -73653988 band -80162523. +-71503555 = -73653988 bor -80162523. +10809401 = -73653988 bxor -80162523. +-33554262 = -24608006 band -10215253. +-1268997 = -24608006 bor -10215253. +32285265 = -24608006 bxor -10215253. +13111808 = -19385592 band 30038689. +-2458711 = -19385592 bor 30038689. +-15570519 = -19385592 bxor 30038689. +71439494 = 72078534 band 104995975. +105635015 = 72078534 bor 104995975. +34195521 = 72078534 bxor 104995975. +67139476 = 104953780 band 93388765. +131203069 = 104953780 bor 93388765. +64063593 = 104953780 bxor 93388765. +-100634110 = -23038126 band -98960861. +-21364877 = -23038126 bor -98960861. +79269233 = -23038126 bxor -98960861. +16783360 = 22567712 band -115163943. +-109379591 = 22567712 bor -115163943. +-126162951 = 22567712 bxor -115163943. +529438 = 36353694 band -66579073. +-30754817 = 36353694 bor -66579073. +-31284255 = 36353694 bxor -66579073. +3672324 = 87558476 band -126268011. +-42381859 = 87558476 bor -126268011. +-46054183 = 87558476 bxor -126268011. +8555146 = 126328490 band -124613989. +-6840645 = 126328490 bor -124613989. +-15395791 = 126328490 bxor -124613989. +-83743216 = -75338184 band -76665327. +-68260295 = -75338184 bor -76665327. +15482921 = -75338184 bxor -76665327. +12662 = 35191670 band 75838839. +111017847 = 35191670 bor 75838839. +111005185 = 35191670 bxor 75838839. +266308 = 67909092 band 66493005. +134135789 = 67909092 bor 66493005. +133869481 = 67909092 bxor 66493005. +58789890 = 126966018 band -74599917. +-6423789 = 126966018 bor -74599917. +-65213679 = 126966018 bxor -74599917. +67669056 = 88656976 band 69176905. +90164825 = 88656976 bor 69176905. +22495769 = 88656976 bxor 69176905. +67108942 = 71304014 band -57189265. +-52994193 = 71304014 bor -57189265. +-120103135 = 71304014 bxor -57189265. +121652228 = 125197692 band 130663941. +134209405 = 125197692 bor 130663941. +12557177 = 125197692 bxor 130663941. +-133890038 = -132315558 band -1617781. +-43301 = -132315558 bor -1617781. +133846737 = -132315558 bxor -1617781. +100766976 = 109696360 band -31081087. +-22151703 = 109696360 bor -31081087. +-122918679 = 109696360 bxor -31081087. +9447974 = -124441050 band 49834599. +-84054425 = -124441050 bor 49834599. +-93502399 = -124441050 bxor 49834599. +113942548 = 115007508 band -17846083. +-16781123 = 115007508 bor -17846083. +-130723671 = 115007508 bxor -17846083. +34997762 = 51775154 band 102188547. +118965939 = 51775154 bor 102188547. +83968177 = 51775154 bxor 102188547. +756096 = -124786304 band 124492729. +-1049671 = -124786304 bor 124492729. +-1805767 = -124786304 bxor 124492729. +68688734 = -61219842 band 129908575. +-1 = -61219842 bor 129908575. +-68688735 = -61219842 bxor 129908575. +16783396 = 97131948 band -81708427. +-1359875 = 97131948 bor -81708427. +-18143271 = 97131948 bxor -81708427. +-130993654 = -126633462 band -105811333. +-101451141 = -126633462 bor -105811333. +29542513 = -126633462 bxor -105811333. +68159632 = 126970008 band 72878321. +131688697 = 126970008 bor 72878321. +63529065 = 126970008 bxor 72878321. +60434518 = 127626454 band -69551273. +-2359337 = 127626454 bor -69551273. +-62793855 = 127626454 bxor -69551273. +16900 = -41912764 band 5456685. +-36472979 = -41912764 bor 5456685. +-36489879 = -41912764 bxor 5456685. +10584162 = 62488674 band -119163405. +-67258893 = 62488674 bor -119163405. +-77843055 = 62488674 bxor -119163405. +40992 = 70300336 band 55436585. +125695929 = 70300336 bor 55436585. +125654937 = 70300336 bxor 55436585. +9633806 = -88915794 band 10206799. +-88342801 = -88915794 bor 10206799. +-97976607 = -88915794 bxor 10206799. +2492612 = 107366876 band 3582693. +108456957 = 107366876 bor 3582693. +105964345 = 107366876 bxor 3582693. +24555562 = 24558010 band -67112853. +-67110405 = 24558010 bor -67112853. +-91665967 = 24558010 bxor -67112853. +2883648 = 83634120 band 2887777. +83638249 = 83634120 bor 2887777. +80754601 = 83634120 bxor 2887777. +50470918 = -70862970 band 120268871. +-1065017 = -70862970 bor 120268871. +-51535935 = -70862970 bxor 120268871. +25710612 = 26212468 band 95965597. +96467453 = 26212468 bor 95965597. +70756841 = 26212468 bxor 95965597. +79691778 = 80135698 band -51904029. +-51460109 = 80135698 bor -51904029. +-131151887 = 80135698 bxor -51904029. +130818688 = 133048288 band 130902681. +133132281 = 133048288 bor 130902681. +2313593 = 133048288 bxor 130902681. +397598 = 71774558 band 973119. +72350079 = 71774558 bor 973119. +71952481 = 71774558 bxor 973119. +66052 = 37609996 band 8460117. +46004061 = 37609996 bor 8460117. +45938009 = 37609996 bxor 8460117. +-58654646 = -53410454 band -22951333. +-17707141 = -53410454 bor -22951333. +40947505 = -53410454 bxor -22951333. +59249360 = 65868536 band -74918959. +-68299783 = 65868536 bor -74918959. +-127549143 = 65868536 bxor -74918959. +-98566090 = -26079690 band -89607881. +-17121481 = -26079690 bor -89607881. +81444609 = -26079690 bxor -89607881. +5522436 = 123496100 band 7724045. +125697709 = 123496100 bor 7724045. +120175273 = 123496100 bxor 7724045. +4719042 = -95889470 band 80554451. +-20054061 = -95889470 bor 80554451. +-24773103 = -95889470 bxor 80554451. +67584 = -95729392 band 78720009. +-17076967 = -95729392 bor 78720009. +-17144551 = -95729392 bxor 78720009. +9469966 = 47230478 band 79073327. +116833839 = 47230478 bor 79073327. +107363873 = 47230478 bxor 79073327. +16999940 = 84141628 band 20414405. +87556093 = 84141628 bor 20414405. +70556153 = 84141628 bxor 20414405. +2359306 = 82681114 band -81395637. +-1073829 = 82681114 bor -81395637. +-3433135 = 82681114 bxor -81395637. +-133889536 = -129553880 band -132820159. +-128484503 = -129553880 bor -132820159. +5405033 = -129553880 bxor -132820159. +26234918 = 95973606 band -103655897. +-33917209 = 95973606 bor -103655897. +-60152127 = 95973606 bxor -103655897. +94421076 = -34029356 band 94560893. +-33889539 = -34029356 bor 94560893. +-128310615 = -34029356 bxor 94560893. +16786754 = 17479026 band -50057789. +-49365517 = 17479026 bor -50057789. +-66152271 = 17479026 bxor -50057789. +-125829056 = -125102528 band -109041287. +-108314759 = -125102528 bor -109041287. +17514297 = -125102528 bxor -109041287. +12624414 = 80393918 band 49406751. +117176255 = 80393918 bor 49406751. +104551841 = 80393918 bxor 49406751. +16794660 = -47491476 band 55632949. +-8653187 = -47491476 bor 55632949. +-25447847 = -47491476 bxor 55632949. +80969738 = 83329226 band -52719045. +-50359557 = 83329226 bor -52719045. +-131329295 = 83329226 bxor -52719045. +69733392 = 78474584 band -13070671. +-4329479 = 78474584 bor -13070671. +-74062871 = 78474584 bxor -13070671. +73668374 = 74768278 band 99030807. +100130711 = 74768278 bor 99030807. +26462337 = 74768278 bxor 99030807. +-32504828 = -13105404 band -32086803. +-12687379 = -13105404 bor -32086803. +19817449 = -13105404 bxor -32086803. +-90960606 = -23634142 band -71561805. +-4235341 = -23634142 bor -71561805. +86725265 = -23634142 bxor -71561805. +75498080 = 112234352 band 92365545. +129101817 = 112234352 bor 92365545. +53603737 = 112234352 bxor 92365545. +72368654 = -42972306 band 81777167. +-33563793 = -42972306 bor 81777167. +-105932447 = -42972306 bxor 81777167. +58982532 = -68734308 band 58999973. +-68716867 = -68734308 bor 58999973. +-127699399 = -68734308 bxor 58999973. +13729834 = -119951238 band 13729835. +-119951237 = -119951238 bor 13729835. +-133681071 = -119951238 bxor 13729835. +33588224 = -92087160 band 35227169. +-90448215 = -92087160 bor 35227169. +-124036439 = -92087160 bxor 35227169. +-130002938 = -96314810 band -35261433. +-1573305 = -96314810 bor -35261433. +128429633 = -96314810 bxor -35261433. +103096596 = -5424844 band 107438941. +-1082499 = -5424844 bor 107438941. +-104179095 = -5424844 bxor 107438941. +2211970 = 20567250 band 14928291. +33283571 = 20567250 bor 14928291. +31071601 = 20567250 bxor 14928291. +121278464 = -8473440 band 129751129. +-775 = -8473440 bor 129751129. +-121279239 = -8473440 bxor 129751129. +1854494 = 79457310 band -94413569. +-16810753 = 79457310 bor -94413569. +-18665247 = 79457310 bxor -94413569. +532484 = 86670028 band -95903467. +-9765923 = 86670028 bor -95903467. +-10298407 = 86670028 bxor -95903467. +85329930 = -46191574 band 97962523. +-33558981 = -46191574 bor 97962523. +-118888911 = -46191574 bxor 97962523. +-108383856 = -102074440 band -107005551. +-100696135 = -102074440 bor -107005551. +7687721 = -102074440 bxor -107005551. +34201846 = 58450166 band -24253193. +-4873 = 58450166 bor -24253193. +-34206719 = 58450166 bxor -24253193. +-22522556 = -22325404 band -18031155. +-17834003 = -22325404 bor -18031155. +4688553 = -22325404 bxor -18031155. +103284866 = -190846 band 103440787. +-34925 = -190846 bor 103440787. +-103319791 = -190846 bxor 103440787. +74482112 = 75007440 band -17397303. +-16871975 = 75007440 bor -17397303. +-91354087 = 75007440 bxor -17397303. +17432782 = 124393678 band -116423697. +-9462801 = 124393678 bor -116423697. +-26895583 = 124393678 bxor -116423697. +-75487100 = -5755140 band -69928571. +-196611 = -5755140 bor -69928571. +75290489 = -5755140 bxor -69928571. +-65900534 = -7146534 band -59084789. +-330789 = -7146534 bor -59084789. +65569745 = -7146534 bxor -59084789. +4204544 = 29834984 band 108046593. +133677033 = 29834984 bor 108046593. +129472489 = 29834984 bxor 108046593. +1835430 = -113478746 band 39715303. +-75598873 = -113478746 bor 39715303. +-77434303 = -113478746 bxor 39715303. +33898516 = 105210260 band -71445443. +-133699 = 105210260 bor -71445443. +-34032215 = 105210260 bxor -71445443. +-89390078 = -89381838 band -16853629. +-16845389 = -89381838 bor -16853629. +72544689 = -89381838 bxor -16853629. +-106953984 = -35585280 band -105351367. +-33982663 = -35585280 bor -105351367. +72971321 = -35585280 bxor -105351367. +71581790 = 116674942 band -61913377. +-16820225 = 116674942 bor -61913377. +-88402015 = 116674942 bxor -61913377. +19748 = 80957228 band -132100619. +-51163139 = 80957228 bor -132100619. +-51182887 = 80957228 bxor -132100619. +100663690 = -33552502 band 118190587. +-16025605 = -33552502 bor 118190587. +-116689295 = -33552502 bxor 118190587. +11800592 = -4443624 band 16045169. +-199047 = -4443624 bor 16045169. +-11999639 = -4443624 bxor 16045169. +18158166 = 23007830 band 26555095. +31404759 = 23007830 bor 26555095. +13246593 = 23007830 bxor 26555095. +18052 = -78751804 band 78726829. +-43027 = -78751804 bor 78726829. +-61079 = -78751804 bxor 78726829. +-124770974 = -103678494 band -124770957. +-103678477 = -103678494 bor -124770957. +21092497 = -103678494 bxor -124770957. +34086944 = -88396752 band 105423017. +-17060679 = -88396752 bor 105423017. +-51147623 = -88396752 bxor 105423017. +18088974 = -107604434 band 87926223. +-37767185 = -107604434 bor 87926223. +-55856159 = -107604434 bxor 87926223. +12622404 = 14605148 band -85877147. +-83894403 = 14605148 bor -85877147. +-96516807 = 14605148 bxor -85877147. +17844010 = 124872506 band -107425813. +-397317 = 124872506 bor -107425813. +-18241327 = 124872506 bxor -107425813. +4416 = 2904392 band -112018463. +-109118487 = 2904392 bor -112018463. +-109122903 = 2904392 bxor -112018463. +36846854 = -25248506 band 36863943. +-25231417 = -25248506 bor 36863943. +-62078271 = -25248506 bxor 36863943. +89665812 = -44484108 band 90060061. +-44089859 = -44484108 bor 90060061. +-133755671 = -44484108 bxor 90060061. +-125239038 = -21388398 band -103984797. +-134157 = -21388398 bor -103984797. +125104881 = -21388398 bxor -103984797. +9043968 = 13238624 band 44959257. +49153913 = 13238624 bor 44959257. +40109945 = 13238624 bxor 44959257. +-100130658 = -95787298 band -88497985. +-84154625 = -95787298 bor -88497985. +15976033 = -95787298 bxor -88497985. +42844804 = 45994892 band -74454315. +-71304227 = 45994892 bor -74454315. +-114149031 = 45994892 bxor -74454315. +-108003126 = -74312982 band -101611045. +-67920901 = -74312982 bor -101611045. +40082225 = -74312982 bxor -101611045. +103816272 = -29713288 band 124870481. +-8659079 = -29713288 bor 124870481. +-112475351 = -29713288 bxor 124870481. +133456054 = -625738 band 133490871. +-590921 = -625738 bor 133490871. +-134046975 = -625738 bxor 133490871. +68749316 = 112789540 band -48521331. +-4481107 = 112789540 bor -48521331. +-73230423 = 112789540 bxor -48521331. +56889666 = 57546050 band 56973651. +57630035 = 57546050 bor 56973651. +740369 = 57546050 bxor 56973651. +-58686848 = -57638256 band -55597175. +-54548583 = -57638256 bor -55597175. +4138265 = -57638256 bxor -55597175. +-130022514 = -120831090 band -111003729. +-101812305 = -120831090 bor -111003729. +28210209 = -120831090 bxor -111003729. +-64867580 = -64800836 band -43895995. +-43829251 = -64800836 bor -43895995. +21038329 = -64800836 bxor -43895995. +-92009846 = -87225702 band -5988405. +-1204261 = -87225702 bor -5988405. +90805585 = -87225702 bxor -5988405. +46273152 = 63574952 band -84427071. +-67125271 = 63574952 bor -84427071. +-113398423 = 63574952 bxor -84427071. +4269094 = 31536742 band 73100711. +100368359 = 31536742 bor 73100711. +96099265 = 31536742 bxor 73100711. +-67076012 = -58670508 band -16742915. +-8337411 = -58670508 bor -16742915. +58738601 = -58670508 bxor -16742915. +-92139454 = -88452366 band -3719869. +-32781 = -88452366 bor -3719869. +92106673 = -88452366 bxor -3719869. +22054080 = 22130624 band 30704889. +30781433 = 22130624 bor 30704889. +8727353 = 22130624 bxor 30704889. +26617886 = -107566018 band 60189343. +-73994561 = -107566018 bor 60189343. +-100612447 = -107566018 bxor 60189343. +16910244 = 25298924 band -11569227. +-3180547 = 25298924 bor -11569227. +-20090791 = 25298924 bxor -11569227. +67174410 = 105729610 band 67178939. +105734139 = 105729610 bor 67178939. +38559729 = 105729610 bxor 67178939. +-112422384 = -109201704 band -78849487. +-75628807 = -109201704 bor -78849487. +36793577 = -109201704 bxor -78849487. +67109910 = -48626410 band 111480471. +-4255849 = -48626410 bor 111480471. +-71365759 = -48626410 bxor 111480471. +8611844 = -24942460 band 31713389. +-1840915 = -24942460 bor 31713389. +-10452759 = -24942460 bxor 31713389. +2186274 = 2710690 band 52559155. +53083571 = 2710690 bor 52559155. +50897297 = 2710690 bxor 52559155. +-117405600 = -116356880 band -10248599. +-9199879 = -116356880 bor -10248599. +108205721 = -116356880 bxor -10248599. +23339150 = 98869486 band 24459663. +99989999 = 98869486 bor 24459663. +76650849 = 98869486 bxor 24459663. +-133431292 = -99793892 band -66144219. +-32506819 = -99793892 bor -66144219. +100924473 = -99793892 bxor -66144219. +34987434 = -139782 band 34987947. +-139269 = -139782 bor 34987947. +-35126703 = -139782 bxor 34987947. +110133248 = 112756232 band 127381921. +130004905 = 112756232 bor 127381921. +19871657 = 112756232 bxor 127381921. +51432326 = 121364422 band -70202489. +-270393 = 121364422 bor -70202489. +-51702719 = 121364422 bxor -70202489. +5292692 = 122944180 band 6080221. +123731709 = 122944180 bor 6080221. +118439017 = 122944180 bxor 6080221. +-133951486 = -133811630 band -77293277. +-77153421 = -133811630 bor -77293277. +56798065 = -133811630 bxor -77293277. +512 = 76549664 band 40104921. +116654073 = 76549664 bor 40104921. +116653561 = 76549664 bxor 40104921. +9510942 = -72277602 band 14525567. +-67262977 = -72277602 bor 14525567. +-76773919 = -72277602 bxor 14525567. +-99163132 = -4723636 band -99158891. +-4719395 = -4723636 bor -99158891. +94443737 = -4723636 bxor -99158891. +41945482 = -91637334 band 112331163. +-21251653 = -91637334 bor 112331163. +-63197135 = -91637334 bxor 112331163. +10289424 = 27099448 band 113198353. +130008377 = 27099448 bor 113198353. +119718953 = 27099448 bxor 113198353. +42042486 = 44156534 band -23223177. +-21109129 = 44156534 bor -23223177. +-63151615 = 44156534 bxor -23223177. +-130015164 = -62555932 band -121495219. +-54035987 = -62555932 bor -121495219. +75979177 = -62555932 bxor -121495219. +1708034 = -10759166 band 4067603. +-8399597 = -10759166 bor 4067603. +-10107631 = -10759166 bxor 4067603. +51381568 = -78430384 band 127698249. +-2113703 = -78430384 bor 127698249. +-53495271 = -78430384 bxor 127698249. +86387278 = -38326706 band 91138927. +-33575057 = -38326706 bor 91138927. +-119962335 = -38326706 bxor 91138927. +-82509820 = -13303684 band -73454331. +-4248195 = -13303684 bor -73454331. +78261625 = -13303684 bxor -73454331. +4227338 = -111419046 band 6590347. +-109056037 = -111419046 bor 6590347. +-113283375 = -111419046 bxor 6590347. +118128640 = -15751064 band 124425345. +-9454359 = -15751064 bor 124425345. +-127582999 = -15751064 bxor 124425345. +100833574 = -26822362 band 126523751. +-1132185 = -26822362 bor 126523751. +-101965759 = -26822362 bxor 126523751. +-47521004 = -43326700 band -47515715. +-43321411 = -43326700 bor -47515715. +4199593 = -43326700 bxor -47515715. +51724546 = -67812942 band 52258051. +-67279437 = -67812942 bor 52258051. +-119003983 = -67812942 bxor 52258051. +-74182528 = -73589632 band -74165575. +-73572679 = -73589632 bor -74165575. +609849 = -73589632 bxor -74165575. +83550 = 57788158 band -125350305. +-67645697 = 57788158 bor -125350305. +-67729247 = 57788158 bxor -125350305. +110493732 = 133660844 band -23174795. +-7683 = 133660844 bor -23174795. +-110501415 = 133660844 bxor -23174795. +1855754 = 10441994 band -8621701. +-35461 = 10441994 bor -8621701. +-1891215 = 10441994 bxor -8621701. +39824 = 45218712 band 40945. +45219833 = 45218712 bor 40945. +45180009 = 45218712 bxor 40945. +71606870 = 107329494 band -53040553. +-17317929 = 107329494 bor -53040553. +-88924799 = 107329494 bxor -53040553. +17172484 = 93796676 band 57559597. +134183789 = 93796676 bor 57559597. +117011305 = 93796676 bxor 57559597. +-65990558 = -60982430 band -13527821. +-8519693 = -60982430 bor -13527821. +57470865 = -60982430 bxor -13527821. +-99613664 = -93280848 band -91071447. +-84738631 = -93280848 bor -91071447. +14875033 = -93280848 bxor -91071447. +-117274354 = -115610706 band -112816817. +-111153169 = -115610706 bor -112816817. +6121185 = -115610706 bxor -112816817. +-66977596 = -63804196 band -53767707. +-50594307 = -63804196 bor -53767707. +16383289 = -63804196 bxor -53767707. +67634218 = 88020154 band 101232491. +121618427 = 88020154 bor 101232491. +53984209 = 88020154 bxor 101232491. +-23043520 = -18384184 band -22517919. +-17858583 = -18384184 bor -22517919. +5184937 = -18384184 bxor -22517919. +33604102 = 54116998 band 41998151. +62511047 = 54116998 bor 41998151. +28906945 = 54116998 bxor 41998151. +71700 = -94536844 band 86186141. +-8422403 = -94536844 bor 86186141. +-8494103 = -94536844 bxor 86186141. +21594114 = 132088082 band -110518045. +-24077 = 132088082 bor -110518045. +-21618191 = 132088082 bxor -110518045. +9470080 = 59824864 band 10330521. +60685305 = 59824864 bor 10330521. +51215225 = 59824864 bxor 10330521. +-58718178 = -5202850 band -57972673. +-4457345 = -5202850 bor -57972673. +54260833 = -5202850 bxor -57972673. +9995268 = 14206220 band -73548203. +-69337251 = 14206220 bor -73548203. +-79332519 = 14206220 bxor -73548203. +79691850 = -52027286 band 131615067. +-104069 = -52027286 bor 131615067. +-79795919 = -52027286 bxor 131615067. +4202704 = 80946680 band -112661807. +-35917831 = 80946680 bor -112661807. +-40120535 = 80946680 bxor -112661807. +-100138954 = -96609994 band -95936457. +-92407497 = -96609994 bor -95936457. +7731457 = -96609994 bxor -95936457. +-67100412 = -66016860 band -6266099. +-5182547 = -66016860 bor -6266099. +61917865 = -66016860 bxor -6266099. +262338 = -24751422 band 7637203. +-17376557 = -24751422 bor 7637203. +-17638895 = -24751422 bxor 7637203. +-117432320 = -109003760 band -109239543. +-100810983 = -109003760 bor -109239543. +16621337 = -109003760 bxor -109239543. +-52373234 = -51717874 band -51060945. +-50405585 = -51717874 bor -51060945. +1967649 = -51717874 bxor -51060945. +-66486268 = -40007364 band -62134587. +-35655683 = -40007364 bor -62134587. +30830585 = -40007364 bxor -62134587. +-126207990 = -33589222 band -92651701. +-32933 = -33589222 bor -92651701. +126175057 = -33589222 bxor -92651701. +67184640 = 72875304 band -41342399. +-35651735 = 72875304 bor -41342399. +-102836375 = 72875304 bxor -41342399. +25723174 = -41092122 band 61572391. +-5242905 = -41092122 bor 61572391. +-30966079 = -41092122 bxor 61572391. +29426004 = 96715732 band 66922877. +134212605 = 96715732 bor 66922877. +104786601 = 96715732 bxor 66922877. +-134201278 = -115543950 band -54440765. +-35783437 = -115543950 bor -54440765. +98417841 = -115543950 bxor -54440765. +8601664 = 92490048 band 12050553. +95938937 = 92490048 bor 12050553. +87337273 = 92490048 bxor 12050553. +-96362466 = -79322690 band -85855713. +-68815937 = -79322690 bor -85855713. +27546529 = -79322690 bxor -85855713. +-121566940 = -51136148 band -70448331. +-17539 = -51136148 bor -70448331. +121549401 = -51136148 bxor -70448331. +87298314 = -4842550 band 87920955. +-4219909 = -4842550 bor 87920955. +-91518223 = -4842550 bxor 87920955. +1048592 = -65470376 band 13641137. +-52877831 = -65470376 bor 13641137. +-53926423 = -65470376 bxor 13641137. +-134086122 = -66966890 band -68549097. +-1429865 = -66966890 bor -68549097. +132656257 = -66966890 bxor -68549097. +83905028 = -45495804 band 118516717. +-10884115 = -45495804 bor 118516717. +-94789143 = -45495804 bxor 118516717. +3033122 = -114402782 band 8318131. +-109117773 = -114402782 bor 8318131. +-112150895 = -114402782 bxor 8318131. +26247264 = 127631984 band 26532329. +127917049 = 127631984 bor 26532329. +101669785 = 127631984 bxor 26532329. +-126771186 = -100927890 band -59662065. +-33818769 = -100927890 bor -59662065. +92952417 = -100927890 bxor -59662065. +524676 = -66169444 band 47721381. +-18972739 = -66169444 bor 47721381. +-19497415 = -66169444 bxor 47721381. +19991338 = -101381254 band 20004651. +-101367941 = -101381254 bor 20004651. +-121359279 = -101381254 bxor 20004651. +4197632 = -109498488 band 4513057. +-109183063 = -109498488 bor 4513057. +-113380695 = -109498488 bxor 4513057. +8454 = 20473158 band -33381625. +-12916921 = 20473158 bor -33381625. +-12925375 = 20473158 bxor -33381625. +19998740 = 53853236 band 24193629. +58048125 = 53853236 bor 24193629. +38049385 = 53853236 bxor 24193629. +17041538 = -117076014 band 127690915. +-6426637 = -117076014 bor 127690915. +-23468175 = -117076014 bxor 127690915. +101189376 = 109864864 band 119213913. +127889401 = 109864864 bor 119213913. +26700025 = 109864864 bxor 119213913. +-50281698 = -49752290 band -41751553. +-41222145 = -49752290 bor -41751553. +9059553 = -49752290 bxor -41751553. +14698500 = -85959220 band 98846741. +-1810979 = -85959220 bor 98846741. +-16509479 = -85959220 bxor 98846741. +19153162 = 90654506 band -115062501. +-43561157 = 90654506 bor -115062501. +-62714319 = 90654506 bxor -115062501. +9044112 = -124024136 band 13521041. +-119547207 = -124024136 bor 13521041. +-128591319 = -124024136 bxor 13521041. +8391670 = 92974070 band 45374455. +129956855 = 92974070 bor 45374455. +121565185 = 92974070 bxor 45374455. +38928452 = 47880804 band -9018163. +-65811 = 47880804 bor -9018163. +-38994263 = 47880804 bxor -9018163. +59277442 = -72511102 band 130597011. +-1191533 = -72511102 bor 130597011. +-60468975 = -72511102 bxor 130597011. +-66027328 = -2557744 band -65961783. +-2492199 = -2557744 bor -65961783. +63535129 = -2557744 bxor -65961783. +-47955250 = -47758386 band -4926737. +-4729873 = -47758386 bor -4926737. +43225377 = -47758386 bxor -4926737. +67649668 = -65220100 band 86532229. +-46337539 = -65220100 bor 86532229. +-113987207 = -65220100 bxor 86532229. +-114979318 = -76034342 band -106582261. +-67637285 = -76034342 bor -106582261. +47342033 = -76034342 bxor -106582261. +67305472 = 73601512 band -15499263. +-9203223 = 73601512 bor -15499263. +-76508695 = 73601512 bxor -15499263. +1192102 = -32244058 band 8270055. +-25166105 = -32244058 bor 8270055. +-26358207 = -32244058 bxor 8270055. +196628 = 38495380 band 20388669. +58687421 = 38495380 bor 20388669. +58490793 = 38495380 bxor 20388669. +7361538 = -51290318 band 7533699. +-51118157 = -51290318 bor 7533699. +-58479695 = -51290318 bxor 7533699. +46409216 = 130299392 band -83939783. +-49607 = 130299392 bor -83939783. +-46458823 = 130299392 bxor -83939783. +37885022 = 131218558 band -93956641. +-623105 = 131218558 bor -93956641. +-38508127 = 131218558 bxor -93956641. +68300836 = 87470636 band -56920843. +-37751043 = 87470636 bor -56920843. +-106051879 = 87470636 bxor -56920843. +8330 = 106013322 band 17068283. +123073275 = 106013322 bor 17068283. +123064945 = 106013322 bxor 17068283. +108151056 = 108184856 band -8688783. +-8654983 = 108184856 bor -8688783. +-116806039 = 108184856 bxor -8688783. +-124845738 = -55616170 band -73457193. +-4227625 = -55616170 bor -73457193. +120618113 = -55616170 bxor -73457193. +34211972 = 39525060 band -91599443. +-86286355 = 39525060 bor -91599443. +-120498327 = 39525060 bxor -91599443. +4849762 = 22804706 band -87423885. +-69468941 = 22804706 bor -87423885. +-74318703 = 22804706 bxor -87423885. +-134146272 = -112124112 band -30730327. +-8708167 = -112124112 bor -30730327. +125438105 = -112124112 bxor -30730327. +-100384754 = -12271314 band -88705841. +-592401 = -12271314 bor -88705841. +99792353 = -12271314 bxor -88705841. +39879748 = -27197860 band 66356581. +-721027 = -27197860 bor 66356581. +-40600775 = -27197860 bxor 66356581. +5210666 = 14664250 band -11563285. +-2109701 = 14664250 bor -11563285. +-7320367 = 14664250 bxor -11563285. +103612480 = 120431688 band -30600479. +-13781271 = 120431688 bor -30600479. +-117393751 = 120431688 bxor -30600479. +102107142 = -538618 band 102117063. +-528697 = -538618 bor 102117063. +-102635839 = -538618 bxor 102117063. +33864724 = -23282444 band 50789405. +-6357763 = -23282444 bor 50789405. +-40222487 = -23282444 bxor 50789405. +3690498 = 104357522 band -105058205. +-4391181 = 104357522 bor -105058205. +-8081679 = 104357522 bxor -105058205. +100676608 = 105034848 band -6537959. +-2179719 = 105034848 bor -6537959. +-102856327 = 105034848 bxor -6537959. +33554846 = -92679714 band 58994623. +-67239937 = -92679714 bor 58994623. +-100794783 = -92679714 bxor 58994623. +42635396 = 42907276 band -22375979. +-22104099 = 42907276 bor -22375979. +-64739495 = 42907276 bxor -22375979. +105121994 = 114109930 band 106301659. +115289595 = 114109930 bor 106301659. +10167601 = 114109930 bxor 106301659. +-49928624 = -38359176 band -15763887. +-4194439 = -38359176 bor -15763887. +45734185 = -38359176 bxor -15763887. +50337462 = 55066294 band -6137929. +-1409097 = 55066294 bor -6137929. +-51746559 = 55066294 bxor -6137929. +67109380 = -43824348 band 100935309. +-9998419 = -43824348 bor 100935309. +-77107799 = -43824348 bxor 100935309. +26251330 = 26316866 band -101009325. +-100943789 = 26316866 bor -101009325. +-127195119 = 26316866 bxor -101009325. +18453632 = 119272848 band -115761527. +-14942311 = 119272848 bor -115761527. +-33395943 = 119272848 bxor -115761527. +86771342 = 86797966 band -43088209. +-43061585 = 86797966 bor -43088209. +-129832927 = 86797966 bxor -43088209. +-76506620 = -9250116 band -67855803. +-599299 = -9250116 bor -67855803. +75907321 = -9250116 bxor -67855803. +8701066 = 75818394 band -106504501. +-39387173 = 75818394 bor -106504501. +-48088239 = 75818394 bxor -106504501. +-37714816 = -989528 band -37120575. +-395287 = -989528 bor -37120575. +37319529 = -989528 bxor -37120575. +75661350 = -21249690 band 96640167. +-270873 = -21249690 bor 96640167. +-75932223 = -21249690 bxor 96640167. +41993300 = -4078252 band 43568381. +-2503171 = -4078252 bor 43568381. +-44496471 = -4078252 bxor 43568381. +3279938 = 36867570 band 32660547. +66248179 = 36867570 bor 32660547. +62968241 = 36867570 bxor 32660547. +664256 = -81796416 band 69876729. +-12583943 = -81796416 bor 69876729. +-13248199 = -81796416 bxor 69876729. +114561310 = -2648258 band 114588063. +-2621505 = -2648258 bor 114588063. +-117182815 = -2648258 bxor 114588063. +75500196 = 92302060 band 113876661. +130678525 = 92302060 bor 113876661. +55178329 = 92302060 bxor 113876661. +101777418 = 120711498 band -24047429. +-5113349 = 120711498 bor -24047429. +-106890767 = 120711498 bxor -24047429. +4342032 = 41896408 band -37588687. +-34311 = 41896408 bor -37588687. +-4376343 = 41896408 bxor -37588687. +52776982 = 120410134 band 62258583. +129891735 = 120410134 bor 62258583. +77114753 = 120410134 bxor 62258583. +25897732 = 25897860 band -73666707. +-73666579 = 25897860 bor -73666707. +-99564311 = 25897860 bxor -73666707. +25318434 = -5875806 band 30596147. +-598093 = -5875806 bor 30596147. +-25916527 = -5875806 bxor 30596147. +-133099168 = -128877584 band -99281559. +-95059975 = -128877584 bor -99281559. +38039193 = -128877584 bxor -99281559. +60033166 = -4830226 band 64293007. +-570385 = -4830226 bor 64293007. +-60603551 = -4830226 bxor 64293007. +98567940 = 132802332 band 98606885. +132841277 = 132802332 bor 98606885. +34273337 = 132802332 bxor 98606885. +-64808790 = -54576902 band -64774485. +-54542597 = -54576902 bor -64774485. +10266193 = -54576902 bxor -64774485. +-134215680 = -121317112 band -98498399. +-85599831 = -121317112 bor -98498399. +48615849 = -121317112 bxor -98498399. +36924038 = -29889850 band 41646727. +-25167161 = -29889850 bor 41646727. +-62091199 = -29889850 bxor 41646727. +16780692 = -112034380 band 128224733. +-590339 = -112034380 bor 128224733. +-17371031 = -112034380 bxor 128224733. +33761282 = -96998062 band 59455523. +-71303821 = -96998062 bor 59455523. +-105065103 = -96998062 bxor 59455523. +56688640 = -76300000 band 65088217. +-67900423 = -76300000 bor 65088217. +-124589063 = -76300000 bxor 65088217. +-29163490 = -20738914 band -28363905. +-19939329 = -20738914 bor -28363905. +9224161 = -20738914 bxor -28363905. +-123696380 = -56373428 band -72311915. +-4988963 = -56373428 bor -72311915. +118707417 = -56373428 bxor -72311915. +50692234 = 64476330 band -80901989. +-67117893 = 64476330 bor -80901989. +-117810127 = 64476330 bxor -80901989. +79959056 = 82089016 band 97278993. +99408953 = 82089016 bor 97278993. +19449897 = 82089016 bxor 97278993. +1184118 = 37130614 band -120450185. +-84503689 = 37130614 bor -120450185. +-85687807 = 37130614 bxor -120450185. +567364 = -127222812 band 17410125. +-110380051 = -127222812 bor 17410125. +-110947415 = -127222812 bxor 17410125. +-87932926 = -84783358 band -87396333. +-84246765 = -84783358 bor -87396333. +3686161 = -84783358 bxor -87396333. +-134139840 = -133582256 band -95060919. +-94503335 = -133582256 bor -95060919. +39636505 = -133582256 bxor -95060919. +27285582 = -71673522 band 98695791. +-263313 = -71673522 bor 98695791. +-27548895 = -71673522 bxor 98695791. +72384516 = -60841092 band 108041221. +-25184387 = -60841092 bor 108041221. +-97568903 = -60841092 bxor 108041221. +35949578 = -68764582 band 104713867. +-293 = -68764582 bor 104713867. +-35949871 = -68764582 bxor 104713867. +54618880 = 130120552 band -76846207. +-1344535 = 130120552 bor -76846207. +-55963415 = 130120552 bxor -76846207. +-100646874 = -29080538 band -80164761. +-8598425 = -29080538 bor -80164761. +92048449 = -29080538 bxor -80164761. +14820884 = -85531116 band 98713277. +-1638723 = -85531116 bor 98713277. +-16459607 = -85531116 bxor 98713277. +10486786 = 60849330 band 83854339. +134216883 = 60849330 bor 83854339. +123730097 = 60849330 bxor 83854339. +5245312 = -128561280 band 100207033. +-33599559 = -128561280 bor 100207033. +-38844871 = -128561280 bxor 100207033. +-100396706 = -99241474 band -1286817. +-131585 = -99241474 bor -1286817. +100265121 = -99241474 bxor -1286817. +1081380 = 43049900 band 1542261. +43510781 = 43049900 bor 1542261. +42429401 = 43049900 bxor 1542261. +16936970 = 85389322 band -106729349. +-38276997 = 85389322 bor -106729349. +-55213967 = 85389322 bxor -106729349. +6555280 = 16682648 band -43698447. +-33571079 = 16682648 bor -43698447. +-40126359 = 16682648 bxor -43698447. +-97779626 = -96730410 band -68249257. +-67200041 = -96730410 bor -68249257. +30579585 = -96730410 bxor -68249257. +86020 = 127532100 band -133869267. +-6423187 = 127532100 bor -133869267. +-6509207 = 127532100 bxor -133869267. +-129404318 = -20089246 band -111578125. +-2263053 = -20089246 bor -111578125. +127141265 = -20089246 bxor -111578125. +-49246176 = -44263248 band -15543511. +-10560583 = -44263248 bor -15543511. +38685593 = -44263248 bxor -15543511. +33559566 = 34641582 band 126704719. +127786735 = 34641582 bor 126704719. +94227169 = 34641582 bxor 126704719. +-62388028 = -43348004 band -27494171. +-8454147 = -43348004 bor -27494171. +53933881 = -43348004 bxor -27494171. +4288042 = 5468090 band 57503339. +58683387 = 5468090 bor 57503339. +54395345 = 5468090 bxor 57503339. +81824832 = -16855608 band 98614881. +-65559 = -16855608 bor 98614881. +-81890391 = -16855608 bxor 98614881. +-89095162 = -88552058 band -84769209. +-84226105 = -88552058 bor -84769209. +4869057 = -88552058 bxor -84769209. +56852 = 1506932 band -49684579. +-48234499 = 1506932 bor -49684579. +-48291351 = 1506932 bxor -49684579. +-121357310 = -3916782 band -121159709. +-3719181 = -3916782 bor -121159709. +117638129 = -3916782 bxor -121159709. +-58095488 = -18903584 band -39200615. +-8711 = -18903584 bor -39200615. +58086777 = -18903584 bxor -39200615. +10618654 = 10880862 band -39585985. +-39323777 = 10880862 bor -39585985. +-49942431 = 10880862 bxor -39585985. +9838596 = -35674100 band 45507925. +-4771 = -35674100 bor 45507925. +-9843367 = -35674100 bxor 45507925. +54659146 = -12108950 band 57329755. +-9438341 = -12108950 bor 57329755. +-64097487 = -12108950 bxor 57329755. +113574096 = -18532104 band 113574353. +-18531847 = -18532104 bor 113574353. +-132105943 = -18532104 bxor 113574353. +99382 = 18195510 band 100896567. +118992695 = 18195510 bor 100896567. +118893313 = 18195510 bxor 100896567. +59396 = 11594916 band -28906995. +-17371475 = 11594916 bor -28906995. +-17430871 = 11594916 bxor -28906995. +8897986 = 42978754 band -34084909. +-4141 = 42978754 bor -34084909. +-8902127 = 42978754 bxor -34084909. +-117437952 = -77451504 band -108717559. +-68731111 = -77451504 bor -108717559. +48706841 = -77451504 bxor -108717559. +8455182 = 126944270 band -120639953. +-2150865 = 126944270 bor -120639953. +-10606047 = 126944270 bxor -120639953. +33557508 = 128134204 band -94614075. +-37379 = 128134204 bor -94614075. +-33594887 = 128134204 bxor -94614075. +545290 = 73224986 band -81101237. +-8421541 = 73224986 bor -81101237. +-8966831 = 73224986 bxor -81101237. +-124780544 = -57356248 band -105316031. +-37891735 = -57356248 bor -105316031. +86888809 = -57356248 bxor -105316031. +-132086746 = -76708122 band -123685849. +-68307225 = -76708122 bor -123685849. +63779521 = -76708122 bxor -123685849. +5390420 = 8046292 band -120360835. +-117704963 = 8046292 bor -120360835. +-123095383 = 8046292 bxor -120360835. +-111531198 = -67425422 band -44405821. +-300045 = -67425422 bor -44405821. +111231153 = -67425422 bxor -44405821. +-131918784 = -131630016 band -97806471. +-97517703 = -131630016 bor -97806471. +34401081 = -131630016 bxor -97806471. +88866846 = -45314882 band 91095327. +-43086401 = -45314882 bor 91095327. +-131953247 = -45314882 bxor 91095327. +4132 = 19405932 band -29019595. +-9617795 = 19405932 bor -29019595. +-9621927 = 19405932 bxor -29019595. +12619786 = 46184138 band -33845189. +-280837 = 46184138 bor -33845189. +-12900623 = 46184138 bxor -33845189. +2134032 = 45126488 band 2342065. +45334521 = 45126488 bor 2342065. +43200489 = 45126488 bxor 2342065. +67663126 = 77297046 band -66521833. +-56887913 = 77297046 bor -66521833. +-124551039 = 77297046 bxor -66521833. +17170436 = 21466372 band -41520403. +-37224467 = 21466372 bor -41520403. +-54394903 = 21466372 bxor -41520403. +17908002 = -107915998 band 85838771. +-39985229 = -107915998 bor 85838771. +-57893231 = -107915998 bxor 85838771. +2117728 = 20084080 band 115626217. +133592569 = 20084080 bor 115626217. +131474841 = 20084080 bxor 115626217. +85139470 = -49045138 band 94334991. +-39849617 = -49045138 bor 94334991. +-124989087 = -49045138 bxor 94334991. +52433028 = 60913820 band 52957861. +61438653 = 60913820 bor 52957861. +9005625 = 60913820 bxor 52957861. +5006890 = -27498886 band 15531563. +-16974213 = -27498886 bor 15531563. +-21981103 = -27498886 bxor 15531563. +34078720 = -90471800 band 53228577. +-71321943 = -90471800 bor 53228577. +-105400663 = -90471800 bxor 53228577. +70930438 = 70938694 band 121328135. +121336391 = 70938694 bor 121328135. +50405953 = 70938694 bxor 121328135. +10629396 = -5619916 band 16183645. +-65667 = -5619916 bor 16183645. +-10695063 = -5619916 bxor 16183645. +17891970 = 27085522 band -47118429. +-37924877 = 27085522 bor -47118429. +-55816847 = 27085522 bxor -47118429. +393728 = -112846176 band 112608857. +-631047 = -112846176 bor 112608857. +-1024775 = -112846176 bxor 112608857. +4211230 = 115425822 band 21134079. +132348671 = 115425822 bor 21134079. +128137441 = 115425822 bxor 21134079. +-117293052 = -83738420 band -109318379. +-75763747 = -83738420 bor -109318379. +41529305 = -83738420 bxor -109318379. +-87474166 = -69508566 band -87177189. +-69211589 = -69508566 bor -87177189. +18262577 = -69508566 bxor -87177189. +3671440 = -59204168 band 62482321. +-393287 = -59204168 bor 62482321. +-4064727 = -59204168 bxor 62482321. +-22789386 = -22710538 band -17380617. +-17301769 = -22710538 bor -17380617. +5487617 = -22710538 bxor -17380617. +41011524 = 49667428 band -75764787. +-67108883 = 49667428 bor -75764787. +-108120407 = 49667428 bxor -75764787. +50465922 = 53087362 band 121839507. +124460947 = 53087362 bor 121839507. +73995025 = 53087362 bxor 121839507. +6316992 = -102405168 band 6846409. +-101875751 = -102405168 bor 6846409. +-108192743 = -102405168 bxor 6846409. +91234510 = -9408818 band 100016623. +-626705 = -9408818 bor 100016623. +-91861215 = -9408818 bxor 100016623. +91571332 = 100496636 band -42481787. +-33556483 = 100496636 bor -42481787. +-125127815 = 100496636 bxor -42481787. +2664458 = 11053530 band 70053387. +78442459 = 11053530 bor 70053387. +75778001 = 11053530 bxor 70053387. +-98417664 = -13966104 band -93169919. +-8718359 = -13966104 bor -93169919. +89699305 = -13966104 bxor -93169919. +78776742 = 83331494 band 96100327. +100655079 = 83331494 bor 96100327. +21878337 = 83331494 bxor 96100327. +-114531820 = -46307436 band -114531779. +-46307395 = -46307436 bor -114531779. +68224425 = -46307436 bxor -114531779. +100798978 = 100833842 band -20769917. +-20735053 = 100833842 bor -20769917. +-121534031 = 100833842 bxor -20769917. +33644800 = 55798016 band -92150471. +-69997255 = 55798016 bor -92150471. +-103642055 = 55798016 bxor -92150471. +1582174 = 3942270 band 119104735. +121464831 = 3942270 bor 119104735. +119882657 = 3942270 bxor 119104735. +100798756 = 101061932 band 118660085. +118923261 = 101061932 bor 118660085. +18124505 = 101061932 bxor 118660085. +38350218 = 49233290 band 123301883. +134184955 = 49233290 bor 123301883. +95834737 = 49233290 bxor 123301883. +1310736 = -128624616 band 129892977. +-42375 = -128624616 bor 129892977. +-1353111 = -128624616 bxor 129892977. +16842838 = 84650070 band -70971177. +-3163945 = 84650070 bor -70971177. +-20006783 = 84650070 bxor -70971177. +-111979388 = -78389820 band -102804307. +-69214739 = -78389820 bor -102804307. +42764649 = -78389820 bxor -102804307. +-124656798 = -89000990 band -119544973. +-83889165 = -89000990 bor -119544973. +40767633 = -89000990 bxor -119544973. +-134151648 = -57470416 band -79065431. +-2384199 = -57470416 bor -79065431. +131767449 = -57470416 bxor -79065431. +88817678 = 125791278 band -37010481. +-36881 = 125791278 bor -37010481. +-88854559 = 125791278 bxor -37010481. +-100458428 = -11591332 band -100438939. +-11571843 = -11591332 bor -100438939. +88886585 = -11591332 bxor -100438939. +134442 = -107340486 band 6442475. +-101032453 = -107340486 bor 6442475. +-101166895 = -107340486 bxor 6442475. +4350272 = -61147320 band 63138273. +-2359319 = -61147320 bor 63138273. +-6709591 = -61147320 bxor 63138273. +-116076282 = -109260026 band -15344185. +-8527929 = -109260026 bor -15344185. +107548353 = -109260026 bxor -15344185. +525076 = 80494580 band 19645213. +99614717 = 80494580 bor 19645213. +99089641 = 80494580 bxor 19645213. +8390914 = -92071534 band 76058467. +-24403981 = -92071534 bor 76058467. +-32794895 = -92071534 bxor 76058467. +4613120 = 57108320 band -121211879. +-68716679 = 57108320 bor -121211879. +-73329799 = 57108320 bxor -121211879. +-132105058 = -130728738 band -118833473. +-117457153 = -130728738 bor -118833473. +14647905 = -130728738 bxor -118833473. +12654724 = -120874612 band 96549077. +-36980259 = -120874612 bor 96549077. +-49634983 = -120874612 bxor 96549077. +-65797942 = -61585174 band -48855077. +-44642309 = -61585174 bor -48855077. +21155633 = -61585174 bxor -48855077. +-28802992 = -27344264 band -26636975. +-25178247 = -27344264 bor -26636975. +3624745 = -27344264 bxor -26636975. +-115212106 = -106559050 band -76822857. +-68169801 = -106559050 bor -76822857. +47042305 = -106559050 bxor -76822857. +40406020 = -67531228 band 107523469. +-413779 = -67531228 bor 107523469. +-40819799 = -67531228 bxor 107523469. +33555266 = 125897538 band -93579437. +-1237165 = 125897538 bor -93579437. +-34792431 = 125897538 bxor -93579437. +-132972416 = -61642608 band -121662071. +-50332263 = -61642608 bor -121662071. +82640153 = -61642608 bxor -121662071. +-133131890 = -99051122 band -48835153. +-14754385 = -99051122 bor -48835153. +118377505 = -99051122 bxor -48835153. +67240196 = -64062020 band 92471621. +-38830595 = -64062020 bor 92471621. +-106070791 = -64062020 bxor 92471621. +16777354 = 59293850 band -49996341. +-7479845 = 59293850 bor -49996341. +-24257199 = 59293850 bxor -49996341. +4401280 = 4438440 band -11047743. +-11010583 = 4438440 bor -11047743. +-15411863 = 4438440 bxor -11047743. +-134199258 = -106804122 band -96089177. +-68694041 = -106804122 bor -96089177. +65505217 = -106804122 bxor -96089177. +78381140 = -34682796 band 78451709. +-34612227 = -34682796 bor 78451709. +-112993367 = -34682796 bxor 78451709. +-59750334 = -59324174 band -50758845. +-50332685 = -59324174 bor -50758845. +9417649 = -59324174 bxor -50758845. +10096832 = 43652544 band 12317433. +45873145 = 43652544 bor 12317433. +35776313 = 43652544 bxor 12317433. +10780702 = -106659266 band 78547103. +-38892865 = -106659266 bor 78547103. +-49673567 = -106659266 bxor 78547103. +2803108 = 99274220 band 4179381. +100650493 = 99274220 bor 4179381. +97847385 = 99274220 bxor 4179381. +6292490 = -127761334 band 24973243. +-109080581 = -127761334 bor 24973243. +-115373071 = -127761334 bxor 24973243. +10749968 = 44883160 band 99878961. +134012153 = 44883160 bor 99878961. +123262185 = 44883160 bxor 99878961. +37783574 = -95642858 band 48426135. +-85000297 = -95642858 bor 48426135. +-122783871 = -95642858 bxor 48426135. +38725124 = 41873028 band -87034259. +-83886355 = 41873028 bor -87034259. +-122611479 = 41873028 bxor -87034259. +-129035742 = -51424606 band -127943885. +-50332749 = -51424606 bor -127943885. +78702993 = -51424606 bxor -127943885. +134240 = -130126096 band 100830313. +-29430023 = -130126096 bor 100830313. +-29564263 = -130126096 bxor 100830313. +-133114226 = -132909330 band -3090545. +-2885649 = -132909330 bor -3090545. +130228577 = -132909330 bxor -3090545. +2261508 = 87263772 band -122780123. +-37777859 = 87263772 bor -122780123. +-40039367 = 87263772 bxor -122780123. +76288426 = 80516090 band -41067093. +-36839429 = 80516090 bor -41067093. +-113127855 = 80516090 bxor -41067093. +6556672 = 83700744 band -110731359. +-33587287 = 83700744 bor -110731359. +-40143959 = 83700744 bxor -110731359. +-134078074 = -113248826 band -96327289. +-75498041 = -113248826 bor -96327289. +58580033 = -113248826 bxor -96327289. +-131596140 = -63110988 band -77048611. +-8563459 = -63110988 bor -77048611. +123032681 = -63110988 bxor -77048611. +360450 = 87402578 band 42850083. +129892211 = 87402578 bor 42850083. +129531761 = 87402578 bxor 42850083. +67264512 = 100889632 band -40214055. +-6588935 = 100889632 bor -40214055. +-73853447 = 100889632 bxor -40214055. +4243998 = -77465698 band 73187967. +-8521729 = -77465698 bor 73187967. +-12765727 = -77465698 bxor 73187967. +-113114620 = -67390900 band -45727083. +-3363 = -67390900 bor -45727083. +113111257 = -67390900 bxor -45727083. +33621898 = 57798570 band 100992923. +125169595 = 57798570 bor 100992923. +91547697 = 57798570 bxor 100992923. +1385232 = 89630520 band -124423407. +-36178119 = 89630520 bor -124423407. +-37563351 = 89630520 bxor -124423407. +131190 = 14113910 band 52593271. +66575991 = 14113910 bor 52593271. +66444801 = 14113910 bxor 52593271. +-129421756 = -126091548 band -53661875. +-50331667 = -126091548 bor -53661875. +79090089 = -126091548 bxor -53661875. +-99563006 = -95106558 band -80556269. +-76099821 = -95106558 bor -80556269. +23463185 = -95106558 bxor -80556269. +-129490624 = -76798640 band -62229687. +-9537703 = -76798640 bor -62229687. +119952921 = -76798640 bxor -62229687. +-62848946 = -28736434 band -34518673. +-406161 = -28736434 bor -34518673. +62442785 = -28736434 bxor -34518673. +-130792956 = -17414532 band -130155771. +-16777347 = -17414532 bor -130155771. +114015609 = -17414532 bxor -130155771. +19989770 = -4352166 band 24317323. +-24613 = -4352166 bor 24317323. +-20014383 = -4352166 bxor 24317323. +541184 = 10440296 band -98024831. +-88125719 = 10440296 bor -98024831. +-88666903 = 10440296 bxor -98024831. +-134166746 = -131215578 band -33360025. +-30408857 = -131215578 bor -33360025. +103757889 = -131215578 bxor -33360025. +-117145324 = -11605740 band -116030019. +-10490435 = -11605740 bor -116030019. +106654889 = -11605740 bxor -116030019. +-99245310 = -99108942 band -71458045. +-71321677 = -99108942 bor -71458045. +27923633 = -99108942 bxor -71458045. +110723200 = -21265792 band 110739641. +-21249351 = -21265792 bor 110739641. +-131972551 = -21265792 bxor 110739641. +4525150 = 4562174 band -34771873. +-34734849 = 4562174 bor -34771873. +-39259999 = 4562174 bxor -34771873. +92538404 = 93734572 band -7557259. +-6361091 = 93734572 bor -7557259. +-98899495 = 93734572 bxor -7557259. +133898 = 98208522 band -131698821. +-33624197 = 98208522 bor -131698821. +-33758095 = 98208522 bxor -131698821. +328080 = 41361816 band -58339855. +-17306119 = 41361816 bor -58339855. +-17634199 = 41361816 bxor -58339855. +16910422 = 52317654 band -115177385. +-79770153 = 52317654 bor -115177385. +-96680575 = 52317654 bxor -115177385. +34084868 = 59293508 band -31958995. +-6750355 = 59293508 bor -31958995. +-40835223 = 59293508 bxor -31958995. +50942050 = -83267230 band 123556595. +-10652685 = -83267230 bor 123556595. +-61594735 = -83267230 bxor 123556595. +12847648 = -51082320 band 13584937. +-50345031 = -51082320 bor 13584937. +-63192679 = -51082320 bxor 13584937. +17826062 = 93405614 band -76534961. +-955409 = 93405614 bor -76534961. +-18781471 = 93405614 bxor -76534961. +529092 = -99700004 band 82403301. +-17825795 = -99700004 bor 82403301. +-18354887 = -99700004 bxor 82403301. +2230314 = 45337274 band 70135147. +113242107 = 45337274 bor 70135147. +111011793 = 45337274 bxor 70135147. +88080448 = 88219848 band 97850721. +97990121 = 88219848 bor 97850721. +9909673 = 88219848 bxor 97850721. +4102 = 38000774 band 8402247. +46398919 = 38000774 bor 8402247. +46394817 = 38000774 bxor 8402247. +2916372 = 45908340 band -43211107. +-219139 = 45908340 bor -43211107. +-3135511 = 45908340 bxor -43211107. +-134162942 = -59443438 band -83829021. +-9109517 = -59443438 bor -83829021. +125053425 = -59443438 bxor -83829021. +-120455040 = -103137056 band -17690727. +-372743 = -103137056 bor -17690727. +120082297 = -103137056 bxor -17690727. +50332190 = 120025694 band 56133183. +125826687 = 120025694 bor 56133183. +75494497 = 120025694 bxor 56133183. +21104644 = -112030964 band 97193045. +-35942563 = -112030964 bor 97193045. +-57047207 = -112030964 bxor 97193045. +22038090 = 66344554 band 22628187. +66934651 = 66344554 bor 22628187. +44896561 = 66344554 bxor 22628187. +35719376 = 35867640 band 66918609. +67066873 = 35867640 bor 66918609. +31347497 = 35867640 bxor 66918609. +14183990 = 49901366 band -35979721. +-262345 = 49901366 bor -35979721. +-14446335 = 49901366 bxor -35979721. +69804292 = 87895972 band -60198643. +-42106963 = 87895972 bor -60198643. +-111911255 = 87895972 bxor -60198643. +71647426 = 107301058 band -44611885. +-8958253 = 107301058 bor -44611885. +-80605679 = 107301058 bxor -44611885. +80281600 = -1072624 band 80285961. +-1068263 = -1072624 bor 80285961. +-81349863 = -1072624 bxor 80285961. +4271374 = 46345998 band -129663697. +-87589073 = 46345998 bor -129663697. +-91860447 = 46345998 bxor -129663697. +50365444 = 51695420 band -77024059. +-75694083 = 51695420 bor -77024059. +-126059527 = 51695420 bxor -77024059. +-133813238 = -133747174 band -46744245. +-46678181 = -133747174 bor -46744245. +87135057 = -133747174 bxor -46744245. +10780672 = 16622376 band -56305599. +-50463895 = 16622376 bor -56305599. +-61244567 = 16622376 bxor -56305599. +-133168858 = -10874394 band -122559705. +-265241 = -10874394 bor -122559705. +132903617 = -10874394 bxor -122559705. +67469652 = -31602220 band 69580669. +-29491203 = -31602220 bor 69580669. +-96960855 = -31602220 bxor 69580669. +-125500862 = -106600846 band -19952957. +-1052941 = -106600846 bor -19952957. +124447921 = -106600846 bxor -19952957. +5443136 = 7843648 band 98258553. +100659065 = 7843648 bor 98258553. +95215929 = 7843648 bxor 98258553. +43388958 = -86018114 band 43388959. +-86018113 = -86018114 bor 43388959. +-129407071 = -86018114 bxor 43388959. +-125282012 = -104300692 band -88516299. +-67534979 = -104300692 bor -88516299. +57747033 = -104300692 bxor -88516299. +102039818 = -32026166 band 118853435. +-15212549 = -32026166 bor 118853435. +-117252367 = -32026166 bxor 118853435. +-131071472 = -126605736 band -46967887. +-42502151 = -126605736 bor -46967887. +88569321 = -126605736 bxor -46967887. +104906774 = -29310826 band 105112599. +-29105001 = -29310826 bor 105112599. +-134011775 = -29310826 bxor 105112599. +19943428 = -80654332 band 24672749. +-75925011 = -80654332 bor 24672749. +-95868439 = -80654332 bxor 24672749. +-109051870 = -4173790 band -107435341. +-2557261 = -4173790 bor -107435341. +106494609 = -4173790 bxor -107435341. +23412832 = 58026096 band 91211753. +125825017 = 58026096 bor 91211753. +102412185 = 58026096 bxor 91211753. +2165774 = 112675950 band 6897423. +117407599 = 112675950 bor 6897423. +115241825 = 112675950 bxor 6897423. +2136452 = 44080028 band 74709413. +116652989 = 44080028 bor 74709413. +114516537 = 44080028 bxor 74709413. +295210 = 101695866 band 310571. +101711227 = 101695866 bor 310571. +101416017 = 101695866 bxor 310571. +-121011968 = -35007096 band -87061727. +-1056855 = -35007096 bor -87061727. +119955113 = -35007096 bxor -87061727. +16777478 = 55081798 band -108003065. +-69698745 = 55081798 bor -108003065. +-86476223 = 55081798 bxor -108003065. +67665940 = 84591156 band 83408989. +100334205 = 84591156 bor 83408989. +32668265 = 84591156 bxor 83408989. +16843906 = -83819054 band 27371171. +-73291789 = -83819054 bor 27371171. +-90135695 = -83819054 bxor 27371171. +109661440 = 128699808 band 109935961. +128974329 = 128699808 bor 109935961. +19312889 = 128699808 bxor 109935961. +264478 = 38120734 band 94243327. +132099583 = 38120734 bor 94243327. +131835105 = 38120734 bxor 94243327. +83886596 = 93332428 band 84907541. +94353373 = 93332428 bor 84907541. +10466777 = 93332428 bxor 84907541. +9651466 = 10190122 band -86816997. +-86278341 = 10190122 bor -86816997. +-95929807 = 10190122 bxor -86816997. +12432 = 92385464 band 39878289. +132251321 = 92385464 bor 39878289. +132238889 = 92385464 bxor 39878289. +38011382 = -20168202 band 55917047. +-2262537 = -20168202 bor 55917047. +-40273919 = -20168202 bxor 55917047. +50143300 = -16965532 band 50164429. +-16944403 = -16965532 bor 50164429. +-67087703 = -16965532 bxor 50164429. +68159106 = 108169090 band 77168275. +117178259 = 108169090 bor 77168275. +49019153 = 108169090 bxor 77168275. +43601600 = 43900624 band -67408183. +-67109159 = 43900624 bor -67408183. +-110710759 = 43900624 bxor -67408183. +-96399154 = -28993074 band -70029073. +-2622993 = -28993074 bor -70029073. +93776161 = -28993074 bxor -70029073. +71435908 = -45475844 band 79900293. +-37011459 = -45475844 bor 79900293. +-108447367 = -45475844 bxor 79900293. +-67107830 = -14318374 band -66048757. +-13259301 = -14318374 bor -66048757. +53848529 = -14318374 bxor -66048757. +796160 = 35567592 band -124965375. +-90193943 = 35567592 bor -124965375. +-90990103 = 35567592 bxor -124965375. +132262 = -35187546 band 34770663. +-549145 = -35187546 bor 34770663. +-681407 = -35187546 bxor 34770663. +51980308 = 119237268 band 60664125. +127921085 = 119237268 bor 60664125. +75940777 = 119237268 bxor 60664125. +30347266 = 98555186 band -101764477. +-33556557 = 98555186 bor -101764477. +-63903823 = 98555186 bxor -101764477. +39936 = 9346048 band -129983431. +-120677319 = 9346048 bor -129983431. +-120717255 = 9346048 bxor -129983431. +2101854 = 3281534 band 40399839. +41579519 = 3281534 bor 40399839. +39477665 = 3281534 bxor 40399839. +117522468 = 121731116 band 126206709. +130415357 = 121731116 bor 126206709. +12892889 = 121731116 bxor 126206709. +34097290 = 64542858 band -99979525. +-69533957 = 64542858 bor -99979525. +-103631247 = 64542858 bxor -99979525. +18909456 = 90434328 band -105080463. +-33555591 = 90434328 bor -105080463. +-52465047 = 90434328 bxor -105080463. +33747798 = -93064362 band 34013143. +-92799017 = -93064362 bor 34013143. +-126546815 = -93064362 bxor 34013143. +36700292 = 104374468 band 45112237. +112786413 = 104374468 bor 45112237. +76086121 = 104374468 bxor 45112237. +13746786 = 97775330 band 47301235. +131329779 = 97775330 bor 47301235. +117582993 = 97775330 bxor 47301235. +75498784 = 75564336 band -39582295. +-39516743 = 75564336 bor -39582295. +-115015527 = 75564336 bxor -39582295. +38015502 = 38147886 band -25423153. +-25290769 = 38147886 bor -25423153. +-63306271 = 38147886 bxor -25423153. +17317956 = 61424732 band -49392795. +-5286019 = 61424732 bor -49392795. +-22603975 = 61424732 bxor -49392795. +8390698 = 27293754 band -53408533. +-34505477 = 27293754 bor -53408533. +-42896175 = 27293754 bxor -53408533. +-99336128 = -4961720 band -99237663. +-4863255 = -4961720 bor -99237663. +94472873 = -4961720 bxor -99237663. +-117339130 = -82977274 band -47084345. +-12722489 = -82977274 bor -47084345. +104616641 = -82977274 bxor -47084345. +-3898860 = -1588492 band -3372515. +-1062147 = -1588492 bor -3372515. +2836713 = -1588492 bxor -3372515. +-99613694 = -73804654 band -97505693. +-71696653 = -73804654 bor -97505693. +27917041 = -73804654 bxor -97505693. +-131593728 = -130540960 band -30627047. +-29574279 = -130540960 bor -30627047. +102019449 = -130540960 bxor -30627047. +40633758 = 58501086 band -85111361. +-67244033 = 58501086 bor -85111361. +-107877791 = 58501086 bxor -85111361. +5266564 = 91520140 band 13885397. +100138973 = 91520140 bor 13885397. +94872409 = 91520140 bxor 13885397. +-64814390 = -64527382 band -30210341. +-29923333 = -64527382 bor -30210341. +34891057 = -64527382 bxor -30210341. +3310672 = 3331448 band 92251217. +92271993 = 3331448 bor 92251217. +88961321 = 3331448 bxor 92251217. +50402486 = 51369142 band -78563913. +-77597257 = 51369142 bor -78563913. +-127999743 = 51369142 bxor -78563913. +38342660 = 41668900 band -28756851. +-25430611 = 41668900 bor -28756851. +-63773271 = 41668900 bxor -28756851. +70780482 = 87852610 band 79263315. +96335443 = 87852610 bor 79263315. +25554961 = 87852610 bxor 79263315. +-132085632 = -63513712 band -73298807. +-4726887 = -63513712 bor -73298807. +127358745 = -63513712 bxor -73298807. +1049742 = 126928014 band -128244561. +-2366289 = 126928014 bor -128244561. +-3416031 = 126928014 bxor -128244561. +33824772 = 39198908 band -99784635. +-94410499 = 39198908 bor -99784635. +-128235271 = 39198908 bxor -99784635. +26744970 = 131636122 band -104899381. +-8229 = 131636122 bor -104899381. +-26753199 = 131636122 bxor -104899381. +75497600 = 79858856 band -6208575. +-1847319 = 79858856 bor -6208575. +-77344919 = 79858856 bxor -6208575. +8704550 = 43308902 band 31783591. +66387943 = 43308902 bor 31783591. +57683393 = 43308902 bxor 31783591. +84232788 = 117951316 band 87907069. +121625597 = 117951316 bor 87907069. +37392809 = 117951316 bxor 87907069. +8651330 = -108592142 band 14457411. +-102786061 = -108592142 bor 14457411. +-111437391 = -108592142 bxor 14457411. +125831360 = 130042048 band 126462457. +130673145 = 130042048 bor 126462457. +4841785 = 130042048 bxor 126462457. +69469470 = 117271870 band -47933537. +-131137 = 117271870 bor -47933537. +-69600607 = 117271870 bxor -47933537. +42016932 = 46215404 band -72225611. +-68027139 = 46215404 bor -72225611. +-110044071 = 46215404 bxor -72225611. +-121303542 = -102817974 band -54194501. +-35708933 = -102817974 bor -54194501. +85594609 = -102817974 bxor -54194501. +33558288 = -100241448 band 65118001. +-68681735 = -100241448 bor 65118001. +-102240023 = -100241448 bxor 65118001. +69452310 = 108520982 band 69983127. +109051799 = 108520982 bor 69983127. +39599489 = 108520982 bxor 69983127. +22982916 = 22983044 band -8389267. +-8389139 = 22983044 bor -8389267. +-31372055 = 22983044 bxor -8389267. +2082 = -133935710 band 113809971. +-20127821 = -133935710 bor 113809971. +-20129903 = -133935710 bxor 113809971. +262496 = -120102416 band 53216105. +-67148807 = -120102416 bor 53216105. +-67411303 = -120102416 bxor 53216105. +73965710 = -16932370 band 90744463. +-153617 = -16932370 bor 90744463. +-74119327 = -16932370 bxor 90744463. +6827268 = 32025884 band 75001125. +100199741 = 32025884 bor 75001125. +93372473 = 32025884 bxor 75001125. +68778 = -131731718 band 106110123. +-25690373 = -131731718 bor 106110123. +-25759151 = -131731718 bxor 106110123. +23148032 = -77496568 band 90683041. +-9961559 = -77496568 bor 90683041. +-33109591 = -77496568 bxor 90683041. +262278 = -128712506 band 52746375. +-76228409 = -128712506 bor 52746375. +-76490687 = -128712506 bxor 52746375. +916 = 1278900 band -72868899. +-71590915 = 1278900 bor -72868899. +-71591831 = 1278900 bxor -72868899. +-127114750 = -117480622 band -127109597. +-117475469 = -117480622 bor -127109597. +9639281 = -117480622 bxor -127109597. +68091904 = 71247648 band -7366439. +-4210695 = 71247648 bor -7366439. +-72302599 = 71247648 bxor -7366439. +17055774 = 25977502 band 50745727. +59667455 = 25977502 bor 50745727. +42611681 = 25977502 bxor 50745727. +-57179900 = -37776052 band -19404395. +-547 = -37776052 bor -19404395. +57179353 = -37776052 bxor -19404395. +18350730 = -111670614 band 121144987. +-8876357 = -111670614 bor 121144987. +-27227087 = -111670614 bxor 121144987. +34769424 = 49723960 band -15037935. +-83399 = 49723960 bor -15037935. +-34852823 = 49723960 bxor -15037935. +-58449546 = -24893578 band -40963721. +-7407753 = -24893578 bor -40963721. +51041793 = -24893578 bxor -40963721. +-66584508 = -59162140 band -66275763. +-58853395 = -59162140 bor -66275763. +7731113 = -59162140 bxor -66275763. +16974850 = -41728766 band 24587795. +-34115821 = -41728766 bor 24587795. +-51090671 = -41728766 bxor 24587795. +91883584 = 91920464 band -42243511. +-42206631 = 91920464 bor -42243511. +-134090215 = 91920464 bxor -42243511. +84183118 = 90484558 band -40069009. +-33767569 = 90484558 bor -40069009. +-117950687 = 90484558 bxor -40069009. +24580 = 116975996 band 17261061. +134212477 = 116975996 bor 17261061. +134187897 = 116975996 bxor 17261061. +16394 = 81818202 band 33836171. +115637979 = 81818202 bor 33836171. +115621585 = 81818202 bxor 33836171. +27328768 = -106356376 band 60889473. +-72795671 = -106356376 bor 60889473. +-100124439 = -106356376 bxor 60889473. +-64945626 = -64792026 band -1497497. +-1343897 = -64792026 bor -1497497. +63601729 = -64792026 bxor -1497497. +41995284 = -89986028 band 113560765. +-18420547 = -89986028 bor 113560765. +-60415831 = -89986028 bxor 113560765. +122864130 = -10816846 band 123191811. +-10489165 = -10816846 bor 123191811. +-133353295 = -10816846 bxor 123191811. +-62638720 = -20138624 band -42567751. +-67655 = -20138624 bor -42567751. +62571065 = -20138624 bxor -42567751. +33555294 = 100763646 band 42629983. +109838335 = 100763646 bor 42629983. +76283041 = 100763646 bxor 42629983. +360484 = 17279404 band -50473355. +-33554435 = 17279404 bor -50473355. +-33914919 = 17279404 bxor -50473355. +33564170 = 48899594 band -83530117. +-68194693 = 48899594 bor -83530117. +-101758863 = 48899594 bxor -83530117. +84026512 = 119256216 band -43883279. +-8653575 = 119256216 bor -43883279. +-92680087 = 119256216 bxor -43883279. +4182 = 17602774 band 74610519. +92209111 = 17602774 bor 74610519. +92204929 = 17602774 bxor 74610519. +19071492 = -110919100 band 94854957. +-35135635 = -110919100 bor 94854957. +-54207127 = -110919100 bxor 94854957. +17899618 = 17919074 band -113430029. +-113410573 = 17919074 bor -113430029. +-131310191 = 17919074 bxor -113430029. +-117424096 = -113738064 band -3686103. +-71 = -113738064 bor -3686103. +117424025 = -113738064 bxor -3686103. +9234446 = 60681390 band 82770511. +134217455 = 60681390 bor 82770511. +124983009 = 60681390 bxor 82770511. +1197252 = 35575260 band 7489253. +41867261 = 35575260 bor 7489253. +40670009 = 35575260 bxor 7489253. +-130014166 = -60807750 band -129307541. +-60101125 = -60807750 bor -129307541. +69913041 = -60807750 bxor -129307541. +8478784 = 28406728 band -24810399. +-4882455 = 28406728 bor -24810399. +-13361239 = 28406728 bxor -24810399. +17358854 = -103095418 band 53077063. +-67377209 = -103095418 bor 53077063. +-84736063 = -103095418 bxor 53077063. +38405140 = 38667380 band 105606557. +105868797 = 38667380 bor 105606557. +67463657 = 38667380 bxor 105606557. +1060866 = -34491886 band 1474019. +-34078733 = -34491886 bor 1474019. +-35139599 = -34491886 bxor 1474019. +67125888 = 75559904 band 74860185. +83294201 = 75559904 bor 74860185. +16168313 = 75559904 bxor 74860185. +18879774 = 53796190 band -39250625. +-4334209 = 53796190 bor -39250625. +-23213983 = 53796190 bxor -39250625. +1122820 = 53571084 band 81507157. +133955421 = 53571084 bor 81507157. +132832601 = 53571084 bxor 81507157. +10567754 = -85102230 band 27510363. +-68159621 = -85102230 bor 27510363. +-78727375 = -85102230 bxor 27510363. +8457936 = -24289544 band 15806417. +-16941063 = -24289544 bor 15806417. +-25398999 = -24289544 bxor 15806417. +29894710 = -1492426 band 30305591. +-1081545 = -1492426 bor 30305591. +-30976255 = -1492426 bxor 30305591. +-133861372 = -105549148 band -100141043. +-71828819 = -105549148 bor -100141043. +62032553 = -105549148 bxor -100141043. +-100499006 = -100219966 band -23943725. +-23664685 = -100219966 bor -23943725. +76834321 = -100219966 bxor -23943725. +50921472 = 120132880 band -79099895. +-9888487 = 120132880 bor -79099895. +-60809959 = 120132880 bxor -79099895. +-100579314 = -25077234 band -78132177. +-2630097 = -25077234 bor -78132177. +97949217 = -25077234 bxor -78132177. +-9432572 = -888260 band -9364539. +-820227 = -888260 bor -9364539. +8612345 = -888260 bxor -9364539. +10225674 = -117634790 band 10419275. +-117441189 = -117634790 bor 10419275. +-127666863 = -117634790 bxor 10419275. +9728 = 26375720 band 105688897. +132054889 = 26375720 bor 105688897. +132045161 = 26375720 bxor 105688897. +22155302 = -112026394 band 64950823. +-69230873 = -112026394 bor 64950823. +-91386175 = -112026394 bxor 64950823. +77646932 = -22229804 band 99876477. +-259 = -22229804 bor 99876477. +-77647191 = -22229804 bxor 99876477. +41282 = 35365234 band 18917827. +54241779 = 35365234 bor 18917827. +54200497 = 35365234 bxor 18917827. +37945408 = -25959872 band 63374713. +-530567 = -25959872 bor 63374713. +-38475975 = -25959872 bxor 63374713. +39453214 = 67003070 band 39460639. +67010495 = 67003070 bor 39460639. +27557281 = 67003070 bxor 39460639. +32804 = 114614892 band 19497013. +134079101 = 114614892 bor 19497013. +134046297 = 114614892 bxor 19497013. +9014282 = 28961994 band 9145915. +29093627 = 28961994 bor 9145915. +20079345 = 28961994 bxor 9145915. +90351632 = -43796136 band 134146737. +-1031 = -43796136 bor 134146737. +-90352663 = -43796136 bxor 134146737. +-124648682 = -118355050 band -90516713. +-84223081 = -118355050 bor -90516713. +40425601 = -118355050 bxor -90516713. +33947652 = -83422460 band 48660717. +-68709395 = -83422460 bor 48660717. +-102657047 = -83422460 bxor 48660717. +-106231518 = -71611614 band -34633293. +-13389 = -71611614 bor -34633293. +106218129 = -71611614 bxor -34633293. +-64742816 = -26977424 band -46711063. +-8945671 = -26977424 bor -46711063. +55797145 = -26977424 bxor -46711063. +80086542 = 115799918 band -53539313. +-17825937 = 115799918 bor -53539313. +-97912479 = 115799918 bxor -53539313. +761988 = -116670820 band 112976037. +-4456771 = -116670820 bor 112976037. +-5218759 = -116670820 bxor 112976037. +531498 = 17767546 band -25658325. +-8422277 = 17767546 bor -25658325. +-8953775 = 17767546 bxor -25658325. +52699136 = 56895624 band 120513057. +124709545 = 56895624 bor 120513057. +72010409 = 56895624 bxor 120513057. +67141638 = -27097530 band 83931143. +-10308025 = -27097530 bor 83931143. +-77449663 = -27097530 bxor 83931143. +22430996 = 56050996 band -42565795. +-8945795 = 56050996 bor -42565795. +-31376791 = 56050996 bxor -42565795. +69222530 = 87081170 band 82724259. +100582899 = 87081170 bor 82724259. +31360369 = 87081170 bxor 82724259. +10518528 = 29196448 band 111195225. +129873145 = 29196448 bor 111195225. +119354617 = 29196448 bxor 111195225. +-99346402 = -13232098 band -90859265. +-4744961 = -13232098 bor -90859265. +94601441 = -13232098 bxor -90859265. +-125172732 = -91617588 band -123781867. +-90226723 = -91617588 bor -123781867. +34946009 = -91617588 bxor -123781867. +19169290 = 61315114 band -113981925. +-71836101 = 61315114 bor -113981925. +-91005391 = 61315114 bxor -113981925. +8552848 = 62309304 band -54291055. +-534599 = 62309304 bor -54291055. +-9087447 = 62309304 bxor -54291055. +97454326 = 100601078 band -3168009. +-21257 = 100601078 bor -3168009. +-97475583 = 100601078 bxor -3168009. +82862404 = 116417380 band 100334029. +133889005 = 116417380 bor 100334029. +51026601 = 116417380 bxor 100334029. +92471426 = 92734082 band -3416685. +-3154029 = 92734082 bor -3416685. +-95625455 = 92734082 bxor -3416685. +-100515392 = -100511280 band -20290103. +-20285991 = -100511280 bor -20290103. +80229401 = -100511280 bxor -20290103. +17073358 = -106511154 band 21807087. +-101777425 = -106511154 bor 21807087. +-118850783 = -106511154 bxor 21807087. +33722500 = 33733372 band -83192443. +-83181571 = 33733372 bor -83192443. +-116904071 = 33733372 bxor -83192443. +5131274 = 116285402 band 21982219. +133136347 = 116285402 bor 21982219. +128005073 = 116285402 bxor 21982219. +-115081216 = -46232856 band -110885631. +-42037271 = -46232856 bor -110885631. +73043945 = -46232856 bxor -110885631. +8560038 = -119365722 band 92716519. +-35209241 = -119365722 bor 92716519. +-43769279 = -119365722 bxor 92716519. +8413204 = -1741420 band 9105469. +-1049155 = -1741420 bor 9105469. +-9462359 = -1741420 bxor 9105469. +8458242 = -58126286 band 32985475. +-33599053 = -58126286 bor 32985475. +-42057295 = -58126286 bxor 32985475. +70337280 = -9056512 band 70996793. +-8396999 = -9056512 bor 70996793. +-78734279 = -9056512 bxor 70996793. +68386910 = 129236350 band -61635873. +-786433 = 129236350 bor -61635873. +-69173343 = 129236350 bxor -61635873. +-119486172 = -118957268 band -34280971. +-33752067 = -118957268 bor -34280971. +85734105 = -118957268 bxor -34280971. +-117022326 = -116493430 band -115905029. +-115376133 = -116493430 bor -115905029. +1646193 = -116493430 bxor -115905029. +85340176 = -39944680 band 91697265. +-33587591 = -39944680 bor 91697265. +-118927767 = -39944680 bxor 91697265. +-60805546 = -51888554 band -26939689. +-18022697 = -51888554 bor -26939689. +42782849 = -51888554 bxor -26939689. +615044 = 50947012 band 83714733. +134046701 = 50947012 bor 83714733. +133431657 = 50947012 bxor 83714733. +8495458 = 46262754 band -123756173. +-85988877 = 46262754 bor -123756173. +-94484335 = 46262754 bxor -123756173. +18511904 = 18544688 band 87719081. +87751865 = 18544688 bor 87719081. +69239961 = 18544688 bxor 87719081. +-58146802 = -6766034 band -53943857. +-2563089 = -6766034 bor -53943857. +55583713 = -6766034 bxor -53943857. +-117104060 = -76585124 band -48940443. +-8421507 = -76585124 bor -48940443. +108682553 = -76585124 bxor -48940443. +9618218 = -118303942 band 77319147. +-50603013 = -118303942 bor 77319147. +-60221231 = -118303942 bxor 77319147. +18879808 = 20553032 band 19142625. +20815849 = 20553032 bor 19142625. +1936041 = 20553032 bxor 19142625. +2631942 = 78309638 band 6896583. +82574279 = 78309638 bor 6896583. +79942337 = 78309638 bxor 6896583. +-18267884 = -1096204 band -18263779. +-1092099 = -1096204 bor -18263779. +17175785 = -1096204 bxor -18263779. +-131035902 = -109277294 band -88879773. +-67121165 = -109277294 bor -88879773. +63914737 = -109277294 bxor -88879773. +75808768 = 78957920 band -3218919. +-69767 = 78957920 bor -3218919. +-75878535 = 78957920 bxor -3218919. +-134213474 = -61861154 band -108274497. +-35922177 = -61861154 bor -108274497. +98291297 = -61861154 bxor -108274497. +-125827452 = -125214836 band -1931563. +-1318947 = -125214836 bor -1931563. +124508505 = -125214836 bxor -1931563. +132298 = 105283306 band -106199589. +-1048581 = 105283306 bor -106199589. +-1180879 = 105283306 bxor -106199589. +1091664 = 53667960 band 72465233. +125041529 = 53667960 bor 72465233. +123949865 = 53667960 bxor 72465233. +-16743242 = -8020042 band -11361097. +-2637897 = -8020042 bor -11361097. +14105345 = -8020042 bxor -11361097. +10489860 = 15340580 band -39470195. +-34619475 = 15340580 bor -39470195. +-45109335 = 15340580 bxor -39470195. +-121634494 = -87817918 band -119351981. +-85535405 = -87817918 bor -119351981. +36099089 = -87817918 bxor -119351981. +8782464 = 113659536 band 29328265. +134205337 = 113659536 bor 29328265. +125422873 = 113659536 bxor 29328265. +-49257586 = -40570994 band -12880977. +-4194385 = -40570994 bor -12880977. +45063201 = -40570994 bxor -12880977. +25281284 = 32097212 band -107753659. +-100937731 = 32097212 bor -107753659. +-126219015 = 32097212 bxor -107753659. +22286986 = 24409754 band -2778165. +-655397 = 24409754 bor -2778165. +-22942383 = 24409754 bxor -2778165. +-64677248 = -43163736 band -22603071. +-1089559 = -43163736 bor -22603071. +63587689 = -43163736 bxor -22603071. +-125820890 = -107781530 band -56612441. +-38573081 = -107781530 bor -56612441. +87247809 = -107781530 bxor -56612441. +557140 = -83046828 band 71934461. +-11669507 = -83046828 bor 71934461. +-12226647 = -83046828 bxor 71934461. +-117229502 = -110936334 band -40126141. +-33832973 = -110936334 bor -40126141. +83396529 = -110936334 bxor -40126141. +-124624704 = -91063360 band -124559111. +-90997767 = -91063360 bor -124559111. +33626937 = -91063360 bxor -124559111. +2228254 = 132274238 band 3581599. +133627583 = 132274238 bor 3581599. +131399329 = 132274238 bxor 3581599. +-134212700 = -66874388 band -115338315. +-48000003 = -66874388 bor -115338315. +86212697 = -66874388 bxor -115338315. +2164746 = -72893878 band 6884795. +-68173829 = -72893878 bor 6884795. +-70338575 = -72893878 bxor 6884795. +8913424 = -125041960 band 126563889. +-7391495 = -125041960 bor 126563889. +-16304919 = -125041960 bxor 126563889. +58720278 = -72404714 band 126929559. +-4195433 = -72404714 bor 126929559. +-62915711 = -72404714 bxor 126929559. +-131595260 = -30772092 band -106167187. +-5344019 = -30772092 bor -106167187. +126251241 = -30772092 bxor -106167187. +346146 = 15026338 band -49448653. +-34768461 = 15026338 bor -49448653. +-35114607 = 15026338 bxor -49448653. +1069152 = -98806544 band 26311273. +-73564423 = -98806544 bor 26311273. +-74633575 = -98806544 bxor 26311273. +68174990 = 74665198 band 77362575. +83852783 = 74665198 bor 77362575. +15677793 = 74665198 bxor 77362575. +-133672956 = -32911332 band -113355739. +-12594115 = -32911332 bor -113355739. +121078841 = -32911332 bxor -113355739. +104876458 = 113986042 band 108321707. +117431291 = 113986042 bor 108321707. +12554833 = 113986042 bxor 108321707. +-98500608 = -68038136 band -31126111. +-663639 = -68038136 bor -31126111. +97836969 = -68038136 bxor -31126111. +-115342458 = -76280890 band -48003193. +-8941625 = -76280890 bor -48003193. +106400833 = -76280890 bxor -48003193. +4326036 = 81135284 band -127671587. +-50862339 = 81135284 bor -127671587. +-55188375 = 81135284 bxor -127671587. +84218882 = 93658706 band 86447395. +95887219 = 93658706 bor 86447395. +11668337 = 93658706 bxor 86447395. +51712 = 103209504 band -104804391. +-1646599 = 103209504 bor -104804391. +-1698311 = 103209504 bxor -104804391. +4374558 = 21155230 band -95690625. +-78909953 = 21155230 bor -95690625. +-83284511 = 21155230 bxor -95690625. +6623236 = 32471116 band 6656149. +32504029 = 32471116 bor 6656149. +25880793 = 32471116 bxor 6656149. +76023178 = 92939690 band -20445797. +-3529285 = 92939690 bor -20445797. +-79552463 = 92939690 bxor -20445797. +-113147632 = -37630664 band -111435503. +-35918535 = -37630664 bor -111435503. +77229097 = -37630664 bxor -111435503. +-132882314 = -79891850 band -132685705. +-79695241 = -79891850 bor -132685705. +53187073 = -79891850 bxor -132685705. +71304260 = 73565412 band -20431539. +-18170387 = 73565412 bor -20431539. +-89474647 = 73565412 bxor -20431539. +68517890 = 75350018 band -40399597. +-33567469 = 75350018 bor -40399597. +-102085359 = 75350018 bxor -40399597. +69206336 = 104139600 band -35102391. +-169127 = 104139600 bor -35102391. +-69375463 = 104139600 bxor -35102391. +246350 = 17553998 band 82044783. +99352431 = 17553998 bor 82044783. +99106081 = 17553998 bxor 82044783. +4491268 = 73895036 band 13420805. +82824573 = 73895036 bor 13420805. +78333305 = 73895036 bxor 13420805. +54593802 = -78688934 band 133270411. +-12325 = -78688934 bor 133270411. +-54606127 = -78688934 bxor 133270411. +47509504 = 48165992 band 131461249. +132117737 = 48165992 bor 131461249. +84608233 = 48165992 bxor 131461249. +2114854 = -98245338 band 15422823. +-84937369 = -98245338 bor 15422823. +-87052223 = -98245338 bxor 15422823. +-52428012 = -52236524 band -17820739. +-17629251 = -52236524 bor -17820739. +34798761 = -52236524 bxor -17820739. +55058690 = 57290162 band 130932995. +133164467 = 57290162 bor 130932995. +78105777 = 57290162 bxor 130932995. +-125228928 = -125179776 band -91279687. +-91230535 = -125179776 bor -91279687. +33998393 = -125179776 bxor -91279687. +-113180066 = -79072514 band -37516705. +-3409153 = -79072514 bor -37516705. +109770913 = -79072514 bxor -37516705. +6294564 = 82119852 band -127206027. +-51380739 = 82119852 bor -127206027. +-57675303 = 82119852 bxor -127206027. +4210954 = -62537462 band 37776763. +-28971653 = -62537462 bor 37776763. +-33182607 = -62537462 bxor 37776763. +-18332784 = -18069608 band -328719. +-65543 = -18069608 bor -328719. +18267241 = -18069608 bxor -328719. +67527254 = 67560406 band -35756457. +-35723305 = 67560406 bor -35756457. +-103250559 = 67560406 bxor -35756457. +-131972092 = -114670268 band -21862867. +-4561043 = -114670268 bor -21862867. +127411049 = -114670268 bxor -21862867. +14745698 = 15034210 band -17231629. +-16943117 = 15034210 bor -17231629. +-31688815 = 15034210 bxor -17231629. +36188192 = 36204976 band -67356631. +-67339847 = 36204976 bor -67356631. +-103528039 = 36204976 bxor -67356631. +67141902 = -63531090 band 67750223. +-62922769 = -63531090 bor 67750223. +-130064671 = -63531090 bxor 67750223. +9578692 = 94042332 band 16199141. +100662781 = 94042332 bor 16199141. +91084089 = 94042332 bxor 16199141. +-46104534 = -44531526 band -3953813. +-2380805 = -44531526 bor -3953813. +43723729 = -44531526 bxor -3953813. +71352896 = 72140488 band -933023. +-145431 = 72140488 bor -933023. +-71498327 = 72140488 bxor -933023. +7176710 = 25030278 band 49255239. +67108807 = 25030278 bor 49255239. +59932097 = 25030278 bxor 49255239. +109184020 = -20215948 band 128332957. +-1067011 = -20215948 bor 128332957. +-110251031 = -20215948 bxor 128332957. +527362 = 70937874 band -133686045. +-63275533 = 70937874 bor -133686045. +-63802895 = 70937874 bxor -133686045. +-32365440 = -19683616 band -29983335. +-17301511 = -19683616 bor -29983335. +15063929 = -19683616 bxor -29983335. +75759646 = 80627806 band -57301953. +-52433793 = 80627806 bor -57301953. +-128193439 = 80627806 bxor -57301953. +-77049852 = -75738868 band -1549739. +-238755 = -75738868 bor -1549739. +76811097 = -75738868 bxor -1549739. +67241034 = 70421610 band 71976283. +75156859 = 70421610 bor 71976283. +7915825 = 70421610 bxor 71976283. +69288144 = 69431800 band -39762223. +-39618567 = 69431800 bor -39762223. +-108906711 = 69431800 bxor -39762223. +29688886 = 132449590 band 31317047. +134077751 = 132449590 bor 31317047. +104388865 = 132449590 bxor 31317047. +100676868 = -31869532 band 119701261. +-12845139 = -31869532 bor 119701261. +-113522007 = -31869532 bxor 119701261. +18875586 = -42713406 band 27919571. +-33669421 = -42713406 bor 27919571. +-52545007 = -42713406 bxor 27919571. +17074176 = 17729552 band -50004215. +-49348839 = 17729552 bor -50004215. +-66423015 = 17729552 bxor -50004215. +33685774 = -87325426 band 33954607. +-87056593 = -87325426 bor 33954607. +-120742367 = -87325426 bxor 33954607. +104071172 = -29616836 band 108364485. +-25323523 = -29616836 bor 108364485. +-129394695 = -29616836 bxor 108364485. +86122506 = 121562138 band 90389323. +125828955 = 121562138 bor 90389323. +39706449 = 121562138 bxor 90389323. +101711872 = -28096216 band 112232001. +-17576087 = -28096216 bor 112232001. +-119287959 = -28096216 bxor 112232001. +-134217434 = -111728666 band -98025177. +-75536409 = -111728666 bor -98025177. +58681025 = -111728666 bxor -98025177. +36062548 = 36163540 band -29473411. +-29372419 = 36163540 bor -29473411. +-65434967 = 36163540 bxor -29473411. +72206402 = 90037362 band 72206531. +90037491 = 90037362 bor 72206531. +17831089 = 90037362 bxor 72206531. +34346048 = 35394880 band 65977465. +67026297 = 35394880 bor 65977465. +32680249 = 35394880 bxor 65977465. +11013150 = -123122242 band 79310367. +-54825025 = -123122242 bor 79310367. +-65838175 = -123122242 bxor 79310367. +328996 = -129153684 band 26584885. +-102897795 = -129153684 bor 26584885. +-103226791 = -129153684 bxor 26584885. +-133659382 = -39286838 band -94532293. +-159749 = -39286838 bor -94532293. +133499633 = -39286838 bxor -94532293. +393232 = 25119832 band 8815025. +33541625 = 25119832 bor 8815025. +33148393 = 25119832 bxor 8815025. +868886 = 78599830 band -116538857. +-38807913 = 78599830 bor -116538857. +-39676799 = 78599830 bxor -116538857. +12617220 = 13161988 band 30443501. +30988269 = 13161988 bor 30443501. +18371049 = 13161988 bxor 30443501. +147490 = -41794014 band 35809459. +-6132045 = -41794014 bor 35809459. +-6279535 = -41794014 bxor 35809459. +3802208 = 33508976 band -29706775. +-7 = 33508976 bor -29706775. +-3802215 = 33508976 bxor -29706775. +-125796338 = -39673234 band -86975217. +-852113 = -39673234 bor -86975217. +124944225 = -39673234 bxor -86975217. +14860676 = 115532188 band -100677723. +-6211 = 115532188 bor -100677723. +-14866887 = 115532188 bxor -100677723. +-62377174 = -10848390 band -62375125. +-10846341 = -10848390 bor -62375125. +51530833 = -10848390 bxor -62375125. +-133547776 = -83199096 band -129353439. +-79004759 = -83199096 bor -129353439. +54543017 = -83199096 bxor -129353439. +25694470 = 92836166 band -108175609. +-41033913 = 92836166 bor -108175609. +-66728383 = 92836166 bxor -108175609. +-100646892 = -91240396 band -93305251. +-83898755 = -91240396 bor -93305251. +16748137 = -91240396 bxor -93305251. +286850 = 2915282 band 118940835. +121569267 = 2915282 bor 118940835. +121282417 = 2915282 bxor 118940835. +107684608 = 125514656 band 116386649. +134216697 = 125514656 bor 116386649. +26532089 = 125514656 bxor 116386649. +2097950 = -38632674 band 2697215. +-38033409 = -38632674 bor 2697215. +-40131359 = -38632674 bxor 2697215. +2809860 = -101717556 band 69919765. +-34607651 = -101717556 bor 69919765. +-37417511 = -101717556 bxor 69919765. +82968842 = 83866410 band 99763483. +100661051 = 83866410 bor 99763483. +17692209 = 83866410 bxor 99763483. +33719440 = 119002808 band 48409745. +133693113 = 119002808 bor 48409745. +99973673 = 119002808 bxor 48409745. +69474294 = 71161846 band 73799671. +75487223 = 71161846 bor 73799671. +6012929 = 71161846 bxor 73799671. +4489284 = -87054748 band 74744013. +-16800019 = -87054748 bor 74744013. +-21289303 = -87054748 bxor 74744013. +4340866 = 6782338 band -119915373. +-117473901 = 6782338 bor -119915373. +-121814767 = 6782338 bxor -119915373. +1066176 = 1230032 band -120234807. +-120070951 = 1230032 bor -120234807. +-121137127 = 1230032 bxor -120234807. +134862 = 26472398 band 107089647. +133427183 = 26472398 bor 107089647. +133292321 = 26472398 bxor 107089647. +351364 = 69688828 band 5110917. +74448381 = 69688828 bor 5110917. +74097017 = 69688828 bxor 5110917. +141834 = -134006054 band 65710859. +-68437029 = -134006054 bor 65710859. +-68578863 = -134006054 bxor 65710859. +8543232 = 9068008 band -50930687. +-50405911 = 9068008 bor -50930687. +-58949143 = 9068008 bxor -50930687. +141478 = 99232422 band 1502439. +100593383 = 99232422 bor 1502439. +100451905 = 99232422 bxor 1502439. +126890004 = 127627412 band -772291. +-34883 = 127627412 bor -772291. +-126924887 = 127627412 bxor -772291. +14303234 = -100775118 band 115044483. +-33869 = -100775118 bor 115044483. +-14337103 = -100775118 bxor 115044483. +512 = 590336 band -26080711. +-25490887 = 590336 bor -26080711. +-25491399 = 590336 bxor -26080711. +79724638 = 113371262 band 81433055. +115079679 = 113371262 bor 81433055. +35355041 = 113371262 bxor 81433055. +-94367708 = -84132308 band -94367499. +-84132099 = -84132308 bor -94367499. +10235609 = -84132308 bxor -94367499. +8391818 = 42995338 band 75525371. +110128891 = 42995338 bor 75525371. +101737073 = 42995338 bxor 75525371. +327952 = 17109272 band -85080207. +-68298887 = 17109272 bor -85080207. +-68626839 = 17109272 bxor -85080207. +4753750 = -60257962 band 14605783. +-50405929 = -60257962 bor 14605783. +-55159679 = -60257962 bxor 14605783. +12984452 = 29763268 band 13003181. +29781997 = 29763268 bor 13003181. +16797545 = 29763268 bxor 13003181. +4816994 = 24896738 band -95846285. +-75766541 = 24896738 bor -95846285. +-80583535 = 24896738 bxor -95846285. +33612576 = 39906096 band 34403241. +40696761 = 39906096 bor 34403241. +7084185 = 39906096 bxor 34403241. +-130998258 = -8950482 band -122572593. +-524817 = -8950482 bor -122572593. +130473441 = -8950482 bxor -122572593. +33554500 = 111250012 band -99081883. +-21386371 = 111250012 bor -99081883. +-54940871 = 111250012 bxor -99081883. +125831722 = -7262662 band 130190059. +-2904325 = -7262662 bor 130190059. +-128736047 = -7262662 bxor 130190059. +15360064 = 15396936 band -118591775. +-118554903 = 15396936 bor -118591775. +-133914967 = 15396936 bxor -118591775. +1105926 = 106165254 band -121836857. +-16777529 = 106165254 bor -121836857. +-17883455 = 106165254 bxor -121836857. +75630612 = 81971444 band -25028579. +-18687747 = 81971444 bor -25028579. +-94318359 = 81971444 bxor -25028579. +67323906 = 69946002 band 101936227. +104558323 = 69946002 bor 101936227. +37234417 = 69946002 bxor 101936227. +-124977152 = -119701408 band -38987495. +-33711751 = -119701408 bor -38987495. +91265401 = -119701408 bxor -38987495. +8808862 = 45055454 band 80112575. +116359167 = 45055454 bor 80112575. +107550305 = 45055454 bxor 80112575. +34078852 = 34226828 band 49098197. +49246173 = 34226828 bor 49098197. +15167321 = 34226828 bxor 49098197. +-92274486 = -89024022 band -8387365. +-5136901 = -89024022 bor -8387365. +87137585 = -89024022 bxor -8387365. +39768656 = 123665272 band -85994927. +-2098311 = 123665272 bor -85994927. +-41866967 = 123665272 bxor -85994927. +117441206 = -16291146 band 124785591. +-8946761 = -16291146 bor 124785591. +-126387967 = -16291146 bxor 124785591. +71582212 = 121919268 band 75383437. +125720493 = 121919268 bor 75383437. +54138281 = 121919268 bxor 75383437. +13378 = -132678590 band 115881043. +-16810925 = -132678590 bor 115881043. +-16824303 = -132678590 bxor 115881043. +-134135680 = -66993776 band -82216311. +-15074407 = -66993776 bor -82216311. +119061273 = -66993776 bxor -82216311. +2425486 = -64677234 band 28820143. +-38282577 = -64677234 bor 28820143. +-40708063 = -64677234 bxor 28820143. +9732 = -85367108 band 68564549. +-16812291 = -85367108 bor 68564549. +-16822023 = -85367108 bxor 68564549. +4477066 = 6050202 band -12068149. +-10495013 = 6050202 bor -12068149. +-14972079 = 6050202 bxor -12068149. +-130011008 = -96193880 band -60231231. +-26414103 = -96193880 bor -60231231. +103596905 = -96193880 bxor -60231231. diff --git a/erts/emulator/test/big_SUITE_data/eq_32.dat b/erts/emulator/test/big_SUITE_data/eq_32.dat new file mode 100644 index 0000000000..e7118ccdde --- /dev/null +++ b/erts/emulator/test/big_SUITE_data/eq_32.dat @@ -0,0 +1,3000 @@ +1082131525 = 1621645175 band 1154714701. +1694228351 = 1621645175 bor 1154714701. +612096826 = 1621645175 bxor 1154714701. +46178305 = 599847955 band 182034505. +735704155 = 599847955 bor 182034505. +689525850 = 599847955 bxor 182034505. +-1055868923 = -507724177 band -988612603. +-440467857 = -507724177 bor -988612603. +615401066 = -507724177 bxor -988612603. +-1962933631 = -1358900597 band -1949298815. +-1345265781 = -1358900597 bor -1949298815. +617667850 = -1358900597 bxor -1949298815. +1093140517 = 1730677863 band 1106059965. +1743597311 = 1730677863 bor 1106059965. +650456794 = 1730677863 bxor 1106059965. +9308161 = 715065347 band 30289337. +736046523 = 715065347 bor 30289337. +726738362 = 715065347 bxor 30289337. +-905961387 = -369090209 band -837096331. +-300225153 = -369090209 bor -837096331. +605736234 = -369090209 bxor -837096331. +-2111156111 = -1422953349 band -2110072079. +-1421869317 = -1422953349 bor -2110072079. +689286794 = -1422953349 bxor -2110072079. +1141904645 = 1681317207 band 1318139181. +1857551743 = 1681317207 bor 1318139181. +715647098 = 1681317207 bxor 1318139181. +73463585 = 669120499 band 209254185. +804911099 = 669120499 bor 209254185. +731447514 = 669120499 bxor 209254185. +-1073741755 = -535158705 band -973021979. +-434438929 = -535158705 bor -973021979. +639302826 = -535158705 bxor -973021979. +-2147327391 = -1576897941 band -1922604447. +-1352174997 = -1576897941 bor -1922604447. +795152394 = -1576897941 bxor -1922604447. +1079165445 = 1741933127 band 1079427997. +1742195679 = 1741933127 bor 1079427997. +663030234 = 1741933127 bxor 1079427997. +6340737 = 746111971 band 48299161. +788070395 = 746111971 bor 48299161. +781729658 = 746111971 bxor 48299161. +-1003910891 = -454444225 band -834942635. +-285475969 = -454444225 bor -834942635. +718434922 = -454444225 bxor -834942635. +-2096593839 = -1555510181 band -1891850799. +-1350767141 = -1555510181 bor -1891850799. +745826698 = -1555510181 bxor -1891850799. +1083490821 = 1874711351 band 1083493901. +1874714431 = 1874711351 bor 1083493901. +791223610 = 1874711351 bxor 1083493901. +10753 = 588409811 band 214777353. +803176411 = 588409811 bor 214777353. +803165658 = 588409811 bxor 214777353. +-1006587899 = -284298705 band -1006456379. +-284167185 = -284298705 bor -1006456379. +722420714 = -284298705 bxor -1006456379. +-2147385279 = -1601076661 band -2124307135. +-1577998517 = -1601076661 bor -2124307135. +569386762 = -1601076661 bxor -2124307135. +1147293733 = 1735653415 band 1281512573. +1869872255 = 1735653415 bor 1281512573. +722578522 = 1735653415 bxor 1281512573. +305985 = 538832835 band 29670265. +568197115 = 538832835 bor 29670265. +567891130 = 538832835 bxor 29670265. +-1069251563 = -354040545 band -1068722635. +-353511617 = -354040545 bor -1068722635. +715739946 = -354040545 bxor -1068722635. +-2060910543 = -1389652933 band -2059575119. +-1388317509 = -1389652933 bor -2059575119. +672593034 = -1389652933 bxor -2059575119. +1075056645 = 1748318487 band 1150703341. +1823965183 = 1748318487 bor 1150703341. +748908538 = 1748318487 bxor 1150703341. +17450145 = 566906803 band 151942377. +701399035 = 566906803 bor 151942377. +683948890 = 566906803 bxor 151942377. +-1030736891 = -359648241 band -942639451. +-271550801 = -359648241 bor -942639451. +759186090 = -359648241 bxor -942639451. +-2111438815 = -1373240789 band -2080974815. +-1342776789 = -1373240789 bor -2080974815. +768662026 = -1373240789 bxor -2080974815. +1224774661 = 1761646087 band 1304941917. +1841813343 = 1761646087 bor 1304941917. +617038682 = 1761646087 bxor 1304941917. +2561 = 537299875 band 162622041. +699919355 = 537299875 bor 162622041. +699916794 = 537299875 bxor 162622041. +-1056697835 = -437502209 band -888843499. +-269647873 = -437502209 bor -888843499. +787049962 = -437502209 bxor -888843499. +-1975187439 = -1437610981 band -1904931951. +-1367355493 = -1437610981 bor -1904931951. +607831946 = -1437610981 bxor -1904931951. +1074073285 = 1855262455 band 1078841293. +1860030463 = 1855262455 bor 1078841293. +785957178 = 1855262455 bxor 1078841293. +134251393 = 746693523 band 175414217. +787856347 = 746693523 bor 175414217. +653604954 = 746693523 bxor 175414217. +-1040178811 = -359078417 band -970839163. +-289738769 = -359078417 bor -970839163. +750440042 = -359078417 bxor -970839163. +-2011762175 = -1439174133 band -1923155199. +-1350567157 = -1439174133 bor -1923155199. +661195018 = -1439174133 bxor -1923155199. +1211171365 = 1802609639 band 1212106301. +1803544575 = 1802609639 bor 1212106301. +592373210 = 1802609639 bxor 1212106301. +9044225 = 581605251 band 31394105. +603955131 = 581605251 bor 31394105. +594910906 = 581605251 bxor 31394105. +-1055577899 = -336254753 band -1054998539. +-335675393 = -336254753 bor -1054998539. +719902506 = -336254753 bxor -1054998539. +-2146885007 = -1473416197 band -2128894351. +-1455425541 = -1473416197 bor -2128894351. +691459466 = -1473416197 bxor -2128894351. +1162940549 = 1876251863 band 1165179053. +1878490367 = 1876251863 bor 1165179053. +715549818 = 1876251863 bxor 1165179053. +103817761 = 665872243 band 104313513. +666367995 = 665872243 bor 104313513. +562550234 = 665872243 bxor 104313513. +-1021312955 = -484440113 band -810561435. +-273688593 = -484440113 bor -810561435. +747624362 = -484440113 bxor -810561435. +-2146303519 = -1606462997 band -2116940319. +-1577099797 = -1606462997 bor -2116940319. +569203722 = -1606462997 bxor -2116940319. +1233133829 = 1774133703 band 1266722589. +1807722463 = 1774133703 bor 1266722589. +574588634 = 1774133703 bxor 1266722589. +142610433 = 713167715 band 226859033. +797416315 = 713167715 bor 226859033. +654805882 = 713167715 bxor 226859033. +-1068990315 = -285703489 band -1051812651. +-268525825 = -285703489 bor -1051812651. +800464490 = -285703489 bxor -1051812651. +-2144861871 = -1606644773 band -1888931503. +-1350714405 = -1606644773 bor -1888931503. +794147466 = -1606644773 bxor -1888931503. +1085145221 = 1693321911 band 1103008141. +1711184831 = 1693321911 bor 1103008141. +626039610 = 1693321911 bxor 1103008141. +26122497 = 600742739 band 227522953. +802143195 = 600742739 bor 227522953. +776020698 = 600742739 bxor 227522953. +-1072627451 = -467822161 band -1053727419. +-448922129 = -467822161 bor -1053727419. +623705322 = -467822161 bxor -1053727419. +-2122317631 = -1481367093 band -2121789247. +-1480838709 = -1481367093 bor -2121789247. +641478922 = -1481367093 bxor -2121789247. +1111558053 = 1793134503 band 1128527869. +1810104319 = 1793134503 bor 1128527869. +698546266 = 1793134503 bxor 1128527869. +33822273 = 637861699 band 199038713. +803078139 = 637861699 bor 199038713. +769255866 = 637861699 bxor 199038713. +-1001518955 = -319927137 band -967890507. +-286298689 = -319927137 bor -967890507. +715220266 = -319927137 bxor -967890507. +-2020278223 = -1477110853 band -2020234191. +-1477066821 = -1477110853 bor -2020234191. +543211402 = -1477110853 bxor -2020234191. +1120342021 = 1658269847 band 1323817581. +1861745407 = 1658269847 bor 1323817581. +741403386 = 1658269847 bxor 1323817581. +219426849 = 760495923 band 229945449. +771014523 = 760495923 bor 229945449. +551587674 = 760495923 bxor 229945449. +-1056404987 = -376857713 band -1017189851. +-337642577 = -376857713 bor -1017189851. +718762410 = -376857713 bxor -1017189851. +-2146958943 = -1542561365 band -2001140831. +-1396743253 = -1542561365 bor -2001140831. +750215690 = -1542561365 bxor -2001140831. +1094789253 = 1640983943 band 1195456733. +1741651423 = 1640983943 bor 1195456733. +646862170 = 1640983943 bxor 1195456733. +134807809 = 799759139 band 136152537. +801103867 = 799759139 bor 136152537. +666296058 = 799759139 bxor 136152537. +-960068075 = -271677825 band -958945643. +-270555393 = -271677825 bor -958945643. +689512682 = -271677825 bxor -958945643. +-2134310127 = -1597043813 band -2082924783. +-1545658469 = -1597043813 bor -2082924783. +588651658 = -1597043813 bxor -2082924783. +1115685445 = 1787348599 band 1118245709. +1789908863 = 1787348599 bor 1118245709. +674223418 = 1787348599 bxor 1118245709. +211292929 = 750342931 band 266245961. +805295963 = 750342931 bor 266245961. +594003034 = 750342931 bxor 266245961. +-900723451 = -346288785 band -890216699. +-335782033 = -346288785 bor -890216699. +564941418 = -346288785 bxor -890216699. +-2071723903 = -1530523253 band -1885542783. +-1344342133 = -1530523253 bor -1885542783. +727381770 = -1530523253 bxor -1885542783. +1224747301 = 1837251431 band 1261463997. +1873968127 = 1837251431 bor 1261463997. +649220826 = 1837251431 bxor 1261463997. +158082049 = 770516739 band 159311033. +771745723 = 770516739 bor 159311033. +613663674 = 770516739 bxor 159311033. +-981462955 = -309252001 band -979365003. +-307154049 = -309252001 bor -979365003. +674308906 = -309252001 bxor -979365003. +-2008911503 = -1472040069 band -1972669967. +-1435798533 = -1472040069 bor -1972669967. +573112970 = -1472040069 bxor -1972669967. +1219496965 = 1761266775 band 1320434733. +1862204543 = 1761266775 bor 1320434733. +642707578 = 1761266775 bxor 1320434733. +4539937 = 645256947 band 155545129. +796262139 = 645256947 bor 155545129. +791722202 = 645256947 bxor 155545129. +-930299067 = -309530801 band -929184795. +-308416529 = -309530801 bor -929184795. +621882538 = -309530801 bxor -929184795. +-2143080095 = -1521274517 band -1972651679. +-1350846101 = -1521274517 bor -1972651679. +792233994 = -1521274517 bxor -1972651679. +1220610053 = 1760655687 band 1321831069. +1861876703 = 1760655687 bor 1321831069. +641266650 = 1760655687 bxor 1321831069. +50340481 = 591553251 band 54080409. +595293179 = 591553251 bor 54080409. +544952698 = 591553251 bxor 54080409. +-1071628267 = -399619521 band -1050644395. +-378635649 = -399619521 bor -1050644395. +692992618 = -399619521 bxor -1050644395. +-2054944687 = -1480111269 band -1920680751. +-1345847333 = -1480111269 bor -1920680751. +709097354 = -1480111269 bxor -1920680751. +1074085893 = 1730495031 band 1086805261. +1743214399 = 1730495031 bor 1086805261. +669128506 = 1730495031 bxor 1086805261. +184614913 = 721537747 band 186725641. +723648475 = 721537747 bor 186725641. +539033562 = 721537747 bxor 186725641. +-1072431099 = -535543505 band -920708923. +-383821329 = -535543505 bor -920708923. +688609770 = -535543505 bxor -920708923. +-1995620287 = -1389510325 band -1990362047. +-1384252085 = -1389510325 bor -1990362047. +611368202 = -1389510325 bxor -1990362047. +1224999717 = 1796548391 band 1304730493. +1876279167 = 1796548391 bor 1304730493. +651279450 = 1796548391 bxor 1304730493. +67109441 = 774049475 band 75788921. +782728955 = 774049475 bor 75788921. +715619514 = 774049475 bxor 75788921. +-997157867 = -308423649 band -992953035. +-304218817 = -308423649 bor -992953035. +692939050 = -308423649 bxor -992953035. +-2141940943 = -1529507013 band -1956841551. +-1344407621 = -1529507013 bor -1956841551. +797533322 = -1529507013 bxor -1956841551. +1107298309 = 1778395159 band 1117281773. +1788378623 = 1778395159 bor 1117281773. +681080314 = 1778395159 bxor 1117281773. +42019489 = 651505331 band 44690409. +654176251 = 651505331 bor 44690409. +612156762 = 651505331 bxor 44690409. +-1004011259 = -286653681 band -986948187. +-269590609 = -286653681 bor -986948187. +734420650 = -286653681 bxor -986948187. +-2004352735 = -1345470165 band -2002112735. +-1343230165 = -1345470165 bor -2002112735. +661122570 = -1345470165 bxor -2002112735. +1187054597 = 1726301447 band 1339661405. +1878908255 = 1726301447 bor 1339661405. +691853658 = 1726301447 bxor 1339661405. +134225921 = 688335523 band 144220505. +698330107 = 688335523 bor 144220505. +564104186 = 688335523 bxor 144220505. +-964638699 = -405287425 band -962004459. +-402653185 = -405287425 bor -962004459. +561985514 = -405287425 bxor -962004459. +-2145123823 = -1595585765 band -1909710191. +-1360172133 = -1595585765 bor -1909710191. +784951690 = -1595585765 bxor -1909710191. +1082348741 = 1652784631 band 1239373517. +1809809407 = 1652784631 bor 1239373517. +727460666 = 1652784631 bxor 1239373517. +641 = 577241747 band 152539849. +729780955 = 577241747 bor 152539849. +729780314 = 577241747 bxor 152539849. +-1073475451 = -502909713 band -1048735099. +-478169361 = -502909713 bor -1048735099. +595306090 = -502909713 bxor -1048735099. +-2138501119 = -1398066933 band -2138451455. +-1398017269 = -1398066933 bor -2138451455. +740483850 = -1398066933 bxor -2138451455. +1212186661 = 1801048807 band 1220578621. +1809440767 = 1801048807 bor 1220578621. +597254106 = 1801048807 bxor 1220578621. +35946497 = 711374467 band 112050233. +787478203 = 711374467 bor 112050233. +751531706 = 711374467 bxor 112050233. +-931125547 = -321636385 band -912185611. +-302696449 = -321636385 bor -912185611. +628429098 = -321636385 bxor -912185611. +-2010501007 = -1452379397 band -1943388815. +-1385267205 = -1452379397 bor -1943388815. +625233802 = -1452379397 bxor -1943388815. +1208222597 = 1839678423 band 1213480877. +1844936703 = 1839678423 bor 1213480877. +636714106 = 1839678423 bxor 1213480877. +35782689 = 573720179 band 60959145. +598896635 = 573720179 bor 60959145. +563113946 = 573720179 bxor 60959145. +-868182459 = -312420657 band -825575579. +-269813777 = -312420657 bor -825575579. +598368682 = -312420657 bxor -825575579. +-2060189471 = -1354886933 band -2060163871. +-1354861333 = -1354886933 bor -2060163871. +705328138 = -1354886933 bxor -2060163871. +1075855365 = 1667944647 band 1211199005. +1803288287 = 1667944647 bor 1211199005. +727432922 = 1667944647 bxor 1211199005. +12157441 = 616149603 band 33279769. +637271931 = 616149603 bor 33279769. +625114490 = 616149603 bxor 33279769. +-872349291 = -292875841 band -864992299. +-285518849 = -292875841 bor -864992299. +586830442 = -292875841 bxor -864992299. +-2021062575 = -1477899557 band -2020652975. +-1477489957 = -1477899557 bor -2020652975. +543572618 = -1477899557 bxor -2020652975. +1076041861 = 1684240823 band 1269766285. +1877965247 = 1684240823 bor 1269766285. +801923386 = 1684240823 bxor 1269766285. +42053633 = 648804947 band 58830985. +665582299 = 648804947 bor 58830985. +623528666 = 648804947 bxor 58830985. +-1061042171 = -521017169 band -909390779. +-369365777 = -521017169 bor -909390779. +691676394 = -521017169 bxor -909390779. +-2032115519 = -1359060789 band -2032015423. +-1358960693 = -1359060789 bor -2032015423. +673154826 = -1359060789 bxor -2032015423. +1073757861 = 1712340647 band 1239695101. +1878277887 = 1712340647 bor 1239695101. +804520026 = 1712340647 bxor 1239695101. +3673153 = 645406275 band 163237369. +804970491 = 645406275 bor 163237369. +801297338 = 645406275 bxor 163237369. +-925871979 = -353084513 band -909029195. +-336241729 = -353084513 bor -909029195. +589630250 = -353084513 bxor -909029195. +-2139028943 = -1580395845 band -1902951631. +-1344318533 = -1580395845 bor -1902951631. +794710410 = -1580395845 bxor -1902951631. +1235222789 = 1806704535 band 1302847853. +1874329599 = 1806704535 bor 1302847853. +639106810 = 1806704535 bxor 1302847853. +72091169 = 743251507 band 99493737. +770654075 = 743251507 bor 99493737. +698562906 = 743251507 bxor 99493737. +-936361979 = -391026033 band -885468891. +-340132945 = -391026033 bor -885468891. +596229034 = -391026033 bxor -885468891. +-2126511967 = -1352392533 band -2117444959. +-1343325525 = -1352392533 bor -2117444959. +783186442 = -1352392533 bxor -2117444959. +1140857989 = 1715608711 band 1167130589. +1741881311 = 1715608711 bor 1167130589. +601023322 = 1715608711 bxor 1167130589. +134264833 = 706345507 band 153271513. +725352187 = 706345507 bor 153271513. +591087354 = 706345507 bxor 153271513. +-938998507 = -335014529 band -931574379. +-327590401 = -335014529 bor -931574379. +611408106 = -335014529 bxor -931574379. +-2013132271 = -1466791269 band -1955713519. +-1409372517 = -1466791269 bor -1955713519. +603759754 = -1466791269 bxor -1955713519. +1082396741 = 1686451575 band 1140234829. +1744289663 = 1686451575 bor 1140234829. +661892922 = 1686451575 bxor 1140234829. +885249 = 730706451 band 69176905. +798998107 = 730706451 bor 69176905. +798112858 = 730706451 bxor 69176905. +-998161403 = -325624721 band -943077883. +-270541201 = -325624721 bor -943077883. +727620202 = -325624721 bxor -943077883. +-1910173567 = -1343795061 band -1910129279. +-1343750773 = -1343795061 bor -1910129279. +566422794 = -1343795061 bxor -1910129279. +1122508837 = 1660447335 band 1324331197. +1862269695 = 1660447335 bor 1324331197. +739760858 = 1660447335 bxor 1324331197. +100860417 = 639059459 band 124492729. +662691771 = 639059459 bor 124492729. +561831354 = 639059459 bxor 124492729. +-1021298091 = -406962337 band -887014795. +-272679041 = -406962337 bor -887014795. +748619050 = -406962337 bxor -887014795. +-2146434959 = -1447988613 band -2074605327. +-1376158981 = -1447988613 bor -2074605327. +770275978 = -1447988613 bxor -2074605327. +1079116549 = 1809496919 band 1079198509. +1809578879 = 1809496919 bor 1079198509. +730462330 = 1809496919 bxor 1079198509. +4564257 = 686142963 band 55436585. +737015291 = 686142963 bor 55436585. +732451034 = 686142963 bxor 55436585. +-1072518587 = -526664113 band -1070159131. +-524304657 = -526664113 bor -1070159131. +548213930 = -526664113 bxor -1070159131. +-2144595871 = -1409290133 band -2144595871. +-1409290133 = -1409290133 bor -2144595871. +735305738 = -1409290133 bxor -2144595871. +1160249349 = 1730881607 band 1169707421. +1740339679 = 1730881607 bor 1169707421. +580090330 = 1730881607 bxor 1169707421. +80216193 = 753402339 band 130902681. +804088827 = 753402339 bor 130902681. +723872634 = 753402339 bxor 130902681. +-1073737451 = -535897793 band -1065281707. +-527442049 = -535897793 bor -1065281707. +546295402 = -535897793 bxor -1065281707. +-1971273135 = -1365128613 band -1953967151. +-1347822629 = -1365128613 bor -1953967151. +623450506 = -1365128613 bxor -1953967151. +1075875845 = 1789440311 band 1081465869. +1795030335 = 1789440311 bor 1081465869. +719154490 = 1789440311 bxor 1081465869. +75573249 = 617425363 band 78720009. +620572123 = 617425363 bor 78720009. +544998874 = 617425363 bxor 78720009. +-1070198779 = -457797585 band -1053327419. +-440926225 = -457797585 bor -1053327419. +629272554 = -457797585 bxor -1053327419. +-2013003711 = -1423572917 band -2011868351. +-1422437557 = -1423572917 bor -2011868351. +590566154 = -1423572917 bxor -2011868351. +1099055653 = 1775392295 band 1168302717. +1844639359 = 1775392295 bor 1168302717. +745583706 = 1775392295 bxor 1168302717. +151005505 = 755248579 band 159394169. +763637243 = 755248579 bor 159394169. +612631738 = 755248579 bxor 159394169. +-1034887147 = -487464161 band -1018108875. +-470685889 = -487464161 bor -1018108875. +564201258 = -487464161 bxor -1018108875. +-1944550863 = -1394896325 band -1892118863. +-1342464325 = -1394896325 bor -1892118863. +602086538 = -1394896325 bxor -1892118863. +1141244933 = 1709643543 band 1310090477. +1878489087 = 1709643543 bor 1310090477. +737244154 = 1709643543 bxor 1310090477. +25165985 = 733744563 band 92365545. +800944123 = 733744563 bor 92365545. +775778138 = 733744563 bxor 92365545. +-1065074683 = -455093745 band -1014741851. +-404760913 = -455093745 bor -1014741851. +660313770 = -455093745 bxor -1014741851. +-2146336735 = -1596882901 band -2112256479. +-1562802645 = -1596882901 bor -2112256479. +583534090 = -1596882901 bxor -2112256479. +1147494405 = 1843786759 band 1181180765. +1877473119 = 1843786759 bor 1181180765. +729978714 = 1843786759 bxor 1181180765. +10733569 = 551799203 band 129751129. +670816763 = 551799203 bor 129751129. +660083194 = 551799203 bxor 129751129. +-901251051 = -362849025 band -901209835. +-362807809 = -362849025 bor -901209835. +538443242 = -362849025 bxor -901209835. +-2120873967 = -1512650213 band -1986053743. +-1377829989 = -1512650213 bor -1986053743. +743043978 = -1512650213 bxor -1986053743. +1317850309 = 1854794999 band 1324146125. +1861090815 = 1854794999 bor 1324146125. +543240506 = 1854794999 bxor 1324146125. +102891905 = 640311699 band 251038153. +788457947 = 640311699 bor 251038153. +685566042 = 640311699 bxor 251038153. +-922451579 = -384859153 band -875234939. +-337642513 = -384859153 bor -875234939. +584809066 = -384859153 bxor -875234939. +-2073026559 = -1401262069 band -2039437055. +-1367672565 = -1401262069 bor -2039437055. +705353994 = -1401262069 bxor -2039437055. +1109131301 = 1650328039 band 1270731837. +1811928575 = 1650328039 bor 1270731837. +702797274 = 1650328039 bxor 1270731837. +146298113 = 788452739 band 163084089. +805238715 = 788452739 bor 163084089. +658940602 = 788452739 bxor 163084089. +-939506475 = -330348833 band -937406987. +-328249345 = -330348833 bor -937406987. +611257130 = -330348833 bxor -937406987. +-2147463055 = -1492422149 band -2131438479. +-1476397573 = -1492422149 bor -2131438479. +671065482 = -1492422149 bxor -2131438479. +1083245189 = 1637167831 band 1152468653. +1706391295 = 1637167831 bor 1152468653. +623146106 = 1637167831 bxor 1152468653. +8225 = 680535411 band 105423017. +785950203 = 680535411 bor 105423017. +785941978 = 680535411 bxor 105423017. +-1071545275 = -448944689 band -891183515. +-268582929 = -448944689 bor -891183515. +802962346 = -448944689 bxor -891183515. +-1995404319 = -1449603093 band -1991066655. +-1445265429 = -1449603093 bor -1991066655. +550138890 = -1449603093 bxor -1991066655. +1074935045 = 1647476679 band 1163801885. +1736343519 = 1647476679 bor 1163801885. +661408474 = 1647476679 bxor 1163801885. +9175041 = 701321571 band 44959257. +737105787 = 701321571 bor 44959257. +727930746 = 701321571 bxor 44959257. +-896950123 = -356933441 band -879760683. +-339744001 = -356933441 bor -879760683. +557206122 = -356933441 bxor -879760683. +-2123298479 = -1443788325 band -2022613167. +-1343103013 = -1443788325 bor -2022613167. +780195466 = -1443788325 bxor -2022613167. +1158711429 = 1744103607 band 1293655949. +1879048127 = 1744103607 bor 1293655949. +720336698 = 1744103607 bxor 1293655949. +2425089 = 593844563 band 212838281. +804257755 = 593844563 bor 212838281. +801832666 = 593844563 bxor 212838281. +-916311291 = -379439185 band -849202363. +-312330257 = -379439185 bor -849202363. +603981034 = -379439185 bxor -849202363. +-1968922943 = -1348165685 band -1963475263. +-1342718005 = -1348165685 bor -1963475263. +626204938 = -1348165685 bxor -1963475263. +1140852133 = 1683713447 band 1325434365. +1868295679 = 1683713447 bor 1325434365. +727443546 = 1683713447 bxor 1325434365. +29623361 = 801586499 band 30704889. +802668027 = 801586499 bor 30704889. +773044666 = 801586499 bxor 30704889. +-1022991723 = -476681569 band -816875595. +-270565441 = -476681569 bor -816875595. +752426282 = -476681569 bxor -816875595. +-2147479503 = -1543433797 band -1957897679. +-1353851973 = -1543433797 bor -1957897679. +793627530 = -1543433797 bxor -1957897679. +1084295173 = 1722093207 band 1105455213. +1743253247 = 1722093207 bor 1105455213. +658958074 = 1722093207 bxor 1105455213. +52534305 = 589430067 band 258186857. +795082619 = 589430067 bor 258186857. +742548314 = 589430067 bxor 258186857. +-1073465339 = -512411249 band -871450587. +-310396497 = -512411249 bor -871450587. +763068842 = -512411249 bxor -871450587. +-2112515679 = -1575624789 band -2020101727. +-1483210837 = -1575624789 bor -2020101727. +629304842 = -1575624789 bxor -2020101727. +1079034501 = 1808845703 band 1079822045. +1809633247 = 1808845703 bor 1079822045. +730598746 = 1808845703 bxor 1079822045. +39883009 = 728013091 band 40104921. +728235003 = 728013091 bor 40104921. +688351994 = 728013091 bxor 40104921. +-1072389099 = -522345345 band -904465259. +-354421505 = -522345345 bor -904465259. +717967594 = -522345345 bxor -904465259. +-2035154671 = -1498281573 band -2034285295. +-1497412197 = -1498281573 bor -2034285295. +537742474 = -1498281573 bxor -2034285295. +1216356421 = 1855825015 band 1220682061. +1860150655 = 1855825015 bor 1220682061. +643794234 = 1855825015 bxor 1220682061. +1835265 = 540938515 band 127698249. +666801499 = 540938515 bor 127698249. +664966234 = 540938515 bxor 127698249. +-1056036603 = -445731985 band -878760699. +-268456081 = -445731985 bor -878760699. +787580522 = -445731985 bxor -878760699. +-2141158271 = -1604022389 band -2023058303. +-1485922421 = -1604022389 bor -2023058303. +655235850 = -1604022389 bxor -2023058303. +1158320421 = 1737136487 band 1294661565. +1873477631 = 1737136487 bor 1294661565. +715157210 = 1737136487 bxor 1294661565. +51658753 = 589128963 band 194269881. +731740091 = 589128963 bor 194269881. +680081338 = 589128963 bxor 194269881. +-930725803 = -393785761 band -828481163. +-291541121 = -393785761 bor -828481163. +639184682 = -393785761 bxor -828481163. +-2147479183 = -1350798981 band -2147442703. +-1350762501 = -1350798981 bor -2147442703. +796716682 = -1350798981 bxor -2147442703. +1078331909 = 1826007639 band 1131301421. +1878977151 = 1826007639 bor 1131301421. +800645242 = 1826007639 bxor 1131301421. +168825889 = 791778547 band 177364009. +800316667 = 791778547 bor 177364009. +631490778 = 791778547 bxor 177364009. +-935165627 = -381252273 band -859074075. +-305160721 = -381252273 bor -859074075. +630004906 = -381252273 bxor -859074075. +-2046285983 = -1509380245 band -1901566111. +-1364660373 = -1509380245 bor -1901566111. +681625610 = -1509380245 bxor -1901566111. +1073745925 = 1652610887 band 1159927965. +1738792927 = 1652610887 bor 1159927965. +665047002 = 1652610887 bxor 1159927965. +630913 = 694788323 band 10330521. +704487931 = 694788323 bor 10330521. +703857018 = 694788323 bxor 10330521. +-930535403 = -326408129 band -878854571. +-274727297 = -326408129 bor -878854571. +655808106 = -326408129 bxor -878854571. +-2125969327 = -1478997669 band -1991709999. +-1344738341 = -1478997669 bor -1991709999. +781230986 = -1478997669 bxor -1991709999. +1241522181 = 1783111735 band 1335911181. +1877500735 = 1783111735 bor 1335911181. +635978554 = 1783111735 bxor 1335911181. +7602177 = 544508115 band 159195913. +696101851 = 544508115 bor 159195913. +688499674 = 544508115 bxor 159195913. +-868170235 = -319496401 band -867440955. +-318767121 = -319496401 bor -867440955. +549403114 = -319496401 bxor -867440955. +-2012730815 = -1434828981 band -1920390591. +-1342488757 = -1434828981 bor -1920390591. +670242058 = -1434828981 bxor -1920390591. +1135149349 = 1672185127 band 1140664701. +1677700479 = 1672185127 bor 1140664701. +542551130 = 1672185127 bxor 1140664701. +8470593 = 750865603 band 12050553. +754445563 = 750865603 bor 12050553. +745974970 = 750865603 bxor 12050553. +-893320683 = -354291169 band -875754699. +-336725185 = -354291169 bor -875754699. +556595498 = -354291169 bxor -875754699. +-2146434767 = -1522691781 band -2133842511. +-1510099525 = -1522691781 bor -2133842511. +636335242 = -1522691781 bxor -2133842511. +1124073989 = 1810499095 band 1192258541. +1878683647 = 1810499095 bor 1192258541. +754609658 = 1810499095 bxor 1192258541. +1362081 = 545189043 band 26532329. +570359291 = 545189043 bor 26532329. +568997210 = 545189043 bxor 26532329. +-1068490491 = -328097521 band -1026020443. +-285627473 = -328097521 bor -1026020443. +782863018 = -328097521 bxor -1026020443. +-2147476191 = -1590608085 band -2142970591. +-1586102485 = -1590608085 bor -2142970591. +561373706 = -1590608085 bxor -2142970591. +1073750533 = 1845666567 band 1097935453. +1869851487 = 1845666567 bor 1097935453. +796100954 = 1845666567 bxor 1097935453. +119015425 = 664561827 band 119213913. +664760315 = 664561827 bor 119213913. +545744890 = 664561827 bxor 119213913. +-981448683 = -310187009 band -974895083. +-303633409 = -310187009 bor -974895083. +677815274 = -310187009 bxor -974895083. +-2147205103 = -1457239781 band -2133962607. +-1443997285 = -1457239781 bor -2133962607. +703207818 = -1457239781 bxor -2133962607. +1110720709 = 1655987191 band 1333159117. +1878425599 = 1655987191 bor 1333159117. +767704890 = 1655987191 bxor 1333159117. +67141761 = 667467923 band 202473673. +802799835 = 667467923 bor 202473673. +735658074 = 667467923 bxor 202473673. +-987742075 = -273362193 band -987209595. +-272829713 = -273362193 bor -987209595. +714912362 = -273362193 bxor -987209595. +-1996390399 = -1448759541 band -1894547455. +-1346916597 = -1448759541 bor -1894547455. +649473802 = -1448759541 bxor -1894547455. +1077284901 = 1618882791 band 1094130493. +1635728383 = 1618882791 bor 1094130493. +558443482 = 1618882791 bxor 1094130493. +7480321 = 544404611 band 184495673. +721419963 = 544404611 bor 184495673. +713939642 = 544404611 bxor 184495673. +-939371307 = -362392097 band -862227211. +-285248001 = -362392097 bor -862227211. +654123306 = -362392097 bxor -862227211. +-2130681743 = -1593544453 band -1887736975. +-1350599685 = -1593544453 bor -1887736975. +780082058 = -1593544453 bxor -1887736975. +1250558341 = 1805590999 band 1250577837. +1805610495 = 1805590999 bor 1250577837. +555052154 = 1805590999 bxor 1250577837. +168428577 = 717882483 band 237705129. +787159035 = 717882483 bor 237705129. +618730458 = 717882483 bxor 237705129. +-1028389819 = -357141297 band -1007385243. +-336136721 = -357141297 bor -1007385243. +692253098 = -357141297 bxor -1007385243. +-1911749919 = -1353740565 band -1909648671. +-1351639317 = -1353740565 bor -1909648671. +560110602 = -1353740565 bxor -1909648671. +1107700741 = 1712729799 band 1124531229. +1729560287 = 1712729799 bor 1124531229. +621859546 = 1712729799 bxor 1124531229. +161230849 = 700248163 band 261897497. +800914811 = 700248163 bor 261897497. +639683962 = 700248163 bxor 261897497. +-1031798379 = -477876289 band -827682347. +-273760257 = -477876289 bor -827682347. +758038122 = -477876289 bxor -827682347. +-2046427055 = -1504311077 band -1894812079. +-1352696101 = -1504311077 bor -1894812079. +693730954 = -1504311077 bxor -1894812079. +1174406789 = 1872910263 band 1174677133. +1873180607 = 1872910263 bor 1174677133. +698773818 = 1872910263 bxor 1174677133. +152606721 = 704297043 band 152673929. +704364251 = 704297043 bor 152673929. +551757530 = 704297043 bxor 152673929. +-916159995 = -311523665 band -873162171. +-268525841 = -311523665 bor -873162171. +647634154 = -311523665 bxor -873162171. +-1988062015 = -1448681781 band -1916168767. +-1376788533 = -1448681781 bor -1916168767. +611273482 = -1448681781 bxor -1916168767. +1082166437 = 1707252903 band 1117310205. +1742396671 = 1707252903 bor 1117310205. +660230234 = 1707252903 bxor 1117310205. +2234433 = 569531459 band 69876729. +637173755 = 569531459 bor 69876729. +634939322 = 569531459 bxor 69876729. +-960489323 = -422282849 band -959865163. +-421658689 = -422282849 bor -959865163. +538830634 = -422282849 bxor -959865163. +-1937764303 = -1366224709 band -1916636879. +-1345097285 = -1366224709 bor -1916636879. +592667018 = -1366224709 bxor -1916636879. +1133636869 = 1672871319 band 1268510573. +1807745023 = 1672871319 bor 1268510573. +674108154 = 1672871319 bxor 1268510573. +1053729 = 567467059 band 169153897. +735567227 = 567467059 bor 169153897. +734513498 = 567467059 bxor 169153897. +-1044379643 = -472577905 band -975134939. +-403333201 = -472577905 bor -975134939. +641046442 = -472577905 bxor -975134939. +-2011101023 = -1406951765 band -1977546591. +-1373397333 = -1406951765 bor -1977546591. +637703690 = -1406951765 bxor -1977546591. +1109395589 = 1652259463 band 1201966557. +1744830431 = 1652259463 bor 1201966557. +635434842 = 1652259463 bxor 1201966557. +58796033 = 596326435 band 65088217. +602618619 = 596326435 bor 65088217. +543822586 = 596326435 bxor 65088217. +-905964779 = -296799361 band -877618283. +-268452865 = -296799361 bor -877618283. +637511914 = -296799361 bxor -877618283. +-2129917935 = -1423079269 band -2050204655. +-1343365989 = -1423079269 bor -2050204655. +786551946 = -1423079269 bxor -2050204655. +1073741893 = 1758598007 band 1091151949. +1776008063 = 1758598007 bor 1091151949. +702266170 = 1758598007 bxor 1091151949. +171995137 = 717910035 band 173374537. +719289435 = 717910035 bor 173374537. +547294298 = 717910035 bxor 173374537. +-1000304635 = -438175121 band -965700603. +-403571089 = -438175121 bor -965700603. +596733546 = -438175121 bxor -965700603. +-2111223167 = -1505898869 band -1955894399. +-1350570101 = -1505898869 bor -1955894399. +760653066 = -1505898869 bxor -1955894399. +1092618277 = 1798883431 band 1172455101. +1878720255 = 1798883431 bor 1172455101. +786101978 = 1798883431 bxor 1172455101. +83427329 = 620725251 band 100207033. +637504955 = 620725251 bor 100207033. +554077626 = 620725251 bxor 100207033. +-1073477547 = -269722273 band -1072199563. +-268444289 = -269722273 bor -1072199563. +805033258 = -269722273 bxor -1072199563. +-1994313615 = -1448906629 band -1922746639. +-1377339653 = -1448906629 bor -1922746639. +616973962 = -1448906629 bxor -1922746639. +1208226053 = 1810798935 band 1208308013. +1810880895 = 1810798935 bor 1208308013. +602654842 = 1810798935 bxor 1208308013. +152064801 = 693728243 band 252891945. +794555387 = 693728243 bor 252891945. +642490586 = 693728243 bxor 252891945. +-972269499 = -410166193 band -832800539. +-270697233 = -410166193 bor -832800539. +701572266 = -410166193 bxor -832800539. +-2124403103 = -1553109397 band -2048868767. +-1477575061 = -1553109397 bor -2048868767. +646828042 = -1553109397 bxor -2048868767. +1207993861 = 1794278983 band 1292492701. +1878777823 = 1794278983 bor 1292492701. +670783962 = 1794278983 bxor 1292492701. +142678145 = 684146659 band 229234841. +770703355 = 684146659 bor 229234841. +628025210 = 684146659 bxor 229234841. +-1063099115 = -308021441 band -1028233899. +-273156225 = -308021441 bor -1028233899. +789942890 = -308021441 bxor -1028233899. +-2109734831 = -1553282981 band -2033909295. +-1477457445 = -1553282981 bor -2033909295. +632277386 = -1553282981 bxor -2033909295. +1174571525 = 1711509303 band 1313270285. +1850208063 = 1711509303 bor 1313270285. +675636538 = 1711509303 bxor 1313270285. +159711745 = 771221459 band 159717897. +771227611 = 771221459 bor 159717897. +611515866 = 771221459 bxor 159717897. +-934540283 = -389075409 band -899920443. +-354455569 = -389075409 bor -899920443. +580084714 = -389075409 bxor -899920443. +-1993867199 = -1423278517 band -1984364223. +-1413775541 = -1423278517 bor -1984364223. +580091658 = -1423278517 bxor -1984364223. +1216360485 = 1755362343 band 1221816445. +1760818303 = 1755362343 bor 1221816445. +544457818 = 1755362343 bxor 1221816445. +134873921 = 760900547 band 170628985. +796655611 = 760900547 bor 170628985. +661781690 = 760900547 bxor 170628985. +-1002176491 = -445775585 band -834325963. +-277925057 = -445775585 bor -834325963. +724251434 = -445775585 bxor -834325963. +-2145152975 = -1376022469 band -2145141583. +-1376011077 = -1376022469 bor -2145141583. +769141898 = -1376022469 bxor -2145141583. +1275097093 = 1812526359 band 1300656877. +1838086143 = 1812526359 bor 1300656877. +562989050 = 1812526359 bxor 1300656877. +67387553 = 622709683 band 115626217. +670948347 = 622709683 bor 115626217. +603560794 = 622709683 bxor 115626217. +-1056436219 = -442535921 band -1020783963. +-406883665 = -442535921 bor -1020783963. +649552554 = -442535921 bxor -1020783963. +-2144586719 = -1595081173 band -2094255071. +-1544749525 = -1595081173 bor -2094255071. +599837194 = -1595081173 bxor -2094255071. +1077039109 = 1731940871 band 1089925469. +1744827231 = 1731940871 bor 1089925469. +667788122 = 1731940871 bxor 1089925469. +70256129 = 758187939 band 112608857. +800540667 = 758187939 bor 112608857. +730284538 = 758187939 bxor 112608857. +-1052612075 = -515736833 band -914624747. +-377749505 = -515736833 bor -914624747. +674862570 = -515736833 bxor -914624747. +-2104934383 = -1429354469 band -2085001327. +-1409421413 = -1429354469 bor -2085001327. +695512970 = -1429354469 bxor -2085001327. +1249036997 = 1861667575 band 1266412493. +1879043071 = 1861667575 bor 1266412493. +630006074 = 1861667575 bxor 1266412493. +4200321 = 658710419 band 6846409. +661356507 = 658710419 bor 6846409. +657156186 = 658710419 bxor 6846409. +-982122107 = -436854289 band -847788155. +-302520337 = -436854289 bor -847788155. +679601770 = -436854289 bxor -847788155. +-2145368575 = -1540559349 band -1972218111. +-1367408885 = -1540559349 bor -1972218111. +777959690 = -1540559349 bxor -1972218111. +1093157413 = 1706713063 band 1227645501. +1841201151 = 1706713063 bor 1227645501. +748043738 = 1706713063 bxor 1227645501. +176226561 = 784536451 band 176284985. +784594875 = 784536451 bor 176284985. +608368314 = 784536451 bxor 176284985. +-955252523 = -417766177 band -955081739. +-417595393 = -417766177 bor -955081739. +537657130 = -417766177 bxor -955081739. +-2028469647 = -1487310853 band -2017590671. +-1476431877 = -1487310853 bor -2017590671. +552037770 = -1487310853 bxor -2017590671. +1237651589 = 1808077015 band 1239372973. +1809798399 = 1808077015 bor 1239372973. +572146810 = 1808077015 bxor 1239372973. +139035169 = 685761395 band 189370025. +736096251 = 685761395 bor 189370025. +597061082 = 685761395 bxor 189370025. +-939311035 = -305445937 band -905745307. +-271880209 = -305445937 bor -905745307. +667430826 = -305445937 bxor -905745307. +-2143139359 = -1604170261 band -2084345375. +-1545376277 = -1604170261 bor -2084345375. +597763082 = -1604170261 bxor -2084345375. +1090633989 = 1863704007 band 1093387037. +1866457055 = 1863704007 bor 1093387037. +775823066 = 1863704007 bxor 1093387037. +8389633 = 612929379 band 147223577. +751763323 = 612929379 bor 147223577. +743373690 = 612929379 bxor 147223577. +-1061144427 = -387268929 band -977192747. +-303317249 = -387268929 bor -977192747. +757827178 = -387268929 bxor -977192747. +-1946122927 = -1391032357 band -1905685167. +-1350594597 = -1391032357 bor -1905685167. +595528330 = -1391032357 bxor -1905685167. +1114145925 = 1802225335 band 1181265293. +1869344703 = 1802225335 bor 1181265293. +755198778 = 1802225335 bxor 1181265293. +137106689 = 711726931 band 146773385. +721393627 = 711726931 bor 146773385. +584286938 = 711726931 bxor 146773385. +-989724411 = -317270609 band -981270203. +-308816401 = -317270609 bor -981270203. +680908010 = -317270609 bxor -981270203. +-1929048895 = -1392173621 band -1890095935. +-1353220661 = -1392173621 bor -1890095935. +575828234 = -1392173621 bxor -1890095935. +1074070437 = 1782959015 band 1152193533. +1861082111 = 1782959015 bor 1152193533. +787011674 = 1782959015 bxor 1152193533. +12153409 = 754547523 band 12317433. +754711547 = 754547523 bor 12317433. +742558138 = 754547523 bxor 12317433. +-1070694251 = -458323809 band -1069562443. +-457192001 = -458323809 bor -1069562443. +613502250 = -458323809 bxor -1069562443. +-2123102159 = -1585639493 band -2047604687. +-1510142021 = -1585639493 bor -2047604687. +612960138 = -1585639493 bxor -2047604687. +1120068613 = 1659038871 band 1255143021. +1794113279 = 1659038871 bor 1255143021. +674044666 = 1659038871 bxor 1255143021. +165921 = 677362483 band 100830313. +778026875 = 677362483 bor 100830313. +777860954 = 677362483 bxor 100830313. +-931101179 = -271526001 band -928086491. +-268511313 = -271526001 bor -928086491. +662589866 = -271526001 bxor -928086491. +-1996202591 = -1383244373 band -1989779551. +-1376821333 = -1383244373 bor -1989779551. +619381258 = -1383244373 bxor -1989779551. +1245708421 = 1782720903 band 1265128669. +1802141151 = 1782720903 bor 1265128669. +556432730 = 1782720903 bxor 1265128669. +8929537 = 579720995 band 228221401. +799012859 = 579720995 bor 228221401. +790083322 = 579720995 bxor 228221401. +-1002159595 = -463682945 band -851033451. +-312556801 = -463682945 bor -851033451. +689602794 = -463682945 bxor -851033451. +-2147155183 = -1509619813 band -2003471599. +-1365936229 = -1509619813 bor -2003471599. +781218954 = -1509619813 bxor -2003471599. +1073742405 = 1663206007 band 1288515405. +1877979007 = 1663206007 bor 1288515405. +804236602 = 1663206007 bxor 1288515405. +134365953 = 724750099 band 206205769. +796589915 = 724750099 bor 206205769. +662223962 = 724750099 bxor 206205769. +-936294139 = -302954129 band -935462139. +-302122129 = -302954129 bor -935462139. +634172010 = -302954129 bxor -935462139. +-2145386367 = -1586295413 band -1977073023. +-1417982069 = -1586295413 bor -1977073023. +727404298 = -1586295413 bxor -1977073023. +1207993637 = 1845688167 band 1226147261. +1863841791 = 1845688167 bor 1226147261. +655848154 = 1845688167 bxor 1226147261. +43614209 = 733848323 band 110739641. +800973755 = 733848323 bor 110739641. +757359546 = 733848323 bxor 110739641. +-846451627 = -303207329 band -812863627. +-269619329 = -303207329 bor -812863627. +576832298 = -303207329 bxor -812863627. +-2012983951 = -1473876101 band -1937388047. +-1398280197 = -1473876101 bor -1937388047. +614703754 = -1473876101 bxor -1937388047. +1207961605 = 1763870807 band 1310218285. +1866127487 = 1763870807 bor 1310218285. +658165882 = 1763870807 bxor 1310218285. +5063201 = 660427507 band 13584937. +668949243 = 660427507 bor 13584937. +663886042 = 660427507 bxor 13584937. +-1067447483 = -344970417 band -991338523. +-268861457 = -344970417 bor -991338523. +798586026 = -344970417 bxor -991338523. +-2080111263 = -1540477589 band -2049632927. +-1509999253 = -1540477589 bor -2049632927. +570112010 = -1540477589 bxor -2049632927. +1073751045 = 1619014983 band 1298966173. +1844230111 = 1619014983 bor 1298966173. +770479066 = 1619014983 bxor 1298966173. +167775873 = 721477347 band 250744729. +804446203 = 721477347 bor 250744729. +636670330 = 721477347 bxor 250744729. +-1052244971 = -480737729 band -976548779. +-405041537 = -480737729 bor -976548779. +647203434 = -480737729 bxor -976548779. +-2124873647 = -1587984549 band -2080565039. +-1543675941 = -1587984549 bor -2080565039. +581197706 = -1587984549 bxor -2080565039. +1279815685 = 1843068471 band 1281978637. +1845231423 = 1843068471 bor 1281978637. +565415738 = 1843068471 bxor 1281978637. +71368705 = 760694483 band 80285961. +769611739 = 760694483 bor 80285961. +698243034 = 760694483 bxor 80285961. +-935316475 = -398099153 band -882330427. +-345113105 = -398099153 bor -882330427. +590203370 = -398099153 bxor -882330427. +-1943758783 = -1388921525 band -1935353791. +-1380516533 = -1388921525 bor -1935353791. +563242250 = -1388921525 bxor -1935353791. +1075946277 = 1756488487 band 1143322493. +1823864703 = 1756488487 bor 1143322493. +747918426 = 1756488487 bxor 1143322493. +80415297 = 785353411 band 98258553. +803196667 = 785353411 bor 98258553. +722781370 = 785353411 bxor 98258553. +-1030746091 = -493481953 band -893822667. +-356558529 = -493481953 bor -893822667. +674187562 = -493481953 bxor -893822667. +-2062482639 = -1491759301 band -1926016079. +-1355292741 = -1491759301 bor -1926016079. +707189898 = -1491759301 bxor -1926016079. +1077960709 = 1715725335 band 1098414573. +1736179199 = 1715725335 bor 1098414573. +658218490 = 1715725335 bxor 1098414573. +17334945 = 697871027 band 91211753. +771747835 = 697871027 bor 91211753. +754412890 = 697871027 bxor 91211753. +-1067370235 = -529973489 band -999032411. +-461635665 = -529973489 bor -999032411. +605734570 = -529973489 bxor -999032411. +-2147186399 = -1610302165 band -1966109919. +-1429225685 = -1610302165 bor -1966109919. +717960714 = -1610302165 bxor -1966109919. +1083179013 = 1771045127 band 1157150813. +1845016927 = 1771045127 bor 1157150813. +761837914 = 1771045127 bxor 1157150813. +8463361 = 564242083 band 109935961. +665714683 = 564242083 bor 109935961. +657251322 = 564242083 bxor 109935961. +-988938219 = -442627585 band -988834283. +-442523649 = -442627585 bor -988834283. +546414570 = -442627585 bxor -988834283. +-2109716975 = -1428994277 band -2107605359. +-1426882661 = -1428994277 bor -2107605359. +682834314 = -1428994277 bxor -2107605359. +1112879301 = 1666529783 band 1123906253. +1677556735 = 1666529783 bor 1123906253. +564677434 = 1666529783 bxor 1123906253. +10055297 = 614039187 band 201027273. +805011163 = 614039187 bor 201027273. +794955866 = 614039187 bxor 201027273. +-1060953979 = -338464529 band -993841531. +-271352081 = -338464529 bor -993841531. +789601898 = -338464529 bxor -993841531. +-2013254655 = -1408226037 band -2004013567. +-1398984949 = -1408226037 bor -2004013567. +614269706 = -1408226037 bxor -2004013567. +1108379685 = 1645383399 band 1134405949. +1671409663 = 1645383399 bor 1134405949. +563029978 = 1645383399 bxor 1134405949. +138416129 = 703541891 band 138452025. +703577787 = 703541891 bor 138452025. +565161658 = 703541891 bxor 138452025. +-1040170283 = -496471073 band -947535115. +-403835905 = -496471073 bor -947535115. +636334378 = -496471073 bxor -947535115. +-2012739471 = -1442156805 band -1984128655. +-1413545989 = -1442156805 bor -1984128655. +599193482 = -1442156805 bxor -1984128655. +1107319685 = 1644625879 band 1118854061. +1656160255 = 1644625879 bor 1118854061. +548840570 = 1644625879 bxor 1118854061. +8388641 = 584172147 band 228853161. +804636667 = 584172147 bor 228853161. +796248026 = 584172147 bxor 228853161. +-871624123 = -293858609 band -854699163. +-276933649 = -293858609 bor -854699163. +594690474 = -293858609 bxor -854699163. +-2012151583 = -1395585813 band -1978285855. +-1361720085 = -1395585813 bor -1978285855. +650431498 = -1395585813 bxor -1978285855. +1291880453 = 1831963847 band 1338804765. +1878888159 = 1831963847 bor 1338804765. +587007706 = 1831963847 bxor 1338804765. +169880065 = 707800675 band 237808409. +775729019 = 707800675 bor 237808409. +605848954 = 707800675 bxor 237808409. +-1061073515 = -353546817 band -1059856427. +-352329729 = -353546817 bor -1059856427. +708743786 = -353546817 bxor -1059856427. +-2077031343 = -1372387621 band -2055232431. +-1350588709 = -1372387621 bor -2055232431. +726442634 = -1372387621 bxor -2055232431. +1245787269 = 1800484279 band 1313420429. +1868117439 = 1800484279 bor 1313420429. +622330170 = 1800484279 bxor 1313420429. +10552321 = 616134227 band 195136649. +800718555 = 616134227 bor 195136649. +790166234 = 616134227 bxor 195136649. +-938926075 = -396680017 band -905091003. +-362844945 = -396680017 bor -905091003. +576081130 = -396680017 bxor -905091003. +-1985920831 = -1447076661 band -1885256767. +-1346412597 = -1447076661 bor -1885256767. +639508234 = -1447076661 bxor -1885256767. +1092901541 = 1642396327 band 1161648893. +1711143679 = 1642396327 bor 1161648893. +618242138 = 1642396327 bxor 1161648893. +8947777 = 551328323 band 126462457. +668843003 = 551328323 bor 126462457. +659895226 = 551328323 bxor 126462457. +-920615787 = -316368993 band -877531979. +-273285185 = -316368993 bor -877531979. +647330602 = -316368993 bxor -877531979. +-2134831567 = -1396371781 band -2082365647. +-1343905861 = -1396371781 bor -2082365647. +790925706 = -1396371781 bxor -2082365647. +1143724293 = 1680595863 band 1333788013. +1870659583 = 1680595863 bor 1333788013. +726935290 = 1680595863 bxor 1333788013. +34079265 = 650680883 band 53216105. +669817723 = 650680883 bor 53216105. +635738458 = 650680883 bxor 53216105. +-999807995 = -446126449 band -998740699. +-445059153 = -446126449 bor -998740699. +554748842 = -446126449 bxor -998740699. +-2075978591 = -1504502613 band -2056800607. +-1485324629 = -1504502613 bor -2056800607. +590653962 = -1504502613 bxor -2056800607. +1126176901 = 1663359111 band 1269308381. +1806490591 = 1663359111 bor 1269308381. +680313690 = 1663359111 bxor 1269308381. +135008257 = 678196771 band 261069017. +804257531 = 678196771 bor 261069017. +669249274 = 678196771 bxor 261069017. +-1039777515 = -486125185 band -824710763. +-271058433 = -486125185 bor -824710763. +768719082 = -486125185 bxor -824710763. +-2028436975 = -1489467749 band -1894086127. +-1355116901 = -1489467749 bor -1894086127. +673320074 = -1489467749 bxor -1894086127. +1275899973 = 1838084471 band 1275901517. +1838086015 = 1838084471 bor 1275901517. +562186042 = 1838084471 bxor 1275901517. +24324609 = 561458707 band 226191945. +763326043 = 561458707 bor 226191945. +739001434 = 561458707 bxor 226191945. +-1056702459 = -308504465 band -1056480763. +-308282769 = -308504465 bor -1056480763. +748419690 = -308504465 bxor -1056480763. +-2113927039 = -1576776565 band -2086594175. +-1549443701 = -1576776565 bor -2086594175. +564483338 = -1576776565 bxor -2086594175. +1186989093 = 1877550695 band 1187302589. +1877864191 = 1877550695 bor 1187302589. +690875098 = 1877550695 bxor 1187302589. +89539073 = 660062723 band 225867705. +796391355 = 660062723 bor 225867705. +706852282 = 660062723 bxor 225867705. +-1064807851 = -494240929 band -855779723. +-285212801 = -494240929 bor -855779723. +779595050 = -494240929 bxor -855779723. +-1996462991 = -1425707397 band -1922931471. +-1352175877 = -1425707397 bor -1922931471. +644287114 = -1425707397 bxor -1922931471. +1143101189 = 1685223255 band 1168596781. +1710718847 = 1685223255 bor 1168596781. +567617658 = 1685223255 bxor 1168596781. +151322913 = 691876339 band 264749353. +805302779 = 691876339 bor 264749353. +653979866 = 691876339 bxor 264749353. +-1067302331 = -454100401 band -1066252571. +-453050641 = -454100401 bor -1066252571. +614251690 = -454100401 bxor -1066252571. +-2013238175 = -1471484821 band -1903858591. +-1362105237 = -1471484821 bor -1903858591. +651132938 = -1471484821 bxor -1903858591. +1107911685 = 1663689799 band 1179348381. +1735126495 = 1663689799 bor 1179348381. +627214810 = 1663689799 bxor 1179348381. +1459329 = 538344931 band 74860185. +611745787 = 538344931 bor 74860185. +610286458 = 538344931 bxor 74860185. +-997650155 = -307686081 band -992234667. +-302270593 = -307686081 bor -992234667. +695379562 = -307686081 bxor -992234667. +-2136930735 = -1583102373 band -2131677231. +-1577848869 = -1583102373 bor -2131677231. +559081866 = -1583102373 bxor -2131677231. +1074161669 = 1640918327 band 1242036237. +1808792895 = 1640918327 bor 1242036237. +734631226 = 1640918327 bxor 1242036237. +167772161 = 781362643 band 189335561. +802926043 = 781362643 bor 189335561. +635153882 = 781362643 bxor 189335561. +-883881979 = -346567633 band -814670907. +-277356561 = -346567633 bor -814670907. +606525418 = -346567633 bxor -814670907. +-2146653119 = -1600193461 band -2041794751. +-1495335093 = -1600193461 bor -2041794751. +651318026 = -1600193461 bxor -2041794751. +1104351781 = 1675563559 band 1173618301. +1744830079 = 1675563559 bor 1173618301. +640478298 = 1675563559 bxor 1173618301. +16777537 = 555788739 band 63374713. +602385915 = 555788739 bor 63374713. +585608378 = 555788739 bxor 63374713. +-1073217515 = -497410273 band -1054244811. +-478437569 = -497410273 bor -1054244811. +594779946 = -497410273 bxor -1054244811. +-2138404303 = -1601466821 band -2013336911. +-1476399429 = -1601466821 bor -2013336911. +662004874 = -1601466821 bxor -2013336911. +1115848709 = 1788531479 band 1122402541. +1795085311 = 1788531479 bor 1122402541. +679236602 = 1788531479 bxor 1122402541. +220661921 = 770673075 band 221724393. +771735547 = 770673075 bor 221724393. +551073626 = 770673075 bxor 221724393. +-997523451 = -321974769 band -960765787. +-285217105 = -321974769 bor -960765787. +712306346 = -321974769 bxor -960765787. +-2044174303 = -1367835605 band -2026970591. +-1350631893 = -1367835605 bor -2026970591. +693542410 = -1367835605 bxor -2026970591. +1157640197 = 1694543879 band 1299611485. +1836515167 = 1694543879 bor 1299611485. +678874970 = 1694543879 bxor 1299611485. +77595649 = 619595171 band 111195225. +653194747 = 619595171 bor 111195225. +575599098 = 619595171 bxor 111195225. +-929753067 = -359294721 band -929088235. +-358629889 = -359294721 bor -929088235. +571123178 = -359294721 bxor -929088235. +-2013232111 = -1456159205 band -1933339247. +-1376266341 = -1456159205 bor -1933339247. +636965770 = -1456159205 bxor -1933339247. +1170909381 = 1875880183 band 1174075853. +1879046655 = 1875880183 bor 1174075853. +708137274 = 1875880183 bxor 1174075853. +248137089 = 801889683 band 248145353. +801897947 = 801889683 bor 248145353. +553760858 = 801889683 bxor 248145353. +-1056402043 = -515063825 band -888498811. +-347160593 = -515063825 bor -888498811. +709241450 = -515063825 bxor -888498811. +-2126248959 = -1588630517 band -1989933823. +-1452315381 = -1588630517 bor -1989933823. +673933578 = -1588630517 bxor -1989933823. +1082306597 = 1703329255 band 1082847293. +1703869951 = 1703329255 bor 1082847293. +621563354 = 1703329255 bxor 1082847293. +3363073 = 569856387 band 70996793. +637490107 = 569856387 bor 70996793. +634127034 = 569856387 bxor 70996793. +-867139371 = -330071329 band -839587339. +-302519297 = -330071329 bor -839587339. +564620074 = -330071329 bxor -839587339. +-2129190799 = -1458082309 band -2055786383. +-1384677893 = -1458082309 bor -2055786383. +744512906 = -1458082309 bxor -2055786383. +1147429509 = 1852108503 band 1157456557. +1862135551 = 1852108503 bor 1157456557. +714706042 = 1852108503 bxor 1157456557. +1712161 = 681550195 band 87719081. +767557115 = 681550195 bor 87719081. +765844954 = 681550195 bxor 87719081. +-872406971 = -322379313 band -854246811. +-304219153 = -322379313 bor -854246811. +568187818 = -322379313 bxor -854246811. +-2147482655 = -1533293589 band -2128341023. +-1514151957 = -1533293589 bor -2128341023. +633330698 = -1533293589 bxor -2128341023. +1080627461 = 1617509319 band 1323913501. +1860795359 = 1617509319 bor 1323913501. +780167898 = 1617509319 bxor 1323913501. +176340993 = 716426595 band 265216537. +805302139 = 716426595 bor 265216537. +628961146 = 716426595 bxor 265216537. +-914193259 = -376709953 band -807237931. +-269754625 = -376709953 bor -807237931. +644438634 = -376709953 bxor -807237931. +-2147385007 = -1448376869 band -2075018415. +-1376010277 = -1448376869 bor -2075018415. +771374730 = -1448376869 bxor -2075018415. +1291886725 = 1867687095 band 1302707085. +1878507455 = 1867687095 bor 1302707085. +586620730 = 1867687095 bxor 1302707085. +10649857 = 685954387 band 29328265. +704632795 = 685954387 bor 29328265. +693982938 = 685954387 bxor 29328265. +-921484539 = -281316433 band -913060027. +-272891921 = -281316433 bor -913060027. +648592618 = -281316433 bxor -913060027. +-1903879487 = -1344955445 band -1901651263. +-1342727221 = -1344955445 bor -1901651263. +561152266 = -1344955445 bxor -1901651263. +1140859301 = 1822435751 band 1145676285. +1827252735 = 1822435751 bor 1145676285. +686393434 = 1822435751 bxor 1145676285. +143859777 = 765180227 band 143876345. +765196795 = 765180227 bor 143876345. +621337018 = 765180227 bxor 143876345. +-1071644011 = -533289313 band -920644683. +-382289985 = -533289313 bor -920644683. +689354026 = -533289313 bxor -920644683. +-2146892751 = -1603727941 band -2020919759. +-1477754949 = -1603727941 bor -2020919759. +669137802 = -1603727941 bxor -2020919759. +1098907653 = 1737542295 band 1236010093. +1874644735 = 1737542295 bor 1236010093. +775737082 = 1737542295 bxor 1236010093. +16873505 = 755857715 band 26311273. +765295483 = 755857715 bor 26311273. +748421978 = 755857715 bxor 26311273. +-1071885307 = -459508337 band -918662107. +-306285137 = -459508337 bor -918662107. +765600170 = -459508337 bxor -918662107. +-2044458591 = -1502291029 band -1910174303. +-1368006741 = -1502291029 bor -1910174303. +676451850 = -1502291029 bxor -1910174303. +1210286725 = 1831044999 band 1214505693. +1835263967 = 1831044999 bor 1214505693. +624977242 = 1831044999 bxor 1214505693. +16778497 = 623318307 band 163631065. +770170875 = 623318307 bor 163631065. +753392378 = 623318307 bxor 163631065. +-1069449195 = -364126081 band -1067085675. +-361762561 = -364126081 bor -1067085675. +707686634 = -364126081 bxor -1067085675. +-2008547055 = -1362623077 band -1990483695. +-1344559717 = -1362623077 bor -1990483695. +663987338 = -1362623077 bxor -1990483695. +1207967813 = 1746362487 band 1321745741. +1860140415 = 1746362487 bor 1321745741. +652172602 = 1746362487 bxor 1321745741. +226492673 = 764906771 band 233333065. +771747163 = 764906771 bor 233333065. +545254490 = 764906771 bxor 233333065. +-1061109499 = -454826129 band -1060321019. +-454037649 = -454826129 bor -1060321019. +607071850 = -454826129 bxor -1060321019. +-2016313215 = -1477342325 band -2016022399. +-1477051509 = -1477342325 bor -2016022399. +539261706 = -1477342325 bxor -2016022399. +1088426277 = 1626035559 band 1324356541. +1861965823 = 1626035559 bor 1324356541. +773539546 = 1626035559 bxor 1324356541. +42803201 = 667803907 band 177155769. +802156475 = 667803907 bor 177155769. +759353274 = 667803907 bxor 177155769. +-935163819 = -305952161 band -932512395. +-303300737 = -305952161 bor -932512395. +631863082 = -305952161 bxor -932512395. +-2109707919 = -1572835973 band -1879376911. +-1342504965 = -1572835973 bor -1879376911. +767202954 = -1572835973 bxor -1879376911. +1284662789 = 1843291735 band 1320314413. +1878943359 = 1843291735 bor 1320314413. +594280570 = 1843291735 bxor 1320314413. +184029217 = 788074739 band 201078825. +805124347 = 788074739 bor 201078825. +621095130 = 788074739 bxor 201078825. +-1073673915 = -469120689 band -1057542683. +-452989457 = -469120689 bor -1057542683. +620684458 = -469120689 bxor -1057542683. +-1883143327 = -1346131093 band -1879981215. +-1342968981 = -1346131093 bor -1879981215. +540174346 = -1346131093 bxor -1879981215. +1118179333 = 1659867975 band 1202074781. +1743763423 = 1659867975 bor 1202074781. +625584090 = 1659867975 bxor 1202074781. +134225025 = 671620323 band 238452121. +775847419 = 671620323 bor 238452121. +641622394 = 671620323 bxor 238452121. +-864026603 = -325737409 band -806856107. +-268566913 = -325737409 bor -806856107. +595459690 = -325737409 bxor -806856107. +-2080357295 = -1538636453 band -1918810415. +-1377089573 = -1538636453 bor -1918810415. +703267722 = -1538636453 bxor -1918810415. +1090542597 = 1641929783 band 1193443085. +1744830271 = 1641929783 bor 1193443085. +654287674 = 1641929783 bxor 1193443085. +16778241 = 564790483 band 218431241. +766443483 = 564790483 bor 218431241. +749665242 = 564790483 bxor 218431241. +-1039924731 = -502916305 band -965377339. +-428368913 = -502916305 bor -965377339. +611555818 = -502916305 bxor -965377339. +-2078277055 = -1520223413 band -2035251647. +-1477198005 = -1520223413 bor -2035251647. +601079050 = -1520223413 bxor -2035251647. +1244152101 = 1781023015 band 1312703869. +1849574783 = 1781023015 bor 1312703869. +605422682 = 1781023015 bxor 1312703869. +5015617 = 609077443 band 65977465. +670039291 = 609077443 bor 65977465. +665023674 = 609077443 bxor 65977465. +-1064294891 = -457560545 band -1047156939. +-440422593 = -457560545 bor -1047156939. +623872298 = -457560545 bxor -1047156939. +-2147188431 = -1436709573 band -2138668623. +-1428189765 = -1436709573 bor -2138668623. +718998666 = -1436709573 bxor -2138668623. +1090552325 = 1762509335 band 1104185325. +1776142335 = 1762509335 bor 1104185325. +685590010 = 1762509335 bxor 1104185325. +35791009 = 572680371 band 238728681. +775618043 = 572680371 bor 238728681. +739827034 = 572680371 bxor 238728681. +-925842171 = -355410673 band -905984091. +-335552593 = -355410673 bor -905984091. +590289578 = -355410673 bxor -905984091. +-2008532703 = -1404552405 band -2008401631. +-1404421333 = -1404552405 bor -2008401631. +604111370 = -1404552405 bxor -2008401631. +1207977477 = 1770872583 band 1248872029. +1811767135 = 1770872583 bor 1248872029. +603789658 = 1770872583 bxor 1248872029. +101113857 = 655811747 band 116386649. +671084539 = 655811747 bor 116386649. +569970682 = 655811747 bxor 116386649. +-1071111147 = -534173697 band -1003822059. +-466884609 = -534173697 bor -1003822059. +604226538 = -534173697 bxor -1003822059. +-2132671471 = -1510849253 band -2099073903. +-1477251685 = -1510849253 bor -2099073903. +655419786 = -1510849253 bxor -2099073903. +1147404485 = 1684412407 band 1148485837. +1685493759 = 1684412407 bor 1148485837. +538089274 = 1684412407 bxor 1148485837. +147856513 = 685390995 band 148200649. +685735131 = 685390995 bor 148200649. +537878618 = 685390995 bxor 148200649. +-1069544315 = -429781265 band -1068630907. +-428867857 = -429781265 bor -1068630907. +640676458 = -429781265 bxor -1068630907. +-2132637695 = -1544901877 band -1929978879. +-1342243061 = -1544901877 bor -1929978879. +790394634 = -1544901877 bxor -1929978879. +1075061797 = 1612115175 band 1341404989. +1878458367 = 1612115175 bor 1341404989. +803396570 = 1612115175 bxor 1341404989. +106037249 = 651915395 band 242354745. +788232891 = 651915395 bor 242354745. +682195642 = 651915395 bxor 242354745. +-1069543211 = -455437857 band -899673867. +-285568513 = -455437857 bor -899673867. +783974698 = -455437857 bxor -899673867. +-2139077519 = -1535087365 band -1964128399. +-1360138245 = -1535087365 bor -1964128399. +778939274 = -1535087365 bxor -1964128399. +1086736773 = 1625218519 band 1086745005. +1625226751 = 1625218519 bor 1086745005. +538489978 = 1625218519 bxor 1086745005. +34111521 = 709460083 band 34403241. +709751803 = 709460083 bor 34403241. +675640282 = 709460083 bxor 34403241. +-938467259 = -391008049 band -904388251. +-356929041 = -391008049 bor -904388251. +581538218 = -391008049 bxor -904388251. +-2134766879 = -1480422677 band -1997639967. +-1343295765 = -1480422677 bor -1997639967. +791471114 = -1480422677 bxor -1997639967. +1216350213 = 1757211335 band 1317148701. +1858009823 = 1757211335 bor 1317148701. +641659610 = 1757211335 bxor 1317148701. +67176449 = 638807139 band 229447961. +801078651 = 638807139 bor 229447961. +733902202 = 638807139 bxor 229447961. +-1060886123 = -456758337 band -1024643627. +-420515841 = -456758337 bor -1024643627. +640370282 = -456758337 bxor -1024643627. +-1971322799 = -1350564645 band -1965043119. +-1344284965 = -1350564645 bor -1965043119. +627037834 = -1350564645 bxor -1965043119. +1148191365 = 1735398327 band 1149125261. +1736332223 = 1735398327 bor 1149125261. +588140858 = 1735398327 bxor 1149125261. +34091009 = 652751955 band 186219145. +804880091 = 652751955 bor 186219145. +770789082 = 652751955 bxor 186219145. +-1072299515 = -508050769 band -1005177275. +-440928529 = -508050769 bor -1005177275. +631370986 = -508050769 bxor -1005177275. +-1941909311 = -1354245429 band -1939279423. +-1351615541 = -1354245429 bor -1939279423. +590293770 = -1354245429 bxor -1939279423. +1079068837 = 1786206375 band 1104275709. +1811413247 = 1786206375 bor 1104275709. +732344410 = 1786206375 bxor 1104275709. +51384385 = 590796867 band 64559097. +603971579 = 590796867 bor 64559097. +552587194 = 590796867 bxor 64559097. +-931123051 = -303778401 band -930465099. +-303120449 = -303778401 bor -930465099. +628002602 = -303778401 bxor -930465099. +-2141189071 = -1402401605 band -2131702479. +-1392915013 = -1402401605 bor -2131702479. +748274058 = -1402401605 bxor -2131702479. +1225787653 = 1829878167 band 1230244717. +1834335231 = 1829878167 bor 1230244717. +608547578 = 1829878167 bxor 1230244717. +19025953 = 724457523 band 20115817. +725547387 = 724457523 bor 20115817. +706521434 = 724457523 bxor 20115817. +-989855739 = -311671665 band -956286171. +-278102097 = -311671665 bor -956286171. +711753642 = -311671665 bxor -956286171. +-2121138015 = -1376609621 band -2086771551. +-1342243157 = -1376609621 bor -2086771551. +778894858 = -1376609621 bxor -2086771551. +1075454085 = 1748907655 band 1100720605. +1774174175 = 1748907655 bor 1100720605. +698720090 = 1748907655 bxor 1100720605. +137102337 = 683521059 band 204343001. +750761723 = 683521059 bor 204343001. +613659386 = 683521059 bxor 204343001. +-1070782699 = -366121089 band -1041287275. +-336625665 = -366121089 bor -1041287275. +734157034 = -366121089 bxor -1041287275. +-2079293423 = -1397521253 band -2024228847. +-1342456677 = -1397521253 bor -2024228847. +736836746 = -1397521253 bxor -2024228847. +1086047301 = 1656475511 band 1157612621. +1728040831 = 1656475511 bor 1157612621. +641993530 = 1656475511 bxor 1157612621. +227624961 = 798223379 band 227629129. +798227547 = 798223379 bor 227629129. +570602586 = 798223379 bxor 227629129. +-1014616059 = -473483665 band -946982907. +-405850513 = -473483665 bor -946982907. +608765546 = -473483665 bxor -946982907. +-2113748351 = -1556428149 band -2033793151. +-1476472949 = -1556428149 bor -2033793151. +637275402 = -1556428149 bxor -2033793151. +1090584613 = 1628013671 band 1100438205. +1637867263 = 1628013671 bor 1100438205. +547282650 = 1628013671 bxor 1100438205. +220200961 = 757071875 band 233039289. +769910203 = 757071875 bor 233039289. +549709242 = 757071875 bxor 233039289. +-1047527339 = -275211937 band -1043061643. +-270746241 = -275211937 bor -1043061643. +776781098 = -275211937 bxor -1043061643. +-2075721615 = -1378390917 band -2075159823. +-1377829125 = -1378390917 bor -2075159823. +697892490 = -1378390917 bxor -2075159823. +1092633861 = 1701205335 band 1228500269. +1837071743 = 1701205335 bor 1228500269. +744437882 = 1701205335 bxor 1228500269. +44833 = 680587251 band 91008809. +771551227 = 680587251 bor 91008809. +771506394 = 680587251 bxor 91008809. +-1069543355 = -390031281 band -965208859. +-285696785 = -390031281 bor -965208859. +783846570 = -390031281 bxor -965208859. +-1978135967 = -1432851861 band -1978000799. +-1432716693 = -1432851861 bor -1978000799. +545419274 = -1432851861 bxor -1978000799. +1095778821 = 1875984967 band 1098709917. +1878916063 = 1875984967 bor 1098709917. +783137242 = 1875984967 bxor 1098709917. +1093761 = 584432611 band 204649625. +787988475 = 584432611 bor 204649625. +786894714 = 584432611 bxor 204649625. +-1072692971 = -534891713 band -957284011. +-419482753 = -534891713 bor -957284011. +653210218 = -534891713 bxor -957284011. +-2012461999 = -1454586789 band -1978835503. +-1420960293 = -1454586789 bor -1978835503. +591501706 = -1454586789 bxor -1978835503. +1107886597 = 1846102839 band 1136199181. +1874415423 = 1846102839 bor 1136199181. +766528826 = 1846102839 bxor 1136199181. +10248705 = 647848915 band 167573001. +805173211 = 647848915 bor 167573001. +794924506 = 647848915 bxor 167573001. +-1068472315 = -330274257 band -1066014267. +-327816209 = -330274257 bor -1066014267. +740656106 = -330274257 bxor -1066014267. +-1988077503 = -1417446837 band -1915724479. +-1345093813 = -1417446837 bor -1915724479. +642983690 = -1417446837 bxor -1915724479. +1224998949 = 1804431399 band 1292143741. +1871576191 = 1804431399 bor 1292143741. +646577242 = 1804431399 bxor 1292143741. +5399361 = 676784067 band 106066809. +777451515 = 676784067 bor 106066809. +772052154 = 676784067 bxor 106066809. +-910947307 = -373932769 band -872559051. +-335544513 = -373932769 bor -872559051. +575402794 = -373932769 bxor -872559051. +-2071328719 = -1534358469 band -2033575759. +-1496605509 = -1534358469 bor -2033575759. +574723210 = -1534358469 bxor -2033575759. +1075085317 = 1637658903 band 1312198381. +1874771967 = 1637658903 bor 1312198381. +799686650 = 1637658903 bxor 1312198381. +3146913 = 640763827 band 142224617. +779841531 = 640763827 bor 142224617. +776694618 = 640763827 bxor 142224617. +-902910971 = -361845745 band -834687323. +-293622097 = -361845745 bor -834687323. +609288874 = -361845745 bxor -834687323. +-2011066335 = -1452017109 band -1910403039. +-1351353813 = -1452017109 bor -1910403039. +659712522 = -1452017109 bxor -1910403039. +1126566917 = 1731595783 band 1273367901. +1878396767 = 1731595783 bor 1273367901. +751829850 = 1731595783 bxor 1273367901. +1769985 = 672891811 band 125510233. +796632059 = 672891811 bor 125510233. +794862074 = 672891811 bxor 125510233. +-971996651 = -430393601 band -944600299. +-402997249 = -430393601 bor -944600299. +568999402 = -430393601 bxor -944600299. +-2146844655 = -1593064421 band -2067938415. +-1514158181 = -1593064421 bor -2067938415. +632686474 = -1593064421 bxor -2067938415. +1074267845 = 1628997367 band 1315571661. +1870301183 = 1628997367 bor 1315571661. +796033338 = 1628997367 bxor 1315571661. +168039297 = 801414035 band 169628617. +803003355 = 801414035 bor 169628617. +634964058 = 801414035 bxor 169628617. +-1073659515 = -351052305 band -997366907. +-274759697 = -351052305 bor -997366907. +798899818 = -351052305 bxor -997366907. +-2092850687 = -1545475573 band -2092584191. +-1545209077 = -1545475573 bor -2092584191. +547641610 = -1545475573 bxor -2092584191. +1103174181 = 1640176615 band 1104772669. +1641775103 = 1640176615 bor 1104772669. +538600922 = 1640176615 bxor 1104772669. +8421633 = 681283459 band 115654969. +788516795 = 681283459 bor 115654969. +780095162 = 681283459 bxor 115654969. +-926605099 = -335699745 band -859359243. +-268453889 = -335699745 bor -859359243. +658151210 = -335699745 bxor -859359243. +-2013246863 = -1404736517 band -1977590159. +-1369079813 = -1404736517 bor -1977590159. +644167050 = -1404736517 bxor -1977590159. +1073758341 = 1769262295 band 1175154861. +1870658815 = 1769262295 bor 1175154861. +796900474 = 1769262295 bxor 1175154861. +67848737 = 667901811 band 68905641. +668958715 = 667901811 bor 68905641. +601109978 = 667901811 bxor 68905641. +-1072297915 = -499744817 band -1005123483. +-432570385 = -499744817 bor -1005123483. +639727530 = -499744817 bxor -1005123483. +-2143010335 = -1505408533 band -2123053599. +-1485451797 = -1505408533 bor -2123053599. +657558538 = -1505408533 bxor -2123053599. +1174706437 = 1714198983 band 1318510365. +1858002911 = 1714198983 bor 1318510365. +683296474 = 1714198983 bxor 1318510365. +71761921 = 743377763 band 130502681. +802118523 = 743377763 bor 130502681. +730356602 = 743377763 bxor 130502681. +-930033515 = -325256513 band -906767147. +-301990145 = -325256513 bor -906767147. +628043370 = -325256513 bxor -906767147. +-1994358447 = -1347386405 band -1993741999. +-1346769957 = -1347386405 bor -1993741999. +647588490 = -1347386405 bxor -1993741999. +1115717765 = 1672053431 band 1121110413. +1677446079 = 1672053431 bor 1121110413. +561728314 = 1672053431 bxor 1121110413. +109646081 = 784962387 band 128938377. +804254683 = 784962387 bor 128938377. +694608602 = 784962387 bxor 128938377. +-913305339 = -271576657 band -913007291. +-271278609 = -271576657 bor -913007291. +642026730 = -271576657 bxor -913007291. +-2012870463 = -1474946613 band -1998141247. +-1460217397 = -1474946613 bor -1998141247. +552653066 = -1474946613 bxor -1998141247. +1229064101 = 1802143655 band 1305882621. +1878962175 = 1802143655 bor 1305882621. +649898074 = 1802143655 bxor 1305882621. +17352257 = 565049155 band 156946169. +704643067 = 565049155 bor 156946169. +687290810 = 565049155 bxor 156946169. +-1071628139 = -433142625 band -906993227. +-268507713 = -433142625 bor -906993227. +803120426 = -433142625 bxor -906993227. +-2147483599 = -1597699141 band -2146278351. +-1596493893 = -1597699141 bor -2146278351. +550989706 = -1597699141 bxor -2146278351. +1143472133 = 1689168023 band 1316491885. +1862187775 = 1689168023 bor 1316491885. +718715642 = 1689168023 bxor 1316491885. +8225 = 556480307 band 34629737. +591101819 = 556480307 bor 34629737. +591093594 = 556480307 bxor 34629737. +-845676027 = -271051889 band -843177435. +-268553297 = -271051889 bor -843177435. +577122730 = -271051889 bxor -843177435. +-2067785311 = -1395893845 band -2049721439. +-1377829973 = -1395893845 bor -2049721439. +689955338 = -1395893845 bxor -2049721439. +1145331845 = 1685382535 band 1196388573. +1736439263 = 1685382535 bor 1196388573. +591107418 = 1685382535 bxor 1196388573. +34607361 = 590369571 band 114769369. +670531579 = 590369571 bor 114769369. +635924218 = 590369571 bxor 114769369. +-1038033387 = -492110209 band -1015751019. +-469827841 = -492110209 bor -1015751019. +568205546 = -492110209 bxor -1015751019. +-2146368751 = -1594162277 band -1995321583. +-1443115109 = -1594162277 bor -1995321583. +703253642 = -1594162277 bxor -1995321583. +1278216773 = 1836858999 band 1320373069. +1879015295 = 1836858999 bor 1320373069. +600798522 = 1836858999 bxor 1320373069. +73681665 = 661408531 band 209080137. +796807003 = 661408531 bor 209080137. +723125338 = 661408531 bxor 209080137. +-1069382395 = -364477073 band -984901883. +-279996561 = -364477073 bor -984901883. +789385834 = -364477073 bxor -984901883. +-2141190015 = -1545598581 band -2139906431. +-1544314997 = -1545598581 bor -2139906431. +596875018 = -1545598581 bxor -2139906431. +1073914149 = 1615049575 band 1320853949. +1861989375 = 1615049575 bor 1320853949. +788075226 = 1615049575 bxor 1320853949. +121904129 = 659431171 band 125082809. +662609851 = 659431171 bor 125082809. +540705722 = 659431171 bxor 125082809. +-938932139 = -402020257 band -918992011. +-382080129 = -402020257 bor -918992011. +556852010 = -402020257 bxor -918992011. +-2009061007 = -1379243141 band -1973409295. +-1343591429 = -1379243141 bor -1973409295. +665469578 = -1379243141 bxor -1973409295. +1091060741 = 1795834967 band 1161589805. +1866364031 = 1795834967 bor 1161589805. +775303290 = 1795834967 bxor 1161589805. +67110433 = 637849331 band 202974761. +773713659 = 637849331 bor 202974761. +706603226 = 637849331 bxor 202974761. +-1072667835 = -485267633 band -1057686555. +-470286353 = -485267633 bor -1057686555. +602381482 = -485267633 bxor -1057686555. +-2000150175 = -1463211669 band -1929481887. +-1392543381 = -1463211669 bor -1929481887. +607606794 = -1463211669 bxor -1929481887. +1104068613 = 1775169863 band 1137689245. +1808790495 = 1775169863 bor 1137689245. +704721882 = 1775169863 bxor 1137689245. +6965889 = 545217251 band 241888153. +780139515 = 545217251 bor 241888153. +773173626 = 545217251 bxor 241888153. +-935297003 = -398278081 band -906647467. +-369628545 = -398278081 bor -906647467. +565668458 = -398278081 bxor -906647467. +-2145304495 = -1599388837 band -2043317039. +-1497401381 = -1599388837 bor -2043317039. +647903114 = -1599388837 bxor -2043317039. +1178634245 = 1716566583 band 1338739981. +1876672319 = 1716566583 bor 1338739981. +698038074 = 1716566583 bxor 1338739981. +2146305 = 762102483 band 36760841. +796717019 = 762102483 bor 36760841. +794570714 = 762102483 bxor 36760841. +-936243195 = -365512401 band -848146235. +-277415441 = -365512401 bor -848146235. +658827754 = -365512401 bxor -848146235. +-2102644671 = -1560299189 band -1951648703. +-1409303221 = -1560299189 bor -1951648703. +693341450 = -1560299189 bxor -1951648703. +1074172709 = 1745788711 band 1111937917. +1783553919 = 1745788711 bor 1111937917. +709381210 = 1745788711 bxor 1111937917. +137364033 = 758908611 band 183642745. +805187323 = 758908611 bor 183642745. +667823290 = 758908611 bxor 183642745. +-1069530091 = -514962401 band -1067322059. +-512754369 = -514962401 bor -1067322059. +556775722 = -514962401 bxor -1067322059. +-1979610319 = -1357542597 band -1966493775. +-1344426053 = -1357542597 bor -1966493775. +635184266 = -1357542597 bxor -1966493775. +1073774597 = 1682415639 band 1209570797. +1818211839 = 1682415639 bor 1209570797. +744437242 = 1682415639 bxor 1209570797. +169091745 = 706487987 band 200647657. +738043899 = 706487987 bor 200647657. +568952154 = 706487987 bxor 200647657. +-1020784379 = -341279985 band -1015310939. +-335806545 = -341279985 bor -1015310939. +684977834 = -341279985 bxor -1015310939. +-2135908063 = -1510229717 band -2001410271. +-1375731925 = -1510229717 bor -2001410271. +760176138 = -1510229717 bxor -2001410271. +1104319493 = 1845148935 band 1104663645. +1845493087 = 1845148935 bor 1104663645. +741173594 = 1845148935 bxor 1104663645. +4194305 = 670835363 band 138565977. +805207035 = 670835363 bor 138565977. +801012730 = 670835363 bxor 138565977. +-1054605291 = -316389889 band -1019858411. +-281643009 = -316389889 bor -1019858411. +772962282 = -316389889 bxor -1019858411. +-2113912303 = -1434369253 band -2108368239. +-1428825189 = -1434369253 bor -2108368239. +685087114 = -1434369253 bxor -2108368239. +1103267013 = 1709635063 band 1138462413. +1744830463 = 1709635063 bor 1138462413. +641563450 = 1709635063 bxor 1138462413. +9063041 = 613087891 band 43993801. +648018651 = 613087891 bor 43993801. +638955610 = 613087891 bxor 43993801. +-952072059 = -278876945 band -943142267. +-269947153 = -278876945 bor -943142267. +682124906 = -278876945 bxor -943142267. +-2146433023 = -1590351605 band -1940878847. +-1384797429 = -1590351605 bor -1940878847. +761635594 = -1590351605 bxor -1940878847. +1107968037 = 1787513575 band 1178256701. +1857802239 = 1787513575 bor 1178256701. +749834202 = 1787513575 bxor 1178256701. +85141505 = 657960579 band 227768377. +800587451 = 657960579 bor 227768377. +715445946 = 657960579 bxor 227768377. +-1054339371 = -507727905 band -987078923. +-440467457 = -507727905 bor -987078923. +613871914 = -507727905 bxor -987078923. +-2147065743 = -1603900677 band -2096171663. +-1553006597 = -1603900677 bor -2096171663. +594059146 = -1603900677 bxor -2096171663. +1074017157 = 1747368919 band 1154250669. +1827602431 = 1747368919 bor 1154250669. +753585274 = 1747368919 bxor 1154250669. +18948129 = 556875379 band 191226281. +729153531 = 556875379 bor 191226281. +710205402 = 556875379 bxor 191226281. +-921612731 = -380154161 band -888017051. +-346558481 = -380154161 bor -888017051. +575054250 = -380154161 bxor -888017051. +-2145122079 = -1608251157 band -1967711007. +-1430840085 = -1608251157 bor -1967711007. +714281994 = -1608251157 bxor -1967711007. +1210056709 = 1756907719 band 1327998493. +1874849503 = 1756907719 bor 1327998493. +664792794 = 1756907719 bxor 1327998493. +201622017 = 761703011 band 236816153. +796897147 = 761703011 bor 236816153. +595275130 = 761703011 bxor 236816153. +-1073346155 = -519075393 band -990479403. +-436208641 = -519075393 bor -990479403. +637137514 = -519075393 bxor -990479403. +-1976565679 = -1438842149 band -1892679599. +-1354956069 = -1438842149 bor -1892679599. +621609610 = -1438842149 bxor -1892679599. +1084379269 = 1677652407 band 1218662541. +1811935679 = 1677652407 bor 1218662541. +727556410 = 1677652407 bxor 1218662541. +8413185 = 545714771 band 125921417. +663223003 = 545714771 bor 125921417. +654809818 = 545714771 bxor 125921417. +-939261947 = -377200465 band -904985531. +-342924049 = -377200465 bor -904985531. +596337898 = -377200465 bxor -904985531. +-2147477311 = -1438623541 band -2078236735. +-1369382965 = -1438623541 bor -2078236735. +778094346 = -1438623541 bxor -2078236735. +1213216421 = 1870247591 band 1213626109. +1870657279 = 1870247591 bor 1213626109. +657440858 = 1870247591 bxor 1213626109. +150996033 = 687937091 band 152602105. +689543163 = 687937091 bor 152602105. +538547130 = 687937091 bxor 152602105. +-921665387 = -384511073 band -850229067. +-313074753 = -384511073 bor -850229067. +608590634 = -384511073 bxor -850229067. +-2073228751 = -1384314181 band -2064647375. +-1375732805 = -1384314181 bor -2064647375. +697495946 = -1384314181 bxor -2064647375. +1207963909 = 1852282775 band 1226316141. +1870635007 = 1852282775 bor 1226316141. +662671098 = 1852282775 bxor 1226316141. +67114529 = 788796979 band 69853033. +791535483 = 788796979 bor 69853033. +724420954 = 788796979 bxor 69853033. +-916979707 = -337649009 band -847771355. +-268440657 = -337649009 bor -847771355. +648539050 = -337649009 bxor -847771355. +-2147479391 = -1560143701 band -2067459423. +-1480123733 = -1560143701 bor -2067459423. +667355658 = -1560143701 bxor -2067459423. +1095177349 = 1640469639 band 1233074141. +1778366431 = 1640469639 bor 1233074141. +683189082 = 1640469639 bxor 1233074141. +3960833 = 612299299 band 163345625. +771684091 = 612299299 bor 163345625. +767723258 = 612299299 bxor 163345625. +-1060862699 = -473657985 band -990476907. +-403272193 = -473657985 bor -990476907. +657590506 = -473657985 bxor -990476907. +-1970896367 = -1415675237 band -1903761903. +-1348540773 = -1415675237 bor -1903761903. +622355594 = -1415675237 bxor -1903761903. +1212186693 = 1750642039 band 1273156173. +1811611519 = 1750642039 bor 1273156173. +599424826 = 1750642039 bxor 1273156173. +513 = 622897683 band 177686089. +800583259 = 622897683 bor 177686089. +800582746 = 622897683 bxor 177686089. +-939469819 = -396241809 band -905642491. +-362414481 = -396241809 bor -905642491. +577055338 = -396241809 bxor -905642491. +-2134884223 = -1444853621 band -2065926783. +-1375896181 = -1444853621 bor -2065926783. +758988042 = -1444853621 bxor -2065926783. +1176100901 = 1855578727 band 1180297405. +1859775231 = 1855578727 bor 1180297405. +683674330 = 1855578727 bxor 1180297405. +104862209 = 643317251 band 121721785. +660176827 = 643317251 bor 121721785. +555314618 = 643317251 bxor 121721785. +-971885995 = -417941665 band -828738955. +-274794625 = -417941665 bor -828738955. +697091370 = -417941665 bxor -828738955. +-2113388431 = -1575392645 band -2110996239. +-1573000453 = -1575392645 bor -2110996239. +540387978 = -1575392645 bxor -2110996239. +1116353285 = 1858745175 band 1119583021. +1861974911 = 1858745175 bor 1119583021. +745621626 = 1858745175 bxor 1119583021. +36129 = 659860979 band 105769. +659930619 = 659860979 bor 105769. +659894490 = 659860979 bxor 105769. +-1073733051 = -486394289 band -1066540315. +-479201553 = -486394289 bor -1066540315. +594531498 = -486394289 bxor -1066540315. +-2011903903 = -1437210517 band -2002859935. +-1428166549 = -1437210517 bor -2002859935. +583737354 = -1437210517 bxor -2002859935. +1082687493 = 1625858119 band 1319012765. +1862183391 = 1625858119 bor 1319012765. +779495898 = 1625858119 bxor 1319012765. +270465 = 553974243 band 81732249. +635436027 = 553974243 bor 81732249. +635165562 = 553974243 bxor 81732249. +-1073594091 = -452767425 band -923381931. +-302555265 = -452767425 bor -923381931. +771038826 = -452767425 bxor -923381931. +-2113830319 = -1436171685 band -2112255023. +-1434596389 = -1436171685 bor -2112255023. +679233930 = -1436171685 bxor -2112255023. +1242562565 = 1790191927 band 1264194573. +1811823935 = 1790191927 bor 1264194573. +569261370 = 1790191927 bxor 1264194573. +67117057 = 639115731 band 94430217. +666428891 = 639115731 bor 94430217. +599311834 = 639115731 bxor 94430217. +-920125435 = -340195281 band -848644155. +-268714001 = -340195281 bor -848644155. +651411434 = -340195281 bxor -848644155. +-2143025087 = -1411909557 band -2143024319. +-1411908789 = -1411909557 bor -2143024319. +731116298 = -1411909557 bxor -2143024319. +1308690981 = 1873530407 band 1308957309. +1873796735 = 1873530407 bor 1308957309. +565105754 = 1873530407 bxor 1308957309. +13443393 = 587015619 band 30269817. +603842043 = 587015619 bor 30269817. +590398650 = 587015619 bxor 30269817. +-897443819 = -343778529 band -826139595. +-272474305 = -343778529 bor -826139595. +624969514 = -343778529 bxor -826139595. +-2004811215 = -1443132869 band -1937422671. +-1375744325 = -1443132869 bor -1937422671. +629066890 = -1443132869 bxor -1937422671. +1090948101 = 1628344087 band 1333173485. +1870569471 = 1628344087 bor 1333173485. +779621370 = 1628344087 bxor 1333173485. +144769185 = 769852851 band 145562345. +770646011 = 769852851 bor 145562345. +625876826 = 769852851 bxor 145562345. +-936228859 = -293713393 band -910984027. +-268468561 = -293713393 bor -910984027. +667760298 = -293713393 bxor -910984027. +-2147207135 = -1579190229 band -2012987871. +-1444970965 = -1579190229 bor -2012987871. +702236170 = -1579190229 bxor -2012987871. +1279330309 = 1843096583 band 1279630173. +1843396447 = 1843096583 bor 1279630173. +564066138 = 1843096583 bxor 1279630173. +32769 = 649642403 band 155553881. +805163515 = 649642403 bor 155553881. +805130746 = 649642403 bxor 155553881. +-998125547 = -460598017 band -961160939. +-423633409 = -460598017 bor -961160939. +574492138 = -460598017 bxor -961160939. +-2113748975 = -1571634661 band -1951927919. +-1409813605 = -1571634661 bor -1951927919. +703935370 = -1571634661 bxor -1951927919. +1086391493 = 1657890039 band 1154029005. +1725527551 = 1657890039 bor 1154029005. +639136058 = 1657890039 bxor 1154029005. +34357633 = 657283475 band 39731657. +662657499 = 657283475 bor 39731657. +628299866 = 657283475 bxor 39731657. +-1040174715 = -481690641 band -905956987. +-347472913 = -481690641 bor -905956987. +692701802 = -481690641 bxor -905956987. +-2012979199 = -1411094517 band -2011733759. +-1409849077 = -1411094517 bor -2011733759. +603130122 = -1411094517 bxor -2011733759. +1208485925 = 1785690599 band 1293421629. +1870626303 = 1785690599 bor 1293421629. +662140378 = 1785690599 bxor 1293421629. +36572417 = 581946755 band 41824057. +587198395 = 581946755 bor 41824057. +550625978 = 581946755 bxor 41824057. +-1040087851 = -434651425 band -1014397451. +-408961025 = -434651425 bor -1014397451. +631126826 = -434651425 bxor -1014397451. +-2136930191 = -1595708933 band -2051437455. +-1510216197 = -1595708933 bor -2051437455. +626713994 = -1595708933 bxor -2051437455. +1275079301 = 1827973847 band 1292467885. +1845362431 = 1827973847 bor 1292467885. +570283130 = 1827973847 bxor 1292467885. +107747361 = 644816243 band 132929705. +669998587 = 644816243 bor 132929705. +562251226 = 644816243 bxor 132929705. +-838855611 = -300671537 band -821504411. +-283320337 = -300671537 bor -821504411. +555535274 = -300671537 bxor -821504411. +-2079046687 = -1520515093 band -2068483103. +-1509951509 = -1520515093 bor -2068483103. +569095178 = -1520515093 bxor -2068483103. +1075078405 = 1616902087 band 1077177629. +1619001311 = 1616902087 bor 1077177629. +543922906 = 1616902087 bxor 1077177629. +657409 = 693782883 band 11517465. +704642939 = 693782883 bor 11517465. +703985530 = 693782883 bxor 11517465. +-1038876523 = -501344065 band -1007344939. +-469812481 = -501344065 bor -1007344939. +569064042 = -501344065 bxor -1007344939. +-1944059567 = -1356496421 band -1930291375. +-1342728229 = -1356496421 bor -1930291375. +601331338 = -1356496421 bxor -1930291375. +1080049797 = 1752195255 band 1173346189. +1845491647 = 1752195255 bor 1173346189. +765441850 = 1752195255 bxor 1173346189. +134238465 = 740315475 band 177168265. +783245275 = 740315475 bor 177168265. +649006810 = 740315475 bxor 177168265. +-997971195 = -288051281 band -981111995. +-271192081 = -288051281 bor -981111995. +726779114 = -288051281 bxor -981111995. +-2079975743 = -1513711669 band -1911130431. +-1344866357 = -1513711669 bor -1911130431. +735109386 = -1513711669 bxor -1911130431. +1073784229 = 1722082727 band 1095941629. +1744240127 = 1722082727 bor 1095941629. +670455898 = 1722082727 bxor 1095941629. +17839169 = 691025219 band 51526905. +724712955 = 691025219 bor 51526905. +706873786 = 691025219 bxor 51526905. +-1030708587 = -426319201 band -1028608075. +-424218689 = -426319201 bor -1028608075. +606489898 = -426319201 bxor -1028608075. +-2105475023 = -1567553093 band -1886809551. +-1348887621 = -1567553093 bor -1886809551. +756587402 = -1567553093 bxor -1886809551. +1211367429 = 1782351511 band 1228152941. +1799137023 = 1782351511 bor 1228152941. +587769594 = 1782351511 bxor 1228152941. +70800417 = 616101171 band 125785705. +671086459 = 616101171 bor 125785705. +600286042 = 616101171 bxor 125785705. +-1073631227 = -511463025 band -970067931. +-407899729 = -511463025 bor -970067931. +665731498 = -511463025 bxor -970067931. +-2146287199 = -1600923733 band -2139985503. +-1594622037 = -1600923733 bor -2139985503. +551665162 = -1600923733 bxor -2139985503. +1075987077 = 1614168967 band 1210777309. +1748959199 = 1614168967 bor 1210777309. +672972122 = 1614168967 bxor 1210777309. +76120321 = 749310243 band 81636313. +754826235 = 749310243 bor 81636313. +678705914 = 749310243 bxor 81636313. +-999289835 = -310764417 band -965464939. +-276939521 = -310764417 bor -965464939. +722350314 = -310764417 bxor -965464939. +-2070544111 = -1398931045 band -2017985263. +-1346372197 = -1398931045 bor -2017985263. +724171914 = -1398931045 bxor -2017985263. +1073748037 = 1666260087 band 1284397389. +1876909439 = 1666260087 bor 1284397389. +803161402 = 1666260087 bxor 1284397389. +11536641 = 682690835 band 133446985. +804601179 = 682690835 bor 133446985. +793064538 = 682690835 bxor 133446985. +-1005051643 = -300342417 band -977640187. +-272930961 = -300342417 bor -977640187. +732120682 = -300342417 bxor -977640187. +-2080373631 = -1522628725 band -2080289663. +-1522544757 = -1522628725 bor -2080289663. +557828874 = -1522628725 bxor -2080289663. +1208221989 = 1812730215 band 1215639485. +1820147711 = 1812730215 bor 1215639485. +611925722 = 1812730215 bxor 1215639485. +134875137 = 708730115 band 222956217. +796811195 = 708730115 bor 222956217. +661936058 = 708730115 bxor 222956217. +-1061715883 = -322976161 band -1040737931. +-301998209 = -322976161 bor -1040737931. +759717674 = -322976161 bxor -1040737931. +-1971043983 = -1429968517 band -1951049743. +-1409974277 = -1429968517 bor -1951049743. +561069706 = -1429968517 bxor -1951049743. +1084621317 = 1621500503 band 1102479917. +1639359103 = 1621500503 bor 1102479917. +554737786 = 1621500503 bxor 1102479917. +1057 = 746622195 band 19272745. +765893883 = 746622195 bor 19272745. +765892826 = 746622195 bxor 19272745. +-1065352891 = -393411249 band -991770139. +-319828497 = -393411249 bor -991770139. +745524394 = -393411249 bxor -991770139. +-1942354079 = -1354848405 band -1929699487. +-1342193813 = -1354848405 bor -1929699487. +600160266 = -1354848405 bxor -1929699487. +1091059717 = 1696485191 band 1105809565. +1711235039 = 1696485191 bor 1105809565. +620175322 = 1696485191 bxor 1105809565. +67508353 = 610703587 band 261052825. +804248059 = 610703587 bor 261052825. +736739706 = 610703587 bxor 261052825. +-1034756075 = -429924289 band -1007487403. +-402655617 = -429924289 bor -1007487403. +632100458 = -429924289 bxor -1007487403. +-2076704687 = -1501806245 band -1917213999. +-1342315557 = -1501806245 bor -1917213999. +734389130 = -1501806245 bxor -1917213999. +1109432325 = 1798543415 band 1180998413. +1870109503 = 1798543415 bor 1180998413. +760677178 = 1798543415 bxor 1180998413. +819201 = 547324115 band 72145673. +618650587 = 547324115 bor 72145673. +617831386 = 547324115 bxor 72145673. +-1068034555 = -522758353 band -1067508027. +-522231825 = -522758353 bor -1067508027. +545802730 = -522758353 bxor -1067508027. +-2113658303 = -1509148853 band -1952980415. +-1348470965 = -1509148853 bor -1952980415. +765187338 = -1509148853 bxor -1952980415. +1076125989 = 1650785575 band 1077895549. +1652555135 = 1650785575 bor 1077895549. +576429146 = 1650785575 bxor 1077895549. +142606401 = 697976003 band 182818937. +738188539 = 697976003 bor 182818937. +595582138 = 697976003 bxor 182818937. +-1072545259 = -397252065 band -954318027. +-279024833 = -397252065 bor -954318027. +793520426 = -397252065 bxor -954318027. +-2126739151 = -1522693829 band -1946362447. +-1342317125 = -1522693829 bor -1946362447. +784422026 = -1522693829 bxor -1946362447. +1146102277 = 1743879703 band 1146135533. +1743912959 = 1743879703 bor 1146135533. +597810682 = 1743879703 bxor 1146135533. +8421537 = 562422963 band 245404137. +799405563 = 562422963 bor 245404137. +790984026 = 562422963 bxor 245404137. +-1059061499 = -487581425 band -1058577499. +-487097425 = -487581425 bor -1058577499. +571964074 = -487581425 bxor -1058577499. +-1945168607 = -1390463189 band -1945135839. +-1390430421 = -1390463189 bor -1945135839. +554738186 = -1390463189 bxor -1945135839. +1107821061 = 1725438727 band 1261396573. +1879014239 = 1725438727 bor 1261396573. +771193178 = 1725438727 bxor 1261396573. +16385 = 609312931 band 176473945. +785770491 = 609312931 bor 176473945. +785754106 = 609312931 bxor 176473945. +-1073676267 = -326147073 band -1036943339. +-289414145 = -326147073 bor -1036943339. +784262122 = -326147073 bxor -1036943339. +-2139095023 = -1467989733 band -2135488367. +-1464383077 = -1467989733 bor -2135488367. +674711946 = -1467989733 bxor -2135488367. +1091735749 = 1742197751 band 1093835981. +1744297983 = 1742197751 bor 1093835981. +652562234 = 1742197751 bxor 1093835981. +17381505 = 665565331 band 156842185. +805026011 = 665565331 bor 156842185. +787644506 = 665565331 bxor 156842185. +-1039988603 = -422622481 band -885811067. +-268444945 = -422622481 bor -885811067. +771543658 = -422622481 bxor -885811067. +-2104877055 = -1544575221 band -2036713471. +-1476411637 = -1544575221 bor -2036713471. +628465418 = -1544575221 bxor -2036713471. +1080098853 = 1634707687 band 1181831997. +1736440831 = 1634707687 bor 1181831997. +656341978 = 1634707687 bxor 1181831997. +16835585 = 721677443 band 94692921. +799534779 = 721677443 bor 94692921. +782699194 = 721677443 bxor 94692921. +-1056666411 = -384905761 band -941314827. +-269554177 = -384905761 bor -941314827. +787112234 = -384905761 bxor -941314827. +-2145378191 = -1380161285 band -2111822991. +-1346606085 = -1380161285 bor -2111822991. +798772106 = -1380161285 bxor -2111822991. +1187152261 = 1742641623 band 1321371053. +1876860415 = 1742641623 bor 1321371053. +689708154 = 1742641623 bxor 1321371053. +25742369 = 663288947 band 162451369. +799997947 = 663288947 bor 162451369. +774255578 = 663288947 bxor 162451369. +-1066881979 = -529732401 band -805585563. +-268435985 = -529732401 bor -805585563. +798445994 = -529732401 bxor -805585563. +-2056944927 = -1510635797 band -1888498975. +-1342189845 = -1510635797 bor -1888498975. +714755082 = -1510635797 bxor -1888498975. +1092690949 = 1831052999 band 1102918685. +1841280735 = 1831052999 bor 1102918685. +748589786 = 1831052999 bxor 1102918685. +2744321 = 539617379 band 259912985. +796786043 = 539617379 bor 259912985. +794041722 = 539617379 bxor 259912985. +-959938155 = -272062529 band -957363755. +-269488129 = -272062529 bor -957363755. +690450026 = -272062529 bxor -957363755. +-2107637679 = -1368784677 band -2106577327. +-1367724325 = -1368784677 bor -2106577327. +739913354 = -1368784677 bxor -2106577327. +1085820549 = 1627246519 band 1253596813. +1795022783 = 1627246519 bor 1253596813. +709202234 = 1627246519 bxor 1253596813. +9506817 = 563458131 band 14243465. +568194779 = 563458131 bor 14243465. +558687962 = 563458131 bxor 14243465. +-876555771 = -272564561 band -872951227. +-268960017 = -272564561 bor -872951227. +607595754 = -272564561 bxor -872951227. +-2104998719 = -1431775541 band -2033693247. +-1360470069 = -1431775541 bor -2033693247. +744528650 = -1431775541 bxor -2033693247. +1086850213 = 1626084519 band 1221264637. +1760498943 = 1626084519 bor 1221264637. +673648730 = 1626084519 bxor 1221264637. +33771585 = 574313539 band 122156025. +662697979 = 574313539 bor 122156025. +628926394 = 574313539 bxor 122156025. +-905916267 = -290131553 band -905259339. +-289474625 = -290131553 bor -905259339. +616441642 = -290131553 bxor -905259339. +-2147416015 = -1610544965 band -1881200335. +-1344329285 = -1610544965 bor -1881200335. +803086730 = -1610544965 bxor -1881200335. +1208755461 = 1747809687 band 1322002285. +1861056511 = 1747809687 bor 1322002285. +652301050 = 1747809687 bxor 1322002285. +50209 = 575263795 band 202427753. +777641339 = 575263795 bor 202427753. +777591130 = 575263795 bxor 202427753. +-1060929531 = -524058481 band -941631707. +-404760657 = -524058481 bor -941631707. +656168874 = -524058481 bxor -941631707. +-2138996575 = -1518233941 band -1998864223. +-1378101589 = -1518233941 bor -1998864223. +760894986 = -1518233941 bxor -1998864223. +1128317061 = 1874915975 band 1129498077. +1876096991 = 1874915975 bor 1129498077. +747779930 = 1874915975 bxor 1129498077. +137371649 = 732966947 band 138076889. +733672187 = 732966947 bor 138076889. +596300538 = 732966947 bxor 138076889. +-943095019 = -271864961 band -940715115. +-269485057 = -271864961 bor -940715115. +673609962 = -271864961 bxor -940715115. +-2136932335 = -1543929701 band -2069556207. +-1476553573 = -1543929701 bor -2069556207. +660378762 = -1543929701 bxor -2069556207. +1076199493 = 1852148599 band 1085661261. +1861610367 = 1852148599 bor 1085661261. +785410874 = 1852148599 bxor 1085661261. +860161 = 572352531 band 76362825. +647855195 = 572352531 bor 76362825. +646995034 = 572352531 bxor 76362825. +-932691963 = -345214353 band -932459515. +-344981905 = -345214353 bor -932459515. +587710058 = -345214353 bxor -932459515. +-2048785791 = -1510488437 band -1914559615. +-1376262261 = -1510488437 bor -1914559615. +672523530 = -1510488437 bxor -1914559615. +1074282533 = 1754939495 band 1158444733. +1839101695 = 1754939495 bor 1158444733. +764819162 = 1754939495 bxor 1158444733. +16793601 = 587234307 band 160350649. +730791355 = 587234307 bor 160350649. +713997754 = 587234307 bxor 160350649. +-1056915371 = -385559201 band -1018118027. +-346761857 = -385559201 bor -1018118027. +710153514 = -385559201 bxor -1018118027. +-2033620879 = -1479841669 band -2030440719. +-1476661509 = -1479841669 bor -2030440719. +556959370 = -1479841669 bxor -2030440719. +1074528517 = 1620971863 band 1110280493. +1656723839 = 1620971863 bor 1110280493. +582195322 = 1620971863 bxor 1110280493. +92277537 = 629697523 band 260475689. +797895675 = 629697523 bor 260475689. +705618138 = 629697523 bxor 260475689. +-1038905275 = -474753969 band -833376027. +-269224721 = -474753969 bor -833376027. +769680554 = -474753969 bxor -833376027. +-2113706399 = -1484560789 band -1978435999. +-1349290389 = -1484560789 bor -1978435999. +764416010 = -1484560789 bxor -1978435999. +1142953477 = 1718615623 band 1303386013. +1879048159 = 1718615623 bor 1303386013. +736094682 = 1718615623 bxor 1303386013. +169873537 = 715405283 band 242978969. +788510715 = 715405283 bor 242978969. +618637178 = 715405283 bxor 242978969. +-934802155 = -329748673 band -890528427. +-285474945 = -329748673 bor -890528427. +649327210 = -329748673 bxor -890528427. +-2147188655 = -1527857061 band -1995064879. +-1375733285 = -1527857061 bor -1995064879. +771455370 = -1527857061 bxor -1995064879. +1087046149 = 1741621047 band 1089151501. +1743726399 = 1741621047 bor 1089151501. +656680250 = 1741621047 bxor 1089151501. +201380353 = 755163091 band 238342665. +792125403 = 755163091 bor 238342665. +590745050 = 755163091 bxor 238342665. +-1073642491 = -376330705 band -967866939. +-270555153 = -376330705 bor -967866939. +803087338 = -376330705 bxor -967866939. +-2122043327 = -1583581621 band -1918387903. +-1379926197 = -1583581621 bor -1918387903. +742117130 = -1583581621 bxor -1918387903. +1076897829 = 1614425127 band 1224059005. +1761586303 = 1614425127 bor 1224059005. +684688474 = 1614425127 bxor 1224059005. +1131329 = 554918851 band 104419193. +658206715 = 554918851 bor 104419193. +657075386 = 554918851 bxor 104419193. +-1053399019 = -406947553 band -914986443. +-268534977 = -406947553 bor -914986443. +784864042 = -406947553 bxor -914986443. +-2146435023 = -1596225477 band -1993313103. +-1443103557 = -1596225477 bor -1993313103. +703331466 = -1596225477 bxor -1993313103. +1084237829 = 1760587031 band 1185327853. +1861677055 = 1760587031 bor 1185327853. +777439226 = 1760587031 bxor 1185327853. +83886241 = 621069235 band 231737577. +768920571 = 621069235 bor 231737577. +685034330 = 621069235 bxor 231737577. +-938129403 = -386013169 band -921220443. +-369104209 = -386013169 bor -921220443. +569025194 = -386013169 bxor -921220443. +-2070748127 = -1480919509 band -2066289631. +-1476461013 = -1480919509 bor -2066289631. +594287114 = -1480919509 bxor -2066289631. +1217398789 = 1760610823 band 1318398301. +1861610335 = 1760610823 bor 1318398301. +644211546 = 1760610823 bxor 1318398301. +12975617 = 549846947 band 201326169. +738197499 = 549846947 bor 201326169. +725221882 = 549846947 bxor 201326169. +-987225579 = -449907969 band -978770155. +-441452545 = -449907969 bor -978770155. +545773034 = -449907969 bxor -978770155. +-2130706415 = -1391869925 band -2122178671. +-1383342181 = -1391869925 bor -2122178671. +747364234 = -1391869925 bxor -2122178671. +1075315397 = 1694122743 band 1226318797. +1845126143 = 1694122743 bor 1226318797. +769810746 = 1694122743 bxor 1226318797. +100665217 = 637933459 band 126889929. +664158171 = 637933459 bor 126889929. +563492954 = 637933459 bxor 126889929. +-916416123 = -370107921 band -882704507. +-336396305 = -370107921 bor -882704507. +580019818 = -370107921 bxor -882704507. +-2125462015 = -1453922805 band -2015817983. +-1344278773 = -1453922805 bor -2015817983. +781183242 = -1453922805 bxor -2015817983. +1107464741 = 1871435751 band 1111923261. +1875894271 = 1871435751 bor 1111923261. +768429530 = 1871435751 bxor 1111923261. +264449 = 540281731 band 117939513. +657956795 = 540281731 bor 117939513. +657692346 = 540281731 bxor 117939513. +-1037971243 = -358490913 band -1036266507. +-356786177 = -358490913 bor -1036266507. +681185066 = -358490913 bxor -1036266507. +-2143280527 = -1494128645 band -2008892815. +-1359740933 = -1494128645 bor -2008892815. +783539594 = -1494128645 bxor -2008892815. +1222936709 = 1759807703 band 1240960173. +1777831167 = 1759807703 bor 1240960173. +554894458 = 1759807703 bxor 1240960173. +2900513 = 612293491 band 11355817. +620748795 = 612293491 bor 11355817. +617848282 = 612293491 bxor 11355817. +-1067409339 = -530465841 band -840260507. +-303317009 = -530465841 bor -840260507. +764092330 = -530465841 bxor -840260507. +-2132803103 = -1578613269 band -1964629535. +-1410439701 = -1578613269 bor -1964629535. +722363402 = -1578613269 bxor -1964629535. +1124159749 = 1862489543 band 1136786205. +1875115999 = 1862489543 bor 1136786205. +750956250 = 1862489543 bxor 1136786205. +8389633 = 567641955 band 176696345. +735948667 = 567641955 bor 176696345. +727559034 = 567641955 bxor 176696345. +-939118443 = -368101697 band -840535851. +-269519105 = -368101697 bor -840535851. +669599338 = -368101697 bxor -840535851. +-2012592815 = -1475706917 band -1884666543. +-1347780645 = -1475706917 bor -1884666543. +664812170 = -1475706917 bxor -1884666543. +1151607941 = 1839677111 band 1190978957. +1879048127 = 1839677111 bor 1190978957. +727440186 = 1839677111 bxor 1190978957. +4656385 = 552013651 band 174017929. +721375195 = 552013651 bor 174017929. +716718810 = 552013651 bxor 174017929. +-868218619 = -330740305 band -848938683. +-311460369 = -330740305 bor -848938683. +556758250 = -330740305 bxor -848938683. +-2010774335 = -1461250613 band -1909054271. +-1359530549 = -1461250613 bor -1909054271. +651243786 = -1461250613 bxor -1909054271. +1309623205 = 1850688423 band 1321159677. +1862224895 = 1850688423 bor 1321159677. +552601690 = 1850688423 bxor 1321159677. +69214785 = 606237507 band 96054009. +633076731 = 606237507 bor 96054009. +563861946 = 606237507 bxor 96054009. +-1050673003 = -512819041 band -1017053771. +-479199809 = -512819041 bor -1017053771. +571473194 = -512819041 bxor -1017053771. +-2051014607 = -1513289797 band -2047819727. +-1510094917 = -1513289797 bor -2047819727. +540919690 = -1513289797 bxor -2047819727. +1210065925 = 1748657303 band 1239428717. +1778020095 = 1748657303 bor 1239428717. +567954170 = 1748657303 bxor 1239428717. +26607649 = 666284851 band 31343721. +671020923 = 666284851 bor 31343721. +644413274 = 666284851 bxor 31343721. +-1064497659 = -375435377 band -1030898139. +-341835857 = -375435377 bor -1030898139. +722661802 = -375435377 bxor -1030898139. +-2147412575 = -1580509781 band -1912531039. +-1345628245 = -1580509781 bor -1912531039. +801784330 = -1580509781 bxor -1912531039. +1080459397 = 1617404295 band 1257671901. +1794616799 = 1617404295 bor 1257671901. +714157402 = 1617404295 bxor 1257671901. +26216705 = 563269411 band 64231897. +601284603 = 563269411 bor 64231897. +575067898 = 563269411 bxor 64231897. +-937346539 = -356959617 band -916227435. +-335840513 = -356959617 bor -916227435. +601506026 = -356959617 bxor -916227435. +-2130695407 = -1582235749 band -2058474735. +-1510015077 = -1582235749 bor -2058474735. +620680330 = -1582235749 bxor -2058474735. +1209098821 = 1771436663 band 1213818701. +1776156543 = 1771436663 bor 1213818701. +567057722 = 1771436663 bxor 1213818701. +6292225 = 560318227 band 6433609. +560459611 = 560318227 bor 6433609. +554167386 = 560318227 bxor 6433609. +-1072103163 = -530857617 band -1038535931. +-497290385 = -530857617 bor -1038535931. +574812778 = -530857617 bxor -1038535931. +-2146697087 = -1408432757 band -2105607551. +-1367343221 = -1408432757 bor -2105607551. +779353866 = -1408432757 bxor -2105607551. +1141124389 = 1682206567 band 1277148605. +1818230783 = 1682206567 bor 1277148605. +677106394 = 1682206567 bxor 1277148605. +923649 = 547265283 band 202340537. +748682171 = 547265283 bor 202340537. +747758522 = 547265283 bxor 202340537. +-1029315499 = -337255329 band -1029314699. +-337254529 = -337255329 bor -1029314699. +692060970 = -337255329 bxor -1029314699. +-2127952527 = -1456576645 band -2080733711. +-1409357829 = -1456576645 bor -2080733711. +718594698 = -1456576645 bxor -2080733711. +1142947845 = 1857159255 band 1142984749. +1857196159 = 1857159255 bor 1142984749. +714248314 = 1857159255 bxor 1142984749. +35652129 = 577522419 band 186843689. +728713979 = 577522419 bor 186843689. +693061850 = 577522419 bxor 186843689. +-1002405051 = -461986993 band -859793435. +-319375377 = -461986993 bor -859793435. +683029674 = -461986993 bxor -859793435. +-2094791327 = -1557912213 band -1880634015. +-1343754901 = -1557912213 bor -1880634015. +751036426 = -1557912213 bxor -1880634015. +1087409157 = 1692249415 band 1106435741. +1711275999 = 1692249415 bor 1106435741. +623866842 = 1692249415 bxor 1106435741. +27379329 = 599643875 band 27510681. +599775227 = 599643875 bor 27510681. +572395898 = 599643875 bxor 27510681. +-991935467 = -420676033 band -840940459. +-269681025 = -420676033 bor -840940459. +722254442 = -420676033 bxor -840940459. +-2077421487 = -1514324133 band -2077372207. +-1514274853 = -1514324133 bor -2077372207. +563146634 = -1514324133 bxor -2077372207. +1082400773 = 1619424823 band 1257089293. +1794113343 = 1619424823 bor 1257089293. +711712570 = 1619424823 bxor 1257089293. +54528001 = 725761747 band 56150281. +727384027 = 725761747 bor 56150281. +672856026 = 725761747 bxor 56150281. +-987503611 = -437783249 band -818156347. +-268435985 = -437783249 bor -818156347. +719067626 = -437783249 bxor -818156347. +-2046783423 = -1366772405 band -2039246783. +-1359235765 = -1366772405 bor -2039246783. +687547658 = -1366772405 bxor -2039246783. +1210272549 = 1764449063 band 1210576765. +1764753279 = 1764449063 bor 1210576765. +554480730 = 1764449063 bxor 1210576765. +21496385 = 694715075 band 63506041. +736724731 = 694715075 bor 63506041. +715228346 = 694715075 bxor 63506041. +-1044217835 = -372864993 band -976580299. +-305227457 = -372864993 bor -976580299. +738990378 = -372864993 bxor -976580299. +-2080373967 = -1395292357 band -2078274639. +-1393193029 = -1395292357 bor -2078274639. +687180938 = -1395292357 bxor -2078274639. +1141379077 = 1678466071 band 1182314989. +1719401983 = 1678466071 bor 1182314989. +578022906 = 1678466071 bxor 1182314989. +1778337 = 677356211 band 104562665. +780140539 = 677356211 bor 104562665. +778362202 = 677356211 bxor 104562665. +-1073532667 = -525879537 band -1035783771. +-488130641 = -525879537 bor -1035783771. +585402026 = -525879537 bxor -1035783771. +-2146303711 = -1582123733 band -2108013791. +-1543833813 = -1582123733 bor -2108013791. +602469898 = -1582123733 bxor -2108013791. +1143238661 = 1680177415 band 1182199901. +1719138655 = 1680177415 bor 1182199901. +575899994 = 1680177415 bxor 1182199901. +202773505 = 739679907 band 230110553. +767016955 = 739679907 bor 230110553. +564243450 = 739679907 bxor 230110553. +-1073184747 = -295009793 band -1055076843. +-276901889 = -295009793 bor -1055076843. +796282858 = -295009793 bxor -1055076843. +-1911998959 = -1343275237 band -1911998831. +-1343275109 = -1343275237 bor -1911998831. +568723850 = -1343275237 bxor -1911998831. +1211670725 = 1782100471 band 1283041997. +1853471743 = 1782100471 bor 1283041997. +641801018 = 1782100471 bxor 1283041997. +9857 = 574387859 band 218310345. +792688347 = 574387859 bor 218310345. +792678490 = 574387859 bxor 218310345. +-930324347 = -324146961 band -896637307. +-290459921 = -324146961 bor -896637307. +639864426 = -324146961 bxor -896637307. +-2012077055 = -1407572725 band -1949047295. +-1344542965 = -1407572725 bor -1949047295. +667534090 = -1407572725 bxor -1949047295. +1082392613 = 1690568423 band 1083695421. +1691871231 = 1690568423 bor 1083695421. +609478618 = 1690568423 bxor 1083695421. +33554433 = 574630531 band 111563833. +652639931 = 574630531 bor 111563833. +619085498 = 574630531 bxor 111563833. +-1031738667 = -355406881 band -1030817035. +-354485249 = -355406881 bor -1030817035. +677253418 = -355406881 bxor -1030817035. +-2013249423 = -1400740101 band -2011082383. +-1398573061 = -1400740101 bor -2011082383. +614676362 = -1400740101 bxor -2011082383. +1073746821 = 1611036631 band 1319670701. +1856960511 = 1611036631 bor 1319670701. +783213690 = 1611036631 bxor 1319670701. +205568033 = 760265331 band 216513961. +771211259 = 760265331 bor 216513961. +565643226 = 760265331 bxor 216513961. +-925857211 = -302871857 band -925529243. +-302543889 = -302871857 bor -925529243. +623313322 = -302871857 bxor -925529243. +-2129657631 = -1456012053 band -2028439327. +-1354793749 = -1456012053 bor -2028439327. +774863882 = -1456012053 bxor -2028439327. +1145176069 = 1711211719 band 1178780189. +1744815839 = 1711211719 bor 1178780189. +599639770 = 1711211719 bxor 1178780189. +4989441 = 777856611 band 30303001. +803170171 = 777856611 bor 30303001. +798180730 = 777856611 bxor 30303001. +-1060043371 = -521026113 band -925296683. +-386279425 = -521026113 bor -925296683. +673763946 = -521026113 bxor -925296683. +-2080351151 = -1408827685 band -2069865391. +-1398341925 = -1408827685 bor -2069865391. +682009226 = -1408827685 bxor -2069865391. +1244408965 = 1852616119 band 1253928077. +1862135231 = 1852616119 bor 1253928077. +617726266 = 1852616119 bxor 1253928077. +33571841 = 705982035 band 119620745. +792030939 = 705982035 bor 119620745. +758459098 = 705982035 bxor 119620745. +-1069514747 = -462578513 band -909074363. +-302138129 = -462578513 bor -909074363. +767376618 = -462578513 bxor -909074363. +-2147397439 = -1602136885 band -2074084415. +-1528823861 = -1602136885 bor -2074084415. +618573578 = -1602136885 bxor -2074084415. +1108218533 = 1859023527 band 1127191293. +1877996287 = 1859023527 bor 1127191293. +769777754 = 1859023527 bxor 1127191293. +241500225 = 786797123 band 241656313. +786953211 = 786797123 bor 241656313. +545452986 = 786797123 bxor 241656313. +-830405483 = -289075297 band -827120459. +-285790273 = -289075297 bor -827120459. +544615210 = -289075297 bxor -827120459. +-2118908367 = -1544223045 band -2118232271. +-1543546949 = -1544223045 bor -2118232271. +575361418 = -1544223045 bxor -2118232271. +1247809797 = 1784894359 band 1248867693. +1785952255 = 1784894359 bor 1248867693. +538142458 = 1784894359 bxor 1248867693. +15176225 = 620728883 band 149404521. +754957179 = 620728883 bor 149404521. +739780954 = 620728883 bxor 149404521. +-1005124603 = -334029169 band -969431771. +-298336337 = -334029169 bor -969431771. +706788266 = -334029169 bxor -969431771. +-2057304927 = -1519315797 band -1880985951. +-1342996821 = -1519315797 bor -1880985951. +714308106 = -1519315797 bxor -1880985951. +1107447941 = 1646940295 band 1326863325. +1866355679 = 1646940295 bor 1326863325. +758907738 = 1646940295 bxor 1326863325. +100745217 = 777088547 band 128536793. +804880123 = 777088547 bor 128536793. +704134906 = 777088547 bxor 128536793. +-901775083 = -297612929 band -892001899. +-287839745 = -297612929 bor -892001899. +613935338 = -297612929 bxor -892001899. +-2122300911 = -1513849189 band -1984740847. +-1376289125 = -1513849189 bor -1984740847. +746011786 = -1513849189 bxor -1984740847. +1080059973 = 1692559735 band 1131998797. +1744498559 = 1692559735 bor 1131998797. +664438586 = 1692559735 bxor 1131998797. +33694209 = 646587923 band 192094793. +804988507 = 646587923 bor 192094793. +771294298 = 646587923 bxor 192094793. +-1061023739 = -320401297 band -1027433979. +-286811537 = -320401297 bor -1027433979. +774212202 = -320401297 bxor -1027433979. +-2125053823 = -1484897141 band -2116562559. +-1476405877 = -1484897141 bor -2116562559. +648647946 = -1484897141 bxor -2116562559. +1292502053 = 1862966887 band 1303315645. +1873780479 = 1862966887 bor 1303315645. +581278426 = 1862966887 bxor 1303315645. +535041 = 588823043 band 80490425. +668778427 = 588823043 bor 80490425. +668243386 = 588823043 bxor 80490425. +-983432619 = -446500001 band -805892491. +-268959873 = -446500001 bor -805892491. +714472746 = -446500001 bxor -805892491. +-2103114639 = -1360173445 band -2101928719. +-1358987525 = -1360173445 bor -2101928719. +744127114 = -1360173445 bxor -2101928719. +1115784965 = 1793191767 band 1200592685. +1877999487 = 1793191767 bor 1200592685. +762214522 = 1793191767 bxor 1200592685. +52963617 = 590096883 band 66812201. +603945467 = 590096883 bor 66812201. +550981850 = 590096883 bxor 66812201. +-1073647035 = -355110321 band -1071022363. +-352485649 = -355110321 bor -1071022363. +721161386 = -355110321 bxor -1071022363. +-2111822751 = -1574902677 band -1904728991. +-1367808917 = -1574902677 bor -1904728991. +744013834 = -1574902677 bxor -1904728991. +1075905541 = 1617386567 band 1320265117. +1861746143 = 1617386567 bor 1320265117. +785840602 = 1617386567 bxor 1320265117. +151221377 = 800290275 band 151518873. +800587771 = 800290275 bor 151518873. +649366394 = 800290275 bxor 151518873. +-1005549291 = -434270913 band -858723499. +-287445121 = -434270913 bor -858723499. +718104170 = -434270913 bxor -858723499. +-2013157807 = -1461207461 band -1895700527. +-1343750181 = -1461207461 bor -1895700527. +669407626 = -1461207461 bxor -1895700527. +1145577477 = 1700390199 band 1147940877. +1702753599 = 1700390199 bor 1147940877. +557176122 = 1700390199 bxor 1147940877. +51937281 = 727555539 band 62439433. +738057691 = 727555539 bor 62439433. +686120410 = 727555539 bxor 62439433. +-1056948219 = -438680529 band -886811707. +-268544017 = -438680529 bor -886811707. +788404202 = -438680529 bxor -886811707. +-2066717631 = -1395592117 band -2047121599. +-1375996085 = -1395592117 bor -2047121599. +690721546 = -1395592117 bxor -2047121599. +1292894757 = 1832421927 band 1305884285. +1845411455 = 1832421927 bor 1305884285. +552516698 = 1832421927 bxor 1305884285. +43032897 = 580493763 band 60079481. +597540347 = 580493763 bor 60079481. +554507450 = 580493763 bxor 60079481. +-871722987 = -295004385 band -870664139. +-293945537 = -295004385 bor -870664139. +577777450 = -295004385 bxor -870664139. +-2012511695 = -1456765381 band -1932811599. +-1377065285 = -1456765381 bor -1932811599. +635446410 = -1456765381 bxor -1932811599. +1094846469 = 1765952279 band 1137096941. +1808202751 = 1765952279 bor 1137096941. +713356282 = 1765952279 bxor 1137096941. +58884257 = 731283891 band 132314857. +804714491 = 731283891 bor 132314857. +745830234 = 731283891 bxor 132314857. +-932642811 = -370309617 band -865396571. +-303063377 = -370309617 bor -865396571. +629579434 = -370309617 bxor -865396571. +-2147479519 = -1425640405 band -2070308319. +-1348469205 = -1425640405 bor -2070308319. +799010314 = -1425640405 bxor -2070308319. +1079255045 = 1752573959 band 1121236829. +1794555743 = 1752573959 bor 1121236829. +715300698 = 1752573959 bxor 1121236829. +100805633 = 641940899 band 262827097. +803962363 = 641940899 bor 262827097. +703156730 = 641940899 bxor 262827097. +-1073737707 = -398323457 band -997427947. +-322013697 = -398323457 bor -997427947. +751724010 = -398323457 bxor -997427947. +-2147480559 = -1590641125 band -2041819759. +-1484980325 = -1590641125 bor -2041819759. +662500234 = -1590641125 bxor -2041819759. +1125327045 = 1737695479 band 1264005581. +1876374015 = 1737695479 bor 1264005581. +751046970 = 1737695479 bxor 1264005581. +134354305 = 743363987 band 162667977. +771677659 = 743363987 bor 162667977. +637323354 = 743363987 bxor 162667977. +-939195003 = -284739601 band -927609467. +-273154065 = -284739601 bor -927609467. +666040938 = -284739601 bxor -927609467. +-2146950143 = -1405524981 band -2104836863. +-1363411701 = -1405524981 bor -2104836863. +783538442 = -1405524981 bxor -2104836863. +1090527269 = 1628976615 band 1097148477. +1635597823 = 1628976615 bor 1097148477. +545070554 = 1628976615 bxor 1097148477. +2305 = 556288387 band 75565881. +631851963 = 556288387 bor 75565881. +631849658 = 556288387 bxor 75565881. +-929423147 = -375653665 band -924966411. +-371196929 = -375653665 bor -924966411. +558226218 = -375653665 bxor -924966411. +-2144640911 = -1368431109 band -2118391695. +-1342181893 = -1368431109 bor -2118391695. +802459018 = -1368431109 bxor -2118391695. +1279525509 = 1833199319 band 1289067181. +1842740991 = 1833199319 bor 1289067181. +563215482 = 1833199319 bxor 1289067181. +6164513 = 570333555 band 241054889. +805223931 = 570333555 bor 241054889. +799059418 = 570333555 bxor 241054889. +-1071886267 = -383821361 band -1061391771. +-373326865 = -383821361 bor -1061391771. +698559402 = -383821361 bxor -1061391771. +-2147433503 = -1411267605 band -2079928351. +-1343762453 = -1411267605 bor -2079928351. +803671050 = -1411267605 bxor -2079928351. +1075216645 = 1645654983 band 1228900637. +1799338975 = 1645654983 bor 1228900637. +724122330 = 1645654983 bxor 1228900637. +88113153 = 633390435 band 89168409. +634445691 = 633390435 bor 89168409. +546332538 = 633390435 bxor 89168409. +-1002433387 = -462400321 band -943210795. +-403177729 = -462400321 bor -943210795. +599255658 = -462400321 bxor -943210795. +-2142080687 = -1436582437 band -2125302959. +-1419804709 = -1436582437 bor -2125302959. +722275978 = -1436582437 bxor -2125302959. +1095241861 = 1666063543 band 1174008717. +1744830399 = 1666063543 bor 1174008717. +649588538 = 1666063543 bxor 1174008717. +85788929 = 756927827 band 119487369. +790626267 = 756927827 bor 119487369. +704837338 = 756927827 bxor 119487369. +-1071316219 = -399643729 band -1053358267. +-381685777 = -399643729 bor -1053358267. +689630442 = -399643729 bxor -1053358267. +-2126146879 = -1585998901 band -1991912767. +-1451764789 = -1585998901 bor -1991912767. +674382090 = -1585998901 bxor -1991912767. +1107919269 = 1651089831 band 1176230397. +1719400959 = 1651089831 bor 1176230397. +611481690 = 1651089831 bxor 1176230397. +4161 = 579121475 band 22092025. +601209339 = 579121475 bor 22092025. +601205178 = 579121475 bxor 22092025. +-1006564715 = -424206689 band -872330315. +-289972289 = -424206689 bor -872330315. +716592426 = -424206689 bxor -872330315. +-2109668303 = -1434909253 band -2092437967. +-1417678917 = -1434909253 bor -2092437967. +691989386 = -1434909253 bxor -2092437967. +1076363269 = 1856520855 band 1081883757. +1862041343 = 1856520855 bor 1081883757. +785678074 = 1856520855 bxor 1081883757. +2371617 = 707031347 band 19739241. +724398971 = 707031347 bor 19739241. +722027354 = 707031347 bxor 19739241. +-1073181691 = -399839857 band -1025668059. +-352326225 = -399839857 bor -1025668059. +720855466 = -399839857 bxor -1025668059. +-2139962975 = -1603087445 band -1904228959. +-1367353429 = -1603087445 bor -1904228959. +772609546 = -1603087445 bxor -1904228959. +1157634693 = 1695088519 band 1337072349. +1874526175 = 1695088519 bor 1337072349. +716891482 = 1695088519 bxor 1337072349. +27788545 = 569117987 band 62556121. +603885563 = 569117987 bor 62556121. +576097018 = 569117987 bxor 62556121. +-935311339 = -362260353 band -868038507. +-294987521 = -362260353 bor -868038507. +640323818 = -362260353 bxor -868038507. +-2146412271 = -1607205477 band -2116789999. +-1577583205 = -1607205477 bor -2116789999. +568829066 = -1607205477 bxor -2116789999. +1073762373 = 1615517815 band 1108637005. +1650392447 = 1615517815 bor 1108637005. +576630074 = 1615517815 bxor 1108637005. +25166081 = 562726163 band 96475465. +634035547 = 562726163 bor 96475465. +608869466 = 562726163 bxor 96475465. +-1073217275 = -519151761 band -899153659. +-345088145 = -519151761 bor -899153659. +728129130 = -519151761 bxor -899153659. +-2008514431 = -1471446133 band -1947424639. +-1410356341 = -1471446133 bor -1947424639. +598158090 = -1471446133 bxor -1947424639. +1218988325 = 1760349543 band 1236945853. +1778307071 = 1760349543 bor 1236945853. +559318746 = 1760349543 bxor 1236945853. +38060033 = 711907587 band 63235769. +737083323 = 711907587 bor 63235769. +699023290 = 711907587 bxor 63235769. +-1052508075 = -444857761 band -884722315. +-277072001 = -444857761 bor -884722315. +775436074 = -444857761 bxor -884722315. +-2130173583 = -1459067525 band -2094025743. +-1422919685 = -1459067525 bor -2094025743. +707253898 = -1459067525 bxor -2094025743. +1143512581 = 1697504855 band 1283104301. +1837096575 = 1697504855 bor 1283104301. +693583994 = 1697504855 bxor 1283104301. +34078753 = 667420915 band 168816681. +802158843 = 667420915 bor 168816681. +768080090 = 667420915 bxor 168816681. +-1065336507 = -422559409 band -930191899. +-287414801 = -422559409 bor -930191899. +777921706 = -422559409 bxor -930191899. +-2076171423 = -1535532181 band -2050720927. +-1510081685 = -1535532181 bor -2050720927. +566089738 = -1535532181 bxor -2050720927. +1091307525 = 1762462535 band 1139567773. +1810722783 = 1762462535 bor 1139567773. +719415258 = 1762462535 bxor 1139567773. +75502721 = 780473571 band 78132633. +783103483 = 780473571 bor 78132633. +707600762 = 780473571 bxor 78132633. +-1045950443 = -370533313 band -943877547. +-268460417 = -370533313 bor -943877547. +777490026 = -370533313 bxor -943877547. +-2013250479 = -1368507045 band -1986920751. +-1342177317 = -1368507045 bor -1986920751. +671073162 = -1368507045 bxor -1986920751. +1145050117 = 1716081719 band 1298577165. +1869608767 = 1716081719 bor 1298577165. +724558650 = 1716081719 bxor 1298577165. +223654913 = 760544467 band 257210121. +794099675 = 760544467 bor 257210121. +570444762 = 760544467 bxor 257210121. +-938962427 = -379022545 band -905397563. +-345457681 = -379022545 bor -905397563. +593504746 = -379022545 bxor -905397563. +-1942670783 = -1401605301 band -1942012351. +-1400946869 = -1401605301 bor -1942012351. +541723914 = -1401605301 bxor -1942012351. +1207974181 = 1818343719 band 1241546109. +1851915647 = 1818343719 bor 1241546109. +643941466 = 1818343719 bxor 1241546109. +75776065 = 749125827 band 94139513. +767489275 = 749125827 bor 94139513. +691713210 = 749125827 bxor 94139513. +-1004370411 = -441801185 band -865673419. +-303104193 = -441801185 bor -865673419. +701266218 = -441801185 bxor -865673419. +-2129592015 = -1512209093 band -2093794895. +-1476411973 = -1512209093 bor -2093794895. +653180042 = -1512209093 bxor -2093794895. +1217411589 = 1754610199 band 1318109165. +1855307775 = 1754610199 bor 1318109165. +637896186 = 1754610199 bxor 1318109165. +41967777 = 782852275 band 46558697. +787443195 = 782852275 bor 46558697. +745475418 = 782852275 bxor 46558697. +-997305083 = -456174321 band -946929755. +-405798993 = -456174321 bor -946929755. +591506090 = -456174321 bxor -946929755. +-2087440095 = -1548340437 band -1953173215. +-1414073557 = -1548340437 bor -1953173215. +673366538 = -1548340437 bxor -1953173215. +1101157893 = 1709364999 band 1135509085. +1743716191 = 1709364999 bor 1135509085. +642558298 = 1709364999 bxor 1135509085. +21594113 = 793500835 band 31040345. +802947067 = 793500835 bor 31040345. +781352954 = 793500835 bxor 31040345. +-1028645867 = -491413505 band -805823467. +-268591105 = -491413505 bor -805823467. +760054762 = -491413505 bxor -805823467. +-2142624751 = -1597096677 band -1974770543. +-1429242469 = -1597096677 bor -1974770543. +713382282 = -1597096677 bxor -1974770543. +1157662917 = 1829343223 band 1169209549. +1840889855 = 1829343223 bor 1169209549. +683226938 = 1829343223 bxor 1169209549. +69014657 = 607990931 band 228398281. +767374555 = 607990931 bor 228398281. +698359898 = 607990931 bxor 228398281. +-1059584891 = -520321297 band -975620987. +-436357393 = -520321297 bor -975620987. +623227498 = -520321297 bxor -975620987. +-1984659455 = -1447779573 band -1946315775. +-1409435893 = -1447779573 bor -1946315775. +575223562 = -1447779573 bxor -1946315775. +1149789221 = 1686660327 band 1152282429. +1689153535 = 1686660327 bor 1152282429. +539364314 = 1686660327 bxor 1152282429. +8667137 = 753690755 band 9945657. +754969275 = 753690755 bor 9945657. +746302138 = 753690755 bxor 9945657. +-989787947 = -419231265 band -987150091. +-416593409 = -419231265 bor -987150091. +573194538 = -419231265 bxor -987150091. +-2079300495 = -1397201669 band -2062385295. +-1380286469 = -1397201669 bor -2062385295. +699014026 = -1397201669 bxor -2062385295. diff --git a/erts/emulator/test/big_SUITE_data/eq_big.dat b/erts/emulator/test/big_SUITE_data/eq_big.dat new file mode 100644 index 0000000000..5511d1bf10 --- /dev/null +++ b/erts/emulator/test/big_SUITE_data/eq_big.dat @@ -0,0 +1,13004 @@ +3627225882 = -697 + 3627226579. +-3627227276 = -697 - 3627226579. +-2528176925563 = -697 * 3627226579. +697 = -(-697). +-697 = +(-697). +0 = -697 div 3627226579. +-697 = -697 rem 3627226579. +3627226435 = -697 band 3627226579. +-553 = -697 bor 3627226579. +-3627226988 = -697 bxor 3627226579. +696 = bnot(-697). +-1 = -697 bsl -61. +-1607172577421944684544 = -697 bsr -61. +-283388912239615 = -283388912239613 + -2. +-283388912239611 = -283388912239613 - -2. +566777824479226 = -283388912239613 * -2. +283388912239613 = -(-283388912239613). +-283388912239613 = +(-283388912239613). +141694456119806 = -283388912239613 div -2. +-1 = -283388912239613 rem -2. +-283388912239614 = -283388912239613 band -2. +-1 = -283388912239613 bor -2. +283388912239613 = -283388912239613 bxor -2. +283388912239612 = bnot(-283388912239613). +-104896167137483835127591520601167100453480347078199925156632915223228188306305878154109985624943277357501787279310034030156370067160844817777591157023073455111626047495778039507502639061242015835277440456218702874565483838389693116456108032 = -283388912239613 bsl 746. +-1 = -283388912239613 bsr 746. +899396154689163167548626101 = 899396154689163167641847368 + -93221267. +899396154689163167735068635 = 899396154689163167641847368 - -93221267. +-83842849075051781657306413865575256 = 899396154689163167641847368 * -93221267. +-899396154689163167641847368 = -(899396154689163167641847368). +899396154689163167641847368 = +(899396154689163167641847368). +-9647971794774717743 = 899396154689163167641847368 div -93221267. +72006987 = 899396154689163167641847368 rem -93221267. +899396154689163167574066760 = 899396154689163167641847368 band -93221267. +-25440659 = 899396154689163167641847368 bor -93221267. +-899396154689163167599507419 = 899396154689163167641847368 bxor -93221267. +-899396154689163167641847369 = bnot(899396154689163167641847368). +0 = 899396154689163167641847368 bsl -253. +13017869975433327806566054549187146850478372938959200496342626543873703998010638391600224608668463661056 = 899396154689163167641847368 bsr -253. +38353289727271510973285999751 = 887666814621463939 + 38353289726383844158664535812. +-38353289725496177344043071873 = 887666814621463939 - 38353289726383844158664535812. +34044942521673265192360995015832746373332083468 = 887666814621463939 * 38353289726383844158664535812. +-887666814621463939 = -(887666814621463939). +887666814621463939 = +(887666814621463939). +0 = 887666814621463939 div 38353289726383844158664535812. +887666814621463939 = 887666814621463939 rem 38353289726383844158664535812. +594616166601860352 = 887666814621463939 band 38353289726383844158664535812. +38353289726676894806684139399 = 887666814621463939 bor 38353289726383844158664535812. +38353289726082278640082279047 = 887666814621463939 bxor 38353289726383844158664535812. +-887666814621463940 = bnot(887666814621463939). +0 = 887666814621463939 bsl -787. +722531143980030224978407003366379878572019340627220673638308476197912211331706163856015044590466259639511920085355248108717151013626249732488736624553440916080782402468384420123415848619840265859350798319617560713791523384835232073919483231937051903393792 = 887666814621463939 bsr -787. +-8515461716215666486977884 = -8515461716215666492151278 + 5173394. +-8515461716215666497324672 = -8515461716215666492151278 - 5173394. +-44053838549899831736496468697532 = -8515461716215666492151278 * 5173394. +8515461716215666492151278 = -(-8515461716215666492151278). +-8515461716215666492151278 = +(-8515461716215666492151278). +-1646010668473282045 = -8515461716215666492151278 div 5173394. +-240548 = -8515461716215666492151278 rem 5173394. +417810 = -8515461716215666492151278 band 5173394. +-8515461716215666487395694 = -8515461716215666492151278 bor 5173394. +-8515461716215666487813504 = -8515461716215666492151278 bxor 5173394. +8515461716215666492151277 = bnot(-8515461716215666492151278). +-1 = -8515461716215666492151278 bsl -594. +-552110015119483874455401000114182509753848554122155066504811641532970839680006262116242666380962025577884962904613845097544935294020129261657550847020494270805103895692818062392457706943718836114766692352 = -8515461716215666492151278 bsr -594. +-251589684634846873123391 = -251589684634846873115962 + -7429. +-251589684634846873108533 = -251589684634846873115962 - -7429. +1869059767152277420378481698 = -251589684634846873115962 * -7429. +251589684634846873115962 = -(-251589684634846873115962). +-251589684634846873115962 = +(-251589684634846873115962). +33865888361131629171 = -251589684634846873115962 div -7429. +-4603 = -251589684634846873115962 rem -7429. +-251589684634846873115966 = -251589684634846873115962 band -7429. +-7425 = -251589684634846873115962 bor -7429. +251589684634846873108541 = -251589684634846873115962 bxor -7429. +251589684634846873115961 = bnot(-251589684634846873115962). +-491386102802435299055 = -251589684634846873115962 bsl -9. +-128813918533041599035372544 = -251589684634846873115962 bsr -9. +-871998795379825 = -871998795375248 + -4577. +-871998795370671 = -871998795375248 - -4577. +3991138486432510096 = -871998795375248 * -4577. +871998795375248 = -(-871998795375248). +-871998795375248 = +(-871998795375248). +190517543232 = -871998795375248 div -4577. +-2384 = -871998795375248 rem -4577. +-871998795379696 = -871998795375248 band -4577. +-129 = -871998795375248 bor -4577. +871998795379567 = -871998795375248 bxor -4577. +871998795375247 = bnot(-871998795375248). +-1624225 = -871998795375248 bsl -29. +-468150788536010775986176 = -871998795375248 bsr -29. +-2991637738047072853981278 = -22265889556864555 + -2991637715781183297116723. +2991637693515293740252168 = -22265889556864555 - -2991637715781183297116723. +66611474973734380901960088484083736453265 = -22265889556864555 * -2991637715781183297116723. +22265889556864555 = -(-22265889556864555). +-22265889556864555 = +(-22265889556864555). +0 = -22265889556864555 div -2991637715781183297116723. +-22265889556864555 = -22265889556864555 rem -2991637715781183297116723. +-2991637717189315254902331 = -22265889556864555 band -2991637715781183297116723. +-20857757599078947 = -22265889556864555 bor -2991637715781183297116723. +2991637696331557655823384 = -22265889556864555 bxor -2991637715781183297116723. +22265889556864554 = bnot(-22265889556864555). +-17698916545639237821347114552137310261435038803077739211627488090044459979816479609975948949711590599556505345935296144423539391408146296529089297996491904195783620894238607320078819402991090831482824833109254755662658020392150316325223984043875368960 = -22265889556864555 bsl 777. +-1 = -22265889556864555 bsr 777. +-921330394855903 = -5867913648 + -921324526942255. +921318659028607 = -5867913648 - -921324526942255. +5406252765881601822396240 = -5867913648 * -921324526942255. +5867913648 = -(-5867913648). +-5867913648 = +(-5867913648). +0 = -5867913648 div -921324526942255. +-5867913648 = -5867913648 rem -921324526942255. +-921330042534320 = -5867913648 band -921324526942255. +-352321583 = -5867913648 bor -921324526942255. +921329690212737 = -5867913648 bxor -921324526942255. +5867913647 = bnot(-5867913648). +-10070509970159717552275921442977953280617487172740969541904499886948034952538118239864941771032831232670760838938532099451694651006107378590139473654943040250130202624 = -5867913648 bsl 519. +-1 = -5867913648 bsr 519. +1423045349 = 535282818 + 887762531. +-352479713 = 535282818 - 887762531. +475204029308492358 = 535282818 * 887762531. +-535282818 = -(535282818). +535282818 = +(535282818). +0 = 535282818 div 887762531. +535282818 = 535282818 rem 887762531. +350356482 = 535282818 band 887762531. +1072688867 = 535282818 bor 887762531. +722332385 = 535282818 bxor 887762531. +-535282819 = bnot(535282818). +11595019119157717269464123722338130937385408762397230511002837033772286450351880310576900208963283084603926920717598384092802353509433344 = 535282818 bsl 423. +0 = 535282818 bsr 423. +-9526614229 = -9526614162 + -67. +-9526614095 = -9526614162 - -67. +638283148854 = -9526614162 * -67. +9526614162 = -(-9526614162). +-9526614162 = +(-9526614162). +142188271 = -9526614162 div -67. +-5 = -9526614162 rem -67. +-9526614228 = -9526614162 band -67. +-1 = -9526614162 bor -67. +9526614227 = -9526614162 bxor -67. +9526614161 = bnot(-9526614162). +-4877626450944 = -9526614162 bsl 9. +-18606669 = -9526614162 bsr 9. +-98623731973471913763537026123 = -96141273121197669237423453745 + -2482458852274244526113572378. +-93658814268923424711309881367 = -96141273121197669237423453745 - -2482458852274244526113572378. +238666754528633040727288330786331678776932078104792655610 = -96141273121197669237423453745 * -2482458852274244526113572378. +96141273121197669237423453745 = -(-96141273121197669237423453745). +-96141273121197669237423453745 = +(-96141273121197669237423453745). +38 = -96141273121197669237423453745 div -2482458852274244526113572378. +-1807836734776377245107703381 = -96141273121197669237423453745 rem -2482458852274244526113572378. +-98618669153224018419052574266 = -96141273121197669237423453745 band -2482458852274244526113572378. +-5062820247895344484451857 = -96141273121197669237423453745 bor -2482458852274244526113572378. +98613606332976123074568122409 = -96141273121197669237423453745 bxor -2482458852274244526113572378. +96141273121197669237423453744 = bnot(-96141273121197669237423453745). +-1 = -96141273121197669237423453745 bsl -221. +-323995449482431561430955688380557595865526794242980577682451215826215493438826396507655362314240 = -96141273121197669237423453745 bsr -221. +-96275818948398693347585066750 = -96275818948398693352364564443 + 4779497693. +-96275818948398693357144062136 = -96275818948398693352364564443 - 4779497693. +-460150054555557240921840871850268329999 = -96275818948398693352364564443 * 4779497693. +96275818948398693352364564443 = -(-96275818948398693352364564443). +-96275818948398693352364564443 = +(-96275818948398693352364564443). +-20143501500043237567 = -96275818948398693352364564443 div 4779497693. +-637131512 = -96275818948398693352364564443 rem 4779497693. +4703911941 = -96275818948398693352364564443 band 4779497693. +-96275818948398693352288978691 = -96275818948398693352364564443 bor 4779497693. +-96275818948398693356992890632 = -96275818948398693352364564443 bxor 4779497693. +96275818948398693352364564442 = bnot(-96275818948398693352364564443). +-770206551587189546818916515544 = -96275818948398693352364564443 bsl 3. +-12034477368549836669045570556 = -96275818948398693352364564443 bsr 3. +-272689270240 = -5873 + -272689264367. +272689258494 = -5873 - -272689264367. +1601504049627391 = -5873 * -272689264367. +5873 = -(-5873). +-5873 = +(-5873). +0 = -5873 div -272689264367. +-5873 = -5873 rem -272689264367. +-272689264383 = -5873 band -272689264367. +-5857 = -5873 bor -272689264367. +272689258526 = -5873 bxor -272689264367. +5872 = bnot(-5873). +-1469 = -5873 bsl -2. +-23492 = -5873 bsr -2. +13670759686 = 7826527119 + 5844232567. +1982294552 = 7826527119 - 5844232567. +45740044675368484473 = 7826527119 * 5844232567. +-7826527119 = -(7826527119). +7826527119 = +(7826527119). +1 = 7826527119 div 5844232567. +1982294552 = 7826527119 rem 5844232567. +5642862855 = 7826527119 band 5844232567. +8027896831 = 7826527119 bor 5844232567. +2385033976 = 7826527119 bxor 5844232567. +-7826527120 = bnot(7826527119). +17210715144889395314688 = 7826527119 bsl 41. +0 = 7826527119 bsr 41. +-4341394495791782339893875 = -4341394495791781981452416 + -358441459. +-4341394495791781623010957 = -4341394495791781981452416 - -358441459. +1556135777166175693641714930114944 = -4341394495791781981452416 * -358441459. +4341394495791781981452416 = -(-4341394495791781981452416). +-4341394495791781981452416 = +(-4341394495791781981452416). +12111864815815800 = -4341394495791781981452416 div -358441459. +-354200216 = -4341394495791781981452416 rem -358441459. +-4341394495791782271384064 = -4341394495791781981452416 band -358441459. +-68509811 = -4341394495791781981452416 bor -358441459. +4341394495791782202874253 = -4341394495791781981452416 bxor -358441459. +4341394495791781981452415 = bnot(-4341394495791781981452416). +-32345909593938157 = -4341394495791781981452416 bsl -27. +-582692105576878538621881415630848 = -4341394495791781981452416 bsr -27. +25613348061753413432805 = -62561418842848 + 25613348124314832275653. +-25613348186876251118501 = -62561418842848 - 25613348124314832275653. +-1602407399972935425479526309823579744 = -62561418842848 * 25613348124314832275653. +62561418842848 = -(-62561418842848). +-62561418842848 = +(-62561418842848). +0 = -62561418842848 div 25613348124314832275653. +-62561418842848 = -62561418842848 rem 25613348124314832275653. +25613348062046077323264 = -62561418842848 band 25613348124314832275653. +-292663890459 = -62561418842848 bor 25613348124314832275653. +-25613348062338741213723 = -62561418842848 bxor 25613348124314832275653. +62561418842847 = bnot(-62561418842848). +-619578282400515063188185698798133487599616 = -62561418842848 bsl 93. +-1 = -62561418842848 bsr 93. +-415145595976523548470677 = -21466329235395744132 + -415124129647288152726545. +415102663318052756982413 = -21466329235395744132 - -415124129647288152726545. +8911191240565794849702499410197724984383940 = -21466329235395744132 * -415124129647288152726545. +21466329235395744132 = -(-21466329235395744132). +-21466329235395744132 = +(-21466329235395744132). +0 = -21466329235395744132 div -415124129647288152726545. +-21466329235395744132 = -21466329235395744132 rem -415124129647288152726545. +-415124229342963475389844 = -21466329235395744132 band -415124129647288152726545. +-21366633560073080833 = -21466329235395744132 bor -415124129647288152726545. +415102862709403402309011 = -21466329235395744132 bxor -415124129647288152726545. +21466329235395744131 = bnot(-21466329235395744132). +-10990760568522620995584 = -21466329235395744132 bsl 9. +-41926424287882313 = -21466329235395744132 bsr 9. +76468874711569513325056778 = 76468874711569513317743546 + 7313232. +76468874711569513310430314 = 76468874711569513317743546 - 7313232. +559234621544640935019748268400672 = 76468874711569513317743546 * 7313232. +-76468874711569513317743546 = -(76468874711569513317743546). +76468874711569513317743546 = +(76468874711569513317743546). +10456235315872587293 = 76468874711569513317743546 div 7313232. +3782570 = 76468874711569513317743546 rem 7313232. +2429712 = 76468874711569513317743546 band 7313232. +76468874711569513322627066 = 76468874711569513317743546 bor 7313232. +76468874711569513320197354 = 76468874711569513317743546 bxor 7313232. +-76468874711569513317743547 = bnot(76468874711569513317743546). +0 = 76468874711569513317743546 bsl -746. +28304889556786495453831814324215420256373810154437575218925605423140242106417314289689964336921067023412402676980609685783148483385245613331457090830852471386788403077786640815058022739945601734382573174324776692555808679848887824494250404725122924544 = 76468874711569513317743546 bsr -746. +-5897699569812678369906 = -762 + -5897699569812678369144. +5897699569812678368382 = -762 - -5897699569812678369144. +4494047072197260917287728 = -762 * -5897699569812678369144. +762 = -(-762). +-762 = +(-762). +0 = -762 div -5897699569812678369144. +-762 = -762 rem -5897699569812678369144. +-5897699569812678369280 = -762 band -5897699569812678369144. +-626 = -762 bor -5897699569812678369144. +5897699569812678368654 = -762 bxor -5897699569812678369144. +761 = bnot(-762). +-1 = -762 bsl -47. +-107241966126759936 = -762 bsr -47. +93648805036749 = 93648894616213 + -89579464. +93648984195677 = 93648894616213 - -89579464. +-8389017783912846249832 = 93648894616213 * -89579464. +-93648894616213 = -(93648894616213). +93648894616213 = +(93648894616213). +-1045428 = 93648894616213 div -89579464. +14725621 = 93648894616213 rem -89579464. +93648809631760 = 93648894616213 band -89579464. +-4595011 = 93648894616213 bor -89579464. +-93648814226771 = 93648894616213 bxor -89579464. +-93648894616214 = bnot(93648894616213). +50277367460398163296256 = 93648894616213 bsl 29. +174434 = 93648894616213 bsr 29. +-5348788016 = -5287491547 + -61296469. +-5226195078 = -5287491547 - -61296469. +324104561698447543 = -5287491547 * -61296469. +5287491547 = -(-5287491547). +-5287491547 = +(-5287491547). +86 = -5287491547 div -61296469. +-15995213 = -5287491547 rem -61296469. +-5296357343 = -5287491547 band -61296469. +-52430673 = -5287491547 bor -61296469. +5243926670 = -5287491547 bxor -61296469. +5287491546 = bnot(-5287491547). +-1 = -5287491547 bsl -85. +-204549921669196753881551737878216704 = -5287491547 bsr -85. +762439979239339795156546850 = 762439979239339795156537669 + 9181. +762439979239339795156528488 = 762439979239339795156537669 - 9181. +6999961449396378659332172339089 = 762439979239339795156537669 * 9181. +-762439979239339795156537669 = -(762439979239339795156537669). +762439979239339795156537669 = +(762439979239339795156537669). +83045417627637489941894 = 762439979239339795156537669 div 9181. +8855 = 762439979239339795156537669 rem 9181. +325 = 762439979239339795156537669 band 9181. +762439979239339795156546525 = 762439979239339795156537669 bor 9181. +762439979239339795156546200 = 762439979239339795156537669 bxor 9181. +-762439979239339795156537670 = bnot(762439979239339795156537669). +45201673274459720178644042862458985496925598168922005361232603694334612864372839655498293719782600063582208 = 762439979239339795156537669 bsl 265. +0 = 762439979239339795156537669 bsr 265. +-556183529548738362375165 = -556183529548742715698331 + 4353323166. +-556183529548747069021497 = -556183529548742715698331 - 4353323166. +-2421246643732187190423296209835946 = -556183529548742715698331 * 4353323166. +556183529548742715698331 = -(-556183529548742715698331). +-556183529548742715698331 = +(-556183529548742715698331). +-127760680367725 = -556183529548742715698331 div 4353323166. +-4074480981 = -556183529548742715698331 rem 4353323166. +4348448772 = -556183529548742715698331 band 4353323166. +-556183529548742710823937 = -556183529548742715698331 bor 4353323166. +-556183529548747059272709 = -556183529548742715698331 bxor 4353323166. +556183529548742715698330 = bnot(-556183529548742715698331). +-164156403641570095641504089198946277272846336 = -556183529548742715698331 bsl 68. +-1885 = -556183529548742715698331 bsr 68. +-58828870360392725 = -58828872875851219 + 2515458494. +-58828875391309713 = -58828872875851219 - 2515458494. +-147981587968006156313804186 = -58828872875851219 * 2515458494. +58828872875851219 = -(-58828872875851219). +-58828872875851219 = +(-58828872875851219). +-23386938 = -58828872875851219 div 2515458494. +-1035099847 = -58828872875851219 rem 2515458494. +2174926892 = -58828872875851219 band 2515458494. +-58828872535319617 = -58828872875851219 bor 2515458494. +-58828874710246509 = -58828872875851219 bxor 2515458494. +58828872875851218 = bnot(-58828872875851219). +-1 = -58828872875851219 bsl -897. +-62157943626374948997432249001986780504201035968394074770676882720538609168733361134066329678956567940750449072796753898138503322952919077398530702139123003614916021436073293455615861224266659917484107541556523561584386197396750779974331385916265028971325138931043761240917394354411143168 = -58828872875851219 bsr -897. +958617833851552 = 959151593526117 + -533759674565. +959685353200682 = 959151593526117 - -533759674565. +-511956442419001370748114105 = 959151593526117 * -533759674565. +-959151593526117 = -(959151593526117). +959151593526117 = +(959151593526117). +-1796 = 959151593526117 div -533759674565. +519218007377 = 959151593526117 rem -533759674565. +958789708714785 = 959151593526117 band -533759674565. +-171874863233 = 959151593526117 bor -533759674565. +-958961583578018 = 959151593526117 bxor -533759674565. +-959151593526118 = bnot(959151593526117). +0 = 959151593526117 bsl -396. +154798067840604982832706767635620816692372607293762470743157215497890321537138188100605114026166068788312392515811048749195833808781312 = 959151593526117 bsr -396. +-24447692715287 = 2228231 + -24447694943518. +24447697171749 = 2228231 - -24447694943518. +-54475111751690056658 = 2228231 * -24447694943518. +-2228231 = -(2228231). +2228231 = +(2228231). +0 = 2228231 div -24447694943518. +2228231 = 2228231 rem -24447694943518. +131074 = 2228231 band -24447694943518. +-24447692846361 = 2228231 bor -24447694943518. +-24447692977435 = 2228231 bxor -24447694943518. +-2228232 = bnot(2228231). +1412309182298573913763200240009084928 = 2228231 bsl 99. +0 = 2228231 bsr 99. +-529636755821667055158 = -93556888355645 + -529636662264778699513. +529636568707890343868 = -93556888355645 - -529636662264778699513. +49551158080562357886280616132300885 = -93556888355645 * -529636662264778699513. +93556888355645 = -(-93556888355645). +-93556888355645 = +(-93556888355645). +0 = -93556888355645 div -529636662264778699513. +-93556888355645 = -93556888355645 rem -529636662264778699513. +-529636685380830622717 = -93556888355645 band -529636662264778699513. +-70440836432441 = -93556888355645 bor -529636662264778699513. +529636614939994190276 = -93556888355645 bxor -529636662264778699513. +93556888355644 = bnot(-93556888355645). +-365456595140 = -93556888355645 bsl -8. +-23950563419045120 = -93556888355645 bsr -8. +92142373454895610795790155642 = 92142373447271694876236992324 + 7623915919553163318. +92142373439647778956683829006 = 92142373447271694876236992324 - 7623915919553163318. +702485707790067362709541849380847259784284371032 = 92142373447271694876236992324 * 7623915919553163318. +-92142373447271694876236992324 = -(92142373447271694876236992324). +92142373447271694876236992324 = +(92142373447271694876236992324). +12085964013 = 92142373447271694876236992324 div 7623915919553163318. +5414359974577317190 = 92142373447271694876236992324 rem 7623915919553163318. +7602101606705807364 = 92142373447271694876236992324 band 7623915919553163318. +92142373447293509189084348278 = 92142373447271694876236992324 bor 7623915919553163318. +92142373439691407582378540914 = 92142373447271694876236992324 bxor 7623915919553163318. +-92142373447271694876236992325 = bnot(92142373447271694876236992324). +23588447602501553888316670034944 = 92142373447271694876236992324 bsl 8. +359931146278405058110300751 = 92142373447271694876236992324 bsr 8. +-55748392941580801751 = 514177926246 + -55748393455758727997. +55748393969936654243 = 514177926246 - -55748393455758727997. +-28664593338628100308012241309262 = 514177926246 * -55748393455758727997. +-514177926246 = -(514177926246). +514177926246 = +(514177926246). +0 = 514177926246 div -55748393455758727997. +514177926246 = 514177926246 rem -55748393455758727997. +21579695170 = 514177926246 band -55748393455758727997. +-55748392963160496921 = 514177926246 bor -55748393455758727997. +-55748392984740192091 = 514177926246 bxor -55748393455758727997. +-514177926247 = bnot(514177926246). +131629549118976 = 514177926246 bsl 8. +2008507524 = 514177926246 bsr 8. +6972198921324448981856466 = 474612 + 6972198921324448981381854. +-6972198921324448980907242 = 474612 - 6972198921324448981381854. +3309089274447639379951604490648 = 474612 * 6972198921324448981381854. +-474612 = -(474612). +474612 = +(474612). +0 = 474612 div 6972198921324448981381854. +474612 = 474612 rem 6972198921324448981381854. +143572 = 474612 band 6972198921324448981381854. +6972198921324448981712894 = 474612 bor 6972198921324448981381854. +6972198921324448981569322 = 474612 bxor 6972198921324448981381854. +-474613 = bnot(474612). +1853 = 474612 bsl -8. +121500672 = 474612 bsr -8. +-62665821848439446596209498285 = -62665821855634398988562936143 + 7194952392353437858. +-62665821862829351380916374001 = -62665821855634398988562936143 - 7194952392353437858. +-450877604878991071526708285254256154704572701694 = -62665821855634398988562936143 * 7194952392353437858. +62665821855634398988562936143 = -(-62665821855634398988562936143). +-62665821855634398988562936143 = +(-62665821855634398988562936143). +-8709692356 = -62665821855634398988562936143 div 7194952392353437858. +-2169748426419322695 = -62665821855634398988562936143 rem 7194952392353437858. +2382407589730371744 = -62665821855634398988562936143 band 7194952392353437858. +-62665821850821854185939870029 = -62665821855634398988562936143 bor 7194952392353437858. +-62665821853204261775670241773 = -62665821855634398988562936143 bxor 7194952392353437858. +62665821855634398988562936142 = bnot(-62665821855634398988562936143). +-1084817767643660244780522213629153953898926080345040453069544371713234463275536771280298267170010833880597802476198435796829522365121191004077579629400494449329542774627983279936815553926960929899067484269699889551711727747590392357842956761256251073907540863242281989377617906220851861591680884999716864 = -62665821855634398988562936143 bsl 911. +-1 = -62665821855634398988562936143 bsr 911. +94260648081969 = 98519912838757 + -4259264756788. +102779177595545 = 98519912838757 - -4259264756788. +-419622392595943292265232516 = 98519912838757 * -4259264756788. +-98519912838757 = -(98519912838757). +98519912838757 = +(98519912838757). +-23 = 98519912838757 div -4259264756788. +556823432633 = 98519912838757 rem -4259264756788. +96758365946436 = 98519912838757 band -4259264756788. +-2497717864467 = 98519912838757 bor -4259264756788. +-99256083810903 = 98519912838757 bxor -4259264756788. +-98519912838758 = bnot(98519912838757). +1377686678635590569341335761341476992469445833833739901863031756572672973825711307939900985089843549770640275075499187023317754094386723724653949486126864958044191347876801655313662239288766310820240641344937421666103930076472730808791105944640660351508298072064 = 98519912838757 bsl 821. +0 = 98519912838757 bsr 821. +-484369358674959980331422569 = -85182295312 + -484369358674959895149127257. +484369358674959809966831945 = -85182295312 - -484369358674959895149127257. +41259693750734482808349514284842519184 = -85182295312 * -484369358674959895149127257. +85182295312 = -(-85182295312). +-85182295312 = +(-85182295312). +0 = -85182295312 div -484369358674959895149127257. +-85182295312 = -85182295312 rem -484369358674959895149127257. +-484369358674959975763652448 = -85182295312 band -484369358674959895149127257. +-4567770121 = -85182295312 bor -484369358674959895149127257. +484369358674959971195882327 = -85182295312 bxor -484369358674959895149127257. +85182295311 = bnot(-85182295312). +-658380353059922195180871506894252321738235694807762272644705873309199760459060567795020296114869851753437837983701591902586517465082146648836526078746238102492112557942174580605976576 = -85182295312 bsl 571. +-1 = -85182295312 bsr 571. +-2694483758798 = -8325666717994 + 5631182959196. +-13956849677190 = -8325666717994 - 5631182959196. +-46883352546313102140972824 = -8325666717994 * 5631182959196. +8325666717994 = -(-8325666717994). +-8325666717994 = +(-8325666717994). +-1 = -8325666717994 div 5631182959196. +-2694483758798 = -8325666717994 rem 5631182959196. +55910117972 = -8325666717994 band 5631182959196. +-2750393876770 = -8325666717994 bor 5631182959196. +-2806303994742 = -8325666717994 bxor 5631182959196. +8325666717993 = bnot(-8325666717994). +-33302666871976 = -8325666717994 bsl 2. +-2081416679499 = -8325666717994 bsr 2. +19250113 = 24817572 + -5567459. +30385031 = 24817572 - -5567459. +-138170814589548 = 24817572 * -5567459. +-24817572 = -(24817572). +24817572 = +(24817572). +-4 = 24817572 div -5567459. +2547736 = 24817572 rem -5567459. +19532804 = 24817572 band -5567459. +-282691 = 24817572 bor -5567459. +-19815495 = 24817572 bxor -5567459. +-24817573 = bnot(24817572). +3176649216 = 24817572 bsl 7. +193887 = 24817572 bsr 7. +-986197265 = -986197241 + -24. +-986197217 = -986197241 - -24. +23668733784 = -986197241 * -24. +986197241 = -(-986197241). +-986197241 = +(-986197241). +41091551 = -986197241 div -24. +-17 = -986197241 rem -24. +-986197248 = -986197241 band -24. +-17 = -986197241 bor -24. +986197231 = -986197241 bxor -24. +986197240 = bnot(-986197241). +-1 = -986197241 bsl -81. +-2384478615755221950666675513720832 = -986197241 bsr -81. +732942200343775581690880232 = 732934871577251234126124376 + 7328766524347564755856. +732927542810726886561368520 = 732934871577251234126124376 - 7328766524347564755856. +5371508551342340254299322759521810138255930345856 = 732934871577251234126124376 * 7328766524347564755856. +-732934871577251234126124376 = -(732934871577251234126124376). +732934871577251234126124376 = +(732934871577251234126124376). +100007 = 732934871577251234126124376 div 7328766524347564755856. +6917776824325587233384 = 732934871577251234126124376 rem 7328766524347564755856. +2600995417994822156560 = 732934871577251234126124376 band 7328766524347564755856. +732939599348357586868723672 = 732934871577251234126124376 bor 7328766524347564755856. +732936998352939592046567112 = 732934871577251234126124376 bxor 7328766524347564755856. +-732934871577251234126124377 = bnot(732934871577251234126124376). +55082520201569452267604508957951350510286308219191612295828187656546553125849458644923371557579438629117140030970114012095759709458399232 = 732934871577251234126124376 bsl 365. +0 = 732934871577251234126124376 bsr 365. +546282386 = 546282474 + -88. +546282562 = 546282474 - -88. +-48072857712 = 546282474 * -88. +-546282474 = -(546282474). +546282474 = +(546282474). +-6207755 = 546282474 div -88. +34 = 546282474 rem -88. +546282408 = 546282474 band -88. +-22 = 546282474 bor -88. +-546282430 = 546282474 bxor -88. +-546282475 = bnot(546282474). +0 = 546282474 bsl -813. +29840338297334282138450456656187711109660907212364379909472719157266715168793742613319458215652373579139998102057611417555902445129790415236383563474617625018813617946269840102762316133855929231416002055980335539109980770638424358837471127735450896171008 = 546282474 bsr -813. +4322312878927677411598763 = 4322312878917964499415617 + 9712912183146. +4322312878908251587232471 = 4322312878917964499415617 - 9712912183146. +41982245421011158924257465556676591082 = 4322312878917964499415617 * 9712912183146. +-4322312878917964499415617 = -(4322312878917964499415617). +4322312878917964499415617 = +(4322312878917964499415617). +445006893650 = 4322312878917964499415617 div 9712912183146. +923154992717 = 4322312878917964499415617 rem 9712912183146. +9643921384000 = 4322312878917964499415617 band 9712912183146. +4322312878918033490214763 = 4322312878917964499415617 bor 9712912183146. +4322312878908389568830763 = 4322312878917964499415617 bxor 9712912183146. +-4322312878917964499415618 = bnot(4322312878917964499415617). +31859856237028551888120820009923328758300029661585733548532377883593603909573437430715960643388604457851166218950251358566044377514463637163386275663830923200450335964662085432581827661398016 = 4322312878917964499415617 bsl 551. +0 = 4322312878917964499415617 bsr 551. +-337755121673376495033 = 511116728 + -337755121673887611761. +337755121674398728489 = 511116728 - -337755121673887611761. +-172632292655199319163016638008 = 511116728 * -337755121673887611761. +-511116728 = -(511116728). +511116728 = +(511116728). +0 = 511116728 div -337755121673887611761. +511116728 = 511116728 rem -337755121673887611761. +102171784 = 511116728 band -337755121673887611761. +-337755121673478666817 = 511116728 bor -337755121673887611761. +-337755121673580838601 = 511116728 bxor -337755121673887611761. +-511116729 = bnot(511116728). +127779182 = 511116728 bsl -2. +2044466912 = 511116728 bsr -2. +-6656675232558356241402161741 = -6656675232558356263876529115 + 22474367374. +-6656675232558356286350896489 = -6656675232558356263876529115 - 22474367374. +-149604564665923384567935200706517094010 = -6656675232558356263876529115 * 22474367374. +6656675232558356263876529115 = -(-6656675232558356263876529115). +-6656675232558356263876529115 = +(-6656675232558356263876529115). +-296189660059543541 = -6656675232558356263876529115 div 22474367374. +-8693697781 = -6656675232558356263876529115 rem 22474367374. +5284962308 = -6656675232558356263876529115 band 22474367374. +-6656675232558356246687124049 = -6656675232558356263876529115 bor 22474367374. +-6656675232558356251972086357 = -6656675232558356263876529115 bxor 22474367374. +6656675232558356263876529114 = bnot(-6656675232558356263876529115). +-4098224355635156475671491056479847988400246161035515855685751443750385849166363304055370075768214282026921745868015574871345586307288593858560 = -6656675232558356263876529115 bsl 378. +-1 = -6656675232558356263876529115 bsr 378. +-834784265375442923 = 492876415643 + -834784758251858566. +834785251128274209 = 492876415643 - -834784758251858566. +-411445719480584316653065947938 = 492876415643 * -834784758251858566. +-492876415643 = -(492876415643). +492876415643 = +(492876415643). +0 = 492876415643 div -834784758251858566. +492876415643 = 492876415643 rem -834784758251858566. +147106316314 = 492876415643 band -834784758251858566. +-834784412481759237 = 492876415643 bor -834784758251858566. +-834784559588075551 = 492876415643 bxor -834784758251858566. +-492876415644 = bnot(492876415643). +7886022650288 = 492876415643 bsl 4. +30804775977 = 492876415643 bsr 4. +786997892440 = 786994155228 + 3737212. +786990418016 = 786994155228 - 3737212. +2941164000847944336 = 786994155228 * 3737212. +-786994155228 = -(786994155228). +786994155228 = +(786994155228). +210583 = 786994155228 div 3737212. +840632 = 786994155228 rem 3737212. +67164 = 786994155228 band 3737212. +786997825276 = 786994155228 bor 3737212. +786997758112 = 786994155228 bxor 3737212. +-786994155229 = bnot(786994155228). +5561993252649343873980481383423107439067560947225604842146139928323085688976506355712 = 786994155228 bsl 242. +0 = 786994155228 bsr 242. +4598250297565 = -9548772 + 4598259846337. +-4598269395109 = -9548772 - 4598259846337. +-43907734869427048164 = -9548772 * 4598259846337. +9548772 = -(-9548772). +-9548772 = +(-9548772). +0 = -9548772 div 4598259846337. +-9548772 = -9548772 rem 4598259846337. +4598251392000 = -9548772 band 4598259846337. +-1094435 = -9548772 bor 4598259846337. +-4598252486435 = -9548772 bxor 4598259846337. +9548771 = bnot(-9548772). +-1 = -9548772 bsl -27. +-1281614483030016 = -9548772 bsr -27. +17 = -77 + 94. +-171 = -77 - 94. +-7238 = -77 * 94. +77 = -(-77). +-77 = +(-77). +0 = -77 div 94. +-77 = -77 rem 94. +18 = -77 band 94. +-1 = -77 bor 94. +-19 = -77 bxor 94. +76 = bnot(-77). +-3 = -77 bsl -5. +-2464 = -77 bsr -5. +77134258283273549 = -6 + 77134258283273555. +-77134258283273561 = -6 - 77134258283273555. +-462805549699641330 = -6 * 77134258283273555. +6 = -(-6). +-6 = +(-6). +0 = -6 div 77134258283273555. +-6 = -6 rem 77134258283273555. +77134258283273554 = -6 band 77134258283273555. +-5 = -6 bor 77134258283273555. +-77134258283273559 = -6 bxor 77134258283273555. +5 = bnot(-6). +-384 = -6 bsl 6. +-1 = -6 bsr 6. +29183275531772892507 = -55766289 + 29183275531828658796. +-29183275531884425085 = -55766289 - 29183275531828658796. +-1627442977274585684900128044 = -55766289 * 29183275531828658796. +55766289 = -(-55766289). +-55766289 = +(-55766289). +0 = -55766289 div 29183275531828658796. +-55766289 = -55766289 rem 29183275531828658796. +29183275531823284844 = -55766289 band 29183275531828658796. +-50392337 = -55766289 bor 29183275531828658796. +-29183275531873677181 = -55766289 bxor 29183275531828658796. +55766288 = bnot(-55766289). +-4018384613763766240149504 = -55766289 bsl 56. +-1 = -55766289 bsr 56. +365086117139147091661 = 361132233426153168792 + 3953883712993922869. +357178349713159245923 = 361132233426153168792 - 3953883712993922869. +1427874855980786554439175373063185904248 = 361132233426153168792 * 3953883712993922869. +-361132233426153168792 = -(361132233426153168792). +361132233426153168792 = +(361132233426153168792). +91 = 361132233426153168792 div 3953883712993922869. +1328815543706187713 = 361132233426153168792 rem 3953883712993922869. +1339544090379063056 = 361132233426153168792 band 3953883712993922869. +363746573048768028605 = 361132233426153168792 bor 3953883712993922869. +362407028958388965549 = 361132233426153168792 bxor 3953883712993922869. +-361132233426153168793 = bnot(361132233426153168792). +0 = 361132233426153168792 bsl -696. +118725289140703491556836465932452495756105260575954009599581403128900049342467809199936615485148280430682318251152714265033690995374449129825872565827751619376374351380769605395391077677220595122612287408817961317361349732033626112 = 361132233426153168792 bsr -696. +-6141584268641914214120 = -6141584268641914217341 + 3221. +-6141584268641914220562 = -6141584268641914217341 - 3221. +-19782042929295605694055361 = -6141584268641914217341 * 3221. +6141584268641914217341 = -(-6141584268641914217341). +-6141584268641914217341 = +(-6141584268641914217341). +-1906732154188734621 = -6141584268641914217341 div 3221. +-3100 = -6141584268641914217341 rem 3221. +3201 = -6141584268641914217341 band 3221. +-6141584268641914217321 = -6141584268641914217341 bor 3221. +-6141584268641914220522 = -6141584268641914217341 bxor 3221. +6141584268641914217340 = bnot(-6141584268641914217341). +-1751288345237585826291073747928848023048343983742588022682591874328785777092434928905126541446820557558701485007668624934352026410694513865411795125375468600332166887490883186250928441914174496707171387583523454976 = -6141584268641914217341 bsl 636. +-1 = -6141584268641914217341 bsr 636. +67861760423550 = 61265567725173 + 6596192698377. +54669375026796 = 61265567725173 - 6596192698377. +404119490490707732419144221 = 61265567725173 * 6596192698377. +-61265567725173 = -(61265567725173). +61265567725173 = +(61265567725173). +9 = 61265567725173 div 6596192698377. +1899833439780 = 61265567725173 rem 6596192698377. +6289981702145 = 61265567725173 band 6596192698377. +61571778721405 = 61265567725173 bor 6596192698377. +55281797019260 = 61265567725173 bxor 6596192698377. +-61265567725174 = bnot(61265567725173). +239318623926 = 61265567725173 bsl -8. +15683985337644288 = 61265567725173 bsr -8. +47116745348335290 = -8 + 47116745348335298. +-47116745348335306 = -8 - 47116745348335298. +-376933962786682384 = -8 * 47116745348335298. +8 = -(-8). +-8 = +(-8). +0 = -8 div 47116745348335298. +-8 = -8 rem 47116745348335298. +47116745348335296 = -8 band 47116745348335298. +-6 = -8 bor 47116745348335298. +-47116745348335302 = -8 bxor 47116745348335298. +7 = bnot(-8). +-32 = -8 bsl 2. +-2 = -8 bsr 2. +-88573984901610957 = -88567592543696663 + -6392357914294. +-88561200185782369 = -88567592543696663 - -6392357914294. +566155751146665626751287800922 = -88567592543696663 * -6392357914294. +88567592543696663 = -(-88567592543696663). +-88567592543696663 = +(-88567592543696663). +13855 = -88567592543696663 div -6392357914294. +-1473641153293 = -88567592543696663 rem -6392357914294. +-88567662371518392 = -88567592543696663 band -6392357914294. +-6322530092565 = -88567592543696663 bor -6392357914294. +88561339841425827 = -88567592543696663 bxor -6392357914294. +88567592543696662 = bnot(-88567592543696663). +-45346607382372691456 = -88567592543696663 bsl 9. +-172983579186908 = -88567592543696663 bsr 9. +-9146156523089801569030876897 = -8817572254811883426431653785 + -328584268277918142599223112. +-8488987986533965283832430673 = -8817572254811883426431653785 - -328584268277918142599223112. +2897315527335035496667139099181367051282066106354278920 = -8817572254811883426431653785 * -328584268277918142599223112. +8817572254811883426431653785 = -(-8817572254811883426431653785). +-8817572254811883426431653785 = +(-8817572254811883426431653785). +26 = -8817572254811883426431653785 div -328584268277918142599223112. +-274381279586011718851852873 = -8817572254811883426431653785 rem -328584268277918142599223112. +-9129798012702552983602681824 = -8817572254811883426431653785 band -328584268277918142599223112. +-16358510387248585428195073 = -8817572254811883426431653785 bor -328584268277918142599223112. +9113439502315304398174486751 = -8817572254811883426431653785 bxor -328584268277918142599223112. +8817572254811883426431653784 = bnot(-8817572254811883426431653785). +-2204393063702970856607913447 = -8817572254811883426431653785 bsl -2. +-35270289019247533705726615140 = -8817572254811883426431653785 bsr -2. +465928375553828382292956748 = -3346318897841 + 465928375553831728611854589. +-465928375553835074930752430 = -3346318897841 - 465928375553831728611854589. +-1559144928156145718052797073149438042349 = -3346318897841 * 465928375553831728611854589. +3346318897841 = -(-3346318897841). +-3346318897841 = +(-3346318897841). +0 = -3346318897841 div 465928375553831728611854589. +-3346318897841 = -3346318897841 rem 465928375553831728611854589. +465928375553830594738128973 = -3346318897841 band 465928375553831728611854589. +-2212445172225 = -3346318897841 bor 465928375553831728611854589. +-465928375553832807183301198 = -3346318897841 bxor 465928375553831728611854589. +3346318897840 = bnot(-3346318897841). +-1 = -3346318897841 bsl -73. +-31605088408315261556739799276060672 = -3346318897841 bsr -73. +-62714104103016144602 = 21419246681141769 + -62735523349697286371. +62756942596378428140 = 21419246681141769 - -62735523349697286371. +-1343747650297695555866511519242530299 = 21419246681141769 * -62735523349697286371. +-21419246681141769 = -(21419246681141769). +21419246681141769 = +(21419246681141769). +0 = 21419246681141769 div -62735523349697286371. +21419246681141769 = 21419246681141769 rem -62735523349697286371. +21392787656221193 = 21419246681141769 band -62735523349697286371. +-62735496890672365795 = 21419246681141769 bor -62735523349697286371. +-62756889678328586988 = 21419246681141769 bxor -62735523349697286371. +-21419246681141770 = bnot(21419246681141769). +301135451132850879823076333720532272357865951171292782157020618613801305055882637248865896221318709819446722148208834930598535508005104228433238569815922886879036217445134106624 = 21419246681141769 bsl 532. +0 = 21419246681141769 bsr 532. +-422346012809773866 = 287563561651815 + -422633576371425681. +422921139933077496 = 287563561651815 - -422633576371425681. +-121534016495011532057750871261015 = 287563561651815 * -422633576371425681. +-287563561651815 = -(287563561651815). +287563561651815 = +(287563561651815). +0 = 287563561651815 div -422633576371425681. +287563561651815 = 287563561651815 rem -422633576371425681. +1099548348007 = 287563561651815 band -422633576371425681. +-422347112358121873 = 287563561651815 bor -422633576371425681. +-422348211906469880 = 287563561651815 bxor -422633576371425681. +-287563561651816 = bnot(287563561651815). +0 = 287563561651815 bsl -69. +169747565654893748186088190802657280 = 287563561651815 bsr -69. +5798686886864655553 = 5798686886864655561 + -8. +5798686886864655569 = 5798686886864655561 - -8. +-46389495094917244488 = 5798686886864655561 * -8. +-5798686886864655561 = -(5798686886864655561). +5798686886864655561 = +(5798686886864655561). +-724835860858081945 = 5798686886864655561 div -8. +1 = 5798686886864655561 rem -8. +5798686886864655560 = 5798686886864655561 band -8. +-7 = 5798686886864655561 bor -8. +-5798686886864655567 = 5798686886864655561 bxor -8. +-5798686886864655562 = bnot(5798686886864655561). +2765029376442 = 5798686886864655561 bsl -21. +12160727802161986139062272 = 5798686886864655561 bsr -21. +34535239279974682 = 34535239283838143 + -3863461. +34535239287701604 = 34535239283838143 - -3863461. +-133425550098776595792923 = 34535239283838143 * -3863461. +-34535239283838143 = -(34535239283838143). +34535239283838143 = +(34535239283838143). +-8938938243 = 34535239283838143 div -3863461. +599120 = 34535239283838143 rem -3863461. +34535239280036891 = 34535239283838143 band -3863461. +-62209 = 34535239283838143 bor -3863461. +-34535239280099100 = 34535239283838143 bxor -3863461. +-34535239283838144 = bnot(34535239283838143). +4635241352613102673199104 = 34535239283838143 bsl 27. +257307583 = 34535239283838143 bsr 27. +-368153716082640201944396754031 = 76753291427389858788 + -368153716159393493371786612819. +368153716236146784799176471607 = 76753291427389858788 - -368153716159393493371786612819. +-28257009466458495941911927915494931764981240603372 = 76753291427389858788 * -368153716159393493371786612819. +-76753291427389858788 = -(76753291427389858788). +76753291427389858788 = +(76753291427389858788). +0 = 76753291427389858788 div -368153716159393493371786612819. +76753291427389858788 = 76753291427389858788 rem -368153716159393493371786612819. +72118344229069732 = 76753291427389858788 band -368153716159393493371786612819. +-368153716082712320288625823763 = 76753291427389858788 bor -368153716159393493371786612819. +-368153716082784438632854893495 = 76753291427389858788 bxor -368153716159393493371786612819. +-76753291427389858789 = bnot(76753291427389858788). +0 = 76753291427389858788 bsl -366. +11536535890257593071038976300375871109868892628109738378273396023014903115688063580778111060947038640339585509431463222210442821632 = 76753291427389858788 bsr -366. +1884609829208532322882303799 = 2248556246542721798153863135 + -363946417334189475271559336. +2612502663876911273425422471 = 2248556246542721798153863135 - -363946417334189475271559336. +-818353990103636068016594906757526612446893223775478360 = 2248556246542721798153863135 * -363946417334189475271559336. +-2248556246542721798153863135 = -(2248556246542721798153863135). +2248556246542721798153863135 = +(2248556246542721798153863135). +-6 = 2248556246542721798153863135 div -363946417334189475271559336. +64877742537584946524507119 = 2248556246542721798153863135 rem -363946417334189475271559336. +1937843304908427225687799640 = 2248556246542721798153863135 band -363946417334189475271559336. +-53233475699894902805495841 = 2248556246542721798153863135 bor -363946417334189475271559336. +-1991076780608322128493295481 = 2248556246542721798153863135 bxor -363946417334189475271559336. +-2248556246542721798153863136 = bnot(2248556246542721798153863135). +7801246615 = 2248556246542721798153863135 bsl -58. +648102212739289793590374371758327316548157440 = 2248556246542721798153863135 bsr -58. +-927242187530948173 = 881216 + -927242187531829389. +927242187532710605 = 881216 - -927242187531829389. +-817100651528048566857024 = 881216 * -927242187531829389. +-881216 = -(881216). +881216 = +(881216). +0 = 881216 div -927242187531829389. +881216 = 881216 rem -927242187531829389. +537152 = 881216 band -927242187531829389. +-927242187531485325 = 881216 bor -927242187531829389. +-927242187532022477 = 881216 bxor -927242187531829389. +-881217 = bnot(881216). +56397824 = 881216 bsl 6. +13769 = 881216 bsr 6. +-92294491442187688455153989533 = -92294491442187686323776125311 + -2131377864222. +-92294491442187684192398261089 = -92294491442187686323776125311 - -2131377864222. +196714436049505647464037636743433815523042 = -92294491442187686323776125311 * -2131377864222. +92294491442187686323776125311 = -(-92294491442187686323776125311). +-92294491442187686323776125311 = +(-92294491442187686323776125311). +43302735282876372 = -92294491442187686323776125311 div -2131377864222. +-1561548162727 = -92294491442187686323776125311 rem -2131377864222. +-92294491442187687148409847680 = -92294491442187686323776125311 band -2131377864222. +-1306744141853 = -92294491442187686323776125311 bor -2131377864222. +92294491442187685841665705827 = -92294491442187686323776125311 bxor -2131377864222. +92294491442187686323776125310 = bnot(-92294491442187686323776125311). +-185999584514065598597956584080419883018491093214177575881974373283864097380857203228341277386380643103031653648497557735646336491731819166395960639369110660948577337627072201396978938963758595137324517976756474055979267842414815940739328582451905282350545473628506864588391433882838514410717184 = -92294491442187686323776125311 bsl 878. +-1 = -92294491442187686323776125311 bsr 878. +-22992720593436056750377491 = -81183965279133325738952927 + 58191244685697268988575436. +-139375209964830594727528363 = -81183965279133325738952927 - 58191244685697268988575436. +-4724195988113198744171942818553380419018847992501172 = -81183965279133325738952927 * 58191244685697268988575436. +81183965279133325738952927 = -(-81183965279133325738952927). +-81183965279133325738952927 = +(-81183965279133325738952927). +-1 = -81183965279133325738952927 div 58191244685697268988575436. +-22992720593436056750377491 = -81183965279133325738952927 rem 58191244685697268988575436. +58029031944576824657589760 = -81183965279133325738952927 band 58191244685697268988575436. +-81021752538012881407967251 = -81183965279133325738952927 bor 58191244685697268988575436. +-139050784482589706065557011 = -81183965279133325738952927 bxor 58191244685697268988575436. +81183965279133325738952926 = bnot(-81183965279133325738952927). +-5019815681416656113511808829597582218059123923898989834827865951504562132517509866352730861760071653866933645628409284104571167935680767215508231731030047302186971796092169038304272610902626447392768 = -81183965279133325738952927 bsl 574. +-1 = -81183965279133325738952927 bsr 574. +-627171199928636384 = 3 + -627171199928636387. +627171199928636390 = 3 - -627171199928636387. +-1881513599785909161 = 3 * -627171199928636387. +-3 = -(3). +3 = +(3). +0 = 3 div -627171199928636387. +3 = 3 rem -627171199928636387. +1 = 3 band -627171199928636387. +-627171199928636385 = 3 bor -627171199928636387. +-627171199928636386 = 3 bxor -627171199928636387. +-4 = bnot(3). +14167099448608935641088 = 3 bsl 72. +0 = 3 bsr 72. +38489905028814522963407073 = 38489896817115623696432732 + 8211698899266974341. +38489888605416724429458391 = 38489896817115623696432732 - 8211698899266974341. +316067443326007786301602416749121180676529612 = 38489896817115623696432732 * 8211698899266974341. +-38489896817115623696432732 = -(38489896817115623696432732). +38489896817115623696432732 = +(38489896817115623696432732). +4687202 = 38489896817115623696432732 div 8211698899266974341. +5313073663031348850 = 38489896817115623696432732 rem 8211698899266974341. +8126112209232212484 = 38489896817115623696432732 band 8211698899266974341. +38489896902702313731194589 = 38489896817115623696432732 bor 8211698899266974341. +38489888776590104498982105 = 38489896817115623696432732 bxor 8211698899266974341. +-38489896817115623696432733 = bnot(38489896817115623696432732). +75175579720928952532095 = 38489896817115623696432732 bsl -9. +19706827170363199332573558784 = 38489896817115623696432732 bsr -9. +83662398216864836064980991875 = -577817779741 + 83662398216864836642798771616. +-83662398216864837220616551357 = -577817779741 - 83662398216864836642798771616. +-48341621185476237330836646511399250631456 = -577817779741 * 83662398216864836642798771616. +577817779741 = -(-577817779741). +-577817779741 = +(-577817779741). +0 = -577817779741 div 83662398216864836642798771616. +-577817779741 = -577817779741 rem 83662398216864836642798771616. +83662398216864836084310213024 = -577817779741 band 83662398216864836642798771616. +-19329221149 = -577817779741 bor 83662398216864836642798771616. +-83662398216864836103639434173 = -577817779741 bxor 83662398216864836642798771616. +577817779740 = bnot(-577817779741). +-18490168951712 = -577817779741 bsl 5. +-18056805617 = -577817779741 bsr 5. +-9323712223762171796121 = -9323712223762171796118 + -3. +-9323712223762171796115 = -9323712223762171796118 - -3. +27971136671286515388354 = -9323712223762171796118 * -3. +9323712223762171796118 = -(-9323712223762171796118). +-9323712223762171796118 = +(-9323712223762171796118). +3107904074587390598706 = -9323712223762171796118 div -3. +0 = -9323712223762171796118 rem -3. +-9323712223762171796120 = -9323712223762171796118 band -3. +-1 = -9323712223762171796118 bor -3. +9323712223762171796119 = -9323712223762171796118 bxor -3. +9323712223762171796117 = bnot(-9323712223762171796118). +-383156198468100171274531995553938956410245284103900601718134146024035993174671945925044898293687575318577045701862973654972998397835931164269051794643753412311088298486910253034674495588871621252033983025960411401743062972766355456 = -9323712223762171796118 bsl 693. +-1 = -9323712223762171796118 bsr 693. +3758818439164718652970 = 3758818439164718653841 + -871. +3758818439164718654712 = 3758818439164718653841 - -871. +-3273930860512469947495511 = 3758818439164718653841 * -871. +-3758818439164718653841 = -(3758818439164718653841). +3758818439164718653841 = +(3758818439164718653841). +-4315520596055934160 = 3758818439164718653841 div -871. +481 = 3758818439164718653841 rem -871. +3758818439164718653585 = 3758818439164718653841 band -871. +-615 = 3758818439164718653841 bor -871. +-3758818439164718654200 = 3758818439164718653841 bxor -871. +-3758818439164718653842 = bnot(3758818439164718653841). +0 = 3758818439164718653841 bsl -562. +56742558204536011717878679188974270513240470254145891506083143932073281639818006934936298751805558180191534955833936593373339751482539304001976191488311896199919676896644311542788491013259264 = 3758818439164718653841 bsr -562. +91757988939962461471635 = 91757988939962489784156 + -28312521. +91757988939962518096677 = 91757988939962489784156 - -28312521. +-2597899988780455731226202217276 = 91757988939962489784156 * -28312521. +-91757988939962489784156 = -(91757988939962489784156). +91757988939962489784156 = +(91757988939962489784156). +-3240897867765378 = 91757988939962489784156 div -28312521. +2086218 = 91757988939962489784156 rem -28312521. +91757988939962461471764 = 91757988939962489784156 band -28312521. +-129 = 91757988939962489784156 bor -28312521. +-91757988939962461471893 = 91757988939962489784156 bxor -28312521. +-91757988939962489784157 = bnot(91757988939962489784156). +1733259406022409871975898372007034246140002304 = 91757988939962489784156 bsl 74. +4 = 91757988939962489784156 bsr 74. +39565775828 = -21 + 39565775849. +-39565775870 = -21 - 39565775849. +-830881292829 = -21 * 39565775849. +21 = -(-21). +-21 = +(-21). +0 = -21 div 39565775849. +-21 = -21 rem 39565775849. +39565775849 = -21 band 39565775849. +-21 = -21 bor 39565775849. +-39565775870 = -21 bxor 39565775849. +20 = bnot(-21). +-336 = -21 bsl 4. +-2 = -21 bsr 4. +-29762862369475373945987344 = 5 + -29762862369475373945987349. +29762862369475373945987354 = 5 - -29762862369475373945987349. +-148814311847376869729936745 = 5 * -29762862369475373945987349. +-5 = -(5). +5 = +(5). +0 = 5 div -29762862369475373945987349. +5 = 5 rem -29762862369475373945987349. +1 = 5 band -29762862369475373945987349. +-29762862369475373945987345 = 5 bor -29762862369475373945987349. +-29762862369475373945987346 = 5 bxor -29762862369475373945987349. +-6 = bnot(5). +96714065569170333976494080 = 5 bsl 84. +0 = 5 bsr 84. +732729761416169004741 = 732729756148682423249 + 5267486581492. +732729750881195841757 = 732729756148682423249 - 5267486581492. +3859644158373089945319821673907508 = 732729756148682423249 * 5267486581492. +-732729756148682423249 = -(732729756148682423249). +732729756148682423249 = +(732729756148682423249). +139104247 = 732729756148682423249 div 5267486581492. +1647633626725 = 732729756148682423249 rem 5267486581492. +4434025915088 = 732729756148682423249 band 5267486581492. +732729756982143089653 = 732729756148682423249 bor 5267486581492. +732729752548117174565 = 732729756148682423249 bxor 5267486581492. +-732729756148682423250 = bnot(732729756148682423249). +23447352196757837543968 = 732729756148682423249 bsl 5. +22897804879646325726 = 732729756148682423249 bsr 5. +-4352599859673007 = -4352599857524451 + -2148556. +-4352599855375895 = -4352599857524451 - -2148556. +9351804539483304342756 = -4352599857524451 * -2148556. +4352599857524451 = -(-4352599857524451). +-4352599857524451 = +(-4352599857524451). +2025825651 = -4352599857524451 div -2148556. +-114495 = -4352599857524451 rem -2148556. +-4352599859654380 = -4352599857524451 band -2148556. +-18627 = -4352599857524451 bor -2148556. +4352599859635753 = -4352599857524451 bxor -2148556. +4352599857524450 = bnot(-4352599857524451). +-506710 = -4352599857524451 bsl -33. +-37388548081283553130708992 = -4352599857524451 bsr -33. +-94389634156317189166047 = -94389634156317189165519 + -528. +-94389634156317189164991 = -94389634156317189165519 - -528. +49837726834535475879394032 = -94389634156317189165519 * -528. +94389634156317189165519 = -(-94389634156317189165519). +-94389634156317189165519 = +(-94389634156317189165519). +178768246508176494631 = -94389634156317189165519 div -528. +-351 = -94389634156317189165519 rem -528. +-94389634156317189166032 = -94389634156317189165519 band -528. +-15 = -94389634156317189165519 bor -528. +94389634156317189166017 = -94389634156317189165519 bxor -528. +94389634156317189165518 = bnot(-94389634156317189165519). +-1 = -94389634156317189165519 bsl -481. +-589321407184680099467763885021504893476495349802993815326732172023506652597245345883037146499772326893673837721264247748151299039384987799013342753209972052494215282688 = -94389634156317189165519 bsr -481. +74772711469266263075409212497 = 2119146693595222 + 74772711469264143928715617275. +-74772711469262024782022022053 = 2119146693595222 - 74772711469264143928715617275. +158454344281240644616172070363307888720660050 = 2119146693595222 * 74772711469264143928715617275. +-2119146693595222 = -(2119146693595222). +2119146693595222 = +(2119146693595222). +0 = 2119146693595222 div 74772711469264143928715617275. +2119146693595222 = 2119146693595222 rem 74772711469264143928715617275. +425787105083474 = 2119146693595222 band 74772711469264143928715617275. +74772711469265837288304129023 = 2119146693595222 bor 74772711469264143928715617275. +74772711469265411501199045549 = 2119146693595222 bxor 74772711469264143928715617275. +-2119146693595223 = bnot(2119146693595222). +60 = 2119146693595222 bsl -45. +74560845778272347356034760704 = 2119146693595222 bsr -45. +-433169449654421572447807185 = 3451446756 + -433169449654421575899253941. +433169449654421579350700697 = 3451446756 - -433169449654421575899253941. +-1495061291808058669193887797484665396 = 3451446756 * -433169449654421575899253941. +-3451446756 = -(3451446756). +3451446756 = +(3451446756). +0 = 3451446756 div -433169449654421575899253941. +3451446756 = 3451446756 rem -433169449654421575899253941. +1143497024 = 3451446756 band -433169449654421575899253941. +-433169449654421573591304209 = 3451446756 bor -433169449654421575899253941. +-433169449654421574734801233 = 3451446756 bxor -433169449654421575899253941. +-3451446757 = bnot(3451446756). +1698155371193525204830545916836568128680441580998381568463828606592094114468682671168384424246732426433969671163465789195711765615185779492213847037840137881175115452783147995343129479623640605849293724317507773619519108156500008029348686509290662078665092776507457142784 = 3451446756 bsl 866. +0 = 3451446756 bsr 866. +76344137685153051759 = 58961 + 76344137685152992798. +-76344137685152933837 = 58961 - 76344137685152992798. +4501326702054305608362878 = 58961 * 76344137685152992798. +-58961 = -(58961). +58961 = +(58961). +0 = 58961 div 76344137685152992798. +58961 = 58961 rem 76344137685152992798. +34320 = 58961 band 76344137685152992798. +76344137685153017439 = 58961 bor 76344137685152992798. +76344137685152983119 = 58961 bxor 76344137685152992798. +-58962 = bnot(58961). +0 = 58961 bsl -42. +259313220341202944 = 58961 bsr -42. +57479277147034760219615969056 = -8862494328917399859 + 57479277155897254548533368915. +-57479277164759748877450768774 = -8862494328917399859 - 57479277155897254548533368915. +-509409767824410870945391245069230635419415982985 = -8862494328917399859 * 57479277155897254548533368915. +8862494328917399859 = -(-8862494328917399859). +-8862494328917399859 = +(-8862494328917399859). +0 = -8862494328917399859 div 57479277155897254548533368915. +-8862494328917399859 = -8862494328917399859 rem 57479277155897254548533368915. +57479277151278456879468134465 = -8862494328917399859 band 57479277155897254548533368915. +-4243696659852165409 = -8862494328917399859 bor 57479277155897254548533368915. +-57479277155522153539320299874 = -8862494328917399859 bxor 57479277155897254548533368915. +8862494328917399858 = bnot(-8862494328917399859). +-2215623582229349965 = -8862494328917399859 bsl -2. +-35449977315669599436 = -8862494328917399859 bsr -2. +-789815706 = -789767185 + -48521. +-789718664 = -789767185 - -48521. +38320293583385 = -789767185 * -48521. +789767185 = -(-789767185). +-789767185 = +(-789767185). +16276 = -789767185 div -48521. +-39389 = -789767185 rem -48521. +-789773721 = -789767185 band -48521. +-41985 = -789767185 bor -48521. +789731736 = -789767185 bxor -48521. +789767184 = bnot(-789767185). +-1 = -789767185 bsl -668. +-967244320475332459002335950829023241212009066219700749912658431836369087690997676597488152418437276434629255755917760744115452947683138425828558291918401735328264621736592953964668879409046635974873824215695360 = -789767185 bsr -668. +-777623247658461946715588637616 = -44827 + -777623247658461946715588592789. +777623247658461946715588547962 = -44827 - -777623247658461946715588592789. +34858517322785873685419689848952503 = -44827 * -777623247658461946715588592789. +44827 = -(-44827). +-44827 = +(-44827). +0 = -44827 div -777623247658461946715588592789. +-44827 = -44827 rem -777623247658461946715588592789. +-777623247658461946715588636575 = -44827 band -777623247658461946715588592789. +-1041 = -44827 bor -777623247658461946715588592789. +777623247658461946715588635534 = -44827 bxor -777623247658461946715588592789. +44826 = bnot(-44827). +-358616 = -44827 bsl 3. +-5604 = -44827 bsr 3. +-49423188549633 = 25351124379885 + -74774312929518. +100125437309403 = 25351124379885 - -74774312929518. +-1895612907496653945461945430 = 25351124379885 * -74774312929518. +-25351124379885 = -(25351124379885). +25351124379885 = +(25351124379885). +0 = 25351124379885 div -74774312929518. +25351124379885 = 25351124379885 rem -74774312929518. +20950926172160 = 25351124379885 band -74774312929518. +-70374114721793 = 25351124379885 bor -74774312929518. +-91325040893953 = 25351124379885 bxor -74774312929518. +-25351124379886 = bnot(25351124379885). +52597442651485657809365458667747892670808001914636976424691825090673452876305446441790869078292405009570560626596540131597379195232839616586590302364353984959784155371906169553655674683921530880 = 25351124379885 bsl 599. +0 = 25351124379885 bsr 599. +-15852865259102721198 = -9926283823219191664 + -5926581435883529534. +-3999702387335662130 = -9926283823219191664 - -5926581435883529534. +58828929434001848172249748630750604576 = -9926283823219191664 * -5926581435883529534. +9926283823219191664 = -(-9926283823219191664). +-9926283823219191664 = +(-9926283823219191664). +1 = -9926283823219191664 div -5926581435883529534. +-3999702387335662130 = -9926283823219191664 rem -5926581435883529534. +-15852528765024317312 = -9926283823219191664 band -5926581435883529534. +-336494078403886 = -9926283823219191664 bor -5926581435883529534. +15852192270945913426 = -9926283823219191664 bxor -5926581435883529534. +9926283823219191663 = bnot(-9926283823219191664). +-1547756045176818240766206999809915530671296664991964117799518055392269366077386494692881433839074405311077250537837886767801418064914093372206515291028891547675977370286094990394268275016242604106038028738327402925622139791354161601330758117019767057343663418879325827380964335218533457494233551068446561665024 = -9926283823219191664 bsl 964. +-1 = -9926283823219191664 bsr 964. +-383677947339064 = -383677947346213 + 7149. +-383677947353362 = -383677947346213 - 7149. +-2742913645578076737 = -383677947346213 * 7149. +383677947346213 = -(-383677947346213). +-383677947346213 = +(-383677947346213). +-53668757497 = -383677947346213 div 7149. +-160 = -383677947346213 rem 7149. +713 = -383677947346213 band 7149. +-383677947339777 = -383677947346213 bor 7149. +-383677947340490 = -383677947346213 bxor 7149. +383677947346212 = bnot(-383677947346213). +-184349993378748017410350293410895821521862783586301195774935674013710260738384110439146111760752677495343397910854837653850092153763712234228462046128933001276753302353480921523231388620474310418148418884596127970493618659407853109150585379373807238231576711160423795130368 = -383677947346213 bsl 856. +-1 = -383677947346213 bsr 856. +8912273195587815868165187 = 8912273195587893298126921 + -77429961734. +8912273195587970728088655 = 8912273195587893298126921 - -77429961734. +-690076972497324475707642546905241014 = 8912273195587893298126921 * -77429961734. +-8912273195587893298126921 = -(8912273195587893298126921). +8912273195587893298126921 = +(8912273195587893298126921). +-115101092600365 = 8912273195587893298126921 div -77429961734. +40793694011 = 8912273195587893298126921 rem -77429961734. +8912273195587815954481224 = 8912273195587893298126921 band -77429961734. +-86316037 = 8912273195587893298126921 bor -77429961734. +-8912273195587816040797261 = 8912273195587893298126921 bxor -77429961734. +-8912273195587893298126922 = bnot(8912273195587893298126921). +278508537362121665566466 = 8912273195587893298126921 bsl -5. +285192742258812585540061472 = 8912273195587893298126921 bsr -5. +-8319732734949941921 = 2 + -8319732734949941923. +8319732734949941925 = 2 - -8319732734949941923. +-16639465469899883846 = 2 * -8319732734949941923. +-2 = -(2). +2 = +(2). +0 = 2 div -8319732734949941923. +2 = 2 rem -8319732734949941923. +0 = 2 band -8319732734949941923. +-8319732734949941921 = 2 bor -8319732734949941923. +-8319732734949941921 = 2 bxor -8319732734949941923. +-3 = bnot(2). +0 = 2 bsl -349. +2293498615990071511610820895302086940796564989168281123737588839386922876088484808070018553110125686554624 = 2 bsr -349. +-55166512001 = -55166511776 + -225. +-55166511551 = -55166511776 - -225. +12412465149600 = -55166511776 * -225. +55166511776 = -(-55166511776). +-55166511776 = +(-55166511776). +245184496 = -55166511776 div -225. +-176 = -55166511776 rem -225. +-55166511872 = -55166511776 band -225. +-129 = -55166511776 bor -225. +55166511743 = -55166511776 bxor -225. +55166511775 = bnot(-55166511776). +-1 = -55166511776 bsl -632. +-983179429919357600188043312907429492583409892139791338942729556793990055834694805047122432028004044528336229548373177381065816092507597262686575422335137617441398222885097037637605200400385762127773696 = -55166511776 bsr -632. +44636453572121039829328985 = 44636453523244412987464786 + 48876626841864199. +44636453474367786145600587 = 44636453523244412987464786 - 48876626841864199. +2181679282399831671724744654409275106596414 = 44636453523244412987464786 * 48876626841864199. +-44636453523244412987464786 = -(44636453523244412987464786). +44636453523244412987464786 = +(44636453523244412987464786). +913247423 = 44636453523244412987464786 div 48876626841864199. +14979304734755609 = 44636453523244412987464786 rem 48876626841864199. +12705992542390274 = 44636453523244412987464786 band 48876626841864199. +44636453559415047286938711 = 44636453523244412987464786 bor 48876626841864199. +44636453546709054744548437 = 44636453523244412987464786 bxor 48876626841864199. +-44636453523244412987464787 = bnot(44636453523244412987464786). +147 = 44636453523244412987464786 bsl -78. +13490540290069638524711849676635183589775674179584 = 44636453523244412987464786 bsr -78. +6178626537631128165561247990 = 62599 + 6178626537631128165561185391. +-6178626537631128165561122792 = 62599 - 6178626537631128165561185391. +386775842629170992035964644291209 = 62599 * 6178626537631128165561185391. +-62599 = -(62599). +62599 = +(62599). +0 = 62599 div 6178626537631128165561185391. +62599 = 62599 rem 6178626537631128165561185391. +46087 = 62599 band 6178626537631128165561185391. +6178626537631128165561201903 = 62599 bor 6178626537631128165561185391. +6178626537631128165561155816 = 62599 bxor 6178626537631128165561185391. +-62600 = bnot(62599). +781673350004923190769026419951289670294225980530738116290529466062354581913514032215644166982686135610536024245075732746528591318191069487553834909696 = 62599 bsl 482. +0 = 62599 bsr 482. +61294794533664140628529 = 28755399394 + 61294794533635385229135. +-61294794533606629829741 = 28755399394 - 61294794533635385229135. +1762556297587853469034825130144190 = 28755399394 * 61294794533635385229135. +-28755399394 = -(28755399394). +28755399394 = +(28755399394). +0 = 28755399394 div 61294794533635385229135. +28755399394 = 28755399394 rem 61294794533635385229135. +8593347138 = 28755399394 band 61294794533635385229135. +61294794533655547281391 = 28755399394 bor 61294794533635385229135. +61294794533646953934253 = 28755399394 bxor 61294794533635385229135. +-28755399395 = bnot(28755399394). +224651557 = 28755399394 bsl -7. +3680691122432 = 28755399394 bsr -7. +68356591755465309388702963323 = 68356591755456717891361834647 + 8591497341128676. +68356591755448126394020705971 = 68356591755456717891361834647 - 8591497341128676. +587285476315624766804947477869971049062037372 = 68356591755456717891361834647 * 8591497341128676. +-68356591755456717891361834647 = -(68356591755456717891361834647). +68356591755456717891361834647 = +(68356591755456717891361834647). +7956307153611 = 68356591755456717891361834647 div 8591497341128676. +4747063712785611 = 68356591755456717891361834647 rem 8591497341128676. +141569639843460 = 68356591755456717891361834647 band 8591497341128676. +68356591755465167819063119863 = 68356591755456717891361834647 bor 8591497341128676. +68356591755465026249423276403 = 68356591755456717891361834647 bxor 8591497341128676. +-68356591755456717891361834648 = bnot(68356591755456717891361834647). +573416652452558267357221017014501376 = 68356591755456717891361834647 bsl 23. +8148740739280786262912 = 68356591755456717891361834647 bsr 23. +-699567528957588408229971773208 = -699567528956825442116545643412 + -762966113426129796. +-699567528956062476003119513616 = -699567528956825442116545643412 - -762966113426129796. +533746318647310620793763440997871100807844303952 = -699567528956825442116545643412 * -762966113426129796. +699567528956825442116545643412 = -(-699567528956825442116545643412). +-699567528956825442116545643412 = +(-699567528956825442116545643412). +916905111047 = -699567528956825442116545643412 div -762966113426129796. +-741903883730187000 = -699567528956825442116545643412 rem -762966113426129796. +-699567528957407700745095857044 = -699567528956825442116545643412 band -762966113426129796. +-180707484875916164 = -699567528956825442116545643412 bor -762966113426129796. +699567528957226993260219940880 = -699567528956825442116545643412 bxor -762966113426129796. +699567528956825442116545643411 = bnot(-699567528956825442116545643412). +-1550121224195987807290171107091258107712715916897584379572599658174498656050114252196127509785981291190843396381201329621527162385718421440264449420454387485687802987709033516486490246567477835931041196955025926459411521992418704737782360971317378993141120628074117433571666760150601966198593076802069987328 = -699567528956825442116545643412 bsl 918. +-1 = -699567528956825442116545643412 bsr 918. +-2968553792195197914198583324 = -2968553792195197914198583351 + 27. +-2968553792195197914198583378 = -2968553792195197914198583351 - 27. +-80150952389270343683361750477 = -2968553792195197914198583351 * 27. +2968553792195197914198583351 = -(-2968553792195197914198583351). +-2968553792195197914198583351 = +(-2968553792195197914198583351). +-109946436747970293118466050 = -2968553792195197914198583351 div 27. +-1 = -2968553792195197914198583351 rem 27. +9 = -2968553792195197914198583351 band 27. +-2968553792195197914198583333 = -2968553792195197914198583351 bor 27. +-2968553792195197914198583342 = -2968553792195197914198583351 bxor 27. +2968553792195197914198583350 = bnot(-2968553792195197914198583351). +-664188490871115306642579814060706102409828879569937769141553990272626475834572045731134930507314228990954986433495077258998829005959661816677464155727409238268814013379673829080983557475938736170397612032475671508364459503815492935041291646492770907720336592025769311712837632 = -2968553792195197914198583351 bsl 825. +-1 = -2968553792195197914198583351 bsr 825. +815573798945895524991106 = -441683913266449 + 815573799387579438257555. +-815573799829263351524004 = -441683913266449 - 815573799387579438257555. +-360225827271091913160959947957002272195 = -441683913266449 * 815573799387579438257555. +441683913266449 = -(-441683913266449). +-441683913266449 = +(-441683913266449). +0 = -441683913266449 div 815573799387579438257555. +-441683913266449 = -441683913266449 rem 815573799387579438257555. +815573799104386470379651 = -441683913266449 band 815573799387579438257555. +-158490945388545 = -441683913266449 bor 815573799387579438257555. +-815573799262877415768196 = -441683913266449 bxor 815573799387579438257555. +441683913266448 = bnot(-441683913266449). +-1932146918834075102100431195023309123629707192731767591505727311905482150279583583222046778003171933397097960701952 = -441683913266449 bsl 331. +-1 = -441683913266449 bsr 331. +52204 = 52158 + 46. +52112 = 52158 - 46. +2399268 = 52158 * 46. +-52158 = -(52158). +52158 = +(52158). +1133 = 52158 div 46. +40 = 52158 rem 46. +46 = 52158 band 46. +52158 = 52158 bor 46. +52112 = 52158 bxor 46. +-52159 = bnot(52158). +0 = 52158 bsl -52. +234898749364390330368 = 52158 bsr -52. +-97487593454442928269 = -4927 + -97487593454442923342. +97487593454442918415 = -4927 - -97487593454442923342. +480321372950040283306034 = -4927 * -97487593454442923342. +4927 = -(-4927). +-4927 = +(-4927). +0 = -4927 div -97487593454442923342. +-4927 = -4927 rem -97487593454442923342. +-97487593454442928000 = -4927 band -97487593454442923342. +-269 = -4927 bor -97487593454442923342. +97487593454442927731 = -4927 bxor -97487593454442923342. +4926 = bnot(-4927). +-14589799195796190115888637427625179461957316219966820150531977446278291785975988233475185242269022363399606798448114009259810209040362721455852515037780569978447627385816054314892114758123179507549420923285371859618471253297332224 = -4927 bsl 749. +-1 = -4927 bsr 749. +761499775066582643 = -3473149426889489 + 764972924493472132. +-768446073920361621 = -3473149426889489 - 764972924493472132. +-2656865274290479077637570265220548 = -3473149426889489 * 764972924493472132. +3473149426889489 = -(-3473149426889489). +-3473149426889489 = +(-3473149426889489). +0 = -3473149426889489 div 764972924493472132. +-3473149426889489 = -3473149426889489 rem 764972924493472132. +761574600322089092 = -3473149426889489 band 764972924493472132. +-74825255506449 = -3473149426889489 bor 764972924493472132. +-761649425577595541 = -3473149426889489 bxor 764972924493472132. +3473149426889488 = bnot(-3473149426889489). +-512546388860651254601660862186913792 = -3473149426889489 bsl 67. +-1 = -3473149426889489 bsr 67. +-29167626795 = -29167626868 + 73. +-29167626941 = -29167626868 - 73. +-2129236761364 = -29167626868 * 73. +29167626868 = -(-29167626868). +-29167626868 = +(-29167626868). +-399556532 = -29167626868 div 73. +-32 = -29167626868 rem 73. +8 = -29167626868 band 73. +-29167626803 = -29167626868 bor 73. +-29167626811 = -29167626868 bxor 73. +29167626867 = bnot(-29167626868). +-1 = -29167626868 bsl -296. +-3713469079651023032800980145115508414591077540621460200026867016400652828280866359537842689983643648 = -29167626868 bsr -296. +-5646468003438 = -5646468742754 + 739316. +-5646469482070 = -5646468742754 - 739316. +-4174524685017916264 = -5646468742754 * 739316. +5646468742754 = -(-5646468742754). +-5646468742754 = +(-5646468742754). +-7637422 = -5646468742754 div 739316. +-459402 = -5646468742754 rem 739316. +524692 = -5646468742754 band 739316. +-5646468528130 = -5646468742754 bor 739316. +-5646469052822 = -5646468742754 bxor 739316. +5646468742753 = bnot(-5646468742754). +-176452148212 = -5646468742754 bsl -5. +-180686999768128 = -5646468742754 bsr -5. +-956277620367771238126145 = -7868127313336278 + -956277612499643924789867. +956277604631516611453589 = -7868127313336278 - -956277612499643924789867. +7524114002040453690389825588077857895026 = -7868127313336278 * -956277612499643924789867. +7868127313336278 = -(-7868127313336278). +-7868127313336278 = +(-7868127313336278). +0 = -7868127313336278 div -956277612499643924789867. +-7868127313336278 = -7868127313336278 rem -956277612499643924789867. +-956277617377078110306304 = -7868127313336278 band -956277612499643924789867. +-2990693127819841 = -7868127313336278 bor -956277612499643924789867. +956277614386384982486463 = -7868127313336278 bxor -956277612499643924789867. +7868127313336277 = bnot(-7868127313336278). +-67586698983087317320728576 = -7868127313336278 bsl 33. +-915971 = -7868127313336278 bsr 33. +-3404395 = -3336216 + -68179. +-3268037 = -3336216 - -68179. +227459870664 = -3336216 * -68179. +3336216 = -(-3336216). +-3336216 = +(-3336216). +48 = -3336216 div -68179. +-63624 = -3336216 rem -68179. +-3402328 = -3336216 band -68179. +-2067 = -3336216 bor -68179. +3400261 = -3336216 bxor -68179. +3336215 = bnot(-3336216). +-1 = -3336216 bsl -55. +-120199849075419893465088 = -3336216 bsr -55. +-26667627288156133159209 = -73524972633286392 + -26667553763183499872817. +26667480238210866586425 = -73524972633286392 - -26667553763183499872817. +1960731160634760365163374554512736806264 = -73524972633286392 * -26667553763183499872817. +73524972633286392 = -(-73524972633286392). +-73524972633286392 = +(-73524972633286392). +0 = -73524972633286392 div -26667553763183499872817. +-73524972633286392 = -73524972633286392 rem -26667553763183499872817. +-26667625880162171580152 = -73524972633286392 band -26667553763183499872817. +-1407993961579057 = -73524972633286392 bor -26667553763183499872817. +26667624472168210001095 = -73524972633286392 bxor -26667553763183499872817. +73524972633286391 = bnot(-73524972633286392). +-132313005449321260680774500200028140830168861061069117670914111166517837616265409926801035271503411746776605137121977062322282496434290842261606645221444297756607760213967001092096 = -73524972633286392 bsl 539. +-1 = -73524972633286392 bsr 539. +546126779234557 = 83 + 546126779234474. +-546126779234391 = 83 - 546126779234474. +45328522676461342 = 83 * 546126779234474. +-83 = -(83). +83 = +(83). +0 = 83 div 546126779234474. +83 = 83 rem 546126779234474. +2 = 83 band 546126779234474. +546126779234555 = 83 bor 546126779234474. +546126779234553 = 83 bxor 546126779234474. +-84 = bnot(83). +332 = 83 bsl 2. +20 = 83 bsr 2. +-738133514617696188442939210579 = -738133514617696233638262947878 + 45195323737299. +-738133514617696278833586685177 = -738133514617696233638262947878 - 45195323737299. +-33360183154497104989277574453536007801501522 = -738133514617696233638262947878 * 45195323737299. +738133514617696233638262947878 = -(-738133514617696233638262947878). +-738133514617696233638262947878 = +(-738133514617696233638262947878). +-16332077161525586 = -738133514617696233638262947878 div 45195323737299. +-42488331915664 = -738133514617696233638262947878 rem 45195323737299. +1103137899730 = -738133514617696233638262947878 band 45195323737299. +-738133514617696189546077110309 = -738133514617696233638262947878 bor 45195323737299. +-738133514617696190649215010039 = -738133514617696233638262947878 bxor 45195323737299. +738133514617696233638262947877 = bnot(-738133514617696233638262947878). +-25362074442916346130709715643076500783104 = -738133514617696233638262947878 bsl 35. +-21482512663866400068 = -738133514617696233638262947878 bsr 35. +7373598033 = 7373916289 + -318256. +7374234545 = 7373916289 - -318256. +-2346793102471984 = 7373916289 * -318256. +-7373916289 = -(7373916289). +7373916289 = +(7373916289). +-23169 = 7373916289 div -318256. +243025 = 7373916289 rem -318256. +7373652096 = 7373916289 band -318256. +-54063 = 7373916289 bor -318256. +-7373706159 = 7373916289 bxor -318256. +-7373916290 = bnot(7373916289). +115217442 = 7373916289 bsl -6. +471930642496 = 7373916289 bsr -6. +-9555122457769466332373611435 = 4172342184 + -9555122457769466336545953619. +9555122457769466340718295803 = 4172342184 - -9555122457769466336545953619. +-39867240503837302943138623139061163896 = 4172342184 * -9555122457769466336545953619. +-4172342184 = -(4172342184). +4172342184 = +(4172342184). +0 = 4172342184 div -9555122457769466336545953619. +4172342184 = 4172342184 rem -9555122457769466336545953619. +2021695656 = 4172342184 band -9555122457769466336545953619. +-9555122457769466334395307091 = 4172342184 bor -9555122457769466336545953619. +-9555122457769466336417002747 = 4172342184 bxor -9555122457769466336545953619. +-4172342185 = bnot(4172342184). +0 = 4172342184 bsl -372. +40136389791856951738794660592982613363559313877413175890401099927085788488463139812582073973306647849955782653992253784064 = 4172342184 bsr -372. +363969588297217972 = -996737648375349 + 364966325945593321. +-365963063593968670 = -996737648375349 - 364966325945593321. +-363775677459201808215401515444029 = -996737648375349 * 364966325945593321. +996737648375349 = -(-996737648375349). +-996737648375349 = +(-996737648375349). +0 = -996737648375349 div 364966325945593321. +-996737648375349 = -996737648375349 rem 364966325945593321. +364814043308902857 = -996737648375349 band 364966325945593321. +-844455011684885 = -996737648375349 bor 364966325945593321. +-365658498320587742 = -996737648375349 bxor 364966325945593321. +996737648375348 = bnot(-996737648375349). +-574580134631598876693413926797312 = -996737648375349 bsl 59. +-1 = -996737648375349 bsr 59. +-9734193829925 = -717566 + -9734193112359. +9734192394793 = -717566 - -9734193112359. +6984926014862998194 = -717566 * -9734193112359. +717566 = -(-717566). +-717566 = +(-717566). +0 = -717566 div -9734193112359. +-717566 = -717566 rem -9734193112359. +-9734193149952 = -717566 band -9734193112359. +-679973 = -717566 bor -9734193112359. +9734192469979 = -717566 bxor -9734193112359. +717565 = bnot(-717566). +-44848 = -717566 bsl -4. +-11481056 = -717566 bsr -4. +678175877952508232 = 21487329859 + 678175856465178373. +-678175834977848514 = 21487329859 - 678175856465178373. +14572188330277125447923939407 = 21487329859 * 678175856465178373. +-21487329859 = -(21487329859). +21487329859 = +(21487329859). +0 = 21487329859 div 678175856465178373. +21487329859 = 21487329859 rem 678175856465178373. +4305068545 = 21487329859 band 678175856465178373. +678175873647439687 = 21487329859 bor 678175856465178373. +678175869342371142 = 21487329859 bxor 678175856465178373. +-21487329860 = bnot(21487329859). +5500756443904 = 21487329859 bsl 8. +83934882 = 21487329859 bsr 8. +7286046216 = -216257 + 7286262473. +-7286478730 = -216257 - 7286262473. +-1575705263623561 = -216257 * 7286262473. +216257 = -(-216257). +-216257 = +(-216257). +0 = -216257 div 7286262473. +-216257 = -216257 rem 7286262473. +7286063625 = -216257 band 7286262473. +-17409 = -216257 bor 7286262473. +-7286081034 = -216257 bxor 7286262473. +216256 = bnot(-216257). +-1857633485062144 = -216257 bsl 33. +-1 = -216257 bsr 33. +-6764481016209013 = 888466865577671 + -7652947881786684. +8541414747364355 = 888466865577671 - -7652947881786684. +-6799390616960291788045255532964 = 888466865577671 * -7652947881786684. +-888466865577671 = -(888466865577671). +888466865577671 = +(888466865577671). +0 = 888466865577671 div -7652947881786684. +888466865577671 = 888466865577671 rem -7652947881786684. +8856356815556 = 888466865577671 band -7652947881786684. +-6773337373024569 = 888466865577671 bor -7652947881786684. +-6782193729840125 = 888466865577671 bxor -7652947881786684. +-888466865577672 = bnot(888466865577671). +137483588309622589200810999915511218700288 = 888466865577671 bsl 87. +0 = 888466865577671 bsr 87. +91490331573054849644778 = 99741621496377689556299 + -8251289923322839911521. +107992911419700529467820 = 99741621496377689556299 - -8251289923322839911521. +-822997036388941987096763924793330974908220779 = 99741621496377689556299 * -8251289923322839911521. +-99741621496377689556299 = -(99741621496377689556299). +99741621496377689556299 = +(99741621496377689556299). +-12 = 99741621496377689556299 div -8251289923322839911521. +726142416503610618047 = 99741621496377689556299 rem -8251289923322839911521. +94447332200778076029195 = 99741621496377689556299 band -8251289923322839911521. +-2957000627723226384417 = 99741621496377689556299 bor -8251289923322839911521. +-97404332828501302413612 = 99741621496377689556299 bxor -8251289923322839911521. +-99741621496377689556300 = bnot(99741621496377689556299). +4174765856565762433809785303436052549481744663516623317101140077233477255380204318557841012624809946662412087062564502736088945479821863479435710747619717167586245784348605908982209472591040160588804704214594321655377727921255724473008462453546458253110240990996582037341144319885430793582000606583769395334471197239803904 = 99741621496377689556299 bsl 992. +0 = 99741621496377689556299 bsr 992. +724593654925448350082 = 868413935 + 724593654924579936147. +-724593654923711522212 = 868413935 - 724593654924579936147. +629247227149086590571465008445 = 868413935 * 724593654924579936147. +-868413935 = -(868413935). +868413935 = +(868413935). +0 = 868413935 div 724593654924579936147. +868413935 = 868413935 rem 724593654924579936147. +293769603 = 868413935 band 724593654924579936147. +724593654925154580479 = 868413935 bor 724593654924579936147. +724593654924860810876 = 868413935 bxor 724593654924579936147. +-868413936 = bnot(868413935). +8009704804494020882968084480 = 868413935 bsl 63. +0 = 868413935 bsr 63. +8632255073244542809708331575 = -7118711883835919751124254 + 8639373785128378729459455829. +-8646492497012214649210580083 = -7118711883835919751124254 - 8639373785128378729459455829. +-61501212833093901526261388977476702258823433803576566 = -7118711883835919751124254 * 8639373785128378729459455829. +7118711883835919751124254 = -(-7118711883835919751124254). +-7118711883835919751124254 = +(-7118711883835919751124254). +0 = -7118711883835919751124254 div 8639373785128378729459455829. +-7118711883835919751124254 = -7118711883835919751124254 rem 8639373785128378729459455829. +8639062071729512996535304768 = -7118711883835919751124254 band 8639373785128378729459455829. +-6806998484970186826973193 = -7118711883835919751124254 bor 8639373785128378729459455829. +-8645869070214483183362277961 = -7118711883835919751124254 bxor 8639373785128378729459455829. +7118711883835919751124253 = bnot(-7118711883835919751124254). +-771813 = -7118711883835919751124254 bsl -63. +-65658528127798005347284574349651537121247232 = -7118711883835919751124254 bsr -63. +-846509452415985654555762 = -839311283762714365725835 + -7198168653271288829927. +-832113115109443076895908 = -839311283762714365725835 - -7198168653271288829927. +6041504173117654213676998143437530729225064045 = -839311283762714365725835 * -7198168653271288829927. +839311283762714365725835 = -(-839311283762714365725835). +-839311283762714365725835 = +(-839311283762714365725835). +116 = -839311283762714365725835 div -7198168653271288829927. +-4323719983244861454303 = -839311283762714365725835 rem -7198168653271288829927. +-839386225952523109916655 = -839311283762714365725835 band -7198168653271288829927. +-7123226463462544639107 = -839311283762714365725835 bor -7198168653271288829927. +832262999489060565277548 = -839311283762714365725835 bxor -7198168653271288829927. +839311283762714365725834 = bnot(-839311283762714365725835). +-26857961080406859703226720 = -839311283762714365725835 bsl 5. +-26228477617584823928933 = -839311283762714365725835 bsr 5. +59337771524502253278240 = -311674139136692 + 59337771836176392414932. +-59337772147850531551624 = -311674139136692 - 59337771836176392414932. +-18494048955329724865880685275529884944 = -311674139136692 * 59337771836176392414932. +311674139136692 = -(-311674139136692). +-311674139136692 = +(-311674139136692). +0 = -311674139136692 div 59337771836176392414932. +-311674139136692 = -311674139136692 rem 59337771836176392414932. +59337771545891229279300 = -311674139136692 band 59337771836176392414932. +-21388976001060 = -311674139136692 bor 59337771836176392414932. +-59337771567280205280360 = -311674139136692 bxor 59337771836176392414932. +311674139136691 = bnot(-311674139136692). +-9739816848022 = -311674139136692 bsl -5. +-9973572452374144 = -311674139136692 bsr -5. +7384361237883868414254203561 = 7384361237883874829616473378 + -6415362269817. +7384361237883881244978743195 = 7384361237883874829616473378 - -6415362269817. +-47373352472219367116791452785860833431826 = 7384361237883874829616473378 * -6415362269817. +-7384361237883874829616473378 = -(7384361237883874829616473378). +7384361237883874829616473378 = +(7384361237883874829616473378). +-1151043530717793 = 7384361237883874829616473378 div -6415362269817. +565867719497 = 7384361237883874829616473378 rem -6415362269817. +7384361237883868489432974594 = 7384361237883874829616473378 band -6415362269817. +-75178771033 = 7384361237883874829616473378 bor -6415362269817. +-7384361237883868564611745627 = 7384361237883874829616473378 bxor -6415362269817. +-7384361237883874829616473379 = bnot(7384361237883874829616473378). +4059595522375848785786921648814674673664 = 7384361237883874829616473378 bsl 39. +13432074843665531 = 7384361237883874829616473378 bsr 39. +-3977553155326023397025 = -3977553156125337758647 + 799314361622. +-3977553156924652120269 = -3977553156125337758647 - 799314361622. +-3179315361805895649572059115445434 = -3977553156125337758647 * 799314361622. +3977553156125337758647 = -(-3977553156125337758647). +-3977553156125337758647 = +(-3977553156125337758647). +-4976206292 = -3977553156125337758647 div 799314361622. +-535978033023 = -3977553156125337758647 rem 799314361622. +249548575744 = -3977553156125337758647 band 799314361622. +-3977553155575571972769 = -3977553156125337758647 bor 799314361622. +-3977553155825120548513 = -3977553156125337758647 bxor 799314361622. +3977553156125337758646 = bnot(-3977553156125337758647). +-1 = -3977553156125337758647 bsl -94. +-78783556965655822831177085280930750212150130638848 = -3977553156125337758647 bsr -94. +-632628718016347 = -632621446787599 + -7271228748. +-632614175558851 = -632621446787599 - -7271228748. +4599935250483342098696052 = -632621446787599 * -7271228748. +632621446787599 = -(-632621446787599). +-632621446787599 = +(-632621446787599). +87003 = -632621446787599 div -7271228748. +-2732025355 = -632621446787599 rem -7271228748. +-632621738424144 = -632621446787599 band -7271228748. +-6979592203 = -632621446787599 bor -7271228748. +632614758831941 = -632621446787599 bxor -7271228748. +632621446787598 = bnot(-632621446787599). +-9206 = -632621446787599 bsl -36. +-43473414795215071413796864 = -632621446787599 bsr -36. +929613671737385374580 = 859391 + 929613671737384515189. +-929613671737383655798 = 859391 - 929613671737384515189. +798901622968062615892789899 = 859391 * 929613671737384515189. +-859391 = -(859391). +859391 = +(859391). +0 = 859391 div 929613671737384515189. +859391 = 859391 rem 929613671737384515189. +267381 = 859391 band 929613671737384515189. +929613671737385107199 = 859391 bor 929613671737384515189. +929613671737384839818 = 859391 bxor 929613671737384515189. +-859392 = bnot(859391). +472455198653022208 = 859391 bsl 39. +0 = 859391 bsr 39. +75357881755642898911906 = 75357881755569421413484 + 73477498422. +75357881755495943915062 = 75357881755569421413484 - 73477498422. +5537108637780114751620723619522248 = 75357881755569421413484 * 73477498422. +-75357881755569421413484 = -(75357881755569421413484). +75357881755569421413484 = +(75357881755569421413484). +1025591281330 = 75357881755569421413484 div 73477498422. +27388352224 = 75357881755569421413484 rem 73477498422. +4446594084 = 75357881755569421413484 band 73477498422. +75357881755638452317822 = 75357881755569421413484 bor 73477498422. +75357881755634005723738 = 75357881755569421413484 bxor 73477498422. +-75357881755569421413485 = bnot(75357881755569421413484). +1205726108089110742615744 = 75357881755569421413484 bsl 4. +4709867609723088838342 = 75357881755569421413484 bsr 4. +52686088 = -81126 + 52767214. +-52848340 = -81126 - 52767214. +-4280793002964 = -81126 * 52767214. +81126 = -(-81126). +-81126 = +(-81126). +0 = -81126 div 52767214. +-81126 = -81126 rem 52767214. +52691210 = -81126 band 52767214. +-5122 = -81126 bor 52767214. +-52696332 = -81126 bxor 52767214. +81125 = bnot(-81126). +-1 = -81126 bsl -78. +-24518829010514101606803308544 = -81126 bsr -78. +-93444457447505 = -93444456497546 + -949959. +-93444455547587 = -93444456497546 - -949959. +88768402449952300614 = -93444456497546 * -949959. +93444456497546 = -(-93444456497546). +-93444456497546 = +(-93444456497546). +98366831 = -93444456497546 div -949959. +-87617 = -93444456497546 rem -949959. +-93444457299920 = -93444456497546 band -949959. +-147585 = -93444456497546 bor -949959. +93444457152335 = -93444456497546 bxor -949959. +93444456497545 = bnot(-93444456497546). +-1 = -93444456497546 bsl -914. +-12941051909268604697162829316830566897993099152071438805265906320814944091424858349699489680718123770888301404623392627447633281381525770576269811087080625668986264684171387393369784316629809758745706270318418308651539390272376226390091132313131238731721120970038334365730701400102261489664 = -93444456497546 bsr -914. +-5617861855288475533985269679 = 645987691562896 + -5617861855289121521676832575. +5617861855289767509368395471 = 645987691562896 - -5617861855289121521676832575. +-3629069611417467716101248871383636674137200 = 645987691562896 * -5617861855289121521676832575. +-645987691562896 = -(645987691562896). +645987691562896 = +(645987691562896). +0 = 645987691562896 div -5617861855289121521676832575. +645987691562896 = 645987691562896 rem -5617861855289121521676832575. +636637136552064 = 645987691562896 band -5617861855289121521676832575. +-5617861855289112171121821743 = 645987691562896 bor -5617861855289121521676832575. +-5617861855289748808258373807 = 645987691562896 bxor -5617861855289121521676832575. +-645987691562897 = bnot(645987691562896). +363658740876073166051634839552 = 645987691562896 bsl 49. +1 = 645987691562896 bsr 49. +66715149278699370 = -48844 + 66715149278748214. +-66715149278797058 = -48844 - 66715149278748214. +-3258634751371177764616 = -48844 * 66715149278748214. +48844 = -(-48844). +-48844 = +(-48844). +0 = -48844 div 66715149278748214. +-48844 = -48844 rem 66715149278748214. +66715149278707764 = -48844 band 66715149278748214. +-8394 = -48844 bor 66715149278748214. +-66715149278716158 = -48844 bxor 66715149278748214. +48843 = bnot(-48844). +-1 = -48844 bsl -38. +-13426136486772736 = -48844 bsr -38. +3295561145144957083124548 = 3295561145144956985824896 + 97299652. +3295561145144956888525244 = 3295561145144956985824896 - 97299652. +320656952567325804275731313736192 = 3295561145144956985824896 * 97299652. +-3295561145144956985824896 = -(3295561145144956985824896). +3295561145144956985824896 = +(3295561145144956985824896). +33870225405790320 = 3295561145144956985824896 div 97299652. +64856256 = 3295561145144956985824896 rem 97299652. +25691264 = 3295561145144956985824896 band 97299652. +3295561145144957057433284 = 3295561145144956985824896 bor 97299652. +3295561145144957031742020 = 3295561145144956985824896 bxor 97299652. +-3295561145144956985824897 = bnot(3295561145144956985824896). +259703441323196961676360460665136735063618879506226750493095879826011849090010994459984645721689952198507282266369597144389258950003782582272 = 3295561145144956985824896 bsl 385. +0 = 3295561145144956985824896 bsr 385. +-986476643886792959314064916 = 615218779 + -986476643886792959929283695. +986476643886792960544502474 = 615218779 - -986476643886792959929283695. +-606898956364050579033489841182508405 = 615218779 * -986476643886792959929283695. +-615218779 = -(615218779). +615218779 = +(615218779). +0 = 615218779 div -986476643886792959929283695. +615218779 = 615218779 rem -986476643886792959929283695. +69798417 = 615218779 band -986476643886792959929283695. +-986476643886792959383863333 = 615218779 bor -986476643886792959929283695. +-986476643886792959453661750 = 615218779 bxor -986476643886792959929283695. +-615218780 = bnot(615218779). +18 = 615218779 bsl -25. +20643316685078528 = 615218779 bsr -25. +-467349317662454183287639774 = 64746241233363 + -467349317662518929528873137. +467349317662583675770106500 = 64746241233363 - -467349317662518929528873137. +-30259111661625046096016841538274438869731 = 64746241233363 * -467349317662518929528873137. +-64746241233363 = -(64746241233363). +64746241233363 = +(64746241233363). +0 = 64746241233363 div -467349317662518929528873137. +64746241233363 = 64746241233363 rem -467349317662518929528873137. +9632143741251 = 64746241233363 band -467349317662518929528873137. +-467349317662463815431381025 = 64746241233363 bor -467349317662518929528873137. +-467349317662473447575122276 = 64746241233363 bxor -467349317662518929528873137. +-64746241233364 = bnot(64746241233363). +1011660019271 = 64746241233363 bsl -6. +4143759438935232 = 64746241233363 bsr -6. +35450086531620560507 = 3341273982796755 + 35446745257637763752. +-35443403983654966997 = 3341273982796755 - 35446745257637763752. +118437287704169318322969476922224760 = 3341273982796755 * 35446745257637763752. +-3341273982796755 = -(3341273982796755). +3341273982796755 = +(3341273982796755). +0 = 3341273982796755 div 35446745257637763752. +3341273982796755 = 3341273982796755 rem 35446745257637763752. +2254002062525056 = 3341273982796755 band 35446745257637763752. +35447832529558035451 = 3341273982796755 bor 35446745257637763752. +35445578527495510395 = 3341273982796755 bxor 35446745257637763752. +-3341273982796756 = bnot(3341273982796755). +0 = 3341273982796755 bsl -582. +52889512678192664732690770583278780993203394534456274139414018863445336544367899815668028889670017211503927199630045246956599926056869252654122021934322204013537551648566187968385045254635520 = 3341273982796755 bsr -582. +578708048628698322701 = -8487932719457493135 + 587195981348155815836. +-595683914067613308971 = -8487932719457493135 - 587195981348155815836. +-4984079982818963609910892068739294285860 = -8487932719457493135 * 587195981348155815836. +8487932719457493135 = -(-8487932719457493135). +-8487932719457493135 = +(-8487932719457493135). +0 = -8487932719457493135 div 587195981348155815836. +-8487932719457493135 = -8487932719457493135 rem 587195981348155815836. +581085949258189772560 = -8487932719457493135 band 587195981348155815836. +-2377900629491449859 = -8487932719457493135 bor 587195981348155815836. +-583463849887681222419 = -8487932719457493135 bxor 587195981348155815836. +8487932719457493134 = bnot(-8487932719457493135). +-33155987185380833 = -8487932719457493135 bsl -8. +-2172910776181118242560 = -8487932719457493135 bsr -8. +-98251539676273547556103585 = -7652797965119 + -98251539676265894758138466. +98251539676258241960173347 = -7652797965119 - -98251539676265894758138466. +751899182904336331425461861269240167454 = -7652797965119 * -98251539676265894758138466. +7652797965119 = -(-7652797965119). +-7652797965119 = +(-7652797965119). +0 = -7652797965119 div -98251539676265894758138466. +-7652797965119 = -7652797965119 rem -98251539676265894758138466. +-98251539676268660856316800 = -7652797965119 band -98251539676265894758138466. +-4886699786785 = -7652797965119 bor -98251539676265894758138466. +98251539676263774156530015 = -7652797965119 bxor -98251539676265894758138466. +7652797965118 = bnot(-7652797965119). +-256785288930323857408 = -7652797965119 bsl 25. +-228072 = -7652797965119 bsr 25. +-938601950 = -934814639 + -3787311. +-931027328 = -934814639 - -3787311. +3540433765245729 = -934814639 * -3787311. +934814639 = -(-934814639). +-934814639 = +(-934814639). +246 = -934814639 div -3787311. +-3136133 = -934814639 rem -3787311. +-934931375 = -934814639 band -3787311. +-3670575 = -934814639 bor -3787311. +931260800 = -934814639 bxor -3787311. +934814638 = bnot(-934814639). +-3651620 = -934814639 bsl -8. +-239312547584 = -934814639 bsr -8. +-387581 = -656 + -386925. +386269 = -656 - -386925. +253822800 = -656 * -386925. +656 = -(-656). +-656 = +(-656). +0 = -656 div -386925. +-656 = -656 rem -386925. +-387056 = -656 band -386925. +-525 = -656 bor -386925. +386531 = -656 bxor -386925. +655 = bnot(-656). +-2624 = -656 bsl 2. +-164 = -656 bsr 2. +-6514808036364428552 = -896184894532265 + -6513911851469896287. +6513015666575364022 = -896184894532265 - -6513911851469896287. +5837669405602020039778712925200055 = -896184894532265 * -6513911851469896287. +896184894532265 = -(-896184894532265). +-896184894532265 = +(-896184894532265). +0 = -896184894532265 div -6513911851469896287. +-896184894532265 = -896184894532265 rem -6513911851469896287. +-6514245013329410815 = -896184894532265 band -6513911851469896287. +-563023035017737 = -896184894532265 bor -6513911851469896287. +6513681990294393078 = -896184894532265 bxor -6513911851469896287. +896184894532264 = bnot(-896184894532265). +-2116056754196618103829184408945950720 = -896184894532265 bsl 71. +-1 = -896184894532265 bsr 71. +-97222758789292894469424106674 = -97222758789292894469423252399 + -854275. +-97222758789292894469422398124 = -97222758789292894469423252399 - -854275. +83054972264723187422866548943155725 = -97222758789292894469423252399 * -854275. +97222758789292894469423252399 = -(-97222758789292894469423252399). +-97222758789292894469423252399 = +(-97222758789292894469423252399). +113807332286784576944687 = -97222758789292894469423252399 div -854275. +-765474 = -97222758789292894469423252399 rem -854275. +-97222758789292894469423582127 = -97222758789292894469423252399 band -854275. +-524547 = -97222758789292894469423252399 bor -854275. +97222758789292894469423057580 = -97222758789292894469423252399 bxor -854275. +97222758789292894469423252398 = bnot(-97222758789292894469423252399). +-388891035157171577877693009596 = -97222758789292894469423252399 bsl 2. +-24305689697323223617355813100 = -97222758789292894469423252399 bsr 2. +45314799959449834 = 8619 + 45314799959441215. +-45314799959432596 = 8619 - 45314799959441215. +390568260850423832085 = 8619 * 45314799959441215. +-8619 = -(8619). +8619 = +(8619). +0 = 8619 div 45314799959441215. +8619 = 8619 rem 45314799959441215. +8491 = 8619 band 45314799959441215. +45314799959441343 = 8619 bor 45314799959441215. +45314799959432852 = 8619 bxor 45314799959441215. +-8620 = bnot(8619). +7941353061410367410881337630258273820999253905949536145550420435013924476478987049836505430738828348984354473728064838669707682843096139575206787552025978320364779864064 = 8619 bsl 548. +0 = 8619 bsr 548. +-567484289988620768675110 = 832462677188 + -567484289989453231352298. +567484289990285694029486 = 832462677188 - -567484289989453231352298. +-472409491306751585255851530675978024 = 832462677188 * -567484289989453231352298. +-832462677188 = -(832462677188). +832462677188 = +(832462677188). +0 = 832462677188 div -567484289989453231352298. +832462677188 = 832462677188 rem -567484289989453231352298. +1107297284 = 832462677188 band -567484289989453231352298. +-567484289988621875972394 = 832462677188 bor -567484289989453231352298. +-567484289988622983269678 = 832462677188 bxor -567484289989453231352298. +-832462677189 = bnot(832462677188). +128817359912715694748896543518452875264 = 832462677188 bsl 87. +0 = 832462677188 bsr 87. +823334994347687588935276277 = -8726434876 + 823334994347687597661711153. +-823334994347687606388146029 = -8726434876 - 823334994347687597661711153. +-7184779209306923922187812255377372028 = -8726434876 * 823334994347687597661711153. +8726434876 = -(-8726434876). +-8726434876 = +(-8726434876). +0 = -8726434876 div 823334994347687597661711153. +-8726434876 = -8726434876 rem 823334994347687597661711153. +823334994347687597659466496 = -8726434876 band 823334994347687597661711153. +-8724190219 = -8726434876 bor 823334994347687597661711153. +-823334994347687606383656715 = -8726434876 bxor 823334994347687597661711153. +8726434875 = bnot(-8726434876). +-2637403108695496227490767824748544 = -8726434876 bsl 78. +-1 = -8726434876 bsr 78. +509565608112303867308591 = -9933529355932531354156 + 519499137468236398662747. +-529432666824168930016903 = -9933529355932531354156 - 519499137468236398662747. +-5160459932422355880342008555720285127460826532 = -9933529355932531354156 * 519499137468236398662747. +9933529355932531354156 = -(-9933529355932531354156). +-9933529355932531354156 = +(-9933529355932531354156). +0 = -9933529355932531354156 div 519499137468236398662747. +-9933529355932531354156 = -9933529355932531354156 rem 519499137468236398662747. +510015616812963311457360 = -9933529355932531354156 band 519499137468236398662747. +-450008700659444148769 = -9933529355932531354156 bor 519499137468236398662747. +-510465625513622755606129 = -9933529355932531354156 bxor 519499137468236398662747. +9933529355932531354155 = bnot(-9933529355932531354156). +-317872939389841003332992 = -9933529355932531354156 bsl 5. +-310422792372891604818 = -9933529355932531354156 bsr 5. +-37096154251521333714133 = 73423963737328583155 + -37169578215258662297288. +37243002178995990880443 = 73423963737328583155 - -37169578215258662297288. +-2729137763008950497871192185843978438983640 = 73423963737328583155 * -37169578215258662297288. +-73423963737328583155 = -(73423963737328583155). +73423963737328583155 = +(73423963737328583155). +0 = 73423963737328583155 div -37169578215258662297288. +73423963737328583155 = 73423963737328583155 rem -37169578215258662297288. +19055295172658069808 = 73423963737328583155 band -37169578215258662297288. +-37115209546693991783941 = 73423963737328583155 bor -37169578215258662297288. +-37134264841866649853749 = 73423963737328583155 bxor -37169578215258662297288. +-73423963737328583156 = bnot(73423963737328583155). +60086328323069571884886422554887049463830943694271535732589302468223369323657564870290153787226398591009460002240599573447008736990986904085469235396956305326233427640320 = 73423963737328583155 bsl 498. +0 = 73423963737328583155 bsr 498. +-97385435680005309784032198 = -31643372812742 + -97385435679973666411219456. +97385435679942023038406714 = -31643372812742 - -97385435679973666411219456. +3081603647752713441867279806232955108352 = -31643372812742 * -97385435679973666411219456. +31643372812742 = -(-31643372812742). +-31643372812742 = +(-31643372812742). +0 = -31643372812742 div -97385435679973666411219456. +-31643372812742 = -31643372812742 rem -97385435679973666411219456. +-97385435679987418936637952 = -31643372812742 band -97385435679973666411219456. +-17890847394246 = -31643372812742 bor -97385435679973666411219456. +97385435679969528089243706 = -31643372812742 bxor -97385435679973666411219456. +31643372812741 = bnot(-31643372812742). +-1 = -31643372812742 bsl -99. +-20056370269659015991794578266269362207850496 = -31643372812742 bsr -99. +2696944336321953535277237639 = 4 + 2696944336321953535277237635. +-2696944336321953535277237631 = 4 - 2696944336321953535277237635. +10787777345287814141108950540 = 4 * 2696944336321953535277237635. +-4 = -(4). +4 = +(4). +0 = 4 div 2696944336321953535277237635. +4 = 4 rem 2696944336321953535277237635. +0 = 4 band 2696944336321953535277237635. +2696944336321953535277237639 = 4 bor 2696944336321953535277237635. +2696944336321953535277237639 = 4 bxor 2696944336321953535277237635. +-5 = bnot(4). +68719476736 = 4 bsl 34. +0 = 4 bsr 34. +-4552277100 = -4453455525 + -98821575. +-4354633950 = -4453455525 - -98821575. +440097489172951875 = -4453455525 * -98821575. +4453455525 = -(-4453455525). +-4453455525 = +(-4453455525). +45 = -4453455525 div -98821575. +-6484650 = -4453455525 rem -98821575. +-4529059815 = -4453455525 band -98821575. +-23217285 = -4453455525 bor -98821575. +4505842530 = -4453455525 bxor -98821575. +4453455524 = bnot(-4453455525). +-1 = -4453455525 bsl -39. +-2448313066760385331200 = -4453455525 bsr -39. +9933367324985400417482 = -989164129354261 + 9933368314149529771743. +-9933369303313659126004 = -989164129354261 - 9933368314149529771743. +-9825731620020922984764659973314446923 = -989164129354261 * 9933368314149529771743. +989164129354261 = -(-989164129354261). +-989164129354261 = +(-989164129354261). +0 = -989164129354261 div 9933368314149529771743. +-989164129354261 = -989164129354261 rem 9933368314149529771743. +9933368032527978126539 = -989164129354261 band 9933368314149529771743. +-707542577709057 = -989164129354261 bor 9933368314149529771743. +-9933368740070555835596 = -989164129354261 bxor 9933368314149529771743. +989164129354260 = bnot(-989164129354261). +-1 = -989164129354261 bsl -816. +-432259772646768474565743340945911685180939112368269936973860870163212437849557138458245552085199626816186005750617365378632608731145945336023653710938459786500342977738666480323242539275941384501750417946839160709008859216903183353877678051450083859962208976896 = -989164129354261 bsr -816. +35455434641626474236 = -8191467337 + 35455434649817941573. +-35455434658009408910 = -8191467337 - 35455434649817941573. +-290432034853121701391803901101 = -8191467337 * 35455434649817941573. +8191467337 = -(-8191467337). +-8191467337 = +(-8191467337). +0 = -8191467337 div 35455434649817941573. +-8191467337 = -8191467337 rem 35455434649817941573. +35455434647532470277 = -8191467337 band 35455434649817941573. +-5905996041 = -8191467337 bor 35455434649817941573. +-35455434653438466318 = -8191467337 bxor 35455434649817941573. +8191467336 = bnot(-8191467337). +-4194031276544 = -8191467337 bsl 9. +-15998960 = -8191467337 bsr 9. +866121085978430578 = -6318836466295679 + 872439922444726257. +-878758758911021936 = -6318836466295679 - 872439922444726257. +-5512805196595910305947821976943503 = -6318836466295679 * 872439922444726257. +6318836466295679 = -(-6318836466295679). +-6318836466295679 = +(-6318836466295679). +0 = -6318836466295679 div 872439922444726257. +-6318836466295679 = -6318836466295679 rem 872439922444726257. +867370690654260353 = -6318836466295679 band 872439922444726257. +-1249604675829775 = -6318836466295679 bor 872439922444726257. +-868620295330090128 = -6318836466295679 bxor 872439922444726257. +6318836466295678 = bnot(-6318836466295679). +-1778594347189020103220526055424 = -6318836466295679 bsl 48. +-23 = -6318836466295679 bsr 48. +-838928431376113277356992188754 = 532 + -838928431376113277356992189286. +838928431376113277356992189818 = 532 - -838928431376113277356992189286. +-446309925492092263553919844700152 = 532 * -838928431376113277356992189286. +-532 = -(532). +532 = +(532). +0 = 532 div -838928431376113277356992189286. +532 = 532 rem -838928431376113277356992189286. +16 = 532 band -838928431376113277356992189286. +-838928431376113277356992188770 = 532 bor -838928431376113277356992189286. +-838928431376113277356992188786 = 532 bxor -838928431376113277356992189286. +-533 = bnot(532). +17024 = 532 bsl 5. +16 = 532 bsr 5. +835256139615651161826982037484 = 835256139615651258654646787165 + -96827664749681. +835256139615651355482311536846 = 835256139615651258654646787165 - -96827664749681. +-80875901466817027217390282385766390608644365 = 835256139615651258654646787165 * -96827664749681. +-835256139615651258654646787165 = -(835256139615651258654646787165). +835256139615651258654646787165 = +(835256139615651258654646787165). +-8626213817868648 = 835256139615651258654646787165 div -96827664749681. +12782788885877 = 835256139615651258654646787165 rem -96827664749681. +835256139615651240991861508109 = 835256139615651258654646787165 band -96827664749681. +-79164879470625 = 835256139615651258654646787165 bor -96827664749681. +-835256139615651320156740978734 = 835256139615651258654646787165 bxor -96827664749681. +-835256139615651258654646787166 = bnot(835256139615651258654646787165). +13050877181494550916478856049 = 835256139615651258654646787165 bsl -6. +53456392935401680553897394378560 = 835256139615651258654646787165 bsr -6. +5975929321496698341544 = 5975929321496698341539 + 5. +5975929321496698341534 = 5975929321496698341539 - 5. +29879646607483491707695 = 5975929321496698341539 * 5. +-5975929321496698341539 = -(5975929321496698341539). +5975929321496698341539 = +(5975929321496698341539). +1195185864299339668307 = 5975929321496698341539 div 5. +4 = 5975929321496698341539 rem 5. +1 = 5975929321496698341539 band 5. +5975929321496698341543 = 5975929321496698341539 bor 5. +5975929321496698341542 = 5975929321496698341539 bxor 5. +-5975929321496698341540 = bnot(5975929321496698341539). +371496063840359799118004057551362324785911970559740878742915756886585495727539355412378263482391299409051648 = 5975929321496698341539 bsl 285. +0 = 5975929321496698341539 bsr 285. +-76789134657341395858736391309 = 3 + -76789134657341395858736391312. +76789134657341395858736391315 = 3 - -76789134657341395858736391312. +-230367403972024187576209173936 = 3 * -76789134657341395858736391312. +-3 = -(3). +3 = +(3). +0 = 3 div -76789134657341395858736391312. +3 = 3 rem -76789134657341395858736391312. +0 = 3 band -76789134657341395858736391312. +-76789134657341395858736391309 = 3 bor -76789134657341395858736391312. +-76789134657341395858736391309 = 3 bxor -76789134657341395858736391312. +-4 = bnot(3). +96 = 3 bsl 5. +0 = 3 bsr 5. +-972912573952353043619267387590 = -972912571787978446351768634963 + -2164374597267498752627. +-972912569623603849084269882336 = -972912571787978446351768634963 - -2164374597267498752627. +2105747255740092318635706185048342783618905000297801 = -972912571787978446351768634963 * -2164374597267498752627. +972912571787978446351768634963 = -(-972912571787978446351768634963). +-972912571787978446351768634963 = +(-972912571787978446351768634963). +449512100 = -972912571787978446351768634963 div -2164374597267498752627. +-1383610820311025348263 = -972912571787978446351768634963 rem -2164374597267498752627. +-972912572697643119681296293491 = -972912571787978446351768634963 band -2164374597267498752627. +-1254709923937971094099 = -972912571787978446351768634963 bor -2164374597267498752627. +972912571442933195743325199392 = -972912571787978446351768634963 bxor -2164374597267498752627. +972912571787978446351768634962 = bnot(-972912571787978446351768634963). +-206022251 = -972912571787978446351768634963 bsl -72. +-4594449719774056986990108839949590416305948352053248 = -972912571787978446351768634963 bsr -72. +-368694148740671175525604 = 717324848622586465652 + -369411473589293761991256. +370128798437916348456908 = 717324848622586465652 - -369411473589293761991256. +-264988029371886745960981433433994966768338912 = 717324848622586465652 * -369411473589293761991256. +-717324848622586465652 = -(717324848622586465652). +717324848622586465652 = +(717324848622586465652). +0 = 717324848622586465652 div -369411473589293761991256. +717324848622586465652 = 717324848622586465652 rem -369411473589293761991256. +113049512052828540192 = 717324848622586465652 band -369411473589293761991256. +-368807198252724004065796 = 717324848622586465652 bor -369411473589293761991256. +-368920247764776832605988 = 717324848622586465652 bxor -369411473589293761991256. +-717324848622586465653 = bnot(717324848622586465652). +3255231258462683863258487392003512564171824532565768030597274640785308663687009408682524071334781070174200620562413181685430433235754844555593076739044560515618419345374711226882314266250976292724903960588751204902335018453221756485226777054353505364397985992256190606645305837000971566495144161050624 = 717324848622586465652 bsl 929. +0 = 717324848622586465652 bsr 929. +-836464698689084617970645316 = -836464698686742118695776464 + -2342499274868852. +-836464698684399619420907612 = -836464698686742118695776464 - -2342499274868852. +1959417950127086192853451457099349908299328 = -836464698686742118695776464 * -2342499274868852. +836464698686742118695776464 = -(-836464698686742118695776464). +-836464698686742118695776464 = +(-836464698686742118695776464). +357082159068 = -836464698686742118695776464 div -2342499274868852. +-1348053993226528 = -836464698686742118695776464 rem -2342499274868852. +-836464698686832487159265536 = -836464698686742118695776464 band -2342499274868852. +-2252130811379780 = -836464698686742118695776464 bor -2342499274868852. +836464698684580356347885756 = -836464698686742118695776464 bxor -2342499274868852. +836464698686742118695776463 = bnot(-836464698686742118695776464). +-6691717589493936949566211712 = -836464698686742118695776464 bsl 3. +-104558087335842764836972058 = -836464698686742118695776464 bsr 3. +696585230662675608544 = 726333654824223364519 + -29748424161547755975. +756082078985771120494 = 726333654824223364519 - -29748424161547755975. +-21607281646518214144391285666208885251025 = 726333654824223364519 * -29748424161547755975. +-726333654824223364519 = -(726333654824223364519). +726333654824223364519 = +(726333654824223364519). +-24 = 726333654824223364519 div -29748424161547755975. +12371474947077221119 = 726333654824223364519 rem -29748424161547755975. +705813141625409655841 = 726333654824223364519 band -29748424161547755975. +-9227910962734047297 = 726333654824223364519 bor -29748424161547755975. +-715041052588143703138 = 726333654824223364519 bxor -29748424161547755975. +-726333654824223364520 = bnot(726333654824223364519). +0 = 726333654824223364519 bsl -871. +11435690451366222024367175662929179710635743234945722592068379701662961338420744154925516990271411044523107699951959958023547144448199929569201741028579907058237786908876106979333458778292628538248539604428551721719270108790275745604896016465451216263949689199341385719758959895642112 = 726333654824223364519 bsr -871. +97526085963108 = 893141621 + 97525192821487. +-97524299679866 = 893141621 - 97525192821487. +87103808804920462810427 = 893141621 * 97525192821487. +-893141621 = -(893141621). +893141621 = +(893141621). +0 = 893141621 div 97525192821487. +893141621 = 893141621 rem 97525192821487. +272106085 = 893141621 band 97525192821487. +97525813857023 = 893141621 bor 97525192821487. +97525541750938 = 893141621 bxor 97525192821487. +-893141622 = bnot(893141621). +27910675 = 893141621 bsl -5. +28580531872 = 893141621 bsr -5. +-588282776776163612977818769727 = 6844 + -588282776776163612977818776571. +588282776776163612977818783415 = 6844 - -588282776776163612977818776571. +-4026207324256063767220191706851924 = 6844 * -588282776776163612977818776571. +-6844 = -(6844). +6844 = +(6844). +0 = 6844 div -588282776776163612977818776571. +6844 = 6844 rem -588282776776163612977818776571. +2052 = 6844 band -588282776776163612977818776571. +-588282776776163612977818771779 = 6844 bor -588282776776163612977818776571. +-588282776776163612977818773831 = 6844 bxor -588282776776163612977818776571. +-6845 = bnot(6844). +0 = 6844 bsl -79. +4136944154721261035844534272 = 6844 bsr -79. +5491768516893889754824 = 27265255183351 + 5491768489628634571473. +-5491768462363379388122 = 27265255183351 - 5491768489628634571473. +149734469277610821234926847929146023 = 27265255183351 * 5491768489628634571473. +-27265255183351 = -(27265255183351). +27265255183351 = +(27265255183351). +0 = 27265255183351 div 5491768489628634571473. +27265255183351 = 27265255183351 rem 5491768489628634571473. +9397493400273 = 27265255183351 band 5491768489628634571473. +5491768507496396354551 = 27265255183351 bor 5491768489628634571473. +5491768498098902954278 = 27265255183351 bxor 5491768489628634571473. +-27265255183352 = bnot(27265255183351). +590605833979279523757345160506562130760604478596484640331883899311197720867385191048344070202384917859514703010595620818844555467936296337408 = 27265255183351 bsl 423. +0 = 27265255183351 bsr 423. +-243633971503659577459246664 = 33528189219127257 + -243633971537187766678373921. +243633971570715955897501178 = 33528189219127257 - -243633971537187766678373921. +-8168605897906295864640451842147147529064697 = 33528189219127257 * -243633971537187766678373921. +-33528189219127257 = -(33528189219127257). +33528189219127257 = +(33528189219127257). +0 = 33528189219127257 div -243633971537187766678373921. +33528189219127257 = 33528189219127257 rem -243633971537187766678373921. +14378387645020633 = 33528189219127257 band -243633971537187766678373921. +-243633971518037965104267297 = 33528189219127257 bor -243633971537187766678373921. +-243633971532416352749287930 = 33528189219127257 bxor -243633971537187766678373921. +-33528189219127258 = bnot(33528189219127257). +65484744568607 = 33528189219127257 bsl -9. +17166432880193155584 = 33528189219127257 bsr -9. +-89954888350459534858325537 = -898356866157681 + -89954888349561177992167856. +89954888348662821126010175 = -898356866157681 - -89954888349561177992167856. +80811591593275869086159243769082315701936 = -898356866157681 * -89954888349561177992167856. +898356866157681 = -(-898356866157681). +-898356866157681 = +(-898356866157681). +0 = -898356866157681 div -89954888349561177992167856. +-898356866157681 = -898356866157681 rem -89954888349561177992167856. +-89954888349842704514911744 = -898356866157681 band -89954888349561177992167856. +-616830343413793 = -898356866157681 bor -89954888349561177992167856. +89954888349225874171497951 = -898356866157681 bxor -89954888349561177992167856. +898356866157680 = bnot(-898356866157681). +-56147304134856 = -898356866157681 bsl -4. +-14373709858522896 = -898356866157681 bsr -4. +64720118415810 = -75774795351 + 64795893211161. +-64871668006512 = -75774795351 - 64795893211161. +-4909895547660975004112511 = -75774795351 * 64795893211161. +75774795351 = -(-75774795351). +-75774795351 = +(-75774795351). +0 = -75774795351 div 64795893211161. +-75774795351 = -75774795351 rem 64795893211161. +64795356176393 = -75774795351 band 64795893211161. +-75237760583 = -75774795351 bor 64795893211161. +-64870593936976 = -75774795351 bxor 64795893211161. +75774795350 = bnot(-75774795351). +-18943698838 = -75774795351 bsl -2. +-303099181404 = -75774795351 bsr -2. +-31142252253840804847011712537 = -31142252253756192995144998645 + -84611851866713892. +-31142252253671581143278284753 = -31142252253756192995144998645 - -84611851866713892. +2635003634490655848531253998671200774942676340 = -31142252253756192995144998645 * -84611851866713892. +31142252253756192995144998645 = -(-31142252253756192995144998645). +-31142252253756192995144998645 = +(-31142252253756192995144998645). +368060166119 = -31142252253756192995144998645 div -84611851866713892. +-57257658979973497 = -31142252253756192995144998645 rem -84611851866713892. +-31142252253765340962695790584 = -31142252253756192995144998645 band -84611851866713892. +-75463884315921953 = -31142252253756192995144998645 bor -84611851866713892. +31142252253689877078379868631 = -31142252253756192995144998645 bxor -84611851866713892. +31142252253756192995144998644 = bnot(-31142252253756192995144998645). +-6441 = -31142252253756192995144998645 bsl -82. +-150594691322070952976781795744798420507787935172526080 = -31142252253756192995144998645 bsr -82. +-768279695054038550429476 = -57614822655244 + -768279694996423727774232. +768279694938808905118988 = -57614822655244 - -768279694996423727774232. +44264298376843904180525501948402872608 = -57614822655244 * -768279694996423727774232. +57614822655244 = -(-57614822655244). +-57614822655244 = +(-57614822655244). +0 = -57614822655244 div -768279694996423727774232. +-57614822655244 = -57614822655244 rem -768279694996423727774232. +-768279695049200370319136 = -57614822655244 band -768279694996423727774232. +-4838180110340 = -57614822655244 bor -768279694996423727774232. +768279695044362190208796 = -57614822655244 bxor -768279694996423727774232. +57614822655243 = bnot(-57614822655244). +-7201852831906 = -57614822655244 bsl -3. +-460918581241952 = -57614822655244 bsr -3. +66716996688288331280347926915 = 78862962169674868952653347 + 66638133726118656411395273568. +-66559270763948981542442620221 = 78862962169674868952653347 - 66638133726118656411395273568. +5255280619100630615291494137334154503933005328535832096 = 78862962169674868952653347 * 66638133726118656411395273568. +-78862962169674868952653347 = -(78862962169674868952653347). +78862962169674868952653347 = +(78862962169674868952653347). +0 = 78862962169674868952653347 div 66638133726118656411395273568. +78862962169674868952653347 = 78862962169674868952653347 rem 66638133726118656411395273568. +78587880854205447134089760 = 78862962169674868952653347 band 66638133726118656411395273568. +66638408807434125833213837155 = 78862962169674868952653347 bor 66638133726118656411395273568. +66559820926579920386079747395 = 78862962169674868952653347 bxor 66638133726118656411395273568. +-78862962169674868952653348 = bnot(78862962169674868952653347). +5047229578859191612969814208 = 78862962169674868952653347 bsl 6. +1232233783901169827385208 = 78862962169674868952653347 bsr 6. +363496995691681518346351 = 76 + 363496995691681518346275. +-363496995691681518346199 = 76 - 363496995691681518346275. +27625771672567795394316900 = 76 * 363496995691681518346275. +-76 = -(76). +76 = +(76). +0 = 76 div 363496995691681518346275. +76 = 76 rem 363496995691681518346275. +0 = 76 band 363496995691681518346275. +363496995691681518346351 = 76 bor 363496995691681518346275. +363496995691681518346351 = 76 bxor 363496995691681518346275. +-77 = bnot(76). +21392098230009856 = 76 bsl 48. +0 = 76 bsr 48. +45388257267872619604708117937 = 45388257267875444867293787589 + -2825262585669652. +45388257267878270129879457241 = 45388257267875444867293787589 - -2825262585669652. +-128233745087677154079742755684412077011549028 = 45388257267875444867293787589 * -2825262585669652. +-45388257267875444867293787589 = -(45388257267875444867293787589). +45388257267875444867293787589 = +(45388257267875444867293787589). +-16065146474559 = 45388257267875444867293787589 div -2825262585669652. +1190325297404121 = 45388257267875444867293787589 rem -2825262585669652. +45388257267875436034622232004 = 45388257267875444867293787589 band -2825262585669652. +-2816429914114067 = 45388257267875444867293787589 bor -2825262585669652. +-45388257267878252464536346071 = 45388257267875444867293787589 bxor -2825262585669652. +-45388257267875444867293787590 = bnot(45388257267875444867293787589). +181553029071501779469175150356 = 45388257267875444867293787589 bsl 2. +11347064316968861216823446897 = 45388257267875444867293787589 bsr 2. +534232775221076557060361434224 = 8142637292681815651 + 534232775212933919767679618573. +-534232775204791282474997802922 = 8142637292681815651 - 534232775212933919767679618573. +4350063718421737243249387242627227872212781686023 = 8142637292681815651 * 534232775212933919767679618573. +-8142637292681815651 = -(8142637292681815651). +8142637292681815651 = +(8142637292681815651). +0 = 8142637292681815651 div 534232775212933919767679618573. +8142637292681815651 = 8142637292681815651 rem 534232775212933919767679618573. +8070450807195059713 = 8142637292681815651 band 534232775212933919767679618573. +534232775213006106253166374511 = 8142637292681815651 bor 534232775212933919767679618573. +534232775204935655445971314798 = 8142637292681815651 bxor 534232775212933919767679618573. +-8142637292681815652 = bnot(8142637292681815651). +254457415396306739 = 8142637292681815651 bsl -5. +260564393365818100832 = 8142637292681815651 bsr -5. +-719 = 5 + -724. +729 = 5 - -724. +-3620 = 5 * -724. +-5 = -(5). +5 = +(5). +0 = 5 div -724. +5 = 5 rem -724. +4 = 5 band -724. +-723 = 5 bor -724. +-727 = 5 bxor -724. +-6 = bnot(5). +80 = 5 bsl 4. +0 = 5 bsr 4. +-33698381775178712848228269225 = 6383716279392 + -33698381775178719231944548617. +33698381775178725615660828009 = 6383716279392 - -33698381775178719231944548617. +-215120908327375073751204849770572099200864 = 6383716279392 * -33698381775178719231944548617. +-6383716279392 = -(6383716279392). +6383716279392 = +(6383716279392). +0 = 6383716279392 div -33698381775178719231944548617. +6383716279392 = 6383716279392 rem -33698381775178719231944548617. +5008250897504 = 6383716279392 band -33698381775178719231944548617. +-33698381775178717856479166729 = 6383716279392 bor -33698381775178719231944548617. +-33698381775178722864730064233 = 6383716279392 bxor -33698381775178719231944548617. +-6383716279393 = bnot(6383716279392). +24936391716 = 6383716279392 bsl -8. +1634231367524352 = 6383716279392 bsr -8. +473371560325055 = -59763632186814 + 533135192511869. +-592898824698683 = -59763632186814 - 533135192511869. +-31862095551125612402120295366 = -59763632186814 * 533135192511869. +59763632186814 = -(-59763632186814). +-59763632186814 = +(-59763632186814). +0 = -59763632186814 div 533135192511869. +-59763632186814 = -59763632186814 rem 533135192511869. +493269238960192 = -59763632186814 band 533135192511869. +-19897678635137 = -59763632186814 bor 533135192511869. +-513166917595329 = -59763632186814 bxor 533135192511869. +59763632186813 = bnot(-59763632186814). +-13915 = -59763632186814 bsl -32. +-256682845732539092434944 = -59763632186814 bsr -32. +9147059083566908696 = 8353389925127187513 + 793669158439721183. +7559720766687466330 = 8353389925127187513 - 793669158439721183. +6629827951994540456288032372679187879 = 8353389925127187513 * 793669158439721183. +-8353389925127187513 = -(8353389925127187513). +8353389925127187513 = +(8353389925127187513). +10 = 8353389925127187513 div 793669158439721183. +416698340729975683 = 8353389925127187513 rem 793669158439721183. +216491503072577561 = 8353389925127187513 band 793669158439721183. +8930567580494331135 = 8353389925127187513 bor 793669158439721183. +8714076077421753574 = 8353389925127187513 bxor 793669158439721183. +-8353389925127187514 = bnot(8353389925127187513). +2138467820832560003328 = 8353389925127187513 bsl 8. +32630429395028076 = 8353389925127187513 bsr 8. +72362913728339258532 = 72362913728339235883 + 22649. +72362913728339213234 = 72362913728339235883 - 22649. +1638947633033155353514067 = 72362913728339235883 * 22649. +-72362913728339235883 = -(72362913728339235883). +72362913728339235883 = +(72362913728339235883). +3194971686535354 = 72362913728339235883 div 22649. +3137 = 72362913728339235883 rem 22649. +20521 = 72362913728339235883 band 22649. +72362913728339238011 = 72362913728339235883 bor 22649. +72362913728339217490 = 72362913728339235883 bxor 22649. +-72362913728339235884 = bnot(72362913728339235883). +4016 = 72362913728339235883 bsl -54. +1303574365209567728547354356714831872 = 72362913728339235883 bsr -54. +17436186965801552151 = 7797441669221589463 + 9638745296579962688. +-1841303627358373225 = 7797441669221589463 - 9638745296579962688. +75157554214566208648139375940593956544 = 7797441669221589463 * 9638745296579962688. +-7797441669221589463 = -(7797441669221589463). +7797441669221589463 = +(7797441669221589463). +0 = 7797441669221589463 div 9638745296579962688. +7797441669221589463 = 7797441669221589463 rem 9638745296579962688. +288815050620674368 = 7797441669221589463 band 9638745296579962688. +17147371915180877783 = 7797441669221589463 bor 9638745296579962688. +16858556864560203415 = 7797441669221589463 bxor 9638745296579962688. +-7797441669221589464 = bnot(7797441669221589463). +15229378260198416 = 7797441669221589463 bsl -9. +3992290134641453805056 = 7797441669221589463 bsr -9. +-249371619938137286729145349434 = 55186244262 + -249371619938137286784331593696. +249371619938137286839517837958 = 55186244262 - -249371619938137286784331593696. +-13761883129916673637770067844111195372352 = 55186244262 * -249371619938137286784331593696. +-55186244262 = -(55186244262). +55186244262 = +(55186244262). +0 = 55186244262 div -249371619938137286784331593696. +55186244262 = 55186244262 rem -249371619938137286784331593696. +21184544 = 55186244262 band -249371619938137286784331593696. +-249371619938137286729166533978 = 55186244262 bor -249371619938137286784331593696. +-249371619938137286729187718522 = 55186244262 bxor -249371619938137286784331593696. +-55186244263 = bnot(55186244262). +428834400026232149395182982878267995633372152430042768694025038616215998110292595899915669864448 = 55186244262 bsl 282. +0 = 55186244262 bsr 282. +-31637674 = -31637667 + -7. +-31637660 = -31637667 - -7. +221463669 = -31637667 * -7. +31637667 = -(-31637667). +-31637667 = +(-31637667). +4519666 = -31637667 div -7. +-5 = -31637667 rem -7. +-31637671 = -31637667 band -7. +-3 = -31637667 bor -7. +31637668 = -31637667 bxor -7. +31637666 = bnot(-31637667). +-8696495685551259648 = -31637667 bsl 38. +-1 = -31637667 bsr 38. +34884055521500638 = 34883342235339514 + 713286161124. +34882628949178390 = 34883342235339514 - 713286161124. +24881805270220014909847853736 = 34883342235339514 * 713286161124. +-34883342235339514 = -(34883342235339514). +34883342235339514 = +(34883342235339514). +48905 = 34883342235339514 div 713286161124. +82525570294 = 34883342235339514 rem 713286161124. +163242312416 = 34883342235339514 band 713286161124. +34883892279188222 = 34883342235339514 bor 713286161124. +34883729036875806 = 34883342235339514 bxor 713286161124. +-34883342235339515 = bnot(34883342235339514). +558133475765432224 = 34883342235339514 bsl 4. +2180208889708719 = 34883342235339514 bsr 4. +-56817515656656 = 541178 + -56817516197834. +56817516739012 = 541178 - -56817516197834. +-30748389780911408452 = 541178 * -56817516197834. +-541178 = -(541178). +541178 = +(541178). +0 = 541178 div -56817516197834. +541178 = 541178 rem -56817516197834. +16434 = 541178 band -56817516197834. +-56817515673090 = 541178 bor -56817516197834. +-56817515689524 = 541178 bxor -56817516197834. +-541179 = bnot(541178). +4874498078282220568576 = 541178 bsl 53. +0 = 541178 bsr 53. +5517514786496594214410504 = 618239 + 5517514786496594213792265. +-5517514786496594213174026 = 618239 - 5517514786496594213792265. +3411142824088867910140716121335 = 618239 * 5517514786496594213792265. +-618239 = -(618239). +618239 = +(618239). +0 = 618239 div 5517514786496594213792265. +618239 = 618239 rem 5517514786496594213792265. +27145 = 618239 band 5517514786496594213792265. +5517514786496594214383359 = 618239 bor 5517514786496594213792265. +5517514786496594214356214 = 618239 bxor 5517514786496594213792265. +-618240 = bnot(618239). +9891824 = 618239 bsl 4. +38639 = 618239 bsr 4. +528252633090290629 = 5869819193392718 + 522382813896897911. +-516512994703505193 = 5869819193392718 - 522382813896897911. +3066292667310507615057367776812098 = 5869819193392718 * 522382813896897911. +-5869819193392718 = -(5869819193392718). +5869819193392718 = +(5869819193392718). +0 = 5869819193392718 div 522382813896897911. +5869819193392718 = 5869819193392718 rem 522382813896897911. +5840609038496838 = 5869819193392718 band 522382813896897911. +522412024051793791 = 5869819193392718 bor 522382813896897911. +516571415013296953 = 5869819193392718 bxor 522382813896897911. +-5869819193392719 = bnot(5869819193392718). +93917107094283488 = 5869819193392718 bsl 4. +366863699587044 = 5869819193392718 bsr 4. +93451451842942818555 = -855656892 + 93451451843798475447. +-93451451844654132339 = -855656892 - 93451451843798475447. +-79962378837552272975318330724 = -855656892 * 93451451843798475447. +855656892 = -(-855656892). +-855656892 = +(-855656892). +0 = -855656892 div 93451451843798475447. +-855656892 = -855656892 rem 93451451843798475447. +93451451843228049924 = -855656892 band 93451451843798475447. +-285231369 = -855656892 bor 93451451843798475447. +-93451451843513281293 = -855656892 bxor 93451451843798475447. +855656891 = bnot(-855656892). +-1 = -855656892 bsl -986. +-559596999863434058181088787703630780480556894737428043058390821616679397799374967206458383762742284413287718056878721836706115755314903261006719275360075705173593849705167073442107788566149655603624348072477881781982878106212705711322388638085309768430813689625159547205033343575193347563752997552796991488 = -855656892 bsr -986. +447649719154665546776115 = 447649719154622935599339 + 42611176776. +447649719154580324422563 = 447649719154622935599339 - 42611176776. +19074881316624391186447497637751064 = 447649719154622935599339 * 42611176776. +-447649719154622935599339 = -(447649719154622935599339). +447649719154622935599339 = +(447649719154622935599339). +10505453099965 = 447649719154622935599339 div 42611176776. +37121186499 = 447649719154622935599339 rem 42611176776. +3229614152 = 447649719154622935599339 band 42611176776. +447649719154662317161963 = 447649719154622935599339 bor 42611176776. +447649719154659087547811 = 447649719154622935599339 bxor 42611176776. +-447649719154622935599340 = bnot(447649719154622935599339). +3497263430895491684369 = 447649719154622935599339 bsl -7. +57299164051791735756715392 = 447649719154622935599339 bsr -7. +-526687489683481433080338 = -526687489683481428111489 + -4968849. +-526687489683481423142640 = -526687489683481428111489 - -4968849. +2617030606426277010590344006161 = -526687489683481428111489 * -4968849. +526687489683481428111489 = -(-526687489683481428111489). +-526687489683481428111489 = +(-526687489683481428111489). +105997885965840666 = -526687489683481428111489 div -4968849. +-698055 = -526687489683481428111489 rem -4968849. +-526687489683481432945041 = -526687489683481428111489 band -4968849. +-135297 = -526687489683481428111489 bor -4968849. +526687489683481432809744 = -526687489683481428111489 bxor -4968849. +526687489683481428111488 = bnot(-526687489683481428111489). +-1962063795639133 = -526687489683481428111489 bsl -28. +-141381596462680632822638768553984 = -526687489683481428111489 bsr -28. +-768406856353371 = -36812223784429 + -731594632568942. +694782408784513 = -36812223784429 - -731594632568942. +26931625333615001809488604118 = -36812223784429 * -731594632568942. +36812223784429 = -(-36812223784429). +-36812223784429 = +(-36812223784429). +0 = -36812223784429 div -731594632568942. +-36812223784429 = -36812223784429 rem -731594632568942. +-766890699236846 = -36812223784429 band -731594632568942. +-1516157116525 = -36812223784429 bor -731594632568942. +765374542120321 = -36812223784429 bxor -731594632568942. +36812223784428 = bnot(-36812223784429). +-5696415719734780799497428387179383488512 = -36812223784429 bsl 87. +-1 = -36812223784429 bsr 87. +-6156884284911674685174760725 = 7738353147 + -6156884284911674692913113872. +6156884284911674700651467019 = 7738353147 - -6156884284911674692913113872. +-47644144881861102476944453328960555184 = 7738353147 * -6156884284911674692913113872. +-7738353147 = -(7738353147). +7738353147 = +(7738353147). +0 = 7738353147 div -6156884284911674692913113872. +7738353147 = 7738353147 rem -6156884284911674692913113872. +1073825008 = 7738353147 band -6156884284911674692913113872. +-6156884284911674686248585733 = 7738353147 bor -6156884284911674692913113872. +-6156884284911674687322410741 = 7738353147 bxor -6156884284911674692913113872. +-7738353148 = bnot(7738353147). +0 = 7738353147 bsl -49. +4356305543661313132068864 = 7738353147 bsr -49. +-9331217104250 = -6857773436789 + -2473443667461. +-4384329769328 = -6857773436789 - -2473443667461. +16962316280108010419622729 = -6857773436789 * -2473443667461. +6857773436789 = -(-6857773436789). +-6857773436789 = +(-6857773436789). +2 = -6857773436789 div -2473443667461. +-1910886101867 = -6857773436789 rem -2473443667461. +-6871809224565 = -6857773436789 band -2473443667461. +-2459407879685 = -6857773436789 bor -2473443667461. +4412401344880 = -6857773436789 bxor -2473443667461. +6857773436788 = bnot(-6857773436789). +-1 = -6857773436789 bsl -711. +-73877135891535041194567845409532392555449692441996201171567393259263971087275630149583954972045843046579819926045499081403789204710777913948952840714061305344623347040087488483321504037757473989273894688863749707071200136527872 = -6857773436789 bsr -711. +-8862 = -3163 + -5699. +2536 = -3163 - -5699. +18025937 = -3163 * -5699. +3163 = -(-3163). +-3163 = +(-3163). +0 = -3163 div -5699. +-3163 = -3163 rem -5699. +-7771 = -3163 band -5699. +-1091 = -3163 bor -5699. +6680 = -3163 bxor -5699. +3162 = bnot(-3163). +-7747583955804587064033025409816693034551909564216481017690646693299710659329624213439192275631247214614854720650283481286037929452644368456245063859770027514737272854791614349968839653855242186565464621056 = -3163 bsl 669. +-1 = -3163 bsr 669. +49938691529915359744835 = 673513368 + 49938691529914686231467. +-49938691529914012718099 = 673513368 - 49938691529914686231467. +33634376325825913076418566750856 = 673513368 * 49938691529914686231467. +-673513368 = -(673513368). +673513368 = +(673513368). +0 = 673513368 div 49938691529914686231467. +673513368 = 673513368 rem 49938691529914686231467. +2413448 = 673513368 band 49938691529914686231467. +49938691529915357331387 = 673513368 bor 49938691529914686231467. +49938691529915354917939 = 673513368 bxor 49938691529914686231467. +-673513369 = bnot(673513368). +40 = 673513368 bsl -24. +11299679253823488 = 673513368 bsr -24. +-3778957544766119360 = -3778956672496357543 + -872269761817. +-3778955800226595726 = -3778956672496357543 - -872269761817. +3296269636635160668832681335631 = -3778956672496357543 * -872269761817. +3778956672496357543 = -(-3778956672496357543). +-3778956672496357543 = +(-3778956672496357543). +4332325 = -3778956672496357543 div -872269761817. +-576632523018 = -3778956672496357543 rem -872269761817. +-3778957536090971583 = -3778956672496357543 band -872269761817. +-8675147777 = -3778956672496357543 bor -872269761817. +3778957527415823806 = -3778956672496357543 bxor -872269761817. +3778956672496357542 = bnot(-3778956672496357543). +-1 = -3778956672496357543 bsl -574. +-233662717739497829481445250147111709136982365013769391462699314908304472573989039157320248745318224210099370341970651220915547562381773285418885296295503586503787527171820935607181131447795712 = -3778956672496357543 bsr -574. +-649232869612948879619714134339 = -725 + -649232869612948879619714133614. +649232869612948879619714132889 = -725 - -649232869612948879619714133614. +470693830469387937724292746870150 = -725 * -649232869612948879619714133614. +725 = -(-725). +-725 = +(-725). +0 = -725 div -649232869612948879619714133614. +-725 = -725 rem -649232869612948879619714133614. +-649232869612948879619714133758 = -725 band -649232869612948879619714133614. +-581 = -725 bor -649232869612948879619714133614. +649232869612948879619714133177 = -725 bxor -649232869612948879619714133614. +724 = bnot(-725). +-182 = -725 bsl -2. +-2900 = -725 bsr -2. +336153821221413443388253589123 = 336153821221413443388254443641 + -854518. +336153821221413443388255298159 = 336153821221413443388254443641 - -854518. +-287249491002479772817244410671220038 = 336153821221413443388254443641 * -854518. +-336153821221413443388254443641 = -(336153821221413443388254443641). +336153821221413443388254443641 = +(336153821221413443388254443641). +-393384131430131891181056 = 336153821221413443388254443641 div -854518. +832633 = 336153821221413443388254443641 rem -854518. +336153821221413443388254113800 = 336153821221413443388254443641 band -854518. +-524677 = 336153821221413443388254443641 bor -854518. +-336153821221413443388254638477 = 336153821221413443388254443641 bxor -854518. +-336153821221413443388254443642 = bnot(336153821221413443388254443641). +0 = 336153821221413443388254443641 bsl -859. +1292124400582025214681753805379999017826458544223285740214950304716425204700493732921339170721971191611095287667243285143016059894708138089168312449178554746377958816494701003039401515512800135243884361346414364814334839205381088559598646160649881162109023652744982065088981627652232183808 = 336153821221413443388254443641 bsr -859. +-48828401135 = -2461564478 + -46366836657. +43905272179 = -2461564478 - -46366836657. +114134958072099470046 = -2461564478 * -46366836657. +2461564478 = -(-2461564478). +-2461564478 = +(-2461564478). +0 = -2461564478 div -46366836657. +-2461564478 = -2461564478 rem -46366836657. +-46636335038 = -2461564478 band -46366836657. +-2192066097 = -2461564478 bor -46366836657. +44444268941 = -2461564478 bxor -46366836657. +2461564477 = bnot(-2461564478). +-1 = -2461564478 bsl -78. +-743962213525101706399794732204032 = -2461564478 bsr -78. +-556775059482823128027518 = -556778541154981477947271 + 3481672158349919753. +-556782022827139827867024 = -556778541154981477947271 - 3481672158349919753. +-1938520345105983984371355886263702015344063 = -556778541154981477947271 * 3481672158349919753. +556778541154981477947271 = -(-556778541154981477947271). +-556778541154981477947271 = +(-556778541154981477947271). +-159916 = -556778541154981477947271 div 3481672158349919753. +-3456280295710726523 = -556778541154981477947271 rem 3481672158349919753. +3458837223825244169 = -556778541154981477947271 band 3481672158349919753. +-556778518320046953271687 = -556778541154981477947271 bor 3481672158349919753. +-556781977157270778515856 = -556778541154981477947271 bxor 3481672158349919753. +556778541154981477947270 = bnot(-556778541154981477947271). +-4349832352773292796464 = -556778541154981477947271 bsl -7. +-71267653267837629177250688 = -556778541154981477947271 bsr -7. +-97754190262650772370872987 = -98197617887185616669216942 + 443427624534844298343955. +-98641045511720460967560897 = -98197617887185616669216942 - 443427624534844298343955. +-43543536434695054084525258535137170335157229285610 = -98197617887185616669216942 * 443427624534844298343955. +98197617887185616669216942 = -(-98197617887185616669216942). +-98197617887185616669216942 = +(-98197617887185616669216942). +-221 = -98197617887185616669216942 div 443427624534844298343955. +-200112864985026735202887 = -98197617887185616669216942 rem 443427624534844298343955. +329389834326850956174866 = -98197617887185616669216942 band 443427624534844298343955. +-98083580096977623327047853 = -98197617887185616669216942 bor 443427624534844298343955. +-98412969931304474283222719 = -98197617887185616669216942 bxor 443427624534844298343955. +98197617887185616669216941 = bnot(-98197617887185616669216942). +-383584444871818815114129 = -98197617887185616669216942 bsl -8. +-25138590179119517867319537152 = -98197617887185616669216942 bsr -8. +65325146671884263620246 = -2375599319477 + 65325146674259862939723. +-65325146676635462259200 = -2375599319477 - 65325146674259862939723. +-155186373984106940192261251470884871 = -2375599319477 * 65325146674259862939723. +2375599319477 = -(-2375599319477). +-2375599319477 = +(-2375599319477). +0 = -2375599319477 div 65325146674259862939723. +-2375599319477 = -2375599319477 rem 65325146674259862939723. +65325146674255093956683 = -2375599319477 band 65325146674259862939723. +-2370830336437 = -2375599319477 bor 65325146674259862939723. +-65325146676625924293120 = -2375599319477 bxor 65325146674259862939723. +2375599319476 = bnot(-2375599319477). +-38009589111632 = -2375599319477 bsl 4. +-148474957468 = -2375599319477 bsr 4. +524147523146881815581505024662 = 524147523146881815517932188839 + 63572835823. +524147523146881815454359353016 = 524147523146881815517932188839 - 63572835823. +33321544436048809972305676753508779979497 = 524147523146881815517932188839 * 63572835823. +-524147523146881815517932188839 = -(524147523146881815517932188839). +524147523146881815517932188839 = +(524147523146881815517932188839). +8244834705914607277 = 524147523146881815517932188839 div 63572835823. +39690104868 = 524147523146881815517932188839 rem 63572835823. +51676738727 = 524147523146881815517932188839 band 63572835823. +524147523146881815529828285935 = 524147523146881815517932188839 bor 63572835823. +524147523146881815478151547208 = 524147523146881815517932188839 bxor 63572835823. +-524147523146881815517932188840 = bnot(524147523146881815517932188839). +110992555 = 524147523146881815517932188839 bsl -72. +2475216695387976233192489581374336681680929181138944 = 524147523146881815517932188839 bsr -72. +788157169335553457993544312218 = 788157169335553457992572592346 + 971719872. +788157169335553457991600872474 = 788157169335553457992572592346 - 971719872. +765867983702626331249700016385163299712 = 788157169335553457992572592346 * 971719872. +-788157169335553457992572592346 = -(788157169335553457992572592346). +788157169335553457992572592346 = +(788157169335553457992572592346). +811095040912730719571 = 788157169335553457992572592346 div 971719872. +572577434 = 788157169335553457992572592346 rem 971719872. +30097600 = 788157169335553457992572592346 band 971719872. +788157169335553457993514214618 = 788157169335553457992572592346 bor 971719872. +788157169335553457993484117018 = 788157169335553457992572592346 bxor 971719872. +-788157169335553457992572592347 = bnot(788157169335553457992572592346). +0 = 788157169335553457992572592346 bsl -945. +234400607467991052780843019870991817329861630439057960281722580280810231453180252492156694352398844086727915063510342812594864041835995223590154472972256657500844954457923059382361422736857621154335734662262532892155554792243506175409804520676108851065559235441081280792496342485860126981192353512187823008484687872 = 788157169335553457992572592346 bsr -945. +456498221969429928 = 45395 + 456498221969384533. +-456498221969339138 = 45395 - 456498221969384533. +20722736786300210875535 = 45395 * 456498221969384533. +-45395 = -(45395). +45395 = +(45395). +0 = 45395 div 456498221969384533. +45395 = 45395 rem 456498221969384533. +8273 = 45395 band 456498221969384533. +456498221969421655 = 45395 bor 456498221969384533. +456498221969413382 = 45395 bxor 456498221969384533. +-45396 = bnot(45395). +0 = 45395 bsl -65. +1674779894452090191216640 = 45395 bsr -65. +58272100780201 = 5813589616752 + 52458511163449. +-46644921546697 = 5813589616752 - 52458511163449. +304972255810095985540497648 = 5813589616752 * 52458511163449. +-5813589616752 = -(5813589616752). +5813589616752 = +(5813589616752). +0 = 5813589616752 div 52458511163449. +5813589616752 = 5813589616752 rem 52458511163449. +5504283713584 = 5813589616752 band 52458511163449. +52767817066617 = 5813589616752 bor 52458511163449. +47263533353033 = 5813589616752 bxor 52458511163449. +-5813589616753 = bnot(5813589616752). +0 = 5813589616752 bsl -249. +5259122560094394097887193586280664621930222978143017527786994756394715120927690796826624 = 5813589616752 bsr -249. +-811217921544075522 = 22713615154896373 + -833931536698971895. +856645151853868268 = 22713615154896373 - -833931536698971895. +-18941599990111788883837564364436835 = 22713615154896373 * -833931536698971895. +-22713615154896373 = -(22713615154896373). +22713615154896373 = +(22713615154896373). +0 = 22713615154896373 div -833931536698971895. +22713615154896373 = 22713615154896373 rem -833931536698971895. +18016226019068161 = 22713615154896373 band -833931536698971895. +-829234147563143683 = 22713615154896373 bor -833931536698971895. +-847250373582211844 = 22713615154896373 bxor -833931536698971895. +-22713615154896374 = bnot(22713615154896373). +363417842478341968 = 22713615154896373 bsl 4. +1419600947181023 = 22713615154896373 bsr 4. +5456 = -66 + 5522. +-5588 = -66 - 5522. +-364452 = -66 * 5522. +66 = -(-66). +-66 = +(-66). +0 = -66 div 5522. +-66 = -66 rem 5522. +5522 = -66 band 5522. +-66 = -66 bor 5522. +-5588 = -66 bxor 5522. +65 = bnot(-66). +-1 = -66 bsl -861. +-1014776034715873720684741443386595231429787920740899294045678304850603383056116311499835541721706232086537349665158267971309685931982741617205773147828702700672249808672767119573437380797816007092467025269927062172028523267991930326776759329910401937327974776832 = -66 bsr -861. +5196785811345279665568573520 = 75194 + 5196785811345279665568498326. +-5196785811345279665568423132 = 75194 - 5196785811345279665568498326. +390767112298296959172757663125244 = 75194 * 5196785811345279665568498326. +-75194 = -(75194). +75194 = +(75194). +0 = 75194 div 5196785811345279665568498326. +75194 = 75194 rem 5196785811345279665568498326. +146 = 75194 band 5196785811345279665568498326. +5196785811345279665568573374 = 75194 bor 5196785811345279665568498326. +5196785811345279665568573228 = 75194 bxor 5196785811345279665568498326. +-75195 = bnot(75194). +0 = 75194 bsl -49. +42330458797562134528 = 75194 bsr -49. +-527576 = 3536 + -531112. +534648 = 3536 - -531112. +-1878012032 = 3536 * -531112. +-3536 = -(3536). +3536 = +(3536). +0 = 3536 div -531112. +3536 = 3536 rem -531112. +1360 = 3536 band -531112. +-528936 = 3536 bor -531112. +-530296 = 3536 bxor -531112. +-3537 = bnot(3536). +0 = 3536 bsl -523. +97095698104887343808704004902207225665058892885226911710475291166720322785976447201221483557515613225598879028321105256077053398267992210085047056149531368357888 = 3536 bsr -523. +194861382607051816055649501 = 8184173239335391298581224112 + -7989311856728339482525574611. +16173485096063730781106798723 = 8184173239335391298581224112 - -7989311856728339482525574611. +-65385912298541023764191404366290936156944601698568220432 = 8184173239335391298581224112 * -7989311856728339482525574611. +-8184173239335391298581224112 = -(8184173239335391298581224112). +8184173239335391298581224112 = +(8184173239335391298581224112). +-1 = 8184173239335391298581224112 div -7989311856728339482525574611. +194861382607051816055649501 = 8184173239335391298581224112 rem -7989311856728339482525574611. +659166956033658411882699296 = 8184173239335391298581224112 band -7989311856728339482525574611. +-464305573426606595827049795 = 8184173239335391298581224112 bor -7989311856728339482525574611. +-1123472529460265007709749091 = 8184173239335391298581224112 bxor -7989311856728339482525574611. +-8184173239335391298581224113 = bnot(8184173239335391298581224112). +0 = 8184173239335391298581224112 bsl -848. +15360704581040881949470074138553440868943889412111113776588868549988553860433207151006860525408649511176731212529971171670484927035841364300665867032458282255893662134560851235709044534840334938773177773825554117097592516116215828036110551084445750840532370878910844498230861965033472 = 8184173239335391298581224112 bsr -848. +-24469893012618 = -24469883178955 + -9833663. +-24469873345292 = -24469883178955 - -9833663. +240628584831212162165 = -24469883178955 * -9833663. +24469883178955 = -(-24469883178955). +-24469883178955 = +(-24469883178955). +2488379 = -24469883178955 div -9833663. +-2676678 = -24469883178955 rem -9833663. +-24469883572223 = -24469883178955 band -9833663. +-9440395 = -24469883178955 bor -9833663. +24469874131828 = -24469883178955 bxor -9833663. +24469883178954 = bnot(-24469883178955). +-3388815562760659540322787124611722074864605117165619288748126783639116305815276462163657745235017088176590901286599153079163310119519980301350579944449075884550540718729845948037455500638928402240973972195935287936127385696634369984694284188180163816400164604802252283180697041035298078720 = -24469883178955 bsl 914. +-1 = -24469883178955 bsr 914. +2929337694275698696311920100 = 2929337694275698696311924425 + -4325. +2929337694275698696311928750 = 2929337694275698696311924425 - -4325. +-12669385527742396861549073138125 = 2929337694275698696311924425 * -4325. +-2929337694275698696311924425 = -(2929337694275698696311924425). +2929337694275698696311924425 = +(2929337694275698696311924425). +-677303513127329178338017 = 2929337694275698696311924425 div -4325. +900 = 2929337694275698696311924425 rem -4325. +2929337694275698696311924233 = 2929337694275698696311924425 band -4325. +-4133 = 2929337694275698696311924425 bor -4325. +-2929337694275698696311928366 = 2929337694275698696311924425 bxor -4325. +-2929337694275698696311924426 = bnot(2929337694275698696311924425). +0 = 2929337694275698696311924425 bsl -281. +11381466426987286010056685843059868836669048747613621092418532667143480310195248513703294481583824492589324697600 = 2929337694275698696311924425 bsr -281. +-51912714165724719765 = -51912714165724719694 + -71. +-51912714165724719623 = -51912714165724719694 - -71. +3685802705766455098274 = -51912714165724719694 * -71. +51912714165724719694 = -(-51912714165724719694). +-51912714165724719694 = +(-51912714165724719694). +731164988249643939 = -51912714165724719694 div -71. +-25 = -51912714165724719694 rem -71. +-51912714165724719696 = -51912714165724719694 band -71. +-69 = -51912714165724719694 bor -71. +51912714165724719627 = -51912714165724719694 bxor -71. +51912714165724719693 = bnot(-51912714165724719694). +-1 = -51912714165724719694 bsl -426. +-8996050581678828194654071155591618815918926338360260452875684958610849308208012689624562657875494921399574264624661808260863722667206971809507311616 = -51912714165724719694 bsr -426. +-914986716689646585310455939687 = 77389166885648 + -914986716689646662699622825335. +914986716689646740088789710983 = 77389166885648 - -914986716689646662699622825335. +-70810059716046191723759306493834876622292080 = 77389166885648 * -914986716689646662699622825335. +-77389166885648 = -(77389166885648). +77389166885648 = +(77389166885648). +0 = 77389166885648 div -914986716689646662699622825335. +77389166885648 = 77389166885648 rem -914986716689646662699622825335. +4400492315136 = 77389166885648 band -914986716689646662699622825335. +-914986716689646589710948254823 = 77389166885648 bor -914986716689646662699622825335. +-914986716689646594111440569959 = 77389166885648 bxor -914986716689646662699622825335. +-77389166885649 = bnot(77389166885648). +1 = 77389166885648 bsl -46. +5445778486698710331683766272 = 77389166885648 bsr -46. +-975537694281819 = -9957624 + -975537684324195. +975537674366571 = -9957624 - -975537684324195. +9714037458331027912680 = -9957624 * -975537684324195. +9957624 = -(-9957624). +-9957624 = +(-9957624). +0 = -9957624 div -975537684324195. +-9957624 = -9957624 rem -975537684324195. +-975537694048248 = -9957624 band -975537684324195. +-233571 = -9957624 bor -975537684324195. +975537693814677 = -9957624 bxor -975537684324195. +9957623 = bnot(-9957624). +-1368565421627670528 = -9957624 bsl 37. +-1 = -9957624 bsr 37. +94302615120 = 437658273 + 93864956847. +-93427298574 = 437658273 - 93864956847. +41080774908877545231 = 437658273 * 93864956847. +-437658273 = -(437658273). +437658273 = +(437658273). +0 = 437658273 div 93864956847. +437658273 = 437658273 rem 93864956847. +436208289 = 437658273 band 93864956847. +93866406831 = 437658273 bor 93864956847. +93430198542 = 437658273 bxor 93864956847. +-437658274 = bnot(437658273). +32293480615090828255451676672 = 437658273 bsl 66. +0 = 437658273 bsr 66. +-943791 = -944115 + 324. +-944439 = -944115 - 324. +-305893260 = -944115 * 324. +944115 = -(-944115). +-944115 = +(-944115). +-2913 = -944115 div 324. +-303 = -944115 rem 324. +4 = -944115 band 324. +-943795 = -944115 bor 324. +-943799 = -944115 bxor 324. +944114 = bnot(-944115). +-1 = -944115 bsl -76. +-71335312511591601454857584640 = -944115 bsr -76. +804168 = 47752 + 756416. +-708664 = 47752 - 756416. +36120376832 = 47752 * 756416. +-47752 = -(47752). +47752 = +(47752). +0 = 47752 div 756416. +47752 = 47752 rem 756416. +35456 = 47752 band 756416. +768712 = 47752 bor 756416. +733256 = 47752 bxor 756416. +-47753 = bnot(47752). +12613560225395143421908464704666750497243998756438437462327189888720866097444362744811186401573703018173245854859007204336994930330686119887393868649781145338264640467160245389612633716042357706582006584916450334337438323517736288076505564354961762912664223157514392448270336 = 47752 bsl 895. +0 = 47752 bsr 895. +-1884722603876 = -898353346699 + -986369257177. +88015910478 = -898353346699 - -986369257177. +886108123265964575008723 = -898353346699 * -986369257177. +898353346699 = -(-898353346699). +-898353346699 = +(-898353346699). +0 = -898353346699 div -986369257177. +-898353346699 = -898353346699 rem -986369257177. +-1055122816731 = -898353346699 band -986369257177. +-829599787145 = -898353346699 bor -986369257177. +225523029586 = -898353346699 bxor -986369257177. +898353346698 = bnot(-898353346699). +-28747307094368 = -898353346699 bsl 5. +-28073542085 = -898353346699 bsr 5. +423856867381559151547629330 = -73393635644 + 423856867381559224941264974. +-423856867381559298334900618 = -73393635644 - 423856867381559224941264974. +-31108396489809386079946238802215133256 = -73393635644 * 423856867381559224941264974. +73393635644 = -(-73393635644). +-73393635644 = +(-73393635644). +0 = -73393635644 div 423856867381559224941264974. +-73393635644 = -73393635644 rem 423856867381559224941264974. +423856867381559220578140228 = -73393635644 band 423856867381559224941264974. +-69030510898 = -73393635644 bor 423856867381559224941264974. +-423856867381559289608651126 = -73393635644 bxor 423856867381559224941264974. +73393635643 = bnot(-73393635644). +-1 = -73393635644 bsl -951. +-1396960987869257021182404737770934090305346867905888782305430990308128968611284969672680394890041633710648474075566307385781440743432461872101582743469592870663924353071069797292284110104690003385191941662431781220632085690520925286314556403968101141362195770022335942242917544896735955404520947712 = -73393635644 bsr -951. +83129814239514894144774200099 = 846361 + 83129814239514894144773353738. +-83129814239514894144772507377 = 846361 - 83129814239514894144773353738. +70357832709570065323264520443047418 = 846361 * 83129814239514894144773353738. +-846361 = -(846361). +846361 = +(846361). +0 = 846361 div 83129814239514894144773353738. +846361 = 846361 rem 83129814239514894144773353738. +57352 = 846361 band 83129814239514894144773353738. +83129814239514894144774142747 = 846361 bor 83129814239514894144773353738. +83129814239514894144774085395 = 846361 bxor 83129814239514894144773353738. +-846362 = bnot(846361). +99816706619824517513266074272494132712041761282277466793778573140068334740824421706264571914002764129848897354981634954162960368061493044290229001702400876756223308697960448 = 846361 bsl 555. +0 = 846361 bsr 555. +-6149219841637342341767709375 = 7936914143828558 + -6149219841645279255911537933. +6149219841653216170055366491 = 7936914143828558 - -6149219841645279255911537933. +-48805829934665622608982731067028238465690614 = 7936914143828558 * -6149219841645279255911537933. +-7936914143828558 = -(7936914143828558). +7936914143828558 = +(7936914143828558). +0 = 7936914143828558 div -6149219841645279255911537933. +7936914143828558 = 7936914143828558 rem -6149219841645279255911537933. +2270027655070274 = 7936914143828558 band -6149219841645279255911537933. +-6149219841639612369422779649 = 7936914143828558 bor -6149219841645279255911537933. +-6149219841641882397077849923 = 7936914143828558 bxor -6149219841645279255911537933. +-7936914143828559 = bnot(7936914143828558). +1015925010410055424 = 7936914143828558 bsl 7. +62007141748660 = 7936914143828558 bsr 7. +-9623489537571151649536261155 = -9623489537571151649536252669 + -8486. +-9623489537571151649536244183 = -9623489537571151649536252669 - -8486. +81664932215828792897964640149134 = -9623489537571151649536252669 * -8486. +9623489537571151649536252669 = -(-9623489537571151649536252669). +-9623489537571151649536252669 = +(-9623489537571151649536252669). +1134043075367800100110329 = -9623489537571151649536252669 div -8486. +-775 = -9623489537571151649536252669 rem -8486. +-9623489537571151649536261118 = -9623489537571151649536252669 band -8486. +-37 = -9623489537571151649536252669 bor -8486. +9623489537571151649536261081 = -9623489537571151649536252669 bxor -8486. +9623489537571151649536252668 = bnot(-9623489537571151649536252669). +-44142919870828739211200701535155062110435384245131017753869244786479539088619838914209774386582838431752616390853683553030701068582912 = -9623489537571151649536252669 bsl 351. +-1 = -9623489537571151649536252669 bsr 351. +2217835715205243105330672 = 2217834943852943918978847 + 771352299186351825. +2217834172500644732627022 = 2217834943852943918978847 - 771352299186351825. +1710732083156801799158171996743613274845775 = 2217834943852943918978847 * 771352299186351825. +-2217834943852943918978847 = -(2217834943852943918978847). +2217834943852943918978847 = +(2217834943852943918978847). +2875255 = 2217834943852943918978847 div 771352299186351825. +388855889902388472 = 2217834943852943918978847 rem 771352299186351825. +194851138756298257 = 2217834943852943918978847 band 771352299186351825. +2217835520354104349032415 = 2217834943852943918978847 bor 771352299186351825. +2217835325502965592734158 = 2217834943852943918978847 bxor 771352299186351825. +-2217834943852943918978848 = bnot(2217834943852943918978847). +0 = 2217834943852943918978847 bsl -777. +1762933184547032271860867896688770063313984512531651045139630090111197779460986334458776585482400710991208227030812046357442194506276242298380162967879430699127512261438594192361631181535584738325550599656143411847624343045336965677373191327400246575192080384 = 2217834943852943918978847 bsr -777. +92438122089066 = 4912779 + 92438117176287. +-92438112263508 = 4912779 - 92438117176287. +454128040863202071573 = 4912779 * 92438117176287. +-4912779 = -(4912779). +4912779 = +(4912779). +0 = 4912779 div 92438117176287. +4912779 = 4912779 rem 92438117176287. +152203 = 4912779 band 92438117176287. +92438121936863 = 4912779 bor 92438117176287. +92438121784660 = 4912779 bxor 92438117176287. +-4912780 = bnot(4912779). +314417856 = 4912779 bsl 6. +76762 = 4912779 bsr 6. +39620715882967338 = 39587992666517787 + 32723216449551. +39555269450068236 = 39587992666517787 - 32723216449551. +1295446452829699203068729663637 = 39587992666517787 * 32723216449551. +-39587992666517787 = -(39587992666517787). +39587992666517787 = +(39587992666517787). +1209 = 39587992666517787 div 32723216449551. +25623979010628 = 39587992666517787 rem 32723216449551. +5501047799819 = 39587992666517787 band 32723216449551. +39615214835167519 = 39587992666517787 bor 32723216449551. +39609713787367700 = 39587992666517787 bxor 32723216449551. +-39587992666517788 = bnot(39587992666517787). +633407882664284592 = 39587992666517787 bsl 4. +2474249541657361 = 39587992666517787 bsr 4. +768874092916150731214 = 768881411673972895468 + -7318757822164254. +768888730431795059722 = 768881411673972895468 - -7318757822164254. +-5627256846005583089915510094668200872 = 768881411673972895468 * -7318757822164254. +-768881411673972895468 = -(768881411673972895468). +768881411673972895468 = +(768881411673972895468). +-105056 = 768881411673972895468 div -7318757822164254. +1989908685027244 = 768881411673972895468 rem -7318757822164254. +768874093234249269984 = 768881411673972895468 band -7318757822164254. +-318098538770 = 768881411673972895468 bor -7318757822164254. +-768874093552347808754 = 768881411673972895468 bxor -7318757822164254. +-768881411673972895469 = bnot(768881411673972895468). +1744597869527381584003786176799407787844738102215515492761961756558697632737056644556336255557654110596433804500802027126351973090052059686348113033076149181819228376621109013589970153641994880427935169332083607354819336020908133882778522143888586620649102893574792953387671612174288395085127937425408 = 768881411673972895468 bsl 928. +0 = 768881411673972895468 bsr 928. +97523379246321139975 = 97523379246321146323 + -6348. +97523379246321152671 = 97523379246321146323 - -6348. +-619078411455646636858404 = 97523379246321146323 * -6348. +-97523379246321146323 = -(97523379246321146323). +97523379246321146323 = +(97523379246321146323). +-15362851173018454 = 97523379246321146323 div -6348. +331 = 97523379246321146323 rem -6348. +97523379246321139984 = 97523379246321146323 band -6348. +-9 = 97523379246321146323 bor -6348. +-97523379246321139993 = 97523379246321146323 bxor -6348. +-97523379246321146324 = bnot(97523379246321146323). +12190422405790143290 = 97523379246321146323 bsl -3. +780187033970569170584 = 97523379246321146323 bsr -3. +26473395236717784918939914261 = 26473395236717784918939914226 + 35. +26473395236717784918939914191 = 26473395236717784918939914226 - 35. +926568833285122472162896997910 = 26473395236717784918939914226 * 35. +-26473395236717784918939914226 = -(26473395236717784918939914226). +26473395236717784918939914226 = +(26473395236717784918939914226). +756382721049079569112568977 = 26473395236717784918939914226 div 35. +31 = 26473395236717784918939914226 rem 35. +34 = 26473395236717784918939914226 band 35. +26473395236717784918939914227 = 26473395236717784918939914226 bor 35. +26473395236717784918939914193 = 26473395236717784918939914226 bxor 35. +-26473395236717784918939914227 = bnot(26473395236717784918939914226). +27462941423975092133770269895553664313413731473513731049365080553912333227837462701951873909017702412472899040824845665565845174978755925962484247416291407045000410969434175858998730926298219165286384212639744 = 26473395236717784918939914226 bsl 598. +0 = 26473395236717784918939914226 bsr 598. +44253593145128125682376644835 = -5238646474973384 + 44253593145133364328851618219. +-44253593145138602975326591603 = -5238646474973384 - 44253593145133364328851618219. +-231828929734659208811078400956033413354483096 = -5238646474973384 * 44253593145133364328851618219. +5238646474973384 = -(-5238646474973384). +-5238646474973384 = +(-5238646474973384). +0 = -5238646474973384 div 44253593145133364328851618219. +-5238646474973384 = -5238646474973384 rem 44253593145133364328851618219. +44253593145132800824777382184 = -5238646474973384 band 44253593145133364328851618219. +-4675142400737349 = -5238646474973384 bor 44253593145133364328851618219. +-44253593145137475967178119533 = -5238646474973384 bxor 44253593145133364328851618219. +5238646474973383 = bnot(-5238646474973384). +-2879976356520494944057556992 = -5238646474973384 bsl 39. +-9530 = -5238646474973384 bsr 39. +-61074776157 = -61599175326 + 524399169. +-62123574495 = -61599175326 - 524399169. +-32302556352039704094 = -61599175326 * 524399169. +61599175326 = -(-61599175326). +-61599175326 = +(-61599175326). +-117 = -61599175326 div 524399169. +-244472553 = -61599175326 rem 524399169. +138485824 = -61599175326 band 524399169. +-61213261981 = -61599175326 bor 524399169. +-61351747805 = -61599175326 bxor 524399169. +61599175325 = bnot(-61599175326). +-230 = -61599175326 bsl -28. +-16535402717858758656 = -61599175326 bsr -28. +46569222308238723841 = 97243965961854867 + 46471978342276868974. +-46374734376315014107 = 97243965961854867 - 46471978342276868974. +4519119480096428414454840194163196458 = 97243965961854867 * 46471978342276868974. +-97243965961854867 = -(97243965961854867). +97243965961854867 = +(97243965961854867). +0 = 97243965961854867 div 46471978342276868974. +97243965961854867 = 97243965961854867 rem 46471978342276868974. +20585147107904258 = 97243965961854867 band 46471978342276868974. +46548637161130819583 = 97243965961854867 bor 46471978342276868974. +46528052014022915325 = 97243965961854867 bxor 46471978342276868974. +-97243965961854868 = bnot(97243965961854867). +6077747872615929 = 97243965961854867 bsl -4. +1555903455389677872 = 97243965961854867 bsr -4. +-9443337600386540895 = -62221842737 + -9443337538164698158. +9443337475942855421 = -62221842737 - -9443337538164698158. +587581863212092584392149578446 = -62221842737 * -9443337538164698158. +62221842737 = -(-62221842737). +-62221842737 = +(-62221842737). +0 = -62221842737 div -9443337538164698158. +-62221842737 = -62221842737 rem -9443337538164698158. +-9443337582130756926 = -62221842737 band -9443337538164698158. +-18255783969 = -62221842737 bor -9443337538164698158. +9443337563874972957 = -62221842737 bxor -9443337538164698158. +62221842736 = bnot(-62221842737). +-3982197935168 = -62221842737 bsl 6. +-972216293 = -62221842737 bsr 6. +-92946333875615637858065426480 = -41989427184345 + -92946333875615595868638242135. +92946333875615553879211057790 = -41989427184345 - -92946333875615595868638242135. +3902763318321980061088044077940023391376575 = -41989427184345 * -92946333875615595868638242135. +41989427184345 = -(-41989427184345). +-41989427184345 = +(-41989427184345). +0 = -41989427184345 div -92946333875615595868638242135. +-41989427184345 = -41989427184345 rem -92946333875615595868638242135. +-92946333875615596006624552927 = -41989427184345 band -92946333875615595868638242135. +-41851440873553 = -41989427184345 bor -92946333875615595868638242135. +92946333875615554155183679374 = -41989427184345 bxor -92946333875615595868638242135. +41989427184344 = bnot(-41989427184345). +-78212 = -41989427184345 bsl -29. +-22542902066816892272640 = -41989427184345 bsr -29. +73412760701 = 73412756377 + 4324. +73412752053 = 73412756377 - 4324. +317436758574148 = 73412756377 * 4324. +-73412756377 = -(73412756377). +73412756377 = +(73412756377). +16977973 = 73412756377 div 4324. +1125 = 73412756377 rem 4324. +128 = 73412756377 band 4324. +73412760573 = 73412756377 bor 4324. +73412760445 = 73412756377 bxor 4324. +-73412756378 = bnot(73412756377). +4588297273 = 73412756377 bsl -4. +1174604102032 = 73412756377 bsr -4. +8615882880057551270 = 4665767863572685 + 8611217112193978585. +-8606551344330405900 = 4665767863572685 - 8611217112193978585. +40177940068321845575900022480950725 = 4665767863572685 * 8611217112193978585. +-4665767863572685 = -(4665767863572685). +4665767863572685 = +(4665767863572685). +0 = 4665767863572685 div 8611217112193978585. +4665767863572685 = 4665767863572685 rem 8611217112193978585. +17955648983241 = 4665767863572685 band 8611217112193978585. +8615864924408568029 = 4665767863572685 bor 8611217112193978585. +8615846968759584788 = 4665767863572685 bxor 8611217112193978585. +-4665767863572686 = bnot(4665767863572685). +0 = 4665767863572685 bsl -93. +46207526818621075710052698991316946145771520 = 4665767863572685 bsr -93. +-39467433864158659742658 = -39467433864217874379444 + 59214636786. +-39467433864277089016230 = -39467433864217874379444 - 59214636786. +-2337049761145137873347751604626984 = -39467433864217874379444 * 59214636786. +39467433864217874379444 = -(-39467433864217874379444). +-39467433864217874379444 = +(-39467433864217874379444). +-666514834952 = -39467433864217874379444 div 59214636786. +-54456635172 = -39467433864217874379444 rem 59214636786. +40953447488 = -39467433864217874379444 band 59214636786. +-39467433864199613190146 = -39467433864217874379444 bor 59214636786. +-39467433864240566637634 = -39467433864217874379444 bxor 59214636786. +39467433864217874379443 = bnot(-39467433864217874379444). +-335402457668306942374505095499667157298433588811630592532361265952607363769192115735984351204439323261922619019955576664690066828623553597851655044917278817794907884804757365885534387240588638854958716813312 = -39467433864217874379444 bsl 611. +-1 = -39467433864217874379444 bsr 611. +6126905 = 6126912 + -7. +6126919 = 6126912 - -7. +-42888384 = 6126912 * -7. +-6126912 = -(6126912). +6126912 = +(6126912). +-875273 = 6126912 div -7. +1 = 6126912 rem -7. +6126912 = 6126912 band -7. +-7 = 6126912 bor -7. +-6126919 = 6126912 bxor -7. +-6126913 = bnot(6126912). +0 = 6126912 bsl -32. +26314886665469952 = 6126912 bsr -32. +-7154169647745 = -7154169647741 + -4. +-7154169647737 = -7154169647741 - -4. +28616678590964 = -7154169647741 * -4. +7154169647741 = -(-7154169647741). +-7154169647741 = +(-7154169647741). +1788542411935 = -7154169647741 div -4. +-1 = -7154169647741 rem -4. +-7154169647744 = -7154169647741 band -4. +-1 = -7154169647741 bor -4. +7154169647743 = -7154169647741 bxor -4. +7154169647740 = bnot(-7154169647741). +-1 = -7154169647741 bsl -244. +-202245178288604698038496862819314736706844432058191949633859085890283884187663525216256 = -7154169647741 bsr -244. +3690966049 = 4242728246 + -551762197. +4794490443 = 4242728246 - -551762197. +-2340977058286916462 = 4242728246 * -551762197. +-4242728246 = -(4242728246). +4242728246 = +(4242728246). +-7 = 4242728246 div -551762197. +380392867 = 4242728246 rem -551762197. +3691037730 = 4242728246 band -551762197. +-71681 = 4242728246 bor -551762197. +-3691109411 = 4242728246 bxor -551762197. +-4242728247 = bnot(4242728246). +1086138430976 = 4242728246 bsl 8. +16573157 = 4242728246 bsr 8. +-28899446413897218455215387171 = -328252375 + -28899446413897218454887134796. +28899446413897218454558882421 = -328252375 - -28899446413897218454887134796. +9486311921546994963710532353732140500 = -328252375 * -28899446413897218454887134796. +328252375 = -(-328252375). +-328252375 = +(-328252375). +0 = -328252375 div -28899446413897218454887134796. +-328252375 = -328252375 rem -28899446413897218454887134796. +-28899446413897218455156621280 = -328252375 band -28899446413897218454887134796. +-58765891 = -328252375 bor -28899446413897218454887134796. +28899446413897218455097855389 = -328252375 bxor -28899446413897218454887134796. +328252374 = bnot(-328252375). +-41031547 = -328252375 bsl -3. +-2626019000 = -328252375 bsr -3. +3625286175567416254712 = 85876386829 + 3625286175481539867883. +-3625286175395663481054 = 85876386829 - 3625286175481539867883. +311326477971478693042906061313007 = 85876386829 * 3625286175481539867883. +-85876386829 = -(85876386829). +85876386829 = +(85876386829). +0 = 85876386829 div 3625286175481539867883. +85876386829 = 85876386829 rem 3625286175481539867883. +12190753801 = 85876386829 band 3625286175481539867883. +3625286175555225500911 = 85876386829 bor 3625286175481539867883. +3625286175543034747110 = 85876386829 bxor 3625286175481539867883. +-85876386830 = bnot(85876386829). +0 = 85876386829 bsl -43. +755376686959001895698432 = 85876386829 bsr -43. +89427374879114797914 = 486913296 + 89427374878627884618. +-89427374878140971322 = 486913296 - 89427374878627884618. +43543377854780303256858080928 = 486913296 * 89427374878627884618. +-486913296 = -(486913296). +486913296 = +(486913296). +0 = 486913296 div 89427374878627884618. +486913296 = 486913296 rem 89427374878627884618. +67380224 = 486913296 band 89427374878627884618. +89427374879047417690 = 486913296 bor 89427374878627884618. +89427374878980037466 = 486913296 bxor 89427374878627884618. +-486913297 = bnot(486913296). +0 = 486913296 bsl -676. +152661210848739746084796801219929303017091608483351569718679717829647832381127607004270259131421098930744261831142132636907808415233236106921022961095308743313013280041597545067006268505764100610866637431694688256 = 486913296 bsr -676. +-6999135574145138500199069 = -6999135574144648672339887 + -489827859182. +-6999135574144158844480705 = -6999135574144648672339887 - -489827859182. +3428371594407851689973765427877792434 = -6999135574144648672339887 * -489827859182. +6999135574144648672339887 = -(-6999135574144648672339887). +-6999135574144648672339887 = +(-6999135574144648672339887). +14288969977806 = -6999135574144648672339887 div -489827859182. +-65639025195 = -6999135574144648672339887 rem -489827859182. +-6999135574144648806662128 = -6999135574144648672339887 band -489827859182. +-489693536941 = -6999135574144648672339887 bor -489827859182. +6999135574144159113125187 = -6999135574144648672339887 bxor -489827859182. +6999135574144648672339886 = bnot(-6999135574144648672339887). +-1970081522727088896154641004058086735872 = -6999135574144648672339887 bsl 48. +-24865924695 = -6999135574144648672339887 bsr 48. +28133112160341859011 = 8294987549896678 + 28124817172791962333. +-28116522185242065655 = 8294987549896678 - 28124817172791962333. +233295008291429613932376743017829774 = 8294987549896678 * 28124817172791962333. +-8294987549896678 = -(8294987549896678). +8294987549896678 = +(8294987549896678). +0 = 8294987549896678 div 28124817172791962333. +8294987549896678 = 8294987549896678 rem 28124817172791962333. +3773748453976772 = 8294987549896678 band 28124817172791962333. +28129338411887882239 = 8294987549896678 bor 28124817172791962333. +28125564663433905467 = 8294987549896678 bxor 28124817172791962333. +-8294987549896679 = bnot(8294987549896678). +1263082162412447579800888840669276340899121737001091513533517862335233925901939815520623946825386759209517435329525794796703333180486616796703609541310798284672613427814355760158969931165101163017718864257813588701421019625991708955623833787170994552942292643771145249627718231570271772775626465609777152 = 8294987549896678 bsl 954. +0 = 8294987549896678 bsr 954. +-779237291937111325192769 = -779237253649537953318198 + -38287573371874571. +-779237215361964581443627 = -779237253649537953318198 - -38287573371874571. +29835103523204720212081208891876907743058 = -779237253649537953318198 * -38287573371874571. +779237253649537953318198 = -(-779237253649537953318198). +-779237253649537953318198 = +(-779237253649537953318198). +20352223 = -779237253649537953318198 div -38287573371874571. +-22256284756296865 = -779237253649537953318198 rem -38287573371874571. +-779237291934568402545984 = -779237253649537953318198 band -38287573371874571. +-2542922646785 = -779237253649537953318198 bor -38287573371874571. +779237291932025479899199 = -779237253649537953318198 bxor -38287573371874571. +779237253649537953318197 = bnot(-779237253649537953318198). +-6087791044137015260299 = -779237253649537953318198 bsl -7. +-99742368467140858024729344 = -779237253649537953318198 bsr -7. +-298617752514520 = 3 + -298617752514523. +298617752514526 = 3 - -298617752514523. +-895853257543569 = 3 * -298617752514523. +-3 = -(3). +3 = +(3). +0 = 3 div -298617752514523. +3 = 3 rem -298617752514523. +1 = 3 band -298617752514523. +-298617752514521 = 3 bor -298617752514523. +-298617752514522 = 3 bxor -298617752514523. +-4 = bnot(3). +0 = 3 bsl -9. +1536 = 3 bsr -9. +-133 = -47 + -86. +39 = -47 - -86. +4042 = -47 * -86. +47 = -(-47). +-47 = +(-47). +0 = -47 div -86. +-47 = -47 rem -86. +-128 = -47 band -86. +-5 = -47 bor -86. +123 = -47 bxor -86. +46 = bnot(-47). +-1 = -47 bsl -74. +-887804898779493300174848 = -47 bsr -74. +-509981125680411160658784391928 = -826657747793126416252762779123 + 316676622112715255593978387195. +-1143334369905841671846741166318 = -826657747793126416252762779123 - 316676622112715255593978387195. +-261783183214432167649135582111582362841923892371405556529985 = -826657747793126416252762779123 * 316676622112715255593978387195. +826657747793126416252762779123 = -(-826657747793126416252762779123). +-826657747793126416252762779123 = +(-826657747793126416252762779123). +-2 = -826657747793126416252762779123 div 316676622112715255593978387195. +-193304503567695905064806004733 = -826657747793126416252762779123 rem 316676622112715255593978387195. +123847801736915507221384729097 = -826657747793126416252762779123 band 316676622112715255593978387195. +-633828927417326667880169121025 = -826657747793126416252762779123 bor 316676622112715255593978387195. +-757676729154242175101553850122 = -826657747793126416252762779123 bxor 316676622112715255593978387195. +826657747793126416252762779122 = bnot(-826657747793126416252762779123). +-1 = -826657747793126416252762779123 bsl -736. +-298815106411787030647290347359184362814657491801384110694109341430405716236858687575876812387232946571630146667000682675592981845434535225432344189083261459357626833404822948698396070901561854958883208841441498296598547928675344224375690492086507798528 = -826657747793126416252762779123 bsr -736. +-64584896933529 = -64584813557954 + -83375575. +-64584730182379 = -64584813557954 - -83375575. +5384795966662210573550 = -64584813557954 * -83375575. +64584813557954 = -(-64584813557954). +-64584813557954 = +(-64584813557954). +774625 = -64584813557954 div -83375575. +-8773579 = -64584813557954 rem -83375575. +-64584882765272 = -64584813557954 band -83375575. +-14168257 = -64584813557954 bor -83375575. +64584868597015 = -64584813557954 bxor -83375575. +64584813557953 = bnot(-64584813557954). +-4133428067709056 = -64584813557954 bsl 6. +-1009137711844 = -64584813557954 bsr 6. +5445452782307633783919491483 = 5445459651994218436231385824 + -6869686584652311894341. +5445466521680803088543280165 = 5445459651994218436231385824 - -6869686584652311894341. +-37408601118570129338094041961378427211853093221984 = 5445459651994218436231385824 * -6869686584652311894341. +-5445459651994218436231385824 = -(5445459651994218436231385824). +5445459651994218436231385824 = +(5445459651994218436231385824). +-792679 = 5445459651994218436231385824 div -6869686584652311894341. +3359758608496137056285 = 5445459651994218436231385824 rem -6869686584652311894341. +5445457804436360510423843488 = 5445459651994218436231385824 band -6869686584652311894341. +-5022128726726504352005 = 5445459651994218436231385824 bor -6869686584652311894341. +-5445462826565087236928195493 = 5445459651994218436231385824 bxor -6869686584652311894341. +-5445459651994218436231385825 = bnot(5445459651994218436231385824). +424541713960740958963994971066282255333546899910452547992056400302574875373415528379911049066750750745702499309271450700245418359668606110820892628974614398415116198945474660651745336645526790587577936231743543715623590567622817663647964067135091598708138221633309269545040067703054877683963344265271410827531273633792 = 5445459651994218436231385824 bsl 963. +0 = 5445459651994218436231385824 bsr 963. +-56292853672347789967622755530 = -2348 + -56292853672347789967622753182. +56292853672347789967622750834 = -2348 - -56292853672347789967622753182. +132175620422672610843978224471336 = -2348 * -56292853672347789967622753182. +2348 = -(-2348). +-2348 = +(-2348). +0 = -2348 div -56292853672347789967622753182. +-2348 = -2348 rem -56292853672347789967622753182. +-56292853672347789967622753216 = -2348 band -56292853672347789967622753182. +-2314 = -2348 bor -56292853672347789967622753182. +56292853672347789967622750902 = -2348 bxor -56292853672347789967622753182. +2347 = bnot(-2348). +-161353331376128 = -2348 bsl 36. +-1 = -2348 bsr 36. +81677755761110325989 = 81677755761141741122 + -31415133. +81677755761173156255 = 81677755761141741122 - -31415133. +-2565917560377784029199199226 = 81677755761141741122 * -31415133. +-81677755761141741122 = -(81677755761141741122). +81677755761141741122 = +(81677755761141741122). +-2599949386212 = 81677755761141741122 div -31415133. +23394926 = 81677755761141741122 rem -31415133. +81677755761110852610 = 81677755761141741122 band -31415133. +-526621 = 81677755761141741122 bor -31415133. +-81677755761111379231 = 81677755761141741122 bxor -31415133. +-81677755761141741123 = bnot(81677755761141741122). +0 = 81677755761141741122 bsl -441. +463801217193409525842586227224346187120848525564428471008166082428333282429928854270435247339902105628804687447690604120298658543401340136044500661305344 = 81677755761141741122 bsr -441. +3686559983349955873379 = 3686559983349881939528 + 73933851. +3686559983349808005677 = 3686559983349881939528 - 73933851. +272561576511552652184654162328 = 3686559983349881939528 * 73933851. +-3686559983349881939528 = -(3686559983349881939528). +3686559983349881939528 = +(3686559983349881939528). +49862950914728 = 3686559983349881939528 div 73933851. +68282000 = 3686559983349881939528 rem 73933851. +2106376 = 3686559983349881939528 band 73933851. +3686559983349953767003 = 3686559983349881939528 bor 73933851. +3686559983349951660627 = 3686559983349881939528 bxor 73933851. +-3686559983349881939529 = bnot(3686559983349881939528). +2423975815203786007743325477570123552079224796171620812901156999316537218240556378219798115949609720528071885440199041531037808941745592396171939222230680705206120186559996389841922298304117353704995561336328522084056218553932578816 = 3686559983349881939528 bsl 697. +0 = 3686559983349881939528 bsr 697. +57484957125928146 = -7693579689369341 + 65178536815297487. +-72872116504666828 = -7693579689369341 - 65178536815297487. +-501456267024984596441840332146067 = -7693579689369341 * 65178536815297487. +7693579689369341 = -(-7693579689369341). +-7693579689369341 = +(-7693579689369341). +0 = -7693579689369341 div 65178536815297487. +-7693579689369341 = -7693579689369341 rem 65178536815297487. +64328614120784131 = -7693579689369341 band 65178536815297487. +-6843656994855985 = -7693579689369341 bor 65178536815297487. +-71172271115640116 = -7693579689369341 bxor 65178536815297487. +7693579689369340 = bnot(-7693579689369341). +-1102825898098619242482183019680173987957272873402146047893375711191417365700739748008122193597413717796130157914356711424 = -7693579689369341 bsl 346. +-1 = -7693579689369341 bsr 346. +-519158957389930531939580311985 = -519158957389938888268468295316 + 8356328887983331. +-519158957389947244597356278647 = -519158957389938888268468295316 - 8356328887983331. +-4338262993092853551931673024332658790593377596 = -519158957389938888268468295316 * 8356328887983331. +519158957389938888268468295316 = -(-519158957389938888268468295316). +-519158957389938888268468295316 = +(-519158957389938888268468295316). +-62127635753603 = -519158957389938888268468295316 div 8356328887983331. +-94845381103723 = -519158957389938888268468295316 rem 8356328887983331. +8356293808359520 = -519158957389938888268468295316 band 8356328887983331. +-519158957389938888233388671505 = -519158957389938888268468295316 bor 8356328887983331. +-519158957389947244527197031025 = -519158957389938888268468295316 bxor 8356328887983331. +519158957389938888268468295315 = bnot(-519158957389938888268468295316). +-4055929354608897564597408558 = -519158957389938888268468295316 bsl -7. +-66452346545912177698363941800448 = -519158957389938888268468295316 bsr -7. +-28977693743494607236553 = 327952916 + -28977693743494935189469. +28977693743495263142385 = 327952916 - -28977693743494935189469. +-9503319162134120026617371041604 = 327952916 * -28977693743494935189469. +-327952916 = -(327952916). +327952916 = +(327952916). +0 = 327952916 div -28977693743494935189469. +327952916 = 327952916 rem -28977693743494935189469. +285222912 = 327952916 band -28977693743494935189469. +-28977693743494892459465 = 327952916 bor -28977693743494935189469. +-28977693743495177682377 = 327952916 bxor -28977693743494935189469. +-327952917 = bnot(327952916). +0 = 327952916 bsl -829. +1174026506388461224997001534527826734857654163263098943331637410142530672452265566015726828228263252542300150382587480100197773428316022689359675598503380136107671318105408084540110960461813695296459050154533107209859133108602988474181342077223930952671035392 = 327952916 bsr -829. +-2695050304640900494 = -3466487676266667 + -2691583816964633827. +2688117329288367160 = -3466487676266667 - -2691583816964633827. +9330342131146699470866724060744609 = -3466487676266667 * -2691583816964633827. +3466487676266667 = -(-3466487676266667). +-3466487676266667 = +(-3466487676266667). +0 = -3466487676266667 div -2691583816964633827. +-3466487676266667 = -3466487676266667 rem -2691583816964633827. +-2692728133733317867 = -3466487676266667 band -2691583816964633827. +-2322170907582627 = -3466487676266667 bor -2691583816964633827. +2690405962825735240 = -3466487676266667 bxor -2691583816964633827. +3466487676266666 = bnot(-3466487676266667). +-1 = -3466487676266667 bsl -996. +-2321482113640535431413620257407215827129049952400819330081663821876398892083620880412644946852926812279497835369537647617146819081816303894972183011212579895044715021815984947621783999582159904772883937113585197454877221630252530865836836630100784077944139096919685291647777681531880061996596278375284733806077018112 = -3466487676266667 bsr -996. +-22437719121122816933 = -23285647816458958477 + 847928695336141544. +-24133576511795100021 = -23285647816458958477 - 847928695336141544. +-19744568973066917792526540430090668488 = -23285647816458958477 * 847928695336141544. +23285647816458958477 = -(-23285647816458958477). +-23285647816458958477 = +(-23285647816458958477). +-27 = -23285647816458958477 div 847928695336141544. +-391573042383136789 = -23285647816458958477 rem 847928695336141544. +630577232458088544 = -23285647816458958477 band 847928695336141544. +-23068296353580905477 = -23285647816458958477 bor 847928695336141544. +-23698873586038994021 = -23285647816458958477 bxor 847928695336141544. +23285647816458958476 = bnot(-23285647816458958477). +-38817258929776399754088580725456443760777990968496296036332720682810882753979348016638665186177153265633575379988311077403580431663080426551349837729969580718177343869422008191109185431721874421090512735255464683562656344729123003655067404229022059383475929088 = -23285647816458958477 bsl 798. +-1 = -23285647816458958477 bsr 798. +-989442199970150700183057 = -989442199876381553248442 + -93769146934615. +-989442199782612406313827 = -989442199876381553248442 - -93769146934615. +92779151023517125455724277559824619830 = -989442199876381553248442 * -93769146934615. +989442199876381553248442 = -(-989442199876381553248442). +-989442199876381553248442 = +(-989442199876381553248442). +10551895076 = -989442199876381553248442 div -93769146934615. +-56297040792702 = -989442199876381553248442 rem -93769146934615. +-989442199899747529125376 = -989442199876381553248442 band -93769146934615. +-70403171057681 = -989442199876381553248442 bor -93769146934615. +989442199829344358067695 = -989442199876381553248442 bxor -93769146934615. +989442199876381553248441 = bnot(-989442199876381553248442). +-3957768799505526212993768 = -989442199876381553248442 bsl 2. +-247360549969095388312111 = -989442199876381553248442 bsr 2. +-454565619835185753747499735 = 23857 + -454565619835185753747523592. +454565619835185753747547449 = 23857 - -454565619835185753747523592. +-10844571992408026527154670334344 = 23857 * -454565619835185753747523592. +-23857 = -(23857). +23857 = +(23857). +0 = 23857 div -454565619835185753747523592. +23857 = 23857 rem -454565619835185753747523592. +21808 = 23857 band -454565619835185753747523592. +-454565619835185753747521543 = 23857 bor -454565619835185753747523592. +-454565619835185753747543351 = 23857 bxor -454565619835185753747523592. +-23858 = bnot(23857). +381712 = 23857 bsl 4. +1491 = 23857 bsr 4. +4424861271793435821209060 = -895284491 + 4424861271793436716493551. +-4424861271793437611778042 = -895284491 - 4424861271793436716493551. +-3961509671463199647866640111817541 = -895284491 * 4424861271793436716493551. +895284491 = -(-895284491). +-895284491 = +(-895284491). +0 = -895284491 div 4424861271793436716493551. +-895284491 = -895284491 rem 4424861271793436716493551. +4424861271793436714863333 = -895284491 band 4424861271793436716493551. +-893654273 = -895284491 bor 4424861271793436716493551. +-4424861271793437608517606 = -895284491 bxor 4424861271793436716493551. +895284490 = bnot(-895284491). +-20335232416252554641923252366849810142015369362484154992319414677966476941037681564548311931469593765231637616504453672554373676561313854128128 = -895284491 bsl 443. +-1 = -895284491 bsr 443. +-479897902363968905109082 = -479897986781358672282469 + 84417389767173387. +-479898071198748439455856 = -479897986781358672282469 - 84417389767173387. +-40511735398603776920128864530205763452503 = -479897986781358672282469 * 84417389767173387. +479897986781358672282469 = -(-479897986781358672282469). +-479897986781358672282469 = +(-479897986781358672282469). +-5684823 = -479897986781358672282469 div 84417389767173387. +-67832966756876968 = -479897986781358672282469 rem 84417389767173387. +72594190081467403 = -479897986781358672282469 band 84417389767173387. +-479897974958158986576485 = -479897986781358672282469 bor 84417389767173387. +-479898047552349068043888 = -479897986781358672282469 bxor 84417389767173387. +479897986781358672282468 = bnot(-479897986781358672282469). +-1 = -479897986781358672282469 bsl -554. +-28298702654068005841545709516918834456567407751897587427005307095333461302591905673285423371447222444481771769836293532214420357015734577061387734681527826892801158705423150865290221632618496 = -479897986781358672282469 bsr -554. +-63589298 = -63688694 + 99396. +-63788090 = -63688694 - 99396. +-6330401428824 = -63688694 * 99396. +63688694 = -(-63688694). +-63688694 = +(-63688694). +-640 = -63688694 div 99396. +-75254 = -63688694 rem 99396. +0 = -63688694 band 99396. +-63589298 = -63688694 bor 99396. +-63589298 = -63688694 bxor 99396. +63688693 = bnot(-63688694). +-1 = -63688694 bsl -366. +-9572839033616149482117465315062621977561566009507969171174157968312164591652007173476852839438977804043377850519126016 = -63688694 bsr -366. +38915975846452919995301805206 = 463577688 + 38915975846452919994838227518. +-38915975846452919994374649830 = 463577688 - 38915975846452919994838227518. +18040578109162487652056077446812418384 = 463577688 * 38915975846452919994838227518. +-463577688 = -(463577688). +463577688 = +(463577688). +0 = 463577688 div 38915975846452919994838227518. +463577688 = 463577688 rem 38915975846452919994838227518. +444662296 = 463577688 band 38915975846452919994838227518. +38915975846452919994857142910 = 463577688 bor 38915975846452919994838227518. +38915975846452919994412480614 = 463577688 bxor 38915975846452919994838227518. +-463577689 = bnot(463577688). +0 = 463577688 bsl -934. +67319126996976393712644982790218279208550252032390219414949744296596194471837978968081786211424320887982063355469556203181254294641466766425359065272182089051181133983012727913586133826172285933782992420679866256197858058290960678672764073003328205861839447865053537609972137876760236654592 = 463577688 bsr -934. +-138361293209433 = 674896677931891 + -813257971141324. +1488154649073215 = 674896677931891 - -813257971141324. +-548865103024909248965207563684 = 674896677931891 * -813257971141324. +-674896677931891 = -(674896677931891). +674896677931891 = +(674896677931891). +0 = 674896677931891 div -813257971141324. +674896677931891 = 674896677931891 rem -813257971141324. +4743800062256 = 674896677931891 band -813257971141324. +-143105093271689 = 674896677931891 bor -813257971141324. +-147848893333945 = 674896677931891 bxor -813257971141324. +-674896677931892 = bnot(674896677931891). +94983263351489061205990965248 = 674896677931891 bsl 47. +4 = 674896677931891 bsr 47. +627853533456289133315151352 = 627853534329433388814597617 + -873144255499446265. +627853535202577644314043882 = 627853534329433388814597617 - -873144255499446265. +-548206706794769143536531955029983892288550505 = 627853534329433388814597617 * -873144255499446265. +-627853534329433388814597617 = -(627853534329433388814597617). +627853534329433388814597617 = +(627853534329433388814597617). +-719071940 = 627853534329433388814597617 div -873144255499446265. +627590894115293517 = 627853534329433388814597617 rem -873144255499446265. +627853533749023109104031745 = 627853534329433388814597617 band -873144255499446265. +-292733975788880393 = 627853534329433388814597617 bor -873144255499446265. +-627853534041757084892912138 = 627853534329433388814597617 bxor -873144255499446265. +-627853534329433388814597618 = bnot(627853534329433388814597617). +80365252394167473768268494976 = 627853534329433388814597617 bsl 7. +4905105736948698350114043 = 627853534329433388814597617 bsr 7. +-21576635897 = 626 + -21576636523. +21576637149 = 626 - -21576636523. +-13506974463398 = 626 * -21576636523. +-626 = -(626). +626 = +(626). +0 = 626 div -21576636523. +626 = 626 rem -21576636523. +528 = 626 band -21576636523. +-21576636425 = 626 bor -21576636523. +-21576636953 = 626 bxor -21576636523. +-627 = bnot(626). +1126528014153616374255758842324569857460972158422799924928429195382004130200140562727887787800414270630340196022633632138851349820295772642127732201288637029325733888 = 626 bsl 539. +0 = 626 bsr 539. +-327875629828116419647977544 = -327875629828116419647977461 + -83. +-327875629828116419647977378 = -327875629828116419647977461 - -83. +27213677275733662830782129263 = -327875629828116419647977461 * -83. +327875629828116419647977461 = -(-327875629828116419647977461). +-327875629828116419647977461 = +(-327875629828116419647977461). +3950308793109836381300933 = -327875629828116419647977461 div -83. +-22 = -327875629828116419647977461 rem -83. +-327875629828116419647977463 = -327875629828116419647977461 band -83. +-81 = -327875629828116419647977461 bor -83. +327875629828116419647977382 = -327875629828116419647977461 bxor -83. +327875629828116419647977460 = bnot(-327875629828116419647977461). +-10246113432128638113999296 = -327875629828116419647977461 bsl -5. +-10492020154499725428735278752 = -327875629828116419647977461 bsr -5. +9315714251516243906868654 = 9315714251516325428488326 + -81521619672. +9315714251516406950107998 = 9315714251516325428488326 - -81521619672. +-759432114185144030880207746063949072 = 9315714251516325428488326 * -81521619672. +-9315714251516325428488326 = -(9315714251516325428488326). +9315714251516325428488326 = +(9315714251516325428488326). +-114272928935880 = 9315714251516325428488326 div -81521619672. +32393856966 = 9315714251516325428488326 rem -81521619672. +9315714251516323801090048 = 9315714251516325428488326 band -81521619672. +-79894221394 = 9315714251516325428488326 bor -81521619672. +-9315714251516403695311442 = 9315714251516325428488326 bxor -81521619672. +-9315714251516325428488327 = bnot(9315714251516325428488326). +1273487671781282264641552716631249308204448980984801118850118055677058047356019203824800731291141143228184946951674778353664 = 9315714251516325428488326 bsl 326. +0 = 9315714251516325428488326 bsr 326. +59719273612193636529940 = -46 + 59719273612193636529986. +-59719273612193636530032 = -46 - 59719273612193636529986. +-2747086586160907280379356 = -46 * 59719273612193636529986. +46 = -(-46). +-46 = +(-46). +0 = -46 div 59719273612193636529986. +-46 = -46 rem 59719273612193636529986. +59719273612193636529986 = -46 band 59719273612193636529986. +-46 = -46 bor 59719273612193636529986. +-59719273612193636530032 = -46 bxor 59719273612193636529986. +45 = bnot(-46). +-1 = -46 bsl -682. +-923027997860813832599966181230491327725660823554481496951755224384924618139899131077685015368534350419773927945648948725886893781694240485015409391212411953346024661529191785876527911616053943612974127120384 = -46 bsr -682. +8239777107128 = -9584735 + 8239786691863. +-8239796276598 = -9584735 - 8239786691863. +-78976171898033511305 = -9584735 * 8239786691863. +9584735 = -(-9584735). +-9584735 = +(-9584735). +0 = -9584735 div 8239786691863. +-9584735 = -9584735 rem 8239786691863. +8239778172161 = -9584735 band 8239786691863. +-1065033 = -9584735 bor 8239786691863. +-8239779237194 = -9584735 bxor 8239786691863. +9584734 = bnot(-9584735). +-1 = -9584735 bsl -546. +-2207789901237298349168515420337438685802160456150401071122584087718795318977399464587385366042827588336888176608306170711999671293512097614322126374505966913691887641559040 = -9584735 bsr -546. +864214577958738583386 = -999868 + 864214577958739583254. +-864214577958740583122 = -999868 - 864214577958739583254. +-864100501634449029629010472 = -999868 * 864214577958739583254. +999868 = -(-999868). +-999868 = +(-999868). +0 = -999868 div 864214577958739583254. +-999868 = -999868 rem 864214577958739583254. +864214577958738731012 = -999868 band 864214577958739583254. +-147626 = -999868 bor 864214577958739583254. +-864214577958738878638 = -999868 bxor 864214577958739583254. +999867 = bnot(-999868). +-1 = -999868 bsl -44. +-17589863875858137088 = -999868 bsr -44. +742429259336656208630042 = 742429266981345577992641 + -7644689369362599. +742429274626034947355240 = 742429266981345577992641 - -7644689369362599. +-5675641124795959371173671938168082633959 = 742429266981345577992641 * -7644689369362599. +-742429266981345577992641 = -(742429266981345577992641). +742429266981345577992641 = +(742429266981345577992641). +-97116996 = 742429266981345577992641 div -7644689369362599. +75715528360037 = 742429266981345577992641 rem -7644689369362599. +742429262468394699456833 = 742429266981345577992641 band -7644689369362599. +-3131738490826791 = 742429266981345577992641 bor -7644689369362599. +-742429265600133190283624 = 742429266981345577992641 bxor -7644689369362599. +-742429266981345577992642 = bnot(742429266981345577992641). +56096369380706971764952345809247950674566578176 = 742429266981345577992641 bsl 76. +9 = 742429266981345577992641 bsr 76. +-63822114144981621 = -34 + -63822114144981587. +63822114144981553 = -34 - -63822114144981587. +2169951880929373958 = -34 * -63822114144981587. +34 = -(-34). +-34 = +(-34). +0 = -34 div -63822114144981587. +-34 = -34 rem -63822114144981587. +-63822114144981620 = -34 band -63822114144981587. +-1 = -34 bor -63822114144981587. +63822114144981619 = -34 bxor -63822114144981587. +33 = bnot(-34). +-18253611008 = -34 bsl 29. +-1 = -34 bsr 29. +-2686231576924555149905426542 = -2686231576924555149813974296 + -91452246. +-2686231576924555149722522050 = -2686231576924555149813974296 - -91452246. +245661910985872341001354431555468816 = -2686231576924555149813974296 * -91452246. +2686231576924555149813974296 = -(-2686231576924555149813974296). +-2686231576924555149813974296 = +(-2686231576924555149813974296). +29373051996170276122 = -2686231576924555149813974296 div -91452246. +-16904284 = -2686231576924555149813974296 rem -91452246. +-2686231576924555149884258136 = -2686231576924555149813974296 band -91452246. +-21168406 = -2686231576924555149813974296 bor -91452246. +2686231576924555149863089730 = -2686231576924555149813974296 bxor -91452246. +2686231576924555149813974295 = bnot(-2686231576924555149813974296). +-145620906 = -2686231576924555149813974296 bsl -64. +-49552226422244501234349603813943975169109262336 = -2686231576924555149813974296 bsr -64. +-7794906949236057903 = -8239525163563949492 + 444618214327891589. +-8684143377891841081 = -8239525163563949492 - 444618214327891589. +-3663442965133532096405715590047622788 = -8239525163563949492 * 444618214327891589. +8239525163563949492 = -(-8239525163563949492). +-8239525163563949492 = +(-8239525163563949492). +-18 = -8239525163563949492 div 444618214327891589. +-236397305661900890 = -8239525163563949492 rem 444618214327891589. +298101241817375236 = -8239525163563949492 band 444618214327891589. +-8093008191053433139 = -8239525163563949492 bor 444618214327891589. +-8391109432870808375 = -8239525163563949492 bxor 444618214327891589. +8239525163563949491 = bnot(-8239525163563949492). +-1 = -8239525163563949492 bsl -269. +-7815756456038475044314658489534671849000407135891980184024346413048071743431833478349947290521698304 = -8239525163563949492 bsr -269. +-9469201222362472158468 = -9511385564486716393926 + 42184342124244235458. +-9553569906610960629384 = -9511385564486716393926 - 42184342124244235458. +-401231542727905526424290941252210625028108 = -9511385564486716393926 * 42184342124244235458. +9511385564486716393926 = -(-9511385564486716393926). +-9511385564486716393926 = +(-9511385564486716393926). +-225 = -9511385564486716393926 div 42184342124244235458. +-19908586531763415876 = -9511385564486716393926 rem 42184342124244235458. +4683851916089193474 = -9511385564486716393926 band 42184342124244235458. +-9473885074278561351942 = -9511385564486716393926 bor 42184342124244235458. +-9478568926194650545416 = -9511385564486716393926 bxor 42184342124244235458. +9511385564486716393925 = bnot(-9511385564486716393926). +-1 = -9511385564486716393926 bsl -872. +-299502192571225438047488105658859863385967144993669725823404832331225269910529398842051240815323832342514425020449726133790958582625570706749851376388969819379334603895213893319813641128404044517800989825299954131142773830774705719482501075599631003152051945016770640324681096543338496 = -9511385564486716393926 bsr -872. +-82327367158839231346468686 = -82327367158839231414763514 + 68294828. +-82327367158839231483058342 = -82327367158839231414763514 - 68294828. +-5622533379805773989123470849305592 = -82327367158839231414763514 * 68294828. +82327367158839231414763514 = -(-82327367158839231414763514). +-82327367158839231414763514 = +(-82327367158839231414763514). +-1205470012441340820 = -82327367158839231414763514 div 68294828. +-23484554 = -82327367158839231414763514 rem 68294828. +4 = -82327367158839231414763514 band 68294828. +-82327367158839231346468690 = -82327367158839231414763514 bor 68294828. +-82327367158839231346468694 = -82327367158839231414763514 bxor 68294828. +82327367158839231414763513 = bnot(-82327367158839231414763514). +-1 = -82327367158839231414763514 bsl -862. +-2531631490728627937601786650854934811248022860364659715090149968584266679474566383501961515903027741185156659521588388177636000048472950697199597078612943528485007433241218981825673198379847255299771693621571458318840535791756308399134792078730413455274294383363650980665154094975942656 = -82327367158839231414763514 bsr -862. +576646511682247658 = 2852342282936486 + 573794169399311172. +-570941827116374686 = 2852342282936486 - 573794169399311172. +1636657371080076004094657826221592 = 2852342282936486 * 573794169399311172. +-2852342282936486 = -(2852342282936486). +2852342282936486 = +(2852342282936486). +0 = 2852342282936486 div 573794169399311172. +2852342282936486 = 2852342282936486 rem 573794169399311172. +565151124971524 = 2852342282936486 band 573794169399311172. +576081360557276134 = 2852342282936486 bor 573794169399311172. +575516209432304610 = 2852342282936486 bxor 573794169399311172. +-2852342282936487 = bnot(2852342282936486). +802862977660366763796847394816 = 2852342282936486 bsl 48. +10 = 2852342282936486 bsr 48. +-3924188576621262044924576719 = -2961569231199212855 + -3924188573659692813725363864. +3924188570698123582526151009 = -2961569231199212855 - -3924188573659692813725363864. +11621756137174072111357977307746881505261271720 = -2961569231199212855 * -3924188573659692813725363864. +2961569231199212855 = -(-2961569231199212855). +-2961569231199212855 = +(-2961569231199212855). +0 = -2961569231199212855 div -3924188573659692813725363864. +-2961569231199212855 = -2961569231199212855 rem -3924188573659692813725363864. +-3924188576542156021877931960 = -2961569231199212855 band -3924188573659692813725363864. +-79106023046644759 = -2961569231199212855 bor -3924188573659692813725363864. +3924188576463049998831287201 = -2961569231199212855 bxor -3924188573659692813725363864. +2961569231199212854 = bnot(-2961569231199212855). +-5784314904685963 = -2961569231199212855 bsl -9. +-1516323446373996981760 = -2961569231199212855 bsr -9. +-7831461881754721320824764644 = -7831461881754721314434837393 + -6389927251. +-7831461881754721308044910142 = -7831461881754721314434837393 - -6389927251. +50042471693392233425017707121284496643 = -7831461881754721314434837393 * -6389927251. +7831461881754721314434837393 = -(-7831461881754721314434837393). +-7831461881754721314434837393 = +(-7831461881754721314434837393). +1225594842340204494 = -7831461881754721314434837393 div -6389927251. +-5311571399 = -7831461881754721314434837393 rem -6389927251. +-7831461881754721319406006227 = -7831461881754721314434837393 band -6389927251. +-1418758417 = -7831461881754721314434837393 bor -6389927251. +7831461881754721317987247810 = -7831461881754721314434837393 bxor -6389927251. +7831461881754721314434837392 = bnot(-7831461881754721314434837393). +-442783854038468215329094768091161141255478419537582706029054537536642857581179154220410293681154686976 = -7831461881754721314434837393 bsl 245. +-1 = -7831461881754721314434837393 bsr 245. +194621195850105967080077323 = 96387968691682123552961471 + 98233227158423843527115852. +-1845258466741719974154381 = 96387968691682123552961471 - 98233227158423843527115852. +9468501223829055524727701090123235136541605909338292 = 96387968691682123552961471 * 98233227158423843527115852. +-96387968691682123552961471 = -(96387968691682123552961471). +96387968691682123552961471 = +(96387968691682123552961471). +0 = 96387968691682123552961471 div 98233227158423843527115852. +96387968691682123552961471 = 96387968691682123552961471 rem 98233227158423843527115852. +78583429525471920982360076 = 96387968691682123552961471 band 98233227158423843527115852. +116037766324634046097717247 = 96387968691682123552961471 bor 98233227158423843527115852. +37454336799162125115357171 = 96387968691682123552961471 bxor 98233227158423843527115852. +-96387968691682123552961472 = bnot(96387968691682123552961471). +5610518197743345 = 96387968691682123552961471 bsl -34. +1655932693034586511551203367572209664 = 96387968691682123552961471 bsr -34. +-6176529541955489 = -6176529541946177 + -9312. +-6176529541936865 = -6176529541946177 - -9312. +57515843094602800224 = -6176529541946177 * -9312. +6176529541946177 = -(-6176529541946177). +-6176529541946177 = +(-6176529541946177). +663287107167 = -6176529541946177 div -9312. +-7073 = -6176529541946177 rem -9312. +-6176529541955424 = -6176529541946177 band -9312. +-65 = -6176529541946177 bor -9312. +6176529541955359 = -6176529541946177 bxor -9312. +6176529541946176 = bnot(-6176529541946177). +-1 = -6176529541946177 bsl -282. +-47995807212208277884944016617820070836245614453104659072077011457368858099803947103643668713578692608 = -6176529541946177 bsr -282. +-579636899835487569585335692 = -579636899835487569585335765 + 73. +-579636899835487569585335838 = -579636899835487569585335765 - 73. +-42313493687990592579729510845 = -579636899835487569585335765 * 73. +579636899835487569585335765 = -(-579636899835487569585335765). +-579636899835487569585335765 = +(-579636899835487569585335765). +-7940231504595720131305969 = -579636899835487569585335765 div 73. +-28 = -579636899835487569585335765 rem 73. +9 = -579636899835487569585335765 band 73. +-579636899835487569585335701 = -579636899835487569585335765 bor 73. +-579636899835487569585335710 = -579636899835487569585335765 bxor 73. +579636899835487569585335764 = bnot(-579636899835487569585335765). +-1 = -579636899835487569585335765 bsl -938. +-1346765423176583012049052892147042667014251665156490772334510940228576398548649372195525300955339723355712093608524844502210775957221752905511057470718258827159087451739739288214013652339412227414100683885806358080844304086823596559794764688306073651238227667486207613978771789074030450792545845265846931292160 = -579636899835487569585335765 bsr -938. +-37156449122464181194286 = 382447 + -37156449122464181576733. +37156449122464181959180 = 382447 - -37156449122464181576733. +-14210372497539058851476805651 = 382447 * -37156449122464181576733. +-382447 = -(382447). +382447 = +(382447). +0 = 382447 div -37156449122464181576733. +382447 = 382447 rem -37156449122464181576733. +332259 = 382447 band -37156449122464181576733. +-37156449122464181526545 = 382447 bor -37156449122464181576733. +-37156449122464181858804 = 382447 bxor -37156449122464181576733. +-382448 = bnot(382447). +3267607335707377193126915465837706790293842145846939127631744887147137869862514545738527125050530725888 = 382447 bsl 322. +0 = 382447 bsr 322. +-3879793355513634615720575 = -481911 + -3879793355513634615238664. +3879793355513634614756753 = -481911 - -3879793355513634615238664. +1869715095748931171064279806904 = -481911 * -3879793355513634615238664. +481911 = -(-481911). +-481911 = +(-481911). +0 = -481911 div -3879793355513634615238664. +-481911 = -481911 rem -3879793355513634615238664. +-3879793355513634615720568 = -481911 band -3879793355513634615238664. +-7 = -481911 bor -3879793355513634615238664. +3879793355513634615720561 = -481911 bxor -3879793355513634615238664. +481910 = bnot(-481911). +-1 = -481911 bsl -92. +-2386307689088227574627647415648256 = -481911 bsr -92. +-685793482466922729770089 = 43851784289 + -685793482466966581554378. +685793482467010433338667 = 43851784289 - -685793482466966581554378. +-30073267859943522102494310379567242 = 43851784289 * -685793482466966581554378. +-43851784289 = -(43851784289). +43851784289 = +(43851784289). +0 = 43851784289 div -685793482466966581554378. +43851784289 = 43851784289 rem -685793482466966581554378. +9127133216 = 43851784289 band -685793482466966581554378. +-685793482466931856903305 = 43851784289 bor -685793482466966581554378. +-685793482466940984036521 = 43851784289 bxor -685793482466966581554378. +-43851784290 = bnot(43851784289). +0 = 43851784289 bsl -741. +507240656676445006921350498546236949549885605308873515813999060954631952492340984108575825868855107686850300348339344660908756789690404717943725680905979044051237707408360970203848608972443834876606623368978764950416702005167708438528 = 43851784289 bsr -741. +-64297936826539773755448431895 = 2395351967 + -64297936826539773757843783862. +64297936826539773760239135829 = 2395351967 - -64297936826539773757843783862. +-154016189451493784874586089352564556554 = 2395351967 * -64297936826539773757843783862. +-2395351967 = -(2395351967). +2395351967 = +(2395351967). +0 = 2395351967 div -64297936826539773757843783862. +2395351967 = 2395351967 rem -64297936826539773757843783862. +2361666314 = 2395351967 band -64297936826539773757843783862. +-64297936826539773757810098209 = 2395351967 bor -64297936826539773757843783862. +-64297936826539773760171764523 = 2395351967 bxor -64297936826539773757843783862. +-2395351968 = bnot(2395351967). +379558669840677493225295095876575821824 = 2395351967 bsl 97. +0 = 2395351967 bsr 97. +770813703325541 = 836295641311454 + -65481937985913. +901777579297367 = 836295641311454 - -65481937985913. +-54762259322245972818697547502 = 836295641311454 * -65481937985913. +-836295641311454 = -(836295641311454). +836295641311454 = +(836295641311454). +-12 = 836295641311454 div -65481937985913. +50512385480498 = 836295641311454 rem -65481937985913. +774130274175110 = 836295641311454 band -65481937985913. +-3316570849569 = 836295641311454 bor -65481937985913. +-777446845024679 = 836295641311454 bxor -65481937985913. +-836295641311455 = bnot(836295641311454). +0 = 836295641311454 bsl -782. +21272397638013034718728490721075051503817452457058679878289406207574916622366800339593607966879094691976196311442781198819613867431211340106115654351939124120269224915055093698208503418889470534301291559958922191784577789792542951420477967228643311616 = 836295641311454 bsr -782. +315 = -77 + 392. +-469 = -77 - 392. +-30184 = -77 * 392. +77 = -(-77). +-77 = +(-77). +0 = -77 div 392. +-77 = -77 rem 392. +384 = -77 band 392. +-69 = -77 bor 392. +-453 = -77 bxor 392. +76 = bnot(-77). +-41339060224 = -77 bsl 29. +-1 = -77 bsr 29. +-726958148793677870 = -726958148793677877 + 7. +-726958148793677884 = -726958148793677877 - 7. +-5088707041555745139 = -726958148793677877 * 7. +726958148793677877 = -(-726958148793677877). +-726958148793677877 = +(-726958148793677877). +-103851164113382553 = -726958148793677877 div 7. +-6 = -726958148793677877 rem 7. +3 = -726958148793677877 band 7. +-726958148793677873 = -726958148793677877 bor 7. +-726958148793677876 = -726958148793677877 bxor 7. +726958148793677876 = bnot(-726958148793677877). +-2839680268725305 = -726958148793677877 bsl -8. +-186101286091181536512 = -726958148793677877 bsr -8. +-27391664628842574182975932 = -31724496561664731869374853 + 4332831932822157686398921. +-36057328494486889555773774 = -31724496561664731869374853 - 4332831932822157686398921. +-137456911755087696017154216110617535911133043733613 = -31724496561664731869374853 * 4332831932822157686398921. +31724496561664731869374853 = -(-31724496561664731869374853). +-31724496561664731869374853 = +(-31724496561664731869374853). +-7 = -31724496561664731869374853 div 4332831932822157686398921. +-1394673031909628064582406 = -31724496561664731869374853 rem 4332831932822157686398921. +1813444657374202021451337 = -31724496561664731869374853 band 4332831932822157686398921. +-29205109286216776204427269 = -31724496561664731869374853 bor 4332831932822157686398921. +-31018553943590978225878606 = -31724496561664731869374853 bxor 4332831932822157686398921. +31724496561664731869374852 = bnot(-31724496561664731869374853). +-2454564032491009351568915678640966559254341004296192 = -31724496561664731869374853 bsl 86. +-1 = -31724496561664731869374853 bsr 86. +2275149 = -6 + 2275155. +-2275161 = -6 - 2275155. +-13650930 = -6 * 2275155. +6 = -(-6). +-6 = +(-6). +0 = -6 div 2275155. +-6 = -6 rem 2275155. +2275154 = -6 band 2275155. +-5 = -6 bor 2275155. +-2275159 = -6 bxor 2275155. +5 = bnot(-6). +-1325135298583788247187473125557188886870612922656714218591204650969464832 = -6 bsl 237. +-1 = -6 bsr 237. +-297695611366842322174181901 = -6 + -297695611366842322174181895. +297695611366842322174181889 = -6 - -297695611366842322174181895. +1786173668201053933045091370 = -6 * -297695611366842322174181895. +6 = -(-6). +-6 = +(-6). +0 = -6 div -297695611366842322174181895. +-6 = -6 rem -297695611366842322174181895. +-297695611366842322174181896 = -6 band -297695611366842322174181895. +-5 = -6 bor -297695611366842322174181895. +297695611366842322174181891 = -6 bxor -297695611366842322174181895. +5 = bnot(-6). +-1 = -6 bsl -398. +-3873374817130362884483878758004517811494558689243835269245989034810971433025261791944468029920206747153854757959121240064 = -6 bsr -398. +4526392995126238 = 4526392995561573 + -435335. +4526392995996908 = 4526392995561573 - -435335. +-1970497294722797381955 = 4526392995561573 * -435335. +-4526392995561573 = -(4526392995561573). +4526392995561573 = +(4526392995561573). +-10397493873 = 4526392995561573 div -435335. +359118 = 4526392995561573 rem -435335. +4526392995299425 = 4526392995561573 band -435335. +-173187 = 4526392995561573 bor -435335. +-4526392995472612 = 4526392995561573 bxor -435335. +-4526392995561574 = bnot(4526392995561573). +9492534123427943940096 = 4526392995561573 bsl 21. +2158352372 = 4526392995561573 bsr 21. +7887314996470303626382 = 7887373824819569326219 + -58828349265699837. +7887432653168835026056 = 7887373824819569326219 - -58828349265699837. +-464001182155624425965132306817588126303 = 7887373824819569326219 * -58828349265699837. +-7887373824819569326219 = -(7887373824819569326219). +7887373824819569326219 = +(7887373824819569326219). +-134074 = 7887373824819569326219 div -58828349265699837. +21725370129380281 = 7887373824819569326219 rem -58828349265699837. +7887355810341930080259 = 7887373824819569326219 band -58828349265699837. +-40813871626453877 = 7887373824819569326219 bor -58828349265699837. +-7887396624213556534136 = 7887373824819569326219 bxor -58828349265699837. +-7887373824819569326220 = bnot(7887373824819569326219). +985921728102446165777 = 7887373824819569326219 bsl -3. +63098990598556554609752 = 7887373824819569326219 bsr -3. +-39829885621163298980777562 = -4847991611 + -39829885621163294132785951. +39829885621163289284794340 = -4847991611 - -39829885621163294132785951. +193094951358489174016871810506657061 = -4847991611 * -39829885621163294132785951. +4847991611 = -(-4847991611). +-4847991611 = +(-4847991611). +0 = -4847991611 div -39829885621163294132785951. +-4847991611 = -4847991611 rem -39829885621163294132785951. +-39829885621163298442443583 = -4847991611 band -39829885621163294132785951. +-538333979 = -4847991611 bor -39829885621163294132785951. +39829885621163297904109604 = -4847991611 bxor -39829885621163294132785951. +4847991610 = bnot(-4847991611). +-1 = -4847991611 bsl -815. +-1059274032173169249210912480478494242895499365554911866173767690067157635577659137412971079812073458566849467649816801488739198889427389825097658891419842676658538651753087239335473072810778095703758240053305602292270128237182995593610156636408404139573248 = -4847991611 bsr -815. +-95223736697 = -95222763361 + -973336. +-95221790025 = -95222763361 - -973336. +92683743598742296 = -95222763361 * -973336. +95222763361 = -(-95222763361). +-95222763361 = +(-95222763361). +97831 = -95222763361 div -973336. +-329145 = -95222763361 rem -973336. +-95223209848 = -95222763361 band -973336. +-526849 = -95222763361 bor -973336. +95222682999 = -95222763361 bxor -973336. +95222763360 = bnot(-95222763361). +-1 = -95222763361 bsl -54. +-1715380806359154077124788224 = -95222763361 bsr -54. +82182257492664591951363162 = 82182257492664591951363615 + -453. +82182257492664591951364068 = 82182257492664591951363615 - -453. +-37228562644177060153967717595 = 82182257492664591951363615 * -453. +-82182257492664591951363615 = -(82182257492664591951363615). +82182257492664591951363615 = +(82182257492664591951363615). +-181417786959524485543849 = 82182257492664591951363615 div -453. +18 = 82182257492664591951363615 rem -453. +82182257492664591951363611 = 82182257492664591951363615 band -453. +-449 = 82182257492664591951363615 bor -453. +-82182257492664591951364060 = 82182257492664591951363615 bxor -453. +-82182257492664591951363616 = bnot(82182257492664591951363615). +0 = 82182257492664591951363615 bsl -89. +50868353534515221204638696196059782526438483039354880 = 82182257492664591951363615 bsr -89. +34336558417852744164668007 = 34336558417383317722736162 + 469426441931845. +34336558416913891280804317 = 34336558417383317722736162 - 469426441931845. +16118488446057193649802819013002520878890 = 34336558417383317722736162 * 469426441931845. +-34336558417383317722736162 = -(34336558417383317722736162). +34336558417383317722736162 = +(34336558417383317722736162). +73145769710 = 34336558417383317722736162 div 469426441931845. +51895837321212 = 34336558417383317722736162 rem 469426441931845. +11823306867712 = 34336558417383317722736162 band 469426441931845. +34336558417840920857800295 = 34336558417383317722736162 bor 469426441931845. +34336558417829097550932583 = 34336558417383317722736162 bxor 469426441931845. +-34336558417383317722736163 = bnot(34336558417383317722736162). +9438361309430711520968256731299708928 = 34336558417383317722736162 bsl 38. +124915671830907 = 34336558417383317722736162 bsr 38. +6363678596284926877774 = 6363678596284926877719 + 55. +6363678596284926877664 = 6363678596284926877719 - 55. +350002322795670978274545 = 6363678596284926877719 * 55. +-6363678596284926877719 = -(6363678596284926877719). +6363678596284926877719 = +(6363678596284926877719). +115703247205180488685 = 6363678596284926877719 div 55. +44 = 6363678596284926877719 rem 55. +23 = 6363678596284926877719 band 55. +6363678596284926877751 = 6363678596284926877719 bor 55. +6363678596284926877728 = 6363678596284926877719 bxor 55. +-6363678596284926877720 = bnot(6363678596284926877719). +0 = 6363678596284926877719 bsl -357. +1868171270807695465811717792912671932573589457822593548078554753678289760300921328694949457367392182152900585249481507182338899968 = 6363678596284926877719 bsr -357. +2836235199466365630442 = -876 + 2836235199466365631318. +-2836235199466365632194 = -876 - 2836235199466365631318. +-2484542034732536293034568 = -876 * 2836235199466365631318. +876 = -(-876). +-876 = +(-876). +0 = -876 div 2836235199466365631318. +-876 = -876 rem 2836235199466365631318. +2836235199466365630484 = -876 band 2836235199466365631318. +-42 = -876 bor 2836235199466365631318. +-2836235199466365630526 = -876 bxor 2836235199466365631318. +875 = bnot(-876). +-1926344371863552 = -876 bsl 41. +-1 = -876 bsr 41. +-47372461657264100128016242 = -786194966312368178575 + -47371675462297787759837667. +47370889267331475391659092 = -786194966312368178575 - -47371675462297787759837667. +37243372794241647509924771819376743578467384525 = -786194966312368178575 * -47371675462297787759837667. +786194966312368178575 = -(-786194966312368178575). +-786194966312368178575 = +(-786194966312368178575). +0 = -786194966312368178575 div -47371675462297787759837667. +-786194966312368178575 = -786194966312368178575 rem -47371675462297787759837667. +-47372414666538015693719023 = -786194966312368178575 band -47371675462297787759837667. +-46990726084434297219 = -786194966312368178575 bor -47371675462297787759837667. +47372367675811931259421804 = -786194966312368178575 bxor -47371675462297787759837667. +786194966312368178574 = bnot(-786194966312368178575). +-1 = -786194966312368178575 bsl -842. +-23056140391842376856942385979048877753494478796369537038283990637967359275756168535019576389602874038491715400459610608590330696454643966505877991077027671488589191268781221316986692007983001771463057149877393715414378574703287577707240626738075837126331648151212247534796800 = -786194966312368178575 bsr -842. +37024255800679 = 7448912425833 + 29575343374846. +-22126430949013 = 7448912425833 - 29575343374846. +220304142763168062892796718 = 7448912425833 * 29575343374846. +-7448912425833 = -(7448912425833). +7448912425833 = +(7448912425833). +0 = 7448912425833 div 29575343374846. +7448912425833 = 7448912425833 rem 29575343374846. +3049456533864 = 7448912425833 band 29575343374846. +33974799266815 = 7448912425833 bor 29575343374846. +30925342732951 = 7448912425833 bxor 29575343374846. +-7448912425834 = bnot(7448912425833). +232778513307 = 7448912425833 bsl -5. +238365197626656 = 7448912425833 bsr -5. +-8498864996039499763036 = -9265742822333137134835 + 766877826293637371799. +-10032620648626774506634 = -9265742822333137134835 - 766877826293637371799. +-7105692714586708823837484658209598489518165 = -9265742822333137134835 * 766877826293637371799. +9265742822333137134835 = -(-9265742822333137134835). +-9265742822333137134835 = +(-9265742822333137134835). +-12 = -9265742822333137134835 div 766877826293637371799. +-63208906809488673247 = -9265742822333137134835 rem 766877826293637371799. +176581658718206710533 = -9265742822333137134835 band 766877826293637371799. +-8675446654757706473569 = -9265742822333137134835 bor 766877826293637371799. +-8852028313475913184102 = -9265742822333137134835 bxor 766877826293637371799. +9265742822333137134834 = bnot(-9265742822333137134835). +-144777231598955267732 = -9265742822333137134835 bsl -6. +-593007540629320776629440 = -9265742822333137134835 bsr -6. +-56882487688527177609281 = -56882487688532411578145 + 5233968864. +-56882487688537645547009 = -56882487688532411578145 - 5233968864. +-297721169468641972054844032877280 = -56882487688532411578145 * 5233968864. +56882487688532411578145 = -(-56882487688532411578145). +-56882487688532411578145 = +(-56882487688532411578145). +-10867945371203 = -56882487688532411578145 div 5233968864. +-2987354753 = -56882487688532411578145 rem 5233968864. +4949803200 = -56882487688532411578145 band 5233968864. +-56882487688532127412481 = -56882487688532411578145 bor 5233968864. +-56882487688537077215681 = -56882487688532411578145 bxor 5233968864. +56882487688532411578144 = bnot(-56882487688532411578145). +-512351900715962790238789615423942819840 = -56882487688532411578145 bsl 53. +-6315225 = -56882487688532411578145 bsr 53. +64575 = -33319 + 97894. +-131213 = -33319 - 97894. +-3261730186 = -33319 * 97894. +33319 = -(-33319). +-33319 = +(-33319). +0 = -33319 div 97894. +-33319 = -33319 rem 97894. +97344 = -33319 band 97894. +-32769 = -33319 bor 97894. +-130113 = -33319 bxor 97894. +33318 = bnot(-33319). +-1 = -33319 bsl -363. +-626008722523530794560396832035391363321042934776610478176769823043853380062349109822135895417456867330568331722752 = -33319 bsr -363. +67769193761565562434810930047 = 67769193738113729497422973453 + 23451832937387956594. +67769193714661896560035016859 = 67769193738113729497422973453 - 23451832937387956594. +1589311809847721219260337275925999570019178299082 = 67769193738113729497422973453 * 23451832937387956594. +-67769193738113729497422973453 = -(67769193738113729497422973453). +67769193738113729497422973453 = +(67769193738113729497422973453). +2889718424 = 67769193738113729497422973453 div 23451832937387956594. +22373712892028885597 = 67769193738113729497422973453 rem 23451832937387956594. +23361758981359929344 = 67769193738113729497422973453 band 23451832937387956594. +67769193738203803453451000703 = 67769193738113729497422973453 bor 23451832937387956594. +67769193714842044472091071359 = 67769193738113729497422973453 bxor 23451832937387956594. +-67769193738113729497422973454 = bnot(67769193738113729497422973453). +2117787304316054046794467920 = 67769193738113729497422973453 bsl -5. +2168614199619639343917535150496 = 67769193738113729497422973453 bsr -5. +-7885694187608415931205573899 = -8273167911729764246432215673 + 387473724121348315226641774. +-8660641635851112561658857447 = -8273167911729764246432215673 - 387473724121348315226641774. +-3205635181039170021882665399154579563048311525879323902 = -8273167911729764246432215673 * 387473724121348315226641774. +8273167911729764246432215673 = -(-8273167911729764246432215673). +-8273167911729764246432215673 = +(-8273167911729764246432215673). +-21 = -8273167911729764246432215673 div 387473724121348315226641774. +-136219705181449626672738419 = -8273167911729764246432215673 rem 387473724121348315226641774. +387463095885847653291132166 = -8273167911729764246432215673 band 387473724121348315226641774. +-8273157283494263584496706065 = -8273167911729764246432215673 bor 387473724121348315226641774. +-8660620379380111237787838231 = -8273167911729764246432215673 bxor 387473724121348315226641774. +8273167911729764246432215672 = bnot(-8273167911729764246432215673). +-2068291977932441061608053919 = -8273167911729764246432215673 bsl -2. +-33092671646919056985728862692 = -8273167911729764246432215673 bsr -2. +-9340882561511109548174122 = -8616146697814932781717359 + -724735863696176766456763. +-7891410834118756015260596 = -8616146697814932781717359 - -724735863696176766456763. +6244430518773866671246836981563234056856560048917 = -8616146697814932781717359 * -724735863696176766456763. +8616146697814932781717359 = -(-8616146697814932781717359). +-8616146697814932781717359 = +(-8616146697814932781717359). +11 = -8616146697814932781717359 div -724735863696176766456763. +-644052197156988350692966 = -8616146697814932781717359 rem -724735863696176766456763. +-9340734807308439922137087 = -8616146697814932781717359 band -724735863696176766456763. +-147754202669626037035 = -8616146697814932781717359 bor -724735863696176766456763. +9340587053105770296100052 = -8616146697814932781717359 bxor -724735863696176766456763. +8616146697814932781717358 = bnot(-8616146697814932781717359). +-1 = -8616146697814932781717359 bsl -455. +-801606281495502293128590378590436882741939672196195224471519060616467399151958617949152781733879053032977845343629338540173896768533078295212512138385883777728512 = -8616146697814932781717359 bsr -455. +-721711695065839494 = -721711699848178775 + 4782339281. +-721711704630518056 = -721711699848178775 - 4782339281. +-3451470211741227091992960775 = -721711699848178775 * 4782339281. +721711699848178775 = -(-721711699848178775). +-721711699848178775 = +(-721711699848178775). +-150911856 = -721711699848178775 div 4782339281. +-2930763239 = -721711699848178775 rem 4782339281. +67899521 = -721711699848178775 band 4782339281. +-721711695133739015 = -721711699848178775 bor 4782339281. +-721711695201638536 = -721711699848178775 bxor 4782339281. +721711699848178774 = bnot(-721711699848178775). +-109061988533053345959846156529321168076800 = -721711699848178775 bsl 77. +-1 = -721711699848178775 bsr 77. +733733191817308369 = 733733191817313955 + -5586. +733733191817319541 = 733733191817313955 - -5586. +-4098633609491515752630 = 733733191817313955 * -5586. +-733733191817313955 = -(733733191817313955). +733733191817313955 = +(733733191817313955). +-131352164664753 = 733733191817313955 div -5586. +3697 = 733733191817313955 rem -5586. +733733191817308706 = 733733191817313955 band -5586. +-337 = 733733191817313955 bor -5586. +-733733191817309043 = 733733191817313955 bxor -5586. +-733733191817313956 = bnot(733733191817313955). +5538162991525838594741869954611567113668786757581083286911736941383154599216724252392860416284411687606958361153300446379109181948976694609697270551828111996701734676461057576930545500160 = 733733191817313955 bsl 561. +0 = 733733191817313955 bsr 561. +94448894682821423222216 = 94448894682821423222291 + -75. +94448894682821423222366 = 94448894682821423222291 - -75. +-7083667101211606741671825 = 94448894682821423222291 * -75. +-94448894682821423222291 = -(94448894682821423222291). +94448894682821423222291 = +(94448894682821423222291). +-1259318595770952309630 = 94448894682821423222291 div -75. +41 = 94448894682821423222291 rem -75. +94448894682821423222289 = 94448894682821423222291 band -75. +-73 = 94448894682821423222291 bor -75. +-94448894682821423222362 = 94448894682821423222291 bxor -75. +-94448894682821423222292 = bnot(94448894682821423222291). +2951527958838169475696 = 94448894682821423222291 bsl -5. +3022364629850285543113312 = 94448894682821423222291 bsr -5. +8281516573311517468 = 29388669 + 8281516573282128799. +-8281516573252740130 = 29388669 - 8281516573282128799. +243382749390202726889178531 = 29388669 * 8281516573282128799. +-29388669 = -(29388669). +29388669 = +(29388669). +0 = 29388669 div 8281516573282128799. +29388669 = 29388669 rem 8281516573282128799. +29377309 = 29388669 band 8281516573282128799. +8281516573282140159 = 29388669 bor 8281516573282128799. +8281516573252762850 = 29388669 bxor 8281516573282128799. +-29388670 = bnot(29388669). +0 = 29388669 bsl -516. +6304602068298530802555856986719955291286766182900851726331355532331216818815000284114895397254950905461564494075161261146530244310801391837457379857631751736131584 = 29388669 bsr -516. +73857 = 73381 + 476. +72905 = 73381 - 476. +34929356 = 73381 * 476. +-73381 = -(73381). +73381 = +(73381). +154 = 73381 div 476. +77 = 73381 rem 476. +132 = 73381 band 476. +73725 = 73381 bor 476. +73593 = 73381 bxor 476. +-73382 = bnot(73381). +18785536 = 73381 bsl 8. +286 = 73381 bsr 8. +-672 = -678 + 6. +-684 = -678 - 6. +-4068 = -678 * 6. +678 = -(-678). +-678 = +(-678). +-113 = -678 div 6. +0 = -678 rem 6. +2 = -678 band 6. +-674 = -678 bor 6. +-676 = -678 bxor 6. +677 = bnot(-678). +-11 = -678 bsl -6. +-43392 = -678 bsr -6. +646871226767987500146156850189 = 646871226767894615366929898452 + 92884779226951737. +646871226767801730587702946715 = 646871226767894615366929898452 - 92884779226951737. +60084491086603324173941866316678094918915011124 = 646871226767894615366929898452 * 92884779226951737. +-646871226767894615366929898452 = -(646871226767894615366929898452). +646871226767894615366929898452 = +(646871226767894615366929898452). +6964232807049 = 646871226767894615366929898452 div 92884779226951737. +53875763773504339 = 646871226767894615366929898452 rem 92884779226951737. +90619621955096592 = 646871226767894615366929898452 band 92884779226951737. +646871226767896880524201753597 = 646871226767894615366929898452 bor 92884779226951737. +646871226767806260902246657005 = 646871226767894615366929898452 bxor 92884779226951737. +-646871226767894615366929898453 = bnot(646871226767894615366929898452). +0 = 646871226767894615366929898452 bsl -275. +39270519047433881707202790258921294936734613845970943458816343766813625805071514463646288271302578826787722100736 = 646871226767894615366929898452 bsr -275. +-7 = -3 + -4. +1 = -3 - -4. +12 = -3 * -4. +3 = -(-3). +-3 = +(-3). +0 = -3 div -4. +-3 = -3 rem -4. +-4 = -3 band -4. +-3 = -3 bor -4. +1 = -3 bxor -4. +2 = bnot(-3). +-1 = -3 bsl -7. +-384 = -3 bsr -7. +714249984402415 = 5123119881 + 714244861282534. +-714239738162653 = 5123119881 - 714244861282534. +3659162048738637093458454 = 5123119881 * 714244861282534. +-5123119881 = -(5123119881). +5123119881 = +(5123119881). +0 = 5123119881 div 714244861282534. +5123119881 = 5123119881 rem 714244861282534. +287049728 = 5123119881 band 714244861282534. +714249697352687 = 5123119881 bor 714244861282534. +714249410302959 = 5123119881 bxor 714244861282534. +-5123119882 = bnot(5123119881). +655759344768 = 5123119881 bsl 7. +40024374 = 5123119881 bsr 7. +959939234339641868150277905 = 959893656998498311384448464 + 45577341143556765829441. +959848079657354754618619023 = 959893656998498311384448464 - 45577341143556765829441. +43749400666556822964792371935459754694087278428624 = 959893656998498311384448464 * 45577341143556765829441. +-959893656998498311384448464 = -(959893656998498311384448464). +959893656998498311384448464 = +(959893656998498311384448464). +21060 = 959893656998498311384448464 div 45577341143556765829441. +34852515192823016421004 = 959893656998498311384448464 rem 45577341143556765829441. +5354212576714157230400 = 959893656998498311384448464 band 45577341143556765829441. +959933880127065153993047505 = 959893656998498311384448464 bor 45577341143556765829441. +959928525914488439835817105 = 959893656998498311384448464 bxor 45577341143556765829441. +-959893656998498311384448465 = bnot(959893656998498311384448464). +104071878 = 959893656998498311384448464 bsl -63. +8853456314314218895471508657041030238449958912 = 959893656998498311384448464 bsr -63. +59247603122112336157 = 462133893243347993 + 58785469228868988164. +-58323335335625640171 = 462133893243347993 - 58785469228868988164. +27166757760874259441608768381650154852 = 462133893243347993 * 58785469228868988164. +-462133893243347993 = -(462133893243347993). +462133893243347993 = +(462133893243347993). +0 = 462133893243347993 div 58785469228868988164. +462133893243347993 = 462133893243347993 rem 58785469228868988164. +453122219436942336 = 462133893243347993 band 58785469228868988164. +58794480902675393821 = 462133893243347993 bor 58785469228868988164. +58341358683238451485 = 462133893243347993 bxor 58785469228868988164. +-462133893243347994 = bnot(462133893243347993). +902605260240914 = 462133893243347993 bsl -9. +236612553340594172416 = 462133893243347993 bsr -9. +-698011569432077309818 = -35126663965523543 + -697976442768111786275. +697941316104146262732 = -35126663965523543 - -697976442768111786275. +24517583960966937814813969629296772325 = -35126663965523543 * -697976442768111786275. +35126663965523543 = -(-35126663965523543). +-35126663965523543 = +(-35126663965523543). +0 = -35126663965523543 div -697976442768111786275. +-35126663965523543 = -35126663965523543 rem -697976442768111786275. +-697985602812498640759 = -35126663965523543 band -697976442768111786275. +-25966619578669059 = -35126663965523543 bor -697976442768111786275. +697959636192919971700 = -35126663965523543 bxor -697976442768111786275. +35126663965523542 = bnot(-35126663965523543). +-1 = -35126663965523543 bsl -439. +-49866053955979679484958059718662141146464390837730256639612968936119505528878470902001368771063691814798804304753403053643510683012393077590861021184 = -35126663965523543 bsr -439. +-347226718057629 = -269767376619753 + -77459341437876. +-192308035181877 = -269767376619753 - -77459341437876. +20896003334389534767523964628 = -269767376619753 * -77459341437876. +269767376619753 = -(-269767376619753). +-269767376619753 = +(-269767376619753). +3 = -269767376619753 div -77459341437876. +-37389352306125 = -269767376619753 rem -77459341437876. +-272107596934140 = -269767376619753 band -77459341437876. +-75119121123489 = -269767376619753 bor -77459341437876. +196988475810651 = -269767376619753 bxor -77459341437876. +269767376619752 = bnot(-269767376619753). +-2671646694484568040711421504928585273573376 = -269767376619753 bsl 93. +-1 = -269767376619753 bsr 93. +58815216586799 = 4212156 + 58815212374643. +-58815208162487 = 4212156 - 58815212374643. +247738849695126760308 = 4212156 * 58815212374643. +-4212156 = -(4212156). +4212156 = +(4212156). +0 = 4212156 div 58815212374643. +4212156 = 4212156 rem 58815212374643. +4210736 = 4212156 band 58815212374643. +58815212376063 = 4212156 bor 58815212374643. +58815208165327 = 4212156 bxor 58815212374643. +-4212157 = bnot(4212156). +1053039 = 4212156 bsl -2. +16848624 = 4212156 bsr -2. +-88676814525367380585 = -88239588111222488472 + -437226414144892113. +-87802361697077596359 = -88239588111222488472 - -437226414144892113. +38580678695492062162453604775826221336 = -88239588111222488472 * -437226414144892113. +88239588111222488472 = -(-88239588111222488472). +-88239588111222488472 = +(-88239588111222488472). +201 = -88239588111222488472 div -437226414144892113. +-357078868099173759 = -88239588111222488472 rem -437226414144892113. +-88671935875773808088 = -88239588111222488472 band -437226414144892113. +-4878649593572497 = -88239588111222488472 bor -437226414144892113. +88667057226180235591 = -88239588111222488472 bxor -437226414144892113. +88239588111222488471 = bnot(-88239588111222488472). +-5647333639118239262208 = -88239588111222488472 bsl 6. +-1378743564237851383 = -88239588111222488472 bsr 6. +-437977443717588881112365 = -437977531113424834577219 + 87395835953464854. +-437977618509260788042073 = -437977531113424834577219 - 87395835953464854. +-38277412460492425885954993823007265561026 = -437977531113424834577219 * 87395835953464854. +437977531113424834577219 = -(-437977531113424834577219). +-437977531113424834577219 = +(-437977531113424834577219). +-5011423 = -437977531113424834577219 div 87395835953464854. +-28712004135549977 = -437977531113424834577219 rem 87395835953464854. +620127049614356 = -437977531113424834577219 band 87395835953464854. +-437977444337715930726721 = -437977531113424834577219 bor 87395835953464854. +-437977444957842980341077 = -437977531113424834577219 bxor 87395835953464854. +437977531113424834577218 = bnot(-437977531113424834577219). +-855424865455907880034 = -437977531113424834577219 bsl -9. +-224244495930073515303536128 = -437977531113424834577219 bsr -9. +57529768662798 = 57529743235679 + 25427119. +57529717808560 = 57529743235679 - 25427119. +1462815627293054978801 = 57529743235679 * 25427119. +-57529743235679 = -(57529743235679). +57529743235679 = +(57529743235679). +2262534 = 57529743235679 div 25427119. +21976133 = 57529743235679 rem 25427119. +25221135 = 57529743235679 band 25427119. +57529743441663 = 57529743235679 bor 25427119. +57529718220528 = 57529743235679 bxor 25427119. +-57529743235680 = bnot(57529743235679). +0 = 57529743235679 bsl -653. +2150203697232589654792902726688504035787373753317740472616158352025532118481145934218614454598229143742728790729735919344159937791585638765207158020340521212411106021591913143080783578332048708490009799261421568 = 57529743235679 bsr -653. +-48168881458034390938 = -48168881457472155651 + -562235287. +-48168881456909920364 = -48168881457472155651 - -562235287. +27082244890710835726948656837 = -48168881457472155651 * -562235287. +48168881457472155651 = -(-48168881457472155651). +-48168881457472155651 = +(-48168881457472155651). +85673885242 = -48168881457472155651 div -562235287. +-31221197 = -48168881457472155651 rem -562235287. +-48168881458025805719 = -48168881457472155651 band -562235287. +-8585219 = -48168881457472155651 bor -562235287. +48168881458017220500 = -48168881457472155651 bxor -562235287. +48168881457472155650 = bnot(-48168881457472155651). +-1 = -48168881457472155651 bsl -581. +-381236121260383005492774074595693584190866122338627672539864171434414087748651811581315483199933807980438282682217386828359838278877913308263353248432527750572413075499014900574630363563558961152 = -48168881457472155651 bsr -581. +739882768287751160101 = 739786335162219961386 + 96433125531198715. +739689902036688762671 = 739786335162219961386 - 96433125531198715. +71339908524963803426561871285592818990 = 739786335162219961386 * 96433125531198715. +-739786335162219961386 = -(739786335162219961386). +739786335162219961386 = +(739786335162219961386). +7671 = 739786335162219961386 div 96433125531198715. +47829212394618621 = 739786335162219961386 rem 96433125531198715. +4512679860372522 = 739786335162219961386 band 96433125531198715. +739878255607890787579 = 739786335162219961386 bor 96433125531198715. +739873742928030415057 = 739786335162219961386 bxor 96433125531198715. +-739786335162219961387 = bnot(739786335162219961386). +0 = 739786335162219961386 bsl -833. +42373339545823064452953060540077710062123552824101456154188513062975916538654414695114452913159036766478308994464946252072164053125988212949097361157966884473506561283361047162159722712646669544255918471902633142986531002304367793320129801334124644819367270027037362880512 = 739786335162219961386 bsr -833. +-625353 = -37665 + -587688. +550023 = -37665 - -587688. +22135268520 = -37665 * -587688. +37665 = -(-37665). +-37665 = +(-37665). +0 = -37665 div -587688. +-37665 = -37665 rem -587688. +-587688 = -37665 band -587688. +-37665 = -37665 bor -587688. +550023 = -37665 bxor -587688. +37664 = bnot(-37665). +-74 = -37665 bsl -9. +-19284480 = -37665 bsr -9. +-26738861699899329205016202072 = -26738861699899323541179316717 + -5663836885355. +-26738861699899317877342431362 = -26738861699899323541179316717 - -5663836885355. +151444551168295885362544490277960363979535 = -26738861699899323541179316717 * -5663836885355. +26738861699899323541179316717 = -(-26738861699899323541179316717). +-26738861699899323541179316717 = +(-26738861699899323541179316717). +4720980183775786 = -26738861699899323541179316717 div -5663836885355. +-259272302687 = -26738861699899323541179316717 rem -5663836885355. +-26738861699899324806125844975 = -26738861699899323541179316717 band -5663836885355. +-4398890357097 = -26738861699899323541179316717 bor -5663836885355. +26738861699899320407235487878 = -26738861699899323541179316717 bxor -5663836885355. +26738861699899323541179316716 = bnot(-26738861699899323541179316717). +-21764540494837285653113708660260658306913102977080703667325446600276054925599603068742626374079187394458447357144933268540651762235834868524509702008202349633834638069722456773697396880298420647631419469270408138078722014103016323178222961281900930669016503419928576 = -26738861699899323541179316717 bsl 787. +-1 = -26738861699899323541179316717 bsr 787. +-64769727830985007813 = -53446138352252 + -64769674384846655561. +64769620938708303309 = -53446138352252 - -64769674384846655561. +3461688978202826803362677532673372 = -53446138352252 * -64769674384846655561. +53446138352252 = -(-53446138352252). +-53446138352252 = +(-53446138352252). +0 = -53446138352252 div -64769674384846655561. +-53446138352252 = -53446138352252 rem -64769674384846655561. +-64769709619149263484 = -53446138352252 band -64769674384846655561. +-18211835744329 = -53446138352252 bor -64769674384846655561. +64769691407313519155 = -53446138352252 bxor -64769674384846655561. +53446138352251 = bnot(-53446138352252). +-459098832640827335901184 = -53446138352252 bsl 33. +-6222 = -53446138352252 bsr 33. +2937974356524398868985611 = 2937974356524398868985294 + 317. +2937974356524398868984977 = 2937974356524398868985294 - 317. +931337871018234441468338198 = 2937974356524398868985294 * 317. +-2937974356524398868985294 = -(2937974356524398868985294). +2937974356524398868985294 = +(2937974356524398868985294). +9268057907017031132445 = 2937974356524398868985294 div 317. +229 = 2937974356524398868985294 rem 317. +268 = 2937974356524398868985294 band 317. +2937974356524398868985343 = 2937974356524398868985294 bor 317. +2937974356524398868985075 = 2937974356524398868985294 bxor 317. +-2937974356524398868985295 = bnot(2937974356524398868985294). +12921347868425151865191655869383704576 = 2937974356524398868985294 bsl 42. +668018027800 = 2937974356524398868985294 bsr 42. +24957774184222492454005 = 741 + 24957774184222492453264. +-24957774184222492452523 = 741 - 24957774184222492453264. +18493710670508866907868624 = 741 * 24957774184222492453264. +-741 = -(741). +741 = +(741). +0 = 741 div 24957774184222492453264. +741 = 741 rem 24957774184222492453264. +128 = 741 band 24957774184222492453264. +24957774184222492453877 = 741 bor 24957774184222492453264. +24957774184222492453749 = 741 bxor 24957774184222492453264. +-742 = bnot(741). +0 = 741 bsl -291. +2948132145437215214697105967014353940115504061926677268987070455022649498290297850159955968 = 741 bsr -291. +-74144284777679928900317788815 = -8444544183 + -74144284777679928891873244632. +74144284777679928883428700449 = -8444544183 - -74144284777679928891873244632. +626114688722052491759721843930491575656 = -8444544183 * -74144284777679928891873244632. +8444544183 = -(-8444544183). +-8444544183 = +(-8444544183). +0 = -8444544183 div -74144284777679928891873244632. +-8444544183 = -8444544183 rem -74144284777679928891873244632. +-74144284777679928895217186296 = -8444544183 band -74144284777679928891873244632. +-5100602519 = -8444544183 bor -74144284777679928891873244632. +74144284777679928890116583777 = -8444544183 bxor -74144284777679928891873244632. +8444544182 = bnot(-8444544183). +-1055568023 = -8444544183 bsl -3. +-67556353464 = -8444544183 bsr -3. +191999140043763205552 = -26334813434414254169 + 218333953478177459721. +-244668766912591713890 = -26334813434414254169 - 218333953478177459721. +-5749783931245884542559171755125253826849 = -26334813434414254169 * 218333953478177459721. +26334813434414254169 = -(-26334813434414254169). +-26334813434414254169 = +(-26334813434414254169). +0 = -26334813434414254169 div 218333953478177459721. +-26334813434414254169 = -26334813434414254169 rem 218333953478177459721. +194881452636271019521 = -26334813434414254169 band 218333953478177459721. +-2882312592507813969 = -26334813434414254169 bor 218333953478177459721. +-197763765228778833490 = -26334813434414254169 bxor 218333953478177459721. +26334813434414254168 = bnot(-26334813434414254169). +-105339253737657016676 = -26334813434414254169 bsl 2. +-6583703358603563543 = -26334813434414254169 bsr 2. +97077970270216582312757580721 = 96665975928744285133262424376 + 411994341472297179495156345. +96253981587271987953767268031 = 96665975928744285133262424376 - 411994341472297179495156345. +39825835095539932495287151918398938981709695283859065720 = 96665975928744285133262424376 * 411994341472297179495156345. +-96665975928744285133262424376 = -(96665975928744285133262424376). +96665975928744285133262424376 = +(96665975928744285133262424376). +234 = 96665975928744285133262424376 div 411994341472297179495156345. +259300024226745131395839646 = 96665975928744285133262424376 rem 411994341472297179495156345. +96752176571981774075594808 = 96665975928744285133262424376 band 411994341472297179495156345. +96981218093644600538681985913 = 96665975928744285133262424376 bor 411994341472297179495156345. +96884465917072618764606391105 = 96665975928744285133262424376 bxor 411994341472297179495156345. +-96665975928744285133262424377 = bnot(96665975928744285133262424376). +6186622459439634248528795160064 = 96665975928744285133262424376 bsl 6. +1510405873886629455207225380 = 96665975928744285133262424376 bsr 6. +669655565377865995388648200720 = 669655565377865995339383557353 + 49264643367. +669655565377865995290118913986 = 669655565377865995339383557353 - 49264643367. +32990342607067320855911215082619335527551 = 669655565377865995339383557353 * 49264643367. +-669655565377865995339383557353 = -(669655565377865995339383557353). +669655565377865995339383557353 = +(669655565377865995339383557353). +13593025740371762130 = 669655565377865995339383557353 div 49264643367. +7577265643 = 669655565377865995339383557353 rem 49264643367. +48593423393 = 669655565377865995339383557353 band 49264643367. +669655565377865995340054777327 = 669655565377865995339383557353 bor 49264643367. +669655565377865995291461353934 = 669655565377865995339383557353 bxor 49264643367. +-669655565377865995339383557354 = bnot(669655565377865995339383557353). +0 = 669655565377865995339383557353 bsl -788. +1090154534911603833409211258660596520018679181593386620841863895484444978620280882365041667806860194849327859281038497075397363173136686064640477233061715543249397573262429774489673948938528155747849665389296215168513071882659601605167905661417721061215192707412000768 = 669655565377865995339383557353 bsr -788. +62680198872129 = 84249394156647 + -21569195284518. +105818589441165 = 84249394156647 - -21569195284518. +-1817191635167048815825891146 = 84249394156647 * -21569195284518. +-84249394156647 = -(84249394156647). +84249394156647 = +(84249394156647). +-3 = 84249394156647 div -21569195284518. +19541808303093 = 84249394156647 rem -21569195284518. +83571591480386 = 84249394156647 band -21569195284518. +-20891392608257 = 84249394156647 bor -21569195284518. +-104462984088643 = 84249394156647 bxor -21569195284518. +-84249394156648 = bnot(84249394156647). +0 = 84249394156647 bsl -385. +6639190301205371846453424945009347141230397653878083794429127533671990806472252090083489931149828497016074919504445953734191611904 = 84249394156647 bsr -385. +8112728482719164532 = 8112728482719164141 + 391. +8112728482719163750 = 8112728482719164141 - 391. +3172076836743193179131 = 8112728482719164141 * 391. +-8112728482719164141 = -(8112728482719164141). +8112728482719164141 = +(8112728482719164141). +20748666196212696 = 8112728482719164141 div 391. +5 = 8112728482719164141 rem 391. +133 = 8112728482719164141 band 391. +8112728482719164399 = 8112728482719164141 bor 391. +8112728482719164266 = 8112728482719164141 bxor 391. +-8112728482719164142 = bnot(8112728482719164141). +63380691271243469 = 8112728482719164141 bsl -7. +1038429245788053010048 = 8112728482719164141 bsr -7. +-667126619869642686 = -667126619869638824 + -3862. +-667126619869634962 = -667126619869638824 - -3862. +2576443005936545138288 = -667126619869638824 * -3862. +667126619869638824 = -(-667126619869638824). +-667126619869638824 = +(-667126619869638824). +172741227309590 = -667126619869638824 div -3862. +-2244 = -667126619869638824 rem -3862. +-667126619869642680 = -667126619869638824 band -3862. +-6 = -667126619869638824 bor -3862. +667126619869642674 = -667126619869638824 bxor -3862. +667126619869638823 = bnot(-667126619869638824). +-5211926717731554 = -667126619869638824 bsl -7. +-85392207343313769472 = -667126619869638824 bsr -7. +-426557362126 = 661597599 + -427218959725. +427880557324 = 661597599 - -427218959725. +-282647038001337700275 = 661597599 * -427218959725. +-661597599 = -(661597599). +661597599 = +(661597599). +0 = 661597599 div -427218959725. +661597599 = 661597599 rem -427218959725. +121897107 = 661597599 band -427218959725. +-426679259233 = 661597599 bor -427218959725. +-426801156340 = 661597599 bxor -427218959725. +-661597600 = bnot(661597599). +42342246336 = 661597599 bsl 6. +10337462 = 661597599 bsr 6. +-6867177441679752363 = 5 + -6867177441679752368. +6867177441679752373 = 5 - -6867177441679752368. +-34335887208398761840 = 5 * -6867177441679752368. +-5 = -(5). +5 = +(5). +0 = 5 div -6867177441679752368. +5 = 5 rem -6867177441679752368. +0 = 5 band -6867177441679752368. +-6867177441679752363 = 5 bor -6867177441679752368. +-6867177441679752363 = 5 bxor -6867177441679752368. +-6 = bnot(5). +2156795733372051183573361206961570453890971553803245798488288819937280 = 5 bsl 228. +0 = 5 bsr 228. +3827466834441551602834674714 = -3685667364298319745 + 3827466838127218967132994459. +-3827466841812886331431314204 = -3685667364298319745 - 3827466838127218967132994459. +-14106769613219570758389934564963414364095292955 = -3685667364298319745 * 3827466838127218967132994459. +3685667364298319745 = -(-3685667364298319745). +-3685667364298319745 = +(-3685667364298319745). +0 = -3685667364298319745 div 3827466838127218967132994459. +-3685667364298319745 = -3685667364298319745 rem 3827466838127218967132994459. +3827466838118178164054104091 = -3685667364298319745 band 3827466838127218967132994459. +-3676626561219429377 = -3685667364298319745 bor 3827466838127218967132994459. +-3827466841794804725273533468 = -3685667364298319745 bxor 3827466838127218967132994459. +3685667364298319744 = bnot(-3685667364298319745). +-16997140652508683198578488716537364480 = -3685667364298319745 bsl 62. +-1 = -3685667364298319745 bsr 62. +-8352846793286413624906528 = 3341361 + -8352846793286413628247889. +8352846793286413631589250 = 3341361 - -8352846793286413628247889. +-27909876514062284327295994636929 = 3341361 * -8352846793286413628247889. +-3341361 = -(3341361). +3341361 = +(3341361). +0 = 3341361 div -8352846793286413628247889. +3341361 = 3341361 rem -8352846793286413628247889. +1208353 = 3341361 band -8352846793286413628247889. +-8352846793286413626114881 = 3341361 bor -8352846793286413628247889. +-8352846793286413627323234 = 3341361 bxor -8352846793286413628247889. +-3341362 = bnot(3341361). +14695461088388972544 = 3341361 bsl 42. +0 = 3341361 bsr 42. +53092 = 53969 + -877. +54846 = 53969 - -877. +-47330813 = 53969 * -877. +-53969 = -(53969). +53969 = +(53969). +-61 = 53969 div -877. +472 = 53969 rem -877. +53393 = 53969 band -877. +-301 = 53969 bor -877. +-53694 = 53969 bxor -877. +-53970 = bnot(53969). +843 = 53969 bsl -6. +3454016 = 53969 bsr -6. +4887551645628250 = -484517 + 4887551646112767. +-4887551646597284 = -484517 - 4887551646112767. +-2368101860919619528539 = -484517 * 4887551646112767. +484517 = -(-484517). +-484517 = +(-484517). +0 = -484517 div 4887551646112767. +-484517 = -484517 rem 4887551646112767. +4887551646112603 = -484517 band 4887551646112767. +-484353 = -484517 bor 4887551646112767. +-4887551646596956 = -484517 bxor 4887551646112767. +484516 = bnot(-484517). +-7571 = -484517 bsl -6. +-31009088 = -484517 bsr -6. +9818661703 = 9818661771 + -68. +9818661839 = 9818661771 - -68. +-667669000428 = 9818661771 * -68. +-9818661771 = -(9818661771). +9818661771 = +(9818661771). +-144392084 = 9818661771 div -68. +59 = 9818661771 rem -68. +9818661768 = 9818661771 band -68. +-65 = 9818661771 bor -68. +-9818661833 = 9818661771 bxor -68. +-9818661772 = bnot(9818661771). +0 = 9818661771 bsl -71. +23183659627001955918025020407808 = 9818661771 bsr -71. +-712255146394710796767561401884 = -712255146394711532165679291249 + 735398117889365. +-712255146394712267563797180614 = -712255146394711532165679291249 - 735398117889365. +-523791094115684997786158104614938540994666885 = -712255146394711532165679291249 * 735398117889365. +712255146394711532165679291249 = -(-712255146394711532165679291249). +-712255146394711532165679291249 = +(-712255146394711532165679291249). +-968530009893042 = -712255146394711532165679291249 div 735398117889365. +-381715239992919 = -712255146394711532165679291249 rem 735398117889365. +572648593671173 = -712255146394711532165679291249 band 735398117889365. +-712255146394711369416155073057 = -712255146394711532165679291249 bor 735398117889365. +-712255146394711942064748744230 = -712255146394711532165679291249 bxor 735398117889365. +712255146394711532165679291248 = bnot(-712255146394711532165679291249). +-4713310 = -712255146394711532165679291249 bsl -77. +-107632954578745541137618349763529320349863629687881728 = -712255146394711532165679291249 bsr -77. +543191318463985309537255 = 543191317734459435141817 + 729525874395438. +543191317004933560746379 = 543191317734459435141817 - 729525874395438. +396272121034241707641659530986667830846 = 543191317734459435141817 * 729525874395438. +-543191317734459435141817 = -(543191317734459435141817). +543191317734459435141817 = +(543191317734459435141817). +744581291 = 543191317734459435141817 div 729525874395438. +359200364591359 = 543191317734459435141817 rem 729525874395438. +158380282873896 = 543191317734459435141817 band 729525874395438. +543191318305605026663359 = 543191317734459435141817 bor 729525874395438. +543191318147224743789463 = 543191317734459435141817 bxor 729525874395438. +-543191317734459435141818 = bnot(543191317734459435141817). +4556619033477828293306127220736 = 543191317734459435141817 bsl 23. +64753451077277593 = 543191317734459435141817 bsr 23. +-169 = -73 + -96. +23 = -73 - -96. +7008 = -73 * -96. +73 = -(-73). +-73 = +(-73). +0 = -73 div -96. +-73 = -73 rem -96. +-96 = -73 band -96. +-73 = -73 bor -96. +23 = -73 bxor -96. +72 = bnot(-73). +-1183260298938720648325803804880682671968392870912882397264386660419600215754462088621791463176322566339993928604003740665292367298847889052639616651915309957638540123626211700113408 = -73 bsl 592. +-1 = -73 bsr 592. +8831173783751346 = 9 + 8831173783751337. +-8831173783751328 = 9 - 8831173783751337. +79480564053762033 = 9 * 8831173783751337. +-9 = -(9). +9 = +(9). +0 = 9 div 8831173783751337. +9 = 9 rem 8831173783751337. +9 = 9 band 8831173783751337. +8831173783751337 = 9 bor 8831173783751337. +8831173783751328 = 9 bxor 8831173783751337. +-10 = bnot(9). +21250649172913403461632 = 9 bsl 71. +0 = 9 bsr 71. +811781846846508316055933 = -8115277375891 + 811781846854623593431824. +-811781846862738870807715 = -8115277375891 - 811781846854623593431824. +-6587834855938339387465949533929755184 = -8115277375891 * 811781846854623593431824. +8115277375891 = -(-8115277375891). +-8115277375891 = +(-8115277375891). +0 = -8115277375891 div 811781846854623593431824. +-8115277375891 = -8115277375891 rem 811781846854623593431824. +811781846848984164991488 = -8115277375891 band 811781846854623593431824. +-2475848935555 = -8115277375891 bor 811781846854623593431824. +-811781846851460013927043 = -8115277375891 bxor 811781846854623593431824. +8115277375890 = bnot(-8115277375891). +-1510015450930589366813802127150545214557626373979929896039337967719857490005174837056015495287940938465420445761003514563307717354269184123213736574976 = -8115277375891 bsl 456. +-1 = -8115277375891 bsr 456. +3753491446477699 = 23456 + 3753491446454243. +-3753491446430787 = 23456 - 3753491446454243. +88041895368030723808 = 23456 * 3753491446454243. +-23456 = -(23456). +23456 = +(23456). +0 = 23456 div 3753491446454243. +23456 = 23456 rem 3753491446454243. +21408 = 23456 band 3753491446454243. +3753491446456291 = 23456 bor 3753491446454243. +3753491446434883 = 23456 bxor 3753491446454243. +-23457 = bnot(23456). +0 = 23456 bsl -444. +1065545569817359701545308702363814647362438234767608276372664631998817196374241355596196080346377387112077856674786216850561725987549085696 = 23456 bsr -444. +17398133890995795 = 21932873413385293 + -4534739522389498. +26467612935774791 = 21932873413385293 - -4534739522389498. +-99459867907244142309416690852914 = 21932873413385293 * -4534739522389498. +-21932873413385293 = -(21932873413385293). +21932873413385293 = +(21932873413385293). +-4 = 21932873413385293 div -4534739522389498. +3793915323827301 = 21932873413385293 rem -4534739522389498. +21923733720815620 = 21932873413385293 band -4534739522389498. +-4525599829819825 = 21932873413385293 bor -4534739522389498. +-26449333550635445 = 21932873413385293 bxor -4534739522389498. +-21932873413385294 = bnot(21932873413385293). +0 = 21932873413385293 bsl -247. +4960260225612245530309503124020715866594788167704014792650628470837551940641670763437359104 = 21932873413385293 bsr -247. +53441059870677 = 54137324433324 + -696264562647. +54833588995971 = 54137324433324 - -696264562647. +-37693900519447081972448628 = 54137324433324 * -696264562647. +-54137324433324 = -(54137324433324). +54137324433324 = +(54137324433324). +-77 = 54137324433324 div -696264562647. +524953109505 = 54137324433324 rem -696264562647. +53999607081000 = 54137324433324 band -696264562647. +-558547210323 = 54137324433324 bor -696264562647. +-54558154291323 = 54137324433324 bxor -696264562647. +-54137324433325 = bnot(54137324433324). +1 = 54137324433324 bsl -45. +1904787766755887616589037568 = 54137324433324 bsr -45. +8257786268962687995 = 8257786268955161814 + 7526181. +8257786268947635633 = 8257786268955161814 - 7526181. +62149594119471228696452334 = 8257786268955161814 * 7526181. +-8257786268955161814 = -(8257786268955161814). +8257786268955161814 = +(8257786268955161814). +1097208035384 = 8257786268955161814 div 7526181. +773310 = 8257786268955161814 rem 7526181. +2266116 = 8257786268955161814 band 7526181. +8257786268960421879 = 8257786268955161814 bor 7526181. +8257786268958155763 = 8257786268955161814 bxor 7526181. +-8257786268955161815 = bnot(8257786268955161814). +2064446567238790453 = 8257786268955161814 bsl -2. +33031145075820647256 = 8257786268955161814 bsr -2. +6852732571801646526 = -33923148 + 6852732571835569674. +-6852732571869492822 = -33923148 - 6852732571835569674. +-232466261238798661715413752 = -33923148 * 6852732571835569674. +33923148 = -(-33923148). +-33923148 = +(-33923148). +0 = -33923148 div 6852732571835569674. +-33923148 = -33923148 rem 6852732571835569674. +6852732571835569664 = -33923148 band 6852732571835569674. +-33923138 = -33923148 bor 6852732571835569674. +-6852732571869492802 = -33923148 bxor 6852732571835569674. +33923147 = bnot(-33923148). +-21782271568400745073903219172783846555237631662776043049986741799362091680002283776431101407811523695564419536863711473859250454968134546588361401779957252264574810298924994276642619876092046681855009415287374086144 = -33923148 bsl 687. +-1 = -33923148 bsr 687. +4933596866441911751760609356 = -87768791 + 4933596866441911751848378147. +-4933596866441911751936146938 = -87768791 - 4933596866441911751848378147. +-433015832248995066188424165273010277 = -87768791 * 4933596866441911751848378147. +87768791 = -(-87768791). +-87768791 = +(-87768791). +0 = -87768791 div 4933596866441911751848378147. +-87768791 = -87768791 rem 4933596866441911751848378147. +4933596866441911751848231201 = -87768791 band 4933596866441911751848378147. +-87621845 = -87768791 bor 4933596866441911751848378147. +-4933596866441911751935853046 = -87768791 bxor 4933596866441911751848378147. +87768790 = bnot(-87768791). +-1 = -87768791 bsl -823. +-4909378852518964665397930710056376487208812040153826207402671768865531237643441262508997952270996583077595683649423749336461411177429052678292244331311794729913386285051361522165088879213446951378294299353770172247965285722703217125354394092893822599036928 = -87768791 bsr -823. +8741864586305876256 = 8741864585723676465 + 582199791. +8741864585141476674 = 8741864585723676465 - 582199791. +5089511734758626021674618815 = 8741864585723676465 * 582199791. +-8741864585723676465 = -(8741864585723676465). +8741864585723676465 = +(8741864585723676465). +15015231404 = 8741864585723676465 div 582199791. +498239901 = 8741864585723676465 rem 582199791. +580944161 = 8741864585723676465 band 582199791. +8741864585724932095 = 8741864585723676465 bor 582199791. +8741864585143987934 = 8741864585723676465 bxor 582199791. +-8741864585723676466 = bnot(8741864585723676465). +0 = 8741864585723676465 bsl -72. +41282288317406626147881407260211690864640 = 8741864585723676465 bsr -72. +-26994448456349269779196434055 = -995853541223 + -26994448456349268783342892832. +26994448456349267787489351609 = -995853541223 - -26994448456349268783342892832. +26882517088617165256418668582616183213536 = -995853541223 * -26994448456349268783342892832. +995853541223 = -(-995853541223). +-995853541223 = +(-995853541223). +0 = -995853541223 div -26994448456349268783342892832. +-995853541223 = -995853541223 rem -26994448456349268783342892832. +-26994448456349269615645245312 = -995853541223 band -26994448456349268783342892832. +-163551188743 = -995853541223 bor -26994448456349268783342892832. +26994448456349269452094056569 = -995853541223 bxor -26994448456349268783342892832. +995853541222 = bnot(-995853541223). +-1 = -995853541223 bsl -219. +-839004948739536910209664142641239584601848226954266016490647922432867223732224 = -995853541223 bsr -219. +7478630468 = -248785 + 7478879253. +-7479128038 = -248785 - 7478879253. +-1860632974957605 = -248785 * 7478879253. +248785 = -(-248785). +-248785 = +(-248785). +0 = -248785 div 7478879253. +-248785 = -248785 rem 7478879253. +7478715397 = -248785 band 7478879253. +-84929 = -248785 bor 7478879253. +-7478800326 = -248785 bxor 7478879253. +248784 = bnot(-248785). +-1 = -248785 bsl -88. +-76995228168403332922694655016960 = -248785 bsr -88. +9112624 = 9112626 + -2. +9112628 = 9112626 - -2. +-18225252 = 9112626 * -2. +-9112626 = -(9112626). +9112626 = +(9112626). +-4556313 = 9112626 div -2. +0 = 9112626 rem -2. +9112626 = 9112626 band -2. +-2 = 9112626 bor -2. +-9112628 = 9112626 bxor -2. +-9112627 = bnot(9112626). +0 = 9112626 bsl -87. +1410110573554122214116613347606528 = 9112626 bsr -87. +-9231217449626140093169195 = 7158295958 + -9231217449626147251465153. +9231217449626154409761111 = 7158295958 - -9231217449626147251465153. +-66079786557077918481275814297751574 = 7158295958 * -9231217449626147251465153. +-7158295958 = -(7158295958). +7158295958 = +(7158295958). +0 = 7158295958 div -9231217449626147251465153. +7158295958 = 7158295958 rem -9231217449626147251465153. +4431299606 = 7158295958 band -9231217449626147251465153. +-9231217449626144524468801 = 7158295958 bor -9231217449626147251465153. +-9231217449626148955768407 = 7158295958 bxor -9231217449626147251465153. +-7158295959 = bnot(7158295958). +13981046 = 7158295958 bsl -9. +3665047530496 = 7158295958 bsr -9. +733622196575874592956977683677 = 733622196575874592956977683719 + -42. +733622196575874592956977683761 = 733622196575874592956977683719 - -42. +-30812132256186732904193062716198 = 733622196575874592956977683719 * -42. +-733622196575874592956977683719 = -(733622196575874592956977683719). +733622196575874592956977683719 = +(733622196575874592956977683719). +-17467195156568442689451849612 = 733622196575874592956977683719 div -42. +15 = 733622196575874592956977683719 rem -42. +733622196575874592956977683718 = 733622196575874592956977683719 band -42. +-41 = 733622196575874592956977683719 bor -42. +-733622196575874592956977683759 = 733622196575874592956977683719 bxor -42. +-733622196575874592956977683720 = bnot(733622196575874592956977683719). +0 = 733622196575874592956977683719 bsl -982. +29986667558820548860569388339118939628021609752472298746240482499913429520272515420974508069522157046073722363662951409931227880373184804148721237710463162469842938171830741413264701323225102429378796617204756120261640476470840409010032421701834204666551977915902768691582481649109164531815901034693474889878223588005223858176 = 733622196575874592956977683719 bsr -982. +811349291315272899466 = 811349291315272899411 + 55. +811349291315272899356 = 811349291315272899411 - 55. +44624211022340009467605 = 811349291315272899411 * 55. +-811349291315272899411 = -(811349291315272899411). +811349291315272899411 = +(811349291315272899411). +14751805296641325443 = 811349291315272899411 div 55. +46 = 811349291315272899411 rem 55. +19 = 811349291315272899411 band 55. +811349291315272899447 = 811349291315272899411 bor 55. +811349291315272899428 = 811349291315272899411 bxor 55. +-811349291315272899412 = bnot(811349291315272899411). +1124801795688128809117845354257026935140522772168575758953903827993679735658665042098288387621672886911021174779684507191627912556218392869482195320832 = 811349291315272899411 bsl 429. +0 = 811349291315272899411 bsr 429. +885975861442819814306863 = 885975861442819814297548 + 9315. +885975861442819814288233 = 885975861442819814297548 - 9315. +8252865149339866570181659620 = 885975861442819814297548 * 9315. +-885975861442819814297548 = -(885975861442819814297548). +885975861442819814297548 = +(885975861442819814297548). +95112813896169598958 = 885975861442819814297548 div 9315. +3778 = 885975861442819814297548 rem 9315. +1088 = 885975861442819814297548 band 9315. +885975861442819814305775 = 885975861442819814297548 bor 9315. +885975861442819814304687 = 885975861442819814297548 bxor 9315. +-885975861442819814297549 = bnot(885975861442819814297548). +0 = 885975861442819814297548 bsl -927. +1005143040823854522478619626628497929067403976849016345635161191003470159625580516200556688949945723013240038033686213398765835282099300420928799390266566436852158165277864040471010072625095701590737584910653891758231878828261163348792412956637359318013736327093066282518636197068463689890831796424146944 = 885975861442819814297548 bsr -927. +41399875836504791656137563799 = 41399875836262823738481646965 + 241967917655916834. +41399875836020855820825730131 = 41399875836262823738481646965 - 241967917655916834. +10017441747314024011053170597295347749388508810 = 41399875836262823738481646965 * 241967917655916834. +-41399875836262823738481646965 = -(41399875836262823738481646965). +41399875836262823738481646965 = +(41399875836262823738481646965). +171096549647 = 41399875836262823738481646965 div 241967917655916834. +66041286697589367 = 41399875836262823738481646965 rem 241967917655916834. +72339653133074720 = 41399875836262823738481646965 band 241967917655916834. +41399875836432452003004489079 = 41399875836262823738481646965 bor 241967917655916834. +41399875836360112349871414359 = 41399875836262823738481646965 bxor 241967917655916834. +-41399875836262823738481646966 = bnot(41399875836262823738481646965). +71817336515 = 41399875836262823738481646965 bsl -59. +23865403569840390970934364411101718826104913920 = 41399875836262823738481646965 bsr -59. +4274843908092340195 = -4185377341 + 4274843912277717536. +-4274843916463094877 = -4185377341 - 4274843912277717536. +-17891834846758950674372751776 = -4185377341 * 4274843912277717536. +4185377341 = -(-4185377341). +-4185377341 = +(-4185377341). +0 = -4185377341 div 4274843912277717536. +-4185377341 = -4185377341 rem 4274843912277717536. +4274843909710426112 = -4185377341 band 4274843912277717536. +-1618085917 = -4185377341 bor 4274843912277717536. +-4274843911328512029 = -4185377341 bxor 4274843912277717536. +4185377340 = bnot(-4185377341). +-1295311547485420108782786396968452096 = -4185377341 bsl 88. +-1 = -4185377341 bsr 88. +-6242811754787962 = -6242811754788576 + 614. +-6242811754789190 = -6242811754788576 - 614. +-3833086417440185664 = -6242811754788576 * 614. +6242811754788576 = -(-6242811754788576). +-6242811754788576 = +(-6242811754788576). +-10167445854704 = -6242811754788576 div 614. +-320 = -6242811754788576 rem 614. +32 = -6242811754788576 band 614. +-6242811754787994 = -6242811754788576 bor 614. +-6242811754788026 = -6242811754788576 bxor 614. +6242811754788575 = bnot(-6242811754788576). +-97543933668572 = -6242811754788576 bsl -6. +-399539952306468864 = -6242811754788576 bsr -6. +-7538171139905556212306216 = -7629586458271768482155827 + 91415318366212269849611. +-7721001776637980752005438 = -7629586458271768482155827 - 91415318366212269849611. +-697461075085455621116210985649692909134357333297 = -7629586458271768482155827 * 91415318366212269849611. +7629586458271768482155827 = -(-7629586458271768482155827). +-7629586458271768482155827 = +(-7629586458271768482155827). +-83 = -7629586458271768482155827 div 91415318366212269849611. +-42115033876150084638114 = -7629586458271768482155827 rem 91415318366212269849611. +77236661554355152924681 = -7629586458271768482155827 band 91415318366212269849611. +-7615407801459911365230897 = -7629586458271768482155827 bor 91415318366212269849611. +-7692644463014266518155578 = -7629586458271768482155827 bxor 91415318366212269849611. +7629586458271768482155826 = bnot(-7629586458271768482155827). +-3469534230259 = -7629586458271768482155827 bsl -41. +-16777638051984237727202732308906901504 = -7629586458271768482155827 bsr -41. +-4267121652459075945934652272 = -4267121648737814333378672448 + -3721261612555979824. +-4267121645016552720822692624 = -4267121648737814333378672448 - -3721261612555979824. +15879075987554610274837263875481017808992689152 = -4267121648737814333378672448 * -3721261612555979824. +4267121648737814333378672448 = -(-4267121648737814333378672448). +-4267121648737814333378672448 = +(-4267121648737814333378672448). +1146686821 = -4267121648737814333378672448 div -3721261612555979824. +-126664144455972944 = -4267121648737814333378672448 rem -3721261612555979824. +-4267121651089823294832672576 = -4267121648737814333378672448 band -3721261612555979824. +-1369252651101979696 = -4267121648737814333378672448 bor -3721261612555979824. +4267121649720570643730692880 = -4267121648737814333378672448 bxor -3721261612555979824. +4267121648737814333378672447 = bnot(-4267121648737814333378672448). +-1 = -4267121648737814333378672448 bsl -651. +-39871465739338534063342663826501196000324697659784107528606747974331669942608986453404016148280232658289099588827686503977278355928542987546437376620656531497244946319740519491056964833008916902911927004689951702106037551104 = -4267121648737814333378672448 bsr -651. +-4036400470114176 = -4273587136568859 + 237186666454683. +-4510773803023542 = -4273587136568859 - 237186666454683. +-1013637886726381765650632516697 = -4273587136568859 * 237186666454683. +4273587136568859 = -(-4273587136568859). +-4273587136568859 = +(-4273587136568859). +-18 = -4273587136568859 div 237186666454683. +-4227140384565 = -4273587136568859 rem 237186666454683. +230005444362369 = -4273587136568859 band 237186666454683. +-4266405914476545 = -4273587136568859 bor 237186666454683. +-4496411358838914 = -4273587136568859 bxor 237186666454683. +4273587136568858 = bnot(-4273587136568859). +-1 = -4273587136568859 bsl -92. +-21161778510934196433939532476604893483761664 = -4273587136568859 bsr -92. +-91484855776220637360611 = 596954114912 + -91484855776817591475523. +91484855777414545590435 = 596954114912 - -91484855776817591475523. +-54612261108102115527342428577298976 = 596954114912 * -91484855776817591475523. +-596954114912 = -(596954114912). +596954114912 = +(596954114912). +0 = 596954114912 div -91484855776817591475523. +596954114912 = 596954114912 rem -91484855776817591475523. +558882628128 = 596954114912 band -91484855776817591475523. +-91484855776779519988739 = 596954114912 bor -91484855776817591475523. +-91484855777338402616867 = 596954114912 bxor -91484855776817591475523. +-596954114913 = bnot(596954114912). +2503807031991861248 = 596954114912 bsl 22. +142324 = 596954114912 bsr 22. +65569748663986084 = -4498113 + 65569748668484197. +-65569748672982310 = -4498113 - 65569748668484197. +-294940138892441456820261 = -4498113 * 65569748668484197. +4498113 = -(-4498113). +-4498113 = +(-4498113). +0 = -4498113 div 65569748668484197. +-4498113 = -4498113 rem 65569748668484197. +65569748663994405 = -4498113 band 65569748668484197. +-8321 = -4498113 bor 65569748668484197. +-65569748664002726 = -4498113 bxor 65569748668484197. +4498112 = bnot(-4498113). +-178188613885762551182954379538857984 = -4498113 bsl 95. +-1 = -4498113 bsr 95. +-777223525640658 = -777223525611319 + -29339. +-777223525581980 = -777223525611319 - -29339. +22802961017910488141 = -777223525611319 * -29339. +777223525611319 = -(-777223525611319). +-777223525611319 = +(-777223525611319). +26491138948 = -777223525611319 div -29339. +-15947 = -777223525611319 rem -29339. +-777223525627839 = -777223525611319 band -29339. +-12819 = -777223525611319 bor -29339. +777223525615020 = -777223525611319 bxor -29339. +777223525611318 = bnot(-777223525611319). +-198969222556497664 = -777223525611319 bsl 8. +-3036029396920 = -777223525611319 bsr 8. +96417343 = 97244955 + -827612. +98072567 = 97244955 - -827612. +-80481091697460 = 97244955 * -827612. +-97244955 = -(97244955). +97244955 = +(97244955). +-117 = 97244955 div -827612. +414351 = 97244955 rem -827612. +96687872 = 97244955 band -827612. +-270529 = 97244955 bor -827612. +-96958401 = 97244955 bxor -827612. +-97244956 = bnot(97244955). +0 = 97244955 bsl -881. +1567809384369929985858068741727183110280701137458891778377229107393402021905611996672699880982016244270146370873154137628391215170843459394808333944286332041143039007815016768028549464218926813385360539034073368739559839619975355452669118002097778858629874794621716041564160 = 97244955 bsr -881. +3198551991723789764315794183 = 3198551987886863514642434571 + 3836926249673359612. +3198551984049937264969074959 = 3198551987886863514642434571 - 3836926249673359612. +12272608083268012387137280170851540240463946452 = 3198551987886863514642434571 * 3836926249673359612. +-3198551987886863514642434571 = -(3198551987886863514642434571). +3198551987886863514642434571 = +(3198551987886863514642434571). +833623525 = 3198551987886863514642434571 div 3836926249673359612. +2469127376294362271 = 3198551987886863514642434571 rem 3836926249673359612. +3758253958181683208 = 3198551987886863514642434571 band 3836926249673359612. +3198551987965535806134110975 = 3198551987886863514642434571 bor 3836926249673359612. +3198551984207281847952427767 = 3198551987886863514642434571 bxor 3836926249673359612. +-3198551987886863514642434572 = bnot(3198551987886863514642434571). +173393850 = 3198551987886863514642434571 bsl -64. +59002869927003905065155415068870526795027316736 = 3198551987886863514642434571 bsr -64. +-439573608517099225018102502 = 47624424382333611295892 + -439621232941481558629398394. +439668857365863892240694286 = 47624424382333611295892 - -439621232941481558629398394. +-20936708165089858529216529838982016081590683597448 = 47624424382333611295892 * -439621232941481558629398394. +-47624424382333611295892 = -(47624424382333611295892). +47624424382333611295892 = +(47624424382333611295892). +0 = 47624424382333611295892 div -439621232941481558629398394. +47624424382333611295892 = 47624424382333611295892 rem -439621232941481558629398394. +47614587867083402395780 = 47624424382333611295892 band -439621232941481558629398394. +-439621223104966308420498282 = 47624424382333611295892 bor -439621232941481558629398394. +-439668837692833391822894062 = 47624424382333611295892 bxor -439621232941481558629398394. +-47624424382333611295893 = bnot(47624424382333611295892). +5953053047791701411986 = 47624424382333611295892 bsl -3. +380995395058668890367136 = 47624424382333611295892 bsr -3. +-89689944725641365990750893772 = -89688946256488841397951674395 + -998469152524592799219377. +-89687947787336316805152455018 = -89688946256488841397951674395 - -998469152524592799219377. +89551646159540163343803048054284057336968126078751915 = -89688946256488841397951674395 * -998469152524592799219377. +89688946256488841397951674395 = -(-89688946256488841397951674395). +-89688946256488841397951674395 = +(-89688946256488841397951674395). +89826 = -89688946256488841397951674395 div -998469152524592799219377. +-456161814768615271915993 = -89688946256488841397951674395 rem -998469152524592799219377. +-89688957491206761847796203195 = -89688946256488841397951674395 band -998469152524592799219377. +-987234434604142954690577 = -89688946256488841397951674395 bor -998469152524592799219377. +89687970256772157704841512618 = -89688946256488841397951674395 bxor -998469152524592799219377. +89688946256488841397951674394 = bnot(-89688946256488841397951674395). +-1577824628671779641725474254499699039928320 = -89688946256488841397951674395 bsl 44. +-5098226339242095 = -89688946256488841397951674395 bsr 44. +-107944578653 = -7956649228 + -99987929425. +92031280197 = -7956649228 - -99987929425. +795568881468744733900 = -7956649228 * -99987929425. +7956649228 = -(-7956649228). +-7956649228 = +(-7956649228). +0 = -7956649228 div -99987929425. +-7956649228 = -7956649228 rem -99987929425. +-102542277980 = -7956649228 band -99987929425. +-5402300673 = -7956649228 bor -99987929425. +97139977307 = -7956649228 bxor -99987929425. +7956649227 = bnot(-7956649228). +-124322645 = -7956649228 bsl -6. +-509225550592 = -7956649228 bsr -6. +-51547258647535796118556002179 = -51547258555743582681958687423 + -91792213436597314756. +-51547258463951369245361372667 = -51547258555743582681958687423 - -91792213436597314756. +4731636959420281983396358032954664794408149513788 = -51547258555743582681958687423 * -91792213436597314756. +51547258555743582681958687423 = -(-51547258555743582681958687423). +-51547258555743582681958687423 = +(-51547258555743582681958687423). +561564610 = -51547258555743582681958687423 div -91792213436597314756. +-16184051893958302263 = -51547258555743582681958687423 rem -91792213436597314756. +-51547258563298109923031492352 = -51547258555743582681958687423 band -91792213436597314756. +-84237686195524509827 = -51547258555743582681958687423 bor -91792213436597314756. +51547258479060423727506982525 = -51547258555743582681958687423 bxor -91792213436597314756. +51547258555743582681958687422 = bnot(-51547258555743582681958687423). +-206189034222974330727834749692 = -51547258555743582681958687423 bsl 2. +-12886814638935895670489671856 = -51547258555743582681958687423 bsr 2. +-224891864892188194404827 = -75871363 + -224891864892188118533464. +224891864892188042662101 = -75871363 - -224891864892188118533464. +17062852316982160605539474791432 = -75871363 * -224891864892188118533464. +75871363 = -(-75871363). +-75871363 = +(-75871363). +0 = -75871363 div -224891864892188118533464. +-75871363 = -75871363 rem -224891864892188118533464. +-224891864892188118611416 = -75871363 band -224891864892188118533464. +-75793411 = -75871363 bor -224891864892188118533464. +224891864892188042818005 = -75871363 bxor -224891864892188118533464. +75871362 = bnot(-75871363). +-14456257168929956743916818538905745587330375758255603855674002658551814160518532039738027833047217492154099127703139584735390894188138005134344978432 = -75871363 bsl 466. +-1 = -75871363 bsr 466. +-92626589181922614192054168450 = -92626589178671292863737413479 + -3251321328316754971. +-92626589175419971535420658508 = -92626589178671292863737413479 - -3251321328316754971. +301158804965847909758322589425413031470155654109 = -92626589178671292863737413479 * -3251321328316754971. +92626589178671292863737413479 = -(-92626589178671292863737413479). +-92626589178671292863737413479 = +(-92626589178671292863737413479). +28488906455 = -92626589178671292863737413479 div -3251321328316754971. +-1108917885762175674 = -92626589178671292863737413479 rem -3251321328316754971. +-92626589180980516345207242623 = -92626589178671292863737413479 band -3251321328316754971. +-942097846846925827 = -92626589178671292863737413479 bor -3251321328316754971. +92626589180038418498360316796 = -92626589178671292863737413479 bxor -3251321328316754971. +92626589178671292863737413478 = bnot(-92626589178671292863737413479). +-21566308377932592497 = -92626589178671292863737413479 bsl -32. +-397828171262420703583790375223934582784 = -92626589178671292863737413479 bsr -32. +81117343425000610841 = 81117343429423544534 + -4422933693. +81117343433846478227 = 81117343429423544534 - -4422933693. +-358776631340649562686914584062 = 81117343429423544534 * -4422933693. +-81117343429423544534 = -(81117343429423544534). +81117343429423544534 = +(81117343429423544534). +-18340167196 = 81117343429423544534 div -4422933693. +2981809706 = 81117343429423544534 rem -4422933693. +81117343429387886658 = 81117343429423544534 band -4422933693. +-4387275817 = 81117343429423544534 bor -4422933693. +-81117343433775162475 = 81117343429423544534 bxor -4422933693. +-81117343429423544535 = bnot(81117343429423544534). +0 = 81117343429423544534 bsl -75. +3064526590324287910001030154146913621901312 = 81117343429423544534 bsr -75. +2289828191515276228 = 897 + 2289828191515275331. +-2289828191515274434 = 897 - 2289828191515275331. +2053975887789201971907 = 897 * 2289828191515275331. +-897 = -(897). +897 = +(897). +0 = 897 div 2289828191515275331. +897 = 897 rem 2289828191515275331. +1 = 897 band 2289828191515275331. +2289828191515276227 = 897 bor 2289828191515275331. +2289828191515276226 = 897 bxor 2289828191515275331. +-898 = bnot(897). +0 = 897 bsl -77. +135550807524290296213929984 = 897 bsr -77. +9192773900209659062759187325 = 8917952238734891769776674856 + 274821661474767292982512469. +8643130577260124476794162387 = 8917952238734891769776674856 - 274821661474767292982512469. +2450846451201743538156756726936311131318670343378779464 = 8917952238734891769776674856 * 274821661474767292982512469. +-8917952238734891769776674856 = -(8917952238734891769776674856). +8917952238734891769776674856 = +(8917952238734891769776674856). +32 = 8917952238734891769776674856 div 274821661474767292982512469. +123659071542338394336275848 = 8917952238734891769776674856 rem 274821661474767292982512469. +232424254142200712549107712 = 8917952238734891769776674856 band 274821661474767292982512469. +8960349646067458350210079613 = 8917952238734891769776674856 bor 274821661474767292982512469. +8727925391925257637660971901 = 8917952238734891769776674856 bxor 274821661474767292982512469. +-8917952238734891769776674857 = bnot(8917952238734891769776674856). +0 = 8917952238734891769776674856 bsl -584. +564654261126213671114483452323326413544879874913914808333671107414843491072816921551217451075660814076529724813634685375060836733551015518497888460292811462963241339175888195957918257118982987786271850496 = 8917952238734891769776674856 bsr -584. +584763 = 427 + 584336. +-583909 = 427 - 584336. +249511472 = 427 * 584336. +-427 = -(427). +427 = +(427). +0 = 427 div 584336. +427 = 427 rem 584336. +128 = 427 band 584336. +584635 = 427 bor 584336. +584507 = 427 bxor 584336. +-428 = bnot(427). +4228803174198859019055408349184 = 427 bsl 93. +0 = 427 bsr 93. +2873569340219161220 = 7391242189536 + 2873561948976971684. +-2873554557734782148 = 7391242189536 - 2873561948976971684. +21239192311523887704890833098624 = 7391242189536 * 2873561948976971684. +-7391242189536 = -(7391242189536). +7391242189536 = +(7391242189536). +0 = 7391242189536 div 2873561948976971684. +7391242189536 = 7391242189536 rem 2873561948976971684. +103756167840 = 7391242189536 band 2873561948976971684. +2873569236462993380 = 7391242189536 bor 2873561948976971684. +2873569132706825540 = 7391242189536 bxor 2873561948976971684. +-7391242189537 = bnot(7391242189536). +17043044132146902307495080886272 = 7391242189536 bsl 61. +0 = 7391242189536 bsr 61. +73238685419183094543 = -3683395 + 73238685419186777938. +-73238685419190461333 = -3683395 - 73238685419186777938. +-269767007679605481922939510 = -3683395 * 73238685419186777938. +3683395 = -(-3683395). +-3683395 = +(-3683395). +0 = -3683395 div 73238685419186777938. +-3683395 = -3683395 rem 73238685419186777938. +73238685419183622928 = -3683395 band 73238685419186777938. +-528385 = -3683395 bor 73238685419186777938. +-73238685419184151313 = -3683395 bxor 73238685419186777938. +3683394 = bnot(-3683395). +-1 = -3683395 bsl -844. +-432080467963048262555853318747661237135491073876285524679401425413095676321779140263983609193746870415010306742107002773190381670106317989361810254628326460421320780438073712482013284075623886968942998082030670994745774987273376488656463788581076528831733432320 = -3683395 bsr -844. +92722951385418647291709 = 558134 + 92722951385418646733575. +-92722951385418646175441 = 558134 - 92722951385418646733575. +51751831748549250975997149050 = 558134 * 92722951385418646733575. +-558134 = -(558134). +558134 = +(558134). +0 = 558134 div 92722951385418646733575. +558134 = 558134 rem 92722951385418646733575. +32774 = 558134 band 92722951385418646733575. +92722951385418647258935 = 558134 bor 92722951385418646733575. +92722951385418647226161 = 558134 bxor 92722951385418646733575. +-558135 = bnot(558134). +321742345526118965051392 = 558134 bsl 59. +0 = 558134 bsr 59. +-63546419921881191 = -497245399 + -63546419424635792. +63546418927390393 = -497245399 - -63546419424635792. +31598164681824374822721008 = -497245399 * -63546419424635792. +497245399 = -(-497245399). +-497245399 = +(-497245399). +0 = -497245399 div -63546419424635792. +-497245399 = -497245399 rem -63546419424635792. +-63546419443662816 = -497245399 band -63546419424635792. +-478218375 = -497245399 bor -63546419424635792. +63546418965444441 = -497245399 bxor -63546419424635792. +497245398 = bnot(-497245399). +-1942365 = -497245399 bsl -8. +-127294822144 = -497245399 bsr -8. +-35008318338433879811771391803 = -34379533892997313329548513238 + -628784445436566482222878565. +-33750749447560746847325634673 = -34379533892997313329548513238 - -628784445436566482222878565. +21617316153275957220539326692103788726389233444368943470 = -34379533892997313329548513238 * -628784445436566482222878565. +34379533892997313329548513238 = -(-34379533892997313329548513238). +-34379533892997313329548513238 = +(-34379533892997313329548513238). +54 = -34379533892997313329548513238 div -628784445436566482222878565. +-425173839422723289513070728 = -34379533892997313329548513238 rem -628784445436566482222878565. +-34389252543110051313847685110 = -34379533892997313329548513238 band -628784445436566482222878565. +-619065795323828497923706693 = -34379533892997313329548513238 bor -628784445436566482222878565. +33770186747786222815923978417 = -34379533892997313329548513238 bxor -628784445436566482222878565. +34379533892997313329548513237 = bnot(-34379533892997313329548513238). +-8196719620942428905857 = -34379533892997313329548513238 bsl -22. +-144198216525534203287378647268196352 = -34379533892997313329548513238 bsr -22. +-94420 = 545 + -94965. +95510 = 545 - -94965. +-51755925 = 545 * -94965. +-545 = -(545). +545 = +(545). +0 = 545 div -94965. +545 = 545 rem -94965. +1 = 545 band -94965. +-94421 = 545 bor -94965. +-94422 = 545 bxor -94965. +-546 = bnot(545). +0 = 545 bsl -44. +9587741394206720 = 545 bsr -44. +2795644593395452536265 = 2795644593395373913827 + 78622438. +2795644593395295291389 = 2795644593395373913827 - 78622438. +219800393714262995026680650226 = 2795644593395373913827 * 78622438. +-2795644593395373913827 = -(2795644593395373913827). +2795644593395373913827 = +(2795644593395373913827). +35557846646721 = 2795644593395373913827 div 78622438. +44188029 = 2795644593395373913827 rem 78622438. +76490466 = 2795644593395373913827 band 78622438. +2795644593395376045799 = 2795644593395373913827 bor 78622438. +2795644593395299555333 = 2795644593395373913827 bxor 78622438. +-2795644593395373913828 = bnot(2795644593395373913827). +698911148348843478456 = 2795644593395373913827 bsl -2. +11182578373581495655308 = 2795644593395373913827 bsr -2. +-8787568974423759098778 = -8787568974423759158612 + 59834. +-8787568974423759218446 = -8787568974423759158612 - 59834. +-525795402015671205496390408 = -8787568974423759158612 * 59834. +8787568974423759158612 = -(-8787568974423759158612). +-8787568974423759158612 = +(-8787568974423759158612). +-146865811652634942 = -8787568974423759158612 div 59834. +-38984 = -8787568974423759158612 rem 59834. +32936 = -8787568974423759158612 band 59834. +-8787568974423759131714 = -8787568974423759158612 bor 59834. +-8787568974423759164650 = -8787568974423759158612 bxor 59834. +8787568974423759158611 = bnot(-8787568974423759158612). +-1 = -8787568974423759158612 bsl -579. +-17387463699334606574369673082096282686305542007575594251570474477704968929224742151269560686612629435515287574348276272141023568588788324161754188375467588140470398322054786885776003241773530873856 = -8787568974423759158612 bsr -579. +-44295264476766669313925 = 2264128488185265259789 + -46559392964951934573714. +48823521453137199833503 = 2264128488185265259789 - -46559392964951934573714. +-105416448004560298652327962495129255180586346 = 2264128488185265259789 * -46559392964951934573714. +-2264128488185265259789 = -(2264128488185265259789). +2264128488185265259789 = +(2264128488185265259789). +0 = 2264128488185265259789 div -46559392964951934573714. +2264128488185265259789 = 2264128488185265259789 rem -46559392964951934573714. +590302565758291542284 = 2264128488185265259789 band -46559392964951934573714. +-44885567042524960856209 = 2264128488185265259789 bor -46559392964951934573714. +-45475869608283252398493 = 2264128488185265259789 bxor -46559392964951934573714. +-2264128488185265259790 = bnot(2264128488185265259789). +35377007627894769684 = 2264128488185265259789 bsl -6. +144904223243856976626496 = 2264128488185265259789 bsr -6. +-61546169223333011082 = -61546169215361312324 + -7971698758. +-61546169207389613566 = -61546169215361312324 - -7971698758. +490627520693753607974480893592 = -61546169215361312324 * -7971698758. +61546169215361312324 = -(-61546169215361312324). +-61546169215361312324 = +(-61546169215361312324). +7720583916 = -61546169215361312324 div -7971698758. +-1149335996 = -61546169215361312324 rem -7971698758. +-61546169219790896712 = -61546169215361312324 band -7971698758. +-3542114370 = -61546169215361312324 bor -7971698758. +61546169216248782342 = -61546169215361312324 bxor -7971698758. +61546169215361312323 = bnot(-61546169215361312324). +-121777909929335523574588157034445100959831387059408680082411440556553243672720190039604708970499490782835119930156702044709277648871091652309490418630295508362600151076627660779355865587239616512 = -61546169215361312324 bsl 579. +-1 = -61546169215361312324 bsr 579. +23649639883984821896606 = 23649639883984817244112 + 4652494. +23649639883984812591618 = 23649639883984817244112 - 4652494. +110029807662400058319327615328 = 23649639883984817244112 * 4652494. +-23649639883984817244112 = -(23649639883984817244112). +23649639883984817244112 = +(23649639883984817244112). +5083217707316724 = 23649639883984817244112 div 4652494. +2734456 = 23649639883984817244112 rem 4652494. +4343232 = 23649639883984817244112 band 4652494. +23649639883984817553374 = 23649639883984817244112 bor 4652494. +23649639883984813210142 = 23649639883984817244112 bxor 4652494. +-23649639883984817244113 = bnot(23649639883984817244112). +175260237560112780376561341239759785667109378118687222490628883487671117225086117574386608280067637248 = 23649639883984817244112 bsl 262. +0 = 23649639883984817244112 bsr 262. +86829374765368359338103465 = -7856119756 + 86829374765368367194223221. +-86829374765368375050342977 = -7856119756 - 86829374765368367194223221. +-682141966495338294131999335572054076 = -7856119756 * 86829374765368367194223221. +7856119756 = -(-7856119756). +-7856119756 = +(-7856119756). +0 = -7856119756 div 86829374765368367194223221. +-7856119756 = -7856119756 rem 86829374765368367194223221. +86829374765368366858510388 = -7856119756 band 86829374765368367194223221. +-7520406923 = -7856119756 bor 86829374765368367194223221. +-86829374765368374378917311 = -7856119756 bxor 86829374765368367194223221. +7856119755 = bnot(-7856119756). +-982014970 = -7856119756 bsl -3. +-62848958048 = -7856119756 bsr -3. +362130164919076 = 522657498 + 362129642261578. +-362129119604080 = 522657498 - 362129642261578. +189269772776071419011844 = 522657498 * 362129642261578. +-522657498 = -(522657498). +522657498 = +(522657498). +0 = 522657498 div 362129642261578. +522657498 = 522657498 rem 362129642261578. +2100298 = 522657498 band 362129642261578. +362130162818778 = 522657498 bor 362129642261578. +362130160718480 = 522657498 bxor 362129642261578. +-522657499 = bnot(522657498). +65332187 = 522657498 bsl -3. +4181259984 = 522657498 bsr -3. +244396629458857238594742 = 244396629458857238497869 + 96873. +244396629458857238400996 = 244396629458857238497869 - 96873. +23675434685567877265004063637 = 244396629458857238497869 * 96873. +-244396629458857238497869 = -(244396629458857238497869). +244396629458857238497869 = +(244396629458857238497869). +2522856001763724035 = 244396629458857238497869 div 96873. +55314 = 244396629458857238497869 rem 96873. +2633 = 244396629458857238497869 band 96873. +244396629458857238592109 = 244396629458857238497869 bor 96873. +244396629458857238589476 = 244396629458857238497869 bxor 96873. +-244396629458857238497870 = bnot(244396629458857238497869). +0 = 244396629458857238497869 bsl -748. +361852826053798945056603619852469940983689527163516744953429110981220955101854721603121186998792297986447974170815227941556273391909578309489775202609859011419169533779429522341079176324810902171648165179355508332095987761507345817482628118624600064 = 244396629458857238497869 bsr -748. +9425386805 = -884964 + 9426271769. +-9427156733 = -884964 - 9426271769. +-8341911169781316 = -884964 * 9426271769. +884964 = -(-884964). +-884964 = +(-884964). +0 = -884964 div 9426271769. +-884964 = -884964 rem 9426271769. +9425681944 = -884964 band 9426271769. +-295139 = -884964 bor 9426271769. +-9425977083 = -884964 bxor 9426271769. +884963 = bnot(-884964). +-1 = -884964 bsl -32. +-3800891438137344 = -884964 bsr -32. +-52275425127615427747385716 = -52275425127615134534422791 + -293212962925. +-52275425127614841321459866 = -52275425127615134534422791 - -293212962925. +15327832289832029835910596953758023675 = -52275425127615134534422791 * -293212962925. +52275425127615134534422791 = -(-52275425127615134534422791). +-52275425127615134534422791 = +(-52275425127615134534422791). +178284836407408 = -52275425127615134534422791 div -293212962925. +-122435074391 = -52275425127615134534422791 rem -293212962925. +-52275425127615135676879215 = -52275425127615134534422791 band -293212962925. +-292070506501 = -52275425127615134534422791 bor -293212962925. +52275425127614843606372714 = -52275425127615134534422791 bxor -293212962925. +52275425127615134534422790 = bnot(-52275425127615134534422791). +-102100439702373309637545 = -52275425127615134534422791 bsl -9. +-26765017665338948881624468992 = -52275425127615134534422791 bsr -9. +-5791622013186222891 = 21325272293193394 + -5812947285479416285. +5834272557772609679 = 21325272293193394 - -5812947285479416285. +-123962683688827946451651497738021290 = 21325272293193394 * -5812947285479416285. +-21325272293193394 = -(21325272293193394). +21325272293193394 = +(21325272293193394). +0 = 21325272293193394 div -5812947285479416285. +21325272293193394 = 21325272293193394 rem -5812947285479416285. +18088310044104226 = 21325272293193394 band -5812947285479416285. +-5809710323230327117 = 21325272293193394 bor -5812947285479416285. +-5827798633274431343 = 21325272293193394 bxor -5812947285479416285. +-21325272293193395 = bnot(21325272293193394). +0 = 21325272293193394 bsl -72. +100705751115445181549959465091385524224 = 21325272293193394 bsr -72. +-817650 = -817625 + -25. +-817600 = -817625 - -25. +20440625 = -817625 * -25. +817625 = -(-817625). +-817625 = +(-817625). +32705 = -817625 div -25. +0 = -817625 rem -25. +-817625 = -817625 band -25. +-25 = -817625 bor -25. +817600 = -817625 bxor -25. +817624 = bnot(-817625). +-494223986631205589484568576000 = -817625 bsl 79. +-1 = -817625 bsr 79. +-61546673668249674831 = -61546673668249682778 + 7947. +-61546673668249690725 = -61546673668249682778 - 7947. +-489111415641580229036766 = -61546673668249682778 * 7947. +61546673668249682778 = -(-61546673668249682778). +-61546673668249682778 = +(-61546673668249682778). +-7744642464860913 = -61546673668249682778 div 7947. +-7167 = -61546673668249682778 rem 7947. +7170 = -61546673668249682778 band 7947. +-61546673668249682001 = -61546673668249682778 bor 7947. +-61546673668249689171 = -61546673668249682778 bxor 7947. +61546673668249682777 = bnot(-61546673668249682778). +-12296527315240313535790507724854437742769532445677260456347466338808971349679816879668566025398914953954251685556928523433067603371295396887270529671962667521138491392 = -61546673668249682778 bsl 486. +-1 = -61546673668249682778 bsr 486. +-27965925300435250777907714 = -27965925294615931585626426 + -5819319192281288. +-27965925288796612393345138 = -27965925294615931585626426 - -5819319192281288. +162742645796863224139466778328025478116688 = -27965925294615931585626426 * -5819319192281288. +27965925294615931585626426 = -(-27965925294615931585626426). +-27965925294615931585626426 = +(-27965925294615931585626426). +4805703961 = -27965925294615931585626426 div -5819319192281288. +-1946425217844658 = -27965925294615931585626426 rem -5819319192281288. +-27965925294756682026148352 = -27965925294615931585626426 band -5819319192281288. +-5678568751759362 = -27965925294615931585626426 bor -5819319192281288. +27965925289078113274388990 = -27965925294615931585626426 bxor -5819319192281288. +27965925294615931585626425 = bnot(-27965925294615931585626426). +-15374430021472587653227382187950604288 = -27965925294615931585626426 bsl 39. +-50869721771262 = -27965925294615931585626426 bsr 39. +-331224228819562 = 2873623 + -331224231693185. +331224234566808 = 2873623 - -331224231693185. +-951813570350865359255 = 2873623 * -331224231693185. +-2873623 = -(2873623). +2873623 = +(2873623). +0 = 2873623 div -331224231693185. +2873623 = 2873623 rem -331224231693185. +4119 = 2873623 band -331224231693185. +-331224228823681 = 2873623 bor -331224231693185. +-331224228827800 = 2873623 bxor -331224231693185. +-2873624 = bnot(2873623). +0 = 2873623 bsl -34. +49368467224133632 = 2873623 bsr -34. +-8565982141776 = -8565982141871 + 95. +-8565982141966 = -8565982141871 - 95. +-813768303477745 = -8565982141871 * 95. +8565982141871 = -(-8565982141871). +-8565982141871 = +(-8565982141871). +-90168233072 = -8565982141871 div 95. +-31 = -8565982141871 rem 95. +81 = -8565982141871 band 95. +-8565982141857 = -8565982141871 bor 95. +-8565982141938 = -8565982141871 bxor 95. +8565982141870 = bnot(-8565982141871). +-1 = -8565982141871 bsl -877. +-8631442106926386804633469430411434898438751867311358071196192924586562956798386296912193704448921210697577795369113498160118240574191024547489063711324965470124352836122308377305392149641151166260838018968859937647572032501383839126081894291756559516775212532659331407556902912 = -8565982141871 bsr -877. +-672377636817477109183605829215 = -2381459636356532 + -672377636817474727723969472683. +672377636817472346264333116151 = -2381459636356532 - -672377636817474727723969472683. +1601240202469607707134531348515651407422615356 = -2381459636356532 * -672377636817474727723969472683. +2381459636356532 = -(-2381459636356532). +-2381459636356532 = +(-2381459636356532). +0 = -2381459636356532 div -672377636817474727723969472683. +-2381459636356532 = -2381459636356532 rem -672377636817474727723969472683. +-672377636817477033279646264764 = -2381459636356532 band -672377636817474727723969472683. +-75903959564451 = -2381459636356532 bor -672377636817474727723969472683. +672377636817476957375686700313 = -2381459636356532 bxor -672377636817474727723969472683. +2381459636356531 = bnot(-2381459636356532). +-1 = -2381459636356532 bsl -793. +-124059431457391911820834127222744003825780855300797096084676852440688587721933431499226186664140076792406508037832096528642693463799600994501404016585580340103134786630206913198714638849726646741120678936315390537699641011434629481596256055697334645817344 = -2381459636356532 bsr -793. +243423426533490497385 = -2752962661628964252 + 246176389195119461637. +-248929351856748425889 = -2752962661628964252 - 246176389195119461637. +-677714407628803869811252130296158400524 = -2752962661628964252 * 246176389195119461637. +2752962661628964252 = -(-2752962661628964252). +-2752962661628964252 = +(-2752962661628964252). +0 = -2752962661628964252 div 246176389195119461637. +-2752962661628964252 = -2752962661628964252 rem 246176389195119461637. +246167319718196674564 = -2752962661628964252 band 246176389195119461637. +-2743893184706177179 = -2752962661628964252 bor 246176389195119461637. +-248911212902902851743 = -2752962661628964252 bxor 246176389195119461637. +2752962661628964251 = bnot(-2752962661628964252). +-1 = -2752962661628964252 bsl -344. +-98654938348724579057088257125813202232942319359331674402848732439372762784482382719112423178289753421639095077566867832832 = -2752962661628964252 bsr -344. +59563200878650243717310553 = 387926856318447916625 + 59562812951793925269393928. +-59562425024937606821477303 = 387926856318447916625 - 59562812951793925269393928. +23106014781873150682478281572899806248025253000 = 387926856318447916625 * 59562812951793925269393928. +-387926856318447916625 = -(387926856318447916625). +387926856318447916625 = +(387926856318447916625). +0 = 387926856318447916625 div 59562812951793925269393928. +387926856318447916625 = 387926856318447916625 rem 59562812951793925269393928. +504697853253652992 = 387926856318447916625 band 59562812951793925269393928. +59563200373952390463657561 = 387926856318447916625 bor 59562812951793925269393928. +59563199869254537210004569 = 387926856318447916625 bxor 59562812951793925269393928. +-387926856318447916626 = bnot(387926856318447916625). +0 = 387926856318447916625 bsl -339. +434428568394404113651715053735778402879314662187017182623400694761038553681201573026512080787373278668453710770196185088000 = 387926856318447916625 bsr -339. +-398144453763324514738573635323 = -398144453763324514738573635261 + -62. +-398144453763324514738573635199 = -398144453763324514738573635261 - -62. +24684956133326119913791565386182 = -398144453763324514738573635261 * -62. +398144453763324514738573635261 = -(-398144453763324514738573635261). +-398144453763324514738573635261 = +(-398144453763324514738573635261). +6421684738118137334493123149 = -398144453763324514738573635261 div -62. +-23 = -398144453763324514738573635261 rem -62. +-398144453763324514738573635262 = -398144453763324514738573635261 band -62. +-61 = -398144453763324514738573635261 bor -62. +398144453763324514738573635201 = -398144453763324514738573635261 bxor -62. +398144453763324514738573635260 = bnot(-398144453763324514738573635261). +-66658626423574540504601335910866168511615294895439043499808639641139326582462538933358943305828698678104818612542582390243992313525876300514024008852709600577683640004396953447056036298558556275689987750562606287020911012956502425536525446485803440775585979670704756615591316235396069700234868591477005062590091593068392872935424 = -398144453763324514738573635261 bsl 994. +-1 = -398144453763324514738573635261 bsr 994. +-9214385556315649651785 = -23732441 + -9214385556315625919344. +9214385556315602186903 = -23732441 - -9214385556315625919344. +218679861566512769508902238704 = -23732441 * -9214385556315625919344. +23732441 = -(-23732441). +-23732441 = +(-23732441). +0 = -23732441 div -9214385556315625919344. +-23732441 = -23732441 rem -9214385556315625919344. +-9214385556315632743424 = -23732441 band -9214385556315625919344. +-16908361 = -23732441 bor -9214385556315625919344. +9214385556315615835063 = -23732441 bxor -9214385556315625919344. +23732440 = bnot(-23732441). +-189859528 = -23732441 bsl 3. +-2966556 = -23732441 bsr 3. +-5372494371976352850019706251 = -5372494272395186453391223932 + -99581166396628482319. +-5372494172814020056762741613 = -5372494272395186453391223932 - -99581166396628482319. +534999246104318529343725713325254090903031658308 = -5372494272395186453391223932 * -99581166396628482319. +5372494272395186453391223932 = -(-5372494272395186453391223932). +-5372494272395186453391223932 = +(-5372494272395186453391223932). +53950907 = -5372494272395186453391223932 div -99581166396628482319. +-25179158090247710599 = -5372494272395186453391223932 rem -99581166396628482319. +-5372494371618570459932474752 = -5372494272395186453391223932 band -99581166396628482319. +-357782390087231499 = -5372494272395186453391223932 bor -99581166396628482319. +5372494371260788069845243253 = -5372494272395186453391223932 bxor -99581166396628482319. +5372494272395186453391223931 = bnot(-5372494272395186453391223932). +-1 = -5372494272395186453391223932 bsl -854. +-645345458602619608664758166580222950342667274088042452990234746151398093692985776277122254975220509919775283657920615386043642023172791487611710501770303088256267014951620113959939334848651815055530778938513276209771519928127843414309468085959460683078343358732552273870214550507225088 = -5372494272395186453391223932 bsr -854. +-622311400235520025 = -622311491388362663 + 91152842638. +-622311582541205301 = -622311491388362663 - 91152842638. +-56725461446342513964913624994 = -622311491388362663 * 91152842638. +622311491388362663 = -(-622311491388362663). +-622311491388362663 = +(-622311491388362663). +-6827121 = -622311491388362663 div 91152842638. +-5204777465 = -622311491388362663 rem 91152842638. +86572609544 = -622311491388362663 band 91152842638. +-622311486808129569 = -622311491388362663 bor 91152842638. +-622311573380739113 = -622311491388362663 bxor 91152842638. +622311491388362662 = bnot(-622311491388362663). +-175165112545312982471309344636928 = -622311491388362663 bsl 48. +-2211 = -622311491388362663 bsr 48. +-45751395297 = -45751395299 + 2. +-45751395301 = -45751395299 - 2. +-91502790598 = -45751395299 * 2. +45751395299 = -(-45751395299). +-45751395299 = +(-45751395299). +-22875697649 = -45751395299 div 2. +-1 = -45751395299 rem 2. +0 = -45751395299 band 2. +-45751395297 = -45751395299 bor 2. +-45751395297 = -45751395299 bxor 2. +45751395298 = bnot(-45751395299). +-210991070023942822323915063296 = -45751395299 bsl 62. +-1 = -45751395299 bsr 62. +649148398141948497246 = 83997982 + 649148398141864499264. +-649148398141780501282 = 83997982 - 649148398141864499264. +54527155462449167655616485248 = 83997982 * 649148398141864499264. +-83997982 = -(83997982). +83997982 = +(83997982). +0 = 83997982 div 649148398141864499264. +83997982 = 83997982 rem 649148398141864499264. +83955712 = 83997982 band 649148398141864499264. +649148398141864541534 = 83997982 bor 649148398141864499264. +649148398141780585822 = 83997982 bxor 649148398141864499264. +-83997983 = bnot(83997982). +0 = 83997982 bsl -58. +24210769947844712341700608 = 83997982 bsr -58. +-53736505071733726558540 = -53727351395785129141971 + -9153675948597416569. +-53718197719836531725402 = -53727351395785129141971 - -9153675948597416569. +491802764253440175135261132926726228717499 = -53727351395785129141971 * -9153675948597416569. +53727351395785129141971 = -(-53727351395785129141971). +-53727351395785129141971 = +(-53727351395785129141971). +5869 = -53727351395785129141971 div -9153675948597416569. +-4427253466891298510 = -53727351395785129141971 rem -9153675948597416569. +-53735349860211478214395 = -53727351395785129141971 band -9153675948597416569. +-1155211522248344145 = -53727351395785129141971 bor -9153675948597416569. +53734194648689229870250 = -53727351395785129141971 bxor -9153675948597416569. +53727351395785129141970 = bnot(-53727351395785129141971). +-3127343451825 = -53727351395785129141971 bsl -34. +-923028868582388327631607943921664 = -53727351395785129141971 bsr -34. +96451138707169 = 96451212451614 + -73744445. +96451286196059 = 96451212451614 - -73744445. +-7112741131821363784230 = 96451212451614 * -73744445. +-96451212451614 = -(96451212451614). +96451212451614 = +(96451212451614). +-1307911 = 96451212451614 div -73744445. +41647219 = 96451212451614 rem -73744445. +96451141082882 = 96451212451614 band -73744445. +-2375713 = 96451212451614 bor -73744445. +-96451143458595 = 96451212451614 bxor -73744445. +-96451212451615 = bnot(96451212451614). +49383020775226368 = 96451212451614 bsl 9. +188381274319 = 96451212451614 bsr 9. +-57601894722972806209645 = -57667814637436523686832 + 65919914463717477187. +-57733734551900241164019 = -57667814637436523686832 - 65919914463717477187. +-3801457408209330340454544221357103092301584 = -57667814637436523686832 * 65919914463717477187. +57667814637436523686832 = -(-57667814637436523686832). +-57667814637436523686832 = +(-57667814637436523686832). +-874 = -57667814637436523686832 div 65919914463717477187. +-53809396147448625394 = -57667814637436523686832 rem 65919914463717477187. +28985752554527866944 = -57667814637436523686832 band 65919914463717477187. +-57630880475527334076589 = -57667814637436523686832 bor 65919914463717477187. +-57659866228081861943533 = -57667814637436523686832 bxor 65919914463717477187. +57667814637436523686831 = bnot(-57667814637436523686832). +-461342517099492189494656 = -57667814637436523686832 bsl 3. +-7208476829679565460854 = -57667814637436523686832 bsr 3. +5495366208771220 = 5495368997358978 + -2788587758. +5495371785946736 = 5495368997358978 - -2788587758. +-15324318711727980382191324 = 5495368997358978 * -2788587758. +-5495368997358978 = -(5495368997358978). +5495368997358978 = +(5495368997358978). +-1970663 = 5495368997358978 div -2788587758. +2280415424 = 5495368997358978 rem -2788587758. +5495368926692610 = 5495368997358978 band -2788587758. +-2717921390 = 5495368997358978 bor -2788587758. +-5495371644614000 = 5495368997358978 bxor -2788587758. +-5495368997358979 = bnot(5495368997358978). +0 = 5495368997358978 bsl -453. +127815903730368892198224471153194858502094152297957879933628492677771799528319523153257752893153933771965334340879654516057785486043490331701019647410176 = 5495368997358978 bsr -453. +-82828718716766876699 = -5674763721141391318 + -77153954995625485381. +71479191274484094063 = -5674763721141391318 - -77153954995625485381. +437830464751751117528858834313409322158 = -5674763721141391318 * -77153954995625485381. +5674763721141391318 = -(-5674763721141391318). +-5674763721141391318 = +(-5674763721141391318). +0 = -5674763721141391318 div -77153954995625485381. +-5674763721141391318 = -5674763721141391318 rem -77153954995625485381. +-81783662566975434710 = -5674763721141391318 band -77153954995625485381. +-1045056149791441989 = -5674763721141391318 bor -77153954995625485381. +80738606417183992721 = -5674763721141391318 bxor -77153954995625485381. +5674763721141391317 = bnot(-5674763721141391318). +-1452739512612196177408 = -5674763721141391318 bsl 8. +-22167045785708560 = -5674763721141391318 bsr 8. +62049501291561 = 7638117936322 + 54411383355239. +-46773265418917 = 7638117936322 - 54411383355239. +415600563145743330907090958 = 7638117936322 * 54411383355239. +-7638117936322 = -(7638117936322). +7638117936322 = +(7638117936322). +0 = 7638117936322 div 54411383355239. +7638117936322 = 7638117936322 rem 54411383355239. +481624335426 = 7638117936322 band 54411383355239. +61567876956135 = 7638117936322 bor 54411383355239. +61086252620709 = 7638117936322 bxor 54411383355239. +-7638117936323 = bnot(7638117936322). +30552471745288 = 7638117936322 bsl 2. +1909529484080 = 7638117936322 bsr 2. +718248518674927168763 = -79 + 718248518674927168842. +-718248518674927168921 = -79 - 718248518674927168842. +-56741632975319246338518 = -79 * 718248518674927168842. +79 = -(-79). +-79 = +(-79). +0 = -79 div 718248518674927168842. +-79 = -79 rem 718248518674927168842. +718248518674927168768 = -79 band 718248518674927168842. +-5 = -79 bor 718248518674927168842. +-718248518674927168773 = -79 bxor 718248518674927168842. +78 = bnot(-79). +-1 = -79 bsl -598. +-81952932485399610930620055307900432732495813086788128774914232261390393025404935891394214216705299937191908260573190586352304233739382562330765777973750782819458340617179813092786176 = -79 bsr -598. +-576591030072400 = 728492118 + -576591758564518. +576592487056636 = 728492118 - -576591758564518. +-420042551418010357469124 = 728492118 * -576591758564518. +-728492118 = -(728492118). +728492118 = +(728492118). +0 = 728492118 div -576591758564518. +728492118 = 728492118 rem -576591758564518. +17358930 = 728492118 band -576591758564518. +-576591047431330 = 728492118 bor -576591758564518. +-576591064790260 = 728492118 bxor -576591758564518. +-728492119 = bnot(728492118). +0 = 728492118 bsl -526. +160030431586239744892753319833238291175662243150891592358740153051381853076922268596681019782617022390917057017573357357693450229193093160027956764850762514123248893952 = 728492118 bsr -526. +-924392572229326523195129 = 612 + -924392572229326523195741. +924392572229326523196353 = 612 - -924392572229326523195741. +-565728254204347832195793492 = 612 * -924392572229326523195741. +-612 = -(612). +612 = +(612). +0 = 612 div -924392572229326523195741. +612 = 612 rem -924392572229326523195741. +544 = 612 band -924392572229326523195741. +-924392572229326523195673 = 612 bor -924392572229326523195741. +-924392572229326523196217 = 612 bxor -924392572229326523195741. +-613 = bnot(612). +1 = 612 bsl -9. +313344 = 612 bsr -9. +-85364771073575410040667221 = -85887184662464988616143357 + 522413588889578575476136. +-86409598251354567191619493 = -85887184662464988616143357 - 522413588889578575476136. +-44868632379140303011030046969722375335512308428552 = -85887184662464988616143357 * 522413588889578575476136. +85887184662464988616143357 = -(-85887184662464988616143357). +-85887184662464988616143357 = +(-85887184662464988616143357). +-164 = -85887184662464988616143357 div 522413588889578575476136. +-211356084574102238057053 = -85887184662464988616143357 rem 522413588889578575476136. +475188183418524194472960 = -85887184662464988616143357 band 522413588889578575476136. +-85839959256993934235140181 = -85887184662464988616143357 bor 522413588889578575476136. +-86315147440412458429613141 = -85887184662464988616143357 bxor 522413588889578575476136. +85887184662464988616143356 = bnot(-85887184662464988616143357). +-3168677829359847849991594780148158367294029824 = -85887184662464988616143357 bsl 65. +-2327977 = -85887184662464988616143357 bsr 65. +-98899404120945813 = 484548812438515 + -99383952933384328. +99868501745822843 = 484548812438515 - -99383952933384328. +-48156376369316645392401364592920 = 484548812438515 * -99383952933384328. +-484548812438515 = -(484548812438515). +484548812438515 = +(484548812438515). +0 = 484548812438515 div -99383952933384328. +484548812438515 = 484548812438515 rem -99383952933384328. +185337586387824 = 484548812438515 band -99383952933384328. +-99084741707333637 = 484548812438515 bor -99383952933384328. +-99270079293721461 = 484548812438515 bxor -99383952933384328. +-484548812438516 = bnot(484548812438515). +30679974992315889390798967663773782424471480578356502615503704551121426715147114584348015495816231245911833067790307608342690846808918881379420686041269395371370242315457964130051387807498240 = 484548812438515 bsl 584. +0 = 484548812438515 bsr 584. +968455268434 = -997599999 + 969452868433. +-970450468432 = -997599999 - 969452868433. +-967126180579307931567 = -997599999 * 969452868433. +997599999 = -(-997599999). +-997599999 = +(-997599999). +0 = -997599999 div 969452868433. +-997599999 = -997599999 rem 969452868433. +968590676225 = -997599999 band 969452868433. +-135407791 = -997599999 bor 969452868433. +-968726084016 = -997599999 bxor 969452868433. +997599998 = bnot(-997599999). +-1 = -997599999 bsl -797. +-831501398946616023867775734042959373463794138149698957311924829077443217085354064591518586508503794946699073508134886259423178510532584618756389864680235000206712394403502918001094042445318423144725184421024432250131011032561971218323577847391715328 = -997599999 bsr -797. +-39877824187112479 = 51357 + -39877824187163836. +39877824187215193 = 51357 - -39877824187163836. +-2048005416780173125452 = 51357 * -39877824187163836. +-51357 = -(51357). +51357 = +(51357). +0 = 51357 div -39877824187163836. +51357 = 51357 rem -39877824187163836. +34820 = 51357 band -39877824187163836. +-39877824187147299 = 51357 bor -39877824187163836. +-39877824187182119 = 51357 bxor -39877824187163836. +-51358 = bnot(51357). +121263287730368184619892736 = 51357 bsl 71. +0 = 51357 bsr 71. +78387 = -7 + 78394. +-78401 = -7 - 78394. +-548758 = -7 * 78394. +7 = -(-7). +-7 = +(-7). +0 = -7 div 78394. +-7 = -7 rem 78394. +78392 = -7 band 78394. +-5 = -7 bor 78394. +-78397 = -7 bxor 78394. +6 = bnot(-7). +-1 = -7 bsl -35. +-240518168576 = -7 bsr -35. +9665926958347581 = 98633 + 9665926958248948. +-9665926958150315 = 98633 - 9665926958248948. +953379373672968488084 = 98633 * 9665926958248948. +-98633 = -(98633). +98633 = +(98633). +0 = 98633 div 9665926958248948. +98633 = 98633 rem 9665926958248948. +65856 = 98633 band 9665926958248948. +9665926958281725 = 98633 bor 9665926958248948. +9665926958215869 = 98633 bxor 9665926958248948. +-98634 = bnot(98633). +0 = 98633 bsl -242. +697077706161145526319157529563105127886448876802131698785633537808379865464832 = 98633 bsr -242. +999444115635065983079250079840 = 999444115631184126856775915218 + 3881856222474164622. +999444115627302270634301750596 = 999444115631184126856775915218 - 3881856222474164622. +3879698359278100601364997602272180986374047017596 = 999444115631184126856775915218 * 3881856222474164622. +-999444115631184126856775915218 = -(999444115631184126856775915218). +999444115631184126856775915218 = +(999444115631184126856775915218). +257465516070 = 999444115631184126856775915218 div 3881856222474164622. +2332600211409439678 = 999444115631184126856775915218 rem 3881856222474164622. +25056404357271682 = 999444115631184126856775915218 band 3881856222474164622. +999444115635040926674892808158 = 999444115631184126856775915218 bor 3881856222474164622. +999444115635015870270535536476 = 999444115631184126856775915218 bxor 3881856222474164622. +-999444115631184126856775915219 = bnot(999444115631184126856775915218). +249861028907796031714193978804 = 999444115631184126856775915218 bsl -2. +3997776462524736507427103660872 = 999444115631184126856775915218 bsr -2. +-7421760831679509280811286683 = -7422292158463252213136449141 + 531326783742932325162458. +-7422823485246995145461611599 = -7422292158463252213136449141 - 531326783742932325162458. +-3943662620556666793445602995377124133609104079548578 = -7422292158463252213136449141 * 531326783742932325162458. +7422292158463252213136449141 = -(-7422292158463252213136449141). +-7422292158463252213136449141 = +(-7422292158463252213136449141). +-13969 = -7422292158463252213136449141 div 531326783742932325162458. +-188316358230562942073339 = -7422292158463252213136449141 rem 531326783742932325162458. +453407718756634929824138 = -7422292158463252213136449141 band 531326783742932325162458. +-7422214239398265915741110821 = -7422292158463252213136449141 bor 531326783742932325162458. +-7422667647117022550670934959 = -7422292158463252213136449141 bxor 531326783742932325162458. +7422292158463252213136449140 = bnot(-7422292158463252213136449141). +-1728137060642068324 = -7422292158463252213136449141 bsl -32. +-31878502081956917873220670646162292736 = -7422292158463252213136449141 bsr -32. +-887410717883738347 = -887411542626632718 + 824742894371. +-887412367369527089 = -887411542626632718 - 824742894371. +-731886364164123111632886630378 = -887411542626632718 * 824742894371. +887411542626632718 = -(-887411542626632718). +-887411542626632718 = +(-887411542626632718). +-1075985 = -887411542626632718 div 824742894371. +-559426852283 = -887411542626632718 rem 824742894371. +824633744162 = -887411542626632718 band 824742894371. +-887411542517482509 = -887411542626632718 bor 824742894371. +-887412367151226671 = -887411542626632718 bxor 824742894371. +887411542626632717 = bnot(-887411542626632718). +-1 = -887411542626632718 bsl -329. +-970495769895456546915019153080417053119984920561167837968648469580707157753110011803004098876328273565803987196706816 = -887411542626632718 bsr -329. +313568626669534262696946623 = 313568626669533918717171286 + 343979775337. +313568626669533574737395949 = 313568626669533918717171286 - 343979775337. +107861265754517903902833798202427373382 = 313568626669533918717171286 * 343979775337. +-313568626669533918717171286 = -(313568626669533918717171286). +313568626669533918717171286 = +(313568626669533918717171286). +911590300221366 = 313568626669533918717171286 div 343979775337. +60669920944 = 313568626669533918717171286 rem 343979775337. +275222516800 = 313568626669533918717171286 band 343979775337. +313568626669533987474429823 = 313568626669533918717171286 bor 343979775337. +313568626669533712251913023 = 313568626669533918717171286 bxor 343979775337. +-313568626669533918717171287 = bnot(313568626669533918717171286). +78392156667383479679292821 = 313568626669533918717171286 bsl -2. +1254274506678135674868685144 = 313568626669533918717171286 bsr -2. +1030797516921412947901481 = 948853774157265434517939 + 81943742764147513383542. +866910031393117921134397 = 948853774157265434517939 - 81943742764147513383542. +77752629590333478278519214703311340021586359938 = 948853774157265434517939 * 81943742764147513383542. +-948853774157265434517939 = -(948853774157265434517939). +948853774157265434517939 = +(948853774157265434517939). +11 = 948853774157265434517939 div 81943742764147513383542. +47472603751642787298977 = 948853774157265434517939 rem 81943742764147513383542. +1330856053278681202738 = 948853774157265434517939 band 81943742764147513383542. +1029466660868134266698743 = 948853774157265434517939 bor 81943742764147513383542. +1028135804814855585496005 = 948853774157265434517939 bxor 81943742764147513383542. +-948853774157265434517940 = bnot(948853774157265434517939). +0 = 948853774157265434517939 bsl -753. +44955830423796552989937230141548278995130022619090864557796782625730192137398224697416208564819328265689801653760488324197488078265293703127019736304678811815553524422839974370260849677832477301506583027387430880948825277017160289147874622970934591488 = 948853774157265434517939 bsr -753. +-69127735311 = 64125 + -69127799436. +69127863561 = 64125 - -69127799436. +-4432820138833500 = 64125 * -69127799436. +-64125 = -(64125). +64125 = +(64125). +0 = 64125 div -69127799436. +64125 = 64125 rem -69127799436. +30836 = 64125 band -69127799436. +-69127766147 = 64125 bor -69127799436. +-69127796983 = 64125 bxor -69127799436. +-64126 = bnot(64125). +2052000 = 64125 bsl 5. +2003 = 64125 bsr 5. +-5279768325556361346253573 = -4432399871885 + -5279768325551928946381688. +5279768325547496546509803 = -4432399871885 - -5279768325551928946381688. +23402044449758850833856816925510041880 = -4432399871885 * -5279768325551928946381688. +4432399871885 = -(-4432399871885). +-4432399871885 = +(-4432399871885). +0 = -4432399871885 div -5279768325551928946381688. +-4432399871885 = -4432399871885 rem -5279768325551928946381688. +-5279768325551958567878656 = -4432399871885 band -5279768325551928946381688. +-4402778374917 = -4432399871885 bor -5279768325551928946381688. +5279768325547555789503739 = -4432399871885 bxor -5279768325551928946381688. +4432399871884 = bnot(-4432399871885). +-283673591800640 = -4432399871885 bsl 6. +-69256247999 = -4432399871885 bsr 6. +-682115273248931533421569716 = 2121756217159 + -682115273248933655177786875. +682115273248935776934004034 = 2121756217159 - -682115273248933655177786875. +-1447282321835035099940583993505519988125 = 2121756217159 * -682115273248933655177786875. +-2121756217159 = -(2121756217159). +2121756217159 = +(2121756217159). +0 = 2121756217159 div -682115273248933655177786875. +2121756217159 = 2121756217159 rem -682115273248933655177786875. +1786714786309 = 2121756217159 band -682115273248933655177786875. +-682115273248933320136356025 = 2121756217159 bor -682115273248933655177786875. +-682115273248935106851142334 = 2121756217159 bxor -682115273248933655177786875. +-2121756217160 = bnot(2121756217159). +271584795796352 = 2121756217159 bsl 7. +16576220446 = 2121756217159 bsr 7. +-2701221790617 = -2644899318861 + -56322471756. +-2588576847105 = -2644899318861 - -56322471756. +148967267184012310589916 = -2644899318861 * -56322471756. +2644899318861 = -(-2644899318861). +-2644899318861 = +(-2644899318861). +46 = -2644899318861 div -56322471756. +-54065618085 = -2644899318861 rem -56322471756. +-2679478484816 = -2644899318861 band -56322471756. +-21743305801 = -2644899318861 bor -56322471756. +2657735179015 = -2644899318861 bxor -56322471756. +2644899318860 = bnot(-2644899318861). +-15018869115712881537722849356305578217847074295132537190932634107335313073669235165106989168393649706480152428938986012858339815450764726105014272 = -2644899318861 bsl 441. +-1 = -2644899318861 bsr 441. +815052126 = 3762931 + 811289195. +-807526264 = 3762931 - 811289195. +3052825261830545 = 3762931 * 811289195. +-3762931 = -(3762931). +3762931 = +(3762931). +0 = 3762931 div 811289195. +3762931 = 3762931 rem 811289195. +1657443 = 3762931 band 811289195. +813394683 = 3762931 bor 811289195. +811737240 = 3762931 bxor 811289195. +-3762932 = bnot(3762931). +1137276110832074043751571390464 = 3762931 bsl 78. +0 = 3762931 bsr 78. +49521116610 = -5716127151 + 55237243761. +-60953370912 = -5716127151 - 55237243761. +-315743108808657454911 = -5716127151 * 55237243761. +5716127151 = -(-5716127151). +-5716127151 = +(-5716127151). +0 = -5716127151 div 55237243761. +-5716127151 = -5716127151 rem 55237243761. +53825524305 = -5716127151 band 55237243761. +-4304407695 = -5716127151 bor 55237243761. +-58129932000 = -5716127151 bxor 55237243761. +5716127150 = bnot(-5716127151). +-1 = -5716127151 bsl -296. +-727747290743084335959424417130358281838296824590763414131023965275244960523992426285614207898484736 = -5716127151 bsr -296. +6544231478191377 = -486656422 + 6544231964847799. +-6544232451504221 = -486656422 - 6544231964847799. +-3184792512750859635915178 = -486656422 * 6544231964847799. +486656422 = -(-486656422). +-486656422 = +(-486656422). +0 = -486656422 div 6544231964847799. +-486656422 = -486656422 rem 6544231964847799. +6544231478208018 = -486656422 band 6544231964847799. +-16641 = -486656422 bor 6544231964847799. +-6544231478224659 = -486656422 bxor 6544231964847799. +486656421 = bnot(-486656422). +-301225735084581300745892102892683264 = -486656422 bsl 89. +-1 = -486656422 bsr 89. +778717791186742215227726143792 = 961172988421 + 778717791186742214266553155371. +-778717791186742213305380166950 = 961172988421 - 778717791186742214266553155371. +748482506491561270161937597014991196959191 = 961172988421 * 778717791186742214266553155371. +-961172988421 = -(961172988421). +961172988421 = +(961172988421). +0 = 961172988421 div 778717791186742214266553155371. +961172988421 = 961172988421 rem 778717791186742214266553155371. +552977605121 = 961172988421 band 778717791186742214266553155371. +778717791186742214674748538671 = 961172988421 bor 778717791186742214266553155371. +778717791186742214121770933550 = 961172988421 bxor 778717791186742214266553155371. +-961172988422 = bnot(961172988421). +1877290993 = 961172988421 bsl -9. +492120570071552 = 961172988421 bsr -9. +248781815992745712161 = 217 + 248781815992745711944. +-248781815992745711727 = 217 - 248781815992745711944. +53985654070425819491848 = 217 * 248781815992745711944. +-217 = -(217). +217 = +(217). +0 = 217 div 248781815992745711944. +217 = 217 rem 248781815992745711944. +72 = 217 band 248781815992745711944. +248781815992745712089 = 217 bor 248781815992745711944. +248781815992745712017 = 217 bxor 248781815992745711944. +-218 = bnot(217). +0 = 217 bsl -384. +8550235344617601989064551701731164195702303421691001926944779668721321624414894702676895777310026694055038273896579072 = 217 bsr -384. +-85735918 = 3889577 + -89625495. +93515072 = 3889577 - -89625495. +-348605263965615 = 3889577 * -89625495. +-3889577 = -(3889577). +3889577 = +(3889577). +0 = 3889577 div -89625495. +3889577 = 3889577 rem -89625495. +2639913 = 3889577 band -89625495. +-88375831 = 3889577 bor -89625495. +-91015744 = 3889577 bxor -89625495. +-3889578 = bnot(3889577). +62233232 = 3889577 bsl 4. +243098 = 3889577 bsr 4. +3360943323643976598 = 3883621238878422729 + -522677915234446131. +4406299154112868860 = 3883621238878422729 - -522677915234446131. +-2029883052697190904206803023196511499 = 3883621238878422729 * -522677915234446131. +-3883621238878422729 = -(3883621238878422729). +3883621238878422729 = +(3883621238878422729). +-7 = 3883621238878422729 div -522677915234446131. +224875832237299812 = 3883621238878422729 rem -522677915234446131. +3505208093292250313 = 3883621238878422729 band -522677915234446131. +-144264769648273715 = 3883621238878422729 bor -522677915234446131. +-3649472862940524028 = 3883621238878422729 bxor -522677915234446131. +-3883621238878422730 = bnot(3883621238878422729). +0 = 3883621238878422729 bsl -389. +4896718979799578121787780444971369924407880135835598510635873693211107237295224873386902521754369854131955746958494421577321819456667648 = 3883621238878422729 bsr -389. +498254268939163057825040291 = 895382574868 + 498254268939162162442465423. +-498254268939161267059890555 = 895382574868 - 498254268939162162442465423. +446128190261719971850333574351798789164 = 895382574868 * 498254268939162162442465423. +-895382574868 = -(895382574868). +895382574868 = +(895382574868). +0 = 895382574868 div 498254268939162162442465423. +895382574868 = 895382574868 rem 498254268939162162442465423. +550162976772 = 895382574868 band 498254268939162162442465423. +498254268939162507662063519 = 895382574868 bor 498254268939162162442465423. +498254268939161957499086747 = 895382574868 bxor 498254268939162162442465423. +-895382574869 = bnot(895382574868). +416 = 895382574868 bsl -31. +1922819438233165758464 = 895382574868 bsr -31. +34461789487513 = 34461789487594 + -81. +34461789487675 = 34461789487594 - -81. +-2791404948495114 = 34461789487594 * -81. +-34461789487594 = -(34461789487594). +34461789487594 = +(34461789487594). +-425454191204 = 34461789487594 div -81. +70 = 34461789487594 rem -81. +34461789487530 = 34461789487594 band -81. +-17 = 34461789487594 bor -81. +-34461789487547 = 34461789487594 bxor -81. +-34461789487595 = bnot(34461789487594). +232272001660026703760366764807388926368265233083387462586811750474488235820056576 = 34461789487594 bsl 222. +0 = 34461789487594 bsr 222. +-58613221819218149614641 = -58613221819218149646763 + 32122. +-58613221819218149678885 = -58613221819218149646763 - 32122. +-1882773911276925402953321086 = -58613221819218149646763 * 32122. +58613221819218149646763 = -(-58613221819218149646763). +-58613221819218149646763 = +(-58613221819218149646763). +-1824706488363680644 = -58613221819218149646763 div 32122. +-195 = -58613221819218149646763 rem 32122. +23632 = -58613221819218149646763 band 32122. +-58613221819218149638273 = -58613221819218149646763 bor 32122. +-58613221819218149661905 = -58613221819218149646763 bxor 32122. +58613221819218149646762 = bnot(-58613221819218149646763). +-115353780013824240609754035330166356835530807146082501076917294201730599832145189329658309317264927314622238725685567526053775984409131220351199561714585926564441368296923936159972926723881633284496272440549628177999460373025776789014171764136993061539354648264840701399373720351408128 = -58613221819218149646763 bsl 868. +-1 = -58613221819218149646763 bsr 868. +-648607 = -648663 + 56. +-648719 = -648663 - 56. +-36325128 = -648663 * 56. +648663 = -(-648663). +-648663 = +(-648663). +-11583 = -648663 div 56. +-15 = -648663 rem 56. +40 = -648663 band 56. +-648647 = -648663 bor 56. +-648687 = -648663 bxor 56. +648662 = bnot(-648663). +-5068 = -648663 bsl -7. +-83028864 = -648663 bsr -7. +-211455963197590501059607 = -211455963197594943585752 + 4442526145. +-211455963197599386111897 = -211455963197594943585752 - 4442526145. +-939398645021473337999503309486040 = -211455963197594943585752 * 4442526145. +211455963197594943585752 = -(-211455963197594943585752). +-211455963197594943585752 = +(-211455963197594943585752). +-47598135901931 = -211455963197594943585752 div 4442526145. +-3320099757 = -211455963197594943585752 rem 4442526145. +4299194368 = -211455963197594943585752 band 4442526145. +-211455963197594800253975 = -211455963197594943585752 bor 4442526145. +-211455963197599099448343 = -211455963197594943585752 bxor 4442526145. +211455963197594943585751 = bnot(-211455963197594943585752). +-54132726578584305557952512 = -211455963197594943585752 bsl 8. +-825999856240605248382 = -211455963197594943585752 bsr 8. +-3973112315127790593229 = -3972863948889215724974 + -248366238574868255. +-3972615582650640856719 = -3972863948889215724974 - -248366238574868255. +986725275355312154032587659946363300370 = -3972863948889215724974 * -248366238574868255. +3972863948889215724974 = -(-3972863948889215724974). +-3972863948889215724974 = +(-3972863948889215724974). +15995 = -3972863948889215724974 div -248366238574868255. +-245962884197986249 = -3972863948889215724974 rem -248366238574868255. +-3972963669672093286336 = -3972863948889215724974 band -248366238574868255. +-148645455697306893 = -3972863948889215724974 bor -248366238574868255. +3972815024216395979443 = -3972863948889215724974 bxor -248366238574868255. +3972863948889215724973 = bnot(-3972863948889215724974). +-1 = -3972863948889215724974 bsl -98. +-1259050842358627002143885165651655811471832363565056 = -3972863948889215724974 bsr -98. +-558635317797086 = -558635322194377 + 4397291. +-558635326591668 = -558635322194377 - 4397291. +-2456482074567434232707 = -558635322194377 * 4397291. +558635322194377 = -(-558635322194377). +-558635322194377 = +(-558635322194377). +-127040789 = -558635322194377 div 4397291. +-4091778 = -558635322194377 rem 4397291. +196643 = -558635322194377 band 4397291. +-558635317993729 = -558635322194377 bor 4397291. +-558635318190372 = -558635322194377 bxor 4397291. +558635322194376 = bnot(-558635322194377). +-4469082577555016 = -558635322194377 bsl 3. +-69829415274298 = -558635322194377 bsr 3. +-412756587134358128931489395 = 854997971 + -412756587134358129786487366. +412756587134358130641485337 = 854997971 - -412756587134358129786487366. +-352906044516760905354801361147134386 = 854997971 * -412756587134358129786487366. +-854997971 = -(854997971). +854997971 = +(854997971). +0 = 854997971 div -412756587134358129786487366. +854997971 = 854997971 rem -412756587134358129786487366. +43399570 = 854997971 band -412756587134358129786487366. +-412756587134358128974888965 = 854997971 bor -412756587134358129786487366. +-412756587134358129018288535 = 854997971 bxor -412756587134358129786487366. +-854997972 = bnot(854997971). +0 = 854997971 bsl -867. +841339588559027968657139068853479070517085189036390509696375594633682764255723855003503859399509987968043180973990640978757883815265442996100067617822859505102539561134888814730475971954120773134914827626854172581891142155887893016986662978936934078264133426162945753088 = 854997971 bsr -867. +-97495118883786324533104878919 = -97495118883786564252296322472 + 239719191443553. +-97495118883786803971487766025 = -97495118883786564252296322472 - 239719191443553. +-23371451068514390665490176249061750873423016 = -97495118883786564252296322472 * 239719191443553. +97495118883786564252296322472 = -(-97495118883786564252296322472). +-97495118883786564252296322472 = +(-97495118883786564252296322472). +-406705521976298 = -97495118883786564252296322472 div 239719191443553. +-232128225415678 = -97495118883786564252296322472 rem 239719191443553. +90184246911040 = -97495118883786564252296322472 band 239719191443553. +-97495118883786414717351789959 = -97495118883786564252296322472 bor 239719191443553. +-97495118883786504901598700999 = -97495118883786564252296322472 bxor 239719191443553. +97495118883786564252296322471 = bnot(-97495118883786564252296322472). +-761680616279582533221065020 = -97495118883786564252296322472 bsl -7. +-12479375217124680224293929276416 = -97495118883786564252296322472 bsr -7. +83 = 6 + 77. +-71 = 6 - 77. +462 = 6 * 77. +-6 = -(6). +6 = +(6). +0 = 6 div 77. +6 = 6 rem 77. +4 = 6 band 77. +79 = 6 bor 77. +75 = 6 bxor 77. +-7 = bnot(6). +24 = 6 bsl 2. +1 = 6 bsr 2. +2272412686867798218988 = 222618662789 + 2272412686645179556199. +-2272412686422560893410 = 222618662789 - 2272412686645179556199. +505881473605708751313821855579011 = 222618662789 * 2272412686645179556199. +-222618662789 = -(222618662789). +222618662789 = +(222618662789). +0 = 222618662789 div 2272412686645179556199. +222618662789 = 222618662789 rem 2272412686645179556199. +218239672581 = 222618662789 band 2272412686645179556199. +2272412686649558546407 = 222618662789 bor 2272412686645179556199. +2272412686431318873826 = 222618662789 bxor 2272412686645179556199. +-222618662790 = bnot(222618662789). +61192952074112457506816 = 222618662789 bsl 38. +0 = 222618662789 bsr 38. +-95427743251695916914283324936 = -95427743251695916914283328493 + 3557. +-95427743251695916914283332050 = -95427743251695916914283328493 - 3557. +-339436482746282376464105799449601 = -95427743251695916914283328493 * 3557. +95427743251695916914283328493 = -(-95427743251695916914283328493). +-95427743251695916914283328493 = +(-95427743251695916914283328493). +-26828153852037086565724860 = -95427743251695916914283328493 div 3557. +-1473 = -95427743251695916914283328493 rem 3557. +3073 = -95427743251695916914283328493 band 3557. +-95427743251695916914283328009 = -95427743251695916914283328493 bor 3557. +-95427743251695916914283331082 = -95427743251695916914283328493 bxor 3557. +95427743251695916914283328492 = bnot(-95427743251695916914283328493). +-3053687784054269341257066511776 = -95427743251695916914283328493 bsl 5. +-2982116976615497403571354016 = -95427743251695916914283328493 bsr 5. +538947190970 = 63698 + 538947127272. +-538947063574 = 63698 - 538947127272. +34329854112971856 = 63698 * 538947127272. +-63698 = -(63698). +63698 = +(63698). +0 = 63698 div 538947127272. +63698 = 63698 rem 538947127272. +32960 = 63698 band 538947127272. +538947158010 = 63698 bor 538947127272. +538947125050 = 63698 bxor 538947127272. +-63699 = bnot(63698). +36719397000223469338624 = 63698 bsl 59. +0 = 63698 bsr 59. +-2814956792591 = -2814594177148 + -362615443. +-2814231561705 = -2814594177148 - -362615443. +1020615314411742496564 = -2814594177148 * -362615443. +2814594177148 = -(-2814594177148). +-2814594177148 = +(-2814594177148). +7761 = -2814594177148 div -362615443. +-335724025 = -2814594177148 rem -362615443. +-2814679964412 = -2814594177148 band -362615443. +-276828179 = -2814594177148 bor -362615443. +2814403136233 = -2814594177148 bxor -362615443. +2814594177147 = bnot(-2814594177148). +-90067013668736 = -2814594177148 bsl 5. +-87956068036 = -2814594177148 bsr 5. +-74795892476115149750695 = -74795892476178575122683 + 63425371988. +-74795892476242000494671 = -74795892476178575122683 - 63425371988. +-4743957303476076555871972011603804 = -74795892476178575122683 * 63425371988. +74795892476178575122683 = -(-74795892476178575122683). +-74795892476178575122683 = +(-74795892476178575122683). +-1179274005524 = -74795892476178575122683 div 63425371988. +-40108260971 = -74795892476178575122683 rem 63425371988. +36577484548 = -74795892476178575122683 band 63425371988. +-74795892476151727235243 = -74795892476178575122683 bor 63425371988. +-74795892476188304719791 = -74795892476178575122683 bxor 63425371988. +74795892476178575122682 = bnot(-74795892476178575122683). +-1168685819940290236292 = -74795892476178575122683 bsl -6. +-4786937118475428807851712 = -74795892476178575122683 bsr -6. +-22437499697211126968661233906 = -22437499697211126969325683753 + 664449847. +-22437499697211126969990133600 = -22437499697211126969325683753 - 664449847. +-14908593240874479641466024262851235791 = -22437499697211126969325683753 * 664449847. +22437499697211126969325683753 = -(-22437499697211126969325683753). +-22437499697211126969325683753 = +(-22437499697211126969325683753). +-33768537683493705386 = -22437499697211126969325683753 div 664449847. +-134907811 = -22437499697211126969325683753 rem 664449847. +546452247 = -22437499697211126969325683753 band 664449847. +-22437499697211126969207686153 = -22437499697211126969325683753 bor 664449847. +-22437499697211126969754138400 = -22437499697211126969325683753 bxor 664449847. +22437499697211126969325683752 = bnot(-22437499697211126969325683753). +-1187832 = -22437499697211126969325683753 bsl -74. +-423832386118030556385499827621469560121596001124352 = -22437499697211126969325683753 bsr -74. +83166332774953742129752170768 = -2557145728214 + 83166332774953744686897898982. +-83166332774953747244043627196 = -2557145728214 - 83166332774953744686897898982. +-212668432586696948837543761316992999278148 = -2557145728214 * 83166332774953744686897898982. +2557145728214 = -(-2557145728214). +-2557145728214 = +(-2557145728214). +0 = -2557145728214 div 83166332774953744686897898982. +-2557145728214 = -2557145728214 rem 83166332774953744686897898982. +83166332774953742130305835298 = -2557145728214 band 83166332774953744686897898982. +-553664530 = -2557145728214 bor 83166332774953744686897898982. +-83166332774953742130859499828 = -2557145728214 bxor 83166332774953744686897898982. +2557145728213 = bnot(-2557145728214). +-75 = -2557145728214 bsl -35. +-87862858190281875914752 = -2557145728214 bsr -35. +72922571214 = -362 + 72922571576. +-72922571938 = -362 - 72922571576. +-26397970910512 = -362 * 72922571576. +362 = -(-362). +-362 = +(-362). +0 = -362 div 72922571576. +-362 = -362 rem 72922571576. +72922571280 = -362 band 72922571576. +-66 = -362 bor 72922571576. +-72922571346 = -362 bxor 72922571576. +361 = bnot(-362). +-6890241547122655599781102391427379235424207270408970165480824487326342629018449705258891902049390066092891366554238159926586366193756875087619592580596055738027973686297350071900831748608201993561940337577103619438035520408189345176484733649999542093444612200632321234460199120267720523776 = -362 bsl 951. +-1 = -362 bsr 951. +-93189639659574845625544558 = -93189639659574846354398755 + 728854197. +-93189639659574847083252952 = -93189639659574846354398755 - 728854197. +-67921659982798778001033681993324735 = -93189639659574846354398755 * 728854197. +93189639659574846354398755 = -(-93189639659574846354398755). +-93189639659574846354398755 = +(-93189639659574846354398755). +-127857725239352427 = -93189639659574846354398755 div 728854197. +-373312636 = -93189639659574846354398755 rem 728854197. +90261 = -93189639659574846354398755 band 728854197. +-93189639659574845625634819 = -93189639659574846354398755 bor 728854197. +-93189639659574845625725080 = -93189639659574846354398755 bxor 728854197. +93189639659574846354398754 = bnot(-93189639659574846354398755). +-10931606062726626168689879712279756080799076594515029339699505607773757758484265826434794126786089188471648933174161746396893256718020099226297769133138659324465250832140453386754272464958470824443196446258559494628169675724271919797628793512473184775801897351832646076025882542080 = -93189639659574846354398755 bsl 844. +-1 = -93189639659574846354398755 bsr 844. +776716499568896236748367 = 776716499568896236753549 + -5182. +776716499568896236758731 = 776716499568896236753549 - -5182. +-4024944900766020298856890918 = 776716499568896236753549 * -5182. +-776716499568896236753549 = -(776716499568896236753549). +776716499568896236753549 = +(776716499568896236753549). +-149887398604572797520 = 776716499568896236753549 div -5182. +4909 = 776716499568896236753549 rem -5182. +776716499568896236749440 = 776716499568896236753549 band -5182. +-1073 = 776716499568896236753549 bor -5182. +-776716499568896236750513 = 776716499568896236753549 bxor -5182. +-776716499568896236753550 = bnot(776716499568896236753549). +3416035291045895614130141354939908096 = 776716499568896236753549 bsl 42. +176604885284 = 776716499568896236753549 bsr 42. +8784691884057442103417 = 8698434224582283691994 + 86257659475158411423. +8612176565107125280571 = 8698434224582283691994 - 86257659475158411423. +750306577311082232165252216883388463247462 = 8698434224582283691994 * 86257659475158411423. +-8698434224582283691994 = -(8698434224582283691994). +8698434224582283691994 = +(8698434224582283691994). +100 = 8698434224582283691994 div 86257659475158411423. +72668277066442549694 = 8698434224582283691994 rem 86257659475158411423. +83658937330337054874 = 8698434224582283691994 band 86257659475158411423. +8701032946727105048543 = 8698434224582283691994 bor 86257659475158411423. +8617374009396767993669 = 8698434224582283691994 bxor 86257659475158411423. +-8698434224582283691995 = bnot(8698434224582283691994). +31644719363 = 8698434224582283691994 bsl -38. +2391007393343233773958935489806336 = 8698434224582283691994 bsr -38. +-889414884063465 = -482757798149 + -888932126265316. +888449368467167 = -482757798149 - -888932126265316. +429138915979752802747700084 = -482757798149 * -888932126265316. +482757798149 = -(-482757798149). +-482757798149 = +(-482757798149). +0 = -482757798149 div -888932126265316. +-482757798149 = -482757798149 rem -888932126265316. +-888933267271656 = -482757798149 band -888932126265316. +-481616791809 = -482757798149 bor -888932126265316. +888451650479847 = -482757798149 bxor -888932126265316. +482757798148 = bnot(-482757798149). +-120689449538 = -482757798149 bsl -2. +-1931031192596 = -482757798149 bsr -2. +-9311465532747505012879235860 = -9311465532741592568295336441 + -5912444583899419. +-9311465532735680123711437022 = -9311465532741592568295336441 - -5912444583899419. +55053523957224147137203729930936572309427779 = -9311465532741592568295336441 * -5912444583899419. +9311465532741592568295336441 = -(-9311465532741592568295336441). +-9311465532741592568295336441 = +(-9311465532741592568295336441). +1574892652372 = -9311465532741592568295336441 div -5912444583899419. +-1770692915564573 = -9311465532741592568295336441 rem -5912444583899419. +-9311465532747503817737468411 = -9311465532741592568295336441 band -5912444583899419. +-1195141767449 = -9311465532741592568295336441 bor -5912444583899419. +9311465532747502622595700962 = -9311465532741592568295336441 bxor -5912444583899419. +9311465532741592568295336440 = bnot(-9311465532741592568295336441). +-5496519092276855218107774179961766736959207636992 = -9311465532741592568295336441 bsl 69. +-15774237 = -9311465532741592568295336441 bsr 69. +-336594717611075159231967 = -4815737711246539 + -336594712795337447985428. +336594707979599736738889 = -4815737711246539 - -336594712795337447985428. +1620951851814704497131776297164187433692 = -4815737711246539 * -336594712795337447985428. +4815737711246539 = -(-4815737711246539). +-4815737711246539 = +(-4815737711246539). +0 = -4815737711246539 div -336594712795337447985428. +-4815737711246539 = -4815737711246539 rem -336594712795337447985428. +-336594717584535246896604 = -4815737711246539 band -336594712795337447985428. +-26539912335363 = -4815737711246539 bor -336594712795337447985428. +336594717557995334561241 = -4815737711246539 bxor -336594712795337447985428. +4815737711246538 = bnot(-4815737711246539). +-616414427039556992 = -4815737711246539 bsl 7. +-37622950869114 = -4815737711246539 bsr 7. +-841542 = -21913 + -819629. +797716 = -21913 - -819629. +17960530277 = -21913 * -819629. +21913 = -(-21913). +-21913 = +(-21913). +0 = -21913 div -819629. +-21913 = -21913 rem -819629. +-841149 = -21913 band -819629. +-393 = -21913 bor -819629. +840756 = -21913 bxor -819629. +21912 = bnot(-21913). +-86 = -21913 bsl -8. +-5609728 = -21913 bsr -8. +751693196175252841486165556 = -658945832828833 + 751693196175911787318994389. +-751693196176570733151823222 = -658945832828833 - 751693196175911787318994389. +-495325099185903537919591301481900724418037 = -658945832828833 * 751693196175911787318994389. +658945832828833 = -(-658945832828833). +-658945832828833 = +(-658945832828833). +0 = -658945832828833 div 751693196175911787318994389. +-658945832828833 = -658945832828833 rem 751693196175911787318994389. +751693196175271868196012117 = -658945832828833 band 751693196175911787318994389. +-19026709846561 = -658945832828833 bor 751693196175911787318994389. +-751693196175290894905858678 = -658945832828833 bxor 751693196175911787318994389. +658945832828832 = bnot(-658945832828833). +-42172533301045312 = -658945832828833 bsl 6. +-10296028637951 = -658945832828833 bsr 6. +8881452937194234543364865475 = -47862 + 8881452937194234543364913337. +-8881452937194234543364961199 = -47862 - 8881452937194234543364913337. +-425084100479990453714531482135494 = -47862 * 8881452937194234543364913337. +47862 = -(-47862). +-47862 = +(-47862). +0 = -47862 div 8881452937194234543364913337. +-47862 = -47862 rem 8881452937194234543364913337. +8881452937194234543364898824 = -47862 band 8881452937194234543364913337. +-33349 = -47862 bor 8881452937194234543364913337. +-8881452937194234543364932173 = -47862 bxor 8881452937194234543364913337. +47861 = bnot(-47862). +-1 = -47862 bsl -657. +-28621869264487515102197023426743807953081427927227508378485563364697061202715176740185177977686855507798311334158188612511882646044602690892250333326153431839947747374429765768428457110969640540820209664 = -47862 bsr -657. +43246692744888958054081193 = -4463469462784332 + 43246692749352427516865525. +-43246692753815896979649857 = -4463469462784332 - 43246692749352427516865525. +-193030292453151145514582848977255720954300 = -4463469462784332 * 43246692749352427516865525. +4463469462784332 = -(-4463469462784332). +-4463469462784332 = +(-4463469462784332). +0 = -4463469462784332 div 43246692749352427516865525. +-4463469462784332 = -4463469462784332 rem 43246692749352427516865525. +43246692745550864171672244 = -4463469462784332 band 43246692749352427516865525. +-661906117591051 = -4463469462784332 bor 43246692749352427516865525. +-43246692746212770289263295 = -4463469462784332 bxor 43246692749352427516865525. +4463469462784331 = bnot(-4463469462784332). +-16 = -4463469462784332 bsl -48. +-1256354963085944097420494241792 = -4463469462784332 bsr -48. +8728675682299444845504227424 = 3328234963656 + 8728675682299441517269263768. +-8728675682299438189034300112 = 3328234963656 - 8728675682299441517269263768. +29051083592242892740737765593255357615808 = 3328234963656 * 8728675682299441517269263768. +-3328234963656 = -(3328234963656). +3328234963656 = +(3328234963656). +0 = 3328234963656 div 8728675682299441517269263768. +3328234963656 = 3328234963656 rem 8728675682299441517269263768. +1100182847624 = 3328234963656 band 8728675682299441517269263768. +8728675682299443745321379800 = 3328234963656 bor 8728675682299441517269263768. +8728675682299442645138532176 = 3328234963656 bxor 8728675682299441517269263768. +-3328234963657 = bnot(3328234963656). +0 = 3328234963656 bsl -976. +2125640160021589754437853056555184807143885696198386054840467658580619821374871238208694261565718427120235436218054118816956979200437397103127510222131217940910349101057302546832028585912956319511017564357863535791436478822874955160912187456194118518427198621138185494324184783655387790473827510562865545216 = 3328234963656 bsr -976. +-82858148667443555890 = -93416 + -82858148667443462474. +82858148667443369058 = -93416 - -82858148667443462474. +7740276815917898490471184 = -93416 * -82858148667443462474. +93416 = -(-93416). +-93416 = +(-93416). +0 = -93416 div -82858148667443462474. +-93416 = -93416 rem -82858148667443462474. +-82858148667443473904 = -93416 band -82858148667443462474. +-81986 = -93416 bor -82858148667443462474. +82858148667443391918 = -93416 bxor -82858148667443462474. +93415 = bnot(-93416). +-747328 = -93416 bsl 3. +-11677 = -93416 bsr 3. +-69522286132708825661355059 = -6296125933876397422 + -69522279836582891784957637. +69522273540456957908560215 = -6296125933876397422 - -69522279836582891784957637. +437721029061321693891748265271742172446011814 = -6296125933876397422 * -69522279836582891784957637. +6296125933876397422 = -(-6296125933876397422). +-6296125933876397422 = +(-6296125933876397422). +0 = -6296125933876397422 div -69522279836582891784957637. +-6296125933876397422 = -6296125933876397422 rem -69522279836582891784957637. +-69522279836587466206212078 = -6296125933876397422 band -69522279836582891784957637. +-6296121359455142981 = -6296125933876397422 bor -69522279836582891784957637. +69522273540466106751069097 = -6296125933876397422 bxor -69522279836582891784957637. +6296125933876397421 = bnot(-6296125933876397422). +-29959826309054960899492441143257086457558738752300529629065745032858510795396227815951096336645313085285082382949010591123047750614938649536436354908253490458588459860438104999605715265971851389712439168805885079103840928811819820835717902702278465473672638927765675383076896434542926217646211947418353664 = -6296125933876397422 bsl 949. +-1 = -6296125933876397422 bsr 949. +-8790853496198 = 4658928385 + -8795512424583. +8800171352968 = 4658928385 - -8795512424583. +-40977662495509910488455 = 4658928385 * -8795512424583. +-4658928385 = -(4658928385). +4658928385 = +(4658928385). +0 = 4658928385 div -8795512424583. +4658928385 = 4658928385 rem -8795512424583. +9507585 = 4658928385 band -8795512424583. +-8790863003783 = 4658928385 bor -8795512424583. +-8790872511368 = 4658928385 bxor -8795512424583. +-4658928386 = bnot(4658928385). +582366048 = 4658928385 bsl -3. +37271427080 = 4658928385 bsr -3. +7715926329340651 = 7711677977654284 + 4248351686367. +7707429625967917 = 7711677977654284 - 4248351686367. +32761920141086833574321946228 = 7711677977654284 * 4248351686367. +-7711677977654284 = -(7711677977654284). +7711677977654284 = +(7711677977654284). +1815 = 7711677977654284 div 4248351686367. +919666898179 = 7711677977654284 rem 4248351686367. +1752891536396 = 7711677977654284 band 4248351686367. +7714173437804255 = 7711677977654284 bor 4248351686367. +7712420546267859 = 7711677977654284 bxor 4248351686367. +-7711677977654285 = bnot(7711677977654284). +60247484200424 = 7711677977654284 bsl -7. +987094781139748352 = 7711677977654284 bsr -7. +-42642321093453 = 2585512 + -42642323678965. +42642326264477 = 2585512 - -42642323678965. +-110252239579848155080 = 2585512 * -42642323678965. +-2585512 = -(2585512). +2585512 = +(2585512). +0 = 2585512 div -42642323678965. +2585512 = 2585512 rem -42642323678965. +2183432 = 2585512 band -42642323678965. +-42642323276885 = 2585512 bor -42642323678965. +-42642325460317 = 2585512 bxor -42642323678965. +-2585513 = bnot(2585512). +325658762403878241163952527518051310623588082226349026899363505534404205118952466218333127046730115696891637885047489472578634310547091362187317737408559758990182083158406170172516194279339952578517625445121509111687082511722725843073735533362617019272189110606687633408 = 2585512 bsl 874. +0 = 2585512 bsr 874. +-767284617701761748962633 = -39272154248625298665 + -767245345547513123663968. +767206073393264498365303 = -39272154248625298665 - -767245345547513123663968. +30131377556881752895633973866033123099002720 = -39272154248625298665 * -767245345547513123663968. +39272154248625298665 = -(-39272154248625298665). +-39272154248625298665 = +(-39272154248625298665). +0 = -39272154248625298665 div -767245345547513123663968. +-39272154248625298665 = -39272154248625298665 rem -767245345547513123663968. +-767282311269246790663424 = -39272154248625298665 band -767245345547513123663968. +-2306432514958299209 = -39272154248625298665 bor -767245345547513123663968. +767280004836731832364215 = -39272154248625298665 bxor -767245345547513123663968. +39272154248625298664 = bnot(-39272154248625298665). +-76703426266846287 = -39272154248625298665 bsl -9. +-20107342975296152916480 = -39272154248625298665 bsr -9. +-9239493198773203875387030 = -9239493198773198132818179 + -5742568851. +-9239493198773192390249328 = -9239493198773198132818179 - -5742568851. +53058425842301319011173035571942329 = -9239493198773198132818179 * -5742568851. +9239493198773198132818179 = -(-9239493198773198132818179). +-9239493198773198132818179 = +(-9239493198773198132818179). +1608947744207585 = -9239493198773198132818179 div -5742568851. +-4833883344 = -9239493198773198132818179 rem -5742568851. +-9239493198773203808269715 = -9239493198773198132818179 band -5742568851. +-67117315 = -9239493198773198132818179 bor -5742568851. +9239493198773203741152400 = -9239493198773198132818179 bxor -5742568851. +9239493198773198132818178 = bnot(-9239493198773198132818179). +-295663782360742340250181728 = -9239493198773198132818179 bsl 5. +-288734162461662441650569 = -9239493198773198132818179 bsr 5. +-51767695721771121252643955124 = -51767695721771121252643961599 + 6475. +-51767695721771121252643968074 = -51767695721771121252643961599 - 6475. +-335195829798468010110869651353525 = -51767695721771121252643961599 * 6475. +51767695721771121252643961599 = -(-51767695721771121252643961599). +-51767695721771121252643961599 = +(-51767695721771121252643961599). +-7995010922281254247512580 = -51767695721771121252643961599 div 6475. +-6099 = -51767695721771121252643961599 rem 6475. +257 = -51767695721771121252643961599 band 6475. +-51767695721771121252643955381 = -51767695721771121252643961599 bor 6475. +-51767695721771121252643955638 = -51767695721771121252643961599 bxor 6475. +51767695721771121252643961598 = bnot(-51767695721771121252643961599). +-1 = -51767695721771121252643961599 bsl -96. +-4101459409633469070626883473116985513501536515007147147264 = -51767695721771121252643961599 bsr -96. +-71488425765717485811 = 2 + -71488425765717485813. +71488425765717485815 = 2 - -71488425765717485813. +-142976851531434971626 = 2 * -71488425765717485813. +-2 = -(2). +2 = +(2). +0 = 2 div -71488425765717485813. +2 = 2 rem -71488425765717485813. +2 = 2 band -71488425765717485813. +-71488425765717485813 = 2 bor -71488425765717485813. +-71488425765717485815 = 2 bxor -71488425765717485813. +-3 = bnot(2). +0 = 2 bsl -9. +1024 = 2 bsr -9. +-29853310 = 49 + -29853359. +29853408 = 49 - -29853359. +-1462814591 = 49 * -29853359. +-49 = -(49). +49 = +(49). +0 = 49 div -29853359. +49 = 49 rem -29853359. +17 = 49 band -29853359. +-29853327 = 49 bor -29853359. +-29853344 = 49 bxor -29853359. +-50 = bnot(49). +0 = 49 bsl -822. +1370416300786399510758320715576237388716176972105822240178350620520744273693644827937420829126373818746131460890362291292622506032320894002267388941442055079497198087002911516612376232238740195347663047268901872193672458131572403903469316961149648896 = 49 bsr -822. +-3327259672827942138 = 38 + -3327259672827942176. +3327259672827942214 = 38 - -3327259672827942176. +-126435867567461802688 = 38 * -3327259672827942176. +-38 = -(38). +38 = +(38). +0 = 38 div -3327259672827942176. +38 = 38 rem -3327259672827942176. +32 = 38 band -3327259672827942176. +-3327259672827942170 = 38 bor -3327259672827942176. +-3327259672827942202 = 38 bxor -3327259672827942176. +-39 = bnot(38). +10952754293765046272 = 38 bsl 58. +0 = 38 bsr 58. +-6166638483332631225207873 = -6166638483332631677652215 + 452444342. +-6166638483332632130096557 = -6166638483332631677652215 - 452444342. +-2790060690943310506523712520517530 = -6166638483332631677652215 * 452444342. +6166638483332631677652215 = -(-6166638483332631677652215). +-6166638483332631677652215 = +(-6166638483332631677652215). +-13629606806603919 = -6166638483332631677652215 div 452444342. +-291075917 = -6166638483332631677652215 rem 452444342. +310870016 = -6166638483332631677652215 band 452444342. +-6166638483332631536077889 = -6166638483332631677652215 bor 452444342. +-6166638483332631846947905 = -6166638483332631677652215 bxor 452444342. +6166638483332631677652214 = bnot(-6166638483332631677652215). +-1 = -6166638483332631677652215 bsl -996. +-4129753882685615072570641438967458335229779666029661176613271197538250890449055225405454861443951408827738251305872557217168543348545877943992188684690076608466334151476719612408546067060287806744603782814736963222494649921816478038076842248135088239975552993497178634462091574277794817071167406424900701076341124126463754240 = -6166638483332631677652215 bsr -996. +-8945229019521027315 = -63946584418 + -8945228955574442897. +8945228891627858479 = -63946584418 - -8945228955574442897. +572016838545979084396330978946 = -63946584418 * -8945228955574442897. +63946584418 = -(-63946584418). +-63946584418 = +(-63946584418). +0 = -63946584418 div -8945228955574442897. +-63946584418 = -63946584418 rem -8945228955574442897. +-8945228992618691570 = -63946584418 band -8945228955574442897. +-26902335745 = -63946584418 bor -8945228955574442897. +8945228965716355825 = -63946584418 bxor -8945228955574442897. +63946584417 = bnot(-63946584418). +-2046290701376 = -63946584418 bsl 5. +-1998330764 = -63946584418 bsr 5. +67443671255351964 = 6213841 + 67443671249138123. +-67443671242924282 = 6213841 - 67443671249138123. +419084249598415683360443 = 6213841 * 67443671249138123. +-6213841 = -(6213841). +6213841 = +(6213841). +0 = 6213841 div 67443671249138123. +6213841 = 6213841 rem 67443671249138123. +397505 = 6213841 band 67443671249138123. +67443671254954459 = 6213841 bor 67443671249138123. +67443671254556954 = 6213841 bxor 67443671249138123. +-6213842 = bnot(6213841). +24272 = 6213841 bsl -8. +1590743296 = 6213841 bsr -8. +82342884782 = 82345722295 + -2837513. +82348559808 = 82345722295 - -2837513. +-233657057506452335 = 82345722295 * -2837513. +-82345722295 = -(82345722295). +82345722295 = +(82345722295). +-29020 = 82345722295 div -2837513. +1095035 = 82345722295 rem -2837513. +82343625143 = 82345722295 band -2837513. +-740361 = 82345722295 bor -2837513. +-82344365504 = 82345722295 bxor -2837513. +-82345722296 = bnot(82345722295). +0 = 82345722295 bsl -75. +3110933431788797435617493972418560 = 82345722295 bsr -75. +43572240502045 = -743398 + 43572241245443. +-43572241988841 = -743398 - 43572241245443. +-32391516997379835314 = -743398 * 43572241245443. +743398 = -(-743398). +-743398 = +(-743398). +0 = -743398 div 43572241245443. +-743398 = -743398 rem 43572241245443. +43572241113090 = -743398 band 43572241245443. +-611045 = -743398 bor 43572241245443. +-43572241724135 = -743398 bxor 43572241245443. +743397 = bnot(-743398). +-47577472 = -743398 bsl 6. +-11616 = -743398 bsr 6. +-91594137246897918174 = -833 + -91594137246897917341. +91594137246897916508 = -833 - -91594137246897917341. +76297916326665965145053 = -833 * -91594137246897917341. +833 = -(-833). +-833 = +(-833). +0 = -833 div -91594137246897917341. +-833 = -833 rem -91594137246897917341. +-91594137246897917917 = -833 band -91594137246897917341. +-257 = -833 bor -91594137246897917341. +91594137246897917660 = -833 bxor -91594137246897917341. +832 = bnot(-833). +-1 = -833 bsl -799. +-2777228011294459305154258270835403872510791841244575748805041378599721509551043757788676511663002362094430307762164944645712685888940715555971337795795790714198633131867587063599872106082270541299613929220596769725374196557608946127769754927104 = -833 bsr -799. +7785281615558743240165 = 755344292 + 7785281615557987895873. +-7785281615557232551581 = 755344292 - 7785281615557987895873. +5880568029924264552152760906916 = 755344292 * 7785281615557987895873. +-755344292 = -(755344292). +755344292 = +(755344292). +0 = 755344292 div 7785281615557987895873. +755344292 = 755344292 rem 7785281615557987895873. +16876032 = 755344292 band 7785281615557987895873. +7785281615558726364133 = 755344292 bor 7785281615557987895873. +7785281615558709488101 = 755344292 bxor 7785281615557987895873. +-755344293 = bnot(755344292). +29220966953514617177951386199916544 = 755344292 bsl 85. +0 = 755344292 bsr 85. +-1078320760604 = -4824745155583 + 3746424394979. +-8571169550562 = -4824745155583 - 3746424394979. +-18075542950432901999017757 = -4824745155583 * 3746424394979. +4824745155583 = -(-4824745155583). +-4824745155583 = +(-4824745155583). +-1 = -4824745155583 div 3746424394979. +-1078320760604 = -4824745155583 rem 3746424394979. +3332899013633 = -4824745155583 band 3746424394979. +-4411219774237 = -4824745155583 bor 3746424394979. +-7744118787870 = -4824745155583 bxor 3746424394979. +4824745155582 = bnot(-4824745155583). +-6344703802175932826948506277387853831652433096072652876345722969499346964981655993272881899870798551447793487830423204642644396774153846137488341278160903583437198477435542964519758669496804762864416770266392624939298455552 = -4824745155583 bsl 698. +-1 = -4824745155583 bsr 698. +736594418215962290005038759664 = 736594418215962289947266895286 + 57771864378. +736594418215962289889495030908 = 736594418215962289947266895286 - 57771864378. +42554432830764386129595815846231919522108 = 736594418215962289947266895286 * 57771864378. +-736594418215962289947266895286 = -(736594418215962289947266895286). +736594418215962289947266895286 = +(736594418215962289947266895286). +12750054479745394689 = 736594418215962289947266895286 div 57771864378. +4277406844 = 736594418215962289947266895286 rem 57771864378. +57747210546 = 736594418215962289947266895286 band 57771864378. +736594418215962289947291549118 = 736594418215962289947266895286 bor 57771864378. +736594418215962289889544338572 = 736594418215962289947266895286 bxor 57771864378. +-736594418215962289947266895287 = bnot(736594418215962289947266895286). +13913875168207705462638560218105114542296559700148224 = 736594418215962289947266895286 bsl 74. +38994983 = 736594418215962289947266895286 bsr 74. +-44499666734315603021609175 = -44267334142723866234955437 + -232332591591736786653738. +-44035001551132129448301699 = -44267334142723866234955437 - -232332591591736786653738. +10284744464236409699247335826909733008312779473506 = -44267334142723866234955437 * -232332591591736786653738. +44267334142723866234955437 = -(-44267334142723866234955437). +-44267334142723866234955437 = +(-44267334142723866234955437). +190 = -44267334142723866234955437 div -232332591591736786653738. +-124141740293876770745217 = -44267334142723866234955437 rem -232332591591736786653738. +-44418486790699506364036782 = -44267334142723866234955437 band -232332591591736786653738. +-81179943616096657572393 = -44267334142723866234955437 bor -232332591591736786653738. +44337306847083409706464389 = -44267334142723866234955437 bxor -232332591591736786653738. +44267334142723866234955436 = bnot(-44267334142723866234955437). +-19344603412483138584124909315899351993406026847258365156654530346044019592419283545366730486787483901772466875019849611292165184086245659597430481191845721885258321204649825128992477334294813436320376000188342502728496927502124171690494640260046529660954126810644041695232 = -44267334142723866234955437 bsl 816. +-1 = -44267334142723866234955437 bsr 816. +683857175479606 = 683857175479682 + -76. +683857175479758 = 683857175479682 - -76. +-51973145336455832 = 683857175479682 * -76. +-683857175479682 = -(683857175479682). +683857175479682 = +(683857175479682). +-8998120729995 = 683857175479682 div -76. +62 = 683857175479682 rem -76. +683857175479680 = 683857175479682 band -76. +-74 = 683857175479682 bor -76. +-683857175479754 = 683857175479682 bxor -76. +-683857175479683 = bnot(683857175479682). +0 = 683857175479682 bsl -619. +1487759472876019611292223358074497985975273879482222010497134415479575860865563804521231385258548213499430324053331578407367628766429304314628378275020045407624205785928797259522281156909858045523132416 = 683857175479682 bsr -619. +-7584278372166956 = -7584278372166953 + -3. +-7584278372166950 = -7584278372166953 - -3. +22752835116500859 = -7584278372166953 * -3. +7584278372166953 = -(-7584278372166953). +-7584278372166953 = +(-7584278372166953). +2528092790722317 = -7584278372166953 div -3. +-2 = -7584278372166953 rem -3. +-7584278372166955 = -7584278372166953 band -3. +-1 = -7584278372166953 bor -3. +7584278372166954 = -7584278372166953 bxor -3. +7584278372166952 = bnot(-7584278372166953). +-237008699130218 = -7584278372166953 bsl -5. +-242696907909342496 = -7584278372166953 bsr -5. +700475563613494766961192 = 699891966453749538575625 + 583597159745228385567. +699308369294004310190058 = 699891966453749538575625 - 583597159745228385567. +408454963750910895841936347455859207488004375 = 699891966453749538575625 * 583597159745228385567. +-699891966453749538575625 = -(699891966453749538575625). +699891966453749538575625 = +(699891966453749538575625). +1199 = 699891966453749538575625 div 583597159745228385567. +158971919220704280792 = 699891966453749538575625 rem 583597159745228385567. +389687613701390075145 = 699891966453749538575625 band 583597159745228385567. +700085875999793376886047 = 699891966453749538575625 bor 583597159745228385567. +699696188386091986810902 = 699891966453749538575625 bxor 583597159745228385567. +-699891966453749538575626 = bnot(699891966453749538575625). +5214601505203169 = 699891966453749538575625 bsl -27. +93937909582874480148668743680000 = 699891966453749538575625 bsr -27. +24163917278717181820 = -397919 + 24163917278717579739. +-24163917278717977658 = -397919 - 24163917278717579739. +-9615281799630020612163141 = -397919 * 24163917278717579739. +397919 = -(-397919). +-397919 = +(-397919). +0 = -397919 div 24163917278717579739. +-397919 = -397919 rem 24163917278717579739. +24163917278717444481 = -397919 band 24163917278717579739. +-262661 = -397919 bor 24163917278717579739. +-24163917278717707142 = -397919 bxor 24163917278717579739. +397918 = bnot(-397919). +-881720008260862467535648094417617143671022248542464649309238318334728166992382627601504073345655260786923942524000700776672122040870760879424839487674361120308837255626935937373935928217849017914636001805242153319122303273815123985408819695181545132002338731761585908602058714382336 = -397919 bsl 918. +-1 = -397919 bsr 918. +-2325699978272500 = -757 + -2325699978271743. +2325699978270986 = -757 - -2325699978271743. +1760554883551709451 = -757 * -2325699978271743. +757 = -(-757). +-757 = +(-757). +0 = -757 div -2325699978271743. +-757 = -757 rem -2325699978271743. +-2325699978271743 = -757 band -2325699978271743. +-757 = -757 bor -2325699978271743. +2325699978270986 = -757 bxor -2325699978271743. +756 = bnot(-757). +-1 = -757 bsl -877. +-762784881724736388184969362605672971982512332552612289907200349298843658896333157772319531835473043892418893832961361713245271878325525191685977948563471335830018462728971192771396177065000182871130646346122493022804369769311775658227284340604108071713601504782843904 = -757 bsr -877. +-399326552934552554555 = -399326552934552554837 + 282. +-399326552934552555119 = -399326552934552554837 - 282. +-112610087927543820464034 = -399326552934552554837 * 282. +399326552934552554837 = -(-399326552934552554837). +-399326552934552554837 = +(-399326552934552554837). +-1416051606150895584 = -399326552934552554837 div 282. +-149 = -399326552934552554837 rem 282. +10 = -399326552934552554837 band 282. +-399326552934552554565 = -399326552934552554837 bor 282. +-399326552934552554575 = -399326552934552554837 bxor 282. +399326552934552554836 = bnot(-399326552934552554837). +-162519239404282077726356668430744933325304730894253957182797269749815524173310489155599580175893087324766269535394202666586959435660185747865985481001922616246731215114933426566027267436359691332683403034291364290584270445935905624013135372400880425231187968 = -399326552934552554837 bsl 786. +-1 = -399326552934552554837 bsr 786. +7788556563963559887277654637 = 7788556563963286199292257816 + 273687985396821. +7788556563963012511306860995 = 7788556563963286199292257816 - 273687985396821. +2131634355140298218131081660650893798802936 = 7788556563963286199292257816 * 273687985396821. +-7788556563963286199292257816 = -(7788556563963286199292257816). +7788556563963286199292257816 = +(7788556563963286199292257816). +28457794932688 = 7788556563963286199292257816 div 273687985396821. +46202628072968 = 7788556563963286199292257816 rem 273687985396821. +220625256055824 = 7788556563963286199292257816 band 273687985396821. +7788556563963339262021598813 = 7788556563963286199292257816 bor 273687985396821. +7788556563963118636765542989 = 7788556563963286199292257816 bxor 273687985396821. +-7788556563963286199292257817 = bnot(7788556563963286199292257816). +1122449294055010765489568052730189407481495552 = 7788556563963286199292257816 bsl 57. +54043967661 = 7788556563963286199292257816 bsr 57. +455741584345907566712 = 455741584345945741559 + -38174847. +455741584345983916406 = 455741584345945741559 - -38174847. +-17397865253944073754316366473 = 455741584345945741559 * -38174847. +-455741584345945741559 = -(455741584345945741559). +455741584345945741559 = +(455741584345945741559). +-11938268785882 = 455741584345945741559 div -38174847. +24631505 = 455741584345945741559 rem -38174847. +455741584345941416065 = 455741584345945741559 band -38174847. +-33849353 = 455741584345945741559 bor -38174847. +-455741584345975265418 = 455741584345945741559 bxor -38174847. +-455741584345945741560 = bnot(455741584345945741559). +233339691185124219678208 = 455741584345945741559 bsl 9. +890120281925675276 = 455741584345945741559 bsr 9. +-374898793368034 = -374967657234849 + 68863866815. +-375036521101664 = -374967657234849 - 68863866815. +-25821722807753212712635935 = -374967657234849 * 68863866815. +374967657234849 = -(-374967657234849). +-374967657234849 = +(-374967657234849). +-5445 = -374967657234849 div 68863866815. +-3902427174 = -374967657234849 rem 68863866815. +68863669791 = -374967657234849 band 68863866815. +-374967657037825 = -374967657234849 bor 68863866815. +-375036520707616 = -374967657234849 bxor 68863866815. +374967657234848 = bnot(-374967657234849). +-5858869644295 = -374967657234849 bsl -6. +-23997930063030336 = -374967657234849 bsr -6. +695698116237678489407423938 = 695698116237678482758846255 + 6648577683. +695698116237678476110268572 = 695698116237678482758846255 - 6648577683. +4625402969722969084199765481821127165 = 695698116237678482758846255 * 6648577683. +-695698116237678482758846255 = -(695698116237678482758846255). +695698116237678482758846255 = +(695698116237678482758846255). +104638638428868077 = 695698116237678482758846255 div 6648577683. +3065520664 = 695698116237678482758846255 rem 6648577683. +4295493123 = 695698116237678482758846255 band 6648577683. +695698116237678485111930815 = 695698116237678482758846255 bor 6648577683. +695698116237678480816437692 = 695698116237678482758846255 bxor 6648577683. +-695698116237678482758846256 = bnot(695698116237678482758846255). +5435141533106863146553486 = 695698116237678482758846255 bsl -7. +89049358878422845793132320640 = 695698116237678482758846255 bsr -7. +867155941797334727149668788 = -2397633985559 + 867155941797337124783654347. +-867155941797339522417639906 = -2397633985559 - 867155941797337124783654347. +-2079122556832717644348186887614245574973 = -2397633985559 * 867155941797337124783654347. +2397633985559 = -(-2397633985559). +-2397633985559 = +(-2397633985559). +0 = -2397633985559 div 867155941797337124783654347. +-2397633985559 = -2397633985559 rem 867155941797337124783654347. +867155941797334891131568585 = -2397633985559 band 867155941797337124783654347. +-163981899797 = -2397633985559 bor 867155941797337124783654347. +-867155941797335055113468382 = -2397633985559 bxor 867155941797337124783654347. +2397633985558 = bnot(-2397633985559). +-4682878879 = -2397633985559 bsl -9. +-1227588600606208 = -2397633985559 bsr -9. +-99391269544746942 = -999 + -99391269544745943. +99391269544744944 = -999 - -99391269544745943. +99291878275201197057 = -999 * -99391269544745943. +999 = -(-999). +-999 = +(-999). +0 = -999 div -99391269544745943. +-999 = -999 rem -99391269544745943. +-99391269544745975 = -999 band -99391269544745943. +-967 = -999 bor -99391269544745943. +99391269544745008 = -999 bxor -99391269544745943. +998 = bnot(-999). +-271670709669862569774540092593109073255558924599964104333437283359848016026107591934168749958637596868208865360261250311337591172257307920471096554899364231471046369057053606816100556734464 = -999 bsl 616. +-1 = -999 bsr 616. +51170326738252384475287511615 = -53532239445214813437776259 + 51223858977697599288725287874. +-51277391217142814102163064133 = -53532239445214813437776259 - 51223858977697599288725287874. +-2742127884102024373168869308493551385093294966177783366 = -53532239445214813437776259 * 51223858977697599288725287874. +53532239445214813437776259 = -(-53532239445214813437776259). +-53532239445214813437776259 = +(-53532239445214813437776259). +0 = -53532239445214813437776259 div 51223858977697599288725287874. +-53532239445214813437776259 = -53532239445214813437776259 rem 51223858977697599288725287874. +51223547227586499364060668480 = -53532239445214813437776259 band 51223858977697599288725287874. +-53220489334114888773156865 = -53532239445214813437776259 bor 51223858977697599288725287874. +-51276767716920614252833825345 = -53532239445214813437776259 bxor 51223858977697599288725287874. +53532239445214813437776258 = bnot(-53532239445214813437776259). +-1713031662246874030008840288 = -53532239445214813437776259 bsl 5. +-1672882482662962919930509 = -53532239445214813437776259 bsr 5. +73264835839749594226010 = 8662 + 73264835839749594217348. +-73264835839749594208686 = 8662 - 73264835839749594217348. +634620008043910985110668376 = 8662 * 73264835839749594217348. +-8662 = -(8662). +8662 = +(8662). +0 = 8662 div 73264835839749594217348. +8662 = 8662 rem 73264835839749594217348. +8580 = 8662 band 73264835839749594217348. +73264835839749594217430 = 8662 bor 73264835839749594217348. +73264835839749594208850 = 8662 bxor 73264835839749594217348. +-8663 = bnot(8662). +67 = 8662 bsl -7. +1108736 = 8662 bsr -7. +-88648668659335769732449251 = -88648668659335769732446832 + -2419. +-88648668659335769732444413 = -88648668659335769732446832 - -2419. +214441129486933226982788886608 = -88648668659335769732446832 * -2419. +88648668659335769732446832 = -(-88648668659335769732446832). +-88648668659335769732446832 = +(-88648668659335769732446832). +36646824580130537301548 = -88648668659335769732446832 div -2419. +-2220 = -88648668659335769732446832 rem -2419. +-88648668659335769732447104 = -88648668659335769732446832 band -2419. +-2147 = -88648668659335769732446832 bor -2419. +88648668659335769732444957 = -88648668659335769732446832 bxor -2419. +88648668659335769732446831 = bnot(-88648668659335769732446832). +-1 = -88648668659335769732446832 bsl -277. +-21526876367714690857102338451583587804202513123842334826095893895994143205595507487537586045998436466561122304 = -88648668659335769732446832 bsr -277. +472407689385533914110659 = -92176733159392931236298 + 564584422544926845346957. +-656761155704319776583255 = -92176733159392931236298 - 564584422544926845346957. +-52041547662873668367867286690437311862762245186 = -92176733159392931236298 * 564584422544926845346957. +92176733159392931236298 = -(-92176733159392931236298). +-92176733159392931236298 = +(-92176733159392931236298). +0 = -92176733159392931236298 div 564584422544926845346957. +-92176733159392931236298 = -92176733159392931236298 rem 564584422544926845346957. +472421606637668457948164 = -92176733159392931236298 band 564584422544926845346957. +-13917252134543837505 = -92176733159392931236298 bor 564584422544926845346957. +-472435523889803001785669 = -92176733159392931236298 bxor 564584422544926845346957. +92176733159392931236297 = bnot(-92176733159392931236298). +-197948027185855697436738379055104 = -92176733159392931236298 bsl 31. +-42923136222825 = -92176733159392931236298 bsr 31. +926565856438049866558555264 = 933124279636981428678231393 + -6558423198931562119676129. +939682702835912990797907522 = 933124279636981428678231393 - -6558423198931562119676129. +-6119823923057481252398382601992868036026185680517697 = 933124279636981428678231393 * -6558423198931562119676129. +-933124279636981428678231393 = -(933124279636981428678231393). +933124279636981428678231393 = +(933124279636981428678231393). +-142 = 933124279636981428678231393 div -6558423198931562119676129. +1828185388699607684221075 = 933124279636981428678231393 rem -6558423198931562119676129. +931552902605547407822423297 = 933124279636981428678231393 band -6558423198931562119676129. +-4987046167497541263868033 = 933124279636981428678231393 bor -6558423198931562119676129. +-936539948773044949086291330 = 933124279636981428678231393 bxor -6558423198931562119676129. +-933124279636981428678231394 = bnot(933124279636981428678231393). +108629963318465909 = 933124279636981428678231393 bsl -33. +8015476528288787976664720680111046656 = 933124279636981428678231393 bsr -33. +-272843753421484620759016887177 = -272836611788825721137484413564 + -7141632658899621532473613. +-272829470156166821515951939951 = -272836611788825721137484413564 - -7141632658899621532473613. +1948498857294595260358231217824490200133654665609286732 = -272836611788825721137484413564 * -7141632658899621532473613. +272836611788825721137484413564 = -(-272836611788825721137484413564). +-272836611788825721137484413564 = +(-272836611788825721137484413564). +38203 = -272836611788825721137484413564 div -7141632658899621532473613. +-4819320883479732394976125 = -272836611788825721137484413564 rem -7141632658899621532473613. +-272837556339268983097432947584 = -272836611788825721137484413564 band -7141632658899621532473613. +-6197082215637661583939593 = -272836611788825721137484413564 bor -7141632658899621532473613. +272831359257053345435849007991 = -272836611788825721137484413564 bxor -7141632658899621532473613. +272836611788825721137484413563 = bnot(-272836611788825721137484413564). +-1 = -272836611788825721137484413564 bsl -975. +-87126129236002257870538958730310744500573154348629344446020418054995206413443356585847042214910091639020918677712597473077059225043718786652309645154890346722009375561018953488114368585295148197269160637768429141827421422749860346865955452200127047946305111734795397098009767822432538074840838252544803626856997705431908352 = -272836611788825721137484413564 bsr -975. +542255456896764093697 = 542255456889625635573 + 7138458124. +542255456882487177449 = 542255456889625635573 - 7138458124. +3870867871517079889574745245052 = 542255456889625635573 * 7138458124. +-542255456889625635573 = -(542255456889625635573). +542255456889625635573 = +(542255456889625635573). +75962546458 = 542255456889625635573 div 7138458124. +6788110781 = 542255456889625635573 rem 7138458124. +692333060 = 542255456889625635573 band 7138458124. +542255456896071760637 = 542255456889625635573 bor 7138458124. +542255456895379427577 = 542255456889625635573 bxor 7138458124. +-542255456889625635574 = bnot(542255456889625635573). +8676087310234010169168 = 542255456889625635573 bsl 4. +33890966055601602223 = 542255456889625635573 bsr 4. +55994598326593711852577100 = -5774543 + 55994598326593711858351643. +-55994598326593711864126186 = -5774543 - 55994598326593711858351643. +-323343215804643432655661471624149 = -5774543 * 55994598326593711858351643. +5774543 = -(-5774543). +-5774543 = +(-5774543). +0 = -5774543 div 55994598326593711858351643. +-5774543 = -5774543 rem 55994598326593711858351643. +55994598326593711857820177 = -5774543 band 55994598326593711858351643. +-5243077 = -5774543 bor 55994598326593711858351643. +-55994598326593711863063254 = -5774543 bxor 55994598326593711858351643. +5774542 = bnot(-5774543). +-1443636 = -5774543 bsl -2. +-23098172 = -5774543 bsr -2. +-242182668347924615038 = -242182668347924614996 + -42. +-242182668347924614954 = -242182668347924614996 - -42. +10171672070612833829832 = -242182668347924614996 * -42. +242182668347924614996 = -(-242182668347924614996). +-242182668347924614996 = +(-242182668347924614996). +5766254008283919404 = -242182668347924614996 div -42. +-28 = -242182668347924614996 rem -42. +-242182668347924615036 = -242182668347924614996 band -42. +-2 = -242182668347924614996 bor -42. +242182668347924615034 = -242182668347924614996 bxor -42. +242182668347924614995 = bnot(-242182668347924614996). +-3874922693566793839936 = -242182668347924614996 bsl 4. +-15136416771745288438 = -242182668347924614996 bsr 4. +7797689768344356 = 7797689768344352 + 4. +7797689768344348 = 7797689768344352 - 4. +31190759073377408 = 7797689768344352 * 4. +-7797689768344352 = -(7797689768344352). +7797689768344352 = +(7797689768344352). +1949422442086088 = 7797689768344352 div 4. +0 = 7797689768344352 rem 4. +0 = 7797689768344352 band 4. +7797689768344356 = 7797689768344352 bor 4. +7797689768344356 = 7797689768344352 bxor 4. +-7797689768344353 = bnot(7797689768344352). +4942373057617620444148698860578715267472818176 = 7797689768344352 bsl 99. +0 = 7797689768344352 bsr 99. +3825348573927459346362328 = -67412241 + 3825348573927459413774569. +-3825348573927459481186810 = -67412241 - 3825348573927459413774569. +-257875319974604210519089965099129 = -67412241 * 3825348573927459413774569. +67412241 = -(-67412241). +-67412241 = +(-67412241). +0 = -67412241 div 3825348573927459413774569. +-67412241 = -67412241 rem 3825348573927459413774569. +3825348573927459413774569 = -67412241 band 3825348573927459413774569. +-67412241 = -67412241 bor 3825348573927459413774569. +-3825348573927459481186810 = -67412241 bxor 3825348573927459413774569. +67412240 = bnot(-67412241). +-1078595856 = -67412241 bsl 4. +-4213266 = -67412241 bsr 4. +4912958129896753774 = -71229483 + 4912958129967983257. +-4912958130039212740 = -71229483 - 4912958129967983257. +-349947467598266253948766131 = -71229483 * 4912958129967983257. +71229483 = -(-71229483). +-71229483 = +(-71229483). +0 = -71229483 div 4912958129967983257. +-71229483 = -71229483 rem 4912958129967983257. +4912958129899113105 = -71229483 band 4912958129967983257. +-2359331 = -71229483 bor 4912958129967983257. +-4912958129901472436 = -71229483 bxor 4912958129967983257. +71229482 = bnot(-71229483). +-1 = -71229483 bsl -762. +-1727891579105090281002224014699820654642608174830491410613854965292061717054813855570284937448861315846627197740623061370480532122428365964742753217260345878982568113105352124889753543881032588882929824556216264339246144840554599659077632 = -71229483 bsr -762. +46494293391644389 = 46494293391868173 + -223784. +46494293392091957 = 46494293391868173 - -223784. +-10404678952405827226632 = 46494293391868173 * -223784. +-46494293391868173 = -(46494293391868173). +46494293391868173 = +(46494293391868173). +-207764153790 = 46494293391868173 div -223784. +126813 = 46494293391868173 rem -223784. +46494293391868168 = 46494293391868173 band -223784. +-223779 = 46494293391868173 bor -223784. +-46494293392091947 = 46494293391868173 bxor -223784. +-46494293391868174 = bnot(46494293391868173). +0 = 46494293391868173 bsl -91. +115114294776150565191781242098022401917845504 = 46494293391868173 bsr -91. +-412781543671019436383555080573 = -8847989186169711636 + -412781543662171447197385368937. +412781543653323458011215657301 = -8847989186169711636 - -412781543662171447197385368937. +3652286634573333633165948299445552201166761850932 = -8847989186169711636 * -412781543662171447197385368937. +8847989186169711636 = -(-8847989186169711636). +-8847989186169711636 = +(-8847989186169711636). +0 = -8847989186169711636 div -412781543662171447197385368937. +-8847989186169711636 = -8847989186169711636 rem -412781543662171447197385368937. +-412781543670982818247229615484 = -8847989186169711636 band -412781543662171447197385368937. +-36618136325465089 = -8847989186169711636 bor -412781543662171447197385368937. +412781543670946200110904150395 = -8847989186169711636 bxor -412781543662171447197385368937. +8847989186169711635 = bnot(-8847989186169711636). +-250128699564397448650083420076872233779944628446086238630703601982129156400429730446574616576 = -8847989186169711636 bsl 244. +-1 = -8847989186169711636 bsr 244. +-6743223186536623446244856 = -6743223186536623446251414 + 6558. +-6743223186536623446257972 = -6743223186536623446251414 - 6558. +-44222057657307176560516773012 = -6743223186536623446251414 * 6558. +6743223186536623446251414 = -(-6743223186536623446251414). +-6743223186536623446251414 = +(-6743223186536623446251414). +-1028243852780820897568 = -6743223186536623446251414 div 6558. +-470 = -6743223186536623446251414 rem 6558. +2058 = -6743223186536623446251414 band 6558. +-6743223186536623446246914 = -6743223186536623446251414 bor 6558. +-6743223186536623446248972 = -6743223186536623446251414 bxor 6558. +6743223186536623446251413 = bnot(-6743223186536623446251414). +-93581021 = -6743223186536623446251414 bsl -56. +-485900438882598815873542327663439070101504 = -6743223186536623446251414 bsr -56. +276366 = -7313 + 283679. +-290992 = -7313 - 283679. +-2074544527 = -7313 * 283679. +7313 = -(-7313). +-7313 = +(-7313). +0 = -7313 div 283679. +-7313 = -7313 rem 283679. +278543 = -7313 band 283679. +-2177 = -7313 bor 283679. +-280720 = -7313 bxor 283679. +7312 = bnot(-7313). +-2853668393557606398511702567684678149242437277163616753279126855717542940748618247492474816462914598136476793411355829154301380767829403805612507136 = -7313 bsl 477. +-1 = -7313 bsr 477. +-639444299611848222499 = -3155 + -639444299611848219344. +639444299611848216189 = -3155 - -639444299611848219344. +2017446765275381132030320 = -3155 * -639444299611848219344. +3155 = -(-3155). +-3155 = +(-3155). +0 = -3155 div -639444299611848219344. +-3155 = -3155 rem -639444299611848219344. +-639444299611848220384 = -3155 band -639444299611848219344. +-2115 = -3155 bor -639444299611848219344. +639444299611848218269 = -3155 bxor -639444299611848219344. +3154 = bnot(-3155). +-25240 = -3155 bsl 3. +-395 = -3155 bsr 3. +-36455956348806219 = -36455956348738666 + -67553. +-36455956348671113 = -36455956348738666 - -67553. +2462709219226343104298 = -36455956348738666 * -67553. +36455956348738666 = -(-36455956348738666). +-36455956348738666 = +(-36455956348738666). +539664505628 = -36455956348738666 div -67553. +-50382 = -36455956348738666 rem -67553. +-36455956348739562 = -36455956348738666 band -67553. +-66657 = -36455956348738666 bor -67553. +36455956348672905 = -36455956348738666 bxor -67553. +36455956348738665 = bnot(-36455956348738666). +-328366062855229048242919725596672 = -36455956348738666 bsl 53. +-5 = -36455956348738666 bsr 53. +-679412090374 = -679451664999 + 39574625. +-679491239624 = -679451664999 - 39574625. +-26889044847961050375 = -679451664999 * 39574625. +679451664999 = -(-679451664999). +-679451664999 = +(-679451664999). +-17168 = -679451664999 div 39574625. +-34502999 = -679451664999 rem 39574625. +154625 = -679451664999 band 39574625. +-679412244999 = -679451664999 bor 39574625. +-679412399624 = -679451664999 bxor 39574625. +679451664998 = bnot(-679451664999). +-155670007609233581977874185118449598377546383149890798288746270941756522693250308637177806401228008507407190240376022799438910969536738155724260046465671742417127808182973484591722793433869805526063007222467423793961010534599949406815404079106073067451699148357632 = -679451664999 bsl 835. +-1 = -679451664999 bsr 835. +-31223276117594453328647389 = -8 + -31223276117594453328647381. +31223276117594453328647373 = -8 - -31223276117594453328647381. +249786208940755626629179048 = -8 * -31223276117594453328647381. +8 = -(-8). +-8 = +(-8). +0 = -8 div -31223276117594453328647381. +-8 = -8 rem -31223276117594453328647381. +-31223276117594453328647384 = -8 band -31223276117594453328647381. +-5 = -8 bor -31223276117594453328647381. +31223276117594453328647379 = -8 bxor -31223276117594453328647381. +7 = bnot(-8). +-645562469521727147413979793000752968582426448207305878207664839135161905504210298657411338320034457858975792993186873344 = -8 bsl 395. +-1 = -8 bsr 395. +-7822355794946638 = 6175 + -7822355794952813. +7822355794958988 = 6175 - -7822355794952813. +-48303047033833620275 = 6175 * -7822355794952813. +-6175 = -(6175). +6175 = +(6175). +0 = 6175 div -7822355794952813. +6175 = 6175 rem -7822355794952813. +6163 = 6175 band -7822355794952813. +-7822355794952801 = 6175 bor -7822355794952813. +-7822355794958964 = 6175 bxor -7822355794952813. +-6176 = bnot(6175). +15288559485174446395004184166400 = 6175 bsl 91. +0 = 6175 bsr 91. +-64646795518781450802 = -27267 + -64646795518781423535. +64646795518781396268 = -27267 - -64646795518781423535. +1762724173410613075528845 = -27267 * -64646795518781423535. +27267 = -(-27267). +-27267 = +(-27267). +0 = -27267 div -64646795518781423535. +-27267 = -27267 rem -64646795518781423535. +-64646795518781423535 = -27267 band -64646795518781423535. +-27267 = -27267 bor -64646795518781423535. +64646795518781396268 = -27267 bxor -64646795518781423535. +27266 = bnot(-27267). +-4219363881399307994459302526976 = -27267 bsl 87. +-1 = -27267 bsr 87. +436976517494451682725159518 = 51571916895 + 436976517494451631153242623. +-436976517494451579581325728 = 51571916895 - 436976517494451631153242623. +22535716645290373145432221563127815585 = 51571916895 * 436976517494451631153242623. +-51571916895 = -(51571916895). +51571916895 = +(51571916895). +0 = 51571916895 div 436976517494451631153242623. +51571916895 = 51571916895 rem 436976517494451631153242623. +34366292063 = 51571916895 band 436976517494451631153242623. +436976517494451648358867455 = 51571916895 bor 436976517494451631153242623. +436976517494451613992575392 = 51571916895 bxor 436976517494451631153242623. +-51571916896 = bnot(51571916895). +6601205362560 = 51571916895 bsl 7. +402905600 = 51571916895 bsr 7. +-912671397920102774968391 = 3249731726658748667948 + -915921129646761523636339. +919170861373420272304287 = 3249731726658748667948 - -915921129646761523636339. +-2976497954130201920617341300258571233417362372 = 3249731726658748667948 * -915921129646761523636339. +-3249731726658748667948 = -(3249731726658748667948). +3249731726658748667948 = +(3249731726658748667948). +0 = 3249731726658748667948 div -915921129646761523636339. +3249731726658748667948 = 3249731726658748667948 rem -915921129646761523636339. +562967133327372 = 3249731726658748667948 band -915921129646761523636339. +-912671398483069908295763 = 3249731726658748667948 bor -915921129646761523636339. +-912671399046037041623135 = 3249731726658748667948 bxor -915921129646761523636339. +-3249731726658748667949 = bnot(3249731726658748667948). +11 = 3249731726658748667948 bsl -68. +959151511518210887716537591521349612863488 = 3249731726658748667948 bsr -68. +-62758589555098529255606427693 = -26295371273478989759811 + -62758563259727255776616667882. +62758536964355982297626908071 = -26295371273478989759811 - -62758563259727255776616667882. +1650259721504646028505429441211136333805018338090302 = -26295371273478989759811 * -62758563259727255776616667882. +26295371273478989759811 = -(-26295371273478989759811). +-26295371273478989759811 = +(-26295371273478989759811). +0 = -26295371273478989759811 div -62758563259727255776616667882. +-26295371273478989759811 = -26295371273478989759811 rem -62758563259727255776616667882. +-62758586872718261130464813036 = -26295371273478989759811 band -62758563259727255776616667882. +-2682380268125141614657 = -26295371273478989759811 bor -62758563259727255776616667882. +62758584190337993005323198379 = -26295371273478989759811 bxor -62758563259727255776616667882. +26295371273478989759810 = bnot(-26295371273478989759811). +-841451880751327672313952 = -26295371273478989759811 bsl 5. +-821730352296218429995 = -26295371273478989759811 bsr 5. +-23513526692704330458733 = -23513526661191814622388 + -31512515836345. +-23513526629679298786043 = -23513526661191814622388 - -31512515836345. +740970381279127431619689386181091860 = -23513526661191814622388 * -31512515836345. +23513526661191814622388 = -(-23513526661191814622388). +-23513526661191814622388 = +(-23513526661191814622388). +746164691 = -23513526661191814622388 div -31512515836345. +-19532841127993 = -23513526661191814622388 rem -31512515836345. +-23513526679471195684284 = -23513526661191814622388 band -31512515836345. +-13233134774449 = -23513526661191814622388 bor -31512515836345. +23513526666238060909835 = -23513526661191814622388 bxor -31512515836345. +23513526661191814622387 = bnot(-23513526661191814622388). +-1298275173872345034147165274034282455511155004697235724928149296177900551399900966119521910784 = -23513526661191814622388 bsl 235. +-1 = -23513526661191814622388 bsr 235. +9482913998 = 3 + 9482913995. +-9482913992 = 3 - 9482913995. +28448741985 = 3 * 9482913995. +-3 = -(3). +3 = +(3). +0 = 3 div 9482913995. +3 = 3 rem 9482913995. +3 = 3 band 9482913995. +9482913995 = 3 bor 9482913995. +9482913992 = 3 bxor 9482913995. +-4 = bnot(3). +96 = 3 bsl 5. +0 = 3 bsr 5. +-55166011823650092204876573962 = 647941623139971541625682 + -55166659765273232176418199644. +55167307706896372147959825326 = 647941623139971541625682 - -55166659765273232176418199644. +-35744775071521699508529009213111107931222023393657208 = 647941623139971541625682 * -55166659765273232176418199644. +-647941623139971541625682 = -(647941623139971541625682). +647941623139971541625682 = +(647941623139971541625682). +0 = 647941623139971541625682 div -55166659765273232176418199644. +647941623139971541625682 = 647941623139971541625682 rem -55166659765273232176418199644. +5398843323464184029952 = 647941623139971541625682 band -55166659765273232176418199644. +-55166017222493415669060603914 = 647941623139971541625682 bor -55166659765273232176418199644. +-55166022621336739133244633866 = 647941623139971541625682 bxor -55166659765273232176418199644. +-647941623139971541625683 = bnot(647941623139971541625682). +3059817803972356533925082117027148782131740672 = 647941623139971541625682 bsl 72. +137 = 647941623139971541625682 bsr 72. +-94676213915211394031 = -94676213915211394576 + 545. +-94676213915211395121 = -94676213915211394576 - 545. +-51598536583790210043920 = -94676213915211394576 * 545. +94676213915211394576 = -(-94676213915211394576). +-94676213915211394576 = +(-94676213915211394576). +-173717823697635586 = -94676213915211394576 div 545. +-206 = -94676213915211394576 rem 545. +32 = -94676213915211394576 band 545. +-94676213915211394063 = -94676213915211394576 bor 545. +-94676213915211394095 = -94676213915211394576 bxor 545. +94676213915211394575 = bnot(-94676213915211394576). +-24237110762294117011456 = -94676213915211394576 bsl 8. +-369828960606294511 = -94676213915211394576 bsr 8. +8476635749175533995 = -421 + 8476635749175534416. +-8476635749175534837 = -421 - 8476635749175534416. +-3568663650402899989136 = -421 * 8476635749175534416. +421 = -(-421). +-421 = +(-421). +0 = -421 div 8476635749175534416. +-421 = -421 rem 8476635749175534416. +8476635749175534160 = -421 band 8476635749175534416. +-165 = -421 bor 8476635749175534416. +-8476635749175534325 = -421 bxor 8476635749175534416. +420 = bnot(-421). +-1 = -421 bsl -45. +-14812620649398272 = -421 bsr -45. +217959599599587342411256227 = 593 + 217959599599587342411255634. +-217959599599587342411255041 = 593 - 217959599599587342411255634. +129250042562555294049874590962 = 593 * 217959599599587342411255634. +-593 = -(593). +593 = +(593). +0 = 593 div 217959599599587342411255634. +593 = 593 rem 217959599599587342411255634. +592 = 593 band 217959599599587342411255634. +217959599599587342411255635 = 593 bor 217959599599587342411255634. +217959599599587342411255043 = 593 bxor 217959599599587342411255634. +-594 = bnot(593). +151808 = 593 bsl 8. +2 = 593 bsr 8. +79988115792698 = -563244 + 79988116355942. +-79988116919186 = -563244 - 79988116355942. +-45052826608786195848 = -563244 * 79988116355942. +563244 = -(-563244). +-563244 = +(-563244). +0 = -563244 div 79988116355942. +-563244 = -563244 rem 79988116355942. +79988116316996 = -563244 band 79988116355942. +-524298 = -563244 bor 79988116355942. +-79988116841294 = -563244 bxor 79988116355942. +563243 = bnot(-563244). +-1 = -563244 bsl -863. +-34640394721061065329294333911444814820087240462411338301543274614380197084003586409358386052212163938506038968169842635468627438974162867844936272174280595390147919468853578393758858430914247218108454374614230194304365670276172533634851456485821480532627746981937152 = -563244 bsr -863. +-8556525880857951556791276 = 726465657566678 + -8556525881584417214357954. +8556525882310882871924632 = 726465657566678 - -8556525881584417214357954. +-6216022201051522826115155263983714656812 = 726465657566678 * -8556525881584417214357954. +-726465657566678 = -(726465657566678). +726465657566678 = +(726465657566678). +0 = 726465657566678 div -8556525881584417214357954. +726465657566678 = 726465657566678 rem -8556525881584417214357954. +21996143711254 = 726465657566678 band -8556525881584417214357954. +-8556525880879947700502530 = 726465657566678 bor -8556525881584417214357954. +-8556525880901943844213784 = 726465657566678 bxor -8556525881584417214357954. +-726465657566679 = bnot(726465657566678). +185975208337069568 = 726465657566678 bsl 8. +2837756474869 = 726465657566678 bsr 8. +9789649 = -28126 + 9817775. +-9845901 = -28126 - 9817775. +-276134739650 = -28126 * 9817775. +28126 = -(-28126). +-28126 = +(-28126). +0 = -28126 div 9817775. +-28126 = -28126 rem 9817775. +9798178 = -28126 band 9817775. +-8529 = -28126 bor 9817775. +-9806707 = -28126 bxor 9817775. +28125 = bnot(-28126). +-1 = -28126 bsl -64. +-518833123817154848751616 = -28126 bsr -64. +63316455963147 = 9 + 63316455963138. +-63316455963129 = 9 - 63316455963138. +569848103668242 = 9 * 63316455963138. +-9 = -(9). +9 = +(9). +0 = 9 div 63316455963138. +9 = 9 rem 63316455963138. +0 = 9 band 63316455963138. +63316455963147 = 9 bor 63316455963138. +63316455963147 = 9 bxor 63316455963138. +-10 = bnot(9). +144 = 9 bsl 4. +0 = 9 bsr 4. +7296844515889252715100 = 7296838576556419786673 + 5939332832928427. +7296832637223586858246 = 7296838576556419786673 - 5939332832928427. +43338352934320271488477932101217453371 = 7296838576556419786673 * 5939332832928427. +-7296838576556419786673 = -(7296838576556419786673). +7296838576556419786673 = +(7296838576556419786673). +1228561 = 7296838576556419786673 div 5939332832928427. +5892001038583126 = 7296838576556419786673 rem 5939332832928427. +4531096076493473 = 7296838576556419786673 band 5939332832928427. +7296839984793176221627 = 7296838576556419786673 bor 5939332832928427. +7296835453697099728154 = 7296838576556419786673 bxor 5939332832928427. +-7296838576556419786674 = bnot(7296838576556419786673). +0 = 7296838576556419786673 bsl -532. +102587024151951932244548571765698531258935873397019643020672834543681182372243810323536922545540017678616196319719868675345631069947330350527532819302325602914141803302531159931486208 = 7296838576556419786673 bsr -532. +-91245673612382390408697634 = -91245673612417952937469295 + 35562528771661. +-91245673612453515466240956 = -91245673612417952937469295 - 35562528771661. +-3244926893131202344473484034258253648995 = -91245673612417952937469295 * 35562528771661. +91245673612417952937469295 = -(-91245673612417952937469295). +-91245673612417952937469295 = +(-91245673612417952937469295). +-2565781364938 = -91245673612417952937469295 div 35562528771661. +-18695824047277 = -91245673612417952937469295 rem 35562528771661. +378108185089 = -91245673612417952937469295 band 35562528771661. +-91245673612382768516882723 = -91245673612417952937469295 bor 35562528771661. +-91245673612383146625067812 = -91245673612417952937469295 bxor 35562528771661. +91245673612417952937469294 = bnot(-91245673612417952937469295). +-1 = -91245673612417952937469295 bsl -686. +-29294717018410934065107356110468495676928046273552651572128166411163755894770684486824260955216737260266573314290990495657167626170151376088394384892210106258096923019338891602242482231931183866946163680066951951064290274210354298880 = -91245673612417952937469295 bsr -686. +-9199662011147518 = -9283927165491291 + 84265154343773. +-9368192319835064 = -9283927165491291 - 84265154343773. +-782311555516470615236251580943 = -9283927165491291 * 84265154343773. +9283927165491291 = -(-9283927165491291). +-9283927165491291 = +(-9283927165491291). +-110 = -9283927165491291 div 84265154343773. +-14760187676261 = -9283927165491291 rem 84265154343773. +4402375435013 = -9283927165491291 band 84265154343773. +-9204064386582531 = -9283927165491291 bor 84265154343773. +-9208466762017544 = -9283927165491291 bxor 84265154343773. +9283927165491290 = bnot(-9283927165491291). +-74271417323930328 = -9283927165491291 bsl 3. +-1160490895686412 = -9283927165491291 bsr 3. +6122188 = -584 + 6122772. +-6123356 = -584 - 6122772. +-3575698848 = -584 * 6122772. +584 = -(-584). +-584 = +(-584). +0 = -584 div 6122772. +-584 = -584 rem 6122772. +6122768 = -584 band 6122772. +-580 = -584 bor 6122772. +-6123348 = -584 bxor 6122772. +583 = bnot(-584). +-40656514292775909541113955958999178066065146610003036490756964576006724512479669093619584378194349631816514721542040006552767998615772335677788607951626176238085401761267009442877174808838144 = -584 bsl 624. +-1 = -584 bsr 624. +53933372059795890975 = 37215668448636 + 53933334844127442339. +-53933297628458993703 = 37215668448636 - 53933334844127442339. +2007165107888314254907326673199604 = 37215668448636 * 53933334844127442339. +-37215668448636 = -(37215668448636). +37215668448636 = +(37215668448636). +0 = 37215668448636 div 53933334844127442339. +37215668448636 = 37215668448636 rem 53933334844127442339. +35494148744480 = 37215668448636 band 53933334844127442339. +53933336565647146495 = 37215668448636 bor 53933334844127442339. +53933301071498402015 = 37215668448636 bxor 53933334844127442339. +-37215668448637 = bnot(37215668448636). +595450695178176 = 37215668448636 bsl 4. +2325979278039 = 37215668448636 bsr 4. +9566197812430892 = 9534647661 + 9566188277783231. +-9566178743135570 = 9534647661 - 9566188277783231. +91210234687451501719172691 = 9534647661 * 9566188277783231. +-9534647661 = -(9534647661). +9534647661 = +(9534647661). +0 = 9534647661 div 9566188277783231. +9534647661 = 9534647661 rem 9566188277783231. +395309 = 9534647661 band 9566188277783231. +9566197812035583 = 9534647661 bor 9566188277783231. +9566197811640274 = 9534647661 bxor 9566188277783231. +-9534647662 = bnot(9534647661). +0 = 9534647661 bsl -793. +496696626687282375377939935965836735613470956377184826911039002953819968230271768556956314417265994372395239252551698187320658279355797931861652732925518299196794659366716565832577633856476303462101737891022331623015356684381760015565255495240384512 = 9534647661 bsr -793. +938397723693288956 = 938397723693288917 + 39. +938397723693288878 = 938397723693288917 - 39. +36597511224038267763 = 938397723693288917 * 39. +-938397723693288917 = -(938397723693288917). +938397723693288917 = +(938397723693288917). +24061480094699715 = 938397723693288917 div 39. +32 = 938397723693288917 rem 39. +5 = 938397723693288917 band 39. +938397723693288951 = 938397723693288917 bor 39. +938397723693288946 = 938397723693288917 bxor 39. +-938397723693288918 = bnot(938397723693288917). +58649857730830557 = 938397723693288917 bsl -4. +15014363579092622672 = 938397723693288917 bsr -4. +43959977489574816370 = -9768 + 43959977489574826138. +-43959977489574835906 = -9768 - 43959977489574826138. +-429401060118166901715984 = -9768 * 43959977489574826138. +9768 = -(-9768). +-9768 = +(-9768). +0 = -9768 div 43959977489574826138. +-9768 = -9768 rem 43959977489574826138. +43959977489574826136 = -9768 band 43959977489574826138. +-9766 = -9768 bor 43959977489574826138. +-43959977489574835902 = -9768 bxor 43959977489574826138. +9767 = bnot(-9768). +-1 = -9768 bsl -94. +-193475172859833512403434326720512 = -9768 bsr -94. +2962685 = 2962587 + 98. +2962489 = 2962587 - 98. +290333526 = 2962587 * 98. +-2962587 = -(2962587). +2962587 = +(2962587). +30230 = 2962587 div 98. +47 = 2962587 rem 98. +2 = 2962587 band 98. +2962683 = 2962587 bor 98. +2962681 = 2962587 bxor 98. +-2962588 = bnot(2962587). +46290 = 2962587 bsl -6. +189605568 = 2962587 bsr -6. +-889113815585846537540801435783 = -889113815585846533226317722798 + -4314483712985. +-889113815585846528911834009813 = -889113815585846533226317722798 - -4314483712985. +3836067076335083713688673459976825023132030 = -889113815585846533226317722798 * -4314483712985. +889113815585846533226317722798 = -(-889113815585846533226317722798). +-889113815585846533226317722798 = +(-889113815585846533226317722798). +206076526122915435 = -889113815585846533226317722798 div -4314483712985. +-734351299323 = -889113815585846533226317722798 rem -4314483712985. +-889113815585846533930864343038 = -889113815585846533226317722798 band -4314483712985. +-3609937092745 = -889113815585846533226317722798 bor -4314483712985. +889113815585846530320927250293 = -889113815585846533226317722798 bxor -4314483712985. +889113815585846533226317722797 = bnot(-889113815585846533226317722798). +-1791816582989376561490997744830221417691895980460967584164720991418785143992020564566076037250058614790535884958141103004067848722060363009988868482825768479955320716208227978961243998689015388323903187582743175153472415090077713829853735621254211466096507757345074364569772653221305600664666112 = -889113815585846533226317722798 bsl 878. +-1 = -889113815585846533226317722798 bsr 878. +-28463619149739495954188715 = -28463619149739495954188711 + -4. +-28463619149739495954188707 = -28463619149739495954188711 - -4. +113854476598957983816754844 = -28463619149739495954188711 * -4. +28463619149739495954188711 = -(-28463619149739495954188711). +-28463619149739495954188711 = +(-28463619149739495954188711). +7115904787434873988547177 = -28463619149739495954188711 div -4. +-3 = -28463619149739495954188711 rem -4. +-28463619149739495954188712 = -28463619149739495954188711 band -4. +-3 = -28463619149739495954188711 bor -4. +28463619149739495954188709 = -28463619149739495954188711 bxor -4. +28463619149739495954188710 = bnot(-28463619149739495954188711). +-53017622138819650 = -28463619149739495954188711 bsl -29. +-15281289171741307755345603494674432 = -28463619149739495954188711 bsr -29. +-39144435271099 = -39144434357238 + -913861. +-39144433443377 = -39144434357238 - -913861. +35772571926139875918 = -39144434357238 * -913861. +39144434357238 = -(-39144434357238). +-39144434357238 = +(-39144434357238). +42834122 = -39144434357238 div -913861. +-792196 = -39144434357238 rem -913861. +-39144434693110 = -39144434357238 band -913861. +-577989 = -39144434357238 bor -913861. +39144434115121 = -39144434357238 bxor -913861. +39144434357237 = bnot(-39144434357238). +-156577737428952 = -39144434357238 bsl 2. +-9786108589310 = -39144434357238 bsr 2. +-2267949984571668733125 = -2267949984568444421677 + -3224311448. +-2267949984565220110229 = -2267949984568444421677 - -3224311448. +7312577098735458688364890458296 = -2267949984568444421677 * -3224311448. +2267949984568444421677 = -(-2267949984568444421677). +-2267949984568444421677 = +(-2267949984568444421677). +703390482323 = -2267949984568444421677 div -3224311448. +-153887973 = -2267949984568444421677 rem -3224311448. +-2267949984568447047360 = -2267949984568444421677 band -3224311448. +-3221685765 = -2267949984568444421677 bor -3224311448. +2267949984565225361595 = -2267949984568444421677 bxor -3224311448. +2267949984568444421676 = bnot(-2267949984568444421677). +-4429589813610243012 = -2267949984568444421677 bsl -9. +-1161190392099043543898624 = -2267949984568444421677 bsr -9. +-24642187589952063846 = -917727727296215997 + -23724459862655847849. +22806732135359631852 = -917727727296215997 - -23724459862655847849. +21772594631085447961223694261471840453 = -917727727296215997 * -23724459862655847849. +917727727296215997 = -(-917727727296215997). +-917727727296215997 = +(-917727727296215997). +0 = -917727727296215997 div -23724459862655847849. +-917727727296215997 = -917727727296215997 rem -23724459862655847849. +-24048798206334435261 = -917727727296215997 band -23724459862655847849. +-593389383617628585 = -917727727296215997 bor -23724459862655847849. +23455408822716806676 = -917727727296215997 bxor -23724459862655847849. +917727727296215996 = bnot(-917727727296215997). +-3584873934750844 = -917727727296215997 bsl -8. +-234938298187831295232 = -917727727296215997 bsr -8. +68879551139130795 = 68879551138896923 + 233872. +68879551138663051 = 68879551138896923 - 233872. +16108998383956101175856 = 68879551138896923 * 233872. +-68879551138896923 = -(68879551138896923). +68879551138896923 = +(68879551138896923). +294518160099 = 68879551138896923 div 233872. +223595 = 68879551138896923 rem 233872. +4112 = 68879551138896923 band 233872. +68879551139126683 = 68879551138896923 bor 233872. +68879551139122571 = 68879551138896923 bxor 233872. +-68879551138896924 = bnot(68879551138896923). +8816582545778806144 = 68879551138896923 bsl 7. +538121493272632 = 68879551138896923 bsr 7. +-524372124561571424235676612096 = 6114152 + -524372124561571424235682726248. +524372124561571424235688840400 = 6114152 - -524372124561571424235682726248. +-3206090874132381046633448012054661696 = 6114152 * -524372124561571424235682726248. +-6114152 = -(6114152). +6114152 = +(6114152). +0 = 6114152 div -524372124561571424235682726248. +6114152 = 6114152 rem -524372124561571424235682726248. +5261832 = 6114152 band -524372124561571424235682726248. +-524372124561571424235681873928 = 6114152 bor -524372124561571424235682726248. +-524372124561571424235687135760 = 6114152 bxor -524372124561571424235682726248. +-6114153 = bnot(6114152). +0 = 6114152 bsl -77. +923944527231053024723514425344 = 6114152 bsr -77. +9493229794381587 = -2 + 9493229794381589. +-9493229794381591 = -2 - 9493229794381589. +-18986459588763178 = -2 * 9493229794381589. +2 = -(-2). +-2 = +(-2). +0 = -2 div 9493229794381589. +-2 = -2 rem 9493229794381589. +9493229794381588 = -2 band 9493229794381589. +-1 = -2 bor 9493229794381589. +-9493229794381589 = -2 bxor 9493229794381589. +1 = bnot(-2). +-562949953421312 = -2 bsl 48. +-1 = -2 bsr 48. +338654 = 337727 + 927. +336800 = 337727 - 927. +313072929 = 337727 * 927. +-337727 = -(337727). +337727 = +(337727). +364 = 337727 div 927. +299 = 337727 rem 927. +799 = 337727 band 927. +337855 = 337727 bor 927. +337056 = 337727 bxor 927. +-337728 = bnot(337727). +0 = 337727 bsl -588. +342139512825066188696171867817584175304682721844858761456258145259871851083995905654085415654237920686906788977435249420947941207823631015480153949487501614780300719462251368873459712 = 337727 bsr -588. +39138662259334119678064 = -322563763953267 + 39138662581897883631331. +-39138662904461647584598 = -322563763953267 - 39138662581897883631331. +-12624714318513872489316281894141008377 = -322563763953267 * 39138662581897883631331. +322563763953267 = -(-322563763953267). +-322563763953267 = +(-322563763953267). +0 = -322563763953267 div 39138662581897883631331. +-322563763953267 = -322563763953267 rem 39138662581897883631331. +39138662260743179346049 = -322563763953267 band 39138662581897883631331. +-1409059667985 = -322563763953267 bor 39138662581897883631331. +-39138662262152239014034 = -322563763953267 bxor 39138662581897883631331. +322563763953266 = bnot(-322563763953267). +-181587255892894736365129826304 = -322563763953267 bsl 49. +-1 = -322563763953267 bsr 49. +-6288977272882750121716142727 = 2621979282859 + -6288977272882752743695425586. +6288977272882755365674708445 = 2621979282859 - -6288977272882752743695425586. +-16489568119869669586504346611499079830374 = 2621979282859 * -6288977272882752743695425586. +-2621979282859 = -(2621979282859). +2621979282859 = +(2621979282859). +0 = 2621979282859 div -6288977272882752743695425586. +2621979282859 = 2621979282859 rem -6288977272882752743695425586. +285349006730 = 2621979282859 band -6288977272882752743695425586. +-6288977272882750407065149457 = 2621979282859 bor -6288977272882752743695425586. +-6288977272882750692414156187 = 2621979282859 bxor -6288977272882752743695425586. +-2621979282860 = bnot(2621979282859). +45633792032927766636558829632437146623729424500201394081270271387439117523627148615542082354664238135683294503022951256421709887736295998881361127556508864099138488079282435334867583874528003946971136 = 2621979282859 bsl 622. +0 = 2621979282859 bsr 622. +-981608 = -95 + -981513. +981418 = -95 - -981513. +93243735 = -95 * -981513. +95 = -(-95). +-95 = +(-95). +0 = -95 div -981513. +-95 = -95 rem -981513. +-981599 = -95 band -981513. +-9 = -95 bor -981513. +981590 = -95 bxor -981513. +94 = bnot(-95). +-3040 = -95 bsl 5. +-3 = -95 bsr 5. +-72159589933345004080192207563 = -25565764779621271 + -72159589933319438315412586292. +72159589933293872550632965021 = -25565764779621271 - -72159589933319438315412586292. +1844815102829171715237701492238966502366217132 = -25565764779621271 * -72159589933319438315412586292. +25565764779621271 = -(-25565764779621271). +-25565764779621271 = +(-25565764779621271). +0 = -25565764779621271 div -72159589933319438315412586292. +-25565764779621271 = -25565764779621271 rem -72159589933319438315412586292. +-72159589933344228730818396088 = -25565764779621271 band -72159589933319438315412586292. +-775349373811475 = -25565764779621271 bor -72159589933319438315412586292. +72159589933343453381444584613 = -25565764779621271 bxor -72159589933319438315412586292. +25565764779621270 = bnot(-25565764779621271). +-1 = -25565764779621271 bsl -552. +-376891545469205666692423721188611135467462423258473339765083709194668716109829979210087156306882816693633085329973128696206684696862091342922014883525884084455336719448376222119100416 = -25565764779621271 bsr -552. +853762466 = 4 + 853762462. +-853762458 = 4 - 853762462. +3415049848 = 4 * 853762462. +-4 = -(4). +4 = +(4). +0 = 4 div 853762462. +4 = 4 rem 853762462. +4 = 4 band 853762462. +853762462 = 4 bor 853762462. +853762458 = 4 bxor 853762462. +-5 = bnot(4). +0 = 4 bsl -3. +32 = 4 bsr -3. +1423394379825560705171 = 583911822985914123515 + 839482556839646581656. +-255570733853732458141 = 583911822985914123515 - 839482556839646581656. +490183790129114306563518065187741117240840 = 583911822985914123515 * 839482556839646581656. +-583911822985914123515 = -(583911822985914123515). +583911822985914123515 = +(583911822985914123515). +0 = 583911822985914123515 div 839482556839646581656. +583911822985914123515 = 583911822985914123515 rem 839482556839646581656. +249184450009142952088 = 583911822985914123515 band 839482556839646581656. +1174209929816417753083 = 583911822985914123515 bor 839482556839646581656. +925025479807274800995 = 583911822985914123515 bxor 839482556839646581656. +-583911822985914123516 = bnot(583911822985914123515). +0 = 583911822985914123515 bsl -489. +933286854102346590916038334878114268698088764671016388629042772055499685121238063867877641091156694537038817124889329230541736781305155973928074893116930143895085383680 = 583911822985914123515 bsr -489. +-95896673865189 = -96592446293331 + 695772428142. +-97288218721473 = -96592446293331 - 695772428142. +-67206360897686637451321002 = -96592446293331 * 695772428142. +96592446293331 = -(-96592446293331). +-96592446293331 = +(-96592446293331). +-138 = -96592446293331 div 695772428142. +-575851209735 = -96592446293331 rem 695772428142. +138798215724 = -96592446293331 band 695772428142. +-96035472080913 = -96592446293331 bor 695772428142. +-96174270296637 = -96592446293331 bxor 695772428142. +96592446293330 = bnot(-96592446293331). +-1 = -96592446293331 bsl -221. +-325515900064727033006723633047949897409224347669638580099791894982130765043597312 = -96592446293331 bsr -221. +-7289159845218643776343174512 = -7289159845218643776343173517 + -995. +-7289159845218643776343172522 = -7289159845218643776343173517 - -995. +7252714045992550557461457649415 = -7289159845218643776343173517 * -995. +7289159845218643776343173517 = -(-7289159845218643776343173517). +-7289159845218643776343173517 = +(-7289159845218643776343173517). +7325788789164466106877561 = -7289159845218643776343173517 div -995. +-322 = -7289159845218643776343173517 rem -995. +-7289159845218643776343174127 = -7289159845218643776343173517 band -995. +-385 = -7289159845218643776343173517 bor -995. +7289159845218643776343173742 = -7289159845218643776343173517 bxor -995. +7289159845218643776343173516 = bnot(-7289159845218643776343173517). +-70496428321463939690824451884876015117562414876327936 = -7289159845218643776343173517 bsl 83. +-754 = -7289159845218643776343173517 bsr 83. +35376388787642844912187156 = 593 + 35376388787642844912186563. +-35376388787642844912185970 = 593 - 35376388787642844912186563. +20978198551072207032926631859 = 593 * 35376388787642844912186563. +-593 = -(593). +593 = +(593). +0 = 593 div 35376388787642844912186563. +593 = 593 rem 35376388787642844912186563. +65 = 593 band 35376388787642844912186563. +35376388787642844912187091 = 593 bor 35376388787642844912186563. +35376388787642844912187026 = 593 bxor 35376388787642844912186563. +-594 = bnot(593). +0 = 593 bsl -35. +20375324852224 = 593 bsr -35. +-88383936180025438134421 = -88383944478485252746958 + 8298459814612537. +-88383952776945067359495 = -88383944478485252746958 - 8298459814612537. +-733450611511655493711281995007675412446 = -88383944478485252746958 * 8298459814612537. +88383944478485252746958 = -(-88383944478485252746958). +-88383944478485252746958 = +(-88383944478485252746958). +-10650644 = -88383944478485252746958 div 8298459814612537. +-3244741123223130 = -88383944478485252746958 rem 8298459814612537. +8289244542320688 = -88383944478485252746958 band 8298459814612537. +-88383944469269980455109 = -88383944478485252746958 bor 8298459814612537. +-88383952758514522775797 = -88383944478485252746958 bxor 8298459814612537. +88383944478485252746957 = bnot(-88383944478485252746958). +-1 = -88383944478485252746958 bsl -498. +-72328793436171923303501242904921538868908174232957948869553245322491821288425462681446794260789939913028086656509573167011669502730599213013225742326068691415924548464279552 = -88383944478485252746958 bsr -498. +-432 = -516 + 84. +-600 = -516 - 84. +-43344 = -516 * 84. +516 = -(-516). +-516 = +(-516). +-6 = -516 div 84. +-12 = -516 rem 84. +84 = -516 band 84. +-516 = -516 bor 84. +-600 = -516 bxor 84. +515 = bnot(-516). +-129 = -516 bsl -2. +-2064 = -516 bsr -2. +-5596641981436881743594547168 = -5596641981436935356756388516 + 53613161841348. +-5596641981436988969918229864 = -5596641981436935356756388516 - 53613161841348. +-300053672318860964426375383823133041159568 = -5596641981436935356756388516 * 53613161841348. +5596641981436935356756388516 = -(-5596641981436935356756388516). +-5596641981436935356756388516 = +(-5596641981436935356756388516). +-104389328836797 = -5596641981436935356756388516 div 53613161841348. +-42033257906160 = -5596641981436935356756388516 rem 53613161841348. +17868295372868 = -5596641981436935356756388516 band 53613161841348. +-5596641981436899611889920036 = -5596641981436935356756388516 bor 53613161841348. +-5596641981436917480185292904 = -5596641981436935356756388516 bxor 53613161841348. +5596641981436935356756388515 = bnot(-5596641981436935356756388516). +-1289155062446397240207348514759687647736457136729469815900398414886254960824036212425282575915046285725246915330099303076472005333399133729486620438473826088340577967551488726816896503852826624 = -5596641981436935356756388516 bsl 546. +-1 = -5596641981436935356756388516 bsr 546. +284396196340718960184592278332 = -217734169182222469124 + 284396196558453129366814747456. +-284396196776187298549037216580 = -217734169182222469124 - 284396196558453129366814747456. +-61922769576238829194488665641522602052528817548544 = -217734169182222469124 * 284396196558453129366814747456. +217734169182222469124 = -(-217734169182222469124). +-217734169182222469124 = +(-217734169182222469124). +0 = -217734169182222469124 div 284396196558453129366814747456. +-217734169182222469124 = -217734169182222469124 rem 284396196558453129366814747456. +284396196489160710023662412608 = -217734169182222469124 band 284396196558453129366814747456. +-148441749839070134276 = -217734169182222469124 bor 284396196558453129366814747456. +-284396196637602459862732546884 = -217734169182222469124 bxor 284396196558453129366814747456. +217734169182222469123 = bnot(-217734169182222469124). +-1 = -217734169182222469124 bsl -439. +-309096925320254733711942867352297104175140757235372806325969408707524208701220561286286948547716279158327238545931855047770537522991128544603004429402112 = -217734169182222469124 bsr -439. +985223770122340129850815 = -3398973293555211497613 + 988622743415895341348428. +-992021716709450552846041 = -3398973293555211497613 - 988622743415895341348428. +-3360302302271914570872637267312734552723302364 = -3398973293555211497613 * 988622743415895341348428. +3398973293555211497613 = -(-3398973293555211497613). +-3398973293555211497613 = +(-3398973293555211497613). +0 = -3398973293555211497613 div 988622743415895341348428. +-3398973293555211497613 = -3398973293555211497613 rem 988622743415895341348428. +988175400125004939593280 = -3398973293555211497613 band 988622743415895341348428. +-2951630002664809742465 = -3398973293555211497613 bor 988622743415895341348428. +-991127030127669749335745 = -3398973293555211497613 bxor 988622743415895341348428. +3398973293555211497612 = bnot(-3398973293555211497613). +-217534290787533535847232 = -3398973293555211497613 bsl 6. +-53108957711800179651 = -3398973293555211497613 bsr 6. +-1048780507735075470499531127922 = -299912126399476783966892396589 + -748868381335598686532638731333. +448956254936121902565746334744 = -299912126399476783966892396589 - -748868381335598686532638731333. +224594708639693654151248600938408959574771763247688856623137 = -299912126399476783966892396589 * -748868381335598686532638731333. +299912126399476783966892396589 = -(-299912126399476783966892396589). +-299912126399476783966892396589 = +(-299912126399476783966892396589). +0 = -299912126399476783966892396589 div -748868381335598686532638731333. +-299912126399476783966892396589 = -299912126399476783966892396589 rem -748868381335598686532638731333. +-949414776692567621220798692461 = -299912126399476783966892396589 band -748868381335598686532638731333. +-99365731042507849278732435461 = -299912126399476783966892396589 bor -748868381335598686532638731333. +850049045650059771942066257000 = -299912126399476783966892396589 bxor -748868381335598686532638731333. +299912126399476783966892396588 = bnot(-299912126399476783966892396589). +-2515845262811662145798945293165658112 = -299912126399476783966892396589 bsl 23. +-35752311515745733257162 = -299912126399476783966892396589 bsr 23. +544613 = -84835 + 629448. +-714283 = -84835 - 629448. +-53399221080 = -84835 * 629448. +84835 = -(-84835). +-84835 = +(-84835). +0 = -84835 div 629448. +-84835 = -84835 rem 629448. +561288 = -84835 band 629448. +-16675 = -84835 bor 629448. +-577963 = -84835 bxor 629448. +84834 = bnot(-84835). +-1 = -84835 bsl -97. +-13442642333795230159496602053509120 = -84835 bsr -97. +-36121523960803135913611 = -36121524847967313194856 + 887164177281245. +-36121525735131490476101 = -36121524847967313194856 - 887164177281245. +-32045722873890969789282230872999275720 = -36121524847967313194856 * 887164177281245. +36121524847967313194856 = -(-36121524847967313194856). +-36121524847967313194856 = +(-36121524847967313194856). +-40715716 = -36121524847967313194856 div 887164177281245. +-160410489648436 = -36121524847967313194856 rem 887164177281245. +3092378554520 = -36121524847967313194856 band 887164177281245. +-36121523963895514468131 = -36121524847967313194856 bor 887164177281245. +-36121523966987893022651 = -36121524847967313194856 bxor 887164177281245. +36121524847967313194855 = bnot(-36121524847967313194856). +-1 = -36121524847967313194856 bsl -555. +-4260039921983946223320372338255047661798517726710739357683710915733751398170472437637779148660565183876332275255098994351650385918924882566819183379734039604666474308285291287373178478788608 = -36121524847967313194856 bsr -555. +-5228933976190874131121760902 = -5228933976191629529339534856 + 755398217773954. +-5228933976192384927557308810 = -5228933976191629529339534856 - 755398217773954. +-3949927406472831763397050258582202111940624 = -5228933976191629529339534856 * 755398217773954. +5228933976191629529339534856 = -(-5228933976191629529339534856). +-5228933976191629529339534856 = +(-5228933976191629529339534856). +-6922089373735 = -5228933976191629529339534856 div 755398217773954. +-185139684836666 = -5228933976191629529339534856 rem 755398217773954. +578372112294272 = -5228933976191629529339534856 band 755398217773954. +-5228933976191452503234055174 = -5228933976191629529339534856 bor 755398217773954. +-5228933976192030875346349446 = -5228933976191629529339534856 bxor 755398217773954. +5228933976191629529339534855 = bnot(-5228933976191629529339534856). +-20915735904766518117358139424 = -5228933976191629529339534856 bsl 2. +-1307233494047907382334883714 = -5228933976191629529339534856 bsr 2. +-2313941712627712635797936 = -58825119 + -2313941712627712576972817. +2313941712627712518147698 = -58825119 - -2313941712627712576972817. +136117896604388995038222619790223 = -58825119 * -2313941712627712576972817. +58825119 = -(-58825119). +-58825119 = +(-58825119). +0 = -58825119 div -2313941712627712576972817. +-58825119 = -58825119 rem -2313941712627712576972817. +-2313941712627712585365919 = -58825119 band -2313941712627712576972817. +-50432017 = -58825119 bor -2313941712627712576972817. +2313941712627712534933902 = -58825119 bxor -2313941712627712576972817. +58825118 = bnot(-58825119). +-459572 = -58825119 bsl -7. +-7529615232 = -58825119 bsr -7. +-39532178545449714486969974045 = -39144824719771556967531838878 + -387353825678157519438135167. +-38757470894093399448093703711 = -39144824719771556967531838878 - -387353825678157519438135167. +15162897610704422948379732234328403070831799486629622626 = -39144824719771556967531838878 * -387353825678157519438135167. +39144824719771556967531838878 = -(-39144824719771556967531838878). +-39144824719771556967531838878 = +(-39144824719771556967531838878). +101 = -39144824719771556967531838878 div -387353825678157519438135167. +-22088326277647504280187011 = -39144824719771556967531838878 rem -387353825678157519438135167. +-39454500041501834731337220096 = -39144824719771556967531838878 band -387353825678157519438135167. +-77678503947879755632753949 = -39144824719771556967531838878 bor -387353825678157519438135167. +39376821537553954975704466147 = -39144824719771556967531838878 bxor -387353825678157519438135167. +39144824719771556967531838877 = bnot(-39144824719771556967531838878). +-36261288297047112456574047448012037405591068471788300549971762926424652906450749839118480673786272849854464 = -39144824719771556967531838878 bsl 259. +-1 = -39144824719771556967531838878 bsr 259. +96442260946113395843907062 = 9714399119165457325774274 + 86727861826947938518132788. +-77013462707782481192358514 = 9714399119165457325774274 - 86727861826947938518132788. +842509064538806544487422868581886775245460846295912 = 9714399119165457325774274 * 86727861826947938518132788. +-9714399119165457325774274 = -(9714399119165457325774274). +9714399119165457325774274 = +(9714399119165457325774274). +0 = 9714399119165457325774274 div 86727861826947938518132788. +9714399119165457325774274 = 9714399119165457325774274 rem 86727861826947938518132788. +42842645781906634850304 = 9714399119165457325774274 band 86727861826947938518132788. +96399418300331489209056758 = 9714399119165457325774274 bor 86727861826947938518132788. +96356575654549582574206454 = 9714399119165457325774274 bxor 86727861826947938518132788. +-9714399119165457325774275 = bnot(9714399119165457325774274). +155430385906647317212388384 = 9714399119165457325774274 bsl 4. +607149944947841082860892 = 9714399119165457325774274 bsr 4. +58725190968083356687400 = -259348471451611166831 + 58984539439534967854231. +-59243887910986579021062 = -259348471451611166831 - 58984539439534967854231. +-15297550142920667545306486335476338230211961 = -259348471451611166831 * 58984539439534967854231. +259348471451611166831 = -(-259348471451611166831). +-259348471451611166831 = +(-259348471451611166831). +0 = -259348471451611166831 div 58984539439534967854231. +-259348471451611166831 = -259348471451611166831 rem 58984539439534967854231. +58762157292493824984209 = -259348471451611166831 band 58984539439534967854231. +-36966324410468296809 = -259348471451611166831 bor 58984539439534967854231. +-58799123616904293281018 = -259348471451611166831 bxor 58984539439534967854231. +259348471451611166830 = bnot(-259348471451611166831). +-11781532008619042716132876004244721666502104356517640457399534631670477333637333442414731753378215776210292300440032904923490970981846667962649607139229696 = -259348471451611166831 bsl 444. +-1 = -259348471451611166831 bsr 444. +591644923315353855980747 = 698822196362898 + 591644922616531659617849. +-591644921917709463254951 = 698822196362898 - 591644922616531659617849. +413454604289841479405363865188402166402 = 698822196362898 * 591644922616531659617849. +-698822196362898 = -(698822196362898). +698822196362898 = +(698822196362898). +0 = 698822196362898 div 591644922616531659617849. +698822196362898 = 698822196362898 rem 591644922616531659617849. +20419084056080 = 698822196362898 band 591644922616531659617849. +591644923294934771924667 = 698822196362898 bor 591644922616531659617849. +591644923274515687868587 = 698822196362898 bxor 591644922616531659617849. +-698822196362899 = bnot(698822196362898). +2795288785451592 = 698822196362898 bsl 2. +174705549090724 = 698822196362898 bsr 2. +-71129950541462559969961 = -6896237721355314 + -71129943645224838614647. +71129936748987117259333 = -6896237721355314 - -71129943645224838614647. +490529000484077238376825442807011684158 = -6896237721355314 * -71129943645224838614647. +6896237721355314 = -(-6896237721355314). +-6896237721355314 = +(-6896237721355314). +0 = -6896237721355314 div -71129943645224838614647. +-6896237721355314 = -6896237721355314 rem -71129943645224838614647. +-71129950400634273123960 = -6896237721355314 band -71129943645224838614647. +-140828286846001 = -6896237721355314 bor -71129943645224838614647. +71129950259805986277959 = -6896237721355314 bxor -71129943645224838614647. +6896237721355313 = bnot(-6896237721355314). +-1 = -6896237721355314 bsl -578. +-6822596977107109636132725784345838907142012186166156789606892117950408498673939962039999041421050078931352102357161071567561607022595870779761007920162403830610258693924129685610207763234816 = -6896237721355314 bsr -578. +-7443127918909037783 = -281491387173284 + -7442846427521864499. +7442564936134691215 = -281491387173284 - -7442846427521864499. +2095097165400850810996268880844716 = -281491387173284 * -7442846427521864499. +281491387173284 = -(-281491387173284). +-281491387173284 = +(-281491387173284). +0 = -281491387173284 div -7442846427521864499. +-281491387173284 = -281491387173284 rem -7442846427521864499. +-7443127917531093940 = -281491387173284 band -7442846427521864499. +-1377943843 = -281491387173284 bor -7442846427521864499. +7443127916153150097 = -281491387173284 bxor -7442846427521864499. +281491387173283 = bnot(-281491387173284). +-72061795116360704 = -281491387173284 bsl 8. +-1099575731146 = -281491387173284 bsr 8. +-771246567331013984771121652752 = -771782222179325333442389628311 + 535654848311348671267975559. +-772317877027636682113657603870 = -771782222179325333442389628311 - 535654848311348671267975559. +-413408889150862109611410971768391972038899579623442450849 = -771782222179325333442389628311 * 535654848311348671267975559. +771782222179325333442389628311 = -(-771782222179325333442389628311). +-771782222179325333442389628311 = +(-771782222179325333442389628311). +-1440 = -771782222179325333442389628311 div 535654848311348671267975559. +-439240610983246816504823351 = -771782222179325333442389628311 rem 535654848311348671267975559. +67800214851217117319241729 = -771782222179325333442389628311 band 535654848311348671267975559. +-771314367545865201888440894481 = -771782222179325333442389628311 bor 535654848311348671267975559. +-771382167760716419005760136210 = -771782222179325333442389628311 bxor 535654848311348671267975559. +771782222179325333442389628310 = bnot(-771782222179325333442389628311). +-3644638498094299663555727589154918055519413606547456 = -771782222179325333442389628311 bsl 72. +-163431243 = -771782222179325333442389628311 bsr 72. +873839764774485360398501843 = -3643612469677871 + 873839764778128972868179714. +-873839764781772585337857585 = -3643612469677871 - 873839764778128972868179714. +-3183933463445968379222577364230379716908894 = -3643612469677871 * 873839764778128972868179714. +3643612469677871 = -(-3643612469677871). +-3643612469677871 = +(-3643612469677871). +0 = -3643612469677871 div 873839764778128972868179714. +-3643612469677871 = -3643612469677871 rem 873839764778128972868179714. +873839764774733644420550656 = -3643612469677871 band 873839764778128972868179714. +-248284022048813 = -3643612469677871 bor 873839764778128972868179714. +-873839764774981928442599469 = -3643612469677871 bxor 873839764778128972868179714. +3643612469677870 = bnot(-3643612469677871). +-1865529584475069952 = -3643612469677871 bsl 9. +-7116430604840 = -3643612469677871 bsr 9. +88329617515 = 89922 + 88329527593. +-88329437671 = 89922 - 88329527593. +7942767780217746 = 89922 * 88329527593. +-89922 = -(89922). +89922 = +(89922). +0 = 89922 div 88329527593. +89922 = 89922 rem 88329527593. +65792 = 89922 band 88329527593. +88329551723 = 89922 bor 88329527593. +88329485931 = 89922 bxor 88329527593. +-89923 = bnot(89922). +56994838636861422120693272816910336 = 89922 bsl 99. +0 = 89922 bsr 99. +37972972863670164457235 = 37972972864637848691766 + -967684234531. +37972972865605532926297 = 37972972864637848691766 - -967684234531. +-36745847179383510889822181472571746 = 37972972864637848691766 * -967684234531. +-37972972864637848691766 = -(37972972864637848691766). +37972972864637848691766 = +(37972972864637848691766). +-39241078349 = 37972972864637848691766 div -967684234531. +314786422447 = 37972972864637848691766 rem -967684234531. +37972972863675535859732 = 37972972864637848691766 band -967684234531. +-5371402497 = 37972972864637848691766 bor -967684234531. +-37972972863680907262229 = 37972972864637848691766 bxor -967684234531. +-37972972864637848691767 = bnot(37972972864637848691766). +19442162106694578530184192 = 37972972864637848691766 bsl 9. +74165962626245798226 = 37972972864637848691766 bsr 9. +6279872 = 6279929 + -57. +6279986 = 6279929 - -57. +-357955953 = 6279929 * -57. +-6279929 = -(6279929). +6279929 = +(6279929). +-110174 = 6279929 div -57. +11 = 6279929 rem -57. +6279873 = 6279929 band -57. +-1 = 6279929 bor -57. +-6279874 = 6279929 bxor -57. +-6279930 = bnot(6279929). +0 = 6279929 bsl -88. +1943543888242349716091745572225024 = 6279929 bsr -88. +34392885586249287 = 34392885586249381 + -94. +34392885586249475 = 34392885586249381 - -94. +-3232931245107441814 = 34392885586249381 * -94. +-34392885586249381 = -(34392885586249381). +34392885586249381 = +(34392885586249381). +-365881761555844 = 34392885586249381 div -94. +45 = 34392885586249381 rem -94. +34392885586249376 = 34392885586249381 band -94. +-89 = 34392885586249381 bor -94. +-34392885586249465 = 34392885586249381 bxor -94. +-34392885586249382 = bnot(34392885586249381). +0 = 34392885586249381 bsl -84. +665255158340299183156934914780744590032896 = 34392885586249381 bsr -84. +-2764682352159 = -2764682352698 + 539. +-2764682353237 = -2764682352698 - 539. +-1490163788104222 = -2764682352698 * 539. +2764682352698 = -(-2764682352698). +-2764682352698 = +(-2764682352698). +-5129280802 = -2764682352698 div 539. +-420 = -2764682352698 rem 539. +514 = -2764682352698 band 539. +-2764682352673 = -2764682352698 bor 539. +-2764682353187 = -2764682352698 bxor 539. +2764682352697 = bnot(-2764682352698). +-1 = -2764682352698 bsl -52. +-12451022413408498996591198208 = -2764682352698 bsr -52. +411347001767816756104233336410 = 438724827454564951793956448838 + -27377825686748195689723112428. +466102653141313147483679561266 = 438724827454564951793956448838 - -27377825686748195689723112428. +-12011331850499758360055954360069623806117771462827503958664 = 438724827454564951793956448838 * -27377825686748195689723112428. +-438724827454564951793956448838 = -(438724827454564951793956448838). +438724827454564951793956448838 = +(438724827454564951793956448838). +-16 = 438724827454564951793956448838 div -27377825686748195689723112428. +679616466593820758386649990 = 438724827454564951793956448838 rem -27377825686748195689723112428. +436229415513727871705332989956 = 438724827454564951793956448838 band -27377825686748195689723112428. +-24882413745911115601099653546 = 438724827454564951793956448838 bor -27377825686748195689723112428. +-461111829259638987306432643502 = 438724827454564951793956448838 bxor -27377825686748195689723112428. +-438724827454564951793956448839 = bnot(438724827454564951793956448838). +2903237 = 438724827454564951793956448838 bsl -77. +66298221451974587282214130220604359757665273628327936 = 438724827454564951793956448838 bsr -77. +49489484348507721380 = 49489484349336544761 + -828823381. +49489484350165368142 = 49489484349336544761 - -828823381. +-41018041742363700135669856941 = 49489484349336544761 * -828823381. +-49489484349336544761 = -(49489484349336544761). +49489484349336544761 = +(49489484349336544761). +-59710531198 = 49489484349336544761 div -828823381. +504204323 = 49489484349336544761 rem -828823381. +49489484348776325289 = 49489484349336544761 band -828823381. +-268603909 = 49489484349336544761 bor -828823381. +-49489484349044929198 = 49489484349336544761 bxor -828823381. +-49489484349336544762 = bnot(49489484349336544761). +1583663499178769432352 = 49489484349336544761 bsl 5. +1546546385916767023 = 49489484349336544761 bsr 5. +-5964308434181410553351390 = -48966654222568461613 + -5964259467527187984889777. +5964210500872965416428164 = -48966654222568461613 - -5964259467527187984889777. +292049831040084103997351697544933156260630301 = -48966654222568461613 * -5964259467527187984889777. +48966654222568461613 = -(-48966654222568461613). +-48966654222568461613 = +(-48966654222568461613). +0 = -48966654222568461613 div -5964259467527187984889777. +-48966654222568461613 = -48966654222568461613 rem -5964259467527187984889777. +-5964268730447095049959357 = -48966654222568461613 band -5964259467527187984889777. +-39703734315503392033 = -48966654222568461613 bor -5964259467527187984889777. +5964229026712779546567324 = -48966654222568461613 bxor -5964259467527187984889777. +48966654222568461612 = bnot(-48966654222568461613). +-391733233780547692904 = -48966654222568461613 bsl 3. +-6120831777821057702 = -48966654222568461613 bsr 3. +-4789495265182100 = -4789495265248472 + 66372. +-4789495265314844 = -4789495265248472 - 66372. +-317888379745071583584 = -4789495265248472 * 66372. +4789495265248472 = -(-4789495265248472). +-4789495265248472 = +(-4789495265248472). +-72161382288 = -4789495265248472 div 66372. +-29336 = -4789495265248472 rem 66372. +66304 = -4789495265248472 band 66372. +-4789495265248404 = -4789495265248472 bor 66372. +-4789495265314708 = -4789495265248472 bxor 66372. +4789495265248471 = bnot(-4789495265248472). +-1115142 = -4789495265248472 bsl -32. +-20570725528589032553971712 = -4789495265248472 bsr -32. +6123210 = 6131949 + -8739. +6140688 = 6131949 - -8739. +-53587102311 = 6131949 * -8739. +-6131949 = -(6131949). +6131949 = +(6131949). +-701 = 6131949 div -8739. +5910 = 6131949 rem -8739. +6131917 = 6131949 band -8739. +-8707 = 6131949 bor -8739. +-6140624 = 6131949 bxor -8739. +-6131950 = bnot(6131949). +8020551919344756729031218299753941701989984953287274290321164245870588083001099769758356086157870363219782747805318726955028674740546508065587792294262127816212374137239461470559298462333691609017014070959373923245739782857993726237262890385083410627678458699969911445122461553439023249052980524793987072 = 6131949 bsl 987. +0 = 6131949 bsr 987. +-71521222332273642257324 = -71521222332273642293443 + 36119. +-71521222332273642329562 = -71521222332273642293443 - 36119. +-2583275029419391685996867717 = -71521222332273642293443 * 36119. +71521222332273642293443 = -(-71521222332273642293443). +-71521222332273642293443 = +(-71521222332273642293443). +-1980155107624066067 = -71521222332273642293443 div 36119. +-19470 = -71521222332273642293443 rem 36119. +1301 = -71521222332273642293443 band 36119. +-71521222332273642258625 = -71521222332273642293443 bor 36119. +-71521222332273642259926 = -71521222332273642293443 bxor 36119. +71521222332273642293442 = bnot(-71521222332273642293443). +-1117519098941775660836 = -71521222332273642293443 bsl -6. +-4577358229265513106780352 = -71521222332273642293443 bsr -6. +665326317763636533 = -777616 + 665326317764414149. +-665326317765191765 = -777616 - 665326317764414149. +-517368389914692672888784 = -777616 * 665326317764414149. +777616 = -(-777616). +-777616 = +(-777616). +0 = -777616 div 665326317764414149. +-777616 = -777616 rem 665326317764414149. +665326317764346432 = -777616 band 665326317764414149. +-709899 = -777616 bor 665326317764414149. +-665326317765056331 = -777616 bxor 665326317764414149. +777615 = bnot(-777616). +-1 = -777616 bsl -64. +-14344483339621726689427456 = -777616 bsr -64. +-742789355945246516934055414343 = -742789355945246516936898773466 + 2843359123. +-742789355945246516939742132589 = -742789355945246516936898773466 - 2843359123. +-2112016891694210972416505142862061430318 = -742789355945246516936898773466 * 2843359123. +742789355945246516936898773466 = -(-742789355945246516936898773466). +-742789355945246516936898773466 = +(-742789355945246516936898773466). +-261236559932512793930 = -742789355945246516936898773466 div 2843359123. +-1814250076 = -742789355945246516936898773466 rem 2843359123. +2684499458 = -742789355945246516936898773466 band 2843359123. +-742789355945246516936739913801 = -742789355945246516936898773466 bor 2843359123. +-742789355945246516939424413259 = -742789355945246516936898773466 bxor 2843359123. +742789355945246516936898773465 = bnot(-742789355945246516936898773466). +-1 = -742789355945246516936898773466 bsl -592. +-12039906237866742069817054125723223154051261965793698359567866550315976451949665083616194680102781002958123515976277237215956114495168853552580898628325007810674596671065137644155374117516458451655322853441536 = -742789355945246516936898773466 bsr -592. +51953632733124287146 = 51953632739515644477 + -6391357331. +51953632745907001808 = 51953632739515644477 - -6391357331. +-332054231481784927717263610887 = 51953632739515644477 * -6391357331. +-51953632739515644477 = -(51953632739515644477). +51953632739515644477 = +(51953632739515644477). +-8128732294 = 51953632739515644477 div -6391357331. +522297163 = 51953632739515644477 rem -6391357331. +51953632737822973997 = 51953632739515644477 band -6391357331. +-4698686851 = 51953632739515644477 bor -6391357331. +-51953632742521660848 = 51953632739515644477 bxor -6391357331. +-51953632739515644478 = bnot(51953632739515644477). +207814530958062577908 = 51953632739515644477 bsl 2. +12988408184878911119 = 51953632739515644477 bsr 2. +-262672270 = 5713 + -262677983. +262683696 = 5713 - -262677983. +-1500679316879 = 5713 * -262677983. +-5713 = -(5713). +5713 = +(5713). +0 = 5713 div -262677983. +5713 = 5713 rem -262677983. +4609 = 5713 band -262677983. +-262676879 = 5713 bor -262677983. +-262681488 = 5713 bxor -262677983. +-5714 = bnot(5713). +11 = 5713 bsl -9. +2925056 = 5713 bsr -9. +-568921276688204408271309170952 = -5283749879527367 + -568921276688199124521429643585. +568921276688193840771550116218 = -5283749879527367 - -568921276688199124521429643585. +3006037727161827951841235319900749663063490695 = -5283749879527367 * -568921276688199124521429643585. +5283749879527367 = -(-5283749879527367). +-5283749879527367 = +(-5283749879527367). +0 = -5283749879527367 div -568921276688199124521429643585. +-5283749879527367 = -5283749879527367 rem -568921276688199124521429643585. +-568921276688199758976725202887 = -5283749879527367 band -568921276688199124521429643585. +-4649294583968065 = -5283749879527367 bor -568921276688199124521429643585. +568921276688195109682141234822 = -5283749879527367 bxor -568921276688199124521429643585. +5283749879527366 = bnot(-5283749879527367). +-42269999036218936 = -5283749879527367 bsl 3. +-660468734940921 = -5283749879527367 bsr 3. +11904699374459 = 4233227718792 + 7671471655667. +-3438243936875 = 4233227718792 - 7671471655667. +32475086456696701729194264 = 4233227718792 * 7671471655667. +-4233227718792 = -(4233227718792). +4233227718792 = +(4233227718792). +0 = 4233227718792 div 7671471655667. +4233227718792 = 4233227718792 rem 7671471655667. +3127273111680 = 4233227718792 band 7671471655667. +8777426262779 = 4233227718792 bor 7671471655667. +5650153151099 = 4233227718792 bxor 7671471655667. +-4233227718793 = bnot(4233227718792). +0 = 4233227718792 bsl -249. +3829486576376904164635311492615690175490415617529800201345103258022357798923215887663104 = 4233227718792 bsr -249. +25125316857724427543 = 25125316857179548718 + 544878825. +25125316856634669893 = 25125316857179548718 - 544878825. +13690253126892685319494096350 = 25125316857179548718 * 544878825. +-25125316857179548718 = -(25125316857179548718). +25125316857179548718 = +(25125316857179548718). +46111751281 = 25125316857179548718 div 544878825. +496023893 = 25125316857179548718 rem 544878825. +5382184 = 25125316857179548718 band 544878825. +25125316857719045359 = 25125316857179548718 bor 544878825. +25125316857713663175 = 25125316857179548718 bxor 544878825. +-25125316857179548719 = bnot(25125316857179548718). +0 = 25125316857179548718 bsl -93. +248829085897875822412742556034438954413935558656 = 25125316857179548718 bsr -93. +-88767522295277243892987472925 = 4 + -88767522295277243892987472929. +88767522295277243892987472933 = 4 - -88767522295277243892987472929. +-355070089181108975571949891716 = 4 * -88767522295277243892987472929. +-4 = -(4). +4 = +(4). +0 = 4 div -88767522295277243892987472929. +4 = 4 rem -88767522295277243892987472929. +4 = 4 band -88767522295277243892987472929. +-88767522295277243892987472929 = 4 bor -88767522295277243892987472929. +-88767522295277243892987472933 = 4 bxor -88767522295277243892987472929. +-5 = bnot(4). +0 = 4 bsl -4. +64 = 4 bsr -4. +254705954978575608208360764 = 254712299555523954647979436 + -6344576948346439618672. +254718644132472301087598108 = 254712299555523954647979436 - -6344576948346439618672. +-1616041784220290360650451738363048745803137628992 = 254712299555523954647979436 * -6344576948346439618672. +-254712299555523954647979436 = -(254712299555523954647979436). +254712299555523954647979436 = +(254712299555523954647979436). +-40146 = 254712299555523954647979436 div -6344576948346439618672. +2913387207789716773324 = 254712299555523954647979436 rem -6344576948346439618672. +254706297445885094062916992 = 254712299555523954647979436 band -6344576948346439618672. +-342467309485854556228 = 254712299555523954647979436 bor -6344576948346439618672. +-254706639913194579917473220 = 254712299555523954647979436 bxor -6344576948346439618672. +-254712299555523954647979437 = bnot(254712299555523954647979436). +1809839741579 = 254712299555523954647979436 bsl -47. +35847569292654369877447765855454005035008 = 254712299555523954647979436 bsr -47. +-2175263430742300103586 = 7632491378239 + -2175263438374791481825. +2175263446007282860064 = 7632491378239 - -2175263438374791481825. +-16602679438794118279348731369006175 = 7632491378239 * -2175263438374791481825. +-7632491378239 = -(7632491378239). +7632491378239 = +(7632491378239). +0 = 7632491378239 div -2175263438374791481825. +7632491378239 = 7632491378239 rem -2175263438374791481825. +3092706555423 = 7632491378239 band -2175263438374791481825. +-2175263433835006659009 = 7632491378239 bor -2175263438374791481825. +-2175263436927713214432 = 7632491378239 bxor -2175263438374791481825. +-7632491378240 = bnot(7632491378239). +30529965512956 = 7632491378239 bsl 2. +1908122844559 = 7632491378239 bsr 2. +-8812069618852 = -296325119 + -8811773293733. +8811476968614 = -296325119 - -8811773293733. +2611149769866453179227 = -296325119 * -8811773293733. +296325119 = -(-296325119). +-296325119 = +(-296325119). +0 = -296325119 div -8811773293733. +-296325119 = -296325119 rem -8811773293733. +-8812060606463 = -296325119 band -8811773293733. +-9012389 = -296325119 bor -8811773293733. +8812051594074 = -296325119 bxor -8811773293733. +296325118 = bnot(-296325119). +-1 = -296325119 bsl -51. +-667264847754458942144512 = -296325119 bsr -51. +961537478172334855 = 961537478172334783 + 72. +961537478172334711 = 961537478172334783 - 72. +69230698428408104376 = 961537478172334783 * 72. +-961537478172334783 = -(961537478172334783). +961537478172334783 = +(961537478172334783). +13354687196837983 = 961537478172334783 div 72. +7 = 961537478172334783 rem 72. +8 = 961537478172334783 band 72. +961537478172334847 = 961537478172334783 bor 72. +961537478172334839 = 961537478172334783 bxor 72. +-961537478172334784 = bnot(961537478172334783). +3846149912689339132 = 961537478172334783 bsl 2. +240384369543083695 = 961537478172334783 bsr 2. +-56935718366269633695631884973 = -56935718366269633696146472629 + 514587656. +-56935718366269633696661060285 = -56935718366269633696146472629 - 514587656. +-29298417856774840267678629582825267624 = -56935718366269633696146472629 * 514587656. +56935718366269633696146472629 = -(-56935718366269633696146472629). +-56935718366269633696146472629 = +(-56935718366269633696146472629). +-110643381554938880415 = -56935718366269633696146472629 div 514587656. +-127315389 = -56935718366269633696146472629 rem 514587656. +480952328 = -56935718366269633696146472629 band 514587656. +-56935718366269633696112837301 = -56935718366269633696146472629 bor 514587656. +-56935718366269633696593789629 = -56935718366269633696146472629 bxor 514587656. +56935718366269633696146472628 = bnot(-56935718366269633696146472629). +-33865750362788801638712217592875907723541573597845853713336988398679128310391930228722966719990357450223634399287920490900190621337960232425893678083539509097136354066085984633396253311133907314718439783298422229060401777256132142149667079426124235341914505345677881203404137903510253441797823517381377673087942656 = -56935718366269633696146472629 bsl 946. +-1 = -56935718366269633696146472629 bsr 946. +5478134454819665063141 = -77499384391 + 5478134454897164447532. +-5478134454974663831923 = -77499384391 - 5478134454897164447532. +-424552047865656599895221619273012 = -77499384391 * 5478134454897164447532. +77499384391 = -(-77499384391). +-77499384391 = +(-77499384391). +0 = -77499384391 div 5478134454897164447532. +-77499384391 = -77499384391 rem 5478134454897164447532. +5478134454828428176680 = -77499384391 band 5478134454897164447532. +-8763113539 = -77499384391 bor 5478134454897164447532. +-5478134454837191290219 = -77499384391 bxor 5478134454897164447532. +77499384390 = bnot(-77499384391). +-1 = -77499384391 bsl -957. +-94406979572560835598169159724368584579513338907559188265909267851122163141033431114034831856378837816438432447149999435369909239179642280099783886954506143034676884689536633413822594071691266396363194959504310276820454223562606194235221588028210734969962226246140583709705654278369610908548257021952 = -77499384391 bsr -957. +-4849115565564 = 8187 + -4849115573751. +4849115581938 = 8187 - -4849115573751. +-39699709202299437 = 8187 * -4849115573751. +-8187 = -(8187). +8187 = +(8187). +0 = 8187 div -4849115573751. +8187 = 8187 rem -4849115573751. +4617 = 8187 band -4849115573751. +-4849115570181 = 8187 bor -4849115573751. +-4849115574798 = 8187 bxor -4849115573751. +-8188 = bnot(8187). +65496 = 8187 bsl 3. +1023 = 8187 bsr 3. +-431578567135440151878 = -431578567418864531161 + 283424379283. +-431578567702288910444 = -431578567418864531161 - 283424379283. +-122319887582538047208971236337563 = -431578567418864531161 * 283424379283. +431578567418864531161 = -(-431578567418864531161). +-431578567418864531161 = +(-431578567418864531161). +-1522729161 = -431578567418864531161 div 283424379283. +-146316159598 = -431578567418864531161 rem 283424379283. +2751987971 = -431578567418864531161 band 283424379283. +-431578567138192139849 = -431578567418864531161 bor 283424379283. +-431578567140944127820 = -431578567418864531161 bxor 283424379283. +431578567418864531160 = bnot(-431578567418864531161). +-8152288646014973407771771735780730783924224 = -431578567418864531161 bsl 74. +-1 = -431578567418864531161 bsr 74. +-495291200701 = -495246754927 + -44445774. +-495202309153 = -495246754927 - -44445774. +22011625343718828498 = -495246754927 * -44445774. +495246754927 = -(-495246754927). +-495246754927 = +(-495246754927). +11142 = -495246754927 div -44445774. +-31941019 = -495246754927 rem -44445774. +-495257646192 = -495246754927 band -44445774. +-33554509 = -495246754927 bor -44445774. +495224091683 = -495246754927 bxor -44445774. +495246754926 = bnot(-495246754927). +-68066195707570939756544 = -495246754927 bsl 37. +-4 = -495246754927 bsr 37. +-6095142424482 = -749949895633 + -5345192528849. +4595242633216 = -749949895633 - -5345192528849. +4008626579148598891616417 = -749949895633 * -5345192528849. +749949895633 = -(-749949895633). +-749949895633 = +(-749949895633). +0 = -749949895633 div -5345192528849. +-749949895633 = -749949895633 rem -5345192528849. +-5491627346897 = -749949895633 band -5345192528849. +-603515077585 = -749949895633 bor -5345192528849. +4888112269312 = -749949895633 bxor -5345192528849. +749949895632 = bnot(-749949895633). +-187487473909 = -749949895633 bsl -2. +-2999799582532 = -749949895633 bsr -2. +-621829506476310151076 = -621822948751363498914 + -6557724946652162. +-621816391026416846752 = -621822948751363498914 - -6557724946652162. +4077743863427625266245768430822752068 = -621822948751363498914 * -6557724946652162. +621822948751363498914 = -(-621822948751363498914). +-621822948751363498914 = +(-621822948751363498914). +94822 = -621822948751363498914 div -6557724946652162. +-6353859912193750 = -621822948751363498914 rem -6557724946652162. +-621827742773743976354 = -621822948751363498914 band -6557724946652162. +-1763702566174722 = -621822948751363498914 bor -6557724946652162. +621825979071177801632 = -621822948751363498914 bxor -6557724946652162. +621822948751363498913 = bnot(-621822948751363498914). +-279752784190103629808262213481877267604434642103946792685969727886783900024504628125643344380628874645015331155431963989708755535149879893839797241498386941273765158340250824404369408 = -621822948751363498914 bsl 537. +-1 = -621822948751363498914 bsr 537. +249491668436548300378842774138 = -373671939733595218 + 249491668436921972318576369356. +-249491668437295644258309964574 = -373671939733595218 - 249491668436921972318576369356. +-93228035692195627484154251188872698411363339608 = -373671939733595218 * 249491668436921972318576369356. +373671939733595218 = -(-373671939733595218). +-373671939733595218 = +(-373671939733595218). +0 = -373671939733595218 div 249491668436921972318576369356. +-373671939733595218 = -373671939733595218 rem 249491668436921972318576369356. +249491668436839922216563169932 = -373671939733595218 band 249491668436921972318576369356. +-291621837720395794 = -373671939733595218 bor 249491668436921972318576369356. +-249491668437131544054283565726 = -373671939733595218 bxor 249491668436921972318576369356. +373671939733595217 = bnot(-373671939733595218). +-1 = -373671939733595218 bsl -268. +-177226770805200883084300797497432069977324995854719724156211341765268018946668965966541256401092608 = -373671939733595218 bsr -268. +782229585818934957 = 782229158144523791 + 427674411166. +782228730470112625 = 782229158144523791 - 427674411166. +334539394606335105443403050306 = 782229158144523791 * 427674411166. +-782229158144523791 = -(782229158144523791). +782229158144523791 = +(782229158144523791). +1829029 = 782229158144523791 div 427674411166. +257563985977 = 782229158144523791 rem 427674411166. +283469946894 = 782229158144523791 band 427674411166. +782229302348988063 = 782229158144523791 bor 427674411166. +782229018879041169 = 782229158144523791 bxor 427674411166. +-782229158144523792 = bnot(782229158144523791). +0 = 782229158144523791 bsl -692. +16072779992163944869162500501258888552545266030817826252520110008131745637803626241572391467228352301587824476241604259730959710633625940025608756154401018658504704342516809504287240332863674263352125923608713986070835401588736 = 782229158144523791 bsr -692. +431372269785776272290886 = 431372269785861816229748 + -85543938862. +431372269785947360168610 = 431372269785861816229748 - -85543938862. +-36901283073323933039537842257666776 = 431372269785861816229748 * -85543938862. +-431372269785861816229748 = -(431372269785861816229748). +431372269785861816229748 = +(431372269785861816229748). +-5042698238173 = 431372269785861816229748 div -85543938862. +75589650622 = 431372269785861816229748 rem -85543938862. +431372269785858016154704 = 431372269785861816229748 band -85543938862. +-81743863818 = 431372269785861816229748 bor -85543938862. +-431372269785939760018522 = 431372269785861816229748 bxor -85543938862. +-431372269785861816229749 = bnot(431372269785861816229748). +55215650532590312477407744 = 431372269785861816229748 bsl 7. +3370095857702045439294 = 431372269785861816229748 bsr 7. +4167637475335631083 = -6411 + 4167637475335637494. +-4167637475335643905 = -6411 - 4167637475335637494. +-26718723854376771974034 = -6411 * 4167637475335637494. +6411 = -(-6411). +-6411 = +(-6411). +0 = -6411 div 4167637475335637494. +-6411 = -6411 rem 4167637475335637494. +4167637475335635188 = -6411 band 4167637475335637494. +-4105 = -6411 bor 4167637475335637494. +-4167637475335639293 = -6411 bxor 4167637475335637494. +6410 = bnot(-6411). +-1 = -6411 bsl -417. +-2169871265748113289154933268376624709806030040311811531178948314370158350139387923499667470402055521872848517269721472045355630592 = -6411 bsr -417. +-72198400604812844524850328532 = -69517263963635144889192757364 + -2681136641177699635657571168. +-66836127322457445253535186196 = -69517263963635144889192757364 - -2681136641177699635657571168. +186385283607324270996007753661156514502862074176986081152 = -69517263963635144889192757364 * -2681136641177699635657571168. +69517263963635144889192757364 = -(-69517263963635144889192757364). +-69517263963635144889192757364 = +(-69517263963635144889192757364). +25 = -69517263963635144889192757364 div -2681136641177699635657571168. +-2488847934192653997753478164 = -69517263963635144889192757364 rem -2681136641177699635657571168. +-72032475452338347505308269440 = -69517263963635144889192757364 band -2681136641177699635657571168. +-165925152474497019542059092 = -69517263963635144889192757364 bor -2681136641177699635657571168. +71866550299863850485766210348 = -69517263963635144889192757364 bxor -2681136641177699635657571168. +69517263963635144889192757363 = bnot(-69517263963635144889192757364). +-1975799476771134 = -69517263963635144889192757364 bsl -45. +-2445921281894091002472893945597486430158848 = -69517263963635144889192757364 bsr -45. +-597883 = -762 + -597121. +596359 = -762 - -597121. +455006202 = -762 * -597121. +762 = -(-762). +-762 = +(-762). +0 = -762 div -597121. +-762 = -762 rem -597121. +-597754 = -762 band -597121. +-129 = -762 bor -597121. +597625 = -762 bxor -597121. +761 = bnot(-762). +-6096 = -762 bsl 3. +-96 = -762 bsr 3. +-439134683934183283784740784307 = 782114871 + -439134683934183283785522899178. +439134683934183283786305014049 = 782114871 - -439134683934183283785522899178. +-343453766676809531488270633958147476038 = 782114871 * -439134683934183283785522899178. +-782114871 = -(782114871). +782114871 = +(782114871). +0 = 782114871 div -439134683934183283785522899178. +782114871 = 782114871 rem -439134683934183283785522899178. +605552662 = 782114871 band -439134683934183283785522899178. +-439134683934183283785346336969 = 782114871 bor -439134683934183283785522899178. +-439134683934183283785951889631 = 782114871 bxor -439134683934183283785522899178. +-782114872 = bnot(782114871). +1761166120798261774123008 = 782114871 bsl 51. +0 = 782114871 bsr 51. +-2817223291852954659512177 = -2817223291852954658876965 + -635212. +-2817223291852954658241753 = -2817223291852954658876965 - -635212. +1789534041664499034774554691580 = -2817223291852954658876965 * -635212. +2817223291852954658876965 = -(-2817223291852954658876965). +-2817223291852954658876965 = +(-2817223291852954658876965). +4435091421215207928 = -2817223291852954658876965 div -635212. +-516229 = -2817223291852954658876965 rem -635212. +-2817223291852954659438448 = -2817223291852954658876965 band -635212. +-73729 = -2817223291852954658876965 bor -635212. +2817223291852954659364719 = -2817223291852954658876965 bxor -635212. +2817223291852954658876964 = bnot(-2817223291852954658876965). +-5502389241900302068120 = -2817223291852954658876965 bsl -9. +-1442418325428712785345006080 = -2817223291852954658876965 bsr -9. +-131461936887 = -54764697521 + -76697239366. +21932541845 = -54764697521 - -76697239366. +4200301114574723811686 = -54764697521 * -76697239366. +54764697521 = -(-54764697521). +-54764697521 = +(-54764697521). +0 = -54764697521 div -76697239366. +-54764697521 = -54764697521 rem -76697239366. +-128240517110 = -54764697521 band -76697239366. +-3221419777 = -54764697521 bor -76697239366. +125019097333 = -54764697521 bxor -76697239366. +54764697520 = bnot(-54764697521). +-1 = -54764697521 bsl -292. +-435772105794347831388572420830297697694089413640651371434988576327209811006398295311758623628066816 = -54764697521 bsr -292. +-718383814066737940583 = -718384471966434468442 + 657899696527859. +-718385129866130996301 = -718384471966434468442 - 657899696527859. +-472624926097043467979643525709325678 = -718384471966434468442 * 657899696527859. +718384471966434468442 = -(-718384471966434468442). +-718384471966434468442 = +(-718384471966434468442). +-1091936 = -718384471966434468442 div 657899696527859. +-108938590223418 = -718384471966434468442 rem 657899696527859. +313869310370 = -718384471966434468442 band 657899696527859. +-718383814380607250953 = -718384471966434468442 bor 657899696527859. +-718383814694476561323 = -718384471966434468442 bxor 657899696527859. +718384471966434468441 = bnot(-718384471966434468442). +-11224757374475538570 = -718384471966434468442 bsl -6. +-45976606205851805980288 = -718384471966434468442 bsr -6. +69587853318633335 = 69587853318632789 + 546. +69587853318632243 = 69587853318632789 - 546. +37994967911973502794 = 69587853318632789 * 546. +-69587853318632789 = -(69587853318632789). +69587853318632789 = +(69587853318632789). +127450280803356 = 69587853318632789 div 546. +413 = 69587853318632789 rem 546. +0 = 69587853318632789 band 546. +69587853318633335 = 69587853318632789 bor 546. +69587853318633335 = 69587853318632789 bxor 546. +-69587853318632790 = bnot(69587853318632789). +2226811306196249248 = 69587853318632789 bsl 5. +2174620416207274 = 69587853318632789 bsr 5. +7881966812303549621 = 7881967199162492797 + -386858943176. +7881967586021435973 = 7881967199162492797 - -386858943176. +-3049209500815898675745132303272 = 7881967199162492797 * -386858943176. +-7881967199162492797 = -(7881967199162492797). +7881967199162492797 = +(7881967199162492797). +-20374266 = 7881967199162492797 div -386858943176. +186415783981 = 7881967199162492797 rem -386858943176. +7881966889655100728 = 7881967199162492797 band -386858943176. +-77351551107 = 7881967199162492797 bor -386858943176. +-7881966967006651835 = 7881967199162492797 bxor -386858943176. +-7881967199162492798 = bnot(7881967199162492797). +0 = 7881967199162492797 bsl -87. +1219675348022161883312283936183914520501026816 = 7881967199162492797 bsr -87. +5434826832880908507321 = 5491168191821856 + 5434821341712716685465. +-5434815850544524863609 = 5491168191821856 - 5434821341712716685465. +29843518079847451852035006528064523040 = 5491168191821856 * 5434821341712716685465. +-5491168191821856 = -(5491168191821856). +5491168191821856 = +(5491168191821856). +0 = 5491168191821856 div 5434821341712716685465. +5491168191821856 = 5491168191821856 rem 5434821341712716685465. +2267748507648 = 5491168191821856 band 5434821341712716685465. +5434826830613159999673 = 5491168191821856 bor 5434821341712716685465. +5434826828345411492025 = 5491168191821856 bxor 5434821341712716685465. +-5491168191821857 = bnot(5491168191821856). +27694469519309956907906736988340335288164603951096450650305569038190403118530742434158245364055453483480375607197928499621306185023488 = 5491168191821856 bsl 391. +0 = 5491168191821856 bsr 391. +-12965631870144917 = -6643255557847534 + -6322376312297383. +-320879245550151 = -6643255557847534 - -6322376312297383. +42001161575473185936773981203522 = -6643255557847534 * -6322376312297383. +6643255557847534 = -(-6643255557847534). +-6643255557847534 = +(-6643255557847534). +1 = -6643255557847534 div -6322376312297383. +-320879245550151 = -6643255557847534 rem -6322376312297383. +-6753389257916400 = -6643255557847534 band -6322376312297383. +-6212242612228517 = -6643255557847534 bor -6322376312297383. +541146645687883 = -6643255557847534 bxor -6322376312297383. +6643255557847533 = bnot(-6643255557847534). +-161152725708367740895437494628907697939243534943643461141618092139904119253051381194500954345652785574706775810270689912233366294097741715204603746816563384034817788972520647289946562585108549405788710464323092207350516362491917360517306946420736 = -6643255557847534 bsl 762. +-1 = -6643255557847534 bsr 762. +31342846592922 = -26985445 + 31342873578367. +-31342900563812 = -26985445 - 31342873578367. +-845801391090975868315 = -26985445 * 31342873578367. +26985445 = -(-26985445). +-26985445 = +(-26985445). +0 = -26985445 div 31342873578367. +-26985445 = -26985445 rem 31342873578367. +31342863583259 = -26985445 band 31342873578367. +-16990337 = -26985445 bor 31342873578367. +-31342880573596 = -26985445 bxor 31342873578367. +26985444 = bnot(-26985445). +-254870321986644506167413309440 = -26985445 bsl 73. +-1 = -26985445 bsr 73. +572927541962185236192615839 = 328 + 572927541962185236192615511. +-572927541962185236192615183 = 328 - 572927541962185236192615511. +187920233763596757471177887608 = 328 * 572927541962185236192615511. +-328 = -(328). +328 = +(328). +0 = 328 div 572927541962185236192615511. +328 = 328 rem 572927541962185236192615511. +64 = 328 band 572927541962185236192615511. +572927541962185236192615775 = 328 bor 572927541962185236192615511. +572927541962185236192615711 = 328 bxor 572927541962185236192615511. +-329 = bnot(328). +0 = 328 bsl -45. +11540474045136896 = 328 bsr -45. +7522286436127792454065865 = -848625735117776 + 7522286436976418189183641. +-7522286437825043924301417 = -848625735117776 - 7522286436976418189183641. +-6383605857345588870864671022250427502416 = -848625735117776 * 7522286436976418189183641. +848625735117776 = -(-848625735117776). +-848625735117776 = +(-848625735117776). +0 = -848625735117776 div 7522286436976418189183641. +-848625735117776 = -848625735117776 rem 7522286436976418189183641. +7522286436976143037005840 = -848625735117776 band 7522286436976418189183641. +-848350582939975 = -848625735117776 bor 7522286436976418189183641. +-7522286437824493619945815 = -848625735117776 bxor 7522286436976418189183641. +848625735117775 = bnot(-848625735117776). +-230777533236791811937923527909470948120033583019220046964229501521150351925362156486191065861179888824870818927545456120268239397752217898933816374173017707522176554440297628809587477866933704705703936 = -848625735117776 bsl 616. +-1 = -848625735117776 bsr 616. +-791719256114 = -2172 + -791719253942. +791719251770 = -2172 - -791719253942. +1719614219562024 = -2172 * -791719253942. +2172 = -(-2172). +-2172 = +(-2172). +0 = -2172 div -791719253942. +-2172 = -2172 rem -791719253942. +-791719256064 = -2172 band -791719253942. +-50 = -2172 bor -791719253942. +791719256014 = -2172 bxor -791719253942. +2171 = bnot(-2172). +-1 = -2172 bsl -683. +-87165948319725549756831588940549007122614578641753643973009232494089403069559170117423124060019852570076042239041283331853318838862603927541455182509276467942068068036582806909731244523046485457712165395890176 = -2172 bsr -683. +399884239982556913673 = 399884239982557689298 + -775625. +399884239982558464923 = 399884239982557689298 - -775625. +-310160213636471307761761250 = 399884239982557689298 * -775625. +-399884239982557689298 = -(399884239982557689298). +399884239982557689298 = +(399884239982557689298). +-515563887165263 = 399884239982557689298 div -775625. +574923 = 399884239982557689298 rem -775625. +399884239982557143058 = 399884239982557689298 band -775625. +-229385 = 399884239982557689298 bor -775625. +-399884239982557372443 = 399884239982557689298 bxor -775625. +-399884239982557689299 = bnot(399884239982557689298). +6248191249727463895 = 399884239982557689298 bsl -6. +25592591358883692115072 = 399884239982557689298 bsr -6. +-44980302852142023255246380639 = -446625714922843593693761866 + -44533677137219179661552618773. +44087051422296336067858856907 = -446625714922843593693761866 - -44533677137219179661552618773. +19889885389553610740544285445999387722022564646143110418 = -446625714922843593693761866 * -44533677137219179661552618773. +446625714922843593693761866 = -(-446625714922843593693761866). +-446625714922843593693761866 = +(-446625714922843593693761866). +0 = -446625714922843593693761866 div -44533677137219179661552618773. +-446625714922843593693761866 = -446625714922843593693761866 rem -44533677137219179661552618773. +-44553095738867805362119875934 = -446625714922843593693761866 band -44533677137219179661552618773. +-427207113274217893126504705 = -446625714922843593693761866 bor -44533677137219179661552618773. +44125888625593587468993371229 = -446625714922843593693761866 bxor -44533677137219179661552618773. +446625714922843593693761865 = bnot(-446625714922843593693761866). +-26336697907466707431452259915040757780966340589709535579395555585980697709376097601034270890825071371732371680377763343497440940619798904912648202171728902307721468032616760270952556509102342144 = -446625714922843593693761866 bsl 554. +-1 = -446625714922843593693761866 bsr 554. +-75684508410009542805739174389 = -498153796625829811465951162 + -75186354613383712994273223227. +74688200816757883182807272065 = -498153796625829811465951162 - -75186354613383712994273223227. +37454368005113071165177808884019876888070327805106039774 = -498153796625829811465951162 * -75186354613383712994273223227. +498153796625829811465951162 = -(-498153796625829811465951162). +-498153796625829811465951162 = +(-498153796625829811465951162). +0 = -498153796625829811465951162 div -75186354613383712994273223227. +-498153796625829811465951162 = -498153796625829811465951162 rem -75186354613383712994273223227. +-75510346904256744945233131452 = -498153796625829811465951162 band -75186354613383712994273223227. +-174161505752797860506042937 = -498153796625829811465951162 bor -75186354613383712994273223227. +75336185398503947084727088515 = -498153796625829811465951162 bxor -75186354613383712994273223227. +498153796625829811465951161 = bnot(-498153796625829811465951162). +-72729507697548556594247865846124256119427484441651488108647007093339614933858206268651285532108070827403091989906633866101143522475573303639107187558734195229322724513812266307402531853259074857977300118498648191385206784 = -498153796625829811465951162 bsl 645. +-1 = -498153796625829811465951162 bsr 645. +-349641534929400177572 = -3662276865181 + -349641531267123312391. +349641527604846447210 = -3662276865181 - -349641531267123312391. +1280484091066044959231076453757771 = -3662276865181 * -349641531267123312391. +3662276865181 = -(-3662276865181). +-3662276865181 = +(-3662276865181). +0 = -3662276865181 div -349641531267123312391. +-3662276865181 = -3662276865181 rem -349641531267123312391. +-349641534843492171679 = -3662276865181 band -349641531267123312391. +-85908005893 = -3662276865181 bor -349641531267123312391. +349641534757584165786 = -3662276865181 bxor -349641531267123312391. +3662276865180 = bnot(-3662276865181). +-1 = -3662276865181 bsl -67. +-540456672472489650321132741459968 = -3662276865181 bsr -67. +95194355719099220632332 = 95194355719153182466249 + -53961833917. +95194355719207144300166 = 95194355719153182466249 - -53961833917. +-5136862013152763128125724995967333 = 95194355719153182466249 * -53961833917. +-95194355719153182466249 = -(95194355719153182466249). +95194355719153182466249 = +(95194355719153182466249). +-1764105272359 = 95194355719153182466249 div -53961833917. +12773666046 = 95194355719153182466249 rem -53961833917. +95194355719150760247361 = 95194355719153182466249 band -53961833917. +-51539615029 = 95194355719153182466249 bor -53961833917. +-95194355719202299862390 = 95194355719153182466249 bxor -53961833917. +-95194355719153182466250 = bnot(95194355719153182466249). +11899294464894147808281 = 95194355719153182466249 bsl -3. +761554845753225459729992 = 95194355719153182466249 bsr -3. +865761194182852538761799504 = 865761194182852485987565723 + 52774233781. +865761194182852433213331942 = 865761194182852485987565723 - 52774233781. +45689883660323594356944820124704288663 = 865761194182852485987565723 * 52774233781. +-865761194182852485987565723 = -(865761194182852485987565723). +865761194182852485987565723 = +(865761194182852485987565723). +16404997896805987 = 865761194182852485987565723 div 52774233781. +14849118876 = 865761194182852485987565723 rem 52774233781. +26607761 = 865761194182852485987565723 band 52774233781. +865761194182852538735191743 = 865761194182852485987565723 bor 52774233781. +865761194182852538708583982 = 865761194182852485987565723 bxor 52774233781. +-865761194182852485987565724 = bnot(865761194182852485987565723). +0 = 865761194182852485987565723 bsl -234. +23901056636578152198835723665750983422335028724869521276981945661302774128209516129727702244524032 = 865761194182852485987565723 bsr -234. +22552956143687134 = -2377925557 + 22552958521612691. +-22552960899538248 = -2377925557 - 22552958521612691. +-53629256454503754784443887 = -2377925557 * 22552958521612691. +2377925557 = -(-2377925557). +-2377925557 = +(-2377925557). +0 = -2377925557 div 22552958521612691. +-2377925557 = -2377925557 rem 22552958521612691. +22552956222085123 = -2377925557 band 22552958521612691. +-78397989 = -2377925557 bor 22552958521612691. +-22552956300483112 = -2377925557 bxor 22552958521612691. +2377925556 = bnot(-2377925557). +-864184189159900223931269425922722087985704133795314350665511079338331311401567617994038073478470737101191118267652517926430688278248306503581696 = -2377925557 bsl 447. +-1 = -2377925557 bsr 447. +52736489523359951 = 8 + 52736489523359943. +-52736489523359935 = 8 - 52736489523359943. +421891916186879544 = 8 * 52736489523359943. +-8 = -(8). +8 = +(8). +0 = 8 div 52736489523359943. +8 = 8 rem 52736489523359943. +0 = 8 band 52736489523359943. +52736489523359951 = 8 bor 52736489523359943. +52736489523359951 = 8 bxor 52736489523359943. +-9 = bnot(8). +943490606205385338060388645247067222729230305104110107094051575061406040598037213021531681294414691885367093757690961224942646157481198158140358562858174010912348831744 = 8 bsl 555. +0 = 8 bsr 555. +6473257884965793731994114438 = -685361747213 + 6473257884965794417355861651. +-6473257884965795102717608864 = -685361747213 - 6473257884965794417355861651. +-4436523334200485826619574672716462828663 = -685361747213 * 6473257884965794417355861651. +685361747213 = -(-685361747213). +-685361747213 = +(-685361747213). +0 = -685361747213 div 6473257884965794417355861651. +-685361747213 = -685361747213 rem 6473257884965794417355861651. +6473257884965794391582124691 = -685361747213 band 6473257884965794417355861651. +-659588010253 = -685361747213 bor 6473257884965794417355861651. +-6473257884965795051170134944 = -685361747213 bxor 6473257884965794417355861651. +685361747212 = bnot(-685361747213). +-398103322863127778168772896219995089013190570480005198583607340512926062411749281505673152733301559458222748590173533454802569120231995000055804716173753625150327419277696152317604800338665813575874556829151703700450096632420017690406582733979166862176980635624381604665642256255139974393888768 = -685361747213 bsl 936. +-1 = -685361747213 bsr 936. +9739756856122388822877 = -2488 + 9739756856122388825365. +-9739756856122388827853 = -2488 - 9739756856122388825365. +-24232515058032503397508120 = -2488 * 9739756856122388825365. +2488 = -(-2488). +-2488 = +(-2488). +0 = -2488 div 9739756856122388825365. +-2488 = -2488 rem 9739756856122388825365. +9739756856122388825088 = -2488 band 9739756856122388825365. +-2211 = -2488 bor 9739756856122388825365. +-9739756856122388827299 = -2488 bxor 9739756856122388825365. +2487 = bnot(-2488). +-1 = -2488 bsl -999. +-13329567073397165472598407610306422523383875857616838076600254831327167075994205363815387832467256475107277731094361146505328087354012386702364814502925027056094602311881343345863816808697589700496175002598389814879575934936644066843601936668919866265726568418242058456569574710575864737225483851078303744 = -2488 bsr -999. +31877226767652310946210254518 = -4866892436167135 + 31877226767657177838646421653. +-31877226767662044731082588788 = -4866892436167135 - 31877226767657177838646421653. +-155143033841495248559827480439514486390974155 = -4866892436167135 * 31877226767657177838646421653. +4866892436167135 = -(-4866892436167135). +-4866892436167135 = +(-4866892436167135). +0 = -4866892436167135 div 31877226767657177838646421653. +-4866892436167135 = -4866892436167135 rem 31877226767657177838646421653. +31877226767656894024783110145 = -4866892436167135 band 31877226767657177838646421653. +-4583078572855627 = -4866892436167135 bor 31877226767657177838646421653. +-31877226767661477103355965772 = -4866892436167135 bxor 31877226767657177838646421653. +4866892436167134 = bnot(-4866892436167135). +-1216723109041784 = -4866892436167135 bsl -2. +-19467569744668540 = -4866892436167135 bsr -2. +-6716805724025 = -3592552651 + -6713213171374. +6709620618723 = -3592552651 - -6713213171374. +24117571775547781012474 = -3592552651 * -6713213171374. +3592552651 = -(-3592552651). +-3592552651 = +(-3592552651). +0 = -3592552651 div -6713213171374. +-3592552651 = -3592552651 rem -6713213171374. +-6716769941232 = -3592552651 band -6713213171374. +-35782793 = -3592552651 bor -6713213171374. +6716734158439 = -3592552651 bxor -6713213171374. +3592552650 = bnot(-3592552651). +-14033409 = -3592552651 bsl -8. +-919693478656 = -3592552651 bsr -8. +6342688856832569926635 = 243589238 + 6342688856832326337397. +-6342688856832082748159 = 243589238 - 6342688856832326337397. +1545010745506877466293866133486 = 243589238 * 6342688856832326337397. +-243589238 = -(243589238). +243589238 = +(243589238). +0 = 243589238 div 6342688856832326337397. +243589238 = 243589238 rem 6342688856832326337397. +234913908 = 243589238 band 6342688856832326337397. +6342688856832335012727 = 243589238 bor 6342688856832326337397. +6342688856832100098819 = 243589238 bxor 6342688856832326337397. +-243589239 = bnot(243589238). +7794855616 = 243589238 bsl 5. +7612163 = 243589238 bsr 5. +-66498536559289764002685355478 = -661563588547 + -66498536559289763341121766931. +66498536559289762679558178384 = -661563588547 - -66498536559289763341121766931. +43993010479287610065554884623365714939257 = -661563588547 * -66498536559289763341121766931. +661563588547 = -(-661563588547). +-661563588547 = +(-661563588547). +0 = -661563588547 div -66498536559289763341121766931. +-661563588547 = -661563588547 rem -66498536559289763341121766931. +-66498536559289763452790996947 = -661563588547 band -66498536559289763341121766931. +-549894358531 = -661563588547 bor -66498536559289763341121766931. +66498536559289762902896638416 = -661563588547 bxor -66498536559289763341121766931. +661563588546 = bnot(-661563588547). +-1 = -661563588547 bsl -931. +-12008743190950049197359166028745504918110862504433494660009085601342677414452326029787292755507771918146614791028819877647480428524086999078135313170114862205662956040149928337601463362981762236859328550390963427343128800748578481098842371714721549472086991926143438587884108107257246652563456 = -661563588547 bsr -931. +2478045 = 776 + 2477269. +-2476493 = 776 - 2477269. +1922360744 = 776 * 2477269. +-776 = -(776). +776 = +(776). +0 = 776 div 2477269. +776 = 776 rem 2477269. +0 = 776 band 2477269. +2478045 = 776 bor 2477269. +2478045 = 776 bxor 2477269. +-777 = bnot(776). +0 = 776 bsl -765. +150594254953168766709451010380862747859917943660319571280488047688526942410578557974095205656378708361197309877621714100998643264279136995970095865678994570502832132674022440838375732706265049148050510921790497468836606144820157612032 = 776 bsr -765. +-5804070374514233830 = -5896262786855451155 + 92192412341217325. +-5988455199196668480 = -5896262786855451155 - 92192412341217325. +-543590690117952952955498064777260375 = -5896262786855451155 * 92192412341217325. +5896262786855451155 = -(-5896262786855451155). +-5896262786855451155 = +(-5896262786855451155). +-63 = -5896262786855451155 div 92192412341217325. +-88140809358759680 = -5896262786855451155 rem 92192412341217325. +1125900510822445 = -5896262786855451155 band 92192412341217325. +-5805196275025056275 = -5896262786855451155 bor 92192412341217325. +-5806322175535878720 = -5896262786855451155 bxor 92192412341217325. +5896262786855451154 = bnot(-5896262786855451155). +-1 = -5896262786855451155 bsl -769. +-18308109307104973221907306379181569546935285356107783425114666977827898124798039943215443809688591451372916367417021091895961849411086899368966313551780601272324189197241852897140354823763739530137256577861266851140500438226450994295781619332924047360 = -5896262786855451155 bsr -769. +-443211342895884 = -443211342896345 + 461. +-443211342896806 = -443211342896345 - 461. +-204320429075215045 = -443211342896345 * 461. +443211342896345 = -(-443211342896345). +-443211342896345 = +(-443211342896345). +-961412891315 = -443211342896345 div 461. +-130 = -443211342896345 rem 461. +261 = -443211342896345 band 461. +-443211342896145 = -443211342896345 bor 461. +-443211342896406 = -443211342896345 bxor 461. +443211342896344 = bnot(-443211342896345). +-816729958176514552203192674502448526511752999823230523651292759264447583415583111736446478648044233525141009345655080859402927179022658877860939660281020224748231941212147957104640 = -443211342896345 bsl 549. +-1 = -443211342896345 bsr 549. +89113643731118361834094922652 = 88487169551642615174247139488 + 626474179475746659847783164. +87860695372166868514399356324 = 88487169551642615174247139488 - 626474179475746659847783164. +55434926938996580796277853360910097493380621825085980032 = 88487169551642615174247139488 * 626474179475746659847783164. +-88487169551642615174247139488 = -(88487169551642615174247139488). +88487169551642615174247139488 = +(88487169551642615174247139488). +141 = 88487169551642615174247139488 div 626474179475746659847783164. +154310245562336135709713364 = 88487169551642615174247139488 rem 626474179475746659847783164. +2517041061918882394161312 = 88487169551642615174247139488 band 626474179475746659847783164. +89111126690056442951700761340 = 88487169551642615174247139488 bor 626474179475746659847783164. +89108609648994524069306600028 = 88487169551642615174247139488 bxor 626474179475746659847783164. +-88487169551642615174247139489 = bnot(88487169551642615174247139488). +345653006061103965524402888 = 88487169551642615174247139488 bsl -8. +22652715405220509484607267708928 = 88487169551642615174247139488 bsr -8. +-4252961282927655944807871 = -4252961282927655944727952 + -79919. +-4252961282927655944648033 = -4252961282927655944727952 - -79919. +339892412770295335446713195888 = -4252961282927655944727952 * -79919. +4252961282927655944727952 = -(-4252961282927655944727952). +-4252961282927655944727952 = +(-4252961282927655944727952). +53215897132442297134 = -4252961282927655944727952 div -79919. +-75806 = -4252961282927655944727952 rem -79919. +-4252961282927655944797616 = -4252961282927655944727952 band -79919. +-10255 = -4252961282927655944727952 bor -79919. +4252961282927655944787361 = -4252961282927655944727952 bxor -79919. +4252961282927655944727951 = bnot(-4252961282927655944727952). +-140426011681400209026547427003774677314553319113895083364477823906168064213545836899087212036304588754345279546615537065261329107956356443202764600141444295955266753800881336952656684971045506141440117127722873350801409015632681065196238844967911192617187951283431435238988282881545167534292992 = -4252961282927655944727952 bsl 892. +-1 = -4252961282927655944727952 bsr 892. +453762865478398111269668210 = -49 + 453762865478398111269668259. +-453762865478398111269668308 = -49 - 453762865478398111269668259. +-22234380408441507452213744691 = -49 * 453762865478398111269668259. +49 = -(-49). +-49 = +(-49). +0 = -49 div 453762865478398111269668259. +-49 = -49 rem 453762865478398111269668259. +453762865478398111269668227 = -49 band 453762865478398111269668259. +-17 = -49 bor 453762865478398111269668259. +-453762865478398111269668244 = -49 bxor 453762865478398111269668259. +48 = bnot(-49). +-1683627180032 = -49 bsl 35. +-1 = -49 bsr 35. +-57713179591551324250701492252 = -57713179591551319632367534597 + -4618333957655. +-57713179591551315014033576942 = -57713179591551319632367534597 - -4618333957655. +266538737111902982398789855692898145490035 = -57713179591551319632367534597 * -4618333957655. +57713179591551319632367534597 = -(-57713179591551319632367534597). +-57713179591551319632367534597 = +(-57713179591551319632367534597). +12496536656014303 = -57713179591551319632367534597 div -4618333957655. +-4300091195132 = -57713179591551319632367534597 rem -4618333957655. +-57713179591551319852619132439 = -57713179591551319632367534597 band -4618333957655. +-4398082359813 = -57713179591551319632367534597 bor -4618333957655. +57713179591551315454536772626 = -57713179591551319632367534597 bxor -4618333957655. +57713179591551319632367534596 = bnot(-57713179591551319632367534597). +-3693643493859284456471522214208 = -57713179591551319632367534597 bsl 6. +-901768431117989369255742729 = -57713179591551319632367534597 bsr 6. +265837649729404089302891 = 52315144254666596 + 265837597414259834636295. +-265837545099115579969699 = 52315144254666596 - 265837597414259834636295. +13907332257040986924721914497828145701820 = 52315144254666596 * 265837597414259834636295. +-52315144254666596 = -(52315144254666596). +52315144254666596 = +(52315144254666596). +0 = 52315144254666596 div 265837597414259834636295. +52315144254666596 = 52315144254666596 rem 265837597414259834636295. +36183072789757956 = 52315144254666596 band 265837597414259834636295. +265837613546331299544935 = 52315144254666596 bor 265837597414259834636295. +265837577363258509786979 = 52315144254666596 bxor 265837597414259834636295. +-52315144254666597 = bnot(52315144254666596). +13968058738787516388706915168375689068407128218376520265019126620449392236038299189412454557317871103017234726912 = 52315144254666596 bsl 317. +0 = 52315144254666596 bsr 317. +5116298099 = 5179827677 + -63529578. +5243357255 = 5179827677 - -63529578. +-329072266432530306 = 5179827677 * -63529578. +-5179827677 = -(5179827677). +5179827677 = +(5179827677). +-81 = 5179827677 div -63529578. +33931859 = 5179827677 rem -63529578. +5170824596 = 5179827677 band -63529578. +-54526497 = 5179827677 bor -63529578. +-5225351093 = 5179827677 bxor -63529578. +-5179827678 = bnot(5179827677). +0 = 5179827677 bsl -39. +2847640380368723378176 = 5179827677 bsr -39. +-5273151 = 444 + -5273595. +5274039 = 444 - -5273595. +-2341476180 = 444 * -5273595. +-444 = -(444). +444 = +(444). +0 = 444 div -5273595. +444 = 444 rem -5273595. +4 = 444 band -5273595. +-5273155 = 444 bor -5273595. +-5273159 = 444 bxor -5273595. +-445 = bnot(444). +0 = 444 bsl -615. +60371268815525015505453353909579794056790872133325356518541618524410670228023909318704166657475021526268636746724722291408353593834957315660243678866525384771343637568234134848022345940992 = 444 bsr -615. +494826194665397615344866324725 = 494826194665397615344865332937 + 991788. +494826194665397615344864341149 = 494826194665397615344865332937 - 991788. +490762681954805370127653298822921356 = 494826194665397615344865332937 * 991788. +-494826194665397615344865332937 = -(494826194665397615344865332937). +494826194665397615344865332937 = +(494826194665397615344865332937). +498923353242222748556007 = 494826194665397615344865332937 div 991788. +262421 = 494826194665397615344865332937 rem 991788. +328200 = 494826194665397615344865332937 band 991788. +494826194665397615344865996525 = 494826194665397615344865332937 bor 991788. +494826194665397615344865668325 = 494826194665397615344865332937 bxor 991788. +-494826194665397615344865332938 = bnot(494826194665397615344865332937). +140345557827981039314391893049623959037326578794917044229687953213535487381280129496170628842737120271071911974932563929194833801299266628684553435862103204230956193711098219747098614967226001563675077822808620342930577054561672425384147736363482328577856355552345156862561716239253724614734782765811613302784 = 494826194665397615344865332937 bsl 925. +0 = 494826194665397615344865332937 bsr 925. +-334577614673512267637522355505 = -334577614612144943799776698692 + -61367323837745656813. +-334577614550777619962031041879 = -334577614612144943799776698692 - -61367323837745656813. +20532132824763961997155896186806543924462337988596 = -334577614612144943799776698692 * -61367323837745656813. +334577614612144943799776698692 = -(-334577614612144943799776698692). +-334577614612144943799776698692 = +(-334577614612144943799776698692). +5452048316 = -334577614612144943799776698692 div -61367323837745656813. +-25137078336146121784 = -334577614612144943799776698692 rem -61367323837745656813. +-334577614613560205755450520560 = -334577614612144943799776698692 band -61367323837745656813. +-59952061882071834945 = -334577614612144943799776698692 bor -61367323837745656813. +334577614553608143873378685615 = -334577614612144943799776698692 bxor -61367323837745656813. +334577614612144943799776698691 = bnot(-334577614612144943799776698692). +-10455550456629529493743021835 = -334577614612144943799776698692 bsl -5. +-10706483667588638201592854358144 = -334577614612144943799776698692 bsr -5. +-21297477526471769336883823 = 93839 + -21297477526471769336977662. +21297477526471769337071501 = 93839 - -21297477526471769336977662. +-1998533993606584362812646824418 = 93839 * -21297477526471769336977662. +-93839 = -(93839). +93839 = +(93839). +0 = 93839 div -21297477526471769336977662. +93839 = 93839 rem -21297477526471769336977662. +91650 = 93839 band -21297477526471769336977662. +-21297477526471769336975473 = 93839 bor -21297477526471769336977662. +-21297477526471769337067123 = 93839 bxor -21297477526471769336977662. +-93840 = bnot(93839). +0 = 93839 bsl -42. +412708286555488256 = 93839 bsr -42. +264197895362246034877072924 = -3751257145287 + 264197895362249786134218211. +-264197895362253537391363498 = -3751257145287 - 264197895362249786134218211. +-991074242747426669479673681623388221557 = -3751257145287 * 264197895362249786134218211. +3751257145287 = -(-3751257145287). +-3751257145287 = +(-3751257145287). +0 = -3751257145287 div 264197895362249786134218211. +-3751257145287 = -3751257145287 rem 264197895362249786134218211. +264197895362249608294072353 = -3751257145287 band 264197895362249786134218211. +-3573416999429 = -3751257145287 bor 264197895362249786134218211. +-264197895362253181711071782 = -3751257145287 bxor 264197895362249786134218211. +3751257145286 = bnot(-3751257145287). +-937814286322 = -3751257145287 bsl -2. +-15005028581148 = -3751257145287 bsr -2. +-72757343598454287140636 = -72757343674813464813435 + 76359177672799. +-72757343751172642486234 = -72757343674813464813435 - 76359177672799. +-5555690932665979868743179456009254565 = -72757343674813464813435 * 76359177672799. +72757343674813464813435 = -(-72757343674813464813435). +-72757343674813464813435 = +(-72757343674813464813435). +-952830372 = -72757343674813464813435 div 76359177672799. +-7226299362207 = -72757343674813464813435 rem 76359177672799. +74913912717317 = -72757343674813464813435 band 76359177672799. +-72757343673368199857953 = -72757343674813464813435 bor 76359177672799. +-72757343748282112575270 = -72757343674813464813435 bxor 76359177672799. +72757343674813464813434 = bnot(-72757343674813464813435). +-568416747459480193855 = -72757343674813464813435 bsl -7. +-9312939990376123496119680 = -72757343674813464813435 bsr -7. +-2443173978 = 3 + -2443173981. +2443173984 = 3 - -2443173981. +-7329521943 = 3 * -2443173981. +-3 = -(3). +3 = +(3). +0 = 3 div -2443173981. +3 = 3 rem -2443173981. +3 = 3 band -2443173981. +-2443173981 = 3 bor -2443173981. +-2443173984 = 3 bxor -2443173981. +-4 = bnot(3). +805306368 = 3 bsl 28. +0 = 3 bsr 28. +-3645448931891413927754625081 = -3645448931891413927754625956 + 875. +-3645448931891413927754626831 = -3645448931891413927754625956 - 875. +-3189767815404987186785297711500 = -3645448931891413927754625956 * 875. +3645448931891413927754625956 = -(-3645448931891413927754625956). +-3645448931891413927754625956 = +(-3645448931891413927754625956). +-4166227350733044488862429 = -3645448931891413927754625956 div 875. +-581 = -3645448931891413927754625956 rem 875. +72 = -3645448931891413927754625956 band 875. +-3645448931891413927754625153 = -3645448931891413927754625956 bor 875. +-3645448931891413927754625225 = -3645448931891413927754625956 bxor 875. +3645448931891413927754625955 = bnot(-3645448931891413927754625956). +-227840558243213370484664123 = -3645448931891413927754625956 bsl -4. +-58327182910262622844074015296 = -3645448931891413927754625956 bsr -4. +64229 = 2 + 64227. +-64225 = 2 - 64227. +128454 = 2 * 64227. +-2 = -(2). +2 = +(2). +0 = 2 div 64227. +2 = 2 rem 64227. +2 = 2 band 64227. +64227 = 2 bor 64227. +64225 = 2 bxor 64227. +-3 = bnot(2). +0 = 2 bsl -342. +17917957937422433684459538244547554224973163977877196279199912807710334969441287563047019946172856926208 = 2 bsr -342. +-626757338901836109135953560 = -7541582214176877 + -626757338894294526921776683. +626757338886752944707599806 = -7541582214176877 - -626757338894294526921776683. +4726741999610040988142421334831059256358991 = -7541582214176877 * -626757338894294526921776683. +7541582214176877 = -(-7541582214176877). +-7541582214176877 = +(-7541582214176877). +0 = -7541582214176877 div -626757338894294526921776683. +-7541582214176877 = -7541582214176877 rem -626757338894294526921776683. +-626757338898942175994691183 = -7541582214176877 band -626757338894294526921776683. +-2893933141262377 = -7541582214176877 bor -626757338894294526921776683. +626757338896048242853428806 = -7541582214176877 bxor -626757338894294526921776683. +7541582214176876 = bnot(-7541582214176877). +-638132215910912451466994730205580201861516135967930979297281833843378789064718565091603858502704883635901837540941628509603367251144433729536 = -7541582214176877 bsl 415. +-1 = -7541582214176877 bsr 415. +-2284559120046200332 = 4745398416 + -2284559124791598748. +2284559129536997164 = 4745398416 - -2284559124791598748. +-10841143252044399028866783168 = 4745398416 * -2284559124791598748. +-4745398416 = -(4745398416). +4745398416 = +(4745398416). +0 = 4745398416 div -2284559124791598748. +4745398416 = 4745398416 rem -2284559124791598748. +38338560 = 4745398416 band -2284559124791598748. +-2284559120084538892 = 4745398416 bor -2284559124791598748. +-2284559120122877452 = 4745398416 bxor -2284559124791598748. +-4745398417 = bnot(4745398416). +303705498624 = 4745398416 bsl 6. +74146850 = 4745398416 bsr 6. +298778172512467885395267 = 298778172512467885395351 + -84. +298778172512467885395435 = 298778172512467885395351 - -84. +-25097366491047302373209484 = 298778172512467885395351 * -84. +-298778172512467885395351 = -(298778172512467885395351). +298778172512467885395351 = +(298778172512467885395351). +-3556883006100808159468 = 298778172512467885395351 div -84. +39 = 298778172512467885395351 rem -84. +298778172512467885395332 = 298778172512467885395351 band -84. +-65 = 298778172512467885395351 bor -84. +-298778172512467885395397 = 298778172512467885395351 bxor -84. +-298778172512467885395352 = bnot(298778172512467885395351). +0 = 298778172512467885395351 bsl -932. +10846879746341106854250683491297020349676922920531953549343983959344035170292491338416736773485060621087087608945540330413744546847830071999340448032004155221819772944774757727017866168531570434935738393729944261378667160894741412044825672639034861257924274515240621449999856178042342680768857979429584896 = 298778172512467885395351 bsr -932. +2268984308828144 = 69581485 + 2268984239246659. +-2268984169665174 = 69581485 - 2268984239246659. +157879292808377814508615 = 69581485 * 2268984239246659. +-69581485 = -(69581485). +69581485 = +(69581485). +0 = 69581485 div 2268984239246659. +69581485 = 69581485 rem 2268984239246659. +67405825 = 69581485 band 2268984239246659. +2268984241422319 = 69581485 bor 2268984239246659. +2268984174016494 = 69581485 bxor 2268984239246659. +-69581486 = bnot(69581485). +0 = 69581485 bsl -694. +5718876052055462937007598889387116086563452902110056711829245940354116255675625230745152443578140260237867922542525497080081186403510634308518282758545191993483541352254200013787566857722994263858933317597726496522240 = 69581485 bsr -694. +7902836001462 = 7899921622616 + 2914378846. +7897007243770 = 7899921622616 - 2914378846. +23023364462010065581136 = 7899921622616 * 2914378846. +-7899921622616 = -(7899921622616). +7899921622616 = +(7899921622616). +2710 = 7899921622616 div 2914378846. +1954949956 = 7899921622616 rem 2914378846. +134587480 = 7899921622616 band 2914378846. +7902701413982 = 7899921622616 bor 2914378846. +7902566826502 = 7899921622616 bxor 2914378846. +-7899921622617 = bnot(7899921622616). +500196041351084719973947319032291808337454016879701655445979098134205560779805962638448159616474260573226784074964131350101141996230429830484541064783979489766718649243075961677495618502656 = 7899921622616 bsl 584. +0 = 7899921622616 bsr 584. +69472832278273138 = 69472832278272622 + 516. +69472832278272106 = 69472832278272622 - 516. +35847981455588672952 = 69472832278272622 * 516. +-69472832278272622 = -(69472832278272622). +69472832278272622 = +(69472832278272622). +134637271857117 = 69472832278272622 div 516. +250 = 69472832278272622 rem 516. +516 = 69472832278272622 band 516. +69472832278272622 = 69472832278272622 bor 516. +69472832278272106 = 69472832278272622 bxor 516. +-69472832278272623 = bnot(69472832278272622). +271378251087002 = 69472832278272622 bsl -8. +17785045063237791232 = 69472832278272622 bsr -8. +-9782188648367 = -6133259365129 + -3648929283238. +-2484330081891 = -6133259365129 - -3648929283238. +22379829699112912901407702 = -6133259365129 * -3648929283238. +6133259365129 = -(-6133259365129). +-6133259365129 = +(-6133259365129). +1 = -6133259365129 div -3648929283238. +-2484330081891 = -6133259365129 rem -3648929283238. +-8613955305390 = -6133259365129 band -3648929283238. +-1168233342977 = -6133259365129 bor -3648929283238. +7445721962413 = -6133259365129 bxor -3648929283238. +6133259365128 = bnot(-6133259365129). +-6550281245928027744902992954685820792419231494427770677357445851271727377820455966876392907848330511124529152 = -6133259365129 bsl 319. +-1 = -6133259365129 bsr 319. +-93313685820166552986 = -98457538278635145628 + 5143852458468592642. +-103601390737103738270 = -98457538278635145628 - 5143852458468592642. +-506451050329322960710577528667879269176 = -98457538278635145628 * 5143852458468592642. +98457538278635145628 = -(-98457538278635145628). +-98457538278635145628 = +(-98457538278635145628). +-19 = -98457538278635145628 div 5143852458468592642. +-724341567731885430 = -98457538278635145628 rem 5143852458468592642. +81208305330045952 = -98457538278635145628 band 5143852458468592642. +-93394894125496598938 = -98457538278635145628 bor 5143852458468592642. +-93476102430826644890 = -98457538278635145628 bxor 5143852458468592642. +98457538278635145627 = bnot(-98457538278635145628). +-1538399035603674151 = -98457538278635145628 bsl -6. +-6301282449832649320192 = -98457538278635145628 bsr -6. +-6060 = -5229 + -831. +-4398 = -5229 - -831. +4345299 = -5229 * -831. +5229 = -(-5229). +-5229 = +(-5229). +6 = -5229 div -831. +-243 = -5229 rem -831. +-6015 = -5229 band -831. +-45 = -5229 bor -831. +5970 = -5229 bxor -831. +5228 = bnot(-5229). +-1 = -5229 bsl -76. +-395092069422805997158662144 = -5229 bsr -76. +-4343754474128429969041 = -52584374 + -4343754474128377384667. +4343754474128324800293 = -52584374 - -4343754474128377384667. +228413609831739920408471393458 = -52584374 * -4343754474128377384667. +52584374 = -(-52584374). +-52584374 = +(-52584374). +0 = -52584374 div -4343754474128377384667. +-52584374 = -52584374 rem -4343754474128377384667. +-4343754474128377536512 = -52584374 band -4343754474128377384667. +-52432529 = -52584374 bor -4343754474128377384667. +4343754474128325103983 = -52584374 bxor -4343754474128377384667. +52584373 = bnot(-52584374). +-2083081664491428131440587534952824832 = -52584374 bsl 95. +-1 = -52584374 bsr 95. +-3638 = -3631 + -7. +-3624 = -3631 - -7. +25417 = -3631 * -7. +3631 = -(-3631). +-3631 = +(-3631). +518 = -3631 div -7. +-5 = -3631 rem -7. +-3631 = -3631 band -7. +-7 = -3631 bor -7. +3624 = -3631 bxor -7. +3630 = bnot(-3631). +-908 = -3631 bsl -2. +-14524 = -3631 bsr -2. +-884549755474144167619 = -884549755474144168175 + 556. +-884549755474144168731 = -884549755474144168175 - 556. +-491809664043624157505300 = -884549755474144168175 * 556. +884549755474144168175 = -(-884549755474144168175). +-884549755474144168175 = +(-884549755474144168175). +-1590916826392345626 = -884549755474144168175 div 556. +-119 = -884549755474144168175 rem 556. +512 = -884549755474144168175 band 556. +-884549755474144168131 = -884549755474144168175 bor 556. +-884549755474144168643 = -884549755474144168175 bxor 556. +884549755474144168174 = bnot(-884549755474144168175). +-1591805238744975374454665900570029007819284350200031663884462025031376025609117149208746513976100952086165260745837921603193537457214918655990196564258865998806977944368611206784614400 = -884549755474144168175 bsl 539. +-1 = -884549755474144168175 bsr 539. +-6898178838912644673024105 = 95931631866715232 + -6898178934844276539739337. +6898179030775908406454569 = 95931631866715232 - -6898178934844276539739337. +-661753562128210935363300938280983687481184 = 95931631866715232 * -6898178934844276539739337. +-95931631866715232 = -(95931631866715232). +95931631866715232 = +(95931631866715232). +0 = 95931631866715232 div -6898178934844276539739337. +95931631866715232 = 95931631866715232 rem -6898178934844276539739337. +22607067303022624 = 95931631866715232 band -6898178934844276539739337. +-6898178861519711976046729 = 95931631866715232 bor -6898178934844276539739337. +-6898178884126779279069353 = 95931631866715232 bxor -6898178934844276539739337. +-95931631866715233 = bnot(95931631866715232). +0 = 95931631866715232 bsl -93. +950060864974336740620950611578780579207839744 = 95931631866715232 bsr -93. +432547742614636761652035 = 432547742614636761651666 + 369. +432547742614636761651297 = 432547742614636761651666 - 369. +159610117024800965049464754 = 432547742614636761651666 * 369. +-432547742614636761651666 = -(432547742614636761651666). +432547742614636761651666 = +(432547742614636761651666). +1172216104646712091196 = 432547742614636761651666 div 369. +342 = 432547742614636761651666 rem 369. +336 = 432547742614636761651666 band 369. +432547742614636761651699 = 432547742614636761651666 bor 369. +432547742614636761651363 = 432547742614636761651666 bxor 369. +-432547742614636761651667 = bnot(432547742614636761651666). +55366111054673505491413248 = 432547742614636761651666 bsl 7. +3379279239176849700403 = 432547742614636761651666 bsr 7. +-903415491 = 51542996 + -954958487. +1006501483 = 51542996 - -954958487. +-49221421475607052 = 51542996 * -954958487. +-51542996 = -(51542996). +51542996 = +(51542996). +0 = 51542996 div -954958487. +51542996 = 51542996 rem -954958487. +51411264 = 51542996 band -954958487. +-954826755 = 51542996 bor -954958487. +-1006238019 = 51542996 bxor -954958487. +-51542997 = bnot(51542996). +206171984 = 51542996 bsl 2. +12885749 = 51542996 bsr 2. +-394039090394236209 = 57478469399929949 + -451517559794166158. +508996029194096107 = 57478469399929949 - -451517559794166158. +-25952538244160020554537424066465942 = 57478469399929949 * -451517559794166158. +-57478469399929949 = -(57478469399929949). +57478469399929949 = +(57478469399929949). +0 = 57478469399929949 div -451517559794166158. +57478469399929949 = 57478469399929949 rem -451517559794166158. +38315819969545296 = 57478469399929949 band -451517559794166158. +-432354910363781505 = 57478469399929949 bor -451517559794166158. +-470670730333326801 = 57478469399929949 bxor -451517559794166158. +-57478469399929950 = bnot(57478469399929949). +898101084373905 = 57478469399929949 bsl -6. +3678622041595516736 = 57478469399929949 bsr -6. +441188502936649166298 = 7965182897847 + 441188494971466268451. +-441188487006283370604 = 7965182897847 - 441188494971466268451. +3514147054873580279719147811924997 = 7965182897847 * 441188494971466268451. +-7965182897847 = -(7965182897847). +7965182897847 = +(7965182897847). +0 = 7965182897847 div 441188494971466268451. +7965182897847 = 7965182897847 rem 441188494971466268451. +6771039383075 = 7965182897847 band 441188494971466268451. +441188496165609783223 = 7965182897847 bor 441188494971466268451. +441188489394570400148 = 7965182897847 bxor 441188494971466268451. +-7965182897848 = bnot(7965182897847). +0 = 7965182897847 bsl -395. +642752892715792032020916564971604842268294905551325536647355633728692499974443520789917622155430822468256301261612127218720409911296 = 7965182897847 bsr -395. +158154113 = -635671774 + 793825887. +-1429497661 = -635671774 - 793825887. +-504612709836413538 = -635671774 * 793825887. +635671774 = -(-635671774). +-635671774 = +(-635671774). +0 = -635671774 div 793825887. +-635671774 = -635671774 rem 793825887. +168837634 = -635671774 band 793825887. +-10683521 = -635671774 bor 793825887. +-179521155 = -635671774 bxor 793825887. +635671773 = bnot(-635671774). +-3001875079643887983740745416704 = -635671774 bsl 72. +-1 = -635671774 bsr 72. +-749159243735 = 584196 + -749159827931. +749160412127 = 584196 - -749159827931. +-437656174837978476 = 584196 * -749159827931. +-584196 = -(584196). +584196 = +(584196). +0 = 584196 div -749159827931. +584196 = 584196 rem -749159827931. +532996 = 584196 band -749159827931. +-749159776731 = 584196 bor -749159827931. +-749160309727 = 584196 bxor -749159827931. +-584197 = bnot(584196). +74777088 = 584196 bsl 7. +4564 = 584196 bsr 7. +-289323663941639762 = -824322113 + -289323663117317649. +289323662292995536 = -824322113 - -289323663117317649. +238495893321767451315872337 = -824322113 * -289323663117317649. +824322113 = -(-824322113). +-824322113 = +(-824322113). +0 = -824322113 div -289323663117317649. +-824322113 = -824322113 rem -289323663117317649. +-289323663117450833 = -824322113 band -289323663117317649. +-824188929 = -824322113 bor -289323663117317649. +289323662293261904 = -824322113 bxor -289323663117317649. +824322112 = bnot(-824322113). +-1610005 = -824322113 bsl -9. +-422052921856 = -824322113 bsr -9. +-326847 = 44525 + -371372. +415897 = 44525 - -371372. +-16535338300 = 44525 * -371372. +-44525 = -(44525). +44525 = +(44525). +0 = 44525 div -371372. +44525 = 44525 rem -371372. +1348 = 44525 band -371372. +-328195 = 44525 bor -371372. +-329543 = 44525 bxor -371372. +-44526 = bnot(44525). +6416728749077482700800 = 44525 bsl 57. +0 = 44525 bsr 57. +23581337831219595386137516208 = -3 + 23581337831219595386137516211. +-23581337831219595386137516214 = -3 - 23581337831219595386137516211. +-70744013493658786158412548633 = -3 * 23581337831219595386137516211. +3 = -(-3). +-3 = +(-3). +0 = -3 div 23581337831219595386137516211. +-3 = -3 rem 23581337831219595386137516211. +23581337831219595386137516209 = -3 band 23581337831219595386137516211. +-1 = -3 bor 23581337831219595386137516211. +-23581337831219595386137516210 = -3 bxor 23581337831219595386137516211. +2 = bnot(-3). +-1536 = -3 bsl 9. +-1 = -3 bsr 9. +473833510 = 58349 + 473775161. +-473716812 = 58349 - 473775161. +27644306869189 = 58349 * 473775161. +-58349 = -(58349). +58349 = +(58349). +0 = 58349 div 473775161. +58349 = 58349 rem 473775161. +8233 = 58349 band 473775161. +473825277 = 58349 bor 473775161. +473817044 = 58349 bxor 473775161. +-58350 = bnot(58349). +14937344 = 58349 bsl 8. +227 = 58349 bsr 8. +-33376122770 = 86 + -33376122856. +33376122942 = 86 - -33376122856. +-2870346565616 = 86 * -33376122856. +-86 = -(86). +86 = +(86). +0 = 86 div -33376122856. +86 = 86 rem -33376122856. +16 = 86 band -33376122856. +-33376122786 = 86 bor -33376122856. +-33376122802 = 86 bxor -33376122856. +-87 = bnot(86). +0 = 86 bsl -65. +3172839980678042877952 = 86 bsr -65. +-929864438874349386957477629 = -929864438874349386957477632 + 3. +-929864438874349386957477635 = -929864438874349386957477632 - 3. +-2789593316623048160872432896 = -929864438874349386957477632 * 3. +929864438874349386957477632 = -(-929864438874349386957477632). +-929864438874349386957477632 = +(-929864438874349386957477632). +-309954812958116462319159210 = -929864438874349386957477632 div 3. +-2 = -929864438874349386957477632 rem 3. +0 = -929864438874349386957477632 band 3. +-929864438874349386957477629 = -929864438874349386957477632 bor 3. +-929864438874349386957477629 = -929864438874349386957477632 bxor 3. +929864438874349386957477631 = bnot(-929864438874349386957477632). +-7438915510994795095659821056 = -929864438874349386957477632 bsl 3. +-116233054859293673369684704 = -929864438874349386957477632 bsr 3. +-3817912565748568606797 = -3817912565738985778851 + -9582827946. +-3817912565729402950905 = -3817912565738985778851 - -9582827946. +36586399230348115063269938570046 = -3817912565738985778851 * -9582827946. +3817912565738985778851 = -(-3817912565738985778851). +-3817912565738985778851 = +(-3817912565738985778851). +398411887101 = -3817912565738985778851 div -9582827946. +-8926054305 = -3817912565738985778851 rem -9582827946. +-3817912565739170987948 = -3817912565738985778851 band -9582827946. +-9397618849 = -3817912565738985778851 bor -9582827946. +3817912565729773369099 = -3817912565738985778851 bxor -9582827946. +3817912565738985778850 = bnot(-3817912565738985778851). +-1043841503321345663125349288538610526431071093780390609101774787620215813866056745943147557256981444124967678463891734528 = -3817912565738985778851 bsl 327. +-1 = -3817912565738985778851 bsr 327. +-38146852966143458950 = -38146852966148174367 + 4715417. +-38146852966152889784 = -38146852966148174367 - 4715417. +-179878318973075525929116039 = -38146852966148174367 * 4715417. +38146852966148174367 = -(-38146852966148174367). +-38146852966148174367 = +(-38146852966148174367). +-8089815379243 = -38146852966148174367 div 4715417. +-4285036 = -38146852966148174367 rem 4715417. +426369 = -38146852966148174367 band 4715417. +-38146852966143885319 = -38146852966148174367 bor 4715417. +-38146852966144311688 = -38146852966148174367 bxor 4715417. +38146852966148174366 = bnot(-38146852966148174367). +-5902939582440887005209827326210539013093195776 = -38146852966148174367 bsl 87. +-1 = -38146852966148174367 bsr 87. +27296884958896974342379 = 9828 + 27296884958896974332551. +-27296884958896974322723 = 9828 - 27296884958896974332551. +268273785376039463740311228 = 9828 * 27296884958896974332551. +-9828 = -(9828). +9828 = +(9828). +0 = 9828 div 27296884958896974332551. +9828 = 9828 rem 27296884958896974332551. +516 = 9828 band 27296884958896974332551. +27296884958896974341863 = 9828 bor 27296884958896974332551. +27296884958896974341347 = 9828 bxor 27296884958896974332551. +-9829 = bnot(9828). +157248 = 9828 bsl 4. +614 = 9828 bsr 4. +481750492244047 = 594898489335 + 481155593754712. +-480560695265377 = 594898489335 - 481155593754712. +286238735859763129337996520 = 594898489335 * 481155593754712. +-594898489335 = -(594898489335). +594898489335 = +(594898489335). +0 = 594898489335 div 481155593754712. +594898489335 = 594898489335 rem 481155593754712. +594856511568 = 594898489335 band 481155593754712. +481155635732479 = 594898489335 bor 481155593754712. +480560779220911 = 594898489335 bxor 481155593754712. +-594898489336 = bnot(594898489335). +18590577791 = 594898489335 bsl -5. +19036751658720 = 594898489335 bsr -5. +-56521177399366874777959624 = -56521177399366874777956856 + -2768. +-56521177399366874777954088 = -56521177399366874777956856 - -2768. +156450619041447509385384577408 = -56521177399366874777956856 * -2768. +56521177399366874777956856 = -(-56521177399366874777956856). +-56521177399366874777956856 = +(-56521177399366874777956856). +20419500505551616610533 = -56521177399366874777956856 div -2768. +-1512 = -56521177399366874777956856 rem -2768. +-56521177399366874777959424 = -56521177399366874777956856 band -2768. +-200 = -56521177399366874777956856 bor -2768. +56521177399366874777959224 = -56521177399366874777956856 bxor -2768. +56521177399366874777956855 = bnot(-56521177399366874777956856). +-4270619419569590861925385289086088873382212796416 = -56521177399366874777956856 bsl 76. +-749 = -56521177399366874777956856 bsr 76. +3331606320261 = -4222816969137 + 7554423289398. +-11777240258535 = -4222816969137 - 7554423289398. +-31900946858513628185309526 = -4222816969137 * 7554423289398. +4222816969137 = -(-4222816969137). +-4222816969137 = +(-4222816969137). +0 = -4222816969137 div 7554423289398. +-4222816969137 = -4222816969137 rem 7554423289398. +4435698128390 = -4222816969137 band 7554423289398. +-1104091808129 = -4222816969137 bor 7554423289398. +-5539789936519 = -4222816969137 bxor 7554423289398. +4222816969136 = bnot(-4222816969137). +-326724637791776765240250227125458567168 = -4222816969137 bsl 86. +-1 = -4222816969137 bsr 86. +-3869944912635894845431 = -3869944912635894845426 + -5. +-3869944912635894845421 = -3869944912635894845426 - -5. +19349724563179474227130 = -3869944912635894845426 * -5. +3869944912635894845426 = -(-3869944912635894845426). +-3869944912635894845426 = +(-3869944912635894845426). +773988982527178969085 = -3869944912635894845426 div -5. +-1 = -3869944912635894845426 rem -5. +-3869944912635894845430 = -3869944912635894845426 band -5. +-1 = -3869944912635894845426 bor -5. +3869944912635894845429 = -3869944912635894845426 bxor -5. +3869944912635894845425 = bnot(-3869944912635894845426). +-8115862713424192146874826752 = -3869944912635894845426 bsl 21. +-1845333534543941 = -3869944912635894845426 bsr 21. +-791938612820188974009 = 7984591332 + -791938612828173565341. +791938612836158156673 = 7984591332 - -791938612828173565341. +-6323306183463938655213284224212 = 7984591332 * -791938612828173565341. +-7984591332 = -(7984591332). +7984591332 = +(7984591332). +0 = 7984591332 div -791938612828173565341. +7984591332 = 7984591332 rem -791938612828173565341. +3641376864 = 7984591332 band -791938612828173565341. +-791938612823830350873 = 7984591332 bor -791938612828173565341. +-791938612827471727737 = 7984591332 bxor -791938612828173565341. +-7984591333 = bnot(7984591332). +152795239135758123610193604886969735300219218331318199952071007164863589275883561950294154464429070843944911676374127825687842495580767193068162538932842201844502675203742537259543974199411276738883515609776128 = 7984591332 bsl 662. +0 = 7984591332 bsr 662. +-95762135561856276171733400868 = -322622315345758699 + -95762135561533653856387642169. +95762135561211031541041883470 = -322622315345758699 - -95762135561533653856387642169. +30895001897316403762773969256055325231030978131 = -322622315345758699 * -95762135561533653856387642169. +322622315345758699 = -(-322622315345758699). +-322622315345758699 = +(-322622315345758699). +0 = -322622315345758699 div -95762135561533653856387642169. +-322622315345758699 = -322622315345758699 rem -95762135561533653856387642169. +-95762135561847268696518360059 = -322622315345758699 band -95762135561533653856387642169. +-9007475215040809 = -322622315345758699 bor -95762135561533653856387642169. +95762135561838261221303319250 = -322622315345758699 bxor -95762135561533653856387642169. +322622315345758698 = bnot(-322622315345758699). +-2567161184092343845628212333860085140646302889367202631469553957315392947157823861052588997808445984866304 = -322622315345758699 bsl 292. +-1 = -322622315345758699 bsr 292. +-99095 = -6558 + -92537. +85979 = -6558 - -92537. +606857646 = -6558 * -92537. +6558 = -(-6558). +-6558 = +(-6558). +0 = -6558 div -92537. +-6558 = -6558 rem -92537. +-96766 = -6558 band -92537. +-2329 = -6558 bor -92537. +94437 = -6558 bxor -92537. +6557 = bnot(-6558). +-606859543878319811624706237634247050128856807962137244692439035497596391899422384533757007425919985914188536281096075659160210009175834225362040755136016959601808532043977599179663642833949482510332748217129266385338025669296128 = -6558 bsl 744. +-1 = -6558 bsr 744. +-4816162758613654499450998419 = -4816162758613654499451532177 + 533758. +-4816162758613654499452065935 = -4816162758613654499451532177 - 533758. +-2570665401712106998318250911731166 = -4816162758613654499451532177 * 533758. +4816162758613654499451532177 = -(-4816162758613654499451532177). +-4816162758613654499451532177 = +(-4816162758613654499451532177). +-9023120512692370886153 = -4816162758613654499451532177 div 533758. +-279203 = -4816162758613654499451532177 rem 533758. +1134 = -4816162758613654499451532177 band 533758. +-4816162758613654499450999553 = -4816162758613654499451532177 bor 533758. +-4816162758613654499451000687 = -4816162758613654499451532177 bxor 533758. +4816162758613654499451532176 = bnot(-4816162758613654499451532177). +-875143398867689885702861582865761345058340424630704765607334381359968415311325768611320589070116093115457035529403987868423505377358747196387899692483366279446528 = -4816162758613654499451532177 bsl 446. +-1 = -4816162758613654499451532177 bsr 446. +-234214727464624993697749987957 = 45666987 + -234214727464624993697795654944. +234214727464624993697841321931 = 45666987 - -234214727464624993697795654944. +-10695880914335572547072316102984133728 = 45666987 * -234214727464624993697795654944. +-45666987 = -(45666987). +45666987 = +(45666987). +0 = 45666987 div -234214727464624993697795654944. +45666987 = 45666987 rem -234214727464624993697795654944. +2626208 = 45666987 band -234214727464624993697795654944. +-234214727464624993697752614165 = 45666987 bor -234214727464624993697795654944. +-234214727464624993697755240373 = 45666987 bxor -234214727464624993697795654944. +-45666988 = bnot(45666987). +0 = 45666987 bsl -814. +4989061176068287327376163286037207456904942639896041682600096896425602836184001940372722721400138276293043823722192536810459596531044311721135428994959988087426858384533388806703417525251556871597511867028804791274242795579764130948539744305141942059008 = 45666987 bsr -814. +294237733793 = 294237675975 + 57818. +294237618157 = 294237675975 - 57818. +17012233949522550 = 294237675975 * 57818. +-294237675975 = -(294237675975). +294237675975 = +(294237675975). +5089032 = 294237675975 div 57818. +23799 = 294237675975 rem 57818. +41410 = 294237675975 band 57818. +294237692383 = 294237675975 bor 57818. +294237650973 = 294237675975 bxor 57818. +-294237675976 = bnot(294237675975). +2298731843 = 294237675975 bsl -7. +37662422524800 = 294237675975 bsr -7. +619635526811414968622238 = 619635526811414968622274 + -36. +619635526811414968622310 = 619635526811414968622274 - -36. +-22306878965210938870401864 = 619635526811414968622274 * -36. +-619635526811414968622274 = -(619635526811414968622274). +619635526811414968622274 = +(619635526811414968622274). +-17212097966983749128396 = 619635526811414968622274 div -36. +18 = 619635526811414968622274 rem -36. +619635526811414968622272 = 619635526811414968622274 band -36. +-34 = 619635526811414968622274 bor -36. +-619635526811414968622306 = 619635526811414968622274 bxor -36. +-619635526811414968622275 = bnot(619635526811414968622274). +0 = 619635526811414968622274 bsl -898. +1309400240447349610752865658212333969519436336204740814484295543713792185287997964704284463880988952952448374164567391624130625099714206654273655760270277077772585340072874724861337858038465105456883583603200323496638775911839793771182071797910195619316242423523255972536276419270994033698144256 = 619635526811414968622274 bsr -898. +9775526678384975794014685742 = -33684429226 + 9775526678384975827699114968. +-9775526678384975861383544194 = -33684429226 - 9775526678384975827699114968. +-329283036544933582249851608562433254768 = -33684429226 * 9775526678384975827699114968. +33684429226 = -(-33684429226). +-33684429226 = +(-33684429226). +0 = -33684429226 div 9775526678384975827699114968. +-33684429226 = -33684429226 rem 9775526678384975827699114968. +9775526678384975806094910032 = -33684429226 band 9775526678384975827699114968. +-12080224290 = -33684429226 bor 9775526678384975827699114968. +-9775526678384975818175134322 = -33684429226 bxor 9775526678384975827699114968. +33684429225 = bnot(-33684429226). +-121887201088907928216526935522257963350171324723121089166932176873234351228518345474048 = -33684429226 bsl 251. +-1 = -33684429226 bsr 251. +9086916786367603 = -34196395468764 + 9121113181836367. +-9155309577305131 = -34196395468764 - 9121113181836367. +-311909193481432730867307740388 = -34196395468764 * 9121113181836367. +34196395468764 = -(-34196395468764). +-34196395468764 = +(-34196395468764). +0 = -34196395468764 div 9121113181836367. +-34196395468764 = -34196395468764 rem 9121113181836367. +9113310836871172 = -34196395468764 band 9121113181836367. +-26394050503569 = -34196395468764 bor 9121113181836367. +-9139704887374741 = -34196395468764 bxor 9121113181836367. +34196395468763 = bnot(-34196395468764). +-21166543575010053090615518150392773869568 = -34196395468764 bsl 89. +-1 = -34196395468764 bsr 89. +999476298913469228469154575859 = 42153428 + 999476298913469228469112422431. +-999476298913469228469070269003 = 42153428 - 999476298913469228469112422431. +42131352203955403352488280722850743468 = 42153428 * 999476298913469228469112422431. +-42153428 = -(42153428). +42153428 = +(42153428). +0 = 42153428 div 999476298913469228469112422431. +42153428 = 42153428 rem 999476298913469228469112422431. +8519700 = 42153428 band 999476298913469228469112422431. +999476298913469228469146056159 = 42153428 bor 999476298913469228469112422431. +999476298913469228469137536459 = 42153428 bxor 999476298913469228469112422431. +-42153429 = bnot(42153428). +329323 = 42153428 bsl -7. +5395638784 = 42153428 bsr -7. +595927225325835812808187095571 = -494321158288683628236833357 + 596421546484124496436423928928. +-596915867642413180064660762285 = -494321158288683628236833357 - 596421546484124496436423928928. +-294823789686360385692280171002505341469922006947147651296 = -494321158288683628236833357 * 596421546484124496436423928928. +494321158288683628236833357 = -(-494321158288683628236833357). +-494321158288683628236833357 = +(-494321158288683628236833357). +0 = -494321158288683628236833357 div 596421546484124496436423928928. +-494321158288683628236833357 = -494321158288683628236833357 rem 596421546484124496436423928928. +596111740048785683094737824800 = -494321158288683628236833357 band 596421546484124496436423928928. +-184514722949870286550729229 = -494321158288683628236833357 bor 596421546484124496436423928928. +-596296254771735553381288554029 = -494321158288683628236833357 bxor 596421546484124496436423928928. +494321158288683628236833356 = bnot(-494321158288683628236833357). +-74299794547651704779075817488211167888677617799570034016983255678418711265003573368175743881415842265896826807944841365719178660594843648 = -494321158288683628236833357 bsl 366. +-1 = -494321158288683628236833357 bsr 366. +76696419294522 = -6 + 76696419294528. +-76696419294534 = -6 - 76696419294528. +-460178515767168 = -6 * 76696419294528. +6 = -(-6). +-6 = +(-6). +0 = -6 div 76696419294528. +-6 = -6 rem 76696419294528. +76696419294528 = -6 band 76696419294528. +-6 = -6 bor 76696419294528. +-76696419294534 = -6 bxor 76696419294528. +5 = bnot(-6). +-27881567033958432427463671840310635502461128781113646107295722362173887321757582003971905896802931573558726071066118244696023473353966982021078073395669899233430703258389872636425370184393082566316984920919089447613770288253960251652945605131537339056475845727265198365445600290275328 = -6 bsl 939. +-1 = -6 bsr 939. +-5963204504535392 = 612459256858577 + -6575663761393969. +7188123018252546 = 612459256858577 - -6575663761393969. +-4027326140655225441893413722113 = 612459256858577 * -6575663761393969. +-612459256858577 = -(612459256858577). +612459256858577 = +(612459256858577). +0 = 612459256858577 div -6575663761393969. +612459256858577 = 612459256858577 rem -6575663761393969. +36315161740993 = 612459256858577 band -6575663761393969. +-5999519666276385 = 612459256858577 bor -6575663761393969. +-6035834828017378 = 612459256858577 bxor -6575663761393969. +-612459256858578 = bnot(612459256858577). +0 = 612459256858577 bsl -439. +869451376832272522741917124901056592656087690916267199941797101960482731922298972310236064550080148577974253133047874586483234014371207396380901376 = 612459256858577 bsr -439. +526301200591041754927532011 = 527268739875958669246658124 + -967539284916914319126113. +528236279160875583565784237 = 527268739875958669246658124 - -967539284916914319126113. +-510153219538627557276352650964165768447981351992012 = 527268739875958669246658124 * -967539284916914319126113. +-527268739875958669246658124 = -(527268739875958669246658124). +527268739875958669246658124 = +(527268739875958669246658124). +-544 = 527268739875958669246658124 div -967539284916914319126113. +927368881157279642052652 = 527268739875958669246658124 rem -967539284916914319126113. +527248039701759342747455500 = 527268739875958669246658124 band -967539284916914319126113. +-946839110717587819923489 = 527268739875958669246658124 bor -967539284916914319126113. +-528194878812476930567378989 = 527268739875958669246658124 bxor -967539284916914319126113. +-527268739875958669246658125 = bnot(527268739875958669246658124). +1029821757570231775872379 = 527268739875958669246658124 bsl -9. +269961594816490838654288959488 = 527268739875958669246658124 bsr -9. +25 = -33 + 58. +-91 = -33 - 58. +-1914 = -33 * 58. +33 = -(-33). +-33 = +(-33). +0 = -33 div 58. +-33 = -33 rem 58. +26 = -33 band 58. +-1 = -33 bor 58. +-27 = -33 bxor 58. +32 = bnot(-33). +-1 = -33 bsl -977. +-42152147337373282422182591699338030515344570620396863276533797760273915156272521069378312231204466007006912477349345499552697890314872698114811308379775639597158519812726929488050396676904946289297638894444767674739146716812152782613332623269622692606550393553215967599486611419264865489676926976 = -33 bsr -977. +-363991769580627863095264 = 97355814189858 + -363991769677983677285122. +363991769775339491474980 = 97355814189858 - -363991769677983677285122. +-35436715095407368188328987401306692676 = 97355814189858 * -363991769677983677285122. +-97355814189858 = -(97355814189858). +97355814189858 = +(97355814189858). +0 = 97355814189858 div -363991769677983677285122. +97355814189858 = 97355814189858 rem -363991769677983677285122. +70967526733858 = 97355814189858 band -363991769677983677285122. +-363991769651595389829122 = 97355814189858 bor -363991769677983677285122. +-363991769722562916562980 = 97355814189858 bxor -363991769677983677285122. +-97355814189859 = bnot(97355814189858). +0 = 97355814189858 bsl -51. +219225804253897867858525814784 = 97355814189858 bsr -51. +-442434983275624365774696314360 = 35967576152264915259 + -442434983311591941926961229619. +442434983347559518079226144878 = 35967576152264915259 - -442434983311591941926961229619. +-15913313954685740093802190705270834339315475856321 = 35967576152264915259 * -442434983311591941926961229619. +-35967576152264915259 = -(35967576152264915259). +35967576152264915259 = +(35967576152264915259). +0 = 35967576152264915259 div -442434983311591941926961229619. +35967576152264915259 = 35967576152264915259 rem -442434983311591941926961229619. +26734058852615229449 = 35967576152264915259 band -442434983311591941926961229619. +-442434983302358424627311543809 = 35967576152264915259 bor -442434983311591941926961229619. +-442434983329092483479926773258 = 35967576152264915259 bxor -442434983311591941926961229619. +-35967576152264915260 = bnot(35967576152264915259). +143870304609059661036 = 35967576152264915259 bsl 2. +8991894038066228814 = 35967576152264915259 bsr 2. +-9425177621947 = -9425177618185 + -3762. +-9425177614423 = -9425177618185 - -3762. +35457518199611970 = -9425177618185 * -3762. +9425177618185 = -(-9425177618185). +-9425177618185 = +(-9425177618185). +2505363534 = -9425177618185 div -3762. +-3277 = -9425177618185 rem -3762. +-9425177620410 = -9425177618185 band -3762. +-1537 = -9425177618185 bor -3762. +9425177618873 = -9425177618185 bxor -3762. +9425177618184 = bnot(-9425177618185). +-1 = -9425177618185 bsl -74. +-178036571516839993116237002482647040 = -9425177618185 bsr -74. +7498725127338 = 7498725127332 + 6. +7498725127326 = 7498725127332 - 6. +44992350763992 = 7498725127332 * 6. +-7498725127332 = -(7498725127332). +7498725127332 = +(7498725127332). +1249787521222 = 7498725127332 div 6. +0 = 7498725127332 rem 6. +4 = 7498725127332 band 6. +7498725127334 = 7498725127332 bor 6. +7498725127330 = 7498725127332 bxor 6. +-7498725127333 = bnot(7498725127332). +0 = 7498725127332 bsl -638. +8553122025330921140993595282243144990572367479830507462601522123573495966844348731535465006154186485117158657367833571146441807249102545221406114737060457937917228945748790915862864350301737636832538001408 = 7498725127332 bsr -638. +8974004074 = -43849548455 + 52823552529. +-96673100984 = -43849548455 - 52823552529. +-2316288926185623292695 = -43849548455 * 52823552529. +43849548455 = -(-43849548455). +-43849548455 = +(-43849548455). +0 = -43849548455 div 52823552529. +-43849548455 = -43849548455 rem 52823552529. +18388119569 = -43849548455 band 52823552529. +-9414115495 = -43849548455 bor 52823552529. +-27802235064 = -43849548455 bxor 52823552529. +43849548454 = bnot(-43849548455). +-171287299 = -43849548455 bsl -8. +-11225484404480 = -43849548455 bsr -8. +-2696151341480155039610 = -2696668659469524633754 + 517317989369594144. +-2697185977458894227898 = -2696668659469524633754 - 517317989369594144. +-1395035208912773235167847251805223136576 = -2696668659469524633754 * 517317989369594144. +2696668659469524633754 = -(-2696668659469524633754). +-2696668659469524633754 = +(-2696668659469524633754). +-5212 = -2696668659469524633754 div 517317989369594144. +-407298875199955226 = -2696668659469524633754 rem 517317989369594144. +10205393930699040 = -2696668659469524633754 band 517317989369594144. +-2696161546874085738650 = -2696668659469524633754 bor 517317989369594144. +-2696171752268016437690 = -2696668659469524633754 bxor 517317989369594144. +2696668659469524633753 = bnot(-2696668659469524633754). +-46328414802279076042559230836736 = -2696668659469524633754 bsl 34. +-156966774927 = -2696668659469524633754 bsr 34. +-337159831121812558591892981637 = -213354536394912 + -337159831121812345237356586725. +337159831121812131882820191813 = -213354536394912 - -337159831121812345237356586725. +71934579459981095625165181309631098976743200 = -213354536394912 * -337159831121812345237356586725. +213354536394912 = -(-213354536394912). +-213354536394912 = +(-213354536394912). +0 = -213354536394912 div -337159831121812345237356586725. +-213354536394912 = -213354536394912 rem -337159831121812345237356586725. +-337159831121812415620346210048 = -213354536394912 band -337159831121812345237356586725. +-142971546771589 = -213354536394912 bor -337159831121812345237356586725. +337159831121812272648799438459 = -213354536394912 bxor -337159831121812345237356586725. +213354536394911 = bnot(-213354536394912). +-1876686348839708223074205696 = -213354536394912 bsl 43. +-25 = -213354536394912 bsr 43. +296274581723538294441 = 296274581723538337699 + -43258. +296274581723538380957 = 296274581723538337699 - -43258. +-12816245856196821412183342 = 296274581723538337699 * -43258. +-296274581723538337699 = -(296274581723538337699). +296274581723538337699 = +(296274581723538337699). +-6849012476849099 = 296274581723538337699 div -43258. +13157 = 296274581723538337699 rem -43258. +296274581723538327298 = 296274581723538337699 band -43258. +-32857 = 296274581723538337699 bor -43258. +-296274581723538360155 = 296274581723538337699 bxor -43258. +-296274581723538337700 = bnot(296274581723538337699). +4629290339430286526 = 296274581723538337699 bsl -6. +18961573230306453612736 = 296274581723538337699 bsr -6. +-2795179228387527847137412139 = 73811352538545589 + -2795179228461339199675957728. +2795179228535150552214503317 = 73811352538545589 - -2795179228461339199675957728. +-206315959440379770010957884816805519764861792 = 73811352538545589 * -2795179228461339199675957728. +-73811352538545589 = -(73811352538545589). +73811352538545589 = +(73811352538545589). +0 = 73811352538545589 div -2795179228461339199675957728. +73811352538545589 = 73811352538545589 rem -2795179228461339199675957728. +591574440442912 = 73811352538545589 band -2795179228461339199675957728. +-2795179228388119421577855051 = 73811352538545589 bor -2795179228461339199675957728. +-2795179228388710996018297963 = 73811352538545589 bxor -2795179228461339199675957728. +-73811352538545590 = bnot(73811352538545589). +21951745852486365331390533787549643026759044079118398227826506135038082976341265195515789437916237414977760255060471755358280849338222559163449801749157628373115303872545583140012311157645083351087974141647608316563146738157835625890058188866567715570838242838777132323892260829840559655555770559234048 = 73811352538545589 bsl 945. +0 = 73811352538545589 bsr 945. +3856978036337648058739 = 3856981361636182577366 + -3325298534518627. +3856984686934717095993 = 3856981361636182577366 - -3325298534518627. +-12825614469514456438512789842995596482 = 3856981361636182577366 * -3325298534518627. +-3856981361636182577366 = -(3856981361636182577366). +3856981361636182577366 = +(3856981361636182577366). +-1159890 = 3856981361636182577366 div -3325298534518627. +844433372306336 = 3856981361636182577366 rem -3325298534518627. +3856978458830441795732 = 3856981361636182577366 band -3325298534518627. +-422492793736993 = 3856981361636182577366 bor -3325298534518627. +-3856978881323235532725 = 3856981361636182577366 bxor -3325298534518627. +-3856981361636182577367 = bnot(3856981361636182577366). +30132666887782676385 = 3856981361636182577366 bsl -7. +493693614289431369902848 = 3856981361636182577366 bsr -7. +-661321514381874695658958184 = -99198762598991 + -661321514381775496896359193. +661321514381676298133760202 = -99198762598991 - -661321514381775496896359193. +65602275906762959875107760914366155374263 = -99198762598991 * -661321514381775496896359193. +99198762598991 = -(-99198762598991). +-99198762598991 = +(-99198762598991). +0 = -99198762598991 div -661321514381775496896359193. +-99198762598991 = -99198762598991 rem -661321514381775496896359193. +-661321514381854730469895007 = -99198762598991 band -661321514381775496896359193. +-19965189063177 = -99198762598991 bor -661321514381775496896359193. +661321514381834765280831830 = -99198762598991 bxor -661321514381775496896359193. +99198762598990 = bnot(-99198762598991). +-843011706507761063802353817455684884896075820720354110340744260908722957174197815508162477953706034861601895234230996573606424974614263170204716079184952542065012482111122397761684618867382385901568 = -99198762598991 bsl 611. +-1 = -99198762598991 bsr 611. +-79187846614272646 = -72626285391 + -79187773987987255. +79187701361701864 = -72626285391 - -79187773987987255. +5751113873129568587300691705 = -72626285391 * -79187773987987255. +72626285391 = -(-72626285391). +-72626285391 = +(-72626285391). +0 = -72626285391 div -79187773987987255. +-72626285391 = -72626285391 rem -79187773987987255. +-79187776282541951 = -72626285391 band -79187773987987255. +-70331730695 = -72626285391 bor -79187773987987255. +79187705950811256 = -72626285391 bxor -79187773987987255. +72626285390 = bnot(-72626285391). +-1162020566256 = -72626285391 bsl 4. +-4539142837 = -72626285391 bsr 4. +654631766685886951274 = 266748 + 654631766685886684526. +-654631766685886417778 = 266748 - 654631766685886684526. +174621714499926901323941448 = 266748 * 654631766685886684526. +-266748 = -(266748). +266748 = +(266748). +0 = 266748 div 654631766685886684526. +266748 = 266748 rem 654631766685886684526. +4460 = 266748 band 654631766685886684526. +654631766685886946814 = 266748 bor 654631766685886684526. +654631766685886942354 = 266748 bxor 654631766685886684526. +-266749 = bnot(266748). +4167 = 266748 bsl -6. +17071872 = 266748 bsr -6. +3194331913276412233660393 = 36414377791915 + 3194331913239997855868478. +-3194331913203583478076563 = 36414377791915 - 3194331913239997855868478. +116319609081491930476239322338291755370 = 36414377791915 * 3194331913239997855868478. +-36414377791915 = -(36414377791915). +36414377791915 = +(36414377791915). +0 = 36414377791915 div 3194331913239997855868478. +36414377791915 = 36414377791915 rem 3194331913239997855868478. +1185411792938 = 36414377791915 band 3194331913239997855868478. +3194331913275226821867455 = 36414377791915 bor 3194331913239997855868478. +3194331913274041410074517 = 36414377791915 bxor 3194331913239997855868478. +-36414377791916 = bnot(36414377791915). +0 = 36414377791915 bsl -243. +514709092139009613858501395657339641731606256350238568349145338242232949900516335288320 = 36414377791915 bsr -243. +6339132293665891298 = 6339132293665891257 + 41. +6339132293665891216 = 6339132293665891257 - 41. +259904424040301541537 = 6339132293665891257 * 41. +-6339132293665891257 = -(6339132293665891257). +6339132293665891257 = +(6339132293665891257). +154612982772338811 = 6339132293665891257 div 41. +6 = 6339132293665891257 rem 41. +41 = 6339132293665891257 band 41. +6339132293665891257 = 6339132293665891257 bor 41. +6339132293665891216 = 6339132293665891257 bxor 41. +-6339132293665891258 = bnot(6339132293665891257). +6540876802517922337097795615425271354928844298415014190466702337110754307535259672876481376235273683129339522762233785446355493168525251329916155541611588867156042761429400960498727161711020718201875316876620233162795732755392651208565655320924567661735650320962331384548650016829341696 = 6339132293665891257 bsl 887. +0 = 6339132293665891257 bsr 887. +383295354711715984308705 = -42155431778539617 + 383295396867147762848322. +-383295439022579541387939 = -42155431778539617 - 383295396867147762848322. +-16157982953661315158369020707121438972674 = -42155431778539617 * 383295396867147762848322. +42155431778539617 = -(-42155431778539617). +-42155431778539617 = +(-42155431778539617). +0 = -42155431778539617 div 383295396867147762848322. +-42155431778539617 = -42155431778539617 rem 383295396867147762848322. +383295395389385881420290 = -42155431778539617 band 383295396867147762848322. +-40677669897111585 = -42155431778539617 bor 383295396867147762848322. +-383295436067055778531875 = -42155431778539617 bxor 383295396867147762848322. +42155431778539616 = bnot(-42155431778539617). +-1414501569043646637932544 = -42155431778539617 bsl 25. +-1256329769 = -42155431778539617 bsr 25. +48709579420901383 = -23944221635562 + 48733523642536945. +-48757467864172507 = -23944221635562 - 48733523642536945. +-1166886291178805365042910838090 = -23944221635562 * 48733523642536945. +23944221635562 = -(-23944221635562). +-23944221635562 = +(-23944221635562). +0 = -23944221635562 div 48733523642536945. +-23944221635562 = -23944221635562 rem 48733523642536945. +48732696319148048 = -23944221635562 band 48733523642536945. +-23116898246665 = -23944221635562 bor 48733523642536945. +-48755813217394713 = -23944221635562 bxor 48733523642536945. +23944221635561 = bnot(-23944221635562). +-187064231528 = -23944221635562 bsl -7. +-3064860369351936 = -23944221635562 bsr -7. +-433297913832315274130561120 = 7923238216626 + -433297913832323197368777746. +433297913832331120606994372 = 7923238216626 - -433297913832323197368777746. +-3433122590060582667514644803870396004996 = 7923238216626 * -433297913832323197368777746. +-7923238216626 = -(7923238216626). +7923238216626 = +(7923238216626). +0 = 7923238216626 div -433297913832323197368777746. +7923238216626 = 7923238216626 rem -433297913832323197368777746. +7698800182178 = 7923238216626 band -433297913832323197368777746. +-433297913832322972930743298 = 7923238216626 bor -433297913832323197368777746. +-433297913832330671730925476 = 7923238216626 bxor -433297913832323197368777746. +-7923238216627 = bnot(7923238216626). +0 = 7923238216626 bsl -88. +2452123457289354197191493662153749037056 = 7923238216626 bsr -88. +473357648279047 = -9836574172179 + 483194222451226. +-493030796623405 = -9836574172179 - 483194222451226. +-4752975808709843967153641454 = -9836574172179 * 483194222451226. +9836574172179 = -(-9836574172179). +-9836574172179 = +(-9836574172179). +0 = -9836574172179 div 483194222451226. +-9836574172179 = -9836574172179 rem 483194222451226. +482703497271816 = -9836574172179 band 483194222451226. +-9345848992769 = -9836574172179 bor 483194222451226. +-492049346264585 = -9836574172179 bxor 483194222451226. +9836574172178 = bnot(-9836574172179). +-1 = -9836574172179 bsl -828. +-17606793912749172550843427523076589979264544829358355822456798783172507525100432953497835342733207977676835352380503993144327689305889086352246266155981325126663410035213905986199732431751681161072054055564182178329935567160742995579258415951996305623912099610624 = -9836574172179 bsr -828. +952179116216 = 4474585 + 952174641631. +-952170167046 = 4474585 - 952174641631. +4260586368822448135 = 4474585 * 952174641631. +-4474585 = -(4474585). +4474585 = +(4474585). +0 = 4474585 div 952174641631. +4474585 = 4474585 rem 952174641631. +217 = 4474585 band 952174641631. +952179115999 = 4474585 bor 952174641631. +952179115782 = 4474585 bxor 952174641631. +-4474586 = bnot(4474585). +34957 = 4474585 bsl -7. +572746880 = 4474585 bsr -7. +6360004 = 91 + 6359913. +-6359822 = 91 - 6359913. +578752083 = 91 * 6359913. +-91 = -(91). +91 = +(91). +0 = 91 div 6359913. +91 = 91 rem 6359913. +73 = 91 band 6359913. +6359931 = 91 bor 6359913. +6359858 = 91 bxor 6359913. +-92 = bnot(91). +5 = 91 bsl -4. +1456 = 91 bsr -4. +4766 = -9 + 4775. +-4784 = -9 - 4775. +-42975 = -9 * 4775. +9 = -(-9). +-9 = +(-9). +0 = -9 div 4775. +-9 = -9 rem 4775. +4775 = -9 band 4775. +-9 = -9 bor 4775. +-4784 = -9 bxor 4775. +8 = bnot(-9). +-1 = -9 bsl -274. +-273187812969243150598049330647057346246588461741707120176036120119533415106982445056 = -9 bsr -274. +965284315779889295267486240 = 965284315779953794811369987 + -64499543883747. +965284315780018294355253734 = 965284315779953794811369987 - -64499543883747. +-62260398085941826544035961668579732901289 = 965284315779953794811369987 * -64499543883747. +-965284315779953794811369987 = -(965284315779953794811369987). +965284315779953794811369987 = +(965284315779953794811369987). +-14965754138041 = 965284315779953794811369987 div -64499543883747. +10057317050360 = 965284315779953794811369987 rem -64499543883747. +965284315779951418077151233 = 965284315779953794811369987 band -64499543883747. +-62122809664993 = 965284315779953794811369987 bor -64499543883747. +-965284315780013540886816226 = 965284315779953794811369987 bxor -64499543883747. +-965284315779953794811369988 = bnot(965284315779953794811369987). +4380475155801998892845301196571361280019643826879041496383329462320530168980671956908579027196908153533698762167225859842996267500189793598273681761756447031851518995847141414482166450061962739401970301137712309293255063821878024688218282842638050668650497046538763680360490864062383649123060113105846534144 = 965284315779953794811369987 bsl 929. +0 = 965284315779953794811369987 bsr 929. +-9566681586293604325086935 = -9566681586787938453518878 + 494334128431943. +-9566681587282272581950821 = -9566681586787938453518878 - 494334128431943. +-4729137204190733020979865587096688719954 = -9566681586787938453518878 * 494334128431943. +9566681586787938453518878 = -(-9566681586787938453518878). +-9566681586787938453518878 = +(-9566681586787938453518878). +-19352662574 = -9566681586787938453518878 div 494334128431943. +-432165851317596 = -9566681586787938453518878 rem 494334128431943. +494334128423234 = -9566681586787938453518878 band 494334128431943. +-9566681586787938453510169 = -9566681586787938453518878 bor 494334128431943. +-9566681587282272581933403 = -9566681586787938453518878 bxor 494334128431943. +9566681586787938453518877 = bnot(-9566681586787938453518878). +-153066905388607015256302048 = -9566681586787938453518878 bsl 4. +-597917599174246153344930 = -9566681586787938453518878 bsr 4. +48668267991694166982 = 48668267991782878894 + -88711912. +48668267991871590806 = 48668267991782878894 - -88711912. +-4317455107279459475551185328 = 48668267991782878894 * -88711912. +-48668267991782878894 = -(48668267991782878894). +48668267991782878894 = +(48668267991782878894). +-548610292513 = 48668267991782878894 div -88711912. +75364038 = 48668267991782878894 rem -88711912. +48668267991765502984 = 48668267991782878894 band -88711912. +-71336002 = 48668267991782878894 bor -88711912. +-48668267991836838986 = 48668267991782878894 bxor -88711912. +-48668267991782878895 = bnot(48668267991782878894). +6083533498972859861 = 48668267991782878894 bsl -3. +389346143934263031152 = 48668267991782878894 bsr -3. +25782325836398723569174 = 56476212692 + 25782325836342247356482. +-25782325836285771143790 = 56476212692 - 25782325836342247356482. +1456088117627711545009952176869544 = 56476212692 * 25782325836342247356482. +-56476212692 = -(56476212692). +56476212692 = +(56476212692). +0 = 56476212692 div 25782325836342247356482. +56476212692 = 56476212692 rem 25782325836342247356482. +38690920512 = 56476212692 band 25782325836342247356482. +25782325836360032648662 = 56476212692 bor 25782325836342247356482. +25782325836321341728150 = 56476212692 bxor 25782325836342247356482. +-56476212693 = bnot(56476212692). +3529763293 = 56476212692 bsl -4. +903619403072 = 56476212692 bsr -4. +544126888057471 = 59572428437918 + 484554459619553. +-424982031181635 = 59572428437918 - 484554459619553. +28866085869959848332359410654 = 59572428437918 * 484554459619553. +-59572428437918 = -(59572428437918). +59572428437918 = +(59572428437918). +0 = 59572428437918 div 484554459619553. +59572428437918 = 59572428437918 rem 484554459619553. +52922593321088 = 59572428437918 band 484554459619553. +491204294736383 = 59572428437918 bor 484554459619553. +438281701415295 = 59572428437918 bxor 484554459619553. +-59572428437919 = bnot(59572428437918). +920879540142378034005739088998035113353252370667466073858283381752546665759251813181966234183165163005062487859289803948100779213626721216453025126753265034957176202865336813677264764928 = 59572428437918 bsl 572. +0 = 59572428437918 bsr 572. +-41927729416296284512550 = -41927729416296284513545 + 995. +-41927729416296284514540 = -41927729416296284513545 - 995. +-41718090769214803090977275 = -41927729416296284513545 * 995. +41927729416296284513545 = -(-41927729416296284513545). +-41927729416296284513545 = +(-41927729416296284513545). +-42138421523915863832 = -41927729416296284513545 div 995. +-705 = -41927729416296284513545 rem 995. +739 = -41927729416296284513545 band 995. +-41927729416296284513289 = -41927729416296284513545 bor 995. +-41927729416296284514028 = -41927729416296284513545 bxor 995. +41927729416296284513544 = bnot(-41927729416296284513545). +-10481932354074071128387 = -41927729416296284513545 bsl -2. +-167710917665185138054180 = -41927729416296284513545 bsr -2. +-369624136911445327 = -3858 + -369624136911441469. +369624136911437611 = -3858 - -369624136911441469. +1426009920204341187402 = -3858 * -369624136911441469. +3858 = -(-3858). +-3858 = +(-3858). +0 = -3858 div -369624136911441469. +-3858 = -3858 rem -369624136911441469. +-369624136911441726 = -3858 band -369624136911441469. +-3601 = -3858 bor -369624136911441469. +369624136911438125 = -3858 bxor -369624136911441469. +3857 = bnot(-3858). +-8 = -3858 bsl -9. +-1975296 = -3858 bsr -9. +-31967719691456702 = -36927457 + -31967719654529245. +31967719617601788 = -36927457 - -31967719654529245. +1180486592930683549979965 = -36927457 * -31967719654529245. +36927457 = -(-36927457). +-36927457 = +(-36927457). +0 = -36927457 div -31967719654529245. +-36927457 = -36927457 rem -31967719654529245. +-31967719657832445 = -36927457 band -31967719654529245. +-33624257 = -36927457 bor -31967719654529245. +31967719624208188 = -36927457 bxor -31967719654529245. +36927456 = bnot(-36927457). +-48300888692627902203159381368269173925083523002745591981120571759374314593897558949114155183332909821880923825185557097902569365832709524017917692999614979130075339638477474642603071212430748615690802283865575088373754619400438658556406320794723029719741519942422027023311439600814151120859653113743671296 = -36927457 bsl 987. +-1 = -36927457 bsr 987. +-47994771759541 = -265696 + -47994771493845. +47994771228149 = -265696 - -47994771493845. +12752018806828641120 = -265696 * -47994771493845. +265696 = -(-265696). +-265696 = +(-265696). +0 = -265696 div -47994771493845. +-265696 = -265696 rem -47994771493845. +-47994771496928 = -265696 band -47994771493845. +-262613 = -265696 bor -47994771493845. +47994771234315 = -265696 bxor -47994771493845. +265695 = bnot(-265696). +-4251136 = -265696 bsl 4. +-16606 = -265696 bsr 4. +-9199171888129156 = -9194377219277887 + -4794668851269. +-9189582550426618 = -9194377219277887 - -4794668851269. +44083994060088968983983588603 = -9194377219277887 * -4794668851269. +9194377219277887 = -(-9194377219277887). +-9194377219277887 = +(-9194377219277887). +1917 = -9194377219277887 div -4794668851269. +-2997031395214 = -9194377219277887 rem -4794668851269. +-9199050555303039 = -9194377219277887 band -4794668851269. +-121332826117 = -9194377219277887 bor -4794668851269. +9198929222476922 = -9194377219277887 bxor -4794668851269. +9194377219277886 = bnot(-9194377219277887). +-2913814450185593058043228609701771773244080128 = -9194377219277887 bsl 98. +-1 = -9194377219277887 bsr 98. +39784597364028809470 = 39874589917552972417 + -89992553524162947. +39964582471077135364 = 39874589917552972417 - -89992553524162947. +-3588416167409434062145463651704432899 = 39874589917552972417 * -89992553524162947. +-39874589917552972417 = -(39874589917552972417). +39874589917552972417 = +(39874589917552972417). +-443 = 39874589917552972417 div -89992553524162947. +7888706348786896 = 39874589917552972417 rem -89992553524162947. +39793806323820397057 = 39874589917552972417 band -89992553524162947. +-9208959791587587 = 39874589917552972417 bor -89992553524162947. +-39803015283611984644 = 39874589917552972417 bxor -89992553524162947. +-39874589917552972418 = bnot(39874589917552972417). +44177613724782317629726103087440850907624966483292366382746735726976564189959417102355828270623805771784678778871474506348138709591737092478985716719593842928610997636257349819585597367194459440485450001490045881291799831376541790352579216953353874488253428812593792225588439865380516445525377024 = 39874589917552972417 bsl 917. +0 = 39874589917552972417 bsr 917. +-44416525916238423771346329 = 371862112393 + -44416525916238795633458722. +44416525916239167495571115 = 371862112393 - -44416525916238795633458722. +-16516823152370988325676184911690141746 = 371862112393 * -44416525916238795633458722. +-371862112393 = -(371862112393). +371862112393 = +(371862112393). +0 = 371862112393 div -44416525916238795633458722. +371862112393 = 371862112393 rem -44416525916238795633458722. +354343190664 = 371862112393 band -44416525916238795633458722. +-44416525916238778114536993 = 371862112393 bor -44416525916238795633458722. +-44416525916239132457727657 = 371862112393 bxor -44416525916238795633458722. +-371862112394 = bnot(371862112393). +0 = 371862112393 bsl -72. +1756069175813808117623456454934528 = 371862112393 bsr -72. +-3865686417158761331434189 = -863 + -3865686417158761331433326. +3865686417158761331432463 = -863 - -3865686417158761331433326. +3336087378008011029026960338 = -863 * -3865686417158761331433326. +863 = -(-863). +-863 = +(-863). +0 = -863 div -3865686417158761331433326. +-863 = -863 rem -3865686417158761331433326. +-3865686417158761331433344 = -863 band -3865686417158761331433326. +-845 = -863 bor -3865686417158761331433326. +3865686417158761331432499 = -863 bxor -3865686417158761331433326. +862 = bnot(-863). +-4 = -863 bsl -8. +-220928 = -863 bsr -8. +727539561357448124806725677 = 727539561357448124539998794 + 266726883. +727539561357448124273271911 = 727539561357448124539998794 - 266726883. +194054359460059387092749687147379102 = 727539561357448124539998794 * 266726883. +-727539561357448124539998794 = -(727539561357448124539998794). +727539561357448124539998794 = +(727539561357448124539998794). +2727657419358993238 = 727539561357448124539998794 div 266726883. +150181640 = 727539561357448124539998794 rem 266726883. +213909570 = 727539561357448124539998794 band 266726883. +727539561357448124592816107 = 727539561357448124539998794 bor 266726883. +727539561357448124378906537 = 727539561357448124539998794 bxor 266726883. +-727539561357448124539998795 = bnot(727539561357448124539998794). +0 = 727539561357448124539998794 bsl -793. +37900346059551112482395129926244905271818313722396862075761608118559495567606489509093257379637005489271882584535403108973651072452029113565088475423250923853072711617314417667217591005076220972638849002500670093256802323450051418911175916633384168603386087995342848 = 727539561357448124539998794 bsr -793. +4845615483639054675854643916 = -97549726517766 + 4845615483639152225581161682. +-4845615483639249775307679448 = -97549726517766 - 4845615483639152225581161682. +-472688465239251728979641804071054891442412 = -97549726517766 * 4845615483639152225581161682. +97549726517766 = -(-97549726517766). +-97549726517766 = +(-97549726517766). +0 = -97549726517766 div 4845615483639152225581161682. +-97549726517766 = -97549726517766 rem 4845615483639152225581161682. +4845615483639064090704499922 = -97549726517766 band 4845615483639152225581161682. +-9414849856006 = -97549726517766 bor 4845615483639152225581161682. +-4845615483639073505554355928 = -97549726517766 bxor 4845615483639152225581161682. +97549726517765 = bnot(-97549726517766). +-390198906071064 = -97549726517766 bsl 2. +-24387431629442 = -97549726517766 bsr 2. +6639170004 = 6639178221 + -8217. +6639186438 = 6639178221 - -8217. +-54554127441957 = 6639178221 * -8217. +-6639178221 = -(6639178221). +6639178221 = +(6639178221). +-807980 = 6639178221 div -8217. +6561 = 6639178221 rem -8217. +6639178213 = 6639178221 band -8217. +-8209 = 6639178221 bor -8217. +-6639186422 = 6639178221 bxor -8217. +-6639178222 = bnot(6639178221). +53113425768 = 6639178221 bsl 3. +829897277 = 6639178221 bsr 3. +33481279823977461794349784 = 33481277286797878946675326 + 2537179582847674458. +33481274749618296099000868 = 33481277286797878946675326 - 2537179582847674458. +84948013139725160201646406502066349869023308 = 33481277286797878946675326 * 2537179582847674458. +-33481277286797878946675326 = -(33481277286797878946675326). +33481277286797878946675326 = +(33481277286797878946675326). +13196258 = 33481277286797878946675326 div 2537179582847674458. +919207592098897162 = 33481277286797878946675326 rem 2537179582847674458. +2391556963994576986 = 33481277286797878946675326 band 2537179582847674458. +33481277432420497799772798 = 33481277286797878946675326 bor 2537179582847674458. +33481275040863533805195812 = 33481277286797878946675326 bxor 2537179582847674458. +-33481277286797878946675327 = bnot(33481277286797878946675326). +2470482213481859956052584333671314613562507264 = 33481277286797878946675326 bsl 66. +453755 = 33481277286797878946675326 bsr 66. +2949630 = 2949658 + -28. +2949686 = 2949658 - -28. +-82590424 = 2949658 * -28. +-2949658 = -(2949658). +2949658 = +(2949658). +-105344 = 2949658 div -28. +26 = 2949658 rem -28. +2949632 = 2949658 band -28. +-2 = 2949658 bor -28. +-2949634 = 2949658 bxor -28. +-2949659 = bnot(2949658). +204247949655482574992198843144245417155122976000711607807759657083365083062948847360093802222986870853603096865933994972242869949257164051767014234801443625572032584030766673239601613500109640599284135073096453005744860671238600929503948062015275568879262681196614132524091845902336 = 2949658 bsl 913. +0 = 2949658 bsr 913. +54213750915990011984673215 = 681915667814577758327862 + 53531835248175434226345353. +-52849919580360856468017491 = 681915667814577758327862 - 53531835248175434226345353. +36504197182599504119108093734255607396776614125286 = 681915667814577758327862 * 53531835248175434226345353. +-681915667814577758327862 = -(681915667814577758327862). +681915667814577758327862 = +(681915667814577758327862). +0 = 681915667814577758327862 div 53531835248175434226345353. +681915667814577758327862 = 681915667814577758327862 rem 53531835248175434226345353. +1302260960919421977600 = 681915667814577758327862 band 53531835248175434226345353. +54212448655029092562695615 = 681915667814577758327862 bor 53531835248175434226345353. +54211146394068173140718015 = 681915667814577758327862 bxor 53531835248175434226345353. +-681915667814577758327863 = bnot(681915667814577758327862). +1610127846915616446784725449733263096310398976 = 681915667814577758327862 bsl 71. +288 = 681915667814577758327862 bsr 71. +6851766981 = -52815 + 6851819796. +-6851872611 = -52815 - 6851819796. +-361878862525740 = -52815 * 6851819796. +52815 = -(-52815). +-52815 = +(-52815). +0 = -52815 div 6851819796. +-52815 = -52815 rem 6851819796. +6851801360 = -52815 band 6851819796. +-34379 = -52815 bor 6851819796. +-6851835739 = -52815 bxor 6851819796. +52814 = bnot(-52815). +-1 = -52815 bsl -47. +-7433050447486648320 = -52815 bsr -47. +-66628139849827523346014 = -66628139849827523391548 + 45534. +-66628139849827523437082 = -66628139849827523391548 - 45534. +-3033845719922046450110746632 = -66628139849827523391548 * 45534. +66628139849827523391548 = -(-66628139849827523391548). +-66628139849827523391548 = +(-66628139849827523391548). +-1463261295950883370 = -66628139849827523391548 div 45534. +-21968 = -66628139849827523391548 rem 45534. +33220 = -66628139849827523391548 band 45534. +-66628139849827523379234 = -66628139849827523391548 bor 45534. +-66628139849827523412454 = -66628139849827523391548 bxor 45534. +66628139849827523391547 = bnot(-66628139849827523391548). +-1 = -66628139849827523391548 bsl -837. +-61061020653629541530678333423590394702630673329368349208169542556834451981708470066769456666195053957164684750814833252120673860604316558971076065384053138153960634900506615586342480493979509916032696769423700469570953563285507702655565472021062634858074372881152933841862656 = -66628139849827523391548 bsr -837. +9211374728442040 = 8224434745967512 + 986939982474528. +7237494763492984 = 8224434745967512 - 986939982474528. +8117023484048075436999255534336 = 8224434745967512 * 986939982474528. +-8224434745967512 = -(8224434745967512). +8224434745967512 = +(8224434745967512). +8 = 8224434745967512 div 986939982474528. +328914886171288 = 8224434745967512 rem 986939982474528. +281562201522432 = 8224434745967512 band 986939982474528. +8929812526919608 = 8224434745967512 bor 986939982474528. +8648250325397176 = 8224434745967512 bxor 986939982474528. +-8224434745967513 = bnot(8224434745967512). +1939919231042380565962104015342735378726303987800599269510469133672945844084547228682084943200234731603251107588955360021639289241623954321289129635876931859117892133750335247044575232 = 8224434745967512 bsl 556. +0 = 8224434745967512 bsr 556. +-5483258629748897366 = 8354925 + -5483258629757252291. +5483258629765607216 = 8354925 - -5483258629757252291. +-45812214607224611097383175 = 8354925 * -5483258629757252291. +-8354925 = -(8354925). +8354925 = +(8354925). +0 = 8354925 div -5483258629757252291. +8354925 = 8354925 rem -5483258629757252291. +3755053 = 8354925 band -5483258629757252291. +-5483258629752652419 = 8354925 bor -5483258629757252291. +-5483258629756407472 = 8354925 bxor -5483258629757252291. +-8354926 = bnot(8354925). +0 = 8354925 bsl -26. +560689525555200 = 8354925 bsr -26. +4381739694537252289 = 4381739686354483342 + 8182768947. +4381739678171714395 = 4381739686354483342 - 8182768947. +35854763439338985925146380874 = 4381739686354483342 * 8182768947. +-4381739686354483342 = -(4381739686354483342). +4381739686354483342 = +(4381739686354483342). +535483735 = 4381739686354483342 div 8182768947. +7972906297 = 4381739686354483342 rem 8182768947. +6025322498 = 4381739686354483342 band 8182768947. +4381739688511929791 = 4381739686354483342 bor 8182768947. +4381739682486607293 = 4381739686354483342 bxor 8182768947. +-4381739686354483343 = bnot(4381739686354483342). +0 = 4381739686354483342 bsl -893. +289356139145147333863788455805704466017305954143094341143482572359115241899220389383039670575892056266347435138152573334213173358216552878730871724255074771593291995484866587673770807274116435463555953886907273598495937987036797992684062401606201791030148991671207019891702586048316964864 = 4381739686354483342 bsr -893. +79187393169177576755434820123 = -5365966382688351766 + 79187393174543543138123171889. +-79187393179909509520811523655 = -5365966382688351766 - 79187393174543543138123171889. +-424916889707325692610969117094605702893314705974 = -5365966382688351766 * 79187393174543543138123171889. +5365966382688351766 = -(-5365966382688351766). +-5365966382688351766 = +(-5365966382688351766). +0 = -5365966382688351766 div 79187393174543543138123171889. +-5365966382688351766 = -5365966382688351766 rem 79187393174543543138123171889. +79187393173804384522707683360 = -5365966382688351766 band 79187393174543543138123171889. +-4626807767272863237 = -5365966382688351766 bor 79187393174543543138123171889. +-79187393178431192289980546597 = -5365966382688351766 bxor 79187393174543543138123171889. +5365966382688351765 = bnot(-5365966382688351766). +-2747374787936436104192 = -5365966382688351766 bsl 9. +-10480403091188188 = -5365966382688351766 bsr 9. +-5611968923644672949873679 = -5611968923644672949873582 + -97. +-5611968923644672949873485 = -5611968923644672949873582 - -97. +544360985593533276137737454 = -5611968923644672949873582 * -97. +5611968923644672949873582 = -(-5611968923644672949873582). +-5611968923644672949873582 = +(-5611968923644672949873582). +57855349728295597421377 = -5611968923644672949873582 div -97. +-13 = -5611968923644672949873582 rem -97. +-5611968923644672949873646 = -5611968923644672949873582 band -97. +-33 = -5611968923644672949873582 bor -97. +5611968923644672949873613 = -5611968923644672949873582 bxor -97. +5611968923644672949873581 = bnot(-5611968923644672949873582). +-158647853125905587983965055420542576055990822820929885620968234464499599091920176631475980690522112 = -5611968923644672949873582 bsl 244. +-1 = -5611968923644672949873582 bsr 244. +-73539392680305865807 = -73539393618444719756 + 938138853949. +-73539394556583573705 = -73539393618444719756 - 938138853949. +-68990162449312133579704318916444 = -73539393618444719756 * 938138853949. +73539393618444719756 = -(-73539393618444719756). +-73539393618444719756 = +(-73539393618444719756). +-78388602 = -73539393618444719756 div 938138853949. +-375500430458 = -73539393618444719756 rem 938138853949. +1684561972 = -73539393618444719756 band 938138853949. +-73539392681990427779 = -73539393618444719756 bor 938138853949. +-73539392683674989751 = -73539393618444719756 bxor 938138853949. +73539393618444719755 = bnot(-73539393618444719756). +-11112958963017639143168135532523822495301632 = -73539393618444719756 bsl 77. +-1 = -73539393618444719756 bsr 77. +783890351610663724836834062 = 54536735517382498342324 + 783835814875146342338491738. +-783781278139628959840149414 = 54536735517382498342324 - 783835814875146342338491738. +42747846524897846348628188420967043453483369719112 = 54536735517382498342324 * 783835814875146342338491738. +-54536735517382498342324 = -(54536735517382498342324). +54536735517382498342324 = +(54536735517382498342324). +0 = 54536735517382498342324 div 783835814875146342338491738. +54536735517382498342324 = 54536735517382498342324 rem 783835814875146342338491738. +54309592454742337934608 = 54536735517382498342324 band 783835814875146342338491738. +783836042018208982498899454 = 54536735517382498342324 bor 783835814875146342338491738. +783781732425754240160964846 = 54536735517382498342324 bxor 783835814875146342338491738. +-54536735517382498342325 = bnot(54536735517382498342324). +0 = 54536735517382498342324 bsl -548. +50248923489998030034903198320077145750115194695859954245153889712191233506311786196207510945877569332115110911097771254434310271268639802234354416067215336690923897090580052311182927724544 = 54536735517382498342324 bsr -548. +71759253949874661270359909355 = 71759253949874661271235447583 + -875538228. +71759253949874661272110985811 = 71759253949874661271235447583 - -875538228. +-62827970045875261751517711147606702924 = 71759253949874661271235447583 * -875538228. +-71759253949874661271235447583 = -(71759253949874661271235447583). +71759253949874661271235447583 = +(71759253949874661271235447583). +-81960160795942608768 = 71759253949874661271235447583 div -875538228. +803464479 = 71759253949874661271235447583 rem -875538228. +71759253949874661270429386764 = 71759253949874661271235447583 band -875538228. +-69477409 = 71759253949874661271235447583 bor -875538228. +-71759253949874661270498864173 = 71759253949874661271235447583 bxor -875538228. +-71759253949874661271235447584 = bnot(71759253949874661271235447583). +14952866907201716632509004323935665096218601299062227623271212072714077064817014161146843592699415623073129145583197929812711978595091326214835567719882706352747661494762832039731719901097875516322832472336710965583335005123342937603392785017008665065918059346283986944 = 71759253949874661271235447583 bsl 795. +0 = 71759253949874661271235447583 bsr 795. +9114771611346090 = -39233 + 9114771611385323. +-9114771611424556 = -39233 - 9114771611385323. +-357599834629480377259 = -39233 * 9114771611385323. +39233 = -(-39233). +-39233 = +(-39233). +0 = -39233 div 9114771611385323. +-39233 = -39233 rem 9114771611385323. +9114771611346091 = -39233 band 9114771611385323. +-1 = -39233 bor 9114771611385323. +-9114771611346092 = -39233 bxor 9114771611385323. +39232 = bnot(-39233). +-77 = -39233 bsl -9. +-20087296 = -39233 bsr -9. +-92493277314758890 = -92493277314686391 + -72499. +-92493277314613892 = -92493277314686391 - -72499. +6705670112037448661109 = -92493277314686391 * -72499. +92493277314686391 = -(-92493277314686391). +-92493277314686391 = +(-92493277314686391). +1275786939332 = -92493277314686391 div -72499. +-55723 = -92493277314686391 rem -72499. +-92493277314752439 = -92493277314686391 band -72499. +-6451 = -92493277314686391 bor -72499. +92493277314745988 = -92493277314686391 bxor -72499. +92493277314686390 = bnot(-92493277314686391). +-5919569748139929024 = -92493277314686391 bsl 6. +-1445207458041975 = -92493277314686391 bsr 6. +64821233361388145113497646784 = 562 + 64821233361388145113497646222. +-64821233361388145113497645660 = 562 - 64821233361388145113497646222. +36429533149100137553785677176764 = 562 * 64821233361388145113497646222. +-562 = -(562). +562 = +(562). +0 = 562 div 64821233361388145113497646222. +562 = 562 rem 64821233361388145113497646222. +2 = 562 band 64821233361388145113497646222. +64821233361388145113497646782 = 562 bor 64821233361388145113497646222. +64821233361388145113497646780 = 562 bxor 64821233361388145113497646222. +-563 = bnot(562). +0 = 562 bsl -298. +286203554674995295120716619221517631627731309310064043214377733134290572616748807218767331328 = 562 bsr -298. +-214404149705 = -214397688214 + -6461491. +-214391226723 = -214397688214 - -6461491. +1385328732815567074 = -214397688214 * -6461491. +214397688214 = -(-214397688214). +-214397688214 = +(-214397688214). +33180 = -214397688214 div -6461491. +-5416834 = -214397688214 rem -6461491. +-214404143544 = -214397688214 band -6461491. +-6161 = -214397688214 bor -6461491. +214404137383 = -214397688214 bxor -6461491. +214397688213 = bnot(-214397688214). +-26799711027 = -214397688214 bsl -3. +-1715181505712 = -214397688214 bsr -3. +-7935720450961869732011057 = -222425217168495549558481 + -7713295233793374182452576. +7490870016624878632894095 = -222425217168495549558481 - -7713295233793374182452576. +1715631367461212905019038579907922366374521097056 = -222425217168495549558481 * -7713295233793374182452576. +222425217168495549558481 = -(-222425217168495549558481). +-222425217168495549558481 = +(-222425217168495549558481). +0 = -222425217168495549558481 div -7713295233793374182452576. +-222425217168495549558481 = -222425217168495549558481 rem -7713295233793374182452576. +-7779429221288574896254944 = -222425217168495549558481 band -7713295233793374182452576. +-156291229673294835756113 = -222425217168495549558481 bor -7713295233793374182452576. +7623137991615280060498831 = -222425217168495549558481 bxor -7713295233793374182452576. +222425217168495549558480 = bnot(-222425217168495549558481). +-1 = -222425217168495549558481 bsl -288. +-110617228861385846832181611898216202123399104524737012955318627588625390123827573845641751515474090468820647936 = -222425217168495549558481 bsr -288. +939060 = 936531 + 2529. +934002 = 936531 - 2529. +2368486899 = 936531 * 2529. +-936531 = -(936531). +936531 = +(936531). +370 = 936531 div 2529. +801 = 936531 rem 2529. +2113 = 936531 band 2529. +936947 = 936531 bor 2529. +934834 = 936531 bxor 2529. +-936532 = bnot(936531). +0 = 936531 bsl -69. +552830325571048962703491072 = 936531 bsr -69. +-2852442502912101042364 = -2852942484288572612327 + 499981376471569963. +-2853442465665044182290 = -2852942484288572612327 - 499981376471569963. +-1426418110288820897544258290069856733901 = -2852942484288572612327 * 499981376471569963. +2852942484288572612327 = -(-2852942484288572612327). +-2852942484288572612327 = +(-2852942484288572612327). +-5706 = -2852942484288572612327 div 499981376471569963. +-48750141794403449 = -2852942484288572612327 rem 499981376471569963. +463872967389347849 = -2852942484288572612327 band 499981376471569963. +-2852906375879490390213 = -2852942484288572612327 bor 499981376471569963. +-2853370248846879738062 = -2852942484288572612327 bxor 499981376471569963. +2852942484288572612326 = bnot(-2852942484288572612327). +-730353275977874588755712 = -2852942484288572612327 bsl 8. +-11144306579252236767 = -2852942484288572612327 bsr 8. +-4551914114467152301 = 3681681323 + -4551914118148833624. +4551914121830514947 = 3681681323 - -4551914118148833624. +-16758697192688576087715204552 = 3681681323 * -4551914118148833624. +-3681681323 = -(3681681323). +3681681323 = +(3681681323). +0 = 3681681323 div -4551914118148833624. +3681681323 = 3681681323 rem -4551914118148833624. +52510376 = 3681681323 band -4551914118148833624. +-4551914114519662677 = 3681681323 bor -4551914118148833624. +-4551914114572173053 = 3681681323 bxor -4551914118148833624. +-3681681324 = bnot(3681681323). +7190783 = 3681681323 bsl -9. +1885020837376 = 3681681323 bsr -9. +-89182662169448522409091 = -89182662164652578816278 + -4795943592813. +-89182662159856635223465 = -89182662164652578816278 - -4795943592813. +427715017198571888620065965968210014 = -89182662164652578816278 * -4795943592813. +89182662164652578816278 = -(-89182662164652578816278). +-89182662164652578816278 = +(-89182662164652578816278). +18595436005 = -89182662164652578816278 div -4795943592813. +-908659384213 = -89182662164652578816278 rem -4795943592813. +-89182662169170959917950 = -89182662164652578816278 band -4795943592813. +-277562491141 = -89182662164652578816278 bor -4795943592813. +89182662168893397426809 = -89182662164652578816278 bxor -4795943592813. +89182662164652578816277 = bnot(-89182662164652578816278). +-1393479096322696544005 = -89182662164652578816278 bsl -6. +-5707690378537765044241792 = -89182662164652578816278 bsr -6. +632545389415606345 = 9131421835176 + 632536257993771169. +-632527126571935993 = 9131421835176 - 632536257993771169. +5775955397784841728006978840744 = 9131421835176 * 632536257993771169. +-9131421835176 = -(9131421835176). +9131421835176 = +(9131421835176). +0 = 9131421835176 div 632536257993771169. +9131421835176 = 9131421835176 rem 632536257993771169. +9071256537248 = 9131421835176 band 632536257993771169. +632536318159069097 = 9131421835176 bor 632536257993771169. +632527246902531849 = 9131421835176 bxor 632536257993771169. +-9131421835177 = bnot(9131421835176). +4966446146660946458439123605341255292009634626855273740252574599074841436823948039774841525780525323097117652732871837238747964247145232892143144668276764293363353532420323977978151928168918047260672 = 9131421835176 bsl 617. +0 = 9131421835176 bsr 617. +628467798272410 = 617 + 628467798271793. +-628467798271176 = 617 - 628467798271793. +387764631533696281 = 617 * 628467798271793. +-617 = -(617). +617 = +(617). +0 = 617 div 628467798271793. +617 = 617 rem 628467798271793. +545 = 617 band 628467798271793. +628467798271865 = 617 bor 628467798271793. +628467798271320 = 617 bxor 628467798271793. +-618 = bnot(617). +44459535521401536512 = 617 bsl 56. +0 = 617 bsr 56. +3349939166095985147910546 = 3349938368558747723283131 + 797537237424627415. +3349937571021510298655716 = 3349938368558747723283131 - 797537237424627415. +2671700592003107001257687187823898229636365 = 3349938368558747723283131 * 797537237424627415. +-3349938368558747723283131 = -(3349938368558747723283131). +3349938368558747723283131 = +(3349938368558747723283131). +4200353 = 3349938368558747723283131 div 797537237424627415. +440730501686805636 = 3349938368558747723283131 rem 797537237424627415. +76853680943405715 = 3349938368558747723283131 band 797537237424627415. +3349939089242304204504831 = 3349938368558747723283131 bor 797537237424627415. +3349939012388623261099116 = 3349938368558747723283131 bxor 797537237424627415. +-3349938368558747723283132 = bnot(3349938368558747723283131). +0 = 3349938368558747723283131 bsl -85. +129594463611788089464584360769616723420831434145792 = 3349938368558747723283131 bsr -85. +6386447 = 6779 + 6379668. +-6372889 = 6779 - 6379668. +43247769372 = 6779 * 6379668. +-6779 = -(6779). +6779 = +(6779). +0 = 6779 div 6379668. +6779 = 6779 rem 6379668. +6160 = 6779 band 6379668. +6380287 = 6779 bor 6379668. +6374127 = 6779 bxor 6379668. +-6780 = bnot(6779). +3581308626568674705022511401949066075591266023198867798505445646491822385432037822377074577662428076737997723659290075314143434105868705257021403735000267391861953330829255465579830958328494843898451274884763646191719483796562837027585492576741740274122582039905765890719744 = 6779 bsl 896. +0 = 6779 bsr 896. +-416640072 = -7576 + -416632496. +416624920 = -7576 - -416632496. +3156407789696 = -7576 * -416632496. +7576 = -(-7576). +-7576 = +(-7576). +0 = -7576 div -416632496. +-7576 = -7576 rem -416632496. +-416636864 = -7576 band -416632496. +-3208 = -7576 bor -416632496. +416633656 = -7576 bxor -416632496. +7575 = bnot(-7576). +-18122040996845715967928180977059971505791224602120730723781423931381466355085051103893937433367232236603569150272235755161925780488396639187638504473606485280134063274303615014969202379566754146275033088 = -7576 bsl 659. +-1 = -7576 bsr 659. +95447279398571924885740904 = -541 + 95447279398571924885741445. +-95447279398571924885741986 = -541 - 95447279398571924885741445. +-51636978154627411363186121745 = -541 * 95447279398571924885741445. +541 = -(-541). +-541 = +(-541). +0 = -541 div 95447279398571924885741445. +-541 = -541 rem 95447279398571924885741445. +95447279398571924885740929 = -541 band 95447279398571924885741445. +-25 = -541 bor 95447279398571924885741445. +-95447279398571924885740954 = -541 bxor 95447279398571924885741445. +540 = bnot(-541). +-1 = -541 bsl -76. +-40876804275719648969752576 = -541 bsr -76. +-56166218967 = -99819836458 + 43653617491. +-143473453949 = -99819836458 - 43653617491. +-4357496958751708286878 = -99819836458 * 43653617491. +99819836458 = -(-99819836458). +-99819836458 = +(-99819836458). +-2 = -99819836458 div 43653617491. +-12512601476 = -99819836458 rem 43653617491. +34364195666 = -99819836458 band 43653617491. +-90530414633 = -99819836458 bor 43653617491. +-124894610299 = -99819836458 bxor 43653617491. +99819836457 = bnot(-99819836458). +-1 = -99819836458 bsl -584. +-6320250937891014880117158995322339818026510986708959014357773064574126455177221787777628770828395108621203423478412972882583915910031223087169043632598445656991544468013674755319270473728 = -99819836458 bsr -584. +-39394918556145756519903048269 = -39394918556145756519934536445 + 31488176. +-39394918556145756519966024621 = -39394918556145756519934536445 - 31488176. +-1240474129001583462952846192058574320 = -39394918556145756519934536445 * 31488176. +39394918556145756519934536445 = -(-39394918556145756519934536445). +-39394918556145756519934536445 = +(-39394918556145756519934536445). +-1251101955100408372969 = -39394918556145756519934536445 div 31488176. +-13021901 = -39394918556145756519934536445 rem 31488176. +10506240 = -39394918556145756519934536445 band 31488176. +-39394918556145756519913554509 = -39394918556145756519934536445 bor 31488176. +-39394918556145756519924060749 = -39394918556145756519934536445 bxor 31488176. +39394918556145756519934536444 = bnot(-39394918556145756519934536445). +-1 = -39394918556145756519934536445 bsl -733. +-1780028798475663899313794956801320316158277918977430074417848601707585154174768737231872948239599259481202593635313473975351259309647662557576980403048292705610626819624592707960493930346520749099995844854314387825837143542701975430418076519565885440 = -39394918556145756519934536445 bsr -733. +-942218636829645973571 = 9541594 + -942218636829655515165. +942218636829665056759 = 9541594 - -942218636829655515165. +-8990267691862020085565273010 = 9541594 * -942218636829655515165. +-9541594 = -(9541594). +9541594 = +(9541594). +0 = 9541594 div -942218636829655515165. +9541594 = 9541594 rem -942218636829655515165. +9476034 = 9541594 band -942218636829655515165. +-942218636829655449605 = 9541594 bor -942218636829655515165. +-942218636829664925639 = 9541594 bxor -942218636829655515165. +-9541595 = bnot(9541594). +0 = 9541594 bsl -53. +85943038365841120821248 = 9541594 bsr -53. +359263544344378002 = 22525 + 359263544344355477. +-359263544344332952 = 22525 - 359263544344355477. +8092411336356607119425 = 22525 * 359263544344355477. +-22525 = -(22525). +22525 = +(22525). +0 = 22525 div 359263544344355477. +22525 = 22525 rem 359263544344355477. +661 = 22525 band 359263544344355477. +359263544344377341 = 22525 bor 359263544344355477. +359263544344376680 = 22525 bxor 359263544344355477. +-22526 = bnot(22525). +90100 = 22525 bsl 2. +5631 = 22525 bsr 2. +-3326662191 = -3326662578 + 387. +-3326662965 = -3326662578 - 387. +-1287418417686 = -3326662578 * 387. +3326662578 = -(-3326662578). +-3326662578 = +(-3326662578). +-8596027 = -3326662578 div 387. +-129 = -3326662578 rem 387. +2 = -3326662578 band 387. +-3326662193 = -3326662578 bor 387. +-3326662195 = -3326662578 bxor 387. +3326662577 = bnot(-3326662578). +-446497093041782784 = -3326662578 bsl 27. +-25 = -3326662578 bsr 27. +9122678121848255133767059 = 9122678121848255133774381 + -7322. +9122678121848255133781703 = 9122678121848255133774381 - -7322. +-66796249208172924089496017682 = 9122678121848255133774381 * -7322. +-9122678121848255133774381 = -(9122678121848255133774381). +9122678121848255133774381 = +(9122678121848255133774381). +-1245927085748191086284 = 9122678121848255133774381 div -7322. +2933 = 9122678121848255133774381 rem -7322. +9122678121848255133770276 = 9122678121848255133774381 band -7322. +-3217 = 9122678121848255133774381 bor -7322. +-9122678121848255133773493 = 9122678121848255133774381 bxor -7322. +-9122678121848255133774382 = bnot(9122678121848255133774381). +71270922826939493232612 = 9122678121848255133774381 bsl -7. +1167702799596576657123120768 = 9122678121848255133774381 bsr -7. +-93467851987533385442390274598 = -6998279695768832496435489362 + -86469572291764552945954785236. +79471292595995720449519295874 = -6998279695768832496435489362 - -86469572291764552945954785236. +605138252071271103733214166260700576672786898959272659432 = -6998279695768832496435489362 * -86469572291764552945954785236. +6998279695768832496435489362 = -(-6998279695768832496435489362). +-6998279695768832496435489362 = +(-6998279695768832496435489362). +0 = -6998279695768832496435489362 div -86469572291764552945954785236. +-6998279695768832496435489362 = -6998279695768832496435489362 rem -86469572291764552945954785236. +-86653344739603769203471773652 = -6998279695768832496435489362 band -86469572291764552945954785236. +-6814507247929616238918500946 = -6998279695768832496435489362 bor -86469572291764552945954785236. +79838837491674152964553272706 = -6998279695768832496435489362 bxor -86469572291764552945954785236. +6998279695768832496435489361 = bnot(-6998279695768832496435489362). +-437392480985552031027218086 = -6998279695768832496435489362 bsl -4. +-111972475132301319942967829792 = -6998279695768832496435489362 bsr -4. +-47887784345477057051 = -47887784399154513386 + 53677456335. +-47887784452831969721 = -47887784399154513386 - 53677456335. +-2570494456065510603195188000310 = -47887784399154513386 * 53677456335. +47887784399154513386 = -(-47887784399154513386). +-47887784399154513386 = +(-47887784399154513386). +-892139599 = -47887784399154513386 div 53677456335. +-29107603721 = -47887784399154513386 rem 53677456335. +52334754310 = -47887784399154513386 band 53677456335. +-47887784397811811361 = -47887784399154513386 bor 53677456335. +-47887784450146565671 = -47887784399154513386 bxor 53677456335. +47887784399154513385 = bnot(-47887784399154513386). +-21776844 = -47887784399154513386 bsl -41. +-105306351550601034262356082819072 = -47887784399154513386 bsr -41. +-79316814638770194316947865550 = -46945142255491325454964751682 + -32371672383278868861983113868. +-14573469872212456592981637814 = -46945142255491325454964751682 - -32371672383278868861983113868. +1519692765081186408722971619574264846511184431031750525976 = -46945142255491325454964751682 * -32371672383278868861983113868. +46945142255491325454964751682 = -(-46945142255491325454964751682). +-46945142255491325454964751682 = +(-46945142255491325454964751682). +1 = -46945142255491325454964751682 div -32371672383278868861983113868. +-14573469872212456592981637814 = -46945142255491325454964751682 rem -32371672383278868861983113868. +-79142615909218722686232428492 = -46945142255491325454964751682 band -32371672383278868861983113868. +-174198729551471630715437058 = -46945142255491325454964751682 bor -32371672383278868861983113868. +78968417179667251055516991434 = -46945142255491325454964751682 bxor -32371672383278868861983113868. +46945142255491325454964751681 = bnot(-46945142255491325454964751682). +-1467035695484103920467648491 = -46945142255491325454964751682 bsl -5. +-1502244552175722414558872053824 = -46945142255491325454964751682 bsr -5. +-959256731475517667191147619 = -959256731475517597311251448 + -69879896171. +-959256731475517527431355277 = -959256731475517597311251448 - -69879896171. +67032760796841997328593639956313405608 = -959256731475517597311251448 * -69879896171. +959256731475517597311251448 = -(-959256731475517597311251448). +-959256731475517597311251448 = +(-959256731475517597311251448). +13727220331412097 = -959256731475517597311251448 div -69879896171. +-49137870861 = -959256731475517597311251448 rem -69879896171. +-959256731475517666097871872 = -959256731475517597311251448 band -69879896171. +-1093275747 = -959256731475517597311251448 bor -69879896171. +959256731475517665004596125 = -959256731475517597311251448 bxor -69879896171. +959256731475517597311251447 = bnot(-959256731475517597311251448). +-74218894740472983230499719574570888012122512290742272 = -959256731475517597311251448 bsl 86. +-13 = -959256731475517597311251448 bsr 86. +-7636256537005201989969009000 = -7735619899564627144133283782 + 99363362559425154164274782. +-7834983262124052298297558564 = -7735619899564627144133283782 - 99363362559425154164274782. +-768637204702344044187714998374778579284830200232185524 = -7735619899564627144133283782 * 99363362559425154164274782. +7735619899564627144133283782 = -(-7735619899564627144133283782). +-7735619899564627144133283782 = +(-7735619899564627144133283782). +-77 = -7735619899564627144133283782 div 99363362559425154164274782. +-84640982488890273484125568 = -7735619899564627144133283782 rem 99363362559425154164274782. +226685510059814126366746 = -7735619899564627144133283782 band 99363362559425154164274782. +-7636483222515261804095375746 = -7735619899564627144133283782 bor 99363362559425154164274782. +-7636709908025321618221742492 = -7735619899564627144133283782 bxor 99363362559425154164274782. +7735619899564627144133283781 = bnot(-7735619899564627144133283782). +-1 = -7735619899564627144133283782 bsl -952. +-294476738258171150599617898367824151666477449653244545539179271066059551908021445021373336676213218319522988394235273605055872991465124045264656669368839068869654064706291126766925685578764235202272405610013145652686307873063005905912788538570286021969964306150351272383224523163385128550321369284951279666695503872 = -7735619899564627144133283782 bsr -952. +5189354565971672 = 4398231646349891 + 791122919621781. +3607108726728110 = 4398231646349891 - 791122919621781. +3479541861233238334550910575871 = 4398231646349891 * 791122919621781. +-4398231646349891 = -(4398231646349891). +4398231646349891 = +(4398231646349891). +5 = 4398231646349891 div 791122919621781. +442617048240986 = 4398231646349891 rem 791122919621781. +703691879940097 = 4398231646349891 band 791122919621781. +4485662686031575 = 4398231646349891 bor 791122919621781. +3781970806091478 = 4398231646349891 bxor 791122919621781. +-4398231646349892 = bnot(4398231646349891). +0 = 4398231646349891 bsl -57. +633851980914895752036374598909952 = 4398231646349891 bsr -57. +-66462493333953656144175 = -66462493333953656144148 + -27. +-66462493333953656144121 = -66462493333953656144148 - -27. +1794487320016748715891996 = -66462493333953656144148 * -27. +66462493333953656144148 = -(-66462493333953656144148). +-66462493333953656144148 = +(-66462493333953656144148). +2461573827183468746079 = -66462493333953656144148 div -27. +-15 = -66462493333953656144148 rem -27. +-66462493333953656144156 = -66462493333953656144148 band -27. +-19 = -66462493333953656144148 bor -27. +66462493333953656144137 = -66462493333953656144148 bxor -27. +66462493333953656144147 = bnot(-66462493333953656144148). +-531699946671629249153184 = -66462493333953656144148 bsl 3. +-8307811666744207018019 = -66462493333953656144148 bsr 3. +-95484272407718148579925639801 = -5163374558913331895812 + -95484267244343589666593743989. +95484262080969030753261848177 = -5163374558913331895812 - -95484267244343589666593743989. +493021036265925287117377824018467509063892349274068 = -5163374558913331895812 * -95484267244343589666593743989. +5163374558913331895812 = -(-5163374558913331895812). +-5163374558913331895812 = +(-5163374558913331895812). +0 = -5163374558913331895812 div -95484267244343589666593743989. +-5163374558913331895812 = -5163374558913331895812 rem -95484267244343589666593743989. +-95484272054337006900938718840 = -5163374558913331895812 band -95484267244343589666593743989. +-353381141678986920961 = -5163374558913331895812 bor -95484267244343589666593743989. +95484271700955865221951797879 = -5163374558913331895812 bxor -95484267244343589666593743989. +5163374558913331895811 = bnot(-5163374558913331895812). +-80677727483020810873 = -5163374558913331895812 bsl -6. +-330455971770453241331968 = -5163374558913331895812 bsr -6. +-728291976857434384373484660277 = -6136 + -728291976857434384373484654141. +728291976857434384373484648005 = -6136 - -728291976857434384373484654141. +4468799569997217382515701837809176 = -6136 * -728291976857434384373484654141. +6136 = -(-6136). +-6136 = +(-6136). +0 = -6136 div -728291976857434384373484654141. +-6136 = -6136 rem -728291976857434384373484654141. +-728291976857434384373484658688 = -6136 band -728291976857434384373484654141. +-1589 = -6136 bor -728291976857434384373484654141. +728291976857434384373484657099 = -6136 bxor -728291976857434384373484654141. +6135 = bnot(-6136). +-196352 = -6136 bsl 5. +-192 = -6136 bsr 5. +-255897171117657553338 = 7 + -255897171117657553345. +255897171117657553352 = 7 - -255897171117657553345. +-1791280197823602873415 = 7 * -255897171117657553345. +-7 = -(7). +7 = +(7). +0 = 7 div -255897171117657553345. +7 = 7 rem -255897171117657553345. +7 = 7 band -255897171117657553345. +-255897171117657553345 = 7 bor -255897171117657553345. +-255897171117657553352 = 7 bxor -255897171117657553345. +-8 = bnot(7). +3584 = 7 bsl 9. +0 = 7 bsr 9. +327659896220292618768682756 = 61713382968829984 + 327659896158579235799852772. +-327659896096865852831022788 = 61713382968829984 - 327659896158579235799852772. +20221000655161464908942372144898492299115648 = 61713382968829984 * 327659896158579235799852772. +-61713382968829984 = -(61713382968829984). +61713382968829984 = +(61713382968829984). +0 = 61713382968829984 div 327659896158579235799852772. +61713382968829984 = 61713382968829984 rem 327659896158579235799852772. +52399225577504 = 61713382968829984 band 327659896158579235799852772. +327659896220240219543105252 = 61713382968829984 bor 327659896158579235799852772. +327659896220187820317527748 = 61713382968829984 bxor 327659896158579235799852772. +-61713382968829985 = bnot(61713382968829984). +2673606666864789640199890437071214500263506125978353728418541999859694514267787931734957644905255199855096668552593175655049499727010700453740544 = 61713382968829984 bsl 424. +0 = 61713382968829984 bsr 424. +-41468119058294390 = -535695115 + -41468118522599275. +41468117986904160 = -535695115 - -41468118522599275. +22214268520797448720041625 = -535695115 * -41468118522599275. +535695115 = -(-535695115). +-535695115 = +(-535695115). +0 = -535695115 div -41468118522599275. +-535695115 = -535695115 rem -41468118522599275. +-41468118621429611 = -535695115 band -41468118522599275. +-436864779 = -535695115 bor -41468118522599275. +41468118184564832 = -535695115 bxor -41468118522599275. +535695114 = bnot(-535695115). +-555718804966498486056123639866735224318786187703107235755854288182306793058727785492506975888007348999538127502749434140163481607696271161478154955312821425111515949552269758866058180034560 = -535695115 bsl 598. +-1 = -535695115 bsr 598. +-7687388271331556624628222776 = 567539817 + -7687388271331556625195762593. +7687388271331556625763302410 = 567539817 - -7687388271331556625195762593. +-4362898932719457993388740691206665481 = 567539817 * -7687388271331556625195762593. +-567539817 = -(567539817). +567539817 = +(567539817). +0 = 567539817 div -7687388271331556625195762593. +567539817 = 567539817 rem -7687388271331556625195762593. +29587529 = 567539817 band -7687388271331556625195762593. +-7687388271331556624657810305 = 567539817 bor -7687388271331556625195762593. +-7687388271331556624687397834 = 567539817 bxor -7687388271331556625195762593. +-567539818 = bnot(567539817). +0 = 567539817 bsl -895. +149914090761418128044033419526669597570583809234739872029132135692094377387859729432730742794061566488239060704529433522179169649225275380409858787494111834380321602201016086825595741332105663784597330220645777832121347009089521887862272784249805703749598764308570959644779872256 = 567539817 bsr -895. +-271876793993788 = 47 + -271876793993835. +271876793993882 = 47 - -271876793993835. +-12778209317710245 = 47 * -271876793993835. +-47 = -(47). +47 = +(47). +0 = 47 div -271876793993835. +47 = 47 rem -271876793993835. +5 = 47 band -271876793993835. +-271876793993793 = 47 bor -271876793993835. +-271876793993798 = 47 bxor -271876793993835. +-48 = bnot(47). +0 = 47 bsl -7. +6016 = 47 bsr -7. +2957935961678274511090515 = -628899 + 2957935961678274511719414. +-2957935961678274512348313 = -628899 - 2957935961678274511719414. +-1860242968363505162145827745186 = -628899 * 2957935961678274511719414. +628899 = -(-628899). +-628899 = +(-628899). +0 = -628899 div 2957935961678274511719414. +-628899 = -628899 rem 2957935961678274511719414. +2957935961678274511651668 = -628899 band 2957935961678274511719414. +-561153 = -628899 bor 2957935961678274511719414. +-2957935961678274512212821 = -628899 bxor 2957935961678274511719414. +628898 = bnot(-628899). +-1 = -628899 bsl -262. +-4660577864272570751084055609662644259904872965519147845366453447999523796315271069696 = -628899 bsr -262. +-2134739549478317544367 = 417825184917526139286 + -2552564734395843683653. +2970389919313369822939 = 417825184917526139286 - -2552564734395843683653. +-1066525832162899381985364983898885799291758 = 417825184917526139286 * -2552564734395843683653. +-417825184917526139286 = -(417825184917526139286). +417825184917526139286 = +(417825184917526139286). +0 = 417825184917526139286 div -2552564734395843683653. +417825184917526139286 = 417825184917526139286 rem -2552564734395843683653. +380467502953848819858 = 417825184917526139286 band -2552564734395843683653. +-2515207052432166364225 = 417825184917526139286 bor -2552564734395843683653. +-2895674555386015184083 = 417825184917526139286 bxor -2552564734395843683653. +-417825184917526139287 = bnot(417825184917526139286). +0 = 417825184917526139286 bsl -586. +105821051628775302540019449117422307372788400977033737301827098767360059441259056456375975687517232564538623450082399539570963500720198873199082481060631384759042571813704318479195354072313709461504 = 417825184917526139286 bsr -586. +65348459157074999199412310 = 65348459156717665282542516 + 357333916869794. +65348459156360331365672722 = 65348459156717665282542516 - 357333916869794. +23351220871875678725546248635536441161704 = 65348459156717665282542516 * 357333916869794. +-65348459156717665282542516 = -(65348459156717665282542516). +65348459156717665282542516 = +(65348459156717665282542516). +182877851979 = 65348459156717665282542516 div 357333916869794. +327187134320190 = 65348459156717665282542516 rem 357333916869794. +343617061024 = 65348459156717665282542516 band 357333916869794. +65348459157074655582351286 = 65348459156717665282542516 bor 357333916869794. +65348459157074311965290262 = 65348459156717665282542516 bxor 357333916869794. +-65348459156717665282542517 = bnot(65348459156717665282542516). +963369646005615849436861831463875639304554151636736647798813648922317577483620894478811593879355376037264307609013532944946246538408084699742556180761937401506292607357517926271625814853287936 = 65348459156717665282542516 bsl 552. +0 = 65348459156717665282542516 bsr 552. +82983973517509960 = 82983973517475534 + 34426. +82983973517441108 = 82983973517475534 - 34426. +2856806272312612733484 = 82983973517475534 * 34426. +-82983973517475534 = -(82983973517475534). +82983973517475534 = +(82983973517475534). +2410502919812 = 82983973517475534 div 34426. +27622 = 82983973517475534 rem 34426. +1610 = 82983973517475534 band 34426. +82983973517508350 = 82983973517475534 bor 34426. +82983973517506740 = 82983973517475534 bxor 34426. +-82983973517475535 = bnot(82983973517475534). +104071373546698694201735881906791178166996828921478528184482511645647327574232864181745195351097946190811926743969178466711406403669731970037407822299028809439676023308953516811124116217612698305359897905687757289995370496 = 82983973517475534 bsl 678. +0 = 82983973517475534 bsr 678. +-63745812445273723555466583743 = -63745812445273723555466625664 + 41921. +-63745812445273723555466667585 = -63745812445273723555466625664 - 41921. +-2672288203518319765168716414460544 = -63745812445273723555466625664 * 41921. +63745812445273723555466625664 = -(-63745812445273723555466625664). +-63745812445273723555466625664 = +(-63745812445273723555466625664). +-1520617648559760586709921 = -63745812445273723555466625664 div 41921. +-27423 = -63745812445273723555466625664 rem 41921. +8576 = -63745812445273723555466625664 band 41921. +-63745812445273723555466592319 = -63745812445273723555466625664 bor 41921. +-63745812445273723555466600895 = -63745812445273723555466625664 bxor 41921. +63745812445273723555466625663 = bnot(-63745812445273723555466625664). +-6592 = -63745812445273723555466625664 bsl -83. +-616511668459223720181482832961376249103493771047206912 = -63745812445273723555466625664 bsr -83. +-31346355498113217 = -64 + -31346355498113153. +31346355498113089 = -64 - -31346355498113153. +2006166751879241792 = -64 * -31346355498113153. +64 = -(-64). +-64 = +(-64). +0 = -64 div -31346355498113153. +-64 = -64 rem -31346355498113153. +-31346355498113216 = -64 band -31346355498113153. +-1 = -64 bor -31346355498113153. +31346355498113215 = -64 bxor -31346355498113153. +63 = bnot(-64). +-645562469521727147413979793000752968582426448207305878207664839135161905504210298657411338320034457858975792993186873344 = -64 bsl 392. +-1 = -64 bsr 392. +-6149421864998047819362004 = 345328854531 + -6149421864998393148216535. +6149421864998738477071066 = 345328854531 - -6149421864998393148216535. +-2123572808667780828029214937103870085 = 345328854531 * -6149421864998393148216535. +-345328854531 = -(345328854531). +345328854531 = +(345328854531). +0 = 345328854531 div -6149421864998393148216535. +345328854531 = 345328854531 rem -6149421864998393148216535. +344201372161 = 345328854531 band -6149421864998393148216535. +-6149421864998392020734165 = 345328854531 bor -6149421864998393148216535. +-6149421864998736222106326 = 345328854531 bxor -6149421864998393148216535. +-345328854532 = bnot(345328854531). +1236229985648790720140825348929489781677170882473230453855854197366391334552042905720116564304224528376972518078198688469362639253242806828985118145108745184426782194439105078579460863521995194467044977426616924637733277133789922549224835456258032541070390198272 = 345328854531 bsl 829. +0 = 345328854531 bsr 829. +-45456559819945214994526 = 518218891 + -45456559819945733213417. +45456559819946251432308 = 518218891 - -45456559819945733213417. +-23556448018567437546038824060547 = 518218891 * -45456559819945733213417. +-518218891 = -(518218891). +518218891 = +(518218891). +0 = 518218891 div -45456559819945733213417. +518218891 = 518218891 rem -45456559819945733213417. +136323075 = 518218891 band -45456559819945733213417. +-45456559819945351317601 = 518218891 bor -45456559819945733213417. +-45456559819945487640676 = 518218891 bxor -45456559819945733213417. +-518218892 = bnot(518218891). +2024292 = 518218891 bsl -8. +132664036096 = 518218891 bsr -8. +981107618657309 = -833879618242 + 981941498275551. +-982775377893793 = -833879618242 - 981941498275551. +-818821001717993969202201342 = -833879618242 * 981941498275551. +833879618242 = -(-833879618242). +-833879618242 = +(-833879618242). +0 = -833879618242 div 981941498275551. +-833879618242 = -833879618242 rem 981941498275551. +981932873663518 = -833879618242 band 981941498275551. +-825255006209 = -833879618242 bor 981941498275551. +-982758128669727 = -833879618242 bxor 981941498275551. +833879618241 = bnot(-833879618242). +-928839414178366905934203589000236592058142035897290206229403095403923419980586576125314662445572910144126809670971212444331872797646975882602165499109003875192023740319959678259052811936697283459940352 = -833879618242 bsl 628. +-1 = -833879618242 bsr 628. +91739893931159218326346947398 = 941 + 91739893931159218326346946457. +-91739893931159218326346945516 = 941 - 91739893931159218326346946457. +86327240189220824445092476616037 = 941 * 91739893931159218326346946457. +-941 = -(941). +941 = +(941). +0 = 941 div 91739893931159218326346946457. +941 = 941 rem 91739893931159218326346946457. +905 = 941 band 91739893931159218326346946457. +91739893931159218326346946493 = 941 bor 91739893931159218326346946457. +91739893931159218326346945588 = 941 bxor 91739893931159218326346946457. +-942 = bnot(941). +252597764096 = 941 bsl 28. +0 = 941 bsr 28. +-9456264219673416 = -9456264219274591 + -398825. +-9456264218875766 = -9456264219274591 - -398825. +3771394577252188755575 = -9456264219274591 * -398825. +9456264219274591 = -(-9456264219274591). +-9456264219274591 = +(-9456264219274591). +23710309582 = -9456264219274591 div -398825. +-233441 = -9456264219274591 rem -398825. +-9456264219672063 = -9456264219274591 band -398825. +-1353 = -9456264219274591 bor -398825. +9456264219670710 = -9456264219274591 bxor -398825. +9456264219274590 = bnot(-9456264219274591). +-634599149439364706074624 = -9456264219274591 bsl 26. +-140909318 = -9456264219274591 bsr 26. +6865215386180237197481 = 353463884 + 6865215386179883733597. +-6865215386179530269713 = 353463884 - 6865215386179883733597. +2426605694895701627145616910748 = 353463884 * 6865215386179883733597. +-353463884 = -(353463884). +353463884 = +(353463884). +0 = 353463884 div 6865215386179883733597. +353463884 = 353463884 rem 6865215386179883733597. +335610444 = 353463884 band 6865215386179883733597. +6865215386179901587037 = 353463884 bor 6865215386179883733597. +6865215386179565976593 = 353463884 bxor 6865215386179883733597. +-353463885 = bnot(353463884). +178082501288577240848078587402645659914638037742368543155041634761774079512727259778196069624589135450143236703554934037709754321498623217036440075322058651839594907283944119630839112845539422125720019636017744203172611037538391169810880104228736423635165207073176078516224 = 353463884 bsl 876. +0 = 353463884 bsr 876. +3734635776523991788537932207 = 84552 + 3734635776523991788537847655. +-3734635776523991788537763103 = 84552 - 3734635776523991788537847655. +315770924176656553704452094925560 = 84552 * 3734635776523991788537847655. +-84552 = -(84552). +84552 = +(84552). +0 = 84552 div 3734635776523991788537847655. +84552 = 84552 rem 3734635776523991788537847655. +68160 = 84552 band 3734635776523991788537847655. +3734635776523991788537864047 = 84552 bor 3734635776523991788537847655. +3734635776523991788537795887 = 84552 bxor 3734635776523991788537847655. +-84553 = bnot(84552). +660 = 84552 bsl -7. +10822656 = 84552 bsr -7. +2782778678603311 = -39836525 + 2782778718439836. +-2782778758276361 = -39836525 - 2782778718439836. +-110856233986596487809900 = -39836525 * 2782778718439836. +39836525 = -(-39836525). +-39836525 = +(-39836525). +0 = -39836525 div 2782778718439836. +-39836525 = -39836525 rem 2782778718439836. +2782778718421136 = -39836525 band 2782778718439836. +-39817825 = -39836525 bor 2782778718439836. +-2782778758238961 = -39836525 bxor 2782778718439836. +39836524 = bnot(-39836525). +-1 = -39836525 bsl -46. +-2803246236652116377600 = -39836525 bsr -46. +7561228265255773898606129 = 64399986374386 + 7561228265191373912231743. +-7561228265126973925857357 = 64399986374386 - 7561228265191373912231743. +486942997251946772560427191460391334798 = 64399986374386 * 7561228265191373912231743. +-64399986374386 = -(64399986374386). +64399986374386 = +(64399986374386). +0 = 64399986374386 div 7561228265191373912231743. +64399986374386 = 64399986374386 rem 7561228265191373912231743. +2207613781554 = 64399986374386 band 7561228265191373912231743. +7561228265253566284824575 = 64399986374386 bor 7561228265191373912231743. +7561228265251358671043021 = 64399986374386 bxor 7561228265191373912231743. +-64399986374387 = bnot(64399986374386). +155709612621651092297023693430164815872 = 64399986374386 bsl 81. +0 = 64399986374386 bsr 81. +-293768271718296280472 = -293768271719154417444 + 858136972. +-293768271720012554416 = -293768271719154417444 - 858136972. +-252093415162748406185818139568 = -293768271719154417444 * 858136972. +293768271719154417444 = -(-293768271719154417444). +-293768271719154417444 = +(-293768271719154417444). +-342332612746 = -293768271719154417444 div 858136972. +-453372332 = -293768271719154417444 rem 858136972. +50725004 = -293768271719154417444 band 858136972. +-293768271718347005476 = -293768271719154417444 bor 858136972. +-293768271718397730480 = -293768271719154417444 bxor 858136972. +293768271719154417443 = bnot(-293768271719154417444). +-75204677560103530865664 = -293768271719154417444 bsl 8. +-1147532311402946944 = -293768271719154417444 bsr 8. +7334628981256154244320 = 6 + 7334628981256154244314. +-7334628981256154244308 = 6 - 7334628981256154244314. +44007773887536925465884 = 6 * 7334628981256154244314. +-6 = -(6). +6 = +(6). +0 = 6 div 7334628981256154244314. +6 = 6 rem 7334628981256154244314. +2 = 6 band 7334628981256154244314. +7334628981256154244318 = 6 bor 7334628981256154244314. +7334628981256154244316 = 6 bxor 7334628981256154244314. +-7 = bnot(6). +48 = 6 bsl 3. +0 = 6 bsr 3. +-484689735605708013667484 = -484689729221194738721122 + -6384513274946362. +-484689722836681463774760 = -484689729221194738721122 - -6384513274946362. +3094508010442875433029193488499026458164 = -484689729221194738721122 * -6384513274946362. +484689729221194738721122 = -(-484689729221194738721122). +-484689729221194738721122 = +(-484689729221194738721122). +75916472 = -484689729221194738721122 div -6384513274946362. +-5950100946446258 = -484689729221194738721122 rem -6384513274946362. +-484689729226143887483770 = -484689729221194738721122 band -6384513274946362. +-6379564126183714 = -484689729221194738721122 bor -6384513274946362. +484689722846579761300056 = -484689729221194738721122 bxor -6384513274946362. +484689729221194738721121 = bnot(-484689729221194738721122). +-3407152045104124367017271929002010304822004118541879927081529418883046659294496161374843964190705909987297679873244728454802455339323150218637293463093441609411771424703629741634093056 = -484689729221194738721122 bsl 531. +-1 = -484689729221194738721122 bsr 531. +97275658985222212 = -9831226364 + 97275668816448576. +-97275678647674940 = -9831226364 - 97275668816448576. +-956339119844001917221457664 = -9831226364 * 97275668816448576. +9831226364 = -(-9831226364). +-9831226364 = +(-9831226364). +0 = -9831226364 div 97275668816448576. +-9831226364 = -9831226364 rem 97275668816448576. +97275668798325760 = -9831226364 band 97275668816448576. +-9813103548 = -9831226364 bor 97275668816448576. +-97275678611429308 = -9831226364 bxor 97275668816448576. +9831226363 = bnot(-9831226364). +-218069947164034966789202107619672282027864460589294264974753653179697026601398604901956177657410076397815275462605092654470227515792045375488 = -9831226364 bsl 433. +-1 = -9831226364 bsr 433. +811334966792538 = 811334971748727 + -4956189. +811334976704916 = 811334971748727 - -4956189. +-4021129462296351521403 = 811334971748727 * -4956189. +-811334971748727 = -(811334971748727). +811334971748727 = +(811334971748727). +-163701378 = 811334971748727 div -4956189. +2820285 = 811334971748727 rem -4956189. +811334966989155 = 811334971748727 band -4956189. +-196617 = 811334971748727 bor -4956189. +-811334967185772 = 811334971748727 bxor -4956189. +-811334971748728 = bnot(811334971748727). +0 = 811334971748727 bsl -584. +51370957898696338924979062684267574889692713921960031697929223518883541308686122246026955424429435685879870308869332170294114526221878140437663970272288492929969523669597608930525213183967232 = 811334971748727 bsr -584. +9386646838474838885886405 = 9386646838474838878344919 + 7541486. +9386646838474838870803433 = 9386646838474838878344919 - 7541486. +70789265719302258753293909809634 = 9386646838474838878344919 * 7541486. +-9386646838474838878344919 = -(9386646838474838878344919). +9386646838474838878344919 = +(9386646838474838878344919). +1244668071846163856 = 9386646838474838878344919 div 7541486. +4614903 = 9386646838474838878344919 rem 7541486. +135878 = 9386646838474838878344919 band 7541486. +9386646838474838885750527 = 9386646838474838878344919 bor 7541486. +9386646838474838885614649 = 9386646838474838878344919 bxor 7541486. +-9386646838474838878344920 = bnot(9386646838474838878344919). +73333178425584678737069 = 9386646838474838878344919 bsl -7. +1201490795324779376428149632 = 9386646838474838878344919 bsr -7. +-37668595329896688694811341665 = 968955878746223172532899 + -37669564285775434917983874564. +37670533241654181141156407463 = 968955878746223172532899 - -37669564285775434917983874564. +-36500145764510881221050255830505417406356885779281036 = 968955878746223172532899 * -37669564285775434917983874564. +-968955878746223172532899 = -(968955878746223172532899). +968955878746223172532899 = +(968955878746223172532899). +0 = 968955878746223172532899 div -37669564285775434917983874564. +968955878746223172532899 = 968955878746223172532899 rem -37669564285775434917983874564. +326658692321257898512544 = 968955878746223172532899 band -37669564285775434917983874564. +-37668921988589009952709854209 = 968955878746223172532899 bor -37669564285775434917983874564. +-37669248647281331210608366753 = 968955878746223172532899 bxor -37669564285775434917983874564. +-968955878746223172532900 = bnot(968955878746223172532899). +15058883548636265840324379812208556560337747233343885124606900333031925746470989114966905517118570701931937792 = 968955878746223172532899 bsl 283. +0 = 968955878746223172532899 bsr 283. +627532199385515150887717802077 = 5458823246133 + 627532199385515145428894555944. +-627532199385515139970071309811 = 5458823246133 - 627532199385515145428894555944. +3425587357702618774070593756411997650164552 = 5458823246133 * 627532199385515145428894555944. +-5458823246133 = -(5458823246133). +5458823246133 = +(5458823246133). +0 = 5458823246133 div 627532199385515145428894555944. +5458823246133 = 5458823246133 rem 627532199385515145428894555944. +4425430077728 = 5458823246133 band 627532199385515145428894555944. +627532199385515146462287724349 = 5458823246133 bor 627532199385515145428894555944. +627532199385515142036857646621 = 5458823246133 bxor 627532199385515145428894555944. +-5458823246134 = bnot(5458823246133). +2794917502020096 = 5458823246133 bsl 9. +10661764152 = 5458823246133 bsr 9. +-31585827561050681201 = -2338687527 + -31585827558711993674. +31585827556373306147 = -2338687527 - -31585827558711993674. +73869380941532599790686704198 = -2338687527 * -31585827558711993674. +2338687527 = -(-2338687527). +-2338687527 = +(-2338687527). +0 = -2338687527 div -31585827558711993674. +-2338687527 = -2338687527 rem -31585827558711993674. +-31585827558881865584 = -2338687527 band -31585827558711993674. +-2168815617 = -2338687527 bor -31585827558711993674. +31585827556713049967 = -2338687527 bxor -31585827558711993674. +2338687526 = bnot(-2338687527). +-1 = -2338687527 bsl -533. +-65759709852165087769940772575489996288042718555253349062666077449644046015414156042793337269979323586161617517094356159490764375295512553139276209064246923605092528553984 = -2338687527 bsr -533. +5812121546762844266932235 = 5812121546762844267224589 + -292354. +5812121546762844267516943 = 5812121546762844267224589 - -292354. +-1699196982682304572900177492506 = 5812121546762844267224589 * -292354. +-5812121546762844267224589 = -(5812121546762844267224589). +5812121546762844267224589 = +(5812121546762844267224589). +-19880424234875679030 = 5812121546762844267224589 div -292354. +87969 = 5812121546762844267224589 rem -292354. +5812121546762844267218956 = 5812121546762844267224589 band -292354. +-286721 = 5812121546762844267224589 bor -292354. +-5812121546762844267505677 = 5812121546762844267224589 bxor -292354. +-5812121546762844267224590 = bnot(5812121546762844267224589). +615 = 5812121546762844267224589 bsl -73. +54893935973594670110177900039258388459461541888 = 5812121546762844267224589 bsr -73. +3331753125934228494 = -7443 + 3331753125934235937. +-3331753125934243380 = -7443 - 3331753125934235937. +-24798238516328518079091 = -7443 * 3331753125934235937. +7443 = -(-7443). +-7443 = +(-7443). +0 = -7443 div 3331753125934235937. +-7443 = -7443 rem 3331753125934235937. +3331753125934235681 = -7443 band 3331753125934235937. +-7187 = -7443 bor 3331753125934235937. +-3331753125934242868 = -7443 bxor 3331753125934235937. +7442 = bnot(-7443). +-1 = -7443 bsl -798. +-12407507855981188840494084219584580446037109048249326109457336723239932290269158877083504967771744646499906831136730902159687587677902608573286114774374592008271564466080702589660172920510407946514421653774850994637431059410734325347533184827392 = -7443 bsr -798. +26635721247961419918017306131 = 28479837341185584372 + 26635721219481582576831721759. +-26635721191001745235646137387 = 28479837341185584372 - 26635721219481582576831721759. +758581007796000805728711634493377859651322750348 = 28479837341185584372 * 26635721219481582576831721759. +-28479837341185584372 = -(28479837341185584372). +28479837341185584372 = +(28479837341185584372). +0 = 28479837341185584372 div 26635721219481582576831721759. +28479837341185584372 = 28479837341185584372 rem 26635721219481582576831721759. +9804530054297034772 = 28479837341185584372 band 26635721219481582576831721759. +26635721238156889863720271359 = 28479837341185584372 bor 26635721219481582576831721759. +26635721228352359809423236587 = 28479837341185584372 bxor 26635721219481582576831721759. +-28479837341185584373 = bnot(28479837341185584372). +8208754229589487061188871904735264768 = 28479837341185584372 bsl 58. +98 = 28479837341185584372 bsr 58. +784958823981468756737666093662 = 632875826637545 + 784958823981468123861839456117. +-784958823981467490986012818572 = 632875826637545 - 784958823981468123861839456117. +496781464603706821016997050696933563692112765 = 632875826637545 * 784958823981468123861839456117. +-632875826637545 = -(632875826637545). +632875826637545 = +(632875826637545). +0 = 632875826637545 div 784958823981468123861839456117. +632875826637545 = 632875826637545 rem 784958823981468123861839456117. +67620506509921 = 632875826637545 band 784958823981468123861839456117. +784958823981468689117159583741 = 632875826637545 bor 784958823981468123861839456117. +784958823981468621496653073820 = 632875826637545 bxor 784958823981468123861839456117. +-632875826637546 = bnot(632875826637545). +0 = 632875826637545 bsl -593. +20516625748444697013132472763415875732836671730728516550567464549598887302810888413024109757475171676866082875547269136780171543238563532659989925889572073146078421290869696111709877260926320640 = 632875826637545 bsr -593. +-2914193355372640051694253540 = 515622817551199632229525229 + -3429816172923839683923778769. +3945438990475039316153303998 = 515622817551199632229525229 - -3429816172923839683923778769. +-1768491478765662757411666562480603349534105948500063101 = 515622817551199632229525229 * -3429816172923839683923778769. +-515622817551199632229525229 = -(515622817551199632229525229). +515622817551199632229525229 = +(515622817551199632229525229). +0 = 515622817551199632229525229 div -3429816172923839683923778769. +515622817551199632229525229 = 515622817551199632229525229 rem -3429816172923839683923778769. +206122455245401623684473389 = 515622817551199632229525229 band -3429816172923839683923778769. +-3120315810618041675378726929 = 515622817551199632229525229 bor -3429816172923839683923778769. +-3326438265863443299063200318 = 515622817551199632229525229 bxor -3429816172923839683923778769. +-515622817551199632229525230 = bnot(515622817551199632229525229). +0 = 515622817551199632229525229 bsl -276. +62605275486156137647802923481395651866850404438681977171102591552274731760454431062534142921293166485537030144 = 515622817551199632229525229 bsr -276. +-9913453277908 = -3738727 + -9913449539181. +9913445800454 = -3738727 - -9913449539181. +37063681455273562587 = -3738727 * -9913449539181. +3738727 = -(-3738727). +-3738727 = +(-3738727). +0 = -3738727 div -9913449539181. +-3738727 = -3738727 rem -9913449539181. +-9913451114095 = -3738727 band -9913449539181. +-2163813 = -3738727 bor -9913449539181. +9913448950282 = -3738727 bxor -9913449539181. +3738726 = bnot(-3738727). +-934682 = -3738727 bsl -2. +-14954908 = -3738727 bsr -2. +56395812787692 = 56399367924819 + -3555137127. +56402923061946 = 56399367924819 - -3555137127. +-200507486848856971655013 = 56399367924819 * -3555137127. +-56399367924819 = -(56399367924819). +56399367924819 = +(56399367924819). +-15864 = 56399367924819 div -3555137127. +672542091 = 56399367924819 rem -3555137127. +56397216114705 = 56399367924819 band -3555137127. +-1403327013 = 56399367924819 bor -3555137127. +-56398619441718 = 56399367924819 bxor -3555137127. +-56399367924820 = bnot(56399367924819). +0 = 56399367924819 bsl -729. +159272602282009369804829167225421786302420595178138543748234819107412786245682622256854084210389395589458167604383150065493827422572034432629455384375599948907220540068921691169946166324347611732916449742155274846225999064909299580928 = 56399367924819 bsr -729. +4994279985463060 = 3395489689 + 4994276589973371. +-4994273194483682 = 3395489689 - 4994276589973371. +16958014665268662015071619 = 3395489689 * 4994276589973371. +-3395489689 = -(3395489689). +3395489689 = +(3395489689). +0 = 3395489689 div 4994276589973371. +3395489689 = 3395489689 rem 4994276589973371. +2181173017 = 3395489689 band 4994276589973371. +4994277804290043 = 3395489689 bor 4994276589973371. +4994275623117026 = 3395489689 bxor 4994276589973371. +-3395489690 = bnot(3395489689). +0 = 3395489689 bsl -291. +13509247370636319377028265275489356165531332673832186424934247239333258613907867043126852213276672 = 3395489689 bsr -291. +523243201587728280751 = 523242478127831926822 + 723459896353929. +523241754667935572893 = 523242478127831926822 - 723459896353929. +378544948994334247525429156540183638 = 523242478127831926822 * 723459896353929. +-523242478127831926822 = -(523242478127831926822). +523242478127831926822 = +(523242478127831926822). +723250 = 523242478127831926822 div 723459896353929. +108089852777572 = 523242478127831926822 rem 723459896353929. +723038416994304 = 523242478127831926822 band 723459896353929. +523242478549311286447 = 523242478127831926822 bor 723459896353929. +523241755510894292143 = 523242478127831926822 bxor 723459896353929. +-523242478127831926823 = bnot(523242478127831926822). +0 = 523242478127831926822 bsl -999. +2803294094797220652232266501811179882751129680863999088493038299717880199239545298634531365335411847272580723990775872043912169086424045641711796232129861039764268922701116650361817709508239089301422949197285315743815759829635246059669306007739749073740441686438866628351372490944813670278407068149346034570668047425601536 = 523242478127831926822 bsr -999. +4252353997369259107525 = 4252353997362499368692 + 6759738833. +4252353997355739629859 = 4252353997362499368692 - 6759738833. +28744802447634066560485296816436 = 4252353997362499368692 * 6759738833. +-4252353997362499368692 = -(4252353997362499368692). +4252353997362499368692 = +(4252353997362499368692). +629070752941 = 4252353997362499368692 div 6759738833. +2672710839 = 4252353997362499368692 rem 6759738833. +2172112 = 4252353997362499368692 band 6759738833. +4252353997369256935413 = 4252353997362499368692 bor 6759738833. +4252353997369254763301 = 4252353997362499368692 bxor 6759738833. +-4252353997362499368693 = bnot(4252353997362499368692). +33221515604394526317 = 4252353997362499368692 bsl -7. +544301311662399919192576 = 4252353997362499368692 bsr -7. +54472535782100 = 54472535869625 + -87525. +54472535957150 = 54472535869625 - -87525. +-4767708701988928125 = 54472535869625 * -87525. +-54472535869625 = -(54472535869625). +54472535869625 = +(54472535869625). +-622365448 = 54472535869625 div -87525. +33425 = 54472535869625 rem -87525. +54472535869465 = 54472535869625 band -87525. +-87365 = 54472535869625 bor -87525. +-54472535956830 = 54472535869625 bxor -87525. +-54472535869626 = bnot(54472535869625). +0 = 54472535869625 bsl -377. +16768181217720974853415558020309662149305308050341966976476256634902959995822887523210131218903662344688915902893996573196288000 = 54472535869625 bsr -377. +-2579111915618386289526442805 = -2579111915618386289527399793 + 956988. +-2579111915618386289528356781 = -2579111915618386289527399793 - 956988. +-2468179153903808258442247273103484 = -2579111915618386289527399793 * 956988. +2579111915618386289527399793 = -(-2579111915618386289527399793). +-2579111915618386289527399793 = +(-2579111915618386289527399793). +-2695030570517484325328 = -2579111915618386289527399793 div 956988. +-407729 = -2579111915618386289527399793 rem 956988. +137740 = -2579111915618386289527399793 band 956988. +-2579111915618386289526580545 = -2579111915618386289527399793 bor 956988. +-2579111915618386289526718285 = -2579111915618386289527399793 bxor 956988. +2579111915618386289527399792 = bnot(-2579111915618386289527399793). +-1 = -2579111915618386289527399793 bsl -511. +-17290118597218821021024529513821890190835063660820584345872985981883877694306832228957223603920918937419348656157110128014320605373240673410652865615970155698006925060701575985496064 = -2579111915618386289527399793 bsr -511. +984438258742911654929765 = -63 + 984438258742911654929828. +-984438258742911654929891 = -63 - 984438258742911654929828. +-62019610300803434260579164 = -63 * 984438258742911654929828. +63 = -(-63). +-63 = +(-63). +0 = -63 div 984438258742911654929828. +-63 = -63 rem 984438258742911654929828. +984438258742911654929792 = -63 band 984438258742911654929828. +-27 = -63 bor 984438258742911654929828. +-984438258742911654929819 = -63 bxor 984438258742911654929828. +62 = bnot(-63). +-260019964543335238439042237888598017270995168283403561672355661474066061414638016772564743132206272166910053785743743021637405439442728037865499653462228073009596571030760314864297543856366138955785364634510194292666607675338659293334523473611900765772194770285605421056 = -63 bsl 889. +-1 = -63 bsr 889. +91797984805388653757851517010 = 91798462158182776484622633323 + -477352794122726771116313. +91798939510976899211393749636 = 91798462158182776484622633323 - -477352794122726771116313. +-43820252407377947171728929967148734684504702382698099 = 91798462158182776484622633323 * -477352794122726771116313. +-91798462158182776484622633323 = -(91798462158182776484622633323). +91798462158182776484622633323 = +(91798462158182776484622633323). +-192307 = 91798462158182776484622633323 div -477352794122726771116313. +178378823559311557829232 = 91798462158182776484622633323 rem -477352794122726771116313. +91798008423564741150336221283 = 91798462158182776484622633323 band -477352794122726771116313. +-23618176087392484704273 = 91798462158182776484622633323 bor -477352794122726771116313. +-91798032041740828542820925556 = 91798462158182776484622633323 bxor -477352794122726771116313. +-91798462158182776484622633324 = bnot(91798462158182776484622633323). +5875101578123697695015848532672 = 91798462158182776484622633323 bsl 6. +1434350971221605882572228645 = 91798462158182776484622633323 bsr 6. +-9847688181859085960044534308 = -9854555878181727326733483689 + 6867696322641366688949381. +-9861423574504368693422433070 = -9854555878181727326733483689 - 6867696322641366688949381. +-67678097165852512684070512237042486621497513510146509 = -9854555878181727326733483689 * 6867696322641366688949381. +9854555878181727326733483689 = -(-9854555878181727326733483689). +-9854555878181727326733483689 = +(-9854555878181727326733483689). +-1434 = -9854555878181727326733483689 div 6867696322641366688949381. +-6279351514007494780071335 = -9854555878181727326733483689 rem 6867696322641366688949381. +604647396178036289257477 = -9854555878181727326733483689 band 6867696322641366688949381. +-9848292829255263996333791785 = -9854555878181727326733483689 bor 6867696322641366688949381. +-9848897476651442032623049262 = -9854555878181727326733483689 bxor 6867696322641366688949381. +9854555878181727326733483688 = bnot(-9854555878181727326733483689). +-3049837322744065660367024103424449271192547190672195584 = -9854555878181727326733483689 bsl 88. +-32 = -9854555878181727326733483689 bsr 88. +-986483217873878995 = -37444 + -986483217873841551. +986483217873804107 = -37444 - -986483217873841551. +36937877610068123035644 = -37444 * -986483217873841551. +37444 = -(-37444). +-37444 = +(-37444). +0 = -37444 div -986483217873841551. +-37444 = -37444 rem -986483217873841551. +-986483217873878992 = -37444 band -986483217873841551. +-3 = -37444 bor -986483217873841551. +986483217873878989 = -37444 bxor -986483217873841551. +37443 = bnot(-37444). +-1483309658592056928426329838190592 = -37444 bsl 95. +-1 = -37444 bsr 95. +-349988546208659 = 8353537459 + -349996899746118. +350005253283577 = 8353537459 - -349996899746118. +-2923712212563064302834162 = 8353537459 * -349996899746118. +-8353537459 = -(8353537459). +8353537459 = +(8353537459). +0 = 8353537459 div -349996899746118. +8353537459 = 8353537459 rem -349996899746118. +8338807986 = 8353537459 band -349996899746118. +-349996885016645 = 8353537459 bor -349996899746118. +-350005223824631 = 8353537459 bxor -349996899746118. +-8353537460 = bnot(8353537459). +3983 = 8353537459 bsl -21. +17518637789216768 = 8353537459 bsr -21. +-621886761 = 9885 + -621896646. +621906531 = 9885 - -621896646. +-6147448345710 = 9885 * -621896646. +-9885 = -(9885). +9885 = +(9885). +0 = 9885 div -621896646. +9885 = 9885 rem -621896646. +1048 = 9885 band -621896646. +-621887809 = 9885 bor -621896646. +-621888857 = 9885 bxor -621896646. +-9886 = bnot(9885). +77 = 9885 bsl -7. +1265280 = 9885 bsr -7. +999851860769505 = 999851388881667 + 471887838. +999850916993829 = 999851388881667 - 471887838. +471817710220667078465946 = 999851388881667 * 471887838. +-999851388881667 = -(999851388881667). +999851388881667 = +(999851388881667). +2118832 = 999851388881667 div 471887838. +337316451 = 999851388881667 rem 471887838. +134236930 = 999851388881667 band 471887838. +999851726532575 = 999851388881667 bor 471887838. +999851592295645 = 999851388881667 bxor 471887838. +-999851388881668 = bnot(999851388881667). +127980977776853376 = 999851388881667 bsl 7. +7811338975638 = 999851388881667 bsr 7. +591659823198345342511450469317 = 591659823198345342511446313699 + 4155618. +591659823198345342511442158081 = 591659823198345342511446313699 - 4155618. +2458712211159861475556731507241210982 = 591659823198345342511446313699 * 4155618. +-591659823198345342511446313699 = -(591659823198345342511446313699). +591659823198345342511446313699 = +(591659823198345342511446313699). +142375892875222251542717 = 591659823198345342511446313699 div 4155618. +3779593 = 591659823198345342511446313699 rem 4155618. +1132770 = 591659823198345342511446313699 band 4155618. +591659823198345342511449336547 = 591659823198345342511446313699 bor 4155618. +591659823198345342511448203777 = 591659823198345342511446313699 bxor 4155618. +-591659823198345342511446313700 = bnot(591659823198345342511446313699). +0 = 591659823198345342511446313699 bsl -227. +127608938228185338488286093170817910594843289499086799450886247183853299206472132392911663238479872 = 591659823198345342511446313699 bsr -227. +97342756719869374268 = 97342756789528864195 + -69659489927. +97342756859188354122 = 97342756789528864195 - -69659489927. +-6780846786046596774467353463765 = 97342756789528864195 * -69659489927. +-97342756789528864195 = -(97342756789528864195). +97342756789528864195 = +(97342756789528864195). +-1397408406 = 97342756789528864195 div -69659489927. +7866737833 = 97342756789528864195 rem -69659489927. +97342756789125939521 = 97342756789528864195 band -69659489927. +-69256565253 = 97342756789528864195 bor -69659489927. +-97342756858382504774 = 97342756789528864195 bxor -69659489927. +-97342756789528864196 = bnot(97342756789528864195). +0 = 97342756789528864195 bsl -653. +3638235524365231785090583033971798644167750991518951290046858219409184295614139712285888748466465048994893130074583871738843577903195379854051907486739870268645716009456943061582792921520195791432792560529229417021440 = 97342756789528864195 bsr -653. +389678954744234422040883672 = 389678954839351938193496446 + -95117516152612774. +389678954934469454346109220 = 389678954839351938193496446 - -95117516152612774. +-37065294281265321678205132948334177383201204 = 389678954839351938193496446 * -95117516152612774. +-389678954839351938193496446 = -(389678954839351938193496446). +389678954839351938193496446 = +(389678954839351938193496446). +-4096815924 = 389678954839351938193496446 div -95117516152612774. +14000711464483270 = 389678954839351938193496446 rem -95117516152612774. +389678954821231161930815578 = 389678954839351938193496446 band -95117516152612774. +-76996739889931906 = 389678954839351938193496446 bor -95117516152612774. +-389678954898227901820747484 = 389678954839351938193496446 bxor -95117516152612774. +-389678954839351938193496447 = bnot(389678954839351938193496446). +107114135486366560536017955549582721024 = 389678954839351938193496446 bsl 38. +1417643779275211 = 389678954839351938193496446 bsr 38. +-84775522259114738152919513 = -84775522259114738152919831 + 318. +-84775522259114738152920149 = -84775522259114738152919831 - 318. +-26958616078398486732628506258 = -84775522259114738152919831 * 318. +84775522259114738152919831 = -(-84775522259114738152919831). +-84775522259114738152919831 = +(-84775522259114738152919831). +-266589692638725591675848 = -84775522259114738152919831 div 318. +-167 = -84775522259114738152919831 rem 318. +40 = -84775522259114738152919831 band 318. +-84775522259114738152919553 = -84775522259114738152919831 bor 318. +-84775522259114738152919593 = -84775522259114738152919831 bxor 318. +84775522259114738152919830 = bnot(-84775522259114738152919831). +-331154383824666945909844 = -84775522259114738152919831 bsl -8. +-21702533698333372967147476736 = -84775522259114738152919831 bsr -8. +-54388 = 736 + -55124. +55860 = 736 - -55124. +-40571264 = 736 * -55124. +-736 = -(736). +736 = +(736). +0 = 736 div -55124. +736 = 736 rem -55124. +160 = 736 band -55124. +-54548 = 736 bor -55124. +-54708 = 736 bxor -55124. +-737 = bnot(736). +0 = 736 bsl -388. +463998024968741387203797976219291196168619009649001099961759103128397619581151152160014399417524766586138851213853065216 = 736 bsr -388. +92644319712923691793287 = 8385535252126162 + 92644311327388439667125. +-92644302941853187540963 = 8385535252126162 - 92644311327388439667125. +776872138544766865531637813315783824250 = 8385535252126162 * 92644311327388439667125. +-8385535252126162 = -(8385535252126162). +8385535252126162 = +(8385535252126162). +0 = 8385535252126162 div 92644311327388439667125. +8385535252126162 = 8385535252126162 rem 92644311327388439667125. +6764784243458448 = 8385535252126162 band 92644311327388439667125. +92644312948139448334839 = 8385535252126162 bor 92644311327388439667125. +92644306183355204876391 = 8385535252126162 bxor 92644311327388439667125. +-8385535252126163 = bnot(8385535252126162). +281371872401070158249984 = 8385535252126162 bsl 25. +249908424 = 8385535252126162 bsr 25. +-29189349977685776166969722520 = -29189349977685776166969727281 + 4761. +-29189349977685776166969732042 = -29189349977685776166969727281 - 4761. +-138970495243761980330942871584841 = -29189349977685776166969727281 * 4761. +29189349977685776166969727281 = -(-29189349977685776166969727281). +-29189349977685776166969727281 = +(-29189349977685776166969727281). +-6130928371704636876070096 = -29189349977685776166969727281 div 4761. +-225 = -29189349977685776166969727281 rem 4761. +649 = -29189349977685776166969727281 band 4761. +-29189349977685776166969723169 = -29189349977685776166969727281 bor 4761. +-29189349977685776166969723818 = -29189349977685776166969727281 bxor 4761. +29189349977685776166969727280 = bnot(-29189349977685776166969727281). +-1 = -29189349977685776166969727281 bsl -563. +-881276080166012926281107714324665601604190299552786912735934932557813868523097097100922140056103562533709036837914341738001573003565008318526683760280034928105733555883921301952092024813908339458048 = -29189349977685776166969727281 bsr -563. +-58881726281 = -5 + -58881726276. +58881726271 = -5 - -58881726276. +294408631380 = -5 * -58881726276. +5 = -(-5). +-5 = +(-5). +0 = -5 div -58881726276. +-5 = -5 rem -58881726276. +-58881726280 = -5 band -58881726276. +-1 = -5 bor -58881726276. +58881726279 = -5 bxor -58881726276. +4 = bnot(-5). +-80 = -5 bsl 4. +-1 = -5 bsr 4. +7970339327155153060970032148 = -27584345718728311767683193 + 7997923672873881372737715341. +-8025508018592609684505398534 = -27584345718728311767683193 - 7997923672873881372737715341. +-220617491624554464326103592082184976562231515503963813 = -27584345718728311767683193 * 7997923672873881372737715341. +27584345718728311767683193 = -(-27584345718728311767683193). +-27584345718728311767683193 = +(-27584345718728311767683193). +0 = -27584345718728311767683193 div 7997923672873881372737715341. +-27584345718728311767683193 = -27584345718728311767683193 rem 7997923672873881372737715341. +7970646287930818855716007045 = -27584345718728311767683193 band 7997923672873881372737715341. +-306960775665794745974897 = -27584345718728311767683193 bor 7997923672873881372737715341. +-7970953248706484650461981942 = -27584345718728311767683193 bxor 7997923672873881372737715341. +27584345718728311767683192 = bnot(-27584345718728311767683193). +-53875675231891233921257 = -27584345718728311767683193 bsl -9. +-14123185007988895625053794816 = -27584345718728311767683193 bsr -9. +-58817458847070320482149769860 = -58817458847842812994772557344 + 772492512622787484. +-58817458848615305507395344828 = -58817458847842812994772557344 - 772492512622787484. +-45436046571457497602599660023827514268515482496 = -58817458847842812994772557344 * 772492512622787484. +58817458847842812994772557344 = -(-58817458847842812994772557344). +-58817458847842812994772557344 = +(-58817458847842812994772557344). +-76139843282 = -58817458847842812994772557344 div 772492512622787484. +-225367181021474856 = -58817458847842812994772557344 rem 772492512622787484. +756676585255575936 = -58817458847842812994772557344 band 772492512622787484. +-58817458847826997067405345796 = -58817458847842812994772557344 bor 772492512622787484. +-58817458848583673652660921732 = -58817458847842812994772557344 bxor 772492512622787484. +58817458847842812994772557343 = bnot(-58817458847842812994772557344). +-1 = -58817458847842812994772557344 bsl -213. +-774275172673422732549803392048349440221676987250114196486616281772697653613546737517406978048 = -58817458847842812994772557344 bsr -213. +-59195539 = 91593 + -59287132. +59378725 = 91593 - -59287132. +-5430286281276 = 91593 * -59287132. +-91593 = -(91593). +91593 = +(91593). +0 = 91593 div -59287132. +91593 = 91593 rem -59287132. +82304 = 91593 band -59287132. +-59277843 = 91593 bor -59287132. +-59360147 = 91593 bxor -59287132. +-91594 = bnot(91593). +0 = 91593 bsl -221. +308667799385541068839116989108173629036305871136719831907715371694555136 = 91593 bsr -221. +-5343798581253211314197119350 = -5343798581253211316914762972 + 2717643622. +-5343798581253211319632406594 = -5343798581253211316914762972 - 2717643622. +-14522540131595438502431626308497564584 = -5343798581253211316914762972 * 2717643622. +5343798581253211316914762972 = -(-5343798581253211316914762972). +-5343798581253211316914762972 = +(-5343798581253211316914762972). +-1966335297974257831 = -5343798581253211316914762972 div 2717643622. +-2314059090 = -5343798581253211316914762972 rem 2717643622. +2692465444 = -5343798581253211316914762972 band 2717643622. +-5343798581253211316889584794 = -5343798581253211316914762972 bor 2717643622. +-5343798581253211319582050238 = -5343798581253211316914762972 bxor 2717643622. +5343798581253211316914762971 = bnot(-5343798581253211316914762972). +-607519562123936 = -5343798581253211316914762972 bsl -43. +-47004549412646382184706045100711452082176 = -5343798581253211316914762972 bsr -43. +99984403910220432 = 99984399368494261 + 4541726171. +99984394826768090 = 99984399368494261 - 4541726171. +454101763303606258047004631 = 99984399368494261 * 4541726171. +-99984399368494261 = -(99984399368494261). +99984399368494261 = +(99984399368494261). +22014625 = 99984399368494261 div 4541726171. +861243386 = 99984399368494261 rem 4541726171. +238034065 = 99984399368494261 band 4541726171. +99984403672186367 = 99984399368494261 bor 4541726171. +99984403434152302 = 99984399368494261 bxor 4541726171. +-99984399368494262 = bnot(99984399368494261). +990197530257271489688167149327288051760627712 = 99984399368494261 bsl 93. +0 = 99984399368494261 bsr 93. +79212883456597265552 = 79212883456949412315 + -352146763. +79212883457301559078 = 79212883456949412315 - -352146763. +-27894560497260985401479586345 = 79212883456949412315 * -352146763. +-79212883456949412315 = -(79212883456949412315). +79212883456949412315 = +(79212883456949412315). +-224942812996 = 79212883456949412315 div -352146763. +293680367 = 79212883456949412315 rem -352146763. +79212883456599171217 = 79212883456949412315 band -352146763. +-1905665 = 79212883456949412315 bor -352146763. +-79212883456601076882 = 79212883456949412315 bxor -352146763. +-79212883456949412316 = bnot(79212883456949412315). +37771646240687 = 79212883456949412315 bsl -21. +166121456967508373935226880 = 79212883456949412315 bsr -21. +828850801818857828 = 828856788173989676 + -5986355131848. +828862774529121524 = 828856788173989676 - -5986355131848. +-4961831087452413774035170801248 = 828856788173989676 * -5986355131848. +-828856788173989676 = -(828856788173989676). +828856788173989676 = +(828856788173989676). +-138457 = 828856788173989676 div -5986355131848. +4015683711140 = 828856788173989676 rem -5986355131848. +828856438998172200 = 828856788173989676 band -5986355131848. +-5637179314372 = 828856788173989676 bor -5986355131848. +-828862076177486572 = 828856788173989676 bxor -5986355131848. +-828856788173989677 = bnot(828856788173989676). +207214197043497419 = 828856788173989676 bsl -2. +3315427152695958704 = 828856788173989676 bsr -2. +108892 = 81938 + 26954. +54984 = 81938 - 26954. +2208556852 = 81938 * 26954. +-81938 = -(81938). +81938 = +(81938). +3 = 81938 div 26954. +1076 = 81938 rem 26954. +16386 = 81938 band 26954. +92506 = 81938 bor 26954. +76120 = 81938 bxor 26954. +-81939 = bnot(81938). +1280 = 81938 bsl -6. +5244032 = 81938 bsr -6. +-71218210020096204 = -71453447486777563 + 235237466681359. +-71688684953458922 = -71453447486777563 - 235237466681359. +-16808527972439071951918631548117 = -71453447486777563 * 235237466681359. +71453447486777563 = -(-71453447486777563). +-71453447486777563 = +(-71453447486777563). +-303 = -71453447486777563 div 235237466681359. +-176495082325786 = -71453447486777563 rem 235237466681359. +5988602253317 = -71453447486777563 band 235237466681359. +-71224198622349521 = -71453447486777563 bor 235237466681359. +-71230187224602838 = -71453447486777563 bxor 235237466681359. +71453447486777562 = bnot(-71453447486777563). +-8931680935847196 = -71453447486777563 bsl -3. +-571627579894220504 = -71453447486777563 bsr -3. +5537188928 = -55 + 5537188983. +-5537189038 = -55 - 5537188983. +-304545394065 = -55 * 5537188983. +55 = -(-55). +-55 = +(-55). +0 = -55 div 5537188983. +-55 = -55 rem 5537188983. +5537188929 = -55 band 5537188983. +-1 = -55 bor 5537188983. +-5537188930 = -55 bxor 5537188983. +54 = bnot(-55). +-944892805120 = -55 bsl 34. +-1 = -55 bsr 34. +-64978773561394548434684261 = -552972 + -64978773561394548434131289. +64978773561394548433578317 = -552972 - -64978773561394548434131289. +35931442373791466236718447140908 = -552972 * -64978773561394548434131289. +552972 = -(-552972). +-552972 = +(-552972). +0 = -552972 div -64978773561394548434131289. +-552972 = -552972 rem -64978773561394548434131289. +-64978773561394548434663772 = -552972 band -64978773561394548434131289. +-20489 = -552972 bor -64978773561394548434131289. +64978773561394548434643283 = -552972 bxor -64978773561394548434131289. +552971 = bnot(-552972). +-1 = -552972 bsl -888. +-1141140951059183916429476701347093831796640795206430430992744879655851254861708042942529136026209259783179256047700706874292693338567652448845722812494564936414782818063663435167780487470972195163956703592653739352416185551169596085347445351191428494052238781860093657874432 = -552972 bsr -888. +-7931161752156336473679481555 = -7931161752156336685154151379 + 211474669824. +-7931161752156336896628821203 = -7931161752156336685154151379 - 211474669824. +-1677239812857998620522352805416939287296 = -7931161752156336685154151379 * 211474669824. +7931161752156336685154151379 = -(-7931161752156336685154151379). +-7931161752156336685154151379 = +(-7931161752156336685154151379). +-37504074406438623 = -7931161752156336685154151379 div 211474669824. +-106507939027 = -7931161752156336685154151379 rem 211474669824. +73627222016 = -7931161752156336685154151379 band 211474669824. +-7931161752156336547306703571 = -7931161752156336685154151379 bor 211474669824. +-7931161752156336620933925587 = -7931161752156336685154151379 bxor 211474669824. +7931161752156336685154151378 = bnot(-7931161752156336685154151379). +-12313272113186103921130374203648000551845741068461661724876816962650434751748552394322870652014840162966396119852328739173423034400378461241792451490464791783699965196730140308013088409468006269539623602257087703480757573735187413571225145620726804090846183424 = -7931161752156336685154151379 bsl 768. +-1 = -7931161752156336685154151379 bsr 768. +714957416338999897061 = 714958245882488652896 + -829543488755835. +714959075425977408731 = 714958245882488652896 - -829543488755835. +-593088957604111741020359952209648160 = 714958245882488652896 * -829543488755835. +-714958245882488652896 = -(714958245882488652896). +714958245882488652896 = +(714958245882488652896). +-861869 = 714958245882488652896 div -829543488755835. +428771985897281 = 714958245882488652896 rem -829543488755835. +714957981904603087872 = 714958245882488652896 band -829543488755835. +-565565603190811 = 714958245882488652896 bor -829543488755835. +-714958547470206278683 = 714958245882488652896 bxor -829543488755835. +-714958245882488652897 = bnot(714958245882488652896). +45757327736479273785344 = 714958245882488652896 bsl 6. +11171222591913885201 = 714958245882488652896 bsr 6. +996378621616514 = 996378621622899 + -6385. +996378621629284 = 996378621622899 - -6385. +-6361877499062210115 = 996378621622899 * -6385. +-996378621622899 = -(996378621622899). +996378621622899 = +(996378621622899). +-156049901585 = 996378621622899 div -6385. +2674 = 996378621622899 rem -6385. +996378621616643 = 996378621622899 band -6385. +-129 = 996378621622899 bor -6385. +-996378621616772 = 996378621622899 bxor -6385. +-996378621622900 = bnot(996378621622899). +1191685205215865960980475238890439746942267230329209039566398371784516186461927373794119083796406545393401897213207408688658831871831161338124049068588648198137657255470407110838856633687430191838787047644626681856 = 996378621622899 bsl 658. +0 = 996378621622899 bsr 658. +-7856694390025 = -7856982256154 + 287866129. +-7857270122283 = -7856982256154 - 287866129. +-2261759067700738407866 = -7856982256154 * 287866129. +7856982256154 = -(-7856982256154). +-7856982256154 = +(-7856982256154). +-27293 = -7856982256154 div 287866129. +-251997357 = -7856982256154 rem 287866129. +17306880 = -7856982256154 band 287866129. +-7856711696905 = -7856982256154 bor 287866129. +-7856729003785 = -7856982256154 bxor 287866129. +7856982256153 = bnot(-7856982256154). +-30691336939 = -7856982256154 bsl -8. +-2011387457575424 = -7856982256154 bsr -8. +5458631248550523 = 5458631248551254 + -731. +5458631248551985 = 5458631248551254 - -731. +-3990259442690966674 = 5458631248551254 * -731. +-5458631248551254 = -(5458631248551254). +5458631248551254 = +(5458631248551254). +-7467347809235 = 5458631248551254 div -731. +469 = 5458631248551254 rem -731. +5458631248551172 = 5458631248551254 band -731. +-649 = 5458631248551254 bor -731. +-5458631248551821 = 5458631248551254 bxor -731. +-5458631248551255 = bnot(5458631248551254). +2342024938910654820051888536507780965891187943829321942042078042290919638154856722380825766850939794692762065322883142094692838537470620714612390306960835945300214088204288 = 5458631248551254 bsl 517. +0 = 5458631248551254 bsr 517. +37877562043706634320734816 = -219639748162211523 + 37877562263346382482946339. +-37877562482986130645157862 = -219639748162211523 - 37877562263346382482946339. +-8319418236519886147530691974581819176464297 = -219639748162211523 * 37877562263346382482946339. +219639748162211523 = -(-219639748162211523). +-219639748162211523 = +(-219639748162211523). +0 = -219639748162211523 div 37877562263346382482946339. +-219639748162211523 = -219639748162211523 rem 37877562263346382482946339. +37877562046028814865936673 = -219639748162211523 band 37877562263346382482946339. +-2322180545201857 = -219639748162211523 bor 37877562263346382482946339. +-37877562048350995411138530 = -219639748162211523 bxor 37877562263346382482946339. +219639748162211522 = bnot(-219639748162211523). +-1 = -219639748162211523 bsl -89. +-135950419234279581409087868002800581870616576 = -219639748162211523 bsr -89. +69778474864706102665228970530 = 69778474864697313953383437367 + 8788711845533163. +69778474864688525241537904204 = 69778474864697313953383437367 - 8788711845533163. +613262908606603356476071407813496285731901821 = 69778474864697313953383437367 * 8788711845533163. +-69778474864697313953383437367 = -(69778474864697313953383437367). +69778474864697313953383437367 = +(69778474864697313953383437367). +7939556568823 = 69778474864697313953383437367 div 8788711845533163. +1978346045060218 = 69778474864697313953383437367 rem 8788711845533163. +4239721133118499 = 69778474864697313953383437367 band 8788711845533163. +69778474864701862944095852031 = 69778474864697313953383437367 bor 8788711845533163. +69778474864697623222962733532 = 69778474864697313953383437367 bxor 8788711845533163. +-69778474864697313953383437368 = bnot(69778474864697313953383437367). +1116455597835157023254134997872 = 69778474864697313953383437367 bsl 4. +4361154679043582122086464835 = 69778474864697313953383437367 bsr 4. +68916954866495927 = 68916954866738219 + -242292. +68916954866980511 = 68916954866738219 - -242292. +-16698026828571736557948 = 68916954866738219 * -242292. +-68916954866738219 = -(68916954866738219). +68916954866738219 = +(68916954866738219). +-284437599535 = 68916954866738219 div -242292. +203999 = 68916954866738219 rem -242292. +68916954866664456 = 68916954866738219 band -242292. +-168529 = 68916954866738219 bor -242292. +-68916954866832985 = 68916954866738219 bxor -242292. +-68916954866738220 = bnot(68916954866738219). +2603608942112997136130701629317963579392 = 68916954866738219 bsl 75. +0 = 68916954866738219 bsr 75. +798375855535459387752176231 = -558 + 798375855535459387752176789. +-798375855535459387752177347 = -558 - 798375855535459387752176789. +-445493727388786338365714648262 = -558 * 798375855535459387752176789. +558 = -(-558). +-558 = +(-558). +0 = -558 div 798375855535459387752176789. +-558 = -558 rem 798375855535459387752176789. +798375855535459387752176784 = -558 band 798375855535459387752176789. +-553 = -558 bor 798375855535459387752176789. +-798375855535459387752177337 = -558 bxor 798375855535459387752176789. +557 = bnot(-558). +-1 = -558 bsl -555. +-65808469782825627329712108005982938785363813781011679969810097360533071331713095608251834770285424759004354789598944545439749569484313571530290009759357637261136331014144 = -558 bsr -555. +31341992556638337 = 31341992588568319 + -31929982. +31341992620498301 = 31341992588568319 - -31929982. +-1000749259197119831440258 = 31341992588568319 * -31929982. +-31341992588568319 = -(31341992588568319). +31341992588568319 = +(31341992588568319). +-981585037 = 31341992588568319 div -31929982. +25688985 = 31341992588568319 rem -31929982. +31341992575778946 = 31341992588568319 band -31929982. +-19140609 = 31341992588568319 bor -31929982. +-31341992594919555 = 31341992588568319 bxor -31929982. +-31341992588568320 = bnot(31341992588568319). +0 = 31341992588568319 bsl -82. +151560576313962352491548366831053308952576 = 31341992588568319 bsr -82. +-71152585374235 = -71152585374226 + -9. +-71152585374217 = -71152585374226 - -9. +640373268368034 = -71152585374226 * -9. +71152585374226 = -(-71152585374226). +-71152585374226 = +(-71152585374226). +7905842819358 = -71152585374226 div -9. +-4 = -71152585374226 rem -9. +-71152585374234 = -71152585374226 band -9. +-1 = -71152585374226 bor -9. +71152585374233 = -71152585374226 bxor -9. +71152585374225 = bnot(-71152585374226). +-1401777304902370023267168911069106526994726800019700595916679983405075563365032665475935344090222914425442753620093033909959262208 = -71152585374226 bsl 383. +-1 = -71152585374226 bsr 383. +-79667436337 = -421 + -79667435916. +79667435495 = -421 - -79667435916. +33539990520636 = -421 * -79667435916. +421 = -(-421). +-421 = +(-421). +0 = -421 div -79667435916. +-421 = -421 rem -79667435916. +-79667435952 = -421 band -79667435916. +-385 = -421 bor -79667435916. +79667435567 = -421 bxor -79667435916. +420 = bnot(-421). +-1 = -421 bsl -43. +-3703155162349568 = -421 bsr -43. +83279812644292437334481164553 = 551264226118 + 83279812644292436783216938435. +-83279812644292436231952712317 = 551264226118 - 83279812644292436783216938435. +45909181468607901372980522896879525045330 = 551264226118 * 83279812644292436783216938435. +-551264226118 = -(551264226118). +551264226118 = +(551264226118). +0 = 551264226118 div 83279812644292436783216938435. +551264226118 = 551264226118 rem 83279812644292436783216938435. +550844238146 = 551264226118 band 83279812644292436783216938435. +83279812644292436783636926407 = 551264226118 bor 83279812644292436783216938435. +83279812644292436232792688261 = 551264226118 bxor 83279812644292436783216938435. +-551264226119 = bnot(551264226118). +36994715978618109952 = 551264226118 bsl 26. +8214 = 551264226118 bsr 26. +87569964599575541 = 87569964599575535 + 6. +87569964599575529 = 87569964599575535 - 6. +525419787597453210 = 87569964599575535 * 6. +-87569964599575535 = -(87569964599575535). +87569964599575535 = +(87569964599575535). +14594994099929255 = 87569964599575535 div 6. +5 = 87569964599575535 rem 6. +6 = 87569964599575535 band 6. +87569964599575535 = 87569964599575535 bor 6. +87569964599575529 = 87569964599575535 bxor 6. +-87569964599575536 = bnot(87569964599575535). +350279858398302140 = 87569964599575535 bsl 2. +21892491149893883 = 87569964599575535 bsr 2. +-79139683474112 = 3266 + -79139683477378. +79139683480644 = 3266 - -79139683477378. +-258470206237116548 = 3266 * -79139683477378. +-3266 = -(3266). +3266 = +(3266). +0 = 3266 div -79139683477378. +3266 = 3266 rem -79139683477378. +2114 = 3266 band -79139683477378. +-79139683476226 = 3266 bor -79139683477378. +-79139683478340 = 3266 bxor -79139683477378. +-3267 = bnot(3266). +0 = 3266 bsl -97. +517518357543174653161029083594752 = 3266 bsr -97. +-528826609416005235279143258934 = -528822366958813963365687686735 + -4242457191271913455572199. +-528818124501622691452232114536 = -528822366958813963365687686735 - -4242457191271913455572199. +2243506253609855016895612866281530019759954648087080265 = -528822366958813963365687686735 * -4242457191271913455572199. +528822366958813963365687686735 = -(-528822366958813963365687686735). +-528822366958813963365687686735 = +(-528822366958813963365687686735). +124650 = -528822366958813963365687686735 div -4242457191271913455572199. +-78066769951128613081385 = -528822366958813963365687686735 rem -4242457191271913455572199. +-528822378175597133599814448879 = -528822366958813963365687686735 band -4242457191271913455572199. +-4231240408101679328810055 = -528822366958813963365687686735 bor -4242457191271913455572199. +528818146935189031920485638824 = -528822366958813963365687686735 bxor -4242457191271913455572199. +528822366958813963365687686734 = bnot(-528822366958813963365687686735). +-1 = -528822366958813963365687686735 bsl -694. +-43463711218466338955572487038712869586135496388142499896172260074134030839763399010045581644463349710359458383073992347886041147194909733968081404679983369726128835813905894046541858902553215110731412580659716174189772604269171919017738240 = -528822366958813963365687686735 bsr -694. +797319233226109 = 797319233226116 + -7. +797319233226123 = 797319233226116 - -7. +-5581234632582812 = 797319233226116 * -7. +-797319233226116 = -(797319233226116). +797319233226116 = +(797319233226116). +-113902747603730 = 797319233226116 div -7. +6 = 797319233226116 rem -7. +797319233226112 = 797319233226116 band -7. +-3 = 797319233226116 bor -7. +-797319233226115 = 797319233226116 bxor -7. +-797319233226117 = bnot(797319233226116). +0 = 797319233226116 bsl -678. +999929314538887397457460885892402574280556113199216091903682678906350648933619397885255043195645170578694143264320226870569053104450492035830990612081822756284334114092839013846886137293561013683556295378342835969327104 = 797319233226116 bsr -678. +74658793917586461856003213 = 74658793917586461855943656 + 59557. +74658793917586461855884099 = 74658793917586461855943656 - 59557. +4446453789349696908754436320392 = 74658793917586461855943656 * 59557. +-74658793917586461855943656 = -(74658793917586461855943656). +74658793917586461855943656 = +(74658793917586461855943656). +1253568747881633760195 = 74658793917586461855943656 div 59557. +10041 = 74658793917586461855943656 rem 59557. +34976 = 74658793917586461855943656 band 59557. +74658793917586461855968237 = 74658793917586461855943656 bor 59557. +74658793917586461855933261 = 74658793917586461855943656 bxor 59557. +-74658793917586461855943657 = bnot(74658793917586461855943656). +180513887256515809585267167850601915130806022438912 = 74658793917586461855943656 bsl 81. +30 = 74658793917586461855943656 bsr 81. +328255484272303502 = 328255484352167823 + -79864321. +328255484432032144 = 328255484352167823 - -79864321. +-26215901372312008061943183 = 328255484352167823 * -79864321. +-328255484352167823 = -(328255484352167823). +328255484352167823 = +(328255484352167823). +-4110164341 = 328255484352167823 div -79864321. +59790362 = 328255484352167823 rem -79864321. +328255484280724879 = 328255484352167823 band -79864321. +-8421377 = 328255484352167823 bor -79864321. +-328255484289146256 = 328255484352167823 bxor -79864321. +-328255484352167824 = bnot(328255484352167823). +41031935544020977 = 328255484352167823 bsl -3. +2626043874817342584 = 328255484352167823 bsr -3. +-77397692958105440346617 = -77397692957873165781294 + -232274565323. +-77397692957640891215971 = -77397692957873165781294 - -232274565323. +17977515488793007732415981534467962 = -77397692957873165781294 * -232274565323. +77397692957873165781294 = -(-77397692957873165781294). +-77397692957873165781294 = +(-77397692957873165781294). +333216393496 = -77397692957873165781294 div -232274565323. +-92041442086 = -77397692957873165781294 rem -232274565323. +-77397692957959335696880 = -77397692957873165781294 band -232274565323. +-146104649737 = -77397692957873165781294 bor -232274565323. +77397692957813231047143 = -77397692957873165781294 bxor -232274565323. +77397692957873165781293 = bnot(-77397692957873165781294). +-2476726174651941305001408 = -77397692957873165781294 bsl 5. +-2418677904933536430666 = -77397692957873165781294 bsr 5. +558623004797590356 = -71322676152166 + 558694327473742522. +-558765650149894688 = -71322676152166 - 558694327473742522. +-39847574586461917438398376602652 = -71322676152166 * 558694327473742522. +71322676152166 = -(-71322676152166). +-71322676152166 = +(-71322676152166). +0 = -71322676152166 div 558694327473742522. +-71322676152166 = -71322676152166 rem 558694327473742522. +558623382767739034 = -71322676152166 band 558694327473742522. +-377970148678 = -71322676152166 bor 558694327473742522. +-558623760737887712 = -71322676152166 bxor 558694327473742522. +71322676152165 = bnot(-71322676152166). +-9521519476763252171233415047488689967244976902650839894022363196561548524908584988430404213853455719885438976 = -71322676152166 bsl 316. +-1 = -71322676152166 bsr 316. +41146241257 = 48132563528 + -6986322271. +55118885799 = 48132563528 - -6986322271. +-336269600535988732088 = 48132563528 * -6986322271. +-48132563528 = -(48132563528). +48132563528 = +(48132563528). +-6 = 48132563528 div -6986322271. +6214629902 = 48132563528 rem -6986322271. +43293876736 = 48132563528 band -6986322271. +-2147635479 = 48132563528 bor -6986322271. +-45441512215 = 48132563528 bxor -6986322271. +-48132563529 = bnot(48132563528). +376035652 = 48132563528 bsl -7. +6160968131584 = 48132563528 bsr -7. +-24099764783368 = -24152264348513 + 52499565145. +-24204763913658 = -24152264348513 - 52499565145. +-1267983375564019227379385 = -24152264348513 * 52499565145. +24152264348513 = -(-24152264348513). +-24152264348513 = +(-24152264348513). +-460 = -24152264348513 div 52499565145. +-2464381813 = -24152264348513 rem 52499565145. +34763753497 = -24152264348513 band 52499565145. +-24134528536865 = -24152264348513 bor 52499565145. +-24169292290362 = -24152264348513 bxor 52499565145. +24152264348512 = bnot(-24152264348513). +-1545744918304832 = -24152264348513 bsl 6. +-377379130446 = -24152264348513 bsr 6. +5539295 = 7879 + 5531416. +-5523537 = 7879 - 5531416. +43582026664 = 7879 * 5531416. +-7879 = -(7879). +7879 = +(7879). +0 = 7879 div 5531416. +7879 = 7879 rem 5531416. +1536 = 7879 band 5531416. +5537759 = 7879 bor 5531416. +5536223 = 7879 bxor 5531416. +-7880 = bnot(7879). +984 = 7879 bsl -3. +63032 = 7879 bsr -3. +58172169302819364 = 58172169262996546 + 39822818. +58172169223173728 = 58172169262996546 - 39822818. +2316579709225505585986628 = 58172169262996546 * 39822818. +-58172169262996546 = -(58172169262996546). +58172169262996546 = +(58172169262996546). +1460774806 = 58172169262996546 div 39822818. +24673238 = 58172169262996546 rem 39822818. +1836098 = 58172169262996546 band 39822818. +58172169300983266 = 58172169262996546 bor 39822818. +58172169299147168 = 58172169262996546 bxor 39822818. +-58172169262996547 = bnot(58172169262996546). +0 = 58172169262996546 bsl -583. +1841631485232425883936462493764158299079473394554733660956254705586690260117048334965703753053493372091793188222396847239863698388545793745284307475542137916335156259717659697262445460631584768 = 58172169262996546 bsr -583. +-524374052553398976132976328851 = 515975493941411182952824 + -524374568528892917544159281675. +524375084504386858955342234499 = 515975493941411182952824 - -524374568528892917544159281675. +-270564427007009890743217691173433382599028713252700200 = 515975493941411182952824 * -524374568528892917544159281675. +-515975493941411182952824 = -(515975493941411182952824). +515975493941411182952824 = +(515975493941411182952824). +0 = 515975493941411182952824 div -524374568528892917544159281675. +515975493941411182952824 = 515975493941411182952824 rem -524374568528892917544159281675. +24793884116422100140400 = 515975493941411182952824 band -524374568528892917544159281675. +-524374077347283092555076469251 = 515975493941411182952824 bor -524374568528892917544159281675. +-524374102141167208977176609651 = 515975493941411182952824 bxor -524374568528892917544159281675. +-515975493941411182952825 = bnot(515975493941411182952824). +0 = 515975493941411182952824 bsl -383. +10165234804733592749048078667408891909669893160380371407515909658118733874352020029652328005348506648156359666196339278592623350726306824192 = 515975493941411182952824 bsr -383. +65522935517544286668033 = 65522935517544323655995 + -36987962. +65522935517544360643957 = 65522935517544323655995 - -36987962. +-2423559849051379776703644132190 = 65522935517544323655995 * -36987962. +-65522935517544323655995 = -(65522935517544323655995). +65522935517544323655995 = +(65522935517544323655995). +-1771466498141863 = 65522935517544323655995 div -36987962. +24402789 = 65522935517544323655995 rem -36987962. +65522935517544288782594 = 65522935517544323655995 band -36987962. +-2114561 = 65522935517544323655995 bor -36987962. +-65522935517544290897155 = 65522935517544323655995 bxor -36987962. +-65522935517544323655996 = bnot(65522935517544323655995). +255948966865407514281 = 65522935517544323655995 bsl -8. +16773871492491346855934720 = 65522935517544323655995 bsr -8. +-5488878154392571 = -5488877264739374 + -889653197. +-5488876375086177 = -5488877264739374 - -889653197. +4883197206515999450878678 = -5488877264739374 * -889653197. +5488877264739374 = -(-5488877264739374). +-5488877264739374 = +(-5488877264739374). +6169681 = -5488877264739374 div -889653197. +-838619217 = -5488877264739374 rem -889653197. +-5488877868916718 = -5488877264739374 band -889653197. +-285475853 = -5488877264739374 bor -889653197. +5488877583440865 = -5488877264739374 bxor -889653197. +5488877264739373 = bnot(-5488877264739374). +-171527414523106 = -5488877264739374 bsl -5. +-175644072471659968 = -5488877264739374 bsr -5. +-975351984431271311365207286 = -275691 + -975351984431271311364931595. +975351984431271311364655904 = -275691 - -975351984431271311364931595. +268895763939841619101509356357145 = -275691 * -975351984431271311364931595. +275691 = -(-275691). +-275691 = +(-275691). +0 = -275691 div -975351984431271311364931595. +-275691 = -275691 rem -975351984431271311364931595. +-975351984431271311365207275 = -275691 band -975351984431271311364931595. +-11 = -275691 bor -975351984431271311364931595. +975351984431271311365207264 = -275691 bxor -975351984431271311364931595. +275690 = bnot(-275691). +-8822112 = -275691 bsl 5. +-8616 = -275691 bsr 5. +-547541251554946824913030723705 = -547541251554946824865281451454 + -47749272251. +-547541251554946824817532179203 = -547541251554946824865281451454 - -47749272251. +26144696289150433026320340423217485802954 = -547541251554946824865281451454 * -47749272251. +547541251554946824865281451454 = -(-547541251554946824865281451454). +-547541251554946824865281451454 = +(-547541251554946824865281451454). +11467007259853679081 = -547541251554946824865281451454 div -47749272251. +-2628970123 = -547541251554946824865281451454 rem -47749272251. +-547541251554946824874241800128 = -547541251554946824865281451454 band -47749272251. +-38788923577 = -547541251554946824865281451454 bor -47749272251. +547541251554946824835452876551 = -547541251554946824865281451454 bxor -47749272251. +547541251554946824865281451453 = bnot(-547541251554946824865281451454). +-68442656444368353108160181432 = -547541251554946824865281451454 bsl -3. +-4380330012439574598922251611632 = -547541251554946824865281451454 bsr -3. +-893417919092660 = -272535657287 + -893145383435373. +892872847778086 = -272535657287 - -893145383435373. +243413964127409022641013051 = -272535657287 * -893145383435373. +272535657287 = -(-272535657287). +-272535657287 = +(-272535657287). +0 = -272535657287 div -893145383435373. +-272535657287 = -272535657287 rem -893145383435373. +-893353154576239 = -272535657287 band -893145383435373. +-64764516421 = -272535657287 bor -893145383435373. +893288390059818 = -272535657287 bxor -893145383435373. +272535657286 = bnot(-272535657287). +-1 = -272535657287 bsl -257. +-63114946297853855695226119544089564744479648846237524090765976921107249191234398809227264 = -272535657287 bsr -257. +4868490155316553 = -6893813846725 + 4875383969163278. +-4882277783010003 = -6893813846725 - 4875383969163278. +-33609989514718896288790564550 = -6893813846725 * 4875383969163278. +6893813846725 = -(-6893813846725). +-6893813846725 = +(-6893813846725). +0 = -6893813846725 div 4875383969163278. +-6893813846725 = -6893813846725 rem 4875383969163278. +4873184929130506 = -6893813846725 band 4875383969163278. +-4694773813953 = -6893813846725 bor 4875383969163278. +-4877879702944459 = -6893813846725 bxor 4875383969163278. +6893813846724 = bnot(-6893813846725). +-53857920678 = -6893813846725 bsl -7. +-882408172380800 = -6893813846725 bsr -7. +88531884 = -345648 + 88877532. +-89223180 = -345648 - 88877532. +-30720341180736 = -345648 * 88877532. +345648 = -(-345648). +-345648 = +(-345648). +0 = -345648 div 88877532. +-345648 = -345648 rem 88877532. +88615376 = -345648 band 88877532. +-83492 = -345648 bor 88877532. +-88698868 = -345648 bxor 88877532. +345647 = bnot(-345648). +-1 = -345648 bsl -22. +-1449752788992 = -345648 bsr -22. +-7182728122643761525984115570 = 6713161799745 + -7182728122643768239145915315. +7182728122643774952307715060 = 6713161799745 - -7182728122643768239145915315. +-48218816050886264279813462417710758594675 = 6713161799745 * -7182728122643768239145915315. +-6713161799745 = -(6713161799745). +6713161799745 = +(6713161799745). +0 = 6713161799745 div -7182728122643768239145915315. +6713161799745 = 6713161799745 rem -7182728122643768239145915315. +34378565697 = 6713161799745 band -7182728122643768239145915315. +-7182728122643761560362681267 = 6713161799745 bor -7182728122643768239145915315. +-7182728122643761594741246964 = 6713161799745 bxor -7182728122643768239145915315. +-6713161799746 = bnot(6713161799745). +400135 = 6713161799745 bsl -24. +112628165557270609920 = 6713161799745 bsr -24. +677832337812136399 = 9225519627 + 677832328586616772. +-677832319361097145 = 9225519627 - 677832328586616772. +6253355451190946199613384044 = 9225519627 * 677832328586616772. +-9225519627 = -(9225519627). +9225519627 = +(9225519627). +0 = 9225519627 div 677832328586616772. +9225519627 = 9225519627 rem 677832328586616772. +10633728 = 9225519627 band 677832328586616772. +677832337801502671 = 9225519627 bor 677832328586616772. +677832337790868943 = 9225519627 bxor 677832328586616772. +-9225519628 = bnot(9225519627). +0 = 9225519627 bsl -73. +87132569347201742402958114422784 = 9225519627 bsr -73. +9582164918175358592318162218 = 9582164555961441837585497692 + 362213916754732664526. +9582164193747525082852833166 = 9582164555961441837585497692 - 362213916754732664526. +3470793354803167580245453739625958279418983273992 = 9582164555961441837585497692 * 362213916754732664526. +-9582164555961441837585497692 = -(9582164555961441837585497692). +9582164555961441837585497692 = +(9582164555961441837585497692). +26454435 = 9582164555961441837585497692 div 362213916754732664526. +39077955621505624882 = 9582164555961441837585497692 rem 362213916754732664526. +20910215406356022860 = 9582164555961441837585497692 band 362213916754732664526. +9582164897265143185962139358 = 9582164555961441837585497692 bor 362213916754732664526. +9582164876354927779606116498 = 9582164555961441837585497692 bxor 362213916754732664526. +-9582164555961441837585497693 = bnot(9582164555961441837585497692). +5336676852399686120194739528601269773861139218240560986439407944118521240903591147655063511501698925729523074806326316313266339822586508845390959601173850920852656732314354269052161587782993297354961379357339760459776 = 9582164555961441837585497692 bsl 627. +0 = 9582164555961441837585497692 bsr 627. +-341814826686116351943 = -4927348123992595974 + -336887478562123755969. +331960130438131159995 = -4927348123992595974 - -336887478562123755969. +1659961885489676382779337545251587868806 = -4927348123992595974 * -336887478562123755969. +4927348123992595974 = -(-4927348123992595974). +-4927348123992595974 = +(-4927348123992595974). +0 = -4927348123992595974 div -336887478562123755969. +-4927348123992595974 = -4927348123992595974 rem -336887478562123755969. +-337185055900363997126 = -4927348123992595974 band -336887478562123755969. +-4629770785752354817 = -4927348123992595974 bor -336887478562123755969. +332555285114611642309 = -4927348123992595974 bxor -336887478562123755969. +4927348123992595973 = bnot(-4927348123992595974). +-1 = -4927348123992595974 bsl -78. +-1489199592331088637185911635105985232633856 = -4927348123992595974 bsr -78. +-9392058631397766 = -9392647166833978 + 588535436212. +-9393235702270190 = -9392647166833978 - 588535436212. +-5527905697518041181213211336 = -9392647166833978 * 588535436212. +9392647166833978 = -(-9392647166833978). +-9392647166833978 = +(-9392647166833978). +-15959 = -9392647166833978 div 588535436212. +-210140326670 = -9392647166833978 rem 588535436212. +38689440388 = -9392647166833978 band 588535436212. +-9392097320838154 = -9392647166833978 bor 588535436212. +-9392136010278542 = -9392647166833978 bxor 588535436212. +9392647166833977 = bnot(-9392647166833978). +-385989066975312680106234949556957333505791913465331437801724024961539883462898484456837898372667490205649698957301760942139537259995987721900399294371093260505471227570348896124947635073654541278753777384183516606078780440576 = -9392647166833978 bsl 693. +-1 = -9392647166833978 bsr 693. +-4961296591226261882489848 = -27175 + -4961296591226261882462673. +4961296591226261882435498 = -27175 - -4961296591226261882462673. +134823234866573666655923138775 = -27175 * -4961296591226261882462673. +27175 = -(-27175). +-27175 = +(-27175). +0 = -27175 div -4961296591226261882462673. +-27175 = -27175 rem -4961296591226261882462673. +-4961296591226261882465271 = -27175 band -4961296591226261882462673. +-24577 = -27175 bor -4961296591226261882462673. +4961296591226261882440694 = -27175 bxor -4961296591226261882462673. +27174 = bnot(-27175). +-1 = -27175 bsl -622. +-472962660918743725076957086124059359565633715379637207464178301520968638110717040932839129057119628101290148783349716257736074641431341276559891019300274545920364209273300933908470558831411200 = -27175 bsr -622. +-4518784533548335134124 = 311734 + -4518784533548335445858. +4518784533548335757592 = 311734 - -4518784533548335445858. +-1408658777781156801879097772 = 311734 * -4518784533548335445858. +-311734 = -(311734). +311734 = +(311734). +0 = 311734 div -4518784533548335445858. +311734 = 311734 rem -4518784533548335445858. +311446 = 311734 band -4518784533548335445858. +-4518784533548335445570 = 311734 bor -4518784533548335445858. +-4518784533548335757016 = 311734 bxor -4518784533548335445858. +-311735 = bnot(311734). +0 = 311734 bsl -44. +5484082524369977344 = 311734 bsr -44. +21275919429780858025821 = 21275919429779874153175 + 983872646. +21275919429778890280529 = 21275919429779874153175 - 983872646. +20932795145460335980631296551050 = 21275919429779874153175 * 983872646. +-21275919429779874153175 = -(21275919429779874153175). +21275919429779874153175 = +(21275919429779874153175). +21624668107481 = 21275919429779874153175 div 983872646. +730288449 = 21275919429779874153175 rem 983872646. +8683654 = 21275919429779874153175 band 983872646. +21275919429780849342167 = 21275919429779874153175 bor 983872646. +21275919429780840658513 = 21275919429779874153175 bxor 983872646. +-21275919429779874153176 = bnot(21275919429779874153175). +0 = 21275919429779874153175 bsl -618. +23143319841309774529218182426277225740061130868854095682779067358923745953370169676763359692335210842040982434765721084951676031564401410968549003375379240299973134221202155012423338818501642607167135757107200 = 21275919429779874153175 bsr -618. +-3339502453047626442278 = 515477399815852872455 + -3854979852863479314733. +4370457252679332187188 = 515477399815852872455 - -3854979852863479314733. +-1987154990896565405463692075357393051379515 = 515477399815852872455 * -3854979852863479314733. +-515477399815852872455 = -(515477399815852872455). +515477399815852872455 = +(515477399815852872455). +0 = 515477399815852872455 div -3854979852863479314733. +515477399815852872455 = 515477399815852872455 rem -3854979852863479314733. +202997527792201105923 = 515477399815852872455 band -3854979852863479314733. +-3542499980839827548201 = 515477399815852872455 bor -3854979852863479314733. +-3745497508632028654124 = 515477399815852872455 bxor -3854979852863479314733. +-515477399815852872456 = bnot(515477399815852872455). +507242775050453558664206926574664259334949441075912623324632243027555334273558726787570601860054774624788985787370365824153046190847018043828663361852299868268568559992782257302728452053620442820422112636486933611624357943645384009909453643531871800768007627880329628193139185418240 = 515477399815852872455 bsl 867. +0 = 515477399815852872455 bsr 867. +-984265841769192217048 = -984174278811462362262 + -91562957729854786. +-984082715853732507476 = -984174278811462362262 - -91562957729854786. +90113907889624247031558125489786485932 = -984174278811462362262 * -91562957729854786. +984174278811462362262 = -(-984174278811462362262). +-984174278811462362262 = +(-984174278811462362262). +10748 = -984174278811462362262 div -91562957729854786. +-55609130983122334 = -984174278811462362262 rem -91562957729854786. +-984265476721666913750 = -984174278811462362262 band -91562957729854786. +-365047525303298 = -984174278811462362262 bor -91562957729854786. +984265111674141610452 = -984174278811462362262 bxor -91562957729854786. +984174278811462362261 = bnot(-984174278811462362262). +-144460950166215404152568275607761337046688597771011357538634752049580194971460310077327877110179810448579921881907952828108767232 = -984174278811462362262 bsl 356. +-1 = -984174278811462362262 bsr 356. +6618887092721257518 = 6594487817164322823 + 24399275556934695. +6570088541607388128 = 6594487817164322823 - 24399275556934695. +160900725407841093880781221309043985 = 6594487817164322823 * 24399275556934695. +-6594487817164322823 = -(6594487817164322823). +6594487817164322823 = +(6594487817164322823). +270 = 6594487817164322823 div 24399275556934695. +6683416791955173 = 6594487817164322823 rem 24399275556934695. +1129211462422535 = 6594487817164322823 band 24399275556934695. +6617757881258834983 = 6594487817164322823 bor 24399275556934695. +6616628669796412448 = 6594487817164322823 bxor 24399275556934695. +-6594487817164322824 = bnot(6594487817164322823). +2881758163258708472009229807991022233836603862499931168191263405427528350157214552701788026582250369607836895526645645608425613267889411032227731280317762877832901610956911686886424172368524206909418827646354584671451685390926741598329380603293086612065494790832128 = 6594487817164322823 bsl 816. +0 = 6594487817164322823 bsr 816. +9294547468162 = 55151716 + 9294492316446. +-9294437164730 = 55151716 - 9294492316446. +512607200600811921336 = 55151716 * 9294492316446. +-55151716 = -(55151716). +55151716 = +(55151716). +0 = 55151716 div 9294492316446. +55151716 = 55151716 rem 9294492316446. +38371332 = 55151716 band 9294492316446. +9294509096830 = 55151716 bor 9294492316446. +9294470725498 = 55151716 bxor 9294492316446. +-55151717 = bnot(55151716). +1764854912 = 55151716 bsl 5. +1723491 = 55151716 bsr 5. +6847874423084035 = 6763526927266637 + 84347495817398. +6679179431449239 = 6763526927266637 - 84347495817398. +570486559208481411318209550526 = 6763526927266637 * 84347495817398. +-6763526927266637 = -(6763526927266637). +6763526927266637 = +(6763526927266637). +80 = 6763526927266637 div 84347495817398. +15727261874797 = 6763526927266637 rem 84347495817398. +4552707579908 = 6763526927266637 band 84347495817398. +6843321715504127 = 6763526927266637 bor 84347495817398. +6838769007924219 = 6763526927266637 bxor 84347495817398. +-6763526927266638 = bnot(6763526927266637). +72861841021346594950469669310145622757531257645856262087320576422892113884140671863370529611731381331417851598231496342896189603706299843552141018223872279795445980361061454826487169875371327280810397754559309096395131065861144576 = 6763526927266637 bsl 711. +0 = 6763526927266637 bsr 711. +-80167305584397671 = -2243787451848889 + -77923518132548782. +75679730680699893 = -2243787451848889 - -77923518132548782. +174843812189732329080955885003198 = -2243787451848889 * -77923518132548782. +2243787451848889 = -(-2243787451848889). +-2243787451848889 = +(-2243787451848889). +0 = -2243787451848889 div -77923518132548782. +-2243787451848889 = -2243787451848889 rem -77923518132548782. +-78812679878540478 = -2243787451848889 band -77923518132548782. +-1354625705857193 = -2243787451848889 bor -77923518132548782. +77458054172683285 = -2243787451848889 bxor -77923518132548782. +2243787451848888 = bnot(-2243787451848889). +-1 = -2243787451848889 bsl -64. +-41390572880057349064804798377754624 = -2243787451848889 bsr -64. +65170746308571457407813069 = 7625473793728984683221438 + 57545272514842472724591631. +-49919798721113488041370193 = 7625473793728984683221438 - 57545272514842472724591631. +438809967514924101539814551646840646904176094585378 = 7625473793728984683221438 * 57545272514842472724591631. +-7625473793728984683221438 = -(7625473793728984683221438). +7625473793728984683221438 = +(7625473793728984683221438). +0 = 7625473793728984683221438 div 57545272514842472724591631. +7625473793728984683221438 = 7625473793728984683221438 rem 57545272514842472724591631. +7293718166728473898913806 = 7625473793728984683221438 band 57545272514842472724591631. +57877028141842983508899263 = 7625473793728984683221438 bor 57545272514842472724591631. +50583309975114509609985457 = 7625473793728984683221438 bxor 57545272514842472724591631. +-7625473793728984683221439 = bnot(7625473793728984683221438). +488030322798655019726172032 = 7625473793728984683221438 bsl 6. +119148028027015385675334 = 7625473793728984683221438 bsr 6. +455461316337253539450 = 5 + 455461316337253539445. +-455461316337253539440 = 5 - 455461316337253539445. +2277306581686267697225 = 5 * 455461316337253539445. +-5 = -(5). +5 = +(5). +0 = 5 div 455461316337253539445. +5 = 5 rem 455461316337253539445. +5 = 5 band 455461316337253539445. +455461316337253539445 = 5 bor 455461316337253539445. +455461316337253539440 = 5 bxor 455461316337253539445. +-6 = bnot(5). +640 = 5 bsl 7. +0 = 5 bsr 7. +-83155929185183823425319556194 = -973 + -83155929185183823425319555221. +83155929185183823425319554248 = -973 - -83155929185183823425319555221. +80910719097183860192835927230033 = -973 * -83155929185183823425319555221. +973 = -(-973). +-973 = +(-973). +0 = -973 div -83155929185183823425319555221. +-973 = -973 rem -83155929185183823425319555221. +-83155929185183823425319556061 = -973 band -83155929185183823425319555221. +-133 = -973 bor -83155929185183823425319555221. +83155929185183823425319555928 = -973 bxor -83155929185183823425319555221. +972 = bnot(-973). +-1 = -973 bsl -926. +-551936131267121475258832859306279466631971807943188022102838904996646980063275701698092945100692798280286467837470154868351864411893918324920836698689510334353191615202094443262570906360157660665413947103968791351892059132305975847540610225280473447712219195406678019400605653532672 = -973 bsr -926. +-47638341697598172697398233 = -47638341697598172697392918 + -5315. +-47638341697598172697387603 = -47638341697598172697392918 - -5315. +253197786122734287886643359170 = -47638341697598172697392918 * -5315. +47638341697598172697392918 = -(-47638341697598172697392918). +-47638341697598172697392918 = +(-47638341697598172697392918). +8962999378663814242218 = -47638341697598172697392918 div -5315. +-4248 = -47638341697598172697392918 rem -5315. +-47638341697598172697393112 = -47638341697598172697392918 band -5315. +-5121 = -47638341697598172697392918 bor -5315. +47638341697598172697387991 = -47638341697598172697392918 bxor -5315. +47638341697598172697392917 = bnot(-47638341697598172697392918). +-1 = -47638341697598172697392918 bsl -653. +-1780507485120814963816905410710360908621808249817282740913166131099101078121931803923807431316809972356332314045330221899193989705837846871622622680409917642160646232237830315179310472531087430300491432785096334823082950656 = -47638341697598172697392918 bsr -653. +-72339946578891567854753983517 = -519829187751 + -72339946578891567334924795766. +72339946578891566815095608015 = -519829187751 - -72339946578891567334924795766. +37604415672055934689617280357709343862266 = -519829187751 * -72339946578891567334924795766. +519829187751 = -(-519829187751). +-519829187751 = +(-519829187751). +0 = -519829187751 div -72339946578891567334924795766. +-519829187751 = -519829187751 rem -72339946578891567334924795766. +-72339946578891567442436030456 = -519829187751 band -72339946578891567334924795766. +-412317953061 = -519829187751 bor -72339946578891567334924795766. +72339946578891567030118077395 = -519829187751 bxor -72339946578891567334924795766. +519829187750 = bnot(-519829187751). +-16634534008032 = -519829187751 bsl 5. +-16244662118 = -519829187751 bsr 5. +662264339361468698253212818 = 662264339361468697367817694 + 885395124. +662264339361468696482422570 = 662264339361468697367817694 - 885395124. +586365616869725658128097420788524056 = 662264339361468697367817694 * 885395124. +-662264339361468697367817694 = -(662264339361468697367817694). +662264339361468697367817694 = +(662264339361468697367817694). +747987335156669213 = 662264339361468697367817694 div 885395124. +96700282 = 662264339361468697367817694 rem 885395124. +71568532 = 662264339361468697367817694 band 885395124. +662264339361468698181644286 = 662264339361468697367817694 bor 885395124. +662264339361468698110075754 = 662264339361468697367817694 bxor 885395124. +-662264339361468697367817695 = bnot(662264339361468697367817694). +0 = 662264339361468697367817694 bsl -99. +419759893650658802452305031968642128034251818337904361472 = 662264339361468697367817694 bsr -99. +5551635323614192491 = 5551635323614192528 + -37. +5551635323614192565 = 5551635323614192528 - -37. +-205410506973725123536 = 5551635323614192528 * -37. +-5551635323614192528 = -(5551635323614192528). +5551635323614192528 = +(5551635323614192528). +-150044197935518716 = 5551635323614192528 div -37. +36 = 5551635323614192528 rem -37. +5551635323614192528 = 5551635323614192528 band -37. +-37 = 5551635323614192528 bor -37. +-5551635323614192565 = 5551635323614192528 bxor -37. +-5551635323614192529 = bnot(5551635323614192528). +173488603862943516 = 5551635323614192528 bsl -5. +177652330355654160896 = 5551635323614192528 bsr -5. +-7922868694817488596 = -7922868694817488664 + 68. +-7922868694817488732 = -7922868694817488664 - 68. +-538755071247589229152 = -7922868694817488664 * 68. +7922868694817488664 = -(-7922868694817488664). +-7922868694817488664 = +(-7922868694817488664). +-116512774923786598 = -7922868694817488664 div 68. +0 = -7922868694817488664 rem 68. +64 = -7922868694817488664 band 68. +-7922868694817488660 = -7922868694817488664 bor 68. +-7922868694817488724 = -7922868694817488664 bxor 68. +7922868694817488663 = bnot(-7922868694817488664). +-1 = -7922868694817488664 bsl -779. +-25191213038852209044292937828015099025257271256952343863342072868140826251837776329735427118358786135914611789331358205206094825046490733380868271669321943129071304927884001954104300135133945628429755034568960848769397911798990400314322641925013799698432 = -7922868694817488664 bsr -779. +-3439612141528135279856463 = -563955965296 + -3439612141527571323891167. +3439612141527007367925871 = -563955965296 - -3439612141527571323891167. +1939789785519023253963531752332940432 = -563955965296 * -3439612141527571323891167. +563955965296 = -(-563955965296). +-563955965296 = +(-563955965296). +0 = -563955965296 div -3439612141527571323891167. +-563955965296 = -563955965296 rem -3439612141527571323891167. +-3439612141528129776598528 = -563955965296 band -3439612141527571323891167. +-5503257935 = -563955965296 bor -3439612141527571323891167. +3439612141528124273340593 = -563955965296 bxor -3439612141527571323891167. +563955965295 = bnot(-563955965296). +-541940339221058495495078070836423910083159626032191856894560088569230104128272088057519676587986666583808881852814217227628213601444998530249842725234595206451724231979262967335650884326365777356470287467946345934412644176179721180848261386551415577421540255883551834112 = -563955965296 bsl 857. +-1 = -563955965296 bsr 857. +74846914192869903940589 = 74846914187975425696327 + 4894478244262. +74846914183080947452065 = 74846914187975425696327 - 4894478244262. +366336593143190538994560613742225674 = 74846914187975425696327 * 4894478244262. +-74846914187975425696327 = -(74846914187975425696327). +74846914187975425696327 = +(74846914187975425696327). +15292112959 = 74846914187975425696327 div 4894478244262. +1352928105069 = 74846914187975425696327 rem 4894478244262. +27394054 = 74846914187975425696327 band 4894478244262. +74846914192869876546535 = 74846914187975425696327 bor 4894478244262. +74846914192869849152481 = 74846914187975425696327 bxor 4894478244262. +-74846914187975425696328 = bnot(74846914187975425696327). +9355864273496928212040 = 74846914187975425696327 bsl -3. +598775313503803405570616 = 74846914187975425696327 bsr -3. +27729278293582772620091 = 4568124133468954 + 27729273725458639151137. +-27729269157334505682183 = 4568124133468954 - 27729273725458639151137. +126670764508834179830296294753703300698 = 4568124133468954 * 27729273725458639151137. +-4568124133468954 = -(4568124133468954). +4568124133468954 = +(4568124133468954). +0 = 4568124133468954 div 27729273725458639151137. +4568124133468954 = 4568124133468954 rem 27729273725458639151137. +4521193025757184 = 4568124133468954 band 27729273725458639151137. +27729273772389746862907 = 4568124133468954 bor 27729273725458639151137. +27729269251196721105723 = 4568124133468954 bxor 27729273725458639151137. +-4568124133468955 = bnot(4568124133468954). +2338879556336104448 = 4568124133468954 bsl 9. +8922117448181 = 4568124133468954 bsr 9. +613853613779 = -9 + 613853613788. +-613853613797 = -9 - 613853613788. +-5524682524092 = -9 * 613853613788. +9 = -(-9). +-9 = +(-9). +0 = -9 div 613853613788. +-9 = -9 rem 613853613788. +613853613780 = -9 band 613853613788. +-1 = -9 bor 613853613788. +-613853613781 = -9 bxor 613853613788. +8 = bnot(-9). +-2 = -9 bsl -3. +-72 = -9 bsr -3. +-751857743733561031471334097 = -751857796426246214427919613 + 52692685182956585516. +-751857849118931397384505129 = -751857796426246214427919613 - 52692685182956585516. +-39617406169439652737022658089983852693808125308 = -751857796426246214427919613 * 52692685182956585516. +751857796426246214427919613 = -(-751857796426246214427919613). +-751857796426246214427919613 = +(-751857796426246214427919613). +-14268731 = -751857796426246214427919613 div 52692685182956585516. +-45882952911021619417 = -751857796426246214427919613 rem 52692685182956585516. +37686689255231390208 = -751857796426246214427919613 band 52692685182956585516. +-751857781420250286702724305 = -751857796426246214427919613 bor 52692685182956585516. +-751857819106939541934114513 = -751857796426246214427919613 bxor 52692685182956585516. +751857796426246214427919612 = bnot(-751857796426246214427919613). +-1 = -751857796426246214427919613 bsl -515. +-80646119400903926685731137644641022840104071743500325701578097649871103598441439752640723378625217462686403820548821827652110516083907867978512175536328261507327541587791080046198784 = -751857796426246214427919613 bsr -515. +96996894948146060580 = -345647483986177414 + 97342542432132237994. +-97688189916118415408 = -345647483986177414 - 97342542432132237994. +-33646204876484223153688510072955467516 = -345647483986177414 * 97342542432132237994. +345647483986177414 = -(-345647483986177414). +-345647483986177414 = +(-345647483986177414). +0 = -345647483986177414 div 97342542432132237994. +-345647483986177414 = -345647483986177414 rem 97342542432132237994. +96999656947326190122 = -345647483986177414 band 97342542432132237994. +-2761999180129542 = -345647483986177414 bor 97342542432132237994. +-97002418946506319664 = -345647483986177414 bxor 97342542432132237994. +345647483986177413 = bnot(-345647483986177414). +-675092742160503 = -345647483986177414 bsl -9. +-176971511800922835968 = -345647483986177414 bsr -9. +-569275717333336783105837 = -36525449459652 + -569275717296811333646185. +569275717260285884186533 = -36525449459652 - -569275717296811333646185. +20793051440731822236629637395201227620 = -36525449459652 * -569275717296811333646185. +36525449459652 = -(-36525449459652). +-36525449459652 = +(-36525449459652). +0 = -36525449459652 div -569275717296811333646185. +-36525449459652 = -36525449459652 rem -569275717296811333646185. +-569275717332064800602092 = -36525449459652 band -569275717296811333646185. +-1271982503745 = -36525449459652 bor -569275717296811333646185. +569275717330792818098347 = -36525449459652 bxor -569275717296811333646185. +36525449459651 = bnot(-36525449459652). +-1 = -36525449459652 bsl -71. +-86243279150004899242472755634896896 = -36525449459652 bsr -71. +-613417895681019799187662 = 952595656291 + -613417895681972394843953. +613417895682924990500244 = 952595656291 - -613417895681972394843953. +-584339222917812668483720392567758323 = 952595656291 * -613417895681972394843953. +-952595656291 = -(952595656291). +952595656291 = +(952595656291). +0 = 952595656291 div -613417895681972394843953. +952595656291 = 952595656291 rem -613417895681972394843953. +601431744579 = 952595656291 band -613417895681972394843953. +-613417895681621230932241 = 952595656291 bor -613417895681972394843953. +-613417895682222662676820 = 952595656291 bxor -613417895681972394843953. +-952595656292 = bnot(952595656291). +0 = 952595656291 bsl -58. +274567004333241643758732181504 = 952595656291 bsr -58. +-813328478207627017348061145252 = -813328514393849498522623473498 + 36186222481174562328246. +-813328550580071979697185801744 = -813328514393849498522623473498 - 36186222481174562328246. +-29431286572139025330671384515676263999375822557824508 = -813328514393849498522623473498 * 36186222481174562328246. +813328514393849498522623473498 = -(-813328514393849498522623473498). +-813328514393849498522623473498 = +(-813328514393849498522623473498). +-22476192 = -813328514393849498522623473498 div 36186222481174562328246. +-30152253650116999354266 = -813328514393849498522623473498 rem 36186222481174562328246. +16549625396562181163174 = -813328514393849498522623473498 band 36186222481174562328246. +-813328494757252413910242308426 = -813328514393849498522623473498 bor 36186222481174562328246. +-813328511306877810472423471600 = -813328514393849498522623473498 bxor 36186222481174562328246. +813328514393849498522623473497 = bnot(-813328514393849498522623473498). +-13972877480903395438802672539183330885632 = -813328514393849498522623473498 bsl 34. +-47341950377091386968 = -813328514393849498522623473498 bsr 34. +-246978517966895 = 419452542 + -246978937419437. +246979356871979 = 419452542 - -246978937419437. +-103595943121041769858854 = 419452542 * -246978937419437. +-419452542 = -(419452542). +419452542 = +(419452542). +0 = 419452542 div -246978937419437. +419452542 = 419452542 rem -246978937419437. +402653266 = 419452542 band -246978937419437. +-246978920620161 = 419452542 bor -246978937419437. +-246979323273427 = 419452542 bxor -246978937419437. +-419452543 = bnot(419452542). +870262426717854295966065008483023523861908222876206258988889127949838197693295466809932634868090555026014842069068940974580873883527751424812991148802465193116752608480453708173520085712896 = 419452542 bsl 599. +0 = 419452542 bsr 599. +7346833259 = 7356131752 + -9298493. +7365430245 = 7356131752 - -9298493. +-68400939603049736 = 7356131752 * -9298493. +-7356131752 = -(7356131752). +7356131752 = +(7356131752). +-791 = 7356131752 div -9298493. +1023789 = 7356131752 rem -9298493. +7355763072 = 7356131752 band -9298493. +-8929813 = 7356131752 bor -9298493. +-7364692885 = 7356131752 bxor -9298493. +-7356131753 = bnot(7356131752). +0 = 7356131752 bsl -99. +4662502415390368373544927386193285349376 = 7356131752 bsr -99. +87759834593295 = 87759834951214 + -357919. +87759835309133 = 87759834951214 - -357919. +-31410912365903563666 = 87759834951214 * -357919. +-87759834951214 = -(87759834951214). +87759834951214 = +(87759834951214). +-245194680 = 87759834951214 div -357919. +280294 = 87759834951214 rem -357919. +87759834875936 = 87759834951214 band -357919. +-282641 = 87759834951214 bor -357919. +-87759835158577 = 87759834951214 bxor -357919. +-87759834951215 = bnot(87759834951214). +26523782599410241230670220080936124416 = 87759834951214 bsl 78. +0 = 87759834951214 bsr 78. +-2886281968227901 = 657 + -2886281968228558. +2886281968229215 = 657 - -2886281968228558. +-1896287253126162606 = 657 * -2886281968228558. +-657 = -(657). +657 = +(657). +0 = 657 div -2886281968228558. +657 = 657 rem -2886281968228558. +528 = 657 band -2886281968228558. +-2886281968228429 = 657 bor -2886281968228558. +-2886281968228957 = 657 bxor -2886281968228558. +-658 = bnot(657). +0 = 657 bsl -647. +383683006179556129106847967352971699258220944545574895921987773985257444461580933495601243780545665235784703665900995277199677312248788833901055806343359324375239744135000841242169388071170391146496 = 657 bsr -647. +-386217743711406946466 = 58569695 + -386217743711465516161. +386217743711524085856 = 58569695 - -386217743711465516161. +-22620655452768703284567340895 = 58569695 * -386217743711465516161. +-58569695 = -(58569695). +58569695 = +(58569695). +0 = 58569695 div -386217743711465516161. +58569695 = 58569695 rem -386217743711465516161. +20812639 = 58569695 band -386217743711465516161. +-386217743711427759105 = 58569695 bor -386217743711465516161. +-386217743711448571744 = 58569695 bxor -386217743711465516161. +-58569696 = bnot(58569695). +0 = 58569695 bsl -75. +2212700516639182759395076341760 = 58569695 bsr -75. +935526528909122527908635 = -77259628266821 + 935526528986382156175456. +-935526529063641784442277 = -77259628266821 - 935526528986382156175456. +-72278431863237226442629106583259345376 = -77259628266821 * 935526528986382156175456. +77259628266821 = -(-77259628266821). +-77259628266821 = +(-77259628266821). +0 = -77259628266821 div 935526528986382156175456. +-77259628266821 = -77259628266821 rem 935526528986382156175456. +935526528916011801384992 = -77259628266821 band 935526528986382156175456. +-6889273476357 = -77259628266821 bor 935526528986382156175456. +-935526528922901074861349 = -77259628266821 bxor 935526528986382156175456. +77259628266820 = bnot(-77259628266821). +-3060569192057672483181072812828412690300928 = -77259628266821 bsl 95. +-1 = -77259628266821 bsr 95. +-6590 = 91 + -6681. +6772 = 91 - -6681. +-607971 = 91 * -6681. +-91 = -(91). +91 = +(91). +0 = 91 div -6681. +91 = 91 rem -6681. +67 = 91 band -6681. +-6657 = 91 bor -6681. +-6724 = 91 bxor -6681. +-92 = bnot(91). +0 = 91 bsl -834. +10424561026324885878408437351857641210622713058670117520716687691641227297948457114001683472760164728656286861355715898107080457315574709118961989479129506981866686248104433205225115659178348274553194562996355270081238721512852480435990598506756643487744 = 91 bsr -834. +-996686702714 = -996686696237 + -6477. +-996686689760 = -996686696237 - -6477. +6455539731527049 = -996686696237 * -6477. +996686696237 = -(-996686696237). +-996686696237 = +(-996686696237). +153880916 = -996686696237 div -6477. +-3305 = -996686696237 rem -6477. +-996686700397 = -996686696237 band -6477. +-2317 = -996686696237 bor -6477. +996686698080 = -996686696237 bxor -6477. +996686696236 = bnot(-996686696237). +-470182267614744941834464066213763821417723793602057510484725260491419503503826402776606703887379095487930410700653614976462478299254219106840621721874843375463342071648306975473664 = -996686696237 bsl 557. +-1 = -996686696237 bsr 557. +23987 = -72861 + 96848. +-169709 = -72861 - 96848. +-7056442128 = -72861 * 96848. +72861 = -(-72861). +-72861 = +(-72861). +0 = -72861 div 96848. +-72861 = -72861 rem 96848. +25152 = -72861 band 96848. +-1165 = -72861 bor 96848. +-26317 = -72861 bxor 96848. +72860 = bnot(-72861). +-11483478293901992599543452562946255381807659531941531638693522422906990135972233049433019414388679354019246888006979682304 = -72861 bsl 386. +-1 = -72861 bsr 386. +69291931734315477708 = 69291931734273229525 + 42248183. +69291931734230981342 = 69291931734273229525 - 42248183. +2927458212333082772973203075 = 69291931734273229525 * 42248183. +-69291931734273229525 = -(69291931734273229525). +69291931734273229525 = +(69291931734273229525). +1640116256225 = 69291931734273229525 div 42248183. +4540350 = 69291931734273229525 rem 42248183. +8389333 = 69291931734273229525 band 42248183. +69291931734307088375 = 69291931734273229525 bor 42248183. +69291931734298699042 = 69291931734273229525 bxor 42248183. +-69291931734273229526 = bnot(69291931734273229525). +277167726937092918100 = 69291931734273229525 bsl 2. +17322982933568307381 = 69291931734273229525 bsr 2. +-2832927225825495987764600788 = 53892974 + -2832927225825495987818493762. +2832927225825495987872386736 = 53892974 - -2832927225825495987818493762. +-152674873325305583808606401034628188 = 53892974 * -2832927225825495987818493762. +-53892974 = -(53892974). +53892974 = +(53892974). +0 = 53892974 div -2832927225825495987818493762. +53892974 = 53892974 rem -2832927225825495987818493762. +33816622 = 53892974 band -2832927225825495987818493762. +-2832927225825495987798417410 = 53892974 bor -2832927225825495987818493762. +-2832927225825495987832234032 = 53892974 bxor -2832927225825495987818493762. +-53892975 = bnot(53892974). +0 = 53892974 bsl -954. +8206311791222122719336074185028366232549318925851085049614006002078274316481391281454698884993554155752540906133304458402903004243858966440184097786445439478278285019852093783289495160356162789520040176852907588015026362705746248987255627889422108774672178028038905455213511938638920115516604416 = 53892974 bsr -954. +-68611845705004 = -286215 + -68611845418789. +68611845132574 = -286215 - -68611845418789. +19637739336538693635 = -286215 * -68611845418789. +286215 = -(-286215). +-286215 = +(-286215). +0 = -286215 div -68611845418789. +-286215 = -286215 rem -68611845418789. +-68611845422887 = -286215 band -68611845418789. +-282117 = -286215 bor -68611845418789. +68611845140770 = -286215 bxor -68611845418789. +286214 = bnot(-286215). +-436275029945650252199650317932251510839763192091237655245680473241785045032372664532584673480623708264409113813922556919931954276878660438935470080 = -286215 bsl 469. +-1 = -286215 bsr 469. +-512732740390153 = 49352993 + -512732789743146. +512732839096139 = 49352993 - -512732789743146. +-25304897783063956335978 = 49352993 * -512732789743146. +-49352993 = -(49352993). +49352993 = +(49352993). +0 = 49352993 div -512732789743146. +49352993 = 49352993 rem -512732789743146. +3211520 = 49352993 band -512732789743146. +-512732743601673 = 49352993 bor -512732789743146. +-512732746813193 = 49352993 bxor -512732789743146. +-49352994 = bnot(49352993). +0 = 49352993 bsl -74. +932251679890000880576088768512 = 49352993 bsr -74. +531482923494787 = 531448591528994 + 34331965793. +531414259563201 = 531448591528994 - 34331965793. +18245674865111451575702242 = 531448591528994 * 34331965793. +-531448591528994 = -(531448591528994). +531448591528994 = +(531448591528994). +15479 = 531448591528994 div 34331965793. +24093019147 = 531448591528994 rem 34331965793. +6509572128 = 531448591528994 band 34331965793. +531476413922659 = 531448591528994 bor 34331965793. +531469904350531 = 531448591528994 bxor 34331965793. +-531448591528995 = bnot(531448591528994). +1037985530330 = 531448591528994 bsl -9. +272101678862844928 = 531448591528994 bsr -9. +-8489992563173627951104 = -8489992562348759397818 + -824868553286. +-8489992561523890844532 = -8489992562348759397818 - -824868553286. +7003127882313521318655030205129948 = -8489992562348759397818 * -824868553286. +8489992562348759397818 = -(-8489992562348759397818). +-8489992562348759397818 = +(-8489992562348759397818). +10292539979 = -8489992562348759397818 div -824868553286. +-232712576824 = -8489992562348759397818 rem -824868553286. +-8489992562623733790718 = -8489992562348759397818 band -824868553286. +-549894160386 = -8489992562348759397818 bor -824868553286. +8489992562073839630332 = -8489992562348759397818 bxor -824868553286. +8489992562348759397817 = bnot(-8489992562348759397818). +-120650051 = -8489992562348759397818 bsl -46. +-597430114690189927379778990245937152 = -8489992562348759397818 bsr -46. +57476985649093700 = -5453973 + 57476985654547673. +-57476985660001646 = -5453973 - 57476985654547673. +-313477927881290335754829 = -5453973 * 57476985654547673. +5453973 = -(-5453973). +-5453973 = +(-5453973). +0 = -5453973 div 57476985654547673. +-5453973 = -5453973 rem 57476985654547673. +57476985653298249 = -5453973 band 57476985654547673. +-4204549 = -5453973 bor 57476985654547673. +-57476985657502798 = -5453973 bxor 57476985654547673. +5453972 = bnot(-5453973). +-1 = -5453973 bsl -258. +-2526107713255652489211518863283154459432889832307270655903890391297559981606842662912 = -5453973 bsr -258. +-25599391846587506442715334 = -25599391855744375581629931 + 9156869138914597. +-25599391864901244720544528 = -25599391855744375581629931 - 9156869138914597. +-234410281258847347773596153584801468002807 = -25599391855744375581629931 * 9156869138914597. +25599391855744375581629931 = -(-25599391855744375581629931). +-25599391855744375581629931 = +(-25599391855744375581629931). +-2795648978 = -25599391855744375581629931 div 9156869138914597. +-5858042449298065 = -25599391855744375581629931 rem 9156869138914597. +8867702833157 = -25599391855744375581629931 band 9156869138914597. +-25599391846596374145548491 = -25599391855744375581629931 bor 9156869138914597. +-25599391846605241848381648 = -25599391855744375581629931 bxor 9156869138914597. +25599391855744375581629930 = bnot(-25599391855744375581629931). +-3276722157535280074448631168 = -25599391855744375581629931 bsl 7. +-199995248873002934231484 = -25599391855744375581629931 bsr 7. +-6847695562908190 = -6847695562916685 + 8495. +-6847695562925180 = -6847695562916685 - 8495. +-58171173806977239075 = -6847695562916685 * 8495. +6847695562916685 = -(-6847695562916685). +-6847695562916685 = +(-6847695562916685). +-806085410584 = -6847695562916685 div 8495. +-5605 = -6847695562916685 rem 8495. +8227 = -6847695562916685 band 8495. +-6847695562916417 = -6847695562916685 bor 8495. +-6847695562924644 = -6847695562916685 bxor 8495. +6847695562916684 = bnot(-6847695562916685). +-6738305309360558911484947669955640850019842627085458412460504846319924825267906933730937584276189428450798629439606252598836059693897767836404630423790207590427281228188700926861329466744518920219435577244877120735671164418722952535662164634929364198997228429265378305827143680 = -6847695562916685 bsl 867. +-1 = -6847695562916685 bsr 867. +-78957516664711610812330364 = 4787424172 + -78957516664711615599754536. +78957516664711620387178708 = 4787424172 - -78957516664711615599754536. +-378003123841733207931437142913044192 = 4787424172 * -78957516664711615599754536. +-4787424172 = -(4787424172). +4787424172 = +(4787424172). +0 = 4787424172 div -78957516664711615599754536. +4787424172 = 4787424172 rem -78957516664711615599754536. +4299702920 = 4787424172 band -78957516664711615599754536. +-78957516664711615112033284 = 4787424172 bor -78957516664711615599754536. +-78957516664711619411736204 = 4787424172 bxor -78957516664711615599754536. +-4787424173 = bnot(4787424172). +598428021 = 4787424172 bsl -3. +38299393376 = 4787424172 bsr -3. +-68926612091105 = -72337987637636 + 3411375546531. +-75749363184167 = -72337987637636 - 3411375546531. +-246772042112293231084840716 = -72337987637636 * 3411375546531. +72337987637636 = -(-72337987637636). +-72337987637636 = +(-72337987637636). +-21 = -72337987637636 div 3411375546531. +-699101160485 = -72337987637636 rem 3411375546531. +2268914081824 = -72337987637636 band 3411375546531. +-71195526172929 = -72337987637636 bor 3411375546531. +-73464440254753 = -72337987637636 bxor 3411375546531. +72337987637635 = bnot(-72337987637636). +-5337601379034546763031602584879104 = -72337987637636 bsl 66. +-1 = -72337987637636 bsr 66. +366997256288629962285709 = 366997256282391586138967 + 6238376146742. +366997256276153209992225 = 366997256282391586138967 - 6238376146742. +2289466929511832274961970530796295514 = 366997256282391586138967 * 6238376146742. +-366997256282391586138967 = -(366997256282391586138967). +366997256282391586138967 = +(366997256282391586138967). +58828972099 = 366997256282391586138967 div 6238376146742. +2639338387509 = 366997256282391586138967 rem 6238376146742. +35972555542 = 366997256282391586138967 band 6238376146742. +366997256288593989730167 = 366997256282391586138967 bor 6238376146742. +366997256288558017174625 = 366997256282391586138967 bxor 6238376146742. +-366997256282391586138968 = bnot(366997256282391586138967). +62107066059550596845185833471899010129125068295383964890558683963063224157463976245047477053513779620293728948896445559395991275930251116411787149312 = 366997256282391586138967 bsl 416. +0 = 366997256282391586138967 bsr 416. +-907849704 = -832371363 + -75478341. +-756893022 = -832371363 - -75478341. +62826009575148783 = -832371363 * -75478341. +832371363 = -(-832371363). +-832371363 = +(-832371363). +11 = -832371363 div -75478341. +-2109612 = -832371363 rem -75478341. +-905969639 = -832371363 band -75478341. +-1880065 = -832371363 bor -75478341. +904089574 = -832371363 bxor -75478341. +832371362 = bnot(-832371363). +-67168464082180747975884535694311826060656310067695512550203247399763807063777091066513318216137651486880217824718100934881705984 = -832371363 bsl 395. +-1 = -832371363 bsr 395. +33349 = 33351 + -2. +33353 = 33351 - -2. +-66702 = 33351 * -2. +-33351 = -(33351). +33351 = +(33351). +-16675 = 33351 div -2. +1 = 33351 rem -2. +33350 = 33351 band -2. +-1 = 33351 bor -2. +-33351 = 33351 bxor -2. +-33352 = bnot(33351). +1067232 = 33351 bsl 5. +1042 = 33351 bsr 5. +-489348 = 377 + -489725. +490102 = 377 - -489725. +-184626325 = 377 * -489725. +-377 = -(377). +377 = +(377). +0 = 377 div -489725. +377 = 377 rem -489725. +257 = 377 band -489725. +-489605 = 377 bor -489725. +-489862 = 377 bxor -489725. +-378 = bnot(377). +23 = 377 bsl -4. +6032 = 377 bsr -4. +49559794142498886273111105 = -8485389 + 49559794142498886281596494. +-49559794142498886290081883 = -8485389 - 49559794142498886281596494. +-420534132059024482166109792626166 = -8485389 * 49559794142498886281596494. +8485389 = -(-8485389). +-8485389 = +(-8485389). +0 = -8485389 div 49559794142498886281596494. +-8485389 = -8485389 rem 49559794142498886281596494. +49559794142498886281593922 = -8485389 band 49559794142498886281596494. +-8482817 = -8485389 bor 49559794142498886281596494. +-49559794142498886290076739 = -8485389 bxor 49559794142498886281596494. +8485388 = bnot(-8485389). +-16574 = -8485389 bsl -9. +-4344519168 = -8485389 bsr -9. +-2286769281656285670353 = -44554 + -2286769281656285625799. +2286769281656285581245 = -44554 - -2286769281656285625799. +101884718574914149771848646 = -44554 * -2286769281656285625799. +44554 = -(-44554). +-44554 = +(-44554). +0 = -44554 div -2286769281656285625799. +-44554 = -44554 rem -2286769281656285625799. +-2286769281656285626320 = -44554 band -2286769281656285625799. +-44033 = -44554 bor -2286769281656285625799. +2286769281656285582287 = -44554 bxor -2286769281656285625799. +44553 = bnot(-44554). +-1 = -44554 bsl -591. +-361088899718601094284300429607218738129313534045565495395325227865307315155645917099008882536697778224055407500156045627407096798855266088022640276092018629127585730603029014293512192 = -44554 bsr -591. +49523073771743412 = 54281959185659176 + -4758885413915764. +59040844599574940 = 54281959185659176 - -4758885413915764. +-258321623807404275527695677650464 = 54281959185659176 * -4758885413915764. +-54281959185659176 = -(54281959185659176). +54281959185659176 = +(54281959185659176). +-11 = 54281959185659176 div -4758885413915764. +1934219632585772 = 54281959185659176 rem -4758885413915764. +54061892131369224 = 54281959185659176 band -4758885413915764. +-4538818359625812 = 54281959185659176 bor -4758885413915764. +-58600710490995036 = 54281959185659176 bxor -4758885413915764. +-54281959185659177 = bnot(54281959185659176). +0 = 54281959185659176 bsl -78. +16405715499702717044095293200073169567744 = 54281959185659176 bsr -78. +75484079292225385591313 = 75491318149378877719244 + -7238857153492127931. +75498557006532369847175 = 75491318149378877719244 - -7238857153492127931. +-546470868412181397694378331179405548604164 = 75491318149378877719244 * -7238857153492127931. +-75491318149378877719244 = -(75491318149378877719244). +75491318149378877719244 = +(75491318149378877719244). +-10428 = 75491318149378877719244 div -7238857153492127931. +4515752762967654776 = 75491318149378877719244 rem -7238857153492127931. +75484079573734998934084 = 75491318149378877719244 band -7238857153492127931. +-281509613342771 = 75491318149378877719244 bor -7238857153492127931. +-75484079855244612276855 = 75491318149378877719244 bxor -7238857153492127931. +-75491318149378877719245 = bnot(75491318149378877719244). +38651554892481985392252928 = 75491318149378877719244 bsl 9. +147443980760505620545 = 75491318149378877719244 bsr 9. +846314546781048692419533467 = -44582885879577817 + 846314546825631578299111284. +-846314546870214464178689101 = -44582885879577817 - 846314546825631578299111284. +-37731144859353749299911077263371216220787028 = -44582885879577817 * 846314546825631578299111284. +44582885879577817 = -(-44582885879577817). +-44582885879577817 = +(-44582885879577817). +0 = -44582885879577817 div 846314546825631578299111284. +-44582885879577817 = -44582885879577817 rem 846314546825631578299111284. +846314546788968766774706980 = -44582885879577817 band 846314546825631578299111284. +-7920074355173513 = -44582885879577817 bor 846314546825631578299111284. +-846314546796888841129880493 = -44582885879577817 bxor 846314546825631578299111284. +44582885879577816 = bnot(-44582885879577817). +-1 = -44582885879577817 bsl -216. +-4695125881176098779573626983064072496921988771806705828324879944082052820250918912 = -44582885879577817 bsr -216. +-23378346714231806796 = -58913948147 + -23378346655317858649. +23378346596403910502 = -58913948147 - -23378346655317858649. +1377310702613987206250261473403 = -58913948147 * -23378346655317858649. +58913948147 = -(-58913948147). +-58913948147 = +(-58913948147). +0 = -58913948147 div -23378346655317858649. +-58913948147 = -58913948147 rem -23378346655317858649. +-23378346675274488315 = -58913948147 band -23378346655317858649. +-38957318481 = -58913948147 bor -23378346655317858649. +23378346636317169834 = -58913948147 bxor -23378346655317858649. +58913948146 = bnot(-58913948147). +-7540985362816 = -58913948147 bsl 7. +-460265220 = -58913948147 bsr 7. +-995879234083410706492793 = -84936519757496 + -995879233998474186735297. +995879233913537666977801 = -84936519757496 - -995879233998474186735297. +84586516234591384969560304166383536312 = -84936519757496 * -995879233998474186735297. +84936519757496 = -(-84936519757496). +-84936519757496 = +(-84936519757496). +0 = -84936519757496 div -995879233998474186735297. +-84936519757496 = -84936519757496 rem -995879233998474186735297. +-995879234069068735495928 = -84936519757496 band -995879233998474186735297. +-14341970996865 = -84936519757496 bor -995879233998474186735297. +995879234054726764499063 = -84936519757496 bxor -995879233998474186735297. +84936519757495 = bnot(-84936519757496). +-21234129939374 = -84936519757496 bsl -2. +-339746079029984 = -84936519757496 bsr -2. +9738893580548867195 = -42543967528973 + 9738936124516396168. +-9738978668483925141 = -42543967528973 - 9738936124516396168. +-414332982248167708124130086175464 = -42543967528973 * 9738936124516396168. +42543967528973 = -(-42543967528973). +-42543967528973 = +(-42543967528973). +0 = -42543967528973 div 9738936124516396168. +-42543967528973 = -42543967528973 rem 9738936124516396168. +9738893793318700160 = -42543967528973 band 9738936124516396168. +-212769832965 = -42543967528973 bor 9738936124516396168. +-9738894006088533125 = -42543967528973 bxor 9738936124516396168. +42543967528972 = bnot(-42543967528973). +-340351740231784 = -42543967528973 bsl 3. +-5317995941122 = -42543967528973 bsr 3. +-71223385482623257918611962250 = -71223385482623257918611962322 + 72. +-71223385482623257918611962394 = -71223385482623257918611962322 - 72. +-5128083754748874570140061287184 = -71223385482623257918611962322 * 72. +71223385482623257918611962322 = -(-71223385482623257918611962322). +-71223385482623257918611962322 = +(-71223385482623257918611962322). +-989213687258656359980721698 = -71223385482623257918611962322 div 72. +-66 = -71223385482623257918611962322 rem 72. +8 = -71223385482623257918611962322 band 72. +-71223385482623257918611962258 = -71223385482623257918611962322 bor 72. +-71223385482623257918611962266 = -71223385482623257918611962322 bxor 72. +71223385482623257918611962321 = bnot(-71223385482623257918611962322). +-176340561244792838116701740498131728651107744015770976256 = -71223385482623257918611962322 bsl 91. +-29 = -71223385482623257918611962322 bsr 91. +87477546472702745 = 87516898231171237 + -39351758468492. +87556249989639729 = 87516898231171237 - -39351758468492. +-3443943841104645261102521164604 = 87516898231171237 * -39351758468492. +-87516898231171237 = -(87516898231171237). +87516898231171237 = +(87516898231171237). +-2223 = 87516898231171237 div -39351758468492. +37939155713521 = 87516898231171237 rem -39351758468492. +87481705092876324 = 87516898231171237 band -39351758468492. +-4158620173579 = 87516898231171237 bor -39351758468492. +-87485863713049903 = 87516898231171237 bxor -39351758468492. +-87516898231171238 = bnot(87516898231171237). +0 = 87516898231171237 bsl -322. +747739840183165556231747713118623014305740385103595472270217127206668955381854797942139748885855913209911257858048 = 87516898231171237 bsr -322. +-2572165226296481 = -2572165226297448 + 967. +-2572165226298415 = -2572165226297448 - 967. +-2487283773829632216 = -2572165226297448 * 967. +2572165226297448 = -(-2572165226297448). +-2572165226297448 = +(-2572165226297448). +-2659943357081 = -2572165226297448 div 967. +-121 = -2572165226297448 rem 967. +896 = -2572165226297448 band 967. +-2572165226297377 = -2572165226297448 bor 967. +-2572165226298273 = -2572165226297448 bxor 967. +2572165226297447 = bnot(-2572165226297448). +-1 = -2572165226297448 bsl -277. +-624608171349100629421385803006244944484997667512182838365822583265372804924905146864213810642681856 = -2572165226297448 bsr -277. +-7256638636891165207778490262 = -7184166541211583221336 + -7256631452724623996195268926. +7256624268558082784612047590 = -7184166541211583221336 - -7256631452724623996195268926. +52132848884567848459087375659910565373045901005136 = -7184166541211583221336 * -7256631452724623996195268926. +7184166541211583221336 = -(-7184166541211583221336). +-7184166541211583221336 = +(-7184166541211583221336). +0 = -7184166541211583221336 div -7256631452724623996195268926. +-7184166541211583221336 = -7184166541211583221336 rem -7256631452724623996195268926. +-7256633891158678290607239040 = -7184166541211583221336 band -7256631452724623996195268926. +-4745732486917171251222 = -7184166541211583221336 bor -7256631452724623996195268926. +7256629145426191373435987818 = -7184166541211583221336 bxor -7256631452724623996195268926. +7184166541211583221335 = bnot(-7184166541211583221336). +-1 = -7184166541211583221336 bsl -351. +-32953752038621890334425178917985074997854170453384134811778334942985990684658696341917651315139497320317419007913299938092515328 = -7184166541211583221336 bsr -351. +-3462186111954578 = -67714158933844334 + 64251972821889756. +-131966131755734090 = -67714158933844334 - 64251972821889756. +-4350768299474489564409187813242504 = -67714158933844334 * 64251972821889756. +67714158933844334 = -(-67714158933844334). +-67714158933844334 = +(-67714158933844334). +-1 = -67714158933844334 div 64251972821889756. +-3462186111954578 = -67714158933844334 rem 64251972821889756. +1201027477574288 = -67714158933844334 band 64251972821889756. +-4663213589528866 = -67714158933844334 bor 64251972821889756. +-5864241067103154 = -67714158933844334 bxor 64251972821889756. +67714158933844333 = bnot(-67714158933844334). +-1 = -67714158933844334 bsl -374. +-2605540732319311553167826272165063781607477544645504809702612489304829956429336753861030327061751678134696824627057563959721721856 = -67714158933844334 bsr -374. +-9652719261564706635 = -9748574598338171976 + 95855336773465341. +-9844429935111637317 = -9748574598338171976 - 95855336773465341. +-934452901184955092352836156733483816 = -9748574598338171976 * 95855336773465341. +9748574598338171976 = -(-9748574598338171976). +-9748574598338171976 = +(-9748574598338171976). +-101 = -9748574598338171976 div 95855336773465341. +-67185584218172535 = -9748574598338171976 rem 95855336773465341. +5641634999967928 = -9748574598338171976 band 95855336773465341. +-9658360896564674563 = -9748574598338171976 bor 95855336773465341. +-9664002531564642491 = -9748574598338171976 bxor 95855336773465341. +9748574598338171975 = bnot(-9748574598338171976). +-93275643364251906664796184423084838717559727181712738294726887614128686525946534428737553711187915471796433618576288688299419188855051822432041930762382413770591440466736418794551446453706979125411803145109989230641152 = -9748574598338171976 bsl 661. +-1 = -9748574598338171976 bsr 661. +64322201122929545141550 = 64919146984647711792883 + -596945861718166651333. +65516092846365878444216 = 64919146984647711792883 - -596945861718166651333. +-38753216138758848495241667646258677771863039 = 64919146984647711792883 * -596945861718166651333. +-64919146984647711792883 = -(64919146984647711792883). +64919146984647711792883 = +(64919146984647711792883). +-108 = 64919146984647711792883 div -596945861718166651333. +448993919085713448919 = 64919146984647711792883 rem -596945861718166651333. +64323950833336603647539 = 64919146984647711792883 band -596945861718166651333. +-1749710407058505989 = 64919146984647711792883 bor -596945861718166651333. +-64325700543743662153528 = 64919146984647711792883 bxor -596945861718166651333. +-64919146984647711792884 = bnot(64919146984647711792883). +0 = 64919146984647711792883 bsl -342. +581609272502131059560435752570029234159994619290776929561934516217066618271246715576422981086520311125732738535288214055288832 = 64919146984647711792883 bsr -342. +-5251933002520669 = -5318314627357648 + 66381624836979. +-5384696252194627 = -5318314627357648 - 66381624836979. +-353038366358273161551528865392 = -5318314627357648 * 66381624836979. +5318314627357648 = -(-5318314627357648). +-5318314627357648 = +(-5318314627357648). +-80 = -5318314627357648 div 66381624836979. +-7784640399328 = -5318314627357648 rem 66381624836979. +26410307616816 = -5318314627357648 band 66381624836979. +-5278343310137485 = -5318314627357648 bor 66381624836979. +-5304753617754301 = -5318314627357648 bxor 66381624836979. +5318314627357647 = bnot(-5318314627357648). +-83098666052464 = -5318314627357648 bsl -6. +-340372136150889472 = -5318314627357648 bsr -6. +-57081174464 = 32783127 + -57113957591. +57146740718 = 32783127 - -57113957591. +-1872374125178367057 = 32783127 * -57113957591. +-32783127 = -(32783127). +32783127 = +(32783127). +0 = 32783127 div -57113957591. +32783127 = 32783127 rem -57113957591. +28584705 = 32783127 band -57113957591. +-57109759169 = 32783127 bor -57113957591. +-57138343874 = 32783127 bxor -57113957591. +-32783128 = bnot(32783127). +0 = 32783127 bsl -335. +2294557385324912875494980346220154405065163305775677015722414843609744103577089254776917819792648174080884736 = 32783127 bsr -335. +-614181602134994308355643270 = -614181598438261869879976828 + -3696732438475666442. +-614181594741529431404310386 = -614181598438261869879976828 - -3696732438475666442. +2270465038061558370394846287066022208817205976 = -614181598438261869879976828 * -3696732438475666442. +614181598438261869879976828 = -(-614181598438261869879976828). +-614181598438261869879976828 = +(-614181598438261869879976828). +166141750 = -614181598438261869879976828 div -3696732438475666442. +-1828147314789823328 = -614181598438261869879976828 rem -3696732438475666442. +-614181599683582487689394044 = -614181598438261869879976828 band -3696732438475666442. +-2451411820666249226 = -614181598438261869879976828 bor -3696732438475666442. +614181597232170667023144818 = -614181598438261869879976828 bxor -3696732438475666442. +614181598438261869879976827 = bnot(-614181598438261869879976828). +-4798293737798920858437319 = -614181598438261869879976828 bsl -7. +-78615244600097519344637033984 = -614181598438261869879976828 bsr -7. +-3462738347991127928203 = -456319 + -3462738347991127471884. +3462738347991127015565 = -456319 - -3462738347991127471884. +1580113300216963296842634996 = -456319 * -3462738347991127471884. +456319 = -(-456319). +-456319 = +(-456319). +0 = -456319 div -3462738347991127471884. +-456319 = -456319 rem -3462738347991127471884. +-3462738347991127488384 = -456319 band -3462738347991127471884. +-439819 = -456319 bor -3462738347991127471884. +3462738347991127048565 = -456319 bxor -3462738347991127471884. +456318 = bnot(-456319). +-1 = -456319 bsl -394. +-18411401283105313136299990322644412116910265901219350689865213233082371597360983704565705280678737735984373430178627553591296 = -456319 bsr -394. +7848387228643692381463657 = 7848387228643692381462858 + 799. +7848387228643692381462059 = 7848387228643692381462858 - 799. +6270861395686310212788823542 = 7848387228643692381462858 * 799. +-7848387228643692381462858 = -(7848387228643692381462858). +7848387228643692381462858 = +(7848387228643692381462858). +9822762488915760177049 = 7848387228643692381462858 div 799. +707 = 7848387228643692381462858 rem 799. +266 = 7848387228643692381462858 band 799. +7848387228643692381463391 = 7848387228643692381462858 bor 799. +7848387228643692381463125 = 7848387228643692381462858 bxor 799. +-7848387228643692381462859 = bnot(7848387228643692381462858). +13941536331 = 7848387228643692381462858 bsl -49. +4418249224797386599965305306964553629696 = 7848387228643692381462858 bsr -49. +-5549579159671479070701 = -92853964 + -5549579159671386216737. +5549579159671293362773 = -92853964 - -5549579159671386216737. +515300423507277147598993595468 = -92853964 * -5549579159671386216737. +92853964 = -(-92853964). +-92853964 = +(-92853964). +0 = -92853964 div -5549579159671386216737. +-92853964 = -92853964 rem -5549579159671386216737. +-5549579159671453376492 = -92853964 band -5549579159671386216737. +-25694209 = -92853964 bor -5549579159671386216737. +5549579159671427682283 = -92853964 bxor -5549579159671386216737. +92853963 = bnot(-92853964). +-1 = -92853964 bsl -735. +-16782136989272980093816490385033612560449506270868835380490349714294723959512373280455297308712315539869175004841888273922635762863717436251445878139037165327133779761272117074039733622046904552059825139314096655650358806553034752 = -92853964 bsr -735. +7873498039473 = 7873498115865 + -76392. +7873498192257 = 7873498115865 - -76392. +-601472268067159080 = 7873498115865 * -76392. +-7873498115865 = -(7873498115865). +7873498115865 = +(7873498115865). +-103067050 = 7873498115865 div -76392. +32265 = 7873498115865 rem -76392. +7873498105112 = 7873498115865 band -76392. +-65639 = 7873498115865 bor -76392. +-7873498170751 = 7873498115865 bxor -76392. +-7873498115866 = bnot(7873498115865). +1082125341208249400033280 = 7873498115865 bsl 37. +57 = 7873498115865 bsr 37. +-467100769590 = -628469971 + -466472299619. +465843829648 = -628469971 - -466472299619. +293163832613856241049 = -628469971 * -466472299619. +628469971 = -(-628469971). +-628469971 = +(-628469971). +0 = -628469971 div -466472299619. +-628469971 = -628469971 rem -466472299619. +-467077692659 = -628469971 band -466472299619. +-23076931 = -628469971 bor -466472299619. +467054615728 = -628469971 bxor -466472299619. +628469970 = bnot(-628469971). +-5398515943926136832 = -628469971 bsl 33. +-1 = -628469971 bsr 33. +-7456232186824215298555595 = -97 + -7456232186824215298555498. +7456232186824215298555401 = -97 - -7456232186824215298555498. +723254522121948883959883306 = -97 * -7456232186824215298555498. +97 = -(-97). +-97 = +(-97). +0 = -97 div -7456232186824215298555498. +-97 = -97 rem -7456232186824215298555498. +-7456232186824215298555498 = -97 band -7456232186824215298555498. +-97 = -97 bor -7456232186824215298555498. +7456232186824215298555401 = -97 bxor -7456232186824215298555498. +96 = bnot(-97). +-1 = -97 bsl -778. +-154208517072044817110477834630003453808555974308167240991219760833051589028432443365473490592131797361866045314684635239422610702621836283873378166455290440194900103858198979418496750291215410327603723183913469408088684692295841394720768 = -97 bsr -778. +-66178579725227678922255570214 = 45732325748 + -66178579725227678967987895962. +66178579725227679013720221710 = 45732325748 - -66178579725227678967987895962. +-3026500365534100548029990922255317829576 = 45732325748 * -66178579725227678967987895962. +-45732325748 = -(45732325748). +45732325748 = +(45732325748). +0 = 45732325748 div -66178579725227678967987895962. +45732325748 = 45732325748 rem -66178579725227678967987895962. +8590524772 = 45732325748 band -66178579725227678967987895962. +-66178579725227678930846094986 = 45732325748 bor -66178579725227678967987895962. +-66178579725227678939436619758 = 45732325748 bxor -66178579725227678967987895962. +-45732325749 = bnot(45732325748). +5716540718 = 45732325748 bsl -3. +365858605984 = 45732325748 bsr -3. +-37712225963798 = -37712225963791 + -7. +-37712225963784 = -37712225963791 - -7. +263985581746537 = -37712225963791 * -7. +37712225963791 = -(-37712225963791). +-37712225963791 = +(-37712225963791). +5387460851970 = -37712225963791 div -7. +-1 = -37712225963791 rem -7. +-37712225963791 = -37712225963791 band -7. +-7 = -37712225963791 bor -7. +37712225963784 = -37712225963791 bxor -7. +37712225963790 = bnot(-37712225963791). +-5061649286682638286848 = -37712225963791 bsl 27. +-280978 = -37712225963791 bsr 27. +-40228549198831930 = 4349648727446694 + -44578197926278624. +48927846653725318 = 4349648727446694 - -44578197926278624. +-193899501881904670273392751669056 = 4349648727446694 * -44578197926278624. +-4349648727446694 = -(4349648727446694). +4349648727446694 = +(4349648727446694). +0 = 4349648727446694 div -44578197926278624. +4349648727446694 = 4349648727446694 rem -44578197926278624. +317041655414816 = 4349648727446694 band -44578197926278624. +-40545590854246746 = 4349648727446694 bor -44578197926278624. +-40862632509661562 = 4349648727446694 bxor -44578197926278624. +-4349648727446695 = bnot(4349648727446694). +6752908344513747637690457064417473670326630538753659067616117393202915830263445258130617408615993113903675936677510161499392289297220214035812746737076986874754312746973700128193439161869643768009306177595926894863094335723318300478027259459928064 = 4349648727446694 bsl 768. +0 = 4349648727446694 bsr 768. +848583217115039357 = 848583134997193418 + 82117845939. +848583052879347479 = 848583134997193418 - 82117845939. +69683819146133168296708829502 = 848583134997193418 * 82117845939. +-848583134997193418 = -(848583134997193418). +848583134997193418 = +(848583134997193418). +10333723 = 848583134997193418 div 82117845939. +61706892521 = 848583134997193418 rem 82117845939. +73056395906 = 848583134997193418 band 82117845939. +848583144058643451 = 848583134997193418 bor 82117845939. +848583071002247545 = 848583134997193418 bxor 82117845939. +-848583134997193419 = bnot(848583134997193418). +5 = 848583134997193418 bsl -57. +122293718098119922577138408275050496 = 848583134997193418 bsr -57. +-569568392787 = -569568392782 + -5. +-569568392777 = -569568392782 - -5. +2847841963910 = -569568392782 * -5. +569568392782 = -(-569568392782). +-569568392782 = +(-569568392782). +113913678556 = -569568392782 div -5. +-2 = -569568392782 rem -5. +-569568392782 = -569568392782 band -5. +-5 = -569568392782 bor -5. +569568392777 = -569568392782 bxor -5. +569568392781 = bnot(-569568392782). +-9113094284512 = -569568392782 bsl 4. +-35598024549 = -569568392782 bsr 4. +65335161399831779703913704 = 57185822923562963328294152 + 8149338476268816375619552. +49036484447294146952674600 = 57185822923562963328294152 - 8149338476268816375619552. +466026627048086949714978241189501601930310298459904 = 57185822923562963328294152 * 8149338476268816375619552. +-57185822923562963328294152 = -(57185822923562963328294152). +57185822923562963328294152 = +(57185822923562963328294152). +7 = 57185822923562963328294152 div 8149338476268816375619552. +140453589681248698957288 = 57185822923562963328294152 rem 8149338476268816375619552. +7317611534847486666611968 = 57185822923562963328294152 band 8149338476268816375619552. +58017549864984293037301736 = 57185822923562963328294152 bor 8149338476268816375619552. +50699938330136806370689768 = 57185822923562963328294152 bxor 8149338476268816375619552. +-57185822923562963328294153 = bnot(57185822923562963328294152). +29279141336864237224086605824 = 57185822923562963328294152 bsl 9. +111691060397583912750574 = 57185822923562963328294152 bsr 9. +499824736561663365 = -2773 + 499824736561666138. +-499824736561668911 = -2773 - 499824736561666138. +-1386013994485500200674 = -2773 * 499824736561666138. +2773 = -(-2773). +-2773 = +(-2773). +0 = -2773 div 499824736561666138. +-2773 = -2773 rem 499824736561666138. +499824736561664010 = -2773 band 499824736561666138. +-645 = -2773 bor 499824736561666138. +-499824736561664655 = -2773 bxor 499824736561666138. +2772 = bnot(-2773). +-790727989541646708830748053912931740245557665662516042968506303258418127416853899548806014111441930724135945277973580717033736137023380598072164364974356246501423827000063419161238133443739516928 = -2773 bsl 636. +-1 = -2773 bsr 636. +-5636784153952403932489085934 = -5636784153952933259926817425 + 529327437731491. +-5636784153953462587364548916 = -5636784153952933259926817425 - 529327437731491. +-2983704513257376458668302178379317330030675 = -5636784153952933259926817425 * 529327437731491. +5636784153952933259926817425 = -(-5636784153952933259926817425). +-5636784153952933259926817425 = +(-5636784153952933259926817425). +-10648955168676 = -5636784153952933259926817425 div 529327437731491. +-148631224841509 = -5636784153952933259926817425 rem 529327437731491. +423630351897635 = -5636784153952933259926817425 band 529327437731491. +-5636784153952827562840983569 = -5636784153952933259926817425 bor 529327437731491. +-5636784153953251193192881204 = -5636784153952933259926817425 bxor 529327437731491. +5636784153952933259926817424 = bnot(-5636784153952933259926817425). +-3098854860267376316756012568798455398400 = -5636784153952933259926817425 bsl 39. +-10253250646115582 = -5636784153952933259926817425 bsr 39. +56279753385219477533778544977 = -94599 + 56279753385219477533778639576. +-56279753385219477533778734175 = -94599 - 56279753385219477533778639576. +-5324008390488377355217925525250024 = -94599 * 56279753385219477533778639576. +94599 = -(-94599). +-94599 = +(-94599). +0 = -94599 div 56279753385219477533778639576. +-94599 = -94599 rem 56279753385219477533778639576. +56279753385219477533778545240 = -94599 band 56279753385219477533778639576. +-263 = -94599 bor 56279753385219477533778639576. +-56279753385219477533778545503 = -94599 bxor 56279753385219477533778639576. +94598 = bnot(-94599). +-1 = -94599 bsl -222. +-637595998691445843483926240054242510523850056306978904034980106491396096 = -94599 bsr -222. +617541146396428695254820 = 9829596 + 617541146396428685425224. +-617541146396428675595628 = 9829596 - 617541146396428685425224. +6070179982453749820541040129504 = 9829596 * 617541146396428685425224. +-9829596 = -(9829596). +9829596 = +(9829596). +0 = 9829596 div 617541146396428685425224. +9829596 = 9829596 rem 617541146396428685425224. +14408 = 9829596 band 617541146396428685425224. +617541146396428695240412 = 9829596 bor 617541146396428685425224. +617541146396428695226004 = 9829596 bxor 617541146396428685425224. +-9829597 = bnot(9829596). +0 = 9829596 bsl -781. +125015045161014717203289441762288117900434356357580493144604519274682108643919458274266784431377843036784250025653017056568044245117426098854979177853711924930146744848176268478031998571177718143882247174738400267205847645084736774447973793792 = 9829596 bsr -781. +660109205356653082434571 = 8611421642786154821912 + 651497783713866927612659. +-642886362071080772790747 = 8611421642786154821912 - 651497783713866927612659. +5610322114900806920083336854208274531461784008 = 8611421642786154821912 * 651497783713866927612659. +-8611421642786154821912 = -(8611421642786154821912). +8611421642786154821912 = +(8611421642786154821912). +0 = 8611421642786154821912 div 651497783713866927612659. +8611421642786154821912 = 8611421642786154821912 rem 651497783713866927612659. +8573375208632380563472 = 8611421642786154821912 band 651497783713866927612659. +651535830148020701871099 = 8611421642786154821912 bor 651497783713866927612659. +642962454939388321307627 = 8611421642786154821912 bxor 651497783713866927612659. +-8611421642786154821913 = bnot(8611421642786154821912). +1301321245944051079661665054096505666025816064 = 8611421642786154821912 bsl 77. +0 = 8611421642786154821912 bsr 77. +377194245837736757882924482170 = 377194245837736846762764359958 + -88879839877788. +377194245837736935642604237746 = 377194245837736846762764359958 - -88879839877788. +-33524964172881053730057518754198488760812904 = 377194245837736846762764359958 * -88879839877788. +-377194245837736846762764359958 = -(377194245837736846762764359958). +377194245837736846762764359958 = +(377194245837736846762764359958). +-4243867297200223 = 377194245837736846762764359958 div -88879839877788. +88683878013234 = 377194245837736846762764359958 rem -88879839877788. +377194245837736828345893732612 = 377194245837736846762764359958 band -88879839877788. +-70462969250442 = 377194245837736846762764359958 bor -88879839877788. +-377194245837736898808862983054 = 377194245837736846762764359958 bxor -88879839877788. +-377194245837736846762764359959 = bnot(377194245837736846762764359958). +12070215866807579096408459518656 = 377194245837736846762764359958 bsl 5. +11787320182429276461336386248 = 377194245837736846762764359958 bsr 5. +-4741322768177 = -4741322797952 + 29775. +-4741322827727 = -4741322797952 - 29775. +-141172886309020800 = -4741322797952 * 29775. +4741322797952 = -(-4741322797952). +-4741322797952 = +(-4741322797952). +-159238381 = -4741322797952 div 29775. +-3677 = -4741322797952 rem 29775. +1024 = -4741322797952 band 29775. +-4741322769201 = -4741322797952 bor 29775. +-4741322770225 = -4741322797952 bxor 29775. +4741322797951 = bnot(-4741322797952). +-2427557272551424 = -4741322797952 bsl 9. +-9260396090 = -4741322797952 bsr 9. +99364986943748632704689 = 99364986943748642619248 + -9914559. +99364986943748652533807 = 99364986943748642619248 - -9914559. +-985160025588025598418448831632 = 99364986943748642619248 * -9914559. +-99364986943748642619248 = -(99364986943748642619248). +99364986943748642619248 = +(99364986943748642619248). +-10022128764753797 = 99364986943748642619248 div -9914559. +1788725 = 99364986943748642619248 rem -9914559. +99364986943748641437504 = 99364986943748642619248 band -9914559. +-8732815 = 99364986943748642619248 bor -9914559. +-99364986943748650170319 = 99364986943748642619248 bxor -9914559. +-99364986943748642619249 = bnot(99364986943748642619248). +3179679582199956563815936 = 99364986943748642619248 bsl 5. +3105155841992145081851 = 99364986943748642619248 bsr 5. +8667485381021 = 8667485389556 + -8535. +8667485398091 = 8667485389556 - -8535. +-73976987799860460 = 8667485389556 * -8535. +-8667485389556 = -(8667485389556). +8667485389556 = +(8667485389556). +-1015522599 = 8667485389556 div -8535. +7091 = 8667485389556 rem -8535. +8667485389472 = 8667485389556 band -8535. +-8451 = 8667485389556 bor -8535. +-8667485397923 = 8667485389556 bxor -8535. +-8667485389557 = bnot(8667485389556). +277359532465792 = 8667485389556 bsl 5. +270858918423 = 8667485389556 bsr 5. +6134725647932282021187 = 6134686373166524876423 + 39274765757144764. +6134647098400767731659 = 6134686373166524876423 - 39274765757144764. +240938370299663236613351775854421499172 = 6134686373166524876423 * 39274765757144764. +-6134686373166524876423 = -(6134686373166524876423). +6134686373166524876423 = +(6134686373166524876423). +156199 = 6134686373166524876423 div 39274765757144764. +7236666269884387 = 6134686373166524876423 rem 39274765757144764. +36028938685990532 = 6134686373166524876423 band 39274765757144764. +6134689618993596030655 = 6134686373166524876423 bor 39274765757144764. +6134653590054910040123 = 6134686373166524876423 bxor 39274765757144764. +-6134686373166524876424 = bnot(6134686373166524876423). +1533671593291631219105 = 6134686373166524876423 bsl -2. +24538745492666099505692 = 6134686373166524876423 bsr -2. +796190 = 796128 + 62. +796066 = 796128 - 62. +49359936 = 796128 * 62. +-796128 = -(796128). +796128 = +(796128). +12840 = 796128 div 62. +48 = 796128 rem 62. +32 = 796128 band 62. +796158 = 796128 bor 62. +796126 = 796128 bxor 62. +-796129 = bnot(796128). +458936545809819934654464 = 796128 bsl 59. +0 = 796128 bsr 59. +-4853967239688694934843182549 = -4853967239688771551186895246 + 76616343712697. +-4853967239688848167530607943 = -4853967239688771551186895246 - 76616343712697. +-371893222406166024238845641488852059138462 = -4853967239688771551186895246 * 76616343712697. +4853967239688771551186895246 = -(-4853967239688771551186895246). +-4853967239688771551186895246 = +(-4853967239688771551186895246). +-63354201002995 = -4853967239688771551186895246 div 76616343712697. +-13611670367731 = -4853967239688771551186895246 rem 76616343712697. +1142467605040 = -4853967239688771551186895246 band 76616343712697. +-4853967239688696077310787589 = -4853967239688771551186895246 bor 76616343712697. +-4853967239688697219778392629 = -4853967239688771551186895246 bxor 76616343712697. +4853967239688771551186895245 = bnot(-4853967239688771551186895246). +-1 = -4853967239688771551186895246 bsl -666. +-1486188693811800700044646223823865461549051074643879329904045362554983936403642602692697466395741062471646174962499126670468038568597407402903708616589970221885698780048932809206830445140876586892595078611386751158397833675014144 = -4853967239688771551186895246 bsr -666. +-374855932158674925467 = 797 + -374855932158674926264. +374855932158674927061 = 797 - -374855932158674926264. +-298760177930463916232408 = 797 * -374855932158674926264. +-797 = -(797). +797 = +(797). +0 = 797 div -374855932158674926264. +797 = 797 rem -374855932158674926264. +264 = 797 band -374855932158674926264. +-374855932158674925731 = 797 bor -374855932158674926264. +-374855932158674925995 = 797 bxor -374855932158674926264. +-798 = bnot(797). +13371441152 = 797 bsl 24. +0 = 797 bsr 24. +-57766182273728 = 9255 + -57766182282983. +57766182292238 = 9255 - -57766182282983. +-534626017029007665 = 9255 * -57766182282983. +-9255 = -(9255). +9255 = +(9255). +0 = 9255 div -57766182282983. +9255 = 9255 rem -57766182282983. +1 = 9255 band -57766182282983. +-57766182273729 = 9255 bor -57766182282983. +-57766182273730 = 9255 bxor -57766182282983. +-9256 = bnot(9255). +2369280 = 9255 bsl 8. +36 = 9255 bsr 8. +43583457932098704125432925625 = 43583457926631745136214938829 + 5466958989217986796. +43583457921164786146996952033 = 43583457926631745136214938829 - 5466958989217986796. +238268977093203339917214546461418761963669701884 = 43583457926631745136214938829 * 5466958989217986796. +-43583457926631745136214938829 = -(43583457926631745136214938829). +43583457926631745136214938829 = +(43583457926631745136214938829). +7972157466 = 43583457926631745136214938829 div 5466958989217986796. +4421758198994119893 = 43583457926631745136214938829 rem 5466958989217986796. +5231643519462150348 = 43583457926631745136214938829 band 5466958989217986796. +43583457926867060605970775277 = 43583457926631745136214938829 bor 5466958989217986796. +43583457921635417086508624929 = 43583457926631745136214938829 bxor 5466958989217986796. +-43583457926631745136214938830 = bnot(43583457926631745136214938829). +9909731017303726 = 43583457926631745136214938829 bsl -42. +191682075076070720302541032957128229257216 = 43583457926631745136214938829 bsr -42. +688582391845697458364529253983 = 747334547 + 688582391845697458363781919436. +-688582391845697458363034584889 = 747334547 - 688582391845697458363781919436. +514601409882180803945348321968493555492 = 747334547 * 688582391845697458363781919436. +-747334547 = -(747334547). +747334547 = +(747334547). +0 = 747334547 div 688582391845697458363781919436. +747334547 = 747334547 rem 688582391845697458363781919436. +67641984 = 747334547 band 688582391845697458363781919436. +688582391845697458364461611999 = 747334547 bor 688582391845697458363781919436. +688582391845697458364393970015 = 747334547 bxor 688582391845697458363781919436. +-747334548 = bnot(747334547). +1459637 = 747334547 bsl -9. +382635288064 = 747334547 bsr -9. +4198468694770 = 4192924421877 + 5544272893. +4187380148984 = 4192924421877 - 5544272893. +23246717214610347280161 = 4192924421877 * 5544272893. +-4192924421877 = -(4192924421877). +4192924421877 = +(4192924421877). +756 = 4192924421877 div 5544272893. +1454114769 = 4192924421877 rem 5544272893. +138691317 = 4192924421877 band 5544272893. +4198330003453 = 4192924421877 bor 5544272893. +4198191312136 = 4192924421877 bxor 5544272893. +-4192924421878 = bnot(4192924421877). +8189305511 = 4192924421877 bsl -9. +2146777304001024 = 4192924421877 bsr -9. +695779499497740362954764 = -946965296458 + 695779499498687328251222. +-695779499499634293547680 = -946965296458 - 695779499498687328251222. +-658879040012173308179266399930771676 = -946965296458 * 695779499498687328251222. +946965296458 = -(-946965296458). +-946965296458 = +(-946965296458). +0 = -946965296458 div 695779499498687328251222. +-946965296458 = -946965296458 rem 695779499498687328251222. +695779499498394708101142 = -946965296458 band 695779499498687328251222. +-654345146378 = -946965296458 bor 695779499498687328251222. +-695779499499049053247520 = -946965296458 bxor 695779499498687328251222. +946965296457 = bnot(-946965296458). +-29592665515 = -946965296458 bsl -5. +-30302889486656 = -946965296458 bsr -5. +-8749549967799272686 = -5 + -8749549967799272681. +8749549967799272676 = -5 - -8749549967799272681. +43747749838996363405 = -5 * -8749549967799272681. +5 = -(-5). +-5 = +(-5). +0 = -5 div -8749549967799272681. +-5 = -5 rem -8749549967799272681. +-8749549967799272685 = -5 band -8749549967799272681. +-1 = -5 bor -8749549967799272681. +8749549967799272684 = -5 bxor -8749549967799272681. +4 = bnot(-5). +-160 = -5 bsl 5. +-1 = -5 bsr 5. +-4442553739 = -4442554356 + 617. +-4442554973 = -4442554356 - 617. +-2741056037652 = -4442554356 * 617. +4442554356 = -(-4442554356). +-4442554356 = +(-4442554356). +-7200250 = -4442554356 div 617. +-106 = -4442554356 rem 617. +8 = -4442554356 band 617. +-4442553747 = -4442554356 bor 617. +-4442553755 = -4442554356 bxor 617. +4442554355 = bnot(-4442554356). +-71080869696 = -4442554356 bsl 4. +-277659648 = -4442554356 bsr 4. +-80761627119765 = -47577995383167 + -33183631736598. +-14394363646569 = -47577995383167 - -33183631736598. +1578810677560573582627045866 = -47577995383167 * -33183631736598. +47577995383167 = -(-47577995383167). +-47577995383167 = +(-47577995383167). +1 = -47577995383167 div -33183631736598. +-14394363646569 = -47577995383167 rem -33183631736598. +-69749188329344 = -47577995383167 band -33183631736598. +-11012438790421 = -47577995383167 bor -33183631736598. +58736749538923 = -47577995383167 bxor -33183631736598. +47577995383166 = bnot(-47577995383167). +-6504062805347175992854226195333100911915243382216748635078916338179559855776585782654748012038802701462209036288 = -47577995383167 bsl 326. +-1 = -47577995383167 bsr 326. +7153697534725 = 7153697524993 + 9732. +7153697515261 = 7153697524993 - 9732. +69619784313231876 = 7153697524993 * 9732. +-7153697524993 = -(7153697524993). +7153697524993 = +(7153697524993). +735069618 = 7153697524993 div 9732. +2617 = 7153697524993 rem 9732. +1024 = 7153697524993 band 9732. +7153697533701 = 7153697524993 bor 9732. +7153697532677 = 7153697524993 bxor 9732. +-7153697524994 = bnot(7153697524993). +697876402438937479803173358990579965085580863789430026221840561487579144890078941736343300387089227788186901649794788881497645969466145766479590030808449024 = 7153697524993 bsl 475. +0 = 7153697524993 bsr 475. + +0 = 7153697524993 bsr 475833444444444444444444444444444444444444444444. +-1 = -83987348 bsr 475833444444444444444444444444444444444444444444. + diff --git a/erts/emulator/test/big_SUITE_data/eq_math.dat b/erts/emulator/test/big_SUITE_data/eq_math.dat new file mode 100644 index 0000000000..8422328906 --- /dev/null +++ b/erts/emulator/test/big_SUITE_data/eq_math.dat @@ -0,0 +1,78 @@ +1 = fac(1). +2 = fac(2). +6 = fac(3). +24 = fac(4). +120 = fac(5). +720 = fac(6). +5040 = fac(7). +40320 = fac(8). +362880 = fac(9). +3628800 = fac(10). +39916800 = fac(11). +479001600 = fac(12). +6227020800 = fac(13). +87178291200 = fac(14). +1307674368000 = fac(15). +20922789888000 = fac(16). +355687428096000 = fac(17). +6402373705728000 = fac(18). +121645100408832000 = fac(19). +2432902008176640000 = fac(20). +265252859812191058636308480000000 = fac(30). +815915283247897734345611269596115894272000000000 = fac(40). +30414093201713378043612608166064768844377641568960512000000000000 = fac(50). +8320987112741390144276341183223364380754172606361245952449277696409600000000000000 = fac(60). +11978571669969891796072783721689098736458938142546425857555362864628009582789845319680000000000000000 = fac(70). +71569457046263802294811533723186532165584657342365752577109445058227039255480148842668944867280814080000000000000000000 = fac(80). +1485715964481761497309522733620825737885569961284688766942216863704985393094065876545992131370884059645617234469978112000000000000000000000 = fac(90). +93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000 = fac(100). +385620482362580421735677065923463640617493109590223590278828403276373402575165543560686168588507361534030051833058916347592172932262498857766114955245039357760034644709279247692495585280000000000000000000000000000000 = fac(128). +857817775342842654119082271681232625157781520279485619859655650377269452553147589377440291360451408450375885342336584306157196834693696475322289288497426025679637332563368786442675207626794560187968867971521143307702077526646451464709187326100832876325702818980773671781454170250523018608495319068138257481070252817559459476987034665712738139286205234756808218860701203611083152093501947437109101726968262861606263662435022840944191408424615936000000000000000000000000000000000000000000000000000000000000000 = fac(256). +402387260077093773543702433923003985719374864210714632543799910429938512398629020592044208486969404800479988610197196058631666872994808558901323829669944590997424504087073759918823627727188732519779505950995276120874975462497043601418278094646496291056393887437886487337119181045825783647849977012476632889835955735432513185323958463075557409114262417474349347553428646576611667797396668820291207379143853719588249808126867838374559731746136085379534524221586593201928090878297308431392844403281231558611036976801357304216168747609675871348312025478589320767169132448426236131412508780208000261683151027341827977704784635868170164365024153691398281264810213092761244896359928705114964975419909342221566832572080821333186116811553615836546984046708975602900950537616475847728421889679646244945160765353408198901385442487984959953319101723355556602139450399736280750137837615307127761926849034352625200015888535147331611702103968175921510907788019393178114194545257223865541461062892187960223838971476088506276862967146674697562911234082439208160153780889893964518263243671616762179168909779911903754031274622289988005195444414282012187361745992642956581746628302955570299024324153181617210465832036786906117260158783520751516284225540265170483304226143974286933061690897968482590125458327168226458066526769958652682272807075781391858178889652208164348344825993266043367660176999612831860788386150279465955131156552036093988180612138558600301435694527224206344631797460594682573103790084024432438465657245014402821885252470935190620929023136493273497565513958720559654228749774011413346962715422845862377387538230483865688976461927383814900140767310446640259899490222221765904339901886018566526485061799702356193897017860040811889729918311021171229845901641921068884387121855646124960798722908519296819372388642614839657382291123125024186649353143970137428531926649875337218940694281434118520158014123344828015051399694290153483077644569099073152433278288269864602789864321139083506217095002597389863554277196742822248757586765752344220207573630569498825087968928162753848863396909959826280956121450994871701244516461260379029309120889086942028510640182154399457156805941872748998094254742173582401063677404595741785160829230135358081840096996372524230560855903700624271243416909004153690105933983835777939410970027753472000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 = fac(999). +2 = 1 bsl 1. +4 = 1 bsl 2. +8 = 1 bsl 3. +16 = 1 bsl 4. +32 = 1 bsl 5. +1024 = 1 bsl 10. +1048576 = 1 bsl 20. +134217728 = 1 bsl 27. +268435456 = 1 bsl 28. +1073741824 = 1 bsl 30. +2147483648 = 1 bsl 31. +4294967296 = 1 bsl 32. +1099511627776 = 1 bsl 40. +1125899906842624 = 1 bsl 50. +1152921504606846976 = 1 bsl 60. +1180591620717411303424 = 1 bsl 70. +1208925819614629174706176 = 1 bsl 80. +1237940039285380274899124224 = 1 bsl 90. +1267650600228229401496703205376 = 1 bsl 100. +3072 = 3 bsl 10. +3145728 = 3 bsl 20. +402653184 = 3 bsl 27. +805306368 = 3 bsl 28. +3221225472 = 3 bsl 30. +6442450944 = 3 bsl 31. +12884901888 = 3 bsl 32. +3298534883328 = 3 bsl 40. +3377699720527872 = 3 bsl 50. +3458764513820540928 = 3 bsl 60. +3541774862152233910272 = 3 bsl 70. +3626777458843887524118528 = 3 bsl 80. +3713820117856140824697372672 = 3 bsl 90. +3802951800684688204490109616128 = 3 bsl 100. +5120 = 5 bsl 10. +5242880 = 5 bsl 20. +671088640 = 5 bsl 27. +1342177280 = 5 bsl 28. +5368709120 = 5 bsl 30. +10737418240 = 5 bsl 31. +21474836480 = 5 bsl 32. +5497558138880 = 5 bsl 40. +5629499534213120 = 5 bsl 50. +5764607523034234880 = 5 bsl 60. +5902958103587056517120 = 5 bsl 70. +6044629098073145873530880 = 5 bsl 80. +6189700196426901374495621120 = 5 bsl 90. +6338253001141147007483516026880 = 5 bsl 100. diff --git a/erts/emulator/test/big_SUITE_data/literal_test.erl b/erts/emulator/test/big_SUITE_data/literal_test.erl new file mode 100644 index 0000000000..dc0adeb1ca --- /dev/null +++ b/erts/emulator/test/big_SUITE_data/literal_test.erl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(literal_test). + +-export([t/0]). + +t() -> + 2639222 = do_band(-30710410, 11032439), + -104896167137483835127591520601167100453480347078199925156632915223228188306305878154109985624943277357501787279310034030156370067160844817777591157023073455111626047495778039507502639061242015835277440456218702874565483838389693116456108032 = do_bsl(-283388912239613, 746), + 899396154689163167548626101 = do_plus(899396154689163167641847368, -93221267), + ok. + +do_plus(A, B) -> + A + B. + +do_band(A, B) -> + A band B. + +do_bsl(X, S) -> + X bsl S. + diff --git a/erts/emulator/test/big_SUITE_data/negative.dat b/erts/emulator/test/big_SUITE_data/negative.dat new file mode 100644 index 0000000000..6169bd25ce --- /dev/null +++ b/erts/emulator/test/big_SUITE_data/negative.dat @@ -0,0 +1,10 @@ +%% 'bor' operations. +(-1 bsl 28) bor 0 = -1 bsl 28. +0 bor (-1 bsl 28) = -1 bsl 28. +(-1 bsl 28) bor (-1 bsl 28) = -1 bsl 28. + +%%(-1 bsl 28) bor -16#FFFFffff = -16#10000001. Not sure about the result yet. + +%% 'band' operations. +(-1 bsl 28) band 16#FFFFffffFFFF = 16#FFFFf0000000. + diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl new file mode 100644 index 0000000000..e47dfa18f7 --- /dev/null +++ b/erts/emulator/test/binary_SUITE.erl @@ -0,0 +1,1313 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(binary_SUITE). +-compile({nowarn_deprecated_function, {erlang,hash,2}}). + +%% Tests binaries and the BIFs: +%% list_to_binary/1 +%% iolist_to_binary/1 +%% bitstr_to_list/1 +%% binary_to_list/1 +%% binary_to_list/3 +%% binary_to_term/1 +%% bitstr_to_list/1 +%% term_to_binary/1 +%% erlang:external_size/1 +%% size(Binary) +%% iolist_size/1 +%% concat_binary/1 +%% split_binary/2 +%% hash(Binary, N) +%% phash(Binary, N) +%% phash2(Binary, N) +%% + +-include("test_server.hrl"). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2, + copy_terms/1, conversions/1, deep_lists/1, deep_bitstr_lists/1, + bad_list_to_binary/1, bad_binary_to_list/1, + t_split_binary/1, bad_split/1, t_concat_binary/1, + terms/1, terms_float/1, external_size/1, t_iolist_size/1, + t_hash/1, + bad_size/1, + bad_term_to_binary/1, + bad_binary_to_term_2/1, + bad_binary_to_term/1, bad_terms/1, more_bad_terms/1, + otp_5484/1,otp_5933/1, + ordering/1,unaligned_order/1,gc_test/1, + bit_sized_binary_sizes/1, + bitlevel_roundtrip/1, + otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1, + otp_8180/1]). + +%% Internal exports. +-export([sleeper/0]). + +all(suite) -> + [copy_terms,conversions,deep_lists,deep_bitstr_lists, + t_split_binary, bad_split, t_concat_binary, + bad_list_to_binary, bad_binary_to_list, terms, terms_float, + external_size, t_iolist_size, + bad_binary_to_term_2, + bad_binary_to_term, bad_terms, t_hash, bad_size, bad_term_to_binary, + more_bad_terms, otp_5484, otp_5933, ordering, unaligned_order, + gc_test, bit_sized_binary_sizes, bitlevel_roundtrip, otp_6817, otp_8117, + deep,obsolete_funs,robustness,otp_8180]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(2)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +-define(heap_binary_size, 64). + +copy_terms(Config) when is_list(Config) -> + Self = self(), + ?line Pid = spawn_link(fun() -> copy_server(Self) end), + F = fun(Term) -> + Pid ! Term, + receive + Term -> ok; + Other -> + io:format("Sent: ~P\nGot back:~P", [Term,12,Other,12]), + ?t:fail(bad_term) + end + end, + ?line test_terms(F), + ok. + +copy_server(Parent) -> + receive + Term -> + Parent ! Term, + copy_server(Parent) + end. + +%% Tests list_to_binary/1, binary_to_list/1 and size/1, +%% using flat lists. + +conversions(suite) -> []; +conversions(Config) when is_list(Config) -> + ?line test_bin([]), + ?line test_bin([1]), + ?line test_bin([1, 2]), + ?line test_bin([1, 2, 3]), + ?line test_bin(lists:seq(0, ?heap_binary_size)), + ?line test_bin(lists:seq(0, ?heap_binary_size+1)), + ?line test_bin(lists:seq(0, 255)), + ?line test_bin(lists:duplicate(50000, $@)), + + %% Binary in list. + List = [1,2,3,4,5], + ?line B1 = make_sub_binary(list_to_binary(List)), + ?line 5 = size(B1), + ?line 5 = size(make_unaligned_sub_binary(B1)), + ?line 40 = bit_size(B1), + ?line 40 = bit_size(make_unaligned_sub_binary(B1)), + ?line B2 = list_to_binary([42,B1,19]), + ?line B2 = list_to_binary([42,make_unaligned_sub_binary(B1),19]), + ?line B2 = iolist_to_binary(B2), + ?line B2 = iolist_to_binary(make_unaligned_sub_binary(B2)), + ?line 7 = size(B2), + ?line 7 = size(make_sub_binary(B2)), + ?line 56 = bit_size(B2), + ?line 56 = bit_size(make_sub_binary(B2)), + ?line [42,1,2,3,4,5,19] = binary_to_list(B2), + ?line [42,1,2,3,4,5,19] = binary_to_list(make_sub_binary(B2)), + ?line [42,1,2,3,4,5,19] = binary_to_list(make_unaligned_sub_binary(B2)), + ?line [42,1,2,3,4,5,19] = bitstring_to_list(B2), + ?line [42,1,2,3,4,5,19] = bitstring_to_list(make_sub_binary(B2)), + ?line [42,1,2,3,4,5,19] = bitstring_to_list(make_unaligned_sub_binary(B2)), + + ok. + +test_bin(List) -> + ?line Size = length(List), + ?line Bin = list_to_binary(List), + ?line Bin = iolist_to_binary(List), + ?line Bin = list_to_bitstring(List), + ?line Size = iolist_size(List), + ?line Size = iolist_size(Bin), + ?line Size = iolist_size(make_unaligned_sub_binary(Bin)), + ?line Size = size(Bin), + ?line Size = size(make_sub_binary(Bin)), + ?line Size = size(make_unaligned_sub_binary(Bin)), + ?line List = binary_to_list(Bin), + ?line List = binary_to_list(make_sub_binary(Bin)), + ?line List = binary_to_list(make_unaligned_sub_binary(Bin)), + ?line List = bitstring_to_list(Bin), + ?line List = bitstring_to_list(make_unaligned_sub_binary(Bin)). + +%% Tests list_to_binary/1, iolist_to_binary/1, list_to_bitstr/1, binary_to_list/1,3, +%% bitstr_to_list/1, and size/1, using deep lists. + +deep_lists(Config) when is_list(Config) -> + ?line test_deep_list(["abc"]), + ?line test_deep_list([[12,13,[123,15]]]), + ?line test_deep_list([[12,13,[lists:seq(0, 255), []]]]), + ok. + +test_deep_list(List) -> + ?line FlatList = lists:flatten(List), + ?line Size = length(FlatList), + ?line Bin = list_to_binary(List), + ?line Bin = iolist_to_binary(List), + ?line Bin = iolist_to_binary(Bin), + ?line Bin = list_to_bitstring(List), + ?line Size = size(Bin), + ?line Size = iolist_size(List), + ?line Size = iolist_size(FlatList), + ?line Size = iolist_size(Bin), + ?line Bitsize = bit_size(Bin), + ?line Bitsize = 8*Size, + ?line FlatList = binary_to_list(Bin), + ?line FlatList = bitstring_to_list(Bin), + io:format("testing plain binary..."), + ?line t_binary_to_list_3(FlatList, Bin, 1, Size), + io:format("testing unaligned sub binary..."), + ?line t_binary_to_list_3(FlatList, make_unaligned_sub_binary(Bin), 1, Size). + +t_binary_to_list_3(List, Bin, From, To) -> + ?line going_up(List, Bin, From, To), + ?line going_down(List, Bin, From, To), + ?line going_center(List, Bin, From, To). + +going_up(List, Bin, From, To) when From =< To -> + ?line List = binary_to_list(Bin, From, To), + ?line going_up(tl(List), Bin, From+1, To); +going_up(_List, _Bin, From, To) when From > To -> + ok. + +going_down(List, Bin, From, To) when To > 0-> + ?line compare(List, binary_to_list(Bin, From, To), To-From+1), + ?line going_down(List, Bin, From, To-1); +going_down(_List, _Bin, _From, _To) -> + ok. + +going_center(List, Bin, From, To) when From >= To -> + ?line compare(List, binary_to_list(Bin, From, To), To-From+1), + ?line going_center(tl(List), Bin, From+1, To-1); +going_center(_List, _Bin, _From, _To) -> + ok. + +compare([X|Rest1], [X|Rest2], Left) when Left > 0 -> + ?line compare(Rest1, Rest2, Left-1); +compare([_X|_], [_Y|_], _Left) -> + ?line test_server:fail(); +compare(_List, [], 0) -> + ok. + +deep_bitstr_lists(Config) when is_list(Config) -> + ?line {<<7:3>>,[<<7:3>>]} = test_deep_bitstr([<<7:3>>]), + ?line {<<42,5:3>>=Bin,[42,<<5:3>>]=List} = test_deep_bitstr([42,<<5:3>>]), + ?line {Bin,List} = test_deep_bitstr([42|<<5:3>>]), + ?line {Bin,List} = test_deep_bitstr([<<42,5:3>>]), + ?line {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>|<<5:3>>]), + ?line {Bin,List} = test_deep_bitstr([<<1:3>>,<<10:5>>,<<5:3>>]), + ?line {Bin,List} = test_deep_bitstr([[<<1:3>>,<<10:5>>],[],<<5:3>>]), + ?line {Bin,List} = test_deep_bitstr([[[<<1:3>>]|<<10:5>>],[],<<5:3>>]), + ?line {Bin,List} = test_deep_bitstr([[<<0:1>>,<<0:1>>,[],<<1:1>>,<<10:5>>], + <<1:1>>,<<0:1>>,<<1:1>>]), + ok. + +test_deep_bitstr(List) -> + %%?line {'EXIT',{badarg,_}} = list_to_binary(List), + Bin = list_to_bitstring(List), + {Bin,bitstring_to_list(Bin)}. + +bad_list_to_binary(suite) -> []; +bad_list_to_binary(Config) when is_list(Config) -> + ?line test_bad_bin(atom), + ?line test_bad_bin(42), + ?line test_bad_bin([1|2]), + ?line test_bad_bin([256]), + ?line test_bad_bin([255, [256]]), + ?line test_bad_bin([-1]), + ?line test_bad_bin([atom_in_list]), + ?line test_bad_bin([[<<8>>]|bad_tail]), + + {'EXIT',{badarg,_}} = (catch list_to_binary(id(<<1,2,3>>))), + {'EXIT',{badarg,_}} = (catch list_to_binary(id([<<42:7>>]))), + {'EXIT',{badarg,_}} = (catch list_to_bitstring(id(<<1,2,3>>))), + + %% Funs used to be implemented as a type of binary internally. + ?line test_bad_bin(fun(X, Y) -> X*Y end), + ?line test_bad_bin([1,fun(X) -> X + 1 end,2|fun() -> 0 end]), + ?line test_bad_bin([fun(X) -> X + 1 end]), + ok. + +test_bad_bin(List) -> + {'EXIT',{badarg,_}} = (catch list_to_binary(List)), + {'EXIT',{badarg,_}} = (catch iolist_to_binary(List)), + {'EXIT',{badarg,_}} = (catch list_to_bitstring(List)). + +bad_binary_to_list(doc) -> "Tries binary_to_list/1,3 with bad arguments."; +bad_binary_to_list(Config) when is_list(Config) -> + ?line bad_bin_to_list(fun(X) -> X * 42 end), + + GoodBin = list_to_binary(lists:seq(1, 10)), + ?line bad_bin_to_list(fun(X) -> X * 44 end, 1, 2), + ?line bad_bin_to_list(GoodBin, 0, 1), + ?line bad_bin_to_list(GoodBin, 2, 1), + ?line bad_bin_to_list(GoodBin, 11, 11), + {'EXIT',{badarg,_}} = (catch binary_to_list(id(<<42:7>>))), + ok. + +bad_bin_to_list(BadBin) -> + {'EXIT',{badarg,_}} = (catch binary_to_list(BadBin)), + {'EXIT',{badarg,_}} = (catch bitstring_to_list(BadBin)). + +bad_bin_to_list(Bin, First, Last) -> + {'EXIT',{badarg,_}} = (catch binary_to_list(Bin, First, Last)). + + +%% Tries to split a binary at all possible positions. + +t_split_binary(suite) -> []; +t_split_binary(Config) when is_list(Config) -> + ?line L = lists:seq(0, ?heap_binary_size-5), %Heap binary. + ?line B = list_to_binary(L), + ?line split(L, B, size(B)), + + %% Sub binary of heap binary. + ?line split(L, make_sub_binary(B), size(B)), + {X,_Y} = split_binary(B, size(B) div 2), + ?line split(binary_to_list(X), X, size(X)), + + %% Unaligned sub binary of heap binary. + ?line split(L, make_unaligned_sub_binary(B), size(B)), + {X,_Y} = split_binary(B, size(B) div 2), + ?line split(binary_to_list(X), X, size(X)), + + %% Reference-counted binary. + ?line L2 = lists:seq(0, ?heap_binary_size+1), + ?line B2 = list_to_binary(L2), + ?line split(L2, B2, size(B2)), + + %% Sub binary of reference-counted binary. + ?line split(L2, make_sub_binary(B2), size(B2)), + {X2,_Y2} = split_binary(B2, size(B2) div 2), + ?line split(binary_to_list(X2), X2, size(X2)), + + %% Unaligned sub binary of reference-counted binary. + ?line split(L2, make_unaligned_sub_binary(B2), size(B2)), + {X2,_Y2} = split_binary(B2, size(B2) div 2), + ?line split(binary_to_list(X2), X2, size(X2)), + + ok. + +split(L, B, Pos) when Pos > 0 -> + ?line {B1, B2} = split_binary(B, Pos), + ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), + ?line B2 = list_to_binary(lists:nthtail(Pos, L)), + ?line split(L, B, Pos-1); +split(_L, _B, 0) -> + ok. + +bad_split(doc) -> "Tries split_binary/2 with bad arguments."; +bad_split(suite) -> []; +bad_split(Config) when is_list(Config) -> + GoodBin = list_to_binary([1,2,3]), + ?line bad_split(GoodBin, -1), + ?line bad_split(GoodBin, 4), + ?line bad_split(GoodBin, a), + + %% Funs are a kind of binaries. + ?line bad_split(fun(_X) -> 1 end, 1), + ok. + +bad_split(Bin, Pos) -> + {'EXIT',{badarg,_}} = (catch split_binary(Bin, Pos)). + +%% Tests concat_binary/2 and size/1. + +t_concat_binary(suite) -> []; +t_concat_binary(Config) when is_list(Config) -> + test_concat([]), + + test_concat([[]]), + test_concat([[], []]), + test_concat([[], [], []]), + + test_concat([[1], []]), + test_concat([[], [2]]), + test_concat([[], [3], []]), + + test_concat([[1, 2, 3], [4, 5, 6, 7]]), + test_concat([[1, 2, 3], [4, 5, 6, 7], [9, 10]]), + + test_concat([lists:seq(0, 255), lists:duplicate(1024, $@), + lists:duplicate(2048, $a), + lists:duplicate(4000, $b)]), + ok. + +test_concat(Lists) -> + test_concat(Lists, 0, [], []). + +test_concat([List|Rest], Size, Combined, Binaries) -> + ?line Bin = list_to_binary(List), + ?line test_concat(Rest, Size+length(List), Combined++List, [Bin|Binaries]); +test_concat([], Size, Combined, Binaries0) -> + ?line Binaries = lists:reverse(Binaries0), + ?line Bin = concat_binary(Binaries), + ?line Size = size(Bin), + ?line Size = iolist_size(Bin), + ?line Combined = binary_to_list(Bin). + +t_hash(doc) -> "Test hash/2 with different type of binaries."; +t_hash(Config) when is_list(Config) -> + test_hash([]), + test_hash([253]), + test_hash(lists:seq(1, ?heap_binary_size)), + test_hash(lists:seq(1, ?heap_binary_size+1)), + test_hash([X rem 256 || X <- lists:seq(1, 312)]), + ok. + +test_hash(List) -> + Bin = list_to_binary(List), + Sbin = make_sub_binary(List), + Unaligned = make_unaligned_sub_binary(Sbin), + ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:hash/2), + ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash/2), + ?line test_hash_1(Bin, Sbin, Unaligned, fun erlang:phash2/2). + +test_hash_1(Bin, Sbin, Unaligned, Hash) when is_function(Hash, 2) -> + N = 65535, + case {Hash(Bin, N),Hash(Sbin, N),Hash(Unaligned, N)} of + {H,H,H} -> ok; + {H1,H2,H3} -> + io:format("Different hash values: ~p, ~p, ~p\n", [H1,H2,H3]), + ?t:fail() + end. + +bad_size(doc) -> "Try bad arguments to size/1."; +bad_size(suite) -> []; +bad_size(Config) when is_list(Config) -> + ?line {'EXIT',{badarg,_}} = (catch size(fun(X) -> X + 33 end)), + ok. + +bad_term_to_binary(Config) when is_list(Config) -> + T = id({a,b,c}), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, not_a_list)), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [blurf])), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,-1}])), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,10}])), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed,cucumber}])), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{compressed}])), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{version,1}|bad_tail])), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,-1}])), + ?line {'EXIT',{badarg,_}} = (catch term_to_binary(T, [{minor_version,x}])), + + ok. + +%% Tests binary_to_term/1 and term_to_binary/1. + +terms(Config) when is_list(Config) -> + TestFun = fun(Term) -> + try + S = io_lib:format("~p", [Term]), + io:put_chars(S) + catch + error:badarg -> + io:put_chars("bit sized binary") + end, + Bin = term_to_binary(Term), + case erlang:external_size(Bin) of + Sz when is_integer(Sz), size(Bin) =< Sz -> + ok + end, + Term = binary_to_term(Bin), + Unaligned = make_unaligned_sub_binary(Bin), + Term = binary_to_term(Unaligned), + BinC = erlang:term_to_binary(Term, [compressed]), + Term = binary_to_term(BinC), + true = size(BinC) =< size(Bin), + Bin = term_to_binary(Term, [{compressed,0}]), + terms_compression_levels(Term, size(Bin), 1), + UnalignedC = make_unaligned_sub_binary(BinC), + Term = binary_to_term(UnalignedC) + end, + ?line test_terms(TestFun), + ok. + +terms_compression_levels(Term, UncompressedSz, Level) when Level < 10 -> + BinC = erlang:term_to_binary(Term, [{compressed,Level}]), + Term = binary_to_term(BinC), + Sz = byte_size(BinC), + true = Sz =< UncompressedSz, + terms_compression_levels(Term, UncompressedSz, Level+1); +terms_compression_levels(_, _, _) -> ok. + +terms_float(Config) when is_list(Config) -> + ?line test_floats(fun(Term) -> + Bin0 = term_to_binary(Term), + Bin0 = term_to_binary(Term, [{minor_version,0}]), + Term = binary_to_term(Bin0), + Bin1 = term_to_binary(Term, [{minor_version,1}]), + Term = binary_to_term(Bin1), + true = size(Bin1) < size(Bin0) + end). + +external_size(Config) when is_list(Config) -> + %% Build a term whose external size only fits in a big num (on 32-bit CPU). + ?line external_size_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF), + + %% Test that the same binary aligned and unaligned has the same external size. + ?line Bin = iolist_to_binary([1,2,3,96]), + ?line Unaligned = make_unaligned_sub_binary(Bin), + case {erlang:external_size(Bin),erlang:external_size(Unaligned)} of + {X,X} -> ok; + {Sz1,Sz2} -> + io:format(" Aligned size: ~p\n", [Sz1]), + io:format("Unaligned size: ~p\n", [Sz2]), + ?line ?t:fail() + end. + +external_size_1(Term, Size0, Limit) when Size0 < Limit -> + case erlang:external_size(Term) of + Size when is_integer(Size), Size0 < Size -> + io:format("~p", [Size]), + external_size_1([Term|Term], Size, Limit) + end; +external_size_1(_, _, _) -> ok. + +t_iolist_size(Config) when is_list(Config) -> + %% Build a term whose external size only fits in a big num (on 32-bit CPU). + Bin = iolist_to_binary(lists:seq(0, 254)), + ?line ok = t_iolist_size_1(Bin, 0, 16#7FFFFFFF), + ?line ok = t_iolist_size_1(make_unaligned_sub_binary(Bin), 0, 16#7FFFFFFF). + +t_iolist_size_1(IOList, Size0, Limit) when Size0 < Limit -> + case iolist_size(IOList) of + Size when is_integer(Size), Size0 < Size -> + io:format("~p", [Size]), + t_iolist_size_1([IOList|IOList], Size, Limit) + end; +t_iolist_size_1(_, _, _) -> ok. + +bad_binary_to_term_2(doc) -> "OTP-4053."; +bad_binary_to_term_2(suite) -> []; +bad_binary_to_term_2(Config) when is_list(Config) -> + ?line {ok, N} = test_server:start_node(plopp, slave, []), + ?line R = rpc:call(N, erlang, binary_to_term, [<<131,111,255,255,255,0>>]), + ?line case R of + {badrpc, {'EXIT', _}} -> + ok; + _Other -> + test_server:fail({rpcresult, R}) + end, + ?line test_server:stop_node(N), + ok. + +bad_binary_to_term(doc) -> "Try bad input to binary_to_term/1."; +bad_binary_to_term(Config) when is_list(Config) -> + ?line bad_bin_to_term(an_atom), + ?line bad_bin_to_term({an,tuple}), + ?line bad_bin_to_term({a,list}), + ?line bad_bin_to_term(fun() -> self() end), + ?line bad_bin_to_term(fun(X) -> 42*X end), + ?line bad_bin_to_term(fun(X, Y) -> {X,Y} end), + ?line bad_bin_to_term(fun(X, Y, Z) -> {X,Y,Z} end), + ?line bad_bin_to_term(bit_sized_binary(term_to_binary({you,should,'not',see,this,term}))), + + %% Bad float. + ?line bad_bin_to_term(<<131,70,-1:64>>), + ok. + +bad_bin_to_term(BadBin) -> + {'EXIT',{badarg,_}} = (catch binary_to_term(BadBin)). + +%% Tests bad input to binary_to_term/1. + +bad_terms(suite) -> []; +bad_terms(Config) when is_list(Config) -> + ?line test_terms(fun corrupter/1). + +corrupter(Term) -> + ?line try + S = io_lib:format("About to corrupt: ~P", [Term,12]), + io:put_chars(S) + catch + error:badarg -> + io:format("About to corrupt: <= 0 -> + ?line {ShorterBin, _} = split_binary(Bin, Pos), + ?line catch binary_to_term(ShorterBin), %% emulator shouldn't crash + ?line MovedBin = list_to_binary([ShorterBin]), + ?line catch binary_to_term(MovedBin), %% emulator shouldn't crash + ?line corrupter(MovedBin, Pos-1); +corrupter(_Bin, _) -> + ok. + +more_bad_terms(suite) -> []; +more_bad_terms(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line BadFile = filename:join(Data, "bad_binary"), + ?line ok = io:format("File: ~s\n", [BadFile]), + ?line case file:read_file(BadFile) of + {ok,Bin} -> + ?line {'EXIT',{badarg,_}} = (catch binary_to_term(Bin)), + ok; + Other -> + ?line ?t:fail(Other) + end. + +otp_5484(Config) when is_list(Config) -> + ?line {'EXIT',_} = + (catch + binary_to_term( + <<131, + 104,2, %Tuple, 2 elements + 103, %Pid + 100,0,20,"wslin1427198@wslin14", + %% Obviously bad values follow. + 255,255,255,255, + 255,255,255,255, + 255, + 106>>)), + + ?line {'EXIT',_} = + (catch + binary_to_term( + <<131, + 104,2, %Tuple, 2 elements + 103, %Pid + 106, %[] instead of atom. + 0,0,0,17, + 0,0,0,135, + 2, + 106>>)), + + ?line {'EXIT',_} = + (catch + binary_to_term( + %% A old-type fun in a list containing a bad creator pid. + <<131,108,0,0,0,1,117,0,0,0,0,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,255,255,0,25,255,0,0,0,0,100,0,1,116,97,0,98,6,142,121,72,106>>)), + + ?line {'EXIT',_} = + (catch + binary_to_term( + %% A new-type fun in a list containing a bad creator pid. + %% + <<131, + 108,0,0,0,1, %List, 1 element + 112,0,0,0,66,0,52,216,81,158,148,250,237,109,185,9,208,60,202,156,244,218,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,6,142,121,72, + 103, %Pid. + 106, %[] instead of an atom. + 0,0,0,27,0,0,0,0,0,106>>)), + + ?line {'EXIT',_} = + (catch + binary_to_term( + %% A new-type fun in a list containing a bad module. + <<131, + 108,0,0,0,1, %List, 1 element + 112,0,0,0,70,0,224,90,4,101,48,28,110,228,153,48,239,169,232,77,108,145,0,0,0,0,0,0,0,2, + %%100,0,1,116, + 107,0,1,64, %String instead of atom (same length). + 97,0,98,6,64,82,230,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), + + ?line {'EXIT',_} = + (catch + binary_to_term( + %% A new-type fun in a list containing a bad index. + <<131, + 108,0,0,0,1, %List, 1 element + 112,0,0,0,70,0,224,90,4,101,48,28,110,228,153,48,239,169,232,77,108,145,0,0,0,0,0,0,0,2, + 100,0,1,116, + %%97,0, %Integer: 0. + 104,0, %Tuple {} instead of integer. + 98,6,64,82,230,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), + + ?line {'EXIT',_} = + (catch + binary_to_term( + %% A new-type fun in a list containing a bad unique value. + <<131, + 108,0,0,0,1, %List, 1 element + 112,0,0,0,70,0,224,90,4,101,48,28,110,228,153,48,239,169,232,77,108,145,0,0,0,0,0,0,0,2, + 100,0,1,116, + 97,0, %Integer: 0. + %%98,6,64,82,230, %Integer. + 100,0,2,64,65, %Atom instead of integer. + 103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116,0,0,0,48,0,0,0,0,0,97,42,97,7,106>>)), + + %% An absurdly large atom. + ?line {'EXIT',_} = + (catch binary_to_term(iolist_to_binary([<<131,100,65000:16>>| + lists:duplicate(65000, 42)]))), + + %% Longer than 255 characters. + ?line {'EXIT',_} = + (catch binary_to_term(iolist_to_binary([<<131,100,256:16>>| + lists:duplicate(256, 42)]))), + + %% OTP-7218. Thanks to Matthew Dempsky. Also make sure that we + %% cover the other error cases for external funs (EXPORT_EXT). + ?line {'EXIT',_} = + (catch binary_to_term( + <<131, + 113, %EXPORT_EXP + 97,13, %Integer: 13 + 97,13, %Integer: 13 + 97,13>>)), %Integer: 13 + ?line {'EXIT',_} = + (catch binary_to_term( + <<131, + 113, %EXPORT_EXP + 100,0,1,64, %Atom: '@' + 97,13, %Integer: 13 + 97,13>>)), %Integer: 13 + ?line {'EXIT',_} = + (catch binary_to_term( + <<131, + 113, %EXPORT_EXP + 100,0,1,64, %Atom: '@' + 100,0,1,64, %Atom: '@' + 106>>)), %NIL + ?line {'EXIT',_} = + (catch binary_to_term( + <<131, + 113, %EXPORT_EXP + 100,0,1,64, %Atom: '@' + 100,0,1,64, %Atom: '@' + 98,255,255,255,255>>)), %Integer: -1 + ?line {'EXIT',_} = + (catch binary_to_term( + <<131, + 113, %EXPORT_EXP + 100,0,1,64, %Atom: '@' + 100,0,1,64, %Atom: '@' + 113,97,13,97,13,97,13>>)), %fun 13:13/13 + + %% Bad funs. + ?line {'EXIT',_} = (catch binary_to_term(fake_fun(0, lists:seq(0, 256)))), + ok. + +fake_fun(Arity, Env0) -> + Uniq = erlang:md5([]), + Index = 0, + NumFree = length(Env0), + Mod = list_to_binary(?MODULE_STRING), + OldIndex = 0, + OldUniq = 16#123456, + <<131,Pid/binary>> = term_to_binary(self()), + Env1 = [term_to_binary(Term) || Term <- Env0], + Env = << <> || <<131,Bin/binary>> <- Env1 >>, + B = <>, + <<131,$p,(byte_size(B)+4):32,B/binary>>. + + +%% More bad terms submitted by Matthias Lang. +otp_5933(Config) when is_list(Config) -> + ?line try_bad_lengths(<<131,$m>>), %binary + ?line try_bad_lengths(<<131,$n>>), %bignum + ?line try_bad_lengths(<<131,$o>>), %huge bignum + ok. + +try_bad_lengths(B) -> + try_bad_lengths(B, 16#FFFFFFFF). + +try_bad_lengths(B, L) when L > 16#FFFFFFF0 -> + Bin = <>, + io:format("~p\n", [Bin]), + {'EXIT',_} = (catch binary_to_term(Bin)), + try_bad_lengths(B, L-1); +try_bad_lengths(_, _) -> ok. + + +otp_6817(Config) when is_list(Config) -> + process_flag(min_heap_size, 20000), %Use the heap, not heap fragments. + + %% Floats are only validated when the heap fragment has been allocated. + BadFloat = <<131,99,53,46,48,$X,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,101,45,48,49,0,0,0,0,0>>, + ?line otp_6817_try_bin(BadFloat), + + %% {Binary,BadFloat}: When the error in float is discovered, a refc-binary + %% has been allocated and the list of refc-binaries goes through the + %% limbo area between the heap top and stack. + BinAndFloat = + <<131,104,2,109,0,0,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, + 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45, + 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70, + 71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95, + 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115, + 116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134, + 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153, + 154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172, + 173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191, + 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210, + 211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229, + 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248, + 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48, + 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>, + ?line otp_6817_try_bin(BinAndFloat), + + %% {Fun,BadFloat} + FunAndFloat = + <<131,104,2,112,0,0,0,66,0,238,239,135,138,137,216,89,57,22,111,52,126,16,84, + 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111, + 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48, + $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>, + ?line otp_6817_try_bin(FunAndFloat), + + %% [ExternalPid|BadFloat] + ExtPidAndFloat = + <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101, + 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48, + 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>, + ?line otp_6817_try_bin(ExtPidAndFloat), + ok. + +otp_6817_try_bin(Bin) -> + erlang:garbage_collect(), + + %% If the bug is present, the heap pointer will moved when the invalid term + %% is found and we will have a linked list passing through the limbo area + %% between the heap top and the stack pointer. + catch binary_to_term(Bin), + + %% If the bug is present, we will overwrite the pointers in the limbo area. + Filler = erlang:make_tuple(1024, 16#3FA), + id(Filler), + + %% Will crash if the bug is present. + erlang:garbage_collect(). + +otp_8117(doc) -> "Some bugs in binary_to_term when 32-bit integers are negative."; +otp_8117(suite) -> []; +otp_8117(Config) when is_list(Config) -> + [otp_8117_do(Op,-(1 bsl N)) || Op <- ['fun',list,tuple], + N <- lists:seq(0,31)], + ok. + +otp_8117_do('fun',Neg) -> + % Fun with negative num_free + FunBin = term_to_binary(fun() -> ok end), + ?line <> = FunBin, + ?line bad_bin_to_term(<>); +otp_8117_do(list,Neg) -> + %% List with negative length + ?line bad_bin_to_term(<<131,104,2,108,Neg:32,97,11,104,1,97,12,97,13,106,97,14>>); +otp_8117_do(tuple,Neg) -> + %% Tuple with negative arity + ?line bad_bin_to_term(<<131,104,2,105,Neg:32,97,11,97,12,97,13,97,14>>). + + +ordering(doc) -> "Tests ordering of binaries."; +ordering(suite) -> []; +ordering(Config) when is_list(Config) -> + B1 = list_to_binary([7,8,9]), + B2 = make_sub_binary([1,2,3,4]), + B3 = list_to_binary([1,2,3,5]), + Unaligned = make_unaligned_sub_binary(B2), + + %% From R8 binaries are compared as strings. + + ?line false = B1 == B2, + ?line false = B1 =:= B2, + ?line true = B1 /= B2, + ?line true = B1 =/= B2, + + ?line true = B1 > B2, + ?line true = B2 < B3, + ?line true = B2 =< B1, + ?line true = B2 =< B3, + + ?line true = B2 =:= Unaligned, + ?line true = B2 == Unaligned, + ?line true = Unaligned < B3, + ?line true = Unaligned =< B3, + + %% Binaries are greater than all other terms. + + ?line true = B1 > 0, + ?line true = B1 > 39827491247298471289473333333333333333333333333333, + ?line true = B1 > -3489274937438742190467869234328742398347, + ?line true = B1 > 3.14, + ?line true = B1 > [], + ?line true = B1 > [a], + ?line true = B1 > {a}, + ?line true = B1 > self(), + ?line true = B1 > make_ref(), + ?line true = B1 > xxx, + ?line true = B1 > fun() -> 1 end, + ?line true = B1 > fun erlang:send/2, + + ?line Path = ?config(priv_dir, Config), + ?line AFile = filename:join(Path, "vanilla_file"), + ?line Port = open_port(AFile, [out]), + ?line true = B1 > Port, + + ?line true = B1 >= 0, + ?line true = B1 >= 39827491247298471289473333333333333333333333333333, + ?line true = B1 >= -3489274937438742190467869234328742398347, + ?line true = B1 >= 3.14, + ?line true = B1 >= [], + ?line true = B1 >= [a], + ?line true = B1 >= {a}, + ?line true = B1 >= self(), + ?line true = B1 >= make_ref(), + ?line true = B1 >= xxx, + ?line true = B1 >= fun() -> 1 end, + ?line true = B1 >= fun erlang:send/2, + ?line true = B1 >= Port, + + ok. + +%% Test that comparisions between binaries with different alignment work. +unaligned_order(Config) when is_list(Config) -> + L = lists:seq(0, 7), + [test_unaligned_order(I, J) || I <- L, J <- L], + ok. + +test_unaligned_order(I, J) -> + Align = {I,J}, + io:format("~p ~p", [I,J]), + ?line true = test_unaligned_order_1('=:=', <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>, + <<1,2,3,16#AA,16#7C,4,16#5F,5,16#5A>>, + Align), + ?line false = test_unaligned_order_1('=/=', <<1,2,3>>, <<1,2,3>>, Align), + ?line true = test_unaligned_order_1('==', <<4,5,6>>, <<4,5,6>>, Align), + ?line false = test_unaligned_order_1('/=', <<1,2,3>>, <<1,2,3>>, Align), + + ?line true = test_unaligned_order_1('<', <<1,2>>, <<1,2,3>>, Align), + ?line true = test_unaligned_order_1('=<', <<1,2>>, <<1,2,3>>, Align), + ?line true = test_unaligned_order_1('=<', <<1,2,7,8>>, <<1,2,7,8>>, Align), + ok. + +test_unaligned_order_1(Op, A, B, {Aa,Ba}) -> + erlang:Op(unaligned_sub_bin(A, Aa), unaligned_sub_bin(B, Ba)). + +test_terms(Test_Func) -> + ?line Test_Func(atom), + ?line Test_Func(''), + ?line Test_Func('a'), + ?line Test_Func('ab'), + ?line Test_Func('abc'), + ?line Test_Func('abcd'), + ?line Test_Func('abcde'), + ?line Test_Func('abcdef'), + ?line Test_Func('abcdefg'), + ?line Test_Func('abcdefgh'), + + ?line Test_Func(fun() -> ok end), + X = id([a,{b,c},c]), + Y = id({x,y,z}), + Z = id(1 bsl 8*257), + ?line Test_Func(fun() -> X end), + ?line Test_Func(fun() -> {X,Y} end), + ?line Test_Func([fun() -> {X,Y,Z} end, + fun() -> {Z,X,Y} end, + fun() -> {Y,Z,X} end]), + + ?line Test_Func({trace_ts,{even_bigger,{some_data,fun() -> ok end}},{1,2,3}}), + ?line Test_Func({trace_ts,{even_bigger,{some_data,<<1,2,3,4,5,6,7,8,9,10>>}}, + {1,2,3}}), + + ?line Test_Func(1), + ?line Test_Func(42), + ?line Test_Func(-23), + ?line Test_Func(256), + ?line Test_Func(25555), + ?line Test_Func(-3333), + + ?line Test_Func(1.0), + + ?line Test_Func(183749783987483978498378478393874), + ?line Test_Func(-37894183749783987483978498378478393874), + Very_Big = very_big_num(), + ?line Test_Func(Very_Big), + ?line Test_Func(-Very_Big+1), + + ?line Test_Func([]), + ?line Test_Func("abcdef"), + ?line Test_Func([a, b, 1, 2]), + ?line Test_Func([a|b]), + + ?line Test_Func({}), + ?line Test_Func({1}), + ?line Test_Func({a, b}), + ?line Test_Func({a, b, c}), + ?line Test_Func(list_to_tuple(lists:seq(0, 255))), + ?line Test_Func(list_to_tuple(lists:seq(0, 256))), + + ?line Test_Func(make_ref()), + ?line Test_Func([make_ref(), make_ref()]), + + ?line Test_Func(make_port()), + + ?line Test_Func(make_pid()), + + ?line Test_Func(Bin0 = list_to_binary(lists:seq(0, 14))), + ?line Test_Func(Bin1 = list_to_binary(lists:seq(0, ?heap_binary_size))), + ?line Test_Func(Bin2 = list_to_binary(lists:seq(0, ?heap_binary_size+1))), + ?line Test_Func(Bin3 = list_to_binary(lists:seq(0, 255))), + + ?line Test_Func(make_unaligned_sub_binary(Bin0)), + ?line Test_Func(make_unaligned_sub_binary(Bin1)), + ?line Test_Func(make_unaligned_sub_binary(Bin2)), + ?line Test_Func(make_unaligned_sub_binary(Bin3)), + + ?line Test_Func(make_sub_binary(lists:seq(42, 43))), + ?line Test_Func(make_sub_binary([42,43,44])), + ?line Test_Func(make_sub_binary([42,43,44,45])), + ?line Test_Func(make_sub_binary([42,43,44,45,46])), + ?line Test_Func(make_sub_binary([42,43,44,45,46,47])), + ?line Test_Func(make_sub_binary([42,43,44,45,46,47,48])), + ?line Test_Func(make_sub_binary(lists:seq(42, 49))), + ?line Test_Func(make_sub_binary(lists:seq(0, 14))), + ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size))), + ?line Test_Func(make_sub_binary(lists:seq(0, ?heap_binary_size+1))), + ?line Test_Func(make_sub_binary(lists:seq(0, 255))), + + ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 43))), + ?line Test_Func(make_unaligned_sub_binary([42,43,44])), + ?line Test_Func(make_unaligned_sub_binary([42,43,44,45])), + ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46])), + ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47])), + ?line Test_Func(make_unaligned_sub_binary([42,43,44,45,46,47,48])), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(42, 49))), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 14))), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size))), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, ?heap_binary_size+1))), + ?line Test_Func(make_unaligned_sub_binary(lists:seq(0, 255))), + + %% Bit level binaries. + ?line Test_Func(<<1:1>>), + ?line Test_Func(<<2:2>>), + ?line Test_Func(<<42:10>>), + ?line Test_Func(list_to_bitstring([<<5:6>>|lists:seq(0, 255)])), + + ?line Test_Func(F = fun(A) -> 42*A end), + ?line Test_Func(lists:duplicate(32, F)), + + ?line Test_Func(FF = fun binary_SUITE:all/1), + ?line Test_Func(lists:duplicate(32, FF)), + + ok. + +test_floats(Test_Func) -> + ?line Test_Func(5.5), + ?line Test_Func(-15.32), + ?line Test_Func(1.2435e25), + ?line Test_Func(1.2333e-20), + ?line Test_Func(199.0e+15), + ok. + +very_big_num() -> + very_big_num(33, 1). + +very_big_num(Left, Result) when Left > 0 -> + ?line very_big_num(Left-1, Result*256); +very_big_num(0, Result) -> + ?line Result. + +make_port() -> + ?line open_port({spawn, efile}, [eof]). + +make_pid() -> + ?line spawn_link(?MODULE, sleeper, []). + +sleeper() -> + ?line receive after infinity -> ok end. + + +gc_test(doc) -> "Test that binaries are garbage collected properly."; +gc_test(suite) -> []; +gc_test(Config) when is_list(Config) -> + case erlang:system_info(heap_type) of + private -> gc_test_1(); + hybrid -> {skip,"Hybrid heap"} + end. + +gc_test_1() -> + %% Note: This test is only relevant for REFC binaries. + %% Therefore, we take care that all binaries are REFC binaries. + B = list_to_binary(lists:seq(0, ?heap_binary_size)), + Self = self(), + F1 = fun() -> + gc(), + {binary,[]} = process_info(self(), binary), + Self ! {self(),done} + end, + F = fun() -> + receive go -> ok end, + {binary,[{_,65,1}]} = process_info(self(), binary), + gc(), + {B1,B2} = my_split_binary(B, 4), + gc(), + gc(), + {binary,L1} = process_info(self(), binary), + [Binfo1,Binfo2,Binfo3] = L1, + {_,65,3} = Binfo1 = Binfo2 = Binfo3, + 65 = size(B), + 4 = size(B1), + 61 = size(B2), + F1() + end, + gc(), + gc(), + 65 = size(B), + gc_test1(spawn_opt(erlang, apply, [F,[]], [link,{fullsweep_after,0}])). + +gc_test1(Pid) -> + gc(), + Pid ! go, + receive + {Pid,done} -> ok + after 10000 -> + ?line ?t:fail() + end. + +%% Like split binary, but returns REFC binaries. Only useful for gc_test/1. + +my_split_binary(B, Pos) -> + Self = self(), + Ref = make_ref(), + spawn(fun() -> Self ! {Ref,split_binary(B, Pos)} end), + receive + {Ref,Result} -> Result + end. + +gc() -> + erlang:garbage_collect(), + gc1(). +gc1() -> ok. + +bit_sized_binary_sizes(Config) when is_list(Config) -> + ?line [bsbs_1(A) || A <- lists:seq(0, 7)], + ok. + +bsbs_1(0) -> + BinSize = 32+8, + io:format("A: ~p BinSize: ~p", [0,BinSize]), + Bin = binary_to_term(<<131,$M,5:32,0,0,0,0,0,0>>), + BinSize = bit_size(Bin); +bsbs_1(A) -> + BinSize = 32+A, + io:format("A: ~p BinSize: ~p", [A,BinSize]), + Bin = binary_to_term(<<131,$M,5:32,A,0,0,0,0,0>>), + BinSize = bit_size(Bin). + +bitlevel_roundtrip(Config) when is_list(Config) -> + case ?t:is_release_available("r11b") of + true -> bitlevel_roundtrip_1(); + false -> {skip,"No R11B found"} + end. + +bitlevel_roundtrip_1() -> + Name = bitlevelroundtrip, + ?line N = list_to_atom(atom_to_list(Name) ++ "@" ++ hostname()), + ?line ?t:start_node(Name, slave, [{erl,[{release,"r11b"}]}]), + + ?line {<<128>>,1} = roundtrip(N, <<1:1>>), + ?line {<<64>>,2} = roundtrip(N, <<1:2>>), + ?line {<<16#E0>>,3} = roundtrip(N, <<7:3>>), + ?line {<<16#70>>,4} = roundtrip(N, <<7:4>>), + ?line {<<16#10>>,5} = roundtrip(N, <<2:5>>), + ?line {<<16#8>>,6} = roundtrip(N, <<2:6>>), + ?line {<<16#2>>,7} = roundtrip(N, <<1:7>>), + ?line {<<8,128>>,1} = roundtrip(N, <<8,1:1>>), + ?line {<<42,248>>,5} = roundtrip(N, <<42,31:5>>), + + ?line ?t:stop_node(N), + ok. + +roundtrip(Node, Term) -> + {badrpc,{'EXIT',Res}} = rpc:call(Node, erlang, exit, [Term]), + io:format("<<~p bits>> => ~w", [bit_size(Term),Res]), + Res. + +deep(Config) when is_list(Config) -> + ?line deep_roundtrip(lists:foldl(fun(E, A) -> + [E,A] + end, [], lists:seq(1, 1000000))), + ?line deep_roundtrip(lists:foldl(fun(E, A) -> + {E,A} + end, [], lists:seq(1, 1000000))), + ?line deep_roundtrip(lists:foldl(fun(E, A) -> + fun() -> {E,A} end + end, [], lists:seq(1, 1000000))), + ok. + +deep_roundtrip(T) -> + B = term_to_binary(T), + true = deep_eq(T, binary_to_term(B)). + +%% +%% FIXME: =:= runs out of stack. +%% +deep_eq([H1|T1], [H2|T2]) -> + deep_eq(H1, H2) andalso deep_eq(T1, T2); +deep_eq(T1, T2) when tuple_size(T1) =:= tuple_size(T2) -> + deep_eq_tup(T1, T2, tuple_size(T1)); +deep_eq(T1, T2) when is_function(T1), is_function(T2) -> + {uniq,U1} = erlang:fun_info(T1, uniq), + {index,I1} = erlang:fun_info(T1, index), + {arity,A1} = erlang:fun_info(T1, arity), + {env,E1} = erlang:fun_info(T1, env), + {uniq,U2} = erlang:fun_info(T2, uniq), + {index,I2} = erlang:fun_info(T2, index), + {arity,A2} = erlang:fun_info(T2, arity), + {env,E2} = erlang:fun_info(T2, env), + U1 =:= U2 andalso I1 =:= I2 andalso A1 =:= A2 andalso + deep_eq(E1, E2); +deep_eq(T1, T2) -> + T1 =:= T2. + +deep_eq_tup(_T1, _T2, 0) -> + true; +deep_eq_tup(T1, T2, N) -> + deep_eq(element(N, T1), element(N, T2)) andalso + deep_eq_tup(T1, T2, N-1). + +obsolete_funs(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + + X = id({1,2,3}), + Y = id([a,b,c,d]), + Z = id({x,y,z}), + ?line obsolete_fun(fun() -> ok end), + ?line obsolete_fun(fun() -> X end), + ?line obsolete_fun(fun(A) -> {A,X} end), + ?line obsolete_fun(fun() -> {X,Y} end), + ?line obsolete_fun(fun() -> {X,Y,Z} end), + + ?line obsolete_fun(fun ?MODULE:all/1), + + erts_debug:set_internal_state(available_internal_state, false), + ok. + +obsolete_fun(Fun) -> + Tuple = case erlang:fun_info(Fun, type) of + {type,external} -> + {module,M} = erlang:fun_info(Fun, module), + {name,F} = erlang:fun_info(Fun, name), + {M,F}; + {type,local} -> + {module,M} = erlang:fun_info(Fun, module), + {index,I} = erlang:fun_info(Fun, index), + {uniq,U} = erlang:fun_info(Fun, uniq), + {env,E} = erlang:fun_info(Fun, env), + {'fun',M,I,U,list_to_tuple(E)} + end, + Tuple = no_fun_roundtrip(Fun). + +no_fun_roundtrip(Term) -> + binary_to_term(erts_debug:get_internal_state({term_to_binary_no_funs,Term})). + +%% Test non-standard encodings never generated by term_to_binary/1 +%% but recognized by binary_to_term/1. + +robustness(Config) when is_list(Config) -> + ?line [] = binary_to_term(<<131,107,0,0>>), %Empty string. + ?line [] = binary_to_term(<<131,108,0,0,0,0,106>>), %Zero-length list. + + %% {[],a} where [] is a zero-length list. + ?line {[],a} = binary_to_term(<<131,104,2,108,0,0,0,0,106,100,0,1,97>>), + + %% {42,a} where 42 is a zero-length list with 42 in the tail. + ?line {42,a} = binary_to_term(<<131,104,2,108,0,0,0,0,97,42,100,0,1,97>>), + + %% {{x,y},a} where {x,y} is a zero-length list with {x,y} in the tail. + ?line {{x,y},a} = binary_to_term(<<131,104,2,108,0,0,0,0, + 104,2,100,0,1,120,100,0,1, + 121,100,0,1,97>>), + + %% Bignums fitting in 32 bits. + ?line 16#7FFFFFFF = binary_to_term(<<131,98,127,255,255,255>>), + ?line -1 = binary_to_term(<<131,98,255,255,255,255>>), + + ok. + +%% OTP-8180: Test several terms that have been known to crash the emulator. +%% (Thanks to Scott Lystig Fritchie.) +otp_8180(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line Wc = filename:join(Data, "zzz.*"), + Files = filelib:wildcard(Wc), + [run_otp_8180(F) || F <- Files], + ok. + +run_otp_8180(Name) -> + io:format("~s", [Name]), + ?line {ok,Bins} = file:consult(Name), + [begin + io:format("~p\n", [Bin]), + ?line {'EXIT',{badarg,_}} = (catch binary_to_term(Bin)) + end || Bin <- Bins], + ok. + +%% Utilities. + +make_sub_binary(Bin) when is_binary(Bin) -> + {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), + B; +make_sub_binary(List) -> + make_sub_binary(list_to_binary(List)). + +make_unaligned_sub_binary(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin; +make_unaligned_sub_binary(List) -> + make_unaligned_sub_binary(list_to_binary(List)). + +%% Add 1 bit to the size of the binary. +bit_sized_binary(Bin0) -> + Bin = <>, + BitSize = bit_size(Bin), + BitSize = 8*size(Bin) + 1, + Bin. + +unaligned_sub_bin(Bin, 0) -> Bin; +unaligned_sub_bin(Bin0, Offs) -> + F = random:uniform(256), + Roffs = 8-Offs, + Bin1 = <>, + Sz = size(Bin0), + <<_:Offs,Bin:Sz/binary,_:Roffs>> = id(Bin1), + Bin. + +hostname() -> + from($@, atom_to_list(node())). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_, []) -> []. + +id(I) -> I. diff --git a/erts/emulator/test/binary_SUITE_data/bad_binary b/erts/emulator/test/binary_SUITE_data/bad_binary new file mode 100644 index 0000000000..6c008e96ee Binary files /dev/null and b/erts/emulator/test/binary_SUITE_data/bad_binary differ diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.1197 b/erts/emulator/test/binary_SUITE_data/zzz.terms.1197 new file mode 100644 index 0000000000..762e89c342 --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.1197 @@ -0,0 +1 @@ +<<131,104,3,108,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,187,16,52,164,138,66,218,149,102,245,119,235,94,64,69,150,116,121,109,0,0,0,16,69,128,138,148,31,134,101,69,254,137,55,67,50,87,61,209,109,0,0,0,16,102,135,75,119,127,212,19,209,35,70,255,181,98,150,204,245,109,0,0,0,16,249,179,20,179,193,238,148,70,246,210,217,238,180,230,213,19,109,0,0,0,16,53,94,111,136,10,236,80,242,175,115,246,172,67,209,60,111,109,0,0,0,16,215,248,244,92,112,145,239,153,42,113,41,150,30,100,224,175,109,0,0,0,16,200,44,221,92,158,142,48,188,76,52,143,53,27,36,227,193,109,0,0,0,16,103,194,1,2,29,34,16,42,54,48,191,81,89,103,122,214,106,107,0,9,10,21,25,30,7,36,41,12,10,107,0,30,45,33,40,4,13,27,38,10,3,25,39,0,18,4,3,4,20,8,46,20,6,33,2,23,10,12,37,33,45,33>>. diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.2224 b/erts/emulator/test/binary_SUITE_data/zzz.terms.2224 new file mode 100644 index 0000000000..6440db5f8a --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.2224 @@ -0,0 +1 @@ +<<131,104,3,108,176,0,0,1,109,0,0,0,16,212,29,140,217,143,0,178,4,233,128,9,152,236,248,66,126,106,107,0,1,0,107,0,3,1,6,4>>. diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.24619 b/erts/emulator/test/binary_SUITE_data/zzz.terms.24619 new file mode 100644 index 0000000000..e0f28775a2 --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.24619 @@ -0,0 +1 @@ +<<131,104,3,108,157,157,0,7,109,0,0,0,16,55,233,12,238,67,82,29,243,29,211,100,103,94,222,253,111,109,0,0,0,16,123,199,42,7,103,210,55,190,77,163,10,206,25,26,205,194,109,0,0,0,16,112,190,42,171,14,14,14,14,14,14,14,14,14,73,114,31,109,0,0,0,16,36,164,198,221,134,71,27,5,151,55,181,122,115,75,182,107,109,0,0,0,16,191,181,181,232,197,52,185,67,212,192,200,78,208,248,48,138,109,0,0,0,16,58,191,0,250,97,191,174,47,255,145,51,55,94,20,36,22,109,0,0,0,16,19,32,200,163,20,224,40,199,252,222,64,38,59,226,140,105,106,107,0,7,6,1,4,9,5,6,4,107,0,6,8,7,9,9,0,6>>. diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.25681 b/erts/emulator/test/binary_SUITE_data/zzz.terms.25681 new file mode 100644 index 0000000000..482d11fdf1 --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.25681 @@ -0,0 +1 @@ +<<131,104,3,108,146,146,146,146,109,0,0,0,16,5,44,160,195,30,175,203,35,219,89,215,184,2,78,94,170,106,107,0,1,4,107,0,4,2,5,3,0>>. diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.26563 b/erts/emulator/test/binary_SUITE_data/zzz.terms.26563 new file mode 100644 index 0000000000..abc33dba0a --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.26563 @@ -0,0 +1 @@ +<<131,104,3,108,174,174,174,174,174,174,174,174,174,174,174,174,174,174,174,174,174,43,35,116,53,8,115,151,70,109,0,0,0,16,46,214,206,144,145,5,5,151,216,205,186,160,20,122,56,211,109,0,0,0,16,231,252,248,228,158,57,175,60,102,175,36,111,220,245,53,223,109,0,0,0,16,11,114,118,250,109,208,21,68,191,28,20,37,85,92,109,233,109,0,0,0,16,241,70,203,137,71,9,64,196,13,97,57,45,198,58,101,16,109,0,0,0,16,55,10,73,208,111,248,3,206,218,97,250,249,167,97,111,253,106,107,0,6,10,17,13,21,18,3,107,0,22,10,24,17,24,18,11,9,2,10,5,8,13,16,12,21,3,12,15,24,15,9,11>>. diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.26744 b/erts/emulator/test/binary_SUITE_data/zzz.terms.26744 new file mode 100644 index 0000000000..5d2e0460df --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.26744 @@ -0,0 +1 @@ +<<131,104,3,108,0,0,0,34,109,0,0,0,16,246,40,48,114,226,31,172,131,140,186,199,103,184,69,163,250,109,0,0,0,16,70,137,87,84,123,59,151,104,51,248,19,182,201,216,104,107,109,0,0,0,16,75,247,173,46,233,103,101,172,74,156,58,219,100,163,0,15,109,0,0,0,16,165,61,109,30,82,118,124,174,79,99,109,226,67,30,250,201,109,0,0,0,16,171,87,99,231,11,27,105,249,22,185,117,13,190,221,68,43,109,0,0,0,16,28,138,81,135,98,250,241,78,63,129,1,111,189,226,232,62,109,0,0,0,16,140,242,136,145,115,249,196,75,89,2,77,154,77,146,188,139,109,0,0,0,16,23,94,33,183,84,175,41,135,44,181,221,17,82,139,116,240,109,0,0,0,16,25,92,169,206,39,56,163,245,227,229,124,198,10,125,58,216,109,0,0,0,16,242,242,226,156,245,143,114,37,12,97,30,171,229,203,72,148,109,0,0,0,16,88,244,34,176,67,151,108,108,108,108,108,108,108,108,108,108,108,108,108,108,108,108,44,229,66,176,163,15,18,95,127,249,160,57,55,191,22,109,0,0,0,16,216,32,191,62,114,130,211,165,62,177,139,90,101,213,148,153,109,0,0,0,16,89,69,176,67,182,240,212,246,155,244,183,194,27,76,211,241,109,0,0,0,16,89,223,126,234,29,229,230,116,177,209,128,89,205,173,125,192,109,0,0,0,16,0,223,16,80,225,217,146,95,191,172,211,105,204,53,184,0,109,0,0,0,16,109,122,166,47,188,116,57,251,215,211,182,101,15,67,248,98,109,0,0,0,16,30,14,197,5,205,206,164,77,34,144,27,11,45,20,124,37,109,0,0,0,16,120,12,166,133,0,60,236,29,97,123,234,166,243,70,225,190,109,0,0,0,16,153,158,57,172,15,245,115,49,233,53,112,251,201,28,250,95,109,0,0,0,16,253,120,180,234,85,203,127,112,237,225,193,159,73,44,64,231,109,0,0,0,16,18,51,70,243,111,230,11,148,243,73,182,43,168,82,227,129,109,0,0,0,16,61,147,55,3,76,53,153,52,117,47,51,176,153,85,97,216,109,0,0,0,16,113,142,196,76,220,119,212,32,42,51,80,42,159,137,71,183,109,0,0,0,16,207,4,245,17,147,229,41,4,66,99,23,243,85,156,222,34,109,0,0,0,16,146,201,209,199,145,105,193,201,188,11,226,207,215,23,156,30,109,0,0,0,16,141,156,48,124,183,243,196,163,40,34,165,25,34,209,206,170,109,0,0,0,16,160,252,133,213,54,168,44,75,148,247,79,183,170,194,80,228,109,0,0,0,16,221,101,172,89,69,146,157,172,253,251,151,231,116,217,76,209,109,0,0,0,16,250,199,222,195,91,93,106,169,252,80,246,217,80,160,207,76,109,0,0,0,16,146,101,163,61,212,184,154,55,158,19,200,188,141,102,164,115,109,0,0,0,16,80,97,213,9,68,43,15,183,17,103,106,252,92,177,75,49,109,0,0,0,16,14,108,183,17,228,213,68,27,3,156,218,105,141,132,206,120,109,0,0,0,16,85,46,106,151,41,124,83,229,146,32,140,249,127,187,59,96,106,107,0,34,4,7,13,36,26,38,29,4,2,9,10,38,20,41,10,38,44,44,27,38,9,20,41,19,3,41,1,19,22,14,6,37,16,9,107,0,21,29,44,0,11,30,4,5,12,45,44,11,43,11,21,42,27,45,16,44,11,46>>. diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.27459 b/erts/emulator/test/binary_SUITE_data/zzz.terms.27459 new file mode 100644 index 0000000000..8ce2f4f676 --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.27459 @@ -0,0 +1 @@ +<<131,104,3,108,0,0,0,22,109,0,0,0,16,226,66,101,167,212,253,41,123,50,225,132,86,201,118,10,221,109,0,0,0,16,169,167,250,110,49,5,132,236,14,41,12,236,33,224,162,32,109,0,0,0,16,19,212,176,127,21,145,23,227,37,69,236,192,15,15,88,151,109,0,0,0,16,59,91,152,82,86,126,247,97,138,172,127,95,45,116,239,116,109,0,0,0,16,20,167,126,55,177,97,157,117,16,231,14,242,108,48,99,108,109,0,0,0,16,164,40,48,217,95,155,48,112,128,190,231,207,101,255,133,46,109,0,0,0,16,106,176,58,142,146,193,78,37,119,98,59,15,159,223,27,213,109,0,0,0,16,11,124,59,66,82,164,203,178,45,254,62,41,149,60,186,80,109,0,0,0,16,109,178,163,249,96,68,62,121,3,244,194,251,10,56,39,200,109,0,0,0,16,212,29,140,217,143,0,178,4,233,128,9,152,236,248,66,126,109,0,0,0,16,156,22,40,137,15,93,180,84,160,180,174,215,114,13,224,148,109,0,0,0,16,93,94,191,98,203,74,126,252,62,90,216,238,14,13,138,247,109,0,0,0,16,136,233,85,1,4,240,228,125,156,73,95,136,32,15,55,89,109,0,0,0,16,142,34,55,192,14,202,6,201,109,29,102,197,165,181,70,199,109,0,0,0,16,195,209,131,241,209,212,72,96,92,244,0,245,215,133,84,79,109,0,0,0,16,125,74,14,90,3,167,45,63,216,3,89,225,61,100,248,35,109,0,0,0,16,39,87,149,29,170,91,68,106,115,163,48,196,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,252,10,34,41,217,19,207,125,36,59,89,207,34,55,138,91,109,0,0,0,16,32,110,118,6,239,38,57,44,131,209,5,122,105,63,68,184,109,0,0,0,16,27,187,87,135,62,179,16,242,240,163,46,113,111,99,144,218,109,0,0,0,16,17,40,32,235,194,249,160,229,181,252,153,106,65,252,184,124,106,107,0,22,5,23,26,4,13,21,19,25,27,0,2,10,18,2,29,11,12,5,25,8,3,17,107,0,19,21,20,0,2,18,22,1,33,3,32,20,2,19,14,19,16,19,28,33>>. diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.527 b/erts/emulator/test/binary_SUITE_data/zzz.terms.527 new file mode 100644 index 0000000000..d70c79b868 --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.527 @@ -0,0 +1 @@ +<<131,104,3,108,183,183,183,183,183,183,183,183,183,212,29,140,217,143,0,178,4,233,128,9,152,236,248,66,126,109,0,0,0,16,111,126,36,22,107,79,30,119,213,219,164,180,225,120,123,224,109,0,0,0,16,14,69,79,49,229,113,56,180,7,19,44,94,76,79,28,42,109,0,0,0,16,251,14,34,199,154,199,86,121,233,136,30,107,161,131,179,84,109,0,0,0,16,230,230,11,16,202,117,16,238,148,246,255,105,98,84,219,245,109,0,0,0,16,212,29,140,217,143,0,178,4,233,128,9,152,236,248,66,126,109,0,0,0,16,223,31,62,219,145,21,172,176,161,224,66,9,183,169,147,123,109,0,0,0,16,243,121,234,243,200,49,176,77,225,83,70,157,27,236,52,94,109,0,0,0,16,102,186,19,229,71,77,36,30,128,247,161,46,212,52,100,93,109,0,0,0,16,226,185,112,99,61,36,116,197,254,193,204,138,97,228,254,178,109,0,0,0,16,230,253,160,240,211,224,173,255,246,158,51,68,98,209,239,106,109,0,0,0,16,212,29,140,217,143,0,178,4,233,128,9,152,236,248,66,126,109,0,0,0,16,109,53,240,214,48,20,94,143,112,27,180,172,186,100,207,103,109,0,0,0,16,185,122,218,11,245,247,117,236,175,192,101,22,47,247,213,93,109,0,0,0,16,55,83,136,179,218,183,199,99,80,205,69,122,209,147,136,162,109,0,0,0,16,127,11,36,195,150,130,218,123,120,49,162,50,95,182,15,195,106,107,0,16,0,2,3,5,11,0,2,6,10,14,2,0,12,17,3,5,107,0,3,3,10,2>>. diff --git a/erts/emulator/test/binary_SUITE_data/zzz.terms.8929 b/erts/emulator/test/binary_SUITE_data/zzz.terms.8929 new file mode 100644 index 0000000000..9a31f48823 --- /dev/null +++ b/erts/emulator/test/binary_SUITE_data/zzz.terms.8929 @@ -0,0 +1 @@ +<<131,104,3,108,0,0,0,21,109,0,0,0,16,123,228,24,65,132,178,1,218,6,16,174,5,79,241,119,229,109,0,0,0,16,183,232,168,242,114,241,182,252,130,145,187,84,195,110,40,25,109,0,0,0,16,66,82,177,244,114,57,249,15,18,65,96,242,176,74,53,28,109,0,0,0,16,47,133,166,135,215,134,84,208,17,228,162,235,112,124,148,175,109,0,0,0,16,63,40,157,117,204,109,93,163,234,121,88,204,132,5,20,13,109,0,0,0,16,61,43,105,42,38,153,95,240,96,250,203,163,119,26,60,213,109,0,0,0,16,210,182,163,73,245,168,197,235,86,247,170,147,57,54,191,53,109,0,0,0,16,115,123,197,83,101,37,58,233,125,174,138,46,126,247,215,92,109,0,0,0,16,1,255,56,198,14,1,187,166,68,144,31,120,55,83,173,248,109,0,0,0,16,194,65,213,139,79,189,84,102,162,249,58,2,119,30,134,91,109,0,0,0,16,63,48,4,66,133,134,117,230,157,150,136,210,143,30,94,155,109,0,0,0,16,15,192,239,194,248,186,65,210,185,236,136,68,211,183,140,202,109,0,0,0,16,147,139,158,102,146,47,236,193,207,187,249,192,209,174,224,63,109,0,0,0,16,37,246,103,28,128,66,188,29,13,164,191,101,236,147,220,38,109,0,0,0,16,192,5,210,30,111,116,229,81,90,183,152,255,37,27,203,136,109,0,0,0,16,79,158,149,156,199,24,38,151,226,113,87,159,1,52,165,103,109,0,0,0,16,56,202,139,53,165,157,149,169,169,253,235,156,199,62,23,124,109,0,0,0,16,53,97,55,75,222,77,234,235,193,28,105,92,95,73,124,38,109,0,0,0,16,37,248,57,253,174,178,47,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,82,0,0,0,16,105,105,28,123,220,195,206,109,93,138,19,97,242,45,4,172,106,107,0,21,29,26,34,20,23,42,44,21,6,8,33,25,29,41,16,15,34,27,9,30,1,107,0,10,42,24,26,42,13,35,23,18,12,3>>. diff --git a/erts/emulator/test/bs_bincomp_SUITE.erl b/erts/emulator/test/bs_bincomp_SUITE.erl new file mode 100644 index 0000000000..4e83d97689 --- /dev/null +++ b/erts/emulator/test/bs_bincomp_SUITE.erl @@ -0,0 +1,130 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% Originally based on Per Gustafsson's test suite. +%% + +-module(bs_bincomp_SUITE). + +-export([all/1, + byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, + extended_bit_aligned/1,mixed/1,tracing/1]). + +-include("test_server.hrl"). + +all(suite) -> + [byte_aligned,bit_aligned,extended_byte_aligned, + extended_bit_aligned,mixed,tracing]. + + +byte_aligned(Config) when is_list(Config) -> + <<"abcdefg">> = << <<(X+32)>> || <> <= <<"ABCDEFG">> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <> || <> <= <<1:32,2:32,3:32,4:32>> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <> || <> <= <<1:16,2:16,3:16,4:16>> >>, + ok. + +bit_aligned(Config) when is_list(Config) -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || <> <= <<"ABCDEFG">> >>, + <<"ABCDEFG">> = + << <<(X-32)>> || <> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> >>, + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <> || <> <= <<1:31,2:31,3:31,4:31>> >>, + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <> || <> <= <<1:15,2:15,3:15,4:15>> >>, + ok. + +extended_byte_aligned(Config) when is_list(Config) -> + <<"abcdefg">> = << <<(X+32)>> || X <- "ABCDEFG" >>, + "abcdefg" = [(X+32) || <> <= <<"ABCDEFG">>], + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <> || X <- [1,2,3,4] >>, + [256,512,768,1024] = + [X || <> <= <<1:16,2:16,3:16,4:16>>], + ok. + +extended_bit_aligned(Config) when is_list(Config) -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || X <- "ABCDEFG" >>, + "ABCDEFG" = [(X-32) || <> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>], + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <> || X <- [1,2,3,4] >>, + [256,512,768,1024] = + [X || <> <= <<1:15,2:15,3:15,4:15>>], + ok. + +mixed(Config) when is_list(Config) -> + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <> <= <<1,2,3,4>>, <> <= <<1,2>> >>, + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <> <= <<1,2,3,4>>, Y <- [1,2] >>, + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || X <- [1,2,3,4], Y <- [1,2] >>, + [2,3,3,4,4,5,5,6] = + [(X+Y) || <> <= <<1,2,3,4>>, <> <= <<1,2>>], + [2,3,3,4,4,5,5,6] = + [(X+Y) || <> <= <<1,2,3,4>>, Y <- [1,2]], + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <> <= <<1:3,2:3,3:3,4:3>>, <> <= <<1:3,2:3>> >>, + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2] >>, + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || X <- [1,2,3,4], Y <- [1,2] >>, + [2,3,3,4,4,5,5,6] = + [(X+Y) || <> <= <<1:3,2:3,3:3,4:3>>, <> <= <<1:3,2:3>>], + [2,3,3,4,4,5,5,6] = + [(X+Y) || <> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]], + ok. + +%% OTP-8179: Call tracing on binary comprehensions would cause a crash. +tracing(Config) when is_list(Config) -> + Self = self(), + Tracer = spawn_opt(fun() -> tracer(Self, 0) end, + [link,{priority,max}]), + Pattern = [{'_',[],[{return_trace}]}], + erlang:trace_pattern({?MODULE,'_','_'}, Pattern, [local]), + erlang:trace(self(), true, [call,{tracer,Tracer}]), + random_binaries(1000), + Tracer ! done, + receive + {Tracer,N} -> + {comment,integer_to_list(N) ++ " trace messages"} + end. + +random_binary() -> + Seq = [1,2,3,4,5,6,7,8,9,10], + << <<($a + random:uniform($z - $a)):8>> || _ <- Seq >>. + +random_binaries(N) when N > 0 -> + random_binary(), + random_binaries(N - 1); +random_binaries(_) -> ok. + +tracer(Parent, N) -> + receive + Msg -> + case Msg of + done -> + Parent ! {self(),N}; + _ -> + tracer(Parent, N+1) + end + end. diff --git a/erts/emulator/test/bs_bit_binaries_SUITE.erl b/erts/emulator/test/bs_bit_binaries_SUITE.erl new file mode 100644 index 0000000000..52bb925385 --- /dev/null +++ b/erts/emulator/test/bs_bit_binaries_SUITE.erl @@ -0,0 +1,183 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% Originally based on Per Gustafsson's test suite. +%% + +-module(bs_bit_binaries_SUITE). + +-export([all/1, + misc/1,horrid_match/1,test_bitstr/1,test_bit_size/1,asymmetric_tests/1, + big_asymmetric_tests/1,binary_to_and_from_list/1, + big_binary_to_and_from_list/1,send_and_receive/1, + send_and_receive_alot/1,append/1]). + +-include("test_server.hrl"). + +all(suite) -> + [misc,horrid_match,test_bitstr,test_bit_size,asymmetric_tests, + big_asymmetric_tests,binary_to_and_from_list,big_binary_to_and_from_list, + send_and_receive,send_and_receive_alot,append]. + +misc(Config) when is_list(Config) -> + ?line <<1:100>> = id(<<1:100>>), + ?line {ok,ok} = {match(7),match(9)}, + ?line {ok,ok} = {match1(15),match1(31)}, + ok. + + +match(N) -> + %% Move N to a Y register to cover another instruction. + <<0:N>> = id(<<0:N>>), + <<0:N,0:1>> = id(<<0:N,0:1>>), + ok. + +match1(N) -> + %% Putting the binary inside a list will force another + %% instruction to be used. + [<<42:N/little>>] = id([<<42:N/little>>]), + ok. + +test_bit_size(Config) when is_list(Config) -> + ?line 101 = bit_size(<<1:101>>), + ?line 1001 = bit_size(<<1:1001>>), + ?line 80 = bit_size(<<1:80>>), + ?line 800 = bit_size(<<1:800>>), + ?line Bin = <<0:16#1000000>>, + ?line BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + ?line 16#10000001 = erlang:bit_size(BigBin), + %% Only run these on computers with lots of memory + %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + %% 16#100000011 = bit_size(HugeBin), + ?line 0 = bit_size(<<>>), + ok. + +horrid_match(Config) when is_list(Config) -> + ?line <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, + ?line <<42:24/little>> = B, + ok. + +test_bitstr(Config) when is_list(Config) -> + ?line <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>, + ?line <<1:1,6>> = B, + ?line B = <<1:1,6>>, + ok. + +asymmetric_tests(Config) when is_list(Config) -> + ?line <<1:12>> = <<0,1:4>>, + ?line <<0,1:4>> = <<1:12>>, + ?line <<1:1,X/bitstring>> = <<128,255,0,0:2>>, + ?line <<1,254,0,0:1>> = X, + ?line X = <<1,254,0,0:1>>, + ?line <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>, + ?line <<1,254,0,0:1>> = X1, + ?line X1 = <<1,254,0,0:1>>, + ok. + +big_asymmetric_tests(Config) when is_list(Config) -> + ?line <<1:875,1:12>> = <<1:875,0,1:4>>, + ?line <<1:875,0,1:4>> = <<1:875,1:12>>, + ?line <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>, + ?line <<1,254,0,0:1,1:875>> = X, + ?line X = <<1,254,0,0:1,1:875>>, + ?line <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>, + ?line <<1,254,0,0:1,1:875>> = X1, + ?line X1 = <<1,254,0,0:1,1:875>>, + ok. + +binary_to_and_from_list(Config) when is_list(Config) -> + ?line <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)), + ?line [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>), + ?line <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]), + ?line [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>), + ok. + +big_binary_to_and_from_list(Config) when is_list(Config) -> + ?line <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)), + ?line [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>), + ?line <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]), + ok. + +send_and_receive(Config) when is_list(Config) -> + ?line Bin = <<1,2:7>>, + Pid = spawn_link(fun() -> receiver(Bin) end), + ?line Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + ?line receive + ok -> + ok + end. + +receiver(Bin) -> + receive + {Pid,<<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok + end. + +send_and_receive_alot(Config) when is_list(Config) -> + Bin = <<1:1000001>>, + Pid = spawn_link(fun() -> receiver_alot(Bin) end), + spamalot(100,Bin,Pid). + +spamalot(N,Bin,Pid) when N > 0 -> + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end, + spamalot(N-1,Bin,Pid); +spamalot(0,_Bin,Pid) -> + Pid ! no_more, + ok. + +receiver_alot(Bin) -> + receive + {Pid,<<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok; + no_more -> ok + end, + receiver_alot(Bin). + +append(Config) when is_list(Config) -> + cs_init(), + ?line <<(-1):256/signed-unit:8>> = cs(do_append(id(<<>>), 256*8)), + ?line <<(-1):256/signed-unit:8>> = cs(do_append2(id(<<>>), 256*4)), + cs_end(). + +do_append(Bin, N) when N > 0 -> do_append(<>, N-1); +do_append(Bin, 0) -> Bin. + +do_append2(Bin, N) when N > 0 -> do_append2(<>, N-1); +do_append2(Bin, 0) -> Bin. + +cs_init() -> + erts_debug:set_internal_state(available_internal_state, true), + ok. + +cs_end() -> + erts_debug:set_internal_state(available_internal_state, false), + ok. + +%% Verify that the allocated size is exact (rounded up to the nearest byte). +cs(Bin) -> + ByteSize = byte_size(Bin), + {refc_binary,ByteSize,{binary,ByteSize},_} = + erts_debug:get_internal_state({binary_info,Bin}), + Bin. + +id(I) -> I. diff --git a/erts/emulator/test/bs_construct_SUITE.erl b/erts/emulator/test/bs_construct_SUITE.erl new file mode 100644 index 0000000000..3d9b51d278 --- /dev/null +++ b/erts/emulator/test/bs_construct_SUITE.erl @@ -0,0 +1,790 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose : Common utilities used by several optimization passes. +%% + +-module(bs_construct_SUITE). + +-export([all/1, + test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, + not_used/1, in_guard/1, + mem_leak/1, coerce_to_float/1, bjorn/1, + huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, + copy_writable_binary/1, kostis/1, dynamic/1, bs_add/1, + otp_7422/1]). + +-include("test_server.hrl"). + +all(suite) -> + [test1, test2, test3, test4, test5, testf, + not_used, in_guard, mem_leak, coerce_to_float, bjorn, + huge_float_field, huge_binary, system_limit, badarg, + copy_writable_binary, kostis, dynamic, bs_add, + otp_7422]. + +big(1) -> + 57285702734876389752897683. + +i(X) -> X. + +r(L) -> + lists:reverse(L). + +-define(T(B, L), {B, ??B, L}). +-define(N(B), {B, ??B, unknown}). + +-define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). + +-define(FAIL_VARS(Expr, Vars), ?line fail_check(catch Expr, ??Expr, Vars)). + +l(I_13, I_big1) -> + [ + ?T(<<-43>>, + [256-43]), + ?T(<<56>>, + [56]), + ?T(<<1,2>>, + [1, 2]), + ?T(<<4:4, 7:4>>, + [4*16+7]), + ?T(<<777:16/big>>, + [3, 9]), + ?T(<<777:16/little>>, + [9, 3]), + ?T(<<0.0:32/float>>, + [0,0,0,0]), + ?T(<<0.125:32/float>>, + [62,0,0,0]), + ?T(<<0.125:32/little-float>>, + [0,0,0,62]), + ?T(<>, + [138, 99, 0, 147]), + ?T(<<57285702734876389752897684:32>>, + [138, 99, 0, 148]), + ?T(<>, + r([138, 99, 0, 147])), + ?T(<<-1:17/unit:8>>, + lists:duplicate(17, 255)), + + ?T(<>, + [13]), + + ?T(<<4:8/unit:2,5:2/unit:8>>, + [0, 4, 0, 5]), + + ?T(<<1:1, 0:6, 1:1>>, + [129]), + ?T(<<1:1/little, 0:6/little, 1:1/little>>, + [129]), + + ?T(<<<<1,2>>/binary>>, + [1, 2]), + ?T(<<<<1,2>>:1/binary>>, + [1]), + ?T(<<4,3,<<1,2>>:1/binary>>, + [4,3,1]), + + ?T(<<(256*45+47)>>, + [47]), + + ?T(<<57:0>>, + []), + + ?T(<<"apa">>, + "apa"), + + ?T(<<1:3,"string",9:5>>, + [46,110,142,77,45,204,233]), + + ?T(<<>>, + []), + + ?T(<<37.98:64/native-float>>, + native_3798()), + + ?T(<<32978297842987249827298387697777669766334937:128/native-integer>>, + native_bignum()), + + %% Unit tests. + ?T(<<<<5:3>>/bitstring>>, <<5:3>>), + ?T(<<42,<<7:4>>/binary-unit:4>>, <<42,7:4>>), + ?T(<<<<344:17>>/binary-unit:17>>, <<344:17>>), + ?T(<<<<42,3,7656:16>>/binary-unit:16>>, <<42,3,7656:16>>) + + ]. + +native_3798() -> + case <<1:16/native>> of + <<0,1>> -> [64,66,253,112,163,215,10,61]; + <<1,0>> -> [61,10,215,163,112,253,66,64] + end. + +native_bignum() -> + case <<1:16/native>> of + <<0,1>> -> [129,205,18,177,1,213,170,101,39,231,109,128,176,11,73,217]; + <<1,0>> -> [217,73,11,176,128,109,231,39,101,170,213,1,177,18,205,129] + end. + +evaluate(Str, Vars) -> + {ok,Tokens,_} = + erl_scan:string(Str ++ " . "), + {ok, [Expr]} = erl_parse:parse_exprs(Tokens), + case erl_eval:expr(Expr, Vars) of + {value, Result, _} -> + Result + end. + +eval_list([], _Vars) -> + []; +eval_list([{C_bin, Str, Bytes} | Rest], Vars) -> + case catch evaluate(Str, Vars) of + {'EXIT', Error} -> + io:format("Evaluation error: ~p, ~p, ~p~n", [Str, Vars, Error]), + exit(Error); + E_bin -> + [{C_bin, E_bin, Str, Bytes} | eval_list(Rest, Vars)] + end. + +one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> + io:format(" ~s, ~p~n", [Str, Bytes]), + Bin = list_to_binary(Bytes), + if + C_bin == Bin -> + ok; + true -> + io:format("ERROR: Compiled: ~p. Expected ~p. Got ~p.~n", + [Str, Bytes, binary_to_list(C_bin)]), + test_server:fail(comp) + end, + if + E_bin == Bin -> + ok; + true -> + io:format("ERROR: Interpreted: ~p. Expected ~p. Got ~p.~n", + [Str, Bytes, binary_to_list(E_bin)]), + test_server:fail(comp) + end; +one_test({C_bin, E_bin, Str, Result}) -> + io:format(" ~s ~p~n", [Str, C_bin]), + if + C_bin == E_bin -> + ok; + true -> + Arbitrary = case Result of + unknown -> + size(C_bin); + _ -> + Result + end, + case equal_lists(binary_to_list(C_bin), + binary_to_list(E_bin), + Arbitrary) of + false -> + io:format("ERROR: Compiled not equal to interpreted:" + "~n ~p, ~p.~n", + [binary_to_list(C_bin), binary_to_list(E_bin)]), + test_server:fail(comp); + 0 -> + ok; + %% For situations where the final bits may not matter, like + %% for floats: + N when is_integer(N) -> + io:format("Info: compiled and interpreted differ in the" + " last bytes:~n ~p, ~p.~n", + [binary_to_list(C_bin), binary_to_list(E_bin)]), + ok + end + end. + +equal_lists([], [], _) -> + 0; +equal_lists([], _, _) -> + false; +equal_lists(_, [], _) -> + false; +equal_lists([A|AR], [A|BR], R) -> + equal_lists(AR, BR, R); +equal_lists(A, B, R) -> + if + length(A) /= length(B) -> + false; + length(A) =< R -> + R; + true -> + false + end. + +fail_check({'EXIT',{badarg,_}}, Str, Vars) -> + try evaluate(Str, Vars) of + Res -> + io:format("Interpreted result: ~p", [Res]), + ?t:fail(did_not_fail_in_intepreted_code) + catch + error:badarg -> + ok + end; +fail_check(Res, _, _) -> + io:format("Compiled result: ~p", [Res]), + ?t:fail(did_not_fail_in_compiled_code). + +%%% Simple working cases +test1(suite) -> []; +test1(Config) when is_list(Config) -> + ?line I_13 = i(13), + ?line I_big1 = big(1), + ?line Vars = [{'I_13', I_13}, + {'I_big1', I_big1}], + ?line lists:foreach(fun one_test/1, eval_list(l(I_13, I_big1), Vars)). + +%%% Misc + +%%% <> +comp(N, A, S) -> + M1 = (1 bsl S) - 1, + M2 = (1 bsl (N-S)) - 1, + [((A band M1) bsl (N-S)) bor (A band M2)]. + +gen(N, S, A) -> + [?T(<>, comp(N, A, S))]. + +gen_l(N, S, A) -> + [?T(<>, comp(N, A, S))]. + +test2(suite) -> []; +test2(Config) when is_list(Config) -> + ?line test2(0, 8, 2#10101010101010101), + ?line test2(0, 8, 2#1111111111). + +test2(End, End, _) -> + ok; +test2(I, End, A) -> + test2(I, A), + test2(I+1, End, A). + +test2(S, A) -> + N = 8, + Vars = [{'A',A}, {'N',N}, {'S',S}], + io:format("Vars: ~p\n", [Vars]), + lists:foreach(fun one_test/1, eval_list(gen(N, S, A), Vars)), + lists:foreach(fun one_test/1, eval_list(gen_l(N, S, A), Vars)). + +%%% Tests without facit + +t3() -> + [?N(<<4711:13, 9876:13, 3:6>>), + ?N(<<4.57:64/float>>), + ?N(<<4.57:32/float>>), + + ?N(<<>>) + ]. + +test3(suite) -> []; +test3(Config) when is_list(Config) -> + ?line Vars = [], + ?line lists:foreach(fun one_test/1, eval_list(t3(), Vars)). + +gen_u(N, S, A) -> + [?N(<>)]. + +gen_u_l(N, S, A) -> + [?N(<>)]. + +test4(suite) -> []; +test4(Config) when is_list(Config) -> + ?line test4(0, 16, 2#10101010101010101), + ?line test4(0, 16, 2#1111111111). + +test4(End, End, _) -> + ok; +test4(I, End, A) -> + test4(I, A), + test4(I+1, End, A). + +test4(S, A) -> + N = 16, + Vars = [{'A', A}, {'N', 16}, {'S', S}], + lists:foreach(fun one_test/1, eval_list(gen_u(N, S, A), Vars)), + lists:foreach(fun one_test/1, eval_list(gen_u_l(N, S, A), Vars)). + +gen_b(N, S, A) -> + [?T(<>, + binary_to_list(<>))]. + +test5(suite) -> []; +test5(doc) -> ["OTP-3995"]; +test5(Config) when is_list(Config) -> + ?line test5(0, 8, <<73>>), + ?line test5(0, 8, <<68>>). + +test5(End, End, _) -> + ok; +test5(I, End, A) -> + test5(I, A), + test5(I+1, End, A). + +test5(S, A) -> + N = 8, + Vars = [{'A', A}, {'N', 8}, {'S', S}], + lists:foreach(fun one_test/1, eval_list(gen_b(N, S, A), Vars)). + +%%% Failure cases +testf(suite) -> []; +testf(Config) when is_list(Config) -> + ?line ?FAIL(<<3.14>>), + ?line ?FAIL(<<<<1,2>>>>), + + ?line ?FAIL(<<2.71/binary>>), + ?line ?FAIL(<<24334/binary>>), + ?line ?FAIL(<<24334344294788947129487129487219847/binary>>), + BigInt = id(24334344294788947129487129487219847), + ?line ?FAIL_VARS(<>, [{'BigInt',BigInt}]), + ?line ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), + ?line ?FAIL_VARS(<>, [{'BigInt',BigInt}]), + + %% One negative field size, but the sum of field sizes will be 1 byte. + %% Make sure that we reject that properly. + I_minus_777 = id(-777), + I_minus_2047 = id(-2047), + ?line ?FAIL_VARS(<>, + ordsets:from_list([{'I_minus_777',I_minus_777}, + {'I_minus_2047',I_minus_2047}])), + ?line ?FAIL(<<<<1,2,3>>/float>>), + + %% Negative field widths. + ?line testf_1(-8, <<1,2,3,4,5>>), + ?line ?FAIL(<<0:(-(1 bsl 100))>>), + + ?line ?FAIL(<<42:(-16)>>), + ?line ?FAIL(<<3.14:(-8)/float>>), + ?line ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), + ?line ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), + ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + + %% Unit failures. + ?line ?FAIL(<<<<1:1>>/binary>>), + Sz = id(1), + ?line ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), + ?line {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), + ?line ?FAIL(<<<<7,8,9>>/binary-unit:16>>), + ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), + ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), + + ok. + +testf_1(W, B) -> + Vars = [{'W',W}], + ?FAIL_VARS(<<42:W>>, Vars), + ?FAIL_VARS(<<3.14:W/float>>, Vars), + ?FAIL_VARS(<>, [{'B',B}|Vars]). + +not_used(doc) -> + "Test that constructed binaries that are not used will still give an exception."; +not_used(Config) when is_list(Config) -> + ?line ok = not_used1(3, <<"dum">>), + ?line {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), + ?line {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), + ?line {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), + ?line {'EXIT',{badarg,_}} = (catch not_used3(444)), + ok. + +not_used1(I, BinString) -> + <>, + ok. + +not_used2(I, Sz) -> + <>, + ok. + +not_used3(I) -> + <>, + ok. + +in_guard(Config) when is_list(Config) -> + ?line 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), + ?line 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), + ?line 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + nope = in_guard(<<1>>, 42, b), + nope = in_guard(<<1>>, a, b), + nope = in_guard(<<1,2>>, 1, 1), + nope = in_guard(<<4,5>>, 1, 2.71), + nope = in_guard(<<4,5>>, 1, <<12,13>>), + ok. + +in_guard(Bin, A, B) when <> == Bin -> 1; +in_guard(Bin, A, B) when <> == Bin -> 2; +in_guard(Bin, A, B) when <> == Bin -> 3; +in_guard(Bin, A, B) when {a,b,<>} == Bin -> cant_happen; +in_guard(_, _, _) -> nope. + +mem_leak(doc) -> "Make sure that construction has no memory leak"; +mem_leak(Config) when is_list(Config) -> + ?line B = make_bin(16, <<0>>), + ?line mem_leak(1024, B), + ok. + +mem_leak(0, _) -> ok; +mem_leak(N, B) -> + ?line big_bin(B, <<23>>), + ?line {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), + maybe_gc(), + mem_leak(N-1, B). + +big_bin(B1, B2) -> + <>. + +make_bin(0, Acc) -> Acc; +make_bin(N, Acc) -> make_bin(N-1, <>). + +maybe_gc() -> + case erlang:system_info(heap_type) of + shared -> erlang:garbage_collect(); + hybrid -> erlang:garbage_collect(); + private -> ok + end. + +-define(COF(Int0), + ?line (fun(Int) -> + true = <> =:= <<(float(Int)):32/float>>, + true = <> =:= <<(float(Int)):64/float>> + end)(nonliteral(Int0)), + ?line true = <> =:= <<(float(Int0)):32/float>>, + ?line true = <> =:= <<(float(Int0)):64/float>>). + +-define(COF64(Int0), + ?line (fun(Int) -> + true = <> =:= <<(float(Int)):64/float>> + end)(nonliteral(Int0)), + ?line true = <> =:= <<(float(Int0)):64/float>>). + +nonliteral(X) -> X. + +coerce_to_float(Config) when is_list(Config) -> + ?COF(0), + ?COF(-1), + ?COF(1), + ?COF(42), + ?COF(255), + ?COF(-255), + ?COF(38474), + ?COF(387498738948729893849444444443), + ?COF(-37489378937773899999999999999993), + ?COF64(298748888888888888888888888883478264866528467367364766666666666666663), + ?COF64(-367546729879999999999947826486652846736736476555566666663), + ok. + +bjorn(Config) when is_list(Config) -> + ?line error = bjorn_1(), + ok. + +bjorn_1() -> + Bitstr = <<7:13>>, + try + do_something() + catch + throw:blurf -> + ignore + end, + do_more(Bitstr, 13). + +do_more(Bin, Sz) -> + %% Previous bug in the bs_bits_to_bytes instruction: The exeption code + %% was not set - the previous exception (throw:blurf) would be used, + %% causing the catch to slip. + try <> of + _V -> ok + catch + error:_ -> + error + end. + +do_something() -> + throw(blurf). + +huge_float_field(Config) when is_list(Config) -> + ?line {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), + ?line huge_float_check(catch <<0.0:67108865/float-unit:64>>), + ?line huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), + ?line huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), +%% ?line huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), + ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), +%% ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), + ok. + +huge_float_check({'EXIT',{system_limit,_}}) -> ok; +huge_float_check({'EXIT',{badarg,_}}) -> ok. + +huge_binary(Config) when is_list(Config) -> + ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), + ok. + +system_limit(Config) when is_list(Config) -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + ?line {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + ?line {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + ok. + +badarg(Config) when is_list(Config) -> + ?line {'EXIT',{badarg,_}} = + (catch <<0:(id(1 bsl 100)),0:(id(-1))>>), + ?line {'EXIT',{badarg,_}} = + (catch <<0:(id(1 bsl 100)),0:(id(-(1 bsl 70)))>>), + ?line {'EXIT',{badarg,_}} = + (catch <<0:(id(-(1 bsl 70))),0:(id(1 bsl 100))>>), + + ?line {'EXIT',{badarg,_}} = + (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), + + ok. + +copy_writable_binary(Config) when is_list(Config) -> + ?line [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], + ok. + +copy_writable_binary_1(_) -> + ?line Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, + ?line SubBin = make_sub_bin(Bin0), + ?line id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. + ?line Pid = spawn(fun() -> + copy_writable_binary_holder(Bin0, SubBin) + end), + ?line Tab = ets:new(holder, []), + ?line ets:insert(Tab, {17,Bin0}), + ?line ets:insert(Tab, {42,SubBin}), + ?line id(<>), + ?line Pid ! self(), + ?line [{17,Bin0}] = ets:lookup(Tab, 17), + ?line [{42,Bin0}] = ets:lookup(Tab, 42), + receive + {Pid,Bin0,Bin0} -> ok; + Other -> + io:format("Unexpected message: ~p", [Other]), + ?line ?t:fail() + end, + ok. + +copy_writable_binary_holder(Bin, SubBin) -> + receive + Pid -> + Pid ! {self(),Bin,SubBin} + end. + +make_sub_bin(Bin0) -> + N = bit_size(Bin0), + <<_:17,Bin:N/bitstring,_:5>> = <<(-1):17,Bin0/bitstring,(-1):5>>, + Bin = Bin0, %Assertion. + Bin. + +%% Make sure that bit syntax expression with huge field size are +%% not constructed at compile time. + +kostis(Config) when is_list(Config) -> + case have_250_terabytes_of_ram() of + true -> + Bin = <<0:800000000000>>, + EmbeddedBin = <<0,(<<0:99999999999>>)/bitstring,1>>, + Bin0 = list_to_binary([Bin,Bin,Bin,Bin,Bin]), + Bin1 = list_to_binary([Bin0,Bin0,Bin0,Bin0,Bin0,Bin0]), + Bin2 = list_to_binary([Bin1,Bin1]), + id({EmbeddedBin,Bin0,Bin1,Bin2}); + false -> + ok + end. + +%% I'm not even certain how much 250 TB really is... +%% but I'm sure I don't have it :-) + +have_250_terabytes_of_ram() -> false. + +%% Test that different ways of using bit syntax instructions +%% give the same result. + +dynamic(Config) when is_list(Config) -> + ?line dynamic_1(fun dynamic_big/5), + ?line dynamic_1(fun dynamic_little/5), + ok. + +dynamic_1(Dynamic) -> + <> = erlang:md5([0]), + <> = erlang:md5([1]), + <> = erlang:md5([2]), + 8385 = dynamic_2(0, {Int,Lpad,Rpad,Dynamic}, 0). + +dynamic_2(129, _, Count) -> Count; +dynamic_2(Bef, Data, Count0) -> + Count = dynamic_3(Bef, 128-Bef, Data, Count0), + dynamic_2(Bef+1, Data, Count). + +dynamic_3(_, -1, _, Count) -> Count; +dynamic_3(Bef, N, {Int0,Lpad,Rpad,Dynamic}=Data, Count) -> + Int1 = Int0 band ((1 bsl (N+3))-1), + Dynamic(Bef, N, Int1, Lpad, Rpad), + Dynamic(Bef, N, -Int1, Lpad, Rpad), + + %% OTP-7085: Test a small number in a wide field. + Int2 = Int0 band 16#FFFFFF, + Dynamic(Bef, N, Int2, Lpad, Rpad), + Dynamic(Bef, N, -Int2, Lpad, Rpad), + dynamic_3(Bef, N-1, Data, Count+1). + +dynamic_big(Bef, N, Int, Lpad, Rpad) -> + NumBin = id(<>), + MaskedInt = Int band ((1 bsl N) - 1), + <> = NumBin, + + %% Construct the binary in two different ways. + Bin = id(<>), + Bin = <>, + + %% Further verify the result by matching. + LpadMasked = Lpad band ((1 bsl Bef) - 1), + RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1), + Rbits = (128-Bef-N), + <> = id(Bin), + ok. + +dynamic_little(Bef, N, Int, Lpad, Rpad) -> + NumBin = id(<>), + MaskedInt = Int band ((1 bsl N) - 1), + <> = NumBin, + + %% Construct the binary in two different ways. + Bin = id(<>), + Bin = <>, + + %% Further verify the result by matching. + LpadMasked = Lpad band ((1 bsl Bef) - 1), + RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1), + Rbits = (128-Bef-N), + <> = id(Bin), + ok. + +%% Test that the bs_add/5 instruction handles big numbers correctly. +bs_add(Config) when is_list(Config) -> + Mod = bs_construct_bs_add, + N = 2000, + Code = [{module, Mod}, + {exports, [{bs_add,2}]}, + {labels, 2}, + + %% bs_add(Number, -SmallestBig) -> Number + N + {function, bs_add, 2, 2}, + {label,1}, + {func_info,{atom,Mod},{atom,bs_add},2}, + + {label,2}, + {move,{x,0},{x,2}}] ++ + lists:duplicate(N-1, {bs_add,{f,0},[{x,2},{integer,1},1],{x,2}}) ++ + [{gc_bif,abs,{f,0},3,[{x,1}],{x,4}}, %Force GC, ignore result. + {gc_bif,'+',{f,0},3,[{x,2},{integer,1}],{x,0}}, %Safe result in {x,0} + return], + + %% Write assembly file and assemble it. + ?line PrivDir = ?config(priv_dir, Config), + ?line RootName = filename:join(PrivDir, atom_to_list(Mod)), + ?line AsmFile = RootName ++ ".S", + ?line {ok,Fd} = file:open(AsmFile, [write]), + ?line [io:format(Fd, "~p. \n", [T]) || T <- Code], + ?line ok = file:close(Fd), + ?line {ok,Mod} = compile:file(AsmFile, [from_asm,report,{outdir,PrivDir}]), + ?line LoadRc = code:load_abs(RootName), + ?line {module,_Module} = LoadRc, + + %% Find smallest positive bignum. + ?line SmallestBig = smallest_big(), + ?line io:format("~p\n", [SmallestBig]), + ?line Expected = SmallestBig + N, + DoTest = fun() -> + exit(Mod:bs_add(SmallestBig, -SmallestBig)) + end, + ?line {Pid,Mref} = spawn_monitor(DoTest), + receive + {'DOWN',Mref,process,Pid,Res} -> ok + end, + ?line Expected = Res, + + %% Clean up. + ?line ok = file:delete(AsmFile), + ?line ok = file:delete(code:which(Mod)), + ok. + + +smallest_big() -> + smallest_big_1(1 bsl 24). + +smallest_big_1(N) -> + case erts_debug:flat_size(N) of + 0 -> smallest_big_1(N+N); + _ -> N + end. + +otp_7422(Config) when is_list(Config) -> + otp_7422_int(0), + otp_7422_bin(0). + +otp_7422_int(N) when N < 512 -> + T = erlang:make_tuple(N, []), + spawn_link(fun() -> + id(T), + %% A size of field 0 would write one byte beyond + %% the current position in the binary. It could + %% overwrite the continuation pointer stored on + %% the stack if HTOP was equal to E (the stack pointer). + id(<<0:(id(0))>>) + end), + otp_7422_int(N+1); +otp_7422_int(_) -> ok. + +otp_7422_bin(N) when N < 512 -> + T = erlang:make_tuple(N, []), + Z = id(<<>>), + spawn_link(fun() -> + id(T), + id(<>) + end), + otp_7422_bin(N+1); +otp_7422_bin(_) -> ok. + +id(I) -> I. diff --git a/erts/emulator/test/bs_match_bin_SUITE.erl b/erts/emulator/test/bs_match_bin_SUITE.erl new file mode 100644 index 0000000000..3d054a279f --- /dev/null +++ b/erts/emulator/test/bs_match_bin_SUITE.erl @@ -0,0 +1,195 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(bs_match_bin_SUITE). + +-export([all/1,byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). + +-include("test_server.hrl"). + +all(suite) -> + [byte_split_binary,bit_split_binary,match_huge_bin]. + +byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions."; +byte_split_binary(Config) when is_list(Config) -> + ?line L = lists:seq(0, 57), + ?line B = mkbin(L), + ?line byte_split(L, B, size(B)), + ?line Unaligned = make_unaligned_sub_binary(B), + ?line byte_split(L, Unaligned, size(Unaligned)). + +byte_split(L, B, Pos) when Pos >= 0 -> + ?line Sz1 = Pos, + ?line Sz2 = size(B) - Pos, + ?line <> = B, + ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), + ?line B2 = list_to_binary(lists:nthtail(Pos, L)), + ?line byte_split(L, B, Pos-1); +byte_split(_, _, _) -> ok. + +bit_split_binary(doc) -> "Tries to split a binary at all positions."; +bit_split_binary(Config) when is_list(Config) -> + Fun = fun(Bin, List, SkipBef, N) -> + ?line SkipAft = 8*size(Bin) - N - SkipBef, + %%io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), + ?line <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, + ?line OutBin = make_bin_from_list(List, N) + end, + ?line bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), + ?line bit_split_binary1(Fun, + make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))), + ok. + +bit_split_binary1(Action, Bin) -> + BitList = bits_to_list(binary_to_list(Bin), 16#80), + bit_split_binary2(Action, Bin, BitList, 0). + +bit_split_binary2(Action, Bin, [_|T]=List, Bef) -> + bit_split_binary3(Action, Bin, List, Bef, size(Bin)*8), + bit_split_binary2(Action, Bin, T, Bef+1); +bit_split_binary2(_, _, [], _) -> ok. + +bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> + Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), + bit_split_binary3(Action, Bin, List, Bef, Aft-8); +bit_split_binary3(_, _, _, _, _) -> ok. + +make_bin_from_list(_, 0) -> mkbin([]); +make_bin_from_list(List, N) -> + list_to_binary([make_int(List, 8, 0), + make_bin_from_list(lists:nthtail(8, List), N-8)]). + + +make_int(_, 0, Acc) -> Acc; +make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). + +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([H|_]=List, Mask) -> + [case H band Mask of + 0 -> 0; + _ -> 1 + end|bits_to_list(List, Mask bsr 1)]; +bits_to_list([], _) -> []. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +make_unaligned_sub_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +id(I) -> I. + +match_huge_bin(Config) when is_list(Config) -> + ?line Bin = <<0:(1 bsl 27),13:8>>, + ?line skip_huge_bin_1(1 bsl 27, Bin), + ?line 16777216 = match_huge_bin_1(1 bsl 27, Bin), + + %% Test overflowing the size of a binary field. + ?line nomatch = overflow_huge_bin_skip_32(Bin), + ?line nomatch = overflow_huge_bin_32(Bin), + ?line nomatch = overflow_huge_bin_skip_64(Bin), + ?line nomatch = overflow_huge_bin_64(Bin), + + %% Size in variable + ?line ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ?line ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + + ok. + +overflow_huge_bin(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/binary-unit:8,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <> -> + {error,Sz,size(NewBin)}; + _ -> + overflow_huge_bin(Bin, Sizes) + end + end; +overflow_huge_bin(_, []) -> ok. + +overflow_huge_bin_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/binary-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <> -> + {error,Sz,size(NewBin)}; + _ -> + overflow_huge_bin_unit128(Bin, Sizes) + end + end; +overflow_huge_bin_unit128(_, []) -> ok. + +skip_huge_bin_1(I, Bin) -> + <<_:I/binary-unit:1,13>> = Bin, + ok. + +match_huge_bin_1(I, Bin) -> + case Bin of + <> -> size(Val); + _ -> nomatch + end. + +overflow_huge_bin_skip_32(<<_:4294967296/binary,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_bin_skip_32(<<_:33554432/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_bin_skip_32(<<_:67108864/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_bin_skip_32(<<_:134217728/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_bin_skip_32(<<_:268435456/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_bin_skip_32(<<_:536870912/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_bin_skip_32(<<_:1073741824/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_bin_skip_32(<<_:2147483648/binary-unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_bin_skip_32(_) -> nomatch. + +overflow_huge_bin_32(<>) -> {1,Bin}; % 1 bsl 32 +overflow_huge_bin_32(<>) -> {2,Bin}; % 1 bsl 25 +overflow_huge_bin_32(<>) -> {3,Bin}; % 1 bsl 26 +overflow_huge_bin_32(<>) -> {4,Bin}; % 1 bsl 27 +overflow_huge_bin_32(<>) -> {5,Bin}; % 1 bsl 28 +overflow_huge_bin_32(<>) -> {6,Bin}; % 1 bsl 29 +overflow_huge_bin_32(<>) -> {7,Bin}; % 1 bsl 30 +overflow_huge_bin_32(<>) -> {8,Bin}; % 1 bsl 31 +overflow_huge_bin_32(_) -> nomatch. + +overflow_huge_bin_skip_64(<<_:18446744073709551616/binary,0,_/binary>>) -> 1; % 1 bsl 64 +overflow_huge_bin_skip_64(<<_:144115188075855872/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 57 +overflow_huge_bin_skip_64(<<_:288230376151711744/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 58 +overflow_huge_bin_skip_64(<<_:576460752303423488/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 59 +overflow_huge_bin_skip_64(<<_:1152921504606846976/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 60 +overflow_huge_bin_skip_64(<<_:2305843009213693952/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 61 +overflow_huge_bin_skip_64(<<_:4611686018427387904/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 62 +overflow_huge_bin_skip_64(<<_:9223372036854775808/binary-unit:8,_/binary>>) -> 8; % 1 bsl 63 +overflow_huge_bin_skip_64(_) -> nomatch. + +overflow_huge_bin_64(<>) -> {1,Bin}; % 1 bsl 64 +overflow_huge_bin_64(<>) -> {2,Bin}; % 1 bsl 57 +overflow_huge_bin_64(<>) -> {3,Bin}; % 1 bsl 58 +overflow_huge_bin_64(<>) -> {4,Bin}; % 1 bsl 59 +overflow_huge_bin_64(<>) -> {5,Bin}; % 1 bsl 60 +overflow_huge_bin_64(<>) -> {6,Bin}; % 1 bsl 61 +overflow_huge_bin_64(<>) -> {7,Bin}; % 1 bsl 62 +overflow_huge_bin_64(<>) -> {8,Bin}; % 1 bsl 63 +overflow_huge_bin_64(_) -> nomatch. diff --git a/erts/emulator/test/bs_match_int_SUITE.erl b/erts/emulator/test/bs_match_int_SUITE.erl new file mode 100644 index 0000000000..99dee7c7bc --- /dev/null +++ b/erts/emulator/test/bs_match_int_SUITE.erl @@ -0,0 +1,331 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +-module(bs_match_int_SUITE). + +-export([all/1,integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, + match_huge_int/1,bignum/1,unaligned_32_bit/1]). + +-include("test_server.hrl"). + +-import(lists, [seq/2]). + +all(suite) -> + [integer,signed_integer,dynamic,more_dynamic,mml,match_huge_int,bignum, + unaligned_32_bit]. + +integer(Config) when is_list(Config) -> + ?line 0 = get_int(mkbin([])), + ?line 0 = get_int(mkbin([0])), + ?line 42 = get_int(mkbin([42])), + ?line 255 = get_int(mkbin([255])), + ?line 256 = get_int(mkbin([1,0])), + ?line 257 = get_int(mkbin([1,1])), + ?line 258 = get_int(mkbin([1,2])), + ?line 258 = get_int(mkbin([1,2])), + ?line 65534 = get_int(mkbin([255,254])), + ?line 16776455 = get_int(mkbin([255,253,7])), + ?line 4245492555 = get_int(mkbin([253,13,19,75])), + ?line 4294967294 = get_int(mkbin([255,255,255,254])), + ?line 4294967295 = get_int(mkbin([255,255,255,255])), + ?line Eight = [200,1,19,128,222,42,97,111], + ?line cmp128(Eight, uint(Eight)), + ?line fun_clause(catch get_int(mkbin(seq(1,5)))), + ok. + +get_int(Bin) -> + I = get_int1(Bin), + get_int(Bin, I). + +get_int(Bin0, I) when size(Bin0) < 4 -> + Bin = <<0,Bin0/binary>>, + I = get_int1(Bin), + get_int(Bin, I); +get_int(_, I) -> I. + +get_int1(<>) -> I; +get_int1(<>) -> I; +get_int1(<>) -> I; +get_int1(<>) -> I; +get_int1(<>) -> I. + +cmp128(<>, I) -> equal; +cmp128(_, _) -> not_equal. + +signed_integer(Config) when is_list(Config) -> + ?line {no_match,_} = sint(mkbin([])), + ?line {no_match,_} = sint(mkbin([1,2,3])), + ?line 127 = sint(mkbin([127])), + ?line -1 = sint(mkbin([255])), + ?line -128 = sint(mkbin([128])), + ?line 42 = sint(mkbin([42,255])), + ?line 127 = sint(mkbin([127,255])). + +sint(Bin) -> + case Bin of + <> -> I; + <> -> I; + Other -> {no_match,Other} + end. + +uint(L) -> uint(L, 0). +uint([H|T], Acc) -> uint(T, Acc bsl 8 bor H); +uint([], Acc) -> Acc. + +dynamic(Config) when is_list(Config) -> + dynamic(mkbin([255]), 8), + dynamic(mkbin([255,255]), 16), + dynamic(mkbin([255,255,255]), 24), + dynamic(mkbin([255,255,255,255]), 32), + ok. + +dynamic(Bin, S1) when S1 >= 0 -> + S2 = size(Bin) * 8 - S1, + dynamic(Bin, S1, S2, (1 bsl S1) - 1, (1 bsl S2) - 1), + dynamic(Bin, S1-1); +dynamic(_, _) -> ok. + +dynamic(Bin, S1, S2, A, B) -> +% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + case Bin of + <> -> + io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + ok; + _Other -> erlang:error(badmatch, [Bin,S1,S2,A,B]) + end. + +more_dynamic(doc) -> "Extract integers at different alignments and of different sizes."; +more_dynamic(Config) when is_list(Config) -> + + % Unsigned big-endian numbers. + Unsigned = fun(Bin, List, SkipBef, N) -> + SkipAft = 8*size(Bin) - N - SkipBef, + <<_:SkipBef,Int:N,_:SkipAft>> = Bin, + Int = make_int(List, N, 0) + end, + ?line more_dynamic1(Unsigned, erlang:md5(mkbin([42]))), + + %% Signed big-endian numbers. + Signed = fun(Bin, List, SkipBef, N) -> + SkipAft = 8*size(Bin) - N - SkipBef, + <<_:SkipBef,Int:N/signed,_:SkipAft>> = Bin, + case make_signed_int(List, N) of + Int -> ok; + Other -> + io:format("Bin = ~p,", [Bin]), + io:format("SkipBef = ~p, N = ~p", [SkipBef,N]), + io:format("Expected ~p, got ~p", [Int,Other]), + ?t:fail() + end + end, + ?line more_dynamic1(Signed, erlang:md5(mkbin([43]))), + + %% Unsigned little-endian numbers. + UnsLittle = fun(Bin, List, SkipBef, N) -> + SkipAft = 8*size(Bin) - N - SkipBef, + <<_:SkipBef,Int:N/little,_:SkipAft>> = Bin, + Int = make_int(big_to_little(List, N), N, 0) + end, + ?line more_dynamic1(UnsLittle, erlang:md5(mkbin([44]))), + + %% Signed little-endian numbers. + SignLittle = fun(Bin, List, SkipBef, N) -> + SkipAft = 8*size(Bin) - N - SkipBef, + <<_:SkipBef,Int:N/signed-little,_:SkipAft>> = Bin, + Little = big_to_little(List, N), + Int = make_signed_int(Little, N) + end, + ?line more_dynamic1(SignLittle, erlang:md5(mkbin([45]))), + + ok. + +more_dynamic1(Action, Bin) -> + BitList = bits_to_list(binary_to_list(Bin), 16#80), + more_dynamic2(Action, Bin, BitList, 0). + +more_dynamic2(Action, Bin, [_|T]=List, Bef) -> + more_dynamic3(Action, Bin, List, Bef, size(Bin)*8), + more_dynamic2(Action, Bin, T, Bef+1); +more_dynamic2(_, _, [], _) -> ok. + +more_dynamic3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> +%% io:format("~p, ~p", [Bef,Aft-Bef]), + Action(Bin, List, Bef, Aft-Bef), + more_dynamic3(Action, Bin, List, Bef, Aft-1); +more_dynamic3(_, _, _, _, _) -> ok. + +big_to_little(List, N) -> big_to_little(List, N, []). + +big_to_little([B0,B1,B2,B3,B4,B5,B6,B7|T], N, Acc) when N >= 8 -> + big_to_little(T, N-8, [B0,B1,B2,B3,B4,B5,B6,B7|Acc]); +big_to_little(List, N, Acc) -> lists:sublist(List, 1, N) ++ Acc. + +make_signed_int(_List, 0) -> 0; +make_signed_int([0|_]=List, N) -> make_int(List, N, 0); +make_signed_int([1|_]=List0, N) -> + List1 = reversed_sublist(List0, N, []), + List2 = two_complement_and_reverse(List1, 1, []), + -make_int(List2, length(List2), 0). + +reversed_sublist(_List, 0, Acc) -> Acc; +reversed_sublist([H|T], N, Acc) -> reversed_sublist(T, N-1, [H|Acc]). + +two_complement_and_reverse([H|T], Carry, Acc) -> + Sum = 1-H+Carry, + two_complement_and_reverse(T, Sum div 2, [Sum rem 2|Acc]); +two_complement_and_reverse([], Carry, Acc) -> [Carry|Acc]. + +make_int(_List, 0, Acc) -> Acc; +make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). + +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([H|_]=List, Mask) -> + [case H band Mask of + 0 -> 0; + _ -> 1 + end|bits_to_list(List, Mask bsr 1)]; +bits_to_list([], _) -> []. + +fun_clause({'EXIT',{function_clause,_}}) -> ok. +mkbin(L) when is_list(L) -> list_to_binary(L). + + +mml(Config) when is_list(Config) -> + ?line single_byte_binary = mml_choose(<<42>>), + ?line multi_byte_binary = mml_choose(<<42,43>>). + +mml_choose(<<_A:8>>) -> single_byte_binary; +mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary. + +match_huge_int(Config) when is_list(Config) -> + Sz = 1 bsl 27, + ?line Bin = <<0:Sz,13:8>>, + ?line skip_huge_int_1(Sz, Bin), + ?line 0 = match_huge_int_1(Sz, Bin), + + %% Test overflowing the size of an integer field. + ?line nomatch = overflow_huge_int_skip_32(Bin), + case erlang:system_info(wordsize) of + 4 -> + ?line nomatch = overflow_huge_int_32(Bin); + 8 -> + %% An attempt will be made to allocate heap space for + %% the bignum (which will probably fail); only if the + %% allocation succeds will the matching fail because + %% the binary is too small. + ok + end, + ?line nomatch = overflow_huge_int_skip_64(Bin), + ?line nomatch = overflow_huge_int_64(Bin), + + %% Test overflowing the size of an integer field using variables as sizes. + ?line Sizes = case erlang:system_info(wordsize) of + 4 -> lists:seq(25, 32); + 8 -> [] + end ++ lists:seq(50, 64), + ?line ok = overflow_huge_int_unit128(Bin, Sizes), + + ok. + +overflow_huge_int_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <> -> + {error,Sz,Var}; + _ -> + overflow_huge_int_unit128(Bin, Sizes) + end + end; +overflow_huge_int_unit128(_, []) -> ok. + +match_huge_int_1(I, Bin) -> + <> = Bin, + Int. + +skip_huge_int_1(I, Bin) -> + <<_:I,13>> = Bin. + +overflow_huge_int_skip_32(<<_:4294967296,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_int_skip_32(<<_:33554432/unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_int_skip_32(<<_:67108864/unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_int_skip_32(<<_:134217728/unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_int_skip_32(<<_:268435456/unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_int_skip_32(<<_:536870912/unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_int_skip_32(<<_:1073741824/unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_int_skip_32(<<_:2147483648/unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_int_skip_32(_) -> nomatch. + +overflow_huge_int_32(<>) -> {1,Int}; % 1 bsl 32 +overflow_huge_int_32(<>) -> {2,Int}; % 1 bsl 25 +overflow_huge_int_32(<>) -> {3,Int}; % 1 bsl 26 +overflow_huge_int_32(<>) -> {4,Int}; % 1 bsl 27 +overflow_huge_int_32(<>) -> {5,Int}; % 1 bsl 28 +overflow_huge_int_32(<>) -> {6,Int}; % 1 bsl 29 +overflow_huge_int_32(<>) -> {7,Int}; % 1 bsl 30 +overflow_huge_int_32(<>) -> {8,Int}; % 1 bsl 31 +overflow_huge_int_32(_) -> nomatch. + +overflow_huge_int_skip_64(<<_:18446744073709551616,_/binary>>) -> 1; % 1 bsl 64 +overflow_huge_int_skip_64(<<_:144115188075855872/unit:128,0,_/binary>>) -> 2; % 1 bsl 57 +overflow_huge_int_skip_64(<<_:288230376151711744/unit:64,0,_/binary>>) -> 3; % 1 bsl 58 +overflow_huge_int_skip_64(<<_:576460752303423488/unit:32,0,_/binary>>) -> 4; % 1 bsl 59 +overflow_huge_int_skip_64(<<_:1152921504606846976/unit:16,0,_/binary>>) -> 5; % 1 bsl 60 +overflow_huge_int_skip_64(<<_:2305843009213693952/unit:8,0,_/binary>>) -> 6; % 1 bsl 61 +overflow_huge_int_skip_64(<<_:4611686018427387904/unit:8,0,_/binary>>) -> 7; % 1 bsl 62 +overflow_huge_int_skip_64(<<_:9223372036854775808/unit:8,0,_/binary>>) -> 8; % 1 bsl 63 +overflow_huge_int_skip_64(_) -> nomatch. + +overflow_huge_int_64(<>) -> {1,Int}; % 1 bsl 64 +overflow_huge_int_64(<>) -> {2,Int}; % 1 bsl 57 +overflow_huge_int_64(<>) -> {3,Int}; % 1 bsl 58 +overflow_huge_int_64(<>) -> {4,Int}; % 1 bsl 59 +overflow_huge_int_64(<>) -> {5,Int}; % 1 bsl 60 +overflow_huge_int_64(<>) -> {6,Int}; % 1 bsl 61 +overflow_huge_int_64(<>) -> {7,Int}; % 1 bsl 62 +overflow_huge_int_64(<>) -> {8,Int}; % 1 bsl 63 +overflow_huge_int_64(_) -> nomatch. + +bignum(Config) when is_list(Config) -> + ?line Bin = id(<<42,0:1024/unit:8,43>>), + ?line <<42:1025/little-integer-unit:8,_:8>> = Bin, + ?line <<_:8,43:1025/integer-unit:8>> = Bin, + + ?line BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), + ?line <<258254417031933722623:(512+9)/unit:8>> = BignumBin, + erlang:garbage_collect(), %Search for holes in debug-build. + ok. + +unaligned_32_bit(Config) when is_list(Config) -> + %% There used to be a risk for heap overflow (fixed in R11B-5). + ?line L = unaligned_32_bit_1(<<-1:(64*1024)>>), + ?line unaligned_32_bit_verify(L, 1638). + +unaligned_32_bit_1(<<1:1,U:32,_:7,T/binary>>) -> + [U|unaligned_32_bit_1(T)]; +unaligned_32_bit_1(_) -> + []. + +unaligned_32_bit_verify([], 0) -> ok; +unaligned_32_bit_verify([4294967295|T], N) when N > 0 -> + unaligned_32_bit_verify(T, N-1). + +id(I) -> I. diff --git a/erts/emulator/test/bs_match_misc_SUITE.erl b/erts/emulator/test/bs_match_misc_SUITE.erl new file mode 100644 index 0000000000..6de2ef67e5 --- /dev/null +++ b/erts/emulator/test/bs_match_misc_SUITE.erl @@ -0,0 +1,537 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(bs_match_misc_SUITE). + +-export([all/1,bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, + kenneth/1,encode_binary/1,native/1,happi/1, + size_var/1,wiger/1,x0_context/1,huge_float_field/1, + writable_binary_matched/1,otp_7198/1]). + +-include("test_server.hrl"). + +all(suite) -> + [bound_var,bound_tail,t_float,little_float,sean, + kenneth,encode_binary,native,happi, + size_var,wiger,x0_context,huge_float_field, + writable_binary_matched,otp_7198]. + +bound_var(doc) -> "Test matching of bound variables."; +bound_var(Config) when is_list(Config) -> + ?line ok = bound_var(42, 13, <<42,13>>), + ?line nope = bound_var(42, 13, <<42,255>>), + ?line nope = bound_var(42, 13, <<154,255>>), + ok. + +bound_var(A, B, <>) -> ok; +bound_var(_, _, _) -> nope. + +bound_tail(doc) -> "Test matching of a bound tail."; +bound_tail(Config) when is_list(Config) -> + ?line ok = bound_tail(<<>>, <<13,14>>), + ?line ok = bound_tail(<<2,3>>, <<1,1,2,3>>), + ?line nope = bound_tail(<<2,3>>, <<1,1,2,7>>), + ?line nope = bound_tail(<<2,3>>, <<1,1,2,3,4>>), + ?line nope = bound_tail(<<2,3>>, <<>>), + ok. + +bound_tail(T, <<_:16,T/binary>>) -> ok; +bound_tail(_, _) -> nope. + +t_float(Config) when is_list(Config) -> + F = f1(), + G = f_one(), + + ?line G = match_float(<<63,128,0,0>>, 32, 0), + ?line G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), + + ?line fcmp(F, match_float(<>, 32, 0)), + ?line fcmp(F, match_float(<>, 64, 0)), + ?line fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), + ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + ?line fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), + ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + + ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), + ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), + + ok. + + +fcmp(F1, F2) when (F1 - F2) / F2 < 0.0000001 -> ok. + +match_float(Bin0, Fsz, I) -> + Bin = make_sub_bin(Bin0), + Bsz = size(Bin) * 8, + Tsz = Bsz - Fsz - I, + <<_:I,F:Fsz/float,_:Tsz>> = Bin, + F. + +little_float(Config) when is_list(Config) -> + F = f2(), + G = f_one(), + + ?line G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), + ?line G = match_float_little(<<0,0,128,63>>, 32, 0), + + ?line fcmp(F, match_float_little(<>, 32, 0)), + ?line fcmp(F, match_float_little(<>, 64, 0)), + ?line fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), + ?line fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), + ?line fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), + ?line fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), + + ok. + +match_float_little(Bin0, Fsz, I) -> + Bin = make_sub_bin(Bin0), + Bsz = size(Bin) * 8, + Tsz = Bsz - Fsz - I, + <<_:I,F:Fsz/float-little,_:Tsz>> = Bin, + F. + + +make_sub_bin(Bin0) -> + Sz = size(Bin0), + Bin1 = <<37,Bin0/binary,38,39>>, + <<_:8,Bin:Sz/binary,_:8,_:8>> = Bin1, + Bin. + +f1() -> + 3.1415. + +f2() -> + 2.7133. + +f_one() -> + 1.0. + +sean(Config) when is_list(Config) -> + ?line small = sean1(<<>>), + ?line small = sean1(<<1>>), + ?line small = sean1(<<1,2>>), + ?line small = sean1(<<1,2,3>>), + ?line large = sean1(<<1,2,3,4>>), + + ?line small = sean1(<<4>>), + ?line small = sean1(<<4,5>>), + ?line small = sean1(<<4,5,6>>), + ?line {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), + ok. + +sean1(<>) when byte_size(B) < 4 -> small; +sean1(<<1, _B/binary>>) -> large. + +kenneth(Config) when is_list(Config) -> + {ok,[145,148,113,129,0,0,0,0]} = + msisdn_internal_storage(<<145,148,113,129,0,0,0,0>>, []). + +msisdn_internal_storage(<<>>,MSISDN) -> + {ok,lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>,MSISDN) -> + {ok,lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>,MSISDN) when + DigitN < 10 -> + {ok,lists:reverse([(DigitN bor 2#11110000)|MSISDN])}; +msisdn_internal_storage(<>,MSISDN) when + DigitNplus1 < 10, + DigitN < 10 -> + NewMSISDN=[((DigitNplus1 bsl 4) bor DigitN)|MSISDN], + msisdn_internal_storage(Rest,NewMSISDN); +msisdn_internal_storage(_Rest,_MSISDN) -> + {fault}. %% Mandatory IE incorrect + +encode_binary(Config) when is_list(Config) -> + "C2J2QiSc" = encodeBinary(<<11,98,118,66,36,156>>, []), + ok. + +encodeBinary(<<>>, Output) -> + lists:reverse(Output); +encodeBinary(<>, Output) -> + <> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = "=", + Char4 = "=", + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(<<>>, NewOutput); +encodeBinary(<>, Output) -> + <> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = getBase64Char(DChar3), + Char4 = "=", + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(<<>>, NewOutput); +encodeBinary(<>, Output) -> + <> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = getBase64Char(DChar3), + Char4 = getBase64Char(DChar4), + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(Rest, NewOutput); +encodeBinary(_Data, _) -> + error. + +getBase64Char(0) -> "A"; +getBase64Char(1) -> "B"; +getBase64Char(2) -> "C"; +getBase64Char(3) -> "D"; +getBase64Char(4) -> "E"; +getBase64Char(5) -> "F"; +getBase64Char(6) -> "G"; +getBase64Char(7) -> "H"; +getBase64Char(8) -> "I"; +getBase64Char(9) -> "J"; +getBase64Char(10) -> "K"; +getBase64Char(11) -> "L"; +getBase64Char(12) -> "M"; +getBase64Char(13) -> "N"; +getBase64Char(14) -> "O"; +getBase64Char(15) -> "P"; +getBase64Char(16) -> "Q"; +getBase64Char(17) -> "R"; +getBase64Char(18) -> "S"; +getBase64Char(19) -> "T"; +getBase64Char(20) -> "U"; +getBase64Char(21) -> "V"; +getBase64Char(22) -> "W"; +getBase64Char(23) -> "X"; +getBase64Char(24) -> "Y"; +getBase64Char(25) -> "Z"; +getBase64Char(26) -> "a"; +getBase64Char(27) -> "b"; +getBase64Char(28) -> "c"; +getBase64Char(29) -> "d"; +getBase64Char(30) -> "e"; +getBase64Char(31) -> "f"; +getBase64Char(32) -> "g"; +getBase64Char(33) -> "h"; +getBase64Char(34) -> "i"; +getBase64Char(35) -> "j"; +getBase64Char(36) -> "k"; +getBase64Char(37) -> "l"; +getBase64Char(38) -> "m"; +getBase64Char(39) -> "n"; +getBase64Char(40) -> "o"; +getBase64Char(41) -> "p"; +getBase64Char(42) -> "q"; +getBase64Char(43) -> "r"; +getBase64Char(44) -> "s"; +getBase64Char(45) -> "t"; +getBase64Char(46) -> "u"; +getBase64Char(47) -> "v"; +getBase64Char(48) -> "w"; +getBase64Char(49) -> "x"; +getBase64Char(50) -> "y"; +getBase64Char(51) -> "z"; +getBase64Char(52) -> "0"; +getBase64Char(53) -> "1"; +getBase64Char(54) -> "2"; +getBase64Char(55) -> "3"; +getBase64Char(56) -> "4"; +getBase64Char(57) -> "5"; +getBase64Char(58) -> "6"; +getBase64Char(59) -> "7"; +getBase64Char(60) -> "8"; +getBase64Char(61) -> "9"; +getBase64Char(62) -> "+"; +getBase64Char(63) -> "/"; +getBase64Char(_Else) -> + %% This is an illegal input. +% cgLogEM:log(error, ?MODULE, getBase64Char, [Else], +% "illegal input", +% ?LINE, version()), + "**". + +-define(M(F), <> = <>). + +native(Config) when is_list(Config) -> + ?line ?M(3.14:64/native-float), + ?line ?M(333:16/native), + ?line ?M(38658345:32/native), + case <<1:16/native>> of + <<0,1>> -> native_big(); + <<1,0>> -> native_little() + end. + +native_big() -> + ?line <<37.33:64/native-float>> = <<37.33:64/big-float>>, + ?line <<3974:16/native-integer>> = <<3974:16/big-integer>>, + {comment,"Big endian"}. + +native_little() -> + ?line <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, + ?line <<7974:16/native-integer>> = <<7974:16/little-integer>>, + {comment,"Little endian"}. + +happi(Config) when is_list(Config) -> + Bin = <<".123">>, + ?line <<"123">> = lex_digits1(Bin, 1, []), + ?line <<"123">> = lex_digits2(Bin, 1, []), + ok. + +lex_digits1(<<$., Rest/binary>>,_Val,_Acc) -> + Rest; +lex_digits1(<>,Val, Acc) when N >= $0 , N =< $9 -> + lex_digits1(Rest,Val*10+dec(N),Acc); +lex_digits1(_Other,_Val,_Acc) -> + not_ok. + +lex_digits2(<>,Val, Acc) when N >= $0 , N =< $9 -> + lex_digits2(Rest,Val*10+dec(N),Acc); +lex_digits2(<<$., Rest/binary>>,_Val,_Acc) -> + Rest; +lex_digits2(_Other,_Val,_Acc) -> + not_ok. + +dec(A) -> + A-$0. + +size_var(Config) when is_list(Config) -> + ?line {<<45>>,<<>>} = split(<<1:16,45>>), + ?line {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), + ?line {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), + + ?line {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), + + ?line {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), + ?line {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), + + ?line <<"cdef">> = skip(<<2:8,"abcdef">>), + + ok. + +split(<>) -> + {B,T}. + +split(N, <>) -> + {B,T}. + +split_2(<>) -> + {B,T}. + +skip(<>) -> T. + +wiger(Config) when is_list(Config) -> + ?line ok1 = wcheck(<<3>>), + ?line ok2 = wcheck(<<1,2,3>>), + ?line ok3 = wcheck(<<4>>), + ?line {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), + ?line {error,<<>>} = wcheck(<<>>), + ok. + +wcheck(<>) when A==3-> + ok1; +wcheck(<<_,_:2/binary>>) -> + ok2; +wcheck(<<_>>) -> + ok3; +wcheck(Other) -> + {error,Other}. + +%% Test that having the match context in x(0) works. + +x0_context(Config) when is_list(Config) -> + x0_0([], <<3.0:64/float,42:16,123456:32>>). + +x0_0(_, Bin) -> + <<3.0:64/float,42:16,_/binary>> = Bin, + x0_1([], Bin, 64, 16, 2). + +x0_1(_, Bin, FloatSz, IntSz, BinSz) -> + <<_:FloatSz/float,42:IntSz,B:BinSz/binary,C:1/binary,D/binary>> = Bin, + id({B,C,D}), + <<_:FloatSz/float,42:IntSz,B:BinSz/binary,_/binary>> = Bin, + x0_2([], Bin). + +x0_2(_, Bin) -> + <<_:64,0:7,42:9,_/binary>> = Bin, + x0_3([], Bin). + +x0_3(_, Bin) -> + case Bin of + <<_:72,7:8,_/binary>> -> + ?line ?t:fail(); + <<_:64,0:16,_/binary>> -> + ?line ?t:fail(); + <<_:64,42:16,123456:32,_/binary>> -> + ok + end. + + +huge_float_field(Config) when is_list(Config) -> + Sz = 1 bsl 27, + ?line Bin = <<0:Sz>>, + + ?line nomatch = overflow_huge_float_skip_32(Bin), + ?line nomatch = overflow_huge_float_32(Bin), + + ?line ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ?line ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok. + +overflow_huge_float_skip_32(<<_:4294967296/float,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_float_skip_32(<<_:33554432/float-unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_float_skip_32(<<_:67108864/float-unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_float_skip_32(<<_:134217728/float-unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_float_skip_32(<<_:268435456/float-unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_float_skip_32(<<_:536870912/float-unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_float_skip_32(<<_:1073741824/float-unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_float_skip_32(<<_:2147483648/float-unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_float_skip_32(_) -> nomatch. + +overflow_huge_float_32(<>) -> {1,F}; % 1 bsl 32 +overflow_huge_float_32(<>) -> {2,F}; % 1 bsl 25 +overflow_huge_float_32(<>) -> {3,F}; % 1 bsl 26 +overflow_huge_float_32(<>) -> {4,F}; % 1 bsl 27 +overflow_huge_float_32(<>) -> {5,F}; % 1 bsl 28 +overflow_huge_float_32(<>) -> {6,F}; % 1 bsl 29 +overflow_huge_float_32(<>) -> {7,F}; % 1 bsl 30 +overflow_huge_float_32(<>) -> {8,F}; % 1 bsl 31 +overflow_huge_float_32(_) -> nomatch. + + +overflow_huge_float(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/float-unit:8,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <> -> + {error,Sz,Var}; + _ -> + overflow_huge_float(Bin, Sizes) + end + end; +overflow_huge_float(_, []) -> ok. + +overflow_huge_float_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/float-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <> -> + {error,Sz,Var}; + _ -> + overflow_huge_float_unit128(Bin, Sizes) + end + end; +overflow_huge_float_unit128(_, []) -> ok. + + +%% +%% Test that a writable binary can be safely matched. +%% + +writable_binary_matched(Config) when is_list(Config) -> + ?line WritableBin = create_writeable_binary(), + ?line writable_binary_matched(WritableBin, WritableBin, 500). + +writable_binary_matched(<<0>>, _, N) -> + if + N =:= 0 -> ok; + true -> + put(grow_heap, [N|get(grow_heap)]), + ?line WritableBin = create_writeable_binary(), + ?line writable_binary_matched(WritableBin, WritableBin, N-1) + end; +writable_binary_matched(<>, WritableBin0, N) -> + ?line WritableBin = writable_binary(WritableBin0, B), + writable_binary_matched(T, WritableBin, N). + +writable_binary(WritableBin0, B) when is_binary(WritableBin0) -> + %% Heavy append to force the binary to move. + ?line WritableBin = <>, + ?line id(<<(id(0)):128/unit:8>>), + WritableBin. + +create_writeable_binary() -> + <<(id(<<>>))/binary,1,2,3,4,5,6,0>>. + +otp_7198(Config) when is_list(Config) -> + %% When a match context was reused, and grown at the same time to + %% increase the number of saved positions, the thing word was not updated + %% to account for the new size. Therefore, if there was a garbage collection, + %% the new slots would be included in the garbage collection. + ?line [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], + ok. + +do_otp_7198(FillerSize) -> + Filler = erlang:make_tuple(FillerSize, 42), + {Pid,Ref} = spawn_monitor(fun() -> do_otp_7198_test(Filler) end), + receive + {'DOWN',Ref,process,Pid,normal} -> + ok; + {'DOWN',Ref,process,Pid,Reason} -> + io:format("unexpected: ~p", [Reason]), + ?line ?t:fail() + end. + +do_otp_7198_test(_) -> + [{'KEYWORD',114}, + {'KEYWORD',101}, + {'KEYWORD',103}, + {'KEYWORD',105}, + {'KEYWORD',111}, + {'FIELD',110}, + {'KEYWORD',119}, + {'KEYWORD',104}, + {'KEYWORD',97}, + {'KEYWORD',116}, + {'KEYWORD',101}, + {'KEYWORD',118}, + {'KEYWORD',101}, + {'KEYWORD',114}, + '$thats_all_folks$'] = otp_7198_scan(<<"region:whatever">>, []). + + +otp_7198_scan(<<>>, TokAcc) -> + lists:reverse(['$thats_all_folks$' | TokAcc]); + +otp_7198_scan(<>, TokAcc) when + (D =:= $D orelse D =:= $d) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + otp_7198_scan(<>, ['AND' | TokAcc]); + +otp_7198_scan(<>, TokAcc) when + (D =:= $D) or (D =:= $d) -> + otp_7198_scan(<<>>, ['AND' | TokAcc]); + +otp_7198_scan(<>, TokAcc) when + (N =:= $N orelse N =:= $n) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + otp_7198_scan(<>, ['NOT' | TokAcc]); + +otp_7198_scan(<>, TokAcc) when + (C >= $A) and (C =< $Z); + (C >= $a) and (C =< $z); + (C >= $0) and (C =< $9) -> + case Rest of + <<$:, R/binary>> -> + otp_7198_scan(R, [{'FIELD', C} | TokAcc]); + _ -> + otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. + + +id(I) -> I. diff --git a/erts/emulator/test/bs_match_tail_SUITE.erl b/erts/emulator/test/bs_match_tail_SUITE.erl new file mode 100644 index 0000000000..b0b0779b65 --- /dev/null +++ b/erts/emulator/test/bs_match_tail_SUITE.erl @@ -0,0 +1,87 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(bs_match_tail_SUITE). + +-author('bjorn@erix.ericsson.se'). +-export([all/1,aligned/1,unaligned/1,zero_tail/1]). + +-include("test_server.hrl"). + +all(suite) -> [aligned,unaligned,zero_tail]. + +aligned(doc) -> "Test aligned tails."; +aligned(Config) when is_list(Config) -> + ?line Tail1 = mkbin([]), + ?line {258,Tail1} = al_get_tail_used(mkbin([1,2])), + ?line Tail2 = mkbin(lists:seq(1, 127)), + ?line {35091,Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), + + ?line 64896 = al_get_tail_unused(mkbin([253,128])), + ?line 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), + + ?line Tail3 = mkbin(lists:seq(0, 19)), + ?line {0,Tail1} = get_dyn_tail_used(Tail1, 0), + ?line {0,Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), + ?line {73,Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), + + ?line 0 = get_dyn_tail_unused(mkbin([]), 0), + ?line 233 = get_dyn_tail_unused(mkbin([233]), 8), + ?line 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), + ok. + +al_get_tail_used(<>) -> {A,T}. +al_get_tail_unused(<>) -> A. + +unaligned(doc) -> "Test that an non-aligned tail cannot be matched out."; +unaligned(Config) when is_list(Config) -> + ?line {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), + ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), + ?line {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), + ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), + ok. + +get_tail_used(<>) -> {A,T}. + +get_tail_unused(<>) -> A. + +get_dyn_tail_used(Bin, Sz) -> + <> = Bin, + {A,T}. + +get_dyn_tail_unused(Bin, Sz) -> + <> = Bin, + A. + +zero_tail(doc) -> "Test that zero tails are tested correctly."; +zero_tail(Config) when is_list(Config) -> + ?line 7 = (catch test_zero_tail(mkbin([7]))), + ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), + ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), + ok. + +test_zero_tail(<>) -> A. + +test_zero_tail2(<<_A:4,_B:4>>) -> ok. + +mkbin(L) when is_list(L) -> list_to_binary(L). + + + + diff --git a/erts/emulator/test/bs_utf_SUITE.erl b/erts/emulator/test/bs_utf_SUITE.erl new file mode 100644 index 0000000000..87adc5197b --- /dev/null +++ b/erts/emulator/test/bs_utf_SUITE.erl @@ -0,0 +1,394 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(bs_utf_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + utf8_roundtrip/1,utf16_roundtrip/1,utf32_roundtrip/1, + utf8_illegal_sequences/1,utf16_illegal_sequences/1, + utf32_illegal_sequences/1, + bad_construction/1]). + +-include("test_server.hrl"). + +-define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(6)), + [{watchdog,Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +all(suite) -> + [utf8_roundtrip,utf16_roundtrip,utf32_roundtrip, + utf8_illegal_sequences,utf16_illegal_sequences, + utf32_illegal_sequences,bad_construction]. + +utf8_roundtrip(Config) when is_list(Config) -> + ?line utf8_roundtrip(0, 16#D7FF), + ?line utf8_roundtrip(16#E000, 16#FFFD), + ?line utf8_roundtrip(16#10000, 16#10FFFF), + ok. + +utf8_roundtrip(First, Last) when First =< Last -> + Bin = int_to_utf8(First), + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,First/utf8>>), + Unaligned = id(<<3:2,First/utf8>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + utf8_roundtrip(First+1, Last); +utf8_roundtrip(_, _) -> ok. + +utf16_roundtrip(Config) when is_list(Config) -> + Big = fun utf16_big_roundtrip/1, + Little = fun utf16_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> + do_utf16_roundtrip(Fun) + end) || Fun <- [Big,Little]], + [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end || + {Pid,Ref} <- PidRefs], + ok. + +do_utf16_roundtrip(Fun) -> + do_utf16_roundtrip(0, 16#D7FF, Fun), + do_utf16_roundtrip(16#E000, 16#FFFD, Fun), + do_utf16_roundtrip(16#10000, 16#10FFFF, Fun). + +do_utf16_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf16_roundtrip(First+1, Last, Fun); +do_utf16_roundtrip(_, _, _) -> ok. + +utf16_big_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/utf16>>), + Unaligned = id(<<3:2,Char/utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +utf16_little_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf16>>), + Unaligned = id(<<3:2,Char/little-utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +utf32_roundtrip(Config) when is_list(Config) -> + Big = fun utf32_big_roundtrip/1, + Little = fun utf32_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> + do_utf32_roundtrip(Fun) + end) || Fun <- [Big,Little]], + [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end || + {Pid,Ref} <- PidRefs], + ok. + +do_utf32_roundtrip(Fun) -> + do_utf32_roundtrip(0, 16#D7FF, Fun), + do_utf32_roundtrip(16#E000, 16#FFFD, Fun), + do_utf32_roundtrip(16#10000, 16#10FFFF, Fun). + +do_utf32_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf32_roundtrip(First+1, Last, Fun); +do_utf32_roundtrip(_, _, _) -> ok. + +utf32_big_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/utf32>>), + Unaligned = id(<<3:2,Char/utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +utf32_little_roundtrip(Char) -> + Bin = id(<>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf32>>), + Unaligned = id(<<3:2,Char/little-utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <> = Bin, + <> = make_unaligned(Bin), + ok. + +utf8_illegal_sequences(Config) when is_list(Config) -> + ?line fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + ?line fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + ?line fail_range(16#FFFE, 16#FFFF), %Non-characters. + + %% Illegal first character. + ?line [fail(<>) || I <- lists:seq(16#80, 16#BF)], + + %% Short sequences. + ?line short_sequences(16#80, 16#10FFFF), + + %% Overlong sequences. (Using more bytes than necessary + %% is not allowed.) + ?line overlong(0, 127, 2), + ?line overlong(128, 16#7FF, 3), + ?line overlong(16#800, 16#FFFF, 4), + ok. + +fail_range(Char, End) when Char =< End -> + {'EXIT',_} = (catch <>), + Bin = int_to_utf8(Char), + fail(Bin), + fail_range(Char+1, End); +fail_range(_, _) -> ok. + +short_sequences(Char, End) -> + Step = (End - Char) div erlang:system_info(schedulers) + 1, + PidRefs = short_sequences_1(Char, Step, End), + [receive {'DOWN',Ref,process,Pid,Reason} -> normal=Reason end || + {Pid,Ref} <- PidRefs], + ok. + +short_sequences_1(Char, Step, End) when Char =< End -> + CharEnd = lists:min([Char+Step-1,End]), + [spawn_monitor(fun() -> + io:format("~p - ~p\n", [Char,CharEnd]), + do_short_sequences(Char, CharEnd) + end)|short_sequences_1(Char+Step, Step, End)]; +short_sequences_1(_, _, _) -> []. + +do_short_sequences(Char, End) when Char =< End -> + short_sequence(Char), + do_short_sequences(Char+1, End); +do_short_sequences(_, _) -> ok. + +short_sequence(I) -> + case int_to_utf8(I) of + <> -> + <> = S0, + <> = S1, + fail(S0), + fail(S1), + fail(S2), + fail(<>), + fail(<>), + fail(<>); + <> -> + <> = S0, + fail(S0), + fail(S1), + fail(<>), + fail(<>), + fail(<>); + <> -> + fail(S), + fail(<>) + end. + +overlong(Char, Last, NumBytes) when Char =< Last -> + overlong(Char, NumBytes), + overlong(Char+1, Last, NumBytes); +overlong(_, _, _) -> ok. + +overlong(Char, NumBytes) when NumBytes < 5 -> + case int_to_utf8(Char, NumBytes) of + <>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char}); + <>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); + _ -> ok + end, + overlong(Char, NumBytes+1); +overlong(_, _) -> ok. + +fail(Bin) -> + fail_1(Bin), + fail_1(make_unaligned(Bin)). + +fail_1(<>=Bin) -> + ?t:fail({illegal_encoding_accepted,Bin,Char}); +fail_1(_) -> ok. + + +utf16_illegal_sequences(Config) when is_list(Config) -> + ?line utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + ?line utf16_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + ?line utf16_fail_range(16#FFFE, 16#FFFF), %Non-characters. + + ?line lonely_hi_surrogate(16#D800, 16#DFFF), + ?line leading_lo_surrogate(16#DC00, 16#DFFF), + + ok. + +utf16_fail_range(Char, End) when Char =< End -> + {'EXIT',_} = (catch <>), + {'EXIT',_} = (catch <>), + utf16_fail_range(Char+1, End); +utf16_fail_range(_, _) -> ok. + +lonely_hi_surrogate(Char, End) when Char =< End -> + BinBig = <>, + BinLittle = <>, + case {BinBig,BinLittle} of + {<>,_} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,<>} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + lonely_hi_surrogate(Char+1, End); +lonely_hi_surrogate(_, _) -> ok. + +leading_lo_surrogate(Char, End) when Char =< End -> + leading_lo_surrogate(Char, 16#D800, 16#DFFF), + leading_lo_surrogate(Char+1, End); +leading_lo_surrogate(_, _) -> ok. + +leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> + BinBig = <>, + BinLittle = <>, + case {BinBig,BinLittle} of + {<>,_} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,<>} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + leading_lo_surrogate(HiSurr, LoSurr+1, End); +leading_lo_surrogate(_, _, _) -> ok. + +utf32_illegal_sequences(Config) when is_list(Config) -> + ?line utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), %Too large. + ?line utf32_fail_range(16#D800, 16#DFFF), %Reserved for UTF-16. + ?line utf32_fail_range(16#FFFE, 16#FFFF), %Non-characters. + ?line utf32_fail_range(-100, -1), + ok. + +utf32_fail_range(Char, End) when Char =< End -> + {'EXIT',_} = (catch <>), + {'EXIT',_} = (catch <>), + case {<>,<>} of + {<>,_} -> + ?line ?t:fail(Unexpected); + {_,<>} -> + ?line ?t:fail(Unexpected); + {_,_} -> ok + end, + utf32_fail_range(Char+1, End); +utf32_fail_range(_, _) -> ok. + +bad_construction(Config) when is_list(Config) -> + ?FAIL(<<3.14/utf8>>), + ?FAIL(<<3.1415/utf16>>), + ?FAIL(<<3.1415/utf32>>), + + ?FAIL(<<(-1)/utf8>>), + ?FAIL(<<(-1)/utf16>>), + {'EXIT',_} = (catch <<(id(-1))/utf8>>), + {'EXIT',_} = (catch <<(id(-1))/utf16>>), + {'EXIT',_} = (catch <<(id(-1))/utf32>>), + + ?FAIL(<<16#D800/utf8>>), + ?FAIL(<<16#D800/utf16>>), + ?FAIL(<<16#D800/utf32>>), + + ok. + +%% This function intentionally allows construction of +%% UTF-8 sequence in illegal ranges. +int_to_utf8(I) when I =< 16#7F -> + <>; +int_to_utf8(I) when I =< 16#7FF -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I) when I =< 16#FFFF -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I) when I =< 16#3FFFFF -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>; +int_to_utf8(I) when I =< 16#3FFFFFF -> + B5 = I, + B4 = (I bsr 6), + B3 = (I bsr 12), + B2 = (I bsr 18), + B1 = (I bsr 24), + <<1:1,1:1,1:1,1:1,1:1,0:1,B1:2,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6, + 1:1,0:1,B5:6>>. + +%% int_to_utf8(I, NumberOfBytes) -> Binary. +%% This function can be used to construct overlong sequences. +int_to_utf8(I, 1) -> + <>; +int_to_utf8(I, 2) -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I, 3) -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I, 4) -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>. + +make_unaligned(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = byte_size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +fail_check({'EXIT',{badarg,_}}, Str, Vars) -> + try evaluate(Str, Vars) of + Res -> + io:format("Interpreted result: ~p", [Res]), + ?t:fail(did_not_fail_in_intepreted_code) + catch + error:badarg -> + ok + end; +fail_check(Res, _, _) -> + io:format("Compiled result: ~p", [Res]), + ?t:fail(did_not_fail_in_compiled_code). + +evaluate(Str, Vars) -> + {ok,Tokens,_} = + erl_scan:string(Str ++ " . "), + {ok, [Expr]} = erl_parse:parse_exprs(Tokens), + case erl_eval:expr(Expr, Vars) of + {value, Result, _} -> + Result + end. + +id(I) -> I. + diff --git a/erts/emulator/test/busy_port_SUITE.erl b/erts/emulator/test/busy_port_SUITE.erl new file mode 100644 index 0000000000..9b16170293 --- /dev/null +++ b/erts/emulator/test/busy_port_SUITE.erl @@ -0,0 +1,628 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(busy_port_SUITE). + +-export([all/1, io_to_busy/1, message_order/1, send_3/1, + system_monitor/1, no_trap_exit/1, + no_trap_exit_unlinked/1, trap_exit/1, multiple_writers/1, + hard_busy_driver/1, soft_busy_driver/1]). + +-include("test_server.hrl"). + +%% Internal exports. +-export([init/2]). + +all(suite) -> {req, [dynamic_loading], + [io_to_busy, message_order, send_3, + system_monitor, no_trap_exit, + no_trap_exit_unlinked, trap_exit, multiple_writers, + hard_busy_driver, soft_busy_driver]}. + +%% Tests I/O operations to a busy port, to make sure a suspended send +%% operation is correctly restarted. This used to crash Beam. + +io_to_busy(suite) -> []; +io_to_busy(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(30)), + + ?line start_busy_driver(Config), + ?line process_flag(trap_exit, true), + ?line Writer = fun_spawn(fun writer/0), + ?line Generator = fun_spawn(fun() -> generator(100, Writer) end), + ?line wait_for([Writer, Generator]), + + ?line test_server:timetrap_cancel(Dog), + ok. + +generator(N, Writer) -> + generator(N, Writer, lists:duplicate(128, 42)). + +generator(0, Writer, _Data) -> + Writer ! stop, + erlang:garbage_collect(), + receive after 2000 -> ok end, + + %% Calling process_info(Pid, current_function) on a suspended process + %% used to crash Beam. + {current_function, {erlang, send, 2}} = + process_info(Writer, current_function), + unlock_slave(); +generator(N, Writer, Data) -> + Writer ! {exec, Data}, + generator(N-1, Writer, [42|Data]). + +writer() -> + {Owner, Port} = get_slave(), + Port ! {Owner, {connect, self()}}, + X = {a, b, c, d}, + forget({element(1, X), element(2, X), element(3, X), element(4, X)}), + writer_loop(Port). + +writer_loop(Port) -> + receive + {exec, Data} -> + Port ! {self(), {command, Data}}, + writer_loop(Port); + stop -> + erlang:garbage_collect() + end. + +forget(_) -> + ok. + +%% Test the interaction of busy ports and message sending. +%% This used to cause the wrong message to be received. + +message_order(suite) -> {req, dynamic_loading}; +message_order(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + + ?line start_busy_driver(Config), + ?line Self = self(), + ?line Busy = fun_spawn(fun () -> send_to_busy_1(Self) end), + ?line receive after 1000 -> ok end, + ?line Busy ! first, + ?line Busy ! second, + ?line receive after 1 -> ok end, + ?line unlock_slave(), + ?line Busy ! third, + ?line receive + {Busy, first} -> + ok; + Other -> + test_server:fail({unexpected_message, Other}) + end, + + ?line test_server:timetrap_cancel(Dog), + ok. + +send_to_busy_1(Parent) -> + {Owner, Slave} = get_slave(), + Slave ! {Owner, {command, "set_me_busy"}}, + Slave ! {Owner, {command, "hello"}}, + Slave ! {Owner, {command, "hello again"}}, + receive + Message -> + Parent ! {self(), Message} + end. + +%% Test the bif send/3 +send_3(suite) -> {req,dynamic_loading}; +send_3(doc) -> ["Test the BIF send/3"]; +send_3(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + %% + ?line start_busy_driver(Config), + ?line {Owner,Slave} = get_slave(), + ?line ok = erlang:send(Slave, {Owner,{command,"set busy"}}, + [nosuspend]), + ?line nosuspend = erlang:send(Slave, {Owner,{command,"busy"}}, + [nosuspend]), + ?line unlock_slave(), + ?line ok = erlang:send(Slave, {Owner,{command,"not busy"}}, + [nosuspend]), + ?line ok = command(stop), + %% + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Test the erlang:system_monitor(Pid, [busy_port]) +system_monitor(suite) -> {req,dynamic_loading}; +system_monitor(doc) -> ["Test erlang:system_monitor({Pid,[busy_port]})."]; +system_monitor(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Self = self(), + %% + ?line OldMonitor = erlang:system_monitor(Self, [busy_port]), + ?line {Self,[busy_port]} = erlang:system_monitor(), + ?line Void = make_ref(), + ?line start_busy_driver(Config), + ?line {Owner,Slave} = get_slave(), + ?line Master = command(get_master), + ?line Parent = self(), + ?line Busy = + spawn_link( + fun() -> + Slave ! {Owner,{command,"set busy"}}, + receive {Parent,alpha} -> ok end, + Slave ! {Owner,{command,"busy"}}, + Slave ! {Owner,{command,"free"}}, + Parent ! {self(),alpha}, + command(lock), + receive {Parent,beta} -> ok end, + command({port_command,"busy"}), + command({port_command,"free"}), + Parent ! {self(),beta} + end), + ?line Void = rec(Void), + ?line Busy ! {self(),alpha}, + ?line {monitor,Busy,busy_port,Slave} = rec(Void), + ?line unlock_slave(), + ?line {Busy,alpha} = rec(Void), + ?line Void = rec(Void), + ?line Busy ! {self(), beta}, + ?line {monitor,Owner,busy_port,Slave} = rec(Void), + ?line Master ! {Owner, {command, "u"}}, + ?line {Busy,beta} = rec(Void), + ?line Void = rec(Void), + ?line NewMonitor = erlang:system_monitor(OldMonitor), + ?line OldMonitor = erlang:system_monitor(), + ?line OldMonitor = erlang:system_monitor(OldMonitor), + %% + ?line test_server:timetrap_cancel(Dog), + ok. + + + +rec(Tag) -> + receive X -> X after 1000 -> Tag end. + + + + +%% Assuming the following scenario, +%% +%% +---------------+ +-----------+ +%% | process with | | | +%% | no trap_exit |------------------| busy port | +%% | (suspended) | | | +%% +---------------+ +-----------+ +%% +%% tests that the suspended process is killed if the port is killed. + +no_trap_exit(suite) -> []; +no_trap_exit(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun no_trap_exit_process/3, + [self(), linked, Config]), + ?line receive + {Pid, port_created, Port} -> + io:format("Process ~w created port ~w", [Pid, Port]), + ?line exit(Port, die); + Other1 -> + test_server:fail({unexpected_message, Other1}) + end, + ?line receive + {'EXIT', Pid, die} -> + ok; + Other2 -> + test_server:fail({unexpected_message, Other2}) + end, + + ?line test_server:timetrap_cancel(Dog), + ok. + +%% The same scenario as above, but the port has been explicitly +%% unlinked from the process. + +no_trap_exit_unlinked(suite) -> []; +no_trap_exit_unlinked(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun no_trap_exit_process/3, + [self(), unlink, Config]), + ?line receive + {Pid, port_created, Port} -> + io:format("Process ~w created port ~w", [Pid, Port]), + ?line exit(Port, die); + Other1 -> + test_server:fail({unexpected_message, Other1}) + end, + ?line receive + {'EXIT', Pid, normal} -> + ok; + Other2 -> + test_server:fail({unexpected_message, Other2}) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +no_trap_exit_process(ResultTo, Link, Config) -> + ?line load_busy_driver(Config), + ?line _Master = open_port({spawn, "busy_drv master"}, [eof]), + ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]), + ?line case Link of + linked -> ok; + unlink -> unlink(Slave) + end, + ?line Slave ! {self(), {command, "lock port"}}, + ?line ResultTo ! {self(), port_created, Slave}, + ?line Slave ! {self(), {command, "suspend me"}}, + ok. + +%% Assuming the following scenario, +%% +%% +---------------+ +-----------+ +%% | process with | | | +%% | trap_exit |------------------| busy port | +%% | (suspended) | | | +%% +---------------+ +-----------+ +%% +%% tests that the suspended process is scheduled runnable and +%% receives an 'EXIT' message if the port is killed. + +trap_exit(suite) -> []; +trap_exit(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Pid = fun_spawn(fun busy_port_exit_process/2, [self(), Config]), + ?line receive + {Pid, port_created, Port} -> + io:format("Process ~w created port ~w", [Pid, Port]), + ?line unlink(Pid), + ?line {status, suspended} = process_info(Pid, status), + ?line exit(Port, die); + Other1 -> + test_server:fail({unexpected_message, Other1}) + end, + ?line receive + {Pid, ok} -> + ok; + Other2 -> + test_server:fail({unexpected_message, Other2}) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +busy_port_exit_process(ResultTo, Config) -> + ?line process_flag(trap_exit, true), + ?line load_busy_driver(Config), + ?line _Master = open_port({spawn, "busy_drv master"}, [eof]), + ?line Slave = open_port({spawn, "busy_drv slave"}, [eof]), + ?line Slave ! {self(), {command, "lock port"}}, + ?line ResultTo ! {self(), port_created, Slave}, + ?line Slave ! {self(), {command, "suspend me"}}, + receive + {'EXIT', Slave, die} -> + ResultTo ! {self(), ok}; + Other -> + ResultTo ! {self(), {unexpected_message, Other}} + end. + +%% Tests that several processes suspended by a write to a busy port +%% will start running as soon as the port becamomes ready. +%% This should work even if some of the processes have terminated +%% in the meantime. + +multiple_writers(suite) -> []; +multiple_writers(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line start_busy_driver(Config), + ?line process_flag(trap_exit, true), + + %% Start the waiters and make sure they have blocked. + ?line W1 = fun_spawn(fun quick_writer/0), + ?line W2 = fun_spawn(fun quick_writer/0), + ?line W3 = fun_spawn(fun quick_writer/0), + ?line W4 = fun_spawn(fun quick_writer/0), + ?line W5 = fun_spawn(fun quick_writer/0), + ?line test_server:sleep(500), % Make sure writers have blocked. + + %% Kill two of the processes. + exit(W1, kill), + receive {'EXIT', W1, killed} -> ok end, + exit(W3, kill), + receive {'EXIT', W3, killed} -> ok end, + + %% Unlock the port. The surviving processes should be become runnable. + ?line unlock_slave(), + ?line wait_for([W2, W4, W5]), + + ?line test_server:timetrap_cancel(Dog), + ok. + +quick_writer() -> + {Owner, Port} = get_slave(), + Port ! {Owner, {command, "port to busy"}}, + Port ! {Owner, {command, "lock me"}}, + ok. + +hard_busy_driver(Config) when is_list(Config) -> + hs_test(Config, true). + +soft_busy_driver(Config) when is_list(Config) -> + hs_test(Config, false). + +hs_test(Config, HardBusy) when is_list(Config) -> + ?line Me = self(), + ?line DrvName = case HardBusy of + true -> 'hard_busy_drv'; + false -> 'soft_busy_drv' + end, + ?line erl_ddll:start(), + ?line Path = ?config(data_dir, Config), + case erl_ddll:load_driver(Path, DrvName) of + ok -> ok; + {error, Error} -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + ?line ?t:fail() + end, + + ?line Port = open_port({spawn, DrvName}, []), + + NotSuspended = fun (Proc) -> + chk_not_value({status,suspended}, + process_info(Proc, status)) + end, + NotBusyEnd = fun (Proc, Res, Time) -> + receive + {Port, caller, Proc} -> ok + after + 500 -> exit(missing_caller_message) + end, + chk_value({return, true}, Res), + chk_range(0, Time, 100) + end, + ForceEnd = fun (Proc, Res, Time) -> + case HardBusy of + false -> + NotBusyEnd(Proc, Res, Time); + true -> + chk_value({error, notsup}, Res), + chk_range(0, Time, 100), + receive + Msg -> exit({unexpected_msg, Msg}) + after + 500 -> ok + end + end + end, + BadArg = fun (_Proc, Res, Time) -> + chk_value({error, badarg}, Res), + chk_range(0, Time, 100) + end, + + %% Not busy + + %% Not busy; nosuspend option + ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended, NotBusyEnd), + + %% Not busy; force option + ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), + + %% Not busy; force and nosuspend option + ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), + + %% Not busy; no option + ?line hs_busy_pcmd(Port, [], NotSuspended, NotBusyEnd), + + %% Not busy; bad option + ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), + + + %% Make busy + ?line erlang:port_control(Port, $B, []), + + + %% Busy; nosuspend option + ?line hs_busy_pcmd(Port, [nosuspend], NotSuspended, + fun (_Proc, Res, Time) -> + chk_value({return, false}, Res), + chk_range(0, Time, 100), + receive + Msg -> exit({unexpected_msg, Msg}) + after + 500 -> ok + end + end), + + %% Busy; force option + ?line hs_busy_pcmd(Port, [force], NotSuspended, ForceEnd), + + %% Busy; force and nosuspend option + ?line hs_busy_pcmd(Port, [force, nosuspend], NotSuspended, ForceEnd), + + %% Busy; bad option + ?line hs_busy_pcmd(Port, [bad_option], NotSuspended, BadArg), + + %% no option on busy port + ?line hs_busy_pcmd(Port, [], + fun (Proc) -> + receive after 1000 -> ok end, + chk_value({status,suspended}, + process_info(Proc, status)), + + %% Make not busy + erlang:port_control(Port, $N, []) + end, + fun (_Proc, Res, Time) -> + chk_value({return, true}, Res), + chk_range(1000, Time, 2000) + end), + + ?line true = erlang:port_close(Port), + ?line ok = erl_ddll:unload_driver(DrvName), + ?line ok = erl_ddll:stop(), + ?line ok. + +hs_busy_pcmd(Prt, Opts, StartFun, EndFun) -> + Tester = self(), + P = spawn_link(fun () -> + erlang:yield(), + Tester ! {self(), doing_port_command}, + Start = os:timestamp(), + Res = try {return, + erlang:port_command(Prt, [], Opts)} + catch Exception:Error -> {Exception, Error} + end, + End = os:timestamp(), + Time = round(timer:now_diff(End, Start)/1000), + Tester ! {self(), port_command_result, Res, Time} + end), + receive + {P, doing_port_command} -> + ok + end, + StartFun(P), + receive + {P, port_command_result, Res, Time} -> + EndFun(P, Res, Time) + end. + +%%% Utilities. + +chk_range(Min, Val, Max) when Min =< Val, Val =< Max -> + ok; +chk_range(Min, Val, Max) -> + exit({bad_range, Min, Val, Max}). + +chk_value(Exp, Exp) -> + ok; +chk_value(Exp, Val) -> + exit({unexpected_value, Val, expected, Exp}). + +chk_not_value(NotExp, NotExp) -> + exit({unexpected_not_value, NotExp}); +chk_not_value(_, _) -> + ok. + +wait_for([]) -> + ok; +wait_for(Pids) -> + io:format("Waiting for ~p", [Pids]), + receive + {'EXIT', Pid, normal} -> + wait_for(lists:delete(Pid, Pids)); + Other -> + test_server:fail({bad_exit, Other}) + end. + +fun_spawn(Fun) -> + fun_spawn(Fun, []). + +fun_spawn(Fun, Args) -> + spawn_link(erlang, apply, [Fun, Args]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% These routines provide a port which will become busy when the +%% the first message is sent to it. The unlock_slave/0 function can +%% be called (from another process) to make the port non-busy. +%% +%% Typical usage: +%% +%% start_busy_driver(Config) Load driver; start server. +%% +%% P r o c e s s O n e +%% {Owner, Port} = get_slave() O Obtain port and its owner. +%% Port ! {Owner, {command, List}} Send to port (will not block +%% but port will become busy). +%% Port ! {Owner, {command, List}} Will block the process. +%% +%% P r o c e s s T w o +%% unlock_slave() Set port to non-busy. Process One +%% will continue executing. Further +%% writes to the port will not block. +%% +%% Any process can call busy_drv:lock() to lock the port again. +%% +%% Note: This module must be used in an installed test suite (outside of +%% clearcase). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +load_busy_driver(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line erl_ddll:start(), + case erl_ddll:load_driver(DataDir, "busy_drv") of + ok -> ok; + {error, Error} -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + ?line ?t:fail() + end. + +%%% Interface functions. + +start_busy_driver(Config) when is_list(Config) -> + ?line Pid = spawn_link(?MODULE, init, [Config, self()]), + ?line receive + {Pid, started} -> + ok; + Other -> + test_server:fail({unexpected_message, Other}) + end. + +unlock_slave() -> + command(unlock). + +get_slave() -> + ?line command(get_slave). + +%% Internal functions. + +command(Msg) -> + ?line whereis(busy_drv_server) ! {self(), Msg}, + ?line receive + {busy_drv_reply, Reply} -> + Reply + end. + +%%% Server. + +init(Config, ReplyTo) -> + register(busy_drv_server, self()), + load_busy_driver(Config), + Driver = "busy_drv", + Master = open_port({spawn, Driver++" master"}, []), + Slave = open_port({spawn, Driver++" slave"}, []), + ReplyTo ! {self(), started}, + loop(Master, Slave). + +loop(Master, Slave) -> + receive + {Pid, get_master} -> + Pid ! {busy_drv_reply, Master}, + loop(Master, Slave); + {Pid, get_slave} -> + Pid ! {busy_drv_reply, {self(), Slave}}, + loop(Master, Slave); + {Pid, unlock} -> + Master ! {self(), {command, "u"}}, + Pid ! {busy_drv_reply, ok}, + loop(Master, Slave); + {Pid, lock} -> + Master ! {self(), {command, "l"}}, + Pid ! {busy_drv_reply, ok}, + loop(Master, Slave); + {Pid, {port_command,Data}} -> + erlang:port_command(Slave, Data), + Pid ! {busy_drv_reply, ok}, + loop(Master, Slave); + {Pid, stop} -> + Pid ! {busy_drv_reply, ok} + end. diff --git a/erts/emulator/test/busy_port_SUITE_data/Makefile.src b/erts/emulator/test/busy_port_SUITE_data/Makefile.src new file mode 100644 index 0000000000..664909db71 --- /dev/null +++ b/erts/emulator/test/busy_port_SUITE_data/Makefile.src @@ -0,0 +1,25 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +all: busy_drv@dll@ hard_busy_drv@dll@ soft_busy_drv@dll@ + +@SHLIB_RULES@ + +hard_busy_drv@obj@: hard_busy_drv.c hs_busy_drv.c +soft_busy_drv@obj@: soft_busy_drv.c hs_busy_drv.c diff --git a/erts/emulator/test/busy_port_SUITE_data/busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/busy_drv.c new file mode 100644 index 0000000000..1273d610ba --- /dev/null +++ b/erts/emulator/test/busy_port_SUITE_data/busy_drv.c @@ -0,0 +1,97 @@ +/* + * Purpose: Provides a driver whose busy state can be controlled from Erlang. + * Author: Bjorn Gustavsson + */ + +#include "erl_driver.h" +#include +#include + +#define NO 0 +#define YES 1 + +static ErlDrvData busy_start(ErlDrvPort, char*); +static void busy_stop(ErlDrvData), busy_from_erlang(ErlDrvData, char*, int); + +ErlDrvEntry busy_driver_entry = +{ + NULL, + busy_start, + busy_stop, + busy_from_erlang, + NULL, + NULL, + "busy_drv", + NULL, + NULL +}; + +static ErlDrvPort master_port; +static ErlDrvPort slave_port; +static int next_slave_state; + +DRIVER_INIT(busy_drv) +{ + master_port = (ErlDrvPort)-1; + slave_port = (ErlDrvPort)-1; + return &busy_driver_entry; +} + +static ErlDrvData busy_start(ErlDrvPort port, char* buf) +{ + char *s; + int slave = YES; + + s = strchr(buf, ' '); + if (s && s[1] == 'm') { + /* This is the master port */ + if (master_port != (ErlDrvPort)-1) + return ERL_DRV_ERROR_GENERAL; /* Already open */ + if (slave_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + master_port = port; + next_slave_state = 1; + } else { + if (slave_port != (ErlDrvPort)-1) + return ERL_DRV_ERROR_GENERAL; /* Already open */ + if (master_port == (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + slave_port = port; + } + return (ErlDrvData)port; +} + +static void busy_stop(ErlDrvData port) +{ + if ((ErlDrvPort)port == master_port) { + master_port = (ErlDrvPort)-1; + } else if ((ErlDrvPort)port == slave_port) { + slave_port = (ErlDrvPort)-1; + } +} + +static void +busy_from_erlang(ErlDrvData port, char* buf, int count) +{ + if ((ErlDrvPort)port == slave_port) { + set_busy_port(slave_port, next_slave_state); + next_slave_state = 0; + return; + } + + if (slave_port == (ErlDrvPort)-1 || count < 1) { + driver_failure((ErlDrvPort)port, -1); + return; + } + + switch (buf[0]) { + case 'l': /* Lock port (set to busy) */ + set_busy_port(slave_port, 1); + break; + case 'u': /* Unlock port (not busy) */ + set_busy_port(slave_port, 0); + break; + } +} diff --git a/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c new file mode 100644 index 0000000000..52c41f8ca5 --- /dev/null +++ b/erts/emulator/test/busy_port_SUITE_data/hard_busy_drv.c @@ -0,0 +1,23 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#define ERTS_TEST_BUSY_DRV_NAME "hard_busy_drv" +#define ERTS_TEST_BUSY_DRV_FLAGS \ + ERL_DRV_FLAG_USE_PORT_LOCKING + +#include "hs_busy_drv.c" diff --git a/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c new file mode 100644 index 0000000000..35919da2d0 --- /dev/null +++ b/erts/emulator/test/busy_port_SUITE_data/hs_busy_drv.c @@ -0,0 +1,94 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#include +#include "erl_driver.h" + +ErlDrvData start(ErlDrvPort port, char *command); +void output(ErlDrvData drv_data, char *buf, int len); +int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); + +static ErlDrvEntry busy_drv_entry = { + NULL /* init */, + start, + NULL /* stop */, + output, + NULL /* ready_input */, + NULL /* ready_output */, + ERTS_TEST_BUSY_DRV_NAME, + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERTS_TEST_BUSY_DRV_FLAGS, + NULL /* handle2 */, + NULL /* handle_monitor */, + NULL /* stop_select */ +}; + +DRIVER_INIT(busy_drv) +{ + return &busy_drv_entry; +} + +ErlDrvData start(ErlDrvPort port, char *command) +{ + return (ErlDrvData) port; +} + +void output(ErlDrvData drv_data, char *buf, int len) +{ + int res; + ErlDrvPort port = (ErlDrvPort) drv_data; + ErlDrvTermData msg[] = { + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_ATOM, driver_mk_atom("caller"), + ERL_DRV_PID, driver_caller(port), + ERL_DRV_TUPLE, (ErlDrvTermData) 3 + }; + res = driver_output_term(port, msg, sizeof(msg)/sizeof(ErlDrvTermData)); + if (res <= 0) + driver_failure_atom(port, "driver_output_term failed"); +} + +int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + switch (command) { + case 'B': /* busy */ + set_busy_port((ErlDrvPort) drv_data, 1); + break; + case 'N': /* not busy */ + set_busy_port((ErlDrvPort) drv_data, 0); + break; + default: + driver_failure_posix((ErlDrvPort) drv_data, EINVAL); + break; + } + return 0; +} diff --git a/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c b/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c new file mode 100644 index 0000000000..30bcd86d1d --- /dev/null +++ b/erts/emulator/test/busy_port_SUITE_data/soft_busy_drv.c @@ -0,0 +1,23 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#define ERTS_TEST_BUSY_DRV_NAME "soft_busy_drv" +#define ERTS_TEST_BUSY_DRV_FLAGS \ + (ERL_DRV_FLAG_USE_PORT_LOCKING|ERL_DRV_FLAG_SOFT_BUSY) + +#include "hs_busy_drv.c" diff --git a/erts/emulator/test/call_trace_SUITE.erl b/erts/emulator/test/call_trace_SUITE.erl new file mode 100644 index 0000000000..e0528955b0 --- /dev/null +++ b/erts/emulator/test/call_trace_SUITE.erl @@ -0,0 +1,1240 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +%%% Purpose : Tests the new call_trace BIF. + +-module(call_trace_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + hipe/1,process_specs/1,basic/1,flags/1,errors/1,pam/1,change_pam/1, + return_trace/1,exception_trace/1,on_load/1,deep_exception/1, + exception_nocatch/1,bit_syntax/1]). + +%% Helper functions. + +-export([bar/0,foo/0,foo/1,foo/2,expect/1,worker_foo/1,pam_foo/2,nasty/0, + id/1,deep/3,deep_1/3,deep_2/2,deep_3/2,deep_4/1,deep_5/1, + bs_sum_a/2,bs_sum_b/2]). + +%% Debug +-export([abbr/1,abbr/2]). + + +-include("test_server.hrl"). + +-define(P, 20). + +all(suite) -> + Common = [errors,on_load], + NotHipe = [process_specs,basic,flags,pam,change_pam,return_trace, + exception_trace,deep_exception,exception_nocatch,bit_syntax], + Hipe = [hipe], + case test_server:is_native(?MODULE) of + true -> Hipe ++ Common; + false -> NotHipe ++ Common + end. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:seconds(30)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +hipe(Config) when is_list(Config) -> + ?line 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true), + ?line 0 = erlang:trace_pattern({?MODULE,worker_foo,1}, true, [local]), + ?line AllFuncs = erlang:trace_pattern({'_','_','_'}, true), + + %% Make sure that a traced, exported function can still be found. + ?line true = erlang:function_exported(error_handler, undefined_function, 3), + ?line AllFuncs = erlang:trace_pattern({'_','_','_'}, false), + ok. + +process_specs(doc) -> + "Tests 'all', 'new', and 'existing' for specifying processes."; +process_specs(suite) -> []; +process_specs(Config) when is_list(Config) -> + ?line Tracer = start_tracer(), + ?line {flags,[call]} = trace_info(self(), flags), + ?line {tracer,Tracer} = trace_info(self(), tracer), + ?line trace_func({?MODULE,worker_foo,1}, []), + + %% Test the 'new' flag. + + ?line {Work1A,Work1B} = start_and_trace(new, [1,2,3], A1B={3,2,1}), + {flags,[]} = trace_info(Work1A, flags), + {tracer,[]} = trace_info(Work1A, tracer), + {tracer,Tracer} = trace_info(Work1B, tracer), + {flags,[call]} = trace_info(Work1B, flags), + ?line expect({trace,Work1B,call,{?MODULE,worker_foo,[A1B]}}), + ?line unlink(Work1B), + ?line Mref = erlang:monitor(process, Work1B), + ?line exit(Work1B, kill), + receive + {'DOWN',Mref,_,_,_} -> ok + end, + ?line undefined = trace_info(Work1B, flags), + ?line {flags,[]} = trace_info(new, flags), + ?line {tracer,[]} = trace_info(new, tracer), + + %% Test the 'existing' flag. + ?line {Work2A,_Work2B} = start_and_trace(existing, A2A=[5,6,7], [7,6,5]), + ?line expect({trace,Work2A,call,{?MODULE,worker_foo,[A2A]}}), + + %% Test the 'all' flag. + ?line {Work3A,Work3B} = start_and_trace(all, A3A=[12,13], A3B=[13,12]), + ?line expect({trace,Work3A,call,{?MODULE,worker_foo,[A3A]}}), + ?line expect({trace,Work3B,call,{?MODULE,worker_foo,[A3B]}}), + + ok. + +start_and_trace(Flag, A1, A2) -> + W1 = start_worker(), + trace_pid(Flag, true, [call]), + W2 = start_worker(), + call_worker(W1, A1), + call_worker(W2, A2), + case Flag of + new -> + {flags,[call]} = trace_info(new, flags), + {tracer,_} = trace_info(new, tracer); + _Other -> + ok + end, + trace_pid(Flag, false, [call]), + {W1,W2}. + +start_worker() -> + ?line spawn(fun worker_loop/0). + +call_worker(Pid, Arg) -> + Pid ! {self(),{call,Arg}}, + receive + {result,Res} -> Res + after 5000 -> + ?line ?t:fail(no_answer_from_worker) + end. + +worker_loop() -> + receive + {From,{call,Arg}} -> + From ! {result,?MODULE:worker_foo(Arg)}, + worker_loop(); + Other -> + exit({unexpected_message,Other}) + end. + +worker_foo(_Arg) -> + ok. + +basic(doc) -> + "Basic test of the call tracing (we trace one process)."; +basic(suite) -> []; +basic(Config) when is_list(Config) -> + ?line start_tracer(), + ?line trace_info(self(), flags), + ?line trace_info(self(), tracer), + ?line 0 = trace_func({?MODULE,no_such_function,0}, []), + ?line {traced,undefined} = + trace_info({?MODULE,no_such_function,0}, traced), + ?line {match_spec, undefined} = + trace_info({?MODULE,no_such_function,0}, match_spec), + + %% Trace some functions... + + ?line trace_func({lists,'_','_'}, []), + ?line 3 = trace_func({?MODULE,foo,'_'}, true), + ?line 1 = trace_func({?MODULE,bar,0}, true), + ?line {traced,global} = trace_info({?MODULE,bar,0}, traced), + ?line 1 = trace_func({erlang,list_to_integer,1}, true), + ?line {traced,global} = trace_info({erlang,list_to_integer,1}, traced), + + %% ... and call them... + + ?line AList = [x,y,z], + ?line true = lists:member(y, AList), + ?line foo0 = ?MODULE:foo(), + ?line 4 = ?MODULE:foo(3), + ?line 11 = ?MODULE:foo(7, 4), + ?line ok = ?MODULE:bar(), + ?line 42 = list_to_integer(non_literal("42")), + + %% ... make sure the we got trace messages (but not for ?MODULE:expect/1). + + ?line Self = self(), + ?line ?MODULE:expect({trace,Self,call,{lists,member,[y,AList]}}), + ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[]}}), + ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[3]}}), + ?line ?MODULE:expect({trace,Self,call,{?MODULE,foo,[7,4]}}), + ?line ?MODULE:expect({trace,Self,call,{?MODULE,bar,[]}}), + ?line ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["42"]}}), + + %% Turn off trace for this module and call functions... + + ?line trace_func({?MODULE,'_','_'}, false), + ?line {traced,false} = trace_info({?MODULE,bar,0}, traced), + ?line foo0 = ?MODULE:foo(), + ?line 4 = ?MODULE:foo(3), + ?line 11 = ?MODULE:foo(7, 4), + ?line ok = ?MODULE:bar(), + ?line [1,2,3,4,5,6,7,8,9,10] = lists:seq(1, 10), + ?line 777 = list_to_integer(non_literal("777")), + + %% ... turn on all trace messages... + + ?line trace_func({'_','_','_'}, false), + ?line [b,a] = lists:reverse([a,b]), + + %% Read out the remaing trace messages. + + ?line ?MODULE:expect({trace,Self,call,{lists,seq,[1,10]}}), + ?line ?MODULE:expect({trace,Self,call,{erlang,list_to_integer,["777"]}}), + receive + Any -> + ?line ?t:fail({unexpected_message,Any}) + after 1 -> + ok + end, + + %% Turn on and then off tracing on all external functions. + %% This might cause the emulator to crasch later if it doesn't + %% restore all export entries properly. + + ?line AllFuncs = trace_func({'_','_','_'}, true), + io:format("AllFuncs = ~p", [AllFuncs]), + %% Make sure that a traced, exported function can still be found. + ?line true = erlang:function_exported(error_handler, undefined_function, 3), + ?line AllFuncs = trace_func({'_','_','_'}, false), + ?line erlang:trace_delivered(all), + receive + {trace_delivered,_,_} -> ok + end, + c:flush(), % Print the traces messages. + c:flush(), % Print the traces messages. + + ?line {traced,false} = trace_info({erlang,list_to_integer,1}, traced), + + ok. + +non_literal(X) -> X. + +bar() -> + ok. + +foo() -> foo0. +foo(X) -> X+1. +foo(X, Y) -> X+Y. + +flags(doc) -> "Test flags (arity, timestamp) for call_trace/3. " + "Also, test the '{tracer,Pid}' option."; +flags(Config) when is_list(Config) -> + ?line Tracer = start_tracer_loop(), + ?line trace_pid(self(), true, [call,{tracer,Tracer}]), + + %% Trace some functions... + + ?line trace_func({filename,'_','_'}, true), + + %% ... and call them... + + ?line Self = self(), + ?line filename:absname("nisse"), + ?line ?MODULE:expect({trace,Self,call,{filename,absname,["nisse"]}}), + ?line trace_pid(Self, true, [call,arity]), + ?line filename:absname("kalle"), + ?line filename:absname("kalle", "/root"), + ?line ?MODULE:expect({trace,Self,call,{filename,absname,1}}), + ?line ?MODULE:expect({trace,Self,call,{filename,absname,2}}), + ?line trace_info(Self, flags), + + %% Timestamp + arity. + + flag_test(fun() -> + ?line trace_pid(Self, true, [timestamp]), + ?line "dum" = filename:basename("/abcd/dum"), + ?line Ts = expect({trace_ts,Self,call,{filename,basename,1},ts}), + ?line trace_info(Self, flags), + Ts + end), + + %% Timestamp. + + ?line AnArg = "/abcd/hejsan", + flag_test(fun() -> + ?line trace_pid(Self, false, [arity]), + ?line "hejsan" = filename:basename(AnArg), + ?line Ts = expect({trace_ts,Self,call, + {filename,basename,[AnArg]},ts}), + ?line trace_info(Self, flags), + Ts + end), + + %% All flags turned off. + + ?line trace_pid(Self, false, [timestamp]), + ?line AnotherArg = filename:join(AnArg, "hoppsan"), + ?line "hoppsan" = filename:basename(AnotherArg), + ?line expect({trace,Self,call,{filename,join,[AnArg,"hoppsan"]}}), + ?line expect({trace,Self,call,{filename,basename,[AnotherArg]}}), + ?line trace_info(Self, flags), + + ok. + +flag_test(Test) -> + Now = now(), + Ts = Test(), + case timer:now_diff(Ts, Now) of + Time when Time < 5*1000000 -> + %% Reasonable short time. + ok; + _Diff -> + %% Too large difference. + io:format("Now = ~p\n", [Now]), + io:format("Ts = ~p\n", [Ts]), + ?line ?t:fail() + end, + flag_test_cpu_timestamp(Test). + +flag_test_cpu_timestamp(Test) -> + try erlang:trace(all, true, [cpu_timestamp]) of + _ -> + io:format("CPU timestamps"), + Ts = Test(), + erlang:trace(all, false, [cpu_timestamp]), + Origin = {0,0,0}, + Hour = 3600*1000000, + case timer:now_diff(Ts, Origin) of + Diff when Diff < 4*Hour -> + %% In the worst case, CPU timestamps count from when this + %% Erlang emulator was started. The above test is a conservative + %% test that all CPU timestamps should pass. + ok; + _Time -> + io:format("Strange CPU timestamp: ~p", [Ts]), + ?line ?t:fail() + end, + io:format("Turned off CPU timestamps") + catch + error:badarg -> ok + end. + +errors(doc) -> "Test bad arguments for trace/3 and trace_pattern/3."; +errors(suite) -> []; +errors(Config) when is_list(Config) -> + ?line expect_badarg_pid(aaa, true, []), + ?line expect_badarg_pid({pid,dum}, false, []), + ?line expect_badarg_func({'_','_',1}, []), + ?line expect_badarg_func({'_',gosh,1}, []), + ?line expect_badarg_func({xxx,'_',2}, []), + ?line expect_badarg_func({xxx,yyy,b}, glurp), + ok. + +expect_badarg_pid(What, How, Flags) -> + case catch erlang:trace(What, How, Flags) of + {'EXIT',{badarg,Where}} -> + io:format("trace(~p, ~p, ~p) ->\n {'EXIT',{badarg,~p}}", + [What,How,Flags,Where]), + ok; + Other -> + io:format("trace(~p, ~p, ~p) -> ~p", + [What,How,Flags,Other]), + ?t:fail({unexpected,Other}) + end. + +expect_badarg_func(MFA, Pattern) -> + case catch erlang:trace_pattern(MFA, Pattern) of + {'EXIT',{badarg,Where}} -> + io:format("trace_pattern(~p, ~p) ->\n {'EXIT',{badarg,~p}}", + [MFA,Pattern,Where]), + ok; + Other -> + io:format("trace_pattern(~p, ~p) -> ~p", + [MFA, Pattern, Other]), + ?t:fail({unexpected,Other}) + end. + +pam(doc) -> "Basic test of PAM."; +pam(suite) -> []; +pam(Config) when is_list(Config) -> + ?line start_tracer(), + ?line Self = self(), + + %% Build the match program. + ?line Prog1 = {[{a,tuple},'$1'],[],[]}, + ?line Prog2 = {[{a,bigger,tuple},'$1'],[],[{message,'$1'}]}, + ?line MatchProg = [Prog1,Prog2], + ?line pam_trace(MatchProg), + + %% Do some calls. + ?line ?MODULE:pam_foo(not_a_tuple, [a,b]), + ?line ?MODULE:pam_foo({a,tuple}, [a,list]), + ?line ?MODULE:pam_foo([this,one,will,'not',match], dummy_arg), + ?line LongList = lists:seq(1,10), + ?line ?MODULE:pam_foo({a,bigger,tuple}, LongList), + + %% Check that we get the correct trace messages. + ?line expect({trace,Self,call,{?MODULE,pam_foo,[{a,tuple},[a,list]]}}), + ?line expect({trace,Self,call, + {?MODULE,pam_foo,[{a,bigger,tuple},LongList]}, + LongList}), + + ?line trace_func({?MODULE,pam_foo,'_'}, false), + ok. + +pam_trace(Prog) -> + 1 = trace_func({?MODULE,pam_foo,'_'}, Prog), + {match_spec,Prog} = trace_info({?MODULE,pam_foo,2}, match_spec), + ok. + +pam_foo(A, B) -> + {ok,A,B}. + + +change_pam(doc) -> "Test changing PAM programs for a function."; +change_pam(suite) -> []; +change_pam(Config) when is_list(Config) -> + ?line start_tracer(), + ?line Self = self(), + + %% Install the first match program. + %% Test using timestamp at the same time. + + ?line trace_pid(Self, true, [call,arity,timestamp]), + ?line Prog1 = [{['$1','$2'],[],[{message,'$1'}]}], + ?line change_pam_trace(Prog1), + ?line [x,y] = lists:append(id([x]), id([y])), + ?line {heap_size,_} = erlang:process_info(Self, heap_size), + ?line expect({trace_ts,Self,call,{lists,append,2},[x],ts}), + ?line expect({trace_ts,Self,call,{erlang,process_info,2},Self,ts}), + + %% Install a new PAM program. + + ?line Prog2 = [{['$1','$2'],[],[{message,'$2'}]}], + ?line change_pam_trace(Prog2), + ?line [xx,yy] = lists:append(id([xx]), id([yy])), + ?line {current_function,_} = erlang:process_info(Self, current_function), + ?line expect({trace_ts,Self,call,{lists,append,2},[yy],ts}), + ?line expect({trace_ts,Self,call,{erlang,process_info,2},current_function,ts}), + + ?line 1 = trace_func({lists,append,2}, false), + ?line 1 = trace_func({erlang,process_info,2}, false), + ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), + ?line {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), + + ok. + +change_pam_trace(Prog) -> + 1 = trace_func({lists,append,2}, Prog), + 1 = trace_func({erlang,process_info,2}, Prog), + {match_spec,Prog} = trace_info({lists,append,2}, match_spec), + {match_spec,Prog} = trace_info({erlang,process_info,2}, match_spec), + ok. + +return_trace(doc) -> "Test the new return trace."; +return_trace(suite) -> []; +return_trace(Config) when is_list(Config) -> + return_trace(). + +return_trace() -> + X = {save,me}, + ?line start_tracer(), + ?line Self = self(), + + %% Test call and return trace and timestamp. + + ?line trace_pid(Self, true, [call,timestamp]), + Stupid = {pointless,tuple}, + ?line Prog1 = [{['$1','$2'],[],[{return_trace},{message,{Stupid}}]}], + ?line 1 = trace_func({lists,append,2}, Prog1), + ?line 1 = trace_func({erlang,process_info,2}, Prog1), + ?line {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), + ?line {match_spec,Prog1} = trace_info({erlang,process_info,2}, match_spec), + + ?line [x,y] = lists:append(id([x]), id([y])), + Current = {current_function,{?MODULE,return_trace,0}}, + ?line Current = erlang:process_info(Self, current_function), + ?line expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), + ?line expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), + ?line expect({trace_ts,Self,call,{erlang,process_info,[Self,current_function]}, + Stupid,ts}), + ?line expect({trace_ts,Self,return_from,{erlang,process_info,2},Current,ts}), + + %% Try catch/exit. + + ?line 1 = trace_func({?MODULE,nasty,0}, [{[],[],[{return_trace},{message,false}]}]), + ?line {'EXIT',good_bye} = (catch ?MODULE:nasty()), + ?line 1 = trace_func({?MODULE,nasty,0}, false), + + %% Turn off trace. + + ?line 1 = trace_func({lists,append,2}, false), + ?line 1 = trace_func({erlang,process_info,2}, false), + ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), + ?line {match_spec,false} = trace_info({erlang,process_info,2}, match_spec), + + %% No timestamp, no trace message for call. + + ?line trace_pid(Self, false, [timestamp]), + ?line Prog2 = [{['$1','$2'],[],[{return_trace},{message,false}]}, + {['$1'],[],[{return_trace},{message,false}]}], + ?line 1 = trace_func({lists,seq,2}, Prog2), + ?line 1 = trace_func({erlang,atom_to_list,1}, Prog2), + ?line {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), + ?line {match_spec,Prog2} = trace_info({erlang,atom_to_list,1}, match_spec), + + ?line lists:seq(2, 7), + ?line atom_to_list(non_literal(nisse)), + ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), + ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), + + %% Turn off trace. + + ?line 1 = trace_func({lists,seq,2}, false), + ?line 1 = trace_func({erlang,atom_to_list,1}, false), + ?line {match_spec,false} = trace_info({lists,seq,2}, match_spec), + ?line {match_spec,false} = trace_info({erlang,atom_to_list,1}, match_spec), + + ?line {save,me} = X, + + ok. + +nasty() -> + exit(good_bye). + +exception_trace(doc) -> "Test the new exception trace."; +exception_trace(suite) -> []; +exception_trace(Config) when is_list(Config) -> + exception_trace(). + +exception_trace() -> + X = {save,me}, + ?line start_tracer(), + ?line Self = self(), + + %% Test call and return trace and timestamp. + + ?line trace_pid(Self, true, [call,timestamp]), + Stupid = {pointless,tuple}, + ?line Prog1 = [{['$1','$2'],[],[{exception_trace},{message,{Stupid}}]}], + ?line 1 = trace_func({lists,append,2}, Prog1), + ?line 1 = trace_func({erlang,process_info,2}, Prog1), + ?line {match_spec,Prog1} = trace_info({lists,append,2}, match_spec), + ?line {match_spec,Prog1} = + trace_info({erlang,process_info,2}, match_spec), + + ?line [x,y] = lists:append(id([x]), id([y])), + Current = {current_function,{?MODULE,exception_trace,0}}, + ?line Current = erlang:process_info(Self, current_function), + ?line expect({trace_ts,Self,call,{lists,append,[[x],[y]]},Stupid,ts}), + ?line expect({trace_ts,Self,return_from,{lists,append,2},[x,y],ts}), + ?line expect({trace_ts,Self,call,{erlang,process_info, + [Self,current_function]}, + Stupid,ts}), + ?line expect({trace_ts,Self,return_from, + {erlang,process_info,2},Current,ts}), + + %% Try catch/exit. + + ?line 1 = trace_func({?MODULE,nasty,0}, + [{[],[],[{exception_trace},{message,false}]}]), + ?line {'EXIT',good_bye} = (catch ?MODULE:nasty()), + ?line expect({trace_ts,Self,exception_from, + {?MODULE,nasty,0},{exit,good_bye},ts}), + ?line 1 = trace_func({?MODULE,nasty,0}, false), + + %% Turn off trace. + + ?line 1 = trace_func({lists,append,2}, false), + ?line 1 = trace_func({erlang,process_info,2}, false), + ?line {match_spec,false} = trace_info({lists,append,2}, match_spec), + ?line {match_spec,false} = + trace_info({erlang,process_info,2}, match_spec), + + %% No timestamp, no trace message for call. + + ?line trace_pid(Self, false, [timestamp]), + ?line Prog2 = [{['$1','$2'],[],[{exception_trace},{message,false}]}, + {['$1'],[],[{exception_trace},{message,false}]}], + ?line 1 = trace_func({lists,seq,2}, Prog2), + ?line 1 = trace_func({erlang,atom_to_list,1}, Prog2), + ?line {match_spec,Prog2} = trace_info({lists,seq,2}, match_spec), + ?line {match_spec,Prog2} = + trace_info({erlang,atom_to_list,1}, match_spec), + + ?line lists:seq(2, 7), + ?line atom_to_list(non_literal(nisse)), + ?line expect({trace,Self,return_from,{lists,seq,2},[2,3,4,5,6,7]}), + ?line expect({trace,Self,return_from,{erlang,atom_to_list,1},"nisse"}), + + %% Turn off trace. + + ?line 1 = trace_func({lists,seq,2}, false), + ?line 1 = trace_func({erlang,atom_to_list,1}, false), + ?line {match_spec,false} = trace_info({lists,seq,2}, match_spec), + ?line {match_spec,false} = + trace_info({erlang,atom_to_list,1}, match_spec), + + ?line expect(), + ?line {save,me} = X, + ok. + +on_load(doc) -> "Test the on_load argument for trace_pattern/3."; +on_load(suite) -> []; +on_load(Config) when is_list(Config) -> + ?line 0 = erlang:trace_pattern(on_load, []), + ?line {traced,global} = erlang:trace_info(on_load, traced), + ?line {match_spec,[]} = erlang:trace_info(on_load, match_spec), + + ?line 0 = erlang:trace_pattern(on_load, true, [local]), + ?line {traced,local} = erlang:trace_info(on_load, traced), + ?line {match_spec,[]} = erlang:trace_info(on_load, match_spec), + + ?line 0 = erlang:trace_pattern(on_load, false, [local]), + ?line {traced,false} = erlang:trace_info(on_load, traced), + ?line {match_spec,false} = erlang:trace_info(on_load, match_spec), + + ?line Pam1 = [{[],[],[{message,false}]}], + ?line 0 = erlang:trace_pattern(on_load, Pam1), + ?line {traced,global} = erlang:trace_info(on_load, traced), + ?line {match_spec,Pam1} = erlang:trace_info(on_load, match_spec), + + ?line 0 = erlang:trace_pattern(on_load, true, [local]), + ?line 0 = erlang:trace_pattern(on_load, false, [local]), + + ok. + + + +deep_exception(doc) -> "Test the new exception trace."; +deep_exception(suite) -> []; +deep_exception(Config) when is_list(Config) -> + deep_exception(). + +deep_exception() -> + ?line start_tracer(), + ?line Self = self(), + ?line N = 200000, + ?line LongImproperList = seq(1, N-1, N), + + Prog = [{'_',[],[{exception_trace}]}], +%% ?line 1 = trace_pid(Self, true, [call]), + ?line 1 = trace_func({?MODULE,deep,'_'}, Prog), + ?line 1 = trace_func({?MODULE,deep_1,'_'}, Prog), + ?line 1 = trace_func({?MODULE,deep_2,'_'}, Prog), + ?line 1 = trace_func({?MODULE,deep_3,'_'}, Prog), + ?line 1 = trace_func({?MODULE,deep_4,'_'}, Prog), + ?line 1 = trace_func({?MODULE,deep_5,'_'}, Prog), + ?line 1 = trace_func({?MODULE,id,'_'}, Prog), + ?line 1 = trace_func({erlang,'++','_'}, Prog), + ?line 1 = trace_func({erlang,exit,1}, Prog), + ?line 1 = trace_func({erlang,throw,1}, Prog), + ?line 2 = trace_func({erlang,error,'_'}, Prog), + ?line 1 = trace_func({lists,reverse,2}, Prog), + + ?line deep_exception(?LINE, exit, [paprika], 1, + [{trace,Self,call,{erlang,exit,[paprika]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,paprika}}], + exception_from, {exit,paprika}), + ?line deep_exception(?LINE, throw, [3.14], 2, + [{trace,Self,call,{erlang,throw,[3.14]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,3.14}}], + exception_from, {throw,3.14}), + ?line deep_exception(?LINE, error, [{paprika}], 3, + [{trace,Self,call,{erlang,error,[{paprika}]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,{paprika}}}], + exception_from, {error,{paprika}}), + ?line deep_exception(?LINE, error, ["{paprika}",[]], 3, + [{trace,Self,call,{erlang,error,["{paprika}",[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,"{paprika}"}}], + exception_from, {error,"{paprika}"}), + ?line deep_exception(?LINE, id, [broccoli], 4, [], + return_from, broccoli), + ?line deep_exception( + ?LINE, append, [1,2], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + ?line deep_exception(?LINE, '=', [1,2], 6, [], + exception_from, {error,{badmatch,2}}), + %% + ?line io:format("== Subtest: ~w", [?LINE]), + ?line try lists:reverse(LongImproperList, []) of + R1 -> test_server:fail({returned,abbr(R1)}) + catch error:badarg -> ok + end, + ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + ?line deep_exception(?LINE, deep_5, [1,2], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + ?line deep_exception(?LINE, deep_5, [undef], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), + + %% Apply + %% + ?line deep_exception(?LINE, apply, [erlang,error,[[mo|rot]]], 1, + [{trace,Self,call,{erlang,error,[[mo|rot]]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,[mo|rot]}}], + exception_from, {error,[mo|rot]}), + ?line deep_exception(?LINE, apply, [erlang,error,[[mo|"rot"],[]]], 1, + [{trace,Self,call,{erlang,error,[[mo|"rot"],[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,[mo|"rot"]}}], + exception_from, {error,[mo|"rot"]}), + ?line Morot = make_ref(), + ?line deep_exception(?LINE, apply, [erlang,throw,[Morot]], 3, + [{trace,Self,call,{erlang,throw,[Morot]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,Morot}}], + exception_from, {throw,Morot}), + ?line deep_exception(?LINE, apply, [erlang,exit,[["morot"|Morot]]], 2, + [{trace,Self,call,{erlang,exit,[["morot"|Morot]]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,["morot"|Morot]}}], + exception_from, {exit,["morot"|Morot]}), + ?line deep_exception( + ?LINE, apply, [?MODULE,id,[spenat]], 4, + [{trace,Self,call,{?MODULE,id,[spenat]}}, + {trace,Self,return_from,{?MODULE,id,1},spenat}], + return_from, spenat), + ?line deep_exception( + ?LINE, apply, [erlang,'++',[1,2]], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from,{erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + ?line io:format("== Subtest: ~w", [?LINE]), + ?line try apply(lists, reverse, [LongImproperList, []]) of + R2 -> test_server:fail({returned,abbr(R2)}) + catch error:badarg -> ok + end, + ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + ?line deep_exception(?LINE, apply, [?MODULE,deep_5,[1,2]], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + ?line deep_exception(?LINE, apply, [?MODULE,deep_5,[undef]], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), + %% Apply of fun + %% + ?line deep_exception(?LINE, apply, + [fun () -> + erlang:error([{"palsternacka",3.14},17]) + end, []], 1, + [{trace,Self,call, + {erlang,error,[[{"palsternacka",3.14},17]]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,[{"palsternacka",3.14},17]}}], + exception_from, {error,[{"palsternacka",3.14},17]}), + ?line deep_exception(?LINE, apply, + [fun () -> + erlang:error(["palsternacka",17], []) + end, []], 1, + [{trace,Self,call, + {erlang,error,[["palsternacka",17],[]]}}, + {trace,Self,exception_from,{erlang,error,2}, + {error,["palsternacka",17]}}], + exception_from, {error,["palsternacka",17]}), + ?line deep_exception(?LINE, apply, + [fun () -> erlang:throw(Self) end, []], 2, + [{trace,Self,call,{erlang,throw,[Self]}}, + {trace,Self,exception_from,{erlang,throw,1}, + {throw,Self}}], + exception_from, {throw,Self}), + ?line deep_exception(?LINE, apply, + [fun () -> + erlang:exit({1,2,3,4,[5,palsternacka]}) + end, []], 3, + [{trace,Self,call, + {erlang,exit,[{1,2,3,4,[5,palsternacka]}]}}, + {trace,Self,exception_from,{erlang,exit,1}, + {exit,{1,2,3,4,[5,palsternacka]}}}], + exception_from, {exit,{1,2,3,4,[5,palsternacka]}}), + ?line deep_exception(?LINE, apply, + [fun () -> ?MODULE:id(bladsallad) end, []], 4, + [{trace,Self,call,{?MODULE,id,[bladsallad]}}, + {trace,Self,return_from,{?MODULE,id,1},bladsallad}], + return_from, bladsallad), + ?line deep_exception(?LINE, apply, + [fun (A, B) -> A ++ B end, [1,2]], 5, + [{trace,Self,call,{erlang,'++',[1,2]}}, + {trace,Self,exception_from, + {erlang,'++',2},{error,badarg}}], + exception_from, {error,badarg}), + ?line deep_exception(?LINE, apply, [fun (A, B) -> A = B end, [1,2]], 6, + [], + exception_from, {error,{badmatch,2}}), + ?line io:format("== Subtest: ~w", [?LINE]), + ?line try apply(fun() -> lists:reverse(LongImproperList, []) end, []) of + R3 -> test_server:fail({returned,abbr(R3)}) + catch error:badarg -> ok + end, + ?line expect(fun ({trace,S,call,{lists,reverse,[L1,L2]}}) + when is_list(L1), is_list(L2), S == Self -> + next; + ({trace,S,exception_from, + {lists,reverse,2},{error,badarg}}) + when S == Self -> + expected; + ('_') -> + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}; + (_) -> + {unexpected, + {trace,Self,exception_from, + {lists,reverse,2},{error,badarg}}} + end), + ?line deep_exception(?LINE, apply, + [fun () -> ?MODULE:deep_5(1,2) end, []], 7, + [{trace,Self,call,{erlang,error,[undef]}}, + {trace,Self,exception_from,{erlang,error,1}, + {error,undef}}], + exception_from, {error,undef}), + ?line deep_exception(?LINE, apply, + [fun () -> ?MODULE:deep_5(undef) end, []], 8, + [{trace,Self,call,{?MODULE,deep_5,[undef]}}, + {trace,Self,exception_from,{?MODULE,deep_5,1}, + {error,function_clause}}], + exception_from, {error,function_clause}), + + ?line trace_func({?MODULE,'_','_'}, false), + ?line trace_func({erlang,'_','_'}, false), + ?line trace_func({lists,'_','_'}, false), + ?line expect(), + ?line ok. + + +deep_exception(Line, B, Q, N, Extra, Tag, R) -> + ?line Self = self(), + ?line io:format("== Subtest: ~w", [Line]), + ?line Result = ?MODULE:deep(N, B, Q), + ?line Result = deep_expect(Self, B, Q, N, Extra, Tag, R). + +deep_expect(Self, B, Q, N, Extra, Tag, R) -> + ?line expect({trace,Self,call,{?MODULE,deep,[N,B,Q]}}), + ?line Result = deep_expect_N(Self, B, Q, N, Extra, Tag, R), + ?line expect({trace,Self,return_from,{?MODULE,deep,3},Result}), + ?line Result. + +deep_expect_N(Self, B, Q, N, Extra, Tag, R) -> + deep_expect_N(Self, B, Q, N, Extra, Tag, R, N). + +deep_expect_N(Self, B, Q, N, Extra, Tag, R, J) when J > 0 -> + ?line expect({trace,Self,call,{?MODULE,deep_1,[J,B,Q]}}), + ?line deep_expect_N(Self, B, Q, N, Extra, Tag, R, J-1); +deep_expect_N(Self, B, Q, N, Extra, Tag, R, 0) -> + ?line expect({trace,Self,call,{?MODULE,deep_2,[B,Q]}}), + ?line expect({trace,Self,call,{?MODULE,deep_3,[B,Q]}}), + ?line expect({trace,Self,return_from,{?MODULE,deep_3,2},{B,Q}}), + ?line expect({trace,Self,call,{?MODULE,deep_4,[{B,Q}]}}), + ?line expect({trace,Self,call,{?MODULE,id,[{B,Q}]}}), + ?line expect({trace,Self,return_from,{?MODULE,id,1},{B,Q}}), + ?line deep_expect_Extra(Self, N, Extra, Tag, R), + ?line expect({trace,Self,Tag,{?MODULE,deep_4,1},R}), + ?line expect({trace,Self,Tag,{?MODULE,deep_2,2},R}), + ?line deep_expect_N(Self, N, Tag, R). + +deep_expect_Extra(Self, N, [E|Es], Tag, R) -> + ?line expect(E), + ?line deep_expect_Extra(Self, N, Es, Tag, R); +deep_expect_Extra(_Self, _N, [], _Tag, _R) -> + ?line ok. + +deep_expect_N(Self, N, Tag, R) when N > 0 -> + ?line expect({trace,Self,Tag,{?MODULE,deep_1,3},R}), + ?line deep_expect_N(Self, N-1, Tag, R); +deep_expect_N(_Self, 0, return_from, R) -> + ?line {value,R}; +deep_expect_N(_Self, 0, exception_from, R) -> + ?line R. + + + +exception_nocatch(doc) -> "Test the new exception trace."; +exception_nocatch(suite) -> []; +exception_nocatch(Config) when is_list(Config) -> + exception_nocatch(). + +exception_nocatch() -> + Prog = [{'_',[],[{exception_trace}]}], + ?line 1 = erlang:trace_pattern({?MODULE,deep_1,'_'}, Prog), + ?line 1 = erlang:trace_pattern({?MODULE,deep_2,'_'}, Prog), + ?line 1 = erlang:trace_pattern({?MODULE,deep_3,'_'}, Prog), + ?line 1 = erlang:trace_pattern({?MODULE,deep_4,'_'}, Prog), + ?line 1 = erlang:trace_pattern({?MODULE,deep_5,'_'}, Prog), + ?line 1 = erlang:trace_pattern({?MODULE,id,'_'}, Prog), + ?line 1 = erlang:trace_pattern({erlang,exit,1}, Prog), + ?line 1 = erlang:trace_pattern({erlang,throw,1}, Prog), + ?line 2 = erlang:trace_pattern({erlang,error,'_'}, Prog), + ?line Q1 = {make_ref(),Prog}, + ?line T1 = + exception_nocatch(?LINE, exit, [Q1], 3, + [{trace,t1,call,{erlang,exit,[Q1]}}, + {trace,t1,exception_from,{erlang,exit,1}, + {exit,Q1}}], + exception_from, {exit,Q1}), + ?line expect({trace,T1,exit,Q1}), + ?line Q2 = {cake,14.125}, + ?line T2 = + exception_nocatch(?LINE, throw, [Q2], 2, + [{trace,t2,call,{erlang,throw,[Q2]}}, + {trace,t2,exception_from,{erlang,throw,1}, + {error,{nocatch,Q2}}}], + exception_from, {error,{nocatch,Q2}}), + ?line expect({trace,T2,exit,{{nocatch,Q2},[{erlang,throw,[Q2]}, + {?MODULE,deep_4,1}]}}), + ?line Q3 = {dump,[dump,{dump}]}, + ?line T3 = + exception_nocatch(?LINE, error, [Q3], 4, + [{trace,t3,call,{erlang,error,[Q3]}}, + {trace,t3,exception_from,{erlang,error,1}, + {error,Q3}}], + exception_from, {error,Q3}), + ?line expect({trace,T3,exit,{Q3,[{erlang,error,[Q3]}, + {?MODULE,deep_4,1}]}}), + ?line T4 = + exception_nocatch(?LINE, '=', [17,4711], 5, [], + exception_from, {error,{badmatch,4711}}), + ?line expect({trace,T4,exit,{{badmatch,4711},[{?MODULE,deep_4,1}]}}), + %% + ?line erlang:trace_pattern({?MODULE,'_','_'}, false), + ?line erlang:trace_pattern({erlang,'_','_'}, false), + ?line expect(), + ?line ok. + +exception_nocatch(Line, B, Q, N, Extra, Tag, R) -> + ?line io:format("== Subtest: ~w", [Line]), + ?line Go = make_ref(), + ?line Tracee = + spawn(fun () -> + receive + Go -> + deep_1(N, B, Q) + end + end), + ?line 1 = erlang:trace(Tracee, true, [call,return_to,procs]), + ?line Tracee ! Go, + ?line deep_expect_N(Tracee, B, Q, N-1, + [setelement(2, T, Tracee) || T <- Extra], Tag, R), + ?line Tracee. + +%% Make sure that code that uses the optimized bit syntax matching +%% can be traced without crashing the emulator. (Actually, it seems +%% that we can't trigger the bug using external call trace, but we +%% will keep the test case anyway.) + +bit_syntax(Config) when is_list(Config) -> + ?line start_tracer(), + ?line 1 = trace_func({?MODULE,bs_sum_a,'_'}, []), + ?line 1 = trace_func({?MODULE,bs_sum_b,'_'}, []), + + ?line 6 = call_bs_sum_a(<<1,2,3>>), + ?line 10 = call_bs_sum_b(<<1,2,3,4>>), + + ?line trace_func({?MODULE,'_','_'}, false), + ?line erlang:trace_delivered(all), + receive + {trace_delivered,_,_} -> ok + end, + + Self = self(), + ?line expect({trace,Self,call,{?MODULE,bs_sum_a,[<<2,3>>,1]}}), + ?line expect({trace,Self,call,{?MODULE,bs_sum_b,[1,<<2,3,4>>]}}), + + ok. + +call_bs_sum_a(<>) -> + ?MODULE:bs_sum_a(T, H). + +call_bs_sum_b(<>) -> + ?MODULE:bs_sum_b(H, T). + +bs_sum_a(<>, Acc) -> bs_sum_a(T, H+Acc); +bs_sum_a(<<>>, Acc) -> Acc. + +bs_sum_b(Acc, <>) -> bs_sum_b(H+Acc, T); +bs_sum_b(Acc, <<>>) -> Acc. + + + + +%%% Help functions. + +expect() -> + case flush() of + [] -> ok; + Msgs -> + test_server:fail({unexpected,abbr(Msgs)}) + end. + +expect({trace_ts,Pid,Type,MFA,Term,ts}=Message) -> + receive + M -> + case M of + {trace_ts,Pid,Type,MFA,Term,Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [abbr(MessageTs)]), + Ts; + _ -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + test_server:fail({unexpected,abbr([M|flush()])}) + end + after 5000 -> + io:format("Expected ~p; got nothing", [abbr(Message)]), + test_server:fail(no_trace_message) + end; +expect({trace_ts,Pid,Type,MFA,ts}=Message) -> + receive + M -> + case M of + {trace_ts,Pid,Type,MFA,Ts} -> + ok = io:format("Expected and got ~p", [abbr(M)]), + Ts; + _ -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + test_server:fail({unexpected,abbr([M|flush()])}) + end + after 5000 -> + io:format("Expected ~p; got nothing", [abbr(Message)]), + test_server:fail(no_trace_message) + end; +expect(Validator) when is_function(Validator) -> + receive + M -> + case Validator(M) of + expected -> + ok = io:format("Expected and got ~p", [abbr(M)]); + next -> + ok = io:format("Expected and got ~p", [abbr(M)]), + expect(Validator); + {unexpected,Message} -> + io:format("Expected ~p; got ~p", [abbr(Message),abbr(M)]), + test_server:fail({unexpected,abbr([M|flush()])}) + end + after 5000 -> + io:format("Expected ~p; got nothing", [abbr(Validator('_'))]), + test_server:fail(no_trace_message) + end; +expect(Message) -> + receive + M -> + case M of + Message -> + ok = io:format("Expected and got ~p", [abbr(Message)]); + Other -> + io:format("Expected ~p; got ~p", + [abbr(Message),abbr(Other)]), + test_server:fail({unexpected,abbr([Other|flush()])}) + end + after 5000 -> + io:format("Expected ~p; got nothing", [abbr(Message)]), + test_server:fail(no_trace_message) + end. + +trace_info(What, Key) -> + get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}}, + Res = receive + {apply_result,Result} -> Result + end, + ok = io:format("erlang:trace_info(~p, ~p) -> ~p", + [What,Key,Res]), + Res. + +trace_func(MFA, MatchSpec) -> + get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA, MatchSpec]}}, + Res = receive + {apply_result,Result} -> Result + end, + ok = io:format("trace_pattern(~p, ~p) -> ~p", [MFA,MatchSpec,Res]), + Res. + +trace_pid(Pid, On, Flags) -> + get(tracer) ! {apply,self(),{erlang,trace,[Pid,On,Flags]}}, + Res = receive + {apply_result,Result} -> Result + end, + ok = io:format("trace(~p, ~p, ~p) -> ~p", [Pid,On,Flags,Res]), + Res. + +start_tracer() -> + Self = self(), + put(tracer, spawn(fun() -> tracer(Self) end)), + get(tracer). + +start_tracer_loop() -> + Self = self(), + put(tracer, spawn(fun() -> tracer_loop(Self) end)), + get(tracer). + +tracer(RelayTo) -> + erlang:trace(RelayTo, true, [call]), + tracer_loop(RelayTo). + +tracer_loop(RelayTo) -> + receive + {apply,From,{M,F,A}} -> + From ! {apply_result,apply(M, F, A)}, + tracer_loop(RelayTo); + Msg -> + RelayTo ! Msg, + tracer_loop(RelayTo) + end. + +id(I) -> I. + +deep(N, Class, Reason) -> + try ?MODULE:deep_1(N, Class, Reason) of + Value -> {value,Value} + catch C:R -> {C,R} + end. + +deep_1(1, Class, Reason) -> + ?MODULE:deep_2(Class, Reason); +deep_1(N, Class, Reason) when is_integer(N), N > 1 -> + ?MODULE:deep_1(N-1, Class, Reason). + +deep_2(Class, Reason) -> + ?MODULE:deep_4(?MODULE:deep_3(Class, Reason)). + +deep_3(Class, Reason) -> + {Class,Reason}. + +deep_4(CR) -> + case ?MODULE:id(CR) of + {exit,[Reason]} -> + erlang:exit(Reason); + {throw,[Reason]} -> + erlang:throw(Reason); + {error,[Reason,Arglist]} -> + erlang:error(Reason, Arglist); + {error,[Reason]} -> + erlang:error(Reason); + {id,[Reason]} -> + Reason; + {reverse,[A,B]} -> + lists:reverse(A, B); + {append,[A,B]} -> + A ++ B; + {apply,[Fun,Args]} -> + erlang:apply(Fun, Args); + {apply,[M,F,Args]} -> + erlang:apply(M, F, Args); + {deep_5,[A,B]} -> + ?MODULE:deep_5(A, B); + {deep_5,[A]} -> + ?MODULE:deep_5(A); + {'=',[A,B]} -> + A = B + end. + +deep_5(A) when is_integer(A) -> + A. + +flush() -> + receive X -> + [X|flush()] + after 1000 -> + [] + end. + +%% Abbreviate large complex terms +abbr(Term) -> + abbr(Term, 20). +%% +abbr(Tuple, N) when is_tuple(Tuple) -> + abbr_tuple(Tuple, 1, N, []); +abbr(List, N) when is_list(List) -> + abbr_list(List, N, []); +abbr(Term, _) -> Term. +%% +abbr_tuple(_, _, 0, R) -> + list_to_tuple(reverse(R, ['...'])); +abbr_tuple(Tuple, J, N, R) when J =< size(Tuple) -> + M = N-1, + abbr_tuple(Tuple, J+1, M, [abbr(element(J, Tuple), M)|R]); +abbr_tuple(_, _, _, R) -> + list_to_tuple(reverse(R)). +%% +abbr_list(_, 0, R) -> + case io_lib:printable_list(R) of + true -> + reverse(R, "..."); + false -> + reverse(R, '...') + end; +abbr_list([H|T], N, R) -> + M = N-1, + abbr_list(T, M, [abbr(H, M)|R]); +abbr_list(T, _, R) -> + reverse(R, T). + +%% Lean and mean list functions + +%% Do not build garbage +seq(M, N, R) when M =< N -> + seq(M, N-1, [N|R]); +seq(_, _, R) -> R. + +%% lists:reverse can not be called since it is traced +reverse(L) -> + reverse(L, []). +%% +reverse([], R) -> R; +reverse([H|T], R) -> + reverse(T, [H|R]). diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl new file mode 100644 index 0000000000..33351a3cc9 --- /dev/null +++ b/erts/emulator/test/code_SUITE.erl @@ -0,0 +1,520 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(code_SUITE). +-export([all/1, + new_binary_types/1,t_check_process_code/1,t_check_process_code_ets/1, + external_fun/1,get_chunk/1,module_md5/1,make_stub/1, + make_stub_many_funs/1,constant_pools/1, + false_dependency/1,coverage/1]). + +-include("test_server.hrl"). + +all(suite) -> + [new_binary_types,t_check_process_code,t_check_process_code_ets, + external_fun,get_chunk,module_md5,make_stub,make_stub_many_funs, + constant_pools,false_dependency,coverage]. + +new_binary_types(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "my_code_test"), + ?line {ok,my_code_test,Bin} = compile:file(File, [binary]), + ?line {module,my_code_test} = erlang:load_module(my_code_test, + make_sub_binary(Bin)), + ?line true = erlang:delete_module(my_code_test), + ?line true = erlang:purge_module(my_code_test), + + ?line {module,my_code_test} = erlang:load_module(my_code_test, + make_unaligned_sub_binary(Bin)), + ?line true = erlang:delete_module(my_code_test), + ?line true = erlang:purge_module(my_code_test), + + %% Try heap binaries and bad binaries. + ?line {error,badfile} = erlang:load_module(my_code_test, <<1,2>>), + ?line {error,badfile} = erlang:load_module(my_code_test, + make_sub_binary(<<1,2>>)), + ?line {error,badfile} = erlang:load_module(my_code_test, + make_unaligned_sub_binary(<<1,2>>)), + ?line {'EXIT',{badarg,_}} = (catch erlang:load_module(my_code_test, + bit_sized_binary(Bin))), + ok. + +t_check_process_code(doc) -> "Test check_process_code/2."; +t_check_process_code(Config) when is_list(Config) -> + case erlang:system_info(heap_type) of + private -> t_check_process_code_1(Config); + hybrid -> {skip,"Hybrid heap"} + end. + +t_check_process_code_1(Config) -> + ?line Priv = ?config(priv_dir, Config), + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "my_code_test"), + ?line Code = filename:join(Priv, "my_code_test"), + + ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]), + + ?line MyFun = fun(X, Y) -> X + Y end, %Confuse things. + ?line F = my_code_test:make_fun(42), + ?line 2 = fun_refc(F), + ?line MyFun2 = fun(X, Y) -> X * Y end, %Confuse things. + ?line 44 = F(2), + + %% Delete the module and call the fun again. + ?line true = erlang:delete_module(my_code_test), + ?line 2 = fun_refc(F), + ?line 45 = F(3), + ?line {'EXIT',{undef,_}} = (catch my_code_test:make_fun(33)), + + %% The fun should still be there, preventing purge. + ?line true = erlang:check_process_code(self(), my_code_test), + gc(), + gc(), %Place funs on the old heap. + ?line true = erlang:check_process_code(self(), my_code_test), + + %% Using the funs here guarantees that they will not be prematurely garbed. + ?line 48 = F(6), + ?line 3 = MyFun(1, 2), + ?line 12 = MyFun2(3, 4), + + %% Kill all funs. + t_check_process_code1(Code, []). + +%% The real fun was killed, but we have some fakes which look similar. + +t_check_process_code1(Code, Fakes) -> + ?line MyFun = fun(X, Y) -> X + Y + 1 end, %Confuse things. + ?line false = erlang:check_process_code(self(), my_code_test), + ?line 4 = MyFun(1, 2), + t_check_process_code2(Code, Fakes). + +t_check_process_code2(Code, _) -> + ?line false = erlang:check_process_code(self(), my_code_test), + ?line true = erlang:purge_module(my_code_test), + + %% In the next test we will load the same module twice. + ?line {module,my_code_test} = code:load_abs(Code), + ?line F = my_code_test:make_fun(37), + ?line 2 = fun_refc(F), + ?line false = erlang:check_process_code(self(), my_code_test), + ?line {module,my_code_test} = code:load_abs(Code), + ?line 2 = fun_refc(F), + + %% Still false because the fun with the same identify is found + %% in the current code. + ?line false = erlang:check_process_code(self(), my_code_test), + + %% Some fake funs in the same module should not do any difference. + ?line false = erlang:check_process_code(self(), my_code_test), + + 38 = F(1), + t_check_process_code3(Code, F, []). + +t_check_process_code3(Code, F, Fakes) -> + Pid = spawn_link(fun() -> body(F, Fakes) end), + ?line true = erlang:purge_module(my_code_test), + ?line false = erlang:check_process_code(self(), my_code_test), + ?line false = erlang:check_process_code(Pid, my_code_test), + + ?line true = erlang:delete_module(my_code_test), + ?line true = erlang:check_process_code(self(), my_code_test), + ?line true = erlang:check_process_code(Pid, my_code_test), + 39 = F(2), + t_check_process_code4(Code, Pid). + +t_check_process_code4(_Code, Pid) -> + Pid ! drop_funs, + receive after 1 -> ok end, + ?line false = erlang:check_process_code(Pid, my_code_test), + ok. + +body(F, Fakes) -> + receive + jog -> + 40 = F(3), + erlang:garbage_collect(), + body(F, Fakes); + drop_funs -> + dropped_body() + end. + +dropped_body() -> + receive + X -> exit(X) + end. + +gc() -> + erlang:garbage_collect(), + gc1(). +gc1() -> ok. + +t_check_process_code_ets(doc) -> + "Test check_process_code/2 in combination with a fun obtained from an ets table."; +t_check_process_code_ets(Config) when is_list(Config) -> + case {test_server:is_native(?MODULE),erlang:system_info(heap_type)} of + {true,_} -> + {skipped,"Native code"}; + {_,hybrid} -> + {skipped,"Hybrid heap"}; + {false,private} -> + do_check_process_code_ets(Config) + end. + +do_check_process_code_ets(Config) -> + ?line Priv = ?config(priv_dir, Config), + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "my_code_test"), + + ?line erlang:purge_module(my_code_test), + ?line erlang:delete_module(my_code_test), + ?line {ok,my_code_test} = c:c(File, [{outdir,Priv}]), + + ?line T = ets:new(my_code_test, []), + ?line ets:insert(T, {7,my_code_test:make_fun(107)}), + ?line ets:insert(T, {8,my_code_test:make_fun(108)}), + ?line erlang:delete_module(my_code_test), + ?line false = erlang:check_process_code(self(), my_code_test), + Body = fun() -> + [{7,F1}] = ets:lookup(T, 7), + [{8,F2}] = ets:lookup(T, 8), + IdleLoop = fun() -> receive _X -> ok end end, + RecLoop = fun(Again) -> + receive + call -> 110 = F1(3), + 100 = F2(-8), + Again(Again); + {drop_funs,To} -> + To ! funs_dropped, + IdleLoop() + end + end, + true = erlang:check_process_code(self(), my_code_test), + RecLoop(RecLoop) + end, + ?line Pid = spawn_link(Body), + receive after 1 -> ok end, + ?line true = erlang:check_process_code(Pid, my_code_test), + Pid ! call, + Pid ! {drop_funs,self()}, + + receive + funs_dropped -> ok; + Other -> ?t:fail({unexpected,Other}) + after 10000 -> + ?line ?t:fail(no_funs_dropped_answer) + end, + + ?line false = erlang:check_process_code(Pid, my_code_test), + ok. + +fun_refc(F) -> + {refc,Count} = erlang:fun_info(F, refc), + Count. + + +external_fun(Config) when is_list(Config) -> + ?line false = erlang:function_exported(another_code_test, x, 1), + ?line ExtFun = erlang:make_fun(id(another_code_test), x, 1), + ?line {'EXIT',{undef,_}} = (catch ExtFun(answer)), + ?line false = erlang:function_exported(another_code_test, x, 1), + ?line false = lists:member(another_code_test, erlang:loaded()), + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "another_code_test"), + ?line {ok,another_code_test,Code} = compile:file(File, [binary,report]), + ?line {module,another_code_test} = erlang:load_module(another_code_test, Code), + ?line 42 = ExtFun(answer), + ok. + +get_chunk(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "my_code_test"), + ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + + %% Should work. + ?line Chunk = get_chunk_ok("Atom", Code), + ?line Chunk = get_chunk_ok("Atom", make_sub_binary(Code)), + ?line Chunk = get_chunk_ok("Atom", make_unaligned_sub_binary(Code)), + + %% Should fail. + ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(bit_sized_binary(Code), "Atom")), + ?line {'EXIT',{badarg,_}} = (catch code:get_chunk(Code, "bad chunk id")), + + %% Invalid beam code or missing chunk should return 'undefined'. + ?line undefined = code:get_chunk(<<"not a beam module">>, "Atom"), + ?line undefined = code:get_chunk(Code, "XXXX"), + + ok. + +get_chunk_ok(Chunk, Code) -> + case code:get_chunk(Code, Chunk) of + Bin when is_binary(Bin) -> Bin + end. + +module_md5(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "my_code_test"), + ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + + %% Should work. + ?line Chunk = module_md5_ok(Code), + ?line Chunk = module_md5_ok(make_sub_binary(Code)), + ?line Chunk = module_md5_ok(make_unaligned_sub_binary(Code)), + + %% Should fail. + ?line {'EXIT',{badarg,_}} = (catch code:module_md5(bit_sized_binary(Code))), + + %% Invalid beam code should return 'undefined'. + ?line undefined = code:module_md5(<<"not a beam module">>), + ok. + +module_md5_ok(Code) -> + case code:module_md5(Code) of + Bin when is_binary(Bin), size(Bin) =:= 16 -> Bin + end. + + +make_stub(Config) when is_list(Config) -> + %% No old code to purge if hybrid heap because of skipped test cases, + %% so we'll need a catch here. + ?line (catch erlang:purge_module(my_code_test)), + + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "my_code_test"), + ?line {ok,my_code_test,Code} = compile:file(File, [binary]), + + ?line my_code_test = code:make_stub_module(my_code_test, Code, {[],[]}), + ?line true = erlang:delete_module(my_code_test), + ?line true = erlang:purge_module(my_code_test), + + ?line my_code_test = code:make_stub_module(my_code_test, + make_unaligned_sub_binary(Code), + {[],[]}), + ?line true = erlang:delete_module(my_code_test), + ?line true = erlang:purge_module(my_code_test), + + ?line my_code_test = code:make_stub_module(my_code_test, zlib:gzip(Code), + {[],[]}), + ?line true = erlang:delete_module(my_code_test), + ?line true = erlang:purge_module(my_code_test), + + %% Should fail. + ?line {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test, <<"bad">>, {[],[]})), + ?line {'EXIT',{badarg,_}} = + (catch code:make_stub_module(my_code_test, + bit_sized_binary(Code), + {[],[]})), + ok. + +make_stub_many_funs(Config) when is_list(Config) -> + %% No old code to purge if hybrid heap because of skipped test cases, + %% so we'll need a catch here. + ?line (catch erlang:purge_module(many_funs)), + + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "many_funs"), + ?line {ok,many_funs,Code} = compile:file(File, [binary]), + + ?line many_funs = code:make_stub_module(many_funs, Code, {[],[]}), + ?line true = erlang:delete_module(many_funs), + ?line true = erlang:purge_module(many_funs), + ?line many_funs = code:make_stub_module(many_funs, + make_unaligned_sub_binary(Code), + {[],[]}), + ?line true = erlang:delete_module(many_funs), + ?line true = erlang:purge_module(many_funs), + + %% Should fail. + ?line {'EXIT',{badarg,_}} = + (catch code:make_stub_module(many_funs, <<"bad">>, {[],[]})), + ?line {'EXIT',{badarg,_}} = + (catch code:make_stub_module(many_funs, + bit_sized_binary(Code), + {[],[]})), + ok. + +constant_pools(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "literals"), + ?line {ok,literals,Code} = compile:file(File, [report,binary,constant_pool]), + ?line {module,literals} = erlang:load_module(literals, + make_sub_binary(Code)), + + %% Initialize. + ?line A = literals:a(), + ?line B = literals:b(), + ?line C = literals:huge_bignum(), + ?line process_flag(trap_exit, true), + Self = self(), + + %% Have a process WITHOUT old heap that references the literals + %% in the 'literals' module. + ?line NoOldHeap = spawn_link(fun() -> no_old_heap(Self) end), + receive go -> ok end, + ?line true = erlang:delete_module(literals), + ?line false = erlang:check_process_code(NoOldHeap, literals), + ?line erlang:check_process_code(self(), literals), + ?line true = erlang:purge_module(literals), + ?line NoOldHeap ! done, + ?line receive + {'EXIT',NoOldHeap,{A,B,C}} -> + ok; + Other -> + ?line ?t:fail({unexpected,Other}) + end, + ?line {module,literals} = erlang:load_module(literals, Code), + + %% Have a process WITH an old heap that references the literals + %% in the 'literals' module. + ?line OldHeap = spawn_link(fun() -> old_heap(Self) end), + receive go -> ok end, + ?line true = erlang:delete_module(literals), + ?line false = erlang:check_process_code(OldHeap, literals), + ?line erlang:check_process_code(self(), literals), + ?line erlang:purge_module(literals), + ?line OldHeap ! done, + receive + {'EXIT',OldHeap,{A,B,C,[1,2,3|_]=Seq}} when length(Seq) =:= 16 -> + ok + end. + +no_old_heap(Parent) -> + A = literals:a(), + B = literals:b(), + Res = {A,B,literals:huge_bignum()}, + Parent ! go, + receive + done -> + exit(Res) + end. + +old_heap(Parent) -> + A = literals:a(), + B = literals:b(), + Res = {A,B,literals:huge_bignum(),lists:seq(1, 16)}, + create_old_heap(), + Parent ! go, + receive + done -> + exit(Res) + end. + +create_old_heap() -> + case process_info(self(), [heap_size,total_heap_size]) of + [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total -> + ok; + _ -> + create_old_heap() + end. + +%% OTP-7559: c_p->cp could contain garbage and create a false dependency +%% to a module in a process. (Thanks to Richard Carlsson.) +false_dependency(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "cpbugx"), + ?line {ok,cpbugx,Code} = compile:file(File, [binary,report]), + + do_false_dependency(fun cpbugx:before/0, Code), + do_false_dependency(fun cpbugx:before2/0, Code), + do_false_dependency(fun cpbugx:before3/0, Code), + +%% %% Spawn process. Make sure it has called cpbugx:before/0 and returned. +%% Parent = self(), +%% ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent) end), +%% ?line receive initialized -> ok end, + +%% %% Reload the module. Make sure the process is still alive. +%% ?line {module,cpbugx} = erlang:load_module(cpbugx, Bin), +%% ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), +%% ?line true = is_process_alive(Pid), + +%% %% There should not be any dependency to cpbugx. +%% ?line false = erlang:check_process_code(Pid, cpbugx), + + + + +%% %% Kill the process. +%% ?line unlink(Pid), exit(Pid, kill), + ok. + +do_false_dependency(Init, Code) -> + ?line {module,cpbugx} = erlang:load_module(cpbugx, Code), + + %% Spawn process. Make sure it has the appropriate init function + %% and returned. CP should not contain garbage after the return. + Parent = self(), + ?line Pid = spawn_link(fun() -> false_dependency_loop(Parent, Init) end), + ?line receive initialized -> ok end, + + %% Reload the module. Make sure the process is still alive. + ?line {module,cpbugx} = erlang:load_module(cpbugx, Code), + ?line io:put_chars(binary_to_list(element(2, process_info(Pid, backtrace)))), + ?line true = is_process_alive(Pid), + + %% There should not be any dependency to cpbugx. + ?line false = erlang:check_process_code(Pid, cpbugx), + + %% Kill the process and completely unload the code. + ?line unlink(Pid), exit(Pid, kill), + ?line true = erlang:purge_module(cpbugx), + ?line true = erlang:delete_module(cpbugx), + ?line true = erlang:purge_module(cpbugx), + ok. + +false_dependency_loop(Parent, Init) -> + Init(), + Parent ! initialized, + receive + _ -> false_dependency_loop(Parent, Init) + end. + +coverage(Config) when is_list(Config) -> + ?line code:is_module_native(?MODULE), + ?line {'EXIT',{badarg,_}} = (catch erlang:purge_module({a,b,c})), + ?line {'EXIT',{badarg,_}} = (catch code:is_module_native({a,b,c})), + ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(not_a_pid, ?MODULE)), + ?line {'EXIT',{badarg,_}} = (catch erlang:check_process_code(self(), [not_a_module])), + ?line {'EXIT',{badarg,_}} = (catch erlang:delete_module([a,b,c])), + ?line {'EXIT',{badarg,_}} = (catch erlang:module_loaded(42)), + ok. + +%% Utilities. + +make_sub_binary(Bin) when is_binary(Bin) -> + {_,B1} = split_binary(list_to_binary([0,1,3,Bin,4,5,6,7]), 3), + {B,_} = split_binary(B1, size(Bin)), + B; +make_sub_binary(List) -> + make_sub_binary(list_to_binary(List)). + +make_unaligned_sub_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +%% Add 1 bit to the size of the binary. +bit_sized_binary(Bin0) -> + Bin = <>, + BitSize = bit_size(Bin), + BitSize = 8*size(Bin) + 1, + Bin. + +id(I) -> I. diff --git a/erts/emulator/test/code_SUITE_data/another_code_test.erl b/erts/emulator/test/code_SUITE_data/another_code_test.erl new file mode 100644 index 0000000000..1c9b5bdb5b --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/another_code_test.erl @@ -0,0 +1,23 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(another_code_test). +-export([x/1]). + +x(answer) -> 42. diff --git a/erts/emulator/test/code_SUITE_data/cpbugx.erl b/erts/emulator/test/code_SUITE_data/cpbugx.erl new file mode 100644 index 0000000000..fb617c1973 --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/cpbugx.erl @@ -0,0 +1,45 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(cpbugx). + +-export([before/0,before2/0,before3/0]). + +before() -> + 1 + lethal(). + +lethal() -> + 4711. + +before2() -> + {status,lethal2(self())}. + +lethal2(Pid) -> + try + is_process_alive(Pid) + catch + _ -> + error + end. + +before3() -> + atom_to_list(lethal3(self())). + +lethal3(Pid) -> + Pid ! garbage. diff --git a/erts/emulator/test/code_SUITE_data/literals.erl b/erts/emulator/test/code_SUITE_data/literals.erl new file mode 100644 index 0000000000..9f99b1a780 --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/literals.erl @@ -0,0 +1,83 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(literals). +-export([a/0,b/0,huge_bignum/0]). + +a() -> + {a,42.0,[7,38877938333399637266518333334747]}. + +b() -> + [{init,get_flag,1}, + {init,get_flags,0}, + {init,get_args,0}, + {string,re_sh_to_awk,1}, + {string,re_parse,1}, + {string,re_match,2}, + {string,re_sub,3}, + {string,re_gsub,3}, + {string,re_split,2}, + {string,index,2}, + {erl_eval,seq,2}, + {erl_eval,seq,3}, + {erl_eval,arg_list,2}, + {erl_eval,arg_list,3}, + {erl_pp,seq,1}, + {erl_pp,seq,2}, + {io,scan_erl_seq,1}, + {io,scan_erl_seq,2}, + {io,scan_erl_seq,3}, + {io,parse_erl_seq,1}, + {io,parse_erl_seq,2}, + {io,parse_erl_seq,3}, + {io,parse_exprs,2}, + {io_lib,scan,1}, + {io_lib,scan,2}, + {io_lib,scan,3}, + {io_lib,reserved_word,1}, + {lists,keymap,4}, + {lists,all,3}, + {lists,any,3}, + {lists,map,3}, + {lists,flatmap,3}, + {lists,foldl,4}, + {lists,foldr,4}, + {lists,mapfoldl,4}, + {lists,mapfoldr,4}, + {lists,filter,3}, + {lists,foreach,3}, + {erlang,old_binary_to_term,1}, + {erlang,info,1}, + {file,file_info,1}, + {dict,dict_to_list,1}, + {dict,list_to_dict,1}, + {orddict,dict_to_list,1}, + {orddict,list_to_dict,1}, + {sets,new_set,0}, + {sets,set_to_list,1}, + {sets,list_to_set,1}, + {sets,subset,2}, + {ordsets,new_set,0}, + {ordsets,set_to_list,1}, + {ordsets,list_to_set,1}, + {ordsets,subset,2}, + {calendar,local_time_to_universal_time,1}]. + +huge_bignum() -> + 36#9987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR0737376766798779987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987779JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR0737376766798779987333333392789234879423987243987423432879423879234897423879423874328794323248423872348742323487423987423879243872347824374238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR07373767667987769707660766789076874238792437842374283926276478623462342363243SDKJFSDLEFHDSHJFE48H3838973879JFSDKJLFASLKJVBJKLEJKLDYEIOEHFEOU39873487SFHJSLDFASUIDFHSDHFEYR0R987YDFHDHFDLKHFSIDFHSIDFSIFDHSIFHWIHR073737676679877. diff --git a/erts/emulator/test/code_SUITE_data/many_funs.erl b/erts/emulator/test/code_SUITE_data/many_funs.erl new file mode 100644 index 0000000000..0f9c3a85a4 --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/many_funs.erl @@ -0,0 +1,47 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(many_funs). + +-export([make_fun/1,many_funs/0]). + +make_fun(A) -> + fun(X) -> A + X end. + +%% Force dynamic allocation of lambda table. +many_funs() -> + [fun(_) -> 1 end, + fun(_) -> 2 end, + fun(_) -> 3 end, + fun(_) -> 4 end, + fun(_) -> 5 end, + fun(_) -> 6 end, + fun(_) -> 7 end, + fun(_) -> 8 end, + fun(_) -> 9 end, + fun(_) -> 10 end, + fun(_) -> 11 end, + fun(_) -> 12 end, + fun(_) -> 13 end, + fun(_) -> 14 end, + fun(_) -> 15 end, + fun(_) -> 16 end]. + + + diff --git a/erts/emulator/test/code_SUITE_data/my_code_test.erl b/erts/emulator/test/code_SUITE_data/my_code_test.erl new file mode 100644 index 0000000000..5039b7f937 --- /dev/null +++ b/erts/emulator/test/code_SUITE_data/my_code_test.erl @@ -0,0 +1,27 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(my_code_test). + +-export([make_fun/1]). + +make_fun(A) -> + fun(X) -> A + X end. + + diff --git a/erts/emulator/test/crypto_SUITE.erl b/erts/emulator/test/crypto_SUITE.erl new file mode 100644 index 0000000000..e3d34b923d --- /dev/null +++ b/erts/emulator/test/crypto_SUITE.erl @@ -0,0 +1,330 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(crypto_SUITE). + +-include("test_server.hrl"). + +-export([all/1, + t_md5/1,t_md5_update/1,error/1,unaligned_context/1,random_lists/1, + misc_errors/1]). + +all(suite) -> + [t_md5,t_md5_update,error,unaligned_context,random_lists,misc_errors]. + + +misc_errors(doc) -> + ["Test crc32, adler32 and md5 error cases not covered by other tests"]; +misc_errors(suite) -> + []; +misc_errors(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(2)), + ?line 1 = erlang:adler32([]), + ?line L = lists:duplicate(600,3), + ?line 1135871753 = erlang:adler32(L), + ?line L2 = lists:duplicate(22000,3), + ?line 1100939744 = erlang:adler32(L2), + ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(L++[a])), + ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(L++[a])), + ?line {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|<<25:7>>])), + ?line {'EXIT', {badarg,_}} = (catch erlang:crc32([1,2,3|4])), + ?line Big = 111111111111111111111111111111, + ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(Big,<<"hej">>)), + ?line {'EXIT', {badarg,_}} = (catch erlang:crc32(25,[1,2,3|4])), + ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(Big,3,3)), + ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,Big,3)), + ?line {'EXIT', {badarg,_}} = (catch erlang:crc32_combine(3,3,Big)), + ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(Big,<<"hej">>)), + ?line {'EXIT', {badarg,_}} = (catch erlang:adler32(25,[1,2,3|4])), + ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(Big,3,3)), + ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,Big,3)), + ?line {'EXIT', {badarg,_}} = (catch erlang:adler32_combine(3,3,Big)), + ?line {'EXIT', {badarg,_}} = (catch erlang:md5_update(<<"hej">>,<<"hej">>)), + ?line {'EXIT', {badarg,_}} = (catch erlang:md5_final(<<"hej">>)), + ?line test_server:timetrap_cancel(Dog), + ok. + + +%% +%% Most of the real code for these test cases are in +%% the modules crypto_reference and random_iolist. +%% +-define(REF,crypto_reference). + +nicesplit(N,L) -> + nicesplit(N,L,[]). +nicesplit(0,Tail,Acc) -> + {lists:reverse(Acc),Tail}; +nicesplit(_,[],Acc) -> + {lists:reverse(Acc),[]}; +nicesplit(N,[H|Tail],Acc) -> + nicesplit(N-1,Tail,[H|Acc]). + +run_in_para([],_) -> + true; +run_in_para(FunList,Schedulers) -> + {ThisTime,NextTime} = nicesplit(Schedulers,FunList), + case length(ThisTime) of + 1 -> + [{L,Fun}] = ThisTime, + try + Fun() + catch + _:Reason -> + exit({error_at_line,L,Reason}) + end; + _ -> + These = [ {L,erlang:spawn_monitor(F)} || {L,F} <- ThisTime ], + collect_workers(These) + end, + run_in_para(NextTime,Schedulers). + +collect_workers([]) -> + ok; +collect_workers([{L,{Pid,Ref}}|T]) -> + receive + {'DOWN',Ref,process,Pid,normal} -> + collect_workers(T); + {'DOWN',Ref,process,Pid,Other} -> + exit({error_at_line,L,Other}) + end. + +random_lists(doc) -> + ["Test crc32, adler32 and md5 on a number of pseudo-randomly generated " + "lists."]; +random_lists(suite) -> + []; +random_lists(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(5)), + ?line Num = erlang:system_info(schedulers_online), + ?line B = list_to_binary( + lists:duplicate( + (erlang:system_info(context_reductions)*10) - 50,$!)), + ?line CRC32_1 = fun(L) -> erlang:crc32(L) end, + ?line CRC32_2 = fun(L) -> ?REF:crc32(L) end, + ?line ADLER32_1 = fun(L) -> erlang:adler32(L) end, + ?line ADLER32_2 = fun(L) -> ?REF:adler32(L) end, + ?line MD5_1 = fun(L) -> erlang:md5(L) end, + ?line MD5_2 = fun(L) -> ?REF:md5_final( + ?REF:md5_update(?REF:md5_init(),L)) end, + ?line MD5_3 = fun(L) -> erlang:md5_final( + erlang:md5_update(erlang:md5_init(),L)) end, + ?line CRC32_1_L = fun(L) -> erlang:crc32([B|L]) end, + ?line CRC32_2_L = fun(L) -> ?REF:crc32([B|L]) end, + ?line ADLER32_1_L = fun(L) -> erlang:adler32([B|L]) end, + ?line ADLER32_2_L = fun(L) -> ?REF:adler32([B|L]) end, + ?line MD5_1_L = fun(L) -> erlang:md5([B|L]) end, + ?line MD5_2_L = fun(L) -> ?REF:md5_final( + ?REF:md5_update(?REF:md5_init(),[B|L])) end, + ?line MD5_3_L = fun(L) -> erlang:md5_final( + erlang:md5_update( + erlang:md5_init(),[B|L])) end, + ?line Wlist0 = + [{?LINE, fun() -> random_iolist:run(150, CRC32_1, CRC32_2) end}, + {?LINE, fun() -> random_iolist:run(150, ADLER32_1, ADLER32_2) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_2) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1,MD5_3) end}, + {?LINE, fun() -> random_iolist:run(150, CRC32_1_L, CRC32_2_L) end}, + {?LINE, + fun() -> random_iolist:run(150, ADLER32_1_L, ADLER32_2_L) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_2_L) end}, + {?LINE, fun() -> random_iolist:run(150,MD5_1_L,MD5_3_L) end}], + ?line run_in_para(Wlist0,Num), + ?line CRC32_1_2 = fun(L1,L2) -> erlang:crc32([L1,L2]) end, + ?line CRC32_2_2 = fun(L1,L2) -> erlang:crc32(erlang:crc32(L1),L2) end, + ?line CRC32_3_2 = fun(L1,L2) -> erlang:crc32_combine( + erlang:crc32(L1), + erlang:crc32(L2), + erlang:iolist_size(L2)) + end, + ?line ADLER32_1_2 = fun(L1,L2) -> erlang:adler32([L1,L2]) end, + ?line ADLER32_2_2 = fun(L1,L2) -> erlang:adler32( + erlang:adler32(L1),L2) end, + ?line ADLER32_3_2 = fun(L1,L2) -> erlang:adler32_combine( + erlang:adler32(L1), + erlang:adler32(L2), + erlang:iolist_size(L2)) + end, + ?line MD5_1_2 = fun(L1,L2) -> erlang:md5([L1,L2]) end, + ?line MD5_2_2 = fun(L1,L2) -> + erlang:md5_final( + erlang:md5_update( + erlang:md5_update( + erlang:md5_init(), + L1), + L2)) + end, + ?line CRC32_1_L_2 = fun(L1,L2) -> erlang:crc32([[B|L1],[B|L2]]) end, + ?line CRC32_2_L_2 = fun(L1,L2) -> erlang:crc32( + erlang:crc32([B|L1]),[B|L2]) end, + ?line CRC32_3_L_2 = fun(L1,L2) -> erlang:crc32_combine( + erlang:crc32([B|L1]), + erlang:crc32([B|L2]), + erlang:iolist_size([B|L2])) + end, + ?line ADLER32_1_L_2 = fun(L1,L2) -> erlang:adler32([[B|L1],[B|L2]]) end, + ?line ADLER32_2_L_2 = fun(L1,L2) -> erlang:adler32( + erlang:adler32([B|L1]), + [B|L2]) + end, + ?line ADLER32_3_L_2 = fun(L1,L2) -> erlang:adler32_combine( + erlang:adler32([B|L1]), + erlang:adler32([B|L2]), + erlang:iolist_size([B|L2])) + end, + ?line MD5_1_L_2 = fun(L1,L2) -> erlang:md5([[B|L1],[B|L2]]) end, + ?line MD5_2_L_2 = fun(L1,L2) -> + erlang:md5_final( + erlang:md5_update( + erlang:md5_update( + erlang:md5_init(), + [B|L1]), + [B|L2])) + end, + ?line Wlist1 = + [{?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_2,CRC32_3_2) end}, + {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,ADLER32_1_2,ADLER32_3_2) end}, + {?LINE, fun() -> random_iolist:run2(150,MD5_1_2,MD5_2_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_2_L_2) end}, + {?LINE, fun() -> random_iolist:run2(150,CRC32_1_L_2,CRC32_3_L_2) end}, + {?LINE, + fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_2_L_2) end}, + {?LINE, + fun() -> random_iolist:run2(150,ADLER32_1_L_2,ADLER32_3_L_2) end}, + {?LINE, fun() -> random_iolist:run2(150,MD5_1_L_2,MD5_2_L_2) end}], + ?line run_in_para(Wlist1,Num), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% +%% +t_md5(doc) -> + ["Generate MD5 message digests and check the result. Examples are " + "from RFC-1321."]; +t_md5(Config) when is_list(Config) -> + ?line t_md5_test("", "d41d8cd98f00b204e9800998ecf8427e"), + ?line t_md5_test("a", "0cc175b9c0f1b6a831c399e269772661"), + ?line t_md5_test("abc", "900150983cd24fb0d6963f7d28e17f72"), + ?line t_md5_test(["message ","digest"], "f96b697d7cb7938d525a2f31aaf161d0"), + ?line t_md5_test(["message ",unaligned_sub_bin(<<"digest">>)], + "f96b697d7cb7938d525a2f31aaf161d0"), + ?line t_md5_test("abcdefghijklmnopqrstuvwxyz", + "c3fcd3d76192e4007dfb496cca67e13b"), + ?line t_md5_test("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" + "0123456789", + "d174ab98d277d9f5a5611c2c9f419d9f"), + ?line t_md5_test("12345678901234567890123456789012345678901234567890" + "123456789012345678901234567890", + "57edf4a22be3c955ac49da2e2107b67a"), + ok. + +%% +%% +t_md5_update(doc) -> + ["Generate MD5 message using md5_init, md5_update, and md5_final, and" + "check the result. Examples are from RFC-1321."]; +t_md5_update(Config) when is_list(Config) -> + ?line t_md5_update_1(fun(Str) -> Str end), + ?line t_md5_update_1(fun(Str) -> list_to_binary(Str) end), + ?line t_md5_update_1(fun(Str) -> unaligned_sub_bin(list_to_binary(Str)) end), + ok. + +t_md5_update_1(Tr) when is_function(Tr, 1) -> + Ctx = erlang:md5_init(), + Ctx1 = erlang:md5_update(Ctx, Tr("ABCDEFGHIJKLMNOPQRSTUVWXYZ")), + Ctx2 = erlang:md5_update(Ctx1, Tr("abcdefghijklmnopqrstuvwxyz" + "0123456789")), + m(erlang:md5_final(Ctx2), + hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), + ok. + +%% +%% +error(Config) when is_list(Config) -> + ?line {'EXIT',{badarg,_}} = (catch erlang:md5(bit_sized_binary(<<"abc">>))), + ?line Ctx0 = erlang:md5_init(), + ?line {'EXIT',{badarg,_}} = + (catch erlang:md5_update(Ctx0, bit_sized_binary(<<"abcfjldjd">>))), + ?line {'EXIT',{badarg,_}} = + (catch erlang:md5_update(Ctx0, ["something",bit_sized_binary(<<"abcfjldjd">>)])), + ?line {'EXIT',{badarg,_}} = + (catch erlang:md5_update(bit_sized_binary(Ctx0), "something")), + ?line {'EXIT',{badarg,_}} = (catch erlang:md5_final(bit_sized_binary(Ctx0))), + ?line m(erlang:md5_final(Ctx0), hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")), + ok. + + +%% +%% +unaligned_context(Config) when is_list(Config) -> + ?line Ctx0 = erlang:md5_init(), + ?line Ctx1 = erlang:md5_update(unaligned_sub_bin(Ctx0), "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), + ?line Ctx = erlang:md5_update(unaligned_sub_bin(Ctx1), + "abcdefghijklmnopqrstuvwxyz0123456789"), + ?line m(erlang:md5_final(unaligned_sub_bin(Ctx)), + hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), + ok. + +%% +%% Help functions +%% + +t_md5_test(Str, ResultStr) -> + ResultBin = hexstr2bin(ResultStr), + m(erlang:md5(Str), ResultBin), + Bin = list_to_binary(Str), + m(erlang:md5(Bin), ResultBin), + UnalignedSubBin = unaligned_sub_bin(Bin), + m(erlang:md5(UnalignedSubBin), ResultBin). + +m(X, X) -> true. + +hexstr2bin(S) -> + list_to_binary(hexstr2list(S)). + +hexstr2list([X,Y|T]) -> + [mkint(X)*16 + mkint(Y) | hexstr2list(T)]; +hexstr2list([]) -> + []. + +mkint(C) when $0 =< C, C =< $9 -> + C - $0; +mkint(C) when $A =< C, C =< $F -> + C - $A + 10; +mkint(C) when $a =< C, C =< $f -> + C - $a + 10. + +unaligned_sub_bin(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +%% Add 1 bit to the size of the binary. +bit_sized_binary(Bin0) -> + Bin = <>, + BitSize = bit_size(Bin), + BitSize = 8*size(Bin) + 1, + Bin. + +id(I) -> I. + + diff --git a/erts/emulator/test/crypto_reference.erl b/erts/emulator/test/crypto_reference.erl new file mode 100644 index 0000000000..99107e3b57 --- /dev/null +++ b/erts/emulator/test/crypto_reference.erl @@ -0,0 +1,856 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Reference implementations of crc32, adler32 and md5 in erlang. Used +%% by crypto_SUITE. +%% + +-module(crypto_reference). + +-export([adler32/1, crc32/1, md5_init/0, md5_update/2, md5_final/1]). +-export([crc32_table/0, reflect8_table/0]). + +-define(BASE, 65521). +-define(NMAX, 5552). + +-define(AINIT,<<0,0,0,1>>). + +adler32(Bin) when is_binary(Bin) -> + B2 = adler32(Bin,0,1), + <> = B2, + Sum; + +adler32(IoList) -> + adler32(erlang:iolist_to_binary(IoList)). + +adler32(<<>>,B,A) -> + <>; + +adler32(<>,B,A) -> + NewA = (A+CH) rem ?BASE, + NewB = (B+NewA) rem ?BASE, + adler32(T,NewB,NewA). + +-define(FINAL_XOR_VALUE,16#FFFFFFFF). +-define(INITIAL_REMAINDER,16#FFFFFFFF). + +reflect_bin(<<>>,Res) -> + Res; +reflect_bin(<>,BS) -> + reflect_bin(Rest,<>). +reflect(Data,8) -> + reflect8(Data); +reflect(Data,32) -> + <> = <>, + ND = reflect8(D), + NC = reflect8(C), + NB = reflect8(B), + NA = reflect8(A), + <> = <>, + Result; +reflect(Data,Size) -> + <> = reflect_bin(<>,<<>>), + NewData. +crc32(<<>>,Remainder) -> + reflect(Remainder,32) bxor ?FINAL_XOR_VALUE; +crc32(<>,Remainder) -> + Data = reflect(CH,8) bxor (Remainder bsr 24), + NewRem = crcTab32(Data) bxor ((Remainder bsl 8) band 16#FFFFFFFF), +% io:format("CH = ~p (~p)~n",[CH,reflect(CH,8)]), +% io:format("No reflect = ~p~n",[(CH bxor (Remainder bsr 24))]), +% io:format("Data = ~p, NewRem = ~p~n",[Data,NewRem]), + crc32(T,NewRem). + +crc32(Bin) when is_binary(Bin) -> + crc32(Bin,?INITIAL_REMAINDER); +crc32(L) -> + crc32(erlang:iolist_to_binary(L)). + +bitmod2(0,Remainder,_Topbit,_Polynomial,_Mask) -> + %io:format("~p ",[Remainder]), + Remainder; +bitmod2(N,Remainder,Topbit,Polynomial,Mask) -> + %io:format("~p ",[Remainder]), + case (Remainder band Topbit) of + 0 -> + bitmod2(N-1,(Remainder bsl 1) band Mask,Topbit,Polynomial,Mask); + _ -> + bitmod2(N-1,((Remainder bsl 1) bxor Polynomial) band Mask,Topbit,Polynomial,Mask) + end. + +mask(CrcSize) -> + 16#FFFFFFFF bsr (32 - CrcSize). + +calc_crc_table(256,_CrcSize,_Polynomial) -> + ok; +calc_crc_table(Dividend,CrcSize,Polynomial) -> + Mask = mask(CrcSize), + Remainder = (Dividend bsl (CrcSize - 8)) band Mask, + TopBit = 1 bsl (CrcSize - 1), + Rem2 = bitmod2(8,Remainder,TopBit,Polynomial,Mask), + io:format("crcTab~p(~p) -> ~p;~n",[CrcSize,Dividend,Rem2]), + calc_crc_table(Dividend+1,CrcSize,Polynomial). + +crc32_table() -> + calc_crc_table(0,32,16#04C11DB7). + +reflect8_table(256) -> + ok; +reflect8_table(N) -> + X = reflect(N,8), + io:format("reflect8(~p) -> ~p;~n",[N,X]), + reflect8_table(N+1). +reflect8_table() -> + reflect8_table(0). + +%CRC32 table calculated with crc32_table above +crcTab32(0) -> 0; +crcTab32(1) -> 79764919; +crcTab32(2) -> 159529838; +crcTab32(3) -> 222504665; +crcTab32(4) -> 319059676; +crcTab32(5) -> 398814059; +crcTab32(6) -> 445009330; +crcTab32(7) -> 507990021; +crcTab32(8) -> 638119352; +crcTab32(9) -> 583659535; +crcTab32(10) -> 797628118; +crcTab32(11) -> 726387553; +crcTab32(12) -> 890018660; +crcTab32(13) -> 835552979; +crcTab32(14) -> 1015980042; +crcTab32(15) -> 944750013; +crcTab32(16) -> 1276238704; +crcTab32(17) -> 1221641927; +crcTab32(18) -> 1167319070; +crcTab32(19) -> 1095957929; +crcTab32(20) -> 1595256236; +crcTab32(21) -> 1540665371; +crcTab32(22) -> 1452775106; +crcTab32(23) -> 1381403509; +crcTab32(24) -> 1780037320; +crcTab32(25) -> 1859660671; +crcTab32(26) -> 1671105958; +crcTab32(27) -> 1733955601; +crcTab32(28) -> 2031960084; +crcTab32(29) -> 2111593891; +crcTab32(30) -> 1889500026; +crcTab32(31) -> 1952343757; +crcTab32(32) -> 2552477408; +crcTab32(33) -> 2632100695; +crcTab32(34) -> 2443283854; +crcTab32(35) -> 2506133561; +crcTab32(36) -> 2334638140; +crcTab32(37) -> 2414271883; +crcTab32(38) -> 2191915858; +crcTab32(39) -> 2254759653; +crcTab32(40) -> 3190512472; +crcTab32(41) -> 3135915759; +crcTab32(42) -> 3081330742; +crcTab32(43) -> 3009969537; +crcTab32(44) -> 2905550212; +crcTab32(45) -> 2850959411; +crcTab32(46) -> 2762807018; +crcTab32(47) -> 2691435357; +crcTab32(48) -> 3560074640; +crcTab32(49) -> 3505614887; +crcTab32(50) -> 3719321342; +crcTab32(51) -> 3648080713; +crcTab32(52) -> 3342211916; +crcTab32(53) -> 3287746299; +crcTab32(54) -> 3467911202; +crcTab32(55) -> 3396681109; +crcTab32(56) -> 4063920168; +crcTab32(57) -> 4143685023; +crcTab32(58) -> 4223187782; +crcTab32(59) -> 4286162673; +crcTab32(60) -> 3779000052; +crcTab32(61) -> 3858754371; +crcTab32(62) -> 3904687514; +crcTab32(63) -> 3967668269; +crcTab32(64) -> 881225847; +crcTab32(65) -> 809987520; +crcTab32(66) -> 1023691545; +crcTab32(67) -> 969234094; +crcTab32(68) -> 662832811; +crcTab32(69) -> 591600412; +crcTab32(70) -> 771767749; +crcTab32(71) -> 717299826; +crcTab32(72) -> 311336399; +crcTab32(73) -> 374308984; +crcTab32(74) -> 453813921; +crcTab32(75) -> 533576470; +crcTab32(76) -> 25881363; +crcTab32(77) -> 88864420; +crcTab32(78) -> 134795389; +crcTab32(79) -> 214552010; +crcTab32(80) -> 2023205639; +crcTab32(81) -> 2086057648; +crcTab32(82) -> 1897238633; +crcTab32(83) -> 1976864222; +crcTab32(84) -> 1804852699; +crcTab32(85) -> 1867694188; +crcTab32(86) -> 1645340341; +crcTab32(87) -> 1724971778; +crcTab32(88) -> 1587496639; +crcTab32(89) -> 1516133128; +crcTab32(90) -> 1461550545; +crcTab32(91) -> 1406951526; +crcTab32(92) -> 1302016099; +crcTab32(93) -> 1230646740; +crcTab32(94) -> 1142491917; +crcTab32(95) -> 1087903418; +crcTab32(96) -> 2896545431; +crcTab32(97) -> 2825181984; +crcTab32(98) -> 2770861561; +crcTab32(99) -> 2716262478; +crcTab32(100) -> 3215044683; +crcTab32(101) -> 3143675388; +crcTab32(102) -> 3055782693; +crcTab32(103) -> 3001194130; +crcTab32(104) -> 2326604591; +crcTab32(105) -> 2389456536; +crcTab32(106) -> 2200899649; +crcTab32(107) -> 2280525302; +crcTab32(108) -> 2578013683; +crcTab32(109) -> 2640855108; +crcTab32(110) -> 2418763421; +crcTab32(111) -> 2498394922; +crcTab32(112) -> 3769900519; +crcTab32(113) -> 3832873040; +crcTab32(114) -> 3912640137; +crcTab32(115) -> 3992402750; +crcTab32(116) -> 4088425275; +crcTab32(117) -> 4151408268; +crcTab32(118) -> 4197601365; +crcTab32(119) -> 4277358050; +crcTab32(120) -> 3334271071; +crcTab32(121) -> 3263032808; +crcTab32(122) -> 3476998961; +crcTab32(123) -> 3422541446; +crcTab32(124) -> 3585640067; +crcTab32(125) -> 3514407732; +crcTab32(126) -> 3694837229; +crcTab32(127) -> 3640369242; +crcTab32(128) -> 1762451694; +crcTab32(129) -> 1842216281; +crcTab32(130) -> 1619975040; +crcTab32(131) -> 1682949687; +crcTab32(132) -> 2047383090; +crcTab32(133) -> 2127137669; +crcTab32(134) -> 1938468188; +crcTab32(135) -> 2001449195; +crcTab32(136) -> 1325665622; +crcTab32(137) -> 1271206113; +crcTab32(138) -> 1183200824; +crcTab32(139) -> 1111960463; +crcTab32(140) -> 1543535498; +crcTab32(141) -> 1489069629; +crcTab32(142) -> 1434599652; +crcTab32(143) -> 1363369299; +crcTab32(144) -> 622672798; +crcTab32(145) -> 568075817; +crcTab32(146) -> 748617968; +crcTab32(147) -> 677256519; +crcTab32(148) -> 907627842; +crcTab32(149) -> 853037301; +crcTab32(150) -> 1067152940; +crcTab32(151) -> 995781531; +crcTab32(152) -> 51762726; +crcTab32(153) -> 131386257; +crcTab32(154) -> 177728840; +crcTab32(155) -> 240578815; +crcTab32(156) -> 269590778; +crcTab32(157) -> 349224269; +crcTab32(158) -> 429104020; +crcTab32(159) -> 491947555; +crcTab32(160) -> 4046411278; +crcTab32(161) -> 4126034873; +crcTab32(162) -> 4172115296; +crcTab32(163) -> 4234965207; +crcTab32(164) -> 3794477266; +crcTab32(165) -> 3874110821; +crcTab32(166) -> 3953728444; +crcTab32(167) -> 4016571915; +crcTab32(168) -> 3609705398; +crcTab32(169) -> 3555108353; +crcTab32(170) -> 3735388376; +crcTab32(171) -> 3664026991; +crcTab32(172) -> 3290680682; +crcTab32(173) -> 3236090077; +crcTab32(174) -> 3449943556; +crcTab32(175) -> 3378572211; +crcTab32(176) -> 3174993278; +crcTab32(177) -> 3120533705; +crcTab32(178) -> 3032266256; +crcTab32(179) -> 2961025959; +crcTab32(180) -> 2923101090; +crcTab32(181) -> 2868635157; +crcTab32(182) -> 2813903052; +crcTab32(183) -> 2742672763; +crcTab32(184) -> 2604032198; +crcTab32(185) -> 2683796849; +crcTab32(186) -> 2461293480; +crcTab32(187) -> 2524268063; +crcTab32(188) -> 2284983834; +crcTab32(189) -> 2364738477; +crcTab32(190) -> 2175806836; +crcTab32(191) -> 2238787779; +crcTab32(192) -> 1569362073; +crcTab32(193) -> 1498123566; +crcTab32(194) -> 1409854455; +crcTab32(195) -> 1355396672; +crcTab32(196) -> 1317987909; +crcTab32(197) -> 1246755826; +crcTab32(198) -> 1192025387; +crcTab32(199) -> 1137557660; +crcTab32(200) -> 2072149281; +crcTab32(201) -> 2135122070; +crcTab32(202) -> 1912620623; +crcTab32(203) -> 1992383480; +crcTab32(204) -> 1753615357; +crcTab32(205) -> 1816598090; +crcTab32(206) -> 1627664531; +crcTab32(207) -> 1707420964; +crcTab32(208) -> 295390185; +crcTab32(209) -> 358241886; +crcTab32(210) -> 404320391; +crcTab32(211) -> 483945776; +crcTab32(212) -> 43990325; +crcTab32(213) -> 106832002; +crcTab32(214) -> 186451547; +crcTab32(215) -> 266083308; +crcTab32(216) -> 932423249; +crcTab32(217) -> 861060070; +crcTab32(218) -> 1041341759; +crcTab32(219) -> 986742920; +crcTab32(220) -> 613929101; +crcTab32(221) -> 542559546; +crcTab32(222) -> 756411363; +crcTab32(223) -> 701822548; +crcTab32(224) -> 3316196985; +crcTab32(225) -> 3244833742; +crcTab32(226) -> 3425377559; +crcTab32(227) -> 3370778784; +crcTab32(228) -> 3601682597; +crcTab32(229) -> 3530312978; +crcTab32(230) -> 3744426955; +crcTab32(231) -> 3689838204; +crcTab32(232) -> 3819031489; +crcTab32(233) -> 3881883254; +crcTab32(234) -> 3928223919; +crcTab32(235) -> 4007849240; +crcTab32(236) -> 4037393693; +crcTab32(237) -> 4100235434; +crcTab32(238) -> 4180117107; +crcTab32(239) -> 4259748804; +crcTab32(240) -> 2310601993; +crcTab32(241) -> 2373574846; +crcTab32(242) -> 2151335527; +crcTab32(243) -> 2231098320; +crcTab32(244) -> 2596047829; +crcTab32(245) -> 2659030626; +crcTab32(246) -> 2470359227; +crcTab32(247) -> 2550115596; +crcTab32(248) -> 2947551409; +crcTab32(249) -> 2876312838; +crcTab32(250) -> 2788305887; +crcTab32(251) -> 2733848168; +crcTab32(252) -> 3165939309; +crcTab32(253) -> 3094707162; +crcTab32(254) -> 3040238851; +crcTab32(255) -> 2985771188; +crcTab32(_) -> exit(not_a_byte). + +%% +%% Reflect8 table generated with code above crcTab32 +%% + +reflect8(0) -> 0; +reflect8(1) -> 128; +reflect8(2) -> 64; +reflect8(3) -> 192; +reflect8(4) -> 32; +reflect8(5) -> 160; +reflect8(6) -> 96; +reflect8(7) -> 224; +reflect8(8) -> 16; +reflect8(9) -> 144; +reflect8(10) -> 80; +reflect8(11) -> 208; +reflect8(12) -> 48; +reflect8(13) -> 176; +reflect8(14) -> 112; +reflect8(15) -> 240; +reflect8(16) -> 8; +reflect8(17) -> 136; +reflect8(18) -> 72; +reflect8(19) -> 200; +reflect8(20) -> 40; +reflect8(21) -> 168; +reflect8(22) -> 104; +reflect8(23) -> 232; +reflect8(24) -> 24; +reflect8(25) -> 152; +reflect8(26) -> 88; +reflect8(27) -> 216; +reflect8(28) -> 56; +reflect8(29) -> 184; +reflect8(30) -> 120; +reflect8(31) -> 248; +reflect8(32) -> 4; +reflect8(33) -> 132; +reflect8(34) -> 68; +reflect8(35) -> 196; +reflect8(36) -> 36; +reflect8(37) -> 164; +reflect8(38) -> 100; +reflect8(39) -> 228; +reflect8(40) -> 20; +reflect8(41) -> 148; +reflect8(42) -> 84; +reflect8(43) -> 212; +reflect8(44) -> 52; +reflect8(45) -> 180; +reflect8(46) -> 116; +reflect8(47) -> 244; +reflect8(48) -> 12; +reflect8(49) -> 140; +reflect8(50) -> 76; +reflect8(51) -> 204; +reflect8(52) -> 44; +reflect8(53) -> 172; +reflect8(54) -> 108; +reflect8(55) -> 236; +reflect8(56) -> 28; +reflect8(57) -> 156; +reflect8(58) -> 92; +reflect8(59) -> 220; +reflect8(60) -> 60; +reflect8(61) -> 188; +reflect8(62) -> 124; +reflect8(63) -> 252; +reflect8(64) -> 2; +reflect8(65) -> 130; +reflect8(66) -> 66; +reflect8(67) -> 194; +reflect8(68) -> 34; +reflect8(69) -> 162; +reflect8(70) -> 98; +reflect8(71) -> 226; +reflect8(72) -> 18; +reflect8(73) -> 146; +reflect8(74) -> 82; +reflect8(75) -> 210; +reflect8(76) -> 50; +reflect8(77) -> 178; +reflect8(78) -> 114; +reflect8(79) -> 242; +reflect8(80) -> 10; +reflect8(81) -> 138; +reflect8(82) -> 74; +reflect8(83) -> 202; +reflect8(84) -> 42; +reflect8(85) -> 170; +reflect8(86) -> 106; +reflect8(87) -> 234; +reflect8(88) -> 26; +reflect8(89) -> 154; +reflect8(90) -> 90; +reflect8(91) -> 218; +reflect8(92) -> 58; +reflect8(93) -> 186; +reflect8(94) -> 122; +reflect8(95) -> 250; +reflect8(96) -> 6; +reflect8(97) -> 134; +reflect8(98) -> 70; +reflect8(99) -> 198; +reflect8(100) -> 38; +reflect8(101) -> 166; +reflect8(102) -> 102; +reflect8(103) -> 230; +reflect8(104) -> 22; +reflect8(105) -> 150; +reflect8(106) -> 86; +reflect8(107) -> 214; +reflect8(108) -> 54; +reflect8(109) -> 182; +reflect8(110) -> 118; +reflect8(111) -> 246; +reflect8(112) -> 14; +reflect8(113) -> 142; +reflect8(114) -> 78; +reflect8(115) -> 206; +reflect8(116) -> 46; +reflect8(117) -> 174; +reflect8(118) -> 110; +reflect8(119) -> 238; +reflect8(120) -> 30; +reflect8(121) -> 158; +reflect8(122) -> 94; +reflect8(123) -> 222; +reflect8(124) -> 62; +reflect8(125) -> 190; +reflect8(126) -> 126; +reflect8(127) -> 254; +reflect8(128) -> 1; +reflect8(129) -> 129; +reflect8(130) -> 65; +reflect8(131) -> 193; +reflect8(132) -> 33; +reflect8(133) -> 161; +reflect8(134) -> 97; +reflect8(135) -> 225; +reflect8(136) -> 17; +reflect8(137) -> 145; +reflect8(138) -> 81; +reflect8(139) -> 209; +reflect8(140) -> 49; +reflect8(141) -> 177; +reflect8(142) -> 113; +reflect8(143) -> 241; +reflect8(144) -> 9; +reflect8(145) -> 137; +reflect8(146) -> 73; +reflect8(147) -> 201; +reflect8(148) -> 41; +reflect8(149) -> 169; +reflect8(150) -> 105; +reflect8(151) -> 233; +reflect8(152) -> 25; +reflect8(153) -> 153; +reflect8(154) -> 89; +reflect8(155) -> 217; +reflect8(156) -> 57; +reflect8(157) -> 185; +reflect8(158) -> 121; +reflect8(159) -> 249; +reflect8(160) -> 5; +reflect8(161) -> 133; +reflect8(162) -> 69; +reflect8(163) -> 197; +reflect8(164) -> 37; +reflect8(165) -> 165; +reflect8(166) -> 101; +reflect8(167) -> 229; +reflect8(168) -> 21; +reflect8(169) -> 149; +reflect8(170) -> 85; +reflect8(171) -> 213; +reflect8(172) -> 53; +reflect8(173) -> 181; +reflect8(174) -> 117; +reflect8(175) -> 245; +reflect8(176) -> 13; +reflect8(177) -> 141; +reflect8(178) -> 77; +reflect8(179) -> 205; +reflect8(180) -> 45; +reflect8(181) -> 173; +reflect8(182) -> 109; +reflect8(183) -> 237; +reflect8(184) -> 29; +reflect8(185) -> 157; +reflect8(186) -> 93; +reflect8(187) -> 221; +reflect8(188) -> 61; +reflect8(189) -> 189; +reflect8(190) -> 125; +reflect8(191) -> 253; +reflect8(192) -> 3; +reflect8(193) -> 131; +reflect8(194) -> 67; +reflect8(195) -> 195; +reflect8(196) -> 35; +reflect8(197) -> 163; +reflect8(198) -> 99; +reflect8(199) -> 227; +reflect8(200) -> 19; +reflect8(201) -> 147; +reflect8(202) -> 83; +reflect8(203) -> 211; +reflect8(204) -> 51; +reflect8(205) -> 179; +reflect8(206) -> 115; +reflect8(207) -> 243; +reflect8(208) -> 11; +reflect8(209) -> 139; +reflect8(210) -> 75; +reflect8(211) -> 203; +reflect8(212) -> 43; +reflect8(213) -> 171; +reflect8(214) -> 107; +reflect8(215) -> 235; +reflect8(216) -> 27; +reflect8(217) -> 155; +reflect8(218) -> 91; +reflect8(219) -> 219; +reflect8(220) -> 59; +reflect8(221) -> 187; +reflect8(222) -> 123; +reflect8(223) -> 251; +reflect8(224) -> 7; +reflect8(225) -> 135; +reflect8(226) -> 71; +reflect8(227) -> 199; +reflect8(228) -> 39; +reflect8(229) -> 167; +reflect8(230) -> 103; +reflect8(231) -> 231; +reflect8(232) -> 23; +reflect8(233) -> 151; +reflect8(234) -> 87; +reflect8(235) -> 215; +reflect8(236) -> 55; +reflect8(237) -> 183; +reflect8(238) -> 119; +reflect8(239) -> 247; +reflect8(240) -> 15; +reflect8(241) -> 143; +reflect8(242) -> 79; +reflect8(243) -> 207; +reflect8(244) -> 47; +reflect8(245) -> 175; +reflect8(246) -> 111; +reflect8(247) -> 239; +reflect8(248) -> 31; +reflect8(249) -> 159; +reflect8(250) -> 95; +reflect8(251) -> 223; +reflect8(252) -> 63; +reflect8(253) -> 191; +reflect8(254) -> 127; +reflect8(255) -> 255; +reflect8(_) -> exit(not_a_byte). + +%%% +%%% Old MD5 implementation by Tony, modified to fit testing +%%% + +-record(md5_ctx, + { + state = { 16#67452301, 16#efcdab89, 16#98badcfe, 16#10325476 }, + count = 0, %% number of bits (64 bit) + buffer = <<>> %% input buffer (16 bytes) + }). + +-define(S11, 7). +-define(S12, 12). +-define(S13, 17). +-define(S14, 22). +-define(S21, 5). +-define(S22, 9). +-define(S23, 14). +-define(S24, 20). +-define(S31, 4). +-define(S32, 11). +-define(S33, 16). +-define(S34, 23). +-define(S41, 6). +-define(S42, 10). +-define(S43, 15). +-define(S44, 21). + +%% F, G, H and I are basic MD5 functions. + +-define(F(X, Y, Z), (((X) band (Y)) bor ((bnot (X)) band (Z)))). +-define(G(X, Y, Z), (((X) band (Z)) bor ((Y) band (bnot (Z))))). +-define(H(X, Y, Z), ((X) bxor (Y) bxor (Z))). +-define(I(X, Y, Z), ((Y) bxor ((X) bor (bnot (Z))))). + +-define(U32(X), ((X) band 16#ffffffff)). + +-define(ROTATE_LEFT(X,N), rotate_left(X,N)). + +%% FF, GG, HH, and II transformations for rounds 1, 2, 3, and 4. +%% Rotation is separate from addition to prevent recomputation. +%% +-define(FF(A, B, C, D, X, S, AC), + ?ROTATE_LEFT(A + ?F((B), (C), (D)) + (X) + (AC),(S)) + (B)). + +-define(GG(A, B, C, D, X, S, AC), + ?ROTATE_LEFT(A + ?G((B), (C), (D)) + (X) + (AC),(S)) + (B)). + +-define( HH(A, B, C, D, X, S, AC), + ?ROTATE_LEFT(A + ?H((B), (C), (D)) + (X) + (AC),(S)) + (B)). + +-define(II(A, B, C, D, X, S, AC), + ?ROTATE_LEFT(A + ?I((B), (C), (D)) + (X) + (AC),(S)) + (B)). + +md5_init() -> + #md5_ctx {}. + +md5_update(CTX, Input) when is_list(Input) -> + md5_update(CTX,iolist_to_binary(Input)); +md5_update(CTX, Input) when is_binary(Input) -> + Buffer = CTX#md5_ctx.buffer, + LenI = size(Input), + Len = LenI + size(Buffer), + md5_update(<>, Len,CTX#md5_ctx.state, + CTX#md5_ctx.count+(LenI bsl 3)). + +%% +%% update state, count reflects number of bytes +%% including bytes in buffer +%% +md5_update(Buf0, Len0, State0, Count) when Len0 >= 64 -> + {Xs,Buf1} = decode(Buf0, 64), + State1 = transform(State0, Xs), + md5_update(Buf1, Len0 - 64, State1, Count); +md5_update(Buf0, _Len0, State0, Count) -> + #md5_ctx { state = State0, count = Count, buffer = Buf0 }. + +%% produce a digest +md5_final(CTX) -> + %% pad out to a length 56 (we later add a count that makes 64) + Count = CTX#md5_ctx.count, %% number of bits + Index = (Count bsr 3) rem 64, %% number of bytes + PadLen = if Index < 56 -> + 56 - Index; + true -> 120 - Index + end, + CTX1 = md5_update(CTX, list_to_binary(padding(PadLen,[]))), + CTX2 = md5_update(CTX1, list_to_binary(encode([?U32(Count), ?U32(Count bsr 32)]))), + list_to_binary(encode(tuple_to_list(CTX2#md5_ctx.state))). + +%% generate padding info to final +padding(0,Acc) -> Acc; +padding(1,Acc) -> [16#80 | Acc]; +padding(N,Acc) -> padding(N-1, [0 | Acc]). + +%% rotate X as 32-bit unsigned left N bits +rotate_left(X, N) -> + ?U32(X bsl N) bor (?U32(X) bsr (32 - N)). + +%% +%% decodes Len number of bytes into 32 bit integers +%% returns {Xs, Tail} +%% +decode(Buf, Len) -> + decode(Buf, Len, []). + +decode(Buf, 0, Acc) -> + {lists:reverse(Acc), Buf}; +decode(<>, N, Acc) -> + decode(Buf, N-4, [ A | Acc]). + +%% +%% Encodes input 32-bit ints into byte buffer output. +%% +encode(Xs) -> encode(Xs, []). + +encode([X | Xs], Acc) -> + encode(Xs, [(X bsr 24) band 16#ff, + (X bsr 16) band 16#ff, + (X bsr 8) band 16#ff, + X band 16#ff | Acc]); +encode([], Acc) -> lists:reverse(Acc). + + +transform({A0,B0,C0,D0}, Xs) -> + [X0,X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15] = Xs, + + %% Round 1 + A1 = ?FF (A0, B0, C0, D0, X0, ?S11, 16#d76aa478), + D1 = ?FF (D0, A1, B0, C0, X1, ?S12, 16#e8c7b756), + C1 = ?FF (C0, D1, A1, B0, X2, ?S13, 16#242070db), + B1 = ?FF (B0, C1, D1, A1, X3, ?S14, 16#c1bdceee), + + A2 = ?FF (A1, B1, C1, D1, X4, ?S11, 16#f57c0faf), + D2 = ?FF (D1, A2, B1, C1, X5, ?S12, 16#4787c62a), + C2 = ?FF (C1, D2, A2, B1, X6, ?S13, 16#a8304613), + B2 = ?FF (B1, C2, D2, A2, X7, ?S14, 16#fd469501), + + A3 = ?FF (A2, B2, C2, D2, X8, ?S11, 16#698098d8), + D3 = ?FF (D2, A3, B2, C2, X9, ?S12, 16#8b44f7af), + C3 = ?FF (C2, D3, A3, B2, X10, ?S13, 16#ffff5bb1), + B3 = ?FF (B2, C3, D3, A3, X11, ?S14, 16#895cd7be), + + A4 = ?FF (A3, B3, C3, D3, X12, ?S11, 16#6b901122), + D4 = ?FF (D3, A4, B3, C3, X13, ?S12, 16#fd987193), + C4 = ?FF (C3, D4, A4, B3, X14, ?S13, 16#a679438e), + B4 = ?FF (B3, C4, D4, A4, X15, ?S14, 16#49b40821), + + %% Round 2 + A5 = ?GG (A4, B4, C4, D4, X1, ?S21, 16#f61e2562), + D5 = ?GG (D4, A5, B4, C4, X6, ?S22, 16#c040b340), + C5 = ?GG (C4, D5, A5, B4, X11, ?S23, 16#265e5a51), + B5 = ?GG (B4, C5, D5, A5, X0, ?S24, 16#e9b6c7aa), + + A6 = ?GG (A5, B5, C5, D5, X5, ?S21, 16#d62f105d), + D6 = ?GG (D5, A6, B5, C5, X10, ?S22, 16#2441453), + C6 = ?GG (C5, D6, A6, B5, X15, ?S23, 16#d8a1e681), + B6 = ?GG (B5, C6, D6, A6, X4, ?S24, 16#e7d3fbc8), + + A7 = ?GG (A6, B6, C6, D6, X9, ?S21, 16#21e1cde6), + D7 = ?GG (D6, A7, B6, C6, X14, ?S22, 16#c33707d6), + C7 = ?GG (C6, D7, A7, B6, X3, ?S23, 16#f4d50d87), + B7 = ?GG (B6, C7, D7, A7, X8, ?S24, 16#455a14ed), + + A8 = ?GG (A7, B7, C7, D7, X13, ?S21, 16#a9e3e905), + D8 = ?GG (D7, A8, B7, C7, X2, ?S22, 16#fcefa3f8), + C8 = ?GG (C7, D8, A8, B7, X7, ?S23, 16#676f02d9), + B8 = ?GG (B7, C8, D8, A8, X12, ?S24, 16#8d2a4c8a), + + %% Round 3 + A9 = ?HH (A8, B8, C8, D8, X5, ?S31, 16#fffa3942), + D9 = ?HH (D8, A9, B8, C8, X8, ?S32, 16#8771f681), + C9 = ?HH (C8, D9, A9, B8, X11, ?S33, 16#6d9d6122), + B9 = ?HH (B8, C9, D9, A9, X14, ?S34, 16#fde5380c), + + A10 = ?HH (A9, B9, C9, D9, X1, ?S31, 16#a4beea44), + D10 = ?HH (D9, A10, B9, C9, X4, ?S32, 16#4bdecfa9), + C10 = ?HH (C9, D10, A10, B9, X7, ?S33, 16#f6bb4b60), + B10 = ?HH (B9, C10, D10, A10, X10, ?S34, 16#bebfbc70), + + A11 = ?HH (A10, B10, C10, D10, X13, ?S31, 16#289b7ec6), + D11 = ?HH (D10, A11, B10, C10, X0, ?S32, 16#eaa127fa), + C11 = ?HH (C10, D11, A11, B10, X3, ?S33, 16#d4ef3085), + B11 = ?HH (B10, C11, D11, A11, X6, ?S34, 16#4881d05), + + A12 = ?HH (A11, B11, C11, D11, X9, ?S31, 16#d9d4d039), + D12 = ?HH (D11, A12, B11, C11, X12, ?S32, 16#e6db99e5), + C12 = ?HH (C11, D12, A12, B11, X15, ?S33, 16#1fa27cf8), + B12 = ?HH (B11, C12, D12, A12, X2, ?S34, 16#c4ac5665), + + %% Round 4 + A13 = ?II (A12, B12, C12, D12, X0, ?S41, 16#f4292244), + D13 = ?II (D12, A13, B12, C12, X7, ?S42, 16#432aff97), + C13 = ?II (C12, D13, A13, B12, X14, ?S43, 16#ab9423a7), + B13 = ?II (B12, C13, D13, A13, X5, ?S44, 16#fc93a039), + + A14 = ?II (A13, B13, C13, D13, X12, ?S41, 16#655b59c3), + D14 = ?II (D13, A14, B13, C13, X3, ?S42, 16#8f0ccc92), + C14 = ?II (C13, D14, A14, B13, X10, ?S43, 16#ffeff47d), + B14 = ?II (B13, C14, D14, A14, X1, ?S44, 16#85845dd1), + + A15 = ?II (A14, B14, C14, D14, X8, ?S41, 16#6fa87e4f), + D15 = ?II (D14, A15, B14, C14, X15, ?S42, 16#fe2ce6e0), + C15 = ?II (C14, D15, A15, B14, X6, ?S43, 16#a3014314), + B15 = ?II (B14, C15, D15, A15, X13, ?S44, 16#4e0811a1), + + A16 = ?II (A15, B15, C15, D15, X4, ?S41, 16#f7537e82), + D16 = ?II (D15, A16, B15, C15, X11, ?S42, 16#bd3af235), + C16 = ?II (C15, D16, A16, B15, X2, ?S43, 16#2ad7d2bb), + B16 = ?II (B15, C16, D16, A16, X9, ?S44, 16#eb86d391), + + {?U32(A0+A16), ?U32(B0+B16), ?U32(C0+C16), ?U32(D0+D16)}. + diff --git a/erts/emulator/test/ddll_SUITE.erl b/erts/emulator/test/ddll_SUITE.erl new file mode 100644 index 0000000000..79047d7de5 --- /dev/null +++ b/erts/emulator/test/ddll_SUITE.erl @@ -0,0 +1,1120 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ddll_SUITE). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Checks if the dynamic driver and linker loader works. +%%% +%%% These tests can only be run installed (outside clearcase). +%%% +%%% XXX In this suite is missing test cases for reference counts +%%% and that drivers are unloaded when their processes die. +%%% (For me to add :-) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +-export([all/1, ddll_test/1, errors/1, + reference_count/1, + kill_port/1, dont_kill_port/1]). +-export([unload_on_process_exit/1, delayed_unload_with_ports/1, + unload_due_to_process_exit/1, + no_unload_due_to_process_exit/1, no_unload_due_to_process_exit_2/1, + unload_reload_thingie/1, unload_reload_thingie_2/1, + unload_reload_thingie_3/1, reload_pending/1, reload_pending_kill/1, + load_fail_init/1, + reload_pending_fail_init/1, + more_error_codes/1, forced_port_killing/1, + no_trap_exit_and_kill_ports/1, + monitor_demonitor/1, monitor_demonitor_load/1, new_interface/1, + lock_driver/1]). + +% Private exports +-export([echo_loader/2, nice_echo_loader/2 ,properties/1, load_and_unload/1]). + +-import(ordsets, [subtract/2]). + +-include("test_server.hrl"). + +all(suite) -> + [ddll_test, errors, + reference_count, + kill_port, + dont_kill_port, + properties, + load_and_unload, + unload_on_process_exit, + delayed_unload_with_ports, + unload_due_to_process_exit, + no_unload_due_to_process_exit, + no_unload_due_to_process_exit_2, + unload_reload_thingie, + unload_reload_thingie_2, + unload_reload_thingie_3, + reload_pending, + load_fail_init, + reload_pending_fail_init, + reload_pending_kill, + more_error_codes, + forced_port_killing, + no_trap_exit_and_kill_ports, + monitor_demonitor, + monitor_demonitor_load, + new_interface, + lock_driver + ]. + +unload_on_process_exit(suite) -> + []; +unload_on_process_exit(doc) -> + ["Check that the driver is unloaded on process exit"]; +unload_on_process_exit(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + Parent = self(), + ?line Pid = spawn(fun() -> + receive go -> ok end, + erl_ddll:try_load(Path, echo_drv, []), + Parent ! gone, + receive go -> ok end, + erl_ddll:loaded_drivers(), + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + Pid ! go, + ?line receive + gone -> ok + end, + ?line true = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + Pid ! go, + ?line receive + {'DOWN', Ref, process, Pid, banan} -> + ok + end, + receive after 500 -> ok end, + ?line false = lists:member("echo_drv",element(2,erl_ddll:loaded_drivers())), + ?line test_server:timetrap_cancel(Dog), + ok. + +delayed_unload_with_ports(suite) -> + []; +delayed_unload_with_ports(doc) -> + ["Check that the driver is unloaded when the last port is closed"]; +delayed_unload_with_ports(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:try_load(Path, echo_drv, []), + ?line erl_ddll:try_load(Path, echo_drv, []), + ?line Port = open_port({spawn, echo_drv}, [eof]), + ?line 1 = erl_ddll:info(echo_drv, port_count), + ?line Port2 = open_port({spawn, echo_drv}, [eof]), + ?line 2 = erl_ddll:info(echo_drv, port_count), + ?line {ok,pending_process} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), + ?line {ok,pending_driver,Ref} = erl_ddll:try_unload(echo_drv,[{monitor, pending_driver}]), + ?line ok = receive _ -> false after 0 -> ok end, + ?line Port ! {self(), close}, + ?line 1 = erl_ddll:info(echo_drv, port_count), + ?line ok = receive {Port,closed} -> ok after 1000 -> false end, + ?line Port2 ! {self(), close}, + ?line ok = receive {Port2,closed} -> ok after 1000 -> false end, + ?line ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 1000 -> false end, + ?line test_server:timetrap_cancel(Dog), + ok. + +unload_due_to_process_exit(suite) -> + []; +unload_due_to_process_exit(doc) -> + ["Check that the driver with ports is unloaded on process exit"]; +unload_due_to_process_exit(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ?line test_server:timetrap_cancel(Dog), + ok. + +no_unload_due_to_process_exit(suite) -> + []; +no_unload_due_to_process_exit(doc) -> + ["Check that a driver with driver loaded in another process is not unloaded on process exit"]; +no_unload_due_to_process_exit(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive X -> {error, X} after 300 -> ok end, + ?line ok = unload_expect_fast(echo_drv,[]), + ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ?line test_server:timetrap_cancel(Dog), + ok. + +no_unload_due_to_process_exit_2(suite) -> + []; +no_unload_due_to_process_exit_2(doc) -> + ["Check that a driver with open ports in another process is not unloaded on process exit"]; +no_unload_due_to_process_exit_2(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line Port = open_port({spawn, echo_drv}, [eof]), + Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive X -> {error, X} after 300 -> ok end, + ?line erlang:port_close(Port), + ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ?line test_server:timetrap_cancel(Dog), + ok. + +unload_reload_thingie(suite) -> + []; +unload_reload_thingie(doc) -> + ["Check delayed unload and reload"]; +unload_reload_thingie(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line {ok,pending_driver,Ref3} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), + ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,loaded}), + ?line ok = receive {'DOWN',Ref4, driver,echo_drv,load_cancelled} -> ok after 1000 -> false end, + ?line {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line ok = receive {'UP',Ref3, driver,echo_drv,unload_cancelled} -> ok after 1000 -> false end, + ?line Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line [{Parent,1}] = erl_ddll:info(echo_drv, processes), + ?line 0 = erl_ddll:info(echo_drv, port_count), + ?line ok = unload_expect_fast(echo_drv,[{monitor,pending}]), + ?line ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ?line ok = receive X -> {error, X} after 300 -> ok end, + ?line test_server:timetrap_cancel(Dog), + ok. + +unload_reload_thingie_2(suite) -> + []; +unload_reload_thingie_2(doc) -> + ["Check delayed unload and reload"]; +unload_reload_thingie_2(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line {ok,pending_driver,Ref3} = erl_ddll:try_load(Path,echo_drv,[{monitor,pending_driver},{reload,pending_driver}]), + ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ?line Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive {'DOWN',Ref4, driver,echo_drv,unloaded} -> ok after 1000 -> false end, + ?line ok = receive {'UP',Ref3, driver,echo_drv,loaded} -> ok after 1000 -> false end, + ?line [{Parent,1}] = erl_ddll:info(echo_drv, processes), + ?line 0 = erl_ddll:info(echo_drv, port_count), + ?line ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ?line ok = unload_expect_fast(echo_drv,[{monitor,pending}]), + ?line ok = receive X -> {error, X} after 300 -> ok end, + ?line test_server:timetrap_cancel(Dog), + ok. + +unload_reload_thingie_3(suite) -> + []; +unload_reload_thingie_3(doc) -> + ["Check delayed unload and reload failure"]; +unload_reload_thingie_3(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + spawn(F3), + receive go -> ok end, + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line {ok,pending_driver,Ref3} = erl_ddll:try_load(filename:join([Path,"skrumpf"]),echo_drv,[{monitor,pending_driver},{reload,pending_driver}]), + ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ?line Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ?line ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> false end, + ?line ok = receive + {'DOWN',Ref3, driver,echo_drv,{load_failure,_}} -> ok + after 1000 -> false + end, + ?line {'EXIT',_} = (catch erl_ddll:info(echo_drv, port_count)), + ?line {error, not_loaded} = erl_ddll:try_unload(echo_drv,[{monitor,pending}]), + ?line ok = receive X -> {error, X} after 300 -> ok end, + ?line test_server:timetrap_cancel(Dog), + ok. + +reload_pending(suite) -> []; +reload_pending(doc) -> ["Reload a driver that is pending on a user"]; +reload_pending(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line Port = open_port({spawn, echo_drv}, [eof]), + Pid ! go, + ?line receive opened -> ok end, + ?line {error, pending_process} = + erl_ddll:try_load(Path, echo_drv, + [{reload,pending_driver}, + {monitor,pending_driver}]), + ?line {ok, pending_process, Ref3} = + erl_ddll:try_load(Path, echo_drv, + [{reload,pending}, + {monitor,pending}]), + ?line ok = receive X -> {error, X} after 300 -> ok end, + Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive Y -> {error, Y} after 300 -> ok end, + ?line erlang:port_close(Port), + ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ?line ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, + [{Parent,1}] = erl_ddll:info(echo_drv,processes), + ?line ok = receive Z -> {error, Z} after 300 -> ok end, + ?line test_server:timetrap_cancel(Dog), + ok. + +load_fail_init(suite) -> []; +load_fail_init(doc) -> ["Tests failure in the init in driver struct."]; +load_fail_init(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line PathFailing = ?config(priv_dir, Config), + ?line [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), + ?line lists:foreach(fun(Name) -> + Src = filename:join([Path,Name]), + Ext = filename:extension(Name), + Dst =filename:join([PathFailing,"echo_drv"++Ext]), + file:delete(Dst), + {ok,_} = file:copy(Src,Dst) + end, + AllFailInits), + ?line [_|_] = filelib:wildcard("echo_drv.*",PathFailing), + ?line {error, driver_init_failed} = erl_ddll:try_load(PathFailing, + echo_drv, + [{monitor,pending}]), + ?line ok = receive XX -> + {unexpected,XX} + after 300 -> + ok + end, + ?line test_server:timetrap_cancel(Dog), + ok. + + +reload_pending_fail_init(suite) -> []; +reload_pending_fail_init(doc) -> ["Reload a driver that is pending but init fails"]; +reload_pending_fail_init(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line PathFailing = ?config(priv_dir, Config), + ?line [_|_] = AllFailInits = filelib:wildcard("echo_drv_fail_init.*",Path), + ?line lists:foreach(fun(Name) -> + Src = filename:join([Path,Name]), + Ext = filename:extension(Name), + Dst =filename:join([PathFailing,"echo_drv"++Ext]), + file:delete(Dst), + {ok,_} = file:copy(Src,Dst) + end, + AllFailInits), + ?line [_|_] = filelib:wildcard("echo_drv.*",PathFailing), + ?line Parent = self(), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line Port = open_port({spawn, echo_drv}, [eof]), + Pid ! go, + ?line receive opened -> ok end, + ?line {ok, pending_process, Ref3} = + erl_ddll:try_load(PathFailing, echo_drv, + [{reload,pending}, + {monitor,pending}]), + ?line ok = receive X -> {error, X} after 300 -> ok end, + Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive Y -> {error, Y} after 300 -> ok end, + ?line erlang:port_close(Port), + ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ?line ok = receive {'DOWN', Ref3, driver, echo_drv, {load_failure,driver_init_failed}} -> ok after 300 -> error end, + ?line {'EXIT',{badarg,_}} = (catch erl_ddll:info(echo_drv,processes)), + + ?line ok = receive Z -> {error, Z} after 300 -> ok end, + ?line test_server:timetrap_cancel(Dog), + ok. + +reload_pending_kill(suite) -> []; +reload_pending_kill(doc) -> ["Reload a driver with kill_ports option " + "that is pending on a user"]; +reload_pending_kill(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line OldFlag = process_flag(trap_exit,true), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + process_flag(trap_exit,true), + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), + spawn(F3), + receive go -> ok end, + Port = open_port({spawn, echo_drv}, [eof]), + Port2 = open_port({spawn, echo_drv}, [eof]), + Parent ! opened, + receive go -> ok end, + receive + {'EXIT', Port2, driver_unloaded} -> + Parent ! first_exit + end, + receive + {'EXIT', Port, driver_unloaded} -> + Parent ! second_exit + end, + receive go -> ok end, + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line {ok, already_loaded} = erl_ddll:try_load(Path, echo_drv, [{driver_options,[kill_ports]}]), + ?line {error,inconsistent} = erl_ddll:try_load(Path, echo_drv, []), + ?line Port = open_port({spawn, echo_drv}, [eof]), + Pid ! go, + ?line receive opened -> ok end, + ?line {error, pending_process} = + erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}, + {reload,pending_driver}, + {monitor,pending_driver}]), + ?line {ok, pending_process, Ref3} = + erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}, + {reload,pending}, + {monitor,pending}]), + ?line ok = receive + {'EXIT', Port, driver_unloaded} -> + ok + after 300 -> error + end, + Pid ! go, + ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ?line ok = receive {'UP', Ref3, driver, echo_drv, loaded} -> ok after 300 -> error end, + ?line [_,_] = erl_ddll:info(echo_drv,processes), + ?line ok = receive first_exit -> ok after 300 -> error end, + ?line ok = receive second_exit -> ok after 300 -> error end, + ?line 0 = erl_ddll:info(echo_drv,port_count), + ?line ok = receive X -> {error, X} after 300 -> ok end, + Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive Y -> {error, Y} after 300 -> ok end, + ?line Port2 = open_port({spawn, echo_drv}, [eof]), + ?line true = is_port(Port2), + [{Parent,1}] = erl_ddll:info(echo_drv,processes), + ?line 1 = erl_ddll:info(echo_drv,port_count), + ?line erlang:port_close(Port2), + ?line ok = receive {'EXIT', Port2, normal} -> ok after 300 -> error end, + ?line 0 = erl_ddll:info(echo_drv,port_count), + ?line [{Parent,1}] = erl_ddll:info(echo_drv,processes), + ?line Port3 = open_port({spawn, echo_drv}, [eof]), + ?line {ok, pending_driver, Ref4} = + erl_ddll:try_unload(echo_drv,[{monitor,pending_driver}]), + ?line ok = receive + {'EXIT', Port3, driver_unloaded} -> + ok + after 300 -> error + end, + ?line ok = receive {'DOWN', Ref4, driver, echo_drv, unloaded} -> ok after 300 -> error end, + io:format("Port = ~w, Port2 = ~w, Port3 = ~w~n",[Port,Port2,Port3]), + ?line ok = receive Z -> {error, Z} after 300 -> ok end, + ?line process_flag(trap_exit,OldFlag), + ?line test_server:timetrap_cancel(Dog), + ok. + + +more_error_codes(suite) -> + []; +more_error_codes(doc) -> + ["Some more error code checking"]; +more_error_codes(Config) when is_list(Config) -> + ?line {error,Err} = erl_ddll:try_load("./echo_dr",echo_dr,[]), + ?line true = is_list(erl_ddll:format_error(Err)), + ?line true = is_list(erl_ddll:format_error(not_loaded)), + ok. + +forced_port_killing(suite) -> + []; +forced_port_killing(doc) -> + ["Check kill_ports option to try_unload "]; +forced_port_killing(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line OldFlag=process_flag(trap_exit,true), + ?line Parent = self(), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line {ok, loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line spawn(F3), + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line Port = open_port({spawn, echo_drv}, [eof]), + ?line Port2 = open_port({spawn, echo_drv}, [eof]), + ?line {ok, pending_driver, Ref1} = + erl_ddll:try_unload(echo_drv,[{monitor,pending_driver},kill_ports]), + ?line ok = receive + {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok + after 300 -> error + end, + ?line ok = receive {'EXIT',Port,driver_unloaded} -> ok after 300 -> false end, + ?line ok = receive {'EXIT',Port2,driver_unloaded} -> ok after 300 -> false end, + ?line ok = receive {'DOWN',Ref1, driver, echo_drv, unloaded} -> ok after 300 -> false end, + ?line process_flag(trap_exit,OldFlag), + ?line ok = receive X -> {error, X} after 300 -> ok end, + ?line test_server:timetrap_cancel(Dog), + ok. + +no_trap_exit_and_kill_ports(suite) -> + []; +no_trap_exit_and_kill_ports(doc) -> + ["Check delayed unload and reload with no trap_exit"]; +no_trap_exit_and_kill_ports(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line Parent = self(), + ?line OldFlag=process_flag(trap_exit,true), + ?line F3 = fun() -> + Parent ! erl_ddll:monitor(driver,{echo_drv,unloaded}), + receive X -> Parent ! {got,X} end + end, + ?line Pid = spawn(fun() -> + process_flag(trap_exit,false), + receive go -> ok end, + {ok, loaded} = erl_ddll:try_load(Path, echo_drv, + [{driver_options,[kill_ports]}]), + spawn(F3), + receive go -> ok end, + _Port = open_port({spawn, echo_drv}, [eof]), + _Port2 = open_port({spawn, echo_drv}, [eof]), + exit(banan) + end), + ?line Ref = erlang:monitor(process,Pid), + Pid ! go, + ?line {ok,Ref2} = receive + R when is_reference(R) -> {ok,R}; + Other -> {error, Other} + after 500 -> {error, timeout} + end, + ?line {error, inconsistent} = erl_ddll:try_load(Path, echo_drv, []), + ?line MyPort = open_port({spawn, echo_drv}, [eof]), + Pid ! go, + ?line ok = receive {'DOWN', Ref, process, Pid, banan} -> ok after 300 -> error end, + ?line ok = receive {got,{'DOWN', Ref2, driver, echo_drv, unloaded}} -> ok after 300 -> error end, + ?line ok = receive {'EXIT',MyPort,driver_unloaded} -> ok after 300 -> error end, + ?line process_flag(trap_exit,OldFlag), + ?line test_server:timetrap_cancel(Dog), + ok. + +monitor_demonitor(suite) -> + []; +monitor_demonitor(doc) -> + ["Check monitor and demonitor of drivers"]; +monitor_demonitor(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:try_load(Path, echo_drv, []), + ?line Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ?line Self = self(), + ?line [{Self,1}] = erl_ddll:info(echo_drv,awaiting_unload), + ?line true = erl_ddll:demonitor(Ref), + ?line [] = erl_ddll:info(echo_drv,awaiting_unload), + ?line erl_ddll:try_unload(echo_drv,[]), + ?line ok = receive _ -> error after 300 -> ok end, + ?line test_server:timetrap_cancel(Dog), + ok. + +monitor_demonitor_load(suite) -> + []; +monitor_demonitor_load(doc) -> + ["Check monitor/demonitor of driver loading"]; +monitor_demonitor_load(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line {ok,loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line Port = open_port({spawn, echo_drv}, [eof]), + ?line Ref = erl_ddll:monitor(driver,{echo_drv,loaded}), + ?line ok = receive {'UP',Ref,driver,echo_drv,loaded} -> ok after 500 -> error end, + ?line {ok, pending_driver} = erl_ddll:try_unload(echo_drv,[]), + ?line Ref2 = erl_ddll:monitor(driver,{echo_drv,loaded}), + ?line ok = receive {'DOWN',Ref2,driver,echo_drv,load_cancelled} -> ok after 0 -> error end, + ?line {ok,already_loaded} = erl_ddll:try_load(Path, echo_drv, []), + ?line {ok, pending_driver} = + erl_ddll:try_load(Path, echo_drv, [{reload,pending_driver}]), + ?line Ref3 = erl_ddll:monitor(driver,{echo_drv,loaded}), + ?line Ref4 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ?line ok = receive _ -> error after 300 -> ok end, + ?line Self = self(), + ?line [{Self,1}] = erl_ddll:info(echo_drv,awaiting_load), + ?line true = erl_ddll:demonitor(Ref3), + ?line [] = erl_ddll:info(echo_drv,awaiting_load), + ?line erlang:port_close(Port), + ?line ok = receive {'DOWN',Ref4,driver,echo_drv,unloaded} -> ok after 300 -> error end, + ?line ok = receive _ -> error after 300 -> ok end, + ?line ok = unload_expect_fast(echo_drv,[]), + ?line test_server:timetrap_cancel(Dog), + ok. + +new_interface(suite) -> + []; +new_interface(doc) -> + ["Test the new load/unload/reload interface"]; +new_interface(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + % Typical scenario + ?line ok = erl_ddll:load(Path, echo_drv), + ?line Port = open_port({spawn, echo_drv}, [eof]), + ?line ok = erl_ddll:unload(echo_drv), + ?line Port ! {self(), {command, "text"}}, + ?line ok = receive + {Port, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ?line Ref = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ?line ok = receive X -> {error, X} after 300 -> ok end, + ?line erlang:port_close(Port), + ?line ok = receive {'DOWN', Ref, driver, echo_drv, unloaded} -> ok after 300 -> error end, + % More than one user + ?line ok = erl_ddll:load(Path, echo_drv), + ?line Ref2 = erl_ddll:monitor(driver,{echo_drv,unloaded}), + ?line ok = erl_ddll:load(Path, echo_drv), + ?line ok = erl_ddll:load(Path, echo_drv), + ?line Port2 = open_port({spawn, echo_drv}, [eof]), + ?line ok = erl_ddll:unload(echo_drv), + ?line Port2 ! {self(), {command, "text"}}, + ?line ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ?line ok = erl_ddll:unload(echo_drv), + ?line Port2 ! {self(), {command, "text"}}, + ?line ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ?line ok = erl_ddll:unload(echo_drv), + ?line Port2 ! {self(), {command, "text"}}, + ?line ok = receive + {Port2, {data, "text"}} -> ok; + _ -> error + after + 1000 -> error + end, + ?line ok = receive X2 -> {error, X2} after 300 -> ok end, + ?line ok = erl_ddll:load(Path, echo_drv), + ?line ok = receive {'UP', Ref2, driver, echo_drv, unload_cancelled} -> ok after 300 -> error end, + ?line Ref3 = erl_ddll:monitor(driver,{echo_drv,unloaded_only}), + ?line erlang:port_close(Port2), + ?line ok = receive X3 -> {error, X3} after 300 -> ok end, + ?line ok = erl_ddll:unload(echo_drv), + ?line ok = receive {'DOWN', Ref3, driver, echo_drv, unloaded} -> ok after 300 -> error end, + ?line test_server:timetrap_cancel(Dog), + ok. + + + + +ddll_test(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + + %?line {error,{already_started,ErlDdllPid}} = erl_ddll:start(), + %?line ErlDdllPid = whereis(ddll_server), + + %% Load the echo driver and verify that it was loaded. + {ok,L1,L2}=load_echo_driver(Path), + + %% Verify that the driver works. + + ?line Port = open_port({spawn, echo_drv}, [eof]), + ?line {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), + ?line {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,47,{hej, "hopp",4711,123445567436543653}), + ?line Port ! {self(), {command, "text"}}, + ?line 1 = receive + {Port, {data, "text"}} -> 1; + _Other -> 2 + after + 1000 -> 2 + end, + ?line Port ! {self(), close}, + ?line receive {Port, closed} -> ok end, + +%% %% Unload the driver and verify that it was unloaded. + ok = unload_echo_driver(L1,L2), + +%% %?line {error, {already_started, _}} = erl_ddll:start(), + + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests errors having to do with bad drivers. + +errors(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + + ?line {ok, L1} = erl_ddll:loaded_drivers(), + + ?line {error, {open_error, _}} = erl_ddll:load_driver(Path, bad_name), + ?line {error, driver_init_failed} = erl_ddll:load_driver(Path, initfail_drv), + ?line {error, bad_driver_name} = erl_ddll:load_driver(Path, wrongname_drv), + + %% We assume that there is a statically linked driver named "ddll": + ?line {error, linked_in_driver} = erl_ddll:unload_driver(efile), + ?line {error, not_loaded} = erl_ddll:unload_driver("__pucko_driver__"), + + case os:type() of + {unix, _} -> + ?line {error, no_driver_init} = + erl_ddll:load_driver(Path, noinit_drv); + _ -> + ok + end, + + ?line {ok, L1} = erl_ddll:loaded_drivers(), + + ?line test_server:timetrap_cancel(Dog), + ok. + +reference_count(doc) -> + ["Check that drivers are unloaded when their reference count ", + "reaches zero, and that they cannot be unloaded while ", + "they are still referenced."]; +reference_count(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + + %% Spawn a process that loads the driver (and holds a reference + %% to it). + Pid1=spawn_link(?MODULE, echo_loader, [Path, self()]), + receive + {Pid1, echo_loaded} -> ok + after 2000 -> test_server:fail("echo_loader failed to start.") + end, + + Pid1 ! {self(), die}, + ?line test_server:sleep(200), % Give time to unload. + % Verify that the driver was automaticly unloaded when the + % process died. + ?line {error, not_loaded}=erl_ddll:unload_driver(echo_drv), + + ?line test_server:timetrap_cancel(Dog), + ok. + +% Loads the echo driver, send msg to started, sits and waits to +% get a signal to die, then unloads the driver and terminates. +echo_loader(Path, Starter) -> + ?line {ok, L1, L2}=load_echo_driver(Path), + ?line Starter ! {self(), echo_loaded}, + receive + {Starter, die} -> + ?line unload_echo_driver(L1,L2) + end. + +% Loads the echo driver, send msg to started, sits and waits to +% get a signal to die, then unloads the driver and terminates. +nice_echo_loader(Path, Starter) -> + ?line {ok, L1, L2}=load_nice_echo_driver(Path), + ?line Starter ! {self(), echo_loaded}, + receive + {Starter, die} -> + ?line unload_echo_driver(L1,L2) + end. + + +kill_port(doc) -> + ["Test that a port that uses a driver is killed when the ", + "process that loaded the driver dies."]; +kill_port(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + + %% Spawn a process that loads the driver (and holds a reference + %% to it). + ?line Pid1=spawn(?MODULE, echo_loader, [Path, self()]), + ?line receive + {Pid1, echo_loaded} -> + ok + after 3000 -> + ?line exit(Pid1, kill), + ?line test_server:fail("echo_loader failed to start.") + end, + + % Spawn off a port that uses the driver. + ?line Port = open_port({spawn, echo_drv}, [eof]), + + % Kill the process / unload the driver. + ?line process_flag(trap_exit, true), + ?line exit(Pid1, kill), + ?line test_server:sleep(200), % Give some time to unload. + ?line {error, not_loaded} = erl_ddll:unload_driver(echo_drv), + + % See if the port is killed. + receive + {'EXIT', Port, Reason} -> + io:format("Port exited with reason ~w", [Reason]) + after 5000 -> + ?line test_server:fail("Echo port did not terminate.") + end, + + %% Cleanup and exit. + ?line test_server:timetrap_cancel(Dog), + ok. + +dont_kill_port(doc) -> + ["Test that a port that uses a driver is not killed when the ", + "process that loaded the driver dies and it's nicely opened."]; +dont_kill_port(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + + %% Spawn a process that loads the driver (and holds a reference + %% to it). + ?line Pid1=spawn(?MODULE, nice_echo_loader, [Path, self()]), + ?line receive + {Pid1, echo_loaded} -> + ok + after 3000 -> + ?line exit(Pid1, kill), + ?line test_server:fail("echo_loader failed to start.") + end, + + % Spawn off a port that uses the driver. + ?line Port = open_port({spawn, echo_drv}, [eof]), + + % Kill the process / unload the driver. + ?line process_flag(trap_exit, true), + ?line exit(Pid1, kill), + ?line test_server:sleep(200), % Give some time to unload. + ?line {hej, "hopp",4711,123445567436543653} = + erlang:port_call(Port,{hej, "hopp",4711,123445567436543653}), + ?line [] = erl_ddll:info(echo_drv,processes), + %% unload should work with no owner + ?line ok = erl_ddll:unload_driver(echo_drv), %Kill ports while at it + + % See if the port is killed. + receive + {'EXIT', Port, Reason} -> + io:format("Port exited with reason ~w", [Reason]) + after 5000 -> + ?line test_server:fail("Echo port did not terminate.") + end, + + %% Cleanup and exit. + ?line test_server:timetrap_cancel(Dog), + ok. + +properties(doc) -> ["Test that a process that loaded a driver ", + "is the only process that can unload it."]; +properties(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + + % Let another process load the echo driver. + Pid=spawn_link(?MODULE, echo_loader, [Path, self()]), + receive + {Pid, echo_loaded} -> ok + after 2000 -> test_server:fail("echo_loader failed to start.") + end, + + % Try to unload the driver from this process (the wrong one). + ?line {error, _} = erl_ddll:unload_driver(echo_drv), + ?line {ok, Drivers} = erl_ddll:loaded_drivers(), + ?line case lists:member("echo_drv", Drivers) of + true -> + ok; + false -> + test_server:fail("Unload from wrong process " + "succeeded.") + end, + + % Unload the driver and terminate dummy process. + ?line Pid ! {self(), die}, + ?line test_server:sleep(200), % Give time to unload. + ?line test_server:timetrap_cancel(Dog), + ok. + +load_and_unload(doc) -> ["Load two drivers and unload them in load order."]; +load_and_unload(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + ?line Path = ?config(data_dir, Config), + ?line {ok, Loaded_drivers1} = erl_ddll:loaded_drivers(), + ?line ok = erl_ddll:load_driver(Path, echo_drv), + ?line ok = erl_ddll:load_driver(Path, dummy_drv), + ?line ok = erl_ddll:unload_driver(echo_drv), + ?line ok = erl_ddll:unload_driver(dummy_drv), + ?line {ok, Loaded_drivers2} = erl_ddll:loaded_drivers(), + ?line Set1 = ordsets:from_list(Loaded_drivers1), + ?line Set2 = ordsets:from_list(Loaded_drivers2), + ?line io:format("~p == ~p\n", [Loaded_drivers1, Loaded_drivers2]), + ?line [] = ordsets:to_list(ordsets:subtract(Set2, Set1)), + + ?line test_server:timetrap_cancel(Dog), + ok. + +lock_driver(suite) -> + []; +lock_driver(doc) -> + ["Check multiple calls to driver_lock_driver"]; +lock_driver(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line {ok, _} = erl_ddll:try_load(Path, lock_drv, []), + ?line Port1 = open_port({spawn, lock_drv}, [eof]), + ?line Port2 = open_port({spawn, lock_drv}, [eof]), + ?line true = erl_ddll:info(lock_drv,permanent), + ?line erlang:port_close(Port1), + ?line erlang:port_close(Port2), + ?line test_server:timetrap_cancel(Dog), + ok. + + +% Load and unload the echo_drv driver. +% Make sure that the driver doesn't exist before we load it, +% and that it exists before we unload it. +load_echo_driver(Path) -> + ?line {ok, L1} = erl_ddll:loaded_drivers(), + ?line ok = erl_ddll:load_driver(Path, echo_drv), + ?line {ok, L2} = erl_ddll:loaded_drivers(), + ?line ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), + ordsets:from_list(L1))), + {ok,L1,L2}. + +load_nice_echo_driver(Path) -> + ?line {ok, L1} = erl_ddll:loaded_drivers(), + ?line ok = erl_ddll:load(Path, echo_drv), + ?line {ok, L2} = erl_ddll:loaded_drivers(), + ?line ["echo_drv"] = ordsets:to_list(subtract(ordsets:from_list(L2), + ordsets:from_list(L1))), + {ok,L1,L2}. + +unload_echo_driver(L1,L2) -> + ?line {ok, L2} = erl_ddll:loaded_drivers(), + ?line ok = erl_ddll:unload_driver(echo_drv), + ?line {ok, L3} = erl_ddll:loaded_drivers(), + ?line [] = ordsets:to_list(subtract(ordsets:from_list(L3), + ordsets:from_list(L1))), + ok. + +unload_expect_fast(Driver,XFlags) -> + {ok, pending_driver, Ref} = + erl_ddll:try_unload(Driver, + [{monitor,pending_driver}]++XFlags), + receive + {'DOWN', Ref, driver, Driver, unloaded} -> + case lists:member(atom_to_list(Driver),element(2,erl_ddll:loaded_drivers())) of + true -> + {error, {still_there, Driver}}; + false -> + ok + end + after 1000 -> + {error,{unable_to_unload, Driver}} + end. diff --git a/erts/emulator/test/ddll_SUITE_data/Makefile.src b/erts/emulator/test/ddll_SUITE_data/Makefile.src new file mode 100644 index 0000000000..61652a12e2 --- /dev/null +++ b/erts/emulator/test/ddll_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: echo_drv@dll@ echo_drv_fail_init@dll@ noinit_drv@dll@ wrongname_drv@dll@ initfail_drv@dll@ dummy_drv@dll@ lock_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/ddll_SUITE_data/dummy_drv.c b/erts/emulator/test/ddll_SUITE_data/dummy_drv.c new file mode 100644 index 0000000000..e0d5067743 --- /dev/null +++ b/erts/emulator/test/ddll_SUITE_data/dummy_drv.c @@ -0,0 +1,49 @@ +#include +#include "erl_driver.h" + +#ifndef DRIVER_INIT +# define DRIVER_INIT(x) driver_init +#endif + +static ErlDrvPort erlang_port; +static ErlDrvData dummy_start(ErlDrvPort, char*); +static void dummy_read(ErlDrvData port, char *buf, int count); +static void dummy_stop(ErlDrvData), easy_read(ErlDrvData, char*, int); + +static ErlDrvEntry dummy_driver_entry = { + NULL, + dummy_start, + dummy_stop, + dummy_read, + NULL, + NULL, + "dummy_drv", + NULL +}; + +DRIVER_INIT(dummy_drv) +{ + erlang_port = (ErlDrvPort)-1; + return &dummy_driver_entry; +} + +static ErlDrvData dummy_start(ErlDrvPort port,char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + + erlang_port = port; + return (ErlDrvData)port; +} + +static void dummy_read(ErlDrvData port, char *buf, int count) +{ + driver_output(erlang_port, buf, count); +} + +static void dummy_stop(ErlDrvData port) +{ + erlang_port = (ErlDrvPort)-1; +} + diff --git a/erts/emulator/test/ddll_SUITE_data/echo_drv.c b/erts/emulator/test/ddll_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..edf78a979d --- /dev/null +++ b/erts/emulator/test/ddll_SUITE_data/echo_drv.c @@ -0,0 +1,52 @@ +#include +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData echo_start(ErlDrvPort, char *); +static void from_erlang(ErlDrvData, char*, int); +static int echo_call(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned *ret_flags); +static ErlDrvEntry echo_driver_entry = { + NULL, /* Init */ + echo_start, + NULL, /* Stop */ + from_erlang, + NULL, /* Ready input */ + NULL, /* Ready output */ + "echo_drv", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + echo_call +}; + +DRIVER_INIT(echo_drv) +{ + return &echo_driver_entry; +} + +static ErlDrvData +echo_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData) port; +} + +static void +from_erlang(ErlDrvData data, char *buf, int count) +{ + driver_output((ErlDrvPort) data, buf, count); +} + +static int +echo_call(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned *ret_flags) +{ + *rbuf = buf; + *ret_flags |= DRIVER_CALL_KEEP_BUFFER; + return len; +} + diff --git a/erts/emulator/test/ddll_SUITE_data/echo_drv_fail_init.c b/erts/emulator/test/ddll_SUITE_data/echo_drv_fail_init.c new file mode 100644 index 0000000000..3b2a44d907 --- /dev/null +++ b/erts/emulator/test/ddll_SUITE_data/echo_drv_fail_init.c @@ -0,0 +1,59 @@ +#include +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData echo_start(ErlDrvPort, char *); +static void from_erlang(ErlDrvData, char*, int); +static int echo_call(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned *ret_flags); +static int echo_failing_init(void); + +static ErlDrvEntry echo_driver_entry = { + echo_failing_init, + echo_start, + NULL, /* Stop */ + from_erlang, + NULL, /* Ready input */ + NULL, /* Ready output */ + "echo_drv", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + echo_call +}; + +DRIVER_INIT(echo_drv) +{ + return &echo_driver_entry; +} + +static int echo_failing_init(void) +{ + return -1; +} + +static ErlDrvData +echo_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData) port; +} + +static void +from_erlang(ErlDrvData data, char *buf, int count) +{ + driver_output((ErlDrvPort) data, buf, count); +} + +static int +echo_call(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned *ret_flags) +{ + *rbuf = buf; + *ret_flags |= DRIVER_CALL_KEEP_BUFFER; + return len; +} + diff --git a/erts/emulator/test/ddll_SUITE_data/initfail_drv.c b/erts/emulator/test/ddll_SUITE_data/initfail_drv.c new file mode 100644 index 0000000000..b676ff5121 --- /dev/null +++ b/erts/emulator/test/ddll_SUITE_data/initfail_drv.c @@ -0,0 +1,46 @@ +#include +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData easy_start(ErlDrvPort, char*); +static void easy_stop(ErlDrvData), easy_read(ErlDrvData, char*, int); + +static ErlDrvEntry easy_driver_entry = +{ + NULL, + easy_start, + easy_stop, + easy_read, + NULL, + NULL, + "easy", + NULL +}; + +DRIVER_INIT(initfail_drv) +{ + erlang_port = (ErlDrvPort)-1; + return 0; +} + +static ErlDrvData easy_start(ErlDrvPort port, char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + + fprintf(stderr, "Easy driver started with args %s\n", buf); + erlang_port = port; + return (ErlDrvData)port; +} + +static void easy_read(ErlDrvData port, char *buf, int count) +{ + driver_output(erlang_port, buf, count); +} + +static void easy_stop(ErlDrvData port) +{ + erlang_port = (ErlDrvPort) -1; +} + diff --git a/erts/emulator/test/ddll_SUITE_data/lock_drv.c b/erts/emulator/test/ddll_SUITE_data/lock_drv.c new file mode 100644 index 0000000000..2ec8fa3a29 --- /dev/null +++ b/erts/emulator/test/ddll_SUITE_data/lock_drv.c @@ -0,0 +1,55 @@ +#include +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData echo_start(ErlDrvPort, char *); +static void from_erlang(ErlDrvData, char*, int); +static int echo_call(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned *ret_flags); +static ErlDrvEntry echo_driver_entry = { + NULL, /* Init */ + echo_start, + NULL, /* Stop */ + from_erlang, + NULL, /* Ready input */ + NULL, /* Ready output */ + "lock_drv", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + echo_call +}; + +DRIVER_INIT(echo_drv) +{ + return &echo_driver_entry; +} + +static ErlDrvData +echo_start(ErlDrvPort port, char *buf) +{ + driver_lock_driver(port); + return (ErlDrvData) port; +} + +static void +from_erlang(ErlDrvData data, char *buf, int count) +{ + driver_output((ErlDrvPort) data, buf, count); +} + +static int +echo_call(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned *ret_flags) +{ + ErlDrvPort port = (ErlDrvPort) drv_data; + driver_lock_driver(port); + *rbuf = buf; + *ret_flags |= DRIVER_CALL_KEEP_BUFFER; + return len; +} + diff --git a/erts/emulator/test/ddll_SUITE_data/noinit_drv.c b/erts/emulator/test/ddll_SUITE_data/noinit_drv.c new file mode 100644 index 0000000000..931386a305 --- /dev/null +++ b/erts/emulator/test/ddll_SUITE_data/noinit_drv.c @@ -0,0 +1,58 @@ +#include +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData easy_start(ErlDrvPort, char*); +static void easy_stop(ErlDrvData), easy_read(ErlDrvData, char*, int); + +static ErlDrvEntry easy_driver_entry = +{ + NULL, + easy_start, + easy_stop, + easy_read, + NULL, + NULL, + "easy", + NULL +}; + +#ifdef __WIN32__ +/* + * Define a correct driver_init here, or the module won't compile. + * Note that it will not actually be used. + */ +DRIVER_INIT(noinit_drv) + +#else +/* + * Provoke an error when loading the module. + */ +int no_driver_init(void *handle) +#endif +{ + erlang_port = (ErlDrvPort)-1; + return &easy_driver_entry; +} + +static ErlDrvData easy_start(ErlDrvPort port,char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + + fprintf(stderr, "Easy driver started with args %s\n", buf); + erlang_port = port; + return (ErlDrvData)port; +} + +static void easy_read(ErlDrvData port, char *buf, int count) +{ + driver_output(erlang_port, buf, count); +} + +static void easy_stop(ErlDrvData port) +{ + erlang_port = (ErlDrvPort)-1; +} + diff --git a/erts/emulator/test/ddll_SUITE_data/wrongname_drv.c b/erts/emulator/test/ddll_SUITE_data/wrongname_drv.c new file mode 100644 index 0000000000..3a35820ee7 --- /dev/null +++ b/erts/emulator/test/ddll_SUITE_data/wrongname_drv.c @@ -0,0 +1,50 @@ +#include +#include "erl_driver.h" + +#ifndef DRIVER_INIT +# define DRIVER_INIT(x) driver_init +#endif + +static ErlDrvPort erlang_port; +static ErlDrvData easy_start(ErlDrvPort, char*); +static void easy_stop(ErlDrvData), easy_read(ErlDrvData, char*, int); + +static ErlDrvEntry easy_driver_entry = +{ + NULL, + easy_start, + easy_stop, + easy_read, + NULL, + NULL, + "easy", + NULL +}; + +DRIVER_INIT(wrongname_drv) +{ + erlang_port = (ErlDrvPort)-1; + return &easy_driver_entry; +} + +static ErlDrvData easy_start(ErlDrvPort port,char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + + fprintf(stderr, "Easy driver started with args %s\n", buf); + erlang_port = port; + return (ErlDrvData)port; +} + +static void easy_read(ErlDrvData port, char *buf, int count) +{ + driver_output(erlang_port, buf, count); +} + +static void easy_stop(ErlDrvData port) +{ + erlang_port = (ErlDrvPort)-1; +} + diff --git a/erts/emulator/test/decode_packet_SUITE.erl b/erts/emulator/test/decode_packet_SUITE.erl new file mode 100644 index 0000000000..13f17e972c --- /dev/null +++ b/erts/emulator/test/decode_packet_SUITE.erl @@ -0,0 +1,514 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% Test suite for erlang:decode_packet/3 + +-module(decode_packet_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + basic/1, packet_size/1, neg/1, http/1, line/1, ssl/1]). + +all(suite) -> + [basic, packet_size, neg, http, line, ssl]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Seed = {S1,S2,S3} = now(), + random:seed(S1,S2,S3), + io:format("*** SEED: ~p ***\n", [Seed]), + Dog=?t:timetrap(?t:minutes(1)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +basic(doc) -> []; +basic(suite) -> []; +basic(Config) when is_list(Config) -> + ?line Packet = <<101,22,203,54,175>>, + ?line Rest = <<123,34,0,250>>, + ?line Bin = <>, + ?line {ok, Bin, <<>>} = decode_pkt(raw,Bin), + + ?line {more, 5+1} = decode_pkt(1,<<5,1,2,3,4>>), + ?line {more, 5+2} = decode_pkt(2,<<0,5,1,2,3,4>>), + ?line {more, 5+4} = decode_pkt(4,<<0,0,0,5,1,2,3,4>>), + + ?line {more, undefined} = decode_pkt(1,<<>>), + ?line {more, undefined} = decode_pkt(2,<<0>>), + ?line {more, undefined} = decode_pkt(4,<<0,0,0>>), + + Types = [1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], + + %% Run tests for different header types and bit offsets. + + lists:foreach(fun({Type,Bits})->basic_pack(Type,Packet,Rest,Bits), + more_length(Type,Packet,Bits) end, + [{T,B} || T<-Types, B<-lists:seq(0,32)]), + ok. + +basic_pack(Type,Body,Rest,BitOffs) -> + ?line {Bin,Unpacked,_} = pack(Type,Body,Rest,BitOffs), + ?line {ok, Unpacked, Rest} = decode_pkt(Type,Bin), + case Rest of + <<>> -> ok; + _ -> + ?line <<_:1,NRest/bits>> = Rest, + basic_pack(Type,Body,NRest,BitOffs) + end. + +more_length(Type,Body,BitOffs) -> + ?line {Bin,_,_} = pack(Type,Body,<<>>,BitOffs), + HdrSize = byte_size(Bin) - byte_size(Body), + more_length_do(Type,HdrSize,Bin,byte_size(Bin)). + +more_length_do(_,_,_,0) -> + ok; +more_length_do(Type,HdrSize,Bin,Size) -> + TrySize = (Size*3) div 4, + NSize = if TrySize < HdrSize -> Size - 1; + true -> TrySize + end, + {B1,_} = split_binary(Bin,NSize), + ?line {more, Length} = decode_pkt(Type,B1), + case Length of + L when L=:=byte_size(Bin) -> ok; + undefined when NSize ok + end, + more_length_do(Type,HdrSize,Bin,NSize). + + + +pack(Type,Packet,Rest) -> + {Bin,Unpacked} = pack(Type,Packet), + {<>,Unpacked}. + +%pack(0,B,R,Bits) -> +% pack(raw,B,R,Bits); +%pack(raw,Body,Rest,BitOffs) -> +% Orig = <<0:BitOffs,Body/binary,Rest/bits>>, +% <<_:BitOffs,Bin/bits>> = Orig, +% {Bin,<>,Orig}; +pack(Type,Body,Rest,BitOffs) -> + {Packet,Unpacked} = pack(Type,Body), + + %% Make Bin a sub-bin with an arbitrary bitoffset within Orig + Prefix = random:uniform(1 bsl BitOffs) - 1, + Orig = <>, + <<_:BitOffs,Bin/bits>> = Orig, + {Bin,Unpacked,Orig}. + +pack(1,Bin) -> + Psz = byte_size(Bin), + {<>, Bin}; +pack(2,Bin) -> + Psz = byte_size(Bin), + {<>, Bin}; +pack(4,Bin) -> + Psz = byte_size(Bin), + {<>, Bin}; +pack(asn1,Bin) -> + Ident = case random:uniform(3) of + 1 -> <<17>>; + 2 -> <<16#1f,16#81,17>>; + 3 -> <<16#1f,16#81,16#80,16#80,17>> + end, + Psz = byte_size(Bin), + Length = case random:uniform(4) of + 1 when Psz < 128 -> + <>; + R when R=<2 andalso Psz < 16#10000 -> + <<16#82,Psz:16>>; + R when R=<3 andalso Psz < 16#1000000 -> + <<16#83,Psz:24>>; + _ when Psz < 16#100000000 -> + <<16#84,Psz:32>> + end, + Res = <>, + {Res,Res}; +pack(sunrm,Bin) -> + Psz = byte_size(Bin), + Res = if Psz < 16#80000000 -> + <> + end, + {Res,Res}; +pack(cdr,Bin) -> + GIOP = <<"GIOP">>, + Major = random:uniform(256) - 1, + Minor = random:uniform(256) - 1, + MType = random:uniform(256) - 1, + Psz = byte_size(Bin), + Res = case random:uniform(2) of + 1 -> <>; + 2 -> <> + end, + {Res,Res}; +pack(fcgi,Bin) -> + Ver = 1, + Type = random:uniform(256) - 1, + Id = random:uniform(65536) - 1, + PaddSz = random:uniform(16) - 1, + Psz = byte_size(Bin), + Reserv = random:uniform(256) - 1, + Padd = case PaddSz of + 0 -> <<>>; + _ -> list_to_binary([random:uniform(256)-1 + || _<- lists:seq(1,PaddSz)]) + end, + Res = <>, + {<>, Res}; +pack(tpkt,Bin) -> + Ver = 3, + Reserv = random:uniform(256) - 1, + Size = byte_size(Bin) + 4, + Res = <>, + {Res, Res}; +pack(ssl_tls,Bin) -> + Content = case (random:uniform(256) - 1) of + C when C<128 -> C; + _ -> v2hello + end, + Major = random:uniform(256) - 1, + Minor = random:uniform(256) - 1, + pack_ssl(Content,Major,Minor,Bin). + +pack_ssl(Content, Major, Minor, Body) -> + case Content of + v2hello -> + Size = byte_size(Body), + Res = <<1:1,(Size+3):15, 1:8, Major:8, Minor:8, Body/binary>>, + C = 22, + Data = <<1:8, (Size+2):24, Major:8, Minor:8, Body/binary>>; + C when is_integer(C) -> + Size = byte_size(Body), + Res = <>, + Data = Body + end, + {Res, {ssl_tls,[],C,{Major,Minor}, Data}}. + + +packet_size(doc) -> []; +packet_size(suite) -> []; +packet_size(Config) when is_list(Config) -> + ?line Packet = <<101,22,203,54,175>>, + ?line Rest = <<123,34,0,250>>, + + F = fun({Type,Max})-> + ?line {Bin,Unpacked} = pack(Type,Packet,Rest), + ?line case decode_pkt(Type,Bin,[{packet_size,Max}]) of + {ok,Unpacked,Rest} when Max=:=0; Max>=byte_size(Packet) -> + ok; + {error,_} when Max + ok; + {error,_} when Type=:=fcgi, Max=/=0 -> + %% packet includes random amount of padding + ok + end + end, + ?line lists:foreach(F, [{T,D} || T<-[1,2,4,asn1,sunrm,cdr,fcgi,tpkt,ssl_tls], + D<-lists:seq(0, byte_size(Packet)*2)]), + + %% Test OTP-8102, "negative" 4-byte sizes. + lists:foreach(fun(Size) -> + ?line {error,_} = decode_pkt(4,<>) + end, + lists:seq(-10,-1)), + ok. + + +neg(doc) -> []; +neg(suite) -> []; +neg(Config) when is_list(Config) -> + ?line Bin = <<"dummy">>, + Fun = fun()->dummy end, + + BadargF = fun(T,B,Opts)-> {'EXIT',{badarg,_}} = (catch decode_pkt(T,B,Opts)) end, + + %% Invalid Type args + lists:foreach(fun(T)-> BadargF(T,Bin,[]) end, + [3,-1,5,2.0,{2},unknown,[],"line",Bin,Fun,self()]), + + %% Invalid Bin args + lists:foreach(fun(B)-> BadargF(0,B,[]) end, + [3,2.0,unknown,[],"Bin",[Bin],{Bin},Fun,self()]), + + %% Invalid options + InvOpts = [2,false,self(),Bin,"Options",Fun, + packet_size,{packet_size},{packet_size,0,false}, + {packet_size,-1},{packet_size,100.0},{packet_size,false}, + {line_length,-1},{line_length,100.0},{line_length,false}], + + lists:foreach(fun(Opt)-> BadargF(0,Bin,Opt), + BadargF(0,Bin,[Opt]), + BadargF(0,Bin,[Opt,{packet_size,1000}]), + BadargF(0,Bin,[{packet_size,1000},Opt]) end, + InvOpts), + ok. + + +http(doc) -> []; +http(suite) -> []; +http(Config) when is_list(Config) -> + ?line <<"foo">> = http_do(http_request("foo")), + ?line <<" bar">> = http_do(http_request(" bar")), + ?line <<"Hello!">> = http_do(http_response("Hello!")), + + %% Test all known header atoms + Val = "dummy value", + ValB = list_to_binary(Val), + Rest = <<"Rest">>, + HdrF = fun(Str,N) -> + ?line StrA = list_to_atom(Str), + ?line StrB = list_to_binary(Str), + ?line Bin = <>, + ?line {ok, {http_header,N,StrA,undefined,Val}, Rest} = decode_pkt(httph,Bin), + ?line {ok, {http_header,N,StrA,undefined,ValB}, Rest} = decode_pkt(httph_bin,Bin), + ?line N + 1 + end, + ?line lists:foldl(HdrF, 1, http_hdr_strings()), + + %% Test all known method atoms + MethF = fun(Meth) -> + ?line MethA = list_to_atom(Meth), + ?line MethB = list_to_binary(Meth), + ?line Bin = <>, + ?line {ok, {http_request,MethA,{abs_path,"/invalid/url"},{1,0}}, + Rest} = decode_pkt(http,Bin), + ?line {ok, {http_request,MethA,{abs_path,<<"/invalid/url">>},{1,0}}, + Rest} = decode_pkt(http_bin,Bin) + end, + ?line lists:foreach(MethF, http_meth_strings()), + + %% Test all uri variants + UriF = fun({Str,ResL,ResB}) -> + Bin = <<"GET ",(list_to_binary(Str))/binary," HTTP/1.1\r\n",Rest/binary>>, + {ok, {http_request, 'GET', ResL, {1,1}}, Rest} = decode_pkt(http,Bin), + {ok, {http_request, 'GET', ResB, {1,1}}, Rest} = decode_pkt(http_bin,Bin) + end, + lists:foreach(UriF, http_uri_variants()), + ok. + +http_with_bin(http) -> + http_bin; +http_with_bin(httph) -> + httph_bin. + +http_do(Tup) -> + http_do(Tup,http). +http_do({Bin, []}, _) -> + Bin; +http_do({Bin,[{_Line,PL,PB}|Tail]}, Type) -> + ?line {ok, PL, Rest} = decode_pkt(Type,Bin), + ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),Bin), + + %% Same tests again but as SubBin + PreLen = random:uniform(64), + Prefix = random:uniform(1 bsl PreLen) - 1, + SufLen = random:uniform(64), + Suffix = random:uniform(1 bsl SufLen) - 1, + Orig = <>, + BinLen = bit_size(Bin), + <<_:PreLen, SubBin:BinLen/bits, _/bits>> = Orig, % Make SubBin + ?line SubBin = Bin, % just to make sure + + ?line {ok, PL, Rest} = decode_pkt(Type,SubBin), + ?line {ok, PB, Rest} = decode_pkt(http_with_bin(Type),SubBin), + http_do({Rest, Tail}, httph). + +http_request(Msg) -> + QnA = [{"POST /invalid/url HTTP/1.1\r\n", + {http_request, 'POST', {abs_path, "/invalid/url" }, {1,1}}, + {http_request, 'POST', {abs_path,<<"/invalid/url">>}, {1,1}}}, + {"Connection: close\r\n", + {http_header,2,'Connection',undefined, "close"}, + {http_header,2,'Connection',undefined,<<"close">>}}, + {"Host\t : localhost:8000\r\n", % white space before : + {http_header,14,'Host',undefined, "localhost:8000"}, + {http_header,14,'Host',undefined,<<"localhost:8000">>}}, + {"User-Agent: perl post\r\n", + {http_header,24,'User-Agent',undefined, "perl post"}, + {http_header,24,'User-Agent',undefined,<<"perl post">>}}, + {"Content-Length: 4\r\n", + {http_header,38,'Content-Length',undefined, "4"}, + {http_header,38,'Content-Length',undefined,<<"4">>}}, + {"Content-Type: text/xml; charset=utf-8\r\n", + {http_header,42,'Content-Type',undefined, "text/xml; charset=utf-8"}, + {http_header,42,'Content-Type',undefined,<<"text/xml; charset=utf-8">>}}, + {"Other-Field: with some text\r\n", + {http_header,0, "Other-Field" ,undefined, "with some text"}, + {http_header,0,<<"Other-Field">>,undefined,<<"with some text">>}}, + {"Multi-Line: Once upon a time in a land far far away,\r\n" + " there lived a princess imprisoned in the highest tower\r\n" + " of the most haunted castle.\r\n", + {http_header,0, "Multi-Line" ,undefined, "Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle."}, + {http_header,0,<<"Multi-Line">>,undefined,<<"Once upon a time in a land far far away,\r\n there lived a princess imprisoned in the highest tower\r\n of the most haunted castle.">>}}, + {"\r\n", + http_eoh, + http_eoh}], + Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line), + <> end, + <<"">>, QnA), + MsgBin = list_to_binary(Msg), + {<>, QnA}. + + +http_response(Msg) -> + QnA = [{"HTTP/1.0 404 Object Not Found\r\n", + {http_response, {1,0}, 404, "Object Not Found"}, + {http_response, {1,0}, 404, <<"Object Not Found">>}}, + {"Server: inets/4.7.16\r\n", + {http_header, 30, 'Server', undefined, "inets/4.7.16"}, + {http_header, 30, 'Server', undefined, <<"inets/4.7.16">>}}, + {"Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n", + {http_header, 3, 'Date', undefined, "Fri, 04 Jul 2008 17:16:22 GMT"}, + {http_header, 3, 'Date', undefined, <<"Fri, 04 Jul 2008 17:16:22 GMT">>}}, + {"Content-Type: text/html\r\n", + {http_header, 42, 'Content-Type', undefined, "text/html"}, + {http_header, 42, 'Content-Type', undefined, <<"text/html">>}}, + {"Content-Length: 207\r\n", + {http_header, 38, 'Content-Length', undefined, "207"}, + {http_header, 38, 'Content-Length', undefined, <<"207">>}}, + {"\r\n", + http_eoh, + http_eoh}], + + + + Bin = lists:foldl(fun({Line,_,_},Acc) -> LineBin = list_to_binary(Line), + <> end, + <<"">>, QnA), + MsgBin = list_to_binary(Msg), + {<>, QnA}. + +http_hdr_strings() -> + %% Must be correct order + ["Cache-Control","Connection","Date","Pragma","Transfer-Encoding", + "Upgrade","Via","Accept", "Accept-Charset", "Accept-Encoding", + "Accept-Language", "Authorization","From","Host","If-Modified-Since", + "If-Match","If-None-Match","If-Range","If-Unmodified-Since","Max-Forwards", + "Proxy-Authorization","Range","Referer","User-Agent","Age","Location", + "Proxy-Authenticate","Public","Retry-After","Server","Vary","Warning", + "Www-Authenticate","Allow","Content-Base","Content-Encoding", + "Content-Language","Content-Length","Content-Location","Content-Md5", + "Content-Range","Content-Type","Etag","Expires","Last-Modified", + "Accept-Ranges","Set-Cookie","Set-Cookie2","X-Forwarded-For","Cookie", + "Keep-Alive","Proxy-Connection"]. + +http_meth_strings() -> + ["OPTIONS", "GET", "HEAD", "POST", "PUT", "DELETE", "TRACE"]. + +http_uri_variants() -> + [{"*", '*', '*'}, + {"http://tools.ietf.org/html/rfc3986", + {absoluteURI,http, "tools.ietf.org", undefined, "/html/rfc3986"}, + {absoluteURI,http,<<"tools.ietf.org">>,undefined,<<"/html/rfc3986">>}}, + {"http://otp.ericsson.se:8000/product/internal/", + {absoluteURI,http, "otp.ericsson.se" ,8000, "/product/internal/"}, + {absoluteURI,http,<<"otp.ericsson.se">>,8000,<<"/product/internal/">>}}, + {"https://example.com:8042/over/there?name=ferret#nose", + {absoluteURI,https, "example.com", 8042, "/over/there?name=ferret#nose"}, + {absoluteURI,https,<<"example.com">>,8042,<<"/over/there?name=ferret#nose">>}}, + {"ftp://cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm", + {scheme, "ftp", "//cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm"}, + {scheme,<<"ftp">>,<<"//cnn.example.com&story=breaking_news@10.0.0.1/top_story.htm">>}}, + {"/some/absolute/path", + {abs_path, "/some/absolute/path"}, + {abs_path,<<"/some/absolute/path">>}}, + {"something_else", "something_else", <<"something_else">>}]. + + +line(doc) -> []; +line(suite) -> []; +line(Config) when is_list(Config) -> + Text = <<"POST /invalid/url HTTP/1.1\r\n" + "Connection: close\r\n" + "Host\t : localhost:8000\r\n" + "User-Agent: perl post\r\n" + "Content-Length: 4\r\n" + "Content-Type: text/xml; charset=utf-8\r\n" + "Other-Field: with some text\r\n" + "Multi-Line: Once upon a time in a land far far away,\r\n" + " there lived a princess imprisoned in the highest tower\r\n" + " of the most haunted castle.\r\n" + "\r\nThe residue">>, + + lists:foreach(fun(MaxLen) -> line_do(Text,MaxLen) end, + [0,7,19,29,37]), + ok. + +line_do(Bin,MaxLen) -> + Res = decode_pkt(line,Bin,[{line_length,MaxLen}]), + MyRes = decode_line(Bin,MaxLen), + ?line MyRes = Res, + case Res of + {ok,_,Rest} -> + line_do(Rest,MaxLen); + {more,undefined} -> + ok + end. + +% Emulates decode_packet(line,Bin,[{line_length,MaxLen}]) +decode_line(Bin,MaxLen) -> + ?line case find_in_binary($\n,Bin) of + notfound when MaxLen>0 andalso byte_size(Bin) >= MaxLen -> + {LineB,Rest} = split_binary(Bin,MaxLen), + {ok,LineB,Rest}; + notfound -> + {more,undefined}; + Pos when MaxLen>0 andalso Pos > MaxLen -> + {LineB,Rest} = split_binary(Bin,MaxLen), + {ok,LineB,Rest}; + Pos -> + {LineB,Rest} = split_binary(Bin,Pos), + {ok,LineB,Rest} + end. + +find_in_binary(Byte, Bin) -> + case string:chr(binary_to_list(Bin),Byte) of + 0 -> notfound; + P -> P + end. + +ssl(doc) -> []; +ssl(suite) -> []; +ssl(Config) when is_list(Config) -> + Major = 34, + Minor = 17, + Body = <<234,189,73,199,1,32,4,0,254>>, + Rest = <<23,123,203,12,234>>, + + F = fun(Content) -> + {Packet,Unpacked} = pack_ssl(Content, Major, Minor, Body), + Bin = <>, + ?line {ok, Unpacked, Rest} = decode_pkt(ssl_tls, Bin) + end, + F(25), + F(v2hello), + ok. + +decode_pkt(Type,Bin) -> + decode_pkt(Type,Bin,[]). +decode_pkt(Type,Bin,Opts) -> + %%io:format("decode_packet(~p,~p,~p)\n",[Type,Bin,Opts]), + Res = erlang:decode_packet(Type,Bin,Opts), + %%io:format(" -> ~p\n",[Res]), + Res. + diff --git a/erts/emulator/test/dgawd_handler.erl b/erts/emulator/test/dgawd_handler.erl new file mode 100644 index 0000000000..881354b9da --- /dev/null +++ b/erts/emulator/test/dgawd_handler.erl @@ -0,0 +1,118 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : dgawd_handler.erl +%%% Author : Rickard Green +%%% Description : Find out if Driver Gone Away Without Deselecting +%%% have been reported. +%%% +%%% Created : 13 Sep 2006 by Rickard Green +%%%------------------------------------------------------------------- +-module(dgawd_handler). +-behaviour(gen_event). + +%% API +-export([install/0, restore/0]). +-export([got_dgawd_report/0]). + +%% gen_event callbacks +-export([init/1, handle_event/2, handle_call/2, + handle_info/2, terminate/2, code_change/3]). + +%%==================================================================== +%% API +%%==================================================================== + +install() -> + gen_event:add_handler(error_logger, ?MODULE, []). + +restore() -> + gen_event:delete_handler(error_logger, ?MODULE, []). + +got_dgawd_report() -> + gen_event:call(error_logger, ?MODULE, got_dgawd_report, 10*60*1000). + +%%==================================================================== +%% gen_event callbacks +%%==================================================================== + +init([]) -> + {ok, false}. + +handle_event(_, true) -> + {ok, true}; +handle_event({_, _, {emulator, _,IOList}}, false) -> + {ok, dgawd(lists:flatten(IOList))}; +handle_event(_, State) -> + {ok, State}. + +handle_call(got_dgawd_report, State) -> + {ok, State, State}; +handle_call(_Query, _State) -> + {error, bad_query}. + +handle_info(_, State) -> + {ok, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%% +%% Internal functions +%% + +dgawd([]) -> + false; +dgawd([$d,$r,$i,$v,$e,$r|Cs]) -> + gawd(Cs); +dgawd([_|Cs]) -> + dgawd(Cs). + +gawd([]) -> + false; +gawd([$g,$o,$n,$e|Cs]) -> + awd(Cs); +gawd([_|Cs]) -> + gawd(Cs). + +awd([]) -> + false; +awd([$a,$w,$a,$y|Cs]) -> + wd(Cs); +awd([_|Cs]) -> + awd(Cs). + +wd([]) -> + false; +wd([$w,$i,$t,$h,$o,$u,$t|Cs]) -> + d(Cs); +wd([_|Cs]) -> + wd(Cs). + + +d([]) -> + false; +d([$d,$e,$s,$e,$l,$e,$c,$t,$i,$n,$g|_Cs]) -> + true; +d([_|Cs]) -> + d(Cs). diff --git a/erts/emulator/test/dist_init_unix_SUITE_data/hosts.dn_sp b/erts/emulator/test/dist_init_unix_SUITE_data/hosts.dn_sp new file mode 100644 index 0000000000..6cc288e524 --- /dev/null +++ b/erts/emulator/test/dist_init_unix_SUITE_data/hosts.dn_sp @@ -0,0 +1,7 @@ +# +# Internet host table +# +127.0.0.1 localhost +150.236.20.72 elrond +150.236.20.16 gandalf +150.236.20.99 gandalfina diff --git a/erts/emulator/test/dist_init_unix_SUITE_data/hosts.underscore b/erts/emulator/test/dist_init_unix_SUITE_data/hosts.underscore new file mode 100644 index 0000000000..2e7831ff02 --- /dev/null +++ b/erts/emulator/test/dist_init_unix_SUITE_data/hosts.underscore @@ -0,0 +1,7 @@ +# +# Internet host table +# +127.0.0.1 localhost +150.236.20.72 elrond loghost +150.236.20.16 gandalf +150.236.20.199 under_score diff --git a/erts/emulator/test/dist_init_unix_SUITE_data/nsswitch.conf.dn_sp b/erts/emulator/test/dist_init_unix_SUITE_data/nsswitch.conf.dn_sp new file mode 100644 index 0000000000..55a4f9ac86 --- /dev/null +++ b/erts/emulator/test/dist_init_unix_SUITE_data/nsswitch.conf.dn_sp @@ -0,0 +1,31 @@ +# +# /etc/nsswitch.nis: +# +# An example file that could be copied over to /etc/nsswitch.conf; it +# uses NIS (YP) in conjunction with files. +# +# "hosts:" and "services:" in this file are used only if the +# /etc/netconfig file has a "-" for nametoaddr_libs of "inet" transports. + +# the following two lines obviate the "+" entry in /etc/passwd and /etc/group. +passwd: files nis +group: files nis + +# consult /etc "files" only if nis is down. +hosts: nis [NOTFOUND=return] +networks: nis [NOTFOUND=return] files +protocols: nis [NOTFOUND=return] files +rpc: nis [NOTFOUND=return] files +ethers: nis [NOTFOUND=return] files +netmasks: nis [NOTFOUND=return] files +bootparams: nis [NOTFOUND=return] files +publickey: nis [NOTFOUND=return] files + +netgroup: nis + +automount: files nis +aliases: files nis + +# for efficient getservbyname() avoid nis +services: files nis +sendmailvars: files diff --git a/erts/emulator/test/dist_init_unix_SUITE_data/resolv.conf.dn_sp b/erts/emulator/test/dist_init_unix_SUITE_data/resolv.conf.dn_sp new file mode 100644 index 0000000000..13a78d5bbb --- /dev/null +++ b/erts/emulator/test/dist_init_unix_SUITE_data/resolv.conf.dn_sp @@ -0,0 +1,6 @@ +domain du.etx.ericsson.se +nameserver 150.236.14.16 +nameserver 150.236.16.2 +nameserver 130.100.128.25 +search du.etx.ericsson.se etx.ericsson.se ericsson.se +lookup yp bind file diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl new file mode 100644 index 0000000000..8f48d8a992 --- /dev/null +++ b/erts/emulator/test/distribution_SUITE.erl @@ -0,0 +1,1842 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(distribution_SUITE). + +%% Tests distribution and the tcp driver. + +-include("test_server.hrl"). + +-export([all/1, + ping/1, bulk_send/1, bulk_send_small/1, + bulk_send_big/1, + local_send/1, local_send_small/1, local_send_big/1, + local_send_legal/1, link_to_busy/1, exit_to_busy/1, + lost_exit/1, link_to_dead/1, link_to_dead_new_node/1, + applied_monitor_node/1, ref_port_roundtrip/1, nil_roundtrip/1, + trap_bif/1, trap_bif_1/1, trap_bif_2/1, trap_bif_3/1, + stop_dist/1, dist_auto_connect/1, + dist_auto_connect_never/1, dist_auto_connect_once/1, + dist_parallel_send/1, + atom_roundtrip/1, + atom_roundtrip_r12b/1, + contended_atom_cache_entry/1, + bad_dist_ext/1, + bad_dist_ext_receive/1, + bad_dist_ext_process_info/1, + bad_dist_ext_control/1, + bad_dist_ext_connection_id/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +%% Internal exports. +-export([sender/3, receiver2/2, dummy_waiter/0, dead_process/0, + roundtrip/1, bounce/1, do_dist_auto_connect/1, inet_rpc_server/1, + dist_parallel_sender/3, dist_parallel_receiver/0, + dist_evil_parallel_receiver/0]). + +all(suite) -> [ + ping, bulk_send, local_send, link_to_busy, exit_to_busy, + lost_exit, link_to_dead, link_to_dead_new_node, + applied_monitor_node, ref_port_roundtrip, nil_roundtrip, + stop_dist, trap_bif, dist_auto_connect, dist_parallel_send, + atom_roundtrip, atom_roundtrip_r12b, + contended_atom_cache_entry, + bad_dist_ext + ]. + +-define(DEFAULT_TIMETRAP, 4*60*1000). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?DEFAULT_TIMETRAP), + [{watchdog, Dog},{testcase, Func}|Config]. + +fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +%%% Don't be too hard on vxworks, the cross server gets nodedown +%%% cause the card is too busy if we don't sleep a little between pings. +sleep() -> + case os:type() of + vxworks -> + receive + after 10 -> + ok + end; + _ -> + ok + end. + +ping(doc) -> + ["Tests pinging a node in different ways."]; +ping(Config) when is_list(Config) -> + Times = 1024, + + %% Ping a non-existing node many times. This used to crash the emulator + %% on Windows. + + ?line Host = hostname(), + ?line BadName = list_to_atom("__pucko__@" ++ Host), + ?line io:format("Pinging ~s (assumed to not exist)", [BadName]), + ?line test_server:do_times(Times, + fun() -> pang = net_adm:ping(BadName), + sleep() + end), + + %% Pings another node. + + ?line {ok, OtherNode} = start_node(distribution_SUITE_other), + ?line io:format("Pinging ~s (assumed to exist)", [OtherNode]), + ?line test_server:do_times(Times, fun() -> pong = net_adm:ping(OtherNode),sleep() end), + ?line stop_node(OtherNode), + + %% Pings our own node many times. + + ?line Node = node(), + ?line io:format("Pinging ~s (the same node)", [Node]), + ?line test_server:do_times(Times, fun() -> pong = net_adm:ping(Node),sleep() end), + + ok. + +bulk_send(doc) -> + ["Tests sending large amount of data to another node and measure", + "the time. This tests that a process that is suspended on a ", + "busy port will eventually be resumed."]; +bulk_send(suite) -> + [bulk_send_small, bulk_send_big]. + +bulk_send_small(Config) when is_list(Config) -> + ?line bulk_send(64, 32). + +bulk_send_big(Config) when is_list(Config) -> + ?line bulk_send(32, 64). + +bulk_send(Terms, BinSize) -> + ?line Dog = test_server:timetrap(test_server:seconds(30)), + + ?line io:format("Sending ~w binaries, each of size ~w K", + [Terms, BinSize]), + ?line {ok, Node} = start_node(bulk_receiver), + ?line Recv = spawn(Node, erlang, apply, [fun receiver/2, [0, 0]]), + ?line Bin = list_to_binary(lists:duplicate(BinSize*1024, 253)), + ?line Size = Terms*size(Bin), + ?line {Elapsed, {Terms, Size}} = test_server:timecall(?MODULE, sender, + [Recv, Bin, Terms]), + ?line stop_node(Node), + + ?line test_server:timetrap_cancel(Dog), + {comment, integer_to_list(trunc(Size/1024/Elapsed+0.5)) ++ " K/s"}. + +sender(To, _Bin, 0) -> + To ! {done, self()}, + receive + Any -> + Any + end; +sender(To, Bin, Left) -> + To ! {term, Bin}, + sender(To, Bin, Left-1). + +%% Receiver process to be run on a slave node. + +receiver(Terms, Size) -> + receive + {term, Bin} -> + receiver(Terms+1, Size+size(Bin)); + {done, ReplyTo} -> + ReplyTo ! {Terms, Size} + end. + + +local_send(suite) -> + [local_send_small, local_send_big, local_send_legal]; +local_send(doc) -> + ["Tests sending small and big messages to a non-existing ", + "local registered process."]. + +local_send_big(doc) -> + ["Sends several big message to an non-registered process on ", + "the local node."]; +local_send_big(Config) when is_list(Config) -> + Data0=local_send_big(doc)++local_send(doc), + Data1=[Data0,[Data0, Data0, [Data0], Data0],Data0], + Data2=Data0++lists:flatten(Data1)++ + list_to_binary(lists:flatten(Data1)), + Func=fun() -> Data2= {arbitrary_name, node()} ! Data2 end, + ?line test_server:do_times(4096, Func), + ok. + +local_send_small(doc) -> + ["Sends a small message to an non-registered process on the ", + "local node."]; +local_send_small(Config) when is_list(Config) -> + Data={some_stupid, "arbitrary", 'Data'}, + Func=fun() -> Data= {unregistered_name, node()} ! Data end, + ?line test_server:do_times(4096, Func), + ok. + +local_send_legal(doc) -> + ["Sends data to a registered process on the local node, ", + "as if it was on another node."]; +local_send_legal(Config) when is_list(Config) -> + Times=16384, + Data={local_send_legal(doc), local_send_legal(doc)}, + Pid=spawn(?MODULE,receiver2, [0, 0]) , + ?line true=register(registered_process, Pid), + + Func=fun() -> Data={registered_process, node()} ! Data end, + TotalSize=size(Data)*Times, + ?line test_server:do_times(Times, Func), + + % Check that all msgs really came through. + Me=self(), + ?line {done, Me}= + {registered_process, node()} ! {done, Me}, + receive + {Times, TotalSize} -> + ok; + _ -> + test_server:fail("Wrong number of msgs received.") + end, + ok. + +receiver2(Num, TotSize) -> + receive + {done, ReplyTo} -> + ReplyTo ! {Num, TotSize}; + Stuff -> + receiver2(Num+1, TotSize+size(Stuff)) + end. + +link_to_busy(doc) -> "Test that link/1 to a busy distribution port works."; +link_to_busy(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(30)), + ?line {ok, Node} = start_node(link_to_busy), + ?line Recv = spawn(Node, erlang, apply, [fun sink/1, [link_to_busy_sink]]), + + Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, + + %% We will spawn off a process which will try to link to the other + %% node. The linker process will not actually run until this + %% process is suspended due to the busy distribution port (because + %% of the big send). When the link/1 is run, the linker + %% process will block, too, because of the because busy port, + %% and will later be restarted. + + ?line do_busy_test(Node, fun () -> linker(Recv) end), + + %% Same thing, but we apply link/1 instead of calling it directly. + + ?line do_busy_test(Node, fun () -> applied_linker(Recv) end), + + %% Same thing again, but we apply link/1 in the tail of a function. + + ?line do_busy_test(Node, fun () -> tail_applied_linker(Recv) end), + + %% Done. + ?line stop_node(Node), + ?line stop_busy_dist_port_tracer(Tracer), + ?line test_server:timetrap_cancel(Dog), + ok. + +linker(Pid) -> + true = link(Pid), + {links, Links} = process_info(self(), links), + true = lists:member(Pid, Links). + +applied_linker(Pid) -> + true = apply(erlang, link, [Pid]), + {links, Links} = process_info(self(), links), + true = lists:member(Pid, Links). + +tail_applied_linker(Pid) -> + apply(erlang, link, [Pid]). + +exit_to_busy(doc) -> "Test that exit/2 to a busy distribution port works."; +exit_to_busy(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(30)), + ?line {ok, Node} = start_node(exit_to_busy), + + Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, + + %% We will spawn off a process which will try to exit a process on + %% the other node. That process will not actually run until this + %% process is suspended due to the busy distribution port + %% The process executing exit/2 will block, + %% too, because of the busy distribution port, and will be allowed + %% to continue when the port becomes non-busy. + + ?line Recv1 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + ?line M1 = erlang:monitor(process, Recv1), + ?line do_busy_test(Node, fun () -> joey_killer(Recv1) end), + ?line receive + {'DOWN', M1, process, Recv1, R1} -> + ?line joey_said_die = R1 + end, + + %% Same thing, but tail call to exit/2. + ?line Recv2 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + ?line M2 = erlang:monitor(process, Recv2), + ?line do_busy_test(Node, fun () -> tail_joey_killer(Recv2) end), + ?line receive + {'DOWN', M2, process, Recv2, R2} -> + ?line joey_said_die = R2 + end, + + %% Same thing, but we apply exit/2 instead of calling it directly. + ?line Recv3 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + ?line M3 = erlang:monitor(process, Recv3), + ?line do_busy_test(Node, fun () -> applied_joey_killer(Recv3) end), + ?line receive + {'DOWN', M3, process, Recv3, R3} -> + ?line joey_said_die = R3 + end, + + %% Same thing again, but we apply exit/2 in the tail of a function. + ?line Recv4 = spawn(Node, fun () -> sink(exit_to_busy_sink) end), + ?line M4 = erlang:monitor(process, Recv4), + ?line do_busy_test(Node, fun () -> tail_applied_joey_killer(Recv4) end), + ?line receive + {'DOWN', M4, process, Recv4, R4} -> + ?line joey_said_die = R4 + end, + + %% Done. + ?line stop_node(Node), + ?line stop_busy_dist_port_tracer(Tracer), + ?line test_server:timetrap_cancel(Dog), + ok. + +make_busy_data() -> + Size = 1024*1024, + Key = '__busy__port__data__', + case get(Key) of + undefined -> + Data = list_to_binary(lists:duplicate(Size, 253)), + put(Key, Data), + Data; + Data -> + true = is_binary(Data), + true = size(Data) == Size, + Data + end. + +make_busy(Node, Time) when is_integer(Time) -> + Own = 500, + freeze_node(Node, Time+Own), + Data = make_busy_data(), + %% first make port busy + Pid = spawn_link(fun () -> + forever(fun () -> + dport_reg_send(Node, + '__noone__', + Data) + end) + end), + receive after Own -> ok end, + until(fun () -> + case process_info(Pid, status) of + {status, suspended} -> true; + _ -> false + end + end), + %% then dist entry + make_busy(Node, [nosuspend], Data), + Pid. + +make_busy(Node, Opts, Data) -> + case erlang:send({'__noone__', Node}, Data, Opts) of + nosuspend -> nosuspend; + _ -> make_busy(Node, Opts, Data) + end. + +unmake_busy(Pid) -> + unlink(Pid), + exit(Pid, bang). + +do_busy_test(Node, Fun) -> + Busy = make_busy(Node, 1000), + {P, M} = spawn_monitor(Fun), + receive after 100 -> ok end, + Pinfo = process_info(P, [status, current_function]), + unmake_busy(Busy), + ?t:format("~p : ~p~n", [P, Pinfo]), + case Pinfo of + undefined -> + receive + {'DOWN', M, process, P, Reason} -> + ?t:format("~p died with exit reason ~p~n", [P, Reason]) + end, + ?t:fail(premature_death); + _ -> + %% Don't match arity; it is different in debug and + %% optimized emulator + [{status, suspended}, + {current_function, {erlang, bif_return_trap, _}}] = Pinfo, + receive + {'DOWN', M, process, P, Reason} -> + ?t:format("~p died with exit reason ~p~n", [P, Reason]), + normal = Reason + end + end. + +remote_is_process_alive(Pid) -> + rpc:call(node(Pid), erlang, is_process_alive, + [Pid]). + +joey_killer(Pid) -> + exit(Pid, joey_said_die), + until(fun () -> false == remote_is_process_alive(Pid) end). + +tail_joey_killer(Pid) -> + exit(Pid, joey_said_die). + +applied_joey_killer(Pid) -> + apply(erlang, exit, [Pid, joey_said_die]), + until(fun () -> false == remote_is_process_alive(Pid) end). + +tail_applied_joey_killer(Pid) -> + apply(erlang, exit, [Pid, joey_said_die]). + +sink(Name) -> + register(Name, self()), + sink1(). + +sink1() -> + receive + _Any -> sink1() + end. + +lost_exit(doc) -> + "Test that EXIT and DOWN messages send to another node are not lost if " + "if the distribution port is busy."; +lost_exit(Config) when is_list(Config) -> + ?line {ok, Node} = start_node(lost_exit), + + Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, + + Self = self(), + Die = make_ref(), + ?line R1 = spawn(fun () -> receive after infinity -> ok end end), + ?line MR1 = erlang:monitor(process, R1), + + ?line {L1, ML1} = spawn_monitor(fun() -> + link(R1), + Self ! {self(), linked}, + receive + Die -> + exit(controlled_suicide) + end + end), + + ?line R2 = spawn(fun () -> + M = erlang:monitor(process, L1), + receive + {'DOWN', M, process, L1, R} -> + Self ! {self(), got_down_message, L1, R} + end + end), + + ?line receive {L1, linked} -> ok end, + + Busy = make_busy(Node, 2000), + receive after 100 -> ok end, + L1 ! Die, + ?line receive + {'DOWN', ML1, process, L1, RL1} -> + ?line controlled_suicide = RL1 + end, + receive after 500 -> ok end, + unmake_busy(Busy), + + ?line receive + {'DOWN', MR1, process, R1, RR1} -> + ?line controlled_suicide = RR1 + end, + + ?line receive + {R2, got_down_message, L1, RR2} -> + ?line controlled_suicide = RR2 + end, + + %% Done. + ?line stop_busy_dist_port_tracer(Tracer), + ?line stop_node(Node), + ok. + +dummy_waiter() -> + receive + after infinity -> + ok + end. + +link_to_dead(doc) -> + ["Test that linking to a dead remote process gives an EXIT message ", + "AND that the link is teared down."]; +link_to_dead(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line {ok, Node} = start_node(link_to_dead), +% ?line monitor_node(Node, true), + ?line net_adm:ping(Node), %% Ts_cross_server workaround. + ?line Pid = spawn(Node, ?MODULE, dead_process, []), + receive + after 5000 -> ok + end, + ?line link(Pid), + ?line receive + {'EXIT', Pid, noproc} -> + ok; + Other -> + ?line test_server:fail({unexpected_message, Other}) + after 5000 -> + ?line test_server:fail(nothing_received) + end, + ?line {links, Links} = process_info(self(), links), + ?line io:format("Pid=~p, links=~p", [Pid, Links]), + ?line false = lists:member(Pid, Links), + ?line stop_node(Node), + ?line receive + Message -> + ?line test_server:fail({unexpected_message, Message}) + after 3000 -> + ok + end, + ok. + +dead_process() -> + erlang:error(die). + +link_to_dead_new_node(doc) -> + ["Test that linking to a pid on node that has gone and restarted gives ", + "the correct EXIT message (OTP-2304)."]; +link_to_dead_new_node(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + + %% Start the node, get a Pid and stop the node again. + ?line {ok, Node} = start_node(link_to_dead_new_node), + ?line Pid = spawn(Node, ?MODULE, dead_process, []), + ?line stop_node(Node), + + %% Start a new node with the same name. + ?line {ok, Node} = start_node(link_to_dead_new_node), + ?line link(Pid), + ?line receive + {'EXIT', Pid, noproc} -> + ok; + Other -> + ?line test_server:fail({unexpected_message, Other}) + after 5000 -> + ?line test_server:fail(nothing_received) + end, + + %% Make sure that the link wasn't created. + ?line {links, Links} = process_info(self(), links), + ?line io:format("Pid=~p, links=~p", [Pid, Links]), + ?line false = lists:member(Pid, Links), + ?line stop_node(Node), + ?line receive + Message -> + ?line test_server:fail({unexpected_message, Message}) + after 3000 -> + ok + end, + ok. + +applied_monitor_node(doc) -> + "Test that monitor_node/2 works when applied."; +applied_monitor_node(Config) when is_list(Config) -> + ?line NonExisting = list_to_atom("__non_existing__@" ++ hostname()), + + %% Tail-recursive call to apply (since the node is non-existing, + %% there will be a trap). + + ?line true = tail_apply(erlang, monitor_node, [NonExisting, true]), + ?line [{nodedown, NonExisting}] = test_server:messages_get(), + + %% Ordinary call (with trap). + + ?line true = apply(erlang, monitor_node, [NonExisting, true]), + ?line [{nodedown, NonExisting}] = test_server:messages_get(), + + ok. + +tail_apply(M, F, A) -> + apply(M, F, A). + +ref_port_roundtrip(doc) -> + "Test that sending a port or reference to another node and back again " + "doesn't correct them in any way."; +ref_port_roundtrip(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line Port = open_port({spawn, efile}, []), + ?line Ref = make_ref(), + ?line {ok, Node} = start_node(ref_port_roundtrip), + ?line net_adm:ping(Node), + ?line Term = {Port, Ref}, + ?line io:format("Term before: ~p", [show_term(Term)]), + ?line Pid = spawn_link(Node, ?MODULE, roundtrip, [Term]), + ?line receive after 5000 -> ok end, + ?line stop_node(Node), + ?line receive + {'EXIT', Pid, {Port, Ref}} -> + ?line io:format("Term after: ~p", [show_term(Term)]), + ok; + Other -> + ?line io:format("Term after: ~p", [show_term(Term)]), + ?line test_server:fail({unexpected, Other}) + after 10000 -> + ?line test_server:fail(timeout) + end, + ok. + +roundtrip(Term) -> + exit(Term). + +nil_roundtrip(doc) -> + "Test that the smallest external term [] aka NIL can be sent to " + "another node node and back again."; +nil_roundtrip(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line {ok, Node} = start_node(nil_roundtrip), + ?line net_adm:ping(Node), + ?line Pid = spawn_link(Node, ?MODULE, bounce, [self()]), + ?line Pid ! [], + ?line receive + [] -> + ?line receive + {'EXIT', Pid, []} -> + ?line stop_node(Node), + ok + end + end. + +bounce(Dest) -> + receive Msg -> + Dest ! Msg, + exit(Msg) + end. + +show_term(Term) -> + binary_to_list(term_to_binary(Term)). + +stop_dist(doc) -> + ["Tests behaviour after net_kernel:stop (OTP-2586)."]; +stop_dist(Config) when is_list(Config) -> + ?line Str = os:cmd(atom_to_list(lib:progname()) + ++ " -noshell -pa " + ++ ?config(data_dir, Config) + ++ " -s run"), + %% The "true" may be followed by an error report, so ignore anything that + %% follows it. + ?line "true\n"++_ = Str, + + %% "May fail on FreeBSD due to differently configured name lookup - ask Arndt", + %% if you can find him. + + ok. + +trap_bif(doc) -> + ["Verifies that BIFs which are traps to Erlang work (OTP-2680)."]; +trap_bif(suite) -> [trap_bif_1, trap_bif_2, trap_bif_3]. + +trap_bif_1(doc) -> + [""]; +trap_bif_1(Config) when is_list(Config) -> + ?line {true} = tr1(), + ok. + +trap_bif_2(doc) -> + [""]; +trap_bif_2(Config) when is_list(Config) -> + ?line {true} = tr2(), + ok. + +trap_bif_3(doc) -> + [""]; +trap_bif_3(Config) when is_list(Config) -> + ?line {hoo} = tr3(), + ok. + +tr1() -> + ?line NonExisting = 'abc@boromir', + ?line X = erlang:monitor_node(NonExisting, true), + {X}. + +tr2() -> + ?line NonExisting = 'abc@boromir', + ?line X = apply(erlang, monitor_node, [NonExisting, true]), + {X}. + +tr3() -> + ?line NonExisting = 'abc@boromir', + ?line X = {NonExisting, glirp} ! hoo, + {X}. + + + +dist_auto_connect(doc) -> + ["Tests the kernel parameter 'dist_auto_connect'."]; +dist_auto_connect(suite) -> + [dist_auto_connect_never, dist_auto_connect_once]. + +% This has to be done by nodes with differrent cookies, otherwise global +% will connect nodes, which is correct, but makes it hard to test. +% * Start two nodes, n1 and n2. n2 with the dist_auto_connect once parameter +% * n2 pings n1 -> connection +% * check that they now know each other +% * Kill n1 +% * Make sure n2 gets pang when pinging n1 +% * restart n1 +% * Make sure n2 *still gets pang*! +% * Ping n2 from n1 -> pong +% * n2 now also gets pong when pinging n1 +% * disconnect n2 from n1 +% * n2 gets pang when pinging n1 +% * n2 forces connection by using net_kernel:connect_node (ovverrides) +% * n2 gets pong when pinging n1. +dist_auto_connect_once(doc) -> "Test the dist_auto_connect once kernel parameter"; +dist_auto_connect_once(Config) when is_list(Config) -> + ?line Sock = start_relay_node(dist_auto_connect_relay_node,[]), + ?line NN = inet_rpc_nodename(Sock), + ?line Sock2 = start_relay_node(dist_auto_connect_once_node, + "-kernel dist_auto_connect once"), + ?line NN2 = inet_rpc_nodename(Sock2), + ?line {ok,[]} = do_inet_rpc(Sock,erlang,nodes,[]), + ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + ?line {ok,[NN2]} = do_inet_rpc(Sock,erlang,nodes,[]), + ?line {ok,[NN]} = do_inet_rpc(Sock2,erlang,nodes,[]), + ?line [_,HostPartPeer] = string:tokens(atom_to_list(NN),"@"), + ?line [_,MyHostPart] = string:tokens(atom_to_list(node()),"@"), + % Give net_kernel a chance to change the state of the node to up to. + ?line receive after 1000 -> ok end, + case HostPartPeer of + MyHostPart -> + ?line ok = stop_relay_node(Sock), + ?line {ok,pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]); + _ -> + ?line {ok, true} = do_inet_rpc(Sock,net_kernel,disconnect,[NN2]), + receive + after 500 -> ok + end + end, + ?line {ok, []} = do_inet_rpc(Sock2,erlang,nodes,[]), + Sock3 = case HostPartPeer of + MyHostPart -> + ?line start_relay_node(dist_auto_connect_relay_node,[]); + _ -> + Sock + end, + ?line TS1 = timestamp(), + ?line {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + ?line TS2 = timestamp(), + RefT = net_kernel:connecttime() - 1000, + ?line true = ((TS2 - TS1) < RefT), + ?line TS3 = timestamp(), + ?line {ok, true} = do_inet_rpc(Sock2,erlang,monitor_node, + [NN,true,[allow_passive_connect]]), + ?line TS4 = timestamp(), + ?line true = ((TS4 - TS3) > RefT), + ?line {ok, pong} = do_inet_rpc(Sock3,net_adm,ping,[NN2]), + ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + ?line {ok, true} = do_inet_rpc(Sock3,net_kernel,disconnect,[NN2]), + receive + after 500 -> ok + end, + ?line {ok, pang} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + ?line {ok, true} = do_inet_rpc(Sock2,net_kernel,connect_node,[NN]), + ?line {ok, pong} = do_inet_rpc(Sock2,net_adm,ping,[NN]), + ?line stop_relay_node(Sock3), + ?line stop_relay_node(Sock2). + + + +%% Start a relay node and a lonely (dist_auto_connect never) node. +%% Lonely node pings relay node. That should fail. +%% Lonely node connects to relay node with net_kernel:connect_node/1. +%% Result is sent here through relay node. +dist_auto_connect_never(Config) when is_list(Config) -> + Self = self(), + ?line {ok, RelayNode} = + start_node(dist_auto_connect_relay), + ?line spawn(RelayNode, + fun() -> + register(dist_auto_connect_relay, self()), + dist_auto_connect_relay(Self) + end), + ?line {ok, Handle} = dist_auto_connect_start(dist_auto_connect, never), + ?line Result = + receive + {do_dist_auto_connect, ok} -> + ok; + {do_dist_auto_connect, Error} -> + {error, Error}; + Other -> + {error, Other} + after 32000 -> + timeout + end, + ?line stop_node(RelayNode), + ?line Stopped = dist_auto_connect_stop(Handle), + ?line Junk = + receive + {do_dist_auto_connect, _} = J -> + J + after 0 -> + ok + end, + ?line {ok, ok, ok} = {Result, Stopped, Junk}, + ok. + + +do_dist_auto_connect([never]) -> + Node = list_to_atom("dist_auto_connect_relay@" ++ hostname()), + io:format("~p:do_dist_auto_connect([false]) Node=~p~n", + [?MODULE, Node]), + Ping = net_adm:ping(Node), + io:format("~p:do_dist_auto_connect([false]) Ping=~p~n", + [?MODULE, Ping]), + Result = case Ping of + pang -> ok; + _ -> {error, Ping} + end, + io:format("~p:do_dist_auto_connect([false]) Result=~p~n", + [?MODULE, Result]), + net_kernel:connect_node(Node), + catch {dist_auto_connect_relay, Node} ! {do_dist_auto_connect, Result}; +% receive after 1000 -> ok end, +% halt(); + +do_dist_auto_connect(Arg) -> + io:format("~p:do_dist_auto_connect(~p)~n", + [?MODULE, Arg]), + receive after 10000 -> ok end, + halt(). + + +dist_auto_connect_start(Name, Value) when is_atom(Name) -> + dist_auto_connect_start(atom_to_list(Name), Value); +dist_auto_connect_start(Name, Value) when is_list(Name), is_atom(Value) -> + Node = list_to_atom(lists:append([Name, "@", hostname()])), + ModuleDir = filename:dirname(code:which(?MODULE)), + ValueStr = atom_to_list(Value), + Cookie = atom_to_list(erlang:get_cookie()), + Cmd = lists:concat( + [%"xterm -e ", + atom_to_list(lib:progname()), +% " -noinput ", + " -detached ", + long_or_short(), " ", Name, + " -setcookie ", Cookie, + " -pa ", ModuleDir, + " -s ", atom_to_list(?MODULE), + " do_dist_auto_connect ", ValueStr, + " -kernel dist_auto_connect ", ValueStr]), + io:format("~p:dist_auto_connect_start() cmd: ~p~n", [?MODULE, Cmd]), + Port = open_port({spawn, Cmd}, [stream]), + {ok, {Port, Node}}. + + +dist_auto_connect_stop({Port, Node}) -> + Pid = spawn_link(fun() -> rpc:call(Node, erlang, halt, []) end), + dist_auto_connect_stop(Port, Node, Pid, 5000). + +dist_auto_connect_stop(Port, _Node, Pid, N) when is_integer(N), N =< 0 -> + exit(Pid, normal), + catch erlang:port_close(Port), + Result = {error, node_not_down}, + io:format("~p:dist_auto_connect_stop() ~p~n", [?MODULE, Result]), + Result; +dist_auto_connect_stop(Port, Node, Pid, N) when is_integer(N) -> + case net_adm:ping(Node) of + pong -> + receive after 100 -> ok end, + dist_auto_connect_stop(Port, Node, Pid, N-100); + pang -> + exit(Pid, normal), + catch erlang:port_close(Port), + io:format("~p:dist_auto_connect_stop() ok~n", [?MODULE]), + ok + end. + + +dist_auto_connect_relay(Parent) -> + receive X -> + catch Parent ! X + end, + dist_auto_connect_relay(Parent). + + +dist_parallel_send(doc) -> + []; +dist_parallel_send(suite) -> + []; +dist_parallel_send(Config) when is_list(Config) -> + ?line {ok, RNode} = start_node(dist_parallel_receiver), + ?line {ok, SNode} = start_node(dist_parallel_sender), + ?line WatchDog = spawn_link( + fun () -> + TRef = erlang:start_timer((?DEFAULT_TIMETRAP + div 2), + self(), + oops), + receive + {timeout, TRef, _ } -> + spawn(SNode, + fun () -> + abort(timeout) + end), + spawn(RNode, + fun () -> + abort(timeout) + end) +%% rpc:cast(SNode, erlang, halt, +%% ["Timetrap (sender)"]), +%% rpc:cast(RNode, erlang, halt, +%% ["Timetrap (receiver)"]) + end + end), + ?line MkSndrs = fun (Receiver) -> + lists:map(fun (_) -> + spawn_link(SNode, + ?MODULE, + dist_parallel_sender, + [self(), + Receiver, + 1000]) + end, + lists:seq(1, 64)) + end, + ?line SndrsStart = fun (Sndrs) -> + Parent = self(), + spawn_link( + SNode, + fun () -> + lists:foreach(fun (P) -> + P ! {go, Parent} + end, + Sndrs) + end) + end, + ?line SndrsWait = fun (Sndrs) -> + lists:foreach(fun (P) -> + receive {P, done} -> ok end + end, + Sndrs) + end, + ?line DPR = spawn_link(RNode, ?MODULE, dist_parallel_receiver, []), + ?line Sndrs1 = MkSndrs(DPR), + ?line SndrsStart(Sndrs1), + ?line SndrsWait(Sndrs1), + ?line unlink(DPR), + ?line exit(DPR, bang), + + ?line DEPR = spawn_link(RNode, ?MODULE, dist_evil_parallel_receiver, []), + ?line Sndrs2 = MkSndrs(DEPR), + ?line SndrsStart(Sndrs2), + ?line SndrsWait(Sndrs2), + ?line unlink(DEPR), + ?line exit(DEPR, bang), + + ?line unlink(WatchDog), + ?line exit(WatchDog, bang), + + ?line stop_node(RNode), + ?line stop_node(SNode), + + ?line ok. + +do_dist_parallel_sender(Parent, _Receiver, 0) -> + Parent ! {self(), done}; +do_dist_parallel_sender(Parent, Receiver, N) -> + Receiver ! {self(), "Some data"}, + do_dist_parallel_sender(Parent, Receiver, N-1). + +dist_parallel_sender(Parent, Receiver, N) -> + receive {go, Parent} -> ok end, + do_dist_parallel_sender(Parent, Receiver, N). + +dist_parallel_receiver() -> + receive {_Sender, _Data} -> ok end, + dist_parallel_receiver(). + +dist_evil_parallel_receiver() -> + receive {Sender, _Data} -> ok end, + net_kernel:disconnect(node(Sender)), + dist_evil_parallel_receiver(). + +atom_roundtrip(Config) when is_list(Config) -> + ?line AtomData = atom_data(), + ?line verify_atom_data(AtomData), + ?line {ok, Node} = start_node(Config), + ?line do_atom_roundtrip(Node, AtomData), + ?line stop_node(Node), + ?line ok. + +atom_roundtrip_r12b(Config) when is_list(Config) -> + case ?t:is_release_available("r12b") of + true -> + ?line AtomData = atom_data(), + ?line verify_atom_data(AtomData), + ?line {ok, Node} = start_node(Config, [], "r12b"), + ?line do_atom_roundtrip(Node, AtomData), + ?line stop_node(Node), + ?line ok; + false -> + ?line {skip,"No OTP R12B available"} + end. + +do_atom_roundtrip(Node, AtomData) -> + ?line Parent = self(), + ?line Proc = spawn_link(Node, fun () -> verify_atom_data_loop(Parent) end), + ?line Proc ! {self(), AtomData}, + ?line receive {Proc, AD1} -> AtomData = AD1 end, + ?line Proc ! {self(), AtomData}, + ?line receive {Proc, AD2} -> AtomData = AD2 end, + ?line RevAtomData = lists:reverse(AtomData), + ?line Proc ! {self(), RevAtomData}, + ?line receive {Proc, RAD1} -> RevAtomData = RAD1 end, + ?line unlink(Proc), + ?line exit(Proc, bang), + ?line ok. + +verify_atom_data_loop(From) -> + receive + {From, AtomData} -> + verify_atom_data(AtomData), + From ! {self(), AtomData}, + verify_atom_data_loop(From) + end. + +atom_data() -> + lists:map(fun (N) -> + ATxt = "a"++integer_to_list(N), + {list_to_atom(ATxt), ATxt} + end, + lists:seq(1, 2000)). + +verify_atom_data(AtomData) -> + lists:foreach(fun ({Atom, AtomTxt}) -> + AtomTxt = atom_to_list(Atom) + end, + AtomData). + +contended_atom_cache_entry(Config) when is_list(Config) -> + ?line TestServer = self(), + ?line ProcessPairs = 10, + ?line Msgs = 100000, + ?line {ok, SNode} = start_node(Config), + ?line {ok, RNode} = start_node(Config), + ?line Success = make_ref(), + ?line Mstr + = spawn_link( + SNode, + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + Master = self(), + CIX = get_cix(), + TestAtoms = get_conflicting_atoms(CIX, ProcessPairs), + io:format("Testing with the following atoms all using " + "cache index ~p:~n ~p~n", + [CIX, TestAtoms]), + Ps = lists:map( + fun (A) -> + Ref = make_ref(), + R = spawn_link( + RNode, + fun () -> + Atom = receive + {Ref, txt, ATxt} -> + list_to_atom( + ATxt) + end, + receive_ref_atom(Ref, + Atom, + Msgs), + Master ! {self(), success} + end), + S = spawn_link( + SNode, + fun () -> + receive go -> ok end, + R ! {Ref, + txt, + atom_to_list(A)}, + send_ref_atom(R, Ref, A, Msgs) + end), + {S, R} + end, + TestAtoms), + lists:foreach(fun ({S, _}) -> + S ! go + end, + Ps), + lists:foreach(fun ({_, R}) -> + receive {R, success} -> ok end + end, + Ps), + TestServer ! Success + end), + ?line receive + Success -> + ok + end, + ?line stop_node(SNode), + ?line stop_node(RNode), + ?line ok. + +send_ref_atom(To, Ref, Atom, 0) -> + ok; +send_ref_atom(To, Ref, Atom, N) -> + To ! {Ref, Atom}, + send_ref_atom(To, Ref, Atom, N-1). + +receive_ref_atom(Ref, Atom, 0) -> + ok; +receive_ref_atom(Ref, Atom, N) -> + receive + {Ref, Value} -> + Atom = Value + end, + receive_ref_atom(Ref, Atom, N-1). + +get_cix() -> + get_cix(1000). + +get_cix(CIX) when is_integer(CIX), CIX < 0 -> + get_cix(0); +get_cix(CIX) when is_integer(CIX) -> + get_cix(CIX, + unwanted_cixs(), + erts_debug:get_internal_state(max_atom_out_cache_index)). + +get_cix(CIX, Unwanted, MaxCIX) when CIX > MaxCIX -> + get_cix(0, Unwanted, MaxCIX); +get_cix(CIX, Unwanted, MaxCIX) -> + case lists:member(CIX, Unwanted) of + true -> get_cix(CIX+1, Unwanted, MaxCIX); + false -> CIX + end. + +unwanted_cixs() -> + lists:map(fun (Node) -> + erts_debug:get_internal_state({atom_out_cache_index, + Node}) + end, + nodes()). + + +get_conflicting_atoms(CIX, 0) -> + []; +get_conflicting_atoms(CIX, N) -> + {A, B, C} = now(), + Atom = list_to_atom("atom" ++ integer_to_list(A*1000000000000 + + B*1000000 + + C)), + case erts_debug:get_internal_state({atom_out_cache_index, Atom}) of + CIX -> + [Atom|get_conflicting_atoms(CIX, N-1)]; + _ -> + get_conflicting_atoms(CIX, N) + end. + + +bad_dist_ext(doc) -> []; +bad_dist_ext(suite) -> + [bad_dist_ext_receive, + bad_dist_ext_process_info, + bad_dist_ext_control, + bad_dist_ext_connection_id]. + + +bad_dist_ext_receive(Config) when is_list(Config) -> + ?line {ok, Offender} = start_node(bad_dist_ext_receive_offender), + ?line {ok, Victim} = start_node(bad_dist_ext_receive_victim), + ?line start_node_monitors([Offender,Victim]), + + ?line Parent = self(), + + ?line P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([one, + two, + three]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + ?line receive {P, started} -> ok end, + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line verify_up(Offender, Victim), + ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + ?line P ! one, + ?line send_bad_msg(Offender, P), + ?line P ! two, + ?line verify_down(Offender, connection_closed, Victim, killed), + ?line {message_queue_len, 2} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line Suspended = make_ref(), + ?line S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + ?line MS = erlang:monitor(process, S), + ?line receive Suspended -> ok end, + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line verify_up(Offender, Victim), + ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + ?line send_bad_msgs(Offender, P, 5), + ?line true = lists:member(Offender, rpc:call(Victim, erlang, nodes, [])), + ?line P ! three, + ?line send_bad_msgs(Offender, P, 5), + + %% Make sure bad msgs has reached Victim + ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + ?line verify_still_up(Offender, Victim), + ?line {message_queue_len, 13} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line exit(S, bang), + ?line receive {'DOWN', MS, process, S, bang} -> ok end, + ?line verify_down(Offender, connection_closed, Victim, killed), + ?line {message_queue_len, 3} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line P ! check_msgs, + ?line receive {P, messages_checked} -> ok end, + + ?line {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line P ! done, + ?line unlink(P), + ?line verify_no_down(Offender, Victim), + ?line stop_node(Offender), + ?line stop_node(Victim). + + +bad_dist_ext_process_info(Config) when is_list(Config) -> + ?line {ok, Offender} = start_node(bad_dist_ext_process_info_offender), + ?line {ok, Victim} = start_node(bad_dist_ext_process_info_victim), + ?line start_node_monitors([Offender,Victim]), + + ?line Parent = self(), + ?line P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([one, two]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + ?line receive {P, started} -> ok end, + ?line P ! one, + + ?line Suspended = make_ref(), + ?line S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + + ?line receive Suspended -> ok end, + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line verify_up(Offender, Victim), + ?line send_bad_msgs(Offender, P, 5), + + ?line P ! two, + ?line send_bad_msgs(Offender, P, 5), + + %% Make sure bad msgs has reached Victim + ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + ?line verify_still_up(Offender, Victim), + ?line {message_queue_len, 12} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + ?line verify_still_up(Offender, Victim), + ?line [{message_queue_len, 2}, + {messages, [one, two]}] + = rpc:call(Victim, erlang, process_info, [P, [message_queue_len, + messages]]), + ?line verify_down(Offender, connection_closed, Victim, killed), + + ?line P ! check_msgs, + ?line exit(S, bang), + ?line receive {P, messages_checked} -> ok end, + + ?line {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line P ! done, + ?line unlink(P), + ?line verify_no_down(Offender, Victim), + ?line stop_node(Offender), + ?line stop_node(Victim). + +bad_dist_ext_control(Config) when is_list(Config) -> + ?line {ok, Offender} = start_node(bad_dist_ext_control_offender), + ?line {ok, Victim} = start_node(bad_dist_ext_control_victim), + ?line start_node_monitors([Offender,Victim]), + + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line verify_up(Offender, Victim), + ?line send_bad_dhdr(Offender, Victim), + ?line verify_down(Offender, connection_closed, Victim, killed), + + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line verify_up(Offender, Victim), + ?line send_bad_ctl(Offender, Victim), + ?line verify_down(Offender, connection_closed, Victim, killed), + + ?line verify_no_down(Offender, Victim), + ?line stop_node(Offender), + ?line stop_node(Victim). + +bad_dist_ext_connection_id(Config) when is_list(Config) -> + ?line {ok, Offender} = start_node(bad_dist_ext_receive_offender), + ?line {ok, Victim} = start_node(bad_dist_ext_receive_victim), + ?line start_node_monitors([Offender,Victim]), + + ?line Parent = self(), + ?line P = spawn_link(Victim, + fun () -> + Parent ! {self(), started}, + receive check_msgs -> ok end, + bad_dist_ext_check_msgs([]), + Parent ! {self(), messages_checked}, + receive done -> ok end + end), + + ?line receive {P, started} -> ok end, + ?line Suspended = make_ref(), + ?line S = spawn(Victim, + fun () -> + erlang:suspend_process(P), + Parent ! Suspended, + receive after infinity -> ok end + end), + ?line MS = erlang:monitor(process, S), + ?line receive Suspended -> ok end, + ?line pong = rpc:call(Victim, net_adm, ping, [Offender]), + ?line verify_up(Offender, Victim), + ?line send_bad_msg(Offender, P), + + %% Make sure bad msg has reached Victim + ?line rpc:call(Offender, rpc, call, [Victim, erlang, node, []]), + + ?line {message_queue_len, 1} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line true = rpc:call(Offender, net_kernel, disconnect, [Victim]), + ?line verify_down(Offender, disconnect, Victim, connection_closed), + ?line pong = rpc:call(Offender, net_adm, ping, [Victim]), + + ?line verify_up(Offender, Victim), + %% We have a new connection between Offender and Victim, bad message + %% should not bring it down. + + ?line {message_queue_len, 1} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line exit(S, bang), + ?line receive {'DOWN', MS, process, S, bang} -> ok end, + %% Wait for a while (if the connection is taken down it might take a + %% while). + ?line receive after 2000 -> ok end, + ?line verify_still_up(Offender, Victim), + + ?line P ! check_msgs, + ?line receive {P, messages_checked} -> ok end, + + ?line {message_queue_len, 0} + = rpc:call(Victim, erlang, process_info, [P, message_queue_len]), + + ?line verify_still_up(Offender, Victim), + ?line P ! done, + ?line unlink(P), + ?line verify_no_down(Offender, Victim), + ?line stop_node(Offender), + ?line stop_node(Victim). + + +bad_dist_ext_check_msgs([]) -> + receive + Msg -> + exit({unexpected_message, Msg}) + after 0 -> + ok + end; +bad_dist_ext_check_msgs([M|Ms]) -> + receive + Msg -> + M = Msg, + bad_dist_ext_check_msgs(Ms) + end. + +-define(COOKIE, ''). +-define(DOP_LINK, 1). +-define(DOP_SEND, 2). +-define(DOP_EXIT, 3). +-define(DOP_UNLINK, 4). +-define(DOP_NODE_LINK, 5). +-define(DOP_REG_SEND, 6). +-define(DOP_GROUP_LEADER, 7). +-define(DOP_EXIT2, 8). + +-define(DOP_SEND_TT, 12). +-define(DOP_EXIT_TT, 13). +-define(DOP_REG_SEND_TT, 16). +-define(DOP_EXIT2_TT, 18). + +-define(DOP_MONITOR_P, 19). +-define(DOP_DEMONITOR_P, 20). +-define(DOP_MONITOR_P_EXIT, 21). + +dport_reg_send(Node, Name, Msg) -> + DPrt = case dport(Node) of + undefined -> + pong = net_adm:ping(Node), + dport(Node); + Prt -> + Prt + end, + port_command(DPrt, [dmsg_hdr(), + dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + Name}), + dmsg_ext(Msg)]). + + +dport_send(To, Msg) -> + Node = node(To), + DPrt = case dport(Node) of + undefined -> + pong = net_adm:ping(Node), + dport(Node); + Prt -> + Prt + end, + port_command(DPrt, [dmsg_hdr(), + dmsg_ext({?DOP_SEND, + ?COOKIE, + To}), + dmsg_ext(Msg)]). + +%% send_bad_msgs(): +%% Send a valid distribution header and control message +%% but an invalid message. This invalid message will be +%% enqueued in the receivers message queue. +send_bad_msg(BadNode, To) -> + send_bad_msgs(BadNode, To, 1). + +send_bad_msgs(BadNode, To, Repeat) when is_atom(BadNode), + is_pid(To), + is_integer(Repeat) -> + Parent = self(), + Done = make_ref(), + spawn_link(BadNode, + fun () -> + Node = node(To), + pong = net_adm:ping(Node), + DPrt = dport(Node), + DData = [dmsg_hdr(), + dmsg_ext({?DOP_SEND, ?COOKIE, To}), + dmsg_bad_atom_cache_ref()], + repeat(fun () -> port_command(DPrt, DData) end, Repeat), + Parent ! Done + end), + receive Done -> ok end. + +%% send_bad_ctl(): +%% Send a valid distribution header but an invalid control message. +send_bad_ctl(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> + Parent = self(), + Done = make_ref(), + spawn_link(BadNode, + fun () -> + pong = net_adm:ping(ToNode), + %% We creat a valid ctl msg and replace an + %% atom with an invalid atom cache reference + <<131,Replace/binary>> = term_to_binary(replace), + Ctl = dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + replace}), + CtlBeginSize = size(Ctl) - size(Replace), + <> = Ctl, + port_command(dport(ToNode), + [dmsg_fake_hdr2(), + CtlBegin, + dmsg_bad_atom_cache_ref(), + dmsg_ext({a, message})]), + Parent ! Done + end), + receive Done -> ok end. + +%% send_bad_dhr(): +%% Send an invalid distribution header +send_bad_dhdr(BadNode, ToNode) when is_atom(BadNode), is_atom(ToNode) -> + Parent = self(), + Done = make_ref(), + spawn_link(BadNode, + fun () -> + pong = net_adm:ping(ToNode), + port_command(dport(ToNode), dmsg_bad_hdr()), + Parent ! Done + end), + receive Done -> ok end. + +dport(Node) when is_atom(Node) -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + erts_debug:get_internal_state({dist_port, Node}). + +dmsg_hdr() -> + [131, % Version Magic + $D, % Dist header + 0]. % No atom cache referenses + +dmsg_bad_hdr() -> + [131, % Version Magic + $D, % Dist header + 255]. % 255 atom references + + +dmsg_fake_hdr1() -> + A = <<"fake header atom 1">>, + [131, % Version Magic + $D, 1, 16#8, 0, size(A), A]. % Fake header + +dmsg_fake_hdr2() -> + A1 = <<"fake header atom 1">>, + A2 = <<"atom 2">>, + A3 = <<"atom 3">>, + [131, % Version Magic + $D, + 3, + 16#88, 16#08, % Flags + 0, size(A1), A1, + 1, size(A2), A2, + 2, size(A3), A3]. + +dmsg_ext(Term) -> + <<131, Res/binary>> = term_to_binary(Term), + Res. + +dmsg_bad_atom_cache_ref() -> + [$R, 137]. + +%%% Utilities + +timestamp() -> + {A,B,C} = erlang:now(), + (C div 1000) + (B * 1000) + (A * 1000000000). + +start_node(X) -> + start_node(X, [], []). + +start_node(X, Y) -> + start_node(X, Y, []). + +start_node(Name, Args, Rel) when is_atom(Name), is_list(Rel) -> + Pa = filename:dirname(code:which(?MODULE)), + Cookie = atom_to_list(erlang:get_cookie()), + RelArg = case Rel of + [] -> []; + _ -> [{erl,[{release,Rel}]}] + end, + test_server:start_node(Name, slave, + [{args, + Args++" -setcookie "++Cookie++" -pa "++Pa} + | RelArg]); +start_node(Config, Args, Rel) when is_list(Config), is_list(Rel) -> + Name = list_to_atom((atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(timestamp()))), + start_node(Name, Args, Rel). + +stop_node(Node) -> + test_server:stop_node(Node). + +freeze_node(Node, MS) -> + Own = 300, + DoingIt = make_ref(), + Freezer = self(), + spawn_link(Node, + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + dport_send(Freezer, DoingIt), + receive after Own -> ok end, + erts_debug:set_internal_state(block, MS+Own) + end), + receive DoingIt -> ok end, + receive after Own -> ok end. + +inet_rpc_nodename({N,H,_Sock}) -> + list_to_atom(N++"@"++H). + +do_inet_rpc({_,_,Sock},M,F,A) -> + Bin = term_to_binary({M,F,A}), + gen_tcp:send(Sock,Bin), + case gen_tcp:recv(Sock,0) of + {ok, Bin2} -> + T = binary_to_term(Bin2), + {ok,T}; + Else -> + {error, Else} + end. + +inet_rpc_server([Host, PortList]) -> + Port = list_to_integer(PortList), + {ok, Sock} = gen_tcp:connect(Host, Port,[binary, {packet, 4}, + {active, false}]), + inet_rpc_server_loop(Sock). + +inet_rpc_server_loop(Sock) -> + case gen_tcp:recv(Sock,0) of + {ok, Bin} -> + {M,F,A} = binary_to_term(Bin), + Res = (catch apply(M,F,A)), + RB = term_to_binary(Res), + gen_tcp:send(Sock,RB), + inet_rpc_server_loop(Sock); + _ -> + erlang:halt() + end. + + +start_relay_node(Node, Args) -> + Pa = filename:dirname(code:which(?MODULE)), + Cookie = "NOT"++atom_to_list(erlang:get_cookie()), + {ok, LSock} = gen_tcp:listen(0, [binary, {packet, 4}, + {active, false}]), + {ok, Port} = inet:port(LSock), + {ok, Host} = inet:gethostname(), + RunArg = "-run " ++ atom_to_list(?MODULE) ++ " inet_rpc_server " ++ + Host ++ " " ++ integer_to_list(Port), + {ok, NN} = + test_server:start_node(Node, peer, + [{args, Args ++ + " -setcookie "++Cookie++" -pa "++Pa++" "++ + RunArg}]), + [N,H] = string:tokens(atom_to_list(NN),"@"), + {ok, Sock} = gen_tcp:accept(LSock), + pang = net_adm:ping(NN), + {N,H,Sock}. + +stop_relay_node({N,H,Sock}) -> + catch do_inet_rpc(Sock,erlang,halt,[]), + catch gen_tcp:close(Sock), + wait_dead(N,H,10). + +wait_dead(N,H,0) -> + {error,{not_dead,N,H}}; +wait_dead(N,H,X) -> + case erl_epmd:port_please(N,H) of + {port,_,_} -> + receive + after 1000 -> + ok + end, + wait_dead(N,H,X-1); + noport -> + ok; + Else -> + {error, {unexpected, Else}} + end. + + +start_node_monitors(Nodes) -> + Master = self(), + lists:foreach(fun (Node) -> + spawn(Node, + fun () -> + node_monitor(Master) + end) + end, + Nodes), + ok. + +node_monitor(Master) -> + Opts = [nodedown_reason,{node_type,all}], + Nodes0 = nodes(connected), + net_kernel:monitor_nodes(true, Opts), + Nodes1 = nodes(connected), + case lists:sort(Nodes0) == lists:sort(Nodes1) of + true -> + lists:foreach(fun (Node) -> + Master ! {nodeup, node(), Node} + end, + Nodes0), + ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Nodes0]), + node_monitor_loop(Master); + false -> + net_kernel:monitor_nodes(false, Opts), + flush_node_changes(), + node_monitor(Master) + end. + +flush_node_changes() -> + receive + {NodeChange, _Node, _InfoList} when NodeChange == nodeup; + NodeChange == nodedown -> + flush_node_changes() + after 0 -> + ok + end. + +node_monitor_loop(Master) -> + receive + {nodeup, Node, InfoList} = Msg -> + Master ! {nodeup, node(), Node}, + ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]), + node_monitor_loop(Master); + {nodedown, Node, InfoList} = Msg -> + Reason = case lists:keysearch(nodedown_reason, 1, InfoList) of + {value, {nodedown_reason, R}} -> R; + _ -> undefined + end, + Master ! {nodedown, node(), Node, Reason}, + ?t:format("~p ~p: ~p~n", [node(), erlang:now(), Msg]), + node_monitor_loop(Master) + end. + +verify_up(A, B) -> + receive {nodeup, A, B} -> ok end, + receive {nodeup, B, A} -> ok end. + +verify_still_up(A, B) -> + true = lists:member(B, rpc:call(A, erlang, nodes, [connected])), + true = lists:member(A, rpc:call(B, erlang, nodes, [connected])), + verify_no_down(A, B). + +verify_no_down(A, B) -> + receive + {nodedown, A, B, _} = Msg0 -> + ?t:fail(Msg0) + after 0 -> + ok + end, + receive + {nodedown, B, A, _} = Msg1 -> + ?t:fail(Msg1) + after 0 -> + ok + end. + +verify_down(A, B) -> + receive {nodedown, A, B, _} -> ok end, + receive {nodedown, B, A, _} -> ok end. + +verify_down(A, ReasonA, B, ReasonB) -> + receive + {nodedown, A, B, _} = Msg0 -> + {nodedown, A, B, ReasonA} = Msg0 + end, + receive + {nodedown, B, A, _} = Msg1 -> + {nodedown, B, A, ReasonB} = Msg1 + end, + ok. + +hostname() -> + from($@, atom_to_list(node())). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_, []) -> []. + +fun_spawn(Fun) -> + fun_spawn(Fun, []). + +fun_spawn(Fun, Args) -> + spawn_link(erlang, apply, [Fun, Args]). + + +long_or_short() -> + case net_kernel:longnames() of + true -> " -name "; + false -> " -sname " + end. + +until(Fun) -> + case Fun() of + true -> + ok; + false -> + receive after 10 -> ok end, + until(Fun) + end. + +forever(Fun) -> + Fun(), + forever(Fun). + +abort(Why) -> + erts_debug:set_internal_state(available_internal_state, true), + erts_debug:set_internal_state(abort, Why). + + +start_busy_dist_port_tracer() -> + Tracer = spawn_link(fun () -> busy_dist_port_tracer() end), + erlang:system_monitor(Tracer, [busy_dist_port]), + Tracer. + +stop_busy_dist_port_tracer(Tracer) when is_pid(Tracer) -> + unlink(Tracer), + exit(Tracer, bye); +stop_busy_dist_port_tracer(_) -> + true. + +busy_dist_port_tracer() -> + receive + {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> + erlang:display(M), + busy_dist_port_tracer() + end. + +repeat(_Fun, 0) -> + ok; +repeat(Fun, N) -> + Fun(), + repeat(Fun, N-1). diff --git a/erts/emulator/test/distribution_SUITE_data/Makefile.src b/erts/emulator/test/distribution_SUITE_data/Makefile.src new file mode 100644 index 0000000000..0eebe48e74 --- /dev/null +++ b/erts/emulator/test/distribution_SUITE_data/Makefile.src @@ -0,0 +1,4 @@ +all: run + +run: + @erl_name@ -compile run diff --git a/erts/emulator/test/distribution_SUITE_data/run.erl b/erts/emulator/test/distribution_SUITE_data/run.erl new file mode 100644 index 0000000000..e2137a1ec5 --- /dev/null +++ b/erts/emulator/test/distribution_SUITE_data/run.erl @@ -0,0 +1,48 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(run). + +-compile(export_all). + +host() -> + from($@, atom_to_list(node())). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(H, []) -> []. + +start() -> + net_kernel:start([fideridum,shortnames]), + {ok, Node} = slave:start(host(), heppel), + P = spawn(Node, a, b, []), + B1 = term_to_binary(P), + N1 = node(P), + ok = net_kernel:stop(), + N2 = node(P), + io:format("~w~n", [N1 == N2]), + if + N1 == N2 -> + init:stop(); + true -> + %% Make sure that the io:format/2 output is really written + %% (especially on Windows). + erlang:yield(), + init:stop() + end. diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl new file mode 100644 index 0000000000..39b2ed395f --- /dev/null +++ b/erts/emulator/test/driver_SUITE.erl @@ -0,0 +1,1993 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +%%% Purpose : Test interaction Erlang/Drivers (new features as of R3A) + +%%% Checks that new features (as of R3) of the Erlang/Driver +%%% implementation works as expected. +%%% +%%% Things that should be tested: +%%% - outputv +%%% - timeouts +%%% - queueing + +-module(driver_SUITE). +-export([all/1, + init_per_testcase/2, + fin_per_testcase/2, + end_per_suite/1, + outputv_echo/1, + timer/1, + timer_measure/1, + timer_cancel/1, + timer_change/1, + timer_delay/1, + queue_echo/1, + fun_to_port/1, + driver_unloaded/1, + io_ready_exit/1, + use_fallback_pollset/1, + bad_fd_in_pollset/1, + driver_event/1, + fd_change/1, + steal_control/1, + otp_6602/1, + 'driver_system_info_ver1.0'/1, + 'driver_system_info_ver1.1'/1, + driver_system_info_current_ver/1, + driver_monitor/1, + ioq_exit/1, + ioq_exit_ready_input/1, + ioq_exit_ready_output/1, + ioq_exit_timeout/1, + ioq_exit_ready_async/1, + ioq_exit_event/1, + ioq_exit_ready_input_async/1, + ioq_exit_ready_output_async/1, + ioq_exit_timeout_async/1, + ioq_exit_event_async/1, + zero_extended_marker_garb_drv/1, + invalid_extended_marker_drv/1, + larger_major_vsn_drv/1, + larger_minor_vsn_drv/1, + smaller_major_vsn_drv/1, + smaller_minor_vsn_drv/1, + peek_non_existing_queue/1, + otp_6879/1, + caller/1, + many_events/1, + missing_callbacks/1, + smp_select/1, + driver_select_use/1, + thread_mseg_alloc_cache_clean/1]). + +-export([bin_prefix/2]). + +-include("test_server.hrl"). + + +% First byte in communication with the timer driver +-define(START_TIMER, 0). +-define(CANCEL_TIMER, 1). +-define(DELAY_START_TIMER, 2). +-define(TIMER, 3). +-define(CANCELLED, 4). + +% First byte in communication with queue driver +-define(PUSHQ, 0). +-define(ENQ, 1). +-define(PUSHQ_BIN, 2). +-define(ENQ_BIN, 3). +-define(PUSHQV, 4). +-define(ENQV, 5). + +-define(DEQ, 6). +-define(BYTES_QUEUED, 7). +-define(READ_HEAD, 8). + +-define(RANDOM, random). + +% Max data size that is queued in one instance +-define(MAX_DATA_SIZE, 16384). + +% This is the allowed delay when testing the driver timer functionality +-define(delay, 100). + +-define(heap_binary_size, 64). + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(2)), + case catch erts_debug:get_internal_state(available_internal_state) of + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + erlang:display({init_per_testcase, Case}), + ?line 0 = erts_debug:get_internal_state(check_io_debug), + [{watchdog, Dog},{testcase, Case}|Config]. + +fin_per_testcase(Case, Config) -> + Dog = ?config(watchdog, Config), + erlang:display({fin_per_testcase, Case}), + ?line 0 = erts_debug:get_internal_state(check_io_debug), + ?t:timetrap_cancel(Dog). + +end_per_suite(_Config) -> + catch erts_debug:set_internal_state(available_internal_state, false). + +all(suite) -> + [ + fun_to_port, + outputv_echo, + queue_echo, + timer, + driver_unloaded, + io_ready_exit, + use_fallback_pollset, + bad_fd_in_pollset, + driver_event, + fd_change, + steal_control, + otp_6602, + 'driver_system_info_ver1.0', + 'driver_system_info_ver1.1', + driver_system_info_current_ver, + driver_monitor, + ioq_exit, + zero_extended_marker_garb_drv, + invalid_extended_marker_drv, + larger_major_vsn_drv, + larger_minor_vsn_drv, + smaller_major_vsn_drv, + smaller_minor_vsn_drv, + peek_non_existing_queue, + otp_6879, + caller, + many_events, + missing_callbacks, + smp_select, + driver_select_use, + thread_mseg_alloc_cache_clean + ]. + +fun_to_port(doc) -> "Test sending a fun to port with an outputv-capable driver."; +fun_to_port(Config) when is_list(Config) -> + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:start(), + ?line ok = load_driver(Path, outputv_drv), + + ?line fun_to_port_1(fun() -> 33 end), + ?line fun_to_port_1([fun() -> 42 end]), + ?line fun_to_port_1([1|fun() -> 42 end]), + L = build_io_list(65536), + ?line fun_to_port_1([L,fun() -> 42 end]), + ?line fun_to_port_1([L|fun() -> 42 end]), + ok. + +fun_to_port_1(Term) -> + Port = open_port({spawn,outputv_drv}, []), + {'EXIT',{badarg,_}} = (catch port_command(Port, Term)), + port_close(Port). + +build_io_list(0) -> []; +build_io_list(1) -> [7]; +build_io_list(N) -> + L = build_io_list(N div 2), + case N rem 2 of + 0 -> [L|L]; + 1 -> [7,L|L] + end. + + + +outputv_echo(doc) -> ["Test echoing data with a driver that supports outputv."]; +outputv_echo(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(10)), + Name = 'outputv_drv', + P = start_driver(Config, Name, true), + + ?line ov_test(P, {bin,0}), + ?line ov_test(P, {bin,1}), + ?line ov_test(P, {bin,2}), + ?line ov_test(P, {bin,3}), + ?line ov_test(P, {bin,4}), + ?line ov_test(P, {bin,5}), + ?line ov_test(P, {bin,6}), + ?line ov_test(P, {bin,7}), + ?line ov_test(P, {bin,8}), + ?line ov_test(P, {bin,15}), + ?line ov_test(P, {bin,16}), + ?line ov_test(P, {bin,17}), + + ?line ov_test(P, {list,0}), + ?line ov_test(P, {list,1}), + ?line ov_test(P, {list,2}), + ?line ov_test(P, [int,int,{list,0},int]), + ?line ov_test(P, [int,int,{list,1},int]), + ?line ov_test(P, [int,int,{list,2}]), + ?line ov_test(P, [{list,3},int,int,{list,2}]), + ?line ov_test(P, {list,33}), + + ?line ov_test(P, [{bin,0}]), + ?line ov_test(P, [{bin,1}]), + ?line ov_test(P, [{bin,2}]), + ?line ov_test(P, [{bin,3}]), + ?line ov_test(P, [{bin,4}]), + ?line ov_test(P, [{bin,5}]), + ?line ov_test(P, [{bin,6},int]), + ?line ov_test(P, [int,{bin,3}]), + ?line ov_test(P, [int|{bin,4}]), + ?line ov_test(P, [{bin,17},int,{bin,13}|{bin,3}]), + + ?line ov_test(P, [int,{bin,17},int,{bin,?heap_binary_size+1}|{bin,3}]), + + stop_driver(P, Name), + ?line test_server:timetrap_cancel(Dog), + ok. + +ov_test(Port, Template) -> + Self = self(), + spawn_opt(erlang, apply, [fun () -> ov_test(Self, Port, Template) end,[]], + [link,{fullsweep_after,0}]), + receive + done -> ok + end. + +ov_test(Parent, Port, Template) -> + true = port_connect(Port, self()), + + HeapData = build_data(Template), + io:format("Mostly heap binaries"), + ov_send_and_test(Port, HeapData, HeapData), + + %% Try sub binaries. + io:format("Mostly sub binaries of heap binaries"), + SubHeapData = make_sub_binaries(HeapData), + ov_send_and_test(Port, SubHeapData, HeapData), + + %% Try refc binaries. + io:format("Refc binaries"), + RefcData = make_refc_binaries(HeapData), + ov_send_and_test(Port, RefcData, RefcData), + + %% Try sub binaries of heap binaries. + io:format("Sub binaries of refc binaries"), + SubRefcData = make_sub_binaries(RefcData), + ov_send_and_test(Port, SubRefcData, RefcData), + io:format("", []), + + %% Garbage collect and make sure that there are no binaries left. + %% R7 note: + %% - dead variables on the stack are killed after last use, + %% - erlang:garbage_collect/0 collects garbage immediately. + %% (there used to be dummy functions here) + erlang:garbage_collect(), + {binary,[]} = process_info(self(), binary), + + %% Reassign Port back to parent and tell him we are done. + true = port_connect(Port, Parent), + Parent ! done. + +ov_send_and_test(Port, Data, ExpectedResult) -> + io:format("~p ! ~P", [Port,Data,12]), + Port ! {self(),{command,Data}}, + receive + {Port,{data,ReturnData}} -> + io:format("~p returned ~P", [Port,ReturnData,12]), + compare(ReturnData, ExpectedResult); + {Port,{data,OtherData}} -> + io:format("~p returned WRONG data ~p", [Port,OtherData]), + ?line test_server:fail(); + Wrong -> + ?line test_server:fail({unexpected_port_or_data,Wrong}) + end. + +compare(Got, Expected) -> + case {list_to_binary([Got]),list_to_binary([Expected])} of + {B,B} -> ok; + {_Gb,_Eb} -> + ?t:fail(got_bad_data) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Driver timer test suites +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +timer(suite) -> [timer_measure,timer_cancel,timer_delay,timer_change]. + +timer_measure(doc) -> ["Check that timers time out in good time."]; +timer_measure(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(1)), + Name = 'timer_drv', + ?line Port = start_driver(Config, Name, false), + + ?line try_timeouts(Port, 8997), + + ?line stop_driver(Port, Name), + ?line test_server:timetrap_cancel(Dog), + ok. + +try_timeouts(_, 0) -> ok; +try_timeouts(Port, Timeout) -> + ?line TimeBefore = now(), + ?line erlang:port_command(Port, <>), + receive + {Port,{data,[?TIMER]}} -> + ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]), + if + Elapsed < Timeout -> + ?line ?t:fail(too_short); + Elapsed > Timeout + ?delay -> + ?line ?t:fail(too_long); + true -> + try_timeouts(Port, Timeout div 2) + end + after Timeout + ?delay -> + ?line test_server:fail("driver failed to timeout") + end. + +timer_cancel(doc) -> ["Try cancelling timers set in a driver."]; +timer_cancel(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(1)), + Name = 'timer_drv', + ?line Port = start_driver(Config, Name, false), + + ?line try_cancel(Port, 10000), + + ?line stop_driver(Port, Name), + ?line test_server:timetrap_cancel(Dog), + ok. + +try_cancel(Port, Timeout) -> + ?line T_before = erl_millisecs(), + Port ! {self(),{command,<>}}, + receive + {Port, {data, [?TIMER]}} -> + ?line test_server:fail("driver timed out before cancelling it") + after Timeout -> + Port ! {self(), {command, [?CANCEL_TIMER]}}, + receive + {Port, {data, [?TIMER]}} -> + ?line test_server:fail("driver timed out after cancelling it"); + {Port, {data, [?CANCELLED]}} -> + ?line Time_milli_secs = erl_millisecs() - T_before, + + io:format("Time_milli_secs: ~p Timeout: ~p\n", + [Time_milli_secs, Timeout]), + if + Time_milli_secs > (Timeout + ?delay) -> + ?line test_server:fail("too long real time"); + Timeout == 0 -> ok; + true -> try_cancel(Port, Timeout div 2) + end + after ?delay -> + test_server:fail("No message from driver") + end + end. + +%% Test that timers don't time out too early if we do a sleep +%% before setting a timer. + +timer_delay(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(1)), + Name = 'timer_drv', + ?line Port = start_driver(Config, Name, false), + + ?line TimeBefore = now(), + Timeout0 = 350, + ?line erlang:port_command(Port, <>), + Timeout = Timeout0 + + case os:type() of + {win32,_} -> 0; %Driver doesn't sleep on Windows. + _ -> 1000 + end, + receive + {Port,{data,[?TIMER]}} -> + ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed time: ~p Timeout: ~p\n", + [Elapsed,Timeout]), + if + Elapsed < Timeout -> + ?line ?t:fail(too_short); + Elapsed > Timeout + ?delay -> + ?line ?t:fail(too_long); + true -> + ok + end + end, + + ?line stop_driver(Port, Name), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Test that driver_set_timer with new timout really changes +%% the timer (ticket OTP-5942), it didn't work before + +timer_change(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(1)), + Name = 'timer_drv', + ?line Port = start_driver(Config, Name, false), + + ?line try_change_timer(Port, 10000), + + ?line stop_driver(Port, Name), + ?line test_server:timetrap_cancel(Dog), + ok. + +try_change_timer(_Port, 0) -> ok; +try_change_timer(Port, Timeout) -> + ?line Timeout_3 = Timeout*3, + ?line TimeBefore = now(), + ?line erlang:port_command(Port, <>), + ?line erlang:port_command(Port, <>), + receive + {Port,{data,[?TIMER]}} -> + ?line Elapsed = erl_millisecs() - erl_millisecs(TimeBefore), + io:format("Elapsed: ~p Timeout: ~p\n", [Elapsed,Timeout]), + if + Elapsed < Timeout -> + ?line ?t:fail(too_short); + Elapsed > Timeout + ?delay -> + ?line ?t:fail(too_long); + true -> + try_timeouts(Port, Timeout div 2) + end + after Timeout + ?delay -> + ?line test_server:fail("driver failed to timeout") + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Queue test suites +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +queue_echo(doc) -> + ["1) Queue up data in a driver that uses the full driver_queue API to do this." + "2) Get the data back, a random amount at a time."]; +queue_echo(Config) when is_list(Config) -> + case ?t:is_native(?MODULE) of + true -> exit(crashes_native_code); + false -> queue_echo_1(Config) + end. + +queue_echo_1(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(10)), + Name = 'queue_drv', + ?line P = start_driver(Config, Name, true), + + ?line q_echo(P, [{?ENQ, {list,1}}, + {?ENQ, {list,0}}, + {?ENQ, {bin,0}}, + {?ENQ, {bin,1}}, + {?ENQ, {bin,2}}, + {?ENQ, {bin,3}}, + {?ENQ, {bin,4}}, + {?ENQ, {bin,5}}, + {?ENQ, {bin,600}}, + {?PUSHQ, {list,0}}, + {?PUSHQ, {list,1}}, + {?PUSHQ, {bin,0}}, + {?PUSHQ, {bin,1}}, + {?PUSHQ, {bin,888}}, + {?ENQ_BIN, {bin,0}}, + {?ENQ_BIN, {bin,1}}, + {?ENQ_BIN, {bin,2}}, + {?ENQ_BIN, {bin,3}}, + {?ENQ_BIN, {bin,4}}, + {?ENQ_BIN, {bin,777}}, + {?PUSHQ_BIN, {bin,0}}, + {?PUSHQ_BIN, {bin,1}}, + {?PUSHQ_BIN, {bin,334}}, + {?ENQV, [{bin,0},{list,1},{bin,1},{bin,555}]}, + {?ENQV, [{bin,0},{list,1},{bin,1}]}, + {?PUSHQV, [{bin,0},{list,1},{bin,1},{bin,319}]}]), + + ?line stop_driver(P, Name), + ?line test_server:timetrap_cancel(Dog), + ok. + +q_echo(Port, SpecList) -> + io:format("Heap binaries"), + HeapData = [{M,build_data(T)} || {M,T} <- SpecList], + {HeapDataReturn,HeapDataLen} = feed_driver(Port, HeapData), + dequeue(Port, HeapDataReturn, HeapDataLen, 1), + + %% Try sub binaries. + io:format("Sub binaries of heap binaries"), + SubHeapData = make_sub_binaries(HeapData), + %% The following line will generate a warning. + {HeapDataReturn,HeapDataLen} = feed_driver(Port, SubHeapData), + dequeue(Port, HeapDataReturn, HeapDataLen, 1), + + %% Try refc binaries. + io:format("Refc binaries"), + RefcData = make_refc_binaries(HeapData), + {RefcDataReturn,RefcDataLen} = feed_driver(Port, RefcData), + dequeue(Port, RefcDataReturn, RefcDataLen, 1), + + %% Try sub binaries of refc binaries. + io:format("Sub binaries of refc binaries"), + SubRefcData = make_sub_binaries(RefcData), + {RefcDataReturn,RefcDataLen} = feed_driver(Port, SubRefcData), + dequeue(Port, RefcDataReturn, RefcDataLen, 1), + + %% Try a writable binary. + io:format("Writable binaries"), + WritableBinData = make_writable_binaries(HeapData), + {WritableDataReturn,WritableDatalen} = feed_driver(Port, WritableBinData), + _ = append_to_writable_binaries(WritableBinData), + dequeue(Port, WritableDataReturn, WritableDatalen, 1), + + %% Try dequeing more than one byte at the time. + io:format("Heap binaries -- dequeueing more than one byte at the time"), + feed_and_dequeue(Port, HeapData, 2), + feed_and_dequeue(Port, HeapData, 3), + feed_and_dequeue(Port, HeapData, 4), + + io:format("\n"). + +feed_and_dequeue(Port, Data, DeqSize) -> + {DataReturn,DataLen} = feed_driver(Port, Data), + dequeue(Port, DataReturn, DataLen, DeqSize), + ok. + +%% Send all data according to the specification to the driver side (where it +%% is queued up for later return to this process). + +feed_driver(Port, Description) -> + feed_driver(Port, Description, <<>>, 0). + +feed_driver(Port, [], ExpectedInPort, Qb) -> + io:format("Expected in port: ~P", [ExpectedInPort,12]), + io:format("In port: ~P", [read_head(Port, Qb),12]), + {ExpectedInPort,Qb}; +feed_driver(Port, [{Method0,Data}|T], Expected_return, Qb_before) -> + Method = case Method0 of + ?RANDOM -> uniform(6)-1; + Other -> Other + end, + Size = size(list_to_binary([Data])), + + %% *********************************************************************** + %% NOTE! Never never never change this to io:format/2, as that will imply + %% message sending, and sending as message will spoil the test of + %% writable binaries. + + %% erlang:display({sending,method_name(Method),Data}), + %% *********************************************************************** + + queue_op(Port, Method, Data), + + Qb_in_driver = bytes_queued(Port), + case Qb_before + Size of + Qb_in_driver -> ok; + Sum -> + io:format("Qb_before: ~p\n" + "Qb_before+Size: ~p\n" + "Qb_in_driver: ~p", + [Qb_before,Sum,Qb_in_driver]), + ?t:fail() + end, + X_return = case Method of + ?ENQ -> list_to_binary([Expected_return,Data]); + ?PUSHQ -> list_to_binary([Data,Expected_return]); + ?PUSHQ_BIN -> list_to_binary([Data,Expected_return]); + ?ENQ_BIN -> list_to_binary([Expected_return,Data]); + ?PUSHQV -> list_to_binary([Data,Expected_return]); + ?ENQV -> list_to_binary([Expected_return,Data]) + end, + feed_driver(Port, T, X_return, Qb_before + Size). + +%% method_name(0) -> pushq; +%% method_name(1) -> enq; +%% method_name(2) -> pushq_bin; +%% method_name(3) -> enq_bin; +%% method_name(4) -> pushqv; +%% method_name(5) -> enqv. + +dequeue(Port, DataList, LenToGet, DeqSize) -> + io:format("Dequeuing ~p bytes, ~p byte(s) at once...", [LenToGet,DeqSize]), + compare_return(Port, DataList, LenToGet, DeqSize). + +compare_return(Port, _Data_list, 0, _Back_len) -> + 0 = bytes_queued(Port); +compare_return(Port, QueuedInPort0, Len_to_get, DeqSize) -> + case bytes_queued(Port) of + Len_to_get -> ok; + BytesInQueue -> + io:format("Len_to_get: ~p", [Len_to_get]), + io:format("Bytes in queue: ~p", [BytesInQueue]), + ?line test_server:fail() + end, + BytesToDequeue = if (DeqSize > Len_to_get) -> Len_to_get; + true -> DeqSize + end, + Dequeued = read_head(Port, BytesToDequeue), + case bin_prefix(Dequeued, QueuedInPort0) of + true -> + deq(Port, BytesToDequeue), + <<_:BytesToDequeue/binary,QueuedInPort/binary>> = QueuedInPort0, + compare_return(Port, QueuedInPort, Len_to_get - BytesToDequeue, DeqSize); + false -> + io:format("Bytes to dequeue: ~p", [BytesToDequeue]), + io:format("Dequeued: ~p", [Dequeued]), + io:format("Queued in port: ~P", [QueuedInPort0,12]), + ?t:fail() + end. + +%% bin_prefix(PrefixBinary, Binary) +%% Is PrefixBinary a prefix of Binary? + +bin_prefix(<>, <>) -> + bin_prefix(PreTail, Tail); +bin_prefix(<<>>, _Bin) -> true; +bin_prefix(_, _) -> false. + +queue_op(Port, Method, Data) -> + [] = erlang:port_control(Port, Method, []), + Port ! {self(),{command,Data}}, + ok. + +bytes_queued(Port) -> + case erlang:port_control(Port, ?BYTES_QUEUED, []) of + <> -> I; + Bad -> ?t:fail({bad_result,Bad}) + end. + +deq(Port, Size) -> + [] = erlang:port_control(Port, ?DEQ, <>). + +read_head(Port, Size) -> + erlang:port_control(Port, ?READ_HEAD, <>). + + +driver_unloaded(doc) -> + []; +driver_unloaded(suite) -> + []; +driver_unloaded(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line Drv = timer_drv, + ?line User = self(), + ?line Loaded = make_ref(), + ?line Die = make_ref(), + ?line Loader = spawn(fun () -> + erl_ddll:start(), + ok = load_driver(?config(data_dir, + Config), + Drv), + User ! Loaded, + receive Die -> exit(bye) end + end), + ?line receive Loaded -> ok end, + ?line Port = open_port({spawn, Drv}, []), + ?line Loader ! Die, + ?line receive + {'EXIT', Port, Reason} -> + ?line driver_unloaded = Reason + %% Reason used to be -1 + end. + + +io_ready_exit(doc) -> []; +io_ready_exit(suite) -> []; +io_ready_exit(Config) when is_list(Config) -> + ?line OTE = process_flag(trap_exit, true), + ?line Test = self(), + ?line Dgawd = spawn(fun () -> + ok = dgawd_handler:install(), + Mon = erlang:monitor(process, Test), + Test ! dgawd_handler_started, + receive + {'DOWN', Mon, _, _, _} -> ok; + stop_dgawd_handler -> ok + end, + dgawd_handler:restore(), + Test ! dgawd_handler_stopped + end), + ?line receive dgawd_handler_started -> ok end, + ?line Drv = io_ready_exit_drv, + ?line erl_ddll:start(), + ?line ok = load_driver(?config(data_dir, Config), Drv), + ?line Port = open_port({spawn, Drv}, []), + ?line case erlang:port_control(Port, 0, "") of + "ok" -> + receive + {'EXIT', Port, Reason} -> + ?line case Reason of + ready_output_driver_failure -> + ?t:format("Exited in output_ready()~n"), + ?line ok; + ready_input_driver_failure -> + ?t:format("Exited in input_ready()~n"), + ?line ok; + Error -> ?line ?t:fail(Error) + end + end, + receive after 2000 -> ok end, + ?line false = dgawd_handler:got_dgawd_report(), + ?line Dgawd ! stop_dgawd_handler, + ?line receive dgawd_handler_stopped -> ok end, + ?line process_flag(trap_exit, OTE), + ?line ok; + "nyiftos" -> + ?line process_flag(trap_exit, OTE), + ?line {skipped, "Not yet implemented for this OS"}; + Error -> + ?line process_flag(trap_exit, OTE), + ?line ?t:fail({unexpected_control_result, Error}) + end. + + +-define(CHKIO_STOP, 0). +-define(CHKIO_USE_FALLBACK_POLLSET, 1). +-define(CHKIO_BAD_FD_IN_POLLSET, 2). +-define(CHKIO_DRIVER_EVENT, 3). +-define(CHKIO_FD_CHANGE, 4). +-define(CHKIO_STEAL, 5). +-define(CHKIO_STEAL_AUX, 6). +-define(CHKIO_SMP_SELECT, 7). +-define(CHKIO_DRV_USE, 8). + +use_fallback_pollset(doc) -> []; +use_fallback_pollset(suite) -> []; +use_fallback_pollset(Config) when is_list(Config) -> + FlbkFun = fun () -> + ChkIoDuring = erlang:system_info(check_io), + case lists:keysearch(fallback_poll_set_size, + 1, + ChkIoDuring) of + {value, + {fallback_poll_set_size, N}} when N > 0 -> + ?line ok; + Error -> + ?line ?t:fail({failed_to_use_fallback, Error}) + end + end, + ?line {BckupTest, Handel, OkRes} + = case chkio_test_init(Config) of + {erts_poll_info, ChkIo} = Hndl -> + case lists:keysearch(fallback, 1, ChkIo) of + {value, {fallback, B}} when B =/= false -> + ?line {FlbkFun, Hndl, ok}; + _ -> + ?line {fun () -> ok end, + Hndl, + {comment, + "This implementation does not use " + "a fallback pollset"}} + end; + Skip -> + {fun () -> ok end, Skip, ok} + end, + ?line case chkio_test_fini(chkio_test(Handel, + ?CHKIO_USE_FALLBACK_POLLSET, + fun () -> + ?line sleep(1000), + ?line BckupTest() + end)) of + {skipped, _} = Res -> ?line Res; + _ -> ?line OkRes + end. + +bad_fd_in_pollset(doc) -> []; +bad_fd_in_pollset(suite) -> []; +bad_fd_in_pollset(Config) when is_list(Config) -> + ?line chkio_test_fini(chkio_test(chkio_test_init(Config), + ?CHKIO_BAD_FD_IN_POLLSET, + fun () -> ?line sleep(1000) end)). + +driver_event(doc) -> []; +driver_event(suite) -> []; +driver_event(Config) when is_list(Config) -> + ?line chkio_test_fini(chkio_test(chkio_test_init(Config), + ?CHKIO_DRIVER_EVENT, + fun () -> ?line sleep(1000) end)). + +fd_change(doc) -> []; +fd_change(suite) -> []; +fd_change(Config) when is_list(Config) -> + ?line chkio_test_fini(chkio_test(chkio_test_init(Config), + ?CHKIO_FD_CHANGE, + fun () -> ?line sleep(1000) end)). + +steal_control(doc) -> []; +steal_control(suite) -> []; +steal_control(Config) when is_list(Config) -> + ?line chkio_test_fini(case chkio_test_init(Config) of + {erts_poll_info, _} = Hndl -> + ?line steal_control_test(Hndl); + Skip -> + ?line Skip + end). + +steal_control_test(Hndl = {erts_poll_info, Before}) -> + ?line Port = open_chkio_port(), + ?line case erlang:port_control(Port, ?CHKIO_STEAL_AUX, "") of + [$f,$d,$s,$:| _] = FdList -> + ?line chk_chkio_port(Port), + sleep(500), + ?line chk_chkio_port(Port), + ?line Res = chkio_test(Hndl, + ?CHKIO_STEAL, + FdList, + fun () -> + ?line chk_chkio_port(Port), + ?line sleep(500), + ?line chk_chkio_port(Port) + end), + ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of + "ok" -> + ?line chk_chkio_port(Port), + ?line ok; + StopErr -> + ?line chk_chkio_port(Port), + ?line ?t:fail({stop_error, StopErr}) + end, + ?line close_chkio_port(Port), + ?line Res; + [$s,$k,$i,$p,$:,$\ |Skip] -> + ?line chk_chkio_port(Port), + ?line close_chkio_port(Port), + {chkio_test_result, + {skipped, Skip}, + Before}; + StartErr -> + ?line chk_chkio_port(Port), + ?line ?t:fail({start_error, StartErr}) + end. + +chkio_test_init(Config) when is_list(Config) -> + ?line wait_until_no_pending_updates(), + ?line ChkIo = erlang:system_info(check_io), + ?line case catch lists:keysearch(name, 1, ChkIo) of + {value, {name, erts_poll}} -> + ?line ?t:format("Before test: ~p~n", [ChkIo]), + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:start(), + ?line ok = load_driver(Path, 'chkio_drv'), + ?line process_flag(trap_exit, true), + ?line {erts_poll_info, ChkIo}; + _ -> + ?line {skipped, "Test written to test erts_poll() which isn't used"} + end. + + +chkio_test_fini({skipped, _} = Res) -> + Res; +chkio_test_fini({chkio_test_result, Res, Before}) -> + ?line ok = erl_ddll:unload_driver('chkio_drv'), + ?line ok = erl_ddll:stop(), + ?line wait_until_no_pending_updates(), + ?line After = erlang:system_info(check_io), + ?line ?t:format("After test: ~p~n", [After]), + ?line verify_chkio_state(Before, After), + ?line Res. + +open_chkio_port() -> + open_port({spawn, 'chkio_drv'}, []). + +close_chkio_port(Port) when is_port(Port) -> + true = erlang:port_close(Port), + receive + {'EXIT', Port, normal} -> + ok; + {'EXIT', Port, Reason} -> + ?t:fail({abnormal_port_exit, Port, Reason}); + {Port, Message} -> + ?t:fail({strange_message_from_port, Message}) + end. + +chk_chkio_port(Port) -> + receive + {'EXIT', Port, Reason} when Reason /= normal -> + ?t:fail({port_exited, Port, Reason}) + after 0 -> + ok + end. + + +chkio_test({skipped, _} = Res, _Test, _Fun) -> + ?line Res; +chkio_test({erts_poll_info, _Before} = EPI, Test, Fun) when is_integer(Test) -> + chkio_test(EPI, Test, "", Fun). + +chkio_test({skipped, _} = Res, _Test, _TestArgs, _Fun) -> + ?line Res; +chkio_test({erts_poll_info, Before}, + Test, + TestArgs, + Fun) when is_integer(Test), + is_list(TestArgs) -> + ?line Port = open_chkio_port(), + ?line case erlang:port_control(Port, Test, TestArgs) of + "ok" -> + ?line chk_chkio_port(Port), + ?line Fun(), + ?line During = erlang:system_info(check_io), + ?line erlang:display(During), + ?line 0 = erts_debug:get_internal_state(check_io_debug), + ?line ?t:format("During test: ~p~n", [During]), + ?line chk_chkio_port(Port), + ?line case erlang:port_control(Port, ?CHKIO_STOP, "") of + Res when is_list(Res) -> + ?line chk_chkio_port(Port), + ?line ?t:format("~s", [Res]), + ?line close_chkio_port(Port), + ?line Res, + ?line case Res of + [$c,$o,$m,$m,$e,$n,$t,$:,$\ |Cmnt] -> + ?line {chkio_test_result, + {comment, Cmnt}, + Before}; + _ -> + ?line {chkio_test_result, + Res, + Before} + end; + StopErr -> + ?line chk_chkio_port(Port), + ?line ?t:fail({stop_error, StopErr}) + end; + [$s,$k,$i,$p,$:,$\ |Skip] -> + ?line chk_chkio_port(Port), + ?line close_chkio_port(Port), + {chkio_test_result, + {skipped, Skip}, + Before}; + StartErr -> + ?line chk_chkio_port(Port), + ?line ?t:fail({start_error, StartErr}) + end. + +verify_chkio_state(Before, After) -> + ?line TotSetSize = lists:keysearch(total_poll_set_size, 1, Before), + ?line TotSetSize = lists:keysearch(total_poll_set_size, 1, After), + ?line case lists:keysearch(fallback, 1, Before) of + {value,{fallback,false}} -> + ?line ok; + _ -> + ?line BckupSetSize = lists:keysearch(fallback_poll_set_size, + 1, + Before), + ?line BckupSetSize = lists:keysearch(fallback_poll_set_size, + 1, + After) + end, + ?line ok. + + + +wait_until_no_pending_updates() -> + case lists:keysearch(pending_updates, 1, erlang:system_info(check_io)) of + {value, {pending_updates, 0}} -> + ok; + false -> + ok; + _ -> + receive after 10 -> ok end, + wait_until_no_pending_updates() + end. + +otp_6602(doc) -> ["Missed port lock when stealing control of fd from a " + "driver that didn't use the same lock. The lock checker " + "used to trigger on this and dump core."]; +otp_6602(suite) -> + []; +otp_6602(Config) when is_list(Config) -> + ?line {ok, Node} = start_node(Config), + ?line Done = make_ref(), + ?line Parent = self(), + ?line Tester = spawn_link(Node, + fun () -> + %% Inet driver use port locking... + {ok, S} = gen_udp:open(0), + {ok, Fd} = inet:getfd(S), + {ok, Port} = inet:port(S), + %% Steal fd (lock checker used to + %% trigger here). + {ok, _S2} = gen_udp:open(Port,[{fd,Fd}]), + Parent ! Done + end), + ?line receive Done -> ok end, + ?line unlink(Tester), + ?line stop_node(Node), + ?line ok. + +-define(EXPECTED_SYSTEM_INFO_NAMES1, + ["drv_drv_vsn", + "emu_drv_vsn", + "erts_vsn", + "otp_vsn", + "thread", + "smp"]). +-define(EXPECTED_SYSTEM_INFO_NAMES2, + (?EXPECTED_SYSTEM_INFO_NAMES1 ++ + ["async_thrs", + "sched_thrs"])). + +-define(EXPECTED_SYSTEM_INFO_NAMES, ?EXPECTED_SYSTEM_INFO_NAMES2). + +'driver_system_info_ver1.0'(doc) -> + []; +'driver_system_info_ver1.0'(suite) -> + []; +'driver_system_info_ver1.0'(Config) when is_list(Config) -> + ?line driver_system_info_test(Config, sys_info_1_0_drv). + +'driver_system_info_ver1.1'(doc) -> + []; +'driver_system_info_ver1.1'(suite) -> + []; +'driver_system_info_ver1.1'(Config) when is_list(Config) -> + ?line driver_system_info_test(Config, sys_info_1_1_drv). + +driver_system_info_current_ver(doc) -> + []; +driver_system_info_current_ver(suite) -> + []; +driver_system_info_current_ver(Config) when is_list(Config) -> + ?line driver_system_info_test(Config, sys_info_curr_drv). + +driver_system_info_test(Config, Name) -> + ?line Port = start_driver(Config, Name, false), + ?line case erlang:port_control(Port, 0, []) of + [$o,$k,$:,_ | Result] -> + ?line check_driver_system_info_result(Result); + [$e,$r,$r,$o,$r,$:,_ | Error] -> + ?line ?t:fail(Error); + Unexpected -> + ?line ?t:fail({unexpected_result, Unexpected}) + end, + ?line stop_driver(Port, Name), + ?line ok. + +check_driver_system_info_result(Result) -> + ?line ?t:format("All names: ~p~n", [?EXPECTED_SYSTEM_INFO_NAMES]), + ?line ?t:format("Result: ~p~n", [Result]), + ?line {[], Ns, DDVSN} = chk_sis(lists:map(fun (Str) -> + string:tokens(Str, "=") + end, + string:tokens(Result, " ")), + ?EXPECTED_SYSTEM_INFO_NAMES), + ?line case {DDVSN, + drv_vsn_str2tup(erlang:system_info(driver_version))} of + {DDVSN, DDVSN} -> + ?line [] = Ns; + {{1, 0}, _} -> + ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + -- ?EXPECTED_SYSTEM_INFO_NAMES1), + ?line ExpNs = lists:sort(Ns); + {{1, 1}, _} -> + ?line ExpNs = lists:sort(?EXPECTED_SYSTEM_INFO_NAMES + -- ?EXPECTED_SYSTEM_INFO_NAMES2), + ?line ExpNs = lists:sort(Ns) + end. + +chk_sis(SIs, Ns) -> + chk_sis(SIs, Ns, unknown). + +chk_sis(SIs, [], DDVSN) -> + ?line {SIs, [], DDVSN}; +chk_sis([], Ns, DDVSN) -> + ?line {[], Ns, DDVSN}; +chk_sis([[N, _] = SI| SIs], Ns, DDVSN) -> + ?line true = lists:member(N, Ns), + ?line case check_si_res(SI) of + {driver_version, NewDDVSN} -> + ?line chk_sis(SIs, lists:delete(N, Ns), NewDDVSN); + _ -> + ?line chk_sis(SIs, lists:delete(N, Ns), DDVSN) + end. + +%% Data in first version of driver_system_info() (driver version 1.0) +check_si_res(["drv_drv_vsn", Value]) -> + ?line DDVSN = drv_vsn_str2tup(Value), + ?line {Major, DMinor} = DDVSN, + ?line {Major, EMinor} = drv_vsn_str2tup(erlang:system_info(driver_version)), + ?line true = DMinor =< EMinor, + ?line {driver_version, DDVSN}; +check_si_res(["emu_drv_vsn", Value]) -> + ?line Value = erlang:system_info(driver_version); +check_si_res(["erts_vsn", Value]) -> + ?line Value = erlang:system_info(version); +check_si_res(["otp_vsn", Value]) -> + ?line Value = erlang:system_info(otp_release); +check_si_res(["thread", "true"]) -> + ?line true = erlang:system_info(threads); +check_si_res(["thread", "false"]) -> + ?line false = erlang:system_info(threads); +check_si_res(["smp", "true"]) -> + ?line true = erlang:system_info(smp_support); +check_si_res(["smp", "false"]) -> + ?line false = erlang:system_info(smp_support); + +%% Data added in second version of driver_system_info() (driver version 1.1) +check_si_res(["async_thrs", Value]) -> + ?line Value = integer_to_list(erlang:system_info(thread_pool_size)); +check_si_res(["sched_thrs", Value]) -> + ?line Value = integer_to_list(erlang:system_info(schedulers)); + +check_si_res(Unexpected) -> + ?line ?t:fail({unexpected_result, Unexpected}). + +-define(MON_OP_I_AM_IPID,1). +-define(MON_OP_MONITOR_ME,2). +-define(MON_OP_DEMONITOR_ME,3). +-define(MON_OP_MONITOR_ME_LATER,4). +-define(MON_OP_DO_DELAYED_MONITOR,5). + +driver_monitor(suite) -> + []; +driver_monitor(doc) -> + ["Test monitoring of processes from drivers"]; +driver_monitor(Config) when is_list(Config) -> + ?line Name = monitor_drv, + ?line Port = start_driver(Config, Name, false), + ?line "ok" = port_control(Port,?MON_OP_I_AM_IPID,[]), + ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + ?line {monitors, []} = erlang:port_info(Port,monitors), + + ?line "ok:"++Id1 = port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + ?line {monitored_by, []} = process_info(self(),monitored_by), + ?line "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id1), + ?line {monitored_by, [Port]} = process_info(self(),monitored_by), + ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + ?line {monitored_by, []} = process_info(self(),monitored_by), + + ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + ?line Me = self(), + ?line {Pid1,Ref1} = + spawn_monitor(fun() -> + Me ! port_control(Port,?MON_OP_MONITOR_ME,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) + end), + ?line ok = receive + "ok" -> + ok + after 1000 -> + timeout + end, + ?line ok = receive + {monitored_by, L} -> + L2 = lists:sort(L), + L3 = lists:sort([Me,Port]), + case L2 of + L3 -> + ok; + _ -> + mismatch + end + after 1000 -> + timeout + end, + ?line ok = receive + {monitors, LL} -> + LL2 = lists:sort(LL), + LL3 = lists:sort([{process,Me},{process,Pid1}]), + case LL2 of + LL3 -> + ok; + _ -> + mismatch + end + after 1000 -> + timeout + end, + ?line ok = receive + {'DOWN', Ref1, process, Pid1, _} -> + ok + after 1000 -> + timeout + end, + ?line ok = receive + {monitor_fired,Port,Pid1} -> + ok + after 1000 -> + timeout + end, + ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + ?line {monitors,[]} = erlang:port_info(Port,monitors), + ?line {monitored_by, []} = process_info(self(),monitored_by), + + ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + ?line {Pid2,Ref2} = + spawn_monitor(fun() -> + receive go -> ok end, + Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) + end), + ?line Pid2 ! go, + ?line {ok,Id2} = receive + "ok:"++II -> + {ok,II} + after 1000 -> + timeout + end, + ?line ok = receive + {monitored_by, [Me]} -> + ok + after 1000 -> + timeout + end, + ?line ok = receive + {monitors, [{process,Me}]} -> + ok + after 1000 -> + timeout + end, + ?line ok = receive + {'DOWN', Ref2, process, Pid2, _} -> + ok + after 1000 -> + timeout + end, + ?line "noproc" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), + ?line {monitors,[{process,Me}]} = erlang:port_info(Port,monitors), + ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + ?line "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + ?line {monitors,[]} = erlang:port_info(Port,monitors), + ?line {monitored_by, []} = process_info(self(),monitored_by), + + + ?line "ok" = port_control(Port,?MON_OP_MONITOR_ME,[]), + ?line {Pid3,Ref3} = + spawn_monitor(fun() -> + receive go -> ok end, + Me ! port_control(Port,?MON_OP_MONITOR_ME_LATER,[]), + Me ! process_info(self(),monitored_by), + Me ! erlang:port_info(Port,monitors) , + receive die -> ok end + end), + ?line Pid3 ! go, + ?line {ok,Id3} = receive + "ok:"++III -> + {ok,III} + after 1000 -> + timeout + end, + ?line ok = receive + {monitored_by, [Me]} -> + ok + after 1000 -> + timeout + end, + ?line ok = receive + {monitors, [{process,Me}]} -> + ok + after 1000 -> + timeout + end, + ?line "ok" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id3), + ?line LLL1 = lists:sort([{process,Me},{process,Pid3}]), + ?line {monitors,LLL2} = erlang:port_info(Port,monitors), + ?line LLL1 = lists:sort(LLL2), + ?line "ok" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + ?line {monitors,[{process,Pid3}]} = erlang:port_info(Port,monitors), + ?line Pid3 ! die, + ?line ok = receive + {'DOWN', Ref3, process, Pid3, _} -> + ok + after 1000 -> + timeout + end, + ?line "not_found" = port_control(Port,?MON_OP_DO_DELAYED_MONITOR,Id2), + ?line {monitors,[]} = erlang:port_info(Port,monitors), + ?line "not_monitored" = port_control(Port,?MON_OP_DEMONITOR_ME,[]), + ?line {monitors,[]} = erlang:port_info(Port,monitors), + ?line {monitored_by, []} = process_info(self(),monitored_by), + + ?line stop_driver(Port, Name), + ?line ok. + +ioq_exit(doc) -> []; +ioq_exit(suite) -> + [ioq_exit_ready_input, + ioq_exit_ready_output, + ioq_exit_timeout, + ioq_exit_ready_async, + ioq_exit_event, + ioq_exit_ready_input_async, + ioq_exit_ready_output_async, + ioq_exit_timeout_async, + ioq_exit_event_async]. + +-define(IOQ_EXIT_READY_INPUT, 1). +-define(IOQ_EXIT_READY_OUTPUT, 2). +-define(IOQ_EXIT_TIMEOUT, 3). +-define(IOQ_EXIT_READY_ASYNC, 4). +-define(IOQ_EXIT_EVENT, 5). +-define(IOQ_EXIT_READY_INPUT_ASYNC, 6). +-define(IOQ_EXIT_READY_OUTPUT_ASYNC, 7). +-define(IOQ_EXIT_TIMEOUT_ASYNC, 8). +-define(IOQ_EXIT_EVENT_ASYNC, 9). + +ioq_exit_test(Config, TestNo) -> + ?line Drv = ioq_exit_drv, + ?line try + begin + ?line case load_driver(?config(data_dir, Config), + Drv) of + ok -> ?line ok; + {error, permanent} -> ?line ok; + LoadError -> ?line ?t:fail({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + try port_control(Port, TestNo, "") of + "ok" -> + ?line ok; + "nyiftos" -> + ?line throw({skipped, + "Not yet implemented for " + "this OS"}); + [$s,$k,$i,$p,$:,$ | Comment] -> + ?line throw({skipped, Comment}); + [$e,$r,$r,$o,$r,$:,$ | Error] -> + ?line ?t:fail(Error) + after + Port ! {self(), close}, + receive {Port, closed} -> ok end, + false = lists:member(Port, erlang:ports()), + ok + end; + Error -> + ?line ?t:fail({open_port_failed, Error}) + end + end + catch + throw:Term -> ?line Term + after + erl_ddll:unload_driver(Drv) + end. + +ioq_exit_ready_input(doc) -> []; +ioq_exit_ready_input(suite) -> []; +ioq_exit_ready_input(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT). + +ioq_exit_ready_output(doc) -> []; +ioq_exit_ready_output(suite) -> []; +ioq_exit_ready_output(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_READY_OUTPUT). + +ioq_exit_timeout(doc) -> []; +ioq_exit_timeout(suite) -> []; +ioq_exit_timeout(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT). + +ioq_exit_ready_async(doc) -> []; +ioq_exit_ready_async(suite) -> []; +ioq_exit_ready_async(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_READY_ASYNC). + +ioq_exit_event(doc) -> []; +ioq_exit_event(suite) -> []; +ioq_exit_event(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_EVENT). + +ioq_exit_ready_input_async(doc) -> []; +ioq_exit_ready_input_async(suite) -> []; +ioq_exit_ready_input_async(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_READY_INPUT_ASYNC). + +ioq_exit_ready_output_async(doc) -> []; +ioq_exit_ready_output_async(suite) -> []; +ioq_exit_ready_output_async(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_READY_OUTPUT_ASYNC). + +ioq_exit_timeout_async(doc) -> []; +ioq_exit_timeout_async(suite) -> []; +ioq_exit_timeout_async(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_TIMEOUT_ASYNC). + +ioq_exit_event_async(doc) -> []; +ioq_exit_event_async(suite) -> []; +ioq_exit_event_async(Config) when is_list(Config) -> + ioq_exit_test(Config, ?IOQ_EXIT_EVENT_ASYNC). + + +vsn_mismatch_test(Config, LoadResult) -> + ?line Path = ?config(data_dir, Config), + ?line DrvName = ?config(testcase, Config), + ?line LoadResult = load_driver(Path, DrvName), + ?line case LoadResult of + ok -> + ?line Port = open_port({spawn, DrvName}, []), + ?line true = is_port(Port), + ?line true = port_close(Port), + ?line ok = erl_ddll:unload_driver(DrvName); + _ -> + ?line ok + end. + +zero_extended_marker_garb_drv(doc) -> []; +zero_extended_marker_garb_drv(suite) -> []; +zero_extended_marker_garb_drv(Config) when is_list(Config) -> + vsn_mismatch_test(Config, {error, driver_incorrect_version}). + +invalid_extended_marker_drv(doc) -> []; +invalid_extended_marker_drv(suite) -> []; +invalid_extended_marker_drv(Config) when is_list(Config) -> + vsn_mismatch_test(Config, {error, driver_incorrect_version}). + +larger_major_vsn_drv(doc) -> []; +larger_major_vsn_drv(suite) -> []; +larger_major_vsn_drv(Config) when is_list(Config) -> + vsn_mismatch_test(Config, {error, driver_incorrect_version}). + +larger_minor_vsn_drv(doc) -> []; +larger_minor_vsn_drv(suite) -> []; +larger_minor_vsn_drv(Config) when is_list(Config) -> + vsn_mismatch_test(Config, {error, driver_incorrect_version}). + +smaller_major_vsn_drv(doc) -> []; +smaller_major_vsn_drv(suite) -> []; +smaller_major_vsn_drv(Config) when is_list(Config) -> + vsn_mismatch_test(Config, {error, driver_incorrect_version}). + +smaller_minor_vsn_drv(doc) -> []; +smaller_minor_vsn_drv(suite) -> []; +smaller_minor_vsn_drv(Config) when is_list(Config) -> + DrvVsnStr = erlang:system_info(driver_version), + case drv_vsn_str2tup(DrvVsnStr) of + {_, 0} -> + {skipped, + "Cannot perform test when minor driver version is 0. " + "Current driver version is " ++ DrvVsnStr ++ "."}; + _ -> + vsn_mismatch_test(Config, ok) + end. + +-define(PEEK_NONXQ_TEST, 0). +-define(PEEK_NONXQ_WAIT, 1). + +peek_non_existing_queue(doc) -> []; +peek_non_existing_queue(suite) -> []; +peek_non_existing_queue(Config) when is_list(Config) -> + ?line OTE = process_flag(trap_exit, true), + ?line Drv = peek_non_existing_queue_drv, + ?line try + begin + ?line case load_driver(?config(data_dir, Config), + Drv) of + ok -> ?line ok; + {error, permanent} -> ?line ok; + LoadError -> ?line ?t:fail({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port1 when is_port(Port1) -> + try port_control(Port1, ?PEEK_NONXQ_TEST, "") of + "ok" -> + ?line ok; + [$s,$k,$i,$p,$p,$e,$d,$:,$ | SkipReason] -> + ?line throw({skipped, SkipReason}); + [$e,$r,$r,$o,$r,$:,$ | Error1] -> + ?line ?t:fail(Error1) + after + exit(Port1, kill), + receive {'EXIT', Port1, _} -> ok end + end; + Error1 -> + ?line ?t:fail({open_port1_failed, Error1}) + end, + case open_port({spawn, Drv}, []) of + Port2 when is_port(Port2) -> + try port_control(Port2, ?PEEK_NONXQ_WAIT, "") of + "ok" -> + ?line ok; + [$e,$r,$r,$o,$r,$:,$ | Error2] -> + ?line ?t:fail(Error2) + after + receive {Port2, test_successful} -> ok end, + Port2 ! {self(), close}, + receive {Port2, closed} -> ok end + end; + Error2 -> + ?line ?t:fail({open_port2_failed, Error2}) + end + end + catch + throw:Term -> ?line Term + after + process_flag(trap_exit, OTE), + erl_ddll:unload_driver(Drv) + end. + +otp_6879(doc) -> + []; +otp_6879(suite) -> + []; +otp_6879(Config) when is_list(Config) -> + ?line Drv = 'otp_6879_drv', + ?line Parent = self(), + ?line ok = load_driver(?config(data_dir, Config), Drv), + ?line Procs = lists:map( + fun (No) -> + spawn_link( + fun () -> + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + Res = otp_6879_call(Port, No, 10000), + erlang:port_close(Port), + Parent ! {self(), Res}; + _ -> + Parent ! {self(), + open_port_failed} + end + end) + end, + lists:seq(1,10)), + ?line lists:foreach(fun (P) -> + ?line receive + {P, ok} -> + ?line ok; + {P, Error} -> + ?line ?t:fail({P, Error}) + end + end, + Procs), + %% Also try it when input exeeds default buffer (256 bytes) + ?line Data = lists:seq(1, 1000), + ?line case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + ?line ok = otp_6879_call(Port, Data, 10), + ?line erlang:port_close(Port); + _ -> + ?line ?t:fail(open_port_failed) + end, + ?line erl_ddll:unload_driver(Drv), + ?line ok. + +otp_6879_call(_Port, _Data, 0) -> + ok; +otp_6879_call(Port, Data, N) -> + case catch erlang:port_call(Port, 0, Data) of + Data -> otp_6879_call(Port, Data, N-1); + BadData -> {mismatch, Data, BadData} + end. + +caller(doc) -> + []; +caller(suite) -> + []; +caller(Config) when is_list(Config) -> + ?line run_caller_test(Config, false), + ?line run_caller_test(Config, true). + +run_caller_test(Config, Outputv) -> + ?line Drv = 'caller_drv', + ?line Cmd = case Outputv of + true -> + ?line os:putenv("CALLER_DRV_USE_OUTPUTV", + "true"), + outputv; + false -> + ?line os:putenv("CALLER_DRV_USE_OUTPUTV", + "false"), + output + end, + ?line ok = load_driver(?config(data_dir, Config), Drv), + ?line Port = open_port({spawn, Drv}, []), + ?line true = is_port(Port), + ?line chk_caller(Port, start, self()), + ?line chk_caller(Port, + Cmd, + spawn_link( + fun () -> + port_command(Port, "") + end)), + ?line Port ! {self(), {command, ""}}, + ?line chk_caller(Port, Cmd, self()), + ?line chk_caller(Port, + control, + spawn_link( + fun () -> + port_control(Port, 0, "") + end)), + ?line chk_caller(Port, + call, + spawn_link( + fun () -> + erlang:port_call(Port, 0, "") + end)), + ?line true = port_close(Port), + ?line erl_ddll:unload_driver(Drv), + ?line ok. + +chk_caller(Port, Callback, ExpectedCaller) -> + receive + {caller, Port, Callback, Caller} -> + ExpectedCaller = Caller + end. + +many_events(suite) -> + []; +many_events(doc) -> + ["Check that many simultaneously signalled events work (win32)"]; +many_events(Config) when is_list(Config) -> + ?line Name = 'many_events_drv', + ?line Port = start_driver(Config, Name, false), + Number = "1000", + Port ! {self(), {command, Number}}, + receive + {Port, {data,Number}} -> + ?line receive %% Just to make sure the emulator does not crash + %% after this case is run (if faulty) + after 2000 -> + ok + end + after 1000 -> + ?line exit(the_driver_does_not_respond) + end, + ?line stop_driver(Port, Name), + ?line ok. + + +missing_callbacks(doc) -> + []; +missing_callbacks(suite) -> + []; +missing_callbacks(Config) when is_list(Config) -> + ?line Name = 'missing_callback_drv', + ?line Port = start_driver(Config, Name, false), + + ?line Port ! {self(), {command, "tjenix"}}, + ?line true = erlang:port_command(Port, "halloj"), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(Port, 4711, "mors")), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_call(Port, 17, "hej")), + + ?line %% Give the (non-existing) ready_output(), ready_input(), event(), + ?line %% and timeout() some time to be called. + ?line receive after 1000 -> ok end, + + ?line stop_driver(Port, Name), + ?line ok. + +smp_select(doc) -> + ["Test concurrent calls to driver_select."]; +smp_select(suite) -> + []; +smp_select(Config) when is_list(Config) -> + case os:type() of + {win32,_} -> {skipped, "Test not implemented for this OS"}; + _ -> smp_select0(Config) + end. + +smp_select0(Config) -> + ?line DrvName = 'chkio_drv', + Path = ?config(data_dir, Config), + erl_ddll:start(), + ?line ok = load_driver(Path, DrvName), + Master = self(), + ProcFun = fun()-> io:format("Worker ~p starting\n",[self()]), + ?line Port = open_port({spawn, DrvName}, []), + smp_select_loop(Port, 100000), + sleep(500), % wait for driver to handle pending events + ?line true = erlang:port_close(Port), + Master ! {ok,self()}, + io:format("Worker ~p finished\n",[self()]) + end, + ?line Pids = lists:map(fun(_) -> spawn_link(ProcFun) end, + lists:seq(1,4)), + TimeoutMsg = make_ref(), + {ok,TRef} = timer:send_after(5*1000, TimeoutMsg), % Limit test duration on slow machines + smp_select_wait(Pids, TimeoutMsg), + timer:cancel(TRef), + ?line ok = erl_ddll:unload_driver(DrvName), + ?line ok = erl_ddll:stop(), + ok. + +smp_select_loop(_, 0) -> + ok; +smp_select_loop(Port, N) -> + ?line "ok" = erlang:port_control(Port, ?CHKIO_SMP_SELECT, []), + receive + stop -> + io:format("Worker ~p stopped with ~p laps left\n",[self(), N]), + ok + after 0 -> + smp_select_loop(Port, N-1) + end. + +smp_select_wait([], _) -> + ok; +smp_select_wait(Pids, TimeoutMsg) -> + receive + {ok,Pid} when is_pid(Pid) -> + smp_select_wait(lists:delete(Pid,Pids), TimeoutMsg); + TimeoutMsg -> + lists:foreach(fun(Pid)-> Pid ! stop end, + Pids), + smp_select_wait(Pids, TimeoutMsg) + end. + + +driver_select_use(doc) -> + ["Test driver_select() with new ERL_DRV_USE flag."]; +driver_select_use(suite) -> + []; +driver_select_use(Config) when is_list(Config) -> + case os:type() of + {win32,_} -> {skipped, "Test not implemented for this OS"}; + _ -> driver_select_use0(Config) + end. + +driver_select_use0(Config) -> + ?line DrvName = 'chkio_drv', + Path = ?config(data_dir, Config), + erl_ddll:start(), + ?line ok = load_driver(Path, DrvName), + ?line Port = open_port({spawn, DrvName}, []), + ?line "ok" = erlang:port_control(Port, ?CHKIO_DRV_USE, []), + ?line {Port,{data,"TheEnd"}} = receive Msg -> Msg + after 10000 -> timeout end, + ?line true = erlang:port_close(Port), + ?line ok = erl_ddll:unload_driver(DrvName), + ?line ok = erl_ddll:stop(), + ok. + +thread_mseg_alloc_cache_clean(Config) when is_list(Config) -> + case {erlang:system_info(threads), + erlang:system_info({allocator,mseg_alloc}), + driver_alloc_sbct()} of + {_, false, _} -> + ?line {skipped, "No mseg_alloc"}; + {false, _, _} -> + ?line {skipped, "No threads"}; + {_, _, false} -> + ?line {skipped, "driver_alloc() not using the alloc_util framework"}; + {_, _, SBCT} when is_integer(SBCT), SBCT > 10*1024*1024 -> + ?line {skipped, "driver_alloc() using too large single block threshold"}; + {_, _, 0} -> + ?line {skipped, "driver_alloc() using too low single block threshold"}; + {true, MsegAllocInfo, SBCT} -> + ?line DrvName = 'thr_alloc_drv', + ?line Path = ?config(data_dir, Config), + ?line erl_ddll:start(), + ?line ok = load_driver(Path, DrvName), + ?line Port = open_port({spawn, DrvName}, []), + ?line CCI = mseg_alloc_cci(MsegAllocInfo), + ?line ?t:format("CCI = ~p~n", [CCI]), + ?line CCC = mseg_alloc_ccc(), + ?line ?t:format("CCC = ~p~n", [CCC]), + ?line thread_mseg_alloc_cache_clean_test(Port, + 10, + CCI, + SBCT+100), + ?line true = erlang:port_close(Port), + ?line ok = erl_ddll:unload_driver(DrvName), + ?line ok = erl_ddll:stop(), + ?line ok + end. + +mseg_alloc_cci(MsegAllocInfo) -> + ?line {value,{options, OL}} + = lists:keysearch(options, 1, MsegAllocInfo), + ?line {value,{cci,CCI}} = lists:keysearch(cci,1,OL), + ?line CCI. + +mseg_alloc_ccc() -> + mseg_alloc_ccc(erlang:system_info({allocator,mseg_alloc})). + +mseg_alloc_ccc(MsegAllocInfo) -> + ?line {value,{calls, CL}} + = lists:keysearch(calls, 1, MsegAllocInfo), + ?line {value,{mseg_check_cache, GigaCCC, CCC}} + = lists:keysearch(mseg_check_cache, 1, CL), + ?line GigaCCC*1000000000 + CCC. + +mseg_alloc_cached_segments() -> + mseg_alloc_cached_segments(erlang:system_info({allocator,mseg_alloc})). + +mseg_alloc_cached_segments(MsegAllocInfo) -> + ?line {value,{status, SL}} + = lists:keysearch(status, 1, MsegAllocInfo), + ?line {value,{cached_segments, CS}} + = lists:keysearch(cached_segments, 1, SL), + ?line CS. + +driver_alloc_sbct() -> + {_, _, _, As} = erlang:system_info(allocator), + case lists:keysearch(driver_alloc, 1, As) of + {value,{driver_alloc,DAOPTs}} -> + case lists:keysearch(sbct, 1, DAOPTs) of + {value,{sbct,SBCT}} -> + SBCT; + _ -> + false + end; + _ -> + false + end. + +thread_mseg_alloc_cache_clean_test(_Port, 0, _CCI, _Size) -> + ?line ok; +thread_mseg_alloc_cache_clean_test(Port, N, CCI, Size) -> + ?line wait_until(fun () -> 0 == mseg_alloc_cached_segments() end), + ?line receive after CCI+500 -> ok end, + ?line OCCC = mseg_alloc_ccc(), + ?line "ok" = erlang:port_control(Port, 0, integer_to_list(Size)), + ?line receive after CCI+500 -> ok end, + ?line CCC = mseg_alloc_ccc(), + ?line ?t:format("CCC = ~p~n", [CCC]), + ?line true = CCC > OCCC, + ?line thread_mseg_alloc_cache_clean_test(Port, N-1, CCI, Size). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Utilities +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +wait_until(Fun) -> + case Fun() of + true -> ok; + false -> + receive after 100 -> ok end, + wait_until(Fun) + end. + +drv_vsn_str2tup(Str) -> + [Major, Minor] = string:tokens(Str, "."), + {list_to_integer(Major), list_to_integer(Minor)}. + +%% Build port data from a template. + +build_data({bin,Size}) -> build_binary(Size); +build_data({list,Size}) -> build_list(Size); +build_data(int) -> random_char(); +build_data([]) -> []; +build_data([H|T]) -> [build_data(H)|build_data(T)]. + +%% Transform all binaries in a term. + +transform_bins(_Transform, []) -> []; +transform_bins(Transform, [H|T]) -> + [transform_bins(Transform, H)|transform_bins(Transform, T)]; +transform_bins(Transform, Tuple) when is_tuple(Tuple) -> + list_to_tuple([transform_bins(Transform, E) || E <- tuple_to_list(Tuple)]); +transform_bins(Transform, Bin) when is_binary(Bin) -> + Transform(Bin); +transform_bins(_Transform, Other) -> Other. + + +%% Convert all binaries in a term to sub binaries. + +make_sub_binaries(Term) -> + MakeSub = fun(Bin0) -> + Bin1 = <<243:8,0:3,Bin0/binary,31:5,19:8>>, + Sz = size(Bin0), + <<243:8,0:3,Bin:Sz/binary,31:5,19:8>> = id(Bin1), + Bin + end, + transform_bins(MakeSub, Term). + +id(I) -> I. + +%% Convert all binaries in a term to refc binaries. + +make_refc_binaries(Term) -> + F = fun(B0) -> list_to_binary([build_binary(?heap_binary_size+1),B0]) end, + transform_bins(F, Term). + +build_binary(Elements) -> + list_to_binary(build_list(Elements)). + +build_list(Elements) -> build_list(Elements, []). + +build_list(0, Acc) -> Acc; +build_list(Elements, Acc) -> build_list(Elements-1, [random_char()|Acc]). + + +%% Convert all binaries in a list to writable binaries. + +make_writable_binaries(Term) -> + transform_bins(fun(Bin) -> <> end, Term). + +append_to_writable_binaries(Term) -> + transform_bins(fun(Bin) -> <> end, Term). + +random_char() -> + uniform(256) - 1. + +uniform(N) -> + case get(random_seed) of + undefined -> + {X, Y, Z} = time(), + random:seed(X, Y, Z); + _ -> + ok + end, + random:uniform(N). + +%% return millisecs from statistics source +erl_millisecs() -> + {Ms, S, Us} = erlang:now(), + Ms * 1000000000 + S * 1000 + Us / 1000. + +erl_millisecs({Ms,S,Us}) -> + Ms * 1000000000 + S * 1000 + Us / 1000. + +%% Start/stop drivers. +start_driver(Config, Name, Binary) -> + Path = ?config(data_dir, Config), + erl_ddll:start(), + + %% Load the driver + ok = load_driver(Path, Name), + + %% open port. + case Binary of + true -> + open_port({spawn, Name}, [binary]); + false -> + open_port({spawn, Name}, []) + end. + +stop_driver(Port, Name) -> + ?line true = erlang:port_close(Port), + receive + {Port,Message} -> + ?t:fail({strange_message_from_port,Message}) + after 0 -> + ok + end, + + %% Unload the driver. + ok = erl_ddll:unload_driver(Name), + ?line ok = erl_ddll:stop(). + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. + +sleep() -> + receive after infinity -> ok end. + +sleep(infinity) -> + sleep(); +sleep(Ms) when is_integer(Ms), Ms >= 0 -> + receive after Ms -> ok end. + + +start_node(Config) when is_list(Config) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {A, B, C} = now(), + ?line Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)), + ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). + +stop_node(Node) -> + ?t:stop_node(Node). diff --git a/erts/emulator/test/driver_SUITE_data/Makefile.src b/erts/emulator/test/driver_SUITE_data/Makefile.src new file mode 100644 index 0000000000..4ac7987d2f --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/Makefile.src @@ -0,0 +1,33 @@ + +MISC_DRVS = outputv_drv@dll@ \ + timer_drv@dll@ \ + queue_drv@dll@ \ + io_ready_exit_drv@dll@ \ + chkio_drv@dll@ \ + monitor_drv@dll@ \ + ioq_exit_drv@dll@ \ + peek_non_existing_queue_drv@dll@ \ + otp_6879_drv@dll@ \ + caller_drv@dll@ \ + many_events_drv@dll@ \ + missing_callback_drv@dll@ \ + thr_alloc_drv@dll@ + +SYS_INFO_DRVS = sys_info_1_0_drv@dll@ \ + sys_info_1_1_drv@dll@ \ + sys_info_curr_drv@dll@ + +VSN_MISMATCH_DRVS = zero_extended_marker_garb_drv@dll@ \ + invalid_extended_marker_drv@dll@ \ + larger_major_vsn_drv@dll@ \ + larger_minor_vsn_drv@dll@ \ + smaller_major_vsn_drv@dll@ \ + smaller_minor_vsn_drv@dll@ + +all: $(MISC_DRVS) $(SYS_INFO_DRVS) $(VSN_MISMATCH_DRVS) + +@SHLIB_RULES@ + +$(SYS_INFO_DRVS): sys_info_drv_impl.h sys_info_drv_impl.c +$(VSN_MISMATCH_DRVS): vsn_mismatch_drv_impl.c + diff --git a/erts/emulator/test/driver_SUITE_data/caller_drv.c b/erts/emulator/test/driver_SUITE_data/caller_drv.c new file mode 100644 index 0000000000..a78d51966f --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/caller_drv.c @@ -0,0 +1,134 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include +#include +#include "erl_driver.h" + +static ErlDrvData start(ErlDrvPort port, + char *command); +static void output(ErlDrvData drv_data, + char *buf, int len); +static void outputv(ErlDrvData drv_data, + ErlIOVec *ev); +static int control(ErlDrvData drv_data, + unsigned int command, char *buf, + int len, char **rbuf, int rlen); +static int call(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen, + unsigned int *flags); + +static ErlDrvEntry caller_drv_entry = { + NULL /* init */, + start, + NULL /* stop */, + output, + NULL /* ready_input */, + NULL /* ready_output */, + "caller_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + outputv, + NULL /* ready_async */, + NULL /* flush */, + call, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(caller_drv) +{ + char buf[10]; + size_t bufsz = sizeof(buf); + char *use_outputv; + use_outputv = (erl_drv_getenv("CALLER_DRV_USE_OUTPUTV", buf, &bufsz) == 0 + ? buf + : "false"); + if (strcmp(use_outputv, "true") != 0) + caller_drv_entry.outputv = NULL; + return &caller_drv_entry; +} + +void +send_caller(ErlDrvData drv_data, char *func) +{ + int res; + ErlDrvPort port = (ErlDrvPort) drv_data; + ErlDrvTermData msg[] = { + ERL_DRV_ATOM, driver_mk_atom("caller"), + ERL_DRV_PORT, driver_mk_port(port), + ERL_DRV_ATOM, driver_mk_atom(func), + ERL_DRV_PID, driver_caller(port), + ERL_DRV_TUPLE, (ErlDrvTermData) 4 + }; + res = driver_output_term(port, msg, sizeof(msg)/sizeof(ErlDrvTermData)); + if (res <= 0) + driver_failure_atom(port, "driver_output_term failed"); +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + send_caller((ErlDrvData) port, "start"); + return (ErlDrvData) port; +} + +static void +output(ErlDrvData drv_data, char *buf, int len) +{ + send_caller(drv_data, "output"); +} + +static void +outputv(ErlDrvData drv_data, ErlIOVec *ev) +{ + send_caller(drv_data, "outputv"); +} + +static int +control(ErlDrvData drv_data, + unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + send_caller(drv_data, "control"); + return 0; +} + +static int +call(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen, + unsigned int *flags) +{ + /* echo call */ + if (len > rlen) + *rbuf = driver_alloc(len); + memcpy((void *) *rbuf, (void *) buf, len); + send_caller(drv_data, "call"); + return len; +} diff --git a/erts/emulator/test/driver_SUITE_data/chkio_drv.c b/erts/emulator/test/driver_SUITE_data/chkio_drv.c new file mode 100644 index 0000000000..9e1e5e72c2 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/chkio_drv.c @@ -0,0 +1,1575 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#ifndef UNIX +#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#define UNIX 1 +#endif +#endif + +#ifdef UNIX +#include +#include +#include /* rand */ +#include +#include +#include +#include +#include +#ifdef HAVE_POLL_H +# include +#endif +#endif /* UNIX */ + +#include "erl_driver.h" + +#define CHKIO_STOP 0 +#define CHKIO_USE_FALLBACK_POLLSET 1 +#define CHKIO_BAD_FD_IN_POLLSET 2 +#define CHKIO_DRIVER_EVENT 3 +#define CHKIO_FD_CHANGE 4 +#define CHKIO_STEAL 5 +#define CHKIO_STEAL_AUX 6 +#define CHKIO_SMP_SELECT 7 +#define CHKIO_DRV_USE 8 + +#define CHKIO_FALLBACK_FDS 10 + +#define TRACEF(x) /*erts_printf x*/ + +#ifdef UNIX +typedef struct { + int fd; + int cnt; +} ChkioFallbackFd; + +typedef struct { + ChkioFallbackFd dev_null[CHKIO_FALLBACK_FDS]; + ChkioFallbackFd dev_zero[CHKIO_FALLBACK_FDS]; + ChkioFallbackFd pipe_in[CHKIO_FALLBACK_FDS]; + ChkioFallbackFd pipe_out[CHKIO_FALLBACK_FDS]; +} ChkioFallbackData; + +typedef struct { + int in_fd; + struct erl_drv_event_data in_data; + int in_ok; + int out_fd; + struct erl_drv_event_data out_data; + int out_ok; +} ChkioDriverEvent; + +typedef struct { + int fds[2]; + int same_fd; +} ChkioFdChange; + +typedef struct { + int fds[2]; +} ChkioBadFdInPollset; + +typedef struct { + int driver_select_fds[2]; + int driver_event_fds[2]; + struct erl_drv_event_data event_data[2]; +} ChkioSteal; + +typedef struct { + int driver_select_fds[2]; + int driver_event_fds[2]; + struct erl_drv_event_data event_data[2]; +} ChkioStealAux; + + +typedef struct chkio_smp_select { + struct chkio_smp_select* next; + int read_fd; + int write_fd; + int next_read; + int next_write; + enum {Closed, Opened, Selected, Waiting} state; + int wasSelected; + unsigned rand_state; +}ChkioSmpSelect; + +ChkioSmpSelect* smp_pipes; +unsigned smp_pipes_cnt; +ErlDrvMutex* smp_pipes_mtx; + +typedef struct { + int script_line; + int fd_in; + int fd_out; + int fd_pipe[2]; + volatile int fd_stop_select; + int timeouts_left; + void* expected_callback; + int expected_fd; +}ChkioDrvUse; +static ChkioDrvUse drv_use_singleton; + +typedef struct { + ErlDrvPort port; + ErlDrvTermData id; + int test; + void *test_data; +} ChkioDrvData; + + +#endif /* UNIX */ + +static int chkio_drv_init(void); +static void chkio_drv_finish(void); +static ErlDrvData chkio_drv_start(ErlDrvPort, char *); +static void chkio_drv_stop(ErlDrvData); +static void chkio_drv_ready_input(ErlDrvData, ErlDrvEvent); +static void chkio_drv_ready_output(ErlDrvData, ErlDrvEvent); +static void chkio_drv_ready_event(ErlDrvData, ErlDrvEvent, ErlDrvEventData); +static int chkio_drv_control(ErlDrvData, unsigned int, + char *, int, char **, int); +static void chkio_drv_timeout(ErlDrvData); +static void chkio_drv_stop_select(ErlDrvEvent, void*); + + +static ErlDrvEntry chkio_drv_entry = { + chkio_drv_init, + chkio_drv_start, + chkio_drv_stop, + NULL, /* output */ + chkio_drv_ready_input, + chkio_drv_ready_output, + "chkio_drv", + chkio_drv_finish, + NULL, /* handle */ + chkio_drv_control, + chkio_drv_timeout, + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + chkio_drv_ready_event, + + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL,/* void *handle2 */ + NULL,/* process_exit */ + chkio_drv_stop_select +}; + + +#ifdef UNIX + +static void chkio_drv_use(ChkioDrvData *cddp, void* callback); + +static void +stop_use_fallback_pollset(ChkioDrvData *cddp) +{ + int i; + ChkioFallbackData *cbdp = (ChkioFallbackData *) cddp->test_data; + if (cbdp) { + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + if (cbdp->dev_null[i].fd >= 0) { + if (driver_select(cddp->port, + (ErlDrvEvent) cbdp->dev_null[i].fd, + DO_WRITE, + 0) != 0) { + fprintf(stderr, + "%s:%d: Failed to deselect dev_null fd=%d\n", + __FILE__, __LINE__, cbdp->dev_null[i].fd); + abort(); + } + close(cbdp->dev_null[i].fd); + } + if (cbdp->dev_zero[i].fd >= 0) { + if (driver_select(cddp->port, + (ErlDrvEvent) cbdp->dev_zero[i].fd, + DO_READ, + 0) != 0) { + fprintf(stderr, + "%s:%d: Failed to deselct dev_zero fd=%d\n", + __FILE__, __LINE__, cbdp->dev_zero[i].fd); + abort(); + } + close(cbdp->dev_zero[i].fd); + } + if (cbdp->pipe_in[i].fd >= 0) { + if (driver_select(cddp->port, + (ErlDrvEvent) cbdp->pipe_in[i].fd, + DO_READ, + 0) != 0) { + fprintf(stderr, + "%s:%d: Failed to deselect pipe_in fd=%d\n", + __FILE__, __LINE__, cbdp->pipe_in[i].fd); + abort(); + } + close(cbdp->pipe_in[i].fd); + } + if (cbdp->pipe_out[i].fd >= 0) { + if (driver_select(cddp->port, + (ErlDrvEvent) cbdp->pipe_out[i].fd, + DO_WRITE, + 0) != 0) { + fprintf(stderr, + "%s:%d: Failed to deselect pipe_out fd=%d\n", + __FILE__, __LINE__, cbdp->pipe_out[i].fd); + abort(); + } + close(cbdp->pipe_out[i].fd); + } + } + driver_free((void *) cbdp); + cddp->test_data = NULL; + } + cddp->test = CHKIO_STOP; +} + +static void +stop_driver_event(ChkioDrvData *cddp) +{ + if (cddp->test_data) { + ChkioDriverEvent *cdep = cddp->test_data; + cddp->test_data = NULL; + + if (cdep->in_fd >= 0) { + driver_event(cddp->port, (ErlDrvEvent) cdep->in_fd, NULL); + close(cdep->in_fd); + } + if (cdep->out_fd >= 0) { + driver_event(cddp->port, (ErlDrvEvent) cdep->out_fd, NULL); + close(cdep->out_fd); + } + driver_free(cdep); + } +} + +static void +stop_fd_change(ChkioDrvData *cddp) +{ + if (cddp->test_data) { + ChkioFdChange *cfcp = (ChkioFdChange *) cddp->test_data; + cddp->test_data = NULL; + driver_cancel_timer(cddp->port); + if (cfcp->fds[0] >= 0) { + driver_select(cddp->port, (ErlDrvEvent) cfcp->fds[0], DO_READ, 0); + close(cfcp->fds[0]); + close(cfcp->fds[1]); + } + driver_free((void *) cfcp); + } +} + +static void +stop_bad_fd_in_pollset(ChkioDrvData *cddp) +{ + if (cddp->test_data) { + ChkioBadFdInPollset *bfipp = (ChkioBadFdInPollset *) cddp->test_data; + cddp->test_data = NULL; + driver_select(cddp->port, (ErlDrvEvent) bfipp->fds[0], DO_WRITE, 0); + driver_select(cddp->port, (ErlDrvEvent) bfipp->fds[1], DO_READ, 0); + driver_free((void *) bfipp); + } +} + +static void +stop_steal(ChkioDrvData *cddp) +{ + if (cddp->test_data) { + ChkioSteal *csp = cddp->test_data; + cddp->test_data = NULL; + if (csp->driver_select_fds[0] >= 0) + driver_select(cddp->port, + (ErlDrvEvent) csp->driver_select_fds[0], + DO_READ, + 0); + if (csp->driver_select_fds[1] >= 0) + driver_select(cddp->port, + (ErlDrvEvent) csp->driver_select_fds[1], + DO_WRITE, + 0); + if (csp->driver_event_fds[0] >= 0) + driver_event(cddp->port, + (ErlDrvEvent) csp->driver_event_fds[0], + NULL); + if (csp->driver_event_fds[1] >= 0) + driver_event(cddp->port, + (ErlDrvEvent) csp->driver_event_fds[1], + NULL); + driver_free(csp); + } +} + +static void +stop_steal_aux(ChkioDrvData *cddp) +{ + if (cddp->test_data) { + ChkioStealAux *csap = cddp->test_data; + cddp->test_data = NULL; + if (csap->driver_select_fds[0] >= 0) + close(csap->driver_select_fds[0]); + if (csap->driver_select_fds[1] >= 0) + close(csap->driver_select_fds[1]); + if (csap->driver_event_fds[0] >= 0) + close(csap->driver_event_fds[0]); + if (csap->driver_event_fds[1] >= 0) + close(csap->driver_event_fds[1]); + driver_free(csap); + } +} + +static void free_smp_select(ChkioSmpSelect* pip, ErlDrvPort port) +{ + switch (pip->state) { + case Waiting: { + int word; + fprintf(stderr, "Closing pipe in state Waiting. Event lost?\n"); + for (;;) { + int bytes = read(pip->read_fd, &word, sizeof(word)); + if (bytes != sizeof(word)) { + if (bytes != 0) { + fprintf(stderr, "Failed to read from pipe, bytes=%d, errno=%d\n", bytes, errno); + } + break; + } + fprintf(stderr, "Read from pipe: %d\n", word); + } + abort(); + } + case Selected: + driver_select(port, (ErlDrvEvent)pip->read_fd, DO_READ, 0); + /*fall through*/ + case Opened: + close(pip->read_fd); + close(pip->write_fd); + pip->state = Closed; + break; + } + driver_free(pip); +} + +static void +stop_smp_select(ChkioDrvData *cddp) +{ + ChkioSmpSelect* pip = (ChkioSmpSelect*)cddp->test_data; + if (pip) free_smp_select(pip, cddp->port); + erl_drv_mutex_lock(smp_pipes_mtx); + if (smp_pipes_cnt > 0 && --smp_pipes_cnt == 0) { + while (smp_pipes) { + ChkioSmpSelect* next = smp_pipes->next; + free_smp_select(smp_pipes, cddp->port); + smp_pipes = next; + } + } + erl_drv_mutex_unlock(smp_pipes_mtx); +} + +#endif /* UNIX */ + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(chkio_drv) +{ + return &chkio_drv_entry; +} + + +static int +chkio_drv_init(void) +{ +#ifdef UNIX + smp_pipes_mtx = erl_drv_mutex_create("smp_pipes_mtx"); +#endif + return 0; +} + +static void +chkio_drv_finish(void) +{ +#ifdef UNIX + erl_drv_mutex_destroy(smp_pipes_mtx); +#endif +} + + +static ErlDrvData +chkio_drv_start(ErlDrvPort port, char *command) +{ +#ifndef UNIX + return NULL; +#else + ChkioDrvData *cddp = driver_alloc(sizeof(ChkioDrvData)); + if (!cddp) { + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + cddp->port = port; + cddp->id = driver_mk_port(port); + cddp->test = CHKIO_STOP; + cddp->test_data = NULL; + return (ErlDrvData) cddp; +#endif +} + +static void +chkio_drv_stop(ErlDrvData drv_data) { +#ifdef UNIX + int fd; + ChkioDrvData *cddp = (ChkioDrvData *) drv_data; + + switch (cddp->test) { + case CHKIO_STOP: + break; + case CHKIO_USE_FALLBACK_POLLSET: + stop_use_fallback_pollset(cddp); + break; + case CHKIO_BAD_FD_IN_POLLSET: + stop_bad_fd_in_pollset(cddp); + break; + case CHKIO_DRIVER_EVENT: + stop_driver_event(cddp); + break; + case CHKIO_FD_CHANGE: + stop_fd_change(cddp); + break; + case CHKIO_STEAL: + stop_steal(cddp); + break; + case CHKIO_STEAL_AUX: + stop_steal_aux(cddp); + break; + case CHKIO_SMP_SELECT: + stop_smp_select(cddp); + break; + case CHKIO_DRV_USE: + chkio_drv_use(cddp, chkio_drv_stop); + break; + default: + fprintf(stderr, "%s:%d: Invalid state\n", __FILE__, __LINE__); + abort(); + break; + } + cddp->test = CHKIO_STOP; + + /* Make sure erts_poll() will handle update requests soon */ + fd = open("/dev/null", O_WRONLY); + if (fd < 0) { + fprintf(stderr, "%s:%d: Failed to open /dev/null\n", + __FILE__, __LINE__); + } + driver_select(cddp->port, (ErlDrvEvent) fd, DO_WRITE, 1); + driver_select(cddp->port, (ErlDrvEvent) fd, DO_WRITE, 0); + close(fd); + + + driver_free((void *) cddp); + +#endif +} + + +static void +chkio_drv_ready_output(ErlDrvData drv_data, ErlDrvEvent event) +{ +#ifdef UNIX + ChkioDrvData *cddp = (ChkioDrvData *) drv_data; + int fd = (int) event; + + switch (cddp->test) { + case CHKIO_USE_FALLBACK_POLLSET: { + int i; + int fd_found = 0; + ChkioFallbackData *cbdp = (ChkioFallbackData *) cddp->test_data; + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + if (cbdp->dev_null[i].fd == fd) { + cbdp->dev_null[i].cnt++; + fd_found = 1; + break; + } + if (cbdp->pipe_out[i].fd == fd) { + cbdp->pipe_out[i].cnt++; + fd_found = 1; + break; + } + } + if (!fd_found) + driver_failure_atom(cddp->port, "output_fd_not_found"); + break; + } + case CHKIO_STEAL: + break; + case CHKIO_STEAL_AUX: + break; + case CHKIO_DRV_USE: + chkio_drv_use(cddp, chkio_drv_ready_output); + break; + default: + driver_failure_atom(cddp->port, "unexpected_ready_output"); + break; + } +#endif +} + +static void +chkio_drv_ready_input(ErlDrvData drv_data, ErlDrvEvent event) +{ +#ifdef UNIX + ChkioDrvData *cddp = (ChkioDrvData *) drv_data; + int fd = (int) event; + + switch (cddp->test) { + case CHKIO_USE_FALLBACK_POLLSET: { + int i; + int fd_found = 0; + ChkioFallbackData *cbdp = (ChkioFallbackData *) cddp->test_data; + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + if (cbdp->dev_zero[i].fd == fd) { + cbdp->dev_zero[i].cnt++; + fd_found = 1; + break; + } + if (cbdp->pipe_in[i].fd == fd) { + cbdp->pipe_in[i].cnt++; + fd_found = 1; + break; + } + } + if (!fd_found) + driver_failure_atom(cddp->port, "input_fd_not_found"); + break; + } + case CHKIO_STEAL: + break; + case CHKIO_STEAL_AUX: + break; + case CHKIO_SMP_SELECT: { + ChkioSmpSelect* pip = (ChkioSmpSelect*) cddp->test_data; + int word=123456, bytes; + unsigned inPipe, n; + if (pip == NULL) { + printf("Read event on uninitiated pipe %d\n", fd); + abort(); + } + if (pip->state != Selected && pip->state != Waiting) { + printf("Read event on pipe in strange state %d\n", pip->state); + abort(); + } + + TRACEF(("Got read event on fd=%d, state=%d\n", fd, pip->state)); + + inPipe = (pip->next_write - pip->next_read); + if (inPipe == 0) { + bytes = read(pip->read_fd, &word, sizeof(word)); + printf("Unexpected empty pipe, expected %u -> %u, bytes=%d, word=%d\n", + pip->next_read, pip->next_write-1, bytes, word); + abort(); + } + + n = rand_r(&pip->rand_state) % (inPipe*4); + if (n > inPipe) n = inPipe; + TRACEF(("Read %u of %u words in pipe\n", n, inPipe)); + for (; n; n--) { + bytes = read(pip->read_fd, &word, sizeof(word)); + if (bytes != sizeof(word)) { + printf("Failed to read from pipe, ret=%u errno=%d\n", bytes, errno); + abort(); + } + if (word != pip->next_read) { + printf("Unexpected word in pipe %d, expected %d\n", word, pip->next_read); + abort(); + } + TRACEF(("Read %d from fd=%d\n", word, fd)); + pip->next_read++; + } + pip->state = Selected; /* not Waiting anymore */ + break; + } + case CHKIO_DRV_USE: + chkio_drv_use(cddp, chkio_drv_ready_input); + break; + default: + driver_failure_atom(cddp->port, "unexpected_ready_input"); + break; + } +#endif +} + +static void +chkio_drv_ready_event(ErlDrvData drv_data, + ErlDrvEvent event, + ErlDrvEventData event_data) +{ +#ifdef UNIX + ChkioDrvData *cddp = (ChkioDrvData *) drv_data; + switch (cddp->test) { + case CHKIO_DRIVER_EVENT: { +#ifdef HAVE_POLL_H + ChkioDriverEvent *cdep = cddp->test_data; + int fd = (int) event; + if (fd == cdep->in_fd) { + if (event_data->events == POLLIN + && event_data->revents == POLLIN) { + cdep->in_ok++; + } + else { + driver_failure_atom(cddp->port, "invalid_input_fd_events"); + } + break; + } + if (fd == cdep->out_fd) { + if (event_data->events == POLLOUT + && event_data->revents == POLLOUT) { + cdep->out_ok++; + } + else { + driver_failure_atom(cddp->port, "invalid_output_fd_events"); + } + break; + } +#endif + } + case CHKIO_STEAL: +#ifdef HAVE_POLL_H + break; +#endif + case CHKIO_STEAL_AUX: +#ifdef HAVE_POLL_H + break; +#endif + default: + driver_failure_atom(cddp->port, "unexpected_ready_event"); + break; + } +#endif /* UNIX */ +} + +static void +chkio_drv_timeout(ErlDrvData drv_data) +{ +#ifdef UNIX + ChkioDrvData *cddp = (ChkioDrvData *) drv_data; + switch (cddp->test) { + case CHKIO_FD_CHANGE: { + ChkioFdChange *cfcp = cddp->test_data; + int in_fd = cfcp->fds[0]; + int out_fd = cfcp->fds[1]; + if (in_fd >= 0) { + if (driver_select(cddp->port, (ErlDrvEvent) in_fd, DO_READ, 0) < 0) + driver_failure_atom(cddp->port, "deselect_failed"); + (void) write(out_fd, (void *) "!", 1); + close(out_fd); + close(in_fd); + } + if (pipe(cfcp->fds) < 0) { + driver_failure_posix(cddp->port, errno); + } + else { + if (driver_select(cddp->port, (ErlDrvEvent) cfcp->fds[0], + DO_READ, 1) < 0) + driver_failure_atom(cddp->port, "select_failed"); + if (cfcp->fds[0] == in_fd) + cfcp->same_fd++; + if (driver_set_timer(cddp->port, 10) < 0) + driver_failure_atom(cddp->port, "set_timer_failed"); + } + break; + } + case CHKIO_DRV_USE: + chkio_drv_use(cddp, chkio_drv_timeout); + break; + default: + driver_failure_atom(cddp->port, "unexpected_driver_timeout"); + break; + } +#endif /* UNIX */ +} + +static int +chkio_drv_control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + char *res_str; + int res_len = -1; +#ifndef UNIX +#ifdef __WIN32__ + res_str = "skip: windows_different"; +#else + res_str = "nyiftos"; +#endif +#else + ChkioDrvData *cddp = (ChkioDrvData *) drv_data; + res_len = 0; + switch (command) { + case CHKIO_STOP: { + + /* + * --- STOP BEGIN --------------------------------------------------- + */ + switch (cddp->test) { + case CHKIO_STOP: + driver_failure_atom(cddp->port, "stop_when_stopped"); + break; + case CHKIO_USE_FALLBACK_POLLSET: { + char *c; + int i; + ChkioFallbackData *cbdp = (ChkioFallbackData *) cddp->test_data; + c = driver_alloc(sizeof(char)*(4*20+21*CHKIO_FALLBACK_FDS*8)); + if (!c) + return 0; + *rbuf = c; + c += sprintf(c, "/dev/null: "); + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + c += sprintf(c, "%d=%d ", + cbdp->dev_null[i].fd, + cbdp->dev_null[i].cnt); + } + c += sprintf(c, "\n/dev/zero: "); + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + c += sprintf(c, "%d=%d ", + cbdp->dev_zero[i].fd, + cbdp->dev_zero[i].cnt); + } + c += sprintf(c, "\npipe_in: "); + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + c += sprintf(c, "%d=%d ", + cbdp->pipe_in[i].fd, + cbdp->pipe_in[i].cnt); + } + c += sprintf(c, "\npipe_out: "); + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + c += sprintf(c, "%d=%d ", + cbdp->pipe_out[i].fd, + cbdp->pipe_out[i].cnt); + } + c += sprintf(c, "\n"); + res_len = (int) (c - *rbuf); + stop_use_fallback_pollset(cddp); + break; + } + case CHKIO_BAD_FD_IN_POLLSET: + res_str = "ok"; + res_len = -1; + stop_bad_fd_in_pollset(cddp); + break; + case CHKIO_DRIVER_EVENT: { + ChkioDriverEvent *cdep = cddp->test_data; + if (!cdep->in_ok || !cdep->out_ok) { + if (!cdep->in_ok) + driver_failure_atom(cddp->port, "got_no_input_events"); + if (!cdep->out_ok) + driver_failure_atom(cddp->port, "got_no_output_events"); + } + else { + char *c = driver_alloc(sizeof(char)*2*30); + if (!c) + driver_failure_posix(cddp->port, ENOMEM); + *rbuf = c; + res_len = sprintf(c, "in=%d\nout=%d\n", + cdep->in_ok, cdep->out_ok); + } + stop_driver_event(cddp); + break; + } + case CHKIO_FD_CHANGE: { + ChkioFdChange *cfcp = cddp->test_data; + if (!cfcp->same_fd) + driver_failure_atom(cddp->port, "never_same_fd"); + else { + char *c = driver_alloc(sizeof(char)*30); + if (!c) + driver_failure_posix(cddp->port, ENOMEM); + else { + *rbuf = c; + res_len = sprintf(c, "same_fd=%d\n", cfcp->same_fd); + } + } + stop_fd_change(cddp); + break; + } + case CHKIO_STEAL: + stop_steal(cddp); + res_str = "ok"; + res_len = -1; + break; + case CHKIO_STEAL_AUX: + stop_steal_aux(cddp); + res_str = "ok"; + res_len = -1; + break; + default: + driver_failure_atom(cddp->port, "invalid_state"); + break; + } + break; + } + /* + * --- STOP END ----------------------------------------------------- + */ + + case CHKIO_USE_FALLBACK_POLLSET: { + ChkioFallbackData *cbdp = driver_alloc(sizeof(ChkioFallbackData)); + cddp->test_data = (void *) cbdp; + if (!cbdp) + driver_failure_posix(cddp->port, ENOMEM); + else { + int i; + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + cbdp->dev_null[i].fd = -1; + cbdp->dev_null[i].cnt = 0; + cbdp->dev_zero[i].fd = -1; + cbdp->dev_zero[i].cnt = 0; + cbdp->pipe_in[i].fd = -1; + cbdp->pipe_in[i].cnt = 0; + cbdp->pipe_out[i].fd = -1; + cbdp->pipe_out[i].cnt = 0; + } + for (i = 0; i < CHKIO_FALLBACK_FDS; i++) { + int fds[2]; + cbdp->dev_null[i].fd = open("/dev/null", O_WRONLY); + if (driver_select(cddp->port, + (ErlDrvEvent) cbdp->dev_null[i].fd, + DO_WRITE, + 1) != 0) { + driver_failure_posix(cddp->port, errno); + break; + } + cbdp->dev_zero[i].fd = open("/dev/zero", O_RDONLY); + if (driver_select(cddp->port, + (ErlDrvEvent) cbdp->dev_zero[i].fd, + DO_READ, + 1) != 0) { + driver_failure_posix(cddp->port, errno); + break; + } + if (pipe(fds) < 0) + driver_failure_posix(cddp->port, errno); + cbdp->pipe_in[i].fd = fds[0]; + cbdp->pipe_out[i].fd = fds[1]; + if (driver_select(cddp->port, + (ErlDrvEvent) cbdp->pipe_in[i].fd, + DO_READ, + 1) != 0) { + driver_failure_posix(cddp->port, EIO); + break; + } + if (i % 2 == 0) + (void) write(cbdp->pipe_out[i].fd, "!", 1); + if (driver_select(cddp->port, + (ErlDrvEvent) cbdp->pipe_out[i].fd, + DO_WRITE, + 1) != 0) { + driver_failure_posix(cddp->port, EIO); + break; + } + } + res_str = "ok"; + res_len = -1; + } + break; + } + case CHKIO_BAD_FD_IN_POLLSET: { + int i; + int error = 0; + int fds[11]; + for (i = 0; i < 11; i++) + fds[i] = -1; + /* We open a bunch of fds and use the last ones so we decrease the + risk of selecting on a fd that someone else just opened */ + for (i = 0; i < 10; i++) { + fds[i] = open("/dev/null", O_WRONLY); + if (fds[i] < 0) { + error = 1; + driver_failure_posix(cddp->port, errno); + break; + } + } + fds[10] = open("/dev/zero", O_RDONLY); + if (fds[10] < 0) { + error = 1; + driver_failure_posix(cddp->port, errno); + } + for (i = 0; i < 11; i++) { + if (fds[i] >= 0) + close(fds[i]); + } + if (!error) { + ChkioBadFdInPollset *bfipp; + bfipp = driver_alloc(sizeof(ChkioBadFdInPollset)); + if (!bfipp) + driver_failure_posix(cddp->port, ENOMEM); + else { + bfipp->fds[0] = fds[9]; + bfipp->fds[1] = fds[10]; + cddp->test_data = (void *) bfipp; + driver_select(cddp->port, (ErlDrvEvent) fds[9], DO_WRITE, 1); + driver_select(cddp->port, (ErlDrvEvent) fds[10], DO_READ, 1); + } + } + res_str = "ok"; + res_len = -1; + break; + } + case CHKIO_DRIVER_EVENT: { +#ifndef HAVE_POLL_H + res_str = "skip: Need the poll.h header for this test, but it doesn't exist"; + res_len = -1; +#else /* HAVE_POLL_H */ + int in_fd = open("/dev/zero", O_RDONLY); + int out_fd = open("/dev/null", O_WRONLY); + + if (in_fd < 0 || out_fd < 0) { + if (in_fd >= 0) + close(in_fd); + if (out_fd >= 0) + close(out_fd); + driver_failure_posix(cddp->port, errno); + } + else { + ChkioDriverEvent *cdep = driver_alloc(sizeof(ChkioDriverEvent)); + if (!cdep) + driver_failure_posix(cddp->port, ENOMEM); + else { + int res; + cddp->test_data = cdep; + + cdep->in_fd = in_fd; + cdep->in_data.events = POLLIN; + cdep->in_data.revents = 0; + cdep->in_ok = 0; + + res = driver_event(cddp->port, + (ErlDrvEvent) in_fd, + &cdep->in_data); + if (res < 0) { + res_str = "skip: driver_event() not supported"; + res_len = -1; + close(in_fd); + close(out_fd); + cdep->in_fd = -1; + cdep->out_fd = -1; + } + else { + res_str = "ok"; + res_len = -1; + + cdep->out_fd = out_fd; + cdep->out_data.events = POLLOUT; + cdep->out_data.revents = 0; + cdep->out_ok = 0; + + res = driver_event(cddp->port, + (ErlDrvEvent) out_fd, + &cdep->out_data); + if (res < 0) { + close(out_fd); + cdep->out_fd = -1; + driver_failure_atom(cddp->port, "driver_event_failed"); + } + } + + } + } +#endif /* HAVE_POLL_H */ + break; + } + case CHKIO_FD_CHANGE: { + ChkioFdChange *cfcp = driver_alloc(sizeof(ChkioFdChange)); + if (!cfcp) + driver_failure_posix(cddp->port, ENOMEM); + else { + cfcp->fds[0] = -1; + cfcp->fds[1] = -1; + cfcp->same_fd = 0; + cddp->test_data = cfcp; + driver_set_timer(cddp->port, 1); + res_str = "ok"; + res_len = -1; + } + break; + } + case CHKIO_STEAL: { + ChkioSteal *csp = driver_alloc(sizeof(ChkioSteal)); + char *c = driver_alloc(sizeof(char)*len+1); + if (!c || !csp) { + if (c) + driver_free(c); + if (csp) + driver_free(csp); + driver_failure_posix(cddp->port, ENOMEM); + res_str = "error"; + res_len = -1; + } + else { + int driver_event_fds[2]; + int driver_select_fds[2]; + cddp->test_data = csp; + memcpy(c, buf, len); + c[len] = '\0'; + if (sscanf(c, + "fds:%d:%d:%d:%d", + &driver_select_fds[0], + &driver_select_fds[1], + &driver_event_fds[0], + &driver_event_fds[1]) != 4) + driver_failure_atom(cddp->port, "bad_input"); + else { + int res = 0; + if (driver_event_fds[0] < 0) { /* Have no working driver_event() ... */ + csp->driver_select_fds[0] = driver_select_fds[0]; /* In */ + csp->driver_select_fds[1] = driver_select_fds[1]; /* Out */ + csp->driver_event_fds[0] = -1; + csp->driver_event_fds[1] = -1; + } + else { /* Have working driver_event() ... */ +#ifndef HAVE_POLL_H + driver_failure_atom(cddp->port, "unexpected_result"); + res = -1; +#else + csp->driver_select_fds[0] = driver_select_fds[0]; /* In */ + csp->driver_event_fds[1] = driver_select_fds[1]; /* Out */ + csp->driver_event_fds[0] = driver_event_fds[0]; /* In */ + csp->driver_select_fds[1] = driver_event_fds[1]; /* Out */ + + /* Steal with driver_event() */ + + csp->event_data[0].events = POLLIN; + csp->event_data[0].revents = 0; + res = driver_event(cddp->port, + (ErlDrvEvent) csp->driver_event_fds[0], + &csp->event_data[0]); + if (res < 0) + driver_failure_atom(cddp->port, + "driver_event_failed_to_steal"); + if (res >= 0) { + csp->event_data[1].events = POLLOUT; + csp->event_data[1].revents = 0; + res = driver_event(cddp->port, + (ErlDrvEvent) csp->driver_event_fds[1], + &csp->event_data[1]); + if (res < 0) + driver_failure_atom(cddp->port, + "driver_event_failed_to_steal"); + } +#endif + } + + /* Steal with driver_select() */ + if (res >= 0) { + res = driver_select(cddp->port, + (ErlDrvEvent) csp->driver_select_fds[0], + DO_READ, + 1); + if (res < 0) + driver_failure_atom(cddp->port, + "driver_select_failed_to_steal"); + } + if (res >= 0) { + res = driver_select(cddp->port, + (ErlDrvEvent) csp->driver_select_fds[1], + DO_WRITE, + 1); + if (res < 0) + driver_failure_atom(cddp->port, + "driver_select_failed_to_steal"); + } + + res_str = res >= 0 ? "ok" : "error"; + res_len = -1; + } + driver_free(c); + } + break; + } + case CHKIO_STEAL_AUX: { + int read_fds[2]; + int write_fds[2]; + + read_fds[0] = open("/dev/zero", O_RDONLY); + write_fds[0] = open("/dev/null", O_WRONLY); + +#ifdef HAVE_POLL_H + read_fds[1] = open("/dev/zero", O_RDONLY); + write_fds[1] = open("/dev/null", O_WRONLY); +#else + read_fds[1] = -1; + write_fds[1] = -1; +#endif + + if (read_fds[0] < 0 + || write_fds[0] < 0 +#ifdef HAVE_POLL_H + || read_fds[1] < 0 + || write_fds[1] < 0 +#endif + ) { + if (read_fds[0] < 0) + close(read_fds[0]); + if (write_fds[0] < 0) + close(write_fds[0]); +#ifdef HAVE_POLL_H + if (read_fds[1] < 0) + close(read_fds[1]); + if (write_fds[1] < 0) + close(write_fds[1]); +#endif + driver_failure_posix(cddp->port, errno); + } + else { + ChkioStealAux *csap = driver_alloc(sizeof(ChkioStealAux)); + if (!csap) { + driver_failure_posix(cddp->port, ENOMEM); + res_str = "error"; + res_len = -1; + } + else { + int res; + cddp->test_data = csap; + + csap->driver_select_fds[0] = read_fds[0]; + csap->driver_select_fds[1] = write_fds[0]; + + csap->driver_event_fds[0] = read_fds[1]; + csap->driver_event_fds[1] = write_fds[1]; + + res = driver_select(cddp->port, + (ErlDrvEvent) csap->driver_select_fds[0], + DO_READ, + 1); + if (res < 0) + driver_failure_atom(cddp->port, "driver_select_failed"); + if (res >= 0) { + res = driver_select(cddp->port, + (ErlDrvEvent) csap->driver_select_fds[1], + DO_WRITE, + 1); + if (res < 0) + driver_failure_atom(cddp->port, "driver_select_failed"); + } +#ifdef HAVE_POLL_H + if (res >= 0) { + csap->event_data[0].events = POLLIN; + csap->event_data[0].revents = 0; + res = driver_event(cddp->port, + (ErlDrvEvent) csap->driver_event_fds[0], + &csap->event_data[0]); + if (res < 0) { + close(csap->driver_event_fds[0]); + csap->driver_event_fds[0] = -1; + close(csap->driver_event_fds[1]); + csap->driver_event_fds[1] = -1; + res = 0; + } + else { + csap->event_data[1].events = POLLOUT; + csap->event_data[1].revents = 0; + res = driver_event(cddp->port, + (ErlDrvEvent) csap->driver_event_fds[1], + &csap->event_data[1]); + if (res < 0) + driver_failure_atom(cddp->port, + "driver_event_failed"); + } + } +#endif + if (res < 0) { + res_str = "error"; + res_len = -1; + } + else { + char *c = driver_alloc(sizeof(char)*(3+4*21+1)); + if (!c) { + res_str = "error"; + res_len = -1; + driver_failure_posix(cddp->port, ENOMEM); + } + else { + *rbuf = c; + res_len = sprintf(c, + "fds:%d:%d:%d:%d", + csap->driver_select_fds[0], + csap->driver_select_fds[1], + csap->driver_event_fds[0], + csap->driver_event_fds[1]); + } + } + } + } + break; + } + case CHKIO_SMP_SELECT: { + int rounds = 1; /*rand(); */ + ChkioSmpSelect* pip = (ChkioSmpSelect*) cddp->test_data; + if (pip == NULL) { + erl_drv_mutex_lock(smp_pipes_mtx); + if (smp_pipes) { + pip = smp_pipes; + smp_pipes = smp_pipes->next; + } + else { + cddp->test_data = driver_alloc(sizeof(ChkioSmpSelect)); + pip = (ChkioSmpSelect*) cddp->test_data; + pip->state = Closed; + pip->rand_state = 1; + smp_pipes_cnt++; + } + erl_drv_mutex_unlock(smp_pipes_mtx); + } + while (rounds--) { + int op = rand_r(&pip->rand_state); + switch (pip->state) { + case Closed: { + int fds[2], flags; + if (pipe(fds) < 0 || + (flags = fcntl(fds[0], F_GETFL, 0)) < 0 || + fcntl(fds[0], F_SETFL, flags|O_NONBLOCK) < 0) { + + driver_failure_posix(cddp->port, errno); + rounds = 0; + break; + } + TRACEF(("%T: Created pipe [%d->%d]\n", cddp->id, fds[1], fds[0])); + pip->read_fd = fds[0]; + pip->write_fd = fds[1]; + pip->state = Opened; + pip->wasSelected = 0; + pip->next_write = pip->next_read = rand_r(&pip->rand_state) % 1024; + if (op & 1) break; + op >>= 1; + }/*fall through*/ + case Opened: { + if (op & 1) { + TRACEF(("%T: Write %d to opened pipe [%d->%d]\n", cddp->id, pip->next_write, pip->write_fd, pip->read_fd)); + if (write(pip->write_fd, &pip->next_write, sizeof(int)) != sizeof(int)) { + fprintf(stderr, "Failed to write to pipe fd=%d, errno=%d\n", pip->write_fd, errno); + abort(); + } + pip->next_write++; + } + op >>= 1; + if (pip->wasSelected && (op & 1)) { + TRACEF(("%T: Close pipe [%d->%d]\n", cddp->id, pip->write_fd, pip->read_fd)); + if (close(pip->read_fd) || close(pip->write_fd)) { + fprintf(stderr, "Failed to close pipe, errno=%d\n", errno); + abort(); + } + pip->state = Closed; + break; + } + else { + TRACEF(("%T: Select on pipe [%d->%d]\n", cddp->id, pip->write_fd, pip->read_fd)); + if (driver_select(cddp->port, (ErlDrvEvent)pip->read_fd, DO_READ, 1)) { + fprintf(stderr, "driver_select failed for fd=%d\n", pip->read_fd); + abort(); + } + pip->state = Selected; + pip->wasSelected = 1; + op >>= 1; + if (pip->next_write != pip->next_read) { /* pipe not empty */ + if (op & 1) { + pip->state = Waiting; /* Wait for reader */ + break; + } + op >>= 1; + } + } + }/*fall through*/ + case Selected: + if (op & 1) { + TRACEF(("%T: Write %d to selected pipe [%d->%d]\n", cddp->id, + pip->next_write, pip->write_fd, pip->read_fd)); + if (write(pip->write_fd, &pip->next_write, sizeof(int)) != sizeof(int)) { + fprintf(stderr, "Failed to write to pipe fd=%d, errno=%d\n", pip->write_fd, errno); + abort(); + } + pip->next_write++; + } + op >>= 1; + if (op & 1) { + TRACEF(("%T: Deselect on pipe [%d->%d]\n", cddp->id, pip->write_fd, pip->read_fd)); + if (driver_select(cddp->port, (ErlDrvEvent)pip->read_fd, DO_READ, 0)) { + fprintf(stderr, "driver_(de)select failed for fd=%d\n", pip->read_fd); + abort(); + } + pip->state = Opened; + } + op >>= 1; + if (op & 1) { + TRACEF(("%T: Write %d to pipe [%d->%d] state=%d\n", cddp->id, + pip->next_write, pip->write_fd, pip->read_fd, pip->state)); + if (write(pip->write_fd, &pip->next_write, sizeof(int)) != sizeof(int)) { + fprintf(stderr, "Failed to write to pipe fd=%d, errno=%d\n", pip->write_fd, errno); + abort(); + } + pip->next_write++; + } + break; + case Waiting: + break; + default: + fprintf(stderr, "Strange state %d\n", pip->state); + abort(); + } + if (pip->state == Opened) { /* share unselected pipes with others */ + erl_drv_mutex_lock(smp_pipes_mtx); + pip->next = smp_pipes; + smp_pipes = pip; + erl_drv_mutex_unlock(smp_pipes_mtx); + cddp->test_data = NULL; + } + else { + cddp->test_data = pip; + } + } + res_str = "ok"; + res_len = -1; + break; + } + case CHKIO_DRV_USE: + chkio_drv_use(cddp, chkio_drv_control); + res_str = "ok"; + res_len = -1; + break; + default: + driver_failure_atom(cddp->port, "invalid_state"); + break; + } + cddp->test = command; +#endif /* UNIX */ + + if (res_len >= 0) + return res_len; + + res_len = strlen(res_str); + if (res_len > rlen) { + char *abuf = driver_alloc(sizeof(char)*res_len); + if (!abuf) + return 0; + *rbuf = abuf; + } + + memcpy((void *) *rbuf, (void *) res_str, res_len); + + return res_len; +} + +#ifdef UNIX + +#define ASSERT(cond) \ + do{ \ + if (!(cond)) { assert_failed(cddp->port, #cond, __LINE__); return; } \ + /*else fprintf(stderr, "Assertion '%s' at line %d: OK\r\n", #cond, __LINE__);*/ \ + }while(0) + +static void assert_print(char* str, int line) +{ + fprintf(stderr, "Assertion '%s' at line %d: FAILED\r\n", str, line); +} + +static void assert_failed(ErlDrvPort port, char* str, int line) +{ + char buf[30]; + assert_print(str,line); + snprintf(buf,sizeof(buf),"failed_at_line_%d",line); + driver_failure_atom(port,buf); + /*abort();*/ +} + +#define my_driver_select(PORT,FD,MODE,ON) \ + do{ if(driver_select(PORT, (ErlDrvEvent)(long)FD, MODE, ON) != 0) { \ + assert_failed(cddp->port, "driver_select", __LINE__); \ + return; \ + } \ + }while(0) + + +static void chkio_drv_use(ChkioDrvData *cddp, void* callback) +{ + ChkioDrvUse* cdu = (ChkioDrvUse*) cddp->test_data; + int fd_stop_select = -1; + + /*fprintf(stderr, "Callback: %p\r\n", callback);*/ + + if (cdu == NULL) { + int ret; + ASSERT(callback == chkio_drv_control); + cdu = &drv_use_singleton; + ASSERT(cdu->script_line == 0); + cddp->test_data = cdu; + cdu->fd_stop_select = -1; + cdu->script_line = 1; + cdu->fd_in = open("/dev/zero", O_RDONLY); + ASSERT(cdu->fd_in > 0); + cdu->fd_out = open("/dev/null", O_WRONLY); + ASSERT(cdu->fd_out > 0); + ret = pipe(cdu->fd_pipe); + ASSERT(ret == 0); + } + else { + if (callback == chkio_drv_timeout) { + if (cdu->fd_stop_select >= 0) { + fd_stop_select = cdu->fd_stop_select; + cdu->fd_stop_select = -1; + fprintf(stderr,"timeout detected stop_select fd=%d\r\n", fd_stop_select); + callback = chkio_drv_stop_select; + ASSERT(fd_stop_select == cdu->expected_fd); + } + else if (--cdu->timeouts_left > 0) { + driver_set_timer(cddp->port, 100); + return; + } + } + ASSERT(callback == cdu->expected_callback); + } + +#define NEXT_CALLBACK(fn) \ + cdu->expected_callback = fn; \ + /*fprintf(stderr, "Next expected callback: %p\r\n", fn);*/ \ + cdu->script_line = __LINE__; break; case __LINE__: \ + fprintf(stderr, "Script line %d\r\n", cdu->script_line) + + switch (cdu->script_line) { + case 1: + my_driver_select(cddp->port, cdu->fd_in, ERL_DRV_READ|ERL_DRV_USE, 1); + NEXT_CALLBACK(chkio_drv_ready_input); + + my_driver_select(cddp->port, cdu->fd_in, ERL_DRV_READ|ERL_DRV_USE, 0); + cdu->expected_fd = cdu->fd_in; + NEXT_CALLBACK(chkio_drv_stop_select); + + my_driver_select(cddp->port, cdu->fd_out, ERL_DRV_WRITE|ERL_DRV_USE, 1); + NEXT_CALLBACK(chkio_drv_ready_output); + + my_driver_select(cddp->port, cdu->fd_out, ERL_DRV_WRITE|ERL_DRV_USE, 0); + cdu->expected_fd = cdu->fd_out; + NEXT_CALLBACK(chkio_drv_stop_select); + + my_driver_select(cddp->port, cdu->fd_in, ERL_DRV_READ|ERL_DRV_USE, 1); + NEXT_CALLBACK(chkio_drv_ready_input); + + my_driver_select(cddp->port, cdu->fd_in, ERL_DRV_READ, 0); + NEXT_CALLBACK(chkio_drv_timeout); + + my_driver_select(cddp->port, cdu->fd_out, ERL_DRV_WRITE|ERL_DRV_USE, 1); + NEXT_CALLBACK(chkio_drv_ready_output); + + my_driver_select(cddp->port, cdu->fd_out, ERL_DRV_WRITE, 0); + NEXT_CALLBACK(chkio_drv_timeout); + + my_driver_select(cddp->port, cdu->fd_in, ERL_DRV_USE, 0); + cdu->expected_fd = cdu->fd_in; + NEXT_CALLBACK(chkio_drv_stop_select); + + my_driver_select(cddp->port, cdu->fd_out, ERL_DRV_USE, 0); + cdu->expected_fd = cdu->fd_out; + NEXT_CALLBACK(chkio_drv_stop_select); + + my_driver_select(cddp->port, cdu->fd_in, ERL_DRV_READ, 1); + NEXT_CALLBACK(chkio_drv_ready_input); + + my_driver_select(cddp->port, cdu->fd_in, ERL_DRV_USE, 0); + cdu->expected_fd = cdu->fd_in; + NEXT_CALLBACK(chkio_drv_stop_select); + + my_driver_select(cddp->port, cdu->fd_out, ERL_DRV_WRITE, 1); + NEXT_CALLBACK(chkio_drv_ready_output); + + my_driver_select(cddp->port, cdu->fd_out, ERL_DRV_USE, 0); + cdu->expected_fd = cdu->fd_out; + NEXT_CALLBACK(chkio_drv_stop_select); + + my_driver_select(cddp->port, cdu->fd_pipe[0], ERL_DRV_READ|ERL_DRV_USE, 1); + NEXT_CALLBACK(chkio_drv_timeout); + + my_driver_select(cddp->port, cdu->fd_pipe[0], ERL_DRV_USE, 0); + my_driver_select(cddp->port, cdu->fd_pipe[0], ERL_DRV_READ|ERL_DRV_USE, 1); + /* stop_select may or may not have been called up until now. + In either case it should not be called from here on. */ + cdu->fd_stop_select = -1; + NEXT_CALLBACK(chkio_drv_timeout); + + my_driver_select(cddp->port, cdu->fd_pipe[0], ERL_DRV_USE, 0); + cdu->expected_fd = cdu->fd_pipe[0]; + NEXT_CALLBACK(chkio_drv_stop_select); + + /* switch off USE again */ + my_driver_select(cddp->port, cdu->fd_pipe[0], ERL_DRV_USE, 0); + cdu->expected_fd = cdu->fd_pipe[0]; + NEXT_CALLBACK(chkio_drv_stop_select); + + my_driver_select(cddp->port, cdu->fd_pipe[1], ERL_DRV_READ|ERL_DRV_WRITE|ERL_DRV_USE, 1); + NEXT_CALLBACK(chkio_drv_ready_output); + + /* ERL_DRV_USE_NO_CALLBACK does not clear all */ + my_driver_select(cddp->port, cdu->fd_pipe[1], ERL_DRV_READ|ERL_DRV_USE_NO_CALLBACK, 0); + NEXT_CALLBACK(chkio_drv_ready_output); + + my_driver_select(cddp->port, cdu->fd_pipe[1], ERL_DRV_WRITE|ERL_DRV_USE_NO_CALLBACK, 0); + NEXT_CALLBACK(chkio_drv_timeout); + + cdu->script_line = 0; /* The End */ + cdu->expected_callback = chkio_drv_stop; + break; + + case 0: /* close port */ + ASSERT(cdu->fd_stop_select < 0); + close(cdu->fd_in); cdu->fd_in = -1; + close(cdu->fd_out); cdu->fd_out = -1; + close(cdu->fd_pipe[0]); cdu->fd_pipe[0] = -1; + close(cdu->fd_pipe[1]); cdu->fd_pipe[1] = -1; + /*driver_free(cdu); No, it's static */ + return; + + default: + ASSERT(0); + } + if (cdu->script_line) { + driver_set_timer(cddp->port, 100); + cdu->timeouts_left = 5; + } + else { + if (callback != chkio_drv_timeout) { + driver_cancel_timer(cddp->port); + } + driver_output(cddp->port, "TheEnd", 6); + } +} + +#endif /* UNIX */ + +static void chkio_drv_stop_select(ErlDrvEvent e, void* null) +{ +#ifdef UNIX + /*fprintf(stderr,"STOP_SELECT\r\n");*/ + if (!(null == NULL)) { + assert_print("null==NULL", __LINE__); abort(); + } + if (!(drv_use_singleton.fd_stop_select < 0)) { + assert_print("fd_stop_select<0", __LINE__); abort(); + } + drv_use_singleton.fd_stop_select = (int)(long)e; + /* Can't call chkio_drv_use directly here. That could even be recursive. + * Next timeout will detect it instead. + */ +#endif /* UNIX */ +} + + diff --git a/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c b/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c new file mode 100644 index 0000000000..59145447f8 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/invalid_extended_marker_drv.c @@ -0,0 +1,32 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Implementation of a driver with an invalid extended + * marker. + */ + +#define VSN_MISMATCH_DRV_EXTENDED_MARKER (0xdeadbeef) +#define VSN_MISMATCH_DRV_NAME_STR "invalid_extended_marker_drv" +#define VSN_MISMATCH_DRV_NAME invalid_extended_marker_drv +#define VSN_MISMATCH_DRV_MAJOR_VSN_DIFF 0 +#define VSN_MISMATCH_DRV_MINOR_VSN_DIFF 0 + +#include "vsn_mismatch_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c b/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c new file mode 100644 index 0000000000..25d4b17001 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/io_ready_exit_drv.c @@ -0,0 +1,151 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#ifndef UNIX +#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#define UNIX 1 +#endif +#endif + +#include +#include +#ifdef UNIX +#include +#endif +#include "erl_driver.h" + +typedef struct { + ErlDrvPort port; + int fds[2]; +} IOReadyExitDrvData; + +static ErlDrvData io_ready_exit_drv_start(ErlDrvPort, char *); +static void io_ready_exit_drv_stop(ErlDrvData); +static void io_ready_exit_ready_input(ErlDrvData, ErlDrvEvent); +static void io_ready_exit_ready_output(ErlDrvData, ErlDrvEvent); +static void io_ready_exit_drv_output(ErlDrvData, char *, int); +static void io_ready_exit_drv_finish(void); +static int io_ready_exit_drv_control(ErlDrvData, unsigned int, + char *, int, char **, int); + +static ErlDrvEntry io_ready_exit_drv_entry = { + NULL, /* init */ + io_ready_exit_drv_start, + io_ready_exit_drv_stop, + NULL /* output */, + io_ready_exit_ready_input, + io_ready_exit_ready_output, + "io_ready_exit_drv", + NULL /* finish */, + NULL, /* handle */ + io_ready_exit_drv_control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL /* ready_async */ +}; + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(io_ready_exit_drv) +{ + return &io_ready_exit_drv_entry; +} + +static ErlDrvData +io_ready_exit_drv_start(ErlDrvPort port, char *command) { + IOReadyExitDrvData *oeddp = driver_alloc(sizeof(IOReadyExitDrvData)); + oeddp->port = port; + oeddp->fds[0] = -1; + oeddp->fds[1] = -1; + return (ErlDrvData) oeddp; +} + +static void +io_ready_exit_drv_stop(ErlDrvData drv_data) { + IOReadyExitDrvData *oeddp = (IOReadyExitDrvData *) drv_data; +#ifdef UNIX + if (oeddp->fds[0] >= 0) { + driver_select(oeddp->port, + (ErlDrvEvent) oeddp->fds[0], + DO_READ|DO_WRITE, + 0); + close(oeddp->fds[0]); + } + if (oeddp->fds[1] >= 0) + close(oeddp->fds[1]); +#endif + driver_free((void *) oeddp); +} + + +static void +io_ready_exit_ready_output(ErlDrvData drv_data, ErlDrvEvent event) +{ + IOReadyExitDrvData *oeddp = (IOReadyExitDrvData *) drv_data; + driver_failure_atom(oeddp->port, "ready_output_driver_failure"); +} + +static void +io_ready_exit_ready_input(ErlDrvData drv_data, ErlDrvEvent event) +{ + IOReadyExitDrvData *oeddp = (IOReadyExitDrvData *) drv_data; + driver_failure_atom(oeddp->port, "ready_input_driver_failure"); +} + +static int +io_ready_exit_drv_control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + char *abuf; + char *res_str; + int res_len; + IOReadyExitDrvData *oeddp = (IOReadyExitDrvData *) drv_data; +#ifndef UNIX + res_str = "nyiftos"; +#else + if (pipe(oeddp->fds) < 0) { + res_str = "pipe failed"; + } + else { + res_str = "ok"; + write(oeddp->fds[1], "!", 1); + driver_select(oeddp->port, + (ErlDrvEvent) oeddp->fds[0], + DO_READ|DO_WRITE, + 1); + } +#endif + res_len = strlen(res_str); + if (res_len > rlen) { + abuf = driver_alloc(sizeof(char)*res_len); + if (!abuf) + return 0; + *rbuf = abuf; + } + + memcpy((void *) *rbuf, (void *) res_str, res_len); + + return res_len; +} + + + diff --git a/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c new file mode 100644 index 0000000000..2048d06123 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/ioq_exit_drv.c @@ -0,0 +1,423 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Tests that port I/O queues can be flushed via: + * - ready_input(), + * - ready_output(), + * - timeout(), + * - driver_async() -> read_async(), and + * - event() + */ + +#ifndef UNIX +#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#define UNIX 1 +#endif +#endif + +#if defined(DEBUG) || 0 +# define PRINTF(X) printf X +#else +# define PRINTF(X) +#endif + +#if defined(UNIX) +#include +#include +#include +#include +#include +#include +#ifdef HAVE_POLL_H +# include +#endif +#elif defined(__WIN32__) +#include +#endif + +#include + +#include "erl_driver.h" + +typedef enum { + IOQ_EXIT_INVALID = 0, + IOQ_EXIT_READY_INPUT = 1, + IOQ_EXIT_READY_OUTPUT = 2, + IOQ_EXIT_TIMEOUT = 3, + IOQ_EXIT_READY_ASYNC = 4, + IOQ_EXIT_EVENT = 5, + IOQ_EXIT_READY_INPUT_ASYNC = 6, + IOQ_EXIT_READY_OUTPUT_ASYNC = 7, + IOQ_EXIT_TIMEOUT_ASYNC = 8, + IOQ_EXIT_EVENT_ASYNC = 9 +} IOQExitTest; + +typedef struct { + ErlDrvPort port; + IOQExitTest test; + int ifd; + int ofd; + int outstanding_async_task; + long async_task; +#ifdef HAVE_POLL_H + struct erl_drv_event_data event_data; +#endif +} IOQExitDrvData; + +#define EV2FD(EV) ((int) ((long) (EV))) +#define FD2EV(FD) ((ErlDrvEvent) ((long) (FD))) + +static ErlDrvData start(ErlDrvPort port, char *command); +static void stop(ErlDrvData drv_data); +static void ready_input(ErlDrvData drv_data, ErlDrvEvent event); +static void ready_output(ErlDrvData drv_data, ErlDrvEvent event); +static int control(ErlDrvData, unsigned int, char *, int, char **, int); +static void timeout(ErlDrvData drv_data); +static void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data); +static void flush(ErlDrvData drv_data); +static void event(ErlDrvData drv_data, ErlDrvEvent event, + ErlDrvEventData event_data); +static void async_invoke(void*); +static void do_driver_async(IOQExitDrvData *); + +static ErlDrvEntry ioq_exit_drv_entry = { + NULL /* init */, + start, + stop, + NULL /* output */, + ready_input, + ready_output, + "ioq_exit_drv", + NULL /* finish */, + NULL /* handle */, + control, + timeout, + NULL /* outputv */, + ready_async, + flush, + NULL /* call */, + event, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* process_exit */ +}; + +DRIVER_INIT(ioq_exit_drv) +{ + return &ioq_exit_drv_entry; +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + IOQExitDrvData *ddp = driver_alloc(sizeof(IOQExitDrvData)); + PRINTF(("%p = start(%ld, %s) called\r\n", ddp, (long) port, command)); + if (!ddp) { + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + + ddp->port = port; + ddp->test = IOQ_EXIT_INVALID; + ddp->ifd = -1; + ddp->ofd = -1; + ddp->outstanding_async_task = 0; + ddp->async_task = -1; +#ifdef HAVE_POLL_H + ddp->event_data.events = (short) 0; + ddp->event_data.revents = (short) 0; +#endif + + return (ErlDrvData) ddp; +} + +static int control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; + char *res_str = "nyiftos"; + + PRINTF(("control(%p, %d, ...) called\r\n", drv_data, command)); + + switch (command) { + case IOQ_EXIT_READY_INPUT: + case IOQ_EXIT_READY_INPUT_ASYNC: +#ifdef UNIX + ddp->ifd = open("/dev/zero", O_RDONLY); + if (ddp->ifd < 0) { + driver_failure_posix(ddp->port, errno); + return 0; + } + break; +#else + goto done; +#endif + case IOQ_EXIT_READY_OUTPUT: + case IOQ_EXIT_READY_OUTPUT_ASYNC: +#ifdef UNIX + ddp->ofd = open("/dev/null", O_WRONLY); + if (ddp->ofd < 0) { + driver_failure_posix(ddp->port, errno); + return 0; + } + break; +#else + goto done; +#endif + case IOQ_EXIT_EVENT: + case IOQ_EXIT_EVENT_ASYNC: +#ifdef UNIX +#ifdef HAVE_POLL_H + ddp->ofd = open("/dev/null", O_WRONLY); + if (ddp->ofd < 0) { + driver_failure_posix(ddp->port, errno); + return 0; + } + else if (driver_event(ddp->port, FD2EV(ddp->ofd), NULL) != 0) { + res_str = "skip: driver_event() not supported"; + goto done; + } +#else + res_str = "skip: No poll.h found which is needed for this test"; + goto done; +#endif + break; +#else /* UNIX */ + goto done; +#endif + case IOQ_EXIT_TIMEOUT: + case IOQ_EXIT_TIMEOUT_ASYNC: + break; + case IOQ_EXIT_READY_ASYNC: + break; + default: + res_str = "error: command not supported"; + goto done; + } + + driver_enq(ddp->port, "!", 1); + ddp->test = (IOQExitTest) command; + res_str = "ok"; + + done: { + int res_len = strlen(res_str); + if (res_len > rlen) { + char *abuf = driver_alloc(sizeof(char)*res_len); + if (!abuf) + return 0; + *rbuf = abuf; + } + + memcpy((void *) *rbuf, (void *) res_str, res_len); + + return res_len; + } +} + +static void stop(ErlDrvData drv_data) +{ + IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; + + PRINTF(("stop(%p) called\r\n", drv_data)); + + if (ddp) { + switch (ddp->test) { +#ifdef UNIX + case IOQ_EXIT_READY_INPUT: + case IOQ_EXIT_READY_INPUT_ASYNC: + if (ddp->ifd >= 0) { + driver_select(ddp->port, FD2EV(ddp->ifd), DO_READ, 0); + close(ddp->ifd); + } + break; + case IOQ_EXIT_READY_OUTPUT: + case IOQ_EXIT_READY_OUTPUT_ASYNC: + if (ddp->ofd >= 0) { + driver_select(ddp->port, FD2EV(ddp->ofd), DO_WRITE, 0); + close(ddp->ofd); + } + break; + case IOQ_EXIT_EVENT: + case IOQ_EXIT_EVENT_ASYNC: + if (ddp->ofd >= 0) { + driver_event(ddp->port, FD2EV(ddp->ofd), NULL); + close(ddp->ofd); + } + break; +#endif + case IOQ_EXIT_TIMEOUT: + case IOQ_EXIT_TIMEOUT_ASYNC: + driver_cancel_timer(ddp->port); + break; + case IOQ_EXIT_READY_ASYNC: + if (ddp->outstanding_async_task) + driver_async_cancel(ddp->async_task); + break; + default: + break; + } + driver_free(ddp); + } +} + + +static void flush(ErlDrvData drv_data) +{ + IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; + + PRINTF(("flush(%p) called\r\n", drv_data)); + + switch (ddp->test) { +#ifdef UNIX + case IOQ_EXIT_READY_INPUT: + case IOQ_EXIT_READY_INPUT_ASYNC: + driver_select(ddp->port, FD2EV(ddp->ifd), DO_READ, 1); + break; + case IOQ_EXIT_READY_OUTPUT: + case IOQ_EXIT_READY_OUTPUT_ASYNC: + driver_select(ddp->port, FD2EV(ddp->ofd), DO_WRITE, 1); + break; + case IOQ_EXIT_EVENT: + case IOQ_EXIT_EVENT_ASYNC: +#ifdef HAVE_POLL_H + ddp->event_data.events |= POLLOUT; + driver_event(ddp->port, FD2EV(ddp->ofd), &ddp->event_data); +#endif + break; +#endif + case IOQ_EXIT_TIMEOUT: + case IOQ_EXIT_TIMEOUT_ASYNC: + driver_set_timer(ddp->port, 0); + break; + case IOQ_EXIT_READY_ASYNC: + do_driver_async(ddp); + break; + default: + break; + } +} + +static void ready_input(ErlDrvData drv_data, ErlDrvEvent event) +{ + IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; + + PRINTF(("ready_input(%p, %d) called\r\n", drv_data, EV2FD(event))); + +#ifdef UNIX + if (ddp->ifd == EV2FD(event)) { + driver_select(ddp->port, FD2EV(ddp->ifd), DO_READ, 0); + close(ddp->ifd); + ddp->ifd = -1; + if (ddp->test == IOQ_EXIT_READY_INPUT_ASYNC) + do_driver_async(ddp); + else + driver_deq(ddp->port, 1); + } +#endif +} + +static void ready_output(ErlDrvData drv_data, ErlDrvEvent event) +{ + IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; + + PRINTF(("ready_output(%p, %d) called\r\n", drv_data, EV2FD(event))); + +#ifdef UNIX + if (ddp->ofd == EV2FD(event)) { + driver_select(ddp->port, FD2EV(ddp->ofd), DO_WRITE, 0); + close(ddp->ofd); + ddp->ofd = -1; + if (ddp->test == IOQ_EXIT_READY_OUTPUT_ASYNC) + do_driver_async(ddp); + else + driver_deq(ddp->port, 1); + } +#endif +} + +static void timeout(ErlDrvData drv_data) +{ + IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; + + PRINTF(("timeout(%p) called\r\n", drv_data)); + + if (ddp->test == IOQ_EXIT_TIMEOUT_ASYNC) + do_driver_async(ddp); + else + driver_deq(ddp->port, 1); +} + +static void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data) +{ + IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; + + PRINTF(("ready_async(%p, %p) called\r\n", drv_data, thread_data)); + + if (drv_data == (ErlDrvData) thread_data) { + driver_deq(ddp->port, 1); + ddp->outstanding_async_task = 0; + } +} + +static void event(ErlDrvData drv_data, + ErlDrvEvent event, + ErlDrvEventData event_data) +{ + IOQExitDrvData *ddp = (IOQExitDrvData *) drv_data; + + PRINTF(("event(%p, %d, %p) called\r\n", drv_data, EV2FD(event), event_data)); + +#if defined(UNIX) && defined(HAVE_POLL_H) + if (ddp->ofd == EV2FD(event)) { + driver_event(ddp->port, FD2EV(ddp->ofd), NULL); + close(ddp->ofd); + ddp->ofd = -1; + if (ddp->test == IOQ_EXIT_EVENT_ASYNC) + do_driver_async(ddp); + else + driver_deq(ddp->port, 1); + } +#endif +} + +static void async_invoke(void *arg) +{ + PRINTF(("async_invoke(%p) called\r\n", arg)); +} + +static void do_driver_async(IOQExitDrvData *ddp) +{ + ErlDrvSysInfo si; + long task; + ddp->outstanding_async_task = 1; + task = driver_async(ddp->port, NULL, async_invoke, ddp, NULL); + /* If no async threads, ddp has been deallocated now */ + driver_system_info(&si, sizeof(ErlDrvSysInfo)); + if (si.async_threads) + ddp->async_task = task; +} + + diff --git a/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c new file mode 100644 index 0000000000..4eb0e6fa57 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/larger_major_vsn_drv.c @@ -0,0 +1,31 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Implementation of a driver with a larger major + * driver version than the current system. + */ + +#define VSN_MISMATCH_DRV_NAME_STR "larger_major_vsn_drv" +#define VSN_MISMATCH_DRV_NAME larger_major_vsn_drv +#define VSN_MISMATCH_DRV_MAJOR_VSN_DIFF 1 +#define VSN_MISMATCH_DRV_MINOR_VSN_DIFF 0 + +#include "vsn_mismatch_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c new file mode 100644 index 0000000000..396deb9bef --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/larger_minor_vsn_drv.c @@ -0,0 +1,31 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Implementation of a driver with a larger minor + * driver version than the current system. + */ + +#define VSN_MISMATCH_DRV_NAME_STR "larger_minor_vsn_drv" +#define VSN_MISMATCH_DRV_NAME larger_minor_vsn_drv +#define VSN_MISMATCH_DRV_MAJOR_VSN_DIFF 0 +#define VSN_MISMATCH_DRV_MINOR_VSN_DIFF 1 + +#include "vsn_mismatch_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/many_events_drv.c b/erts/emulator/test/driver_SUITE_data/many_events_drv.c new file mode 100644 index 0000000000..7417dbf7f8 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/many_events_drv.c @@ -0,0 +1,98 @@ +#ifdef __WIN32__ +#include +#endif + +#include +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData many_events_start(ErlDrvPort, char *); +static void from_erlang(ErlDrvData, char*, int); +static void from_port(ErlDrvData drv_data, ErlDrvEvent event); +static int many_events_call(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned *ret_flags); +static ErlDrvEntry many_events_driver_entry = { + NULL, /* Init */ + many_events_start, + NULL, /* Stop */ + from_erlang, + from_port, /* Ready input */ + NULL, /* Ready output */ + "many_events_drv", + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + many_events_call +}; + +DRIVER_INIT(many_events_drv) +{ + return &many_events_driver_entry; +} + +static ErlDrvData +many_events_start(ErlDrvPort port, char *buf) +{ + return (ErlDrvData) port; +} + +static void +from_erlang(ErlDrvData data, char *buf, int count) +{ + int i; + int num; + char *b2 = driver_alloc(count + 1); + char b3[1024]; + + memcpy(b2,buf,count); + b2[count] = '\0'; + + num = atoi(b2); + + driver_free(b2); + + if(num < 0) + num = 0; +#ifdef __WIN32__ + for (i = 0; i < num; ++i) { + HANDLE ev = CreateEvent(NULL, TRUE, FALSE, NULL); + + if (ev == INVALID_HANDLE_VALUE || + driver_select((ErlDrvPort) data, (ErlDrvEvent) ev, + DO_READ, 1) != 0) { + break; + } + SetEvent(ev); + } +#else + i = num; +#endif + sprintf(b3,"%d",i); + driver_output((ErlDrvPort) data, b3, strlen(b3)); +} + +static void from_port(ErlDrvData data, ErlDrvEvent ev) +{ +#ifdef __WIN32__ + /*static int counter = 0;*/ + driver_select((ErlDrvPort) data, (ErlDrvEvent) ev, + DO_READ, 0); + CloseHandle((HANDLE) ev); + /*fprintf(stderr,"Close no %d\r\n",counter++);*/ +#endif + return; +} + +static int +many_events_call(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen, unsigned *ret_flags) +{ + *rbuf = buf; + *ret_flags |= DRIVER_CALL_KEEP_BUFFER; + return len; +} + diff --git a/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c new file mode 100644 index 0000000000..c80e492e3f --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/missing_callback_drv.c @@ -0,0 +1,144 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson AB. Portions + * created by Ericsson are Copyright 2008, Ericsson Utvecklings AB. All + * Rights Reserved.'' + * + * $Id$ + */ + +#ifndef UNIX +#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#define UNIX 1 +#endif +#endif + +#ifdef UNIX +#include +#include +#include +#include +#include +#include +#include +#ifdef HAVE_POLL_H +# include +#endif +#endif /* UNIX */ + +#include "erl_driver.h" + +typedef struct { + int ofd; + int ifd; + int efd; +#ifdef HAVE_POLL_H + struct erl_drv_event_data edata; +#endif +} mcd_data_t; + +static ErlDrvData start(ErlDrvPort port, char *command); +static void stop(ErlDrvData data); + +static ErlDrvEntry missing_callback_drv_entry = { + NULL /* init */, + start, + stop, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "missing_callback_drv", + NULL /* finish */, + NULL /* handle */, + NULL /* control */, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL, /* handle2 */ + NULL /* process_exit */ +}; + +DRIVER_INIT(missing_callback_drv) +{ + return &missing_callback_drv_entry; +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + mcd_data_t *mcd = driver_alloc(sizeof(mcd_data_t)); + + if (!mcd) + goto error; + + mcd->ofd = -1; + mcd->ifd = -1; + mcd->efd = -1; + +#ifdef UNIX + + mcd->ofd = open("/dev/null", O_WRONLY); + if (mcd->ofd < 0) + goto error; + if (driver_select(port, (ErlDrvEvent) (long) mcd->ofd, DO_WRITE, 1) != 0) + goto error; + + mcd->ifd = open("/dev/zero", O_RDONLY); + if (mcd->ifd < 0) + goto error; + if (driver_select(port, (ErlDrvEvent) (long) mcd->ifd, DO_READ, 1) != 0) + goto error; + +#ifdef HAVE_POLL_H + mcd->efd = open("/dev/null", O_WRONLY); + if (mcd->efd < 0) + goto error; + mcd->edata.events = POLLOUT; + mcd->edata.revents = 0; + driver_event(port, (ErlDrvEvent) (long) mcd->efd, &mcd->edata); +#endif +#endif + + driver_set_timer(port, 0); + + return (ErlDrvData) mcd; + + error: + stop((ErlDrvData) mcd); + return ERL_DRV_ERROR_GENERAL; +} + +static void +stop(ErlDrvData data) +{ + mcd_data_t *mcd = (mcd_data_t *) data; + if (mcd) { +#ifdef UNIX + if (mcd->ofd >= 0) + close(mcd->ofd); + if (mcd->ifd >= 0) + close(mcd->ifd); +#ifdef HAVE_POLL_H + if (mcd->efd >= 0) + close(mcd->efd); +#endif +#endif + driver_free(mcd); + } +} diff --git a/erts/emulator/test/driver_SUITE_data/monitor_drv.c b/erts/emulator/test/driver_SUITE_data/monitor_drv.c new file mode 100644 index 0000000000..1da6a56a72 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/monitor_drv.c @@ -0,0 +1,293 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include +#include +#include "erl_driver.h" + +static ErlDrvData monitor_drv_start(ErlDrvPort, char *); +static int monitor_drv_control(ErlDrvData, unsigned int, + char *, int, char **, int); +static void handle_monitor(ErlDrvData drv_data, ErlDrvMonitor *monitor); + +#define OP_I_AM_IPID 1 +#define OP_MONITOR_ME 2 +#define OP_DEMONITOR_ME 3 +#define OP_MONITOR_ME_LATER 4 +#define OP_DO_DELAYED_MONITOR 5 + +typedef struct one_monitor { + ErlDrvTermData pid; + int later_id; + ErlDrvMonitor mon; + struct one_monitor *next; +} OneMonitor; + + +typedef struct { + ErlDrvPort port; + ErlDrvTermData ipid; + int later_counter; + OneMonitor *first; +} MyDrvData; + + +static ErlDrvEntry monitor_drv_entry = { + NULL /* init */, + monitor_drv_start, + NULL /* stop */, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "monitor_drv", + NULL /* finish */, + NULL /* handle */, + monitor_drv_control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + 0, + NULL, /* handle2 */ + handle_monitor +}; + +DRIVER_INIT(monitor_drv) +{ + return &monitor_drv_entry; +} + +static ErlDrvData +monitor_drv_start(ErlDrvPort port, char *command) { + MyDrvData *data = driver_alloc(sizeof(MyDrvData)); + data->port = port; + data->ipid = driver_term_nil; + data->first = NULL; + data->later_counter = 0; + return (ErlDrvData) data; +} + +static void monitor_drv_stop(ErlDrvData data) +{ + driver_free((void *) data); +} + +static void handle_monitor(ErlDrvData drv_data, ErlDrvMonitor *monitor) +{ + + MyDrvData *data = (MyDrvData *) drv_data; + OneMonitor *p,*o; + for (p = data->first, o = NULL; + p != NULL && driver_compare_monitors(&p->mon,monitor); + o = p, p = p->next) + ; + if (!p) { + fprintf(stderr,"Spooky Monitor executed!\r\n"); + } else { + ErlDrvTermData spec[] = { + ERL_DRV_ATOM, driver_mk_atom("monitor_fired"), + ERL_DRV_PORT, driver_mk_port(data->port), + ERL_DRV_PID, p->pid, + ERL_DRV_TUPLE, TERM_DATA(3) + }; + if (!o) { + data->first = p->next; + } else { + o->next = p->next; + } + driver_free(p); + driver_send_term(data->port, data->ipid, spec, sizeof(spec)/sizeof(ErlDrvTermData)); + } + + return; +} + +static int +monitor_drv_control(ErlDrvData drv_data, + unsigned int command, + char *ibuf, int ilen, + char **rbuf, int rlen) +{ + MyDrvData *data = (MyDrvData *) drv_data; + char *answer = NULL; + char buff[64]; + int alen; + + switch (command) { + case OP_I_AM_IPID: + data->ipid = driver_caller(data->port); + answer = "ok"; + break; + case OP_MONITOR_ME: + { + int res; + OneMonitor *om = driver_alloc(sizeof(OneMonitor)); + om->pid = driver_caller(data->port); + om->later_id = 0; + res = driver_monitor_process(data->port,om->pid,&(om->mon)); + if (res < 0) { + answer = "error"; + driver_free(om); + } else if (res > 0) { + answer = "noproc"; + driver_free(om); + } else { + om->next = data->first; + data->first = om; + answer = "ok"; + } + break; + } + case OP_DEMONITOR_ME: + { + int res; + OneMonitor *p,*q = NULL; + int found = 0; + ErlDrvTermData pid = driver_caller(data->port); + for (p = data->first; p != NULL; p = p->next) { + if (p->pid == pid) { + q = p; + ++found; + } + } + if (q == NULL) { + answer = "not_monitored"; + } else { + if (q->later_id > 0) { + if (found > 1) { + answer = "delayd_but_more"; + } else { + answer = "delayed"; + } + } else { + res = driver_demonitor_process(data->port, &(q->mon)); + if (res < 0) { + answer = "error"; + } else if (res > 0) { + if (found > 1) { + answer = "gone_but_more"; + } else { + answer = "gone"; + } + } else { + if (found > 1) { + answer = "ok_but_more"; + } else { + answer = "ok"; + } + } + } + if (data->first == q) { + data->first = q->next; + } else { + for (p = data->first; p != NULL; p = p->next) { + if (p->next == q) { + p->next = q->next; + break; + } + } + } + driver_free(q); + } + break; + } + case OP_MONITOR_ME_LATER: + { + int res; + OneMonitor *om = driver_alloc(sizeof(OneMonitor)); + om->pid = driver_caller(data->port); + om->later_id = (++(data->later_counter)); + om->next = data->first; + data->first = om; + sprintf(buff,"ok:%d",om->later_id); + answer = buff; + break; + } + case OP_DO_DELAYED_MONITOR: + { + int id = 0, sign = 1, in_number = 0; + OneMonitor *p, *q; + char *bp; + for (bp = ibuf; bp < (ibuf + ilen); ++bp) { + if (*bp <= '9' && *bp >= '0') { + int x = *bp - '0'; + in_number++; + id *= 10; + id += x; + } else if (*bp == '-') { + if (in_number) { + break; + } + sign = -1; + ++in_number; + } else { + if (in_number) { + break; + } + } + } + id *= sign; + q = NULL; + for (p = data->first; p != NULL; q = p, p = p->next) { + if (p->later_id != 0 && p->later_id == id) { + break; + } + } + if (p == NULL) { + answer = "not_found"; + } else { + int res = driver_monitor_process(data->port,p->pid,&(p->mon)); + if (res != 0) { + if (res < 0) { + answer = "error"; + } else { + answer = "noproc"; + } + if (q == NULL) { + data->first = p->next; + } else { + q->next = p->next; + } + driver_free(p); + } else { + p->later_id = 0; + answer = "ok"; + } + } + break; + } + default: + answer = "unknown_op"; + } + if (answer == NULL) { + answer = "internal_error"; + } + alen = strlen(answer); + if (alen >= rlen) { + *rbuf = driver_alloc(alen+1); + } + strcpy(*rbuf,answer); + return alen; +} + + diff --git a/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c b/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c new file mode 100644 index 0000000000..8c0a9aadfd --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/otp_6879_drv.c @@ -0,0 +1,71 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include +#include +#include "erl_driver.h" + +static int call(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen, + unsigned int *flags); + +static ErlDrvEntry otp_6879_drv_entry = { + NULL /* init */, + NULL /* start */, + NULL /* stop */, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "otp_6879_drv", + NULL /* finish */, + NULL /* handle */, + NULL /* control */, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + call, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(otp_6879_drv) +{ + return &otp_6879_drv_entry; +} + + +static int call(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen, + unsigned int *flags) +{ + /* echo call */ + if (len > rlen) + *rbuf = driver_alloc(len); + memcpy((void *) *rbuf, (void *) buf, len); + return len; +} diff --git a/erts/emulator/test/driver_SUITE_data/outputv_drv.c b/erts/emulator/test/driver_SUITE_data/outputv_drv.c new file mode 100644 index 0000000000..87f66ae413 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/outputv_drv.c @@ -0,0 +1,63 @@ +#include +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData outputv_start(ErlDrvPort, char*); +static void outputv_stop(ErlDrvData), outputv_read(ErlDrvData, char*, int), outputv(ErlDrvData, ErlIOVec*); + +static ErlDrvEntry outputv_driver_entry = +{ + NULL, + outputv_start, + outputv_stop, + outputv_read, + NULL, + NULL, + "outputv_drv", + NULL, + NULL, + NULL, + NULL, + outputv, + NULL +}; + +DRIVER_INIT(outputv_drv) +{ + erlang_port = (ErlDrvPort)-1; + return &outputv_driver_entry; +} + +static ErlDrvData outputv_start(ErlDrvPort port, char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + + erlang_port = port; + return (ErlDrvData)port; +} + +static void outputv_read(ErlDrvData port, char *buf, int count) +{ + erlang_port = (ErlDrvPort)-1; +} + +static void outputv_stop(ErlDrvData port) +{ + erlang_port = (ErlDrvPort)-1; +} + +/* Erts outputv -> drv, echo it back */ +static void outputv(ErlDrvData port, ErlIOVec* ev) +{ + driver_outputv(erlang_port, NULL, 0, ev, 0); +} + + + + + + + + diff --git a/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c b/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c new file mode 100644 index 0000000000..f429a5b51e --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/peek_non_existing_queue_drv.c @@ -0,0 +1,231 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Tests that port I/O queues can be flushed via: + * - ready_input(), + * - ready_output(), + * - timeout(), + * - driver_async() -> read_async(), and + * - event() + */ + +#ifndef UNIX +#if !defined(__WIN32__) && !defined(_OSE_) && !defined(VXWORKS) +#define UNIX 1 +#endif +#endif + +#if defined(DEBUG) || 0 +# define PRINTF(X) printf X +#else +# define PRINTF(X) +#endif + +#if defined(UNIX) +#include +#include +#elif defined(__WIN32__) +#include +#endif + +#include + +#include "erl_driver.h" + +#define PEEK_NONXQ_TEST 0 +#define PEEK_NONXQ_WAIT 1 + +typedef struct { + ErlDrvTermData caller; + ErlDrvPort port; + int cmd; +} PeekNonXQDrvData; + +typedef struct { + ErlDrvPort port; + ErlDrvPDL pdl; +} AsyncData; + +static ErlDrvData start(ErlDrvPort, char *); +static void stop(ErlDrvData); +static int control(ErlDrvData, unsigned int, char *, int, char **, int); +static void ready_async(ErlDrvData, ErlDrvThreadData); +static void async_test(void *); +static void async_wait(void *); +static void async_free(void *); +static void do_sleep(unsigned); + +static ErlDrvEntry peek_non_existing_queue_drv_entry = { + NULL /* init */, + start, + stop, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "peek_non_existing_queue_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + ready_async, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* process_exit */ +}; + +DRIVER_INIT(peek_non_existing_queue_drv) +{ + return &peek_non_existing_queue_drv_entry; +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + PeekNonXQDrvData *dp = driver_alloc(sizeof(PeekNonXQDrvData)); + if (!dp) { + errno = ENOMEM; + return ERL_DRV_ERROR_ERRNO; + } + + dp->port = port; + return (ErlDrvData) dp; +} + +static void stop(ErlDrvData drv_data) +{ + driver_free(drv_data); +} + +static int control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + PeekNonXQDrvData *dp = (PeekNonXQDrvData *) drv_data; + unsigned int key = 0; + char *res_str = "ok"; + ErlDrvSysInfo si; + driver_system_info(&si, sizeof(ErlDrvSysInfo)); + if (si.async_threads == 0) { + res_str = "skipped: No async-threads available"; + goto done; + } + + dp->cmd = command; + dp->caller = driver_caller(dp->port); + + switch (command) { + case PEEK_NONXQ_TEST: { + AsyncData *adp = driver_alloc(sizeof(AsyncData)); + if (!adp) { + res_str = "enomem"; + goto done; + } + driver_enq(dp->port, "!", 1); + adp->port = dp->port; + adp->pdl = driver_pdl_create(dp->port); + (void) driver_async(dp->port, &key, async_test, adp, async_free); + break; + } + case PEEK_NONXQ_WAIT: + (void) driver_async(dp->port, &key, async_wait, NULL, NULL); + break; + } + + done: { + int res_len = strlen(res_str); + if (res_len > rlen) { + char *abuf = driver_alloc(sizeof(char)*res_len); + if (!abuf) + return 0; + *rbuf = abuf; + } + + memcpy((void *) *rbuf, (void *) res_str, res_len); + + return res_len; + } +} + +static void ready_async(ErlDrvData drv_data, ErlDrvThreadData thread_data) +{ + PeekNonXQDrvData *dp = (PeekNonXQDrvData *) drv_data; + if (dp->cmd == PEEK_NONXQ_WAIT) { + ErlDrvTermData spec[] = { + ERL_DRV_PORT, driver_mk_port(dp->port), + ERL_DRV_ATOM, driver_mk_atom("test_successful"), + ERL_DRV_TUPLE, 2 + }; + driver_send_term(dp->port, + dp->caller, + spec, + sizeof(spec) / sizeof(spec[0])); + } + if (thread_data) + driver_free(thread_data); +} + +static void async_test(void *vadp) +{ + SysIOVec *vec; + int vlen = 4711; + AsyncData *adp = (AsyncData *)vadp; + + do_sleep(1); + + driver_pdl_lock(adp->pdl); + vec = driver_peekq(adp->port, &vlen); + if (vlen >= 0 || vec) + abort(); /* A crude way to fail the test, but what the ... */ + vlen = driver_sizeq(adp->port); + if (vlen >= 0) + abort(); /* ... */ + driver_pdl_unlock(adp->pdl); +} + +static void async_wait(void *vadp) +{ + /* Will always be executed after async_test in the same thread */ +} + + +static void async_free(void *vadp) +{ + driver_free(vadp); +} + +static void +do_sleep(unsigned secs) +{ +#ifdef __WIN32__ + Sleep((DWORD) secs*1000); +#else + sleep(secs); +#endif +} + diff --git a/erts/emulator/test/driver_SUITE_data/queue_drv.c b/erts/emulator/test/driver_SUITE_data/queue_drv.c new file mode 100644 index 0000000000..ded69f89f9 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/queue_drv.c @@ -0,0 +1,195 @@ +#include +#include "erl_driver.h" + +#define put_int32(i, s) {((char*)(s))[0] = (char)((i) >> 24) & 0xff; \ + ((char*)(s))[1] = (char)((i) >> 16) & 0xff; \ + ((char*)(s))[2] = (char)((i) >> 8) & 0xff; \ + ((char*)(s))[3] = (char)((i) & 0xff);} + +#define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \ + (((unsigned char*) (s))[1] << 16) | \ + (((unsigned char*) (s))[2] << 8) | \ + (((unsigned char*) (s))[3])) + +/* + * Data operations. To use, send code using erlang:port_control/2, + * then send the data to the port. + */ + +#define PUSHQ 0 +#define ENQ 1 +#define PUSHQ_BIN 2 +#define ENQ_BIN 3 +#define PUSHQV 4 +#define ENQV 5 + +/* + * Control operations. Data is returned directly. + */ +#define DEQ 6 +#define BYTES_QUEUED 7 +#define READ_HEAD 8 + +static ErlDrvPort erlang_port; +static unsigned opcode; /* Opcode for next operation. */ +static ErlDrvData queue_start(ErlDrvPort, char*); +static void queue_stop(ErlDrvData), queue_read(ErlDrvData, char*, int); +static void queue_outputv(ErlDrvData, ErlIOVec*); +static int control(ErlDrvData, unsigned int, char*, int, char**, int); +static ErlDrvBinary* read_head(ErlDrvPort, int bytes); + +static ErlDrvEntry queue_driver_entry = +{ + NULL, + queue_start, + queue_stop, + queue_read, + NULL, + NULL, + "queue_drv", + NULL, + NULL, + control, + NULL, + queue_outputv, + NULL +}; + +DRIVER_INIT(queue_drv) +{ + erlang_port = (ErlDrvPort) -1; + return &queue_driver_entry; +} + +static ErlDrvData queue_start(ErlDrvPort port, char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + erlang_port = port; + opcode = 0xFFFFFFFF; + set_port_control_flags(erlang_port, PORT_CONTROL_FLAG_BINARY); + return (ErlDrvData)port; +} + +/* messages from Erlang */ +static void queue_read(ErlDrvData port, char *buf, int len) +{ +} + +static void queue_stop(ErlDrvData port) +{ + erlang_port = (ErlDrvPort) -1; +} + +static int +control(ErlDrvData drv_data, unsigned command, char* buf, int len, char** rbuf, int rlen) +{ + ErlDrvBinary* b; + + switch (command) { + case PUSHQ: + case ENQ: + case PUSHQ_BIN: + case ENQ_BIN: + case PUSHQV: + case ENQV: + opcode = command; + *rbuf = NULL; + return 0; + case DEQ: + *rbuf = NULL; + if (len != 4) { + driver_failure_atom(erlang_port, "deq: bad length"); + } else { + int n = get_int32(buf); + driver_deq(erlang_port, n); + } + return 0; + case BYTES_QUEUED: + *rbuf = (char*)(b = driver_alloc_binary(4)); + put_int32(driver_sizeq(erlang_port), b->orig_bytes); + return 0; + case READ_HEAD: + if (len != 4) { + driver_failure_atom(erlang_port, "read_head: bad length"); + return 0; + } else { + int n = get_int32(buf); + *rbuf = (char *) read_head(erlang_port, n); + return 0; /* Ignored anyway */ + } + default: + driver_failure_atom(erlang_port, "bad opcode to control()"); + return 0; + } +} + +static void +queue_outputv(ErlDrvData drv_data, ErlIOVec* ev) +{ + ErlDrvBinary* bin; + ErlDrvPort ix = (ErlDrvPort) drv_data; + int i = ev->vsize - 1; + int offset; + + switch (opcode) { + case PUSHQ: + driver_pushq(ix, ev->iov[i].iov_base, ev->iov[i].iov_len); + break; + case ENQ: + driver_enq(ix, ev->iov[i].iov_base, ev->iov[i].iov_len); + break; + case PUSHQ_BIN: + case ENQ_BIN: + if (ev->binv[i] != NULL) { + bin = ev->binv[i]; + offset = ev->iov[i].iov_base - bin->orig_bytes; + } else { + bin = driver_alloc_binary(ev->iov[i].iov_len); + memcpy(bin->orig_bytes, ev->iov[i].iov_base, ev->iov[i].iov_len); + offset = 0; + } + if (opcode == PUSHQ_BIN) { + driver_pushq_bin(ix, bin, offset, ev->iov[i].iov_len); + } else { + driver_enq_bin(ix, bin, offset, ev->iov[i].iov_len); + } + if (ev->binv[i] == NULL) { + driver_free_binary(bin); + } + break; + case PUSHQV: + driver_pushqv(ix, ev, 0); + break; + case ENQV: + driver_enqv(ix, ev, 0); + break; + default: + fprintf(stderr, "[queue_drv] Bad opcode %d\n", opcode); + driver_failure_atom(ix, "bad_opcode"); + break; + } +} + +static ErlDrvBinary* +read_head(ErlDrvPort ix, int bytes) +{ + int len_io_queue; + SysIOVec* iov = driver_peekq(ix, &len_io_queue); + int bytes_left = bytes; + int copied = 0; + ErlDrvBinary* b; + int iv; + + b = driver_alloc_binary(bytes); + iv = 0; + while (bytes_left > 0 && iv < len_io_queue) { + int n = (iov[iv].iov_len < bytes_left) ? iov[iv].iov_len : bytes_left; + memcpy(b->orig_bytes+copied, iov[iv].iov_base, n); + copied += n; + bytes_left -= n; + iv++; + } + return b; +} diff --git a/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c new file mode 100644 index 0000000000..a1299fe807 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/smaller_major_vsn_drv.c @@ -0,0 +1,31 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Implementation of a driver with a smaller major + * driver version than the current system. + */ + +#define VSN_MISMATCH_DRV_NAME_STR "smaller_major_vsn_drv" +#define VSN_MISMATCH_DRV_NAME smaller_major_vsn_drv +#define VSN_MISMATCH_DRV_MAJOR_VSN_DIFF (-1) +#define VSN_MISMATCH_DRV_MINOR_VSN_DIFF 0 + +#include "vsn_mismatch_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c b/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c new file mode 100644 index 0000000000..42b1d2a187 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/smaller_minor_vsn_drv.c @@ -0,0 +1,31 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Implementation of a driver with a smaller minor + * driver version than the current system. + */ + +#define VSN_MISMATCH_DRV_NAME_STR "smaller_minor_vsn_drv" +#define VSN_MISMATCH_DRV_NAME smaller_minor_vsn_drv +#define VSN_MISMATCH_DRV_MAJOR_VSN_DIFF 0 +#define VSN_MISMATCH_DRV_MINOR_VSN_DIFF (-1) + +#include "vsn_mismatch_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_1_0_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_1_0_drv.c new file mode 100644 index 0000000000..0504778086 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/sys_info_1_0_drv.c @@ -0,0 +1,72 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Driver that fakes driver version 1.0 and tests + * driver_system_info(). + * + */ + +#include "sys_info_drv_impl.h" + +#define SYS_INFO_DRV_MAJOR_VSN 1 +#define SYS_INFO_DRV_MINOR_VSN 0 +#define SYS_INFO_DRV_NAME_STR "sys_info_1_0_drv" +#define SYS_INFO_DRV_NAME sys_info_1_0_drv +#define SYS_INFO_DRV_LAST_FIELD smp_support + +#define SYS_INFO_DRV_RES_FORMAT "ok: " \ + "drv_drv_vsn=%d.%d " \ + "emu_drv_vsn=%d.%d " \ + "erts_vsn=%s " \ + "otp_vsn=%s " \ + "thread=%s " \ + "smp=%s" + + +static size_t +sys_info_drv_max_res_len(ErlDrvSysInfo *sip) +{ + size_t slen = strlen(SYS_INFO_DRV_RES_FORMAT) + 1; + slen += 2*20; /* drv_drv_vsn */ + slen += 2*20; /* emu_drv_vsn */ + slen += strlen(sip->erts_version) + 1; + slen += strlen(sip->otp_release) + 1; + slen += 5; /* threads */ + slen += 5; /* smp */ + return slen; +} + +static size_t +sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) +{ + return sprintf(str, + SYS_INFO_DRV_RES_FORMAT, + SYS_INFO_DRV_MAJOR_VSN, + SYS_INFO_DRV_MINOR_VSN, + sip->driver_major_version, + sip->driver_minor_version, + sip->erts_version, + sip->otp_release, + sip->thread_support ? "true" : "false", + sip->smp_support ? "true" : "false"); +} + +#include "sys_info_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_1_1_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_1_1_drv.c new file mode 100644 index 0000000000..fa21828284 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/sys_info_1_1_drv.c @@ -0,0 +1,80 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Driver that fakes driver version 1.1 and tests + * driver_system_info(). + * + */ + +#include "sys_info_drv_impl.h" + +#define SYS_INFO_DRV_MAJOR_VSN 1 +#define SYS_INFO_DRV_MINOR_VSN 1 +#define SYS_INFO_DRV_NAME_STR "sys_info_1_1_drv" +#define SYS_INFO_DRV_NAME sys_info_1_1_drv +#define SYS_INFO_DRV_LAST_FIELD scheduler_threads + +#define SYS_INFO_DRV_RES_FORMAT "ok: " \ + "drv_drv_vsn=%d.%d " \ + "emu_drv_vsn=%d.%d " \ + "erts_vsn=%s " \ + "otp_vsn=%s " \ + "thread=%s " \ + "smp=%s " \ + "async_thrs=%d " \ + "sched_thrs=%d" + + +static size_t +sys_info_drv_max_res_len(ErlDrvSysInfo *sip) +{ + size_t slen = strlen(SYS_INFO_DRV_RES_FORMAT) + 1; + slen += 2*20; /* drv_drv_vsn */ + slen += 2*20; /* emu_drv_vsn */ + slen += strlen(sip->erts_version) + 1; + slen += strlen(sip->otp_release) + 1; + slen += 5; /* threads */ + slen += 5; /* smp */ + slen += 20; /* async_thrs */ + slen += 20; /* sched_thrs */ + return slen; +} + +static size_t +sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) +{ + return sprintf(str, + SYS_INFO_DRV_RES_FORMAT, + SYS_INFO_DRV_MAJOR_VSN, + SYS_INFO_DRV_MINOR_VSN, + sip->driver_major_version, + sip->driver_minor_version, + sip->erts_version, + sip->otp_release, + sip->thread_support ? "true" : "false", + sip->smp_support ? "true" : "false", + sip->async_threads, + sip->scheduler_threads); +} + +#include "sys_info_drv_impl.c" + + diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c b/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c new file mode 100644 index 0000000000..5bbc966932 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/sys_info_curr_drv.c @@ -0,0 +1,77 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Driver that tests driver_system_info() on current + * driver version. + * + */ + +#include "sys_info_drv_impl.h" + +#define SYS_INFO_DRV_MAJOR_VSN ERL_DRV_EXTENDED_MAJOR_VERSION +#define SYS_INFO_DRV_MINOR_VSN ERL_DRV_EXTENDED_MINOR_VERSION +#define SYS_INFO_DRV_NAME_STR "sys_info_curr_drv" +#define SYS_INFO_DRV_NAME sys_info_curr_drv +#define ERL_DRV_SYS_INFO_SIZE sizeof(ErlDrvSysInfo) + +#define SYS_INFO_DRV_RES_FORMAT "ok: " \ + "drv_drv_vsn=%d.%d " \ + "emu_drv_vsn=%d.%d " \ + "erts_vsn=%s " \ + "otp_vsn=%s " \ + "thread=%s " \ + "smp=%s " \ + "async_thrs=%d " \ + "sched_thrs=%d" + +static size_t +sys_info_drv_max_res_len(ErlDrvSysInfo *sip) +{ + size_t slen = strlen(SYS_INFO_DRV_RES_FORMAT) + 1; + slen += 2*20; /* drv_drv_vsn */ + slen += 2*20; /* emu_drv_vsn */ + slen += strlen(sip->erts_version) + 1; + slen += strlen(sip->otp_release) + 1; + slen += 5; /* threads */ + slen += 5; /* smp */ + slen += 20; /* async_thrs */ + slen += 20; /* sched_thrs */ + return slen; +} + +static size_t +sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *sip, char *str) +{ + return sprintf(str, + SYS_INFO_DRV_RES_FORMAT, + SYS_INFO_DRV_MAJOR_VSN, + SYS_INFO_DRV_MINOR_VSN, + sip->driver_major_version, + sip->driver_minor_version, + sip->erts_version, + sip->otp_release, + sip->thread_support ? "true" : "false", + sip->smp_support ? "true" : "false", + sip->async_threads, + sip->scheduler_threads); +} + +#include "sys_info_drv_impl.c" diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c new file mode 100644 index 0000000000..2d3203ae5d --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.c @@ -0,0 +1,154 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Implementation of a driver that fakes different driver + * versions and tests driver_system_info(). This file should + * be included by an implementation that defines: + * * SYS_INFO_DRV_MAJOR_VSN + * * SYS_INFO_DRV_MINOR_VSN + * * SYS_INFO_DRV_NAME_STR + * * SYS_INFO_DRV_NAME + * * ERL_DRV_SYS_INFO_SIZE, or SYS_INFO_DRV_LAST_FIELD + * and implements: + * * static size_t sys_info_drv_max_res_len(ErlDrvSysInfo *) + * * static size_t sys_info_drv_sprintf_sys_info(ErlDrvSysInfo *, + * char *) + * + */ + +#if !defined(ERL_DRV_SYS_INFO_SIZE) && defined(SYS_INFO_DRV_LAST_FIELD) + +#define ERL_DRV_SYS_INFO_SIZE_FROM_LAST_FIELD(LAST_FIELD) \ + (((size_t) &((ErlDrvSysInfo *) 0)->LAST_FIELD) \ + + sizeof(((ErlDrvSysInfo *) 0)->LAST_FIELD)) + +#define ERL_DRV_SYS_INFO_SIZE \ + ERL_DRV_SYS_INFO_SIZE_FROM_LAST_FIELD(SYS_INFO_DRV_LAST_FIELD) + +#endif + +static ErlDrvData start(ErlDrvPort, char *); +static int control(ErlDrvData, unsigned int, char *, int, char **, int); + +static ErlDrvEntry drv_entry = { + NULL /* init */, + start, + NULL /* stop */, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + SYS_INFO_DRV_NAME_STR, + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + SYS_INFO_DRV_MAJOR_VSN, + SYS_INFO_DRV_MINOR_VSN, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* process_exit */ +}; + +DRIVER_INIT(SYS_INFO_DRV_NAME) +{ + return &drv_entry; +} + +static ErlDrvData +start(ErlDrvPort port, char *command) +{ + return (ErlDrvData) port; +} + +static int +control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + int res; + char *str; + size_t slen, slen2; + ErlDrvPort port = (ErlDrvPort) drv_data; + unsigned deadbeef[] = {0xdeadbeef, + 0xdeadbeef, + 0xdeadbeef, + 0xdeadbeef, + 0xdeadbeef, + 0xdeadbeef, + 0xdeadbeef, + 0xdeadbeef, + 0xdeadbeef, + 0xdeadbeef}; + ErlDrvSysInfo *sip = driver_alloc(ERL_DRV_SYS_INFO_SIZE + sizeof(deadbeef)); + char *beyond_end_format = "error: driver_system_info() wrote beyond end " + "of the ErlDrvSysInfo struct"; + char *buf_overflow_format = "error: Internal buffer overflow"; + + if (!sip) { + driver_failure_atom(port, "enomem"); + return 0; + } + + memset((char *) sip, 0xed, ERL_DRV_SYS_INFO_SIZE); + memcpy(((char *) sip) + ERL_DRV_SYS_INFO_SIZE, + (char *) &deadbeef[0], + sizeof(deadbeef)); + + driver_system_info(sip, ERL_DRV_SYS_INFO_SIZE); + + slen = sys_info_drv_max_res_len(sip); + slen2 = strlen(beyond_end_format) + 1; + if (slen2 > slen) + slen = slen2; + slen2 = strlen(buf_overflow_format) + 1; + if (slen2 > slen) + slen = slen2; + str = driver_alloc(slen); + if (!str) { + driver_free(sip); + driver_failure_atom(port, "enomem"); + return 0; + } + *rbuf = str; + + /* Check that the emulator didn't write beyond ERL_DRV_SYS_INFO_SIZE */ + if (memcmp(((char *) sip) + ERL_DRV_SYS_INFO_SIZE, + (char *) &deadbeef[0], + sizeof(deadbeef)) != 0) { + res = sprintf(str, beyond_end_format); + } + else { + res = sys_info_drv_sprintf_sys_info(sip, str); + if (res > slen) + res = sprintf(str, buf_overflow_format); + } + driver_free(sip); + return res; +} + + diff --git a/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h new file mode 100644 index 0000000000..5a6ddb15cf --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/sys_info_drv_impl.h @@ -0,0 +1,29 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Header file used by 'sys_info_drv's. + * + */ + +#include +#include +#include "erl_driver.h" + diff --git a/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c b/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c new file mode 100644 index 0000000000..c7edbba7f6 --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/thr_alloc_drv.c @@ -0,0 +1,125 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ +#include +#include +#include +#include "erl_driver.h" + +ErlDrvData start(ErlDrvPort port, char *command); +int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); + +static int call(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen, + unsigned int *flags); + +static ErlDrvEntry thr_alloc_drv_entry = { + NULL /* init */, + start, + NULL /* stop */, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "thr_alloc_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* handle_monitor */ +}; + +DRIVER_INIT(thr_alloc_drv) +{ + return &thr_alloc_drv_entry; +} + +void * +test_thread(void *vsize) +{ + int i; + int size = (int) (long) vsize; + void *mem; + mem = driver_alloc(size); + if (mem) + driver_free(mem); +} + +ErlDrvData start(ErlDrvPort port, char *command) +{ + return (ErlDrvData) port; +} + +int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + ErlDrvPort port = (ErlDrvPort) drv_data; + char *result = "failure"; + int result_len; + if (len <= 20) { + int res; + ErlDrvTid tid; + char ibuf[21]; + int size; + memcpy((void *) ibuf, buf, len); + ibuf[len] = '\0'; + size = atoi(ibuf); + if (size > 0) { + res = erl_drv_thread_create("test_thread", + &tid, + test_thread, + (void *) (long) size, + NULL); + if (res == 0) { + res = erl_drv_thread_join(tid, NULL); + if (res == 0) + result = "ok"; + } + if (res != 0) + driver_failure_posix(port, res); + } + } + + result_len = strlen(result); + if (result_len <= rlen) { + memcpy(*rbuf, result, result_len); + return result_len; + } + else { + *rbuf = driver_alloc(result_len); + if (!*rbuf) { + driver_failure_posix(port, ENOMEM); + return 0; + } + else { + memcpy(*rbuf, result, result_len); + return result_len; + } + } +} diff --git a/erts/emulator/test/driver_SUITE_data/timer_drv.c b/erts/emulator/test/driver_SUITE_data/timer_drv.c new file mode 100644 index 0000000000..b96a95dd4c --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/timer_drv.c @@ -0,0 +1,96 @@ +#ifdef VXWORKS +#include +#include +#include +#include +#include +#include +#endif +#include +#include "erl_driver.h" + +#define get_int32(s) ((((unsigned char*) (s))[0] << 24) | \ + (((unsigned char*) (s))[1] << 16) | \ + (((unsigned char*) (s))[2] << 8) | \ + (((unsigned char*) (s))[3])) + +#define START_TIMER 0 +#define CANCEL_TIMER 1 +#define DELAY_START_TIMER 2 +#define TIMER 3 +#define CANCELLED 4 + +static ErlDrvPort erlang_port; +static ErlDrvData timer_start(ErlDrvPort, char*); +static void timer_stop(ErlDrvData), timer_read(ErlDrvData, char*, int), timer(ErlDrvData); + +static ErlDrvEntry timer_driver_entry = +{ + NULL, + timer_start, + timer_stop, + timer_read, + NULL, + NULL, + "timer_drv", + NULL, + NULL, + NULL, + timer, + NULL, + NULL +}; + +DRIVER_INIT(timer_drv) +{ + erlang_port = (ErlDrvPort)-1; + return &timer_driver_entry; +} + +static ErlDrvData timer_start(ErlDrvPort port, char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + erlang_port = port; + return (ErlDrvData)port; +} + +/* set the timer, this is monitored from erlang measuring the time */ +static void timer_read(ErlDrvData port, char *buf, int len) +{ + char reply[1]; + + if (buf[0] == START_TIMER) { + /* fprintf(stderr, "[timer_drv] Setting timeout: %i\n", get_int32(buf + 1)); */ + driver_set_timer(port, get_int32(buf + 1)); + } else if (buf[0] == CANCEL_TIMER) { + /* fprintf(stderr, "[timer_drv] Timer cancelled\n"); */ + driver_cancel_timer(port); + reply[0] = CANCELLED; + driver_output(port, reply, 1); + } else if (buf[0] == DELAY_START_TIMER) { +#ifndef __WIN32__ +#ifdef VXWORKS + taskDelay(sysClkRateGet()); +#else + sleep(1); +#endif +#endif + driver_set_timer(port, get_int32(buf + 1)); + } +} + +static void timer_stop(ErlDrvData port) +{ + erlang_port = (ErlDrvPort)-1; +} + +static void timer(ErlDrvData port) +{ + char reply[1]; + + /* fprintf(stderr, "[timer_drv] timer timed out\n"); */ + reply[0] = TIMER; + driver_output((ErlDrvPort)port, reply, 1); +} diff --git a/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c b/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c new file mode 100644 index 0000000000..53b0a029ce --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/vsn_mismatch_drv_impl.c @@ -0,0 +1,67 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Implementation of a driver that fakes driver version. It + * is used for checking that version mismatches are handled + * correct by the emulator. The following makros have to be + * defined before it can be used: + * * VSN_MISMATCH_DRV_NAME_STR + * * VSN_MISMATCH_DRV_NAME + * * VSN_MISMATCH_DRV_MAJOR_VSN_DIFF + * * VSN_MISMATCH_DRV_MINOR_VSN_DIFF + */ + +#include "erl_driver.h" + +static ErlDrvEntry drv_entry = { + NULL /* init */, + NULL /* start */, + NULL /* stop */, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + VSN_MISMATCH_DRV_NAME_STR, + NULL /* finish */, + NULL /* handle */, + NULL /* control */, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, +#ifdef VSN_MISMATCH_DRV_EXTENDED_MARKER + VSN_MISMATCH_DRV_EXTENDED_MARKER, +#else + ERL_DRV_EXTENDED_MARKER, +#endif + ERL_DRV_EXTENDED_MAJOR_VERSION + VSN_MISMATCH_DRV_MAJOR_VSN_DIFF, + ERL_DRV_EXTENDED_MINOR_VERSION + VSN_MISMATCH_DRV_MINOR_VSN_DIFF, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* process_exit */ +}; + +DRIVER_INIT(VSN_MISMATCH_DRV_NAME) +{ + return &drv_entry; +} + diff --git a/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c b/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c new file mode 100644 index 0000000000..ed705e565f --- /dev/null +++ b/erts/emulator/test/driver_SUITE_data/zero_extended_marker_garb_drv.c @@ -0,0 +1,32 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Author: Rickard Green + * + * Description: Implementation of a driver with an invalid extended + * marker. + */ + +#define VSN_MISMATCH_DRV_EXTENDED_MARKER 0 +#define VSN_MISMATCH_DRV_NAME_STR "zero_extended_marker_garb_drv" +#define VSN_MISMATCH_DRV_NAME zero_extended_marker_garb_drv +#define VSN_MISMATCH_DRV_MAJOR_VSN_DIFF 0 +#define VSN_MISMATCH_DRV_MINOR_VSN_DIFF 0 + +#include "vsn_mismatch_drv_impl.c" diff --git a/erts/emulator/test/efile_SUITE.erl b/erts/emulator/test/efile_SUITE.erl new file mode 100644 index 0000000000..1d66b6ef70 --- /dev/null +++ b/erts/emulator/test/efile_SUITE.erl @@ -0,0 +1,76 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +-module(efile_SUITE). +-export([all/1]). +-export([iter_max_files/1]). + +-include("test_server.hrl"). + +all(suite) -> [iter_max_files]. + +%% +%% Open as many files as possible. Do this several times and check +%% that we get the same number of files every time. +%% + +iter_max_files(suite) -> []; +iter_max_files(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir,Config), + ?line TestFile = filename:join(DataDir, "existing_file"), + ?line L = do_iter_max_files(10, TestFile), + ?line io:format("Number of files opened in each test:~n~w\n", [L]), + ?line all_equal(L), + Head = hd(L), + if Head >= 2 -> ok; + true -> ?line test_server:fail(too_few_files) + end, + {comment, "Max files: " ++ integer_to_list(hd(L))}. + +do_iter_max_files(N, Name) when N > 0 -> + ?line [max_files(Name)| do_iter_max_files(N-1, Name)]; +do_iter_max_files(_, _) -> + []. + +all_equal([E, E| T]) -> + ?line all_equal([E| T]); +all_equal([_]) -> + ok; +all_equal([]) -> + ok. + +max_files(Name) -> + ?line Fds = open_files(Name), + ?line N = length(Fds), + ?line close_files(Fds), + N. + +close_files([Fd| Fds]) -> + ?line file:close(Fd), + ?line close_files(Fds); +close_files([]) -> + ok. + +open_files(Name) -> + ?line case file:open(Name, [read,raw]) of + {ok, Fd} -> + [Fd| open_files(Name)]; + {error, Reason} -> + io:format("Error reason: ~p", [Reason]), + [] + end. diff --git a/erts/emulator/test/efile_SUITE_data/existing_file b/erts/emulator/test/efile_SUITE_data/existing_file new file mode 100644 index 0000000000..540c89611b --- /dev/null +++ b/erts/emulator/test/efile_SUITE_data/existing_file @@ -0,0 +1 @@ +This file must exist, but its contents is not important. diff --git a/erts/emulator/test/emulator.spec b/erts/emulator/test/emulator.spec new file mode 100644 index 0000000000..ed5bd48e84 --- /dev/null +++ b/erts/emulator/test/emulator.spec @@ -0,0 +1 @@ +{topcase, {dir, "../emulator_test"}}. diff --git a/erts/emulator/test/emulator.spec.ose b/erts/emulator/test/emulator.spec.ose new file mode 100644 index 0000000000..9f494609d9 --- /dev/null +++ b/erts/emulator/test/emulator.spec.ose @@ -0,0 +1,2 @@ +{topcase, {dir, "../emulator_test"}}. +{skip, {obsolete_SUITE, "Not on ose"}}. diff --git a/erts/emulator/test/emulator.spec.vxworks b/erts/emulator/test/emulator.spec.vxworks new file mode 100644 index 0000000000..55675bdc29 --- /dev/null +++ b/erts/emulator/test/emulator.spec.vxworks @@ -0,0 +1,26 @@ +{topcase, {dir, "../emulator_test"}}. + +% Added since R11 +{skip,{distribution_SUITE,link_to_dead_new_node,"Does not work in distributed test environments"}}. +{skip,{binary_SUITE,terms_float,"Floats, VxWorks, PPC = Floating points never equal..."}}. +{skip,{system_info_SUITE,process_count,"Fix-allocs starving VxWorks cards"}}. +{skip,{monitor_SUITE,mixer,"Fix-allocs starving VxWorks cards"}}. + +{skip,{node_container_SUITE,"Too memory consuming..."}}. + +{skip,{trace_SUITE,system_monitor_long_gc_1,"Too memory consuming..."}}. +{skip,{trace_SUITE,system_monitor_long_gc_2,"Too memory consuming..."}}. +{skip,{trace_SUITE,system_monitor_large_heap_1,"Too memory consuming..."}}. +{skip,{trace_SUITE,system_monitor_large_heap_2,"Too memory consuming..."}}. +% End added since R11 + +{skip, {distribution_SUITE,stop_dist,"Not written to work on VxWorks."}}. +{skip, {distribution_SUITE,dist_auto_connect_never, + "Not written to work on VxWorks."}}. +{skip, {distribution_SUITE,dist_auto_connect_once, + "Not written to work on VxWorks."}}. +{skip, {trace_SUITE,system_monitor_long_gc, + "Too memory consuming for VxWorks cards."}}. +{skip, {trace_meta_SUITE,stack_grow, + "Too memory consuming for VxWorks cards."}}. +{skip, {obsolete_SUITE, "Not on vxworks"}}. diff --git a/erts/emulator/test/emulator.spec.win b/erts/emulator/test/emulator.spec.win new file mode 100644 index 0000000000..6181a36358 --- /dev/null +++ b/erts/emulator/test/emulator.spec.win @@ -0,0 +1,2 @@ +{topcase, {dir, "../emulator_test"}}. +{skip, {obsolete_SUITE, "Not on windows"}}. diff --git a/erts/emulator/test/erl_drv_thread_SUITE.erl b/erts/emulator/test/erl_drv_thread_SUITE.erl new file mode 100644 index 0000000000..ea618e9feb --- /dev/null +++ b/erts/emulator/test/erl_drv_thread_SUITE.erl @@ -0,0 +1,119 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(erl_drv_thread_SUITE). +-author('rickard.s.green@ericsson.com'). +-export([all/1]). + +-export([basic/1, rwlock/1, tsd/1]). + +-include("test_server.hrl"). + +-define(DEFAULT_TIMETRAP_SECS, 240). + +all(doc) -> []; +all(suite) -> + [basic, rwlock, tsd]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Testcases %% +%% %% + +basic(suite) -> []; +basic(doc) -> []; +basic(Cfg) -> ?line drv_case(Cfg, basic). + +rwlock(suite) -> []; +rwlock(doc) -> []; +rwlock(Cfg) -> ?line drv_case(Cfg, rwlock). + +tsd(suite) -> []; +tsd(doc) -> []; +tsd(Cfg) -> ?line drv_case(Cfg, tsd). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Internal functions %% +%% %% + +drv_case(Config, CaseName) -> + drv_case(Config, CaseName, ""). + +drv_case(Config, CaseName, TimeTrap) when is_integer(TimeTrap) -> + drv_case(Config, CaseName, "", TimeTrap); +drv_case(Config, CaseName, Command) when is_list(Command) -> + drv_case(Config, CaseName, Command, ?DEFAULT_TIMETRAP_SECS). + +drv_case(Config, CaseName, TimeTrap, Command) when is_list(Command), + is_integer(TimeTrap) -> + drv_case(Config, CaseName, Command, TimeTrap); +drv_case(Config, CaseName, Command, TimeTrap) when is_list(Config), + is_atom(CaseName), + is_list(Command), + is_integer(TimeTrap) -> + case ?t:os_type() of + {Family, _} when Family == unix; Family == win32 -> + ?line run_drv_case(Config, CaseName, Command, TimeTrap); + SkipOs -> + ?line {skipped, + lists:flatten(["Not run on " + | io_lib:format("~p",[SkipOs])])} + end. + +run_drv_case(Config, CaseName, Command, TimeTrap) -> + ?line Dog = test_server:timetrap(test_server:seconds(TimeTrap)), + ?line DataDir = ?config(data_dir,Config), + case erl_ddll:load_driver(DataDir, CaseName) of + ok -> ok; + {error, Error} -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + ?line ?t:fail() + end, + ?line Port = open_port({spawn, atom_to_list(CaseName)}, []), + ?line true = is_port(Port), + ?line Port ! {self(), {command, Command}}, + ?line Result = receive_drv_result(Port, CaseName), + ?line Port ! {self(), close}, + ?line receive + {Port, closed} -> + ok + end, + ?line ok = erl_ddll:unload_driver(CaseName), + ?line test_server:timetrap_cancel(Dog), + ?line Result. + +receive_drv_result(Port, CaseName) -> + ?line receive + {print, Port, CaseName, Str} -> + ?line ?t:format("~s", [Str]), + ?line receive_drv_result(Port, CaseName); + {'EXIT', Port, Error} -> + ?line ?t:fail(Error); + {'EXIT', error, Error} -> + ?line ?t:fail(Error); + {failed, Port, CaseName, Comment} -> + ?line ?t:fail(Comment); + {skipped, Port, CaseName, Comment} -> + ?line {skipped, Comment}; + {succeeded, Port, CaseName, ""} -> + ?line succeeded; + {succeeded, Port, CaseName, Comment} -> + ?line {comment, Comment} + end. diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src b/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src new file mode 100644 index 0000000000..216707e8a5 --- /dev/null +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/Makefile.src @@ -0,0 +1,33 @@ +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved via the world wide web at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# The Initial Developer of the Original Code is Ericsson Utvecklings AB. +# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +# AB. All Rights Reserved.'' +# +# $Id$ +# + +TEST_DRVS = basic@dll@ rwlock@dll@ tsd@dll@ +CC = @CC@ +LD = @LD@ +CFLAGS = @SHLIB_CFLAGS@ -I@erl_include@ @DEFS@ +SHLIB_EXTRA_LDLIBS = testcase_driver@obj@ + +all: $(TEST_DRVS) + +@SHLIB_RULES@ + +testcase_driver@obj@: testcase_driver.c testcase_driver.h +$(TEST_DRVS): testcase_driver@obj@ + + + diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c b/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c new file mode 100644 index 0000000000..fca2c1dbea --- /dev/null +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/basic.c @@ -0,0 +1,291 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" + +#ifdef __WIN32__ +#include +#else +#include +#endif +#include + +#define NO_OF_THREADS 2 + +static int die; +static int cw_passed; +static int res_tf0; +static int res_tf1; +static ErlDrvMutex *mtx; +static ErlDrvCond *cnd; +static int need_join[NO_OF_THREADS]; +static ErlDrvTid tid[NO_OF_THREADS]; +static ErlDrvThreadOpts *topts; + +typedef struct { + int n; +} thr_arg_t; + +static void +do_sleep(unsigned secs) +{ +#ifdef __WIN32__ + Sleep((DWORD) secs*1000); +#else + sleep(secs); +#endif +} + +static void *tf0(void *vta) +{ + if (((thr_arg_t *) vta)->n == 0) { + + erl_drv_mutex_lock(mtx); + + erl_drv_cond_wait(cnd, mtx); + + if (die) { + erl_drv_mutex_unlock(mtx); + return NULL; + } + + cw_passed++; + + erl_drv_cond_wait(cnd, mtx); + + if (die) { + erl_drv_mutex_unlock(mtx); + return NULL; + } + + cw_passed++; + + erl_drv_mutex_unlock(mtx); + if (erl_drv_equal_tids(erl_drv_thread_self(), tid[0])) + res_tf0 = 0; + } + + return (void *) &res_tf0; +} + + +static void *tf1(void *vta) +{ + + if (((thr_arg_t *) vta)->n == 1) { + + erl_drv_mutex_lock(mtx); + + erl_drv_cond_wait(cnd, mtx); + + if (die) { + erl_drv_mutex_unlock(mtx); + return NULL; + } + + cw_passed++; + + erl_drv_cond_wait(cnd, mtx); + + if (die) { + erl_drv_mutex_unlock(mtx); + return NULL; + } + + cw_passed++; + + erl_drv_mutex_unlock(mtx); + + if (erl_drv_equal_tids(erl_drv_thread_self(), tid[1])) + res_tf1 = 1; + + erl_drv_thread_exit((void *) &res_tf1); + + res_tf1 = 4711; + } + return NULL; +} + +void +testcase_run(TestCaseState_t *tcs) +{ + int i, r; + void *tres[2]; + thr_arg_t ta[2]; + ErlDrvTid my_tid; + ErlDrvSysInfo sinfo; + + driver_system_info(&sinfo, sizeof(ErlDrvSysInfo)); + if (!sinfo.thread_support) + testcase_skipped(tcs, "No thread support; nothing to test"); + + testcase_printf(tcs, "Initializing\n"); + + cw_passed = 0; + die = 0; + my_tid = erl_drv_thread_self(); + + for (i = 0; i < NO_OF_THREADS; i++) + need_join[i] = 0; + + res_tf0 = 17; + res_tf1 = 17; + + mtx = NULL; + cnd = NULL; + /* Create mutex and cond */ + mtx = erl_drv_mutex_create("mutex"); + ASSERT(tcs, mtx); + cnd = erl_drv_cond_create("cond"); + ASSERT(tcs, cnd); + topts = erl_drv_thread_opts_create("thread opts"); + ASSERT(tcs, topts); + topts->suggested_stack_size = 0; /* As small as possible */ + + testcase_printf(tcs, "Creating threads 0 & 1\n"); + + /* Create the threads */ + ta[0].n = 0; + r = erl_drv_thread_create("thread 0", &tid[0], tf0, (void *) &ta[0], topts); + ASSERT(tcs, r == 0); + need_join[0] = 1; + + ta[1].n = 1; + r = erl_drv_thread_create("thread 1", &tid[1], tf1, (void *) &ta[1], NULL); + ASSERT(tcs, r == 0); + need_join[1] = 1; + + testcase_printf(tcs, "Testing tids\n"); + + ASSERT(tcs, !erl_drv_equal_tids(tid[0], my_tid)); + ASSERT(tcs, !erl_drv_equal_tids(tid[1], my_tid)); + ASSERT(tcs, !erl_drv_equal_tids(tid[0], tid[1])); + ASSERT(tcs, erl_drv_equal_tids(my_tid, erl_drv_thread_self())); + + testcase_printf(tcs, "Testing mutex/cond\n"); + + /* Make sure the threads waits on cond wait */ + do_sleep(1); + + erl_drv_mutex_lock(mtx); + + ASSERT_CLNUP(tcs, cw_passed == 0, erl_drv_mutex_unlock(mtx)); + + /* Let one thread pass one cond wait */ + erl_drv_cond_signal(cnd); + + erl_drv_mutex_unlock(mtx); + + do_sleep(1); + + erl_drv_mutex_lock(mtx); + + ASSERT_CLNUP(tcs, cw_passed == 1, erl_drv_mutex_unlock(mtx)); + + + /* Let both threads pass one cond wait */ + erl_drv_cond_broadcast(cnd); + + erl_drv_mutex_unlock(mtx); + + do_sleep(1); + + erl_drv_mutex_lock(mtx); + + ASSERT_CLNUP(tcs, cw_passed == 3, erl_drv_mutex_unlock(mtx)); + + + /* Let the thread that only have passed one cond wait pass the other one */ + erl_drv_cond_signal(cnd); + + erl_drv_mutex_unlock(mtx); + + do_sleep(1); + + erl_drv_mutex_lock(mtx); + + ASSERT_CLNUP(tcs, cw_passed == 4, erl_drv_mutex_unlock(mtx)); + + + testcase_printf(tcs, "Testing join\n"); + + /* Both threads should have passed both cond waits and exited; + join them and check returned values */ + + erl_drv_thread_join(tid[0], &tres[0]); + ASSERT_CLNUP(tcs, r == 0, erl_drv_mutex_unlock(mtx)); + need_join[0] = 0; + + ASSERT_CLNUP(tcs, tres[0] == &res_tf0, erl_drv_mutex_unlock(mtx)); + ASSERT_CLNUP(tcs, res_tf0 == 0, erl_drv_mutex_unlock(mtx)); + + r = erl_drv_thread_join(tid[1], &tres[1]); + ASSERT_CLNUP(tcs, r == 0, erl_drv_mutex_unlock(mtx)); + need_join[1] = 0; + + ASSERT_CLNUP(tcs, tres[1] == &res_tf1, erl_drv_mutex_unlock(mtx)); + ASSERT_CLNUP(tcs, res_tf1 == 1, erl_drv_mutex_unlock(mtx)); + + /* Test signaling when noone waits */ + + erl_drv_cond_signal(cnd); + + /* Test broadcasting when noone waits */ + + erl_drv_cond_broadcast(cnd); + + erl_drv_mutex_unlock(mtx); + + erl_drv_mutex_destroy(mtx); + mtx = NULL; + + erl_drv_cond_destroy(cnd); + cnd = NULL; + + erl_drv_thread_opts_destroy(topts); + topts = NULL; + + testcase_printf(tcs, "done\n"); +} + +char * +testcase_name(void) +{ + return "basic"; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + int i; + for (i = 0; i < NO_OF_THREADS; i++) { + if (need_join[i]) { + erl_drv_mutex_lock(mtx); + die = 1; + erl_drv_cond_broadcast(cnd); + erl_drv_mutex_unlock(mtx); + erl_drv_thread_join(tid[i], NULL); + } + } + if (mtx) + erl_drv_mutex_destroy(mtx); + if (cnd) + erl_drv_cond_destroy(cnd); + if (topts) + erl_drv_thread_opts_destroy(topts); +} diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c b/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c new file mode 100644 index 0000000000..064f52c16b --- /dev/null +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/rwlock.c @@ -0,0 +1,214 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" + +#ifdef __WIN32__ +#include +#else +#include +#endif +#include + +#define NO_OF_THREADS 17 + +struct { + int alive; + ErlDrvTid tid; +} test_thr[NO_OF_THREADS] = {0}; + + +static int die; +static int ready; +static int rlocked; +static int rwlocked; +static int do_rlock; +static int do_rwlock; +static ErlDrvMutex *mtx; +static ErlDrvCond *cnd; +static ErlDrvRWLock *rwlck; + +static void +do_sleep(unsigned secs) +{ +#ifdef __WIN32__ + Sleep((DWORD) secs*1000); +#else + sleep(secs); +#endif +} + +static void *tf(void *unused) +{ + + erl_drv_mutex_lock(mtx); + ready++; + if (ready == NO_OF_THREADS) + erl_drv_cond_broadcast(cnd); + while (!do_rlock) + erl_drv_cond_wait(cnd, mtx); + erl_drv_mutex_unlock(mtx); + + erl_drv_rwlock_rlock(rwlck); + + /* make sure everyone rlocks at the same time */ + erl_drv_mutex_lock(mtx); + rlocked++; + if (rlocked == NO_OF_THREADS) + erl_drv_cond_broadcast(cnd); + while (rlocked != NO_OF_THREADS && !die) + erl_drv_cond_wait(cnd, mtx); + erl_drv_mutex_unlock(mtx); + + erl_drv_rwlock_runlock(rwlck); + + erl_drv_mutex_lock(mtx); + while (!do_rwlock && !die) + erl_drv_cond_wait(cnd, mtx); + if (die) { + erl_drv_mutex_unlock(mtx); + return NULL; + } + erl_drv_mutex_unlock(mtx); + + erl_drv_rwlock_rwlock(rwlck); + rwlocked++; + erl_drv_rwlock_rwunlock(rwlck); + + return NULL; +} + +void +testcase_run(TestCaseState_t *tcs) +{ + int i, r; + ErlDrvSysInfo sinfo; + + driver_system_info(&sinfo, sizeof(ErlDrvSysInfo)); + if (!sinfo.thread_support) + testcase_skipped(tcs, "No thread support; nothing to test"); + + testcase_printf(tcs, "Initializing\n"); + die = 0; + ready = 0; + rlocked = 0; + rwlocked = 0; + do_rlock = 0; + do_rwlock = 0; + + mtx = erl_drv_mutex_create("test mutex"); + cnd = erl_drv_cond_create("test cond"); + rwlck = erl_drv_rwlock_create("test rwlock"); + ASSERT(tcs, mtx && cnd && rwlck); + + testcase_printf(tcs, "Creating %d threads\n", NO_OF_THREADS); + /* Create the threads */ + for (i = 0; i < NO_OF_THREADS; i++) { + char name[100]; + sprintf(name, "thread %d", i); + r = erl_drv_thread_create(name, + &test_thr[i].tid, + tf, + NULL, + NULL); + ASSERT(tcs, r == 0); + test_thr[i].alive = 1; + } + + testcase_printf(tcs, "Testing\n"); + erl_drv_rwlock_rwlock(rwlck); + + erl_drv_mutex_lock(mtx); + while (ready != NO_OF_THREADS) + erl_drv_cond_wait(cnd, mtx); + do_rlock = 1; + erl_drv_cond_broadcast(cnd); + erl_drv_mutex_unlock(mtx); + + do_sleep(1); + + erl_drv_mutex_lock(mtx); + + ASSERT_CLNUP(tcs, + rlocked == 0, + do { + erl_drv_mutex_unlock(mtx); + erl_drv_rwlock_rwunlock(rwlck); + } while (0)); + + erl_drv_mutex_unlock(mtx); + erl_drv_rwlock_rwunlock(rwlck); + + do_sleep(2); + + erl_drv_mutex_lock(mtx); + ASSERT_CLNUP(tcs, rlocked == NO_OF_THREADS, erl_drv_mutex_unlock(mtx)); + do_rwlock = 1; + erl_drv_cond_broadcast(cnd); + erl_drv_mutex_unlock(mtx); + + testcase_printf(tcs, "Joining threads\n"); + /* Join the threads */ + for (i = 0; i < NO_OF_THREADS; i++) { + void *res; + r = erl_drv_thread_join(test_thr[i].tid, NULL); + test_thr[i].alive = 0; + ASSERT(tcs, r == 0); + } + + erl_drv_mutex_lock(mtx); + ASSERT_CLNUP(tcs, rwlocked == NO_OF_THREADS, erl_drv_mutex_unlock(mtx)); + erl_drv_mutex_unlock(mtx); + + erl_drv_mutex_destroy(mtx); + mtx = NULL; + erl_drv_cond_destroy(cnd); + cnd = NULL; + erl_drv_rwlock_destroy(rwlck); + rwlck = NULL; + + testcase_printf(tcs, "done\n"); +} + +char * +testcase_name(void) +{ + return "rwlock"; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + int i; + for (i = 0; i < NO_OF_THREADS; i++) { + if (test_thr[i].alive) { + erl_drv_mutex_lock(mtx); + die = 1; + erl_drv_cond_broadcast(cnd); + erl_drv_mutex_unlock(mtx); + erl_drv_thread_join(test_thr[i].tid, NULL); + } + } + + if (mtx) + erl_drv_mutex_destroy(mtx); + if (cnd) + erl_drv_cond_destroy(cnd); + if (rwlck) + erl_drv_rwlock_destroy(rwlck); +} diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c new file mode 100644 index 0000000000..1e98844838 --- /dev/null +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.c @@ -0,0 +1,260 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include +#include +#include +#include +#include + +#ifdef __WIN32__ +#undef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 1 +#define vsnprintf _vsnprintf +#endif + +#ifndef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 0 +#endif + +#define COMMENT_BUF_SZ 4096 + +#define TESTCASE_FAILED 0 +#define TESTCASE_SKIPPED 1 +#define TESTCASE_SUCCEEDED 2 + +typedef struct { + TestCaseState_t visible; + ErlDrvPort port; + int result; + jmp_buf done_jmp_buf; + char *comment; + char comment_buf[COMMENT_BUF_SZ]; +} InternalTestCaseState_t; + +ErlDrvData testcase_drv_start(ErlDrvPort port, char *command); +void testcase_drv_stop(ErlDrvData drv_data); +void testcase_drv_run(ErlDrvData drv_data, char *buf, int len); + +static ErlDrvEntry testcase_drv_entry = { + NULL, + testcase_drv_start, + testcase_drv_stop, + testcase_drv_run +}; + + +DRIVER_INIT(testcase_drv) +{ + testcase_drv_entry.driver_name = testcase_name(); + return &testcase_drv_entry; +} + +ErlDrvData +testcase_drv_start(ErlDrvPort port, char *command) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) + driver_alloc(sizeof(InternalTestCaseState_t)); + if (!itcs) { + return ERL_DRV_ERROR_GENERAL; + } + + itcs->visible.testcase_name = testcase_name(); + itcs->visible.extra = NULL; + itcs->port = port; + itcs->result = TESTCASE_FAILED; + itcs->comment = ""; + + return (ErlDrvData) itcs; +} + +void +testcase_drv_stop(ErlDrvData drv_data) +{ + testcase_cleanup((TestCaseState_t *) drv_data); + driver_free((void *) drv_data); +} + +void +testcase_drv_run(ErlDrvData drv_data, char *buf, int len) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) drv_data; + ErlDrvTermData result_atom; + ErlDrvTermData msg[12]; + + itcs->visible.command = buf; + itcs->visible.command_len = len; + + if (setjmp(itcs->done_jmp_buf) == 0) { + testcase_run((TestCaseState_t *) itcs); + itcs->result = TESTCASE_SUCCEEDED; + } + + switch (itcs->result) { + case TESTCASE_SUCCEEDED: + result_atom = driver_mk_atom("succeeded"); + break; + case TESTCASE_SKIPPED: + result_atom = driver_mk_atom("skipped"); + break; + case TESTCASE_FAILED: + default: + result_atom = driver_mk_atom("failed"); + break; + } + + msg[0] = ERL_DRV_ATOM; + msg[1] = (ErlDrvTermData) result_atom; + + msg[2] = ERL_DRV_PORT; + msg[3] = driver_mk_port(itcs->port); + + msg[4] = ERL_DRV_ATOM; + msg[5] = driver_mk_atom(itcs->visible.testcase_name); + + msg[6] = ERL_DRV_STRING; + msg[7] = (ErlDrvTermData) itcs->comment; + msg[8] = (ErlDrvTermData) strlen(itcs->comment); + + msg[9] = ERL_DRV_TUPLE; + msg[10] = (ErlDrvTermData) 4; + + driver_output_term(itcs->port, msg, 11); +} + +int +testcase_assertion_failed(TestCaseState_t *tcs, + char *file, int line, char *assertion) +{ + testcase_failed(tcs, "%s:%d: Assertion failed: \"%s\"", + file, line, assertion); + return 0; +} + +void +testcase_printf(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + ErlDrvTermData msg[12]; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + msg[0] = ERL_DRV_ATOM; + msg[1] = (ErlDrvTermData) driver_mk_atom("print"); + + msg[2] = ERL_DRV_PORT; + msg[3] = driver_mk_port(itcs->port); + + msg[4] = ERL_DRV_ATOM; + msg[5] = driver_mk_atom(itcs->visible.testcase_name); + + msg[6] = ERL_DRV_STRING; + msg[7] = (ErlDrvTermData) itcs->comment_buf; + msg[8] = (ErlDrvTermData) strlen(itcs->comment_buf); + + msg[9] = ERL_DRV_TUPLE; + msg[10] = (ErlDrvTermData) 4; + + driver_output_term(itcs->port, msg, 11); +} + + +void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_SUCCEEDED; + itcs->comment = itcs->comment_buf; + + longjmp(itcs->done_jmp_buf, 1); +} + +void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_SKIPPED; + itcs->comment = itcs->comment_buf; + + longjmp(itcs->done_jmp_buf, 1); +} + +void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + char buf[10]; + size_t bufsz = sizeof(buf); + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_FAILED; + itcs->comment = itcs->comment_buf; + + if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + && strcmp("true", buf) == 0) { + fprintf(stderr, "Testcase \"%s\" failed: %s\n", + itcs->visible.testcase_name, itcs->comment); + abort(); + } + + longjmp(itcs->done_jmp_buf, 1); +} + +void *testcase_alloc(size_t size) +{ + return driver_alloc(size); +} + +void *testcase_realloc(void *ptr, size_t size) +{ + return driver_realloc(ptr, size); +} + +void testcase_free(void *ptr) +{ + driver_free(ptr); +} diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h new file mode 100644 index 0000000000..18d5229780 --- /dev/null +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/testcase_driver.h @@ -0,0 +1,58 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#ifndef TESTCASE_DRIVER_H__ +#define TESTCASE_DRIVER_H__ + +#include "erl_driver.h" +#include + +typedef struct { + char *testcase_name; + char *command; + int command_len; + void *extra; +} TestCaseState_t; + +#define ASSERT_CLNUP(TCS, B, CLN) \ +do { \ + if (!(B)) { \ + CLN; \ + testcase_assertion_failed((TCS), __FILE__, __LINE__, #B); \ + } \ +} while (0) + +#define ASSERT(TCS, B) ASSERT_CLNUP(TCS, B, (void) 0) + + +void testcase_printf(TestCaseState_t *tcs, char *frmt, ...); +void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...); +void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...); +void testcase_failed(TestCaseState_t *tcs, char *frmt, ...); +int testcase_assertion_failed(TestCaseState_t *tcs, char *file, int line, + char *assertion); +void *testcase_alloc(size_t size); +void *testcase_realloc(void *ptr, size_t size); +void testcase_free(void *ptr); + + +char *testcase_name(void); +void testcase_run(TestCaseState_t *tcs); +void testcase_cleanup(TestCaseState_t *tcs); + +#endif diff --git a/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c b/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c new file mode 100644 index 0000000000..3809c915e0 --- /dev/null +++ b/erts/emulator/test/erl_drv_thread_SUITE_data/tsd.c @@ -0,0 +1,173 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include + +#define NO_OF_THREADS 17 +#define NO_OF_KEYS 4711 + +struct { + int alive; + ErlDrvTid tid; +} test_thr[NO_OF_THREADS] = {0}; + +struct { + int used; + ErlDrvTSDKey key; +} test_key[NO_OF_KEYS] = {0}; + +typedef struct { + int n; +} thr_arg_t; + +static void *tf(void *vta) +{ + int i; + int thr_val = (((thr_arg_t *) vta)->n << 16); + + for (i = 0; i < NO_OF_KEYS; i++) + erl_drv_tsd_set(test_key[i].key, (void *) (thr_val | i)); + + for (i = 0; i < NO_OF_KEYS; i++) + if (erl_drv_tsd_get(test_key[i].key) != ((void *) (thr_val | i))) + return (void *) 1; + + for (i = 0; i < NO_OF_KEYS; i++) + erl_drv_tsd_set(test_key[i].key, NULL); + + for (i = 0; i < NO_OF_KEYS; i++) + if (erl_drv_tsd_get(test_key[i].key) != NULL) + return (void *) 2; + + return (void *) 3; +} + +void +thr_key_clnup(void) +{ + int i; + for (i = 0; i < NO_OF_KEYS; i++) + erl_drv_tsd_set(test_key[i].key, NULL); +} + +void +testcase_run(TestCaseState_t *tcs) +{ + int i, r; + thr_arg_t ta[NO_OF_THREADS]; + ErlDrvSysInfo sinfo; + + testcase_printf(tcs, "Initializing\n"); + + driver_system_info(&sinfo, sizeof(ErlDrvSysInfo)); + + for (i = 0; i < NO_OF_KEYS; i++) { + char name[100]; + sprintf(name, "key %d", i); + r = erl_drv_tsd_key_create(name, &test_key[i].key); + ASSERT(tcs, r == 0); + test_key[i].used = 1; + } + + for (i = 0; i < NO_OF_KEYS; i++) + erl_drv_tsd_set(test_key[i].key, + (void *) (((NO_OF_THREADS+1) << 16) | i)); + + if (!sinfo.thread_support) + testcase_printf(tcs, "No thread support; testing tsd in one thread\n"); + else { + testcase_printf(tcs, "Creating %d threads\n", NO_OF_THREADS); + + /* Create the threads */ + for (i = 0; i < NO_OF_THREADS; i++) { + char name[100]; + ta[i].n = 0; + sprintf(name, "thread %d", i); + r = erl_drv_thread_create(name, + &test_thr[i].tid, + tf, + (void *) &ta[i], + NULL); + ASSERT_CLNUP(tcs, r == 0, thr_key_clnup()); + test_thr[i].alive = 1; + } + } + + testcase_printf(tcs, "Testing tsd\n"); + + for (i = 0; i < NO_OF_KEYS; i++) + ASSERT_CLNUP(tcs, + ((void *) (((NO_OF_THREADS+1) << 16) | i) + == erl_drv_tsd_get(test_key[i].key)), + thr_key_clnup()); + + testcase_printf(tcs, "Joining threads\n"); + + if (sinfo.thread_support) { + /* Join the threads */ + for (i = 0; i < NO_OF_THREADS; i++) { + void *res; + r = erl_drv_thread_join(test_thr[i].tid, &res); + test_thr[i].alive = 0; + ASSERT_CLNUP(tcs, r == 0, thr_key_clnup()); + ASSERT_CLNUP(tcs, res == ((void *) 3), thr_key_clnup()); + } + } + + thr_key_clnup(); + + for (i = 0; i < NO_OF_KEYS; i++) + ASSERT(tcs, NULL == erl_drv_tsd_get(test_key[i].key)); + + testcase_printf(tcs, "Destroying keys\n"); + + for (i = 0; i < NO_OF_KEYS; i++) + if (test_key[i].used) { + test_key[i].used = 0; + erl_drv_tsd_key_destroy(test_key[i].key); + } + + testcase_printf(tcs, "done\n"); + + if (!sinfo.thread_support) + testcase_succeeded(tcs, "No thread support; only one thread tested"); +} + +char * +testcase_name(void) +{ + return "tsd"; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + int i; + for (i = 0; i < NO_OF_THREADS; i++) + if (test_thr[i].alive) { + test_thr[i].alive = 0; + erl_drv_thread_join(test_thr[i].tid, NULL); + } + + for (i = 0; i < NO_OF_KEYS; i++) + if (test_key[i].used) { + test_key[i].used = 0; + erl_drv_tsd_key_destroy(test_key[i].key); + } +} diff --git a/erts/emulator/test/erl_link_SUITE.erl b/erts/emulator/test/erl_link_SUITE.erl new file mode 100644 index 0000000000..542c8dffbe --- /dev/null +++ b/erts/emulator/test/erl_link_SUITE.erl @@ -0,0 +1,1133 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%---------------------------------------------------------------------- +%%% File : erl_link_SUITE.erl +%%% Author : Rickard Green +%%% Purpose : Test erlang links +%%% Created : 13 Dec 2001 by Rickard Green +%%%---------------------------------------------------------------------- + +-module(erl_link_SUITE). +-author('rickard.green@uab.ericsson.se'). + +%-define(line_trace, 1). +-include("test_server.hrl"). + +-export([all/1]). + +% Test cases +-export([links/1, + dist_links/1, + monitor_nodes/1, + process_monitors/1, + dist_process_monitors/1, + busy_dist_port_monitor/1, + busy_dist_port_link/1, + otp_5772_link/1, + otp_5772_dist_link/1, + otp_5772_monitor/1, + otp_5772_dist_monitor/1, + otp_7946/1]). + +-export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). + +% Internal exports +-export([test_proc/0]). + + +-define(LINK_UNDEF, 0). +-define(LINK_PID, 1). +-define(LINK_NODE, 3). + + +% These are to be kept in sync with erl_monitors.h +-define(MON_ORIGIN, 1). +-define(MON_TARGET, 3). + + +-record(erl_link, {type = ?LINK_UNDEF, + pid = [], + targets = []}). + +% This is to be kept in sync with erl_bif_info.c (make_monitor_list) + +-record(erl_monitor, { + type, % MON_ORIGIN or MON_TARGET (1 or 3) + ref, + pid, % Process or nodename + name = [] % registered name or [] + }). + + + +all(suite) -> [links, dist_links, monitor_nodes, process_monitors, + dist_process_monitors, busy_dist_port_monitor, + busy_dist_port_link, otp_5772_link, otp_5772_dist_link, + otp_5772_monitor, otp_5772_dist_monitor, + otp_7946]. + +links(doc) -> ["Tests node local links"]; +links(suite) -> []; +links(Config) when is_list(Config) -> + ?line common_link_test(node(), node()), + ?line true = link(self()), + ?line [] = find_erl_link(self(), ?LINK_PID, self()), + ?line true = unlink(self()), + ?line ok. + +dist_links(doc) -> ["Tests distributed links"]; +dist_links(suite) -> []; +dist_links(Config) when is_list(Config) -> + ?line [NodeName] = get_names(1, dist_link), + ?line {ok, Node} = start_node(NodeName), + ?line common_link_test(node(), Node), + ?line TP4 = spawn(?MODULE, test_proc, []), + ?line TP5 = spawn(?MODULE, test_proc, []), + ?line TP6 = spawn(Node, ?MODULE, test_proc, []), + ?line true = tp_call(TP6, fun() -> link(TP4) end), + ?line check_link(TP4, TP6), + ?line true = tp_call(TP5, + fun() -> + process_flag(trap_exit,true), + link(TP6) + end), + ?line check_link(TP5, TP6), + ?line rpc:cast(Node, erlang, halt, []), + ?line wait_until(fun () -> ?line is_proc_dead(TP4) end), + ?line check_unlink(TP4, TP6), + ?line true = tp_call(TP5, + fun() -> + receive + {'EXIT', TP6, noconnection} -> + true + end + end), + ?line check_unlink(TP5, TP6), + ?line tp_cast(TP5, fun() -> exit(normal) end), + ?line ok. + +common_link_test(NodeA, NodeB) -> + ?line TP1 = spawn(NodeA, ?MODULE, test_proc, []), + ?line check_unlink(TP1, self()), + ?line TP2 = tp_call(TP1, + fun () -> + spawn_link(NodeB, ?MODULE, test_proc, []) + end), + ?line check_link(TP1, TP2), + ?line true = tp_call(TP2, fun() -> unlink(TP1) end), + ?line check_unlink(TP1, TP2), + ?line true = tp_call(TP2, fun() -> link(TP1) end), + ?line check_link(TP1, TP2), + ?line false = tp_call(TP2, fun() -> process_flag(trap_exit, true) end), + ?line tp_cast(TP1, fun () -> exit(died) end), + ?line true = tp_call(TP2, fun() -> + receive + {'EXIT', TP1, died} -> + true + end + end), + ?line check_unlink(TP1, TP2), + ?line TP3 = tp_call(TP2, + fun () -> + spawn_link(NodeA, ?MODULE, test_proc, []) + end), + ?line check_link(TP3, TP2), + ?line tp_cast(TP2, fun() -> exit(died) end), + ?line wait_until(fun () -> ?line is_proc_dead(TP3) end), + ?line check_unlink(TP3, TP2), + ?line ok. + +monitor_nodes(doc) -> ["Tests monitor of nodes"]; +monitor_nodes(suite) -> []; +monitor_nodes(Config) when is_list(Config) -> + ?line [An, Bn, Cn, Dn] = get_names(4, dist_link), + ?line {ok, A} = start_node(An), + ?line {ok, B} = start_node(Bn), + ?line C = list_to_atom(lists:concat([Cn, "@", hostname()])), + ?line D = list_to_atom(lists:concat([Dn, "@", hostname()])), + ?line 0 = no_of_monitor_node(self(), A), + ?line 0 = no_of_monitor_node(self(), B), + ?line monitor_node(A, true), + ?line monitor_node(B, true), + ?line monitor_node(D, true), + ?line monitor_node(D, true), + + %% Has been known to crash the emulator. + ?line {memory,_} = process_info(self(), memory), + + ?line monitor_node(A, false), + ?line monitor_node(B, true), + ?line monitor_node(C, true), + ?line monitor_node(C, false), + ?line monitor_node(C, true), + ?line monitor_node(B, true), + ?line monitor_node(A, false), + ?line monitor_node(B, true), + ?line monitor_node(B, false), + ?line monitor_node(A, true), + ?line check_monitor_node(self(), A, 1), + ?line check_monitor_node(self(), B, 3), + ?line check_monitor_node(self(), C, 0), + ?line check_monitor_node(self(), D, 0), + ?line receive {nodedown, C} -> ok end, + ?line receive {nodedown, C} -> ok end, + ?line receive {nodedown, C} -> ok end, + ?line receive {nodedown, D} -> ok end, + ?line receive {nodedown, D} -> ok end, + ?line stop_node(A), + ?line receive {nodedown, A} -> ok end, + ?line check_monitor_node(self(), A, 0), + ?line check_monitor_node(self(), B, 3), + ?line stop_node(B), + ?line receive {nodedown, B} -> ok end, + ?line receive {nodedown, B} -> ok end, + ?line receive {nodedown, B} -> ok end, + ?line check_monitor_node(self(), B, 0), + ?line receive + {nodedown, X} -> + ?line ?t:fail({unexpected_nodedown, X}) + after 0 -> + ?line ok + end, + ?line ok. + + +process_monitors(doc) -> ["Tests node local process monitors"]; +process_monitors(suite) -> []; +process_monitors(Config) when is_list(Config) -> + ?line common_process_monitors(node(), node()), + ?line Mon1 = erlang:monitor(process,self()), + ?line [] = find_erl_monitor(self(), Mon1), + ?line [Name] = get_names(1, process_monitors), + ?line true = register(Name, self()), + ?line Mon2 = erlang:monitor(process, Name), + ?line [] = find_erl_monitor(self(), Mon2), + ?line receive + {'DOWN', Mon1, _, _, _} = Msg -> + ?line ?t:fail({unexpected_down_msg, Msg}); + {'DOWN', Mon2, _, _, _} = Msg -> + ?line ?t:fail({unexpected_down_msg, Msg}) + after 500 -> + ?line true = erlang:demonitor(Mon1), + ?line true = erlang:demonitor(Mon2), + ?line ok + end. + +dist_process_monitors(doc) -> ["Tests distributed process monitors"]; +dist_process_monitors(suite) -> []; +dist_process_monitors(Config) when is_list(Config) -> + ?line [Name] = get_names(1,dist_process_monitors), + ?line {ok, Node} = start_node(Name), + ?line common_process_monitors(node(), Node), + ?line TP1 = spawn(Node, ?MODULE, test_proc, []), + ?line R1 = erlang:monitor(process, TP1), + ?line TP1O = get_down_object(TP1, self()), + ?line check_process_monitor(self(), TP1, R1), + ?line tp_cast(TP1, fun () -> halt() end), + ?line receive + {'DOWN',R1,process,TP1O,noconnection} -> + ?line ok + end, + ?line check_process_demonitor(self(), TP1, R1), + ?line R2 = erlang:monitor(process, TP1), + ?line receive + {'DOWN',R2,process,TP1O,noconnection} -> + ?line ok + end, + ?line check_process_demonitor(self(), TP1, R2), + ?line ok. + + +common_process_monitors(NodeA, NodeB) -> + ?line TP1 = spawn(NodeA, ?MODULE, test_proc, []), + ?line TP2 = spawn(NodeB, ?MODULE, test_proc, []), + ?line run_common_process_monitors(TP1, TP2), + ?line TP3 = spawn(NodeA, ?MODULE, test_proc, []), + ?line TP4 = spawn(NodeB, ?MODULE, test_proc, []), + ?line [TP4N] = get_names(1, common_process_monitors), + ?line true = tp_call(TP4, fun () -> register(TP4N,self()) end), + ?line run_common_process_monitors(TP3, + case node() == node(TP4) of + true -> TP4N; + false -> {TP4N, node(TP4)} + end), + ?line ok. + +run_common_process_monitors(TP1, TP2) -> + ?line R1 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + ?line check_process_monitor(TP1, TP2, R1), + + ?line tp_call(TP2, fun () -> catch erlang:demonitor(R1) end), + ?line check_process_monitor(TP1, TP2, R1), + + ?line true = tp_call(TP1, fun () -> erlang:demonitor(R1) end), + ?line check_process_demonitor(TP1, TP2, R1), + + ?line R2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + ?line TP2O = get_down_object(TP2, TP1), + ?line check_process_monitor(TP1, TP2, R2), + ?line tp_cast(TP2, fun () -> exit(bye) end), + ?line wait_until(fun () -> ?line is_proc_dead(TP2) end), + ?line ok = tp_call(TP1, fun () -> + ?line receive + {'DOWN',R2,process,TP2O,bye} -> + ?line ok + end + end), + ?line check_process_demonitor(TP1, TP2, R2), + + ?line R3 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + ?line ok = tp_call(TP1, fun () -> + ?line receive + {'DOWN',R3,process,TP2O,noproc} -> + ?line ok + end + end), + ?line check_process_demonitor(TP1, TP2, R3), + + ?line tp_cast(TP1, fun () -> exit(normal) end), + ?line wait_until(fun () -> ?line is_proc_dead(TP1) end), + ?line ok. + + +busy_dist_port_monitor(doc) -> ["Tests distributed monitor/2, demonitor/1, " + "and 'DOWN' message over busy distribution " + "port"]; +busy_dist_port_monitor(suite) -> []; +busy_dist_port_monitor(Config) when is_list(Config) -> + + ?line Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, + + ?line [An] = get_names(1, busy_dist_port_monitor), + ?line {ok, A} = start_node(An), + ?line TP1 = spawn(A, ?MODULE, test_proc, []), + %% Check monitor over busy port + ?line M1 = suspend_on_busy_test(A, + "erlang:monitor(process, TP1)", + fun () -> erlang:monitor(process, TP1) end), + ?line check_process_monitor(self(), TP1, M1), + %% Check demonitor over busy port + ?line suspend_on_busy_test(A, + "erlang:demonitor(M1)", + fun () -> erlang:demonitor(M1) end), + ?line check_process_demonitor(self(), TP1, M1), + %% Check down message over busy port + ?line TP2 = spawn(?MODULE, test_proc, []), + ?line M2 = tp_call(TP1, fun () -> erlang:monitor(process, TP2) end), + ?line check_process_monitor(TP1, TP2, M2), + ?line Ref = make_ref(), + ?line Busy = make_busy(A, 1000), + ?line receive after 100 -> ok end, + ?line tp_cast(TP2, fun () -> exit(Ref) end), + ?line receive after 100 -> ok end, + ?line unmake_busy(Busy), + ?line Ref = tp_call(TP1, fun () -> + receive + {'DOWN', M2, process, TP2, Ref} -> + Ref + end + end), + ?line tp_cast(TP1, fun () -> exit(normal) end), + ?line stop_node(A), + ?line stop_busy_dist_port_tracer(Tracer), + ?line ok. + +busy_dist_port_link(doc) -> ["Tests distributed link/1, unlink/1, and 'EXIT'", + " message over busy distribution port"]; +busy_dist_port_link(suite) -> []; +busy_dist_port_link(Config) when is_list(Config) -> + ?line Tracer = case os:getenv("TRACE_BUSY_DIST_PORT") of + "true" -> start_busy_dist_port_tracer(); + _ -> false + end, + + ?line [An] = get_names(1, busy_dist_port_link), + ?line {ok, A} = start_node(An), + ?line TP1 = spawn(A, ?MODULE, test_proc, []), + %% Check link over busy port + ?line suspend_on_busy_test(A, + "link(TP1)", + fun () -> link(TP1) end), + ?line check_link(self(), TP1), + %% Check unlink over busy port + ?line suspend_on_busy_test(A, + "unlink(TP1)", + fun () -> unlink(TP1) end), + ?line check_unlink(self(), TP1), + %% Check trap exit message over busy port + ?line TP2 = spawn(?MODULE, test_proc, []), + ?line ok = tp_call(TP1, fun () -> + process_flag(trap_exit, true), + link(TP2), + ok + end), + ?line check_link(TP1, TP2), + ?line Ref = make_ref(), + ?line Busy = make_busy(A, 1000), + ?line receive after 100 -> ok end, + ?line tp_cast(TP2, fun () -> exit(Ref) end), + ?line receive after 100 -> ok end, + ?line unmake_busy(Busy), + ?line Ref = tp_call(TP1, fun () -> + receive + {'EXIT', TP2, Ref} -> + Ref + end + end), + ?line tp_cast(TP1, fun () -> exit(normal) end), + ?line stop_node(A), + ?line stop_busy_dist_port_tracer(Tracer), + ?line ok. + + +otp_5772_link(doc) -> []; +otp_5772_link(suite) -> []; +otp_5772_link(Config) when is_list(Config) -> + ?line otp_5772_link_test(node()). + +otp_5772_dist_link(doc) -> []; +otp_5772_dist_link(suite) -> []; +otp_5772_dist_link(Config) when is_list(Config) -> + ?line [An] = get_names(1, otp_5772_dist_link), + ?line {ok, A} = start_node(An), + ?line otp_5772_link_test(A), + ?line stop_node(A). + +otp_5772_link_test(Node) -> + ?line Prio = process_flag(priority, high), + ?line TE = process_flag(trap_exit, true), + ?line TP1 = spawn_opt(Node, ?MODULE, test_proc, [], + [link, {priority, low}]), + exit(TP1, bang), + unlink(TP1), + ?line receive + {'EXIT', TP1, _} -> + ?line ok + after 0 -> + ?line ok + end, + ?line receive + {'EXIT', TP1, _} = Exit -> + ?line ?t:fail({got_late_exit_message, Exit}) + after 1000 -> + ?line ok + end, + ?line process_flag(trap_exit, TE), + ?line process_flag(priority, Prio), + ?line ok. + +otp_5772_monitor(doc) -> []; +otp_5772_monitor(suite) -> []; +otp_5772_monitor(Config) when is_list(Config) -> + ?line otp_5772_monitor_test(node()). + +otp_5772_dist_monitor(doc) -> []; +otp_5772_dist_monitor(suite) -> []; +otp_5772_dist_monitor(Config) when is_list(Config) -> + ?line [An] = get_names(1, otp_5772_dist_monitor), + ?line {ok, A} = start_node(An), + ?line otp_5772_monitor_test(A), + ?line stop_node(A), + ?line ok. + +otp_5772_monitor_test(Node) -> + ?line Prio = process_flag(priority, high), + ?line TP1 = spawn_opt(Node, ?MODULE, test_proc, [], [{priority, low}]), + ?line M1 = erlang:monitor(process, TP1), + ?line exit(TP1, bang), + ?line erlang:demonitor(M1), + ?line receive + {'DOWN', M1, _, _, _} -> + ?line ok + after 0 -> + ?line ok + end, + ?line receive + {'DOWN', M1, _, _, _} = Down -> + ?line ?t:fail({got_late_down_message, Down}) + after 1000 -> + ?line ok + end, + ?line process_flag(priority, Prio), + ?line ok. + +otp_7946(Config) when is_list(Config) -> + ?line [NodeName] = get_names(1, otp_7946), + ?line {ok, Node} = start_node(NodeName), + ?line Proc = rpc:call(Node, erlang, whereis, [net_kernel]), + ?line Mon = erlang:monitor(process, Proc), + ?line rpc:cast(Node, erlang, halt, []), + ?line receive {'DOWN', Mon, process, Proc , _} -> ok end, + ?line {Linker, LMon} = spawn_monitor(fun () -> + link(Proc), + receive + after infinity -> ok + end + end), + ?line receive + {'DOWN', LMon, process, Linker, Reason} -> + ?line ?t:format("Reason=~p~n", [Reason]), + ?line Reason = noconnection + end. + +%% +%% -- Internal utils -------------------------------------------------------- +%% + +-define(BUSY_DATA_KEY, '__busy__port__data__'). +-define(BUSY_DATA_SIZE, 1024*1024). + +busy_data() -> + case get(?BUSY_DATA_KEY) of + undefined -> + set_busy_data([]); + Data -> + true = is_binary(Data), + true = size(Data) == ?BUSY_DATA_SIZE, + Data + end. + +set_busy_data(SetData) -> + case get(?BUSY_DATA_KEY) of + undefined -> + Data = case SetData of + D when is_binary(D), size(D) == ?BUSY_DATA_SIZE -> + SetData; + _ -> + list_to_binary(lists:duplicate(?BUSY_DATA_SIZE, 253)) + end, + put(?BUSY_DATA_KEY, Data), + Data; + OldData -> + OldData + end. + +freeze_node(Node, MS) -> + Own = 500, + DoingIt = make_ref(), + Freezer = self(), + spawn_link(Node, + fun () -> + erts_debug:set_internal_state(available_internal_state, + true), + dport_send(Freezer, DoingIt), + receive after Own -> ok end, + erts_debug:set_internal_state(block, MS+Own) + end), + receive DoingIt -> ok end, + receive after Own -> ok end. + +make_busy(Node, Time) when is_integer(Time) -> + Own = 500, + freeze_node(Node, Time+Own), + Data = busy_data(), + %% first make port busy + Pid = spawn_link(fun () -> + forever(fun () -> + dport_reg_send(Node, + '__noone__', + Data) + end) + end), + receive after Own -> ok end, + wait_until(fun () -> + case process_info(Pid, status) of + {status, suspended} -> true; + _ -> false + end + end), + %% then dist entry + make_busy(Node, [nosuspend], Data), + Pid. + +make_busy(Node, Opts, Data) -> + case erlang:send({'__noone__', Node}, Data, Opts) of + nosuspend -> nosuspend; + _ -> make_busy(Node, Opts, Data) + end. + +unmake_busy(Pid) -> + unlink(Pid), + exit(Pid, bang). + +suspend_on_busy_test(Node, Doing, Fun) -> + Tester = self(), + DoIt = make_ref(), + Done = make_ref(), + Data = busy_data(), + spawn_link(fun () -> + set_busy_data(Data), + Busy = make_busy(Node, 1000), + Tester ! DoIt, + receive after 100 -> ok end, + Info = process_info(Tester, [status, current_function]), + unmake_busy(Busy), + ?t:format("~p doing ~s: ~p~n", [Tester, Doing, Info]), + Tester ! {Done, Info} + end), + receive DoIt -> ok end, + Res = Fun(), + receive + {Done, MyInfo} -> + %% Don't match arity; it is different in + %% debug and optimized emulator + [{status, suspended}, + {current_function, {erlang, bif_return_trap, _}}] = MyInfo, + ok + end, + Res. + +% get_node(Name) when is_atom(Name) -> +% ?line node(); +% get_node({Name, Node}) when is_atom(Name) -> +% ?line Node; +% get_node(NC) when is_pid(NC); is_port(NC); is_reference(NC) -> +% ?line node(NC). + +get_down_object(Item, _) when is_pid(Item) -> + Item; +get_down_object({Name, Node} = Item, _) when is_atom(Name); is_atom(Node) -> + Item; +get_down_object(Item, Watcher) when is_atom(Item), is_pid(Watcher) -> + {Item, node(Watcher)}; +get_down_object(Item, {_,Node}) when is_atom(Item), is_atom(Node) -> + {Item, Node}; +get_down_object(Item, Watcher) when is_atom(Item), is_atom(Watcher) -> + {Item, node()}. + +is_proc_dead(P) -> + case is_proc_alive(P) of + true -> false; + false -> true + end. + +is_proc_alive(Pid) when is_pid(Pid), node(Pid) == node() -> + ?line is_process_alive(Pid); +is_proc_alive(Name) when is_atom(Name) -> + ?line case catch whereis(Name) of + Pid when is_pid(Pid) -> + ?line is_proc_alive(Pid); + _ -> + ?line false + end; +is_proc_alive({Name, Node}) when is_atom(Name), Node == node() -> + ?line is_proc_alive(Name); +is_proc_alive(Proc) -> + ?line is_remote_proc_alive(Proc). + +is_remote_proc_alive({Name, Node}) when is_atom(Name), is_atom(Node) -> + ?line is_remote_proc_alive(Name, Node); +is_remote_proc_alive(Pid) when is_pid(Pid) -> + ?line is_remote_proc_alive(Pid, node(Pid)); +is_remote_proc_alive(_) -> + ?line false. + +is_remote_proc_alive(PN, Node) -> + ?line S = self(), + ?line R = make_ref(), + ?line monitor_node(Node, true), + ?line _P = spawn(Node, fun () -> S ! {R, is_proc_alive(PN)} end), + ?line receive + {R, Bool} -> + ?line monitor_node(Node, false), + ?line Bool; + {nodedown, Node} -> + ?line false + end. + +wait_until(Fun) -> + ?line case Fun() of + true -> + ?line ok; + _ -> + ?line receive + after 100 -> + ?line wait_until(Fun) + end + end. + +forever(Fun) -> + Fun(), + forever(Fun). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + ?line Dog = ?t:timetrap(?t:minutes(1)), + case catch erts_debug:get_internal_state(available_internal_state) of + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + ?line [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + ?line Dog = ?config(watchdog, Config), + ?line ?t:timetrap_cancel(Dog). + +end_per_suite(_Config) -> + catch erts_debug:set_internal_state(available_internal_state, false). + +tp_call(Tp, Fun) -> + ?line R = make_ref(), + ?line Tp ! {call, self(), R, Fun}, + ?line receive + {R, Res} -> + ?line Res + end. + +tp_cast(Tp, Fun) -> + ?line Tp ! {cast, Fun}. + +test_proc() -> + ?line receive + {call, From, Ref, Fun} -> + ?line From ! {Ref, Fun()}; + {cast, Fun} -> + ?line Fun() + end, + ?line test_proc(). + +expand_link_list([#erl_link{type = ?LINK_NODE, targets = N} = Rec | T]) -> + lists:duplicate(N,Rec#erl_link{targets = []}) ++ expand_link_list(T); +expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}]} = Rec | T]) -> + [Rec#erl_link{targets = [Pid]} | expand_link_list(T)]; +expand_link_list([#erl_link{targets = [#erl_link{pid = Pid}|TT]} = Rec | T]) -> + [ Rec#erl_link{targets = [Pid]} | expand_link_list( + [Rec#erl_link{targets = TT} | T])]; +expand_link_list([#erl_link{targets = []} = Rec | T]) -> + [Rec | expand_link_list(T)]; +expand_link_list([]) -> + []. + +get_local_link_list(Obj) -> + case catch erts_debug:get_internal_state({link_list, Obj}) of + LL when is_list(LL) -> + expand_link_list(LL); + _ -> + [] + end. + +get_remote_link_list(Node, Obj) -> + case catch rpc:call(Node, erts_debug, get_internal_state, + [{link_list, Obj}]) of + LL when is_list(LL) -> + expand_link_list(LL); + _ -> + [] + end. + + +get_link_list({Node, DistEntry}) when Node == node(), is_atom(DistEntry) -> + get_local_link_list(DistEntry); +get_link_list({Node, DistEntry}) when is_atom(Node), is_atom(DistEntry) -> + get_remote_link_list(Node, DistEntry); +get_link_list(P) when is_pid(P); is_port(P) -> + case node(P) of + Node when Node == node() -> + get_local_link_list(P); + Node -> + get_remote_link_list(Node, P) + end; +get_link_list(undefined) -> + []. + +get_local_monitor_list(Obj) -> + case catch erts_debug:get_internal_state({monitor_list, Obj}) of + LL when is_list(LL) -> + LL; + _ -> + [] + end. + +get_remote_monitor_list(Node, Obj) -> + case catch rpc:call(Node, erts_debug, get_internal_state, + [{monitor_list, Obj}]) of + LL when is_list(LL) -> + LL; + _ -> + [] + end. + + +get_monitor_list({Node, DistEntry}) when Node == node(), is_atom(DistEntry) -> + get_local_monitor_list(DistEntry); +get_monitor_list({Node, DistEntry}) when is_atom(Node), is_atom(DistEntry) -> + get_remote_monitor_list(Node, DistEntry); +get_monitor_list(P) when is_pid(P) -> + case node(P) of + Node when Node == node() -> + get_local_monitor_list(P); + Node -> + get_remote_monitor_list(Node, P) + end; +get_monitor_list(undefined) -> + []. + + +find_erl_monitor(Pid, Ref) when is_reference(Ref) -> + lists:foldl(fun (#erl_monitor{ref = R} = EL, Acc) when R == Ref -> + [EL|Acc]; + (_, Acc) -> + Acc + end, + [], + get_monitor_list(Pid)). + +% find_erl_link(Obj, Ref) when is_reference(Ref) -> +% ?line lists:foldl(fun (#erl_link{ref = R} = EL, Acc) when R == Ref -> +% ?line [EL|Acc]; +% (_, Acc) -> +% ?line Acc +% end, +% [], +% get_link_list(Obj)). + +find_erl_link(Obj, Type, [Item, Data]) when is_pid(Item); + is_port(Item); + is_atom(Item) -> + lists:foldl(fun (#erl_link{type = T, pid = I, targets = D} = EL, + Acc) when T == Type, I == Item -> + case Data of + D -> + [EL|Acc]; + [] -> + [EL|Acc]; + _ -> + Acc + end; + (_, Acc) -> + Acc + end, + [], + get_link_list(Obj)); +find_erl_link(Obj, Type, Item) when is_pid(Item); is_port(Item); is_atom(Item) -> + find_erl_link(Obj, Type, [Item, []]). + + + +check_link(A, B) -> + ?line [#erl_link{type = ?LINK_PID, + pid = B, + targets = []}] = find_erl_link(A, ?LINK_PID, B), + ?line [#erl_link{type = ?LINK_PID, + pid = A, + targets = []}] = find_erl_link(B, ?LINK_PID, A), + ?line case node(A) == node(B) of + false -> + ?line [#erl_link{type = ?LINK_PID, + pid = A, + targets = [B]}] = find_erl_link({node(A), + node(B)}, + ?LINK_PID, + [A, [B]]), + ?line [#erl_link{type = ?LINK_PID, + pid = B, + targets = [A]}] = find_erl_link({node(B), + node(A)}, + ?LINK_PID, + [B, [A]]); + true -> + ?line [] = find_erl_link({node(A), node(B)}, + ?LINK_PID, + [A, [B]]), + ?line [] = find_erl_link({node(B), node(A)}, + ?LINK_PID, + [B, [A]]) + end, + ?line ok. + +check_unlink(A, B) -> + ?line [] = find_erl_link(A, ?LINK_PID, B), + ?line [] = find_erl_link(B, ?LINK_PID, A), + ?line [] = find_erl_link({node(A), node(B)}, ?LINK_PID, [A, [B]]), + ?line [] = find_erl_link({node(B), node(A)}, ?LINK_PID, [B, [A]]), + ?line ok. + +check_process_monitor(From, {Name, Node}, Ref) when is_pid(From), + is_atom(Name), + Node == node(From), + is_reference(Ref) -> + ?line check_process_monitor(From, Name, Ref); +check_process_monitor(From, {Name, Node}, Ref) when is_pid(From), + is_atom(Name), + is_atom(Node), + is_reference(Ref) -> + ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + ?line [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = Node, + name = Name}] = find_erl_monitor(From, Ref), + ?line [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor({node(From), Node}, Ref), + ?line [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = MonitoredPid, + name = Name}] = find_erl_monitor({Node, node(From)}, Ref), + ?line [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor(MonitoredPid, Ref), + ?line ok; +check_process_monitor(From, Name, Ref) when is_pid(From), + is_atom(Name), + undefined /= Name, + is_reference(Ref) -> + ?line MonitoredPid = rpc:call(node(From), erlang, whereis, [Name]), + + ?line [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = MonitoredPid, + name = Name}] = find_erl_monitor(From, Ref), + + + ?line [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From, + name = Name}] = find_erl_monitor(MonitoredPid,Ref), + ok; +check_process_monitor(From, To, Ref) when is_pid(From), + is_pid(To), + is_reference(Ref) -> + ?line OriMon = [#erl_monitor{type = ?MON_ORIGIN, + ref = Ref, + pid = To}], + + ?line OriMon = find_erl_monitor(From, Ref), + + ?line TargMon = [#erl_monitor{type = ?MON_TARGET, + ref = Ref, + pid = From}], + ?line TargMon = find_erl_monitor(To, Ref), + + + ?line case node(From) == node(To) of + false -> + ?line TargMon = find_erl_monitor({node(From), node(To)}, Ref), + ?line OriMon = find_erl_monitor({node(To), node(From)}, Ref); + true -> + ?line [] = find_erl_monitor({node(From), node(From)}, Ref) + end, + ?line ok. + + +check_process_demonitor(From, {undefined, Node}, Ref) when is_pid(From), + is_reference(Ref) -> + ?line [] = find_erl_monitor(From, Ref), + ?line case node(From) == Node of + false -> + ?line [] = find_erl_monitor({node(From), Node}, Ref), + ?line [] = find_erl_monitor({Node, node(From)}, Ref); + true -> + ?line [] = find_erl_monitor({Node, Node}, Ref) + end, + ?line ok; +check_process_demonitor(From, {Name, Node}, Ref) when is_pid(From), + is_atom(Name), + Node == node(From), + is_reference(Ref) -> + ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + ?line case rpc:call(Node, erlang, whereis, [Name]) of + undefined -> + ?line check_process_demonitor(From, {undefined, Node}, Ref); + MonitoredPid -> + ?line check_process_demonitor(From, MonitoredPid, Ref) + end; +check_process_demonitor(From, {Name, Node}, Ref) when is_pid(From), + is_atom(Name), + is_atom(Node), + is_reference(Ref) -> + ?line MonitoredPid = rpc:call(Node, erlang, whereis, [Name]), + ?line [] = find_erl_monitor(From, Ref), + ?line [] = find_erl_monitor({node(From), Node}, Ref), + ?line [] = find_erl_monitor({Node, node(From)}, Ref), + ?line [] = find_erl_monitor(MonitoredPid, Ref), + ?line ok; +check_process_demonitor(From, undefined, Ref) when is_pid(From), + is_reference(Ref) -> + ?line [] = find_erl_monitor(From, Ref), + ?line case node(From) == node() of + false -> + ?line [] = find_erl_monitor({node(From), node()}, Ref), + ?line [] = find_erl_monitor({node(), node(From)}, Ref); + true -> + ?line [] = find_erl_monitor({node(), node()}, Ref) + end, + ?line ok; +check_process_demonitor(From, Name, Ref) when is_pid(From), + is_atom(Name), + undefined /= Name, + is_reference(Ref) -> + ?line check_process_demonitor(From, {Name, node()}, Ref); +check_process_demonitor(From, To, Ref) when is_pid(From), + is_pid(To), + is_reference(Ref) -> + ?line [] = find_erl_monitor(From, Ref), + ?line [] = find_erl_monitor(To, Ref), + ?line case node(From) == node(To) of + false -> + ?line [] = find_erl_monitor({node(From), node(To)}, Ref), + ?line [] = find_erl_monitor({node(To), node(From)}, Ref); + true -> + ?line [] = find_erl_monitor({node(From), node(From)}, Ref) + end, + ?line ok. + +no_of_monitor_node(From, Node) when is_pid(From), is_atom(Node) -> + ?line length(find_erl_link(From, ?LINK_NODE, Node)). + +check_monitor_node(From, Node, No) when is_pid(From), + is_atom(Node), + is_integer(No), + No >= 0 -> + ?line LL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = Node}), + ?line DLL = lists:duplicate(No, #erl_link{type = ?LINK_NODE, pid = From}), + ?line LL = find_erl_link(From, ?LINK_NODE, Node), + ?line DLL = find_erl_link({node(From), Node}, ?LINK_NODE, From), + ?line ok. + + + +hostname() -> + ?line from($@, atom_to_list(node())). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_H, []) -> []. + +get_names(N, T) when is_atom(T) -> + get_names(N, T, []). +get_names(0, _, Acc) -> + Acc; +get_names(N, T, Acc) -> + {A, B, C} = now(), + get_names(N-1, T, [list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(T) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)) | Acc]). + +start_node(Name) -> + ?line start_node(Name, ""). + +start_node(Name, Args) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line Res = ?t:start_node(Name, slave, [{args, Args ++ " -pa " ++ Pa}]), + ?line {ok, Node} = Res, + ?line rpc:call(Node, erts_debug, set_internal_state, + [available_internal_state, true]), + ?line Res. + + +stop_node(Node) -> + ?line ?t:stop_node(Node). + +-define(COOKIE, ''). +-define(DOP_LINK, 1). +-define(DOP_SEND, 2). +-define(DOP_EXIT, 3). +-define(DOP_UNLINK, 4). +-define(DOP_NODE_LINK, 5). +-define(DOP_REG_SEND, 6). +-define(DOP_GROUP_LEADER, 7). +-define(DOP_EXIT2, 8). + +-define(DOP_SEND_TT, 12). +-define(DOP_EXIT_TT, 13). +-define(DOP_REG_SEND_TT, 16). +-define(DOP_EXIT2_TT, 18). + +-define(DOP_MONITOR_P, 19). +-define(DOP_DEMONITOR_P, 20). +-define(DOP_MONITOR_P_EXIT, 21). + +dport_send(To, Msg) -> + Node = node(To), + DPrt = case dport(Node) of + undefined -> + pong = net_adm:ping(Node), + dport(Node); + Prt -> + Prt + end, + port_command(DPrt, [dmsg_hdr(), + dmsg_ext({?DOP_SEND, + ?COOKIE, + To}), + dmsg_ext(Msg)]). + +dport_reg_send(Node, Name, Msg) -> + DPrt = case dport(Node) of + undefined -> + pong = net_adm:ping(Node), + dport(Node); + Prt -> + Prt + end, + port_command(DPrt, [dmsg_hdr(), + dmsg_ext({?DOP_REG_SEND, + self(), + ?COOKIE, + Name}), + dmsg_ext(Msg)]). + +dport(Node) when is_atom(Node) -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + erts_debug:get_internal_state({dist_port, Node}). + +dmsg_hdr() -> + [131, % Version Magic + $D, % Dist header + 0]. % No atom cache referenses + +dmsg_ext(Term) -> + <<131, Res/binary>> = term_to_binary(Term), + Res. + +start_busy_dist_port_tracer() -> + Tracer = spawn_link(fun () -> busy_dist_port_tracer() end), + erlang:system_monitor(Tracer, [busy_dist_port]), + Tracer. + +stop_busy_dist_port_tracer(Tracer) when is_pid(Tracer) -> + unlink(Tracer), + exit(Tracer, bye); +stop_busy_dist_port_tracer(_) -> + true. + +busy_dist_port_tracer() -> + receive + {monitor, _SuspendedProcess, busy_dist_port, _Port} = M -> + erlang:display(M), + busy_dist_port_tracer() + end. + + + + diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl new file mode 100644 index 0000000000..e60a999df1 --- /dev/null +++ b/erts/emulator/test/erts_debug_SUITE.erl @@ -0,0 +1,72 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(erts_debug_SUITE). +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + flat_size/1,flat_size_big/1,df/1]). + +all(suite) -> + [flat_size,flat_size_big,df]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(2)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +flat_size(Config) when is_list(Config) -> + 0 = erts_debug:flat_size([]), + 0 = erts_debug:flat_size(42), + 2 = erts_debug:flat_size([a|b]), + 1 = erts_debug:flat_size({}), + 2 = erts_debug:flat_size({[]}), + 3 = erts_debug:flat_size({a,b}), + 7 = erts_debug:flat_size({a,[b,c]}), + ok. + +flat_size_big(Config) when is_list(Config) -> + %% Build a term whose external size only fits in a big num (on 32-bit CPU). + flat_size_big_1(16#11111111111111117777777777777777888889999, 0, 16#FFFFFFF). + +flat_size_big_1(Term, Size0, Limit) when Size0 < Limit -> + case erts_debug:flat_size(Term) of + Size when is_integer(Size), Size0 < Size -> + io:format("~p", [Size]), + flat_size_big_1([Term|Term], Size, Limit) + end; +flat_size_big_1(_, _, _) -> ok. + +df(Config) when is_list(Config) -> + ?line P0 = pps(), + ?line PrivDir = ?config(priv_dir, Config), + ?line ok = file:set_cwd(PrivDir), + ?line erts_debug:df(?MODULE), + ?line Beam = filename:join(PrivDir, ?MODULE_STRING++".dis"), + ?line {ok,Bin} = file:read_file(Beam), + ?line ok = io:put_chars(binary_to_list(Bin)), + ?line ok = file:delete(Beam), + ?line true = (P0 == pps()), + ok. + +pps() -> + {erlang:ports()}. diff --git a/erts/emulator/test/estone_SUITE.erl b/erts/emulator/test/estone_SUITE.erl new file mode 100644 index 0000000000..7fb92faf0d --- /dev/null +++ b/erts/emulator/test/estone_SUITE.erl @@ -0,0 +1,1107 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +-module(estone_SUITE). +%% Test functions +-export([all/1,estone/1]). +-export([init_per_testcase/2, fin_per_testcase/2]). + +%% Internal exports for EStone tests +-export([lists/1, + msgp/1, + msgp_medium/1, + msgp_huge/1, + pattern/1, + trav/1, + port_io/1, + large_dataset_work/1, + large_local_dataset_work/1,mk_big_procs/1,big_proc/0, + alloc/1, + bif_dispatch/1, + binary_h/1,echo/1, + ets/1, + generic/1,req/2,gserv/4,handle_call/3, + int_arith/1, + float_arith/1, + fcalls/1,remote0/1,remote1/1,app0/1,app1/1, + timer/1, + links/1,lproc/1, + run_micro/3,p1/1,ppp/3,macro/2,micros/0]). + + +-include("test_server.hrl"). + +%% Test suite defines +-define(default_timeout, ?t:minutes(10)). + +%% EStone defines +-define(TOTAL, (3000 * 1000 * 100)). %% 300 secs +-define(BIGPROCS, 2). +-define(BIGPROC_SIZE, 50). +-define(STONEFACTOR, 31000000). %% Factor to make the reference + %% implementation to make 1000 TS_ESTONES. +-record(micro, + {function, %% The name of the function implementing the micro + weight, %% How important is this in typical applications ?? + loops = 100,%% initial data + tt1, %% time to do one round + str}). %% Header string + + + + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +all(suite) -> [estone]. + +estone(suite) -> + []; +estone(doc) -> + ["EStone Test"]; +estone(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir,Config), + ?line Mhz=get_cpu_speed(os:type(),DataDir), + ?line L = ?MODULE:macro(?MODULE:micros(),DataDir), + ?line {Total, Stones} = sum_micros(L, 0, 0), + ?line pp(Mhz,Total,Stones,L), + ?line {comment,Mhz ++ " MHz, " ++ + integer_to_list(Stones) ++ " ESTONES"}. + +%% +%% Calculate CPU speed +%% +%% get_cpu_speed() now returns a string. For multiprocessor +%% machines (at least on Solaris) the format is: +[+...] +%% +get_cpu_speed({win32, _},_DataDir) -> + RegH = + case catch win32reg:open([read]) of + {ok, Handle} -> + Handle; + _ -> + io:format("Error.~nCannot determine CPU clock" + "frequency.~n" + "Please set the environment variable" + "\"CPU_SPEED\"~n"), + exit(self(), {error, no_cpu_speed}) + end, + case win32reg:change_key(RegH,"\\hkey_local_machine\\hardware\\" + "description\\system\\centralprocessor" + "\\0") of + ok -> + ok; + _ -> + io:format("Error.~nRegistry seems to be damaged or" + "unavailable.~n" + "Please set the environment variable" + "\"CPU_SPEED\",~nor correct your registry" + "if possible.~n"), + win32reg:close(RegH), + exit(self(), {error, no_cpu_speed}) + end, + case win32reg:value(RegH, "~MHZ") of + {ok, Speed} -> + win32reg:close(RegH), + integer_to_list(Speed); + _ -> + io:format("Error.~nRegistry seems to be damaged or " + "unavailable.~n"), + io:format("Please set the environment variable" + "\"CPU_SPEED\"~n"), + win32reg:close(RegH), + exit(self(), {error, no_cpu_speed}) + end; +get_cpu_speed({unix, sunos},DataDir) -> + os:cmd(filename:join(DataDir,"sunspeed.sh")) -- "\n"; +get_cpu_speed(_Other,_DataDir) -> + %% Cannot determine CPU speed + "UNKNOWN". + + +%% +%% Pretty Print EStone Result +%% +pp(Mhz,Total,Stones,Ms) -> + io:format("EStone test completed~n",[]), + io:format("**** CPU speed ~s MHz ****~n",[Mhz]), + io:format("**** Total time ~w seconds ****~n", [Total / 1000000]), + io:format("**** ESTONES = ~w ****~n~n", [Stones]), + io:format("~-31s ~-12s ~-10s % ~-10s ~n~n", + [" Title", "Millis", "Estone", "Loops"]), + erlang:display({'ESTONES', Stones}), + pp2(Ms). + +sum_micros([], Tot, Stones) -> {Tot, Stones}; +sum_micros([H|T], Tot, Sto) -> + sum_micros(T, ks(microsecs, H) + Tot, ks(estones, H) + Sto). + +pp2([]) -> ok; +pp2([R|Tail]) -> + io:format("~-35s ~-12w ~-10w ~-2w ~-10w ~n", + [ks(title,R), + round(ks(microsecs, R) / 1000), + ks(estones, R), + ks(weight_percentage, R), + ks(loops, R)]), + pp2(Tail). + +ks(K, L) -> + {value, {_, V}} = lists:keysearch(K, 1, L), + V. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% EStone test +micro(lists) -> + #micro{function = lists, + weight = 7, + loops = 6400, + str = "list manipulation"}; +micro(msgp) -> + #micro{function = msgp, + weight = 10, + loops = 1515, + str = "small messages"}; +micro(msgp_medium) -> + #micro{function = msgp_medium, + weight = 14, + loops = 1527, + str = "medium messages"}; +micro(msgp_huge) -> + #micro{function = msgp_huge, + weight = 4, + loops = 52, + str = "huge messages"}; + +micro(pattern) -> + #micro{function = pattern, + weight = 5, + loops = 1046, + str = "pattern matching"}; + +micro(trav) -> + #micro{function = trav, + weight = 4, + loops = 2834, + str = "traverse"}; + +micro(port_io) -> + #micro{function = port_io, + weight = 12, + loops = 4800, + str = "Port i/o"}; + +micro(large_dataset_work) -> + #micro{function = large_dataset_work, + weight = 3, + loops = 1193, + str = "Work with large dataset"}; + +micro(large_local_dataset_work) -> + #micro{function = large_local_dataset_work, + weight = 3, + loops = 1174, + str = "Work with large local dataset"}; + +micro(alloc) -> + #micro{function = alloc, + weight = 2, + loops = 3710, + str = "Alloc and dealloc"}; + +micro(bif_dispatch) -> + #micro{function = bif_dispatch, + weight = 5, + loops = 1623, + str = "Bif dispatch"}; + +micro(binary_h) -> + #micro{function = binary_h, + weight = 4, + loops = 581, + str = "Binary handling"}; +micro(ets) -> + #micro{function = ets, + weight = 6, + loops = 342, + str = "ets datadictionary"}; +micro(generic) -> + #micro{function = generic, + weight = 9, + loops = 7977, + str = "Generic server (with timeout)"}; +micro(int_arith) -> + #micro{function = int_arith, + weight = 3, + loops = 4157, + str = "Small Integer arithmetics"}; +micro(float_arith) -> + #micro{function = float_arith, + weight = 1, + loops = 5526, + str = "Float arithmetics"}; +micro(fcalls) -> + #micro{function = fcalls, + weight = 5, + loops = 882, + str = "Function calls"}; + +micro(timer) -> + #micro{function = timer, + weight = 2, + loops = 2312, + str = "Timers"}; + +micro(links) -> + #micro{function = links, + weight = 1, + loops = 30, + str = "Links"}. + + + +%% Return a list of micro's +micros() -> + [ + micro(lists), + micro(msgp), + micro(msgp_medium), + micro(msgp_huge), + micro(pattern), + micro(trav), + micro(port_io), + micro(large_dataset_work), + micro(large_local_dataset_work), + micro(alloc), + micro(bif_dispatch), + micro(binary_h), + micro(ets), + micro(generic), + micro(int_arith), + micro(float_arith), + micro(fcalls), + micro(timer), + micro(links) + ]. + +macro(Ms,DataDir) -> + erlang:now(), %% compensate for old 4.3 firsttime clock bug :-( + statistics(reductions), + statistics(runtime), + lists(500), %% fixup cache on first round + run_micros(Ms,DataDir). + +run_micros([],_) -> + io:nl(), + []; +run_micros([H|T],DataDir) -> + R = run_micro(H,DataDir), + [R| run_micros(T,DataDir)]. + +run_micro(M,DataDir) -> + Pid = spawn(?MODULE, run_micro, [self(),M,DataDir]), + Res = receive {Pid, Reply} -> Reply end, + {value,{title,Title}} = lists:keysearch(title,1,Reply), + {value,{estones,Estones}} = lists:keysearch(estones,1,Reply), + erlang:display({Title,Estones}), + Res. + + +run_micro(Top, M, DataDir) -> + EstoneCat = filename:join(DataDir,"estone_cat"), + put(estone_cat,EstoneCat), + Top ! {self(), apply_micro(M)}. + +apply_micro(M) -> + {GC0, Words0, _} = statistics(garbage_collection), + statistics(reductions), + Before = erlang:now(), + + Compensate = apply_micro(M#micro.function, M#micro.loops), + After = erlang:now(), + {GC1, Words1, _} = statistics(garbage_collection), + {_, Reds} = statistics(reductions), + Elapsed = subtr(Before, After), + MicroSecs = Elapsed - Compensate, + [{title, M#micro.str}, + {tt1, M#micro.tt1}, + {function, M#micro.function}, + {weight_percentage, M#micro.weight}, + {loops, M#micro.loops}, + {microsecs,MicroSecs}, + {estones, (M#micro.weight * M#micro.weight * ?STONEFACTOR) div MicroSecs}, + {gcs, GC1 - GC0}, + {kilo_word_reclaimed, (Words1 - Words0) div 1000}, + {kilo_reductions, Reds div 1000}, + {gc_intensity, gci(Elapsed, GC1 - GC0, Words1 - Words0)}]. + + +subtr(Before, After) -> + (element(1,After)*1000000000000 + +element(2,After)*1000000+element(3,After)) - + (element(1,Before)*1000000000000 + +element(2,Before)*1000000+element(3,Before)). + +gci(Micros, Words, Gcs) -> + ((256 * Gcs) / Micros) + (Words / Micros). + +apply_micro(Name, Loops) -> + io:format("~w(~w)~n", [Name, Loops]), + apply(?MODULE, Name, [Loops]). + +%%%%%%%%%%%% micro bench manipulating lists. %%%%%%%%%%%%%%%%%%%%%%%%% +lists(I) -> + L1 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx", + L2 = "aaaaaaaaaa", + lists(I, L1, L2). + +lists(0, _,_) -> + 0; +lists(I, L1, L2) -> + revt(10, L1), + appt(10, L1, L2), + lists(I-1, L1, L2). + +revt(0, _) -> + done; +revt(I, L) -> + reverse(L), + revt(I-1, L). + +reverse(L) -> + reverse(L, []). +reverse([H|T], Ack) -> reverse(T, [H|Ack]); +reverse([], Ack) -> Ack. + +append([H|T], L) -> + [H | append(T, L)]; +append([], L) -> + L. + +appt(0, _L1, _L2) -> ok; +appt(I, L1, L2) -> + append(L1, L2), + appt(I-1, L1, L2). + + +%%%%%%%%%%%%%%% small message passing and ctxt switching %%%%%%% +msgp(I) -> + msgp(I, small()). + +msgp(0, _) -> + 0; +msgp(I, Msg) -> + P1 = spawn(?MODULE, p1, [self()]), + P2 = spawn(?MODULE, p1, [P1]), + P3 = spawn(?MODULE, p1, [P2]), + P4 = spawn(?MODULE, p1, [P3]), + msgp_loop(100, P4, Msg), + msgp(I-1, Msg). + +p1(To) -> + receive + {_From, {message, X}} -> + To ! {self(), {message, X}}, + p1(To); + stop -> + To ! stop, + exit(normal) + end. + +msgp_loop(0, P, _) -> + P ! stop, + receive + stop -> ok + end; +msgp_loop(I, P, Msg) -> + P ! {self(), {message, Msg}}, + receive + {_From, {message, _}} -> + msgp_loop(I-1, P, Msg) + end. + +%%%%%%%%%%%% large massage passing and ctxt switching %%%%%%% +msgp_medium(I) -> + msgp_medium(I, big()). + +msgp_medium(0, _) -> + 0; +msgp_medium(I, Msg) -> + P1 = spawn(?MODULE , p1, [self()]), + P2 = spawn(?MODULE, p1, [P1]), + P3 = spawn(?MODULE, p1, [P2]), + P4 = spawn(?MODULE, p1, [P3]), + msgp_loop(100, P4, Msg), + msgp_medium(I-1, Msg). + + + +%%%%%%%%%%%% huge massage passing and ctxt switching %%%%%%% +msgp_huge(I) -> + msgp_huge(I, very_big(15)). + +msgp_huge(0, _) -> + 0; +msgp_huge(I, Msg) -> + P1 = spawn(?MODULE , p1, [self()]), + P4 = spawn(?MODULE, p1, [P1]), + msgp_loop(100, P4, Msg), + msgp_huge(I-1, Msg). + + +%%%%%% typical protocol pattern matching %%%%%%% +pattern(0) -> + 0; +pattern(I) -> + Tail = "aaabbaaababba", + P1 = [0, 1,2,3,4,5|Tail], + pat_loop1(100, P1), + pat_loop2(100, P1), + pat_loop3(100, P1), + pat_loop4(100, P1), + pat_loop5(100, P1), + pattern(I-1). + +pat_loop1(0, _) -> + ok; +pat_loop1(_I, [_, _X, _Y, 0 |_T]) -> + ok; +pat_loop1(_I, [_, _X, _Y, 1| _T]) -> + ok; +pat_loop1(_I, [_, _X, _Y, 2 | _T]) -> + ok; +pat_loop1(I, [_, X, Y, 3 | T]) -> + pat_loop1(I-1, [0, X,Y,3|T]). + +pat_loop2(0, _) -> + ok; +pat_loop2(_I, [_X, Y | _Tail]) when Y bsl 1 == 0 -> + ok; +pat_loop2(_I, [_X, Y | _Tail]) when Y bsl 2 == 0 -> + ok; +pat_loop2(I, [X, Y | Tail]) when Y bsl 2 == 4 -> + pat_loop2(I-1, [X, Y |Tail]). + + +pat_loop3(0, _) -> + ok; +pat_loop3(_I, [{c, h} | _Tail]) -> + ok; +pat_loop3(_I, [1, 0 |_T]) -> + ok; +pat_loop3(_I, [X, _Y |_Tail]) when is_binary(X), size(X) == 1 -> + ok; +pat_loop3(_I, [no, _Y|_Tail]) -> + ok; +pat_loop3(_I, []) -> + ok; +pat_loop3(_I, [X,_Y|_T]) when X /= 0 -> + ok; +pat_loop3(_I, [2,3|_T]) -> + ok; +pat_loop3(_I, [1, 2]) -> + ok; +pat_loop3(I, [0, 1 |T]) -> + pat_loop3(I-1, [0,1|T]). + + +pat_loop4(0, _) -> ok; +pat_loop4(_I, [20|_T]) -> ok; +pat_loop4(_I, [219|_T]) -> ok; +pat_loop4(_I, [18|_T]) -> ok; +pat_loop4(_I, [17|_T]) -> ok; +pat_loop4(_I, [16|_T]) -> ok; +pat_loop4(_I, [15|_T]) -> ok; +pat_loop4(_I, [14|_T]) -> ok; +pat_loop4(_I, [13|_T]) -> ok; +pat_loop4(_I, [12|_T]) -> ok; +pat_loop4(_I, [11|_T]) -> ok; +pat_loop4(_I, [10|_T]) -> ok; +pat_loop4(_I, [9|_T]) -> ok; +pat_loop4(_I, [8|_T]) -> ok; +pat_loop4(_I, [7|_T]) -> ok; +pat_loop4(_I, [6|_T]) -> ok; +pat_loop4(_I, [5|_T]) -> ok; +pat_loop4(_I, [4|_T]) -> ok; +pat_loop4(_I, [3|_T]) -> ok; +pat_loop4(_I, [1|_T]) -> ok; +pat_loop4(_I, [21|_T]) -> ok; +pat_loop4(_I, [22|_T]) -> ok; +pat_loop4(_I, [23|_T]) -> ok; +pat_loop4(_I, [24|_T]) -> ok; +pat_loop4(_I, [25|_T]) -> ok; +pat_loop4(_I, [26|_T]) -> ok; +pat_loop4(_I, [27|_T]) -> ok; +pat_loop4(I, [0|T]) -> + pat_loop4(I-1, [0|T]). + +pat_loop5(0, _) -> ok; +pat_loop5(_I, [0, 20|_T]) -> ok; +pat_loop5(_I, [0, 19|_T]) -> ok; +pat_loop5(_I, [0, 18|_T]) -> ok; +pat_loop5(_I, [0, 17|_T]) -> ok; +pat_loop5(_I, [0, 16|_T]) -> ok; +pat_loop5(_I, [0, 15|_T]) -> ok; +pat_loop5(_I, [0, 14|_T]) -> ok; +pat_loop5(_I, [0, 13|_T]) -> ok; +pat_loop5(_I, [0, 12|_T]) -> ok; +pat_loop5(_I, [0, 11|_T]) -> ok; +pat_loop5(_I, [0, 10|_T]) -> ok; +pat_loop5(_I, [0, 9|_T]) -> ok; +pat_loop5(_I, [0, 8|_T]) -> ok; +pat_loop5(_I, [0, 7|_T]) -> ok; +pat_loop5(_I, [0, 6|_T]) -> ok; +pat_loop5(I, [0, 1|T]) -> + pat_loop5(I-1, [0,1|T]). + +%%%%%%%%%% term traversal representing simple pattern matchhing %%% +%%%%%%%%% + some arith +trav(I) -> + X = very_big(10), + trav(I, X). + +trav(0, _) -> 0; +trav(I, T) -> + do_trav(T), + trav(I-1, T). + +do_trav(T) when is_tuple(T) -> + tup_trav(T, 1, 1 + size(T)); +do_trav([H|T]) -> + do_trav(H) + do_trav(T); +do_trav(X) when is_integer(X) -> 1; +do_trav(_X) -> 0. +tup_trav(_T, P, P) -> 0; +tup_trav(T, P, End) -> + do_trav(element(P, T)) + tup_trav(T, P+1, End). + + +%% Port I/O +port_io(I) -> + EstoneCat = get(estone_cat), + Before = erlang:now(), + Pps = make_port_pids(5, I, EstoneCat), %% 5 ports + send_procs(Pps, go), + After = erlang:now(), + wait_for_pids(Pps), + subtr(Before, After). + +make_port_pids(0, _, _) -> + []; +make_port_pids(NoPorts, J, EstoneCat) -> + [spawn(?MODULE, ppp, [self(),J,EstoneCat]) | make_port_pids(NoPorts-1, J, EstoneCat)]. +ppp(Top, I, EstoneCat) -> + P = open_port({spawn, EstoneCat}, []),%% cat sits at the other end + Str = lists:duplicate(200, 88), %% 200 X'es + Cmd = {self(), {command, Str}}, + receive + go -> ok + end, + ppp_loop(P, I, Cmd), + Cmd2 = {self(), {command, "abcde"}}, + Res = ppp_loop(P, I, Cmd2), + P ! {self(), close}, + receive + {P, closed} -> + closed + end, + Top ! {self(), Res}. + +ppp_loop(_P, 0, _) -> + ok; +ppp_loop(P, I, Cmd) -> + P ! Cmd, + receive + {P, _} -> %% no match + ppp_loop(P, I-1, Cmd) + end. + +%% Working with a very large non-working data set +%% where the passive data resides in remote processes +large_dataset_work(I) -> + {Minus, Ps} = timer:tc(?MODULE, mk_big_procs, [?BIGPROCS]), + trav(I), + lists(I), + send_procs(Ps, stop), + Minus. %% Don't count time to create the big procs. + +mk_big_procs(0) -> []; +mk_big_procs(I) -> + [ mk_big_proc()| mk_big_procs(I-1)]. + +mk_big_proc() -> + P = spawn(?MODULE, big_proc, []), + P ! {self(), running}, + receive + {P, yes} -> P + end. + +big_proc() -> + X = very_big(?BIGPROC_SIZE), %% creates a big heap + Y = very_big(?BIGPROC_SIZE), + Z = very_big(?BIGPROC_SIZE), + + receive + {From, running} -> + From ! {self(), yes} + end, + receive + stop -> + {X, Y, Z} %% Can't be garbed away now by very (not super) + %% smart compiler + end. + +%% Working with a large non-working data set +%% where the data resides in the local process. +large_local_dataset_work(I) -> + {Minus, _Data} = timer:tc(?MODULE, very_big, [?BIGPROC_SIZE]), + trav(I), + lists(I), + Minus. + + +%% Fast allocation and also deallocation that is gc test +%% Important to not let variable linger on the stack un-necessarily +alloc(0) -> 0; +alloc(I) -> + _X11 = very_big(), + _X12 = very_big(), + _X13 = very_big(), + _Z = [_X14 = very_big(), + _X15 = very_big(), + _X16 = very_big()], + _X17 = very_big(), + _X18 = very_big(), + _X19 = very_big(), + _X20 = very_big(), + _X21 = very_big(), + _X22 = very_big(), + _X23 = very_big(), + _X24 = very_big(), + alloc(I-1). + +%% Time to call bif's +%% Lot's of element stuff which reflects the record code which +%% is becomming more and more common +bif_dispatch(0) -> + 0; +bif_dispatch(I) -> + disp(), disp(), disp(), disp(), disp(), disp(), + disp(), disp(), disp(), disp(), disp(), disp(), + bif_dispatch(I-1). + +disp() -> + Tup = {a}, + L = [x], + self(),self(),self(),self(),self(),self(),self(),self(),self(), + make_ref(), + atom_to_list(''), + _X = list_to_atom([]), + tuple_to_list({}), + _X2 = list_to_tuple([]), + element(1, Tup), + element(1, Tup), + _Elem = element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup), + element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup), + element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup), + element(1, Tup),element(1, Tup),element(1, Tup),element(1, Tup), + setelement(1, Tup,k), + setelement(1, Tup,k), + setelement(1, Tup,k),setelement(1, Tup,k),setelement(1, Tup,k), + setelement(1, Tup,k),setelement(1, Tup,k),setelement(1, Tup,k), + setelement(1, Tup,k), + setelement(1, Tup,k), + setelement(1, Tup,k), + setelement(1, Tup,k), + _Y = setelement(1, Tup,k), + _Date = date(), time(), + put(a, 1), + get(a), + erase(a), + hd(L), + tl(L), + _Len = length(L),length(L),length(L),length(L), + node(),node(),node(),node(),node(),node(),node(),node(), + S=self(), + node(S),node(S),node(S), + size(Tup), + _W = whereis(code_server),whereis(code_server), + whereis(code_server),whereis(code_server), + whereis(code_server),whereis(code_server), + _W2 = whereis(code_server). + + +%% Generic server like behaviour +generic(I) -> + register(funky, spawn(?MODULE, gserv, [funky, ?MODULE, [], []])), + g_loop(I). + +g_loop(0) -> + exit(whereis(funky), kill), + 0; +g_loop(I) -> + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [xyz]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [xyz]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + ?MODULE:req(funky, {call, [abc]}), + g_loop(I-1). + +req(Name, Req) -> + R = make_ref(), + Name ! {self(), R, Req}, + receive + {Name, R, Reply} -> Reply + after 2000 -> + exit(timeout) + end. + +gserv(Name, Mod, State, Debug) -> + receive + {From, Ref, {call, Req}} when Debug == [] -> + case catch apply(Mod, handle_call, [From, State, Req]) of + {reply, Reply, State2} -> + From ! {Name, Ref, Reply}, + gserv(Name, Mod, State2, Debug); + {noreply, State2} -> + gserv(Name, Mod, State2, Debug); + {'EXIT', Reason} -> + exit(Reason) + end; + {_From, _Ref, _Req} when Debug /= [] -> + exit(nodebug) + end. + +handle_call(_From, _State, [xyz]) -> + R = atom_to_list(xyz), + {reply, R, []}; +handle_call(_From, State, [abc]) -> + R = 1 + 3, + {reply, R, [R | State]}. + + + +%% Binary handling, creating, manipulating and sending binaries +binary_h(I) -> + Before = erlang:now(), + P = spawn(?MODULE, echo, [self()]), + B = list_to_binary(lists:duplicate(2000, 5)), + After = erlang:now(), + Compensate = subtr(Before, After), + binary_h_2(I, P, B), + Compensate. + +binary_h_2(0, P, _B) -> + exit(P, kill); +binary_h_2(I, P, B) -> + echo_loop(P, 20, B), + split_loop(B, {abc,1,2222,self(),"ancnd"}, 100), + binary_h_2(I-1, P, B). + +split_loop(_B, _, 0) -> + ok; +split_loop(B, Term, I) -> + {X, Y} = split_binary(B, I), + size(X), + binary_to_list(Y, 1, 2), + binary_to_term(term_to_binary(Term)), + split_loop(B, Term, I-1). + + +echo_loop(_P, 0, _B) -> + k; +echo_loop(P, I, B) -> + P ! B, + P ! B, + P ! B, + P ! B, + P ! B, + P ! B, + P ! B, + P ! B, + P ! B, + P ! B, + receive _ -> ok end, + receive _ -> ok end, + receive _ -> ok end, + receive _ -> ok end, + receive _ -> ok end, + receive _ -> ok end, + receive _ -> ok end, + receive _ -> ok end, + receive _ -> ok end, + receive _ -> ok end, + echo_loop(P, I-1, B). + + +ets(0) -> + 0; +ets(I) -> + T1 = ets:new(a, [set]), + T2 = ets:new(c, [bag, private]), + L = [T1, T2], + run_tabs(L, L, 1), + ets:delete(T1), + ets:delete(T2), + ets(I-1). + +run_tabs(_, _, 0) -> + ok; +run_tabs([], L, I) -> + run_tabs(L, L, I-1); +run_tabs([Tab|Tail], L, I) -> + Begin = I * 20, + End = (I+1) * 20, + run_tab(Tab, Begin, End, I), + run_tabs(Tail, L, I). + +run_tab(_Tab, X, X, _) -> + ok; +run_tab(Tab, Beg, End, J) -> + ets:insert(Tab, {Beg, J}), + ets:insert(Tab, {J, Beg}), + ets:insert(Tab, {{foo,Beg}, J}), + ets:insert(Tab, {{foo, J}, Beg}), + ets:delete(Tab, haha), + ets:match_delete(Tab, {k, j}), + ets:match(Tab, {Beg, '$1'}), + ets:match(Tab, {'$1', J}), + ets:delete(Tab, Beg), + K = ets:first(Tab), + _K2 = ets:next(Tab, K), + run_tab(Tab, Beg+1, End, J). + + +%%%% Integer arith %%%%% +int_arith(0) -> + 0; +int_arith(I) -> + do_arith(I) + + do_arith(I) + + do_arith(I) + + do_arith(I) + + do_arith(I) + + do_arith(I) + + do_arith(I) + + do_arith(I) + + do_arith(I) + + 66, + int_arith(I-1). + +do_arith(I) -> + do_arith2(I) - + do_arith2(I) - + do_arith2(I) - + do_arith2(I) - + do_arith2(I) - + do_arith2(I) - + do_arith2(I) - + 99. + +do_arith2(I) -> + X = 23, + _Y = 789 + I, + Z = I + 1, + U = (X bsl 1 bsr I) * X div 2 bsr 4, + U1 = Z + Z + Z + Z + X bsl 4 * 2 bsl 2, + Z - U + U1 div 2. + + +%%%% Float arith %%%%% +float_arith(0) -> + 0; +float_arith(I) -> + f_do_arith(I) + + f_do_arith(I) + + f_do_arith(I) + + f_do_arith(I) + + f_do_arith(I) + + f_do_arith(I) + + f_do_arith(I) + + f_do_arith(I) + + f_do_arith(I) + + 66, + float_arith(I-1). + +f_do_arith(I) -> + X = 23.4, + _Y = 789.99 + I, + Z = I + 1.88, + U = (X * 1 / I) * X / 2 * 4, + U1 = Z + Z + Z + Z + X * 4 * 2 / 2, + Z - U + U1 / 2. + +%%%% time to do various function calls +fcalls(0) -> + 0; +fcalls(I) -> + local0(400), + remote0(400), + app0(400), + local1(400), + remote1(400), + app1(400), + fcalls(I-1). + + +local0(0) -> 0; +local0(N) -> + local0(N-1). + +local1(0) -> 0; +local1(N) -> + 1+local1(N-1). + +remote0(0) -> 0; +remote0(N) -> + ?MODULE:remote0(N-1). + +remote1(0) -> 0; +remote1(N) -> + 1+?MODULE:remote1(N-1). + +app0(0) -> 0; +app0(N) -> + apply(?MODULE, app0, [N-1]). + +app1(0) -> 0; +app1(N) -> + 1 + apply(?MODULE, app1, [N-1]). + +%%%%%% jog the time queue implementation +timer(I) -> + L = [50, 50, 50, 100, 1000, 3000, 8000, 50000, 100000], + timer(I, L). + +timer(0, _) -> 0; +timer(N, L) -> + send_self(100), + recv(100,L, L), + timer(N-1). + +recv(0, _, _) -> + ok; +recv(N, [], L) -> + recv(N, L, L); +recv(N, [Timeout|Tail], L) -> + receive + hi_dude -> + recv(N-1, Tail, L) + after Timeout -> + io:format("XXXXX this wasn't supposed to happen???~n", []), + ok + end. + +send_self(0) -> + ok; +send_self(N) -> + self() ! hi_dude, + send_self(N-1). + + +%%%%%%%%%%%% managing many links %%%%% +links(I) -> + L = mk_link_procs(100), + send_procs(L, {procs, L, I}), + wait_for_pids(L), + 0. + +mk_link_procs(0) -> + []; +mk_link_procs(I) -> + [spawn_link(?MODULE, lproc, [self()]) | mk_link_procs(I-1)]. + + +lproc(Top) -> + process_flag(trap_exit,true), + receive + {procs, Procs, I} -> + Top ! {self(), lproc(Procs, Procs, link, I)} + end. + +lproc(_, _, _, 0) -> + done; +lproc([], Procs, link, I) -> + lproc(Procs, Procs, unlink, I-1); +lproc([], Procs, unlink, I) -> + lproc(Procs, Procs, link, I-1); +lproc([Pid|Tail], Procs, unlink, I) -> + unlink(Pid), + lproc(Tail, Procs, unlink, I); +lproc([Pid|Tail], Procs, link, I) -> + link(Pid), + lproc(Tail, Procs, unlink, I). + + + +%%%%%%%%%%% various utility functions %%%%%%% + +echo(Pid) -> + receive + X -> Pid ! X, + echo(Pid) + end. + +very_big() -> + very_big(2). +very_big(0) -> []; +very_big(I) -> + {1,2,3,a,v,f,r,t,y,u,self(), self(), self(), + "22222222222222222", {{"234", self()}}, + [[very_big(I-1)]]}. + +big() -> + {self(), funky_stuff, baby, {1, [123, true,[]], "abcdef"}}. + +small() -> {self(), true}. + +%% Wait for a list of children to respond +wait_for_pids([]) -> + ok; +wait_for_pids([P|Tail]) -> + receive + {P, _Res} -> wait_for_pids(Tail) + end. + +send_procs([P|Tail], Msg) -> P ! Msg, send_procs(Tail, Msg); +send_procs([], _) -> ok. + diff --git a/erts/emulator/test/estone_SUITE_data/Makefile.src b/erts/emulator/test/estone_SUITE_data/Makefile.src new file mode 100644 index 0000000000..bd5f155fdf --- /dev/null +++ b/erts/emulator/test/estone_SUITE_data/Makefile.src @@ -0,0 +1,15 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROG = estone_cat +PROGS = $(PROG)@exe@ + +all: $(PROGS) + +$(PROG)@exe@: $(PROG)@obj@ + $(LD) $(CROSSLDFLAGS) -o $(PROG) $(PROG)@obj@ @LIBS@ + +$(PROG)@obj@: $(PROG).c + $(CC) -c -o $(PROG)@obj@ $(CFLAGS) $(PROG).c diff --git a/erts/emulator/test/estone_SUITE_data/estone_cat.c b/erts/emulator/test/estone_SUITE_data/estone_cat.c new file mode 100644 index 0000000000..8ed9f8375b --- /dev/null +++ b/erts/emulator/test/estone_SUITE_data/estone_cat.c @@ -0,0 +1,40 @@ +/* + * Author: Bjorn Gustavsson + * Purpose: Simple portable cat utility for the estone benchmark. + * + * Compiling instructions: + * + * Unix: gcc -O2 -o estone_cat estone_cat.c + * Windows: cl -Ox estone_cat.c + */ + +#include +#include +#include + +#ifdef VXWORKS +estone_cat(argc, argv) +#else +main(argc, argv) +#endif +int argc; +char *argv[]; +{ + char buf[16384]; + int n; + +#ifdef _O_BINARY + _setmode(0, _O_BINARY); + _setmode(1, _O_BINARY); +#endif + + for (;;) { + n = read(0, buf, sizeof(buf)); + if (n <= 0 && errno == EINTR) + continue; + if (n <= 0) + break; + write(1, buf, n); + } + return 0; +} diff --git a/erts/emulator/test/estone_SUITE_data/sunspeed.sh b/erts/emulator/test/estone_SUITE_data/sunspeed.sh new file mode 100755 index 0000000000..d1bd5c4531 --- /dev/null +++ b/erts/emulator/test/estone_SUITE_data/sunspeed.sh @@ -0,0 +1,10 @@ +#!/bin/sh +# +# sunspeed +# +# Returns CPU speed in Mhz on sun/solaris 5.x & 6.x +# + +echo `/usr/sbin/psrinfo -v | sed 's/.* \([0-9]*\)\ MHz.*/\1/;s/.*[^0-9].*//g'` | sed 's/ /+/g' + +# \ No newline at end of file diff --git a/erts/emulator/test/evil_SUITE.erl b/erts/emulator/test/evil_SUITE.erl new file mode 100644 index 0000000000..a8288584f4 --- /dev/null +++ b/erts/emulator/test/evil_SUITE.erl @@ -0,0 +1,377 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% + +-module(evil_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + heap_frag/1, + encode_decode_ext/1, + decode_integer_ext/1, + decode_small_big_ext/1, + decode_large_big_ext/1, + decode_small_big_ext_neg/1, + decode_large_big_ext_neg/1, + decode_too_small/1, + decode_pos_neg_zero/1 + ]). + +-include("test_server.hrl"). + +all(suite) -> + [ + heap_frag, + encode_decode_ext, + decode_integer_ext, + decode_small_big_ext, + decode_large_big_ext, + decode_small_big_ext_neg, + decode_large_big_ext_neg, + decode_too_small, + decode_pos_neg_zero + ]. + +init_per_testcase(_Case, Config) -> + ?line Dog = test_server:timetrap(?t:minutes(0.5)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +heap_frag(Config) when is_list(Config) -> + N = 512, + Self = self(), + ?line Pid = spawn_link(fun() -> appender(Self, N) end), + receive + {Pid,Res} -> + ?line Res = my_appender(N); + Garbage -> + io:format("Garbage: ~p\n", [Garbage]), + ?line ?t:fail(got_garbage) + end. + + +%% ######################################################################## %% + +%% "Interesting" integers taken from erl_interface ei_decode_SUITE.erl +%% These test cases are not "evil" but the next test case is.... + +encode_decode_ext(Config) when is_list(Config) -> + ?line enc_dec( 2, 0), % SMALL_INTEGER_EXT smallest + ?line enc_dec( 2, 255), % SMALL_INTEGER_EXT largest + ?line enc_dec( 5, 256), % INTEGER_EXT smallest pos (*) + ?line enc_dec( 5, -1), % INTEGER_EXT largest neg + + ?line enc_dec( 5, 16#07ffffff), % INTEGER_EXT largest (28 bits) + ?line enc_dec( 5,-16#08000000), % INTEGER_EXT smallest + ?line enc_dec( 7, 16#08000000), % SMALL_BIG_EXT smallest pos(*) + ?line enc_dec( 7,-16#08000001), % SMALL_BIG_EXT largest neg (*) + + ?line enc_dec( 7, 16#7fffffff), % SMALL_BIG_EXT largest i32 + ?line enc_dec( 7,-16#80000000), % SMALL_BIG_EXT smallest i32 + + ?line enc_dec( 7, 16#80000000), % SMALL_BIG_EXT u32 + ?line enc_dec( 7, 16#ffffffff), % SMALL_BIG_EXT largest u32 + + ?line enc_dec( 9, 16#7fffffffffff), % largest i48 + ?line enc_dec( 9,-16#800000000000), % smallest i48 + ?line enc_dec( 9, 16#ffffffffffff), % largest u48 + ?line enc_dec(11, 16#7fffffffffffffff), % largest i64 + ?line enc_dec(11,-16#8000000000000000), % smallest i64 + ?line enc_dec(11, 16#ffffffffffffffff), % largest u64 + + ok. + + +%% ######################################################################## %% + +%% "Interesting" integers taken from erl_interface ei_decode_SUITE.erl +%% These test the decoding "unusual", i.e. integers packed according +%% to "erts/emulator/internal_doc/erl_ext_dist.txt" but not the way +%% the emulator or erl_interface encode them. +%% +%% NOTE!!!! The comments below after a decode line is how it currently +%% is encoded in the external format by the emulator and +%% erl_interface, i.e. not how it is encoded in the test case below. + +decode_integer_ext(Config) when is_list(Config) -> + ?line decode( 0, <<131,98, 0:32>>), % SMALL_INTEGER_EXT + ?line decode( 42, <<131,98, 42:32>>), % SMALL_INTEGER_EXT + ?line decode(255, <<131,98,255:32>>), % SMALL_INTEGER_EXT + ?line decode( 16#08000000, <<131,98, 16#08000000:32>>), % SMALL_BIG_EXT + ?line decode(-16#08000001, <<131,98,-16#08000001:32>>), % SMALL_BIG_EXT + ?line decode( 16#7fffffff, <<131,98, 16#7fffffff:32>>), % SMALL_BIG_EXT + ?line decode(-16#80000000, <<131,98,-16#80000000:32>>), % SMALL_BIG_EXT + ok. + +decode_small_big_ext(Config) when is_list(Config) -> + ?line decode(256,<<131,110,2,0,0,1>>), % INTEGER_EXT + ?line decode(16#07ffffff,<<131,110,4,0,255,255,255,7>>), % INTEGER_EXT + ?line decode(16#7fffffff,<<131,110,4,0,255,255,255,127>>), % SMALL_BIG_EXT + + ?line decode(42,<<131,110,1,0,42>>), % SMALL_INTEGER_EXT + ?line decode(42,<<131,110,2,0,42,0>>), % Redundant zeros from now on + ?line decode(42,<<131,110,3,0,42,0,0>>), + ?line decode(42,<<131,110,4,0,42,0,0,0>>), + ?line decode(42,<<131,110,5,0,42,0,0,0,0>>), + ?line decode(42,<<131,110,6,0,42,0,0,0,0,0>>), + ?line decode(42,<<131,110,7,0,42,0,0,0,0,0,0>>), + ?line decode(42,<<131,110,8,0,42,0,0,0,0,0,0,0>>), + ok. + +decode_large_big_ext(Config) when is_list(Config) -> + ?line decode(256,<<131,111,2:32,0,0,1>>), % INTEGER_EXT + ?line decode(16#07ffffff,<<131,111,4:32,0,255,255,255,7>>), % INTEG_EXT + ?line decode(16#7fffffff,<<131,111,4:32,0,255,255,255,127>>), % SMA_BIG + ?line decode(16#ffffffff,<<131,111,4:32,0,255,255,255,255>>), % SMA_BIG + + N = largest_small_big(), + ?line decode(N,<<131,111,255:32,0,N:2040/little>>), % SMALL_BIG_EXT + + ?line decode(42,<<131,111,1:32,0,42>>), + ?line decode(42,<<131,111,2:32,0,42,0>>), % Redundant zeros from now on + ?line decode(42,<<131,111,3:32,0,42,0,0>>), + ?line decode(42,<<131,111,4:32,0,42,0,0,0>>), + ?line decode(42,<<131,111,5:32,0,42,0,0,0,0>>), + ?line decode(42,<<131,111,6:32,0,42,0,0,0,0,0>>), + ?line decode(42,<<131,111,7:32,0,42,0,0,0,0,0,0>>), + ?line decode(42,<<131,111,8:32,0,42,0,0,0,0,0,0,0>>), + ok. + +decode_small_big_ext_neg(Config) when is_list(Config) -> + ?line decode(-1,<<131,110,1,1,1>>), % INTEGER_EXT + ?line decode(-16#08000000,<<131,110,4,1,0,0,0,8>>), % INTEGER_EXT + ?line decode(-16#80000000,<<131,110,4,1,0,0,0,128>>), % SMALL_BIG_EXT + ?line decode(-16#ffffffff,<<131,110,4,1,255,255,255,255>>), % SMALL_BIG_EXT + + N = largest_small_big(), + ?line decode(-N,<<131,111,255:32,1,N:2040/little>>), % SMALL_BIG_EXT + + ?line decode(-42,<<131,110,1,1,42>>), + ?line decode(-42,<<131,110,2,1,42,0>>), % Redundant zeros from now on + ?line decode(-42,<<131,110,3,1,42,0,0>>), + ?line decode(-42,<<131,110,4,1,42,0,0,0>>), + ?line decode(-42,<<131,110,5,1,42,0,0,0,0>>), + ?line decode(-42,<<131,110,6,1,42,0,0,0,0,0>>), + ?line decode(-42,<<131,110,7,1,42,0,0,0,0,0,0>>), + ?line decode(-42,<<131,110,8,1,42,0,0,0,0,0,0,0>>), + ok. + +decode_large_big_ext_neg(Config) when is_list(Config) -> + ?line decode(-1,<<131,111,1:32,1,1>>), % INTEGER_EXT + ?line decode(-16#08000000,<<131,111,4:32,1,0,0,0,8>>), % INTEGER_EXT + ?line decode(-16#80000000,<<131,111,4:32,1,0,0,0,128>>), % SMALL_BIG_EXT + + ?line decode(-42,<<131,111,1:32,1,42>>), + ?line decode(-42,<<131,111,2:32,1,42,0>>), % Redundant zeros from now on + ?line decode(-42,<<131,111,3:32,1,42,0,0>>), + ?line decode(-42,<<131,111,4:32,1,42,0,0,0>>), + ?line decode(-42,<<131,111,5:32,1,42,0,0,0,0>>), + ?line decode(-42,<<131,111,6:32,1,42,0,0,0,0,0>>), + ?line decode(-42,<<131,111,7:32,1,42,0,0,0,0,0,0>>), + ?line decode(-42,<<131,111,8:32,1,42,0,0,0,0,0,0,0>>), + ok. + +decode_pos_neg_zero(Config) when is_list(Config) -> + ?line decode( 0, <<131,110,0,0>>), % SMALL_BIG_EXT (positive zero) + ?line decode( 0, <<131,110,1,0,0>>), % SMALL_BIG_EXT (positive zero) + ?line decode( 0, <<131,110,0,1>>), % SMALL_BIG_EXT (negative zero) + ?line decode( 0, <<131,110,1,1,0>>), % SMALL_BIG_EXT (negative zero) + + ?line decode( 0, <<131,111,0:32,0>>), % SMALL_BIG_EXT (positive zero) + ?line decode( 0, <<131,111,1:32,0,0>>), % SMALL_BIG_EXT (positive zero) + ?line decode( 0, <<131,111,0:32,1>>), % SMALL_BIG_EXT (negative zero) + ?line decode( 0, <<131,111,1:32,1,0>>), % SMALL_BIG_EXT (negative zero) + + N = largest_small_big(), + ?line decode( N,<<131,110,255,0,N:2040/little>>), % largest SMALL_BIG_EXT + ?line decode(-N,<<131,110,255,1,N:2040/little>>), % largest SMALL_BIG_EXT + + ok. + +%% Test to decode uncompleted encodings for all in "erl_ext_dist.txt" + +decode_too_small(Config) when is_list(Config) -> + ?line decode_badarg(<<131, 97>>), + ?line decode_badarg(<<131, 98>>), + ?line decode_badarg(<<131, 98, 0>>), + ?line decode_badarg(<<131, 98, 0, 0>>), + ?line decode_badarg(<<131, 98, 0, 0, 0>>), + ?line decode_badarg(<<131, 99>>), + ?line decode_badarg(<<131, 99, 0>>), + ?line decode_badarg(<<131, 99, 0:240>>), + + ?line decode_badarg(<<131,100>>), + ?line decode_badarg(<<131,100, 1:16/big>>), + ?line decode_badarg(<<131,100, 2:16/big>>), + ?line decode_badarg(<<131,100, 2:16/big, "A">>), + + % FIXME node name "A" seem ok, should it be? +% ?line decode_badarg(<<131,101,100,1:16/big,"A",42:32/big,0>>), + + ?line decode_badarg(<<131,101>>), + ?line decode_badarg(<<131,101,106>>), + ?line decode_badarg(<<131,101,255>>), + ?line decode_badarg(<<131,101,106,42:8/big>>), + ?line decode_badarg(<<131,101,106,42:16/big>>), + ?line decode_badarg(<<131,101,255,42:24/big>>), + ?line decode_badarg(<<131,101,255,42:32/big,0>>), + ?line decode_badarg(<<131,101,100,1:16/big,"A">>), + ?line decode_badarg(<<131,101,100,1:16/big,"A",42:32/big>>), + + ?line decode_badarg(<<131,102>>), + ?line decode_badarg(<<131,102,106,42:32/big,0>>), + ?line decode_badarg(<<131,102,255,42:32/big,0>>), + ?line decode_badarg(<<131,102,100,1:16/big,"A">>), + ?line decode_badarg(<<131,102,100,1:16/big,"A",42:32/big>>), + + ?line decode_badarg(<<131,103>>), + ?line decode_badarg(<<131,103,106,42:32/big,0>>), + ?line decode_badarg(<<131,103,255,42:32/big,0>>), + ?line decode_badarg(<<131,103,100,1:16/big,"A">>), + ?line decode_badarg(<<131,103,100,1:16/big,"A",42:32/big>>), + ?line decode_badarg(<<131,103,100,1:16/big,"A",4:32/big,2:32/big>>), + + ?line decode_badarg(<<131,104>>), + ?line decode_badarg(<<131,104, 1>>), + ?line decode_badarg(<<131,104, 2, 106>>), + ?line decode_badarg(<<131,105, 1:32/big>>), + ?line decode_badarg(<<131,105, 2:32/big, 106>>), + + ?line decode_badarg(<<131,107>>), + ?line decode_badarg(<<131,107, 1:16/big>>), + ?line decode_badarg(<<131,107, 2:16/big>>), + ?line decode_badarg(<<131,107, 2:16/big, "A">>), + + ?line decode_badarg(<<131,108>>), + ?line decode_badarg(<<131,108, 1:32/big>>), + ?line decode_badarg(<<131,108, 2:32/big>>), + ?line decode_badarg(<<131,108, 2:32/big, 106>>), % FIXME don't use NIL + + ?line decode_badarg(<<131,109>>), + ?line decode_badarg(<<131,109, 1:32/big>>), + ?line decode_badarg(<<131,109, 2:32/big>>), + ?line decode_badarg(<<131,109, 2:32/big, 42>>), + + N = largest_small_big(), + + ?line decode_badarg(<<131,110>>), + ?line decode_badarg(<<131,110,1>>), + ?line decode_badarg(<<131,110,1,0>>), + ?line decode_badarg(<<131,110,1,1>>), + ?line decode_badarg(<<131,110,2,0,42>>), + ?line decode_badarg(<<131,110,2,1,42>>), + ?line decode_badarg(<<131,110,255,0,N:2032/little>>), + ?line decode_badarg(<<131,110,255,1,N:2032/little>>), + + ?line decode_badarg(<<131,111>>), + ?line decode_badarg(<<131,111, 1:32/big>>), + ?line decode_badarg(<<131,111, 1:32/big,0>>), + ?line decode_badarg(<<131,111, 1:32/big,1>>), + ?line decode_badarg(<<131,111, 2:32/big,0,42>>), + ?line decode_badarg(<<131,111, 2:32/big,1,42>>), + ?line decode_badarg(<<131,111,256:32/big,0,N:2032/little>>), + ?line decode_badarg(<<131,111,256:32/big,1,N:2032/little>>), + ?line decode_badarg(<<131,111,256:32/big,0,N:2040/little>>), + ?line decode_badarg(<<131,111,256:32/big,1,N:2040/little>>), + ?line decode_badarg(<<131,111,257:32/big,0,N:2048/little>>), + ?line decode_badarg(<<131,111,257:32/big,1,N:2048/little>>), + + % Emulator dies if trying to create large bignum.... +% ?line decode_badarg(<<131,111,16#ffffffff:32/big,0>>), +% ?line decode_badarg(<<131,111,16#ffffffff:32/big,1>>), + + ?line decode_badarg(<<131, 78>>), + ?line decode_badarg(<<131, 78, 42>>), + ?line decode_badarg(<<131, 78, 42, 1>>), + ?line decode_badarg(<<131, 78, 42, 1:16/big>>), + ?line decode_badarg(<<131, 78, 42, 2:16/big>>), + ?line decode_badarg(<<131, 78, 42, 2:16/big, "A">>), + + ?line decode_badarg(<<131, 67>>), + + ?line decode_badarg(<<131,114>>), + ?line decode_badarg(<<131,114,0>>), + ?line decode_badarg(<<131,114,1:16/big>>), + ?line decode_badarg(<<131,114,1:16/big,100>>), + ?line decode_badarg(<<131,114,1:16/big,100,1:16/big>>), + ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A">>), + ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0>>), + ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:8>>), + ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:16>>), + ?line decode_badarg(<<131,114,1:16/big,100,1:16/big,"A",0,42:24>>), + + ?line decode_badarg(<<131,117>>), % FIXME needs more tests + + ok. + +%% ######################################################################## %% + +decode_badarg(Bin) -> + io:format("Trying ~w\n",[Bin]), + {'EXIT',{badarg,_}} = (catch binary_to_term(Bin)). + +enc_dec(_Size, Term) -> + Bin = term_to_binary(Term), + Term = binary_to_term(Bin), + ok. + +decode(Term, Binary) -> + io:format("Encoding ~w to ~w ... ",[Binary,Term]), + NewTerm = binary_to_term(Binary), + io:format("got ~w\n",[NewTerm]), + Term = NewTerm. + +largest_small_big() -> + List = lists:duplicate(255,255), + Limbs = list_to_binary(List), + binary_to_term(<<131,110,255,0,Limbs/binary>>). + +%% ######################################################################## %% + +appender(Parent, N) -> + seed(), + Res = appender_1(N, {}), + Parent ! {self(),Res}. + +appender_1(0, T) -> T; +appender_1(N, T0) -> + U = rnd_term(), + T = erlang:append_element(T0, U), + appender_1(N-1, T). + +my_appender(N) -> + seed(), + my_appender_1(N, []). + +my_appender_1(0, T) -> + list_to_tuple(lists:reverse(T)); +my_appender_1(N, T0) -> + U = rnd_term(), + T = [U|T0], + my_appender_1(N-1, T). + +seed() -> + random:seed(3172, 9815, 20129). + +rnd_term() -> + U0 = random:uniform(), + B = <>, + {U0,U0 * 2.5 + 3.14,[U0*2.3,B]}. + diff --git a/erts/emulator/test/exception_SUITE.erl b/erts/emulator/test/exception_SUITE.erl new file mode 100644 index 0000000000..f1e6e004ad --- /dev/null +++ b/erts/emulator/test/exception_SUITE.erl @@ -0,0 +1,497 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(exception_SUITE). + +-export([all/1, badmatch/1, pending_errors/1, nil_arith/1, + stacktrace/1, nested_stacktrace/1, raise/1, gunilla/1, per/1, + exception_with_heap_frag/1]). + +-export([bad_guy/2]). + +-include("test_server.hrl"). +-import(lists, [foreach/2]). + +all(suite) -> + [badmatch, pending_errors, nil_arith, + stacktrace, nested_stacktrace, raise, gunilla, per, + exception_with_heap_frag]. + +-define(try_match(E), + catch ?MODULE:bar(), + {'EXIT', {{badmatch, nomatch}, _}} = (catch E = id(nomatch))). + +%% Test that deliberately bad matches are reported correctly. + +badmatch(Config) when is_list(Config) -> + ?line ?try_match(a), + ?line ?try_match(42), + ?line ?try_match({a, b, c}), + ?line ?try_match([]), + ?line ?try_match(1.0), + ok. + +%% Test various exceptions, in the presence of a previous error suppressed +%% in a guard. +pending_errors(Config) when is_list(Config) -> + ?line pending(e_badmatch, {badmatch, b}), + ?line pending(x, function_clause), + ?line pending(e_case, {case_clause, xxx}), + ?line pending(e_if, if_clause), + ?line pending(e_badarith, badarith), + ?line pending(e_undef, undef), + ?line pending(e_timeoutval, timeout_value), + ?line pending(e_badarg, badarg), + ?line pending(e_badarg_spawn, badarg), + ok. + +bad_guy(pe_badarith, Other) when Other+1 == 0 -> % badarith (suppressed) + ok; +bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) + ok; +bad_guy(_, e_case) -> + case id(xxx) of + ok -> ok + end; % case_clause +bad_guy(_, e_if) -> + if + a == b -> ok + end; % if_clause +bad_guy(_, e_badarith) -> + 1+b; % badarith +bad_guy(_, e_undef) -> + non_existing_module:foo(); % undef +bad_guy(_, e_timeoutval) -> + receive + after arne -> % timeout_value + ok + end; +bad_guy(_, e_badarg) -> + node(xxx); % badarg +bad_guy(_, e_badarg_spawn) -> + spawn({}, {}, {}); % badarg +bad_guy(_, e_badmatch) -> + a = id(b). % badmatch + +pending(Arg, Expected) -> + pending(pe_badarith, Arg, Expected), + pending(pe_badarg, Arg, Expected). + +pending(First, Second, Expected) -> + pending_catched(First, Second, Expected), + pending_exit_message([First, Second], Expected). + +pending_catched(First, Second, Expected) -> + ok = io:format("Catching bad_guy(~p, ~p)", [First, Second]), + case catch bad_guy(First, Second) of + {'EXIT', Reason} -> + pending(Reason, bad_guy, [First, Second], Expected); + Other -> + test_server:fail({not_exit, Other}) + end. + +pending_exit_message(Args, Expected) -> + ok = io:format("Trapping EXITs from spawn_link(~p, ~p, ~p)", + [?MODULE, bad_guy, Args]), + process_flag(trap_exit, true), + Pid = spawn_link(?MODULE, bad_guy, Args), + receive + {'EXIT', Pid, Reason} -> + pending(Reason, bad_guy, Args, Expected); + Other -> + test_server:fail({unexpected_message, Other}) + after 10000 -> + test_server:fail(timeout) + end, + process_flag(trap_exit, false). + +pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, Func, Args, _Code) + when is_atom(Bif), is_list(BifArgs), length(Args) == Arity -> + ok; +pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> + ok; +pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> + ok; +pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) when length(Args) == Arity -> + ok; +pending(Reason, _Function, _Args, _Code) -> + test_server:fail({bad_exit_reason,Reason}). + +%% Test that doing arithmetics on [] gives a badarith EXIT and not a crash. + +nil_arith(Config) when is_list(Config) -> + ?line ba_plus_minus_times([], []), + + ?line ba_plus_minus_times([], 0), + ?line ba_plus_minus_times([], 42), + ?line ba_plus_minus_times([], 38724978123478923784), + ?line ba_plus_minus_times([], 38.72), + + ?line ba_plus_minus_times(0, []), + ?line ba_plus_minus_times(334, []), + ?line ba_plus_minus_times(387249797813478923784, []), + ?line ba_plus_minus_times(344.22, []), + + ?line ba_div_rem([], []), + + ?line ba_div_rem([], 0), + ?line ba_div_rem([], 1), + ?line ba_div_rem([], 42), + ?line ba_div_rem([], 38724978123478923784), + ?line ba_div_rem(344.22, []), + + ?line ba_div_rem(0, []), + ?line ba_div_rem(1, []), + ?line ba_div_rem(334, []), + ?line ba_div_rem(387249797813478923784, []), + ?line ba_div_rem(344.22, []), + + ?line ba_div_rem(344.22, 0.0), + ?line ba_div_rem(1, 0.0), + ?line ba_div_rem(392873498733971, 0.0), + + ?line ba_bop([], []), + ?line ba_bop(0, []), + ?line ba_bop(42, []), + ?line ba_bop(-42342742987343, []), + ?line ba_bop(238.342, []), + ?line ba_bop([], 0), + ?line ba_bop([], -243), + ?line ba_bop([], 243), + ?line ba_bop([], 2438724982478933), + ?line ba_bop([], 3987.37), + + ?line ba_bnot([]), + ?line ba_bnot(23.33), + + ?line ba_shift([], []), + ?line ba_shift([], 0), + ?line ba_shift([], 4), + ?line ba_shift([], -4), + ?line ba_shift([], 2343333333333), + ?line ba_shift([], -333333333), + ?line ba_shift([], 234.00), + ?line ba_shift(23, []), + ?line ba_shift(0, []), + ?line ba_shift(-3433443433433323, []), + ?line ba_shift(433443433433323, []), + ?line ba_shift(343.93, []), + ok. + +ba_plus_minus_times(A, B) -> + io:format("~p + ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A + B), + io:format("~p - ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A - B), + io:format("~p * ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A * B). + +ba_div_rem(A, B) -> + io:format("~p / ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A / B), + io:format("~p div ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A div B), + io:format("~p rem ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A rem B). + +ba_bop(A, B) -> + io:format("~p band ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A band B), + io:format("~p bor ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A bor B), + io:format("~p bxor ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A bxor B). + +ba_shift(A, B) -> + io:format("~p bsl ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A bsl B), + io:format("~p bsr ~p", [A, B]), + {'EXIT', {badarith, _}} = (catch A bsr B). + +ba_bnot(A) -> + io:format("bnot ~p", [A]), + {'EXIT', {badarith, _}} = (catch bnot A). + + + +stacktrace(Conf) when is_list(Conf) -> + Tag = make_ref(), + ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), + ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, + V = [make_ref()|self()], + ?line {value2,{caught1,badarg,[{erlang,abs,[V]}|_]=St1}} = + stacktrace_1({'abs',V}, error, {value,V}), + ?line St1 = erase(stacktrace1), + ?line St1 = erase(stacktrace2), + ?line St1 = erlang:get_stacktrace(), + ?line {caught2,{error,badarith},[{?MODULE,my_add,2}|_]=St2} = + stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), + ?line [{?MODULE,my_div,2}|_] = erase(stacktrace1), + ?line St2 = erase(stacktrace2), + ?line St2 = erlang:get_stacktrace(), + ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3}|_]=St3} = + stacktrace_1({value,V}, error, {value,V}), + ?line St3 = erase(stacktrace1), + ?line St3 = erase(stacktrace2), + ?line St3 = erlang:get_stacktrace(), + ?line {caught2,{throw,V},[{?MODULE,foo,1}|_]=St4} = + stacktrace_1({value,V}, error, {throw,V}), + ?line [{?MODULE,stacktrace_1,3}|_] = erase(stacktrace1), + ?line St4 = erase(stacktrace2), + ?line St4 = erlang:get_stacktrace(), + ok. + +stacktrace_1(X, C1, Y) -> + erase(stacktrace1), + erase(stacktrace2), + try try foo(X) of + C1 -> value1 + catch + C1:D1 -> {caught1,D1,erlang:get_stacktrace()} + after + put(stacktrace1, erlang:get_stacktrace()), + foo(Y) + end of + V2 -> {value2,V2} + catch + C2:D2 -> {caught2,{C2,D2},erlang:get_stacktrace()} + after + put(stacktrace2, erlang:get_stacktrace()) + end. + + + +nested_stacktrace(Conf) when is_list(Conf) -> + V = [{make_ref()}|[self()]], + ?line value1 = + nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, + {void,void,void}), + ?line {caught1, + [{?MODULE,my_add,2}|_], + value2, + [{?MODULE,my_add,2}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), + ?line {caught1, + [{?MODULE,my_add,2}|_], + {caught2,[{erlang,abs,[V]}|_]}, + [{erlang,abs,[V]}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{'abs',V},error,badarg}), + ok. + +nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> + try foo(X1) of + V1 -> value1 + catch + C1:V1 -> + S1 = erlang:get_stacktrace(), + T2 = + try foo(X2) of + V2 -> value2 + catch + C2:V2 -> {caught2,erlang:get_stacktrace()} + end, + {caught1,S1,T2,erlang:get_stacktrace()} + end. + + + +raise(Conf) when is_list(Conf) -> + ?line erase(raise), + ?line A = + try + ?line try foo({'div',{1,0}}) + catch + error:badarith -> + put(raise, A0 = erlang:get_stacktrace()), + ?line erlang:raise(error, badarith, A0) + end + catch + error:badarith -> + ?line A1 = erlang:get_stacktrace(), + ?line A1 = get(raise) + end, + ?line A = erlang:get_stacktrace(), + ?line A = get(raise), + ?line [{?MODULE,my_div,2}|_] = A, + %% + N = 8, % Must be even + ?line N = erlang:system_flag(backtrace_depth, N), + ?line try even(N) + catch error:function_clause -> ok + end, + ?line B = odd_even(N, []), + ?line B = erlang:get_stacktrace(), + %% + ?line C0 = odd_even(N+1, []), + ?line C = lists:sublist(C0, N), + ?line try odd(N+1) + catch error:function_clause -> ok + end, + ?line C = erlang:get_stacktrace(), + ?line try erlang:raise(error, function_clause, C0) + catch error:function_clause -> ok + end, + ?line C = erlang:get_stacktrace(), + ok. + +odd_even(N, R) when is_integer(N), N > 1 -> + odd_even(N-1, + [if (N rem 2) == 0 -> + {?MODULE,even,1}; + true -> + {?MODULE,odd,1} + end|R]); +odd_even(1, R) -> + [{?MODULE,odd,[1]}|R]. + +even(N) when is_integer(N), N > 1, (N rem 2) == 0 -> + odd(N-1)++[N]. + +odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> + even(N-1)++[N]. + + +foo({value,Value}) -> Value; +foo({'div',{A,B}}) -> + my_div(A, B); +foo({'add',{A,B}}) -> + my_add(A, B); +foo({'abs',X}) -> + my_abs(X); +foo({error,Error}) -> + erlang:error(Error); +foo({throw,Throw}) -> + erlang:throw(Throw); +foo({exit,Exit}) -> + erlang:exit(Exit); +foo({raise,{Class,Reason,Stacktrace}}) -> + erlang:raise(Class, Reason, Stacktrace). +%%foo(function_clause) -> % must not be defined! + +my_div(A, B) -> + A div B. + +my_add(A, B) -> + A + B. + +my_abs(X) -> abs(X). + +gunilla(Config) when is_list(Config) -> + ?line {throw,kalle} = gunilla_1(), + ?line [] = erlang:get_stacktrace(), + ok. + +gunilla_1() -> + try try arne() + after + pelle + end + catch + C:R -> + {C,R} + end. + +arne() -> + %% Empty stack trace used to cause change the error class to 'error'. + erlang:raise(throw, kalle, []). + +per(Config) when is_list(Config) -> + try + t1(0,pad,0), + t2(0,pad,0) + catch + error:badarith -> + ok + end. + +t1(_,X,_) -> + (1 bsl X) + 1. + +t2(_,X,_) -> + (X bsl 1) + 1. + +%% +%% Make sure that even if a BIF builds an heap fragment, then causes an exception, +%% the stacktrace term will still be OK (specifically, that it does not contain +%% stale pointers to the arguments). +%% +exception_with_heap_frag(Config) when is_list(Config) -> + Sizes = lists:seq(0, 512), + + %% Floats are only validated when the heap fragment has been allocated. + BadFloat = <<131,99,53,46,48,$X,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,48,101,45,48,49,0,0,0,0,0>>, + ?line do_exception_with_heap_frag(BadFloat, Sizes), + + %% {Binary,BadFloat}: When the error in float is discovered, a refc-binary + %% has been allocated and the list of refc-binaries goes through the + %% heap fragment. + BinAndFloat = + <<131,104,2,109,0,0,1,0,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, + 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45, + 46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70, + 71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95, + 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115, + 116,117,118,119,120,121,122,123,124,125,126,127,128,129,130,131,132,133,134, + 135,136,137,138,139,140,141,142,143,144,145,146,147,148,149,150,151,152,153, + 154,155,156,157,158,159,160,161,162,163,164,165,166,167,168,169,170,171,172, + 173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191, + 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208,209,210, + 211,212,213,214,215,216,217,218,219,220,221,222,223,224,225,226,227,228,229, + 230,231,232,233,234,235,236,237,238,239,240,241,242,243,244,245,246,247,248, + 249,250,251,252,253,254,255,99,51,46,49,52,$B,$l,$u,$r,$f,48,48,48,48,48,48, + 48,48,49,50,52,51,52,101,43,48,48,0,0,0,0,0>>, + ?line do_exception_with_heap_frag(BinAndFloat, Sizes), + + %% {Fun,BadFloat} + FunAndFloat = + <<131,104,2,112,0,0,0,66,0,238,239,135,138,137,216,89,57,22,111,52,126,16,84, + 71,8,0,0,0,0,0,0,0,0,100,0,1,116,97,0,98,5,175,169,123,103,100,0,13,110,111, + 110,111,100,101,64,110,111,104,111,115,116,0,0,0,41,0,0,0,0,0,99,50,46,55,48, + $Y,57,57,57,57,57,57,57,57,57,57,57,57,57,54,52,52,55,101,43,48,48,0,0,0,0,0>>, + ?line do_exception_with_heap_frag(FunAndFloat, Sizes), + + %% [ExternalPid|BadFloat] + ExtPidAndFloat = + <<131,108,0,0,0,1,103,100,0,13,107,97,108,108,101,64,115,116,114,105,100,101, + 114,0,0,0,36,0,0,0,0,2,99,48,46,$@,48,48,48,48,48,48,48,48,48,48,48,48,48,48, + 48,48,48,48,48,101,43,48,48,0,0,0,0,0>>, + ?line do_exception_with_heap_frag(ExtPidAndFloat, Sizes), + + ok. + +do_exception_with_heap_frag(Bin, [Sz|Sizes]) -> + Filler = erlang:make_tuple(Sz, a), + spawn(fun() -> + try + binary_to_term(Bin) + catch + _:_ -> + %% term_to_binary/1 is an easy way to traverse the + %% entire stacktrace term to make sure that every part + %% of it is OK. + term_to_binary(erlang:get_stacktrace()) + end, + id(Filler) + end), + do_exception_with_heap_frag(Bin, Sizes); +do_exception_with_heap_frag(_, []) -> ok. + +id(I) -> I. diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl new file mode 100644 index 0000000000..102e472ea6 --- /dev/null +++ b/erts/emulator/test/float_SUITE.erl @@ -0,0 +1,167 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(float_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1,bad_float_unpack/1]). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(3)), + [{watchdog, Dog},{testcase,Func}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +all(suite) -> + [fpe,fp_drv,fp_drv_thread,denormalized,match,bad_float_unpack]. + +%% Forces floating point exceptions and tests that subsequent, legal, +%% operations are calculated correctly. Original version by Sebastian +%% Strollo. + +fpe(Config) when is_list(Config) -> + ?line 0.0 = math:log(1.0), + ?line {'EXIT', {badarith, _}} = (catch math:log(-1.0)), + ?line 0.0 = math:log(1.0), + ?line {'EXIT', {badarith, _}} = (catch math:log(0.0)), + ?line 0.0 = math:log(1.0), + ?line {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)), + ?line 0.0 = math:log(1.0), + ?line {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)), + ?line 0.0 = math:log(1.0), + ok. + + +-define(ERTS_FP_CONTROL_TEST, 0). +-define(ERTS_FP_THREAD_TEST, 1). + +fp_drv(Config) when is_list(Config) -> + fp_drv_test(?ERTS_FP_CONTROL_TEST, ?config(data_dir, Config)). + +fp_drv_thread(Config) when is_list(Config) -> + %% Run in a separate node since it used to crash the emulator... + ?line Parent = self(), + ?line DrvDir = ?config(data_dir, Config), + ?line {ok,Node} = start_node(Config), + ?line Tester = spawn_link(Node, + fun () -> + Parent ! + {self(), + fp_drv_test(?ERTS_FP_THREAD_TEST, + DrvDir)} + end), + ?line Result = receive {Tester, Res} -> Res end, + ?line stop_node(Node), + ?line Result. + +fp_drv_test(Test, DrvDir) -> + ?line Drv = fp_drv, + ?line try + begin + ?line case erl_ddll:load_driver(DrvDir, Drv) of + ok -> + ok; + {error, permanent} -> + ok; + {error, LoadError} -> + exit({load_error, + erl_ddll:format_error(LoadError)}); + LoadError -> + exit({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + try port_control(Port, Test, "") of + "ok" -> + 0.0 = math:log(1.0), + ok; + [$s,$k,$i,$p,$:,$ | Reason] -> + {skipped, Reason}; + Error -> + exit(Error) + after + Port ! {self(), close}, + receive {Port, closed} -> ok end, + false = lists:member(Port, erlang:ports()), + ok + end; + Error -> + exit({open_port_failed, Error}) + end + end + catch + throw:Term -> ?line Term + after + erl_ddll:unload_driver(Drv) + end. + +denormalized(Config) when is_list(Config) -> + ?line Denormalized = 1.0e-307 / 1000, + ?line roundtrip(Denormalized), + ?line NegDenormalized = -1.0e-307 / 1000, + ?line roundtrip(NegDenormalized), + ok. + +roundtrip(N) -> + N = binary_to_term(term_to_binary(N)), + N = binary_to_term(term_to_binary(N, [{minor_version,1}])). + +match(Config) when is_list(Config) -> + ?line one = match_1(1.0), + ?line two = match_1(2.0), + ?line a_lot = match_1(1000.0), + ?line {'EXIT',_} = (catch match_1(0.5)), + ok. + +match_1(1.0) -> one; +match_1(2.0) -> two; +match_1(1000.0) -> a_lot. + +%% Thanks to Per Gustafsson. + +bad_float_unpack(Config) when is_list(Config) -> + ?line Bin = <<-1:64>>, + ?line -1 = bad_float_unpack_match(Bin), + ok. + +bad_float_unpack_match(<>) -> F; +bad_float_unpack_match(<>) -> I. + +id(I) -> I. + +start_node(Config) when is_list(Config) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {A, B, C} = now(), + ?line Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)), + ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). + +stop_node(Node) -> + ?t:stop_node(Node). diff --git a/erts/emulator/test/float_SUITE_data/Makefile.src b/erts/emulator/test/float_SUITE_data/Makefile.src new file mode 100644 index 0000000000..628fece803 --- /dev/null +++ b/erts/emulator/test/float_SUITE_data/Makefile.src @@ -0,0 +1,8 @@ +DRVS = fp_drv@dll@ + +all: has_fpe_bug $(DRVS) + +has_fpe_bug: + @erl_name@ -compile has_fpe_bug -s has_fpe_bug + +@SHLIB_RULES@ diff --git a/erts/emulator/test/float_SUITE_data/fp_drv.c b/erts/emulator/test/float_SUITE_data/fp_drv.c new file mode 100644 index 0000000000..eb453f6cd6 --- /dev/null +++ b/erts/emulator/test/float_SUITE_data/fp_drv.c @@ -0,0 +1,142 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson AB. Portions + * created by Ericsson are Copyright 2008, Ericsson AB. All Rights + * Reserved.'' + * + * $Id$ + */ + +#if defined(DEBUG) || 0 +# define PRINTF(X) printf X +#else +# define PRINTF(X) +#endif + +#include +#ifdef __WIN32__ +#include +#if defined (__GNUC__) +int _finite(double x); +#endif +#ifndef finite +#define finite _finite +#endif +#endif +#include "erl_driver.h" + +#define ERTS_FP_CONTROL_TEST 0 +#define ERTS_FP_THREAD_TEST 1 + +static int control(ErlDrvData, unsigned int, char *, int, char **, int); + +static ErlDrvEntry fp_drv_entry = { + NULL /* init */, + NULL /* start */, + NULL /* stop */, + NULL /* output */, + NULL /* ready_input */, + NULL /* ready_output */, + "fp_drv", + NULL /* finish */, + NULL /* handle */, + control, + NULL /* timeout */, + NULL /* outputv */, + NULL /* ready_async */, + NULL /* flush */, + NULL /* call */, + NULL /* event */, + ERL_DRV_EXTENDED_MARKER, + ERL_DRV_EXTENDED_MAJOR_VERSION, + ERL_DRV_EXTENDED_MINOR_VERSION, + ERL_DRV_FLAG_USE_PORT_LOCKING, + NULL /* handle2 */, + NULL /* process_exit */ +}; + +DRIVER_INIT(fp_drv) +{ + return &fp_drv_entry; +} + +void * +do_test(void *unused) +{ + double x, y, z; + + x = 3.23e133; + y = 3.57e257; + z = x*y; + if (finite(z)) + return "is finite (1)"; + + x = 5.0; + y = 0.0; + z = x/y; + if (finite(z)) + return "is finite (2)"; + + z = log(-1.0); + if (finite(z)) + return "is finite (3)"; + + z = log(0.0); + if (finite(z)) + return "is finite (4)"; + + return "ok"; +} + +static int control(ErlDrvData drv_data, + unsigned int command, + char *buf, int len, + char **rbuf, int rlen) +{ + char *res_str; + PRINTF(("control(%p, %d, ...) called\r\n", drv_data, command)); + + switch (command) { + case ERTS_FP_THREAD_TEST: { + ErlDrvTid tid; + ErlDrvSysInfo info; + driver_system_info(&info, sizeof(ErlDrvSysInfo)); + if (!info.thread_support) + res_str = "skip: no thread support"; + else if (0 != erl_drv_thread_create("test", &tid, do_test, NULL, NULL)) + res_str = "failed to create thread"; + else if (0 != erl_drv_thread_join(tid, &res_str)) + res_str = "failed to join thread"; + break; + } + case ERTS_FP_CONTROL_TEST: + res_str = do_test(NULL); + break; + default: + res_str = "unknown command"; + break; + } + + done: { + int res_len = strlen(res_str); + if (res_len > rlen) { + char *abuf = driver_alloc(sizeof(char)*res_len); + if (!abuf) + return 0; + *rbuf = abuf; + } + + memcpy((void *) *rbuf, (void *) res_str, res_len); + + return res_len; + } +} diff --git a/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl b/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl new file mode 100644 index 0000000000..31af2b2698 --- /dev/null +++ b/erts/emulator/test/float_SUITE_data/has_fpe_bug.erl @@ -0,0 +1,31 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(has_fpe_bug). + +-export([start/0]). + +start() -> + case catch math:log(-1.0) of + {'EXIT', {badarith, _}} -> + halt(0); % Ok. + _ -> + file:write_file(skip_reason, "Known FPE bug"), + halt(1) + end. diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl new file mode 100644 index 0000000000..716ee3707d --- /dev/null +++ b/erts/emulator/test/fun_SUITE.erl @@ -0,0 +1,884 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(fun_SUITE). +-compile({nowarn_deprecated_function, {erlang,hash,2}}). + +-define(default_timeout, ?t:minutes(1)). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + bad_apply/1,bad_fun_call/1,badarity/1,ext_badarity/1, + equality/1,ordering/1, + fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1, + refc/1,refc_ets/1,refc_dist/1, + const_propagation/1,t_arity/1,t_is_function2/1, + t_fun_info/1]). + +-export([nothing/0]). + +-include("test_server.hrl"). + +all(suite) -> + [bad_apply,bad_fun_call,badarity,ext_badarity,equality,ordering, + fun_to_port,t_hash,t_phash,t_phash2,md5, + refc,refc_ets,refc_dist,const_propagation, + t_arity,t_is_function2,t_fun_info]. + +init_per_testcase(_Case, Config) -> + ?line Dog = test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +bad_apply(doc) -> + "Test that the correct EXIT code is returned for all types of bad funs."; +bad_apply(suite) -> []; +bad_apply(Config) when is_list(Config) -> + ?line bad_apply_fc(42, [0]), + ?line bad_apply_fc(xx, [1]), + ?line bad_apply_fc({}, [2]), + ?line bad_apply_fc({1}, [3]), + ?line bad_apply_fc({1,2,3}, [4]), + ?line bad_apply_fc({1,2,3}, [5]), + ?line bad_apply_fc({1,2,3,4}, [6]), + ?line bad_apply_fc({1,2,3,4,5,6}, [7]), + ?line bad_apply_fc({1,2,3,4,5}, [8]), + ?line bad_apply_badarg({1,2}, [9]), + ok. + +bad_apply_fc(Fun, Args) -> + Res = (catch apply(Fun, Args)), + erlang:garbage_collect(), + erlang:yield(), + case Res of + {'EXIT',{{badfun,Fun},_Where}} -> + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]); + Other -> + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]), + ?t:fail({bad_result,Other}) + end. + +bad_apply_badarg(Fun, Args) -> + Res = (catch apply(Fun, Args)), + erlang:garbage_collect(), + erlang:yield(), + case Res of + {'EXIT',{{badfun,Fun},_Where}} -> + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]); + Other -> + ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]), + ?t:fail({bad_result, Other}) + end. + +bad_fun_call(doc) -> + "Try directly calling bad funs."; +bad_fun_call(suite) -> []; +bad_fun_call(Config) when is_list(Config) -> + ?line bad_call_fc(42), + ?line bad_call_fc(xx), + ?line bad_call_fc({}), + ?line bad_call_fc({1}), + ?line bad_call_fc({1,2,3}), + ?line bad_call_fc({1,2,3}), + ?line bad_call_fc({1,2,3,4}), + ?line bad_call_fc({1,2,3,4,5,6}), + ?line bad_call_fc({1,2,3,4,5}), + ?line bad_call_fc({1,2}), + ok. + +bad_call_fc(Fun) -> + Args = [some,stupid,args], + Res = (catch Fun(Fun(Args))), + case Res of + {'EXIT',{{badfun,Fun},_Where}} -> + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + Other -> + ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ?t:fail({bad_result,Other}) + end. + +%% Call and apply valid funs with wrong number of arguments. + +badarity(Config) when is_list(Config) -> + ?line Fun = fun() -> ok end, + ?line Stupid = {stupid,arguments}, + ?line Args = [some,{stupid,arguments},here], + + %% Simple call. + + ?line Res = (catch Fun(some, Stupid, here)), + erlang:garbage_collect(), + erlang:yield(), + case Res of + {'EXIT',{{badarity,{Fun,Args}},_}} -> + ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + _ -> + ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ?line ?t:fail({bad_result,Res}) + end, + + %% Apply. + + ?line Res2 = (catch apply(Fun, Args)), + erlang:garbage_collect(), + erlang:yield(), + case Res2 of + {'EXIT',{{badarity,{Fun,Args}},_}} -> + ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); + _ -> + ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), + ?line ?t:fail({bad_result,Res2}) + end, + ok. + +%% Call and apply valid external funs with wrong number of arguments. + +ext_badarity(Config) when is_list(Config) -> + ?line Fun = fun ?MODULE:nothing/0, + ?line Stupid = {stupid,arguments}, + ?line Args = [some,{stupid,arguments},here], + + %% Simple call. + + ?line Res = (catch Fun(some, Stupid, here)), + erlang:garbage_collect(), + erlang:yield(), + case Res of + {'EXIT',{{badarity,{Fun,Args}},_}} -> + ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]); + _ -> + ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]), + ?line ?t:fail({bad_result,Res}) + end, + + %% Apply. + + ?line Res2 = (catch apply(Fun, Args)), + erlang:garbage_collect(), + erlang:yield(), + case Res2 of + {'EXIT',{{badarity,{Fun,Args}},_}} -> + ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]); + _ -> + ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]), + ?line ?t:fail({bad_result,Res2}) + end, + ok. + +nothing() -> + ok. + +%% Test equality of funs. + +equality(Config) when is_list(Config) -> + F0 = fun() -> 1 end, + F0_copy = copy_term(F0), + ?line true = eq(F0, F0), + ?line true = eq(F0, F0_copy), + + %% Compare different arities. + F1 = fun(X) -> X + 1 end, + ?line true = eq(F1, F1), + ?line false = eq(F0, F1), + ?line false = eq(F0_copy, F1), + + %% Compare different environments. + G1 = make_fun(1), + G2 = make_fun(2), + ?line true = eq(G1, G1), + ?line true = eq(G2, G2), + ?line false = eq(G1, G2), + ?line false = eq(G2, G1), + G1_copy = copy_term(G1), + ?line true = eq(G1, G1_copy), + + %% Compare fun with binaries. + B = list_to_binary([7,8,9]), + ?line false = eq(B, G1), + ?line false = eq(G1, B), + + %% Compare external funs. + FF0 = fun aa:blurf/0, + FF0_copy = copy_term(FF0), + FF1 = fun erlang:abs/0, + FF2 = fun erlang:exit/1, + FF3 = fun erlang:exit/2, + FF4 = fun z:ff/0, + + ?line true = eq(FF0, FF0), + ?line true = eq(FF0, FF0_copy), + ?line true = eq(FF1, FF1), + ?line true = eq(FF2, FF2), + ?line true = eq(FF3, FF3), + ?line true = eq(FF4, FF4), + ?line false = eq(FF0, FF1), + ?line false = eq(FF0, FF2), + ?line false = eq(FF0, FF3), + ?line false = eq(FF0, FF4), + ?line false = eq(FF1, FF0), + ?line false = eq(FF1, FF2), + ?line false = eq(FF1, FF3), + ?line false = eq(FF1, FF4), + ?line false = eq(FF2, FF3), + ?line false = eq(FF2, FF4), + ?line false = eq(FF3, FF4), + + ok. + +eq(X, X) -> true; +eq(_, _) -> false. + +copy_term(Term) -> + binary_to_term(term_to_binary(Term)). + +make_fun(X) -> + fun() -> X end. + +ordering(doc) -> "Tests ordering of funs."; +ordering(Config) when is_list(Config) -> + F1 = make_fun(1, 2), + F1_copy = copy_term(F1), + F2 = make_fun(1, 3), + F3 = make_fun(3, 4), + + FF0 = fun aa:blurf/0, + FF1 = fun erlang:abs/0, + FF2 = fun erlang:exit/1, + FF3 = fun erlang:exit/2, + FF4 = fun z:ff/0, + + ?line true = FF0 < FF1, + ?line true = FF1 < FF2, + ?line true = FF2 < FF3, + ?line true = FF3 < FF4, + + ?line true = FF0 > F1, + ?line true = FF0 > F2, + ?line true = FF0 > F3, + ?line true = FF4 > F1, + ?line true = FF4 > F2, + ?line true = FF4 > F3, + + ?line true = F1 == F1, + ?line true = F1 == F1_copy, + ?line true = F1 /= F2, + + ?line true = F1 < F2, + ?line true = F2 > F1, + ?line true = F2 < F3, + ?line true = F3 > F2, + + ?line false = F1 > F2, + ?line false = F2 > F3, + + %% Compare with binaries. + + B = list_to_binary([7,8,9,10]), + ?line false = B == F1, + ?line false = F1 == B, + + ?line true = F1 < B, + ?line true = B > F2, + + ?line false = F1 > B, + ?line false = B < F2, + + ?line false = F1 >= B, + ?line false = B =< F2, + + %% Compare module funs with binaries. + ?line false = B == FF1, + ?line false = FF1 == B, + + ?line true = FF1 < B, + ?line true = B > FF2, + + ?line false = FF1 > B, + ?line false = B < FF2, + + ?line false = FF1 >= B, + ?line false = B =< FF2, + + %% Create a port and ref. + + ?line Path = ?config(priv_dir, Config), + ?line AFile = filename:join(Path, "vanilla_file"), + ?line P = open_port(AFile, [out]), + ?line R = make_ref(), + + %% Compare funs with ports and refs. + + ?line true = R < F3, + ?line true = F3 > R, + ?line true = F3 < P, + ?line true = P > F3, + + ?line true = R =< F3, + ?line true = F3 >= R, + ?line true = F3 =< P, + ?line true = P >= F3, + + ?line false = R > F3, + ?line false = F3 < R, + ?line false = F3 > P, + ?line false = P < F3, + + %% Compare funs with conses and nils. + + ?line true = F1 < [a], + ?line true = F1 < [], + ?line true = [a,b] > F1, + ?line true = [] > F1, + + ?line false = [1] < F1, + ?line false = [] < F1, + ?line false = F1 > [2], + ?line false = F1 > [], + + ?line false = [1] =< F1, + ?line false = [] =< F1, + ?line false = F1 >= [2], + ?line false = F1 >= [], + + %% Compare module funs with conses and nils. + + ?line true = FF1 < [a], + ?line true = FF1 < [], + ?line true = [a,b] > FF1, + ?line true = [] > FF1, + + ?line false = [1] < FF1, + ?line false = [] < FF1, + ?line false = FF1 > [2], + ?line false = FF1 > [], + + ?line false = [1] =< FF1, + ?line false = [] =< FF1, + ?line false = FF1 >= [2], + ?line false = FF1 >= [], + ok. + +make_fun(X, Y) -> + fun(A) -> A*X+Y end. + +fun_to_port(doc) -> "Try sending funs to ports (should fail)."; +fun_to_port(suite) -> []; +fun_to_port(Config) when is_list(Config) -> + ?line fun_to_port(Config, xxx), + ?line fun_to_port(Config, fun() -> 42 end), + ?line fun_to_port(Config, [fun() -> 43 end]), + ?line fun_to_port(Config, [1,fun() -> 44 end]), + ?line fun_to_port(Config, [0,1|fun() -> 45 end]), + B64K = build_io_list(65536), + ?line fun_to_port(Config, [B64K,fun() -> 45 end]), + ?line fun_to_port(Config, [B64K|fun() -> 45 end]), + ok. + +fun_to_port(Config, IoList) -> + Path = ?config(priv_dir, Config), + AFile = filename:join(Path, "vanilla_file"), + Port = open_port(AFile, [out]), + case catch port_command(Port, IoList) of + {'EXIT',{badarg,_}} -> ok; + Other -> ?t:fail({unexpected_retval,Other}) + end. + +build_io_list(0) -> []; +build_io_list(1) -> [7]; +build_io_list(N) -> + L = build_io_list(N div 2), + case N rem 2 of + 0 -> [L|L]; + 1 -> [7,L|L] + end. + +t_hash(doc) -> "Test the hash/2 BIF on funs."; +t_hash(suite) -> []; +t_hash(Config) when is_list(Config) -> + F1 = fun(_X) -> 1 end, + F2 = fun(_X) -> 2 end, + ?line true = hash(F1) /= hash(F2), + + G1 = make_fun(1, 2, 3), + G2 = make_fun(1, 2, 3), + G3 = make_fun(1, 2, 4), + ?line true = hash(G1) == hash(G2), + ?line true = hash(G2) /= hash(G3), + + FF0 = fun erlang:abs/1, + FF1 = fun erlang:exit/1, + FF2 = fun erlang:exit/2, + FF3 = fun blurf:exit/2, + ?line true = hash(FF0) =/= hash(FF1), + ?line true = hash(FF0) =/= hash(FF2), + ?line true = hash(FF0) =/= hash(FF3), + ?line true = hash(FF1) =/= hash(FF2), + ?line true = hash(FF1) =/= hash(FF3), + ?line true = hash(FF2) =/= hash(FF3), + ok. + +hash(Term) -> + erlang:hash(Term, 16#7ffffff). + +t_phash(doc) -> "Test the phash/2 BIF on funs."; +t_phash(suite) -> []; +t_phash(Config) when is_list(Config) -> + F1 = fun(_X) -> 1 end, + F2 = fun(_X) -> 2 end, + ?line true = phash(F1) /= phash(F2), + + G1 = make_fun(1, 2, 3), + G2 = make_fun(1, 2, 3), + G3 = make_fun(1, 2, 4), + ?line true = phash(G1) == phash(G2), + ?line true = phash(G2) /= phash(G3), + + FF0 = fun erlang:abs/1, + FF1 = fun erlang:exit/1, + FF2 = fun erlang:exit/2, + FF3 = fun blurf:exit/2, + ?line true = phash(FF0) =/= phash(FF1), + ?line true = phash(FF0) =/= phash(FF2), + ?line true = phash(FF0) =/= phash(FF3), + ?line true = phash(FF1) =/= phash(FF2), + ?line true = phash(FF1) =/= phash(FF3), + ?line true = phash(FF2) =/= phash(FF3), + + ok. + +phash(Term) -> + erlang:phash(Term, 16#7ffffff). + +t_phash2(doc) -> "Test the phash2/2 BIF on funs."; +t_phash2(suite) -> []; +t_phash2(Config) when is_list(Config) -> + F1 = fun(_X) -> 1 end, + F2 = fun(_X) -> 2 end, + ?line true = phash2(F1) /= phash2(F2), + + G1 = make_fun(1, 2, 3), + G2 = make_fun(1, 2, 3), + G3 = make_fun(1, 2, 4), + ?line true = phash2(G1) == phash2(G2), + ?line true = phash2(G2) /= phash2(G3), + + FF0 = fun erlang:abs/1, + FF1 = fun erlang:exit/1, + FF2 = fun erlang:exit/2, + FF3 = fun blurf:exit/2, + ?line true = phash2(FF0) =/= phash2(FF1), + ?line true = phash2(FF0) =/= phash2(FF2), + ?line true = phash2(FF0) =/= phash2(FF3), + ?line true = phash2(FF1) =/= phash2(FF2), + ?line true = phash2(FF1) =/= phash2(FF3), + ?line true = phash2(FF2) =/= phash2(FF3), + + ok. + +phash2(Term) -> + erlang:phash2(Term, 16#7ffffff). + +make_fun(X, Y, Z) -> + fun() -> {X,Y,Z} end. + +md5(doc) -> "Test that MD5 bifs reject funs properly."; +md5(suite) -> []; +md5(Config) when is_list(Config) -> + _ = size(erlang:md5_init()), + + %% Try funs in the i/o list. + ?line bad_md5(fun(_X) -> 42 end), + ?line bad_md5([fun(_X) -> 43 end]), + ?line bad_md5([1,fun(_X) -> 44 end]), + ?line bad_md5([1|fun(_X) -> 45 end]), + ?line B64K = build_io_list(65536), + ?line bad_md5([B64K,fun(_X) -> 46 end]), + ?line bad_md5([B64K|fun(_X) -> 46 end]), + ok. + +bad_md5(Bad) -> + {'EXIT',{badarg,_}} = (catch erlang:md5(Bad)). + +refc(Config) when is_list(Config) -> + case erlang:system_info(heap_type) of + private -> refc_1(); + hybrid -> {skip,"Hybrid heap"} + end. + +refc_1() -> + ?line F1 = fun_factory(2), + ?line {refc,2} = erlang:fun_info(F1, refc), + ?line F2 = fun_factory(42), + ?line {refc,3} = erlang:fun_info(F1, refc), + + ?line process_flag(trap_exit, true), + ?line Pid = spawn_link(fun() -> {refc,4} = erlang:fun_info(F1, refc) end), + receive + {'EXIT',Pid,normal} -> ok; + Other -> ?line ?t:fail({unexpected,Other}) + end, + ?line process_flag(trap_exit, false), + ?line {refc,3} = erlang:fun_info(F1, refc), + + %% Garbage collect. Only the F2 fun will be left. + ?line 7 = F1(5), + ?line true = erlang:garbage_collect(), + ?line 40 = F2(-2), + ?line {refc,2} = erlang:fun_info(F2, refc), + ok. + +fun_factory(Const) -> + fun(X) -> X + Const end. + +refc_ets(Config) when is_list(Config) -> + case erlang:system_info(heap_type) of + private -> refc_ets_1(); + hybrid -> {skip,"Hybrid heap"} + end. + +refc_ets_1() -> + ?line F = fun(X) -> X + 33 end, + ?line {refc,2} = erlang:fun_info(F, refc), + + refc_ets_set(F, [set]), + refc_ets_set(F, [ordered_set]), + refc_ets_bag(F, [bag]), + refc_ets_bag(F, [duplicate_bag]), + ok. + +refc_ets_set(F1, Options) -> + ?line io:format("~p", [Options]), + ?line Tab = ets:new(kalle, Options), + ?line true = ets:insert(Tab, {a_key,F1}), + ?line 3 = fun_refc(F1), + ?line [{a_key,F3}] = ets:lookup(Tab, a_key), + ?line 4 = fun_refc(F1), + ?line true = ets:insert(Tab, {a_key,not_a_fun}), + ?line 3 = fun_refc(F1), + ?line true = ets:insert(Tab, {another_key,F1}), + ?line 4 = fun_refc(F1), + ?line true = ets:delete(Tab), + ?line 3 = fun_refc(F1), + ?line 10 = F3(-23), + ?line true = erlang:garbage_collect(), + ?line 2 = fun_refc(F1), + ok. + +refc_ets_bag(F1, Options) -> + ?line io:format("~p", [Options]), + ?line Tab = ets:new(kalle, Options), + ?line true = ets:insert(Tab, {a_key,F1}), + ?line 3 = fun_refc(F1), + ?line [{a_key,F3}] = ets:lookup(Tab, a_key), + ?line 4 = fun_refc(F1), + ?line true = ets:insert(Tab, {a_key,not_a_fun}), + ?line 4 = fun_refc(F1), + ?line true = ets:insert(Tab, {another_key,F1}), + ?line 5 = fun_refc(F1), + ?line true = ets:delete(Tab), + ?line 3 = fun_refc(F1), + ?line 10 = F3(-23), + ?line true = erlang:garbage_collect(), + ?line 2 = fun_refc(F1), + ok. + +refc_dist(Config) when is_list(Config) -> + case erlang:system_info(heap_type) of + private -> refc_dist_1(); + hybrid -> {skip,"Hybrid heap"} + end. + +refc_dist_1() -> + ?line {ok,Node} = start_node(fun_SUITE_refc_dist), + ?line process_flag(trap_exit, true), + ?line Pid = spawn_link(Node, + fun() -> receive + Fun when is_function(Fun) -> + 2 = fun_refc(Fun), + exit({normal,Fun}) end + end), + ?line F = fun() -> 42 end, + ?line 2 = fun_refc(F), + ?line Pid ! F, + F2 = receive + {'EXIT',Pid,{normal,Fun}} -> Fun; + Other -> ?line ?t:fail({unexpected,Other}) + end, + %% dist.c:net_mess2 have a reference to Fun for a while since + %% Fun is passed in an exit signal. Wait until it is gone. + ?line wait_until(fun () -> 4 =/= fun_refc(F2) end), + ?line 3 = fun_refc(F2), + ?line 3 = fun_refc(F), + refc_dist_send(Node, F). + +refc_dist_send(Node, F) -> + ?line true = erlang:garbage_collect(), + ?line Pid = spawn_link(Node, + fun() -> receive + {To,Fun} when is_function(Fun) -> + wait_until(fun () -> + 2 =:= fun_refc(Fun) + end), + To ! Fun + end + end), + ?line 2 = fun_refc(F), + Pid ! {self(),F}, + F2 = receive + Fun when is_function(Fun) -> Fun; + Other -> ?line ?t:fail({unexpected,Other}) + end, + receive {'EXIT',Pid,normal} -> ok end, + %% No reference from dist.c:net_mess2 since Fun is passed + %% in an ordinary message. + ?line 3 = fun_refc(F), + ?line 3 = fun_refc(F2), + refc_dist_reg_send(Node, F). + +refc_dist_reg_send(Node, F) -> + ?line true = erlang:garbage_collect(), + ?line 2 = fun_refc(F), + ?line Ref = make_ref(), + ?line Me = self(), + ?line Pid = spawn_link(Node, + fun() -> + true = register(my_fun_tester, self()), + Me ! Ref, + receive + {Me,Fun} when is_function(Fun) -> + 2 = fun_refc(Fun), + Me ! Fun + end + end), + erlang:yield(), + ?line 2 = fun_refc(F), + receive Ref -> ok end, + {my_fun_tester,Node} ! {self(),F}, + F2 = receive + Fun when is_function(Fun) -> Fun; + Other -> ?line ?t:fail({unexpected,Other}) + end, + receive {'EXIT',Pid,normal} -> ok end, + + ?line 3 = fun_refc(F), + ?line 3 = fun_refc(F2), + ok. + +fun_refc(F) -> + {refc,Count} = erlang:fun_info(F, refc), + Count. + +const_propagation(Config) when is_list(Config) -> + ?line Fun1 = fun start_node/1, + ?line 2 = fun_refc(Fun1), + ?line Fun2 = Fun1, + ?line my_cmp({Fun1,Fun2}), + + ?line Fun3 = fun() -> ok end, + ?line 2 = fun_refc(Fun3), + ?line Fun4 = Fun3, + ?line my_cmp({Fun3,Fun4}), + ok. + +my_cmp({Fun,Fun}) -> ok; +my_cmp({Fun1,Fun2}) -> + io:format("Fun1: ~p", [erlang:fun_info(Fun1)]), + io:format("Fun2: ~p", [erlang:fun_info(Fun2)]), + ?t:fail(). + +t_arity(Config) when is_list(Config) -> + ?line 0 = fun_arity(fun() -> ok end), + ?line 0 = fun_arity(fun() -> Config end), + ?line 1 = fun_arity(fun(X) -> X+1 end), + ?line 1 = fun_arity(fun(X) -> Config =:= X end), + A = id(42), + + %% Test that the arity is transferred properly. + ?line process_flag(trap_exit, true), + ?line {ok,Node} = start_node(fun_test_arity), + ?line hello_world = spawn_call(Node, fun() -> hello_world end), + ?line 0 = spawn_call(Node, fun(X) -> X end), + ?line 42 = spawn_call(Node, fun(_X) -> A end), + ?line 43 = spawn_call(Node, fun(X, Y) -> A+X+Y end), + ?line 1 = spawn_call(Node, fun(X, Y) -> X+Y end), + ?line 45 = spawn_call(Node, fun(X, Y, Z) -> A+X+Y+Z end), + ok. + +t_is_function2(Config) when is_list(Config) -> + ?line true = is_function({a,b}, 0), + ?line true = is_function({a,b}, 234343434333433433), + ?line true = is_function(fun() -> ok end, 0), + ?line true = is_function(fun(_) -> ok end, 1), + ?line false = is_function(fun(_) -> ok end, 0), + + ?line true = is_function(fun erlang:abs/1, 1), + ?line true = is_function(fun erlang:abs/99, 99), + ?line false = is_function(fun erlang:abs/1, 0), + ?line false = is_function(fun erlang:abs/99, 0), + + ?line false = is_function(id(self()), 0), + ?line false = is_function(id({a,b,c}), 0), + ?line false = is_function(id({a}), 0), + ?line false = is_function(id([a,b,c]), 0), + + %% Bad arity argument. + ?line bad_arity(a), + ?line bad_arity(-1), + ?line bad_arity(-9738974938734938793873498378), + ?line bad_arity([]), + ?line bad_arity(fun() -> ok end), + ?line bad_arity({}), + ?line bad_arity({a,b}), + ?line bad_arity(self()), + ok. + +bad_arity(A) -> + {'EXIT',_} = (catch is_function(fun() -> ok end, A)), + {'EXIT',_} = (catch is_function(no_fun, A)), + ok. + +t_fun_info(Config) when is_list(Config) -> + ?line F = fun t_fun_info/1, + ?line try F(blurf) of + FAny -> + io:format("should fail; returned ~p\n", [FAny]), + ?line ?t:fail() + catch + error:function_clause -> ok + end, + ?line {module,?MODULE} = erlang:fun_info(F, module), + ?line case erlang:fun_info(F, name) of + undefined -> + ?line ?t:fail(); + _ -> ok + end, + ?line {arity,1} = erlang:fun_info(F, arity), + ?line {env,[]} = erlang:fun_info(F, env), + ?line verify_not_undef(F, index), + ?line verify_not_undef(F, uniq), + ?line verify_not_undef(F, new_index), + ?line verify_not_undef(F, new_uniq), + ?line verify_not_undef(F, refc), + ?line {'EXIT',_} = (catch erlang:fun_info(F, blurf)), + + %% Module fun. + ?line FF = fun ?MODULE:t_fun_info/1, + ?line try FF(blurf) of + FFAny -> + io:format("should fail; returned ~p\n", [FFAny]), + ?line ?t:fail() + catch + error:function_clause -> ok + end, + + ?line {module,?MODULE} = erlang:fun_info(FF, module), + ?line {name,t_fun_info} = erlang:fun_info(FF, name), + ?line {arity,1} = erlang:fun_info(FF, arity), + ?line {env,[]} = erlang:fun_info(FF, env), + ?line verify_undef(FF, index), + ?line verify_undef(FF, uniq), + ?line verify_undef(FF, new_index), + ?line verify_undef(FF, new_uniq), + ?line verify_undef(FF, refc), + ?line {'EXIT',_} = (catch erlang:fun_info(FF, blurf)), + + %% Not fun. + ?line bad_info(abc), + ?line bad_info(42), + ?line bad_info({fun erlang:list_to_integer/1}), + ?line bad_info([42]), + ?line bad_info([]), + ?line bad_info(self()), + ?line bad_info(<<>>), + ?line bad_info(<<1,2>>), + ok. + +bad_info(Term) -> + try erlang:fun_info(Term, module) of + Any -> + io:format("should fail; returned ~p\n", [Any]), + ?t:fail() + catch + error:badarg -> ok + end. + +verify_undef(Fun, Tag) -> + {Tag,undefined} = erlang:fun_info(Fun, Tag). + +verify_not_undef(Fun, Tag) -> + case erlang:fun_info(Fun, Tag) of + {Tag,undefined} -> + ?t:fail(); + {Tag,_} -> ok + end. + +id(X) -> + X. + +spawn_call(Node, AFun) -> + Pid = spawn_link(Node, + fun() -> + receive + {Fun,Fun,Fun} when is_function(Fun) -> + Arity = fun_arity(Fun), + Args = case Arity of + 0 -> []; + _ -> lists:seq(0, Arity-1) + end, + Res = apply(Fun, Args), + {pid,Creator} = erlang:fun_info(Fun, pid), + Creator ! {result,Res} + end + end), + Pid ! {AFun,AFun,AFun}, + Res = receive + {result,R} -> R; + Other -> ?t:fail({bad_message,Other}) + after 10000 -> + ?t:fail(timeout_waiting_for_result) + end, + receive + {'EXIT',Pid,normal} -> ok; + Other2 -> ?t:fail({bad_message_waiting_for_exit,Other2}) + after 10000 -> + ?t:fail(timeout_waiting_for_exit) + end, + Res. + +fun_arity(F) -> + {arity,Arity} = erlang:fun_info(F, arity), + Arity. + +start_node(Name) -> + Pa = filename:dirname(code:which(?MODULE)), + Cookie = atom_to_list(erlang:get_cookie()), + test_server:start_node(Name, slave, + [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). + +wait_until(Fun) -> + case catch Fun() of + true -> ok; + _ -> receive after 100 -> wait_until(Fun) end + end. + +% stop_node(Node) -> +% test_server:stop_node(Node). diff --git a/erts/emulator/test/fun_r11_SUITE.erl b/erts/emulator/test/fun_r11_SUITE.erl new file mode 100644 index 0000000000..61ba816cc8 --- /dev/null +++ b/erts/emulator/test/fun_r11_SUITE.erl @@ -0,0 +1,76 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(fun_r11_SUITE). +-compile(r11). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2,dist_old_release/1]). + +-define(default_timeout, ?t:minutes(1)). +-include("test_server.hrl"). + +all(suite) -> [dist_old_release]. + +init_per_testcase(_Case, Config) -> + ?line Dog = test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +dist_old_release(Config) when is_list(Config) -> + case ?t:is_release_available("r11b") of + true -> do_dist_old(Config); + false -> {skip,"No R11B found"} + end. + +do_dist_old(Config) when is_list(Config) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + Name = fun_dist_r11, + ?line {ok,Node} = ?t:start_node(Name, peer, + [{args,"-pa "++Pa}, + {erl,[{release,"r11b"}]}]), + + ?line Pid = spawn_link(Node, + fun() -> + receive + Fun when is_function(Fun) -> + R11BFun = fun(H) -> cons(H, [b,c]) end, + Fun(Fun, R11BFun) + end + end), + Self = self(), + Fun = fun(F, R11BFun) -> + {pid,Self} = erlang:fun_info(F, pid), + {module,?MODULE} = erlang:fun_info(F, module), + Self ! {ok,F,R11BFun} + end, + ?line Pid ! Fun, + ?line receive + {ok,Fun,R11BFun} -> + ?line [a,b,c] = R11BFun(a); + Other -> + ?line ?t:fail({bad_message,Other}) + end, + ok. + +cons(H, T) -> + [H|T]. diff --git a/erts/emulator/test/gc_SUITE.erl b/erts/emulator/test/gc_SUITE.erl new file mode 100644 index 0000000000..066aa215b2 --- /dev/null +++ b/erts/emulator/test/gc_SUITE.erl @@ -0,0 +1,181 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% Test the garbage collector (or Memory Recycler) + +-module(gc_SUITE). + +-include("test_server.hrl"). +-export([all/1]). + +-define(default_timeout, ?t:minutes(10)). + +-export([grow_heap/1, grow_stack/1, grow_stack_heap/1]). + +all(suite) -> + [grow_heap,grow_stack, grow_stack_heap]. + +grow_heap(doc) -> ["Produce a growing list of elements, ", + "for X calls, then drop one item per call", + "until the list is empty."]; +grow_heap(Config) when is_list(Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(40)), + ?line ok=grow_heap1(256), + case os:type() of + vxworks -> + stop_here; + _ -> + ?line ok=grow_heap1(512), + ?line ok=grow_heap1(1024), + ?line ok=grow_heap1(2048) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +grow_heap1(Len) -> + io:format("~ngrow_heap with ~p items.",[Len]), + show_heap("before:"), + grow_heap1([], Len, 0, up), + show_heap("after:"). + +grow_heap1(List, MaxLen, MaxLen, up) -> + show_heap("top:"), + grow_heap1(List, MaxLen, MaxLen-1, down); +grow_heap1(List, MaxLen, CurLen, up) -> + NewList=[make_arbit()|List], + grow_heap1(NewList, MaxLen, CurLen+1, up); +grow_heap1([], _MaxLen, _, down) -> + ok; +grow_heap1([_|List], MaxLen, CurLen, down) -> + ?line {_,_,C}=erlang:now(), + ?line Num=C rem (length(List))+1, + ?line Elem=lists:nth(Num, List), + ?line NewList=lists:delete(Elem, List), + grow_heap1(NewList, MaxLen, CurLen-1, down). + + + +grow_stack(doc) -> ["Increase and decrease stack size, and ", + "drop off some garbage from time to time."]; +grow_stack(Config) when is_list(Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(80)), + show_heap("before:"), + case os:type() of + vxworks -> + ?line grow_stack1(25, 0); + _ -> + ?line grow_stack1(200, 0) + end, + show_heap("after:"), + ?line test_server:timetrap_cancel(Dog), + ok. + +grow_stack1(0, _) -> + ok; +grow_stack1(Recs, 0) -> +% show_heap("running:"), + grow_stack1(Recs-1, Recs), + grow_stack1(0,0); +grow_stack1(Recs, CurRecs) -> + grow_stack1(Recs, CurRecs-1), + make_arbit(), + grow_stack1(1,0), + ok. + + +%% Let's see how BEAM handles this one... +grow_stack_heap(doc) -> ["While growing the heap, bounces the size ", + "of the stack, and while reducing the heap", + "bounces the stack usage."]; +grow_stack_heap(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "Takes too long to run on VxWorks/cpu32"}; + _ -> + ?line Dog=test_server:timetrap(test_server:minutes(40)), + ?line grow_stack_heap1(16), + ?line grow_stack_heap1(32), + ?line test_server:timetrap_cancel(Dog), + ok + end. + +grow_stack_heap1(MaxLen) -> + io:format("~ngrow_stack_heap with ~p items.",[MaxLen]), + show_heap("before:"), + grow_stack_heap1([], MaxLen, 0, up), + show_heap("after:"). + +grow_stack_heap1(List, MaxLen, MaxLen, up) -> + show_heap("top:"), + grow_stack_heap1(List, MaxLen, MaxLen-1, down); +grow_stack_heap1(List, MaxLen, CurLen, up) -> + grow_stack1(CurLen*2,0), + grow_stack_heap1([make_arbit()|List], MaxLen, CurLen+1, up), + ok; + +grow_stack_heap1([], _MaxLen, _, down) -> ok; +grow_stack_heap1([_|List], MaxLen, CurLen, down) -> + grow_stack1(CurLen*2,0), + ?line {_,_,C}=erlang:now(), + ?line Num=C rem (length(List))+1, + ?line Elem=lists:nth(Num, List), + ?line NewList=lists:delete(Elem, List), + grow_stack_heap1(NewList, MaxLen, CurLen-1, down), + ok. + + +%% Create an arbitrary element/term. +make_arbit() -> + {AA,BB,CC}=erlang:now(), + A=AA+1, B=BB+1, C=CC+1, + New = + case C rem 9 of + 0 -> make_string((B div C) +5); + 1 -> C; + 2 -> make_ref(); + 3 -> self(); + 4 -> list_to_binary(make_string((C div B) + 12)); + 5 -> (C*B)/(A+1); + 6 -> list_to_tuple(make_string((B div C) +5)); + 7 -> list_to_atom(make_string(((C div B) rem 254) + 2)); + 8 -> fun(X) -> {X,AA,make_string((B div C)+10)} end + end, + New. + +%% Create an arbitrary string of a certain length. +make_string(Length) -> + Alph="abcdefghjiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"++ + "0123456789", + make_string(Alph, Length, []). + +make_string(_, 0, Acc) -> + Acc; +make_string(Alph, Length, Acc) -> + {_,_,C}=erlang:now(), + Pos=1+(Length*C rem length(Alph)), + make_string(Alph, Length-1, + [lists:nth(Pos,Alph)|Acc]). + +show_heap(String) -> + garbage_collect(self()), + receive after 1 -> ok end, + {heap_size, HSize}=process_info(self(), heap_size), + {stack_size, SSize}=process_info(self(), stack_size), + io:format("Heap/Stack "++String++"~p/~p", [HSize, SSize]). + diff --git a/erts/emulator/test/guard_SUITE.erl b/erts/emulator/test/guard_SUITE.erl new file mode 100644 index 0000000000..23482a20d7 --- /dev/null +++ b/erts/emulator/test/guard_SUITE.erl @@ -0,0 +1,390 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(guard_SUITE). + +-export([all/1, bad_arith/1, bad_tuple/1, test_heap_guards/1, guard_bifs/1, + type_tests/1]). + +-include("test_server.hrl"). + +-export([init/3]). +-import(lists, [member/2]). + +all(suite) -> [bad_arith, bad_tuple, test_heap_guards, guard_bifs, type_tests]. + +bad_arith(doc) -> "Test that a bad arithmetic operation in a guard works correctly."; +bad_arith(Config) when is_list(Config) -> + ?line 5 = bad_arith1(2, 3), + ?line 10 = bad_arith1(1, infinity), + ?line 10 = bad_arith1(infinity, 1), + ok. + +bad_arith1(T1, T2) when T1+T2 < 10 -> + T1+T2; +bad_arith1(_, _) -> + 10. + +bad_tuple(doc) -> "Test that bad arguments to element/2 are handled correctly."; +bad_tuple(Config) when is_list(Config) -> + ?line error = bad_tuple1(a), + ?line error = bad_tuple1({a, b}), + ?line x = bad_tuple1({x, b}), + ?line y = bad_tuple1({a, b, y}), + ok. + +bad_tuple1(T) when element(1, T) == x -> + x; +bad_tuple1(T) when element(3, T) == y -> + y; +bad_tuple1(_) -> + error. + +test_heap_guards(doc) -> ""; +test_heap_guards(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(2)), + + ?line process_flag(trap_exit, true), + ?line Tuple = {a, tuple, is, built, here, xxx}, + ?line List = [a, list, is, built, here], + + ?line 'try'(fun a_case/1, [Tuple], [Tuple]), + ?line 'try'(fun a_case/1, [List], [List, List]), + ?line 'try'(fun a_case/1, [a], [a]), + + ?line 'try'(fun an_if/1, [Tuple], [Tuple]), + ?line 'try'(fun an_if/1, [List], [List, List]), + ?line 'try'(fun an_if/1, [a], [a]), + + ?line 'try'(fun receive_test/1, [Tuple], [Tuple]), + ?line 'try'(fun receive_test/1, [List], [List, List]), + ?line 'try'(fun receive_test/1, [a], [a]), + ?line test_server:timetrap_cancel(Dog). + +a_case(V) -> + case V of + T when T == {a, tuple, is, built, here, xxx} -> + [T]; + L when L == [a, list, is, built, here] -> + [L, L]; + a -> + [a] + end. + +an_if(V) -> + if + V == {a, tuple, is, built, here, xxx} -> + [V]; + V == [a, list, is, built, here] -> + [V, V]; + V == a -> + [a] + end. + +receive_test(V) -> + self() ! V, + a_receive(). + +a_receive() -> + receive + T when T == {a, tuple, is, built, here, xxx} -> + [T]; + L when L == [a, list, is, built, here] -> + [L, L]; + a -> + [a] + end. + +'try'(Fun, Args, Result) -> + 'try'(512, Fun, Args, Result, []). + +'try'(0, _, _, _, _) -> + ok; +'try'(Iter, Fun, Args, Result, Filler) -> + Pid = spawn_link(?MODULE, init, [Fun,Args,list_to_tuple(Filler)]), + receive + {'EXIT', Pid, {result, Result}} -> + ?line 'try'(Iter-1, Fun, Args, Result, [0|Filler]); + {result, Other} -> + ?line io:format("Expected ~p; got ~p~n", [Result, Other]), + ?line test_server:fail(); + Other -> + ?line test_server:fail({unexpected_message, Other}) + end. + +init(Fun, Args, Filler) -> + Result = {result,apply(Fun, Args)}, + dummy(Filler), + exit(Result). + +dummy(_) -> + ok. + +guard_bifs(doc) -> "Test all guard bifs with nasty (but legal arguments)."; +guard_bifs(Config) when is_list(Config) -> + ?line Big = -237849247829874297658726487367328971246284736473821617265433, + ?line Float = 387924.874, + + %% Succeding use of guard bifs. + + ?line try_gbif('abs/1', Big, -Big), + ?line try_gbif('float/1', Big, float(Big)), + ?line try_gbif('float/1', Big, float(id(Big))), + ?line try_gbif('trunc/1', Float, 387924.0), + ?line try_gbif('round/1', Float, 387925.0), + ?line try_gbif('length/1', [], 0), + + ?line try_gbif('length/1', [a], 1), + ?line try_gbif('length/1', [a, b], 2), + ?line try_gbif('length/1', lists:seq(0, 31), 32), + + ?line try_gbif('hd/1', [a], a), + ?line try_gbif('hd/1', [a, b], a), + + ?line try_gbif('tl/1', [a], []), + ?line try_gbif('tl/1', [a, b], [b]), + ?line try_gbif('tl/1', [a, b, c], [b, c]), + + ?line try_gbif('size/1', {}, 0), + ?line try_gbif('size/1', {a}, 1), + ?line try_gbif('size/1', {a, b}, 2), + ?line try_gbif('size/1', {a, b, c}, 3), + ?line try_gbif('size/1', list_to_binary([]), 0), + ?line try_gbif('size/1', list_to_binary([1]), 1), + ?line try_gbif('size/1', list_to_binary([1, 2]), 2), + ?line try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + + ?line try_gbif('bit_size/1', <<0:7>>, 7), + + ?line try_gbif('element/2', {x}, {1, x}), + ?line try_gbif('element/2', {x, y}, {1, x}), + ?line try_gbif('element/2', {x, y}, {2, y}), + + ?line try_gbif('self/0', 0, self()), + ?line try_gbif('node/0', 0, node()), + ?line try_gbif('node/1', self(), node()), + + %% Failing use of guard bifs. + + ?line try_fail_gbif('abs/1', Big, 1), + ?line try_fail_gbif('abs/1', [], 1), + + ?line try_fail_gbif('float/1', Big, 42), + ?line try_fail_gbif('float/1', [], 42), + + ?line try_fail_gbif('trunc/1', Float, 0.0), + ?line try_fail_gbif('trunc/1', [], 0.0), + + ?line try_fail_gbif('round/1', Float, 1.0), + ?line try_fail_gbif('round/1', [], a), + + ?line try_fail_gbif('length/1', [], 1), + ?line try_fail_gbif('length/1', [a], 0), + ?line try_fail_gbif('length/1', a, 0), + ?line try_fail_gbif('length/1', {a}, 0), + + ?line try_fail_gbif('hd/1', [], 0), + ?line try_fail_gbif('hd/1', [a], x), + ?line try_fail_gbif('hd/1', x, x), + + ?line try_fail_gbif('tl/1', [], 0), + ?line try_fail_gbif('tl/1', [a], x), + ?line try_fail_gbif('tl/1', x, x), + + ?line try_fail_gbif('size/1', {}, 1), + ?line try_fail_gbif('size/1', [], 0), + ?line try_fail_gbif('size/1', [a], 1), + ?line try_fail_gbif('size/1', fun() -> 1 end, 0), + ?line try_fail_gbif('size/1', fun() -> 1 end, 1), + + ?line try_fail_gbif('element/2', {}, {1, x}), + ?line try_fail_gbif('element/2', {x}, {1, y}), + ?line try_fail_gbif('element/2', [], {1, z}), + + ?line try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + ?line try_fail_gbif('node/0', 0, xxxx), + ?line try_fail_gbif('node/1', self(), xxx), + ?line try_fail_gbif('node/1', yyy, xxx), + ok. + +try_gbif(Id, X, Y) -> + case guard_bif(Id, X, Y) of + {Id, X, Y} -> + io:format("guard_bif(~p, ~p, ~p) -- ok", [Id, X, Y]); + Other -> + ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + ?line test_server:fail() + end. + +try_fail_gbif(Id, X, Y) -> + case catch guard_bif(Id, X, Y) of + {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> + io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); + Other -> + ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + ?line test_server:fail() + end. + +guard_bif('abs/1', X, Y) when abs(X) == Y -> + {'abs/1', X, Y}; +guard_bif('float/1', X, Y) when float(X) == Y -> + {'float/1', X, Y}; +guard_bif('trunc/1', X, Y) when trunc(X) == Y -> + {'trunc/1', X, Y}; +guard_bif('round/1', X, Y) when round(X) == Y -> + {'round/1', X, Y}; +guard_bif('length/1', X, Y) when length(X) == Y -> + {'length/1', X, Y}; +guard_bif('hd/1', X, Y) when hd(X) == Y -> + {'hd/1', X, Y}; +guard_bif('tl/1', X, Y) when tl(X) == Y -> + {'tl/1', X, Y}; +guard_bif('size/1', X, Y) when size(X) == Y -> + {'size/1', X, Y}; +guard_bif('bit_size/1', X, Y) when bit_size(X) == Y -> + {'bit_size/1', X, Y}; +guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected -> + {'element/2', X, {Pos, Expected}}; +guard_bif('self/0', X, Y) when self() == Y -> + {'self/0', X, Y}; +guard_bif('node/0', X, Y) when node() == Y -> + {'node/0', X, Y}; +guard_bif('node/1', X, Y) when node(X) == Y -> + {'node/1', X, Y}. + +type_tests(doc) -> "Test the type tests."; +type_tests(Config) when is_list(Config) -> + ?line Types = all_types(), + ?line Tests = type_test_desc(), + ?line put(errors, 0), + ?line put(violations, 0), + ?line type_tests(Tests, Types), + ?line case {get(errors), get(violations)} of + {0, 0} -> + ok; + {0, N} -> + {comment, integer_to_list(N) ++ " standard violation(s)"}; + {Errors, Violations} -> + io:format("~p sub test(s) failed, ~p violation(s)", + [Errors, Violations]), + ?line test_server:fail() + end. + +type_tests([{Test, AllowedTypes}| T], AllTypes) -> + type_tests(Test, AllTypes, AllowedTypes), + type_tests(T, AllTypes); +type_tests([], _) -> + ok. + +type_tests(Test, [Type|T], Allowed) -> + {TypeTag, Value} = Type, + case member(TypeTag, Allowed) of + true -> + case catch type_test(Test, Value) of + Test -> + ok; + _Other -> + io:format("Test ~p(~p) failed", [Test, Value]), + put(errors, get(errors) + 1) + end; + false -> + case catch type_test(Test, Value) of + {'EXIT', {function_clause, {?MODULE,type_test,[Test,Value]}}} -> + ok; + {'EXIT', {function_clause,[{?MODULE,type_test,[Test,Value]}|_]}} -> + ok; + {'EXIT',Other} -> + ?line test_server:fail({unexpected_error_reason,Other}); + tuple when is_function(Value) -> + io:format("Standard violation: Test ~p(~p) should fail", + [Test, Value]), + put(violations, get(violations) + 1); + _Other -> + io:format("Test ~p(~p) succeeded (should fail)", [Test, Value]), + put(errors, get(errors) + 1) + end + end, + type_tests(Test, T, Allowed); +type_tests(_, [], _) -> + ok. + +all_types() -> + [{small, 42}, + {big, 392742928742947293873938792874019287447829874290742}, + {float, 3.14156}, + {nil, []}, + {cons, [a]}, + {tuple, {a, b}}, + {atom, xxxx}, + {ref, make_ref()}, + {pid, self()}, + {port, open_port({spawn, efile}, [])}, + {function, fun(_) -> "" end}, + {function, fun erlang:abs/1}, + {binary, list_to_binary([])}, + {bitstring, <<0:7>>}]. + +type_test_desc() -> + [{binary, [binary]}, + {bitstring, [binary, bitstring]}, + {integer, [small, big]}, + {float, [float]}, + {number, [small, big, float]}, + {atom, [atom]}, + {list, [cons, nil]}, + {nonempty_list, [cons]}, + {nil, [nil]}, + {tuple, [tuple]}, + {pid, [pid]}, + {port, [port]}, + {reference, [ref]}, + {function, [function]}]. + +type_test(integer, X) when is_integer(X) -> + integer; +type_test(float, X) when is_float(X) -> + float; +type_test(number, X) when is_number(X) -> + number; +type_test(atom, X) when is_atom(X) -> + atom; +type_test(list, X) when is_list(X) -> + list; +type_test(nonempty_list, [_]) -> + nonempty_list; +type_test(nil, []) -> + nil; +type_test(tuple, X) when is_tuple(X) -> + tuple; +type_test(pid, X) when is_pid(X) -> + pid; +type_test(reference, X) when is_reference(X) -> + reference; +type_test(port, X) when is_port(X) -> + port; +type_test(binary, X) when is_binary(X) -> + binary; +type_test(bitstring, X) when is_bitstring(X) -> + bitstring; +type_test(function, X) when is_function(X) -> + function. + +id(I) -> I. diff --git a/erts/emulator/test/hash_SUITE.erl b/erts/emulator/test/hash_SUITE.erl new file mode 100644 index 0000000000..85bdb8bff8 --- /dev/null +++ b/erts/emulator/test/hash_SUITE.erl @@ -0,0 +1,717 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Verifying erlang:phash/2. And now also phash2/2, to some extent. +%% Test the hashing algorithm for integer numbers in 2 ways: +%% 1 Test that numbers in diferent sequences get sufficiently spread +%% in a "bit pattern" way (modulo 256 etc). +%% 2 Test that numbers are correctly hashed compared to a reference implementation, +%% regardless of their internal representation. The hashing algorithm should never +%% change. +%% The hashing of other datatypes is tested with a few samples, so that we are sure +%% it does not change across versions. +%% Also tests that the limit can be between 0 and 16#FFFFFFFF. +%% +-module(hash_SUITE). +-export([basic_test/0,cmp_test/1,range_test/0,spread_test/1, + phash2_test/0, otp_5292_test/0, bit_level_binaries/0, + otp_7127_test/0]). +-compile({nowarn_deprecated_function, {erlang,hash,2}}). + +%% +%% Define to run outside of test server +%% +%-define(STANDALONE,1). + +%% +%% Define for debug output +%% +%-define(debug,1). + +-ifdef(STANDALONE). +-define(config(A,B),config(A,B)). +-export([config/2]). +-else. +-include("test_server.hrl"). +-endif. + +-ifdef(debug). +-ifdef(STANDALONE). +-define(line, erlang:display({?MODULE,?LINE}), ). +-endif. +-define(dbgformat(A,B),io:format(A,B)). +-else. +-ifdef(STANDALONE). +-define(line, noop, ). +-endif. +-define(dbgformat(A,B),noop). +-endif. + +-ifdef(STANDALONE). +config(priv_dir,_) -> + ".". +-else. +%% When run in test server. +-export([all/1,test_basic/1,test_cmp/1,test_range/1,test_spread/1, + test_phash2/1,otp_5292/1,bit_level_binaries/1,otp_7127/1, + fin_per_testcase/2,init_per_testcase/2]). +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(10)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. +all(doc) -> + ["Test erlang:phash"]; +all(suite) -> + [test_basic, test_cmp, test_range, test_spread, test_phash2, otp_5292, + bit_level_binaries, otp_7127]. + +test_basic(suite) -> + []; +test_basic(doc) -> + ["Tests basic functionality of erlang:phash and that the " + "hashes has not changed (neither hash nor phash)"]; +test_basic(Config) when is_list(Config) -> + basic_test(). + + +test_cmp(suite) -> + []; +test_cmp(doc) -> + ["Compares integer hashes made by erlang:phash with those of a reference " + "implementation"]; +test_cmp(Config) when is_list(Config) -> + cmp_test(10000). + +test_range(suite) -> + []; +test_range(doc) -> + ["Tests ranges on erlang:phash from 1 to 2^32"]; +test_range(Config) when is_list(Config) -> + range_test(). + +test_spread(suite) -> + []; +test_spread(doc) -> + ["Tests that the hashes are spread ok"]; +test_spread(Config) when is_list(Config) -> + spread_test(10). + +test_phash2(suite) -> + []; +test_phash2(doc) -> + ["Tests phash2"]; +test_phash2(Config) when is_list(Config) -> + phash2_test(). + +otp_5292(suite) -> + []; +otp_5292(doc) -> + ["Tests hash, phash and phash2 regarding integers."]; +otp_5292(Config) when is_list(Config) -> + otp_5292_test(). + +%% Test hashing bit-level binaries. +bit_level_binaries(Config) when is_list(Config) -> + bit_level_binaries(). + +otp_7127(suite) -> + []; +otp_7127(doc) -> + ["Tests phash2/1."]; +otp_7127(Config) when is_list(Config) -> + otp_7127_test(). + +-endif. + + + +%% +%% Here are the real tests, they can be run without test_server, +%% define -DSTANDALONE when compiling. +%% +basic_test() -> + ?line 685556714 = erlang:phash({a,b,c},16#FFFFFFFF), + ?line 14468079 = erlang:hash({a,b,c},16#7FFFFFF), + ?line 37442646 = erlang:phash([a,b,c,{1,2,3},c:pid(0,2,3), + 16#77777777777777],16#FFFFFFFF), + ?line Comment = case erlang:hash([a,b,c,{1,2,3},c:pid(0,2,3), + 16#77777777777777],16#7FFFFFF) of + 102727602 -> + ?line big = erlang:system_info(endian), + "Big endian machine"; + 105818829 -> + ?line little = erlang:system_info(endian), + "Little endian machine" + end, + ExternalReference = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64, + 110,111,104,111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0>>, + ?line 1113403635 = erlang:phash(binary_to_term(ExternalReference), + 16#FFFFFFFF), + ?line 123 = erlang:hash(binary_to_term(ExternalReference), + 16#7FFFFFF), + ExternalFun = <<131,117,0,0,0,3,103,100,0,13,110,111,110,111,100,101,64, + 110,111,104,111,115,116,0,0,0,38,0,0,0,0,0,100,0,8,101, + 114,108,95,101,118,97,108,97,20,98,5,182,139,98,108,0,0, + 0,3,104,2,100,0,1,66,109,0,0,0,33,131,114,0,3,100,0,13, + 110,111,110,111,100,101,64,110,111,104,111,115,116,0,0, + 0,0,122,0,0,0,0,0,0,0,0,104,2,100,0,1,76,107,0,33,131, + 114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, + 111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0,104,2,100,0,1,82, + 114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, + 111,115,116,0,0,0,0,122,0,0,0,0,0,0,0,0,106,108,0,0,0,1, + 104,5,100,0,6,99,108,97,117,115,101,97,1,106,106,108,0,0, + 0,1,104,3,100,0,7,105,110,116,101,103,101,114,97,1,97,1, + 106,106,104,3,100,0,4,101,118,97,108,104,2,100,0,5,115, + 104,101,108,108,100,0,10,108,111,99,97,108,95,102,117, + 110,99,108,0,0,0,1,103,100,0,13,110,111,110,111,100,101, + 64,110,111,104,111,115,116,0,0,0,22,0,0,0,0,0,106>>, + ?line 170987488 = erlang:phash(binary_to_term(ExternalFun), + 16#FFFFFFFF), + ?line 124460689 = erlang:hash(binary_to_term(ExternalFun), + 16#7FFFFFF), + case (catch erlang:phash(1,0)) of + {'EXIT',{badarg, _}} -> + {comment, Comment}; + _ -> + exit(phash_accepted_zero_as_range) + end. + + +range_test() -> + random:seed(), + F = fun(From,From,_FF) -> + ok; + (From,To,FF) -> + R = random:uniform(16#FFFFFFFFFFFFFFFF), + X = erlang:phash(R, From), + Y = erlang:phash(R, 16#100000000) - 1, + Z = (Y rem From) + 1, + case X =:= Z of + true -> + FF(From*2,To,FF); + _ -> + exit({range_test_failed, hash_on, R, range, From}) + end + end, + F(1,16#100000000,F). + + + +spread_test(N) -> + ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + X + end), + ?line test_fun(N,{erlang,phash},0,fun(X) -> + X + end), + ?line test_fun(N,{erlang,phash},16#123456789ABCDEF123456789ABCDEF,fun(X) -> + X + end), + ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + integer_to_list(X) + end), + ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + integer_to_bytelist(X,[]) + end), + ?line test_fun(N,{erlang,phash},16#50000000000,fun(X) -> + integer_to_binary(X) + end). + + + +cmp_test(N) -> + % No need to save seed, the error indicates what number caused it. + random:seed(), + do_cmp_hashes(N,8). +do_cmp_hashes(0,_) -> + ok; +do_cmp_hashes(N,Steps) -> + ?line R0 = random:uniform(1 bsl Steps - 1) + random:uniform(16#FFFFFFFF), + ?line R = case random:uniform(2) of + 1 -> + R0; + _ -> + -R0 + end, + ?line NSteps = case N rem 10 of + 0 -> + case (Steps + 8) rem 1024 of + 0 -> + 8; + OK -> + OK + end; + _ -> + Steps + end, + ?line X = erlang:phash(R,16#FFFFFFFF), + ?line Y = make_hash(R,16#FFFFFFFF), + ?line case X =:= Y of + true -> + do_cmp_hashes(N - 1, NSteps); + _ -> + exit({missmatch_on_input, R, phash, X, make_hash, Y}) + end. + +phash2_test() -> + Max = 1 bsl 32, + BPort = <<131,102,100,0,13,110,111,110,111,100,101,64,110,111,104, + 111,115,116,0,0,0,1,0>>, + Port = binary_to_term(BPort), + + BXPort = <<131,102,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 0,0,0,24,3>>, + XPort = binary_to_term(BXPort), + + BRef = <<131,114,0,3,100,0,13,110,111,110,111,100,101,64,110,111,104, + 111,115,116,0,0,0,1,255,0,0,0,0,0,0,0,0>>, + Ref = binary_to_term(BRef), + + BXRef = <<131,114,0,3,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 2,0,0,0,155,0,0,0,0,0,0,0,0>>, + XRef = binary_to_term(BXRef), + + BXPid = <<131,103,100,0,11,97,112,97,64,108,101,103,111,108,97,115, + 0,0,0,36,0,0,0,0,1>>, + XPid = binary_to_term(BXPid), + + + %% X = f1(), Y = f2(), Z = f3(X, Y), + + %% F1 = fun f1/0, % -> abc + B1 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,1,0,0,0,0,100,0,1,116,97,1,98,2,195,126, + 58,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F1 = binary_to_term(B1), + + %% F2 = fun f2/0, % -> abd + B2 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,2,0,0,0,0,100,0,1,116,97,2,98,3,130,152, + 185,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F2 = binary_to_term(B2), + + %% F3 = fun f3/2, % -> {abc, abd} + B3 = <<131,112,0,0,0,66,2,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,3,0,0,0,0,100,0,1,116,97,3,98,7,168,160, + 93,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F3 = binary_to_term(B3), + + %% F4 = fun () -> 123456789012345678901234567 end, + B4 = <<131,112,0,0,0,66,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,4,0,0,0,0,100,0,1,116,97,4,98,2,230,21, + 171,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0>>, + F4 = binary_to_term(B4), + + %% F5 = fun() -> {X,Y,Z} end, + B5 = <<131,112,0,0,0,92,0,215,206,77,69,249,50,170,17,129,47,21,98, + 13,196,76,242,0,0,0,5,0,0,0,3,100,0,1,116,97,5,98,0,99,101, + 130,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111, + 115,116,0,0,0,112,0,0,0,0,0,100,0,3,97,98,99,100,0,3,97,98, + 100,104,2,100,0,3,97,98,99,100,0,3,97,98,100>>, + F5 = binary_to_term(B5), + + Chars = lists:seq(32,127), + NotAHeapBin = list_to_binary(lists:flatten(lists:duplicate(500,Chars))), + <<_:128,SubBin/binary>> = NotAHeapBin, + L = [%% nil + {[], 3468870702}, + + %% atom :( not very good ): + %% (cannot use block_hash due to compatibility issues...) + {abc,26499}, + {abd,26500}, + + %% small + {0,3175731469}, + {1, 539485162}, + {-1, 1117813597}, + {1 bsl 20, 1477815345}, + {-(1 bsl 20), 3076904293}, + + %% bignum + {4294967296, 2108323275}, + {-4294967296, 2586067094}, + {981494972710656, 1622082818}, + {-981494972710656, 3367191372}, + {36893488147419103232, 2545846594}, + {-36893488147419103232, 1649047068}, + {1606938044258990275541962092341162602522202993782792835301376, + 2573322433}, + {-1606938044258990275541962092341162602522202993782792835301376, + 2288753377}, + + %% binary + {<<>>, 147926629}, + {<<0:8>>, 2914887855}, + {<<0:32>>, 2014511533}, + {<<"abc">>, 1306188027}, + {<<"12345678901234567890">>, 3021061640}, + {NotAHeapBin,2644086993}, + {SubBin,3575839236}, + + %% unaligned sub binaries + {unaligned_sub_bin(<<>>), 147926629}, + {unaligned_sub_bin(<<0:8>>), 2914887855}, + {unaligned_sub_bin(<<0:32>>), 2014511533}, + {unaligned_sub_bin(<<"abc">>), 1306188027}, + {unaligned_sub_bin(<<"12345678901234567890">>), 3021061640}, + {unaligned_sub_bin(NotAHeapBin),2644086993}, + {unaligned_sub_bin(SubBin),3575839236}, + + %% bit-level binaries + {<<0:7>>, 1055790816}, + {<<"abc",13:4>>, 670412287}, + {<<5:3,"12345678901234567890">>, 289973273}, + + %% fun + {F1, 3826013332}, + {F2, 126009152}, + {F3, 3482452479}, + {F4, 633704783}, + {F5, 1241537408}, + + %% module fun + {fun lists:map/2, 840287883}, + {fun lists:map/3, 2318478565}, + {fun lists:filter/2, 635165125}, + {fun lists:filter/3, 3824649396}, + {fun xxx:map/2, 2630071865}, + {fun xxx:map/3, 4237970519}, + + %% pid + {c:pid(0,0,0), 2858162279}, + {c:pid(0,1,0), 2870503209}, + {c:pid(0,2,0), 1707788908}, + {XPid, 1290188489}, + + %% port + {Port,1954394636}, + {XPort,274735}, + + %% ref + {Ref, 1675501484}, + {XRef, 3845846926}, + + %% float + {0.0, 423528920}, + {3.14, 3731709215}, + {-3.14, 1827518724}, + + %% list + {[0.0], 167906877}, + {[{}], 4050867804}, + {[<<>>], 440873397}, + {[[]], 499070068}, + {[abc], 3112446404}, + {[a,b,c], 1505666924}, + {[a,b|c], 433753489}, + {"abc", 519996486}, + {"abc"++[1009], 290369864}, + {"abc"++[1009]++"de", 4134369195}, + {"1234567890123456", 963649519}, + + %% tuple + {{}, 221703996}, + {{{}}, 2165044361}, + {{<<>>}, 682464809}, + {{0.0}, 688441152}, + {{[]}, 1775079505}, + {{abc}, 2032039329}, + {{a,1,{},-3.14}, 1364396939}, + {{c:pid(0,2,0)}, 686997880}, + {{F4}, 2279632930}, + {{a,<<>>}, 2724468891}, + {{b,<<>>}, 2702508511} + ], + SpecFun = fun(S) -> sofs:no_elements(S) > 1 end, + F = sofs:relation_to_family(sofs:converse(sofs:relation(L))), + D = sofs:to_external(sofs:family_specification(SpecFun, F)), + ?line [] = D, + ?line [] = [{E,H,H2} || {E,H} <- L, (H2 = erlang:phash2(E, Max)) =/= H], + ok. + +-ifdef(FALSE). +f1() -> + abc. + +f2() -> + abd. + +f3(X, Y) -> + {X, Y}. +-endif. + +otp_5292_test() -> + H = fun(E) -> [erlang:hash(E, 16#7FFFFFF), + erlang:hash(-E, 16#7FFFFFF)] + end, + S1 = md5([md5(hash_int(S, E, H)) || {Start, N, Sz} <- d(), + {S, E} <- int(Start, N, Sz)]), + PH = fun(E) -> [erlang:phash(E, 1 bsl 32), + erlang:phash(-E, 1 bsl 32), + erlang:phash2(E, 1 bsl 32), + erlang:phash2(-E, 1 bsl 32)] + end, + S2 = md5([md5(hash_int(S, E, PH)) || {Start, N, Sz} <- d(), + {S, E} <- int(Start, N, Sz)]), + ?line Comment = case S1 of + <<43,186,76,102,87,4,110,245,203,177,206,6,130,69,43,99>> -> + ?line big = erlang:system_info(endian), + "Big endian machine"; + <<21,206,139,15,149,28,167,81,98,225,132,254,49,125,174,195>> -> + ?line little = erlang:system_info(endian), + "Little endian machine" + end, + ?line <<140,37,79,80,26,242,130,22,20,229,123,240,223,244,43,99>> = S2, + ?line 2 = erlang:hash(1, (1 bsl 27) -1), + ?line {'EXIT', _} = (catch erlang:hash(1, (1 bsl 27))), + {comment, Comment}. + +d() -> + [%% Start, NumOfIntervals, SizeOfInterval + {(1 bsl I)-100, 2, 100} || I <- lists:seq(1, 1000)]. + +int(Start, N, Sz) -> + {_, R} = lists:mapfoldl(fun(S, Acc) -> + {S + Sz, [{S,S+Sz-1} | Acc]} + end, [], lists:seq(Start, Start+(N-1)*Sz, Sz)), + lists:reverse(R). + +hash_int(Start, End, F) -> + HL = lists:flatmap(fun(E) -> F(E) end, lists:seq(Start, End)), + {Start, End, md5(HL)}. + +md5(T) -> + erlang:md5(term_to_binary(T)). + +bit_level_binaries() -> + ?line [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = + bit_level_all_different(fun erlang:hash/2), + ?line [3511317,7022633,14044578,28087749,56173436,112344123,90467083|_] = + bit_level_all_different(fun erlang:phash/2), + ?line [102233154,19716,102133857,4532024,123369135,24565730,109558721|_] = + bit_level_all_different(fun erlang:phash2/2), + + ?line 13233341 = test_hash_phash(<<42:7>>, 16#7FFFFFF), + ?line 79121243 = test_hash_phash(<<99:7>>, 16#7FFFFFF), + ?line 95517726 = test_hash_phash(<<16#378ABF73:31>>, 16#7FFFFFF), + + ?line 64409098 = test_phash2(<<99:7>>, 16#7FFFFFF), + ?line 55555814 = test_phash2(<<123,19:2>>, 16#7FFFFFF), + ?line 83868582 = test_phash2(<<123,45,6:3>>, 16#7FFFFFF), + ?line 2123204 = test_phash2(<<123,45,7:3>>, 16#7FFFFFF), + + ok. + +bit_level_all_different(Hash) -> + {name,Name} = erlang:fun_info(Hash, name), + Seq = lists:seq(1, 32), + Hashes0 = [Hash(<<1:Sz>>, 16#7FFFFFF) || Sz <- Seq], + io:format("~p/2 ~p", [Name,Hashes0]), + Hashes0 = [Hash(unaligned_sub_bitstr(<<1:Sz>>), 16#7FFFFFF) || Sz <- Seq], + 32 = length(lists:usort(Hashes0)), + + Hashes1 = [Hash(<<(1 bsl (Sz-1)):Sz>>, 16#7FFFFFF) || Sz <- Seq], + io:format("~p/2 ~p", [Name,Hashes1]), + Hashes1 = [Hash(unaligned_sub_bitstr(<<(1 bsl (Sz-1)):Sz>>), 16#7FFFFFF) || + Sz <- Seq], + 32 = length(lists:usort(Hashes1)), + + Hashes2 = [Hash(<<0:Sz>>, 16#7FFFFFF) || Sz <- Seq], + io:format("~p/2 ~p", [Name,Hashes2]), + Hashes2 = [Hash(unaligned_sub_bitstr(<<0:Sz>>), 16#7FFFFFF) || Sz <- Seq], + 32 = length(lists:usort(Hashes2)), + + Hashes1. + +test_hash_phash(Bitstr, Rem) -> + Hash = erlang:hash(Bitstr, Rem), + Hash = erlang:phash(Bitstr, Rem), + Hash = erlang:hash(unaligned_sub_bitstr(Bitstr), Rem), + Hash = erlang:phash(unaligned_sub_bitstr(Bitstr), Rem). + +test_phash2(Bitstr, Rem) -> + Hash = erlang:phash2(Bitstr, Rem), + Hash = erlang:phash2(unaligned_sub_bitstr(Bitstr), Rem). + +otp_7127_test() -> + %% Used to return 2589127136. + ?line 38990304 = erlang:phash2(<<"Scott9">>), + ok. + +%% +%% Reference implementation of integer hashing +%% + +%% +%% These are primes just above 2^28 that will never be changed, they are also in +%% utils.c. +%% +-define(FN2,268439161). +-define(FN3,268435459). +-define(FN4,268436141). + +make_hash(N,M) -> + Prime1 = ?FN2, + {Prime2, BL0} = to_bytes(N), + BL = pad(BL0), + (integer_hash(BL, Prime1, Prime2) rem M) + 1. + +to_bytes(N) when N < 0 -> + {?FN4,to_bytes(-N,[])}; +to_bytes(N) -> + {?FN3,to_bytes(N,[])}. +to_bytes(0,Acc) -> + Acc; +to_bytes(N,Acc) -> + to_bytes(N bsr 8, [N band 16#FF | Acc]). + +pad([]) -> + [0,0,0,0]; +pad(L) -> + case 4 - (length(L) rem 4) of + 4 -> + L; + N -> + lists:duplicate(N,0) ++ L + end. + +integer_hash(BL,P1,P2) -> + (do_ihash(0,lists:reverse(BL),P1) * P2) band 16#FFFFFFFF. + +do_ihash(Hash,[],_) -> + Hash; +do_ihash(Hash, [H|T], P) -> + do_ihash((((Hash * P) band 16#FFFFFFFF) + H) band 16#FFFFFFFF, T, P). + + + + +%% +%% Utilities for the test of "spreading" +%% +-ifdef(debug). +hex(N) -> + hex(0,N,[]). +hex(X,0,Acc) when X >= 8 -> + [$0, $x | Acc]; +hex(X,N,Acc) -> + hex(X+1,N bsr 4, [trans(N band 16#F) | Acc]). + +trans(N) when N < 10 -> + N + $0; +trans(10) -> + $A; +trans(11) -> + $B; +trans(12) -> + $C; +trans(13) -> + $D; +trans(14) -> + $E; +trans(15) -> + $F. +-endif. + +gen_keys(N, Template, BP,Fun) -> + Ratio = (1 bsl (BP * 8)), + Low = Template + Ratio, + High = Template + (N*Ratio), + ?dbgformat("N = ~p, BP = ~p, Template = ~p, Low = ~s, High = ~s~n", + [hex(N),hex(BP),hex(Template),hex(Low),hex(High-1)]), + Fun(Template), + gen_keys2(Low, High,Ratio,Fun). + +gen_keys2(High,High2,_,_) when High >= High2 -> + []; +gen_keys2(Low,High,R,Fun) -> + Fun(Low), + gen_keys2(Low + R,High,R,Fun). + +test_fun(N,{HM,HF}, Template, Fun) -> + init_table(), + test_fun_1(0,1,N+1,{HM,HF},Template,Fun). + +test_fun_1(_,To,To,_,_,_) -> + ok; +test_fun_1(A,X,To,Y,Z,W) when A > To -> + ?dbgformat("~p:~p(~p,~p,~p,~p,~p,~p)~n",[?MODULE,test_fun_1,To,X,To,Y,Z,W]), + test_fun_1(0,X+1,To,Y,Z,W); +test_fun_1(Pos,Siz,To,{HM,HF},Template,Fun) when 1 bsl (Siz*8) =< 65536 -> + io:format("Byte: ~p, Size: ~p~n",[Pos,Siz]), + N = 1 bsl (Siz*8), + gen_keys(N,Template,Pos,fun (X) -> + P = HM:HF(Fun(X),N), + ets:insert(?MODULE,{P}) + end + ), + Hits = collect_hits(), + io:format( + "Hashing of ~p values spread over ~p buckets~n", + [N,Hits]), + case (N div Hits) > 2 of + true -> + exit({not_spread_enough, Hits, on, N}); + _ -> + test_fun_1(Pos + Siz, Siz, To,{HM,HF},Template,Fun) + end; +test_fun_1(_,_,_,_,_,_) -> + ok. + +init_table() -> + (catch ets:delete(?MODULE)), + ets:new(?MODULE,[ordered_set,named_table]). + +collect_hits() -> + N = ets:info(?MODULE,size), + init_table(), + N. + +integer_to_binary(N) -> + list_to_binary(lists:reverse(integer_to_bytelist(N,[]))). + +integer_to_bytelist(0,Acc) -> + Acc; +integer_to_bytelist(N,Acc) -> + integer_to_bytelist(N bsr 8, [N band 16#FF | Acc]). + +unaligned_sub_bin(Bin0) when is_binary(Bin0) -> + Bin1 = <<42:6,Bin0/binary,3:2>>, + Sz = size(Bin0), + <<42:6,Bin:Sz/binary,3:2>> = id(Bin1), + Bin. + +unaligned_sub_bitstr(Bin0) when is_bitstring(Bin0) -> + Bin1 = <<(-1):4,Bin0/bits,(-1):64>>, + Bits = bit_size(Bin0), + <<_:4,Bin:Bits/bits,_:64>> = id(Bin1), + Bin. + +id(I) -> I. + diff --git a/erts/emulator/test/hibernate_SUITE.erl b/erts/emulator/test/hibernate_SUITE.erl new file mode 100644 index 0000000000..4d36076d12 --- /dev/null +++ b/erts/emulator/test/hibernate_SUITE.erl @@ -0,0 +1,353 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(hibernate_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + basic/1,min_heap_size/1,bad_args/1, + messages_in_queue/1,undefined_mfa/1, no_heap/1]). + +%% Used by test cases. +-export([basic_hibernator/1,messages_in_queue_restart/2, no_heap_loop/0]). + +all(suite) -> + [basic,min_heap_size,bad_args,messages_in_queue,undefined_mfa,no_heap]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(3)), + [{watchdog,Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +%%% +%%% Testing the basic functionality of erlang:hibernate/3. +%%% + +basic(Config) when is_list(Config) -> + Ref = make_ref(), + Info = {self(),Ref}, + ExpectedHeapSz = case erlang:system_info(heap_type) of + private -> erts_debug:size([Info]); + hybrid -> erts_debug:size([a|b]) + end, + ?line Child = spawn_link(fun() -> basic_hibernator(Info) end), + ?line hibernate_wake_up(100, ExpectedHeapSz, Child), + ?line Child ! please_quit_now, + ok. + +hibernate_wake_up(0, _, _) -> ok; +hibernate_wake_up(N, ExpectedHeapSz, Child) -> + {heap_size,Before} = process_info(Child, heap_size), + case N rem 2 of + 0 -> + Child ! {acquire_old_heap,self()}, + receive + done -> ok + end; + 1 -> ok + end, + ?line Child ! {hibernate,self()}, + ?line wait_until(fun () -> + {current_function,{erlang,hibernate,3}} == + process_info(Child, current_function) + end), + ?line {message_queue_len,0} = process_info(Child, message_queue_len), + ?line {status,waiting} = process_info(Child, status), + ?line {heap_size,ExpectedHeapSz} = process_info(Child, heap_size), + io:format("Before hibernation: ~p After hibernation: ~p\n", + [Before,ExpectedHeapSz]), + ?line Child ! {whats_up,self()}, + ?line receive + {all_fine,X,Child,_Ref} -> + if + N =:= 1 -> io:format("~p\n", [X]); + true -> ok + end, + {backtrace,Bin} = process_info(Child, backtrace), + if + size(Bin) > 1000 -> + io:format("~s\n", [binary_to_list(Bin)]), + ?line ?t:fail(stack_is_growing); + true -> + hibernate_wake_up(N-1, ExpectedHeapSz, Child) + end; + Other -> + ?line io:format("~p\n", [Other]), + ?line ?t:fail(unexpected_message) + end. + +basic_hibernator(Info) -> + {catchlevel,0} = process_info(self(), catchlevel), + receive + Any -> + basic_hibernator_msg(Any, Info), + basic_hibernator(Info) + end. + +basic_hibernator_msg({hibernate,_}, Info) -> + catch erlang:hibernate(?MODULE, basic_hibernator, [Info]), + exit(hibernate_returned); +basic_hibernator_msg({acquire_old_heap,Parent}, _) -> + acquire_old_heap(), + Parent ! done; +basic_hibernator_msg({whats_up,Parent}, {Parent,Ref}) -> + {heap_size,HeapSize} = process_info(self(), heap_size), + io:format("Heap size after waking up: ~p\n", [HeapSize]), + X = whats_up_calc(5000, 2, math:pi(), 4, 5, 6, 7, 8.5, 9, []), + Parent ! {all_fine,X,self(),Ref}; +basic_hibernator_msg(please_quit_now, _) -> + exit(normal); +basic_hibernator_msg(Other, _) -> + exit({unexpected,Other}). + +acquire_old_heap() -> + case process_info(self(), [heap_size,total_heap_size]) of + [{heap_size,Sz},{total_heap_size,Total}] when Sz < Total -> + ok; + _ -> + acquire_old_heap() + end. + +%% The point with this calculation is to force memory to be +%% allocated for the argument registers in the process structure. +%% The allocation will be forced if the process is scheduled out +%% while calling a function with more than 6 arguments. +whats_up_calc(0, A2, A3, A4, A5, A6, A7, A8, A9, Acc) -> + {Acc,A2+A3+A4+A5+A6+A7+A8+A9}; +whats_up_calc(A1, A2, A3, A4, A5, A6, A7, A8, A9, Acc) -> + whats_up_calc(A1-1, A2+1, A3+2, A4+3, A5+4, A6+5, A7+6, A8+7, A9+8, [A1,A2|Acc]). + +%%% +%%% Testing setting the minimum heap size. +%%% + +min_heap_size(Config) when is_list(Config) -> + ?line erlang:trace(new, true, [call]), + MFA = {?MODULE,min_hibernator,1}, + ?line 1 = erlang:trace_pattern(MFA, true, [local]), + Ref = make_ref(), + Info = {self(),Ref}, + ?line Child = spawn_opt(fun() -> min_hibernator(Info) end, + [{min_heap_size,15000},link]), + receive + {trace,Child,call,{?MODULE,min_hibernator,_}} -> + ?line 1 = erlang:trace_pattern(MFA, false, [local]), + ?line erlang:trace(new, false, [call]) + end, + {heap_size,HeapSz} = process_info(Child, heap_size), + io:format("Heap size: ~p\n", [HeapSz]), + ?line if + HeapSz < 20 -> ok + end, + ?line Child ! wake_up, + receive + {heap_size,AfterSize} -> + io:format("Heap size after wakeup: ~p\n", [AfterSize]), + ?line + if + AfterSize >= 15000 -> ok + end; + Other -> + io:format("Unexpected: ~p\n", [Other]), + ?line ?t:fail() + end. + +min_hibernator({Parent,_Ref}) -> + erlang:hibernate(erlang, apply, [fun min_hibernator_recv/1, [Parent]]). + +min_hibernator_recv(Parent) -> + receive + wake_up -> + Parent ! process_info(self(), heap_size) + end. + +%%% +%%% Testing feeding erlang:hibernate/3 with bad arguments. +%%% + +bad_args(Config) when is_list(Config) -> + ?line bad_args(?MODULE, {name,glurf}, [0]), + ?line {'EXIT',{system_limit,_}} = + (catch erlang:hibernate(x, y, lists:duplicate(5122, xxx))), + ?line bad_args(42, name, [0]), + ?line bad_args(xx, 42, [1]), + ?line bad_args(xx, 42, glurf), + ?line bad_args(xx, 42, {}), + ?line bad_args({}, name, [2]), + ?line bad_args({1}, name, [3]), + ?line bad_args({1,2,3}, name, [4]), + ?line bad_args({1,2,3}, name, [5]), + ?line bad_args({1,2,3,4}, name, [6]), + ?line bad_args({1,2,3,4,5,6}, name,[7]), + ?line bad_args({1,2,3,4,5}, name, [8]), + ?line bad_args({1,2}, name, [9]), + ?line bad_args([1,2], name, [9]), + ?line bad_args(55.0, name, [9]), + ok. + +bad_args(Mod, Name, Args) -> + Res = (catch erlang:hibernate(Mod, Name, Args)), + erlang:garbage_collect(), + case Res of + {'EXIT',{badarg,_Where}} -> + io:format("erlang:hibernate(~p, ~p, ~p) -> ~p\n", [Mod,Name,Args,Res]); + Other -> + io:format("erlang:hibernate(~p, ~p, ~p) -> ~p\n", [Mod,Name,Args,Res]), + ?t:fail({bad_result,Other}) + end. + + +%%% +%%% Testing calling erlang:hibernate/3 with messages already in the message queue. +%%% + +messages_in_queue(Config) when is_list(Config) -> + Self = self(), + Msg = {Self,make_ref(),a,message}, + Pid = spawn_link(fun() -> messages_in_queue_1(Self, Msg) end), + Pid ! Msg, + Pid ! go_ahead, + receive + done -> ok; + Other -> + ?line io:format("~p\n", [Other]), + ?line ?t:fail(unexpected_message) + end. + +messages_in_queue_1(Parent, ExpectedMsg) -> + receive + go_ahead -> ok + end, + {message_queue_len,1} = process_info(self(), message_queue_len), + erlang:hibernate(?MODULE, messages_in_queue_restart, + [Parent,ExpectedMsg]). + +messages_in_queue_restart(Parent, ExpectedMessage) -> + ?line receive + ExpectedMessage -> + Parent ! done; + Other -> + io:format("~p\n", [Other]), + ?t:fail(unexpected_message) + end, + ok. + + +%%% +%%% Test that trying to hibernate to an undefined MFA gives the correct +%%% exit behavior. +%%% + +undefined_mfa(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line Pid = spawn_link(fun() -> + %% Will be a call_only instruction. + erlang:hibernate(?MODULE, blarf, []) end), + ?line Pid ! {a,message}, + ?line receive + {'EXIT',Pid,{undef,Undef}} -> + io:format("~p\n", [Undef]), + ok; + Other -> + ?line io:format("~p\n", [Other]), + ?line ?t:fail(unexpected_message) + end, + undefined_mfa_1(). + +undefined_mfa_1() -> + ?line Pid = spawn_link(fun() -> + %% Force a call_last instruction by calling bar() + %% (if that is not obvious). + bar(), + erlang:hibernate(?MODULE, blarf, []) + end), + ?line Pid ! {another,message}, + ?line receive + {'EXIT',Pid,{undef,Undef}} -> + io:format("~p\n", [Undef]), + ok; + Other -> + ?line io:format("~p\n", [Other]), + ?line ?t:fail(unexpected_message) + end, + ok. + +bar() -> + ok. + +%% +%% No heap +%% + +no_heap(doc) -> []; +no_heap(suite) -> []; +no_heap(Config) when is_list(Config) -> + ?line H = spawn_link(fun () -> clean_dict(), no_heap_loop() end), + ?line lists:foreach(fun (_) -> + wait_until(fun () -> is_hibernated(H) end), + ?line [{heap_size,1}, + {total_heap_size,1}] + = process_info(H, + [heap_size, + total_heap_size]), + receive after 10 -> ok end, + H ! again + end, + lists:seq(1, 100)), + ?line unlink(H), + ?line exit(H, bye). + +no_heap_loop() -> + flush(), + erlang:hibernate(?MODULE, no_heap_loop, []). + +clean_dict() -> + {dictionary, Dict} = process_info(self(), dictionary), + lists:foreach(fun ({Key, _}) -> erase(Key) end, Dict). + +%% +%% Misc +%% + +is_hibernated(P) -> + case process_info(P, [current_function, status]) of + [{current_function, {erlang, hibernate, _}}, + {status, waiting}] -> + true; + _ -> + false + end. + +flush() -> + receive + _Msg -> flush() + after 0 -> + ok + end. + + +wait_until(Fun) -> + case catch Fun() of + true -> ok; + _ -> receive after 10 -> wait_until(Fun) end + end. diff --git a/erts/emulator/test/ignore_cores.erl b/erts/emulator/test/ignore_cores.erl new file mode 120000 index 0000000000..1d738cbafd --- /dev/null +++ b/erts/emulator/test/ignore_cores.erl @@ -0,0 +1 @@ +../../test/ignore_cores.erl \ No newline at end of file diff --git a/erts/emulator/test/list_bif_SUITE.erl b/erts/emulator/test/list_bif_SUITE.erl new file mode 100644 index 0000000000..65ea88eb2f --- /dev/null +++ b/erts/emulator/test/list_bif_SUITE.erl @@ -0,0 +1,145 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(list_bif_SUITE). +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2]). +-export([hd_test/1,tl_test/1,t_length/1,t_list_to_pid/1, + t_list_to_float/1,t_list_to_integer/1]). + + +all(suite) -> + [hd_test,tl_test,t_length,t_list_to_pid,t_list_to_float,t_list_to_integer]. + +init_per_testcase(_Case, Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + [{watchdog,Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +t_list_to_integer(suite) -> + []; +t_list_to_integer(doc) -> + ["tests list_to_integer and string:to_integer"]; +t_list_to_integer(Config) when is_list(Config) -> + ?line {'EXIT',{badarg,_}} = (catch list_to_integer("12373281903728109372810937209817320981321ABC")), + ?line 12373281903728109372810937209817320981321 = (catch list_to_integer("12373281903728109372810937209817320981321")), + ?line 12373 = (catch list_to_integer("12373")), + ?line -12373 = (catch list_to_integer("-12373")), + ?line 12373 = (catch list_to_integer("+12373")), + ?line {'EXIT',{badarg,_}} = ( catch list_to_integer(abc)), + ?line {'EXIT',{badarg,_}} = (catch list_to_integer("")), + ?line {12373281903728109372810937209817320981321,"ABC"} = string:to_integer("12373281903728109372810937209817320981321ABC"), + ?line {-12373281903728109372810937209817320981321,"ABC"} = string:to_integer("-12373281903728109372810937209817320981321ABC"), + ?line {12,[345]} = string:to_integer([$1,$2,345]), + ?line {12,[a]} = string:to_integer([$1,$2,a]), + ?line {error,no_integer} = string:to_integer([$A]), + ?line {error,not_a_list} = string:to_integer($A), + ok. + +%% Test hd/1 with correct and incorrect arguments. +hd_test(Config) when is_list(Config) -> + ?line $h = hd(id("hejsan")), + ?line case catch hd(id($h)) of + {'EXIT', {badarg, _}} -> ok; + Res -> + Str=io_lib:format("hd/1 with incorrect args "++ + "succeeded.~nResult: ~p", [Res]), + test_server:fail(Str) + end, + ok. + + +%% Test tl/1 with correct and incorrect arguments. +tl_test(Config) when is_list(Config) -> + ?line "ejsan" = tl(id("hejsan")), + ?line case catch tl(id(104)) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + Str=io_lib:format("tl/1 with incorrect args "++ + "succeeded.~nResult: ~p", [Res]), + test_server:fail(Str) + end, + ok. + + +%% Test length/1 with correct and incorrect arguments. + +t_length(Config) when is_list(Config) -> + ?line 0 = length(""), + ?line 0 = length([]), + ?line 1 = length([1]), + ?line 2 = length([1,a]), + ?line 2 = length("ab"), + ?line 3 = length("abc"), + ?line 4 = length(id([x|"abc"])), + ?line 6 = length("hejsan"), + ?line {'EXIT',{badarg,_}} = (catch length(id([a,b|c]))), + ?line case catch length({tuple}) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + Str = io_lib:format("length/1 with incorrect args "++ + "succeeded.~nResult: ~p", [Res]), + ?line test_server:fail(Str) + end, + ok. + + +%% Test list_to_pid/1 with correct and incorrect arguments. + +t_list_to_pid(Config) when is_list(Config) -> + ?line Me = self(), + ?line MyListedPid = pid_to_list(Me), + ?line Me = list_to_pid(MyListedPid), + ?line case catch list_to_pid(id("Incorrect list")) of + {'EXIT', {badarg, _}} -> + ok; + Res -> + Str=io_lib:format("list_to_pid/1 with incorrect "++ + "arg succeeded.~nResult: ~p", + [Res]), + test_server:fail(Str) + end, + ok. + + +%% Test list_to_float/1 with correct and incorrect arguments. + +t_list_to_float(Config) when is_list(Config) -> + ?line 5.89000 = list_to_float(id("5.89")), + ?line 5.89898 = list_to_float(id("5.89898")), + ?line case catch list_to_float(id("58")) of + {'EXIT', {badarg, _}} -> ok; + Res -> + Str=io_lib:format("list_to_float with incorrect "++ + "arg succeeded.~nResult: ~p", + [Res]), + test_server:fail(Str) + end, + ok. + +id(I) -> I. + + diff --git a/erts/emulator/test/long_timers_test.erl b/erts/emulator/test/long_timers_test.erl new file mode 100644 index 0000000000..28626d26fb --- /dev/null +++ b/erts/emulator/test/long_timers_test.erl @@ -0,0 +1,317 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + + +%%%------------------------------------------------------------------- +%%% File : long_timer_test.erl +%%% Author : Rickard Green +%%% Description : +%%% +%%% Created : 21 Aug 2006 by Rickard Green +%%%------------------------------------------------------------------- + + +-define(MAX_TIMEOUT, 60). % Minutes +-define(MAX_LATE, 10*1000). % Milliseconds +-define(REG_NAME, '___LONG___TIMERS___TEST___SERVER___'). + +-define(DRV_NAME, timer_driver). + +% First byte in communication with the timer driver +-define(START_TIMER, 0). +-define(CANCEL_TIMER, 1). +-define(DELAY_START_TIMER, 2). +-define(TIMER, 3). +-define(CANCELLED, 4). + +-module(long_timers_test). + +-export([start/1, check_result/0]). + +-record(timeout_rec,{pid, type, timeout, timeout_diff}). + +start(DrvDir) when is_list(DrvDir) -> + Starter = self(), + StartDone = make_ref(), + stop_node(full_node_name(?REG_NAME)), + Node = start_node(?REG_NAME), + Test = spawn(Node, fun () -> test(Starter, DrvDir, StartDone) end), + Mon = erlang:monitor(process, Test), + receive + StartDone -> + erlang:demonitor(Mon), + net_kernel:disconnect(Node), + receive {'DOWN',Mon,_,_,_} -> ok after 0 -> ok end; + {'DOWN',Mon,_,_,Reason} -> + stop_node(full_node_name(?REG_NAME)), + {error, Reason} + end. + +check_result() -> + Node = full_node_name(?REG_NAME), + LTTS = {?REG_NAME, Node}, + Mon = erlang:monitor(process, LTTS), + (catch LTTS ! {get_result, ?REG_NAME, self()}), + receive + {'DOWN', Mon, process, _, Reason} -> + {?REG_NAME, 'DOWN', Reason}; + {result, ?REG_NAME, TORs, Start, End} -> + erlang:demonitor(Mon), + receive {'DOWN', Mon, _, _, _} -> ok after 0 -> ok end, + stop_node(Node), + check(TORs, (timer:now_diff(End, Start) div 1000) - ?MAX_LATE, ok) + end. + +check([#timeout_rec{timeout = Timeout, + type = Type, + timeout_diff = undefined} | TORs], + NeedRes, + _Ok) when Timeout < NeedRes -> + io:format("~p timeout = ~p failed! No timeout.~n", + [Type, Timeout]), + check(TORs, NeedRes, failed); +check([#timeout_rec{timeout_diff = undefined} | TORs], + NeedRes, + Ok) -> + check(TORs, NeedRes, Ok); +check([#timeout_rec{timeout = Timeout, + type = Type, + timeout_diff = {error, Reason}} | TORs], + NeedRes, + _Ok) -> + io:format("~p timeout = ~p failed! exit reason ~p~n", + [Type, Timeout, Reason]), + check(TORs, NeedRes, failed); +check([#timeout_rec{timeout = Timeout, + type = Type, + timeout_diff = TimeoutDiff} | TORs], + NeedRes, + Ok) -> + case (0 =< TimeoutDiff) and (TimeoutDiff =< ?MAX_LATE) of + true -> + io:format("~p timeout = ~p succeded! timeout diff = ~p.~n", + [Type, Timeout, TimeoutDiff]), + check(TORs, NeedRes, Ok); + false -> + io:format("~p timeout = ~p failed! timeout diff = ~p.~n", + [Type, Timeout, TimeoutDiff]), + check(TORs, NeedRes, failed) + end; +check([], _NeedRes, Ok) -> + Ok. + +receive_after(Timeout) -> + Start = now(), + receive + {get_result, ?REG_NAME} -> + ?REG_NAME ! #timeout_rec{pid = self(), + type = receive_after, + timeout = Timeout} + after Timeout -> + Stop = now(), + receive + {get_result, ?REG_NAME} -> + TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) + - Timeout), + ?REG_NAME ! #timeout_rec{pid = self(), + type = receive_after, + timeout = Timeout, + timeout_diff = TimeoutDiff} + end + end. + +driver(Timeout) -> + Port = open_port({spawn, ?DRV_NAME},[]), + link(Port), + Start = now(), + erlang:port_command(Port, <>), + receive + {get_result, ?REG_NAME} -> + ?REG_NAME ! #timeout_rec{pid = self(), + type = driver, + timeout = Timeout}; + {Port,{data,[?TIMER]}} -> + Stop = now(), + unlink(Port), + true = erlang:port_close(Port), + receive + {get_result, ?REG_NAME} -> + TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) + - Timeout), + ?REG_NAME ! #timeout_rec{pid = self(), + type = driver, + timeout = Timeout, + timeout_diff = TimeoutDiff} + end + end. + +bif_timer(Timeout) -> + Tmr = erlang:start_timer(Timeout, self(), ok), + Start = now(), + receive + {get_result, ?REG_NAME} -> + ?REG_NAME ! #timeout_rec{pid = self(), + type = bif_timer, + timeout = Timeout}; + {timeout, Tmr, ok} -> + Stop = now(), + receive + {get_result, ?REG_NAME} -> + TimeoutDiff = ((timer:now_diff(Stop, Start) div 1000) + - Timeout), + ?REG_NAME ! #timeout_rec{pid = self(), + type = bif_timer, + timeout = Timeout, + timeout_diff = TimeoutDiff} + end + end. + +test(Starter, DrvDir, StartDone) -> + erl_ddll:start(), + ok = load_driver(DrvDir, ?DRV_NAME), + process_flag(trap_exit, true), + register(?REG_NAME, self()), + {group_leader, GL} = process_info(whereis(net_kernel),group_leader), + group_leader(GL, self()), + Start = now(), + TORs = lists:map(fun (Min) -> + TO = Min*60*1000, + [#timeout_rec{pid = spawn_opt( + fun () -> + receive_after(TO) + end, + [link, {priority, high}]), + type = receive_after, + timeout = TO}, + #timeout_rec{pid = spawn_opt( + fun () -> + driver(TO) + end, + [link, {priority, high}]), + type = driver, + timeout = TO}, + #timeout_rec{pid = spawn_opt( + fun () -> + bif_timer(TO) + end, + [link, {priority, high}]), + type = bif_timer, + timeout = TO}] + end, + lists:seq(1, ?MAX_TIMEOUT)), + FlatTORs = lists:flatten(TORs), + Starter ! StartDone, + test_loop(FlatTORs, Start). + +test_loop(TORs, Start) -> + receive + {get_result, ?REG_NAME, Pid} -> + End = now(), + Pid ! {result, ?REG_NAME, get_test_results(TORs), Start, End}, + erl_ddll:unload_driver(?DRV_NAME), + erl_ddll:stop(), + exit(bye) + end. + +get_test_results(TORs) -> + lists:foreach(fun (#timeout_rec{pid = Pid}) -> + Pid ! {get_result, ?REG_NAME} + end, + TORs), + get_test_results(TORs, []). + +get_test_results([#timeout_rec{pid = Pid, + timeout = Timeout} = TOR | TORs], NewTORs) -> + receive + #timeout_rec{pid = Pid, timeout = Timeout} = NewTOR -> + get_test_results(TORs, [NewTOR | NewTORs]); + #timeout_rec{pid = Pid} = NewTOR -> + exit({timeout_mismatch, TOR, NewTOR}); + {'EXIT', Pid, Reason} -> + get_test_results(TORs, + [TOR#timeout_rec{timeout_diff = {error, Reason}} + | NewTORs]) + end; +get_test_results([], NewTORs) -> + lists:reverse(NewTORs). + +mk_node_cmdline(Name) -> + Static = "-detached -noinput", + Pa = filename:dirname(code:which(?MODULE)), + Prog = case catch init:get_argument(progname) of + {ok,[[P]]} -> P; + _ -> exit(no_progname_argument_found) + end, + NameSw = case net_kernel:longnames() of + false -> "-sname "; + true -> "-name "; + _ -> exit(not_distributed_node) + end, + {ok, Pwd} = file:get_cwd(), + NameStr = atom_to_list(Name), + Prog ++ " " + ++ Static ++ " " + ++ NameSw ++ " " ++ NameStr ++ " " + ++ "-pa " ++ Pa ++ " " + ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ NameStr ++ " " + ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()). + +full_node_name(PreName) -> + HostSuffix = lists:dropwhile(fun ($@) -> false; (_) -> true end, + atom_to_list(node())), + list_to_atom(atom_to_list(PreName) ++ HostSuffix). + +ping_node(_Node, 0) -> + pang; +ping_node(Node, N) when is_integer(N), N > 0 -> + case catch net_adm:ping(Node) of + pong -> pong; + _ -> + receive after 100 -> ok end, + ping_node(Node, N-1) + end. + +start_node(Name) -> + FullName = full_node_name(Name), + CmdLine = mk_node_cmdline(Name), + io:format("Starting node ~p: ~s~n", [FullName, CmdLine]), + case open_port({spawn, CmdLine}, []) of + Port when is_port(Port) -> + unlink(Port), + erlang:port_close(Port), + case ping_node(FullName, 50) of + pong -> FullName; + Other -> exit({failed_to_start_node, FullName, Other}) + end; + Error -> + exit({failed_to_start_node, FullName, Error}) + end. + +stop_node(Node) -> + monitor_node(Node, true), + spawn(Node, fun () -> halt() end), + receive {nodedown, Node} -> ok end. + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. diff --git a/erts/emulator/test/match_spec_SUITE.erl b/erts/emulator/test/match_spec_SUITE.erl new file mode 100644 index 0000000000..69c89f5d2d --- /dev/null +++ b/erts/emulator/test/match_spec_SUITE.erl @@ -0,0 +1,942 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(match_spec_SUITE). + +-export([all/1, not_run/1]). +-export([test_1/1, test_2/1, test_3/1, bad_match_spec_bin/1, + trace_control_word/1, silent/1, silent_no_ms/1, + ms_trace2/1, ms_trace3/1, boxed_and_small/1, + destructive_in_test_bif/1, guard_exceptions/1, + unary_plus/1, unary_minus/1, moving_labels/1]). +-export([fpe/1]). + +-export([runner/2]). +-export([f1/1, f2/2, f3/2, fn/1, fn/2, fn/3]). +-export([do_boxed_and_small/0]). + +% This test suite assumes that tracing in general works. What we test is +% the match spec functionality. + +-include("test_server.hrl"). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:seconds(10)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + + +all(suite) -> + case test_server:is_native(?MODULE) of + false -> [test_1, test_2, test_3, bad_match_spec_bin, + trace_control_word, silent, silent_no_ms, + ms_trace2, ms_trace3, boxed_and_small, + destructive_in_test_bif, guard_exceptions, + unary_plus, unary_minus, fpe, moving_labels]; + true -> [not_run] + end. + +not_run(Config) when is_list(Config) -> + {skipped, "Native Code"}. + +test_1(doc) -> + [""]; +test_1(suite) -> []; +test_1(Config) when is_list(Config) -> + ?line tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [], + [{call, {?MODULE, f1, [a]}}]), + + ?line tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[]}], + [{call, {?MODULE, f2, [a, a]}}]), + + ?line tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, false}]}], + []), + + ?line tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [a, a]}, 4711}]), + + Ref = make_ref(), + ?line tr(fun() -> ?MODULE:f2(Ref, Ref) end, + {?MODULE, f2, 2}, + [{[Ref,'$1'],[{is_reference, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), + ?line tr(fun() -> ?MODULE:f2(Ref, Ref) end, + {?MODULE, f2, 2}, + [{['$1',Ref],[{is_reference, '$1'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [Ref, Ref]}, 4711}]), + + ?line tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$0','$0'],[{is_atom, '$0'}],[{message, 4711}]}], + [{call, {?MODULE, f2, [a, a]}, 4711}]), + + ?line tr(fun() -> ?MODULE:f2(a, b) end, + {?MODULE, f2, 2}, + [{['_','_'],[],[]}], + [{call, {?MODULE, f2, [a, b]}}]), + + ?line tr(fun() -> ?MODULE:f2(a, b) end, + {?MODULE, f2, 2}, + [{['_','_'],[],[{message, '$_'}]}], + [{call, {?MODULE, f2, [a, b]}, [a, b]}]), + + ?line tr(fun() -> ?MODULE:f2(a, '$_') end, + {?MODULE, f2, 2}, + [{['$1','$_'],[{is_atom, '$1'}],[]}], + [{call, {?MODULE, f2, [a, '$_']}}]), + + ?line tr(fun() -> ?MODULE:f1({a}) end, + {?MODULE, f1, 1}, + [{['$1'],[{'==', '$1', {const, {a}}}],[]}], + [{call, {?MODULE, f1, [{a}]}}]), + + ?line tr(fun() -> ?MODULE:f1({a}) end, + {?MODULE, f1, 1}, + [{['$1'],[{'==', '$1', {{a}}}],[]}], + [{call, {?MODULE, f1, [{a}]}}]), + +%% Undocumented, currently. + ?line tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, + {message, true}]}], + [{call, {?MODULE, f2, [a, a]}}]), + + ?line tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{message, 4711}, + {message, false}]}], + []), + + ?line tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[kakalorum]}], + [{call, {?MODULE, f2, [a, a]}}]), + +% case tr0(fun() -> ?MODULE:f2(a, a) end, +% {?MODULE, f2, 2}, +% [{['$1','$1'],[{is_atom, '$1'}],[{message, {process_dump}}]}]) of +% [{trace, _, call, {?MODULE, f2, [a, a]}, Bin}] -> +% erlang:display(binary_to_list(Bin)) +% end, + +% Error cases + ?line errchk([{['$1','$1'],[{is_atom, '$1'}],[{banka, kanin}]}]), + + ok. + +test_2(doc) -> + [""]; +test_2(suite) -> []; +test_2(Config) when is_list(Config) -> + ?line tr(fun() -> ?MODULE:f2(a, a) end, + {?MODULE, f2, 2}, + [{['$1','$1'],[{is_atom, '$1'}],[{return_trace}]}], + [{call, {?MODULE, f2, [a, a]}}, + {return_from, {?MODULE, f2, 2}, {a, a}}]), + ok. + +test_3(doc) -> + ["Test the enable_trace/2 and caller/0 PAM instructions"]; +test_3(suite) -> []; +test_3(Config) when is_list(Config) -> + ?line Fun1 = fun() -> + register(fnoppelklopfer,self()), + ?MODULE:f2(a, b), + ?MODULE:f2(a, b) + end, + ?line P1 = spawn(?MODULE, runner, [self(), Fun1]), + ?line Pat = [{['$1','$1'],[],[{message, + [{enable_trace, P1, call},{caller}]}]}, + {['_','_'],[],[{message, + [{disable_trace, fnoppelklopfer, call}]}]}], + ?line Fun2 = fun() -> ?MODULE:f3(a, a) end, + ?line P2 = spawn(?MODULE, runner, [self(), Fun2]), + ?line erlang:trace(P2, true, [call]), + ?line erlang:trace_pattern({?MODULE, f2, 2}, Pat), + ?line collect(P2, [{trace, P2, call, {?MODULE, f2, [a, a]}, [true, + {?MODULE,f3,2}]}]), + ?line collect(P1, [{trace, P1, call, {?MODULE, f2, [a, b]}, [true]}]), + ?line ok. + +bad_match_spec_bin(Config) when is_list(Config) -> + {'EXIT',{badarg,_}} = (catch ets:match_spec_run([1], <<>>)), + B0 = <<1,2>>, + {B,_} = split_binary(B0, 0), + {'EXIT',{badarg,_}} = (catch ets:match_spec_run([1], B)), + ok. + + + +trace_control_word(doc) -> + ["Test the erlang:system_info(trace_control_word) and ", + "erlang:system_flag(trace_control_word, Value) BIFs, ", + "as well as the get_tcw/0 and set_tcw/1 PAM instructions"]; +trace_control_word(suite) -> []; +trace_control_word(Config) when is_list(Config) -> + ?line 32 = Bits = tcw_bits(), + ?line High = 1 bsl (Bits - 1), + ?line erlang:system_flag(trace_control_word, 17), + ?line tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, 17}],[]}], + [{call, {?MODULE, f1, [a]}}]), + ?line tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, 18}],[]}], + []), + ?line erlang:system_flag(trace_control_word, High), + ?line tr(fun() -> ?MODULE:f1(a) end, + {?MODULE, f1, 1}, + [{'_',[{'=:=', {get_tcw}, High}],[]}], + [{call, {?MODULE, f1, [a]}}]), + ?line erlang:system_flag(trace_control_word, 0), + ?line tr(fun() -> + ?MODULE:f1(a), + ?MODULE:f1(start), + ?MODULE:f1(b), + ?MODULE:f1(c), + ?MODULE:f1(high), + ?MODULE:f1(d), + ?MODULE:f1(stop), + ?MODULE:f1(e) + end, + {?MODULE, f1, 1}, + [{[start], + [], + [{message, {set_tcw, 17}}]}, + {[stop], + [], + [{message, {set_tcw, 0}}]}, + {[high], + [], + [{message, {set_tcw, High}}]}, + {['_'], + [{'>', {get_tcw}, 0}], + [{set_tcw, {'+', 1, {get_tcw}}}, {message, {get_tcw}}] }], + [{call, {?MODULE, f1, [start]}, 0}, + {call, {?MODULE, f1, [b]}, 18}, + {call, {?MODULE, f1, [c]}, 19}, + {call, {?MODULE, f1, [high]}, 19}, + {call, {?MODULE, f1, [d]}, High + 1}, + {call, {?MODULE, f1, [stop]}, High + 1}]), + ?line 0 = erlang:system_info(trace_control_word), + ok. + +tcw_bits() -> + ?line tcw_bits(erlang:system_flag(trace_control_word, 0), 0, 0). + +tcw_bits(Save, Prev, Bits) -> + ?line Curr = 1 bsl Bits, + ?line case catch erlang:system_flag(trace_control_word, Curr) of + {'EXIT' , {badarg, _}} -> + ?line Prev = erlang:system_flag(trace_control_word, Save), + Bits; + Prev -> + ?line Curr = erlang:system_info(trace_control_word), + tcw_bits(Save, Curr, Bits+1) + end. + + + +silent(doc) -> + ["Test the erlang:trace(_, _, [silent]) flag ", + "as well as the silent/0 PAM instruction"]; +silent(suite) -> []; +silent(Config) when is_list(Config) -> + %% Global call trace + ?line tr(fun() -> + ?MODULE:f1(a), % No trace - not active + ?MODULE:f1(miss), % No trace - no activation + ?MODULE:f1(b), % No trace - still not active + ?MODULE:f1(start), % Trace - activation + ?MODULE:f1(c), % Trace - active + f1(d), % No trace - local call + ?MODULE:f1(miss), % Trace - no inactivation + ?MODULE:f1(e), % Trace - still active + ?MODULE:f1(stop), % No trace - inactivation + ?MODULE:f1(f) % No trace - not active + end, + {?MODULE, f1, 1}, + [call, silent], + [{[start], + [], + [{silent, false}, {message, start}]}, + {[stop], + [], + [{silent, true}, {message, stop}]}, + {[miss], + [], + [{silent, neither_true_nor_false}, {message, miss}]}, + {['$1'], + [], + [{message, '$1'}] }], + [global], + [{call, {?MODULE, f1, [start]}, start}, + {call, {?MODULE, f1, [c]}, c}, + {call, {?MODULE, f1, [miss]}, miss}, + {call, {?MODULE, f1, [e]}, e} ]), + %% Local call trace + ?line tr(fun() -> + ?MODULE:f1(a), % No trace - not active + f1(b), % No trace - not active + ?MODULE:f1(start), % Trace - activation + ?MODULE:f1(c), % Trace - active + f1(d), % Trace - active + f1(stop), % No trace - inactivation + ?MODULE:f1(e), % No trace - not active + f1(f) % No trace - not active + end, + {?MODULE, f1, 1}, + [call, silent], + [{[start], + [], + [{silent, false}, {message, start}]}, + {[stop], + [], + [{silent, true}, {message, stop}]}, + {['$1'], + [], + [{message, '$1'}] }], + [local], + [{call, {?MODULE, f1, [start]}, start}, + {call, {?MODULE, f1, [c]}, c}, + {call, {?MODULE, f1, [d]}, d} ]), + ok. + +silent_no_ms(doc) -> + ["Test the erlang:trace(_, _, [silent]) flag without match specs"]; +silent_no_ms(suite) -> []; +silent_no_ms(Config) when is_list(Config) -> + %% Global call trace + %% + %% Trace f2/2 and erlang:integer_to_list/1 without match spec + %% and use match spec on f1/1 to control silent flag. + ?line tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + ?MODULE:f1(start), + ?MODULE:f2(f, g), + erlang:integer_to_list(id(2)), + ?MODULE:f3(h, i), + ?MODULE:f1(stop), + ?MODULE:f2(j, k), + erlang:integer_to_list(id(3)), + ?MODULE:f3(l, m) + end, + fun (Tracee) -> + ?line 1 = + erlang:trace(Tracee, true, + [call,silent,return_to]), + ?line 1 = + erlang:trace_pattern( + {?MODULE,f2,2}, + [], + [global]), + ?line 1 = + erlang:trace_pattern( + {erlang,integer_to_list,1}, + [], + [global]), + ?line 1 = + erlang:trace_pattern( + {?MODULE,f1,1}, + [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true}]}], + [global]), + %% + %% Expected: (no return_to for global call trace) + %% + ?line + [{trace,Tracee,call,{?MODULE,f1,[start]}}, + {trace,Tracee,call,{?MODULE,f2,[f,g]}}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[h,i]}}] + end), + %% Local call trace + %% + %% Trace f2/2 and erlang:integer_to_list/1 without match spec + %% and use match spec on f1/1 to control silent flag. + ?line tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + ?MODULE:f1(start), + ?MODULE:f2(f, g), + erlang:integer_to_list(id(2)), + ?MODULE:f3(h, i), + ?MODULE:f1(stop), + ?MODULE:f2(j, k), + erlang:integer_to_list(id(3)), + ?MODULE:f3(l, m) + end, + fun (Tracee) -> + ?line 1 = + erlang:trace(Tracee, true, + [call,silent,return_to]), + ?line 1 = + erlang:trace_pattern( + {?MODULE,f2,2}, + [], + [local]), + ?line 1 = + erlang:trace_pattern( + {erlang,integer_to_list,1}, + [], + [local]), + ?line 1 = + erlang:trace_pattern( + {?MODULE,f1,1}, + [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true}]}], + [local]), + %% + %% Expected: + %% + ?line + [{trace,Tracee,call,{?MODULE,f1,[start]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {trace,Tracee,call,{?MODULE,f2,[f,g]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,return_to, + {?MODULE,'-silent_no_ms/1-fun-2-',0}}, + {trace,Tracee,call,{?MODULE,f2,[h,i]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}] + end). + +ms_trace2(doc) -> + ["Test the match spec functions {trace/2}"]; +ms_trace2(suite) -> []; +ms_trace2(Config) when is_list(Config) -> + Tracer = self(), + %% Meta trace init + %% + %% Trace global f1/1, local f2/2, global erlang:integer_to_list/1 + %% without match spec. Use match spec functions + %% {trace/2} to control trace through fn/2,3. + ?line tr( + fun () -> + ?MODULE:f1(a), + ?MODULE:f2(b, c), + erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + fn([all], [call,return_to,{tracer,Tracer}]), + ?MODULE:f1(f), + f2(g, h), + f1(i), + erlang:integer_to_list(id(2)), + ?MODULE:f3(j, k), + fn([call,return_to], []), + ?MODULE:f1(l), + ?MODULE:f2(m, n), + erlang:integer_to_list(id(3)), + ?MODULE:f3(o, p) + end, + fun (Tracee) -> + ?line 1 = + erlang:trace(Tracee, false, [all]), + ?line 1 = + erlang:trace_pattern( + {?MODULE,f1,1}, + [], + [global]), + ?line 1 = + erlang:trace_pattern( + {?MODULE,f2,2}, + [], + [local]), + ?line 1 = + erlang:trace_pattern( + {erlang,integer_to_list,1}, + [], + [global]), + ?line 3 = + erlang:trace_pattern( + {?MODULE,fn,'_'}, + [{['$1','$2'],[], + [{trace,'$1','$2'},{message,ms_trace2}]}], + [meta]), + %% + %% Expected: (no return_to for global call trace) + %% + ?line Origin = {match_spec_SUITE,'-ms_trace2/1-fun-0-',1}, + ?line + [{trace_ts,Tracee,call, + {?MODULE,fn, + [[all],[call,return_to,{tracer,Tracer}]]}, + ms_trace2}, + {trace,Tracee,call,{?MODULE,f1,[f]}}, + {trace,Tracee,call,{?MODULE,f2,[g,h]}}, + {trace,Tracee,return_to,Origin}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[j,k]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}, + {trace_ts,Tracee,call, + {?MODULE,fn, + [[call,return_to],[]]}, + ms_trace2}] + end), + ok. + + + +ms_trace3(doc) -> + ["Test the match spec functions {trace/3}"]; +ms_trace3(suite) -> []; +ms_trace3(Config) when is_list(Config) -> + TraceeName = 'match_spec_SUITE:ms_trace3', + Tracer = self(), + %% Meta trace init + %% + %% Trace global f1/1, local f2/2, global erlang:integer_to_list/1 + %% without match spec. Use match spec functions + %% {trace/2} to control trace through fn/2,3. + Tag = make_ref(), + Controller = + spawn_link( + fun () -> + receive + {Tracee,Tag,start} -> + fn(TraceeName, [all], + [call,return_to,send,'receive', + {tracer,Tracer}]), + Tracee ! {self(),Tag,started}, + receive {Tracee,Tag,stop_1} -> ok end, + fn(Tracee, [call,return_to], []), + Tracee ! {self(),Tag,stopped_1}, + receive {Tracee,Tag,stop_2} -> ok end, + fn(Tracee, [all], []), + Tracee ! {self(),Tag,stopped_2} + end + end), + ?line tr( + fun () -> %% Action + register(TraceeName, self()), + ?MODULE:f1(a), + ?MODULE:f2(b, c), + erlang:integer_to_list(id(1)), + ?MODULE:f3(d, e), + Controller ! {self(),Tag,start}, + receive {Controller,Tag,started} -> ok end, + ?MODULE:f1(f), + f2(g, h), + f1(i), + erlang:integer_to_list(id(2)), + ?MODULE:f3(j, k), + Controller ! {self(),Tag,stop_1}, + receive {Controller,Tag,stopped_1} -> ok end, + ?MODULE:f1(l), + ?MODULE:f2(m, n), + erlang:integer_to_list(id(3)), + ?MODULE:f3(o, p), + Controller ! {self(),Tag,stop_2}, + receive {Controller,Tag,stopped_2} -> ok end, + ?MODULE:f1(q), + ?MODULE:f2(r, s), + erlang:integer_to_list(id(4)), + ?MODULE:f3(t, u) + end, + + fun (Tracee) -> %% Startup + ?line 1 = + erlang:trace(Tracee, false, [all]), + ?line 1 = + erlang:trace_pattern( + {?MODULE,f1,1}, + [], + [global]), + ?line 1 = + erlang:trace_pattern( + {?MODULE,f2,2}, + [], + [local]), + ?line 1 = + erlang:trace_pattern( + {erlang,integer_to_list,1}, + [], + [global]), + ?line 3 = + erlang:trace_pattern( + {?MODULE,fn,'_'}, + [{['$1','$2','$3'],[], + [{trace,'$1','$2','$3'},{message,Tag}]}], + [meta]), + %% + %% Expected: (no return_to for global call trace) + %% + ?line Origin = {match_spec_SUITE,'-ms_trace3/1-fun-1-',2}, + ?line + [{trace_ts,Controller,call, + {?MODULE,fn,[TraceeName,[all], + [call,return_to,send,'receive', + {tracer,Tracer}]]}, + Tag}, + {trace,Tracee,'receive',{Controller,Tag,started}}, + {trace,Tracee,call,{?MODULE,f1,[f]}}, + {trace,Tracee,call,{?MODULE,f2,[g,h]}}, + {trace,Tracee,return_to,Origin}, + {trace,Tracee,call,{erlang,integer_to_list,[2]}}, + {trace,Tracee,call,{?MODULE,f2,[j,k]}}, + {trace,Tracee,return_to,{?MODULE,f3,2}}, + {trace,Tracee,send,{Tracee,Tag,stop_1},Controller}, + {trace_ts,Controller,call, + {?MODULE,fn,[Tracee,[call,return_to],[]]}, + Tag}, + {trace_ts,Controller,call, + {?MODULE,fn,[Tracee,[all],[]]}, + Tag}] + end), + ok. + + + +destructive_in_test_bif(doc) -> + ["Test that destructive operations in test bif does not really happen"]; +destructive_in_test_bif(suite) -> []; +destructive_in_test_bif(Config) when is_list(Config) -> + ?line {ok,OldToken,_,_} = erlang:match_spec_test + ([], + [{'_',[],[{message,{get_seq_token}}]}],trace), + ?line {ok,_,_,_} = erlang:match_spec_test + ([], + [{'_',[],[{message,{set_seq_token, label, 1}}]}], + trace), + ?line {ok,OldToken,_,_} = erlang:match_spec_test + ([], + [{'_',[],[{message,{get_seq_token}}]}],trace), + ?line {ok, OldTCW,_,_} = erlang:match_spec_test + ([],[{'_',[],[{message,{get_tcw}}]}],trace), + ?line {ok,OldTCW,_,_} = erlang:match_spec_test + ([], + [{'_',[],[{message,{set_tcw, OldTCW+1}}]}], + trace), + ?line {ok, OldTCW,_,_} = erlang:match_spec_test + ([],[{'_',[],[{message,{get_tcw}}]}],trace), + ok. + +boxed_and_small(doc) -> + ["Test that the comparision between boxed and small does not crash emulator"]; +boxed_and_small(suite) -> []; +boxed_and_small(Config) when is_list(Config) -> + ?line {ok, Node} = start_node(match_spec_suite_other), + ?line ok = rpc:call(Node,?MODULE,do_boxed_and_small,[]), + ?line stop_node(Node), + ok. + +do_boxed_and_small() -> + {ok, false, _, _} = erlang:match_spec_test({0,3},[{{1.47,'_'},[],['$_']}],table), + {ok, false, _, _} = erlang:match_spec_test({0,3},[{{12345678901234567890,'_'},[],['$_']}],table), + {ok, false, _, _} = erlang:match_spec_test({0,3},[{{<<1,2,3,4>>,'_'},[],['$_']}],table), + {ok, false, _, _} = erlang:match_spec_test({0,3},[{{make_ref(),'_'},[],['$_']}],table), + ok. + +errchk(Pat) -> + case catch erlang:trace_pattern({?MODULE, f2, 2}, Pat) of + {'EXIT', {badarg, _}} -> + ok; + Other -> + test_server:fail({noerror, Other}) + end. + +unary_minus(suite) -> + []; +unary_minus(doc) -> + ["Checks that unary minus works"]; +unary_minus(Config) when is_list(Config) -> + ?line {ok,true,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'<',{'-','$1'},-4}], + [true]}], + table), + ?line {ok,false,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'<',{'-','$1'},-6}], + [true]}], + table), + ?line {ok,true,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'=:=',{'-','$1',2},3}], + [true]}], + table), + ?line {ok,false,[],[]} = erlang:match_spec_test + (hej, + [{'$1', + [{'=/=',{'-','$1'},0}], + [true]}], + table), + ok. +unary_plus(suite) -> + []; +unary_plus(doc) -> + ["Checks that unary plus works"]; +unary_plus(Config) when is_list(Config) -> + ?line {ok,true,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'<',{'+','$1'},6}], + [true]}], + table), + ?line {ok,false,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'<',{'+','$1'},4}], + [true]}], + table), + ?line {ok,true,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'=:=',{'+','$1',2},7}], + [true]}], + table), + ?line {ok,false,[],[]} = erlang:match_spec_test + (hej, + [{'$1', + [{'=/=',{'+','$1'},0}], + [true]}], + table), + ok. + + + + +guard_exceptions(suite) -> + []; +guard_exceptions(doc) -> + ["Checks that exceptions in guards are handled correctly"]; +guard_exceptions(Config) when is_list(Config) -> + ?line {ok,false,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'or',{is_integer,'$1'},{'or','$1','$1'}}], + [true]}], + table), + ?line {ok,true,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'orelse',{is_integer,'$1'}, + {'or','$1','$1'}}], + [true]}], + table), + ?line {ok,false,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'orelse',{'or','$1',true}, + {is_integer,'$1'}}], + [true]}], + table), + ?line {ok,false,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'or',{is_integer,'$1'}, + {'orelse','$1',true}}], + [true]}], + table), + ?line {ok,true,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'or',{is_integer,'$1'}, + {'orelse',true,'$1'}}], + [true]}], + table), + ?line {ok,true,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'or',{is_integer,'$1'}, + {'andalso',false,'$1'}}], + [true]}], + table), + ?line {ok,false,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'or',{is_integer,'$1'}, + {'andalso','$1',false}}], + [true]}], + table), + + ?line {ok,false,[],[]} = erlang:match_spec_test + (5, + [{'$1', + [{'or',{is_integer,'$1'}, + {'andalso','$1',false}}], + [true]}], + table), + + ok. + +fpe(suite) -> + []; +fpe(doc) -> + ["Checks floating point exceptions in match-specs"]; +fpe(Config) when is_list(Config) -> + MS = [{{'$1'},[],[{'/','$1',0}]}], + case catch (['EXIT','EXIT'] = + ets:match_spec_run([{1},{2}],ets:match_spec_compile(MS))) of + {'EXIT',_} -> test_server:fail({error, + "Floating point exceptions faulty"}); + _ -> ok + end. + +moving_labels(Config) when is_list(Config) -> + %% Force an andalso/orelse construction to be moved by placing it + %% in a tuple followed by a constant term. Labels should still + %% point at their correct target. + %% + Ms = [{{'$1','$2'},[],[{{ok,{'andalso','$1','$2'},[1,2,3]}}]}], + ?line {ok,{ok,false,[1,2,3]},[],[]} = + erlang:match_spec_test({true,false}, Ms, table), + + Ms2 = [{{'$1','$2'},[],[{{ok,{'orelse','$1','$2'},[1,2,3]}}]}], + ?line {ok,{ok,true,[1,2,3]},[],[]} = + erlang:match_spec_test({true,false}, Ms2, table), + + ok. + +tr(Fun, MFA, Pat, Expected) -> + tr(Fun, MFA, [call], Pat, [global], Expected). + +tr(Fun, MFA, TraceFlags, Pat, PatFlags, Expected0) -> + tr(Fun, + fun(P) -> + erlang:trace(P, true, TraceFlags), + erlang:trace_pattern(MFA, Pat, PatFlags), + lists:map( + fun(X) -> + list_to_tuple([trace, P | tuple_to_list(X)]) + end, + Expected0) + end). + +tr(RunFun, ControlFun) -> + P = spawn(?MODULE, runner, [self(), RunFun]), + collect(P, ControlFun(P)). + +collect(P, TMs) -> + start_collect(P), + collect(TMs), + stop_collect(P). + +collect([]) -> + receive + M -> + ?t:format("Got unexpected: ~p~n", [M]), + flush({got_unexpected,M}) + after 17 -> + ok + end; +collect([TM | TMs]) -> + ?t:format( "Expecting: ~p~n", [TM]), + receive + M -> + case if element(1, M) == trace_ts -> + list_to_tuple(lists:reverse( + tl(lists:reverse(tuple_to_list(M))))); + true -> M + end of + TM -> + ?t:format("Got: ~p~n", [M]), + collect(TMs); + _ -> + ?t:format("Got unexpected: ~p~n", [M]), + flush({got_unexpected,M}) + end + end. + +flush(Reason) -> + receive + M -> + ?t:format("In queue: ~p~n", [M]), + flush(Reason) + after 17 -> + ?t:fail(Reason) + end. + +start_collect(P) -> + P ! {go, self()}. + +stop_collect(P) -> + P ! {done, self()}, + receive + {gone, P} -> + ok + end. + + +runner(Collector, Fun) -> + receive + {go, Collector} -> + go + end, + Fun(), + receive + {done, Collector} -> + Collector ! {gone, self()} + end. + +f1(X) -> + {X}. + +f2(X, Y) -> + {X, Y}. + +f3(X,Y) -> + ?MODULE:f2(X,Y), + ok. + +fn(X) -> + [X]. +fn(X, Y) -> + [X, Y]. +fn(X, Y, Z) -> + [X, Y, Z]. + +id(X) -> + X. + +start_node(Name) -> + Pa = filename:dirname(code:which(?MODULE)), + Cookie = atom_to_list(erlang:get_cookie()), + test_server:start_node(Name, slave, + [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). + +stop_node(Node) -> + test_server:stop_node(Node). diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl new file mode 100644 index 0000000000..f34a2b496c --- /dev/null +++ b/erts/emulator/test/module_info_SUITE.erl @@ -0,0 +1,105 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(module_info_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,end_per_testcase/2, + exports/1,functions/1,native/1]). + +%%-compile(native). + +%% Helper. +-export([native_proj/1,native_filter/1]). + +all(suite) -> + [exports,functions,native]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(3)), + [{watchdog,Dog}|Config]. + +end_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +%% Should return all functions exported from this module. (local) +all_exported() -> + All = add_arity(all(suite)), + lists:sort([{all,1},{init_per_testcase,2},{end_per_testcase,2}, + {module_info,0},{module_info,1},{native_proj,1}, + {native_filter,1}|All]). + +%% Should return all functions in this module. (local) +all_functions() -> + Locals = [{add_arity,1},{add_arity,2},{all_exported,0},{all_functions,0}], + lists:sort(Locals++all_exported()). + +%% Test that the list of exported functions from this module is correct. +exports(Config) when is_list(Config) -> + ?line All = all_exported(), + ?line All = lists:sort(?MODULE:module_info(exports)), + ?line (catch ?MODULE:foo()), + ?line All = lists:sort(?MODULE:module_info(exports)), + ok. + +%% Test that the list of exported functions from this module is correct. +functions(Config) when is_list(Config) -> + ?line All = all_functions(), + ?line All = lists:sort(?MODULE:module_info(functions)), + ok. + +%% Test that the list of exported functions from this module is correct. +native(Config) when is_list(Config) -> + ?line All = all_functions(), + ?line case ?MODULE:module_info(native_addresses) of + [] -> + {comment,"no native functions"}; + L -> + %% Verify that all functions have unique addresses. + ?line S0 = sofs:set(L, [{name,arity,addr}]), + ?line S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0), + ?line S2 = sofs:relation_to_family(S1), + ?line S3 = sofs:family_specification(fun ?MODULE:native_filter/1, S2), + ?line 0 = sofs:no_elements(S3), + ?line S4 = sofs:range(S1), + + %% Verify that the set of function with native addresses + %% is a subset of all functions in the module. + ?line AllSet = sofs:set(All, [{name,arity}]), + ?line true = sofs:is_subset(S4, AllSet), + + {comment,integer_to_list(sofs:no_elements(S0))++" native functions"} + end. + +native_proj({Name,Arity,Addr}) -> + {Addr,{Name,Arity}}. + +native_filter(Set) -> + sofs:no_elements(Set) =/= 1. + +%% Helper functions (local). + +add_arity(L) -> + add_arity(L, []). + +add_arity([H|T], Acc) -> + add_arity(T, [{H,1}|Acc]); +add_arity([], Acc) -> lists:reverse(Acc). diff --git a/erts/emulator/test/monitor_SUITE.erl b/erts/emulator/test/monitor_SUITE.erl new file mode 100644 index 0000000000..68e378dfec --- /dev/null +++ b/erts/emulator/test/monitor_SUITE.erl @@ -0,0 +1,943 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(monitor_SUITE). + +-include("test_server.hrl"). + +-export([all/1, + case_1/1, case_1a/1, case_2/1, case_2a/1, mon_e_1/1, demon_e_1/1, demon_1/1, + demon_2/1, demon_3/1, demonitor_flush/1, remove_monitor/1, + local_remove_monitor/1, remote_remove_monitor/1, mon_1/1, mon_2/1, + large_exit/1, list_cleanup/1, mixer/1, named_down/1, otp_5827/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-export([y2/1, g/1, g0/0, g1/0, large_exit_sub/1]). + +all(suite) -> + [case_1, case_1a, case_2, case_2a, mon_e_1, demon_e_1, demon_1, mon_1, + mon_2, demon_2, demon_3, demonitor_flush, remove_monitor, + large_exit, list_cleanup, mixer, named_down, + otp_5827]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(15)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +case_1(doc) -> + "A monitors B, B kills A and then exits (yielded core dump)"; +case_1(suite) -> []; +case_1(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line spawn_link(?MODULE, g0, []), + ?line receive _ -> ok end, + ok. + +case_1a(doc) -> + "A monitors B, B kills A and then exits (yielded core dump)"; +case_1a(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line spawn_link(?MODULE, g1, []), + ?line receive _ -> ok end, + ok. + +g0() -> + ?line B = spawn(?MODULE, g, [self()]), + ?line erlang:monitor(process, B), + ?line B ! ok, + ?line receive ok -> ok end, + ok. + +g1() -> + ?line {B,_} = spawn_monitor(?MODULE, g, [self()]), + ?line B ! ok, + ?line receive ok -> ok end, + ok. + +g(Parent) -> + ?line receive ok -> ok end, + ?line exit(Parent, foo), + ?line ok. + + +case_2(doc) -> + "A monitors B, B demonitors A (yielded core dump)"; +case_2(Config) when is_list(Config) -> + ?line B = spawn(?MODULE, y2, [self()]), + ?line R = erlang:monitor(process, B), + ?line B ! R, + ?line receive + {'EXIT', _} -> ok; + Other -> + test_server:fail({rec, Other}) + end, + ?line expect_down(R, B, normal), + ok. + +case_2a(doc) -> + "A monitors B, B demonitors A (yielded core dump)"; +case_2a(Config) when is_list(Config) -> + ?line {B,R} = spawn_monitor(?MODULE, y2, [self()]), + ?line B ! R, + ?line receive + {'EXIT', _} -> ok; + Other -> + test_server:fail({rec, Other}) + end, + ?line expect_down(R, B, normal), + ok. + +y2(Parent) -> + ?line R = receive T -> T end, + ?line Parent ! (catch erlang:demonitor(R)), + ok. + +expect_down(Ref, P) -> + receive + {'DOWN', Ref, process, P, Reason} -> + Reason; + Other -> + test_server:fail({rec, Other}) + end. + +expect_down(Ref, P, Reason) -> + receive + {'DOWN', Ref, process, P, Reason} -> + ok; + Other -> + test_server:fail({rec, Other}) + end. + +expect_no_msg() -> + receive + Msg -> + test_server:fail({msg, Msg}) + after 0 -> + ok + end. + +%%% Error cases for monitor/2 + +mon_e_1(doc) -> + "Error cases for monitor/2"; +mon_e_1(suite) -> []; +mon_e_1(Config) when is_list(Config) -> + ?line {ok, N} = test_server:start_node(hej, slave, []), + ?line mon_error(plutt, self()), + ?line mon_error(process, [bingo]), + ?line mon_error(process, {rex, N, junk}), + ?line mon_error(process, 1), + + ?line true = test_server:stop_node(N), + ok. + +%%% We would also like to have a test case that tries to monitor something +%%% on an R5 node, but this isn't possible to do systematically. +%%% +%%% Likewise against an R6 node, which is not capable of monitoring +%%% by name, which gives a badarg on the R7 node at the call to +%%% erlang:monitor(process, {Name, Node}). This has been tested +%%% manually at least once. + +mon_error(Type, Item) -> + case catch erlang:monitor(Type, Item) of + {'EXIT', _} -> + ok; + Other -> + test_server:fail({err, Other}) + end. + +%%% Error cases for demonitor/1 + +demon_e_1(doc) -> + "Error cases for demonitor/1"; +demon_e_1(suite) -> []; +demon_e_1(Config) when is_list(Config) -> + ?line {ok, N} = test_server:start_node(hej, slave, []), + ?line demon_error(plutt, badarg), + ?line demon_error(1, badarg), + + %% Demonitor with ref created at other node + ?line R1 = rpc:call(N, erlang, make_ref, []), + ?line demon_error(R1, badarg), + + %% Demonitor with ref created at wrong monitor link end + ?line P0 = self(), + ?line P2 = spawn( + fun() -> + P0 ! {self(), ref, erlang:monitor(process,P0)}, + receive {P0, stop} -> ok end + end ), + ?line receive + {P2, ref, R2} -> + ?line demon_error(R2, badarg), + ?line P2 ! {self(), stop}; + Other2 -> + test_server:fail({rec, Other2}) + end, + + ?line true = test_server:stop_node(N), + ok. + +demon_error(Ref, Reason) -> + case catch erlang:demonitor(Ref) of + {'EXIT', {Reason, _}} -> + ok; + Other -> + test_server:fail({err, Other}) + end. + +%%% No-op cases for demonitor/1 + +demon_1(doc) -> + "demonitor/1"; +demon_1(suite) -> []; +demon_1(Config) when is_list(Config) -> + ?line true = erlang:demonitor(make_ref()), + ok. + + +%%% Cases for demonitor/1 + +demon_2(doc) -> + "Cases for demonitor/1"; +demon_2(suite) -> []; +demon_2(Config) when is_list(Config) -> + ?line R1 = erlang:monitor(process, self()), + ?line true = erlang:demonitor(R1), + %% Extra demonitor + ?line true = erlang:demonitor(R1), + ?line expect_no_msg(), + + %% Normal 'DOWN' + ?line P2 = spawn(timer, sleep, [1]), + ?line R2 = erlang:monitor(process, P2), + ?line case expect_down(R2, P2) of + normal -> ?line ok; + noproc -> ?line ok; + BadReason -> ?line ?t:fail({bad_reason, BadReason}) + end, + +%% OTP-5772 +% %% 'DOWN' before demonitor +% ?line P3 = spawn(timer, sleep, [100000]), +% ?line R3 = erlang:monitor(process, P3), +% ?line exit(P3, frop), +% ?line erlang:demonitor(R3), +% ?line expect_down(R3, P3, frop), + + %% Demonitor before 'DOWN' + ?line P4 = spawn(timer, sleep, [100000]), + ?line R4 = erlang:monitor(process, P4), + ?line erlang:demonitor(R4), + ?line exit(P4, frop), + ?line expect_no_msg(), + + ok. + +demon_3(doc) -> + "Distributed case for demonitor/1 (OTP-3499)"; +demon_3(suite) -> []; +demon_3(Config) when is_list(Config) -> + ?line {ok, N} = test_server:start_node(hej, slave, []), + + %% 'DOWN' before demonitor + ?line P2 = spawn(N, timer, sleep, [100000]), + ?line R2 = erlang:monitor(process, P2), + ?line true = test_server:stop_node(N), + ?line true = erlang:demonitor(R2), + ?line expect_down(R2, P2, noconnection), + + ?line {ok, N2} = test_server:start_node(hej, slave, []), + + %% Demonitor before 'DOWN' + ?line P3 = spawn(N2, timer, sleep, [100000]), + ?line R3 = erlang:monitor(process, P3), + ?line true = erlang:demonitor(R3), + ?line true = test_server:stop_node(N2), + ?line expect_no_msg(), + + ok. + +demonitor_flush(suite) -> []; +demonitor_flush(doc) -> []; +demonitor_flush(Config) when is_list(Config) -> + ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), flush)), + ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(make_ref(), [flus])), + ?line {'EXIT', {badarg, _}} = (catch erlang:demonitor(x, [flush])), + ?line {ok, N} = test_server:start_node(demonitor_flush, slave, []), + ?line ok = demonitor_flush_test(N), + ?line true = test_server:stop_node(N), + ?line ok = demonitor_flush_test(node()). + +demonitor_flush_test(Node) -> + ?line P = spawn(Node, timer, sleep, [100000]), + ?line M1 = erlang:monitor(process, P), + ?line M2 = erlang:monitor(process, P), + ?line M3 = erlang:monitor(process, P), + ?line M4 = erlang:monitor(process, P), + ?line true = erlang:demonitor(M1, [flush, flush]), + ?line exit(P, bang), + ?line receive {'DOWN', M2, process, P, bang} -> ok end, + ?line receive after 100 -> ok end, + ?line true = erlang:demonitor(M3, [flush]), + ?line true = erlang:demonitor(M4, []), + ?line receive {'DOWN', M4, process, P, bang} -> ok end, + ?line receive + {'DOWN', M, _, _, _} =DM when M == M1, + M == M3 -> + ?line ?t:fail({unexpected_down_message, DM}) + after 100 -> + ?line ok + end. + +-define(RM_MON_GROUPS, 100). +-define(RM_MON_GPROCS, 100). + +remove_monitor(suite) -> + [local_remove_monitor, remote_remove_monitor]. + +local_remove_monitor(Config) when is_list(Config) -> + Gs = generate(fun () -> start_remove_monitor_group(node()) end, + ?RM_MON_GROUPS), + {True, False} = lists:foldl(fun (G, {T, F}) -> + receive + {rm_mon_res, G, {GT, GF}} -> + {T+GT, F+GF} + end + end, + {0, 0}, + Gs), + erlang:display({local_remove_monitor, True, False}), + {comment, + "True = "++integer_to_list(True)++"; False = "++integer_to_list(False)}. + +remote_remove_monitor(Config) when is_list(Config) -> + ?line {ok, N} = test_server:start_node(demonitor_flush, slave, []), + Gs = generate(fun () -> start_remove_monitor_group(node()) end, + ?RM_MON_GROUPS), + {True, False} = lists:foldl(fun (G, {T, F}) -> + receive + {rm_mon_res, G, {GT, GF}} -> + {T+GT, F+GF} + end + end, + {0, 0}, + Gs), + erlang:display({remote_remove_monitor, True, False}), + ?line true = test_server:stop_node(N), + {comment, + "True = "++integer_to_list(True)++"; False = "++integer_to_list(False)}. + +start_remove_monitor_group(Node) -> + Master = self(), + spawn_link( + fun () -> + Ms = generate(fun () -> + P = spawn(Node, fun () -> ok end), + erlang:monitor(process, P) + end, ?RM_MON_GPROCS), + Res = lists:foldl(fun (M, {T, F}) -> + case erlang:demonitor(M, [info]) of + true -> + receive + {'DOWN', M, _, _, _} -> + exit(down_msg_found) + after 0 -> + ok + end, + {T+1, F}; + false -> + receive + {'DOWN', M, _, _, _} -> + ok + after 0 -> + exit(no_down_msg_found) + end, + {T, F+1} + end + end, + {0,0}, + Ms), + Master ! {rm_mon_res, self(), Res} + end). + + +%%% Cases for monitor/2 + +mon_1(doc) -> + "Cases for monitor/2"; +mon_1(suite) -> []; +mon_1(Config) when is_list(Config) -> + %% Normal case + ?line P2 = spawn(timer, sleep, [1]), + ?line R2 = erlang:monitor(process, P2), + ?line case expect_down(R2, P2) of + normal -> ?line ok; + noproc -> ?line ok; + BadReason -> ?line ?t:fail({bad_reason, BadReason}) + end, + ?line {P2A,R2A} = spawn_monitor(timer, sleep, [1]), + ?line expect_down(R2A, P2A, normal), + + %% 'DOWN' with other reason + ?line P3 = spawn(timer, sleep, [100000]), + ?line R3 = erlang:monitor(process, P3), + ?line exit(P3, frop), + ?line expect_down(R3, P3, frop), + ?line {P3A,R3A} = spawn_monitor(timer, sleep, [100000]), + ?line exit(P3A, frop), + ?line expect_down(R3A, P3A, frop), + + %% Monitor fails because process is dead + ?line R4 = erlang:monitor(process, P3), + ?line expect_down(R4, P3, noproc), + + %% Normal case (named process) + ?line P5 = start_jeeves(jeeves), + ?line R5 = erlang:monitor(process, jeeves), + ?line tell_jeeves(P5, stop), + ?line expect_down(R5, {jeeves, node()}, normal), + + %% 'DOWN' with other reason and node explicit activation + ?line P6 = start_jeeves(jeeves), + ?line R6 = erlang:monitor(process, {jeeves, node()}), + ?line tell_jeeves(P6, {exit, frop}), + ?line expect_down(R6, {jeeves, node()}, frop), + + %% Monitor (named process) fails because process is dead + ?line R7 = erlang:monitor(process, {jeeves, node()}), + ?line expect_down(R7, {jeeves, node()}, noproc), + + ok. + +mon_2(doc) -> + "Distributed cases for monitor/2"; +mon_2(suite) -> []; +mon_2(Config) when is_list(Config) -> + ?line {ok, N1} = test_server:start_node(hej1, slave, []), + + %% Normal case + ?line P2 = spawn(N1, timer, sleep, [4000]), + ?line R2 = erlang:monitor(process, P2), + ?line expect_down(R2, P2, normal), + + %% 'DOWN' with other reason + ?line P3 = spawn(N1, timer, sleep, [100000]), + ?line R3 = erlang:monitor(process, P3), + ?line exit(P3, frop), + ?line expect_down(R3, P3, frop), + + %% Monitor fails because process is dead + ?line R4 = erlang:monitor(process, P3), + ?line expect_down(R4, P3, noproc), + + %% Other node goes down + ?line P5 = spawn(N1, timer, sleep, [100000]), + ?line R5 = erlang:monitor(process, P5), + + ?line true = test_server:stop_node(N1), + + ?line expect_down(R5, P5, noconnection), + + %% Monitor fails because other node is dead + ?line P6 = spawn(N1, timer, sleep, [100000]), + ?line R6 = erlang:monitor(process, P6), + ?line R6_Reason = expect_down(R6, P6), + ?line true = (R6_Reason == noconnection) orelse (R6_Reason == noproc), + + %% Start a new node that can load code in this module + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, N2} = test_server:start_node + (hej2, slave, [{args, "-pa " ++ PA}]), + + %% Normal case (named process) + ?line P7 = start_jeeves({jeeves, N2}), + ?line R7 = erlang:monitor(process, {jeeves, N2}), + ?line tell_jeeves(P7, stop), + ?line expect_down(R7, {jeeves, N2}, normal), + + %% 'DOWN' with other reason (named process) + ?line P8 = start_jeeves({jeeves, N2}), + ?line R8 = erlang:monitor(process, {jeeves, N2}), + ?line tell_jeeves(P8, {exit, frop}), + ?line expect_down(R8, {jeeves, N2}, frop), + + %% Monitor (named process) fails because process is dead + ?line R9 = erlang:monitor(process, {jeeves, N2}), + ?line expect_down(R9, {jeeves, N2}, noproc), + + %% Other node goes down (named process) + ?line _P10 = start_jeeves({jeeves, N2}), + ?line R10 = erlang:monitor(process, {jeeves, N2}), + + ?line true = test_server:stop_node(N2), + + ?line expect_down(R10, {jeeves, N2}, noconnection), + + %% Monitor (named process) fails because other node is dead + ?line R11 = erlang:monitor(process, {jeeves, N2}), + ?line expect_down(R11, {jeeves, N2}, noconnection), + + ok. + +%%% Large exit reason. Crashed first attempt to release R5B. + +large_exit(doc) -> + "Large exit reason"; +large_exit(suite) -> []; +large_exit(Config) when is_list(Config) -> + ?line f(100), + ok. + +f(0) -> + ok; +f(N) -> + f(), + f(N-1). + +f() -> + ?line S0 = {big, tuple, with, [list, 4563784278]}, + ?line S = {S0, term_to_binary(S0)}, + ?line P = spawn(?MODULE, large_exit_sub, [S]), + ?line R = erlang:monitor(process, P), + ?line P ! hej, + receive + {'DOWN', R, process, P, X} -> + ?line io:format(" -> ~p~n", [X]), + if + X == S -> + ok; + true -> + test_server:fail({X, S}) + end; + Other -> + ?line io:format(" -> ~p~n", [Other]), + exit({answer, Other}) + end. + +large_exit_sub(S) -> + receive _X -> ok end, + exit(S). + +%%% Testing of monitor link list cleanup +%%% by using erlang:process_info(self(), monitors) +%%% and erlang:process_info(self(), monitored_by) + +list_cleanup(doc) -> + "Testing of monitor link list cleanup by using " ++ + "erlang:process_info/2"; +list_cleanup(suite) -> []; +list_cleanup(Config) when is_list(Config) -> + ?line P0 = self(), + ?line M = node(), + ?line PA = filename:dirname(code:which(?MODULE)), + ?line true = register(master_bertie, self()), + + %% Normal local case, monitor and demonitor + ?line P1 = start_jeeves(jeeves), + ?line {[], []} = monitors(), + ?line expect_jeeves(P1, monitors, {monitors, {[], []}}), + ?line R1a = erlang:monitor(process, P1), + ?line {[{process, P1}], []} = monitors(), + ?line expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), + ?line true = erlang:demonitor(R1a), + ?line expect_no_msg(), + ?line {[], []} = monitors(), + ?line expect_jeeves(P1, monitors, {monitors, {[], []}}), + %% Remonitor named and try again, now exiting the monitored process + ?line R1b = erlang:monitor(process, jeeves), + ?line {[{process, {jeeves, M}}], []} = monitors(), + ?line expect_jeeves(P1, monitors, {monitors, {[], [P0]}}), + ?line tell_jeeves(P1, stop), + ?line expect_down(R1b, {jeeves, node()}, normal), + ?line {[], []} = monitors(), + + %% Slightly weird local case - the monitoring process crashes + ?line P2 = start_jeeves(jeeves), + ?line {[], []} = monitors(), + ?line expect_jeeves(P2, monitors, {monitors, {[], []}}), + ?line {monitor_process, _R2} = + ask_jeeves(P2, {monitor_process, master_bertie}), + ?line {[], [P2]} = monitors(), + ?line expect_jeeves(P2, monitors, + {monitors, {[{process, {master_bertie, node()}}], []}}), + ?line tell_jeeves(P2, {exit, frop}), + timer:sleep(2000), + ?line {[], []} = monitors(), + + %% Start a new node that can load code in this module + ?line {ok, J} = test_server:start_node + (jeeves, slave, [{args, "-pa " ++ PA}]), + + %% Normal remote case, monitor and demonitor + ?line P3 = start_jeeves({jeeves, J}), + ?line {[], []} = monitors(), + ?line expect_jeeves(P3, monitors, {monitors, {[], []}}), + ?line R3a = erlang:monitor(process, P3), + ?line {[{process, P3}], []} = monitors(), + ?line expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), + ?line true = erlang:demonitor(R3a), + ?line expect_no_msg(), + ?line {[], []} = monitors(), + ?line expect_jeeves(P3, monitors, {monitors, {[], []}}), + %% Remonitor named and try again, now exiting the monitored process + ?line R3b = erlang:monitor(process, {jeeves, J}), + ?line {[{process, {jeeves, J}}], []} = monitors(), + ?line expect_jeeves(P3, monitors, {monitors, {[], [P0]}}), + ?line tell_jeeves(P3, stop), + ?line expect_down(R3b, {jeeves, J}, normal), + ?line {[], []} = monitors(), + + %% Slightly weird remote case - the monitoring process crashes + ?line P4 = start_jeeves({jeeves, J}), + ?line {[], []} = monitors(), + ?line expect_jeeves(P4, monitors, {monitors, {[], []}}), + ?line {monitor_process, _R4} = + ask_jeeves(P4, {monitor_process, {master_bertie, M}}), + ?line {[], [P4]} = monitors(), + ?line expect_jeeves(P4, monitors, + {monitors, {[{process, {master_bertie, M}}], []}} ), + ?line tell_jeeves(P4, {exit, frop}), + timer:sleep(2000), + ?line {[], []} = monitors(), + + %% Now, the monitoring remote node crashes + ?line P5 = start_jeeves({jeeves, J}), + ?line {[], []} = monitors(), + ?line expect_jeeves(P5, monitors, {monitors, {[], []}}), + ?line {monitor_process, _R5} = + ask_jeeves(P5, {monitor_process, P0}), + ?line {[], [P5]} = monitors(), + ?line expect_jeeves(P5, monitors, + {monitors, {[{process, P0}], []}} ), + ?line test_server:stop_node(J), + timer:sleep(4000), + ?line {[], []} = monitors(), + + ?line true = unregister(master_bertie), + ok. + + +%%% Mixed internal and external monitors + +mixer(doc) -> + "Test mixing of internal and external monitors."; +mixer(Config) when is_list(Config) -> + ?line PA = filename:dirname(code:which(?MODULE)), + ?line NN = [j0,j1,j2,j3], +% ?line NN = [j0,j1], + ?line NL0 = [begin + {ok, J} = test_server:start_node + (X, slave, [{args, "-pa " ++ PA}]), + J + end || X <- NN], + ?line NL1 = lists:duplicate(2,node()) ++ NL0, + ?line Perm = perm(NL1), + ?line lists:foreach( + fun(NL) -> + ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], + ?line [ask_jeeves(P,{monitor_process,self()}) || P <- Js], + ?line {monitored_by,MB} = + process_info(self(),monitored_by), + ?line MBL = lists:sort(MB), + ?line JsL = lists:sort(Js), + ?line MBL = JsL, + ?line {monitors,[]} = process_info(self(),monitors), + ?line [tell_jeeves(P,{exit,flaff}) || P <- Js], + ?line wait_for_m([],[],200) + end, + Perm), + ?line lists:foreach( + fun(NL) -> + ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], + ?line Rs = [begin + {monitor_process,Ref} = + ask_jeeves(P,{monitor_process,self()}), + {P,Ref} + end + || P <- Js], + ?line {monitored_by,MB} = + process_info(self(),monitored_by), + ?line MBL = lists:sort(MB), + ?line JsL = lists:sort(Js), + ?line MBL = JsL, + ?line {monitors,[]} = process_info(self(),monitors), + ?line [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], + ?line wait_for_m([],[],200), + ?line [tell_jeeves(P,{exit,flaff}) || P <- Js] + end, + Perm), + ?line lists:foreach( + fun(NL) -> + ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], + ?line [ask_jeeves(P,{monitor_process,self()}) || P <- Js], + ?line [erlang:monitor(process,P) || P <- Js], + ?line {monitored_by,MB} = + process_info(self(),monitored_by), + ?line MBL = lists:sort(MB), + ?line JsL = lists:sort(Js), + ?line MBL = JsL, + ?line {monitors,M} = + process_info(self(),monitors), + ?line ML = lists:sort([P||{process,P} <- M]), + ?line ML = JsL, + ?line [begin + tell_jeeves(P,{exit,flaff}), + receive {'DOWN',_,process,P,_} -> ok end + end || P <- Js], + ?line wait_for_m([],[],200) + end, + Perm), + ?line lists:foreach( + fun(NL) -> + ?line Js = [ start_jeeves({[],M}) || M <- (NL ++ NL) ], + ?line Rs = [begin + {monitor_process,Ref} = + ask_jeeves(P,{monitor_process,self()}), + {P,Ref} + end + || P <- Js], + ?line R2s = [{P,erlang:monitor(process,P)} || P <- Js], + ?line {monitored_by,MB} = + process_info(self(),monitored_by), + ?line MBL = lists:sort(MB), + ?line JsL = lists:sort(Js), + ?line MBL = JsL, + ?line {monitors,M} = + process_info(self(),monitors), + ?line ML = lists:sort([P||{process,P} <- M]), + ?line ML = JsL, + ?line [ask_jeeves(P,{demonitor,Ref}) || {P,Ref} <- Rs], + ?line wait_for_m(lists:sort(M),[],200), + ?line [erlang:demonitor(Ref) || {_P,Ref} <- R2s], + ?line wait_for_m([],[],200), + ?line [tell_jeeves(P,{exit,flaff}) || P <- Js] + end, + Perm), + [test_server:stop_node(K) || K <- NL0 ], + ok. + +named_down(doc) -> ["Test that DOWN message for a named monitor isn't" + " delivered until name has been unregistered"]; +named_down(suite) -> []; +named_down(Config) when is_list(Config) -> + ?line {A,B,C} = now(), + ?line Name = list_to_atom(atom_to_list(?MODULE) + ++ "-named_down-" + ++ integer_to_list(A) + ++ "-" ++ integer_to_list(B) + ++ "-" ++ integer_to_list(C)), + ?line Prio = process_flag(priority,high), + %% Spawn a bunch of high prio cpu bound processes to prevent + %% normal prio processes from terminating during the next + %% 500 ms... + ?line Self = self(), + ?line spawn_opt(fun () -> + WFun = fun + (F, hej) -> F(F, hopp); + (F, hopp) -> F(F, hej) + end, + NoSchedulers = erlang:system_info(schedulers_online), + lists:foreach(fun (_) -> + spawn_opt(fun () -> + WFun(WFun, + hej) + end, + [{priority,high}, + link]) + end, + lists:seq(1, NoSchedulers)), + receive after 500 -> ok end, + unlink(Self), + exit(bang) + end, + [{priority,high}, link]), + ?line NamedProc = spawn_link(fun () -> + receive after infinity -> ok end + end), + ?line true = register(Name, NamedProc), + ?line unlink(NamedProc), + ?line exit(NamedProc, bang), + ?line Mon = erlang:monitor(process, Name), + ?line receive {'DOWN',Mon, _, _, _} -> ok end, + ?line true = register(Name, self()), + ?line true = unregister(Name), + ?line process_flag(priority,Prio), + ok. + +otp_5827(doc) -> []; +otp_5827(suite) -> []; +otp_5827(Config) when is_list(Config) -> + %% Make a pid with the same nodename but with another creation + ?line [CreEnd | RPTail] + = lists:reverse(binary_to_list(term_to_binary(self()))), + ?line NewCreEnd = case CreEnd of + 0 -> 1; + 1 -> 2; + _ -> CreEnd - 1 + end, + ?line OtherCreationPid + = binary_to_term(list_to_binary(lists:reverse([NewCreEnd | RPTail]))), + %% If the bug is present erlang:monitor(process, OtherCreationPid) + %% will hang... + ?line Parent = self(), + ?line Ok = make_ref(), + ?line spawn(fun () -> + Mon = erlang:monitor(process, OtherCreationPid), + % Should get the DOWN message right away + receive + {'DOWN', Mon, process, OtherCreationPid, noproc} -> + Parent ! Ok + end + end), + ?line receive + Ok -> + ?line ok + after 1000 -> + ?line ?t:fail("erlang:monitor/2 hangs") + end. + + +wait_for_m(_,_,0) -> + exit(monitor_wait_timeout); +wait_for_m(Monitors, MonitoredBy, N) -> + {monitors,M0} = process_info(self(),monitors), + {monitored_by,MB0} = process_info(self(),monitored_by), + case lists:sort(M0) of + Monitors -> + case lists:sort(MB0) of + MonitoredBy -> + ok; + _ -> + receive after 100 -> ok end, + wait_for_m(Monitors,MonitoredBy,N-1) + end; + _ -> + receive after 100 -> ok end, + wait_for_m(Monitors,MonitoredBy,N-1) + end. + +% All permutations of a list... +perm([]) -> + []; +perm([X]) -> + [[X]]; +perm(List) -> + perm([],List,[]). + +perm(_,[],Acc) -> + Acc; +perm(Pre,[El|Post],Acc) -> + Res = [[El|X] || X <- perm(Pre ++ Post)], + perm(Pre ++ [El], Post, Res ++ Acc). + + +%%% Our butler for named process monitor tests + +jeeves(Parent, Name, Ref) + when is_pid(Parent), (is_atom(Name) or (Name =:= [])), is_reference(Ref) -> + %%io:format("monitor_SUITE:jeeves(~p, ~p)~n", [Parent, Name]), + case Name of + Atom when is_atom(Atom) -> + register(Name, self()); + [] -> + ok + end, + Parent ! {self(), Ref}, + jeeves_loop(Parent). + +jeeves_loop(Parent) -> + receive + {Parent, monitors} -> + Parent ! {self(), {monitors, monitors()}}, + jeeves_loop(Parent); + {Parent, {monitor_process, P}} -> + Parent ! {self(), {monitor_process, + catch erlang:monitor(process, P) }}, + jeeves_loop(Parent); + {Parent, {demonitor, Ref}} -> + Parent ! {self(), {demonitor, catch erlang:demonitor(Ref)}}, + jeeves_loop(Parent); + {Parent, stop} -> + ok; + {Parent, {exit, Reason}} -> + exit(Reason); + Other -> + io:format("~p:jeeves_loop received ~p~n", [?MODULE, Other]) + end. + + +start_jeeves({Name, Node}) + when (is_atom(Name) or (Name =:= [])), is_atom(Node) -> + Parent = self(), + Ref = make_ref(), + Pid = spawn(Node, fun() -> jeeves(Parent, Name, Ref) end), + receive + {Pid, Ref} -> + ok; + Other -> + test_server:fail({rec, Other}) + end, + Pid; +start_jeeves(Name) when is_atom(Name) -> + start_jeeves({Name, node()}). + + +tell_jeeves(Pid, What) when is_pid(Pid) -> + Pid ! {self(), What}. + + +ask_jeeves(Pid, Request) when is_pid(Pid) -> + Pid ! {self(), Request}, + receive + {Pid, Response} -> + Response; + Other -> + test_server:fail({rec, Other}) + end. + + +expect_jeeves(Pid, Request, Response) when is_pid(Pid) -> + Pid ! {self(), Request}, + receive + {Pid, Response} -> + ok; + Other -> + test_server:fail({rec, Other}) + end. + + +monitors() -> + monitors(self()). + +monitors(Pid) when is_pid(Pid) -> + {monitors, Monitors} = process_info(self(), monitors), + {monitored_by, MonitoredBy} = process_info(self(), monitored_by), + {Monitors, MonitoredBy}. + +generate(_Fun, 0) -> + []; +generate(Fun, N) -> + [Fun() | generate(Fun, N-1)]. diff --git a/erts/emulator/test/nested_SUITE.erl b/erts/emulator/test/nested_SUITE.erl new file mode 100644 index 0000000000..310892424e --- /dev/null +++ b/erts/emulator/test/nested_SUITE.erl @@ -0,0 +1,92 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(nested_SUITE). + +-export([all/1, case_in_case/1, case_in_after/1, catch_in_catch/1, bif_in_bif/1]). + +-include("test_server.hrl"). + +all(suite) -> [case_in_case, case_in_after, catch_in_catch, bif_in_bif]. + +case_in_case(suite) -> []; +case_in_case(Config) when is_list(Config) -> + ?line done = search_any([a], [{a, 1}]), + ?line done = search_any([x], [{a, 1}]), + ok. + +search_any([Key|Rest], List) -> + ?line case case lists:keysearch(Key, 1, List) of + {value, _} -> + true; + _ -> + false + end of + true -> + ok; + false -> + error; + Other -> + test_server:fail({other_result, Other}) + end, + ?line search_any(Rest, List); +search_any([], _) -> + done. + +case_in_after(suite) -> []; +case_in_after(Config) when is_list(Config) -> + receive + after case {x, y, z} of + {x, y, z} -> 0 + end -> + ok + end, + ok. + +catch_in_catch(doc) -> "Test a catch within a catch in the same function."; +catch_in_catch(suite) -> []; +catch_in_catch(Config) when is_list(Config) -> + ?line {outer, inner_exit} = catcher(), + ok. + +catcher() -> + case (catch + case (catch ?MODULE:non_existing()) of % bogus function + {'EXIT', _} -> + inner_exit; + Res1 -> + {inner, Res1} + end) of + {'EXIT', _} -> + outer_exit; + Res2 -> + {outer, Res2} + end. + +bif_in_bif(doc) -> "Test a BIF call within a BIF call."; +bif_in_bif(suite) -> []; +bif_in_bif(Config) when is_list(Config) -> + Self = self(), + put(pid, Self), + Self = register_me(), + ok. + +register_me() -> + register(?MODULE, Pid = get(pid)), + Pid. diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl new file mode 100644 index 0000000000..213ff6637a --- /dev/null +++ b/erts/emulator/test/nif_SUITE.erl @@ -0,0 +1,235 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(nif_SUITE). + +%%-define(line_trace,true). + +-include("test_server.hrl"). + +-export([all/1, fin_per_testcase/2, basic/1, reload/1, upgrade/1, heap_frag/1, + neg/1]). + +-define(nif_stub,nif_stub_error(?LINE)). + +all(suite) -> + [basic, reload, upgrade, heap_frag, neg]. + +fin_per_testcase(_Func, _Config) -> + P1 = code:purge(nif_mod), + Del = code:delete(nif_mod), + P2 = code:purge(nif_mod), + io:format("fin purged=~p, deleted=~p and then purged=~p\n",[P1,Del,P2]). + +basic(doc) -> ["Basic smoke test of load_nif and a simple NIF call"]; +basic(suite) -> []; +basic(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + ?line true = (lib_version() =/= undefined), + ?line [{load,1,1,101},{lib_version,1,2,102}] = call_history(), + ?line [] = call_history(), + ?line [?MODULE] = erlang:system_info(taints), + ok. + +reload(doc) -> ["Test reload callback in nif lib"]; +reload(suite) -> []; +reload(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "nif_mod"), + ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + + ?line nif_mod:load_nif_lib(Config, 1), + + ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + + ?line nif_mod:load_nif_lib(Config, 2), + ?line 2 = nif_mod:lib_version(), + ?line [{reload,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), + + ?line nif_mod:load_nif_lib(Config, 1), + ?line 1 = nif_mod:lib_version(), + ?line [{reload,1,1,101},{lib_version,1,2,102}] = nif_mod_call_history(), + + ?line true = erlang:delete_module(nif_mod), + ?line [] = nif_mod_call_history(), + + %%?line false= check_process_code(Pid, nif_mod), + ?line true = erlang:purge_module(nif_mod), + ?line [{unload,1,3,103}] = nif_mod_call_history(), + + ?line [?MODULE, nif_mod] = erlang:system_info(taints), + ok. + +upgrade(doc) -> ["Test upgrade callback in nif lib"]; +upgrade(suite) -> []; +upgrade(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "nif_mod"), + ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + + ?line nif_mod:load_nif_lib(Config, 1), + ?line {Pid,MRef} = nif_mod:start(), + ?line 1 = call(Pid,lib_version), + + ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + ?line [{load,1,1,101},{lib_version,1,2,102},{get_priv_data_ptr,1,3,103}] = nif_mod_call_history(), + + %% Module upgrade with same lib-version + ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + ?line undefined = nif_mod:lib_version(), + ?line 1 = call(Pid,lib_version), + ?line [{lib_version,1,4,104}] = nif_mod_call_history(), + + ?line nif_mod:load_nif_lib(Config, 1), + ?line 1 = nif_mod:lib_version(), + ?line [{upgrade,1,5,105},{lib_version,1,6,106}] = nif_mod_call_history(), + + ?line upgraded = call(Pid,upgrade), + ?line false = check_process_code(Pid, nif_mod), + ?line true = erlang:purge_module(nif_mod), + ?line [{unload,1,7,107}] = nif_mod_call_history(), + + ?line 1 = nif_mod:lib_version(), + ?line [{lib_version,1,8,108}] = nif_mod_call_history(), + + ?line true = erlang:delete_module(nif_mod), + ?line [] = nif_mod_call_history(), + + ?line Pid ! die, + ?line {'DOWN', MRef, process, Pid, normal} = receive_any(), + ?line false = check_process_code(Pid, nif_mod), + ?line true = erlang:purge_module(nif_mod), + ?line [{unload,1,9,109}] = nif_mod_call_history(), + + %% Module upgrade with different lib version + ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + ?line undefined = nif_mod:lib_version(), + ?line {Pid2,MRef2} = nif_mod:start(), + ?line undefined = call(Pid2,lib_version), + + ?line nif_mod:load_nif_lib(Config, 1), + ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + ?line 1 = call(Pid2,lib_version), + ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102},{lib_version,1,3,103}] = nif_mod_call_history(), + + ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + ?line undefined = nif_mod:lib_version(), + ?line [] = nif_mod_call_history(), + ?line 1 = call(Pid2,lib_version), + ?line [{lib_version,1,4,104}] = nif_mod_call_history(), + + ?line nif_mod:load_nif_lib(Config, 2), + ?line 2 = nif_mod:lib_version(), + ?line [{upgrade,2,1,201},{lib_version,2,2,202}] = nif_mod_call_history(), + + ?line 1 = call(Pid2,lib_version), + ?line [{lib_version,1,5,105}] = nif_mod_call_history(), + + ?line upgraded = call(Pid2,upgrade), + ?line false = check_process_code(Pid2, nif_mod), + ?line true = erlang:purge_module(nif_mod), + ?line [{unload,1,6,106}] = nif_mod_call_history(), + + ?line 2 = nif_mod:lib_version(), + ?line [{lib_version,2,3,203}] = nif_mod_call_history(), + + ?line true = erlang:delete_module(nif_mod), + ?line [] = nif_mod_call_history(), + + ?line Pid2 ! die, + ?line {'DOWN', MRef2, process, Pid2, normal} = receive_any(), + ?line false= check_process_code(Pid2, nif_mod), + ?line true = erlang:purge_module(nif_mod), + ?line [{unload,2,4,204}] = nif_mod_call_history(), + + ?line [?MODULE, nif_mod] = erlang:system_info(taints), + ok. + +heap_frag(doc) -> ["Test NIF building heap fragments"]; +heap_frag(suite) -> []; +heap_frag(Config) when is_list(Config) -> + ensure_lib_loaded(Config), + + heap_frag_do(1,1000000), + ok. + +heap_frag_do(N, Max) when N > Max -> + ok; +heap_frag_do(N, Max) -> + io:format("Create list of length ~p\n",[N]), + L = lists:seq(1,N), + L = list_seq(N), + heap_frag_do(((N*5) div 4) + 1, Max). + + +neg(doc) -> ["Negative testing of load_nif"]; +neg(suite) -> []; +neg(Config) when is_list(Config) -> + ?line {'EXIT',{badarg,_}} = (catch erlang:load_nif(badarg, 0)), + ?line {error,load_failed,_} = erlang:load_nif("pink_unicorn", 0), + + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "nif_mod"), + ?line {ok,nif_mod,Bin} = compile:file(File, [binary,return_errors]), + ?line {module,nif_mod} = erlang:load_module(nif_mod,Bin), + + ?line {error,bad_lib,_} = nif_mod:load_nif_lib(Config, no_init), + ?line ok. + + + +ensure_lib_loaded(Config) -> + ensure_lib_loaded(Config, 1). + +ensure_lib_loaded(Config, Ver) -> + ?line case lib_version() of + undefined -> + ?line Path = ?config(data_dir, Config), + ?line Lib = "nif_SUITE." ++ integer_to_list(Ver), + ?line ok = erlang:load_nif(filename:join(Path,Lib), 0); + Ver when is_integer(Ver) -> + ok + end. + +call(Pid,Cmd) -> + %%io:format("~p calling ~p with ~p\n",[self(), Pid, Cmd]), + Pid ! {self(), Cmd}, + receive + {Pid,Reply} -> Reply + end. + +receive_any() -> + receive M -> M end. + +%% The NIFs: +lib_version() -> undefined. +call_history() -> ?nif_stub. +hold_nif_mod_priv_data(_Ptr) -> ?nif_stub. +nif_mod_call_history() -> ?nif_stub. +list_seq(_To) -> ?nif_stub. + +nif_stub_error(Line) -> + exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/Makefile.src b/erts/emulator/test/nif_SUITE_data/Makefile.src new file mode 100644 index 0000000000..6a8b4f1245 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ + +NIF_LIBS = nif_SUITE.1@dll@ \ + nif_mod.1@dll@ \ + nif_mod.2@dll@ \ + nif_mod.3@dll@ + +all: $(NIF_LIBS) + + +@SHLIB_RULES@ + +$(NIF_LIBS): nif_SUITE.c nif_mod.c nif_mod.h + + diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.1.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.1.c new file mode 100644 index 0000000000..71626043dd --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.1.c @@ -0,0 +1,2 @@ +#define NIF_SUITE_LIB_VER 1 +#include "nif_SUITE.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c new file mode 100644 index 0000000000..852495e234 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -0,0 +1,149 @@ +#include "erl_nif.h" +#include +#include + +#include "nif_mod.h" + +static int static_cntA; /* zero by default */ +static int static_cntB = NIF_SUITE_LIB_VER * 100; + +typedef struct +{ + int ref_cnt; + CallInfo* call_history; + NifModPrivData* nif_mod; +}PrivData; + +void add_call(ErlNifEnv* env, PrivData* data, const char* func_name) +{ + CallInfo* call = enif_alloc(env, sizeof(CallInfo)+strlen(func_name)); + strcpy(call->func_name, func_name); + call->lib_ver = NIF_SUITE_LIB_VER; + call->next = data->call_history; + call->static_cntA = ++static_cntA; + call->static_cntB = ++static_cntB; + data->call_history = call; +} + +#define ADD_CALL(FUNC_NAME) add_call(env, enif_get_data(env),FUNC_NAME) + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + PrivData* data = enif_alloc(env, sizeof(PrivData)); + assert(data != NULL); + data->ref_cnt = 1; + data->call_history = NULL; + data->nif_mod = NULL; + + add_call(env, data, "load"); + + *priv_data = data; + return 0; +} + +static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + add_call(env, *priv_data, "reload"); + return 0; +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) +{ + PrivData* data = *old_priv_data; + add_call(env, data, "upgrade"); + data->ref_cnt++; + *priv_data = *old_priv_data; + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + PrivData* data = priv_data; + add_call(env, data, "unload"); + if (--data->ref_cnt == 0) { + enif_free(env, priv_data); + } +} + +static ERL_NIF_TERM lib_version(ErlNifEnv* env) +{ + ADD_CALL("lib_version"); + return enif_make_int(env, NIF_SUITE_LIB_VER); +} + +static ERL_NIF_TERM make_call_history(ErlNifEnv* env, CallInfo** headp) +{ + ERL_NIF_TERM list = enif_make_list(env, 0); /* NIL */ + + while (*headp != NULL) { + CallInfo* call = *headp; + ERL_NIF_TERM tpl = enif_make_tuple(env, 4, + enif_make_atom(env,call->func_name), + enif_make_int(env,call->lib_ver), + enif_make_int(env,call->static_cntA), + enif_make_int(env,call->static_cntB)); + list = enif_make_list_cell(env, tpl, list); + *headp = call->next; + enif_free(env,call); + } + return list; +} + +static ERL_NIF_TERM call_history(ErlNifEnv* env) +{ + PrivData* data = (PrivData*) enif_get_data(env); + + return make_call_history(env,&data->call_history); +} + +static ERL_NIF_TERM hold_nif_mod_priv_data(ErlNifEnv* env, ERL_NIF_TERM a1) +{ + PrivData* data = (PrivData*) enif_get_data(env); + unsigned long ptr_as_ulong; + + if (!enif_get_ulong(env,a1,&ptr_as_ulong)) { + return enif_make_badarg(env); + } + if (data->nif_mod != NULL && --(data->nif_mod->ref_cnt) == 0) { + enif_free(env,data->nif_mod); + } + data->nif_mod = (NifModPrivData*) ptr_as_ulong; + return enif_make_int(env,++(data->nif_mod->ref_cnt)); +} + +static ERL_NIF_TERM nif_mod_call_history(ErlNifEnv* env) +{ + PrivData* data = (PrivData*) enif_get_data(env); + + if (data->nif_mod == NULL) { + return enif_make_string(env,"nif_mod pointer is NULL"); + } + return make_call_history(env,&data->nif_mod->call_history); +} + +static ERL_NIF_TERM list_seq(ErlNifEnv* env, ERL_NIF_TERM a1) +{ + ERL_NIF_TERM list; + int n; + if (!enif_get_int(env, a1, &n)) { + return enif_make_badarg(env); + } + list = enif_make_list(env, 0); /* NIL */ + while (n > 0) { + list = enif_make_list_cell(env, enif_make_int(env,n), list); + n--; + } + return list; +} + +static ErlNifFunc nif_funcs[] = +{ + {"lib_version", 0, lib_version}, + {"call_history", 0, call_history}, + {"hold_nif_mod_priv_data", 1, hold_nif_mod_priv_data}, + {"nif_mod_call_history", 0, nif_mod_call_history}, + {"list_seq", 1, list_seq} +}; + +ERL_NIF_INIT(nif_SUITE,nif_funcs,load,reload,upgrade,unload) + diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.1.c b/erts/emulator/test/nif_SUITE_data/nif_mod.1.c new file mode 100644 index 0000000000..5e508570bd --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.1.c @@ -0,0 +1,2 @@ +#define NIF_LIB_VER 1 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.2.c b/erts/emulator/test/nif_SUITE_data/nif_mod.2.c new file mode 100644 index 0000000000..5dd5d88766 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.2.c @@ -0,0 +1,2 @@ +#define NIF_LIB_VER 2 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.3.c b/erts/emulator/test/nif_SUITE_data/nif_mod.3.c new file mode 100644 index 0000000000..8cbcb748a3 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.3.c @@ -0,0 +1,2 @@ +#define NIF_LIB_VER 3 +#include "nif_mod.c" diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c new file mode 100644 index 0000000000..18f676335a --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c @@ -0,0 +1,103 @@ +#include "erl_nif.h" +#include +#include + +#include "nif_mod.h" + + +static int static_cntA; /* zero by default */ +static int static_cntB = NIF_LIB_VER * 100; + +static void add_call(ErlNifEnv* env, NifModPrivData* data, const char* func_name) +{ + CallInfo* call = enif_alloc(env, sizeof(CallInfo)+strlen(func_name)); + strcpy(call->func_name, func_name); + call->lib_ver = NIF_LIB_VER; + call->static_cntA = ++static_cntA; + call->static_cntB = ++static_cntB; + call->next = data->call_history; + data->call_history = call; +} + +#define ADD_CALL(FUNC_NAME) add_call(env, enif_get_data(env),FUNC_NAME) + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + NifModPrivData* data = enif_alloc(env, sizeof(NifModPrivData)); + assert(data != NULL); + data->ref_cnt = 1; + data->call_history = NULL; + add_call(env, data, "load"); + + data->calls = 0; + *priv_data = data; + return 0; +} + +static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + add_call(env, *priv_data, "reload"); + return 0; +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) +{ + NifModPrivData* data = *old_priv_data; + add_call(env, data, "upgrade"); + data->ref_cnt++; + *priv_data = *old_priv_data; + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ + NifModPrivData* data = priv_data; + add_call(env, data, "unload"); + if (--data->ref_cnt == 0) { + enif_free(env, data); + } +} + +static ERL_NIF_TERM lib_version(ErlNifEnv* env) +{ + ADD_CALL("lib_version"); + return enif_make_int(env, NIF_LIB_VER); +} + +static ERL_NIF_TERM call_history(ErlNifEnv* env) +{ + NifModPrivData* data = (NifModPrivData*) enif_get_data(env); + ERL_NIF_TERM list = enif_make_list(env, 0); /* NIL */ + + while (data->call_history != NULL) { + CallInfo* call = data->call_history; + ERL_NIF_TERM tpl = enif_make_tuple(env, 2, + enif_make_atom(env,call->func_name), + enif_make_int(env,call->lib_ver)); + list = enif_make_list_cell(env, tpl, list); + data->call_history = call->next; + enif_free(env,call); + } + return list; +} + +static ERL_NIF_TERM get_priv_data_ptr(ErlNifEnv* env) +{ + ADD_CALL("get_priv_data_ptr"); + return enif_make_ulong(env, (unsigned long)enif_get_data(env)); +} + + +static ErlNifFunc nif_funcs[] = +{ + {"lib_version", 0, lib_version}, + {"call_history", 0, call_history}, + {"get_priv_data_ptr", 0, get_priv_data_ptr} +}; + +#if NIF_LIB_VER != 3 +ERL_NIF_INIT(nif_mod,nif_funcs,load,reload,upgrade,unload) +#else +ERL_NIF_INIT_GLOB /* avoid link error on windows */ +#endif + diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.erl b/erts/emulator/test/nif_SUITE_data/nif_mod.erl new file mode 100644 index 0000000000..93da6590a0 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.erl @@ -0,0 +1,64 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(nif_mod). + +-include("test_server.hrl"). + +-export([load_nif_lib/2, start/0, lib_version/0, call_history/0, get_priv_data_ptr/0]). + +-export([loop/0, upgrade/1]). + +-define(nif_stub,nif_stub_error(?LINE)). + +load_nif_lib(Config, Ver) -> + ?line Path = ?config(data_dir, Config), + erlang:load_nif(filename:join(Path,libname(Ver)), 0). + +libname(no_init) -> libname(3); +libname(Ver) when is_integer(Ver) -> + "nif_mod." ++ integer_to_list(Ver). + +start() -> + spawn_opt(?MODULE,loop,[], + [link, monitor]). + +loop() -> + receive + {Pid,lib_version} -> + Pid ! {self(),lib_version()}, + loop(); + {Pid,upgrade} -> + ?MODULE:upgrade(Pid); + die -> + void + end. + +upgrade(Pid) -> + Pid ! {self(),upgraded}, + loop(). + +lib_version() -> % NIF + undefined. + +call_history() -> ?nif_stub. +get_priv_data_ptr() -> ?nif_stub. + +nif_stub_error(Line) -> + exit({nif_not_loaded,module,?MODULE,line,Line}). diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.h b/erts/emulator/test/nif_SUITE_data/nif_mod.h new file mode 100644 index 0000000000..2dfdc75176 --- /dev/null +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.h @@ -0,0 +1,17 @@ +typedef struct call_info_t +{ + struct call_info_t* next; + unsigned lib_ver; + int static_cntA; + int static_cntB; + char func_name[1]; /* must be last */ +}CallInfo; + + +typedef struct +{ + int calls; + int ref_cnt; + CallInfo* call_history; +}NifModPrivData; + diff --git a/erts/emulator/test/node_container_SUITE.erl b/erts/emulator/test/node_container_SUITE.erl new file mode 100644 index 0000000000..f3d9eb783b --- /dev/null +++ b/erts/emulator/test/node_container_SUITE.erl @@ -0,0 +1,1288 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%---------------------------------------------------------------------- +%%% File : node_container_SUITE.erl +%%% Author : Rickard +%%% Purpose : +%%% Created : 24 Jul 2002 by Rickard +%%%---------------------------------------------------------------------- + +-module(node_container_SUITE). +-author('rickard.green@uab.ericsson.se'). + +%-define(line_trace, 1). + +-include("test_server.hrl"). + +%-compile(export_all). +-export([all/1, init_per_testcase/2, fin_per_testcase/2, end_per_suite/1, + node_container_refc_check/1]). + +-export([term_to_binary_to_term_eq/1, + round_trip_eq/1, + cmp/1, + ref_eq/1, + node_table_gc/1, + dist_link_refc/1, + dist_monitor_refc/1, + node_controller_refc/1, + ets_refc/1, + match_spec_refc/1, + timer_refc/1, + otp_4715/1, + pid_wrap/1, + port_wrap/1, + bad_nc/1, + unique_pid/1, + iter_max_procs/1]). + +-define(DEFAULT_TIMEOUT, ?t:minutes(10)). + +all(doc) -> []; +all(suite) -> + [term_to_binary_to_term_eq, + round_trip_eq, + cmp, + ref_eq, + node_table_gc, + dist_link_refc, + dist_monitor_refc, + node_controller_refc, + ets_refc, + match_spec_refc, + timer_refc, + otp_4715, + pid_wrap, + port_wrap, + bad_nc, + unique_pid, + iter_max_procs]. + +available_internal_state(Bool) when Bool == true; Bool == false -> + case {Bool, + (catch erts_debug:get_internal_state(available_internal_state))} of + {true, true} -> + true; + {false, true} -> + erts_debug:set_internal_state(available_internal_state, false), + true; + {true, _} -> + erts_debug:set_internal_state(available_internal_state, true), + false; + {false, _} -> + false + end. + +init_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + available_internal_state(true), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +end_per_suite(_Config) -> + available_internal_state(false). + +%%% +%%% The test cases ------------------------------------------------------------- +%%% + +-define(MAX_PIDS_PORTS, ((1 bsl 28) - 1)). + +%% +%% Test case: term_to_binary_to_term_eq +%% +term_to_binary_to_term_eq(doc) -> + ["Tests that node container terms that are converted to external format " + "and back stay equal to themselves."]; +term_to_binary_to_term_eq(suite) -> []; +term_to_binary_to_term_eq(Config) when is_list(Config) -> + ?line ThisNode = {node(), erlang:system_info(creation)}, + % Get local node containers + ?line LPid = self(), + ?line LXPid = mk_pid(ThisNode, 32767, 8191), + ?line LPort = hd(erlang:ports()), + ?line LXPort = mk_port(ThisNode, 268435455), + ?line LLRef = make_ref(), + ?line LHLRef = mk_ref(ThisNode, [47, 11]), + ?line LSRef = mk_ref(ThisNode, [4711]), + % Test local nc:s + ?line LPid = binary_to_term(term_to_binary(LPid)), + ?line LXPid = binary_to_term(term_to_binary(LXPid)), + ?line LPort = binary_to_term(term_to_binary(LPort)), + ?line LXPort = binary_to_term(term_to_binary(LXPort)), + ?line LLRef = binary_to_term(term_to_binary(LLRef)), + ?line LHLRef = binary_to_term(term_to_binary(LHLRef)), + ?line LSRef = binary_to_term(term_to_binary(LSRef)), + % Get remote node containers + ?line RNode = {get_nodename(), 3}, + ?line RPid = mk_pid(RNode, 4711, 1), + ?line RXPid = mk_pid(RNode, 32767, 8191), + ?line RPort = mk_port(RNode, 4711), + ?line RXPort = mk_port(RNode, 268435455), + ?line RLRef = mk_ref(RNode, [4711, 4711, 4711]), + ?line RHLRef = mk_ref(RNode, [4711, 4711]), + ?line RSRef = mk_ref(RNode, [4711]), + % Test remote nc:s + ?line RPid = binary_to_term(term_to_binary(RPid)), + ?line RXPid = binary_to_term(term_to_binary(RXPid)), + ?line RPort = binary_to_term(term_to_binary(RPort)), + ?line RXPort = binary_to_term(term_to_binary(RXPort)), + ?line RLRef = binary_to_term(term_to_binary(RLRef)), + ?line RHLRef = binary_to_term(term_to_binary(RHLRef)), + ?line RSRef = binary_to_term(term_to_binary(RSRef)), + ?line nc_refc_check(node()), + ?line ok. + + +%% +%% Test case: round_trip_eq +%% +round_trip_eq(doc) -> + ["Tests that node containers that are sent beteen nodes stay equal to " + "themselves."]; +round_trip_eq(suite) -> []; +round_trip_eq(Config) when is_list(Config) -> + ?line ThisNode = {node(), erlang:system_info(creation)}, + ?line NodeFirstName = get_nodefirstname(), + ?line ?line {ok, Node} = start_node(NodeFirstName), + ?line Self = self(), + ?line RPid = spawn_link(Node, + fun () -> + receive + {Self, Data} -> + Self ! {self(), Data} + end + end), + ?line SentPid = self(), + ?line SentXPid = mk_pid(ThisNode, 17471, 8190), + ?line SentPort = hd(erlang:ports()), + ?line SentXPort = mk_port(ThisNode, 268435451), + ?line SentLRef = make_ref(), + ?line SentHLRef = mk_ref(ThisNode, [4711, 17]), + ?line SentSRef = mk_ref(ThisNode, [4711]), + ?line RPid ! {Self, {SentPid, + SentXPid, + SentPort, + SentXPort, + SentLRef, + SentHLRef, + SentSRef}}, + receive + {RPid, {RecPid, + RecXPid, + RecPort, + RecXPort, + RecLRef, + RecHLRef, + RecSRef}} -> + ?line stop_node(Node), + ?line SentPid = RecPid, + ?line SentXPid = RecXPid, + ?line SentPort = RecPort, + ?line SentXPort = RecXPort, + ?line SentLRef = RecLRef, + ?line SentHLRef = RecHLRef, + ?line SentSRef = RecSRef, + ?line nc_refc_check(node()), + ?line ok + end. + + + +%% +%% Test case: cmp +%% +cmp(doc) -> + ["Tests that Erlang term comparison works as it should on node " + "containers."]; +cmp(suite) -> []; +cmp(Config) when is_list(Config) -> + + %% Inter type comparison --------------------------------------------------- + + %% The Erlang term order: + %% number < atom < ref < fun < port < pid < tuple < nil < cons < binary + RNode = {get_nodename(), 2}, + + IRef = make_ref(), + ERef = mk_ref({get_nodename(), 2}, [1,2,3]), + + IPid = self(), + EPid = mk_pid(RNode, 1, 2), + + IPort = hd(erlang:ports()), + EPort = mk_port(RNode, 1), + + %% Test pids ---------------------------------------------------- + ?line true = 1 < IPid, + ?line true = 1.3 < IPid, + ?line true = (1 bsl 64) < IPid, + ?line true = an_atom < IPid, + ?line true = IRef < IPid, + ?line true = ERef < IPid, + ?line true = fun () -> a_fun end < IPid, + ?line true = IPort < IPid, + ?line true = EPort < IPid, + ?line true = IPid < {a, tuple}, + ?line true = IPid < [], + ?line true = IPid < [a|cons], + ?line true = IPid < <<"a binary">>, + + ?line true = 1 < EPid, + ?line true = 1.3 < EPid, + ?line true = (1 bsl 64) < EPid, + ?line true = an_atom < EPid, + ?line true = IRef < EPid, + ?line true = ERef < EPid, + ?line true = fun () -> a_fun end < EPid, + ?line true = IPort < EPid, + ?line true = EPort < EPid, + ?line true = EPid < {a, tuple}, + ?line true = EPid < [], + ?line true = EPid < [a|cons], + ?line true = EPid < <<"a binary">>, + + %% Test ports -------------------------------------------------- + ?line true = 1 < IPort, + ?line true = 1.3 < IPort, + ?line true = (1 bsl 64) < IPort, + ?line true = an_atom < IPort, + ?line true = IRef < IPort, + ?line true = ERef < IPort, + ?line true = fun () -> a_fun end < IPort, + ?line true = IPort < IPid, + ?line true = IPort < EPid, + ?line true = IPort < {a, tuple}, + ?line true = IPort < [], + ?line true = IPort < [a|cons], + ?line true = IPort < <<"a binary">>, + + ?line true = 1 < EPort, + ?line true = 1.3 < EPort, + ?line true = (1 bsl 64) < EPort, + ?line true = an_atom < EPort, + ?line true = IRef < EPort, + ?line true = ERef < EPort, + ?line true = fun () -> a_fun end < EPort, + ?line true = EPort < IPid, + ?line true = EPort < EPid, + ?line true = EPort < {a, tuple}, + ?line true = EPort < [], + ?line true = EPort < [a|cons], + ?line true = EPort < <<"a binary">>, + + %% Test refs ---------------------------------------------------- + ?line true = 1 < IRef, + ?line true = 1.3 < IRef, + ?line true = (1 bsl 64) < IRef, + ?line true = an_atom < IRef, + ?line true = IRef < fun () -> a_fun end, + ?line true = IRef < IPort, + ?line true = IRef < EPort, + ?line true = IRef < IPid, + ?line true = IRef < EPid, + ?line true = IRef < {a, tuple}, + ?line true = IRef < [], + ?line true = IRef < [a|cons], + ?line true = IRef < <<"a binary">>, + + ?line true = 1 < ERef, + ?line true = 1.3 < ERef, + ?line true = (1 bsl 64) < ERef, + ?line true = an_atom < ERef, + ?line true = ERef < fun () -> a_fun end, + ?line true = ERef < IPort, + ?line true = ERef < EPort, + ?line true = ERef < IPid, + ?line true = ERef < EPid, + ?line true = ERef < {a, tuple}, + ?line true = ERef < [], + ?line true = ERef < [a|cons], + ?line true = ERef < <<"a binary">>, + + + %% Intra type comparison --------------------------------------------------- + + + %% Test pids ---------------------------------------------------- + %% + %% Significance (most -> least): + %% serial, number, nodename, creation + %% + + ?line Pid = mk_pid({b@b, 2}, 4711, 1), + + ?line true = mk_pid({a@b, 1}, 4710, 2) > Pid, + ?line true = mk_pid({a@b, 1}, 4712, 1) > Pid, + ?line true = mk_pid({c@b, 1}, 4711, 1) > Pid, + ?line true = mk_pid({b@b, 3}, 4711, 1) > Pid, + ?line true = mk_pid({b@b, 2}, 4711, 1) =:= Pid, + + %% Test ports --------------------------------------------------- + %% + %% Significance (most -> least): + %% nodename, creation, number + %% + %% OBS: Comparison between ports has changed in R9. This + %% since it wasn't stable in R8 (and eariler releases). + %% Significance used to be: dist_slot, number, + %% creation. + + ?line Port = mk_port({b@b, 2}, 4711), + + ?line true = mk_port({c@b, 1}, 4710) > Port, + ?line true = mk_port({b@b, 3}, 4710) > Port, + ?line true = mk_port({b@b, 2}, 4712) > Port, + ?line true = mk_port({b@b, 2}, 4711) =:= Port, + + %% Test refs ---------------------------------------------------- + %% Significance (most -> least): + %% nodename, creation, (number high, number mid), number low, + %% + %% OBS: Comparison between refs has changed in R9. This + %% since it wasn't stable in R8 (and eariler releases). + %% Significance used to be: dist_slot, number, + %% creation. + %% + + ?line Ref = mk_ref({b@b, 2}, [4711, 4711, 4711]), + + ?line true = mk_ref({c@b, 1}, [4710, 4710, 4710]) > Ref, + ?line true = mk_ref({b@b, 3}, [4710, 4710, 4710]) > Ref, + ?line true = mk_ref({b@b, 2}, [4710, 4710, 4712]) > Ref, + ?line true = mk_ref({b@b, 2}, [4710, 4712, 4711]) > Ref, + ?line true = mk_ref({b@b, 2}, [4712, 4711, 4711]) > Ref, + ?line true = mk_ref({b@b, 2}, [4711, 4711, 4711]) =:= Ref, + + ok. + +%% +%% Test case: ref_eq +%% +ref_eq(doc) -> ["Test that one word refs \"works\"."]; +ref_eq(suite) -> []; +ref_eq(Config) when is_list(Config) -> + ?line ThisNode = {node(), erlang:system_info(creation)}, + ?line AnotherNode = {get_nodename(),2}, + ?line LLongRef = mk_ref(ThisNode, [4711, 0, 0]), + ?line LHalfLongRef = mk_ref(ThisNode, [4711, 0]), + ?line LShortRef = mk_ref(ThisNode, [4711]), + ?line true = LLongRef =:= LShortRef, + ?line true = LLongRef =:= LHalfLongRef, + ?line true = LLongRef =:= LLongRef, + ?line true = LHalfLongRef =:= LShortRef, + ?line true = LHalfLongRef =:= LHalfLongRef, + ?line true = LShortRef =:= LShortRef, + ?line false = LShortRef == mk_ref(ThisNode, [4711, 0, 1]), % Not any more + ?line RLongRef = mk_ref(AnotherNode, [4711, 0, 0]), + ?line RHalfLongRef = mk_ref(AnotherNode, [4711, 0]), + ?line RShortRef = mk_ref(AnotherNode, [4711]), + ?line true = RLongRef =:= RShortRef, + ?line true = RLongRef =:= RHalfLongRef, + ?line true = RLongRef =:= RLongRef, + ?line true = RHalfLongRef =:= RShortRef, + ?line true = RHalfLongRef =:= RHalfLongRef, + ?line true = RShortRef =:= RShortRef, + ?line false = RShortRef == mk_ref(AnotherNode, [4711, 0, 1]), % Not any more + ?line nc_refc_check(node()), + ?line ok. + +%% +%% Test case: node_table_gc +%% +node_table_gc(doc) -> + ["Tests that node tables are garbage collected."]; +node_table_gc(suite) -> []; +node_table_gc(Config) when is_list(Config) -> + ?line PreKnown = nodes(known), + ?line ?t:format("PreKnown = ~p~n", [PreKnown]), + ?line make_node_garbage(0, 200000, 1000, []), + ?line PostKnown = nodes(known), + ?line PostAreas = erlang:system_info(allocated_areas), + ?line ?t:format("PostKnown = ~p~n", [PostKnown]), + ?line ?t:format("PostAreas = ~p~n", [PostAreas]), + ?line true = length(PostKnown) =< length(PreKnown), + ?line nc_refc_check(node()), + ?line ok. + +make_node_garbage(N, L, I, Ps) when N < L -> + ?line Self = self(), + ?line P = spawn_link(fun () -> + % Generate two node entries and one dist + % entry per node name + ?line PL1 = make_faked_pid_list(N, + I div 2, + 1), + ?line put(a, PL1), + ?line PL2 = make_faked_pid_list(N, + I div 2, + 2), + ?line put(b, PL2), + ?line Self ! {self(), length(nodes(known))} + end), + ?line receive + {P, KnownLength} -> + ?line true = KnownLength >= I div 2 + end, + ?line make_node_garbage(N+(I div 2)*2, L, I, [P|Ps]); +make_node_garbage(_, _, _, Ps) -> + %% Cleanup garbage... + ProcIsCleanedUp + = fun (Proc) -> + undefined == erts_debug:get_internal_state({process_status, + Proc}) + end, + lists:foreach(fun (P) -> wait_until(fun () -> ProcIsCleanedUp(P) end) end, + Ps), + ?line case erlang:system_info(heap_type) of + shared -> ?line garbage_collect(); + _ -> ?line ok + end, + ?line ok. + + +make_faked_pid_list(Start, No, Creation) -> + make_faked_pid_list(Start, No, Creation, []). + +make_faked_pid_list(_Start, 0, _Creation, Acc) -> + Acc; +make_faked_pid_list(Start, No, Creation, Acc) -> + make_faked_pid_list(Start+1, + No-1, + Creation, + [mk_pid({"faked_node-" + ++ integer_to_list(Start rem 50000) + ++ "@" + ++ atom_to_list(?MODULE), + Creation}, + 4711, + 3) | Acc]). + +%% +%% Test case: dist_link_refc +%% +dist_link_refc(doc) -> + ["Tests that external reference counts are incremented and decremented " + "as they should for distributed links"]; +dist_link_refc(suite) -> []; +dist_link_refc(Config) when is_list(Config) -> + ?line NodeFirstName = get_nodefirstname(), + ?line ?line {ok, Node} = start_node(NodeFirstName), + ?line RP = spawn_execer(Node), + ?line LP = spawn_link_execer(node()), + ?line true = sync_exec(RP, fun () -> link(LP) end), + ?line wait_until(fun () -> + ?line {links, Links} = process_info(LP, links), + ?line lists:member(RP, Links) + end), + ?line NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), + ?line 1 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + ?line exec(RP, fun() -> exit(normal) end), + ?line wait_until(fun () -> + ?line {links, Links} = process_info(LP, links), + ?line not lists:member(RP, Links) + end), + ?line 0 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + ?line exit(LP, normal), + ?line stop_node(Node), + ?line nc_refc_check(node()), + ?line ok. + + +%% +%% Test case: dist_monitor_refc +%% +dist_monitor_refc(doc) -> + ["Tests that external reference counts are incremented and decremented " + "as they should for distributed monitors"]; +dist_monitor_refc(suite) -> []; +dist_monitor_refc(Config) when is_list(Config) -> + ?line NodeFirstName = get_nodefirstname(), + ?line {ok, Node} = start_node(NodeFirstName), + ?line RP = spawn_execer(Node), + ?line LP = spawn_link_execer(node()), + ?line RMon = sync_exec(RP, fun () -> erlang:monitor(process, LP) end), + ?line true = is_reference(RMon), + ?line LMon = sync_exec(LP, fun () -> erlang:monitor(process, RP) end), + ?line true = is_reference(LMon), + ?line NodeCre = sync_exec(RP, fun() -> erlang:system_info(creation) end), + ?line wait_until(fun () -> + ?line {monitored_by, MonBy} + = process_info(LP, monitored_by), + ?line {monitors, Mon} + = process_info(LP, monitors), + ?line (lists:member(RP, MonBy) + and lists:member({process,RP}, Mon)) + end), + ?line 3 = reference_type_count( + monitor, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + ?line exec(RP, fun () -> exit(normal) end), + ?line wait_until(fun () -> + ?line {monitored_by, MonBy} + = process_info(LP, monitored_by), + ?line {monitors, Mon} + = process_info(LP, monitors), + ?line ((not lists:member(RP, MonBy)) + and (not lists:member({process,RP}, Mon))) + end), + ?line ok = sync_exec(LP, + fun () -> + receive + {'DOWN', LMon, process, _, _} -> + ok + end + end), + ?line 0 = reference_type_count( + link, + refering_entity_id({process, LP}, + get_node_references({Node, NodeCre}))), + ?line exit(LP, normal), + ?line stop_node(Node), + ?line nc_refc_check(node()), + ?line ok. + + +%% +%% Test case: node_controller_refc +%% +node_controller_refc(doc) -> + ["Tests that external reference counts are incremented and decremented " + "as they should for entities controlling a connections."]; +node_controller_refc(suite) -> []; +node_controller_refc(Config) when is_list(Config) -> + ?line NodeFirstName = get_nodefirstname(), + ?line ?line {ok, Node} = start_node(NodeFirstName), + ?line true = lists:member(Node, nodes()), + ?line 1 = reference_type_count(control, get_dist_references(Node)), + ?line P = spawn_link_execer(node()), + ?line Node + = sync_exec(P, + fun () -> + put(remote_net_kernel, + rpc:call(Node,erlang,whereis,[net_kernel])), + node(get(remote_net_kernel)) + end), + ?line Creation = rpc:call(Node, erlang, system_info, [creation]), + ?line monitor_node(Node,true), + ?line stop_node(Node), + ?line receive {nodedown, Node} -> ok end, + ?line DistRefs = get_dist_references(Node), + ?line true = reference_type_count(node, DistRefs) > 0, + ?line 0 = reference_type_count(control, DistRefs), + % Get rid of all references to Node + ?line exec(P, fun () -> exit(normal) end), + ?line wait_until(fun () -> not is_process_alive(P) end), + ?line case erlang:system_info(heap_type) of + shared -> + ?line garbage_collect(); + hybrid -> + ?line lists:foreach(fun (Proc) -> garbage_collect(Proc) end, + processes()), + ?line erlang:garbage_collect_message_area(); + _ -> + ?line lists:foreach(fun (Proc) -> garbage_collect(Proc) end, + processes()) + end, + ?line false = get_node_references({Node,Creation}), + ?line false = get_dist_references(Node), + ?line false = lists:member(Node, nodes(known)), + ?line nc_refc_check(node()), + ?line ok. + +%% +%% Test case: ets_refc +%% +ets_refc(doc) -> + ["Tests that external reference counts are incremented and decremented " + "as they should for data stored in ets tables."]; +ets_refc(suite) -> []; +ets_refc(Config) when is_list(Config) -> + ?line RNode = {get_nodename(), 1}, + ?line RPid = mk_pid(RNode, 4711, 2), + ?line RPort = mk_port(RNode, 4711), + ?line RRef = mk_ref(RNode, [4711, 47, 11]), + ?line Tab = ets:new(ets_refc, []), + ?line 0 = reference_type_count(ets, get_node_references(RNode)), + ?line true = ets:insert(Tab, [{a, self()}, + {b, RPid}, + {c, hd(erlang:ports())}, + {d, RPort}, + {e, make_ref()}]), + ?line 2 = reference_type_count(ets, get_node_references(RNode)), + ?line true = ets:insert(Tab, {f, RRef}), + ?line 3 = reference_type_count(ets, get_node_references(RNode)), + ?line true = ets:delete(Tab, d), + ?line 2 = reference_type_count(ets, get_node_references(RNode)), + ?line true = ets:delete_all_objects(Tab), + ?line 0 = reference_type_count(ets, get_node_references(RNode)), + ?line true = ets:insert(Tab, [{b, RPid}, {e, make_ref()}]), + ?line 1 = reference_type_count(ets, get_node_references(RNode)), + ?line true = ets:delete(Tab), + ?line 0 = reference_type_count(ets, get_node_references(RNode)), + ?line nc_refc_check(node()), + ?line ok. + +%% +%% Test case: match_spec_refc +%% +match_spec_refc(doc) -> + ["Tests that external reference counts are incremented and decremented " + "as they should for data stored in match specifications."]; +match_spec_refc(suite) -> []; +match_spec_refc(Config) when is_list(Config) -> + ?line RNode = {get_nodename(), 1}, + ?line RPid = mk_pid(RNode, 4711, 2), + ?line RPort = mk_port(RNode, 4711), + ?line RRef = mk_ref(RNode, [4711, 47, 11]), + ?line ok = do_match_spec_test(RNode, RPid, RPort, RRef), + ?line garbage_collect(), + ?line NodeRefs = get_node_references(RNode), + ?line 0 = reference_type_count(binary, NodeRefs), + ?line 0 = reference_type_count(ets, NodeRefs), + ?line nc_refc_check(node()), + ?line ok. + +do_match_spec_test(RNode, RPid, RPort, RRef) -> + ?line Tab = ets:new(match_spec_refc, []), + ?line true = ets:insert(Tab, [{a, RPid, RPort, RRef}, + {b, self(), RPort, RRef}, + {c, RPid, RPort, make_ref()}, + {d, RPid, RPort, RRef}]), + ?line {M1, C1} = ets:select(Tab, [{{'$1',RPid,RPort,RRef},[],['$1']}], 1), + ?line NodeRefs = get_node_references(RNode), + ?line 3 = reference_type_count(binary, NodeRefs), + ?line 10 = reference_type_count(ets, NodeRefs), + ?line {M2, C2} = ets:select(C1), + ?line '$end_of_table' = ets:select(C2), + ?line ets:delete(Tab), + ?line [a,d] = lists:sort(M1++M2), + ?line ok. + + +%% +%% Test case: ets_refc +%% +timer_refc(doc) -> + ["Tests that external reference counts are incremented and decremented " + "as they should for data stored in bif timers."]; +timer_refc(suite) -> []; +timer_refc(Config) when is_list(Config) -> + ?line RNode = {get_nodename(), 1}, + ?line RPid = mk_pid(RNode, 4711, 2), + ?line RPort = mk_port(RNode, 4711), + ?line RRef = mk_ref(RNode, [4711, 47, 11]), + ?line 0 = reference_type_count(timer, get_node_references(RNode)), + ?line Pid = spawn(fun () -> receive after infinity -> ok end end), + ?line erlang:start_timer(10000, Pid, {RPid, RPort, RRef}), + ?line 3 = reference_type_count(timer, get_node_references(RNode)), + ?line exit(Pid, kill), + ?line Mon = erlang:monitor(process, Pid), + ?line receive {'DOWN', Mon, process, Pid, _} -> ok end, + ?line 0 = reference_type_count(timer, get_node_references(RNode)), + ?line erlang:send_after(500, Pid, {timer, RPid, RPort, RRef}), + ?line 0 = reference_type_count(timer, get_node_references(RNode)), + ?line erlang:send_after(500, self(), {timer, RPid, RPort, RRef}), + ?line erlang:send_after(400, bananfluga, {timer, RPid, RPort, RRef}), + ?line 6 = reference_type_count(timer, get_node_references(RNode)), + ?line receive {timer, RPid, RPort, RRef} -> ok end, + ?line 0 = reference_type_count(timer, get_node_references(RNode)), + ?line nc_refc_check(node()), + ?line ok. + +otp_4715(doc) -> []; +otp_4715(suite) -> []; +otp_4715(Config) when is_list(Config) -> + case ?t:is_release_available("r9b") of + true -> otp_4715_1(Config); + false -> {skip,"No R9B found"} + end. + +otp_4715_1(Config) -> + case erlang:system_info(compat_rel) of + 9 -> + ?line run_otp_4715(Config); + _ -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line ?t:run_on_shielded_node(fun () -> + run_otp_4715(Config) + end, + "+R9 -pa " ++ Pa) + end. + +run_otp_4715(Config) when is_list(Config) -> + ?line erts_debug:set_internal_state(available_internal_state, true), + ?line PidList = [mk_pid({a@b, 1}, 4710, 2), + mk_pid({a@b, 1}, 4712, 1), + mk_pid({c@b, 1}, 4711, 1), + mk_pid({b@b, 3}, 4711, 1), + mk_pid({b@b, 2}, 4711, 1)], + + ?line R9Sorted = old_mod:sort_on_old_node(PidList), + ?line R9Sorted = lists:sort(PidList). + +pid_wrap(doc) -> []; +pid_wrap(suite) -> []; +pid_wrap(Config) when is_list(Config) -> ?line pp_wrap(pid). + +port_wrap(doc) -> []; +port_wrap(suite) -> []; +port_wrap(Config) when is_list(Config) -> + ?line case ?t:os_type() of + {unix, _} -> + ?line pp_wrap(port); + _ -> + ?line {skip, "Only run on unix"} + end. + +get_next_id(pid) -> + erts_debug:get_internal_state(next_pid); +get_next_id(port) -> + erts_debug:get_internal_state(next_port). + +set_next_id(pid, N) -> + erts_debug:set_internal_state(next_pid, N); +set_next_id(port, N) -> + erts_debug:set_internal_state(next_port, N). + +pp_wrap(What) -> + ?line N = set_high_pp_next(What), + ?line Cre = N + 100, + ?line ?t:format("no creations = ~p~n", [Cre]), + ?line PreCre = get_next_id(What), + ?line ?t:format("pre creations = ~p~n", [PreCre]), + ?line true = is_integer(PreCre), + ?line do_pp_creations(What, Cre), + ?line PostCre = get_next_id(What), + ?line ?t:format("post creations = ~p~n", [PostCre]), + ?line true = is_integer(PostCre), + ?line true = PreCre > PostCre, + ?line Now = set_next_id(What, ?MAX_PIDS_PORTS div 2), + ?line ?t:format("reset to = ~p~n", [Now]), + ?line true = is_integer(Now), + ?line ok. + +set_high_pp_next(What) -> + ?line set_high_pp_next(What, ?MAX_PIDS_PORTS-1). + +set_high_pp_next(What, N) -> + ?line M = set_next_id(What, N), + ?line true = is_integer(M), + ?line case {M >= N, M =< ?MAX_PIDS_PORTS} of + {true, true} -> + ?line ?MAX_PIDS_PORTS - M + 1; + _ -> + ?line set_high_pp_next(What, N - 100) + end. + +do_pp_creations(_What, N) when is_integer(N), N =< 0 -> + ?line done; +do_pp_creations(pid, N) when is_integer(N) -> + %% Create new pid and make sure it works... + ?line Me = self(), + ?line Ref = make_ref(), + ?line Pid = spawn_link(fun () -> + receive + Ref -> + Me ! Ref + end + end), + ?line Pid ! Ref, + ?line receive + Ref -> + ?line do_pp_creations(pid, N - 1) + end; +do_pp_creations(port, N) when is_integer(N) -> + %% Create new port and make sure it works... + ?line "hej" = os:cmd("echo hej") -- "\n", + ?line do_pp_creations(port, N - 1). + +bad_nc(doc) -> []; +bad_nc(suite) -> []; +bad_nc(Config) when is_list(Config) -> + % Make sure emulator don't crash on bad node containers... + ?line MaxPidNum = (1 bsl 15) - 1, + ?line MaxPidSer = ?MAX_PIDS_PORTS bsr 15, + ?line ThisNode = {node(), erlang:system_info(creation)}, + ?line {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(ThisNode, MaxPidNum + 1, 17)), + ?line {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(ThisNode, 4711, MaxPidSer + 1)), + ?line {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(ThisNode, ?MAX_PIDS_PORTS + 1)), + ?line {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(ThisNode,[(1 bsl 18), 4711, 4711])), + ?line {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(ThisNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), + ?line RemNode = {x@y, 2}, + ?line {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(RemNode, MaxPidNum + 1, MaxPidSer)), + ?line {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(RemNode, MaxPidNum, MaxPidSer + 1)), + ?line {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(RemNode, ?MAX_PIDS_PORTS + 1)), + ?line {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(RemNode, [(1 bsl 18), 4711, 4711])), + ?line {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(RemNode, [4711, 4711, 4711, 4711, 4711, 4711, 4711])), + ?line BadNode = {x@y, 4}, + ?line {'EXIT', {badarg, mk_pid, _}} + = (catch mk_pid(BadNode, 4711, 17)), + ?line {'EXIT', {badarg, mk_port, _}} + = (catch mk_port(BadNode, 4711)), + ?line {'EXIT', {badarg, mk_ref, _}} + = (catch mk_ref(BadNode, [4711, 4711, 17])), + ?line ok. + + + +-define(NO_PIDS, 1000000). + +unique_pid(doc) -> []; +unique_pid(suite) -> []; +unique_pid(Config) when is_list(Config) -> + case catch erlang:system_info(modified_timing_level) of + Level when is_integer(Level) -> + {skip, + "Modified timing (level " ++ integer_to_list(Level) + ++ ") is enabled. spawn() is too slow for this " + " test when modified timing is enabled."}; + _ -> + ?line ?NO_PIDS = length(lists:usort(mkpidlist(?NO_PIDS, []))), + ?line ok + end. + +mkpidlist(0, Ps) -> Ps; +mkpidlist(N, Ps) -> mkpidlist(N-1, [spawn(fun () -> ok end)|Ps]). + + +iter_max_procs(doc) -> []; +iter_max_procs(suite) -> []; +iter_max_procs(Config) when is_list(Config) -> + ?line NoMoreTests = make_ref(), + ?line erlang:send_after(10000, self(), NoMoreTests), + ?line Res = chk_max_proc_line(), + ?line Res = chk_max_proc_line(), + ?line done = chk_max_proc_line_until(NoMoreTests, Res), + ?line {comment, + io_lib:format("max processes = ~p; " + "process line length = ~p", + [element(2, Res), element(1, Res)])}. + + +max_proc_line(Root, Parent, N) -> + Me = self(), + case catch spawn_link(fun () -> max_proc_line(Root, Me, N+1) end) of + {'EXIT', {system_limit, _}} when Root /= self() -> + Root ! {proc_line_length, N, self()}, + receive remove_proc_line -> Parent ! {exiting, Me} end; + P when is_pid(P), Root =/= self() -> + receive {exiting, P} -> Parent ! {exiting, Me} end; + P when is_pid(P) -> + P; + Unexpected -> + exit({unexpected_spawn_result, Unexpected}) + end. + +chk_max_proc_line() -> + ?line Child = max_proc_line(self(), self(), 0), + ?line receive + {proc_line_length, PLL, End} -> + ?line PC = erlang:system_info(process_count), + ?line LP = length(processes()), + ?line ?t:format("proc line length = ~p; " + "process count = ~p; " + "length processes = ~p~n", + [PLL, PC, LP]), + ?line End ! remove_proc_line, + ?line PC = LP, + ?line receive {exiting, Child} -> ok end, + ?line {PLL, PC} + end. + +chk_max_proc_line_until(NoMoreTests, Res) -> + receive + NoMoreTests -> + ?line done + after 0 -> + ?line Res = chk_max_proc_line(), + ?line chk_max_proc_line_until(NoMoreTests, Res) + end. + +%% +%% -- Internal utils --------------------------------------------------------- +%% + +-define(ND_REFS, erts_debug:get_internal_state(node_and_dist_references)). + +node_container_refc_check(Node) when is_atom(Node) -> + AIS = available_internal_state(true), + nc_refc_check(Node), + available_internal_state(AIS). + +nc_refc_check(Node) when is_atom(Node) -> + Ref = make_ref(), + Self = self(), + ?t:format("Starting reference count check of node ~w~n", [Node]), + spawn_link(Node, + fun () -> + {{node_references, NodeRefs}, + {dist_references, DistRefs}} = ?ND_REFS, + check_nd_refc({node(), erlang:system_info(creation)}, + NodeRefs, + DistRefs, + fun (ErrMsg) -> + Self ! {Ref, ErrMsg, failed}, + exit(normal) + end), + Self ! {Ref, succeded} + end), + receive + {Ref, ErrorMsg, failed} -> + ?t:format("~s~n", [ErrorMsg]), + ?t:fail(reference_count_check_failed); + {Ref, succeded} -> + ?t:format("Reference count check of node ~w succeded!~n", [Node]), + ok + end. + +check_nd_refc({ThisNodeName, ThisCreation}, NodeRefs, DistRefs, Fail) -> + case catch begin + check_refc(ThisNodeName,ThisCreation,"node table",NodeRefs), + check_refc(ThisNodeName,ThisCreation,"dist table",DistRefs), + ok + end of + ok -> + ok; + {'EXIT', Reason} -> + {Y,Mo,D} = date(), + {H,Mi,S} = time(), + ErrMsg = io_lib:format("~n" + "*** Reference count check of node ~w " + "failed (~p) at ~w~w~w ~w:~w:~w~n" + "*** Node table references:~n ~p~n" + "*** Dist table references:~n ~p~n", + [node(), Reason, Y, Mo, D, H, Mi, S, + NodeRefs, DistRefs]), + Fail(lists:flatten(ErrMsg)) + end. + + +check_refc(ThisNodeName,ThisCreation,Table,EntryList) when is_list(EntryList) -> + lists:foreach( + fun ({Entry, Refc, ReferrerList}) -> + FoundRefs = + lists:foldl( + fun ({_Referrer, ReferencesList}, A1) -> + A1 + lists:foldl(fun ({_T,Rs},A2) -> + A2+Rs + end, + 0, + ReferencesList) + end, + 0, + ReferrerList), + + %% Reference count equals found references ? + case Refc =:= FoundRefs of + true -> + ok; + false -> + exit({invalid_reference_count, Table, Entry}) + end, + + %% All entries in table referred to? + case {Entry, Refc} of + {ThisNodeName, 0} -> ok; + {{ThisNodeName, ThisCreation}, 0} -> ok; + {_, 0} -> exit({not_referred_entry_in_table, Table, Entry}); + {_, _} -> ok + end + + end, + EntryList), + ok. + +get_node_references({NodeName, Creation} = Node) when is_atom(NodeName), + is_integer(Creation) -> + {{node_references, NodeRefs}, + {dist_references, DistRefs}} = ?ND_REFS, + check_nd_refc({node(), erlang:system_info(creation)}, + NodeRefs, + DistRefs, + fun (ErrMsg) -> + ?t:format("~s", [ErrMsg]), + ?t:fail(reference_count_check_failed) + end), + find_references(Node, NodeRefs). + +get_dist_references(NodeName) when is_atom(NodeName) -> + ?line {{node_references, NodeRefs}, + {dist_references, DistRefs}} = ?ND_REFS, + ?line check_nd_refc({node(), erlang:system_info(creation)}, + NodeRefs, + DistRefs, + fun (ErrMsg) -> + ?line ?t:format("~s", [ErrMsg]), + ?line ?t:fail(reference_count_check_failed) + end), + ?line find_references(NodeName, DistRefs). + +find_references(N, NRefList) -> + case lists:keysearch(N, 1, NRefList) of + {value, {N, _, ReferrersList}} -> ReferrersList; + _ -> false + end. + +%% Currently unused +% refering_entity_type(RefererType, ReferingEntities) -> +% lists:filter(fun ({{RT, _}, _}) when RT == RefererType -> +% true; +% (_) -> +% false +% end, +% ReferingEntities). + +refering_entity_id(ReferingEntityId, [{ReferingEntityId,_} = ReferingEntity + | _ReferingEntities]) -> + ReferingEntity; +refering_entity_id(ReferingEntityId, [_ | ReferingEntities]) -> + refering_entity_id(ReferingEntityId, ReferingEntities); +refering_entity_id(_, []) -> + false. + +reference_type_count(_, false) -> + 0; +reference_type_count(Type, {_, _ReferenceCountList} = ReferingEntity) -> + reference_type_count(Type, [ReferingEntity]); +reference_type_count(Type, ReferingEntities) when is_list(ReferingEntities) -> + lists:foldl(fun ({_, ReferenceCountList}, Acc1) -> + lists:foldl(fun ({T, N}, Acc2) when T == Type -> + N + Acc2; + (_, Acc2) -> + Acc2 + end, + Acc1, + ReferenceCountList) + end, + 0, + ReferingEntities). + + +start_node(Name, Args) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line Res = test_server:start_node(Name, + slave, + [{args, "-pa "++Pa++" "++Args}]), + ?line {ok, Node} = Res, + ?line rpc:call(Node, erts_debug, set_internal_state, + [available_internal_state, true]), + ?line Res. + +start_node(Name) -> + ?line start_node(Name, ""). + +stop_node(Node) -> + ?line nc_refc_check(Node), + ?line true = test_server:stop_node(Node). + +hostname() -> + from($@, atom_to_list(node())). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_H, []) -> []. + +wait_until(Pred) -> + case Pred() of + true -> ok; + false -> receive after 100 -> wait_until(Pred) end + end. + + +get_nodefirstname() -> + {A, B, C} = now(), + list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)). + +get_nodename() -> + {A, B, C} = now(), + list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C) + ++ "@" + ++ hostname()). + + + +-define(VERSION_MAGIC, 131). + +-define(ATOM_EXT, 100). +-define(REFERENCE_EXT, 101). +-define(PORT_EXT, 102). +-define(PID_EXT, 103). +-define(NEW_REFERENCE_EXT, 114). + +uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> + [(Uint bsr 24) band 16#ff, + (Uint bsr 16) band 16#ff, + (Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint32_be(Uint) -> + exit({badarg, uint32_be, [Uint]}). + + +uint16_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 16 -> + [(Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint16_be(Uint) -> + exit({badarg, uint16_be, [Uint]}). + +uint8(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 8 -> + Uint band 16#ff; +uint8(Uint) -> + exit({badarg, uint8, [Uint]}). + + + +mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> + mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); +mk_pid({NodeName, Creation}, Number, Serial) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PID_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> + mk_port({atom_to_list(NodeName), Creation}, Number); +mk_port({NodeName, Creation}, Number) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PORT_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeName, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), + is_integer(Creation), + is_list(Numbers) -> + mk_ref({atom_to_list(NodeName), Creation}, Numbers); +mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), + is_integer(Creation), + is_integer(Number) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?REFERENCE_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end; +mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), + is_integer(Creation), + is_list(Numbers) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +exec_loop() -> + receive + {exec_fun, Fun} when is_function(Fun) -> + Fun(); + {sync_exec_fun, From, Fun} when is_pid(From), is_function(Fun) -> + From ! {sync_exec_fun_res, self(), Fun()} + end, + exec_loop(). + +spawn_execer(Node) -> + spawn(Node, fun () -> exec_loop() end). + +spawn_link_execer(Node) -> + spawn_link(Node, fun () -> exec_loop() end). + +exec(Pid, Fun) when is_pid(Pid), is_function(Fun) -> + Pid ! {exec_fun, Fun}. + +sync_exec(Pid, Fun) when is_pid(Pid), is_function(Fun) -> + Pid ! {sync_exec_fun, self(), Fun}, + receive + {sync_exec_fun_res, Pid, Res} -> + Res + end. diff --git a/erts/emulator/test/nofrag_SUITE.erl b/erts/emulator/test/nofrag_SUITE.erl new file mode 100644 index 0000000000..ece55f433c --- /dev/null +++ b/erts/emulator/test/nofrag_SUITE.erl @@ -0,0 +1,208 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(nofrag_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,end_per_testcase/2, + error_handler/1,error_handler_apply/1, + error_handler_fixed_apply/1,error_handler_fun/1, + error_handler_tuple_fun/1, + debug_breakpoint/1]). + +%% Exported functions for an error_handler module. +-export([undefined_function/3,undefined_lambda/3,breakpoint/3]). + +all(suite) -> + [error_handler,error_handler_apply,error_handler_fixed_apply, + error_handler_fun,error_handler_tuple_fun,debug_breakpoint]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(3)), + [{watchdog,Dog}|Config]. + +end_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +error_handler(Config) when is_list(Config) -> + ?line process_flag(error_handler, ?MODULE), + %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way + %% to traverse the entire term. + ?line Term = collect(1024), + ?line Term = binary_to_term(term_to_binary(Term)), + ?line 1024 = length(Term), + ?line [[a,b,c,d,[e,f,g]]] = lists:usort(Term), + ok. + +collect(0) -> + []; +collect(N) -> + %% The next line calls the error handle function, which is + %% ?MODULE:undefined_function/3 (it simply returns the list + %% of args, i.e. [a,b,c,d,[e,f,g]]). + C = fooblurf:x(a, b, c, d, [e,f,id(g)]), + + %% The variable C will be saved onto the stack frame; if C + %% points into a heap fragment the garbage collector will reach + %% it and the emulator will crash sooner or later (sooner if + %% the emulator is debug-compiled). + Res = collect(N-1), + [C|Res]. + +collect_apply(0, _) -> + []; +collect_apply(N, Mod) -> + %% The next line calls the error handle function, which is + %% ?MODULE:undefined_function/3 (it simply returns the list + %% of args). + + C = apply(Mod, xyz, id([{a,id(42)},b,c,d,[e,f,id(g)]])), + + %% The variable C will be saved onto the stack frame; if C + %% points into a heap fragment the garbage collector will reach + %% it and the emulator will crash sooner or later (sooner if + %% the emulator is debug-compiled). + Res = collect_apply(N-1, Mod), + [C|Res]. + +error_handler_apply(Config) when is_list(Config) -> + ?line process_flag(error_handler, ?MODULE), + + %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way + %% to traverse the entire term. + ?line Term = collect_apply(1024, fooblurfbar), + ?line Term = binary_to_term(term_to_binary(Term)), + ?line 1024 = length(Term), + ?line [[{a,42},b,c,d,[e,f,g]]] = lists:usort(Term), + ok. + +error_handler_fixed_apply(Config) when is_list(Config) -> + ?line process_flag(error_handler, ?MODULE), + + %% The term_to_binary/1 - binary_to_term/1 roundtrip is a good way + %% to traverse the entire term. + ?line Term = collect_fixed_apply(1024, fooblurfbar), + ?line Term = binary_to_term(term_to_binary(Term)), + ?line 1024 = length(Term), + ?line [[{a,2},b,c,d,[e,f,g]]] = lists:usort(Term), + ok. + +collect_fixed_apply(0, _) -> + []; +collect_fixed_apply(N, Mod) -> + %% The next line calls the error handle function, which is + %% ?MODULE:undefined_function/3 (it simply returns the list + %% of args). + C = Mod:x({a,id(2)}, b, c, d, [e,f,id(g)]), + + %% The variable C will be saved onto the stack frame; if C + %% points into a heap fragment the garbage collector will reach + %% it and the emulator will crash sooner or later (sooner if + %% the emulator is debug-compiled). + Res = collect_fixed_apply(N-1, Mod), + [C|Res]. + +undefined_function(_Mod, _Name, Args) -> + Args. + +error_handler_fun(Config) when is_list(Config) -> + ?line process_flag(error_handler, ?MODULE), + + %% fun(A, B, C) -> {A,B,C,X} end in module foobarblurf. + B = <<131,112,0,0,0,84,3,109,96,69,208,5,175,207,75,36,93,112,218,232,222,22,251,0, + 0,0,0,0,0,0,1,100,0,11,102,111,111,98,97,114,98,108,117,114,102,97,0,98,5, + 244,197,144,103,100,0,13,110,111,110,111,100,101,64,110,111,104,111,115,116, + 0,0,0,46,0,0,0,0,0,104,3,97,1,97,2,97,3>>, + ?line Fun = binary_to_term(B), + ?line Term = collect_fun(1024, Fun), + ?line Term = binary_to_term(term_to_binary(Term)), + ?line 1024 = length(Term), + ?line [[{foo,bar},{99,1.0},[e,f,g]]] = lists:usort(Term), + ?line {env,[{1,2,3}]} = erlang:fun_info(Fun, env), + ok. + +collect_fun(0, _) -> + []; +collect_fun(N, Fun) -> + %% The next line calls the error handle function, which is + %% ?MODULE:undefined_lambda/3 (it simply returns the list + %% of args). + C = Fun({foo,id(bar)}, {99,id(1.0)}, [e,f,id(g)]), + + %% The variable C will be saved onto the stack frame; if C + %% points into a heap fragment the garbage collector will reach + %% it and the emulator will crash sooner or later (sooner if + %% the emulator is debug-compiled). + Res = collect_fun(N-1, Fun), + [C|Res]. + +undefined_lambda(foobarblurf, Fun, Args) when is_function(Fun) -> + Args. + +error_handler_tuple_fun(Config) when is_list(Config) -> + ?line process_flag(error_handler, ?MODULE), + ?line Term = collect_tuple_fun(1024, {?MODULE,very_undefined_function}), + ?line Term = binary_to_term(term_to_binary(Term)), + ?line 1024 = length(Term), + ?line [[{foo,bar},42.0,[e,f,g]]] = lists:usort(Term), + ok. + +collect_tuple_fun(0, _) -> + []; +collect_tuple_fun(N, Fun) -> + %% The next line calls the error handle function, which is + %% ?MODULE:undefined_function/3 (it simply returns the list + %% of args). + C = Fun({foo,id(bar)}, 42.0, [e,f,id(g)]), + + %% The variable C will be saved onto the stack frame; if C + %% points into a heap fragment the garbage collector will reach + %% it and the emulator will crash sooner or later (sooner if + %% the emulator is debug-compiled). + Res = collect_tuple_fun(N-1, Fun), + [C|Res]. + +debug_breakpoint(Config) when is_list(Config) -> + ?line process_flag(error_handler, ?MODULE), + ?line erts_debug:breakpoint({?MODULE,foobar,5}, true), + ?line Term = break_collect(1024), + ?line Term = binary_to_term(term_to_binary(Term)), + ?line 1024 = length(Term), + ?line [[a,b,c,{d,e},[f,g,h]]] = lists:usort(Term), + ?line erts_debug:breakpoint({?MODULE,foobar,5}, false), + ok. + +break_collect(0) -> + []; +break_collect(N) -> + C = foobar(a, b, c, {id(d),e}, [f,g,id(h)]), + Res = break_collect(N-1), + [C|Res]. + +breakpoint(?MODULE, foobar, Args) -> + Args. + +foobar(_, _, _, _, _) -> + exit(dont_execute_me). + +id(I) -> I. + + diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl new file mode 100644 index 0000000000..d009994e2d --- /dev/null +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -0,0 +1,268 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(num_bif_SUITE). + +-include("test_server.hrl"). + +%% Tests the BIFs: +%% abs/1 +%% float/1 +%% float_to_list/1 +%% integer_to_list/1 +%% list_to_float/1 +%% list_to_integer/1 +%% round/1 +%% trunc/1 + +-export([all/1, t_abs/1, t_float/1, + t_float_to_list/1, t_integer_to_list/1, + t_list_to_integer/1, + t_list_to_float/1, t_list_to_float_safe/1, t_list_to_float_risky/1, + t_round/1, t_trunc/1]). + +all(suite) -> [t_abs, t_float, t_float_to_list, t_integer_to_list, + t_list_to_float, t_list_to_integer, + t_round, t_trunc]. + +t_abs(Config) when is_list(Config) -> + %% Floats. + ?line 5.5 = abs(id(5.5)), + ?line 0.0 = abs(id(0.0)), + ?line 100.0 = abs(id(-100.0)), + + %% Integers. + ?line 5 = abs(id(5)), + ?line 0 = abs(id(0)), + ?line 100 = abs(id(-100)), + + %% The largest smallnum. OTP-3190. + ?line X = id((1 bsl 27) - 1), + ?line X = abs(X), + ?line X = abs(X-1)+1, + ?line X = abs(X+1)-1, + ?line X = abs(-X), + ?line X = abs(-X-1)-1, + ?line X = abs(-X+1)+1, + + %% Bignums. + BigNum = id(13984792374983749), + ?line BigNum = abs(BigNum), + ?line BigNum = abs(-BigNum), + ok. + +t_float(Config) when is_list(Config) -> + ?line 0.0 = float(id(0)), + ?line 2.5 = float(id(2.5)), + ?line 0.0 = float(id(0.0)), + ?line -100.55 = float(id(-100.55)), + ?line 42.0 = float(id(42)), + ?line -100.0 = float(id(-100)), + + %% Bignums. + ?line 4294967305.0 = float(id(4294967305)), + ?line -4294967305.0 = float(id(-4294967305)), + + %% Extremly big bignums. + ?line Big = id(list_to_integer(id(lists:duplicate(2000, $1)))), + ?line {'EXIT', {badarg, _}} = (catch float(Big)), + + %% Invalid types and lists. + ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(atom))), + ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(123))), + ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id([$1,[$2]]))), + ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id("1.2"))), + ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id("a"))), + ?line {'EXIT', {badarg, _}} = (catch list_to_integer(id(""))), + ok. + + +%% Tests float_to_list/1. + +t_float_to_list(Config) when is_list(Config) -> + ?line test_ftl("0.0e+0", 0.0), + ?line test_ftl("2.5e+1", 25.0), + ?line test_ftl("2.5e+0", 2.5), + ?line test_ftl("2.5e-1", 0.25), + ?line test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No ?line on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%% Tests integer_to_list/1. + +t_integer_to_list(Config) when is_list(Config) -> + ?line "0" = integer_to_list(id(0)), + ?line "42" = integer_to_list(id(42)), + ?line "-42" = integer_to_list(id(-42)), + ?line "32768" = integer_to_list(id(32768)), + ?line "268435455" = integer_to_list(id(268435455)), + ?line "-268435455" = integer_to_list(id(-268435455)), + ?line "123456932798748738738" = integer_to_list(id(123456932798748738738)), + ?line Big_List = id(lists:duplicate(2000, id($1))), + ?line Big = list_to_integer(Big_List), + ?line Big_List = integer_to_list(Big), + ok. + +%% Tests list_to_float/1. + +t_list_to_float(suite) -> [t_list_to_float_safe, t_list_to_float_risky]. + +t_list_to_float_safe(Config) when is_list(Config) -> + ?line 0.0 = list_to_float(id("0.0")), + ?line 0.0 = list_to_float(id("-0.0")), + ?line 0.5 = list_to_float(id("0.5")), + ?line -0.5 = list_to_float(id("-0.5")), + ?line 100.0 = list_to_float(id("1.0e2")), + ?line 127.5 = list_to_float(id("127.5")), + ?line -199.5 = list_to_float(id("-199.5")), + + ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0"))), + ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0..0"))), + ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("0e12"))), + ?line {'EXIT',{badarg,_}} = (catch list_to_float(id("--0.0"))), + + ok. + +%% This might crash the emulator... +%% (Known to crash the Unix version of Erlang 4.4.1) + +t_list_to_float_risky(Config) when is_list(Config) -> + ?line Many_Ones = lists:duplicate(25000, id($1)), + ?line id(list_to_float("2."++Many_Ones)), + ?line {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), + ok. + +%% Tests list_to_integer/1. + +t_list_to_integer(Config) when is_list(Config) -> + ?line 0 = list_to_integer(id("0")), + ?line 0 = list_to_integer(id("00")), + ?line 0 = list_to_integer(id("-0")), + ?line 1 = list_to_integer(id("1")), + ?line -1 = list_to_integer(id("-1")), + ?line 42 = list_to_integer(id("42")), + ?line -12 = list_to_integer(id("-12")), + ?line 32768 = list_to_integer(id("32768")), + ?line 268435455 = list_to_integer(id("268435455")), + ?line -268435455 = list_to_integer(id("-268435455")), + + %% Bignums. + ?line 123456932798748738738 = list_to_integer(id("123456932798748738738")), + ?line id(list_to_integer(lists:duplicate(2000, id($1)))), + ok. + +%% Tests round/1. + +t_round(Config) when is_list(Config) -> + ?line 0 = round(id(0.0)), + ?line 0 = round(id(0.4)), + ?line 1 = round(id(0.5)), + ?line 0 = round(id(-0.4)), + ?line -1 = round(id(-0.5)), + ?line 255 = round(id(255.3)), + ?line 256 = round(id(255.6)), + ?line -1033 = round(id(-1033.3)), + ?line -1034 = round(id(-1033.6)), + + % OTP-3722: + ?line X = id((1 bsl 27) - 1), + ?line MX = -X, + ?line MXm1 = -X-1, + ?line MXp1 = -X+1, + ?line F = id(X + 0.0), + ?line X = round(F), + ?line X = round(F+1)-1, + ?line X = round(F-1)+1, + ?line MX = round(-F), + ?line MXm1 = round(-F-1), + ?line MXp1 = round(-F+1), + + ?line X = round(F+0.1), + ?line X = round(F+1+0.1)-1, + ?line X = round(F-1+0.1)+1, + ?line MX = round(-F+0.1), + ?line MXm1 = round(-F-1+0.1), + ?line MXp1 = round(-F+1+0.1), + + ?line X = round(F-0.1), + ?line X = round(F+1-0.1)-1, + ?line X = round(F-1-0.1)+1, + ?line MX = round(-F-0.1), + ?line MXm1 = round(-F-1-0.1), + ?line MXp1 = round(-F+1-0.1), + + ?line 0.5 = abs(round(F+0.5)-(F+0.5)), + ?line 0.5 = abs(round(F-0.5)-(F-0.5)), + ?line 0.5 = abs(round(-F-0.5)-(-F-0.5)), + ?line 0.5 = abs(round(-F+0.5)-(-F+0.5)), + + %% Bignums. + ?line 4294967296 = round(id(4294967296.1)), + ?line 4294967297 = round(id(4294967296.9)), + ?line -4294967296 = -round(id(4294967296.1)), + ?line -4294967297 = -round(id(4294967296.9)), + ok. + +t_trunc(Config) when is_list(Config) -> + ?line 0 = trunc(id(0.0)), + ?line 5 = trunc(id(5.3333)), + ?line -10 = trunc(id(-10.978987)), + + % The largest smallnum, converted to float (OTP-3722): + ?line X = id((1 bsl 27) - 1), + ?line F = id(X + 0.0), + io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", + [X, X, binary_to_list(term_to_binary(X)), + F, F, binary_to_list(term_to_binary(F)), + trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), + ?line X = trunc(F), + ?line X = trunc(F+1)-1, + ?line X = trunc(F-1)+1, + ?line X = -trunc(-F), + ?line X = -trunc(-F-1)-1, + ?line X = -trunc(-F+1)+1, + + %% Bignums. + ?line 4294967305 = trunc(id(4294967305.7)), + ?line -4294967305 = trunc(id(-4294967305.7)), + ok. + +% Calling this function (which is not supposed to be inlined) prevents +% the compiler from calculating the answer, so we don't test the compiler +% instead of the newest runtime system. +id(X) -> X. diff --git a/erts/emulator/test/obsolete_SUITE.erl b/erts/emulator/test/obsolete_SUITE.erl new file mode 100644 index 0000000000..33c4726699 --- /dev/null +++ b/erts/emulator/test/obsolete_SUITE.erl @@ -0,0 +1,123 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + + +-module(obsolete_SUITE). +-author('rickard.s.green@ericsson.com'). +-compile(nowarn_obsolete_guard). + +-export([all/1]). + +-export([erl_threads/1]). + +-include("test_server.hrl"). + +-define(DEFAULT_TIMETRAP_SECS, 240). + +all(doc) -> []; +all(suite) -> + case catch erlang:system_info(wordsize) of + 4 -> [erl_threads]; + _ -> {skip, "Only expected to work on 32-bit architectures"} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Testcases %% +%% %% + +erl_threads(suite) -> []; +erl_threads(doc) -> []; +erl_threads(Cfg) -> + ?line case erlang:system_info(threads) of + true -> + ?line drv_case(Cfg, erl_threads); + false -> + ?line {skip, "Emulator not compiled with threads support"} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Internal functions %% +%% %% + +drv_case(Config, CaseName) -> + drv_case(Config, CaseName, ""). + +drv_case(Config, CaseName, TimeTrap) when integer(TimeTrap) -> + drv_case(Config, CaseName, "", TimeTrap); +drv_case(Config, CaseName, Command) when list(Command) -> + drv_case(Config, CaseName, Command, ?DEFAULT_TIMETRAP_SECS). + +drv_case(Config, CaseName, TimeTrap, Command) when list(Command), + integer(TimeTrap) -> + drv_case(Config, CaseName, Command, TimeTrap); +drv_case(Config, CaseName, Command, TimeTrap) when list(Config), + atom(CaseName), + list(Command), + integer(TimeTrap) -> + case ?t:os_type() of + {Family, _} when Family == unix; Family == win32 -> + ?line run_drv_case(Config, CaseName, Command, TimeTrap); + SkipOs -> + ?line {skipped, + lists:flatten(["Not run on " + | io_lib:format("~p",[SkipOs])])} + end. + +run_drv_case(Config, CaseName, Command, TimeTrap) -> + ?line Dog = test_server:timetrap(test_server:seconds(TimeTrap)), + ?line DataDir = ?config(data_dir,Config), + case erl_ddll:load_driver(DataDir, CaseName) of + ok -> ok; + {error, Error} -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + ?line ?t:fail() + end, + ?line Port = open_port({spawn, atom_to_list(CaseName)}, []), + ?line true = is_port(Port), + ?line Port ! {self(), {command, Command}}, + ?line Result = receive_drv_result(Port, CaseName), + ?line Port ! {self(), close}, + ?line receive + {Port, closed} -> + ok + end, + ?line ok = erl_ddll:unload_driver(CaseName), + ?line test_server:timetrap_cancel(Dog), + ?line Result. + +receive_drv_result(Port, CaseName) -> + ?line receive + {print, Port, CaseName, Str} -> + ?line ?t:format("~s", [Str]), + ?line receive_drv_result(Port, CaseName); + {'EXIT', Port, Error} -> + ?line ?t:fail(Error); + {'EXIT', error, Error} -> + ?line ?t:fail(Error); + {failed, Port, CaseName, Comment} -> + ?line ?t:fail(Comment); + {skipped, Port, CaseName, Comment} -> + ?line {skipped, Comment}; + {succeeded, Port, CaseName, ""} -> + ?line succeeded; + {succeeded, Port, CaseName, Comment} -> + ?line {comment, Comment} + end. diff --git a/erts/emulator/test/obsolete_SUITE_data/Makefile.src b/erts/emulator/test/obsolete_SUITE_data/Makefile.src new file mode 100644 index 0000000000..d8e2b861c0 --- /dev/null +++ b/erts/emulator/test/obsolete_SUITE_data/Makefile.src @@ -0,0 +1,33 @@ +# ``The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved via the world wide web at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# The Initial Developer of the Original Code is Ericsson Utvecklings AB. +# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +# AB. All Rights Reserved.'' +# +# $Id$ +# + +TEST_DRVS = erl_threads@dll@ +CC = @CC@ +LD = @LD@ +CFLAGS = @SHLIB_CFLAGS@ -I@erl_include@ @DEFS@ +SHLIB_EXTRA_LDLIBS = testcase_driver@obj@ + +all: $(TEST_DRVS) + +@SHLIB_RULES@ + +testcase_driver@obj@: testcase_driver.c testcase_driver.h +$(TEST_DRVS): testcase_driver@obj@ + + + diff --git a/erts/emulator/test/obsolete_SUITE_data/erl_threads.c b/erts/emulator/test/obsolete_SUITE_data/erl_threads.c new file mode 100644 index 0000000000..27a5163121 --- /dev/null +++ b/erts/emulator/test/obsolete_SUITE_data/erl_threads.c @@ -0,0 +1,302 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" + +#ifndef __WIN32__ + +#define NO_OF_THREADS 2 + +#include +#include + +static int die; +static int cw_passed; +static int res_tf0; +static int res_tf1; +static erl_mutex_t mtx; +static erl_cond_t cnd; +static erl_thread_t tid[NO_OF_THREADS]; +static int need_join[NO_OF_THREADS]; + +typedef struct { + int n; +} thr_arg_t; + + +static void *tf0(void *vta) +{ + int r; + + if (((thr_arg_t *) vta)->n != 0) + goto fail; + + r = erts_mutex_lock(mtx); + if (r != 0) { + erts_mutex_unlock(mtx); + goto fail; + } + + r = erts_cond_wait(cnd, mtx); + if (r != 0 || die) { + erts_mutex_unlock(mtx); + goto fail; + } + + cw_passed++; + + r = erts_cond_wait(cnd, mtx); + if (r != 0 || die) { + erts_mutex_unlock(mtx); + goto fail; + } + + cw_passed++; + + r = erts_mutex_unlock(mtx); + if (r != 0) + goto fail; + + res_tf0 = 0; + + return (void *) &res_tf0; + + fail: + return NULL; +} + + +static void *tf1(void *vta) +{ + int r; + + if (((thr_arg_t *) vta)->n != 1) + goto fail; + + r = erts_mutex_lock(mtx); + if (r != 0) { + erts_mutex_unlock(mtx); + goto fail; + } + + r = erts_cond_wait(cnd, mtx); + if (r != 0 || die) { + erts_mutex_unlock(mtx); + goto fail; + } + + cw_passed++; + + r = erts_cond_wait(cnd, mtx); + if (r != 0 || die) { + erts_mutex_unlock(mtx); + goto fail; + } + + cw_passed++; + + r = erts_mutex_unlock(mtx); + if (r != 0) + goto fail; + + res_tf1 = 1; + + erts_thread_exit((void *) &res_tf1); + + res_tf1 = 4711; + + fail: + return NULL; +} + +#endif /* #ifndef __WIN32__ */ + +void +testcase_run(TestCaseState_t *tcs) +{ +#ifdef __WIN32__ + testcase_skipped(tcs, "Nothing to test; not supported on windows."); +#else + int i, r; + void *tres[NO_OF_THREADS]; + thr_arg_t ta[NO_OF_THREADS]; + erl_thread_t t1; + + die = 0; + cw_passed = 0; + + for (i = 0; i < NO_OF_THREADS; i++) + need_join[i] = 0; + + res_tf0 = 17; + res_tf1 = 17; + + cnd = mtx = NULL; + + /* Create mutex and cond */ + mtx = erts_mutex_create(); + ASSERT(tcs, mtx); + cnd = erts_cond_create(); + ASSERT(tcs, cnd); + + /* Create the threads */ + ta[0].n = 0; + r = erts_thread_create(&tid[0], tf0, (void *) &ta[0], 0); + ASSERT(tcs, r == 0); + need_join[0] = 1; + + ta[1].n = 1; + r = erts_thread_create(&tid[1], tf1, (void *) &ta[1], 0); + ASSERT(tcs, r == 0); + need_join[1] = 1; + + /* Make sure the threads waits on cond wait */ + sleep(1); + + r = erts_mutex_lock(mtx); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + ASSERT_CLNUP(tcs, cw_passed == 0, (void) erts_mutex_unlock(mtx)); + + + /* Let one thread pass one cond wait */ + r = erts_cond_signal(cnd); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + r = erts_mutex_unlock(mtx); + ASSERT(tcs, r == 0); + + sleep(1); + + r = erts_mutex_lock(mtx); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + ASSERT_CLNUP(tcs, cw_passed == 1, (void) erts_mutex_unlock(mtx)); + + + /* Let both threads pass one cond wait */ + r = erts_cond_broadcast(cnd); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + r = erts_mutex_unlock(mtx); + ASSERT(tcs, r == 0); + + sleep(1); + + r = erts_mutex_lock(mtx); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + ASSERT_CLNUP(tcs, cw_passed == 3, (void) erts_mutex_unlock(mtx)); + + + /* Let the thread that only have passed one cond wait pass the other one */ + r = erts_cond_signal(cnd); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + r = erts_mutex_unlock(mtx); + ASSERT(tcs, r == 0); + + sleep(1); + + r = erts_mutex_lock(mtx); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + ASSERT_CLNUP(tcs, cw_passed == 4, (void) erts_mutex_unlock(mtx)); + + /* Both threads should have passed both cond waits and exited; + join them and check returned values */ + + r = erts_thread_join(tid[0], &tres[0]); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + need_join[0] = 0; + + ASSERT_CLNUP(tcs, tres[0] == &res_tf0, (void) erts_mutex_unlock(mtx)); + ASSERT_CLNUP(tcs, res_tf0 == 0, (void) erts_mutex_unlock(mtx)); + + r = erts_thread_join(tid[1], &tres[1]); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + need_join[1] = 0; + + ASSERT_CLNUP(tcs, tres[1] == &res_tf1, (void) erts_mutex_unlock(mtx)); + ASSERT_CLNUP(tcs, res_tf1 == 1, (void) erts_mutex_unlock(mtx)); + + /* Test signaling when noone waits */ + + r = erts_cond_signal(cnd); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + /* Test broadcasting when noone waits */ + + r = erts_cond_broadcast(cnd); + ASSERT_CLNUP(tcs, r == 0, (void) erts_mutex_unlock(mtx)); + + /* erts_cond_timedwait() not supported anymore */ + r = erts_cond_timedwait(cnd, mtx, 1000); + ASSERT_CLNUP(tcs, r != 0, (void) erts_mutex_unlock(mtx)); + ASSERT_CLNUP(tcs, + strcmp(erl_errno_id(r), "enotsup") == 0, + (void) erts_mutex_unlock(mtx)); + + r = erts_mutex_unlock(mtx); + ASSERT(tcs, r == 0); + + r = erts_mutex_destroy(mtx); + ASSERT(tcs, r == 0); + mtx = NULL; + + r = erts_cond_destroy(cnd); + ASSERT(tcs, r == 0); + cnd = NULL; + + /* ... */ + t1 = erts_thread_self(); + + if (cw_passed == 4711) { + /* We don't want to execute this just check that the + symbol/symbols is/are defined */ + erts_thread_kill(t1); + } + +#endif /* #ifndef __WIN32__ */ +} + +char * +testcase_name(void) +{ + return "erl_threads"; +} + +void +testcase_cleanup(TestCaseState_t *tcs) +{ + int i; + for (i = 0; i < NO_OF_THREADS; i++) { + if (need_join[i]) { + erts_mutex_lock(mtx); + die = 1; + erts_cond_broadcast(cnd); + erts_mutex_unlock(mtx); + erts_thread_join(tid[1], NULL); + } + } + if (mtx) + erts_mutex_destroy(mtx); + if (cnd) + erts_cond_destroy(cnd); +} + diff --git a/erts/emulator/test/obsolete_SUITE_data/testcase_driver.c b/erts/emulator/test/obsolete_SUITE_data/testcase_driver.c new file mode 100644 index 0000000000..99d5adb041 --- /dev/null +++ b/erts/emulator/test/obsolete_SUITE_data/testcase_driver.c @@ -0,0 +1,262 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "testcase_driver.h" +#include +#include +#include +#include +#include + +#ifdef __WIN32__ +#undef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 1 +#define vsnprintf _vsnprintf +#endif + +#ifndef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 0 +#endif + +#define COMMENT_BUF_SZ 4096 + +#define TESTCASE_FAILED 0 +#define TESTCASE_SKIPPED 1 +#define TESTCASE_SUCCEEDED 2 + +typedef struct { + TestCaseState_t visible; + int port; + int result; + jmp_buf done_jmp_buf; + char *comment; + char comment_buf[COMMENT_BUF_SZ]; +} InternalTestCaseState_t; + +long testcase_drv_start(int port, char *command); +int testcase_drv_stop(long drv_data); +int testcase_drv_run(long drv_data, char *buf, int len); + +static DriverEntry testcase_drv_entry = { + NULL, + testcase_drv_start, + testcase_drv_stop, + testcase_drv_run +}; + + +int DRIVER_INIT(testcase_drv)(void *arg) +{ + testcase_drv_entry.driver_name = testcase_name(); + return (int) &testcase_drv_entry; +} + +long +testcase_drv_start(int port, char *command) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) + driver_alloc(sizeof(InternalTestCaseState_t)); + if (!itcs) { + return -1; + } + + itcs->visible.testcase_name = testcase_name(); + itcs->visible.extra = NULL; + itcs->port = port; + itcs->result = TESTCASE_FAILED; + itcs->comment = ""; + + return (long) itcs; +} + +int +testcase_drv_stop(long drv_data) +{ + testcase_cleanup((TestCaseState_t *) drv_data); + driver_free((void *) drv_data); + return 0; +} + +int +testcase_drv_run(long drv_data, char *buf, int len) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) drv_data; + DriverTermData result_atom; + DriverTermData msg[12]; + + itcs->visible.command = buf; + itcs->visible.command_len = len; + + if (setjmp(itcs->done_jmp_buf) == 0) { + testcase_run((TestCaseState_t *) itcs); + itcs->result = TESTCASE_SUCCEEDED; + } + + switch (itcs->result) { + case TESTCASE_SUCCEEDED: + result_atom = driver_mk_atom("succeeded"); + break; + case TESTCASE_SKIPPED: + result_atom = driver_mk_atom("skipped"); + break; + case TESTCASE_FAILED: + default: + result_atom = driver_mk_atom("failed"); + break; + } + + msg[0] = ERL_DRV_ATOM; + msg[1] = (DriverTermData) result_atom; + + msg[2] = ERL_DRV_PORT; + msg[3] = driver_mk_port(itcs->port); + + msg[4] = ERL_DRV_ATOM; + msg[5] = driver_mk_atom(itcs->visible.testcase_name); + + msg[6] = ERL_DRV_STRING; + msg[7] = (DriverTermData) itcs->comment; + msg[8] = (DriverTermData) strlen(itcs->comment); + + msg[9] = ERL_DRV_TUPLE; + msg[10] = (DriverTermData) 4; + + driver_output_term(itcs->port, msg, 11); + return 0; +} + +int +testcase_assertion_failed(TestCaseState_t *tcs, + char *file, int line, char *assertion) +{ + testcase_failed(tcs, "%s:%d: Assertion failed: \"%s\"", + file, line, assertion); + return 0; +} + +void +testcase_printf(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + DriverTermData msg[12]; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + msg[0] = ERL_DRV_ATOM; + msg[1] = (DriverTermData) driver_mk_atom("print"); + + msg[2] = ERL_DRV_PORT; + msg[3] = driver_mk_port(itcs->port); + + msg[4] = ERL_DRV_ATOM; + msg[5] = driver_mk_atom(itcs->visible.testcase_name); + + msg[6] = ERL_DRV_STRING; + msg[7] = (DriverTermData) itcs->comment_buf; + msg[8] = (DriverTermData) strlen(itcs->comment_buf); + + msg[9] = ERL_DRV_TUPLE; + msg[10] = (DriverTermData) 4; + + driver_output_term(itcs->port, msg, 11); +} + + +void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_SUCCEEDED; + itcs->comment = itcs->comment_buf; + + longjmp(itcs->done_jmp_buf, 1); +} + +void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_SKIPPED; + itcs->comment = itcs->comment_buf; + + longjmp(itcs->done_jmp_buf, 1); +} + +void testcase_failed(TestCaseState_t *tcs, char *frmt, ...) +{ + InternalTestCaseState_t *itcs = (InternalTestCaseState_t *) tcs; + char buf[10]; + size_t bufsz = sizeof(buf); + va_list va; + va_start(va, frmt); +#if HAVE_VSNPRINTF + vsnprintf(itcs->comment_buf, COMMENT_BUF_SZ, frmt, va); +#else + vsprintf(itcs->comment_buf, frmt, va); +#endif + va_end(va); + + itcs->result = TESTCASE_FAILED; + itcs->comment = itcs->comment_buf; + + if (erl_drv_getenv("ERL_ABORT_ON_FAILURE", buf, &bufsz) == 0 + && strcmp("true", buf) == 0) { + fprintf(stderr, "Testcase \"%s\" failed: %s\n", + itcs->visible.testcase_name, itcs->comment); + abort(); + } + + longjmp(itcs->done_jmp_buf, 1); +} + +void *testcase_alloc(size_t size) +{ + return driver_alloc(size); +} + +void *testcase_realloc(void *ptr, size_t size) +{ + return driver_realloc(ptr, size); +} + +void testcase_free(void *ptr) +{ + driver_free(ptr); +} diff --git a/erts/emulator/test/obsolete_SUITE_data/testcase_driver.h b/erts/emulator/test/obsolete_SUITE_data/testcase_driver.h new file mode 100644 index 0000000000..3d85ca6df0 --- /dev/null +++ b/erts/emulator/test/obsolete_SUITE_data/testcase_driver.h @@ -0,0 +1,57 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#ifndef TESTCASE_DRIVER_H__ +#define TESTCASE_DRIVER_H__ + +#include "obsolete/driver.h" +#include + +typedef struct { + char *testcase_name; + char *command; + int command_len; + void *extra; +} TestCaseState_t; + +#define ASSERT_CLNUP(TCS, B, CLN) \ +do { \ + if (!(B)) { \ + CLN; \ + testcase_assertion_failed((TCS), __FILE__, __LINE__, #B); \ + } \ +} while (0) + +#define ASSERT(TCS, B) ASSERT_CLNUP(TCS, B, (void) 0) + +void testcase_printf(TestCaseState_t *tcs, char *frmt, ...); +void testcase_succeeded(TestCaseState_t *tcs, char *frmt, ...); +void testcase_skipped(TestCaseState_t *tcs, char *frmt, ...); +void testcase_failed(TestCaseState_t *tcs, char *frmt, ...); +int testcase_assertion_failed(TestCaseState_t *tcs, char *file, int line, + char *assertion); +void *testcase_alloc(size_t size); +void *testcase_realloc(void *ptr, size_t size); +void testcase_free(void *ptr); + + +char *testcase_name(void); +void testcase_run(TestCaseState_t *tcs); +void testcase_cleanup(TestCaseState_t *tcs); + +#endif diff --git a/erts/emulator/test/old_mod.erl b/erts/emulator/test/old_mod.erl new file mode 100644 index 0000000000..6c47ba6f8f --- /dev/null +++ b/erts/emulator/test/old_mod.erl @@ -0,0 +1,47 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(old_mod). +-compile(r10). + +-export([sort_on_old_node/1, sorter/3]). + +-include("test_server.hrl"). + +sorter(Receiver, Ref, List) -> + Receiver ! {Ref, lists:sort(List)}. + +sort_on_old_node(List) when is_list(List) -> + OldVersion = "r10", + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {X, Y, Z} = now(), + ?line NodeName = list_to_atom(OldVersion + ++ "_" + ++ integer_to_list(X) + ++ integer_to_list(Y) + ++ integer_to_list(Z)), + ?line {ok, Node} = ?t:start_node(NodeName, + peer, + [{args, " -pa " ++ Pa}, + {erl, [{release, OldVersion++"b_patched"}]}]), + ?line Ref = make_ref(), + ?line spawn_link(Node, ?MODULE, sorter, [self(), Ref, List]), + ?line SortedPids = receive {Ref, SP} -> SP end, + ?line true = ?t:stop_node(Node), + ?line SortedPids. diff --git a/erts/emulator/test/old_scheduler_SUITE.erl b/erts/emulator/test/old_scheduler_SUITE.erl new file mode 100644 index 0000000000..70348f64db --- /dev/null +++ b/erts/emulator/test/old_scheduler_SUITE.erl @@ -0,0 +1,394 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(old_scheduler_SUITE). + +-include("test_server.hrl"). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). +-export([equal/1, many_low/1, few_low/1, max/1, high/1]). + +-define(default_timeout, ?t:minutes(11)). + +all(suite) -> + case catch erlang:system_info(modified_timing_level) of + Level when is_integer(Level) -> + {skipped, + "Modified timing (level " ++ integer_to_list(Level) + ++ ") is enabled. Testcases gets messed up by modfied " + "timing."}; + _ -> + [equal, many_low, few_low, max, high] + end. + +%%----------------------------------------------------------------------------------- +%% TEST SUITE DESCRIPTION +%% +%% The test case function spawns two controlling processes: Starter and Receiver. +%% Starter spawns a number of prio A and a number of prio B test processes. Each +%% test process loops for a number of times, sends a report to the Receiver, then +%% loops again. For each report, the Receiver increases a counter that corresponds +%% to the priority of the sender. After a certain amount of time, the Receiver +%% sends the collected data to the main test process and waits for the test case +%% to terminate. From this data, it's possible to calculate the average run time +%% relationship between the prio A and B test processes. +%% +%% Note that in order to be able to run tests with high or max prio test processes, +%% the main test process and the Receiver needs to run at max prio, or they will +%% be starved by the test processes. The controlling processes must not wait for +%% messages from a normal (or low) prio process while max or high prio test processes +%% are running (which happens e.g. if an io function is called). +%%----------------------------------------------------------------------------------- + +init_per_testcase(_Case, Config) -> + ?line Dog = test_server:timetrap(?default_timeout), + %% main test process needs max prio + ?line Prio = process_flag(priority, max), + ?line MS = erlang:system_flag(multi_scheduling, block), + [{prio,Prio},{watchdog,Dog},{multi_scheduling, MS}|Config]. + +fin_per_testcase(_Case, Config) -> + erlang:system_flag(multi_scheduling, unblock), + Dog=?config(watchdog, Config), + Prio=?config(prio, Config), + process_flag(priority, Prio), + test_server:timetrap_cancel(Dog), + ok. + +ok(Config) when is_list(Config) -> + case ?config(multi_scheduling, Config) of + blocked -> + {comment, + "Multi-scheduling blocked during test. This testcase was not " + "written to work with multiple schedulers."}; + _ -> ok + end. + +%% Run equal number of low and normal prio processes. + +equal(suite) -> []; +equal(doc) -> []; +equal(Config) when is_list(Config) -> + ?line Self = self(), + + %% specify number of test processes to run + Normal = {normal,500}, + Low = {low,500}, + + %% specify time of test (in seconds) + Time = 30, + + %% start controllers + ?line Receiver = + spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), + ?line Starter = + spawn(fun() -> starter(Normal, Low, Receiver) end), + + %% receive test data from Receiver + ?line {NRs,NAvg,LRs,LAvg,Ratio} = + receive + {Receiver,Res} -> Res + end, + + %% stop controllers and test processes + ?line exit(Starter, kill), + ?line exit(Receiver, kill), + + io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", + [NRs,NAvg,LRs,LAvg,Ratio]), + + %% runtime ratio between normal and low should be ~8 + if Ratio < 7.5 ; Ratio > 8.5 -> + ?t:fail({bad_ratio,Ratio}); + true -> + ok(Config) + end. + + +%% Run many low and few normal prio processes. + +many_low(suite) -> []; +many_low(doc) -> []; +many_low(Config) when is_list(Config) -> + ?line Self = self(), + Normal = {normal,1}, + Low = {low,1000}, + + %% specify time of test (in seconds) + Time = 30, + + ?line Receiver = + spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), + ?line Starter = + spawn(fun() -> starter(Normal, Low, Receiver) end), + ?line {NRs,NAvg,LRs,LAvg,Ratio} = + receive + {Receiver,Res} -> Res + end, + ?line exit(Starter, kill), + ?line exit(Receiver, kill), + io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", + [NRs,NAvg,LRs,LAvg,Ratio]), + if Ratio < 7.5 ; Ratio > 8.5 -> + ?t:fail({bad_ratio,Ratio}); + true -> + ok(Config) + end. + + +%% Run few low and many normal prio processes. + +few_low(suite) -> []; +few_low(doc) -> []; +few_low(Config) when is_list(Config) -> + ?line Self = self(), + Normal = {normal,1000}, + Low = {low,1}, + + %% specify time of test (in seconds) + Time = 30, + + ?line Receiver = + spawn(fun() -> receiver(now(), Time, Self, Normal, Low) end), + ?line Starter = + spawn(fun() -> starter(Normal, Low, Receiver) end), + ?line {NRs,NAvg,LRs,LAvg,Ratio} = + receive + {Receiver,Res} -> Res + end, + ?line exit(Starter, kill), + ?line exit(Receiver, kill), + io:format("Reports: ~w normal (~w/proc), ~w low (~w/proc). Ratio: ~w~n", + [NRs,NAvg,LRs,LAvg,Ratio]), + if Ratio < 7.0 ; Ratio > 8.5 -> + ?t:fail({bad_ratio,Ratio}); + true -> + ok(Config) + end. + + +%% Run max prio processes and verify they get at least as much +%% runtime as high, normal and low. + +max(suite) -> []; +max(doc) -> []; +max(Config) when is_list(Config) -> + max = process_flag(priority, max), % should already be max (init_per_tc) + ?line Self = self(), + Max = {max,2}, + High = {high,2}, + Normal = {normal,100}, + Low = {low,100}, + + %% specify time of test (in seconds) + Time = 30, + + ?line Receiver1 = + spawn(fun() -> receiver(now(), Time, Self, Max, High) end), + ?line Starter1 = + spawn(fun() -> starter(Max, High, Receiver1) end), + ?line {M1Rs,M1Avg,HRs,HAvg,Ratio1} = + receive + {Receiver1,Res1} -> Res1 + end, + ?line exit(Starter1, kill), + ?line exit(Receiver1, kill), + io:format("Reports: ~w max (~w/proc), ~w high (~w/proc). Ratio: ~w~n", + [M1Rs,M1Avg,HRs,HAvg,Ratio1]), + if Ratio1 < 1.0 -> + ?t:fail({bad_ratio,Ratio1}); + true -> + ok(Config) + end, + + ?line Receiver2 = + spawn(fun() -> receiver(now(), Time, Self, Max, Normal) end), + ?line Starter2 = + spawn(fun() -> starter(Max, Normal, Receiver2) end), + ?line {M2Rs,M2Avg,NRs,NAvg,Ratio2} = + receive + {Receiver2,Res2} -> Res2 + end, + ?line exit(Starter2, kill), + ?line exit(Receiver2, kill), + io:format("Reports: ~w max (~w/proc), ~w normal (~w/proc). Ratio: ~w~n", + [M2Rs,M2Avg,NRs,NAvg,Ratio2]), + if Ratio2 < 1.0 -> + ?t:fail({bad_ratio,Ratio2}); + true -> + ok + end, + + ?line Receiver3 = + spawn(fun() -> receiver(now(), Time, Self, Max, Low) end), + ?line Starter3 = + spawn(fun() -> starter(Max, Low, Receiver3) end), + ?line {M3Rs,M3Avg,LRs,LAvg,Ratio3} = + receive + {Receiver3,Res3} -> Res3 + end, + ?line exit(Starter3, kill), + ?line exit(Receiver3, kill), + io:format("Reports: ~w max (~w/proc), ~w low (~w/proc). Ratio: ~w~n", + [M3Rs,M3Avg,LRs,LAvg,Ratio3]), + if Ratio3 < 1.0 -> + ?t:fail({bad_ratio,Ratio3}); + true -> + ok(Config) + end. + + +%% Run high prio processes and verify they get at least as much +%% runtime as normal and low. + +high(suite) -> []; +high(doc) -> []; +high(Config) when is_list(Config) -> + max = process_flag(priority, max), % should already be max (init_per_tc) + ?line Self = self(), + High = {high,2}, + Normal = {normal,100}, + Low = {low,100}, + + %% specify time of test (in seconds) + Time = 30, + + ?line Receiver1 = + spawn(fun() -> receiver(now(), Time, Self, High, Normal) end), + ?line Starter1 = + spawn(fun() -> starter(High, Normal, Receiver1) end), + ?line {H1Rs,H1Avg,NRs,NAvg,Ratio1} = + receive + {Receiver1,Res1} -> Res1 + end, + ?line exit(Starter1, kill), + ?line exit(Receiver1, kill), + io:format("Reports: ~w high (~w/proc), ~w normal (~w/proc). Ratio: ~w~n", + [H1Rs,H1Avg,NRs,NAvg,Ratio1]), + if Ratio1 < 1.0 -> + ?t:fail({bad_ratio,Ratio1}); + true -> + ok + end, + + ?line Receiver2 = + spawn(fun() -> receiver(now(), Time, Self, High, Low) end), + ?line Starter2 = + spawn(fun() -> starter(High, Low, Receiver2) end), + ?line {H2Rs,H2Avg,LRs,LAvg,Ratio2} = + receive + {Receiver2,Res2} -> Res2 + end, + ?line exit(Starter2, kill), + ?line exit(Receiver2, kill), + io:format("Reports: ~w high (~w/proc), ~w low (~w/proc). Ratio: ~w~n", + [H2Rs,H2Avg,LRs,LAvg,Ratio2]), + if Ratio2 < 1.0 -> + ?t:fail({bad_ratio,Ratio2}); + true -> + ok(Config) + end. + + +%%----------------------------------------------------------------------------------- +%% Controller processes and help functions +%%----------------------------------------------------------------------------------- + +receiver(T0, TimeSec, Main, {P1,P1N}, {P2,P2N}) -> + %% prio should be max so that mailbox doesn't overflow + process_flag(priority, max), + receiver(T0, TimeSec*1000, Main, P1,P1N,0, P2,P2N,0, 100000). + +%% uncomment lines below to get life sign (debug) +receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 0) -> +% T = elapsed_ms(T0, now()), +% erlang:display({round(T/1000),P1Rs,P2Rs}), + receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, 100000); + +receiver(T0, Time, Main, P1,P1N,P1Rs, P2,P2N,P2Rs, C) -> + Remain = Time - elapsed_ms(T0, now()), % test time remaining + Remain1 = if Remain < 0 -> + 0; + true -> + Remain + end, + {P1Rs1,P2Rs1} = + receive + {_Pid,P1} -> % report from a P1 process + {P1Rs+1,P2Rs}; + {_Pid,P2} -> % report from a P2 process + {P1Rs,P2Rs+1} + after Remain1 -> + {P1Rs,P2Rs} + end, + if Remain > 0 -> % keep going + receiver(T0, Time, Main, P1,P1N,P1Rs1, P2,P2N,P2Rs1, C-1); + true -> % finish + %% calculate results and send to main test process + P1Avg = P1Rs1/P1N, + P2Avg = P2Rs1/P2N, + Ratio = if P2Avg < 1.0 -> P1Avg; + true -> P1Avg/P2Avg + end, + Main ! {self(),{P1Rs1,round(P1Avg),P2Rs1,round(P2Avg),Ratio}}, + flush_loop() + end. + +starter({P1,P1N}, {P2,P2N}, Receiver) -> + %% start N1 processes with prio P1 + start_p(P1, P1N, Receiver), + %% start N2 processes with prio P2 + start_p(P2, P2N, Receiver), + erlang:display({started,P1N+P2N}), + flush_loop(). + +start_p(_, 0, _) -> + ok; +start_p(Prio, N, Receiver) -> + spawn_link(fun() -> p(Prio, Receiver) end), + start_p(Prio, N-1, Receiver). + +p(Prio, Receiver) -> + %% set process priority + process_flag(priority, Prio), + p_loop(0, Prio, Receiver). + +p_loop(100, Prio, Receiver) -> + receive after 0 -> ok end, + %% if Receiver gone, we're done + case is_process_alive(Receiver) of + false -> exit(bye); + true -> ok + end, + %% send report + Receiver ! {self(),Prio}, + p_loop(0, Prio, Receiver); + +p_loop(N, Prio, Receiver) -> + p_loop(N+1, Prio, Receiver). + + +flush_loop() -> + receive _ -> + ok + end, + flush_loop(). + +elapsed_ms({_MS0,S0,MuS0},{_MS1,S1,MuS1}) -> + round(((S1-S0)*1000)+((MuS1-MuS0)/1000)). diff --git a/erts/emulator/test/op_SUITE.erl b/erts/emulator/test/op_SUITE.erl new file mode 100644 index 0000000000..55d8d9ab0f --- /dev/null +++ b/erts/emulator/test/op_SUITE.erl @@ -0,0 +1,368 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(op_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + bsl_bsr/1,logical/1,t_not/1,relop_simple/1,relop/1,complex_relop/1]). + +-export([]). +-import(lists, [foldl/3,flatmap/2]). + +all(suite) -> + [bsl_bsr,logical,t_not,relop_simple,relop,complex_relop]. + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(3)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +%% Test the bsl and bsr operators. +bsl_bsr(Config) when is_list(Config) -> + Vs = [unvalue(V) || V <- [-16#8000009-2,-1,0,1,2,73,16#8000000,bad,[]]], + Cases = [{Op,X,Y} || Op <- ['bsr','bsl'], X <- Vs, Y <- Vs], + ?line run_test_module(Cases, false), + {comment,integer_to_list(length(Cases)) ++ " cases"}. + +logical(doc) -> "Test the logical operators and internal BIFs."; +logical(Config) when is_list(Config) -> + Vs0 = [true,false,bad], + Vs = [unvalue(V) || V <- Vs0], + Cases = [{Op,X,Y} || Op <- ['and','or','xor'], X <- Vs, Y <- Vs], + ?line run_test_module(Cases, false), + {comment,integer_to_list(length(Cases)) ++ " cases"}. + +t_not(doc) -> "Test the not operator and internal BIFs."; +t_not(Config) when is_list(Config) -> + ?line Cases = [{'not',unvalue(V)} || V <- [true,false,42,bad]], + ?line run_test_module(Cases, false), + {comment,integer_to_list(length(Cases)) ++ " cases"}. + +relop_simple(doc) -> "Test that simlpe relations between relation operators hold."; +relop_simple(Config) when is_list(Config) -> + Big1 = 19738924729729787487784874, + Big2 = 38374938373887374983978484, + F1 = float(Big1), + F2 = float(Big2), + T1 = erlang:make_tuple(3,87), + T2 = erlang:make_tuple(3,87), + Terms = [-F2,Big2,-F1,-Big1,-33,-33.0,0,0.0,42,42.0,Big1,F1,Big2,F2,a,b, + {T1,a},{T2,b},[T1,Big1],[T2,Big2]], + + ?line Combos = [{V1,V2} || V1 <- Terms, V2 <- Terms], + + lists:foreach(fun({A,B}) -> relop_simple_do(A,B) end, + Combos), + + repeat(fun() -> Size = random:uniform(100), + Rnd1 = make_rand_term(Size), + {Rnd2,0} = clone_and_mutate(Rnd1, random:uniform(Size)), + relop_simple_do(Rnd1,Rnd2) + end, + 1000), + ok. + +relop_simple_do(V1,V2) -> + %%io:format("compare ~p\n and ~p\n",[V1,V2]), + + L = V1 < V2, + ?line L = not (V1 >= V2), + ?line L = V2 > V1, + ?line L = not (V2 =< V1), + + G = V1 > V2, + ?line G = not (V1 =< V2), + ?line G = V2 < V1, + ?line G = not (V2 >= V1), + + ID = V1 =:= V2, + ?line ID = V2 =:= V1, + ?line ID = not (V1 =/= V2), + ?line ID = not (V2 =/= V1), + + EQ = V1 == V2, + ?line EQ = V2 == V1, + ?line EQ = not (V1 /= V2), + ?line EQ = not (V2 /= V1), + + ?line case {L, EQ, ID, G, cmp_emu(V1,V2)} of + { true, false, false, false, -1} -> ok; + {false, true, false, false, 0} -> ok; + {false, true, true, false, 0} -> ok; + {false, false, false, true, +1} -> ok + end. + +%% Emulate internal "cmp" +cmp_emu(A,B) when is_tuple(A), is_tuple(B) -> + SA = size(A), + SB = size(B), + if SA =:= SB -> cmp_emu(tuple_to_list(A),tuple_to_list(B)); + SA > SB -> +1; + SA < SB -> -1 + end; +cmp_emu([A|TA],[B|TB]) -> + case cmp_emu(A,B) of + 0 -> cmp_emu(TA,TB); + CMP -> CMP + end; +cmp_emu(A,B) -> + %% We cheat and use real "cmp" for the primitive types. + if A < B -> -1; + A > B -> +1; + true -> 0 + end. + +make_rand_term(1) -> + make_rand_term_single(); +make_rand_term(Arity) -> + case random:uniform(3) of + 1 -> + make_rand_list(Arity); + 2 -> + list_to_tuple(make_rand_list(Arity)); + 3 -> + {Car,Rest} = make_rand_term_rand_size(Arity), + [Car|make_rand_term(Rest)] + end. + +make_rand_term_single() -> + Range = 1 bsl random:uniform(200), + case random:uniform(12) of + 1 -> random; + 2 -> uniform; + 3 -> random:uniform(Range) - (Range div 2); + 4 -> Range * (random:uniform() - 0.5); + 5 -> 0; + 6 -> 0.0; + 7 -> make_ref(); + 8 -> self(); + 9 -> term_to_binary(random:uniform(Range)); + 10 -> fun(X) -> X*Range end; + 11 -> fun(X) -> X/Range end; + 12 -> [] + end. + +make_rand_term_rand_size(1) -> + {make_rand_term(1), 0}; +make_rand_term_rand_size(MaxArity) -> + Arity = random:uniform(MaxArity-1), + {make_rand_term(Arity), MaxArity-Arity}. + +make_rand_list(0) -> []; +make_rand_list(Arity) -> + {Term, Rest} = make_rand_term_rand_size(Arity), + [Term | make_rand_list(Rest)]. + + +clone_and_mutate(Term, 0) -> + {clone(Term), 0}; +clone_and_mutate(_Term, 1) -> + {Mutation, _} = make_rand_term_rand_size(10), % MUTATE! + {Mutation, 0}; +clone_and_mutate(Term, Cnt) when is_tuple(Term) -> + {Clone,NewCnt} = clone_and_mutate(tuple_to_list(Term),Cnt), + {my_list_to_tuple(Clone), NewCnt}; +clone_and_mutate([Term|Tail], Cnt) -> + {Car,Cnt1} = clone_and_mutate(Term,Cnt), + {Cdr,Cnt2} = clone_and_mutate(Tail,Cnt1), + {[Car | Cdr], Cnt2}; +clone_and_mutate(Term, Cnt) -> + {clone(Term), Cnt-1}. + +clone(Term) -> + binary_to_term(term_to_binary(Term)). + +my_list_to_tuple(List) -> + try list_to_tuple(List) + catch + error:badarg -> + %%io:format("my_list_to_tuple got badarg exception.\n"), + list_to_tuple(purify_list(List)) + end. + +purify_list(List) -> + lists:reverse(purify_list(List, [])). +purify_list([], Acc) -> Acc; +purify_list([H|T], Acc) -> purify_list(T, [H|Acc]); +purify_list(Other, Acc) -> [Other|Acc]. + + +relop(doc) -> "Test the relational operators and internal BIFs on literals."; +relop(Config) when is_list(Config) -> + Big1 = -38374938373887374983978484, + Big2 = 19738924729729787487784874, + F1 = float(Big1), + F2 = float(Big2), + Vs0 = [a,b,-33,-33.0,0,0.0,42,42.0,Big1,Big2,F1,F2], + ?line Vs = [unvalue(V) || V <- Vs0], + Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='], + ?line binop(Ops, Vs). + +complex_relop(doc) -> + "Test the relational operators and internal BIFs on lists and tuples."; +complex_relop(Config) when is_list(Config) -> + Big = 99678557475484872464269855544643333, + Float = float(Big), + Vs0 = [an_atom,42.0,42,Big,Float], + Vs = flatmap(fun(X) -> [unvalue({X}),unvalue([X])] end, Vs0), + Ops = ['==', '/=', '=:=', '=/=', '<', '=<', '>', '>='], + ?line binop(Ops, Vs). + +binop(Ops, Vs) -> + Run = fun(Op, N) -> ?line Cases = [{Op,V1,V2} || V1 <- Vs, V2 <- Vs], + ?line run_test_module(Cases, true), + N + length(Cases) end, + ?line NumCases = foldl(Run, 0, Ops), + {comment,integer_to_list(NumCases) ++ " cases"}. + +run_test_module(Cases, GuardsOk) -> + ?line Es = [expr(C) || C <- Cases], + ?line Ok = unvalue(ok), + ?line Gts = case GuardsOk of + true -> + Ges = [guard_expr(C) || C <- Cases], + ?line lists:foldr(fun guard_test/2, [Ok], Ges); + false -> + [Ok] + end, + ?line Fun1 = make_function(guard_tests, Gts), + ?line Bts = lists:foldr(fun body_test/2, [Ok], Es), + ?line Fun2 = make_function(body_tests, Bts), + ?line Bbts = lists:foldr(fun internal_bif/2, [Ok], Es), + ?line Fun3 = make_function(bif_tests, Bbts), + ?line Id = {function,1,id,1,[{clause,1,[{var,1,'I'}],[],[{var,1,'I'}]}]}, + ?line Module = make_module(op_tests, [Fun1,Fun2,Fun3,Id]), + ?line lists:foreach(fun(F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Module), + + %% Compile, load, and run the generated module. + + Native = case ?t:is_native(?MODULE) of + true -> [native]; + false -> [] + end, + ?line {ok,Mod,Code1} = compile:forms(Module, [time|Native]), + ?line code:delete(Mod), + ?line code:purge(Mod), + ?line {module,Mod} = code:load_binary(Mod, Mod, Code1), + ?line run_function(Mod, guard_tests), + ?line run_function(Mod, body_tests), + ?line run_function(Mod, bif_tests), + + ?line true = code:delete(Mod), + ?line code:purge(Mod), + + ok. + +expr({Op,X}) -> + E = {op,1,Op,{call,1,{atom,1,id},[X]}}, + Res = eval([{op,1,Op,X}]), + {E,{Op,X},Res}; +expr({Op,X,Y}) -> + E = {op,1,Op,{call,1,{atom,1,id},[X]},Y}, + Res = eval([{op,1,Op,X,Y}]), + {E,{Op,value(X),value(Y)},Res}. + +guard_expr({Op,X}) -> + E = {op,1,Op,X}, + Res = eval([E]), + {E,{Op,X},Res}; +guard_expr({Op,X,Y}) -> + E = {op,1,Op,X,Y}, + Res = eval([E]), + {E,{Op,value(X),value(Y)},Res}. + +run_function(Mod, Name) -> + case catch Mod:Name() of + {'EXIT',Reason} -> + io:format("~p", [get(last)]), + ?t:fail({'EXIT',Reason}); + _Other -> + ok + end. + +guard_test({E,Expr,Res}, Tail) -> + True = unvalue(true), + [save_term(Expr), + {match,1,unvalue(Res), + {'if',1,[{clause,1,[],[[E]],[True]}, + {clause,1,[],[[True]],[unvalue(false)]}]}}|Tail]. + +body_test({E,Expr,{'EXIT',_}}, Tail) -> + [save_term(Expr), + {match,1,{tuple,1,[unvalue('EXIT'), {var,1,'_'}]}, + {'catch',1,E}}|Tail]; +body_test({E,Expr,Res}, Tail) -> + [save_term(Expr), + {match,1,unvalue(Res),E}|Tail]. + +internal_bif({{op,_,Op,X},Expr,Res}, Tail) -> + internal_bif(Op, [X], Expr, Res, Tail); +internal_bif({{op,_,Op,X,Y},Expr,Res}, Tail) -> + internal_bif(Op, [X,Y], Expr, Res, Tail). + +internal_bif(Op, Args, Expr, {'EXIT',_}, Tail) -> + [save_term(Expr), + {match,1,{tuple,1,[unvalue('EXIT'), {var,1,'_'}]}, + {'catch',1,{call,1,{remote,1,{atom,1,erlang},unvalue(Op)},Args}}}|Tail]; +internal_bif(Op, Args, Expr, Res, Tail) -> + [save_term(Expr), + {match,1,unvalue(Res), + {call,1,{remote,1,{atom,1,erlang},unvalue(Op)},Args}}|Tail]. + +save_term(Term) -> + {call,1, + {atom,1,put}, + [{atom,1,last},unvalue(Term)]}. + +make_module(Name, Funcs) -> + [{attribute,1,module,Name}, + {attribute,0,compile,export_all}, + {attribute,0,compile,[{hipe,[{regalloc,linear_scan}]}]} | + Funcs ++ [{eof,0}]]. + +make_function(Name, Body) -> + {function,1,Name,0,[{clause,1,[],[],Body}]}. + +eval(E) -> + ?line case catch erl_eval:exprs(E, []) of + {'EXIT',Reason} -> {'EXIT',Reason}; + {value,Val,_Bs} -> Val + end. + +unvalue(V) -> erl_parse:abstract(V). + +value({nil,_}) -> []; +value({integer,_,X}) -> X; +value({string,_,X}) -> X; +value({float,_,X}) -> X; +value({atom,_,X}) -> X; +value({tuple,_,Es}) -> + list_to_tuple(lists:map(fun(X) -> value(X) end, Es)); +value({cons,_,H,T}) -> + [value(H) | value(T)]. + +repeat(_, 0) -> ok; +repeat(Fun, N) -> + Fun(), + repeat(Fun, N-1). diff --git a/erts/emulator/test/port_SUITE.erl b/erts/emulator/test/port_SUITE.erl new file mode 100644 index 0000000000..9a09d20eab --- /dev/null +++ b/erts/emulator/test/port_SUITE.erl @@ -0,0 +1,2288 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(port_SUITE). + +%%% +%%% Author: Bjorn Gustavsson; iter_max_ports contributed by Peter Hogfeldt. +%%% + +%% +%% There are a lot of things to test with open_port(Name, Settings). +%% +%% Name can be +%% +%% {spawn, Command} +%% which according to The Book and the manual page starts an +%% external program. That is not true. It might very well be +%% a linked-in program (the notion of 'linked-in driver' is +%% silly, since any driver is 'linked-in'). +%% [Spawn of external program is tested.] +%% +%% Atom +%% Read all contents of Atom, or write to it. +%% +%% {fd, In, Out} +%% Open file descriptors In and Out. [Not tested] +%% +%% PortSettings can be +%% +%% {packet, N} +%% N is 1, 2 or 4. +%% +%% stream (default) +%% Without packet length. +%% +%% use_stdio (default for spawned ports) +%% The spawned process use file descriptors 0 and 1 for I/O. +%% +%% nouse_stdio [Not tested] +%% Use filedescriptors 3 and 4. This option is probably only +%% meaningful on Unix. +%% +%% in (default for Atom) +%% Input only (from Erlang's point of view). +%% +%% out +%% Output only (from Erlang's point of view). +%% +%% binary +%% The port is a binary port, i.e. messages received and sent +%% to a port are binaries. +%% +%% eof +%% Port is not closed on eof and will not send an exit signal, +%% instead it will send a {Port, eof} to the controlling process +%% (output can still be sent to the port (??)). +%% + + +-export([all/1, init_per_testcase/2, fin_per_testcase/2, + init_per_suite/1, end_per_suite/1, + stream/1, stream_small/1, stream_big/1, + basic_ping/1, slow_writes/1, bad_packet/1, bad_port_messages/1, + multiple_packets/1, mul_basic/1, mul_slow_writes/1, + dying_port/1, port_program_with_path/1, + open_input_file_port/1, open_output_file_port/1, + iter_max_ports/1, eof/1, input_only/1, output_only/1, + name1/1, + t_binary/1, options/1, parallell/1, t_exit/1, + env/1, bad_env/1, cd/1, exit_status/1, + tps/1, tps_16_bytes/1, tps_1K/1, line/1, stderr_to_stdout/1, + otp_3906/1, otp_4389/1, win_massive/1, win_massive_client/1, + mix_up_ports/1, otp_5112/1, otp_5119/1, otp_6224/1, + exit_status_multi_scheduling_block/1, ports/1, + spawn_driver/1,spawn_executable/1]). + +-export([]). + +%% Internal exports. +-export([tps/3]). +-export([otp_3906_forker/5, otp_3906_start_forker_starter/4]). +-export([env_slave_main/1]). + +-include("test_server.hrl"). +-include_lib("kernel/include/file.hrl"). + +all(suite) -> + [ + otp_6224, stream, basic_ping, slow_writes, bad_packet, + bad_port_messages, options, multiple_packets, parallell, + dying_port, port_program_with_path, + open_input_file_port, open_output_file_port, + name1, + env, bad_env, cd, exit_status, + iter_max_ports, t_exit, tps, line, stderr_to_stdout, + otp_3906, otp_4389, win_massive, mix_up_ports, + otp_5112, otp_5119, + exit_status_multi_scheduling_block, + ports, spawn_driver, spawn_executable + ]. + +-define(DEFAULT_TIMEOUT, ?t:minutes(5)). + +init_per_testcase(Case, Config) -> + [{testcase, Case} |Config]. + +fin_per_testcase(_Case, _Config) -> + ok. + +init_per_suite(Config) when is_list(Config) -> + ignore_cores:init(Config). + +end_per_suite(Config) when is_list(Config) -> + ignore_cores:fini(Config). + + +-define(WIN_MASSIVE_PORT, 50000). + +%% Tests that you can open a massive amount of ports (sockets) +%% on a Windows machine given the correct environment. +win_massive(Config) when is_list(Config) -> + case os:type() of + {win32,_} -> + do_win_massive(); + _ -> + {skip,"Only on Windows."} + end. + +do_win_massive() -> + ?line Dog = test_server:timetrap(test_server:seconds(360)), + ?line SuiteDir = filename:dirname(code:which(?MODULE)), + ?line Env = " -env ERL_MAX_PORTS 8192", + ?line {ok, Node} = + test_server:start_node(win_massive, + slave, + [{args, " -pa " ++ SuiteDir ++ Env}]), + ?line ok = rpc:call(Node,?MODULE,win_massive_client,[3000]), + ?line test_server:stop_node(Node), + ?line test_server:timetrap_cancel(Dog), + ok. + +win_massive_client(N) -> + {ok,P}=gen_tcp:listen(?WIN_MASSIVE_PORT,[{reuseaddr,true}]), + L = win_massive_loop(P,N), + Len = length(L), + lists:foreach(fun(E) -> + gen_tcp:close(E) + end, + L), + case Len div 2 of + N -> + ok; + _Else -> + {too_few, Len} + end. + +win_massive_loop(_,0) -> + []; +win_massive_loop(P,N) -> + case (catch gen_tcp:connect("localhost",?WIN_MASSIVE_PORT,[])) of + {ok,A} -> + case (catch gen_tcp:accept(P)) of + {ok,B} -> + %erlang:display(N), + [A,B|win_massive_loop(P,N-1)]; + _Else -> + [A] + end; + _Else0 -> + [] + end. + + + + +stream(suite) -> [stream_small, stream_big]. + +%% Test that we can send a stream of bytes and get it back. +%% We will send only a small amount of data, to avoid deadlock. + +stream_small(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line stream_ping(Config, 512, "", []), + ?line stream_ping(Config, 1777, "", []), + ?line stream_ping(Config, 1777, "-s512", []), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Send big amounts of data (much bigger than the buffer size in port test). +%% This will deadlock the emulator if the spawn driver haven't proper +%% non-blocking reads and writes. + +stream_big(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(180)), + case os:type() of + vxworks -> + %% Don't stress VxWorks too much + ?line stream_ping(Config, 43755, "", []), + ?line stream_ping(Config, 51255, "", []), + ?line stream_ping(Config, 52345, " -s40000", []); + _ -> + ?line stream_ping(Config, 43755, "", []), + ?line stream_ping(Config, 100000, "", []), + ?line stream_ping(Config, 77777, " -s40000", []) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Sends packet with header size of 1, 2, and 4, with packets of various +%% sizes. + +basic_ping(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(120)), + ?line ping(Config, sizes(1), 1, "", []), + ?line ping(Config, sizes(2), 2, "", []), + ?line ping(Config, sizes(4), 4, "", []), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Let the port program insert delays between characters sent back to +%% Erlang, to test that the Erlang emulator can handle a packet coming in +%% small chunks rather than all at once. + +slow_writes(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + ?line ping(Config, [8], 4, "-s1", []), + ?line ping(Config, [10], 2, "-s2", []), + ?line test_server:timetrap_cancel(Dog), + ok. + +bad_packet(doc) -> + ["Test that we get {'EXIT', Port, einval} if we try to send a bigger " + "packet than the packet header allows."]; +bad_packet(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line PortTest = port_test(Config), + ?line process_flag(trap_exit, true), + + ?line bad_packet(PortTest, 1, 256), + ?line bad_packet(PortTest, 1, 257), + ?line bad_packet(PortTest, 2, 65536), + ?line bad_packet(PortTest, 2, 65537), + + ?line test_server:timetrap_cancel(Dog), + ok. + +bad_packet(PortTest, HeaderSize, PacketSize) -> + %% Intentionally no ?line macros. + P = open_port({spawn, PortTest}, [{packet, HeaderSize}]), + P ! {self(), {command, make_zero_packet(PacketSize)}}, + receive + {'EXIT', P, einval} -> ok; + Other -> test_server:fail({unexpected_message, Other}) + end. + +make_zero_packet(0) -> []; +make_zero_packet(N) when N rem 2 == 0 -> + P = make_zero_packet(N div 2), + [P|P]; +make_zero_packet(N) -> + P = make_zero_packet(N div 2), + [0, P|P]. + +%% Test sending bad messages to a port. +bad_port_messages(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line PortTest = port_test(Config), + ?line process_flag(trap_exit, true), + + ?line bad_message(PortTest, {a,b}), + ?line bad_message(PortTest, {a}), + ?line bad_message(PortTest, {self(),{command,bad_command}}), + ?line bad_message(PortTest, {self(),{connect,no_pid}}), + + ?line test_server:timetrap_cancel(Dog), + ok. + +bad_message(PortTest, Message) -> + P = open_port({spawn,PortTest}, []), + P ! Message, + receive + {'EXIT',P,badsig} -> ok; + Other -> test_server:fail({unexpected_message, Other}) + end. + +%% Tests various options (stream and {packet, Number} are implicitly +%% tested in other test cases). + +options(suite) -> [t_binary, eof, input_only, output_only]. + +%% Tests the 'binary' option for a port. + +t_binary(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(300)), + + %% Packet mode. + ?line ping(Config, sizes(1), 1, "", [binary]), + ?line ping(Config, sizes(2), 2, "", [binary]), + ?line ping(Config, sizes(4), 4, "", [binary]), + + %% Stream mode. + case os:type() of + vxworks -> + %% don't stress VxWorks too much + ?line stream_ping(Config, 435, "", [binary]), + ?line stream_ping(Config, 43755, "", [binary]), + ?line stream_ping(Config, 50000, "", [binary]); + _ -> + ?line stream_ping(Config, 435, "", [binary]), + ?line stream_ping(Config, 43755, "", [binary]), + ?line stream_ping(Config, 100000, "", [binary]) + end, + + ?line test_server:timetrap_cancel(Dog), + ok. + +name1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(100)), + ?line PortTest = port_test(Config), + ?line Command = lists:concat([PortTest, " "]), + ?line P = open_port({spawn, Command}, []), + ?line register(myport, P), + ?line P = whereis(myport), + Text = "hej", + ?line myport ! {self(), {command, Text}}, + ?line receive + {P, {data, Text}} -> + ok + end, + ?line myport ! {self(), close}, + ?line receive + {P, closed} -> ok + end, + ?line undefined = whereis(myport), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Test that the 'eof' option works. + +eof(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(100)), + ?line PortTest = port_test(Config), + ?line Command = lists:concat([PortTest, " -h0 -q"]), + ?line P = open_port({spawn, Command}, [eof]), + ?line receive + {P, eof} -> + ok + end, + ?line P ! {self(), close}, + ?line receive + {P, closed} -> ok + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests that the 'in' option for a port works. + +input_only(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(300)), + ?line expect_input(Config, [0, 1, 10, 13, 127, 128, 255], 1, "", [in]), + ?line expect_input(Config, [0, 1, 255, 2048], 2, "", [in]), + ?line expect_input(Config, [0, 1, 255, 2048], 4, "", [in]), + ?line expect_input(Config, [0, 1, 10, 13, 127, 128, 255], + 1, "", [in, binary]), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests that the 'out' option for a port works. + +output_only(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(100)), + ?line Dir = ?config(priv_dir, Config), + ?line Filename = filename:join(Dir, "output_only_stream"), + ?line output_and_verify(Config, Filename, "-h0", + random_packet(35777, "echo")), + ?line test_server:timetrap_cancel(Dog), + ok. + +output_and_verify(Config, Filename, Options, Data) -> + ?line PortTest = port_test(Config), + ?line Command = lists:concat([PortTest, " ", + Options, " -o", Filename]), + ?line Port = open_port({spawn, Command}, [out]), + ?line Port ! {self(), {command, Data}}, + ?line Port ! {self(), close}, + ?line receive + {Port, closed} -> ok + end, + Wait_time = case os:type() of + vxworks -> 5000; + _ -> 500 + end, + ?line test_server:sleep(Wait_time), + ?line {ok, Written} = file:read_file(Filename), + ?line Data = binary_to_list(Written), + ok. + +%% Test that receiving several packages written in the same +%% write operation works. + +multiple_packets(suite) -> [mul_basic, mul_slow_writes]. + +%% Basic test of receiving multiple packages, written in +%% one operation by the other end. +mul_basic(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(600)), + case os:type() of + vxworks -> + %% don't stress vxworks too much + ?line expect_input(Config, [0, 1, 255, 10, 13], 1, "", []), + ?line expect_input(Config, [0, 10, 13, 1600, 8191, 16383], 2, "", []), + ?line expect_input(Config, [10, 35000], 4, "", []); + _ -> + ?line expect_input(Config, [0, 1, 255, 10, 13], 1, "", []), + ?line expect_input(Config, [0, 10, 13, 1600, 32767, 65535], 2, "", []), + ?line expect_input(Config, [10, 70000], 4, "", []) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Test reading a buffer consisting of several packets, some +%% of which might be incomplete. (The port program builds +%% a buffer with several packets, but writes it in chunks with +%% delays in between.) + +mul_slow_writes(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(250)), + ?line expect_input(Config, [0, 20, 255, 10, 1], 1, "-s64", []), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Runs several port tests in parallell. Each individual test +%% finishes in about 5 seconds. Running in parallell, all tests +%% should also finish in about 5 seconds. + +parallell(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(300)), + ?line Testers = + [fun() -> stream_ping(Config, 1007, "-s100", []) end, + fun() -> stream_ping(Config, 10007, "-s1000", []) end, + fun() -> stream_ping(Config, 10007, "-s1000", []) end, + + fun() -> expect_input(Config, [21, 22, 23, 24, 25], 1, + "-s10", [in]) end, + + fun() -> ping(Config, [10], 1, "-d", []) end, + fun() -> ping(Config, [20000], 2, "-d", []) end, + fun() -> ping(Config, [101], 1, "-s10", []) end, + fun() -> ping(Config, [1001], 2, "-s100", []) end, + fun() -> ping(Config, [10001], 4, "-s1000", []) end, + + fun() -> ping(Config, [501, 501], 2, "-s100", []) end, + fun() -> ping(Config, [11, 12, 13, 14, 11], 1, "-s5", []) end], + ?line process_flag(trap_exit, true), + ?line Pids = lists:map(fun fun_spawn/1, Testers), + ?line wait_for(Pids), + ?line test_server:timetrap_cancel(Dog), + ok. + +wait_for([]) -> + ok; +wait_for(Pids) -> + io:format("Waiting for ~p", [Pids]), + receive + {'EXIT', Pid, normal} -> + wait_for(lists:delete(Pid, Pids)); + Other -> + test_server:fail({bad_exit, Other}) + end. + +%% Tests starting port programs that terminate by themselves. +%% This used to cause problems on Windows. + +dying_port(suite) -> []; +dying_port(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(150)), + ?line process_flag(trap_exit, true), + + ?line P1 = make_dying_port(Config), + ?line P2 = make_dying_port(Config), + ?line P3 = make_dying_port(Config), + ?line P4 = make_dying_port(Config), + ?line P5 = make_dying_port(Config), + + %% This should be big enough to be sure to block in the write. + ?line Garbage = random_packet(16384), + + ?line P1 ! {self(), {command, Garbage}}, + ?line P3 ! {self(), {command, Garbage}}, + ?line P5 ! {self(), {command, Garbage}}, + + ?line wait_for_port_exit(P1), + ?line wait_for_port_exit(P2), + ?line wait_for_port_exit(P3), + ?line wait_for_port_exit(P4), + ?line wait_for_port_exit(P5), + + ?line test_server:timetrap_cancel(Dog), + ok. + +wait_for_port_exit(Port) -> + receive + {'EXIT', Port, _} -> + ok + end. + +make_dying_port(Config) when is_list(Config) -> + PortTest = port_test(Config), + Command = lists:concat([PortTest, " -h0 -d -q"]), + open_port({spawn, Command}, [stream]). + +%% Tests that port program with complete path (but without any +%% .exe extension) can be started, even if there is a file with +%% the same name but without the extension in the same directory. +%% (In practice, the file with the same name could be a Unix +%% executable.) +%% +%% This used to failed on Windows (the .exe extension had to be +%% explicitly given). +%% +%% This testcase works on Unix, but is not very useful. + +port_program_with_path(suite) -> []; +port_program_with_path(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(100)), + ?line DataDir = ?config(data_dir, Config), + ?line PrivDir = ?config(priv_dir, Config), + + %% Create a copy of the port test program in a directory not + %% included in PATH (i.e. in priv_dir), with the name 'my_port_test.exe'. + %% Also, place a file named 'my_port_test' in the same directory. + %% This used to confuse the CreateProcess() call in spawn driver. + %% (On Unix, there will be a single file created, which will be + %% a copy of the port program.) + + ?line PortTest = os:find_executable("port_test", DataDir), + io:format("os:find_executable(~p, ~p) returned ~p", + ["port_test", DataDir, PortTest]), + ?line {ok, PortTestPgm} = file:read_file(PortTest), + ?line NewName = filename:join(PrivDir, filename:basename(PortTest)), + ?line RedHerring = filename:rootname(NewName), + ?line ok = file:write_file(RedHerring, "I'm just here to confuse.\n"), + ?line ok = file:write_file(NewName, PortTestPgm), + ?line ok = file:write_file_info(NewName, #file_info{mode=8#111}), + ?line PgmWithPathAndNoExt = filename:rootname(NewName), + + %% Open the port using the path to the copied port test program, + %% but without the .exe extension, and verified that it was started. + %% + %% If the bug is present the open_port call will fail with badarg. + + ?line Command = lists:concat([PgmWithPathAndNoExt, " -h2"]), + %% allow VxWorks time to write file + case os:type() of + vxworks -> test_server:sleep(2500); + _ -> time + end, + ?line P = open_port({spawn, Command}, [{packet, 2}]), + ?line Message = "echo back to me", + ?line P ! {self(), {command, Message}}, + ?line receive + {P, {data, Message}} -> + ok + end, + ?line test_server:timetrap_cancel(Dog), + ok. + + +%% Tests that files can be read using open_port(Filename, [in]). +%% This used to fail on Windows. +open_input_file_port(suite) -> []; +open_input_file_port(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line PrivDir = ?config(priv_dir, Config), + + %% Create a file with the file driver and read it back using + %% open_port/2. + + ?line MyFile1 = filename:join(PrivDir, "my_input_file"), + ?line FileData1 = "An input file", + ?line ok = file:write_file(MyFile1, FileData1), + case os:type() of + vxworks -> + %% Can't open input file with vanilla driver on VxWorks + ?line process_flag(trap_exit, true), + ?line case catch open_port(MyFile1, [in]) of + {'EXIT', {badarg, _}} -> + ok + end; + _ -> + ?line case open_port(MyFile1, [in]) of + InputPort when is_port(InputPort) -> + ?line receive + {InputPort, {data, FileData1}} -> + ok + end + end + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests that files can be written using open_port(Filename, [out]). +open_output_file_port(suite) -> []; +open_output_file_port(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(100)), + ?line PrivDir = ?config(priv_dir, Config), + + %% Create a file with open_port/2 and read it back with + %% the file driver. + + ?line MyFile2 = filename:join(PrivDir, "my_output_file"), + ?line FileData2_0 = "A file created ", + ?line FileData2_1 = "with open_port/2.\n", + ?line FileData2 = FileData2_0 ++ FileData2_1, + ?line OutputPort = open_port(MyFile2, [out]), + ?line OutputPort ! {self(), {command, FileData2_0}}, + ?line OutputPort ! {self(), {command, FileData2_1}}, + ?line OutputPort ! {self(), close}, + ?line {ok, Bin} = file:read_file(MyFile2), + ?line FileData2 = binary_to_list(Bin), + + ?line test_server:timetrap_cancel(Dog), + ok. + +%% +%% Open as many ports as possible. Do this several times and check +%% that we get the same number of ports every time. +%% + +iter_max_ports(suite) -> []; +iter_max_ports(Config) when is_list(Config) -> + %% The child_setup program might dump core if we get out of memory. + %% This is hard to do anything about and is harmless. We run this test + %% in a working directory with an ignore_core_files file which will make + %% the search for core files ignore cores generated by this test. + %% + Config2 = ignore_cores:setup(?MODULE, iter_max_ports, Config, true), + try + iter_max_ports_test(Config2) + after + ignore_cores:restore(Config2) + end. + + +iter_max_ports_test(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(20)), + ?line PortTest = port_test(Config), + ?line Command = lists:concat([PortTest, " -h0 -q"]), + ?line Iters = case os:type() of + {win32,_} -> 4; + _ -> 10 + end, + ?line L = do_iter_max_ports(Iters, Command), + io:format("Result: ~p",[L]), + ?line all_equal(L), + ?line test_server:timetrap_cancel(Dog), + {comment, "Max ports: " ++ integer_to_list(hd(L))}. + +do_iter_max_ports(N, Command) when N > 0 -> + [max_ports(Command)| do_iter_max_ports(N-1, Command)]; +do_iter_max_ports(_, _) -> + []. + +all_equal([E,E|T]) -> + all_equal([E|T]); +all_equal([_]) -> ok; +all_equal([]) -> ok. + +max_ports(Command) -> + test_server:sleep(500), + ?line Ps = open_ports({spawn, Command}, [eof]), + ?line N = length(Ps), + ?line close_ports(Ps), + io:format("Got ~p ports\n",[N]), + N. + +close_ports([P|Ps]) -> + P ! {self(), close}, + receive + {P,closed} -> + ok + end, + close_ports(Ps); +close_ports([]) -> + ok. + +open_ports(Name, Settings) -> + test_server:sleep(50), + case catch open_port(Name, Settings) of + P when is_port(P) -> + [P| open_ports(Name, Settings)]; + {'EXIT', {Code, _}} -> + case Code of + enfile -> + []; + emfile -> + []; + system_limit -> + []; + Other -> + ?line test_server:fail({open_ports, Other}) + end; + Other -> + ?line test_server:fail({open_ports, Other}) + end. + +%% Tests that exit(Port, Term) works (has been known to crash the emulator). + +t_exit(suite) -> []; +t_exit(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun suicide_port/1, [Config]), + ?line receive + {'EXIT', Pid, die} -> + ok; + Other -> + test_server:fail({bad_message, Other}) + end. + +suicide_port(Config) when is_list(Config) -> + ?line Port = port_expect(Config, [], 0, "", []), + ?line exit(Port, die), + ?line receive after infinity -> ok end. + +tps(suite) -> [tps_16_bytes, tps_1K]. + +tps_16_bytes(doc) -> ""; +tps_16_bytes(suite) -> []; +tps_16_bytes(Config) when is_list(Config) -> + ?line tps(16, Config). + +tps_1K(doc) -> ""; +tps_1K(suite) -> []; +tps_1K(Config) when is_list(Config) -> + ?line tps(1024, Config). + +tps(Size, Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(300)), + ?line PortTest = port_test(Config), + ?line Packet = list_to_binary(random_packet(Size, "e")), + ?line Port = open_port({spawn, PortTest}, [binary, {packet, 2}]), + ?line Transactions = 10000, + ?line {Elapsed, ok} = test_server:timecall(?MODULE, tps, + [Port, Packet, Transactions]), + ?line test_server:timetrap_cancel(Dog), + {comment, integer_to_list(trunc(Transactions/Elapsed+0.5)) ++ " transactions/s"}. + +tps(_Port, _Packet, 0) -> ok; +tps(Port, Packet, N) -> + ?line port_command(Port, Packet), + ?line receive + {Port, {data, Packet}} -> + ?line tps(Port, Packet, N-1); + Other -> + ?line test_server:fail({bad_message, Other}) + end. + +%% Line I/O test +line(Config) when is_list(Config) -> + ?line Siz = 110, + ?line Dog = test_server:timetrap(test_server:seconds(300)), + ?line Packet1 = random_packet(Siz), + ?line Packet2 = random_packet(Siz div 2), + %% Test that packets are split into lines + ?line port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet2, + io_lib:nl()]), + [{eol, Packet1}, {eol, Packet2}]}], + 0, "", [{line,Siz}]), + %% Test the same for binaries + ?line port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet2, + io_lib:nl()]), + [{eol, Packet1}, {eol, Packet2}]}], + 0, "", [{line,Siz},binary]), + %% Test that too long lines get split + ?line port_expect(Config,[{lists:append([Packet1, io_lib:nl(), Packet1, + Packet2, io_lib:nl()]), + [{eol, Packet1}, {noeol, Packet1}, + {eol, Packet2}]}], 0, "", [{line,Siz}]), + %% Test that last output from closing port program gets received. + ?line L1 = lists:append([Packet1, io_lib:nl(), Packet2]), + ?line S1 = lists:flatten(io_lib:format("-l~w", [length(L1)])), + io:format("S1 = ~w, L1 = ~w~n", [S1,L1]), + ?line port_expect(Config,[{L1, + [{eol, Packet1}, {noeol, Packet2}, eof]}], 0, + S1, [{line,Siz},eof]), + %% Test that lonely Don't get treated as newlines + ?line port_expect(Config,[{lists:append([Packet1, [13], Packet2, + io_lib:nl()]), + [{noeol, Packet1}, {eol, [13 |Packet2]}]}], + 0, "", [{line,Siz}]), + %% Test that packets get built up to lines (delayed output from + %% port program) + ?line port_expect(Config,[{Packet2,[]}, + {lists:append([Packet2, io_lib:nl(), + Packet1, io_lib:nl()]), + [{eol, lists:append(Packet2, Packet2)}, + {eol, Packet1}]}], 0, "-d", [{line,Siz}]), + %% Test that we get badarg if trying both packet and line + ?line bad_argument(Config, [{packet, 5}, {line, 5}]), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%% Redirection of stderr test +stderr_to_stdout(suite) -> + []; +stderr_to_stdout(doc) -> + "Test that redirection of standard error to standard output works."; +stderr_to_stdout(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + %% See that it works + ?line Packet = random_packet(10), + ?line port_expect(Config,[{Packet,[Packet]}], 0, "-e -l10", + [stderr_to_stdout]), + %% ?line stream_ping(Config, 10, "-e", [stderr_to_stdout]), + %% See that it doesn't always happen (will generate garbage on stderr) + ?line port_expect(Config,[{Packet,[eof]}], 0, "-e -l10", [line,eof]), + ?line test_server:timetrap_cancel(Dog), + ok. + + +bad_argument(Config, ArgList) -> + PortTest = port_test(Config), + case catch open_port({spawn, PortTest}, ArgList) of + {'EXIT', {badarg, _}} -> + ok + end. + + +%% 'env' option +%% (Can perhaps be made smaller by calling the other utility functions +%% in this module.) +env(suite) -> + []; +env(doc) -> + ["Test that the 'env' option works"]; +env(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skipped,"Environments not implemented on VxWorks (could be...)"}; + _ -> + env2(Config) + end. + +env2(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + ?line Priv = ?config(priv_dir, Config), + ?line Temp = filename:join(Priv, "env_fun.bin"), + + PluppVal = "dirty monkey", + ?line env_slave(Temp, [{"plupp",PluppVal}]), + + Long = "LongAndBoringEnvName", + ?line os:putenv(Long, "nisse"), + + ?line env_slave(Temp, [{"plupp",PluppVal}, + {"DIR_PLUPP","###glurfrik"}], + fun() -> + PluppVal = os:getenv("plupp"), + "###glurfrik" = os:getenv("DIR_PLUPP"), + "nisse" = os:getenv(Long) + end), + + + ?line env_slave(Temp, [{"must_define_something","some_value"}, + {"certainly_not_existing",false}, + {Long,false}, + {"glurf","a glorfy string"}]), + + ?line test_server:timetrap_cancel(Dog), + ok. + +env_slave(File, Env) -> + F = fun() -> + lists:foreach(fun({Name,Val}) -> + Val = os:getenv(Name) + end, Env) + end, + env_slave(File, Env, F). + +env_slave(File, Env, Body) -> + file:write_file(File, term_to_binary(Body)), + Program = atom_to_list(lib:progname()), + Dir = filename:dirname(code:which(?MODULE)), + Cmd = Program ++ " -pz " ++ Dir ++ + " -noinput -run " ++ ?MODULE_STRING ++ " env_slave_main " ++ + File ++ " -run erlang halt", + Port = open_port({spawn, Cmd}, [{env,Env},{line,256}]), + receive + {Port,{data,{eol,"ok"}}} -> + ok; + {Port,{data,{eol,Error}}} -> + io:format("~p\n", [Error]), + test_server:fail(); + Other -> + test_server:fail(Other) + end. + +env_slave_main([File]) -> + {ok,Body0} = file:read_file(File), + Body = binary_to_term(Body0), + case Body() of + {'EXIT',Reason} -> + io:format("Error: ~p\n", [Reason]); + _ -> + io:format("ok\n") + end, + init:stop(). + + +%% 'env' option +%% Test bad environments. +bad_env(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skipped,"Environments not implemented on VxWorks"}; + _ -> + bad_env_1() + end. + +bad_env_1() -> + ?line try_bad_env([abbb]), + ?line try_bad_env([{"key","value"}|{"another","value"}]), + ?line try_bad_env([{"key","value","value2"}]), + ?line try_bad_env([{"key",[a,b,c]}]), + ?line try_bad_env([{"key",value}]), + ?line try_bad_env({a,tuple}), + ?line try_bad_env(42), + ?line try_bad_env([a|b]), + ?line try_bad_env(self()), + ok. + +try_bad_env(Env) -> + try open_port({spawn,"ls"}, [{env,Env}]) + catch + error:badarg -> ok + end. + +%% 'cd' option +%% (Can perhaps be made smaller by calling the other utility functions +%% in this module.) +cd(suite) -> + []; +cd(doc) -> + ["Test that the 'cd' option works"]; +cd(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skipped,"Task specific directories does not exist on VxWorks"}; + _ -> + cd2(Config) + end. +cd2(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + + ?line Program = atom_to_list(lib:progname()), + ?line DataDir = ?config(data_dir, Config), + ?line TestDir = filename:join(DataDir, "dir"), + ?line Cmd = Program ++ " -pz " ++ DataDir ++ + " -noshell -s port_test pwd -s erlang halt", + ?line _ = open_port({spawn, Cmd}, + [{cd, TestDir}, + {line, 256}]), + ?line receive + {_, {data, {eol, String}}} -> + case filename_equal(String, TestDir) of + true -> + ok; + false -> + ?line test_server:fail({cd, String}) + end; + Other2 -> + ?line test_server:fail({env, Other2}) + end, + + ?line test_server:timetrap_cancel(Dog), + ok. + +filename_equal(A, B) -> + case os:type() of + {win32, _} -> + win_filename_equal(A, B); + _ -> + A == B + end. + +win_filename_equal([], []) -> + true; +win_filename_equal([], _) -> + false; +win_filename_equal(_, []) -> + false; +win_filename_equal([C1 | Rest1], [C2 | Rest2]) -> + case tolower(C1) == tolower(C2) of + true -> + win_filename_equal(Rest1, Rest2); + false -> + false + end. + +tolower(C) when C >= $A, C =< $Z -> + C + 32; +tolower(C) -> + C. + +otp_3906(suite) -> + []; +otp_3906(doc) -> + ["Tests that child process deaths are managed correctly when there are " + " a large amount of concurrently dying children. See ticket OTP-3906."]; +otp_3906(Config) when is_list(Config) -> + case os:type() of + {unix, OSName} -> + otp_3906(Config, OSName); + _ -> + {skipped, "Only run on Unix systems"} + end. + +-define(OTP_3906_CHILDREN, 1000). +-define(OTP_3906_EXIT_STATUS, 17). +-define(OTP_3906_PROGNAME, "otp_3906"). +-define(OTP_3906_TICK_TIMEOUT, 5000). +-define(OTP_3906_OSP_P_ERLP, 10). +-define(OTP_3906_MAX_CONC_OSP, 50). + +otp_3906(Config, OSName) -> + ?line TSDir = filename:dirname(code:which(test_server)), + ?line {ok, Variables} = file:consult(filename:join(TSDir, "variables")), + case lists:keysearch('CC', 1, Variables) of + {value,{'CC', CC}} -> + SuiteDir = filename:dirname(code:which(?MODULE)), + PrivDir = ?config(priv_dir, Config), + Prog = otp_3906_make_prog(CC, PrivDir), + {ok, Node} = test_server:start_node(otp_3906, + slave, + [{args, " -pa " ++ SuiteDir}, + {linked, false}]), + OP = process_flag(priority, max), + OTE = process_flag(trap_exit, true), + FS = spawn_link(Node, + ?MODULE, + otp_3906_start_forker_starter, + [?OTP_3906_CHILDREN, [], self(), Prog]), + Result = receive + {'EXIT', _ForkerStarter, Reason} -> + {failed, Reason}; + {emulator_pid, EmPid} -> + case otp_3906_wait_result(FS, 0, 0) of + {succeded, + ?OTP_3906_CHILDREN, + ?OTP_3906_CHILDREN} -> + succeded; + {succeded, Forked, Exited} -> + otp_3906_list_defunct(EmPid, OSName), + {failed, + {mismatch, + {forked, Forked}, + {exited, Exited}}}; + Res -> + otp_3906_list_defunct(EmPid, OSName), + Res + end + end, + process_flag(trap_exit, OTE), + process_flag(priority, OP), + test_server:stop_node(Node), + case Result of + succeded -> + ok; + _ -> + ?line test_server:fail(Result) + end; + _ -> + {skipped, "No C compiler found"} + end. + +otp_3906_list_defunct(EmPid, OSName) -> + % Guess ps switches to use and what to grep for (could be improved) + {Switches, Zombie} = case OSName of + BSD when BSD == darwin; + BSD == openbsd; + BSD == netbsd; + BSD == freebsd -> + {"-ajx", "Z"}; + _ -> + {"-ef", "[dD]efunct"} + end, + test_server:format("Emulator pid: ~s~n" + "Listing of zombie processes:~n" + "~s~n", + [EmPid, + otp_3906_htmlize(os:cmd("ps " + ++ Switches + ++ " | grep " + ++ Zombie))]). + +otp_3906_htmlize([]) -> + []; +otp_3906_htmlize([C | Cs]) -> + case [C] of + "<" -> "<" ++ otp_3906_htmlize(Cs); + ">" -> ">" ++ otp_3906_htmlize(Cs); + _ -> [C | otp_3906_htmlize(Cs)] + end. + +otp_3906_make_prog(CC, PrivDir) -> + SrcFileName = filename:join(PrivDir, ?OTP_3906_PROGNAME ++ ".c"), + TrgtFileName = filename:join(PrivDir, ?OTP_3906_PROGNAME), + {ok, SrcFile} = file:open(SrcFileName, write), + io:format(SrcFile, + "int ~n" + "main(void) ~n" + "{ ~n" + " return ~p; ~n" + "} ~n", + [?OTP_3906_EXIT_STATUS]), + file:close(SrcFile), + os:cmd(CC ++ " " ++ SrcFileName ++ " -o " ++ TrgtFileName), + TrgtFileName. + + +otp_3906_wait_result(ForkerStarter, F, E) -> + receive + {'EXIT', ForkerStarter, Reason} -> + {failed, {Reason, {forked, F}, {exited, E}}}; + forked -> + otp_3906_wait_result(ForkerStarter, F+1, E); + exited -> + otp_3906_wait_result(ForkerStarter, F, E+1); + tick -> + otp_3906_wait_result(ForkerStarter, F, E); + succeded -> + {succeded, F, E} + after + ?OTP_3906_TICK_TIMEOUT -> + unlink(ForkerStarter), + exit(ForkerStarter, timeout), + {failed, {timeout, {forked, F}, {exited, E}}} + end. + +otp_3906_collect([], _) -> + done; +otp_3906_collect(RefList, Sup) -> + otp_3906_collect(otp_3906_collect_one(RefList, Sup), Sup). + +otp_3906_collect_one(RefList, Sup) -> + receive + Ref when is_reference(Ref) -> + Sup ! tick, + lists:delete(Ref, RefList) + end. + +otp_3906_start_forker(N, Sup, Prog) -> + Ref = make_ref(), + spawn_opt(?MODULE, + otp_3906_forker, + [N, self(), Ref, Sup, Prog], + [link, {priority, max}]), + Ref. + +otp_3906_start_forker_starter(N, RefList, Sup, Prog) -> + process_flag(priority, max), + EmPid = os:getpid(), + Sup ! {emulator_pid, EmPid}, + otp_3906_forker_starter(N, RefList, Sup, Prog). + +otp_3906_forker_starter(0, RefList, Sup, _) -> + otp_3906_collect(RefList, Sup), + unlink(Sup), + Sup ! succeded; +otp_3906_forker_starter(N, RefList, Sup, Prog) + when length(RefList) >= ?OTP_3906_MAX_CONC_OSP -> + otp_3906_forker_starter(N, otp_3906_collect_one(RefList, Sup), Sup, Prog); +otp_3906_forker_starter(N, RefList, Sup, Prog) + when is_integer(N), N > ?OTP_3906_OSP_P_ERLP -> + otp_3906_forker_starter(N-?OTP_3906_OSP_P_ERLP, + [otp_3906_start_forker(?OTP_3906_OSP_P_ERLP, + Sup, + Prog)|RefList], + Sup, + Prog); +otp_3906_forker_starter(N, RefList, Sup, Prog) when is_integer(N) -> + otp_3906_forker_starter(0, + [otp_3906_start_forker(N, + Sup, + Prog)|RefList], + Sup, + Prog). + +otp_3906_forker(0, Parent, Ref, _, _) -> + unlink(Parent), + Parent ! Ref; +otp_3906_forker(N, Parent, Ref, Sup, Prog) -> + Port = erlang:open_port({spawn, Prog}, [exit_status, in]), + Sup ! forked, + receive + {Port, {exit_status, ?OTP_3906_EXIT_STATUS}} -> + Sup ! exited, + otp_3906_forker(N-1, Parent, Ref, Sup, Prog); + {Port, Res} -> + exit(Res); + Other -> + exit(Other) + end. + + +otp_4389(suite) -> []; +otp_4389(doc) -> []; +otp_4389(Config) when is_list(Config) -> + case {os:type(),erlang:system_info(heap_type)} of + {{unix, _},private} -> + ?line Dog = test_server:timetrap(test_server:seconds(240)), + ?line TCR = self(), + case get_true_cmd() of + True when is_list(True) -> + ?line lists:foreach( + fun (P) -> + ?line receive + {P, ok} -> ?line ok; + {P, Err} -> ?line ?t:fail(Err) + end + end, + lists:map( + fun(_) -> + spawn_link( + fun() -> + process_flag(trap_exit, true), + case catch open_port({spawn, True}, + [stream,exit_status]) of + P when is_port(P) -> + receive + {P,{exit_status,_}} -> + TCR ! {self(),ok}; + {'EXIT',_,{R2,_}} when R2 == emfile; + R2 == eagain -> + TCR ! {self(),ok}; + Err2 -> + TCR ! {self(),{msg,Err2}} + end; + {'EXIT',{R1,_}} when R1 == emfile; + R1 == eagain -> + TCR ! {self(),ok}; + Err1 -> + TCR ! {self(), {open_port,Err1}} + end + end) + end, + lists:duplicate(1000,[]))), + ?line test_server:timetrap_cancel(Dog), + {comment, + "This test case doesn't always fail when the bug that " + "it tests for is present (it is most likely to fail on" + " a multi processor machine). If the test case fails it" + " will fail by deadlocking the emulator."}; + _ -> + ?line {skipped, "\"true\" command not found"} + end; + _ -> + {skip,"Only run on Unix and private heaps"} + end. + +get_true_cmd() -> + DoFileExist = fun (FileName) -> + case file:read_file_info(FileName) of + {ok, _} -> throw(FileName); + _ -> not_found + end + end, + catch begin + %% First check in /usr/bin and /bin + DoFileExist("/usr/bin/true"), + DoFileExist("/bin/true"), + %% Try which + case filename:dirname(os:cmd("which true")) of + "." -> not_found; + TrueDir -> filename:join(TrueDir, "true") + end + end. + +%% 'exit_status' option +exit_status(suite) -> + []; +exit_status(doc) -> + ["Test that the 'exit_status' option works"]; +exit_status(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + ?line port_expect(Config,[{"x", + [{exit_status, 5}]}], + 1, "", [exit_status]), + ?line test_server:timetrap_cancel(Dog), + ok. + +spawn_driver(suite) -> + []; +spawn_driver(doc) -> + ["Test spawning a driver specifically"]; +spawn_driver(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line ok = load_driver(Path, "echo_drv"), + ?line Port = erlang:open_port({spawn_driver, "echo_drv"}, []), + ?line Port ! {self(), {command, "Hello port!"}}, + ?line receive + {Port, {data, "Hello port!"}} = Msg1 -> + io:format("~p~n", [Msg1]), + ok; + Other -> + test_server:fail({unexpected, Other}) + end, + ?line Port ! {self(), close}, + ?line receive {Port, closed} -> ok end, + + ?line Port2 = erlang:open_port({spawn_driver, "echo_drv -Hello port?"}, + []), + ?line receive + {Port2, {data, "Hello port?"}} = Msg2 -> + io:format("~p~n", [Msg2]), + ok; + Other2 -> + test_server:fail({unexpected2, Other2}) + end, + ?line Port2 ! {self(), close}, + ?line receive {Port2, closed} -> ok end, + ?line {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, "ls"}, [])), + ?line {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, "cmd"}, [])), + ?line {'EXIT',{badarg,_}} = (catch erlang:open_port({spawn_driver, os:find_executable("erl")}, [])), + ?line test_server:timetrap_cancel(Dog), + ok. + +spawn_executable(suite) -> + []; +spawn_executable(doc) -> + ["Test spawning an executable specifically"]; +spawn_executable(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line DataDir = ?config(data_dir, Config), + ?line EchoArgs1 = filename:join([DataDir,"echo_args"]), + ?line ExactFile1 = filename:nativename(os:find_executable(EchoArgs1)), + ?line [ExactFile1] = run_echo_args(DataDir,[]), + ?line ["echo_args"] = run_echo_args(DataDir,["echo_args"]), + ?line ["echo_arguments"] = run_echo_args(DataDir,["echo_arguments"]), + ?line [ExactFile1,"hello world","dlrow olleh"] = + run_echo_args(DataDir,[ExactFile1,"hello world","dlrow olleh"]), + ?line [ExactFile1] = run_echo_args(DataDir,[default]), + ?line [ExactFile1,"hello world","dlrow olleh"] = + run_echo_args(DataDir,[switch_order,ExactFile1,"hello world", + "dlrow olleh"]), + ?line [ExactFile1,"hello world","dlrow olleh"] = + run_echo_args(DataDir,[default,"hello world","dlrow olleh"]), + + ?line [ExactFile1,"hello world","dlrow olleh"] = + run_echo_args_2("\""++ExactFile1++"\" "++"\"hello world\" \"dlrow olleh\""), + + ?line PrivDir = ?config(priv_dir, Config), + ?line SpaceDir =filename:join([PrivDir,"With Spaces"]), + ?line file:make_dir(SpaceDir), + ?line Executable = filename:basename(ExactFile1), + ?line file:copy(ExactFile1,filename:join([SpaceDir,Executable])), + ?line ExactFile2 = filename:nativename(filename:join([SpaceDir,Executable])), + ?line chmodplusx(ExactFile2), + io:format("|~s|~n",[ExactFile2]), + ?line [ExactFile2] = run_echo_args(SpaceDir,[]), + ?line ["echo_args"] = run_echo_args(SpaceDir,["echo_args"]), + ?line ["echo_arguments"] = run_echo_args(SpaceDir,["echo_arguments"]), + ?line [ExactFile2,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,[ExactFile2,"hello world","dlrow olleh"]), + ?line [ExactFile2] = run_echo_args(SpaceDir,[default]), + ?line [ExactFile2,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,[switch_order,ExactFile2,"hello world", + "dlrow olleh"]), + ?line [ExactFile2,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,[default,"hello world","dlrow olleh"]), + ?line [ExactFile2,"hello world","dlrow olleh"] = + run_echo_args_2("\""++ExactFile2++"\" "++"\"hello world\" \"dlrow olleh\""), + + ?line ExeExt = + case string:to_lower(lists:last(string:tokens(ExactFile2,"."))) of + "exe" -> + ".exe"; + _ -> + "" + end, + Executable2 = "spoky name"++ExeExt, + ?line file:copy(ExactFile1,filename:join([SpaceDir,Executable2])), + ?line ExactFile3 = filename:nativename(filename:join([SpaceDir,Executable2])), + ?line chmodplusx(ExactFile3), + ?line [ExactFile3] = run_echo_args(SpaceDir,Executable2,[]), + ?line ["echo_args"] = run_echo_args(SpaceDir,Executable2,["echo_args"]), + ?line ["echo_arguments"] = run_echo_args(SpaceDir,Executable2,["echo_arguments"]), + ?line [ExactFile3,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,Executable2,[ExactFile3,"hello world","dlrow olleh"]), + ?line [ExactFile3] = run_echo_args(SpaceDir,Executable2,[default]), + ?line [ExactFile3,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,Executable2, + [switch_order,ExactFile3,"hello world", + "dlrow olleh"]), + ?line [ExactFile3,"hello world","dlrow olleh"] = + run_echo_args(SpaceDir,Executable2, + [default,"hello world","dlrow olleh"]), + ?line [ExactFile3,"hello world","dlrow olleh"] = + run_echo_args_2("\""++ExactFile3++"\" "++"\"hello world\" \"dlrow olleh\""), + ?line {'EXIT',{enoent,_}} = (catch run_echo_args(SpaceDir,"fnurflmonfi", + [default,"hello world", + "dlrow olleh"])), + NonExec = "kronxfrt"++ExeExt, + ?line file:write_file(filename:join([SpaceDir,NonExec]), + <<"Not an executable">>), + ?line {'EXIT',{eacces,_}} = (catch run_echo_args(SpaceDir,NonExec, + [default,"hello world", + "dlrow olleh"])), + ?line {'EXIT',{enoent,_}} = (catch open_port({spawn_executable,"cmd"},[])), + ?line {'EXIT',{enoent,_}} = (catch open_port({spawn_executable,"sh"},[])), + case os:type() of + {win32,_} -> + test_bat_file(SpaceDir); + {unix,_} -> + test_sh_file(SpaceDir) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +test_bat_file(Dir) -> + FN = "tf.bat", + Full = filename:join([Dir,FN]), + D = [<<"@echo off\r\n">>, + <<"echo argv[0]:^|%0^|\r\n">>, + <<"if \"%1\" == \"\" goto done\r\n">>, + <<"echo argv[1]:^|%1^|\r\n">>, + <<"if \"%2\" == \"\" goto done\r\n">>, + <<"echo argv[2]:^|%2^|\r\n">>, + <<"if \"%3\" == \"\" goto done\r\n">>, + <<"echo argv[3]:^|%3^|\r\n">>, + <<"if \"%4\" == \"\" goto done\r\n">>, + <<"echo argv[4]:^|%4^|\r\n">>, + <<"if \"%5\" == \"\" goto done\r\n">>, + <<"echo argv[5]:^|%5^|\r\n">>, + <<"\r\n">>, + <<":done\r\n">>, + <<"\r\n">>], + ?line file:write_file(Full,list_to_binary(D)), + ?line EF = filename:basename(FN), + ?line [DN,"hello","world"] = + run_echo_args(Dir,FN, + [default,"hello","world"]), + %% The arg0 argumant should be ignored when running batch files + ?line [DN,"hello","world"] = + run_echo_args(Dir,FN, + ["knaskurt","hello","world"]), + ?line EF = filename:basename(DN), + ok. + +test_sh_file(Dir) -> + FN = "tf.sh", + Full = filename:join([Dir,FN]), + D = [<<"#! /bin/sh\n">>, + <<"echo 'argv[0]:|'$0'|'\n">>, + <<"i=1\n">>, + <<"while [ '!' -z \"$1\" ]; do\n">>, + <<" echo 'argv['$i']:|'\"$1\"'|'\n">>, + <<" shift\n">>, + <<" i=`expr $i + 1`\n">>, + <<"done\n">>], + ?line file:write_file(Full,list_to_binary(D)), + ?line chmodplusx(Full), + ?line [Full,"hello","world"] = + run_echo_args(Dir,FN, + [default,"hello","world"]), + ?line [Full,"hello","world of spaces"] = + run_echo_args(Dir,FN, + [default,"hello","world of spaces"]), + ?line file:write_file(filename:join([Dir,"testfile1"]),<<"testdata1">>), + ?line file:write_file(filename:join([Dir,"testfile2"]),<<"testdata2">>), + ?line Pattern = filename:join([Dir,"testfile*"]), + ?line L = filelib:wildcard(Pattern), + ?line 2 = length(L), + ?line [Full,"hello",Pattern] = + run_echo_args(Dir,FN, + [default,"hello",Pattern]), + ok. + + + +chmodplusx(Filename) -> + case file:read_file_info(Filename) of + {ok,FI} -> + FI2 = FI#file_info{mode = ((FI#file_info.mode) bor 8#00100)}, + file:write_file_info(Filename,FI2); + _ -> + ok + end. + +run_echo_args_2(FullnameAndArgs) -> + Port = open_port({spawn,FullnameAndArgs},[eof]), + Data = collect_data(Port), + Port ! {self(), close}, + receive {Port, closed} -> ok end, + parse_echo_args_output(Data). + + +run_echo_args(Where,Args) -> + run_echo_args(Where,"echo_args",Args). +run_echo_args(Where,Prog,Args) -> + ArgvArg = case Args of + [] -> + []; + [default|T] -> + [{args,T}]; + [switch_order,H|T] -> + [{args,T},{arg0,H}]; + [H|T] -> + [{arg0,H},{args,T}] + end, + Command = filename:join([Where,Prog]), + Port = open_port({spawn_executable,Command},ArgvArg++[eof]), + Data = collect_data(Port), + Port ! {self(), close}, + receive {Port, closed} -> ok end, + parse_echo_args_output(Data). + +collect_data(Port) -> + receive + {Port, {data, Data}} -> + Data ++ collect_data(Port); + {Port, eof} -> + [] + end. + +parse_echo_args_output(Data) -> + [lists:last(string:tokens(S,"|")) || S <- string:tokens(Data,"\r\n")]. + +mix_up_ports(suite) -> + []; +mix_up_ports(doc) -> + ["Test that the emulator does not mix up ports when the port table wraps"]; +mix_up_ports(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line ok = load_driver(Path, "echo_drv"), + ?line Port = erlang:open_port({spawn, "echo_drv"}, []), + ?line Port ! {self(), {command, "Hello port!"}}, + ?line receive + {Port, {data, "Hello port!"}} = Msg1 -> + io:format("~p~n", [Msg1]), + ok; + Other -> + test_server:fail({unexpected, Other}) + end, + ?line Port ! {self(), close}, + ?line receive {Port, closed} -> ok end, + ?line loop(start, done, + fun(P) -> + ?line Q = + (catch erlang:open_port({spawn, "echo_drv"}, [])), +%% ?line io:format("~p ", [Q]), + if is_port(Q) -> + Q; + true -> + io:format("~p~n", [P]), + done + end + end), + ?line Port ! {self(), {command, "Hello again port!"}}, + ?line receive + Msg2 -> + test_server:fail({unexpected, Msg2}) + after 1000 -> + ok + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +loop(Stop, Stop, Fun) when is_function(Fun) -> + ok; +loop(Start, Stop, Fun) when is_function(Fun) -> + loop(Fun(Start), Stop, Fun). + + +otp_5112(suite) -> + []; +otp_5112(doc) -> + ["Test that link to connected process is taken away when port calls", + "driver_exit() also when the port index has wrapped"]; +otp_5112(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line ok = load_driver(Path, "exit_drv"), + ?line Port = otp_5112_get_wrapped_port(), + ?line ?t:format("Max ports: ~p~n",[max_ports()]), + ?line ?t:format("Port: ~p~n",[Port]), + ?line {links, Links1} = process_info(self(),links), + ?line ?t:format("Links1: ~p~n",[Links1]), + ?line true = lists:member(Port, Links1), + ?line Port ! {self(), {command, ""}}, + ?line {links, Links2} = process_info(self(),links), + ?line ?t:format("Links2: ~p~n",[Links2]), + ?line false = lists:member(Port, Links2), %% This used to fail + ?line test_server:timetrap_cancel(Dog), + ok. + +otp_5112_get_wrapped_port() -> + ?line P1 = erlang:open_port({spawn, "exit_drv"}, []), + ?line case port_ix(P1) < max_ports() of + true -> + ?line ?t:format("Need to wrap port index (~p)~n", [P1]), + ?line otp_5112_wrap_port_ix([P1]), + ?line P2 = erlang:open_port({spawn, "exit_drv"}, []), + ?line false = port_ix(P2) < max_ports(), + ?line P2; + false -> + ?line ?t:format("Port index already wrapped (~p)~n", [P1]), + ?line P1 + end. + +otp_5112_wrap_port_ix(Ports) -> + ?line case (catch erlang:open_port({spawn, "exit_drv"}, [])) of + Port when is_port(Port) -> + ?line otp_5112_wrap_port_ix([Port|Ports]); + _ -> + %% Port table now full; empty port table + ?line lists:foreach(fun (P) -> P ! {self(), close} end, + Ports), + ?line ok + end. + + +otp_5119(suite) -> + []; +otp_5119(doc) -> + ["Test that port index is not unnecessarily wrapped"]; +otp_5119(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line ok = load_driver(Path, "exit_drv"), + ?line PI1 = port_ix(otp_5119_fill_empty_port_tab([])), + ?line PI2 = port_ix(erlang:open_port({spawn, "exit_drv"}, [])), + ?line {PortIx1, PortIx2} + = case PI2 > PI1 of + true -> + ?line {PI1, PI2}; + false -> + ?line {port_ix(otp_5119_fill_empty_port_tab([PI2])), + port_ix(erlang:open_port({spawn, "exit_drv"}, []))} + end, + ?line MaxPorts = max_ports(), + ?line ?t:format("PortIx1 = ~p ~p~n", [PI1, PortIx1]), + ?line ?t:format("PortIx2 = ~p ~p~n", [PI2, PortIx2]), + ?line ?t:format("MaxPorts = ~p~n", [MaxPorts]), + ?line true = PortIx2 > PortIx1, + ?line true = PortIx2 =< PortIx1 + MaxPorts, + ?line test_server:timetrap_cancel(Dog), + ?line ok. + +otp_5119_fill_empty_port_tab(Ports) -> + ?line case (catch erlang:open_port({spawn, "exit_drv"}, [])) of + Port when is_port(Port) -> + ?line otp_5119_fill_empty_port_tab([Port|Ports]); + _ -> + %% Port table now full; empty port table + ?line lists:foreach(fun (P) -> P ! {self(), close} end, + Ports), + ?line [LastPort|_] = Ports, + ?line LastPort + end. + +-define(DEF_MAX_PORTS, 1024). + +max_ports_env() -> + ?line case os:getenv("ERL_MAX_PORTS") of + EMP when is_list(EMP) -> + case catch list_to_integer(EMP) of + Int when is_integer(Int) -> ?line Int; + _ -> ?line false + end; + _ -> ?line false + end. + +max_ports() -> + ?line PreMaxPorts + = case max_ports_env() of + Env when is_integer(Env) -> ?line Env; + _ -> + ?line case os:type() of + {unix, _} -> + ?line UlimStr = string:strip(os:cmd("ulimit -n") + -- "\n"), + ?line case catch list_to_integer(UlimStr) of + Ulim when is_integer(Ulim) -> ?line Ulim; + _ -> ?line ?DEF_MAX_PORTS + end; + _ -> ?line ?DEF_MAX_PORTS + end + end, + ?line case PreMaxPorts > ?DEF_MAX_PORTS of + true -> ?line PreMaxPorts; + false -> ?line ?DEF_MAX_PORTS + end. + +port_ix(Port) when is_port(Port) -> + ?line ["#Port",_,PortIxStr] = string:tokens(erlang:port_to_list(Port), + "<.>"), + ?line list_to_integer(PortIxStr). + + +otp_6224(doc) -> ["Check that port command failure doesn't crash the emulator"]; +otp_6224(suite) -> []; +otp_6224(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Path = ?config(data_dir, Config), + ?line ok = load_driver(Path, "failure_drv"), + ?line Go = make_ref(), + ?line Failer = spawn(fun () -> + receive Go -> ok end, + ?line Port = open_port({spawn, "failure_drv"}, + []), + Port ! {self(), {command, "Fail, please!"}}, + otp_6224_loop() + end), + ?line Mon = erlang:monitor(process, Failer), + ?line Failer ! Go, + ?line receive + {'DOWN', Mon, process, Failer, Reason} -> + ?line case Reason of + {driver_failed, _} -> ?line ok; + driver_failed -> ?line ok; + _ -> ?line ?t:fail({unexpected_exit_reason, + Reason}) + end + end, + ?line test_server:timetrap_cancel(Dog), + ?line ok. + +otp_6224_loop() -> + receive _ -> ok after 0 -> ok end, + otp_6224_loop(). + + +-define(EXIT_STATUS_MSB_MAX_PROCS, 64). +-define(EXIT_STATUS_MSB_MAX_PORTS, 300). + +exit_status_multi_scheduling_block(doc) -> []; +exit_status_multi_scheduling_block(suite) -> []; +exit_status_multi_scheduling_block(Config) when is_list(Config) -> + ?line Repeat = 3, + ?line case ?t:os_type() of + {unix, _} -> + ?line Dog = ?t:timetrap(test_server:minutes(2*Repeat)), + ?line SleepSecs = 6, + try + lists:foreach(fun (_) -> + exit_status_msb_test(Config, + SleepSecs) + end, + lists:seq(1, Repeat)) + after + %% Wait for the system to recover (regardless + %% of success or not) otherwise later testcases + %% may unnecessarily fail. + ?t:timetrap_cancel(Dog), + receive after SleepSecs+500 -> ok end + end; + _ -> ?line {skip, "Not implemented for this OS"} + end. + +exit_status_msb_test(Config, SleepSecs) when is_list(Config) -> + %% + %% We want to start port programs from as many schedulers as possible + %% and we want these port programs to terminate while multi-scheduling + %% is blocked. + %% + ?line NoSchedsOnln = erlang:system_info(schedulers_online), + ?line Parent = self(), + ?line ?t:format("SleepSecs = ~p~n", [SleepSecs]), + ?line PortProg = "sleep " ++ integer_to_list(SleepSecs), + ?line Start = now(), + ?line NoProcs = case NoSchedsOnln of + NProcs when NProcs < ?EXIT_STATUS_MSB_MAX_PROCS -> + NProcs; + _ -> + ?EXIT_STATUS_MSB_MAX_PROCS + end, + ?line NoPortsPerProc = case 20*NoProcs of + TNPorts when TNPorts < ?EXIT_STATUS_MSB_MAX_PORTS -> 20; + _ -> ?EXIT_STATUS_MSB_MAX_PORTS div NoProcs + end, + ?line ?t:format("NoProcs = ~p~nNoPortsPerProc = ~p~n", + [NoProcs, NoPortsPerProc]), + ProcFun + = fun () -> + PrtSIds = lists:map( + fun (_) -> + erlang:yield(), + case catch open_port({spawn, PortProg}, + [exit_status]) of + Prt when is_port(Prt) -> + {Prt, + erlang:system_info(scheduler_id)}; + {'EXIT', {Err, _}} when Err == eagain; + Err == emfile -> + noop; + {'EXIT', Err} when Err == eagain; + Err == emfile -> + noop; + Error -> + ?t:fail(Error) + end + end, + lists:seq(1, NoPortsPerProc)), + SIds = lists:filter(fun (noop) -> false; + (_) -> true + end, + lists:map(fun (noop) -> noop; + ({_, SId}) -> SId + end, + PrtSIds)), + process_flag(scheduler, 0), + Parent ! {self(), started, SIds}, + lists:foreach( + fun (noop) -> + noop; + ({Port, _}) -> + receive + {Port, {exit_status, 0}} -> + ok; + {Port, {exit_status, Status}} when Status > 128 -> + %% Sometimes happens when we have created + %% too many ports. + ok; + {Port, {exit_status, _}} = ESMsg -> + {Port, {exit_status, 0}} = ESMsg + end + end, + PrtSIds), + Parent ! {self(), done} + end, + ?line Procs = lists:map(fun (N) -> + spawn_opt(ProcFun, + [link, + {scheduler, + (N rem NoSchedsOnln)+1}]) + end, + lists:seq(1, NoProcs)), + ?line SIds = lists:map(fun (P) -> + receive {P, started, SIds} -> SIds end + end, + Procs), + ?line StartedTime = timer:now_diff(now(), Start)/1000000, + ?line ?t:format("StartedTime = ~p~n", [StartedTime]), + ?line true = StartedTime < SleepSecs, + ?line erlang:system_flag(multi_scheduling, block), + ?line lists:foreach(fun (P) -> receive {P, done} -> ok end end, Procs), + ?line DoneTime = timer:now_diff(now(), Start)/1000000, + ?line ?t:format("DoneTime = ~p~n", [DoneTime]), + ?line true = DoneTime > SleepSecs, + ?line ok = verify_multi_scheduling_blocked(), + ?line erlang:system_flag(multi_scheduling, unblock), + ?line case {length(lists:usort(lists:flatten(SIds))), NoSchedsOnln} of + {N, N} -> + ?line ok; + {N, M} -> + ?line ?t:fail("Failed to create ports on all" + ++ integer_to_list(M) ++ " available" + "schedulers. Only created ports on " + ++ integer_to_list(N) ++ " schedulers.") + end. + +save_sid(SIds) -> + SId = erlang:system_info(scheduler_id), + case lists:member(SId, SIds) of + true -> SIds; + false -> [SId|SIds] + end. + +sid_proc(SIds) -> + NewSIds = save_sid(SIds), + receive + {From, want_sids} -> + From ! {self(), sids, NewSIds} + after 0 -> + sid_proc(NewSIds) + end. + +verify_multi_scheduling_blocked() -> + ?line Procs = lists:map(fun (_) -> + spawn_link(fun () -> sid_proc([]) end) + end, + lists:seq(1, 3*erlang:system_info(schedulers_online))), + ?line receive after 1000 -> ok end, + ?line SIds = lists:map(fun (P) -> + P ! {self(), want_sids}, + receive {P, sids, PSIds} -> PSIds end + end, + Procs), + ?line 1 = length(lists:usort(lists:flatten(SIds))), + ?line ok. + + +%%% Pinging functions. + +stream_ping(Config, Size, CmdLine, Options) -> + Data = random_packet(Size), + port_expect(Config, [{Data, [Data]}], 0, CmdLine, Options). + +ping(Config, Sizes, HSize, CmdLine, Options) -> + Actions = lists:map(fun(Size) -> + [$p|Packet] = random_packet(Size, "ping"), + {[$p|Packet], [[$P|Packet]]} + end, + Sizes), + port_expect(Config, Actions, HSize, CmdLine, Options). + +%% expect_input(Sizes, HSize, CmdLine, Options) +%% +%% Sizes = Size of packets to generated. +%% HSize = Header size: 1, 2, or 4 +%% CmdLine = Additional command line options. +%% Options = Addtional port options. + +expect_input(Config, Sizes, HSize, CmdLine, Options) -> + expect_input1(Config, Sizes, {HSize, CmdLine, Options}, [], []). + +expect_input1(Config, [0|Rest], Params, Expect, ReplyCommand) -> + expect_input1(Config, Rest, Params, [""|Expect], ["x0"|ReplyCommand]); +expect_input1(Config, [Size|Rest], Params, Expect, ReplyCommand) -> + Packet = random_packet(Size), + Fmt = io_lib:format("~c~p", [hd(Packet), Size]), + expect_input1(Config, Rest, Params, [Packet|Expect], [Fmt|ReplyCommand]); +expect_input1(Config, [], {HSize, CmdLine0, Options}, Expect, ReplyCommand) -> + CmdLine = build_cmd_line(CmdLine0, ReplyCommand, []), + port_expect(Config, [{false, lists:reverse(Expect)}], + HSize, CmdLine, Options). + +build_cmd_line(FixedCmdLine, [Cmd|Rest], []) -> + build_cmd_line(FixedCmdLine, Rest, [Cmd]); +build_cmd_line(FixedCmdLine, [Cmd|Rest], Result) -> + build_cmd_line(FixedCmdLine, Rest, [Cmd, $:|Result]); +build_cmd_line(FixedCmdLine, [], Result) -> + lists:flatten([FixedCmdLine, " -r", Result, " -n"]). + +%% port_expect(Actions, HSize, CmdLine, Options) +%% +%% Actions = [{Send, ExpectList}|Rest] +%% HSize = 0 (stream), or 1, 2, 4 (header size aka "packet bytes") +%% CmdLine = Command line for port_test. Don't include -h. +%% Options = Options for open_port/2. Don't include {packet, Number} or +%% or stream. +%% +%% Send = false | list() +%% ExpectList = List of lists or binaries. +%% +%% Returns the port. + +port_expect(Config, Actions, HSize, CmdLine, Options0) -> +% io:format("port_expect(~p, ~p, ~p, ~p)", +% [Actions, HSize, CmdLine, Options0]), + ?line PortTest = port_test(Config), + ?line Cmd = lists:concat([PortTest, " -h", HSize, " ", CmdLine]), + ?line PortType = + case HSize of + 0 -> stream; + _ -> {packet, HSize} + end, + ?line Options = [PortType|Options0], + ?line io:format("open_port({spawn, ~p}, ~p)", [Cmd, Options]), + ?line Port = open_port({spawn, Cmd}, Options), + ?line port_expect(Port, Actions, Options), + Port. + +port_expect(Port, [{Send, Expects}|Rest], Options) when is_list(Expects) -> + ?line port_send(Port, Send), + ?line IsBinaryPort = lists:member(binary, Options), + ?line Receiver = + case {lists:member(stream, Options), line_option(Options)} of + {false, _} -> fun receive_all/2; + {true,false} -> fun stream_receive_all/2; + {_, true} -> fun receive_all/2 + end, + ?line Receiver(Port, maybe_to_binary(Expects, IsBinaryPort)), + ?line port_expect(Port, Rest, Options); +port_expect(_, [], _) -> + ok. + +%%% Check for either line or {line,N} in option list +line_option([{line,_}|_]) -> + true; +line_option([line|_]) -> + true; +line_option([_|T]) -> + line_option(T); +line_option([]) -> + false. + +any_list_to_binary({Atom, List}) -> + {Atom, list_to_binary(List)}; +any_list_to_binary(List) -> + list_to_binary(List). + +maybe_to_binary(Expects, true) -> + lists:map(fun any_list_to_binary/1, Expects); +maybe_to_binary(Expects, false) -> + Expects. + +port_send(_Port, false) -> ok; +port_send(Port, Send) when is_list(Send) -> +% io:format("port_send(~p, ~p)", [Port, Send]), + Port ! {self(), {command, Send}}. + +receive_all(Port, [Expect|Rest]) -> +% io:format("receive_all(~p, [~p|Rest])", [Port, Expect]), + receive + {Port, {data, Expect}} -> + io:format("Received ~s", [format(Expect)]), + ok; + {Port, {data, Other}} -> + io:format("Received ~s; expected ~s", + [format(Other), format(Expect)]), + test_server:fail(bad_message); + Other -> + %% (We're not yet prepared for receiving both 'eol' and + %% 'exit_status'; remember that they may appear in any order.) + case {Expect, Rest, Other} of + {eof, [], {Port, eof}} -> + io:format("Received soft EOF.",[]), + ok; + {{exit_status, S}, [], {Port, {exit_status, S}}} -> + io:format("Received exit status ~p.",[S]), + ok; + _ -> +%%% io:format("Unexpected message: ~s", [format(Other)]), + io:format("Unexpected message: ~w", [Other]), + ?line test_server:fail(unexpected_message) + end + end, + receive_all(Port, Rest); +receive_all(_Port, []) -> + ok. + +stream_receive_all(Port, [Expect]) -> + stream_receive_all1(Port, Expect). + +stream_receive_all1(_Port, Empty) when is_binary(Empty), size(Empty) == 0 -> + ok; +stream_receive_all1(_Port, []) -> + ok; +stream_receive_all1(Port, Expect) -> + receive + {Port, {data, Data}} -> + Remaining = compare(Data, Expect), + stream_receive_all1(Port, Remaining); + Other -> + test_server:fail({bad_message, Other}) + end. + +compare(B1, B2) when is_binary(B1), is_binary(B2), byte_size(B1) =< byte_size(B2) -> + case split_binary(B2, size(B1)) of + {B1,Remaining} -> + Remaining; + _Other -> + test_server:fail(nomatch) + end; +compare(B1, B2) when is_binary(B1), is_binary(B2) -> + test_server:fail(too_much_data); +compare([X|Rest1], [X|Rest2]) -> + compare(Rest1, Rest2); +compare([_|_], [_|_]) -> + test_server:fail(nomatch); +compare([], Remaining) -> + Remaining; +compare(_Data, []) -> + test_server:fail(too_much_data). + +maybe_to_list(Bin) when is_binary(Bin) -> + binary_to_list(Bin); +maybe_to_list(List) -> + List. + +format({Eol,List}) -> + io_lib:format("tuple<~w,~s>",[Eol, maybe_to_list(List)]); +format(List) when is_list(List) -> + case list_at_least(50, List) of + true -> + io_lib:format("\"~-50s...\"", [List]); + false -> + io_lib:format("~p", [List]) + end; +format(Bin) when is_binary(Bin), size(Bin) >= 50 -> + io_lib:format("binary<~-50s...>", [binary_to_list(Bin, 1, 50)]); +format(Bin) when is_binary(Bin) -> + io_lib:format("binary<~s>", [binary_to_list(Bin)]). + + +list_at_least(Number, [_|Rest]) when Number > 0 -> + list_at_least(Number-1, Rest); +list_at_least(Number, []) when Number > 0 -> + false; +list_at_least(0, _List) -> true. + + +%%% Utility functions. + +random_packet(Size) -> + random_packet(Size, ""). + +random_packet(Size, Prefix) -> + build_packet(Size-length(Prefix), lists:reverse(Prefix), random_char()). + +build_packet(0, Result, _NextChar) -> + lists:reverse(Result); +build_packet(Left, Result, NextChar0) -> + NextChar = + if + NextChar0 >= 126 -> + 33; + true -> + NextChar0+1 + end, + build_packet(Left-1, [NextChar0|Result], NextChar). + +sizes() -> + case os:type() of + vxworks -> + % don't stress VxWorks too much + [10, 13, 64, 127, 128, 255, 256, 1023, 1024, + 8191, 8192, 16383, 16384]; + _ -> + [10, 13, 64, 127, 128, 255, 256, 1023, 1024, + 32767, 32768, 65535, 65536] + end. + +sizes(Header_Size) -> + sizes(Header_Size, sizes(), []). + +sizes(1, [Packet_Size|Rest], Result) when Packet_Size < 256 -> + sizes(1, Rest, [Packet_Size|Result]); +sizes(2, [Packet_Size|Rest], Result) when Packet_Size < 65536 -> + sizes(2, Rest, [Packet_Size|Result]); +sizes(4, [Packet_Size|Rest], Result) -> + sizes(4, Rest, [Packet_Size|Result]); +sizes(_, _, Result) -> + Result. + +random_char() -> + random_char("abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789"). + +random_char(Chars) -> + lists:nth(uniform(length(Chars)), Chars). + +uniform(N) -> + case get(random_seed) of + undefined -> + {X, Y, Z} = Seed = time(), + io:format("Random seed = ~p\n",[Seed]), + random:seed(X, Y, Z); + _ -> + ok + end, + random:uniform(N). + +fun_spawn(Fun) -> + fun_spawn(Fun, []). + +fun_spawn(Fun, Args) -> + spawn_link(erlang, apply, [Fun, Args]). + +port_test(Config) when is_list(Config) -> + ?line filename:join(?config(data_dir, Config), "port_test"). + + +ports(doc) -> "Test that erlang:ports/0 returns a consistent snapshot of ports"; +ports(suite) -> []; +ports(Config) when is_list(Config) -> + ?line Path = ?config(data_dir, Config), + ?line ok = load_driver(Path, "exit_drv"), + + receive after 1000 -> ok end, % Wait for other ports to stabilize + + ?line OtherPorts = erlang:ports(), + io:format("Other ports: ~p\n",[OtherPorts]), + MaxPorts = 1024 - length(OtherPorts), + + TrafficPid = spawn_link(fun() -> ports_traffic(MaxPorts) end), + + ports_snapshots(100, TrafficPid, OtherPorts), + TrafficPid ! {self(),die}, + ?line receive {TrafficPid, dead} -> ok end, + ok. + +ports_snapshots(0, _, _) -> + ok; +ports_snapshots(Iter, TrafficPid, OtherPorts) -> + + TrafficPid ! start, + ?line receive after 1 -> ok end, + + Snapshot = erlang:ports(), + + TrafficPid ! {self(), stop}, + ?line receive {TrafficPid, EventList, TrafficPorts} -> ok end, + + %%io:format("Snapshot=~p\n", [Snapshot]), + ports_verify(Snapshot, OtherPorts ++ TrafficPorts, EventList), + + ports_snapshots(Iter-1, TrafficPid, OtherPorts). + + +ports_traffic(MaxPorts) -> + ports_traffic_stopped(MaxPorts, {[],0}). + +ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) -> + receive + start -> + %%io:format("Traffic started in ~p\n",[self()]), + ports_traffic_started(MaxPorts, {PortList, PortCnt}, []); + {Pid,die} -> + ?line lists:foreach(fun(Port)-> erlang:port_close(Port) end, + PortList), + Pid ! {self(),dead} + end. + +ports_traffic_started(MaxPorts, {PortList, PortCnt}, EventList) -> + receive + {Pid, stop} -> + %%io:format("Traffic stopped in ~p\n",[self()]), + Pid ! {self(), EventList, PortList}, + ports_traffic_stopped(MaxPorts, {PortList, PortCnt}) + + after 0 -> + ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) + end. + +ports_traffic_do(MaxPorts, {PortList, PortCnt}, EventList) -> + N = uniform(MaxPorts), + case N > PortCnt of + true -> % Open port + ?line P = open_port({spawn, "exit_drv"}, []), + %%io:format("Created port ~p\n",[P]), + ports_traffic_started(MaxPorts, {[P|PortList], PortCnt+1}, + [{open,P}|EventList]); + + false -> % Close port + ?line P = lists:nth(N, PortList), + %%io:format("Close port ~p\n",[P]), + ?line true = erlang:port_close(P), + ports_traffic_started(MaxPorts, {lists:delete(P,PortList), PortCnt-1}, + [{close,P}|EventList]) + end. + +ports_verify(Ports, PortsAfter, EventList) -> + %%io:format("Candidate=~p\nEvents=~p\n", [PortsAfter, EventList]), + case lists:sort(Ports) =:= lists:sort(PortsAfter) of + true -> + io:format("Snapshot of ~p ports verified ok.\n",[length(Ports)]), + ok; + false -> + %% Note that we track the event list "backwards", undoing open/close: + case EventList of + [{open,P} | Tail] -> + ports_verify(Ports, lists:delete(P,PortsAfter), Tail); + + [{close,P} | Tail] -> + ports_verify(Ports, [P | PortsAfter], Tail); + + [] -> + ?line test_server:fail("Inconsistent snapshot from erlang:ports()") + end + end. + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. diff --git a/erts/emulator/test/port_SUITE_data/Makefile.src b/erts/emulator/test/port_SUITE_data/Makefile.src new file mode 100644 index 0000000000..d97b37c9ae --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/Makefile.src @@ -0,0 +1,26 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = port_test@exe@ echo_args@exe@ +DRIVERS = echo_drv@dll@ exit_drv@dll@ failure_drv@dll@ + +all: $(PROGS) $(DRIVERS) port_test.@EMULATOR@ + +port_test@exe@: port_test@obj@ + $(LD) $(CROSSLDFLAGS) -o port_test port_test@obj@ @LIBS@ + +port_test@obj@: port_test.c + $(CC) -c -o port_test@obj@ $(CFLAGS) port_test.c + +echo_args@exe@: echo_args@obj@ + $(LD) $(CROSSLDFLAGS) -o echo_args echo_args@obj@ @LIBS@ + +echo_args@obj@: echo_args.c + $(CC) -c -o echo_args@obj@ $(CFLAGS) echo_args.c + +port_test.@EMULATOR@: port_test.erl + @erl_name@ -compile port_test + +@SHLIB_RULES@ diff --git a/erts/emulator/test/port_SUITE_data/dir/dummy b/erts/emulator/test/port_SUITE_data/dir/dummy new file mode 100644 index 0000000000..442071915b --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/dir/dummy @@ -0,0 +1 @@ +Dumma WinZip!! diff --git a/erts/emulator/test/port_SUITE_data/echo_args.c b/erts/emulator/test/port_SUITE_data/echo_args.c new file mode 100644 index 0000000000..91dca8993f --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/echo_args.c @@ -0,0 +1,12 @@ +#include + +int main(int argc, char **argv) +{ + int i; + + for(i = 0; i < argc; ++i) { + printf("argv[%d]:|%s|\n",i,argv[i]); + } + return 0; +} + diff --git a/erts/emulator/test/port_SUITE_data/echo_drv.c b/erts/emulator/test/port_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..25eda116fe --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/echo_drv.c @@ -0,0 +1,85 @@ +#include +#include "erl_driver.h" + + + +/* ------------------------------------------------------------------------- +** Data types +**/ + +typedef struct _erl_drv_data EchoDrvData; + + + +/* ------------------------------------------------------------------------- +** Entry struct +**/ + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command); +static void echo_drv_stop(EchoDrvData *data_p); +static void echo_drv_output(EchoDrvData *data_p, char *buf, int len); +static void echo_drv_finish(void); +static int echo_drv_control(EchoDrvData *data_p, unsigned int command, + char *buf, int len, + char **rbuf, int rlen); + +static ErlDrvEntry echo_drv_entry = { + NULL, /* init */ + echo_drv_start, + echo_drv_stop, + echo_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "echo_drv", + echo_drv_finish, + NULL, /* handle */ + echo_drv_control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL /* ready_async */ +}; + + + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(echo_drv) +{ + return &echo_drv_entry; +} + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command) { + void *void_ptr; + int res = -4711; + if (command) { + while(*command != '\0' && *command != ' ') + ++command; + while(*command != '\0' && *command == ' ') + ++command; + if(*command == '-') { + res = driver_output(port, command+1, strlen(command) - 1); + } + } + return void_ptr = port; +} + +static void echo_drv_stop(EchoDrvData *data_p) { +} + +static void echo_drv_output(EchoDrvData *data_p, char *buf, int len) { + void *void_ptr; + ErlDrvPort port = void_ptr = data_p; + + driver_output(port, buf, len); +} + +static void echo_drv_finish() { +} + +static int echo_drv_control(EchoDrvData *data_p, unsigned int command, + char *buf, int len, + char **rbuf, int rlen) { + return 0; +} diff --git a/erts/emulator/test/port_SUITE_data/exit_drv.c b/erts/emulator/test/port_SUITE_data/exit_drv.c new file mode 100644 index 0000000000..60f1b321bd --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/exit_drv.c @@ -0,0 +1,68 @@ +#include +#include "erl_driver.h" + +typedef struct _erl_drv_data ExitDrvData; + +static ExitDrvData *exit_drv_start(ErlDrvPort port, char *command); +static void exit_drv_stop(ExitDrvData *data_p); +static void exit_drv_output(ExitDrvData *data_p, char *buf, int len); +static void exit_drv_finish(void); +static int exit_drv_control(ExitDrvData *data_p, unsigned int command, + char *buf, int len, + char **rbuf, int rlen); + +static ErlDrvEntry exit_drv_entry = { + NULL, /* init */ + exit_drv_start, + exit_drv_stop, + exit_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "exit_drv", + exit_drv_finish, + NULL, /* handle */ + exit_drv_control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL /* ready_async */ +}; + +DRIVER_INIT(exit_drv) +{ + return &exit_drv_entry; +} + +static ExitDrvData * +exit_drv_start(ErlDrvPort port, char *command) +{ + return (ExitDrvData *) port; +} + +static void +exit_drv_stop(ExitDrvData *datap) +{ + +} + +static void +exit_drv_output(ExitDrvData *datap, char *buf, int len) +{ + driver_exit((ErlDrvPort) datap, 0); +} + +static void +exit_drv_finish(void) +{ + +} + +static int +exit_drv_control(ExitDrvData *datap, + unsigned int command, + char *buf, + int len, + char **rbuf, + int rlen) +{ + return 0; +} diff --git a/erts/emulator/test/port_SUITE_data/failure_drv.c b/erts/emulator/test/port_SUITE_data/failure_drv.c new file mode 100644 index 0000000000..34d48e00f8 --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/failure_drv.c @@ -0,0 +1,63 @@ +#include +#include "erl_driver.h" + +typedef struct _erl_drv_data FailureDrvData; + +static FailureDrvData *failure_drv_start(ErlDrvPort, char *); +static void failure_drv_stop(FailureDrvData *); +static void failure_drv_output(FailureDrvData *, char *, int); +static void failure_drv_finish(void); +static int failure_drv_control(FailureDrvData *, unsigned int, + char *, int, char **, int); + +static ErlDrvEntry failure_drv_entry = { + NULL, /* init */ + failure_drv_start, + failure_drv_stop, + failure_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "failure_drv", + failure_drv_finish, + NULL, /* handle */ + failure_drv_control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL /* ready_async */ +}; + + + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(failure_drv) +{ + return &failure_drv_entry; +} + +static FailureDrvData *failure_drv_start(ErlDrvPort port, char *command) { + void *void_ptr; + + return void_ptr = port; +} + +static void failure_drv_stop(FailureDrvData *data_p) { +} + +static void failure_drv_output(FailureDrvData *data_p, char *buf, int len) { + void *void_ptr; + ErlDrvPort port = void_ptr = data_p; + + driver_failure_atom(port, "driver_failed"); +} + +static void failure_drv_finish() { +} + +static int failure_drv_control(FailureDrvData *data_p, unsigned int command, + char *buf, int len, + char **rbuf, int rlen) { + return 0; +} diff --git a/erts/emulator/test/port_SUITE_data/port_test.c b/erts/emulator/test/port_SUITE_data/port_test.c new file mode 100644 index 0000000000..7b4e386d87 --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/port_test.c @@ -0,0 +1,605 @@ +/* + * Author: Bjorn Gustavsson + * Purpose: A port program to be used for testing the open_port bif. + */ + +#ifdef VXWORKS +#include +#include +#include +#include +#include +#include +#endif + +#include +#include +#include +#include +#include +#include +#include + +#ifndef __WIN32__ +#include + +#ifdef VXWORKS +#include "reclaim.h" +#include +#else +#include +#endif + +#define O_BINARY 0 +#define _setmode(fd, mode) +#endif + +#ifdef __WIN32__ +#include "windows.h" +#include "winbase.h" +#endif + + +#ifdef VXWORKS +#define REDIR_STDOUT(fd) ioTaskStdSet(0, 1, fd); +#else +#define REDIR_STDOUT(fd) if (dup2(fd, 1) == -1) { \ + fprintf(stderr, "%s: failed to duplicate handle %d to 1: %d\n", \ + port_data->progname, fd, errno); \ + exit(1); \ +} +#endif + +#ifdef VXWORKS +#define MAIN(argc, argv) port_test(argc, argv) +#else +#define MAIN(argc, argv) main(argc, argv) +#endif + + +extern int errno; + +typedef struct { + char* progname; /* Name of this program (from argv[0]). */ + int header_size; /* Number of bytes in each packet header: + * 1, 2, or 4, or 0 for a continous byte stream. */ + int fd_from_erl; /* File descriptor from Erlang. */ + int fd_to_erl; /* File descriptor to Erlang. */ + unsigned char* io_buf; /* Buffer for file i/o. */ + int io_buf_size; /* Current size of i/o buffer. */ + int delay_mode; /* If set, this program will wait 5 seconds + * after reading the header for a packet + * before reading the rest. + */ + int break_mode; /* If set, this program will close standard + * input, which should case broken pipe + * error in the writer. + */ + int quit_mode; /* If set, this program will exit + * just after reading the packet header. + */ + int slow_writes; /* Writes back the reply in chunks with + * sleeps in between. The value is the + * chunk size. If 0, normal writes are done. + */ + char* output_file; /* File into which the result will be written. */ + int no_packet_loop; /* No packet loop. */ + + int limited_bytecount; /* Only answer a limited number of bytes, then exit (stream mode) */ + +} PORT_TEST_DATA; + +PORT_TEST_DATA* port_data; + +static int packet_loop(); +static void reply(); +static void write_reply(); +static void ensure_buf_big_enough(); +static int readn(); +static void delay(unsigned ms); +static void dump(unsigned char* buf, int sz, int max); +static void replace_stdout(char* filename); +static void generate_reply(char* spec); + +#ifndef VXWORKS +#ifndef HAVE_STRERROR +extern int sys_nerr; +#ifndef sys_errlist /* sys_errlist is sometimes defined to + call a function on win32 */ +extern char *sys_errlist[]; +#endif + +char* +strerror(err) +int err; +{ + static char msgstr[1024]; + + if (err == 0) { + msgstr[0] = '\0'; + } else if (0 < err && err < sys_nerr) { + strcpy(msgstr, sys_errlist[err]); + } else { + sprintf(msgstr, "Unknown error %d", err); + } + return msgstr; +} +#endif +#endif + + +MAIN(argc, argv) +int argc; +char *argv[]; +{ + int ret; +#ifdef VXWORKS + if(taskVarAdd(0, (int *)&port_data) != OK) { + fprintf(stderr, "Can't do taskVarAdd in port_test\n"); + exit(1); + } +#endif + if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { + fprintf(stderr, "Couldn't malloc for port_data"); + exit(1); + } + port_data->header_size = 0; + port_data->io_buf_size = 0; + port_data->delay_mode = 0; + port_data->break_mode = 0; + port_data->quit_mode = 0; + port_data->slow_writes = 0; + port_data->output_file = NULL; + port_data->no_packet_loop = 0; + + port_data->progname = argv[0]; + port_data->fd_from_erl = 0; + port_data->fd_to_erl = 1; + + port_data->limited_bytecount = 0; + + _setmode(0, _O_BINARY); + _setmode(1, _O_BINARY); + + while (argc > 1 && argv[1][0] == '-') { + switch (argv[1][1]) { + case 'b': /* Break mode. */ + port_data->break_mode = 1; + break; + case 'c': /* Close standard output. */ + close(port_data->fd_to_erl); + break; + case 'd': /* Delay mode. */ + port_data->delay_mode = 1; + break; + case 'e': + port_data->fd_to_erl = 2; + break; + case 'h': /* Header size for packets. */ + switch (argv[1][2]) { + case '0': port_data->header_size = 0; break; + case '1': port_data->header_size = 1; break; + case '2': port_data->header_size = 2; break; + case '4': port_data->header_size = 4; break; + case '\0': + fprintf(stderr, "%s: missing header size for -h\n", port_data->progname); + return 1; + default: + fprintf(stderr, "%s: illegal packet header size: %c\n", + port_data->progname, argv[1][2]); + return 1; + } + break; + case 'l': + port_data->limited_bytecount = atoi(argv[1]+2); + break; + case 'n': /* No packet loop. */ + port_data->no_packet_loop = 1; + break; + case 'o': /* Output to file. */ + port_data->output_file = argv[1]+2; + break; + case 'q': /* Quit mode. */ + port_data->quit_mode = 1; + break; + case 'r': /* Generate reply. */ + generate_reply(argv[1]+2); + break; + case 's': /* Slow writes. */ + port_data->slow_writes = atoi(argv[1]+2); + break; + default: + fprintf(stderr, "Unrecognized switch: %s\n", argv[1]); + free(port_data); + exit(1); + } + argc--, argv++; + } + + if (argc > 1) { + /* XXX Add error printout here */ + } + + if (port_data->no_packet_loop){ + free(port_data); + exit(0); + } + + /* + * If an output file was given, let it replace standard output. + */ + + if (port_data->output_file) + replace_stdout(port_data->output_file); + + ret = packet_loop(); + if(port_data->io_buf_size > 0) + free(port_data->io_buf); + free(port_data); + return ret; +} + +static int +packet_loop(void) +{ + int total_read = 0; + port_data->io_buf = (unsigned char*) malloc(1); /* Allocate once, so realloc works (SunOS) */ + + + for (;;) { + int packet_length; /* Length of current packet. */ + int i; + int bytes_read; /* Number of bytes read. */ + + /* + * Read the packet header, if any. + */ + + if (port_data->header_size == 0) { + if(port_data->limited_bytecount && + port_data->limited_bytecount - total_read < 4096) + packet_length = port_data->limited_bytecount - total_read; + else + packet_length = 4096; + } else { + ensure_buf_big_enough(port_data->header_size); + if (readn(port_data->fd_from_erl, port_data->io_buf, port_data->header_size) != port_data->header_size) { + return(1); + } + + /* + * Get the length of this packet. + */ + + packet_length = 0; + for (i = 0; i < port_data->header_size; i++) + packet_length = (packet_length << 8) | port_data->io_buf[i]; + } + + + /* + * Delay if delay mode. + */ + + if (port_data->delay_mode) { + delay(5000L); + } + + if (port_data->quit_mode) { + return(1); + } else if (port_data->break_mode) { + close(0); + delay(32000L); + return(1); + } + + /* + * Read the packet itself. + */ + + ensure_buf_big_enough(packet_length+4+1); /* At least five bytes. */ + port_data->io_buf[4] = '\0'; + if (port_data->header_size == 0) { + bytes_read = read(port_data->fd_from_erl, port_data->io_buf+4, packet_length); + if (bytes_read == 0) + return(1); + if (bytes_read < 0) { + fprintf(stderr, "Error reading %d bytes: %s\n", + packet_length, strerror(errno)); + return(1); + } + total_read += bytes_read; + } else { + bytes_read = readn(port_data->fd_from_erl, port_data->io_buf+4, packet_length); + if (bytes_read != packet_length) { + fprintf(stderr, "%s: couldn't read packet of length %d\r\n", + port_data->progname, packet_length); + return(1); + } + } + + /* + * Act on the command. + */ + if (port_data->header_size == 0) { + reply(port_data->io_buf+4, bytes_read); + if(port_data->limited_bytecount && + port_data->limited_bytecount <= total_read){ + delay(5000L); + return(0); + } + } else { + switch (port_data->io_buf[4]) { + case 'p': /* ping */ + port_data->io_buf[4] = 'P'; + reply(port_data->io_buf+4, bytes_read); + break; + case 'e': /* echo */ + reply(port_data->io_buf+4, bytes_read); + break; + case 'x': /* exit */ + return(5); + break; + default: + fprintf(stderr, "%s: bad packet of length %d received: ", + port_data->progname, bytes_read); + dump(port_data->io_buf+4, bytes_read, 10); + fprintf(stderr, "\r\n"); + return(1); + } + } + } +} + +/* + * Sends a packet back to Erlang. + */ + +static void +reply(buf, size) + char* buf; /* Buffer with reply. The four bytes before + * this pointer must be allocated so that + * this function can put the header there. + */ + int size; /* Size of buffer to send. */ +{ + int n; /* Temporary to hold size. */ + int i; /* Loop counter. */ + + /* + * Fill the header starting with the least significant byte + * (this will work even if there is no header). + */ + + n = size; + for (i = 0; i < port_data->header_size; i++) { + *--buf = (char) n; /* Store least significant byte. */ + n = n >> 8; + } + + size += port_data->header_size; + write_reply(buf, size); +} + + + +static void +write_reply(buf, size) + char* buf; /* Buffer with reply. Must contain header. */ + int size; /* Size of buffer to send. */ +{ + int n; /* Temporary to hold size. */ + + if (port_data->slow_writes <= 0) { /* Normal, "fast", write. */ + write(port_data->fd_to_erl, buf, size); + } else { + /* + * Write chunks with delays in between. + */ + + while (size > 0) { + n = size > port_data->slow_writes ? port_data->slow_writes : size; + write(port_data->fd_to_erl, buf, n); + size -= n; + buf += n; + if (size) + delay(500L); + } + } +} + + +/* + * Ensures that our I/O buffer is big enough for the packet to come. + */ + +static void +ensure_buf_big_enough(size) + int size; /* Needed size of buffer. */ +{ + if (port_data->io_buf_size >= size) + return; + + port_data->io_buf = (unsigned char*) realloc(port_data->io_buf, size); + if (port_data->io_buf == NULL) { + fprintf(stderr, "%s: insufficient memory for i/o buffer of size %d\n", + port_data->progname, size); + exit(1); + } + port_data->io_buf_size = size; +} + +/* + * Reads len number of bytes. + */ +static int +readn(fd, buf, len) + int fd; /* File descriptor to read from. */ + unsigned char *buf; /* Store in this buffer. */ + int len; /* Number of bytes to read. */ +{ + int n; /* Byte count in last read call. */ + int sofar; /* Bytes read so far. */ + + sofar = 0; + do { + if ((n = read(fd, buf+sofar, len-sofar)) <= 0) + /* error or EOF in read */ + return(n); + sofar += n; + } while (sofar < len); + return sofar; +} + +static void +replace_stdout(filename) +char* filename; /* Name of file to replace standard output. */ +{ + int fd; + + fd = open(filename, O_CREAT|O_TRUNC|O_WRONLY|O_BINARY, 0666); + if (fd == -1) { + fprintf(stderr, "%s: failed to open %s for writing: %d\n", + port_data->progname, filename, errno); + exit(1); + } + REDIR_STDOUT(fd); +} + +static void +dump(buf, sz, max) + unsigned char* buf; + int sz; + int max; +{ + int i, imax; + char comma[5]; + + comma[0] = ','; + comma[1] = '\0'; + if (!sz) + return; + if (sz > max) + imax = max; + else + imax = sz; + + for (i=0; i max) + strcpy(comma, ",..."); + else + comma[0] = 0; + } + if (isdigit(buf[i])) { + fprintf(stderr, "%u%s", (int)(buf[i]), comma); + } else { + if (isalpha(buf[i])) { + fprintf(stderr, "%c%s", buf[i], comma); + } + else { + fprintf(stderr, "%u%s", (int)(buf[i]), comma); + } + } + } +} + +/* + * Delays (sleeps) the given number of milli-seconds. + */ + +static void +delay(unsigned ms) +{ +#ifdef VXWORKS + taskDelay((sysClkRateGet() * ms) / 1000); +#else +#ifdef __WIN32__ + Sleep(ms); +#else + struct timeval t; + t.tv_sec = ms/1000; + t.tv_usec = (ms % 1000) * 1000; + + select(0, NULL, NULL, NULL, &t); +#endif +#endif +} + +/* + * Generates a reply buffer given the specification. + * + * ,,, + * + * Where: + * is + */ +static void +generate_reply(spec) +char* spec; /* Specification for reply. */ +{ + typedef struct item { + int start; /* Start character. */ + int incrementer; /* How much to increment. */ + size_t size; /* Size of reply buffer. */ + } Item; + + Item items[256]; + int last; + int cur; + size_t total_size; + char* buf; /* Reply buffer. */ + char* s; /* Current pointer into buffer. */ + int c; + + total_size = 0; + last = 0; + while (*spec) { + char* colon; + + items[last].incrementer = 1; + items[last].start = *spec++; + items[last].size = atoi(spec); + + total_size += port_data->header_size+items[last].size; + last++; + if ((colon = strchr(spec, ':')) == NULL) { + spec += strlen(spec); + } else { + *colon = '\0'; + spec = colon+1; + } + } + + buf = (char *) malloc(total_size); + if (buf == NULL) { + fprintf(stderr, "%s: insufficent memory for reply buffer of size %d\n", + port_data->progname, total_size); + exit(1); + } + + s = buf; + for (cur = 0; cur < last; cur++) { + int i; + size_t n; + + n = items[cur].size; + s += port_data->header_size; + for (i = 0; i < port_data->header_size; i++) { + *--s = (char) n; /* Store least significant byte. */ + n = n >> 8; + } + s += port_data->header_size; + + c = items[cur].start; + for (i = 0; i < items[cur].size; i++) { + *s++ = c; + c++; + if (c > 126) { + c = 33; + } + } + } + write_reply(buf, s-buf); +} + diff --git a/erts/emulator/test/port_SUITE_data/port_test.erl b/erts/emulator/test/port_SUITE_data/port_test.erl new file mode 100644 index 0000000000..56abfd5ded --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/port_test.erl @@ -0,0 +1,36 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(port_test). + +-export([env/1, pwd/0]). + +env([A]) -> + Var = atom_to_list(A), + Val = os:getenv(Var), + case Val of + false -> + io:format("0~n"); + _ -> + io:format("1~s~n", [Val]) + end. + +pwd() -> + {ok, Pwd} = file:get_cwd(), + io:format("~s~n", [Pwd]). diff --git a/erts/emulator/test/port_SUITE_data/reclaim.h b/erts/emulator/test/port_SUITE_data/reclaim.h new file mode 100644 index 0000000000..1d57dc5b8a --- /dev/null +++ b/erts/emulator/test/port_SUITE_data/reclaim.h @@ -0,0 +1,60 @@ +#ifndef __RECLAIM_H__ +#define __RECLAIM_H__ + + +/* The Erlang release for VxWorks includes a simple mechanism for + "resource reclamation" at task exit - it allows replacement of the + functions that open/close "files" and malloc/free memory with versions + that keep track, to be able to "reclaim" file descriptors and memory + when a task exits (regardless of *how* it exits). + + The interface to this mechanism is made available via this file, + with the following caveats: + + - The interface may change (or perhaps even be removed, though that + isn't likely until VxWorks itself provides similar functionality) + in future releases - i.e. you must always use the version of this + file that comes with the Erlang release you are using. + + - Disaster is guaranteed if you use the mechanism incorrectly (see + below for the correct way), e.g. allocate memory with the "tracking" + version of malloc() and free it with the "standard" version of free(). + + - The mechanism (of course) incurs some performance penalty - thus + for a simple program you may be better off with careful programming, + making sure that you do whatever close()/free()/etc calls that are + appropriate at all exit points (though if you need to guard against + taskDelete() etc, things get messy...). + + To use the mechanism, simply program your application normally, i.e. + use open()/close()/malloc()/free() etc as usual, but #include this + file before any usage of the relevant functions. NOTE: To avoid the + "disaster" mentioned above, you *must* #include it in *all* (or none) + of the files that manipulate a particular file descriptor, allocated + memory area, etc. Finally, note that you can obviously not load your + application before the Erlang system when using this interface. +*/ + +/* Sorry, no ANSI prototypes yet... */ +extern int save_open(),save_creat(),save_socket(),save_accept(),save_close(); +#define open save_open +#define creat save_creat +#define socket save_socket +#define accept save_accept +#define close save_close +extern FILE *save_fopen(), *save_fdopen(), *save_freopen(); +extern int save_fclose(); +#define fopen save_fopen +#define fdopen save_fdopen +#define freopen save_freopen +#define fclose save_fclose +/* XXX Should do opendir/closedir too... */ +extern char *save_malloc(), *save_calloc(), *save_realloc(); +extern void save_free(), save_cfree(); +#define malloc save_malloc +#define calloc save_calloc +#define realloc save_realloc +#define free save_free +#define cfree save_cfree + +#endif diff --git a/erts/emulator/test/port_bif_SUITE.erl b/erts/emulator/test/port_bif_SUITE.erl new file mode 100644 index 0000000000..f4e0bb9fa8 --- /dev/null +++ b/erts/emulator/test/port_bif_SUITE.erl @@ -0,0 +1,446 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(port_bif_SUITE). + + +-export([all/1, command/1, command_e/1, + command_e_1/1, command_e_2/1, command_e_3/1, command_e_4/1, + port_info/1, port_info1/1, port_info2/1, + connect/1, control/1, echo_to_busy/1]). + +-export([do_command_e_1/1, do_command_e_2/1, do_command_e_4/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-include("test_server.hrl"). + +all(suite) -> + [command, port_info, connect, control, echo_to_busy]. + + +init_per_testcase(_Func, Config) when is_list(Config) -> + Dog=test_server:timetrap(test_server:minutes(10)), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Func, Config) when is_list(Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + +command(Config) when is_list(Config) -> + ?line load_control_drv(Config), + + ?line P = open_port({spawn, control_drv}, []), + ?line do_command(P, "hello"), + ?line do_command(P, <<"hello">>), + ?line do_command(P, sub_bin(<<"1234kalle">>)), + ?line do_command(P, unaligned_sub_bin(<<"blurf">>)), + ?line do_command(P, ["bl"|unaligned_sub_bin(<<"urf">>)]), + ?line true = erlang:port_close(P), + ok. + +do_command(P, Data) -> + true = erlang:port_command(P, Data), + receive + {P,{data,Data}} -> + ok; + {P,{data,Data0}} -> + case {list_to_binary(Data0),list_to_binary([Data])} of + {B,B} -> ok; + _ -> test_server:fail({unexpected_data,Data0}) + end; + Other -> + test_server:fail({unexpected_message,Other}) + end. + + +command_e(suite) -> [command_e_1, + command_e_2, + command_e_3, + command_e_4]; +command_e(doc) -> "Tests port_command/2 with errors". + +%% port_command/2: badarg 1st arg +command_e_1(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line Program = filename:join(DataDir, "port_test"), + + process_flag(trap_exit, true), + ?line _ = spawn_link(?MODULE, do_command_e_1, [Program]), + ?line receive + {'EXIT', Pid, {badarg, _}} when is_pid(Pid) -> + ok; + Other -> + ?line test_server:fail(Other) + after 10000 -> + ?line test_server:fail(timeout) + end, + ok. + +do_command_e_1(Program) -> + ?line _ = open_port({spawn, Program}, []), + ?line erlang:port_command(apple, "plock"), + exit(survived). + +%% port_command/2: badarg 2nd arg +command_e_2(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line Program = filename:join(DataDir, "port_test"), + + process_flag(trap_exit, true), + ?line _ = spawn_link(?MODULE, do_command_e_2, [Program]), + ?line receive + {'EXIT', Pid, {badarg, _}} when is_pid(Pid) -> + ok; + Other -> + ?line test_server:fail(Other) + after 10000 -> + ?line test_server:fail(timeout) + end, + ok. + +do_command_e_2(Program) -> + ?line P = open_port({spawn, Program}, []), + ?line erlang:port_command(P, 1), + exit(survived). + +%% port_command/2: Posix signals trapped +command_e_3(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line Program = filename:join(DataDir, "port_test"), + + process_flag(trap_exit, true), + ?line P = open_port({spawn, Program}, [{packet, 1}]), + ?line Data = lists:duplicate(257, $a), + ?line erlang:port_command(P, Data), + ?line receive + {'EXIT', Port, einval} when is_port(Port) -> + ok; + Other -> + test_server:fail(Other) + after 10000 -> + test_server:fail(timeout) + end, + ok. + +%% port_command/2: Posix exit signals not trapped +command_e_4(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line Program = filename:join(DataDir, "port_test"), + + process_flag(trap_exit, true), + ?line _ = spawn_link(?MODULE, do_command_e_4, [Program]), + ?line receive + {'EXIT', Pid, {einval, _}} when is_pid(Pid) -> + ok; + Other -> + ?line test_server:fail(Other) + after 10000 -> + ?line test_server:fail(timeout) + end, + ok. + +do_command_e_4(Program) -> + ?line P = open_port({spawn, Program}, [{packet, 1}]), + ?line Data = lists:duplicate(257, $a), + ?line erlang:port_command(P, Data), + exit(survived). + +port_info(suite) -> [port_info1, port_info2]. + +%% Tests the port_info/1 BIF +port_info1(Config) when is_list(Config) -> + ?line load_control_drv(Config), + Me=self(), + ?line P = open_port({spawn, control_drv}, []), + ?line A1 = erlang:port_info(P), + ?line false = lists:keysearch(registered_name, 1, A1), + ?line register(myport, P), + ?line A = erlang:port_info(P), + ?line {value,{registered_name,myport}}= + lists:keysearch(registered_name, 1, A), + ?line {value,{name,"control_drv"}}=lists:keysearch(name, 1, A), + ?line {value,{links,[Me]}}=lists:keysearch(links, 1, A), + ?line {value,{id,_IdNum}}=lists:keysearch(id, 1, A), + ?line {value,{connected,_}}=lists:keysearch(connected, 1, A), + ?line {value,{input,0}}=lists:keysearch(input, 1, A), + ?line {value,{output,0}}=lists:keysearch(output, 1, A), + ?line true=erlang:port_close(P), + ok. + +%% Tests erlang:port_info/2" +port_info2(Config) when is_list(Config) -> + ?line load_control_drv(Config), + + ?line P = open_port({spawn,control_drv}, [binary]), + ?line [] = erlang:port_info(P, registered_name), + ?line register(myport, P), + ?line {registered_name, myport} = erlang:port_info(P, registered_name), + + ?line {name, "control_drv"}=erlang:port_info(P, name), + ?line {id, _IdNum} = erlang:port_info(P, id), + Me=self(), + ?line {links, [Me]} = erlang:port_info(P, links), + ?line {connected, Me} = erlang:port_info(P, connected), + ?line {input, 0}=erlang:port_info(P, input), + ?line {output,0}=erlang:port_info(P, output), + + ?line erlang:port_control(P, $i, "abc"), + ?line receive + {P,{data,<<"abc">>}} -> ok + end, + ?line {input,3} = erlang:port_info(P, input), + ?line {output,0} = erlang:port_info(P, output), + + ?line Bin = list_to_binary(lists:duplicate(2047, 42)), + ?line output_test(P, Bin, 3, 0), + + ?line true = erlang:port_close(P), + ok. + +output_test(_, _, Input, Output) when Output > 16#1fffffff -> + io:format("~p bytes received\n", [Input]); +output_test(P, Bin, Input0, Output0) -> + erlang:port_command(P, Bin), + receive + {P,{data,Bin}} -> ok; + Other -> + io:format("~p", [Other]), + ?line ?t:fail() + end, + Input = Input0 + size(Bin), + Output = Output0 + size(Bin), + {input,Input} = erlang:port_info(P, input), + {output,Output} = erlang:port_info(P, output), + + %% We can't test much here, but hopefully a debug-built emulator will crasch + %% if there is something wrong with the heap allocation. + case erlang:statistics(io) of + {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> + ok + end, + output_test(P, Bin, Input, Output). + +%% Tests the port_connect/2 BIF. +connect(Config) when is_list(Config) -> + ?line load_control_drv(Config), + + ?line P = open_port({spawn, control_drv}, []), + register(myport, P), + + ?line true = erlang:port_connect(myport, self()), + + %% Connect the port to another process. + + Data = "hello, world", + Parent = self(), + ?line Rec = + fun(Me) -> receive + {P,{data,Data}} -> + Parent ! connect_ok, + Me(Me) + end + end, + ?line RecPid = spawn_link(fun() -> Rec(Rec) end), + ?line true = erlang:port_connect(P, RecPid), + ?line unlink(P), + + %% Send a command to the port and make sure that the + %% other process receives the echo. + + ?line erlang:port_command(P, Data), + ?line receive + connect_ok -> ok + end, + + %% Tests some errors. + + ?line {'EXIT',{badarg, _}}=(catch erlang:port_connect(self(), self())), + ?line {'EXIT',{badarg, _}}=(catch erlang:port_connect(self(), P)), + ?line {'EXIT',{badarg, _}}=(catch erlang:port_connect(P, P)), + ?line {'EXIT',{badarg, _}}=(catch erlang:port_connect(P, xxxx)), + ?line {'EXIT',{badarg, _}}=(catch erlang:port_connect(P, [])), + + ?line process_flag(trap_exit, true), + ?line exit(P, you_should_die), + ?line receive + {'EXIT',RecPid,you_should_die} -> ok; + Other -> ?line ?t:fail({bad_message,Other}) + end, + + %% Done. + ok. + +%% Tests port_control/3 +control(Config) when is_list(Config) -> + ?line load_control_drv(Config), + ?line P = open_port({spawn, control_drv}, []), + + %% Test invalid (out-of-range) arguments. + + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(self(), 1, [])), + + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, -1, [])), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, -34887348739733833, [])), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, 16#100000000, [])), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, a, [])), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, 'e', dum)), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, $e, dum)), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, $e, fun(X) -> X end)), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, $e, + [fun(X) -> X end])), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, $e, + [1|fun(X) -> X end])), + + %% Test errors detected by the driver. + + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, 177, [])), + ?line {'EXIT', {badarg, _}} = (catch erlang:port_control(P, 155, + random_packet(1024))), + + %% Test big op codes. + + register(myport, P), + ?line test_op(myport, 256), + ?line test_op(P, 256), + ?line test_op(P, 16#0033A837), + ?line test_op(P, 16#0ab37938), + ?line test_op(P, 16#eab37938), + ?line test_op(P, 16#ffffFFFF), + + %% Test the echo function of the driver. + + ?line echo(P, 0), + ?line echo(P, 1), + ?line echo(P, 10), + ?line echo(P, 13), + ?line echo(P, 63), + ?line echo(P, 64), + ?line echo(P, 65), + ?line echo(P, 127), + ?line echo(P, 1023), + ?line echo(P, 1024), + ?line echo(P, 11243), + ?line echo(P, 70000), + + %% Done. + + ?line true=erlang:port_close(myport), + ok. + +test_op(P, Op) -> + R = port_control(P, Op, []), + <> = list_to_binary(R). + +echo_to_busy(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line load_control_drv(Config), + ?line P = open_port({spawn, control_drv}, []), + ?line erlang:port_control(P, $b, [1]), % Set to busy. + Self = self(), + ?line Echoer = spawn(fun() -> echoer(P, Self) end), + ?line receive after 500 -> ok end, + ?line erlang:port_control(P, $b, [0]), % Set to not busy. + ?line receive + {Echoer, done} -> + ok; + {Echoer, Other} -> + test_server:fail(Other); + Other -> + test_server:fail({unexpected_message, Other}) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +echoer(P, ReplyTo) -> + Msg = random_packet(73), + true = erlang:port_connect(P, self()), + erlang:port_command(P, Msg), + receive + {P, {data, Msg}} -> + ReplyTo ! {self(), done}; + Other -> + ReplyTo ! {self(), {bad_message, Other}} + end. + +echo(P, Size) -> + io:format("Echo test, size ~w", [Size]), + Packet = random_packet(Size), + Packet = erlang:port_control(P, $e, Packet), + Bin = list_to_binary(Packet), + Packet = erlang:port_control(P, $e, Bin), + Packet = erlang:port_control(P, $e, sub_bin(Bin)), + Packet = erlang:port_control(P, $e, unaligned_sub_bin(Bin)), + Packet = erlang:port_control(P, $e, [unaligned_sub_bin(Bin)]). + +load_control_drv(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line erl_ddll:start(), + ?line ok = load_driver(DataDir, "control_drv"). + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. + +random_packet(Size) -> + random_packet(Size, "", random_char()). + +random_packet(0, Result, _NextChar) -> + Result; +random_packet(Left, Result, NextChar0) -> + NextChar = + if + NextChar0 >= 126 -> + 33; + true -> + NextChar0+1 + end, + random_packet(Left-1, [NextChar0|Result], NextChar). + +random_char() -> + random_char("abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789"). + +random_char(Chars) -> + lists:nth(uniform(length(Chars)), Chars). + +uniform(N) -> + case get(random_seed) of + undefined -> + {X, Y, Z} = time(), + random:seed(X, Y, Z); + _ -> + ok + end, + random:uniform(N). + +unaligned_sub_bin(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +sub_bin(Bin) when is_binary(Bin) -> + {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), + B. + +id(I) -> I. + diff --git a/erts/emulator/test/port_bif_SUITE_data/Makefile.src b/erts/emulator/test/port_bif_SUITE_data/Makefile.src new file mode 100644 index 0000000000..1a2d348ecb --- /dev/null +++ b/erts/emulator/test/port_bif_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +all: control_drv@dll@ port_test@exe@ + +port_test@exe@: port_test@obj@ + $(LD) $(CROSSLDFLAGS) -o port_test port_test@obj@ @LIBS@ + +port_test@obj@: port_test.c + $(CC) -c -o port_test@obj@ $(CFLAGS) port_test.c + +@SHLIB_RULES@ diff --git a/erts/emulator/test/port_bif_SUITE_data/control_drv.c b/erts/emulator/test/port_bif_SUITE_data/control_drv.c new file mode 100644 index 0000000000..e9f57a887a --- /dev/null +++ b/erts/emulator/test/port_bif_SUITE_data/control_drv.c @@ -0,0 +1,84 @@ +#include +#include +#include "erl_driver.h" + + +static ErlDrvPort erlang_port; +static ErlDrvData control_start(ErlDrvPort, char*); +static void control_stop(ErlDrvData); +static void control_read(ErlDrvData, char*, int); +static int control_control(ErlDrvData, unsigned int, char*, int, char**, int); + +static ErlDrvEntry control_driver_entry = +{ + NULL, + control_start, + control_stop, + control_read, + NULL, + NULL, + "control_drv", + NULL, + NULL, + control_control, + NULL, + NULL, + NULL +}; + +DRIVER_INIT(control_drv) +{ + erlang_port = (ErlDrvPort)-1; + return &control_driver_entry; +} + +static ErlDrvData control_start(ErlDrvPort port,char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) + return ERL_DRV_ERROR_GENERAL; + + erlang_port = port; + return (ErlDrvData)port; +} + +static void control_read(ErlDrvData port, char *buf, int count) +{ + driver_output(erlang_port, buf, count); +} + +static void control_stop(ErlDrvData port) +{ + erlang_port = (ErlDrvPort)-1; +} + +static int control_control(ErlDrvData port, unsigned command, char* buf, int count, + char** res, int res_size) +{ + switch (command) { + case 'e': + if (count > res_size) { + *res = (char *) driver_alloc(count); + } + memcpy(*res, buf, count); + return count; + case 'b': + set_busy_port(erlang_port, buf[0]); + return 0; + case 'i': + driver_output(erlang_port, buf, count); + return 0; + default: + if (command < 256) { + return -1; + } else { + char* p = *res; + int i; + + for (i = 3; i >= 0; i--) { + p[i] = command; + command >>= 8; + } + return 4; + } + } +} diff --git a/erts/emulator/test/port_bif_SUITE_data/port_test.c b/erts/emulator/test/port_bif_SUITE_data/port_test.c new file mode 100644 index 0000000000..c6b128df66 --- /dev/null +++ b/erts/emulator/test/port_bif_SUITE_data/port_test.c @@ -0,0 +1,602 @@ +/* + * Author: Bjorn Gustavsson + * Purpose: A port program to be used for testing the open_port bif. + */ + +#ifdef VXWORKS +#include +#include +#include +#include +#include +#include +#endif + +#include +#include +#include +#include +#include +#include +#include + +#ifndef __WIN32__ +#include + +#ifdef VXWORKS +#include "reclaim.h" +#include +#else +#include +#endif + +#define O_BINARY 0 +#define _setmode(fd, mode) +#endif + +#ifdef __WIN32__ +#include "windows.h" +#include "winbase.h" +#endif + + +#ifdef VXWORKS +#define REDIR_STDOUT(fd) ioTaskStdSet(0, 1, fd); +#else +#define REDIR_STDOUT(fd) if (dup2(fd, 1) == -1) { \ + fprintf(stderr, "%s: failed to duplicate handle %d to 1: %d\n", \ + port_data->progname, fd, errno); \ + exit(1); \ +} +#endif + +#ifdef VXWORKS +#define MAIN(argc, argv) port_test(argc, argv) +#else +#define MAIN(argc, argv) main(argc, argv) +#endif + + +extern int errno; + +typedef struct { + char* progname; /* Name of this program (from argv[0]). */ + int header_size; /* Number of bytes in each packet header: + * 1, 2, or 4, or 0 for a continous byte stream. */ + int fd_from_erl; /* File descriptor from Erlang. */ + int fd_to_erl; /* File descriptor to Erlang. */ + unsigned char* io_buf; /* Buffer for file i/o. */ + int io_buf_size; /* Current size of i/o buffer. */ + int delay_mode; /* If set, this program will wait 5 seconds + * after reading the header for a packet + * before reading the rest. + */ + int break_mode; /* If set, this program will close standard + * input, which should case broken pipe + * error in the writer. + */ + int quit_mode; /* If set, this program will exit + * just after reading the packet header. + */ + int slow_writes; /* Writes back the reply in chunks with + * sleeps in between. The value is the + * chunk size. If 0, normal writes are done. + */ + char* output_file; /* File into which the result will be written. */ + int no_packet_loop; /* No packet loop. */ + + int limited_bytecount; /* Only answer a limited number of bytes, then exit (stream mode) */ + +} PORT_TEST_DATA; + +PORT_TEST_DATA* port_data; + +static int packet_loop(); +static void reply(); +static void write_reply(); +static void ensure_buf_big_enough(); +static int readn(); +static void delay(unsigned ms); +static void dump(unsigned char* buf, int sz, int max); +static void replace_stdout(char* filename); +static void generate_reply(char* spec); + +#ifndef VXWORKS +#ifndef HAVE_STRERROR +extern int sys_nerr; +#ifndef sys_errlist /* sys_errlist is sometimes defined to + call a function on win32 */ +extern char *sys_errlist[]; +#endif + +char* +strerror(err) +int err; +{ + static char msgstr[1024]; + + if (err == 0) { + msgstr[0] = '\0'; + } else if (0 < err && err < sys_nerr) { + strcpy(msgstr, sys_errlist[err]); + } else { + sprintf(msgstr, "Unknown error %d", err); + } + return msgstr; +} +#endif +#endif + + +MAIN(argc, argv) +int argc; +char *argv[]; +{ + int ret; +#ifdef VXWORKS + if(taskVarAdd(0, (int *)&port_data) != OK) { + fprintf(stderr, "Can't do taskVarAdd in port_test\n"); + exit(1); + } +#endif + if((port_data = (PORT_TEST_DATA *) malloc(sizeof(PORT_TEST_DATA))) == NULL) { + fprintf(stderr, "Couldn't malloc for port_data"); + exit(1); + } + port_data->header_size = 0; + port_data->io_buf_size = 0; + port_data->delay_mode = 0; + port_data->break_mode = 0; + port_data->quit_mode = 0; + port_data->slow_writes = 0; + port_data->output_file = NULL; + port_data->no_packet_loop = 0; + + port_data->progname = argv[0]; + port_data->fd_from_erl = 0; + port_data->fd_to_erl = 1; + + port_data->limited_bytecount = 0; + + _setmode(0, _O_BINARY); + _setmode(1, _O_BINARY); + + while (argc > 1 && argv[1][0] == '-') { + switch (argv[1][1]) { + case 'b': /* Break mode. */ + port_data->break_mode = 1; + break; + case 'c': /* Close standard output. */ + close(port_data->fd_to_erl); + break; + case 'd': /* Delay mode. */ + port_data->delay_mode = 1; + break; + case 'n': /* No packet loop. */ + port_data->no_packet_loop = 1; + break; + case 'o': /* Output to file. */ + port_data->output_file = argv[1]+2; + break; + case 'q': /* Quit mode. */ + port_data->quit_mode = 1; + break; + case 'r': /* Generate reply. */ + generate_reply(argv[1]+2); + break; + case 's': /* Slow writes. */ + port_data->slow_writes = atoi(argv[1]+2); + break; + case 'h': /* Header size for packets. */ + switch (argv[1][2]) { + case '0': port_data->header_size = 0; break; + case '1': port_data->header_size = 1; break; + case '2': port_data->header_size = 2; break; + case '4': port_data->header_size = 4; break; + case '\0': + fprintf(stderr, "%s: missing header size for -h\n", port_data->progname); + return 1; + default: + fprintf(stderr, "%s: illegal packet header size: %c\n", + port_data->progname, argv[1][2]); + return 1; + } + break; + case 'e': + port_data->fd_to_erl = 2; + break; + case 'l': + port_data->limited_bytecount = atoi(argv[1]+2); + break; + default: + fprintf(stderr, "Unrecognized switch: %s\n", argv[1]); + free(port_data); + exit(1); + } + argc--, argv++; + } + + if (argc > 1) { + /* XXX Add error printout here */ + } + + if (port_data->no_packet_loop){ + free(port_data); + exit(0); + } + + /* + * If an output file was given, let it replace standard output. + */ + + if (port_data->output_file) + replace_stdout(port_data->output_file); + + ret = packet_loop(); + if(port_data->io_buf_size > 0) + free(port_data->io_buf); + free(port_data); + return ret; +} + +static int +packet_loop(void) +{ + int total_read = 0; + port_data->io_buf = (unsigned char*) malloc(1); /* Allocate once, so realloc works (SunOS) */ + + + for (;;) { + int packet_length; /* Length of current packet. */ + int i; + int bytes_read; /* Number of bytes read. */ + + /* + * Read the packet header, if any. + */ + + if (port_data->header_size == 0) { + if(port_data->limited_bytecount && + port_data->limited_bytecount - total_read < 4096) + packet_length = port_data->limited_bytecount - total_read; + else + packet_length = 4096; + } else { + ensure_buf_big_enough(port_data->header_size); + if (readn(port_data->fd_from_erl, port_data->io_buf, port_data->header_size) != port_data->header_size) { + return(1); + } + + /* + * Get the length of this packet. + */ + + packet_length = 0; + for (i = 0; i < port_data->header_size; i++) + packet_length = (packet_length << 8) | port_data->io_buf[i]; + } + + + /* + * Delay if delay mode. + */ + + if (port_data->delay_mode) { + delay(5000L); + } + + if (port_data->quit_mode) { + return(1); + } else if (port_data->break_mode) { + close(0); + delay(32000L); + return(1); + } + + /* + * Read the packet itself. + */ + + ensure_buf_big_enough(packet_length+4+1); /* At least five bytes. */ + port_data->io_buf[4] = '\0'; + if (port_data->header_size == 0) { + bytes_read = read(port_data->fd_from_erl, port_data->io_buf+4, packet_length); + if (bytes_read == 0) + return(1); + if (bytes_read < 0) { + fprintf(stderr, "Error reading %d bytes: %s\n", + packet_length, strerror(errno)); + return(1); + } + total_read += bytes_read; + } else { + bytes_read = readn(port_data->fd_from_erl, port_data->io_buf+4, packet_length); + if (bytes_read != packet_length) { + fprintf(stderr, "%s: couldn't read packet of length %d\r\n", + port_data->progname, packet_length); + return(1); + } + } + + /* + * Act on the command. + */ + if (port_data->header_size == 0) { + reply(port_data->io_buf+4, bytes_read); + if(port_data->limited_bytecount && + port_data->limited_bytecount <= total_read){ + delay(5000L); + return(0); + } + } else { + switch (port_data->io_buf[4]) { + case 'p': /* ping */ + port_data->io_buf[4] = 'P'; + reply(port_data->io_buf+4, bytes_read); + break; + case 'e': /* echo */ + reply(port_data->io_buf+4, bytes_read); + break; + default: + fprintf(stderr, "%s: bad packet of length %d received: ", + port_data->progname, bytes_read); + dump(port_data->io_buf+4, bytes_read, 10); + fprintf(stderr, "\r\n"); + return(1); + } + } + } +} + +/* + * Sends a packet back to Erlang. + */ + +static void +reply(buf, size) + char* buf; /* Buffer with reply. The four bytes before + * this pointer must be allocated so that + * this function can put the header there. + */ + int size; /* Size of buffer to send. */ +{ + int n; /* Temporary to hold size. */ + int i; /* Loop counter. */ + + /* + * Fill the header starting with the least significant byte + * (this will work even if there is no header). + */ + + n = size; + for (i = 0; i < port_data->header_size; i++) { + *--buf = (char) n; /* Store least significant byte. */ + n = n >> 8; + } + + size += port_data->header_size; + write_reply(buf, size); +} + + + +static void +write_reply(buf, size) + char* buf; /* Buffer with reply. Must contain header. */ + int size; /* Size of buffer to send. */ +{ + int n; /* Temporary to hold size. */ + + if (port_data->slow_writes <= 0) { /* Normal, "fast", write. */ + write(port_data->fd_to_erl, buf, size); + } else { + /* + * Write chunks with delays in between. + */ + + while (size > 0) { + n = size > port_data->slow_writes ? port_data->slow_writes : size; + write(port_data->fd_to_erl, buf, n); + size -= n; + buf += n; + if (size) + delay(500L); + } + } +} + + +/* + * Ensures that our I/O buffer is big enough for the packet to come. + */ + +static void +ensure_buf_big_enough(size) + int size; /* Needed size of buffer. */ +{ + if (port_data->io_buf_size >= size) + return; + + port_data->io_buf = (unsigned char*) realloc(port_data->io_buf, size); + if (port_data->io_buf == NULL) { + fprintf(stderr, "%s: insufficient memory for i/o buffer of size %d\n", + port_data->progname, size); + exit(1); + } + port_data->io_buf_size = size; +} + +/* + * Reads len number of bytes. + */ +static int +readn(fd, buf, len) + int fd; /* File descriptor to read from. */ + unsigned char *buf; /* Store in this buffer. */ + int len; /* Number of bytes to read. */ +{ + int n; /* Byte count in last read call. */ + int sofar; /* Bytes read so far. */ + + sofar = 0; + do { + if ((n = read(fd, buf+sofar, len-sofar)) <= 0) + /* error or EOF in read */ + return(n); + sofar += n; + } while (sofar < len); + return sofar; +} + +static void +replace_stdout(filename) +char* filename; /* Name of file to replace standard output. */ +{ + int fd; + + fd = open(filename, O_CREAT|O_TRUNC|O_WRONLY|O_BINARY, 0666); + if (fd == -1) { + fprintf(stderr, "%s: failed to open %s for writing: %d\n", + port_data->progname, filename, errno); + exit(1); + } + REDIR_STDOUT(fd); +} + +static void +dump(buf, sz, max) + unsigned char* buf; + int sz; + int max; +{ + int i, imax; + char comma[5]; + + comma[0] = ','; + comma[1] = '\0'; + if (!sz) + return; + if (sz > max) + imax = max; + else + imax = sz; + + for (i=0; i max) + strcpy(comma, ",..."); + else + comma[0] = 0; + } + if (isdigit(buf[i])) { + fprintf(stderr, "%u%s", (int)(buf[i]), comma); + } else { + if (isalpha(buf[i])) { + fprintf(stderr, "%c%s", buf[i], comma); + } + else { + fprintf(stderr, "%u%s", (int)(buf[i]), comma); + } + } + } +} + +/* + * Delays (sleeps) the given number of milli-seconds. + */ + +static void +delay(unsigned ms) +{ +#ifdef VXWORKS + taskDelay((sysClkRateGet() * ms) / 1000); +#else +#ifdef __WIN32__ + Sleep(ms); +#else + struct timeval t; + t.tv_sec = ms/1000; + t.tv_usec = (ms % 1000) * 1000; + + select(0, NULL, NULL, NULL, &t); +#endif +#endif +} + +/* + * Generates a reply buffer given the specification. + * + * ,,, + * + * Where: + * is + */ +static void +generate_reply(spec) +char* spec; /* Specification for reply. */ +{ + typedef struct item { + int start; /* Start character. */ + int incrementer; /* How much to increment. */ + size_t size; /* Size of reply buffer. */ + } Item; + + Item items[256]; + int last; + int cur; + size_t total_size; + char* buf; /* Reply buffer. */ + char* s; /* Current pointer into buffer. */ + int c; + + total_size = 0; + last = 0; + while (*spec) { + char* colon; + + items[last].incrementer = 1; + items[last].start = *spec++; + items[last].size = atoi(spec); + + total_size += port_data->header_size+items[last].size; + last++; + if ((colon = strchr(spec, ':')) == NULL) { + spec += strlen(spec); + } else { + *colon = '\0'; + spec = colon+1; + } + } + + buf = (char *) malloc(total_size); + if (buf == NULL) { + fprintf(stderr, "%s: insufficent memory for reply buffer of size %d\n", + port_data->progname, total_size); + exit(1); + } + + s = buf; + for (cur = 0; cur < last; cur++) { + int i; + size_t n; + + n = items[cur].size; + s += port_data->header_size; + for (i = 0; i < port_data->header_size; i++) { + *--s = (char) n; /* Store least significant byte. */ + n = n >> 8; + } + s += port_data->header_size; + + c = items[cur].start; + for (i = 0; i < items[cur].size; i++) { + *s++ = c; + c++; + if (c > 126) { + c = 33; + } + } + } + write_reply(buf, s-buf); +} + diff --git a/erts/emulator/test/port_bif_SUITE_data/reclaim.h b/erts/emulator/test/port_bif_SUITE_data/reclaim.h new file mode 100644 index 0000000000..1d57dc5b8a --- /dev/null +++ b/erts/emulator/test/port_bif_SUITE_data/reclaim.h @@ -0,0 +1,60 @@ +#ifndef __RECLAIM_H__ +#define __RECLAIM_H__ + + +/* The Erlang release for VxWorks includes a simple mechanism for + "resource reclamation" at task exit - it allows replacement of the + functions that open/close "files" and malloc/free memory with versions + that keep track, to be able to "reclaim" file descriptors and memory + when a task exits (regardless of *how* it exits). + + The interface to this mechanism is made available via this file, + with the following caveats: + + - The interface may change (or perhaps even be removed, though that + isn't likely until VxWorks itself provides similar functionality) + in future releases - i.e. you must always use the version of this + file that comes with the Erlang release you are using. + + - Disaster is guaranteed if you use the mechanism incorrectly (see + below for the correct way), e.g. allocate memory with the "tracking" + version of malloc() and free it with the "standard" version of free(). + + - The mechanism (of course) incurs some performance penalty - thus + for a simple program you may be better off with careful programming, + making sure that you do whatever close()/free()/etc calls that are + appropriate at all exit points (though if you need to guard against + taskDelete() etc, things get messy...). + + To use the mechanism, simply program your application normally, i.e. + use open()/close()/malloc()/free() etc as usual, but #include this + file before any usage of the relevant functions. NOTE: To avoid the + "disaster" mentioned above, you *must* #include it in *all* (or none) + of the files that manipulate a particular file descriptor, allocated + memory area, etc. Finally, note that you can obviously not load your + application before the Erlang system when using this interface. +*/ + +/* Sorry, no ANSI prototypes yet... */ +extern int save_open(),save_creat(),save_socket(),save_accept(),save_close(); +#define open save_open +#define creat save_creat +#define socket save_socket +#define accept save_accept +#define close save_close +extern FILE *save_fopen(), *save_fdopen(), *save_freopen(); +extern int save_fclose(); +#define fopen save_fopen +#define fdopen save_fdopen +#define freopen save_freopen +#define fclose save_fclose +/* XXX Should do opendir/closedir too... */ +extern char *save_malloc(), *save_calloc(), *save_realloc(); +extern void save_free(), save_cfree(); +#define malloc save_malloc +#define calloc save_calloc +#define realloc save_realloc +#define free save_free +#define cfree save_cfree + +#endif diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl new file mode 100644 index 0000000000..fdedf30e78 --- /dev/null +++ b/erts/emulator/test/process_SUITE.erl @@ -0,0 +1,2067 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(process_SUITE). + +%% Tests processes, trapping exit messages and the BIFs: +%% exit/1 +%% exit/2 +%% process_info/1,2 +%% register/2 (partially) + +-include("test_server.hrl"). + +-define(heap_binary_size, 64). + +-export([all/1, spawn_with_binaries/1, + t_exit_1/1, t_exit_2/1, t_exit_2_other/1, t_exit_2_other_normal/1, + self_exit/1, normal_suicide_exit/1, abnormal_suicide_exit/1, + t_exit_2_catch/1, trap_exit_badarg/1, trap_exit_badarg_in_bif/1, + exit_and_timeout/1, exit_twice/1, + t_process_info/1, process_info_other_msg/1, + process_info_other_dist_msg/1, + process_info_2_list/1, process_info_lock_reschedule/1, + process_info_lock_reschedule2/1, + bump_reductions/1, low_prio/1, binary_owner/1, yield/1, yield2/1, + process_status_exiting/1, + otp_4725/1, bad_register/1, garbage_collect/1, otp_6237/1, + process_info_messages/1, process_flag_badarg/1, + processes_large_tab/1, processes_default_tab/1, processes_small_tab/1, + processes_this_tab/1, processes_apply_trap/1, + processes_last_call_trap/1, processes_gc_trap/1, + processes_term_proc_list/1, processes_bif/1, + otp_7738/1, otp_7738_waiting/1, otp_7738_suspended/1, + otp_7738_resume/1]). +-export([prio_server/2, prio_client/2]). + +-export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). + +-export([hangaround/2, processes_bif_test/0, do_processes/1, + processes_term_proc_list_test/1]). + +all(suite) -> + [spawn_with_binaries, t_exit_1, t_exit_2, + trap_exit_badarg, trap_exit_badarg_in_bif, + t_process_info, process_info_other_msg, process_info_other_dist_msg, + process_info_2_list, + process_info_lock_reschedule, process_info_lock_reschedule2, + process_status_exiting, + bump_reductions, low_prio, yield, yield2, otp_4725, bad_register, + garbage_collect, process_info_messages, process_flag_badarg, otp_6237, + processes_bif, + otp_7738]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(10)), + [{watchdog, Dog},{testcase, Func}|Config]. + +fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +end_per_suite(Config) -> + catch erts_debug:set_internal_state(available_internal_state, false), + Config. + +fun_spawn(Fun) -> + spawn_link(erlang, apply, [Fun, []]). + +%% Tests that binaries as arguments to spawn/3 doesn't leak +%% (unclear if this test case will actually prove anything on +%% a modern computer with lots of memory). +spawn_with_binaries(Config) when is_list(Config) -> + ?line L = lists:duplicate(2048, 42), + ?line TwoMeg = lists:duplicate(1024, L), + ?line Fun = fun() -> spawn(?MODULE, binary_owner, [list_to_binary(TwoMeg)]), + receive after 1 -> ok end end, + ?line Iter = case test_server:purify_is_running() of + true -> 10; + false -> 150 + end, + ?line test_server:do_times(Iter, Fun), + ok. + +binary_owner(Bin) when is_binary(Bin) -> + ok. + +%% Tests exit/1 with a big message. +t_exit_1(Config) when is_list(Config) -> + ?line start_spawner(), + ?line Dog = test_server:timetrap(test_server:seconds(20)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(10, fun t_exit_1/0), + ?line test_server:timetrap_cancel(Dog), + ?line stop_spawner(), + ok. + +t_exit_1() -> + ?line Pid = fun_spawn(fun() -> exit(kb_128()) end), + ?line Garbage = kb_128(), + ?line receive + {'EXIT', Pid, Garbage} -> ok + end. + +t_exit_2(suite) -> [t_exit_2_other, t_exit_2_other_normal, + self_exit, normal_suicide_exit, + abnormal_suicide_exit, t_exit_2_catch, + exit_and_timeout, exit_twice]. + +%% Tests exit/2 with a lot of data in the exit message. +t_exit_2_other(Config) when is_list(Config) -> + ?line start_spawner(), + ?line Dog = test_server:timetrap(test_server:seconds(20)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(10, fun t_exit_2_other/0), + ?line test_server:timetrap_cancel(Dog), + ?line stop_spawner(), + ok. + +t_exit_2_other() -> + ?line Pid = fun_spawn(fun() -> receive x -> ok end end), + ?line Garbage = kb_128(), + ?line exit(Pid, Garbage), + ?line receive + {'EXIT', Pid, Garbage} -> ok + end. + +%% Tests that exit(Pid, normal) does not kill another process.; +t_exit_2_other_normal(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun() -> receive x -> ok end end), + ?line exit(Pid, normal), + ?line receive + {'EXIT', Pid, Reason} -> + ?line test_server:fail({process_died, Reason}) + after 1000 -> + ok + end, + ?line case process_info(Pid) of + undefined -> + test_server:fail(process_died_on_normal); + List when is_list(List) -> + ok + end, + exit(Pid, kill), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests that we can trap an exit message sent with exit/2 from +%% the same process. +self_exit(Config) when is_list(Config) -> + ?line start_spawner(), + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(200, fun self_exit/0), + ?line test_server:timetrap_cancel(Dog), + ?line stop_spawner(), + ok. + +self_exit() -> + ?line Garbage = eight_kb(), + ?line P = self(), + ?line true = exit(P, Garbage), + ?line receive + {'EXIT', P, Garbage} -> ok + end. + +%% Tests exit(self(), normal) is equivalent to exit(normal) for a process +%% that doesn't trap exits. +normal_suicide_exit(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun() -> exit(self(), normal) end), + ?line receive + {'EXIT', Pid, normal} -> ok; + Other -> test_server:fail({bad_message, Other}) + end. + +%% Tests exit(self(), Term) is equivalent to exit(Term) for a process +%% that doesn't trap exits."; +abnormal_suicide_exit(Config) when is_list(Config) -> + ?line Garbage = eight_kb(), + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun() -> exit(self(), Garbage) end), + ?line receive + {'EXIT', Pid, Garbage} -> ok; + Other -> test_server:fail({bad_message, Other}) + end. + +%% Tests that exit(self(), die) cannot be catched. +t_exit_2_catch(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line Pid = fun_spawn(fun() -> catch exit(self(), die) end), + ?line receive + {'EXIT', Pid, normal} -> + test_server:fail(catch_worked); + {'EXIT', Pid, die} -> + ok; + Other -> + test_server:fail({bad_message, Other}) + end. + +%% Tests trapping of an 'EXIT' message generated by a bad argument to +%% the abs/1 bif. The 'EXIT' message will intentionally be very big. +trap_exit_badarg(Config) when is_list(Config) -> + ?line start_spawner(), + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(10, fun trap_exit_badarg/0), + ?line test_server:timetrap_cancel(Dog), + ?line stop_spawner(), + ok. + +trap_exit_badarg() -> + ?line Pid = fun_spawn(fun() -> bad_guy(kb_128()) end), + ?line Garbage = kb_128(), + ?line receive + {'EXIT', Pid, {badarg,[{erlang,abs,[Garbage]},{?MODULE,bad_guy,1}|_]}} -> + ok; + Other -> + ?line ok = io:format("Bad EXIT message: ~P", [Other, 30]), + ?line test_server:fail(bad_exit_message) + end. + +bad_guy(Arg) -> + ?line abs(Arg). + + +kb_128() -> + Eight = eight_kb(), + {big_binary(), + Eight, Eight, Eight, Eight, Eight, Eight, Eight, Eight, + big_binary(), + Eight, Eight, Eight, Eight, Eight, Eight, Eight, Eight, + big_binary()}. + +eight_kb() -> + %%% This is really much more than eight kb, so vxworks platforms + %%% gets away with 1/8 of the other platforms (due to limited + %%% memory resources). + B64 = case os:type() of + vxworks -> + ?line lists:seq(1, 8); + _ -> + ?line lists:seq(1, 64) + end, + ?line B512 = {<<1>>,B64,<<2,3>>,B64,make_unaligned_sub_binary(<<4,5,6,7,8,9>>), + B64,make_sub_binary([1,2,3,4,5,6]), + B64,make_sub_binary(lists:seq(1, ?heap_binary_size+1)), + B64,B64,B64,B64,big_binary()}, + ?line lists:duplicate(8, {B512,B512}). + +big_binary() -> + big_binary(10, [42]). +big_binary(0, Acc) -> + list_to_binary(Acc); +big_binary(N, Acc) -> + big_binary(N-1, [Acc|Acc]). + +%% Test receiving an EXIT message when spawning a BIF with bad arguments. +trap_exit_badarg_in_bif(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line process_flag(trap_exit, true), + ?line test_server:do_times(10, fun trap_exit_badarg_bif/0), + ?line test_server:timetrap_cancel(Dog), + ok. + +trap_exit_badarg_bif() -> + ?line Pid = spawn_link(erlang, node, [1]), + ?line receive + {'EXIT', Pid, {badarg, _}} -> + ok; + Other -> + ?line test_server:fail({unexpected, Other}) + end. + +%% The following sequences of events have crasched Beam. +%% +%% 1) An exit is sent to a process which is currently not running. +%% The exit reason will (on purpose) overwrite the message queue +%% pointer. +%% 2) Before the process is scheduled in, it receives a timeout (from +%% a 'receive after'). +%% 3) The process will crash the next time it executes 'receive'. + +exit_and_timeout(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + + ?line process_flag(trap_exit, true), + ?line Parent = self(), + ?line Low = fun_spawn(fun() -> eat_low(Parent) end), + ?line High = fun_spawn(fun() -> eat_high(Low) end), + ?line eat_wait_for(Low, High), + + ?line test_server:timetrap_cancel(Dog), + ok. + + +eat_wait_for(Low, High) -> + ?line receive + {'EXIT', Low, {you, are, dead}} -> + ok; + {'EXIT', High, normal} -> + eat_wait_for(Low, High); + Other -> + test_server:fail({bad_message, Other}) + end. + +eat_low(_Parent) -> + receive + after 2500 -> + ok + end, + receive + Any -> + io:format("Received: ~p\n", [Any]) + after 1000 -> + ok + end. + +eat_high(Low) -> + process_flag(priority, high), + receive after 1000 -> ok end, + exit(Low, {you, are, dead}), + {_, Sec, _} = now(), + loop(Sec, Sec). + +%% Busy loop for 5 seconds. + +loop(OrigSec, CurrentSec) when CurrentSec < OrigSec+5 -> + {_, NewSec, _} = now(), + loop(OrigSec, NewSec); +loop(_, _) -> + ok. + + +%% Tries to send two different exit messages to a process. +%% (The second one should be ignored.) +exit_twice(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + + ?line process_flag(trap_exit, true), + ?line Low = fun_spawn(fun etwice_low/0), + ?line High = fun_spawn(fun() -> etwice_high(Low) end), + ?line etwice_wait_for(Low, High), + + ?line test_server:timetrap_cancel(Dog), + ok. + +etwice_wait_for(Low, High) -> + ?line receive + {'EXIT', Low, first} -> + ok; + {'EXIT', Low, Other} -> + test_server:fail({wrong_exit_reason, Other}); + {'EXIT', High, normal} -> + etwice_wait_for(Low, High); + Other -> + test_server:fail({bad_message, Other}) + end. + +etwice_low() -> + etwice_low(). + +etwice_high(Low) -> + process_flag(priority, high), + exit(Low, first), + exit(Low, second). + +%% Tests the process_info/1 BIF. +t_process_info(Config) when is_list(Config) -> + ?line [] = process_info(self(), registered_name), + ?line register(my_name, self()), + ?line {registered_name, my_name} = process_info(self(), registered_name), + ?line {status, running} = process_info(self(), status), + ?line {current_function, {?MODULE, t_process_info, 1}} = + process_info(self(), current_function), + ?line Gleader = group_leader(), + ?line {group_leader, Gleader} = process_info(self(), group_leader), + ?line {'EXIT',{badarg,_Info}} = (catch process_info('not_a_pid')), + ok. + +%% Tests the process_info/1 BIF on another process with messages. +process_info_other_msg(Config) when is_list(Config) -> + Self = self(), + ?line Pid = spawn_link(fun() -> other_process(Self) end), + receive + {go_ahead,Pid} -> ok + end, + + ?line Own = {my,own,message}, + + ?line {messages,[Own]} = process_info(Pid, messages), + + ?line Garbage = kb_128(), + ?line MsgA = {a,Garbage}, + ?line MsgB = {b,Garbage}, + ?line MsgC = {c,Garbage}, + ?line MsgD = {d,Garbage}, + ?line MsgE = {e,Garbage}, + + ?line Pid ! MsgA, + ?line {messages,[Own,MsgA]} = process_info(Pid, messages), + ?line Pid ! MsgB, + ?line {messages,[Own,MsgA,MsgB]} = process_info(Pid, messages), + ?line Pid ! MsgC, + ?line {messages,[Own,MsgA,MsgB,MsgC]} = process_info(Pid, messages), + ?line Pid ! MsgD, + ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD]} = process_info(Pid, messages), + ?line Pid ! MsgE, + ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD,MsgE]=All} = process_info(Pid, messages), + ?line {memory,BytesOther} = process_info(Pid, memory), + ?line {memory,BytesSelf} = process_info(self(), memory), + + io:format("Memory ~p: ~p\n", [Pid,BytesOther]), + io:format("Memory ~p (self): ~p\n", [self(),BytesSelf]), + + [Own,MsgA,MsgB,MsgC,MsgD,MsgE] = All, + + ?line Pid ! {self(),empty}, + ?line receive + empty -> ok + end, + ?line {messages,[]} = process_info(Pid, messages), + ?line Pid ! stop, + ok. + +process_info_other_dist_msg(Config) when is_list(Config) -> + %% + %% Check that process_info can handle messages that have not been + %% decoded yet. + %% + ?line {ok, Node} = start_node(Config), + ?line Self = self(), + ?line Pid = spawn_link(fun() -> other_process(Self) end), + ?line receive {go_ahead,Pid} -> ok end, + + ?line Own = {my,own,message}, + + ?line {messages,[Own]} = process_info(Pid, messages), + ?line Garbage = kb_128(), + ?line MsgA = {a,self(),Garbage}, + ?line MsgB = {b,self(),Garbage}, + ?line MsgC = {c,self(),Garbage}, + ?line MsgD = {d,self(),Garbage}, + ?line MsgE = {e,self(),Garbage}, + + %% We don't want the other process to decode messages itself + %% therefore we suspend it. + ?line true = erlang:suspend_process(Pid), + ?line spawn_link(Node, fun () -> + Pid ! MsgA, + Pid ! MsgB, + Pid ! MsgC, + Self ! check_abc + end), + ?line receive check_abc -> ok end, + ?line [{status,suspended}, + {messages,[Own,MsgA,MsgB,MsgC]}, + {status,suspended}]= process_info(Pid, [status,messages,status]), + ?line spawn_link(Node, fun () -> + Pid ! MsgD, + Pid ! MsgE, + Self ! check_de + end), + ?line receive check_de -> ok end, + ?line {messages,[Own,MsgA,MsgB,MsgC,MsgD,MsgE]=All} + = process_info(Pid, messages), + ?line true = erlang:resume_process(Pid), + ?line Pid ! {self(), get_all_messages}, + ?line receive + {all_messages, AllMsgs} -> + ?line All = AllMsgs + end, + ?line {messages,[]} = process_info(Pid, messages), + ?line Pid ! stop, + ?line stop_node(Node), + ?line ok. + + +other_process(Parent) -> + self() ! {my,own,message}, + Parent ! {go_ahead,self()}, + other_process_1(). + +other_process_1() -> + receive + {Parent,get_all_messages} -> + Parent ! {all_messages, get_all_messages()}, + other_process_1(); + {Parent,empty} -> + receive_all(), + Parent ! empty, + other_process_1(); + stop -> ok + end. + +get_all_messages() -> + get_all_messages([]). + +get_all_messages(Msgs) -> + receive + Msg -> + get_all_messages([Msg|Msgs]) + after 0 -> + lists:reverse(Msgs) + end. + +receive_all() -> + receive + _ -> receive_all() + after 0 -> ok + end. + +chk_pi_order([],[]) -> + ok; +chk_pi_order([{Arg, _}| Values], [Arg|Args]) -> + chk_pi_order(Values, Args). + +process_info_2_list(doc) -> + []; +process_info_2_list(suite) -> + []; +process_info_2_list(Config) when is_list(Config) -> + ?line Proc = spawn(fun () -> + receive after infinity -> ok end end), + register(process_SUITE_process_info_2_list1, self()), + register(process_SUITE_process_info_2_list2, Proc), + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line AllArgs = erts_debug:get_internal_state(process_info_args), + ?line A1 = lists:sort(AllArgs) ++ [status] ++ lists:reverse(AllArgs), + + %% Verify that argument is accepted as single atom + ?line lists:foreach(fun (A) -> + ?line {A, _} = process_info(Proc, A), + ?line {A, _} = process_info(self(), A) + end, + A1), + + %% Verify that order is preserved + ?line ok = chk_pi_order(process_info(self(), A1), A1), + ?line ok = chk_pi_order(process_info(Proc, A1), A1), + + %% Small arg list + ?line A2 = [status, stack_size, trap_exit, priority], + ?line [{status, _}, {stack_size, _}, {trap_exit, _}, {priority, _}] + = process_info(Proc, A2), + ?line [{status, _}, {stack_size, _}, {trap_exit, _}, {priority, _}] + = process_info(self(), A2), + + %% Huge arg list (note values are shared) + ?line A3 = lists:duplicate(5000,backtrace), + ?line V3 = process_info(Proc, A3), + ?line 5000 = length(V3), + ?line lists:foreach(fun ({backtrace, _}) -> ok end, V3), + ?line ok. + +process_info_lock_reschedule(doc) -> + []; +process_info_lock_reschedule(suite) -> + []; +process_info_lock_reschedule(Config) when is_list(Config) -> + %% We need a process that is running and an item that requires + %% process_info to take the main process lock. + ?line Target1 = spawn_link(fun tok_loop/0), + ?line Name1 = process_info_lock_reschedule_running, + ?line register(Name1, Target1), + ?line Target2 = spawn_link(fun () -> receive after infinity -> ok end end), + ?line Name2 = process_info_lock_reschedule_waiting, + ?line register(Name2, Target2), + ?line PI = fun(_) -> + ?line erlang:yield(), + ?line [{registered_name, Name1}] + = process_info(Target1, [registered_name]), + ?line [{registered_name, Name2}] + = process_info(Target2, [registered_name]), + ?line erlang:yield(), + ?line {registered_name, Name1} + = process_info(Target1, registered_name), + ?line {registered_name, Name2} + = process_info(Target2, registered_name), + ?line erlang:yield(), + ?line [{registered_name, Name1}| _] + = process_info(Target1), + ?line [{registered_name, Name2}| _] + = process_info(Target2) + end, + ?line lists:foreach(PI, lists:seq(1,1000)), + %% Make sure Target1 still is willing to "tok loop" + ?line case process_info(Target1, status) of + {status, OkStatus} when OkStatus == runnable; + OkStatus == running; + OkStatus == garbage_collecting -> + ?line unlink(Target1), + ?line unlink(Target2), + ?line exit(Target1, bang), + ?line exit(Target2, bang), + ?line OkStatus; + {status, BadStatus} -> + ?line ?t:fail(BadStatus) + end. + +pi_loop(_Name, _Pid, 0) -> + ok; +pi_loop(Name, Pid, N) -> + {registered_name, Name} = process_info(Pid, registered_name), + pi_loop(Name, Pid, N-1). + +process_info_lock_reschedule2(doc) -> + []; +process_info_lock_reschedule2(suite) -> + []; +process_info_lock_reschedule2(Config) when is_list(Config) -> + ?line Parent = self(), + ?line Fun = fun () -> + receive {go, Name, Pid} -> ok end, + pi_loop(Name, Pid, 10000), + Parent ! {done, self()}, + receive after infinity -> ok end + end, + ?line P1 = spawn_link(Fun), + ?line N1 = process_info_lock_reschedule2_1, + ?line true = register(N1, P1), + ?line P2 = spawn_link(Fun), + ?line N2 = process_info_lock_reschedule2_2, + ?line true = register(N2, P2), + ?line P3 = spawn_link(Fun), + ?line N3 = process_info_lock_reschedule2_3, + ?line true = register(N3, P3), + ?line P4 = spawn_link(Fun), + ?line N4 = process_info_lock_reschedule2_4, + ?line true = register(N4, P4), + ?line P5 = spawn_link(Fun), + ?line N5 = process_info_lock_reschedule2_5, + ?line true = register(N5, P5), + ?line P6 = spawn_link(Fun), + ?line N6 = process_info_lock_reschedule2_6, + ?line true = register(N6, P6), + ?line P1 ! {go, N2, P2}, + ?line P2 ! {go, N1, P1}, + ?line P3 ! {go, N1, P1}, + ?line P4 ! {go, N1, P1}, + ?line P5 ! {go, N6, P6}, + ?line P6 ! {go, N5, P5}, + ?line receive {done, P1} -> ok end, + ?line receive {done, P2} -> ok end, + ?line receive {done, P3} -> ok end, + ?line receive {done, P4} -> ok end, + ?line receive {done, P5} -> ok end, + ?line receive {done, P6} -> ok end, + ?line unlink(P1), exit(P1, bang), + ?line unlink(P2), exit(P2, bang), + ?line unlink(P3), exit(P3, bang), + ?line unlink(P4), exit(P4, bang), + ?line unlink(P5), exit(P5, bang), + ?line unlink(P6), exit(P6, bang), + ?line ok. + +process_status_exiting(Config) when is_list(Config) -> + %% Make sure that erts_debug:get_internal_state({process_status,P}) + %% returns exiting if it is in status P_EXITING. + ?line erts_debug:set_internal_state(available_internal_state,true), + ?line Prio = process_flag(priority, max), + ?line P = spawn_opt(fun () -> receive after infinity -> ok end end, + [{priority, normal}]), + ?line erlang:yield(), + %% The tok_loop processes are here to make it hard for the exiting + %% process to be scheduled in for exit... + ?line TokLoops = lists:map(fun (_) -> + spawn_opt(fun tok_loop/0, + [link,{priority, high}]) + end, + lists:seq(1, erlang:system_info(schedulers_online))), + ?line exit(P, boom), + ?line wait_until( + fun () -> + exiting =:= erts_debug:get_internal_state({process_status,P}) + end), + ?line lists:foreach(fun (Tok) -> unlink(Tok), exit(Tok,bang) end, TokLoops), + ?line process_flag(priority, Prio), + ?line ok. + +otp_4725(Config) when is_list(Config) -> + ?line Tester = self(), + ?line Ref1 = make_ref(), + ?line Pid1 = spawn_opt(fun () -> + Tester ! {Ref1, process_info(self())}, + receive + Ref1 -> bye + end + end, + [link, + {priority, max}, + {fullsweep_after, 600}]), + ?line receive + {Ref1, ProcInfo1A} -> + ?line ProcInfo1B = process_info(Pid1), + ?line Pid1 ! Ref1, + ?line check_proc_infos(ProcInfo1A, ProcInfo1B) + end, + ?line Ref2 = make_ref(), + ?line Pid2 = spawn_opt(fun () -> + Tester ! {Ref2, process_info(self())}, + receive + Ref2 -> bye + end + end, + []), + ?line receive + {Ref2, ProcInfo2A} -> + ?line ProcInfo2B = process_info(Pid2), + ?line Pid2 ! Ref2, + ?line check_proc_infos(ProcInfo2A, ProcInfo2B) + end, + ?line ok. + +check_proc_infos(A, B) -> + ?line IC = lists:keysearch(initial_call, 1, A), + ?line IC = lists:keysearch(initial_call, 1, B), + + ?line L = lists:keysearch(links, 1, A), + ?line L = lists:keysearch(links, 1, B), + + ?line D = lists:keysearch(dictionary, 1, A), + ?line D = lists:keysearch(dictionary, 1, B), + + ?line TE = lists:keysearch(trap_exit, 1, A), + ?line TE = lists:keysearch(trap_exit, 1, B), + + ?line EH = lists:keysearch(error_handler, 1, A), + ?line EH = lists:keysearch(error_handler, 1, B), + + ?line P = lists:keysearch(priority, 1, A), + ?line P = lists:keysearch(priority, 1, B), + + ?line GL = lists:keysearch(group_leader, 1, A), + ?line GL = lists:keysearch(group_leader, 1, B), + + ?line GC = lists:keysearch(garbage_collection, 1, A), + ?line GC = lists:keysearch(garbage_collection, 1, B), + + ?line ok. + + +%% Dummies. + +start_spawner() -> + ok. + +stop_spawner() -> + ok. + +%% Tests erlang:bump_reductions/1. +bump_reductions(Config) when is_list(Config) -> + ?line erlang:garbage_collect(), + ?line receive after 1 -> ok end, % Clear reductions. + ?line {reductions,R1} = process_info(self(), reductions), + ?line true = erlang:bump_reductions(100), + ?line {reductions,R2} = process_info(self(), reductions), + ?line case R2-R1 of + Diff when Diff < 100 -> + ?line ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), + ?line test_server:fail({small_diff, Diff}); + Diff when Diff > 110 -> + ?line ok = io:format("R1 = ~w, R2 = ~w", [R1, R2]), + ?line test_server:fail({big_diff, Diff}); + Diff -> + io:format("~p\n", [Diff]), + ok + end, + + %% Make sure that a bignum reduction doesn't crash the emulator (32-bit CPU). + bump_big(R2, 16#08000000). + +bump_big(Prev, Limit) -> + ?line true = erlang:bump_reductions(100000), %Limited to CONTEXT_REDUCTIONS. + ?line case process_info(self(), reductions) of + {reductions,Big} when is_integer(Big), Big > Limit -> + ?line erlang:garbage_collect(), + ?line io:format("~p\n", [Big]); + {reductions,R} when is_integer(R), R > Prev -> + bump_big(R, Limit) + end, + ok. + +%% Priority 'low' should be mixed with 'normal' using a factor of +%% about 8. (OTP-2644) +low_prio(Config) when is_list(Config) -> + case erlang:system_info(schedulers_online) of + 1 -> + ?line ok = low_prio_test(Config); + _ -> + ?line erlang:system_flag(multi_scheduling, block), + ?line ok = low_prio_test(Config), + ?line erlang:system_flag(multi_scheduling, unblock), + ?line {comment, + "Test not written for SMP runtime system. " + "Multi scheduling blocked during test."} + end. + +low_prio_test(Config) when is_list(Config) -> + ?line process_flag(trap_exit, true), + ?line S = spawn_link(?MODULE, prio_server, [0, 0]), + ?line PCs = spawn_prio_clients(S, erlang:system_info(schedulers_online)), + ?line timer:sleep(2000), + ?line lists:foreach(fun (P) -> exit(P, kill) end, PCs), + ?line S ! exit, + ?line receive {'EXIT', S, {A, B}} -> check_prio(A, B) end, + ok. + +check_prio(A, B) -> + ?line Prop = A/B, + ?line ok = io:format("Low=~p, High=~p, Prop=~p\n", [A, B, Prop]), + + %% It isn't 1/8, it's more like 0.3, but let's check that + %% the low-prio processes get some little chance to run at all. + ?line true = (Prop < 1.0), + ?line true = (Prop > 1/32). + +prio_server(A, B) -> + receive + low -> + prio_server(A+1, B); + normal -> + prio_server(A, B+1); + exit -> + exit({A, B}) + end. + +spawn_prio_clients(_, 0) -> + []; +spawn_prio_clients(S, N) -> + [spawn_opt(?MODULE, prio_client, [S, normal], [link, {priority,normal}]), + spawn_opt(?MODULE, prio_client, [S, low], [link, {priority,low}]) + | spawn_prio_clients(S, N-1)]. + +prio_client(S, Prio) -> + S ! Prio, + prio_client(S, Prio). + +make_sub_binary(Bin) when is_binary(Bin) -> + {_,B} = split_binary(list_to_binary([0,1,3,Bin]), 3), + B; +make_sub_binary(List) -> + make_sub_binary(list_to_binary(List)). + +make_unaligned_sub_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +yield(doc) -> + "Tests erlang:yield/1."; +yield(Config) when is_list(Config) -> + case catch erlang:system_info(modified_timing_level) of + Level when is_integer(Level) -> + {skipped, + "Modified timing (level " ++ integer_to_list(Level) + ++ ") is enabled. Testcase gets messed up by modfied " + "timing."}; + _ -> + MS = erlang:system_flag(multi_scheduling, block), + yield_test(), + erlang:system_flag(multi_scheduling, unblock), + case MS of + blocked -> + {comment, + "Multi-scheduling blocked during test. This test-case " + "was not written to work with multiple schedulers (the " + "yield2 test-case tests almost the same thing)."}; + _ -> + ok + end + end. + +yield_test() -> + ?line erlang:garbage_collect(), + ?line receive after 1 -> ok end, % Clear reductions. + ?line SC = schedcnt(start), + ?line {reductions, R1} = process_info(self(), reductions), + ?line {ok, true} = call_yield(middle), + ?line true = call_yield(final), + ?line true = call_yield(), + ?line true = apply(erlang, yield, []), + ?line {reductions, R2} = process_info(self(), reductions), + ?line Schedcnt = schedcnt(stop, SC), + ?line case {R2-R1, Schedcnt} of + {Diff, 4} when Diff < 30 -> + ?line ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", + [R1, R2, Schedcnt]); + {Diff, _} -> + ?line ok = io:format("R1 = ~w, R2 = ~w, Schedcnt = ~w", + [R1, R2, Schedcnt]), + ?line test_server:fail({measurement_error, Diff, Schedcnt}) + end. + +call_yield() -> + erlang:yield(). + +call_yield(middle) -> + {ok, erlang:yield()}; +call_yield(final) -> + case self() of + Self when is_pid(Self) -> + ok + end, + erlang:yield(). + +schedcnt(start) -> + Ref = make_ref(), + Fun = + fun (F, Cnt) -> + receive + {Ref, Parent} -> + Parent ! {Ref, Cnt} + after 0 -> + erlang:yield(), + F(F, Cnt+1) + end + end, + Pid = spawn_link(fun () -> Fun(Fun, 0) end), + {Ref, Pid}. + +schedcnt(stop, {Ref, Pid}) when is_reference(Ref), is_pid(Pid) -> + Pid ! {Ref, self()}, + receive + {Ref, Cnt} -> + Cnt + end. + +yield2(doc) -> []; +yield2(suite) -> []; +yield2(Config) when is_list(Config) -> + ?line Me = self(), + ?line Go = make_ref(), + ?line RedDiff = make_ref(), + ?line Done = make_ref(), + ?line P = spawn(fun () -> + receive Go -> ok end, + {reductions, R1} = process_info(self(), reductions), + {ok, true} = call_yield(middle), + true = call_yield(final), + true = call_yield(), + true = apply(erlang, yield, []), + {reductions, R2} = process_info(self(), reductions), + Me ! {RedDiff, R2 - R1}, + exit(Done) + end), + ?line erlang:yield(), + + ?line 1 = erlang:trace(P, true, [running, procs, {tracer, self()}]), + + ?line P ! Go, + + %% receive Go -> ok end, + ?line {trace, P, in, _} = next_tmsg(P), + + %% {ok, true} = call_yield(middle), + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + + %% true = call_yield(final), + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + + %% true = call_yield(), + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + + %% true = apply(erlang, yield, []), + ?line {trace, P, out, _} = next_tmsg(P), + ?line {trace, P, in, _} = next_tmsg(P), + + %% exit(Done) + ?line {trace, P, exit, Done} = next_tmsg(P), + + + ?line receive + {RedDiff, Reductions} when Reductions < 30, Reductions > 0 -> + io:format("Reductions = ~p~n", [Reductions]), + ?line ok; + {RedDiff, Reductions} -> + ?line ?t:fail({unexpected_reduction_count, Reductions}) + end, + + ?line none = next_tmsg(P), + + ?line ok. + +next_tmsg(Pid) -> + receive + TMsg when is_tuple(TMsg), + element(1, TMsg) == trace, + element(2, TMsg) == Pid -> + TMsg + after 100 -> + none + end. + +%% Test that bad arguments to register/2 cause an exception. +bad_register(Config) when is_list(Config) -> + Name = a_long_and_unused_name, + + ?line {'EXIT',{badarg,_}} = (catch register({bad,name}, self())), + ?line fail_register(undefined, self()), + ?line fail_register([bad,name], self()), + + ?line {Dead,Mref} = spawn_monitor(fun() -> true end), + receive + {'DOWN',Mref,process,Dead,_} -> ok + end, + ?line fail_register(Name, Dead), + ?line fail_register(Name, make_ref()), + ?line fail_register(Name, []), + ?line fail_register(Name, {bad,process}), + ?line fail_register(Name, <<>>), + ok. + +fail_register(Name, Process) -> + {'EXIT',{badarg,_}} = (catch register(Name, Process)), + {'EXIT',{badarg,_}} = (catch Name ! anything_goes), + ok. + +garbage_collect(doc) -> []; +garbage_collect(suite) -> []; +garbage_collect(Config) when is_list(Config) -> + ?line Prio = process_flag(priority, high), + ?line true = erlang:garbage_collect(), + ?line TokLoopers = lists:map(fun (_) -> + spawn_opt(fun tok_loop/0, + [{priority, low}, link]) + end, + lists:seq(1, 10)), + ?line lists:foreach(fun (Pid) -> + ?line Mon = erlang:monitor(process, Pid), + ?line DownBefore = receive + {'DOWN', Mon, _, _, _} -> + ?line true + after 0 -> + ?line false + end, + ?line GC = erlang:garbage_collect(Pid), + ?line DownAfter = receive + {'DOWN', Mon, _, _, _} -> + ?line true + after 0 -> + ?line false + end, + ?line true = erlang:demonitor(Mon), + ?line case {DownBefore, DownAfter} of + {true, _} -> ?line false = GC; + {false, false} -> ?line true = GC; + _ -> ?line GC + end + end, + processes()), + ?line lists:foreach(fun (Pid) -> + unlink(Pid), + exit(Pid, bang) + end, TokLoopers), + ?line process_flag(priority, Prio), + ?line ok. + +process_info_messages(doc) -> + ["This used to cause the nofrag emulator to dump core"]; +process_info_messages(suite) -> + []; +process_info_messages(Config) when is_list(Config) -> + ?line process_info_messages_test(), + ?line ok. + +process_info_messages_loop(0) -> ok; +process_info_messages_loop(N) -> process_info_messages_loop(N-1). + +process_info_messages_send_my_msgs_to(Rcvr) -> + receive + Msg -> + Rcvr ! Msg, + process_info_messages_send_my_msgs_to(Rcvr) + after 0 -> + ok + end. + +process_info_messages_test() -> + ?line Go = make_ref(), + ?line Done = make_ref(), + ?line Rcvr = self(), + ?line Rcvr2 = spawn_link(fun () -> + receive {Go, Rcvr} -> ok end, + garbage_collect(), + Rcvr ! {Done, self()} + end), + ?line Sndrs = lists:map( + fun (_) -> + spawn_link(fun () -> + Rcvr ! {Go, self()}, + receive {Go, Rcvr} -> ok end, + BigData = lists:seq(1, 1000), + Rcvr ! BigData, + Rcvr ! BigData, + Rcvr ! BigData, + Rcvr ! {Done, self()} + end) + end, + lists:seq(1, 10)), + ?line lists:foreach(fun (Sndr) -> receive {Go, Sndr} -> ok end end, + Sndrs), + ?line garbage_collect(), + ?line erlang:yield(), + ?line lists:foreach(fun (Sndr) -> Sndr ! {Go, self()} end, Sndrs), + ?line process_info_messages_loop(100000000), + ?line Msgs = process_info(self(), messages), + ?line lists:foreach(fun (Sndr) -> receive {Done, Sndr} -> ok end end, + Sndrs), + ?line garbage_collect(), + ?line Rcvr2 ! Msgs, + ?line process_info_messages_send_my_msgs_to(Rcvr2), + ?line Rcvr2 ! {Go, self()}, + ?line garbage_collect(), + ?line receive {Done, Rcvr2} -> ok end, + ?line Msgs. + +chk_badarg(Fun) -> + try Fun(), exit(no_badarg) catch error:badarg -> ok end. + +process_flag_badarg(doc) -> + []; +process_flag_badarg(suite) -> + []; +process_flag_badarg(Config) when is_list(Config) -> + ?line chk_badarg(fun () -> process_flag(gurka, banan) end), + ?line chk_badarg(fun () -> process_flag(trap_exit, gurka) end), + ?line chk_badarg(fun () -> process_flag(error_handler, 1) end), + ?line chk_badarg(fun () -> process_flag(min_heap_size, gurka) end), + ?line chk_badarg(fun () -> process_flag(priority, 4711) end), + ?line chk_badarg(fun () -> process_flag(save_calls, hmmm) end), + ?line P= spawn_link(fun () -> receive die -> ok end end), + ?line chk_badarg(fun () -> process_flag(P, save_calls, hmmm) end), + ?line chk_badarg(fun () -> process_flag(gurka, save_calls, hmmm) end), + ?line P ! die, + ?line ok. + +-include_lib("stdlib/include/ms_transform.hrl"). + +otp_6237(doc) -> []; +otp_6237(suite) -> []; +otp_6237(Config) when is_list(Config) -> + ?line Slctrs = lists:map(fun (_) -> + spawn_link(fun () -> + otp_6237_select_loop() + end) + end, + lists:seq(1,5)), + ?line lists:foreach(fun (_) -> otp_6237_test() end, lists:seq(1, 100)), + ?line lists:foreach(fun (S) -> unlink(S),exit(S, kill) end, Slctrs), + ?line ok. + +otp_6237_test() -> + ?line Parent = self(), + ?line Inited = make_ref(), + ?line Die = make_ref(), + ?line Pid = spawn_link(fun () -> + register(otp_6237,self()), + otp_6237 = ets:new(otp_6237, + [named_table, + ordered_set]), + ets:insert(otp_6237, + [{I,I} + || I <- lists:seq(1, 100)]), + %% Inserting a lot of bif timers + %% increase the possibility that + %% the test will fail when the + %% original cleanup order is used + lists:foreach( + fun (_) -> + erlang:send_after(1000000, + self(), + {a,b,c}) + end, + lists:seq(1,1000)), + Parent ! Inited, + receive Die -> bye end + end), + ?line receive + Inited -> ?line ok + end, + ?line Pid ! Die, + otp_6237_whereis_loop(). + +otp_6237_whereis_loop() -> + ?line case whereis(otp_6237) of + undefined -> + ?line otp_6237 = ets:new(otp_6237, + [named_table,ordered_set]), + ?line ets:delete(otp_6237), + ?line ok; + _ -> + ?line otp_6237_whereis_loop() + end. + +otp_6237_select_loop() -> + catch ets:select(otp_6237, ets:fun2ms(fun({K, does_not_exist}) -> K end)), + otp_6237_select_loop(). + + +processes_bif(doc) -> + []; +processes_bif(suite) -> + [processes_large_tab, + processes_default_tab, + processes_small_tab, + processes_this_tab, + processes_last_call_trap, + processes_apply_trap, + processes_gc_trap, + processes_term_proc_list]. + +-define(NoTestProcs, 10000). +-record(processes_bif_info, {min_start_reds, + tab_chunks, + tab_chunks_size, + tab_indices_per_red, + free_term_proc_reds, + term_procs_per_red, + term_procs_max_reds, + conses_per_red, + debug_level}). + +processes_large_tab(doc) -> + []; +processes_large_tab(suite) -> + []; +processes_large_tab(Config) when is_list(Config) -> + ?line enable_internal_state(), + ?line MaxDbgLvl = 20, + ?line MinProcTabSize = 2*(1 bsl 15), + ?line ProcTabSize0 = 1000000, + ?line ProcTabSize1 = case {erlang:system_info(schedulers_online), + erlang:system_info(logical_processors)} of + {Schdlrs, Cpus} when is_integer(Cpus), + Schdlrs =< Cpus -> + ProcTabSize0; + _ -> + ProcTabSize0 div 4 + end, + ?line ProcTabSize2 = case erlang:system_info(debug_compiled) of + true -> ProcTabSize1 - 500000; + false -> ProcTabSize1 + end, + %% With high debug levels this test takes so long time that + %% the connection times out; therefore, shrink the test on + %% high debug levels. + ?line DbgLvl = case erts_debug:get_internal_state(processes_bif_info) of + #processes_bif_info{debug_level = Lvl} when Lvl > MaxDbgLvl -> + 20; + #processes_bif_info{debug_level = Lvl} when Lvl < 0 -> + ?line ?t:fail({debug_level, Lvl}); + #processes_bif_info{debug_level = Lvl} -> + Lvl + end, + ?line ProcTabSize3 = ProcTabSize2 - (1300000 * DbgLvl div MaxDbgLvl), + ?line ProcTabSize = case ProcTabSize3 < MinProcTabSize of + true -> MinProcTabSize; + false -> ProcTabSize3 + end, + ?line {ok, LargeNode} = start_node(Config, + "+P " ++ integer_to_list(ProcTabSize)), + ?line Res = rpc:call(LargeNode, ?MODULE, processes_bif_test, []), + ?line case rpc:call(LargeNode, + erts_debug, + get_internal_state, + [processes_bif_info]) of + #processes_bif_info{tab_chunks = Chunks} when is_integer(Chunks), + Chunks > 1 -> ok; + PBInfo -> ?t:fail(PBInfo) + end, + ?line stop_node(LargeNode), + ?line chk_processes_bif_test_res(Res). + +processes_default_tab(doc) -> + []; +processes_default_tab(suite) -> + []; +processes_default_tab(Config) when is_list(Config) -> + ?line {ok, DefaultNode} = start_node(Config, ""), + ?line Res = rpc:call(DefaultNode, ?MODULE, processes_bif_test, []), + ?line stop_node(DefaultNode), + ?line chk_processes_bif_test_res(Res). + +processes_small_tab(doc) -> + []; +processes_small_tab(suite) -> + []; +processes_small_tab(Config) when is_list(Config) -> + ?line {ok, SmallNode} = start_node(Config, "+P 500"), + ?line Res = rpc:call(SmallNode, ?MODULE, processes_bif_test, []), + ?line PBInfo = rpc:call(SmallNode, + erts_debug, + get_internal_state, + [processes_bif_info]), + ?line stop_node(SmallNode), + ?line 1 = PBInfo#processes_bif_info.tab_chunks, + ?line chk_processes_bif_test_res(Res). + +processes_this_tab(doc) -> + []; +processes_this_tab(suite) -> + []; +processes_this_tab(Config) when is_list(Config) -> + ?line chk_processes_bif_test_res(processes_bif_test()). + +chk_processes_bif_test_res(ok) -> ok; +chk_processes_bif_test_res({comment, _} = Comment) -> Comment; +chk_processes_bif_test_res(Failure) -> ?t:fail(Failure). + +print_processes_bif_info(#processes_bif_info{min_start_reds = MinStartReds, + tab_chunks = TabChunks, + tab_chunks_size = TabChunksSize, + tab_indices_per_red = TabIndPerRed, + free_term_proc_reds = FreeTPReds, + term_procs_per_red = TPPerRed, + term_procs_max_reds = TPMaxReds, + conses_per_red = ConsesPerRed, + debug_level = DbgLvl}) -> + ?t:format("processes/0 bif info on node ~p:~n" + "Min start reductions = ~p~n" + "Process table chunks = ~p~n" + "Process table chunks size = ~p~n" + "Process table indices per reduction = ~p~n" + "Reduction cost for free() on terminated process struct = ~p~n" + "Inspect terminated processes per reduction = ~p~n" + "Max reductions during inspection of terminated processes = ~p~n" + "Create cons-cells per reduction = ~p~n" + "Debug level = ~p~n", + [node(), + MinStartReds, + TabChunks, + TabChunksSize, + TabIndPerRed, + FreeTPReds, + TPPerRed, + TPMaxReds, + ConsesPerRed, + DbgLvl]). + +processes_bif_cleaner() -> + receive {'EXIT', _, _} -> ok end, + processes_bif_cleaner(). + +spawn_initial_hangarounds(Cleaner) -> + TabSz = erlang:system_info(process_limit), + spawn_initial_hangarounds(Cleaner, + TabSz, + TabSz*2, + 0, + []). + +processes_unexpected_result(CorrectProcs, Procs) -> + ProcInfo = [registered_name, + initial_call, + current_function, + status, + priority], + MissingProcs = CorrectProcs -- Procs, + ?t:format("Missing processes: ~p", + [lists:map(fun (Pid) -> + [{pid, Pid} + | case process_info(Pid, ProcInfo) of + undefined -> []; + Res -> Res + end] + end, + MissingProcs)]), + SuperfluousProcs = Procs -- CorrectProcs, + ?t:format("Superfluous processes: ~p", + [lists:map(fun (Pid) -> + [{pid, Pid} + | case process_info(Pid, ProcInfo) of + undefined -> []; + Res -> Res + end] + end, + SuperfluousProcs)]), + ?t:fail(unexpected_result). + +hangaround(Cleaner, Type) -> + %% Type is only used to distinguish different processes from + %% when doing process_info + try link(Cleaner) catch error:Reason -> exit(Reason) end, + receive after infinity -> ok end, + exit(Type). + +spawn_initial_hangarounds(_Cleaner, NP, Max, Len, HAs) when NP > Max -> + {Len, HAs}; +spawn_initial_hangarounds(Cleaner, NP, Max, Len, HAs) -> + erts_debug:set_internal_state(next_pid,NP), + HA1 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], + [{priority, low}]), + HA2 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], + [{priority, normal}]), + HA3 = spawn_opt(?MODULE, hangaround, [Cleaner, initial_hangaround], + [{priority, high}]), + spawn_initial_hangarounds(Cleaner, NP+30, Max, Len+3, [HA1,HA2,HA3|HAs]). + +do_processes(WantReds) -> + erts_debug:set_internal_state(reds_left, WantReds), + processes(). + +processes_bif_test() -> + ?line Tester = self(), + ?line enable_internal_state(), + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = PBInfo#processes_bif_info.min_start_reds + 10, + ?line WillTrap = case PBInfo of + #processes_bif_info{tab_chunks = 1} -> + false; + #processes_bif_info{tab_chunks = Chunks, + tab_chunks_size = ChunksSize, + tab_indices_per_red = IndiciesPerRed + } -> + Chunks*ChunksSize >= IndiciesPerRed*WantReds + end, + ?line Processes = fun () -> + erts_debug:set_internal_state(reds_left,WantReds), + processes() + end, + + ?line ok = do_processes_bif_test(WantReds, WillTrap, Processes), + + case WillTrap of + false -> + ok; + true -> + %% Do it again with a process suspended while + %% in the processes/0 bif. + ?line erlang:system_flag(multi_scheduling, block), + ?line Suspendee = spawn_link(fun () -> + Tester ! {suspend_me, self()}, + Tester ! {self(), + done, + hd(Processes())}, + receive + after infinity -> + ok + end + end), + ?line receive {suspend_me, Suspendee} -> ok end, + ?line erlang:suspend_process(Suspendee), + ?line erlang:system_flag(multi_scheduling, unblock), + + ?line [{status,suspended}, + {current_function,{erlang,processes_trap,2}}] + = process_info(Suspendee, [status, current_function]), + + ?line ok = do_processes_bif_test(WantReds, WillTrap, Processes), + + ?line erlang:resume_process(Suspendee), + ?line receive {Suspendee, done, _} -> ok end, + ?line unlink(Suspendee), + ?line exit(Suspendee, bang) + end, + case get(processes_bif_testcase_comment) of + undefined -> ?line ok; + Comment -> ?line {comment, Comment} + end. + +do_processes_bif_test(WantReds, DieTest, Processes) -> + ?line Tester = self(), + ?line SpawnProcesses = fun (Prio) -> + spawn_opt(?MODULE, + do_processes, + [WantReds], + [link, {priority, Prio}]) + end, + ?line Cleaner = spawn_link(fun () -> + process_flag(trap_exit, true), + Tester ! {cleaner_alive, self()}, + processes_bif_cleaner() + end), + ?line receive {cleaner_alive, Cleaner} -> ok end, + try + ?line DoIt = make_ref(), + ?line GetGoing = make_ref(), + ?line {NoTestProcs, TestProcs} = spawn_initial_hangarounds(Cleaner), + ?line ?t:format("Testing with ~p processes~n", [NoTestProcs]), + ?line SpawnHangAround = fun () -> + spawn(?MODULE, + hangaround, + [Cleaner, new_hangaround]) + end, + ?line Killer = spawn_opt(fun () -> + Splt = NoTestProcs div 10, + {TP1, TP23} = lists:split(Splt, + TestProcs), + {TP2, TP3} = lists:split(Splt, TP23), + erlang:system_flag(multi_scheduling, + block), + Tester ! DoIt, + receive GetGoing -> ok end, + erlang:system_flag(multi_scheduling, + unblock), + SpawnProcesses(high), + lists:foreach( + fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, + TP1), + SpawnProcesses(high), + erlang:yield(), + lists:foreach( + fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, + TP2), + SpawnProcesses(high), + lists:foreach( + fun (P) -> + SpawnHangAround(), + exit(P, bang) + end, + TP3) + end, + [{priority, high}, link]), + ?line receive DoIt -> ok end, + ?line process_flag(priority, low), + ?line SpawnProcesses(low), + ?line erlang:yield(), + ?line process_flag(priority, normal), + ?line CorrectProcs0 = erts_debug:get_internal_state(processes), + ?line Killer ! GetGoing, + ?line erts_debug:set_internal_state(reds_left, WantReds), + ?line Procs0 = processes(), + ?line Procs = lists:sort(Procs0), + ?line CorrectProcs = lists:sort(CorrectProcs0), + ?line LengthCorrectProcs = length(CorrectProcs), + ?line ?t:format("~p = length(CorrectProcs)~n", [LengthCorrectProcs]), + ?line true = LengthCorrectProcs > NoTestProcs, + ?line case CorrectProcs =:= Procs of + true -> + ?line ok; + false -> + ?line processes_unexpected_result(CorrectProcs, Procs) + end, + ?line unlink(Killer), + ?line exit(Killer, bang) + after + unlink(Cleaner), + exit(Cleaner, kill), + %% Wait for the system to recover to a normal state... + wait_until_system_recover() + end, + ?line do_processes_bif_die_test(DieTest, Processes), + ?line ok. + + +do_processes_bif_die_test(false, _Processes) -> + ?line ?t:format("Skipping test killing process executing processes/0~n",[]), + ?line ok; +do_processes_bif_die_test(true, Processes) -> + ?line do_processes_bif_die_test(5, Processes); +do_processes_bif_die_test(N, Processes) -> + ?line ?t:format("Doing test killing process executing processes/0~n",[]), + try + ?line Tester = self(), + ?line Oooh_Nooooooo = make_ref(), + ?line {_, DieWhileDoingMon} = erlang:spawn_monitor( + fun () -> + Victim = self(), + spawn_opt( + fun () -> + exit(Victim, got_him) + end, + [link, + {priority, max}]), + Tester ! {Oooh_Nooooooo, + hd(Processes())}, + exit(ohhhh_nooooo) + end), + ?line receive + {'DOWN', DieWhileDoingMon, _, _, Reason} -> + case Reason of + got_him -> ok; + _ -> throw({kill_in_trap, Reason}) + end + end, + ?line receive + {Oooh_Nooooooo, _} -> + ?line throw({kill_in_trap, 'Oooh_Nooooooo'}) + after 0 -> + ?line ok + end, + ?line PrcsCllrsSeqLen = 2*erlang:system_info(schedulers_online), + ?line PrcsCllrsSeq = lists:seq(1, PrcsCllrsSeqLen), + ?line ProcsCallers = lists:map( + fun (_) -> + spawn_link( + fun () -> + Tester ! hd(Processes()) + end) + end, + PrcsCllrsSeq), + ?line erlang:yield(), + {ProcsCallers1, ProcsCallers2} = lists:split(PrcsCllrsSeqLen div 2, + ProcsCallers), + ?line process_flag(priority, high), + ?line lists:foreach( + fun (P) -> + unlink(P), + exit(P, bang) + end, + lists:reverse(ProcsCallers2) ++ ProcsCallers1), + ?line process_flag(priority, normal), + ?line ok + catch + throw:{kill_in_trap, R} when N > 0 -> + ?t:format("Failed to kill in trap: ~p~n", [R]), + ?t:format("Trying again~p~n", []), + do_processes_bif_die_test(N-1, Processes) + end. + + +wait_until_system_recover() -> + %% If system hasn't recovered after 10 seconds we give up + Tmr = erlang:start_timer(10000, self(), no_more_wait), + wait_until_system_recover(Tmr). + +wait_until_system_recover(Tmr) -> + try + lists:foreach(fun (P) when P == self() -> + ok; + (P) -> + case process_info(P, initial_call) of + {initial_call,{?MODULE, _, _}} -> + throw(wait); + {initial_call,{_, _, _}} -> + ok; + undefined -> + ok + end + end, + processes()) + catch + throw:wait -> + receive + {timeout, Tmr, _} -> + Comment = "WARNING: Test processes still hanging around!", + ?t:format("~s~n", [Comment]), + put(processes_bif_testcase_comment, Comment), + lists:foreach( + fun (P) when P == self() -> + ok; + (P) -> + case process_info(P, initial_call) of + {initial_call,{?MODULE, _, _} = MFA} -> + ?t:format("~p ~p~n", [P, MFA]); + {initial_call,{_, _, _}} -> + ok; + undefined -> + ok + end + end, + processes()) + after 100 -> + wait_until_system_recover(Tmr) + end + end, + erlang:cancel_timer(Tmr), + receive {timeout, Tmr, _} -> ok after 0 -> ok end, + ok. + +processes_last_call_trap(doc) -> + []; +processes_last_call_trap(suite) -> + []; +processes_last_call_trap(Config) when is_list(Config) -> + ?line enable_internal_state(), + ?line Processes = fun () -> processes() end, + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = case PBInfo#processes_bif_info.min_start_reds of + R when R > 10 -> R - 1; + _R -> 9 + end, + ?line lists:foreach(fun (_) -> + ?line erts_debug:set_internal_state(reds_left, + WantReds), + Processes(), + ?line erts_debug:set_internal_state(reds_left, + WantReds), + my_processes() + end, + lists:seq(1,100)). + +my_processes() -> + processes(). + +processes_apply_trap(doc) -> + []; +processes_apply_trap(suite) -> + []; +processes_apply_trap(Config) when is_list(Config) -> + ?line enable_internal_state(), + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = case PBInfo#processes_bif_info.min_start_reds of + R when R > 10 -> R - 1; + _R -> 9 + end, + ?line lists:foreach(fun (_) -> + ?line erts_debug:set_internal_state(reds_left, + WantReds), + ?line apply(erlang, processes, []) + end, + lists:seq(1,100)). + +processes_gc_trap(doc) -> + []; +processes_gc_trap(suite) -> + []; +processes_gc_trap(Config) when is_list(Config) -> + ?line Tester = self(), + ?line enable_internal_state(), + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = PBInfo#processes_bif_info.min_start_reds + 10, + ?line Processes = fun () -> + erts_debug:set_internal_state(reds_left,WantReds), + processes() + end, + + ?line erlang:system_flag(multi_scheduling, block), + ?line Suspendee = spawn_link(fun () -> + Tester ! {suspend_me, self()}, + Tester ! {self(), + done, + hd(Processes())}, + receive after infinity -> ok end + end), + ?line receive {suspend_me, Suspendee} -> ok end, + ?line erlang:suspend_process(Suspendee), + ?line erlang:system_flag(multi_scheduling, unblock), + + ?line [{status,suspended}, {current_function,{erlang,processes_trap,2}}] + = process_info(Suspendee, [status, current_function]), + + ?line erlang:garbage_collect(Suspendee), + ?line erlang:garbage_collect(Suspendee), + + ?line erlang:resume_process(Suspendee), + ?line receive {Suspendee, done, _} -> ok end, + ?line erlang:garbage_collect(Suspendee), + ?line erlang:garbage_collect(Suspendee), + + ?line unlink(Suspendee), + ?line exit(Suspendee, bang), + ?line ok. + + +processes_term_proc_list(doc) -> + []; +processes_term_proc_list(suite) -> + []; +processes_term_proc_list(Config) when is_list(Config) -> + ?line Tester = self(), + ?line as_expected = processes_term_proc_list_test(false), + ?line {ok, Node} = start_node(Config, "+Mis true"), + ?line RT = spawn_link(Node, + fun () -> + receive after 1000 -> ok end, + processes_term_proc_list_test(false), + Tester ! {it_worked, self()} + end), + ?line receive {it_worked, RT} -> ok end, + ?line stop_node(Node), + ?line ok. + +-define(CHK_TERM_PROC_LIST(MC, XB), + chk_term_proc_list(?LINE, MC, XB)). + +chk_term_proc_list(Line, MustChk, ExpectBlks) -> + case {MustChk, instrument:memory_status(types)} of + {false, false} -> + not_enabled; + {_, MS} -> + {value, + {processes_term_proc_el, + DL}} = lists:keysearch(processes_term_proc_el, 1, MS), + case lists:keysearch(blocks, 1, DL) of + {value, {blocks, ExpectBlks, _, _}} -> + ok; + {value, {blocks, Blks, _, _}} -> + exit({line, Line, + mismatch, expected, ExpectBlks, actual, Blks}); + Unexpected -> + exit(Unexpected) + end + end, + ok. + +processes_term_proc_list_test(MustChk) -> + ?line Tester = self(), + ?line enable_internal_state(), + ?line PBInfo = erts_debug:get_internal_state(processes_bif_info), + ?line print_processes_bif_info(PBInfo), + ?line WantReds = PBInfo#processes_bif_info.min_start_reds + 10, + ?line #processes_bif_info{tab_chunks = Chunks, + tab_chunks_size = ChunksSize, + tab_indices_per_red = IndiciesPerRed + } = PBInfo, + ?line true = Chunks > 1, + ?line true = Chunks*ChunksSize >= IndiciesPerRed*WantReds, + ?line Processes = fun () -> + erts_debug:set_internal_state(reds_left, + WantReds), + processes() + end, + ?line Exit = fun (P) -> + unlink(P), + exit(P, bang), + wait_until( + fun () -> + not lists:member( + P, + erts_debug:get_internal_state( + processes)) + end) + end, + ?line SpawnSuspendProcessesProc + = fun () -> + erlang:system_flag(multi_scheduling, block), + P = spawn_link(fun () -> + Tester ! {suspend_me, self()}, + Tester ! {self(), + done, + hd(Processes())}, + receive after infinity -> ok end + end), + receive {suspend_me, P} -> ok end, + erlang:suspend_process(P), + erlang:system_flag(multi_scheduling, unblock), + [{status,suspended}, + {current_function,{erlang,processes_trap,2}}] + = process_info(P, [status, current_function]), + P + end, + ?line ResumeProcessesProc = fun (P) -> + erlang:resume_process(P), + receive {P, done, _} -> ok end + end, + ?line ?CHK_TERM_PROC_LIST(MustChk, 0), + ?line HangAround = fun () -> receive after infinity -> ok end end, + ?line HA1 = spawn_link(HangAround), + ?line HA2 = spawn_link(HangAround), + ?line HA3 = spawn_link(HangAround), + ?line S1 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 1), + ?line Exit(HA1), + ?line ?CHK_TERM_PROC_LIST(MustChk, 2), + ?line S2 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 3), + ?line S3 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 4), + ?line Exit(HA2), + ?line ?CHK_TERM_PROC_LIST(MustChk, 5), + ?line S4 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 6), + ?line Exit(HA3), + ?line ?CHK_TERM_PROC_LIST(MustChk, 7), + ?line ResumeProcessesProc(S1), + ?line ?CHK_TERM_PROC_LIST(MustChk, 5), + ?line ResumeProcessesProc(S3), + ?line ?CHK_TERM_PROC_LIST(MustChk, 4), + ?line ResumeProcessesProc(S4), + ?line ?CHK_TERM_PROC_LIST(MustChk, 3), + ?line ResumeProcessesProc(S2), + ?line ?CHK_TERM_PROC_LIST(MustChk, 0), + ?line Exit(S1), + ?line Exit(S2), + ?line Exit(S3), + ?line Exit(S4), + + + ?line HA4 = spawn_link(HangAround), + ?line HA5 = spawn_link(HangAround), + ?line HA6 = spawn_link(HangAround), + ?line S5 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 1), + ?line Exit(HA4), + ?line ?CHK_TERM_PROC_LIST(MustChk, 2), + ?line S6 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 3), + ?line Exit(HA5), + ?line ?CHK_TERM_PROC_LIST(MustChk, 4), + ?line S7 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 5), + ?line Exit(HA6), + ?line ?CHK_TERM_PROC_LIST(MustChk, 6), + ?line S8 = SpawnSuspendProcessesProc(), + ?line ?CHK_TERM_PROC_LIST(MustChk, 7), + + ?line erlang:system_flag(multi_scheduling, block), + ?line Exit(S8), + ?line ?CHK_TERM_PROC_LIST(MustChk, 7), + ?line Exit(S5), + ?line ?CHK_TERM_PROC_LIST(MustChk, 6), + ?line Exit(S7), + ?line ?CHK_TERM_PROC_LIST(MustChk, 6), + ?line Exit(S6), + ?line ?CHK_TERM_PROC_LIST(MustChk, 0), + ?line erlang:system_flag(multi_scheduling, unblock), + ?line as_expected. + +otp_7738(doc) -> + []; +otp_7738(suite) -> + [otp_7738_waiting, otp_7738_suspended, otp_7738_resume]. + +otp_7738_waiting(doc) -> + []; +otp_7738_waiting(suite) -> + []; +otp_7738_waiting(Config) when is_list(Config) -> + ?line otp_7738_test(waiting). + +otp_7738_suspended(doc) -> + []; +otp_7738_suspended(suite) -> + []; +otp_7738_suspended(Config) when is_list(Config) -> + ?line otp_7738_test(suspended). + +otp_7738_resume(doc) -> + []; +otp_7738_resume(suite) -> + []; +otp_7738_resume(Config) when is_list(Config) -> + ?line otp_7738_test(resume). + +otp_7738_test(Type) -> + ?line T = self(), + ?line S = spawn_link(fun () -> + receive + {suspend, Suspendee} -> + erlang:suspend_process(Suspendee), + T ! {suspended, Suspendee}, + receive + after 10 -> + erlang:resume_process(Suspendee), + Suspendee ! wake_up + end; + {send, To, Msg} -> + receive after 10 -> ok end, + To ! Msg + end + end), + ?line R = spawn_link(fun () -> + X = lists:seq(1, 20000000), + T ! {initialized, self()}, + ?line case Type of + _ when Type == suspended; + Type == waiting -> + receive _ -> ok end; + _ when Type == resume -> + Receive = fun (F) -> + receive + _ -> + ok + after 0 -> + F(F) + end + end, + Receive(Receive) + end, + T ! {woke_up, self()}, + id(X) + end), + ?line receive {initialized, R} -> ok end, + ?line receive after 10 -> ok end, + ?line case Type of + suspended -> + ?line erlang:suspend_process(R), + ?line S ! {send, R, wake_up}; + waiting -> + ?line S ! {send, R, wake_up}; + resume -> + ?line S ! {suspend, R}, + ?line receive {suspended, R} -> ok end + end, + ?line erlang:garbage_collect(R), + ?line case Type of + suspended -> + ?line erlang:resume_process(R); + _ -> + ?line ok + end, + ?line receive + {woke_up, R} -> + ?line ok + after 2000 -> + ?line I = process_info(R, [status, message_queue_len]), + ?line ?t:format("~p~n", [I]), + ?line ?t:fail(no_progress) + end, + ?line ok. + +%% Internal functions + +wait_until(Fun) -> + case Fun() of + true -> true; + false -> receive after 10 -> wait_until(Fun) end + end. + +tok_loop() -> + tok_loop(hej). + +tok_loop(hej) -> + tok_loop(hopp); +tok_loop(hopp) -> + tok_loop(hej). + +id(I) -> I. + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) when is_list(Config) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {A, B, C} = now(), + ?line Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)), + ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + +stop_node(Node) -> + ?t:stop_node(Node). + +enable_internal_state() -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end. diff --git a/erts/emulator/test/pseudoknot_SUITE.erl b/erts/emulator/test/pseudoknot_SUITE.erl new file mode 100644 index 0000000000..907204cf93 --- /dev/null +++ b/erts/emulator/test/pseudoknot_SUITE.erl @@ -0,0 +1,3326 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(pseudoknot_SUITE). + +-export([all/1,test/1]). + +all(suite) -> [test]. + +test(Config) when is_list(Config) -> + statistics(runtime), + R = loop(1,0), + {_,Time} = statistics(runtime), + io:format("\nruntime = ~p msecs\nresult = ~p\n", [Time,R]), + true = abs(R-33.7976) < 0.0001, + {comment,lists:flatten(io_lib:format("Time: ~w", [Time]))}. + +append([H|T], Z) -> + [H|append(T, Z)]; +append([], X) -> + X. + +atan2(Y,X) when X>0.0 -> + math:atan(Y/X); +atan2(Y,X) when Y<0.0 -> + if + X == 0.0 -> -1.57079632679489661923; + true -> math:atan(Y/X) - 3.14159265358979323846 + end; +atan2(Y,X) -> + if + X == 0.0 -> 1.57079632679489661923; + true -> math:atan(Y/X) + 3.14159265358979323846 + end. + +% -- POINTS ------------------------------------------------------------------ + +%pt ::= {X, Y, Z} where X,Y,Z are floats + +pt_sub({X1, Y1, Z1}, {X2, Y2, Z2}) + when is_float(X1), is_float(Y1), is_float(Z1), + is_float(X2), is_float(Y2), is_float(Z2) -> + {X1 - X2, Y1 - Y2, Z1 - Z2}. + +pt_dist({X1, Y1, Z1}, {X2, Y2, Z2}) + when is_float(X1), is_float(Y1), is_float(Z1), + is_float(X2), is_float(Y2), is_float(Z2) -> + Dx = X1 - X2, + Dy = Y1 - Y2, + Dz = Z1 - Z2, + math:sqrt(Dx * Dx + Dy * Dy + Dz * Dz). + +pt_phi({X, Y, Z}) + when is_float(X), is_float(Z) -> + B = atan2(X, Z), + atan2(math:cos(B) * Z + math:sin(B) * X, Y). + +pt_theta ({X, _, Z}) -> + atan2(X, Z). + +% -- COORDINATE TRANSFORMATIONS ---------------------------------------------- + +% The notation for the transformations follows "Paul, R.P. (1981) Robot +% Manipulators. MIT Press." with the exception that our transformation +% matrices don't have the perspective terms and are the transpose of +% Paul's one. See also "M\"antyl\"a, M. (1985) An Introduction to +% Solid Modeling, Computer Science Press" Appendix A. +% +% The components of a transformation matrix are named like this: +% +% a b c +% d e f +% g h i +% tx ty tz +% +% The components tx, ty, and tz are the translation vector. + +%tfo ::= {A,B,C,D,E,F,G,H,I,Tx,Ty,Tz} where all elements are floats + +tfo_id() -> {1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0, 1.0, 0.0, 0.0, 0.0}. + +% The function "tfo-apply" multiplies a transformation matrix, tfo, by a +% point vector, p. The result is a new point. + +tfo_apply ({A,B,C,D,E,F,G,H,I,Tx,Ty,Tz}, {X,Y,Z}) + when is_float(A), is_float(B), is_float(C), is_float(D), is_float(E), + is_float(F), is_float(G), is_float(H), is_float(I), + is_float(Tx), is_float(Ty), is_float(Tz), is_float(X), is_float(Y), is_float(Z) -> + {X * A + Y * D + Z * G + Tx, + X * B + Y * E + Z * H + Ty, + X * C + Y * F + Z * I + Tz}. + +% The function "tfo-combine" multiplies two transformation matrices A and B. +% The result is a new matrix which cumulates the transformations described +% by A and B. + +tfo_combine({A_a,A_b,A_c,A_d,A_e,A_f,A_g,A_h,A_i,A_tx,A_ty,A_tz}, + {B_a,B_b,B_c,B_d,B_e,B_f,B_g,B_h,B_i,B_tx,B_ty,B_tz}) + when is_float(A_a), is_float(A_b), is_float(A_c), is_float(A_d), is_float(A_e), + is_float(A_f), is_float(A_g), is_float(A_h), is_float(A_i), is_float(A_tx), + is_float(A_ty), is_float(A_tz), + is_float(B_a), is_float(B_b), is_float(B_c), is_float(B_d), is_float(B_e), + is_float(B_f), is_float(B_g), is_float(B_h), is_float(B_i), is_float(B_tx), + is_float(B_ty), is_float(B_tz) -> + {A_a * B_a + A_b * B_d + A_c * B_g, + A_a * B_b + A_b * B_e + A_c * B_h, + A_a * B_c + A_b * B_f + A_c * B_i, + A_d * B_a + A_e * B_d + A_f * B_g, + A_d * B_b + A_e * B_e + A_f * B_h, + A_d * B_c + A_e * B_f + A_f * B_i, + A_g * B_a + A_h * B_d + A_i * B_g, + A_g * B_b + A_h * B_e + A_i * B_h, + A_g * B_c + A_h * B_f + A_i * B_i, + A_tx * B_a + A_ty * B_d + A_tz * B_g + B_tx, + A_tx * B_b + A_ty * B_e + A_tz * B_h + B_ty, + A_tx * B_c + A_ty * B_f + A_tz * B_i + B_tz}. + +% The function "tfo-inv-ortho" computes the inverse of a homogeneous +% transformation matrix. + +tfo_inv_ortho({A,B,C,D,E,F,G,H,I,Tx,Ty,Tz}) + when is_float(A), is_float(B), is_float(C), is_float(D), is_float(E), is_float(F), + is_float(G), is_float(H), is_float(I), is_float(Tx), is_float(Ty), is_float(Tz) -> + {A,D,G, + B,E,H, + C,F,I, + -(A * Tx + B * Ty + C * Tz), + -(D * Tx + E * Ty + F * Tz), + -(G * Tx + H * Ty + I * Tz)}. + +% Given three points p1, p2, and p3, the function "tfo-align" computes +% a transformation matrix such that point p1 gets mapped to (0,0,0), p2 gets +% mapped to the Y axis and p3 gets mapped to the YZ plane. + +tfo_align({X1,Y1,Z1},{X2,Y2,Z2},{X3,Y3,Z3}) + when is_float(X1), is_float(Y1), is_float(Z1), + is_float(X2), is_float(Y2), is_float(Z2), + is_float(X3), is_float(Y3), is_float(Z3) -> + X31 = X3 - X1, + Y31 = Y3 - Y1, + Z31 = Z3 - Z1, + Rotpy = pt_sub({X2,Y2,Z2},{X1,Y1,Z1}), + Phi = pt_phi(Rotpy), + Theta = pt_theta(Rotpy), + Sinp = math:sin(Phi), + Sint = math:sin(Theta), + Cosp = math:cos(Phi), + Cost = math:cos(Theta), + Sinpsint = Sinp * Sint, + Sinpcost = Sinp * Cost, + Cospsint = Cosp * Sint, + Cospcost = Cosp * Cost, + Rotpz = {Cost * X31 - Sint * Z31, + Sinpsint * X31 + Cosp * Y31 + Sinpcost * Z31, + Cospsint * X31 - Sinp * Y31 + Cospcost * Z31}, + Rho = pt_theta(Rotpz), + Cosr = math:cos(Rho), + Sinr = math:sin(Rho), + X = Z1 * Sint - X1 * Cost, + Y = -X1 * Sinpsint - Y1 * Cosp - Z1 * Sinpcost, + Z = Y1 * Sinp - Z1 * Cospcost - X1 * Cospsint, + {Cost * Cosr - Cospsint * Sinr, + Sinpsint, + Cost * Sinr + Cospsint * Cosr, + Sinp * Sinr, + Cosp, + -Sinp * Cosr, + -Sint * Cosr - Cospcost * Sinr, + Sinpcost, + Cospcost * Cosr - Sint * Sinr, + X * Cosr - Z * Sinr, + Y, + X * Sinr + Z * Cosr}. + +% -- NUCLEIC ACID CONFORMATIONS DATA BASE ------------------------------------ + +% Numbering of atoms follows the paper: +% +% IUPAC-IUB Joint Commission on Biochemical Nomenclature (JCBN) +% (1983) Abbreviations and Symbols for the Description of +% Conformations of Polynucleotide Chains. Eur. J. Biochem 131, +% 9-15. + +% Define part common to all 4 nucleotide types. + +%nuc ::= { +% tfo,tfo,tfo,tfo, +% pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt, +% pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt, +% A/C/G/U, +% nuc_specific +% } + +% dgf_base_tfo ; defines the standard position for wc and wc_dumas +% p_o3'_275_tfo ; defines the standard position for the connect function +% p_o3'_180_tfo +% p_o3'_60_tfo +% p o1p o2p o5' c5' h5' h5'' c4' h4' o4' c1' h1' c2' h2'' o2' h2' c3' +% h3' o3' n1 n3 c2 c4 c5 c6 + +type({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,X, + _}) -> X. + +nuc_C1_({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,X,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _}) -> X. + +nuc_C2({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,X,_,_,_,_, + _}) -> X. + +nuc_C3_({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + X,_,_,_,_,_,_,_,_,_, + _}) -> X. + +nuc_C4({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,X,_,_,_, + _}) -> X. + +nuc_C4_({_,_,_,_,_,_,_,_,_,_, + _,X,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _}) -> X. + +nuc_N1({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,X,_,_,_,_,_,_, + _}) -> X. + +nuc_O3_({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,X,_,_,_,_,_,_,_, + _}) -> X. + +nuc_P({_,_,_,_,X,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _}) -> X. + +nuc_dgf_base_tfo({X,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _}) -> X. + +nuc_p_o3__180_tfo({_,_,X,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _}) -> X. + +nuc_p_o3__275_tfo({_,X,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _}) -> X. + +nuc_p_o3__60_tfo({_,_,_,X,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _}) -> X. + +rA_N9({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,a, + {_,_,X,_,_,_,_,_}}) -> X. + +rG_N9({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,g, + {_,_,X,_,_,_,_,_,_}}) -> X. + + +%nuc ::= { +% tfo,tfo,tfo,tfo, +% pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt, +% pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt,pt, +% A/C/G/U, +% nuc_specific +% } + +% Define remaining atoms for each nucleotide type. + +%nuc_specific +% a {N6,N7,N9,C8,H2,H61,H62,H8} +% c {N4,O2,H41,H42,H5,H6} +% g {N2,N7,N9,C8,O6,H1,H21,H22,H8} +% u {O2,O4,H3,H5,H6} + +% Database of nucleotide conformations: + +rA() -> + { + {-0.0018, -0.8207, 0.5714, % dgf_base_tfo + 0.2679, -0.5509, -0.7904, + 0.9634, 0.1517, 0.2209, + 0.0073, 8.4030, 0.6232}, + {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo + -0.0433, -0.4257, 0.9038, + -0.5788, 0.7480, 0.3246, + 1.5227, 6.9114, -7.0765}, + {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo + 0.4552, 0.6637, 0.5935, + -0.8042, 0.0203, 0.5941, + -6.9472, -4.1186, -5.9108}, + {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo + -0.8247, 0.5587, -0.0878, + 0.0426, 0.2162, 0.9754, + 6.2694, -7.0540, 3.3316}, + {2.8930, 8.5380, -3.3280}, % P + {1.6980, 7.6960, -3.5570}, % O1P + {3.2260, 9.5010, -4.4020}, % O2P + {4.1590, 7.6040, -3.0340}, % O5' + {5.4550, 8.2120, -2.8810}, % C5' + {5.4546, 8.8508, -1.9978}, % H5' + {5.7588, 8.6625, -3.8259}, % H5'' + {6.4970, 7.1480, -2.5980}, % C4' + {7.4896, 7.5919, -2.5214}, % H4' + {6.1630, 6.4860, -1.3440}, % O4' + {6.5400, 5.1200, -1.4190}, % C1' + {7.2763, 4.9681, -0.6297}, % H1' + {7.1940, 4.8830, -2.7770}, % C2' + {6.8667, 3.9183, -3.1647}, % H2'' + {8.5860, 5.0910, -2.6140}, % O2' + {8.9510, 4.7626, -1.7890}, % H2' + {6.5720, 6.0040, -3.6090}, % C3' + {5.5636, 5.7066, -3.8966}, % H3' + {7.3801, 6.3562, -4.7350}, % O3' + {4.7150, 0.4910, -0.1360}, % N1 + {6.3490, 2.1730, -0.6020}, % N3 + {5.9530, 0.9650, -0.2670}, % C2 + {5.2900, 2.9790, -0.8260}, % C4 + {3.9720, 2.6390, -0.7330}, % C5 + {3.6770, 1.3160, -0.3660}, % C6 + a, { + {2.4280, 0.8450, -0.2360}, % N6 + {3.1660, 3.7290, -1.0360}, % N7 + {5.3170, 4.2990, -1.1930}, % N9 + {4.0100, 4.6780, -1.2990}, % C8 + {6.6890, 0.1903, -0.0518}, % H2 + {1.6470, 1.4460, -0.4040}, % H61 + {2.2780, -0.1080, -0.0280}, % H62 + {3.4421, 5.5744, -1.5482}} % H8 + }. + +rA01() -> + { + {-0.0043, -0.8175, 0.5759, % dgf_base_tfo + 0.2617, -0.5567, -0.7884, + 0.9651, 0.1473, 0.2164, + 0.0359, 8.3929, 0.5532}, + {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo + -0.0433, -0.4257, 0.9038, + -0.5788, 0.7480, 0.3246, + 1.5227, 6.9114, -7.0765}, + {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo + 0.4552, 0.6637, 0.5935, + -0.8042, 0.0203, 0.5941, + -6.9472, -4.1186, -5.9108}, + {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo + -0.8247, 0.5587, -0.0878, + 0.0426, 0.2162, 0.9754, + 6.2694, -7.0540, 3.3316}, + {2.8930, 8.5380, -3.3280}, % P + {1.6980, 7.6960, -3.5570}, % O1P + {3.2260, 9.5010, -4.4020}, % O2P + {4.1590, 7.6040, -3.0340}, % O5' + {5.4352, 8.2183, -2.7757}, % C5' + {5.3830, 8.7883, -1.8481}, % H5' + {5.7729, 8.7436, -3.6691}, % H5'' + {6.4830, 7.1518, -2.5252}, % C4' + {7.4749, 7.5972, -2.4482}, % H4' + {6.1626, 6.4620, -1.2827}, % O4' + {6.5431, 5.0992, -1.3905}, % C1' + {7.2871, 4.9328, -0.6114}, % H1' + {7.1852, 4.8935, -2.7592}, % C2' + {6.8573, 3.9363, -3.1645}, % H2'' + {8.5780, 5.1025, -2.6046}, % O2' + {8.9516, 4.7577, -1.7902}, % H2' + {6.5522, 6.0300, -3.5612}, % C3' + {5.5420, 5.7356, -3.8459}, % H3' + {7.3487, 6.4089, -4.6867}, % O3' + {4.7442, 0.4514, -0.1390}, % N1 + {6.3687, 2.1459, -0.5926}, % N3 + {5.9795, 0.9335, -0.2657}, % C2 + {5.3052, 2.9471, -0.8125}, % C4 + {3.9891, 2.5987, -0.7230}, % C5 + {3.7016, 1.2717, -0.3647}, % C6 + a, { + {2.4553, 0.7925, -0.2390}, % N6 + {3.1770, 3.6859, -1.0198}, % N7 + {5.3247, 4.2695, -1.1710}, % N9 + {4.0156, 4.6415, -1.2759}, % C8 + {6.7198, 0.1618, -0.0547}, % H2 + {1.6709, 1.3900, -0.4039}, % H61 + {2.3107, -0.1627, -0.0373}, % H62 + {3.4426, 5.5361, -1.5199}} % H8 + }. + +rA02() -> + { + {0.5566, 0.0449, 0.8296, % dgf_base_tfo + 0.5125, 0.7673, -0.3854, + -0.6538, 0.6397, 0.4041, + -9.1161, -3.7679, -2.9968}, + {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo + -0.0433, -0.4257, 0.9038, + -0.5788, 0.7480, 0.3246, + 1.5227, 6.9114, -7.0765}, + {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo + 0.4552, 0.6637, 0.5935, + -0.8042, 0.0203, 0.5941, + -6.9472, -4.1186, -5.9108}, + {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo + -0.8247, 0.5587, -0.0878, + 0.0426, 0.2162, 0.9754, + 6.2694, -7.0540, 3.3316}, + {2.8930, 8.5380, -3.3280}, % P + {1.6980, 7.6960, -3.5570}, % O1P + {3.2260, 9.5010, -4.4020}, % O2P + {4.1590, 7.6040, -3.0340}, % O5' + {4.5778, 6.6594, -4.0364}, % C5' + {4.9220, 7.1963, -4.9204}, % H5' + {3.7996, 5.9091, -4.1764}, % H5'' + {5.7873, 5.8869, -3.5482}, % C4' + {6.0405, 5.0875, -4.2446}, % H4' + {6.9135, 6.8036, -3.4310}, % O4' + {7.7293, 6.4084, -2.3392}, % C1' + {8.7078, 6.1815, -2.7624}, % H1' + {7.1305, 5.1418, -1.7347}, % C2' + {7.2040, 5.1982, -0.6486}, % H2'' + {7.7417, 4.0392, -2.3813}, % O2' + {8.6785, 4.1443, -2.5630}, % H2' + {5.6666, 5.2728, -2.1536}, % C3' + {5.1747, 5.9805, -1.4863}, % H3' + {4.9997, 4.0086, -2.1973}, % O3' + {10.3245, 8.5459, 1.5467}, % N1 + {9.8051, 6.9432, -0.1497}, % N3 + {10.5175, 7.4328, 0.8408}, % C2 + {8.7523, 7.7422, -0.4228}, % C4 + {8.4257, 8.9060, 0.2099}, % C5 + {9.2665, 9.3242, 1.2540}, % C6 + a, { + {9.0664, 10.4462, 1.9610}, % N6 + {7.2750, 9.4537, -0.3428}, % N7 + {7.7962, 7.5519, -1.3859}, % N9 + {6.9479, 8.6157, -1.2771}, % C8 + {11.4063, 6.9047, 1.1859}, % H2 + {8.2845, 11.0341, 1.7552}, % H61 + {9.6584, 10.6647, 2.7198}, % H62 + {6.0430, 8.9853, -1.7594}} % H8 + }. + +rA03() -> + { + {-0.5021, 0.0731, 0.8617, % dgf_base_tfo + -0.8112, 0.3054, -0.4986, + -0.2996, -0.9494, -0.0940, + 6.4273, -5.1944, -3.7807}, + {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo + -0.0433, -0.4257, 0.9038, + -0.5788, 0.7480, 0.3246, + 1.5227, 6.9114, -7.0765}, + {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo + 0.4552, 0.6637, 0.5935, + -0.8042, 0.0203, 0.5941, + -6.9472, -4.1186, -5.9108}, + {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo + -0.8247, 0.5587, -0.0878, + 0.0426, 0.2162, 0.9754, + 6.2694, -7.0540, 3.3316}, + {2.8930, 8.5380, -3.3280}, % P + {1.6980, 7.6960, -3.5570}, % O1P + {3.2260, 9.5010, -4.4020}, % O2P + {4.1590, 7.6040, -3.0340}, % O5' + {4.1214, 6.7116, -1.9049}, % C5' + {3.3465, 5.9610, -2.0607}, % H5' + {4.0789, 7.2928, -0.9837}, % H5'' + {5.4170, 5.9293, -1.8186}, % C4' + {5.4506, 5.3400, -0.9023}, % H4' + {5.5067, 5.0417, -2.9703}, % O4' + {6.8650, 4.9152, -3.3612}, % C1' + {7.1090, 3.8577, -3.2603}, % H1' + {7.7152, 5.7282, -2.3894}, % C2' + {8.5029, 6.2356, -2.9463}, % H2'' + {8.1036, 4.8568, -1.3419}, % O2' + {8.3270, 3.9651, -1.6184}, % H2' + {6.7003, 6.7565, -1.8911}, % C3' + {6.5898, 7.5329, -2.6482}, % H3' + {7.0505, 7.2878, -0.6105}, % O3' + {9.6740, 4.7656, -7.6614}, % N1 + {9.0739, 4.3013, -5.3941}, % N3 + {9.8416, 4.2192, -6.4581}, % C2 + {7.9885, 5.0632, -5.6446}, % C4 + {7.6822, 5.6856, -6.8194}, % C5 + {8.5831, 5.5215, -7.8840}, % C6 + a, { + {8.4084, 6.0747, -9.0933}, % N6 + {6.4857, 6.3816, -6.7035}, % N7 + {6.9740, 5.3703, -4.7760}, % N9 + {6.1133, 6.1613, -5.4808}, % C8 + {10.7627, 3.6375, -6.4220}, % H2 + {7.6031, 6.6390, -9.2733}, % H61 + {9.1004, 5.9708, -9.7893}, % H62 + {5.1705, 6.6830, -5.3167}} % H8 + }. + +rA04() -> + { + {-0.5426, -0.8175, 0.1929, % dgf_base_tfo + 0.8304, -0.5567, -0.0237, + 0.1267, 0.1473, 0.9809, + -0.5075, 8.3929, 0.2229}, + {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo + -0.0433, -0.4257, 0.9038, + -0.5788, 0.7480, 0.3246, + 1.5227, 6.9114, -7.0765}, + {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo + 0.4552, 0.6637, 0.5935, + -0.8042, 0.0203, 0.5941, + -6.9472, -4.1186, -5.9108}, + {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo + -0.8247, 0.5587, -0.0878, + 0.0426, 0.2162, 0.9754, + 6.2694, -7.0540, 3.3316}, + {2.8930, 8.5380, -3.3280}, % P + {1.6980, 7.6960, -3.5570}, % O1P + {3.2260, 9.5010, -4.4020}, % O2P + {4.1590, 7.6040, -3.0340}, % O5' + {5.4352, 8.2183, -2.7757}, % C5' + {5.3830, 8.7883, -1.8481}, % H5' + {5.7729, 8.7436, -3.6691}, % H5'' + {6.4830, 7.1518, -2.5252}, % C4' + {7.4749, 7.5972, -2.4482}, % H4' + {6.1626, 6.4620, -1.2827}, % O4' + {6.5431, 5.0992, -1.3905}, % C1' + {7.2871, 4.9328, -0.6114}, % H1' + {7.1852, 4.8935, -2.7592}, % C2' + {6.8573, 3.9363, -3.1645}, % H2'' + {8.5780, 5.1025, -2.6046}, % O2' + {8.9516, 4.7577, -1.7902}, % H2' + {6.5522, 6.0300, -3.5612}, % C3' + {5.5420, 5.7356, -3.8459}, % H3' + {7.3487, 6.4089, -4.6867}, % O3' + {3.6343, 2.6680, 2.0783}, % N1 + {5.4505, 3.9805, 1.2446}, % N3 + {4.7540, 3.3816, 2.1851}, % C2 + {4.8805, 3.7951, 0.0354}, % C4 + {3.7416, 3.0925, -0.2305}, % C5 + {3.0873, 2.4980, 0.8606}, % C6 + a, { + {1.9600, 1.7805, 0.7462}, % N6 + {3.4605, 3.1184, -1.5906}, % N7 + {5.3247, 4.2695, -1.1710}, % N9 + {4.4244, 3.8244, -2.0953}, % C8 + {5.0814, 3.4352, 3.2234}, % H2 + {1.5423, 1.6454, -0.1520}, % H61 + {1.5716, 1.3398, 1.5392}, % H62 + {4.2675, 3.8876, -3.1721}} % H8 + }. + +rA05() -> + { + {-0.5891, 0.0449, 0.8068, % dgf_base_tfo + 0.5375, 0.7673, 0.3498, + -0.6034, 0.6397, -0.4762, + -0.3019, -3.7679, -9.5913}, + {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo + -0.0433, -0.4257, 0.9038, + -0.5788, 0.7480, 0.3246, + 1.5227, 6.9114, -7.0765}, + {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo + 0.4552, 0.6637, 0.5935, + -0.8042, 0.0203, 0.5941, + -6.9472, -4.1186, -5.9108}, + {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo + -0.8247, 0.5587, -0.0878, + 0.0426, 0.2162, 0.9754, + 6.2694, -7.0540, 3.3316}, + {2.8930, 8.5380, -3.3280}, % P + {1.6980, 7.6960, -3.5570}, % O1P + {3.2260, 9.5010, -4.4020}, % O2P + {4.1590, 7.6040, -3.0340}, % O5' + {4.5778, 6.6594, -4.0364}, % C5' + {4.9220, 7.1963, -4.9204}, % H5' + {3.7996, 5.9091, -4.1764}, % H5'' + {5.7873, 5.8869, -3.5482}, % C4' + {6.0405, 5.0875, -4.2446}, % H4' + {6.9135, 6.8036, -3.4310}, % O4' + {7.7293, 6.4084, -2.3392}, % C1' + {8.7078, 6.1815, -2.7624}, % H1' + {7.1305, 5.1418, -1.7347}, % C2' + {7.2040, 5.1982, -0.6486}, % H2'' + {7.7417, 4.0392, -2.3813}, % O2' + {8.6785, 4.1443, -2.5630}, % H2' + {5.6666, 5.2728, -2.1536}, % C3' + {5.1747, 5.9805, -1.4863}, % H3' + {4.9997, 4.0086, -2.1973}, % O3' + {10.2594, 10.6774, -1.0056}, % N1 + {9.7528, 8.7080, -2.2631}, % N3 + {10.4471, 9.7876, -1.9791}, % C2 + {8.7271, 8.5575, -1.3991}, % C4 + {8.4100, 9.3803, -0.3580}, % C5 + {9.2294, 10.5030, -0.1574}, % C6 + a, { + {9.0349, 11.3951, 0.8250}, % N6 + {7.2891, 8.9068, 0.3121}, % N7 + {7.7962, 7.5519, -1.3859}, % N9 + {6.9702, 7.8292, -0.3353}, % C8 + {11.3132, 10.0537, -2.5851}, % H2 + {8.2741, 11.2784, 1.4629}, % H61 + {9.6733, 12.1368, 0.9529}, % H62 + {6.0888, 7.3990, 0.1403}} % H8 + }. + +rA06() -> + { + {-0.9815, 0.0731, -0.1772, % dgf_base_tfo + 0.1912, 0.3054, -0.9328, + -0.0141, -0.9494, -0.3137, + 5.7506, -5.1944, 4.7470}, + {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo + -0.0433, -0.4257, 0.9038, + -0.5788, 0.7480, 0.3246, + 1.5227, 6.9114, -7.0765}, + {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo + 0.4552, 0.6637, 0.5935, + -0.8042, 0.0203, 0.5941, + -6.9472, -4.1186, -5.9108}, + {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo + -0.8247, 0.5587, -0.0878, + 0.0426, 0.2162, 0.9754, + 6.2694, -7.0540, 3.3316}, + {2.8930, 8.5380, -3.3280}, % P + {1.6980, 7.6960, -3.5570}, % O1P + {3.2260, 9.5010, -4.4020}, % O2P + {4.1590, 7.6040, -3.0340}, % O5' + {4.1214, 6.7116, -1.9049}, % C5' + {3.3465, 5.9610, -2.0607}, % H5' + {4.0789, 7.2928, -0.9837}, % H5'' + {5.4170, 5.9293, -1.8186}, % C4' + {5.4506, 5.3400, -0.9023}, % H4' + {5.5067, 5.0417, -2.9703}, % O4' + {6.8650, 4.9152, -3.3612}, % C1' + {7.1090, 3.8577, -3.2603}, % H1' + {7.7152, 5.7282, -2.3894}, % C2' + {8.5029, 6.2356, -2.9463}, % H2'' + {8.1036, 4.8568, -1.3419}, % O2' + {8.3270, 3.9651, -1.6184}, % H2' + {6.7003, 6.7565, -1.8911}, % C3' + {6.5898, 7.5329, -2.6482}, % H3' + {7.0505, 7.2878, -0.6105}, % O3' + {6.6624, 3.5061, -8.2986}, % N1 + {6.5810, 3.2570, -5.9221}, % N3 + {6.5151, 2.8263, -7.1625}, % C2 + {6.8364, 4.5817, -5.8882}, % C4 + {7.0116, 5.4064, -6.9609}, % C5 + {6.9173, 4.8260, -8.2361}, % C6 + a, { + {7.0668, 5.5163, -9.3763}, % N6 + {7.2573, 6.7070, -6.5394}, % N7 + {6.9740, 5.3703, -4.7760}, % N9 + {7.2238, 6.6275, -5.2453}, % C8 + {6.3146, 1.7741, -7.3641}, % H2 + {7.2568, 6.4972, -9.3456}, % H61 + {7.0437, 5.0478, -10.2446}, % H62 + {7.4108, 7.6227, -4.8418}} % H8 + }. + +rA07() -> + { + {0.2379, 0.1310, -0.9624, % dgf_base_tfo + -0.5876, -0.7696, -0.2499, + -0.7734, 0.6249, -0.1061, + 30.9870, -26.9344, 42.6416}, + {0.7529, 0.1548, 0.6397, % p_o3'_275_tfo + 0.2952, -0.9481, -0.1180, + 0.5882, 0.2777, -0.7595, + -58.8919, -11.3095, 6.0866}, + {-0.0239, 0.9667, -0.2546, % p_o3'_180_tfo + 0.9731, -0.0359, -0.2275, + -0.2290, -0.2532, -0.9399, + 3.5401, -29.7913, 52.2796}, + {-0.8912, -0.4531, 0.0242, % p_o3'_60_tfo + -0.1183, 0.1805, -0.9764, + 0.4380, -0.8730, -0.2145, + 19.9023, 54.8054, 15.2799}, + {41.8210, 8.3880, 43.5890}, % P + {42.5400, 8.0450, 44.8330}, % O1P + {42.2470, 9.6920, 42.9910}, % O2P + {40.2550, 8.2030, 43.7340}, % O5' + {39.3505, 8.4697, 42.6565}, % C5' + {39.1377, 7.5433, 42.1230}, % H5' + {39.7203, 9.3119, 42.0717}, % H5'' + {38.0405, 8.9195, 43.2869}, % C4' + {37.3687, 9.3036, 42.5193}, % H4' + {37.4319, 7.8146, 43.9387}, % O4' + {37.1959, 8.1354, 45.3237}, % C1' + {36.1788, 8.5202, 45.3970}, % H1' + {38.1721, 9.2328, 45.6504}, % C2' + {39.1555, 8.7939, 45.8188}, % H2'' + {37.7862, 10.0617, 46.7013}, % O2' + {37.3087, 9.6229, 47.4092}, % H2' + {38.1844, 10.0268, 44.3367}, % C3' + {39.1578, 10.5054, 44.2289}, % H3' + {37.0547, 10.9127, 44.3441}, % O3' + {34.8811, 4.2072, 47.5784}, % N1 + {35.1084, 6.1336, 46.1818}, % N3 + {34.4108, 5.1360, 46.7207}, % C2 + {36.3908, 6.1224, 46.6053}, % C4 + {36.9819, 5.2334, 47.4697}, % C5 + {36.1786, 4.1985, 48.0035}, % C6 + a, { + {36.6103, 3.2749, 48.8452}, % N6 + {38.3236, 5.5522, 47.6595}, % N7 + {37.3887, 7.0024, 46.2437}, % N9 + {38.5055, 6.6096, 46.9057}, % C8 + {33.3553, 5.0152, 46.4771}, % H2 + {37.5730, 3.2804, 49.1507}, % H61 + {35.9775, 2.5638, 49.1828}, % H62 + {39.5461, 6.9184, 47.0041}} % H8 + }. + +rA08() -> + { + {0.1084, -0.0895, -0.9901, % dgf_base_tfo + 0.9789, -0.1638, 0.1220, + -0.1731, -0.9824, 0.0698, + -2.9039, 47.2655, 33.0094}, + {0.7529, 0.1548, 0.6397, % p_o3'_275_tfo + 0.2952, -0.9481, -0.1180, + 0.5882, 0.2777, -0.7595, + -58.8919, -11.3095, 6.0866}, + {-0.0239, 0.9667, -0.2546, % p_o3'_180_tfo + 0.9731, -0.0359, -0.2275, + -0.2290, -0.2532, -0.9399, + 3.5401, -29.7913, 52.2796}, + {-0.8912, -0.4531, 0.0242, % p_o3'_60_tfo + -0.1183, 0.1805, -0.9764, + 0.4380, -0.8730, -0.2145, + 19.9023, 54.8054, 15.2799}, + {41.8210, 8.3880, 43.5890}, % P + {42.5400, 8.0450, 44.8330}, % O1P + {42.2470, 9.6920, 42.9910}, % O2P + {40.2550, 8.2030, 43.7340}, % O5' + {39.4850, 8.9301, 44.6977}, % C5' + {39.0638, 9.8199, 44.2296}, % H5' + {40.0757, 9.0713, 45.6029}, % H5'' + {38.3102, 8.0414, 45.0789}, % C4' + {37.7842, 8.4637, 45.9351}, % H4' + {37.4200, 7.9453, 43.9769}, % O4' + {37.2249, 6.5609, 43.6273}, % C1' + {36.3360, 6.2168, 44.1561}, % H1' + {38.4347, 5.8414, 44.1590}, % C2' + {39.2688, 5.9974, 43.4749}, % H2'' + {38.2344, 4.4907, 44.4348}, % O2' + {37.6374, 4.0386, 43.8341}, % H2' + {38.6926, 6.6079, 45.4637}, % C3' + {39.7585, 6.5640, 45.6877}, % H3' + {37.8238, 6.0705, 46.4723}, % O3' + {33.9162, 6.2598, 39.7758}, % N1 + {34.6709, 6.5759, 42.0215}, % N3 + {33.7257, 6.5186, 41.0858}, % C2 + {35.8935, 6.3324, 41.5018}, % C4 + {36.2105, 6.0601, 40.1932}, % C5 + {35.1538, 6.0151, 39.2537}, % C6 + a, { + {35.3088, 5.7642, 37.9649}, % N6 + {37.5818, 5.8677, 40.0507}, % N7 + {37.0932, 6.3197, 42.1810}, % N9 + {38.0509, 6.0354, 41.2635}, % C8 + {32.6830, 6.6898, 41.3532}, % H2 + {36.2305, 5.5855, 37.5925}, % H61 + {34.5056, 5.7512, 37.3528}, % H62 + {39.1318, 5.8993, 41.2285}} % H8 + }. + +rA09() -> + { + {0.8467, 0.4166, -0.3311, % dgf_base_tfo + -0.3962, 0.9089, 0.1303, + 0.3552, 0.0209, 0.9346, + -42.7319, -26.6223, -29.8163}, + {0.7529, 0.1548, 0.6397, % p_o3'_275_tfo + 0.2952, -0.9481, -0.1180, + 0.5882, 0.2777, -0.7595, + -58.8919, -11.3095, 6.0866}, + {-0.0239, 0.9667, -0.2546, % p_o3'_180_tfo + 0.9731, -0.0359, -0.2275, + -0.2290, -0.2532, -0.9399, + 3.5401, -29.7913, 52.2796}, + {-0.8912, -0.4531, 0.0242, % p_o3'_60_tfo + -0.1183, 0.1805, -0.9764, + 0.4380, -0.8730, -0.2145, + 19.9023, 54.8054, 15.2799}, + {41.8210, 8.3880, 43.5890}, % P + {42.5400, 8.0450, 44.8330}, % O1P + {42.2470, 9.6920, 42.9910}, % O2P + {40.2550, 8.2030, 43.7340}, % O5' + {39.3505, 8.4697, 42.6565}, % C5' + {39.1377, 7.5433, 42.1230}, % H5' + {39.7203, 9.3119, 42.0717}, % H5'' + {38.0405, 8.9195, 43.2869}, % C4' + {37.6479, 8.1347, 43.9335}, % H4' + {38.2691, 10.0933, 44.0524}, % O4' + {37.3999, 11.1488, 43.5973}, % C1' + {36.5061, 11.1221, 44.2206}, % H1' + {37.0364, 10.7838, 42.1836}, % C2' + {37.8636, 11.0489, 41.5252}, % H2'' + {35.8275, 11.3133, 41.7379}, % O2' + {35.6214, 12.1896, 42.0714}, % H2' + {36.9316, 9.2556, 42.2837}, % C3' + {37.1778, 8.8260, 41.3127}, % H3' + {35.6285, 8.9334, 42.7926}, % O3' + {38.1482, 15.2833, 46.4641}, % N1 + {37.3641, 13.0968, 45.9007}, % N3 + {37.5032, 14.1288, 46.7300}, % C2 + {37.9570, 13.3377, 44.7113}, % C4 + {38.6397, 14.4660, 44.3267}, % C5 + {38.7473, 15.5229, 45.2609}, % C6 + a, { + {39.3720, 16.6649, 45.0297}, % N6 + {39.1079, 14.3351, 43.0223}, % N7 + {38.0132, 12.4868, 43.6280}, % N9 + {38.7058, 13.1402, 42.6620}, % C8 + {37.0731, 14.0857, 47.7306}, % H2 + {39.8113, 16.8281, 44.1350}, % H61 + {39.4100, 17.3741, 45.7478}, % H62 + {39.0412, 12.9660, 41.6397}} % H8 + }. + +rA10() -> + { + {0.7063, 0.6317, -0.3196, % dgf_base_tfo + -0.0403, -0.4149, -0.9090, + -0.7068, 0.6549, -0.2676, + 6.4402, -52.1496, 30.8246}, + {0.7529, 0.1548, 0.6397, % p_o3'_275_tfo + 0.2952, -0.9481, -0.1180, + 0.5882, 0.2777, -0.7595, + -58.8919, -11.3095, 6.0866}, + {-0.0239, 0.9667, -0.2546, % p_o3'_180_tfo + 0.9731, -0.0359, -0.2275, + -0.2290, -0.2532, -0.9399, + 3.5401, -29.7913, 52.2796}, + {-0.8912, -0.4531, 0.0242, % p_o3'_60_tfo + -0.1183, 0.1805, -0.9764, + 0.4380, -0.8730, -0.2145, + 19.9023, 54.8054, 15.2799}, + {41.8210, 8.3880, 43.5890}, % P + {42.5400, 8.0450, 44.8330}, % O1P + {42.2470, 9.6920, 42.9910}, % O2P + {40.2550, 8.2030, 43.7340}, % O5' + {39.4850, 8.9301, 44.6977}, % C5' + {39.0638, 9.8199, 44.2296}, % H5' + {40.0757, 9.0713, 45.6029}, % H5'' + {38.3102, 8.0414, 45.0789}, % C4' + {37.7099, 7.8166, 44.1973}, % H4' + {38.8012, 6.8321, 45.6380}, % O4' + {38.2431, 6.6413, 46.9529}, % C1' + {37.3505, 6.0262, 46.8385}, % H1' + {37.8484, 8.0156, 47.4214}, % C2' + {38.7381, 8.5406, 47.7690}, % H2'' + {36.8286, 8.0368, 48.3701}, % O2' + {36.8392, 7.3063, 48.9929}, % H2' + {37.3576, 8.6512, 46.1132}, % C3' + {37.5207, 9.7275, 46.1671}, % H3' + {35.9985, 8.2392, 45.9032}, % O3' + {39.9117, 2.2278, 48.8527}, % N1 + {38.6207, 3.6941, 47.4757}, % N3 + {38.9872, 2.4888, 47.9057}, % C2 + {39.2961, 4.6720, 48.1174}, % C4 + {40.2546, 4.5307, 49.0912}, % C5 + {40.5932, 3.2189, 49.4985}, % C6 + a, { + {41.4938, 2.9317, 50.4229}, % N6 + {40.7195, 5.7755, 49.5060}, % N7 + {39.1730, 6.0305, 47.9170}, % N9 + {40.0413, 6.6250, 48.7728}, % C8 + {38.5257, 1.5960, 47.4838}, % H2 + {41.9907, 3.6753, 50.8921}, % H61 + {41.6848, 1.9687, 50.6599}, % H62 + {40.3571, 7.6321, 49.0452}} % H8 + }. + +rAs() -> [rA01(),rA02(),rA03(),rA04(),rA05(),rA06(),rA07(), + rA08(),rA09(),rA10()]. + +rC() -> + { + {-0.0359, -0.8071, 0.5894, % dgf_base_tfo + -0.2669, 0.5761, 0.7726, + -0.9631, -0.1296, -0.2361, + 0.1584, 8.3434, 0.5434}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {5.2430, -8.2420, 2.8260}, % C5' + {5.1974, -8.8497, 1.9223}, % H5' + {5.5548, -8.7348, 3.7469}, % H5'' + {6.3140, -7.2060, 2.5510}, % C4' + {7.2954, -7.6762, 2.4898}, % H4' + {6.0140, -6.5420, 1.2890}, % O4' + {6.4190, -5.1840, 1.3620}, % C1' + {7.1608, -5.0495, 0.5747}, % H1' + {7.0760, -4.9560, 2.7270}, % C2' + {6.7770, -3.9803, 3.1099}, % H2'' + {8.4500, -5.1930, 2.5810}, % O2' + {8.8309, -4.8755, 1.7590}, % H2' + {6.4060, -6.0590, 3.5580}, % C3' + {5.4021, -5.7313, 3.8281}, % H3' + {7.1570, -6.4240, 4.7070}, % O3' + {5.2170, -4.3260, 1.1690}, % N1 + {4.2960, -2.2560, 0.6290}, % N3 + {5.4330, -3.0200, 0.7990}, % C2 + {2.9930, -2.6780, 0.7940}, % C4 + {2.8670, -4.0630, 1.1830}, % C5 + {3.9570, -4.8300, 1.3550}, % C6 + c, { + {2.0187, -1.8047, 0.5874}, % N4 + {6.5470, -2.5560, 0.6290}, % O2 + {1.0684, -2.1236, 0.7109}, % H41 + {2.2344, -0.8560, 0.3162}, % H42 + {1.8797, -4.4972, 1.3404}, % H5 + {3.8479, -5.8742, 1.6480}} % H6 + }. + +rC01() -> + { + {-0.0137, -0.8012, 0.5983, % dgf_base_tfo + -0.2523, 0.5817, 0.7733, + -0.9675, -0.1404, -0.2101, + 0.2031, 8.3874, 0.4228}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {5.2416, -8.2422, 2.8181}, % C5' + {5.2050, -8.8128, 1.8901}, % H5' + {5.5368, -8.7738, 3.7227}, % H5'' + {6.3232, -7.2037, 2.6002}, % C4' + {7.3048, -7.6757, 2.5577}, % H4' + {6.0635, -6.5092, 1.3456}, % O4' + {6.4697, -5.1547, 1.4629}, % C1' + {7.2354, -5.0043, 0.7018}, % H1' + {7.0856, -4.9610, 2.8521}, % C2' + {6.7777, -3.9935, 3.2487}, % H2'' + {8.4627, -5.1992, 2.7423}, % O2' + {8.8693, -4.8638, 1.9399}, % H2' + {6.3877, -6.0809, 3.6362}, % C3' + {5.3770, -5.7562, 3.8834}, % H3' + {7.1024, -6.4754, 4.7985}, % O3' + {5.2764, -4.2883, 1.2538}, % N1 + {4.3777, -2.2062, 0.7229}, % N3 + {5.5069, -2.9779, 0.9088}, % C2 + {3.0693, -2.6246, 0.8500}, % C4 + {2.9279, -4.0146, 1.2149}, % C5 + {4.0101, -4.7892, 1.4017}, % C6 + c, { + {2.1040, -1.7437, 0.6331}, % N4 + {6.6267, -2.5166, 0.7728}, % O2 + {1.1496, -2.0600, 0.7287}, % H41 + {2.3303, -0.7921, 0.3815}, % H42 + {1.9353, -4.4465, 1.3419}, % H5 + {3.8895, -5.8371, 1.6762}} % H6 + }. + +rC02() -> + { + {0.5141, 0.0246, 0.8574, % dgf_base_tfo + -0.5547, -0.7529, 0.3542, + 0.6542, -0.6577, -0.3734, + -9.1111, -3.4598, -3.2939}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {4.3825, -6.6585, 4.0489}, % C5' + {4.6841, -7.2019, 4.9443}, % H5' + {3.6189, -5.8889, 4.1625}, % H5'' + {5.6255, -5.9175, 3.5998}, % C4' + {5.8732, -5.1228, 4.3034}, % H4' + {6.7337, -6.8605, 3.5222}, % O4' + {7.5932, -6.4923, 2.4548}, % C1' + {8.5661, -6.2983, 2.9064}, % H1' + {7.0527, -5.2012, 1.8322}, % C2' + {7.1627, -5.2525, 0.7490}, % H2'' + {7.6666, -4.1249, 2.4880}, % O2' + {8.5944, -4.2543, 2.6981}, % H2' + {5.5661, -5.3029, 2.2009}, % C3' + {5.0841, -6.0018, 1.5172}, % H3' + {4.9062, -4.0452, 2.2042}, % O3' + {7.6298, -7.6136, 1.4752}, % N1 + {8.6945, -8.7046, -0.2857}, % N3 + {8.6943, -7.6514, 0.6066}, % C2 + {7.7426, -9.6987, -0.3801}, % C4 + {6.6642, -9.5742, 0.5722}, % C5 + {6.6391, -8.5592, 1.4526}, % C6 + c, { + {7.9033, -10.6371, -1.3010}, % N4 + {9.5840, -6.8186, 0.6136}, % O2 + {7.2009, -11.3604, -1.3619}, % H41 + {8.7058, -10.6168, -1.9140}, % H42 + {5.8585, -10.3083, 0.5822}, % H5 + {5.8197, -8.4773, 2.1667}} % H6 + }. + +rC03() -> + { + {-0.4993, 0.0476, 0.8651, % dgf_base_tfo + 0.8078, -0.3353, 0.4847, + 0.3132, 0.9409, 0.1290, + 6.2989, -5.2303, -3.8577}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {3.9938, -6.7042, 1.9023}, % C5' + {3.2332, -5.9343, 2.0319}, % H5' + {3.9666, -7.2863, 0.9812}, % H5'' + {5.3098, -5.9546, 1.8564}, % C4' + {5.3863, -5.3702, 0.9395}, % H4' + {5.3851, -5.0642, 3.0076}, % O4' + {6.7315, -4.9724, 3.4462}, % C1' + {7.0033, -3.9202, 3.3619}, % H1' + {7.5997, -5.8018, 2.4948}, % C2' + {8.3627, -6.3254, 3.0707}, % H2'' + {8.0410, -4.9501, 1.4724}, % O2' + {8.2781, -4.0644, 1.7570}, % H2' + {6.5701, -6.8129, 1.9714}, % C3' + {6.4186, -7.5809, 2.7299}, % H3' + {6.9357, -7.3841, 0.7235}, % O3' + {6.8024, -5.4718, 4.8475}, % N1 + {7.9218, -5.5700, 6.8877}, % N3 + {7.8908, -5.0886, 5.5944}, % C2 + {6.9789, -6.3827, 7.4823}, % C4 + {5.8742, -6.7319, 6.6202}, % C5 + {5.8182, -6.2769, 5.3570}, % C6 + c, { + {7.1702, -6.7511, 8.7402}, % N4 + {8.7747, -4.3728, 5.1568}, % O2 + {6.4741, -7.3461, 9.1662}, % H41 + {7.9889, -6.4396, 9.2429}, % H42 + {5.0736, -7.3713, 6.9922}, % H5 + {4.9784, -6.5473, 4.7170}} % H6 + }. + +rC04() -> + { + {-0.5669, -0.8012, 0.1918, % dgf_base_tfo + -0.8129, 0.5817, 0.0273, + -0.1334, -0.1404, -0.9811, + -0.3279, 8.3874, 0.3355}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {5.2416, -8.2422, 2.8181}, % C5' + {5.2050, -8.8128, 1.8901}, % H5' + {5.5368, -8.7738, 3.7227}, % H5'' + {6.3232, -7.2037, 2.6002}, % C4' + {7.3048, -7.6757, 2.5577}, % H4' + {6.0635, -6.5092, 1.3456}, % O4' + {6.4697, -5.1547, 1.4629}, % C1' + {7.2354, -5.0043, 0.7018}, % H1' + {7.0856, -4.9610, 2.8521}, % C2' + {6.7777, -3.9935, 3.2487}, % H2'' + {8.4627, -5.1992, 2.7423}, % O2' + {8.8693, -4.8638, 1.9399}, % H2' + {6.3877, -6.0809, 3.6362}, % C3' + {5.3770, -5.7562, 3.8834}, % H3' + {7.1024, -6.4754, 4.7985}, % O3' + {5.2764, -4.2883, 1.2538}, % N1 + {3.8961, -3.0896, -0.1893}, % N3 + {5.0095, -3.8907, -0.0346}, % C2 + {3.0480, -2.6632, 0.8116}, % C4 + {3.4093, -3.1310, 2.1292}, % C5 + {4.4878, -3.9124, 2.3088}, % C6 + c, { + {2.0216, -1.8941, 0.4804}, % N4 + {5.7005, -4.2164, -0.9842}, % O2 + {1.4067, -1.5873, 1.2205}, % H41 + {1.8721, -1.6319, -0.4835}, % H42 + {2.8048, -2.8507, 2.9918}, % H5 + {4.7491, -4.2593, 3.3085}} % H6 + }. + +rC05() -> + { + {-0.6298, 0.0246, 0.7763, % dgf_base_tfo + -0.5226, -0.7529, -0.4001, + 0.5746, -0.6577, 0.4870, + -0.0208, -3.4598, -9.6882}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {4.3825, -6.6585, 4.0489}, % C5' + {4.6841, -7.2019, 4.9443}, % H5' + {3.6189, -5.8889, 4.1625}, % H5'' + {5.6255, -5.9175, 3.5998}, % C4' + {5.8732, -5.1228, 4.3034}, % H4' + {6.7337, -6.8605, 3.5222}, % O4' + {7.5932, -6.4923, 2.4548}, % C1' + {8.5661, -6.2983, 2.9064}, % H1' + {7.0527, -5.2012, 1.8322}, % C2' + {7.1627, -5.2525, 0.7490}, % H2'' + {7.6666, -4.1249, 2.4880}, % O2' + {8.5944, -4.2543, 2.6981}, % H2' + {5.5661, -5.3029, 2.2009}, % C3' + {5.0841, -6.0018, 1.5172}, % H3' + {4.9062, -4.0452, 2.2042}, % O3' + {7.6298, -7.6136, 1.4752}, % N1 + {8.5977, -9.5977, 0.7329}, % N3 + {8.5951, -8.5745, 1.6594}, % C2 + {7.7372, -9.7371, -0.3364}, % C4 + {6.7596, -8.6801, -0.4476}, % C5 + {6.7338, -7.6721, 0.4408}, % C6 + c, { + {7.8849, -10.7881, -1.1289}, % N4 + {9.3993, -8.5377, 2.5743}, % O2 + {7.2499, -10.8809, -1.9088}, % H41 + {8.6122, -11.4649, -0.9468}, % H42 + {6.0317, -8.6941, -1.2588}, % H5 + {5.9901, -6.8809, 0.3459}} % H6 + }. + +rC06() -> + { + {-0.9837, 0.0476, -0.1733, % dgf_base_tfo + -0.1792, -0.3353, 0.9249, + -0.0141, 0.9409, 0.3384, + 5.7793, -5.2303, 4.5997}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {3.9938, -6.7042, 1.9023}, % C5' + {3.2332, -5.9343, 2.0319}, % H5' + {3.9666, -7.2863, 0.9812}, % H5'' + {5.3098, -5.9546, 1.8564}, % C4' + {5.3863, -5.3702, 0.9395}, % H4' + {5.3851, -5.0642, 3.0076}, % O4' + {6.7315, -4.9724, 3.4462}, % C1' + {7.0033, -3.9202, 3.3619}, % H1' + {7.5997, -5.8018, 2.4948}, % C2' + {8.3627, -6.3254, 3.0707}, % H2'' + {8.0410, -4.9501, 1.4724}, % O2' + {8.2781, -4.0644, 1.7570}, % H2' + {6.5701, -6.8129, 1.9714}, % C3' + {6.4186, -7.5809, 2.7299}, % H3' + {6.9357, -7.3841, 0.7235}, % O3' + {6.8024, -5.4718, 4.8475}, % N1 + {6.6920, -5.0495, 7.1354}, % N3 + {6.6201, -4.5500, 5.8506}, % C2 + {6.9254, -6.3614, 7.4926}, % C4 + {7.1046, -7.2543, 6.3718}, % C5 + {7.0391, -6.7951, 5.1106}, % C6 + c, { + {6.9614, -6.6648, 8.7815}, % N4 + {6.4083, -3.3696, 5.6340}, % O2 + {7.1329, -7.6280, 9.0324}, % H41 + {6.8204, -5.9469, 9.4777}, % H42 + {7.2954, -8.3135, 6.5440}, % H5 + {7.1753, -7.4798, 4.2735}} % H6 + }. + +rC07() -> + { + {0.0033, 0.2720, -0.9623, % dgf_base_tfo + 0.3013, -0.9179, -0.2584, + -0.9535, -0.2891, -0.0850, + 43.0403, 13.7233, 34.5710}, + {0.9187, 0.2887, 0.2694, % p_o3'_275_tfo + 0.0302, -0.7316, 0.6811, + 0.3938, -0.6176, -0.6808, + -48.4330, 26.3254, 13.6383}, + {-0.1504, 0.7744, -0.6145, % p_o3'_180_tfo + 0.7581, 0.4893, 0.4311, + 0.6345, -0.4010, -0.6607, + -31.9784, -13.4285, 44.9650}, + {-0.6236, -0.7810, -0.0337, % p_o3'_60_tfo + -0.6890, 0.5694, -0.4484, + 0.3694, -0.2564, -0.8932, + 12.1105, 30.8774, 46.0946}, + {33.3400, 11.0980, 46.1750}, % P + {34.5130, 10.2320, 46.4660}, % O1P + {33.4130, 12.3960, 46.9340}, % O2P + {31.9810, 10.3390, 46.4820}, % O5' + {30.8152, 11.1619, 46.2003}, % C5' + {30.4519, 10.9454, 45.1957}, % H5' + {31.0379, 12.2016, 46.4400}, % H5'' + {29.7081, 10.7448, 47.1428}, % C4' + {28.8710, 11.4416, 47.0982}, % H4' + {29.2550, 9.4394, 46.8162}, % O4' + {29.3907, 8.5625, 47.9460}, % C1' + {28.4416, 8.5669, 48.4819}, % H1' + {30.4468, 9.2031, 48.7952}, % C2' + {31.4222, 8.9651, 48.3709}, % H2'' + {30.3701, 8.9157, 50.1624}, % O2' + {30.0652, 8.0304, 50.3740}, % H2' + {30.1622, 10.6879, 48.6120}, % C3' + {31.0952, 11.2399, 48.7254}, % H3' + {29.1076, 11.1535, 49.4702}, % O3' + {29.7883, 7.2209, 47.5235}, % N1 + {29.1825, 5.0438, 46.8275}, % N3 + {28.8008, 6.2912, 47.2263}, % C2 + {30.4888, 4.6890, 46.7186}, % C4 + {31.5034, 5.6405, 47.0249}, % C5 + {31.1091, 6.8691, 47.4156}, % C6 + c, { + {30.8109, 3.4584, 46.3336}, % N4 + {27.6171, 6.5989, 47.3189}, % O2 + {31.7923, 3.2301, 46.2638}, % H41 + {30.0880, 2.7857, 46.1215}, % H42 + {32.5542, 5.3634, 46.9395}, % H5 + {31.8523, 7.6279, 47.6603}} % H6 + }. + +rC08() -> + { + {0.0797, -0.6026, -0.7941, % dgf_base_tfo + 0.7939, 0.5201, -0.3150, + 0.6028, -0.6054, 0.5198, + -36.8341, 41.5293, 1.6628}, + {0.9187, 0.2887, 0.2694, % p_o3'_275_tfo + 0.0302, -0.7316, 0.6811, + 0.3938, -0.6176, -0.6808, + -48.4330, 26.3254, 13.6383}, + {-0.1504, 0.7744, -0.6145, % p_o3'_180_tfo + 0.7581, 0.4893, 0.4311, + 0.6345, -0.4010, -0.6607, + -31.9784, -13.4285, 44.9650}, + {-0.6236, -0.7810, -0.0337, % p_o3'_60_tfo + -0.6890, 0.5694, -0.4484, + 0.3694, -0.2564, -0.8932, + 12.1105, 30.8774, 46.0946}, + {33.3400, 11.0980, 46.1750}, % P + {34.5130, 10.2320, 46.4660}, % O1P + {33.4130, 12.3960, 46.9340}, % O2P + {31.9810, 10.3390, 46.4820}, % O5' + {31.8779, 9.9369, 47.8760}, % C5' + {31.3239, 10.6931, 48.4322}, % H5' + {32.8647, 9.6624, 48.2489}, % H5'' + {31.0429, 8.6773, 47.9401}, % C4' + {31.0779, 8.2331, 48.9349}, % H4' + {29.6956, 8.9669, 47.5983}, % O4' + {29.2784, 8.1700, 46.4782}, % C1' + {28.8006, 7.2731, 46.8722}, % H1' + {30.5544, 7.7940, 45.7875}, % C2' + {30.8837, 8.6410, 45.1856}, % H2'' + {30.5100, 6.6007, 45.0582}, % O2' + {29.6694, 6.4168, 44.6326}, % H2' + {31.5146, 7.5954, 46.9527}, % C3' + {32.5255, 7.8261, 46.6166}, % H3' + {31.3876, 6.2951, 47.5516}, % O3' + {28.3976, 8.9302, 45.5933}, % N1 + {26.2155, 9.6135, 44.9910}, % N3 + {27.0281, 8.8961, 45.8192}, % C2 + {26.7044, 10.3489, 43.9595}, % C4 + {28.1088, 10.3837, 43.7247}, % C5 + {28.8978, 9.6708, 44.5535}, % C6 + c, { + {25.8715, 11.0249, 43.1749}, % N4 + {26.5733, 8.2371, 46.7484}, % O2 + {26.2707, 11.5609, 42.4177}, % H41 + {24.8760, 10.9939, 43.3427}, % H42 + {28.5089, 10.9722, 42.8990}, % H5 + {29.9782, 9.6687, 44.4097}} % H6 + }. + +rC09() -> + { + {0.8727, 0.4760, -0.1091, % dgf_base_tfo + -0.4188, 0.6148, -0.6682, + -0.2510, 0.6289, 0.7359, + -8.1687, -52.0761, -25.0726}, + {0.9187, 0.2887, 0.2694, % p_o3'_275_tfo + 0.0302, -0.7316, 0.6811, + 0.3938, -0.6176, -0.6808, + -48.4330, 26.3254, 13.6383}, + {-0.1504, 0.7744, -0.6145, % p_o3'_180_tfo + 0.7581, 0.4893, 0.4311, + 0.6345, -0.4010, -0.6607, + -31.9784, -13.4285, 44.9650}, + {-0.6236, -0.7810, -0.0337, % p_o3'_60_tfo + -0.6890, 0.5694, -0.4484, + 0.3694, -0.2564, -0.8932, + 12.1105, 30.8774, 46.0946}, + {33.3400, 11.0980, 46.1750}, % P + {34.5130, 10.2320, 46.4660}, % O1P + {33.4130, 12.3960, 46.9340}, % O2P + {31.9810, 10.3390, 46.4820}, % O5' + {30.8152, 11.1619, 46.2003}, % C5' + {30.4519, 10.9454, 45.1957}, % H5' + {31.0379, 12.2016, 46.4400}, % H5'' + {29.7081, 10.7448, 47.1428}, % C4' + {29.4506, 9.6945, 47.0059}, % H4' + {30.1045, 10.9634, 48.4885}, % O4' + {29.1794, 11.8418, 49.1490}, % C1' + {28.4388, 11.2210, 49.6533}, % H1' + {28.5211, 12.6008, 48.0367}, % C2' + {29.1947, 13.3949, 47.7147}, % H2'' + {27.2316, 13.0683, 48.3134}, % O2' + {27.0851, 13.3391, 49.2227}, % H2' + {28.4131, 11.5507, 46.9391}, % C3' + {28.4451, 12.0512, 45.9713}, % H3' + {27.2707, 10.6955, 47.1097}, % O3' + {29.8751, 12.7405, 50.0682}, % N1 + {30.7172, 13.1841, 52.2328}, % N3 + {30.0617, 12.3404, 51.3847}, % C2 + {31.1834, 14.3941, 51.8297}, % C4 + {30.9913, 14.8074, 50.4803}, % C5 + {30.3434, 13.9610, 49.6548}, % C6 + c, { + {31.8090, 15.1847, 52.6957}, % N4 + {29.6470, 11.2494, 51.7616}, % O2 + {32.1422, 16.0774, 52.3606}, % H41 + {31.9392, 14.8893, 53.6527}, % H42 + {31.3632, 15.7771, 50.1491}, % H5 + {30.1742, 14.2374, 48.6141}} % H6 + }. + +rC10() -> + { + {0.1549, 0.8710, -0.4663, % dgf_base_tfo + 0.6768, -0.4374, -0.5921, + -0.7197, -0.2239, -0.6572, + 25.2447, -14.1920, 50.3201}, + {0.9187, 0.2887, 0.2694, % p_o3'_275_tfo + 0.0302, -0.7316, 0.6811, + 0.3938, -0.6176, -0.6808, + -48.4330, 26.3254, 13.6383}, + {-0.1504, 0.7744, -0.6145, % p_o3'_180_tfo + 0.7581, 0.4893, 0.4311, + 0.6345, -0.4010, -0.6607, + -31.9784, -13.4285, 44.9650}, + {-0.6236, -0.7810, -0.0337, % p_o3'_60_tfo + -0.6890, 0.5694, -0.4484, + 0.3694, -0.2564, -0.8932, + 12.1105, 30.8774, 46.0946}, + {33.3400, 11.0980, 46.1750}, % P + {34.5130, 10.2320, 46.4660}, % O1P + {33.4130, 12.3960, 46.9340}, % O2P + {31.9810, 10.3390, 46.4820}, % O5' + {31.8779, 9.9369, 47.8760}, % C5' + {31.3239, 10.6931, 48.4322}, % H5' + {32.8647, 9.6624, 48.2489}, % H5'' + {31.0429, 8.6773, 47.9401}, % C4' + {30.0440, 8.8473, 47.5383}, % H4' + {31.6749, 7.6351, 47.2119}, % O4' + {31.9159, 6.5022, 48.0616}, % C1' + {31.0691, 5.8243, 47.9544}, % H1' + {31.9300, 7.0685, 49.4493}, % C2' + {32.9024, 7.5288, 49.6245}, % H2'' + {31.5672, 6.1750, 50.4632}, % O2' + {31.8416, 5.2663, 50.3200}, % H2' + {30.8618, 8.1514, 49.3749}, % C3' + {31.1122, 8.9396, 50.0850}, % H3' + {29.5351, 7.6245, 49.5409}, % O3' + {33.1890, 5.8629, 47.7343}, % N1 + {34.4004, 4.2636, 46.4828}, % N3 + {33.2062, 4.8497, 46.7851}, % C2 + {35.5600, 4.6374, 47.0822}, % C4 + {35.5444, 5.6751, 48.0577}, % C5 + {34.3565, 6.2450, 48.3432}, % C6 + c, { + {36.6977, 4.0305, 46.7598}, % N4 + {32.1661, 4.5034, 46.2348}, % O2 + {37.5405, 4.3347, 47.2259}, % H41 + {36.7033, 3.2923, 46.0706}, % H42 + {36.4713, 5.9811, 48.5428}, % H5 + {34.2986, 7.0426, 49.0839}} % H6 + }. + +rCs() -> [rC01(),rC02(),rC03(),rC04(),rC05(),rC06(),rC07(), + rC08(),rC09(),rC10()]. + +rG() -> + { + {-0.0018, -0.8207, 0.5714, % dgf_base_tfo + 0.2679, -0.5509, -0.7904, + 0.9634, 0.1517, 0.2209, + 0.0073, 8.4030, 0.6232}, + {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo + -0.0433, -0.4257, 0.9038, + -0.5788, 0.7480, 0.3246, + 1.5227, 6.9114, -7.0765}, + {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo + 0.4552, 0.6637, 0.5935, + -0.8042, 0.0203, 0.5941, + -6.9472, -4.1186, -5.9108}, + {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo + -0.8247, 0.5587, -0.0878, + 0.0426, 0.2162, 0.9754, + 6.2694, -7.0540, 3.3316}, + {2.8930, 8.5380, -3.3280}, % P + {1.6980, 7.6960, -3.5570}, % O1P + {3.2260, 9.5010, -4.4020}, % O2P + {4.1590, 7.6040, -3.0340}, % O5' + {5.4550, 8.2120, -2.8810}, % C5' + {5.4546, 8.8508, -1.9978}, % H5' + {5.7588, 8.6625, -3.8259}, % H5'' + {6.4970, 7.1480, -2.5980}, % C4' + {7.4896, 7.5919, -2.5214}, % H4' + {6.1630, 6.4860, -1.3440}, % O4' + {6.5400, 5.1200, -1.4190}, % C1' + {7.2763, 4.9681, -0.6297}, % H1' + {7.1940, 4.8830, -2.7770}, % C2' + {6.8667, 3.9183, -3.1647}, % H2'' + {8.5860, 5.0910, -2.6140}, % O2' + {8.9510, 4.7626, -1.7890}, % H2' + {6.5720, 6.0040, -3.6090}, % C3' + {5.5636, 5.7066, -3.8966}, % H3' + {7.3801, 6.3562, -4.7350}, % O3' + {4.7150, 0.4910, -0.1360}, % N1 + {6.3490, 2.1730, -0.6020}, % N3 + {5.9530, 0.9650, -0.2670}, % C2 + {5.2900, 2.9790, -0.8260}, % C4 + {3.9720, 2.6390, -0.7330}, % C5 + {3.6770, 1.3160, -0.3660}, % C6 + g, { + {6.8426, 0.0056, -0.0019}, % N2 + {3.1660, 3.7290, -1.0360}, % N7 + {5.3170, 4.2990, -1.1930}, % N9 + {4.0100, 4.6780, -1.2990}, % C8 + {2.4280, 0.8450, -0.2360}, % O6 + {4.6151, -0.4677, 0.1305}, % H1 + {6.6463, -0.9463, 0.2729}, % H21 + {7.8170, 0.2642, -0.0640}, % H22 + {3.4421, 5.5744, -1.5482}} % H8 + }. + +% rG01() -> +% { +% {-0.0043, -0.8175, 0.5759, % dgf_base_tfo +% 0.2617, -0.5567, -0.7884, +% 0.9651, 0.1473, 0.2164, +% 0.0359, 8.3929, 0.5532}, +% {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo +% -0.0433, -0.4257, 0.9038, +% -0.5788, 0.7480, 0.3246, +% 1.5227, 6.9114, -7.0765}, +% {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo +% 0.4552, 0.6637, 0.5935, +% -0.8042, 0.0203, 0.5941, +% -6.9472, -4.1186, -5.9108}, +% {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo +% -0.8247, 0.5587, -0.0878, +% 0.0426, 0.2162, 0.9754, +% 6.2694, -7.0540, 3.3316}, +% {2.8930, 8.5380, -3.3280}, % P +% {1.6980, 7.6960, -3.5570}, % O1P +% {3.2260, 9.5010, -4.4020}, % O2P +% {4.1590, 7.6040, -3.0340}, % O5' +% {5.4352, 8.2183, -2.7757}, % C5' +% {5.3830, 8.7883, -1.8481}, % H5' +% {5.7729, 8.7436, -3.6691}, % H5'' +% {6.4830, 7.1518, -2.5252}, % C4' +% {7.4749, 7.5972, -2.4482}, % H4' +% {6.1626, 6.4620, -1.2827}, % O4' +% {6.5431, 5.0992, -1.3905}, % C1' +% {7.2871, 4.9328, -0.6114}, % H1' +% {7.1852, 4.8935, -2.7592}, % C2' +% {6.8573, 3.9363, -3.1645}, % H2'' +% {8.5780, 5.1025, -2.6046}, % O2' +% {8.9516, 4.7577, -1.7902}, % H2' +% {6.5522, 6.0300, -3.5612}, % C3' +% {5.5420, 5.7356, -3.8459}, % H3' +% {7.3487, 6.4089, -4.6867}, % O3' +% {4.7442, 0.4514, -0.1390}, % N1 +% {6.3687, 2.1459, -0.5926}, % N3 +% {5.9795, 0.9335, -0.2657}, % C2 +% {5.3052, 2.9471, -0.8125}, % C4 +% {3.9891, 2.5987, -0.7230}, % C5 +% {3.7016, 1.2717, -0.3647}, % C6 +% g, { +% {6.8745, -0.0224, -0.0058}, % N2 +% {3.1770, 3.6859, -1.0198}, % N7 +% {5.3247, 4.2695, -1.1710}, % N9 +% {4.0156, 4.6415, -1.2759}, % C8 +% {2.4553, 0.7925, -0.2390}, % O6 +% {4.6497, -0.5095, 0.1212}, % H1 +% {6.6836, -0.9771, 0.2627}, % H21 +% {7.8474, 0.2424, -0.0653}, % H22 +% {3.4426, 5.5361, -1.5199}} % H8 +% }. + +% rG02() -> +% { +% {0.5566, 0.0449, 0.8296, % dgf_base_tfo +% 0.5125, 0.7673, -0.3854, +% -0.6538, 0.6397, 0.4041, +% -9.1161, -3.7679, -2.9968}, +% {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo +% -0.0433, -0.4257, 0.9038, +% -0.5788, 0.7480, 0.3246, +% 1.5227, 6.9114, -7.0765}, +% {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo +% 0.4552, 0.6637, 0.5935, +% -0.8042, 0.0203, 0.5941, +% -6.9472, -4.1186, -5.9108}, +% {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo +% -0.8247, 0.5587, -0.0878, +% 0.0426, 0.2162, 0.9754, +% 6.2694, -7.0540, 3.3316}, +% {2.8930, 8.5380, -3.3280}, % P +% {1.6980, 7.6960, -3.5570}, % O1P +% {3.2260, 9.5010, -4.4020}, % O2P +% {4.1590, 7.6040, -3.0340}, % O5' +% {4.5778, 6.6594, -4.0364}, % C5' +% {4.9220, 7.1963, -4.9204}, % H5' +% {3.7996, 5.9091, -4.1764}, % H5'' +% {5.7873, 5.8869, -3.5482}, % C4' +% {6.0405, 5.0875, -4.2446}, % H4' +% {6.9135, 6.8036, -3.4310}, % O4' +% {7.7293, 6.4084, -2.3392}, % C1' +% {8.7078, 6.1815, -2.7624}, % H1' +% {7.1305, 5.1418, -1.7347}, % C2' +% {7.2040, 5.1982, -0.6486}, % H2'' +% {7.7417, 4.0392, -2.3813}, % O2' +% {8.6785, 4.1443, -2.5630}, % H2' +% {5.6666, 5.2728, -2.1536}, % C3' +% {5.1747, 5.9805, -1.4863}, % H3' +% {4.9997, 4.0086, -2.1973}, % O3' +% {10.3245, 8.5459, 1.5467}, % N1 +% {9.8051, 6.9432, -0.1497}, % N3 +% {10.5175, 7.4328, 0.8408}, % C2 +% {8.7523, 7.7422, -0.4228}, % C4 +% {8.4257, 8.9060, 0.2099}, % C5 +% {9.2665, 9.3242, 1.2540}, % C6 +% g, { +% {11.6077, 6.7966, 1.2752}, % N2 +% {7.2750, 9.4537, -0.3428}, % N7 +% {7.7962, 7.5519, -1.3859}, % N9 +% {6.9479, 8.6157, -1.2771}, % C8 +% {9.0664, 10.4462, 1.9610}, % O6 +% {10.9838, 8.7524, 2.2697}, % H1 +% {12.2274, 7.0896, 2.0170}, % H21 +% {11.8502, 5.9398, 0.7984}, % H22 +% {6.0430, 8.9853, -1.7594}} % H8 +% }. + +% rG03() -> +% { +% {-0.5021, 0.0731, 0.8617, % dgf_base_tfo +% -0.8112, 0.3054, -0.4986, +% -0.2996, -0.9494, -0.0940, +% 6.4273, -5.1944, -3.7807}, +% {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo +% -0.0433, -0.4257, 0.9038, +% -0.5788, 0.7480, 0.3246, +% 1.5227, 6.9114, -7.0765}, +% {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo +% 0.4552, 0.6637, 0.5935, +% -0.8042, 0.0203, 0.5941, +% -6.9472, -4.1186, -5.9108}, +% {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo +% -0.8247, 0.5587, -0.0878, +% 0.0426, 0.2162, 0.9754, +% 6.2694, -7.0540, 3.3316}, +% {2.8930, 8.5380, -3.3280}, % P +% {1.6980, 7.6960, -3.5570}, % O1P +% {3.2260, 9.5010, -4.4020}, % O2P +% {4.1590, 7.6040, -3.0340}, % O5' +% {4.1214, 6.7116, -1.9049}, % C5' +% {3.3465, 5.9610, -2.0607}, % H5' +% {4.0789, 7.2928, -0.9837}, % H5'' +% {5.4170, 5.9293, -1.8186}, % C4' +% {5.4506, 5.3400, -0.9023}, % H4' +% {5.5067, 5.0417, -2.9703}, % O4' +% {6.8650, 4.9152, -3.3612}, % C1' +% {7.1090, 3.8577, -3.2603}, % H1' +% {7.7152, 5.7282, -2.3894}, % C2' +% {8.5029, 6.2356, -2.9463}, % H2'' +% {8.1036, 4.8568, -1.3419}, % O2' +% {8.3270, 3.9651, -1.6184}, % H2' +% {6.7003, 6.7565, -1.8911}, % C3' +% {6.5898, 7.5329, -2.6482}, % H3' +% {7.0505, 7.2878, -0.6105}, % O3' +% {9.6740, 4.7656, -7.6614}, % N1 +% {9.0739, 4.3013, -5.3941}, % N3 +% {9.8416, 4.2192, -6.4581}, % C2 +% {7.9885, 5.0632, -5.6446}, % C4 +% {7.6822, 5.6856, -6.8194}, % C5 +% {8.5831, 5.5215, -7.8840}, % C6 +% g, { +% {10.9733, 3.5117, -6.4286}, % N2 +% {6.4857, 6.3816, -6.7035}, % N7 +% {6.9740, 5.3703, -4.7760}, % N9 +% {6.1133, 6.1613, -5.4808}, % C8 +% {8.4084, 6.0747, -9.0933}, % O6 +% {10.3759, 4.5855, -8.3504}, % H1 +% {11.6254, 3.3761, -7.1879}, % H21 +% {11.1917, 3.0460, -5.5593}, % H22 +% {5.1705, 6.6830, -5.3167}} % H8 +% }. + +% rG04() -> +% { +% {-0.5426, -0.8175, 0.1929, % dgf_base_tfo +% 0.8304, -0.5567, -0.0237, +% 0.1267, 0.1473, 0.9809, +% -0.5075, 8.3929, 0.2229}, +% {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo +% -0.0433, -0.4257, 0.9038, +% -0.5788, 0.7480, 0.3246, +% 1.5227, 6.9114, -7.0765}, +% {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo +% 0.4552, 0.6637, 0.5935, +% -0.8042, 0.0203, 0.5941, +% -6.9472, -4.1186, -5.9108}, +% {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo +% -0.8247, 0.5587, -0.0878, +% 0.0426, 0.2162, 0.9754, +% 6.2694, -7.0540, 3.3316}, +% {2.8930, 8.5380, -3.3280}, % P +% {1.6980, 7.6960, -3.5570}, % O1P +% {3.2260, 9.5010, -4.4020}, % O2P +% {4.1590, 7.6040, -3.0340}, % O5' +% {5.4352, 8.2183, -2.7757}, % C5' +% {5.3830, 8.7883, -1.8481}, % H5' +% {5.7729, 8.7436, -3.6691}, % H5'' +% {6.4830, 7.1518, -2.5252}, % C4' +% {7.4749, 7.5972, -2.4482}, % H4' +% {6.1626, 6.4620, -1.2827}, % O4' +% {6.5431, 5.0992, -1.3905}, % C1' +% {7.2871, 4.9328, -0.6114}, % H1' +% {7.1852, 4.8935, -2.7592}, % C2' +% {6.8573, 3.9363, -3.1645}, % H2'' +% {8.5780, 5.1025, -2.6046}, % O2' +% {8.9516, 4.7577, -1.7902}, % H2' +% {6.5522, 6.0300, -3.5612}, % C3' +% {5.5420, 5.7356, -3.8459}, % H3' +% {7.3487, 6.4089, -4.6867}, % O3' +% {3.6343, 2.6680, 2.0783}, % N1 +% {5.4505, 3.9805, 1.2446}, % N3 +% {4.7540, 3.3816, 2.1851}, % C2 +% {4.8805, 3.7951, 0.0354}, % C4 +% {3.7416, 3.0925, -0.2305}, % C5 +% {3.0873, 2.4980, 0.8606}, % C6 +% g, { +% {5.1433, 3.4373, 3.4609}, % N2 +% {3.4605, 3.1184, -1.5906}, % N7 +% {5.3247, 4.2695, -1.1710}, % N9 +% {4.4244, 3.8244, -2.0953}, % C8 +% {1.9600, 1.7805, 0.7462}, % O6 +% {3.2489, 2.2879, 2.9191}, % H1 +% {4.6785, 3.0243, 4.2568}, % H21 +% {5.9823, 3.9654, 3.6539}, % H22 +% {4.2675, 3.8876, -3.1721}} % H8 +% }. + +% rG05() -> +% { +% {-0.5891, 0.0449, 0.8068, % dgf_base_tfo +% 0.5375, 0.7673, 0.3498, +% -0.6034, 0.6397, -0.4762, +% -0.3019, -3.7679, -9.5913}, +% {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo +% -0.0433, -0.4257, 0.9038, +% -0.5788, 0.7480, 0.3246, +% 1.5227, 6.9114, -7.0765}, +% {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo +% 0.4552, 0.6637, 0.5935, +% -0.8042, 0.0203, 0.5941, +% -6.9472, -4.1186, -5.9108}, +% {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo +% -0.8247, 0.5587, -0.0878, +% 0.0426, 0.2162, 0.9754, +% 6.2694, -7.0540, 3.3316}, +% {2.8930, 8.5380, -3.3280}, % P +% {1.6980, 7.6960, -3.5570}, % O1P +% {3.2260, 9.5010, -4.4020}, % O2P +% {4.1590, 7.6040, -3.0340}, % O5' +% {4.5778, 6.6594, -4.0364}, % C5' +% {4.9220, 7.1963, -4.9204}, % H5' +% {3.7996, 5.9091, -4.1764}, % H5'' +% {5.7873, 5.8869, -3.5482}, % C4' +% {6.0405, 5.0875, -4.2446}, % H4' +% {6.9135, 6.8036, -3.4310}, % O4' +% {7.7293, 6.4084, -2.3392}, % C1' +% {8.7078, 6.1815, -2.7624}, % H1' +% {7.1305, 5.1418, -1.7347}, % C2' +% {7.2040, 5.1982, -0.6486}, % H2'' +% {7.7417, 4.0392, -2.3813}, % O2' +% {8.6785, 4.1443, -2.5630}, % H2' +% {5.6666, 5.2728, -2.1536}, % C3' +% {5.1747, 5.9805, -1.4863}, % H3' +% {4.9997, 4.0086, -2.1973}, % O3' +% {10.2594, 10.6774, -1.0056}, % N1 +% {9.7528, 8.7080, -2.2631}, % N3 +% {10.4471, 9.7876, -1.9791}, % C2 +% {8.7271, 8.5575, -1.3991}, % C4 +% {8.4100, 9.3803, -0.3580}, % C5 +% {9.2294, 10.5030, -0.1574}, % C6 +% g, { +% {11.5110, 10.1256, -2.7114}, % N2 +% {7.2891, 8.9068, 0.3121}, % N7 +% {7.7962, 7.5519, -1.3859}, % N9 +% {6.9702, 7.8292, -0.3353}, % C8 +% {9.0349, 11.3951, 0.8250}, % O6 +% {10.9013, 11.4422, -0.9512}, % H1 +% {12.1031, 10.9341, -2.5861}, % H21 +% {11.7369, 9.5180, -3.4859}, % H22 +% {6.0888, 7.3990, 0.1403}} % H8 +% }. + +% rG06() -> +% { +% {-0.9815, 0.0731, -0.1772, % dgf_base_tfo +% 0.1912, 0.3054, -0.9328, +% -0.0141, -0.9494, -0.3137, +% 5.7506, -5.1944, 4.7470}, +% {-0.8143, -0.5091, -0.2788, % p_o3'_275_tfo +% -0.0433, -0.4257, 0.9038, +% -0.5788, 0.7480, 0.3246, +% 1.5227, 6.9114, -7.0765}, +% {0.3822, -0.7477, 0.5430, % p_o3'_180_tfo +% 0.4552, 0.6637, 0.5935, +% -0.8042, 0.0203, 0.5941, +% -6.9472, -4.1186, -5.9108}, +% {0.5640, 0.8007, -0.2022, % p_o3'_60_tfo +% -0.8247, 0.5587, -0.0878, +% 0.0426, 0.2162, 0.9754, +% 6.2694, -7.0540, 3.3316}, +% {2.8930, 8.5380, -3.3280}, % P +% {1.6980, 7.6960, -3.5570}, % O1P +% {3.2260, 9.5010, -4.4020}, % O2P +% {4.1590, 7.6040, -3.0340}, % O5' +% {4.1214, 6.7116, -1.9049}, % C5' +% {3.3465, 5.9610, -2.0607}, % H5' +% {4.0789, 7.2928, -0.9837}, % H5'' +% {5.4170, 5.9293, -1.8186}, % C4' +% {5.4506, 5.3400, -0.9023}, % H4' +% {5.5067, 5.0417, -2.9703}, % O4' +% {6.8650, 4.9152, -3.3612}, % C1' +% {7.1090, 3.8577, -3.2603}, % H1' +% {7.7152, 5.7282, -2.3894}, % C2' +% {8.5029, 6.2356, -2.9463}, % H2'' +% {8.1036, 4.8568, -1.3419}, % O2' +% {8.3270, 3.9651, -1.6184}, % H2' +% {6.7003, 6.7565, -1.8911}, % C3' +% {6.5898, 7.5329, -2.6482}, % H3' +% {7.0505, 7.2878, -0.6105}, % O3' +% {6.6624, 3.5061, -8.2986}, % N1 +% {6.5810, 3.2570, -5.9221}, % N3 +% {6.5151, 2.8263, -7.1625}, % C2 +% {6.8364, 4.5817, -5.8882}, % C4 +% {7.0116, 5.4064, -6.9609}, % C5 +% {6.9173, 4.8260, -8.2361}, % C6 +% g, { +% {6.2717, 1.5402, -7.4250}, % N2 +% {7.2573, 6.7070, -6.5394}, % N7 +% {6.9740, 5.3703, -4.7760}, % N9 +% {7.2238, 6.6275, -5.2453}, % C8 +% {7.0668, 5.5163, -9.3763}, % O6 +% {6.5754, 2.9964, -9.1545}, % H1 +% {6.1908, 1.1105, -8.3354}, % H21 +% {6.1346, 0.9352, -6.6280}, % H22 +% {7.4108, 7.6227, -4.8418}} % H8 +% }. + +% rG07() -> +% { +% {0.0894, -0.6059, 0.7905, % dgf_base_tfo +% -0.6810, 0.5420, 0.4924, +% -0.7268, -0.5824, -0.3642, +% 34.1424, 45.9610, -11.8600}, +% {-0.8644, -0.4956, -0.0851, % p_o3'_275_tfo +% -0.0427, 0.2409, -0.9696, +% 0.5010, -0.8345, -0.2294, +% 4.0167, 54.5377, 12.4779}, +% {0.3706, -0.6167, 0.6945, % p_o3'_180_tfo +% -0.2867, -0.7872, -0.5460, +% 0.8834, 0.0032, -0.4686, +% -52.9020, 18.6313, -0.6709}, +% {0.4155, 0.9025, -0.1137, % p_o3'_60_tfo +% 0.9040, -0.4236, -0.0582, +% -0.1007, -0.0786, -0.9918, +% -7.6624, -25.2080, 49.5181}, +% {31.3810, 0.1400, 47.5810}, % P +% {29.9860, 0.6630, 47.6290}, % O1P +% {31.7210, -0.6460, 48.8090}, % O2P +% {32.4940, 1.2540, 47.2740}, % O5' +% {33.8709, 0.7918, 47.2113}, % C5' +% {34.1386, 0.5870, 46.1747}, % H5' +% {34.0186, -0.0095, 47.9353}, % H5'' +% {34.7297, 1.9687, 47.6685}, % C4' +% {35.7723, 1.6845, 47.8113}, % H4' +% {34.6455, 2.9768, 46.6660}, % O4' +% {34.1690, 4.1829, 47.2627}, % C1' +% {35.0437, 4.7633, 47.5560}, % H1' +% {33.4145, 3.7532, 48.4954}, % C2' +% {32.4340, 3.3797, 48.2001}, % H2'' +% {33.3209, 4.6953, 49.5217}, % O2' +% {33.2374, 5.6059, 49.2295}, % H2' +% {34.2724, 2.5970, 48.9773}, % C3' +% {33.6373, 1.8935, 49.5157}, % H3' +% {35.3453, 3.1884, 49.7285}, % O3' +% {34.0511, 7.8930, 43.7791}, % N1 +% {34.9937, 6.3369, 45.3199}, % N3 +% {35.0882, 7.3126, 44.4200}, % C2 +% {33.7190, 5.9650, 45.5374}, % C4 +% {32.5845, 6.4770, 44.9458}, % C5 +% {32.7430, 7.5179, 43.9914}, % C6 +% g, { +% {36.3030, 7.7827, 44.1036}, % N2 +% {31.4499, 5.8335, 45.4368}, % N7 +% {33.2760, 4.9817, 46.4043}, % N9 +% {31.9235, 4.9639, 46.2934}, % C8 +% {31.8602, 8.1000, 43.3695}, % O6 +% {34.2623, 8.6223, 43.1283}, % H1 +% {36.5188, 8.5081, 43.4347}, % H21 +% {37.0888, 7.3524, 44.5699}, % H22 +% {31.0815, 4.4201, 46.7218}} % H8 +% }. + +% rG08() -> +% { +% {0.2224, 0.6335, 0.7411, % dgf_base_tfo +% -0.3644, -0.6510, 0.6659, +% 0.9043, -0.4181, 0.0861, +% -47.6824, -0.5823, -31.7554}, +% {-0.8644, -0.4956, -0.0851, % p_o3'_275_tfo +% -0.0427, 0.2409, -0.9696, +% 0.5010, -0.8345, -0.2294, +% 4.0167, 54.5377, 12.4779}, +% {0.3706, -0.6167, 0.6945, % p_o3'_180_tfo +% -0.2867, -0.7872, -0.5460, +% 0.8834, 0.0032, -0.4686, +% -52.9020, 18.6313, -0.6709}, +% {0.4155, 0.9025, -0.1137, % p_o3'_60_tfo +% 0.9040, -0.4236, -0.0582, +% -0.1007, -0.0786, -0.9918, +% -7.6624, -25.2080, 49.5181}, +% {31.3810, 0.1400, 47.5810}, % P +% {29.9860, 0.6630, 47.6290}, % O1P +% {31.7210, -0.6460, 48.8090}, % O2P +% {32.4940, 1.2540, 47.2740}, % O5' +% {32.5924, 2.3488, 48.2255}, % C5' +% {33.3674, 2.1246, 48.9584}, % H5' +% {31.5994, 2.5917, 48.6037}, % H5'' +% {33.0722, 3.5577, 47.4258}, % C4' +% {33.0310, 4.4778, 48.0089}, % H4' +% {34.4173, 3.3055, 47.0316}, % O4' +% {34.5056, 3.3910, 45.6094}, % C1' +% {34.7881, 4.4152, 45.3663}, % H1' +% {33.1122, 3.1198, 45.1010}, % C2' +% {32.9230, 2.0469, 45.1369}, % H2'' +% {32.7946, 3.6590, 43.8529}, % O2' +% {33.5170, 3.6707, 43.2207}, % H2' +% {32.2730, 3.8173, 46.1566}, % C3' +% {31.3094, 3.3123, 46.2244}, % H3' +% {32.2391, 5.2039, 45.7807}, % O3' +% {39.3337, 2.7157, 44.1441}, % N1 +% {37.4430, 3.8242, 45.0824}, % N3 +% {38.7276, 3.7646, 44.7403}, % C2 +% {36.7791, 2.6963, 44.7704}, % C4 +% {37.2860, 1.5653, 44.1678}, % C5 +% {38.6647, 1.5552, 43.8235}, % C6 +% g, { +% {39.5123, 4.8216, 44.9936}, % N2 +% {36.2829, 0.6110, 44.0078}, % N7 +% {35.4394, 2.4314, 44.9931}, % N9 +% {35.2180, 1.1815, 44.5128}, % C8 +% {39.2907, 0.6514, 43.2796}, % O6 +% {40.3076, 2.8048, 43.9352}, % H1 +% {40.4994, 4.9066, 44.7977}, % H21 +% {39.0738, 5.6108, 45.4464}, % H22 +% {34.3856, 0.4842, 44.4185}} % H8 +% }. + +% rG09() -> +% { +% {-0.9699, -0.1688, -0.1753, % dgf_base_tfo +% -0.1050, -0.3598, 0.9271, +% -0.2196, 0.9176, 0.3312, +% 45.6217, -38.9484, -12.3208}, +% {-0.8644, -0.4956, -0.0851, % p_o3'_275_tfo +% -0.0427, 0.2409, -0.9696, +% 0.5010, -0.8345, -0.2294, +% 4.0167, 54.5377, 12.4779}, +% {0.3706, -0.6167, 0.6945, % p_o3'_180_tfo +% -0.2867, -0.7872, -0.5460, +% 0.8834, 0.0032, -0.4686, +% -52.9020, 18.6313, -0.6709}, +% {0.4155, 0.9025, -0.1137, % p_o3'_60_tfo +% 0.9040, -0.4236, -0.0582, +% -0.1007, -0.0786, -0.9918, +% -7.6624, -25.2080, 49.5181}, +% {31.3810, 0.1400, 47.5810}, % P +% {29.9860, 0.6630, 47.6290}, % O1P +% {31.7210, -0.6460, 48.8090}, % O2P +% {32.4940, 1.2540, 47.2740}, % O5' +% {33.8709, 0.7918, 47.2113}, % C5' +% {34.1386, 0.5870, 46.1747}, % H5' +% {34.0186, -0.0095, 47.9353}, % H5'' +% {34.7297, 1.9687, 47.6685}, % C4' +% {34.5880, 2.8482, 47.0404}, % H4' +% {34.3575, 2.2770, 49.0081}, % O4' +% {35.5157, 2.1993, 49.8389}, % C1' +% {35.9424, 3.2010, 49.8893}, % H1' +% {36.4701, 1.2820, 49.1169}, % C2' +% {36.1545, 0.2498, 49.2683}, % H2'' +% {37.8262, 1.4547, 49.4008}, % O2' +% {38.0227, 1.6945, 50.3094}, % H2' +% {36.2242, 1.6797, 47.6725}, % C3' +% {36.4297, 0.8197, 47.0351}, % H3' +% {37.0289, 2.8480, 47.4426}, % O3' +% {34.3005, 3.5042, 54.6070}, % N1 +% {34.7693, 3.7936, 52.2874}, % N3 +% {34.4484, 4.2541, 53.4939}, % C2 +% {34.9354, 2.4584, 52.2785}, % C4 +% {34.8092, 1.5915, 53.3422}, % C5 +% {34.4646, 2.1367, 54.6085}, % C6 +% g, { +% {34.2514, 5.5708, 53.6503}, % N2 +% {35.0641, 0.2835, 52.9337}, % N7 +% {35.2669, 1.6690, 51.1915}, % N9 +% {35.3288, 0.3954, 51.6563}, % C8 +% {34.3151, 1.5317, 55.6650}, % O6 +% {34.0623, 3.9797, 55.4539}, % H1 +% {33.9950, 6.0502, 54.5016}, % H21 +% {34.3512, 6.1432, 52.8242}, % H22 +% {35.5414, -0.6006, 51.2679}} % H8 +% }. + +% rG10() -> +% { +% {-0.0980, -0.9723, 0.2122, % dgf_base_tfo +% -0.9731, 0.1383, 0.1841, +% -0.2083, -0.1885, -0.9597, +% 17.8469, 38.8265, 37.0475}, +% {-0.8644, -0.4956, -0.0851, % p_o3'_275_tfo +% -0.0427, 0.2409, -0.9696, +% 0.5010, -0.8345, -0.2294, +% 4.0167, 54.5377, 12.4779}, +% {0.3706, -0.6167, 0.6945, % p_o3'_180_tfo +% -0.2867, -0.7872, -0.5460, +% 0.8834, 0.0032, -0.4686, +% -52.9020, 18.6313, -0.6709}, +% {0.4155, 0.9025, -0.1137, % p_o3'_60_tfo +% 0.9040, -0.4236, -0.0582, +% -0.1007, -0.0786, -0.9918, +% -7.6624, -25.2080, 49.5181}, +% {31.3810, 0.1400, 47.5810}, % P +% {29.9860, 0.6630, 47.6290}, % O1P +% {31.7210, -0.6460, 48.8090}, % O2P +% {32.4940, 1.2540, 47.2740}, % O5' +% {32.5924, 2.3488, 48.2255}, % C5' +% {33.3674, 2.1246, 48.9584}, % H5' +% {31.5994, 2.5917, 48.6037}, % H5'' +% {33.0722, 3.5577, 47.4258}, % C4' +% {34.0333, 3.3761, 46.9447}, % H4' +% {32.0890, 3.8338, 46.4332}, % O4' +% {31.6377, 5.1787, 46.5914}, % C1' +% {32.2499, 5.8016, 45.9392}, % H1' +% {31.9167, 5.5319, 48.0305}, % C2' +% {31.1507, 5.0820, 48.6621}, % H2'' +% {32.0865, 6.8890, 48.3114}, % O2' +% {31.5363, 7.4819, 47.7942}, % H2' +% {33.2398, 4.8224, 48.2563}, % C3' +% {33.3166, 4.5570, 49.3108}, % H3' +% {34.2528, 5.7056, 47.7476}, % O3' +% {28.2782, 6.3049, 42.9364}, % N1 +% {30.4001, 5.8547, 43.9258}, % N3 +% {29.6195, 6.1568, 42.8913}, % C2 +% {29.7005, 5.7006, 45.0649}, % C4 +% {28.3383, 5.8221, 45.2343}, % C5 +% {27.5519, 6.1461, 44.0958}, % C6 +% g, { +% {30.1838, 6.3385, 41.6890}, % N2 +% {27.9936, 5.5926, 46.5651}, % N7 +% {30.2046, 5.3825, 46.3136}, % N9 +% {29.1371, 5.3398, 47.1506}, % C8 +% {26.3361, 6.3024, 44.0495}, % O6 +% {27.8122, 6.5394, 42.0833}, % H1 +% {29.7125, 6.5595, 40.8235}, % H21 +% {31.1859, 6.2231, 41.6389}, % H22 +% {28.9406, 5.1504, 48.2059}} % H8 +% }. + +% rGs() -> [rG01(),rG02(),rG03(),rG04(),rG05(),rG06(),rG07(), +% rG08(),rG09(),rG10()]. + +rU() -> + { + {-0.0359, -0.8071, 0.5894, % dgf_base_tfo + -0.2669, 0.5761, 0.7726, + -0.9631, -0.1296, -0.2361, + 0.1584, 8.3434, 0.5434}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {5.2430, -8.2420, 2.8260}, % C5' + {5.1974, -8.8497, 1.9223}, % H5' + {5.5548, -8.7348, 3.7469}, % H5'' + {6.3140, -7.2060, 2.5510}, % C4' + {7.2954, -7.6762, 2.4898}, % H4' + {6.0140, -6.5420, 1.2890}, % O4' + {6.4190, -5.1840, 1.3620}, % C1' + {7.1608, -5.0495, 0.5747}, % H1' + {7.0760, -4.9560, 2.7270}, % C2' + {6.7770, -3.9803, 3.1099}, % H2'' + {8.4500, -5.1930, 2.5810}, % O2' + {8.8309, -4.8755, 1.7590}, % H2' + {6.4060, -6.0590, 3.5580}, % C3' + {5.4021, -5.7313, 3.8281}, % H3' + {7.1570, -6.4240, 4.7070}, % O3' + {5.2170, -4.3260, 1.1690}, % N1 + {4.2960, -2.2560, 0.6290}, % N3 + {5.4330, -3.0200, 0.7990}, % C2 + {2.9930, -2.6780, 0.7940}, % C4 + {2.8670, -4.0630, 1.1830}, % C5 + {3.9570, -4.8300, 1.3550}, % C6 + u, { + {6.5470, -2.5560, 0.6290}, % O2 + {2.0540, -1.9000, 0.6130}, % O4 + {4.4300, -1.3020, 0.3600}, % H3 + {1.9590, -4.4570, 1.3250}, % H5 + {3.8460, -5.7860, 1.6240}} % H6 + }. + +rU01() -> + { + {-0.0137, -0.8012, 0.5983, % dgf_base_tfo + -0.2523, 0.5817, 0.7733, + -0.9675, -0.1404, -0.2101, + 0.2031, 8.3874, 0.4228}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {5.2416, -8.2422, 2.8181}, % C5' + {5.2050, -8.8128, 1.8901}, % H5' + {5.5368, -8.7738, 3.7227}, % H5'' + {6.3232, -7.2037, 2.6002}, % C4' + {7.3048, -7.6757, 2.5577}, % H4' + {6.0635, -6.5092, 1.3456}, % O4' + {6.4697, -5.1547, 1.4629}, % C1' + {7.2354, -5.0043, 0.7018}, % H1' + {7.0856, -4.9610, 2.8521}, % C2' + {6.7777, -3.9935, 3.2487}, % H2'' + {8.4627, -5.1992, 2.7423}, % O2' + {8.8693, -4.8638, 1.9399}, % H2' + {6.3877, -6.0809, 3.6362}, % C3' + {5.3770, -5.7562, 3.8834}, % H3' + {7.1024, -6.4754, 4.7985}, % O3' + {5.2764, -4.2883, 1.2538}, % N1 + {4.3777, -2.2062, 0.7229}, % N3 + {5.5069, -2.9779, 0.9088}, % C2 + {3.0693, -2.6246, 0.8500}, % C4 + {2.9279, -4.0146, 1.2149}, % C5 + {4.0101, -4.7892, 1.4017}, % C6 + u, { + {6.6267, -2.5166, 0.7728}, % O2 + {2.1383, -1.8396, 0.6581}, % O4 + {4.5223, -1.2489, 0.4716}, % H3 + {2.0151, -4.4065, 1.3290}, % H5 + {3.8886, -5.7486, 1.6535}} % H6 + }. + +rU02() -> + { + {0.5141, 0.0246, 0.8574, % dgf_base_tfo + -0.5547, -0.7529, 0.3542, + 0.6542, -0.6577, -0.3734, + -9.1111, -3.4598, -3.2939}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {4.3825, -6.6585, 4.0489}, % C5' + {4.6841, -7.2019, 4.9443}, % H5' + {3.6189, -5.8889, 4.1625}, % H5'' + {5.6255, -5.9175, 3.5998}, % C4' + {5.8732, -5.1228, 4.3034}, % H4' + {6.7337, -6.8605, 3.5222}, % O4' + {7.5932, -6.4923, 2.4548}, % C1' + {8.5661, -6.2983, 2.9064}, % H1' + {7.0527, -5.2012, 1.8322}, % C2' + {7.1627, -5.2525, 0.7490}, % H2'' + {7.6666, -4.1249, 2.4880}, % O2' + {8.5944, -4.2543, 2.6981}, % H2' + {5.5661, -5.3029, 2.2009}, % C3' + {5.0841, -6.0018, 1.5172}, % H3' + {4.9062, -4.0452, 2.2042}, % O3' + {7.6298, -7.6136, 1.4752}, % N1 + {8.6945, -8.7046, -0.2857}, % N3 + {8.6943, -7.6514, 0.6066}, % C2 + {7.7426, -9.6987, -0.3801}, % C4 + {6.6642, -9.5742, 0.5722}, % C5 + {6.6391, -8.5592, 1.4526}, % C6 + u, { + {9.5840, -6.8186, 0.6136}, % O2 + {7.8505, -10.5925, -1.2223}, % O4 + {9.4601, -8.7514, -0.9277}, % H3 + {5.9281, -10.2509, 0.5782}, % H5 + {5.8831, -8.4931, 2.1028}} % H6 + }. + +rU03() -> + { + {-0.4993, 0.0476, 0.8651, % dgf_base_tfo + 0.8078, -0.3353, 0.4847, + 0.3132, 0.9409, 0.1290, + 6.2989, -5.2303, -3.8577}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {3.9938, -6.7042, 1.9023}, % C5' + {3.2332, -5.9343, 2.0319}, % H5' + {3.9666, -7.2863, 0.9812}, % H5'' + {5.3098, -5.9546, 1.8564}, % C4' + {5.3863, -5.3702, 0.9395}, % H4' + {5.3851, -5.0642, 3.0076}, % O4' + {6.7315, -4.9724, 3.4462}, % C1' + {7.0033, -3.9202, 3.3619}, % H1' + {7.5997, -5.8018, 2.4948}, % C2' + {8.3627, -6.3254, 3.0707}, % H2'' + {8.0410, -4.9501, 1.4724}, % O2' + {8.2781, -4.0644, 1.7570}, % H2' + {6.5701, -6.8129, 1.9714}, % C3' + {6.4186, -7.5809, 2.7299}, % H3' + {6.9357, -7.3841, 0.7235}, % O3' + {6.8024, -5.4718, 4.8475}, % N1 + {7.9218, -5.5700, 6.8877}, % N3 + {7.8908, -5.0886, 5.5944}, % C2 + {6.9789, -6.3827, 7.4823}, % C4 + {5.8742, -6.7319, 6.6202}, % C5 + {5.8182, -6.2769, 5.3570}, % C6 + u, { + {8.7747, -4.3728, 5.1568}, % O2 + {7.1154, -6.7509, 8.6509}, % O4 + {8.7055, -5.3037, 7.4491}, % H3 + {5.1416, -7.3178, 6.9665}, % H5 + {5.0441, -6.5310, 4.7784}} % H6 + }. + +rU04() -> + { + {-0.5669, -0.8012, 0.1918, % dgf_base_tfo + -0.8129, 0.5817, 0.0273, + -0.1334, -0.1404, -0.9811, + -0.3279, 8.3874, 0.3355}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {5.2416, -8.2422, 2.8181}, % C5' + {5.2050, -8.8128, 1.8901}, % H5' + {5.5368, -8.7738, 3.7227}, % H5'' + {6.3232, -7.2037, 2.6002}, % C4' + {7.3048, -7.6757, 2.5577}, % H4' + {6.0635, -6.5092, 1.3456}, % O4' + {6.4697, -5.1547, 1.4629}, % C1' + {7.2354, -5.0043, 0.7018}, % H1' + {7.0856, -4.9610, 2.8521}, % C2' + {6.7777, -3.9935, 3.2487}, % H2'' + {8.4627, -5.1992, 2.7423}, % O2' + {8.8693, -4.8638, 1.9399}, % H2' + {6.3877, -6.0809, 3.6362}, % C3' + {5.3770, -5.7562, 3.8834}, % H3' + {7.1024, -6.4754, 4.7985}, % O3' + {5.2764, -4.2883, 1.2538}, % N1 + {3.8961, -3.0896, -0.1893}, % N3 + {5.0095, -3.8907, -0.0346}, % C2 + {3.0480, -2.6632, 0.8116}, % C4 + {3.4093, -3.1310, 2.1292}, % C5 + {4.4878, -3.9124, 2.3088}, % C6 + u, { + {5.7005, -4.2164, -0.9842}, % O2 + {2.0800, -1.9458, 0.5503}, % O4 + {3.6834, -2.7882, -1.1190}, % H3 + {2.8508, -2.8721, 2.9172}, % H5 + {4.7188, -4.2247, 3.2295}} % H6 + }. + +rU05() -> + { + {-0.6298, 0.0246, 0.7763, % dgf_base_tfo + -0.5226, -0.7529, -0.4001, + 0.5746, -0.6577, 0.4870, + -0.0208, -3.4598, -9.6882}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {4.3825, -6.6585, 4.0489}, % C5' + {4.6841, -7.2019, 4.9443}, % H5' + {3.6189, -5.8889, 4.1625}, % H5'' + {5.6255, -5.9175, 3.5998}, % C4' + {5.8732, -5.1228, 4.3034}, % H4' + {6.7337, -6.8605, 3.5222}, % O4' + {7.5932, -6.4923, 2.4548}, % C1' + {8.5661, -6.2983, 2.9064}, % H1' + {7.0527, -5.2012, 1.8322}, % C2' + {7.1627, -5.2525, 0.7490}, % H2'' + {7.6666, -4.1249, 2.4880}, % O2' + {8.5944, -4.2543, 2.6981}, % H2' + {5.5661, -5.3029, 2.2009}, % C3' + {5.0841, -6.0018, 1.5172}, % H3' + {4.9062, -4.0452, 2.2042}, % O3' + {7.6298, -7.6136, 1.4752}, % N1 + {8.5977, -9.5977, 0.7329}, % N3 + {8.5951, -8.5745, 1.6594}, % C2 + {7.7372, -9.7371, -0.3364}, % C4 + {6.7596, -8.6801, -0.4476}, % C5 + {6.7338, -7.6721, 0.4408}, % C6 + u, { + {9.3993, -8.5377, 2.5743}, % O2 + {7.8374, -10.6990, -1.1008}, % O4 + {9.2924, -10.3081, 0.8477}, % H3 + {6.0932, -8.6982, -1.1929}, % H5 + {6.0481, -6.9515, 0.3446}} % H6 + }. + +rU06() -> + { + {-0.9837, 0.0476, -0.1733, % dgf_base_tfo + -0.1792, -0.3353, 0.9249, + -0.0141, 0.9409, 0.3384, + 5.7793, -5.2303, 4.5997}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {3.9938, -6.7042, 1.9023}, % C5' + {3.2332, -5.9343, 2.0319}, % H5' + {3.9666, -7.2863, 0.9812}, % H5'' + {5.3098, -5.9546, 1.8564}, % C4' + {5.3863, -5.3702, 0.9395}, % H4' + {5.3851, -5.0642, 3.0076}, % O4' + {6.7315, -4.9724, 3.4462}, % C1' + {7.0033, -3.9202, 3.3619}, % H1' + {7.5997, -5.8018, 2.4948}, % C2' + {8.3627, -6.3254, 3.0707}, % H2'' + {8.0410, -4.9501, 1.4724}, % O2' + {8.2781, -4.0644, 1.7570}, % H2' + {6.5701, -6.8129, 1.9714}, % C3' + {6.4186, -7.5809, 2.7299}, % H3' + {6.9357, -7.3841, 0.7235}, % O3' + {6.8024, -5.4718, 4.8475}, % N1 + {6.6920, -5.0495, 7.1354}, % N3 + {6.6201, -4.5500, 5.8506}, % C2 + {6.9254, -6.3614, 7.4926}, % C4 + {7.1046, -7.2543, 6.3718}, % C5 + {7.0391, -6.7951, 5.1106}, % C6 + u, { + {6.4083, -3.3696, 5.6340}, % O2 + {6.9679, -6.6901, 8.6800}, % O4 + {6.5626, -4.3957, 7.8812}, % H3 + {7.2781, -8.2254, 6.5350}, % H5 + {7.1657, -7.4312, 4.3503}} % H6 + }. + +rU07() -> + { + {-0.9434, 0.3172, 0.0971, % dgf_base_tfo + 0.2294, 0.4125, 0.8816, + 0.2396, 0.8539, -0.4619, + 8.3625, -52.7147, 1.3745}, + {0.2765, -0.1121, -0.9545, % p_o3'_275_tfo + -0.8297, 0.4733, -0.2959, + 0.4850, 0.8737, 0.0379, + -14.7774, -45.2464, 21.9088}, + {0.1063, -0.6334, -0.7665, % p_o3'_180_tfo + -0.5932, -0.6591, 0.4624, + -0.7980, 0.4055, -0.4458, + 43.7634, 4.3296, 28.4890}, + {0.7136, -0.5032, -0.4873, % p_o3'_60_tfo + 0.6803, 0.3317, 0.6536, + -0.1673, -0.7979, 0.5791, + -17.1858, 41.4390, -27.0751}, + {21.3880, 15.0780, 45.5770}, % P + {21.9980, 14.5500, 46.8210}, % O1P + {21.1450, 14.0270, 44.5420}, % O2P + {22.1250, 16.3600, 44.9460}, % O5' + {21.5037, 16.8594, 43.7323}, % C5' + {20.8147, 17.6663, 43.9823}, % H5' + {21.1086, 16.0230, 43.1557}, % H5'' + {22.5654, 17.4874, 42.8616}, % C4' + {22.1584, 17.7243, 41.8785}, % H4' + {23.0557, 18.6826, 43.4751}, % O4' + {24.4788, 18.6151, 43.6455}, % C1' + {24.9355, 19.0840, 42.7739}, % H1' + {24.7958, 17.1427, 43.6474}, % C2' + {24.5652, 16.7400, 44.6336}, % H2'' + {26.1041, 16.8773, 43.2455}, % O2' + {26.7516, 17.5328, 43.5149}, % H2' + {23.8109, 16.5979, 42.6377}, % C3' + {23.5756, 15.5686, 42.9084}, % H3' + {24.2890, 16.7447, 41.2729}, % O3' + {24.9420, 19.2174, 44.8923}, % N1 + {25.2655, 20.5636, 44.8883}, % N3 + {25.1663, 21.2219, 43.8561}, % C2 + {25.6911, 21.1219, 46.0494}, % C4 + {25.8051, 20.4068, 47.2048}, % C5 + {26.2093, 20.9962, 48.2534}, % C6 + u, { + {25.4692, 19.0221, 47.2053}, % O2 + {25.0502, 18.4827, 46.0370}, % O4 + {25.9599, 22.1772, 46.0966}, % H3 + {25.5545, 18.4409, 48.1234}, % H5 + {24.7854, 17.4265, 45.9883}} % H6 + }. + +rU08() -> + { + {-0.0080, -0.7928, 0.6094, % dgf_base_tfo + -0.7512, 0.4071, 0.5197, + -0.6601, -0.4536, -0.5988, + 44.1482, 30.7036, 2.1088}, + {0.2765, -0.1121, -0.9545, % p_o3'_275_tfo + -0.8297, 0.4733, -0.2959, + 0.4850, 0.8737, 0.0379, + -14.7774, -45.2464, 21.9088}, + {0.1063, -0.6334, -0.7665, % p_o3'_180_tfo + -0.5932, -0.6591, 0.4624, + -0.7980, 0.4055, -0.4458, + 43.7634, 4.3296, 28.4890}, + {0.7136, -0.5032, -0.4873, % p_o3'_60_tfo + 0.6803, 0.3317, 0.6536, + -0.1673, -0.7979, 0.5791, + -17.1858, 41.4390, -27.0751}, + {21.3880, 15.0780, 45.5770}, % P + {21.9980, 14.5500, 46.8210}, % O1P + {21.1450, 14.0270, 44.5420}, % O2P + {22.1250, 16.3600, 44.9460}, % O5' + {23.5096, 16.1227, 44.5783}, % C5' + {23.5649, 15.8588, 43.5222}, % H5' + {23.9621, 15.4341, 45.2919}, % H5'' + {24.2805, 17.4138, 44.7151}, % C4' + {25.3492, 17.2309, 44.6030}, % H4' + {23.8497, 18.3471, 43.7208}, % O4' + {23.4090, 19.5681, 44.3321}, % C1' + {24.2595, 20.2496, 44.3524}, % H1' + {23.0418, 19.1813, 45.7407}, % C2' + {22.0532, 18.7224, 45.7273}, % H2'' + {23.1307, 20.2521, 46.6291}, % O2' + {22.8888, 21.1051, 46.2611}, % H2' + {24.0799, 18.1326, 46.0700}, % C3' + {23.6490, 17.4370, 46.7900}, % H3' + {25.3329, 18.7227, 46.5109}, % O3' + {22.2515, 20.1624, 43.6698}, % N1 + {22.4760, 21.0609, 42.6406}, % N3 + {23.6229, 21.3462, 42.3061}, % C2 + {21.3986, 21.6081, 42.0236}, % C4 + {20.1189, 21.3012, 42.3804}, % C5 + {19.1599, 21.8516, 41.7578}, % C6 + u, { + {19.8919, 20.3745, 43.4387}, % O2 + {20.9790, 19.8423, 44.0440}, % O4 + {21.5235, 22.3222, 41.2097}, % H3 + {18.8732, 20.1200, 43.7312}, % H5 + {20.8545, 19.1313, 44.8608}} % H6 + }. + +rU09() -> + { + {-0.0317, 0.1374, 0.9900, % dgf_base_tfo + -0.3422, -0.9321, 0.1184, + 0.9391, -0.3351, 0.0765, + -32.1929, 25.8198, -28.5088}, + {0.2765, -0.1121, -0.9545, % p_o3'_275_tfo + -0.8297, 0.4733, -0.2959, + 0.4850, 0.8737, 0.0379, + -14.7774, -45.2464, 21.9088}, + {0.1063, -0.6334, -0.7665, % p_o3'_180_tfo + -0.5932, -0.6591, 0.4624, + -0.7980, 0.4055, -0.4458, + 43.7634, 4.3296, 28.4890}, + {0.7136, -0.5032, -0.4873, % p_o3'_60_tfo + 0.6803, 0.3317, 0.6536, + -0.1673, -0.7979, 0.5791, + -17.1858, 41.4390, -27.0751}, + {21.3880, 15.0780, 45.5770}, % P + {21.9980, 14.5500, 46.8210}, % O1P + {21.1450, 14.0270, 44.5420}, % O2P + {22.1250, 16.3600, 44.9460}, % O5' + {21.5037, 16.8594, 43.7323}, % C5' + {20.8147, 17.6663, 43.9823}, % H5' + {21.1086, 16.0230, 43.1557}, % H5'' + {22.5654, 17.4874, 42.8616}, % C4' + {23.0565, 18.3036, 43.3915}, % H4' + {23.5375, 16.5054, 42.4925}, % O4' + {23.6574, 16.4257, 41.0649}, % C1' + {24.4701, 17.0882, 40.7671}, % H1' + {22.3525, 16.9643, 40.5396}, % C2' + {21.5993, 16.1799, 40.6133}, % H2'' + {22.4693, 17.4849, 39.2515}, % O2' + {23.0899, 17.0235, 38.6827}, % H2' + {22.0341, 18.0633, 41.5279}, % C3' + {20.9509, 18.1709, 41.5846}, % H3' + {22.7249, 19.3020, 41.2100}, % O3' + {23.8580, 15.0648, 40.5757}, % N1 + {25.1556, 14.5982, 40.4523}, % N3 + {26.1047, 15.3210, 40.7448}, % C2 + {25.3391, 13.3315, 40.0020}, % C4 + {24.2974, 12.5148, 39.6749}, % C5 + {24.5450, 11.3410, 39.2610}, % C6 + u, { + {22.9633, 12.9979, 39.8053}, % O2 + {22.8009, 14.2648, 40.2524}, % O4 + {26.3414, 12.9194, 39.8855}, % H3 + {22.1227, 12.3533, 39.5486}, % H5 + {21.7989, 14.6788, 40.3650}} % H6 + }. + +rU10() -> + { + {-0.9674, 0.1021, -0.2318, % dgf_base_tfo + -0.2514, -0.2766, 0.9275, + 0.0306, 0.9555, 0.2933, + 27.8571, -42.1305, -24.4563}, + {0.2765, -0.1121, -0.9545, % p_o3'_275_tfo + -0.8297, 0.4733, -0.2959, + 0.4850, 0.8737, 0.0379, + -14.7774, -45.2464, 21.9088}, + {0.1063, -0.6334, -0.7665, % p_o3'_180_tfo + -0.5932, -0.6591, 0.4624, + -0.7980, 0.4055, -0.4458, + 43.7634, 4.3296, 28.4890}, + {0.7136, -0.5032, -0.4873, % p_o3'_60_tfo + 0.6803, 0.3317, 0.6536, + -0.1673, -0.7979, 0.5791, + -17.1858, 41.4390, -27.0751}, + {21.3880, 15.0780, 45.5770}, % P + {21.9980, 14.5500, 46.8210}, % O1P + {21.1450, 14.0270, 44.5420}, % O2P + {22.1250, 16.3600, 44.9460}, % O5' + {23.5096, 16.1227, 44.5783}, % C5' + {23.5649, 15.8588, 43.5222}, % H5' + {23.9621, 15.4341, 45.2919}, % H5'' + {24.2805, 17.4138, 44.7151}, % C4' + {23.8509, 18.1819, 44.0720}, % H4' + {24.2506, 17.8583, 46.0741}, % O4' + {25.5830, 18.0320, 46.5775}, % C1' + {25.8569, 19.0761, 46.4256}, % H1' + {26.4410, 17.1555, 45.7033}, % C2' + {26.3459, 16.1253, 46.0462}, % H2'' + {27.7649, 17.5888, 45.6478}, % O2' + {28.1004, 17.9719, 46.4616}, % H2' + {25.7796, 17.2997, 44.3513}, % C3' + {25.9478, 16.3824, 43.7871}, % H3' + {26.2154, 18.4984, 43.6541}, % O3' + {25.7321, 17.6281, 47.9726}, % N1 + {25.5136, 18.5779, 48.9560}, % N3 + {25.2079, 19.7276, 48.6503}, % C2 + {25.6482, 18.1987, 50.2518}, % C4 + {25.9847, 16.9266, 50.6092}, % C5 + {26.0918, 16.6439, 51.8416}, % C6 + u, { + {26.2067, 15.9515, 49.5943}, % O2 + {26.0713, 16.3497, 48.3080}, % O4 + {25.4890, 18.9105, 51.0618}, % H3 + {26.4742, 14.9310, 49.8682}, % H5 + {26.2346, 15.6394, 47.4975}} % H6 + }. + +rUs() -> [rU01(),rU02(),rU03(),rU04(),rU05(),rU06(),rU07(), + rU08(),rU09(),rU10()]. + +rG_() -> + { + {-0.2067, -0.0264, 0.9780, % dgf_base_tfo + 0.9770, -0.0586, 0.2049, + 0.0519, 0.9979, 0.0379, + 1.0331, -46.8078, -36.4742}, + {-0.8644, -0.4956, -0.0851, % p_o3'_275_tfo + -0.0427, 0.2409, -0.9696, + 0.5010, -0.8345, -0.2294, + 4.0167, 54.5377, 12.4779}, + {0.3706, -0.6167, 0.6945, % p_o3'_180_tfo + -0.2867, -0.7872, -0.5460, + 0.8834, 0.0032, -0.4686, + -52.9020, 18.6313, -0.6709}, + {0.4155, 0.9025, -0.1137, % p_o3'_60_tfo + 0.9040, -0.4236, -0.0582, + -0.1007, -0.0786, -0.9918, + -7.6624, -25.2080, 49.5181}, + {31.3810, 0.1400, 47.5810}, % P + {29.9860, 0.6630, 47.6290}, % O1P + {31.7210, -0.6460, 48.8090}, % O2P + {32.4940, 1.2540, 47.2740}, % O5' + {32.1610, 2.2370, 46.2560}, % C5' + {31.2986, 2.8190, 46.5812}, % H5' + {32.0980, 1.7468, 45.2845}, % H5'' + {33.3476, 3.1959, 46.1947}, % C4' + {33.2668, 3.8958, 45.3630}, % H4' + {33.3799, 3.9183, 47.4216}, % O4' + {34.6515, 3.7222, 48.0398}, % C1' + {35.2947, 4.5412, 47.7180}, % H1' + {35.1756, 2.4228, 47.4827}, % C2' + {34.6778, 1.5937, 47.9856}, % H2'' + {36.5631, 2.2672, 47.4798}, % O2' + {37.0163, 2.6579, 48.2305}, % H2' + {34.6953, 2.5043, 46.0448}, % C3' + {34.5444, 1.4917, 45.6706}, % H3' + {35.6679, 3.3009, 45.3487}, % O3' + {37.4804, 4.0914, 52.2559}, % N1 + {36.9670, 4.1312, 49.9281}, % N3 + {37.8045, 4.2519, 50.9550}, % C2 + {35.7171, 3.8264, 50.3222}, % C4 + {35.2668, 3.6420, 51.6115}, % C5 + {36.2037, 3.7829, 52.6706}, % C6 + g, { + {39.0869, 4.5552, 50.7092}, % N2 + {33.9075, 3.3338, 51.6102}, % N7 + {34.6126, 3.6358, 49.5108}, % N9 + {33.5805, 3.3442, 50.3425}, % C8 + {35.9958, 3.6512, 53.8724}, % O6 + {38.2106, 4.2053, 52.9295}, % H1 + {39.8218, 4.6863, 51.3896}, % H21 + {39.3420, 4.6857, 49.7407}, % H22 + {32.5194, 3.1070, 50.2664}} % H8 + }. + +rU_() -> + { + {-0.0109, 0.5907, 0.8068, % dgf_base_tfo + 0.2217, -0.7853, 0.5780, + 0.9751, 0.1852, -0.1224, + -1.4225, -11.0956, -2.5217}, + {-0.8313, -0.4738, -0.2906, % p_o3'_275_tfo + 0.0649, 0.4366, -0.8973, + 0.5521, -0.7648, -0.3322, + 1.6833, 6.8060, -7.0011}, + {0.3445, -0.7630, 0.5470, % p_o3'_180_tfo + -0.4628, -0.6450, -0.6082, + 0.8168, -0.0436, -0.5753, + -6.8179, -3.9778, -5.9887}, + {0.5855, 0.7931, -0.1682, % p_o3'_60_tfo + 0.8103, -0.5790, 0.0906, + -0.0255, -0.1894, -0.9816, + 6.1203, -7.1051, 3.1984}, + {2.6760, -8.4960, 3.2880}, % P + {1.4950, -7.6230, 3.4770}, % O1P + {2.9490, -9.4640, 4.3740}, % O2P + {3.9730, -7.5950, 3.0340}, % O5' + {5.2430, -8.2420, 2.8260}, % C5' + {5.1974, -8.8497, 1.9223}, % H5' + {5.5548, -8.7348, 3.7469}, % H5'' + {6.3140, -7.2060, 2.5510}, % C4' + {5.8744, -6.2116, 2.4731}, % H4' + {7.2798, -7.2260, 3.6420}, % O4' + {8.5733, -6.9410, 3.1329}, % C1' + {8.9047, -6.0374, 3.6446}, % H1' + {8.4429, -6.6596, 1.6327}, % C2' + {9.2880, -7.1071, 1.1096}, % H2'' + {8.2502, -5.2799, 1.4754}, % O2' + {8.7676, -4.7284, 2.0667}, % H2' + {7.1642, -7.4416, 1.3021}, % C3' + {7.4125, -8.5002, 1.2260}, % H3' + {6.5160, -6.9772, 0.1267}, % O3' + {9.4531, -8.1107, 3.4087}, % N1 + {11.5931, -9.0015, 3.6357}, % N3 + {10.8101, -7.8950, 3.3748}, % C2 + {11.1439, -10.2744, 3.9206}, % C4 + {9.7056, -10.4026, 3.9332}, % C5 + {8.9192, -9.3419, 3.6833}, % C6 + u, { + {11.3013, -6.8063, 3.1326}, % O2 + {11.9431, -11.1876, 4.1375}, % O4 + {12.5840, -8.8673, 3.6158}, % H3 + {9.2891, -11.2898, 4.1313}, % H5 + {7.9263, -9.4537, 3.6977}} % H6 + }. + + +% -- PARTIAL INSTANTIATIONS -------------------------------------------------- + +%var ::= {Int, Tfo, Nuc} + +absolute_pos({_I,T,_N}, P) -> tfo_apply(T,P). + +atom_pos(Atom, {I,T,N}) -> + absolute_pos({I,T,N}, p_apply(Atom, N)). + +get_var(Id,[{Id,T,N}|_]) -> {Id,T,N}; +get_var(Id,[_|Lst]) -> get_var(Id,Lst). + +% make_relative_nuc(T, +% { +% Dgf_base_tfo,P_o3__275_tfo,P_o3__180_tfo,P_o3__60_tfo, +% P,O1p,O2p,O5_,C5_,H5_,H5__,C4_,H4_,O4_,C1_,H1_,C2_,H2__,O2_,H2_, +% C3_,H3_,O3_,N1,N3,C2,C4,C5,C6, +% a, {N6,N7,N9,C8,H2,H61,H62,H8} +% }) -> +% { +% Dgf_base_tfo, P_o3__275_tfo, P_o3__180_tfo, P_o3__60_tfo, +% tfo_apply(T, P), +% tfo_apply(T, O1p), +% tfo_apply(T, O2p), +% tfo_apply(T, O5_), +% tfo_apply(T, C5_), +% tfo_apply(T, H5_), +% tfo_apply(T, H5__), +% tfo_apply(T, C4_), +% tfo_apply(T, H4_), +% tfo_apply(T, O4_), +% tfo_apply(T, C1_), +% tfo_apply(T, H1_), +% tfo_apply(T, C2_), +% tfo_apply(T, H2__), +% tfo_apply(T, O2_), +% tfo_apply(T, H2_), +% tfo_apply(T, C3_), +% tfo_apply(T, H3_), +% tfo_apply(T, O3_), +% tfo_apply(T, N1), +% tfo_apply(T, N3), +% tfo_apply(T, C2), +% tfo_apply(T, C4), +% tfo_apply(T, C5), +% tfo_apply(T, C6), +% a, { +% tfo_apply(T, N6), +% tfo_apply(T, N7), +% tfo_apply(T, N9), +% tfo_apply(T, C8), +% tfo_apply(T, H2), +% tfo_apply(T, H61), +% tfo_apply(T, H62), +% tfo_apply(T, H8)} +% }; + +% make_relative_nuc(T, +% { +% Dgf_base_tfo,P_o3__275_tfo,P_o3__180_tfo,P_o3__60_tfo, +% P,O1p,O2p,O5_,C5_,H5_,H5__,C4_,H4_,O4_,C1_,H1_,C2_,H2__,O2_,H2_, +% C3_,H3_,O3_,N1,N3,C2,C4,C5,C6, +% c, {N4,O2,H41,H42,H5,H6} +% }) -> +% { +% Dgf_base_tfo, P_o3__275_tfo, P_o3__180_tfo, P_o3__60_tfo, +% tfo_apply(T, P), +% tfo_apply(T, O1p), +% tfo_apply(T, O2p), +% tfo_apply(T, O5_), +% tfo_apply(T, C5_), +% tfo_apply(T, H5_), +% tfo_apply(T, H5__), +% tfo_apply(T, C4_), +% tfo_apply(T, H4_), +% tfo_apply(T, O4_), +% tfo_apply(T, C1_), +% tfo_apply(T, H1_), +% tfo_apply(T, C2_), +% tfo_apply(T, H2__), +% tfo_apply(T, O2_), +% tfo_apply(T, H2_), +% tfo_apply(T, C3_), +% tfo_apply(T, H3_), +% tfo_apply(T, O3_), +% tfo_apply(T, N1), +% tfo_apply(T, N3), +% tfo_apply(T, C2), +% tfo_apply(T, C4), +% tfo_apply(T, C5), +% tfo_apply(T, C6), +% c, { +% tfo_apply(T, N4), +% tfo_apply(T, O2), +% tfo_apply(T, H41), +% tfo_apply(T, H42), +% tfo_apply(T, H5), +% tfo_apply(T, H6)} +% }; + +% make_relative_nuc(T, +% { +% Dgf_base_tfo,P_o3__275_tfo,P_o3__180_tfo,P_o3__60_tfo, +% P,O1p,O2p,O5_,C5_,H5_,H5__,C4_,H4_,O4_,C1_,H1_,C2_,H2__,O2_,H2_, +% C3_,H3_,O3_,N1,N3,C2,C4,C5,C6, +% g, {N2,N7,N9,C8,O6,H1,H21,H22,H8} +% }) -> +% { +% Dgf_base_tfo, P_o3__275_tfo, P_o3__180_tfo, P_o3__60_tfo, +% tfo_apply(T, P), +% tfo_apply(T, O1p), +% tfo_apply(T, O2p), +% tfo_apply(T, O5_), +% tfo_apply(T, C5_), +% tfo_apply(T, H5_), +% tfo_apply(T, H5__), +% tfo_apply(T, C4_), +% tfo_apply(T, H4_), +% tfo_apply(T, O4_), +% tfo_apply(T, C1_), +% tfo_apply(T, H1_), +% tfo_apply(T, C2_), +% tfo_apply(T, H2__), +% tfo_apply(T, O2_), +% tfo_apply(T, H2_), +% tfo_apply(T, C3_), +% tfo_apply(T, H3_), +% tfo_apply(T, O3_), +% tfo_apply(T, N1), +% tfo_apply(T, N3), +% tfo_apply(T, C2), +% tfo_apply(T, C4), +% tfo_apply(T, C5), +% tfo_apply(T, C6), +% g, { +% tfo_apply(T, N2), +% tfo_apply(T, N7), +% tfo_apply(T, N9), +% tfo_apply(T, C8), +% tfo_apply(T, O6), +% tfo_apply(T, H1), +% tfo_apply(T, H21), +% tfo_apply(T, H22), +% tfo_apply(T, H8)} +% }; + +% make_relative_nuc(T, +% { +% Dgf_base_tfo,P_o3__275_tfo,P_o3__180_tfo,P_o3__60_tfo, +% P,O1p,O2p,O5_,C5_,H5_,H5__,C4_,H4_,O4_,C1_,H1_,C2_,H2__,O2_,H2_, +% C3_,H3_,O3_,N1,N3,C2,C4,C5,C6, +% u, {O2,O4,H3,H5,H6} +% }) -> +% { +% Dgf_base_tfo, P_o3__275_tfo, P_o3__180_tfo, P_o3__60_tfo, +% tfo_apply(T, P), +% tfo_apply(T, O1p), +% tfo_apply(T, O2p), +% tfo_apply(T, O5_), +% tfo_apply(T, C5_), +% tfo_apply(T, H5_), +% tfo_apply(T, H5__), +% tfo_apply(T, C4_), +% tfo_apply(T, H4_), +% tfo_apply(T, O4_), +% tfo_apply(T, C1_), +% tfo_apply(T, H1_), +% tfo_apply(T, C2_), +% tfo_apply(T, H2__), +% tfo_apply(T, O2_), +% tfo_apply(T, H2_), +% tfo_apply(T, C3_), +% tfo_apply(T, H3_), +% tfo_apply(T, O3_), +% tfo_apply(T, N1), +% tfo_apply(T, N3), +% tfo_apply(T, C2), +% tfo_apply(T, C4), +% tfo_apply(T, C5), +% tfo_apply(T, C6), +% u, { +% tfo_apply(T, O2), +% tfo_apply(T, O4), +% tfo_apply(T, H3), +% tfo_apply(T, H5), +% tfo_apply(T, H6)} +% }. + +% -- SEARCH ------------------------------------------------------------------ + +% Sequential backtracking algorithm + +search(Partial_inst,[],_) -> + [Partial_inst]; +search(Partial_inst,[{F,Arg0,Arg1}|T],Constraint) -> + try_assignments(p_apply(F, Arg0,Arg1,Partial_inst), + Constraint, + Partial_inst, + T); +search(Partial_inst,[{F,Arg0,Arg1,Arg2}|T],Constraint) -> + try_assignments(p_apply(F, Arg0,Arg1,Arg2,Partial_inst), + Constraint, + Partial_inst, + T). + +try_assignments([],_,_,_) -> []; +try_assignments([V|Vs], Constraint, Partial_inst,T) -> + case p_apply(Constraint, V, Partial_inst) of + true -> append(search([V|Partial_inst],T,Constraint), + try_assignments(Vs, Constraint, Partial_inst,T)); + _ -> try_assignments(Vs, Constraint, Partial_inst,T) + end. + + +% -- DOMAINS ----------------------------------------------------------------- + +% Primary structure: strand A CUGCCACGUCUG, strand B CAGACGUGGCAG +% +% Secondary structure: strand A CUGCCACGUCUG +% |||||| +% GACGGUGCAGAC strand B +% +% Tertiary structure: +% +% 5' end of strand A C1----G12 3' end of strand B +% U2-------A11 +% G3-------C10 +% C4-----G9 +% C5---G8 +% A6 +% G6-C7 +% C5----G8 +% A4-------U9 +% G3--------C10 +% A2-------U11 +% 5' end of strand B C1----G12 3' end of strand A +% +% "helix", "stacked" and "connected" describe the spatial relationship +% between two consecutive nucleotides. E.g. the nucleotides C1 and U2 +% from the strand A. +% +% "wc" (stands for Watson-Crick and is a type of base-pairing), +% and "wc-dumas" describe the spatial relationship between +% nucleotides from two chains that are growing in opposite directions. +% E.g. the nucleotides C1 from strand A and G12 from strand B. + +% Dynamic Domains + +% Given, +% "ref" a nucleotide which is already positioned, +% "nuc" the nucleotide to be placed, +% and "tfo" a transformation matrix which expresses the desired +% relationship between "ref" and "nuc", +% the function "dgf-base" computes the transformation matrix that +% places the nucleotide "nuc" in the given relationship to "ref". + +dgf_base(Tfo, V, Nuc) -> + {_I,_T,N} = V, + tfo_combine(nuc_dgf_base_tfo(Nuc), + tfo_combine(Tfo,tfo_inv_ortho(process_type(type(N),V)))). + +process_type(a,V) -> + tfo_align(atom_pos(nuc_C1_, V),atom_pos(rA_N9, V),atom_pos(nuc_C4, V)); +process_type(c,V) -> + tfo_align(atom_pos(nuc_C1_, V),atom_pos(nuc_N1, V),atom_pos(nuc_C2, V)); +process_type(g,V) -> + tfo_align(atom_pos(nuc_C1_, V),atom_pos(rG_N9, V),atom_pos(nuc_C4, V)); +process_type(_,V) -> + tfo_align(atom_pos(nuc_C1_, V),atom_pos(nuc_N1, V),atom_pos(nuc_C2, V)). + + +% Placement of first nucleotide. + +reference(Nuc,I,_) -> + [{I,tfo_id(),Nuc}]. + +% The transformation matrix for wc is from: +% +% Chandrasekaran R. et al (1989) A Re-Examination of the Crystal +% Structure of A-DNA Using Fiber Diffraction Data. J. Biomol. +% Struct. & Dynamics 6(6):1189-1202. + +wc_tfo() -> + { + -1.0000, 0.0028, -0.0019, + 0.0028, 0.3468, -0.9379, + -0.0019, -0.9379, -0.3468, + -0.0080, 6.0730, 8.7208 + }. + +wc(Nuc,I,J,Partial_inst) -> + [{I,dgf_base(wc_tfo(),get_var(J,Partial_inst),Nuc),Nuc}]. + +wc_dumas_tfo() -> + { + -0.9737, -0.1834, 0.1352, + -0.1779, 0.2417, -0.9539, + 0.1422, -0.9529, -0.2679, + 0.4837, 6.2649, 8.0285 + }. + +wc_dumas(Nuc,I,J,Partial_inst) -> + [{I,dgf_base(wc_dumas_tfo(),get_var(J,Partial_inst),Nuc),Nuc}]. + +helix5__tfo() -> + { + 0.9886, -0.0961, 0.1156, + 0.1424, 0.8452, -0.5152, + -0.0482, 0.5258, 0.8492, + -3.8737, 0.5480, 3.8024 + }. + +helix5_(Nuc,I,J,Partial_inst) -> + [{I,dgf_base(helix5__tfo(),get_var(J,Partial_inst),Nuc),Nuc}]. + +helix3__tfo() -> + { + 0.9886, 0.1424, -0.0482, + -0.0961, 0.8452, 0.5258, + 0.1156, -0.5152, 0.8492, + 3.4426, 2.0474, -3.7042 + }. + +helix3_(Nuc,I,J,Partial_inst) -> + [{I,dgf_base(helix3__tfo(),get_var(J,Partial_inst),Nuc),Nuc}]. + +g37_a38_tfo() -> + { + 0.9991, 0.0164, -0.0387, + -0.0375, 0.7616, -0.6470, + 0.0189, 0.6478, 0.7615, + -3.3018, 0.9975, 2.5585 + }. + +g37_a38(Nuc,I,J,Partial_inst) -> + {I,dgf_base(g37_a38_tfo(),get_var(J,Partial_inst),Nuc),Nuc}. + +stacked5_(Nuc,I,J,Partial_inst) -> + [g37_a38(Nuc,I,J,Partial_inst) | helix5_(Nuc,I,J,Partial_inst)]. + +a38_g37_tfo() -> + { + 0.9991, -0.0375, 0.0189, + 0.0164, 0.7616, 0.6478, + -0.0387, -0.6470, 0.7615, + 3.3819, 0.7718, -2.5321 + }. + +a38_g37(Nuc,I,J,Partial_inst) -> + {I,dgf_base(a38_g37_tfo(),get_var(J,Partial_inst),Nuc),Nuc}. + +stacked3_(Nuc,I,J,Partial_inst) -> + [a38_g37(Nuc,I,J,Partial_inst) | helix3_(Nuc,I,J,Partial_inst)]. + +p_o3_(Nucs,I,J,Partial_inst) -> + generate([],Nucs,I,J,Partial_inst). + + +generate(Domains,[],_,_,_) -> + Domains; +generate(Domains,[N|Ns],I,J,Partial_inst) -> + Ref = get_var(J,Partial_inst), + Align = tfo_inv_ortho(tfo_align(atom_pos(nuc_O3_,Ref), + atom_pos(nuc_C3_,Ref), + atom_pos(nuc_C4_,Ref))), + generate([{I,tfo_combine(nuc_p_o3__60_tfo(N),Align),N}, + {I,tfo_combine(nuc_p_o3__180_tfo(N),Align),N}, + {I,tfo_combine(nuc_p_o3__275_tfo(N),Align),N} | Domains], + Ns,I,J,Partial_inst). + + +% -- PROBLEM STATEMENT ------------------------------------------------------- + +% Define anticodon problem -- Science 253:1255 Figure 3a, 3b and 3c + +% anticodon_domains() -> +% [ +% {reference, rC(), 27}, +% {helix5_, rC(), 28, 27}, +% {helix5_, rA(), 29, 28}, +% {helix5_, rG(), 30, 29}, +% {helix5_, rA(), 31, 30}, +% {wc, rU(), 39, 31}, +% {helix5_, rC(), 40, 39}, +% {helix5_, rU(), 41, 40}, +% {helix5_, rG(), 42, 41}, +% {helix5_, rG(), 43, 42}, +% {stacked3_, rA(), 38, 39}, +% {stacked3_, rG(), 37, 38}, +% {stacked3_, rA(), 36, 37}, +% {stacked3_, rA(), 35, 36}, +% {stacked3_, rG(), 34, 35}, %<-. Distance +% {p_o3_, rCs(), 32, 31}, % | Constraint +% {p_o3_, rUs(), 33, 32} %<-' 3.0 Angstroms +% ]. + +% Anticodon constraint + +anticodon_constraint({33,T,N},Partial_inst) -> + check0(dist(34,{33,T,N},Partial_inst)); +anticodon_constraint(_,_) -> true. + +check0(Dist) when is_float(Dist), Dist =< 3.0 -> true; +check0(_) -> false. + +dist(J,V,Partial_inst) -> + pt_dist(atom_pos(nuc_P, get_var(J,Partial_inst)), + atom_pos(nuc_O3_,V)). + +% anticodon() -> search([], anticodon_domains(), anticodon_constraint). + +% Define pseudoknot problem -- Science 253:1255 Figure 4a and 4b +pseudoknot_domains() -> + [ + {reference, rA(), 23}, + {wc_dumas, rU(), 8, 23}, + {helix3_, rG(), 22, 23}, + {wc_dumas, rC(), 9, 22}, + {helix3_, rG(), 21, 22}, + {wc_dumas, rC(), 10, 21}, + {helix3_, rC(), 20, 21}, + {wc_dumas, rG(), 11, 20}, + {helix3_, rU_(), 19, 20}, %<-. + {wc_dumas, rA(), 12, 19}, % | Distance +% % | Constraint +% Helix 1 % | 4.0 Angstroms + {helix3_, rC(), 3, 19}, % | + {wc_dumas, rG(), 13, 3}, % | + {helix3_, rC(), 2, 3}, % | + {wc_dumas, rG(), 14, 2}, % | + {helix3_, rC(), 1, 2}, % | + {wc_dumas, rG_(), 15, 1}, % | +% % | +% L2 LOOP % | + {p_o3_, rUs(), 16, 15}, % | + {p_o3_, rCs(), 17, 16}, % | + {p_o3_, rAs(), 18, 17}, %<-' +% +% L1 LOOP + {helix3_, rU(), 7, 8}, %<-. + {p_o3_, rCs(), 4, 3}, % | Constraint + {stacked5_, rU(), 5, 4}, % | 4.5 Angstroms + {stacked5_, rC(), 6, 5} %<-' + ]. + +% Pseudoknot constraint + +pseudoknot_constraint({18,T,N}, Partial_inst) -> + check1(dist(19, {18,T,N}, Partial_inst)); +pseudoknot_constraint({6,T,N}, Partial_inst) -> + check2(dist(7, {6,T,N}, Partial_inst)); +pseudoknot_constraint(_,_) -> true. + +check1(Dist) when is_float(Dist), Dist =< 4.0 -> true; +check1(_) -> false. + +check2(Dist) when is_float(Dist), Dist =< 4.5 -> true; +check2(_) -> false. + +pseudoknot() -> search([], pseudoknot_domains(), pseudoknot_constraint). + +% -- TESTING ----------------------------------------------------------------- + +list_of_atoms(N) -> + append(list_of_common_atoms(N),list_of_specific_atoms(N)). + +list_of_common_atoms + ({ + _,_,_,_, + P,O1p,O2p,O5_,C5_,H5_,H5__,C4_,H4_,O4_,C1_,H1_,C2_,H2__,O2_,H2_, + C3_,H3_,O3_,N1,N3,C2,C4,C5,C6, + _,_ + }) -> + [P,O1p,O2p,O5_,C5_,H5_,H5__,C4_,H4_,O4_,C1_,H1_,C2_,H2__,O2_,H2_, + C3_,H3_,O3_,N1,N3,C2,C4,C5,C6]. + +list_of_specific_atoms({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,a, + {N6,N7,N9,C8,H2,H61,H62,H8}}) -> + [N6,N7,N9,C8,H2,H61,H62,H8]; +list_of_specific_atoms({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,c, + {N4,O2,H41,H42,H5,H6}}) -> + [N4,O2,H41,H42,H5,H6]; +list_of_specific_atoms({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,g, + {N2,N7,N9,C8,O6,H1,H21,H22,H8}}) -> + [N2,N7,N9,C8,O6,H1,H21,H22,H8]; +list_of_specific_atoms({_,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,_, + _,_,_,_,_,_,_,_,_,u, + {O2,O4,H3,H5,H6}}) -> + [O2,O4,H3,H5,H6]. + +var_most_distant_atom(V) -> + {_,_,N} = V, + maximum(map(distance,V,list_of_atoms(N))). + +distance(V,P) -> + {X,Y,Z} = absolute_pos(V,P), + distance(X,Y,Z). + +distance(X,Y,Z) when is_float(X), is_float(Y), is_float(Z) -> + math:sqrt(X * X + Y * Y + Z * Z). + +sol_most_distant_atom(S) -> + maximum(map(var_most_distant_atom,S)). + +most_distant_atom(Sols) -> + maximum(map(sol_most_distant_atom, Sols)). + +maximum([H|T]) -> + max(T,H). + +max([H|T],M) when is_float(H), is_float(M), H > M -> + max(T,H); +max([_|T],M) -> + max(T,M); +max([],M) -> M. + +map(_Func,[]) -> []; +map(Func,[H|T]) -> + [p_apply(Func,H) | map(Func, T)]. + +map(_Func,_Arg,[]) -> []; +map(Func,Arg,[H|T]) -> + [p_apply(Func,Arg,H) | map(Func,Arg,T)]. + +% p_apply implements higher order functions +p_apply(sol_most_distant_atom, S) -> sol_most_distant_atom(S); +p_apply(var_most_distant_atom, V) -> var_most_distant_atom(V); +p_apply(nuc_C1_, X) -> nuc_C1_(X); +p_apply(nuc_C2, X) -> nuc_C2(X); +p_apply(nuc_C3_, X) -> nuc_C3_(X); +p_apply(nuc_C4, X) -> nuc_C4(X); +p_apply(nuc_C4_, X) -> nuc_C4_(X); +p_apply(nuc_N1, X) -> nuc_N1(X); +p_apply(nuc_O3_, X) -> nuc_O3_(X); +p_apply(nuc_P, X) -> nuc_P(X); +p_apply(nuc_dgf_base_tfo, X) -> nuc_dgf_base_tfo(X); +p_apply(nuc_p_o3__180_tfo, X) -> nuc_p_o3__180_tfo(X); +p_apply(nuc_p_o3__275_tfo, X) -> nuc_p_o3__275_tfo(X); +p_apply(nuc_p_o3__60_tfo, X) -> nuc_p_o3__60_tfo(X); +p_apply(rA_N9, X) -> rA_N9(X); +p_apply(rG_N9, X) -> rG_N9(X). + +p_apply(anticodon_constraint, V, P) -> anticodon_constraint(V, P); +p_apply(pseudoknot_constraint, V, P) -> pseudoknot_constraint(V, P); +p_apply(distance, V, P) -> distance(V, P). + +p_apply(reference, A1, A2, A3) -> reference(A1, A2, A3). + +p_apply(helix5_, A1, A2, A3, A4) -> helix5_(A1, A2, A3, A4); +p_apply(wc, A1, A2, A3, A4) -> wc(A1, A2, A3, A4); +p_apply(stacked3_, A1, A2, A3, A4) -> stacked3_(A1, A2, A3, A4); +p_apply(p_o3_, A1, A2, A3, A4) -> p_o3_(A1, A2, A3, A4); +p_apply(wc_dumas, A1, A2, A3, A4) -> wc_dumas(A1, A2, A3, A4); +p_apply(helix3_, A1, A2, A3, A4) -> helix3_(A1, A2, A3, A4); +p_apply(stacked5_, A1, A2, A3, A4) -> stacked5_(A1, A2, A3, A4). + +loop(0,R) -> R; +loop(N,_) -> loop(N-1,most_distant_atom(pseudoknot())). diff --git a/erts/emulator/test/random_iolist.erl b/erts/emulator/test/random_iolist.erl new file mode 100644 index 0000000000..4bce347d9a --- /dev/null +++ b/erts/emulator/test/random_iolist.erl @@ -0,0 +1,195 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Generate random iolists to be used by crypto_SUITE.erl +%% + +-module(random_iolist). + +-export([run/3, run2/3, standard_seed/0, compare/3, compare2/3, + random_iolist/1]). + +run(Iter,Fun1,Fun2) -> + standard_seed(), + compare(Iter,Fun1,Fun2). + +run2(Iter,Fun1,Fun2) -> + standard_seed(), + compare2(Iter,Fun1,Fun2). + +random_byte() -> + random:uniform(256) - 1. + +random_list(0,Acc) -> + Acc; +random_list(N,Acc) -> + random_list(N-1,[random_byte() | Acc]). + +random_binary(N) -> + B = list_to_binary(random_list(N,[])), + case {random:uniform(2),size(B)} of + {2,M} when M > 1 -> + S = M-1, + <<_:3,C:S/binary,_:5>> = B, + C; + _ -> + B + end. +random_list(N) -> + random_list(N,[]). + +front() -> + case random:uniform(10) of + 10 -> + false; + _ -> + true + end. + +any_type() -> + case random:uniform(10) of + 1 -> + list; + 2 -> + binary; + 3 -> + iolist; + _ -> + byte + end. + +tail_type() -> + case random:uniform(5) of + 1 -> + list; + 2 -> + iolist; + _ -> + binary + end. + +random_length(N) -> + UpperLimit = 255, + case N of + M when M > UpperLimit -> + random:uniform(UpperLimit+1) - 1; + _ -> + random:uniform(N+1) - 1 + end. + +random_iolist(0,Acc) -> + Acc; +random_iolist(N,Acc) -> + case front() of + true -> + case any_type() of + list -> + X = random_length(N), + L = random_list(X), + random_iolist(N-X,[L|Acc]); + binary -> + X = random_length(N), + B = random_binary(X), + random_iolist(N-X,[B|Acc]); + iolist -> + X = random_length(N), + B = random_iolist(X), + random_iolist(N-X,[B|Acc]); + byte -> + C = random_byte(), + random_iolist(N-1,[C|Acc]) + end; + false -> + case tail_type() of + list -> + X = random_length(N), + L = random_list(X), + random_iolist(N-X,[Acc|L]); + binary -> + X = random_length(N), + B = random_binary(X), + random_iolist(N-X,[Acc|B]); + iolist -> + X = random_length(N), + B = random_iolist(X), + random_iolist(N-X,[Acc|B]) + end + end. + +random_iolist(N) -> + random_iolist(N,[]). + + +standard_seed() -> + random:seed(1201,855653,380975). + +do_comp(List,F1,F2) -> + X = F1(List), + Y = F2(List), + case X =:= Y of + false -> + exit({not_matching,List,X,Y}); + _ -> + true + end. + +do_comp(List,List2,F1,F2) -> + X = F1(List,List2), + Y = F2(List,List2), + case X =:= Y of + false -> + exit({not_matching,List,List2,X,Y}); + _ -> + true + end. + +compare(0,Fun1,Fun2) -> + do_comp(<<>>,Fun1,Fun2), + do_comp([],Fun1,Fun2), + do_comp([[]|<<>>],Fun1,Fun2), + do_comp([<<>>,[]|<<>>],Fun1,Fun2), + true; + +compare(N,Fun1,Fun2) -> + L = random_iolist(N), + do_comp(L,Fun1,Fun2), + compare(N-1,Fun1,Fun2). + +compare2(0,Fun1,Fun2) -> + L = random_iolist(100), + do_comp(<<>>,L,Fun1,Fun2), + do_comp(L,<<>>,Fun1,Fun2), + do_comp(<<>>,<<>>,Fun1,Fun2), + do_comp([],L,Fun1,Fun2), + do_comp(L,[],Fun1,Fun2), + do_comp([],[],Fun1,Fun2), + do_comp([[]|<<>>],L,Fun1,Fun2), + do_comp(L,[[]|<<>>],Fun1,Fun2), + do_comp([[]|<<>>],[[]|<<>>],Fun1,Fun2), + do_comp([<<>>,[]|<<>>],L,Fun1,Fun2), + do_comp(L,[<<>>,[]|<<>>],Fun1,Fun2), + do_comp([<<>>,[]|<<>>],[<<>>,[]|<<>>],Fun1,Fun2), + true; + +compare2(N,Fun1,Fun2) -> + L = random_iolist(N), + L2 = random_iolist(N), + do_comp(L,L2,Fun1,Fun2), + compare2(N-1,Fun1,Fun2). diff --git a/erts/emulator/test/ref_SUITE.erl b/erts/emulator/test/ref_SUITE.erl new file mode 100644 index 0000000000..fa77095efd --- /dev/null +++ b/erts/emulator/test/ref_SUITE.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ref_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2]). +-export([wrap_1/1]). + +-export([loop_ref/1]). + +-include("test_server.hrl"). + +init_per_testcase(_, Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(2)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +all(suite) -> [wrap_1]. + +wrap_1(doc) -> "Check that refs don't wrap around easily."; +wrap_1(Config) when is_list(Config) -> + ?line spawn_link(?MODULE, loop_ref, [self()]), + ?line receive + done -> + test_server:fail(wrapfast) + after 30000 -> + ok + end, + ok. + +loop_ref(Parent) -> + Ref0 = make_ref(), + loop_ref(Ref0, first, 0), + Parent ! done. + +loop_ref(R, R, _) -> ok; +loop_ref(R0, _, N) -> + loop_ref(R0, make_ref(), N+1). diff --git a/erts/emulator/test/register_SUITE.erl b/erts/emulator/test/register_SUITE.erl new file mode 100644 index 0000000000..c03ee23b2e --- /dev/null +++ b/erts/emulator/test/register_SUITE.erl @@ -0,0 +1,87 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(register_SUITE). + + +%-define(line_trace, 1). + +-include("test_server.hrl"). + +%-compile(export_all). +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([otp_8099/1]). + +-define(DEFAULT_TIMEOUT, ?t:minutes(2)). + +all(doc) -> []; +all(suite) -> + [otp_8099]. + +init_per_testcase(Case, Config) when is_list(Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + [{watchdog, Dog}, {testcase, Case} | Config]. + +fin_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +%% +%% Test cases +%% + +-define(OTP_8099_NAME, otp_8099_reg_proc). + +otp_8099(Config) when is_list(Config) -> + case catch erlang:system_info(lock_counting) of + true -> {skipped, + "Lock counting enabled. Current lock counting " + "implementation cannot handle this many " + "processes."}; + _ -> + otp_8099_test(1000000) + end. + +otp_8099_test(0) -> + ok; +otp_8099_test(N) -> + ?line P = spawn(fun () -> otp_8099_proc() end), + ?line case catch register(?OTP_8099_NAME, P) of + true -> + ?line ok; + _ -> + ?line OP = whereis(?OTP_8099_NAME), + ?line (catch unregister(?OTP_8099_NAME)), + ?line (catch exit(OP, kill)), + ?line true = (catch register(?OTP_8099_NAME, P)) + end, + ?line P = whereis(?OTP_8099_NAME), + ?line exit(P, kill), + ?line otp_8099_test(N-1). + +otp_8099_proc() -> + receive _ -> ok end, + otp_8099_proc(). + +%% +%% Utils +%% + diff --git a/erts/emulator/test/save_calls_SUITE.erl b/erts/emulator/test/save_calls_SUITE.erl new file mode 100644 index 0000000000..b56c4ad0b0 --- /dev/null +++ b/erts/emulator/test/save_calls_SUITE.erl @@ -0,0 +1,256 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(save_calls_SUITE). + +-include("test_server.hrl"). + +-export([all/1]). + +-export([save_calls_1/1,dont_break_reductions/1]). + +-export([do_bopp/1, do_bipp/0, do_bepp/0]). + +all(suite) -> + [save_calls_1, dont_break_reductions]. + +dont_break_reductions(suite) -> + []; +dont_break_reductions(doc) -> + ["Check that save_calls dont break reduction-based scheduling"]; +dont_break_reductions(Config) when is_list(Config) -> + ?line RPS1 = reds_per_sched(0), + ?line RPS2 = reds_per_sched(20), + ?line Diff = abs(RPS1 - RPS2), + ?line true = (Diff < (0.05 * RPS1)), + ok. + + +reds_per_sched(SaveCalls) -> + ?line Parent = self(), + ?line HowMany = 10000, + ?line Pid = spawn(fun() -> + process_flag(save_calls,SaveCalls), + receive + go -> + carmichaels_below(HowMany), + Parent ! erlang:process_info(self(),reductions) + end + end), + ?line TH = spawn(fun() -> trace_handler(0,Parent,Pid) end), + ?line erlang:trace(Pid, true,[running,procs,{tracer,TH}]), + ?line Pid ! go, + ?line {Sched,Reds} = receive + {accumulated,X} -> + receive {reductions,Y} -> + {X,Y} + after 30000 -> + timeout + end + after 30000 -> + timeout + end, + ?line Reds div Sched. + + + +trace_handler(Acc,Parent,Client) -> + receive + {trace,Client,out,_} -> + trace_handler(Acc+1,Parent,Client); + {trace,Client,exit,_} -> + Parent ! {accumulated, Acc}; + _ -> + trace_handler(Acc,Parent,Client) + after 10000 -> + ok + end. + +save_calls_1(doc) -> "Test call saving."; +save_calls_1(Config) when is_list(Config) -> + case test_server:is_native(?MODULE) of + true -> {skipped,"Native code"}; + false -> save_calls_1() + end. + +save_calls_1() -> + ?line erlang:process_flag(self(), save_calls, 0), + ?line {last_calls, false} = process_info(self(), last_calls), + + ?line erlang:process_flag(self(), save_calls, 10), + ?line {last_calls, _L1} = process_info(self(), last_calls), + ?line ?MODULE:do_bipp(), + ?line {last_calls, L2} = process_info(self(), last_calls), + ?line L21 = lists:filter(fun is_local_function/1, L2), + ?line case L21 of + [{?MODULE,do_bipp,0}, + timeout, + 'send', + {?MODULE,do_bopp,1}, + 'receive', + timeout, + {?MODULE,do_bepp,0}] -> + ok; + X -> + test_server:fail({l21, X}) + end, + + ?line erlang:process_flag(self(), save_calls, 10), + ?line {last_calls, L3} = process_info(self(), last_calls), + ?line L31 = lists:filter(fun is_local_function/1, L3), + ?line [] = L31, + ok. + +do_bipp() -> + do_bopp(0), + do_bapp(), + ?MODULE:do_bopp(0), + do_bopp(3), + apply(?MODULE, do_bepp, []). + +do_bapp() -> + self() ! heffaklump. + +do_bopp(T) -> + receive + X -> X + after T -> ok + end. + +do_bepp() -> + ok. + +is_local_function({?MODULE, _, _}) -> + true; +is_local_function({_, _, _}) -> + false; +is_local_function(_) -> + true. + + +% Number crunching for reds test. +carmichaels_below(N) -> + random:seed(3172,9814,20125), + carmichaels_below(1,N). + +carmichaels_below(N,N2) when N >= N2 -> + 0; +carmichaels_below(N,N2) -> + X = case fast_prime(N,10) of + false -> 0; + true -> + case fast_prime2(N,10) of + true -> + %io:format("Prime: ~p~n",[N]), + 0; + false -> + io:format("Carmichael: ~p (dividable by ~p)~n", + [N,smallest_divisor(N)]), + 1 + end + end, + X+carmichaels_below(N+2,N2). + +expmod(_,E,_) when E == 0 -> + 1; +expmod(Base,Exp,Mod) when (Exp rem 2) == 0 -> + X = expmod(Base,Exp div 2,Mod), + (X*X) rem Mod; +expmod(Base,Exp,Mod) -> + (Base * expmod(Base,Exp - 1,Mod)) rem Mod. + +uniform(N) -> + random:uniform(N-1). + +fermat(N) -> + R = uniform(N), + expmod(R,N,N) == R. + +do_fast_prime(1,_) -> + true; +do_fast_prime(_N,0) -> + true; +do_fast_prime(N,Times) -> + case fermat(N) of + true -> + do_fast_prime(N,Times-1); + false -> + false + end. + +fast_prime(N,T) -> + do_fast_prime(N,T). + +expmod2(_,E,_) when E == 0 -> + 1; +expmod2(Base,Exp,Mod) when (Exp rem 2) == 0 -> +%% Uncomment the code below to simulate scheduling bug! +% case erlang:process_info(self(),last_calls) of +% {last_calls,false} -> ok; +% _ -> erlang:yield() +% end, + X = expmod2(Base,Exp div 2,Mod), + Y=(X*X) rem Mod, + if + Y == 1, X =/= 1, X =/= (Mod - 1) -> + 0; + true -> + Y rem Mod + end; +expmod2(Base,Exp,Mod) -> + (Base * expmod2(Base,Exp - 1,Mod)) rem Mod. + +miller_rabbin(N) -> + R = uniform(N), + expmod2(R,N,N) == R. + +do_fast_prime2(1,_) -> + true; +do_fast_prime2(_N,0) -> + true; +do_fast_prime2(N,Times) -> + case miller_rabbin(N) of + true -> + do_fast_prime2(N,Times-1); + false -> + false + end. + +fast_prime2(N,T) -> + do_fast_prime2(N,T). + +smallest_divisor(N) -> + find_divisor(N,2). + +find_divisor(N,TD) -> + if + TD*TD > N -> + N; + true -> + case divides(TD,N) of + true -> + TD; + false -> + find_divisor(N,TD+1) + end + end. + +divides(A,B) -> + (B rem A) == 0. + diff --git a/erts/emulator/test/scheduler_SUITE.erl b/erts/emulator/test/scheduler_SUITE.erl new file mode 100644 index 0000000000..e644ad4dc8 --- /dev/null +++ b/erts/emulator/test/scheduler_SUITE.erl @@ -0,0 +1,1378 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + + +%%%------------------------------------------------------------------- +%%% File : scheduler_SUITE.erl +%%% Author : Rickard Green +%%% Description : +%%% +%%% Created : 27 Oct 2008 by Rickard Green +%%%------------------------------------------------------------------- +-module(scheduler_SUITE). + + +%-define(line_trace, 1). + +-include("test_server.hrl"). + +%-compile(export_all). +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([equal/1, + few_low/1, + many_low/1, + equal_with_part_time_high/1, + equal_with_part_time_max/1, + equal_and_high_with_part_time_max/1, + equal_with_high/1, + equal_with_high_max/1, + bound_process/1, + scheduler_bind/1, + scheduler_bind_types/1, + cpu_topology/1, + sct_cmd/1, + sbt_cmd/1]). + +-define(DEFAULT_TIMEOUT, ?t:minutes(10)). + +-define(MIN_SCHEDULER_TEST_TIMEOUT, ?t:minutes(1)). + +all(doc) -> []; +all(suite) -> + [equal, + few_low, + many_low, + equal_with_part_time_high, + equal_with_part_time_max, + equal_and_high_with_part_time_max, + equal_with_high, + equal_with_high_max, + bound_process, + scheduler_bind]. + +init_per_testcase(Case, Config) when is_list(Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + process_flag(priority, max), + erlang:display({'------------', ?MODULE, Case, '------------'}), + OkRes = ok, + [{watchdog, Dog}, {testcase, Case}, {ok_res, OkRes} |Config]. + +fin_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +-define(ERTS_RUNQ_CHECK_BALANCE_REDS_PER_SCHED, (2000*2000)). +-define(DEFAULT_TEST_REDS_PER_SCHED, 200000000). + +%% +%% Test cases +%% + +equal(Config) when is_list(Config) -> + low_normal_test(Config, 500, 500). + +few_low(Config) when is_list(Config) -> + low_normal_test(Config, 1000, 2*active_schedulers()). + +many_low(Config) when is_list(Config) -> + low_normal_test(Config, 2*active_schedulers(), 1000). + +low_normal_test(Config, NW, LW) -> + ?line Tracer = start_tracer(), + ?line Low = workers(LW, low), + ?line Normal = workers(NW, normal), + ?line Res = do_it(Tracer, Low, Normal, [], []), + ?line chk_result(Res, LW, NW, 0, 0, true, false, false), + ?line workers_exit([Low, Normal]), + ?line ok(Res, Config). + +equal_with_part_time_high(Config) when is_list(Config) -> + ?line NW = 500, + ?line LW = 500, + ?line HW = 1, + ?line Tracer = start_tracer(), + ?line Normal = workers(NW, normal), + ?line Low = workers(LW, low), + ?line High = part_time_workers(HW, high), + ?line Res = do_it(Tracer, Low, Normal, High, []), + ?line chk_result(Res, LW, NW, HW, 0, true, true, false), + ?line workers_exit([Low, Normal, High]), + ?line ok(Res, Config). + +equal_and_high_with_part_time_max(Config) when is_list(Config) -> + ?line NW = 500, + ?line LW = 500, + ?line HW = 500, + ?line MW = 1, + ?line Tracer = start_tracer(), + ?line Low = workers(LW, low), + ?line Normal = workers(NW, normal), + ?line High = workers(HW, high), + ?line Max = part_time_workers(MW, max), + ?line Res = do_it(Tracer, Low, Normal, High, Max), + ?line chk_result(Res, LW, NW, HW, MW, false, true, true), + ?line workers_exit([Low, Normal, Max]), + ?line ok(Res, Config). + +equal_with_part_time_max(Config) when is_list(Config) -> + ?line NW = 500, + ?line LW = 500, + ?line MW = 1, + ?line Tracer = start_tracer(), + ?line Low = workers(LW, low), + ?line Normal = workers(NW, normal), + ?line Max = part_time_workers(MW, max), + ?line Res = do_it(Tracer, Low, Normal, [], Max), + ?line chk_result(Res, LW, NW, 0, MW, true, false, true), + ?line workers_exit([Low, Normal, Max]), + ?line ok(Res, Config). + +equal_with_high(Config) when is_list(Config) -> + ?line NW = 500, + ?line LW = 500, + ?line HW = 1, + ?line Tracer = start_tracer(), + ?line Low = workers(LW, low), + ?line Normal = workers(NW, normal), + ?line High = workers(HW, high), + ?line Res = do_it(Tracer, Low, Normal, High, []), + ?line LNExe = case active_schedulers() of + S when S =< HW -> false; + _ -> true + end, + ?line chk_result(Res, LW, NW, HW, 0, LNExe, true, false), + ?line workers_exit([Low, Normal, High]), + ?line ok(Res, Config). + +equal_with_high_max(Config) when is_list(Config) -> + ?line NW = 500, + ?line LW = 500, + ?line HW = 1, + ?line MW = 1, + ?line Tracer = start_tracer(), + ?line Normal = workers(NW, normal), + ?line Low = workers(LW, low), + ?line High = workers(HW, high), + ?line Max = workers(MW, max), + ?line Res = do_it(Tracer, Low, Normal, High, Max), + ?line {LNExe, HExe} = case active_schedulers() of + S when S =< MW -> {false, false}; + S when S =< (MW + HW) -> {false, true}; + _ -> {true, true} + end, + ?line chk_result(Res, LW, NW, HW, MW, LNExe, HExe, true), + ?line workers_exit([Low, Normal, Max]), + ?line ok(Res, Config). + +bound_process(Config) when is_list(Config) -> + case erlang:system_info(run_queues) == erlang:system_info(schedulers) of + true -> + ?line NStartBase = 20000, + ?line NStart = case {erlang:system_info(debug_compiled), + erlang:system_info(lock_checking)} of + {true, true} -> NStartBase div 100; + {_, true} -> NStartBase div 10; + _ -> NStartBase + end, + ?line MStart = 100, + ?line Seq = lists:seq(1, 100), + ?line Tester = self(), + ?line Procs = lists:map( + fun (N) when N rem 2 == 0 -> + spawn_opt(fun () -> + bound_loop(NStart, + NStart, + MStart, + 1), + Tester ! {self(), done} + end, + [{scheduler, 1}, link]); + (_N) -> + spawn_link(fun () -> + bound_loop(NStart, + NStart, + MStart, + false), + Tester ! {self(), done} + end) + end, + Seq), + ?line lists:foreach(fun (P) -> receive {P, done} -> ok end end, + Procs), + ?line ok; + false -> + {skipped, "Functionality not supported"} + end. + +bound_loop(_, 0, 0, _) -> + ok; +bound_loop(NS, 0, M, false) -> + bound_loop(NS, NS, M-1, false); +bound_loop(NS, N, M, false) -> + erlang:system_info(scheduler_id), + bound_loop(NS, N-1, M, false); +bound_loop(NS, 0, M, Sched) -> + NewSched = (Sched rem erlang:system_info(schedulers_online)) + 1, + Sched = process_flag(scheduler, NewSched), + NewSched = erlang:system_info(scheduler_id), + bound_loop(NS, NS, M-1, NewSched); +bound_loop(NS, N, M, Sched) -> + Sched = erlang:system_info(scheduler_id), + bound_loop(NS, N-1, M, Sched). + +scheduler_bind(suite) -> + [scheduler_bind_types, + cpu_topology, + sct_cmd, + sbt_cmd]. + +-define(TOPOLOGY_A_CMD, + "+sct" + "L0-1t0-1c0p0n0" + ":L2-3t0-1c1p0n0" + ":L4-5t0-1c0p1n0" + ":L6-7t0-1c1p1n0" + ":L8-9t0-1c0p2n1" + ":L10-11t0-1c1p2n1" + ":L12-13t0-1c0p3n1" + ":L14-15t0-1c1p3n1"). + +-define(TOPOLOGY_A_TERM, + [{node,[{processor,[{core,[{thread,{logical,0}}, + {thread,{logical,1}}]}, + {core,[{thread,{logical,2}}, + {thread,{logical,3}}]}]}, + {processor,[{core,[{thread,{logical,4}}, + {thread,{logical,5}}]}, + {core,[{thread,{logical,6}}, + {thread,{logical,7}}]}]}]}, + {node,[{processor,[{core,[{thread,{logical,8}}, + {thread,{logical,9}}]}, + {core,[{thread,{logical,10}}, + {thread,{logical,11}}]}]}, + {processor,[{core,[{thread,{logical,12}}, + {thread,{logical,13}}]}, + {core,[{thread,{logical,14}}, + {thread,{logical,15}}]}]}]}]). + +-define(TOPOLOGY_B_CMD, + "+sct" + "L0-1t0-1c0n0p0" + ":L2-3t0-1c1n0p0" + ":L4-5t0-1c2n1p0" + ":L6-7t0-1c3n1p0" + ":L8-9t0-1c0n2p1" + ":L10-11t0-1c1n2p1" + ":L12-13t0-1c2n3p1" + ":L14-15t0-1c3n3p1"). + +-define(TOPOLOGY_B_TERM, + [{processor,[{node,[{core,[{thread,{logical,0}}, + {thread,{logical,1}}]}, + {core,[{thread,{logical,2}}, + {thread,{logical,3}}]}]}, + {node,[{core,[{thread,{logical,4}}, + {thread,{logical,5}}]}, + {core,[{thread,{logical,6}}, + {thread,{logical,7}}]}]}]}, + {processor,[{node,[{core,[{thread,{logical,8}}, + {thread,{logical,9}}]}, + {core,[{thread,{logical,10}}, + {thread,{logical,11}}]}]}, + {node,[{core,[{thread,{logical,12}}, + {thread,{logical,13}}]}, + {core,[{thread,{logical,14}}, + {thread,{logical,15}}]}]}]}]). + +-define(TOPOLOGY_C_TERM, + [{node,[{processor,[{core,[{thread,{logical,0}}, + {thread,{logical,1}}]}, + {core,[{thread,{logical,2}}, + {thread,{logical,3}}]}]}, + {processor,[{core,[{thread,{logical,4}}, + {thread,{logical,5}}]}, + {core,[{thread,{logical,6}}, + {thread,{logical,7}}]}]}]}, + {processor,[{node,[{core,[{thread,{logical,8}}, + {thread,{logical,9}}]}, + {core,[{thread,{logical,10}}, + {thread,{logical,11}}]}]}, + {node,[{core,[{thread,{logical,12}}, + {thread,{logical,13}}]}, + {core,[{thread,{logical,14}}, + {thread,{logical,15}}]}]}]}, + {node,[{processor,[{core,[{thread,{logical,16}}, + {thread,{logical,17}}]}, + {core,[{thread,{logical,18}}, + {thread,{logical,19}}]}]}, + {processor,[{core,[{thread,{logical,20}}, + {thread,{logical,21}}]}, + {core,[{thread,{logical,22}}, + {thread,{logical,23}}]}]}]}, + {processor,[{node,[{core,[{thread,{logical,24}}, + {thread,{logical,25}}]}, + {core,[{thread,{logical,26}}, + {thread,{logical,27}}]}]}, + {node,[{core,[{thread,{logical,28}}, + {thread,{logical,29}}]}, + {core,[{thread,{logical,30}}, + {thread,{logical,31}}]}]}]}]). + + +-define(TOPOLOGY_C_CMD, + "+sct" + "L0-1t0-1c0p0n0" + ":L2-3t0-1c1p0n0" + ":L4-5t0-1c0p1n0" + ":L6-7t0-1c1p1n0" + ":L8-9t0-1c0n1p2" + ":L10-11t0-1c1n1p2" + ":L12-13t0-1c2n2p2" + ":L14-15t0-1c3n2p2" + ":L16-17t0-1c0p3n3" + ":L18-19t0-1c1p3n3" + ":L20-21t0-1c0p4n3" + ":L22-23t0-1c1p4n3" + ":L24-25t0-1c0n4p5" + ":L26-27t0-1c1n4p5" + ":L28-29t0-1c2n5p5" + ":L30-31t0-1c3n5p5"). + +-define(TOPOLOGY_D_TERM, + [{processor,[{node,[{core,[{thread,{logical,0}}, + {thread,{logical,1}}]}, + {core,[{thread,{logical,2}}, + {thread,{logical,3}}]}]}, + {node,[{core,[{thread,{logical,4}}, + {thread,{logical,5}}]}, + {core,[{thread,{logical,6}}, + {thread,{logical,7}}]}]}]}, + {node,[{processor,[{core,[{thread,{logical,8}}, + {thread,{logical,9}}]}, + {core,[{thread,{logical,10}}, + {thread,{logical,11}}]}]}, + {processor,[{core,[{thread,{logical,12}}, + {thread,{logical,13}}]}, + {core,[{thread,{logical,14}}, + {thread,{logical,15}}]}]}]}, + {processor,[{node,[{core,[{thread,{logical,16}}, + {thread,{logical,17}}]}, + {core,[{thread,{logical,18}}, + {thread,{logical,19}}]}]}, + {node,[{core,[{thread,{logical,20}}, + {thread,{logical,21}}]}, + {core,[{thread,{logical,22}}, + {thread,{logical,23}}]}]}]}, + {node,[{processor,[{core,[{thread,{logical,24}}, + {thread,{logical,25}}]}, + {core,[{thread,{logical,26}}, + {thread,{logical,27}}]}]}, + {processor,[{core,[{thread,{logical,28}}, + {thread,{logical,29}}]}, + {core,[{thread,{logical,30}}, + {thread,{logical,31}}]}]}]}]). + +-define(TOPOLOGY_D_CMD, + "+sct" + "L0-1t0-1c0n0p0" + ":L2-3t0-1c1n0p0" + ":L4-5t0-1c2n1p0" + ":L6-7t0-1c3n1p0" + ":L8-9t0-1c0p1n2" + ":L10-11t0-1c1p1n2" + ":L12-13t0-1c0p2n2" + ":L14-15t0-1c1p2n2" + ":L16-17t0-1c0n3p3" + ":L18-19t0-1c1n3p3" + ":L20-21t0-1c2n4p3" + ":L22-23t0-1c3n4p3" + ":L24-25t0-1c0p4n5" + ":L26-27t0-1c1p4n5" + ":L28-29t0-1c0p5n5" + ":L30-31t0-1c1p5n5"). + +-define(TOPOLOGY_E_CMD, + "+sct" + "L0-1t0-1c0p0n0" + ":L2-3t0-1c1p0n0" + ":L4-5t0-1c2p0n0" + ":L6-7t0-1c3p0n0" + ":L8-9t0-1c0p1n1" + ":L10-11t0-1c1p1n1" + ":L12-13t0-1c2p1n1" + ":L14-15t0-1c3p1n1"). + +-define(TOPOLOGY_E_TERM, + [{node,[{processor,[{core,[{thread,{logical,0}}, + {thread,{logical,1}}]}, + {core,[{thread,{logical,2}}, + {thread,{logical,3}}]}, + {core,[{thread,{logical,4}}, + {thread,{logical,5}}]}, + {core,[{thread,{logical,6}}, + {thread,{logical,7}}]}]}]}, + {node,[{processor,[{core,[{thread,{logical,8}}, + {thread,{logical,9}}]}, + {core,[{thread,{logical,10}}, + {thread,{logical,11}}]}, + {core,[{thread,{logical,12}}, + {thread,{logical,13}}]}, + {core,[{thread,{logical,14}}, + {thread,{logical,15}}]}]}]}]). + +-define(TOPOLOGY_F_CMD, + "+sct" + "L0-1t0-1c0n0p0" + ":L2-3t0-1c1n0p0" + ":L4-5t0-1c2n0p0" + ":L6-7t0-1c3n0p0" + ":L8-9t0-1c4n1p0" + ":L10-11t0-1c5n1p0" + ":L12-13t0-1c6n1p0" + ":L14-15t0-1c7n1p0" + ":L16-17t0-1c8n2p0" + ":L18-19t0-1c9n2p0" + ":L20-21t0-1c10n2p0" + ":L22-23t0-1c11n2p0" + ":L24-25t0-1c12n3p0" + ":L26-27t0-1c13n3p0" + ":L28-29t0-1c14n3p0" + ":L30-31t0-1c15n3p0"). + +-define(TOPOLOGY_F_TERM, + [{processor,[{node,[{core,[{thread,{logical,0}}, + {thread,{logical,1}}]}, + {core,[{thread,{logical,2}}, + {thread,{logical,3}}]}, + {core,[{thread,{logical,4}}, + {thread,{logical,5}}]}, + {core,[{thread,{logical,6}}, + {thread,{logical,7}}]}]}, + {node,[{core,[{thread,{logical,8}}, + {thread,{logical,9}}]}, + {core,[{thread,{logical,10}}, + {thread,{logical,11}}]}, + {core,[{thread,{logical,12}}, + {thread,{logical,13}}]}, + {core,[{thread,{logical,14}}, + {thread,{logical,15}}]}]}, + {node,[{core,[{thread,{logical,16}}, + {thread,{logical,17}}]}, + {core,[{thread,{logical,18}}, + {thread,{logical,19}}]}, + {core,[{thread,{logical,20}}, + {thread,{logical,21}}]}, + {core,[{thread,{logical,22}}, + {thread,{logical,23}}]}]}, + {node,[{core,[{thread,{logical,24}}, + {thread,{logical,25}}]}, + {core,[{thread,{logical,26}}, + {thread,{logical,27}}]}, + {core,[{thread,{logical,28}}, + {thread,{logical,29}}]}, + {core,[{thread,{logical,30}}, + {thread,{logical,31}}]}]}]}]). + +bindings(Node, BindType) -> + Parent = self(), + Ref = make_ref(), + spawn_link(Node, + fun () -> + enable_internal_state(), + Res = (catch erts_debug:get_internal_state( + {fake_scheduler_bindings, BindType})), + Parent ! {Ref, Res} + end), + receive + {Ref, Res} -> + ?t:format("~p: ~p~n", [BindType, Res]), + Res + end. + +scheduler_bind_types(Config) when is_list(Config) -> + ?line OldRelFlags = clear_erl_rel_flags(), + try + scheduler_bind_types_test(Config, + ?TOPOLOGY_A_TERM, + ?TOPOLOGY_A_CMD, + a), + scheduler_bind_types_test(Config, + ?TOPOLOGY_B_TERM, + ?TOPOLOGY_B_CMD, + b), + scheduler_bind_types_test(Config, + ?TOPOLOGY_C_TERM, + ?TOPOLOGY_C_CMD, + c), + scheduler_bind_types_test(Config, + ?TOPOLOGY_D_TERM, + ?TOPOLOGY_D_CMD, + d), + scheduler_bind_types_test(Config, + ?TOPOLOGY_E_TERM, + ?TOPOLOGY_E_CMD, + e), + scheduler_bind_types_test(Config, + ?TOPOLOGY_F_TERM, + ?TOPOLOGY_F_CMD, + f) + after + restore_erl_rel_flags(OldRelFlags) + end, + ?line ok. + +scheduler_bind_types_test(Config, Topology, CmdLine, TermLetter) -> + ?line ?t:format("Testing (~p): ~p~n", [TermLetter, Topology]), + ?line {ok, Node0} = start_node(Config), + ?line _ = rpc:call(Node0, erlang, system_flag, [cpu_topology, Topology]), + ?line cmp(Topology, rpc:call(Node0, erlang, system_info, [cpu_topology])), + ?line check_bind_types(Node0, TermLetter), + ?line stop_node(Node0), + ?line {ok, Node1} = start_node(Config, CmdLine), + ?line cmp(Topology, rpc:call(Node1, erlang, system_info, [cpu_topology])), + ?line check_bind_types(Node1, TermLetter), + ?line stop_node(Node1). + +check_bind_types(Node, a) -> + ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + ?line {0,4,8,12,2,6,10,14,1,5,9,13,3,7,11,15} + = bindings(Node, processor_spread), + ?line {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} + = bindings(Node, spread), + ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_thread_spread), + ?line {0,4,2,6,1,5,3,7,8,12,10,14,9,13,11,15} + = bindings(Node, no_node_processor_spread), + ?line {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} + = bindings(Node, thread_no_node_processor_spread), + ?line {0,4,2,6,8,12,10,14,1,5,3,7,9,13,11,15} + = bindings(Node, default_bind), + ?line ok; +check_bind_types(Node, b) -> + ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, processor_spread), + ?line {0,8,4,12,2,10,6,14,1,9,5,13,3,11,7,15} + = bindings(Node, spread), + ?line {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} + = bindings(Node, no_node_thread_spread), + ?line {0,2,1,3,4,6,5,7,8,10,9,11,12,14,13,15} + = bindings(Node, no_node_processor_spread), + ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_no_node_processor_spread), + ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, default_bind), + ?line ok; +check_bind_types(Node, c) -> + ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + ?line {0,4,8,16,20,24,2,6,10,18,22,26,12,28,14,30,1,5,9,17,21,25, + 3,7,11,19,23,27,13,29,15,31} = bindings(Node, processor_spread), + ?line {0,8,16,24,4,20,12,28,2,10,18,26,6,22,14,30,1,9,17,25,5,21,13,29,3,11, + 19,27,7,23,15,31} = bindings(Node, spread), + ?line {0,2,4,6,1,3,5,7,8,10,9,11,12,14,13,15,16,18,20,22,17,19,21,23,24,26, + 25,27,28,30,29,31} = bindings(Node, no_node_thread_spread), + ?line {0,4,2,6,1,5,3,7,8,10,9,11,12,14,13,15,16,20,18,22,17,21,19,23,24,26, + 25,27,28,30,29,31} = bindings(Node, no_node_processor_spread), + ?line {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, + 19,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), + ?line {0,4,2,6,8,10,12,14,16,20,18,22,24,26,28,30,1,5,3,7,9,11,13,15,17,21, + 19,23,25,27,29,31} = bindings(Node, default_bind), + ?line ok; +check_bind_types(Node, d) -> + ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + ?line {0,8,12,16,24,28,2,10,14,18,26,30,4,20,6,22,1,9,13,17,25,29,3,11,15, + 19,27,31,5,21,7,23} = bindings(Node, processor_spread), + ?line {0,8,16,24,12,28,4,20,2,10,18,26,14,30,6,22,1,9,17,25,13,29,5,21,3,11, + 19,27,15,31,7,23} = bindings(Node, spread), + ?line {0,2,1,3,4,6,5,7,8,10,12,14,9,11,13,15,16,18,17,19,20,22,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), + ?line {0,2,1,3,4,6,5,7,8,12,10,14,9,13,11,15,16,18,17,19,20,22,21,23,24,28, + 26,30,25,29,27,31} = bindings(Node, no_node_processor_spread), + ?line {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, + 21,23,25,29,27,31} = bindings(Node, thread_no_node_processor_spread), + ?line {0,2,4,6,8,12,10,14,16,18,20,22,24,28,26,30,1,3,5,7,9,13,11,15,17,19, + 21,23,25,29,27,31} = bindings(Node, default_bind), + ?line ok; +check_bind_types(Node, e) -> + ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} + = bindings(Node, no_spread), + ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_spread), + ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, processor_spread), + ?line {0,8,2,10,4,12,6,14,1,9,3,11,5,13,7,15} + = bindings(Node, spread), + ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_thread_spread), + ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15} + = bindings(Node, no_node_processor_spread), + ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, thread_no_node_processor_spread), + ?line {0,2,4,6,8,10,12,14,1,3,5,7,9,11,13,15} + = bindings(Node, default_bind), + ?line ok; +check_bind_types(Node, f) -> + ?line {0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24, + 25,26,27,28,29,30,31} = bindings(Node, no_spread), + ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15, + 17,19,21,23,25,27,29,31} = bindings(Node, thread_spread), + ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13, + 15,17,19,21,23,25,27,29,31} = bindings(Node, processor_spread), + ?line {0,8,16,24,2,10,18,26,4,12,20,28,6,14,22,30,1,9,17,25,3,11,19,27,5,13, + 21,29,7,15,23,31} = bindings(Node, spread), + ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_thread_spread), + ?line {0,2,4,6,1,3,5,7,8,10,12,14,9,11,13,15,16,18,20,22,17,19,21,23,24,26, + 28,30,25,27,29,31} = bindings(Node, no_node_processor_spread), + ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, + 21,23,25,27,29,31} = bindings(Node, thread_no_node_processor_spread), + ?line {0,2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,1,3,5,7,9,11,13,15,17,19, + 21,23,25,27,29,31} = bindings(Node, default_bind), + ?line ok; +check_bind_types(Node, _) -> + ?line bindings(Node, no_spread), + ?line bindings(Node, thread_spread), + ?line bindings(Node, processor_spread), + ?line bindings(Node, spread), + ?line bindings(Node, no_node_thread_spread), + ?line bindings(Node, no_node_processor_spread), + ?line bindings(Node, thread_no_node_processor_spread), + ?line bindings(Node, default_bind), + ?line ok. + +cpu_topology(Config) when is_list(Config) -> + ?line OldRelFlags = clear_erl_rel_flags(), + try + ?line cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}]}, + {processor,[{node,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {node,[{processor,[{core,{logical,4}}, + {core,{logical,5}}]}]}, + {processor,[{node,[{core,{logical,6}}, + {core,{logical,7}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1n1p1" + ":L4-5c0-1p2n2" + ":L6-7c0-1n3p3"), + ?line cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}, + {processor,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {processor,[{node,[{core,{logical,4}}, + {core,{logical,5}}]}, + {node,[{core,{logical,6}}, + {core,{logical,7}}]}]}, + {node,[{processor,[{core,{logical,8}}, + {core,{logical,9}}]}, + {processor,[{core,{logical,10}}, + {core,{logical,11}}]}]}, + {processor,[{node,[{core,{logical,12}}, + {core,{logical,13}}]}, + {node,[{core,{logical,14}}, + {core,{logical,15}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1p1n0" + ":L4-5c0-1n1p2" + ":L6-7c2-3n2p2" + ":L8-9c0-1p3n3" + ":L10-11c0-1p4n3" + ":L12-13c0-1n4p5" + ":L14-15c2-3n5p5"), + ?line cpu_topology_test( + Config, + [{node,[{processor,[{core,{logical,0}}, + {core,{logical,1}}]}]}, + {processor,[{node,[{core,{logical,2}}, + {core,{logical,3}}]}]}, + {processor,[{node,[{core,{logical,4}}, + {core,{logical,5}}]}]}, + {node,[{processor,[{core,{logical,6}}, + {core,{logical,7}}]}]}, + {node,[{processor,[{core,{logical,8}}, + {core,{logical,9}}]}]}, + {processor,[{node,[{core,{logical,10}}, + {core,{logical,11}}]}]}], + "+sct " + "L0-1c0-1p0n0" + ":L2-3c0-1n1p1" + ":L4-5c0-1n2p2" + ":L6-7c0-1p3n3" + ":L8-9c0-1p4n4" + ":L10-11c0-1n5p5") + after + restore_erl_rel_flags(OldRelFlags) + end, + ?line ok. + +cpu_topology_test(Config, Topology, Cmd) -> + ?line ?t:format("Testing~n ~p~n ~p~n", [Topology, Cmd]), + ?line cpu_topology_bif_test(Config, Topology), + ?line cpu_topology_cmdline_test(Config, Topology, Cmd), + ?line ok. + +cpu_topology_bif_test(_Config, false) -> + ?line ok; +cpu_topology_bif_test(Config, Topology) -> + ?line {ok, Node} = start_node(Config), + ?line _ = rpc:call(Node, erlang, system_flag, [cpu_topology, Topology]), + ?line cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), + ?line stop_node(Node), + ?line ok. + +cpu_topology_cmdline_test(_Config, _Topology, false) -> + ?line ok; +cpu_topology_cmdline_test(Config, Topology, Cmd) -> + ?line {ok, Node} = start_node(Config, Cmd), + ?line cmp(Topology, rpc:call(Node, erlang, system_info, [cpu_topology])), + ?line stop_node(Node), + ?line ok. + +sct_cmd(Config) when is_list(Config) -> + ?line Topology = ?TOPOLOGY_A_TERM, + ?line OldRelFlags = clear_erl_rel_flags(), + try + ?line {ok, Node} = start_node(Config, ?TOPOLOGY_A_CMD), + ?line cmp(Topology, + rpc:call(Node, erlang, system_info, [cpu_topology])), + ?line cmp(Topology, + rpc:call(Node, erlang, system_flag, [cpu_topology, Topology])), + ?line cmp(Topology, + rpc:call(Node, erlang, system_info, [cpu_topology])), + ?line stop_node(Node) + after + restore_erl_rel_flags(OldRelFlags) + end, + ?line ok. + +-define(BIND_TYPES, + [{"u", unbound}, + {"ns", no_spread}, + {"ts", thread_spread}, + {"ps", processor_spread}, + {"s", spread}, + {"nnts", no_node_thread_spread}, + {"nnps", no_node_processor_spread}, + {"tnnps", thread_no_node_processor_spread}, + {"db", thread_no_node_processor_spread}]). + +sbt_cmd(Config) when is_list(Config) -> + Bind = try + OldVal = erlang:system_flag(scheduler_bind_type, default_bind), + erlang:system_flag(scheduler_bind_type, OldVal), + go_for_it + catch + error:notsup -> notsup; + error:_ -> go_for_it + end, + case Bind of + notsup -> + ?line {skipped, "Binding of schedulers not supported"}; + go_for_it -> + CpuTCmd = case erlang:system_info({cpu_topology,detected}) of + undefined -> + case os:type() of + linux -> + case erlang:system_info(logical_processors) of + 1 -> + "+sctL0"; + N when is_integer(N) -> + NS = integer_to_list(N-1), + "+sctL0-"++NS++"p0-"++NS; + _ -> + false + end; + _ -> + false + end; + _ -> + "" + end, + case CpuTCmd of + false -> + ?line {skipped, "Don't know how to create cpu topology"}; + _ -> + case erlang:system_info(logical_processors) of + LP when is_integer(LP) -> + OldRelFlags = clear_erl_rel_flags(), + try + lists:foreach(fun ({ClBt, Bt}) -> + ?line sbt_test(Config, + CpuTCmd, + ClBt, + Bt, + LP) + end, + ?BIND_TYPES) + after + restore_erl_rel_flags(OldRelFlags) + end, + ?line ok; + _ -> + ?line {skipped, + "Don't know the amount of logical processors"} + end + end + end. + +sbt_test(Config, CpuTCmd, ClBt, Bt, LP) -> + ?line ?t:format("Testing +sbt ~s (~p)~n", [ClBt, Bt]), + ?line LPS = integer_to_list(LP), + ?line Cmd = CpuTCmd++" +sbt "++ClBt++" +S"++LPS++":"++LPS, + ?line {ok, Node} = start_node(Config, Cmd), + ?line Bt = rpc:call(Node, + erlang, + system_info, + [scheduler_bind_type]), + ?line SB = rpc:call(Node, + erlang, + system_info, + [scheduler_bindings]), + ?line ?t:format("scheduler bindings: ~p~n", [SB]), + ?line BS = case {Bt, erlang:system_info(logical_processors_available)} of + {unbound, _} -> 0; + {_, Int} when is_integer(Int) -> Int; + {_, _} -> LP + end, + ?line lists:foldl(fun (S, 0) -> + ?line unbound = S, + 0; + (S, N) -> + ?line true = is_integer(S), + N-1 + end, + BS, + tuple_to_list(SB)), + ?line stop_node(Node), + ?line ok. + + +% +%% Utils +%% + +erl_rel_flag_var() -> + "ERL_"++erlang:system_info(otp_release)++"_FLAGS". + +clear_erl_rel_flags() -> + EnvVar = erl_rel_flag_var(), + case os:getenv(EnvVar) of + false -> + false; + Value -> + os:putenv(EnvVar, ""), + Value + end. + +restore_erl_rel_flags(false) -> + ok; +restore_erl_rel_flags(OldValue) -> + os:putenv(erl_rel_flag_var(), OldValue), + ok. + +ok(too_slow, _Config) -> + {comment, "Too slow system to do any actual testing..."}; +ok(_Res, Config) -> + ?config(ok_res, Config). + +chk_result(too_slow, + _LWorkers, + _NWorkers, + _HWorkers, + _MWorkers, + _LNShouldWork, + _HShouldWork, + _MShouldWork) -> + ?line ok; +chk_result([{low, L, Lmin, _Lmax}, + {normal, N, Nmin, _Nmax}, + {high, H, Hmin, _Hmax}, + {max, M, Mmin, _Mmax}] = Res, + LWorkers, + NWorkers, + HWorkers, + MWorkers, + LNShouldWork, + HShouldWork, + MShouldWork) -> + ?line ?t:format("~p~n", [Res]), + ?line Relax = relax_limits(), + case {L, N} of + {0, 0} -> + ?line false = LNShouldWork; + _ -> + ?line {LminRatioLim, + NminRatioLim, + LNRatioLimMin, + LNRatioLimMax} = case Relax of + false -> {0.5, 0.5, 0.05, 0.25}; + true -> {0.05, 0.05, 0.01, 0.4} + end, + ?line Lavg = L/LWorkers, + ?line Navg = N/NWorkers, + ?line Ratio = Lavg/Navg, + ?line LminRatio = Lmin/Lavg, + ?line NminRatio = Nmin/Navg, + ?line ?t:format("low min ratio=~p~n" + "normal min ratio=~p~n" + "low avg=~p~n" + "normal avg=~p~n" + "low/normal ratio=~p~n", + [LminRatio, NminRatio, Lavg, Navg, Ratio]), + erlang:display({low_min_ratio, LminRatio}), + erlang:display({normal_min_ratio, NminRatio}), + erlang:display({low_avg, Lavg}), + erlang:display({normal_avg, Navg}), + erlang:display({low_normal_ratio, Ratio}), + ?line chk_lim(LminRatioLim, LminRatio, 1.0, low_min_ratio), + ?line chk_lim(NminRatioLim, NminRatio, 1.0, normal_min_ratio), + ?line chk_lim(LNRatioLimMin, Ratio, LNRatioLimMax, low_normal_ratio), + ?line true = LNShouldWork, + ?line ok + end, + case H of + 0 -> + ?line false = HShouldWork; + _ -> + ?line HminRatioLim = case Relax of + false -> 0.5; + true -> 0.1 + end, + ?line Havg = H/HWorkers, + ?line HminRatio = Hmin/Havg, + erlang:display({high_min_ratio, HminRatio}), + ?line chk_lim(HminRatioLim, HminRatio, 1.0, high_min_ratio), + ?line true = HShouldWork, + ?line ok + end, + case M of + 0 -> + ?line false = MShouldWork; + _ -> + ?line MminRatioLim = case Relax of + false -> 0.5; + true -> 0.1 + end, + ?line Mavg = M/MWorkers, + ?line MminRatio = Mmin/Mavg, + erlang:display({max_min_ratio, MminRatio}), + ?line chk_lim(MminRatioLim, MminRatio, 1.0, max_min_ratio), + ?line true = MShouldWork, + ?line ok + end, + ?line ok. + + + +chk_lim(Min, V, Max, _What) when Min =< V, V =< Max -> + ok; +chk_lim(_Min, V, _Max, What) -> + ?t:fail({bad, What, V}). + +snd(_Msg, []) -> + []; +snd(Msg, [P|Ps]) -> + P ! Msg, + Ps. + +relax_limits() -> + case strange_system_scale() of + Scale when Scale > 1 -> + ?t:format("Relaxing limits~n", []), + true; + _ -> + false + end. + +strange_system_scale() -> + S0 = 1, + S1 = case erlang:system_info(schedulers_online) + > erlang:system_info(logical_processors) of + true -> S0*2; + false -> S0 + end, + S2 = case erlang:system_info(debug_compiled) of + true -> S1*10; + false -> + case erlang:system_info(lock_checking) of + true -> S1*2; + false -> S1 + end + end, + S3 = case lock_counting() of + true -> S2*2; + false -> S2 + end, + S3. + +lock_counting() -> + lock_counting(erlang:system_info(system_version)). + +lock_counting([]) -> + false; +lock_counting([$[,$l,$o,$c,$k,$-,$c,$o,$u,$n,$t,$i,$n,$g,$],_]) -> + true; +lock_counting([_C|Cs]) -> + lock_counting(Cs). + +go_work([], [], [], []) -> + []; +go_work(L, N, [], []) -> + go_work(snd(go_work, L), snd(go_work, N), [], []); +go_work(L, N, H, []) -> + go_work(L, N, snd(go_work, H), []); +go_work(L, N, H, M) -> + go_work(L, N, H, snd(go_work, M)). + +stop_work([], [], [], []) -> + []; +stop_work([], [], [], M) -> + stop_work([], [], [], snd(stop_work, M)); +stop_work([], [], H, M) -> + stop_work([], [], snd(stop_work, H), M); +stop_work(L, N, H, M) -> + stop_work(snd(stop_work, L), snd(stop_work, N), H, M). + +wait_balance(N) when is_integer(N) -> + case erlang:system_info(schedulers_active) of + 1 -> + done; + _ -> + erts_debug:set_internal_state(available_internal_state,true), + Start = erts_debug:get_internal_state(nbalance), + End = (Start + N) band ((1 bsl (8*erlang:system_info(wordsize)))-1), + wait_balance(Start, End), + erts_debug:set_internal_state(available_internal_state,false) + end. + +wait_balance(Start, End) -> + X = erts_debug:get_internal_state(nbalance), + case End =< X of + true -> + case Start =< End of + true -> + done; + false -> + case X < Start of + true -> + done; + false -> + receive after 250 -> ok end, + wait_balance(Start, End) + end + end; + false -> + receive after 250 -> ok end, + wait_balance(Start, End) + end. + +wait_reds(RedsLimit, Timeout) -> + Stop = erlang:start_timer(Timeout, self(), stop), + statistics(reductions), + wait_reds(0, RedsLimit, Stop). + +wait_reds(Reds, RedsLimit, Stop) when Reds < RedsLimit -> + receive + {timeout, Stop, stop} -> + erlang:display(timeout), + erlang:display({reduction_limit, RedsLimit}), + erlang:display({reductions, Reds}), + done + after 10000 -> + {_, NewReds} = statistics(reductions), + wait_reds(NewReds+Reds, RedsLimit, Stop) + end; +wait_reds(Reds, RedsLimit, Stop) when is_reference(Stop) -> + erlang:cancel_timer(Stop), + receive {timeout, Stop, stop} -> ok after 0 -> ok end, + wait_reds(Reds, RedsLimit, false); +wait_reds(Reds, RedsLimit, _Stop) -> + erlang:display({reduction_limit, RedsLimit}), + erlang:display({reductions, Reds}), + done. + +do_it(Tracer, Low, Normal, High, Max) -> + do_it(Tracer, Low, Normal, High, Max, ?DEFAULT_TEST_REDS_PER_SCHED). + +do_it(Tracer, Low, Normal, High, Max, RedsPerSchedLimit) -> + OldPrio = process_flag(priority, max), + go_work(Low, Normal, High, Max), + StartWait = now(), + %% Give the emulator a chance to balance the load... + wait_balance(5), + EndWait = now(), + BalanceWait = timer:now_diff(EndWait,StartWait) div 1000, + erlang:display({balance_wait, BalanceWait}), + Timeout = ?DEFAULT_TIMEOUT - ?t:seconds(10) - BalanceWait, + Res = case Timeout < ?MIN_SCHEDULER_TEST_TIMEOUT of + true -> + stop_work(Low, Normal, High, Max), + too_slow; + false -> + set_tracing(true, Tracer, normal, Normal), + set_tracing(true, Tracer, low, Low), + set_tracing(true, Tracer, high, High), + set_tracing(true, Tracer, max, Max), + wait_reds(RedsPerSchedLimit + * erlang:system_info(schedulers_online), + Timeout), + set_tracing(false, Tracer, normal, Normal), + set_tracing(false, Tracer, low, Low), + set_tracing(false, Tracer, high, High), + set_tracing(false, Tracer, max, Max), + stop_work(Low, Normal, High, Max), + get_trace_result(Tracer) + end, + process_flag(priority, OldPrio), + Res. + +workers_exit([]) -> + ok; +workers_exit([P|Ps]) when is_pid(P) -> + Mon = erlang:monitor(process, P), + unlink(P), + exit(P, kill), + workers_exit(Ps), + receive {'DOWN', Mon, process, P, _} -> ok end, + ok; +workers_exit([[]]) -> + ok; +workers_exit([Ps|Pss]) -> + workers_exit(Ps), + workers_exit(Pss). + +do_work(PartTime) -> + lists:reverse(lists:seq(1, 50)), + receive stop_work -> receive after infinity -> ok end after 0 -> ok end, + case PartTime of + true -> receive after 1 -> ok end; + false -> ok + end, + do_work(PartTime). + +workers(N, _Prio, _PartTime) when N =< 0 -> + []; +workers(N, Prio, PartTime) -> + Parent = self(), + W = spawn_opt(fun () -> + Parent ! {ready, self()}, + receive + go_work -> + do_work(PartTime) + end + end, + [{priority, Prio}, link]), + Ws = workers(N-1, Prio, PartTime), + receive {ready, W} -> ok end, + [W|Ws]. + +workers(N, Prio) -> + workers(N, Prio, false). + +part_time_workers(N, Prio) -> + workers(N, Prio, true). + +tracer(Low, Normal, High, Max) -> + receive + {tracees, Prio, Tracees} -> + save_tracees(Prio, Tracees), + case Prio of + low -> tracer(Tracees++Low, Normal, High, Max); + normal -> tracer(Low, Tracees++Normal, High, Max); + high -> tracer(Low, Normal, Tracees++High, Max); + max -> tracer(Low, Normal, High, Tracees++Max) + end; + {get_result, Ref, Who} -> + Delivered = erlang:trace_delivered(all), + receive + {trace_delivered, all, Delivered} -> + ok + end, + {Lc, Nc, Hc, Mc} = read_trace(), + GetMinMax + = fun (Prio, Procs) -> + LargeNum = 1 bsl 64, + case lists:foldl(fun (P, {Mn, Mx} = MnMx) -> + {Prio, C} = get(P), + case C < Mn of + true -> + case C > Mx of + true -> + {C, C}; + false -> + {C, Mx} + end; + false -> + case C > Mx of + true -> {Mn, C}; + false -> MnMx + end + end + end, + {LargeNum, 0}, + Procs) of + {LargeNum, 0} -> {0, 0}; + Res -> Res + end + end, + {Lmin, Lmax} = GetMinMax(low, Low), + {Nmin, Nmax} = GetMinMax(normal, Normal), + {Hmin, Hmax} = GetMinMax(high, High), + {Mmin, Mmax} = GetMinMax(max, Max), + Who ! {trace_result, Ref, [{low, Lc, Lmin, Lmax}, + {normal, Nc, Nmin, Nmax}, + {high, Hc, Hmin, Hmax}, + {max, Mc, Mmin, Mmax}]} + end. + +read_trace() -> + read_trace(0,0,0,0). + +read_trace(Low, Normal, High, Max) -> + receive + {trace, Proc, in, _} -> + {Prio, Count} = get(Proc), + put(Proc, {Prio, Count+1}), + case Prio of + low -> read_trace(Low+1, Normal, High, Max); + normal -> read_trace(Low, Normal+1, High, Max); + high -> read_trace(Low, Normal, High+1, Max); + max -> read_trace(Low, Normal, High, Max+1) + end; + {trace, _Proc, out, _} -> + read_trace(Low, Normal, High, Max) + after 0 -> + {Low, Normal, High, Max} + end. + +save_tracees(_Prio, []) -> + ok; +save_tracees(Prio, [T|Ts]) -> + put(T, {Prio, 0}), + save_tracees(Prio, Ts). + +start_tracer() -> + Tracer = spawn_link(fun () -> tracer([], [], [], []) end), + true = erlang:suspend_process(Tracer), + Tracer. + +get_trace_result(Tracer) -> + erlang:resume_process(Tracer), + Ref = make_ref(), + Tracer ! {get_result, Ref, self()}, + receive + {trace_result, Ref, Res} -> + Res + end. + + +set_tracing(_On, _Tracer, _Prio, []) -> + ok; +set_tracing(true, Tracer, Prio, Pids) -> + Tracer ! {tracees, Prio, Pids}, + set_tracing(true, Tracer, Pids); +set_tracing(false, Tracer, _Prio, Pids) -> + set_tracing(false, Tracer, Pids). + +set_tracing(_On, _Tracer, []) -> + ok; +set_tracing(On, Tracer, [Pid|Pids]) -> + 1 = erlang:trace(Pid, On, [running, {tracer, Tracer}]), + set_tracing(On, Tracer, Pids). + +active_schedulers() -> + case erlang:system_info(schedulers_online) of + 1 -> + 1; + N -> + case erlang:system_info(multi_scheduling) of + blocked -> 1; + enabled -> N + end + end. + +start_node(Config) -> + start_node(Config, ""). + +start_node(Config, Args) when is_list(Config) -> + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line {A, B, C} = now(), + ?line Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(?config(testcase, Config)) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)), + ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa++" "++Args}]). + +stop_node(Node) -> + ?t:stop_node(Node). + + +enable_internal_state() -> + case catch erts_debug:get_internal_state(available_internal_state) of + true -> true; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end. + +cmp(X, X) -> + ok; +cmp(X, Y) -> + ?t:format("cmp failed:~n X=~p~n Y=~p~n", [X,Y]), + cmp_aux(X, Y). + + +cmp_aux([X0|Y0], [X1|Y1]) -> + cmp_aux(X0, X1), + cmp_aux(Y0, Y1); +cmp_aux(T0, T1) when is_tuple(T0), is_tuple(T1), size(T0) == size(T1) -> + cmp_tuple(T0, T1, 1, size(T0)); +cmp_aux(X, X) -> + ok; +cmp_aux(F0, F1) -> + ?t:fail({no_match, F0, F1}). + +cmp_tuple(_T0, _T1, N, Sz) when N > Sz -> + ok; +cmp_tuple(T0, T1, N, Sz) -> + cmp_aux(element(N, T0), element(N, T1)), + cmp_tuple(T0, T1, N+1, Sz). diff --git a/erts/emulator/test/send_term_SUITE.erl b/erts/emulator/test/send_term_SUITE.erl new file mode 100644 index 0000000000..489adbd660 --- /dev/null +++ b/erts/emulator/test/send_term_SUITE.erl @@ -0,0 +1,354 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(send_term_SUITE). + +-export([all/1,basic/1]). +-export([init_per_testcase/2,fin_per_testcase/2]). + +-export([generate_external_terms_files/1]). + +-include("test_server.hrl"). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(3)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +all(suite) -> + [basic]. + +basic(Config) when is_list(Config) -> + Drv = "send_term_drv", + ?line P = start_driver(Config, Drv), + + ?line [] = term(P, 0), + ?line Self = self(), + ?line {blurf,42,[],[-42,{}|"abc"++P],"kalle",3.1416,Self} = term(P, 1), + ?line Deep = lists:seq(0, 199), + ?line Deep = term(P, 2), + ?line {B1,B2} = term(P, 3), + ?line B1 = list_to_binary(lists:seq(0, 255)), + ?line B2 = list_to_binary(lists:seq(23, 255-17)), + + %% Pid sending. We need another process. + ?line Child = spawn_link(fun() -> + erlang:port_command(P, [4]) + end), + ?line {Self,Child} = receive_any(), + + %% ERL_DRV_EXT2TERM + ?line ExpectExt2Term = expected_ext2term_drv(?config(data_dir, Config)), + ?line ExpectExt2Term = term(P, 5), + + %% ERL_DRV_INT, ERL_DRV_UINT + ?line case erlang:system_info(wordsize) of + 4 -> + ?line {-1, 4294967295} = term(P, 6); + 8 -> + ?line {-1, 18446744073709551615} = term(P, 6) + end, + + %% ERL_DRV_BUF2BINARY + ?line ExpectedBinTup = {<<>>, + <<>>, + list_to_binary(lists:duplicate(17,17)), + list_to_binary(lists:duplicate(1024,17))}, + ?line ExpectedBinTup = term(P, 7), + + %% single terms + ?line [] = term(P, 8), % ERL_DRV_NIL + ?line '' = term(P, 9), % ERL_DRV_ATOM + ?line an_atom = term(P, 10), % ERL_DRV_ATOM + ?line -4711 = term(P, 11), % ERL_DRV_INT + ?line 4711 = term(P, 12), % ERL_DRV_UINT + ?line P = term(P, 13), % ERL_DRV_PORT + ?line <<>> = term(P, 14), % ERL_DRV_BINARY + ?line <<"hejsan">> = term(P, 15), % ERL_DRV_BINARY + ?line <<>> = term(P, 16), % ERL_DRV_BUF2BINARY + ?line <<>> = term(P, 17), % ERL_DRV_BUF2BINARY + ?line <<"hoppsan">> = term(P, 18), % ERL_DRV_BUF2BINARY + ?line "" = term(P, 19), % ERL_DRV_STRING + ?line "" = term(P, 20), % ERL_DRV_STRING + ?line "hippsan" = term(P, 21), % ERL_DRV_STRING + ?line {} = term(P, 22), % ERL_DRV_TUPLE + ?line [] = term(P, 23), % ERL_DRV_LIST + ?line Self = term(P, 24), % ERL_DRV_PID + ?line [] = term(P, 25), % ERL_DRV_STRING_CONS + ?line AFloat = term(P, 26), % ERL_DRV_FLOAT + ?line true = AFloat < 0.001, + ?line true = AFloat > -0.001, + ?line [] = term(P, 27), % ERL_DRV_EXT2TERM + ?line 18446744073709551615 = term(P, 28), % ERL_DRV_UINT64 + ?line 20233590931456 = term(P, 29), % ERL_DRV_UINT64 + ?line 4711 = term(P, 30), % ERL_DRV_UINT64 + ?line 0 = term(P, 31), % ERL_DRV_UINT64 + ?line 9223372036854775807 = term(P, 32), % ERL_DRV_INT64 + ?line 20233590931456 = term(P, 33), % ERL_DRV_INT64 + ?line 4711 = term(P, 34), % ERL_DRV_INT64 + ?line 0 = term(P, 35), % ERL_DRV_INT64 + ?line -1 = term(P, 36), % ERL_DRV_INT64 + ?line -4711 = term(P, 37), % ERL_DRV_INT64 + ?line -20233590931456 = term(P, 38), % ERL_DRV_INT64 + ?line -9223372036854775808 = term(P, 39), % ERL_DRV_INT64 + + %% Failure cases. + ?line [] = term(P, 127), + ?line receive + Any -> + ?line io:format("Unexpected: ~p\n", [Any]), + ?line ?t:fail() + after 0 -> + ok + end, + + ?line ok = chk_temp_alloc(), + + %% In a private heap system, verify that there are no binaries + %% left for the process. + ?line erlang:garbage_collect(), %Get rid of binaries. + case erlang:system_info(heap_type) of + private -> + ?line {binary,[]} = process_info(self(), binary); + _ -> ok + end, + + ?line stop_driver(P, Drv), + ok. + +term(P, Op) -> + erlang:port_command(P, [Op]), + receive_any(). + +receive_any() -> + receive + Any -> Any + end. + +chk_temp_alloc() -> + case erlang:system_info({allocator,temp_alloc}) of + false -> + %% Temp alloc is not enabled + ?line ok; + TIL -> + %% Verify that we havn't got anything allocated by temp_alloc + lists:foreach( + fun ({instance, _, TI}) -> + ?line {value, {mbcs, MBCInfo}} + = lists:keysearch(mbcs, 1, TI), + ?line {value, {blocks, 0, _, _}} + = lists:keysearch(blocks, 1, MBCInfo), + ?line {value, {sbcs, SBCInfo}} + = lists:keysearch(sbcs, 1, TI), + ?line {value, {blocks, 0, _, _}} + = lists:keysearch(blocks, 1, SBCInfo) + end, + TIL), + ?line ok + end. + + +%% Start/stop drivers. +start_driver(Config, Name) -> + Path = ?config(data_dir, Config), + erl_ddll:start(), + ok = load_driver(Path, Name), + open_port({spawn, Name}, []). + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. + +stop_driver(Port, Name) -> + ?line true = erlang:port_close(Port), + receive + {Port,Message} -> + ?t:fail({strange_message_from_port,Message}) + after 0 -> + ok + end, + + %% Unload the driver. + ok = erl_ddll:unload_driver(Name), + ?line ok = erl_ddll:stop(). + +get_external_terms(DataDir) -> + {ok, Bin} = file:read_file([DataDir, "ext_terms.bin"]), + binary_to_term(Bin). + +expected_ext2term_drv(DataDir) -> + make_expected_ext2term_drv(get_external_terms(DataDir)). + +make_expected_ext2term_drv([]) -> + []; +make_expected_ext2term_drv([T|Ts]) -> + [{T, T} | make_expected_ext2term_drv(Ts)]. + +%% +%% Generation of send_term_SUITE_data/ext_terms.h and +%% send_term_SUITE_data/ext_terms.bin +%% +%% These files should normally not need to be regenerated, +%% but we may want that if we introduce new types or make +%% backward incompatible changes to the external format. +%% + +generate_external_terms_files(BaseDir) -> + {ok,Node} = slave:start(hostname(), a_node), + RPid = rpc:call(Node, erlang, self, []), + true = is_pid(RPid), + RRef = rpc:call(Node, erlang, make_ref, []), + true = is_reference(RRef), + RPort = hd(rpc:call(Node, erlang, ports, [])), + true = is_port(RPort), + slave:stop(Node), + Terms = + [{4711, -4711, [an_atom, "a list"]}, + [1000000000000000000000,-1111111111111111, "blupp!", blipp], + {RPid, {RRef, RPort}, self(), hd(erlang:ports()), make_ref()}, + {{}, [], [], fun () -> ok end, <<"hej hopp trallalaaaaaaaaaaaaaaa">>}, + [44444444444444444444444,-44444444444, "b!", blippppppp], + {4711, RPid, {RRef, RPort}, -4711, [an_atom, "a list"]}, + {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, + {4711, -4711, [an_atom, "a list"]}, + {4711, -4711, [atom, "list"]}, + {RPid, {RRef, RPort}, hd(processes()), hd(erlang:ports())}, + {4444444444444444444,-44444, {{{{{{{{{{{{}}}}}}}}}}}}, make_ref()}, + {444444444444444444444,-44444, [[[[[[[[[[[1]]]]]]]]]]], make_ref()}, + {444444444444444444,-44444, {{{{{{{{{{{{2}}}}}}}}}}}}, make_ref()}, + {4444444444444444444444,-44444, {{{{{{{{{{{{3}}}}}}}}}}}}, make_ref()}, + {44444444444444444444,-44444, {{{{{{{{{{{{4}}}}}}}}}}}}, make_ref()}, + {4444444444444444,-44444, [[[[[[[[[[[5]]]]]]]]]]], make_ref()}, + {444444444444444444444,-44444, {{{{{{{{{{{{6}}}}}}}}}}}}, make_ref()}, + {444444444444444,-44444, {{{{{{{{{{{{7}}}}}}}}}}}}, make_ref()}, + {4444444444444444444,-44444, {{{{{{{{{{{{8}}}}}}}}}}}}, make_ref()}], + ok = file:write_file(filename:join([BaseDir, + "send_term_SUITE_data", + "ext_terms.bin"]), + term_to_binary(Terms, [compressed])), + {ok, IoDev} = file:open(filename:join([BaseDir, + "send_term_SUITE_data", + "ext_terms.h"]), + [write]), + write_ext_terms_h(IoDev, Terms), + file:close(IoDev). + +write_ext_terms_h(IoDev, Terms) -> + write_license(IoDev), + io:format(IoDev, "#ifndef EXT_TERMS_H__~n",[]), + io:format(IoDev, "#define EXT_TERMS_H__~n",[]), + {ExtTerms, MaxSize} = make_ext_terms(Terms), + io:format(IoDev, + "static struct {~n" + " unsigned char ext[~p];~n" + " int ext_size;~n" + " unsigned char cext[~p];~n" + " int cext_size;~n" + "} ext_terms[] = {~n",[MaxSize, MaxSize]), + E = write_ext_terms_h(IoDev, ExtTerms, 0), + io:format(IoDev, "};~n",[]), + io:format(IoDev, "#define NO_OF_EXT_TERMS ~p~n", [E]), + io:format(IoDev, "#endif~n",[]). + +make_ext_terms([]) -> + {[], 0}; +make_ext_terms([T|Ts]) -> + E = term_to_binary(T), + ESz = size(E), + CE = term_to_binary(T, [compressed]), + CESz = size(CE), + true = CESz =< ESz, % Assertion + {ExtTerms, MaxSize} = make_ext_terms(Ts), + NewMaxSize = case MaxSize < ESz of + true -> ESz; + false -> MaxSize + end, + {[{E, ESz, CE, CESz} | ExtTerms], NewMaxSize}. + +write_ext_terms_h(IoDev, [], N) -> + io:format(IoDev, "~n",[]), + N; +write_ext_terms_h(IoDev, [ET|ETs], 0) -> + write_ext_term(IoDev, ET), + write_ext_terms_h(IoDev, ETs, 1); +write_ext_terms_h(IoDev, [ET|ETs], N) -> + io:format(IoDev, ",~n",[]), + write_ext_term(IoDev, ET), + write_ext_terms_h(IoDev, ETs, N+1). + +write_ext_term(IoDev, {E, ESz, CE, CESz}) -> + ESz = write_bytes(IoDev, " {{", binary_to_list(E), 0), + io:format(IoDev, + ",~n" + " ~p,~n", + [ESz]), + CESz = write_bytes(IoDev, " {", binary_to_list(CE), 0), + io:format(IoDev, + ",~n" + " ~p}", + [CESz]). + +write_bytes(IoDev, _, [], N) -> + io:format(IoDev, "}",[]), + N; +write_bytes(IoDev, Prefix, [B|Bs], N) -> + io:format(IoDev, "~s~w", [Prefix, B]), + write_bytes(IoDev, ",", Bs, N+1). + +write_license(IoDev) -> + S = "/* ``The contents of this file are subject to the Erlang Public License,~n" + " * Version 1.1, (the \"License\"); you may not use this file except in~n" + " * compliance with the License. You should have received a copy of the~n" + " * Erlang Public License along with this software. If not, it can be~n" + " * retrieved via the world wide web at http://www.erlang.org/.~n" + " * ~n" + " * Software distributed under the License is distributed on an \"AS IS\"~n" + " * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See~n" + " * the License for the specific language governing rights and limitations~n" + " * under the License.~n" + " * ~n" + " * The Initial Developer of the Original Code is Ericsson AB.~n" + " * Portions created by Ericsson are Copyright 2007, Ericsson AB.~n" + " * All Rights Reserved.''~n" + " * ~n" + " * $Id$~n" + " */~n" + "~n" + "/*~n" + " * Do not modify this file. This file and ext_terms.bin were~n" + " * automatically generated by send_term_SUITE:generate_external_terms_files/1~n" + " * and needs to be consistent with each other.~n" + " */~n", + io:format(IoDev, S, []). + + +hostname() -> + hostname(atom_to_list(node())). + +hostname([$@ | Hostname]) -> + list_to_atom(Hostname); +hostname([_C | Cs]) -> + hostname(Cs). diff --git a/erts/emulator/test/send_term_SUITE_data/Makefile.src b/erts/emulator/test/send_term_SUITE_data/Makefile.src new file mode 100644 index 0000000000..41a96ff626 --- /dev/null +++ b/erts/emulator/test/send_term_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: send_term_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/send_term_SUITE_data/ext_terms.bin b/erts/emulator/test/send_term_SUITE_data/ext_terms.bin new file mode 100644 index 0000000000..b239284323 Binary files /dev/null and b/erts/emulator/test/send_term_SUITE_data/ext_terms.bin differ diff --git a/erts/emulator/test/send_term_SUITE_data/ext_terms.h b/erts/emulator/test/send_term_SUITE_data/ext_terms.h new file mode 100644 index 0000000000..08134f3b05 --- /dev/null +++ b/erts/emulator/test/send_term_SUITE_data/ext_terms.h @@ -0,0 +1,110 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson AB. + * Portions created by Ericsson are Copyright 2007, Ericsson AB. + * All Rights Reserved.'' + * + * $Id$ + */ + +/* + * Do not modify this file. This file and ext_terms.bin were + * automatically generated by send_term_SUITE:generate_external_terms_files/1 + * and needs to be consistent with each other. + */ +#ifndef EXT_TERMS_H__ +#define EXT_TERMS_H__ +static struct { + unsigned char ext[162]; + int ext_size; + unsigned char cext[162]; + int cext_size; +} ext_terms[] = { + {{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, + 38, + {131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, + 38}, + {{131,108,0,0,0,4,110,9,0,0,0,160,222,197,173,201,53,54,110,7,1,199,113,21,183,140,242,3,107,0,6,98,108,117,112,112,33,100,0,5,98,108,105,112,112,106}, + 46, + {131,108,0,0,0,4,110,9,0,0,0,160,222,197,173,201,53,54,110,7,1,199,113,21,183,140,242,3,107,0,6,98,108,117,112,112,33,100,0,5,98,108,105,112,112,106}, + 46}, + {{131,104,5,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,37,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,59,0,0,0,0,0,0,0,0}, + 162, + {131,80,0,0,0,161,120,156,203,96,77,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,80,21,108,96,26,166,4,35,51,216,14,20,97,144,21,214,48,43,0,1,209,36,52}, + 82}, + {{131,104,5,104,0,106,106,112,0,0,0,79,0,21,87,190,182,1,38,106,214,65,228,1,52,27,227,2,212,0,0,0,1,0,0,0,0,100,0,15,115,101,110,100,95,116,101,114,109,95,83,85,73,84,69,97,1,98,0,184,11,180,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,37,0,0,0,0,3,109,0,0,0,31,104,101,106,32,104,111,112,112,32,116,114,97,108,108,97,108,97,97,97,97,97,97,97,97,97,97,97,97,97,97,97}, + 123, + {131,80,0,0,0,122,120,156,203,96,205,96,200,202,42,96,96,96,240,103,16,13,223,183,141,81,45,235,154,227,19,70,19,233,199,76,87,128,130,140,64,204,144,194,192,95,156,154,151,18,95,146,90,148,27,31,28,234,25,226,154,200,152,196,176,131,123,75,122,10,3,79,98,94,126,74,170,67,122,126,81,82,98,58,80,173,42,72,3,115,46,144,144,207,72,205,82,200,200,47,40,80,40,41,74,204,201,73,204,73,68,5,0,18,237,35,68}, + 117}, + {{131,108,0,0,0,4,110,10,0,28,199,113,166,118,185,145,86,105,9,110,5,1,28,103,24,89,10,107,0,2,98,33,100,0,10,98,108,105,112,112,112,112,112,112,112,106}, + 46, + {131,108,0,0,0,4,110,10,0,28,199,113,166,118,185,145,86,105,9,110,5,1,28,103,24,89,10,107,0,2,98,33,100,0,10,98,108,105,112,112,112,112,112,112,112,106}, + 46}, + {{131,104,5,98,0,0,18,103,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, + 120, + {131,80,0,0,0,119,120,156,203,96,77,98,96,16,74,79,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,156,244,255,255,219,153,57,64,38,83,10,3,123,98,94,124,98,73,126,110,54,3,91,162,66,78,102,113,73,22,0,167,192,30,158}, + 93}, + {{131,104,4,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,0,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3}, + 131, + {131,80,0,0,0,130,120,156,203,96,73,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,16,12,152,211,48,37,24,153,1,215,214,30,50}, + 72}, + {{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, + 38, + {131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,7,97,110,95,97,116,111,109,107,0,6,97,32,108,105,115,116,106}, + 38}, + {{131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,4,97,116,111,109,107,0,4,108,105,115,116,106}, + 33, + {131,104,3,98,0,0,18,103,98,255,255,237,153,108,0,0,0,2,100,0,4,97,116,111,109,107,0,4,108,105,115,116,106}, + 33}, + {{131,104,4,103,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,38,0,0,0,0,3,104,2,114,0,3,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,40,0,0,0,0,0,0,0,0,102,100,0,13,97,95,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,0,0,0,0,0,3,102,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,1,3}, + 131, + {131,80,0,0,0,130,120,156,203,96,73,79,97,224,77,140,207,203,79,73,117,72,207,47,74,74,76,103,96,96,80,3,98,6,230,12,166,34,6,102,116,89,102,160,140,6,3,20,164,97,209,203,200,12,52,145,39,17,85,16,12,152,211,48,37,24,153,1,215,214,30,50}, + 72}, + {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,0,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,60,0,0,0,0,0,0,0,0}, + 74, + {131,80,0,0,0,73,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,133,12,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,54,12,80,0,0,73,17,18,208}, + 63}, + {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,1,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,61,0,0,0,0,0,0,0,0}, + 115, + {131,80,0,0,0,114,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,114,24,24,24,24,73,34,178,25,24,25,179,224,160,136,129,57,133,129,39,49,47,63,37,213,33,61,191,40,41,49,157,25,168,200,150,1,10,0,208,188,23,70}, + 71}, + {{131,104,4,110,8,0,28,199,129,17,222,251,42,6,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,2,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,62,0,0,0,0,0,0,0,0}, + 76, + {131,80,0,0,0,75,120,156,203,96,201,227,96,144,57,222,40,120,239,183,22,91,210,255,255,65,41,25,140,216,97,34,83,17,3,115,10,3,79,98,94,126,74,170,67,122,126,81,82,98,58,51,3,3,131,29,3,20,0,0,76,82,18,165}, + 64}, + {{131,104,4,110,9,0,28,199,113,221,139,146,14,239,240,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,3,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,63,0,0,0,0,0,0,0,0}, + 77, + {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,94,120,183,123,18,223,251,15,73,255,255,7,165,100,48,98,135,137,204,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,246,12,80,0,0,192,110,20,101}, + 65}, + {{131,104,4,110,9,0,28,199,177,214,190,98,202,104,2,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,4,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,64,0,0,0,0,0,0,0,0}, + 77, + {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,190,241,218,190,164,83,25,76,73,255,255,7,165,100,48,98,135,137,44,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,14,12,80,0,0,164,94,19,234}, + 65}, + {{131,104,4,110,7,0,28,199,85,220,50,202,15,98,255,255,82,100,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,108,0,0,0,1,107,0,1,5,106,106,106,106,106,106,106,106,106,106,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,65,0,0,0,0,0,0,0,0}, + 113, + {131,80,0,0,0,112,120,156,203,96,201,99,103,144,57,30,122,199,232,20,127,210,255,255,65,41,57,12,12,12,140,36,17,217,12,140,172,89,112,80,196,192,156,194,192,147,152,151,159,146,234,144,158,95,148,148,152,206,12,84,228,200,0,5,0,46,116,21,208}, + 69}, + {{131,104,4,110,9,0,28,199,241,98,116,219,231,23,24,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,6,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,66,0,0,0,0,0,0,0,0}, + 77, + {131,80,0,0,0,76,120,156,203,96,201,227,100,144,57,254,49,169,228,246,115,113,137,164,255,255,131,82,50,24,177,195,68,182,34,6,230,20,6,158,196,188,252,148,84,135,244,252,162,164,196,116,102,6,6,6,39,6,40,0,0,155,123,19,203}, + 65}, + {{131,104,4,110,7,0,28,199,59,73,56,148,1,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,7,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,67,0,0,0,0,0,0,0,0}, + 75, + {131,80,0,0,0,74,120,156,203,96,201,99,103,144,57,110,237,105,49,133,49,233,255,255,160,148,12,70,236,48,145,189,136,129,57,133,129,39,49,47,63,37,213,33,61,191,40,41,49,157,153,129,129,193,153,1,10,0,245,21,17,100}, + 62}, + {{131,104,4,110,8,0,28,199,17,175,172,214,173,61,98,255,255,82,100,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,104,1,97,8,114,0,3,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,3,0,0,0,68,0,0,0,0,0,0,0,0}, + 76, + {131,80,0,0,0,75,120,156,203,96,201,227,96,144,57,46,184,126,205,181,181,182,73,255,255,7,165,100,48,98,135,137,28,69,12,204,41,12,60,137,121,249,41,169,14,233,249,69,73,137,233,204,12,12,12,46,12,80,0,0,112,226,19,66}, + 64} +}; +#define NO_OF_EXT_TERMS 19 +#endif diff --git a/erts/emulator/test/send_term_SUITE_data/send_term_drv.c b/erts/emulator/test/send_term_SUITE_data/send_term_drv.c new file mode 100644 index 0000000000..6638de0560 --- /dev/null +++ b/erts/emulator/test/send_term_SUITE_data/send_term_drv.c @@ -0,0 +1,718 @@ +/* ``The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved via the world wide web at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * The Initial Developer of the Original Code is Ericsson Utvecklings AB. + * Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings + * AB. All Rights Reserved.'' + * + * $Id$ + */ + +#include "erl_driver.h" +#include +#include + +static ErlDrvPort erlang_port; +static ErlDrvData send_term_drv_start(ErlDrvPort port, char *command); +static void send_term_drv_stop(ErlDrvData drv_data); +static void send_term_drv_run(ErlDrvData drv_data, char *buf, int len); + + +static int make_ext_term_list(ErlDrvTermData *td, int bad); + +#define FAIL_TERM(M, L) fail_term((M), (L), __LINE__) + +static ErlDrvEntry send_term_drv_entry = { + NULL, + send_term_drv_start, + send_term_drv_stop, + send_term_drv_run, + NULL, + NULL, + "send_term_drv", +}; + +DRIVER_INIT(send_term_drv) +{ + erlang_port = (ErlDrvPort)-1; + return &send_term_drv_entry; +} + +static ErlDrvData send_term_drv_start(ErlDrvPort port, char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + + erlang_port = port; + return (ErlDrvData)port; +} + +static void send_term_drv_stop(ErlDrvData drv_data) +{ +} + +static void output_term(ErlDrvTermData* msg, int len); +static void fail_term(ErlDrvTermData* msg, int len, int line); + +static void send_term_drv_run(ErlDrvData port, char *buf, int count) +{ + ErlDrvTermData msg[1024]; + + switch (*buf) { + case 0: + msg[0] = ERL_DRV_NIL; + output_term(msg, 1); + break; + + case 1: /* Most term types inside a tuple. */ + { + double f = 3.1416; + + msg[0] = ERL_DRV_ATOM; + msg[1] = driver_mk_atom("blurf"), + msg[2] = ERL_DRV_INT; + msg[3] = (ErlDrvTermData) 42; + msg[4] = ERL_DRV_NIL; + msg[5] = ERL_DRV_INT; + msg[6] = (ErlDrvTermData) -42; + msg[7] = ERL_DRV_TUPLE; + msg[8] = (ErlDrvTermData) 0; + msg[9] = ERL_DRV_PORT; + msg[10] = driver_mk_port(erlang_port); + msg[11] = ERL_DRV_STRING_CONS; + msg[12] = (ErlDrvTermData) "abc"; + msg[13] = (ErlDrvTermData) 3; + msg[14] = ERL_DRV_LIST; + msg[15] = (ErlDrvTermData) 3; + msg[16] = ERL_DRV_STRING; + msg[17] = (ErlDrvTermData) "kalle"; + msg[18] = (ErlDrvTermData) 5; + msg[19] = ERL_DRV_FLOAT; + msg[20] = (ErlDrvTermData) &f; + msg[21] = ERL_DRV_PID; + msg[22] = driver_connected(erlang_port); + msg[23] = ERL_DRV_TUPLE; + msg[24] = (ErlDrvTermData) 7; + output_term(msg, 25); + } + break; + + case 2: /* Deep stack */ + { + int i; + + for (i = 0; i < 400; i += 2) { + msg[i] = ERL_DRV_INT; + msg[i+1] = (ErlDrvTermData) (i / 2); + } + msg[i] = ERL_DRV_NIL; + msg[i+1] = ERL_DRV_LIST; + msg[i+2] = (ErlDrvTermData) 201; + output_term(msg, i+3); + } + break; + + case 3: /* Binaries */ + { + ErlDrvBinary* bin; + int i; + + bin = driver_alloc_binary(256); + for (i = 0; i < 256; i++) { + bin->orig_bytes[i] = i; + } + msg[0] = ERL_DRV_BINARY; + msg[1] = (ErlDrvTermData) bin; + msg[2] = (ErlDrvTermData) 256; + msg[3] = (ErlDrvTermData) 0; + msg[4] = ERL_DRV_BINARY; + msg[5] = (ErlDrvTermData) bin; + msg[6] = (ErlDrvTermData) 256-23-17; + msg[7] = (ErlDrvTermData) 23; + msg[8] = ERL_DRV_TUPLE; + msg[9] = (ErlDrvTermData) 2; + output_term(msg, 10); + driver_free_binary(bin); + } + break; + + case 4: /* Pids */ + msg[0] = ERL_DRV_PID; + msg[1] = driver_connected(erlang_port); + msg[2] = ERL_DRV_PID; + msg[3] = driver_caller(erlang_port); + msg[4] = ERL_DRV_TUPLE; + msg[5] = (ErlDrvTermData) 2; + output_term(msg, 6); + break; + + case 5: + output_term(msg, make_ext_term_list(msg, 0)); + break; + + case 6: + msg[0] = ERL_DRV_INT; + msg[1] = ~((ErlDrvTermData) 0); + msg[2] = ERL_DRV_UINT; + msg[3] = ~((ErlDrvTermData) 0); + msg[4] = ERL_DRV_TUPLE; + msg[5] = (ErlDrvTermData) 2; + output_term(msg, 6); + break; + + case 7: { + int len = 0; + char buf[1024]; + memset(buf, 17, sizeof(buf)); + /* empty heap binary */ + msg[len++] = ERL_DRV_BUF2BINARY; + msg[len++] = (ErlDrvTermData) NULL; /* NULL is ok if size == 0 */ + msg[len++] = (ErlDrvTermData) 0; + /* empty heap binary again */ + msg[len++] = ERL_DRV_BUF2BINARY; + msg[len++] = (ErlDrvTermData) &buf[0]; /* ptr is ok if size == 0 */ + msg[len++] = (ErlDrvTermData) 0; + /* heap binary */ + msg[len++] = ERL_DRV_BUF2BINARY; + msg[len++] = (ErlDrvTermData) &buf[0]; + msg[len++] = (ErlDrvTermData) 17; + /* off heap binary */ + msg[len++] = ERL_DRV_BUF2BINARY; + msg[len++] = (ErlDrvTermData) &buf[0]; + msg[len++] = (ErlDrvTermData) sizeof(buf); + + msg[len++] = ERL_DRV_TUPLE; + msg[len++] = (ErlDrvTermData) 4; + + output_term(msg, len); + break; + } + + case 8: + msg[0] = ERL_DRV_NIL; + output_term(msg, 1); + break; + + case 9: + msg[0] = ERL_DRV_ATOM; + msg[1] = (ErlDrvTermData) driver_mk_atom(""); + output_term(msg, 2); + break; + + case 10: + msg[0] = ERL_DRV_ATOM; + msg[1] = (ErlDrvTermData) driver_mk_atom("an_atom"); + output_term(msg, 2); + break; + + case 11: + msg[0] = ERL_DRV_INT; + msg[1] = (ErlDrvTermData) -4711; + output_term(msg, 2); + break; + + case 12: + msg[0] = ERL_DRV_UINT; + msg[1] = (ErlDrvTermData) 4711; + output_term(msg, 2); + + break; + case 13: + msg[0] = ERL_DRV_PORT; + msg[1] = driver_mk_port(erlang_port); + output_term(msg, 2); + break; + + case 14: { + ErlDrvBinary *dbin = driver_alloc_binary(0); + msg[0] = ERL_DRV_BINARY; + msg[1] = (ErlDrvTermData) dbin; + msg[2] = (ErlDrvTermData) 0; + msg[3] = (ErlDrvTermData) 0; + output_term(msg, 4); + driver_free_binary(dbin); + break; + } + + case 15: { + char buf[] = "hejsan"; + ErlDrvBinary *dbin = driver_alloc_binary(sizeof(buf)-1); + if (dbin) + memcpy((void *) dbin->orig_bytes, (void *) buf, sizeof(buf)-1); + msg[0] = ERL_DRV_BINARY; + msg[1] = (ErlDrvTermData) dbin; + msg[2] = (ErlDrvTermData) (dbin ? sizeof(buf)-1 : 0); + msg[3] = (ErlDrvTermData) 0; + output_term(msg, 4); + driver_free_binary(dbin); + break; + } + + case 16: + msg[0] = ERL_DRV_BUF2BINARY; + msg[1] = (ErlDrvTermData) NULL; + msg[2] = (ErlDrvTermData) 0; + output_term(msg, 3); + break; + + case 17: { + char buf[] = ""; + msg[0] = ERL_DRV_BUF2BINARY; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) sizeof(buf)-1; + output_term(msg, 3); + break; + } + + case 18: { + char buf[] = "hoppsan"; + msg[0] = ERL_DRV_BUF2BINARY; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) sizeof(buf)-1; + output_term(msg, 3); + break; + } + + case 19: + msg[0] = ERL_DRV_STRING; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) 0; + output_term(msg, 3); + break; + + case 20: { + char buf[] = ""; + msg[0] = ERL_DRV_STRING; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) sizeof(buf)-1; + output_term(msg, 3); + break; + } + + case 21: { + char buf[] = "hippsan"; + msg[0] = ERL_DRV_STRING; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) sizeof(buf)-1; + output_term(msg, 3); + break; + } + + case 22: + msg[0] = ERL_DRV_TUPLE; + msg[1] = (ErlDrvTermData) 0; + output_term(msg, 2); + break; + + case 23: + msg[0] = ERL_DRV_NIL; + msg[1] = ERL_DRV_LIST; + msg[2] = (ErlDrvTermData) 1; + output_term(msg, 3); + break; + + case 24: + msg[0] = ERL_DRV_PID; + msg[1] = driver_connected(erlang_port); + output_term(msg, 2); + break; + + case 25: + msg[0] = ERL_DRV_NIL; + msg[1] = ERL_DRV_STRING_CONS; + msg[2] = (ErlDrvTermData) ""; + msg[3] = (ErlDrvTermData) 0; + output_term(msg, 4); + break; + + case 26: { + double my_float = 0.0; + msg[0] = ERL_DRV_FLOAT; + msg[1] = (ErlDrvTermData) &my_float; + output_term(msg, 2); + break; + } + + case 27: { + char buf[] = {131, 106}; /* [] */ + msg[0] = ERL_DRV_EXT2TERM; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) sizeof(buf); + output_term(msg, 3); + break; + } + + case 28: { + ErlDrvUInt64 x = ~((ErlDrvUInt64) 0); + msg[0] = ERL_DRV_UINT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 29: { + ErlDrvUInt64 x = ((ErlDrvUInt64) 4711) << 32; + msg[0] = ERL_DRV_UINT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 30: { + ErlDrvUInt64 x = 4711; + msg[0] = ERL_DRV_UINT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 31: { + ErlDrvUInt64 x = 0; + msg[0] = ERL_DRV_UINT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 32: { + ErlDrvSInt64 x = ((((ErlDrvUInt64) 0x7fffffff) << 32) + | ((ErlDrvUInt64) 0xffffffff)); + msg[0] = ERL_DRV_INT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 33: { + ErlDrvSInt64 x = (ErlDrvSInt64) (((ErlDrvUInt64) 4711) << 32); + msg[0] = ERL_DRV_INT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 34: { + ErlDrvSInt64 x = 4711; + msg[0] = ERL_DRV_INT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 35: { + ErlDrvSInt64 x = 0; + msg[0] = ERL_DRV_INT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 36: { + ErlDrvSInt64 x = -1; + msg[0] = ERL_DRV_INT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 37: { + ErlDrvSInt64 x = -4711; + msg[0] = ERL_DRV_INT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 38: { + ErlDrvSInt64 x = ((ErlDrvSInt64) ((ErlDrvUInt64) 4711) << 32)*-1; + msg[0] = ERL_DRV_INT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + case 39: { + ErlDrvSInt64 x = ((ErlDrvSInt64) 1) << 63; + msg[0] = ERL_DRV_INT64; + msg[1] = (ErlDrvTermData) &x; + output_term(msg, 2); + + break; + } + + + case 127: /* Error cases */ + { + long refc; + ErlDrvBinary* bin = driver_alloc_binary(256); + + FAIL_TERM(msg, 0); + + msg[0] = ERL_DRV_LIST; + msg[1] = (ErlDrvTermData) 0; + FAIL_TERM(msg, 2); + + /* Not an atom */ + msg[0] = ERL_DRV_ATOM; + msg[1] = (ErlDrvTermData) driver_connected(erlang_port); + FAIL_TERM(msg, 2); + msg[0] = ERL_DRV_ATOM; + msg[1] = driver_term_nil; + FAIL_TERM(msg, 2); + + /* Not a pid */ + msg[0] = ERL_DRV_PID; + msg[1] = (ErlDrvTermData) driver_mk_atom("blurf"); + FAIL_TERM(msg, 2); + msg[0] = ERL_DRV_PID; + msg[1] = driver_term_nil; + FAIL_TERM(msg, 2); + + /* Not a port */ + msg[0] = ERL_DRV_PORT; + msg[1] = (ErlDrvTermData) driver_mk_atom("blurf"); + FAIL_TERM(msg, 2); + msg[0] = ERL_DRV_PORT; + msg[1] = driver_term_nil; + FAIL_TERM(msg, 2); + + /* Missing parameter on stack */ + msg[0] = ERL_DRV_STRING_CONS; + msg[1] = (ErlDrvTermData) "abc"; + msg[2] = (ErlDrvTermData) 3; + FAIL_TERM(msg, 3); + + /* + * The first binary reference is correct, the second is incorrect. + * There should not be any "binary leak". + */ + msg[0] = ERL_DRV_BINARY; + msg[1] = (ErlDrvTermData) bin; + msg[2] = (ErlDrvTermData) 256; + msg[3] = (ErlDrvTermData) 0; + msg[4] = ERL_DRV_BINARY; + msg[5] = (ErlDrvTermData) bin; + msg[6] = (ErlDrvTermData) 257; + msg[7] = (ErlDrvTermData) 0; + msg[8] = ERL_DRV_TUPLE; + msg[9] = (ErlDrvTermData) 2; + FAIL_TERM(msg, 10); + + msg[0] = ERL_DRV_BINARY; + msg[1] = (ErlDrvTermData) bin; + msg[2] = (ErlDrvTermData) 256; + msg[3] = (ErlDrvTermData) 0; + msg[4] = ERL_DRV_BINARY; + msg[5] = (ErlDrvTermData) bin; + msg[6] = (ErlDrvTermData) 256; + msg[7] = (ErlDrvTermData) 50; + msg[8] = ERL_DRV_TUPLE; + msg[9] = (ErlDrvTermData) 2; + FAIL_TERM(msg, 10); + + /* + * We have succefully built two binaries. We expect the ref count + * to be 1 (SMP) or 3 (non-SMP). + */ + refc = driver_binary_get_refc(bin); + if (refc > 3) { + char sbuf[128]; + sprintf(sbuf, "bad_refc:%d", refc); + driver_failure_atom(erlang_port, sbuf); + } + driver_free_binary(bin); + + + FAIL_TERM(msg, make_ext_term_list(msg, 1)); + + + /* + * Check that we fail for missing args. + * + * We setup valid terms but pass a too small size. We + * want valid terms since we want to verify that the + * failure really is due to the small size. + */ + msg[0] = ERL_DRV_ATOM; + msg[1] = (ErlDrvTermData) driver_mk_atom("an_atom"); + FAIL_TERM(msg, 1); + + msg[0] = ERL_DRV_INT; + msg[1] = (ErlDrvTermData) -4711; + FAIL_TERM(msg, 1); + + msg[0] = ERL_DRV_UINT; + msg[1] = (ErlDrvTermData) 4711; + FAIL_TERM(msg, 1); + + msg[0] = ERL_DRV_PORT; + msg[1] = driver_mk_port(erlang_port); + FAIL_TERM(msg, 1); + + { + char buf[] = "hejsan"; + ErlDrvBinary *dbin = driver_alloc_binary(sizeof(buf)-1); + if (!dbin) + driver_failure_posix(erlang_port, ENOMEM); + else { + memcpy((void *) dbin->orig_bytes, (void *) buf, sizeof(buf)-1); + msg[0] = ERL_DRV_BINARY; + msg[1] = (ErlDrvTermData) dbin; + msg[2] = (ErlDrvTermData) sizeof(buf)-1; + msg[3] = (ErlDrvTermData) 0; + FAIL_TERM(msg, 1); + FAIL_TERM(msg, 2); + FAIL_TERM(msg, 3); + driver_free_binary(dbin); + } + } + + { + char buf[] = "hoppsan"; + msg[0] = ERL_DRV_BUF2BINARY; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) sizeof(buf)-1; + FAIL_TERM(msg, 1); + FAIL_TERM(msg, 2); + } + + { + char buf[] = "hippsan"; + msg[0] = ERL_DRV_STRING; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) sizeof(buf)-1; + FAIL_TERM(msg, 1); + FAIL_TERM(msg, 2); + } + + msg[0] = ERL_DRV_TUPLE; + msg[1] = (ErlDrvTermData) 0; + FAIL_TERM(msg, 1); + + msg[0] = ERL_DRV_NIL; + msg[1] = ERL_DRV_LIST; + msg[2] = (ErlDrvTermData) 1; + FAIL_TERM(msg, 2); + + msg[0] = ERL_DRV_PID; + msg[1] = driver_connected(erlang_port); + FAIL_TERM(msg, 1); + + msg[0] = ERL_DRV_NIL; + msg[1] = ERL_DRV_STRING_CONS; + msg[2] = (ErlDrvTermData) ""; + msg[3] = (ErlDrvTermData) 0; + FAIL_TERM(msg, 2); + FAIL_TERM(msg, 3); + + { + double my_float = 0.0; + msg[0] = ERL_DRV_FLOAT; + msg[1] = (ErlDrvTermData) &my_float; + FAIL_TERM(msg, 1); + } + + { + char buf[] = {131, 106}; /* [] */ + msg[0] = ERL_DRV_EXT2TERM; + msg[1] = (ErlDrvTermData) buf; + msg[2] = (ErlDrvTermData) sizeof(buf); + FAIL_TERM(msg, 1); + FAIL_TERM(msg, 2); + } + + /* Signal end of test case */ + msg[0] = ERL_DRV_NIL; + driver_output_term(erlang_port, msg, 1); + } + break; + + default: + driver_failure_atom(erlang_port, "bad_request"); + break; + } +} + +static void output_term(ErlDrvTermData* msg, int len) +{ + if (driver_output_term(erlang_port, msg, len) <= 0) { + driver_failure_atom(erlang_port, "driver_output_term_failed"); + } +} + +static void fail_term(ErlDrvTermData* msg, int len, int line) +{ + int status = driver_output_term(erlang_port, msg, len); + + if (status == 1) { + char buf[1024]; + sprintf(buf, "%s:%d: unexpected success", __FILE__, line); + driver_failure_atom(erlang_port, buf); + } else if (status == 0) { + char buf[1024]; + sprintf(buf, "%s:%d: unexpected port error", __FILE__, line); + driver_failure_atom(erlang_port, buf); + } +} + +#include "ext_terms.h" + +/* + * <<131,103,100,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,36,0,0,0,0,1>> + * is a valid pid: <0.36.0> + * + * We replace the nodename tag (atom tag: 100) with a pid tag (103) to get an + * invalid pid. + */ +static unsigned char bad_ext_term[] = { + 131,103,103,0,12,97,110,111,100,101,64,103,111,114,98,97,103,0,0,0,36,0,0,0,0,1 + /* ^ + * | + * The bad tag. + */ +}; + +static int make_ext_term_list(ErlDrvTermData *td, int bad) +{ + int tdix = 0; + int i; + for (i = 0; i < NO_OF_EXT_TERMS; i++) { + td[tdix++] = ERL_DRV_EXT2TERM; + td[tdix++] = (ErlDrvTermData) &ext_terms[i].ext[0]; + td[tdix++] = (ErlDrvTermData) ext_terms[i].ext_size; + td[tdix++] = ERL_DRV_EXT2TERM; + td[tdix++] = (ErlDrvTermData) &ext_terms[i].cext[0]; + td[tdix++] = (ErlDrvTermData) ext_terms[i].cext_size; + td[tdix++] = ERL_DRV_TUPLE; + td[tdix++] = (ErlDrvTermData) 2; + } + if (bad) { /* Include a bad ext term */ + td[tdix++] = ERL_DRV_EXT2TERM; + td[tdix++] = (ErlDrvTermData) &bad_ext_term[0]; + td[tdix++] = (ErlDrvTermData) sizeof(bad_ext_term); + } + td[tdix++] = ERL_DRV_NIL; + td[tdix++] = ERL_DRV_LIST; + td[tdix++] = (ErlDrvTermData) (NO_OF_EXT_TERMS + (bad ? 2 : 1)); + return tdix; +} diff --git a/erts/emulator/test/sensitive_SUITE.erl b/erts/emulator/test/sensitive_SUITE.erl new file mode 100644 index 0000000000..458275af81 --- /dev/null +++ b/erts/emulator/test/sensitive_SUITE.erl @@ -0,0 +1,461 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(sensitive_SUITE). + +-include("test_server.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + stickiness/1,send_trace/1,recv_trace/1,proc_trace/1,call_trace/1, + meta_trace/1,running_trace/1,gc_trace/1,seq_trace/1, + t_process_info/1,t_process_display/1,save_calls/1]). + +-export([remote_process_display/0,an_exported_function/1]). + +-import(lists, [keysearch/3,foreach/2,sort/1]). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:minutes(5)), + [{watchdog,Dog}|Config]. + +fin_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +all(suite) -> + [stickiness,send_trace,recv_trace,proc_trace,call_trace, + meta_trace,running_trace,gc_trace,seq_trace, + t_process_info,t_process_display,save_calls]. + +stickiness(Config) when is_list(Config) -> + ?line {Tracer,Mref} = spawn_monitor(fun() -> + receive after infinity -> ok end + end), + ?line false = process_flag(sensitive, true), + put(foo, bar), + + Flags = sort([send,'receive',procs,call,running,garbage_collection, + set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link]), + ?line foreach(fun(F) -> + 1 = erlang:trace(self(), true, [F,{tracer,Tracer}]) + end, Flags), + ?line foreach(fun(F) -> + 1 = erlang:trace(self(), false, [F,{tracer,Tracer}]) + end, Flags), + ?line 1 = erlang:trace(self(), true, [{tracer,Tracer}|Flags]), + ?line 1 = erlang:trace(self(), false, [{tracer,Tracer}|Flags]), + + ?line {messages,[]} = process_info(Tracer, messages), + exit(Tracer, kill), + receive {'DOWN',Mref,_,_,_} -> ok end, + + case process_info(self(), dictionary) of + {dictionary,[]} -> ok; + {dictionary,_} -> ?line ?t:fail(sensitive_flag_cleared) + end, + + NewTracer = spawn_link(fun() -> receive after infinity -> ok end end), + ?line 1 = erlang:trace(self(), true, [{tracer,NewTracer}|Flags]), + ?line Flags = sort(element(2, erlang:trace_info(self(), flags))), + ?line {tracer,NewTracer} = erlang:trace_info(self(), tracer), + + %% Process still sensitive. Tracer should disappear when we clear + %% all trace flags. + ?line 1 = erlang:trace(self(), false, [{tracer,NewTracer}|Flags]), + ?line {tracer,[]} = erlang:trace_info(self(), tracer), + + ?line unlink(NewTracer), exit(NewTracer, kill), + ok. + +send_trace(Config) when is_list(Config) -> + ?line {Dead,Mref} = spawn_monitor(fun() -> ok end), + receive {'DOWN',Mref,_,_,_} -> ok end, + ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + ?line Sink = spawn_link(fun() -> receive after infinity -> ok end end), + Self = self(), + + ?line 1 = erlang:trace(self(), true, [send,{tracer,Tracer}]), + ?line Dead ! before, + ?line Sink ! before, + ?line false = process_flag(sensitive, true), + ?line Sink ! {blurf,lists:seq(1, 50)}, + ?line true = process_flag(sensitive, true), + ?line Sink ! lists:seq(1, 100), + ?line Dead ! forget_me, + ?line true = process_flag(sensitive, false), + ?line Sink ! after1, + ?line false = process_flag(sensitive, false), + ?line Sink ! after2, + ?line Dead ! after2, + ?line wait_trace(Self), + + ?line {messages,Messages} = process_info(Tracer, messages), + ?line [{trace,Self,send_to_non_existing_process,before,Dead}, + {trace,Self,send,before,Sink}, + {trace,Self,send,after1,Sink}, + {trace,Self,send,after2,Sink}, + {trace,Self,send_to_non_existing_process,after2,Dead}] = Messages, + + ?line unlink(Tracer), exit(Tracer, kill), + ?line unlink(Sink), exit(Sink, kill), + ok. + +recv_trace(Config) when is_list(Config) -> + Parent = self(), + ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + ?line Sender = spawn_link(fun() -> recv_trace_sender(Parent) end), + + ?line 1 = erlang:trace(self(), true, ['receive',{tracer,Tracer}]), + + Sender ! 1, + receive a -> wait_trace(Sender) end, + + ?line false = process_flag(sensitive, true), + + Sender ! 2, + receive {b,[x,y,z]} -> wait_trace(Sender) end, + + ?line true = process_flag(sensitive, false), + + Sender ! 3, + receive c -> wait_trace(Sender) end, + + ?line {messages,Messages} = process_info(Tracer, messages), + [{trace,Parent,'receive',a}, + {trace,Parent,'receive',{trace_delivered,_,_}}, + {trace,Parent,'receive',c}, + {trace,Parent,'receive',{trace_delivered,_,_}}] = Messages, + + ?line unlink(Tracer), exit(Tracer, kill), + ?line unlink(Sender), exit(Sender, kill), + ok. + +recv_trace_sender(Pid) -> + receive + 1 -> Pid ! a; + 2 -> Pid ! {b,[x,y,z]}; + 3 -> Pid ! c + end, + recv_trace_sender(Pid). + +proc_trace(Config) when is_list(Config) -> + Self = self(), + ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + ?line 1 = erlang:trace(self(), true, [procs,{tracer,Tracer}]), + ?line false = process_flag(sensitive, true), + + spawn(fun() -> ok end), + ?line register(nisse, self()), + ?line unregister(nisse), + ?line link(Tracer), + ?line unlink(Tracer), + ?line Linker0 = spawn_link(fun() -> ok end), + Mref0 = erlang:monitor(process, Linker0), + + ?line {_,Mref} = spawn_monitor(fun() -> link(Self), unlink(Self) end), + + receive {'DOWN',Mref0,_,_,_} -> ok end, + + receive {'DOWN',Mref,_,_,_} -> ok end, + + ?line true = process_flag(sensitive, false), + + Dead = spawn(fun() -> ok end), + ?line register(arne, self()), + ?line unregister(arne), + ?line {Linker,Mref2} = spawn_monitor(fun() -> link(Self), unlink(Self) end), + receive {'DOWN',Mref2,_,_,_} -> ok end, + ?line Last = spawn_link(fun() -> ok end), + receive after 10 -> ok end, + ?line wait_trace(all), + ?line {messages,Messages} = process_info(Tracer, messages), + [{trace,Self,spawn,Dead,{erlang,apply,_}}, + {trace,Self,register,arne}, + {trace,Self,unregister,arne}, + {trace,Self,spawn,Linker,_}, + {trace,Self,getting_linked,Linker}, + {trace,Self,getting_unlinked,Linker}, + {trace,Self,spawn,Last,_}, + {trace,Self,link,Last}, + {trace,Self,getting_unlinked,Last}] = Messages, + + ?line unlink(Tracer), exit(Tracer, kill), + ok. + +call_trace(Config) when is_list(Config) -> + Self = self(), + ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + ?line 1 = erlang:trace(self(), true, [call,{tracer,Tracer}]), + ?line 1 = erlang:trace_pattern({?MODULE,an_exported_function,1}, + true, [global]), + ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [global]), + ?line 1 = erlang:trace_pattern({erlang,binary_to_list,1}, true, [local]), + ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [local]), + + ?line false = process_flag(sensitive, true), + ?line {ok,42} = a_local_function(42), + ?line 7 = an_exported_function(6), + ?line <<7,8,9,10>> = list_to_binary(id([7,8,9,10])), + ?line [42,43] = binary_to_list(id(<<42,43>>)), + ?line true = process_flag(sensitive, false), + + ?line {ok,{a,b}} = a_local_function({a,b}), + ?line 1 = an_exported_function(0), + ?line <<1,2,3>> = list_to_binary(id([1,2,3])), + ?line [42,43,44] = binary_to_list(id(<<42,43,44>>)), + + ?line wait_trace(Self), + + ?line {messages,Messages} = process_info(Tracer, messages), + ?line [{trace,Self,call,{?MODULE,a_local_function,[{a,b}]}}, + {trace,Self,call,{?MODULE,an_exported_function,[0]}}, + {trace,Self,call,{?MODULE,id,[_]}}, + {trace,Self,call,{erlang,list_to_binary,[[1,2,3]]}}, + {trace,Self,call,{sensitive_SUITE,id,[<<42,43,44>>]}}, + {trace,Self,call,{erlang,binary_to_list,[<<42,43,44>>]}}, + {trace,Self,call,{?MODULE,wait_trace,[Self]}}] = Messages, + + ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [local]), + ?line erlang:trace_pattern({erlang,'_','_'}, false, [local]), + ?line erlang:trace_pattern({'_','_','_'}, false, [global]), + + ?line unlink(Tracer), exit(Tracer, kill), + ok. + +meta_trace(Config) when is_list(Config) -> + Self = self(), + ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, true, [{meta,Tracer}]), + ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, true, [{meta,Tracer}]), + + ?line false = process_flag(sensitive, true), + ?line {ok,blurf} = a_local_function(blurf), + ?line 100 = an_exported_function(99), + ?line <<8,9,10>> = list_to_binary(id([8,9,10])), + ?line true = process_flag(sensitive, false), + + ?line {ok,{x,y}} = a_local_function({x,y}), + ?line 1 = an_exported_function(0), + ?line <<10>> = list_to_binary(id([10])), + ?line wait_trace(Self), + + ?line Local = erlang:trace_pattern({?MODULE,'_','_'}, false, [meta]), + ?line 1 = erlang:trace_pattern({erlang,list_to_binary,1}, false, [meta]), + ?line a_local_function(0), + + ?line {messages,Messages} = process_info(Tracer, messages), + ?line [{trace_ts,Self,call,{?MODULE,a_local_function,[{x,y}]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,an_exported_function,[0]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,id,[_]},{_,_,_}}, + {trace_ts,Self,call,{erlang,list_to_binary,[[10]]},{_,_,_}}, + {trace_ts,Self,call,{?MODULE,wait_trace,[Self]},{_,_,_}}] = Messages, + + ?line unlink(Tracer), exit(Tracer, kill), + ok. + +a_local_function(A) -> + {ok,A}. + +an_exported_function(X) -> + X+1. + +running_trace(Config) when is_list(Config) -> + Self = self(), + ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + ?line false = process_flag(sensitive, true), + ?line 1 = erlang:trace(Self, true, [running,{tracer,Tracer}]), + erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), + erlang:yield(), erlang:yield(), erlang:yield(), erlang:yield(), + ?line true = process_flag(sensitive, false), + erlang:yield(), + ?line 1 = erlang:trace(Self, false, [running,{tracer,Tracer}]), + + ?line wait_trace(Self), + ?line {messages,Messages} = process_info(Tracer, messages), + ?line [{trace,Self,out,{sensitive_SUITE,running_trace,1}}, + {trace,Self,in,{sensitive_SUITE,running_trace,1}}] = Messages, + + ?line unlink(Tracer), exit(Tracer, kill), + ok. + +gc_trace(Config) when is_list(Config) -> + Self = self(), + ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + + ?line false = process_flag(sensitive, true), + ?line 1 = erlang:trace(Self, true, [garbage_collection,{tracer,Tracer}]), + erlang:garbage_collect(), erlang:garbage_collect(), + erlang:garbage_collect(), erlang:garbage_collect(), + erlang:garbage_collect(), erlang:garbage_collect(), + erlang:garbage_collect(), erlang:garbage_collect(), + ?line true = process_flag(sensitive, false), + erlang:garbage_collect(), + ?line 1 = erlang:trace(Self, false, [garbage_collection,{tracer,Tracer}]), + + ?line wait_trace(Self), + ?line {messages,Messages} = process_info(Tracer, messages), + ?line [{trace,Self,gc_start,_},{trace,Self,gc_end,_}] = Messages, + + ?line unlink(Tracer), exit(Tracer, kill), + ok. + +seq_trace(Config) when is_list(Config) -> + Self = self(), + ?line Tracer = spawn_link(fun() -> receive after infinity -> ok end end), + ?line seq_trace:set_system_tracer(Tracer), + + ?line false = process_flag(sensitive, true), + + ?line Echo = spawn_link(fun() -> + receive + {Pid,Message} -> + Pid ! {reply,Message} + end + end), + ?line Sender = spawn_link(fun() -> + seq_trace:set_token(label, 42), + seq_trace:set_token('receive', true), + seq_trace:set_token(send, true), + seq_trace:set_token(print, true), + seq_trace:print(42, "trace started"), + Self ! blurf + end), + seq_trace:set_token(label, 17), + seq_trace:set_token('receive', true), + seq_trace:set_token(send, true), + seq_trace:set_token(print, true), + seq_trace:print(17, "trace started"), + Echo ! {Self,hello}, + receive {reply,hello} -> ok end, + receive blurf -> ok end, + + ?line wait_trace(all), + + ?line {messages,Messages} = process_info(Tracer, messages), + ?line [{seq_trace,17,{'receive',{0,2},Self,Echo,{Self,hello}}}, + {seq_trace,17,{send,{2,3},Echo,Self,{reply,hello}}}] = + [M || {seq_trace,17,_}=M <- Messages], + + ?line [{seq_trace,42,{print,{0,1},Sender,[],"trace started"}}, + {seq_trace,42,{send,{0,2},Sender,Self,blurf}}] = + [M || {seq_trace,42,_}=M <- Messages], + + ?line unlink(Tracer), exit(Tracer, kill), + ?line unlink(Echo), exit(Echo, kill), + ?line unlink(Sender), exit(Sender, kill), + ok. + +t_process_info(Config) when is_list(Config) -> + Parent = self(), + ?line Pid = spawn_link(fun() -> + put(foo, bar), + false = process_flag(sensitive, true), + Parent ! go, + receive + revert -> + true = process_flag(sensitive, false), + Parent ! go_again, + receive never -> ok end + end end), + receive go -> ok end, + + ?line put(foo, bar), + ?line self() ! Pid ! {i,am,a,message}, + + ?line false = process_flag(sensitive, true), + ?line t_process_info_suppressed(self()), + ?line t_process_info_suppressed(Pid), + + ?line true = process_flag(sensitive, false), + Pid ! revert, + receive go_again -> ok end, + + ?line t_process_info_normal(self()), + ?line t_process_info_normal(Pid), + ok. + +t_process_info_suppressed(Pid) -> + [] = my_process_info(Pid, dictionary), + <<>> = my_process_info(Pid, backtrace), + [] = my_process_info(Pid, messages). + +t_process_info_normal(Pid) -> + {value,{foo,bar}} = keysearch(foo, 1, my_process_info(Pid, dictionary)), + case process_info(Pid, backtrace) of + {backtrace,Bin} when size(Bin) > 20 -> ok + end, + [{i,am,a,message}] = my_process_info(Pid, messages). + +my_process_info(Pid, Tag) -> + {Tag,Value} = process_info(Pid, Tag), + All = process_info(Pid), + case keysearch(Tag, 1, All) of + false -> Value; + {value,{Tag,Value}} -> Value + end. + +t_process_display(Config) when is_list(Config) -> + ?line Dir = filename:dirname(code:which(?MODULE)), + ?line Cmd = atom_to_list(lib:progname()) ++ " -noinput -pa " ++ Dir ++ + " -run " ++ ?MODULE_STRING ++ " remote_process_display", + ?line io:put_chars(Cmd), + ?line P = open_port({spawn,Cmd}, [in,stderr_to_stdout,eof]), + <<"done",_/binary>> = get_all(P), + ok. + +remote_process_display() -> + false = process_flag(sensitive, true), + erlang:process_display(self(), backtrace), + erlang:display(done), + receive after 10 -> ok end, + init:stop(). + +get_all(P) -> + get_all(P, []). + +get_all(P, Acc) -> + receive + {P,{data,S}} -> + get_all(P, [Acc|S]); + {P,eof} -> + iolist_to_binary(Acc) + end. + +save_calls(Config) when is_list(Config) -> + process_flag(save_calls, 10), + + false = process_flag(sensitive, true), + ?line {last_calls,LastCalls} = process_info(self(), last_calls), + ?line [{erlang,process_flag,2}] = LastCalls, + ?line [2,4,6] = lists:map(fun(E) -> 2*E end, [1,2,3]), + ?line {last_calls,LastCalls} = process_info(self(), last_calls), + ok. + +wait_trace(Pid) -> + Ref = erlang:trace_delivered(Pid), + receive + {trace_delivered,Pid,Ref} -> ok + end. + +id(I) -> I. + diff --git a/erts/emulator/test/signal_SUITE.erl b/erts/emulator/test/signal_SUITE.erl new file mode 100644 index 0000000000..e9103ca3c1 --- /dev/null +++ b/erts/emulator/test/signal_SUITE.erl @@ -0,0 +1,544 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : signal_SUITE.erl +%%% Author : Rickard Green +%%% Description : Test signals +%%% +%%% Created : 10 Jul 2006 by Rickard Green +%%%------------------------------------------------------------------- +-module(signal_SUITE). +-author('rickard.s.green@ericsson.com'). + +-define(DEFAULT_TIMEOUT_SECONDS, 120). + +%-define(line_trace, 1). +-include("test_server.hrl"). +-export([all/1]). + +% Test cases +-export([xm_sig_order/1, + pending_exit_unlink_process/1, + pending_exit_unlink_dist_process/1, + pending_exit_unlink_port/1, + pending_exit_trap_exit/1, + pending_exit_receive/1, + pending_exit_exit/1, + pending_exit_gc/1, + pending_exit_is_process_alive/1, + pending_exit_process_display/1, + pending_exit_process_info_1/1, + pending_exit_process_info_2/1, + pending_exit_group_leader/1, + exit_before_pending_exit/1]). + +-export([init_per_testcase/2, fin_per_testcase/2, end_per_suite/1]). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMEOUT_SECONDS)), + available_internal_state(true), + ?line [{testcase, Func},{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + ?line Dog = ?config(watchdog, Config), + ?line ?t:timetrap_cancel(Dog). + +end_per_suite(_Config) -> + available_internal_state(true), + erts_debug:set_internal_state(not_running_optimization, true), + available_internal_state(false). + +all(suite) -> + [xm_sig_order, + pending_exit_unlink_process, + pending_exit_unlink_dist_process, + pending_exit_unlink_port, + pending_exit_trap_exit, + pending_exit_receive, + pending_exit_trap_exit, + pending_exit_gc, + pending_exit_is_process_alive, + pending_exit_process_display, + pending_exit_process_info_1, + pending_exit_process_info_2, + pending_exit_group_leader, + exit_before_pending_exit]. + +xm_sig_order(doc) -> ["Test that exit signals and messages are received " + "in correct order"]; +xm_sig_order(suite) -> []; +xm_sig_order(Config) when is_list(Config) -> + ?line LNode = node(), + ?line repeat(fun () -> xm_sig_order_test(LNode) end, 1000), + ?line {ok, RNode} = start_node(Config), + ?line repeat(fun () -> xm_sig_order_test(RNode) end, 1000), + ?line stop_node(RNode), + ?line ok. + + +xm_sig_order_test(Node) -> + ?line P = spawn(Node, fun () -> xm_sig_order_proc() end), + ?line M = erlang:monitor(process, P), + ?line P ! may_reach, + ?line P ! may_reach, + ?line P ! may_reach, + ?line exit(P, good_signal_order), + ?line P ! may_not_reach, + ?line P ! may_not_reach, + ?line P ! may_not_reach, + ?line receive + {'DOWN', M, process, P, R} -> + ?line good_signal_order = R + end. + +xm_sig_order_proc() -> + receive + may_not_reach -> exit(bad_signal_order); + may_reach -> ok + after 0 -> ok + end, + xm_sig_order_proc(). + +pending_exit_unlink_process(doc) -> []; +pending_exit_unlink_process(suite) -> []; +pending_exit_unlink_process(Config) when is_list(Config) -> + ?line pending_exit_test(self(), unlink). + +pending_exit_unlink_dist_process(doc) -> []; +pending_exit_unlink_dist_process(suite) -> []; +pending_exit_unlink_dist_process(Config) when is_list(Config) -> + ?line {ok, Node} = start_node(Config), + ?line From = spawn(Node, fun () -> receive after infinity -> ok end end), + ?line Res = pending_exit_test(From, unlink), + ?line stop_node(Node), + ?line Res. + +pending_exit_unlink_port(doc) -> []; +pending_exit_unlink_port(suite) -> []; +pending_exit_unlink_port(Config) when is_list(Config) -> + ?line pending_exit_test(hd(erlang:ports()), unlink). + +pending_exit_trap_exit(doc) -> []; +pending_exit_trap_exit(suite) -> []; +pending_exit_trap_exit(Config) when is_list(Config) -> + ?line pending_exit_test(self(), trap_exit). + +pending_exit_receive(doc) -> []; +pending_exit_receive(suite) -> []; +pending_exit_receive(Config) when is_list(Config) -> + ?line pending_exit_test(self(), 'receive'). + +pending_exit_exit(doc) -> []; +pending_exit_exit(suite) -> []; +pending_exit_exit(Config) when is_list(Config) -> + ?line pending_exit_test(self(), exit). + +pending_exit_gc(doc) -> []; +pending_exit_gc(suite) -> []; +pending_exit_gc(Config) when is_list(Config) -> + ?line pending_exit_test(self(), gc). + +pending_exit_test(From, Type) -> + ?line case catch erlang:system_info(smp_support) of + true -> + ?line OTE = process_flag(trap_exit, true), + ?line Ref = make_ref(), + ?line Master = self(), + ?line ExitBySignal = case Type of + gc -> + lists:duplicate(10000, + exit_by_signal); + _ -> + exit_by_signal + end, + ?line Pid = spawn_link( + fun () -> + receive go -> ok end, + false = have_pending_exit(), + exit = fake_exit(From, + self(), + ExitBySignal), + true = have_pending_exit(), + Master ! {self(), Ref, Type}, + case Type of + gc -> + force_gc(), + erlang:yield(); + unlink -> + unlink(From); + trap_exit -> + process_flag(trap_exit, true); + 'receive' -> + receive _ -> ok + after 0 -> ok + end; + exit -> + ok + end, + exit(exit_by_myself) + end), + ?line Mon = erlang:monitor(process, Pid), + ?line Pid ! go, + ?line Reason = receive + {'DOWN', Mon, process, Pid, R} -> + ?line receive + {Pid, Ref, Type} -> + ?line ok + after 0 -> + ?line ?t:fail(premature_exit) + end, + ?line case Type of + exit -> + ?line exit_by_myself = R; + _ -> + ?line ExitBySignal = R + end + end, + ?line receive + {'EXIT', Pid, R2} -> + ?line Reason = R2 + end, + ?line process_flag(trap_exit, OTE), + ?line ok, + {comment, + "Test only valid with current SMP emulator."}; + _ -> + {skipped, + "SMP support not enabled. " + "Test only valid with current SMP emulator."} + end. + + + +exit_before_pending_exit(doc) -> []; +exit_before_pending_exit(suite) -> []; +exit_before_pending_exit(Config) when is_list(Config) -> + %% This is a testcase testcase very specific to the smp + %% implementation as it is of the time of writing. + %% + %% The testcase tries to check that a process can + %% exit by itself even though it has a pending exit. + ?line OTE = process_flag(trap_exit, true), + ?line Master = self(), + ?line Tester = spawn_link( + fun () -> + Opts = case {erlang:system_info(run_queues), + erlang:system_info(schedulers_online)} of + {RQ, SO} when RQ =:= 1; SO =:= 1 -> []; + _ -> + process_flag(scheduler, 1), + [{scheduler, 2}] + end, + P = self(), + Exiter = spawn_opt(fun () -> + receive + {exit_me, P, R} -> + exit(P, R) + end + end, Opts), + erlang:yield(), + Exiter ! {exit_me, self(), exited_by_exiter}, + %% We want to get a pending exit + %% before we exit ourselves. We + %% don't want to be scheduled out + %% since we will then see the + %% pending exit. + %% + %% Do something that takes + %% relatively long time but + %% consumes few reductions... + repeat(fun() -> erlang:system_info(procs) end,10), + %% ... then exit. + Master ! {self(), + pending_exit, + have_pending_exit()}, + exit(exited_by_myself) + end), + ?line PendingExit = receive {Tester, pending_exit, PE} -> PE end, + ?line receive + {'EXIT', Tester, exited_by_myself} -> + ?line process_flag(trap_exit, OTE), + ?line ok; + Msg -> + ?line ?t:fail({unexpected_message, Msg}) + end, + NoScheds = integer_to_list(erlang:system_info(schedulers_online)), + {comment, + "Was " + ++ case PendingExit of + true -> ""; + false ->"*not*" + end ++ " able to trigger a pending exit. " + ++ "Running on " ++ NoScheds ++ " scheduler(s). " + ++ "This test is only interesting with at least two schedulers."}. + +-define(PE_INFO_REPEAT, 100). + +pending_exit_is_process_alive(Config) when is_list(Config) -> + ?line S = exit_op_test_init(), + ?line TestFun = fun (P) -> false = is_process_alive(P) end, + ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + ?line verify_pending_exit_success(S), + ?line comment(). + +pending_exit_process_info_1(Config) when is_list(Config) -> + ?line S = exit_op_test_init(), + ?line TestFun = fun (P) -> + undefined = process_info(P) + end, + ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + ?line verify_pending_exit_success(S), + ?line comment(). + +pending_exit_process_info_2(Config) when is_list(Config) -> + ?line S0 = exit_op_test_init(), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, messages) + end, ?PE_INFO_REPEAT), + ?line S1 = verify_pending_exit_success(S0), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, status) + end, ?PE_INFO_REPEAT), + ?line S2 = verify_pending_exit_success(S1), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, links) + end, ?PE_INFO_REPEAT), + ?line S3 = verify_pending_exit_success(S2), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, [messages]) + end, ?PE_INFO_REPEAT), + ?line S4 = verify_pending_exit_success(S3), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, [status]) + end, ?PE_INFO_REPEAT), + ?line S5 = verify_pending_exit_success(S4), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, [links]) + end, ?PE_INFO_REPEAT), + ?line S6 = verify_pending_exit_success(S5), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, [status, + links]) + end, ?PE_INFO_REPEAT), + ?line S7 = verify_pending_exit_success(S6), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, [messages, + status]) + end, ?PE_INFO_REPEAT), + ?line S8 = verify_pending_exit_success(S7), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, [messages, + links]) + end, ?PE_INFO_REPEAT), + ?line S9 = verify_pending_exit_success(S8), + ?line repeated_exit_op_test( + fun (P) -> + undefined = process_info(P, [message_queue_len, + status]) + end, ?PE_INFO_REPEAT), + ?line S10 = verify_pending_exit_success(S9), + ?line repeated_exit_op_test(fun (P) -> + undefined = process_info(P, [messages, + links, + status]) + end, ?PE_INFO_REPEAT), + ?line verify_pending_exit_success(S10), + ?line comment(). + +pending_exit_process_display(Config) when is_list(Config) -> + ?line S = exit_op_test_init(), + ?line TestFun = fun (P) -> + badarg = try + erlang:process_display(P, backtrace) + catch + error:badarg -> badarg + end + end, + ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + ?line verify_pending_exit_success(S), + ?line comment(). + +pending_exit_group_leader(Config) when is_list(Config) -> + ?line S = exit_op_test_init(), + ?line TestFun = fun (P) -> + badarg = try + group_leader(self(), P) + catch + error:badarg -> badarg + end + end, + ?line repeated_exit_op_test(TestFun, ?PE_INFO_REPEAT), + ?line verify_pending_exit_success(S), + ?line comment(). + +%% +%% -- Internal utils -------------------------------------------------------- +%% +exit_op_test_init() -> + put(no_pending_exit_success, 0), + put(no_pending_exit_tries, 0), + {case {erlang:system_info(run_queues), + erlang:system_info(schedulers_online)} of + {RQ, SO} when RQ =:= 1; SO =:= 1 -> false; + _ -> true + end, 0, 0}. + +verify_pending_exit_success({false, _, _} = S) -> + S; +verify_pending_exit_success({true, S, T}) -> + NewS = get(no_pending_exit_success), + NewT = get(no_pending_exit_tries), + case NewT =:= T of + true -> ok; + _ -> case NewS > S of + true -> ok; + _ -> exit(no_pending_exits) + end + end, + {true, NewS, NewT}. + +comment() -> + {comment, + "Pending exit trigger ratio " + ++ integer_to_list(get(no_pending_exit_success)) + ++ "/" + ++ integer_to_list(get(no_pending_exit_tries)) + ++ "." + ++ case get(not_running_opt_test) of + true -> " No 'not running optimization' to disable."; + _ -> "" + end}. + +repeated_exit_op_test(TestFun, N) -> + WorkFun0 = fun () -> + lists:sort(lists:reverse(lists:seq(1, 1000))) + end, + repeat(fun () -> exit_op_test(TestFun, WorkFun0) end, N), + try erts_debug:set_internal_state(not_running_optimization, false) of + Bool when Bool == true; Bool == false -> + WorkFun1 = fun () -> + erts_debug:set_internal_state(sleep, 0), + lists:sort(lists:reverse(lists:seq(1, 1000))) + end, + repeat(fun () -> + exit_op_test(TestFun, WorkFun1) + end, N) + catch + error:notsup -> put(not_running_opt_test, true) + after + catch erts_debug:set_internal_state(not_running_optimization, true) + end. + +exit_op_test(TestFun, WorkFun) -> + Opts = case {erlang:system_info(run_queues), + erlang:system_info(schedulers_online)} of + {RQ, SO} when RQ =:= 1; SO =:= 1 -> []; + _ -> + process_flag(scheduler, 1), + [{scheduler, 2}] + end, + Master = self(), + Going = make_ref(), + P = spawn_opt(fun () -> + loop(10, WorkFun), + Master ! Going, + loop(infinity, WorkFun) + end, Opts), + receive Going -> ok end, + loop(10, WorkFun), + erlang:yield(), + exit(P, bang), + PE0 = have_pending_exit(P), + TestFun(P), + PE = case PE0 of + true -> true; + _ -> false + end, + case {PE, get(no_pending_exit_success), get(no_pending_exit_tries)} of + {true, undefined, undefined} -> + put(no_pending_exit_success, 1), + put(no_pending_exit_tries, 1); + {false, undefined, undefined} -> + put(no_pending_exit_success, 0), + put(no_pending_exit_tries, 1); + {true, S, T} -> + put(no_pending_exit_success, S+1), + put(no_pending_exit_tries, T+1); + {false, _S, T} -> + put(no_pending_exit_tries, T+1) + end, + ok. + +loop(infinity, WorkFun) -> + do_loop(infinity, WorkFun); +loop(0, _WorkFun) -> + ok; +loop(N, WorkFun) when is_integer(N) -> + do_loop(N-1, WorkFun). + +do_loop(N, WorkFun) -> + WorkFun(), + loop(N, WorkFun). + +repeat(_Fun, N) when is_integer(N), N =< 0 -> + ok; +repeat(Fun, N) when is_integer(N) -> + Fun(), + repeat(Fun, N-1). + +start_node(Config) -> + {A, B, C} = now(), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" ++ atom_to_list(?config(testcase, Config)) + ++ "-" ++ integer_to_list(A) + ++ "-" ++ integer_to_list(B) + ++ "-" ++ integer_to_list(C)), + Pa = filename:dirname(code:which(?MODULE)), + ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]). + +stop_node(Node) -> + ?t:stop_node(Node). + +have_pending_exit() -> + have_pending_exit(self()). + +have_pending_exit(Pid) -> + erts_debug:get_internal_state({have_pending_exit, Pid}). + +force_gc() -> + erts_debug:set_internal_state(force_gc, self()). + +fake_exit(From, To, Reason) -> + erts_debug:set_internal_state(send_fake_exit_signal, {From, To, Reason}). + +available_internal_state(Bool) when Bool == true; Bool == false -> + case {Bool, + (catch erts_debug:get_internal_state(available_internal_state))} of + {true, true} -> + true; + {false, true} -> + erts_debug:set_internal_state(available_internal_state, false), + true; + {true, _} -> + erts_debug:set_internal_state(available_internal_state, true), + false; + {false, _} -> + false + end. diff --git a/erts/emulator/test/statistics_SUITE.erl b/erts/emulator/test/statistics_SUITE.erl new file mode 100644 index 0000000000..bc12821887 --- /dev/null +++ b/erts/emulator/test/statistics_SUITE.erl @@ -0,0 +1,341 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(statistics_SUITE). + +%% Tests the statistics/1 bif. + +-export([all/1, + init_per_testcase/2, + fin_per_testcase/2, + wall_clock/1, wall_clock_zero_diff/1, wall_clock_update/1, + runtime/1, runtime_zero_diff/1, runtime_zero_update/1, + runtime_update/1, runtime_diff/1, + run_queue/1, run_queue_one/1, + reductions/1, reductions_big/1, garbage_collection/1, io/1, + badarg/1]). + +%% Internal exports. + +-export([hog/1]). + +-include("test_server.hrl"). + +init_per_testcase(_, Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(300)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +all(suite) -> [wall_clock, runtime, reductions, reductions_big, run_queue, + garbage_collection, io, badarg]. + + +%%% Testing statistics(wall_clock). + +wall_clock(suite) -> [wall_clock_zero_diff, wall_clock_update]. + + +wall_clock_zero_diff(doc) -> + "Tests that the 'Wall clock since last call' element of the result " + "is zero when statistics(runtime) is called twice in succession."; +wall_clock_zero_diff(Config) when is_list(Config) -> + wall_clock_zero_diff1(16). + +wall_clock_zero_diff1(N) when N > 0 -> + ?line {Time, _} = statistics(wall_clock), + ?line case statistics(wall_clock) of + {Time, 0} -> ok; + _ -> wall_clock_zero_diff1(N-1) + end; +wall_clock_zero_diff1(0) -> + ?line test_server:fail("Difference never zero."). + +wall_clock_update(doc) -> + "Test that the time differences returned by two calls to " + "statistics(wall_clock) are compatible, and are within a small number " + "of ms of the amount of real time we waited for."; +wall_clock_update(Config) when is_list(Config) -> + wall_clock_update1(6). + +wall_clock_update1(N) when N > 0 -> + ?line {T1_wc_time, _} = statistics(wall_clock), + ?line receive after 1000 -> ok end, + ?line {T2_wc_time, Wc_Diff} = statistics(wall_clock), + + ?line Wc_Diff = T2_wc_time - T1_wc_time, + ?line test_server:format("Wall clock diff = ~p; should be = 1000..1040~n", + [Wc_Diff]), + case ?t:is_debug() of + false -> + ?line true = Wc_Diff =< 1040; + true -> + ?line true = Wc_Diff =< 2000 %Be more tolerant in debug-compiled emulator. + end, + ?line true = Wc_Diff >= 1000, + wall_clock_update1(N-1); +wall_clock_update1(0) -> + ok. + + +%%% Test statistics(runtime). + +runtime(suite) -> [runtime_zero_diff, runtime_zero_update, runtime_update, + runtime_diff]. + +runtime_zero_diff(doc) -> + "Tests that the difference between the times returned from two consectuitive " + "calls to statistics(runtime) is zero."; +runtime_zero_diff(Config) when is_list(Config) -> + ?line runtime_zero_diff1(16). + +runtime_zero_diff1(N) when N > 0 -> + ?line {T1, _} = statistics(runtime), + ?line case statistics(runtime) of + {T1, 0} -> ok; + _ -> runtime_zero_diff1(N-1) + end; +runtime_zero_diff1(0) -> + ?line test_server:fail("statistics(runtime) never returned zero difference"). + +runtime_zero_update(doc) -> + "Test that the time differences returned by two calls to " + "statistics(runtime) several seconds apart is zero."; +runtime_zero_update(Config) when is_list(Config) -> + case ?t:is_debug() of + false -> ?line runtime_zero_update1(6); + true -> {skip,"Unreliable in DEBUG build"} + end. + +runtime_zero_update1(N) when N > 0 -> + ?line {T1, _} = statistics(runtime), + ?line receive after 7000 -> ok end, + ?line case statistics(runtime) of + {T, Td} when Td =< 80 -> + test_server:format("ok, Runtime before: {~p, _} after: {~p, ~p}", + [T1, T, Td]), + ok; + {T, R} -> + test_server:format("nok, Runtime before: {~p, _} after: {~p, ~p}", + [T1, T, R]), + runtime_zero_update1(N-1) + end; +runtime_zero_update1(0) -> + ?line test_server:fail("statistics(runtime) never returned zero difference"). + +runtime_update(doc) -> + "Test that the statistics(runtime) returns a substanstially updated difference " + "after running a process that takes all CPU power of the Erlang process " + "for a second."; +runtime_update(Config) when is_list(Config) -> + case ?t:is_cover() of + false -> + ?line process_flag(priority, high), + ?line test_server:m_out_of_n(1, 10, fun runtime_update/0); + true -> + {skip,"Cover-compiled"} + end. + +runtime_update() -> + ?line {T1,_} = statistics(runtime), + ?line spawn_link(fun cpu_heavy/0), + receive after 1000 -> ok end, + ?line {T2,Diff} = statistics(runtime), + ?line Delta = abs(Diff-1000), + ?line test_server:format("T1 = ~p, T2 = ~p, Diff = ~p, abs(Diff-1000) = ~p", + [T1,T2,Diff,Delta]), + ?line if + abs(Diff-1000) =:= Delta, Delta =< 100 -> + ok + end. + +cpu_heavy() -> + cpu_heavy(). + +runtime_diff(doc) -> + "Test that the difference between two consecutive absolute runtimes is " + "equal to the last relative runtime. The loop runs a lot of times since " + "the bug which this test case tests for showed up only rarely."; +runtime_diff(Config) when is_list(Config) -> + runtime_diff1(1000). + +runtime_diff1(N) when N > 0 -> + ?line {T1_wc_time, _} = statistics(runtime), + ?line do_much(), + ?line {T2_wc_time, Wc_Diff} = statistics(runtime), + ?line Wc_Diff = T2_wc_time - T1_wc_time, + runtime_diff1(N-1); +runtime_diff1(0) -> + ok. + +%%% do_much(100000) takes about 760 ms on boromir. +%%% do_much(1000) takes about 8 ms on boromir. + +do_much() -> + do_much(1000). + +do_much(0) -> + ok; +do_much(N) -> + _ = 4784728478274827 * 72874284728472, + do_much(N-1). + + +reductions(doc) -> + "Test that statistics(reductions) is callable, and that " + "Total_Reductions and Reductions_Since_Last_Call make sense. " + "(This to fail on pre-R3A version of JAM."; +reductions(Config) when is_list(Config) -> + {Reductions, _} = statistics(reductions), + + %% Each loop of reductions/2 takes 4 reductions + that the garbage built + %% outside the heap in the BIF calls will bump the reductions. + %% 300 * 4 is more than CONTEXT_REDS (1000). Thus, there will be one or + %% more context switches. + + reductions(300, Reductions). + +reductions(N, Previous) when N > 0 -> + ?line {Reductions, Diff} = statistics(reductions), + ?line build_some_garbage(), + ?line if Reductions > 0 -> ok end, + ?line if Diff >= 0 -> ok end, + io:format("Previous = ~p, Reductions = ~p, Diff = ~p, DiffShouldBe = ~p", + [Previous, Reductions, Diff, Reductions-Previous]), + ?line if Reductions == Previous+Diff -> reductions(N-1, Reductions) end; +reductions(0, _) -> + ok. + +build_some_garbage() -> + %% This will build garbage outside the process heap, which will cause + %% a garbage collection in the scheduler. + processes(). + +reductions_big(doc) -> + "Test that the number of reductions can be returned as a big number."; +reductions_big(Config) when is_list(Config) -> + ?line reductions_big_loop(), + ok. + +reductions_big_loop() -> + erlang:yield(), + case statistics(reductions) of + {Red, Diff} when Red >= 16#7ffFFFF -> + ok = io:format("Reductions = ~w, Diff = ~w", [Red, Diff]); + _ -> + reductions_big_loop() + end. + + +%%% Tests of statistics(run_queue). + +run_queue(suite) -> [run_queue_one]. + +run_queue_one(doc) -> + "Tests that statistics(run_queue) returns 1 if we start a " + "CPU-bound process."; +run_queue_one(Config) when is_list(Config) -> + ?line MS = erlang:system_flag(multi_scheduling, block), + ?line run_queue_one_test(Config), + ?line erlang:system_flag(multi_scheduling, unblock), + case MS of + blocked -> + {comment, + "Multi-scheduling blocked during test. This test-case " + "was not written to work with multiple schedulers."}; + _ -> ok + end. + + +run_queue_one_test(Config) when is_list(Config) -> + ?line Hog = spawn_link(?MODULE, hog, [self()]), + ?line receive + hog_started -> + Hog ! go + end, + ?line receive after 100 -> ok end, % Give hog a head start. + ?line case statistics(run_queue) of + N when N >= 1 -> ok; + Other -> ?line ?t:fail({unexpected,Other}) + end, + ok. + +%% CPU-bound process, going at low priority. It will always be ready +%% to run. + +hog(Pid) -> + ?line process_flag(priority, low), + ?line Pid ! hog_started, + ?line receive + go -> hog_iter(0) + end. + +hog_iter(N) when N > 0 -> + ?line hog_iter(N-1); +hog_iter(0) -> + ?line hog_iter(10000). + + +garbage_collection(doc) -> + "Tests that statistics(garbage_collection) is callable. " + "It is not clear how to test anything more."; +garbage_collection(Config) when is_list(Config) -> + ?line Bin = list_to_binary(lists:duplicate(19999, 42)), + ?line case statistics(garbage_collection) of + {Gcs0,R,0} when is_integer(Gcs0), is_integer(R) -> + ?line io:format("Reclaimed: ~p", [R]), + ?line Gcs = garbage_collection_1(Gcs0, Bin), + ?line io:format("Reclaimed: ~p", + [element(2, statistics(garbage_collection))]), + {comment,integer_to_list(Gcs-Gcs0)++" GCs"} + end. + +garbage_collection_1(Gcs0, Bin) -> + case statistics(garbage_collection) of + {Gcs,Reclaimed,0} when Gcs >= Gcs0 -> + if + Reclaimed > 16#7ffffff -> + Gcs; + true -> + _ = binary_to_list(Bin), + erlang:garbage_collect(), + garbage_collection_1(Gcs, Bin) + end + end. + +io(doc) -> + "Tests that statistics(io) is callable. " + "This could be improved to test something more."; +io(Config) when is_list(Config) -> + ?line case statistics(io) of + {{input,In},{output,Out}} when is_integer(In), is_integer(Out) -> ok + end. + +badarg(doc) -> + "Tests that some illegal arguments to statistics fails."; +badarg(Config) when is_list(Config) -> + ?line case catch statistics(1) of + {'EXIT', {badarg, _}} -> ok + end, + ?line case catch statistics(bad_atom) of + {'EXIT', {badarg, _}} -> ok + end. diff --git a/erts/emulator/test/suite_release.exclude b/erts/emulator/test/suite_release.exclude new file mode 100644 index 0000000000..74fdcc9653 --- /dev/null +++ b/erts/emulator/test/suite_release.exclude @@ -0,0 +1,6 @@ +driver_SUITE.erl +driver_SUITE_data +port_SUITE.erl +port_SUITE_data +fun_r7_SUITE.erl +node_container_SUITE.erl diff --git a/erts/emulator/test/system_info_SUITE.erl b/erts/emulator/test/system_info_SUITE.erl new file mode 100644 index 0000000000..2c7124839a --- /dev/null +++ b/erts/emulator/test/system_info_SUITE.erl @@ -0,0 +1,142 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + + +%%%------------------------------------------------------------------- +%%% File : system_info_SUITE.erl +%%% Author : Rickard Green +%%% Description : Misc tests of erlang:system_info/1 +%%% +%%% Created : 15 Jul 2005 by Rickard Green +%%%------------------------------------------------------------------- +-module(system_info_SUITE). +-author('rickard.s.green@ericsson.com'). + +%-define(line_trace, 1). + +-include("test_server.hrl"). + +%-compile(export_all). +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([process_count/1, system_version/1, misc_smoke_tests/1]). + +-define(DEFAULT_TIMEOUT, ?t:minutes(2)). + +all(doc) -> []; +all(suite) -> [process_count, system_version, misc_smoke_tests]. + +init_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +%%% +%%% The test cases ------------------------------------------------------------- +%%% + +process_count(doc) -> []; +process_count(suite) -> []; +process_count(Config) when is_list(Config) -> + case catch erlang:system_info(modified_timing_level) of + Level when is_integer(Level) -> + {skipped, + "Modified timing (level " ++ integer_to_list(Level) + ++ ") is enabled. spawn() is too slow for this " + " test when modified timing is enabled."}; + _ -> + process_count_test() + end. + +process_count_test() -> + ?line OldPrio = process_flag(priority, max), + ?line check_procs(10), + ?line check_procs(11234), + ?line check_procs(57), + ?line check_procs(1030), + ?line check_procs(687), + ?line check_procs(7923), + ?line check_procs(5302), + ?line check_procs(12456), + ?line check_procs(14), + ?line check_procs(1125), + ?line check_procs(236), + ?line check_procs(125), + ?line check_procs(2346), + ?line process_flag(priority, OldPrio), + ?line ok. + + +check_procs(N) -> + ?line CP = length(processes()), + ?line Procs = start_procs(N), + ?line check_pc(CP+N), + ?line stop_procs(Procs), + ?line check_pc(CP). + +check_pc(E) -> + ?line P = length(processes()), + ?line SI = erlang:system_info(process_count), + ?line ?t:format("E=~p; P=~p; SI=~p~n", [E, P, SI]), + ?line E = P, + ?line P = SI. + +start_procs(N) -> + lists:map(fun (_) -> + P = spawn_opt(fun () -> + receive after infinity -> bye end + end, + [{priority, max}]), + {P, erlang:monitor(process, P)} + end, + lists:seq(1, N)). + +stop_procs(PMs) -> + lists:foreach(fun ({P, _}) -> + exit(P, boom) + end, PMs), + lists:foreach(fun ({P, M}) -> + receive {'DOWN', M, process, P, boom} -> ok end + end, PMs). + + +system_version(doc) -> []; +system_version(suite) -> []; +system_version(Config) when is_list(Config) -> + ?line {comment, erlang:system_info(system_version)}. + +misc_smoke_tests(doc) -> []; +misc_smoke_tests(suite) -> []; +misc_smoke_tests(Config) when is_list(Config) -> + ?line true = is_binary(erlang:system_info(info)), + ?line true = is_binary(erlang:system_info(procs)), + ?line true = is_binary(erlang:system_info(loaded)), + ?line true = is_binary(erlang:system_info(dist)), + ?line ok. + + + + + + + diff --git a/erts/emulator/test/system_profile_SUITE.erl b/erts/emulator/test/system_profile_SUITE.erl new file mode 100644 index 0000000000..7b0d6d19fe --- /dev/null +++ b/erts/emulator/test/system_profile_SUITE.erl @@ -0,0 +1,474 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + + +%%% Purpose : Tests system_profile BIF + +-module(system_profile_SUITE). + +-export([all/1, + system_profile_on_and_off/1, + runnable_procs/1, + runnable_ports/1, + scheduler/1 + ]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-export([profiler_process/1, ring_loop/1, port_echo_start/0, list_load/0, run_load/2]). + +-include("test_server.hrl"). + +-define(default_timeout, ?t:minutes(1)). + +init_per_testcase(_Case, Config) -> + ?line Dog=?t:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +all(suite) -> + %% Test specification on test suite level + [system_profile_on_and_off, + runnable_procs, + runnable_ports, + scheduler]. + +%% No specification clause needed for an init function in a conf case!!! + +%% Test switching system_profiling on and off. +system_profile_on_and_off(suite) -> + []; +system_profile_on_and_off(doc) -> + ["Tests switching system_profiling on and off."]; +system_profile_on_and_off(Config) when is_list(Config) -> + ?line Pid = start_profiler_process(), + + % Test runnable_ports on and off + ?line undefined = erlang:system_profile(Pid, [runnable_ports]), + ?line {Pid, [runnable_ports]} = erlang:system_profile(), + ?line {Pid, [runnable_ports]} = erlang:system_profile(undefined, []), + + % Test runnable_procs on and off + ?line undefined = erlang:system_profile(Pid, [runnable_procs]), + ?line {Pid, [runnable_procs]} = erlang:system_profile(), + ?line {Pid, [runnable_procs]} = erlang:system_profile(undefined, []), + + % Test scheduler on and off + ?line undefined = erlang:system_profile(Pid, [scheduler]), + ?line {Pid, [scheduler]} = erlang:system_profile(), + ?line {Pid, [scheduler]} = erlang:system_profile(undefined, []), + + % Test combined runnable_ports, runnable_procs, scheduler; on and off + ?line undefined = erlang:system_profile(Pid, [scheduler, runnable_procs, runnable_ports]), + ?line {Pid, [scheduler,runnable_procs,runnable_ports]} = erlang:system_profile(), + ?line {Pid, [scheduler,runnable_procs,runnable_ports]} = erlang:system_profile(undefined, []), + + % Test turned off and kill process + ?line undefined = erlang:system_profile(), + ?line exit(Pid,kill), + ok. + +%% Test runnable_procs + +runnable_procs(suite) -> + []; +runnable_procs(doc) -> + ["Tests system_profiling with runnable_procs."]; +runnable_procs(Config) when is_list(Config) -> + ?line Pid = start_profiler_process(), + % start a ring of processes + % FIXME: Set #laps and #nodes in config file + Nodes = 10, + Laps = 10, + ?line Master = ring(Nodes), + ?line undefined = erlang:system_profile(Pid, [runnable_procs]), + % loop a message + ?line ok = ring_message(Master, message, Laps), + ?line Events = get_profiler_events(), + ?line kill_em_all = kill_ring(Master), + ?line erlang:system_profile(undefined, []), + put(master, Master), + put(laps, Laps), + ?line true = has_runnable_event(Events), + Pids = sort_events_by_pid(Events), + ?line ok = check_events(Pids), + erase(), + ?line exit(Pid,kill), + ok. + +runnable_ports(suite) -> + []; +runnable_ports(doc) -> + ["Tests system_profiling with runnable_port."]; +runnable_ports(Config) when is_list(Config) -> + ?line Pid = start_profiler_process(), + ?line undefined = erlang:system_profile(Pid, [runnable_ports]), + ?line EchoPid = echo(Config), + % FIXME: Set config to number_of_echos + Laps = 10, + put(laps, Laps), + ?line ok = echo_message(EchoPid, Laps, message), + ?line Events = get_profiler_events(), + ?line kill_em_all = kill_echo(EchoPid), + ?line erlang:system_profile(undefined, []), + ?line true = has_runnable_event(Events), + Pids = sort_events_by_pid(Events), + ?line ok = check_events(Pids), + erase(), + ?line exit(Pid,kill), + ok. + +scheduler(suite) -> + []; +scheduler(doc) -> + ["Tests system_profiling with scheduler."]; +scheduler(Config) when is_list(Config) -> + case {erlang:system_info(smp_support), erlang:system_info(schedulers_online)} of + {false,_} -> ?line {skipped, "No need for scheduler test when smp support is disabled."}; + {_, 1} -> ?line {skipped, "No need for scheduler test when only one scheduler online."}; + _ -> + Nodes = 10, + ?line ok = check_block_system(Nodes), + ?line ok = check_multi_scheduling_block(Nodes), + ok + end. + +%%% Check scheduler profiling + +check_multi_scheduling_block(Nodes) -> + ?line Pid = start_profiler_process(), + ?line undefined = erlang:system_profile(Pid, [scheduler]), + ?line {ok, Supervisor} = start_load(Nodes), + ?line erlang:system_flag(multi_scheduling, block), + ?line erlang:system_flag(multi_scheduling, unblock), + ?line {Pid, [scheduler]} = erlang:system_profile(undefined, []), + ?line Events = get_profiler_events(), + ?line true = has_scheduler_event(Events), + stop_load(Supervisor), + ?line exit(Pid,kill), + erase(), + ok. + +check_block_system(Nodes) -> + ?line Dummy = spawn(?MODULE, profiler_process, [[]]), + ?line Pid = start_profiler_process(), + ?line undefined = erlang:system_profile(Pid, [scheduler]), + ?line {ok, Supervisor} = start_load(Nodes), + % FIXME: remove wait !! + wait(300), + ?line undefined = erlang:system_monitor(Dummy, [busy_port]), + ?line {Dummy, [busy_port]} = erlang:system_monitor(undefined, []), + ?line {Pid, [scheduler]} = erlang:system_profile(undefined, []), + ?line Events = get_profiler_events(), + ?line true = has_scheduler_event(Events), + stop_load(Supervisor), + ?line exit(Pid,kill), + ?line exit(Dummy,kill), + erase(), + ok. + +%%% Check events + +check_events([]) -> ok; +check_events([Pid | Pids]) -> + Master = get(master), + Laps = get(laps), + CheckPids = get(pids), + {Events, N} = get_pid_events(Pid), + ?line ok = check_event_flow(Events), + ?line ok = check_event_ts(Events), + IsMember = lists:member(Pid, CheckPids), + case Pid of + Master -> + io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2+2, N, Pid]), + ?line N = Laps*2 + 2, + check_events(Pids); + Pid when IsMember == true -> + io:format("Expected ~p and got ~p profile events from ~p: ok~n", [Laps*2, N, Pid]), + ?line N = Laps*2, + check_events(Pids); + Pid -> + check_events(Pids) + end. + +%% timestamp consistency check for descending timestamps + +check_event_ts(Events) -> + check_event_ts(Events, undefined). +check_event_ts([], _) -> ok; +check_event_ts([Event | Events], undefined) -> + check_event_ts(Events, Event); +check_event_ts([{Pid, _, _, TS1}=Event | Events], {Pid,_,_,TS0}) -> + Time = timer:now_diff(TS1, TS0), + if + Time < 0.0 -> timestamp_error; + true -> check_event_ts(Events, Event) + end. + +%% consistency check for active vs. inactive activity (runnable) + +check_event_flow(Events) -> + check_event_flow(Events, undefined). +check_event_flow([], _) -> ok; +check_event_flow([Event | PidEvents], undefined) -> + check_event_flow(PidEvents, Event); +check_event_flow([{Pid,Act,_,_}=Event | Events], PrevEvent) -> + case PrevEvent of + {Pid, Act, _MFA, _TS} -> consistency_error; + _ -> check_event_flow(Events, Event) + end. + + + +get_pid_events(Pid) -> + Events = get({pid_events, Pid}), + {Events, length(Events)}. + +sort_events_by_pid(Events) -> + sort_events_by_pid(lists:reverse(Events), []). +sort_events_by_pid([], Pids) -> Pids; +sort_events_by_pid([Event | Events],Pids) -> + case Event of + {profile,Pid,Act,MFA,TS} -> + case get({pid_events, Pid}) of + undefined -> + put({pid_events, Pid}, [{Pid,Act,MFA,TS}]), + sort_events_by_pid(Events, [Pid | Pids]); + PidEvents -> + put({pid_events, Pid}, [{Pid,Act,MFA,TS}|PidEvents]), + sort_events_by_pid(Events, Pids) + end + end. + + +%%% +%% Process ring +%%% + +%% API + +% Returns master pid +ring(N) -> + Pids = build_ring(N, []), + put(pids, Pids), + setup_ring(Pids). + +ring_message(Master, Message, Laps) -> + Master ! {message, Master, Laps, Message}, + receive + {laps_complete, Master} -> ok + end. + +kill_ring(Master) -> Master ! kill_em_all. + +%% Process ring helpers + +build_ring(0, Pids) -> Pids; +build_ring(N, Pids) -> + build_ring(N - 1, [spawn_link(?MODULE, ring_loop, [undefined]) | Pids]). + +setup_ring([Master | Relayers]) -> + % Relayers may not include the master pid + Master ! {setup_ring, Relayers, self()}, + receive + {setup_complete, Master} -> Master + end. + +ring_loop(RelayTo) -> + receive + kill_em_all -> + RelayTo ! kill_em_all; + {setup_ring, [Pid | Pids], Supervisor} -> + put(supervisor, Supervisor), + Pid ! {relay_to, Pids, self()}, + ring_loop(Pid); + {setup_complete, _} -> + get(supervisor) ! {setup_complete, self()}, + ring_loop(RelayTo); + {relay_to, [], Master} -> + Master ! {setup_complete, self()}, + ring_loop(Master); + {relay_to, [Pid | Pids], Master} -> + Pid ! {relay_to, Pids, Master}, + ring_loop(Pid); + {message, Master, Lap, Msg}=Message -> + case {self(), Lap} of + {Master, 0} -> + get(supervisor) ! {laps_complete, self()}, + ring_loop(RelayTo); + {Master, Lap} -> + RelayTo ! {message, Master, Lap - 1, Msg}, + ring_loop(RelayTo); + _ -> + RelayTo ! Message, + ring_loop(RelayTo) + end + end. + +%%% +%% Echo driver +%%% + +%% API + +echo(Config) -> + Path = ?config(data_dir, Config), + erl_ddll:load_driver(Path, echo_drv), + Pid = spawn_link(?MODULE, port_echo_start, []), + Pid ! {self(), get_ports}, + receive + {port, Port} -> + put(pids, [Port]), + put(master, Port), + Pid + end. + +echo_message(Pid, N, Msg) -> + Pid ! {start_echo, self(), N, Msg}, + receive + {echo_complete, Pid} -> ok + end. + +kill_echo(Pid) -> Pid ! kill_em_all. + + +%% Echo driver helpers +port_echo_start() -> + Port = open_port({spawn,echo_drv}, [eof,binary]), + receive + {Pid, get_ports} -> + Pid ! {port, Port}, + port_echo_loop(Port) + end. + +port_echo_loop(Port) -> + receive + {start_echo, Pid, Echos, Msg} -> + port_command(Port, term_to_binary({Pid, Echos, Msg})), + port_echo_loop(Port); + {Port, {data, Data}} -> + {Pid, Echos, Msg} = binary_to_term(Data), + case Echos of + 0 -> + Pid ! {echo_complete, self()}, + port_echo_loop(Port); + Echos -> + port_command(Port, term_to_binary({Pid, Echos - 1, Msg})), + port_echo_loop(Port) + end; + kill_em_all -> + port_close(Port), + ok + end. + + + +%%% +%% Helpers +%%% + +start_load(N) -> + Pid = spawn_link(?MODULE, run_load, [N, []]), + {ok, Pid}. + + +stop_load(Supervisor) -> + erlang:unlink(Supervisor), + exit(Supervisor, kill). + +run_load(0, _Pids) -> + receive + % wait for an exit signal or a message then kill + % all associated processes. + _ -> exit(annihilated) + end; +run_load(N, Pids) -> + Pid = spawn_link(?MODULE, list_load, []), + run_load(N - 1, [Pid | Pids]). + +list_load() -> + ok = case math:sin(random:uniform(32451)) of + A when is_float(A) -> ok; + _ -> ok + end, + list_load(). + + +has_scheduler_event(Events) -> + lists:any( + fun (Pred) -> + case Pred of + {profile, scheduler, _ID, _Activity, _NR, _TS} -> true; + _ -> false + end + end, Events). + +has_runnable_event(Events) -> + lists:any( + fun (Pred) -> + case Pred of + {profile, _Pid, _Activity, _MFA, _TS} -> true; + _ -> false + end + end, Events). + +wait(Time) -> receive after Time -> ok end. + +%%% +%% Receivers +%%% + +%% Process receiver + + +get_profiler_events() -> + Pid = get(profiler), + Pid ! {self(), get_events}, + receive + Events -> Events + end. + +start_profiler_process() -> + Pid = spawn(?MODULE, profiler_process, [[]]), + put(profiler, Pid), + Pid. + +profiler_process(Events) -> + receive + {Pid, get_events} -> + Ref = erlang:trace_delivered(all), + profiler_process_followup(Pid, Events, Ref); + Event -> + profiler_process([Event | Events]) + end. + +profiler_process_followup(Pid, Events, Ref) -> + receive + {trace_delivered,all,Ref} -> + Pid ! lists:reverse(Events); + Event -> + profiler_process_followup(Pid, [Event | Events], Ref) + end. + +%% Port receiver + + diff --git a/erts/emulator/test/system_profile_SUITE_data/Makefile.src b/erts/emulator/test/system_profile_SUITE_data/Makefile.src new file mode 100644 index 0000000000..c1bf142ccf --- /dev/null +++ b/erts/emulator/test/system_profile_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: echo_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/system_profile_SUITE_data/echo_drv.c b/erts/emulator/test/system_profile_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..d968ff06f9 --- /dev/null +++ b/erts/emulator/test/system_profile_SUITE_data/echo_drv.c @@ -0,0 +1,66 @@ +#include +#include "erl_driver.h" + +typedef struct _erl_drv_data { + ErlDrvPort erlang_port; +} EchoDrvData; + +static EchoDrvData echo_drv_data, *echo_drv_data_p; + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command); +static void echo_drv_stop(EchoDrvData *data_p); +static void echo_drv_output(EchoDrvData *data_p, char *buf, int len); +static void echo_drv_finish(void); +static int echo_drv_control(EchoDrvData *data_p, unsigned int command, + char *buf, int len, + char **rbuf, int rlen); + +static ErlDrvEntry echo_drv_entry = { + NULL, /* init */ + echo_drv_start, + echo_drv_stop, + echo_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "echo_drv", + echo_drv_finish, + NULL, /* handle */ + echo_drv_control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL /* ready_async */ +}; + +DRIVER_INIT(echo_drv) +{ + echo_drv_data_p = NULL; + return &echo_drv_entry; +} + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command) +{ + if (echo_drv_data_p != NULL) { + return ERL_DRV_ERROR_GENERAL; + } + echo_drv_data_p = &echo_drv_data; + echo_drv_data_p->erlang_port = port; + return echo_drv_data_p; +} + +static void echo_drv_stop(EchoDrvData *data_p) { + echo_drv_data_p = NULL; +} + +static void echo_drv_output(EchoDrvData *data_p, char *buf, int len) { + driver_output(data_p->erlang_port, buf, len); +} + +static void echo_drv_finish() { + echo_drv_data_p = NULL; +} + +static int echo_drv_control(EchoDrvData *data_p, unsigned int command, + char *buf, int len, + char **rbuf, int rlen) { + return 0; +} diff --git a/erts/emulator/test/time_SUITE.erl b/erts/emulator/test/time_SUITE.erl new file mode 100644 index 0000000000..2ad1f0d201 --- /dev/null +++ b/erts/emulator/test/time_SUITE.erl @@ -0,0 +1,439 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(time_SUITE). + +%% "Time is on my side." -- The Rolling Stones + +%% Tests the BIFs: +%% erlang:localtime_to_universaltime/1 +%% erlang:universaltime_to_localtime/1 +%% date/0 +%% time/0 +%% now/0 +%% + +-export([all/1, univ_to_local/1, local_to_univ/1, + bad_univ_to_local/1, bad_local_to_univ/1, + consistency/1, + now/1, now_unique/1, now_update/1, timestamp/1]). + +-include("test_server.hrl"). + +-export([linear_time/1]). + +%% The following defines the timezone in which the test is run. +%% It is interpreted as the number of hours to be added to UTC +%% to obtain the local time. The number will be positive east +%% of Greenwhich, negative west of Greenwhich. +%% +%% Allowable range is -12 through 11. + +-define(timezone, 1). + +%% Similarly to timezone, but the difference when Daylight Saving Time +%% is in use. [Same range.] + +-define(dst_timezone, 2). + +all(suite) -> [univ_to_local, local_to_univ, + bad_univ_to_local, bad_local_to_univ, consistency, now, timestamp]. + + +%% Tests conversion from univeral to local time. + +univ_to_local(Config) when is_list(Config) -> + ?line test_univ_to_local(test_data()). + +test_univ_to_local([{Utc, Local}|Rest]) -> + ?line io:format("Testing ~p => ~p~n", [Local, Utc]), + ?line Local = erlang:universaltime_to_localtime(Utc), + ?line test_univ_to_local(Rest); +test_univ_to_local([]) -> + ok. + +%% Tests conversion from local to universal time. + +local_to_univ(Config) when is_list(Config) -> + ?line test_local_to_univ(test_data()). + +test_local_to_univ([{Utc, Local}|Rest]) -> + ?line io:format("Testing ~p => ~p~n", [Utc, Local]), + ?line Utc = erlang:localtime_to_universaltime(Local), + ?line test_local_to_univ(Rest); +test_local_to_univ([]) -> + ok. + +%% Test bad arguments to erlang:universaltime_to_localtime; should +%% generate a badarg. + +bad_univ_to_local(Config) when is_list(Config) -> + ?line bad_test_univ_to_local(bad_dates()). + +bad_test_univ_to_local([Utc|Rest]) -> + ?line io:format("Testing ~p~n", [Utc]), + ?line case catch erlang:universaltime_to_localtime(Utc) of + {'EXIT', {badarg, _}} -> bad_test_univ_to_local(Rest) + end; +bad_test_univ_to_local([]) -> + ok. + +%% Test bad arguments to erlang:localtime_to_universaltime/1; should +%% generate a badarg. + +bad_local_to_univ(Config) when is_list(Config) -> + ?line bad_test_local_to_univ(bad_dates()). + +bad_test_local_to_univ([Local|Rest]) -> + ?line io:format("Testing ~p~n", [Local]), + ?line case catch erlang:localtime_to_universaltime(Local) of + {'EXIT', {badarg, _}} -> bad_test_local_to_univ(Rest) + end; +bad_test_local_to_univ([]) -> + ok. + +%% Test that the the different time functions return +%% consistent results. (See the test case for assumptions +%% and limitations.) +consistency(Config) when is_list(Config) -> + %% Test the following equations: + %% date() & time() == erlang:localtime() + %% erlang:universaltime() + timezone == erlang:localtime() + %% + %% Assumptions: + %% Middle-European time zone, EU rules for daylight-saving time. + %% + %% Limitations: + %% Localtime and universaltime must be in the same month. + %% Daylight-saving calculations are incorrect from the last + %% Sunday of March and October to the end of the month. + + ?line ok = compare_date_time_and_localtime(16), + ?line ok = compare_local_and_universal(16). + +compare_date_time_and_localtime(Times) when Times > 0 -> + ?line {Year, Mon, Day} = date(), + ?line {Hour, Min, Sec} = time(), + ?line case erlang:localtime() of + {{Year, Mon, Day}, {Hour, Min, Sec}} -> ok; + _ -> compare_date_time_and_localtime(Times-1) + end; +compare_date_time_and_localtime(0) -> + error. + +compare_local_and_universal(Times) when Times > 0 -> + case compare(erlang:universaltime(), erlang:localtime()) of + true -> ok; + false -> compare_local_and_universal(Times-1) + end; +compare_local_and_universal(0) -> + error. + +compare(Utc0, Local) -> + io:format("local = ~p, utc = ~p", [Local, Utc0]), + Utc = linear_time(Utc0)+effective_timezone(Utc0)*3600, + case linear_time(Local) of + Utc -> true; + Other -> + io:format("Failed: local = ~p, utc = ~p~n", + [Other, Utc]), + false + end. + +%% This function converts a date and time to a linear time. +%% Two linear times can be subtracted to give their difference +%% in seconds. +%% +%% XXX Limitations: The length of months and leap years are not +%% taken into account; thus a comparision of dates is only +%% valid if they are in the SAME month. + +linear_time({{Year, Mon, Day}, {Hour, Min, Sec}}) -> + 86400*(366*Year + 31*(Mon-1) + (Day-1)) + + 3600*Hour + 60*Min + Sec. + +%% This functions returns either the normal timezone or the +%% the DST timezone, depending on the given UTC time. +%% +%% XXX This function uses an approximation of the EU rule for +%% daylight saving time. This function will fail in the +%% following intervals: After the last Sunday in March upto +%% the end of March, and after the last Sunday in October +%% upto the end of October. + +effective_timezone(Time) -> + case os:type() of + {unix,_} -> + case os:cmd("date '+%Z'") of + "SAST"++_ -> + 2; + _ -> + effective_timezone1(Time) + end; + _ -> + effective_timezone1(Time) + end. + +effective_timezone1({{_Year,Mon,_Day}, _}) when Mon < 4 -> + ?timezone; +effective_timezone1({{_Year,Mon,_Day}, _}) when Mon > 10 -> + ?timezone; +effective_timezone1(_) -> + ?dst_timezone. + +%% Test (the bif) os:timestamp/0, which is something quite like, but not +%% similar to erlang:now... + +timestamp(suite) -> + []; +timestamp(doc) -> + ["Test that os:timestamp works."]; +timestamp(Config) when is_list(Config) -> + repeating_timestamp_check(100000). + +repeating_timestamp_check(0) -> + ok; +repeating_timestamp_check(N) -> + {A,B,C} = TS = os:timestamp(), + if + is_integer(A), + is_integer(B), + is_integer(C), + B < 1000000, + C < 1000000 -> + ok; + true -> + test_server:fail( + lists:flatten( + io_lib:format("Strange return from os:timestamp/0 ~w~n",[TS]))) + end, + %% I assume the now and timestamp should not differ more than 1 hour, + %% which is safe assuming the system has not had a large time-warp + %% during the testrun... + Secs = A*1000000+B+round(C/1000000), + {NA,NB,NC} = erlang:now(), + NSecs = NA*1000000+NB+round(NC/1000000), + case Secs - NSecs of + TooLarge when TooLarge > 3600 -> + test_server:fail( + lists:flatten( + io_lib:format("os:timestamp/0 is ~w s more than erlang:now/0", + [TooLarge]))); + TooSmall when TooSmall < -3600 -> + test_server:fail( + lists:flatten( + io_lib:format("os:timestamp/0 is ~w s less than erlang:now/0", + [-TooSmall]))); + _ -> + ok + end, + repeating_timestamp_check(N-1). + + +%% Test now/0. + +now(suite) -> [now_unique, now_update]. + +%% Tests that successive calls to now/0 returns different values. +%% Also returns a comment string with the median difference between +%% times (in microseconds). + +now_unique(Config) when is_list(Config) -> + ?line now_unique(1000, now(), []), + ?line fast_now_unique(100000, now()). + +now_unique(N, Previous, Result) when N > 0 -> + ?line case now() of + Previous -> + test_server:fail("now/0 returned the same value twice"); + New -> + now_unique(N-1, New, [New|Result]) + end; +now_unique(0, _, [Then|Rest]) -> + ?line now_calc_increment(Rest, microsecs(Then), []). + +now_calc_increment([Then|Rest], Previous, _Result) -> + ?line This = microsecs(Then), + ?line now_calc_increment(Rest, This, [Previous-This]); +now_calc_increment([], _, Differences) -> + {comment, "Median increment: " ++ integer_to_list(median(Differences))}. + +fast_now_unique(0, _) -> ok; +fast_now_unique(N, Then) -> + case now() of + Then -> + ?line ?t:fail("now/0 returned the same value twice"); + Now -> + fast_now_unique(N-1, Now) + end. + +median(Unsorted_List) -> + ?line Length = length(Unsorted_List), + ?line List = lists:sort(Unsorted_List), + ?line case Length rem 2 of + 0 -> % Even length. + [A, B] = lists:nthtail((Length div 2)-1, List), + (A+B)/2; + 1 -> % Odd list length. + lists:nth((Length div 2)+1, List) + end. + +microsecs({Mega_Secs, Secs, Microsecs}) -> + (Mega_Secs*1000000+Secs)*1000000+Microsecs. + +%% Test that the time differences returned by two calls to +%% now/0 one second apart is comparable to the difference of two +%% calls to erlang:localtime(). + +now_update(Config) when is_list(Config) -> + case ?t:is_debug() of + false -> ?line now_update1(10); + true -> {skip,"Unreliable in DEBUG build"} + end. + + +now_update1(N) when N > 0 -> + ?line T1_linear = linear_time(erlang:localtime()), + ?line T1_now = microsecs(now()), + + ?line receive after 1008 -> ok end, + + ?line T2_linear = linear_time(erlang:localtime()), + ?line T2_now = microsecs(now()), + + ?line Linear_Diff = (T2_linear-T1_linear)*1000000, + ?line Now_Diff = T2_now-T1_now, + test_server:format("Localtime diff = ~p; now() diff = ~p", + [Linear_Diff, Now_Diff]), + ?line case abs(Linear_Diff - Now_Diff) of + Abs_Delta when Abs_Delta =< 40000 -> ok; + _ -> now_update1(N-1) + end; +now_update1(0) -> + ?line test_server:fail(). + +%% Returns the test data: a list of {Utc, Local} tuples. + +test_data() -> + {TZ,DSTTZ} = + case os:type() of + {unix,_} -> + case os:cmd("date '+%Z'") of + "SAST"++_ -> + {2,2}; + _ -> + {?timezone,?dst_timezone} + end; + _ -> + {?timezone,?dst_timezone} + end, + ?line test_data(nondst_dates(), TZ) ++ + test_data(dst_dates(), DSTTZ) ++ + crossover_test_data(crossover_dates(), TZ). + + +%% test_data1() -> +%% ?line test_data(nondst_dates(), ?timezone) ++ +%% test_data(dst_dates(), ?dst_timezone) ++ +%% crossover_test_data(crossover_dates(), ?timezone). + +crossover_test_data([{Year, Month, Day}|Rest], TimeZone) when TimeZone > 0 -> + Hour = 23, + Min = 35, + Sec = 55, + ?line Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, + ?line Local = {{Year, Month, Day+1}, {Hour+TimeZone-24, Min, Sec}}, + ?line [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; +crossover_test_data([{Year, Month, Day}|Rest], TimeZone) when TimeZone < 0 -> + Hour = 0, + Min = 23, + Sec = 12, + ?line Utc = {{Year, Month, Day}, {Hour, Min, Sec}}, + ?line Local = {{Year, Month, Day-1}, {Hour+TimeZone+24, Min, Sec}}, + ?line [{Utc, Local}|crossover_test_data(Rest, TimeZone)]; +crossover_test_data([], _) -> + []. + +test_data([Date|Rest], TimeZone) -> + Hour = 12, + Min = 45, + Sec = 7, + ?line Utc = {Date, {Hour, Min, Sec}}, + ?line Local = {Date, {Hour+TimeZone, Min, Sec}}, + ?line [{Utc, Local}|test_data(Rest, TimeZone)]; +test_data([], _) -> + []. + +nondst_dates() -> + [{1996, 01, 30}, + {1997, 01, 30}, + {1998, 01, 30}, + {1999, 01, 30}, + {1996, 02, 29}, + {1997, 02, 28}, + {1998, 02, 28}, + {1999, 02, 28}, + {1996, 03, 2}, + {1997, 03, 2}, + {1998, 03, 2}, + {1999, 03, 2}]. + +dst_dates() -> + [{1996, 06, 1}, + {1997, 06, 2}, + {1998, 06, 3}, + {1999, 06, 4}]. + +%% The following dates should not be near the end or beginning of +%% a month, because they will be used to test when the dates are +%% different in UTC and local time. + +crossover_dates() -> + [{1996, 01, 25}, + {1997, 01, 25}, + {1998, 01, 25}, + {1999, 01, 25}, + {1996, 02, 27}, + {1997, 02, 27}, + {1998, 02, 27}, + {1999, 02, 27}]. + +bad_dates() -> + [{{1900, 7, 1}, {12, 0, 0}}, % Year + + {{1996, 0, 20}, {12, 0, 0}}, % Month + {{1996, 13, 20}, {12, 0, 0}}, + + {{1996, 1, 0}, {12, 0, 0}}, % Date + {{1996, 1, 32}, {12, 0, 0}}, + {{1996, 2, 30}, {12, 0, 0}}, + {{1997, 2, 29}, {12, 0, 0}}, + {{1998, 2, 29}, {12, 0, 0}}, + {{1999, 2, 29}, {12, 0, 0}}, + {{1996, 4, 31}, {12, 0, 0}}, + + {{1996, 4, 30}, {-1, 0, 0}}, % Hour + {{1996, 4, 30}, {25, 0, 0}}, + + {{1996, 4, 30}, {12,-1, 0}}, % Minute + {{1996, 4, 30}, {12, 60, 0}}, + + {{1996, 4, 30}, {12, 0, -1}}, % Sec + {{1996, 4, 30}, {12, 0, 60}}]. + diff --git a/erts/emulator/test/timer_bif_SUITE.erl b/erts/emulator/test/timer_bif_SUITE.erl new file mode 100644 index 0000000000..9ac5afcc45 --- /dev/null +++ b/erts/emulator/test/timer_bif_SUITE.erl @@ -0,0 +1,558 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(timer_bif_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2,end_per_suite/1]). +-export([start_timer_1/1, send_after_1/1, send_after_2/1, send_after_3/1, + cancel_timer_1/1, + start_timer_big/1, send_after_big/1, + start_timer_e/1, send_after_e/1, cancel_timer_e/1, + read_timer_trivial/1, read_timer/1, + cleanup/1, evil_timers/1, registered_process/1]). + +-include("test_server.hrl"). + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(test_server:seconds(30)), + case catch erts_debug:get_internal_state(available_internal_state) of + true -> ok; + _ -> erts_debug:set_internal_state(available_internal_state, true) + end, + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +end_per_suite(_Config) -> + catch erts_debug:set_internal_state(available_internal_state, false). + +all(suite) -> + [start_timer_1, send_after_1, send_after_2, cancel_timer_1, + start_timer_e, send_after_e, cancel_timer_e, + start_timer_big, send_after_big, read_timer_trivial, read_timer, + cleanup, evil_timers, registered_process]. + +start_timer_1(doc) -> ["Basic start_timer/3 functionality"]; +start_timer_1(Config) when is_list(Config) -> + ?line Ref1 = erlang:start_timer(1000, self(), plopp), + ?line ok = get(1100, {timeout, Ref1, plopp}), + + ?line false = erlang:read_timer(Ref1), + ?line false = erlang:cancel_timer(Ref1), + ?line false = erlang:read_timer(Ref1), + + ?line Ref2 = erlang:start_timer(1000, self(), plapp), + ?line Left2 = erlang:cancel_timer(Ref2), + UpperLimit = case os:type() of + vxworks -> + %% The ticks of vxworks have a far lesser granularity + %% than what is expected in this testcase, in + %% fact the Left2 variable can get a little more than 1000... + 1100; + _ -> + 1000 + end, + ?line RetVal = case os:type() of + vxworks -> + {comment, "VxWorks behaves slightly unexpected, should be fixed,"}; + _ -> + ok + end, + ?line true = (Left2 > 900) and (Left2 =< UpperLimit), + ?line empty = get_msg(), + ?line false = erlang:cancel_timer(Ref2), + + ?line Ref3 = erlang:start_timer(1000, self(), plopp), + ?line no_message = get(900, {timeout, Ref3, plopp}), + + RetVal. + +send_after_1(doc) -> ["Basic send_after/3 functionality"]; +send_after_1(Config) when is_list(Config) -> + ?line Ref3 = erlang:send_after(1000, self(), plipp), + ?line ok = get(1500, plipp), + ?line false = erlang:read_timer(Ref3), + ok. + +start_timer_big(doc) -> ["Big timeouts for start_timer/3"]; +start_timer_big(Config) when is_list(Config) -> + ?line Big = 1 bsl 31, + ?line R = erlang:start_timer(Big, self(), hej), + ?line timer:sleep(200), + ?line Left = erlang:cancel_timer(R), + ?line case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + ok. + +send_after_big(doc) -> ["Big timeouts for send_after/3"]; +send_after_big(Config) when is_list(Config) -> + ?line Big = 1 bsl 31, + ?line R = erlang:send_after(Big, self(), hej), + ?line timer:sleep(200), + ?line Left = erlang:cancel_timer(R), + ?line case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + ok. + +send_after_2(doc) -> ["send_after/3: messages in the right order, kind version"]; +send_after_2(Config) when is_list(Config) -> + ?line _ = erlang:send_after(5000, self(), last), + ?line _ = erlang:send_after(0, self(), a0), + ?line _ = erlang:send_after(200, self(), a2), + ?line _ = erlang:send_after(100, self(), a1), + ?line _ = erlang:send_after(500, self(), a5), + ?line _ = erlang:send_after(300, self(), a3), + ?line _ = erlang:send_after(400, self(), a4), + ?line [a0,a1,a2,a3,a4,a5,last] = collect(last), + ok. + +send_after_3(doc) -> ["send_after/3: messages in the right order, worse than send_after_2"]; +send_after_3(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skipped, "VxWorks timer granularity and order is not working good, this is subject to change!"}; + _ -> + do_send_after_3() + end. + +do_send_after_3() -> + ?line _ = erlang:send_after(100, self(), b1), + ?line _ = erlang:send_after(101, self(), b2), + ?line _ = erlang:send_after(102, self(), b3), + ?line _ = erlang:send_after(103, self(), last), + ?line [b1, b2, b3, last] = collect(last), + +% This behaviour is not guaranteed: +% ?line _ = erlang:send_after(100, self(), c1), +% ?line _ = erlang:send_after(100, self(), c2), +% ?line _ = erlang:send_after(100, self(), c3), +% ?line _ = erlang:send_after(100, self(), last), +% ?line [c1, c2, c3, last] = collect(last), + + ok. + +cancel_timer_1(doc) -> ["Check trivial cancel_timer/1 behaviour"]; +cancel_timer_1(Config) when is_list(Config) -> + ?line false = erlang:cancel_timer(make_ref()), + + ok. + +start_timer_e(doc) -> ["Error cases for start_timer/3"]; +start_timer_e(Config) when is_list(Config) -> + ?line {'EXIT', _} = (catch erlang:start_timer(-4, self(), hej)), + ?line {'EXIT', _} = (catch erlang:start_timer(4728472847827482, + self(), hej)), + + ?line {'EXIT', _} = (catch erlang:start_timer(4.5, self(), hej)), + ?line {'EXIT', _} = (catch erlang:start_timer(a, self(), hej)), + + ?line Node = start_slave(), + ?line Pid = spawn(Node, timer, sleep, [10000]), + ?line {'EXIT', _} = (catch erlang:start_timer(1000, Pid, hej)), + ?line stop_slave(Node), + + + ok. + +send_after_e(doc) -> ["Error cases for send_after/3"]; +send_after_e(suite) -> []; +send_after_e(Config) when is_list(Config) -> + ?line {'EXIT', _} = (catch erlang:send_after(-4, self(), hej)), + ?line {'EXIT', _} = (catch erlang:send_after(4728472847827482, + self(), hej)), + + ?line {'EXIT', _} = (catch erlang:send_after(4.5, self(), hej)), + ?line {'EXIT', _} = (catch erlang:send_after(a, self(), hej)), + + ?line Node = start_slave(), + ?line Pid = spawn(Node, timer, sleep, [10000]), + ?line {'EXIT', _} = (catch erlang:send_after(1000, Pid, hej)), + ?line stop_slave(Node), + ok. + +cancel_timer_e(doc) -> ["Error cases for cancel_timer/1"]; +cancel_timer_e(suite) -> []; +cancel_timer_e(Config) when is_list(Config) -> + ?line {'EXIT', _} = (catch erlang:cancel_timer(1)), + ?line {'EXIT', _} = (catch erlang:cancel_timer(self())), + ?line {'EXIT', _} = (catch erlang:cancel_timer(a)), + ok. + +read_timer_trivial(doc) -> ["Trivial and error test cases for read_timer/1."]; +read_timer_trivial(suite) -> []; +read_timer_trivial(Config) when is_list(Config) -> + ?line false = erlang:read_timer(make_ref()), + ?line {'EXIT', _} = (catch erlang:read_timer(42)), + ?line {'EXIT', _} = (catch erlang:read_timer(423497834744444444457667444444)), + ?line {'EXIT', _} = (catch erlang:read_timer(self())), + ?line {'EXIT', _} = (catch erlang:read_timer(ab)), + ok. + +read_timer(doc) -> ["Test that read_timer/1 seems to return the correct values."]; +read_timer(suite) -> []; +read_timer(Config) when is_list(Config) -> + ?line Big = 1 bsl 31, + ?line R = erlang:send_after(Big, self(), hej_hopp), + + ?line receive after 200 -> ok end, % Delay and clear reductions. + ?line Left = erlang:read_timer(R), + ?line Left = erlang:cancel_timer(R), + ?line false = erlang:read_timer(R), + + ?line case Big - Left of + Diff when Diff >= 200, Diff < 10000 -> + ok; + _Diff -> + test_server:fail({big, Big, Left}) + end, + ok. + +cleanup(doc) -> []; +cleanup(suite) -> []; +cleanup(Config) when is_list(Config) -> + ?line Mem = mem(), + %% Timer on dead process + ?line P1 = spawn(fun () -> ok end), + ?line wait_until(fun () -> process_is_cleaned_up(P1) end), + ?line T1 = erlang:start_timer(10000, P1, "hej"), + ?line T2 = erlang:send_after(10000, P1, "hej"), + ?line Mem = mem(), + ?line false = erlang:read_timer(T1), + ?line false = erlang:read_timer(T2), + ?line Mem = mem(), + %% Process dies before timeout + ?line P2 = spawn(fun () -> receive after 500 -> ok end end), + ?line T3 = erlang:start_timer(10000, P2, "hej"), + ?line T4 = erlang:send_after(10000, P2, "hej"), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:read_timer(T3)), + ?line true = is_integer(erlang:read_timer(T4)), + ?line wait_until(fun () -> process_is_cleaned_up(P2) end), + ?line false = erlang:read_timer(T3), + ?line false = erlang:read_timer(T4), + ?line Mem = mem(), + %% Cancel timer + ?line P3 = spawn(fun () -> receive after 20000 -> ok end end), + ?line T5 = erlang:start_timer(10000, P3, "hej"), + ?line T6 = erlang:send_after(10000, P3, "hej"), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:cancel_timer(T5)), + ?line true = is_integer(erlang:cancel_timer(T6)), + ?line false = erlang:read_timer(T5), + ?line false = erlang:read_timer(T6), + ?line exit(P3, kill), + ?line Mem = mem(), + %% Timeout + ?line Ref = make_ref(), + ?line T7 = erlang:start_timer(500, self(), Ref), + ?line T8 = erlang:send_after(500, self(), Ref), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:read_timer(T7)), + ?line true = is_integer(erlang:read_timer(T8)), + ?line receive {timeout, T7, Ref} -> ok end, + ?line receive Ref -> ok end, + ?line Mem = mem(), + ?line ok. + + +evil_timers(doc) -> []; +evil_timers(suite) -> []; +evil_timers(Config) when is_list(Config) -> + %% Create a composite term consisting of at least: + %% * externals (remote pids, ports, and refs) + %% * large (off heap) binaries + %% * small (heap) binaries + %% * funs + %% * bignums + %% * tuples + %% * lists + %% since data of these types have to be adjusted if moved + %% in memory + ?line Self = self(), + ?line R1 = make_ref(), + ?line Node = start_slave(), + ?line spawn_link(Node, + fun () -> + Self ! {R1, + [lists:sublist(erlang:ports(), 3), + [make_ref(), make_ref(), make_ref()], + lists:sublist(processes(), 3), + [fun () -> gurka end, + fun (A) -> A + 1 end, + fun (A, B) -> A + B end]]} + end), + ?line ExtList = receive {R1, L} -> L end, + ?line stop_slave(Node), + ?line BinList = [<<"bla">>, + <<"blipp">>, + <<"blupp">>, + list_to_binary(lists:duplicate(1000000,$a)), + list_to_binary(lists:duplicate(1000000,$b)), + list_to_binary(lists:duplicate(1000000,$c))], + ?line FunList = [fun () -> gurka end, + fun (A) -> A + 1 end, + fun (A, B) -> A + B end], + ?line PidList = lists:sublist(processes(), 3), + ?line PortList = lists:sublist(erlang:ports(), 3), + ?line RefList = [make_ref(), make_ref(), make_ref()], + ?line BigList = [111111111111, 22222222222222, 333333333333333333], + ?line Msg = {BinList,[FunList,{RefList,ExtList,PidList,PortList,BigList}]}, + %% ?line ?t:format("Msg=~p~n",[Msg]), + + ?line Prio = process_flag(priority, max), + %% + %% In the smp case there are four major cases we want to test: + %% + %% 1. A timer started with erlang:start_timer(Time, Receiver, Msg), + %% where Msg is a composite term, expires, and the receivers main + %% lock *can not* be acquired immediately (typically when the + %% receiver *is* running). + %% + %% The wrap tuple ({timeout, TRef, Msg}) will in this case + %% be allocated in the previously allocated message buffer along + %% with Msg, i.e. the previously allocated message buffer will be + %% reallocated and potentially moved. + ?line TimeOutMsgs0 = evil_setup_timers(200, Self, Msg), + ?line RecvTimeOutMsgs0 = evil_recv_timeouts(200), + %% 2. A timer started with erlang:start_timer(Time, Receiver, Msg), + %% where Msg is an immediate term, expires, and the receivers main + %% lock *can not* be acquired immediately (typically when the + %% receiver *is* running). + %% + %% The wrap tuple will in this case be allocated in a new + %% message buffer. + ?line TimeOutMsgs1 = evil_setup_timers(200, Self, immediate), + ?line RecvTimeOutMsgs1 = evil_recv_timeouts(200), + %% 3. A timer started with erlang:start_timer(Time, Receiver, Msg), + %% where Msg is a composite term, expires, and the receivers main + %% lock *can* be acquired immediately (typically when the receiver + %% *is not* running). + %% + %% The wrap tuple will in this case be allocated on the receivers + %% heap, and Msg is passed in the previously allocated message + %% buffer. + ?line R2 = make_ref(), + ?line spawn_link(fun () -> + Self ! {R2, evil_setup_timers(200, Self, Msg)} + end), + ?line receive after 1000 -> ok end, + ?line TimeOutMsgs2 = receive {R2, TOM2} -> TOM2 end, + ?line RecvTimeOutMsgs2 = evil_recv_timeouts(200), + %% 4. A timer started with erlang:start_timer(Time, Receiver, Msg), + %% where Msg is an immediate term, expires, and the Receivers main + %% lock *can* be acquired immediately (typically when the receiver + %% *is not* running). + %% + %% The wrap tuple will in this case be allocated on the receivers + %% heap. + ?line R3 = make_ref(), + ?line spawn_link(fun () -> + Self ! {R3, evil_setup_timers(200,Self,immediate)} + end), + ?line receive after 1000 -> ok end, + ?line TimeOutMsgs3 = receive {R3, TOM3} -> TOM3 end, + ?line RecvTimeOutMsgs3 = evil_recv_timeouts(200), + + %% Garge collection will hopefully crash the emulator if something + %% is wrong... + ?line garbage_collect(), + ?line garbage_collect(), + ?line garbage_collect(), + + %% Make sure we got the timeouts we expected + %% + %% Note timeouts are *not* guaranteed to be delivered in order + ?line ok = match(lists:sort(RecvTimeOutMsgs0), lists:sort(TimeOutMsgs0)), + ?line ok = match(lists:sort(RecvTimeOutMsgs1), lists:sort(TimeOutMsgs1)), + ?line ok = match(lists:sort(RecvTimeOutMsgs2), lists:sort(TimeOutMsgs2)), + ?line ok = match(lists:sort(RecvTimeOutMsgs3), lists:sort(TimeOutMsgs3)), + + ?line process_flag(priority, Prio), + ?line ok. + +evil_setup_timers(N, Receiver, Msg) -> + ?line evil_setup_timers(0, N, Receiver, Msg, []). + +evil_setup_timers(N, N, _Receiver, _Msg, TOs) -> + ?line TOs; +evil_setup_timers(N, Max, Receiver, Msg, TOs) -> + ?line TRef = erlang:start_timer(N, Receiver, Msg), + ?line evil_setup_timers(N+1, Max, Receiver, Msg, [{timeout,TRef,Msg}|TOs]). + + +evil_recv_timeouts(M) -> + ?line evil_recv_timeouts([], 0, M). + +evil_recv_timeouts(TOs, N, N) -> + ?line TOs; +evil_recv_timeouts(TOs, N, M) -> + ?line receive + {timeout, _, _} = TO -> + ?line evil_recv_timeouts([TO|TOs], N+1, M) + after 0 -> + ?line evil_recv_timeouts(TOs, N, M) + end. + +registered_process(doc) -> []; +registered_process(suite) -> []; +registered_process(Config) when is_list(Config) -> + ?line Mem = mem(), + %% Cancel + ?line T1 = erlang:start_timer(500, ?MODULE, "hej"), + ?line T2 = erlang:send_after(500, ?MODULE, "hej"), + ?line undefined = whereis(?MODULE), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:cancel_timer(T1)), + ?line true = is_integer(erlang:cancel_timer(T2)), + ?line false = erlang:read_timer(T1), + ?line false = erlang:read_timer(T2), + ?line Mem = mem(), + %% Timeout register after start + ?line Ref1 = make_ref(), + ?line T3 = erlang:start_timer(500, ?MODULE, Ref1), + ?line T4 = erlang:send_after(500, ?MODULE, Ref1), + ?line undefined = whereis(?MODULE), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:read_timer(T3)), + ?line true = is_integer(erlang:read_timer(T4)), + ?line true = register(?MODULE, self()), + ?line receive {timeout, T3, Ref1} -> ok end, + ?line receive Ref1 -> ok end, + ?line Mem = mem(), + %% Timeout register before start + ?line Ref2 = make_ref(), + ?line T5 = erlang:start_timer(500, ?MODULE, Ref2), + ?line T6 = erlang:send_after(500, ?MODULE, Ref2), + ?line true = Mem < mem(), + ?line true = is_integer(erlang:read_timer(T5)), + ?line true = is_integer(erlang:read_timer(T6)), + ?line receive {timeout, T5, Ref2} -> ok end, + ?line receive Ref2 -> ok end, + ?line Mem = mem(), + ?line true = unregister(?MODULE), + ?line ok. + +mem() -> + AA = erlang:system_info(allocated_areas), + {value,{bif_timer,Mem}} = lists:keysearch(bif_timer, 1, AA), + Mem. + +process_is_cleaned_up(P) when is_pid(P) -> + undefined == erts_debug:get_internal_state({process_status, P}). + +wait_until(Pred) when is_function(Pred) -> + case catch Pred() of + true -> ok; + _ -> receive after 50 -> ok end, wait_until(Pred) + end. + +get(Time, Msg) -> + receive + Msg -> + ok + after Time + -> + no_message + end. + +get_msg() -> + receive + Msg -> + {ok, Msg} + after 0 -> + empty + end. + +start_slave() -> + ?line {A, B, C} = now(), + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line Name = atom_to_list(?MODULE) ++ "-" ++ integer_to_list(A+B+C), + {ok, Node} = ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]), + Node. + +stop_slave(Node) -> + test_server:stop_node(Node). + +collect(Last) -> + collect(Last, []). + +receive_one() -> + receive + Msg -> + Msg + end. + +collect(Last, Msgs0) -> + Msg = receive_one(), + Msgs = Msgs0 ++ [Msg], + case Msg of + Last -> + Msgs; + _ -> + collect(Last, Msgs) + end. + +match(X, X) -> + %erlang:display({match, X}), + ok; +match(X, Y) -> + %erlang:display({mismatch, X, Y}), + match_aux(X, Y). + +match_aux(X, X) -> + unexpected_error; +match_aux(X, Y) when is_list(X), is_list(Y), length(X) =/= length(Y) -> + %% erlang:display({mismatch, X, Y}), + {list_length_mismatch, length(X), length(Y)}; +match_aux([X|Xs], [X|Ys]) -> + match_aux(Xs, Ys); +match_aux([X|_], [Y|_]) -> + match_aux(X, Y); +match_aux(X, Y) when is_tuple(X), is_tuple(Y), size(X) =/= size(Y) -> + %% erlang:display({mismatch, X, Y}), + {tuple_size_mismatch, size(X), size(Y)}; +match_aux(X, Y) when is_tuple(X), is_tuple(Y) -> + match_aux(tuple_to_list(X), tuple_to_list(Y)); +match_aux(X, Y) -> + %% erlang:display({mismatch, X, Y}), + {mismatch, type(X), type(Y)}. + +type(X) when is_list(X) -> list; +type(X) when is_tuple(X) -> tuple; +type(X) when is_float(X) -> float; +type(X) when is_integer(X) -> integer; +type(X) when is_pid(X) -> {pid, node(X)}; +type(X) when is_reference(X) -> {reference, node(X)}; +type(X) when is_port(X) -> {port, node(X)}; +type(X) when is_binary(X) -> binary; +type(X) when is_atom(X) -> atom; +type(_) -> unknown. + + diff --git a/erts/emulator/test/trace_SUITE.erl b/erts/emulator/test/trace_SUITE.erl new file mode 100644 index 0000000000..2c60ba6838 --- /dev/null +++ b/erts/emulator/test/trace_SUITE.erl @@ -0,0 +1,1496 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(trace_SUITE). + +%%% +%%% Tests the trace BIF. +%%% + +-export([all/1, receive_trace/1, self_send/1, + timeout_trace/1, send_trace/1, + procs_trace/1, dist_procs_trace/1, + suspend/1, mutual_suspend/1, suspend_exit/1, suspender_exit/1, + suspend_system_limit/1, suspend_opts/1, suspend_waiting/1, + new_clear/1, existing_clear/1, + set_on_spawn/1, set_on_first_spawn/1, cpu_timestamp/1, + system_monitor_args/1, more_system_monitor_args/1, + system_monitor_long_gc_1/1, system_monitor_long_gc_2/1, + system_monitor_large_heap_1/1, system_monitor_large_heap_2/1, + bad_flag/1, trace_delivered/1]). + +-include("test_server.hrl"). + +%%% Internal exports +-export([process/1]). + +all(suite) -> + [cpu_timestamp, receive_trace, self_send, timeout_trace, send_trace, + procs_trace, dist_procs_trace, + suspend, mutual_suspend, suspend_exit, suspender_exit, + suspend_system_limit, suspend_opts, suspend_waiting, + new_clear, existing_clear, + set_on_spawn, set_on_first_spawn, + system_monitor_args, more_system_monitor_args, + system_monitor_long_gc_1, system_monitor_long_gc_2, + system_monitor_large_heap_1, system_monitor_large_heap_2, + bad_flag, trace_delivered]. + + +%% No longer testing anything, just reporting whether cpu_timestamp +%% is enabled or not. +cpu_timestamp(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + %% Test whether cpu_timestamp is implemented on this platform. + ?line Works = try erlang:trace(all, true, [cpu_timestamp]) of + _ -> + ?line erlang:trace(all, false, [cpu_timestamp]), + true + catch + error:badarg -> false + end, + + ?line test_server:timetrap_cancel(Dog), + {comment,case Works of + false -> "cpu_timestamp is NOT implemented/does not work"; + true -> "cpu_timestamp works" + end}. + + +%% Tests that trace(Pid, How, ['receive']) works. + +receive_trace(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line Receiver = fun_spawn(fun receiver/0), + ?line process_flag(trap_exit, true), + + %% Trace the process; make sure that we receive the trace messages. + ?line 1 = erlang:trace(Receiver, true, ['receive']), + ?line Hello = {hello, world}, + ?line Receiver ! Hello, + ?line {trace, Receiver, 'receive', Hello} = receive_first(), + ?line Hello2 = {hello, again, world}, + ?line Receiver ! Hello2, + ?line {trace, Receiver, 'receive', Hello2} = receive_first(), + ?line receive_nothing(), + + %% Another process should not be able to trace Receiver. + ?line Intruder = fun_spawn(fun() -> erlang:trace(Receiver, true, ['receive']) end), + ?line {'EXIT', Intruder, {badarg, _}} = receive_first(), + + %% Untrace the process; we should not receive anything. + ?line 1 = erlang:trace(Receiver, false, ['receive']), + ?line Receiver ! {hello, there}, + ?line Receiver ! any_garbage, + ?line receive_nothing(), + + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + +self_send(doc) -> ["Test that traces are generated for messages sent ", + "and received to/from self()."]; +self_send(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line Fun = + fun(Self, Parent) -> receive + go_ahead -> + self() ! from_myself, + Self(Self, Parent); + from_myself -> + Parent ! done + end + end, + ?line Self = self(), + ?line SelfSender = fun_spawn(Fun, [Fun, Self]), + ?line erlang:trace(SelfSender, true, ['receive', 'send']), + ?line SelfSender ! go_ahead, + ?line receive {trace, SelfSender, 'receive', go_ahead} -> ok end, + ?line receive {trace, SelfSender, 'receive', from_myself} -> ok end, + ?line receive + {trace,SelfSender,send,from_myself,SelfSender} -> ok + end, + ?line receive {trace,SelfSender,send,done,Self} -> ok end, + ?line receive done -> ok end, + + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Test that we can receive timeout traces. +timeout_trace(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + ?line Process = fun_spawn(fun process/0), + ?line 1 = erlang:trace(Process, true, ['receive']), + ?line Process ! timeout_please, + ?line {trace, Process, 'receive', timeout_please} = receive_first(), + ?line {trace, Process, 'receive', timeout} = receive_first(), + ?line receive_nothing(), + + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests that trace(Pid, How, [send]) works. + +send_trace(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line process_flag(trap_exit, true), + ?line Sender = fun_spawn(fun sender/0), + ?line Receiver = fun_spawn(fun receiver/0), + + %% Check that a message sent to another process is traced. + ?line 1 = erlang:trace(Sender, true, [send]), + ?line Sender ! {send_please, Receiver, to_receiver}, + ?line {trace, Sender, send, to_receiver, Receiver} = receive_first(), + ?line receive_nothing(), + + %% Check that a message sent to this process is traced. + ?line Sender ! {send_please, self(), to_myself}, + ?line receive to_myself -> ok end, + ?line Self = self(), + ?line {trace, Sender, send, to_myself, Self} = receive_first(), + ?line receive_nothing(), + + %% Another process should not be able to trace Sender. + ?line Intruder = fun_spawn(fun() -> erlang:trace(Sender, true, [send]) end), + ?line {'EXIT', Intruder, {badarg, _}} = receive_first(), + + %% Untrace the sender process and make sure that we receive no more + %% trace messages. + ?line 1 = erlang:trace(Sender, false, [send]), + ?line Sender ! {send_please, Receiver, to_receiver}, + ?line Sender ! {send_please, self(), to_myself_again}, + ?line receive to_myself_again -> ok end, + ?line receive_nothing(), + + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Test trace(Pid, How, [procs]). +procs_trace(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line Name = list_to_atom(atom_to_list(?MODULE)++"_procs_trace"), + ?line Self = self(), + ?line process_flag(trap_exit, true), + %% + ?line Proc1 = spawn_link(?MODULE, process, [Self]), + ?line io:format("Proc1 = ~p ~n", [Proc1]), + ?line Proc2 = spawn(?MODULE, process, [Self]), + ?line io:format("Proc2 = ~p ~n", [Proc2]), + %% + ?line 1 = erlang:trace(Proc1, true, [procs]), + ?line MFA = {?MODULE, process, [Self]}, + %% + %% spawn, link + ?line Proc1 ! {spawn_link_please, Self, MFA}, + ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end, + ?line {trace, Proc1, spawn, Proc3, MFA} = receive_first(), + ?line io:format("Proc3 = ~p ~n", [Proc3]), + ?line {trace, Proc1, link, Proc3} = receive_first(), + ?line receive_nothing(), + %% + %% getting_unlinked by exit() + ?line Proc1 ! {trap_exit_please, true}, + ?line Reason3 = make_ref(), + ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, + ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, + ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(), + ?line Proc1 ! {trap_exit_please, false}, + ?line receive_nothing(), + %% + %% link + ?line Proc1 ! {link_please, Proc2}, + ?line {trace, Proc1, link, Proc2} = receive_first(), + ?line receive_nothing(), + %% + %% unlink + ?line Proc1 ! {unlink_please, Proc2}, + ?line {trace, Proc1, unlink, Proc2} = receive_first(), + ?line receive_nothing(), + %% + %% getting_linked + ?line Proc2 ! {link_please, Proc1}, + ?line {trace, Proc1, getting_linked, Proc2} = receive_first(), + ?line receive_nothing(), + %% + %% getting_unlinked + ?line Proc2 ! {unlink_please, Proc1}, + ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(), + ?line receive_nothing(), + %% + %% register + ?line true = register(Name, Proc1), + ?line {trace, Proc1, register, Name} = receive_first(), + ?line receive_nothing(), + %% + %% unregister + ?line true = unregister(Name), + ?line {trace, Proc1, unregister, Name} = receive_first(), + ?line receive_nothing(), + %% + %% exit (with registered name, due to link) + ?line Reason4 = make_ref(), + ?line Proc1 ! {spawn_link_please, Self, MFA}, + ?line Proc4 = receive {spawned, Proc1, P4} -> P4 end, + ?line {trace, Proc1, spawn, Proc4, MFA} = receive_first(), + ?line io:format("Proc4 = ~p ~n", [Proc4]), + ?line {trace, Proc1, link, Proc4} = receive_first(), + ?line Proc1 ! {register_please, Name, Proc1}, + ?line {trace, Proc1, register, Name} = receive_first(), + ?line Proc4 ! {exit_please, Reason4}, + ?line receive {'EXIT', Proc1, Reason4} -> ok end, + ?line {trace, Proc1, exit, Reason4} = receive_first(), + ?line {trace, Proc1, unregister, Name} = receive_first(), + ?line receive_nothing(), + %% + %% exit (not linked to tracing process) + ?line 1 = erlang:trace(Proc2, true, [procs]), + ?line Reason2 = make_ref(), + ?line Proc2 ! {exit_please, Reason2}, + ?line {trace, Proc2, exit, Reason2} = receive_first(), + ?line receive_nothing(), + %% + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + + +dist_procs_trace(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(15)), + ?line OtherName = atom_to_list(?MODULE)++"_dist_procs_trace", + ?line {ok, OtherNode} = start_node(OtherName), + ?line Self = self(), + ?line process_flag(trap_exit, true), + %% + ?line Proc1 = spawn_link(?MODULE, process, [Self]), + ?line io:format("Proc1 = ~p ~n", [Proc1]), + ?line Proc2 = spawn(OtherNode, ?MODULE, process, [Self]), + ?line io:format("Proc2 = ~p ~n", [Proc2]), + %% + ?line 1 = erlang:trace(Proc1, true, [procs]), + ?line MFA = {?MODULE, process, [Self]}, + %% + %% getting_unlinked by exit() + ?line Proc1 ! {spawn_link_please, Self, OtherNode, MFA}, + ?line Proc1 ! {trap_exit_please, true}, + ?line Proc3 = receive {spawned, Proc1, P3} -> P3 end, + ?line io:format("Proc3 = ~p ~n", [Proc3]), + ?line {trace, Proc1, getting_linked, Proc3} = receive_first(), + ?line Reason3 = make_ref(), + ?line Proc1 ! {send_please, Proc3, {exit_please, Reason3}}, + ?line receive {Proc1, {'EXIT', Proc3, Reason3}} -> ok end, + ?line {trace, Proc1, getting_unlinked, Proc3} = receive_first(), + ?line Proc1 ! {trap_exit_please, false}, + ?line receive_nothing(), + %% + %% link + ?line Proc1 ! {link_please, Proc2}, + ?line {trace, Proc1, link, Proc2} = receive_first(), + ?line receive_nothing(), + %% + %% unlink + ?line Proc1 ! {unlink_please, Proc2}, + ?line {trace, Proc1, unlink, Proc2} = receive_first(), + ?line receive_nothing(), + %% + %% getting_linked + ?line Proc2 ! {link_please, Proc1}, + ?line {trace, Proc1, getting_linked, Proc2} = receive_first(), + ?line receive_nothing(), + %% + %% getting_unlinked + ?line Proc2 ! {unlink_please, Proc1}, + ?line {trace, Proc1, getting_unlinked, Proc2} = receive_first(), + ?line receive_nothing(), + %% + %% exit (with registered name, due to link) + ?line Name = list_to_atom(OtherName), + ?line Reason2 = make_ref(), + ?line Proc1 ! {link_please, Proc2}, + ?line {trace, Proc1, link, Proc2} = receive_first(), + ?line Proc1 ! {register_please, Name, Proc1}, + ?line {trace, Proc1, register, Name} = receive_first(), + ?line Proc2 ! {exit_please, Reason2}, + ?line receive {'EXIT', Proc1, Reason2} -> ok end, + ?line {trace, Proc1, exit, Reason2} = receive_first(), + ?line {trace, Proc1, unregister, Name} = receive_first(), + ?line receive_nothing(), + %% + %% Done. + ?line true = stop_node(OtherNode), + ?line test_server:timetrap_cancel(Dog), + ok. + + + + +%% Tests trace(Pid, How, [set_on_spawn]). + +set_on_spawn(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_spawn flag. + %% Make sure it is traced. + ?line Father_SOS = fun_spawn(fun process/0), + ?line 1 = erlang:trace(Father_SOS, true, [send, set_on_spawn]), + ?line true = is_send_traced(Father_SOS, Listener, sos_father), + + %% Have the process spawn of two children and test that they + %% are traced. + ?line [Child1, Child2] = spawn_children(Father_SOS, 2), + ?line true = is_send_traced(Child1, Listener, child1), + ?line true = is_send_traced(Child2, Listener, child2), + + %% Second generation. + [Child11, Child12] = spawn_children(Child1, 2), + ?line true = is_send_traced(Child11, Listener, child11), + ?line true = is_send_traced(Child12, Listener, child12), + + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests trace(Pid, How, [set_on_first_spawn]). + +set_on_first_spawn(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Listener = fun_spawn(fun process/0), + + %% Create and trace a process with the set_on_first_spawn flag. + %% Make sure it is traced. + ?line Parent = fun_spawn(fun process/0), + ?line 1 = erlang:trace(Parent, true, [send, set_on_first_spawn]), + ?line is_send_traced(Parent, Listener, sos_father), + + %% Have the process spawn off three children and test that the + %% first is traced. + ?line [Child1, Child2, Child3] = spawn_children(Parent, 3), + ?line true = is_send_traced(Child1, Listener, child1), + ?line false = is_send_traced(Child2, Listener, child2), + ?line false = is_send_traced(Child3, Listener, child3), + ?line receive_nothing(), + + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + + +system_monitor_args(doc) -> + ["Tests arguments to erlang:system_monitor/0-2)"]; +system_monitor_args(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line Self = self(), + %% + ?line OldMonitor = erlang:system_monitor(undefined), + ?line undefined = erlang:system_monitor(Self, [{long_gc,0}]), + ?line MinT = case erlang:system_monitor() of + {Self,[{long_gc,T}]} when is_integer(T), T > 0 -> T; + Other1 -> test_server:fault(Other1) + end, + ?line {Self,[{long_gc,MinT}]} = erlang:system_monitor(), + ?line {Self,[{long_gc,MinT}]} = + erlang:system_monitor({Self,[{large_heap,0}]}), + ?line MinN = case erlang:system_monitor() of + {Self,[{large_heap,N}]} when is_integer(N), N > 0 -> N; + Other2 -> test_server:fault(Other2) + end, + ?line {Self,[{large_heap,MinN}]} = erlang:system_monitor(), + ?line {Self,[{large_heap,MinN}]} = + erlang:system_monitor(Self, [busy_port]), + ?line {Self,[busy_port]} = erlang:system_monitor(), + ?line {Self,[busy_port]} = + erlang:system_monitor({Self,[busy_dist_port]}), + ?line {Self,[busy_dist_port]} = erlang:system_monitor(), + ?line All = lists:sort([busy_port,busy_dist_port, + {long_gc,1},{large_heap,65535}]), + ?line {Self,[busy_dist_port]} = erlang:system_monitor(Self, All), + ?line {Self,A1} = erlang:system_monitor(), + ?line All = lists:sort(A1), + ?line {Self,A1} = erlang:system_monitor(Self, []), + ?line Pid = spawn(fun () -> receive {Self,die} -> exit(die) end end), + ?line Mref = erlang:monitor(process, Pid), + ?line undefined = erlang:system_monitor(Pid, All), + ?line {Pid,A2} = erlang:system_monitor(), + ?line All = lists:sort(A2), + ?line Pid ! {Self,die}, + ?line receive {'DOWN',Mref,_,_,_} -> ok end, + ?line undefined = erlang:system_monitor(OldMonitor), + ?line erlang:yield(), + ?line OldMonitor = erlang:system_monitor(), + %% + ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor(atom)), + ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({})), + ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1})), + ?line {'EXIT',{badarg,_}} = (catch erlang:system_monitor({1,2,3})), + ?line {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,atom})), + ?line {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(atom, atom)), + ?line {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[busy_port|busy_dist_port]})), + ?line {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(Self, [{long_gc,-1}])), + ?line {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[{long_gc,atom}]})), + ?line {'EXIT',{badarg,_}} = + (catch erlang:system_monitor(Self,[{large_heap,-1}])), + ?line {'EXIT',{badarg,_}} = + (catch erlang:system_monitor({Self,[{large_heap,atom}]})), + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + + +more_system_monitor_args(doc) -> + ["Tests arguments to erlang:system_monitor/0-2)"]; +more_system_monitor_args(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + ?line try_l(64000), + ?line try_l(16#7ffffff), + ?line try_l(16#3fffffff), + ?line try_l(16#7fffffff), + ?line try_l(16#ffffffff), + + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + +try_l(Val) -> + Self = self(), + Arbitrary1 = 77777, + Arbitrary2 = 88888, + + ?line erlang:system_monitor(undefined), + + ?line undefined = erlang:system_monitor(Self, [{long_gc,Val},{large_heap,Arbitrary1}]), + + ?line {Self,Comb0} = erlang:system_monitor(Self, [{long_gc,Arbitrary2},{large_heap,Val}]), + ?line [{large_heap,Arbitrary1},{long_gc,Val}] = lists:sort(Comb0), + + ?line {Self,Comb1} = erlang:system_monitor(undefined), + ?line [{large_heap,Val},{long_gc,Arbitrary2}] = lists:sort(Comb1). + +-define(LONG_GC_SLEEP, 670). + +system_monitor_long_gc_1(suite) -> + []; +system_monitor_long_gc_1(doc) -> + ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"]; +system_monitor_long_gc_1(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + try + %% Add ?LONG_GC_SLEEP ms to all gc + ?line erts_debug:set_internal_state(test_long_gc_sleep, + ?LONG_GC_SLEEP), + ?line LoadFun = + fun () -> + garbage_collect(), + self() + end, + ?line long_gc(LoadFun, false) + after + erts_debug:set_internal_state(test_long_gc_sleep, 0), + erts_debug:set_internal_state(available_internal_state, false) + end. + +system_monitor_long_gc_2(suite) -> + []; +system_monitor_long_gc_2(doc) -> + ["Tests erlang:system_monitor(Pid, [{long_gc,Time}])"]; +system_monitor_long_gc_2(Config) when is_list(Config) -> + erts_debug:set_internal_state(available_internal_state, true), + try + %% Add ?LONG_GC_SLEEP ms to all gc + ?line erts_debug:set_internal_state(test_long_gc_sleep, + ?LONG_GC_SLEEP), + ?line Parent = self(), + ?line LoadFun = + fun () -> + Ref = make_ref(), + Pid = + spawn_link( + fun () -> + garbage_collect(), + Parent ! {Ref, self()} + end), + receive {Ref, Pid} -> Pid end + end, + ?line long_gc(LoadFun, true), + ?line long_gc(LoadFun, true), + ?line long_gc(LoadFun, true) + after + erts_debug:set_internal_state(test_long_gc_sleep, 0), + erts_debug:set_internal_state(available_internal_state, false) + end. + +long_gc(LoadFun, ExpectMonMsg) -> + ?line Self = self(), + ?line Time = 1, + ?line OldMonitor = erlang:system_monitor(Self, [{long_gc,Time}]), + ?line Pid = LoadFun(), + ?line Ref = erlang:trace_delivered(Pid), + ?line receive {trace_delivered, Pid, Ref} -> ok end, + ?line {Self,[{long_gc,Time}]} = erlang:system_monitor(OldMonitor), + ?line case {long_gc_check(Pid, Time, undefined), ExpectMonMsg} of + {ok, true} when Pid =/= Self -> + ok; + {ok, false} -> + ?line ?t:fail(unexpected_system_monitor_message_received); + {undefined, false} -> + ok; + {undefined, true} -> + ?line ?t:fail(no_system_monitor_message_received) + end. + +long_gc_check(Pid, Time, Result) -> + receive + {monitor,Pid,long_gc,L} = Monitor -> + case lists:foldl( + fun (_, error) -> + error; + ({timeout,T}, N) when is_integer(T), + Time =< T, T =< 10*?LONG_GC_SLEEP -> + %% OTP-7622. The time T must be within reasonable limits + %% for the test to pass. + N-1; + ({heap_size,_}, N) -> + N-1; + ({old_heap_size,_}, N) -> + N-1; + ({stack_size,_}, N) -> + N-1; + ({mbuf_size,_}, N) -> + N-1; + ({heap_block_size,_}, N) -> + N-1; + ({old_heap_block_size,_}, N) -> + N-1; + (_, _) -> + error + end, 7, L) of + 0 -> + long_gc_check(Pid, Time, ok); + error -> + {error,Monitor} + end; + {monitor,_,long_gc,_} -> + long_gc_check(Pid, Time, Result); + Other -> + {error,Other} + after 0 -> + Result + end. + +system_monitor_large_heap_1(suite) -> + []; +system_monitor_large_heap_1(doc) -> + ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"]; +system_monitor_large_heap_1(Config) when is_list(Config) -> + ?line LoadFun = + fun (Size) -> + List = seq(1,2*Size), + garbage_collect(), + true = lists:prefix([1], List), + self() + end, + ?line large_heap(LoadFun, false). + +system_monitor_large_heap_2(suite) -> + []; +system_monitor_large_heap_2(doc) -> + ["Tests erlang:system_monitor(Pid, [{large_heap,Size}])"]; +system_monitor_large_heap_2(Config) when is_list(Config) -> + ?line Parent = self(), + ?line LoadFun = + fun (Size) -> + Ref = make_ref(), + Pid = + spawn_opt(fun () -> + garbage_collect(), + Parent ! {Ref, self()} + end, + [link, {min_heap_size, 2*Size}]), + receive {Ref, Pid} -> Pid end + end, + ?line large_heap(LoadFun, true). + +large_heap(LoadFun, ExpectMonMsg) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + %% + ?line Size = 65535, + ?line Self = self(), + ?line NewMonitor = {Self,[{large_heap,Size}]}, + ?line OldMonitor = erlang:system_monitor(NewMonitor), + ?line Pid = LoadFun(Size), + ?line Ref = erlang:trace_delivered(Pid), + ?line receive {trace_delivered, Pid, Ref} -> ok end, + ?line {Self,[{large_heap,Size}]} = erlang:system_monitor(OldMonitor), + ?line case {large_heap_check(Pid, Size, undefined), ExpectMonMsg} of + {ok, true} when Pid =/= Self -> + ?line ok; + {ok, false} -> + ?line ?t:fail(unexpected_system_monitor_message_received); + {undefined, false} -> + ?line ok; + {undefined, true} -> + ?line ?t:fail(no_system_monitor_message_received) + end, + %% + ?line test_server:timetrap_cancel(Dog), + ok. + +large_heap_check(Pid, Size, Result) -> + receive + {monitor,Pid,large_heap,L} = Monitor -> + case lists:foldl( + fun (_, error) -> + error; + ({heap_size,_}, N) -> + N-1; + ({old_heap_size,_}, N) -> + N-1; + ({stack_size,_}, N) -> + N-1; + ({mbuf_size,_}, N) -> + N-1; + ({heap_block_size,_}, N) -> + N-1; + ({old_heap_block_size,_}, N) -> + N-1; + (_, _) -> + error + end, 6, L) of + 0 -> + large_heap_check(Pid, Size, ok); + error -> + {error,Monitor} + end; + {monitor,_,large_heap,_} -> + large_heap_check(Pid, Size, Result); + Other -> + {error,Other} + after 0 -> + Result + end. + +seq(N, M) -> + seq(N, M, []). + +seq(M, M, R) -> + lists:reverse(R); +seq(N, M, R) -> + seq(N+1, M, [N|R]). + + +is_send_traced(Pid, Listener, Msg) -> + Pid ! {send_please, Listener, Msg}, + receive + Any -> + {trace, Pid, send, Msg, Listener} = Any, + true + after 1000 -> + false + end. + +%% This procedure assumes that the Parent process is send traced. + +spawn_children(Parent, Number) -> + spawn_children(Parent, Number, []). + +spawn_children(_Parent, 0, Result) -> + lists:reverse(Result); +spawn_children(Parent, Number, Result) -> + Self = self(), + Parent ! {spawn_please, Self, fun process/0}, + Child = + receive + {trace, Parent, send, {spawned, Pid}, Self} -> Pid + end, + receive + {spawned, Child} -> + spawn_children(Parent, Number-1, [Child|Result]) + end. + +suspend(doc) -> "Test erlang:suspend/1 and erlang:resume/1."; +suspend(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(2)), + + ?line Worker = fun_spawn(fun worker/0), + %% Suspend a process and test that it is suspended. + ?line ok = do_suspend(Worker, 10000), + + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + +do_suspend(_Pid, 0) -> + ?line ok; +do_suspend(Pid, N) -> + %% Suspend a process and test that it is suspended. + ?line true = erlang:suspend_process(Pid), + ?line {status, suspended} = process_info(Pid, status), + + %% Unsuspend the process and make sure it starts working. + ?line true = erlang:resume_process(Pid), + ?line case process_info(Pid, status) of + {status, runnable} -> ?line ok; + {status, running} -> ?line ok; + {status, garbage_collecting} -> ?line ok; + ST -> ?line ?t:fail(ST) + end, + ?line erlang:yield(), + ?line do_suspend(Pid, N-1). + + + +mutual_suspend(doc) -> + []; +mutual_suspend(suite) -> + []; +mutual_suspend(Config) when is_list(Config) -> + ?line TimeoutSecs = 5*60, + ?line Dog = test_server:timetrap(test_server:minutes(TimeoutSecs)), + ?line Parent = self(), + ?line Fun = fun () -> + receive + {go, Pid} -> + do_mutual_suspend(Pid, 100000) + end, + Parent ! {done, self()}, + receive after infinity -> ok end + end, + ?line P1 = spawn_link(Fun), + ?line P2 = spawn_link(Fun), + ?line T1 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), + ?line T2 = erlang:start_timer((TimeoutSecs - 5)*1000, self(), oops), + ?line P1 ! {go, P2}, + ?line P2 ! {go, P1}, + ?line Res1 = receive + {done, P1} -> done; + {timeout,T1,_} -> timeout + end, + ?line Res2 = receive + {done, P2} -> done; + {timeout,T2,_} -> timeout + end, + ?line P1S = process_info(P1, status), + ?line P2S = process_info(P2, status), + ?line ?t:format("P1S=~p P2S=~p", [P1S, P2S]), + ?line false = {status, suspended} == P1S, + ?line false = {status, suspended} == P2S, + ?line unlink(P1), exit(P1, bang), + ?line unlink(P2), exit(P2, bang), + ?line done = Res1, + ?line done = Res2, + %% Done. + ?line test_server:timetrap_cancel(Dog), + ?line ok. + +do_mutual_suspend(_Pid, 0) -> + ?line ok; +do_mutual_suspend(Pid, N) -> + %% Suspend a process and test that it is suspended. + ?line true = erlang:suspend_process(Pid), + ?line {status, suspended} = process_info(Pid, status), + %% Unsuspend the process. + ?line true = erlang:resume_process(Pid), + ?line do_mutual_suspend(Pid, N-1). + +suspend_exit(doc) -> + []; +suspend_exit(suite) -> + []; +suspend_exit(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(2)), + ?line random:seed(4711,17,4711), + ?line do_suspend_exit(5000), + ?line test_server:timetrap_cancel(Dog), + ?line ok. + +do_suspend_exit(0) -> + ?line ok; +do_suspend_exit(N) -> + ?line Work = random:uniform(50), + ?line Parent = self(), + ?line {Suspendee, Mon2} + = spawn_monitor(fun () -> + suspend_exit_work(Work), + exit(normal) + end), + ?line {Suspender, Mon1} + = spawn_monitor( + fun () -> + suspend_exit_work(Work div 2), + Parent ! {doing_suspend, self()}, + case catch erlang:suspend_process(Suspendee) of + {'EXIT', _} -> + ok; + true -> + ?line erlang:resume_process(Suspendee) + end + end), + ?line receive + {doing_suspend, Suspender} -> + case N rem 2 of + 0 -> exit(Suspender, bang); + 1 -> ok + end + end, + ?line receive {'DOWN', Mon1, process, Suspender, _} -> ok end, + ?line receive {'DOWN', Mon2, process, Suspendee, _} -> ok end, + ?line do_suspend_exit(N-1). + + + + +suspend_exit_work(0) -> + ok; +suspend_exit_work(N) -> + process_info(self()), + suspend_exit_work(N-1). + +-define(CHK_SUSPENDED(P,B), chk_suspended(P, B, ?LINE)). + +chk_suspended(P, Bool, Line) -> + {Bool, Line} = {({status, suspended} == process_info(P, status)), Line}. + +suspender_exit(doc) -> + []; +suspender_exit(suite) -> + []; +suspender_exit(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(3)), + ?line P1 = spawn_link(fun () -> receive after infinity -> ok end end), + ?line {'EXIT', _} = (catch erlang:resume_process(P1)), + ?line {P2, M2} = spawn_monitor( + fun () -> + ?CHK_SUSPENDED(P1, false), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:resume_process(P1), + erlang:resume_process(P1), + erlang:resume_process(P1), + ?CHK_SUSPENDED(P1, true), + erlang:resume_process(P1), + ?CHK_SUSPENDED(P1, false), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + exit(bang) + end), + ?line receive + {'DOWN', M2,process,P2,R2} -> + ?line bang = R2, + ?line ?CHK_SUSPENDED(P1, false) + end, + ?line Parent = self(), + ?line {P3, M3} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + ?line {P4, M4} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + ?line {P5, M5} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + ?line {P6, M6} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + ?line {P7, M7} = spawn_monitor( + fun () -> + erlang:suspend_process(P1), + ?CHK_SUSPENDED(P1, true), + Parent ! self(), + receive after infinity -> ok end + end), + ?line receive P3 -> ok end, + ?line receive P4 -> ok end, + ?line receive P5 -> ok end, + ?line receive P6 -> ok end, + ?line receive P7 -> ok end, + ?line ?CHK_SUSPENDED(P1, true), + ?line exit(P3, bang), + ?line receive + {'DOWN',M3,process,P3,R3} -> + ?line bang = R3, + ?line ?CHK_SUSPENDED(P1, true) + end, + ?line exit(P4, bang), + ?line receive + {'DOWN',M4,process,P4,R4} -> + ?line bang = R4, + ?line ?CHK_SUSPENDED(P1, true) + end, + ?line exit(P5, bang), + ?line receive + {'DOWN',M5,process,P5,R5} -> + ?line bang = R5, + ?line ?CHK_SUSPENDED(P1, true) + end, + ?line exit(P6, bang), + ?line receive + {'DOWN',M6,process,P6,R6} -> + ?line bang = R6, + ?line ?CHK_SUSPENDED(P1, true) + end, + ?line exit(P7, bang), + ?line receive + {'DOWN',M7,process,P7,R7} -> + ?line bang = R7, + ?line ?CHK_SUSPENDED(P1, false) + end, + ?line unlink(P1), + ?line exit(P1, bong), + ?line test_server:timetrap_cancel(Dog), + ?line ok. + +suspend_system_limit(doc) -> + []; +suspend_system_limit(suite) -> + []; +suspend_system_limit(Config) when is_list(Config) -> + case os:getenv("ERL_EXTREME_TESTING") of + "true" -> + ?line Dog = test_server:timetrap(test_server:minutes(3*60)), + ?line P = spawn_link(fun () -> receive after infinity -> ok end end), + ?line suspend_until_system_limit(P), + ?line unlink(P), + ?line exit(P, bye), + ?line test_server:timetrap_cancel(Dog), + ?line ok; + _ -> + {skip, "Takes too long time for normal testing"} + end. + +suspend_until_system_limit(P) -> + ?line suspend_until_system_limit(P, 0, 0). + +suspend_until_system_limit(P, N, M) -> + NewM = case M of + 1 -> + ?line ?CHK_SUSPENDED(P, true), 2; + 1000000 -> + erlang:display(N), 1; + _ -> + M+1 + end, + ?line case catch erlang:suspend_process(P) of + true -> + suspend_until_system_limit(P, N+1, NewM); + {'EXIT', R} when R == system_limit; + element(1, R) == system_limit -> + ?line ?t:format("system limit at ~p~n", [N]), + ?line resume_from_system_limit(P, N, 0); + Error -> + ?line ?t:fail(Error) + end. + +resume_from_system_limit(P, 0, _) -> + ?line ?CHK_SUSPENDED(P, false), + ?line {'EXIT', _} = (catch erlang:resume_process(P)), + ?line ok; +resume_from_system_limit(P, N, M) -> + ?line NewM = case M of + 1 -> + ?line ?CHK_SUSPENDED(P, true), 2; + 1000000 -> + erlang:display(N), 1; + _ -> + M+1 + end, + ?line erlang:resume_process(P), + ?line resume_from_system_limit(P, N-1, NewM). + +-record(susp_info, {async = 0, + dbl_async = 0, + synced = 0, + async_once = 0}). + +suspend_opts(doc) -> + []; +suspend_opts(suite) -> + []; +suspend_opts(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(3)), + ?line Self = self(), + ?line wait_for_empty_runq(10), + ?line Tok = spawn_link(fun () -> + Self ! self(), + tok_trace_loop(Self, 0, 1000000000) + end), + ?line TC = 1000, + ?line receive Tok -> ok end, + ?line SF = fun (N, #susp_info {async = A, + dbl_async = AA, + synced = S, + async_once = AO} = Acc) -> + ?line erlang:suspend_process(Tok, [asynchronous]), + ?line Res = case {suspend_count(Tok), N rem 4} of + {0, 2} -> + ?line erlang:suspend_process(Tok, + [asynchronous]), + case suspend_count(Tok) of + 2 -> + ?line erlang:resume_process(Tok), + ?line Acc#susp_info{async = A+1}; + 0 -> + ?line erlang:resume_process(Tok), + ?line Acc#susp_info{async = A+1, + dbl_async = AA+1} + end; + {0, 1} -> + ?line erlang:suspend_process(Tok, + [asynchronous, + unless_suspending]), + case suspend_count(Tok) of + 1 -> + ?line Acc#susp_info{async = A+1}; + 0 -> + ?line Acc#susp_info{async = A+1, + async_once = AO+1} + end; + {0, 0} -> + ?line erlang:suspend_process(Tok, + [unless_suspending]), + ?line 1 = suspend_count(Tok), + ?line Acc#susp_info{async = A+1, + synced = S+1}; + {0, _} -> + ?line Acc#susp_info{async = A+1}; + _ -> + Acc + end, + ?line erlang:resume_process(Tok), + ?line erlang:yield(), + ?line Res + end, + ?line SI = repeat_acc(SF, TC, #susp_info{}), + ?line erlang:suspend_process(Tok, [asynchronous]), + %% Verify that it eventually suspends + ?line WaitTime0 = 10, + ?line WaitTime1 = case {erlang:system_info(debug_compiled), + erlang:system_info(lock_checking)} of + {false, false} -> + WaitTime0; + {false, true} -> + WaitTime0*5; + _ -> + WaitTime0*10 + end, + ?line WaitTime = case {erlang:system_info(schedulers_online), + erlang:system_info(logical_processors)} of + {Schdlrs, CPUs} when is_integer(CPUs), + Schdlrs =< CPUs -> + WaitTime1; + _ -> + WaitTime1*10 + end, + ?line receive after WaitTime -> ok end, + ?line 1 = suspend_count(Tok), + ?line erlang:suspend_process(Tok, [asynchronous]), + ?line 2 = suspend_count(Tok), + ?line erlang:suspend_process(Tok, [asynchronous]), + ?line 3 = suspend_count(Tok), + ?line erlang:suspend_process(Tok), + ?line 4 = suspend_count(Tok), + ?line erlang:suspend_process(Tok), + ?line 5 = suspend_count(Tok), + ?line erlang:suspend_process(Tok, [unless_suspending]), + ?line 5 = suspend_count(Tok), + ?line erlang:suspend_process(Tok, [unless_suspending, + asynchronous]), + ?line 5 = suspend_count(Tok), + ?line erlang:resume_process(Tok), + ?line erlang:resume_process(Tok), + ?line erlang:resume_process(Tok), + ?line erlang:resume_process(Tok), + ?line 1 = suspend_count(Tok), + ?line ?t:format("Main suspends: ~p~n" + "Main async: ~p~n" + "Double async: ~p~n" + "Async once: ~p~n" + "Synced: ~p~n", + [TC, + SI#susp_info.async, + SI#susp_info.dbl_async, + SI#susp_info.async_once, + SI#susp_info.synced]), + ?line case erlang:system_info(schedulers_online) of + 1 -> + ?line ok; + _ -> + ?line true = SI#susp_info.async =/= 0 + end, + ?line unlink(Tok), + ?line exit(Tok, bang), + ?line test_server:timetrap_cancel(Dog), + ?line ok. + +suspend_count(Suspendee) -> + suspend_count(self(), Suspendee). + +suspend_count(Suspender, Suspendee) -> + {suspending, SList} = process_info(Suspender, suspending), + + case lists:keysearch(Suspendee, 1, SList) of + {value, {_Suspendee, 0, 0}} -> + ?line ?t:fail({bad_suspendee_list, SList}); + {value, {Suspendee, Count, 0}} when is_integer(Count), Count > 0 -> + {status, suspended} = process_info(Suspendee, status), + Count; + {value, {Suspendee, 0, Outstanding}} when is_integer(Outstanding), + Outstanding > 0 -> + 0; + false -> + 0; + Error -> + ?line ?t:fail({bad_suspendee_list, Error, SList}) + end. + +repeat_acc(Fun, N, Acc) -> + repeat_acc(Fun, 0, N, Acc). + +repeat_acc(_Fun, N, N, Acc) -> + Acc; +repeat_acc(Fun, N, M, Acc) -> + repeat_acc(Fun, N+1, M, Fun(N, Acc)). + +%% Tests that waiting process can be suspended +%% (bug in R2D and earlier; see OTP-1488). + +suspend_waiting(doc) -> "Test that a waiting process can be suspended."; +suspend_waiting(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + ?line Process = fun_spawn(fun process/0), + ?line receive after 1 -> ok end, + ?line true = erlang:suspend_process(Process), + ?line {status, suspended} = process_info(Process, status), + + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + + + +new_clear(doc) -> + "Test that erlang:trace(new, true, ...) is cleared when tracer dies."; +new_clear(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + ?line Tracer = spawn(fun receiver/0), + ?line 0 = erlang:trace(new, true, [send, {tracer, Tracer}]), + ?line {flags, [send]} = erlang:trace_info(new, flags), + ?line {tracer, Tracer} = erlang:trace_info(new, tracer), + ?line Mref = erlang:monitor(process, Tracer), + ?line true = exit(Tracer, done), + receive + {'DOWN',Mref,_,_,_} -> ok + end, + ?line {flags, []} = erlang:trace_info(new, flags), + ?line {tracer, []} = erlang:trace_info(new, tracer), + + %% Done. + ?line test_server:timetrap_cancel(Dog), + + ok. + + + +existing_clear(doc) -> + "Test that erlang:trace(all, false, ...) works without tracer."; +existing_clear(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line Self = self(), + + ?line Tracer = fun_spawn(fun receiver/0), + ?line N = erlang:trace(existing, true, [send, {tracer, Tracer}]), + ?line {flags, [send]} = erlang:trace_info(Self, flags), + ?line {tracer, Tracer} = erlang:trace_info(Self, tracer), + ?line M = erlang:trace(all, false, [all]), + ?line io:format("Started trace on ~p processes and stopped on ~p~n", + [N, M]), + ?line {flags, []} = erlang:trace_info(Self, flags), + ?line {tracer, []} = erlang:trace_info(Self, tracer), + ?line M = N + 1, % Since trace could not be enabled on the tracer. + + %% Done. + ?line test_server:timetrap_cancel(Dog), + ok. + +bad_flag(doc) -> "Test that an invalid flag cause badarg"; +bad_flag(suite) -> []; +bad_flag(Config) when is_list(Config) -> + %% A bad flag could deadlock the SMP emulator in erts-5.5 + ?line {'EXIT', {badarg, _}} = (catch erlang:trace(new, + true, + [not_a_valid_flag])), + ?line ok. + +trace_delivered(doc) -> "Test erlang:trace_delivered/1"; +trace_delivered(suite) -> []; +trace_delivered(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + ?line TokLoops = 10000, + ?line Go = make_ref(), + ?line Parent = self(), + ?line Tok = spawn(fun () -> + receive Go -> gone end, + tok_trace_loop(Parent, 0, TokLoops) + end), + ?line 1 = erlang:trace(Tok, true, [procs]), + ?line Mon = erlang:monitor(process, Tok), + ?line NoOfTraceMessages = 4*TokLoops + 1, + ?line io:format("Expect a total of ~p trace messages~n", + [NoOfTraceMessages]), + ?line Tok ! Go, + ?line NoOfTraceMessages = drop_trace_until_down(Tok, Mon), + ?line receive + Msg -> + ?line ?t:fail({unexpected_message, Msg}) + after 1000 -> + ?line test_server:timetrap_cancel(Dog), + ?line ok + end. + +drop_trace_until_down(Proc, Mon) -> + drop_trace_until_down(Proc, Mon, false, 0, 0). + +drop_trace_until_down(Proc, Mon, TDRef, N, D) -> + case receive Msg -> Msg end of + {trace_delivered, Proc, TDRef} -> + io:format("~p trace messages on 'DOWN'~n", [D]), + io:format("Got a total of ~p trace messages~n", [N]), + N; + {'DOWN', Mon, process, Proc, _} -> + Ref = erlang:trace_delivered(Proc), + drop_trace_until_down(Proc, Mon, Ref, N, N); + Trace when is_tuple(Trace), + element(1, Trace) == trace, + element(2, Trace) == Proc -> + drop_trace_until_down(Proc, Mon, TDRef, N+1, D) + end. + +tok_trace_loop(_, N, N) -> + ok; +tok_trace_loop(Parent, N, M) -> + Name = 'A really stupid name which I will unregister at once', + link(Parent), + register(Name, self()), + unregister(Name), + unlink(Parent), + tok_trace_loop(Parent, N+1, M). + +%% Waits for and returns the first message in the message queue. + +receive_first() -> + receive + Any -> Any + end. + +%% Ensures that there is no message in the message queue. + +receive_nothing() -> + receive + Any -> + test_server:fail({unexpected_message, Any}) + after 200 -> + ok + end. + + +%%% Models for various kinds of processes. + +process(Dest) -> + receive + {send_please, To, What} -> + To ! What, + process(Dest); + {spawn_link_please, ReplyTo, {M, F, A}} -> + Pid = spawn_link(M, F, A), + ReplyTo ! {spawned, self(), Pid}, + process(Dest); + {spawn_link_please, ReplyTo, Node, {M, F, A}} -> + Pid = spawn_link(Node, M, F, A), + ReplyTo ! {spawned, self(), Pid}, + process(Dest); + {link_please, Pid} -> + link(Pid), + process(Dest); + {unlink_please, Pid} -> + unlink(Pid), + process(Dest); + {register_please, Name, Pid} -> + register(Name, Pid), + process(Dest); + {unregister_please, Name} -> + unregister(Name), + process(Dest); + {exit_please, Reason} -> + exit(Reason); + {trap_exit_please, State} -> + process_flag(trap_exit, State), + process(Dest); + Other -> + Dest ! {self(), Other}, + process(Dest) + after 3000 -> + exit(timeout) + end. + + +%% A smart process template. + +process() -> + receive + {spawn_please, ReplyTo, Fun} -> + Pid = fun_spawn(Fun), + ReplyTo ! {spawned, Pid}, + process(); + {send_please, To, What} -> + To ! What, + process(); + timeout_please -> + receive after 1 -> process() end; + _Other -> + process() + end. + + +%% Sends messages when ordered to. + +sender() -> + receive + {send_please, To, What} -> + To ! What, + sender() + end. + + +%% Just consumes messages from its message queue. + +receiver() -> + receive + _Any -> receiver() + end. + +%% Works as long as it receives CPU time. Will always be RUNNABLE. + +worker() -> + worker(0). + +worker(Number) -> + worker(Number+1). + +fun_spawn(Fun) -> + spawn_link(erlang, apply, [Fun, []]). + +fun_spawn(Fun, Args) -> + spawn_link(erlang, apply, [Fun, Args]). + + +start_node(Name) -> + Pa = filename:dirname(code:which(?MODULE)), + Cookie = atom_to_list(erlang:get_cookie()), + test_server:start_node(Name, slave, + [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]). + +stop_node(Node) -> + test_server:stop_node(Node). + + +wait_for_empty_runq(DeadLine) -> + case statistics(run_queue) of + 0 -> true; + RQLen -> + erlang:display("Waiting for empty run queue"), + MSDL = DeadLine*1000, + wait_for_empty_runq(MSDL, MSDL, RQLen) + end. + +wait_for_empty_runq(DeadLine, Left, RQLen) when Left =< 0 -> + issue_non_empty_runq_warning(DeadLine, RQLen), + false; +wait_for_empty_runq(DeadLine, Left, _RQLen) -> + Wait = 10, + UntilDeadLine = Left - Wait, + receive after Wait -> ok end, + case statistics(run_queue) of + 0 -> + erlang:display("Waited for " + ++ integer_to_list(DeadLine + - UntilDeadLine) + ++ " ms for empty run queue."), + true; + NewRQLen -> + wait_for_empty_runq(DeadLine, + UntilDeadLine, + NewRQLen) + end. + +issue_non_empty_runq_warning(DeadLine, RQLen) -> + PIs = lists:foldl( + fun (P, Acc) -> + case process_info(P, + [status, + initial_call, + current_function, + registered_name, + reductions, + message_queue_len]) of + [{status, Runnable} | _] = PI when Runnable /= waiting, + Runnable /= suspended -> + [[{pid, P} | PI] | Acc]; + _ -> + Acc + end + end, + [], + processes()), + ?t:format("WARNING: Unexpected runnable processes in system (waited ~p sec).~n" + " Run queue length: ~p~n" + " Self: ~p~n" + " Processes info: ~p~n", + [DeadLine div 1000, RQLen, self(), PIs]), + receive after 1000 -> ok end. diff --git a/erts/emulator/test/trace_bif_SUITE.erl b/erts/emulator/test/trace_bif_SUITE.erl new file mode 100644 index 0000000000..3f91f8dc08 --- /dev/null +++ b/erts/emulator/test/trace_bif_SUITE.erl @@ -0,0 +1,268 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(trace_bif_SUITE). + +-include("test_server.hrl"). + +-export([all/1]). +-export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1, trace_bif_local/1, + trace_bif_timestamp_local/1, trace_bif_return/1, not_run/1, + trace_info_old_code/1]). + +-export([bif_process/0]). + +all(suite) -> + case test_server:is_native(?MODULE) of + true -> [not_run]; + false -> + [trace_bif, trace_bif_timestamp, trace_on_and_off, + trace_bif_local, trace_bif_timestamp_local, + trace_bif_return, trace_info_old_code] + end. + +not_run(Config) when is_list(Config) -> + {skipped,"Native code"}. + +trace_on_and_off(doc) -> + "Tests switching tracing on and off."; +trace_on_and_off(Config) when is_list(Config) -> + ?line Pid = spawn(?MODULE, bif_process, []), + ?line Self = self(), + ?line 1 = erlang:trace(Pid, true, [call,timestamp]), + ?line {flags,[timestamp,call]} = erlang:trace_info(Pid,flags), + ?line {tracer, Self} = erlang:trace_info(Pid,tracer), + ?line 1 = erlang:trace(Pid, false, [timestamp]), + ?line {flags,[call]} = erlang:trace_info(Pid,flags), + ?line {tracer, Self} = erlang:trace_info(Pid,tracer), + ?line 1 = erlang:trace(Pid, false, [call]), + ?line {flags,[]} = erlang:trace_info(Pid,flags), + ?line {tracer, []} = erlang:trace_info(Pid,tracer), + ?line exit(Pid,kill), + ok. + +trace_bif(doc) -> "Test tracing BIFs."; +trace_bif(Config) when is_list(Config) -> + do_trace_bif([]). + +trace_bif_local(doc) -> "Test tracing BIFs with local flag."; +trace_bif_local(Config) when is_list(Config) -> + do_trace_bif([local]). + +do_trace_bif(Flags) -> + ?line Pid = spawn(?MODULE, bif_process, []), + ?line 1 = erlang:trace(Pid, true, [call]), + ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags), + ?line Pid ! {do_bif, time, []}, + ?line receive_trace_msg({trace,Pid,call,{erlang,time, []}}), + ?line Pid ! {do_bif, statistics, [runtime]}, + ?line receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), + + ?line Pid ! {do_time_bif}, + ?line receive_trace_msg({trace,Pid,call, + {erlang,time, []}}), + + ?line Pid ! {do_statistics_bif}, + ?line receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), + + ?line 1 = erlang:trace(Pid, false, [call]), + ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), + ?line exit(Pid, die), + ok. + +trace_bif_timestamp(doc) -> "Test tracing BIFs with timestamps."; +trace_bif_timestamp(Config) when is_list(Config) -> + do_trace_bif_timestamp([]). + +trace_bif_timestamp_local(doc) -> + "Test tracing BIFs with timestamps and local flag."; +trace_bif_timestamp_local(Config) when is_list(Config) -> + do_trace_bif_timestamp([local]). + +do_trace_bif_timestamp(Flags) -> + ?line Pid=spawn(?MODULE, bif_process, []), + ?line 1 = erlang:trace(Pid, true, [call,timestamp]), + ?line erlang:trace_pattern({erlang,'_','_'}, [], Flags), + + ?line Pid ! {do_bif, time, []}, + ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}), + + ?line Pid ! {do_bif, statistics, [runtime]}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}), + + ?line Pid ! {do_time_bif}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,time, []}}), + + ?line Pid ! {do_statistics_bif}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}), + + %% We should be able to turn off the timestamp. + ?line 1 = erlang:trace(Pid, false, [timestamp]), + + ?line Pid ! {do_statistics_bif}, + ?line receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), + + ?line Pid ! {do_bif, statistics, [runtime]}, + ?line receive_trace_msg({trace,Pid,call, + {erlang,statistics, [runtime]}}), + + ?line 1 = erlang:trace(Pid, false, [call]), + ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), + + ?line exit(Pid, die), + ok. + +trace_bif_return(doc) -> + "Test tracing BIF's with return/return_to trace."; +trace_bif_return(Config) when is_list(Config) -> + ?line Pid=spawn(?MODULE, bif_process, []), + ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), + ?line erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}], + [local]), + + + ?line Pid ! {do_bif, time, []}, + ?line receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}}), + ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,time,0}}), + ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}), + + + ?line Pid ! {do_bif, statistics, [runtime]}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}), + ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,statistics,1}}), + ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}), + + + ?line Pid ! {do_time_bif}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,time, []}}), + ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,time,0}}), + ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}), + + + + ?line Pid ! {do_statistics_bif}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {erlang,statistics, [runtime]}}), + ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {erlang,statistics,1}}), + ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, bif_process,0}}), + ok. + + +receive_trace_msg(Mess) -> + receive + Mess -> + ok; + Other -> + io:format("Expected: ~p,~nGot: ~p~n", [Mess, Other]), + ?t:fail() + after 5000 -> + io:format("Expected: ~p,~nGot: timeout~n", [Mess]), + ?t:fail() + end. + +receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}) -> + receive + {trace_ts, Pid, call, {erlang, F, A}, _Ts} -> + ok; + Other -> + io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", + [Pid, erlang, F, A, Other]), + ?t:fail() + after 5000 -> + io:format("Got timeout~n", []), + ?t:fail() + end. + +receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}) -> + receive + {trace_ts, Pid, return_from, {erlang, F, A}, _Value, _Ts} -> + ok; + Other -> + io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" + "Got: ~p~n", + [Pid, erlang, F, A, Other]), + ?t:fail() + after 5000 -> + io:format("Got timeout~n", []), + ?t:fail() + end. + +receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> + receive + {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> + ok; + Other -> + io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", + [Pid, M, F, A, Other]), + ?t:fail() + after 5000 -> + io:format("Got timeout~n", []), + ?t:fail() + end. + +bif_process() -> + receive + {do_bif, Name, Args} -> + apply(erlang, Name, Args), + bif_process(); + {do_time_bif} -> + _ = time(), %Assignment tells compiler to keep call. + bif_process(); + {do_statistics_bif} -> + statistics(runtime), + bif_process(); + _Stuff -> + bif_process() + end. + + + +trace_info_old_code(doc) -> "trace_info on deleted module (OTP-5057)."; +trace_info_old_code(Config) when is_list(Config) -> + ?line MFA = {M,F,0} = {test,foo,0}, + ?line Fname = atom_to_list(M)++".erl", + ?line AbsForms = + [{attribute,1,module,M}, % -module(M). + {attribute,2,export,[{F,0}]}, % -export([F/0]). + {function,3,F,0, % F() -> + [{clause,4,[],[],[{atom,4,F}]}]}], % F. + %% + ?line {ok,M,Mbin} = compile:forms(AbsForms), + ?line {module,M} = code:load_binary(M, Fname, Mbin), + ?line true = erlang:delete_module(M), + ?line {traced,undefined} = erlang:trace_info(MFA, traced), + ok. diff --git a/erts/emulator/test/trace_call_count_SUITE.erl b/erts/emulator/test/trace_call_count_SUITE.erl new file mode 100644 index 0000000000..07aa7c8d8d --- /dev/null +++ b/erts/emulator/test/trace_call_count_SUITE.erl @@ -0,0 +1,362 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Define to run outside of test server +%%% +%%% -define(STANDALONE,1). +%%% +%%% +%%% Define for debug output +%%% +%%% -define(debug,1). + +-module(trace_call_count_SUITE). + +%% Exported end user tests +-export([basic_test/0, on_and_off_test/0, info_test/0, + pause_and_restart_test/0, combo_test/0]). + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Test server related stuff +%% + +-ifdef(STANDALONE). +-define(config(A,B),config(A,B)). +-export([config/2]). +-else. +-include("test_server.hrl"). +-endif. + +-ifdef(debug). +-ifdef(STANDALONE). +-define(line, erlang:display({?MODULE,?LINE}), ). +-endif. +-define(dbgformat(A,B),io:format(A,B)). +-else. +-ifdef(STANDALONE). +-define(line, noop, ). +-endif. +-define(dbgformat(A,B),noop). +-endif. + +-ifdef(STANDALONE). +config(priv_dir,_) -> + ".". +-else. +%% When run in test server. +-export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]). +-export([basic/1, on_and_off/1, info/1, + pause_and_restart/1, combo/1]). + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(test_server:seconds(30)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), + erlang:trace_pattern(on_load, false, [local,meta,call_count]), + erlang:trace(all, false, [all]), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +all(doc) -> + ["Test call count tracing of local function calls."]; +all(suite) -> + case test_server:is_native(?MODULE) of + true -> [not_run]; + false -> [basic, on_and_off, info, + pause_and_restart, combo] + end. + +not_run(Config) when is_list(Config) -> + {skipped,"Native code"}. + +basic(suite) -> + []; +basic(doc) -> + ["Tests basic call count trace"]; +basic(Config) when is_list(Config) -> + basic_test(). + +on_and_off(suite) -> + []; +on_and_off(doc) -> + ["Tests turning trace parameters on and off"]; +on_and_off(Config) when is_list(Config) -> + on_and_off_test(). + +info(suite) -> + []; +info(doc) -> + ["Tests the trace_info BIF"]; +info(Config) when is_list(Config) -> + info_test(). + +pause_and_restart(suite) -> + []; +pause_and_restart(doc) -> + ["Tests pausing and restarting call counters"]; +pause_and_restart(Config) when is_list(Config) -> + pause_and_restart_test(). + +combo(suite) -> + []; +combo(doc) -> + ["Tests combining local call trace and meta trace with call count trace"]; +combo(Config) when is_list(Config) -> + combo_test(). + +-endif. %-ifdef(STANDALONE). ... -else. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Result examination macros + +-define(CT(P,MFA),{trace,P,call,MFA}). +-define(CTT(P, MFA),{trace_ts,P,call,MFA,{_,_,_}}). +-define(RF(P,MFA,V),{trace,P,return_from,MFA,V}). +-define(RFT(P,MFA,V),{trace_ts,P,return_from,MFA,V,{_,_,_}}). +-define(RT(P,MFA),{trace,P,return_to,MFA}). +-define(RTT(P,MFA),{trace_ts,P,return_to,MFA,{_,_,_}}). + +%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% The Tests +%%% + +basic_test() -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + ?line M = 1000, + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, true, [call_count]), + ?line L = seq(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line {call_count,0} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + ?line Lr = seq_r(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + ?line L = lists:reverse(Lr), + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +on_and_off_test() -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + ?line M = 100, + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + ?line L = seq(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line N = erlang:trace_pattern({?MODULE,'_','_'}, true, [call_count]), + ?line L = seq(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line P = erlang:trace_pattern({'_','_','_'}, true, [call_count]), + ?line L = seq(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), + ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line L = seq(1, M, fun(X) -> X+1 end), + ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line {call_count,0} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + ?line Lr = seq_r(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + ?line N = erlang:trace_pattern({?MODULE,'_','_'}, false, [call_count]), + ?line {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + ?line Lr = seq_r(1, M, fun(X) -> X+1 end), + ?line {call_count,false} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + ?line L = lists:reverse(Lr), + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +info_test() -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,3}, true, [call_count]), + ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), + ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line {all,[_|_]=L} = erlang:trace_info({?MODULE,seq,3}, all), + ?line {value,{call_count,0}} = lists:keysearch(call_count, 1, L), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), + ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, false, [call_count]), + ?line {call_count,false} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line {all,false} = erlang:trace_info({?MODULE,seq,3}, all), + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +pause_and_restart_test() -> + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + ?line M = 100, + %% + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, true, [call_count]), + ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line L = seq(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, pause, [call_count]), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line L = seq(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line 1 = erlang:trace_pattern({?MODULE,seq,'_'}, restart, [call_count]), + ?line {call_count,0} = erlang:trace_info({?MODULE,seq,3}, call_count), + ?line L = seq(1, M, fun(X) -> X+1 end), + ?line {call_count,M} = erlang:trace_info({?MODULE,seq,3}, call_count), + %% + ?line P = erlang:trace_pattern({'_','_','_'}, false, [call_count]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +combo_test() -> + ?line Self = self(), + + ?line MetaMatchSpec = [{'_',[],[{return_trace}]}], + ?line Flags = lists:sort([call, return_to]), + ?line LocalTracer = spawn_link(fun () -> relay_n(5, Self) end), + ?line MetaTracer = spawn_link(fun () -> relay_n(9, Self) end), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, [], [local]), + ?line 2 = erlang:trace_pattern({?MODULE,seq_r,'_'}, + MetaMatchSpec, + [{meta,MetaTracer}, call_count]), + ?line 1 = erlang:trace(Self, true, [{tracer,LocalTracer} | Flags]), + %% + ?line {traced,local} = + erlang:trace_info({?MODULE,seq_r,3}, traced), + ?line {match_spec,[]} = + erlang:trace_info({?MODULE,seq_r,3}, match_spec), + ?line {meta,MetaTracer} = + erlang:trace_info({?MODULE,seq_r,3}, meta), + ?line {meta_match_spec,MetaMatchSpec} = + erlang:trace_info({?MODULE,seq_r,3}, meta_match_spec), + ?line {call_count,0} = + erlang:trace_info({?MODULE,seq_r,3}, call_count), + %% + ?line {all,[_|_]=TraceInfo} = + erlang:trace_info({?MODULE,seq_r,3}, all), + ?line {value,{traced,local}} = + lists:keysearch(traced, 1, TraceInfo), + ?line {value,{match_spec,[]}} = + lists:keysearch(match_spec, 1, TraceInfo), + ?line {value,{meta,MetaTracer}} = + lists:keysearch(meta, 1, TraceInfo), + ?line {value,{meta_match_spec,MetaMatchSpec}} = + lists:keysearch(meta_match_spec, 1, TraceInfo), + ?line {value,{call_count,0}} = + lists:keysearch(call_count, 1, TraceInfo), + %% + ?line [3,2,1] = seq_r(1, 3, fun(X) -> X+1 end), + %% + ?line List = collect(100), + ?line {MetaR, LocalR} = + lists:foldl( + fun ({P,X}, {M,L}) when P == MetaTracer -> + {[X|M],L}; + ({P,X}, {M,L}) when P == LocalTracer -> + {M,[X|L]} + end, + {[],[]}, + List), + ?line Meta = lists:reverse(MetaR), + ?line Local = lists:reverse(LocalR), + ?line [?CTT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CTT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CTT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CTT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,4},[3,2,1]), + ?RFT(Self,{?MODULE,seq_r,3},[3,2,1])] = Meta, + ?line [?CT(Self,{?MODULE,seq_r,[1,3,_]}), + ?CT(Self,{?MODULE,seq_r,[1,3,_,[]]}), + ?CT(Self,{?MODULE,seq_r,[2,3,_,[1]]}), + ?CT(Self,{?MODULE,seq_r,[3,3,_,[2,1]]}), + ?RT(Self,{?MODULE,combo_test,0})] = Local, + ?line {call_count,1} = erlang:trace_info({?MODULE,seq_r,3}, call_count), + ?line {call_count,3} = erlang:trace_info({?MODULE,seq_r,4}, call_count), + %% + ?line erlang:trace_pattern({'_','_','_'}, false, [local,meta,call_count]), + ?line erlang:trace_pattern(on_load, false, [local,meta,call_count]), + ?line erlang:trace(all, false, [all]), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Local helpers + +%% Stack recursive seq +seq(Stop, Stop, Succ) when is_function(Succ) -> + [Stop]; +seq(Start, Stop, Succ) when is_function(Succ) -> + [Start | seq(Succ(Start), Stop, Succ)]. + + + +%% Tail recursive seq, result list is reversed +seq_r(Start, Stop, Succ) when is_function(Succ) -> + seq_r(Start, Stop, Succ, []). + +seq_r(Stop, Stop, _, R) -> + [Stop | R]; +seq_r(Start, Stop, Succ, R) -> + seq_r(Succ(Start), Stop, Succ, [Start | R]). + + + +%% Message relay process +relay_n(0, _) -> + ok; +relay_n(N, Dest) -> + receive Msg -> + Dest ! {self(), Msg}, + relay_n(N-1, Dest) + end. + + + +%% Collect received messages +collect(Time) -> + Ref = erlang:start_timer(Time, self(), done), + L = lists:reverse(collect([], Ref)), + ?dbgformat("Got: ~p~n",[L]), + L. + +collect(A, 0) -> + receive + Mess -> + collect([Mess | A], 0) + after 0 -> + A + end; +collect(A, Ref) -> + receive + {timeout, Ref, done} -> + collect(A, 0); + Mess -> + collect([Mess | A], Ref) + end. diff --git a/erts/emulator/test/trace_local_SUITE.erl b/erts/emulator/test/trace_local_SUITE.erl new file mode 100644 index 0000000000..24005774ba --- /dev/null +++ b/erts/emulator/test/trace_local_SUITE.erl @@ -0,0 +1,1259 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(trace_local_SUITE). +-compile({nowarn_deprecated_function, {erlang,hash,2}}). + +-export([basic_test/0, bit_syntax_test/0, return_test/0, + on_and_off_test/0, stack_grow_test/0, + info_test/0, delete_test/1, exception_test/1, + not_run/1]). + +-export([exported/1, exported_wrap/1, loop/4, apply_slave_async/5, + match/2, clause/2, id/1, undef/1, lists_reverse/2]). + +%% +%% Define to run outside of test server +%% +%% (rotten feature) +%% +%%-define(STANDALONE,1). + +%% +%% Define for debug output +%% +%%-define(debug,1). + +-ifdef(STANDALONE). +-define(config(A,B),config(A,B)). +-export([config/2]). +-define(DEFAULT_RECEIVE_TIMEOUT, 1000). +-else. +-include("test_server.hrl"). +-define(DEFAULT_RECEIVE_TIMEOUT, infinity). +-endif. + +-ifdef(debug). +-ifdef(STANDALONE). +-define(line, erlang:display({?MODULE,?LINE}), ). +-endif. +-define(dbgformat(A,B),io:format(A,B)). +-else. +-ifdef(STANDALONE). +-define(line, noop, ). +-endif. +-define(dbgformat(A,B),noop). +-endif. + +-ifdef(STANDALONE). +config(priv_dir,_) -> + ".". +-else. + +%%% When run in test server %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-export([all/1, basic/1, bit_syntax/1, + return/1, on_and_off/1, stack_grow/1,info/1, delete/1, + exception/1, exception_apply/1, + exception_function/1, exception_apply_function/1, + exception_nocatch/1, exception_nocatch_apply/1, + exception_nocatch_function/1, exception_nocatch_apply_function/1, + exception_meta/1, exception_meta_apply/1, + exception_meta_function/1, exception_meta_apply_function/1, + exception_meta_nocatch/1, exception_meta_nocatch_apply/1, + exception_meta_nocatch_function/1, + exception_meta_nocatch_apply_function/1, + init_per_testcase/2, fin_per_testcase/2]). +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(2)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + shutdown(), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. +all(doc) -> + ["Test tracing of local function calls and return traces."]; +all(suite) -> + case test_server:is_native(?MODULE) of + true -> [not_run]; + false -> [basic, bit_syntax, return, on_and_off, stack_grow, info, delete, + exception, exception_apply, + exception_function, exception_apply_function, + exception_nocatch, exception_nocatch_apply, + exception_nocatch_function, + exception_nocatch_apply_function, + exception_meta, exception_meta_apply, + exception_meta_function, exception_meta_apply_function, + exception_meta_nocatch, exception_meta_nocatch_apply, + exception_meta_nocatch_function, + exception_meta_nocatch_apply_function] + end. + +not_run(Config) when is_list(Config) -> + {skipped,"Native code"}. + +basic(doc) -> + ["Tests basic local call-trace"]; +basic(Config) when is_list(Config) -> + basic_test(). + +bit_syntax(doc) -> + "OTP-7399: Make sure that code that uses the optimized bit syntax matching " + "can be traced without crashing the emulator."; +bit_syntax(Config) when is_list(Config) -> + bit_syntax_test(). + +return(doc) -> + ["Tests the different types of return trace"]; +return(Config) when is_list(Config) -> + return_test(). + +on_and_off(doc) -> + ["Tests turning trace parameters on and off, " + "both for trace and trace_pattern"]; +on_and_off(Config) when is_list(Config) -> + on_and_off_test(). + +stack_grow(doc) -> + ["Tests the stack growth during return traces"]; +stack_grow(Config) when is_list(Config) -> + stack_grow_test(). + +info(doc) -> + ["Tests the trace_info BIF"]; +info(Config) when is_list(Config) -> + info_test(). + +delete(doc) -> + ["Tests putting trace on deleted modules"]; +delete(Config) when is_list(Config) -> + delete_test(Config). + +exception(doc) -> + ["Tests exception_trace"]; +exception(Config) when is_list(Config) -> + exception_test([]). + +exception_apply(doc) -> + ["Tests exception_trace"]; +exception_apply(Config) when is_list(Config) -> + exception_test([apply]). + +exception_function(doc) -> + ["Tests exception_trace"]; +exception_function(Config) when is_list(Config) -> + exception_test([function]). + +exception_apply_function(doc) -> + ["Tests exception_trace"]; +exception_apply_function(Config) when is_list(Config) -> + exception_test([apply,function]). + +exception_nocatch(doc) -> + ["Tests exception_trace"]; +exception_nocatch(Config) when is_list(Config) -> + exception_test([nocatch]). + +exception_nocatch_apply(doc) -> + ["Tests exception_trace"]; +exception_nocatch_apply(Config) when is_list(Config) -> + exception_test([nocatch,apply]). + +exception_nocatch_function(doc) -> + ["Tests exception_trace"]; +exception_nocatch_function(Config) when is_list(Config) -> + exception_test([nocatch,function]). + +exception_nocatch_apply_function(doc) -> + ["Tests exception_trace"]; +exception_nocatch_apply_function(Config) when is_list(Config) -> + exception_test([nocatch,apply,function]). + +exception_meta(doc) -> + ["Tests meta exception_trace"]; +exception_meta(Config) when is_list(Config) -> + exception_test([meta]). + +exception_meta_apply(doc) -> + ["Tests meta exception_trace"]; +exception_meta_apply(Config) when is_list(Config) -> + exception_test([meta,apply]). + +exception_meta_function(doc) -> + ["Tests meta exception_trace"]; +exception_meta_function(Config) when is_list(Config) -> + exception_test([meta,function]). + +exception_meta_apply_function(doc) -> + ["Tests meta exception_trace"]; +exception_meta_apply_function(Config) when is_list(Config) -> + exception_test([meta,apply,function]). + +exception_meta_nocatch(doc) -> + ["Tests meta exception_trace"]; +exception_meta_nocatch(Config) when is_list(Config) -> + exception_test([meta,nocatch]). + +exception_meta_nocatch_apply(doc) -> + ["Tests meta exception_trace"]; +exception_meta_nocatch_apply(Config) when is_list(Config) -> + exception_test([meta,nocatch,apply]). + +exception_meta_nocatch_function(doc) -> + ["Tests meta exception_trace"]; +exception_meta_nocatch_function(Config) when is_list(Config) -> + exception_test([meta,nocatch,function]). + +exception_meta_nocatch_apply_function(doc) -> + ["Tests meta exception_trace"]; +exception_meta_nocatch_apply_function(Config) when is_list(Config) -> + exception_test([meta,nocatch,apply,function]). + +-endif. + + + +%%% Message patterns and expect functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-define(pCT(P,M,F,A), {trace, P,call,{M,F,A}}). +-define(pCTT(P,M,F,A), {trace_ts,P,call,{M,F,A},{_,_,_}}). +-define(pRF(P,M,F,A,V), {trace, P,return_from,{M,F,A},V}). +-define(pRFT(P,M,F,A,V),{trace_ts,P,return_from,{M,F,A},V,{_,_,_}}). +-define(pEF(P,M,F,A,V), {trace, P,exception_from,{M,F,A},V}). +-define(pEFT(P,M,F,A,V),{trace_ts,P,exception_from,{M,F,A},V,{_,_,_}}). +-define(pRT(P,M,F,A), {trace, P,return_to,{M,F,A}}). +-define(pRTT(P,M,F,A), {trace_ts,P,return_to,{M,F,A},{_,_,_}}). + +-define(CT(M,F,A), ?pCT(_,M,F,A) = receive_next()). +-define(CTT(M,F,A), ?pCTT(_,M,F,A) = receive_next()). +-define(RF(M,F,A,V), ?pRF(_,M,F,A,V) = receive_next()). +-define(RFT(M,F,A,V), ?pRFT(_,M,F,A,V) = receive_next()). +-define(EF(M,F,A,V), ?pEF(_,M,F,A,V) = receive_next()). +-define(EFT(M,F,A,V), ?pEFT(_,M,F,A,V) = receive_next()). +-define(RT(M,F,A), ?pRT(_,M,F,A) = receive_next()). +-define(RTT(M,F,A), ?pRTT(_,M,F,A) = receive_next()). +-define(NM, receive_no_next(100)). + +expect() -> + {Pid,_} = get(slave), + expect_receive(Pid). + +expect(Msg) -> + {Pid,_} = get(slave), + expect_pid(Pid, Msg). + + + +expect_pid(_Pid, []) -> + ok; +expect_pid(Pid, [Line|T]) when is_integer(Line) -> + put(test_server_loc, {?MODULE,Line}), + expect_pid(Pid, T); +expect_pid(Pid, [true|[_|_]=T]) -> + expect_pid(Pid, T); +expect_pid(Pid, [false|[_|T]]) -> + expect_pid(Pid, T); +expect_pid(Pid, [H|T]) -> + expect_pid(Pid, H), + expect_pid(Pid, T); +expect_pid(Pid, Msg) when is_tuple(Msg) -> + same(Msg, expect_receive(Pid)); +expect_pid(Pid, Fun) when is_function(Fun, 1) -> + case Fun(expect_receive(Pid)) of + next -> + expect_pid(Pid, Fun); + done -> + ok; + Other -> + expect_pid(Pid, Other) + end. + +expect_receive(Pid) when is_pid(Pid) -> + receive + Msg when is_tuple(Msg), + element(1, Msg) == trace, + element(2, Msg) =/= Pid; + %% + is_tuple(Msg), + element(1, Msg) == trace_ts, + element(2, Msg) =/= Pid -> + expect_receive(Pid); + Msg -> + expect_msg(Pid, Msg) + after 100 -> + {nm} + end. + +expect_msg(P, ?pCT(P,M,F,Args)) -> {ct,{M,F},Args}; +expect_msg(P, ?pCTT(P,M,F,Args)) -> {ctt,{M,F},Args}; +expect_msg(P, ?pRF(P,M,F,Arity,V)) -> {rf,{M,F,Arity},V}; +expect_msg(P, ?pRFT(P,M,F,Arity,V)) -> {rft,{M,F,Arity},V}; +expect_msg(P, ?pEF(P,M,F,Arity,V)) -> {ef,{M,F,Arity},V}; +expect_msg(P, ?pEFT(P,M,F,Arity,V)) -> {eft,{M,F,Arity},V}; +expect_msg(P, ?pRT(P,M,F,Arity)) -> {rt,{M,F,Arity}}; +expect_msg(P, ?pRTT(P,M,F,Arity)) -> {rtt,{M,F,Arity}}; +expect_msg(P, Msg) when is_tuple(Msg) -> + case tuple_to_list(Msg) of + [trace,P|T] -> + list_to_tuple([trace|T]); + [trace_ts,P|[_|_]=T] -> + list_to_tuple([trace_ts|reverse(tl(reverse(T)))]); + _ -> + Msg + end. + +same(A, B) -> + case [A|B] of + [X|X] -> + ok + end. + + + +%%% tests %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +basic_test() -> + ?line setup([call]), + ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported,[1]), + ?line ?CT(?MODULE,local,[1]), + ?line ?CT(?MODULE,local2,[1]), + ?line ?CT(?MODULE,local_tail,[1]), + ?line erlang:trace_pattern({?MODULE,'_','_'},[],[]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line [1,1,1,1] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?line ?NM, + ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line [1,1,1,1] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?line ?CT(?MODULE,_,_), %% The fun + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported,[1]), + ?line ?CT(?MODULE,local,[1]), + ?line ?CT(?MODULE,local2,[1]), + ?line ?CT(?MODULE,local_tail,[1]), + ?line erlang:trace_pattern({?MODULE,'_','_'},false,[local]), + ?line shutdown(), + ?line ?NM, + ok. + +%% OTP-7399. +bit_syntax_test() -> + ?line setup([call]), + ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + + ?line lambda_slave(fun() -> + 6 = bs_sum_a(<<1,2,3>>, 0), + 10 = bs_sum_b(0, <<1,2,3,4>>), + 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0) + end), + ?line ?CT(?MODULE,_,[]), %Ignore call to the fun. + + ?line ?CT(?MODULE,bs_sum_a,[<<1,2,3>>,0]), + ?line ?CT(?MODULE,bs_sum_a,[<<2,3>>,1]), + ?line ?CT(?MODULE,bs_sum_a,[<<3>>,3]), + ?line ?CT(?MODULE,bs_sum_a,[<<>>,6]), + + ?line ?CT(?MODULE,bs_sum_b,[0,<<1,2,3,4>>]), + ?line ?CT(?MODULE,bs_sum_b,[1,<<2,3,4>>]), + ?line ?CT(?MODULE,bs_sum_b,[3,<<3,4>>]), + ?line ?CT(?MODULE,bs_sum_b,[6,<<4>>]), + ?line ?CT(?MODULE,bs_sum_b,[10,<<>>]), + + ?line ?CT(?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>, 0]), + ?line ?CT(?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>, 3]), + ?line ?CT(?MODULE,bs_sum_c,[<<7:4,11:4>>, 8]), + ?line ?CT(?MODULE,bs_sum_c,[<<11:4>>, 15]), + ?line ?CT(?MODULE,bs_sum_c,[<<>>, 26]), + + ?line erlang:trace_pattern({?MODULE,'_','_'},false,[local]), + ?line shutdown(), + ?line ?NM, + + ok. + +bs_sum_a(<>, Acc) -> bs_sum_a(T, H+Acc); +bs_sum_a(<<>>, Acc) -> Acc. + +bs_sum_b(Acc, <>) -> bs_sum_b(H+Acc, T); +bs_sum_b(Acc, <<>>) -> Acc. + +bs_sum_c(<>, Acc) -> bs_sum_c(T, H+Acc); +bs_sum_c(<<>>, Acc) -> Acc. + +return_test() -> + ?line setup([call]), + ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + [local]), + ?line erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], + [local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported,[1]), + ?line ?CT(?MODULE,local,[1]), + ?line ?CT(?MODULE,local2,[1]), + ?line ?CT(?MODULE,local_tail,[1]), + ?line ?CT(erlang,hash,[1,1]), + ?line ?RF(erlang,hash,2,1), + ?line ?RF(?MODULE,local_tail,1,[1,1]), + ?line ?RF(?MODULE,local2,1,[1,1]), + ?line ?RF(?MODULE,local,1,[1,1,1]), + ?line ?RF(?MODULE,exported,1,[1,1,1,1]), + ?line ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), + ?line shutdown(), + ?line setup([call,return_to]), + ?line erlang:trace_pattern({?MODULE,'_','_'},[], + [local]), + ?line erlang:trace_pattern({erlang,hash,'_'},[], + [local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported,[1]), + ?line ?CT(?MODULE,local,[1]), + ?line ?CT(?MODULE,local2,[1]), + ?line ?CT(?MODULE,local_tail,[1]), + ?line ?CT(erlang,hash,[1,1]), + ?line ?RT(?MODULE,local_tail,1), + ?line ?RT(?MODULE,local,1), + ?line ?RT(?MODULE,exported,1), + ?line ?RT(?MODULE,slave,2), + ?line shutdown(), + ?line setup([call,return_to]), + ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + [local]), + ?line erlang:trace_pattern({erlang,hash,'_'},[{'_',[],[{return_trace}]}], + [local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported,[1]), + ?line ?CT(?MODULE,local,[1]), + ?line ?CT(?MODULE,local2,[1]), + ?line ?CT(?MODULE,local_tail,[1]), + ?line ?CT(erlang,hash,[1,1]), + ?line ?RF(erlang,hash,2,1), + ?line ?RT(?MODULE,local_tail,1), + ?line ?RF(?MODULE,local_tail,1,[1,1]), + ?line ?RF(?MODULE,local2,1,[1,1]), + ?line ?RT(?MODULE,local,1), + ?line ?RF(?MODULE,local,1,[1,1,1]), + ?line ?RT(?MODULE,exported,1), + ?line ?RF(?MODULE,exported,1,[1,1,1,1]), + ?line ?RF(?MODULE,exported_wrap,1,[1,1,1,1]), + ?line ?RT(?MODULE,slave,2), + ?line shutdown(), + ?line ?NM, + ok. + +on_and_off_test() -> + ?line Pid = setup([call]), + ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line LocalTail = fun() -> + local_tail(1) + end, + ?line [1,1] = lambda_slave(LocalTail), + ?line ?CT(?MODULE,local_tail,[1]), + ?line erlang:trace(Pid,true,[return_to]), + ?line [1,1] = lambda_slave(LocalTail), + ?line ?CT(?MODULE,local_tail,[1]), + ?line ?RT(?MODULE,_,_), + ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), + ?line [1,1] = lambda_slave(LocalTail), + ?line ?NM, + ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[global]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[local]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?RT(?MODULE,slave,2), + ?line 1 = erlang:trace_pattern({erlang,hash,2},[],[local]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(erlang,hash,[1,1]), + ?line ?RT(?MODULE,local_tail,1), + ?line ?RT(?MODULE,slave,2), + ?line erlang:trace(Pid,true,[timestamp]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CTT(?MODULE,exported_wrap,[1]), + ?line ?CTT(erlang,hash,[1,1]), + ?line ?RTT(?MODULE,local_tail,1), + ?line ?RTT(?MODULE,slave,2), + ?line erlang:trace(Pid,false,[return_to,timestamp]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(erlang,hash,[1,1]), + ?line erlang:trace(Pid,true,[return_to]), + ?line 1 = erlang:trace_pattern({erlang,hash,2},[],[]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(erlang,hash,[1,1]), + ?line ?RT(?MODULE,slave,2), + ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), + ?line [1,1,1,1] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CT(?MODULE,exported_wrap,[1]), + ?line ?CT(erlang,hash,[1,1]), + ?line shutdown(), + ?line erlang:trace_pattern({'_','_','_'},false,[local]), + ?line N = erlang:trace_pattern({erlang,'_','_'},true,[local]), + ?line case erlang:trace_pattern({erlang,'_','_'},false,[local]) of + N -> + ok; + Else -> + exit({number_mismatch, {expected, N}, {got, Else}}) + end, + ?line case erlang:trace_pattern({erlang,'_','_'},false,[local]) of + N -> + ok; + Else2 -> + exit({number_mismatch, {expected, N}, {got, Else2}}) + end, + ?line M = erlang:trace_pattern({erlang,'_','_'},true,[]), + ?line case erlang:trace_pattern({erlang,'_','_'},false,[]) of + M -> + ok; + Else3 -> + exit({number_mismatch, {expected, N}, {got, Else3}}) + end, + ?line case erlang:trace_pattern({erlang,'_','_'},false,[]) of + M -> + ok; + Else4 -> + exit({number_mismatch, {expected, N}, {got, Else4}}) + end, + ?line ?NM, + ok. + + +stack_grow_test() -> + ?line setup([call,return_to]), + ?line 1 = erlang:trace_pattern({?MODULE,loop,4}, + [{'_',[],[{return_trace}]}],[local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line Num = 1 bsl 15, + ?line Fun = + fun(_F,0) -> ok; + (F,N) -> + receive _A -> + receive _B -> + receive _C -> + F(F,N-1) + end + end + end + end, + ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), + ?line Fun(Fun,Num + 1), + ?line ?NM, + ok. + + +info_test() -> + ?line Flags1 = lists:sort([call,return_to]), + ?line Pid = setup(Flags1), + ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, + {'_',[],[]}], + ?line erlang:trace_pattern({?MODULE,exported_wrap,1},Prog,[local]), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,[local]), + ?line Self = self(), + ?line {flags,L} = erlang:trace_info(Pid,flags), + ?line case lists:sort(L) of + Flags1 -> + ok; + Wrong1 -> + exit({bad_result, {erlang,trace_info,[Pid,flags]}, + {expected, Flags1}, {got, Wrong1}}) + end, + ?line {tracer,Tracer} = erlang:trace_info(Pid,tracer), + ?line case Tracer of + Self -> + ok; + Wrong2 -> + exit({bad_result, {erlang,trace_info,[Pid,tracer]}, + {expected, Self}, {got, Wrong2}}) + end, + ?line {traced,local} = erlang:trace_info({?MODULE,exported_wrap,1},traced), + ?line {match_spec, MS} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + ?line case MS of + Prog -> + ok; + Wrong3 -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + match_spec]}, + {expected, Prog}, {got, Wrong3}}) + end, + ?line erlang:garbage_collect(self()), + ?line receive + after 1 -> + ok + end, + ?line io:format("~p~n",[MS]), + ?line {match_spec,MS2} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + ?line io:format("~p~n",[MS2]), + ?line erlang:trace_pattern({?MODULE,exported_wrap,1},[],[]), + ?line {traced,global} = + erlang:trace_info({?MODULE,exported_wrap,1},traced), + ?line {match_spec,[]} = + erlang:trace_info({?MODULE,exported_wrap,1},match_spec), + ?line {traced,undefined} = + erlang:trace_info({?MODULE,exported_wrap,2},traced), + ?line {match_spec,undefined} = + erlang:trace_info({?MODULE,exported_wrap,2},match_spec), + ?line {traced,false} = erlang:trace_info({?MODULE,exported,1},traced), + ?line {match_spec,false} = + erlang:trace_info({?MODULE,exported,1},match_spec), + ?line shutdown(), + ok. + +delete_test(Config) -> + ?line Priv = ?config(priv_dir, Config), + ?line Data = ?config(data_dir, Config), + ?line File = filename:join(Data, "trace_local_dummy"), + ?line {ok,trace_local_dummy} = c:c(File, [{outdir,Priv}]), + ?line code:purge(trace_local_dummy), + ?line code:delete(trace_local_dummy), + ?line 0 = erlang:trace_pattern({trace_local_dummy,'_','_'},true,[local]), + ?line ?NM, + ok. + + + +%%% exception_test %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +exception_test(Opts) -> + ?line {ProcFlags,PatFlags} = + case proplists:get_bool(meta, Opts) of + true -> {[timestamp],[meta]}; + false -> {[call,return_to,timestamp],[local]} + end, + ?line case proplists:get_bool(nocatch, Opts) of + false -> + ?line Exceptions = exceptions(), + ?line exception_test_setup(ProcFlags, PatFlags), + ?line lists:foreach( + fun ({Func,Args}) -> + ?line exception_test(Opts, Func, Args) + end, + Exceptions), + ?line shutdown(); + true -> + ?line Exceptions = exceptions(), + ?line lists:foreach( + fun ({Func,Args}) -> + ?line exception_test_setup( + [procs|ProcFlags], + PatFlags), + ?line exception_test(Opts, Func, Args), + ?line shutdown() + end, + Exceptions) + end, + ?line ok. + +exceptions() -> + ?line Ref = make_ref(), + ?line N = case os:type() of + vxworks -> + ?line 2000; % Limited memory on themachines, not actually + % VxWorks' fault /PaN + _ -> + ?line 200000 + end, + ?line LiL = seq(1, N-1, N), % Long Improper List + ?line LL = seq(1, N, []), % Long List + [{{erlang,exit}, [done]}, + {{erlang,error}, [1.0]}, + {{erlang,error}, [Ref,[]]}, + {{erlang,throw}, [4711]}, + {{erlang,'++'}, [[17],seventeen]}, + {{erlang,'++'}, [Ref,[125.125]]}, + {{?MODULE,match}, [ref,Ref]}, + {{?MODULE,match}, [Ref,Ref]}, + {{?MODULE,clause}, [ref,Ref]}, + {{?MODULE,clause}, [Ref,Ref]}, + {{?MODULE,id}, [4711.0]}, + {{?MODULE,undef}, [[Ref|Ref]]}, + {{?MODULE,lists_reverse}, [LiL,[]]}, + {{?MODULE,lists_reverse}, [LL,[]]}]. + +exception_test_setup(ProcFlags, PatFlags) -> + ?line Pid = setup(ProcFlags), + ?line io:format("=== exception_test_setup(~p, ~p): ~p~n", + [ProcFlags,PatFlags,Pid]), + ?line Mprog = [{'_',[],[{exception_trace}]}], + ?line erlang:trace_pattern({?MODULE,'_','_'}, Mprog, PatFlags), + ?line erlang:trace_pattern({?MODULE,slave,'_'},false,PatFlags), + ?line [1,1,1,1,1] = + [erlang:trace_pattern({erlang,F,A}, Mprog, PatFlags) + || {F,A} <- [{exit,1},{error,1},{error,2},{throw,1},{'++',2}]], + ?line 1 = erlang:trace_pattern({lists,reverse,2}, Mprog, PatFlags), + ?line ok. + +-record(exc_opts, {nocatch=false, meta=false}). + +exception_test(Opts, Func0, Args0) -> + ?line io:format("=== exception_test(~p, ~p, ~p)~n", + [Opts,Func0,abbr(Args0)]), + ?line Apply = proplists:get_bool(apply, Opts), + ?line Function = proplists:get_bool(function, Opts), + ?line Nocatch = proplists:get_bool(nocatch, Opts), + ?line Meta = proplists:get_bool(meta, Opts), + ?line ExcOpts = #exc_opts{nocatch=Nocatch,meta=Meta}, + + %% Func0 and Args0 are for the innermost call, now we will + %% wrap them in wrappers... + ?line {Func1,Args1} = + case Function of + true -> {fun exc/2,[Func0,Args0]}; + false -> {Func0,Args0} + end, + + ?line {Func,Args} = + case Apply of + true -> {{erlang,apply},[Func1,Args1]}; + false -> {Func1,Args1} + end, + + ?line R1 = exc_slave(ExcOpts, Func, Args), + ?line Stack2 = [{?MODULE,exc_top,3},{?MODULE,slave,2}], + ?line Stack3 = [{?MODULE,exc,2}|Stack2], + ?line Rs = + case x_exc_top(ExcOpts, Func, Args) of % Emulation + {crash,{Reason,Stack}}=R when is_list(Stack) -> + [R, + {crash,{Reason,Stack++Stack2}}, + {crash,{Reason,Stack++Stack3}}]; + R -> + [R] + end, + ?line exception_validate(R1, Rs), + ?line case R1 of + {crash,Crash} -> + ?line expect({trace_ts,exit,Crash}); + _ when not Meta -> + ?line expect({rtt,{?MODULE,slave,2}}); + _ -> + ok + end, + ?line expect({nm}). + +exception_validate(R1, [R2|Rs]) -> + case [R1|R2] of + [R|R] -> + ok; + [{crash,{badarg,[{lists,reverse,[L1a,L1b]}|T]}}| + {crash,{badarg,[{lists,reverse,[L2a,L2b]}|T]}}] -> + same({crash,{badarg,[{lists,reverse, + [lists:reverse(L1b, L1a),[]]}|T]}}, + {crash,{badarg,[{lists,reverse, + [lists:reverse(L2b, L2a),[]]}|T]}}); + _ when is_list(Rs), Rs =/= [] -> + exception_validate(R1, Rs) + end. + + + +%%% Tracee target functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% + +loop(D1,D2,D3,0) -> + io:format("~p~n",[[D1,D2,D3]]), + 0; +loop(D1,D2,D3,N) -> + max(N,loop(D1,D2,D3,N-1)). + +max(A, B) when A > B -> A; +max(_, B) -> B. + +exported_wrap(Val) -> + exported(Val). + +exported(Val) -> + [Val | local(Val)]. %% Non tail recursive local call + +local(Val) -> + [Val | local2(Val)]. %% Non tail recursive local call + +local2(Val) -> + local_tail(Val). %% Tail recursive call + +local_tail(Val) -> + [Val , erlang:hash(1,1)]. + + + +%%% exc_slave/3 tracee target functions %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% + +exc_top(ExcOpts, Func, Args) -> + case ExcOpts#exc_opts.nocatch of + false -> + try exc_jump(Func, Args) of + Value -> + {value,Value} + catch + Class:Reason -> + {Class,Reason} + end; + true -> + {value,exc_jump(Func, Args)} + end. + +%% x_* functions emulate the non-x_* ones. +%% x_* functions below x_exc_top +%% return {value,Value} or {Class,Reason}. +%% The only possible place for exception +%% is below exc/2. +x_exc_top(ExcOpts, Func, Args) -> + ?line Rtt = not ExcOpts#exc_opts.meta, + ?line expect({ctt,{?MODULE,exc_top},[ExcOpts,Func,Args]}), + ?line case x_exc_jump(ExcOpts, Func, Args) of + Result when not ExcOpts#exc_opts.nocatch -> + ?line expect([Rtt,{rtt,{?MODULE,exc_top,3}}, + ?LINE,{rft,{?MODULE,exc_top,3},Result}]), + ?line Result; + {value,_}=Result -> + + ?line expect([Rtt,{rtt,{?MODULE,exc_top,3}}, + ?LINE,{rft,{?MODULE,exc_top,3},Result}]), + ?line Result; + {exit,Reason}=CR -> + ?line expect({eft,{?MODULE,exc_top,3},CR}), + ?line {crash,Reason}; + {error,Reason}=CR -> + ?line expect({eft,{?MODULE,exc_top,3},CR}), + ?line {crash,{Reason,x_exc_stacktrace()}}; + CR -> + ?line expect({eft,{?MODULE,exc_top,3},CR}), + ?line {crash,CR} + end. + +exc_jump(Func, Args) -> + exc(Func, Args, jump). + +x_exc_jump(ExcOpts, Func, Args) -> + ?line expect({ctt,{?MODULE,exc_jump},[Func,Args]}), + ?line case x_exc(ExcOpts, Func, Args, jump) of + {value,Value}=Result -> + ?line expect({rft,{?MODULE,exc_jump,2},Value}), + ?line Result; + CR -> + ?line expect({eft,{?MODULE,exc_jump,2},CR}), + ?line CR + end. + +exc(Func, Args, jump) -> + exc(Func, Args, do); +exc(Func, Args, do) -> + exc(Func, Args). + +x_exc(ExcOpts, Func, Args, jump) -> + ?line expect({ctt,{?MODULE,exc},[Func,Args,jump]}), + ?line case x_exc(ExcOpts, Func, Args, do) of + {value,Value}=Result -> + ?line expect({rft,{?MODULE,exc,3},Value}), + ?line Result; + CR -> + ?line expect({eft,{?MODULE,exc,3},CR}), + ?line CR + end; +x_exc(ExcOpts, Func, Args, do) -> + ?line expect({ctt,{?MODULE,exc},[Func,Args,do]}), + ?line case x_exc(ExcOpts, Func, Args) of + {value,Value}=Result -> + ?line expect({rft,{?MODULE,exc,3},Value}), + ?line Result; + CR -> + ?line expect({eft,{?MODULE,exc,3},CR}), + ?line CR + end. + +exc({erlang,apply}, [{M,F},A]) -> + erlang:apply(M, F, id(A)); +exc({erlang,apply}, [F,A]) -> + erlang:apply(F, id(A)); +exc({erlang,error}, [E]) -> + erlang:error(id(E)); +exc({erlang,error}, [E,S]) -> + erlang:error(E, id(S)); +exc({erlang,exit}, [E]) -> + erlang:exit(id(E)); +exc({erlang,throw}, [E]) -> + erlang:throw(id(E)); +exc({erlang,'++'}, [A,B]) -> + erlang:'++'(A, id(B)); +exc({?MODULE,match}, [A,B]) -> + match(A, id(B)); +exc({?MODULE,clause}, [A,B]) -> + clause(A, id(B)); +exc({?MODULE,id}, [E]) -> + id(id(E)); +exc({?MODULE,undef}, [E]) -> + undef(id(E)); +exc({?MODULE,lists_reverse}, [A,B]) -> + lists_reverse(A, id(B)); +exc(Func, [A,B]) when is_function(Func, 2) -> + Func(A, id(B)). + +x_exc(ExcOpts, {erlang,apply}=Func0, [{_,_}=Func,Args]=Args0) -> + ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), + ?line x_exc_body(ExcOpts, Func, Args, true); +x_exc(ExcOpts, {erlang,apply}=Func0, [Func,Args]=Args0) + when is_function(Func, 2)-> + ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), + ?line x_exc_func(ExcOpts, Func, Args, Args); +x_exc(ExcOpts, {_,_}=Func, Args) -> + ?line expect({ctt,{?MODULE,exc},[Func,Args]}), + ?line x_exc_body(ExcOpts, Func, Args, false); +x_exc(ExcOpts, Func0, [_,Args]=Args0) + when is_function(Func0, 2) -> + ?line expect({ctt,{?MODULE,exc},[Func0,Args0]}), + ?line x_exc_func(ExcOpts, Func0, Args0, Args). + +x_exc_func(ExcOpts, Func, [Func1,Args1]=Args, Id) -> + %% Assumes the called fun =:= fun exc/2, + %% will utterly fail otherwise. + ?line Rtt = not ExcOpts#exc_opts.meta, + ?line {module,M} = erlang:fun_info(Func, module), + ?line {name,F} = erlang:fun_info(Func, name), + ?line expect([{ctt,{?MODULE,id},[Id]}, + ?LINE,{rft,{?MODULE,id,1},Id}, + ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, + ?LINE,{ctt,{M,F},Args}]), + ?line case x_exc(ExcOpts, Func1, Args1) of + {value,Value}=Result -> + ?line expect([{rft,{M,F,2},Value}, + ?LINE,{rft,{?MODULE,exc,2},Value}]), + ?line Result; + CR -> + ?line expect([{eft,{M,F,2},CR}, + ?LINE,{eft,{?MODULE,exc,2},CR}]), + ?line CR + end. + +x_exc_body(ExcOpts, {M,F}=Func, Args, Apply) -> + ?line Nocatch = ExcOpts#exc_opts.nocatch, + ?line Rtt = not ExcOpts#exc_opts.meta, + ?line Id = case Apply of + true -> Args; + false -> lists:last(Args) + end, + ?line expect([{ctt,{?MODULE,id},[Id]}, + ?LINE,{rft,{?MODULE,id,1},Id}, + ?LINE,Rtt,{rtt,{?MODULE,exc,2}}, + ?LINE,{ctt,{M,F},Args}]), + ?line Arity = length(Args), + ?line try exc(Func, Args) of + Value -> + ?line x_exc_value(Rtt, M, F, Args, Arity, Value), + ?line case expect() of + {rtt,{M,F,Arity}} when Rtt, Apply -> + %% We may get the above when + %% applying a BIF. + ?line expect({rft,{?MODULE,exc,2},Value}); + {rtt,{?MODULE,exc,2}} when Rtt, not Apply -> + %% We may get the above when + %% calling a BIF. + ?line expect({rft,{?MODULE,exc,2},Value}); + {rft,{?MODULE,exc,2},Value} -> + ?line ok + end, + ?line {value,Value} + catch + Thrown when Nocatch -> + ?line CR = {error,{nocatch,Thrown}}, + ?line x_exc_exception(Rtt, M, F, Args, Arity, CR), + ?line expect({eft,{?MODULE,exc,2},CR}), + ?line CR; + Class:Reason -> + ?line CR = {Class,Reason}, + ?line x_exc_exception(Rtt, M, F, Args, Arity, CR), + ?line expect({eft,{?MODULE,exc,2},CR}), + ?line CR + end. + +x_exc_value(Rtt, ?MODULE, lists_reverse, [La,Lb], 2, R) -> + ?line L = lists:reverse(Lb, La), + ?line expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> + ?line same(L, lists:reverse(L2, L1)), + ?line next; + (Msg) -> + ?line same({rft,{lists,reverse,2},R}, Msg), + ?line same(R, lists:reverse(L, [])), + ?line done + end, + ?LINE,Rtt,{rtt,{?MODULE,lists_reverse,2}}, + ?LINE,{rft,{?MODULE,lists_reverse,2},R}]); +x_exc_value(_Rtt, M, F, _, Arity, Value) -> + ?line expect({rft,{M,F,Arity},Value}). + +x_exc_exception(_Rtt, ?MODULE, lists_reverse, [La,Lb], 2, CR) -> + ?line L = lists:reverse(Lb, La), + ?line expect([fun ({ctt,{lists,reverse},[L1,L2]}) -> + ?line same(L, lists:reverse(L2, L1)), + ?line next; + (Msg) -> + ?line same({eft,{lists,reverse,2},CR}, Msg), + ?line done + end, + ?LINE,{eft,{?MODULE,lists_reverse,2},CR}]); +x_exc_exception(Rtt, ?MODULE, undef, [_], 1, {Class,Reason}=CR) -> + ?line expect([{ctt,{erlang,Class},[Reason]}, + ?LINE,{eft,{erlang,Class,1},CR}, + ?LINE,Rtt,{rtt,{error_handler,crash,1}}, + ?LINE,{eft,{?MODULE,undef,1},CR}]); +x_exc_exception(_Rtt, M, F, _, Arity, CR) -> + ?line expect({eft,{M,F,Arity},CR}). + +x_exc_stacktrace() -> + x_exc_stacktrace(erlang:get_stacktrace()). +%% Truncate stacktrace to below exc/2 +x_exc_stacktrace([{?MODULE,x_exc,4}|_]) -> []; +x_exc_stacktrace([{?MODULE,x_exc_func,4}|_]) -> []; +x_exc_stacktrace([{?MODULE,x_exc_body,4}|_]) -> []; +x_exc_stacktrace([{?MODULE,exc,2}|_]) -> []; +x_exc_stacktrace([H|T]) -> + [H|x_exc_stacktrace(T)]. + + + +match(A, B) -> + A = B. + +clause(A, A) -> + A. + +id(Id) -> + Id. + +undef(X) -> + ?MODULE:undef(X, X). % undef + +lists_reverse(A, B) -> + lists:reverse(A, B). + + + +%%% Tracee (slave) handling %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% + +slave(Dest, Sync) -> + Dest ! Sync, + receive + {From,Tag,{apply,M,F,A}} when is_pid(From) -> + ?line ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + ?line Res = apply(M,F,A), + ?line ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + From ! {Tag,Res}, + slave(From, Tag); + {From,Tag,{lambda,Fun}} when is_pid(From) -> + Res = Fun(), + From ! {Tag,Res}, + slave(From, Tag); + {From,Tag,{exc_top,Catch,Func,Args}} when is_pid(From) -> + ?line ?dbgformat("Exc: ~p ~p~p ~n",[Catch,Func,Args]), + ?line Res = exc_top(Catch, Func, Args), + ?line ?dbgformat("done Exc: ~p ~p~p ~n",[Catch,Func,Args]), + From ! {Tag,Res}, + slave(From,Tag); + die -> + exit(normal) + end. + +setup(ProcFlags) -> + trace_off(), + flush(100), + Self = self(), + Sync = make_ref(), + Pid = spawn(fun () -> slave(Self, Sync) end), + Mref = erlang:monitor(process, Pid), + receive + Sync -> + put(slave, {Pid,Mref}), + case ProcFlags of + [] -> ok; + _ -> + erlang:trace(Pid, true, ProcFlags) + end, + Pid + end. + +shutdown() -> + trace_off(), + {Pid,Mref} = get(slave), + try erlang:is_process_alive(Pid) of + true -> + Pid ! die, + receive + {'DOWN',Mref,process,Pid,Reason} -> + Reason + end; + _ -> + not_alive + catch _:_ -> + undefined + end. + +trace_off() -> + erlang:trace_pattern({'_','_','_'},false,[]), + erlang:trace_pattern({'_','_','_'},false,[local]), + erlang:trace_pattern({'_','_','_'},false,[meta]), + erlang:trace(all, false, [all]). + + +apply_slave_async(M,F,A) -> + {Pid,Mref} = get(slave), + spawn(?MODULE,apply_slave_async,[M,F,A,Pid,Mref]), + Pid. + +apply_slave_async(M,F,A,Pid,Mref) -> + Tag = make_ref(), + Pid ! {self(),Tag,{apply,M,F,A}}, + result(Tag, Mref). + +apply_slave(M,F,A) -> + request({apply,M,F,A}). + +lambda_slave(Fun) -> + request({lambda,Fun}). + +exc_slave(Opts, Func, Args) -> + try request({exc_top,Opts,Func,Args}) + catch + Reason -> + {crash,Reason} + end. + +request(Request) -> + Tag = make_ref(), + {Pid,Mref} = get(slave), + Pid ! {self(),Tag,Request}, + result(Tag, Mref). + +result(Tag, Mref) -> + receive + {Tag,Result} -> + receive + Tag -> + Result + end; + {'DOWN',Mref,process,_Pid,Reason} -> + throw(Reason) + end. + + + +%%% Some receive helpers %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% + +receive_next() -> + receive_next(?DEFAULT_RECEIVE_TIMEOUT). + +receive_next(TO) -> + receive + M -> + M + after TO -> + ?t:fail(timeout) + end. + +receive_no_next(TO) -> + receive M -> + ?t:fail({unexpected_message,[M|flush(TO)]}) + after TO -> + ok + end. + +flush(T) -> + receive + M -> + [M|flush(T)] + after T -> + [] + end. + + + +%%% Helpers %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% + +%% Do not build garbage +%% +seq(M, N, R) when M =< N -> + seq(M, N-1, [N|R]); +seq(_, _, R) -> R. + +%% Do not call traced lists:reverse +reverse(L) -> + reverse(L, []). +%% +reverse([], R) -> R; +reverse([H|T], R) -> + reverse(T, [H|R]). + +%% Abbreviate large complex terms to avoid croaking printout +%% +abbr(Term) -> + abbr(Term, 20). +%% +abbr(Tuple, N) when is_tuple(Tuple) -> + list_to_tuple(abbr_tuple(Tuple, N, 1)); +abbr(List, N) when is_list(List) -> + abbr_list(List, N, []); +abbr(Term, _) -> Term. +%% +abbr_tuple(Tuple, N, J) when J =< size(Tuple) -> + if J > N; N =< 0 -> + ['...']; + true -> + [abbr(element(J, Tuple), N-1)|abbr_tuple(Tuple, J+1, N)] + end; +abbr_tuple(_, _, _) -> + []. +%% +abbr_list(_, 0, R) -> + case io_lib:printable_list(R) of + true -> + reverse(R, "..."); + false -> + reverse(R, '...') + end; +abbr_list([H|T], N, R) -> + M = N-1, + abbr_list(T, M, [abbr(H, M)|R]); +abbr_list(T, _, R) -> + reverse(R, T). diff --git a/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl b/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl new file mode 100644 index 0000000000..be9bea209a --- /dev/null +++ b/erts/emulator/test/trace_local_SUITE_data/trace_local_dummy.erl @@ -0,0 +1,28 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(trace_local_dummy). + +-export([dummy/0]). + +dummy() -> + dummy2(). + +dummy2() -> + hoppla. diff --git a/erts/emulator/test/trace_meta_SUITE.erl b/erts/emulator/test/trace_meta_SUITE.erl new file mode 100644 index 0000000000..d84cb3cdf2 --- /dev/null +++ b/erts/emulator/test/trace_meta_SUITE.erl @@ -0,0 +1,758 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% +%%% Define to run outside of test server +%%% +%%% -define(STANDALONE,1). +%%% +%%% +%%% Define for debug output +%%% +%%% -define(debug,1). + +-module(trace_meta_SUITE). + +%% Exported end user tests +-export([basic_test/0, return_test/0, on_and_off_test/0, stack_grow_test/0, + info_test/0, tracer_test/0, combo_test/0, nosilent_test/0]). + +%% Internal exports +-export([exported/1, exported_wrap/1, loop/4, id/1, receiver/1]). + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Test server related stuff +%% + +-ifdef(STANDALONE). +-define(config(A,B),config(A,B)). +-export([config/2]). +-else. +-include("test_server.hrl"). +-endif. + +-ifdef(debug). +-ifdef(STANDALONE). +-define(line, erlang:display({?MODULE,?LINE}), ). +-endif. +-define(dbgformat(A,B),io:format(A,B)). +-else. +-ifdef(STANDALONE). +-define(line, noop, ). +-endif. +-define(dbgformat(A,B),noop). +-endif. + +-ifdef(STANDALONE). +config(priv_dir,_) -> + ".". +-else. +%% When run in test server. +-export([all/1, init_per_testcase/2, fin_per_testcase/2, not_run/1]). +-export([basic/1, return/1, on_and_off/1, stack_grow/1, + info/1, tracer/1, combo/1, nosilent/1]). + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(test_server:minutes(5)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + shutdown(), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. +all(doc) -> + ["Test meta tracing of local function calls and return trace."]; +all(suite) -> + case test_server:is_native(?MODULE) of + true -> [not_run]; + false -> [basic, return, on_and_off, stack_grow, + info, tracer, combo, nosilent] + end. + +not_run(Config) when is_list(Config) -> + {skipped,"Native code"}. + +basic(suite) -> + []; +basic(doc) -> + ["Tests basic meta trace"]; +basic(Config) when is_list(Config) -> + basic_test(). + +return(suite) -> + []; +return(doc) -> + ["Tests return trace"]; +return(Config) when is_list(Config) -> + return_test(). + +on_and_off(suite) -> + []; +on_and_off(doc) -> + ["Tests turning trace parameters on and off"]; +on_and_off(Config) when is_list(Config) -> + on_and_off_test(). + +stack_grow(doc) -> + ["Tests the stack growth during return traces"]; +stack_grow(Config) when is_list(Config) -> + stack_grow_test(). + +info(doc) -> + ["Tests the trace_info BIF"]; +info(Config) when is_list(Config) -> + info_test(). + +tracer(suite) -> + []; +tracer(doc) -> + ["Tests stopping and changing tracer process"]; +tracer(Config) when is_list(Config) -> + tracer_test(). + +combo(suite) -> + []; +combo(doc) -> + ["Tests combining local call trace with meta trace"]; +combo(Config) when is_list(Config) -> + combo_test(). + +nosilent(suite) -> + []; +nosilent(doc) -> + ["Tests that meta trace is not silenced by the silent process flag"]; +nosilent(Config) when is_list(Config) -> + nosilent_test(). + +-endif. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Result examination macros + +-define(CT(P,MFA),{trace,P,call,MFA}). +-define(CTT(P, MFA),{trace_ts,P,call,MFA,{_,_,_}}). +-define(RF(P,MFA,V),{trace,P,return_from,MFA,V}). +-define(RFT(P,MFA,V),{trace_ts,P,return_from,MFA,V,{_,_,_}}). +-define(RT(P,MFA),{trace,P,return_to,MFA}). +-define(RTT(P,MFA),{trace_ts,P,return_to,MFA,{_,_,_}}). +-define(NM, receive_no_next(100)). + +%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% The Tests +%%% + +basic_test() -> + ?line Pid = setup(), + ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?NM, + ?line [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?line ?NM, + ?line erlang:trace_pattern({?MODULE,'_','_'},[],[meta]), + ?line [1,1,1,0] = lambda_slave(fun() -> + exported_wrap(1) + end), + ?line ?CTT(Pid,{?MODULE,_,_}) = receive_next(), %% The fun + ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + ?line erlang:trace_pattern({?MODULE,'_','_'},false,[meta]), + ?line shutdown(), + ?line ?NM, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +return_test() -> + ?line Pid = setup(), + ?line erlang:trace_pattern({?MODULE,'_','_'},[{'_',[],[{return_trace}]}], + [meta]), + ?line erlang:trace_pattern({erlang,phash2,'_'},[{'_',[],[{return_trace}]}], + [meta]), + ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,exported,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local2,[1]}) = receive_next(), + ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + ?line ?RFT(Pid,{erlang,phash2,2},0) = receive_next(), + ?line ?RFT(Pid,{?MODULE,local_tail,1},[1,0]) = receive_next(), + ?line ?RFT(Pid,{?MODULE,local2,1},[1,0]) = receive_next(), + ?line ?RFT(Pid,{?MODULE,local,1},[1,1,0]) = receive_next(), + ?line ?RFT(Pid,{?MODULE,exported,1},[1,1,1,0]) = receive_next(), + ?line ?RFT(Pid,{?MODULE,exported_wrap,1},[1,1,1,0]) = receive_next(), + ?line shutdown(), + ?line ?NM, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +on_and_off_test() -> + ?line Pid = setup(), + ?line 1 = erlang:trace_pattern({?MODULE,local_tail,1},[],[meta]), + ?line LocalTail = fun() -> + local_tail(1) + end, + ?line [1,0] = lambda_slave(LocalTail), + ?line ?CTT(Pid,{?MODULE,local_tail,[1]}) = receive_next(), + ?line 0 = erlang:trace_pattern({?MODULE,local_tail,1},[],[global]), + ?line [1,0] = lambda_slave(LocalTail), + ?line ?NM, + ?line 1 = erlang:trace_pattern({?MODULE,exported_wrap,1},[],[meta]), + ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?line 1 = erlang:trace_pattern({erlang,phash2,2},[],[meta]), + ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?line ?CTT(Pid,{?MODULE,exported_wrap,[1]}) = receive_next(), + ?line ?CTT(Pid,{erlang,phash2,[1,1]}) = receive_next(), + ?line shutdown(), + ?line erlang:trace_pattern({'_','_','_'},false,[meta]), + ?line N = erlang:trace_pattern({erlang,'_','_'},true,[meta]), + ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> + ok; + Else -> + exit({number_mismatch, {expected, N}, {got, Else}}) + end, + ?line case erlang:trace_pattern({erlang,'_','_'},false,[meta]) of + N -> + ok; + Else2 -> + exit({number_mismatch, {expected, N}, {got, Else2}}) + end, + ?line ?NM, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +stack_grow_test() -> + ?line Pid = setup(), + ?line 1 = erlang:trace_pattern({?MODULE,loop,4}, + [{'_',[],[{return_trace}]}],[meta]), + ?line Num = 1 bsl 15, + ?line Surface = + fun (This, ?RFT(P,{?MODULE,loop,4},N), N) when P == Pid-> + if N == Num -> + ?NM, + ok; + true -> + This(This, receive_next(), N+1) + end + end, + ?line Dive = + fun (This, ?CTT(P,{?MODULE,loop,[{hej,hopp},[a,b,c],4.5,N]}), N) + when P == Pid-> + if N == 0 -> + Surface(Surface, receive_next(), 0); + true -> + This(This, receive_next(), N-1) + end + end, + ?line apply_slave(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% ?line apply_slave_async(?MODULE,loop,[{hej,hopp},[a,b,c],4.5,Num]), +% ?line List = collect(test_server:seconds(5)), + ?line ok = Dive(Dive, receive_next(), Num), + ?line ?NM, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +info_test() -> + ?line setup(), + ?line Prog = [{['$1'],[{is_integer,'$1'}],[{message, false}]}, + {'_',[],[]}], + ?line Self = self(), + ?line GoOn = make_ref(), + + ?line Pid = + spawn_link( + fun () -> + erlang:trace_pattern({?MODULE,exported_wrap,1}, + Prog, [{meta, Self}]), + Self ! {self(), GoOn} + end), + ?line receive {Pid, GoOn} -> ok end, + ?line {traced,false} = erlang:trace_info({?MODULE,exported_wrap,1}, traced), + ?line {match_spec, false} = + erlang:trace_info({?MODULE,exported_wrap,1}, match_spec), + ?line {meta, Self} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + ?line {meta_match_spec, MMS} = + erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), + ?line case MMS of + Prog -> + ok; + Wrong -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong}}) + end, + ?line erlang:garbage_collect(self()), + ?line receive + after 1 -> + ok + end, + ?line io:format("~p~n",[MMS]), + ?line {meta_match_spec,MMS2} = + erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), + ?line io:format("~p~n",[MMS2]), + ?line case MMS2 of + Prog -> + ok; + Wrong2 -> + exit({bad_result, {erlang,trace_info, + [{?MODULE,exported_wrap,1}, + meta_match_spec]}, + {expected, Prog}, {got, Wrong2}}) + end, + ?line {all, [_|_]=L} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + ?line {value, {meta, Self}} = + lists:keysearch(meta, 1, L), + ?line {value, {meta_match_spec, MMS}} = + lists:keysearch(meta_match_spec, 1, L), + + ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, true, [meta]), + ?line {meta_match_spec, []} = + erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), + + ?line erlang:trace_pattern({?MODULE,exported_wrap,1}, false, [meta]), + ?line {meta, false} = erlang:trace_info({?MODULE,exported_wrap,1}, meta), + ?line {meta_match_spec, false} = + erlang:trace_info({?MODULE,exported_wrap,1}, meta_match_spec), + ?line {all, false} = erlang:trace_info({?MODULE,exported_wrap,1}, all), + + ?line shutdown(), + ?line ?NM, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +tracer_test() -> + ?line Slave = setup(), + ?line Self = self(), + + ?line MatchSpec = [{'_',[],[{return_trace}]}], + ?line Tracer1 = spawn_link(fun () -> relay_n(3, Self) end), + ?line Setter = + spawn_link( + fun () -> + erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer1}]), + erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer1}]), + Self ! {self(), done} + end), + ?line receive {Setter, done} -> ok end, + ?line Ref = make_ref(), + ?line apply_slave_async(?MODULE, receiver, [Ref]), + ?line {Tracer1,?CTT(Slave,{?MODULE,receiver,[Ref]})} = receive_next(100), + ?line {Tracer1,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(100), + ?line {Tracer1,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(100), + %% Initiate a return_trace that will fail since the tracer just stopped + ?line Slave ! Ref, + ?line receive_no_next(100), + %% The breakpoint has not been hit since the tracer stopped + ?line {meta,Tracer1} = + erlang:trace_info({?MODULE,receiver,1}, meta), + ?line {meta_match_spec, MatchSpec} = + erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), + ?line {meta,Tracer1} = + erlang:trace_info({erlang,phash2,2}, meta), + ?line {meta_match_spec, MatchSpec} = + erlang:trace_info({erlang,phash2,2}, meta_match_spec), + %% Initiate trace messages that will fail + ?line Ref2 = make_ref(), + ?line apply_slave_async(?MODULE, receiver, [Ref2]), + ?line Slave ! Ref2, + ?line receive_no_next(100), + ?line {meta,[]} = + erlang:trace_info({?MODULE,receiver,1}, meta), + ?line {meta_match_spec, MatchSpec} = + erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), + ?line {meta,[]} = + erlang:trace_info({erlang,phash2,2}, meta), + ?line {meta_match_spec, MatchSpec} = + erlang:trace_info({erlang,phash2,2}, meta_match_spec), + %% Change tracer + ?line Tracer2 = spawn_link(fun () -> relay_n(4, Self) end), + ?line erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer2}]), + ?line erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer2}]), + ?line Ref3 = make_ref(), + ?line apply_slave_async(?MODULE, receiver, [Ref3]), + ?line {Tracer2,?CTT(Slave,{?MODULE,receiver,[Ref3]})} = receive_next(), + ?line {Tracer2,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + ?line {Tracer2,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + %% Change tracer between call trace and return trace + ?line Tracer3 = spawn_link(fun () -> relay_n(4, Self) end), + ?line erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [{meta,Tracer3}]), + ?line erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [{meta,Tracer3}]), + ?line Slave ! Ref3, + %% The return trace should still come from Tracer2 + ?line {Tracer2,?RFT(Slave,{?MODULE,receiver,1},Ref3)} = receive_next(), + ?line Ref4 = make_ref(), + %% Now should Tracer3 be used + ?line apply_slave_async(?MODULE, receiver, [Ref4]), + ?line Slave ! Ref4, + ?line {Tracer3,?CTT(Slave,{?MODULE,receiver,[Ref4]})} = receive_next(), + ?line {Tracer3,?CTT(Slave,{erlang,phash2,[1,1]})} = receive_next(), + ?line {Tracer3,?RFT(Slave,{erlang,phash2,2},0)} = receive_next(), + ?line {Tracer3,?RFT(Slave,{?MODULE,receiver,1},Ref4)} = receive_next(), + %% The breakpoint has not been hit since the tracer stopped + ?line {meta,Tracer3} = + erlang:trace_info({?MODULE,receiver,1}, meta), + ?line {meta_match_spec, MatchSpec} = + erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), + ?line {meta,Tracer3} = + erlang:trace_info({erlang,phash2,2}, meta), + ?line {meta_match_spec, MatchSpec} = + erlang:trace_info({erlang,phash2,2}, meta_match_spec), + + ?line shutdown(), + ?line ?NM, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +combo_test() -> + ?line Slave = setup(), + ?line Self = self(), + + ?line MatchSpec = [{'_',[],[{return_trace}]}], + ?line Flags = lists:sort([call, return_to]), + ?line LocalTracer = spawn_link(fun () -> relay_n(6, Self) end), + ?line MetaTracer = spawn_link(fun () -> relay_n(4, Self) end), + ?line 1 = erlang:trace_pattern({?MODULE,receiver,1}, + MatchSpec, + [local,{meta,MetaTracer}]), + ?line 1 = erlang:trace_pattern({erlang,phash2,2}, + MatchSpec, + [local,{meta,MetaTracer}]), + ?line 1 = erlang:trace(Slave, true, + [{tracer,LocalTracer} | Flags]), + %% + ?line {all, TraceInfo1} = + erlang:trace_info({?MODULE,receiver,1}, all), + ?line {meta,MetaTracer} = + erlang:trace_info({?MODULE,receiver,1}, meta), + ?line {value,{meta,MetaTracer}} = + lists:keysearch(meta, 1, TraceInfo1), + ?line {meta_match_spec,MatchSpec} = + erlang:trace_info({?MODULE,receiver,1}, meta_match_spec), + ?line {value,{meta_match_spec,MatchSpec}} = + lists:keysearch(meta_match_spec, 1, TraceInfo1), + ?line {traced,local} = + erlang:trace_info({?MODULE,receiver,1}, traced), + ?line {value,{traced,local}} = + lists:keysearch(traced, 1, TraceInfo1), + ?line {match_spec,MatchSpec} = + erlang:trace_info({?MODULE,receiver,1}, match_spec), + ?line {value,{match_spec,MatchSpec}} = + lists:keysearch(match_spec, 1, TraceInfo1), + %% + ?line {all, TraceInfo2} = + erlang:trace_info({erlang,phash2,2}, all), + ?line {meta,MetaTracer} = + erlang:trace_info({erlang,phash2,2}, meta), + ?line {value,{meta,MetaTracer}} = + lists:keysearch(meta, 1, TraceInfo2), + ?line {meta_match_spec,MatchSpec} = + erlang:trace_info({erlang,phash2,2}, meta_match_spec), + ?line {value,{meta_match_spec,MatchSpec}} = + lists:keysearch(meta_match_spec, 1, TraceInfo2), + ?line {traced,local} = + erlang:trace_info({erlang,phash2,2}, traced), + ?line {value,{traced,local}} = + lists:keysearch(traced, 1, TraceInfo2), + ?line {match_spec,MatchSpec} = + erlang:trace_info({erlang,phash2,2}, match_spec), + ?line {value,{match_spec,MatchSpec}} = + lists:keysearch(match_spec, 1, TraceInfo2), + %% + ?line {flags,Flags1} = erlang:trace_info(Slave, flags), + ?line Flags = lists:sort(Flags1), + ?line {tracer,LocalTracer} = erlang:trace_info(Slave, tracer), + %% + ?line Ref = make_ref(), + ?line apply_slave_async(?MODULE, receiver, [Ref]), + ?line Slave ! Ref, + ?line ?CTT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(MetaTracer), + ?line ?CTT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(MetaTracer), + ?line ?RFT(Slave,{erlang,phash2,2},0) = receive_next_bytag(MetaTracer), + ?line ?RFT(Slave,{?MODULE,receiver,1},Ref) = receive_next_bytag(MetaTracer), + ?line ?CT(Slave,{?MODULE,receiver,[Ref]}) = receive_next_bytag(LocalTracer), + ?line ?CT(Slave,{erlang,phash2,[1,1]}) = receive_next_bytag(LocalTracer), + ?line case {receive_next_bytag(LocalTracer), + receive_next_bytag(LocalTracer)} of + {?RF(Slave,{erlang,phash2,2},0), + ?RT(Slave,{?MODULE,receiver,1})} -> + ?line ok; + {?RT(Slave,{?MODULE,receiver,1}), + ?RF(Slave,{erlang,phash2,2},0)} -> + ?line ok; + Error1 -> ?t:fail({unexpected_message, Error1}) + end, + ?line case {receive_next_bytag(LocalTracer), + receive_next_bytag(LocalTracer)} of + {?RF(Slave,{?MODULE,receiver,1},Ref), + ?RT(Slave,{?MODULE,slave,1})} -> + ?line ok; + {?RT(Slave,{?MODULE,slave,1}), + ?RF(Slave,{?MODULE,receiver,1},Ref)} -> + ?line ok; + Error2 -> ?t:fail({unexpected_message, Error2}) + end, + + ?line shutdown(), + ?line ?NM, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Use case for Inviso meta tracing: +%% Setup silent local call tracing, and start it using meta trace. + +nosilent_test() -> + ?line Pid = setup(), + ?line Trigger = {?MODULE,id,1}, + ?line TriggerMS = [{[start],[],[{silent,false}]}, + {[stop],[],[{silent,true},{return_trace}]}], + ?line 1 = erlang:trace(Pid, true, [call,silent,return_to]), + ?line erlang:trace_pattern({?MODULE,'_','_'},[],[local]), + ?line 1 = erlang:trace_pattern({?MODULE,local2,1}, + [{'_',[],[{return_trace}]}], + [local]), + ?line 1 = erlang:trace_pattern({?MODULE,slave,1},false,[local]), + ?line 1 = erlang:trace_pattern(Trigger,false,[local]), + ?line 1 = erlang:trace_pattern(Trigger,TriggerMS,[meta]), + ?line [1,1,1,0] = apply_slave(?MODULE,exported_wrap,[1]), + ?line receive_no_next(17), + ?line start = apply_slave(?MODULE, id, [start]), + ?line ?CTT(Pid,{?MODULE,id,[start]}) = receive_next(), + ?line [2,2,2,0] = apply_slave(?MODULE,exported_wrap,[2]), + ?line ?CT(Pid,{?MODULE,exported_wrap,[2]}) = receive_next(), + ?line ?CT(Pid,{?MODULE,exported,[2]}) = receive_next(), + ?line ?CT(Pid,{?MODULE,local,[2]}) = receive_next(), + ?line ?CT(Pid,{?MODULE,local2,[2]}) = receive_next(), + ?line ?CT(Pid,{?MODULE,local_tail,[2]}) = receive_next(), + ?line ?RF(Pid,{?MODULE,local2,1}, [2,0]) = receive_next(), + ?line ?RT(Pid,{?MODULE,local,1}) = receive_next(), + ?line ?RT(Pid,{?MODULE,exported,1}) = receive_next(), + ?line ?RT(Pid,{?MODULE,slave,1}) = receive_next(), + ?line stop = apply_slave(?MODULE, id, [stop]), + ?line ?CTT(Pid,{?MODULE,id,[stop]}) = receive_next(), + ?line ?RFT(Pid,{?MODULE,id,1}, stop) = receive_next(), + ?line [3,3,3,0] = apply_slave(?MODULE,exported_wrap,[3]), + ?line receive_no_next(17), + ?line shutdown(), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Trace target functions + +loop(D1,D2,D3,0) -> + io:format("~p~n",[[D1,D2,D3]]), + 0; +loop(D1,D2,D3,N) -> + max(N,loop(D1,D2,D3,N-1)). + +max(A,B) when A > B -> + A; +max(_A,B) -> + B. + +id(X) -> + X. + + +exported_wrap(Val) -> + exported(Val). + +exported(Val) -> + [Val | local(Val)]. %% Non tail recursive local call + +local(Val) -> + [Val | local2(Val)]. %% Non tail recursive local call + +local2(Val) -> + local_tail(Val). %% Tail recursive call + +local_tail(Val) -> + [Val , erlang:phash2(1,1)]. + + + +receiver(Msg) -> + erlang:phash2(1,1), + receive Msg -> Msg end. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Trace target process and utilities + +slave(Sync) -> + Sync ! sync, + receive + {From,apply, M, F, A} -> + ?line ?dbgformat("Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + ?line Res = apply(M,F,A), + ?line ?dbgformat("done Apply: ~p:~p/~p (~p)~n",[M,F,length(A),A]), + From ! {apply, Res}, + erlang:trace_pattern({?MODULE,slave,1},false,[meta]), + slave(From); + {From, lambda, Fun} -> + Res = Fun(), + From ! {lambda, Res}, + erlang:trace_pattern({?MODULE,slave,1},false,[meta]), + slave(From); + die -> + exit(normal) + end. + +setup() -> + trace_off(), + Self = self(), + Pid = spawn(fun () -> slave(Self) end), + receive sync -> ok end, + put(slave,Pid), + Pid. + +shutdown() -> + trace_off(), + Pid = get(slave), + case (catch is_process_alive(Pid)) of + true -> + Ref = erlang:monitor(process,Pid), + Pid ! die, + receive + {'DOWN',Ref,process,Pid,_} -> + ok + end; + _ -> + ok + end. + +trace_off() -> + erlang:trace(all, false, [all]), + erlang:trace_pattern({'_','_','_'},false,[]), + erlang:trace_pattern({'_','_','_'},false,[local]), + erlang:trace_pattern({'_','_','_'},false,[meta]), + erlang:trace_pattern(on_load,false,[]), + erlang:trace_pattern(on_load,false,[local]), + erlang:trace_pattern(on_load,false,[meta]), + ok. + +apply_slave_async(M,F,A) -> + Slave = get(slave), + Pid = + spawn( + fun () -> + Slave ! {self(),apply, M, F, A}, + receive + {apply, _} -> + receive + sync -> + ok + end + end + end), + Pid. + +apply_slave(M,F,A) -> + Pid = get(slave), + Pid ! {self(),apply, M, F, A}, + receive + {apply, Res} -> + receive + sync -> + Res + end + end. + +lambda_slave(Fun) -> + Pid = get(slave), + Pid ! {self(), lambda, Fun}, + receive + {lambda, Res} -> + receive + sync -> + Res + end + end. + +relay_n(0, _) -> + ok; +relay_n(N, Dest) -> + receive Msg -> + Dest ! {self(), Msg}, + relay_n(N-1, Dest) + end. + + +receive_next() -> + receive_next(infinity). + +receive_next(TO) -> + receive + M -> + M + after TO -> + ?t:fail(timeout) + end. + +receive_no_next(TO) -> + receive + M -> + ?t:fail({unexpected_message, M}) + after + TO -> + ok + end. + +receive_next_bytag(Tag) -> + receive_next_bytag(Tag, infinity). +receive_next_bytag(Tag, TO) -> + receive + {Tag, Msg} -> + Msg + after + TO -> + timeout + end. diff --git a/erts/emulator/test/trace_nif_SUITE.erl b/erts/emulator/test/trace_nif_SUITE.erl new file mode 100644 index 0000000000..587cc08979 --- /dev/null +++ b/erts/emulator/test/trace_nif_SUITE.erl @@ -0,0 +1,292 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(trace_nif_SUITE). + +-include("test_server.hrl"). + +-export([all/1]). +-export([trace_nif/1, + trace_nif_timestamp/1, + trace_nif_local/1, + trace_nif_meta/1, + trace_nif_timestamp_local/1, + trace_nif_return/1, + not_run/1]). + +-export([nif_process/0, nif/0, nif/1]). + +all(suite) -> + case test_server:is_native(?MODULE) of + true -> [not_run]; + false -> + [trace_nif, + trace_nif_timestamp, + trace_nif_local, + trace_nif_meta, + trace_nif_timestamp_local, + trace_nif_return + ] + end. + +not_run(Config) when is_list(Config) -> + {skipped,"Native code"}. + +trace_nif(doc) -> "Test tracing NIFs."; +trace_nif(Config) when is_list(Config) -> + load_nif(Config), + + do_trace_nif([]). + +trace_nif_local(doc) -> "Test tracing NIFs with local flag."; +trace_nif_local(Config) when is_list(Config) -> + load_nif(Config), + do_trace_nif([local]). + +trace_nif_meta(doc) -> "Test tracing NIFs with meta flag."; +trace_nif_meta(Config) when is_list(Config) -> + load_nif(Config), + ?line Pid=spawn_link(?MODULE, nif_process, []), + ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], [meta]), + + ?line Pid ! {apply_nif, nif, []}, + ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + + ?line Pid ! {apply_nif, nif, ["Arg1"]}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + + ?line Pid ! {call_nif, nif, []}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, []}}), + + ?line Pid ! {call_nif, nif, ["Arg1"]}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + ok. +do_trace_nif(Flags) -> + ?line Pid = spawn(?MODULE, nif_process, []), + ?line 1 = erlang:trace(Pid, true, [call]), + ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + ?line Pid ! {apply_nif, nif, []}, + ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), + ?line Pid ! {apply_nif, nif, ["Arg1"]}, + ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), + + ?line Pid ! {call_nif, nif, []}, + ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), + + ?line Pid ! {call_nif, nif, ["Arg1"]}, + ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), + + + %% Switch off + ?line 1 = erlang:trace(Pid, false, [call]), + + ?line Pid ! {apply_nif, nif, []}, + receive_nothing(), + ?line Pid ! {apply_nif, nif, ["Arg1"]}, + receive_nothing(), + ?line Pid ! {call_nif, nif, []}, + receive_nothing(), + ?line Pid ! {call_nif, nif, ["Arg1"]}, + receive_nothing(), + + %% Switch on again + ?line 1 = erlang:trace(Pid, true, [call]), + ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + ?line Pid ! {apply_nif, nif, []}, + ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, []}}), + ?line Pid ! {apply_nif, nif, ["Arg1"]}, + ?line receive_trace_msg({trace,Pid,call,{?MODULE,nif, ["Arg1"]}}), + + ?line Pid ! {call_nif, nif, []}, + ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, []}}), + + ?line Pid ! {call_nif, nif, ["Arg1"]}, + ?line receive_trace_msg({trace, Pid, call, {?MODULE,nif, ["Arg1"]}}), + + ?line 1 = erlang:trace(Pid, false, [call]), + ?line erlang:trace_pattern({?MODULE,nif,'_'}, false, Flags), + ?line exit(Pid, die), + ok. + +trace_nif_timestamp(doc) -> "Test tracing NIFs with timestamps."; +trace_nif_timestamp(Config) when is_list(Config) -> + load_nif(Config), + do_trace_nif_timestamp([]). + +trace_nif_timestamp_local(doc) -> + "Test tracing NIFs with timestamps and local flag."; +trace_nif_timestamp_local(Config) when is_list(Config) -> + load_nif(Config), + do_trace_nif_timestamp([local]). + +do_trace_nif_timestamp(Flags) -> + ?line Pid=spawn(?MODULE, nif_process, []), + ?line 1 = erlang:trace(Pid, true, [call,timestamp]), + ?line erlang:trace_pattern({?MODULE,nif,'_'}, [], Flags), + + ?line Pid ! {apply_nif, nif, []}, + ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + + ?line Pid ! {apply_nif, nif, ["Arg1"]}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + + ?line Pid ! {call_nif, nif, []}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, []}}), + + ?line Pid ! {call_nif, nif, ["Arg1"]}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + + %% We should be able to turn off the timestamp. + ?line 1 = erlang:trace(Pid, false, [timestamp]), + + ?line Pid ! {call_nif, nif, []}, + ?line receive_trace_msg({trace,Pid,call, + {?MODULE,nif, []}}), + + ?line Pid ! {apply_nif, nif, ["tjoho"]}, + ?line receive_trace_msg({trace,Pid,call, + {?MODULE,nif, ["tjoho"]}}), + + ?line 1 = erlang:trace(Pid, false, [call]), + ?line erlang:trace_pattern({erlang,'_','_'}, false, Flags), + + ?line exit(Pid, die), + ok. + +trace_nif_return(doc) -> + "Test tracing NIF's with return/return_to trace."; +trace_nif_return(Config) when is_list(Config) -> + load_nif(Config), + + ?line Pid=spawn(?MODULE, nif_process, []), + ?line 1 = erlang:trace(Pid, true, [call,timestamp,return_to]), + ?line erlang:trace_pattern({?MODULE,nif,'_'}, [{'_',[],[{return_trace}]}], + [local]), + + ?line Pid ! {apply_nif, nif, []}, + ?line receive_trace_msg_ts({trace_ts,Pid,call,{?MODULE,nif,[]}}), + ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {?MODULE,nif,0}}), + ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, nif_process,0}}), + + ?line Pid ! {call_nif, nif, ["Arg1"]}, + ?line receive_trace_msg_ts({trace_ts,Pid,call, + {?MODULE,nif, ["Arg1"]}}), + ?line receive_trace_msg_ts_return_from({trace_ts,Pid,return_from, + {?MODULE,nif,1}}), + ?line receive_trace_msg_ts_return_to({trace_ts,Pid,return_to, + {?MODULE, nif_process,0}}), + ok. + + +receive_trace_msg(Mess) -> + receive + Mess -> + ok; + Other -> + io:format("Expected: ~p,~nGot: ~p~n", [Mess, Other]), + ?t:fail() + after 5000 -> + io:format("Expected: ~p,~nGot: timeout~n", [Mess]), + ?t:fail() + end. + +receive_nothing() -> + ?line timeout = receive M -> M after 100 -> timeout end. + +receive_trace_msg_ts({trace_ts, Pid, call, {M,F,A}}) -> + receive + {trace_ts, Pid, call, {M, F, A}, _Ts} -> + ok; + Other -> + io:format("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", + [Pid, M, F, A, Other]), + ?t:fail() + after 5000 -> + io:format("Got timeout~n", []), + ?t:fail() + end. + +receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {M,F,A}}) -> + receive + {trace_ts, Pid, return_from, {M, F, A}, _Value, _Ts} -> + ok; + Other -> + io:format("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n" + "Got: ~p~n", + [Pid, M, F, A, Other]), + ?t:fail() + after 5000 -> + io:format("Got timeout~n", []), + ?t:fail() + end. + +receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}) -> + receive + {trace_ts, Pid, return_to, {M, F, A}, _Ts} -> + ok; + Other -> + io:format("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n" + "Got: ~p~n", + [Pid, M, F, A, Other]), + ?t:fail() + after 5000 -> + io:format("Got timeout~n", []), + ?t:fail() + end. + +nif_process() -> + receive + {apply_nif, Name, Args} -> + ?line {ok,Args} = apply(?MODULE, Name, Args); + + {call_nif, Name, []} -> + ?line {ok, []} = ?MODULE:Name(); + + {call_nif, Name, [A1]} -> + ?line {ok, [A1]} = ?MODULE:Name(A1); + + {call_nif, Name, [A1,A2]} -> + ?line {ok,[A1,A2]} = ?MODULE:Name(A1,A2); + + {call_nif, Name, [A1,A2,A3]} -> + ?line {ok,[A1,A2,A3]} = ?MODULE:Name(A1,A2,A3) + end, + nif_process(). + +load_nif(Config) -> + ?line Path = ?config(data_dir, Config), + + ?line ok = erlang:load_nif(filename:join(Path,"trace_nif"), 0). + + +nif() -> + {"Stub0",[]}. %exit("nif/0 stub called"). + +nif(A1) -> + {"Stub1",[A1]}. %exit(["nif/1 stub called",A1]). + diff --git a/erts/emulator/test/trace_nif_SUITE_data/Makefile.src b/erts/emulator/test/trace_nif_SUITE_data/Makefile.src new file mode 100644 index 0000000000..26b1b58f70 --- /dev/null +++ b/erts/emulator/test/trace_nif_SUITE_data/Makefile.src @@ -0,0 +1,7 @@ + +NIF_LIBS = trace_nif@dll@ + +all: $(NIF_LIBS) + +@SHLIB_RULES@ + diff --git a/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c b/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c new file mode 100644 index 0000000000..732f1010ae --- /dev/null +++ b/erts/emulator/test/trace_nif_SUITE_data/trace_nif.c @@ -0,0 +1,46 @@ +#include "erl_nif.h" + + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static int reload(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, ERL_NIF_TERM load_info) +{ + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) +{ +} + +static ERL_NIF_TERM nif_0(ErlNifEnv* env) +{ + return enif_make_tuple(env,2, + enif_make_atom(env,"ok"), + enif_make_list(env,0)); +} + +static ERL_NIF_TERM nif_1(ErlNifEnv* env, ERL_NIF_TERM a1) +{ + return enif_make_tuple(env,2, + enif_make_atom(env,"ok"), + enif_make_list(env,1,a1)); +} + + + +static ErlNifFunc nif_funcs[] = +{ + {"nif", 0, nif_0}, + {"nif", 1, nif_1} +}; + +ERL_NIF_INIT(trace_nif_SUITE,nif_funcs,load,reload,upgrade,unload) + diff --git a/erts/emulator/test/trace_port_SUITE.erl b/erts/emulator/test/trace_port_SUITE.erl new file mode 100644 index 0000000000..5febe177f9 --- /dev/null +++ b/erts/emulator/test/trace_port_SUITE.erl @@ -0,0 +1,686 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + + +-module(trace_port_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + call_trace/1, + return_trace/1, + send/1, + receive_trace/1, + process_events/1, + schedule/1, + fake_schedule/1, + fake_schedule_after_register/1, + fake_schedule_after_getting_linked/1, + fake_schedule_after_getting_unlinked/1, + gc/1, + default_tracer/1]). + +-include("test_server.hrl"). + +test_cases() -> + [call_trace, + return_trace, + send, + receive_trace, + process_events, + schedule, + fake_schedule, + fake_schedule_after_register, + fake_schedule_after_getting_linked, + fake_schedule_after_getting_unlinked, + gc, + default_tracer]. + +all(suite) -> test_cases(). + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog = ?t:timetrap(?t:seconds(30)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +call_trace(doc) -> "Test sending call trace messages to a port."; +call_trace(Config) when is_list(Config) -> + case test_server:is_native(?MODULE) of + true -> + {skip,"Native code"}; + false -> + ?line start_tracer(Config), + Self = self(), + ?line trace_func({lists,reverse,1}, []), + ?line trace_pid(Self, true, [call]), + ?line trace_info(Self, flags), + ?line trace_info(Self, tracer), + ?line [b,a] = lists:reverse([a,b]), + ?line expect({trace,Self,call,{lists,reverse,[[a,b]]}}), + + ?line trace_pid(Self, true, [timestamp]), + ?line trace_info(Self, flags), + ?line Huge = huge_data(), + ?line lists:reverse(Huge), + ?line expect({trace_ts,Self,call,{lists,reverse,[Huge]},ts}), + + ?line trace_pid(Self, true, [arity]), + ?line trace_info(Self, flags), + ?line [y,x] = lists:reverse([x,y]), + ?line expect({trace_ts,Self,call,{lists,reverse,1},ts}), + + ?line trace_pid(Self, false, [timestamp]), + ?line trace_info(Self, flags), + ?line [z,y,x] = lists:reverse([x,y,z]), + ?line expect({trace,Self,call,{lists,reverse,1}}), + + %% OTP-7399. Delayed sub-binary creation optimization. + ?line trace_pid(Self, false, [arity]), + ?line trace_info(Self, flags), + ?line trace_func({?MODULE,bs_sum_c,2}, [], [local]), + ?line 26 = bs_sum_c(<<3:4,5:4,7:4,11:4>>, 0), + ?line trace_func({?MODULE,bs_sum_c,2}, false, [local]), + ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<3:4,5:4,7:4,11:4>>,0]}}), + ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<5:4,7:4,11:4>>,3]}}), + ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<7:4,11:4>>,8]}}), + ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<11:4>>,15]}}), + ?line expect({trace,Self,call,{?MODULE,bs_sum_c,[<<>>,26]}}), + + ?line trace_func({lists,reverse,1}, false), + ok + end. + +bs_sum_c(<>, Acc) -> bs_sum_c(T, H+Acc); +bs_sum_c(<<>>, Acc) -> Acc. + + +return_trace(doc) -> "Test the new return trace."; +return_trace(Config) when is_list(Config) -> + case test_server:is_native(?MODULE) of + true -> + {skip,"Native code"}; + false -> + ?line start_tracer(Config), + Self = self(), + MFA = {lists,reverse,1}, + + %% Plain (no timestamp, small data). + + ?line trace_func(MFA, [{['$1'],[],[{return_trace}, + {message,false}]}]), + ?line trace_pid(Self, true, [call]), + ?line trace_info(Self, flags), + ?line trace_info(Self, tracer), + ?line trace_info(MFA, match_spec), + ?line {traced,global} = trace_info(MFA, traced), + ?line [b,a] = lists:reverse([a,b]), + ?line expect({trace,Self,return_from,MFA,[b,a]}), + + %% Timestamp, huge data. + ?line trace_pid(Self, true, [timestamp]), + ?line Result = lists:reverse(huge_data()), + ?line expect({trace_ts,Self,return_from,MFA,Result,ts}), + + %% Turn off trace. + ?line trace_func(MFA, false), + ?line trace_info(MFA, match_spec), + ?line {traced,false} = trace_info(MFA, traced), + ok + end. + +send(doc) -> "Test sending send trace messages to a port."; +send(Config) when is_list(Config) -> + ?line Tracer = start_tracer(Config), + Self = self(), + ?line Sender = fun_spawn(fun sender/0), + ?line trac(Sender, true, [send]), + + %% Simple message, no timestamp. + + ?line Bin = list_to_binary(lists:seq(1, 10)), + ?line Msg = {some_data,Bin}, + Sender ! {send_please,self(),Msg}, + receive Msg -> ok end, + ?line expect({trace,Sender,send,Msg,Self}), + + %% Timestamp. + + BiggerMsg = {even_bigger,Msg}, + ?line trac(Sender, true, [send,timestamp]), + Sender ! {send_please,self(),BiggerMsg}, + receive BiggerMsg -> ok end, + ?line expect({trace_ts,Sender,send,BiggerMsg,Self,ts}), + + %% Huge message. + + ?line HugeMsg = huge_data(), + Sender ! {send_please,self(),HugeMsg}, + receive HugeMsg -> ok end, + ?line expect({trace_ts,Sender,send,HugeMsg,Self,ts}), + + %% Kill trace port and force a trace. The emulator should not crasch. + + ?line unlink(Tracer), + ?line exit(Tracer, kill), + erlang:yield(), % Make sure that port gets killed. + Sender ! {send_please,Self,good_bye}, + receive good_bye -> ok end, + ok. + +receive_trace(doc) -> "Test sending receive traces to a port."; +receive_trace(Config) when is_list(Config) -> + ?line start_tracer(Config), + ?line Receiver = fun_spawn(fun receiver/0), + ?line trac(Receiver, true, ['receive']), + + Receiver ! {hello,world}, + ?line expect({trace,Receiver,'receive',{hello,world}}), + + ?line trac(Receiver, true, ['receive',timestamp]), + Huge = {hello,huge_data()}, + Receiver ! {hello,huge_data()}, + ?line expect({trace_ts,Receiver,'receive',Huge,ts}), + ok. + +process_events(doc) -> "Tests a few process events (like getting linked)."; +process_events(Config) when is_list(Config) -> + ?line start_tracer(Config), + Self = self(), + ?line Receiver = fun_spawn(fun receiver/0), + ?line trac(Receiver, true, [procs]), + + unlink(Receiver), %It is already linked. + ?line expect({trace,Receiver,getting_unlinked,Self}), + link(Receiver), + ?line expect({trace,Receiver,getting_linked,Self}), + ?line trac(Receiver, true, [procs,timestamp]), + unlink(Receiver), + ?line expect({trace_ts,Receiver,getting_unlinked,Self,ts}), + link(Receiver), + ?line expect({trace_ts,Receiver,getting_linked,Self,ts}), + + unlink(Receiver), + ?line expect({trace_ts,Receiver,getting_unlinked,Self,ts}), + Huge = huge_data(), + exit(Receiver, Huge), + ?line expect({trace_ts,Receiver,exit,Huge,ts}), + + ok. + +schedule(doc) -> "Test sending scheduling events to a port."; +schedule(Config) when is_list(Config) -> + ?line start_tracer(Config), + ?line Receiver = fun_spawn(fun receiver/0), + ?line trac(Receiver, true, [running]), + + Receiver ! hi, + expect({trace,Receiver,in,{?MODULE,receiver,0}}), + expect({trace,Receiver,out,{?MODULE,receiver,0}}), + + ?line trac(Receiver, true, [running,timestamp]), + + Receiver ! hi_again, + expect({trace_ts,Receiver,in,{?MODULE,receiver,0},ts}), + expect({trace_ts,Receiver,out,{?MODULE,receiver,0},ts}), + + ok. + +run_fake_sched_test(Fun, Config) when is_function(Fun), is_list(Config) -> + ?line case catch erlang:system_info(smp_support) of + true -> + ?line {skipped, + "No need for faked schedule out/in trace messages " + "when smp support is enabled"}; + _ -> + ?line Fun(Config) + end. + +fake_schedule(doc) -> "Tests time compensating fake out/in scheduling."; +fake_schedule(Config) when is_list(Config) -> + ?line run_fake_sched_test(fun fake_schedule_test/1, Config). + +fake_schedule_test(Config) when is_list(Config) -> + ?line Tracer = start_tracer(Config), + ?line Port = get(tracer_port), + ?line General = fun_spawn(fun general/0), + %% + ?line trac(General, true, [send, running]), + %% + %% Test that fake out/in scheduling is not generated unless + %% both 'running' and 'timestamp' is active. + ?line [] = erlang:port_control(Port, $h, []), + ?line General ! nop, + ?line expect({trace, General, in, {?MODULE, general, 0}}), + ?line expect({trace, General, out, {?MODULE, general, 0}}), + ?line expect(), + %% + ?line trac(General, false, [running]), + ?line trac(General, true, [timestamp]), + %% + ?line Ref1 = make_ref(), + ?line Msg1 = {Port, {data, term_to_binary(Ref1)}}, + ?line [] = erlang:port_control(Port, $h, []), + ?line General ! {send, Tracer, Msg1}, + ?line expect({trace_ts, General, send, Msg1, Tracer, ts}), + ?line expect(Ref1), + ?line expect(), + %% + ?line trac(General, true, [running]), + %% + %% Test that fake out/in scheduling can be generated by the driver + ?line Ref2 = make_ref(), + ?line Msg2 = {Port, {data, term_to_binary(Ref2)}}, + ?line [] = erlang:port_control(Port, $h, []), + ?line General ! {send, Tracer, Msg2}, + ?line {_,_,_,_,Ts} = + expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), + ?line expect({trace_ts, General, out, 0, Ts}), + ?line expect({trace_ts, General, in, 0, ts}), + ?line expect({trace_ts, General, send, Msg2, Tracer, ts}), + ?line expect(Ref2), + ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), + ?line expect(), + %% + %% Test that fake out/in scheduling is not generated after an + %% 'out' scheduling event + ?line Ref3 = make_ref(), + ?line Msg3 = {Port, {data, term_to_binary(Ref3)}}, + ?line General ! {apply, {erlang, port_control, [Port, $h, []]}}, + ?line expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), + ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), + ?line General ! {send, Tracer, Msg3}, + ?line expect({trace_ts, General, in, {?MODULE, general, 0}, ts}), + ?line expect({trace_ts, General, send, Msg3, Tracer, ts}), + ?line expect(Ref3), + ?line expect({trace_ts, General, out, {?MODULE, general, 0}, ts}), + ?line expect(), + %% + ok. + +fake_schedule_after_register(doc) -> + "Tests fake out/in scheduling contents."; +fake_schedule_after_register(Config) when is_list(Config) -> + ?line run_fake_sched_test(fun fake_schedule_after_register_test/1, Config). + +fake_schedule_after_register_test(Config) when is_list(Config) -> + ?line start_tracer(Config), + ?line Port = get(tracer_port), + ?line G1 = fun_spawn(fun general/0), + ?line G2 = fun_spawn(fun general/0), + %% + ?line trac(G1, true, [running, timestamp, procs]), + ?line trac(G2, true, [running, timestamp]), + %% + %% Test fake out/in scheduling after certain messages + ?line erlang:yield(), + ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, + ?line G2 ! {apply, {erlang, register, [fake_schedule_after_register, G1]}}, + ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), + ?line {_,_,_,_,Ts} = + expect({trace_ts, G1, register, fake_schedule_after_register, ts}), + ?line expect({trace_ts, G2, out, 0, Ts}), + ?line expect({trace_ts, G2, in, 0, ts}), + ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), + ?line expect(), + %% + ok. + +fake_schedule_after_getting_linked(doc) -> + "Tests fake out/in scheduling contents."; +fake_schedule_after_getting_linked(Config) when is_list(Config) -> + ?line run_fake_sched_test(fun fake_schedule_after_getting_linked_test/1, + Config). + +fake_schedule_after_getting_linked_test(Config) when is_list(Config) -> + ?line start_tracer(Config), + ?line Port = get(tracer_port), + ?line G1 = fun_spawn(fun general/0), + ?line G2 = fun_spawn(fun general/0), + %% + ?line trac(G1, true, [running, timestamp, procs]), + ?line trac(G2, true, [running, timestamp]), + %% + %% Test fake out/in scheduling after certain messages + ?line erlang:yield(), + ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, + ?line G2 ! {apply, {erlang, link, [G1]}}, + ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), + ?line {_,_,_,_,Ts} = + expect({trace_ts, G1, getting_linked, G2, ts}), + ?line expect({trace_ts, G2, out, 0, Ts}), + ?line expect({trace_ts, G2, in, 0, ts}), + ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), + ?line expect(), + %% + ok. + +fake_schedule_after_getting_unlinked(doc) -> + "Tests fake out/in scheduling contents."; +fake_schedule_after_getting_unlinked(Config) when is_list(Config) -> + ?line run_fake_sched_test(fun fake_schedule_after_getting_unlinked_test/1, + Config). + +fake_schedule_after_getting_unlinked_test(Config) when is_list(Config) -> + ?line start_tracer(Config), + ?line Port = get(tracer_port), + ?line G1 = fun_spawn(fun general/0), + ?line G2 = fun_spawn(fun general/0), + %% + ?line trac(G1, true, [running, procs]), + ?line trac(G2, true, [running, timestamp]), + %% + %% Test fake out/in scheduling after certain messages + ?line erlang:yield(), + ?line G2 ! {apply, {erlang, link, [G1]}}, + ?line G2 ! {apply, {erlang, port_control, [Port, $h, []]}}, + ?line G2 ! {apply, {erlang, unlink, [G1]}}, + ?line expect({trace_ts, G2, in, {?MODULE, general, 0}, ts}), + ?line expect({trace, G1, getting_linked, G2}), + ?line expect({trace, G1, getting_unlinked, G2}), + ?line expect({trace_ts, G2, out, 0, ts}), + ?line expect({trace_ts, G2, in, 0, ts}), + ?line expect({trace_ts, G2, out, {?MODULE, general, 0}, ts}), + ?line expect(), + %% + ok. + +gc(doc) -> "Test sending garbage collection events to a port."; +gc(Config) when is_list(Config) -> + ?line start_tracer(Config), + ?line Garber = fun_spawn(fun garber/0, [{min_heap_size, 5000}]), + ?line trac(Garber, true, [garbage_collection]), + ?line trace_info(Garber, flags), + + ?line trace_info(Garber, flags), + Garber ! hi, + expect({trace,Garber,gc_start,info}), + expect({trace,Garber,gc_end,info}), + + ?line trac(Garber, true, [garbage_collection,timestamp]), + Garber ! hi, + expect({trace_ts,Garber,gc_start,info,ts}), + expect({trace_ts,Garber,gc_end,info,ts}), + + ok. + +default_tracer(doc) -> + "Test a port as default tracer."; +default_tracer(Config) when is_list(Config) -> + ?line Tracer = start_tracer(Config), + ?line TracerMonitor = erlang:monitor(process, Tracer), + ?line Port = get(tracer_port), + %% + ?line N = erlang:trace(all, true, [send, {tracer, Port}]), + ?line {flags, [send]} = erlang:trace_info(self(), flags), + ?line {tracer, Port} = erlang:trace_info(self(), tracer), + ?line {flags, [send]} = erlang:trace_info(new, flags), + ?line {tracer, Port} = erlang:trace_info(new, tracer), + ?line G1 = fun_spawn(fun general/0), + ?line {flags, [send]} = erlang:trace_info(G1, flags), + ?line {tracer, Port} = erlang:trace_info(G1, tracer), + ?line unlink(Tracer), + ?line exit(Port, done), + ?line receive + {'DOWN', TracerMonitor, process, Tracer, TracerExitReason} -> + ?line done = TracerExitReason + end, + ?line {flags, []} = erlang:trace_info(self(), flags), + ?line {tracer, []} = erlang:trace_info(self(), tracer), + ?line {flags, []} = erlang:trace_info(new, flags), + ?line {tracer, []} = erlang:trace_info(new, tracer), + ?line M = erlang:trace(all, false, [all]), + ?line {flags, []} = erlang:trace_info(self(), flags), + ?line {tracer, []} = erlang:trace_info(self(), tracer), + ?line {flags, []} = erlang:trace_info(G1, flags), + ?line {tracer, []} = erlang:trace_info(G1, tracer), + ?line G1 ! {apply,{erlang,exit,[normal]}}, + ?line io:format("~p = ~p.~n", [M, N]), + ?line M = N, + ok. + + +%%% Help functions. + +huge_data() -> + case os:type() of + vxworks -> huge_data(4711); + _ -> huge_data(16384) + end. +huge_data(0) -> []; +huge_data(N) when N rem 2 == 0 -> + P = huge_data(N div 2), + [P|P]; +huge_data(N) -> + P = huge_data(N div 2), + [16#1234566,P|P]. + +expect() -> + receive + Other -> + ok = io:format("Unexpected; got ~p", [Other]), + test_server:fail({unexpected, Other}) + after 200 -> + ok + end. + +expect({trace_ts,E1,E2,info,ts}=Message) -> + receive + {trace_ts,E1,E2,_Info,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + test_server:fail({unexpected,Other}) + after 5000 -> + io:format("Expected ~p; got nothing", [Message]), + test_server:fail(no_trace_message) + end; +expect({trace,E1,E2,info}=Message) -> + receive + {trace,E1,E2,_Info}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + test_server:fail({unexpected,Other}) + after 5000 -> + io:format("Expected ~p; got nothing", [Message]), + test_server:fail(no_trace_message) + end; +expect({trace_ts,E1,E2,E3,ts}=Message) -> + receive + {trace_ts,E1,E2,E3,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + test_server:fail({unexpected,Other}) + after 5000 -> + io:format("Expected ~p; got nothing", [Message]), + test_server:fail(no_trace_message) + end; +expect({trace_ts,E1,E2,E3,E4,ts}=Message) -> + receive + {trace_ts,E1,E2,E3,E4,_Ts}=MessageTs -> + ok = io:format("Expected and got ~p", [MessageTs]), + MessageTs; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + test_server:fail({unexpected,Other}) + after 5000 -> + io:format("Expected ~p; got nothing", [Message]), + test_server:fail(no_trace_message) + end; +expect(Message) -> + receive + Message -> + ok = io:format("Expected and got ~p", [Message]), + Message; + Other -> + io:format("Expected ~p; got ~p", [Message,Other]), + test_server:fail({unexpected,Other}) + after 5000 -> + io:format("Expected ~p; got nothing", [Message]), + test_server:fail(no_trace_message) + end. + +trac(What, On, Flags0) -> + Flags = [{tracer,get(tracer_port)}|Flags0], + get(tracer) ! {apply,self(),{erlang,trace,[What,On,Flags]}}, + Res = receive + {apply_result,Result} -> Result + end, + ok = io:format("erlang:trace(~p, ~p, ~p) -> ~p", + [What,On,Flags,Res]), + Res. + +trace_info(What, Key) -> + get(tracer) ! {apply,self(),{erlang,trace_info,[What,Key]}}, + Res = receive + {apply_result,Result} -> Result + end, + ok = io:format("erlang:trace_info(~p, ~p) -> ~p", + [What,Key,Res]), + Res. + +trace_func(MFA, MatchProg) -> + get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA,MatchProg]}}, + Res = receive + {apply_result,Result} -> Result + end, + ok = io:format("erlang:trace_pattern(~p, ~p) -> ~p", [MFA,MatchProg,Res]), + Res. + +trace_func(MFA, MatchProg, Flags) -> + get(tracer) ! {apply,self(),{erlang,trace_pattern,[MFA,MatchProg,Flags]}}, + Res = receive + {apply_result,Result} -> Result + end, + ok = io:format("erlang:trace_pattern(~p, ~p) -> ~p", [MFA,MatchProg,Res]), + Res. + +trace_pid(Pid, On, Flags0) -> + Flags = [{tracer,get(tracer_port)}|Flags0], + get(tracer) ! {apply,self(),{erlang,trace,[Pid,On,Flags]}}, + Res = receive + {apply_result,Result} -> Result + end, + ok = io:format("erlang:trace(~p, ~p, ~p) -> ~p", + [Pid,On,Flags,Res]), + Res. + +start_tracer(Config) -> + Path = ?config(data_dir, Config), + ok = load_driver(Path, echo_drv), + Self = self(), + put(tracer, fun_spawn(fun() -> tracer(Self) end)), + receive + {started,Port} -> + put(tracer_port, Port) + end, + get(tracer). + +load_driver(Dir, Driver) -> + case erl_ddll:load_driver(Dir, Driver) of + ok -> ok; + {error, Error} = Res -> + io:format("~s\n", [erl_ddll:format_error(Error)]), + Res + end. + +tracer(RelayTo) -> + Port = open_port({spawn,echo_drv}, [eof,binary]), + RelayTo ! {started,Port}, + tracer_loop(RelayTo, Port). + +tracer_loop(RelayTo, Port) -> + receive + {apply,From,{M,F,A}} -> + From ! {apply_result,apply(M, F, A)}, + tracer_loop(RelayTo, Port); + {Port,{data,Msg}} -> + RelayTo ! binary_to_term(Msg), + tracer_loop(RelayTo, Port); + Other -> + exit({bad_message,Other}) + end. + +fun_spawn(Fun) -> + spawn_link(erlang, apply, [Fun,[]]). + +fun_spawn(Fun, Opts) -> + spawn_opt(erlang, apply, [Fun,[]], [link | Opts]). + +% flush() -> +% receive +% X -> +% [X | flush()] +% after 2000 -> +% [] +% end. + + +%%% Models for various kinds of processes. + +%% Sends messages when ordered to. + +sender() -> + receive + {send_please, To, What} -> + To ! What, + sender() + end. + +%% Just consumes messages from its message queue. + +receiver() -> + receive + _Any -> receiver() + end. + +%% Does a garbage collection when it receives a message. + +garber() -> + receive + _Any -> + lists:seq(1, 100), + erlang:garbage_collect(), + garber() + end. + +%% All-purpose process + +general() -> + receive + {apply, {M, F, Args}} -> + erlang:apply(M, F, Args), + general(); + {send, Dest, Msg} -> + Dest ! Msg, + general(); + {call_f_1, Arg} -> + f(Arg), + general(); + nop -> + general() + end. + +f(Arg) -> + Arg. diff --git a/erts/emulator/test/trace_port_SUITE_data/Makefile.src b/erts/emulator/test/trace_port_SUITE_data/Makefile.src new file mode 100644 index 0000000000..c1bf142ccf --- /dev/null +++ b/erts/emulator/test/trace_port_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: echo_drv@dll@ + +@SHLIB_RULES@ diff --git a/erts/emulator/test/trace_port_SUITE_data/echo_drv.c b/erts/emulator/test/trace_port_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..15c4ca11fe --- /dev/null +++ b/erts/emulator/test/trace_port_SUITE_data/echo_drv.c @@ -0,0 +1,107 @@ +#include +#include "erl_driver.h" + + + +/* ------------------------------------------------------------------------- +** Data types +**/ + +enum e_heavy { + heavy_off, heavy_set, heavy_reset +}; + +typedef struct _erl_drv_data { + ErlDrvPort erlang_port; + enum e_heavy heavy; +} EchoDrvData; + +static EchoDrvData echo_drv_data, *echo_drv_data_p; + + + +/* ------------------------------------------------------------------------- +** Entry struct +**/ + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command); +static void echo_drv_stop(EchoDrvData *data_p); +static void echo_drv_output(EchoDrvData *data_p, char *buf, int len); +static void echo_drv_finish(void); +static int echo_drv_control(EchoDrvData *data_p, unsigned int command, + char *buf, int len, + char **rbuf, int rlen); + +static ErlDrvEntry echo_drv_entry = { + NULL, /* init */ + echo_drv_start, + echo_drv_stop, + echo_drv_output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "echo_drv", + echo_drv_finish, + NULL, /* handle */ + echo_drv_control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL /* ready_async */ +}; + + + +/* ------------------------------------------------------------------------- +** Entry functions +**/ + +DRIVER_INIT(echo_drv) +{ + echo_drv_data_p = NULL; + return &echo_drv_entry; +} + +static EchoDrvData *echo_drv_start(ErlDrvPort port, char *command) +{ + if (echo_drv_data_p != NULL) { + return ERL_DRV_ERROR_GENERAL; + } + echo_drv_data_p = &echo_drv_data; + echo_drv_data_p->erlang_port = port; + echo_drv_data_p->heavy = heavy_off; + return echo_drv_data_p; +} + +static void echo_drv_stop(EchoDrvData *data_p) { + echo_drv_data_p = NULL; +} + +static void echo_drv_output(EchoDrvData *data_p, char *buf, int len) { + driver_output(data_p->erlang_port, buf, len); + switch (data_p->heavy) { + case heavy_off: + break; + case heavy_set: + set_port_control_flags(data_p->erlang_port, PORT_CONTROL_FLAG_HEAVY); + data_p->heavy = heavy_reset; + break; + case heavy_reset: + set_port_control_flags(data_p->erlang_port, 0); + data_p->heavy = heavy_off; + break; + } +} + +static void echo_drv_finish() { + echo_drv_data_p = NULL; +} + +static int echo_drv_control(EchoDrvData *data_p, unsigned int command, + char *buf, int len, + char **rbuf, int rlen) { + switch (command) { + case 'h': + data_p->heavy = heavy_set; + break; + } + return 0; +} diff --git a/erts/emulator/test/tuple_SUITE.erl b/erts/emulator/test/tuple_SUITE.erl new file mode 100644 index 0000000000..c4edb16d68 --- /dev/null +++ b/erts/emulator/test/tuple_SUITE.erl @@ -0,0 +1,283 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(tuple_SUITE). +-export([all/1, t_size/1, t_tuple_size/1, t_element/1, t_setelement/1, + t_list_to_tuple/1, t_tuple_to_list/1, + t_make_tuple_2/1, t_make_tuple_3/1, t_append_element/1, + build_and_match/1, tuple_with_case/1, tuple_in_guard/1]). +-include("test_server.hrl"). + +%% Tests tuples and the BIFs: +%% +%% size(Tuple) +%% element/2 +%% setelement/3 +%% tuple_to_list/1 +%% list_to_tuple/1 +%% make_tuple/2 +%% + +all(suite) -> + [build_and_match, t_size, t_tuple_size, + t_list_to_tuple, t_tuple_to_list, + t_element, t_setelement, t_make_tuple_2, + t_make_tuple_3, t_append_element, + tuple_with_case, tuple_in_guard]. + +build_and_match(Config) when is_list(Config) -> + ?line {} = id({}), + ?line {1} = id({1}), + ?line {1, 2} = id({1, 2}), + ?line {1, 2, 3} = id({1, 2, 3}), + ?line {1, 2, 3, 4} = id({1, 2, 3, 4}), + ?line {1, 2, 3, 4, 5} = id({1, 2, 3, 4, 5}), + ?line {1, 2, 3, 4, 5, 6} = id({1, 2, 3, 4, 5, 6}), + ?line {1, 2, 3, 4, 5, 6} = id({1, 2, 3, 4, 5, 6}), + ?line {1, 2, 3, 4, 5, 6, 7} = id({1, 2, 3, 4, 5, 6, 7}), + ?line {1, 2, 3, 4, 5, 6, 7, 8} = id({1, 2, 3, 4, 5, 6, 7, 8}), + ok. + +%% Tests size(Tuple). + +t_size(Config) when is_list(Config) -> + ?line 0 = size({}), + ?line 1 = size({a}), + ?line 1 = size({{a}}), + ?line 2 = size({{a}, {b}}), + ?line 3 = size({1, 2, 3}), + ok. + +t_tuple_size(Config) when is_list(Config) -> + ?line 0 = tuple_size(id({})), + ?line 1 = tuple_size(id({a})), + ?line 1 = tuple_size(id({{a}})), + ?line 2 = tuple_size(id({{a},{b}})), + ?line 3 = tuple_size(id({1,2,3})), + + %% Error cases. + ?line {'EXIT',{badarg,_}} = (catch tuple_size([])), + ?line {'EXIT',{badarg,_}} = (catch tuple_size(<<1,2,3>>)), + ?line error = ludicrous_tuple_size({a,b,c}), + ?line error = ludicrous_tuple_size([a,b,c]), + ok. + + +ludicrous_tuple_size(T) + when tuple_size(T) =:= 16#7777777777777777777777777777777777 -> ok; +ludicrous_tuple_size(T) -> error. + +%% Tests element/2. + +t_element(Config) when is_list(Config) -> + ?line a = element(1, {a}), + ?line a = element(1, {a, b}), + + ?line List = lists:seq(1, 4096), + ?line Tuple = list_to_tuple(lists:seq(1, 4096)), + ?line get_elements(List, Tuple, 1), + + ?line {'EXIT', {badarg, _}} = (catch element(0, id({a,b}))), + ?line {'EXIT', {badarg, _}} = (catch element(3, id({a,b}))), + ?line {'EXIT', {badarg, _}} = (catch element(1, id({}))), + ?line {'EXIT', {badarg, _}} = (catch element(1, id([a,b]))), + ?line {'EXIT', {badarg, _}} = (catch element(1, id(42))), + ?line {'EXIT', {badarg, _}} = (catch element(id(1.5), id({a,b}))), + + ok. + +get_elements([Element|Rest], Tuple, Pos) -> + ?line Element = element(Pos, Tuple), + ?line get_elements(Rest, Tuple, Pos+1); +get_elements([], _Tuple, _Pos) -> + ok. + +%% Tests set_element/3. + +t_setelement(Config) when is_list(Config) -> + ?line {x} = setelement(1, id({1}), x), + ?line {x,2} = setelement(1, id({1,2}), x), + ?line {1,x} = setelement(2, id({1,2}), x), + + ?line Tuple = list_to_tuple(lists:duplicate(2048, x)), + ?line NewTuple = set_all_elements(Tuple, 1), + ?line NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)), + + ?line {'EXIT', {badarg, _}} = (catch setelement(0, {a, b}, x)), + ?line {'EXIT', {badarg, _}} = (catch setelement(3, {a, b}, x)), + ?line {'EXIT', {badarg, _}} = (catch setelement(1, {}, x)), + ?line {'EXIT', {badarg, _}} = (catch setelement(1, [a, b], x)), + ?line {'EXIT', {badarg, _}} = (catch setelement(1.5, {a, b}, x)), + + %% Nested setelement with literals. + AnotherTuple = id({0,0,a,b,c}), + {93748793749387837476555412,3.0,gurka,b,c} = + setelement(1, setelement(2, setelement(3, AnotherTuple, gurka), + 3.0), 93748793749387837476555412), + + ok. + +set_all_elements(Tuple, Pos) when Pos =< size(Tuple) -> + set_all_elements(setelement(Pos, Tuple, Pos+7), Pos+1); +set_all_elements(Tuple, Pos) when Pos > size(Tuple) -> + Tuple. + +%% Tests list_to_tuple/1. + +t_list_to_tuple(Config) when is_list(Config) -> + ?line {} = list_to_tuple([]), + ?line {a} = list_to_tuple([a]), + ?line {a, b} = list_to_tuple([a, b]), + ?line {a, b, c} = list_to_tuple([a, b, c]), + ?line {a, b, c, d} = list_to_tuple([a, b, c, d]), + ?line {a, b, c, d, e} = list_to_tuple([a, b, c, d, e]), + + ?line Size = 4096, + ?line Tuple = list_to_tuple(lists:seq(1, Size)), + ?line Size = size(Tuple), + + ?line {'EXIT', {badarg, _}} = (catch list_to_tuple(id({a,b}))), + ?line {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), + ?line {'EXIT', {badarg, _}} = (catch list_to_tuple(id([a|b]))), + + ok. + +%% Tests tuple_to_list/1. + +t_tuple_to_list(Config) when is_list(Config) -> + ?line [] = tuple_to_list({}), + ?line [a] = tuple_to_list({a}), + ?line [a, b] = tuple_to_list({a, b}), + ?line [a, b, c] = tuple_to_list({a, b, c}), + ?line [a, b, c, d] = tuple_to_list({a, b, c, d}), + ?line [a, b, c, d] = tuple_to_list({a, b, c, d}), + + ?line Size = 4096, + ?line List = lists:seq(1, Size), + ?line Tuple = list_to_tuple(List), + ?line Size = size(Tuple), + ?line List = tuple_to_list(Tuple), + + ?line {'EXIT', {badarg,_}} = (catch tuple_to_list(id(a))), + ?line {'EXIT', {badarg,_}} = (catch tuple_to_list(id(42))), + + ok. + +%% Tests the make_tuple/2 BIF. +t_make_tuple_2(Config) when is_list(Config) -> + ?line t_make_tuple1([]), + ?line t_make_tuple1(42), + ?line t_make_tuple1(a), + ?line t_make_tuple1({}), + ?line t_make_tuple1({a}), + ?line t_make_tuple1(erlang:make_tuple(400, [])), + ok. + +t_make_tuple1(Element) -> + lists:foreach(fun(Size) -> t_make_tuple(Size, Element) end, + [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 255, 256, 511, 512, 999, + 1000, 1023, 1024, 4095, 4096]). + +t_make_tuple(Size, Element) -> + Tuple = erlang:make_tuple(Size, Element), + lists:foreach(fun(El) when El =:= Element -> + ok; + (Other) -> + test_server:fail({got, Other, expected, Element}) + end, tuple_to_list(Tuple)). + +%% Tests the erlang:make_tuple/3 BIF. +t_make_tuple_3(Config) when is_list(Config) -> + ?line {} = erlang:make_tuple(0, def, []), + ?line {def} = erlang:make_tuple(1, def, []), + ?line {a} = erlang:make_tuple(1, def, [{1,a}]), + ?line {a,def,c,def,e} = erlang:make_tuple(5, def, [{5,e},{1,a},{3,c}]), + ?line {a,def,c,def,e} = erlang:make_tuple(5, def, + [{1,blurf},{5,e},{3,blurf}, + {1,a},{3,c}]), + + %% Error cases. + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(0, def, [{1,a}])), + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{-1,a}])), + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{0,a}])), + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{6,z}])), + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(a, def, [{6,z}])), + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [{1,a}|b])), + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [42])), + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, [[a,b,c]])), + ?line {'EXIT',{badarg,_}} = (catch erlang:make_tuple(5, def, non_list)), + ok. + +%% Tests the append_element/2 BIF. +t_append_element(Config) when is_list(Config) -> + t_append_element({}, 2048, 2048). + +t_append_element(_Tuple, 0, _High) -> ok; +t_append_element(Tuple, N, High) -> + NewTuple = erlang:append_element(Tuple, N), + verify_seq(tuple_to_list(Tuple), High, N), + t_append_element(NewTuple, N-1, High). + +verify_seq([], High, High) -> ok; +verify_seq([High], High, High) -> ok; +verify_seq([High|T], High, Lower) -> + verify_seq(T, High-1, Lower). + +%% Tests that a case nested inside a tuple is ok. +%% (This is known to crash earlier versions of BEAM.) + +tuple_with_case(Config) when is_list(Config) -> + ?line {reply, true} = tuple_with_case(), + ok. + +tuple_with_case() -> + %% The following comments apply to the BEAM compiler. + foo(), % Reset var count. + {reply, % Compiler will choose {x,1} for tuple. + case foo() of % Call will reset var count. + {'EXIT', Reason} -> % Case will return in {x,1} (first free). + {error, Reason}; % but the tuple will be build in {x,1}, + _ -> % so case value is lost and a circular + true % data element is built. + end}. + +foo() -> ignored. + +%% Test to build a tuple in a guard. + +tuple_in_guard(Config) when is_list(Config) -> + ?line Tuple1 = id({a,b}), + ?line Tuple2 = id({a,b,c}), + ?line if + Tuple1 == {element(1, Tuple2),element(2, Tuple2)} -> + ok; + true -> + ?line test_server:fail() + end, + ?line if + Tuple2 == {element(1, Tuple2),element(2, Tuple2), + element(3, Tuple2)} -> + ok; + true -> + ?line test_server:fail() + end, + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. + diff --git a/erts/emulator/test/z_SUITE.erl b/erts/emulator/test/z_SUITE.erl new file mode 100644 index 0000000000..67d2b288a2 --- /dev/null +++ b/erts/emulator/test/z_SUITE.erl @@ -0,0 +1,312 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : z_SUITE.erl +%%% Author : Rickard Green +%%% Description : Misc tests that should be run last +%%% +%%% Created : 15 Jul 2005 by Rickard Green +%%%------------------------------------------------------------------- +-module(z_SUITE). +-author('rickard.s.green@ericsson.com'). + +%-define(line_trace, 1). + +-include("test_server.hrl"). + +%-compile(export_all). +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([schedulers_alive/1, node_container_refc_check/1, + long_timers/1, pollset_size/1, + check_io_debug/1]). + +-define(DEFAULT_TIMEOUT, ?t:minutes(5)). + +all(doc) -> []; +all(suite) -> + [schedulers_alive, + node_container_refc_check, + long_timers, + pollset_size, + check_io_debug]. + +init_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) when is_list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +%%% +%%% The test cases ------------------------------------------------------------- +%%% + +schedulers_alive(doc) -> ["Tests that all schedulers are actually used"]; +schedulers_alive(suite) -> []; +schedulers_alive(Config) when is_list(Config) -> + ?line Master = self(), + ?line NoSchedulersOnline = erlang:system_flag( + schedulers_online, + erlang:system_info(schedulers)), + ?line NoSchedulers = erlang:system_info(schedulers), + UsedScheds = + try + ?line ?t:format("Number of schedulers configured: ~p~n", [NoSchedulers]), + ?line case erlang:system_info(multi_scheduling) of + blocked -> + ?line ?t:fail(multi_scheduling_blocked); + disabled -> + ?line ok; + enabled -> + ?t:format("Testing blocking process exit~n"), + BF = fun () -> + blocked = erlang:system_flag(multi_scheduling, + block), + Master ! {self(), blocking}, + receive after infinity -> ok end + end, + ?line Blocker = spawn_link(BF), + ?line Mon = erlang:monitor(process, Blocker), + ?line receive {Blocker, blocking} -> ok end, + ?line [Blocker] + = erlang:system_info(multi_scheduling_blockers), + ?line unlink(Blocker), + ?line exit(Blocker, kill), + ?line receive {'DOWN', Mon, _, _, _} -> ok end, + ?line enabled = erlang:system_info(multi_scheduling), + ?line [] = erlang:system_info(multi_scheduling_blockers), + ?line ok + end, + ?t:format("Testing blocked~n"), + ?line erlang:system_flag(multi_scheduling, block), + ?line case erlang:system_info(multi_scheduling) of + enabled -> + ?line ?t:fail(multi_scheduling_enabled); + blocked -> + ?line [Master] = erlang:system_info(multi_scheduling_blockers); + disabled -> ?line ok + end, + ?line Ps = lists:map( + fun (_) -> + spawn_link(fun () -> + run_on_schedulers(none, + [], + Master) + end) + end, + lists:seq(1,NoSchedulers)), + ?line receive after 1000 -> ok end, + ?line {_, 1} = verify_all_schedulers_used({[],0}, 1), + ?line lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, + Ps), + ?line case erlang:system_flag(multi_scheduling, unblock) of + blocked -> ?line ?t:fail(multi_scheduling_blocked); + disabled -> ?line ok; + enabled -> ?line ok + end, + erts_debug:set_internal_state(available_internal_state, true), + %% node_and_dist_references will use emulator interal thread blocking... + erts_debug:get_internal_state(node_and_dist_references), + erts_debug:set_internal_state(available_internal_state, false), + ?t:format("Testing not blocked~n"), + ?line Ps2 = lists:map( + fun (_) -> + spawn_link(fun () -> + run_on_schedulers(none, + [], + Master) + end) + end, + lists:seq(1,NoSchedulers)), + ?line receive after 1000 -> ok end, + ?line {_, NoSIDs} = verify_all_schedulers_used({[],0},NoSchedulers), + ?line lists:foreach(fun (P) -> + unlink(P), + exit(P, bang) + end, + Ps2), + NoSIDs + after + NoSchedulers = erlang:system_flag(schedulers_online, + NoSchedulersOnline), + NoSchedulersOnline = erlang:system_info(schedulers_online) + end, + ?line {comment, "Number of schedulers " ++ integer_to_list(UsedScheds)}. + + +run_on_schedulers(LastSID, SIDs, ReportTo) -> + case erlang:system_info(scheduler_id) of + LastSID -> + erlang:yield(), + run_on_schedulers(LastSID, SIDs, ReportTo); + SID -> + NewSIDs = case lists:member(SID, SIDs) of + true -> + SIDs; + false -> + ReportTo ! {scheduler_used, SID}, + [SID | SIDs] + end, + erlang:yield(), + run_on_schedulers(SID, NewSIDs, ReportTo) + end. + +wait_on_used_scheduler({SIDs, SIDsLen} = State) -> + receive + {scheduler_used, SID} -> + case lists:member(SID, SIDs) of + true -> + wait_on_used_scheduler(State); + false -> + ?t:format("Scheduler ~p used~n", [SID]), + {[SID|SIDs], SIDsLen+1} + end + end. + +verify_all_schedulers_used({UsedSIDs, UsedSIDsLen} = State, NoSchedulers) -> + ?line case NoSchedulers of + UsedSIDsLen -> + ?line State; + NoSchdlrs when NoSchdlrs < UsedSIDsLen -> + ?line ?t:fail({more_schedulers_used_than_exist, + {existing_schedulers, NoSchdlrs}, + {used_schedulers, UsedSIDsLen}, + {used_scheduler_ids, UsedSIDs}}); + _ -> + ?line NewState = wait_on_used_scheduler(State), + ?line verify_all_schedulers_used(NewState, NoSchedulers) + end. + +node_container_refc_check(doc) -> []; +node_container_refc_check(suite) -> []; +node_container_refc_check(Config) when is_list(Config) -> + ?line node_container_SUITE:node_container_refc_check(node()), + ?line ok. + +long_timers(doc) -> + []; +long_timers(suite) -> + []; +long_timers(Config) when is_list(Config) -> + ?line ok = long_timers_test:check_result(). + +pollset_size(doc) -> + []; +pollset_size(suite) -> + []; +pollset_size(Config) when is_list(Config) -> + ?line Name = pollset_size_testcase_initial_state_holder, + ?line Mon = erlang:monitor(process, Name), + ?line (catch Name ! {get_initial_check_io_result, self()}), + ?line InitChkIo = receive + {initial_check_io_result, ICIO} -> + ?line erlang:demonitor(Mon, [flush]), + ?line ICIO; + {'DOWN', Mon, _, _, Reason} -> + ?line ?t:fail({non_existing, Name, Reason}) + end, + ?line FinChkIo = get_check_io_info(), + ?line io:format("Initial: ~p~nFinal: ~p~n", [InitChkIo, FinChkIo]), + ?line InitPollsetSize = lists:keysearch(total_poll_set_size, 1, InitChkIo), + ?line FinPollsetSize = lists:keysearch(total_poll_set_size, 1, FinChkIo), + ?line case InitPollsetSize =:= FinPollsetSize of + true -> + case InitPollsetSize of + {value, {total_poll_set_size, Size}} -> + ?line {comment, + "Pollset size: " ++ integer_to_list(Size)}; + _ -> + ?line {skipped, + "Pollset size information not available"} + end; + false -> + %% Somtimes we have fewer descriptors in the + %% pollset at the end than when we started, but + %% that is ok as long as there are at least 2 + %% descriptors (dist listen socket and + %% epmd socket) in the pollset. + ?line {value, {total_poll_set_size, InitSize}} + = InitPollsetSize, + ?line {value, {total_poll_set_size, FinSize}} + = FinPollsetSize, + ?line true = FinSize < InitSize, + ?line true = 2 =< FinSize, + ?line {comment, + "Start pollset size: " + ++ integer_to_list(InitSize) + ++ " End pollset size: " + ++ integer_to_list(FinSize)} + end. + +check_io_debug(doc) -> + []; +check_io_debug(suite) -> + []; +check_io_debug(Config) when is_list(Config) -> + ?line case lists:keysearch(name, 1, erlang:system_info(check_io)) of + {value, {name, erts_poll}} -> ?line check_io_debug_test(); + _ -> ?line {skipped, "Not implemented in this emulator"} + end. + +check_io_debug_test() -> + ?line erts_debug:set_internal_state(available_internal_state, true), + ?line erlang:display(erlang:system_info(check_io)), + ?line NoOfErrorFds = erts_debug:get_internal_state(check_io_debug), + ?line erts_debug:set_internal_state(available_internal_state, false), + ?line 0 = NoOfErrorFds, + ?line ok. + + + +%% +%% Internal functions... +%% + +display_check_io(ChkIo) -> + catch erlang:display('--- CHECK IO INFO ---'), + catch erlang:display(ChkIo), + catch erts_debug:set_internal_state(available_internal_state, true), + NoOfErrorFds = (catch erts_debug:get_internal_state(check_io_debug)), + catch erlang:display({'NoOfErrorFds', NoOfErrorFds}), + catch erts_debug:set_internal_state(available_internal_state, false), + catch erlang:display('--- CHECK IO INFO ---'), + ok. + +get_check_io_info() -> + ChkIo = erlang:system_info(check_io), + case lists:keysearch(pending_updates, 1, ChkIo) of + {value, {pending_updates, 0}} -> + display_check_io(ChkIo), + ChkIo; + false -> + ChkIo; + _ -> + receive after 10 -> ok end, + get_check_io_info() + end. + + + diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops new file mode 100755 index 0000000000..2b7e8a6dde --- /dev/null +++ b/erts/emulator/utils/beam_makeops @@ -0,0 +1,1500 @@ +#!/usr/bin/env perl +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +use strict; +use vars qw($BEAM_FORMAT_NUMBER); + +$BEAM_FORMAT_NUMBER = undef; + +my $target = \&emulator_output; +my $outdir = "."; # Directory for output files. +my $verbose = 0; +my $hot = 1; +my $num_file_opcodes = 0; + +# This is shift counts and mask for the packer. +my $WHOLE_WORD = ''; +my @pack_instr; +my @pack_shift; +my @pack_mask; + +$pack_instr[2] = ['6', 'i']; +$pack_instr[3] = ['0', '0', 'i']; + +$pack_shift[2] = ['0', 'BEAM_LOOSE_SHIFT']; +$pack_shift[3] = ['0', 'BEAM_TIGHT_SHIFT', '(2*BEAM_TIGHT_SHIFT)']; + +$pack_mask[2] = ['BEAM_LOOSE_MASK', $WHOLE_WORD]; +$pack_mask[3] = ['BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK', 'BEAM_TIGHT_MASK']; + +# There are two types of instructions: generic and specific. +# The generic instructions are those generated by the Beam compiler. +# Corresponding to each generic instruction, there is generally a +# whole family of related specific instructions. Specific instructions +# are those executed by the VM interpreter during run-time. + +# Maximum number of operands for a generic instruction. +# In beam_load.c the MAX_OPARGS refers to the maximum +# number of operands for generic instructions. +my $max_gen_operands = 8; + +# Maximum number of operands for a specific instruction. +# Must be even. The beam_load.c file must be updated, too. +my $max_spec_operands = 6; + +my %gen_opnum; +my %num_specific; +my %gen_to_spec; +my %specific_op; + +my %gen_arity; +my @gen_arity; + +my @gen_opname; +my @op_to_name; + +my @obsolete; + +my %macro; +my %macro_flags; + +my %hot_code; +my %cold_code; + +my @unnumbered_generic; +my %unnumbered; + +# +# Code transformations. +# +my $te_max_vars = 0; # Max number of variables ever needed. +my %gen_transform; +my %min_window; +my %match_engine_ops; # All opcodes for the match engine. +my %gen_transform_offset; +my @transformations; +my @call_table; +my @pred_table; + +# Operand types for generic instructions. + +my $compiler_types = "uiaxyfhz"; +my $loader_types = "nprvlq"; +my $genop_types = $compiler_types . $loader_types; + +# +# Defines the argument types and their loaded size assuming no packing. +# +my %arg_size = ('r' => 0, # x(0) - x register zero + 'x' => 1, # x(N), N > 0 - x register + 'y' => 1, # y(N) - y register + 'i' => 1, # tagged integer + 'a' => 1, # tagged atom + 'n' => 0, # NIL (implicit) + 'c' => 1, # tagged constant (integer, atom, nil) + 's' => 1, # tagged source; any of the above + 'd' => 1, # tagged destination register (r, x, y) + 'f' => 1, # failure label + 'j' => 1, # either 'f' or 'p' + 'e' => 1, # pointer to export entry + 'L' => 0, # label + 'I' => 1, # untagged integer + 't' => 1, # untagged integer -- can be packed + 'b' => 1, # pointer to bif + 'A' => 1, # arity value + 'P' => 1, # byte offset into tuple + 'h' => 1, # character + 'l' => 1, # float reg + 'q' => 1, # literal term + ); + +# +# Generate bits. +# +my %type_bit; +my @tag_type; + +{ + my($bit) = 1; + my(%bit); + + foreach (split('', $genop_types)) { + push(@tag_type, $_); + $type_bit{$_} = $bit; + $bit{$_} = $bit; + $bit *= 2; + } + + # Composed types. + $type_bit{'d'} = $type_bit{'x'} | $type_bit{'y'} | $type_bit{'r'}; + $type_bit{'c'} = $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'} | $type_bit{'q'}; + $type_bit{'s'} = $type_bit{'d'} | $type_bit{'i'} | $type_bit{'a'} | $type_bit{'n'}; + $type_bit{'j'} = $type_bit{'f'} | $type_bit{'p'}; + + # Aliases (for matching purposes). + $type_bit{'I'} = $type_bit{'u'}; + $type_bit{'t'} = $type_bit{'u'}; + $type_bit{'A'} = $type_bit{'u'}; + $type_bit{'L'} = $type_bit{'u'}; + $type_bit{'b'} = $type_bit{'u'}; + $type_bit{'N'} = $type_bit{'u'}; + $type_bit{'U'} = $type_bit{'u'}; + $type_bit{'e'} = $type_bit{'u'}; + $type_bit{'P'} = $type_bit{'u'}; +} + +# +# Parse command line options. +# + +while (@ARGV && $ARGV[0] =~ /^-(.*)/) { + $_ = $1; + shift; + ($target = \&emulator_output), next if /^emulator/; + ($target = \&compiler_output), next if /^compiler/; + ($outdir = shift), next if /^outdir/; + ($verbose = 1), next if /^v/; + die "$0: Bad option: -$_\n"; +} + +# +# Parse the input files. +# + +while (<>) { + my($op_num); + chomp; + if (s/\\$//) { + $_ .= <>; + redo unless eof(ARGV); + } + next if /^\s*$/; + next if /^\#/; + + # + # Handle assignments. + # + if (/^([\w_][\w\d_]+)=(.*)/) { + no strict 'refs'; + my($name) = $1; + $$name = $2; + next; + } + + # + # Handle %hot/%cold. + # + if (/^\%hot/) { + $hot = 1; + next; + } elsif (/^\%cold/) { + $hot = 0; + next; + } + + # + # Handle macro definitions. + # + if (/^\%macro:(.*)/) { + my($op, $macro, @flags) = split(' ', $1); + defined($macro) and $macro =~ /^-/ and + &error("A macro must not start with a hyphen"); + foreach (@flags) { + /^-/ or &error("Flags for macros should start with a hyphen"); + } + error("Macro for '$op' is already defined") + if defined $macro{$op}; + $macro{$op} = $macro; + $macro_flags{$op} = join('', @flags); + next; + } + + # + # Handle transformations. + # + if (/=>/) { + &parse_transformation($_); + next; + } + + # + # Parse off the number of the operation. + # + $op_num = undef; + if (s/^(\d+):\s*//) { + $op_num = $1; + $op_num != 0 or &error("Opcode 0 invalid"); + &error("Opcode $op_num already defined") + if defined $gen_opname[$op_num]; + } + + # + # Parse: Name/Arity (generic instruction) + # + if (m@^(-)?(\w+)/(\d)\s*$@) { + my($obsolete) = $1; + my($name) = $2; + my($arity) = $3; + $name =~ /^[a-z]/ or &error("Opname must start with a lowercase letter"); + defined $gen_arity{$name} and $gen_arity{$name} != $arity and + &error("Opname $name already defined with arity $gen_arity{$name}"); + defined $unnumbered{$name,$arity} and + &error("Opname $name already defined with arity $gen_arity{$name}"); + + if (defined $op_num) { # Numbered generic operation + $gen_opname[$op_num] = $name; + $gen_arity[$op_num] = $arity; + $gen_opnum{$name,$arity} = $op_num; + $gen_arity{$name} = $arity; + $gen_to_spec{"$name/$arity"} = undef; + $num_specific{"$name/$arity"} = 0; + $min_window{"$name/$arity"} = 255; + $obsolete[$op_num] = $obsolete eq '-'; + } else { # Unnumbered generic operation. + push(@unnumbered_generic, [$name, $arity]); + $unnumbered{$name,$arity} = 1; + } + next; + } + + # + # Parse specific instructions (only present in emulator/loader): + # Name Arg1 Arg2... + # + my($name, @args) = split; + &error("too many operands") + if @args > $max_spec_operands; + &syntax_check($name, @args); + my $arity = @args; + if ($obsolete[$gen_opnum{$name,$arity}]) { + error("specific instructions may not be specified for obsolete instructions"); + } + push(@{$specific_op{"$name/$arity"}}, [$name, $hot, @args]); + if (defined $op_num) { + &error("specific instructions must not be numbered"); + } elsif (!defined($gen_arity{$name}) && !defined($unnumbered{$name,$arity})) { + # + # Create an unumbered generic instruction too. + # + push(@unnumbered_generic, [$name, $arity]); + $unnumbered{$name,$arity} = 1; + } +} continue { + close(ARGV) if eof(ARGV); +} + +$num_file_opcodes = @gen_opname; + +# +# Number all generic operations without numbers. +# +{ + my $ref; + + foreach $ref (@unnumbered_generic) { + my($name, $arity) = @$ref; + my $op_num = @gen_opname; + push(@gen_opname, $name); + push(@gen_arity, $arity); + $gen_opnum{$name,$arity} = $op_num; + $gen_arity{$name} = $arity; + $gen_to_spec{"$name/$arity"} = undef; + $num_specific{"$name/$arity"} = 0; + $min_window{"$name/$arity"} = 255; + } +} + +# +# Produce output for the chosen target. +# + +&$target; + +# +# Produce output needed by the emulator/loader. +# + +sub emulator_output { + my $i; + my $name; + my $key; # Loop variable. + + # + # Information about opcodes (beam_opcodes.c). + # + $name = "$outdir/beam_opcodes.c"; + open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + &comment('C'); + print "#ifdef HAVE_CONFIG_H\n"; + print "# include \"config.h\"\n"; + print "#endif\n\n"; + print '#include "sys.h"', "\n"; + print '#include "erl_vm.h"', "\n"; + print '#include "export.h"', "\n"; + print '#include "erl_process.h"', "\n"; + print '#include "bif.h"', "\n"; + print '#include "erl_atom_table.h"', "\n"; + print '#include "beam_load.h"', "\n"; + print "\n"; + + print "char tag_to_letter[] = {\n "; + for ($i = 0; $i < length($genop_types); $i++) { + print "'$tag_type[$i]', "; + } + for (; $i < @tag_type; $i++) { + print "'_', "; + } + print "\n};\n"; + print "\n"; + + # + # Generate code for specific ops. + # + my($spec_opnum) = 0; + print "OpEntry opc[] = {\n"; + foreach $key (sort keys %specific_op) { + $gen_to_spec{$key} = $spec_opnum; + $num_specific{$key} = @{$specific_op{$key}}; + + # + # Pick up all instructions and manufacture sort keys; we must have + # the most specific instructions appearing first (e.g. an 'x' operand + # should be matched before 's' or 'd'). + # + my(%items) = (); + foreach (@{$specific_op{$key}}) { + my($name, $hot, @args) = @{$_}; + my($sign) = join('', @args); + + # The primitive types should sort before other types. + + my($sort_key) = $sign; + eval "\$sort_key =~ tr/$genop_types/./"; + $sort_key .= ":$sign"; + $items{$sort_key} = [$name, $hot, $sign, @args]; + } + + # + # Now call the generator for the sorted result. + # + foreach (sort keys %items) { + my($name, $hot, $sign, @args) = @{$items{$_}}; + my $arity = @args; + my($instr) = "${name}_$sign"; + $instr =~ s/_$//; + + # + # Call a generator to calculate size and generate macros + # for the emulator. + # + my($size, $code, $pack) = &basic_generator($name, $hot, @args); + + # + # Save the generated $code for later. + # + if (defined $code) { + if ($hot) { + push(@{$hot_code{$code}}, $instr); + } else { + push(@{$cold_code{$code}}, $instr); + } + } + + # + # Calculate the bit mask which should be used to match this + # instruction. + # + + my(@bits) = (0) x ($max_spec_operands/2); + my($shift) = 16; + my($i); + for ($i = 0; $i < $max_spec_operands && defined $args[$i]; $i++) { + my $t = $args[$i]; + if (defined $type_bit{$t}) { + $bits[int($i/2)] |= $type_bit{$t} << (16*($i%2)); + } + } + + printf "/* %3d */ ", $spec_opnum; + my $print_name = $sign ne '' ? "${name}_$sign" : $name; + my $init = "{"; + my $sep = ""; + foreach (@bits) { + $init .= sprintf("%s0x%X", $sep, $_); + $sep = ","; + } + $init .= "}"; + &init_item($print_name, $init, $size, $pack, $sign, 0); + $op_to_name[$spec_opnum] = $instr; + $spec_opnum++; + } + } + print "};\n\n"; + print "int num_instructions = $spec_opnum;\n\n"; + + # + # Generate transformations. + # + + &tr_gen(@transformations); + + # + # Print the generic instruction table. + # + + print "GenOpEntry gen_opc[] = {\n"; + for ($i = 0; $i < @gen_opname; $i++) { + if ($i == $num_file_opcodes) { + print "\n/*\n * Internal generic instructions.\n */\n\n"; + } + my($name) = $gen_opname[$i]; + my($arity) = $gen_arity[$i]; + printf "/* %3d */ ", $i; + if (!defined $name) { + &init_item("", 0, 0, 0, -1); + } else { + my($key) = "$name/$arity"; + my($tr) = defined $gen_transform_offset{$key} ? + $gen_transform_offset{$key} : -1; + my($spec_op) = $gen_to_spec{$key}; + my($num_specific) = $num_specific{$key}; + defined $spec_op or $tr != -1 or + $obsolete[$gen_opnum{$name,$arity}] or + error("instruction $key has no specific instruction"); + $spec_op = -1 unless defined $spec_op; + &init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key}); + } + } + print "};\n"; + + # + # Information about opcodes (beam_opcodes.h). + # + $name = "$outdir/beam_opcodes.h"; + open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + &comment('C'); + print "#ifndef __OPCODES_H__\n"; + print "#define __OPCODES_H__\n\n"; + + print "#define BEAM_FORMAT_NUMBER $BEAM_FORMAT_NUMBER\n"; + print "#define MAX_GENERIC_OPCODE ", $num_file_opcodes-1, "\n"; + print "#define NUM_GENERIC_OPS ", scalar(@gen_opname), "\n"; + print "#define NUM_SPECIFIC_OPS ", scalar(@op_to_name), "\n"; + print "\n"; + print "#ifdef ARCH_64\n"; + print "# define BEAM_LOOSE_MASK 0x1FFFUL\n"; + print "# define BEAM_TIGHT_MASK 0x1FF8UL\n"; + print "# define BEAM_LOOSE_SHIFT 16\n"; + print "# define BEAM_TIGHT_SHIFT 16\n"; + print "#else\n"; + print "# define BEAM_LOOSE_MASK 0xFFF\n"; + print "# define BEAM_TIGHT_MASK 0xFFC\n"; + print "# define BEAM_LOOSE_SHIFT 16\n"; + print "# define BEAM_TIGHT_SHIFT 10\n"; + print "#endif\n"; + print "\n"; + + # + # Definitions of tags. + # + + my $letter; + my $tag_num = 0; + + &comment('C', "The following operand types for generic instructions", + "occur in beam files."); + foreach $letter (split('', $compiler_types)) { + print "#define TAG_$letter $tag_num\n"; + $tag_num++; + } + print "\n"; + &comment('C', "The following operand types are only used in the loader."); + foreach $letter (split('', $loader_types)) { + print "#define TAG_$letter $tag_num\n"; + $tag_num++; + } + print "\n#define BEAM_NUM_TAGS $tag_num\n\n"; + + $i = 0; + foreach (sort keys %match_engine_ops) { + print "#define $_ $i\n"; + $i++; + } + print "#define NUM_TOPS $i\n"; + print "\n"; + + print "#define TE_MAX_VARS $te_max_vars\n"; + print "\n"; + + print "extern char tag_to_letter[];\n"; + print "extern Uint op_transform[];\n"; + print "\n"; + + for ($i = 0; $i < @op_to_name; $i++) { + print "#define op_$op_to_name[$i] $i\n"; + } + print "\n"; + + print "#define NUMBER_OF_OPCODES ",scalar(@op_to_name),"\n"; + for ($i = 0; $i < @op_to_name; $i++) { + print "#define op_count_$op_to_name[$i] ",$i+scalar(@op_to_name),"\n"; + } + print "\n"; + + print "#define DEFINE_OPCODES"; + foreach (@op_to_name) { + print " \\\n&&lb_$_,"; + } + print "\n\n"; + + print "#define DEFINE_COUNTING_OPCODES"; + foreach (@op_to_name) { + print " \\\n&&lb_count_$_,"; + } + print "\n\n"; + + print "#define DEFINE_COUNTING_LABELS"; + for ($i = 0; $i < @op_to_name; $i++) { + my($name) = $op_to_name[$i]; + print " \\\nCountCase($name): opc[$i].count++; goto lb_$name;"; + } + print "\n\n"; + + for ($i = 0; $i < @gen_opname; $i++) { + print "#define genop_$gen_opname[$i]_$gen_arity[$i] $i\n" + if defined $gen_opname[$i]; + } + + + print "#endif\n"; + + + # + # Extension of transform engine. + # + + $name = "$outdir/beam_tr_funcs.h"; + open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + &comment('C'); + &tr_gen_call(@call_table); + + $name = "$outdir/beam_pred_funcs.h"; + open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + &comment('C'); + &tr_gen_call(@pred_table); + + # + # Implementation of operations for emulator. + # + $name = "$outdir/beam_hot.h"; + open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + &comment('C'); + &print_code(\%hot_code); + + $name = "$outdir/beam_cold.h"; + open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + &comment('C'); + &print_code(\%cold_code); + +} + +sub init_item { + my($sep) = ""; + + print "{"; + foreach (@_) { + if (!defined $_) { + print "${sep}NULL"; + } elsif (/^\{/) { + print "$sep$_"; + } elsif (/^-?\d/) { + print "$sep$_"; + } else { + print "$sep\"$_\""; + } + $sep = ", "; + } + print "},\n"; +} + +sub q { + my($str) = @_; + "\"$str\""; +} + +sub print_code { + my($ref) = @_; + my(%sorted); + my($key, $label); # Loop variables. + + foreach $key (keys %$ref) { + my($sort_key); + my($code) = ''; + foreach $label (@{$ref->{$key}}) { + $code .= "OpCase($label):\n"; + $sort_key = $label; + } + foreach (split("\n", $key)) { + $code .= " $_\n"; + } + $code .= "\n"; + $sorted{$sort_key} = $code; + } + + foreach (sort keys %sorted) { + print $sorted{$_}; + } +} + +# +# Produce output needed by the compiler back-end (assembler). +# + +sub compiler_output { + my($module) = 'beam_opcodes'; + my($name) = "${module}.erl"; + my($i); + + open(STDOUT, ">$outdir/$name") || die "Failed to open $name for writing: $!\n"; + print "-module($module).\n"; + &comment('erlang'); + + print "-export([format_number/0]).\n"; + print "-export([opcode/2,opname/1]).\n"; + print "\n"; + print "-spec format_number() -> $BEAM_FORMAT_NUMBER.\n"; + print "format_number() -> $BEAM_FORMAT_NUMBER.\n\n"; + + print "-spec opcode(atom(), 0..", $max_gen_operands, ") -> 1..", $num_file_opcodes-1, ".\n"; + for ($i = 0; $i < @gen_opname; $i++) { + next unless defined $gen_opname[$i]; + print "%%" if $obsolete[$i]; + print "opcode(", "e($gen_opname[$i]), ", $gen_arity[$i]) -> $i;\n"; + } + print "opcode(Name, Arity) -> erlang:error(badarg, [Name,Arity]).\n\n"; + + print "-spec opname(1..", $num_file_opcodes-1, ") -> {atom(),0..", $max_gen_operands, "}.\n"; + for ($i = 0; $i < @gen_opname; $i++) { + next unless defined $gen_opname[$i]; + print "opname($i) -> {", + "e($gen_opname[$i]), ",$gen_arity[$i]};\n"; + } + print "opname(Number) -> erlang:error(badarg, [Number]).\n"; + + # + # Generate .hrl file. + # + my($name) = "$outdir/${module}.hrl"; + open(STDOUT, ">$name") || die "Failed to open $name for writing: $!\n"; + &comment('erlang'); + + for ($i = 0; $i < @tag_type && $i < 8; $i++) { + print "-define(tag_$tag_type[$i], $i).\n"; + } + print "\n"; + +} + +# +# Check an operation for validity. +# +sub syntax_check { + my($name, @args) = @_; + my($i); + + &error("Bad opcode name '$name'") + unless $name =~ /^[a-z][\w\d_]*$/; + for ($i = 0; $i < @args; $i++) { + &error("Argument " . ($i+1) . ": invalid type '$args[$i]'") + unless defined $arg_size{$args[$i]}; + } +} + +sub error { + my(@message) = @_; + my($where) = $. ? "$ARGV($.): " : ""; + die $where, @message, "\n"; +} + +sub comment { + my($lang, @comments) = @_; + my($prefix); + + if ($lang eq 'C') { + print "/*\n"; + $prefix = " * "; + } elsif ($lang eq 'erlang') { + $prefix = '%% '; + } else { + $prefix = '# '; + } + my(@prog) = split('/', $0); + my($prog) = $prog[$#prog]; + + if (@comments) { + my $line; + foreach $line (@comments) { + print "$prefix$line\n"; + } + } else { + print "$prefix Warning: Do not edit this file. It was automatically\n"; + print "$prefix generated by '$prog' on ", (scalar localtime), ".\n"; + } + if ($lang eq 'C') { + print " */\n"; + } + print "\n"; +} + +# +# Basic implementation of instruction in emulator loop +# (assuming no packing). +# + +sub basic_generator { + my($name, $hot, @args) = @_; + my($size) = 0; + my($macro) = ''; + my($flags) = ''; + my(@f); + my(@f_types); + my($fail_type); + my($prefix) = ''; + my($tmp_arg_num) = 1; + my($pack_spec) = ''; + my($var_decls) = ''; + my($gen_dest_arg) = 'StoreSimpleDest'; + my($i); + + # The following argument types should be included as macro arguments. + my(%incl_arg) = ('c' => 1, + 'i' => 1, + 'a' => 1, + 'A' => 1, + 'N' => 1, + 'U' => 1, + 'I' => 1, + 't' => 1, + 'P' => 1, + ); + + # Pick up the macro to use and its flags (if any). + + $macro = $macro{$name} if defined $macro{$name}; + $flags = $macro_flags{$name} if defined $macro_flags{$name}; + + # + # Add any arguments to be included as macro arguments (for instance, + # 'p' is usually not an argument, except for calls). + # + + while ($flags =~ /-arg_(\w)/g) { + $incl_arg{$1} = 1; + }; + + # + # Pack arguments if requested. + # + + if ($flags =~ /-pack/ && $hot) { + ($prefix, $pack_spec, @args) = &do_pack(@args); + } + + # + # Calculate the size of the instruction and generate each argument for + # the macro. + # + + foreach (@args) { + my($this_size) = $arg_size{$_}; + SWITCH: + { + /^pack:(\d):(.*)/ and do { push(@f, $2); + push(@f_types, 'packed'); + $this_size = $1; + last SWITCH; + }; + /r/ and do { push(@f, "r(0)"); push(@f_types, $_); last SWITCH }; + /[xy]/ and do { push(@f, "$_" . "b(Arg($size))"); + push(@f_types, $_); + last SWITCH; + }; + /n/ and do { push(@f, "NIL"); push(@f_types, $_); last SWITCH }; + /s/ and do { my($tmp) = "targ$tmp_arg_num"; + $var_decls .= "Eterm $tmp; "; + $tmp_arg_num++; + push(@f, $tmp); + push(@f_types, $_); + $prefix .= "GetR($size, $tmp);\n"; + last SWITCH; }; + /d/ and do { $var_decls .= "Eterm dst; "; + push(@f, "dst"); + push(@f_types, $_); + $prefix .= "dst = Arg($size);\n"; + $gen_dest_arg = 'StoreResult'; + last SWITCH; + }; + defined($incl_arg{$_}) + and do { push(@f, "Arg($size)"); + push(@f_types, $_); + last SWITCH; + }; + + /[fp]/ and do { $fail_type = $_; last SWITCH }; + + /[eLIFEbASjPowlq]/ and do { last SWITCH; }; + + die "$name: The generator can't handle $_, at"; + } + $size += $this_size; + } + + # + # If requested, pass a pointer to the destination register. + # The destination must be the last operand. + # + if ($flags =~ /-gen_dest/) { + push(@f, $gen_dest_arg); + } + + # + # Add a fail action macro if requested. + # + + $flags =~ /-fail_action/ and do { + if (!defined $fail_type) { + my($i); + for ($i = 0; $i < @f_types; $i++) { + local($_) = $f_types[$i]; + /[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next }; + } + } elsif ($fail_type eq 'f') { + push(@f, "ClauseFail()"); + } else { + my($i); + for ($i = 0; $i < @f_types; $i++) { + local($_) = $f_types[$i]; + /[rxycians]/ and do { push(@f, "Badmatch($f[$i])"); next }; + } + } + }; + + # + # Add a size argument if requested. + # + + $flags =~ /-size/ and do { + push(@f, $size); + }; + + # Generate the macro if requested. + my($code); + if (defined $macro{$name}) { + my($macro_code) = "$prefix$macro(" . join(', ', @f) . ");"; + $var_decls .= "Uint tmp_packed1;" + if $macro_code =~ /tmp_packed1/; + $var_decls .= "Uint tmp_packed2;" + if $macro_code =~ /tmp_packed2/; + if ($flags =~ /-nonext/) { + $code = "$macro_code\n"; + } else { + $code = join("\n", + "{ $var_decls", + "Eterm* next;", + "PreFetch($size, next);", + "$macro_code", + "NextPF($size, next);", + "}", ""); + } + } + + # Return the size and code for the macro (if any). + $size++; + ($size, $code, $pack_spec); +} + +sub do_pack { + my(@args) = @_; + my($i); + my($packable_args) = 0; + + # + # Count the number of packable arguments. If we encounter any 's' or 'd' + # arguments, packing is not possible. + # + for ($i = 0; $i < @args; $i++) { + if ($args[$i] =~ /[xyt]/) { + $packable_args++; + } elsif ($args[$i] =~ /[sd]/) { + return ('', '', @args); + } + } + + # + # Get out of here if too few or too many arguments. + # + return ('', '', @args) if $packable_args < 2; + &error("too many packable arguments") if $packable_args > 4; + + my($size) = 0; + my($pack_prefix) = ''; + my($down) = ''; # Pack commands (towards instruction + # beginning). + my($up) = ''; # Pack commands (storing back while + # moving forward). + my($args_per_word) = $packable_args < 4 ? $packable_args : 2; + my(@shift) = @{$pack_shift[$args_per_word]}; + my(@mask) = @{$pack_mask[$args_per_word]}; + my(@pack_instr) = @{$pack_instr[$args_per_word]}; + + # + # Now generate the packing instructions. One complication is that + # the packing engine works from right-to-left, but we must generate + # the instructions from left-to-right because we must calculate + # instruction sizes from left-to-right. + # + # XXX Packing 3 't's in one word won't work. Sorry. + + my $did_some_packing = 0; # Nothing packed yet. + my($ap) = 0; # Argument number within word. + my($tmpnum) = 1; # Number of temporary variable. + my($expr) = ''; + for ($i = 0; $i < @args; $i++) { + my($reg) = $args[$i]; + my($this_size) = $arg_size{$reg}; + if ($reg =~ /[xyt]/) { + $this_size = 0; + $did_some_packing = 1; + + if ($ap == 0) { + $pack_prefix .= "tmp_packed$tmpnum = Arg($size);\n"; + $up .= "p"; + $down = "P$down"; + $this_size = 1; + } + + $down = "$pack_instr[$ap]$down"; + my($unpack) = &make_unpack($tmpnum, $shift[$ap], $mask[$ap]); + $args[$i] = "pack:$this_size:$reg" . "b($unpack)"; + + if (++$ap == $args_per_word) { + $ap = 0; + $tmpnum++; + } + } elsif ($arg_size{$reg} && $did_some_packing) { + # + # This is an argument that can't be packed. Normally, we must + # save it on the pack engine's stack, unless: + # + # 1. The argument has zero size (e.g. r(0)). Such arguments + # will not be loaded. They disappear. + # 2. If the argument is on the left of the first packed argument, + # the packing engine will never access it (because the engine + # operates from right-to-left). + # + + $down = "g${down}"; + $up = "${up}p"; + } + $size += $this_size; + } + + my $pack_spec = $down . $up; + return ($pack_prefix, $pack_spec, @args); +} + +sub make_unpack { + my($tmpnum, $shift, $mask) = @_; + + my($e) = "tmp_packed$tmpnum"; + $e = "($e>>$shift)" if $shift; + $e .= "&$mask" unless $mask eq $WHOLE_WORD; + $e; +} + +sub quote { + local($_) = @_; + return "'$_'" if $_ eq 'try'; + return "'$_'" if $_ eq 'catch'; + return "'$_'" if $_ eq 'receive'; + return "'$_'" if $_ =~ /^[A-Z]/; + $_; +} + +# +# Parse instruction transformations when they first appear. +# +sub parse_transformation { + local($_) = @_; + my($orig) = $_; + + my($from, $to) = split(/\s*=>\s*/); + my(@op); + + # The source instructions. + + my(@from) = split(/\s*\|\s*/, $from); + foreach (@from) { + if (/^(\w+)\((.*?)\)/) { + my($name, $arglist) = ($1, $2); + $_ = (&compile_transform_function($name, split(/\s*,\s*/, $arglist))); + } else { + (@op) = split; + $_ = &compile_transform(1, @op); + } + } + + # + # Check for a function which should be called to provide the new + # instructions if the left-hand side matched. Otherwise there is + # an explicit list of instructions. + # + + my @to; + if ($to =~ /^(\w+)\((.*?)\)/) { + my($name, $arglist) = ($1, $2); + @to = (&compile_transform_function($name, split(/\s*,\s*/, $arglist))); + } else { + @to = split(/\s*\|\s*/, $to); + foreach (@to) { + (@op) = split; + $_ = &compile_transform(0, @op); + } + } + push(@transformations, [$., $orig, [@from], [reverse @to]]); +} + +sub compile_transform_function { + my($name, @args) = @_; + + [".$name", 0, @args]; +} + +sub compile_transform { + my($src, $name, @ops) = @_; + my $arity = 0; + + foreach (@ops) { + my(@list) = &tr_parse_op($src, $_); + $arity++ unless $list[1] eq '*'; + $_ = [ @list ]; + } + + if ($obsolete[$gen_opnum{$name,$arity}]) { + error("obsolete function must not be used in transformations"); + } + + [$name,$arity,@ops]; +} + +sub tr_parse_op { + my($src, $op) = @_; + my($var) = ''; + my($type) = ''; + my($type_val) = 0; + my($cond) = ''; + my($cond_val) = ''; + + local($_) = $op; + + # Get the variable name if any. + + if (/^([A-Z]\w*)(.*)/) { + $var = $1; + $_ = $2; + &error("garbage after variable") + unless /^=(.*)/ or /^(\s*)$/; + $_ = $1; + } + + # Get the type if any. + + if (/^([a-z*]+)(.*)/) { + $type = $1; + $_ = $2; + foreach (split('', $type)) { + &error("bad type in $op") + unless defined $type_bit{$_} or $type eq '*'; + } + } + + # Get an optional condition. (In source.) + + if (/^==(.*)/) { + $cond = 'is_eq'; + $cond_val = $1; + $_ = ''; + } elsif (/^\$is_bif(.*)/) { + $cond = 'is_bif'; + $cond_val = -1; + $_ = $1; + } elsif (/^\$is_not_bif(.*)/) { + $cond = 'is_not_bif'; + $cond_val = -1; + $_ = $1; + } elsif (m@^\$bif:(\w+):(\w+)/(\d)(.*)@) { + $cond = 'is_bif'; + if ($1 eq 'erlang') { + $cond_val = "BIF_$2_$3"; + } else { + $cond_val = "BIF_$1_$2_$3"; + } + $_ = $4; + } elsif (m@^\$func:(\w+):(\w+)/([_\d])(.*)@) { + my $arity = $3 eq '_' ? 1024 : $3; + $cond = 'is_func'; + $cond_val = "$1:$2:$arity"; + $_ = $4; + } + + # Get an optional value. (In destination.) + if (/^=(.*)/) { + $type_val = $1; + $_ = ''; + } + + # Nothing more is allowed after the command. + + &error("garbage '$_' after operand: $op") + unless /^\s*$/; + + # Test that destination has no conditions. + + unless ($src) { + error("condition not allowed in destination: $op") + if $cond; + error("variable name and type cannot be combined in destination: $op") + if $var && $type; + } + + # Test that source has no values. + if ($src) { + error("value not allowed in source: $op") + if $type_val; + } + ($var,$type,$type_val,$cond,$cond_val); +} + +# +# Generate code for all transformations. +# + +sub tr_gen { + my(@g) = @_; + + my($ref, $key, $instr); # Loop variables. + + foreach $ref (@g) { + my($line, $orig_transform, $from_ref, $to_ref) = @$ref; + my $so_far = tr_gen_from($line, @$from_ref); + tr_gen_to($line, $orig_transform, $so_far, @$to_ref); + } + + # + # Print the generated transformation engine. + # + my($offset) = 0; + print "Uint op_transform[] = {\n"; + foreach $key (keys %gen_transform) { + $gen_transform_offset{$key} = $offset; + foreach $instr (@{$gen_transform{$key}}) { + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + print " "; + if (!defined $op) { + $comment =~ s/\n(.)/\n $1/g; + print "\n", $comment; + } else { + $op = "TOP_$op"; + $match_engine_ops{$op} = 1; + if ($comment ne '') { + printf "%-24s /* %s */\n", (join(", ", ($op, @args)) . ","), + $comment; + } else { + print join(", ", ($op, @args)), ",\n"; + } + $offset += $size; + } + } + print "\n"; + } + print "/*\n"; + print " * Total number of words: $offset\n"; + print " */\n"; + print "};\n\n"; +} + +sub tr_gen_from { + my($line, @tr) = @_; + my(%var) = (); + my(%var_type); + my($var_num) = 0; + my(@code); + my($min_window) = 0; + my(@fix_rest_args); + my(@fix_pred_funcs); + my($op, $ref); # Loop variables. + my $where = "left side of transformation in line $line: "; + + foreach $ref (@tr) { + my($name, $arity, @ops) = @$ref; + my($key) = "$name/$arity"; + my($opnum); + + # + # A name starting with a period is a C pred function to be called. + # + + if ($name =~ /^\.(\w+)/) { + $name = $1; + my $var; + my(@args); + + my $next_instr = pop(@code); # Get rid of 'next_instr' + push(@fix_pred_funcs, scalar(@code)); + push(@code, [$name, @ops]); + push(@code, $next_instr); + next; + } + + # + # Check that $name/$arity refers to a valid generic instruction. + # + + &error($where, "invalid generic op $name/$arity") + unless defined $gen_opnum{$name,$arity}; + $opnum = $gen_opnum{$name,$arity}; + + push(@code, &make_op("$name/$arity", 'is_op', $opnum)); + $min_window++; + foreach $op (@ops) { + my($var, $type, $type_val, $cond, $val) = @$op; + + if ($type ne '' && $type ne '*') { + my($types) = ''; + my($type_mask) = 0; + foreach (split('', $type)) { + $types .= "$_ "; + $type_mask |= $type_bit{$_}; + } + push(@code, &make_op($types, 'is_type', $type_mask)); + } + + if ($cond eq 'is_func') { + my($m, $f, $a) = split(/:/, $val); + push(@code, &make_op('', "$cond", "am_$m", + "am_$f", $a)); + } elsif ($cond ne '') { + push(@code, &make_op('', "$cond", $val)); + } + + if ($var ne '') { + if (defined $var{$var}) { + push(@code, &make_op($var, 'is_same_var', $var{$var})); + } elsif ($type eq '*') { + # + # Reserve a hole for a 'rest_args' instruction. + # + push(@fix_rest_args, scalar(@code)); + push(@code, $var); + } else { + $var_type{$var} = 'scalar'; + $var{$var} = $var_num; + $var_num++; + push(@code, &make_op($var, 'set_var', $var{$var})); + } + } + if (is_set_var_instr($code[$#code])) { + my $ref = pop @code; + my $comment = $ref->[2]; + my $var = $ref->[1][1]; + push(@code, make_op($comment, 'set_var_next_arg', $var)); + } else { + push(@code, &make_op('', 'next_arg')); + } + } + push(@code, &make_op('', 'next_instr')); + pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + } + + # + # Insert the commit operation. + # + pop(@code); # Get rid of 'next_instr' + push(@code, &make_op('', 'commit')); + + # + # If there is an rest_args instruction, we must insert its correct + # variable number (higher than any other). + # + my $index; + &error("only one use of a '*' variable is allowed on the left hand side of a transformation") + if @fix_rest_args > 1; + foreach $index (@fix_rest_args) { + my $var = $code[$index]; + $var{$var} = $var_num++; + $var_type{$var} = 'array'; + splice(@code, $index, 1, &make_op($var, 'rest_args', $var{$var})); + } + + foreach $index (@fix_pred_funcs) { + my($name, @ops) = @{$code[$index]}; + my(@args); + my $var; + + foreach $var (@ops) { + &error($where, "variable '$var' unbound") + unless defined $var{$var}; + if ($var_type{$var} eq 'scalar') { + push(@args, "var[$var{$var}]"); + } else { + push(@args, "var+$var{$var}"); + } + } + splice(@code, $index, 1, &make_op("$name()", + 'pred', scalar(@pred_table))); + push(@pred_table, [$name, @args]); + } + + $te_max_vars = $var_num + if $te_max_vars < $var_num; + [$min_window, \%var, \%var_type, \@code]; +} + +sub tr_gen_to { + my($line, $orig_transform, $so_far, @tr) = @_; + my($min_window, $var_ref, $var_type_ref, $code_ref) = @$so_far; + my(%var) = %$var_ref; + my(%var_type) = %$var_type_ref; + my(@code) = @$code_ref; + my($op, $ref); # Loop variables. + my($where) = "right side of transformation in line $line: "; + + foreach $ref (@tr) { + my($name, $arity, @ops) = @$ref; + + # + # A name starting with a period is a C function to be called. + # + + if ($name =~ /^\.(\w+)/) { + $name = $1; + my $var; + my(@args); + + foreach $var (@ops) { + &error($where, "variable '$var' unbound") + unless defined $var{$var}; + if ($var_type{$var} eq 'scalar') { + push(@args, "var[$var{$var}]"); + } else { + push(@args, "var+$var{$var}"); + } + } + pop(@code); # Get rid of 'next_instr' + push(@code, &make_op("$name()", 'call', scalar(@call_table))); + push(@call_table, [$name, @args]); + last; + } + + # + # Check that $name/$arity refers to a valid generic instruction. + # + + my($key) = "$name/$arity"; + &error($where, "invalid generic op $name/$arity") + unless defined $gen_opnum{$name,$arity}; + my $opnum = $gen_opnum{$name,$arity}; + + # + # Create code to build the generic instruction. + # + + push(@code, &make_op('', 'new_instr')); + push(@code, &make_op("$name/$arity", 'store_op', $opnum, $arity)); + foreach $op (@ops) { + my($var, $type, $type_val) = @$op; + + if ($var ne '') { + &error($where, "variable '$var' unbound") + unless defined $var{$var}; + push(@code, &make_op($var, 'store_var', $var{$var})); + } elsif ($type ne '') { + push(@code, &make_op('', 'store_type', "TAG_$type")); + if ($type_val) { + push(@code, &make_op('', 'store_val', $type_val)); + } + } + push(@code, &make_op('', 'next_arg')); + } + pop(@code) if $code[$#code]->[1][0] eq 'next_arg'; + } + + push(@code, &make_op('', 'end')); + + # + # Chain together all codes segments having the same first operation. + # + my($first_ref) = shift(@code); + my($size, $first, $key) = @$first_ref; + my($dummy, $op, $arity) = @$first; + my($comment) = "\n/*\n * Line $line:\n * $orig_transform\n */\n\n"; + $min_window{$key} = $min_window + if $min_window{$key} > $min_window; + + pop(@{$gen_transform{$key}}) + if defined @{$gen_transform{$key}}; # Fail + my(@prefix) = (&make_op($comment), &make_op('', 'try_me_else', &tr_code_len(@code))); + unshift(@code, @prefix); + push(@{$gen_transform{$key}}, @code, &make_op('', 'fail')); +} + +sub tr_code_len { + my($sum) = 0; + my($ref); + + foreach $ref (@_) { + $sum += $$ref[0]; + } + $sum; +} + +sub make_op { + my($comment, @op) = @_; + [scalar(@op), [@op], $comment]; +} + +sub is_set_var_instr { + my($ref) = @_; + return 0 unless ref($ref) eq 'ARRAY'; + $ref->[1][0] eq 'set_var'; +} + +sub tr_gen_call { + my(@call_table) = @_; + my($i); + + print "\n"; + for ($i = 0; $i < @call_table; $i++) { + my $ref = $call_table[$i]; + my($name, @args) = @$ref; + print "case $i: RVAL = $name(", join(', ', 'st', @args), "); break;\n"; + } + print "\n"; +} diff --git a/erts/emulator/utils/beam_strip b/erts/emulator/utils/beam_strip new file mode 100755 index 0000000000..1ce0fea180 --- /dev/null +++ b/erts/emulator/utils/beam_strip @@ -0,0 +1,89 @@ +#!/usr/bin/env perl +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +use strict; + +for (@ARGV) { + open(IN, "<$_") or do {warn "skipping $_:$!\n"; next}; + my $data; + sysread(IN, $data, 10000000); + close IN; + my $new_file = eval {slim_beam($data)}; + open(OUT, ">$_") or die "Failed to write $_:$!\n"; + print OUT $new_file; + close OUT; +} + +# Bug in 5.6.0: The following doesn't work. +#local $/; +#while (<>) { +# my $new_file = eval {slim_beam($_)}; +# if ($@) { +# ... +# } else { +# ... +# } +#} + +sub slim_beam { + my($beam) = @_; + my $size_left = length($beam); + my @chunk; + + die "can't read Beam files for OTP R4 or earlier (sorry)" + if $beam =~ /^\x7fBEAM!/; + + # + # Read and verify the head of the IFF file. + # + + my ($id, $size, $beam_id) = unpack("a4Na4", $beam); + die "not a BEAM file: no IFF 'FOR1' chunk" + unless $id eq 'FOR1'; + $size_left -= 8; + die "form size $size greater than size ", $size_left, " of module" + if $size > $size_left; + $size_left -= 4; + die "not a BEAM file: IFF form type is not 'BEAM'" + unless $beam_id eq 'BEAM'; + + # + # Read all IFF chunks. + # + + $beam = substr($beam, 12, $size_left); + while ($size_left > 0) { + ($id, $size) = unpack("a4N", $beam); + $size_left -= 8; + die "chunk size $size greater than size ", $size_left, " of module" + if $size > $size_left; + $size = 4*int(($size+3)/4); + my $chunk = substr($beam, 0, $size+8); + $beam = substr($beam, 8+$size); + $size_left = length($beam); + push(@chunk, $chunk) + unless $id eq 'LocT' || $id eq 'CInf'; + } + + # + # Create new Beam file. + # + my $new_file = join('', @chunk); + "FOR1" . pack("N", length($new_file)+4) . "BEAM" . $new_file; +} diff --git a/erts/emulator/utils/make_alloc_types b/erts/emulator/utils/make_alloc_types new file mode 100755 index 0000000000..53051b7692 --- /dev/null +++ b/erts/emulator/utils/make_alloc_types @@ -0,0 +1,672 @@ +#!/usr/bin/env perl +# -*- cperl -*- + +# %CopyrightBegin% +# +# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% + +use strict; +# use warnings; + +use File::Basename; + +# +# Description: +# Generates a header file containing defines for memory allocation types +# from type declarations in a config file. +# +# Usage: +# make_alloc_types -src -dst +# +# Options: +# -src +# -dst +# [ ...] +# +# Author: Rickard Green +# + +my $myname = basename($0); +my $src; +my $dst; +my %bool_vars; + +while (@ARGV && $ARGV[0]) { + my $opt = shift; + if ($opt eq '-src') { + $src = shift; + $src or die "$myname: Missing source file\n"; + } elsif ($opt eq '-dst') { + $dst = shift; + $dst or die "$myname: Missing destination file\n"; + } else { + $bool_vars{$opt} = 'true'; + } +} + +$src or usage("Missing source file"); +$dst or usage("Missing destination file"); + +open(SRC, "<$src") or die "$myname: Failed to open $src in read mode\n"; + +my $line; +my $line_no = 0; +my $decl; + +my %a_tab; +my %c_tab; +my %t_tab; +my %d_tab; +my @a_order; +my @c_order; +my @t_order; + +my @cond_stack; + +############################################################################# +# Parse source file +############################################################################# + +while ($line = ) { + $line_no = $line_no + 1; + $line = preprocess_line($line); + + if ($line =~ /^(\S+)\s*(.*)/) { + $decl = $1; + $line = $2; + + if ($decl eq 'type') { + if ($line =~ /^(\w+)\s+(\w+)\s+(\w+)\s+(\w+)\s*$/) { + my $t = $1; + my $a = $2; + my $c = $3; + my $d = $4; + + check_reserved_words('type', $t, $d); + + my $a_entry = $a_tab{$a}; + $a_entry or src_error("No allocator '$a' declared"); + my $c_entry = $c_tab{$c}; + $c_entry or src_error("No class '$c' declared"); + + !$t_tab{$t} or src_error("Type '$t' already declared"); + my $d_user = $d_tab{$d}; + !$d_user or duplicate_descr($d, $d_user); + + $t_tab{$t} = mk_entry($d, $a, $c); + add_type($a_entry, $t); + + $d_tab{$d} = "type '$t'"; + + } else { + invalid_decl($decl); + } + } elsif ($decl eq 'allocator') { + if ($line =~ /^(\w+)\s+(\w+)\s+(\w+)\s*$/) { + my $a = $1; + my $mt = $2; + my $d = $3; + + check_reserved_words('allocator', $a, $d); + + !$a_tab{$a} or src_error("Allocator '$a' already declared"); + my $d_user = $d_tab{$d}; + !$d_user or duplicate_descr($d, $d_user); + + my $e = mk_entry($d); + $a_tab{$a} = $e; + + if ($mt =~ /^true$/) { + set_multi_thread($e); + } + else { + $mt =~ /^false$/ or src_error("Multi-thread option not a boolean"); + } + + $d_tab{$d} = "allocator '$a'"; + + push(@a_order, $a); + + } else { + invalid_decl($decl); + } + } elsif ($decl eq 'class') { + if ($line =~ /^(\w+)\s+(\w+)\s*$/) { + my $c = $1; + my $d = $2; + + check_reserved_words('class', $c, $d); + + !$c_tab{$c} or src_error("Class '$c' already declared"); + my $d_user = $d_tab{$d}; + !$d_user or duplicate_descr($d, $d_user); + + $c_tab{$c} = mk_entry($d); + + $d_tab{$d} = "class '$c'"; + + } else { + invalid_decl($decl); + } + } else { + src_error("Unknown '$decl' declaration found"); + } + } +} + +close(SRC) or warn "$myname: Error closing $src"; + +check_cond_stack(); + +############################################################################# +# Create destination file +############################################################################# + +mkdir(dirname($dst), 0777); +open(DST, ">$dst") or die "$myname: Failed to open $dst in write mode\n"; + +print DST "/* + * ----------------------------------------------------------------------- + * + * NOTE: Do *not* edit this file; instead, edit '", basename($src),"' and + * build again! This file was automatically generated by + * '$myname' on ", (scalar localtime), ". + * + * ----------------------------------------------------------------------- + * + * + * Copyright Ericsson AB ", (1900 + (localtime)[5]), ". All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the \"License\"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an \"AS IS\" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + */ + +#ifndef ERL_ALLOC_TYPES_H__ +#define ERL_ALLOC_TYPES_H__ + +"; + +my $a_no = 1; +my $c_no = 1; +my $t_no = 1; + +# Print allocator numbers ------------------------------------------------- + +print DST " +/* --- Allocator numbers -------------------------------------------------- */ + +#define ERTS_ALC_A_INVALID (0) + +"; + +print DST "#define ERTS_ALC_A_MIN ($a_no)\n\n"; + +foreach my $a (@a_order) { + set_number($a_tab{$a}, $a_no); + print DST "#define ERTS_ALC_A_$a ($a_no)\n"; + $a_no++; +} +$a_no--; + +print DST "\n#define ERTS_ALC_A_MAX ($a_no)\n"; + +# Print class numbers ----------------------------------------------------- + +print DST " + +/* --- Class numbers ------------------------------------------------------ */ + +#define ERTS_ALC_C_INVALID (0) + +"; + +print DST "#define ERTS_ALC_C_MIN ($c_no)\n\n"; + +foreach my $c (keys(%c_tab)) { + push(@c_order, $c); + set_number($c_tab{$c}, $c_no); + print DST "#define ERTS_ALC_C_$c ($c_no)\n"; + $c_no++; +} +$c_no--; +print DST "\n#define ERTS_ALC_C_MAX ($c_no)\n"; + +# Print type number intervals --------------------------------------------- + +print DST " + +/* --- Type number intervals ---------------------------------------------- */ + +#define ERTS_ALC_N_INVALID (0) + +"; + +print DST "#define ERTS_ALC_N_MIN ($t_no)\n\n"; + +foreach my $a (@a_order) { + my $a_entry = $a_tab{$a}; + my $ts = get_types($a_entry); + my $n_ts = @{$ts}; + if ($n_ts > 0) { + + print DST "/* Type numbers used for ", get_description($a_entry), " */\n"; + print DST "#define ERTS_ALC_N_MIN_A_$a ($t_no)\n"; + + foreach my $t (@{$ts}) { + push(@t_order, $t); + set_number($t_tab{$t}, $t_no); +# print DST "#define ERTS_ALC_N_$t ($t_no)\n"; + $t_no++; + } + + print DST "#define ERTS_ALC_N_MAX_A_$a (", $t_no - 1, ")\n\n"; + } + else { + print DST "/* No types use ", get_description($a_entry), " */\n\n"; + } +} +$t_no--; +print DST "#define ERTS_ALC_N_MAX ($t_no)\n"; + +# Print multi thread use of allocators ------------------------------------- + +print DST " + +/* --- Multi thread use of allocators -------------------------------------- */ + +"; + +foreach my $a (@a_order) { + my $mt = get_multi_thread($a_tab{$a}); + print DST "#define ERTS_ALC_MTA_$a (", $mt ? "1" : "0" ,")\n"; +} + + +# Calculate field sizes, masks, and shifts needed -------------------------- + +my $a_bits = fits_in_bits($a_no); +my $c_bits = fits_in_bits($c_no); +my $n_bits = fits_in_bits($t_no); +my $t_bits = $a_bits + $n_bits + $c_bits; + +$n_bits <= 16 + # Memory trace format expects type numbers to fit into an Uint16 + or die("$myname: ", $t_no + 1, " types declared;", + " maximum number of types allowed are ", (1 << 16),"\n"); + +$t_bits <= 24 + # We want 8 bits for flags (we actually only use 1 bit for flags + # at the time of writing)... + or die("$myname: More allocators, classes, and types declared than ", + "allowed\n"); + +my $a_mask = (1 << $a_bits) - 1; +my $c_mask = (1 << $c_bits) - 1; +my $n_mask = (1 << $n_bits) - 1; +my $t_mask = (1 << $t_bits) - 1; + +my $a_shift = 0; +my $c_shift = $a_bits + $a_shift; +my $n_shift = $c_bits + $c_shift; + + +# Print the types ---------------------------------------------------------- + +print DST " + +/* --- Types --------------------------------------------------------------- */ + +typedef Uint32 ErtsAlcType_t; /* The type used for memory types */ + +#define ERTS_ALC_T_INVALID (0) + +"; + +foreach my $t (@t_order) { + print DST + "#define ERTS_ALC_T_$t (", + ((get_number($a_tab{get_allocator($t_tab{$t})}) << $a_shift) + | (get_number($c_tab{get_class($t_tab{$t})}) << $c_shift) + | (get_number($t_tab{$t}) << $n_shift)), + ")\n"; +} + + + +# Print field sizes, masks, and shifts needed ------------------------------ + +print DST " + +/* --- Field sizes, masks, and shifts -------------------------------------- */ + +#define ERTS_ALC_A_BITS ($a_bits) +#define ERTS_ALC_C_BITS ($c_bits) +#define ERTS_ALC_N_BITS ($n_bits) +#define ERTS_ALC_T_BITS ($t_bits) + +#define ERTS_ALC_A_MASK ($a_mask) +#define ERTS_ALC_C_MASK ($c_mask) +#define ERTS_ALC_N_MASK ($n_mask) +#define ERTS_ALC_T_MASK ($t_mask) + +#define ERTS_ALC_A_SHIFT ($a_shift) +#define ERTS_ALC_C_SHIFT ($c_shift) +#define ERTS_ALC_N_SHIFT ($n_shift) +"; + +# Print mappings needed ---------------------------------------------------- + +print DST " + +/* --- Mappings ------------------------------------------------------------ */ + +/* type -> type number */ +#define ERTS_ALC_T2N(T) (((T) >> ERTS_ALC_N_SHIFT) & ERTS_ALC_N_MASK) + +/* type -> allocator number */ +#define ERTS_ALC_T2A(T) (((T) >> ERTS_ALC_A_SHIFT) & ERTS_ALC_A_MASK) + +/* type -> class number */ +#define ERTS_ALC_T2C(T) (((T) >> ERTS_ALC_C_SHIFT) & ERTS_ALC_C_MASK) + +/* type number -> type */ +#define ERTS_ALC_N2T(N) (erts_alc_n2t[(N)]) + +/* type number -> type description */ +#define ERTS_ALC_N2TD(N) (erts_alc_n2td[(N)]) + +/* type -> type description */ +#define ERTS_ALC_T2TD(T) (ERTS_ALC_N2TD(ERTS_ALC_T2N((T)))) + +/* class number -> class description */ +#define ERTS_ALC_C2CD(C) (erts_alc_c2cd[(C)]) + +/* allocator number -> allocator description */ +#define ERTS_ALC_A2AD(A) (erts_alc_a2ad[(A)]) + +extern const ErtsAlcType_t erts_alc_n2t[]; +extern const char *erts_alc_n2td[]; +extern const char *erts_alc_c2cd[]; +extern const char *erts_alc_a2ad[]; + +#ifdef ERTS_ALC_INTERNAL__ + +const ErtsAlcType_t erts_alc_n2t[] = { + ERTS_ALC_T_INVALID, +"; + +foreach my $t (@t_order) { + print DST " ERTS_ALC_T_$t,\n"; +} + +print DST " ERTS_ALC_T_INVALID +}; + +const char *erts_alc_n2td[] = { + \"invalid_type\", +"; + +foreach my $t (@t_order) { + print DST " \"", get_description($t_tab{$t}), "\",\n"; +} + +print DST " NULL +}; + +const char *erts_alc_c2cd[] = { + \"invalid_class\", +"; + +foreach my $c (@c_order) { + print DST " \"", get_description($c_tab{$c}), "\",\n"; +} + +print DST " NULL +}; + +const char *erts_alc_a2ad[] = { + \"invalid_allocator\", +"; + +foreach my $a (@a_order) { + print DST " \"", get_description($a_tab{$a}), "\",\n"; +} + +print DST " NULL +}; +"; + +print DST " +#endif /* #ifdef ERTS_ALC_INTERNAL__ */ +"; + +# End of DST +print DST " + +/* ------------------------------------------------------------------------- */ +#endif /* #ifndef ERL_ALLOC_TYPES_H__ */ +"; + + +close(DST) or warn "$myname: Error closing $dst"; + +exit; + +############################################################################# +# Help routines +############################################################################# + +sub fits_in_bits { + my $val = shift; + my $bits; + + $val >= 0 or die "Expected value >= 0; got $val"; + + $bits = 0; + + while ($val != 0) { + $val >>= 1; + $bits++; + } + + return $bits; +} + +############################################################################# +# Table entries +# + +sub mk_entry { + my $d = shift; + my $a = shift; + my $c = shift; + return [$d, undef, [], $a, $c, undef]; +} + +sub get_description { + my $entry = shift; + return $entry->[0]; +} + +sub get_number { + my $entry = shift; + return $entry->[1]; +} + +sub get_types { + my $entry = shift; + return $entry->[2]; +} + +sub get_allocator { + my $entry = shift; + return $entry->[3]; +} + +sub get_class { + my $entry = shift; + return $entry->[4]; +} + +sub set_number { + my $entry = shift; + my $number = shift; + $entry->[1] = $number; +} + +sub add_type { + my $entry = shift; + my $t = shift; + push(@{$entry->[2]}, $t); +} + +sub set_multi_thread { + my $entry = shift; + $entry->[5] ='true'; +} + +sub get_multi_thread { + my $entry = shift; + return $entry->[5]; +} + +############################################################################# +# Preprocessing of a line + +sub preprocess_line { + my $line = shift; + $line =~ s/#.*$//; + $line =~ /^\s*(.*)$/; + $line = $1; + + if (!@cond_stack) { + push(@cond_stack, [undef, undef, undef, 'true', undef]); + } + + my $see_line = $cond_stack[@cond_stack - 1]->[3]; + + if ($line =~ /^(\S+)(.*)$/) { + my $ifdefop = $1; + my $ifdefarg = $2; + + if ($ifdefop eq '+if') { + $ifdefarg =~ /^\s*(\w+)\s*$/ or src_error("Bad '+if'"); + my $var = $1; + if ($see_line) { + $see_line = $bool_vars{$var}; + } + push(@cond_stack, ['+if', $var, undef, $see_line, $line_no]); + $see_line = undef; + } + elsif ($ifdefop eq '+ifnot') { + $ifdefarg =~ /^\s*(\w+)\s*$/ or src_error("Bad '+ifnot'"); + my $var = $1; + if ($see_line) { + $see_line = !$bool_vars{$var}; + } + push(@cond_stack, ['+ifnot', $var, undef, $see_line, $line_no]); + $see_line = undef; + } + elsif ($ifdefop eq '+else') { + $ifdefarg =~ /^\s*$/ or src_error("Garbage after '+else'"); + my $val = $cond_stack[@cond_stack - 1]; + $val->[0] or src_error("'+else' not matching anything"); + !$val->[2] or src_error("duplicate '+else'"); + $val->[2] = 'else'; + if ($see_line || $cond_stack[@cond_stack - 2]->[3]) { + $val->[3] = !$val->[3]; + } + $see_line = undef; + } + elsif ($ifdefop eq '+endif') { + $ifdefarg =~ /^\s*$/ or src_error("Garbage after '+endif'"); + my $val = pop(@cond_stack); + $val->[0] or src_error("'+endif' not matching anything"); + $see_line = undef; + } + elsif ($see_line) { + if ($ifdefop eq '+enable') { + $ifdefarg =~ /^\s*(\w+)\s*$/ or src_error("Bad '+enable'"); + $bool_vars{$1} = 'true'; + $see_line = undef; + } + elsif ($ifdefop eq '+disable') { + $ifdefarg =~ /^\s*(\w+)\s*$/ or src_error("Bad '+disable'"); + $bool_vars{$1} = undef; + $see_line = undef; + } + } + } + + return $see_line ? $line : ""; +} + +sub check_cond_stack { + my $val = $cond_stack[@cond_stack - 1]; + if ($val->[0]) { + $line_no = $val->[4]; + src_error("'", $val->[0], " ", $val->[1], "' not terminated\n"); + } +} + +sub check_reserved_words { + my $sort = shift; + my $name = shift; + my $descr = shift; + + !($name eq 'INVALID') + or src_error("Reserved $sort 'INVALID' declared"); + !($descr eq 'invalid_allocator') + or src_error("Reserved description 'invalid_allocator' used"); + !($descr eq 'invalid_class') + or src_error("Reserved description 'invalid_class' used"); + !($descr eq 'invalid_type') + or src_error("Reserved description 'invalid_type' used"); +} + +############################################################################# +# Error cases + +sub usage { + warn "$myname: ", @_, "\n"; + die "Usage: $myname -src -dst [ ...]\n"; +} + +sub src_error { + die "$src:$line_no: ", @_, "\n"; +} + +sub duplicate_descr { + my $d = shift; + my $u = shift; + src_error("Description '$d' already used for '$u'"); +} + +sub invalid_decl { + my $decl = shift; + src_error("Invalid '$decl' declaration"); +} + +############################################################################# diff --git a/erts/emulator/utils/make_driver_tab b/erts/emulator/utils/make_driver_tab new file mode 100755 index 0000000000..fbbfa3e49e --- /dev/null +++ b/erts/emulator/utils/make_driver_tab @@ -0,0 +1,71 @@ +#!/usr/bin/env perl +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +use strict; +use File::Basename; + +# This program generates driver_tab.c which holds the driver_tab +# array. Since the contents of driver_tab will depend on which +# drivers we wish to include it has to be generated. + +# usage: make_driver_tab [-o filename] drivers... + +my $file = ""; +my @drivers = (); + +while (@ARGV) { + my $d = shift; + if ( $d =~ /^-o$/ ) { + $file = shift or die("-o requires argument"); + next; + } + $d = basename $d; + $d =~ s/drv(\..*|)$//; # strip drv.* or just drv + push(@drivers, $d); +} + +# Did we want output to a file? +if ( $file ) { + open(STDOUT, ">$file") or die("can't open $file for writing"); +} + +print < +#include "global.h" + +EOF + +# "extern" declarations +foreach (@drivers) { + print "extern ErlDrvEntry ${_}driver_entry;\n"; +} + +# The array itself +print "\nErlDrvEntry *driver_tab[DRIVER_TAB_SIZE] =\n{\n"; + +foreach (@drivers) { + print " &${_}driver_entry,\n"; +} + +print " NULL\n};\n"; + +# That's it diff --git a/erts/emulator/utils/make_preload b/erts/emulator/utils/make_preload new file mode 100755 index 0000000000..d0671e998d --- /dev/null +++ b/erts/emulator/utils/make_preload @@ -0,0 +1,209 @@ +#!/usr/bin/env perl +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +use strict; +use File::Basename; + +# +# Description: +# Packages one erlang module in a form that can be preloaded (C source +# for Unix or resource script for Windows). The output is written to +# standard output. +# +# Usage: +# make_preload [ Options ] file.{jam,beam} +# +# Options: +# -rc Produce a resource script rather than C source. +# +# Author: +# Bjorn Gustavsson +# + +my $gen_rc = 0; +my $gen_old = 0; +my $windres = 0; +my $file; + +my $progname = basename($0); + +while (@ARGV && $ARGV[0] =~ /^-(\w+)/) { + my $opt = shift; + if ($opt eq '-rc') { + $gen_rc = 1; + } elsif ($opt eq '-windres') { + $windres = 1; + } elsif ($opt eq '-old') { + $gen_old = 1; + } else { + usage("bad option: $opt"); + } +} + +print header(); + +my @modules; +my $num = 1; + +foreach $file (@ARGV) { + local($/); + + usage("not a beam file") + unless $file =~ /\.beam$/; + my $module = basename($file, ".beam"); + if ($gen_rc) { + my ($win_file) = split("\n", `(cygpath -d $file 2>/dev/null || cygpath -w $file)`); + $win_file =~ s&\\&\\\\&g; + print "$num ERLANG_CODE \"$win_file\"\n"; + push(@modules, " ", -s $file, "L, $num, ", + length($module), ",\"$module\",\n"); + $num++; + } else { + my $i; + my $comment = ''; + + open(FILE, $file) or error("failed to read $file: $!"); + $_ = ; + $_ = beam_strip($_); + close(FILE); + + push(@modules, " {\"$module\", " . length($_) . ", preloaded_$module},\n"); + print "unsigned preloaded_size_$module = ", length($_), ";\n"; + print "unsigned char preloaded_$module", "[] = {\n"; + for ($i = 0; $i < length($_); $i++) { + if ($i % 8 == 0 && $comment ne '') { + $comment =~ s@\*/@..@g; # Comment terminator. + print " /* $comment */\n "; + $comment = ''; + } + my $c = ord(substr($_, $i, 1)); + printf("0x%02x,", $c); + $comment .= (32 <= $c && $c < 127) ? chr($c) : '.'; + } + $comment =~ s@\*/@..@g; # Comment terminator. + print " " x (8-($i % 8)), " /* $comment */\n};\n"; + } +} + +if ($windres) { + $modules[$#modules] =~ s/,$//; +} + +if ($gen_rc) { + print "#include \n"; + $num--; + print "\n0 ERLANG_DICT\n"; + print "BEGIN\n"; + print " $num,\n"; + print @modules; + print "END\n"; +} elsif ($gen_old) { + print "struct {\n"; + print " char* name;\n"; + print " int size;\n"; + print " unsigned char* code;\n"; + print "} pre_loaded[] = {\n"; + foreach (@modules) { + print; + } + print " {0, 0, 0}\n"; + print "};\n"; +} + +sub usage { + warn "$progname: ", @_, "\n"; + die "usage: $progname -o output-directory file.{jam,beam}\n"; +} + +sub error { + die "$progname: ", @_, "\n"; +} + +sub beam_strip { + my($beam) = @_; + + + my $size_left = length($beam); + my %chunk; + my %needed_chunk = ('Code' => 1, + 'Atom' => 1, + 'ImpT' => 1, + 'ExpT' => 1, + 'StrT' => 1, + 'FunT' => 1, + 'LitT' => 1); + + die "can't read Beam files for OTP R4 or earlier (sorry)" + if $beam =~ /^\x7fBEAM!/; + + # + # Read and verify the head of the IFF file. + # + + my ($id, $size, $beam_id) = unpack("a4Na4", $beam); + + return $beam # It might be compressed. + unless $id eq 'FOR1'; +# die "not a BEAM file: no IFF 'FOR1' chunk" +# unless $id eq 'FOR1'; + $size_left -= 8; + die "form size $size greater than size ", $size_left, " of module" + if $size > $size_left; + $size_left -= 4; + die "not a BEAM file: IFF form type is not 'BEAM'" + unless $beam_id eq 'BEAM'; + + # + # Read all IFF chunks. + # + + $beam = substr($beam, 12, $size_left); + while ($size_left > 0) { + ($id, $size) = unpack("a4N", $beam); + $size_left -= 8; + die "chunk size $size greater than size ", $size_left, " of module" + if $size > $size_left; + $size = 4*int(($size+3)/4); + $chunk{$id} = substr($beam, 0, 8+$size); + $beam = substr($beam, 8+$size); + $size_left = length($beam); + } + + # + # Create a new beam file with only the useful chunk types. + # + + my @chunks; + foreach (sort keys %chunk) { + push(@chunks, $chunk{$_}) + if $needed_chunk{$_}; + } + $beam = join('', @chunks); + join('', "FOR1", pack("N", length($beam)+4), "BEAM", $beam); +} + +sub header { + my $time = localtime; + </erl_am.c +# <-src>/erl_bif_table.c +# <-src>/erl_bif_wrap.c +# <-src>/erl_pbifs.c +# <-include>/erl_atom_table.h +# <-include>/erl_bif_table.h +# +# Author: Bjorn Gustavsson +# + +my $progname = basename($0); +my $src = '.'; +my $include = '.'; + +my @atom; +my %atom; +my %atom_alias; +my %aliases; +my $auto_alias_num = 0; + +my @bif; +my @implementation; +my @pbif; + +while (@ARGV && $ARGV[0] =~ /^-(\w+)/) { + my $opt = shift; + if ($opt eq '-src') { + $src = shift; + die "No directory for -src argument specified" + unless defined $src; + } elsif($opt eq '-include') { + $include = shift; + die "No directory for -include argument specified" + unless defined $include; + } else { + usage("bad option: $opt"); + } +} + + +while (<>) { + next if /^#/; + next if /^\s*$/; + my($type, @args) = split; + if ($type eq 'atom') { + save_atoms(@args); + } elsif ($type eq 'bif' or $type eq 'ubif') { + my($bif,$alias,$alias2) = (@args); + $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF"); + my($mod,$name,$arity) = ($1,$2,$3); + save_atoms($mod, $name); + unless (defined $alias) { + $alias = ""; + $alias = "${mod}_" unless $mod eq 'erlang'; + $alias .= "${name}_$arity"; + } + my $wrapper; + $wrapper = "wrap_$alias" if $type eq 'bif'; + $wrapper = $alias if $type eq 'ubif'; + push(@bif, ["am_$atom_alias{$mod}","am_$atom_alias{$name}",$arity, + $alias,$wrapper]); + push(@pbif, $bif =~ m/^'/ && $alias =~ m/^ebif_/); + push(@implementation, $alias2); + } else { + error("invalid line"); + } +} continue { + close ARGV if eof; +} + +# +# Generate the atom header file. +# + +open_file("$include/erl_atom_table.h"); +print <[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$i)\n"; +} + +# +# Generate the bif header file. +# + +open_file("$include/erl_bif_table.h"); +my $bif_size = @bif; +print <[3] $i\n"; +} + +print "\n"; + +for ($i = 0; $i < @bif; $i++) { + my $arity = $bif[$i]->[2]; + my $args = join(', ', 'Process*', ('Eterm') x $arity); + print "Eterm $bif[$i]->[3]($args);\n"; + print "Eterm wrap_$bif[$i]->[3]($args, Uint *I);\n"; +} +print "#endif\n"; + +# +# Generate the bif table file. +# + +open_file("$src/erl_bif_table.c"); +my $i; +includes("export.h", "sys.h", "erl_vm.h", "erl_process.h", "bif.h", + "erl_bif_table.h", "erl_atom_table.h"); + +print "\nExport* bif_export[BIF_SIZE];\n"; +print "unsigned char erts_bif_trace_flags[BIF_SIZE];\n\n"; + +print "BifEntry bif_table[] = {\n"; +for ($i = 0; $i < @bif; $i++) { + my $func = $bif[$i]->[3]; + print " {", join(', ', @{$bif[$i]}), "},\n"; +} +print "};\n\n"; + +# +# Generate the bif wrappers file. +# + +open_file("$src/erl_bif_wrap.c"); +my $i; +includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h", + "erl_bif_table.h", "erl_atom_table.h"); +for ($i = 0; $i < @bif; $i++) { + next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs + my $arity = $bif[$i]->[2]; + my $func = $bif[$i]->[3]; + my $arg; + print "Eterm\n"; + print "wrap_$func(Process* p"; + for ($arg = 1; $arg <= $arity; $arg++) { + print ", Eterm arg$arg"; + } + print ", Uint *I)\n"; + print "{\n"; + print " return erts_bif_trace($i, p"; + for ($arg = 1; $arg <= 3; $arg++) { + if ($arg <= $arity) { + print ", arg$arg"; + } elsif ($arg == ($arity + 1)) { + # Place I in correct position + print ", (Eterm) I"; + } else { + print ", 0"; + } + } + # I is always last, as well as in the correct position + # Note that "last" and "correct position" may be the same... + print ", I);\n"; + print "}\n\n"; +} + +# +# Generate the package bif file. +# + +open_file("$src/erl_pbifs.c"); +my $i; +includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h", + "erl_bif_table.h", "erl_atom_table.h"); +for ($i = 0; $i < @bif; $i++) { + my $arity = $bif[$i]->[2]; + my $func = $bif[$i]->[3]; + my $arg; + next unless $pbif[$i]; + next unless $func =~ m/^ebif_(.*)/; + my $orig_func = $1; + $orig_func = $implementation[$i] if $implementation[$i]; + print "Eterm\n"; + print "$func(Process* p"; + for ($arg = 1; $arg <= $arity; $arg++) { + print ", Eterm arg$arg"; + } + print ")\n"; + print "{\n"; + print " return $orig_func(p"; + for ($arg = 1; $arg <= 3; $arg++) { + if ($arg <= $arity) { + print ", arg$arg"; + } + } + print ");\n"; + print "}\n\n"; +} + +sub open_file { # or die + my($name) = @_; + + open(FILE, ">$name") or die "$0: Failed to create $name: $!\n"; + select(FILE); + comment('C'); +} + +sub includes { + print "#ifdef HAVE_CONFIG_H\n"; + print "# include \"config.h\"\n"; + print "#endif /* HAVE_CONFIG_H */\n"; + print map { "#include \"$_\"\n"; } @_; + print "\n"; +} + +sub save_atoms { + my $atom; + my $alias; + + foreach $atom (@_) { + if ($atom =~ /^\w+$/) { + error("$atom: an atom must start with a lowercase letter\n", + " (use an alias like this: $atom='$atom')") + unless $atom =~ /^[a-z]/; + $alias = $atom; + } elsif ($atom =~ /^'(.*)'$/) { + $atom = $1; + $alias = "_AtomAlias$auto_alias_num"; + $auto_alias_num++; + } elsif ($atom =~ /^(\w+)='(.*)'$/) { + $alias = $1; + $atom = $2; + error("$alias: an alias must start with an uppercase letter") + unless $alias =~ /^[A-Z]/; + } else { + error("invalid atom: $atom"); + } + next if $atom{$atom}; + push(@atom, $atom); + $atom{$atom} = 1; + + if (defined $alias) { + error("$alias: this alias is already in use") + if defined $aliases{$alias} && $aliases{$alias} ne $atom; + $aliases{$alias} = $atom; + $atom_alias{$atom} = $alias; + } + } +} + +sub usage { + warn "$progname: ", @_, "\n"; + die "usage: $progname -src source-dir -include include-dir file...\n"; +} + +sub error { + die "$ARGV($.): ", @_, "\n"; +} + +sub comment { + my($lang, @comments) = @_; + my($prefix); + + if ($lang eq 'C') { + print "/*\n"; + $prefix = " * "; + } elsif ($lang eq 'erlang') { + $prefix = '%% '; + } else { + $prefix = '# '; + } + my(@prog) = split('/', $0); + my($prog) = $prog[$#prog]; + + if (@comments) { + my $line; + foreach $line (@comments) { + print "$prefix$line\n"; + } + } else { + print "$prefix Warning: Do not edit this file. It was automatically\n"; + print "$prefix generated by '$progname' on ", (scalar localtime), ".\n"; + } + if ($lang eq 'C') { + print " */\n"; + } + print "\n"; +} diff --git a/erts/emulator/utils/make_version b/erts/emulator/utils/make_version new file mode 100755 index 0000000000..7757fa8138 --- /dev/null +++ b/erts/emulator/utils/make_version @@ -0,0 +1,63 @@ +#!/usr/bin/env perl +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +use strict; + +# Create the file erl_version.h +# +# Usage: +# make_version [ -o outputfile ] version architecture +# +# Output goes to ./erl_version.h (or to "outputfile" if specified) +# + +my $time_str = localtime; +my $outputfile = "erl_version.h"; + +@ARGV or die "No arguments given to 'make_version'"; + +if ($ARGV[0] eq '-o') { + shift; # Remove -o + $outputfile = shift; + defined $outputfile or die "No output file specified"; +} + +my $release = shift; +defined $release or die "No release specified"; + +my $version = shift; +defined $version or die "No version name specified"; + +my $architecture = shift; +defined $architecture or die "No architecture specified"; +$architecture =~ s&^.*[/\\]&&; # Remove directory part if any + +open(FILE, ">$outputfile") or die "Can't create $outputfile: $!"; + +print FILE < +#include +#include +#include + +int +main(argc, argv) +int argc; +char** argv; +{ + FILE *file; + time_t now; + char *cnow; + + if (argc != 2) { + fprintf(stderr, "usage: mkver version\n"); + exit(1); + } + + if ((file = fopen("erl_version.h", "wb")) == NULL) { + fprintf(stderr, "Could not create file 'erl_version.h'!\n"); + exit(1); + } + + time(&now); + cnow = ctime(&now); + cnow[24] = '\0'; /* tidelipom */ + fprintf(file, "/* This file was created by mkver -- don't modify.*/\n"); + fprintf(file, "#define ERLANG_VERSION \"%s\"\n", argv[1]); + fprintf(file, "#define ERLANG_COMPILE_DATE \"%s\"\n", cnow); + fclose(file); + + exit(0); + return 0; +} diff --git a/erts/emulator/zlib/Makefile b/erts/emulator/zlib/Makefile new file mode 100644 index 0000000000..def8e1aa47 --- /dev/null +++ b/erts/emulator/zlib/Makefile @@ -0,0 +1,23 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# Invoke with GNU make or clearmake -C gnu. +# + +include $(ERL_TOP)/make/run_make.mk diff --git a/erts/emulator/zlib/Makefile.in b/erts/emulator/zlib/Makefile.in new file mode 100644 index 0000000000..5c99b460c1 --- /dev/null +++ b/erts/emulator/zlib/Makefile.in @@ -0,0 +1,116 @@ +# Makefile for zlib +# Copyright (C) 1995-1996 Jean-loup Gailly. +# For conditions of distribution and use, see copyright notice in zlib.h + +# %ExternalCopyright% + +# To compile and test, type: +# ./configure; make test +# The call of configure is optional if you don't have special requirements + +# To install /usr/local/lib/libz.* and /usr/local/include/zlib.h, type: +# make install +# To install in $HOME instead of /usr/local, use: +# make install prefix=$HOME + +ARFLAGS = rc +ifeq ($(findstring ose,$(TARGET)),ose) + TYPE_FLAGS = +else + TYPE_FLAGS = -O3 +endif +CFLAGS = @CFLAGS@ @DEFS@ @EMU_THR_DEFS@ $(TYPE_FLAGS) +#CFLAGS=-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7 +#CFLAGS=-g -DDEBUG +#CFLAGS=-O3 -Wall -Wwrite-strings -Wpointer-arith -Wconversion \ +# -Wstrict-prototypes -Wmissing-prototypes + +VER=1.0.4 + +O = adler32.o compress.o crc32.o uncompr.o deflate.o trees.o \ + zutil.o inflate.o inftrees.o inffast.o +OBJS = $(O:%=$(OBJDIR)/%) + + +#### Begin OTP targets + +include $(ERL_TOP)/make/target.mk + +# On windows we need a separate zlib during debug build +ifeq ($(TARGET),win32) + +ifeq ($(TYPE),debug) +CFLAGS = $(subst -O2, -g, @CFLAGS@ @DEFS@ @DEBUG_FLAGS@) +endif # debug + +else # win32 + +ifeq ($(TYPE),gcov) +CFLAGS = $(subst -O2, -g, -O0 -fprofile-arcs -ftest-coverage @CFLAGS@ @DEFS@ @DEBUG_FLAGS@) +TYPE_FLAGS= +else # gcov +# On other platforms we use no special debug version of zlib +endif # gcov + +endif # win32 + +OBJDIR= $(ERL_TOP)/erts/emulator/zlib/obj/$(TARGET)/$(TYPE) + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +ifeq ($(TARGET), win32) +LIBRARY=$(OBJDIR)/z.lib +else +LIBRARY=$(OBJDIR)/libz.a +endif + +all: $(LIBRARY) + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + +tests release_tests: + +docs release_docs release_docs_spec: + +clean: + rm -f $(OBJS) $(OBJDIR)/libz.a + +#### end OTP targets + +ifeq ($(TARGET), win32) +$(LIBRARY): $(OBJS) + $(AR) -out:$@ $(OBJS) +else +$(LIBRARY): $(OBJS) + $(AR) $(ARFLAGS) $@ $(OBJS) + -@ ($(RANLIB) $@ || true) 2>/dev/null +endif + +$(OBJDIR)/%.o: %.c + $(CC) -c $(CFLAGS) -o $@ $< + +# DO NOT DELETE THIS LINE -- make depend depends on it. + +adler32.o: zlib.h zconf.h +compress.o: zlib.h zconf.h +crc32.o: zlib.h zconf.h +deflate.o: deflate.h zutil.h zlib.h zconf.h +example.o: zlib.h zconf.h +gzio.o: zutil.h zlib.h zconf.h +infblock.o: infblock.h inftrees.h infcodes.h infutil.h zutil.h zlib.h zconf.h +infcodes.o: zutil.h zlib.h zconf.h +infcodes.o: inftrees.h infblock.h infcodes.h infutil.h inffast.h +inffast.o: zutil.h zlib.h zconf.h inftrees.h +inffast.o: infblock.h infcodes.h infutil.h inffast.h +inflate.o: zutil.h zlib.h zconf.h infblock.h +inftrees.o: zutil.h zlib.h zconf.h inftrees.h +infutil.o: zutil.h zlib.h zconf.h infblock.h inftrees.h infcodes.h infutil.h +minigzip.o: zlib.h zconf.h +trees.o: deflate.h zutil.h zlib.h zconf.h +uncompr.o: zlib.h zconf.h +zutil.o: zutil.h zlib.h zconf.h diff --git a/erts/emulator/zlib/adler32.c b/erts/emulator/zlib/adler32.c new file mode 100644 index 0000000000..4368c31d70 --- /dev/null +++ b/erts/emulator/zlib/adler32.c @@ -0,0 +1,154 @@ +/* adler32.c -- compute the Adler-32 checksum of a data stream + * Copyright (C) 1995-2004 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* @(#) $Id$ */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#define ZLIB_INTERNAL +#include "zlib.h" + +#define BASE 65521UL /* largest prime smaller than 65536 */ +#define NMAX 5552 +/* NMAX is the largest n such that 255n(n+1)/2 + (n+1)(BASE-1) <= 2^32-1 */ + +#define DO1(buf,i) {adler += (buf)[i]; sum2 += adler;} +#define DO2(buf,i) DO1(buf,i); DO1(buf,i+1); +#define DO4(buf,i) DO2(buf,i); DO2(buf,i+2); +#define DO8(buf,i) DO4(buf,i); DO4(buf,i+4); +#define DO16(buf) DO8(buf,0); DO8(buf,8); + +/* use NO_DIVIDE if your processor does not do division in hardware */ +#ifdef NO_DIVIDE +# define MOD(a) \ + do { \ + if (a >= (BASE << 16)) a -= (BASE << 16); \ + if (a >= (BASE << 15)) a -= (BASE << 15); \ + if (a >= (BASE << 14)) a -= (BASE << 14); \ + if (a >= (BASE << 13)) a -= (BASE << 13); \ + if (a >= (BASE << 12)) a -= (BASE << 12); \ + if (a >= (BASE << 11)) a -= (BASE << 11); \ + if (a >= (BASE << 10)) a -= (BASE << 10); \ + if (a >= (BASE << 9)) a -= (BASE << 9); \ + if (a >= (BASE << 8)) a -= (BASE << 8); \ + if (a >= (BASE << 7)) a -= (BASE << 7); \ + if (a >= (BASE << 6)) a -= (BASE << 6); \ + if (a >= (BASE << 5)) a -= (BASE << 5); \ + if (a >= (BASE << 4)) a -= (BASE << 4); \ + if (a >= (BASE << 3)) a -= (BASE << 3); \ + if (a >= (BASE << 2)) a -= (BASE << 2); \ + if (a >= (BASE << 1)) a -= (BASE << 1); \ + if (a >= BASE) a -= BASE; \ + } while (0) +# define MOD4(a) \ + do { \ + if (a >= (BASE << 4)) a -= (BASE << 4); \ + if (a >= (BASE << 3)) a -= (BASE << 3); \ + if (a >= (BASE << 2)) a -= (BASE << 2); \ + if (a >= (BASE << 1)) a -= (BASE << 1); \ + if (a >= BASE) a -= BASE; \ + } while (0) +#else +# define MOD(a) a %= BASE +# define MOD4(a) a %= BASE +#endif + +/* ========================================================================= */ +uLong ZEXPORT adler32(adler, buf, len) + uLong adler; + const Bytef *buf; + uInt len; +{ + unsigned long sum2; + unsigned n; + + /* split Adler-32 into component sums */ + sum2 = (adler >> 16) & 0xffff; + adler &= 0xffff; + + /* in case user likes doing a byte at a time, keep it fast */ + if (len == 1) { + adler += buf[0]; + if (adler >= BASE) + adler -= BASE; + sum2 += adler; + if (sum2 >= BASE) + sum2 -= BASE; + return adler | (sum2 << 16); + } + + /* initial Adler-32 value (deferred check for len == 1 speed) */ + if (buf == Z_NULL) + return 1L; + + /* in case short lengths are provided, keep it somewhat fast */ + if (len < 16) { + while (len--) { + adler += *buf++; + sum2 += adler; + } + if (adler >= BASE) + adler -= BASE; + MOD4(sum2); /* only added so many BASE's */ + return adler | (sum2 << 16); + } + + /* do length NMAX blocks -- requires just one modulo operation */ + while (len >= NMAX) { + len -= NMAX; + n = NMAX / 16; /* NMAX is divisible by 16 */ + do { + DO16(buf); /* 16 sums unrolled */ + buf += 16; + } while (--n); + MOD(adler); + MOD(sum2); + } + + /* do remaining bytes (less than NMAX, still just one modulo) */ + if (len) { /* avoid modulos if none remaining */ + while (len >= 16) { + len -= 16; + DO16(buf); + buf += 16; + } + while (len--) { + adler += *buf++; + sum2 += adler; + } + MOD(adler); + MOD(sum2); + } + + /* return recombined sums */ + return adler | (sum2 << 16); +} + +/* ========================================================================= */ +uLong ZEXPORT adler32_combine(adler1, adler2, len2) + uLong adler1; + uLong adler2; + z_off_t len2; +{ + unsigned long sum1; + unsigned long sum2; + unsigned rem; + + /* the derivation of this formula is left as an exercise for the reader */ + rem = (unsigned)(len2 % BASE); + sum1 = adler1 & 0xffff; + sum2 = rem * sum1; + MOD(sum2); + sum1 += (adler2 & 0xffff) + BASE - 1; + sum2 += ((adler1 >> 16) & 0xffff) + ((adler2 >> 16) & 0xffff) + BASE - rem; + if (sum1 > BASE) sum1 -= BASE; + if (sum1 > BASE) sum1 -= BASE; + if (sum2 > (BASE << 1)) sum2 -= (BASE << 1); + if (sum2 > BASE) sum2 -= BASE; + return sum1 | (sum2 << 16); +} diff --git a/erts/emulator/zlib/compress.c b/erts/emulator/zlib/compress.c new file mode 100644 index 0000000000..28bceb15f8 --- /dev/null +++ b/erts/emulator/zlib/compress.c @@ -0,0 +1,84 @@ +/* compress.c -- compress a memory buffer + * Copyright (C) 1995-2003 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* @(#) $Id$ */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#define ZLIB_INTERNAL +#include "zlib.h" + +/* =========================================================================== + Compresses the source buffer into the destination buffer. The level + parameter has the same meaning as in deflateInit. sourceLen is the byte + length of the source buffer. Upon entry, destLen is the total size of the + destination buffer, which must be at least 0.1% larger than sourceLen plus + 12 bytes. Upon exit, destLen is the actual size of the compressed buffer. + + compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_BUF_ERROR if there was not enough room in the output buffer, + Z_STREAM_ERROR if the level parameter is invalid. +*/ +int ZEXPORT compress2 (dest, destLen, source, sourceLen, level) + Bytef *dest; + uLongf *destLen; + const Bytef *source; + uLong sourceLen; + int level; +{ + z_stream stream; + int err; + + stream.next_in = (Bytef*)source; + stream.avail_in = (uInt)sourceLen; +#ifdef MAXSEG_64K + /* Check for source > 64K on 16-bit machine: */ + if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; +#endif + stream.next_out = dest; + stream.avail_out = (uInt)*destLen; + if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; + + stream.zalloc = (alloc_func)0; + stream.zfree = (free_func)0; + stream.opaque = (voidpf)0; + + err = deflateInit(&stream, level); + if (err != Z_OK) return err; + + err = deflate(&stream, Z_FINISH); + if (err != Z_STREAM_END) { + deflateEnd(&stream); + return err == Z_OK ? Z_BUF_ERROR : err; + } + *destLen = stream.total_out; + + err = deflateEnd(&stream); + return err; +} + +/* =========================================================================== + */ +int ZEXPORT compress (dest, destLen, source, sourceLen) + Bytef *dest; + uLongf *destLen; + const Bytef *source; + uLong sourceLen; +{ + return compress2(dest, destLen, source, sourceLen, Z_DEFAULT_COMPRESSION); +} + +/* =========================================================================== + If the default memLevel or windowBits for deflateInit() is changed, then + this function needs to be updated. + */ +uLong ZEXPORT compressBound (sourceLen) + uLong sourceLen; +{ + return sourceLen + (sourceLen >> 12) + (sourceLen >> 14) + 11; +} diff --git a/erts/emulator/zlib/crc32.c b/erts/emulator/zlib/crc32.c new file mode 100644 index 0000000000..b9c10bb9b3 --- /dev/null +++ b/erts/emulator/zlib/crc32.c @@ -0,0 +1,428 @@ +/* crc32.c -- compute the CRC-32 of a data stream + * Copyright (C) 1995-2005 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + * + * Thanks to Rodney Brown for his contribution of faster + * CRC methods: exclusive-oring 32 bits of data at a time, and pre-computing + * tables for updating the shift register in one step with three exclusive-ors +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + * instead of four steps with four exclusive-ors. This results in about a + * factor of two increase in speed on a Power PC G4 (PPC7455) using gcc -O3. + */ + +/* %ExternalCopyright% */ + +/* @(#) $Id$ */ + +/* + Note on the use of DYNAMIC_CRC_TABLE: there is no mutex or semaphore + protection on the static variables used to control the first-use generation + of the crc tables. Therefore, if you #define DYNAMIC_CRC_TABLE, you should + first call get_crc_table() to initialize the tables before allowing more than + one thread to use crc32(). + */ + +#ifdef MAKECRCH +# include +# ifndef DYNAMIC_CRC_TABLE +# define DYNAMIC_CRC_TABLE +# endif /* !DYNAMIC_CRC_TABLE */ +#endif /* MAKECRCH */ + +#include "zutil.h" /* for STDC and FAR definitions */ + +#define local static + +/* Find a four-byte integer type for crc32_little() and crc32_big(). */ +#ifndef NOBYFOUR +# ifdef STDC /* need ANSI C limits.h to determine sizes */ +# include +# define BYFOUR +# if (UINT_MAX == 0xffffffffUL) + typedef unsigned int u4; +# else +# if (ULONG_MAX == 0xffffffffUL) + typedef unsigned long u4; +# else +# if (USHRT_MAX == 0xffffffffUL) + typedef unsigned short u4; +# else +# undef BYFOUR /* can't find a four-byte integer type! */ +# endif +# endif +# endif +# endif /* STDC */ +#endif /* !NOBYFOUR */ + +/* Definitions for doing the crc four data bytes at a time. */ +#ifdef BYFOUR +# define REV(w) (((w)>>24)+(((w)>>8)&0xff00)+ \ + (((w)&0xff00)<<8)+(((w)&0xff)<<24)) + local unsigned long crc32_little OF((unsigned long, + const unsigned char FAR *, unsigned)); + local unsigned long crc32_big OF((unsigned long, + const unsigned char FAR *, unsigned)); +# define TBLS 8 +#else +# define TBLS 1 +#endif /* BYFOUR */ + +/* Local functions for crc concatenation */ +local unsigned long gf2_matrix_times OF((unsigned long *mat, + unsigned long vec)); +local void gf2_matrix_square OF((unsigned long *square, unsigned long *mat)); + +#ifdef DYNAMIC_CRC_TABLE + +local volatile int crc_table_empty = 1; +local unsigned long FAR crc_table[TBLS][256]; +local void make_crc_table OF((void)); +#ifdef MAKECRCH + local void write_table OF((FILE *, const unsigned long FAR *)); +#endif /* MAKECRCH */ +/* + Generate tables for a byte-wise 32-bit CRC calculation on the polynomial: + x^32+x^26+x^23+x^22+x^16+x^12+x^11+x^10+x^8+x^7+x^5+x^4+x^2+x+1. + + Polynomials over GF(2) are represented in binary, one bit per coefficient, + with the lowest powers in the most significant bit. Then adding polynomials + is just exclusive-or, and multiplying a polynomial by x is a right shift by + one. If we call the above polynomial p, and represent a byte as the + polynomial q, also with the lowest power in the most significant bit (so the + byte 0xb1 is the polynomial x^7+x^3+x+1), then the CRC is (q*x^32) mod p, + where a mod b means the remainder after dividing a by b. + + This calculation is done using the shift-register method of multiplying and + taking the remainder. The register is initialized to zero, and for each + incoming bit, x^32 is added mod p to the register if the bit is a one (where + x^32 mod p is p+x^32 = x^26+...+1), and the register is multiplied mod p by + x (which is shifting right by one and adding x^32 mod p if the bit shifted + out is a one). We start with the highest power (least significant bit) of + q and repeat for all eight bits of q. + + The first table is simply the CRC of all possible eight bit values. This is + all the information needed to generate CRCs on data a byte at a time for all + combinations of CRC register values and incoming bytes. The remaining tables + allow for word-at-a-time CRC calculation for both big-endian and little- + endian machines, where a word is four bytes. +*/ +local void make_crc_table() +{ + unsigned long c; + int n, k; + unsigned long poly; /* polynomial exclusive-or pattern */ + /* terms of polynomial defining this crc (except x^32): */ + static volatile int first = 1; /* flag to limit concurrent making */ + static const unsigned char p[] = {0,1,2,4,5,7,8,10,11,12,16,22,23,26}; + + /* See if another task is already doing this (not thread-safe, but better + than nothing -- significantly reduces duration of vulnerability in + case the advice about DYNAMIC_CRC_TABLE is ignored) */ + if (first) { + first = 0; + + /* make exclusive-or pattern from polynomial (0xedb88320UL) */ + poly = 0UL; + for (n = 0; n < sizeof(p)/sizeof(unsigned char); n++) + poly |= 1UL << (31 - p[n]); + + /* generate a crc for every 8-bit value */ + for (n = 0; n < 256; n++) { + c = (unsigned long)n; + for (k = 0; k < 8; k++) + c = c & 1 ? poly ^ (c >> 1) : c >> 1; + crc_table[0][n] = c; + } + +#ifdef BYFOUR + /* generate crc for each value followed by one, two, and three zeros, + and then the byte reversal of those as well as the first table */ + for (n = 0; n < 256; n++) { + c = crc_table[0][n]; + crc_table[4][n] = REV(c); + for (k = 1; k < 4; k++) { + c = crc_table[0][c & 0xff] ^ (c >> 8); + crc_table[k][n] = c; + crc_table[k + 4][n] = REV(c); + } + } +#endif /* BYFOUR */ + + crc_table_empty = 0; + } + else { /* not first */ + /* wait for the other guy to finish (not efficient, but rare) */ + while (crc_table_empty) + ; + } + +#ifdef MAKECRCH + /* write out CRC tables to crc32.h */ + { + FILE *out; + + out = fopen("crc32.h", "w"); + if (out == NULL) return; + fprintf(out, "/* crc32.h -- tables for rapid CRC calculation\n"); + fprintf(out, " * Generated automatically by crc32.c\n */\n\n"); + fprintf(out, "local const unsigned long FAR "); + fprintf(out, "crc_table[TBLS][256] =\n{\n {\n"); + write_table(out, crc_table[0]); +# ifdef BYFOUR + fprintf(out, "#ifdef BYFOUR\n"); + for (k = 1; k < 8; k++) { + fprintf(out, " },\n {\n"); + write_table(out, crc_table[k]); + } + fprintf(out, "#endif\n"); +# endif /* BYFOUR */ + fprintf(out, " }\n};\n"); + fclose(out); + } +#endif /* MAKECRCH */ +} + +#ifdef MAKECRCH +local void write_table(out, table) + FILE *out; + const unsigned long FAR *table; +{ + int n; + + for (n = 0; n < 256; n++) + fprintf(out, "%s0x%08lxUL%s", n % 5 ? "" : " ", table[n], + n == 255 ? "\n" : (n % 5 == 4 ? ",\n" : ", ")); +} +#endif /* MAKECRCH */ + +#else /* !DYNAMIC_CRC_TABLE */ +/* ======================================================================== + * Tables of CRC-32s of all single-byte values, made by make_crc_table(). + */ +#include "crc32.h" +#endif /* DYNAMIC_CRC_TABLE */ + +/* ========================================================================= + * This function can be used by asm versions of crc32() + */ +const unsigned long FAR * ZEXPORT get_crc_table() +{ +#ifdef DYNAMIC_CRC_TABLE + if (crc_table_empty) + make_crc_table(); +#endif /* DYNAMIC_CRC_TABLE */ + return (const unsigned long FAR *)crc_table; +} + +/* ========================================================================= */ +#define DO1 crc = crc_table[0][((int)crc ^ (*buf++)) & 0xff] ^ (crc >> 8) +#define DO8 DO1; DO1; DO1; DO1; DO1; DO1; DO1; DO1 + +/* ========================================================================= */ +unsigned long ZEXPORT crc32(crc, buf, len) + unsigned long crc; + const unsigned char FAR *buf; + unsigned len; +{ + if (buf == Z_NULL) return 0UL; + +#ifdef DYNAMIC_CRC_TABLE + if (crc_table_empty) + make_crc_table(); +#endif /* DYNAMIC_CRC_TABLE */ + +#ifdef BYFOUR + if (sizeof(void *) == sizeof(ptrdiff_t)) { + u4 endian; + + endian = 1; + if (*((unsigned char *)(&endian))) + return crc32_little(crc, buf, len); + else + return crc32_big(crc, buf, len); + } +#endif /* BYFOUR */ + crc = crc ^ 0xffffffffUL; + while (len >= 8) { + DO8; + len -= 8; + } + if (len) do { + DO1; + } while (--len); + return crc ^ 0xffffffffUL; +} + +#ifdef BYFOUR + +/* ========================================================================= */ +#define DOLIT4 c ^= *buf4++; \ + c = crc_table[3][c & 0xff] ^ crc_table[2][(c >> 8) & 0xff] ^ \ + crc_table[1][(c >> 16) & 0xff] ^ crc_table[0][c >> 24] +#define DOLIT32 DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4; DOLIT4 + +/* ========================================================================= */ +local unsigned long crc32_little(crc, buf, len) + unsigned long crc; + const unsigned char FAR *buf; + unsigned len; +{ + register u4 c; + register const u4 FAR *buf4; + + c = (u4)crc; + c = ~c; + while (len && ((ptrdiff_t)buf & 3)) { + c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); + len--; + } + + buf4 = (const u4 FAR *)(const void FAR *)buf; + while (len >= 32) { + DOLIT32; + len -= 32; + } + while (len >= 4) { + DOLIT4; + len -= 4; + } + buf = (const unsigned char FAR *)buf4; + + if (len) do { + c = crc_table[0][(c ^ *buf++) & 0xff] ^ (c >> 8); + } while (--len); + c = ~c; + return (unsigned long)c; +} + +/* ========================================================================= */ +#define DOBIG4 c ^= *++buf4; \ + c = crc_table[4][c & 0xff] ^ crc_table[5][(c >> 8) & 0xff] ^ \ + crc_table[6][(c >> 16) & 0xff] ^ crc_table[7][c >> 24] +#define DOBIG32 DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4; DOBIG4 + +/* ========================================================================= */ +local unsigned long crc32_big(crc, buf, len) + unsigned long crc; + const unsigned char FAR *buf; + unsigned len; +{ + register u4 c; + register const u4 FAR *buf4; + + c = REV((u4)crc); + c = ~c; + while (len && ((ptrdiff_t)buf & 3)) { + c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); + len--; + } + + buf4 = (const u4 FAR *)(const void FAR *)buf; + buf4--; + while (len >= 32) { + DOBIG32; + len -= 32; + } + while (len >= 4) { + DOBIG4; + len -= 4; + } + buf4++; + buf = (const unsigned char FAR *)buf4; + + if (len) do { + c = crc_table[4][(c >> 24) ^ *buf++] ^ (c << 8); + } while (--len); + c = ~c; + return (unsigned long)(REV(c)); +} + +#endif /* BYFOUR */ + +#define GF2_DIM 32 /* dimension of GF(2) vectors (length of CRC) */ + +/* ========================================================================= */ +local unsigned long gf2_matrix_times(mat, vec) + unsigned long *mat; + unsigned long vec; +{ + unsigned long sum; + + sum = 0; + while (vec) { + if (vec & 1) + sum ^= *mat; + vec >>= 1; + mat++; + } + return sum; +} + +/* ========================================================================= */ +local void gf2_matrix_square(square, mat) + unsigned long *square; + unsigned long *mat; +{ + int n; + + for (n = 0; n < GF2_DIM; n++) + square[n] = gf2_matrix_times(mat, mat[n]); +} + +/* ========================================================================= */ +uLong ZEXPORT crc32_combine(crc1, crc2, len2) + uLong crc1; + uLong crc2; + z_off_t len2; +{ + int n; + unsigned long row; + unsigned long even[GF2_DIM]; /* even-power-of-two zeros operator */ + unsigned long odd[GF2_DIM]; /* odd-power-of-two zeros operator */ + + /* degenerate case */ + if (len2 == 0) + return crc1; + + /* put operator for one zero bit in odd */ + odd[0] = 0xedb88320L; /* CRC-32 polynomial */ + row = 1; + for (n = 1; n < GF2_DIM; n++) { + odd[n] = row; + row <<= 1; + } + + /* put operator for two zero bits in even */ + gf2_matrix_square(even, odd); + + /* put operator for four zero bits in odd */ + gf2_matrix_square(odd, even); + + /* apply len2 zeros to crc1 (first square will put the operator for one + zero byte, eight zero bits, in even) */ + do { + /* apply zeros operator for this bit of len2 */ + gf2_matrix_square(even, odd); + if (len2 & 1) + crc1 = gf2_matrix_times(even, crc1); + len2 >>= 1; + + /* if no more bits set, then done */ + if (len2 == 0) + break; + + /* another iteration of the loop with odd and even swapped */ + gf2_matrix_square(odd, even); + if (len2 & 1) + crc1 = gf2_matrix_times(odd, crc1); + len2 >>= 1; + + /* if no more bits set, then done */ + } while (len2 != 0); + + /* return combined crc */ + crc1 ^= crc2; + return crc1; +} diff --git a/erts/emulator/zlib/crc32.h b/erts/emulator/zlib/crc32.h new file mode 100644 index 0000000000..49cd69a4c2 --- /dev/null +++ b/erts/emulator/zlib/crc32.h @@ -0,0 +1,443 @@ +/* crc32.h -- tables for rapid CRC calculation + * Generated automatically by crc32.c + */ + +/* %ExternalCopyright% */ + +local const unsigned long FAR crc_table[TBLS][256] = +{ + { + 0x00000000UL, 0x77073096UL, 0xee0e612cUL, 0x990951baUL, 0x076dc419UL, + 0x706af48fUL, 0xe963a535UL, 0x9e6495a3UL, 0x0edb8832UL, 0x79dcb8a4UL, + 0xe0d5e91eUL, 0x97d2d988UL, 0x09b64c2bUL, 0x7eb17cbdUL, 0xe7b82d07UL, + 0x90bf1d91UL, 0x1db71064UL, 0x6ab020f2UL, 0xf3b97148UL, 0x84be41deUL, + 0x1adad47dUL, 0x6ddde4ebUL, 0xf4d4b551UL, 0x83d385c7UL, 0x136c9856UL, + 0x646ba8c0UL, 0xfd62f97aUL, 0x8a65c9ecUL, 0x14015c4fUL, 0x63066cd9UL, + 0xfa0f3d63UL, 0x8d080df5UL, 0x3b6e20c8UL, 0x4c69105eUL, 0xd56041e4UL, + 0xa2677172UL, 0x3c03e4d1UL, 0x4b04d447UL, 0xd20d85fdUL, 0xa50ab56bUL, + 0x35b5a8faUL, 0x42b2986cUL, 0xdbbbc9d6UL, 0xacbcf940UL, 0x32d86ce3UL, + 0x45df5c75UL, 0xdcd60dcfUL, 0xabd13d59UL, 0x26d930acUL, 0x51de003aUL, + 0xc8d75180UL, 0xbfd06116UL, 0x21b4f4b5UL, 0x56b3c423UL, 0xcfba9599UL, + 0xb8bda50fUL, 0x2802b89eUL, 0x5f058808UL, 0xc60cd9b2UL, 0xb10be924UL, + 0x2f6f7c87UL, 0x58684c11UL, 0xc1611dabUL, 0xb6662d3dUL, 0x76dc4190UL, + 0x01db7106UL, 0x98d220bcUL, 0xefd5102aUL, 0x71b18589UL, 0x06b6b51fUL, + 0x9fbfe4a5UL, 0xe8b8d433UL, 0x7807c9a2UL, 0x0f00f934UL, 0x9609a88eUL, + 0xe10e9818UL, 0x7f6a0dbbUL, 0x086d3d2dUL, 0x91646c97UL, 0xe6635c01UL, + 0x6b6b51f4UL, 0x1c6c6162UL, 0x856530d8UL, 0xf262004eUL, 0x6c0695edUL, + 0x1b01a57bUL, 0x8208f4c1UL, 0xf50fc457UL, 0x65b0d9c6UL, 0x12b7e950UL, + 0x8bbeb8eaUL, 0xfcb9887cUL, 0x62dd1ddfUL, 0x15da2d49UL, 0x8cd37cf3UL, + 0xfbd44c65UL, 0x4db26158UL, 0x3ab551ceUL, 0xa3bc0074UL, 0xd4bb30e2UL, + 0x4adfa541UL, 0x3dd895d7UL, 0xa4d1c46dUL, 0xd3d6f4fbUL, 0x4369e96aUL, + 0x346ed9fcUL, 0xad678846UL, 0xda60b8d0UL, 0x44042d73UL, 0x33031de5UL, + 0xaa0a4c5fUL, 0xdd0d7cc9UL, 0x5005713cUL, 0x270241aaUL, 0xbe0b1010UL, + 0xc90c2086UL, 0x5768b525UL, 0x206f85b3UL, 0xb966d409UL, 0xce61e49fUL, + 0x5edef90eUL, 0x29d9c998UL, 0xb0d09822UL, 0xc7d7a8b4UL, 0x59b33d17UL, + 0x2eb40d81UL, 0xb7bd5c3bUL, 0xc0ba6cadUL, 0xedb88320UL, 0x9abfb3b6UL, + 0x03b6e20cUL, 0x74b1d29aUL, 0xead54739UL, 0x9dd277afUL, 0x04db2615UL, + 0x73dc1683UL, 0xe3630b12UL, 0x94643b84UL, 0x0d6d6a3eUL, 0x7a6a5aa8UL, + 0xe40ecf0bUL, 0x9309ff9dUL, 0x0a00ae27UL, 0x7d079eb1UL, 0xf00f9344UL, + 0x8708a3d2UL, 0x1e01f268UL, 0x6906c2feUL, 0xf762575dUL, 0x806567cbUL, + 0x196c3671UL, 0x6e6b06e7UL, 0xfed41b76UL, 0x89d32be0UL, 0x10da7a5aUL, + 0x67dd4accUL, 0xf9b9df6fUL, 0x8ebeeff9UL, 0x17b7be43UL, 0x60b08ed5UL, + 0xd6d6a3e8UL, 0xa1d1937eUL, 0x38d8c2c4UL, 0x4fdff252UL, 0xd1bb67f1UL, + 0xa6bc5767UL, 0x3fb506ddUL, 0x48b2364bUL, 0xd80d2bdaUL, 0xaf0a1b4cUL, + 0x36034af6UL, 0x41047a60UL, 0xdf60efc3UL, 0xa867df55UL, 0x316e8eefUL, + 0x4669be79UL, 0xcb61b38cUL, 0xbc66831aUL, 0x256fd2a0UL, 0x5268e236UL, + 0xcc0c7795UL, 0xbb0b4703UL, 0x220216b9UL, 0x5505262fUL, 0xc5ba3bbeUL, + 0xb2bd0b28UL, 0x2bb45a92UL, 0x5cb36a04UL, 0xc2d7ffa7UL, 0xb5d0cf31UL, + 0x2cd99e8bUL, 0x5bdeae1dUL, 0x9b64c2b0UL, 0xec63f226UL, 0x756aa39cUL, + 0x026d930aUL, 0x9c0906a9UL, 0xeb0e363fUL, 0x72076785UL, 0x05005713UL, + 0x95bf4a82UL, 0xe2b87a14UL, 0x7bb12baeUL, 0x0cb61b38UL, 0x92d28e9bUL, + 0xe5d5be0dUL, 0x7cdcefb7UL, 0x0bdbdf21UL, 0x86d3d2d4UL, 0xf1d4e242UL, + 0x68ddb3f8UL, 0x1fda836eUL, 0x81be16cdUL, 0xf6b9265bUL, 0x6fb077e1UL, + 0x18b74777UL, 0x88085ae6UL, 0xff0f6a70UL, 0x66063bcaUL, 0x11010b5cUL, + 0x8f659effUL, 0xf862ae69UL, 0x616bffd3UL, 0x166ccf45UL, 0xa00ae278UL, + 0xd70dd2eeUL, 0x4e048354UL, 0x3903b3c2UL, 0xa7672661UL, 0xd06016f7UL, + 0x4969474dUL, 0x3e6e77dbUL, 0xaed16a4aUL, 0xd9d65adcUL, 0x40df0b66UL, + 0x37d83bf0UL, 0xa9bcae53UL, 0xdebb9ec5UL, 0x47b2cf7fUL, 0x30b5ffe9UL, + 0xbdbdf21cUL, 0xcabac28aUL, 0x53b39330UL, 0x24b4a3a6UL, 0xbad03605UL, + 0xcdd70693UL, 0x54de5729UL, 0x23d967bfUL, 0xb3667a2eUL, 0xc4614ab8UL, + 0x5d681b02UL, 0x2a6f2b94UL, 0xb40bbe37UL, 0xc30c8ea1UL, 0x5a05df1bUL, + 0x2d02ef8dUL +#ifdef BYFOUR + }, + { + 0x00000000UL, 0x191b3141UL, 0x32366282UL, 0x2b2d53c3UL, 0x646cc504UL, + 0x7d77f445UL, 0x565aa786UL, 0x4f4196c7UL, 0xc8d98a08UL, 0xd1c2bb49UL, + 0xfaefe88aUL, 0xe3f4d9cbUL, 0xacb54f0cUL, 0xb5ae7e4dUL, 0x9e832d8eUL, + 0x87981ccfUL, 0x4ac21251UL, 0x53d92310UL, 0x78f470d3UL, 0x61ef4192UL, + 0x2eaed755UL, 0x37b5e614UL, 0x1c98b5d7UL, 0x05838496UL, 0x821b9859UL, + 0x9b00a918UL, 0xb02dfadbUL, 0xa936cb9aUL, 0xe6775d5dUL, 0xff6c6c1cUL, + 0xd4413fdfUL, 0xcd5a0e9eUL, 0x958424a2UL, 0x8c9f15e3UL, 0xa7b24620UL, + 0xbea97761UL, 0xf1e8e1a6UL, 0xe8f3d0e7UL, 0xc3de8324UL, 0xdac5b265UL, + 0x5d5daeaaUL, 0x44469febUL, 0x6f6bcc28UL, 0x7670fd69UL, 0x39316baeUL, + 0x202a5aefUL, 0x0b07092cUL, 0x121c386dUL, 0xdf4636f3UL, 0xc65d07b2UL, + 0xed705471UL, 0xf46b6530UL, 0xbb2af3f7UL, 0xa231c2b6UL, 0x891c9175UL, + 0x9007a034UL, 0x179fbcfbUL, 0x0e848dbaUL, 0x25a9de79UL, 0x3cb2ef38UL, + 0x73f379ffUL, 0x6ae848beUL, 0x41c51b7dUL, 0x58de2a3cUL, 0xf0794f05UL, + 0xe9627e44UL, 0xc24f2d87UL, 0xdb541cc6UL, 0x94158a01UL, 0x8d0ebb40UL, + 0xa623e883UL, 0xbf38d9c2UL, 0x38a0c50dUL, 0x21bbf44cUL, 0x0a96a78fUL, + 0x138d96ceUL, 0x5ccc0009UL, 0x45d73148UL, 0x6efa628bUL, 0x77e153caUL, + 0xbabb5d54UL, 0xa3a06c15UL, 0x888d3fd6UL, 0x91960e97UL, 0xded79850UL, + 0xc7cca911UL, 0xece1fad2UL, 0xf5facb93UL, 0x7262d75cUL, 0x6b79e61dUL, + 0x4054b5deUL, 0x594f849fUL, 0x160e1258UL, 0x0f152319UL, 0x243870daUL, + 0x3d23419bUL, 0x65fd6ba7UL, 0x7ce65ae6UL, 0x57cb0925UL, 0x4ed03864UL, + 0x0191aea3UL, 0x188a9fe2UL, 0x33a7cc21UL, 0x2abcfd60UL, 0xad24e1afUL, + 0xb43fd0eeUL, 0x9f12832dUL, 0x8609b26cUL, 0xc94824abUL, 0xd05315eaUL, + 0xfb7e4629UL, 0xe2657768UL, 0x2f3f79f6UL, 0x362448b7UL, 0x1d091b74UL, + 0x04122a35UL, 0x4b53bcf2UL, 0x52488db3UL, 0x7965de70UL, 0x607eef31UL, + 0xe7e6f3feUL, 0xfefdc2bfUL, 0xd5d0917cUL, 0xcccba03dUL, 0x838a36faUL, + 0x9a9107bbUL, 0xb1bc5478UL, 0xa8a76539UL, 0x3b83984bUL, 0x2298a90aUL, + 0x09b5fac9UL, 0x10aecb88UL, 0x5fef5d4fUL, 0x46f46c0eUL, 0x6dd93fcdUL, + 0x74c20e8cUL, 0xf35a1243UL, 0xea412302UL, 0xc16c70c1UL, 0xd8774180UL, + 0x9736d747UL, 0x8e2de606UL, 0xa500b5c5UL, 0xbc1b8484UL, 0x71418a1aUL, + 0x685abb5bUL, 0x4377e898UL, 0x5a6cd9d9UL, 0x152d4f1eUL, 0x0c367e5fUL, + 0x271b2d9cUL, 0x3e001cddUL, 0xb9980012UL, 0xa0833153UL, 0x8bae6290UL, + 0x92b553d1UL, 0xddf4c516UL, 0xc4eff457UL, 0xefc2a794UL, 0xf6d996d5UL, + 0xae07bce9UL, 0xb71c8da8UL, 0x9c31de6bUL, 0x852aef2aUL, 0xca6b79edUL, + 0xd37048acUL, 0xf85d1b6fUL, 0xe1462a2eUL, 0x66de36e1UL, 0x7fc507a0UL, + 0x54e85463UL, 0x4df36522UL, 0x02b2f3e5UL, 0x1ba9c2a4UL, 0x30849167UL, + 0x299fa026UL, 0xe4c5aeb8UL, 0xfdde9ff9UL, 0xd6f3cc3aUL, 0xcfe8fd7bUL, + 0x80a96bbcUL, 0x99b25afdUL, 0xb29f093eUL, 0xab84387fUL, 0x2c1c24b0UL, + 0x350715f1UL, 0x1e2a4632UL, 0x07317773UL, 0x4870e1b4UL, 0x516bd0f5UL, + 0x7a468336UL, 0x635db277UL, 0xcbfad74eUL, 0xd2e1e60fUL, 0xf9ccb5ccUL, + 0xe0d7848dUL, 0xaf96124aUL, 0xb68d230bUL, 0x9da070c8UL, 0x84bb4189UL, + 0x03235d46UL, 0x1a386c07UL, 0x31153fc4UL, 0x280e0e85UL, 0x674f9842UL, + 0x7e54a903UL, 0x5579fac0UL, 0x4c62cb81UL, 0x8138c51fUL, 0x9823f45eUL, + 0xb30ea79dUL, 0xaa1596dcUL, 0xe554001bUL, 0xfc4f315aUL, 0xd7626299UL, + 0xce7953d8UL, 0x49e14f17UL, 0x50fa7e56UL, 0x7bd72d95UL, 0x62cc1cd4UL, + 0x2d8d8a13UL, 0x3496bb52UL, 0x1fbbe891UL, 0x06a0d9d0UL, 0x5e7ef3ecUL, + 0x4765c2adUL, 0x6c48916eUL, 0x7553a02fUL, 0x3a1236e8UL, 0x230907a9UL, + 0x0824546aUL, 0x113f652bUL, 0x96a779e4UL, 0x8fbc48a5UL, 0xa4911b66UL, + 0xbd8a2a27UL, 0xf2cbbce0UL, 0xebd08da1UL, 0xc0fdde62UL, 0xd9e6ef23UL, + 0x14bce1bdUL, 0x0da7d0fcUL, 0x268a833fUL, 0x3f91b27eUL, 0x70d024b9UL, + 0x69cb15f8UL, 0x42e6463bUL, 0x5bfd777aUL, 0xdc656bb5UL, 0xc57e5af4UL, + 0xee530937UL, 0xf7483876UL, 0xb809aeb1UL, 0xa1129ff0UL, 0x8a3fcc33UL, + 0x9324fd72UL + }, + { + 0x00000000UL, 0x01c26a37UL, 0x0384d46eUL, 0x0246be59UL, 0x0709a8dcUL, + 0x06cbc2ebUL, 0x048d7cb2UL, 0x054f1685UL, 0x0e1351b8UL, 0x0fd13b8fUL, + 0x0d9785d6UL, 0x0c55efe1UL, 0x091af964UL, 0x08d89353UL, 0x0a9e2d0aUL, + 0x0b5c473dUL, 0x1c26a370UL, 0x1de4c947UL, 0x1fa2771eUL, 0x1e601d29UL, + 0x1b2f0bacUL, 0x1aed619bUL, 0x18abdfc2UL, 0x1969b5f5UL, 0x1235f2c8UL, + 0x13f798ffUL, 0x11b126a6UL, 0x10734c91UL, 0x153c5a14UL, 0x14fe3023UL, + 0x16b88e7aUL, 0x177ae44dUL, 0x384d46e0UL, 0x398f2cd7UL, 0x3bc9928eUL, + 0x3a0bf8b9UL, 0x3f44ee3cUL, 0x3e86840bUL, 0x3cc03a52UL, 0x3d025065UL, + 0x365e1758UL, 0x379c7d6fUL, 0x35dac336UL, 0x3418a901UL, 0x3157bf84UL, + 0x3095d5b3UL, 0x32d36beaUL, 0x331101ddUL, 0x246be590UL, 0x25a98fa7UL, + 0x27ef31feUL, 0x262d5bc9UL, 0x23624d4cUL, 0x22a0277bUL, 0x20e69922UL, + 0x2124f315UL, 0x2a78b428UL, 0x2bbade1fUL, 0x29fc6046UL, 0x283e0a71UL, + 0x2d711cf4UL, 0x2cb376c3UL, 0x2ef5c89aUL, 0x2f37a2adUL, 0x709a8dc0UL, + 0x7158e7f7UL, 0x731e59aeUL, 0x72dc3399UL, 0x7793251cUL, 0x76514f2bUL, + 0x7417f172UL, 0x75d59b45UL, 0x7e89dc78UL, 0x7f4bb64fUL, 0x7d0d0816UL, + 0x7ccf6221UL, 0x798074a4UL, 0x78421e93UL, 0x7a04a0caUL, 0x7bc6cafdUL, + 0x6cbc2eb0UL, 0x6d7e4487UL, 0x6f38fadeUL, 0x6efa90e9UL, 0x6bb5866cUL, + 0x6a77ec5bUL, 0x68315202UL, 0x69f33835UL, 0x62af7f08UL, 0x636d153fUL, + 0x612bab66UL, 0x60e9c151UL, 0x65a6d7d4UL, 0x6464bde3UL, 0x662203baUL, + 0x67e0698dUL, 0x48d7cb20UL, 0x4915a117UL, 0x4b531f4eUL, 0x4a917579UL, + 0x4fde63fcUL, 0x4e1c09cbUL, 0x4c5ab792UL, 0x4d98dda5UL, 0x46c49a98UL, + 0x4706f0afUL, 0x45404ef6UL, 0x448224c1UL, 0x41cd3244UL, 0x400f5873UL, + 0x4249e62aUL, 0x438b8c1dUL, 0x54f16850UL, 0x55330267UL, 0x5775bc3eUL, + 0x56b7d609UL, 0x53f8c08cUL, 0x523aaabbUL, 0x507c14e2UL, 0x51be7ed5UL, + 0x5ae239e8UL, 0x5b2053dfUL, 0x5966ed86UL, 0x58a487b1UL, 0x5deb9134UL, + 0x5c29fb03UL, 0x5e6f455aUL, 0x5fad2f6dUL, 0xe1351b80UL, 0xe0f771b7UL, + 0xe2b1cfeeUL, 0xe373a5d9UL, 0xe63cb35cUL, 0xe7fed96bUL, 0xe5b86732UL, + 0xe47a0d05UL, 0xef264a38UL, 0xeee4200fUL, 0xeca29e56UL, 0xed60f461UL, + 0xe82fe2e4UL, 0xe9ed88d3UL, 0xebab368aUL, 0xea695cbdUL, 0xfd13b8f0UL, + 0xfcd1d2c7UL, 0xfe976c9eUL, 0xff5506a9UL, 0xfa1a102cUL, 0xfbd87a1bUL, + 0xf99ec442UL, 0xf85cae75UL, 0xf300e948UL, 0xf2c2837fUL, 0xf0843d26UL, + 0xf1465711UL, 0xf4094194UL, 0xf5cb2ba3UL, 0xf78d95faUL, 0xf64fffcdUL, + 0xd9785d60UL, 0xd8ba3757UL, 0xdafc890eUL, 0xdb3ee339UL, 0xde71f5bcUL, + 0xdfb39f8bUL, 0xddf521d2UL, 0xdc374be5UL, 0xd76b0cd8UL, 0xd6a966efUL, + 0xd4efd8b6UL, 0xd52db281UL, 0xd062a404UL, 0xd1a0ce33UL, 0xd3e6706aUL, + 0xd2241a5dUL, 0xc55efe10UL, 0xc49c9427UL, 0xc6da2a7eUL, 0xc7184049UL, + 0xc25756ccUL, 0xc3953cfbUL, 0xc1d382a2UL, 0xc011e895UL, 0xcb4dafa8UL, + 0xca8fc59fUL, 0xc8c97bc6UL, 0xc90b11f1UL, 0xcc440774UL, 0xcd866d43UL, + 0xcfc0d31aUL, 0xce02b92dUL, 0x91af9640UL, 0x906dfc77UL, 0x922b422eUL, + 0x93e92819UL, 0x96a63e9cUL, 0x976454abUL, 0x9522eaf2UL, 0x94e080c5UL, + 0x9fbcc7f8UL, 0x9e7eadcfUL, 0x9c381396UL, 0x9dfa79a1UL, 0x98b56f24UL, + 0x99770513UL, 0x9b31bb4aUL, 0x9af3d17dUL, 0x8d893530UL, 0x8c4b5f07UL, + 0x8e0de15eUL, 0x8fcf8b69UL, 0x8a809decUL, 0x8b42f7dbUL, 0x89044982UL, + 0x88c623b5UL, 0x839a6488UL, 0x82580ebfUL, 0x801eb0e6UL, 0x81dcdad1UL, + 0x8493cc54UL, 0x8551a663UL, 0x8717183aUL, 0x86d5720dUL, 0xa9e2d0a0UL, + 0xa820ba97UL, 0xaa6604ceUL, 0xaba46ef9UL, 0xaeeb787cUL, 0xaf29124bUL, + 0xad6fac12UL, 0xacadc625UL, 0xa7f18118UL, 0xa633eb2fUL, 0xa4755576UL, + 0xa5b73f41UL, 0xa0f829c4UL, 0xa13a43f3UL, 0xa37cfdaaUL, 0xa2be979dUL, + 0xb5c473d0UL, 0xb40619e7UL, 0xb640a7beUL, 0xb782cd89UL, 0xb2cddb0cUL, + 0xb30fb13bUL, 0xb1490f62UL, 0xb08b6555UL, 0xbbd72268UL, 0xba15485fUL, + 0xb853f606UL, 0xb9919c31UL, 0xbcde8ab4UL, 0xbd1ce083UL, 0xbf5a5edaUL, + 0xbe9834edUL + }, + { + 0x00000000UL, 0xb8bc6765UL, 0xaa09c88bUL, 0x12b5afeeUL, 0x8f629757UL, + 0x37def032UL, 0x256b5fdcUL, 0x9dd738b9UL, 0xc5b428efUL, 0x7d084f8aUL, + 0x6fbde064UL, 0xd7018701UL, 0x4ad6bfb8UL, 0xf26ad8ddUL, 0xe0df7733UL, + 0x58631056UL, 0x5019579fUL, 0xe8a530faUL, 0xfa109f14UL, 0x42acf871UL, + 0xdf7bc0c8UL, 0x67c7a7adUL, 0x75720843UL, 0xcdce6f26UL, 0x95ad7f70UL, + 0x2d111815UL, 0x3fa4b7fbUL, 0x8718d09eUL, 0x1acfe827UL, 0xa2738f42UL, + 0xb0c620acUL, 0x087a47c9UL, 0xa032af3eUL, 0x188ec85bUL, 0x0a3b67b5UL, + 0xb28700d0UL, 0x2f503869UL, 0x97ec5f0cUL, 0x8559f0e2UL, 0x3de59787UL, + 0x658687d1UL, 0xdd3ae0b4UL, 0xcf8f4f5aUL, 0x7733283fUL, 0xeae41086UL, + 0x525877e3UL, 0x40edd80dUL, 0xf851bf68UL, 0xf02bf8a1UL, 0x48979fc4UL, + 0x5a22302aUL, 0xe29e574fUL, 0x7f496ff6UL, 0xc7f50893UL, 0xd540a77dUL, + 0x6dfcc018UL, 0x359fd04eUL, 0x8d23b72bUL, 0x9f9618c5UL, 0x272a7fa0UL, + 0xbafd4719UL, 0x0241207cUL, 0x10f48f92UL, 0xa848e8f7UL, 0x9b14583dUL, + 0x23a83f58UL, 0x311d90b6UL, 0x89a1f7d3UL, 0x1476cf6aUL, 0xaccaa80fUL, + 0xbe7f07e1UL, 0x06c36084UL, 0x5ea070d2UL, 0xe61c17b7UL, 0xf4a9b859UL, + 0x4c15df3cUL, 0xd1c2e785UL, 0x697e80e0UL, 0x7bcb2f0eUL, 0xc377486bUL, + 0xcb0d0fa2UL, 0x73b168c7UL, 0x6104c729UL, 0xd9b8a04cUL, 0x446f98f5UL, + 0xfcd3ff90UL, 0xee66507eUL, 0x56da371bUL, 0x0eb9274dUL, 0xb6054028UL, + 0xa4b0efc6UL, 0x1c0c88a3UL, 0x81dbb01aUL, 0x3967d77fUL, 0x2bd27891UL, + 0x936e1ff4UL, 0x3b26f703UL, 0x839a9066UL, 0x912f3f88UL, 0x299358edUL, + 0xb4446054UL, 0x0cf80731UL, 0x1e4da8dfUL, 0xa6f1cfbaUL, 0xfe92dfecUL, + 0x462eb889UL, 0x549b1767UL, 0xec277002UL, 0x71f048bbUL, 0xc94c2fdeUL, + 0xdbf98030UL, 0x6345e755UL, 0x6b3fa09cUL, 0xd383c7f9UL, 0xc1366817UL, + 0x798a0f72UL, 0xe45d37cbUL, 0x5ce150aeUL, 0x4e54ff40UL, 0xf6e89825UL, + 0xae8b8873UL, 0x1637ef16UL, 0x048240f8UL, 0xbc3e279dUL, 0x21e91f24UL, + 0x99557841UL, 0x8be0d7afUL, 0x335cb0caUL, 0xed59b63bUL, 0x55e5d15eUL, + 0x47507eb0UL, 0xffec19d5UL, 0x623b216cUL, 0xda874609UL, 0xc832e9e7UL, + 0x708e8e82UL, 0x28ed9ed4UL, 0x9051f9b1UL, 0x82e4565fUL, 0x3a58313aUL, + 0xa78f0983UL, 0x1f336ee6UL, 0x0d86c108UL, 0xb53aa66dUL, 0xbd40e1a4UL, + 0x05fc86c1UL, 0x1749292fUL, 0xaff54e4aUL, 0x322276f3UL, 0x8a9e1196UL, + 0x982bbe78UL, 0x2097d91dUL, 0x78f4c94bUL, 0xc048ae2eUL, 0xd2fd01c0UL, + 0x6a4166a5UL, 0xf7965e1cUL, 0x4f2a3979UL, 0x5d9f9697UL, 0xe523f1f2UL, + 0x4d6b1905UL, 0xf5d77e60UL, 0xe762d18eUL, 0x5fdeb6ebUL, 0xc2098e52UL, + 0x7ab5e937UL, 0x680046d9UL, 0xd0bc21bcUL, 0x88df31eaUL, 0x3063568fUL, + 0x22d6f961UL, 0x9a6a9e04UL, 0x07bda6bdUL, 0xbf01c1d8UL, 0xadb46e36UL, + 0x15080953UL, 0x1d724e9aUL, 0xa5ce29ffUL, 0xb77b8611UL, 0x0fc7e174UL, + 0x9210d9cdUL, 0x2aacbea8UL, 0x38191146UL, 0x80a57623UL, 0xd8c66675UL, + 0x607a0110UL, 0x72cfaefeUL, 0xca73c99bUL, 0x57a4f122UL, 0xef189647UL, + 0xfdad39a9UL, 0x45115eccUL, 0x764dee06UL, 0xcef18963UL, 0xdc44268dUL, + 0x64f841e8UL, 0xf92f7951UL, 0x41931e34UL, 0x5326b1daUL, 0xeb9ad6bfUL, + 0xb3f9c6e9UL, 0x0b45a18cUL, 0x19f00e62UL, 0xa14c6907UL, 0x3c9b51beUL, + 0x842736dbUL, 0x96929935UL, 0x2e2efe50UL, 0x2654b999UL, 0x9ee8defcUL, + 0x8c5d7112UL, 0x34e11677UL, 0xa9362eceUL, 0x118a49abUL, 0x033fe645UL, + 0xbb838120UL, 0xe3e09176UL, 0x5b5cf613UL, 0x49e959fdUL, 0xf1553e98UL, + 0x6c820621UL, 0xd43e6144UL, 0xc68bceaaUL, 0x7e37a9cfUL, 0xd67f4138UL, + 0x6ec3265dUL, 0x7c7689b3UL, 0xc4caeed6UL, 0x591dd66fUL, 0xe1a1b10aUL, + 0xf3141ee4UL, 0x4ba87981UL, 0x13cb69d7UL, 0xab770eb2UL, 0xb9c2a15cUL, + 0x017ec639UL, 0x9ca9fe80UL, 0x241599e5UL, 0x36a0360bUL, 0x8e1c516eUL, + 0x866616a7UL, 0x3eda71c2UL, 0x2c6fde2cUL, 0x94d3b949UL, 0x090481f0UL, + 0xb1b8e695UL, 0xa30d497bUL, 0x1bb12e1eUL, 0x43d23e48UL, 0xfb6e592dUL, + 0xe9dbf6c3UL, 0x516791a6UL, 0xccb0a91fUL, 0x740cce7aUL, 0x66b96194UL, + 0xde0506f1UL + }, + { + 0x00000000UL, 0x96300777UL, 0x2c610eeeUL, 0xba510999UL, 0x19c46d07UL, + 0x8ff46a70UL, 0x35a563e9UL, 0xa395649eUL, 0x3288db0eUL, 0xa4b8dc79UL, + 0x1ee9d5e0UL, 0x88d9d297UL, 0x2b4cb609UL, 0xbd7cb17eUL, 0x072db8e7UL, + 0x911dbf90UL, 0x6410b71dUL, 0xf220b06aUL, 0x4871b9f3UL, 0xde41be84UL, + 0x7dd4da1aUL, 0xebe4dd6dUL, 0x51b5d4f4UL, 0xc785d383UL, 0x56986c13UL, + 0xc0a86b64UL, 0x7af962fdUL, 0xecc9658aUL, 0x4f5c0114UL, 0xd96c0663UL, + 0x633d0ffaUL, 0xf50d088dUL, 0xc8206e3bUL, 0x5e10694cUL, 0xe44160d5UL, + 0x727167a2UL, 0xd1e4033cUL, 0x47d4044bUL, 0xfd850dd2UL, 0x6bb50aa5UL, + 0xfaa8b535UL, 0x6c98b242UL, 0xd6c9bbdbUL, 0x40f9bcacUL, 0xe36cd832UL, + 0x755cdf45UL, 0xcf0dd6dcUL, 0x593dd1abUL, 0xac30d926UL, 0x3a00de51UL, + 0x8051d7c8UL, 0x1661d0bfUL, 0xb5f4b421UL, 0x23c4b356UL, 0x9995bacfUL, + 0x0fa5bdb8UL, 0x9eb80228UL, 0x0888055fUL, 0xb2d90cc6UL, 0x24e90bb1UL, + 0x877c6f2fUL, 0x114c6858UL, 0xab1d61c1UL, 0x3d2d66b6UL, 0x9041dc76UL, + 0x0671db01UL, 0xbc20d298UL, 0x2a10d5efUL, 0x8985b171UL, 0x1fb5b606UL, + 0xa5e4bf9fUL, 0x33d4b8e8UL, 0xa2c90778UL, 0x34f9000fUL, 0x8ea80996UL, + 0x18980ee1UL, 0xbb0d6a7fUL, 0x2d3d6d08UL, 0x976c6491UL, 0x015c63e6UL, + 0xf4516b6bUL, 0x62616c1cUL, 0xd8306585UL, 0x4e0062f2UL, 0xed95066cUL, + 0x7ba5011bUL, 0xc1f40882UL, 0x57c40ff5UL, 0xc6d9b065UL, 0x50e9b712UL, + 0xeab8be8bUL, 0x7c88b9fcUL, 0xdf1ddd62UL, 0x492dda15UL, 0xf37cd38cUL, + 0x654cd4fbUL, 0x5861b24dUL, 0xce51b53aUL, 0x7400bca3UL, 0xe230bbd4UL, + 0x41a5df4aUL, 0xd795d83dUL, 0x6dc4d1a4UL, 0xfbf4d6d3UL, 0x6ae96943UL, + 0xfcd96e34UL, 0x468867adUL, 0xd0b860daUL, 0x732d0444UL, 0xe51d0333UL, + 0x5f4c0aaaUL, 0xc97c0dddUL, 0x3c710550UL, 0xaa410227UL, 0x10100bbeUL, + 0x86200cc9UL, 0x25b56857UL, 0xb3856f20UL, 0x09d466b9UL, 0x9fe461ceUL, + 0x0ef9de5eUL, 0x98c9d929UL, 0x2298d0b0UL, 0xb4a8d7c7UL, 0x173db359UL, + 0x810db42eUL, 0x3b5cbdb7UL, 0xad6cbac0UL, 0x2083b8edUL, 0xb6b3bf9aUL, + 0x0ce2b603UL, 0x9ad2b174UL, 0x3947d5eaUL, 0xaf77d29dUL, 0x1526db04UL, + 0x8316dc73UL, 0x120b63e3UL, 0x843b6494UL, 0x3e6a6d0dUL, 0xa85a6a7aUL, + 0x0bcf0ee4UL, 0x9dff0993UL, 0x27ae000aUL, 0xb19e077dUL, 0x44930ff0UL, + 0xd2a30887UL, 0x68f2011eUL, 0xfec20669UL, 0x5d5762f7UL, 0xcb676580UL, + 0x71366c19UL, 0xe7066b6eUL, 0x761bd4feUL, 0xe02bd389UL, 0x5a7ada10UL, + 0xcc4add67UL, 0x6fdfb9f9UL, 0xf9efbe8eUL, 0x43beb717UL, 0xd58eb060UL, + 0xe8a3d6d6UL, 0x7e93d1a1UL, 0xc4c2d838UL, 0x52f2df4fUL, 0xf167bbd1UL, + 0x6757bca6UL, 0xdd06b53fUL, 0x4b36b248UL, 0xda2b0dd8UL, 0x4c1b0aafUL, + 0xf64a0336UL, 0x607a0441UL, 0xc3ef60dfUL, 0x55df67a8UL, 0xef8e6e31UL, + 0x79be6946UL, 0x8cb361cbUL, 0x1a8366bcUL, 0xa0d26f25UL, 0x36e26852UL, + 0x95770cccUL, 0x03470bbbUL, 0xb9160222UL, 0x2f260555UL, 0xbe3bbac5UL, + 0x280bbdb2UL, 0x925ab42bUL, 0x046ab35cUL, 0xa7ffd7c2UL, 0x31cfd0b5UL, + 0x8b9ed92cUL, 0x1daede5bUL, 0xb0c2649bUL, 0x26f263ecUL, 0x9ca36a75UL, + 0x0a936d02UL, 0xa906099cUL, 0x3f360eebUL, 0x85670772UL, 0x13570005UL, + 0x824abf95UL, 0x147ab8e2UL, 0xae2bb17bUL, 0x381bb60cUL, 0x9b8ed292UL, + 0x0dbed5e5UL, 0xb7efdc7cUL, 0x21dfdb0bUL, 0xd4d2d386UL, 0x42e2d4f1UL, + 0xf8b3dd68UL, 0x6e83da1fUL, 0xcd16be81UL, 0x5b26b9f6UL, 0xe177b06fUL, + 0x7747b718UL, 0xe65a0888UL, 0x706a0fffUL, 0xca3b0666UL, 0x5c0b0111UL, + 0xff9e658fUL, 0x69ae62f8UL, 0xd3ff6b61UL, 0x45cf6c16UL, 0x78e20aa0UL, + 0xeed20dd7UL, 0x5483044eUL, 0xc2b30339UL, 0x612667a7UL, 0xf71660d0UL, + 0x4d476949UL, 0xdb776e3eUL, 0x4a6ad1aeUL, 0xdc5ad6d9UL, 0x660bdf40UL, + 0xf03bd837UL, 0x53aebca9UL, 0xc59ebbdeUL, 0x7fcfb247UL, 0xe9ffb530UL, + 0x1cf2bdbdUL, 0x8ac2bacaUL, 0x3093b353UL, 0xa6a3b424UL, 0x0536d0baUL, + 0x9306d7cdUL, 0x2957de54UL, 0xbf67d923UL, 0x2e7a66b3UL, 0xb84a61c4UL, + 0x021b685dUL, 0x942b6f2aUL, 0x37be0bb4UL, 0xa18e0cc3UL, 0x1bdf055aUL, + 0x8def022dUL + }, + { + 0x00000000UL, 0x41311b19UL, 0x82623632UL, 0xc3532d2bUL, 0x04c56c64UL, + 0x45f4777dUL, 0x86a75a56UL, 0xc796414fUL, 0x088ad9c8UL, 0x49bbc2d1UL, + 0x8ae8effaUL, 0xcbd9f4e3UL, 0x0c4fb5acUL, 0x4d7eaeb5UL, 0x8e2d839eUL, + 0xcf1c9887UL, 0x5112c24aUL, 0x1023d953UL, 0xd370f478UL, 0x9241ef61UL, + 0x55d7ae2eUL, 0x14e6b537UL, 0xd7b5981cUL, 0x96848305UL, 0x59981b82UL, + 0x18a9009bUL, 0xdbfa2db0UL, 0x9acb36a9UL, 0x5d5d77e6UL, 0x1c6c6cffUL, + 0xdf3f41d4UL, 0x9e0e5acdUL, 0xa2248495UL, 0xe3159f8cUL, 0x2046b2a7UL, + 0x6177a9beUL, 0xa6e1e8f1UL, 0xe7d0f3e8UL, 0x2483dec3UL, 0x65b2c5daUL, + 0xaaae5d5dUL, 0xeb9f4644UL, 0x28cc6b6fUL, 0x69fd7076UL, 0xae6b3139UL, + 0xef5a2a20UL, 0x2c09070bUL, 0x6d381c12UL, 0xf33646dfUL, 0xb2075dc6UL, + 0x715470edUL, 0x30656bf4UL, 0xf7f32abbUL, 0xb6c231a2UL, 0x75911c89UL, + 0x34a00790UL, 0xfbbc9f17UL, 0xba8d840eUL, 0x79dea925UL, 0x38efb23cUL, + 0xff79f373UL, 0xbe48e86aUL, 0x7d1bc541UL, 0x3c2ade58UL, 0x054f79f0UL, + 0x447e62e9UL, 0x872d4fc2UL, 0xc61c54dbUL, 0x018a1594UL, 0x40bb0e8dUL, + 0x83e823a6UL, 0xc2d938bfUL, 0x0dc5a038UL, 0x4cf4bb21UL, 0x8fa7960aUL, + 0xce968d13UL, 0x0900cc5cUL, 0x4831d745UL, 0x8b62fa6eUL, 0xca53e177UL, + 0x545dbbbaUL, 0x156ca0a3UL, 0xd63f8d88UL, 0x970e9691UL, 0x5098d7deUL, + 0x11a9ccc7UL, 0xd2fae1ecUL, 0x93cbfaf5UL, 0x5cd76272UL, 0x1de6796bUL, + 0xdeb55440UL, 0x9f844f59UL, 0x58120e16UL, 0x1923150fUL, 0xda703824UL, + 0x9b41233dUL, 0xa76bfd65UL, 0xe65ae67cUL, 0x2509cb57UL, 0x6438d04eUL, + 0xa3ae9101UL, 0xe29f8a18UL, 0x21cca733UL, 0x60fdbc2aUL, 0xafe124adUL, + 0xeed03fb4UL, 0x2d83129fUL, 0x6cb20986UL, 0xab2448c9UL, 0xea1553d0UL, + 0x29467efbUL, 0x687765e2UL, 0xf6793f2fUL, 0xb7482436UL, 0x741b091dUL, + 0x352a1204UL, 0xf2bc534bUL, 0xb38d4852UL, 0x70de6579UL, 0x31ef7e60UL, + 0xfef3e6e7UL, 0xbfc2fdfeUL, 0x7c91d0d5UL, 0x3da0cbccUL, 0xfa368a83UL, + 0xbb07919aUL, 0x7854bcb1UL, 0x3965a7a8UL, 0x4b98833bUL, 0x0aa99822UL, + 0xc9fab509UL, 0x88cbae10UL, 0x4f5def5fUL, 0x0e6cf446UL, 0xcd3fd96dUL, + 0x8c0ec274UL, 0x43125af3UL, 0x022341eaUL, 0xc1706cc1UL, 0x804177d8UL, + 0x47d73697UL, 0x06e62d8eUL, 0xc5b500a5UL, 0x84841bbcUL, 0x1a8a4171UL, + 0x5bbb5a68UL, 0x98e87743UL, 0xd9d96c5aUL, 0x1e4f2d15UL, 0x5f7e360cUL, + 0x9c2d1b27UL, 0xdd1c003eUL, 0x120098b9UL, 0x533183a0UL, 0x9062ae8bUL, + 0xd153b592UL, 0x16c5f4ddUL, 0x57f4efc4UL, 0x94a7c2efUL, 0xd596d9f6UL, + 0xe9bc07aeUL, 0xa88d1cb7UL, 0x6bde319cUL, 0x2aef2a85UL, 0xed796bcaUL, + 0xac4870d3UL, 0x6f1b5df8UL, 0x2e2a46e1UL, 0xe136de66UL, 0xa007c57fUL, + 0x6354e854UL, 0x2265f34dUL, 0xe5f3b202UL, 0xa4c2a91bUL, 0x67918430UL, + 0x26a09f29UL, 0xb8aec5e4UL, 0xf99fdefdUL, 0x3accf3d6UL, 0x7bfde8cfUL, + 0xbc6ba980UL, 0xfd5ab299UL, 0x3e099fb2UL, 0x7f3884abUL, 0xb0241c2cUL, + 0xf1150735UL, 0x32462a1eUL, 0x73773107UL, 0xb4e17048UL, 0xf5d06b51UL, + 0x3683467aUL, 0x77b25d63UL, 0x4ed7facbUL, 0x0fe6e1d2UL, 0xccb5ccf9UL, + 0x8d84d7e0UL, 0x4a1296afUL, 0x0b238db6UL, 0xc870a09dUL, 0x8941bb84UL, + 0x465d2303UL, 0x076c381aUL, 0xc43f1531UL, 0x850e0e28UL, 0x42984f67UL, + 0x03a9547eUL, 0xc0fa7955UL, 0x81cb624cUL, 0x1fc53881UL, 0x5ef42398UL, + 0x9da70eb3UL, 0xdc9615aaUL, 0x1b0054e5UL, 0x5a314ffcUL, 0x996262d7UL, + 0xd85379ceUL, 0x174fe149UL, 0x567efa50UL, 0x952dd77bUL, 0xd41ccc62UL, + 0x138a8d2dUL, 0x52bb9634UL, 0x91e8bb1fUL, 0xd0d9a006UL, 0xecf37e5eUL, + 0xadc26547UL, 0x6e91486cUL, 0x2fa05375UL, 0xe836123aUL, 0xa9070923UL, + 0x6a542408UL, 0x2b653f11UL, 0xe479a796UL, 0xa548bc8fUL, 0x661b91a4UL, + 0x272a8abdUL, 0xe0bccbf2UL, 0xa18dd0ebUL, 0x62defdc0UL, 0x23efe6d9UL, + 0xbde1bc14UL, 0xfcd0a70dUL, 0x3f838a26UL, 0x7eb2913fUL, 0xb924d070UL, + 0xf815cb69UL, 0x3b46e642UL, 0x7a77fd5bUL, 0xb56b65dcUL, 0xf45a7ec5UL, + 0x370953eeUL, 0x763848f7UL, 0xb1ae09b8UL, 0xf09f12a1UL, 0x33cc3f8aUL, + 0x72fd2493UL + }, + { + 0x00000000UL, 0x376ac201UL, 0x6ed48403UL, 0x59be4602UL, 0xdca80907UL, + 0xebc2cb06UL, 0xb27c8d04UL, 0x85164f05UL, 0xb851130eUL, 0x8f3bd10fUL, + 0xd685970dUL, 0xe1ef550cUL, 0x64f91a09UL, 0x5393d808UL, 0x0a2d9e0aUL, + 0x3d475c0bUL, 0x70a3261cUL, 0x47c9e41dUL, 0x1e77a21fUL, 0x291d601eUL, + 0xac0b2f1bUL, 0x9b61ed1aUL, 0xc2dfab18UL, 0xf5b56919UL, 0xc8f23512UL, + 0xff98f713UL, 0xa626b111UL, 0x914c7310UL, 0x145a3c15UL, 0x2330fe14UL, + 0x7a8eb816UL, 0x4de47a17UL, 0xe0464d38UL, 0xd72c8f39UL, 0x8e92c93bUL, + 0xb9f80b3aUL, 0x3cee443fUL, 0x0b84863eUL, 0x523ac03cUL, 0x6550023dUL, + 0x58175e36UL, 0x6f7d9c37UL, 0x36c3da35UL, 0x01a91834UL, 0x84bf5731UL, + 0xb3d59530UL, 0xea6bd332UL, 0xdd011133UL, 0x90e56b24UL, 0xa78fa925UL, + 0xfe31ef27UL, 0xc95b2d26UL, 0x4c4d6223UL, 0x7b27a022UL, 0x2299e620UL, + 0x15f32421UL, 0x28b4782aUL, 0x1fdeba2bUL, 0x4660fc29UL, 0x710a3e28UL, + 0xf41c712dUL, 0xc376b32cUL, 0x9ac8f52eUL, 0xada2372fUL, 0xc08d9a70UL, + 0xf7e75871UL, 0xae591e73UL, 0x9933dc72UL, 0x1c259377UL, 0x2b4f5176UL, + 0x72f11774UL, 0x459bd575UL, 0x78dc897eUL, 0x4fb64b7fUL, 0x16080d7dUL, + 0x2162cf7cUL, 0xa4748079UL, 0x931e4278UL, 0xcaa0047aUL, 0xfdcac67bUL, + 0xb02ebc6cUL, 0x87447e6dUL, 0xdefa386fUL, 0xe990fa6eUL, 0x6c86b56bUL, + 0x5bec776aUL, 0x02523168UL, 0x3538f369UL, 0x087faf62UL, 0x3f156d63UL, + 0x66ab2b61UL, 0x51c1e960UL, 0xd4d7a665UL, 0xe3bd6464UL, 0xba032266UL, + 0x8d69e067UL, 0x20cbd748UL, 0x17a11549UL, 0x4e1f534bUL, 0x7975914aUL, + 0xfc63de4fUL, 0xcb091c4eUL, 0x92b75a4cUL, 0xa5dd984dUL, 0x989ac446UL, + 0xaff00647UL, 0xf64e4045UL, 0xc1248244UL, 0x4432cd41UL, 0x73580f40UL, + 0x2ae64942UL, 0x1d8c8b43UL, 0x5068f154UL, 0x67023355UL, 0x3ebc7557UL, + 0x09d6b756UL, 0x8cc0f853UL, 0xbbaa3a52UL, 0xe2147c50UL, 0xd57ebe51UL, + 0xe839e25aUL, 0xdf53205bUL, 0x86ed6659UL, 0xb187a458UL, 0x3491eb5dUL, + 0x03fb295cUL, 0x5a456f5eUL, 0x6d2fad5fUL, 0x801b35e1UL, 0xb771f7e0UL, + 0xeecfb1e2UL, 0xd9a573e3UL, 0x5cb33ce6UL, 0x6bd9fee7UL, 0x3267b8e5UL, + 0x050d7ae4UL, 0x384a26efUL, 0x0f20e4eeUL, 0x569ea2ecUL, 0x61f460edUL, + 0xe4e22fe8UL, 0xd388ede9UL, 0x8a36abebUL, 0xbd5c69eaUL, 0xf0b813fdUL, + 0xc7d2d1fcUL, 0x9e6c97feUL, 0xa90655ffUL, 0x2c101afaUL, 0x1b7ad8fbUL, + 0x42c49ef9UL, 0x75ae5cf8UL, 0x48e900f3UL, 0x7f83c2f2UL, 0x263d84f0UL, + 0x115746f1UL, 0x944109f4UL, 0xa32bcbf5UL, 0xfa958df7UL, 0xcdff4ff6UL, + 0x605d78d9UL, 0x5737bad8UL, 0x0e89fcdaUL, 0x39e33edbUL, 0xbcf571deUL, + 0x8b9fb3dfUL, 0xd221f5ddUL, 0xe54b37dcUL, 0xd80c6bd7UL, 0xef66a9d6UL, + 0xb6d8efd4UL, 0x81b22dd5UL, 0x04a462d0UL, 0x33cea0d1UL, 0x6a70e6d3UL, + 0x5d1a24d2UL, 0x10fe5ec5UL, 0x27949cc4UL, 0x7e2adac6UL, 0x494018c7UL, + 0xcc5657c2UL, 0xfb3c95c3UL, 0xa282d3c1UL, 0x95e811c0UL, 0xa8af4dcbUL, + 0x9fc58fcaUL, 0xc67bc9c8UL, 0xf1110bc9UL, 0x740744ccUL, 0x436d86cdUL, + 0x1ad3c0cfUL, 0x2db902ceUL, 0x4096af91UL, 0x77fc6d90UL, 0x2e422b92UL, + 0x1928e993UL, 0x9c3ea696UL, 0xab546497UL, 0xf2ea2295UL, 0xc580e094UL, + 0xf8c7bc9fUL, 0xcfad7e9eUL, 0x9613389cUL, 0xa179fa9dUL, 0x246fb598UL, + 0x13057799UL, 0x4abb319bUL, 0x7dd1f39aUL, 0x3035898dUL, 0x075f4b8cUL, + 0x5ee10d8eUL, 0x698bcf8fUL, 0xec9d808aUL, 0xdbf7428bUL, 0x82490489UL, + 0xb523c688UL, 0x88649a83UL, 0xbf0e5882UL, 0xe6b01e80UL, 0xd1dadc81UL, + 0x54cc9384UL, 0x63a65185UL, 0x3a181787UL, 0x0d72d586UL, 0xa0d0e2a9UL, + 0x97ba20a8UL, 0xce0466aaUL, 0xf96ea4abUL, 0x7c78ebaeUL, 0x4b1229afUL, + 0x12ac6fadUL, 0x25c6adacUL, 0x1881f1a7UL, 0x2feb33a6UL, 0x765575a4UL, + 0x413fb7a5UL, 0xc429f8a0UL, 0xf3433aa1UL, 0xaafd7ca3UL, 0x9d97bea2UL, + 0xd073c4b5UL, 0xe71906b4UL, 0xbea740b6UL, 0x89cd82b7UL, 0x0cdbcdb2UL, + 0x3bb10fb3UL, 0x620f49b1UL, 0x55658bb0UL, 0x6822d7bbUL, 0x5f4815baUL, + 0x06f653b8UL, 0x319c91b9UL, 0xb48adebcUL, 0x83e01cbdUL, 0xda5e5abfUL, + 0xed3498beUL + }, + { + 0x00000000UL, 0x6567bcb8UL, 0x8bc809aaUL, 0xeeafb512UL, 0x5797628fUL, + 0x32f0de37UL, 0xdc5f6b25UL, 0xb938d79dUL, 0xef28b4c5UL, 0x8a4f087dUL, + 0x64e0bd6fUL, 0x018701d7UL, 0xb8bfd64aUL, 0xddd86af2UL, 0x3377dfe0UL, + 0x56106358UL, 0x9f571950UL, 0xfa30a5e8UL, 0x149f10faUL, 0x71f8ac42UL, + 0xc8c07bdfUL, 0xada7c767UL, 0x43087275UL, 0x266fcecdUL, 0x707fad95UL, + 0x1518112dUL, 0xfbb7a43fUL, 0x9ed01887UL, 0x27e8cf1aUL, 0x428f73a2UL, + 0xac20c6b0UL, 0xc9477a08UL, 0x3eaf32a0UL, 0x5bc88e18UL, 0xb5673b0aUL, + 0xd00087b2UL, 0x6938502fUL, 0x0c5fec97UL, 0xe2f05985UL, 0x8797e53dUL, + 0xd1878665UL, 0xb4e03addUL, 0x5a4f8fcfUL, 0x3f283377UL, 0x8610e4eaUL, + 0xe3775852UL, 0x0dd8ed40UL, 0x68bf51f8UL, 0xa1f82bf0UL, 0xc49f9748UL, + 0x2a30225aUL, 0x4f579ee2UL, 0xf66f497fUL, 0x9308f5c7UL, 0x7da740d5UL, + 0x18c0fc6dUL, 0x4ed09f35UL, 0x2bb7238dUL, 0xc518969fUL, 0xa07f2a27UL, + 0x1947fdbaUL, 0x7c204102UL, 0x928ff410UL, 0xf7e848a8UL, 0x3d58149bUL, + 0x583fa823UL, 0xb6901d31UL, 0xd3f7a189UL, 0x6acf7614UL, 0x0fa8caacUL, + 0xe1077fbeUL, 0x8460c306UL, 0xd270a05eUL, 0xb7171ce6UL, 0x59b8a9f4UL, + 0x3cdf154cUL, 0x85e7c2d1UL, 0xe0807e69UL, 0x0e2fcb7bUL, 0x6b4877c3UL, + 0xa20f0dcbUL, 0xc768b173UL, 0x29c70461UL, 0x4ca0b8d9UL, 0xf5986f44UL, + 0x90ffd3fcUL, 0x7e5066eeUL, 0x1b37da56UL, 0x4d27b90eUL, 0x284005b6UL, + 0xc6efb0a4UL, 0xa3880c1cUL, 0x1ab0db81UL, 0x7fd76739UL, 0x9178d22bUL, + 0xf41f6e93UL, 0x03f7263bUL, 0x66909a83UL, 0x883f2f91UL, 0xed589329UL, + 0x546044b4UL, 0x3107f80cUL, 0xdfa84d1eUL, 0xbacff1a6UL, 0xecdf92feUL, + 0x89b82e46UL, 0x67179b54UL, 0x027027ecUL, 0xbb48f071UL, 0xde2f4cc9UL, + 0x3080f9dbUL, 0x55e74563UL, 0x9ca03f6bUL, 0xf9c783d3UL, 0x176836c1UL, + 0x720f8a79UL, 0xcb375de4UL, 0xae50e15cUL, 0x40ff544eUL, 0x2598e8f6UL, + 0x73888baeUL, 0x16ef3716UL, 0xf8408204UL, 0x9d273ebcUL, 0x241fe921UL, + 0x41785599UL, 0xafd7e08bUL, 0xcab05c33UL, 0x3bb659edUL, 0x5ed1e555UL, + 0xb07e5047UL, 0xd519ecffUL, 0x6c213b62UL, 0x094687daUL, 0xe7e932c8UL, + 0x828e8e70UL, 0xd49eed28UL, 0xb1f95190UL, 0x5f56e482UL, 0x3a31583aUL, + 0x83098fa7UL, 0xe66e331fUL, 0x08c1860dUL, 0x6da63ab5UL, 0xa4e140bdUL, + 0xc186fc05UL, 0x2f294917UL, 0x4a4ef5afUL, 0xf3762232UL, 0x96119e8aUL, + 0x78be2b98UL, 0x1dd99720UL, 0x4bc9f478UL, 0x2eae48c0UL, 0xc001fdd2UL, + 0xa566416aUL, 0x1c5e96f7UL, 0x79392a4fUL, 0x97969f5dUL, 0xf2f123e5UL, + 0x05196b4dUL, 0x607ed7f5UL, 0x8ed162e7UL, 0xebb6de5fUL, 0x528e09c2UL, + 0x37e9b57aUL, 0xd9460068UL, 0xbc21bcd0UL, 0xea31df88UL, 0x8f566330UL, + 0x61f9d622UL, 0x049e6a9aUL, 0xbda6bd07UL, 0xd8c101bfUL, 0x366eb4adUL, + 0x53090815UL, 0x9a4e721dUL, 0xff29cea5UL, 0x11867bb7UL, 0x74e1c70fUL, + 0xcdd91092UL, 0xa8beac2aUL, 0x46111938UL, 0x2376a580UL, 0x7566c6d8UL, + 0x10017a60UL, 0xfeaecf72UL, 0x9bc973caUL, 0x22f1a457UL, 0x479618efUL, + 0xa939adfdUL, 0xcc5e1145UL, 0x06ee4d76UL, 0x6389f1ceUL, 0x8d2644dcUL, + 0xe841f864UL, 0x51792ff9UL, 0x341e9341UL, 0xdab12653UL, 0xbfd69aebUL, + 0xe9c6f9b3UL, 0x8ca1450bUL, 0x620ef019UL, 0x07694ca1UL, 0xbe519b3cUL, + 0xdb362784UL, 0x35999296UL, 0x50fe2e2eUL, 0x99b95426UL, 0xfcdee89eUL, + 0x12715d8cUL, 0x7716e134UL, 0xce2e36a9UL, 0xab498a11UL, 0x45e63f03UL, + 0x208183bbUL, 0x7691e0e3UL, 0x13f65c5bUL, 0xfd59e949UL, 0x983e55f1UL, + 0x2106826cUL, 0x44613ed4UL, 0xaace8bc6UL, 0xcfa9377eUL, 0x38417fd6UL, + 0x5d26c36eUL, 0xb389767cUL, 0xd6eecac4UL, 0x6fd61d59UL, 0x0ab1a1e1UL, + 0xe41e14f3UL, 0x8179a84bUL, 0xd769cb13UL, 0xb20e77abUL, 0x5ca1c2b9UL, + 0x39c67e01UL, 0x80fea99cUL, 0xe5991524UL, 0x0b36a036UL, 0x6e511c8eUL, + 0xa7166686UL, 0xc271da3eUL, 0x2cde6f2cUL, 0x49b9d394UL, 0xf0810409UL, + 0x95e6b8b1UL, 0x7b490da3UL, 0x1e2eb11bUL, 0x483ed243UL, 0x2d596efbUL, + 0xc3f6dbe9UL, 0xa6916751UL, 0x1fa9b0ccUL, 0x7ace0c74UL, 0x9461b966UL, + 0xf10605deUL +#endif + } +}; diff --git a/erts/emulator/zlib/deflate.c b/erts/emulator/zlib/deflate.c new file mode 100644 index 0000000000..92f4be57c5 --- /dev/null +++ b/erts/emulator/zlib/deflate.c @@ -0,0 +1,1741 @@ +/* deflate.c -- compress data using the deflation algorithm + * Copyright (C) 1995-2005 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* + * ALGORITHM + * + * The "deflation" process depends on being able to identify portions + * of the input text which are identical to earlier input (within a + * sliding window trailing behind the input currently being processed). + * + * The most straightforward technique turns out to be the fastest for + * most input files: try all possible matches and select the longest. + * The key feature of this algorithm is that insertions into the string + * dictionary are very simple and thus fast, and deletions are avoided + * completely. Insertions are performed at each input character, whereas + * string matches are performed only when the previous match ends. So it + * is preferable to spend more time in matches to allow very fast string + * insertions and avoid deletions. The matching algorithm for small + * strings is inspired from that of Rabin & Karp. A brute force approach + * is used to find longer strings when a small match has been found. + * A similar algorithm is used in comic (by Jan-Mark Wams) and freeze + * (by Leonid Broukhis). + * A previous version of this file used a more sophisticated algorithm + * (by Fiala and Greene) which is guaranteed to run in linear amortized + * time, but has a larger average cost, uses more memory and is patented. + * However the F&G algorithm may be faster for some highly redundant + * files if the parameter max_chain_length (described below) is too large. + * + * ACKNOWLEDGEMENTS + * + * The idea of lazy evaluation of matches is due to Jan-Mark Wams, and + * I found it in 'freeze' written by Leonid Broukhis. + * Thanks to many people for bug reports and testing. + * + * REFERENCES + * + * Deutsch, L.P.,"DEFLATE Compressed Data Format Specification". + * Available in http://www.ietf.org/rfc/rfc1951.txt + * + * A description of the Rabin and Karp algorithm is given in the book + * "Algorithms" by R. Sedgewick, Addison-Wesley, p252. + * + * Fiala,E.R., and Greene,D.H. + * Data Compression with Finite Windows, Comm.ACM, 32,4 (1989) 490-595 + * + */ + +/* @(#) $Id$ */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "deflate.h" + +const char deflate_copyright[] = + " deflate 1.2.3 Copyright 1995-2005 Jean-loup Gailly "; +/* + If you use the zlib library in a product, an acknowledgment is welcome + in the documentation of your product. If for some reason you cannot + include such an acknowledgment, I would appreciate that you keep this + copyright string in the executable of your product. + */ + +/* =========================================================================== + * Function prototypes. + */ +typedef enum { + need_more, /* block not completed, need more input or more output */ + block_done, /* block flush performed */ + finish_started, /* finish started, need only more output at next deflate */ + finish_done /* finish done, accept no more input or output */ +} block_state; + +typedef block_state (*compress_func) OF((deflate_state *s, int flush)); +/* Compression function. Returns the block state after the call. */ + +local void fill_window OF((deflate_state *s)); +local block_state deflate_stored OF((deflate_state *s, int flush)); +local block_state deflate_fast OF((deflate_state *s, int flush)); +#ifndef FASTEST +local block_state deflate_slow OF((deflate_state *s, int flush)); +#endif +local void lm_init OF((deflate_state *s)); +local void putShortMSB OF((deflate_state *s, uInt b)); +local void flush_pending OF((z_streamp strm)); +local int read_buf OF((z_streamp strm, Bytef *buf, unsigned size)); +#ifndef FASTEST +#ifdef ASMV + void match_init OF((void)); /* asm code initialization */ + uInt longest_match OF((deflate_state *s, IPos cur_match)); +#else +local uInt longest_match OF((deflate_state *s, IPos cur_match)); +#endif +#endif +local uInt longest_match_fast OF((deflate_state *s, IPos cur_match)); + +#ifdef DEBUG +local void check_match OF((deflate_state *s, IPos start, IPos match, + int length)); +#endif + +/* =========================================================================== + * Local data + */ + +#define NIL 0 +/* Tail of hash chains */ + +#ifndef TOO_FAR +# define TOO_FAR 4096 +#endif +/* Matches of length 3 are discarded if their distance exceeds TOO_FAR */ + +#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +/* Minimum amount of lookahead, except at the end of the input file. + * See deflate.c for comments about the MIN_MATCH+1. + */ + +/* Values for max_lazy_match, good_match and max_chain_length, depending on + * the desired pack level (0..9). The values given below have been tuned to + * exclude worst case performance for pathological files. Better values may be + * found for specific files. + */ +typedef struct config_s { + ush good_length; /* reduce lazy search above this match length */ + ush max_lazy; /* do not perform lazy search above this match length */ + ush nice_length; /* quit search above this match length */ + ush max_chain; + compress_func func; +} config; + +#ifdef FASTEST +local const config configuration_table[2] = { +/* good lazy nice chain */ +/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ +/* 1 */ {4, 4, 8, 4, deflate_fast}}; /* max speed, no lazy matches */ +#else +local const config configuration_table[10] = { +/* good lazy nice chain */ +/* 0 */ {0, 0, 0, 0, deflate_stored}, /* store only */ +/* 1 */ {4, 4, 8, 4, deflate_fast}, /* max speed, no lazy matches */ +/* 2 */ {4, 5, 16, 8, deflate_fast}, +/* 3 */ {4, 6, 32, 32, deflate_fast}, + +/* 4 */ {4, 4, 16, 16, deflate_slow}, /* lazy matches */ +/* 5 */ {8, 16, 32, 32, deflate_slow}, +/* 6 */ {8, 16, 128, 128, deflate_slow}, +/* 7 */ {8, 32, 128, 256, deflate_slow}, +/* 8 */ {32, 128, 258, 1024, deflate_slow}, +/* 9 */ {32, 258, 258, 4096, deflate_slow}}; /* max compression */ +#endif + +/* Note: the deflate() code requires max_lazy >= MIN_MATCH and max_chain >= 4 + * For deflate_fast() (levels <= 3) good is ignored and lazy has a different + * meaning. + */ + +#define EQUAL 0 +/* result of memcmp for equal strings */ + +#ifndef NO_DUMMY_DECL +struct static_tree_desc_s {int dummy;}; /* for buggy compilers */ +#endif + +/* =========================================================================== + * Update a hash value with the given input byte + * IN assertion: all calls to to UPDATE_HASH are made with consecutive + * input characters, so that a running hash key can be computed from the + * previous key instead of complete recalculation each time. + */ +#define UPDATE_HASH(s,h,c) (h = (((h)<hash_shift) ^ (c)) & s->hash_mask) + + +/* =========================================================================== + * Insert string str in the dictionary and set match_head to the previous head + * of the hash chain (the most recent string with same hash key). Return + * the previous length of the hash chain. + * If this file is compiled with -DFASTEST, the compression level is forced + * to 1, and no hash chains are maintained. + * IN assertion: all calls to to INSERT_STRING are made with consecutive + * input characters and the first MIN_MATCH bytes of str are valid + * (except for the last MIN_MATCH-1 bytes of the input file). + */ +#ifdef FASTEST +#define INSERT_STRING(s, str, match_head) \ + (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ + match_head = s->head[s->ins_h], \ + s->head[s->ins_h] = (Pos)(str)) +#else +#define INSERT_STRING(s, str, match_head) \ + (UPDATE_HASH(s, s->ins_h, s->window[(str) + (MIN_MATCH-1)]), \ + match_head = s->prev[(str) & s->w_mask] = s->head[s->ins_h], \ + s->head[s->ins_h] = (Pos)(str)) +#endif + +/* =========================================================================== + * Initialize the hash table (avoiding 64K overflow for 16 bit systems). + * prev[] will be initialized on the fly. + */ +#define CLEAR_HASH(s) \ + s->head[s->hash_size-1] = NIL; \ + zmemzero((Bytef *)s->head, (unsigned)(s->hash_size-1)*sizeof(*s->head)); + +/* ========================================================================= */ +int ZEXPORT deflateInit_(strm, level, version, stream_size) + z_streamp strm; + int level; + const char *version; + int stream_size; +{ + return deflateInit2_(strm, level, Z_DEFLATED, MAX_WBITS, DEF_MEM_LEVEL, + Z_DEFAULT_STRATEGY, version, stream_size); + /* To do: ignore strm->next_in if we use it as window */ +} + +/* ========================================================================= */ +int ZEXPORT deflateInit2_(strm, level, method, windowBits, memLevel, strategy, + version, stream_size) + z_streamp strm; + int level; + int method; + int windowBits; + int memLevel; + int strategy; + const char *version; + int stream_size; +{ + deflate_state *s; + int wrap = 1; + static const char my_version[] = ZLIB_VERSION; + + ushf *overlay; + /* We overlay pending_buf and d_buf+l_buf. This works since the average + * output size for (length,distance) codes is <= 24 bits. + */ + + if (version == Z_NULL || version[0] != my_version[0] || + stream_size != sizeof(z_stream)) { + return Z_VERSION_ERROR; + } + if (strm == Z_NULL) return Z_STREAM_ERROR; + + strm->msg = Z_NULL; + if (strm->zalloc == (alloc_func)0) { + strm->zalloc = zcalloc; + strm->opaque = (voidpf)0; + } + if (strm->zfree == (free_func)0) strm->zfree = zcfree; + +#ifdef FASTEST + if (level != 0) level = 1; +#else + if (level == Z_DEFAULT_COMPRESSION) level = 6; +#endif + + if (windowBits < 0) { /* suppress zlib wrapper */ + wrap = 0; + windowBits = -windowBits; + } +#ifdef GZIP + else if (windowBits > 15) { + wrap = 2; /* write gzip wrapper instead */ + windowBits -= 16; + } +#endif + if (memLevel < 1 || memLevel > MAX_MEM_LEVEL || method != Z_DEFLATED || + windowBits < 8 || windowBits > 15 || level < 0 || level > 9 || + strategy < 0 || strategy > Z_FIXED) { + return Z_STREAM_ERROR; + } + if (windowBits == 8) windowBits = 9; /* until 256-byte window bug fixed */ + s = (deflate_state *) ZALLOC(strm, 1, sizeof(deflate_state)); + if (s == Z_NULL) return Z_MEM_ERROR; + strm->state = (struct internal_state FAR *)s; + s->strm = strm; + + s->wrap = wrap; + s->gzhead = Z_NULL; + s->w_bits = windowBits; + s->w_size = 1 << s->w_bits; + s->w_mask = s->w_size - 1; + + s->hash_bits = memLevel + 7; + s->hash_size = 1 << s->hash_bits; + s->hash_mask = s->hash_size - 1; + s->hash_shift = ((s->hash_bits+MIN_MATCH-1)/MIN_MATCH); + + s->window = (Bytef *) ZALLOC(strm, s->w_size, 2*sizeof(Byte)); + s->prev = (Posf *) ZALLOC(strm, s->w_size, sizeof(Pos)); + s->head = (Posf *) ZALLOC(strm, s->hash_size, sizeof(Pos)); + + s->lit_bufsize = 1 << (memLevel + 6); /* 16K elements by default */ + + overlay = (ushf *) ZALLOC(strm, s->lit_bufsize, sizeof(ush)+2); + s->pending_buf = (uchf *) overlay; + s->pending_buf_size = (ulg)s->lit_bufsize * (sizeof(ush)+2L); + + if (s->window == Z_NULL || s->prev == Z_NULL || s->head == Z_NULL || + s->pending_buf == Z_NULL) { + s->status = FINISH_STATE; + strm->msg = (char*)ERR_MSG(Z_MEM_ERROR); + deflateEnd (strm); + return Z_MEM_ERROR; + } + s->d_buf = overlay + s->lit_bufsize/sizeof(ush); + s->l_buf = s->pending_buf + (1+sizeof(ush))*s->lit_bufsize; + + s->level = level; + s->strategy = strategy; + s->method = (Byte)method; + + return deflateReset(strm); +} + +/* ========================================================================= */ +int ZEXPORT deflateSetDictionary (strm, dictionary, dictLength) + z_streamp strm; + const Bytef *dictionary; + uInt dictLength; +{ + deflate_state *s; + uInt length = dictLength; + uInt n; + IPos hash_head = 0; + + if (strm == Z_NULL || strm->state == Z_NULL || dictionary == Z_NULL || + strm->state->wrap == 2 || + (strm->state->wrap == 1 && strm->state->status != INIT_STATE)) + return Z_STREAM_ERROR; + + s = strm->state; + if (s->wrap) + strm->adler = adler32(strm->adler, dictionary, dictLength); + + if (length < MIN_MATCH) return Z_OK; + if (length > MAX_DIST(s)) { + length = MAX_DIST(s); + dictionary += dictLength - length; /* use the tail of the dictionary */ + } + zmemcpy(s->window, dictionary, length); + s->strstart = length; + s->block_start = (long)length; + + /* Insert all strings in the hash table (except for the last two bytes). + * s->lookahead stays null, so s->ins_h will be recomputed at the next + * call of fill_window. + */ + s->ins_h = s->window[0]; + UPDATE_HASH(s, s->ins_h, s->window[1]); + for (n = 0; n <= length - MIN_MATCH; n++) { + INSERT_STRING(s, n, hash_head); + } + if (hash_head) hash_head = 0; /* to make compiler happy */ + return Z_OK; +} + +/* ========================================================================= */ +int ZEXPORT deflateReset (strm) + z_streamp strm; +{ + deflate_state *s; + + if (strm == Z_NULL || strm->state == Z_NULL || + strm->zalloc == (alloc_func)0 || strm->zfree == (free_func)0) { + return Z_STREAM_ERROR; + } + + strm->total_in = strm->total_out = 0; + strm->msg = Z_NULL; /* use zfree if we ever allocate msg dynamically */ + strm->data_type = Z_UNKNOWN; + + s = (deflate_state *)strm->state; + s->pending = 0; + s->pending_out = s->pending_buf; + + if (s->wrap < 0) { + s->wrap = -s->wrap; /* was made negative by deflate(..., Z_FINISH); */ + } + s->status = s->wrap ? INIT_STATE : BUSY_STATE; + strm->adler = +#ifdef GZIP + s->wrap == 2 ? crc32(0L, Z_NULL, 0) : +#endif + adler32(0L, Z_NULL, 0); + s->last_flush = Z_NO_FLUSH; + + _tr_init(s); + lm_init(s); + + return Z_OK; +} + +/* ========================================================================= */ +int ZEXPORT deflateSetHeader (strm, head) + z_streamp strm; + gz_headerp head; +{ + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + if (strm->state->wrap != 2) return Z_STREAM_ERROR; + strm->state->gzhead = head; + return Z_OK; +} + +/* ========================================================================= */ +int ZEXPORT deflatePrime (strm, bits, value) + z_streamp strm; + int bits; + int value; +{ + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + strm->state->bi_valid = bits; + strm->state->bi_buf = (ush)(value & ((1 << bits) - 1)); + return Z_OK; +} + +/* ========================================================================= */ +int ZEXPORT deflateParams(strm, level, strategy) + z_streamp strm; + int level; + int strategy; +{ + deflate_state *s; + compress_func func; + int err = Z_OK; + + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + s = strm->state; + +#ifdef FASTEST + if (level != 0) level = 1; +#else + if (level == Z_DEFAULT_COMPRESSION) level = 6; +#endif + if (level < 0 || level > 9 || strategy < 0 || strategy > Z_FIXED) { + return Z_STREAM_ERROR; + } + func = configuration_table[s->level].func; + + if (func != configuration_table[level].func && strm->total_in != 0) { + /* Flush the last buffer: */ + err = deflate(strm, Z_PARTIAL_FLUSH); + } + if (s->level != level) { + s->level = level; + s->max_lazy_match = configuration_table[level].max_lazy; + s->good_match = configuration_table[level].good_length; + s->nice_match = configuration_table[level].nice_length; + s->max_chain_length = configuration_table[level].max_chain; + } + s->strategy = strategy; + return err; +} + +/* ========================================================================= */ +int ZEXPORT deflateTune(strm, good_length, max_lazy, nice_length, max_chain) + z_streamp strm; + int good_length; + int max_lazy; + int nice_length; + int max_chain; +{ + deflate_state *s; + + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + s = strm->state; + s->good_match = good_length; + s->max_lazy_match = max_lazy; + s->nice_match = nice_length; + s->max_chain_length = max_chain; + return Z_OK; +} + +/* ========================================================================= + * For the default windowBits of 15 and memLevel of 8, this function returns + * a close to exact, as well as small, upper bound on the compressed size. + * They are coded as constants here for a reason--if the #define's are + * changed, then this function needs to be changed as well. The return + * value for 15 and 8 only works for those exact settings. + * + * For any setting other than those defaults for windowBits and memLevel, + * the value returned is a conservative worst case for the maximum expansion + * resulting from using fixed blocks instead of stored blocks, which deflate + * can emit on compressed data for some combinations of the parameters. + * + * This function could be more sophisticated to provide closer upper bounds + * for every combination of windowBits and memLevel, as well as wrap. + * But even the conservative upper bound of about 14% expansion does not + * seem onerous for output buffer allocation. + */ +uLong ZEXPORT deflateBound(strm, sourceLen) + z_streamp strm; + uLong sourceLen; +{ + deflate_state *s; + uLong destLen; + + /* conservative upper bound */ + destLen = sourceLen + + ((sourceLen + 7) >> 3) + ((sourceLen + 63) >> 6) + 11; + + /* if can't get parameters, return conservative bound */ + if (strm == Z_NULL || strm->state == Z_NULL) + return destLen; + + /* if not default parameters, return conservative bound */ + s = strm->state; + if (s->w_bits != 15 || s->hash_bits != 8 + 7) + return destLen; + + /* default settings: return tight bound for that case */ + return compressBound(sourceLen); +} + +/* ========================================================================= + * Put a short in the pending buffer. The 16-bit value is put in MSB order. + * IN assertion: the stream state is correct and there is enough room in + * pending_buf. + */ +local void putShortMSB (s, b) + deflate_state *s; + uInt b; +{ + put_byte(s, (Byte)(b >> 8)); + put_byte(s, (Byte)(b & 0xff)); +} + +/* ========================================================================= + * Flush as much pending output as possible. All deflate() output goes + * through this function so some applications may wish to modify it + * to avoid allocating a large strm->next_out buffer and copying into it. + * (See also read_buf()). + */ +local void flush_pending(strm) + z_streamp strm; +{ + unsigned len = strm->state->pending; + + if (len > strm->avail_out) len = strm->avail_out; + if (len == 0) return; + + zmemcpy(strm->next_out, strm->state->pending_out, len); + strm->next_out += len; + strm->state->pending_out += len; + strm->total_out += len; + strm->avail_out -= len; + strm->state->pending -= len; + if (strm->state->pending == 0) { + strm->state->pending_out = strm->state->pending_buf; + } +} + +/* ========================================================================= */ +int ZEXPORT deflate (strm, flush) + z_streamp strm; + int flush; +{ + int old_flush; /* value of flush param for previous deflate call */ + deflate_state *s; + + if (strm == Z_NULL || strm->state == Z_NULL || + flush > Z_FINISH || flush < 0) { + return Z_STREAM_ERROR; + } + s = strm->state; + + if (strm->next_out == Z_NULL || + (strm->next_in == Z_NULL && strm->avail_in != 0) || + (s->status == FINISH_STATE && flush != Z_FINISH)) { + ERR_RETURN(strm, Z_STREAM_ERROR); + } + if (strm->avail_out == 0) ERR_RETURN(strm, Z_BUF_ERROR); + + s->strm = strm; /* just in case */ + old_flush = s->last_flush; + s->last_flush = flush; + + /* Write the header */ + if (s->status == INIT_STATE) { +#ifdef GZIP + if (s->wrap == 2) { + strm->adler = crc32(0L, Z_NULL, 0); + put_byte(s, 31); + put_byte(s, 139); + put_byte(s, 8); + if (s->gzhead == NULL) { + put_byte(s, 0); + put_byte(s, 0); + put_byte(s, 0); + put_byte(s, 0); + put_byte(s, 0); + put_byte(s, s->level == 9 ? 2 : + (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? + 4 : 0)); + put_byte(s, OS_CODE); + s->status = BUSY_STATE; + } + else { + put_byte(s, (s->gzhead->text ? 1 : 0) + + (s->gzhead->hcrc ? 2 : 0) + + (s->gzhead->extra == Z_NULL ? 0 : 4) + + (s->gzhead->name == Z_NULL ? 0 : 8) + + (s->gzhead->comment == Z_NULL ? 0 : 16) + ); + put_byte(s, (Byte)(s->gzhead->time & 0xff)); + put_byte(s, (Byte)((s->gzhead->time >> 8) & 0xff)); + put_byte(s, (Byte)((s->gzhead->time >> 16) & 0xff)); + put_byte(s, (Byte)((s->gzhead->time >> 24) & 0xff)); + put_byte(s, s->level == 9 ? 2 : + (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2 ? + 4 : 0)); + put_byte(s, s->gzhead->os & 0xff); + if (s->gzhead->extra != NULL) { + put_byte(s, s->gzhead->extra_len & 0xff); + put_byte(s, (s->gzhead->extra_len >> 8) & 0xff); + } + if (s->gzhead->hcrc) + strm->adler = crc32(strm->adler, s->pending_buf, + s->pending); + s->gzindex = 0; + s->status = EXTRA_STATE; + } + } + else +#endif + { + uInt header = (Z_DEFLATED + ((s->w_bits-8)<<4)) << 8; + uInt level_flags; + + if (s->strategy >= Z_HUFFMAN_ONLY || s->level < 2) + level_flags = 0; + else if (s->level < 6) + level_flags = 1; + else if (s->level == 6) + level_flags = 2; + else + level_flags = 3; + header |= (level_flags << 6); + if (s->strstart != 0) header |= PRESET_DICT; + header += 31 - (header % 31); + + s->status = BUSY_STATE; + putShortMSB(s, header); + + /* Save the adler32 of the preset dictionary: */ + if (s->strstart != 0) { + putShortMSB(s, (uInt)(strm->adler >> 16)); + putShortMSB(s, (uInt)(strm->adler & 0xffff)); + } + strm->adler = adler32(0L, Z_NULL, 0); + } + } +#ifdef GZIP + if (s->status == EXTRA_STATE) { + if (s->gzhead->extra != NULL) { + uInt beg = s->pending; /* start of bytes to update crc */ + + while (s->gzindex < (s->gzhead->extra_len & 0xffff)) { + if (s->pending == s->pending_buf_size) { + if (s->gzhead->hcrc && s->pending > beg) + strm->adler = crc32(strm->adler, s->pending_buf + beg, + s->pending - beg); + flush_pending(strm); + beg = s->pending; + if (s->pending == s->pending_buf_size) + break; + } + put_byte(s, s->gzhead->extra[s->gzindex]); + s->gzindex++; + } + if (s->gzhead->hcrc && s->pending > beg) + strm->adler = crc32(strm->adler, s->pending_buf + beg, + s->pending - beg); + if (s->gzindex == s->gzhead->extra_len) { + s->gzindex = 0; + s->status = NAME_STATE; + } + } + else + s->status = NAME_STATE; + } + if (s->status == NAME_STATE) { + if (s->gzhead->name != NULL) { + uInt beg = s->pending; /* start of bytes to update crc */ + int val; + + do { + if (s->pending == s->pending_buf_size) { + if (s->gzhead->hcrc && s->pending > beg) + strm->adler = crc32(strm->adler, s->pending_buf + beg, + s->pending - beg); + flush_pending(strm); + beg = s->pending; + if (s->pending == s->pending_buf_size) { + val = 1; + break; + } + } + val = s->gzhead->name[s->gzindex++]; + put_byte(s, val); + } while (val != 0); + if (s->gzhead->hcrc && s->pending > beg) + strm->adler = crc32(strm->adler, s->pending_buf + beg, + s->pending - beg); + if (val == 0) { + s->gzindex = 0; + s->status = COMMENT_STATE; + } + } + else + s->status = COMMENT_STATE; + } + if (s->status == COMMENT_STATE) { + if (s->gzhead->comment != NULL) { + uInt beg = s->pending; /* start of bytes to update crc */ + int val; + + do { + if (s->pending == s->pending_buf_size) { + if (s->gzhead->hcrc && s->pending > beg) + strm->adler = crc32(strm->adler, s->pending_buf + beg, + s->pending - beg); + flush_pending(strm); + beg = s->pending; + if (s->pending == s->pending_buf_size) { + val = 1; + break; + } + } + val = s->gzhead->comment[s->gzindex++]; + put_byte(s, val); + } while (val != 0); + if (s->gzhead->hcrc && s->pending > beg) + strm->adler = crc32(strm->adler, s->pending_buf + beg, + s->pending - beg); + if (val == 0) + s->status = HCRC_STATE; + } + else + s->status = HCRC_STATE; + } + if (s->status == HCRC_STATE) { + if (s->gzhead->hcrc) { + if (s->pending + 2 > s->pending_buf_size) + flush_pending(strm); + if (s->pending + 2 <= s->pending_buf_size) { + put_byte(s, (Byte)(strm->adler & 0xff)); + put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); + strm->adler = crc32(0L, Z_NULL, 0); + s->status = BUSY_STATE; + } + } + else + s->status = BUSY_STATE; + } +#endif + + /* Flush as much pending output as possible */ + if (s->pending != 0) { + flush_pending(strm); + if (strm->avail_out == 0) { + /* Since avail_out is 0, deflate will be called again with + * more output space, but possibly with both pending and + * avail_in equal to zero. There won't be anything to do, + * but this is not an error situation so make sure we + * return OK instead of BUF_ERROR at next call of deflate: + */ + s->last_flush = -1; + return Z_OK; + } + + /* Make sure there is something to do and avoid duplicate consecutive + * flushes. For repeated and useless calls with Z_FINISH, we keep + * returning Z_STREAM_END instead of Z_BUF_ERROR. + */ + } else if (strm->avail_in == 0 && flush <= old_flush && + flush != Z_FINISH) { + ERR_RETURN(strm, Z_BUF_ERROR); + } + + /* User must not provide more input after the first FINISH: */ + if (s->status == FINISH_STATE && strm->avail_in != 0) { + ERR_RETURN(strm, Z_BUF_ERROR); + } + + /* Start a new block or continue the current one. + */ + if (strm->avail_in != 0 || s->lookahead != 0 || + (flush != Z_NO_FLUSH && s->status != FINISH_STATE)) { + block_state bstate; + + bstate = (*(configuration_table[s->level].func))(s, flush); + + if (bstate == finish_started || bstate == finish_done) { + s->status = FINISH_STATE; + } + if (bstate == need_more || bstate == finish_started) { + if (strm->avail_out == 0) { + s->last_flush = -1; /* avoid BUF_ERROR next call, see above */ + } + return Z_OK; + /* If flush != Z_NO_FLUSH && avail_out == 0, the next call + * of deflate should use the same flush parameter to make sure + * that the flush is complete. So we don't have to output an + * empty block here, this will be done at next call. This also + * ensures that for a very small output buffer, we emit at most + * one empty block. + */ + } + if (bstate == block_done) { + if (flush == Z_PARTIAL_FLUSH) { + _tr_align(s); + } else { /* FULL_FLUSH or SYNC_FLUSH */ + _tr_stored_block(s, (char*)0, 0L, 0); + /* For a full flush, this empty block will be recognized + * as a special marker by inflate_sync(). + */ + if (flush == Z_FULL_FLUSH) { + CLEAR_HASH(s); /* forget history */ + } + } + flush_pending(strm); + if (strm->avail_out == 0) { + s->last_flush = -1; /* avoid BUF_ERROR at next call, see above */ + return Z_OK; + } + } + } + Assert(strm->avail_out > 0, "bug2"); + + if (flush != Z_FINISH) return Z_OK; + if (s->wrap <= 0) return Z_STREAM_END; + + /* Write the trailer */ +#ifdef GZIP + if (s->wrap == 2) { + put_byte(s, (Byte)(strm->adler & 0xff)); + put_byte(s, (Byte)((strm->adler >> 8) & 0xff)); + put_byte(s, (Byte)((strm->adler >> 16) & 0xff)); + put_byte(s, (Byte)((strm->adler >> 24) & 0xff)); + put_byte(s, (Byte)(strm->total_in & 0xff)); + put_byte(s, (Byte)((strm->total_in >> 8) & 0xff)); + put_byte(s, (Byte)((strm->total_in >> 16) & 0xff)); + put_byte(s, (Byte)((strm->total_in >> 24) & 0xff)); + } + else +#endif + { + putShortMSB(s, (uInt)(strm->adler >> 16)); + putShortMSB(s, (uInt)(strm->adler & 0xffff)); + } + flush_pending(strm); + /* If avail_out is zero, the application will call deflate again + * to flush the rest. + */ + if (s->wrap > 0) s->wrap = -s->wrap; /* write the trailer only once! */ + return s->pending != 0 ? Z_OK : Z_STREAM_END; +} + +/* ========================================================================= */ +int ZEXPORT deflateEnd (strm) + z_streamp strm; +{ + int status; + + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + + status = strm->state->status; + if (status != INIT_STATE && + status != EXTRA_STATE && + status != NAME_STATE && + status != COMMENT_STATE && + status != HCRC_STATE && + status != BUSY_STATE && + status != FINISH_STATE) { + return Z_STREAM_ERROR; + } + + /* Deallocate in reverse order of allocations: */ + TRY_FREE(strm, strm->state->pending_buf); + TRY_FREE(strm, strm->state->head); + TRY_FREE(strm, strm->state->prev); + TRY_FREE(strm, strm->state->window); + + ZFREE(strm, strm->state); + strm->state = Z_NULL; + + return status == BUSY_STATE ? Z_DATA_ERROR : Z_OK; +} + +/* ========================================================================= + * Copy the source state to the destination state. + * To simplify the source, this is not supported for 16-bit MSDOS (which + * doesn't have enough memory anyway to duplicate compression states). + */ +int ZEXPORT deflateCopy (dest, source) + z_streamp dest; + z_streamp source; +{ +#ifdef MAXSEG_64K + return Z_STREAM_ERROR; +#else + deflate_state *ds; + deflate_state *ss; + ushf *overlay; + + + if (source == Z_NULL || dest == Z_NULL || source->state == Z_NULL) { + return Z_STREAM_ERROR; + } + + ss = source->state; + + zmemcpy(dest, source, sizeof(z_stream)); + + ds = (deflate_state *) ZALLOC(dest, 1, sizeof(deflate_state)); + if (ds == Z_NULL) return Z_MEM_ERROR; + dest->state = (struct internal_state FAR *) ds; + zmemcpy(ds, ss, sizeof(deflate_state)); + ds->strm = dest; + + ds->window = (Bytef *) ZALLOC(dest, ds->w_size, 2*sizeof(Byte)); + ds->prev = (Posf *) ZALLOC(dest, ds->w_size, sizeof(Pos)); + ds->head = (Posf *) ZALLOC(dest, ds->hash_size, sizeof(Pos)); + overlay = (ushf *) ZALLOC(dest, ds->lit_bufsize, sizeof(ush)+2); + ds->pending_buf = (uchf *) overlay; + + if (ds->window == Z_NULL || ds->prev == Z_NULL || ds->head == Z_NULL || + ds->pending_buf == Z_NULL) { + deflateEnd (dest); + return Z_MEM_ERROR; + } + /* following zmemcpy do not work for 16-bit MSDOS */ + zmemcpy(ds->window, ss->window, ds->w_size * 2 * sizeof(Byte)); + zmemcpy(ds->prev, ss->prev, ds->w_size * sizeof(Pos)); + zmemcpy(ds->head, ss->head, ds->hash_size * sizeof(Pos)); + zmemcpy(ds->pending_buf, ss->pending_buf, (uInt)ds->pending_buf_size); + + ds->pending_out = ds->pending_buf + (ss->pending_out - ss->pending_buf); + ds->d_buf = overlay + ds->lit_bufsize/sizeof(ush); + ds->l_buf = ds->pending_buf + (1+sizeof(ush))*ds->lit_bufsize; + + ds->l_desc.dyn_tree = ds->dyn_ltree; + ds->d_desc.dyn_tree = ds->dyn_dtree; + ds->bl_desc.dyn_tree = ds->bl_tree; + + return Z_OK; +#endif /* MAXSEG_64K */ +} + +/* =========================================================================== + * Read a new buffer from the current input stream, update the adler32 + * and total number of bytes read. All deflate() input goes through + * this function so some applications may wish to modify it to avoid + * allocating a large strm->next_in buffer and copying from it. + * (See also flush_pending()). + */ +local int read_buf(strm, buf, size) + z_streamp strm; + Bytef *buf; + unsigned size; +{ + unsigned len = strm->avail_in; + + if (len > size) len = size; + if (len == 0) return 0; + + strm->avail_in -= len; + + if (strm->state->wrap == 1) { + strm->adler = adler32(strm->adler, strm->next_in, len); + } +#ifdef GZIP + else if (strm->state->wrap == 2) { + strm->adler = crc32(strm->adler, strm->next_in, len); + } +#endif + zmemcpy(buf, strm->next_in, len); + strm->next_in += len; + strm->total_in += len; + + return (int)len; +} + +/* =========================================================================== + * Initialize the "longest match" routines for a new zlib stream + */ +local void lm_init (s) + deflate_state *s; +{ + s->window_size = (ulg)2L*s->w_size; + + CLEAR_HASH(s); + + /* Set the default configuration parameters: + */ + s->max_lazy_match = configuration_table[s->level].max_lazy; + s->good_match = configuration_table[s->level].good_length; + s->nice_match = configuration_table[s->level].nice_length; + s->max_chain_length = configuration_table[s->level].max_chain; + + s->strstart = 0; + s->block_start = 0L; + s->lookahead = 0; + s->match_length = s->prev_length = MIN_MATCH-1; + s->match_available = 0; + s->ins_h = 0; +#ifndef FASTEST +#ifdef ASMV + match_init(); /* initialize the asm code */ +#endif +#endif +} + +#ifndef FASTEST +/* =========================================================================== + * Set match_start to the longest match starting at the given string and + * return its length. Matches shorter or equal to prev_length are discarded, + * in which case the result is equal to prev_length and match_start is + * garbage. + * IN assertions: cur_match is the head of the hash chain for the current + * string (strstart) and its distance is <= MAX_DIST, and prev_length >= 1 + * OUT assertion: the match length is not greater than s->lookahead. + */ +#ifndef ASMV +/* For 80x86 and 680x0, an optimized version will be provided in match.asm or + * match.S. The code will be functionally equivalent. + */ +local uInt longest_match(s, cur_match) + deflate_state *s; + IPos cur_match; /* current match */ +{ + unsigned chain_length = s->max_chain_length;/* max hash chain length */ + register Bytef *scan = s->window + s->strstart; /* current string */ + register Bytef *match; /* matched string */ + register int len; /* length of current match */ + int best_len = s->prev_length; /* best match length so far */ + int nice_match = s->nice_match; /* stop if match long enough */ + IPos limit = s->strstart > (IPos)MAX_DIST(s) ? + s->strstart - (IPos)MAX_DIST(s) : NIL; + /* Stop when cur_match becomes <= limit. To simplify the code, + * we prevent matches with the string of window index 0. + */ + Posf *prev = s->prev; + uInt wmask = s->w_mask; + +#ifdef UNALIGNED_OK + /* Compare two bytes at a time. Note: this is not always beneficial. + * Try with and without -DUNALIGNED_OK to check. + */ + register Bytef *strend = s->window + s->strstart + MAX_MATCH - 1; + register ush scan_start = *(ushf*)scan; + register ush scan_end = *(ushf*)(scan+best_len-1); +#else + register Bytef *strend = s->window + s->strstart + MAX_MATCH; + register Byte scan_end1 = scan[best_len-1]; + register Byte scan_end = scan[best_len]; +#endif + + /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16. + * It is easy to get rid of this optimization if necessary. + */ + Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); + + /* Do not waste too much time if we already have a good match: */ + if (s->prev_length >= s->good_match) { + chain_length >>= 2; + } + /* Do not look for matches beyond the end of the input. This is necessary + * to make deflate deterministic. + */ + if ((uInt)nice_match > s->lookahead) nice_match = s->lookahead; + + Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); + + do { + Assert(cur_match < s->strstart, "no future"); + match = s->window + cur_match; + + /* Skip to next match if the match length cannot increase + * or if the match length is less than 2. Note that the checks below + * for insufficient lookahead only occur occasionally for performance + * reasons. Therefore uninitialized memory will be accessed, and + * conditional jumps will be made that depend on those values. + * However the length of the match is limited to the lookahead, so + * the output of deflate is not affected by the uninitialized values. + */ +#if (defined(UNALIGNED_OK) && MAX_MATCH == 258) + /* This code assumes sizeof(unsigned short) == 2. Do not use + * UNALIGNED_OK if your compiler uses a different size. + */ + if (*(ushf*)(match+best_len-1) != scan_end || + *(ushf*)match != scan_start) continue; + + /* It is not necessary to compare scan[2] and match[2] since they are + * always equal when the other bytes match, given that the hash keys + * are equal and that HASH_BITS >= 8. Compare 2 bytes at a time at + * strstart+3, +5, ... up to strstart+257. We check for insufficient + * lookahead only every 4th comparison; the 128th check will be made + * at strstart+257. If MAX_MATCH-2 is not a multiple of 8, it is + * necessary to put more guard bytes at the end of the window, or + * to check more often for insufficient lookahead. + */ + Assert(scan[2] == match[2], "scan[2]?"); + scan++, match++; + do { + } while (*(ushf*)(scan+=2) == *(ushf*)(match+=2) && + *(ushf*)(scan+=2) == *(ushf*)(match+=2) && + *(ushf*)(scan+=2) == *(ushf*)(match+=2) && + *(ushf*)(scan+=2) == *(ushf*)(match+=2) && + scan < strend); + /* The funny "do {}" generates better code on most compilers */ + + /* Here, scan <= window+strstart+257 */ + Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); + if (*scan == *match) scan++; + + len = (MAX_MATCH - 1) - (int)(strend-scan); + scan = strend - (MAX_MATCH-1); + +#else /* UNALIGNED_OK */ + + if (match[best_len] != scan_end || + match[best_len-1] != scan_end1 || + *match != *scan || + *++match != scan[1]) continue; + + /* The check at best_len-1 can be removed because it will be made + * again later. (This heuristic is not always a win.) + * It is not necessary to compare scan[2] and match[2] since they + * are always equal when the other bytes match, given that + * the hash keys are equal and that HASH_BITS >= 8. + */ + scan += 2, match++; + Assert(*scan == *match, "match[2]?"); + + /* We check for insufficient lookahead only every 8th comparison; + * the 256th check will be made at strstart+258. + */ + do { + } while (*++scan == *++match && *++scan == *++match && + *++scan == *++match && *++scan == *++match && + *++scan == *++match && *++scan == *++match && + *++scan == *++match && *++scan == *++match && + scan < strend); + + Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); + + len = MAX_MATCH - (int)(strend - scan); + scan = strend - MAX_MATCH; + +#endif /* UNALIGNED_OK */ + + if (len > best_len) { + s->match_start = cur_match; + best_len = len; + if (len >= nice_match) break; +#ifdef UNALIGNED_OK + scan_end = *(ushf*)(scan+best_len-1); +#else + scan_end1 = scan[best_len-1]; + scan_end = scan[best_len]; +#endif + } + } while ((cur_match = prev[cur_match & wmask]) > limit + && --chain_length != 0); + + if ((uInt)best_len <= s->lookahead) return (uInt)best_len; + return s->lookahead; +} +#endif /* ASMV */ +#endif /* FASTEST */ + +/* --------------------------------------------------------------------------- + * Optimized version for level == 1 or strategy == Z_RLE only + */ +local uInt longest_match_fast(s, cur_match) + deflate_state *s; + IPos cur_match; /* current match */ +{ + register Bytef *scan = s->window + s->strstart; /* current string */ + register Bytef *match; /* matched string */ + register int len; /* length of current match */ + register Bytef *strend = s->window + s->strstart + MAX_MATCH; + + /* The code is optimized for HASH_BITS >= 8 and MAX_MATCH-2 multiple of 16. + * It is easy to get rid of this optimization if necessary. + */ + Assert(s->hash_bits >= 8 && MAX_MATCH == 258, "Code too clever"); + + Assert((ulg)s->strstart <= s->window_size-MIN_LOOKAHEAD, "need lookahead"); + + Assert(cur_match < s->strstart, "no future"); + + match = s->window + cur_match; + + /* Return failure if the match length is less than 2: + */ + if (match[0] != scan[0] || match[1] != scan[1]) return MIN_MATCH-1; + + /* The check at best_len-1 can be removed because it will be made + * again later. (This heuristic is not always a win.) + * It is not necessary to compare scan[2] and match[2] since they + * are always equal when the other bytes match, given that + * the hash keys are equal and that HASH_BITS >= 8. + */ + scan += 2, match += 2; + Assert(*scan == *match, "match[2]?"); + + /* We check for insufficient lookahead only every 8th comparison; + * the 256th check will be made at strstart+258. + */ + do { + } while (*++scan == *++match && *++scan == *++match && + *++scan == *++match && *++scan == *++match && + *++scan == *++match && *++scan == *++match && + *++scan == *++match && *++scan == *++match && + scan < strend); + + Assert(scan <= s->window+(unsigned)(s->window_size-1), "wild scan"); + + len = MAX_MATCH - (int)(strend - scan); + + if (len < MIN_MATCH) return MIN_MATCH - 1; + + s->match_start = cur_match; + return (uInt)len <= s->lookahead ? (uInt)len : s->lookahead; +} + +#ifdef DEBUG +/* =========================================================================== + * Check that the match at match_start is indeed a match. + */ +local void check_match(s, start, match, length) + deflate_state *s; + IPos start, match; + int length; +{ + /* check that the match is indeed a match */ + if (zmemcmp(s->window + match, + s->window + start, length) != EQUAL) { + fprintf(stderr, " start %u, match %u, length %d\n", + start, match, length); + do { + fprintf(stderr, "%c%c", s->window[match++], s->window[start++]); + } while (--length != 0); + z_error("invalid match"); + } + if (z_verbose > 1) { + fprintf(stderr,"\\[%d,%d]", start-match, length); + do { putc(s->window[start++], stderr); } while (--length != 0); + } +} +#else +# define check_match(s, start, match, length) +#endif /* DEBUG */ + +/* =========================================================================== + * Fill the window when the lookahead becomes insufficient. + * Updates strstart and lookahead. + * + * IN assertion: lookahead < MIN_LOOKAHEAD + * OUT assertions: strstart <= window_size-MIN_LOOKAHEAD + * At least one byte has been read, or avail_in == 0; reads are + * performed for at least two bytes (required for the zip translate_eol + * option -- not supported here). + */ +local void fill_window(s) + deflate_state *s; +{ + register unsigned n, m; + register Posf *p; + unsigned more; /* Amount of free space at the end of the window. */ + uInt wsize = s->w_size; + + do { + more = (unsigned)(s->window_size -(ulg)s->lookahead -(ulg)s->strstart); + + /* Deal with !@#$% 64K limit: */ + if (sizeof(int) <= 2) { + if (more == 0 && s->strstart == 0 && s->lookahead == 0) { + more = wsize; + + } else if (more == (unsigned)(-1)) { + /* Very unlikely, but possible on 16 bit machine if + * strstart == 0 && lookahead == 1 (input done a byte at time) + */ + more--; + } + } + + /* If the window is almost full and there is insufficient lookahead, + * move the upper half to the lower one to make room in the upper half. + */ + if (s->strstart >= wsize+MAX_DIST(s)) { + + zmemcpy(s->window, s->window+wsize, (unsigned)wsize); + s->match_start -= wsize; + s->strstart -= wsize; /* we now have strstart >= MAX_DIST */ + s->block_start -= (long) wsize; + + /* Slide the hash table (could be avoided with 32 bit values + at the expense of memory usage). We slide even when level == 0 + to keep the hash table consistent if we switch back to level > 0 + later. (Using level 0 permanently is not an optimal usage of + zlib, so we don't care about this pathological case.) + */ + /* %%% avoid this when Z_RLE */ + n = s->hash_size; + p = &s->head[n]; + do { + m = *--p; + *p = (Pos)(m >= wsize ? m-wsize : NIL); + } while (--n); + + n = wsize; +#ifndef FASTEST + p = &s->prev[n]; + do { + m = *--p; + *p = (Pos)(m >= wsize ? m-wsize : NIL); + /* If n is not on any hash chain, prev[n] is garbage but + * its value will never be used. + */ + } while (--n); +#endif + more += wsize; + } + if (s->strm->avail_in == 0) return; + + /* If there was no sliding: + * strstart <= WSIZE+MAX_DIST-1 && lookahead <= MIN_LOOKAHEAD - 1 && + * more == window_size - lookahead - strstart + * => more >= window_size - (MIN_LOOKAHEAD-1 + WSIZE + MAX_DIST-1) + * => more >= window_size - 2*WSIZE + 2 + * In the BIG_MEM or MMAP case (not yet supported), + * window_size == input_size + MIN_LOOKAHEAD && + * strstart + s->lookahead <= input_size => more >= MIN_LOOKAHEAD. + * Otherwise, window_size == 2*WSIZE so more >= 2. + * If there was sliding, more >= WSIZE. So in all cases, more >= 2. + */ + Assert(more >= 2, "more < 2"); + + n = read_buf(s->strm, s->window + s->strstart + s->lookahead, more); + s->lookahead += n; + + /* Initialize the hash value now that we have some input: */ + if (s->lookahead >= MIN_MATCH) { + s->ins_h = s->window[s->strstart]; + UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); +#if MIN_MATCH != 3 + Call UPDATE_HASH() MIN_MATCH-3 more times +#endif + } + /* If the whole input has less than MIN_MATCH bytes, ins_h is garbage, + * but this is not important since only literal bytes will be emitted. + */ + + } while (s->lookahead < MIN_LOOKAHEAD && s->strm->avail_in != 0); +} + +/* =========================================================================== + * Flush the current block, with given end-of-file flag. + * IN assertion: strstart is set to the end of the current match. + */ +#define FLUSH_BLOCK_ONLY(s, eof) { \ + _tr_flush_block(s, (s->block_start >= 0L ? \ + (charf *)&s->window[(unsigned)s->block_start] : \ + (charf *)Z_NULL), \ + (ulg)((long)s->strstart - s->block_start), \ + (eof)); \ + s->block_start = s->strstart; \ + flush_pending(s->strm); \ + Tracev((stderr,"[FLUSH]")); \ +} + +/* Same but force premature exit if necessary. */ +#define FLUSH_BLOCK(s, eof) { \ + FLUSH_BLOCK_ONLY(s, eof); \ + if (s->strm->avail_out == 0) return (eof) ? finish_started : need_more; \ +} + +/* =========================================================================== + * Copy without compression as much as possible from the input stream, return + * the current block state. + * This function does not insert new strings in the dictionary since + * uncompressible data is probably not useful. This function is used + * only for the level=0 compression option. + * NOTE: this function should be optimized to avoid extra copying from + * window to pending_buf. + */ +local block_state deflate_stored(s, flush) + deflate_state *s; + int flush; +{ + /* Stored blocks are limited to 0xffff bytes, pending_buf is limited + * to pending_buf_size, and each stored block has a 5 byte header: + */ + ulg max_block_size = 0xffff; + ulg max_start; + + if (max_block_size > s->pending_buf_size - 5) { + max_block_size = s->pending_buf_size - 5; + } + + /* Copy as much as possible from input to output: */ + for (;;) { + /* Fill the window as much as possible: */ + if (s->lookahead <= 1) { + + Assert(s->strstart < s->w_size+MAX_DIST(s) || + s->block_start >= (long)s->w_size, "slide too late"); + + fill_window(s); + if (s->lookahead == 0 && flush == Z_NO_FLUSH) return need_more; + + if (s->lookahead == 0) break; /* flush the current block */ + } + Assert(s->block_start >= 0L, "block gone"); + + s->strstart += s->lookahead; + s->lookahead = 0; + + /* Emit a stored block if pending_buf will be full: */ + max_start = s->block_start + max_block_size; + if (s->strstart == 0 || (ulg)s->strstart >= max_start) { + /* strstart == 0 is possible when wraparound on 16-bit machine */ + s->lookahead = (uInt)(s->strstart - max_start); + s->strstart = (uInt)max_start; + FLUSH_BLOCK(s, 0); + } + /* Flush if we may have to slide, otherwise block_start may become + * negative and the data will be gone: + */ + if (s->strstart - (uInt)s->block_start >= MAX_DIST(s)) { + FLUSH_BLOCK(s, 0); + } + } + FLUSH_BLOCK(s, flush == Z_FINISH); + return flush == Z_FINISH ? finish_done : block_done; +} + +/* =========================================================================== + * Compress as much as possible from the input stream, return the current + * block state. + * This function does not perform lazy evaluation of matches and inserts + * new strings in the dictionary only for unmatched strings or for short + * matches. It is used only for the fast compression options. + */ +local block_state deflate_fast(s, flush) + deflate_state *s; + int flush; +{ + IPos hash_head = NIL; /* head of the hash chain */ + int bflush; /* set if current block must be flushed */ + + for (;;) { + /* Make sure that we always have enough lookahead, except + * at the end of the input file. We need MAX_MATCH bytes + * for the next match, plus MIN_MATCH bytes to insert the + * string following the next match. + */ + if (s->lookahead < MIN_LOOKAHEAD) { + fill_window(s); + if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { + return need_more; + } + if (s->lookahead == 0) break; /* flush the current block */ + } + + /* Insert the string window[strstart .. strstart+2] in the + * dictionary, and set hash_head to the head of the hash chain: + */ + if (s->lookahead >= MIN_MATCH) { + INSERT_STRING(s, s->strstart, hash_head); + } + + /* Find the longest match, discarding those <= prev_length. + * At this point we have always match_length < MIN_MATCH + */ + if (hash_head != NIL && s->strstart - hash_head <= MAX_DIST(s)) { + /* To simplify the code, we prevent matches with the string + * of window index 0 (in particular we have to avoid a match + * of the string with itself at the start of the input file). + */ +#ifdef FASTEST + if ((s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) || + (s->strategy == Z_RLE && s->strstart - hash_head == 1)) { + s->match_length = longest_match_fast (s, hash_head); + } +#else + if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { + s->match_length = longest_match (s, hash_head); + } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { + s->match_length = longest_match_fast (s, hash_head); + } +#endif + /* longest_match() or longest_match_fast() sets match_start */ + } + if (s->match_length >= MIN_MATCH) { + check_match(s, s->strstart, s->match_start, s->match_length); + + _tr_tally_dist(s, s->strstart - s->match_start, + s->match_length - MIN_MATCH, bflush); + + s->lookahead -= s->match_length; + + /* Insert new strings in the hash table only if the match length + * is not too large. This saves time but degrades compression. + */ +#ifndef FASTEST + if (s->match_length <= s->max_insert_length && + s->lookahead >= MIN_MATCH) { + s->match_length--; /* string at strstart already in table */ + do { + s->strstart++; + INSERT_STRING(s, s->strstart, hash_head); + /* strstart never exceeds WSIZE-MAX_MATCH, so there are + * always MIN_MATCH bytes ahead. + */ + } while (--s->match_length != 0); + s->strstart++; + } else +#endif + { + s->strstart += s->match_length; + s->match_length = 0; + s->ins_h = s->window[s->strstart]; + UPDATE_HASH(s, s->ins_h, s->window[s->strstart+1]); +#if MIN_MATCH != 3 + Call UPDATE_HASH() MIN_MATCH-3 more times +#endif + /* If lookahead < MIN_MATCH, ins_h is garbage, but it does not + * matter since it will be recomputed at next deflate call. + */ + } + } else { + /* No match, output a literal byte */ + Tracevv((stderr,"%c", s->window[s->strstart])); + _tr_tally_lit (s, s->window[s->strstart], bflush); + s->lookahead--; + s->strstart++; + } + if (bflush) FLUSH_BLOCK(s, 0); + } + FLUSH_BLOCK(s, flush == Z_FINISH); + return flush == Z_FINISH ? finish_done : block_done; +} + +#ifndef FASTEST +/* =========================================================================== + * Same as above, but achieves better compression. We use a lazy + * evaluation for matches: a match is finally adopted only if there is + * no better match at the next window position. + */ +local block_state deflate_slow(s, flush) + deflate_state *s; + int flush; +{ + IPos hash_head = NIL; /* head of hash chain */ + int bflush; /* set if current block must be flushed */ + + /* Process the input block. */ + for (;;) { + /* Make sure that we always have enough lookahead, except + * at the end of the input file. We need MAX_MATCH bytes + * for the next match, plus MIN_MATCH bytes to insert the + * string following the next match. + */ + if (s->lookahead < MIN_LOOKAHEAD) { + fill_window(s); + if (s->lookahead < MIN_LOOKAHEAD && flush == Z_NO_FLUSH) { + return need_more; + } + if (s->lookahead == 0) break; /* flush the current block */ + } + + /* Insert the string window[strstart .. strstart+2] in the + * dictionary, and set hash_head to the head of the hash chain: + */ + if (s->lookahead >= MIN_MATCH) { + INSERT_STRING(s, s->strstart, hash_head); + } + + /* Find the longest match, discarding those <= prev_length. + */ + s->prev_length = s->match_length, s->prev_match = s->match_start; + s->match_length = MIN_MATCH-1; + + if (hash_head != NIL && s->prev_length < s->max_lazy_match && + s->strstart - hash_head <= MAX_DIST(s)) { + /* To simplify the code, we prevent matches with the string + * of window index 0 (in particular we have to avoid a match + * of the string with itself at the start of the input file). + */ + if (s->strategy != Z_HUFFMAN_ONLY && s->strategy != Z_RLE) { + s->match_length = longest_match (s, hash_head); + } else if (s->strategy == Z_RLE && s->strstart - hash_head == 1) { + s->match_length = longest_match_fast (s, hash_head); + } + /* longest_match() or longest_match_fast() sets match_start */ + + if (s->match_length <= 5 && (s->strategy == Z_FILTERED +#if TOO_FAR <= 32767 + || (s->match_length == MIN_MATCH && + s->strstart - s->match_start > TOO_FAR) +#endif + )) { + + /* If prev_match is also MIN_MATCH, match_start is garbage + * but we will ignore the current match anyway. + */ + s->match_length = MIN_MATCH-1; + } + } + /* If there was a match at the previous step and the current + * match is not better, output the previous match: + */ + if (s->prev_length >= MIN_MATCH && s->match_length <= s->prev_length) { + uInt max_insert = s->strstart + s->lookahead - MIN_MATCH; + /* Do not insert strings in hash table beyond this. */ + + check_match(s, s->strstart-1, s->prev_match, s->prev_length); + + _tr_tally_dist(s, s->strstart -1 - s->prev_match, + s->prev_length - MIN_MATCH, bflush); + + /* Insert in hash table all strings up to the end of the match. + * strstart-1 and strstart are already inserted. If there is not + * enough lookahead, the last two strings are not inserted in + * the hash table. + */ + s->lookahead -= s->prev_length-1; + s->prev_length -= 2; + do { + if (++s->strstart <= max_insert) { + INSERT_STRING(s, s->strstart, hash_head); + } + } while (--s->prev_length != 0); + s->match_available = 0; + s->match_length = MIN_MATCH-1; + s->strstart++; + + if (bflush) FLUSH_BLOCK(s, 0); + + } else if (s->match_available) { + /* If there was no match at the previous position, output a + * single literal. If there was a match but the current match + * is longer, truncate the previous match to a single literal. + */ + Tracevv((stderr,"%c", s->window[s->strstart-1])); + _tr_tally_lit(s, s->window[s->strstart-1], bflush); + if (bflush) { + FLUSH_BLOCK_ONLY(s, 0); + } + s->strstart++; + s->lookahead--; + if (s->strm->avail_out == 0) return need_more; + } else { + /* There is no previous match to compare with, wait for + * the next step to decide. + */ + s->match_available = 1; + s->strstart++; + s->lookahead--; + } + } + Assert (flush != Z_NO_FLUSH, "no flush?"); + if (s->match_available) { + Tracevv((stderr,"%c", s->window[s->strstart-1])); + _tr_tally_lit(s, s->window[s->strstart-1], bflush); + s->match_available = 0; + } + FLUSH_BLOCK(s, flush == Z_FINISH); + return flush == Z_FINISH ? finish_done : block_done; +} +#endif /* FASTEST */ + +#if 0 +/* =========================================================================== + * For Z_RLE, simply look for runs of bytes, generate matches only of distance + * one. Do not maintain a hash table. (It will be regenerated if this run of + * deflate switches away from Z_RLE.) + */ +local block_state deflate_rle(s, flush) + deflate_state *s; + int flush; +{ + int bflush; /* set if current block must be flushed */ + uInt run; /* length of run */ + uInt max; /* maximum length of run */ + uInt prev; /* byte at distance one to match */ + Bytef *scan; /* scan for end of run */ + + for (;;) { + /* Make sure that we always have enough lookahead, except + * at the end of the input file. We need MAX_MATCH bytes + * for the longest encodable run. + */ + if (s->lookahead < MAX_MATCH) { + fill_window(s); + if (s->lookahead < MAX_MATCH && flush == Z_NO_FLUSH) { + return need_more; + } + if (s->lookahead == 0) break; /* flush the current block */ + } + + /* See how many times the previous byte repeats */ + run = 0; + if (s->strstart > 0) { /* if there is a previous byte, that is */ + max = s->lookahead < MAX_MATCH ? s->lookahead : MAX_MATCH; + scan = s->window + s->strstart - 1; + prev = *scan++; + do { + if (*scan++ != prev) + break; + } while (++run < max); + } + + /* Emit match if have run of MIN_MATCH or longer, else emit literal */ + if (run >= MIN_MATCH) { + check_match(s, s->strstart, s->strstart - 1, run); + _tr_tally_dist(s, 1, run - MIN_MATCH, bflush); + s->lookahead -= run; + s->strstart += run; + } else { + /* No match, output a literal byte */ + Tracevv((stderr,"%c", s->window[s->strstart])); + _tr_tally_lit (s, s->window[s->strstart], bflush); + s->lookahead--; + s->strstart++; + } + if (bflush) FLUSH_BLOCK(s, 0); + } + FLUSH_BLOCK(s, flush == Z_FINISH); + return flush == Z_FINISH ? finish_done : block_done; +} +#endif diff --git a/erts/emulator/zlib/deflate.h b/erts/emulator/zlib/deflate.h new file mode 100644 index 0000000000..92b037c9d2 --- /dev/null +++ b/erts/emulator/zlib/deflate.h @@ -0,0 +1,333 @@ +/* deflate.h -- internal compression state + * Copyright (C) 1995-2004 Jean-loup Gailly + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* WARNING: this file should *not* be used by applications. It is + part of the implementation of the compression library and is + subject to change. Applications should only use zlib.h. + */ + +/* @(#) $Id$ */ + +#ifndef DEFLATE_H +#define DEFLATE_H + +#include "zutil.h" + +/* define NO_GZIP when compiling if you want to disable gzip header and + trailer creation by deflate(). NO_GZIP would be used to avoid linking in + the crc code when it is not needed. For shared libraries, gzip encoding + should be left enabled. */ +#ifndef NO_GZIP +# define GZIP +#endif + +/* =========================================================================== + * Internal compression state. + */ + +#define LENGTH_CODES 29 +/* number of length codes, not counting the special END_BLOCK code */ + +#define LITERALS 256 +/* number of literal bytes 0..255 */ + +#define L_CODES (LITERALS+1+LENGTH_CODES) +/* number of Literal or Length codes, including the END_BLOCK code */ + +#define D_CODES 30 +/* number of distance codes */ + +#define BL_CODES 19 +/* number of codes used to transfer the bit lengths */ + +#define HEAP_SIZE (2*L_CODES+1) +/* maximum heap size */ + +#define MAX_BITS 15 +/* All codes must not exceed MAX_BITS bits */ + +#define INIT_STATE 42 +#define EXTRA_STATE 69 +#define NAME_STATE 73 +#define COMMENT_STATE 91 +#define HCRC_STATE 103 +#define BUSY_STATE 113 +#define FINISH_STATE 666 +/* Stream status */ + + +/* Data structure describing a single value and its code string. */ +typedef struct ct_data_s { + union { + ush freq; /* frequency count */ + ush code; /* bit string */ + } fc; + union { + ush dad; /* father node in Huffman tree */ + ush len; /* length of bit string */ + } dl; +} FAR ct_data; + +#define Freq fc.freq +#define Code fc.code +#define Dad dl.dad +#define Len dl.len + +typedef struct static_tree_desc_s static_tree_desc; + +typedef struct tree_desc_s { + ct_data *dyn_tree; /* the dynamic tree */ + int max_code; /* largest code with non zero frequency */ + static_tree_desc *stat_desc; /* the corresponding static tree */ +} FAR tree_desc; + +typedef ush Pos; +typedef Pos FAR Posf; +typedef unsigned IPos; + +/* A Pos is an index in the character window. We use short instead of int to + * save space in the various tables. IPos is used only for parameter passing. + */ + +typedef struct internal_state { + z_streamp strm; /* pointer back to this zlib stream */ + int status; /* as the name implies */ + Bytef *pending_buf; /* output still pending */ + ulg pending_buf_size; /* size of pending_buf */ + Bytef *pending_out; /* next pending byte to output to the stream */ + uInt pending; /* nb of bytes in the pending buffer */ + int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ + gz_headerp gzhead; /* gzip header information to write */ + uInt gzindex; /* where in extra, name, or comment */ + Byte method; /* STORED (for zip only) or DEFLATED */ + int last_flush; /* value of flush param for previous deflate call */ + + /* used by deflate.c: */ + + uInt w_size; /* LZ77 window size (32K by default) */ + uInt w_bits; /* log2(w_size) (8..16) */ + uInt w_mask; /* w_size - 1 */ + + Bytef *window; + /* Sliding window. Input bytes are read into the second half of the window, + * and move to the first half later to keep a dictionary of at least wSize + * bytes. With this organization, matches are limited to a distance of + * wSize-MAX_MATCH bytes, but this ensures that IO is always + * performed with a length multiple of the block size. Also, it limits + * the window size to 64K, which is quite useful on MSDOS. + * To do: use the user input buffer as sliding window. + */ + + ulg window_size; + /* Actual size of window: 2*wSize, except when the user input buffer + * is directly used as sliding window. + */ + + Posf *prev; + /* Link to older string with same hash index. To limit the size of this + * array to 64K, this link is maintained only for the last 32K strings. + * An index in this array is thus a window index modulo 32K. + */ + + Posf *head; /* Heads of the hash chains or NIL. */ + + uInt ins_h; /* hash index of string to be inserted */ + uInt hash_size; /* number of elements in hash table */ + uInt hash_bits; /* log2(hash_size) */ + uInt hash_mask; /* hash_size-1 */ + + uInt hash_shift; + /* Number of bits by which ins_h must be shifted at each input + * step. It must be such that after MIN_MATCH steps, the oldest + * byte no longer takes part in the hash key, that is: + * hash_shift * MIN_MATCH >= hash_bits + */ + + long block_start; + /* Window position at the beginning of the current output block. Gets + * negative when the window is moved backwards. + */ + + uInt match_length; /* length of best match */ + IPos prev_match; /* previous match */ + int match_available; /* set if previous match exists */ + uInt strstart; /* start of string to insert */ + uInt match_start; /* start of matching string */ + uInt lookahead; /* number of valid bytes ahead in window */ + + uInt prev_length; + /* Length of the best match at previous step. Matches not greater than this + * are discarded. This is used in the lazy match evaluation. + */ + + uInt max_chain_length; + /* To speed up deflation, hash chains are never searched beyond this + * length. A higher limit improves compression ratio but degrades the + * speed. + */ + + uInt max_lazy_match; + /* Attempt to find a better match only when the current match is strictly + * smaller than this value. This mechanism is used only for compression + * levels >= 4. + */ +# define max_insert_length max_lazy_match + /* Insert new strings in the hash table only if the match length is not + * greater than this length. This saves time but degrades compression. + * max_insert_length is used only for compression levels <= 3. + */ + + int level; /* compression level (1..9) */ + int strategy; /* favor or force Huffman coding*/ + + uInt good_match; + /* Use a faster search when the previous match is longer than this */ + + int nice_match; /* Stop searching when current match exceeds this */ + + /* used by trees.c: */ + /* Didn't use ct_data typedef below to supress compiler warning */ + struct ct_data_s dyn_ltree[HEAP_SIZE]; /* literal and length tree */ + struct ct_data_s dyn_dtree[2*D_CODES+1]; /* distance tree */ + struct ct_data_s bl_tree[2*BL_CODES+1]; /* Huffman tree for bit lengths */ + + struct tree_desc_s l_desc; /* desc. for literal tree */ + struct tree_desc_s d_desc; /* desc. for distance tree */ + struct tree_desc_s bl_desc; /* desc. for bit length tree */ + + ush bl_count[MAX_BITS+1]; + /* number of codes at each bit length for an optimal tree */ + + int heap[2*L_CODES+1]; /* heap used to build the Huffman trees */ + int heap_len; /* number of elements in the heap */ + int heap_max; /* element of largest frequency */ + /* The sons of heap[n] are heap[2*n] and heap[2*n+1]. heap[0] is not used. + * The same heap array is used to build all trees. + */ + + uch depth[2*L_CODES+1]; + /* Depth of each subtree used as tie breaker for trees of equal frequency + */ + + uchf *l_buf; /* buffer for literals or lengths */ + + uInt lit_bufsize; + /* Size of match buffer for literals/lengths. There are 4 reasons for + * limiting lit_bufsize to 64K: + * - frequencies can be kept in 16 bit counters + * - if compression is not successful for the first block, all input + * data is still in the window so we can still emit a stored block even + * when input comes from standard input. (This can also be done for + * all blocks if lit_bufsize is not greater than 32K.) + * - if compression is not successful for a file smaller than 64K, we can + * even emit a stored file instead of a stored block (saving 5 bytes). + * This is applicable only for zip (not gzip or zlib). + * - creating new Huffman trees less frequently may not provide fast + * adaptation to changes in the input data statistics. (Take for + * example a binary file with poorly compressible code followed by + * a highly compressible string table.) Smaller buffer sizes give + * fast adaptation but have of course the overhead of transmitting + * trees more frequently. + * - I can't count above 4 + */ + + uInt last_lit; /* running index in l_buf */ + + ushf *d_buf; + /* Buffer for distances. To simplify the code, d_buf and l_buf have + * the same number of elements. To use different lengths, an extra flag + * array would be necessary. + */ + + ulg opt_len; /* bit length of current block with optimal trees */ + ulg static_len; /* bit length of current block with static trees */ + uInt matches; /* number of string matches in current block */ + int last_eob_len; /* bit length of EOB code for last block */ + +#ifdef DEBUG + ulg compressed_len; /* total bit length of compressed file mod 2^32 */ + ulg bits_sent; /* bit length of compressed data sent mod 2^32 */ +#endif + + ush bi_buf; + /* Output buffer. bits are inserted starting at the bottom (least + * significant bits). + */ + int bi_valid; + /* Number of valid bits in bi_buf. All bits above the last valid bit + * are always zero. + */ + +} FAR deflate_state; + +/* Output a byte on the stream. + * IN assertion: there is enough room in pending_buf. + */ +#define put_byte(s, c) {s->pending_buf[s->pending++] = (c);} + + +#define MIN_LOOKAHEAD (MAX_MATCH+MIN_MATCH+1) +/* Minimum amount of lookahead, except at the end of the input file. + * See deflate.c for comments about the MIN_MATCH+1. + */ + +#define MAX_DIST(s) ((s)->w_size-MIN_LOOKAHEAD) +/* In order to simplify the code, particularly on 16 bit machines, match + * distances are limited to MAX_DIST instead of WSIZE. + */ + + /* in trees.c */ +void _tr_init OF((deflate_state *s)); +int _tr_tally OF((deflate_state *s, unsigned dist, unsigned lc)); +void _tr_flush_block OF((deflate_state *s, charf *buf, ulg stored_len, + int eof)); +void _tr_align OF((deflate_state *s)); +void _tr_stored_block OF((deflate_state *s, charf *buf, ulg stored_len, + int eof)); + +#define d_code(dist) \ + ((dist) < 256 ? _dist_code[dist] : _dist_code[256+((dist)>>7)]) +/* Mapping from a distance to a distance code. dist is the distance - 1 and + * must not have side effects. _dist_code[256] and _dist_code[257] are never + * used. + */ + +#ifndef DEBUG +/* Inline versions of _tr_tally for speed: */ + +#if defined(GEN_TREES_H) || !defined(STDC) + extern uch _length_code[]; + extern uch _dist_code[]; +#else + extern const uch _length_code[]; + extern const uch _dist_code[]; +#endif + +# define _tr_tally_lit(s, c, flush) \ + { uch cc = (c); \ + s->d_buf[s->last_lit] = 0; \ + s->l_buf[s->last_lit++] = cc; \ + s->dyn_ltree[cc].Freq++; \ + flush = (s->last_lit == s->lit_bufsize-1); \ + } +# define _tr_tally_dist(s, distance, length, flush) \ + { uch len = (length); \ + ush dist = (distance); \ + s->d_buf[s->last_lit] = dist; \ + s->l_buf[s->last_lit++] = len; \ + dist--; \ + s->dyn_ltree[_length_code[len]+LITERALS+1].Freq++; \ + s->dyn_dtree[d_code(dist)].Freq++; \ + flush = (s->last_lit == s->lit_bufsize-1); \ + } +#else +# define _tr_tally_lit(s, c, flush) flush = _tr_tally(s, 0, c) +# define _tr_tally_dist(s, distance, length, flush) \ + flush = _tr_tally(s, distance, length) +#endif + +#endif /* DEFLATE_H */ diff --git a/erts/emulator/zlib/example.c b/erts/emulator/zlib/example.c new file mode 100644 index 0000000000..ebe828f72d --- /dev/null +++ b/erts/emulator/zlib/example.c @@ -0,0 +1,570 @@ +/* example.c -- usage example of the zlib compression library + * Copyright (C) 1995-2004 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* @(#) $Id$ */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include +#include "zlib.h" + +#ifdef STDC +# include +# include +#endif + +#if defined(VMS) || defined(RISCOS) +# define TESTFILE "foo-gz" +#else +# define TESTFILE "foo.gz" +#endif + +#define CHECK_ERR(err, msg) { \ + if (err != Z_OK) { \ + fprintf(stderr, "%s error: %d\n", msg, err); \ + exit(1); \ + } \ +} + +const char hello[] = "hello, hello!"; +/* "hello world" would be more standard, but the repeated "hello" + * stresses the compression code better, sorry... + */ + +const char dictionary[] = "hello"; +uLong dictId; /* Adler32 value of the dictionary */ + +void test_compress OF((Byte *compr, uLong comprLen, + Byte *uncompr, uLong uncomprLen)); +void test_gzio OF((const char *fname, + Byte *uncompr, uLong uncomprLen)); +void test_deflate OF((Byte *compr, uLong comprLen)); +void test_inflate OF((Byte *compr, uLong comprLen, + Byte *uncompr, uLong uncomprLen)); +void test_large_deflate OF((Byte *compr, uLong comprLen, + Byte *uncompr, uLong uncomprLen)); +void test_large_inflate OF((Byte *compr, uLong comprLen, + Byte *uncompr, uLong uncomprLen)); +void test_flush OF((Byte *compr, uLong *comprLen)); +void test_sync OF((Byte *compr, uLong comprLen, + Byte *uncompr, uLong uncomprLen)); +void test_dict_deflate OF((Byte *compr, uLong comprLen)); +void test_dict_inflate OF((Byte *compr, uLong comprLen, + Byte *uncompr, uLong uncomprLen)); +int main OF((int argc, char *argv[])); + +/* =========================================================================== + * Test compress() and uncompress() + */ +void test_compress(compr, comprLen, uncompr, uncomprLen) + Byte *compr, *uncompr; + uLong comprLen, uncomprLen; +{ + int err; + uLong len = (uLong)strlen(hello)+1; + + err = compress(compr, &comprLen, (const Bytef*)hello, len); + CHECK_ERR(err, "compress"); + + strcpy((char*)uncompr, "garbage"); + + err = uncompress(uncompr, &uncomprLen, compr, comprLen); + CHECK_ERR(err, "uncompress"); + + if (strcmp((char*)uncompr, hello)) { + fprintf(stderr, "bad uncompress\n"); + exit(1); + } else { + printf("uncompress(): %s\n", (char *)uncompr); + } +} + +/* =========================================================================== + * Test read/write of .gz files + */ +void test_gzio(fname, uncompr, uncomprLen) + const char *fname; /* compressed file name */ + Byte *uncompr; + uLong uncomprLen; +{ +#ifdef NO_GZCOMPRESS + fprintf(stderr, "NO_GZCOMPRESS -- gz* functions cannot compress\n"); +#else + int err; + int len = (int)strlen(hello)+1; + gzFile file; + z_off_t pos; + + file = gzopen(fname, "wb"); + if (file == NULL) { + fprintf(stderr, "gzopen error\n"); + exit(1); + } + gzputc(file, 'h'); + if (gzputs(file, "ello") != 4) { + fprintf(stderr, "gzputs err: %s\n", gzerror(file, &err)); + exit(1); + } + if (gzprintf(file, ", %s!", "hello") != 8) { + fprintf(stderr, "gzprintf err: %s\n", gzerror(file, &err)); + exit(1); + } + gzseek(file, 1L, SEEK_CUR); /* add one zero byte */ + gzclose(file); + + file = gzopen(fname, "rb"); + if (file == NULL) { + fprintf(stderr, "gzopen error\n"); + exit(1); + } + strcpy((char*)uncompr, "garbage"); + + if (gzread(file, uncompr, (unsigned)uncomprLen) != len) { + fprintf(stderr, "gzread err: %s\n", gzerror(file, &err)); + exit(1); + } + if (strcmp((char*)uncompr, hello)) { + fprintf(stderr, "bad gzread: %s\n", (char*)uncompr); + exit(1); + } else { + printf("gzread(): %s\n", (char*)uncompr); + } + + pos = gzseek(file, -8L, SEEK_CUR); + if (pos != 6 || gztell(file) != pos) { + fprintf(stderr, "gzseek error, pos=%ld, gztell=%ld\n", + (long)pos, (long)gztell(file)); + exit(1); + } + + if (gzgetc(file) != ' ') { + fprintf(stderr, "gzgetc error\n"); + exit(1); + } + + if (gzungetc(' ', file) != ' ') { + fprintf(stderr, "gzungetc error\n"); + exit(1); + } + + gzgets(file, (char*)uncompr, (int)uncomprLen); + if (strlen((char*)uncompr) != 7) { /* " hello!" */ + fprintf(stderr, "gzgets err after gzseek: %s\n", gzerror(file, &err)); + exit(1); + } + if (strcmp((char*)uncompr, hello + 6)) { + fprintf(stderr, "bad gzgets after gzseek\n"); + exit(1); + } else { + printf("gzgets() after gzseek: %s\n", (char*)uncompr); + } + + gzclose(file); +#endif +} + +/* =========================================================================== + * Test deflate() with small buffers + */ +void test_deflate(compr, comprLen) + Byte *compr; + uLong comprLen; +{ + z_stream c_stream; /* compression stream */ + int err; + uLong len = (uLong)strlen(hello)+1; + + c_stream.zalloc = (alloc_func)0; + c_stream.zfree = (free_func)0; + c_stream.opaque = (voidpf)0; + + err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION); + CHECK_ERR(err, "deflateInit"); + + c_stream.next_in = (Bytef*)hello; + c_stream.next_out = compr; + + while (c_stream.total_in != len && c_stream.total_out < comprLen) { + c_stream.avail_in = c_stream.avail_out = 1; /* force small buffers */ + err = deflate(&c_stream, Z_NO_FLUSH); + CHECK_ERR(err, "deflate"); + } + /* Finish the stream, still forcing small buffers: */ + for (;;) { + c_stream.avail_out = 1; + err = deflate(&c_stream, Z_FINISH); + if (err == Z_STREAM_END) break; + CHECK_ERR(err, "deflate"); + } + + err = deflateEnd(&c_stream); + CHECK_ERR(err, "deflateEnd"); +} + +/* =========================================================================== + * Test inflate() with small buffers + */ +void test_inflate(compr, comprLen, uncompr, uncomprLen) + Byte *compr, *uncompr; + uLong comprLen, uncomprLen; +{ + int err; + z_stream d_stream; /* decompression stream */ + + strcpy((char*)uncompr, "garbage"); + + d_stream.zalloc = (alloc_func)0; + d_stream.zfree = (free_func)0; + d_stream.opaque = (voidpf)0; + + d_stream.next_in = compr; + d_stream.avail_in = 0; + d_stream.next_out = uncompr; + + err = inflateInit(&d_stream); + CHECK_ERR(err, "inflateInit"); + + while (d_stream.total_out < uncomprLen && d_stream.total_in < comprLen) { + d_stream.avail_in = d_stream.avail_out = 1; /* force small buffers */ + err = inflate(&d_stream, Z_NO_FLUSH); + if (err == Z_STREAM_END) break; + CHECK_ERR(err, "inflate"); + } + + err = inflateEnd(&d_stream); + CHECK_ERR(err, "inflateEnd"); + + if (strcmp((char*)uncompr, hello)) { + fprintf(stderr, "bad inflate\n"); + exit(1); + } else { + printf("inflate(): %s\n", (char *)uncompr); + } +} + +/* =========================================================================== + * Test deflate() with large buffers and dynamic change of compression level + */ +void test_large_deflate(compr, comprLen, uncompr, uncomprLen) + Byte *compr, *uncompr; + uLong comprLen, uncomprLen; +{ + z_stream c_stream; /* compression stream */ + int err; + + c_stream.zalloc = (alloc_func)0; + c_stream.zfree = (free_func)0; + c_stream.opaque = (voidpf)0; + + err = deflateInit(&c_stream, Z_BEST_SPEED); + CHECK_ERR(err, "deflateInit"); + + c_stream.next_out = compr; + c_stream.avail_out = (uInt)comprLen; + + /* At this point, uncompr is still mostly zeroes, so it should compress + * very well: + */ + c_stream.next_in = uncompr; + c_stream.avail_in = (uInt)uncomprLen; + err = deflate(&c_stream, Z_NO_FLUSH); + CHECK_ERR(err, "deflate"); + if (c_stream.avail_in != 0) { + fprintf(stderr, "deflate not greedy\n"); + exit(1); + } + + /* Feed in already compressed data and switch to no compression: */ + deflateParams(&c_stream, Z_NO_COMPRESSION, Z_DEFAULT_STRATEGY); + c_stream.next_in = compr; + c_stream.avail_in = (uInt)comprLen/2; + err = deflate(&c_stream, Z_NO_FLUSH); + CHECK_ERR(err, "deflate"); + + /* Switch back to compressing mode: */ + deflateParams(&c_stream, Z_BEST_COMPRESSION, Z_FILTERED); + c_stream.next_in = uncompr; + c_stream.avail_in = (uInt)uncomprLen; + err = deflate(&c_stream, Z_NO_FLUSH); + CHECK_ERR(err, "deflate"); + + err = deflate(&c_stream, Z_FINISH); + if (err != Z_STREAM_END) { + fprintf(stderr, "deflate should report Z_STREAM_END\n"); + exit(1); + } + err = deflateEnd(&c_stream); + CHECK_ERR(err, "deflateEnd"); +} + +/* =========================================================================== + * Test inflate() with large buffers + */ +void test_large_inflate(compr, comprLen, uncompr, uncomprLen) + Byte *compr, *uncompr; + uLong comprLen, uncomprLen; +{ + int err; + z_stream d_stream; /* decompression stream */ + + strcpy((char*)uncompr, "garbage"); + + d_stream.zalloc = (alloc_func)0; + d_stream.zfree = (free_func)0; + d_stream.opaque = (voidpf)0; + + d_stream.next_in = compr; + d_stream.avail_in = (uInt)comprLen; + + err = inflateInit(&d_stream); + CHECK_ERR(err, "inflateInit"); + + for (;;) { + d_stream.next_out = uncompr; /* discard the output */ + d_stream.avail_out = (uInt)uncomprLen; + err = inflate(&d_stream, Z_NO_FLUSH); + if (err == Z_STREAM_END) break; + CHECK_ERR(err, "large inflate"); + } + + err = inflateEnd(&d_stream); + CHECK_ERR(err, "inflateEnd"); + + if (d_stream.total_out != 2*uncomprLen + comprLen/2) { + fprintf(stderr, "bad large inflate: %ld\n", d_stream.total_out); + exit(1); + } else { + printf("large_inflate(): OK\n"); + } +} + +/* =========================================================================== + * Test deflate() with full flush + */ +void test_flush(compr, comprLen) + Byte *compr; + uLong *comprLen; +{ + z_stream c_stream; /* compression stream */ + int err; + uInt len = (uInt)strlen(hello)+1; + + c_stream.zalloc = (alloc_func)0; + c_stream.zfree = (free_func)0; + c_stream.opaque = (voidpf)0; + + err = deflateInit(&c_stream, Z_DEFAULT_COMPRESSION); + CHECK_ERR(err, "deflateInit"); + + c_stream.next_in = (Bytef*)hello; + c_stream.next_out = compr; + c_stream.avail_in = 3; + c_stream.avail_out = (uInt)*comprLen; + err = deflate(&c_stream, Z_FULL_FLUSH); + CHECK_ERR(err, "deflate"); + + compr[3]++; /* force an error in first compressed block */ + c_stream.avail_in = len - 3; + + err = deflate(&c_stream, Z_FINISH); + if (err != Z_STREAM_END) { + CHECK_ERR(err, "deflate"); + } + err = deflateEnd(&c_stream); + CHECK_ERR(err, "deflateEnd"); + + *comprLen = c_stream.total_out; +} + +/* =========================================================================== + * Test inflateSync() + */ +void test_sync(compr, comprLen, uncompr, uncomprLen) + Byte *compr, *uncompr; + uLong comprLen, uncomprLen; +{ + int err; + z_stream d_stream; /* decompression stream */ + + strcpy((char*)uncompr, "garbage"); + + d_stream.zalloc = (alloc_func)0; + d_stream.zfree = (free_func)0; + d_stream.opaque = (voidpf)0; + + d_stream.next_in = compr; + d_stream.avail_in = 2; /* just read the zlib header */ + + err = inflateInit(&d_stream); + CHECK_ERR(err, "inflateInit"); + + d_stream.next_out = uncompr; + d_stream.avail_out = (uInt)uncomprLen; + + inflate(&d_stream, Z_NO_FLUSH); + CHECK_ERR(err, "inflate"); + + d_stream.avail_in = (uInt)comprLen-2; /* read all compressed data */ + err = inflateSync(&d_stream); /* but skip the damaged part */ + CHECK_ERR(err, "inflateSync"); + + err = inflate(&d_stream, Z_FINISH); + if (err != Z_DATA_ERROR) { + fprintf(stderr, "inflate should report DATA_ERROR\n"); + /* Because of incorrect adler32 */ + exit(1); + } + err = inflateEnd(&d_stream); + CHECK_ERR(err, "inflateEnd"); + + printf("after inflateSync(): hel%s\n", (char *)uncompr); +} + +/* =========================================================================== + * Test deflate() with preset dictionary + */ +void test_dict_deflate(compr, comprLen) + Byte *compr; + uLong comprLen; +{ + z_stream c_stream; /* compression stream */ + int err; + + c_stream.zalloc = (alloc_func)0; + c_stream.zfree = (free_func)0; + c_stream.opaque = (voidpf)0; + + err = deflateInit(&c_stream, Z_BEST_COMPRESSION); + CHECK_ERR(err, "deflateInit"); + + err = deflateSetDictionary(&c_stream, + (const Bytef*)dictionary, sizeof(dictionary)); + CHECK_ERR(err, "deflateSetDictionary"); + + dictId = c_stream.adler; + c_stream.next_out = compr; + c_stream.avail_out = (uInt)comprLen; + + c_stream.next_in = (Bytef*)hello; + c_stream.avail_in = (uInt)strlen(hello)+1; + + err = deflate(&c_stream, Z_FINISH); + if (err != Z_STREAM_END) { + fprintf(stderr, "deflate should report Z_STREAM_END\n"); + exit(1); + } + err = deflateEnd(&c_stream); + CHECK_ERR(err, "deflateEnd"); +} + +/* =========================================================================== + * Test inflate() with a preset dictionary + */ +void test_dict_inflate(compr, comprLen, uncompr, uncomprLen) + Byte *compr, *uncompr; + uLong comprLen, uncomprLen; +{ + int err; + z_stream d_stream; /* decompression stream */ + + strcpy((char*)uncompr, "garbage"); + + d_stream.zalloc = (alloc_func)0; + d_stream.zfree = (free_func)0; + d_stream.opaque = (voidpf)0; + + d_stream.next_in = compr; + d_stream.avail_in = (uInt)comprLen; + + err = inflateInit(&d_stream); + CHECK_ERR(err, "inflateInit"); + + d_stream.next_out = uncompr; + d_stream.avail_out = (uInt)uncomprLen; + + for (;;) { + err = inflate(&d_stream, Z_NO_FLUSH); + if (err == Z_STREAM_END) break; + if (err == Z_NEED_DICT) { + if (d_stream.adler != dictId) { + fprintf(stderr, "unexpected dictionary"); + exit(1); + } + err = inflateSetDictionary(&d_stream, (const Bytef*)dictionary, + sizeof(dictionary)); + } + CHECK_ERR(err, "inflate with dict"); + } + + err = inflateEnd(&d_stream); + CHECK_ERR(err, "inflateEnd"); + + if (strcmp((char*)uncompr, hello)) { + fprintf(stderr, "bad inflate with dict\n"); + exit(1); + } else { + printf("inflate with dictionary: %s\n", (char *)uncompr); + } +} + +/* =========================================================================== + * Usage: example [output.gz [input.gz]] + */ + +int main(argc, argv) + int argc; + char *argv[]; +{ + Byte *compr, *uncompr; + uLong comprLen = 10000*sizeof(int); /* don't overflow on MSDOS */ + uLong uncomprLen = comprLen; + static const char* myVersion = ZLIB_VERSION; + + if (zlibVersion()[0] != myVersion[0]) { + fprintf(stderr, "incompatible zlib version\n"); + exit(1); + + } else if (strcmp(zlibVersion(), ZLIB_VERSION) != 0) { + fprintf(stderr, "warning: different zlib version\n"); + } + + printf("zlib version %s = 0x%04x, compile flags = 0x%lx\n", + ZLIB_VERSION, ZLIB_VERNUM, zlibCompileFlags()); + + compr = (Byte*)calloc((uInt)comprLen, 1); + uncompr = (Byte*)calloc((uInt)uncomprLen, 1); + /* compr and uncompr are cleared to avoid reading uninitialized + * data and to ensure that uncompr compresses well. + */ + if (compr == Z_NULL || uncompr == Z_NULL) { + printf("out of memory\n"); + exit(1); + } + test_compress(compr, comprLen, uncompr, uncomprLen); + + test_gzio((argc > 1 ? argv[1] : TESTFILE), + uncompr, uncomprLen); + + test_deflate(compr, comprLen); + test_inflate(compr, comprLen, uncompr, uncomprLen); + + test_large_deflate(compr, comprLen, uncompr, uncomprLen); + test_large_inflate(compr, comprLen, uncompr, uncomprLen); + + test_flush(compr, &comprLen); + test_sync(compr, comprLen, uncompr, uncomprLen); + comprLen = uncomprLen; + + test_dict_deflate(compr, comprLen); + test_dict_inflate(compr, comprLen, uncompr, uncomprLen); + + free(compr); + free(uncompr); + + return 0; +} diff --git a/erts/emulator/zlib/inffast.c b/erts/emulator/zlib/inffast.c new file mode 100644 index 0000000000..eb81884888 --- /dev/null +++ b/erts/emulator/zlib/inffast.c @@ -0,0 +1,323 @@ +/* inffast.c -- fast decoding + * Copyright (C) 1995-2004 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "zutil.h" +#include "inftrees.h" +#include "inflate.h" +#include "inffast.h" + +#ifndef ASMINF + +/* Allow machine dependent optimization for post-increment or pre-increment. + Based on testing to date, + Pre-increment preferred for: + - PowerPC G3 (Adler) + - MIPS R5000 (Randers-Pehrson) + Post-increment preferred for: + - none + No measurable difference: + - Pentium III (Anderson) + - M68060 (Nikl) + */ +#ifdef POSTINC +# define OFF 0 +# define PUP(a) *(a)++ +#else +# define OFF 1 +# define PUP(a) *++(a) +#endif + +/* + Decode literal, length, and distance codes and write out the resulting + literal and match bytes until either not enough input or output is + available, an end-of-block is encountered, or a data error is encountered. + When large enough input and output buffers are supplied to inflate(), for + example, a 16K input buffer and a 64K output buffer, more than 95% of the + inflate execution time is spent in this routine. + + Entry assumptions: + + state->mode == LEN + strm->avail_in >= 6 + strm->avail_out >= 258 + start >= strm->avail_out + state->bits < 8 + + On return, state->mode is one of: + + LEN -- ran out of enough output space or enough available input + TYPE -- reached end of block code, inflate() to interpret next block + BAD -- error in block data + + Notes: + + - The maximum input bits used by a length/distance pair is 15 bits for the + length code, 5 bits for the length extra, 15 bits for the distance code, + and 13 bits for the distance extra. This totals 48 bits, or six bytes. + Therefore if strm->avail_in >= 6, then there is enough input to avoid + checking for available input while decoding. + + - The maximum bytes that a single length/distance pair can output is 258 + bytes, which is the maximum length that can be coded. inflate_fast() + requires strm->avail_out >= 258 for each loop to avoid checking for + output space. + */ +void inflate_fast(strm, start) +z_streamp strm; +unsigned start; /* inflate()'s starting value for strm->avail_out */ +{ + struct inflate_state FAR *state; + unsigned char FAR *in; /* local strm->next_in */ + unsigned char FAR *last; /* while in < last, enough input available */ + unsigned char FAR *out; /* local strm->next_out */ + unsigned char FAR *beg; /* inflate()'s initial strm->next_out */ + unsigned char FAR *end; /* while out < end, enough space available */ +#ifdef INFLATE_STRICT + unsigned dmax; /* maximum distance from zlib header */ +#endif + unsigned wsize; /* window size or zero if not using window */ + unsigned whave; /* valid bytes in the window */ + unsigned write; /* window write index */ + unsigned char FAR *window; /* allocated sliding window, if wsize != 0 */ + unsigned long hold; /* local strm->hold */ + unsigned bits; /* local strm->bits */ + code const FAR *lcode; /* local strm->lencode */ + code const FAR *dcode; /* local strm->distcode */ + unsigned lmask; /* mask for first level of length codes */ + unsigned dmask; /* mask for first level of distance codes */ + code this; /* retrieved table entry */ + unsigned op; /* code bits, operation, extra bits, or */ + /* window position, window bytes to copy */ + unsigned len; /* match length, unused bytes */ + unsigned dist; /* match distance */ + unsigned char FAR *from; /* where to copy match from */ + + /* copy state to local variables */ + state = (struct inflate_state FAR *)strm->state; + in = strm->next_in - OFF; + last = in + (strm->avail_in - 5); + out = strm->next_out - OFF; + beg = out - (start - strm->avail_out); + end = out + (strm->avail_out - 257); +#ifdef INFLATE_STRICT + dmax = state->dmax; +#endif + wsize = state->wsize; + whave = state->whave; + write = state->write; + window = state->window; + hold = state->hold; + bits = state->bits; + lcode = state->lencode; + dcode = state->distcode; + lmask = (1U << state->lenbits) - 1; + dmask = (1U << state->distbits) - 1; + + /* decode literals and length/distances until end-of-block or not enough + input data or output space */ + do { + if (bits < 15) { + hold += (unsigned long)(PUP(in)) << bits; + bits += 8; + hold += (unsigned long)(PUP(in)) << bits; + bits += 8; + } + this = lcode[hold & lmask]; + dolen: + op = (unsigned)(this.bits); + hold >>= op; + bits -= op; + op = (unsigned)(this.op); + if (op == 0) { /* literal */ + Tracevv((stderr, this.val >= 0x20 && this.val < 0x7f ? + "inflate: literal '%c'\n" : + "inflate: literal 0x%02x\n", this.val)); + PUP(out) = (unsigned char)(this.val); + } + else if (op & 16) { /* length base */ + len = (unsigned)(this.val); + op &= 15; /* number of extra bits */ + if (op) { + if (bits < op) { + hold += (unsigned long)(PUP(in)) << bits; + bits += 8; + } + len += (unsigned)hold & ((1U << op) - 1); + hold >>= op; + bits -= op; + } + Tracevv((stderr, "inflate: length %u\n", len)); + if (bits < 15) { + hold += (unsigned long)(PUP(in)) << bits; + bits += 8; + hold += (unsigned long)(PUP(in)) << bits; + bits += 8; + } + this = dcode[hold & dmask]; + dodist: + op = (unsigned)(this.bits); + hold >>= op; + bits -= op; + op = (unsigned)(this.op); + if (op & 16) { /* distance base */ + dist = (unsigned)(this.val); + op &= 15; /* number of extra bits */ + if (bits < op) { + hold += (unsigned long)(PUP(in)) << bits; + bits += 8; + if (bits < op) { + hold += (unsigned long)(PUP(in)) << bits; + bits += 8; + } + } + dist += (unsigned)hold & ((1U << op) - 1); +#ifdef INFLATE_STRICT + if (dist > dmax) { + strm->msg = (char *)"invalid distance too far back"; + state->mode = BAD; + break; + } +#endif + hold >>= op; + bits -= op; + Tracevv((stderr, "inflate: distance %u\n", dist)); + op = (unsigned)(out - beg); /* max distance in output */ + if (dist > op) { /* see if copy from window */ + op = dist - op; /* distance back in window */ + if (op > whave) { + strm->msg = (char *)"invalid distance too far back"; + state->mode = BAD; + break; + } + from = window - OFF; + if (write == 0) { /* very common case */ + from += wsize - op; + if (op < len) { /* some from window */ + len -= op; + do { + PUP(out) = PUP(from); + } while (--op); + from = out - dist; /* rest from output */ + } + } + else if (write < op) { /* wrap around window */ + from += wsize + write - op; + op -= write; + if (op < len) { /* some from end of window */ + len -= op; + do { + PUP(out) = PUP(from); + } while (--op); + from = window - OFF; + if (write < len) { /* some from start of window */ + op = write; + len -= op; + do { + PUP(out) = PUP(from); + } while (--op); + from = out - dist; /* rest from output */ + } + } + } + else { /* contiguous in window */ + from += write - op; + if (op < len) { /* some from window */ + len -= op; + do { + PUP(out) = PUP(from); + } while (--op); + from = out - dist; /* rest from output */ + } + } + while (len > 2) { + PUP(out) = PUP(from); + PUP(out) = PUP(from); + PUP(out) = PUP(from); + len -= 3; + } + if (len) { + PUP(out) = PUP(from); + if (len > 1) + PUP(out) = PUP(from); + } + } + else { + from = out - dist; /* copy direct from output */ + do { /* minimum length is three */ + PUP(out) = PUP(from); + PUP(out) = PUP(from); + PUP(out) = PUP(from); + len -= 3; + } while (len > 2); + if (len) { + PUP(out) = PUP(from); + if (len > 1) + PUP(out) = PUP(from); + } + } + } + else if ((op & 64) == 0) { /* 2nd level distance code */ + this = dcode[this.val + (hold & ((1U << op) - 1))]; + goto dodist; + } + else { + strm->msg = (char *)"invalid distance code"; + state->mode = BAD; + break; + } + } + else if ((op & 64) == 0) { /* 2nd level length code */ + this = lcode[this.val + (hold & ((1U << op) - 1))]; + goto dolen; + } + else if (op & 32) { /* end-of-block */ + Tracevv((stderr, "inflate: end of block\n")); + state->mode = TYPE; + break; + } + else { + strm->msg = (char *)"invalid literal/length code"; + state->mode = BAD; + break; + } + } while (in < last && out < end); + + /* return unused bytes (on entry, bits < 8, so in won't go too far back) */ + len = bits >> 3; + in -= len; + bits -= len << 3; + hold &= (1U << bits) - 1; + + /* update state and return */ + strm->next_in = in + OFF; + strm->next_out = out + OFF; + strm->avail_in = (unsigned)(in < last ? 5 + (last - in) : 5 - (in - last)); + strm->avail_out = (unsigned)(out < end ? + 257 + (end - out) : 257 - (out - end)); + state->hold = hold; + state->bits = bits; + return; +} + +/* + inflate_fast() speedups that turned out slower (on a PowerPC G3 750CXe): + - Using bit fields for code structure + - Different op definition to avoid & for extra bits (do & for table bits) + - Three separate decoding do-loops for direct, window, and write == 0 + - Special case for distance > 1 copies to do overlapped load and store copy + - Explicit branch predictions (based on measured branch probabilities) + - Deferring match copy and interspersed it with decoding subsequent codes + - Swapping literal/length else + - Swapping window/direct else + - Larger unrolled copy loops (three is about right) + - Moving len -= 3 statement into middle of loop + */ + +#endif /* !ASMINF */ diff --git a/erts/emulator/zlib/inffast.h b/erts/emulator/zlib/inffast.h new file mode 100644 index 0000000000..623ed83c08 --- /dev/null +++ b/erts/emulator/zlib/inffast.h @@ -0,0 +1,13 @@ +/* inffast.h -- header to use inffast.c + * Copyright (C) 1995-2003 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* WARNING: this file should *not* be used by applications. It is + part of the implementation of the compression library and is + subject to change. Applications should only use zlib.h. + */ + +void inflate_fast OF((z_streamp strm, unsigned start)); diff --git a/erts/emulator/zlib/inffixed.h b/erts/emulator/zlib/inffixed.h new file mode 100644 index 0000000000..75ed4b5978 --- /dev/null +++ b/erts/emulator/zlib/inffixed.h @@ -0,0 +1,94 @@ + /* inffixed.h -- table for decoding fixed codes + * Generated automatically by makefixed(). + */ + + /* WARNING: this file should *not* be used by applications. It + is part of the implementation of the compression library and + is subject to change. Applications should only use zlib.h. + */ + + static const code lenfix[512] = { + {96,7,0},{0,8,80},{0,8,16},{20,8,115},{18,7,31},{0,8,112},{0,8,48}, + {0,9,192},{16,7,10},{0,8,96},{0,8,32},{0,9,160},{0,8,0},{0,8,128}, + {0,8,64},{0,9,224},{16,7,6},{0,8,88},{0,8,24},{0,9,144},{19,7,59}, + {0,8,120},{0,8,56},{0,9,208},{17,7,17},{0,8,104},{0,8,40},{0,9,176}, + {0,8,8},{0,8,136},{0,8,72},{0,9,240},{16,7,4},{0,8,84},{0,8,20}, + {21,8,227},{19,7,43},{0,8,116},{0,8,52},{0,9,200},{17,7,13},{0,8,100}, + {0,8,36},{0,9,168},{0,8,4},{0,8,132},{0,8,68},{0,9,232},{16,7,8}, + {0,8,92},{0,8,28},{0,9,152},{20,7,83},{0,8,124},{0,8,60},{0,9,216}, + {18,7,23},{0,8,108},{0,8,44},{0,9,184},{0,8,12},{0,8,140},{0,8,76}, + {0,9,248},{16,7,3},{0,8,82},{0,8,18},{21,8,163},{19,7,35},{0,8,114}, + {0,8,50},{0,9,196},{17,7,11},{0,8,98},{0,8,34},{0,9,164},{0,8,2}, + {0,8,130},{0,8,66},{0,9,228},{16,7,7},{0,8,90},{0,8,26},{0,9,148}, + {20,7,67},{0,8,122},{0,8,58},{0,9,212},{18,7,19},{0,8,106},{0,8,42}, + {0,9,180},{0,8,10},{0,8,138},{0,8,74},{0,9,244},{16,7,5},{0,8,86}, + {0,8,22},{64,8,0},{19,7,51},{0,8,118},{0,8,54},{0,9,204},{17,7,15}, + {0,8,102},{0,8,38},{0,9,172},{0,8,6},{0,8,134},{0,8,70},{0,9,236}, + {16,7,9},{0,8,94},{0,8,30},{0,9,156},{20,7,99},{0,8,126},{0,8,62}, + {0,9,220},{18,7,27},{0,8,110},{0,8,46},{0,9,188},{0,8,14},{0,8,142}, + {0,8,78},{0,9,252},{96,7,0},{0,8,81},{0,8,17},{21,8,131},{18,7,31}, + {0,8,113},{0,8,49},{0,9,194},{16,7,10},{0,8,97},{0,8,33},{0,9,162}, + {0,8,1},{0,8,129},{0,8,65},{0,9,226},{16,7,6},{0,8,89},{0,8,25}, + {0,9,146},{19,7,59},{0,8,121},{0,8,57},{0,9,210},{17,7,17},{0,8,105}, + {0,8,41},{0,9,178},{0,8,9},{0,8,137},{0,8,73},{0,9,242},{16,7,4}, + {0,8,85},{0,8,21},{16,8,258},{19,7,43},{0,8,117},{0,8,53},{0,9,202}, + {17,7,13},{0,8,101},{0,8,37},{0,9,170},{0,8,5},{0,8,133},{0,8,69}, + {0,9,234},{16,7,8},{0,8,93},{0,8,29},{0,9,154},{20,7,83},{0,8,125}, + {0,8,61},{0,9,218},{18,7,23},{0,8,109},{0,8,45},{0,9,186},{0,8,13}, + {0,8,141},{0,8,77},{0,9,250},{16,7,3},{0,8,83},{0,8,19},{21,8,195}, + {19,7,35},{0,8,115},{0,8,51},{0,9,198},{17,7,11},{0,8,99},{0,8,35}, + {0,9,166},{0,8,3},{0,8,131},{0,8,67},{0,9,230},{16,7,7},{0,8,91}, + {0,8,27},{0,9,150},{20,7,67},{0,8,123},{0,8,59},{0,9,214},{18,7,19}, + {0,8,107},{0,8,43},{0,9,182},{0,8,11},{0,8,139},{0,8,75},{0,9,246}, + {16,7,5},{0,8,87},{0,8,23},{64,8,0},{19,7,51},{0,8,119},{0,8,55}, + {0,9,206},{17,7,15},{0,8,103},{0,8,39},{0,9,174},{0,8,7},{0,8,135}, + {0,8,71},{0,9,238},{16,7,9},{0,8,95},{0,8,31},{0,9,158},{20,7,99}, + {0,8,127},{0,8,63},{0,9,222},{18,7,27},{0,8,111},{0,8,47},{0,9,190}, + {0,8,15},{0,8,143},{0,8,79},{0,9,254},{96,7,0},{0,8,80},{0,8,16}, + {20,8,115},{18,7,31},{0,8,112},{0,8,48},{0,9,193},{16,7,10},{0,8,96}, + {0,8,32},{0,9,161},{0,8,0},{0,8,128},{0,8,64},{0,9,225},{16,7,6}, + {0,8,88},{0,8,24},{0,9,145},{19,7,59},{0,8,120},{0,8,56},{0,9,209}, + {17,7,17},{0,8,104},{0,8,40},{0,9,177},{0,8,8},{0,8,136},{0,8,72}, + {0,9,241},{16,7,4},{0,8,84},{0,8,20},{21,8,227},{19,7,43},{0,8,116}, + {0,8,52},{0,9,201},{17,7,13},{0,8,100},{0,8,36},{0,9,169},{0,8,4}, + {0,8,132},{0,8,68},{0,9,233},{16,7,8},{0,8,92},{0,8,28},{0,9,153}, + {20,7,83},{0,8,124},{0,8,60},{0,9,217},{18,7,23},{0,8,108},{0,8,44}, + {0,9,185},{0,8,12},{0,8,140},{0,8,76},{0,9,249},{16,7,3},{0,8,82}, + {0,8,18},{21,8,163},{19,7,35},{0,8,114},{0,8,50},{0,9,197},{17,7,11}, + {0,8,98},{0,8,34},{0,9,165},{0,8,2},{0,8,130},{0,8,66},{0,9,229}, + {16,7,7},{0,8,90},{0,8,26},{0,9,149},{20,7,67},{0,8,122},{0,8,58}, + {0,9,213},{18,7,19},{0,8,106},{0,8,42},{0,9,181},{0,8,10},{0,8,138}, + {0,8,74},{0,9,245},{16,7,5},{0,8,86},{0,8,22},{64,8,0},{19,7,51}, + {0,8,118},{0,8,54},{0,9,205},{17,7,15},{0,8,102},{0,8,38},{0,9,173}, + {0,8,6},{0,8,134},{0,8,70},{0,9,237},{16,7,9},{0,8,94},{0,8,30}, + {0,9,157},{20,7,99},{0,8,126},{0,8,62},{0,9,221},{18,7,27},{0,8,110}, + {0,8,46},{0,9,189},{0,8,14},{0,8,142},{0,8,78},{0,9,253},{96,7,0}, + {0,8,81},{0,8,17},{21,8,131},{18,7,31},{0,8,113},{0,8,49},{0,9,195}, + {16,7,10},{0,8,97},{0,8,33},{0,9,163},{0,8,1},{0,8,129},{0,8,65}, + {0,9,227},{16,7,6},{0,8,89},{0,8,25},{0,9,147},{19,7,59},{0,8,121}, + {0,8,57},{0,9,211},{17,7,17},{0,8,105},{0,8,41},{0,9,179},{0,8,9}, + {0,8,137},{0,8,73},{0,9,243},{16,7,4},{0,8,85},{0,8,21},{16,8,258}, + {19,7,43},{0,8,117},{0,8,53},{0,9,203},{17,7,13},{0,8,101},{0,8,37}, + {0,9,171},{0,8,5},{0,8,133},{0,8,69},{0,9,235},{16,7,8},{0,8,93}, + {0,8,29},{0,9,155},{20,7,83},{0,8,125},{0,8,61},{0,9,219},{18,7,23}, + {0,8,109},{0,8,45},{0,9,187},{0,8,13},{0,8,141},{0,8,77},{0,9,251}, + {16,7,3},{0,8,83},{0,8,19},{21,8,195},{19,7,35},{0,8,115},{0,8,51}, + {0,9,199},{17,7,11},{0,8,99},{0,8,35},{0,9,167},{0,8,3},{0,8,131}, + {0,8,67},{0,9,231},{16,7,7},{0,8,91},{0,8,27},{0,9,151},{20,7,67}, + {0,8,123},{0,8,59},{0,9,215},{18,7,19},{0,8,107},{0,8,43},{0,9,183}, + {0,8,11},{0,8,139},{0,8,75},{0,9,247},{16,7,5},{0,8,87},{0,8,23}, + {64,8,0},{19,7,51},{0,8,119},{0,8,55},{0,9,207},{17,7,15},{0,8,103}, + {0,8,39},{0,9,175},{0,8,7},{0,8,135},{0,8,71},{0,9,239},{16,7,9}, + {0,8,95},{0,8,31},{0,9,159},{20,7,99},{0,8,127},{0,8,63},{0,9,223}, + {18,7,27},{0,8,111},{0,8,47},{0,9,191},{0,8,15},{0,8,143},{0,8,79}, + {0,9,255} + }; + + static const code distfix[32] = { + {16,5,1},{23,5,257},{19,5,17},{27,5,4097},{17,5,5},{25,5,1025}, + {21,5,65},{29,5,16385},{16,5,3},{24,5,513},{20,5,33},{28,5,8193}, + {18,5,9},{26,5,2049},{22,5,129},{64,5,0},{16,5,2},{23,5,385}, + {19,5,25},{27,5,6145},{17,5,7},{25,5,1537},{21,5,97},{29,5,24577}, + {16,5,4},{24,5,769},{20,5,49},{28,5,12289},{18,5,13},{26,5,3073}, + {22,5,193},{64,5,0} + }; diff --git a/erts/emulator/zlib/inflate.c b/erts/emulator/zlib/inflate.c new file mode 100644 index 0000000000..1764447c66 --- /dev/null +++ b/erts/emulator/zlib/inflate.c @@ -0,0 +1,1373 @@ +/* inflate.c -- zlib decompression + * Copyright (C) 1995-2005 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +/* + * Change history: + * + * 1.2.beta0 24 Nov 2002 + * - First version -- complete rewrite of inflate to simplify code, avoid + * creation of window when not needed, minimize use of window when it is + * needed, make inffast.c even faster, implement gzip decoding, and to + * improve code readability and style over the previous zlib inflate code + * + * 1.2.beta1 25 Nov 2002 + * - Use pointers for available input and output checking in inffast.c + * - Remove input and output counters in inffast.c + * - Change inffast.c entry and loop from avail_in >= 7 to >= 6 + * - Remove unnecessary second byte pull from length extra in inffast.c + * - Unroll direct copy to three copies per loop in inffast.c + * + * 1.2.beta2 4 Dec 2002 + * - Change external routine names to reduce potential conflicts + * - Correct filename to inffixed.h for fixed tables in inflate.c + * - Make hbuf[] unsigned char to match parameter type in inflate.c + * - Change strm->next_out[-state->offset] to *(strm->next_out - state->offset) + * to avoid negation problem on Alphas (64 bit) in inflate.c + * + * 1.2.beta3 22 Dec 2002 + * - Add comments on state->bits assertion in inffast.c + * - Add comments on op field in inftrees.h + * - Fix bug in reuse of allocated window after inflateReset() + * - Remove bit fields--back to byte structure for speed + * - Remove distance extra == 0 check in inflate_fast()--only helps for lengths + * - Change post-increments to pre-increments in inflate_fast(), PPC biased? + * - Add compile time option, POSTINC, to use post-increments instead (Intel?) + * - Make MATCH copy in inflate() much faster for when inflate_fast() not used + * - Use local copies of stream next and avail values, as well as local bit + * buffer and bit count in inflate()--for speed when inflate_fast() not used + * + * 1.2.beta4 1 Jan 2003 + * - Split ptr - 257 statements in inflate_table() to avoid compiler warnings + * - Move a comment on output buffer sizes from inffast.c to inflate.c + * - Add comments in inffast.c to introduce the inflate_fast() routine + * - Rearrange window copies in inflate_fast() for speed and simplification + * - Unroll last copy for window match in inflate_fast() + * - Use local copies of window variables in inflate_fast() for speed + * - Pull out common write == 0 case for speed in inflate_fast() + * - Make op and len in inflate_fast() unsigned for consistency + * - Add FAR to lcode and dcode declarations in inflate_fast() + * - Simplified bad distance check in inflate_fast() + * - Added inflateBackInit(), inflateBack(), and inflateBackEnd() in new + * source file infback.c to provide a call-back interface to inflate for + * programs like gzip and unzip -- uses window as output buffer to avoid + * window copying + * + * 1.2.beta5 1 Jan 2003 + * - Improved inflateBack() interface to allow the caller to provide initial + * input in strm. + * - Fixed stored blocks bug in inflateBack() + * + * 1.2.beta6 4 Jan 2003 + * - Added comments in inffast.c on effectiveness of POSTINC + * - Typecasting all around to reduce compiler warnings + * - Changed loops from while (1) or do {} while (1) to for (;;), again to + * make compilers happy + * - Changed type of window in inflateBackInit() to unsigned char * + * + * 1.2.beta7 27 Jan 2003 + * - Changed many types to unsigned or unsigned short to avoid warnings + * - Added inflateCopy() function + * + * 1.2.0 9 Mar 2003 + * - Changed inflateBack() interface to provide separate opaque descriptors + * for the in() and out() functions + * - Changed inflateBack() argument and in_func typedef to swap the length + * and buffer address return values for the input function + * - Check next_in and next_out for Z_NULL on entry to inflate() + * + * The history for versions after 1.2.0 are in ChangeLog in zlib distribution. + */ + +#include "zutil.h" +#include "inftrees.h" +#include "inflate.h" +#include "inffast.h" + +#ifdef MAKEFIXED +# ifndef BUILDFIXED +# define BUILDFIXED +# endif +#endif + +/* function prototypes */ +local void fixedtables OF((struct inflate_state FAR *state)); +local int updatewindow OF((z_streamp strm, unsigned out)); +#ifdef BUILDFIXED + void makefixed OF((void)); +#endif +local unsigned syncsearch OF((unsigned FAR *have, unsigned char FAR *buf, + unsigned len)); + +int ZEXPORT inflateReset(strm) +z_streamp strm; +{ + struct inflate_state FAR *state; + + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)strm->state; + strm->total_in = strm->total_out = state->total = 0; + strm->msg = Z_NULL; + strm->adler = 1; /* to support ill-conceived Java test suite */ + state->mode = HEAD; + state->last = 0; + state->havedict = 0; + state->dmax = 32768U; + state->head = Z_NULL; + state->wsize = 0; + state->whave = 0; + state->write = 0; + state->hold = 0; + state->bits = 0; + state->lencode = state->distcode = state->next = state->codes; + Tracev((stderr, "inflate: reset\n")); + return Z_OK; +} + +int ZEXPORT inflatePrime(strm, bits, value) +z_streamp strm; +int bits; +int value; +{ + struct inflate_state FAR *state; + + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)strm->state; + if (bits > 16 || state->bits + bits > 32) return Z_STREAM_ERROR; + value &= (1L << bits) - 1; + state->hold += value << state->bits; + state->bits += bits; + return Z_OK; +} + +int ZEXPORT inflateInit2_(strm, windowBits, version, stream_size) +z_streamp strm; +int windowBits; +const char *version; +int stream_size; +{ + struct inflate_state FAR *state; + + if (version == Z_NULL || version[0] != ZLIB_VERSION[0] || + stream_size != (int)(sizeof(z_stream))) + return Z_VERSION_ERROR; + if (strm == Z_NULL) return Z_STREAM_ERROR; + strm->msg = Z_NULL; /* in case we return an error */ + if (strm->zalloc == (alloc_func)0) { + strm->zalloc = zcalloc; + strm->opaque = (voidpf)0; + } + if (strm->zfree == (free_func)0) strm->zfree = zcfree; + state = (struct inflate_state FAR *) + ZALLOC(strm, 1, sizeof(struct inflate_state)); + if (state == Z_NULL) return Z_MEM_ERROR; + Tracev((stderr, "inflate: allocated\n")); + strm->state = (struct internal_state FAR *)state; + if (windowBits < 0) { + state->wrap = 0; + windowBits = -windowBits; + } + else { + state->wrap = (windowBits >> 4) + 1; +#ifdef GUNZIP + if (windowBits < 48) windowBits &= 15; +#endif + } + if (windowBits < 8 || windowBits > 15) { + ZFREE(strm, state); + strm->state = Z_NULL; + return Z_STREAM_ERROR; + } + state->wbits = (unsigned)windowBits; + state->window = Z_NULL; + return inflateReset(strm); +} + +int ZEXPORT inflateInit_(strm, version, stream_size) +z_streamp strm; +const char *version; +int stream_size; +{ + return inflateInit2_(strm, DEF_WBITS, version, stream_size); +} + +/* + Return state with length and distance decoding tables and index sizes set to + fixed code decoding. Normally this returns fixed tables from inffixed.h. + If BUILDFIXED is defined, then instead this routine builds the tables the + first time it's called, and returns those tables the first time and + thereafter. This reduces the size of the code by about 2K bytes, in + exchange for a little execution time. However, BUILDFIXED should not be + used for threaded applications, since the rewriting of the tables and virgin + may not be thread-safe. + */ +local void fixedtables(state) +struct inflate_state FAR *state; +{ +#ifdef BUILDFIXED + static int virgin = 1; + static code *lenfix, *distfix; + static code fixed[544]; + + /* build fixed huffman tables if first call (may not be thread safe) */ + if (virgin) { + unsigned sym, bits; + static code *next; + + /* literal/length table */ + sym = 0; + while (sym < 144) state->lens[sym++] = 8; + while (sym < 256) state->lens[sym++] = 9; + while (sym < 280) state->lens[sym++] = 7; + while (sym < 288) state->lens[sym++] = 8; + next = fixed; + lenfix = next; + bits = 9; + inflate_table(LENS, state->lens, 288, &(next), &(bits), state->work); + + /* distance table */ + sym = 0; + while (sym < 32) state->lens[sym++] = 5; + distfix = next; + bits = 5; + inflate_table(DISTS, state->lens, 32, &(next), &(bits), state->work); + + /* do this just once */ + virgin = 0; + } +#else /* !BUILDFIXED */ +# include "inffixed.h" +#endif /* BUILDFIXED */ + state->lencode = lenfix; + state->lenbits = 9; + state->distcode = distfix; + state->distbits = 5; +} + +#ifdef MAKEFIXED +#include + +/* + Write out the inffixed.h that is #include'd above. Defining MAKEFIXED also + defines BUILDFIXED, so the tables are built on the fly. makefixed() writes + those tables to stdout, which would be piped to inffixed.h. A small program + can simply call makefixed to do this: + + void makefixed(void); + + int main(void) + { + makefixed(); + return 0; + } + + Then that can be linked with zlib built with MAKEFIXED defined and run: + + a.out > inffixed.h + */ +void makefixed() +{ + unsigned low, size; + struct inflate_state state; + + fixedtables(&state); + puts(" /* inffixed.h -- table for decoding fixed codes"); + puts(" * Generated automatically by makefixed()."); + puts(" */"); + puts(""); + puts(" /* WARNING: this file should *not* be used by applications."); + puts(" It is part of the implementation of this library and is"); + puts(" subject to change. Applications should only use zlib.h."); + puts(" */"); + puts(""); + size = 1U << 9; + printf(" static const code lenfix[%u] = {", size); + low = 0; + for (;;) { + if ((low % 7) == 0) printf("\n "); + printf("{%u,%u,%d}", state.lencode[low].op, state.lencode[low].bits, + state.lencode[low].val); + if (++low == size) break; + putchar(','); + } + puts("\n };"); + size = 1U << 5; + printf("\n static const code distfix[%u] = {", size); + low = 0; + for (;;) { + if ((low % 6) == 0) printf("\n "); + printf("{%u,%u,%d}", state.distcode[low].op, state.distcode[low].bits, + state.distcode[low].val); + if (++low == size) break; + putchar(','); + } + puts("\n };"); +} +#endif /* MAKEFIXED */ + +/* + Update the window with the last wsize (normally 32K) bytes written before + returning. If window does not exist yet, create it. This is only called + when a window is already in use, or when output has been written during this + inflate call, but the end of the deflate stream has not been reached yet. + It is also called to create a window for dictionary data when a dictionary + is loaded. + + Providing output buffers larger than 32K to inflate() should provide a speed + advantage, since only the last 32K of output is copied to the sliding window + upon return from inflate(), and since all distances after the first 32K of + output will fall in the output data, making match copies simpler and faster. + The advantage may be dependent on the size of the processor's data caches. + */ +local int updatewindow(strm, out) +z_streamp strm; +unsigned out; +{ + struct inflate_state FAR *state; + unsigned copy, dist; + + state = (struct inflate_state FAR *)strm->state; + + /* if it hasn't been done already, allocate space for the window */ + if (state->window == Z_NULL) { + state->window = (unsigned char FAR *) + ZALLOC(strm, 1U << state->wbits, + sizeof(unsigned char)); + if (state->window == Z_NULL) return 1; + } + + /* if window not in use yet, initialize */ + if (state->wsize == 0) { + state->wsize = 1U << state->wbits; + state->write = 0; + state->whave = 0; + } + + /* copy state->wsize or less output bytes into the circular window */ + copy = out - strm->avail_out; + if (copy >= state->wsize) { + zmemcpy(state->window, strm->next_out - state->wsize, state->wsize); + state->write = 0; + state->whave = state->wsize; + } + else { + dist = state->wsize - state->write; + if (dist > copy) dist = copy; + zmemcpy(state->window + state->write, strm->next_out - copy, dist); + copy -= dist; + if (copy) { + zmemcpy(state->window, strm->next_out - copy, copy); + state->write = copy; + state->whave = state->wsize; + } + else { + state->write += dist; + if (state->write == state->wsize) state->write = 0; + if (state->whave < state->wsize) state->whave += dist; + } + } + return 0; +} + +/* Macros for inflate(): */ + +/* check function to use adler32() for zlib or crc32() for gzip */ +#ifdef GUNZIP +# define UPDATE(check, buf, len) \ + (state->flags ? crc32(check, buf, len) : adler32(check, buf, len)) +#else +# define UPDATE(check, buf, len) adler32(check, buf, len) +#endif + +/* check macros for header crc */ +#ifdef GUNZIP +# define CRC2(check, word) \ + do { \ + hbuf[0] = (unsigned char)(word); \ + hbuf[1] = (unsigned char)((word) >> 8); \ + check = crc32(check, hbuf, 2); \ + } while (0) + +# define CRC4(check, word) \ + do { \ + hbuf[0] = (unsigned char)(word); \ + hbuf[1] = (unsigned char)((word) >> 8); \ + hbuf[2] = (unsigned char)((word) >> 16); \ + hbuf[3] = (unsigned char)((word) >> 24); \ + check = crc32(check, hbuf, 4); \ + } while (0) +#endif + +/* Load registers with state in inflate() for speed */ +#define LOAD() \ + do { \ + put = strm->next_out; \ + left = strm->avail_out; \ + next = strm->next_in; \ + have = strm->avail_in; \ + hold = state->hold; \ + bits = state->bits; \ + } while (0) + +/* Restore state from registers in inflate() */ +#define RESTORE() \ + do { \ + strm->next_out = put; \ + strm->avail_out = left; \ + strm->next_in = next; \ + strm->avail_in = have; \ + state->hold = hold; \ + state->bits = bits; \ + } while (0) + +/* Clear the input bit accumulator */ +#define INITBITS() \ + do { \ + hold = 0; \ + bits = 0; \ + } while (0) + +/* Get a byte of input into the bit accumulator, or return from inflate() + if there is no input available. */ +#define PULLBYTE() \ + do { \ + if (have == 0) goto inf_leave; \ + have--; \ + hold += (unsigned long)(*next++) << bits; \ + bits += 8; \ + } while (0) + +/* Assure that there are at least n bits in the bit accumulator. If there is + not enough available input to do that, then return from inflate(). */ +#define NEEDBITS(n) \ + do { \ + while (bits < (unsigned)(n)) \ + PULLBYTE(); \ + } while (0) + +/* Return the low n bits of the bit accumulator (n < 16) */ +#define BITS(n) \ + ((unsigned)hold & ((1U << (n)) - 1)) + +/* Remove n bits from the bit accumulator */ +#define DROPBITS(n) \ + do { \ + hold >>= (n); \ + bits -= (unsigned)(n); \ + } while (0) + +/* Remove zero to seven bits as needed to go to a byte boundary */ +#define BYTEBITS() \ + do { \ + hold >>= bits & 7; \ + bits -= bits & 7; \ + } while (0) + +/* Reverse the bytes in a 32-bit value */ +#define REVERSE(q) \ + ((((q) >> 24) & 0xff) + (((q) >> 8) & 0xff00) + \ + (((q) & 0xff00) << 8) + (((q) & 0xff) << 24)) + +/* + inflate() uses a state machine to process as much input data and generate as + much output data as possible before returning. The state machine is + structured roughly as follows: + + for (;;) switch (state) { + ... + case STATEn: + if (not enough input data or output space to make progress) + return; + ... make progress ... + state = STATEm; + break; + ... + } + + so when inflate() is called again, the same case is attempted again, and + if the appropriate resources are provided, the machine proceeds to the + next state. The NEEDBITS() macro is usually the way the state evaluates + whether it can proceed or should return. NEEDBITS() does the return if + the requested bits are not available. The typical use of the BITS macros + is: + + NEEDBITS(n); + ... do something with BITS(n) ... + DROPBITS(n); + + where NEEDBITS(n) either returns from inflate() if there isn't enough + input left to load n bits into the accumulator, or it continues. BITS(n) + gives the low n bits in the accumulator. When done, DROPBITS(n) drops + the low n bits off the accumulator. INITBITS() clears the accumulator + and sets the number of available bits to zero. BYTEBITS() discards just + enough bits to put the accumulator on a byte boundary. After BYTEBITS() + and a NEEDBITS(8), then BITS(8) would return the next byte in the stream. + + NEEDBITS(n) uses PULLBYTE() to get an available byte of input, or to return + if there is no input available. The decoding of variable length codes uses + PULLBYTE() directly in order to pull just enough bytes to decode the next + code, and no more. + + Some states loop until they get enough input, making sure that enough + state information is maintained to continue the loop where it left off + if NEEDBITS() returns in the loop. For example, want, need, and keep + would all have to actually be part of the saved state in case NEEDBITS() + returns: + + case STATEw: + while (want < need) { + NEEDBITS(n); + keep[want++] = BITS(n); + DROPBITS(n); + } + state = STATEx; + case STATEx: + + As shown above, if the next state is also the next case, then the break + is omitted. + + A state may also return if there is not enough output space available to + complete that state. Those states are copying stored data, writing a + literal byte, and copying a matching string. + + When returning, a "goto inf_leave" is used to update the total counters, + update the check value, and determine whether any progress has been made + during that inflate() call in order to return the proper return code. + Progress is defined as a change in either strm->avail_in or strm->avail_out. + When there is a window, goto inf_leave will update the window with the last + output written. If a goto inf_leave occurs in the middle of decompression + and there is no window currently, goto inf_leave will create one and copy + output to the window for the next call of inflate(). + + In this implementation, the flush parameter of inflate() only affects the + return code (per zlib.h). inflate() always writes as much as possible to + strm->next_out, given the space available and the provided input--the effect + documented in zlib.h of Z_SYNC_FLUSH. Furthermore, inflate() always defers + the allocation of and copying into a sliding window until necessary, which + provides the effect documented in zlib.h for Z_FINISH when the entire input + stream available. So the only thing the flush parameter actually does is: + when flush is set to Z_FINISH, inflate() cannot return Z_OK. Instead it + will return Z_BUF_ERROR if it has not reached the end of the stream. + */ + +int ZEXPORT inflate(strm, flush) +z_streamp strm; +int flush; +{ + struct inflate_state FAR *state; + unsigned char FAR *next; /* next input */ + unsigned char FAR *put; /* next output */ + unsigned have, left; /* available input and output */ + unsigned long hold; /* bit buffer */ + unsigned bits; /* bits in bit buffer */ + unsigned in, out; /* save starting available input and output */ + unsigned copy; /* number of stored or match bytes to copy */ + unsigned char FAR *from; /* where to copy match bytes from */ + code this; /* current decoding table entry */ + code last; /* parent table entry */ + unsigned len; /* length to copy for repeats, bits to drop */ + int ret; /* return code */ +#ifdef GUNZIP + unsigned char hbuf[4]; /* buffer for gzip header crc calculation */ +#endif + static const unsigned short order[19] = /* permutation of code lengths */ + {16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15}; + + if (strm == Z_NULL || strm->state == Z_NULL || strm->next_out == Z_NULL || + (strm->next_in == Z_NULL && strm->avail_in != 0)) + return Z_STREAM_ERROR; + + state = (struct inflate_state FAR *)strm->state; + if (state->mode == TYPE) state->mode = TYPEDO; /* skip check */ + LOAD(); + in = have; + out = left; + ret = Z_OK; + for (;;) + switch (state->mode) { + case HEAD: + if (state->wrap == 0) { + state->mode = TYPEDO; + break; + } + NEEDBITS(16); +#ifdef GUNZIP + if ((state->wrap & 2) && hold == 0x8b1f) { /* gzip header */ + state->check = crc32(0L, Z_NULL, 0); + CRC2(state->check, hold); + INITBITS(); + state->mode = FLAGS; + break; + } + state->flags = 0; /* expect zlib header */ + if (state->head != Z_NULL) + state->head->done = -1; + if (!(state->wrap & 1) || /* check if zlib header allowed */ +#else + if ( +#endif + ((BITS(8) << 8) + (hold >> 8)) % 31) { + strm->msg = (char *)"incorrect header check"; + state->mode = BAD; + break; + } + if (BITS(4) != Z_DEFLATED) { + strm->msg = (char *)"unknown compression method"; + state->mode = BAD; + break; + } + DROPBITS(4); + len = BITS(4) + 8; + if (len > state->wbits) { + strm->msg = (char *)"invalid window size"; + state->mode = BAD; + break; + } + state->dmax = 1U << len; + Tracev((stderr, "inflate: zlib header ok\n")); + strm->adler = state->check = adler32(0L, Z_NULL, 0); + state->mode = hold & 0x200 ? DICTID : TYPE; + INITBITS(); + break; +#ifdef GUNZIP + case FLAGS: + NEEDBITS(16); + state->flags = (int)(hold); + if ((state->flags & 0xff) != Z_DEFLATED) { + strm->msg = (char *)"unknown compression method"; + state->mode = BAD; + break; + } + if (state->flags & 0xe000) { + strm->msg = (char *)"unknown header flags set"; + state->mode = BAD; + break; + } + if (state->head != Z_NULL) + state->head->text = (int)((hold >> 8) & 1); + if (state->flags & 0x0200) CRC2(state->check, hold); + INITBITS(); + state->mode = TIME; + case TIME: + NEEDBITS(32); + if (state->head != Z_NULL) + state->head->time = hold; + if (state->flags & 0x0200) CRC4(state->check, hold); + INITBITS(); + state->mode = OS; + case OS: + NEEDBITS(16); + if (state->head != Z_NULL) { + state->head->xflags = (int)(hold & 0xff); + state->head->os = (int)(hold >> 8); + } + if (state->flags & 0x0200) CRC2(state->check, hold); + INITBITS(); + state->mode = EXLEN; + case EXLEN: + if (state->flags & 0x0400) { + NEEDBITS(16); + state->length = (unsigned)(hold); + if (state->head != Z_NULL) + state->head->extra_len = (unsigned)hold; + if (state->flags & 0x0200) CRC2(state->check, hold); + INITBITS(); + } + else if (state->head != Z_NULL) + state->head->extra = Z_NULL; + state->mode = EXTRA; + case EXTRA: + if (state->flags & 0x0400) { + copy = state->length; + if (copy > have) copy = have; + if (copy) { + if (state->head != Z_NULL && + state->head->extra != Z_NULL) { + len = state->head->extra_len - state->length; + zmemcpy(state->head->extra + len, next, + len + copy > state->head->extra_max ? + state->head->extra_max - len : copy); + } + if (state->flags & 0x0200) + state->check = crc32(state->check, next, copy); + have -= copy; + next += copy; + state->length -= copy; + } + if (state->length) goto inf_leave; + } + state->length = 0; + state->mode = NAME; + case NAME: + if (state->flags & 0x0800) { + if (have == 0) goto inf_leave; + copy = 0; + do { + len = (unsigned)(next[copy++]); + if (state->head != Z_NULL && + state->head->name != Z_NULL && + state->length < state->head->name_max) + state->head->name[state->length++] = len; + } while (len && copy < have); + if (state->flags & 0x0200) + state->check = crc32(state->check, next, copy); + have -= copy; + next += copy; + if (len) goto inf_leave; + } + else if (state->head != Z_NULL) + state->head->name = Z_NULL; + state->length = 0; + state->mode = COMMENT; + case COMMENT: + if (state->flags & 0x1000) { + if (have == 0) goto inf_leave; + copy = 0; + do { + len = (unsigned)(next[copy++]); + if (state->head != Z_NULL && + state->head->comment != Z_NULL && + state->length < state->head->comm_max) + state->head->comment[state->length++] = len; + } while (len && copy < have); + if (state->flags & 0x0200) + state->check = crc32(state->check, next, copy); + have -= copy; + next += copy; + if (len) goto inf_leave; + } + else if (state->head != Z_NULL) + state->head->comment = Z_NULL; + state->mode = HCRC; + case HCRC: + if (state->flags & 0x0200) { + NEEDBITS(16); + if (hold != (state->check & 0xffff)) { + strm->msg = (char *)"header crc mismatch"; + state->mode = BAD; + break; + } + INITBITS(); + } + if (state->head != Z_NULL) { + state->head->hcrc = (int)((state->flags >> 9) & 1); + state->head->done = 1; + } + strm->adler = state->check = crc32(0L, Z_NULL, 0); + state->mode = TYPE; + break; +#endif + case DICTID: + NEEDBITS(32); + strm->adler = state->check = REVERSE(hold); + INITBITS(); + state->mode = DICT; + case DICT: + if (state->havedict == 0) { + RESTORE(); + return Z_NEED_DICT; + } + strm->adler = state->check = adler32(0L, Z_NULL, 0); + state->mode = TYPE; + case TYPE: + if (flush == Z_BLOCK) goto inf_leave; + case TYPEDO: + if (state->last) { + BYTEBITS(); + state->mode = CHECK; + break; + } + NEEDBITS(3); + state->last = BITS(1); + DROPBITS(1); + switch (BITS(2)) { + case 0: /* stored block */ + Tracev((stderr, "inflate: stored block%s\n", + state->last ? " (last)" : "")); + state->mode = STORED; + break; + case 1: /* fixed block */ + fixedtables(state); + Tracev((stderr, "inflate: fixed codes block%s\n", + state->last ? " (last)" : "")); + state->mode = LEN; /* decode codes */ + break; + case 2: /* dynamic block */ + Tracev((stderr, "inflate: dynamic codes block%s\n", + state->last ? " (last)" : "")); + state->mode = TABLE; + break; + case 3: + strm->msg = (char *)"invalid block type"; + state->mode = BAD; + } + DROPBITS(2); + break; + case STORED: + BYTEBITS(); /* go to byte boundary */ + NEEDBITS(32); + if ((hold & 0xffff) != ((hold >> 16) ^ 0xffff)) { + strm->msg = (char *)"invalid stored block lengths"; + state->mode = BAD; + break; + } + state->length = (unsigned)hold & 0xffff; + Tracev((stderr, "inflate: stored length %u\n", + state->length)); + INITBITS(); + state->mode = COPY; + case COPY: + copy = state->length; + if (copy) { + if (copy > have) copy = have; + if (copy > left) copy = left; + if (copy == 0) goto inf_leave; + zmemcpy(put, next, copy); + have -= copy; + next += copy; + left -= copy; + put += copy; + state->length -= copy; + break; + } + Tracev((stderr, "inflate: stored end\n")); + state->mode = TYPE; + break; + case TABLE: + NEEDBITS(14); + state->nlen = BITS(5) + 257; + DROPBITS(5); + state->ndist = BITS(5) + 1; + DROPBITS(5); + state->ncode = BITS(4) + 4; + DROPBITS(4); +#ifndef PKZIP_BUG_WORKAROUND + if (state->nlen > 286 || state->ndist > 30) { + strm->msg = (char *)"too many length or distance symbols"; + state->mode = BAD; + break; + } +#endif + Tracev((stderr, "inflate: table sizes ok\n")); + state->have = 0; + state->mode = LENLENS; + case LENLENS: + while (state->have < state->ncode) { + NEEDBITS(3); + state->lens[order[state->have++]] = (unsigned short)BITS(3); + DROPBITS(3); + } + while (state->have < 19) + state->lens[order[state->have++]] = 0; + state->next = state->codes; + state->lencode = (code const FAR *)(state->next); + state->lenbits = 7; + ret = inflate_table(CODES, state->lens, 19, &(state->next), + &(state->lenbits), state->work); + if (ret) { + strm->msg = (char *)"invalid code lengths set"; + state->mode = BAD; + break; + } + Tracev((stderr, "inflate: code lengths ok\n")); + state->have = 0; + state->mode = CODELENS; + case CODELENS: + while (state->have < state->nlen + state->ndist) { + for (;;) { + this = state->lencode[BITS(state->lenbits)]; + if ((unsigned)(this.bits) <= bits) break; + PULLBYTE(); + } + if (this.val < 16) { + NEEDBITS(this.bits); + DROPBITS(this.bits); + state->lens[state->have++] = this.val; + } + else { + if (this.val == 16) { + NEEDBITS(this.bits + 2); + DROPBITS(this.bits); + if (state->have == 0) { + strm->msg = (char *)"invalid bit length repeat"; + state->mode = BAD; + break; + } + len = state->lens[state->have - 1]; + copy = 3 + BITS(2); + DROPBITS(2); + } + else if (this.val == 17) { + NEEDBITS(this.bits + 3); + DROPBITS(this.bits); + len = 0; + copy = 3 + BITS(3); + DROPBITS(3); + } + else { + NEEDBITS(this.bits + 7); + DROPBITS(this.bits); + len = 0; + copy = 11 + BITS(7); + DROPBITS(7); + } + if (state->have + copy > state->nlen + state->ndist) { + strm->msg = (char *)"invalid bit length repeat"; + state->mode = BAD; + break; + } + while (copy--) + state->lens[state->have++] = (unsigned short)len; + } + } + + /* handle error breaks in while */ + if (state->mode == BAD) break; + + /* build code tables */ + state->next = state->codes; + state->lencode = (code const FAR *)(state->next); + state->lenbits = 9; + ret = inflate_table(LENS, state->lens, state->nlen, &(state->next), + &(state->lenbits), state->work); + if (ret) { + strm->msg = (char *)"invalid literal/lengths set"; + state->mode = BAD; + break; + } + state->distcode = (code const FAR *)(state->next); + state->distbits = 6; + ret = inflate_table(DISTS, state->lens + state->nlen, state->ndist, + &(state->next), &(state->distbits), state->work); + if (ret) { + strm->msg = (char *)"invalid distances set"; + state->mode = BAD; + break; + } + Tracev((stderr, "inflate: codes ok\n")); + state->mode = LEN; + case LEN: + if (have >= 6 && left >= 258) { + RESTORE(); + inflate_fast(strm, out); + LOAD(); + break; + } + for (;;) { + this = state->lencode[BITS(state->lenbits)]; + if ((unsigned)(this.bits) <= bits) break; + PULLBYTE(); + } + if (this.op && (this.op & 0xf0) == 0) { + last = this; + for (;;) { + this = state->lencode[last.val + + (BITS(last.bits + last.op) >> last.bits)]; + if ((unsigned)(last.bits + this.bits) <= bits) break; + PULLBYTE(); + } + DROPBITS(last.bits); + } + DROPBITS(this.bits); + state->length = (unsigned)this.val; + if ((int)(this.op) == 0) { + Tracevv((stderr, this.val >= 0x20 && this.val < 0x7f ? + "inflate: literal '%c'\n" : + "inflate: literal 0x%02x\n", this.val)); + state->mode = LIT; + break; + } + if (this.op & 32) { + Tracevv((stderr, "inflate: end of block\n")); + state->mode = TYPE; + break; + } + if (this.op & 64) { + strm->msg = (char *)"invalid literal/length code"; + state->mode = BAD; + break; + } + state->extra = (unsigned)(this.op) & 15; + state->mode = LENEXT; + case LENEXT: + if (state->extra) { + NEEDBITS(state->extra); + state->length += BITS(state->extra); + DROPBITS(state->extra); + } + Tracevv((stderr, "inflate: length %u\n", state->length)); + state->mode = DIST; + case DIST: + for (;;) { + this = state->distcode[BITS(state->distbits)]; + if ((unsigned)(this.bits) <= bits) break; + PULLBYTE(); + } + if ((this.op & 0xf0) == 0) { + last = this; + for (;;) { + this = state->distcode[last.val + + (BITS(last.bits + last.op) >> last.bits)]; + if ((unsigned)(last.bits + this.bits) <= bits) break; + PULLBYTE(); + } + DROPBITS(last.bits); + } + DROPBITS(this.bits); + if (this.op & 64) { + strm->msg = (char *)"invalid distance code"; + state->mode = BAD; + break; + } + state->offset = (unsigned)this.val; + state->extra = (unsigned)(this.op) & 15; + state->mode = DISTEXT; + case DISTEXT: + if (state->extra) { + NEEDBITS(state->extra); + state->offset += BITS(state->extra); + DROPBITS(state->extra); + } +#ifdef INFLATE_STRICT + if (state->offset > state->dmax) { + strm->msg = (char *)"invalid distance too far back"; + state->mode = BAD; + break; + } +#endif + if (state->offset > state->whave + out - left) { + strm->msg = (char *)"invalid distance too far back"; + state->mode = BAD; + break; + } + Tracevv((stderr, "inflate: distance %u\n", state->offset)); + state->mode = MATCH; + case MATCH: + if (left == 0) goto inf_leave; + copy = out - left; + if (state->offset > copy) { /* copy from window */ + copy = state->offset - copy; + if (copy > state->write) { + copy -= state->write; + from = state->window + (state->wsize - copy); + } + else + from = state->window + (state->write - copy); + if (copy > state->length) copy = state->length; + } + else { /* copy from output */ + from = put - state->offset; + copy = state->length; + } + if (copy > left) copy = left; + left -= copy; + state->length -= copy; + do { + *put++ = *from++; + } while (--copy); + if (state->length == 0) state->mode = LEN; + break; + case LIT: + if (left == 0) goto inf_leave; + *put++ = (unsigned char)(state->length); + left--; + state->mode = LEN; + break; + case CHECK: + if (state->wrap) { + NEEDBITS(32); + out -= left; + strm->total_out += out; + state->total += out; + if (out) + strm->adler = state->check = + UPDATE(state->check, put - out, out); + out = left; + if (( +#ifdef GUNZIP + state->flags ? hold : +#endif + REVERSE(hold)) != state->check) { + strm->msg = (char *)"incorrect data check"; + state->mode = BAD; + break; + } + INITBITS(); + Tracev((stderr, "inflate: check matches trailer\n")); + } +#ifdef GUNZIP + state->mode = LENGTH; + case LENGTH: + if (state->wrap && state->flags) { + NEEDBITS(32); + if (hold != (state->total & 0xffffffffUL)) { + strm->msg = (char *)"incorrect length check"; + state->mode = BAD; + break; + } + INITBITS(); + Tracev((stderr, "inflate: length matches trailer\n")); + } +#endif + state->mode = DONE; + case DONE: + ret = Z_STREAM_END; + goto inf_leave; + case BAD: + ret = Z_DATA_ERROR; + goto inf_leave; + case MEM: + return Z_MEM_ERROR; + case SYNC: + default: + return Z_STREAM_ERROR; + } + + /* + Return from inflate(), updating the total counts and the check value. + If there was no progress during the inflate() call, return a buffer + error. Call updatewindow() to create and/or update the window state. + Note: a memory error from inflate() is non-recoverable. + */ + inf_leave: + RESTORE(); + if (state->wsize || (state->mode < CHECK && out != strm->avail_out)) + if (updatewindow(strm, out)) { + state->mode = MEM; + return Z_MEM_ERROR; + } + in -= strm->avail_in; + out -= strm->avail_out; + strm->total_in += in; + strm->total_out += out; + state->total += out; + if (state->wrap && out) + strm->adler = state->check = + UPDATE(state->check, strm->next_out - out, out); + strm->data_type = state->bits + (state->last ? 64 : 0) + + (state->mode == TYPE ? 128 : 0); + if (((in == 0 && out == 0) || flush == Z_FINISH) && ret == Z_OK) + ret = Z_BUF_ERROR; + return ret; +} + +int ZEXPORT inflateEnd(strm) +z_streamp strm; +{ + struct inflate_state FAR *state; + if (strm == Z_NULL || strm->state == Z_NULL || strm->zfree == (free_func)0) + return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)strm->state; + if (state->window != Z_NULL) ZFREE(strm, state->window); + ZFREE(strm, strm->state); + strm->state = Z_NULL; + Tracev((stderr, "inflate: end\n")); + return Z_OK; +} + +int ZEXPORT inflateSetDictionary(strm, dictionary, dictLength) +z_streamp strm; +const Bytef *dictionary; +uInt dictLength; +{ + struct inflate_state FAR *state; + unsigned long id; + + /* check state */ + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)strm->state; + if (state->wrap != 0 && state->mode != DICT) + return Z_STREAM_ERROR; + + /* check for correct dictionary id */ + if (state->mode == DICT) { + id = adler32(0L, Z_NULL, 0); + id = adler32(id, dictionary, dictLength); + if (id != state->check) + return Z_DATA_ERROR; + } + + /* copy dictionary to window */ + if (updatewindow(strm, strm->avail_out)) { + state->mode = MEM; + return Z_MEM_ERROR; + } + if (dictLength > state->wsize) { + zmemcpy(state->window, dictionary + dictLength - state->wsize, + state->wsize); + state->whave = state->wsize; + } + else { + zmemcpy(state->window + state->wsize - dictLength, dictionary, + dictLength); + state->whave = dictLength; + } + state->havedict = 1; + Tracev((stderr, "inflate: dictionary set\n")); + return Z_OK; +} + +int ZEXPORT inflateGetHeader(strm, head) +z_streamp strm; +gz_headerp head; +{ + struct inflate_state FAR *state; + + /* check state */ + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)strm->state; + if ((state->wrap & 2) == 0) return Z_STREAM_ERROR; + + /* save header structure */ + state->head = head; + head->done = 0; + return Z_OK; +} + +/* + Search buf[0..len-1] for the pattern: 0, 0, 0xff, 0xff. Return when found + or when out of input. When called, *have is the number of pattern bytes + found in order so far, in 0..3. On return *have is updated to the new + state. If on return *have equals four, then the pattern was found and the + return value is how many bytes were read including the last byte of the + pattern. If *have is less than four, then the pattern has not been found + yet and the return value is len. In the latter case, syncsearch() can be + called again with more data and the *have state. *have is initialized to + zero for the first call. + */ +local unsigned syncsearch(have, buf, len) +unsigned FAR *have; +unsigned char FAR *buf; +unsigned len; +{ + unsigned got; + unsigned next; + + got = *have; + next = 0; + while (next < len && got < 4) { + if ((int)(buf[next]) == (got < 2 ? 0 : 0xff)) + got++; + else if (buf[next]) + got = 0; + else + got = 4 - got; + next++; + } + *have = got; + return next; +} + +int ZEXPORT inflateSync(strm) +z_streamp strm; +{ + unsigned len; /* number of bytes to look at or looked at */ + unsigned long in, out; /* temporary to save total_in and total_out */ + unsigned char buf[4]; /* to restore bit buffer to byte string */ + struct inflate_state FAR *state; + + /* check parameters */ + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)strm->state; + if (strm->avail_in == 0 && state->bits < 8) return Z_BUF_ERROR; + + /* if first time, start search in bit buffer */ + if (state->mode != SYNC) { + state->mode = SYNC; + state->hold <<= state->bits & 7; + state->bits -= state->bits & 7; + len = 0; + while (state->bits >= 8) { + buf[len++] = (unsigned char)(state->hold); + state->hold >>= 8; + state->bits -= 8; + } + state->have = 0; + syncsearch(&(state->have), buf, len); + } + + /* search available input */ + len = syncsearch(&(state->have), strm->next_in, strm->avail_in); + strm->avail_in -= len; + strm->next_in += len; + strm->total_in += len; + + /* return no joy or set up to restart inflate() on a new block */ + if (state->have != 4) return Z_DATA_ERROR; + in = strm->total_in; out = strm->total_out; + inflateReset(strm); + strm->total_in = in; strm->total_out = out; + state->mode = TYPE; + return Z_OK; +} + +/* + Returns true if inflate is currently at the end of a block generated by + Z_SYNC_FLUSH or Z_FULL_FLUSH. This function is used by one PPP + implementation to provide an additional safety check. PPP uses + Z_SYNC_FLUSH but removes the length bytes of the resulting empty stored + block. When decompressing, PPP checks that at the end of input packet, + inflate is waiting for these length bytes. + */ +int ZEXPORT inflateSyncPoint(strm) +z_streamp strm; +{ + struct inflate_state FAR *state; + + if (strm == Z_NULL || strm->state == Z_NULL) return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)strm->state; + return state->mode == STORED && state->bits == 0; +} + +int ZEXPORT inflateCopy(dest, source) +z_streamp dest; +z_streamp source; +{ + struct inflate_state FAR *state; + struct inflate_state FAR *copy; + unsigned char FAR *window; + unsigned wsize; + + /* check input */ + if (dest == Z_NULL || source == Z_NULL || source->state == Z_NULL || + source->zalloc == (alloc_func)0 || source->zfree == (free_func)0) + return Z_STREAM_ERROR; + state = (struct inflate_state FAR *)source->state; + + /* allocate space */ + copy = (struct inflate_state FAR *) + ZALLOC(source, 1, sizeof(struct inflate_state)); + if (copy == Z_NULL) return Z_MEM_ERROR; + window = Z_NULL; + if (state->window != Z_NULL) { + window = (unsigned char FAR *) + ZALLOC(source, 1U << state->wbits, sizeof(unsigned char)); + if (window == Z_NULL) { + ZFREE(source, copy); + return Z_MEM_ERROR; + } + } + + /* copy state */ + zmemcpy(dest, source, sizeof(z_stream)); + zmemcpy(copy, state, sizeof(struct inflate_state)); + if (state->lencode >= state->codes && + state->lencode <= state->codes + ENOUGH - 1) { + copy->lencode = copy->codes + (state->lencode - state->codes); + copy->distcode = copy->codes + (state->distcode - state->codes); + } + copy->next = copy->codes + (state->next - state->codes); + if (window != Z_NULL) { + wsize = 1U << state->wbits; + zmemcpy(window, state->window, wsize); + } + copy->window = window; + dest->state = (struct internal_state FAR *)copy; + return Z_OK; +} diff --git a/erts/emulator/zlib/inflate.h b/erts/emulator/zlib/inflate.h new file mode 100644 index 0000000000..59164091c5 --- /dev/null +++ b/erts/emulator/zlib/inflate.h @@ -0,0 +1,117 @@ +/* inflate.h -- internal inflate state definition + * Copyright (C) 1995-2004 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* WARNING: this file should *not* be used by applications. It is + part of the implementation of the compression library and is + subject to change. Applications should only use zlib.h. + */ + +/* define NO_GZIP when compiling if you want to disable gzip header and + trailer decoding by inflate(). NO_GZIP would be used to avoid linking in + the crc code when it is not needed. For shared libraries, gzip decoding + should be left enabled. */ +#ifndef NO_GZIP +# define GUNZIP +#endif + +/* Possible inflate modes between inflate() calls */ +typedef enum { + HEAD, /* i: waiting for magic header */ + FLAGS, /* i: waiting for method and flags (gzip) */ + TIME, /* i: waiting for modification time (gzip) */ + OS, /* i: waiting for extra flags and operating system (gzip) */ + EXLEN, /* i: waiting for extra length (gzip) */ + EXTRA, /* i: waiting for extra bytes (gzip) */ + NAME, /* i: waiting for end of file name (gzip) */ + COMMENT, /* i: waiting for end of comment (gzip) */ + HCRC, /* i: waiting for header crc (gzip) */ + DICTID, /* i: waiting for dictionary check value */ + DICT, /* waiting for inflateSetDictionary() call */ + TYPE, /* i: waiting for type bits, including last-flag bit */ + TYPEDO, /* i: same, but skip check to exit inflate on new block */ + STORED, /* i: waiting for stored size (length and complement) */ + COPY, /* i/o: waiting for input or output to copy stored block */ + TABLE, /* i: waiting for dynamic block table lengths */ + LENLENS, /* i: waiting for code length code lengths */ + CODELENS, /* i: waiting for length/lit and distance code lengths */ + LEN, /* i: waiting for length/lit code */ + LENEXT, /* i: waiting for length extra bits */ + DIST, /* i: waiting for distance code */ + DISTEXT, /* i: waiting for distance extra bits */ + MATCH, /* o: waiting for output space to copy string */ + LIT, /* o: waiting for output space to write literal */ + CHECK, /* i: waiting for 32-bit check value */ + LENGTH, /* i: waiting for 32-bit length (gzip) */ + DONE, /* finished check, done -- remain here until reset */ + BAD, /* got a data error -- remain here until reset */ + MEM, /* got an inflate() memory error -- remain here until reset */ + SYNC /* looking for synchronization bytes to restart inflate() */ +} inflate_mode; + +/* + State transitions between above modes - + + (most modes can go to the BAD or MEM mode -- not shown for clarity) + + Process header: + HEAD -> (gzip) or (zlib) + (gzip) -> FLAGS -> TIME -> OS -> EXLEN -> EXTRA -> NAME + NAME -> COMMENT -> HCRC -> TYPE + (zlib) -> DICTID or TYPE + DICTID -> DICT -> TYPE + Read deflate blocks: + TYPE -> STORED or TABLE or LEN or CHECK + STORED -> COPY -> TYPE + TABLE -> LENLENS -> CODELENS -> LEN + Read deflate codes: + LEN -> LENEXT or LIT or TYPE + LENEXT -> DIST -> DISTEXT -> MATCH -> LEN + LIT -> LEN + Process trailer: + CHECK -> LENGTH -> DONE + */ + +/* state maintained between inflate() calls. Approximately 7K bytes. */ +struct inflate_state { + inflate_mode mode; /* current inflate mode */ + int last; /* true if processing last block */ + int wrap; /* bit 0 true for zlib, bit 1 true for gzip */ + int havedict; /* true if dictionary provided */ + int flags; /* gzip header method and flags (0 if zlib) */ + unsigned dmax; /* zlib header max distance (INFLATE_STRICT) */ + unsigned long check; /* protected copy of check value */ + unsigned long total; /* protected copy of output count */ + gz_headerp head; /* where to save gzip header information */ + /* sliding window */ + unsigned wbits; /* log base 2 of requested window size */ + unsigned wsize; /* window size or zero if not using window */ + unsigned whave; /* valid bytes in the window */ + unsigned write; /* window write index */ + unsigned char FAR *window; /* allocated sliding window, if needed */ + /* bit accumulator */ + unsigned long hold; /* input bit accumulator */ + unsigned bits; /* number of bits in "in" */ + /* for string and stored block copying */ + unsigned length; /* literal or length of data to copy */ + unsigned offset; /* distance back to copy string from */ + /* for table and code decoding */ + unsigned extra; /* extra bits needed */ + /* fixed and dynamic code tables */ + code const FAR *lencode; /* starting table for length/literal codes */ + code const FAR *distcode; /* starting table for distance codes */ + unsigned lenbits; /* index bits for lencode */ + unsigned distbits; /* index bits for distcode */ + /* dynamic table building */ + unsigned ncode; /* number of code length code lengths */ + unsigned nlen; /* number of length code lengths */ + unsigned ndist; /* number of distance code lengths */ + unsigned have; /* number of code lengths in lens[] */ + code FAR *next; /* next available space in codes[] */ + unsigned short lens[320]; /* temporary storage for code lengths */ + unsigned short work[288]; /* work area for code table building */ + code codes[ENOUGH]; /* space for code tables */ +}; diff --git a/erts/emulator/zlib/inftrees.c b/erts/emulator/zlib/inftrees.c new file mode 100644 index 0000000000..832fe28668 --- /dev/null +++ b/erts/emulator/zlib/inftrees.c @@ -0,0 +1,334 @@ +/* inftrees.c -- generate Huffman trees for efficient decoding + * Copyright (C) 1995-2005 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "zutil.h" +#include "inftrees.h" + +#define MAXBITS 15 + +const char inflate_copyright[] = + " inflate 1.2.3 Copyright 1995-2005 Mark Adler "; +/* + If you use the zlib library in a product, an acknowledgment is welcome + in the documentation of your product. If for some reason you cannot + include such an acknowledgment, I would appreciate that you keep this + copyright string in the executable of your product. + */ + +/* + Build a set of tables to decode the provided canonical Huffman code. + The code lengths are lens[0..codes-1]. The result starts at *table, + whose indices are 0..2^bits-1. work is a writable array of at least + lens shorts, which is used as a work area. type is the type of code + to be generated, CODES, LENS, or DISTS. On return, zero is success, + -1 is an invalid code, and +1 means that ENOUGH isn't enough. table + on return points to the next available entry's address. bits is the + requested root table index bits, and on return it is the actual root + table index bits. It will differ if the request is greater than the + longest code or if it is less than the shortest code. + */ +int inflate_table(type, lens, codes, table, bits, work) +codetype type; +unsigned short FAR *lens; +unsigned codes; +code FAR * FAR *table; +unsigned FAR *bits; +unsigned short FAR *work; +{ + unsigned len; /* a code's length in bits */ + unsigned sym; /* index of code symbols */ + unsigned min, max; /* minimum and maximum code lengths */ + unsigned root; /* number of index bits for root table */ + unsigned curr; /* number of index bits for current table */ + unsigned drop; /* code bits to drop for sub-table */ + int left; /* number of prefix codes available */ + unsigned used; /* code entries in table used */ + unsigned huff; /* Huffman code */ + unsigned incr; /* for incrementing code, index */ + unsigned fill; /* index for replicating entries */ + unsigned low; /* low bits for current root entry */ + unsigned mask; /* mask for low root bits */ + code this; /* table entry for duplication */ + code FAR *next; /* next available space in table */ + const unsigned short FAR *base; /* base value table to use */ + const unsigned short FAR *extra; /* extra bits table to use */ + int end; /* use base and extra for symbol > end */ + unsigned short count[MAXBITS+1]; /* number of codes of each length */ + unsigned short offs[MAXBITS+1]; /* offsets in table for each length */ + static const unsigned short lbase[31] = { /* Length codes 257..285 base */ + 3, 4, 5, 6, 7, 8, 9, 10, 11, 13, 15, 17, 19, 23, 27, 31, + 35, 43, 51, 59, 67, 83, 99, 115, 131, 163, 195, 227, 258, 0, 0}; + static const unsigned short lext[31] = { /* Length codes 257..285 extra */ + 16, 16, 16, 16, 16, 16, 16, 16, 17, 17, 17, 17, 18, 18, 18, 18, + 19, 19, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 16, 201, 196}; + static const unsigned short dbase[32] = { /* Distance codes 0..29 base */ + 1, 2, 3, 4, 5, 7, 9, 13, 17, 25, 33, 49, 65, 97, 129, 193, + 257, 385, 513, 769, 1025, 1537, 2049, 3073, 4097, 6145, + 8193, 12289, 16385, 24577, 0, 0}; + static const unsigned short dext[32] = { /* Distance codes 0..29 extra */ + 16, 16, 16, 16, 17, 17, 18, 18, 19, 19, 20, 20, 21, 21, 22, 22, + 23, 23, 24, 24, 25, 25, 26, 26, 27, 27, + 28, 28, 29, 29, 64, 64}; + + /* + Process a set of code lengths to create a canonical Huffman code. The + code lengths are lens[0..codes-1]. Each length corresponds to the + symbols 0..codes-1. The Huffman code is generated by first sorting the + symbols by length from short to long, and retaining the symbol order + for codes with equal lengths. Then the code starts with all zero bits + for the first code of the shortest length, and the codes are integer + increments for the same length, and zeros are appended as the length + increases. For the deflate format, these bits are stored backwards + from their more natural integer increment ordering, and so when the + decoding tables are built in the large loop below, the integer codes + are incremented backwards. + + This routine assumes, but does not check, that all of the entries in + lens[] are in the range 0..MAXBITS. The caller must assure this. + 1..MAXBITS is interpreted as that code length. zero means that that + symbol does not occur in this code. + + The codes are sorted by computing a count of codes for each length, + creating from that a table of starting indices for each length in the + sorted table, and then entering the symbols in order in the sorted + table. The sorted table is work[], with that space being provided by + the caller. + + The length counts are used for other purposes as well, i.e. finding + the minimum and maximum length codes, determining if there are any + codes at all, checking for a valid set of lengths, and looking ahead + at length counts to determine sub-table sizes when building the + decoding tables. + */ + + /* accumulate lengths for codes (assumes lens[] all in 0..MAXBITS) */ + for (len = 0; len <= MAXBITS; len++) + count[len] = 0; + for (sym = 0; sym < codes; sym++) + count[lens[sym]]++; + + /* bound code lengths, force root to be within code lengths */ + root = *bits; + for (max = MAXBITS; max >= 1; max--) + if (count[max] != 0) break; + if (root > max) root = max; + if (max == 0) { /* no symbols to code at all */ + this.op = (unsigned char)64; /* invalid code marker */ + this.bits = (unsigned char)1; + this.val = (unsigned short)0; + *(*table)++ = this; /* make a table to force an error */ + *(*table)++ = this; + *bits = 1; + return 0; /* no symbols, but wait for decoding to report error */ + } + for (min = 1; min <= MAXBITS; min++) + if (count[min] != 0) break; + if (root < min) root = min; + + /* check for an over-subscribed or incomplete set of lengths */ + left = 1; + for (len = 1; len <= MAXBITS; len++) { + left <<= 1; + left -= count[len]; + if (left < 0) return -1; /* over-subscribed */ + } + if (left > 0 && (type == CODES || max != 1)) + return -1; /* incomplete set */ + + /* generate offsets into symbol table for each length for sorting */ + offs[1] = 0; + for (len = 1; len < MAXBITS; len++) + offs[len + 1] = offs[len] + count[len]; + + /* sort symbols by length, by symbol order within each length */ + for (sym = 0; sym < codes; sym++) + if (lens[sym] != 0) work[offs[lens[sym]]++] = (unsigned short)sym; + + /* + Create and fill in decoding tables. In this loop, the table being + filled is at next and has curr index bits. The code being used is huff + with length len. That code is converted to an index by dropping drop + bits off of the bottom. For codes where len is less than drop + curr, + those top drop + curr - len bits are incremented through all values to + fill the table with replicated entries. + + root is the number of index bits for the root table. When len exceeds + root, sub-tables are created pointed to by the root entry with an index + of the low root bits of huff. This is saved in low to check for when a + new sub-table should be started. drop is zero when the root table is + being filled, and drop is root when sub-tables are being filled. + + When a new sub-table is needed, it is necessary to look ahead in the + code lengths to determine what size sub-table is needed. The length + counts are used for this, and so count[] is decremented as codes are + entered in the tables. + + used keeps track of how many table entries have been allocated from the + provided *table space. It is checked when a LENS table is being made + against the space in *table, ENOUGH, minus the maximum space needed by + the worst case distance code, MAXD. This should never happen, but the + sufficiency of ENOUGH has not been proven exhaustively, hence the check. + This assumes that when type == LENS, bits == 9. + + sym increments through all symbols, and the loop terminates when + all codes of length max, i.e. all codes, have been processed. This + routine permits incomplete codes, so another loop after this one fills + in the rest of the decoding tables with invalid code markers. + */ + + /* set up for code type */ + switch (type) { + case CODES: + base = extra = work; /* dummy value--not used */ + end = 19; + break; + case LENS: + base = lbase; + base -= 257; + extra = lext; + extra -= 257; + end = 256; + break; + default: /* DISTS */ + base = dbase; + extra = dext; + end = -1; + } + + /* initialize state for loop */ + huff = 0; /* starting code */ + sym = 0; /* starting code symbol */ + len = min; /* starting code length */ + next = *table; /* current table to fill in */ + curr = root; /* current table index bits */ + drop = 0; /* current bits to drop from code for index */ + low = (unsigned)(-1); /* trigger new sub-table when len > root */ + used = 1U << root; /* use root table entries */ + mask = used - 1; /* mask for comparing low */ + + /* check available table space */ + if (type == LENS && used >= ENOUGH - MAXD) + return 1; + + /* process all codes and make table entries */ + for (;;) { + /* create table entry */ + this.bits = (unsigned char)(len - drop); + if ((int)(work[sym]) < end) { + this.op = (unsigned char)0; + this.val = work[sym]; + } + else if ((int)(work[sym]) > end) { + this.op = (unsigned char)(extra[work[sym]]); + this.val = base[work[sym]]; + } + else { + this.op = (unsigned char)(32 + 64); /* end of block */ + this.val = 0; + } + + /* replicate for those indices with low len bits equal to huff */ + incr = 1U << (len - drop); + fill = 1U << curr; + min = fill; /* save offset to next table */ + do { + fill -= incr; + next[(huff >> drop) + fill] = this; + } while (fill != 0); + + /* backwards increment the len-bit code huff */ + incr = 1U << (len - 1); + while (huff & incr) + incr >>= 1; + if (incr != 0) { + huff &= incr - 1; + huff += incr; + } + else + huff = 0; + + /* go to next symbol, update count, len */ + sym++; + if (--(count[len]) == 0) { + if (len == max) break; + len = lens[work[sym]]; + } + + /* create new sub-table if needed */ + if (len > root && (huff & mask) != low) { + /* if first time, transition to sub-tables */ + if (drop == 0) + drop = root; + + /* increment past last table */ + next += min; /* here min is 1 << curr */ + + /* determine length of next table */ + curr = len - drop; + left = (int)(1 << curr); + while (curr + drop < max) { + left -= count[curr + drop]; + if (left <= 0) break; + curr++; + left <<= 1; + } + + /* check for enough space */ + used += 1U << curr; + if (type == LENS && used >= ENOUGH - MAXD) + return 1; + + /* point entry in root table to sub-table */ + low = huff & mask; + (*table)[low].op = (unsigned char)curr; + (*table)[low].bits = (unsigned char)root; + (*table)[low].val = (unsigned short)(next - *table); + } + } + + /* + Fill in rest of table for incomplete codes. This loop is similar to the + loop above in incrementing huff for table indices. It is assumed that + len is equal to curr + drop, so there is no loop needed to increment + through high index bits. When the current sub-table is filled, the loop + drops back to the root table to fill in any remaining entries there. + */ + this.op = (unsigned char)64; /* invalid code marker */ + this.bits = (unsigned char)(len - drop); + this.val = (unsigned short)0; + while (huff != 0) { + /* when done with sub-table, drop back to root table */ + if (drop != 0 && (huff & mask) != low) { + drop = 0; + len = root; + next = *table; + this.bits = (unsigned char)len; + } + + /* put invalid code marker in table */ + next[huff >> drop] = this; + + /* backwards increment the len-bit code huff */ + incr = 1U << (len - 1); + while (huff & incr) + incr >>= 1; + if (incr != 0) { + huff &= incr - 1; + huff += incr; + } + else + huff = 0; + } + + /* set return parameters */ + *table += used; + *bits = root; + return 0; +} diff --git a/erts/emulator/zlib/inftrees.h b/erts/emulator/zlib/inftrees.h new file mode 100644 index 0000000000..808100f70a --- /dev/null +++ b/erts/emulator/zlib/inftrees.h @@ -0,0 +1,57 @@ +/* inftrees.h -- header to use inftrees.c + * Copyright (C) 1995-2005 Mark Adler + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* WARNING: this file should *not* be used by applications. It is + part of the implementation of the compression library and is + subject to change. Applications should only use zlib.h. + */ + +/* Structure for decoding tables. Each entry provides either the + information needed to do the operation requested by the code that + indexed that table entry, or it provides a pointer to another + table that indexes more bits of the code. op indicates whether + the entry is a pointer to another table, a literal, a length or + distance, an end-of-block, or an invalid code. For a table + pointer, the low four bits of op is the number of index bits of + that table. For a length or distance, the low four bits of op + is the number of extra bits to get after the code. bits is + the number of bits in this code or part of the code to drop off + of the bit buffer. val is the actual byte to output in the case + of a literal, the base length or distance, or the offset from + the current table to the next table. Each entry is four bytes. */ +typedef struct { + unsigned char op; /* operation, extra bits, table bits */ + unsigned char bits; /* bits in this part of the code */ + unsigned short val; /* offset in table or code value */ +} code; + +/* op values as set by inflate_table(): + 00000000 - literal + 0000tttt - table link, tttt != 0 is the number of table index bits + 0001eeee - length or distance, eeee is the number of extra bits + 01100000 - end of block + 01000000 - invalid code + */ + +/* Maximum size of dynamic tree. The maximum found in a long but non- + exhaustive search was 1444 code structures (852 for length/literals + and 592 for distances, the latter actually the result of an + exhaustive search). The true maximum is not known, but the value + below is more than safe. */ +#define ENOUGH 2048 +#define MAXD 592 + +/* Type of code to build for inftable() */ +typedef enum { + CODES, + LENS, + DISTS +} codetype; + +extern int inflate_table OF((codetype type, unsigned short FAR *lens, + unsigned codes, code FAR * FAR *table, + unsigned FAR *bits, unsigned short FAR *work)); diff --git a/erts/emulator/zlib/trees.c b/erts/emulator/zlib/trees.c new file mode 100644 index 0000000000..7d9f77f451 --- /dev/null +++ b/erts/emulator/zlib/trees.c @@ -0,0 +1,1224 @@ +/* trees.c -- output deflated data using Huffman coding + * Copyright (C) 1995-2005 Jean-loup Gailly + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* + * ALGORITHM + * + * The "deflation" process uses several Huffman trees. The more + * common source values are represented by shorter bit sequences. + * + * Each code tree is stored in a compressed form which is itself + * a Huffman encoding of the lengths of all the code strings (in + * ascending order by source values). The actual code strings are + * reconstructed from the lengths in the inflate process, as described + * in the deflate specification. + * + * REFERENCES + * + * Deutsch, L.P.,"'Deflate' Compressed Data Format Specification". + * Available in ftp.uu.net:/pub/archiving/zip/doc/deflate-1.1.doc + * + * Storer, James A. + * Data Compression: Methods and Theory, pp. 49-50. + * Computer Science Press, 1988. ISBN 0-7167-8156-5. + * + * Sedgewick, R. + * Algorithms, p290. + * Addison-Wesley, 1983. ISBN 0-201-06672-6. + */ + +/* @(#) $Id$ */ + +/* #define GEN_TREES_H */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "deflate.h" + +#ifdef DEBUG +# include +#endif + +/* =========================================================================== + * Constants + */ + +#define MAX_BL_BITS 7 +/* Bit length codes must not exceed MAX_BL_BITS bits */ + +#define END_BLOCK 256 +/* end of block literal code */ + +#define REP_3_6 16 +/* repeat previous bit length 3-6 times (2 bits of repeat count) */ + +#define REPZ_3_10 17 +/* repeat a zero length 3-10 times (3 bits of repeat count) */ + +#define REPZ_11_138 18 +/* repeat a zero length 11-138 times (7 bits of repeat count) */ + +local const int extra_lbits[LENGTH_CODES] /* extra bits for each length code */ + = {0,0,0,0,0,0,0,0,1,1,1,1,2,2,2,2,3,3,3,3,4,4,4,4,5,5,5,5,0}; + +local const int extra_dbits[D_CODES] /* extra bits for each distance code */ + = {0,0,0,0,1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8,9,9,10,10,11,11,12,12,13,13}; + +local const int extra_blbits[BL_CODES]/* extra bits for each bit length code */ + = {0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,3,7}; + +local const uch bl_order[BL_CODES] + = {16,17,18,0,8,7,9,6,10,5,11,4,12,3,13,2,14,1,15}; +/* The lengths of the bit length codes are sent in order of decreasing + * probability, to avoid transmitting the lengths for unused bit length codes. + */ + +#define Buf_size (8 * 2*sizeof(char)) +/* Number of bits used within bi_buf. (bi_buf might be implemented on + * more than 16 bits on some systems.) + */ + +/* =========================================================================== + * Local data. These are initialized only once. + */ + +#define DIST_CODE_LEN 512 /* see definition of array dist_code below */ + +#if defined(GEN_TREES_H) || !defined(STDC) +/* non ANSI compilers may not accept trees.h */ + +local ct_data static_ltree[L_CODES+2]; +/* The static literal tree. Since the bit lengths are imposed, there is no + * need for the L_CODES extra codes used during heap construction. However + * The codes 286 and 287 are needed to build a canonical tree (see _tr_init + * below). + */ + +local ct_data static_dtree[D_CODES]; +/* The static distance tree. (Actually a trivial tree since all codes use + * 5 bits.) + */ + +uch _dist_code[DIST_CODE_LEN]; +/* Distance codes. The first 256 values correspond to the distances + * 3 .. 258, the last 256 values correspond to the top 8 bits of + * the 15 bit distances. + */ + +uch _length_code[MAX_MATCH-MIN_MATCH+1]; +/* length code for each normalized match length (0 == MIN_MATCH) */ + +local int base_length[LENGTH_CODES]; +/* First normalized length for each code (0 = MIN_MATCH) */ + +local int base_dist[D_CODES]; +/* First normalized distance for each code (0 = distance of 1) */ + +#else +# include "trees.h" +#endif /* GEN_TREES_H */ + +struct static_tree_desc_s { + const ct_data *static_tree; /* static tree or NULL */ + const intf *extra_bits; /* extra bits for each code or NULL */ + int extra_base; /* base index for extra_bits */ + int elems; /* max number of elements in the tree */ + int max_length; /* max bit length for the codes */ +}; + +local static_tree_desc static_l_desc = +{static_ltree, extra_lbits, LITERALS+1, L_CODES, MAX_BITS}; + +local static_tree_desc static_d_desc = +{static_dtree, extra_dbits, 0, D_CODES, MAX_BITS}; + +local static_tree_desc static_bl_desc = +{(const ct_data *)0, extra_blbits, 0, BL_CODES, MAX_BL_BITS}; + +/* =========================================================================== + * Local (static) routines in this file. + */ + +local void tr_static_init OF((void)); +local void init_block OF((deflate_state *s)); +local void pqdownheap OF((deflate_state *s, ct_data *tree, int k)); +local void gen_bitlen OF((deflate_state *s, tree_desc *desc)); +local void gen_codes OF((ct_data *tree, int max_code, ushf *bl_count)); +local void build_tree OF((deflate_state *s, tree_desc *desc)); +local void scan_tree OF((deflate_state *s, ct_data *tree, int max_code)); +local void send_tree OF((deflate_state *s, ct_data *tree, int max_code)); +local int build_bl_tree OF((deflate_state *s)); +local void send_all_trees OF((deflate_state *s, int lcodes, int dcodes, + int blcodes)); +local void compress_block OF((deflate_state *s, ct_data *ltree, + ct_data *dtree)); +local void set_data_type OF((deflate_state *s)); +local unsigned bi_reverse OF((unsigned value, int length)); +local void bi_windup OF((deflate_state *s)); +local void bi_flush OF((deflate_state *s)); +local void copy_block OF((deflate_state *s, charf *buf, unsigned len, + int header)); + +#ifdef GEN_TREES_H +local void gen_trees_header OF((void)); +#endif + +#ifndef DEBUG +# define send_code(s, c, tree) send_bits(s, tree[c].Code, tree[c].Len) + /* Send a code of the given tree. c and tree must not have side effects */ + +#else /* DEBUG */ +# define send_code(s, c, tree) \ + { if (z_verbose>2) fprintf(stderr,"\ncd %3d ",(c)); \ + send_bits(s, tree[c].Code, tree[c].Len); } +#endif + +/* =========================================================================== + * Output a short LSB first on the stream. + * IN assertion: there is enough room in pendingBuf. + */ +#define put_short(s, w) { \ + put_byte(s, (uch)((w) & 0xff)); \ + put_byte(s, (uch)((ush)(w) >> 8)); \ +} + +/* =========================================================================== + * Send a value on a given number of bits. + * IN assertion: length <= 16 and value fits in length bits. + */ +#ifdef DEBUG +local void send_bits OF((deflate_state *s, int value, int length)); + +local void send_bits(s, value, length) + deflate_state *s; + int value; /* value to send */ + int length; /* number of bits */ +{ + Tracevv((stderr," l %2d v %4x ", length, value)); + Assert(length > 0 && length <= 15, "invalid length"); + s->bits_sent += (ulg)length; + + /* If not enough room in bi_buf, use (valid) bits from bi_buf and + * (16 - bi_valid) bits from value, leaving (width - (16-bi_valid)) + * unused bits in value. + */ + if (s->bi_valid > (int)Buf_size - length) { + s->bi_buf |= (value << s->bi_valid); + put_short(s, s->bi_buf); + s->bi_buf = (ush)value >> (Buf_size - s->bi_valid); + s->bi_valid += length - Buf_size; + } else { + s->bi_buf |= value << s->bi_valid; + s->bi_valid += length; + } +} +#else /* !DEBUG */ + +#define send_bits(s, value, length) \ +{ int len = length;\ + if (s->bi_valid > (int)Buf_size - len) {\ + int val = value;\ + s->bi_buf |= (val << s->bi_valid);\ + put_short(s, s->bi_buf);\ + s->bi_buf = (ush)val >> (Buf_size - s->bi_valid);\ + s->bi_valid += len - Buf_size;\ + } else {\ + s->bi_buf |= (value) << s->bi_valid;\ + s->bi_valid += len;\ + }\ +} +#endif /* DEBUG */ + + +/* the arguments must not have side effects */ + +/* =========================================================================== + * Initialize the various 'constant' tables. + */ +local void tr_static_init() +{ +#if defined(GEN_TREES_H) || !defined(STDC) + static int static_init_done = 0; + int n; /* iterates over tree elements */ + int bits; /* bit counter */ + int length; /* length value */ + int code; /* code value */ + int dist; /* distance index */ + ush bl_count[MAX_BITS+1]; + /* number of codes at each bit length for an optimal tree */ + + if (static_init_done) return; + + /* For some embedded targets, global variables are not initialized: */ + static_l_desc.static_tree = static_ltree; + static_l_desc.extra_bits = extra_lbits; + static_d_desc.static_tree = static_dtree; + static_d_desc.extra_bits = extra_dbits; + static_bl_desc.extra_bits = extra_blbits; + + /* Initialize the mapping length (0..255) -> length code (0..28) */ + length = 0; + for (code = 0; code < LENGTH_CODES-1; code++) { + base_length[code] = length; + for (n = 0; n < (1< dist code (0..29) */ + dist = 0; + for (code = 0 ; code < 16; code++) { + base_dist[code] = dist; + for (n = 0; n < (1<>= 7; /* from now on, all distances are divided by 128 */ + for ( ; code < D_CODES; code++) { + base_dist[code] = dist << 7; + for (n = 0; n < (1<<(extra_dbits[code]-7)); n++) { + _dist_code[256 + dist++] = (uch)code; + } + } + Assert (dist == 256, "tr_static_init: 256+dist != 512"); + + /* Construct the codes of the static literal tree */ + for (bits = 0; bits <= MAX_BITS; bits++) bl_count[bits] = 0; + n = 0; + while (n <= 143) static_ltree[n++].Len = 8, bl_count[8]++; + while (n <= 255) static_ltree[n++].Len = 9, bl_count[9]++; + while (n <= 279) static_ltree[n++].Len = 7, bl_count[7]++; + while (n <= 287) static_ltree[n++].Len = 8, bl_count[8]++; + /* Codes 286 and 287 do not exist, but we must include them in the + * tree construction to get a canonical Huffman tree (longest code + * all ones) + */ + gen_codes((ct_data *)static_ltree, L_CODES+1, bl_count); + + /* The static distance tree is trivial: */ + for (n = 0; n < D_CODES; n++) { + static_dtree[n].Len = 5; + static_dtree[n].Code = bi_reverse((unsigned)n, 5); + } + static_init_done = 1; + +# ifdef GEN_TREES_H + gen_trees_header(); +# endif +#endif /* defined(GEN_TREES_H) || !defined(STDC) */ +} + +/* =========================================================================== + * Genererate the file trees.h describing the static trees. + */ +#ifdef GEN_TREES_H +# ifndef DEBUG +# include +# endif + +# define SEPARATOR(i, last, width) \ + ((i) == (last)? "\n};\n\n" : \ + ((i) % (width) == (width)-1 ? ",\n" : ", ")) + +void gen_trees_header() +{ + FILE *header = fopen("trees.h", "w"); + int i; + + Assert (header != NULL, "Can't open trees.h"); + fprintf(header, + "/* header created automatically with -DGEN_TREES_H */\n\n"); + + fprintf(header, "local const ct_data static_ltree[L_CODES+2] = {\n"); + for (i = 0; i < L_CODES+2; i++) { + fprintf(header, "{{%3u},{%3u}}%s", static_ltree[i].Code, + static_ltree[i].Len, SEPARATOR(i, L_CODES+1, 5)); + } + + fprintf(header, "local const ct_data static_dtree[D_CODES] = {\n"); + for (i = 0; i < D_CODES; i++) { + fprintf(header, "{{%2u},{%2u}}%s", static_dtree[i].Code, + static_dtree[i].Len, SEPARATOR(i, D_CODES-1, 5)); + } + + fprintf(header, "const uch _dist_code[DIST_CODE_LEN] = {\n"); + for (i = 0; i < DIST_CODE_LEN; i++) { + fprintf(header, "%2u%s", _dist_code[i], + SEPARATOR(i, DIST_CODE_LEN-1, 20)); + } + + fprintf(header, "const uch _length_code[MAX_MATCH-MIN_MATCH+1]= {\n"); + for (i = 0; i < MAX_MATCH-MIN_MATCH+1; i++) { + fprintf(header, "%2u%s", _length_code[i], + SEPARATOR(i, MAX_MATCH-MIN_MATCH, 20)); + } + + fprintf(header, "local const int base_length[LENGTH_CODES] = {\n"); + for (i = 0; i < LENGTH_CODES; i++) { + fprintf(header, "%1u%s", base_length[i], + SEPARATOR(i, LENGTH_CODES-1, 20)); + } + + fprintf(header, "local const int base_dist[D_CODES] = {\n"); + for (i = 0; i < D_CODES; i++) { + fprintf(header, "%5u%s", base_dist[i], + SEPARATOR(i, D_CODES-1, 10)); + } + + fclose(header); +} +#endif /* GEN_TREES_H */ + +/* =========================================================================== + * Initialize the tree data structures for a new zlib stream. + */ +void _tr_init(s) + deflate_state *s; +{ + tr_static_init(); + + s->l_desc.dyn_tree = s->dyn_ltree; + s->l_desc.stat_desc = &static_l_desc; + + s->d_desc.dyn_tree = s->dyn_dtree; + s->d_desc.stat_desc = &static_d_desc; + + s->bl_desc.dyn_tree = s->bl_tree; + s->bl_desc.stat_desc = &static_bl_desc; + + s->bi_buf = 0; + s->bi_valid = 0; + s->last_eob_len = 8; /* enough lookahead for inflate */ +#ifdef DEBUG + s->compressed_len = 0L; + s->bits_sent = 0L; +#endif + + /* Initialize the first block of the first file: */ + init_block(s); +} + +/* =========================================================================== + * Initialize a new block. + */ +local void init_block(s) + deflate_state *s; +{ + int n; /* iterates over tree elements */ + + /* Initialize the trees. */ + for (n = 0; n < L_CODES; n++) s->dyn_ltree[n].Freq = 0; + for (n = 0; n < D_CODES; n++) s->dyn_dtree[n].Freq = 0; + for (n = 0; n < BL_CODES; n++) s->bl_tree[n].Freq = 0; + + s->dyn_ltree[END_BLOCK].Freq = 1; + s->opt_len = s->static_len = 0L; + s->last_lit = s->matches = 0; +} + +#define SMALLEST 1 +/* Index within the heap array of least frequent node in the Huffman tree */ + + +/* =========================================================================== + * Remove the smallest element from the heap and recreate the heap with + * one less element. Updates heap and heap_len. + */ +#define pqremove(s, tree, top) \ +{\ + top = s->heap[SMALLEST]; \ + s->heap[SMALLEST] = s->heap[s->heap_len--]; \ + pqdownheap(s, tree, SMALLEST); \ +} + +/* =========================================================================== + * Compares to subtrees, using the tree depth as tie breaker when + * the subtrees have equal frequency. This minimizes the worst case length. + */ +#define smaller(tree, n, m, depth) \ + (tree[n].Freq < tree[m].Freq || \ + (tree[n].Freq == tree[m].Freq && depth[n] <= depth[m])) + +/* =========================================================================== + * Restore the heap property by moving down the tree starting at node k, + * exchanging a node with the smallest of its two sons if necessary, stopping + * when the heap property is re-established (each father smaller than its + * two sons). + */ +local void pqdownheap(s, tree, k) + deflate_state *s; + ct_data *tree; /* the tree to restore */ + int k; /* node to move down */ +{ + int v = s->heap[k]; + int j = k << 1; /* left son of k */ + while (j <= s->heap_len) { + /* Set j to the smallest of the two sons: */ + if (j < s->heap_len && + smaller(tree, s->heap[j+1], s->heap[j], s->depth)) { + j++; + } + /* Exit if v is smaller than both sons */ + if (smaller(tree, v, s->heap[j], s->depth)) break; + + /* Exchange v with the smallest son */ + s->heap[k] = s->heap[j]; k = j; + + /* And continue down the tree, setting j to the left son of k */ + j <<= 1; + } + s->heap[k] = v; +} + +/* =========================================================================== + * Compute the optimal bit lengths for a tree and update the total bit length + * for the current block. + * IN assertion: the fields freq and dad are set, heap[heap_max] and + * above are the tree nodes sorted by increasing frequency. + * OUT assertions: the field len is set to the optimal bit length, the + * array bl_count contains the frequencies for each bit length. + * The length opt_len is updated; static_len is also updated if stree is + * not null. + */ +local void gen_bitlen(s, desc) + deflate_state *s; + tree_desc *desc; /* the tree descriptor */ +{ + ct_data *tree = desc->dyn_tree; + int max_code = desc->max_code; + const ct_data *stree = desc->stat_desc->static_tree; + const intf *extra = desc->stat_desc->extra_bits; + int base = desc->stat_desc->extra_base; + int max_length = desc->stat_desc->max_length; + int h; /* heap index */ + int n, m; /* iterate over the tree elements */ + int bits; /* bit length */ + int xbits; /* extra bits */ + ush f; /* frequency */ + int overflow = 0; /* number of elements with bit length too large */ + + for (bits = 0; bits <= MAX_BITS; bits++) s->bl_count[bits] = 0; + + /* In a first pass, compute the optimal bit lengths (which may + * overflow in the case of the bit length tree). + */ + tree[s->heap[s->heap_max]].Len = 0; /* root of the heap */ + + for (h = s->heap_max+1; h < HEAP_SIZE; h++) { + n = s->heap[h]; + bits = tree[tree[n].Dad].Len + 1; + if (bits > max_length) bits = max_length, overflow++; + tree[n].Len = (ush)bits; + /* We overwrite tree[n].Dad which is no longer needed */ + + if (n > max_code) continue; /* not a leaf node */ + + s->bl_count[bits]++; + xbits = 0; + if (n >= base) xbits = extra[n-base]; + f = tree[n].Freq; + s->opt_len += (ulg)f * (bits + xbits); + if (stree) s->static_len += (ulg)f * (stree[n].Len + xbits); + } + if (overflow == 0) return; + + Trace((stderr,"\nbit length overflow\n")); + /* This happens for example on obj2 and pic of the Calgary corpus */ + + /* Find the first bit length which could increase: */ + do { + bits = max_length-1; + while (s->bl_count[bits] == 0) bits--; + s->bl_count[bits]--; /* move one leaf down the tree */ + s->bl_count[bits+1] += 2; /* move one overflow item as its brother */ + s->bl_count[max_length]--; + /* The brother of the overflow item also moves one step up, + * but this does not affect bl_count[max_length] + */ + overflow -= 2; + } while (overflow > 0); + + /* Now recompute all bit lengths, scanning in increasing frequency. + * h is still equal to HEAP_SIZE. (It is simpler to reconstruct all + * lengths instead of fixing only the wrong ones. This idea is taken + * from 'ar' written by Haruhiko Okumura.) + */ + for (bits = max_length; bits != 0; bits--) { + n = s->bl_count[bits]; + while (n != 0) { + m = s->heap[--h]; + if (m > max_code) continue; + if ((unsigned) tree[m].Len != (unsigned) bits) { + Trace((stderr,"code %d bits %d->%d\n", m, tree[m].Len, bits)); + s->opt_len += ((long)bits - (long)tree[m].Len) + *(long)tree[m].Freq; + tree[m].Len = (ush)bits; + } + n--; + } + } +} + +/* =========================================================================== + * Generate the codes for a given tree and bit counts (which need not be + * optimal). + * IN assertion: the array bl_count contains the bit length statistics for + * the given tree and the field len is set for all tree elements. + * OUT assertion: the field code is set for all tree elements of non + * zero code length. + */ +local void gen_codes (tree, max_code, bl_count) + ct_data *tree; /* the tree to decorate */ + int max_code; /* largest code with non zero frequency */ + ushf *bl_count; /* number of codes at each bit length */ +{ + ush next_code[MAX_BITS+1]; /* next code value for each bit length */ + ush code = 0; /* running code value */ + int bits; /* bit index */ + int n; /* code index */ + + /* The distribution counts are first used to generate the code values + * without bit reversal. + */ + for (bits = 1; bits <= MAX_BITS; bits++) { + next_code[bits] = code = (code + bl_count[bits-1]) << 1; + } + /* Check that the bit counts in bl_count are consistent. The last code + * must be all ones. + */ + Assert (code + bl_count[MAX_BITS]-1 == (1<dyn_tree; + const ct_data *stree = desc->stat_desc->static_tree; + int elems = desc->stat_desc->elems; + int n, m; /* iterate over heap elements */ + int max_code = -1; /* largest code with non zero frequency */ + int node; /* new node being created */ + + /* Construct the initial heap, with least frequent element in + * heap[SMALLEST]. The sons of heap[n] are heap[2*n] and heap[2*n+1]. + * heap[0] is not used. + */ + s->heap_len = 0, s->heap_max = HEAP_SIZE; + + for (n = 0; n < elems; n++) { + if (tree[n].Freq != 0) { + s->heap[++(s->heap_len)] = max_code = n; + s->depth[n] = 0; + } else { + tree[n].Len = 0; + } + } + + /* The pkzip format requires that at least one distance code exists, + * and that at least one bit should be sent even if there is only one + * possible code. So to avoid special checks later on we force at least + * two codes of non zero frequency. + */ + while (s->heap_len < 2) { + node = s->heap[++(s->heap_len)] = (max_code < 2 ? ++max_code : 0); + tree[node].Freq = 1; + s->depth[node] = 0; + s->opt_len--; if (stree) s->static_len -= stree[node].Len; + /* node is 0 or 1 so it does not have extra bits */ + } + desc->max_code = max_code; + + /* The elements heap[heap_len/2+1 .. heap_len] are leaves of the tree, + * establish sub-heaps of increasing lengths: + */ + for (n = s->heap_len/2; n >= 1; n--) pqdownheap(s, tree, n); + + /* Construct the Huffman tree by repeatedly combining the least two + * frequent nodes. + */ + node = elems; /* next internal node of the tree */ + do { + pqremove(s, tree, n); /* n = node of least frequency */ + m = s->heap[SMALLEST]; /* m = node of next least frequency */ + + s->heap[--(s->heap_max)] = n; /* keep the nodes sorted by frequency */ + s->heap[--(s->heap_max)] = m; + + /* Create a new node father of n and m */ + tree[node].Freq = tree[n].Freq + tree[m].Freq; + s->depth[node] = (uch)((s->depth[n] >= s->depth[m] ? + s->depth[n] : s->depth[m]) + 1); + tree[n].Dad = tree[m].Dad = (ush)node; +#ifdef DUMP_BL_TREE + if (tree == s->bl_tree) { + fprintf(stderr,"\nnode %d(%d), sons %d(%d) %d(%d)", + node, tree[node].Freq, n, tree[n].Freq, m, tree[m].Freq); + } +#endif + /* and insert the new node in the heap */ + s->heap[SMALLEST] = node++; + pqdownheap(s, tree, SMALLEST); + + } while (s->heap_len >= 2); + + s->heap[--(s->heap_max)] = s->heap[SMALLEST]; + + /* At this point, the fields freq and dad are set. We can now + * generate the bit lengths. + */ + gen_bitlen(s, (tree_desc *)desc); + + /* The field len is now set, we can generate the bit codes */ + gen_codes ((ct_data *)tree, max_code, s->bl_count); +} + +/* =========================================================================== + * Scan a literal or distance tree to determine the frequencies of the codes + * in the bit length tree. + */ +local void scan_tree (s, tree, max_code) + deflate_state *s; + ct_data *tree; /* the tree to be scanned */ + int max_code; /* and its largest code of non zero frequency */ +{ + int n; /* iterates over all tree elements */ + int prevlen = -1; /* last emitted length */ + int curlen; /* length of current code */ + int nextlen = tree[0].Len; /* length of next code */ + int count = 0; /* repeat count of the current code */ + int max_count = 7; /* max repeat count */ + int min_count = 4; /* min repeat count */ + + if (nextlen == 0) max_count = 138, min_count = 3; + tree[max_code+1].Len = (ush)0xffff; /* guard */ + + for (n = 0; n <= max_code; n++) { + curlen = nextlen; nextlen = tree[n+1].Len; + if (++count < max_count && curlen == nextlen) { + continue; + } else if (count < min_count) { + s->bl_tree[curlen].Freq += count; + } else if (curlen != 0) { + if (curlen != prevlen) s->bl_tree[curlen].Freq++; + s->bl_tree[REP_3_6].Freq++; + } else if (count <= 10) { + s->bl_tree[REPZ_3_10].Freq++; + } else { + s->bl_tree[REPZ_11_138].Freq++; + } + count = 0; prevlen = curlen; + if (nextlen == 0) { + max_count = 138, min_count = 3; + } else if (curlen == nextlen) { + max_count = 6, min_count = 3; + } else { + max_count = 7, min_count = 4; + } + } +} + +/* =========================================================================== + * Send a literal or distance tree in compressed form, using the codes in + * bl_tree. + */ +local void send_tree (s, tree, max_code) + deflate_state *s; + ct_data *tree; /* the tree to be scanned */ + int max_code; /* and its largest code of non zero frequency */ +{ + int n; /* iterates over all tree elements */ + int prevlen = -1; /* last emitted length */ + int curlen; /* length of current code */ + int nextlen = tree[0].Len; /* length of next code */ + int count = 0; /* repeat count of the current code */ + int max_count = 7; /* max repeat count */ + int min_count = 4; /* min repeat count */ + + /* tree[max_code+1].Len = -1; */ /* guard already set */ + if (nextlen == 0) max_count = 138, min_count = 3; + + for (n = 0; n <= max_code; n++) { + curlen = nextlen; nextlen = tree[n+1].Len; + if (++count < max_count && curlen == nextlen) { + continue; + } else if (count < min_count) { + do { send_code(s, curlen, s->bl_tree); } while (--count != 0); + + } else if (curlen != 0) { + if (curlen != prevlen) { + send_code(s, curlen, s->bl_tree); count--; + } + Assert(count >= 3 && count <= 6, " 3_6?"); + send_code(s, REP_3_6, s->bl_tree); send_bits(s, count-3, 2); + + } else if (count <= 10) { + send_code(s, REPZ_3_10, s->bl_tree); send_bits(s, count-3, 3); + + } else { + send_code(s, REPZ_11_138, s->bl_tree); send_bits(s, count-11, 7); + } + count = 0; prevlen = curlen; + if (nextlen == 0) { + max_count = 138, min_count = 3; + } else if (curlen == nextlen) { + max_count = 6, min_count = 3; + } else { + max_count = 7, min_count = 4; + } + } +} + +/* =========================================================================== + * Construct the Huffman tree for the bit lengths and return the index in + * bl_order of the last bit length code to send. + */ +local int build_bl_tree(s) + deflate_state *s; +{ + int max_blindex; /* index of last bit length code of non zero freq */ + + /* Determine the bit length frequencies for literal and distance trees */ + scan_tree(s, (ct_data *)s->dyn_ltree, s->l_desc.max_code); + scan_tree(s, (ct_data *)s->dyn_dtree, s->d_desc.max_code); + + /* Build the bit length tree: */ + build_tree(s, (tree_desc *)(&(s->bl_desc))); + /* opt_len now includes the length of the tree representations, except + * the lengths of the bit lengths codes and the 5+5+4 bits for the counts. + */ + + /* Determine the number of bit length codes to send. The pkzip format + * requires that at least 4 bit length codes be sent. (appnote.txt says + * 3 but the actual value used is 4.) + */ + for (max_blindex = BL_CODES-1; max_blindex >= 3; max_blindex--) { + if (s->bl_tree[bl_order[max_blindex]].Len != 0) break; + } + /* Update opt_len to include the bit length tree and counts */ + s->opt_len += 3*(max_blindex+1) + 5+5+4; + Tracev((stderr, "\ndyn trees: dyn %ld, stat %ld", + s->opt_len, s->static_len)); + + return max_blindex; +} + +/* =========================================================================== + * Send the header for a block using dynamic Huffman trees: the counts, the + * lengths of the bit length codes, the literal tree and the distance tree. + * IN assertion: lcodes >= 257, dcodes >= 1, blcodes >= 4. + */ +local void send_all_trees(s, lcodes, dcodes, blcodes) + deflate_state *s; + int lcodes, dcodes, blcodes; /* number of codes for each tree */ +{ + int rank; /* index in bl_order */ + + Assert (lcodes >= 257 && dcodes >= 1 && blcodes >= 4, "not enough codes"); + Assert (lcodes <= L_CODES && dcodes <= D_CODES && blcodes <= BL_CODES, + "too many codes"); + Tracev((stderr, "\nbl counts: ")); + send_bits(s, lcodes-257, 5); /* not +255 as stated in appnote.txt */ + send_bits(s, dcodes-1, 5); + send_bits(s, blcodes-4, 4); /* not -3 as stated in appnote.txt */ + for (rank = 0; rank < blcodes; rank++) { + Tracev((stderr, "\nbl code %2d ", bl_order[rank])); + send_bits(s, s->bl_tree[bl_order[rank]].Len, 3); + } + Tracev((stderr, "\nbl tree: sent %ld", s->bits_sent)); + + send_tree(s, (ct_data *)s->dyn_ltree, lcodes-1); /* literal tree */ + Tracev((stderr, "\nlit tree: sent %ld", s->bits_sent)); + + send_tree(s, (ct_data *)s->dyn_dtree, dcodes-1); /* distance tree */ + Tracev((stderr, "\ndist tree: sent %ld", s->bits_sent)); +} + +/* =========================================================================== + * Send a stored block + */ +void _tr_stored_block(s, buf, stored_len, eof) + deflate_state *s; + charf *buf; /* input block */ + ulg stored_len; /* length of input block */ + int eof; /* true if this is the last block for a file */ +{ + send_bits(s, (STORED_BLOCK<<1)+eof, 3); /* send block type */ +#ifdef DEBUG + s->compressed_len = (s->compressed_len + 3 + 7) & (ulg)~7L; + s->compressed_len += (stored_len + 4) << 3; +#endif + copy_block(s, buf, (unsigned)stored_len, 1); /* with header */ +} + +/* =========================================================================== + * Send one empty static block to give enough lookahead for inflate. + * This takes 10 bits, of which 7 may remain in the bit buffer. + * The current inflate code requires 9 bits of lookahead. If the + * last two codes for the previous block (real code plus EOB) were coded + * on 5 bits or less, inflate may have only 5+3 bits of lookahead to decode + * the last real code. In this case we send two empty static blocks instead + * of one. (There are no problems if the previous block is stored or fixed.) + * To simplify the code, we assume the worst case of last real code encoded + * on one bit only. + */ +void _tr_align(s) + deflate_state *s; +{ + send_bits(s, STATIC_TREES<<1, 3); + send_code(s, END_BLOCK, static_ltree); +#ifdef DEBUG + s->compressed_len += 10L; /* 3 for block type, 7 for EOB */ +#endif + bi_flush(s); + /* Of the 10 bits for the empty block, we have already sent + * (10 - bi_valid) bits. The lookahead for the last real code (before + * the EOB of the previous block) was thus at least one plus the length + * of the EOB plus what we have just sent of the empty static block. + */ + if (1 + s->last_eob_len + 10 - s->bi_valid < 9) { + send_bits(s, STATIC_TREES<<1, 3); + send_code(s, END_BLOCK, static_ltree); +#ifdef DEBUG + s->compressed_len += 10L; +#endif + bi_flush(s); + } + s->last_eob_len = 7; +} + +/* =========================================================================== + * Determine the best encoding for the current block: dynamic trees, static + * trees or store, and output the encoded block to the zip file. + */ +void _tr_flush_block(s, buf, stored_len, eof) + deflate_state *s; + charf *buf; /* input block, or NULL if too old */ + ulg stored_len; /* length of input block */ + int eof; /* true if this is the last block for a file */ +{ + ulg opt_lenb, static_lenb; /* opt_len and static_len in bytes */ + int max_blindex = 0; /* index of last bit length code of non zero freq */ + + /* Build the Huffman trees unless a stored block is forced */ + if (s->level > 0) { + + /* Check if the file is binary or text */ + if (stored_len > 0 && s->strm->data_type == Z_UNKNOWN) + set_data_type(s); + + /* Construct the literal and distance trees */ + build_tree(s, (tree_desc *)(&(s->l_desc))); + Tracev((stderr, "\nlit data: dyn %ld, stat %ld", s->opt_len, + s->static_len)); + + build_tree(s, (tree_desc *)(&(s->d_desc))); + Tracev((stderr, "\ndist data: dyn %ld, stat %ld", s->opt_len, + s->static_len)); + /* At this point, opt_len and static_len are the total bit lengths of + * the compressed block data, excluding the tree representations. + */ + + /* Build the bit length tree for the above two trees, and get the index + * in bl_order of the last bit length code to send. + */ + max_blindex = build_bl_tree(s); + + /* Determine the best encoding. Compute the block lengths in bytes. */ + opt_lenb = (s->opt_len+3+7)>>3; + static_lenb = (s->static_len+3+7)>>3; + + Tracev((stderr, "\nopt %lu(%lu) stat %lu(%lu) stored %lu lit %u ", + opt_lenb, s->opt_len, static_lenb, s->static_len, stored_len, + s->last_lit)); + + if (static_lenb <= opt_lenb) opt_lenb = static_lenb; + + } else { + Assert(buf != (char*)0, "lost buf"); + opt_lenb = static_lenb = stored_len + 5; /* force a stored block */ + } + +#ifdef FORCE_STORED + if (buf != (char*)0) { /* force stored block */ +#else + if (stored_len+4 <= opt_lenb && buf != (char*)0) { + /* 4: two words for the lengths */ +#endif + /* The test buf != NULL is only necessary if LIT_BUFSIZE > WSIZE. + * Otherwise we can't have processed more than WSIZE input bytes since + * the last block flush, because compression would have been + * successful. If LIT_BUFSIZE <= WSIZE, it is never too late to + * transform a block into a stored block. + */ + _tr_stored_block(s, buf, stored_len, eof); + +#ifdef FORCE_STATIC + } else if (static_lenb >= 0) { /* force static trees */ +#else + } else if (s->strategy == Z_FIXED || static_lenb == opt_lenb) { +#endif + send_bits(s, (STATIC_TREES<<1)+eof, 3); + compress_block(s, (ct_data *)static_ltree, (ct_data *)static_dtree); +#ifdef DEBUG + s->compressed_len += 3 + s->static_len; +#endif + } else { + send_bits(s, (DYN_TREES<<1)+eof, 3); + send_all_trees(s, s->l_desc.max_code+1, s->d_desc.max_code+1, + max_blindex+1); + compress_block(s, (ct_data *)s->dyn_ltree, (ct_data *)s->dyn_dtree); +#ifdef DEBUG + s->compressed_len += 3 + s->opt_len; +#endif + } + Assert (s->compressed_len == s->bits_sent, "bad compressed size"); + /* The above check is made mod 2^32, for files larger than 512 MB + * and uLong implemented on 32 bits. + */ + init_block(s); + + if (eof) { + bi_windup(s); +#ifdef DEBUG + s->compressed_len += 7; /* align on byte boundary */ +#endif + } + Tracev((stderr,"\ncomprlen %lu(%lu) ", s->compressed_len>>3, + s->compressed_len-7*eof)); +} + +/* =========================================================================== + * Save the match info and tally the frequency counts. Return true if + * the current block must be flushed. + */ +int _tr_tally (s, dist, lc) + deflate_state *s; + unsigned dist; /* distance of matched string */ + unsigned lc; /* match length-MIN_MATCH or unmatched char (if dist==0) */ +{ + s->d_buf[s->last_lit] = (ush)dist; + s->l_buf[s->last_lit++] = (uch)lc; + if (dist == 0) { + /* lc is the unmatched char */ + s->dyn_ltree[lc].Freq++; + } else { + s->matches++; + /* Here, lc is the match length - MIN_MATCH */ + dist--; /* dist = match distance - 1 */ + Assert((ush)dist < (ush)MAX_DIST(s) && + (ush)lc <= (ush)(MAX_MATCH-MIN_MATCH) && + (ush)d_code(dist) < (ush)D_CODES, "_tr_tally: bad match"); + + s->dyn_ltree[_length_code[lc]+LITERALS+1].Freq++; + s->dyn_dtree[d_code(dist)].Freq++; + } + +#ifdef TRUNCATE_BLOCK + /* Try to guess if it is profitable to stop the current block here */ + if ((s->last_lit & 0x1fff) == 0 && s->level > 2) { + /* Compute an upper bound for the compressed length */ + ulg out_length = (ulg)s->last_lit*8L; + ulg in_length = (ulg)((long)s->strstart - s->block_start); + int dcode; + for (dcode = 0; dcode < D_CODES; dcode++) { + out_length += (ulg)s->dyn_dtree[dcode].Freq * + (5L+extra_dbits[dcode]); + } + out_length >>= 3; + Tracev((stderr,"\nlast_lit %u, in %ld, out ~%ld(%ld%%) ", + s->last_lit, in_length, out_length, + 100L - out_length*100L/in_length)); + if (s->matches < s->last_lit/2 && out_length < in_length/2) return 1; + } +#endif + return (s->last_lit == s->lit_bufsize-1); + /* We avoid equality with lit_bufsize because of wraparound at 64K + * on 16 bit machines and because stored blocks are restricted to + * 64K-1 bytes. + */ +} + +/* =========================================================================== + * Send the block data compressed using the given Huffman trees + */ +local void compress_block(s, ltree, dtree) + deflate_state *s; + ct_data *ltree; /* literal tree */ + ct_data *dtree; /* distance tree */ +{ + unsigned dist; /* distance of matched string */ + int lc; /* match length or unmatched char (if dist == 0) */ + unsigned lx = 0; /* running index in l_buf */ + unsigned code; /* the code to send */ + int extra; /* number of extra bits to send */ + + if (s->last_lit != 0) do { + dist = s->d_buf[lx]; + lc = s->l_buf[lx++]; + if (dist == 0) { + send_code(s, lc, ltree); /* send a literal byte */ + Tracecv(isgraph(lc), (stderr," '%c' ", lc)); + } else { + /* Here, lc is the match length - MIN_MATCH */ + code = _length_code[lc]; + send_code(s, code+LITERALS+1, ltree); /* send the length code */ + extra = extra_lbits[code]; + if (extra != 0) { + lc -= base_length[code]; + send_bits(s, lc, extra); /* send the extra length bits */ + } + dist--; /* dist is now the match distance - 1 */ + code = d_code(dist); + Assert (code < D_CODES, "bad d_code"); + + send_code(s, code, dtree); /* send the distance code */ + extra = extra_dbits[code]; + if (extra != 0) { + dist -= base_dist[code]; + send_bits(s, dist, extra); /* send the extra distance bits */ + } + } /* literal or match pair ? */ + + /* Check that the overlay between pending_buf and d_buf+l_buf is ok: */ + Assert((uInt)(s->pending) < s->lit_bufsize + 2*lx, + "pendingBuf overflow"); + + } while (lx < s->last_lit); + + send_code(s, END_BLOCK, ltree); + s->last_eob_len = ltree[END_BLOCK].Len; +} + +/* =========================================================================== + * Set the data type to BINARY or TEXT, using a crude approximation: + * set it to Z_TEXT if all symbols are either printable characters (33 to 255) + * or white spaces (9 to 13, or 32); or set it to Z_BINARY otherwise. + * IN assertion: the fields Freq of dyn_ltree are set. + */ +local void set_data_type(s) + deflate_state *s; +{ + int n; + + for (n = 0; n < 9; n++) + if (s->dyn_ltree[n].Freq != 0) + break; + if (n == 9) + for (n = 14; n < 32; n++) + if (s->dyn_ltree[n].Freq != 0) + break; + s->strm->data_type = (n == 32) ? Z_TEXT : Z_BINARY; +} + +/* =========================================================================== + * Reverse the first len bits of a code, using straightforward code (a faster + * method would use a table) + * IN assertion: 1 <= len <= 15 + */ +local unsigned bi_reverse(code, len) + unsigned code; /* the value to invert */ + int len; /* its bit length */ +{ + register unsigned res = 0; + do { + res |= code & 1; + code >>= 1, res <<= 1; + } while (--len > 0); + return res >> 1; +} + +/* =========================================================================== + * Flush the bit buffer, keeping at most 7 bits in it. + */ +local void bi_flush(s) + deflate_state *s; +{ + if (s->bi_valid == 16) { + put_short(s, s->bi_buf); + s->bi_buf = 0; + s->bi_valid = 0; + } else if (s->bi_valid >= 8) { + put_byte(s, (Byte)s->bi_buf); + s->bi_buf >>= 8; + s->bi_valid -= 8; + } +} + +/* =========================================================================== + * Flush the bit buffer and align the output on a byte boundary + */ +local void bi_windup(s) + deflate_state *s; +{ + if (s->bi_valid > 8) { + put_short(s, s->bi_buf); + } else if (s->bi_valid > 0) { + put_byte(s, (Byte)s->bi_buf); + } + s->bi_buf = 0; + s->bi_valid = 0; +#ifdef DEBUG + s->bits_sent = (s->bits_sent+7) & ~7; +#endif +} + +/* =========================================================================== + * Copy a stored block, storing first the length and its + * one's complement if requested. + */ +local void copy_block(s, buf, len, header) + deflate_state *s; + charf *buf; /* the input data */ + unsigned len; /* its length */ + int header; /* true if block header must be written */ +{ + bi_windup(s); /* align on byte boundary */ + s->last_eob_len = 8; /* enough lookahead for inflate */ + + if (header) { + put_short(s, (ush)len); + put_short(s, (ush)~len); +#ifdef DEBUG + s->bits_sent += 2*16; +#endif + } +#ifdef DEBUG + s->bits_sent += (ulg)len<<3; +#endif + while (len--) { + put_byte(s, *buf++); + } +} diff --git a/erts/emulator/zlib/trees.h b/erts/emulator/zlib/trees.h new file mode 100644 index 0000000000..72facf900f --- /dev/null +++ b/erts/emulator/zlib/trees.h @@ -0,0 +1,128 @@ +/* header created automatically with -DGEN_TREES_H */ + +local const ct_data static_ltree[L_CODES+2] = { +{{ 12},{ 8}}, {{140},{ 8}}, {{ 76},{ 8}}, {{204},{ 8}}, {{ 44},{ 8}}, +{{172},{ 8}}, {{108},{ 8}}, {{236},{ 8}}, {{ 28},{ 8}}, {{156},{ 8}}, +{{ 92},{ 8}}, {{220},{ 8}}, {{ 60},{ 8}}, {{188},{ 8}}, {{124},{ 8}}, +{{252},{ 8}}, {{ 2},{ 8}}, {{130},{ 8}}, {{ 66},{ 8}}, {{194},{ 8}}, +{{ 34},{ 8}}, {{162},{ 8}}, {{ 98},{ 8}}, {{226},{ 8}}, {{ 18},{ 8}}, +{{146},{ 8}}, {{ 82},{ 8}}, {{210},{ 8}}, {{ 50},{ 8}}, {{178},{ 8}}, +{{114},{ 8}}, {{242},{ 8}}, {{ 10},{ 8}}, {{138},{ 8}}, {{ 74},{ 8}}, +{{202},{ 8}}, {{ 42},{ 8}}, {{170},{ 8}}, {{106},{ 8}}, {{234},{ 8}}, +{{ 26},{ 8}}, {{154},{ 8}}, {{ 90},{ 8}}, {{218},{ 8}}, {{ 58},{ 8}}, +{{186},{ 8}}, {{122},{ 8}}, {{250},{ 8}}, {{ 6},{ 8}}, {{134},{ 8}}, +{{ 70},{ 8}}, {{198},{ 8}}, {{ 38},{ 8}}, {{166},{ 8}}, {{102},{ 8}}, +{{230},{ 8}}, {{ 22},{ 8}}, {{150},{ 8}}, {{ 86},{ 8}}, {{214},{ 8}}, +{{ 54},{ 8}}, {{182},{ 8}}, {{118},{ 8}}, {{246},{ 8}}, {{ 14},{ 8}}, +{{142},{ 8}}, {{ 78},{ 8}}, {{206},{ 8}}, {{ 46},{ 8}}, {{174},{ 8}}, +{{110},{ 8}}, {{238},{ 8}}, {{ 30},{ 8}}, {{158},{ 8}}, {{ 94},{ 8}}, +{{222},{ 8}}, {{ 62},{ 8}}, {{190},{ 8}}, {{126},{ 8}}, {{254},{ 8}}, +{{ 1},{ 8}}, {{129},{ 8}}, {{ 65},{ 8}}, {{193},{ 8}}, {{ 33},{ 8}}, +{{161},{ 8}}, {{ 97},{ 8}}, {{225},{ 8}}, {{ 17},{ 8}}, {{145},{ 8}}, +{{ 81},{ 8}}, {{209},{ 8}}, {{ 49},{ 8}}, {{177},{ 8}}, {{113},{ 8}}, +{{241},{ 8}}, {{ 9},{ 8}}, {{137},{ 8}}, {{ 73},{ 8}}, {{201},{ 8}}, +{{ 41},{ 8}}, {{169},{ 8}}, {{105},{ 8}}, {{233},{ 8}}, {{ 25},{ 8}}, +{{153},{ 8}}, {{ 89},{ 8}}, {{217},{ 8}}, {{ 57},{ 8}}, {{185},{ 8}}, +{{121},{ 8}}, {{249},{ 8}}, {{ 5},{ 8}}, {{133},{ 8}}, {{ 69},{ 8}}, +{{197},{ 8}}, {{ 37},{ 8}}, {{165},{ 8}}, {{101},{ 8}}, {{229},{ 8}}, +{{ 21},{ 8}}, {{149},{ 8}}, {{ 85},{ 8}}, {{213},{ 8}}, {{ 53},{ 8}}, +{{181},{ 8}}, {{117},{ 8}}, {{245},{ 8}}, {{ 13},{ 8}}, {{141},{ 8}}, +{{ 77},{ 8}}, {{205},{ 8}}, {{ 45},{ 8}}, {{173},{ 8}}, {{109},{ 8}}, +{{237},{ 8}}, {{ 29},{ 8}}, {{157},{ 8}}, {{ 93},{ 8}}, {{221},{ 8}}, +{{ 61},{ 8}}, {{189},{ 8}}, {{125},{ 8}}, {{253},{ 8}}, {{ 19},{ 9}}, +{{275},{ 9}}, {{147},{ 9}}, {{403},{ 9}}, {{ 83},{ 9}}, {{339},{ 9}}, +{{211},{ 9}}, {{467},{ 9}}, {{ 51},{ 9}}, {{307},{ 9}}, {{179},{ 9}}, +{{435},{ 9}}, {{115},{ 9}}, {{371},{ 9}}, {{243},{ 9}}, {{499},{ 9}}, +{{ 11},{ 9}}, {{267},{ 9}}, {{139},{ 9}}, {{395},{ 9}}, {{ 75},{ 9}}, +{{331},{ 9}}, {{203},{ 9}}, {{459},{ 9}}, {{ 43},{ 9}}, {{299},{ 9}}, +{{171},{ 9}}, {{427},{ 9}}, {{107},{ 9}}, {{363},{ 9}}, {{235},{ 9}}, +{{491},{ 9}}, {{ 27},{ 9}}, {{283},{ 9}}, {{155},{ 9}}, {{411},{ 9}}, +{{ 91},{ 9}}, {{347},{ 9}}, {{219},{ 9}}, {{475},{ 9}}, {{ 59},{ 9}}, +{{315},{ 9}}, {{187},{ 9}}, {{443},{ 9}}, {{123},{ 9}}, {{379},{ 9}}, +{{251},{ 9}}, {{507},{ 9}}, {{ 7},{ 9}}, {{263},{ 9}}, {{135},{ 9}}, +{{391},{ 9}}, {{ 71},{ 9}}, {{327},{ 9}}, {{199},{ 9}}, {{455},{ 9}}, +{{ 39},{ 9}}, {{295},{ 9}}, {{167},{ 9}}, {{423},{ 9}}, {{103},{ 9}}, +{{359},{ 9}}, {{231},{ 9}}, {{487},{ 9}}, {{ 23},{ 9}}, {{279},{ 9}}, +{{151},{ 9}}, {{407},{ 9}}, {{ 87},{ 9}}, {{343},{ 9}}, {{215},{ 9}}, +{{471},{ 9}}, {{ 55},{ 9}}, {{311},{ 9}}, {{183},{ 9}}, {{439},{ 9}}, +{{119},{ 9}}, {{375},{ 9}}, {{247},{ 9}}, {{503},{ 9}}, {{ 15},{ 9}}, +{{271},{ 9}}, {{143},{ 9}}, {{399},{ 9}}, {{ 79},{ 9}}, {{335},{ 9}}, +{{207},{ 9}}, {{463},{ 9}}, {{ 47},{ 9}}, {{303},{ 9}}, {{175},{ 9}}, +{{431},{ 9}}, {{111},{ 9}}, {{367},{ 9}}, {{239},{ 9}}, {{495},{ 9}}, +{{ 31},{ 9}}, {{287},{ 9}}, {{159},{ 9}}, {{415},{ 9}}, {{ 95},{ 9}}, +{{351},{ 9}}, {{223},{ 9}}, {{479},{ 9}}, {{ 63},{ 9}}, {{319},{ 9}}, +{{191},{ 9}}, {{447},{ 9}}, {{127},{ 9}}, {{383},{ 9}}, {{255},{ 9}}, +{{511},{ 9}}, {{ 0},{ 7}}, {{ 64},{ 7}}, {{ 32},{ 7}}, {{ 96},{ 7}}, +{{ 16},{ 7}}, {{ 80},{ 7}}, {{ 48},{ 7}}, {{112},{ 7}}, {{ 8},{ 7}}, +{{ 72},{ 7}}, {{ 40},{ 7}}, {{104},{ 7}}, {{ 24},{ 7}}, {{ 88},{ 7}}, +{{ 56},{ 7}}, {{120},{ 7}}, {{ 4},{ 7}}, {{ 68},{ 7}}, {{ 36},{ 7}}, +{{100},{ 7}}, {{ 20},{ 7}}, {{ 84},{ 7}}, {{ 52},{ 7}}, {{116},{ 7}}, +{{ 3},{ 8}}, {{131},{ 8}}, {{ 67},{ 8}}, {{195},{ 8}}, {{ 35},{ 8}}, +{{163},{ 8}}, {{ 99},{ 8}}, {{227},{ 8}} +}; + +local const ct_data static_dtree[D_CODES] = { +{{ 0},{ 5}}, {{16},{ 5}}, {{ 8},{ 5}}, {{24},{ 5}}, {{ 4},{ 5}}, +{{20},{ 5}}, {{12},{ 5}}, {{28},{ 5}}, {{ 2},{ 5}}, {{18},{ 5}}, +{{10},{ 5}}, {{26},{ 5}}, {{ 6},{ 5}}, {{22},{ 5}}, {{14},{ 5}}, +{{30},{ 5}}, {{ 1},{ 5}}, {{17},{ 5}}, {{ 9},{ 5}}, {{25},{ 5}}, +{{ 5},{ 5}}, {{21},{ 5}}, {{13},{ 5}}, {{29},{ 5}}, {{ 3},{ 5}}, +{{19},{ 5}}, {{11},{ 5}}, {{27},{ 5}}, {{ 7},{ 5}}, {{23},{ 5}} +}; + +const uch _dist_code[DIST_CODE_LEN] = { + 0, 1, 2, 3, 4, 4, 5, 5, 6, 6, 6, 6, 7, 7, 7, 7, 8, 8, 8, 8, + 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, +10, 10, 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, +11, 11, 11, 11, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, +12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 13, 13, 13, 13, +13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, +13, 13, 13, 13, 13, 13, 13, 13, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, +14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 15, 15, 15, 15, 15, 15, 15, 15, +15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, +15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, +15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 16, 17, +18, 18, 19, 19, 20, 20, 20, 20, 21, 21, 21, 21, 22, 22, 22, 22, 22, 22, 22, 22, +23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +24, 24, 24, 24, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, +26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, +26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, +27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, +27, 27, 27, 27, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, 28, +28, 28, 28, 28, 28, 28, 28, 28, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29 +}; + +const uch _length_code[MAX_MATCH-MIN_MATCH+1]= { + 0, 1, 2, 3, 4, 5, 6, 7, 8, 8, 9, 9, 10, 10, 11, 11, 12, 12, 12, 12, +13, 13, 13, 13, 14, 14, 14, 14, 15, 15, 15, 15, 16, 16, 16, 16, 16, 16, 16, 16, +17, 17, 17, 17, 17, 17, 17, 17, 18, 18, 18, 18, 18, 18, 18, 18, 19, 19, 19, 19, +19, 19, 19, 19, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, +21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 22, 22, 22, 22, +22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 22, 23, 23, 23, 23, 23, 23, 23, 23, +23, 23, 23, 23, 23, 23, 23, 23, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, +25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, +25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 25, 26, 26, 26, 26, 26, 26, 26, 26, +26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, 26, +26, 26, 26, 26, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, +27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, 28 +}; + +local const int base_length[LENGTH_CODES] = { +0, 1, 2, 3, 4, 5, 6, 7, 8, 10, 12, 14, 16, 20, 24, 28, 32, 40, 48, 56, +64, 80, 96, 112, 128, 160, 192, 224, 0 +}; + +local const int base_dist[D_CODES] = { + 0, 1, 2, 3, 4, 6, 8, 12, 16, 24, + 32, 48, 64, 96, 128, 192, 256, 384, 512, 768, + 1024, 1536, 2048, 3072, 4096, 6144, 8192, 12288, 16384, 24576 +}; + diff --git a/erts/emulator/zlib/uncompr.c b/erts/emulator/zlib/uncompr.c new file mode 100644 index 0000000000..cbc93cb1eb --- /dev/null +++ b/erts/emulator/zlib/uncompr.c @@ -0,0 +1,66 @@ +/* uncompr.c -- decompress a memory buffer + * Copyright (C) 1995-2003 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* @(#) $Id$ */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#define ZLIB_INTERNAL +#include "zlib.h" + +/* =========================================================================== + Decompresses the source buffer into the destination buffer. sourceLen is + the byte length of the source buffer. Upon entry, destLen is the total + size of the destination buffer, which must be large enough to hold the + entire uncompressed data. (The size of the uncompressed data must have + been saved previously by the compressor and transmitted to the decompressor + by some mechanism outside the scope of this compression library.) + Upon exit, destLen is the actual size of the compressed buffer. + This function can be used to decompress a whole file at once if the + input file is mmap'ed. + + uncompress returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_BUF_ERROR if there was not enough room in the output + buffer, or Z_DATA_ERROR if the input data was corrupted. +*/ +int ZEXPORT uncompress (dest, destLen, source, sourceLen) + Bytef *dest; + uLongf *destLen; + const Bytef *source; + uLong sourceLen; +{ + z_stream stream; + int err; + + stream.next_in = (Bytef*)source; + stream.avail_in = (uInt)sourceLen; + /* Check for source > 64K on 16-bit machine: */ + if ((uLong)stream.avail_in != sourceLen) return Z_BUF_ERROR; + + stream.next_out = dest; + stream.avail_out = (uInt)*destLen; + if ((uLong)stream.avail_out != *destLen) return Z_BUF_ERROR; + + stream.zalloc = (alloc_func)0; + stream.zfree = (free_func)0; + + err = inflateInit(&stream); + if (err != Z_OK) return err; + + err = inflate(&stream, Z_FINISH); + if (err != Z_STREAM_END) { + inflateEnd(&stream); + if (err == Z_NEED_DICT || (err == Z_BUF_ERROR && stream.avail_in == 0)) + return Z_DATA_ERROR; + return err; + } + *destLen = stream.total_out; + + err = inflateEnd(&stream); + return err; +} diff --git a/erts/emulator/zlib/zconf.h b/erts/emulator/zlib/zconf.h new file mode 100644 index 0000000000..b7979d48d3 --- /dev/null +++ b/erts/emulator/zlib/zconf.h @@ -0,0 +1,334 @@ +/* zconf.h -- configuration of the zlib compression library + * Copyright (C) 1995-2005 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* @(#) $Id$ */ + +#ifndef ZCONF_H +#define ZCONF_H + +/* + * If you *really* need a unique prefix for all types and library functions, + * compile with -DZ_PREFIX. The "standard" zlib should be compiled without it. + */ +#ifdef Z_PREFIX +# define deflateInit_ z_deflateInit_ +# define deflate z_deflate +# define deflateEnd z_deflateEnd +# define inflateInit_ z_inflateInit_ +# define inflate z_inflate +# define inflateEnd z_inflateEnd +# define deflateInit2_ z_deflateInit2_ +# define deflateSetDictionary z_deflateSetDictionary +# define deflateCopy z_deflateCopy +# define deflateReset z_deflateReset +# define deflateParams z_deflateParams +# define deflateBound z_deflateBound +# define deflatePrime z_deflatePrime +# define inflateInit2_ z_inflateInit2_ +# define inflateSetDictionary z_inflateSetDictionary +# define inflateSync z_inflateSync +# define inflateSyncPoint z_inflateSyncPoint +# define inflateCopy z_inflateCopy +# define inflateReset z_inflateReset +# define inflateBack z_inflateBack +# define inflateBackEnd z_inflateBackEnd +# define compress z_compress +# define compress2 z_compress2 +# define compressBound z_compressBound +# define uncompress z_uncompress +# define adler32 z_adler32 +# define crc32 z_crc32 +# define get_crc_table z_get_crc_table +# define zError z_zError + +# define alloc_func z_alloc_func +# define free_func z_free_func +# define in_func z_in_func +# define out_func z_out_func +# define Byte z_Byte +# define uInt z_uInt +# define uLong z_uLong +# define Bytef z_Bytef +# define charf z_charf +# define intf z_intf +# define uIntf z_uIntf +# define uLongf z_uLongf +# define voidpf z_voidpf +# define voidp z_voidp +#endif + +#if defined(__MSDOS__) && !defined(MSDOS) +# define MSDOS +#endif +#if (defined(OS_2) || defined(__OS2__)) && !defined(OS2) +# define OS2 +#endif +#if defined(_WINDOWS) && !defined(WINDOWS) +# define WINDOWS +#endif +#if defined(_WIN32) || defined(_WIN32_WCE) || defined(__WIN32__) +# ifndef WIN32 +# define WIN32 +# endif +#endif +#if (defined(MSDOS) || defined(OS2) || defined(WINDOWS)) && !defined(WIN32) +# if !defined(__GNUC__) && !defined(__FLAT__) && !defined(__386__) +# ifndef SYS16BIT +# define SYS16BIT +# endif +# endif +#endif + +/* + * Compile with -DMAXSEG_64K if the alloc function cannot allocate more + * than 64k bytes at a time (needed on systems with 16-bit int). + */ +#ifdef SYS16BIT +# define MAXSEG_64K +#endif +#ifdef MSDOS +# define UNALIGNED_OK +#endif + +#ifdef __STDC_VERSION__ +# ifndef STDC +# define STDC +# endif +# if __STDC_VERSION__ >= 199901L +# ifndef STDC99 +# define STDC99 +# endif +# endif +#endif +#if !defined(STDC) && (defined(__STDC__) || defined(__cplusplus)) +# define STDC +#endif +#if !defined(STDC) && (defined(__GNUC__) || defined(__BORLANDC__)) +# define STDC +#endif +#if !defined(STDC) && (defined(MSDOS) || defined(WINDOWS) || defined(WIN32)) +# define STDC +#endif +#if !defined(STDC) && (defined(OS2) || defined(__HOS_AIX__)) +# define STDC +#endif + +#if defined(__OS400__) && !defined(STDC) /* iSeries (formerly AS/400). */ +# define STDC +#endif + +#ifndef STDC +# ifndef const /* cannot use !defined(STDC) && !defined(const) on Mac */ +# define const /* note: need a more gentle solution here */ +# endif +#endif + +/* Some Mac compilers merge all .h files incorrectly: */ +#if defined(__MWERKS__)||defined(applec)||defined(THINK_C)||defined(__SC__) +# define NO_DUMMY_DECL +#endif + +/* Maximum value for memLevel in deflateInit2 */ +#ifndef MAX_MEM_LEVEL +# ifdef MAXSEG_64K +# define MAX_MEM_LEVEL 8 +# else +# define MAX_MEM_LEVEL 9 +# endif +#endif + +/* Maximum value for windowBits in deflateInit2 and inflateInit2. + * WARNING: reducing MAX_WBITS makes minigzip unable to extract .gz files + * created by gzip. (Files created by minigzip can still be extracted by + * gzip.) + */ +#ifndef MAX_WBITS +# define MAX_WBITS 15 /* 32K LZ77 window */ +#endif + +/* The memory requirements for deflate are (in bytes): + (1 << (windowBits+2)) + (1 << (memLevel+9)) + that is: 128K for windowBits=15 + 128K for memLevel = 8 (default values) + plus a few kilobytes for small objects. For example, if you want to reduce + the default memory requirements from 256K to 128K, compile with + make CFLAGS="-O -DMAX_WBITS=14 -DMAX_MEM_LEVEL=7" + Of course this will generally degrade compression (there's no free lunch). + + The memory requirements for inflate are (in bytes) 1 << windowBits + that is, 32K for windowBits=15 (default value) plus a few kilobytes + for small objects. +*/ + + /* Type declarations */ + +#ifndef OF /* function prototypes */ +# ifdef STDC +# define OF(args) args +# else +# define OF(args) () +# endif +#endif + +/* The following definitions for FAR are needed only for MSDOS mixed + * model programming (small or medium model with some far allocations). + * This was tested only with MSC; for other MSDOS compilers you may have + * to define NO_MEMCPY in zutil.h. If you don't need the mixed model, + * just define FAR to be empty. + */ +#ifdef SYS16BIT +# if defined(M_I86SM) || defined(M_I86MM) + /* MSC small or medium model */ +# define SMALL_MEDIUM +# ifdef _MSC_VER +# define FAR _far +# else +# define FAR far +# endif +# endif +# if (defined(__SMALL__) || defined(__MEDIUM__)) + /* Turbo C small or medium model */ +# define SMALL_MEDIUM +# ifdef __BORLANDC__ +# define FAR _far +# else +# define FAR far +# endif +# endif +#endif + +#if defined(WINDOWS) || defined(WIN32) + /* If building or using zlib as a DLL, define ZLIB_DLL. + * This is not mandatory, but it offers a little performance increase. + */ +# ifdef ZLIB_DLL +# if defined(WIN32) && (!defined(__BORLANDC__) || (__BORLANDC__ >= 0x500)) +# ifdef ZLIB_INTERNAL +# define ZEXTERN extern __declspec(dllexport) +# else +# define ZEXTERN extern __declspec(dllimport) +# endif +# endif +# endif /* ZLIB_DLL */ + /* If building or using zlib with the WINAPI/WINAPIV calling convention, + * define ZLIB_WINAPI. + * Caution: the standard ZLIB1.DLL is NOT compiled using ZLIB_WINAPI. + */ +# ifdef ZLIB_WINAPI +# ifdef FAR +# undef FAR +# endif +# include + /* No need for _export, use ZLIB.DEF instead. */ + /* For complete Windows compatibility, use WINAPI, not __stdcall. */ +# define ZEXPORT WINAPI +# ifdef WIN32 +# define ZEXPORTVA WINAPIV +# else +# define ZEXPORTVA FAR CDECL +# endif +# endif +#endif + +#if defined (__BEOS__) +# ifdef ZLIB_DLL +# ifdef ZLIB_INTERNAL +# define ZEXPORT __declspec(dllexport) +# define ZEXPORTVA __declspec(dllexport) +# else +# define ZEXPORT __declspec(dllimport) +# define ZEXPORTVA __declspec(dllimport) +# endif +# endif +#endif + +#ifndef ZEXTERN +# define ZEXTERN extern +#endif +#ifndef ZEXPORT +# define ZEXPORT +#endif +#ifndef ZEXPORTVA +# define ZEXPORTVA +#endif + +#ifndef FAR +# define FAR +#endif + +#if !defined(__MACTYPES__) +typedef unsigned char Byte; /* 8 bits */ +#endif +typedef unsigned int uInt; /* 16 bits or more */ +typedef unsigned long uLong; /* 32 bits or more */ + +#ifdef SMALL_MEDIUM + /* Borland C/C++ and some old MSC versions ignore FAR inside typedef */ +# define Bytef Byte FAR +#else + typedef Byte FAR Bytef; +#endif +typedef char FAR charf; +typedef int FAR intf; +typedef uInt FAR uIntf; +typedef uLong FAR uLongf; + +#ifdef STDC + typedef void const *voidpc; + typedef void FAR *voidpf; + typedef void *voidp; +#else + typedef Byte const *voidpc; + typedef Byte FAR *voidpf; + typedef Byte *voidp; +#endif + +#if 0 /* HAVE_UNISTD_H -- this line is updated by ./configure */ +# include /* for off_t */ +# include /* for SEEK_* and off_t */ +# ifdef VMS +# include /* for off_t */ +# endif +# define z_off_t off_t +#endif +#ifndef SEEK_SET +# define SEEK_SET 0 /* Seek from beginning of file. */ +# define SEEK_CUR 1 /* Seek from current position. */ +# define SEEK_END 2 /* Set file pointer to EOF plus "offset" */ +#endif +#ifndef z_off_t +# define z_off_t long +#endif + +#if defined(__OS400__) +# define NO_vsnprintf +#endif + +#if defined(__MVS__) +# define NO_vsnprintf +# ifdef FAR +# undef FAR +# endif +#endif + +/* MVS linker does not support external names larger than 8 bytes */ +#if defined(__MVS__) +# pragma map(deflateInit_,"DEIN") +# pragma map(deflateInit2_,"DEIN2") +# pragma map(deflateEnd,"DEEND") +# pragma map(deflateBound,"DEBND") +# pragma map(inflateInit_,"ININ") +# pragma map(inflateInit2_,"ININ2") +# pragma map(inflateEnd,"INEND") +# pragma map(inflateSync,"INSY") +# pragma map(inflateSetDictionary,"INSEDI") +# pragma map(compressBound,"CMBND") +# pragma map(inflate_table,"INTABL") +# pragma map(inflate_fast,"INFA") +# pragma map(inflate_copyright,"INCOPY") +#endif + +#endif /* ZCONF_H */ diff --git a/erts/emulator/zlib/zlib.h b/erts/emulator/zlib/zlib.h new file mode 100644 index 0000000000..9209774383 --- /dev/null +++ b/erts/emulator/zlib/zlib.h @@ -0,0 +1,1359 @@ +/* zlib.h -- interface of the 'zlib' general purpose compression library + version 1.2.3, July 18th, 2005 + + Copyright (C) 1995-2005 Jean-loup Gailly and Mark Adler + + This software is provided 'as-is', without any express or implied + warranty. In no event will the authors be held liable for any damages + arising from the use of this software. + + Permission is granted to anyone to use this software for any purpose, + including commercial applications, and to alter it and redistribute it + freely, subject to the following restrictions: + + 1. The origin of this software must not be misrepresented; you must not + claim that you wrote the original software. If you use this software + in a product, an acknowledgment in the product documentation would be + appreciated but is not required. + 2. Altered source versions must be plainly marked as such, and must not be + misrepresented as being the original software. + 3. This notice may not be removed or altered from any source distribution. + + Jean-loup Gailly Mark Adler + jloup@gzip.org madler@alumni.caltech.edu + + + The data format used by the zlib library is described by RFCs (Request for + Comments) 1950 to 1952 in the files http://www.ietf.org/rfc/rfc1950.txt + (zlib format), rfc1951.txt (deflate format) and rfc1952.txt (gzip format). +*/ + +/* %ExternalCopyright% */ + +#ifndef ZLIB_H +#define ZLIB_H + +#include "zconf.h" + +#ifdef __cplusplus +extern "C" { +#endif + +#define ZLIB_VERSION "1.2.3" +#define ZLIB_VERNUM 0x1230 + +/* + The 'zlib' compression library provides in-memory compression and + decompression functions, including integrity checks of the uncompressed + data. This version of the library supports only one compression method + (deflation) but other algorithms will be added later and will have the same + stream interface. + + Compression can be done in a single step if the buffers are large + enough (for example if an input file is mmap'ed), or can be done by + repeated calls of the compression function. In the latter case, the + application must provide more input and/or consume the output + (providing more output space) before each call. + + The compressed data format used by default by the in-memory functions is + the zlib format, which is a zlib wrapper documented in RFC 1950, wrapped + around a deflate stream, which is itself documented in RFC 1951. + + The library also supports reading and writing files in gzip (.gz) format + with an interface similar to that of stdio using the functions that start + with "gz". The gzip format is different from the zlib format. gzip is a + gzip wrapper, documented in RFC 1952, wrapped around a deflate stream. + + This library can optionally read and write gzip streams in memory as well. + + The zlib format was designed to be compact and fast for use in memory + and on communications channels. The gzip format was designed for single- + file compression on file systems, has a larger header than zlib to maintain + directory information, and uses a different, slower check method than zlib. + + The library does not install any signal handler. The decoder checks + the consistency of the compressed data, so the library should never + crash even in case of corrupted input. +*/ + +typedef voidpf (*alloc_func) OF((voidpf opaque, uInt items, uInt size)); +typedef void (*free_func) OF((voidpf opaque, voidpf address)); + +struct internal_state; + +typedef struct z_stream_s { + Bytef *next_in; /* next input byte */ + uInt avail_in; /* number of bytes available at next_in */ + uLong total_in; /* total nb of input bytes read so far */ + + Bytef *next_out; /* next output byte should be put there */ + uInt avail_out; /* remaining free space at next_out */ + uLong total_out; /* total nb of bytes output so far */ + + char *msg; /* last error message, NULL if no error */ + struct internal_state FAR *state; /* not visible by applications */ + + alloc_func zalloc; /* used to allocate the internal state */ + free_func zfree; /* used to free the internal state */ + voidpf opaque; /* private data object passed to zalloc and zfree */ + + int data_type; /* best guess about the data type: binary or text */ + uLong adler; /* adler32 value of the uncompressed data */ + uLong reserved; /* reserved for future use */ +} z_stream; + +typedef z_stream FAR *z_streamp; + +/* + gzip header information passed to and from zlib routines. See RFC 1952 + for more details on the meanings of these fields. +*/ +typedef struct gz_header_s { + int text; /* true if compressed data believed to be text */ + uLong time; /* modification time */ + int xflags; /* extra flags (not used when writing a gzip file) */ + int os; /* operating system */ + Bytef *extra; /* pointer to extra field or Z_NULL if none */ + uInt extra_len; /* extra field length (valid if extra != Z_NULL) */ + uInt extra_max; /* space at extra (only when reading header) */ + Bytef *name; /* pointer to zero-terminated file name or Z_NULL */ + uInt name_max; /* space at name (only when reading header) */ + Bytef *comment; /* pointer to zero-terminated comment or Z_NULL */ + uInt comm_max; /* space at comment (only when reading header) */ + int hcrc; /* true if there was or will be a header crc */ + int done; /* true when done reading gzip header (not used + when writing a gzip file) */ +} gz_header; + +typedef gz_header FAR *gz_headerp; + +/* + The application must update next_in and avail_in when avail_in has + dropped to zero. It must update next_out and avail_out when avail_out + has dropped to zero. The application must initialize zalloc, zfree and + opaque before calling the init function. All other fields are set by the + compression library and must not be updated by the application. + + The opaque value provided by the application will be passed as the first + parameter for calls of zalloc and zfree. This can be useful for custom + memory management. The compression library attaches no meaning to the + opaque value. + + zalloc must return Z_NULL if there is not enough memory for the object. + If zlib is used in a multi-threaded application, zalloc and zfree must be + thread safe. + + On 16-bit systems, the functions zalloc and zfree must be able to allocate + exactly 65536 bytes, but will not be required to allocate more than this + if the symbol MAXSEG_64K is defined (see zconf.h). WARNING: On MSDOS, + pointers returned by zalloc for objects of exactly 65536 bytes *must* + have their offset normalized to zero. The default allocation function + provided by this library ensures this (see zutil.c). To reduce memory + requirements and avoid any allocation of 64K objects, at the expense of + compression ratio, compile the library with -DMAX_WBITS=14 (see zconf.h). + + The fields total_in and total_out can be used for statistics or + progress reports. After compression, total_in holds the total size of + the uncompressed data and may be saved for use in the decompressor + (particularly if the decompressor wants to decompress everything in + a single step). +*/ + + /* constants */ + +#define Z_NO_FLUSH 0 +#define Z_PARTIAL_FLUSH 1 /* will be removed, use Z_SYNC_FLUSH instead */ +#define Z_SYNC_FLUSH 2 +#define Z_FULL_FLUSH 3 +#define Z_FINISH 4 +#define Z_BLOCK 5 +/* Allowed flush values; see deflate() and inflate() below for details */ + +#define Z_OK 0 +#define Z_STREAM_END 1 +#define Z_NEED_DICT 2 +#define Z_ERRNO (-1) +#define Z_STREAM_ERROR (-2) +#define Z_DATA_ERROR (-3) +#define Z_MEM_ERROR (-4) +#define Z_BUF_ERROR (-5) +#define Z_VERSION_ERROR (-6) +/* Return codes for the compression/decompression functions. Negative + * values are errors, positive values are used for special but normal events. + */ + +#define Z_NO_COMPRESSION 0 +#define Z_BEST_SPEED 1 +#define Z_BEST_COMPRESSION 9 +#define Z_DEFAULT_COMPRESSION (-1) +/* compression levels */ + +#define Z_FILTERED 1 +#define Z_HUFFMAN_ONLY 2 +#define Z_RLE 3 +#define Z_FIXED 4 +#define Z_DEFAULT_STRATEGY 0 +/* compression strategy; see deflateInit2() below for details */ + +#define Z_BINARY 0 +#define Z_TEXT 1 +#define Z_ASCII Z_TEXT /* for compatibility with 1.2.2 and earlier */ +#define Z_UNKNOWN 2 +/* Possible values of the data_type field (though see inflate()) */ + +#define Z_DEFLATED 8 +/* The deflate compression method (the only one supported in this version) */ + +#define Z_NULL 0 /* for initializing zalloc, zfree, opaque */ + +#define zlib_version zlibVersion() +/* for compatibility with versions < 1.0.2 */ + + /* basic functions */ + +ZEXTERN const char * ZEXPORT zlibVersion OF((void)); +/* The application can compare zlibVersion and ZLIB_VERSION for consistency. + If the first character differs, the library code actually used is + not compatible with the zlib.h header file used by the application. + This check is automatically made by deflateInit and inflateInit. + */ + +/* +ZEXTERN int ZEXPORT deflateInit OF((z_streamp strm, int level)); + + Initializes the internal stream state for compression. The fields + zalloc, zfree and opaque must be initialized before by the caller. + If zalloc and zfree are set to Z_NULL, deflateInit updates them to + use default allocation functions. + + The compression level must be Z_DEFAULT_COMPRESSION, or between 0 and 9: + 1 gives best speed, 9 gives best compression, 0 gives no compression at + all (the input data is simply copied a block at a time). + Z_DEFAULT_COMPRESSION requests a default compromise between speed and + compression (currently equivalent to level 6). + + deflateInit returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_STREAM_ERROR if level is not a valid compression level, + Z_VERSION_ERROR if the zlib library version (zlib_version) is incompatible + with the version assumed by the caller (ZLIB_VERSION). + msg is set to null if there is no error message. deflateInit does not + perform any compression: this will be done by deflate(). +*/ + + +ZEXTERN int ZEXPORT deflate OF((z_streamp strm, int flush)); +/* + deflate compresses as much data as possible, and stops when the input + buffer becomes empty or the output buffer becomes full. It may introduce some + output latency (reading input without producing any output) except when + forced to flush. + + The detailed semantics are as follows. deflate performs one or both of the + following actions: + + - Compress more input starting at next_in and update next_in and avail_in + accordingly. If not all input can be processed (because there is not + enough room in the output buffer), next_in and avail_in are updated and + processing will resume at this point for the next call of deflate(). + + - Provide more output starting at next_out and update next_out and avail_out + accordingly. This action is forced if the parameter flush is non zero. + Forcing flush frequently degrades the compression ratio, so this parameter + should be set only when necessary (in interactive applications). + Some output may be provided even if flush is not set. + + Before the call of deflate(), the application should ensure that at least + one of the actions is possible, by providing more input and/or consuming + more output, and updating avail_in or avail_out accordingly; avail_out + should never be zero before the call. The application can consume the + compressed output when it wants, for example when the output buffer is full + (avail_out == 0), or after each call of deflate(). If deflate returns Z_OK + and with zero avail_out, it must be called again after making room in the + output buffer because there might be more output pending. + + Normally the parameter flush is set to Z_NO_FLUSH, which allows deflate to + decide how much data to accumualte before producing output, in order to + maximize compression. + + If the parameter flush is set to Z_SYNC_FLUSH, all pending output is + flushed to the output buffer and the output is aligned on a byte boundary, so + that the decompressor can get all input data available so far. (In particular + avail_in is zero after the call if enough output space has been provided + before the call.) Flushing may degrade compression for some compression + algorithms and so it should be used only when necessary. + + If flush is set to Z_FULL_FLUSH, all output is flushed as with + Z_SYNC_FLUSH, and the compression state is reset so that decompression can + restart from this point if previous compressed data has been damaged or if + random access is desired. Using Z_FULL_FLUSH too often can seriously degrade + compression. + + If deflate returns with avail_out == 0, this function must be called again + with the same value of the flush parameter and more output space (updated + avail_out), until the flush is complete (deflate returns with non-zero + avail_out). In the case of a Z_FULL_FLUSH or Z_SYNC_FLUSH, make sure that + avail_out is greater than six to avoid repeated flush markers due to + avail_out == 0 on return. + + If the parameter flush is set to Z_FINISH, pending input is processed, + pending output is flushed and deflate returns with Z_STREAM_END if there + was enough output space; if deflate returns with Z_OK, this function must be + called again with Z_FINISH and more output space (updated avail_out) but no + more input data, until it returns with Z_STREAM_END or an error. After + deflate has returned Z_STREAM_END, the only possible operations on the + stream are deflateReset or deflateEnd. + + Z_FINISH can be used immediately after deflateInit if all the compression + is to be done in a single step. In this case, avail_out must be at least + the value returned by deflateBound (see below). If deflate does not return + Z_STREAM_END, then it must be called again as described above. + + deflate() sets strm->adler to the adler32 checksum of all input read + so far (that is, total_in bytes). + + deflate() may update strm->data_type if it can make a good guess about + the input data type (Z_BINARY or Z_TEXT). In doubt, the data is considered + binary. This field is only for information purposes and does not affect + the compression algorithm in any manner. + + deflate() returns Z_OK if some progress has been made (more input + processed or more output produced), Z_STREAM_END if all input has been + consumed and all output has been produced (only when flush is set to + Z_FINISH), Z_STREAM_ERROR if the stream state was inconsistent (for example + if next_in or next_out was NULL), Z_BUF_ERROR if no progress is possible + (for example avail_in or avail_out was zero). Note that Z_BUF_ERROR is not + fatal, and deflate() can be called again with more input and more output + space to continue compressing. +*/ + + +ZEXTERN int ZEXPORT deflateEnd OF((z_streamp strm)); +/* + All dynamically allocated data structures for this stream are freed. + This function discards any unprocessed input and does not flush any + pending output. + + deflateEnd returns Z_OK if success, Z_STREAM_ERROR if the + stream state was inconsistent, Z_DATA_ERROR if the stream was freed + prematurely (some input or output was discarded). In the error case, + msg may be set but then points to a static string (which must not be + deallocated). +*/ + + +/* +ZEXTERN int ZEXPORT inflateInit OF((z_streamp strm)); + + Initializes the internal stream state for decompression. The fields + next_in, avail_in, zalloc, zfree and opaque must be initialized before by + the caller. If next_in is not Z_NULL and avail_in is large enough (the exact + value depends on the compression method), inflateInit determines the + compression method from the zlib header and allocates all data structures + accordingly; otherwise the allocation will be deferred to the first call of + inflate. If zalloc and zfree are set to Z_NULL, inflateInit updates them to + use default allocation functions. + + inflateInit returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_VERSION_ERROR if the zlib library version is incompatible with the + version assumed by the caller. msg is set to null if there is no error + message. inflateInit does not perform any decompression apart from reading + the zlib header if present: this will be done by inflate(). (So next_in and + avail_in may be modified, but next_out and avail_out are unchanged.) +*/ + + +ZEXTERN int ZEXPORT inflate OF((z_streamp strm, int flush)); +/* + inflate decompresses as much data as possible, and stops when the input + buffer becomes empty or the output buffer becomes full. It may introduce + some output latency (reading input without producing any output) except when + forced to flush. + + The detailed semantics are as follows. inflate performs one or both of the + following actions: + + - Decompress more input starting at next_in and update next_in and avail_in + accordingly. If not all input can be processed (because there is not + enough room in the output buffer), next_in is updated and processing + will resume at this point for the next call of inflate(). + + - Provide more output starting at next_out and update next_out and avail_out + accordingly. inflate() provides as much output as possible, until there + is no more input data or no more space in the output buffer (see below + about the flush parameter). + + Before the call of inflate(), the application should ensure that at least + one of the actions is possible, by providing more input and/or consuming + more output, and updating the next_* and avail_* values accordingly. + The application can consume the uncompressed output when it wants, for + example when the output buffer is full (avail_out == 0), or after each + call of inflate(). If inflate returns Z_OK and with zero avail_out, it + must be called again after making room in the output buffer because there + might be more output pending. + + The flush parameter of inflate() can be Z_NO_FLUSH, Z_SYNC_FLUSH, + Z_FINISH, or Z_BLOCK. Z_SYNC_FLUSH requests that inflate() flush as much + output as possible to the output buffer. Z_BLOCK requests that inflate() stop + if and when it gets to the next deflate block boundary. When decoding the + zlib or gzip format, this will cause inflate() to return immediately after + the header and before the first block. When doing a raw inflate, inflate() + will go ahead and process the first block, and will return when it gets to + the end of that block, or when it runs out of data. + + The Z_BLOCK option assists in appending to or combining deflate streams. + Also to assist in this, on return inflate() will set strm->data_type to the + number of unused bits in the last byte taken from strm->next_in, plus 64 + if inflate() is currently decoding the last block in the deflate stream, + plus 128 if inflate() returned immediately after decoding an end-of-block + code or decoding the complete header up to just before the first byte of the + deflate stream. The end-of-block will not be indicated until all of the + uncompressed data from that block has been written to strm->next_out. The + number of unused bits may in general be greater than seven, except when + bit 7 of data_type is set, in which case the number of unused bits will be + less than eight. + + inflate() should normally be called until it returns Z_STREAM_END or an + error. However if all decompression is to be performed in a single step + (a single call of inflate), the parameter flush should be set to + Z_FINISH. In this case all pending input is processed and all pending + output is flushed; avail_out must be large enough to hold all the + uncompressed data. (The size of the uncompressed data may have been saved + by the compressor for this purpose.) The next operation on this stream must + be inflateEnd to deallocate the decompression state. The use of Z_FINISH + is never required, but can be used to inform inflate that a faster approach + may be used for the single inflate() call. + + In this implementation, inflate() always flushes as much output as + possible to the output buffer, and always uses the faster approach on the + first call. So the only effect of the flush parameter in this implementation + is on the return value of inflate(), as noted below, or when it returns early + because Z_BLOCK is used. + + If a preset dictionary is needed after this call (see inflateSetDictionary + below), inflate sets strm->adler to the adler32 checksum of the dictionary + chosen by the compressor and returns Z_NEED_DICT; otherwise it sets + strm->adler to the adler32 checksum of all output produced so far (that is, + total_out bytes) and returns Z_OK, Z_STREAM_END or an error code as described + below. At the end of the stream, inflate() checks that its computed adler32 + checksum is equal to that saved by the compressor and returns Z_STREAM_END + only if the checksum is correct. + + inflate() will decompress and check either zlib-wrapped or gzip-wrapped + deflate data. The header type is detected automatically. Any information + contained in the gzip header is not retained, so applications that need that + information should instead use raw inflate, see inflateInit2() below, or + inflateBack() and perform their own processing of the gzip header and + trailer. + + inflate() returns Z_OK if some progress has been made (more input processed + or more output produced), Z_STREAM_END if the end of the compressed data has + been reached and all uncompressed output has been produced, Z_NEED_DICT if a + preset dictionary is needed at this point, Z_DATA_ERROR if the input data was + corrupted (input stream not conforming to the zlib format or incorrect check + value), Z_STREAM_ERROR if the stream structure was inconsistent (for example + if next_in or next_out was NULL), Z_MEM_ERROR if there was not enough memory, + Z_BUF_ERROR if no progress is possible or if there was not enough room in the + output buffer when Z_FINISH is used. Note that Z_BUF_ERROR is not fatal, and + inflate() can be called again with more input and more output space to + continue decompressing. If Z_DATA_ERROR is returned, the application may then + call inflateSync() to look for a good compression block if a partial recovery + of the data is desired. +*/ + + +ZEXTERN int ZEXPORT inflateEnd OF((z_streamp strm)); +/* + All dynamically allocated data structures for this stream are freed. + This function discards any unprocessed input and does not flush any + pending output. + + inflateEnd returns Z_OK if success, Z_STREAM_ERROR if the stream state + was inconsistent. In the error case, msg may be set but then points to a + static string (which must not be deallocated). +*/ + + /* Advanced functions */ + +/* + The following functions are needed only in some special applications. +*/ + +/* +ZEXTERN int ZEXPORT deflateInit2 OF((z_streamp strm, + int level, + int method, + int windowBits, + int memLevel, + int strategy)); + + This is another version of deflateInit with more compression options. The + fields next_in, zalloc, zfree and opaque must be initialized before by + the caller. + + The method parameter is the compression method. It must be Z_DEFLATED in + this version of the library. + + The windowBits parameter is the base two logarithm of the window size + (the size of the history buffer). It should be in the range 8..15 for this + version of the library. Larger values of this parameter result in better + compression at the expense of memory usage. The default value is 15 if + deflateInit is used instead. + + windowBits can also be -8..-15 for raw deflate. In this case, -windowBits + determines the window size. deflate() will then generate raw deflate data + with no zlib header or trailer, and will not compute an adler32 check value. + + windowBits can also be greater than 15 for optional gzip encoding. Add + 16 to windowBits to write a simple gzip header and trailer around the + compressed data instead of a zlib wrapper. The gzip header will have no + file name, no extra data, no comment, no modification time (set to zero), + no header crc, and the operating system will be set to 255 (unknown). If a + gzip stream is being written, strm->adler is a crc32 instead of an adler32. + + The memLevel parameter specifies how much memory should be allocated + for the internal compression state. memLevel=1 uses minimum memory but + is slow and reduces compression ratio; memLevel=9 uses maximum memory + for optimal speed. The default value is 8. See zconf.h for total memory + usage as a function of windowBits and memLevel. + + The strategy parameter is used to tune the compression algorithm. Use the + value Z_DEFAULT_STRATEGY for normal data, Z_FILTERED for data produced by a + filter (or predictor), Z_HUFFMAN_ONLY to force Huffman encoding only (no + string match), or Z_RLE to limit match distances to one (run-length + encoding). Filtered data consists mostly of small values with a somewhat + random distribution. In this case, the compression algorithm is tuned to + compress them better. The effect of Z_FILTERED is to force more Huffman + coding and less string matching; it is somewhat intermediate between + Z_DEFAULT and Z_HUFFMAN_ONLY. Z_RLE is designed to be almost as fast as + Z_HUFFMAN_ONLY, but give better compression for PNG image data. The strategy + parameter only affects the compression ratio but not the correctness of the + compressed output even if it is not set appropriately. Z_FIXED prevents the + use of dynamic Huffman codes, allowing for a simpler decoder for special + applications. + + deflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_STREAM_ERROR if a parameter is invalid (such as an invalid + method). msg is set to null if there is no error message. deflateInit2 does + not perform any compression: this will be done by deflate(). +*/ + +ZEXTERN int ZEXPORT deflateSetDictionary OF((z_streamp strm, + const Bytef *dictionary, + uInt dictLength)); +/* + Initializes the compression dictionary from the given byte sequence + without producing any compressed output. This function must be called + immediately after deflateInit, deflateInit2 or deflateReset, before any + call of deflate. The compressor and decompressor must use exactly the same + dictionary (see inflateSetDictionary). + + The dictionary should consist of strings (byte sequences) that are likely + to be encountered later in the data to be compressed, with the most commonly + used strings preferably put towards the end of the dictionary. Using a + dictionary is most useful when the data to be compressed is short and can be + predicted with good accuracy; the data can then be compressed better than + with the default empty dictionary. + + Depending on the size of the compression data structures selected by + deflateInit or deflateInit2, a part of the dictionary may in effect be + discarded, for example if the dictionary is larger than the window size in + deflate or deflate2. Thus the strings most likely to be useful should be + put at the end of the dictionary, not at the front. In addition, the + current implementation of deflate will use at most the window size minus + 262 bytes of the provided dictionary. + + Upon return of this function, strm->adler is set to the adler32 value + of the dictionary; the decompressor may later use this value to determine + which dictionary has been used by the compressor. (The adler32 value + applies to the whole dictionary even if only a subset of the dictionary is + actually used by the compressor.) If a raw deflate was requested, then the + adler32 value is not computed and strm->adler is not set. + + deflateSetDictionary returns Z_OK if success, or Z_STREAM_ERROR if a + parameter is invalid (such as NULL dictionary) or the stream state is + inconsistent (for example if deflate has already been called for this stream + or if the compression method is bsort). deflateSetDictionary does not + perform any compression: this will be done by deflate(). +*/ + +ZEXTERN int ZEXPORT deflateCopy OF((z_streamp dest, + z_streamp source)); +/* + Sets the destination stream as a complete copy of the source stream. + + This function can be useful when several compression strategies will be + tried, for example when there are several ways of pre-processing the input + data with a filter. The streams that will be discarded should then be freed + by calling deflateEnd. Note that deflateCopy duplicates the internal + compression state which can be quite large, so this strategy is slow and + can consume lots of memory. + + deflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_STREAM_ERROR if the source stream state was inconsistent + (such as zalloc being NULL). msg is left unchanged in both source and + destination. +*/ + +ZEXTERN int ZEXPORT deflateReset OF((z_streamp strm)); +/* + This function is equivalent to deflateEnd followed by deflateInit, + but does not free and reallocate all the internal compression state. + The stream will keep the same compression level and any other attributes + that may have been set by deflateInit2. + + deflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent (such as zalloc or state being NULL). +*/ + +ZEXTERN int ZEXPORT deflateParams OF((z_streamp strm, + int level, + int strategy)); +/* + Dynamically update the compression level and compression strategy. The + interpretation of level and strategy is as in deflateInit2. This can be + used to switch between compression and straight copy of the input data, or + to switch to a different kind of input data requiring a different + strategy. If the compression level is changed, the input available so far + is compressed with the old level (and may be flushed); the new level will + take effect only at the next call of deflate(). + + Before the call of deflateParams, the stream state must be set as for + a call of deflate(), since the currently available input may have to + be compressed and flushed. In particular, strm->avail_out must be non-zero. + + deflateParams returns Z_OK if success, Z_STREAM_ERROR if the source + stream state was inconsistent or if a parameter was invalid, Z_BUF_ERROR + if strm->avail_out was zero. +*/ + +ZEXTERN int ZEXPORT deflateTune OF((z_streamp strm, + int good_length, + int max_lazy, + int nice_length, + int max_chain)); +/* + Fine tune deflate's internal compression parameters. This should only be + used by someone who understands the algorithm used by zlib's deflate for + searching for the best matching string, and even then only by the most + fanatic optimizer trying to squeeze out the last compressed bit for their + specific input data. Read the deflate.c source code for the meaning of the + max_lazy, good_length, nice_length, and max_chain parameters. + + deflateTune() can be called after deflateInit() or deflateInit2(), and + returns Z_OK on success, or Z_STREAM_ERROR for an invalid deflate stream. + */ + +ZEXTERN uLong ZEXPORT deflateBound OF((z_streamp strm, + uLong sourceLen)); +/* + deflateBound() returns an upper bound on the compressed size after + deflation of sourceLen bytes. It must be called after deflateInit() + or deflateInit2(). This would be used to allocate an output buffer + for deflation in a single pass, and so would be called before deflate(). +*/ + +ZEXTERN int ZEXPORT deflatePrime OF((z_streamp strm, + int bits, + int value)); +/* + deflatePrime() inserts bits in the deflate output stream. The intent + is that this function is used to start off the deflate output with the + bits leftover from a previous deflate stream when appending to it. As such, + this function can only be used for raw deflate, and must be used before the + first deflate() call after a deflateInit2() or deflateReset(). bits must be + less than or equal to 16, and that many of the least significant bits of + value will be inserted in the output. + + deflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*/ + +ZEXTERN int ZEXPORT deflateSetHeader OF((z_streamp strm, + gz_headerp head)); +/* + deflateSetHeader() provides gzip header information for when a gzip + stream is requested by deflateInit2(). deflateSetHeader() may be called + after deflateInit2() or deflateReset() and before the first call of + deflate(). The text, time, os, extra field, name, and comment information + in the provided gz_header structure are written to the gzip header (xflag is + ignored -- the extra flags are set according to the compression level). The + caller must assure that, if not Z_NULL, name and comment are terminated with + a zero byte, and that if extra is not Z_NULL, that extra_len bytes are + available there. If hcrc is true, a gzip header crc is included. Note that + the current versions of the command-line version of gzip (up through version + 1.3.x) do not support header crc's, and will report that it is a "multi-part + gzip file" and give up. + + If deflateSetHeader is not used, the default gzip header has text false, + the time set to zero, and os set to 255, with no extra, name, or comment + fields. The gzip header is returned to the default state by deflateReset(). + + deflateSetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*/ + +/* +ZEXTERN int ZEXPORT inflateInit2 OF((z_streamp strm, + int windowBits)); + + This is another version of inflateInit with an extra parameter. The + fields next_in, avail_in, zalloc, zfree and opaque must be initialized + before by the caller. + + The windowBits parameter is the base two logarithm of the maximum window + size (the size of the history buffer). It should be in the range 8..15 for + this version of the library. The default value is 15 if inflateInit is used + instead. windowBits must be greater than or equal to the windowBits value + provided to deflateInit2() while compressing, or it must be equal to 15 if + deflateInit2() was not used. If a compressed stream with a larger window + size is given as input, inflate() will return with the error code + Z_DATA_ERROR instead of trying to allocate a larger window. + + windowBits can also be -8..-15 for raw inflate. In this case, -windowBits + determines the window size. inflate() will then process raw deflate data, + not looking for a zlib or gzip header, not generating a check value, and not + looking for any check values for comparison at the end of the stream. This + is for use with other formats that use the deflate compressed data format + such as zip. Those formats provide their own check values. If a custom + format is developed using the raw deflate format for compressed data, it is + recommended that a check value such as an adler32 or a crc32 be applied to + the uncompressed data as is done in the zlib, gzip, and zip formats. For + most applications, the zlib format should be used as is. Note that comments + above on the use in deflateInit2() applies to the magnitude of windowBits. + + windowBits can also be greater than 15 for optional gzip decoding. Add + 32 to windowBits to enable zlib and gzip decoding with automatic header + detection, or add 16 to decode only the gzip format (the zlib format will + return a Z_DATA_ERROR). If a gzip stream is being decoded, strm->adler is + a crc32 instead of an adler32. + + inflateInit2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_STREAM_ERROR if a parameter is invalid (such as a null strm). msg + is set to null if there is no error message. inflateInit2 does not perform + any decompression apart from reading the zlib header if present: this will + be done by inflate(). (So next_in and avail_in may be modified, but next_out + and avail_out are unchanged.) +*/ + +ZEXTERN int ZEXPORT inflateSetDictionary OF((z_streamp strm, + const Bytef *dictionary, + uInt dictLength)); +/* + Initializes the decompression dictionary from the given uncompressed byte + sequence. This function must be called immediately after a call of inflate, + if that call returned Z_NEED_DICT. The dictionary chosen by the compressor + can be determined from the adler32 value returned by that call of inflate. + The compressor and decompressor must use exactly the same dictionary (see + deflateSetDictionary). For raw inflate, this function can be called + immediately after inflateInit2() or inflateReset() and before any call of + inflate() to set the dictionary. The application must insure that the + dictionary that was used for compression is provided. + + inflateSetDictionary returns Z_OK if success, Z_STREAM_ERROR if a + parameter is invalid (such as NULL dictionary) or the stream state is + inconsistent, Z_DATA_ERROR if the given dictionary doesn't match the + expected one (incorrect adler32 value). inflateSetDictionary does not + perform any decompression: this will be done by subsequent calls of + inflate(). +*/ + +ZEXTERN int ZEXPORT inflateSync OF((z_streamp strm)); +/* + Skips invalid compressed data until a full flush point (see above the + description of deflate with Z_FULL_FLUSH) can be found, or until all + available input is skipped. No output is provided. + + inflateSync returns Z_OK if a full flush point has been found, Z_BUF_ERROR + if no more input was provided, Z_DATA_ERROR if no flush point has been found, + or Z_STREAM_ERROR if the stream structure was inconsistent. In the success + case, the application may save the current current value of total_in which + indicates where valid compressed data was found. In the error case, the + application may repeatedly call inflateSync, providing more input each time, + until success or end of the input data. +*/ + +ZEXTERN int ZEXPORT inflateCopy OF((z_streamp dest, + z_streamp source)); +/* + Sets the destination stream as a complete copy of the source stream. + + This function can be useful when randomly accessing a large stream. The + first pass through the stream can periodically record the inflate state, + allowing restarting inflate at those points when randomly accessing the + stream. + + inflateCopy returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_STREAM_ERROR if the source stream state was inconsistent + (such as zalloc being NULL). msg is left unchanged in both source and + destination. +*/ + +ZEXTERN int ZEXPORT inflateReset OF((z_streamp strm)); +/* + This function is equivalent to inflateEnd followed by inflateInit, + but does not free and reallocate all the internal decompression state. + The stream will keep attributes that may have been set by inflateInit2. + + inflateReset returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent (such as zalloc or state being NULL). +*/ + +ZEXTERN int ZEXPORT inflatePrime OF((z_streamp strm, + int bits, + int value)); +/* + This function inserts bits in the inflate input stream. The intent is + that this function is used to start inflating at a bit position in the + middle of a byte. The provided bits will be used before any bytes are used + from next_in. This function should only be used with raw inflate, and + should be used before the first inflate() call after inflateInit2() or + inflateReset(). bits must be less than or equal to 16, and that many of the + least significant bits of value will be inserted in the input. + + inflatePrime returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*/ + +ZEXTERN int ZEXPORT inflateGetHeader OF((z_streamp strm, + gz_headerp head)); +/* + inflateGetHeader() requests that gzip header information be stored in the + provided gz_header structure. inflateGetHeader() may be called after + inflateInit2() or inflateReset(), and before the first call of inflate(). + As inflate() processes the gzip stream, head->done is zero until the header + is completed, at which time head->done is set to one. If a zlib stream is + being decoded, then head->done is set to -1 to indicate that there will be + no gzip header information forthcoming. Note that Z_BLOCK can be used to + force inflate() to return immediately after header processing is complete + and before any actual data is decompressed. + + The text, time, xflags, and os fields are filled in with the gzip header + contents. hcrc is set to true if there is a header CRC. (The header CRC + was valid if done is set to one.) If extra is not Z_NULL, then extra_max + contains the maximum number of bytes to write to extra. Once done is true, + extra_len contains the actual extra field length, and extra contains the + extra field, or that field truncated if extra_max is less than extra_len. + If name is not Z_NULL, then up to name_max characters are written there, + terminated with a zero unless the length is greater than name_max. If + comment is not Z_NULL, then up to comm_max characters are written there, + terminated with a zero unless the length is greater than comm_max. When + any of extra, name, or comment are not Z_NULL and the respective field is + not present in the header, then that field is set to Z_NULL to signal its + absence. This allows the use of deflateSetHeader() with the returned + structure to duplicate the header. However if those fields are set to + allocated memory, then the application will need to save those pointers + elsewhere so that they can be eventually freed. + + If inflateGetHeader is not used, then the header information is simply + discarded. The header is always checked for validity, including the header + CRC if present. inflateReset() will reset the process to discard the header + information. The application would need to call inflateGetHeader() again to + retrieve the header from the next gzip stream. + + inflateGetHeader returns Z_OK if success, or Z_STREAM_ERROR if the source + stream state was inconsistent. +*/ + +/* +ZEXTERN int ZEXPORT inflateBackInit OF((z_streamp strm, int windowBits, + unsigned char FAR *window)); + + Initialize the internal stream state for decompression using inflateBack() + calls. The fields zalloc, zfree and opaque in strm must be initialized + before the call. If zalloc and zfree are Z_NULL, then the default library- + derived memory allocation routines are used. windowBits is the base two + logarithm of the window size, in the range 8..15. window is a caller + supplied buffer of that size. Except for special applications where it is + assured that deflate was used with small window sizes, windowBits must be 15 + and a 32K byte window must be supplied to be able to decompress general + deflate streams. + + See inflateBack() for the usage of these routines. + + inflateBackInit will return Z_OK on success, Z_STREAM_ERROR if any of + the paramaters are invalid, Z_MEM_ERROR if the internal state could not + be allocated, or Z_VERSION_ERROR if the version of the library does not + match the version of the header file. +*/ + +typedef unsigned (*in_func) OF((void FAR *, unsigned char FAR * FAR *)); +typedef int (*out_func) OF((void FAR *, unsigned char FAR *, unsigned)); + +ZEXTERN int ZEXPORT inflateBack OF((z_streamp strm, + in_func in, void FAR *in_desc, + out_func out, void FAR *out_desc)); +/* + inflateBack() does a raw inflate with a single call using a call-back + interface for input and output. This is more efficient than inflate() for + file i/o applications in that it avoids copying between the output and the + sliding window by simply making the window itself the output buffer. This + function trusts the application to not change the output buffer passed by + the output function, at least until inflateBack() returns. + + inflateBackInit() must be called first to allocate the internal state + and to initialize the state with the user-provided window buffer. + inflateBack() may then be used multiple times to inflate a complete, raw + deflate stream with each call. inflateBackEnd() is then called to free + the allocated state. + + A raw deflate stream is one with no zlib or gzip header or trailer. + This routine would normally be used in a utility that reads zip or gzip + files and writes out uncompressed files. The utility would decode the + header and process the trailer on its own, hence this routine expects + only the raw deflate stream to decompress. This is different from the + normal behavior of inflate(), which expects either a zlib or gzip header and + trailer around the deflate stream. + + inflateBack() uses two subroutines supplied by the caller that are then + called by inflateBack() for input and output. inflateBack() calls those + routines until it reads a complete deflate stream and writes out all of the + uncompressed data, or until it encounters an error. The function's + parameters and return types are defined above in the in_func and out_func + typedefs. inflateBack() will call in(in_desc, &buf) which should return the + number of bytes of provided input, and a pointer to that input in buf. If + there is no input available, in() must return zero--buf is ignored in that + case--and inflateBack() will return a buffer error. inflateBack() will call + out(out_desc, buf, len) to write the uncompressed data buf[0..len-1]. out() + should return zero on success, or non-zero on failure. If out() returns + non-zero, inflateBack() will return with an error. Neither in() nor out() + are permitted to change the contents of the window provided to + inflateBackInit(), which is also the buffer that out() uses to write from. + The length written by out() will be at most the window size. Any non-zero + amount of input may be provided by in(). + + For convenience, inflateBack() can be provided input on the first call by + setting strm->next_in and strm->avail_in. If that input is exhausted, then + in() will be called. Therefore strm->next_in must be initialized before + calling inflateBack(). If strm->next_in is Z_NULL, then in() will be called + immediately for input. If strm->next_in is not Z_NULL, then strm->avail_in + must also be initialized, and then if strm->avail_in is not zero, input will + initially be taken from strm->next_in[0 .. strm->avail_in - 1]. + + The in_desc and out_desc parameters of inflateBack() is passed as the + first parameter of in() and out() respectively when they are called. These + descriptors can be optionally used to pass any information that the caller- + supplied in() and out() functions need to do their job. + + On return, inflateBack() will set strm->next_in and strm->avail_in to + pass back any unused input that was provided by the last in() call. The + return values of inflateBack() can be Z_STREAM_END on success, Z_BUF_ERROR + if in() or out() returned an error, Z_DATA_ERROR if there was a format + error in the deflate stream (in which case strm->msg is set to indicate the + nature of the error), or Z_STREAM_ERROR if the stream was not properly + initialized. In the case of Z_BUF_ERROR, an input or output error can be + distinguished using strm->next_in which will be Z_NULL only if in() returned + an error. If strm->next is not Z_NULL, then the Z_BUF_ERROR was due to + out() returning non-zero. (in() will always be called before out(), so + strm->next_in is assured to be defined if out() returns non-zero.) Note + that inflateBack() cannot return Z_OK. +*/ + +ZEXTERN int ZEXPORT inflateBackEnd OF((z_streamp strm)); +/* + All memory allocated by inflateBackInit() is freed. + + inflateBackEnd() returns Z_OK on success, or Z_STREAM_ERROR if the stream + state was inconsistent. +*/ + +ZEXTERN uLong ZEXPORT zlibCompileFlags OF((void)); +/* Return flags indicating compile-time options. + + Type sizes, two bits each, 00 = 16 bits, 01 = 32, 10 = 64, 11 = other: + 1.0: size of uInt + 3.2: size of uLong + 5.4: size of voidpf (pointer) + 7.6: size of z_off_t + + Compiler, assembler, and debug options: + 8: DEBUG + 9: ASMV or ASMINF -- use ASM code + 10: ZLIB_WINAPI -- exported functions use the WINAPI calling convention + 11: 0 (reserved) + + One-time table building (smaller code, but not thread-safe if true): + 12: BUILDFIXED -- build static block decoding tables when needed + 13: DYNAMIC_CRC_TABLE -- build CRC calculation tables when needed + 14,15: 0 (reserved) + + Library content (indicates missing functionality): + 16: NO_GZCOMPRESS -- gz* functions cannot compress (to avoid linking + deflate code when not needed) + 17: NO_GZIP -- deflate can't write gzip streams, and inflate can't detect + and decode gzip streams (to avoid linking crc code) + 18-19: 0 (reserved) + + Operation variations (changes in library functionality): + 20: PKZIP_BUG_WORKAROUND -- slightly more permissive inflate + 21: FASTEST -- deflate algorithm with only one, lowest compression level + 22,23: 0 (reserved) + + The sprintf variant used by gzprintf (zero is best): + 24: 0 = vs*, 1 = s* -- 1 means limited to 20 arguments after the format + 25: 0 = *nprintf, 1 = *printf -- 1 means gzprintf() not secure! + 26: 0 = returns value, 1 = void -- 1 means inferred string length returned + + Remainder: + 27-31: 0 (reserved) + */ + + + /* utility functions */ + +/* + The following utility functions are implemented on top of the + basic stream-oriented functions. To simplify the interface, some + default options are assumed (compression level and memory usage, + standard memory allocation functions). The source code of these + utility functions can easily be modified if you need special options. +*/ + +ZEXTERN int ZEXPORT compress OF((Bytef *dest, uLongf *destLen, + const Bytef *source, uLong sourceLen)); +/* + Compresses the source buffer into the destination buffer. sourceLen is + the byte length of the source buffer. Upon entry, destLen is the total + size of the destination buffer, which must be at least the value returned + by compressBound(sourceLen). Upon exit, destLen is the actual size of the + compressed buffer. + This function can be used to compress a whole file at once if the + input file is mmap'ed. + compress returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_BUF_ERROR if there was not enough room in the output + buffer. +*/ + +ZEXTERN int ZEXPORT compress2 OF((Bytef *dest, uLongf *destLen, + const Bytef *source, uLong sourceLen, + int level)); +/* + Compresses the source buffer into the destination buffer. The level + parameter has the same meaning as in deflateInit. sourceLen is the byte + length of the source buffer. Upon entry, destLen is the total size of the + destination buffer, which must be at least the value returned by + compressBound(sourceLen). Upon exit, destLen is the actual size of the + compressed buffer. + + compress2 returns Z_OK if success, Z_MEM_ERROR if there was not enough + memory, Z_BUF_ERROR if there was not enough room in the output buffer, + Z_STREAM_ERROR if the level parameter is invalid. +*/ + +ZEXTERN uLong ZEXPORT compressBound OF((uLong sourceLen)); +/* + compressBound() returns an upper bound on the compressed size after + compress() or compress2() on sourceLen bytes. It would be used before + a compress() or compress2() call to allocate the destination buffer. +*/ + +ZEXTERN int ZEXPORT uncompress OF((Bytef *dest, uLongf *destLen, + const Bytef *source, uLong sourceLen)); +/* + Decompresses the source buffer into the destination buffer. sourceLen is + the byte length of the source buffer. Upon entry, destLen is the total + size of the destination buffer, which must be large enough to hold the + entire uncompressed data. (The size of the uncompressed data must have + been saved previously by the compressor and transmitted to the decompressor + by some mechanism outside the scope of this compression library.) + Upon exit, destLen is the actual size of the compressed buffer. + This function can be used to decompress a whole file at once if the + input file is mmap'ed. + + uncompress returns Z_OK if success, Z_MEM_ERROR if there was not + enough memory, Z_BUF_ERROR if there was not enough room in the output + buffer, or Z_DATA_ERROR if the input data was corrupted or incomplete. +*/ + + +typedef voidp gzFile; + +ZEXTERN gzFile ZEXPORT gzopen OF((const char *path, const char *mode)); +/* + Opens a gzip (.gz) file for reading or writing. The mode parameter + is as in fopen ("rb" or "wb") but can also include a compression level + ("wb9") or a strategy: 'f' for filtered data as in "wb6f", 'h' for + Huffman only compression as in "wb1h", or 'R' for run-length encoding + as in "wb1R". (See the description of deflateInit2 for more information + about the strategy parameter.) + + gzopen can be used to read a file which is not in gzip format; in this + case gzread will directly read from the file without decompression. + + gzopen returns NULL if the file could not be opened or if there was + insufficient memory to allocate the (de)compression state; errno + can be checked to distinguish the two cases (if errno is zero, the + zlib error is Z_MEM_ERROR). */ + +ZEXTERN gzFile ZEXPORT gzdopen OF((int fd, const char *mode)); +/* + gzdopen() associates a gzFile with the file descriptor fd. File + descriptors are obtained from calls like open, dup, creat, pipe or + fileno (in the file has been previously opened with fopen). + The mode parameter is as in gzopen. + The next call of gzclose on the returned gzFile will also close the + file descriptor fd, just like fclose(fdopen(fd), mode) closes the file + descriptor fd. If you want to keep fd open, use gzdopen(dup(fd), mode). + gzdopen returns NULL if there was insufficient memory to allocate + the (de)compression state. +*/ + +ZEXTERN int ZEXPORT gzsetparams OF((gzFile file, int level, int strategy)); +/* + Dynamically update the compression level or strategy. See the description + of deflateInit2 for the meaning of these parameters. + gzsetparams returns Z_OK if success, or Z_STREAM_ERROR if the file was not + opened for writing. +*/ + +ZEXTERN int ZEXPORT gzread OF((gzFile file, voidp buf, unsigned len)); +/* + Reads the given number of uncompressed bytes from the compressed file. + If the input file was not in gzip format, gzread copies the given number + of bytes into the buffer. + gzread returns the number of uncompressed bytes actually read (0 for + end of file, -1 for error). */ + +ZEXTERN int ZEXPORT gzwrite OF((gzFile file, + voidpc buf, unsigned len)); +/* + Writes the given number of uncompressed bytes into the compressed file. + gzwrite returns the number of uncompressed bytes actually written + (0 in case of error). +*/ + +ZEXTERN int ZEXPORTVA gzprintf OF((gzFile file, const char *format, ...)); +/* + Converts, formats, and writes the args to the compressed file under + control of the format string, as in fprintf. gzprintf returns the number of + uncompressed bytes actually written (0 in case of error). The number of + uncompressed bytes written is limited to 4095. The caller should assure that + this limit is not exceeded. If it is exceeded, then gzprintf() will return + return an error (0) with nothing written. In this case, there may also be a + buffer overflow with unpredictable consequences, which is possible only if + zlib was compiled with the insecure functions sprintf() or vsprintf() + because the secure snprintf() or vsnprintf() functions were not available. +*/ + +ZEXTERN int ZEXPORT gzputs OF((gzFile file, const char *s)); +/* + Writes the given null-terminated string to the compressed file, excluding + the terminating null character. + gzputs returns the number of characters written, or -1 in case of error. +*/ + +ZEXTERN char * ZEXPORT gzgets OF((gzFile file, char *buf, int len)); +/* + Reads bytes from the compressed file until len-1 characters are read, or + a newline character is read and transferred to buf, or an end-of-file + condition is encountered. The string is then terminated with a null + character. + gzgets returns buf, or Z_NULL in case of error. +*/ + +ZEXTERN int ZEXPORT gzputc OF((gzFile file, int c)); +/* + Writes c, converted to an unsigned char, into the compressed file. + gzputc returns the value that was written, or -1 in case of error. +*/ + +ZEXTERN int ZEXPORT gzgetc OF((gzFile file)); +/* + Reads one byte from the compressed file. gzgetc returns this byte + or -1 in case of end of file or error. +*/ + +ZEXTERN int ZEXPORT gzungetc OF((int c, gzFile file)); +/* + Push one character back onto the stream to be read again later. + Only one character of push-back is allowed. gzungetc() returns the + character pushed, or -1 on failure. gzungetc() will fail if a + character has been pushed but not read yet, or if c is -1. The pushed + character will be discarded if the stream is repositioned with gzseek() + or gzrewind(). +*/ + +ZEXTERN int ZEXPORT gzflush OF((gzFile file, int flush)); +/* + Flushes all pending output into the compressed file. The parameter + flush is as in the deflate() function. The return value is the zlib + error number (see function gzerror below). gzflush returns Z_OK if + the flush parameter is Z_FINISH and all output could be flushed. + gzflush should be called only when strictly necessary because it can + degrade compression. +*/ + +ZEXTERN z_off_t ZEXPORT gzseek OF((gzFile file, + z_off_t offset, int whence)); +/* + Sets the starting position for the next gzread or gzwrite on the + given compressed file. The offset represents a number of bytes in the + uncompressed data stream. The whence parameter is defined as in lseek(2); + the value SEEK_END is not supported. + If the file is opened for reading, this function is emulated but can be + extremely slow. If the file is opened for writing, only forward seeks are + supported; gzseek then compresses a sequence of zeroes up to the new + starting position. + + gzseek returns the resulting offset location as measured in bytes from + the beginning of the uncompressed stream, or -1 in case of error, in + particular if the file is opened for writing and the new starting position + would be before the current position. +*/ + +ZEXTERN int ZEXPORT gzrewind OF((gzFile file)); +/* + Rewinds the given file. This function is supported only for reading. + + gzrewind(file) is equivalent to (int)gzseek(file, 0L, SEEK_SET) +*/ + +ZEXTERN z_off_t ZEXPORT gztell OF((gzFile file)); +/* + Returns the starting position for the next gzread or gzwrite on the + given compressed file. This position represents a number of bytes in the + uncompressed data stream. + + gztell(file) is equivalent to gzseek(file, 0L, SEEK_CUR) +*/ + +ZEXTERN int ZEXPORT gzeof OF((gzFile file)); +/* + Returns 1 when EOF has previously been detected reading the given + input stream, otherwise zero. +*/ + +ZEXTERN int ZEXPORT gzdirect OF((gzFile file)); +/* + Returns 1 if file is being read directly without decompression, otherwise + zero. +*/ + +ZEXTERN int ZEXPORT gzclose OF((gzFile file)); +/* + Flushes all pending output if necessary, closes the compressed file + and deallocates all the (de)compression state. The return value is the zlib + error number (see function gzerror below). +*/ + +ZEXTERN const char * ZEXPORT gzerror OF((gzFile file, int *errnum)); +/* + Returns the error message for the last error which occurred on the + given compressed file. errnum is set to zlib error number. If an + error occurred in the file system and not in the compression library, + errnum is set to Z_ERRNO and the application may consult errno + to get the exact error code. +*/ + +ZEXTERN void ZEXPORT gzclearerr OF((gzFile file)); +/* + Clears the error and end-of-file flags for file. This is analogous to the + clearerr() function in stdio. This is useful for continuing to read a gzip + file that is being written concurrently. +*/ + + /* checksum functions */ + +/* + These functions are not related to compression but are exported + anyway because they might be useful in applications using the + compression library. +*/ + +ZEXTERN uLong ZEXPORT adler32 OF((uLong adler, const Bytef *buf, uInt len)); +/* + Update a running Adler-32 checksum with the bytes buf[0..len-1] and + return the updated checksum. If buf is NULL, this function returns + the required initial value for the checksum. + An Adler-32 checksum is almost as reliable as a CRC32 but can be computed + much faster. Usage example: + + uLong adler = adler32(0L, Z_NULL, 0); + + while (read_buffer(buffer, length) != EOF) { + adler = adler32(adler, buffer, length); + } + if (adler != original_adler) error(); +*/ + +ZEXTERN uLong ZEXPORT adler32_combine OF((uLong adler1, uLong adler2, + z_off_t len2)); +/* + Combine two Adler-32 checksums into one. For two sequences of bytes, seq1 + and seq2 with lengths len1 and len2, Adler-32 checksums were calculated for + each, adler1 and adler2. adler32_combine() returns the Adler-32 checksum of + seq1 and seq2 concatenated, requiring only adler1, adler2, and len2. +*/ + +ZEXTERN uLong ZEXPORT crc32 OF((uLong crc, const Bytef *buf, uInt len)); +/* + Update a running CRC-32 with the bytes buf[0..len-1] and return the + updated CRC-32. If buf is NULL, this function returns the required initial + value for the for the crc. Pre- and post-conditioning (one's complement) is + performed within this function so it shouldn't be done by the application. + Usage example: + + uLong crc = crc32(0L, Z_NULL, 0); + + while (read_buffer(buffer, length) != EOF) { + crc = crc32(crc, buffer, length); + } + if (crc != original_crc) error(); +*/ + +ZEXTERN uLong ZEXPORT crc32_combine OF((uLong crc1, uLong crc2, z_off_t len2)); + +/* + Combine two CRC-32 check values into one. For two sequences of bytes, + seq1 and seq2 with lengths len1 and len2, CRC-32 check values were + calculated for each, crc1 and crc2. crc32_combine() returns the CRC-32 + check value of seq1 and seq2 concatenated, requiring only crc1, crc2, and + len2. +*/ + + + /* various hacks, don't look :) */ + +/* deflateInit and inflateInit are macros to allow checking the zlib version + * and the compiler's view of z_stream: + */ +ZEXTERN int ZEXPORT deflateInit_ OF((z_streamp strm, int level, + const char *version, int stream_size)); +ZEXTERN int ZEXPORT inflateInit_ OF((z_streamp strm, + const char *version, int stream_size)); +ZEXTERN int ZEXPORT deflateInit2_ OF((z_streamp strm, int level, int method, + int windowBits, int memLevel, + int strategy, const char *version, + int stream_size)); +ZEXTERN int ZEXPORT inflateInit2_ OF((z_streamp strm, int windowBits, + const char *version, int stream_size)); +ZEXTERN int ZEXPORT inflateBackInit_ OF((z_streamp strm, int windowBits, + unsigned char FAR *window, + const char *version, + int stream_size)); +#define deflateInit(strm, level) \ + deflateInit_((strm), (level), ZLIB_VERSION, sizeof(z_stream)) +#define inflateInit(strm) \ + inflateInit_((strm), ZLIB_VERSION, sizeof(z_stream)) +#define deflateInit2(strm, level, method, windowBits, memLevel, strategy) \ + deflateInit2_((strm),(level),(method),(windowBits),(memLevel),\ + (strategy), ZLIB_VERSION, sizeof(z_stream)) +#define inflateInit2(strm, windowBits) \ + inflateInit2_((strm), (windowBits), ZLIB_VERSION, sizeof(z_stream)) +#define inflateBackInit(strm, windowBits, window) \ + inflateBackInit_((strm), (windowBits), (window), \ + ZLIB_VERSION, sizeof(z_stream)) + + +#if !defined(ZUTIL_H) && !defined(NO_DUMMY_DECL) + struct internal_state {int dummy;}; /* hack for buggy compilers */ +#endif + +ZEXTERN const char * ZEXPORT zError OF((int)); +ZEXTERN int ZEXPORT inflateSyncPoint OF((z_streamp z)); +ZEXTERN const uLongf * ZEXPORT get_crc_table OF((void)); + +#ifdef __cplusplus +} +#endif + +#endif /* ZLIB_H */ diff --git a/erts/emulator/zlib/zutil.c b/erts/emulator/zlib/zutil.c new file mode 100644 index 0000000000..fa5b43126a --- /dev/null +++ b/erts/emulator/zlib/zutil.c @@ -0,0 +1,327 @@ +/* zutil.c -- target dependent utility functions for the compression library + * Copyright (C) 1995-2005 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* @(#) $Id$ */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "zutil.h" + +#ifndef NO_DUMMY_DECL +struct internal_state {int dummy;}; /* for buggy compilers */ +#endif + +const char * const z_errmsg[10] = { +"need dictionary", /* Z_NEED_DICT 2 */ +"stream end", /* Z_STREAM_END 1 */ +"", /* Z_OK 0 */ +"file error", /* Z_ERRNO (-1) */ +"stream error", /* Z_STREAM_ERROR (-2) */ +"data error", /* Z_DATA_ERROR (-3) */ +"insufficient memory", /* Z_MEM_ERROR (-4) */ +"buffer error", /* Z_BUF_ERROR (-5) */ +"incompatible version",/* Z_VERSION_ERROR (-6) */ +""}; + + +const char * ZEXPORT zlibVersion() +{ + return ZLIB_VERSION; +} + +uLong ZEXPORT zlibCompileFlags() +{ + uLong flags; + + flags = 0; + switch (sizeof(uInt)) { + case 2: break; + case 4: flags += 1; break; + case 8: flags += 2; break; + default: flags += 3; + } + switch (sizeof(uLong)) { + case 2: break; + case 4: flags += 1 << 2; break; + case 8: flags += 2 << 2; break; + default: flags += 3 << 2; + } + switch (sizeof(voidpf)) { + case 2: break; + case 4: flags += 1 << 4; break; + case 8: flags += 2 << 4; break; + default: flags += 3 << 4; + } + switch (sizeof(z_off_t)) { + case 2: break; + case 4: flags += 1 << 6; break; + case 8: flags += 2 << 6; break; + default: flags += 3 << 6; + } +#ifdef DEBUG + flags += 1 << 8; +#endif +#if defined(ASMV) || defined(ASMINF) + flags += 1 << 9; +#endif +#ifdef ZLIB_WINAPI + flags += 1 << 10; +#endif +#ifdef BUILDFIXED + flags += 1 << 12; +#endif +#ifdef DYNAMIC_CRC_TABLE + flags += 1 << 13; +#endif +#ifdef NO_GZCOMPRESS + flags += 1L << 16; +#endif +#ifdef NO_GZIP + flags += 1L << 17; +#endif +#ifdef PKZIP_BUG_WORKAROUND + flags += 1L << 20; +#endif +#ifdef FASTEST + flags += 1L << 21; +#endif +#ifdef STDC +# ifdef NO_vsnprintf + flags += 1L << 25; +# ifdef HAS_vsprintf_void + flags += 1L << 26; +# endif +# else +# ifdef HAS_vsnprintf_void + flags += 1L << 26; +# endif +# endif +#else + flags += 1L << 24; +# ifdef NO_snprintf + flags += 1L << 25; +# ifdef HAS_sprintf_void + flags += 1L << 26; +# endif +# else +# ifdef HAS_snprintf_void + flags += 1L << 26; +# endif +# endif +#endif + return flags; +} + +#ifdef DEBUG + +# ifndef verbose +# define verbose 0 +# endif +int z_verbose = verbose; + +void z_error (m) + char *m; +{ + fprintf(stderr, "%s\n", m); + exit(1); +} +#endif + +/* exported to allow conversion of error code to string for compress() and + * uncompress() + */ +const char * ZEXPORT zError(err) + int err; +{ + return ERR_MSG(err); +} + +#if defined(_WIN32_WCE) + /* The Microsoft C Run-Time Library for Windows CE doesn't have + * errno. We define it as a global variable to simplify porting. + * Its value is always 0 and should not be used. + */ + int errno = 0; +#endif + +#ifndef HAVE_MEMCPY + +void zmemcpy(dest, source, len) + Bytef* dest; + const Bytef* source; + uInt len; +{ + if (len == 0) return; + do { + *dest++ = *source++; /* ??? to be unrolled */ + } while (--len != 0); +} + +int zmemcmp(s1, s2, len) + const Bytef* s1; + const Bytef* s2; + uInt len; +{ + uInt j; + + for (j = 0; j < len; j++) { + if (s1[j] != s2[j]) return 2*(s1[j] > s2[j])-1; + } + return 0; +} + +void zmemzero(dest, len) + Bytef* dest; + uInt len; +{ + if (len == 0) return; + do { + *dest++ = 0; /* ??? to be unrolled */ + } while (--len != 0); +} +#endif + + +#ifdef SYS16BIT + +#ifdef __TURBOC__ +/* Turbo C in 16-bit mode */ + +# define MY_ZCALLOC + +/* Turbo C malloc() does not allow dynamic allocation of 64K bytes + * and farmalloc(64K) returns a pointer with an offset of 8, so we + * must fix the pointer. Warning: the pointer must be put back to its + * original form in order to free it, use zcfree(). + */ + +#define MAX_PTR 10 +/* 10*64K = 640K */ + +local int next_ptr = 0; + +typedef struct ptr_table_s { + voidpf org_ptr; + voidpf new_ptr; +} ptr_table; + +local ptr_table table[MAX_PTR]; +/* This table is used to remember the original form of pointers + * to large buffers (64K). Such pointers are normalized with a zero offset. + * Since MSDOS is not a preemptive multitasking OS, this table is not + * protected from concurrent access. This hack doesn't work anyway on + * a protected system like OS/2. Use Microsoft C instead. + */ + +voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) +{ + voidpf buf = opaque; /* just to make some compilers happy */ + ulg bsize = (ulg)items*size; + + /* If we allocate less than 65520 bytes, we assume that farmalloc + * will return a usable pointer which doesn't have to be normalized. + */ + if (bsize < 65520L) { + buf = farmalloc(bsize); + if (*(ush*)&buf != 0) return buf; + } else { + buf = farmalloc(bsize + 16L); + } + if (buf == NULL || next_ptr >= MAX_PTR) return NULL; + table[next_ptr].org_ptr = buf; + + /* Normalize the pointer to seg:0 */ + *((ush*)&buf+1) += ((ush)((uch*)buf-0) + 15) >> 4; + *(ush*)&buf = 0; + table[next_ptr++].new_ptr = buf; + return buf; +} + +void zcfree (voidpf opaque, voidpf ptr) +{ + int n; + if (*(ush*)&ptr != 0) { /* object < 64K */ + farfree(ptr); + return; + } + /* Find the original pointer */ + for (n = 0; n < next_ptr; n++) { + if (ptr != table[n].new_ptr) continue; + + farfree(table[n].org_ptr); + while (++n < next_ptr) { + table[n-1] = table[n]; + } + next_ptr--; + return; + } + ptr = opaque; /* just to make some compilers happy */ + Assert(0, "zcfree: ptr not found"); +} + +#endif /* __TURBOC__ */ + + +#ifdef M_I86 +/* Microsoft C in 16-bit mode */ + +# define MY_ZCALLOC + +#if (!defined(_MSC_VER) || (_MSC_VER <= 600)) +# define _halloc halloc +# define _hfree hfree +#endif + +voidpf zcalloc (voidpf opaque, unsigned items, unsigned size) +{ + if (opaque) opaque = 0; /* to make compiler happy */ + return _halloc((long)items, size); +} + +void zcfree (voidpf opaque, voidpf ptr) +{ + if (opaque) opaque = 0; /* to make compiler happy */ + _hfree(ptr); +} + +#endif /* M_I86 */ + +#endif /* SYS16BIT */ + + +#ifndef MY_ZCALLOC /* Any system without a special alloc function */ + +#ifndef STDC +extern voidp malloc OF((uInt size)); +extern voidp calloc OF((uInt items, uInt size)); +extern void free OF((voidpf ptr)); +#endif + +extern void* sys_alloc(unsigned); +extern void* sys_free(void *); + +voidpf zcalloc (opaque, items, size) + voidpf opaque; + unsigned items; + unsigned size; +{ + unsigned sz = items * size; + voidpf* ptr = (voidpf) sys_alloc(sz); + if (opaque) items += size - size; /* make compiler happy */ + return ptr; +} + +void zcfree (opaque, ptr) + voidpf opaque; + voidpf ptr; +{ + sys_free(ptr); + if (opaque) return; /* make compiler happy */ +} + +#endif /* MY_ZCALLOC */ diff --git a/erts/emulator/zlib/zutil.h b/erts/emulator/zlib/zutil.h new file mode 100644 index 0000000000..d560382691 --- /dev/null +++ b/erts/emulator/zlib/zutil.h @@ -0,0 +1,271 @@ +/* zutil.h -- internal interface and configuration of the compression library + * Copyright (C) 1995-2005 Jean-loup Gailly. + * For conditions of distribution and use, see copyright notice in zlib.h + */ + +/* %ExternalCopyright% */ + +/* WARNING: this file should *not* be used by applications. It is + part of the implementation of the compression library and is + subject to change. Applications should only use zlib.h. + */ + +/* @(#) $Id$ */ + +#ifndef ZUTIL_H +#define ZUTIL_H + +#define ZLIB_INTERNAL +#include "zlib.h" + +#ifdef STDC +# ifndef _WIN32_WCE +# include +# endif +# include +# include +#endif +#ifdef NO_ERRNO_H +# ifdef _WIN32_WCE + /* The Microsoft C Run-Time Library for Windows CE doesn't have + * errno. We define it as a global variable to simplify porting. + * Its value is always 0 and should not be used. We rename it to + * avoid conflict with other libraries that use the same workaround. + */ +# define errno z_errno +# endif + extern int errno; +#else +# ifndef _WIN32_WCE +# include +# endif +#endif + +#ifndef local +# define local static +#endif +/* compile with -Dlocal if your debugger can't find static symbols */ + +typedef unsigned char uch; +typedef uch FAR uchf; +typedef unsigned short ush; +typedef ush FAR ushf; +typedef unsigned long ulg; + +extern const char * const z_errmsg[10]; /* indexed by 2-zlib_error */ +/* (size given to avoid silly warnings with Visual C++) */ + +#define ERR_MSG(err) z_errmsg[Z_NEED_DICT-(err)] + +#define ERR_RETURN(strm,err) \ + return (strm->msg = (char*)ERR_MSG(err), (err)) +/* To be used only when the state is known to be valid */ + + /* common constants */ + +#ifndef DEF_WBITS +# define DEF_WBITS MAX_WBITS +#endif +/* default windowBits for decompression. MAX_WBITS is for compression only */ + +#if MAX_MEM_LEVEL >= 8 +# define DEF_MEM_LEVEL 8 +#else +# define DEF_MEM_LEVEL MAX_MEM_LEVEL +#endif +/* default memLevel */ + +#define STORED_BLOCK 0 +#define STATIC_TREES 1 +#define DYN_TREES 2 +/* The three kinds of block type */ + +#define MIN_MATCH 3 +#define MAX_MATCH 258 +/* The minimum and maximum match lengths */ + +#define PRESET_DICT 0x20 /* preset dictionary flag in zlib header */ + + /* target dependencies */ + +#if defined(MSDOS) || (defined(WINDOWS) && !defined(WIN32)) +# define OS_CODE 0x00 +# if defined(__TURBOC__) || defined(__BORLANDC__) +# if(__STDC__ == 1) && (defined(__LARGE__) || defined(__COMPACT__)) + /* Allow compilation with ANSI keywords only enabled */ + void _Cdecl farfree( void *block ); + void *_Cdecl farmalloc( unsigned long nbytes ); +# else +# include +# endif +# else /* MSC or DJGPP */ +# include +# endif +#endif + +#ifdef AMIGA +# define OS_CODE 0x01 +#endif + +#if defined(VAXC) || defined(VMS) +# define OS_CODE 0x02 +# define F_OPEN(name, mode) \ + fopen((name), (mode), "mbc=60", "ctx=stm", "rfm=fix", "mrs=512") +#endif + +#if defined(ATARI) || defined(atarist) +# define OS_CODE 0x05 +#endif + +#ifdef OS2 +# define OS_CODE 0x06 +# ifdef M_I86 + #include +# endif +#endif + +#if defined(MACOS) || defined(TARGET_OS_MAC) +# define OS_CODE 0x07 +# if defined(__MWERKS__) && __dest_os != __be_os && __dest_os != __win32_os +# include /* for fdopen */ +# else +# ifndef fdopen +# define fdopen(fd,mode) NULL /* No fdopen() */ +# endif +# endif +#endif + +#ifdef TOPS20 +# define OS_CODE 0x0a +#endif + +#ifdef WIN32 +# ifndef __CYGWIN__ /* Cygwin is Unix, not Win32 */ +# define OS_CODE 0x0b +# endif +#endif + +#ifdef __50SERIES /* Prime/PRIMOS */ +# define OS_CODE 0x0f +#endif + +#if defined(_BEOS_) || defined(RISCOS) +# define fdopen(fd,mode) NULL /* No fdopen() */ +#endif + +#if (defined(_MSC_VER) && (_MSC_VER > 600)) +# if defined(_WIN32_WCE) +# define fdopen(fd,mode) NULL /* No fdopen() */ +# ifndef _PTRDIFF_T_DEFINED + typedef int ptrdiff_t; +# define _PTRDIFF_T_DEFINED +# endif +# else +# define fdopen(fd,type) _fdopen(fd,type) +# endif +#endif + + /* common defaults */ + +#ifndef OS_CODE +# define OS_CODE 0x03 /* assume Unix */ +#endif + +#ifndef F_OPEN +# define F_OPEN(name, mode) fopen((name), (mode)) +#endif + + /* functions */ + +#if defined(STDC99) || (defined(__TURBOC__) && __TURBOC__ >= 0x550) +# ifndef HAVE_VSNPRINTF +# define HAVE_VSNPRINTF +# endif +#endif +#if defined(__CYGWIN__) +# ifndef HAVE_VSNPRINTF +# define HAVE_VSNPRINTF +# endif +#endif +#ifndef HAVE_VSNPRINTF +# ifdef MSDOS + /* vsnprintf may exist on some MS-DOS compilers (DJGPP?), + but for now we just assume it doesn't. */ +# define NO_vsnprintf +# endif +# ifdef __TURBOC__ +# define NO_vsnprintf +# endif +# ifdef WIN32 + /* In Win32, vsnprintf is available as the "non-ANSI" _vsnprintf. */ +# if !defined(vsnprintf) && !defined(NO_vsnprintf) +# define vsnprintf _vsnprintf +# endif +# endif +# ifdef __SASC +# define NO_vsnprintf +# endif +#endif +#ifdef VMS +# define NO_vsnprintf +#endif + +#if defined(pyr) +# define NO_MEMCPY +#endif +#if defined(SMALL_MEDIUM) && !defined(_MSC_VER) && !defined(__SC__) + /* Use our own functions for small and medium model with MSC <= 5.0. + * You may have to use the same strategy for Borland C (untested). + * The __SC__ check is for Symantec. + */ +# define NO_MEMCPY +#endif +#if defined(STDC) && !defined(HAVE_MEMCPY) && !defined(NO_MEMCPY) +# define HAVE_MEMCPY +#endif +#ifdef HAVE_MEMCPY +# ifdef SMALL_MEDIUM /* MSDOS small or medium model */ +# define zmemcpy _fmemcpy +# define zmemcmp _fmemcmp +# define zmemzero(dest, len) _fmemset(dest, 0, len) +# else +# define zmemcpy memcpy +# define zmemcmp memcmp +# define zmemzero(dest, len) memset(dest, 0, len) +# endif +#else + extern void zmemcpy OF((Bytef* dest, const Bytef* source, uInt len)); + extern int zmemcmp OF((const Bytef* s1, const Bytef* s2, uInt len)); + extern void zmemzero OF((Bytef* dest, uInt len)); +#endif + +/* Diagnostic functions */ +#ifdef DEBUG +# include + extern int z_verbose; + extern void z_error OF((char *m)); +# define Assert(cond,msg) {if(!(cond)) z_error(msg);} +# define Trace(x) {if (z_verbose>=0) fprintf x ;} +# define Tracev(x) {if (z_verbose>0) fprintf x ;} +# define Tracevv(x) {if (z_verbose>1) fprintf x ;} +# define Tracec(c,x) {if (z_verbose>0 && (c)) fprintf x ;} +# define Tracecv(c,x) {if (z_verbose>1 && (c)) fprintf x ;} +#else +# define Assert(cond,msg) +# define Trace(x) +# define Tracev(x) +# define Tracevv(x) +# define Tracec(c,x) +# define Tracecv(c,x) +#endif + + +voidpf zcalloc OF((voidpf opaque, unsigned items, unsigned size)); +void zcfree OF((voidpf opaque, voidpf ptr)); + +#define ZALLOC(strm, items, size) \ + (*((strm)->zalloc))((strm)->opaque, (items), (size)) +#define ZFREE(strm, addr) (*((strm)->zfree))((strm)->opaque, (voidpf)(addr)) +#define TRY_FREE(s, p) {if (p) ZFREE(s, p);} + +#endif /* ZUTIL_H */ diff --git a/erts/epmd/Makefile b/erts/epmd/Makefile new file mode 100644 index 0000000000..4c1af393ac --- /dev/null +++ b/erts/epmd/Makefile @@ -0,0 +1,32 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Common Macros +# ---------------------------------------------------- +SUB_DIRECTORIES = src + +SPECIAL_TARGETS = + +# ---------------------------------------------------- +# Default Subdir Targets +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_subdir.mk diff --git a/erts/epmd/doc/.gitignore b/erts/epmd/doc/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/epmd/epmd.mk b/erts/epmd/epmd.mk new file mode 100644 index 0000000000..a73f4bc077 --- /dev/null +++ b/erts/epmd/epmd.mk @@ -0,0 +1,70 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# ------------------------------------------------ +# Server defines +# + +# EPMD port number +# 4365 - Version 4.2 TCP +# 4366 - Version 4.3 TCP +# 4368 - Version 4.4.0 - 4.6.2 TCP +# 4369 - Version 4.6.3 - 4.7.4 TCP/UDP +EPMD_PORT_NO=4369 + + +# ------------------------------------------------ +# Client defines +# + +# Node type: +# 72 = R3 hidden node +# 77 = R3 erlang node +# 104 = R4 hidden node +# 109 = R4 erlang node +# (110 = R6 nodes (explicit flags for differences between nodes)) +# +# What epmd has been told, differs very much between versions, both +# 111 and 110 seems to have been used to tell epmd, while +# the actual nodetypes has still been 104 and 109. +# EPMD does not care about this, why we move back to using +# the correct tag (an 'n') for all nodes. +# +EPMD_NODE_TYPE=110 + +# Lowest/Highest supported version of the distribution protocol: +# 0 = R3 +# 1 = R4 +# 2 = R5 ????? +# 3 = R5C +# 4 = R6 (development) +# 5 = R6 +# There was no protocol change in release R5, so we didn't need to raise +# the version number. But now that R5A is released, it's best to keep it +# this way. +# The number was inadvertently raised for R5C, so we increase it again +# for R6. +# Distribution version 4 means a) distributed monitor and b) larger references +# in the distribution format. +# In format 5, nodes can explicitly tell each other which of the above +# mentioned capabilities they can handle. +# Distribution format 5 contains the new md5 based handshake. + +EPMD_DIST_LOW=5 +EPMD_DIST_HIGH=5 + diff --git a/erts/epmd/src/Makefile b/erts/epmd/src/Makefile new file mode 100644 index 0000000000..7d586c7438 --- /dev/null +++ b/erts/epmd/src/Makefile @@ -0,0 +1,22 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Invoke with GNU make or clearmake -C gnu. +# + +include $(ERL_TOP)/make/run_make.mk diff --git a/erts/epmd/src/Makefile.in b/erts/epmd/src/Makefile.in new file mode 100644 index 0000000000..498756b468 --- /dev/null +++ b/erts/epmd/src/Makefile.in @@ -0,0 +1,123 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk + + +ifeq ($(TYPE),debug) +PURIFY = +TYPEMARKER = .debug +TYPE_FLAGS = -DDEBUG @DEBUG_FLAGS@ +else +ifeq ($(TYPE),purify) +PURIFY = purify +TYPEMARKER = +ifeq ($(findstring ose,$(TARGET)),ose) + TYPE_FLAGS = -DPURIFY +else + TYPE_FLAGS = -O2 -DPURIFY +endif +else +PURIFY = +TYPEMARKER = +ifeq ($(findstring ose,$(TARGET)),ose) + TYPE_FLAGS = +else + TYPE_FLAGS = -O2 +endif +endif +endif + +include $(ERL_TOP)/make/$(TARGET)/otp.mk +include ../../vsn.mk +include ../epmd.mk + +BINDIR = $(ERL_TOP)/bin/$(TARGET) +OBJDIR = $(ERL_TOP)/erts/obj$(TYPEMARKER)/$(TARGET) + +CC = @CC@ +WFLAGS = @WFLAGS@ +CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) $(WFLAGS) +LD = @LD@ +LIBS = @LIBS@ +LDFLAGS = @LDFLAGS@ + + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- + +# The targets +ifeq ($(findstring win32,$(TARGET)),win32) +EPMD = epmd.exe +else +EPMD = epmd +endif + +INSTALL_PROGS = $(BINDIR)/$(EPMD) + +#--------------------------------- +# Options +#--------------------------------- + +EPMD_FLAGS = -DEPMD_PORT_NO=$(EPMD_PORT_NO) + +#--------------------------------- +# source and object file information +#--------------------------------- + +EPMD_OBJS = $(OBJDIR)/epmd.o \ + $(OBJDIR)/epmd_cli.o \ + $(OBJDIR)/epmd_srv.o + +#--------------------------------- +# Build targets +#--------------------------------- + + +all: $(BINDIR)/$(EPMD) + +docs: + +clean: + rm -f $(BINDIR)/$(EPMD) + rm -f $(ERL_TOP)/erts/obj/$(TARGET)/epmd.o + rm -f $(ERL_TOP)/erts/obj/$(TARGET)/epmd_cli.o + rm -f $(ERL_TOP)/erts/obj/$(TARGET)/epmd_srv.o + rm -f *.o + rm -f *~ core + +# +# Objects & executables +# + +$(BINDIR)/$(EPMD): $(EPMD_OBJS) + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(EPMD_OBJS) $(LIBS) + +$(OBJDIR)/%.o: %.c + $(CC) $(CFLAGS) $(EPMD_FLAGS) -o $@ -c $< + +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: all + $(INSTALL_DIR) $(RELEASE_PATH)/erts-$(VSN)/bin + $(INSTALL_PROGRAM) $(INSTALL_PROGS) $(RELEASE_PATH)/erts-$(VSN)/bin + + +release_docs_spec: + diff --git a/erts/epmd/src/epmd.c b/erts/epmd/src/epmd.c new file mode 100644 index 0000000000..23ac421446 --- /dev/null +++ b/erts/epmd/src/epmd.c @@ -0,0 +1,629 @@ +/* -*- c-indent-level: 2; c-continued-statement-offset: 2 -*- */ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "epmd.h" /* Renamed from 'epmd_r4.h' */ +#include "epmd_int.h" + +#ifdef _OSE_ +# include "ose.h" +# include "efs.h" +#endif + +#ifdef HAVE_STDLIB_H +# include +#endif + +/* forward declarations */ + +static void usage(EpmdVars *); +static void run_daemon(EpmdVars*); +static int get_port_no(void); +#ifdef __WIN32__ +static int has_console(void); +#endif + +#ifdef DONT_USE_MAIN + +static int epmd_main(int, char **, int); + +/* VxWorks fill 10 stack words with zero when a function is called + from the shell. So it is safe to have argv and argc as parameters + even if they are not given in the call. */ + +#define MAX_DEBUG 10 + +int epmd_dbg(int level,int port) /* Utility to debug epmd... */ +{ + char* argv[MAX_DEBUG+2]; + char ibuff[100]; + int argc = 0; + + argv[argc++] = "epmd"; + if(level > MAX_DEBUG) + level = MAX_DEBUG; + for(;level;--level) + argv[argc++] = "-d"; + if(port) + { + argv[argc++] = "-port"; + sprintf(ibuff,"%d",port); + argv[argc++] = ibuff; + } + argv[argc] = NULL; + + return epmd(argc,argv); + +} + +static char *mystrdup(char *s) +{ + char *r = malloc(strlen(s)+1); + strcpy(r,s); + return r; +} + +#ifdef _OSE_ + +struct args_sig { + SIGSELECT sig_no; + int argc ; + char argv[20][20]; +}; + +union SIGNAL { + SIGSELECT sig_no; + struct args_sig args; +}; + +/* Start function. It may be called from the start script as well as from + the OSE shell directly (using late start hooks). It spawns epmd as an + OSE process which calls the epmd main function. */ +int start_ose_epmd(int argc, char **argv) { + union SIGNAL *sig; + PROCESS epmd_; + OSENTRYPOINT ose_epmd; + int i; + + if(hunt("epmd", 0, &epmd_, NULL)) { + fprintf(stderr, "Warning! EPMD already exists (%u).\n", epmd_); + return 0; + } + else { + /* copy start args to signal */ + sig = alloc(sizeof(struct args_sig), 0); + sig->args.argc = argc; + for(i=0; iargs.argv)[i], argv[i]); + } + /* start epmd and send signal */ + epmd_ = create_process(OS_BG_PROC, /* processtype */ + "epmd", /* name */ + ose_epmd, /* entrypoint */ + 16383, /* stacksize */ + 20, /* priority */ + 0, /* timeslice */ + 0, /* block */ + NULL,0,0); /* not used */ + efs_clone(epmd_); + start(epmd_); + send(&sig, epmd_); +#ifdef DEBUG + printf("EPMD ID: %li\n", epmd_); +#endif + } + return 0; +} + +OS_PROCESS(ose_epmd) { + union SIGNAL *sig; + static const SIGSELECT rec_any_sig[] = { 0 }; + int i, argc; + char **argv; + + sig = receive((SIGSELECT*)rec_any_sig); + + argc = sig->args.argc; + argv = (char **)malloc((argc+1)*sizeof(char *)); + for(i=0; iargs.argv)[i])+1); + strcpy(argv[i], (sig->args.argv)[i]); + } + argv[argc] = NULL; + free_buf(&sig); + + epmd(argc, argv); + + for(i=0; i= tmpsiz) + tmp = realloc(tmp, tmpsiz = (strlen(argarr[i])+1)); + strcpy(tmp,argarr[i]); + for(token = strtok_r(tmp," ",&pplast); + token != NULL; + token = strtok_r(NULL," ",&pplast)) + { + if(argc >= argvsiz - 1) + argv = realloc(argv,sizeof(char *) * (argvsiz += 10)); + argv[argc++] = mystrdup(token); + argv[argc] = NULL; + } + } + free(tmp); + return taskSpawn("epmd",100,VX_FP_TASK,20000,epmd_main, + argc,(int) argv,1, + 0,0,0,0,0,0,0); +} + +#endif /* _OSE_ */ + + + + +int epmd(int argc, char **argv) +{ + return epmd_main(argc,argv,0); +} + +static int epmd_main(int argc, char** argv, int free_argv) +#else +int main(int argc, char** argv) +#endif /* DONT_USE_MAIN */ +{ + EpmdVars g_empd_vars; + EpmdVars *g = &g_empd_vars; +#ifdef __WIN32__ + WORD wVersionRequested; + WSADATA wsaData; + int err; + + wVersionRequested = MAKEWORD(1, 1); + + err = WSAStartup(wVersionRequested, &wsaData); + if (err != 0) + epmd_cleanup_exit(g,1); + + if (LOBYTE(wsaData.wVersion) != 1 || HIBYTE(wsaData.wVersion ) != 1) { + WSACleanup(); + epmd_cleanup_exit(g,1); + } +#endif +#ifdef DONT_USE_MAIN + if(free_argv) + g->argv = argv; + else + g->argv = NULL; +#else + g->argv = NULL; +#endif + + g->port = get_port_no(); + g->debug = 0; + + g->silent = 0; + g->is_daemon = 0; + g->packet_timeout = CLOSE_TIMEOUT; /* Default timeout */ + g->delay_accept = 0; + g->delay_write = 0; + g->progname = argv[0]; + g->listenfd = -1; + g->conn = NULL; + g->nodes.reg = g->nodes.unreg = g->nodes.unreg_tail = NULL; + g->nodes.unreg_count = 0; + g->active_conn = 0; + + argc--; + argv++; + while (argc > 0) { + if ((strcmp(argv[0], "-debug")==0) || + (strcmp(argv[0], "-d")==0)) { + g->debug += 1; + argv++; argc--; + } else if (strcmp(argv[0], "-packet_timeout") == 0) { + if ((argc == 1) || + ((g->packet_timeout = atoi(argv[1])) == 0)) + usage(g); + argv += 2; argc -= 2; + } else if (strcmp(argv[0], "-delay_accept") == 0) { + if ((argc == 1) || + ((g->delay_accept = atoi(argv[1])) == 0)) + usage(g); + argv += 2; argc -= 2; + } else if (strcmp(argv[0], "-delay_write") == 0) { + if ((argc == 1) || + ((g->delay_write = atoi(argv[1])) == 0)) + usage(g); + argv += 2; argc -= 2; + } else if (strcmp(argv[0], "-daemon") == 0) { + g->is_daemon = 1; + argv++; argc--; + } else if (strcmp(argv[0], "-kill") == 0) { + if (argc == 1) + kill_epmd(g); + else + usage(g); + epmd_cleanup_exit(g,0); + } else if (strcmp(argv[0], "-port") == 0) { + if ((argc == 1) || + ((g->port = atoi(argv[1])) == 0)) + usage(g); + argv += 2; argc -= 2; + } else if (strcmp(argv[0], "-names") == 0) { + if (argc == 1) + epmd_call(g, EPMD_NAMES_REQ); + else + usage(g); + epmd_cleanup_exit(g,0); + } else if (strcmp(argv[0], "-started") == 0) { + g->silent = 1; + if (argc == 1) + epmd_call(g, EPMD_NAMES_REQ); + else + usage(g); + epmd_cleanup_exit(g,0); + } else if (strcmp(argv[0], "-dump") == 0) { + if (argc == 1) + epmd_call(g, EPMD_DUMP_REQ); + else + usage(g); + epmd_cleanup_exit(g,0); + } + else + usage(g); + } + dbg_printf(g,0,"epmd running - daemon = %d",g->is_daemon); + +#ifndef NO_SYSCONF + if ((g->max_conn = sysconf(_SC_OPEN_MAX)) <= 0) +#endif + g->max_conn = MAX_FILES; + + /* + * max_conn must not be greater than FD_SETSIZE. + * (at least QNX crashes) + * + * More correctly, it must be FD_SETSIZE - 1, beacuse the + * listen FD is stored outside the connection array. + */ + + if (g->max_conn > FD_SETSIZE) { + g->max_conn = FD_SETSIZE - 1; + } + + if (g->is_daemon) { + run_daemon(g); + } else { + run(g); + } + return 0; +} + +#ifndef NO_DAEMON +static void run_daemon(EpmdVars *g) +{ + register int child_pid, fd; + + dbg_tty_printf(g,2,"fork a daemon"); + + /* fork to make sure first child is not a process group leader */ + if (( child_pid = fork()) < 0) + { +#ifndef NO_SYSLOG + syslog(LOG_ERR,"erlang mapper daemon cant fork %m"); +#endif + epmd_cleanup_exit(g,1); + } + else if (child_pid > 0) + { + dbg_tty_printf(g,2,"daemon child is %d",child_pid); + epmd_cleanup_exit(g,0); /*parent */ + } + + if (setsid() < 0) + { + dbg_perror(g,"epmd: Cant setsid()"); + epmd_cleanup_exit(g,1); + } + + /* ???? */ + + + signal(SIGHUP, SIG_IGN); + + /* We don't want to be session leader so we fork again */ + + if ((child_pid = fork()) < 0) + { +#ifndef NO_SYSLOG + syslog(LOG_ERR,"erlang mapper daemon cant fork 2'nd time %m"); +#endif + epmd_cleanup_exit(g,1); + } + else if (child_pid > 0) + { + dbg_tty_printf(g,2,"daemon 2'nd child is %d",child_pid); + epmd_cleanup_exit(g,0); /*parent */ + } + + /* move cwd to root to make sure we are not on a mounted filesystem */ + chdir("/"); + + umask(0); + + for (fd = 0; fd < g->max_conn ; fd++) /* close all files ... */ + close(fd); + /* Syslog on linux will try to write to whatever if we dont + inform it of that the log is closed. */ + closelog(); + + /* These chouldn't be needed but for safety... */ + + open("/dev/null", O_RDONLY); /* Order is important! */ + open("/dev/null", O_WRONLY); + open("/dev/null", O_WRONLY); + + errno = 0; /* if set by open */ + + run(g); +} + +#endif /* NO_DAEMON */ + +#ifdef __WIN32__ +static int has_console(void) +{ + HANDLE handle = CreateFile("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, + NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + + if (handle == INVALID_HANDLE_VALUE) { + return 0; + } else { + CloseHandle(handle); + return 1; + } +} + +static void run_daemon(EpmdVars *g) +{ + if (has_console()) { + if (spawnvp(_P_DETACH, __argv[0], __argv) == -1) { + fprintf(stderr, "Failed to spawn detached epmd\n"); + exit(1); + } + exit(0); + } + + close(0); + close(1); + close(2); + + /* These chouldn't be needed but for safety... */ + + open("nul", O_RDONLY); + open("nul", O_WRONLY); + open("nul", O_WRONLY); + + run(g); +} +#endif + +#if (defined(VXWORKS) || defined(_OSE_)) +static void run_daemon(EpmdVars *g) +{ + run(g); +} +#endif + + +/*************************************************************************** + * Misc support routines + * + */ + +static void usage(EpmdVars *g) +{ + fprintf(stderr, "usage: epmd [-d|-debug] [DbgExtra...] [-port No] [-daemon]\n"); + fprintf(stderr, " [-d|-debug] [-port No] [-names|-kill]\n\n"); + fprintf(stderr, "See the Erlang epmd manual page for info about the usage.\n"); + fprintf(stderr, "The -port and DbgExtra options are\n\n"); + fprintf(stderr, " -port No\n"); + fprintf(stderr, " Let epmd listen to another port than default %d\n", + EPMD_PORT_NO); + fprintf(stderr, " -d\n"); + fprintf(stderr, " -debug\n"); + fprintf(stderr, " Enable debugging. This will give a log to\n"); + fprintf(stderr, " the standard error stream. It will shorten\n"); + fprintf(stderr, " the number of saved used node names to 5.\n\n"); + fprintf(stderr, " If you give more than one debug flag you may\n"); + fprintf(stderr, " get more debugging information.\n\n"); + fprintf(stderr, " -packet_timout Seconds\n"); + fprintf(stderr, " Set the number of seconds a connection can be\n"); + fprintf(stderr, " inactive before epmd times out and closes the\n"); + fprintf(stderr, " connection (default 60).\n\n"); + fprintf(stderr, " -delay_accept Seconds\n"); + fprintf(stderr, " To simulate a busy server you can insert a\n"); + fprintf(stderr, " delay between epmd gets notified about that\n"); + fprintf(stderr, " a new connection is requested and when the\n"); + fprintf(stderr, " connections gets accepted.\n\n"); + fprintf(stderr, " -delay_write Seconds\n"); + fprintf(stderr, " Also a simulation of a busy server. Inserts\n"); + fprintf(stderr, " a delay before a reply is sent.\n"); + epmd_cleanup_exit(g,1); +} + +/*************************************************************************** + * Error reporting - dbg_printf() & dbg_tty_printf & dbg_perror() + * + * The first form will print out on tty or syslog depending on + * if it runs as deamon or not. The second form will never print + * out on syslog. + * + * The arguments are + * + * g Epmd variables + * from_level From what debug level we print. 0 means always. + * (This argument is missing from dbg_perror() ) + * format Format string + * args... Arguments to print out according to the format + * + */ + +static void dbg_gen_printf(int onsyslog,int perr,int from_level, + EpmdVars *g,const char *format, va_list args) +{ + time_t now; + char *timestr; + char buf[2048]; + + if (g->is_daemon) + { +#ifndef NO_SYSLOG + if (onsyslog) + { + vsprintf(buf, format, args); + syslog(LOG_ERR,"epmd: %s",buf); + } +#endif + } + else + { + int len; + + time(&now); + timestr = (char *)ctime(&now); + sprintf(buf, "epmd: %.*s: ", (int) strlen(timestr)-1, timestr); + len = strlen(buf); + vsprintf(buf + len, format, args); + if (perr == 1) + perror(buf); + else + fprintf(stderr,"%s\r\n",buf); + } +} + + +void dbg_perror(EpmdVars *g,const char *format,...) +{ + va_list args; + va_start(args, format); + dbg_gen_printf(1,1,0,g,format,args); + va_end(args); +} + + +void dbg_tty_printf(EpmdVars *g,int from_level,const char *format,...) +{ + if (g->debug >= from_level) { + va_list args; + va_start(args, format); + dbg_gen_printf(0,0,from_level,g,format,args); + va_end(args); + } +} + +void dbg_printf(EpmdVars *g,int from_level,const char *format,...) +{ + if (g->debug >= from_level) { + va_list args; + va_start(args, format); + dbg_gen_printf(1,0,from_level,g,format,args); + va_end(args); + } +} + + +/*************************************************************************** + * + * This function is to clean up all filedescriptors and free up memory on + * VxWorks. + * This function exits, there is nothing else to do when all here is run. + * + */ + +static void free_all_nodes(EpmdVars *g) +{ + Node *tmp; + for(tmp=g->nodes.reg; tmp != NULL; tmp = g->nodes.reg){ + g->nodes.reg = tmp->next; + free(tmp); + } + for(tmp=g->nodes.unreg; tmp != NULL; tmp = g->nodes.unreg){ + g->nodes.unreg = tmp->next; + free(tmp); + } +} +void epmd_cleanup_exit(EpmdVars *g, int exitval) +{ + int i; + + if(g->conn){ + for (i = 0; i < g->max_conn; i++) + if (g->conn[i].open == EPMD_TRUE) + epmd_conn_close(g,&g->conn[i]); + free(g->conn); + } + if(g->listenfd >= 0) + close(g->listenfd); + free_all_nodes(g); + if(g->argv){ + for(i=0; g->argv[i] != NULL; ++i) + free(g->argv[i]); + free(g->argv); + } + + + exit(exitval); +} + +static int get_port_no(void) +{ + char* port_str = getenv("ERL_EPMD_PORT"); + return (port_str != NULL) ? atoi(port_str) : EPMD_PORT_NO; +} + diff --git a/erts/epmd/src/epmd.h b/erts/epmd/src/epmd.h new file mode 100644 index 0000000000..9e939ee38e --- /dev/null +++ b/erts/epmd/src/epmd.h @@ -0,0 +1,37 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* The port number is now defined in a makefile */ + +/* Definitions of message codes */ + +#define EPMD_ALIVE_REQ 'a' +#define EPMD_ALIVE_OK_RESP 'Y' +#define EPMD_PORT_REQ 'p' +#define EPMD_NAMES_REQ 'n' +#define EPMD_DUMP_REQ 'd' +#define EPMD_KILL_REQ 'k' +#define EPMD_STOP_REQ 's' + +/* New epmd messages */ + +#define EPMD_ALIVE2_REQ 'x' /* 120 */ +#define EPMD_PORT2_REQ 'z' /* 122 */ +#define EPMD_ALIVE2_RESP 'y' /* 121 */ +#define EPMD_PORT2_RESP 'w' /* 119 */ diff --git a/erts/epmd/src/epmd_cli.c b/erts/epmd/src/epmd_cli.c new file mode 100644 index 0000000000..c12f711bc5 --- /dev/null +++ b/erts/epmd/src/epmd_cli.c @@ -0,0 +1,127 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "epmd.h" /* Renamed from 'epmd_r4.h' */ +#include "epmd_int.h" + +/* forward declarations */ + +static int conn_to_epmd(EpmdVars*); +static int read_fill(int,char*,int); + + +void kill_epmd(EpmdVars *g) +{ + char buf[5]; + int fd, rval; + + fd = conn_to_epmd(g); + put_int16(1,buf); + buf[2] = EPMD_KILL_REQ; + if (write(fd, buf, 3) != 3) { + printf("epmd: Can't write to epmd\n"); + epmd_cleanup_exit(g,1); + } + if ((rval = read_fill(fd,buf,2)) == 2) { + printf("Killed\n"); + epmd_cleanup_exit(g,0); + } else if (rval < 0) { + printf("epmd: failed to read answer from local epmd\n"); + epmd_cleanup_exit(g,1); + } else { /* rval is now 0 or 1 */ + buf[rval] = '\0'; + printf("epmd: local epmd responded with <%s>\n", buf); + epmd_cleanup_exit(g,1); + } +} + +/* what == EPMD_NAMES_REQ || EPMD_DUMP_REQ */ + +void epmd_call(EpmdVars *g,int what) +{ + char buf[OUTBUF_SIZE]; + int rval,fd,i,j; + + fd = conn_to_epmd(g); + put_int16(1,buf); + buf[2] = what; + write(fd,buf,3); + if (read(fd,(char *)&i,4) != 4) { + if (!g->silent) + printf("epmd: no response from local epmd\n"); + epmd_cleanup_exit(g,1); + } + j = ntohl(i); + if (!g->silent) + printf("epmd: up and running on port %d with data:\n", j); + while(1) { + if ((rval = read(fd,buf,1)) <= 0) { + close(fd); + epmd_cleanup_exit(g,0); + } + buf[rval] = '\0'; + if (!g->silent) + printf("%s",buf); + } +} + + + +static int conn_to_epmd(EpmdVars *g) +{ + struct EPMD_SOCKADDR_IN address; + int connect_sock; + + connect_sock = socket(FAMILY, SOCK_STREAM, 0); + if (connect_sock<0) + goto error; + + { /* store port number in unsigned short */ + unsigned short sport = g->port; + SET_ADDR_LOOPBACK(address, FAMILY, sport); + } + + if (connect(connect_sock, (struct sockaddr*)&address, sizeof address) < 0) + goto error; + return connect_sock; + + error: + if (!g->silent) { + fprintf(stderr, "epmd: Cannot connect to local epmd\n"); + } + epmd_cleanup_exit(g,1); + return -1; +} + +/* Fill buffer, return buffer length, 0 for EOF, < 0 for error. */ +static int read_fill(int fd,char *buf,int len) +{ + int i; + int got = 0; + + do { + if ((i = read(fd, buf+got, len-got)) <= 0) + return (i); + got += i; + } while (got < len); + return (len); +} diff --git a/erts/epmd/src/epmd_int.h b/erts/epmd/src/epmd_int.h new file mode 100644 index 0000000000..b120b44579 --- /dev/null +++ b/erts/epmd/src/epmd_int.h @@ -0,0 +1,346 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * This file is for internal use within epmd. + */ + +/* This file don't depend on "sys.h" so we have to do some target + definitions ourselves */ + +#ifdef __WIN32__ +#define NO_SYSLOG +#define NO_SYSCONF +#define NO_DAEMON +#endif + +#ifdef VXWORKS +#define NO_SYSLOG +#define NO_SYSCONF +#define NO_DAEMON +#define NO_FCNTL +#define DONT_USE_MAIN +#endif + +#ifdef _OSE_ +#define NO_SYSLOG +#define NO_SYSCONF +#define NO_DAEMON +#define DONT_USE_MAIN +#ifndef HAVE_SYS_TIME_H +#define HAVE_SYS_TIME_H +#endif +#ifndef HAVE_UNISTD_H +#define HAVE_UNISTD_H +#endif +#endif + +/* ************************************************************************ */ +/* Standard includes */ + +#include +#include +#include + +#ifdef __WIN32__ +# ifndef WINDOWS_H_INCLUDES_WINSOCK2_H +# include +# endif +# include +# include +#endif + +#include +#include + +#ifdef VXWORKS +# include +# include +# include +# include +# include +# include +# include +# include +#else /* ! VXWORKS */ +#ifndef __WIN32__ +# ifdef TIME_WITH_SYS_TIME +# include +# include +# else +# ifdef HAVE_SYS_TIME_H +# include +# else +# include +# endif +# endif +#endif +#endif /* ! VXWORKS */ + +#if (!defined(__WIN32__) && !defined(_OSE_)) +# include +# include +# include + +# ifdef DEF_INADDR_LOOPBACK_IN_RPC_TYPES_H +# include +# endif + +# include +# include +#endif /* ! WIN32 */ + +#ifndef _OSE_ +#include +#include +#endif + +#include + +#ifndef NO_SYSLOG +# include +#endif + +#ifdef SYS_SELECT_H +# include +#endif + +#ifdef HAVE_UNISTD_H +# include +#endif + +#include + +#ifdef _OSE_ +# include "ose.h" +# include "inet.h" +# include "sys/stat.h" +#endif + + +/* ************************************************************************ */ +/* Replace some functions by others by making the function name a macro */ + +#ifdef __WIN32__ +# define close(s) closesocket((s)) +# define write(a,b,c) send((a),(b),(c),0) +# define read(a,b,c) recv((a),(char *)(b),(c),0) +# define sleep(s) Sleep((s) * 1000) +# define ioctl(s,r,o) ioctlsocket((s),(r),(o)) +#endif /* WIN32 */ + +#ifdef VXWORKS +#define sleep(n) taskDelay((n) * sysClkRateGet()) +#endif /* VXWORKS */ + +#ifdef _OSE_ +#define sleep(n) delay((n)) +#endif + +#ifdef USE_BCOPY +# define memcpy(a, b, c) bcopy((b), (a), (c)) +# define memcmp(a, b, c) bcmp((a), (b), (c)) +# define memzero(buf, len) bzero((buf), (len)) +#else +# define memzero(buf, len) memset((buf), '\0', (len)) +#endif + +/* ************************************************************************ */ +/* Try to find replacement values for undefined system parameters */ + +#if defined(__WIN32__) && !defined(EADDRINUSE) +# define EADDRINUSE WSAEADDRINUSE +#endif + +#ifndef SOMAXCONN +# define SOMAXCONN 128 +#endif + +/* + * How to get max no of file descriptors? We used to use NOFILE from + * , but that tends to have little relation to reality. + * Best is to use sysconf() (POSIX), but we'll just punt if that isn't + * available. Start out with a high value because it will also be + * used as the number of file descriptors given to select() (it's is + * a terrible bug not to have all file descriptors included in the select()). + * The value will be adjusted down if FD_SETSIZE is smaller. + */ + +#define MAX_FILES 2048 /* if sysconf() isn't available, or fails */ + +/* ************************************************************************ */ +/* Macros that let us use IPv6 */ + +#if defined(HAVE_IN6) && defined(AF_INET6) && defined(EPMD6) + +#define EPMD_SOCKADDR_IN sockaddr_in6 +#define FAMILY AF_INET6 + +#define SET_ADDR_LOOPBACK(addr, af, port) do { \ + static u_int32_t __addr[4] = IN6ADDR_LOOPBACK_INIT; \ + memset((char*)&(addr), 0, sizeof(addr)); \ + (addr).sin6_family = (af); \ + (addr).sin6_flowinfo = 0; \ + (addr).sin6_addr.s6_addr32[0] = __addr[0]; \ + (addr).sin6_addr.s6_addr32[1] = __addr[1]; \ + (addr).sin6_addr.s6_addr32[2] = __addr[2]; \ + (addr).sin6_addr.s6_addr32[3] = __addr[3]; \ + (addr).sin6_port = htons(port); \ + } while(0) + +#define SET_ADDR_ANY(addr, af, port) do { \ + static u_int32_t __addr[4] = IN6ADDR_ANY_INIT; \ + memset((char*)&(addr), 0, sizeof(addr)); \ + (addr).sin6_family = (af); \ + (addr).sin6_flowinfo = 0; \ + (addr).sin6_addr.s6_addr32[0] = __addr[0]; \ + (addr).sin6_addr.s6_addr32[1] = __addr[1]; \ + (addr).sin6_addr.s6_addr32[2] = __addr[2]; \ + (addr).sin6_addr.s6_addr32[3] = __addr[3]; \ + (addr).sin6_port = htons(port); \ + } while(0) + +#else /* Not IP v6 */ + +#define EPMD_SOCKADDR_IN sockaddr_in +#define FAMILY AF_INET + +#define SET_ADDR_LOOPBACK(addr, af, port) do { \ + memset((char*)&(addr), 0, sizeof(addr)); \ + (addr).sin_family = (af); \ + (addr).sin_addr.s_addr = htonl(INADDR_LOOPBACK); \ + (addr).sin_port = htons(port); \ + } while(0) + +#define SET_ADDR_ANY(addr, af, port) do { \ + memset((char*)&(addr), 0, sizeof(addr)); \ + (addr).sin_family = (af); \ + (addr).sin_addr.s_addr = htonl(INADDR_ANY); \ + (addr).sin_port = htons(port); \ + } while(0) + +#endif /* Not IP v6 */ + +/* ************************************************************************ */ +/* Our own definitions */ + +#define EPMD_FALSE 0 +#define EPMD_TRUE 1 + +/* If no activity we let select() return every IDLE_TIMEOUT second + A file descriptor that are idle for CLOSE_TIMEOUT seconds and + isn't a ALIVE socket is probably hanging and we close it */ + +#define IDLE_TIMEOUT 5 +#define CLOSE_TIMEOUT 60 + +/* We save the name of nodes that are unregistered. If a new + node register the name we want to increment the "creation", + a constant 1..3. But we put an limit to this saving to keep + the lookup fast and not to leak memory. */ + +#define MAX_UNREG_COUNT 1000 +#define DEBUG_MAX_UNREG_COUNT 5 + +/* Maximum length of a node name == atom name */ +#define MAXSYMLEN 255 + +#define INBUF_SIZE 1024 +#define OUTBUF_SIZE 1024 + +#define get_int16(s) ((((unsigned char*) (s))[0] << 8) | \ + (((unsigned char*) (s))[1])) + +#define put_int16(i, s) {((unsigned char*)(s))[0] = ((i) >> 8) & 0xff; \ + ((unsigned char*)(s))[1] = (i) & 0xff;} + +/* ************************************************************************ */ + +/* Stuctures used by server */ + +typedef struct { + int fd; /* File descriptor */ + unsigned open:1; /* TRUE if open */ + unsigned keep:1; /* Don't close when sent reply */ + unsigned got; /* # of bytes we have got */ + unsigned want; /* Number of bytes we want */ + char *buf; /* The remaining buffer */ + + time_t mod_time; /* Last activity on this socket */ +} Connection; + +struct enode { + struct enode *next; + int fd; /* The socket in use */ + unsigned short port; /* Port number of Erlang node */ + char symname[MAXSYMLEN+1]; /* Name of the Erlang node */ + short creation; /* Started as a random number 1..3 */ + char nodetype; /* 77 = normal erlang node 72 = hidden (c-node */ + char protocol; /* 0 = tcp/ipv4 */ + unsigned short highvsn; /* 0 = OTP-R3 erts-4.6.x, 1 = OTP-R4 erts-4.7.x*/ + unsigned short lowvsn; + char extra[MAXSYMLEN+1]; +}; + +typedef struct enode Node; + +typedef struct { + Node *reg; + Node *unreg; + Node *unreg_tail; + int unreg_count; +} Nodes; + + +/* This is the structure with all variables needed to pass on + to all functions. This makes this program reentrant */ + +typedef struct { + int port; + int debug; + int silent; + int is_daemon; + unsigned packet_timeout; + unsigned delay_accept; + unsigned delay_write; + int max_conn; + int active_conn; + char *progname; + Connection *conn; + Nodes nodes; + fd_set orig_read_mask; + int listenfd; + char **argv; +} EpmdVars; + +void dbg_printf(EpmdVars*,int,const char*,...); +void dbg_tty_printf(EpmdVars*,int,const char*,...); +void dbg_perror(EpmdVars*,const char*,...); +void kill_epmd(EpmdVars*); +void epmd_call(EpmdVars*,int); +void run(EpmdVars*); +void epmd_cleanup_exit(EpmdVars*, int); +int epmd_conn_close(EpmdVars*,Connection*); + +#ifdef DONT_USE_MAIN +int start_epmd(char *,char *,char *,char *,char *,char *,char *,char *,char *,char *); +int epmd(int,char **); +int epmd_dbg(int,int); +#endif + + diff --git a/erts/epmd/src/epmd_srv.c b/erts/epmd/src/epmd_srv.c new file mode 100644 index 0000000000..b71e27cffd --- /dev/null +++ b/erts/epmd/src/epmd_srv.c @@ -0,0 +1,1254 @@ +/* -*- c-indent-level: 2; c-continued-statement-offset: 2 -*- */ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "epmd.h" /* Renamed from 'epmd_r4.h' */ +#include "epmd_int.h" + +/* + * + * This server is a local name server for Erlang nodes. Erlang nodes can + * ask this server for the listening port of other Erlang nodes on the + * machine EPMD is running on. New distributed nodes that are started + * register their names with this server. + * + * To be accessible to all Erlang nodes this server listens to a well + * known port EPMD_PORT_NO (curently port 4369) where requests + * for connections can be sent. + * + * To keep track of when registered Erlang nodes are terminated this + * server keeps the socket open where the request for registration was + * made. + * + * The protocol is briefly documented in "erl_ext_dist.txt". All requests + * to this server are done with a packet + * + * 2 n + * +--------+---------+ + * | Length | Request | + * +--------+---------+ + * + * In all but one case there is only one request for each connection made + * to this server so we can safely close the socket after sending the + * reply. The exception is ALIVE_REQ where we keep the connection + * open without sending any data. When we receive a "close" this is + * an indication that the Erlang node was terminated. The termination + * may have been "normal" or caused by a crash. The operating system + * ensure that the connection is closed either way. + * + * Reading is done non-blocking, i.e. we call a "read" only if we are + * told by the "select" function that there are data to read. + * + * Two databases are used: One node database where the registered names + * of the nodes are stored, and one connection database where the state + * of sockets and the data buffers is stored. + * + * Incomplete packets are thrown away after a timout. The Erlang node + * doing the request is responsible for completing in it in a reasonable time. + * + * Note that if the server gets busy it may not have time to + * process all requests for connection. The "accept()" function + * will on most operating systems silently refuse to accept more + * than 5 outstanding requests. It is the client's responsibility + * to retry the request a number of times with random time interval. + * The "-debug" flag will insert a delay so you can test this + * behaviour. + * + * FIXME: In this code we assume that the packets we send on each + * socket is so small that a "write()" never block + * + * FIXME: We never restarts a read or write that was terminated + * by an interrupt. Do we need to? + * + */ + +/* We use separate data structures for node names and connections + so that a request will not use a slot with a name that we + want to resuse later incrementing the "creation" */ + + +/* forward declarations */ + +static void do_request(EpmdVars*,int,Connection*,char*,int); +static int do_accept(EpmdVars*,int); +static void do_read(EpmdVars*,Connection*); +static time_t current_time(EpmdVars*); + +static Connection *conn_init(EpmdVars*); +static int conn_open(EpmdVars*,int); +static int conn_close_fd(EpmdVars*,int); + +static void node_init(EpmdVars*); +static Node *node_reg(EpmdVars*,char*,int,int); +static Node *node_reg2(EpmdVars*,char*, int, int, unsigned char, unsigned char, int, int, char*); +static int node_unreg(EpmdVars*,char*); +static int node_unreg_sock(EpmdVars*,int); + +static int reply(EpmdVars*,int,char *,int); +static void dbg_print_buf(EpmdVars*,char *,int); +static void print_names(EpmdVars*); + + +void run(EpmdVars *g) +{ + int listensock; + int i; + int opt; + struct EPMD_SOCKADDR_IN iserv_addr; + + node_init(g); + g->conn = conn_init(g); + + dbg_printf(g,2,"try to initiate listening port %d", g->port); + + if ((listensock = socket(FAMILY,SOCK_STREAM,0)) < 0) { + dbg_perror(g,"error opening stream socket"); + epmd_cleanup_exit(g,1); + } + g->listenfd = listensock; + + /* + * Initialize number of active file descriptors. + * Stdin, stdout, and stderr are still open. + * One for the listen socket. + */ + g->active_conn = 3+1; + + /* + * Note that we must not enable the SO_REUSEADDR on Windows, + * because addresses will be reused even if they are still in use. + */ + +#if (!defined(__WIN32__) && !defined(_OSE_)) + /* We ignore the SIGPIPE signal that is raised when we call write + twice on a socket closed by the other end. */ + signal(SIGPIPE, SIG_IGN); + + opt = 1; /* Set this option */ + if (setsockopt(listensock,SOL_SOCKET,SO_REUSEADDR,(char* ) &opt, + sizeof(opt)) <0) { + dbg_perror(g,"can't set sockopt"); + epmd_cleanup_exit(g,1); + } +#endif + + /* In rare cases select returns because there is someone + to accept but the request is withdrawn before the + accept function is called. We set the listen socket + to be non blocking to prevent us from being hanging + in accept() waiting for the next request. */ +#ifdef _OSE_ + opt = 1; + if (ioctl(listensock, FIONBIO, (char*)&opt) != 0) +#else +#if (defined(__WIN32__) || defined(NO_FCNTL)) + opt = 1; + if (ioctl(listensock, FIONBIO, &opt) != 0) /* Gives warning in VxWorks */ +#else + opt = fcntl(listensock, F_GETFL, 0); + if (fcntl(listensock, F_SETFL, opt | O_NONBLOCK) == -1) +#endif /* __WIN32__ || VXWORKS */ +#endif /* _OSE_ */ + dbg_perror(g,"failed to set non-blocking mode of listening socket %d", + listensock); + + { /* store port number in unsigned short */ + unsigned short sport = g->port; + SET_ADDR_ANY(iserv_addr, FAMILY, sport); + } + +#ifdef _OSE_ + { + int optlen = sizeof(opt); + opt = 1; + if(getsockopt(listensock, SOL_SOCKET, SO_REUSEADDR, + (void*)&opt, &optlen) < 0) + fprintf(stderr, "\n\nGETSOCKOPT FAILS! %d\n\n", errno); + else if(opt == 1) + fprintf(stderr, "SO_REUSEADDR is set!\n"); + } +#endif + + if(bind(listensock,(struct sockaddr*) &iserv_addr, sizeof(iserv_addr)) < 0 ) + { + if (errno == EADDRINUSE) + { + dbg_tty_printf(g,1,"there is already a epmd running at port %d", + g->port); + epmd_cleanup_exit(g,0); + } + else + { + dbg_perror(g,"failed to bind socket"); + epmd_cleanup_exit(g,1); + } + } + + dbg_printf(g,2,"starting"); + + listen(listensock, SOMAXCONN); + + + FD_ZERO(&g->orig_read_mask); + FD_SET(listensock,&g->orig_read_mask); + + dbg_tty_printf(g,2,"entering the main select() loop"); + + select_again: + while(1) + { + fd_set read_mask = g->orig_read_mask; + struct timeval timeout; + int ret; + + /* If we are idle we time out now and then to enable the code + below to close connections that are old and probably + hanging. Make sure that select will return often enough. */ + + timeout.tv_sec = (g->packet_timeout < IDLE_TIMEOUT) ? 1 : IDLE_TIMEOUT; + timeout.tv_usec = 0; + + if ((ret = select(g->max_conn,&read_mask,(fd_set *)0,(fd_set *)0,&timeout)) < 0) + dbg_perror(g,"error in select "); + else { + time_t now; + if (ret == 0) { + FD_ZERO(&read_mask); + } + if (g->delay_accept) { /* Test of busy server */ + sleep(g->delay_accept); + } + + if (FD_ISSET(listensock,&read_mask)) { + if (do_accept(g, listensock) && g->active_conn < g->max_conn) { + /* + * The accept() succeeded, and we have at least one file + * descriptor still free, which means that another accept() + * could succeed. Go do do another select(), in case there + * are more incoming connections waiting to be accepted. + */ + goto select_again; + } + } + + /* Check all open streams marked by select for data or a + close. We also close all open sockets except ALIVE + with no activity for a long period */ + + now = current_time(g); + for (i = 0; i < g->max_conn; i++) { + if (g->conn[i].open == EPMD_TRUE) { + if (FD_ISSET(g->conn[i].fd,&read_mask)) + do_read(g,&g->conn[i]); + else if ((g->conn[i].keep == EPMD_FALSE) && + ((g->conn[i].mod_time + g->packet_timeout) < now)) { + dbg_tty_printf(g,1,"closing because timed out on receive"); + epmd_conn_close(g,&g->conn[i]); + } + } + } + } + } +} + +/* + * This routine read as much of the packet as possible and + * if completed calls "do_request()" to fullfill the request. + * + */ + +static void do_read(EpmdVars *g,Connection *s) +{ + int val, pack_size; + + if (s->open == EPMD_FALSE) + { + dbg_printf(g,0,"read on unknown socket"); + return; + } + + /* Check if we already got the whole packet but we keep the + connection alive to find out when a node is terminated. We then + want to check for a close */ + + if (s->keep == EPMD_TRUE) + { + val = read(s->fd, s->buf, INBUF_SIZE); + + if (val == 0) + { + node_unreg_sock(g,s->fd); + epmd_conn_close(g,s); + } + else if (val < 0) + { + dbg_tty_printf(g,1,"error on ALIVE socket %d (%d; errno=0x%x)", + s->fd, val, errno); + node_unreg_sock(g,s->fd); + epmd_conn_close(g,s); + } + else + { + dbg_tty_printf(g,1,"got more than expected on ALIVE socket %d (%d)", + s->fd,val); + dbg_print_buf(g,s->buf,val); + + /* FIXME: Shouldn't be needed to close down.... */ + node_unreg_sock(g,s->fd); + epmd_conn_close(g,s); + } + /* FIXME: We always close, probably the right thing to do */ + return; + } + + /* If unknown size we request the whole buffer - what we got - 1 + We subtract 1 because we will add a "\0" in "do_request()". + This is not needed for R3A or higher versions of Erlang, + because the '\0' is included in the request, + but is kept for backwards compatibility to allow R2D to use + this epmd. */ + + pack_size = s->want ? s->want : INBUF_SIZE - 1; + val = read(s->fd, s->buf + s->got, pack_size - s->got); + + if (val == 0) + { + /* A close when we haven't got all data */ + dbg_printf(g,0,"got partial packet only on file descriptor %d (%d)", + s->fd,s->got); + epmd_conn_close(g,s); + return; + } + + if (val < 0) + { + dbg_perror(g,"error in read"); + epmd_conn_close(g,s); + return; + } + + dbg_print_buf(g,s->buf,val); + + s->got += val; + + if ((s->want == 0) && (s->got >= 2)) + { + /* The two byte header that specify the length of the packet + doesn't count the header as part of the packet so we add 2 + to "s->want" to make us talk about all bytes we get. */ + + s->want = get_int16(s->buf) + 2; + + if ((s->want < 3) || (s->want >= INBUF_SIZE)) + { + dbg_printf(g,0,"invalid packet size (%d)",s->want - 2); + epmd_conn_close(g,s); + return; + } + + if (s->got > s->want) + { + dbg_printf(g,0,"got %d bytes in packet, expected %d", + s->got - 2, s->want - 2); + epmd_conn_close(g,s); + return; + } + } + + s->mod_time = current_time(g); /* Note activity */ + + if (s->want == s->got) + { + /* Do action and close up */ + /* Skip header bytes */ + + do_request(g, s->fd, s, s->buf + 2, s->got - 2); + + if (!s->keep) + epmd_conn_close(g,s); /* Normal close */ + } +} + +static int do_accept(EpmdVars *g,int listensock) +{ + int msgsock; + struct EPMD_SOCKADDR_IN icli_addr; /* workaround for QNX bug - cannot */ + int icli_addr_len; /* handle NULL pointers to accept. */ + + icli_addr_len = sizeof(icli_addr); + + msgsock = accept(listensock,(struct sockaddr*) &icli_addr, + (unsigned int*) &icli_addr_len); + + if (msgsock < 0) { + dbg_perror(g,"error in accept"); + return EPMD_FALSE; + } + + return conn_open(g,msgsock); +} + +static void do_request(g, fd, s, buf, bsize) + EpmdVars *g; + int fd; + Connection *s; + char *buf; + int bsize; +{ + char wbuf[OUTBUF_SIZE]; /* Buffer for writing */ + int i; + + /* + * Terminate packet as a C string. Needed for requests received from Erlang + * nodes with lower version than R3A. + */ + + buf[bsize] = '\0'; + + switch (*buf) + { + case EPMD_ALIVE_REQ: + dbg_printf(g,1,"** got ALIVE_REQ"); + + /* The packet has the format "axxyyyyyy" where xx is port, given + in network byte order, and yyyyyy is symname, possibly null + terminated. */ + + if (buf[bsize - 1] == '\000') /* Skip null termination */ + bsize--; + + if (bsize <= 3) + { + dbg_printf(g,0,"packet to small for request ALIVE_REQ (%d)", bsize); + return; + } + + for (i = 3; i < bsize; i++) + if (buf[i] == '\000') + { + dbg_printf(g,0,"node name contains ascii 0 in ALIVE_REQ"); + return; + } + + { + Node *node; + int eport; + char *name = &buf[3]; /* points to node name */ + + eport = get_int16(&buf[1]); + + if ((node = node_reg(g, name, fd, eport)) == NULL) + return; + + wbuf[0] = EPMD_ALIVE_OK_RESP; + put_int16(node->creation, wbuf+1); + + if (g->delay_write) /* Test of busy server */ + sleep(g->delay_write); + + if (reply(g, fd, wbuf, 3) != 3) + { + dbg_tty_printf(g,1,"failed to send ALIVE_OK_RESP for \"%s\"",name); + return; + } + + dbg_tty_printf(g,1,"** sent ALIVE_OK_RESP for \"%s\"",name); + s->keep = EPMD_TRUE; /* Don't close on inactivity */ + } + break; + + case EPMD_PORT_REQ: + dbg_printf(g,1,"** got PORT_REQ"); + + if (buf[bsize - 1] == '\000') /* Skip null termination */ + bsize--; + + if (bsize <= 1) + { + dbg_printf(g,0,"packet to small for request PORT_REQ (%d)", bsize); + return; + } + + for (i = 1; i < bsize; i++) + if (buf[i] == '\000') + { + dbg_printf(g,0,"node name contains ascii 0 in PORT_REQ"); + return; + } + + { + char *name = &buf[1]; /* Points to node name */ + Node *node; + + for (node = g->nodes.reg; node; node = node->next) + { + if (strcmp(node->symname, name) == 0) + { + put_int16(node->port,wbuf); + if (reply(g, fd, wbuf, 2) != 2) + { + dbg_tty_printf(g,1,"failed to send PORT_RESP for %s: %d", + name,node->port); + return; + } + dbg_tty_printf(g,1,"** sent PORT_RESP for %s: %d", + name,node->port); + return; + } + } + dbg_tty_printf(g,1,"Closed on PORT_REQ for %s",name); + } + /* FIXME: How about an answer if no port? Is a close enough? */ + break; + + case EPMD_ALIVE2_REQ: + dbg_printf(g,1,"** got ALIVE2_REQ"); + + /* The packet has the format "axxyyyyyy" where xx is port, given + in network byte order, and yyyyyy is symname, possibly null + terminated. */ + + if (bsize <= 13) + { + dbg_printf(g,0,"packet to small for request ALIVE2_REQ (%d)",bsize); + return; + } + + { + Node *node; + int eport; + unsigned char nodetype; + unsigned char protocol; + unsigned short highvsn; + unsigned short lowvsn; + int namelen; + int extralen; + char *name; + char *extra; + eport = get_int16(&buf[1]); + nodetype = buf[3]; + protocol = buf[4]; + highvsn = get_int16(&buf[5]); + lowvsn = get_int16(&buf[7]); + namelen = get_int16(&buf[9]); + extralen = get_int16(&buf[11+namelen]); + for (i = 11 ; i < 11 + namelen; i ++) + if (buf[i] == '\000') { + dbg_printf(g,0,"node name contains ascii 0 in ALIVE2_REQ"); + return; + } + name = &buf[11]; + name[namelen]='\000'; + extra = &buf[11+namelen+1]; + extra[extralen]='\000'; + wbuf[0] = EPMD_ALIVE2_RESP; + if ((node = node_reg2(g, name, fd, eport, nodetype, protocol, + highvsn, lowvsn, extra)) == NULL) { + wbuf[1] = 1; /* error */ + put_int16(99, wbuf+2); + } else { + wbuf[1] = 0; /* ok */ + put_int16(node->creation, wbuf+2); + } + + if (g->delay_write) /* Test of busy server */ + sleep(g->delay_write); + + if (reply(g, fd, wbuf, 4) != 4) + { + dbg_tty_printf(g,1,"** failed to send ALIVE2_RESP for \"%s\"", + name); + return; + } + + dbg_tty_printf(g,1,"** sent ALIVE2_RESP for \"%s\"",name); + s->keep = EPMD_TRUE; /* Don't close on inactivity */ + } + break; + + case EPMD_PORT2_REQ: + dbg_printf(g,1,"** got PORT2_REQ"); + + if (buf[bsize - 1] == '\000') /* Skip null termination */ + bsize--; + + if (bsize <= 1) + { + dbg_printf(g,0,"packet to small for request PORT2_REQ (%d)", bsize); + return; + } + + for (i = 1; i < bsize; i++) + if (buf[i] == '\000') + { + dbg_printf(g,0,"node name contains ascii 0 in PORT2_REQ"); + return; + } + + { + char *name = &buf[1]; /* Points to node name */ + Node *node; + + wbuf[0] = EPMD_PORT2_RESP; + for (node = g->nodes.reg; node; node = node->next) { + int offset; + if (strcmp(node->symname, name) == 0) { + wbuf[1] = 0; /* ok */ + put_int16(node->port,wbuf+2); + wbuf[4] = node->nodetype; + wbuf[5] = node->protocol; + put_int16(node->highvsn,wbuf+6); + put_int16(node->lowvsn,wbuf+8); + put_int16(strlen(node->symname),wbuf+10); + offset = 12; + strcpy(wbuf + offset,node->symname); + offset += strlen(node->symname); + put_int16(strlen(node->extra),wbuf + offset); + offset += 2; + strcpy(wbuf + offset,node->extra); + offset += (strlen(node->extra)-1); + if (reply(g, fd, wbuf, offset) != offset) + { + dbg_tty_printf(g,1,"** failed to send PORT2_RESP (ok) for \"%s\"",name); + return; + } + dbg_tty_printf(g,1,"** sent PORT2_RESP (ok) for \"%s\"",name); + return; + } + } + wbuf[1] = 1; /* error */ + if (reply(g, fd, wbuf, 2) != 2) + { + dbg_tty_printf(g,1,"** failed to send PORT2_RESP (error) for \"%s\"",name); + return; + } + dbg_tty_printf(g,1,"** sent PORT2_RESP (error) for \"%s\"",name); + return; + } + break; + + case EPMD_NAMES_REQ: + dbg_printf(g,1,"** got NAMES_REQ"); + { + Node *node; + + i = htonl(g->port); + memcpy(wbuf,&i,4); + + if (reply(g, fd,wbuf,4) != 4) + { + dbg_tty_printf(g,1,"failed to send NAMES_RESP"); + return; + } + + for (node = g->nodes.reg; node; node = node->next) + { + int len; + + /* CAREFUL!!! These are parsed by "erl_epmd.erl" so a slight + change in syntax will break < OTP R3A */ + + sprintf(wbuf,"name %s at port %d\n",node->symname, node->port); + len = strlen(wbuf); + if (reply(g, fd, wbuf, len) != len) + { + dbg_tty_printf(g,1,"failed to send NAMES_RESP"); + return; + } + } + } + dbg_tty_printf(g,1,"** sent NAMES_RESP"); + break; + + case EPMD_DUMP_REQ: + dbg_printf(g,1,"** got DUMP_REQ"); + { + Node *node; + + i = htonl(g->port); + memcpy(wbuf,&i,4); + if (reply(g, fd,wbuf,4) != 4) + { + dbg_tty_printf(g,1,"failed to send DUMP_RESP"); + return; + } + + for (node = g->nodes.reg; node; node = node->next) + { + int len; + + /* CAREFUL!!! These are parsed by "erl_epmd.erl" so a slight + change in syntax will break < OTP R3A */ + + sprintf(wbuf,"active name <%s> at port %d, fd = %d\n", + node->symname, node->port, node->fd); + len = strlen(wbuf) + 1; + if (reply(g, fd,wbuf,len) != len) + { + dbg_tty_printf(g,1,"failed to send DUMP_RESP"); + return; + } + } + + for (node = g->nodes.unreg; node; node = node->next) + { + int len; + + /* CAREFUL!!! These are parsed by "erl_epmd.erl" so a slight + change in syntax will break < OTP R3A */ + + sprintf(wbuf,"old/unused name <%s>, port = %d, fd = %d \n", + node->symname,node->port, node->fd); + len = strlen(wbuf) + 1; + if (reply(g, fd,wbuf,len) != len) + { + dbg_tty_printf(g,1,"failed to send DUMP_RESP"); + return; + } + } + } + dbg_tty_printf(g,1,"** sent DUMP_RESP"); + break; + + case EPMD_KILL_REQ: + dbg_printf(g,1,"** got KILL_REQ"); + if (reply(g, fd,"OK",2) != 2) + dbg_printf(g,0,"failed to send reply to KILL_REQ"); + dbg_tty_printf(g,1,"epmd killed"); + conn_close_fd(g,fd); /* We never return to caller so close here */ + dbg_printf(g,0,"got KILL_REQ - terminates normal"); + epmd_cleanup_exit(g,0); /* Normal exit */ + + case EPMD_STOP_REQ: + dbg_printf(g,1,"** got STOP_REQ"); + if (bsize <= 1 ) + { + dbg_printf(g,0,"packet to small for request STOP_REQ (%d)",bsize); + return; + } + + { + char *name = &buf[1]; /* Points to node name */ + int node_fd; + + if ((node_fd = node_unreg(g,name)) < 0) + { + if (reply(g, fd,"NOEXIST",7) != 7) + { + dbg_tty_printf(g,1,"failed to send STOP_RESP NOEXIST"); + return; + } + dbg_tty_printf(g,1,"** sent STOP_RESP NOEXIST"); + } + + conn_close_fd(g,node_fd); + dbg_tty_printf(g,1,"epmd connection stopped"); + + if (reply(g, fd,"STOPPED",7) != 7) + { + dbg_tty_printf(g,1,"failed to send STOP_RESP STOPPED"); + return; + } + dbg_tty_printf(g,1,"** sent STOP_RESP STOPPED"); + } + break; + + default: + dbg_printf(g,0,"got garbage "); + } +} + + +/**************************************************************************** + * + * Handle database with data for each socket to read + * + ****************************************************************************/ + +static Connection *conn_init(EpmdVars *g) +{ + int nbytes = g->max_conn * sizeof(Connection); + Connection *connections = (Connection *)malloc(nbytes); + + if (connections == NULL) + { + dbg_printf(g,0,"epmd: Insufficient memory"); +#ifdef DONT_USE_MAIN + free(g->argv); +#endif + exit(1); + } + + memzero(connections, nbytes); + + return connections; +} + +static int conn_open(EpmdVars *g,int fd) +{ + int i; + Connection *s; + +#ifdef VXWORKS + /* + * Since file descriptors are global on VxWorks, we might get an fd that + * does not fit in the FD_SET. + * + * Note: This test would be harmless on Unix, but would fail on Windows + * because socket are numbered differently and FD_SETs are implemented + * differently. + */ + if (fd >= FD_SETSIZE) { + dbg_tty_printf(g,0,"file descriptor %d: too high for FD_SETSIZE=%d", + fd,FD_SETSIZE); + close(fd); + return EPMD_FALSE; + } +#endif + + for (i = 0; i < g->max_conn; i++) { + if (g->conn[i].open == EPMD_FALSE) { + g->active_conn++; + s = &g->conn[i]; + + /* From now on we want to know if there are data to be read */ + FD_SET(fd, &g->orig_read_mask); + + s->fd = fd; + s->open = EPMD_TRUE; + s->keep = EPMD_FALSE; + s->want = 0; /* Currently unknown */ + s->got = 0; + s->mod_time = current_time(g); /* Note activity */ + + s->buf = (char *)malloc(INBUF_SIZE); + + if (s->buf == NULL) { + dbg_printf(g,0,"epmd: Insufficient memory"); + close(fd); + return EPMD_FALSE; + } + + dbg_tty_printf(g,2,"opening connection on file descriptor %d",fd); + return EPMD_TRUE; + } + } + + dbg_tty_printf(g,0,"failed opening connection on file descriptor %d",fd); + close(fd); + return EPMD_FALSE; +} + +static int conn_close_fd(EpmdVars *g,int fd) +{ + int i; + + for (i = 0; i < g->max_conn; i++) + if (g->conn[i].fd == fd) + { + epmd_conn_close(g,&g->conn[i]); + return EPMD_TRUE; + } + + return EPMD_FALSE; +} + + +int epmd_conn_close(EpmdVars *g,Connection *s) +{ + dbg_tty_printf(g,2,"closing connection on file descriptor %d",s->fd); + + FD_CLR(s->fd,&g->orig_read_mask); + close(s->fd); /* Sometimes already closed but close anyway */ + s->open = EPMD_FALSE; + if (s->buf != NULL) { /* Should never be NULL but test anyway */ + free(s->buf); + } + g->active_conn--; + return EPMD_TRUE; +} + +/**************************************************************************** + * + * Handle database with data for each registered node + * + ****************************************************************************/ + + +static void node_init(EpmdVars *g) +{ + g->nodes.reg = NULL; + g->nodes.unreg = NULL; + g->nodes.unreg_tail = NULL; + g->nodes.unreg_count = 0; +} + + +/* We have got a close on a connection and it may be a + EPMD_ALIVE_CLOSE_REQ. Note that this call shouild be called + *before* calling conn_close() */ + +static int node_unreg(EpmdVars *g,char *name) +{ + Node **prev = &g->nodes.reg; /* Point to cell pointing to... */ + Node *node = g->nodes.reg; /* Point to first node */ + + for (; node; prev = &node->next, node = node->next) + if (strcmp(node->symname, name) == 0) + { + dbg_tty_printf(g,1,"unregistering '%s:%d', port %d", + node->symname, node->creation, node->port); + + *prev = node->next; /* Link out from "reg" list */ + + if (g->nodes.unreg == NULL) /* Link into "unreg" list */ + g->nodes.unreg = g->nodes.unreg_tail = node; + else + { + g->nodes.unreg_tail->next = node; + g->nodes.unreg_tail = node; + } + + g->nodes.unreg_count++; + + node->next = NULL; /* Last in list == first in FIFO queue */ + + print_names(g); + + return node->fd; + } + + dbg_tty_printf(g,1,"trying to unregister node with unknown name %s", name); + return -1; +} + + +static int node_unreg_sock(EpmdVars *g,int fd) +{ + Node **prev = &g->nodes.reg; /* Point to cell pointing to... */ + Node *node = g->nodes.reg; /* Point to first node */ + + for (; node; prev = &node->next, node = node->next) + if (node->fd == fd) + { + dbg_tty_printf(g,1,"unregistering '%s:%d', port %d", + node->symname, node->creation, node->port); + + *prev = node->next; /* Link out from "reg" list */ + + if (g->nodes.unreg == NULL) /* Link into "unreg" list */ + g->nodes.unreg = g->nodes.unreg_tail = node; + else + { + g->nodes.unreg_tail->next = node; + g->nodes.unreg_tail = node; + } + + g->nodes.unreg_count++; + + node->next = NULL; /* Last in list == first in FIFO queue */ + + print_names(g); + + return node->fd; + } + + dbg_tty_printf(g,1, + "trying to unregister node with unknown file descriptor %d", + fd); + return -1; +} + +/* + * Finding a node slot and a (name,creation) name is a bit tricky. + * We try in order + * + * 1. If the name was used before and we can reuse that slot but use + * a new "creation" digit in the range 1..3. + * + * 2. We try to find a new unused slot. + * + * 3. We try to use an used slot this isn't used any longer. + * FIXME: The criteria for *what* slot to steal should be improved. + * Perhaps use the oldest or something. + */ + +static Node *node_reg(EpmdVars *g,char *name,int fd, int port) +{ + return node_reg2(g, name, fd, port, 0, 0, 0, 0, NULL); +} + +static Node *node_reg2(EpmdVars *g, + char* name, + int fd, + int port, + unsigned char nodetype, + unsigned char protocol, + int highvsn, + int lowvsn, + char* extra) +{ + Node *prev; /* Point to previous node or NULL */ + Node *node; /* Point to first node */ + + /* Can be NULL; means old style */ + if (extra == NULL) + extra = ""; + + /* Fail if node name is too long */ + + if (strlen(name) > MAXSYMLEN) + { + dbg_printf(g,0,"node name is too long (%d) %s", strlen(name), name); + return NULL; + } + + /* Fail if it is already registered */ + + for (node = g->nodes.reg; node; node = node->next) + if (strcmp(node->symname, name) == 0) + { + dbg_printf(g,0,"node name already occupied %s", name); + return NULL; + } + + /* Try to find the name in the used queue so that we + can change "creation" number 1..3 */ + + prev = NULL; + + for (node = g->nodes.unreg; node; prev = node, node = node->next) + if (strcmp(node->symname, name) == 0) + { + dbg_tty_printf(g,1,"reusing slot with same name '%s'", node->symname); + + if (prev == NULL) /* First in list matched */ + { + if (node->next == NULL) /* Only one element */ + g->nodes.unreg = g->nodes.unreg_tail = NULL; + else + g->nodes.unreg = node->next; + } + else + { + if (node->next == NULL) /* Last in list */ + { + g->nodes.unreg_tail = prev; /* Point to new last */ + prev->next = NULL; /* New last has no next */ + } + else + prev->next = node->next; /* Simple link out from list */ + } + + g->nodes.unreg_count--; + + /* When reusing we change the "creation" number 1..3 */ + + node->creation = node->creation % 3 + 1; + + break; + } + + if (node == NULL) + { + /* A new name. If the "unreg" list is too long we steal the + oldest node structure and use it for the new node, else + we allocate a new node structure */ + + if ((g->nodes.unreg_count > MAX_UNREG_COUNT) || + (g->debug && (g->nodes.unreg_count > DEBUG_MAX_UNREG_COUNT))) + { + /* MAX_UNREG_COUNT > 1 so no need to check unreg_tail */ + node = g->nodes.unreg; /* Take first == oldest */ + g->nodes.unreg = node->next; /* Link out */ + g->nodes.unreg_count--; + } + else + { + if ((node = (Node *)malloc(sizeof(Node))) == NULL) + { + dbg_printf(g,0,"epmd: Insufficient memory"); + exit(1); + } + + node->creation = (current_time(g) % 3) + 1; /* "random" 1-3 */ + } + } + + node->next = g->nodes.reg; /* Link into "reg" queue */ + g->nodes.reg = node; + + node->fd = fd; + node->port = port; + node->nodetype = nodetype; + node->protocol = protocol; + node->highvsn = highvsn; + node->lowvsn = lowvsn; + strcpy(node->extra,extra); + strcpy(node->symname,name); + FD_SET(fd,&g->orig_read_mask); + + if (highvsn == 0) { + dbg_tty_printf(g,1,"registering '%s:%d', port %d", + node->symname, node->creation, node->port); + } else { + dbg_tty_printf(g,1,"registering '%s:%d', port %d", + node->symname, node->creation, node->port); + dbg_tty_printf(g,1,"type %d proto %d highvsn %d lowvsn %d", + nodetype, protocol, highvsn, lowvsn); + } + + print_names(g); + + return node; +} + + +static time_t current_time(EpmdVars *g) +{ + time_t t = time((time_t *)0); + dbg_printf(g,3,"time in seconds: %d",t); + return t; +} + + +static int reply(EpmdVars *g,int fd,char *buf,int len) +{ + int val; + + if (len < 0) + { + dbg_printf(g,0,"Invalid length in write %d",len); + return -1; + } + + if (g->delay_write) /* Test of busy server */ + sleep(g->delay_write); + + val = write(fd,buf,len); + if (val < 0) + dbg_perror(g,"error in write"); + else if (val != len) + dbg_printf(g,0,"could only send %d bytes out of %d to fd %d",val,len,fd); + + dbg_print_buf(g,buf,len); + + return val; +} + + +#define LINEBYTECOUNT 16 + +static void print_buf_hex(unsigned char *buf,int len,char *prefix) +{ + int rows, row; + + rows = len / LINEBYTECOUNT; /* Number of rows */ + if (len % LINEBYTECOUNT) + rows++; /* If leftovers, add a line for them */ + + for (row = 0; row < rows; row++) + { + int rowstart = row * LINEBYTECOUNT; + int rowend = rowstart + LINEBYTECOUNT; + int i; + + fprintf(stderr,"%s%.8x",prefix,rowstart); + + for (i = rowstart; i < rowend; i++) + { + if ((i % (LINEBYTECOUNT/2)) == 0) + fprintf(stderr," "); + + if (i < len) + fprintf(stderr," %.2x",buf[i]); + else + fprintf(stderr," "); + } + + fprintf(stderr," |"); + + for (i = rowstart; (i < rowend) && (i < len); i++) + { + int c = buf[i]; + + /* Used to be isprint(c) but we want ascii only */ + + if ((c >= 32) && (c <= 126)) + fprintf(stderr,"%c",c); + else + fprintf(stderr,"."); + } + + fprintf(stderr,"|\r\n"); + } +} + +static void dbg_print_buf(EpmdVars *g,char *buf,int len) +{ + int plen; + + if ((g->is_daemon) || /* Don't want to write to stderr if daemon */ + (g->debug < 2)) /* or debug level too low */ + return; + + dbg_tty_printf(g,1,"got %d bytes",len); + + plen = len > 1024 ? 1024 : len; /* Limit the number of chars to print */ + + print_buf_hex((unsigned char*)buf,plen,"***** "); + + if (len != plen) + fprintf(stderr,"***** ......and more\r\n"); +} + +static void print_names(EpmdVars *g) +{ + int count = 0; + Node *node; + + if ((g->is_daemon) || /* Don't want to write to stderr if daemon */ + (g->debug < 3)) /* or debug level too low */ + return; + + for (node = g->nodes.reg; node; node = node->next) + { + fprintf(stderr,"***** active name \"%s#%d\" at port %d, fd = %d\r\n", + node->symname, node->creation, node->port, node->fd); + count ++; + } + + fprintf(stderr, "***** reg calculated count : %d\r\n", count); + + count = 0; + + for (node = g->nodes.unreg; node; node = node->next) + { + fprintf(stderr,"***** old/unused name \"%s#%d\"\r\n", + node->symname, node->creation); + count ++; + } + + fprintf(stderr, "***** unreg counter : %d\r\n", + g->nodes.unreg_count); + fprintf(stderr, "***** unreg calculated count: %d\r\n", count); +} diff --git a/erts/epmd/test/Makefile b/erts/epmd/test/Makefile new file mode 100644 index 0000000000..c1d62f0f93 --- /dev/null +++ b/erts/epmd/test/Makefile @@ -0,0 +1,80 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +include ../epmd.mk + +EBIN = . + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES= epmd_SUITE + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELEPMDDIR = $(RELEASE_PATH)/epmd_test + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \ + -I$(ERL_TOP)/lib/kernel/src/ \ + $(EPMD_FLAGS) + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +tests debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f core *~ + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: + +release_tests_spec: opt + $(INSTALL_DIR) $(RELEPMDDIR) + $(INSTALL_DATA) epmd.spec epmd.spec.vxworks $(ERL_FILES) \ + $(TARGET_FILES) $(RELEPMDDIR) + chmod -f -R u+w $(RELEPMDDIR) + +release_docs_spec: + + + + + diff --git a/erts/epmd/test/epmd.spec b/erts/epmd/test/epmd.spec new file mode 100644 index 0000000000..0e2496bc72 --- /dev/null +++ b/erts/epmd/test/epmd.spec @@ -0,0 +1 @@ +{topcase, {dir, "../epmd_test"}}. diff --git a/erts/epmd/test/epmd.spec.vxworks b/erts/epmd/test/epmd.spec.vxworks new file mode 100644 index 0000000000..476308b481 --- /dev/null +++ b/erts/epmd/test/epmd.spec.vxworks @@ -0,0 +1,2 @@ +{topcase, {dir, "../epmd_test"}}. +{skip,{epmd_rx_SUITE,"EPMD RX does simply not work on VxWorks"}}. diff --git a/erts/epmd/test/epmd_SUITE.erl b/erts/epmd/test/epmd_SUITE.erl new file mode 100644 index 0000000000..513c87a13e --- /dev/null +++ b/erts/epmd/test/epmd_SUITE.erl @@ -0,0 +1,835 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(epmd_SUITE). +-include("test_server.hrl"). +-include_lib("kernel/include/file.hrl"). + + +% Timeout for test cases (rather long to work on slow machines) +-define(SHORT_TEST_TIMEOUT, ?t:seconds(30)). % Default +-define(MEDIUM_TEST_TIMEOUT, ?t:minutes(3)). +-define(LONG_TEST_TIMEOUT, ?t:minutes(10)). + +% Delay inserted into code +-define(SHORT_PAUSE, 100). +-define(MEDIUM_PAUSE, ?t:seconds(1)). +-define(LONG_PAUSE, ?t:seconds(5)). + +% Test server specific exports +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export( + [ + register_name/1, + register_names_1/1, + register_names_2/1, + register_duplicate_name/1, + get_port_nr/1, + slow_get_port_nr/1, + unregister_others_name_1/1, + unregister_others_name_2/1, + register_overflow/1, + name_with_null_inside/1, + name_null_terminated/1, + stupid_names_req/1, + + no_data/1, + one_byte/1, + two_bytes/1, + partial_packet/1, + zero_length/1, + too_large/1, + alive_req_too_small_1/1, + alive_req_too_small_2/1, + alive_req_too_large/1 + ]). + + +% Port we use for testing +-define(PORT,2243). +-define(EPMDARGS,"-packet_timeout 1"). + +-define(DUMMY_PORT, 1000). % Port number to register + % not in real use. + +% Timeouts etc inside test cases. Time is in milliseconds. +-define(CONN_RETRY, 4). % Times to retry connecting +-define(CONN_SLEEP, 500). +-define(CONN_TIMEOUT, 100). +-define(RECV_TIMEOUT, 2000). +-define(REG_REPEAT_LIM,1000). + +% Message codes in epmd protocol +-define(EPMD_ALIVE_REQ, $a). +-define(EPMD_ALIVE_OK_RESP, $Y). +-define(EPMD_PORT_REQ, $p). +-define(EPMD_NAMES_REQ, $n). +-define(EPMD_DUMP_REQ, $d). +-define(EPMD_KILL_REQ, $k). +-define(EPMD_STOP_REQ, $s). + +%% +%% all/1 +%% + +all(suite) -> + [ + register_name, + register_names_1, + register_names_2, + register_duplicate_name, + get_port_nr, + slow_get_port_nr, + unregister_others_name_1, + unregister_others_name_2, + register_overflow, + name_with_null_inside, + name_null_terminated, + stupid_names_req, + + no_data, + one_byte, + two_bytes, + partial_packet, + zero_length, + too_large, + alive_req_too_small_1, + alive_req_too_small_2, + alive_req_too_large + ]. + +%% +%% Run before and after each test case +%% + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(?SHORT_TEST_TIMEOUT), + cleanup(), + [{watchdog, Dog} | Config]. + +fin_per_testcase(_Func, Config) -> + cleanup(), + Dog = ?config(watchdog, Config), + catch test_server:timetrap_cancel(Dog), % We may have canceled already + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +register_name(doc) -> + ["Register a name"]; +register_name(suite) -> + []; +register_name(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = register_node("foobar"), + ?line ok = close(Sock), % Unregister + ok. + +register_names_1(doc) -> + ["Register and unregister two nodes"]; +register_names_1(suite) -> + []; +register_names_1(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock1} = register_node("foobar"), + ?line {ok,Sock2} = register_node("foozap"), + ?line ok = close(Sock1), % Unregister + ?line ok = close(Sock2), % Unregister + ok. + +register_names_2(doc) -> + ["Register and unregister two nodes"]; +register_names_2(suite) -> + []; +register_names_2(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock1} = register_node("foobar"), + ?line {ok,Sock2} = register_node("foozap"), + ?line ok = close(Sock2), % Unregister + ?line ok = close(Sock1), % Unregister + ok. + +register_duplicate_name(doc) -> + ["Two nodes with the same name"]; +register_duplicate_name(suite) -> + []; +register_duplicate_name(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = register_node("foobar"), + ?line error = register_node("foobar"), + ?line ok = close(Sock), % Unregister + ok. + +% Internal function to register a node name, no close, i.e. unregister + +register_node(Name) -> + register_node(Name,?DUMMY_PORT). + +register_node(Name, Port) -> + case connect() of + {ok,Sock} -> + M = [?EPMD_ALIVE_REQ, put16(Port), Name], + case send(Sock, [size16(M), M]) of + ok -> + case recv(Sock,3) of + {ok, [?EPMD_ALIVE_OK_RESP,_D1,_D0]} -> + {ok,Sock}; + Other -> + test_server:format("recv on sock ~w: ~p~n", + [Sock,Other]), + error + end; + Other -> + test_server:format("send on sock ~w: ~w~n",[Sock,Other]), + error + end; + Other -> + test_server:format("Connect on port ~w: ~p~n",[Port,Other]), + error + end. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +name_with_null_inside(doc) -> + ["Register a name with a null char in it"]; +name_with_null_inside(suite) -> + []; +name_with_null_inside(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line error = register_node("foo\000bar"), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +name_null_terminated(doc) -> + ["Register a name with terminating null byte"]; +name_null_terminated(suite) -> + []; +name_null_terminated(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = register_node("foobar\000"), + ?line error = register_node("foobar"), + ?line ok = close(Sock), % Unregister + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +stupid_names_req(doc) -> + ["Read names from epmd in a stupid way"]; +stupid_names_req(suite) -> + []; +stupid_names_req(Config) when list(Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + LongDog = test_server:timetrap(?MEDIUM_TEST_TIMEOUT), + ?line ok = epmdrun(), + ?line [FirstConn | Conn] = register_many(1, ?REG_REPEAT_LIM, "foo"), + ?line unregister_many([FirstConn]), + sleep(?MEDIUM_PAUSE), + ?line ok = check_names(Conn), + ?line ok = unregister_many(Conn), + test_server:timetrap_cancel(LongDog), + ok. + +check_names(Conn) -> + ?line {ok,Sock} = connect_active(), + ?line {ok,Reply} = do_get_names(Sock), + ?line SortConn = lists:sort(Conn), + ?line SortReply = lists:sort(Reply), + ?line ok = check_names_cmp(SortConn, SortReply), + ok. + + +% Compare if the result was the same as was registered + +check_names_cmp([], []) -> + ok; +check_names_cmp([{Name,Port,_Sock} | Conn], [{Name,Port} | Reply]) -> + check_names_cmp(Conn, Reply). + + +% This code is taken directly from "erl_epmd.erl" in R3A01 + +-define(int16(X), [(X bsr 8) band 16#ff, X band 16#ff]). +-define(u32(X1,X2,X3,X4), + (((X1) bsl 24) bor ((X2) bsl 16) bor ((X3) bsl 8) bor X4)). + +do_get_names(Socket) -> + inet_tcp:send(Socket, [?int16(1),?EPMD_NAMES_REQ]), + receive + {tcp, Socket, [P0,P1,P2,P3 | T]} -> + EpmdPort = ?u32(P0,P1,P2,P3), + if EpmdPort == ?PORT -> + names_loop(Socket, T, []); + true -> + close(Socket), + {error, address} + end; + {tcp_closed, Socket} -> + {ok, []} + end. + +names_loop(Socket, Acc, Ps) -> + receive + {tcp, Socket, Bytes} -> + {NAcc, NPs} = scan_names(Acc ++ Bytes, Ps), + names_loop(Socket, NAcc, NPs); + {tcp_closed, Socket} -> + {_, NPs} = scan_names(Acc, Ps), % Really needed? + {ok, NPs} + end. + +scan_names(Buf, Ps) -> + case scan_line(Buf, []) of + {Line, NBuf} -> + case parse_line(Line) of + {ok, Entry} -> + scan_names(NBuf, [Entry | Ps]); + error -> + scan_names(NBuf, Ps) + end; + [] -> {Buf, Ps} + end. + +scan_line([$\n | Buf], Line) -> {lists:reverse(Line), Buf}; +scan_line([C | Buf], Line) -> scan_line(Buf, [C|Line]); +scan_line([], _) -> []. + +parse_line([$n,$a,$m,$e,$ | Buf0]) -> + case parse_name(Buf0, []) of + {Name, Buf1} -> + case Buf1 of + [$a,$t,$ ,$p,$o,$r,$t,$ | Buf2] -> + case catch list_to_integer(Buf2) of + {'EXIT', _} -> error; + Port -> {ok, {Name, Port}} + end; + _ -> error + end; + error -> error + end; +parse_line(_) -> error. + + +parse_name([$ | Buf], Name) -> {lists:reverse(Name), Buf}; +parse_name([C | Buf], Name) -> parse_name(Buf, [C|Name]); +parse_name([], _Name) -> error. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +get_port_nr(doc) -> + ["Register a name on a port and ask about port nr"]; +get_port_nr(suite) -> + []; +get_port_nr(Config) when list(Config) -> + port_request([?EPMD_PORT_REQ,"foo"]). + +slow_get_port_nr(doc) -> + ["Register with slow write and ask about port nr"]; +slow_get_port_nr(suite) -> + []; +slow_get_port_nr(Config) when list(Config) -> + port_request([?EPMD_PORT_REQ,d,$f,d,$o,d,$o]). + + +% Internal function used above + +port_request(M) -> + ?line ok = epmdrun(), + Port = 1042, + ?line {ok,RSock} = register_node("foo", Port), + ?line {ok,Sock} = connect(), + ?line ok = send(Sock,[size16(M),M]), + R = put16(Port), + ?line {ok,R} = recv(Sock, length(R)), + ?line ok = close(RSock), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +unregister_others_name_1(doc) -> + ["Unregister name of other node"]; +unregister_others_name_1(suite) -> + []; +unregister_others_name_1(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,RSock} = register_node("foo"), + ?line {ok,Sock} = connect(), + M = [?EPMD_STOP_REQ,"foo"], + ?line ok = send(Sock,[size16(M),M]), + R = "STOPPED", + ?line {ok,R} = recv(Sock,length(R)), + ?line ok = close(RSock), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +unregister_others_name_2(doc) -> + ["Unregister name of other node"]; +unregister_others_name_2(suite) -> + []; +unregister_others_name_2(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + M = [?EPMD_STOP_REQ,"xxx42"], + ?line ok = send(Sock,[size16(M),M]), + R = "NOEXIST", + ?line {ok,R} = recv(Sock,length(R)), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +register_overflow(doc) -> + ["Register too many, clean and redo 10 times"]; +register_overflow(suite) -> + []; +register_overflow(Config) when list(Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + LongDog = test_server:timetrap(?LONG_TEST_TIMEOUT), + ?line ok = epmdrun(), + ?line Conn = register_many(1, ?REG_REPEAT_LIM, "foo"), + Count = length(Conn), + ?line ok = unregister_many(Conn), + sleep(?MEDIUM_PAUSE), + test_server:format("Limit was ~w names, now reg/unreg all 10 times~n", + [Count]), + ?line ok = register_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = rregister_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = register_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = rregister_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = register_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = rregister_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = register_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = rregister_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = register_repeat(Count), + sleep(?MEDIUM_PAUSE), + ?line ok = rregister_repeat(Count), + test_server:timetrap_cancel(LongDog), + ok. + +register_repeat(Count) -> + Conn = register_many(1, ?REG_REPEAT_LIM, "foo"), + ok = unregister_many(Conn), + if + length(Conn) == Count -> + ok; + true -> + error + end. + +rregister_repeat(Count) -> + Conn = register_many(1, ?REG_REPEAT_LIM, "foo"), + ok = unregister_many(lists:reverse(Conn)), + if + length(Conn) == Count -> + ok; + true -> + error + end. + +% Return count of successful registrations + +register_many(I, N, _Prefix) when I > N -> + test_server:format("Done with all ~n", []), + []; +register_many(I, N, Prefix) -> + Name = gen_name(Prefix, I), + Port = ?DUMMY_PORT + I, % Just make it up + case register_node(Name, Port) of + {ok,Sock} -> + [{Name,Port,Sock} | register_many(I + 1, N, Prefix)]; + Any -> + test_server:format("Can't register: ~w of 1..~w ~w~n", + [Name,N,Any]), + [] + end. + +unregister_many([]) -> + ok; +unregister_many([{Name,_Port,Sock} | Socks]) -> + case close(Sock) of + ok -> + unregister_many(Socks); + Any -> + test_server:format("Can't unregister: ~w reason ~w~n", [Name,Any]), + error + end. + +gen_name(Str,Int) -> + Str ++ integer_to_list(Int). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +no_data(doc) -> + ["Open but send no data"]; +no_data(suite) -> + []; +no_data(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + sleep(?LONG_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +one_byte(doc) -> + ["Send one byte only"]; +one_byte(suite) -> + []; +one_byte(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + ?line ok = send(Sock,[0]), + sleep(?LONG_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +two_bytes(doc) -> + ["Send packet size only"]; +two_bytes(suite) -> + []; +two_bytes(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + ?line ok = send(Sock,[put16(3)]), + sleep(?LONG_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +partial_packet(doc) -> + ["Got only part of a packet"]; +partial_packet(suite) -> + []; +partial_packet(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + ?line ok = send(Sock,[put16(100),"only a few bytes"]), + sleep(?LONG_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +zero_length(doc) -> + ["Invalid zero packet size"]; +zero_length(suite) -> + []; +zero_length(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + ?line ok = send(Sock,[0,0,0,0,0,0,0,0,0,0]), + sleep(?MEDIUM_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +too_large(doc) -> + ["Invalid large packet"]; +too_large(suite) -> + []; +too_large(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + Size = 63000, + M = lists:duplicate(Size, $z), + ?line ok = send(Sock,[put16(Size),M]), + sleep(?MEDIUM_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +alive_req_too_small_1(doc) -> + ["Try to register but not enough data"]; +alive_req_too_small_1(suite) -> + []; +alive_req_too_small_1(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + M = [?EPMD_ALIVE_REQ, 42], + ?line ok = send(Sock, [size16(M), M]), + sleep(?MEDIUM_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +alive_req_too_small_2(doc) -> + ["Try to register but not enough data"]; +alive_req_too_small_2(suite) -> + []; +alive_req_too_small_2(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + M = [?EPMD_ALIVE_REQ, put16(?DUMMY_PORT)], + ?line ok = send(Sock, [size16(M), M]), + sleep(?MEDIUM_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +alive_req_too_large(doc) -> + ["Try to register but node name too large"]; +alive_req_too_large(suite) -> + []; +alive_req_too_large(Config) when list(Config) -> + ?line ok = epmdrun(), + ?line {ok,Sock} = connect(), + L = [ + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + ], + M = [?EPMD_ALIVE_REQ, put16(?DUMMY_PORT), L], + ?line ok = send(Sock, [size16(M), M]), + sleep(?MEDIUM_PAUSE), + ?line closed = recv(Sock,1), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Terminate all tests with killing epmd. + +cleanup() -> + sleep(?MEDIUM_PAUSE), + case connect() of + {ok,Sock} -> + M = [?EPMD_KILL_REQ], + send(Sock, [size16(M), M]), + recv(Sock,length("OK")), + close(Sock), + sleep(?MEDIUM_PAUSE); + _ -> + true + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Normal debug start of epmd + +epmdrun() -> + case os:find_executable(epmd) of + false -> + {error, {could_not_find_epmd_in_path}}; + Path -> + epmdrun(Path) + end. + +epmdrun(Epmd) -> + %% test_server:format("epmdrun() => Epmd = ~p",[Epmd]), + osrun(Epmd ++ " " ?EPMDARGS " -port " ++ integer_to_list(?PORT)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Start an external process + +osrun(Cmd) -> + _ = open_port({spawn, Cmd}, []), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Wrappers of TCP functions + +% These two functions is the interface for connect. +% Passive mode is the default + +connect() -> + connect(?PORT, passive). + +connect_active() -> + connect(?PORT, active). + + +% Try a few times before giving up + +connect(Port, Mode) -> + case connect_repeat(?CONN_RETRY, Port, Mode) of + {ok,Sock} -> + {ok,Sock}; + {error,timeout} -> + timeout; + {error,Reason} -> + test_server:format("connect: error: ~w~n",[Reason]), + error; + Any -> + test_server:format("connect: unknown message: ~w~n",[Any]), + exit(1) + end. + + +% Try a few times before giving up. Pause a small time between +% each try. + +connect_repeat(1, Port, Mode) -> + connect_mode(Port, Mode); +connect_repeat(Retry, Port, Mode) -> + case connect_mode(Port, Mode) of + {ok,Sock} -> + {ok,Sock}; + {error,Reason} -> + test_server:format("connect: error: ~w~n",[Reason]), + timer:sleep(?CONN_SLEEP), + connect_repeat(Retry - 1, Port, Mode); + Any -> + test_server:format("connect: unknown message: ~w~n",[Any]), + exit(1) + end. + +connect_mode(Port, active) -> + gen_tcp:connect("localhost", Port, [{packet, 0}], ?CONN_TIMEOUT); +connect_mode(Port, passive) -> + gen_tcp:connect("localhost", Port, [{packet, 0}, {active, false}], + ?CONN_TIMEOUT). + + +close(Sock) -> + case gen_tcp:close(Sock) of + {error,_} -> + error; + ok -> + ok; + Any -> + test_server:format("unknown message: ~w~n",[Any]), + exit(1) + end. + +recv(Sock, Len) -> + recv(Sock, Len, ?RECV_TIMEOUT). + +recv(Sock, Len, Timeout) -> + case gen_tcp:recv(Sock, Len, Timeout) of + {ok,[]} -> % Should not be the case + recv(Sock, 1, 1); % any longer + {ok,Data} -> + {ok,Data}; + {error,timeout} -> + timeout; + {error,closed} -> + closed; + {error,_}=Error -> + Error; + Any -> + test_server:format("unknown message: ~w~n",[Any]), + exit(1) + end. + +%% Send data to socket. The list can be non flat and contain +%% the atom 'd' or tuple {d,Seconds} where this is delay +%% put in between the sent characters. + +send(Sock, SendSpec) -> + case send(SendSpec, [], Sock) of + {ok,[]} -> + ok; + {ok,RevBytes} -> + send_direct(Sock, lists:reverse(RevBytes)); + Any -> + Any + end. + + +% If an error, return immediately +% Collect real characters in the first argument to form +% a string to send. Only perform "actions", like a delay, +% when this argument is empty. + +send([], RevBytes, _Sock) -> + {ok,RevBytes}; +send([Byte | Spec], RevBytes, Sock) when integer(Byte) -> + send(Spec, [Byte | RevBytes], Sock); +send([List | Spec], RevBytes, Sock) when list(List) -> + case send(List, RevBytes, Sock) of + {ok,Left} -> + send(Spec, Left, Sock); + Other -> + Other + end; +send([d | Spec], RevBytes, Sock) -> + send([{d,1000} | Spec], RevBytes, Sock); +send([{d,S} | Spec], RevBytes, Sock) -> + case send_direct(Sock, lists:reverse(RevBytes)) of + ok -> + timer:sleep(S), + send(Spec, [], Sock); + Any -> + Any + end. + +%%%% + +send_direct(Sock, Bytes) -> + case gen_tcp:send(Sock, Bytes) of + ok -> + ok; + {error, closed} -> + closed; + {error, _Reason} -> + error; + Any -> + test_server:format("unknown message: ~w~n",[Any]), + Any + end. + +sleep(MilliSeconds) -> + timer:sleep(MilliSeconds). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +put16(N) -> + [N bsr 8, N band 16#ff]. + +size16(List) -> + N = flat_count(List, 0), + [N bsr 8, N band 16#ff]. + +flat_count([H|T], N) when is_integer(H) -> + flat_count(T, N+1); +flat_count([H|T], N) when is_list(H) -> + flat_count(T, flat_count(H, N)); +flat_count([_|T], N) -> + flat_count(T, N); +flat_count([], N) -> N. + diff --git a/erts/etc/Makefile b/erts/etc/Makefile new file mode 100644 index 0000000000..2b32b8ae50 --- /dev/null +++ b/erts/etc/Makefile @@ -0,0 +1,27 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1999-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk + + +SUB_DIRECTORIES = common +ifeq ($(TARGET),win32) +SUB_DIRECTORIES += win32 +endif + +include $(ERL_TOP)/make/otp_subdir.mk diff --git a/erts/etc/common/Makefile b/erts/etc/common/Makefile new file mode 100644 index 0000000000..73ab79d145 --- /dev/null +++ b/erts/etc/common/Makefile @@ -0,0 +1,23 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# Invoke with GNU make or clearmake -C gnu. +# + +include $(ERL_TOP)/make/run_make.mk diff --git a/erts/etc/common/Makefile.in b/erts/etc/common/Makefile.in new file mode 100644 index 0000000000..a9acab640e --- /dev/null +++ b/erts/etc/common/Makefile.in @@ -0,0 +1,564 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include $(ERL_TOP)/make/target.mk + +ERTS_LIB_TYPEMARKER=.$(TYPE) + +USING_MINGW=@MIXED_CYGWIN_MINGW@ +USING_VC=@MIXED_CYGWIN_VC@ + +ifeq ($(TYPE),debug) +PURIFY = +TYPEMARKER = .debug +TYPE_FLAGS = -DDEBUG @DEBUG_FLAGS@ +else +ifeq ($(TYPE),purify) +PURIFY = purify +TYPEMARKER = +ifeq ($(findstring ose,$(TARGET)),ose) +TYPE_FLAGS = -g -XO -DPURIFY +else +TYPE_FLAGS = -g -O2 -DPURIFY +endif +else +PURIFY = +TYPEMARKER = +ERTS_LIB_TYPEMARKER= +TYPE_FLAGS = +endif +endif + +include $(ERL_TOP)/make/$(TARGET)/otp.mk +include ../../vsn.mk + +ERTS_INCL = -I$(ERL_TOP)/erts/include \ + -I$(ERL_TOP)/erts/include/$(TARGET) \ + -I$(ERL_TOP)/erts/include/internal \ + -I$(ERL_TOP)/erts/include/internal/$(TARGET) + +CC = @CC@ +WFLAGS = @WFLAGS@ +CFLAGS = @CFLAGS@ @DEFS@ $(TYPE_FLAGS) @WFLAGS@ -I$(SYSDIR) -I$(EMUDIR) \ + $(ERTS_INCL) -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\" +LD = @LD@ +LIBS = @LIBS@ +LDFLAGS = @LDFLAGS@ + +ifeq ($(TARGET),win32) +ifeq ($(TYPE),debug) +CFLAGS = $(subst -O2,-g,@CFLAGS@ @DEFS@ $(TYPE_FLAGS) @WFLAGS@ -I$(SYSDIR) \ + -I$(EMUDIR) $(ERTS_INCL) -DOTP_SYSTEM_VERSION=\"$(SYSTEM_VSN)\") +LDFLAGS += -g +endif +endif +BINDIR = $(ERL_TOP)/bin/$(TARGET) +OBJDIR = $(ERL_TOP)/erts/obj$(TYPEMARKER)/$(TARGET) +EMUDIR = $(ERL_TOP)/erts/emulator/beam +EMUOSDIR = $(ERL_TOP)/erts/emulator/@ERLANG_OSTYPE@ +SYSDIR = $(ERL_TOP)/erts/emulator/sys/@ERLANG_OSTYPE@ +DRVDIR = $(ERL_TOP)/erts/emulator/drivers/@ERLANG_OSTYPE@ +VXETC = ../vxworks +UXETC = ../unix +OSEETC = ../ose +WINETC = ../win32 + +ifeq ($(findstring vxworks,$(TARGET)), vxworks) +ERLEXEC = erl.exec +else +ifeq ($(findstring ose,$(TARGET)), ose) +ERLEXEC = +TAR = @TAR@ +else +ifeq ($(TARGET), win32) +ERLEXEC = erlexec.dll +else +ERLEXEC = erlexec +endif +endif +endif + +# On windows we always need reentrant libraries. +ifeq ($(TARGET),win32) +ERLEXEC_XLIBS=-L../../lib/internal/$(TARGET) -lerts_internal_r$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ +else +ERLEXEC_XLIBS=-L../../lib/internal/$(TARGET) -lerts_internal$(ERTS_LIB_TYPEMARKER) @ERTS_INTERNAL_X_LIBS@ +endif + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- + +ifeq ($(findstring vxworks,$(TARGET)), vxworks) +INSTALL_EMBEDDED_PROGS = $(BINDIR)/erl_io $(BINDIR)/rdate $(BINDIR)/vxcall +INSTALL_EMBEDDED_DATA = $(BINDIR)/erl_script.sam $(VXETC)/resolv.conf +INSTALL_INCLUDES = $(VXETC)/reclaim.h +INSTALL_TOP = $(VXETC)/README.VxWorks +INSTALL_MISC = +INSTALL_SRC = heart.c $(VXETC)/heart_config.h $(VXETC)/heart_config.c \ + $(VXETC)/erl.exec.c $(VXETC)/rdate.c $(VXETC)/vxcall.c \ + $(VXETC)/erl_io.c +ERLEXECDIR = $(VXETC) +INSTALL_LIBS = $(OBJDIR)/reclaim.o +INSTALL_OBJS = $(OBJDIR)/heart.o +TEXTFILES = $(BINDIR)/erl_script.sam +ERLSRV_OBJECTS= +MC_OUTPUTS= +ENTRY_LDFLAGS= +ENTRY_OBJ= +INSTALL_PROGS = \ + $(INET_GETHOST) \ + $(BINDIR)/heart \ + $(BINDIR)/$(ERLEXEC) \ + $(INSTALL_EMBEDDED_PROGS) +else +ifeq ($(findstring ose,$(TARGET)), ose) +INSTALL_TOP = $(OSEETC)/README.OSE +INSTALL_ERL_OSE = monolith lm erl_utils drivers port_progs host +INSTALL_SRC = +INSTALL_LIBS = +INSTALL_OBJS = +INSTALL_INCLUDES = +INSTALL_PROGS = +ERLSRV_OBJECTS= +MC_OUTPUTS= +ENTRY_LDFLAGS= +ENTRY_OBJ= +else +ifeq ($(TARGET),win32) +CFLAGS += -I$(EMUOSDIR) -I$(WINETC) +RC=rc.sh +MC=mc.sh +ERLSRV_HEADERS= \ + $(WINETC)/erlsrv/erlsrv_global.h \ + $(WINETC)/erlsrv/erlsrv_registry.h \ + $(WINETC)/erlsrv/erlsrv_util.h \ + $(WINETC)/erlsrv/erlsrv_interactive.h \ + $(WINETC)/erlsrv/erlsrv_service.h + +ifeq ($(USING_VC), yes) +ERLRES_OBJ=erl.res +ERLSRV_OBJECTS= \ + $(OBJDIR)/erlsrv_registry.o \ + $(OBJDIR)/erlsrv_service.o \ + $(OBJDIR)/erlsrv_interactive.o \ + $(OBJDIR)/erlsrv_main.o \ + $(OBJDIR)/erlsrv_util.o \ + $(OBJDIR)/erlsrv_logmess.res +MC_OUTPUTS= \ + $(OBJDIR)/erlsrv_logmess.h $(OBJDIR)/erlsrv_logmess.rc + MT_FLAG="-MT" +else +ERLRES_OBJ=erl_res.o +ERLSRV_OBJECTS= \ + $(OBJDIR)/erlsrv_registry.o \ + $(OBJDIR)/erlsrv_service.o \ + $(OBJDIR)/erlsrv_interactive.o \ + $(OBJDIR)/erlsrv_main.o \ + $(OBJDIR)/erlsrv_util.o \ + $(OBJDIR)/erlsrv_logmess.o +MC_OUTPUTS= \ + $(OBJDIR)/erlsrv_logmess.h $(OBJDIR)/erlsrv_logmess.res + MT_FLAG="-MD" +endif +INET_GETHOST = $(BINDIR)/inet_gethost.exe +INSTALL_EMBEDDED_PROGS += $(BINDIR)/typer.exe $(BINDIR)/dialyzer.exe $(BINDIR)/erlc.exe $(BINDIR)/start_erl.exe $(BINDIR)/escript.exe +INSTALL_SRC = $(WINETC)/start_erl.c $(WINETC)/Nmakefile.start_erl +ERLEXECDIR=. +INSTALL_LIBS = +INSTALL_OBJS = +INSTALL_INCLUDES = +TEXTFILES = Install.ini +INSTALL_TOP = Install.ini +INSTALL_TOP_BIN = $(BINDIR)/Install.exe +INSTALL_PROGS = \ + $(INET_GETHOST) \ + $(BINDIR)/heart.exe $(BINDIR)/erlsrv.exe \ + $(BINDIR)/erl.exe $(BINDIR)/werl.exe \ + $(BINDIR)/$(ERLEXEC) \ + $(INSTALL_EMBEDDED_PROGS) + +ENTRY_SRC=$(WINETC)/port_entry.c +ENTRY_OBJ=$(OBJDIR)/port_entry.o +ifeq ($(USING_VC), yes) +WINDSOCK = ws2_32.lib mswsock.lib +else +WINDSOCK = -lws2_32 +endif +PORT_ENTRY_POINT=erl_port_entry +ENTRY_LDFLAGS=-entry:$(PORT_ENTRY_POINT) + +else +ENTRY_LDFLAGS= +ENTRY_OBJ= +ERLSRV_OBJECTS= +MC_OUTPUTS= +INET_GETHOST = $(BINDIR)/inet_gethost@EXEEXT@ +INSTALL_EMBEDDED_PROGS += $(BINDIR)/typer@EXEEXT@ $(BINDIR)/dialyzer@EXEEXT@ \ + $(BINDIR)/erlc@EXEEXT@ $(BINDIR)/escript@EXEEXT@ \ + $(BINDIR)/run_erl $(BINDIR)/to_erl $(BINDIR)/dyn_erl +INSTALL_EMBEDDED_DATA = ../unix/start.src ../unix/start_erl.src +INSTALL_TOP = Install +INSTALL_TOP_BIN = +INSTALL_MISC = ../unix/format_man_pages ../unix/makewhatis +INSTALL_SRC = ../unix/setuid_socket_wrap.c #delivered as an example +ERLEXECDIR = . +INSTALL_LIBS = +INSTALL_OBJS = +INSTALL_INCLUDES = +TEXTFILES = Install erl.src +INSTALL_PROGS = \ + $(INET_GETHOST) \ + $(BINDIR)/heart@EXEEXT@ \ + $(BINDIR)/$(ERLEXEC) \ + $(INSTALL_EMBEDDED_PROGS) +endif +endif +endif + +etc: erts_lib $(ENTRY_OBJ) $(INSTALL_PROGS) $(INSTALL_LIBS) $(TEXTFILES) $(INSTALL_TOP_BIN) + +# erlexec needs the erts_internal library... +erts_lib: + cd $(ERL_TOP)/erts/lib_src && $(MAKE) $(TYPE) + +docs: + +clean: +ifneq ($(INSTALL_PROGS),) + rm -f $(INSTALL_PROGS) +endif +ifneq ($(ENTRY_OBJ),) + rm -f $(ENTRY_OBJ) +endif +ifneq ($(ERLSRV_OBJECTS),) + rm -f $(ERLSRV_OBJECTS) +endif +ifneq ($(MC_OUTPUTS),) + rm -f $(MC_OUTPUTS) +endif +ifneq ($(ERLRES_OBJ),) + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/$(ERLRES_OBJ) +endif + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/win_erlexec.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/init_file.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/start_erl.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/dialyzer.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/erlexec.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/erl_io.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/erlc.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/escript.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/heart.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/heart_config.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/inet_gethost.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/rdate.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/reclaim.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/run_erl.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/to_erl.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/dyn_erl.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/safe_string.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/typer.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/vxcall.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/erl.o + rm -f $(ERL_TOP)/erts/obj*/$(TARGET)/werl.o + rm -f *~ core + +# +# Objects & executables +# +#$(OBJDIR)/%.o: %.c +# $(CC) $(CFLAGS) -o $@ -c $< +# +#$(OBJDIR)/%.o: ../unix/%.c +# $(CC) $(CFLAGS) -o $@ -c $< +# +#$(BINDIR)/%: $(OBJDIR)/%.o +# $(PURIFY) $(LD) $(LDFLAGS) -o $@ $< $(LIBS) + +$(OBJDIR)/inet_gethost.o: inet_gethost.c + $(CC) $(CFLAGS) -o $@ -c inet_gethost.c + +$(BINDIR)/inet_gethost@EXEEXT@: $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) + $(PURIFY) $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/inet_gethost.o $(ENTRY_OBJ) $(LIBS) + +$(BINDIR)/run_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/run_erl.o $(LIBS) + +$(OBJDIR)/run_erl.o: ../unix/run_erl.c + $(CC) $(CFLAGS) -o $@ -c ../unix/run_erl.c + +$(BINDIR)/to_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/to_erl.o + +$(OBJDIR)/to_erl.o: ../unix/to_erl.c + $(CC) $(CFLAGS) -o $@ -c ../unix/to_erl.c + +$(BINDIR)/dyn_erl: $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/safe_string.o $(OBJDIR)/dyn_erl.o + +$(OBJDIR)/dyn_erl.o: ../unix/dyn_erl.c + $(CC) $(CFLAGS) -o $@ -c ../unix/dyn_erl.c + +$(OBJDIR)/safe_string.o: ../unix/safe_string.c + $(CC) $(CFLAGS) -o $@ -c ../unix/safe_string.c + +ifneq ($(TARGET),win32) +$(BINDIR)/$(ERLEXEC): $(OBJDIR)/$(ERLEXEC).o + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/$(ERLEXEC).o $(ERLEXEC_XLIBS) + +$(OBJDIR)/$(ERLEXEC).o: $(ERLEXECDIR)/$(ERLEXEC).c + $(CC) -I$(EMUDIR) $(CFLAGS) -o $@ -c $(ERLEXECDIR)/$(ERLEXEC).c +endif +$(BINDIR)/erlc@EXEEXT@: $(OBJDIR)/erlc.o + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/erlc.o -L$(OBJDIR) $(LIBS) + +$(OBJDIR)/erlc.o: erlc.c + $(CC) $(CFLAGS) -o $@ -c erlc.c + +$(BINDIR)/dialyzer@EXEEXT@: $(OBJDIR)/dialyzer.o + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/dialyzer.o -L$(OBJDIR) $(LIBS) + +$(OBJDIR)/dialyzer.o: dialyzer.c + $(CC) $(CFLAGS) -o $@ -c dialyzer.c + +$(BINDIR)/typer@EXEEXT@: $(OBJDIR)/typer.o + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/typer.o -L$(OBJDIR) $(LIBS) + +$(OBJDIR)/typer.o: typer.c + $(CC) $(CFLAGS) -o $@ -c typer.c + +$(BINDIR)/escript@EXEEXT@: $(OBJDIR)/escript.o + $(PURIFY) $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/escript.o -L$(OBJDIR) $(LIBS) + +$(OBJDIR)/escript.o: escript.c + $(CC) $(CFLAGS) -o $@ -c escript.c + +#------------------------------------------------------------------------ +# Windows specific targets +# The windows platform is quite different from the others. erl/werl are small C programs +# loading a DLL. INI files are used instead of environment variables and the Install +# script is actually a program, also Install has an INI file which tells of emulator +# versions etc. +#---------------------------------------------------------------------- + +ifeq ($(TARGET),win32) + +$(BINDIR)/$(ERLEXEC): $(OBJDIR)/erlexec.o $(OBJDIR)/win_erlexec.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_OBJ) dbg + $(LD) -dll $(LDFLAGS) -o $@ $(OBJDIR)/erlexec.o $(OBJDIR)/win_erlexec.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_OBJ) $(ERLEXEC_XLIBS) + +dbg: + echo DBG + +$(BINDIR)/erl@EXEEXT@: $(OBJDIR)/erl.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_OBJ) + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/erl.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_OBJ) + +$(BINDIR)/werl@EXEEXT@: $(OBJDIR)/werl.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_OBJ) + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/werl.o $(OBJDIR)/init_file.o $(OBJDIR)/$(ERLRES_OBJ) + +$(BINDIR)/start_erl@EXEEXT@: $(OBJDIR)/start_erl.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/start_erl.o + +$(BINDIR)/Install@EXEEXT@: $(OBJDIR)/Install.o $(OBJDIR)/init_file.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/Install.o $(OBJDIR)/init_file.o + +$(BINDIR)/erlsrv@EXEEXT@: $(ERLSRV_OBJECTS) + $(LD) $(LDFLAGS) $(MT_FLAG) -o $@ $(ERLSRV_OBJECTS) + +# The service expects to be compiled with $(MT_FLAG) flag. + +$(OBJDIR)/%.o: $(WINETC)/erlsrv/%.c $(ERLSRV_HEADERS) + $(CC) $(CFLAGS) $(MT_FLAG) -o $@ -c $< + +$(OBJDIR)/erlsrv_util.o: $(WINETC)/erlsrv/erlsrv_util.c $(ERLSRV_HEADERS) \ +$(OBJDIR)/erlsrv_logmess.h + $(CC) $(CFLAGS) -I$(OBJDIR) $(MT_FLAG) -o $@ -c $< + +ifeq ($(USING_VC), yes) +$(OBJDIR)/erlsrv_logmess.res: $(OBJDIR)/erlsrv_logmess.rc + $(RC) -o $(OBJDIR)/erlsrv_logmess.res -I$(OBJDIR) $(OBJDIR)/erlsrv_logmess.rc +else +$(OBJDIR)/erlsrv_logmess.o: $(OBJDIR)/erlsrv_logmess.res + $(RC) -o $(OBJDIR)/erlsrv_logmess.o -I$(OBJDIR) $(OBJDIR)/erlsrv_logmess.res +endif + +$(MC_OUTPUTS): $(WINETC)/erlsrv/erlsrv_logmess.mc + $(MC) -o $(OBJDIR) $(WINETC)/erlsrv/erlsrv_logmess.mc + +$(OBJDIR)/werl.o: $(WINETC)/erl.c + $(CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ + -DWIN32_WERL -o $@ -c $(WINETC)/erl.c + +$(OBJDIR)/erl.o: $(WINETC)/erl.c + $(CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ + -o $@ -c $(WINETC)/erl.c + +$(OBJDIR)/erlexec.o: $(ERLEXECDIR)/erlexec.c + $(CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ + -o $@ -c $(ERLEXECDIR)/erlexec.c + +$(OBJDIR)/win_erlexec.o: $(WINETC)/win_erlexec.c + $(CC) $(CFLAGS) -DBUILD_TYPE=\"-$(TYPE)\" -DERL_RUN_SHARED_LIB=1 \ + -o $@ -c $(WINETC)/win_erlexec.c + +$(OBJDIR)/init_file.o: $(WINETC)/init_file.c $(WINETC)/init_file.h + $(CC) $(CFLAGS) -o $@ -c $(WINETC)/init_file.c + +$(OBJDIR)/Install.o: $(WINETC)/Install.c $(WINETC)/init_file.h + $(CC) $(CFLAGS) -o $@ -c $(WINETC)/Install.c + +$(OBJDIR)/$(ERLRES_OBJ): $(WINETC)/erl.rc $(WINETC)/erlang.ico $(WINETC)/erl_icon.ico $(WINETC)/hrl_icon.ico $(WINETC)/beam_icon.ico + $(RC) -o $@ -I$(WINETC) $(WINETC)/erl.rc + +$(OBJDIR)/start_erl.o: $(WINETC)/start_erl.c + $(CC) $(CFLAGS) -o $@ -c $(WINETC)/start_erl.c + +$(ENTRY_OBJ): $(ENTRY_SRC) + $(CC) $(CFLAGS) -o $@ -c $(ENTRY_SRC) + +Install.ini: ../$(TARGET)/Install.src ../../vsn.mk $(TARGET)/Makefile + sed -e 's;%I_VSN%;$(VSN);' \ + -e 's;%I_SYSTEM_VSN%;$(SYSTEM_VSN);' \ + ../$(TARGET)/Install.src > Install.ini + + +endif +#--------------------------------------------------------- +# End of windows specific targets. +#--------------------------------------------------------- + +ifeq ($(findstring vxworks,$(TARGET)), vxworks) +$(BINDIR)/heart: $(OBJDIR)/heart.o $(OBJDIR)/heart_config.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/heart.o $(OBJDIR)/heart_config.o + +$(OBJDIR)/heart_config.o: $(VXETC)/heart_config.c + $(CC) $(CFLAGS) -o $@ -c $(VXETC)/heart_config.c + +$(OBJDIR)/reclaim.o: $(VXETC)/reclaim.c + $(CC) $(CFLAGS) -o $@ -c $(VXETC)/reclaim.c + +$(OBJDIR)/heart.o: heart.c + $(CC) $(CFLAGS) -I$(VXETC) -o $@ -c heart.c + +$(BINDIR)/erl_script.sam: $(VXETC)/erl_script.sam.in ../../vsn.mk + sed -e 's;%VSN%;$(VSN);' \ + $(VXETC)/erl_script.sam.in > $(BINDIR)/erl_script.sam +else + +$(BINDIR)/heart@EXEEXT@: $(OBJDIR)/heart.o $(ENTRY_OBJ) + $(LD) $(LDFLAGS) $(ENTRY_LDFLAGS) -o $@ $(OBJDIR)/heart.o \ + $(ENTRY_OBJ) $(WINDSOCK) + +$(OBJDIR)/heart.o: heart.c + $(CC) $(CFLAGS) -o $@ -c heart.c + +endif + + +# VxWorks specific executables and objects ... + +$(BINDIR)/erl_io: $(OBJDIR)/erl_io.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/erl_io.o + +$(OBJDIR)/erl_io.o: $(VXETC)/erl_io.c + $(CC) $(CFLAGS) -o $@ -c $(VXETC)/erl_io.c + +$(BINDIR)/rdate: $(OBJDIR)/rdate.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/rdate.o + +$(OBJDIR)/rdate.o: $(VXETC)/rdate.c + $(CC) $(CFLAGS) -o $@ -c $(VXETC)/rdate.c + +$(BINDIR)/vxcall: $(OBJDIR)/vxcall.o + $(LD) $(LDFLAGS) -o $@ $(OBJDIR)/vxcall.o + +$(OBJDIR)/vxcall.o: $(VXETC)/vxcall.c + $(CC) $(CFLAGS) -o $@ -c $(VXETC)/vxcall.c + + + +Install: ../unix/Install.src ../../vsn.mk $(TARGET)/Makefile + sed -e 's;%I_VSN%;$(VSN);' \ + -e 's;%EMULATOR%;$(EMULATOR);' \ + -e 's;%EMULATOR_NUMBER%;$(EMULATOR_NUMBER);' \ + -e 's;%I_SYSTEM_VSN%;$(SYSTEM_VSN);' \ + ../unix/Install.src > Install + +erl.src: ../unix/erl.src.src ../../vsn.mk $(TARGET)/Makefile + sed -e 's;%EMULATOR%;$(EMULATOR);' \ + -e 's;%EMULATOR_NUMBER%;$(EMULATOR_NUMBER);' \ + -e 's;%VSN%;$(VSN);' \ + ../unix/erl.src.src > erl.src + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: etc +ifneq ($(INSTALL_OBJS),) + $(INSTALL_DIR) $(RELEASE_PATH)/erts-$(VSN)/obj + $(INSTALL_DATA) $(INSTALL_OBJS) $(RELEASE_PATH)/erts-$(VSN)/obj +endif + $(INSTALL_DIR) $(RELEASE_PATH)/erts-$(VSN)/bin +ifneq ($(TARGET), win32) +ifneq ($(findstring vxworks,$(TARGET)), vxworks) +ifneq ($(findstring ose,$(TARGET)), ose) + $(INSTALL_SCRIPT) erl.src $(RELEASE_PATH)/erts-$(VSN)/bin +endif +endif +endif +ifneq ($(INSTALL_PROGS),) + $(INSTALL_PROGRAM) $(INSTALL_PROGS) $(RELEASE_PATH)/erts-$(VSN)/bin +endif +ifneq ($(INSTALL_TOP),) + $(INSTALL_SCRIPT) $(INSTALL_TOP) $(RELEASE_PATH) +endif +ifneq ($(INSTALL_TOP_BIN),) + $(INSTALL_PROGRAM) $(INSTALL_TOP_BIN) $(RELEASE_PATH) +endif +ifneq ($(INSTALL_MISC),) + $(INSTALL_DIR) $(RELEASE_PATH)/misc + $(INSTALL_SCRIPT) $(INSTALL_MISC) $(RELEASE_PATH)/misc +endif +ifneq ($(INSTALL_ERL_OSE),) + $(INSTALL_DIR) $(RELEASE_PATH)/build_erl_ose + cd $(OSEETC) && $(TAR) erl_ose_$(SYSTEM_VSN).tar $(INSTALL_ERL_OSE) + cd $(OSEETC) && $(INSTALL_SCRIPT) erl_ose_$(SYSTEM_VSN).tar $(RELEASE_PATH)/build_erl_ose +endif +ifneq ($(INSTALL_SRC),) + $(INSTALL_DIR) $(RELEASE_PATH)/erts-$(VSN)/src + $(INSTALL_DATA) $(INSTALL_SRC) $(RELEASE_PATH)/erts-$(VSN)/src +endif +ifneq ($(INSTALL_EMBEDDED_DATA),) + $(INSTALL_DATA) $(INSTALL_EMBEDDED_DATA) $(RELEASE_PATH)/erts-$(VSN)/bin +endif +ifneq ($(INSTALL_LIBS),) + $(INSTALL_DATA) $(INSTALL_LIBS) $(RELEASE_PATH)/erts-$(VSN)/bin +endif +ifneq ($(INSTALL_INCLUDES),) + $(INSTALL_DIR) $(RELEASE_PATH)/erts-$(VSN)/include + $(INSTALL_DATA) $(INSTALL_INCLUDES) $(RELEASE_PATH)/erts-$(VSN)/include +endif + +release_docs_spec: + + + + + diff --git a/erts/etc/common/dialyzer.c b/erts/etc/common/dialyzer.c new file mode 100644 index 0000000000..9c66be7f0f --- /dev/null +++ b/erts/etc/common/dialyzer.c @@ -0,0 +1,466 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: Dialyzer front-end. + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#ifdef __WIN32__ +#include +#endif + +#include + +#define NO 0 +#define YES 1 + +#define ASIZE(a) (sizeof(a)/sizeof(a[0])) + +static int debug = 0; /* Bit flags for debug printouts. */ + +static char** eargv_base; /* Base of vector. */ +static char** eargv; /* First argument for erl. */ + +static int eargc; /* Number of arguments in eargv. */ + +#ifdef __WIN32__ +# define QUOTE(s) possibly_quote(s) +# define IS_DIRSEP(c) ((c) == '/' || (c) == '\\') +# define ERL_NAME "erl.exe" +#else +# define QUOTE(s) s +# define IS_DIRSEP(c) ((c) == '/') +# define ERL_NAME "erl" +#endif + +#define UNSHIFT(s) eargc++, eargv--; eargv[0] = QUOTE(s) +#define PUSH(s) eargv[eargc++] = QUOTE(s) +#define PUSH2(s, t) PUSH(s); PUSH(t) +#define PUSH3(s, t, u) PUSH2(s, t); PUSH(u) + +/* + * Local functions. + */ + +static void error(char* format, ...); +static char* emalloc(size_t size); +static char* strsave(char* string); +static void push_words(char* src); +static int run_erlang(char* name, char** argv); +static char* get_default_emulator(char* progname); +#ifdef __WIN32__ +static char* possibly_quote(char* arg); +#endif + +/* + * Supply a strerror() function if libc doesn't. + */ +#ifndef HAVE_STRERROR + +extern int sys_nerr; + +#ifndef SYS_ERRLIST_DECLARED +extern const char * const sys_errlist[]; +#endif /* !SYS_ERRLIST_DECLARED */ + +char *strerror(int errnum) +{ + static char *emsg[1024]; + + if (errnum != 0) { + if (errnum > 0 && errnum < sys_nerr) + sprintf((char *) &emsg[0], "(%s)", sys_errlist[errnum]); + else + sprintf((char *) &emsg[0], "errnum = %d ", errnum); + } + else { + emsg[0] = '\0'; + } + return (char *) &emsg[0]; +} +#endif /* !HAVE_STRERROR */ + +static char * +get_env(char *key) +{ +#ifdef __WIN32__ + DWORD size = 32; + char *value = NULL; + while (1) { + DWORD nsz; + if (value) + free(value); + value = emalloc(size); + SetLastError(0); + nsz = GetEnvironmentVariable((LPCTSTR) key, (LPTSTR) value, size); + if (nsz == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) { + free(value); + return NULL; + } + if (nsz <= size) + return value; + size = nsz; + } +#else + return getenv(key); +#endif +} + +static void +free_env_val(char *value) +{ +#ifdef __WIN32__ + if (value) + free(value); +#endif +} + +int +main(int argc, char** argv) +{ + int eargv_size; + int eargc_base; /* How many arguments in the base of eargv. */ + char* emulator; + char *env; + int need_shell = 0; + + env = get_env("DIALYZER_EMULATOR"); + emulator = env ? env : get_default_emulator(argv[0]); + + /* + * Allocate the argv vector to be used for arguments to Erlang. + * Arrange for starting to pushing information in the middle of + * the array, to allow easy addition of commands in the beginning. + */ + + eargv_size = argc*4+100; + eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); + eargv = eargv_base; + eargc = 0; + push_words(emulator); + eargc_base = eargc; + eargv = eargv + eargv_size/2; + eargc = 0; + + free_env_val(env); + + /* + * Push initial arguments. + */ + + if (argc > 1 && strcmp(argv[1], "--wx") == 0) { + PUSH2("-smp", "--wx"); /* wx currently requires SMP enabled */ + argc--, argv++; + } + + if (argc > 1 && strcmp(argv[1], "-smp") == 0) { + PUSH("-smpauto"); + argc--, argv++; + } + + if (argc > 2 && strcmp(argv[1], "+S") == 0) { + PUSH3("-smp", "+S", argv[2]); + argc--, argv++; + argc--, argv++; + } + + PUSH("+B"); + PUSH2("-boot", "start_clean"); + PUSH3("-run", "dialyzer", "plain_cl"); + PUSH("-extra"); + + /* + * Push everything except --shell. + */ + + while (argc > 1) { + if (strcmp(argv[1], "--shell") == 0) { + need_shell = 1; + } else { + PUSH(argv[1]); + } + argc--, argv++; + } + + if (!need_shell) { + UNSHIFT("-noinput"); + } + + /* + * Move up the commands for invoking the emulator and adjust eargv + * accordingly. + */ + + while (--eargc_base >= 0) { + UNSHIFT(eargv_base[eargc_base]); + } + + /* + * Invoke Erlang with the collected options. + */ + + PUSH(NULL); + return run_erlang(eargv[0], eargv); +} + +static void +push_words(char* src) +{ + char sbuf[1024]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} +#ifdef __WIN32__ +char *make_commandline(char **argv) +{ + static char *buff = NULL; + static int siz = 0; + int num = 0; + char **arg, *p; + + if (*argv == NULL) { + return ""; + } + for (arg = argv; *arg != NULL; ++arg) { + num += strlen(*arg)+1; + } + if (!siz) { + siz = num; + buff = malloc(siz*sizeof(char)); + } else if (siz < num) { + siz = num; + buff = realloc(buff,siz*sizeof(char)); + } + p = buff; + for (arg = argv; *arg != NULL; ++arg) { + strcpy(p,*arg); + p+=strlen(*arg); + *p++=' '; + } + *(--p) = '\0'; + + if (debug) { + printf("Processed commandline:%s\n",buff); + } + return buff; +} + +int my_spawnvp(char **argv) +{ + STARTUPINFO siStartInfo; + PROCESS_INFORMATION piProcInfo; + DWORD ec; + + memset(&siStartInfo,0,sizeof(STARTUPINFO)); + siStartInfo.cb = sizeof(STARTUPINFO); + siStartInfo.dwFlags = STARTF_USESTDHANDLES; + siStartInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + siStartInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + siStartInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE); + siStartInfo.wShowWindow = SW_HIDE; + siStartInfo.dwFlags |= STARTF_USESHOWWINDOW; + + + if (!CreateProcess(NULL, + make_commandline(argv), + NULL, + NULL, + TRUE, + 0, + NULL, + NULL, + &siStartInfo, + &piProcInfo)) { + return -1; + } + CloseHandle(piProcInfo.hThread); + + WaitForSingleObject(piProcInfo.hProcess,INFINITE); + if (!GetExitCodeProcess(piProcInfo.hProcess,&ec)) { + return 0; + } + return (int) ec; +} +#endif /* __WIN32__ */ + + +static int +run_erlang(char* progname, char** argv) +{ +#ifdef __WIN32__ + int status; +#endif + + if (debug) { + int i = 0; + while (argv[i] != NULL) + printf(" %s", argv[i++]); + printf("\n"); + } + +#ifdef __WIN32__ + /* + * Alas, we must wait here for the program to finish. + * Otherwise, the shell from which we was executed will think + * we are finished and print a prompt and read keyboard input. + */ + + status = my_spawnvp(argv)/*_spawnvp(_P_WAIT,progname,argv)*/; + if (status == -1) { + fprintf(stderr, "dialyzer: Error executing '%s': %d", progname, + GetLastError()); + } + return status; +#else + execvp(progname, argv); + error("Error %d executing \'%s\'.", errno, progname); + return 2; +#endif +} + +static void +error(char* format, ...) +{ + char sbuf[1024]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + fprintf(stderr, "dialyzer: %s\n", sbuf); + exit(1); +} + +static char* +emalloc(size_t size) +{ + char *p = malloc(size); + if (p == NULL) + error("Insufficient memory"); + return p; +} + +static char* +strsave(char* string) +{ + char* p = emalloc(strlen(string)+1); + strcpy(p, string); + return p; +} + +static char* +get_default_emulator(char* progname) +{ + char sbuf[MAXPATHLEN]; + char* s; + + strcpy(sbuf, progname); + for (s = sbuf+strlen(sbuf); s >= sbuf; s--) { + if (IS_DIRSEP(*s)) { + strcpy(s+1, ERL_NAME); +#ifdef __WIN32__ + if (_access(sbuf, 0) != -1) { + return strsave(sbuf); + } +#else + if (access(sbuf, 1) != -1) { + return strsave(sbuf); + } +#endif + break; + } + } + return ERL_NAME; +} + +#ifdef __WIN32__ +static char* +possibly_quote(char* arg) +{ + int mustQuote = NO; + int n = 0; + char* s; + char* narg; + + if (arg == NULL) { + return arg; + } + + /* + * Scan the string to find out if it needs quoting and return + * the original argument if not. + */ + + for (s = arg; *s; s++, n++) { + switch(*s) { + case ' ': + mustQuote = YES; + continue; + case '"': + mustQuote = YES; + n++; + continue; + case '\\': + if(s[1] == '"') + n++; + continue; + default: + continue; + } + } + if (!mustQuote) { + return arg; + } + + /* + * Insert the quotes and put a backslash in front of every quote + * inside the string. + */ + + s = narg = emalloc(n+2+1); + for (*s++ = '"'; *arg; arg++, s++) { + if (*arg == '"' || (*arg == '\\' && arg[1] == '"')) { + *s++ = '\\'; + } + *s = *arg; + } + if (s[-1] == '\\') { + *s++ ='\\'; + } + *s++ = '"'; + *s = '\0'; + return narg; +} +#endif /* __WIN32__ */ diff --git a/erts/etc/common/erlc.c b/erts/etc/common/erlc.c new file mode 100644 index 0000000000..c958fed741 --- /dev/null +++ b/erts/etc/common/erlc.c @@ -0,0 +1,701 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: Common compiler front-end. + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#ifdef __WIN32__ +#include +/* FIXE ME config_win32.h? */ +#define HAVE_STRERROR 1 +#endif + +#include + +#define NO 0 +#define YES 1 + +#define ASIZE(a) (sizeof(a)/sizeof(a[0])) + +static int debug = 0; /* Bit flags for debug printouts. */ + +static char** eargv_base; /* Base of vector. */ +static char** eargv; /* First argument for erl. */ + +static int eargc; /* Number of arguments in eargv. */ + +#ifdef __WIN32__ +# define QUOTE(s) possibly_quote(s) +# define IS_DIRSEP(c) ((c) == '/' || (c) == '\\') +# define ERL_NAME "erl.exe" +#else +# define QUOTE(s) s +# define IS_DIRSEP(c) ((c) == '/') +# define ERL_NAME "erl" +#endif + +#define UNSHIFT(s) eargc++, eargv--; eargv[0] = QUOTE(s) +#define PUSH(s) eargv[eargc++] = QUOTE(s) +#define PUSH2(s, t) PUSH(s); PUSH(t) +#define PUSH3(s, t, u) PUSH2(s, t); PUSH(u) + +static char* output_type = NULL; /* Type of output file. */ +#ifdef __WIN32__ +static int pause_after_execution = 0; +#endif + +/* + * Local functions. + */ + +static char* process_opt(int* pArgc, char*** pArgv, int offset); +static void error(char* format, ...); +static void usage(void); +static char* emalloc(size_t size); +static char* strsave(char* string); +static void push_words(char* src); +static int run_erlang(char* name, char** argv); +static char* get_default_emulator(char* progname); +#ifdef __WIN32__ +static char* possibly_quote(char* arg); +#endif + +/* + * Supply a strerror() function if libc doesn't. + */ +#ifndef HAVE_STRERROR + +extern int sys_nerr; + +#ifndef SYS_ERRLIST_DECLARED +extern const char * const sys_errlist[]; +#endif /* !SYS_ERRLIST_DECLARED */ + +char *strerror(int errnum) +{ + static char *emsg[1024]; + + if (errnum != 0) { + if (errnum > 0 && errnum < sys_nerr) + sprintf((char *) &emsg[0], "(%s)", sys_errlist[errnum]); + else + sprintf((char *) &emsg[0], "errnum = %d ", errnum); + } + else { + emsg[0] = '\0'; + } + return (char *) &emsg[0]; +} +#endif /* !HAVE_STRERROR */ + +static char * +get_env(char *key) +{ +#ifdef __WIN32__ + DWORD size = 32; + char *value = NULL; + while (1) { + DWORD nsz; + if (value) + free(value); + value = emalloc(size); + SetLastError(0); + nsz = GetEnvironmentVariable((LPCTSTR) key, (LPTSTR) value, size); + if (nsz == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) { + free(value); + return NULL; + } + if (nsz <= size) + return value; + size = nsz; + } +#else + return getenv(key); +#endif +} + +static void +free_env_val(char *value) +{ +#ifdef __WIN32__ + if (value) + free(value); +#endif +} + + +int +main(int argc, char** argv) +{ + char cwd[MAXPATHLEN]; /* Current working directory. */ + char** rpc_eargv; /* Pointer to the beginning of arguments + * if calling a running Erlang system + * via erl_rpc(). + */ + int eargv_size; + int eargc_base; /* How many arguments in the base of eargv. */ + char* emulator; + char *env; + + env = get_env("ERLC_EMULATOR"); + emulator = env ? env : get_default_emulator(argv[0]); + + /* + * Allocate the argv vector to be used for arguments to Erlang. + * Arrange for starting to pushing information in the middle of + * the array, to allow easy adding of emulator options (like -pa) + * before '-s erlcompile compile_cmdline...'. + * + * Oh, by the way, we will push the compiler command in the + * base of the eargv vector, and move it up later. + */ + + eargv_size = argc*4+100; + eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); + eargv = eargv_base; + eargc = 0; + push_words(emulator); + eargc_base = eargc; + eargv = eargv + eargv_size/2; + eargc = 0; + + free_env_val(env); + + /* + * Push initial arguments. + */ + + PUSH("-noinput"); + PUSH2("-mode", "minimal"); + PUSH2("-boot", "start_clean"); + PUSH3("-s", "erl_compile", "compile_cmdline"); + rpc_eargv = eargv+eargc; + + /* + * Push standard arguments to Erlang. + * + * The @cwd argument was once needed, but from on R13B02 is optional. + * For maximum compatibility between erlc and erl of different versions, + * still provide the @cwd argument, unless it is too long to be + * represented as an atom. + */ + if (getcwd(cwd, sizeof(cwd)) == NULL) + error("Failed to get current working directory: %s", strerror(errno)); +#ifdef __WIN32__ + (void) GetShortPathName(cwd, cwd, sizeof(cwd)); +#endif + if (strlen(cwd) < 256) { + PUSH2("@cwd", cwd); + } + + /* + * Parse all command line switches. + */ + + while (argc > 1 && (argv[1][0] == '-' || argv[1][0] == '+')) { + + /* + * Options starting with '+' are passed on to Erlang. + */ + + if (argv[1][0] == '+') { + PUSH2("@option", argv[1]+1); + } else { + /* + * Interpret options starting with '-'. + */ + + switch (argv[1][1]) { + case 'b': + output_type = process_opt(&argc, &argv, 0); + PUSH2("@output_type", output_type); + break; + case 'c': /* Allowed for compatibility with 'erl'. */ + if (strcmp(argv[1], "-compile") != 0) + goto error; + break; + case 'd': + debug = 1; + break; + case 'D': + { + char* def = process_opt(&argc, &argv, 0); + char* equals; + + def = strsave(def); /* Do not clobber original. */ + if ((equals = strchr(def, '=')) == NULL) { + PUSH2("@d", def); + } else { + *equals = '\0'; + equals++; + PUSH3("@dv", def, equals); + } + } + break; + case 'h': + if (strcmp(argv[1], "-hybrid") == 0) { + UNSHIFT(argv[1]); + } else { + usage(); + } + break; + case 'I': + PUSH2("@i", process_opt(&argc, &argv, 0)); + break; + case 'o': + PUSH2("@outdir", process_opt(&argc, &argv, 0)); + break; + case 'O': + PUSH("@optimize"); + if (argv[1][2] == '\0') + PUSH("1"); + else + PUSH(argv[1]+2); + break; + case 'p': + { + int c = argv[1][2]; + + if (c != 'a' && c != 'z') { + goto error; +#ifdef __WIN32__ + } else if (strcmp(argv[1], "-pause") == 0) { + pause_after_execution = 1; +#endif + } else { + char option[4]; + + UNSHIFT(process_opt(&argc, &argv, 1)); + option[0] = '-'; + option[1] = 'p'; + option[2] = c; + option[3] = '\0'; + UNSHIFT(strsave(option)); + } + } + break; + case 's': + if (strcmp(argv[1], "-smp") == 0) { + UNSHIFT(argv[1]); + } else { + goto error; + } + break; + case 'v': /* Verbose. */ + PUSH2("@verbose", "true"); + break; + case 'V': + /** XXX Version perhaps, but of what? **/ + break; + case 'W': /* Enable warnings. */ + if (strcmp(argv[1]+2, "all") == 0) { + PUSH2("@warn", "999"); + } else if (isdigit((int)argv[1][2])) { + PUSH2("@warn", argv[1]+2); + } else { + PUSH2("@warn", "1"); + } + break; + case 'E': + case 'S': + case 'P': + { + char* buf; + + /* + * From the given upper-case letter, construct + * a quoted atom. This is a convenience for the + * Erlang compiler, to avoid fighting with the shell's + * quoting. + */ + + buf = emalloc(4); + buf[0] = '\''; + buf[1] = argv[1][1]; + buf[2] = '\''; + buf[3] = '\0'; + + PUSH2("@option", buf); + } + break; + + case '-': + goto no_more_options; + + default: + error: + usage(); + break; + } + } + argc--, argv++; + } + + no_more_options: + + if (argc <= 1) { + /* + * To avoid starting an Erlang system unless absolutely needed + * exit if no files were specified on the command line. + */ + exit(0); + } + + /* + * The rest of the command line must be filenames. Simply push them. + */ + + PUSH("@files"); + while (argc > 1) { + PUSH(argv[1]); + argc--, argv++; + } + + /* + * Move up the commands for invoking the emulator and adjust eargv + * accordingly. + */ + + while (--eargc_base >= 0) { + UNSHIFT(eargv_base[eargc_base]); + } + + /* + * Invoke Erlang with the collected options. + */ + + PUSH(NULL); + return run_erlang(eargv[0], eargv); +} + +static char* +process_opt(int* pArgc, char*** pArgv, int offset) +{ + int argc = *pArgc; + char** argv = *pArgv; + int c = argv[1][1]; + + if (argv[1][2+offset] != '\0') { + /* + * The option was given as -x. + */ + return argv[1]+2+offset; + } + + /* + * Look at the next argument. + */ + + argc--, argv++; + if (argc < 2 || argv[1][0] == '-') + error("No value given to -%c option", c); + *pArgc = argc; + *pArgv = argv; + return argv[1]; +} + +static void +push_words(char* src) +{ + char sbuf[1024]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} +#ifdef __WIN32__ +char *make_commandline(char **argv) +{ + static char *buff = NULL; + static int siz = 0; + int num = 0; + char **arg, *p; + + if (*argv == NULL) { + return ""; + } + for (arg = argv; *arg != NULL; ++arg) { + num += strlen(*arg)+1; + } + if (!siz) { + siz = num; + buff = malloc(siz*sizeof(char)); + } else if (siz < num) { + siz = num; + buff = realloc(buff,siz*sizeof(char)); + } + p = buff; + for (arg = argv; *arg != NULL; ++arg) { + strcpy(p,*arg); + p+=strlen(*arg); + *p++=' '; + } + *(--p) = '\0'; + + if (debug) { + printf("Processed commandline:%s\n",buff); + } + return buff; +} + +int my_spawnvp(char **argv) +{ + STARTUPINFO siStartInfo; + PROCESS_INFORMATION piProcInfo; + DWORD ec; + + memset(&siStartInfo,0,sizeof(STARTUPINFO)); + siStartInfo.cb = sizeof(STARTUPINFO); + siStartInfo.dwFlags = STARTF_USESTDHANDLES; + siStartInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + siStartInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + siStartInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE); + siStartInfo.wShowWindow = SW_HIDE; + siStartInfo.dwFlags |= STARTF_USESHOWWINDOW; + + + if (!CreateProcess(NULL, + make_commandline(argv), + NULL, + NULL, + TRUE, + 0, + NULL, + NULL, + &siStartInfo, + &piProcInfo)) { + return -1; + } + CloseHandle(piProcInfo.hThread); + + WaitForSingleObject(piProcInfo.hProcess,INFINITE); + if (!GetExitCodeProcess(piProcInfo.hProcess,&ec)) { + return 0; + } + return (int) ec; +} +#endif /* __WIN32__ */ + + +static int +run_erlang(char* progname, char** argv) +{ +#ifdef __WIN32__ + int status; +#endif + + if (debug) { + int i = 0; + while (argv[i] != NULL) + printf(" %s", argv[i++]); + printf("\n"); + } + +#ifdef __WIN32__ + /* + * Alas, we must wait here for the program to finish. + * Otherwise, the shell from which we was executed will think + * we are finished and print a prompt and read keyboard input. + */ + + status = my_spawnvp(argv)/*_spawnvp(_P_WAIT,progname,argv)*/; + if (status == -1) { + fprintf(stderr, "erlc: Error executing '%s': %d", progname, + GetLastError()); + } + if (pause_after_execution) { + fprintf(stderr, "Press ENTER to continue . . .\n"); + while (getchar() != '\n') + ; + } + return status; +#else + execvp(progname, argv); + error("Error %d executing \'%s\'.", errno, progname); + return 2; +#endif +} + +static void +usage(void) +{ + static struct { + char* name; + char* desc; + } options[] = { + {"-b type", "type of output file (e.g. jam or beam)"}, + {"-d", "turn on debugging of erlc itself"}, + {"-Dname", "define name"}, + {"-Dname=value", "define name to have value"}, + {"-hybrid", "compile using hybrid-heap emulator"}, + {"-help", "shows this help text"}, + {"-I path", "where to search for include files"}, + {"-o name", "name output directory or file"}, + {"-pa path", "add path to the front of Erlang's code path"}, + {"-pz path", "add path to the end of Erlang's code path"}, + {"-smp", "compile using SMP emulator"}, + {"-v", "verbose compiler output"}, + {"-W0", "disable warnings"}, + {"-Wnumber", "set warning level to number"}, + {"-Wall", "enable all warnings"}, + {"-W", "enable warnings (default; same as -W1)"}, + {"-E", "generate listing of expanded code (Erlang compiler)"}, + {"-S", "generate assembly listing (Erlang compiler)"}, + {"-P", "generate listing of preprocessed code (Erlang compiler)"}, + {"+term", "pass the Erlang term unchanged to the compiler"}, + }; + int i; + + fprintf(stderr, "Usage:\terlc [options] file.ext ...\n"); + fprintf(stderr, "Options:\n"); + for (i = 0; i < sizeof(options)/sizeof(options[0]); i++) { + fprintf(stderr, "%-14s %s\n", options[i].name, options[i].desc); + } + exit(1); +} + +static void +error(char* format, ...) +{ + char sbuf[1024]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + fprintf(stderr, "erlc: %s\n", sbuf); + exit(1); +} + +static char* +emalloc(size_t size) +{ + char *p = malloc(size); + if (p == NULL) + error("Insufficient memory"); + return p; +} + +static char* +strsave(char* string) +{ + char* p = emalloc(strlen(string)+1); + strcpy(p, string); + return p; +} + +static char* +get_default_emulator(char* progname) +{ + char sbuf[MAXPATHLEN]; + char* s; + + strcpy(sbuf, progname); + for (s = sbuf+strlen(sbuf); s >= sbuf; s--) { + if (IS_DIRSEP(*s)) { + strcpy(s+1, ERL_NAME); +#ifdef __WIN32__ + if (_access(sbuf, 0) != -1) { + return strsave(sbuf); + } +#else + if (access(sbuf, 1) != -1) { + return strsave(sbuf); + } +#endif + break; + } + } + return ERL_NAME; +} + +#ifdef __WIN32__ +static char* +possibly_quote(char* arg) +{ + int mustQuote = NO; + int n = 0; + char* s; + char* narg; + + if (arg == NULL) { + return arg; + } + + /* + * Scan the string to find out if it needs quoting and return + * the original argument if not. + */ + + for (s = arg; *s; s++, n++) { + switch(*s) { + case ' ': + mustQuote = YES; + continue; + case '"': + mustQuote = YES; + n++; + continue; + case '\\': + if(s[1] == '"') + n++; + continue; + default: + continue; + } + } + if (!mustQuote) { + return arg; + } + + /* + * Insert the quotes and put a backslash in front of every quote + * inside the string. + */ + + s = narg = emalloc(n+2+1); + for (*s++ = '"'; *arg; arg++, s++) { + if (*arg == '"' || (*arg == '\\' && arg[1] == '"')) { + *s++ = '\\'; + } + *s = *arg; + } + if (s[-1] == '\\') { + *s++ ='\\'; + } + *s++ = '"'; + *s = '\0'; + return narg; +} +#endif /* __WIN32__ */ diff --git a/erts/etc/common/erlexec.c b/erts/etc/common/erlexec.c new file mode 100644 index 0000000000..4325418e7c --- /dev/null +++ b/erts/etc/common/erlexec.c @@ -0,0 +1,2038 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This is a C version of the erl.exec Bourne shell script, including + * additions required for Windows NT. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include "erl_driver.h" +#include +#include +#include "erl_misc_utils.h" + +#ifdef __WIN32__ +# include "erl_version.h" +# include "init_file.h" +#endif + +#define NO 0 +#define YES 1 +#define DEFAULT_PROGNAME "erl" + +#ifdef __WIN32__ +#define INI_FILENAME "erl.ini" +#define INI_SECTION "erlang" +#define DIRSEP "\\" +#define PATHSEP ";" +#define NULL_DEVICE "nul" +#define BINARY_EXT "" +#define DLL_EXT ".dll" +#define EMULATOR_EXECUTABLE "beam.dll" +#else +#define PATHSEP ":" +#define DIRSEP "/" +#define NULL_DEVICE "/dev/null" +#define BINARY_EXT "" +#define EMULATOR_EXECUTABLE "beam" + +#endif +#define QUOTE(s) s + +/* +M alloc_util allocators */ +static const char plusM_au_allocs[]= { + 'u', /* all alloc_util allocators */ + 'B', /* binary_alloc */ + 'D', /* std_alloc */ + 'E', /* ets_alloc */ + 'H', /* eheap_alloc */ + 'L', /* ll_alloc */ + 'R', /* driver_alloc */ + 'S', /* sl_alloc */ + 'T', /* temp_alloc */ + '\0' +}; + +/* +M alloc_util allocator specific arguments */ +static char *plusM_au_alloc_switches[] = { + "as", + "asbcst", + "e", + "t", + "lmbcs", + "mbcgs", + "mbsd", + "mmbcs", + "mmmbc", + "mmsbc", + "msbclt", + "ramv", + "rmbcmt", + "rsbcmt", + "rsbcst", + "sbct", + "smbcs", + NULL +}; + +/* +M other arguments */ +static char *plusM_other_switches[] = { + "ea", + "ummc", + "uycs", + "im", + "is", + "it", + "Mamcbf", + "Mrmcbf", + "Mmcs", + "Mcci", + "Fe", + "Ye", + "Ym", + "Ytp", + "Ytt", + NULL +}; + +/* +s arguments with values */ +static char *pluss_val_switches[] = { + "bt", + "ct", + "ss", + NULL +}; + +/* + * Define sleep(seconds) in terms of Sleep() on Windows. + */ + +#ifdef __WIN32__ +#define sleep(seconds) Sleep(seconds*1000) +#endif + +#define SMP_SUFFIX ".smp" +#define HYBRID_SUFFIX ".hybrid" + +#ifdef __WIN32__ +#define DEBUG_SUFFIX ".debug" +#define EMU_TYPE_SUFFIX_LENGTH (strlen(HYBRID_SUFFIX)+(strlen(DEBUG_SUFFIX))) +#else +/* The length of the longest memory architecture suffix. */ +#define EMU_TYPE_SUFFIX_LENGTH strlen(HYBRID_SUFFIX) +#endif +/* + * Define flags for different memory architectures. + */ +#define EMU_TYPE_SMP 0x0001 +#define EMU_TYPE_HYBRID 0x0002 + +#ifdef __WIN32__ +#define EMU_TYPE_DEBUG 0x0004 +#endif + +void usage(const char *switchname); +void start_epmd(char *epmd); +void error(char* format, ...); + +/* + * Local functions. + */ + +#if !defined(ERTS_HAVE_SMP_EMU) || !defined(ERTS_HAVE_HYBRID_EMU) +static void usage_notsup(const char *switchname); +#endif +static void usage_msg(const char *msg); +static char **build_args_from_env(char *env_var); +static char **build_args_from_string(char *env_var); +static void initial_argv_massage(int *argc, char ***argv); +static void get_parameters(int argc, char** argv); +static void add_arg(char *new_arg); +static void add_args(char *first_arg, ...); +static void ensure_EargsSz(int sz); +static void add_Eargs(char *new_arg); +static void *emalloc(size_t size); +static void *erealloc(void *p, size_t size); +static void efree(void *p); +static char* strsave(char* string); +static int is_one_of_strings(char *str, char *strs[]); +static char *write_str(char *to, char *from); +static void get_home(void); +static void add_epmd_port(void); +#ifdef __WIN32__ +static void get_start_erl_data(char *); +static char* get_value(HKEY key, char* value_name, BOOL mustExit); +static char* possibly_quote(char* arg); + +/* + * Functions from win_erlexec.c + */ +int start_win_emulator(char* emu, char *startprog,char** argv, int start_detached); +int start_emulator(char* emu, char*start_prog, char** argv, int start_detached); +#endif + + + +/* + * Variables. + */ +int nohup = 0; +int keep_window = 0; + +static char **Eargsp = NULL; /* Emulator arguments (to appear first). */ +static int EargsSz = 0; /* Size of Eargsp */ +static int EargsCnt = 0; /* Number of emulator arguments. */ +static char **argsp = NULL; /* Common arguments. */ +static int argsCnt = 0; /* Number of common arguments */ +static int argsSz = 0; /* Size of argsp */ +static char tmpStr[10240]; /* Temporary string buffer. */ +static int verbose = 0; /* If non-zero, print some extra information. */ +static int start_detached = 0; /* If non-zero, the emulator should be + * started detached (in the background). + */ +static int emu_type = 0; /* If non-zero, start beam.ARCH or beam.ARCH.exe + * instead of beam or beam.exe, where ARCH is defined by flags. */ +static int emu_type_passed = 0; /* Types explicitly set */ + +#ifdef __WIN32__ +static char *start_emulator_program = NULL; /* For detachec mode - + erl.exe/werl.exe */ +static char* key_val_name = ERLANG_VERSION; /* Used by the registry + * access functions. + */ +static char* boot_script = NULL; /* used by option -start_erl and -boot */ +static char* config_script = NULL; /* used by option -start_erl and -config */ + +static HANDLE this_module_handle; +static int run_werl; + +#endif + +/* + * Needed parameters to be fetched from the environment (Unix) + * or the ini file (Win32). + */ + +static char* bindir; /* Location of executables. */ +static char* rootdir; /* Root location of Erlang installation. */ +static char* emu; /* Emulator to run. */ +static char* progname; /* Name of this program. */ +static char* home; /* Path of user's home directory. */ + +static void +set_env(char *key, char *value) +{ +#ifdef __WIN32__ + if (!SetEnvironmentVariable((LPCTSTR) key, (LPCTSTR) value)) + error("SetEnvironmentVariable(\"%s\", \"%s\") failed!", key, value); +#else + size_t size = strlen(key) + 1 + strlen(value) + 1; + char *str = emalloc(size); + sprintf(str, "%s=%s", key, value); + if (putenv(str) != 0) + error("putenv(\"%s\") failed!", str); +#ifdef HAVE_COPYING_PUTENV + efree(str); +#endif +#endif +} + +static char * +get_env(char *key) +{ +#ifdef __WIN32__ + DWORD size = 32; + char *value = NULL; + while (1) { + DWORD nsz; + if (value) + efree(value); + value = emalloc(size); + SetLastError(0); + nsz = GetEnvironmentVariable((LPCTSTR) key, (LPTSTR) value, size); + if (nsz == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) { + efree(value); + return NULL; + } + if (nsz <= size) + return value; + size = nsz; + } +#else + return getenv(key); +#endif +} + +static void +free_env_val(char *value) +{ +#ifdef __WIN32__ + if (value) + free(value); +#endif +} + +/* + * Add the arcitecture suffix to the program name if needed, + * except on Windows, where we insert it just before ".DLL". + */ +static char* +add_extra_suffixes(char *prog, int type) +{ + char *res; + char *p; + int len; +#ifdef __WIN32__ + char *dll_p; + int dll = 0; +#endif + + if (!type) { + return prog; + } + + len = strlen(prog); + + /* Worst-case allocation */ + p = emalloc(len + + EMU_TYPE_SUFFIX_LENGTH + + + 1); + res = p; + p = write_str(p, prog); + +#ifdef __WIN32__ + dll_p = res + len - 4; + if (dll_p >= res) { + if (dll_p[0] == '.' && + (dll_p[1] == 'd' || dll_p[1] == 'D') && + (dll_p[2] == 'l' || dll_p[2] == 'L') && + (dll_p[3] == 'l' || dll_p[3] == 'L')) { + p = dll_p; + dll = 1; + } + } +#endif + +#ifdef __WIN32__ + if (type & EMU_TYPE_DEBUG) { + p = write_str(p, DEBUG_SUFFIX); + type &= ~(EMU_TYPE_DEBUG); + } +#endif + if (type == EMU_TYPE_SMP) { + p = write_str(p, SMP_SUFFIX); + } + else if (type == EMU_TYPE_HYBRID) { + p = write_str(p, HYBRID_SUFFIX); + } +#ifdef __WIN32__ + if (dll) { + p = write_str(p, DLL_EXT); + } +#endif + + return res; +} + +#ifdef __WIN32__ +__declspec(dllexport) int win_erlexec(int argc, char **argv, HANDLE module, int windowed) +#else +int main(int argc, char **argv) +#endif +{ + int haltAfterwards = 0; /* If true, put 's erlang halt' at the end + * of the arguments. */ + int isdistributed = 0; + int no_epmd = 0; + int i; + char* s; + char *epmd_prog = NULL; + char *malloc_lib; + int process_args = 1; + int print_args_exit = 0; + int print_qouted_cmd_exit = 0; + erts_cpu_info_t *cpuinfo = NULL; + +#ifdef __WIN32__ + this_module_handle = module; + run_werl = windowed; + /* if we started this erl just to get a detached emulator, + * the arguments are already prepared for beam, so we skip + * directly to start_emulator */ + s = get_env("ERL_CONSOLE_MODE"); + if (s != NULL && strcmp(s, "detached")==0) { + free_env_val(s); + s = get_env("ERL_EMULATOR_DLL"); + if (s != NULL) { + argv[0] = strsave(s); + } else { + argv[0] = strsave(EMULATOR_EXECUTABLE); + } + ensure_EargsSz(argc + 1); + memcpy((void *) Eargsp, (void *) argv, argc * sizeof(char *)); + Eargsp[argc] = NULL; + emu = argv[0]; + start_emulator_program = strsave(argv[0]); + goto skip_arg_massage; + } + free_env_val(s); +#else + int reset_cerl_detached = 0; + + s = get_env("CERL_DETACHED_PROG"); + if (s && strcmp(s, "") != 0) { + emu = s; + start_detached = 1; + reset_cerl_detached = 1; + ensure_EargsSz(argc + 1); + memcpy((void *) Eargsp, (void *) argv, argc * sizeof(char *)); + Eargsp[argc] = emu; + Eargsp[argc] = NULL; + goto skip_arg_massage; + } + free_env_val(s); +#endif + + initial_argv_massage(&argc, &argv); /* Merge with env; expand -args_file */ + + i = 1; +#ifdef __WIN32__ + /* Not used? /rickard */ + if ((argc > 2) && (strcmp(argv[i], "-regkey") == 0)) { + key_val_name = strsave(argv[i+1]); + i = 3; + } +#endif + + get_parameters(argc, argv); + + /* + * Construct the path of the executable. + */ + cpuinfo = erts_cpu_info_create(); + /* '-smp auto' is default */ +#ifdef ERTS_HAVE_SMP_EMU + if (erts_get_cpu_configured(cpuinfo) > 1) + emu_type |= EMU_TYPE_SMP; +#endif + +#if defined(__WIN32__) && defined(WIN32_ALWAYS_DEBUG) + emu_type_passed |= EMU_TYPE_DEBUG; + emu_type |= EMU_TYPE_DEBUG; +#endif + + /* We need to do this before the ordinary processing. */ + malloc_lib = get_env("ERL_MALLOC_LIB"); + while (i < argc) { + if (argv[i][0] == '+') { + if (argv[i][1] == 'M' && argv[i][2] == 'Y' && argv[i][3] == 'm') { + if (argv[i][4] == '\0') { + if (++i < argc) + malloc_lib = argv[i]; + else + usage("+MYm"); + } + else + malloc_lib = &argv[i][4]; + } + } + else if (argv[i][0] == '-') { + if (strcmp(argv[i], "-smp") == 0) { + if (i + 1 >= argc) + goto smp; + + if (strcmp(argv[i+1], "auto") == 0) { + i++; + smp_auto: + emu_type_passed |= EMU_TYPE_SMP; +#ifdef ERTS_HAVE_SMP_EMU + if (erts_get_cpu_configured(cpuinfo) > 1) + emu_type |= EMU_TYPE_SMP; + else +#endif + emu_type &= ~EMU_TYPE_SMP; + } + else if (strcmp(argv[i+1], "enable") == 0) { + i++; + smp_enable: + emu_type_passed |= EMU_TYPE_SMP; +#ifdef ERTS_HAVE_SMP_EMU + emu_type |= EMU_TYPE_SMP; +#else + usage_notsup("-smp enable"); +#endif + } + else if (strcmp(argv[i+1], "disable") == 0) { + i++; + smp_disable: + emu_type_passed |= EMU_TYPE_SMP; + emu_type &= ~EMU_TYPE_SMP; + } + else { + smp: + + emu_type_passed |= EMU_TYPE_SMP; +#ifdef ERTS_HAVE_SMP_EMU + emu_type |= EMU_TYPE_SMP; +#else + usage_notsup("-smp"); +#endif + } + } else if (strcmp(argv[i], "-smpenable") == 0) { + goto smp_enable; + } else if (strcmp(argv[i], "-smpauto") == 0) { + goto smp_auto; + } else if (strcmp(argv[i], "-smpdisable") == 0) { + goto smp_disable; +#ifdef __WIN32__ + } else if (strcmp(argv[i], "-debug") == 0) { + emu_type_passed |= EMU_TYPE_DEBUG; + emu_type |= EMU_TYPE_DEBUG; +#endif + } else if (strcmp(argv[i], "-hybrid") == 0) { + emu_type_passed |= EMU_TYPE_HYBRID; +#ifdef ERTS_HAVE_HYBRID_EMU + emu_type |= EMU_TYPE_HYBRID; +#else + usage_notsup("-hybrid"); +#endif + } else if (strcmp(argv[i], "-extra") == 0) { + break; + } + } + i++; + } + + erts_cpu_info_destroy(cpuinfo); + cpuinfo = NULL; + + if ((emu_type & EMU_TYPE_HYBRID) && (emu_type & EMU_TYPE_SMP)) { + /* + * We have a conflict. Only using explicitly passed arguments + * may solve it... + */ + emu_type &= emu_type_passed; + if ((emu_type & EMU_TYPE_HYBRID) && (emu_type & EMU_TYPE_SMP)) { + usage_msg("Hybrid heap emulator with SMP support selected. The " + "combination hybrid heap and SMP support is currently " + "not supported."); + } + } + + if (malloc_lib) { + if (strcmp(malloc_lib, "libc") != 0) + usage("+MYm"); + } + emu = add_extra_suffixes(emu, emu_type); + sprintf(tmpStr, "%s" DIRSEP "%s" BINARY_EXT, bindir, emu); + emu = strsave(tmpStr); + + add_Eargs(emu); /* Will be argv[0] -- necessary! */ + + /* + * Add the bindir to the path (unless it is there already). + */ + + s = get_env("PATH"); + if (!s) { + sprintf(tmpStr, "%s" PATHSEP "%s" DIRSEP "bin", bindir, rootdir); + } else if (strstr(s, bindir) == NULL) { + sprintf(tmpStr, "%s" PATHSEP "%s" DIRSEP "bin" PATHSEP "%s", bindir, + rootdir, s); + } else { + sprintf(tmpStr, "%s", s); + } + free_env_val(s); + set_env("PATH", tmpStr); + + i = 1; + +#ifdef __WIN32__ +#define ADD_BOOT_CONFIG \ + if (boot_script) \ + add_args("-boot", boot_script, NULL); \ + if (config_script) \ + add_args("-config", config_script, NULL); +#else +#define ADD_BOOT_CONFIG +#endif + + get_home(); + add_args("-home", home, NULL); + + add_epmd_port(); + + add_arg("--"); + + while (i < argc) { + if (!process_args) { /* Copy arguments after '-extra' */ + add_arg(argv[i]); + i++; + } else { + switch (argv[i][0]) { + case '-': + switch (argv[i][1]) { +#ifdef __WIN32__ + case 'b': + if (strcmp(argv[i], "-boot") == 0) { + if (boot_script) + error("Conflicting -start_erl and -boot options"); + if (i+1 >= argc) + usage("-boot"); + boot_script = strsave(argv[i+1]); + i++; + } + else { + add_arg(argv[i]); + } + break; +#endif + case 'c': + if (strcmp(argv[i], "-compile") == 0) { + /* + * Note that the shell script erl.exec does an recursive call + * on itself here. We'll avoid doing that. + */ + add_args("-noshell", "-noinput", "-s", "c", "lc_batch", + NULL); + add_Eargs("-B"); + haltAfterwards = 0; + } +#ifdef __WIN32__ + else if (strcmp(argv[i], "-config") == 0){ + if (config_script) + error("Conflicting -start_erl and -config options"); + if (i+1 >= argc) + usage("-config"); + config_script = strsave(argv[i+1]); + i++; + } +#endif + else { + add_arg(argv[i]); + } + break; + + case 'd': + if (strcmp(argv[i], "-detached") != 0) { + add_arg(argv[i]); + } else { + start_detached = 1; + add_args("-noshell", "-noinput", NULL); + } + break; + + case 'i': + if (strcmp(argv[i], "-instr") == 0) { + add_Eargs("-Mim"); + add_Eargs("true"); + } + else + add_arg(argv[i]); + break; + + case 'e': + if (strcmp(argv[i], "-extra") == 0) { + process_args = 0; + ADD_BOOT_CONFIG; + add_arg(argv[i]); + } else if (strcmp(argv[i], "-emu_args") == 0) { /* -emu_args */ + verbose = 1; + } else if (strcmp(argv[i], "-emu_args_exit") == 0) { + print_args_exit = 1; + } else if (strcmp(argv[i], "-emu_qouted_cmd_exit") == 0) { + print_qouted_cmd_exit = 1; + } else if (strcmp(argv[i], "-env") == 0) { /* -env VARNAME VARVALUE */ + if (i+2 >= argc) + usage("-env"); + set_env(argv[i+1], argv[i+2]); + i += 2; + } else if (strcmp(argv[i], "-epmd") == 0) { + if (i+1 >= argc) + usage("-epmd"); + epmd_prog = argv[i+1]; + ++i; + } else { + add_arg(argv[i]); + } + break; + case 'k': + if (strcmp(argv[i], "-keep_window") == 0) { + keep_window = 1; + } else + add_arg(argv[i]); + break; + + case 'm': + /* + * Note that the shell script erl.exec does an recursive call + * on itself here. We'll avoid doing that. + */ + if (strcmp(argv[i], "-make") == 0) { + add_args("-noshell", "-noinput", "-s", "make", "all", NULL); + add_Eargs("-B"); + haltAfterwards = 1; + i = argc; /* Skip rest of command line */ + } else if (strcmp(argv[i], "-man") == 0) { +#if defined(__WIN32__) + error("-man not supported on Windows"); +#else + argv[i] = "man"; + sprintf(tmpStr, "%s/man", rootdir); + set_env("MANPATH", tmpStr); + execvp("man", argv+i); + error("Could not execute the 'man' command."); +#endif + } else + add_arg(argv[i]); + break; + + case 'n': + if (strcmp(argv[i], "-name") == 0) { /* -name NAME */ + if (i+1 >= argc) + usage("-name"); + + /* + * Note: Cannot use add_args() here, due to non-defined + * evaluation order. + */ + + add_arg(argv[i]); + add_arg(argv[i+1]); + isdistributed = 1; + i++; + } else if (strcmp(argv[i], "-noinput") == 0) { + add_args("-noshell", "-noinput", NULL); + } else if (strcmp(argv[i], "-nohup") == 0) { + add_arg("-nohup"); + nohup = 1; + } else if (strcmp(argv[i], "-no_epmd") == 0) { + add_arg("-no_epmd"); + no_epmd = 1; + } else { + add_arg(argv[i]); + } + break; + + case 's': /* -sname NAME */ + if (strcmp(argv[i], "-sname") == 0) { + if (i+1 >= argc) + usage("-sname"); + add_arg(argv[i]); + add_arg(argv[i+1]); + isdistributed = 1; + i++; + } +#ifdef __WIN32__ + else if (strcmp(argv[i], "-service_event") == 0) { + add_arg(argv[i]); + add_arg(argv[i+1]); + i++; + } + else if (strcmp(argv[i], "-start_erl") == 0) { + if (i+1 < argc && argv[i+1][0] != '-') { + get_start_erl_data(argv[i+1]); + i++; + } else + get_start_erl_data((char *) NULL); + } +#endif + else + add_arg(argv[i]); + + break; + + case 'v': /* -version */ + if (strcmp(argv[i], "-version") == 0) { + add_Eargs("-V"); + } else { + add_arg(argv[i]); + } + break; + + default: + add_arg(argv[i]); + break; + } /* switch(argv[i][1] */ + break; + + case '+': + switch (argv[i][1]) { + case '#': + case 'a': + case 'A': + case 'b': + case 'h': + case 'i': + case 'P': + case 'S': + case 'T': + case 'R': + case 'W': + case 'K': + if (argv[i][2] != '\0') + goto the_default; + if (i+1 >= argc) + usage(argv[i]); + argv[i][0] = '-'; + add_Eargs(argv[i]); + add_Eargs(argv[i+1]); + i++; + break; + case 'B': + argv[i][0] = '-'; + if (argv[i][2] != '\0') { + if ((argv[i][2] != 'i') && + (argv[i][2] != 'c') && + (argv[i][2] != 'd')) { + usage(argv[i]); + } else { + add_Eargs(argv[i]); + break; + } + } + if (i+1 < argc) { + if ((argv[i+1][0] != '-') && + (argv[i+1][0] != '+')) { + if (argv[i+1][0] == 'i') { + add_Eargs(argv[i]); + add_Eargs(argv[i+1]); + i++; + break; + } else { + usage(argv[i]); + } + } + } + add_Eargs(argv[i]); + break; + case 'M': { + int x; + for (x = 0; plusM_au_allocs[x]; x++) + if (plusM_au_allocs[x] == argv[i][2]) + break; + if ((plusM_au_allocs[x] + && is_one_of_strings(&argv[i][3], + plusM_au_alloc_switches)) + || is_one_of_strings(&argv[i][2], + plusM_other_switches)) { + if (i+1 >= argc + || argv[i+1][0] == '-' + || argv[i+1][0] == '+') + usage(argv[i]); + argv[i][0] = '-'; + add_Eargs(argv[i]); + add_Eargs(argv[i+1]); + i++; + } + else + goto the_default; + break; + } + case 's': + if (!is_one_of_strings(&argv[i][2], + pluss_val_switches)) + goto the_default; + else { + if (i+1 >= argc + || argv[i+1][0] == '-' + || argv[i+1][0] == '+') + usage(argv[i]); + argv[i][0] = '-'; + add_Eargs(argv[i]); + add_Eargs(argv[i+1]); + i++; + } + break; + default: + the_default: + argv[i][0] = '-'; /* Change +option to -option. */ + add_Eargs(argv[i]); + } + break; + + default: + add_arg(argv[i]); + } /* switch(argv[i][0] */ + i++; + } + } + + if (process_args) { + ADD_BOOT_CONFIG; + } +#undef ADD_BOOT_CONFIG + + /* Doesn't conflict with -extra, since -make skips all the rest of + the arguments. */ + if (haltAfterwards) { + add_args("-s", "erlang", "halt", NULL); + } + + if (isdistributed && !no_epmd) + start_epmd(epmd_prog); + +#if (! defined(__WIN32__)) && defined(DEBUG) + if (start_detached) { + /* Start the emulator within an xterm. + * Move up all arguments and insert + * "xterm -e " first. + * The path must be searched for this + * to work, i.e execvp() must be used. + */ + ensure_EargsSz(EargsCnt+2); + for (i = EargsCnt; i > 0; i--) + Eargsp[i+1] = Eargsp[i-1]; /* Two args to insert */ + EargsCnt += 2; /* Two args to insert */ + Eargsp[0] = emu = "xterm"; + Eargsp[1] = "-e"; + } +#endif + + add_Eargs("--"); + add_Eargs("-root"); + add_Eargs(rootdir); + add_Eargs("-progname"); + add_Eargs(progname); + add_Eargs("--"); + ensure_EargsSz(EargsCnt + argsCnt + 1); + for (i = 0; i < argsCnt; i++) + Eargsp[EargsCnt++] = argsp[i]; + Eargsp[EargsCnt] = NULL; + + if (print_qouted_cmd_exit) { + printf("\"%s\" ", emu); + for (i = 1; i < EargsCnt; i++) + printf("\"%s\" ", Eargsp[i]); + printf("\n"); + exit(0); + } + + if (print_args_exit) { + for (i = 1; i < EargsCnt; i++) + printf("%s ", Eargsp[i]); + printf("\n"); + exit(0); + } + + if (verbose) { + printf("Executing: %s", emu); + for (i = 0; i < EargsCnt; i++) + printf(" %s", Eargsp[i]); + printf("\n\n"); + } + +#ifdef __WIN32__ + + if (EargsSz != EargsCnt + 1) + Eargsp = (char **) erealloc((void *) Eargsp, (EargsCnt + 1) * + sizeof(char *)); + efree((void *) argsp); + + skip_arg_massage: + /*DebugBreak();*/ + + if (run_werl) { + if (start_detached) { + char *p; + /* transform werl to erl */ + p = start_emulator_program+strlen(start_emulator_program); + while (--p >= start_emulator_program && *p != '/' && *p != '\\' && + *p != 'W' && *p != 'w') + ; + if (p >= start_emulator_program && (*p == 'W' || *p == 'w') && + (p[1] == 'E' || p[1] == 'e') && (p[2] == 'R' || p[2] == 'r') && + (p[3] == 'L' || p[3] == 'l')) { + memmove(p,p+1,strlen(p)); + } + } + return start_win_emulator(emu, start_emulator_program, Eargsp, start_detached); + } else { + return start_emulator(emu, start_emulator_program, Eargsp, start_detached); + } + +#else + + skip_arg_massage: + if (start_detached) { + int status = fork(); + if (status != 0) /* Parent */ + return 0; + + if (reset_cerl_detached) + putenv("CERL_DETACHED_PROG="); + + /* Detach from controlling terminal */ +#ifdef HAVE_SETSID + setsid(); +#elif defined(TIOCNOTTY) + { + int fd = open("/dev/tty", O_RDWR); + if (fd >= 0) { + ioctl(fd, TIOCNOTTY, NULL); + close(fd); + } + } +#endif + + status = fork(); + if (status != 0) /* Parent */ + return 0; + + /* + * Grandchild. + */ + close(0); + open("/dev/null", O_RDONLY); + close(1); + open("/dev/null", O_WRONLY); + close(2); + open("/dev/null", O_WRONLY); +#ifdef DEBUG + execvp(emu, Eargsp); /* "xterm ..." needs to search the path */ +#endif + } +#ifdef DEBUG + else +#endif + { + execv(emu, Eargsp); + } + error("Error %d executing \'%s\'.", errno, emu); + return 1; +#endif +} + + +static void +usage_aux(void) +{ + fprintf(stderr, + "Usage: erl [-version] [-sname NAME | -name NAME] " + "[-noshell] [-noinput] [-env VAR VALUE] [-compile file ...] " +#ifdef __WIN32__ + "[-start_erl [datafile]] " +#endif + "[-smp " +#ifdef ERTS_HAVE_SMP_EMU + "[enable|" +#endif + "auto|disable" +#ifdef ERTS_HAVE_SMP_EMU + "]" +#endif + "] " +#ifdef ERTS_HAVE_HYBRID_EMU + "[-hybrid] " +#endif + "[-make] [-man [manopts] MANPAGE] [-x] [-emu_args] " + "[-args_file FILENAME] " + "[+A THREADS] [+a SIZE] [+B[c|d|i]] [+c] [+h HEAP_SIZE] [+K BOOLEAN] " + "[+l] [+M ] [+P MAX_PROCS] [+R COMPAT_REL] " + "[+r] [+s SCHEDULER_OPTION] [+S NO_SCHEDULERS:NO_SCHEDULERS_ONLINE] [+T LEVEL] [+V] [+v] [+W] " + "[args ...]\n"); + exit(1); +} + +void +usage(const char *switchname) +{ + fprintf(stderr, "Missing argument(s) for \'%s\'.\n", switchname); + usage_aux(); +} + +#if !defined(ERTS_HAVE_SMP_EMU) || !defined(ERTS_HAVE_HYBRID_EMU) +static void +usage_notsup(const char *switchname) +{ + fprintf(stderr, "Argument \'%s\' not supported.\n", switchname); + usage_aux(); +} +#endif + +static void +usage_msg(const char *msg) +{ + fprintf(stderr, "%s\n", msg); + usage_aux(); +} + +static void +usage_format(char *format, ...) +{ + va_list args; + va_start(args, format); + vfprintf(stderr, format, args); + va_end(args); + usage_aux(); +} + +void +start_epmd(char *epmd) +{ + char epmd_cmd[MAXPATHLEN+100]; +#ifdef __WIN32__ + char* arg1 = NULL; +#endif + int result; + + if (!epmd) { + epmd = epmd_cmd; +#ifdef __WIN32__ + sprintf(epmd_cmd, "%s" DIRSEP "epmd", bindir); + arg1 = "-daemon"; +#else + sprintf(epmd_cmd, "%s" DIRSEP "epmd -daemon", bindir); +#endif + } +#ifdef __WIN32__ + if (arg1 != NULL) { + strcat(epmd, " "); + strcat(epmd, arg1); + } + { + STARTUPINFO start; + PROCESS_INFORMATION pi; + memset(&start, 0, sizeof (start)); + start.cb = sizeof (start); + if (!CreateProcess(NULL, epmd, NULL, NULL, FALSE, + CREATE_DEFAULT_ERROR_MODE | DETACHED_PROCESS, + NULL, NULL, &start, &pi)) + result = -1; + else + result = 0; + } +#else + result = system(epmd); +#endif + if (result == -1) { + fprintf(stderr, "Error spawning %s (error %d)\n", epmd_cmd,errno); + exit(1); + } +} + +static void +add_arg(char *new_arg) +{ + if (argsCnt >= argsSz) + argsp = (char **) erealloc((void *) argsp, + sizeof(char *) * (argsSz += 20)); + argsp[argsCnt++] = QUOTE(new_arg); +} + +static void +add_args(char *first_arg, ...) +{ + va_list ap; + char* arg; + + add_arg(first_arg); + va_start(ap, first_arg); + while ((arg = va_arg(ap, char *)) != NULL) { + add_arg(arg); + } + va_end(ap); +} + +static void +ensure_EargsSz(int sz) +{ + if (EargsSz < sz) + Eargsp = (char **) erealloc((void *) Eargsp, + sizeof(char *) * (EargsSz = sz)); +} + +static void +add_Eargs(char *new_arg) +{ + if (EargsCnt >= EargsSz) + Eargsp = (char **) erealloc((void *) Eargsp, + sizeof(char *) * (EargsSz += 20)); + Eargsp[EargsCnt++] = QUOTE(new_arg); +} + +#if !defined(__WIN32__) +void error(char* format, ...) +{ + char sbuf[1024]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + fprintf(stderr, "erlexec: %s\n", sbuf); + exit(1); +} +#endif + +static void * +emalloc(size_t size) +{ + void *p = malloc(size); + if (p == NULL) + error("Insufficient memory"); + return p; +} + +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} + +static void +efree(void *p) +{ + free(p); +} + +static int +is_one_of_strings(char *str, char *strs[]) +{ + int i, j; + for (i = 0; strs[i]; i++) { + for (j = 0; str[j] && strs[i][j] && str[j] == strs[i][j]; j++); + if (!str[j] && !strs[i][j]) + return 1; + } + return 0; +} + +static char *write_str(char *to, char *from) +{ + while (*from) + *(to++) = *(from++); + *to = '\0'; + return to; +} + +char* +strsave(char* string) +{ + char* p = emalloc(strlen(string)+1); + strcpy(p, string); + return p; +} + + +#if defined(__WIN32__) + +static void get_start_erl_data(char *file) +{ + int fp; + char tmpbuffer[512]; + char start_erl_data[512]; + int bytesread; + char* env; + char* reldir; + char* otpstring; + char* tprogname; + if (boot_script) + error("Conflicting -start_erl and -boot options"); + if (config_script) + error("Conflicting -start_erl and -config options"); + env = get_env("RELDIR"); + if (env) + reldir = strsave(env); + else { + sprintf(tmpbuffer, "%s/releases", rootdir); + reldir = strsave(tmpbuffer); + } + free_env_val(env); + if (file == NULL) + sprintf(start_erl_data, "%s/start_erl.data", reldir); + else + sprintf(start_erl_data, "%s", file); + fp = _open(start_erl_data, _O_RDONLY ); + if( fp == -1 ) + error( "open failed on %s",start_erl_data ); + else { + if( ( bytesread = _read( fp, tmpbuffer, 512 ) ) <= 0 ) + error( "Problem reading file %s", start_erl_data ); + else { + tmpbuffer[bytesread]='\0'; + if ((otpstring = strchr(tmpbuffer,' ')) != NULL) { + *otpstring = '\0'; + otpstring++; + +/* + * otpstring is the otpversion + * tmpbuffer is the emuversion +*/ + } + } + } + tprogname = otpstring; + while (*tprogname) { + if (*tprogname <= ' ') { + *tprogname='\0'; + break; + } + tprogname++; + } + + bindir = emalloc(512); + sprintf(bindir,"%s/erts-%s/bin",rootdir,tmpbuffer); + /* BINDIR=$ROOTDIR/erts-$ERTS_VSN/bin */ + tprogname = progname; + progname = emalloc(strlen(tprogname) + 20); + sprintf(progname,"%s -start_erl",tprogname); + + boot_script = emalloc(512); + config_script = emalloc(512); + sprintf(boot_script, "%s/%s/start", reldir, otpstring); + sprintf(config_script, "%s/%s/sys", reldir, otpstring); + +} + + +static char *replace_filename(char *path, char *new_base) +{ + int plen = strlen(path); + char *res = malloc((plen+strlen(new_base)+1)*sizeof(char)); + char *p; + + strcpy(res,path); + for (p = res+plen-1 ;p >= res && *p != '\\'; --p) + ; + *(p+1) ='\0'; + strcat(res,new_base); + return res; +} + +static char *path_massage(char *long_path) +{ + char *p; + + p = malloc(MAX_PATH+1); + strcpy(p, long_path); + GetShortPathName(p, p, MAX_PATH); + return p; +} + +static char *do_lookup_in_section(InitSection *inis, char *name, + char *section, char *filename, int is_path) +{ + char *p = lookup_init_entry(inis, name); + + if (p == NULL) { + error("Could not find key %s in section %s of file %s", + name,section,filename); + } + + if (is_path) { + return path_massage(p); + } else { + return strsave(p); + } +} + + +static void get_parameters(int argc, char** argv) +{ + char *p; + char buffer[MAX_PATH]; + char *ini_filename; + HANDLE module = GetModuleHandle(NULL); /* This might look strange, but we want the erl.ini + that resides in the same dir as erl.exe, not + an erl.ini in our directory */ + InitFile *inif; + InitSection *inis; + + if (module == NULL) { + error("Cannot GetModuleHandle()"); + } + + if (GetModuleFileName(module,buffer,MAX_PATH) == 0) { + error("Could not GetModuleFileName"); + } + + ini_filename = replace_filename(buffer,INI_FILENAME); + + if ((inif = load_init_file(ini_filename)) == NULL) { + /* Assume that the path is absolute and that + it does not contain any symbolic link */ + + char buffer[MAX_PATH]; + + /* Determine bindir */ + if (GetEnvironmentVariable("ERLEXEC_DIR", buffer, MAX_PATH) == 0) { + strcpy(buffer, ini_filename); + for (p = buffer+strlen(buffer)-1; p >= buffer && *p != '\\'; --p) + ; + *p ='\0'; + } + bindir = path_massage(buffer); + + /* Determine rootdir */ + for (p = buffer+strlen(buffer)-1; p >= buffer && *p != '\\'; --p) + ; + p--; + for (;p >= buffer && *p != '\\'; --p) + ; + *p ='\0'; + rootdir = path_massage(buffer); + + /* Hardcoded progname */ + progname = strsave(DEFAULT_PROGNAME); + } else { + if ((inis = lookup_init_section(inif,INI_SECTION)) == NULL) { + error("Could not find section %s in init file %s", + INI_SECTION, ini_filename); + } + + bindir = do_lookup_in_section(inis, "Bindir", INI_SECTION, ini_filename,1); + rootdir = do_lookup_in_section(inis, "Rootdir", INI_SECTION, + ini_filename,1); + progname = do_lookup_in_section(inis, "Progname", INI_SECTION, + ini_filename,0); + free_init_file(inif); + } + + emu = EMULATOR_EXECUTABLE; + start_emulator_program = strsave(argv[0]); + + free(ini_filename); +} + +static void +get_home(void) +{ + int len; + char tmpstr[MAX_PATH+1]; + char* homedrive; + char* homepath; + + homedrive = get_env("HOMEDRIVE"); + homepath = get_env("HOMEPATH"); + if (!homedrive || !homepath) { + if (len = GetWindowsDirectory(tmpstr,MAX_PATH)) { + home = emalloc(len+1); + strcpy(home,tmpstr); + } else + error("HOMEDRIVE or HOMEPATH is not set and GetWindowsDir failed"); + } else { + home = emalloc(strlen(homedrive)+strlen(homepath)+1); + strcpy(home, homedrive); + strcat(home, homepath); + } + free_env_val(homedrive); + free_env_val(homepath); +} + +#else + +static void +get_parameters(int argc, char** argv) +{ + progname = get_env("PROGNAME"); + if (!progname) { + progname = strsave(DEFAULT_PROGNAME); + } + + emu = get_env("EMU"); + if (!emu) { + emu = strsave(EMULATOR_EXECUTABLE); + } + + bindir = get_env("BINDIR"); + if (!bindir) { + /* Determine bindir from absolute path to executable */ + char *p; + char buffer[PATH_MAX]; + strcpy(buffer, argv[0]); + + for (p = buffer+strlen(buffer)-1 ; p >= buffer && *p != '/'; --p) + ; + *p ='\0'; + bindir = strsave(buffer); + } + + rootdir = get_env("ROOTDIR"); + if (!rootdir) { + /* Determine rootdir from absolute path to bindir */ + char *p; + char buffer[PATH_MAX]; + strcpy(buffer, bindir); + + for (p = buffer+strlen(buffer)-1; p >= buffer && *p != '/'; --p) + ; + p--; + for (; p >= buffer && *p != '/'; --p) + ; + *p ='\0'; + rootdir = strsave(buffer); + } + + if (!progname || !emu || !rootdir || !bindir) { + error("PROGNAME, EMU, ROOTDIR and BINDIR must be set"); + } +} + +static void +get_home(void) +{ + home = get_env("HOME"); + if (home == NULL) + error("HOME must be set"); +} + +#endif + +static void add_epmd_port(void) +{ + char* port = get_env("ERL_EPMD_PORT"); + if (port != NULL) { + add_args("-epmd_port", port, NULL); + } +} + +static char **build_args_from_env(char *env_var) +{ + char *value = get_env(env_var); + char **res = build_args_from_string(value); + free_env_val(value); + return res; +} + +static char **build_args_from_string(char *string) +{ + int argc = 0; + char **argv = NULL; + int alloced = 0; + char **cur_s = NULL; /* Initialized to avoid warning. */ + int s_alloced = 0; + int s_pos = 0; + char *p = string; + enum {Start, Build, Build0, BuildSQuoted, BuildDQuoted, AcceptNext} state; + +#define ENSURE() \ + if (s_pos >= s_alloced) { \ + if (!*cur_s) { \ + *cur_s = emalloc(s_alloced = 20); \ + } else { \ + *cur_s = erealloc(*cur_s, s_alloced += 20); \ + } \ + } + + + if (!p) + return NULL; + argv = emalloc(sizeof(char *) * (alloced = 10)); + state = Start; + for(;;) { + switch (state) { + case Start: + if (!*p) + goto done; + if (argc >= alloced - 1) { /* Make room for extra NULL */ + argv = erealloc(argv, (alloced += 10) * sizeof(char *)); + } + cur_s = argc + argv; + *cur_s = NULL; + s_pos = 0; + s_alloced = 0; + state = Build0; + break; + case Build0: + switch (*p) { + case ' ': + ++p; + break; + case '\0': + state = Start; + break; + default: + state = Build; + break; + } + break; + case Build: + switch (*p) { + case ' ': + case '\0': + ENSURE(); + (*cur_s)[s_pos] = '\0'; + ++argc; + state = Start; + break; + case '"': + ++p; + state = BuildDQuoted; + break; + case '\'': + ++p; + state = BuildSQuoted; + break; + case '\\': + ++p; + state = AcceptNext; + break; + default: + ENSURE(); + (*cur_s)[s_pos++] = *p++; + break; + } + break; + case BuildDQuoted: + switch (*p) { + case '"': + ++p; + /* fall through */ + case '\0': + state = Build; + break; + default: + ENSURE(); + (*cur_s)[s_pos++] = *p++; + break; + } + break; + case BuildSQuoted: + switch (*p) { + case '\'': + ++p; + /* fall through */ + case '\0': + state = Build; + break; + default: + ENSURE(); + (*cur_s)[s_pos++] = *p++; + break; + } + break; + case AcceptNext: + if (!*p) { + state = Build; + } else { + ENSURE(); + (*cur_s)[s_pos++] = *p++; + } + state = Build; + break; + } + } +done: + argv[argc] = NULL; /* Sure to be large enough */ + if (!argc) { + efree(argv); + return NULL; + } + return argv; +#undef ENSURE +} + +static char * +errno_string(void) +{ + char *str = strerror(errno); + if (!str) + return "unknown error"; + return str; +} + +static char ** +read_args_file(char *filename) +{ + int c, aix = 0, quote = 0, cmnt = 0, asize = 0; + char **res, *astr = NULL; + FILE *file; + +#undef EAF_CMNT +#undef EAF_QUOTE +#undef SAVE_CHAR + +#define EAF_CMNT (1 << 8) +#define EAF_QUOTE (1 << 9) +#define SAVE_CHAR(C) \ + do { \ + if (!astr) \ + astr = emalloc(sizeof(char)*(asize = 20)); \ + if (aix == asize) \ + astr = erealloc(astr, sizeof(char)*(asize += 20)); \ + if (' ' != (char) (C)) \ + astr[aix++] = (char) (C); \ + else if (aix > 0 && astr[aix-1] != ' ') \ + astr[aix++] = ' '; \ + } while (0) + + do { + errno = 0; + file = fopen(filename, "r"); + } while (!file && errno == EINTR); + if (!file) { + usage_format("Failed to open arguments file \"%s\": %s\n", + filename, + errno_string()); + } + + while (1) { + c = getc(file); + if (c == EOF) { + if (ferror(file)) { + if (errno == EINTR) { + clearerr(file); + continue; + } + usage_format("Failed to read arguments file \"%s\": %s\n", + filename, + errno_string()); + } + break; + } + + switch (quote | cmnt | c) { + case '\\': + quote = EAF_QUOTE; + break; + case '#': + cmnt = EAF_CMNT; + break; + case EAF_CMNT|'\n': + cmnt = 0; + /* Fall through... */ + case '\n': + case '\f': + case '\r': + case '\t': + case '\v': + if (!quote) + c = ' '; + /* Fall through... */ + default: + if (!cmnt) + SAVE_CHAR(c); + quote = 0; + break; + } + } + + SAVE_CHAR('\0'); + + fclose(file); + + if (astr[0] == '\0') + res = NULL; + else + res = build_args_from_string(astr); + + efree(astr); + + return res; + +#undef EAF_CMNT +#undef EAF_QUOTE +#undef SAVE_CHAR +} + +typedef struct { + char **argv; + int argc; + int size; +} argv_buf; + +static void +trim_argv_buf(argv_buf *abp) +{ + abp->argv = erealloc(abp->argv, sizeof(char *)*(abp->size = abp->argc)); +} + +static void +save_arg(argv_buf *abp, char *arg) +{ + if (abp->size <= abp->argc) { + if (!abp->argv) + abp->argv = emalloc(sizeof(char *)*(abp->size = 100)); + else + abp->argv = erealloc(abp->argv, sizeof(char *)*(abp->size += 100)); + } + abp->argv[abp->argc++] = arg; +} + +#define DEF_ARGV_STACK_SIZE 10 +#define ARGV_STACK_SIZE_INCR 50 + +typedef struct { + char **argv; + int ix; +} argv_stack_element; + +typedef struct { + int top_ix; + int size; + argv_stack_element *base; + argv_stack_element def_buf[DEF_ARGV_STACK_SIZE]; +} argv_stack; + +#define ARGV_STACK_INIT(S) \ +do { \ + (S)->top_ix = 0; \ + (S)->size = DEF_ARGV_STACK_SIZE; \ + (S)->base = &(S)->def_buf[0]; \ +} while (0) + +static void +push_argv(argv_stack *stck, char **argv, int ix) +{ + if (stck->top_ix == stck->size) { + if (stck->base != &stck->def_buf[0]) { + stck->size += ARGV_STACK_SIZE_INCR; + stck->base = erealloc(stck->base, + sizeof(argv_stack_element)*stck->size); + } + else { + argv_stack_element *base; + base = emalloc(sizeof(argv_stack_element) + *(stck->size + ARGV_STACK_SIZE_INCR)); + memcpy((void *) base, + (void *) stck->base, + sizeof(argv_stack_element)*stck->size); + stck->base = base; + stck->size += ARGV_STACK_SIZE_INCR; + } + } + stck->base[stck->top_ix].argv = argv; + stck->base[stck->top_ix++].ix = ix; +} + +static void +pop_argv(argv_stack *stck, char ***argvp, int *ixp) +{ + if (stck->top_ix == 0) { + *argvp = NULL; + *ixp = 0; + } + else { + *argvp = stck->base[--stck->top_ix].argv; + *ixp = stck->base[stck->top_ix].ix; + if (stck->top_ix == 0 && stck->base != &stck->def_buf[0]) { + efree(stck->base); + stck->base = &stck->def_buf[0]; + stck->size = DEF_ARGV_STACK_SIZE; + } + } +} + +static void +get_file_args(char *filename, argv_buf *abp, argv_buf *xabp) +{ + argv_stack stck; + int i; + char **argv; + + ARGV_STACK_INIT(&stck); + + i = 0; + argv = read_args_file(filename); + + while (argv) { + + while (argv[i]) { + if (strcmp(argv[i], "-args_file") == 0) { + char **new_argv; + char *fname; + if (!argv[++i]) + usage("-args_file"); + fname = argv[i++]; + new_argv = read_args_file(fname); + if (new_argv) { + if (argv[i]) + push_argv(&stck, argv, i); + else + efree(argv); + i = 0; + argv = new_argv; + } + } + else { + if (strcmp(argv[i], "-extra") == 0) { + i++; + while (argv[i]) + save_arg(xabp, argv[i++]); + break; + } + save_arg(abp, argv[i++]); + } + } + + efree(argv); + + pop_argv(&stck, &argv, &i); + } +} + +static void +initial_argv_massage(int *argc, char ***argv) +{ + argv_buf ab = {0}, xab = {0}; + int ix, vix, ac; + char **av; + struct { + int argc; + char **argv; + } avv[] = {{INT_MAX, NULL}, {INT_MAX, NULL}, {INT_MAX, NULL}, + {INT_MAX, NULL}, {INT_MAX, NULL}, {INT_MAX, NULL}}; + /* + * The environment flag containing OTP release is intentionally + * undocumented and intended for OTP internal use only. + */ + + vix = 0; + av = build_args_from_env("ERL_AFLAGS"); + if (av) + avv[vix++].argv = av; + + /* command line */ + if (*argc > 1) { + avv[vix].argc = *argc - 1; + avv[vix++].argv = &(*argv)[1]; + } + + av = build_args_from_env("ERL_FLAGS"); + if (av) + avv[vix++].argv = av; + + av = build_args_from_env("ERL_" OTP_SYSTEM_VERSION "_FLAGS"); + if (av) + avv[vix++].argv = av; + + av = build_args_from_env("ERL_ZFLAGS"); + if (av) + avv[vix++].argv = av; + + if (vix == (*argc > 1 ? 1 : 0)) { + /* Only command line argv; check if we can use argv as it is... */ + ac = *argc; + av = *argv; + for (ix = 1; ix < ac; ix++) { + if (strcmp(av[ix], "-args_file") == 0) { + /* ... no; we need to expand arguments from + file into argument list */ + goto build_new_argv; + } + if (strcmp(av[ix], "-extra") == 0) { + break; + } + } + + /* ... yes; we can use argv as it is. */ + return; + } + + build_new_argv: + + save_arg(&ab, (*argv)[0]); + + vix = 0; + while (avv[vix].argv) { + ac = avv[vix].argc; + av = avv[vix].argv; + + ix = 0; + while (ix < ac && av[ix]) { + if (strcmp(av[ix], "-args_file") == 0) { + if (++ix == ac) + usage("-args_file"); + get_file_args(av[ix++], &ab, &xab); + } + else { + if (strcmp(av[ix], "-extra") == 0) { + ix++; + while (ix < ac && av[ix]) + save_arg(&xab, av[ix++]); + break; + } + save_arg(&ab, av[ix++]); + } + } + + vix++; + } + + vix = 0; + while (avv[vix].argv) { + if (avv[vix].argc == INT_MAX) /* not command line */ + efree(avv[vix].argv); + vix++; + } + + if (xab.argc) { + save_arg(&ab, "-extra"); + for (ix = 0; ix < xab.argc; ix++) + save_arg(&ab, xab.argv[ix]); + efree(xab.argv); + } + + save_arg(&ab, NULL); + trim_argv_buf(&ab); + *argv = ab.argv; + *argc = ab.argc - 1; +} + +#ifdef __WIN32__ +static char* +possibly_quote(char* arg) +{ + int mustQuote = NO; + int n = 0; + char* s; + char* narg; + + /* + * Scan the string to find out if it needs quoting and return + * the original argument if not. + */ + + for (s = arg; *s; s++, n++) { + if (*s == ' ' || *s == '"') { + mustQuote = YES; + n++; + } + } + if (!mustQuote) { + return arg; + } + + /* + * Insert the quotes and put a backslash in front of every quote + * inside the string. + */ + + s = narg = emalloc(n+2+1); + for (*s++ = '"'; *arg; arg++, s++) { + if (*s == '"') { + *s++ = '\\'; + } + *s = *arg; + } + *s++ = '"'; + *s = '\0'; + return narg; +} + +#endif diff --git a/erts/etc/common/escript.c b/erts/etc/common/escript.c new file mode 100644 index 0000000000..ab37d4af46 --- /dev/null +++ b/erts/etc/common/escript.c @@ -0,0 +1,697 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: escript front-end. + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#ifdef __WIN32__ +#include +#endif + +#include + +static int debug = 0; /* Bit flags for debug printouts. */ + +static char** eargv_base; /* Base of vector. */ +static char** eargv; /* First argument for erl. */ + +static int eargc; /* Number of arguments in eargv. */ + +#define BOOL int +#define FALSE 0 +#define TRUE 1 + +#ifdef __WIN32__ +# define QUOTE(s) possibly_quote(s) +# define IS_DIRSEP(c) ((c) == '/' || (c) == '\\') +# define DIRSEPSTR "\\" +# define PATHSEPSTR ";" +# define PMAX MAX_PATH +# define ERL_NAME "erl.exe" +#else +# define QUOTE(s) s +# define IS_DIRSEP(c) ((c) == '/') +# define DIRSEPSTR "/" +# define PATHSEPSTR ":" +# define PMAX PATH_MAX +# define ERL_NAME "erl" +#endif + +#define UNSHIFT(s) eargc++, eargv--; eargv[0] = QUOTE(s) +#define UNSHIFT3(s, t, u) UNSHIFT(u); UNSHIFT(t); UNSHIFT(s) +#define PUSH(s) eargv[eargc++] = QUOTE(s) +#define PUSH2(s, t) PUSH(s); PUSH(t) +#define PUSH3(s, t, u) PUSH2(s, t); PUSH(u) +#define LINEBUFSZ 1024 + +/* + * Local functions. + */ + +static void error(char* format, ...); +static char* emalloc(size_t size); +static void efree(void *p); +static char* strsave(char* string); +static void push_words(char* src); +static int run_erlang(char* name, char** argv); +static char* get_default_emulator(char* progname); +#ifdef __WIN32__ +static char* possibly_quote(char* arg); +#endif + +/* + * Supply a strerror() function if libc doesn't. + */ +#ifndef HAVE_STRERROR + +extern int sys_nerr; + +#ifndef SYS_ERRLIST_DECLARED +extern const char * const sys_errlist[]; +#endif /* !SYS_ERRLIST_DECLARED */ + +char *strerror(int errnum) +{ + static char *emsg[1024]; + + if (errnum != 0) { + if (errnum > 0 && errnum < sys_nerr) + sprintf((char *) &emsg[0], "(%s)", sys_errlist[errnum]); + else + sprintf((char *) &emsg[0], "errnum = %d ", errnum); + } + else { + emsg[0] = '\0'; + } + return (char *) &emsg[0]; +} +#endif /* !HAVE_STRERROR */ + +static char * +get_env(char *key) +{ +#ifdef __WIN32__ + DWORD size = 32; + char *value = NULL; + while (1) { + DWORD nsz; + if (value) + efree(value); + value = emalloc(size); + SetLastError(0); + nsz = GetEnvironmentVariable((LPCTSTR) key, (LPTSTR) value, size); + if (nsz == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) { + efree(value); + return NULL; + } + if (nsz <= size) + return value; + size = nsz; + } +#else + return getenv(key); +#endif +} + +static void +free_env_val(char *value) +{ +#ifdef __WIN32__ + if (value) + efree(value); +#endif +} +/* + * Find absolute path to this program + */ + +static char * +find_prog(char *origpath) +{ + char relpath[PMAX]; + char abspath[PMAX]; + + strcpy(relpath, origpath); + + if (strstr(relpath, DIRSEPSTR) == NULL) { + /* Just a base name */ + char *envpath; + + envpath = get_env("PATH"); + if (envpath) { + /* Try to find the executable in the path */ + char dir[PMAX]; + char *beg = envpath; + char *end; + int sz; + +#ifdef __WIN32__ + HANDLE dir_handle; /* Handle to directory. */ + char wildcard[PMAX]; /* Wildcard to search for. */ + WIN32_FIND_DATA find_data; /* Data found by FindFirstFile() or FindNext(). */ +#else + DIR *dp; /* Pointer to directory structure. */ + struct dirent* dirp; /* Pointer to directory entry. */ +#endif /* __WIN32__ */ + + BOOL look_for_sep = TRUE; + + while (look_for_sep) { + end = strstr(beg, PATHSEPSTR); + if (end != NULL) { + sz = end - beg; + strncpy(dir, beg, sz); + dir[sz] = '\0'; + } else { + sz = strlen(beg); + strcpy(dir, beg); + look_for_sep = FALSE; + } + beg = end + 1; + +#ifdef __WIN32__ + strcpy(wildcard, dir); + strcat(wildcard, DIRSEPSTR); + strcat(wildcard, relpath); /* basename */ + dir_handle = FindFirstFile(wildcard, &find_data); + if (dir_handle == INVALID_HANDLE_VALUE) { + /* Try next directory in path */ + continue; + } else { + /* Wow we found the executable. */ + strcpy(abspath, wildcard); + FindClose(dir_handle); + return strsave(abspath); + } +#else + dp = opendir(dir); + if (dp != NULL) { + while (TRUE) { + dirp = readdir(dp); + if (dirp == NULL) { + closedir(dp); + /* Try next directory in path */ + break; + } + + if (strcmp(origpath, dirp->d_name) == 0) { + /* Wow we found the executable. */ + strcpy(abspath, dir); + strcat(abspath, DIRSEPSTR); + strcat(abspath, dirp->d_name); + closedir(dp); + return strsave(abspath); + } + } + } +#endif /* __WIN32__ */ + } + } + } + + { +#ifdef __WIN32__ + DWORD size; + char *absrest; + size = GetFullPathName(relpath, PMAX, abspath, &absrest); + if ((size == 0) || (size > PMAX)) { + +#else + if (!realpath(relpath, abspath)) { +#endif /* __WIN32__ */ + /* Cannot determine absolute path to escript. Try the relative. */ + return strsave(relpath); + } else { + return strsave(abspath); + } + } +} + +static void +append_shebang_args(char* scriptname) +{ + /* Open script file */ + FILE* fd = fopen (scriptname,"r"); + + if (fd != NULL) { + /* Read first line in script file */ + static char linebuf[LINEBUFSZ]; + char* ptr = fgets(linebuf, LINEBUFSZ, fd); + + if (ptr != NULL && linebuf[0] == '#' && linebuf[1] == '!') { + /* Try to find args on second or third line */ + ptr = fgets(linebuf, LINEBUFSZ, fd); + if (ptr != NULL && linebuf[0] == '%' && linebuf[1] == '%' && linebuf[2] == '!') { + /* Use second line */ + } else { + /* Try third line */ + ptr = fgets(linebuf, LINEBUFSZ, fd); + if (ptr != NULL && linebuf[0] == '%' && linebuf[1] == '%' && linebuf[2] == '!') { + /* Use third line */ + } else { + /* Do not use any line */ + ptr = NULL; + } + } + + if (ptr != NULL) { + /* Use entire line but the leading chars */ + char* beg = linebuf + 3; + char* end; + BOOL newline = FALSE; + + /* Push all args */ + while(beg && !newline) { + /* Skip leading spaces */ + while (beg && beg[0] == ' ') { + beg++; + } + + /* Find end of arg */ + end = beg; + while (end && end[0] != ' ') { + if (end[0] == '\n') { + newline = TRUE; + end[0]= '\0'; + break; + } else { + end++; + } + } + + /* Empty arg */ + if (beg == end) { + break; + } + end[0]= '\0'; + PUSH(beg); + beg = end + 1; + } + } + } + fclose(fd); + } else { + error("Failed to open file: %s", scriptname); + } +} + +int +main(int argc, char** argv) +{ + int eargv_size; + int eargc_base; /* How many arguments in the base of eargv. */ + char* emulator; + char* env; + char* basename; + char* absname; + char scriptname[PMAX]; + char** last_opt; + char** first_opt; + + emulator = env = get_env("ESCRIPT_EMULATOR"); + if (emulator == NULL) { + emulator = get_default_emulator(argv[0]); + } + + /* + * Allocate the argv vector to be used for arguments to Erlang. + * Arrange for starting to pushing information in the middle of + * the array, to allow easy addition of commands in the beginning. + */ + + eargv_size = argc*4+1000; + eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); + eargv = eargv_base; + eargc = 0; + push_words(emulator); + eargc_base = eargc; + eargv = eargv + eargv_size/2; + eargc = 0; + + free_env_val(env); + + /* + * Push initial arguments. + */ + + PUSH("+B"); + PUSH2("-boot", "start_clean"); + PUSH("-noshell"); + + /* Determine basename of the executable */ + for (basename = argv[0]+strlen(argv[0]); + basename > argv[0] && !(IS_DIRSEP(basename[-1])); + --basename) + ; + + first_opt = argv; + last_opt = argv; + +#ifdef __WIN32__ + if (_stricmp(basename, "escript.exe") == 0) { +#else + if (strcmp(basename, "escript") == 0) { +#endif + /* + * Push all options (without the hyphen) before the script name. + */ + + while (argc > 1 && argv[1][0] == '-') { + PUSH(argv[1]+1); + argc--; + argv++; + last_opt = argv; + } + + if (argc <= 1) { + error("Missing filename\n"); + } + strcpy(scriptname, argv[1]); + argc--; + argv++; + } else { +#ifdef __WIN32__ + int len; +#endif + absname = find_prog(argv[0]); + strcpy(scriptname, absname); + efree(absname); +#ifdef __WIN32__ + len = strlen(scriptname); + if (len >= 4 && _stricmp(scriptname+len-4, ".exe") == 0) { + scriptname[len-4] = '\0'; + } +#endif + strcat(scriptname, ".escript"); + } + + /* + * Read options from the %%! row in the script and add them as args + */ + + append_shebang_args(scriptname); + + /* + * Push the script name and everything following it as extra arguments. + */ + + PUSH3("-run", "escript", "start"); + + /* + * Push all options (without the hyphen) before the script name. + */ + + while (first_opt != last_opt) { + PUSH(first_opt[1]+1); + first_opt++; + } + + PUSH("-extra"); + PUSH(scriptname); + while (argc > 1) { + PUSH(argv[1]); + argc--, argv++; + } + + /* + * Move up the commands for invoking the emulator and adjust eargv + * accordingly. + */ + + while (--eargc_base >= 0) { + UNSHIFT(eargv_base[eargc_base]); + } + + /* + * Invoke Erlang with the collected options. + */ + + PUSH(NULL); + return run_erlang(eargv[0], eargv); +} + +static void +push_words(char* src) +{ + char sbuf[1024]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} +#ifdef __WIN32__ +char *make_commandline(char **argv) +{ + static char *buff = NULL; + static int siz = 0; + int num = 0; + char **arg, *p; + + if (*argv == NULL) { + return ""; + } + for (arg = argv; *arg != NULL; ++arg) { + num += strlen(*arg)+1; + } + if (!siz) { + siz = num; + buff = emalloc(siz*sizeof(char)); + } else if (siz < num) { + siz = num; + buff = realloc(buff,siz*sizeof(char)); + } + p = buff; + for (arg = argv; *arg != NULL; ++arg) { + strcpy(p,*arg); + p+=strlen(*arg); + *p++=' '; + } + *(--p) = '\0'; + + if (debug) { + printf("Processed commandline:%s\n",buff); + } + return buff; +} + +int my_spawnvp(char **argv) +{ + STARTUPINFO siStartInfo; + PROCESS_INFORMATION piProcInfo; + DWORD ec; + + memset(&siStartInfo,0,sizeof(STARTUPINFO)); + siStartInfo.cb = sizeof(STARTUPINFO); + siStartInfo.dwFlags = STARTF_USESTDHANDLES; + siStartInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + siStartInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + siStartInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE); + + if (!CreateProcess(NULL, + make_commandline(argv), + NULL, + NULL, + TRUE, + 0, + NULL, + NULL, + &siStartInfo, + &piProcInfo)) { + return -1; + } + CloseHandle(piProcInfo.hThread); + + WaitForSingleObject(piProcInfo.hProcess,INFINITE); + if (!GetExitCodeProcess(piProcInfo.hProcess,&ec)) { + return 0; + } + return (int) ec; +} +#endif /* __WIN32__ */ + + +static int +run_erlang(char* progname, char** argv) +{ +#ifdef __WIN32__ + int status; +#endif + + if (debug) { + int i = 0; + while (argv[i] != NULL) + printf(" %s", argv[i++]); + printf("\n"); + } + +#ifdef __WIN32__ + /* + * Alas, we must wait here for the program to finish. + * Otherwise, the shell from which we was executed will think + * we are finished and print a prompt and read keyboard input. + */ + + status = my_spawnvp(argv)/*_spawnvp(_P_WAIT,progname,argv)*/; + if (status == -1) { + fprintf(stderr, "escript: Error executing '%s': %d", progname, + GetLastError()); + } + return status; +#else + execvp(progname, argv); + error("Error %d executing \'%s\'.", errno, progname); + return 2; +#endif +} + +static void +error(char* format, ...) +{ + char sbuf[1024]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + fprintf(stderr, "escript: %s\n", sbuf); + exit(1); +} + +static char* +emalloc(size_t size) +{ + char *p = malloc(size); + if (p == NULL) + error("Insufficient memory"); + return p; +} + +static void +efree(void *p) +{ + free(p); +} + +static char* +strsave(char* string) +{ + char* p = emalloc(strlen(string)+1); + strcpy(p, string); + return p; +} + +static char* +get_default_emulator(char* progname) +{ + char sbuf[MAXPATHLEN]; + char* s; + + strcpy(sbuf, progname); + for (s = sbuf+strlen(sbuf); s >= sbuf; s--) { + if (IS_DIRSEP(*s)) { + strcpy(s+1, ERL_NAME); +#ifdef __WIN32__ + if (_access(sbuf, 0) != -1) { + return strsave(sbuf); + } +#else + if (access(sbuf, 1) != -1) { + return strsave(sbuf); + } +#endif + break; + } + } + return ERL_NAME; +} + +#ifdef __WIN32__ +static char* +possibly_quote(char* arg) +{ + int mustQuote = FALSE; + int n = 0; + char* s; + char* narg; + + if (arg == NULL) { + return arg; + } + + /* + * Scan the string to find out if it needs quoting and return + * the original argument if not. + */ + + for (s = arg; *s; s++, n++) { + switch(*s) { + case ' ': + mustQuote = TRUE; + continue; + case '"': + mustQuote = TRUE; + n++; + continue; + case '\\': + if(s[1] == '"') + n++; + continue; + default: + continue; + } + } + if (!mustQuote) { + return arg; + } + + /* + * Insert the quotes and put a backslash in front of every quote + * inside the string. + */ + + s = narg = emalloc(n+2+1); + for (*s++ = '"'; *arg; arg++, s++) { + if (*arg == '"' || (*arg == '\\' && arg[1] == '"')) { + *s++ = '\\'; + } + *s = *arg; + } + if (s[-1] == '\\') { + *s++ ='\\'; + } + *s++ = '"'; + *s = '\0'; + return narg; +} +#endif /* __WIN32__ */ diff --git a/erts/etc/common/heart.c b/erts/etc/common/heart.c new file mode 100644 index 0000000000..4f738947b7 --- /dev/null +++ b/erts/etc/common/heart.c @@ -0,0 +1,1142 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/** + * + * File: heart.c + * Purpose: Portprogram for supervision of the Erlang emulator. + * + * Synopsis: heart + * + * SPAWNING FROM ERLANG + * + * This program is started from Erlang as follows, + * + * Port = open_port({spawn, 'heart'}, [{packet, 2}]), + * + * ROLE OF THIS PORT PROGRAM + * + * This program is started by the Erlang emulator. It communicates + * with the emulator through file descriptor 0 (standard input). + * + * MESSAGE FORMAT + * + * All messages have the following format (a value in parentheses + * indicate field length in bytes), + * + * {Length(2), Operation(1)} + * + * START ACK + * + * When this program has started it sends an START ACK message to Erlang. + * + * HEART_BEATING + * + * This program expects a heart beat messages. If it does not receive a + * heart beat message from Erlang within heart_beat_timeout seconds, it + * reboots the system. The variable heart_beat_timeout is exported (so + * that it can be set from the shell in VxWorks, as is the variable + * heart_beat_report_delay). When using Solaris, the system is rebooted + * by executing the command stored in the environment variable + * HEART_COMMAND. + * + * BLOCKING DESCRIPTORS + * + * All file descriptors in this program are blocking. This can lead + * to deadlocks. The emulator reads and writes are blocking. + * + * STANDARD INPUT, OUTPUT AND ERROR + * + * This program communicates with Erlang through the standard + * input and output file descriptors (0 and 1). These descriptors + * (and the standard error descriptor 2) must NOT be closed + * explicitely by this program at termination (in UNIX it is + * taken care of by the operating system itself; in VxWorks + * it is taken care of by the spawn driver part of the Emulator). + * + * END OF FILE + * + * If a read from a file descriptor returns zero (0), it means + * that there is no process at the other end of the connection + * having the connection open for writing (end-of-file). + * + * HARDWARE WATCHDOG + * + * When used with VxWorks(with CPU40), the hardware + * watchdog is enabled, making sure that the system reboots + * even if the heart port program malfunctions or the system + * is completely overloaded. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef __WIN32__ +#include +#include +#include +#include +#endif +#ifdef VXWORKS +#include "sys.h" +#endif + +/* + * Implement time correction using times() call even on Linuxes + * that can simulate gethrtime with clock_gettime, no use implementing + * a phony gethrtime in this file as the time questions are so infrequent. + */ +#if defined(CORRET_USING_TIMES) || defined(GETHRTIME_WITH_CLOCK_GETTIME) +# define HEART_CORRECT_USING_TIMES 1 +#endif + +#include +#include +#include + +#include + +#include +#include +#include + +#ifdef VXWORKS +# include +# include +# include +# include +# include +# include +# include +# include +# include +# include +#endif +#if !defined(__WIN32__) && !defined(VXWORKS) +# include +# include +# include +# include +# include +# if defined(HEART_CORRECT_USING_TIMES) +# include +# include +# endif +#endif + +#define HEART_COMMAND_ENV "HEART_COMMAND" + +#define MSG_HDR_SIZE 2 +#define MSG_HDR_PLUS_OP_SIZE 3 +#define MSG_BODY_SIZE 2048 +#define MSG_TOTAL_SIZE 2050 + +unsigned char cmd[MSG_BODY_SIZE]; + +struct msg { + unsigned short len; + unsigned char op; + unsigned char fill[MSG_BODY_SIZE]; /* one too many */ +}; + +/* operations */ +#define HEART_ACK 1 +#define HEART_BEAT 2 +#define SHUT_DOWN 3 +#define SET_CMD 4 +#define CLEAR_CMD 5 +#define GET_CMD 6 +#define HEART_CMD 7 + + +/* Maybe interesting to change */ + +/* Times in seconds */ +#define HEART_BEAT_BOOT_DELAY 60 /* 1 minute */ +#define SELECT_TIMEOUT 5 /* Every 5 seconds we reset the + watchdog timer */ + +/* heart_beat_timeout is the maximum gap in seconds between two + consecutive heart beat messages from Erlang, and HEART_BEAT_BOOT_DELAY + is the the extra delay that wd_keeper allows for, to give heart a + chance to reboot in the "normal" way before the hardware watchdog + enters the scene. heart_beat_report_delay is the time allowed for reporting + before rebooting under VxWorks. */ + +int heart_beat_timeout = 60; +int heart_beat_report_delay = 30; +int heart_beat_boot_delay = HEART_BEAT_BOOT_DELAY; +/* All current platforms have a process identifier that + fits in an unsigned long and where 0 is an impossible or invalid value */ +unsigned long heart_beat_kill_pid = 0; + +#define VW_WD_TIMEOUT (heart_beat_timeout+heart_beat_report_delay+heart_beat_boot_delay) +#define SOL_WD_TIMEOUT (heart_beat_timeout+heart_beat_boot_delay) + +/* reasons for reboot */ +#define R_TIMEOUT 1 +#define R_CLOSED 2 +#define R_ERROR 3 +#define R_SHUT_DOWN 4 + + +/* macros */ + +#define NULLFDS ((fd_set *) NULL) +#define NULLTV ((struct timeval *) NULL) + +/* prototypes */ + +static int message_loop(int,int); +static void do_terminate(int); +static int notify_ack(int); +static int heart_cmd_reply(int, char *); +static int write_message(int, struct msg *); +static int read_message(int, struct msg *); +static int read_skip(int, char *, int, int); +static int read_fill(int, char *, int); +static void print_error(const char *,...); +static void debugf(const char *,...); +static void init_timestamp(void); +static time_t timestamp(time_t *); + +#ifdef __WIN32__ +static BOOL enable_privilege(void); +static BOOL do_shutdown(int); +static void print_last_error(void); +static HANDLE start_reader_thread(void); +static DWORD WINAPI reader(LPVOID); +static int test_win95(void); +#define read _read +#define write _write +#endif + +/* static variables */ + +static char program_name[256]; +static int erlin_fd = 0, erlout_fd = 1; /* std in and out */ +static int debug_on = 0; +#ifdef __WIN32__ +static HANDLE hreader_thread; +static HANDLE hevent_dataready; +static struct msg m, *mp = &m; +static int tlen; /* total message length */ +static FILE* conh; + +#endif + +static int +is_env_set(char *key) +{ +#ifdef __WIN32__ + char buf[1]; + DWORD sz = (DWORD) sizeof(buf); + SetLastError(0); + sz = GetEnvironmentVariable((LPCTSTR) key, (LPTSTR) buf, sz); + return sz || GetLastError() != ERROR_ENVVAR_NOT_FOUND; +#else + return getenv(key) != NULL; +#endif +} + +static char * +get_env(char *key) +{ +#ifdef __WIN32__ + DWORD size = 32; + char *value = NULL; + while (1) { + DWORD nsz; + if (value) + free(value); + value = malloc(size); + if (!value) { + print_error("Failed to allocate memory. Terminating..."); + exit(1); + } + SetLastError(0); + nsz = GetEnvironmentVariable((LPCTSTR) key, (LPTSTR) value, size); + if (nsz == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) { + free(value); + return NULL; + } + if (nsz <= size) + return value; + size = nsz; + } +#else + return getenv(key); +#endif +} + +static void +free_env_val(char *value) +{ +#ifdef __WIN32__ + if (value) + free(value); +#endif +} + +/* + * main + */ +static void get_arguments(int argc, char** argv) { + int i = 1; + int h; + int w; + unsigned long p; + + while (i < argc) { + switch (argv[i][0]) { + case '-': + switch (argv[i][1]) { + case 'h': + if (strcmp(argv[i], "-ht") == 0) + if (sscanf(argv[i+1],"%i",&h) ==1) + if ((h > 10) && (h <= 65535)) { + heart_beat_timeout = h; + fprintf(stderr,"heart_beat_timeout = %d\n",h); + i++; + } + break; + case 'w': + if (strcmp(argv[i], "-wt") == 0) + if (sscanf(argv[i+1],"%i",&w) ==1) + if ((w > 10) && (w <= 65535)) { + heart_beat_boot_delay = w; + fprintf(stderr,"heart_beat_boot_delay = %d\n",w); + i++; + } + break; + case 'p': + if (strcmp(argv[i], "-pid") == 0) + if (sscanf(argv[i+1],"%lu",&p) ==1){ + heart_beat_kill_pid = p; + fprintf(stderr,"heart_beat_kill_pid = %lu\n",p); + i++; + } + break; +#ifdef __WIN32__ + case 's': + if (strcmp(argv[i], "-shutdown") == 0){ + do_shutdown(1); + exit(0); + } + break; +#endif + default: + ; + } + break; + default: + ; + } + i++; + } + debugf("arguments -ht %d -wt %d -pid %lu\n",h,w,p); +} + +int +main(int argc, char **argv) +{ + get_arguments(argc,argv); + if (is_env_set("HEART_DEBUG")) + debug_on=1; +#ifdef __WIN32__ + if (debug_on) { + if(!is_env_set("ERLSRV_SERVICE_NAME")) { + /* this redirects stderr to a separate console (for debugging purposes)*/ + erlin_fd = _dup(0); + erlout_fd = _dup(1); + AllocConsole(); + conh = freopen("CONOUT$","w",stderr); + if (conh != NULL) + fprintf(conh,"console alloced\n"); + } + debugf("stderr\n"); + } + _setmode(erlin_fd,_O_BINARY); + _setmode(erlout_fd,_O_BINARY); +#endif + strcpy(program_name, argv[0]); + notify_ack(erlout_fd); + cmd[0] = '\0'; + do_terminate(message_loop(erlin_fd,erlout_fd)); + return 0; +} + +/* + * message loop + */ +static int +message_loop(erlin_fd, erlout_fd) + int erlin_fd, erlout_fd; +{ + int i; + time_t now, last_received; +#ifdef __WIN32__ + DWORD wresult; +#else + fd_set read_fds; + int max_fd; + struct timeval timeout; + int tlen; /* total message length */ + struct msg m, *mp = &m; +#endif + + init_timestamp(); + timestamp(&now); + last_received = now; +#ifdef __WIN32__ + hevent_dataready = CreateEvent(NULL,FALSE,FALSE,NULL); + hreader_thread = start_reader_thread(); +#else + max_fd = erlin_fd; +#endif + + while (1) { +#ifdef __WIN32__ + wresult = WaitForSingleObject(hevent_dataready,SELECT_TIMEOUT*1000+ 2); + if (wresult == WAIT_FAILED) { + print_last_error(); + return R_ERROR; + } + + if (wresult == WAIT_TIMEOUT) { + debugf("wait timed out\n"); + i = 0; + } else { + debugf("wait ok\n"); + i = 1; + } +#else + FD_ZERO(&read_fds); /* ZERO on each turn */ + FD_SET(erlin_fd, &read_fds); + timeout.tv_sec = SELECT_TIMEOUT; /* On Linux timeout is modified + by select */ + timeout.tv_usec = 0; + if ((i = select(max_fd + 1, &read_fds, NULLFDS, NULLFDS, &timeout)) < 0) { + print_error("error in select."); + return R_ERROR; + } +#endif + /* + * Maybe heart beat time-out + * If we havn't got anything in 60 seconds we reboot, even if we may + * have got something in the last 5 seconds. We may end up here if + * the system clock is adjusted with more than 55 seconds, but we + * regard this as en error and reboot anyway. + */ + timestamp(&now); + if (now > last_received + heart_beat_timeout) { + print_error("heart-beat time-out."); + return R_TIMEOUT; + } + /* + * Do not check fd-bits if select timeout + */ + if (i == 0) { + continue; + } + /* + * Message from ERLANG + */ +#ifdef __WIN32__ + if (wresult == WAIT_OBJECT_0) { + if (tlen < 0) { +#else + if (FD_ISSET(erlin_fd, &read_fds)) { + if ((tlen = read_message(erlin_fd, mp)) < 0) { +#endif + print_error("error in read_message."); + return R_ERROR; + } + if ((tlen > MSG_HDR_SIZE) && (tlen <= MSG_TOTAL_SIZE)) { + switch (mp->op) { + case HEART_BEAT: + timestamp(&last_received); +#ifdef USE_WATCHDOG + /* reset the hardware watchdog timer */ + wd_reset(); +#endif + break; + case SHUT_DOWN: + return R_SHUT_DOWN; + case SET_CMD: + /* override the HEART_COMMAND_ENV command */ + memcpy(&cmd, &(mp->fill[0]), + tlen-MSG_HDR_PLUS_OP_SIZE); + cmd[tlen-MSG_HDR_PLUS_OP_SIZE] = '\0'; + notify_ack(erlout_fd); + break; + case CLEAR_CMD: + /* use the HEART_COMMAND_ENV command */ + cmd[0] = '\0'; + notify_ack(erlout_fd); + break; + case GET_CMD: + /* send back command string */ + { + char *env = NULL; + char *command + = (cmd[0] + ? (char *)cmd + : (env = get_env(HEART_COMMAND_ENV))); + /* Not set and not in env return "" */ + if (!command) command = ""; + heart_cmd_reply(erlout_fd, command); + free_env_val(env); + } + break; + default: + /* ignore all other messages */ + break; + } + } else if (tlen == 0) { + /* Erlang has closed its end */ + print_error("Erlang has closed."); + return R_CLOSED; + } + /* Junk erroneous messages */ + } + } +} + +#if defined(__WIN32__) +static void +kill_old_erlang(void){ + HANDLE erlh; + DWORD exit_code; + if(heart_beat_kill_pid != 0){ + if((erlh = OpenProcess(PROCESS_TERMINATE | + SYNCHRONIZE | + PROCESS_QUERY_INFORMATION , + FALSE, + (DWORD) heart_beat_kill_pid)) == NULL){ + return; + } + if(!TerminateProcess(erlh, 1)){ + CloseHandle(erlh); + return; + } + if(WaitForSingleObject(erlh,5000) != WAIT_OBJECT_0){ + print_error("Old process did not die, " + "WaitForSingleObject timed out."); + CloseHandle(erlh); + return; + } + if(!GetExitCodeProcess(erlh, &exit_code)){ + print_error("Old process did not die, " + "GetExitCodeProcess failed."); + } + CloseHandle(erlh); + } +} +#elif !defined(VXWORKS) +/* Unix eh? */ +static void +kill_old_erlang(void){ + pid_t pid; + int i; + int res; + if(heart_beat_kill_pid != 0){ + pid = (pid_t) heart_beat_kill_pid; + res = kill(pid,SIGKILL); + for(i=0; i < 5 && res == 0; ++i){ + sleep(1); + res = kill(pid,SIGKILL); + } + if(errno != ESRCH){ + print_error("Unable to kill old process, " + "kill failed (tried multiple times)."); + } + } +} +#endif /* Not on VxWorks */ + +#ifdef __WIN32__ +void win_system(char *command) +{ + char *comspec; + char * cmdbuff; + char * extra = " /C "; + char *env; + STARTUPINFO start; + SECURITY_ATTRIBUTES attr; + PROCESS_INFORMATION info; + + if (!debug_on || test_win95()) { + system(command); + return; + } + comspec = env = get_env("COMSPEC"); + if (!comspec) + comspec = "CMD.EXE"; + cmdbuff = malloc(strlen(command) + strlen(comspec) + strlen(extra) + 1); + if (!cmdbuff) { + print_error("Failed to allocate memory. Terminating..."); + exit(1); + } + strcpy(cmdbuff, comspec); + strcat(cmdbuff, extra); + strcat(cmdbuff, command); + free_env_val(env); + + debugf("running \"%s\"\r\n", cmdbuff); + + memset (&start, 0, sizeof (start)); + start.cb = sizeof (start); + start.dwFlags = STARTF_USESHOWWINDOW | STARTF_USESTDHANDLES; + start.wShowWindow = SW_HIDE; + start.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + start.hStdOutput = GetStdHandle(STD_ERROR_HANDLE); + start.hStdError = GetStdHandle(STD_ERROR_HANDLE); + + attr.nLength = sizeof(attr); + attr.lpSecurityDescriptor = NULL; + attr.bInheritHandle = TRUE; + + fflush(stderr); + + if (!CreateProcess(NULL, + cmdbuff, + &attr, + NULL, + TRUE, + 0, + NULL, + NULL, + &start, + &info)) { + debugf("Could not create process for the command %s.\r\n", cmdbuff); + } + WaitForSingleObject(info.hProcess,INFINITE); + free(cmdbuff); +} +#endif /* defined(__WIN32__) */ + +/* + * do_terminate + */ +static void +do_terminate(reason) + int reason; +{ + /* + When we get here, we have HEART_BEAT_BOOT_DELAY secs to finish + (plus heart_beat_report_delay if under VxWorks), so we don't need + to call wd_reset(). + */ + + switch (reason) { + case R_SHUT_DOWN: + break; + case R_TIMEOUT: + case R_ERROR: + case R_CLOSED: + default: +#if defined(__WIN32__) /* Not VxWorks */ + { + if(!cmd[0]) { + char *command = get_env(HEART_COMMAND_ENV); + if(!command) + print_error("Would reboot. Terminating."); + else { + kill_old_erlang(); + /* High prio combined with system() works badly indeed... */ + SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS); + win_system(command); + print_error("Executed \"%s\". Terminating.",command); + } + free_env_val(command); + } + else { + kill_old_erlang(); + /* High prio combined with system() works badly indeed... */ + SetPriorityClass(GetCurrentProcess(), NORMAL_PRIORITY_CLASS); + win_system(&cmd[0]); + print_error("Executed \"%s\". Terminating.",cmd); + } + } + +#else + { + if(!cmd[0]) { + char *command = get_env(HEART_COMMAND_ENV); + if(!command) + print_error("Would reboot. Terminating."); + else { + kill_old_erlang(); + system(command); + print_error("Executed \"%s\". Terminating.",command); + } + free_env_val(command); + } + else { + kill_old_erlang(); + system((char*)&cmd[0]); + print_error("Executed \"%s\". Terminating.",cmd); + } + } + break; +#endif + } /* switch(reason) */ +} + +/* + * notify_ack + * + * Sends an HEART_ACK. + */ +static int +notify_ack(fd) + int fd; +{ + struct msg m; + + m.op = HEART_ACK; + m.len = htons(1); + return write_message(fd, &m); +} + + +/* + * send back current command + * + * Sends an HEART_CMD. + */ +static int +heart_cmd_reply(int fd, char *s) +{ + struct msg m; + int len = strlen(s) + 1; /* Include \0 */ + + /* FIXME if s >= MSG_BODY_SIZE error */ + + m.op = HEART_CMD; + m.len = htons(len + 2); /* Include Op */ + strcpy((char*)m.fill, s); + + return write_message(fd, &m); +} + + +/* + * write_message + * + * Writes a message to a blocking file descriptor. Returns the total + * size of the message written (always > 0), or -1 if error. + * + * A message which is too short or too long, is not written. The return + * value is then MSG_HDR_SIZE (2), as if the message had been written. + * Is this really necessary? Can't we assume that the length is ok? + * FIXME. + */ +static int +write_message(fd, mp) + int fd; + struct msg *mp; +{ + int len; + char* tmp; + + tmp = (char*) &(mp->len); + len = (*tmp * 256) + *(tmp+1); + if ((len == 0) || (len > MSG_BODY_SIZE)) { + return MSG_HDR_SIZE; + } /* cc68k wants (char *) */ + if (write(fd, (char *) mp, len + MSG_HDR_SIZE) != len + MSG_HDR_SIZE) { + return -1; + } + return len + MSG_HDR_SIZE; +} + +/* + * read_message + * + * Reads a message from a blocking file descriptor. Returns the total + * size of the message read (> 0), 0 if eof, and < 0 if error. + * + * Note: The return value MSG_HDR_SIZE means a message of total size + * MSG_HDR_SIZE, i.e. without even an operation field. + * + * If the size of the message is larger than MSG_TOTAL_SIZE, the total + * number of bytes read is returned, but the buffer contains a truncated + * message. + */ +static int +read_message(fd, mp) + int fd; + struct msg *mp; +{ + int rlen, i; + unsigned char* tmp; + + if ((i = read_fill(fd, (char *) mp, MSG_HDR_SIZE)) != MSG_HDR_SIZE) { + /* < 0 is an error; = 0 is eof */ + return i; + } + + tmp = (unsigned char*) &(mp->len); + rlen = (*tmp * 256) + *(tmp+1); + if (rlen == 0) { + return MSG_HDR_SIZE; + } + if (rlen > MSG_BODY_SIZE) { + if ((i = read_skip(fd, (((char *) mp) + MSG_HDR_SIZE), + MSG_BODY_SIZE, rlen)) != rlen) { + return i; + } else { + return rlen + MSG_HDR_SIZE; + } + } + if ((i = read_fill(fd, ((char *) mp + MSG_HDR_SIZE), rlen)) != rlen) { + return i; + } + return rlen + MSG_HDR_SIZE; +} + +/* + * read_fill + * + * Reads len bytes into buf from a blocking fd. Returns total number of + * bytes read (i.e. len) , 0 if eof, or < 0 if error. len must be > 0. + */ +static int +read_fill(fd, buf, len) + int fd, len; + char *buf; +{ + int i, got = 0; + + do { + if ((i = read(fd, buf + got, len - got)) <= 0) { + return i; + } + got += i; + } while (got < len); + return len; +} + +/* + * read_skip + * + * Reads len bytes into buf from a blocking fd, but puts not more than + * maxlen bytes in buf. Returns total number of bytes read ( > 0), + * 0 if eof, or < 0 if error. len > maxlen > 0 must hold. + */ +static int +read_skip(fd, buf, maxlen, len) + int fd, maxlen, len; + char *buf; +{ + int i, got = 0; + char c; + + if ((i = read_fill(fd, buf, maxlen)) <= 0) { + return i; + } + do { + if ((i = read(fd, &c, 1)) <= 0) { + return i; + } + got += i; + } while (got < len - maxlen); + return len; +} + +/* + * print_error + */ +static void +print_error(const char *format,...) +{ + va_list args; + time_t now; + char *timestr; + + va_start(args, format); + time(&now); + timestr = ctime(&now); + fprintf(stderr, "%s: %.*s: ", program_name, (int) strlen(timestr)-1, timestr); + vfprintf(stderr, format, args); + va_end(args); + fprintf(stderr, "\r\n"); +} + +static void +debugf(const char *format,...) +{ + va_list args; + + if (!debug_on) return; + va_start(args, format); + fprintf(stderr, "Heart: "); + vfprintf(stderr, format, args); + va_end(args); + fprintf(stderr, "\r\n"); +} + +#ifdef __WIN32__ +void print_last_error() { + LPVOID lpMsgBuf; + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), /* Default language */ + (LPTSTR) &lpMsgBuf, + 0, + NULL + ); + + /* Display the string.*/ + fprintf(stderr,"GetLastError:%s\n",lpMsgBuf); + + /* Free the buffer. */ + LocalFree( lpMsgBuf ); +} + +static int test_win95(void) +{ + OSVERSIONINFO osinfo; + osinfo.dwOSVersionInfoSize=sizeof(OSVERSIONINFO); + GetVersionEx(&osinfo); + if (osinfo.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) + return 1; + else + return 0; +} + +static BOOL enable_privilege() { + HANDLE ProcessHandle; + DWORD DesiredAccess = TOKEN_ADJUST_PRIVILEGES; + HANDLE TokenHandle; + TOKEN_PRIVILEGES Tpriv; + LUID luid; + ProcessHandle = GetCurrentProcess(); + OpenProcessToken(ProcessHandle, DesiredAccess, &TokenHandle); + LookupPrivilegeValue(0,SE_SHUTDOWN_NAME,&luid); + Tpriv.PrivilegeCount = 1; + Tpriv.Privileges[0].Luid = luid; + Tpriv.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED; + return AdjustTokenPrivileges(TokenHandle,FALSE,&Tpriv,0,0,0); +} + +static BOOL do_shutdown(int really_shutdown) { + if (test_win95()) { + if (ExitWindowsEx(EWX_REBOOT,0)) { + return TRUE; + } else { + print_last_error(); + return FALSE; + } + } else { + enable_privilege(); + if (really_shutdown) { + if (InitiateSystemShutdown(NULL,"shutdown by HEART",10,TRUE,TRUE)) + return TRUE; + } else if (InitiateSystemShutdown(NULL, + "shutdown by HEART\n" + "will be interrupted", + 30,TRUE,TRUE)) { + AbortSystemShutdown(NULL); + return TRUE; + } + return FALSE; + } +} + +DWORD WINAPI reader(LPVOID lpvParam) { + + while (1) { + debugf("reader is reading\n"); + tlen = read_message(erlin_fd, mp); + debugf("reader setting event\n"); + SetEvent(hevent_dataready); + if(tlen == 0) + break; + } + return 0; +} + +HANDLE start_reader_thread(void) { + DWORD tid; + HANDLE thandle; + if ((thandle = (HANDLE) + _beginthreadex(NULL,0,reader,NULL,0,&tid)) == NULL) { + print_last_error(); + exit(1); + } + return thandle; +} +#endif + +#if defined(__WIN32__) + +# define TICK_MASK 0x7FFFFFFFUL + +void init_timestamp(void) +{ +} + +time_t timestamp(time_t *res) +{ + static time_t extra = 0; + static unsigned last_ticks = 0; + unsigned this_ticks; + time_t r; + + this_ticks = GetTickCount() & TICK_MASK; + + if (this_ticks < last_ticks) { + extra += (time_t) ((TICK_MASK + 1) / 1000); + } + + last_ticks = this_ticks; + + r = ((time_t) (this_ticks / 1000)) + extra; + + if (res != NULL) + *res = r; + return r; +} + +#elif defined(VXWORKS) + +static WDOG_ID watchdog_id; +static volatile unsigned elapsed; +static WIND_TCB *this_task; +/* A simple variable is enough to lock the time update, as the + watchdog is run at interrupt level and never preempted. */ +static volatile int lock_time; + +static void my_delete_hook(WIND_TCB *tcb) +{ + if (tcb == this_task) { + wdDelete(watchdog_id); + watchdog_id = NULL; + taskDeleteHookDelete((FUNCPTR) &my_delete_hook); + } +} + +static void my_wd_routine(int count) +{ + if (watchdog_id != NULL) { + ++count; + if (!lock_time) { + elapsed += count; + count = 0; + } + wdStart(watchdog_id, sysClkRateGet(), + (FUNCPTR) &my_wd_routine, count); + } +} + +void init_timestamp(void) +{ + lock_time = 0; + elapsed = 0; + watchdog_id = wdCreate(); + this_task = (WIND_TCB *) taskIdSelf(); + taskDeleteHookAdd((FUNCPTR) &my_delete_hook); + wdStart(watchdog_id, sysClkRateGet(), + (FUNCPTR) &my_wd_routine, 0); +} + +time_t timestamp(time_t *res) +{ + time_t r; + ++lock_time; + r = (time_t) elapsed; + --lock_time; + if (res != NULL) + *res = r; + return r; +} + +#elif defined(HAVE_GETHRTIME) + +void init_timestamp(void) +{ +} + +time_t timestamp(time_t *res) +{ + hrtime_t ht = gethrtime(); + time_t r = (time_t) (ht / 1000000000); + if (res != NULL) + *res = r; + return r; +} + +#elif defined(HEART_CORRECT_USING_TIMES) + +# ifdef NO_SYSCONF +# include +# define TICKS_PER_SEC() HZ +# else +# define TICKS_PER_SEC() sysconf(_SC_CLK_TCK) +# endif + +# define TICK_MASK 0x7FFFFFFFUL + +static unsigned tps; + +void init_timestamp(void) +{ + tps = TICKS_PER_SEC(); +} + +time_t timestamp(time_t *res) +{ + static time_t extra = 0; + static clock_t last_ticks = 0; + clock_t this_ticks; + struct tms dummy; + time_t r; + + this_ticks = (times(&dummy) & TICK_MASK); + + if (this_ticks < last_ticks) { + extra += (time_t) ((TICK_MASK + 1) / tps); + } + + last_ticks = this_ticks; + + r = ((time_t) (this_ticks / tps)) + extra; + + if (res != NULL) + *res = r; + return r; +} + +#else + +void init_timestamp(void) +{ +} + +time_t timestamp(time_t *res) +{ + return time(res); +} + +#endif diff --git a/erts/etc/common/inet_gethost.c b/erts/etc/common/inet_gethost.c new file mode 100644 index 0000000000..ff16ee02c4 --- /dev/null +++ b/erts/etc/common/inet_gethost.c @@ -0,0 +1,2757 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Erlang port program to do the name service lookup for the erlang + * distribution and inet part of the kernel. + * A pool of subprocess is kept, to which a pair of pipes is connected. + * The main process schedules requests among the different subprocesses + * (created with fork()), to be able to handle as many requests as possible + * simultaneously. The controlling erlang machine may request a "cancel", + * in which case the process may be killed and restarted when the need arises. + * The single numeric parameter to this program is the maximum port pool size, + * which is the size of the bookkeeping array. + * + * Windows: + * There is instead of a pool of processes a pool of threads. + * Communication is not done through pipes but via message queues between + * the threads. The only "pipes" involved are the ones used for communicating + * with Erlang. + * Important note: + * For unknown reasons, the combination of a thread doing blocking I/O on + * a named pipe at the same time as another thread tries to resolve a hostname + * may (with certain software configurations) block the gethostbyname call (!) + * For that reason, standard input (and standard output) should be opened + * in asynchronous mode (FILE_FLAG_OVERLAPPED), which has to be done by Erlang. + * A special flag to open_port is used to work around this behaviour in winsock + * and the threads doing read and write handle asynchronous I/O. + * The ReadFile and WriteFile calls try to cope with both types of I/O, why + * the code is not really as Microsoft describes "the right way to do it" in + * their documentation. Important to note is that **there is no supported way + * to retrieve the information if the HANDLE was opened with + * FILE_FLAG_OVERLAPPED from the HANDLE itself**. + * + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifdef WIN32 + +#define WIN32_LEAN_AND_MEAN +#include +#include +#include +#include +#include + +/* These are not used even if they would exist which they should not */ +#undef HAVE_GETADDRINFO +#undef HAVE_GETIPNODEBYNAME +#undef HAVE_GETHOSTBYNAME2 +#undef HAVE_GETNAMEINFO +#undef HAVE_GETIPNODEBYADDR + +#else /* Unix */ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#ifdef HAVE_SYS_TIME_H +#include +#else +#include +#endif +#include + +#ifndef RETSIGTYPE +#define RETSIGTYPE void +#endif + +/* To simplify #ifdef code further down - select only one to be defined... +** Use them in pairs - if one is broken do not trust its mate. +**/ +#if defined(HAVE_GETADDRINFO) && defined(HAVE_GETNAMEINFO) +#undef HAVE_GETIPNODEBYNAME +#undef HAVE_GETIPNODEBYADDR +#undef HAVE_GETHOSTBYNAME2 +#elif defined(HAVE_GETIPNODEBYNAME) && defined(HAVE_GETIPNODEBYADDR) +#undef HAVE_GETADDRINFO +#undef HAVE_GETNAMEINFO +#undef HAVE_GETHOSTBYNAME2 +#else +#undef HAVE_GETIPNODEBYNAME +#undef HAVE_GETIPNODEBYADDR +#undef HAVE_GETADDRINFO +#undef HAVE_GETNAMEINFO +#endif + +#endif /* !WIN32 */ + +#define PACKET_BYTES 4 +#ifdef WIN32 +#define READ_PACKET_BYTES(X,Y,Z) read_int32((X),(Y),(Z)) +#else +#define READ_PACKET_BYTES(X,Y) read_int32((X),(Y)) +#endif +#define PUT_PACKET_BYTES(X,Y) put_int32((X),(Y)) +/* The serial numbers of the requests */ +typedef int SerialType; + +#define INVALID_SERIAL -1 + +/* The operations performed by this program */ +typedef unsigned char OpType; + +#define OP_GETHOSTBYNAME 1 +#define OP_GETHOSTBYADDR 2 +#define OP_CANCEL_REQUEST 3 +#define OP_CONTROL 4 + +/* The protocol (IPV4/IPV6) */ +typedef unsigned char ProtoType; + +#define PROTO_IPV4 1 +#define PROTO_IPV6 2 + +/* OP_CONTROL */ +typedef unsigned char CtlType; +#define SETOPT_DEBUG_LEVEL 0 + +/* The unit of an IP address (0 == error, 4 == IPV4, 16 == IPV6) */ +typedef unsigned char UnitType; + +#define UNIT_ERROR 0 +#define UNIT_IPV4 4 +#define UNIT_IPV6 16 + +/* And the byte type */ +typedef unsigned char AddrByte; /* Must be compatible with character + datatype */ + +/* + * Marshalled format of request: + *{ + * Serial: 32 bit big endian + * Op:8 bit [1,2,3] + * If op == 1 { + * Proto:8 bit [1,2] + * Str: Null terminated array of characters + * } Else if op == 2 { + * Proto:8 bit [1,2] + * If proto == 1 { + * B0..B3: 4 bytes, most significant first + * } Else (proto == 2) { + * B0..B15: 16 bytes, most significant first + * } + * } + * (No more if op == 3) + *} + * The request arrives as a packet, with 4 packet size bytes. + */ + +/* The main process unpackes the marshalled message and sends the data + * to a suitable port process or, in the case of a close request, kills the + * suitable port process. There is also a que of requests linked together, + * for when all subrocesses are busy. + */ + +typedef struct QueItem { + struct QueItem *next; + int req_size; + AddrByte request[1]; +} QueItem; /* Variable size due to request's variable size */ + +QueItem *que_first; +QueItem *que_last; + +#ifdef WIN32 +typedef struct mesq { + HANDLE data_present; + CRITICAL_SECTION crit; + int shutdown; + QueItem *first; + QueItem *last; +} MesQ; + +MesQ *to_erlang; +MesQ *from_erlang; +#endif + +/* + * Marshalled format of reply: + *{ + * Serial: 32 bit big endian + * Unit: 8 bit, same as h_length or 0 for error + * if unit == 0 { + * Str: Null terminated character string explaining the error + * } else { + * Naddr: 32 bit big endian + * if unit = 4 { + * (B0..B3)0..(B0..B3)Naddr-1: Naddr*4 bytes most significant first + * } else if unit == 16 { + * (B0..B15)0..(B0..B15)Naddr-1: Naddr*16 bytes most significant first + * } + * Nnames: 32 bit big endian >= 1 + * Name0: Null terminated string of characters + * Alias[0]..Alias[Nnames - 2]: Nnames - 1 Null terminated strings of chars + * } + *} + * Four packet size bytes prepended (big endian) + */ +/* Internal error codes */ +#define ERRCODE_NOTSUP 1 +#define ERRCODE_HOST_NOT_FOUND 2 +#define ERRCODE_TRY_AGAIN 3 +#define ERRCODE_NO_RECOVERY 4 +#define ERRCODE_NO_DATA 5 +#define ERRCODE_NETDB_INTERNAL 7 + +/* + * Each worker process is represented in the parent by the following struct + */ + +typedef unsigned WorkerState; + +#define WORKER_EMPTY 0 /* No process created */ +#define WORKER_FREE 1 /* Living waiting process */ +#define WORKER_BUSY 2 /* Living busy process */ +#define WORKER_STALLED 3 /* Living cancelled process */ + +/* The timeout when killing a child process in seconds*/ +#define CHILDWAIT_TMO 1 +/* The domainname size_limit */ +#define DOMAINNAME_MAX 258 /* 255 + Opcode + Protocol + Null termination */ + +typedef struct { + WorkerState state; +#ifdef WIN32 + DWORD pid; /* 0 if unused */ + MesQ *writeto; /* Message queues */ + MesQ *readfrom; +#else + pid_t pid; /* -1 if unused */ + int writeto, readfrom; /* Pipes */ +#endif + SerialType serial; + AddrByte domain[DOMAINNAME_MAX]; + QueItem *que_first; + QueItem *que_last; + int que_size; +} Worker; + +int num_busy_workers; +int num_free_workers; +int num_stalled_workers; +int max_workers; +int greedy_threshold; +Worker *busy_workers; /* Workers doing any job that someone really is + interested in */ +Worker *free_workers; /* Really free workers */ +Worker *stalled_workers; /* May still deliver answers which we will + discard */ +#define BEE_GREEDY() (num_busy_workers >= greedy_threshold) + +static char *program_name; + +static int debug_level; +#ifdef WIN32 +static HANDLE debug_console_allocated = INVALID_HANDLE_VALUE; +#endif + +#ifdef NODEBUG +#define DEBUGF(L,P) /* Nothing */ +#else +#define DEBUGF(Level,Printf) do { if (debug_level >= (Level)) \ + debugf Printf;} while(0) +#endif +#define ALLOC(Size) my_malloc(Size) +#define REALLOC(Old, Size) my_realloc((Old), (Size)) +#define FREE(Ptr) free(Ptr) + +#ifdef WIN32 +#define WAKEUP_WINSOCK() do { \ + char dummy_buff[100]; \ + gethostname(dummy_buff,99); \ +} while (0) +#endif + +/* The internal prototypes */ +static char *format_address(int siz, AddrByte *addr); +static void debugf(char *format, ...); +static void warning(char *format, ...); +static void fatal(char *format, ...); +static void *my_malloc(size_t size); +static void *my_realloc(void *old, size_t size); +static int get_int32(AddrByte *buff); +static void put_int32(AddrByte *buff, int value); +static int create_worker(Worker *pworker, int save_que); +static int map_netdb_error(int netdb_code); +#if defined(HAVE_GETADDRINFO) || defined(HAVE_GETNAMEINFO) +static int map_netdb_error_ai(int netdb_code); +#endif +static char *errcode_to_string(int errcode); +static size_t build_error_reply(SerialType serial, int errnum, + AddrByte **preply, + size_t *preply_size); +#ifdef HAVE_GETADDRINFO +static size_t build_reply_ai(SerialType serial, int, struct addrinfo *, + AddrByte **preply, size_t *preply_size); +#endif +static size_t build_reply(SerialType serial, struct hostent *he, + AddrByte **preply, size_t *preply_size); +static int read_request(AddrByte **buff, size_t *buff_size); +static OpType get_op(AddrByte *buff); +static AddrByte *get_op_addr(AddrByte *buff); +static SerialType get_serial(AddrByte *buff); +static ProtoType get_proto(AddrByte *buff); +static CtlType get_ctl(AddrByte *buff); +static AddrByte *get_data(AddrByte *buff); +static int get_debug_level(AddrByte *buff); +static int relay_reply(Worker *pw); +static int ignore_reply(Worker *pw); +static void init_workers(int max); +static void kill_worker(Worker *pw); +static Worker *pick_worker(void); +static void kill_last_picked_worker(void); +static void stall_worker(SerialType serial); +static int handle_io_busy(int ndx); +static int handle_io_free(int ndx); +static int handle_io_stalled(int ndx); +static void check_que(void); +static void main_loop(void); +static void usage(char *unknown); +static void domaincopy(AddrByte *out,AddrByte *in); +static int domaineq(AddrByte *d1, AddrByte *d2); +static int get_domainname(AddrByte *inbuff, int insize, AddrByte *domainbuff); +static Worker *pick_worker_greedy(AddrByte *domainbuff); +static void restart_worker(Worker *w); +static void start_que_request(Worker *w) ; +#ifdef WIN32 +static int read_int32(HANDLE fd, int *res, HANDLE ev); +static int read_exact(HANDLE fd, void *vbuff, DWORD nbytes, HANDLE ev); +static int write_exact(HANDLE fd, AddrByte *buff, DWORD len,HANDLE ev); +DWORD WINAPI worker_loop(void *v); +DWORD WINAPI reader(void *data); +DWORD WINAPI writer(void *data); +static int send_mes_to_worker(QueItem *m, Worker *pw); +BOOL create_mesq(MesQ **q); +BOOL enque_mesq(MesQ *q, QueItem *m); +BOOL deque_mesq(MesQ *q, QueItem **m); +BOOL close_mesq(MesQ *q); +HANDLE event_mesq(MesQ *q); +#else +static size_t read_int32(int fd, int *res); +static ssize_t read_exact(int fd, void *vbuff, size_t nbytes); +static int write_exact(int fd, AddrByte *buff, int len); +void reap_children(int ignored); +static void init_signals(void); +static void kill_all_workers(void); +static void close_all_worker_fds(void); +static int worker_loop(void); +static int fillin_reply(Worker *pw); +static int send_request_to_worker(AddrByte *pr, int rsize, Worker *pw); +#endif + +#define ERL_DBG_LVL_ENV_VAR "ERL_INET_GETHOST_DEBUG" + +static int +get_env_debug_level(void) +{ +#ifdef __WIN32__ + char value[21]; /* Enough for any 64-bit values */ + DWORD sz = GetEnvironmentVariable((LPCTSTR) ERL_DBG_LVL_ENV_VAR, + (LPTSTR) value, + (DWORD) sizeof(value)); + if (sz == 0 || sz > sizeof(value)) + return 0; +#else + char *value = getenv(ERL_DBG_LVL_ENV_VAR); + if (!value) + return 0; +#endif + return atoi(value); +} + +#ifdef WIN32 +static void do_allocate_console(void) +{ + AllocConsole(); + debug_console_allocated = CreateFile ("CONOUT$", GENERIC_WRITE, + FILE_SHARE_WRITE, NULL, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, NULL); +} +#ifdef HARDDEBUG +DWORD WINAPI pseudo_worker_loop(void *v); +static void poll_gethost(int row); +#endif +#endif + +/* + * Main + */ +int main(int argc, char **argv) +{ + int num_workers = 1; + char **ap = argv + 1; + int x; + int disable_greedy = 0; + + program_name = *argv; + que_first = que_last = NULL; + debug_level = get_env_debug_level(); + greedy_threshold = 0; + + while (*ap) { + if (!strcmp(*ap, "-d")) { + ++debug_level; + } else if(!strcmp(*ap, "-g") && *(ap + 1)) { + ++ap; + x = atoi(*ap); + if (!x) { + usage(*ap); + } else { + greedy_threshold = x; + } + } else if(!strcmp(*ap, "-ng")) { + disable_greedy = 1; + } else { + x = atoi(*ap); + if (!x) { + usage(*ap); + } else { + num_workers = x; + } + } + ++ap; + } + +#ifdef WIN32 + if (num_workers > 60 || greedy_threshold > 60) { + usage("More than 60 workers on windows impossible!"); + num_workers = 60; + greedy_threshold = 0; + } +#endif + + if(!greedy_threshold) { + greedy_threshold = (3*num_workers)/4; /* 75% */ + if (!greedy_threshold) { + greedy_threshold = num_workers; + } + } + + if (disable_greedy) { + greedy_threshold = num_workers + 1; + } + +#ifdef WIN32 + { + WORD wr; + WSADATA wsa_data; + int wsa_error; + wr = MAKEWORD(2,0); + + wsa_error = WSAStartup(wr,&wsa_data); + if (wsa_error) { + fatal("Could not open usable winsock library."); + } + if (LOBYTE(wsa_data.wVersion) != 2 || HIBYTE(wsa_data.wVersion) != 0) { + fatal("Could not open recent enough winsock library."); + } + + if (debug_level >= 1) { + do_allocate_console(); + + DEBUGF(1,("num_workers = %d, greedy_threshold = %d, " + "debug_level = %d.", + num_workers, greedy_threshold, debug_level)); + } + } + WAKEUP_WINSOCK(); /* Why on earth is this needed? */ + +#endif + + init_workers(num_workers); + + main_loop(); +#ifndef WIN32 + kill_all_workers(); +#endif + return 0; +} + +static void usage(char *unknown) +{ + fprintf(stderr,"%s: Unknown option \"%s\"\n" + "Usage: %s [-d [-d ...]] [-g ] " + "[]\n", + program_name, unknown, program_name); +} + +/* + * Main process main loop + */ + +static int handle_io_busy(int ndx) +{ + /* Probably an answer */ + int res; + res = relay_reply(&busy_workers[ndx]); + if (res < 0) { + /* Bad worker */ + if (busy_workers[ndx].que_size) { + restart_worker(&busy_workers[ndx]); + start_que_request(&busy_workers[ndx]); + return 0; + } else { + kill_worker(&busy_workers[ndx]); + --num_busy_workers; + busy_workers[ndx] = busy_workers[num_busy_workers]; + } + return 1; + } else if (res == 0) { + /* Erlang has closed */ + return -1; + } else { + if (busy_workers[ndx].que_size) { + start_que_request(&busy_workers[ndx]); + return 0; + } + /* The worker is no longer busy, it should be in the free list */ + free_workers[num_free_workers] = busy_workers[ndx]; + free_workers[num_free_workers].state = WORKER_FREE; + ++num_free_workers; + --num_busy_workers; + busy_workers[ndx] = busy_workers[num_busy_workers]; + return 1; + } +} + +static int handle_io_free(int ndx) +{ + /* IO from a free worker means "kill me" */ + DEBUGF(1,("Free worker[%ld] spontaneously died.", + (long) free_workers[ndx].pid)); + kill_worker(&free_workers[ndx]); + --num_free_workers; + free_workers[ndx] = free_workers[num_free_workers]; + return 1; +} + +static int handle_io_stalled(int ndx) +{ + int res; + res = ignore_reply(&stalled_workers[ndx]); + if (res <= 0) { + /* Bad worker */ + kill_worker(&stalled_workers[ndx]); + --num_stalled_workers; + stalled_workers[ndx] = stalled_workers[num_stalled_workers]; + return 1; + } else { + DEBUGF(3,("Ignoring reply from stalled worker[%ld].", + (long) stalled_workers[ndx].pid)); + free_workers[num_free_workers] = stalled_workers[ndx]; + free_workers[num_free_workers].state = WORKER_FREE; + ++num_free_workers; + --num_stalled_workers; + stalled_workers[ndx] = stalled_workers[num_stalled_workers]; + return 1; + } +} + +static void check_que(void) +{ + /* Check if anything in the que can be handled */ + Worker *cw; + + while (que_first) { + QueItem *qi,*nxt; + qi = que_first; + nxt = qi->next; /* Need to save before it's getting put in another que + in threaded solution */ + if ((cw = pick_worker()) == NULL) { + break; + } +#ifdef WIN32 + { + SerialType save_serial = get_serial(que_first->request); + if (send_mes_to_worker(que_first, cw) != 0) { + kill_last_picked_worker(); + continue; + } + cw->serial = save_serial; + } +#else + if (send_request_to_worker(que_first->request, + que_first->req_size, cw) != 0) { + /* Couldn't send request, kill the worker and retry */ + kill_last_picked_worker(); + continue; + } + cw->serial = get_serial(que_first->request); +#endif + /* Went well, lets deque */ + que_first = nxt; + if (que_first == NULL) { + que_last = NULL; + } + DEBUGF(3,("Did deque serial %d, Que is %sempty", + get_serial(qi->request), (que_first) ? "not " : "")); +#ifndef WIN32 + FREE(qi); +#endif + } +} + +static int clean_que_of(SerialType s) +{ + QueItem **qi; + int i; + + for(qi=&que_first;*qi != NULL && + s != get_serial((*qi)->request); qi = &((*qi)->next)) + ; + if(*qi != NULL) { + QueItem *r = *qi; + *qi = (*qi)->next; + FREE(r); + if(que_last == r) { + /* Lost the "last" pointer, should be very uncommon + if the que is not empty, so we simply do a traversal + to reclaim it. */ + if (que_first == NULL) { + que_last = NULL; + } else { + for (que_last=que_first;que_last->next != NULL; + que_last = que_last->next) + ; + } + } + DEBUGF(3,("Removing serial %d from global que on request, " + "que %sempty",s, (que_first) ? "not " : "")); + return 1; + } + for (i = 0; i < num_busy_workers; ++i) { + for(qi=&(busy_workers[i].que_first);*qi != NULL && + s != get_serial((*qi)->request); qi = &((*qi)->next)) + ; + if(*qi != NULL) { + QueItem *r = *qi; + *qi = (*qi)->next; + FREE(r); + if(busy_workers[i].que_last == r) { + /* Lost the "last" pointer, should be very uncommon + if the que is not empty, so we simply do a traversal + to reclaim it. */ + if (busy_workers[i].que_first == NULL) { + busy_workers[i].que_last = NULL; + if (busy_workers[i].que_size != 1) { + fatal("Worker que size counter incorrect, internal datastructure error."); + } + } else { + for (busy_workers[i].que_last = busy_workers[i].que_first; + busy_workers[i].que_last->next != NULL; + busy_workers[i].que_last = busy_workers[i].que_last->next) + ; + } + } + --(busy_workers[i].que_size); + DEBUGF(3,("Removing serial %d from worker[%ld] specific que " + "on request, que %sempty", + s, (long) busy_workers[i].pid, + (busy_workers[i].que_first) ? "not " : "")); + return 1; + } + } + return 0; +} + +static void main_loop(void) +{ + AddrByte *inbuff = NULL; + int insize; + int i,w; +#ifdef WIN32 + HANDLE handles[64]; + DWORD num_handles; + DWORD index; + QueItem *qi; +#else + size_t inbuff_size = 0; + fd_set fds; + int max_fd; +#endif + int new_data; + int save_serial; + /* It's important that the free workers list is handled first */ + Worker *workers[3] = {free_workers, busy_workers, stalled_workers}; + int *wsizes[3] = {&num_free_workers, &num_busy_workers, + &num_stalled_workers}; + int (*handlers[3])(int) = {&handle_io_free, &handle_io_busy, + &handle_io_stalled}; + Worker *cw; + AddrByte domainbuff[DOMAINNAME_MAX]; + +#ifdef WIN32 + + { + DWORD dummy; + /* Create the reader and writer */ + if ((!create_mesq(&to_erlang)) || (!create_mesq(&from_erlang))) { + fatal("Could not create message que! errno = %d.",GetLastError()); + } + if (((HANDLE) _beginthreadex(NULL,0,writer,to_erlang,0,&dummy)) + == NULL) { + fatal("Could not create writer thread! errno = %d.",GetLastError()); + } + if (((HANDLE) _beginthreadex(NULL,0,reader,from_erlang,0,&dummy)) + == NULL) { + fatal("Could not create reader thread! errno = %d.",GetLastError()); + } + DEBUGF(4,("Created reader and writer threads.")); +#ifdef HARDDEBUG + poll_gethost(__LINE__); +#endif + } +#endif + + for(;;) { +#ifdef WIN32 + num_handles = 0; + handles[num_handles++] = event_mesq(from_erlang); + for (w = 0; w < 3; ++w) { + for (i = 0; i < *wsizes[w]; ++i) { + handles[num_handles++] = event_mesq(workers[w][i].readfrom); + } + } + + if ((index = WaitForMultipleObjects(num_handles, handles, FALSE, INFINITE)) + == WAIT_FAILED) { + fatal("Could not WaitForMultpleObjects! errno = %d.",GetLastError()); + } + w = 0; + index -= WAIT_OBJECT_0; + + DEBUGF(4,("Got data on index %d.",index)); + if (index > 0) { + if (((int)index - 1) < *wsizes[0]) { + (*handlers[0])(index - 1); + } else if (((int)index - 1) < ((*wsizes[0]) + (*wsizes[1]))) { + (*handlers[1])(index - 1 - (*wsizes[0])); + } else { + (*handlers[2])(index - 1 - (*wsizes[0]) - (*wsizes[1])); + } + } + new_data = (index == 0); +#else + max_fd = 0; + FD_ZERO(&fds); + FD_SET(0,&fds); + for (w = 0; w < 3; ++w) { + for (i = 0; i < *wsizes[w]; ++i) { + FD_SET(workers[w][i].readfrom,&fds); + if (workers[w][i].readfrom > max_fd) { + max_fd = workers[w][i].readfrom; + } + } + } + for (;;) { + if (select(max_fd + 1,&fds,NULL,NULL,NULL) < 0) { + if (errno == EINTR) { + continue; + } else { + fatal("Select failed (invalid internal structures?), " + "errno = %d.",errno); + } + } + break; + } + for (w = 0; w < 3; ++w) { + for (i = 0; i < *wsizes[w]; ++i) { + if (FD_ISSET(workers[w][i].readfrom, &fds)) { + int hres = (*handlers[w])(i); + if (hres < 0) { + return; + } else { + i -= hres; /* We'll retry this position, if hres == 1. + The position is usually + replaced with another worker, + a worker with + I/O usually changes state as we + use blocking file I/O */ + } + } + } + } + new_data = FD_ISSET(0,&fds); + +#endif + + check_que(); + + /* Now check for new requests... */ + if (new_data) { /* Erlang... */ + OpType op; +#ifdef WIN32 + if (!deque_mesq(from_erlang,&qi)) { + DEBUGF(1,("Erlang has closed.")); + return; + } + insize = qi->req_size; + inbuff = qi->request; + DEBUGF(4,("Got data from erlang.")); + DEBUGF(4,("OPeration == %d.",get_op(inbuff))); +#else + insize = read_request(&inbuff, &inbuff_size); + if (insize == 0) { /* Other errors taken care of in + read_request */ + DEBUGF(1,("Erlang has closed.")); + return; + } +#endif + op = get_op(inbuff); + if (op == OP_CANCEL_REQUEST) { + SerialType serial = get_serial(inbuff); + if (!clean_que_of(serial)) { + for (i = 0; i < num_busy_workers; ++i) { + if (busy_workers[i].serial == serial) { + if (busy_workers[i].que_size) { + restart_worker(&busy_workers[i]); + start_que_request(&busy_workers[i]); + } else { + stall_worker(i); + check_que(); + } + break; + } + } + } +#ifdef WIN32 + FREE(qi); +#endif + continue; /* New select */ + } else if (op == OP_CONTROL) { + CtlType ctl; + SerialType serial = get_serial(inbuff); + if (serial != INVALID_SERIAL) { + fatal("Invalid serial: %d.", serial); + } + switch (ctl = get_ctl(inbuff)) { + case SETOPT_DEBUG_LEVEL: + { + int tmp_debug_level = get_debug_level(inbuff); +#ifdef WIN32 + if (debug_console_allocated == INVALID_HANDLE_VALUE && + tmp_debug_level > 0) { + DWORD res; + do_allocate_console(); + WriteFile(debug_console_allocated, + "Hej\n",4,&res,NULL); + } +#endif + debug_level = tmp_debug_level; + DEBUGF(debug_level, ("debug_level = %d", debug_level)); + for (w = 0; w < 3; ++w) { + for (i = 0; i < *wsizes[w]; i++) { + int res; +#ifdef WIN32 + QueItem *m; +#endif + cw = &(workers[w][i]); +#ifdef WIN32 + m = ALLOC(sizeof(QueItem) - 1 + qi->req_size); + memcpy(m->request, qi->request, + (m->req_size = qi->req_size)); + m->next = NULL; + if ((res = send_mes_to_worker(m, cw)) != 0) { + FREE(m); + } +#else + res = send_request_to_worker(inbuff, insize, cw); +#endif + if (res != 0) { + kill_worker(cw); + (*wsizes[w])--; + *cw = workers[w][*wsizes[w]]; + } + } + } + } + break; + default: + warning("Unknown control requested from erlang (%d), " + "message discarded.", (int) ctl); + break; + } +#ifdef WIN32 + FREE(qi); +#endif + continue; /* New select */ + } else { + ProtoType proto; + if (op != OP_GETHOSTBYNAME && op != OP_GETHOSTBYADDR) { + warning("Unknown operation requested from erlang (%d), " + "message discarded.", op); +#ifdef WIN32 + FREE(qi); +#endif + continue; + } + if ((proto = get_proto(inbuff)) != PROTO_IPV4 && + proto != PROTO_IPV6) { + warning("Unknown protocol requested from erlang (%d), " + "message discarded.", proto); +#ifdef WIN32 + FREE(qi); +#endif + continue; + } + if (get_domainname(inbuff,insize,domainbuff) < 0) { + warning("Malformed message sent from erlang, no domain, " + "message discarded.", op); +#ifdef WIN32 + FREE(qi); +#endif + continue; + } + } + + if (BEE_GREEDY()) { + DEBUGF(4,("Beeing greedy!")); + if ((cw = pick_worker_greedy(domainbuff)) != NULL) { + /* Put it in the worker specific que if the + domainname matches... */ +#ifndef WIN32 + QueItem *qi = ALLOC(sizeof(QueItem) - 1 + + insize); + qi->req_size = insize; + memcpy(&(qi->request), inbuff, insize); + qi->next = NULL; +#endif + if (!cw->que_first) { + cw->que_first = cw->que_last = qi; + } else { + cw->que_last->next = qi; + cw->que_last = qi; + } + ++(cw->que_size); + continue; + } + /* Otherwise busyness as usual */ + } + + save_serial = get_serial(inbuff); + + while ((cw = pick_worker()) != NULL) { + int res; +#ifdef WIN32 + res = send_mes_to_worker(qi,cw); +#else + res = send_request_to_worker(inbuff, insize, cw); +#endif + if (res == 0) { + break; + } else { + kill_last_picked_worker(); + } + } + + if (cw == NULL) { + /* Insert into que */ +#ifndef WIN32 + QueItem *qi = ALLOC(sizeof(QueItem) - 1 + + insize); + qi->req_size = insize; + memcpy(&(qi->request), inbuff, insize); + qi->next = NULL; +#endif + if (!que_first) { + que_first = que_last = qi; + } else { + que_last->next = qi; + que_last = qi; + } + } else { + cw->serial = save_serial; + domaincopy(cw->domain, domainbuff); + } + } + } +} + +/* + * Main process worker administration + */ + +static void init_workers(int max) +{ + max_workers = max; + num_busy_workers = 0; + num_free_workers = 0; + num_stalled_workers = 0; + + busy_workers = ALLOC(sizeof(Worker) * max_workers); + free_workers = ALLOC(sizeof(Worker) * max_workers); + stalled_workers = ALLOC(sizeof(Worker) * max_workers); +#ifndef WIN32 + init_signals(); +#endif +} + +#ifdef WIN32 +static void kill_worker(Worker *pw) +{ + /* Cannot really kill a thread in win32, have to just leave it to die */ + close_mesq(pw->writeto); + close_mesq(pw->readfrom); + pw->state = WORKER_EMPTY; +} +#else +static void kill_worker(Worker *pw) +{ + fd_set fds; + struct timeval tmo; + int selret; + static char buff[1024]; + + DEBUGF(3,("Killing worker[%ld] with fd %d, serial %d", + (long) pw->pid, + (int) pw->readfrom, + (int) pw->serial)); + kill(pw->pid, SIGUSR1); + /* This is all just to check that the child died, not + really necessary */ + for(;;) { + FD_ZERO(&fds); + FD_SET(pw->readfrom, &fds); + tmo.tv_usec=0; + tmo.tv_sec = CHILDWAIT_TMO; + selret = select(pw->readfrom+1, &fds, NULL, NULL, &tmo); + if (selret < 0) { + if (errno != EINTR) { + warning("Unable to select on dying child file descriptor, " + "errno = %d.",errno); + break; + } + } else if (selret == 0) { + warning("Timeout waiting for child process to die, " + "ignoring child (pid = %d).", pw->pid); + break; + } else { + int ret; + if ((ret = read(pw->readfrom, buff, 1024)) < 0) { + if (errno != EINTR) { + warning("Child file descriptor not closed properly, " + "errno = %d", errno); + break; + } + } else if (ret == 0) { + break; + } + /* continue */ + } + } + /* Waiting is done by signal handler... */ + close(pw->readfrom); + close(pw->writeto); + pw->state = WORKER_EMPTY; + /* Leave rest as is... */ +} + +static void kill_all_workers(void) +/* Emergency function, will not check that the children died... */ +{ + int i; + for (i = 0; i < num_busy_workers; ++i) { + kill(busy_workers[i].pid, SIGUSR1); + } + for (i = 0; i < num_free_workers; ++i) { + kill(free_workers[i].pid, SIGUSR1); + } + for (i = 0; i < num_stalled_workers; ++i) { + kill(stalled_workers[i].pid, SIGUSR1); + } +} +#endif /* !WIN32 */ + +static Worker *pick_worker(void) +{ + Worker tmp; + if (num_free_workers > 0) { + --num_free_workers; + tmp = free_workers[num_free_workers]; + } else if (num_stalled_workers > 0) { + /* "restart" the worker... */ + --num_stalled_workers; + kill_worker(&(stalled_workers[num_stalled_workers])); + if (create_worker(&tmp,0) < 0) { + warning("Unable to create worker process, insufficient " + "resources"); + return NULL; + } + } else { + if (num_busy_workers == max_workers) { + return NULL; + } + if (create_worker(&tmp,0) < 0) { + warning("Unable to create worker process, insufficient " + "resources"); + return NULL; + } + } + /* tmp contains a worker now, make it busy and put it in the right + array */ + tmp.state = WORKER_BUSY; + busy_workers[num_busy_workers] = tmp; + ++num_busy_workers; + return &(busy_workers[num_busy_workers-1]); +} + +static Worker *pick_worker_greedy(AddrByte *domainbuff) +{ + int i; + int ql = 0; + int found = -1; + for (i=0; i < num_busy_workers; ++i) { + if (domaineq(busy_workers[i].domain, domainbuff)) { + if ((found < 0) || (busy_workers[i].que_size < + busy_workers[found].que_size)) { + found = i; + ql = busy_workers[i].que_size; + } + } + } + if (found >= 0) { + return &busy_workers[found]; + } + return NULL; +} + +static void restart_worker(Worker *w) +{ + kill_worker(w); + if (create_worker(w,1) < 0) { + fatal("Unable to create worker process, insufficient resources"); + } +} + +static void kill_last_picked_worker(void) +{ + kill_worker( &(busy_workers[num_busy_workers-1])); + --num_busy_workers; +} + +/* + * Starts a request qued to a specific worker, check_que starts normally queued requests. + * We expect a que here... + */ +static void start_que_request(Worker *w) +{ + QueItem *qi; + SerialType save_serial; + if (!w->que_first || !w->que_size) { + fatal("Expected que'd requests but found none, " + "internal datastructure corrupted!"); + } + qi = w->que_first; + w->que_first = w->que_first->next; + if (!w->que_first) { + w->que_last = NULL; + } + --(w->que_size); + save_serial = get_serial(qi->request); +#ifdef WIN32 + while (send_mes_to_worker(qi, w) != 0) { + restart_worker(w); + } +#else + while (send_request_to_worker(qi->request, + qi->req_size, w) != 0) { + restart_worker(w); + } +#endif + w->serial = save_serial; + DEBUGF(3,("Did deque serial %d from worker[%ld] specific que, " + "Que is %sempty", + get_serial(qi->request), (long) w->pid, + (w->que_first) ? "not " : "")); +#ifndef WIN32 + FREE(qi); +#endif +} + +#ifndef WIN32 +/* Signal utilities */ +static RETSIGTYPE (*sys_sigset(int sig, RETSIGTYPE (*func)(int)))(int) +{ + struct sigaction act, oact; + + sigemptyset(&act.sa_mask); + act.sa_flags = 0; + act.sa_handler = func; + sigaction(sig, &act, &oact); + return(oact.sa_handler); +} + + +static void sys_sigblock(int sig) +{ + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_BLOCK, &mask, (sigset_t *)NULL); +} + +static void sys_sigrelease(int sig) +{ + sigset_t mask; + + sigemptyset(&mask); + sigaddset(&mask, sig); + sigprocmask(SIG_UNBLOCK, &mask, (sigset_t *)NULL); +} + +/* Child signal handler */ +void reap_children(int ignored) +{ + int res; + sys_sigblock(SIGCHLD); + for (;;) { + while ((res = waitpid((pid_t)-1, NULL, WNOHANG)) > 0) + ; + if (!(res < 0 && errno == EAGAIN)) { + DEBUGF(4,("reap_children: res = %d, errno = %d.",res,errno)); + break; + } + } + sys_sigrelease(SIGCHLD); +} + +static void init_signals(void) +{ + sys_sigset(SIGCHLD,&reap_children); /* SIG_IGN would give same result + on most (?) platforms. */ + sys_sigset(SIGPIPE, SIG_IGN); +} +#endif + +static void stall_worker(int ndx) +{ + --num_busy_workers; + stalled_workers[num_stalled_workers] = busy_workers[ndx]; + stalled_workers[num_stalled_workers].state = WORKER_STALLED; + busy_workers[ndx] = busy_workers[num_busy_workers]; + DEBUGF(3, ("Stalled worker[%ld]", + (long) stalled_workers[num_stalled_workers].pid)); + ++num_stalled_workers; +} + + +/* + * Main loop message passing + */ +#ifndef WIN32 +static int read_request(AddrByte **buff, size_t *buff_size) +{ + int siz; + int r; + + if ((r = READ_PACKET_BYTES(0,&siz)) != PACKET_BYTES) { + if (r == 0) { + return 0; + } else { + fatal("Unexpected end of file on main input, errno = %d",errno); + } + } + + if (siz > *buff_size) { + if (buff_size == 0) { + *buff = ALLOC((*buff_size = siz)); + } else { + *buff = REALLOC(*buff, (*buff_size = siz)); + } + } + if (read_exact(0,*buff, siz) != siz) { + fatal("Unexpected end of file on main input, errno = %d",errno); + } + if (siz < 5) { + fatal("Unexpected message on main input, message size %d less " + "than minimum."); + } + return siz; +} + +#endif /* !WIN32 */ + +static OpType get_op(AddrByte *buff) +{ + return (OpType) buff[4]; +} + +static AddrByte *get_op_addr(AddrByte *buff) +{ + return buff + 4; +} + +static SerialType get_serial(AddrByte *buff) +{ + return get_int32(buff); +} + +static ProtoType get_proto(AddrByte *buff) +{ + return (ProtoType) buff[5]; +} + +static CtlType get_ctl(AddrByte *buff) +{ + return (CtlType) buff[5]; +} + +static AddrByte *get_data(AddrByte *buff) +{ + return buff + 6; +} + +static int get_debug_level(AddrByte *buff) +{ + return get_int32(buff + 6); +} + +#ifdef WIN32 +static int send_mes_to_worker(QueItem *m, Worker *pw) +{ + if (!enque_mesq(pw->writeto, m)) { + warning("Unable to send to child process."); + return -1; + } + return 0; +} +#else +static int send_request_to_worker(AddrByte *pr, int rsize, Worker *pw) +{ + AddrByte hdr[PACKET_BYTES]; + + PUT_PACKET_BYTES(hdr, rsize); + if (write_exact(pw->writeto, hdr, PACKET_BYTES) < 0) { + warning("Unable to write to child process."); + return -1; + } + if (write_exact(pw->writeto, (AddrByte *) pr, rsize) < 0) { + warning("Unable to write to child process."); + return -1; + } + return 0; +} +#endif /* !WIN32 */ + +#ifdef WIN32 +static int relay_reply(Worker *pw) +{ + QueItem *m; + if (!deque_mesq(pw->readfrom,&m)) { + return 0; + } + if (!enque_mesq(to_erlang,m)) { + FREE(m); + return 0; + } + return 1; +} + +static int ignore_reply(Worker *pw) { + QueItem *m; + if (!deque_mesq(pw->readfrom,&m)) { + return 0; + } + FREE(m); + return 1; +} + +#else + +/* Static buffers used by the next three functions */ +static AddrByte *relay_buff = NULL; +static int relay_buff_size = 0; + +static int fillin_reply(Worker *pw) +{ + int length; + + if (READ_PACKET_BYTES(pw->readfrom, &length) != PACKET_BYTES) { + warning("Malformed reply (header) from worker process %d.", + pw->pid); + return -1; + } + + if (relay_buff_size < (length + PACKET_BYTES)) { + if (!relay_buff_size) { + relay_buff = + ALLOC((relay_buff_size = (length + PACKET_BYTES))); + } else { + relay_buff = + REALLOC(relay_buff, + (relay_buff_size = (length + PACKET_BYTES))); + } + } + PUT_PACKET_BYTES(relay_buff, length); + if (read_exact(pw->readfrom, relay_buff + PACKET_BYTES, length) != + length) { + warning("Malformed reply (data) from worker process %d.", pw->pid); + return -1; + } + return length; +} + +static int relay_reply(Worker *pw) +{ + int length = fillin_reply(pw); /* Filled into the "global" buffer */ + int res; + + if (length < 0) { + return -1; + } + if ((res = write_exact(1, relay_buff, length + PACKET_BYTES)) < 0) { + fatal("Cannot write reply to erlang process, errno = %d.", errno); + } else if (res == 0) { + DEBUGF(1,("Erlang has closed write pipe.")); + return 0; + } + return length; +} + +static int ignore_reply(Worker *pw) +{ + return fillin_reply(pw); +} + +#endif /* !WIN32 */ + +/* + * Domain name "parsing" and worker specific queing + */ +static void domaincopy(AddrByte *out, AddrByte *in) +{ + AddrByte *ptr = out; + *ptr++ = *in++; + *ptr++ = *in++; + switch(*out) { + case OP_GETHOSTBYNAME: + while(*in != '\0' && *in != '.') + ++in; + strncpy((char*)ptr, (char*)in, DOMAINNAME_MAX-2); + ptr[DOMAINNAME_MAX-3] = '\0'; + DEBUGF(4,("Saved domainname %s.", ptr)); + return; + case OP_GETHOSTBYADDR: + memcpy(ptr,in, ((out[1] == PROTO_IPV4) ? UNIT_IPV4 : UNIT_IPV6) - 1); + DEBUGF(4, ("Saved domain address: %s.", + format_address(((out[1] == PROTO_IPV4) ? + UNIT_IPV4 : UNIT_IPV6) - 1,ptr))); + return; + default: + fatal("Trying to copy buffer not containing valid domain, [%d,%d].", + (int) out[0], (int) out[1]); + } +} + +static int domaineq(AddrByte *d1, AddrByte *d2) +{ + if (d1[0] != d2[0] || d1[1] != d2[1]) { + return 0; + } + switch (d1[0]) { + case OP_GETHOSTBYNAME: + return !strcmp((char*)d1+2,(char*)d2+2); + case OP_GETHOSTBYADDR: + return !memcmp(d1+2,d2+2, ((d1[1] == PROTO_IPV4) + ? UNIT_IPV4 : UNIT_IPV6) - 1); + default: + fatal("Trying to compare buffers not containing valid domain, " + "[%d,%d].", + (int) d1[0], (int) d1[1]); + return -1; /* Lint... */ + } +} + +static int get_domainname(AddrByte *inbuff, int insize, AddrByte *domainbuff) +{ + OpType op = get_op(inbuff); + ProtoType proto; + int i; + AddrByte *data; + + data = get_data(inbuff); + switch (op) { + case OP_GETHOSTBYNAME: + data = get_data(inbuff); + for (i = (data - inbuff); i < insize && inbuff[i] != '\0'; ++i) + ; + if (i < insize) { + domaincopy(domainbuff, get_op_addr(inbuff)); + return 0; + } + DEBUGF(3, ("Could not pick valid domainname in " + "gethostbyname operation")); + return -1; + case OP_GETHOSTBYADDR: + proto = get_proto(inbuff); + i = insize - (data - inbuff); + if ((proto == PROTO_IPV4 && i == UNIT_IPV4) || + (proto == PROTO_IPV6 && i == UNIT_IPV6)) { + /* An address buffer */ + domaincopy(domainbuff, get_op_addr(inbuff)); + return 0; + } + DEBUGF(3, ("Could not pick valid domainname in gethostbyaddr " + "operation")); + return -1; + default: + DEBUGF(2, ("Could not pick valid domainname because of " + "invalid opcode %d.", (int) op)); + return -1; + } +} + +/* + * Worker subprocesses with utilities + */ +#ifdef WIN32 +static int create_worker(Worker *pworker, int save_que) +{ + MesQ **thread_data = ALLOC(2*sizeof(MesQ *)); + DWORD tid; + + + if (!create_mesq(thread_data)) { + fatal("Could not create, pipes for subprocess, errno = %d", + GetLastError()); + } + if (!create_mesq(thread_data + 1)) { + fatal("Could not create, pipes for subprocess, errno = %d", + GetLastError()); + } + /* Save those before the thread starts */ + pworker->writeto = thread_data[0]; + pworker->readfrom = thread_data[1]; + + if (((HANDLE) _beginthreadex(NULL, 0, worker_loop, thread_data, 0, &tid)) + == NULL) { + fatal("Could not create thread errno = %d", + GetLastError()); + } + pworker->pid = tid; + pworker->state = WORKER_FREE; + pworker->serial = INVALID_SERIAL; + if (!save_que) { + pworker->que_first = pworker->que_last = NULL; + pworker->que_size = 0; + } + DEBUGF(3,("Created worker[%ld] with fd %d", + (long) pworker->pid, (int) pworker->readfrom)); + return 0; +} + +#else + +static int create_worker(Worker *pworker, int save_que) +{ + int p0[2], p1[2]; + pid_t child; + + if (pipe(p0)) { + warning("Could not create, pipes for subprocess, errno = %d", + errno); + return -1; + } + + if (pipe(p1)) { + warning("Could not create, pipes for subprocess, errno = %d", + errno); + close(p0[0]); + close(p0[1]); + return -1; + } + if ((child = fork()) < 0) { /* failure */ + warning("Could not fork(), errno = %d", + errno); + close(p0[0]); + close(p0[1]); + close(p1[0]); + close(p1[1]); + return -1; + } else if (child > 0) { /* parent */ + close(p0[1]); + close(p1[0]); + pworker->writeto = p1[1]; + pworker->readfrom = p0[0]; + pworker->pid = child; + pworker->state = WORKER_FREE; + pworker->serial = INVALID_SERIAL; + if (!save_que) { + pworker->que_first = pworker->que_last = NULL; + pworker->que_size = 0; + } + DEBUGF(3,("Created worker[%ld] with fd %d", + (long) pworker->pid, (int) pworker->readfrom)); + return 0; + } else { /* child */ + close(p1[1]); + close(p0[0]); + close_all_worker_fds(); + /* Make "fatal" not find any children */ + num_busy_workers = num_free_workers = num_stalled_workers = 0; + if((dup2(p1[0],0) < 0) || (dup2(p0[1],1) < 0)) { + fatal("Worker could not dup2(), errno = %d", + errno); + return -1; /* lint... */ + } + close(p1[0]); + close(p0[1]); + signal(SIGCHLD, SIG_IGN); + return worker_loop(); + } +} + +static void close_all_worker_fds(void) +{ + int w,i; + Worker *workers[3] = {free_workers, busy_workers, stalled_workers}; + int wsizes[3] = {num_free_workers, num_busy_workers, + num_stalled_workers}; + for (w = 0; w < 3; ++w) { + for (i = 0; i < wsizes[w]; ++i) { + if (workers[w][i].state != WORKER_EMPTY) { + close(workers[w][i].readfrom); + close(workers[w][i].writeto); + } + } + } +} + +#endif /* !WIN32 */ + +#ifdef WIN32 +DWORD WINAPI worker_loop(void *v) +#else +static int worker_loop(void) +#endif +{ + AddrByte *req = NULL; + size_t req_size = 0; + int this_size; + AddrByte *reply = NULL; + size_t reply_size = 0; + size_t data_size; + +#ifdef WIN32 + QueItem *m = NULL; + MesQ *readfrom = ((MesQ **) v)[0]; + MesQ *writeto = ((MesQ **) v)[1]; + /* XXX:PaN */ + FREE(v); +#endif + + for(;;) { +#ifdef HAVE_GETADDRINFO + struct addrinfo *ai = NULL; +#endif + struct hostent *he = NULL; +#ifdef HAVE_GETNAMEINFO + struct sockaddr *sa = NULL; + char name[NI_MAXHOST]; +#endif +#if defined(HAVE_GETIPNODEBYNAME) || defined(HAVE_GETIPNODEBYADDR) + int free_he = 0; +#endif + int error_num = 0; + SerialType serial; + OpType op; + ProtoType proto; + AddrByte *data; + +#ifdef WIN32 + WaitForSingleObject(event_mesq(readfrom),INFINITE); + DEBUGF(4,("Worker got data on message que.")); + + if(!deque_mesq(readfrom,&m)) { + goto fail; + } + this_size = m->req_size; + req = m->request; +#else + if (READ_PACKET_BYTES(0,&this_size) != PACKET_BYTES) { + DEBUGF(2,("Worker got error/EOF while reading size, exiting.")); + exit(0); + } + if (this_size > req_size) { + if (req == NULL) { + req = ALLOC((req_size = this_size)); + } else { + req = REALLOC(req, (req_size = this_size)); + } + } + if (read_exact(0, req, (size_t) this_size) != this_size) { + DEBUGF(1,("Worker got EOF while reading data, exiting.")); + exit(0); + } +#endif + /* Decode the request... */ + serial = get_serial(req); + if (OP_CONTROL == (op = get_op(req))) { + CtlType ctl; + if (serial != INVALID_SERIAL) { + DEBUGF(1, ("Worker got invalid serial: %d.", serial)); + exit(0); + } + switch (ctl = get_ctl(req)) { + case SETOPT_DEBUG_LEVEL: + debug_level = get_debug_level(req); + DEBUGF(debug_level, + ("Worker debug_level = %d.", debug_level)); + break; + } + continue; + } + proto = get_proto(req); + data = get_data(req); + DEBUGF(4,("Worker got request, op = %d, proto = %d, data = %s.", + op,proto,data)); + /* Got a request, lets go... */ + switch (op) { + case OP_GETHOSTBYNAME: + switch (proto) { + +#ifdef HAVE_IN6 + case PROTO_IPV6: { /* switch (proto) { */ +#ifdef HAVE_GETADDRINFO + struct addrinfo hints; + + memset(&hints, 0, sizeof(hints)); + hints.ai_flags = (AI_CANONNAME|AI_V4MAPPED|AI_ADDRCONFIG); + hints.ai_socktype = SOCK_STREAM; + hints.ai_family = AF_INET6; + DEBUGF(5, ("Starting getaddrinfo(%s, ...)", data)); + error_num = getaddrinfo((char *)data, NULL, &hints, &ai); + DEBUGF(5,("getaddrinfo returned %d", error_num)); + if (error_num) { + error_num = map_netdb_error_ai(error_num); + } +#elif defined(HAVE_GETIPNODEBYNAME) /*#ifdef HAVE_GETADDRINFO */ + DEBUGF(5,("Starting getipnodebyname(%s)",data)); + he = getipnodebyname(data, AF_INET6, AI_DEFAULT, &error_num); + if (he) { + free_he = 1; + error_num = 0; + DEBUGF(5,("getipnodebyname(,AF_INET6,,) OK")); + } else { + DEBUGF(5,("getipnodebyname(,AF_INET6,,) error %d", error_num)); + error_num = map_netdb_error(error_num); + } +#elif defined(HAVE_GETHOSTBYNAME2) /*#ifdef HAVE_GETADDRINFO */ + DEBUGF(5,("Starting gethostbyname2(%s, AF_INET6)",data)); + he = gethostbyname2((char*)data, AF_INET6); + if (he) { + error_num = 0; + DEBUGF(5,("gethostbyname2(, AF_INET6) OK")); + } else { + error_num = map_netdb_error(h_errno); + DEBUGF(5,("gethostbyname2(, AF_INET6) error %d", h_errno)); + } +#else + error_num = ERRCODE_NOTSUP; +#endif /*#ifdef HAVE_GETADDRINFO */ + } break; +#endif /*ifdef HAVE_IN6 */ + + case PROTO_IPV4: { /* switch (proto) { */ + DEBUGF(5,("Starting gethostbyname(%s)",data)); + he = gethostbyname((char*)data); + if (he) { + error_num = 0; + DEBUGF(5,("gethostbyname OK")); + } else { + error_num = map_netdb_error(h_errno); + DEBUGF(5,("gethostbyname error %d", h_errno)); + } + } break; + + default: /* switch (proto) { */ + /* Not supported... */ + error_num = ERRCODE_NOTSUP; + break; + } /* switch (proto) { */ + + if (he) { + data_size = build_reply(serial, he, &reply, &reply_size); +#ifdef HAVE_GETIPNODEBYNAME + if (free_he) { + freehostent(he); + } +#endif +#ifdef HAVE_GETADDRINFO + } else if (ai) { + data_size = build_reply_ai(serial, 16, ai, + &reply, &reply_size); + freeaddrinfo(ai); +#endif + } else { + data_size = build_error_reply(serial, error_num, + &reply, &reply_size); + } + break; /* case OP_GETHOSTBYNAME: */ + + case OP_GETHOSTBYADDR: /* switch (op) { */ + switch (proto) { +#ifdef HAVE_IN6 + case PROTO_IPV6: { +#ifdef HAVE_GETNAMEINFO + struct sockaddr_in6 *sin; + socklen_t salen = sizeof(*sin); + + sin = ALLOC(salen); +#ifndef NO_SA_LEN + sin->sin6_len = salen; +#endif + sin->sin6_family = AF_INET6; + sin->sin6_port = 0; + memcpy(&sin->sin6_addr, data, 16); + sa = (struct sockaddr *)sin; + DEBUGF(5,("Starting getnameinfo(,,%s,16,,,)", + format_address(16, data))); + error_num = getnameinfo(sa, salen, name, sizeof(name), + NULL, 0, NI_NAMEREQD); + DEBUGF(5,("getnameinfo returned %d", error_num)); + if (error_num) { + error_num = map_netdb_error_ai(error_num); + sa = NULL; + } +#elif defined(HAVE_GETIPNODEBYADDR) /*#ifdef HAVE_GETNAMEINFO*/ + struct in6_addr ia; + memcpy(ia.s6_addr, data, 16); + DEBUGF(5,("Starting getipnodebyaddr(%s,16,AF_INET6,)", + format_address(16, data))); + he = getipnodebyaddr(&ia, 16, AF_INET6, &error_num); + free_he = 1; + if (! he) { + DEBUGF(5,("getipnodebyaddr error %d", error_num)); + error_num = map_netdb_error(error_num); + } else { + DEBUGF(5,("getipnodebyaddr OK")); + } +#else /*#ifdef HAVE_GETNAMEINFO*/ + struct in6_addr ia; + memcpy(ia.s6_addr, data, 16); + DEBUGF(5,("Starting gethostbyaddr(%s,16,AF_INET6)", + format_address(16, data))); + he = gethostbyaddr((const char *) &ia, 16, AF_INET6); + if (! he) { + error_num = map_netdb_error(h_errno); + DEBUGF(5,("gethostbyaddr error %d", h_errno)); + } else { + DEBUGF(5,("gethostbyaddr OK")); + } +#endif /* #ifdef HAVE_GETNAMEINFO */ + } break; /* case PROTO_IPV6: { */ +#endif /* #ifdef HAVE_IN6 */ + + case PROTO_IPV4: { /* switch(proto) { */ + struct in_addr ia; + memcpy(&ia.s_addr, data, 4); /* Alignment required... */ + DEBUGF(5,("Starting gethostbyaddr(%s,4,AF_INET)", + format_address(4, data))); + he = gethostbyaddr((const char *) &ia, 4, AF_INET); + if (! he) { + error_num = map_netdb_error(h_errno); + DEBUGF(5,("gethostbyaddr error %d", h_errno)); + } else { + DEBUGF(5,("gethostbyaddr OK")); + } + } break; + + default: + error_num = ERRCODE_NOTSUP; + } /* switch(proto) { */ + + if (he) { + data_size = build_reply(serial, he, &reply, &reply_size); +#ifdef HAVE_GETIPNODEBYADDR + if (free_he) { + freehostent(he); + } +#endif +#ifdef HAVE_GETNAMEINFO + } else if (sa) { + struct addrinfo res; + memset(&res, 0, sizeof(res)); + res.ai_canonname = name; + res.ai_addr = sa; + res.ai_next = NULL; + data_size = build_reply_ai(serial, 16, &res, + &reply, &reply_size); + free(sa); +#endif + } else { + data_size = build_error_reply(serial, error_num, + &reply, &reply_size); + } + break; /* case OP_GETHOSTBYADR: */ + + default: + data_size = build_error_reply(serial, ERRCODE_NOTSUP, + &reply, &reply_size); + break; + } /* switch (op) { */ + +#ifdef WIN32 + m = REALLOC(m, sizeof(QueItem) - 1 + data_size - PACKET_BYTES); + m->next = NULL; + m->req_size = data_size - PACKET_BYTES; + memcpy(m->request,reply + PACKET_BYTES,data_size - PACKET_BYTES); + if (!enque_mesq(writeto,m)) { + goto fail; + } + m = NULL; +#else + write(1, reply, data_size); /* No signals expected */ +#endif + } /* for (;;) */ + +#ifdef WIN32 + fail: + if (m != NULL) { + FREE(m); + } + close_mesq(readfrom); + close_mesq(writeto); + if (reply) { + FREE(reply); + } + return 1; +#endif +} + +static int map_netdb_error(int netdb_code) +{ + switch (netdb_code) { +#ifdef HOST_NOT_FOUND + case HOST_NOT_FOUND: + return ERRCODE_HOST_NOT_FOUND; +#endif +#ifdef TRY_AGAIN + case TRY_AGAIN: + return ERRCODE_TRY_AGAIN; +#endif +#ifdef NO_RECOVERY + case NO_RECOVERY: + return ERRCODE_NO_RECOVERY; +#endif +#if defined(NO_DATA) || defined(NO_ADDRESS) +#ifdef NO_DATA + case NO_DATA: +#endif +#ifdef NO_ADDRESS +#if !defined(NO_DATA) || (NO_DATA != NO_ADDRESS) + case NO_ADDRESS: +#endif +#endif + return ERRCODE_NO_DATA; +#endif + default: + return ERRCODE_NETDB_INTERNAL; + } +} + +#if defined(HAVE_GETADDRINFO) || defined(HAVE_GETNAMEINFO) +static int map_netdb_error_ai(int netdb_code) +{ + switch(netdb_code) { +#ifdef EAI_ADDRFAMILY + case EAI_ADDRFAMILY: + return ERRCODE_NETDB_INTERNAL; +#endif + case EAI_AGAIN: + return ERRCODE_TRY_AGAIN; + case EAI_BADFLAGS: + return ERRCODE_NETDB_INTERNAL; + case EAI_FAIL: + return ERRCODE_HOST_NOT_FOUND; + case EAI_FAMILY: + return ERRCODE_NETDB_INTERNAL; + case EAI_MEMORY: + return ERRCODE_NETDB_INTERNAL; +#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME + case EAI_NODATA: + return ERRCODE_HOST_NOT_FOUND; +#endif + case EAI_NONAME: + return ERRCODE_HOST_NOT_FOUND; + case EAI_SERVICE: + return ERRCODE_NETDB_INTERNAL; + case EAI_SOCKTYPE: + return ERRCODE_NETDB_INTERNAL; + default: + return ERRCODE_NETDB_INTERNAL; + } +} +#endif /* #if defined(HAVE_GETADDRINFO) || defined(HAVE_GETNAMEINFO) */ + + +static char *errcode_to_string(int errcode) +{ + switch (errcode) { + case ERRCODE_NOTSUP: + return "enotsup"; + case ERRCODE_HOST_NOT_FOUND: + /* + * I would preffer + * return "host_not_found"; + * but have to keep compatibility with the old + * inet_gethost's error codes... + */ + return "notfound"; + case ERRCODE_TRY_AGAIN: + return "try_again"; + case ERRCODE_NO_RECOVERY: + return "no_recovery"; + case ERRCODE_NO_DATA: + return "no_data"; + default: + /*case ERRCODE_NETDB_INTERNAL:*/ + return "netdb_internal"; + } +} + +static size_t build_error_reply(SerialType serial, int errnum, + AddrByte **preply, + size_t *preply_size) +{ + char *errstring = errcode_to_string(errnum); + int string_need = strlen(errstring) + 1; /* a '\0' too */ + unsigned need; + AddrByte *ptr; + + need = PACKET_BYTES + 4 /* Serial */ + 1 /* Unit */ + string_need; + if (*preply_size < need) { + if (*preply_size == 0) { + *preply = ALLOC((*preply_size = need)); + } else { + *preply = REALLOC(*preply, + (*preply_size = need)); + } + } + ptr = *preply; + PUT_PACKET_BYTES(ptr,need - PACKET_BYTES); + ptr += PACKET_BYTES; + put_int32(ptr,serial); + ptr +=4; + *ptr++ = (AddrByte) 0; /* 4 or 16 */ + strcpy((char*)ptr, errstring); + return need; +} + + + +static size_t build_reply(SerialType serial, struct hostent *he, + AddrByte **preply, size_t *preply_size) +{ + unsigned need; + int strings_need; + int num_strings; + int num_addresses; + int i; + AddrByte *ptr; + int unit = he->h_length; + + for (num_addresses = 0; he->h_addr_list[num_addresses] != NULL; + ++num_addresses) + ; + strings_need = strlen(he->h_name) + 1; /* 1 for null byte */ + num_strings = 1; + if (he->h_aliases) { + for(i=0; he->h_aliases[i] != NULL; ++i) { + strings_need += strlen(he->h_aliases[i]) + 1; + ++num_strings; + } + } + + need = PACKET_BYTES + + 4 /* Serial */ + 1 /* Unit */ + 4 /* Naddr */ + + (unit * num_addresses) /* Address bytes */ + + 4 /* Nnames */ + strings_need /* The name and alias strings */; + + if (*preply_size < need) { + if (*preply_size == 0) { + *preply = ALLOC((*preply_size = need)); + } else { + *preply = REALLOC(*preply, + (*preply_size = need)); + } + } + ptr = *preply; + PUT_PACKET_BYTES(ptr,need - PACKET_BYTES); + ptr += PACKET_BYTES; + put_int32(ptr,serial); + ptr +=4; + *ptr++ = (AddrByte) unit; /* 4 or 16 */ + put_int32(ptr, num_addresses); + ptr += 4; + for (i = 0; i < num_addresses; ++i) { + memcpy(ptr, he->h_addr_list[i], unit); + ptr += unit; + } + put_int32(ptr, num_strings); + ptr += 4; + strcpy((char*)ptr, he->h_name); + ptr += 1 + strlen(he->h_name); + for (i = 0; i < (num_strings - 1); ++i) { + strcpy((char*)ptr, he->h_aliases[i]); + ptr += 1 + strlen(he->h_aliases[i]); + } + return need; +} + +#if defined(HAVE_GETADDRINFO) || defined(HAVE_GETNAMEINFO) +static size_t build_reply_ai(SerialType serial, int addrlen, + struct addrinfo *res0, + AddrByte **preply, size_t *preply_size) +{ + struct addrinfo *res; + int num_strings; + int num_addresses; + AddrByte *ptr; + int need; + + num_addresses = 0; + num_strings = 0; + need = PACKET_BYTES + + 4 /* Serial */ + 1 /* addrlen */ + + 4 /* Naddr */ + 4 /* Nnames */; + + for (res = res0; res != NULL; res = res->ai_next) { + if (res->ai_addr) { + num_addresses++; + need += addrlen; + } + if (res->ai_canonname) { + num_strings++; + need += strlen(res->ai_canonname) + 1; + } + } + + if (*preply_size < need) { + if (*preply_size == 0) { + *preply = ALLOC((*preply_size = need)); + } else { + *preply = REALLOC(*preply, + (*preply_size = need)); + } + } + + ptr = *preply; + PUT_PACKET_BYTES(ptr,need - PACKET_BYTES); + ptr += PACKET_BYTES; + put_int32(ptr,serial); + ptr +=4; + *ptr++ = (AddrByte) addrlen; /* 4 or 16 */ + put_int32(ptr, num_addresses); + ptr += 4; + for (res = res0; res != NULL && num_addresses; res = res->ai_next) { + if (res->ai_addr == NULL) + continue; + if (addrlen == 4) + memcpy(ptr, &((struct sockaddr_in *)res->ai_addr)->sin_addr, addrlen); +#ifdef AF_INET6 + else if (addrlen == 16) + memcpy(ptr, &((struct sockaddr_in6 *)res->ai_addr)->sin6_addr, addrlen); +#endif + else + memcpy(ptr, res->ai_addr->sa_data, addrlen); + ptr += addrlen; + num_addresses--; + } + put_int32(ptr, num_strings); + ptr += 4; + for (res = res0; res != NULL && num_strings; res = res->ai_next) { + if (res->ai_canonname == NULL) + continue; + strcpy((char *)ptr, res->ai_canonname); + ptr += strlen(res->ai_canonname) + 1; + num_strings--; + } + return need; +} + +#endif /* #if defined(HAVE_GETADDRINFO) || defined(HAVE_GETNAMEINFO) */ + + + +/* + * Encode/decode/read/write + */ + +static int get_int32(AddrByte *b) +{ + int res; + res = (unsigned) b[3]; + res |= ((unsigned) b[2]) << 8; + res |= ((unsigned) b[1]) << 16; + res |= ((unsigned) b[0]) << 24; + return res; +} + +static void put_int32(AddrByte *buff, int value) +{ + buff[0] = (((unsigned) value) >> 24) & 0xFF; + buff[1] = (((unsigned) value) >> 16) & 0xFF; + buff[2] = (((unsigned) value) >> 8) & 0xFF; + buff[3] = ((unsigned) value) & 0xFF; +} +#ifdef WIN32 + +static int read_int32(HANDLE fd, int *res, HANDLE ev) +{ + AddrByte b[4]; + int r; + if ((r = read_exact(fd,b,4,ev)) < 0) { + return -1; + } else if (r == 0) { + return 0; + } else { + *res = (unsigned) b[3]; + *res |= ((unsigned) b[2]) << 8; + *res |= ((unsigned) b[1]) << 16; + *res |= ((unsigned) b[0]) << 24; + } + return 4; +} +/* + * The standard input is expected to be opened with FILE_FLAG_OVERLAPPED + * but this code should handle both cases (although winsock might not). + */ +static int read_exact(HANDLE fd, void *vbuff, DWORD nbytes, HANDLE ev) +{ + DWORD ret,got; + BOOL stat; + char *buff = vbuff; + OVERLAPPED ov; + DWORD err; + + + got = 0; + for(;;) { + memset(&ov,0,sizeof(ov)); + ov.hEvent = ev; + ResetEvent(ov.hEvent); + stat = ReadFile(fd, buff, nbytes - got, &ret, &ov); + if (!stat) { + if ((err = GetLastError()) == ERROR_IO_PENDING) { + DEBUGF(4,("Overlapped read, waiting for completion...")); + WaitForSingleObject(ov.hEvent,INFINITE); + stat = GetOverlappedResult(fd,&ov,&ret,TRUE); + DEBUGF(4,("Overlapped read, completed with status %d," + " result %d",stat,ret)); + } + if (!stat) { + if (GetLastError() == ERROR_BROKEN_PIPE) { + DEBUGF(1, ("End of file while reading from pipe.")); + return 0; + } else { + DEBUGF(1, ("Error while reading from pipe," + " errno = %d", + GetLastError())); + return -1; + } + } + } else { + DEBUGF(4,("Read completed syncronously, result %d",ret)); + } + if (ret == 0) { + DEBUGF(1, ("End of file detected as zero read from pipe.")); + return 0; + } + if (ret < nbytes - got) { + DEBUGF(4,("Not all data read from pipe, still %d bytes to read.", + nbytes - (got + ret))); + got += ret; + buff += ret; + } else { + return nbytes; + } + } +} +/* + * Now, we actually expect a HANDLE opened with FILE_FLAG_OVERLAPPED, + * but this code should handle both cases (although winsock + * does not always..) + */ +static int write_exact(HANDLE fd, AddrByte *buff, DWORD len, HANDLE ev) +{ + DWORD res,stat; + DWORD x = len; + OVERLAPPED ov; + DWORD err; + + + for(;;) { + memset(&ov,0,sizeof(ov)); + ov.hEvent = ev; + ResetEvent(ov.hEvent); + stat = WriteFile(fd,buff,x,&res,&ov); + if (!stat) { + if ((err = GetLastError()) == ERROR_IO_PENDING) { + DEBUGF(4,("Overlapped write, waiting for competion...")); + WaitForSingleObject(ov.hEvent,INFINITE); + stat = GetOverlappedResult(fd,&ov,&res,TRUE); + DEBUGF(4,("Overlapped write, completed with status %d," + " result %d",stat,res)); + } + if (!stat) { + if (GetLastError() == ERROR_BROKEN_PIPE) { + return 0; + } else { + return -1; + } + } + } else { + DEBUGF(4,("Write completed syncronously, result %d",res)); + } + + if (res < x) { + /* Microsoft states this can happen as HANDLE is a pipe... */ + DEBUGF(4,("Not all data written to pipe, still %d bytes to write.", + x - res)); + x -= res; + buff += res; + } else { + return len; + } + } +} + +DWORD WINAPI reader(void *data) { + MesQ *mq = (MesQ *) data; + QueItem *m; + int siz; + int r; + HANDLE inp; + int x = 0; + HANDLE ev = CreateEvent(NULL, TRUE, FALSE, NULL); + + inp = GetStdHandle(STD_INPUT_HANDLE); + for (;;) { + if ((r = READ_PACKET_BYTES(inp,&siz,ev)) != 4) { + DEBUGF(1,("Erlang has closed (reading)")); + exit(0); + } + DEBUGF(4,("Read packet of size %d from erlang",siz)); + m = ALLOC(sizeof(QueItem) - 1 + siz); + if (read_exact(inp, m->request, siz,ev) != siz) { + fatal("Unexpected end of file on main input, errno = %d",errno); + } + if (siz < 5) { + fatal("Unexpected message on main input, message size %d less " + "than minimum."); + } + m->req_size = siz; + m->next = NULL; + if (!enque_mesq(mq, m)) { + fatal("Reader could not talk to main thread!"); + } + } +} + +DWORD WINAPI writer(void *data) +{ + MesQ *mq = (MesQ *) data; + QueItem *m; + HANDLE outp = GetStdHandle(STD_OUTPUT_HANDLE); + AddrByte hdr[PACKET_BYTES]; + HANDLE ev = CreateEvent(NULL, TRUE, FALSE, NULL); + + + for (;;) { + WaitForSingleObject(event_mesq(mq),INFINITE); + if (!deque_mesq(mq, &m)) { + fatal("Writer could not talk to main thread!"); + } + PUT_PACKET_BYTES(hdr, m->req_size); + if (write_exact(outp, hdr, 4, ev) != 4) { + DEBUGF(1,("Erlang has closed (writing)")); + exit(0); + } + if (write_exact(outp, m->request, m->req_size, ev) != m->req_size) { + DEBUGF(1,("Erlang has closed (writing)")); + exit(0); + } + FREE(m); + } +} + + +#else + +static size_t read_int32(int fd, int *res) +{ + AddrByte b[4]; + int r; + if ((r = read_exact(fd,b,4)) < 0) { + return -1; + } else if (r == 0) { + return 0; + } else { + *res = (unsigned) b[3]; + *res |= ((unsigned) b[2]) << 8; + *res |= ((unsigned) b[1]) << 16; + *res |= ((unsigned) b[0]) << 24; + } + return 4; +} + +static ssize_t read_exact(int fd, void *vbuff, size_t nbytes) +{ + ssize_t ret, got; + char *buff = vbuff; + + got = 0; + for(;;) { + ret = read(fd, buff, nbytes - got); + if (ret < 0) { + if (errno == EINTR) { + continue; + } else { + DEBUGF(1, ("Error while reading from pipe," + " errno = %d", + errno)); + return -1; + } + } else if (ret == 0) { + DEBUGF(1, ("End of file while reading from pipe.")); + if (got == 0) { + return 0; /* "Normal" EOF */ + } else { + return -1; + } + } else if (ret < nbytes - got) { + got += ret; + buff += ret; + } else { + return nbytes; + } + } +} + +static int write_exact(int fd, AddrByte *buff, int len) +{ + int res; + int x = len; + for(;;) { + if((res = write(fd, buff, x)) == x) { + break; + } + if (res < 0) { + if (errno == EINTR) { + continue; + } else if (errno == EPIPE) { + return 0; + } +#ifdef ENXIO + else if (errno == ENXIO) { + return 0; + } +#endif + else { + return -1; + } + } else { + /* Hmmm, blocking write but not all written, could this happen + if the other end was closed during the operation? Well, + it costs very little to handle anyway... */ + x -= res; + buff += res; + } + } + return len; +} + +#endif /* !WIN32 */ + +/* + * Debug and memory allocation + */ + +static char *format_address(int siz, AddrByte *addr) +{ + static char buff[50]; + char tmp[10]; + if (siz > 16) { + return "(unknown)"; + } + *buff='\0'; + if (siz <= 4) { + while(siz--) { + sprintf(tmp,"%d",(int) *addr++); + strcat(buff,tmp); + if(siz) { + strcat(buff,"."); + } + } + return buff; + } + while(siz--) { + sprintf(tmp,"%02x",(int) *addr++); + strcat(buff,tmp); + if(siz) { + strcat(buff,":"); + } + } + return buff; +} + +static void debugf(char *format, ...) +{ + char buff[2048]; + char *ptr; + va_list ap; + + va_start(ap,format); +#ifdef WIN32 + sprintf(buff,"%s[%d] (DEBUG):",program_name,(int) GetCurrentThreadId()); +#else + sprintf(buff,"%s[%d] (DEBUG):",program_name,(int) getpid()); +#endif + ptr = buff + strlen(buff); + vsprintf(ptr,format,ap); + strcat(ptr,"\r\n"); +#ifdef WIN32 + if (debug_console_allocated != INVALID_HANDLE_VALUE) { + DWORD res; + WriteFile(debug_console_allocated,buff,strlen(buff),&res,NULL); + } +#else + write(2,buff,strlen(buff)); +#endif + va_end(ap); +} + +static void warning(char *format, ...) +{ + char buff[2048]; + char *ptr; + va_list ap; + + va_start(ap,format); + sprintf(buff,"%s[%d]: WARNING:",program_name, (int) getpid()); + ptr = buff + strlen(buff); + vsprintf(ptr,format,ap); + strcat(ptr,"\r\n"); +#ifdef WIN32 + { + DWORD res; + WriteFile(GetStdHandle(STD_ERROR_HANDLE),buff,strlen(buff),&res,NULL); + } +#else + write(2,buff,strlen(buff)); +#endif + va_end(ap); +} + +static void fatal(char *format, ...) +{ + char buff[2048]; + char *ptr; + va_list ap; + + va_start(ap,format); + sprintf(buff,"%s[%d]: FATAL ERROR:",program_name, (int) getpid()); + ptr = buff + strlen(buff); + vsprintf(ptr,format,ap); + strcat(ptr,"\r\n"); +#ifdef WIN32 + { + DWORD res; + WriteFile(GetStdHandle(STD_ERROR_HANDLE),buff,strlen(buff),&res,NULL); + } +#else + write(2,buff,strlen(buff)); +#endif + va_end(ap); +#ifndef WIN32 + kill_all_workers(); +#endif + exit(1); +} + +static void *my_malloc(size_t size) +{ + void *ptr = malloc(size); + if (!ptr) { + fatal("Cannot allocate %u bytes of memory.", (unsigned) size); + return NULL; /* lint... */ + } + return ptr; +} + +static void *my_realloc(void *old, size_t size) +{ + void *ptr = realloc(old, size); + if (!ptr) { + fatal("Cannot reallocate %u bytes of memory from %p.", + (unsigned) size, old); + return NULL; /* lint... */ + } + return ptr; +} + +#ifdef WIN32 + +BOOL create_mesq(MesQ **q) +{ + MesQ *tmp = malloc(sizeof(MesQ)); + tmp->data_present = CreateEvent(NULL, TRUE, FALSE,NULL); + if (tmp->data_present == NULL) { + free(tmp); + return FALSE; + } + InitializeCriticalSection(&(tmp->crit)); /* Cannot fail */ + tmp->shutdown = 0; + tmp->first = NULL; + tmp->last = NULL; + *q = tmp; + return TRUE; +} + +BOOL enque_mesq(MesQ *q, QueItem *m) +{ + EnterCriticalSection(&(q->crit)); + if (q->shutdown) { + LeaveCriticalSection(&(q->crit)); + return FALSE; + } + if (q->last == NULL) { + q->first = q->last = m; + } else { + q->last->next = m; + q->last = m; + } + m->next = NULL; + if (!SetEvent(q->data_present)) { + fprintf(stderr,"Fatal: Unable to signal event in %s:%d, last error: %d\n", + __FILE__,__LINE__,GetLastError()); + exit(1); /* Unable to continue at all */ + } + LeaveCriticalSection(&(q->crit)); + return TRUE; +} + +BOOL deque_mesq(MesQ *q, QueItem **m) +{ + EnterCriticalSection(&(q->crit)); + if (q->first == NULL) { /* Usually shutdown from other end */ + ResetEvent(q->data_present); + LeaveCriticalSection(&(q->crit)); + return FALSE; + } + *m = q->first; + q->first = q->first->next; + if (q->first == NULL) { + q->last = NULL; + ResetEvent(q->data_present); + } + (*m)->next = NULL; + LeaveCriticalSection(&(q->crit)); + return TRUE; +} + +BOOL close_mesq(MesQ *q) +{ + QueItem *tmp; + EnterCriticalSection(&(q->crit)); + if (!q->shutdown) { + q->shutdown = TRUE; + if (!SetEvent(q->data_present)) { + fprintf(stderr, + "Fatal: Unable to signal event in %s:%d, last error: %d\n", + __FILE__,__LINE__,GetLastError()); + exit(1); /* Unable to continue at all */ + } + LeaveCriticalSection(&(q->crit)); + return FALSE; + } + /* Noone else is supposed to use this object any more */ + LeaveCriticalSection(&(q->crit)); + DeleteCriticalSection(&(q->crit)); + CloseHandle(q->data_present); + tmp = q->first; + while(tmp) { + q->first = q->first->next; + free(tmp); + tmp = q->first; + } + free(q); + return TRUE; +} + +HANDLE event_mesq(MesQ *q) +{ + return q->data_present; +} + +#ifdef HARDDEBUG +DWORD WINAPI pseudo_worker_loop(void *v) +{ + HOSTENT *hep; + + DEBUGF(1,("gethostbyname(\"ftp.funet.fi\") starting")); + hep = gethostbyname("ftp.funet.fi"); + + DEBUGF(1,("gethostbyname(\"ftp.funet.fi\") -> %d OK",(int) hep)); + return 0; +} + +static void poll_gethost(int row) { + HANDLE h; + DWORD tid; + h = (HANDLE) _beginthreadex(NULL, 0, pseudo_worker_loop, NULL, 0, &tid); + if (h == NULL) { + DEBUGF(1,("Failed to spawn pseudo worker (%d)...",row)); + } else { + DEBUGF(1,("Waiting for pseudo worker (%d)", row)); + WaitForSingleObject(h,INFINITE); + DEBUGF(1,("Done Waiting for pseudo worker (%d)", row)); + } +} +#endif + +#endif /* WIN32 */ diff --git a/erts/etc/common/typer.c b/erts/etc/common/typer.c new file mode 100644 index 0000000000..c2567cb8b4 --- /dev/null +++ b/erts/etc/common/typer.c @@ -0,0 +1,416 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: Typer front-end. + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#ifdef __WIN32__ +#include +#endif + +#include + +#define NO 0 +#define YES 1 + +#define ASIZE(a) (sizeof(a)/sizeof(a[0])) + +static int debug = 0; /* Bit flags for debug printouts. */ + +static char** eargv_base; /* Base of vector. */ +static char** eargv; /* First argument for erl. */ + +static int eargc; /* Number of arguments in eargv. */ + +#ifdef __WIN32__ +# define QUOTE(s) possibly_quote(s) +# define IS_DIRSEP(c) ((c) == '/' || (c) == '\\') +# define ERL_NAME "erl.exe" +#else +# define QUOTE(s) s +# define IS_DIRSEP(c) ((c) == '/') +# define ERL_NAME "erl" +#endif + +#define UNSHIFT(s) eargc++, eargv--; eargv[0] = QUOTE(s) +#define PUSH(s) eargv[eargc++] = QUOTE(s) +#define PUSH2(s, t) PUSH(s); PUSH(t) +#define PUSH3(s, t, u) PUSH2(s, t); PUSH(u) + +/* + * Local functions. + */ + +static void error(char* format, ...); +static char* emalloc(size_t size); +static char* strsave(char* string); +static void push_words(char* src); +static int run_erlang(char* name, char** argv); +static char* get_default_emulator(char* progname); +#ifdef __WIN32__ +static char* possibly_quote(char* arg); +#endif + +/* + * Supply a strerror() function if libc doesn't. + */ +#ifndef HAVE_STRERROR + +extern int sys_nerr; + +#ifndef SYS_ERRLIST_DECLARED +extern const char * const sys_errlist[]; +#endif /* !SYS_ERRLIST_DECLARED */ + +char *strerror(int errnum) +{ + static char *emsg[1024]; + + if (errnum != 0) { + if (errnum > 0 && errnum < sys_nerr) + sprintf((char *) &emsg[0], "(%s)", sys_errlist[errnum]); + else + sprintf((char *) &emsg[0], "errnum = %d ", errnum); + } + else { + emsg[0] = '\0'; + } + return (char *) &emsg[0]; +} +#endif /* !HAVE_STRERROR */ + +int +main(int argc, char** argv) +{ + int eargv_size; + int eargc_base; /* How many arguments in the base of eargv. */ + char* emulator; + int need_shell = 0; + + emulator = get_default_emulator(argv[0]); + + /* + * Allocate the argv vector to be used for arguments to Erlang. + * Arrange for starting to pushing information in the middle of + * the array, to allow easy addition of commands in the beginning. + */ + + eargv_size = argc*4+100; + eargv_base = (char **) emalloc(eargv_size*sizeof(char*)); + eargv = eargv_base; + eargc = 0; + push_words(emulator); + eargc_base = eargc; + eargv = eargv + eargv_size/2; + eargc = 0; + + /* + * Push initial arguments. + */ + + if (argc > 1 && strcmp(argv[1], "-smp") == 0) { + PUSH("-smpauto"); + argc--, argv++; + } + + PUSH("+B"); + PUSH2("-boot", "start_clean"); + PUSH3("-run", "typer", "start"); + PUSH("-extra"); + + /* + * Push everything except --shell. + */ + + while (argc > 1) { + if (strcmp(argv[1], "--shell") == 0) { + need_shell = 1; + } else { + PUSH(argv[1]); + } + argc--, argv++; + } + + if (!need_shell) { + UNSHIFT("-noinput"); + } + + /* + * Move up the commands for invoking the emulator and adjust eargv + * accordingly. + */ + + while (--eargc_base >= 0) { + UNSHIFT(eargv_base[eargc_base]); + } + + /* + * Invoke Erlang with the collected options. + */ + + PUSH(NULL); + return run_erlang(eargv[0], eargv); +} + +static void +push_words(char* src) +{ + char sbuf[1024]; + char* dst; + + dst = sbuf; + while ((*dst++ = *src++) != '\0') { + if (isspace((int)*src)) { + *dst = '\0'; + PUSH(strsave(sbuf)); + dst = sbuf; + do { + src++; + } while (isspace((int)*src)); + } + } + if (sbuf[0]) + PUSH(strsave(sbuf)); +} +#ifdef __WIN32__ +char *make_commandline(char **argv) +{ + static char *buff = NULL; + static int siz = 0; + int num = 0; + char **arg, *p; + + if (*argv == NULL) { + return ""; + } + for (arg = argv; *arg != NULL; ++arg) { + num += strlen(*arg)+1; + } + if (!siz) { + siz = num; + buff = malloc(siz*sizeof(char)); + } else if (siz < num) { + siz = num; + buff = realloc(buff,siz*sizeof(char)); + } + p = buff; + for (arg = argv; *arg != NULL; ++arg) { + strcpy(p,*arg); + p+=strlen(*arg); + *p++=' '; + } + *(--p) = '\0'; + + if (debug) { + printf("Processed commandline:%s\n",buff); + } + return buff; +} + +int my_spawnvp(char **argv) +{ + STARTUPINFO siStartInfo; + PROCESS_INFORMATION piProcInfo; + DWORD ec; + + memset(&siStartInfo,0,sizeof(STARTUPINFO)); + siStartInfo.cb = sizeof(STARTUPINFO); + siStartInfo.dwFlags = STARTF_USESTDHANDLES; + siStartInfo.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + siStartInfo.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + siStartInfo.hStdError = GetStdHandle(STD_ERROR_HANDLE); + siStartInfo.wShowWindow = SW_HIDE; + siStartInfo.dwFlags |= STARTF_USESHOWWINDOW; + + + if (!CreateProcess(NULL, + make_commandline(argv), + NULL, + NULL, + TRUE, + 0, + NULL, + NULL, + &siStartInfo, + &piProcInfo)) { + return -1; + } + CloseHandle(piProcInfo.hThread); + + WaitForSingleObject(piProcInfo.hProcess,INFINITE); + if (!GetExitCodeProcess(piProcInfo.hProcess,&ec)) { + return 0; + } + return (int) ec; +} +#endif /* __WIN32__ */ + + +static int +run_erlang(char* progname, char** argv) +{ +#ifdef __WIN32__ + int status; +#endif + + if (debug) { + int i = 0; + while (argv[i] != NULL) + printf(" %s", argv[i++]); + printf("\n"); + } + +#ifdef __WIN32__ + /* + * Alas, we must wait here for the program to finish. + * Otherwise, the shell from which we were executed will think + * we are finished and print a prompt and read keyboard input. + */ + + status = my_spawnvp(argv)/*_spawnvp(_P_WAIT,progname,argv)*/; + if (status == -1) { + fprintf(stderr, "typer: Error executing '%s': %d", progname, + GetLastError()); + } + return status; +#else + execvp(progname, argv); + error("Error %d executing \'%s\'.", errno, progname); + return 2; +#endif +} + +static void +error(char* format, ...) +{ + char sbuf[1024]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + fprintf(stderr, "typer: %s\n", sbuf); + exit(1); +} + +static char* +emalloc(size_t size) +{ + char *p = malloc(size); + if (p == NULL) + error("Insufficient memory"); + return p; +} + +static char* +strsave(char* string) +{ + char* p = emalloc(strlen(string)+1); + strcpy(p, string); + return p; +} + +static char* +get_default_emulator(char* progname) +{ + char sbuf[MAXPATHLEN]; + char* s; + + strcpy(sbuf, progname); + for (s = sbuf+strlen(sbuf); s >= sbuf; s--) { + if (IS_DIRSEP(*s)) { + strcpy(s+1, ERL_NAME); +#ifdef __WIN32__ + if (_access(sbuf, 0) != -1) { + return strsave(sbuf); + } +#else + if (access(sbuf, 1) != -1) { + return strsave(sbuf); + } +#endif + break; + } + } + return ERL_NAME; +} + +#ifdef __WIN32__ +static char* +possibly_quote(char* arg) +{ + int mustQuote = NO; + int n = 0; + char* s; + char* narg; + + if (arg == NULL) { + return arg; + } + + /* + * Scan the string to find out if it needs quoting and return + * the original argument if not. + */ + + for (s = arg; *s; s++, n++) { + switch(*s) { + case ' ': + mustQuote = YES; + continue; + case '"': + mustQuote = YES; + n++; + continue; + case '\\': + if(s[1] == '"') + n++; + continue; + default: + continue; + } + } + if (!mustQuote) { + return arg; + } + + /* + * Insert the quotes and put a backslash in front of every quote + * inside the string. + */ + + s = narg = emalloc(n+2+1); + for (*s++ = '"'; *arg; arg++, s++) { + if (*arg == '"' || (*arg == '\\' && arg[1] == '"')) { + *s++ = '\\'; + } + *s = *arg; + } + if (s[-1] == '\\') { + *s++ ='\\'; + } + *s++ = '"'; + *s = '\0'; + return narg; +} +#endif /* __WIN32__ */ diff --git a/erts/etc/unix/Install.src b/erts/etc/unix/Install.src new file mode 100644 index 0000000000..410a77d91c --- /dev/null +++ b/erts/etc/unix/Install.src @@ -0,0 +1,175 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Patch $ERL_ROOT/emulator/obj/Makefile.dist & make +# +# +start_option=query +unset cross +while [ $# -ne 0 ]; do + case $1 in + -minimal) start_option=minimal ;; + -sasl) start_option=sasl ;; + -cross) cross=yes ;; + *) ERL_ROOT=$1 ;; + esac + shift +done + +if [ -z "$cross" ] +then + TARGET_ERL_ROOT="$ERL_ROOT" +else + TARGET_ERL_ROOT="$ERL_ROOT" + ERL_ROOT=`pwd` +fi + +if [ -z "$ERL_ROOT" -o ! -d "$ERL_ROOT" ] +then + echo "Install: need ERL_ROOT directory as argument" + exit 1 +fi + +case ":$ERL_ROOT" in + :/*) + ;; + *) + echo "Install: need an absolute path to ERL_ROOT" + exit 1 + ;; +esac + +if [ ! -d "$ERL_ROOT/erts-%I_VSN%/bin" ] +then + echo "Install: The directory $ERL_ROOT/erts-%I_VSN%/bin does not exist" + echo " Bad location or erts module not un-tared" + exit 1 +fi + +if [ ! -d $ERL_ROOT/bin ] +then + mkdir $ERL_ROOT/bin +fi + +# +# Fetch target system. +# +SYS=`(uname -s) 2>/dev/null` || SYS=unknown +REL=`(uname -r) 2>/dev/null` || REL=unknown +case $SYS:$REL in + SunOS:5.*) + TARGET=sunos5 ;; + Linux:*) + TARGET=linux ;; + *) + TARGET="" ;; +esac + +cd $ERL_ROOT/erts-%I_VSN%/bin + +sed -e "s;%FINAL_ROOTDIR%;$TARGET_ERL_ROOT;" erl.src > erl +chmod 755 erl + +# +# Create start file for embedded system use, +# +(cd $ERL_ROOT/erts-%I_VSN%/bin; + sed -e "s;%FINAL_ROOTDIR%;$TARGET_ERL_ROOT;" start.src > start; + chmod 755 start) + +cd $ERL_ROOT/bin + +cp -p $ERL_ROOT/erts-%I_VSN%/bin/erl . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/erlc . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/dialyzer . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/typer . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/escript . + +# +# Set a soft link to epmd +# This should not be done for an embedded system! +# + +# Remove old links first. +if [ -h epmd ]; then + /bin/rm -f epmd +fi + +ln -s $TARGET_ERL_ROOT/erts-%I_VSN%/bin/epmd epmd + +cp -p $ERL_ROOT/erts-%I_VSN%/bin/run_erl . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/to_erl . +cp -p $ERL_ROOT/erts-%I_VSN%/bin/start . +sed -e "s;%EMU%;%EMULATOR%%EMULATOR_NUMBER%;" $ERL_ROOT/erts-%I_VSN%/bin/start_erl.src > start_erl +chmod 755 start_erl +echo "" + +echo %I_VSN% %I_SYSTEM_VSN% > $ERL_ROOT/releases/start_erl.data +sed -e "s;%ERL_ROOT%;$TARGET_ERL_ROOT;" $ERL_ROOT/releases/RELEASES.src > $ERL_ROOT/releases/RELEASES + +if [ "$start_option" = "query" ] +then + echo "Do you want to use a minimal system startup" + echo "instead of the SASL startup? (y/n) [n]: " | tr -d '\012' + read reply + case $reply in + [Yy]*) + start_option=minimal ;; + *) + start_option=sasl ;; + esac +fi + +case $start_option in + minimal) + Name=start_clean ;; + sasl) + Name=start_sasl ;; + *) + Name=start_sasl ;; +esac + +cp -p ../releases/%I_SYSTEM_VSN%/start_*.boot . +cp -p $Name.boot start.boot +cp -p ../releases/%I_SYSTEM_VSN%/$Name.script start.script + +# +# We always run ranlib unless Solaris/SunOS 5 +# but ignore failures. +# +if [ "X$TARGET" != "Xsunos5" -a -d $ERL_ROOT/usr/lib ]; then + cd $ERL_ROOT/usr/lib + for library in lib*.a + do + (ranlib $library) > /dev/null 2>&1 + done +fi + + +# +# Fixing the man pages +# + +if [ -d $ERL_ROOT/man ] +then + cd $ERL_ROOT + ./misc/format_man_pages $ERL_ROOT +fi + + diff --git a/erts/etc/unix/README b/erts/etc/unix/README new file mode 100644 index 0000000000..45b4aec2da --- /dev/null +++ b/erts/etc/unix/README @@ -0,0 +1,111 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 1996-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +-------------------------------------------------------------------------------- +%sunos4 This is Erlang version %VERSION% for SunOS 4. +%solaris2 This is Erlang version %VERSION% for Solaris 2 (SunOS 5). +%isc32 This is Erlang version %VERSION% for Interactive UNIX. +%aix This is Erlang version %VERSION% for AIX. +%hpux This is Erlang version %VERSION% for HP-UX. +%osf This is Erlang version %VERSION% for OSF/1 (currently unsupported). +%linux This is Erlang version %VERSION% for Linux. +%qnx This is Erlang version %VERSION% for QNX. +%freebsd This is Erlang version %VERSION% for FreeBSD. + + +Installation +------------ + +Please refer to the "System Administrator's Guide" for a description +of how to install the Erlang system. Ultra-short summary for the +impatient: Run the 'Install' script in this directory and answer the +questions; defaults (if any) are given in square brackets [] at the +end of each question. + +Note that the Install script will terminate if it detects problems - +you will have to correct them and re-run the script. If everything +goes well, the last printout should be: + +Erlang installation sucessfully completed + +If it isn't, something went wrong - check the printouts to find out +what it was. + +%hpux Note: On HP-UX, it isn't possible to have per-manpage-tree 'whatis' +%hpux files. Thus, 'erl -man -k ' will not work, and it isn't +%hpux recommended to integrate the Erlang man pages into /usr/lib/whatis +%hpux since (as mentioned in the "System Administrator's Guide") there are +%hpux some potential conflicts in naming with standard Unix man pages. +%hpux +%isc32 Note: The release currently includes several files with names longer +%isc32 than 14 characters - this means that you will have problems unpacking +%isc32 it in a standard Interactive S51K (or S52K) filesystem (which you've +%isc32 probably already noticed...). Furthermore, the Erlang filer makes no +%isc32 attempts to deal "intelligently" with such restrictions. The bottom +%isc32 line is that you have to install the Erlang system in an S5L (or +%isc32 possibly NFS) filesystem, unless you have found a way to make the +%isc32 Interactive system silently truncate filenames longer than 14 +%isc32 characters when using S5?K (if so, please tell us about it!). +%isc32 + +Overview of the files/directories in the system +----------------------------------------------- + +README - this file. + +RELNOTES - release notes. + +Install - the main installation script. + +bin - the directory where all code that is to be executed + directly by UNIX is placed during the installation. + +lib - a number of "bundles" included in the release - each + bundle lives in a subdirectory. Most of them are written + entirely in Erlang, but in some cases C programs are also + used (these are copied to the bin directory during + installation). The code server will automatically add the + appropriate directory for each bundle to the search path. + Some of the more noteworthy bundles: + std - this is the standard library, with modules such as + file, io, lists, etc. + compiler - the Erlang compiler (of course) + debugger - the Erlang debugger (ditto) + pxw - the "Primitive X Window interface", which perhaps + isn't so primitive anymore... + For further information on these and the other bundles, + please refer to the man pages. + +doc - The printed documentation in compressed PostScript format, + and some code examples. + +man - Manual pages, best accessed with 'erl -man' - there are + some conflicts with standard Unix manpages if you put + this directory in $MANPATH. + +emulator - The object code for the emulator itself is in the 'obj' + subdirectory, along with a simple Makefile and a couple + of source files that advanced users *may* be interested in + changing - care should be taken, of course, since any + changes may make the system non-functional. Refer to the + "System Adminstrator's Guide" and "Additional Features" + documents for some more information on this. + +misc - Some pieces that don't belong to any particular part of the + system - e.g. the new erl_interface package, and an Erlang + mode for emacs. diff --git a/erts/etc/unix/RELNOTES b/erts/etc/unix/RELNOTES new file mode 100644 index 0000000000..d1a110fce3 --- /dev/null +++ b/erts/etc/unix/RELNOTES @@ -0,0 +1,327 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 1996-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +============================================================================= + +Release Notes Erlang 4.3.1, Stockholm, October 1995 + +This is a maintenance release correcting some minor problems in the 4.3 +release. The changes are mostly related to problems when using Erlang in +an distributed environment. For features and incompatibilities look in the +following description of the 4.3 release. + +-- If you already have the 4.3 release and run in an distributed environment + you should change all nodes to 4.3.1 since some changes could (at least + potentially) create problems/incompatibilities. (You ought to change + anyway due to bugs fixed...). + +============================================================================= + +Release Notes Erlang 4.3, Stockholm, June 1995 + +This is a list of the changes, fixes, and enhancements which have occurred +between the Erlang 4.2 release of March 1994, and the Erlang 4.3 release of +June 1995. There is also information on problems reported for 4.2 that still +remain in release 4.3. For a more detailed description of new or changed +functions, please refer to the respective manual pages, which are referred +to as man-page(3) or man-page(1). + +Erlang release 4.3 is basically the same system as release 4.2. +A large number of improvements and enhancements have, however, +occurred. The 4.3 system is largely source code compatible with +the 4.2 system, but there is a number of incompatibilities. + +*** Major Improvements +------------------------------------------------------------------ + +-- The system is considerably faster and smaller. + A fully networked system now requires less than a Megabyte + of memory to start. + +-- The system has built-in hashlists which makes it possible + to store,search and manipulate very large quantities of data, + see ets(3). + +-- Bignums, integers can now be arbitrarily large (almost) + +-- A fully integrated debugger/interpreter that can be used + to debug distributed applications, see int(3), and + the user manual. + +-- Distributed Erlang can now be run in environments where DNS + (The Domain Name system) is not configured, see dist_erl(1). + +-- A new trace/3 BIF which can be used for a variety of + purposes, see erlang(3). + + +*** Minor improvements and new modules. +--------------------------------------------------------------------- + +-- A new BIF to monitor other nodes, monitor_node/2, + see erlang(3). + +-- Floating point exceptions and bad parameters to math functions + are now handled correctly, (possibly not implemented on all + architectures) + +-- epmd can be used to access DNS, see epmd(3). + +-- Erlang now contains MACROS, include files, structures, etc. + These are currently not documented, and are used at the + user's own risk, as the syntax might change. + +-- The configuration of the Erlang system has been simplified. + Not many users are aware of this possibility at all, however. + The only parameter left for configuration is now the size of + TMP_BUF, so no upper limits remain for the number of functions, + modules, etc. + +-- Parallel make, see make(3). + +-- generic.erl, is recommended for writing servers, + see generic(3). + +-- timer.erl a new module to be used for various types of timing + related activities. + +-- The new formatter ~p has been introduced into the formatting + routines. io:format("String ~p", [Term]). will print the + term Term with any lists of integers that seem to be strings + as strings. This means that the majority of printouts will + now have a more attractive appearance. However, it also means + that some lists of integers that are real "lists of integers" + will be displayed as strings. Example: + + 1> [65,66]. + "AB" + +-- Deep lists can now be sent to ports. The lists must be well formed + but can contain integers and binaries. + +-- There is a new interface to udp/ip, see udp(3). + +-- slave.erl is a new and nicer way to start up slave nodes in a + UNIX environment. + +-- ddd.erl is a distributed fully replicated data dictionary. + +-- queue.erl FIFO queues as an abstract datatype. + +-- There are enhancements in the socket interface, see socket(3). + +-- rpc.erl is a new module that now contains some of the functions + that used to be in net.erl, which has now been removed, + see rpc(3). + +-- lists.erl contains some new functionality, see lists(3). + +-- BIF erlang:now() returns the current time. + This BIF is guaranteed to produce continuously increasing values. + +-- The new module auth.erl is for handling authentication, see auth(3). + +-- The file $HOME/.erlang.cookie is now automatically and + silently created if it does not exist. This means that new and/or + naive users can ignore the issues of cookies entirely. + +-- user.erl has been slightly rewritten so that Erlang + programs can now be part of a UNIX pipe, see erl(3), io(3). + +-- The new library directory tools now contain various + "tools" + + +*** Command line flags changes. +------------------------------------------------------------------- + +-- The -s and -h flags take values measured in H_GRAIN and S_GRAIN + H_GRAIN == S_GRAIN == 64. (Default is 1, which means that the default + heap and stack size is 64 words.) + +-- The maximum size of the atom_table is now configurable from + the command line. + +-- erl -sname Name starts a new node with a short name. (s == short), + see erl(1). + +-- The breakhandler can now be turned off with the aid of the flag +B. + +-- init.erl has been rewritten. A -load flag is now accepted, + see init(3). + +-- The -cookie flag is no longer necessary if the system is to + read the $HOME/.erlang.cookie file. This is the default. + +-- The flag -env Variable Value extends the UNIX environment + for the Erlang system, see erl(3). + + +*** Reported Fixed Bugs and Malfunctions +------------------------------------------------------------------- + +-- Do not assume that the first two directory entries "." and ".." + make file:list_dir() work better in some environments. + +-- Faster/better garbage collection. + +-- Stack sizes are automatically shrunk. + +-- Distributed Erlang now handles the case when for example the + Ethernet plug is unplugged. Erlang continuously polls all + remote nodes to ensure that the remote nodes are really alive. + +-- A bug has been corrected in the terminal driver. The system + could fail after a large series of printouts without any + newlines "\n" at all. + +-- Formating of floats: a '9' would sometimes become a ':'. + +-- Formating with the use of '*' and negativ size fields now work + as expected. + +-- The format of the 'EXIT' values is now ALWAYS the same + regardless of where the 'EXIT' was produced. + +-- Bugs in exit/2 when the first argument is a port + and second argument is a tuple, have been fixed. + +-- A bug in the random generator has been fixed, see random(3)) + +-- Object code can now be 'trace' compiled by passing the + flag 'trace' to the compiler. This is necessary for + the trace/3 BIF to work on function calls. + +-- error_logger has been improved and is more flexible, see error_logger(3). + +-- The compiler is not so verbose any more. + +-- A bug in the loading of code has been fixed. It is now possible to load + code into the "hole" created by erlang:delete_module/1. + +-- The file system now accepts very large messages. In 4.2 there + was a limit of 64K, which meant that some VERY large modules + could not be compiled. + +-- Support for real interrupts/signals in linked-in drivers have been added. + +-- open_port does not make new atoms all the time. + +-- statistics(io) does now return two counters, + one for all input and one for all output. + +-- There have been minor bug fixes in the erl_interface c-library. + + +*** New TOOLS for Software Development/Tuning/Debugging +--------------------------------------------------------------- + +-- int, is a fully integrated debugger/interpreter, see int(3). + +-- eprof, is a (tty-based) tool for real-time profiling, see eprof(3). + +-- dbg, is a (tty-based) interface to the the trace/3 BIF, see dbg(3). + +-- pman, is a (pxw-based) interface to the trace/3 BIF. + +-- emseq, is a (tty-based) message sequence chart tool. (Not documented) + +-- perfmon, is a (pxw-based) performance monitor. (Not documented) + +-- exref, is a (tty-based) cross-reference tool. + + +*** New Targets Not Generally Available for 4.2 +------------------------------------------------------------------ + +FreeBSD running on PCs +LINUX running on PCs +QNX + + +*** Incompatibilities with 4.2. +-------------------------------------------------------------------- + +-- The BIF node_link/1 has been replace by monitor_node/2 + See erlang(3). + +-- The 4.3 system is not object code compatible with 4.2. + This means that all source code has to be recompiled. It + is not possible to load 4.2 object code. It is also not + possible to run distribution between 4.3 and erlier versions + due to the new alive check. + +-- The external term format has been changed. This will only affect + programs where the BIF term_to_binary/1 has been used for writing + output on files. The directory misc/external contains a program + ext42_to_ext43.erl that can be used for converting files and + binaries from 4.2 format to 4.3 format. This will affect very + few programs. + +-- The names of the Erlang specific i/o modules are now prefixed by + "erl_", for example erl_scan and erl_parse. + +-- The calls to tokenize/parse have been changed, partially to make their + naming more systematic and also to handle the new line number + information. Their return values have also been made more regular with + all functions returning 'ok', {ok, Value} or {ok, Value, EndLine} where + appropriate when successful, and {error, ErrorInfo} or + {error, ErrorInfo, EndLine} if there is an error. + +-- There is a standardised error information format, ErrorInfo above, which + is returned for all input functions. It has the format: + {ErrorLine, Module, ErrorDescriptor} + where a string describing the error can be obtained by calling + apply(Module, format_error, [ErrorDescriptor]). + The handling of line number is application specific. + +-- The function io:read/1/2 now returns {ok, Term} or {error, ErrorInfo} + for consistency. + +-- The Erlang tokeniser/parser has been converted to return line number + information in the token and parse formats. These formats can now + be handled by the pretty printer (erl_pp) but it does not make use of them. + +-- The function file:open/2 now returns {ok, Pid} or {error, What}. This is + consistent with the return values from the rest of the i/o system. + +-- RTFMP! (Read The Friendly Man Pages) + +-- Module net.erl has been removed. The functionality of net.erl + now resides in the rpc, auth and net_kernel modules. + +-- The old debug BIFs (including the module debugger.erl) have + been removed. The BIF trace/3 replaces it. + +-- The BIF not_alive/0 has been removed. + + +*** Documentation: +-------------- + +All manual pages have been updated, some of them substantially. + + +*** Known problems: +--------------- + +The $HOME/.erlang file should be run before the shell is started. + +The Postscript documentation in the doc directory assumes A4 paper. + +list_to_pid/1 on remote pids may behave in an unexpected manner. diff --git a/erts/etc/unix/cerl.src b/erts/etc/unix/cerl.src new file mode 100644 index 0000000000..f81ef6b0fe --- /dev/null +++ b/erts/etc/unix/cerl.src @@ -0,0 +1,285 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# This is a script to start Erlang/OTP for debugging. PATH is set to +# include this script so if slave nodes are started they will use this +# script as well. +# +# usage: cerl [ OPTIONS ] [ ARGS ] +# +# The OPTIONS are +# +# -rootdir $MYROOTDIR +# Run an installed emulator built from this source +# -debug Run debug compiled emulator +# -gdb Run the debug compiled emulator in emacs and gdb. +# You have to start beam in gdb using "run". +# -break F Run the debug compiled emulator in emacs and gdb and set break. +# The session is started, i.e. "run" is already don for you. +# -xxgdb FIXME currently disabled +# -purify Run emulator compiled for purify +# -quantify Run emulator compiled for quantify +# -purecov Run emulator compiled for purecov +# -gcov Run emulator compiled for gcov +# -valgrind Run emulator compiled for valgrind +# -lcnt Run emulator compiled for lock counting +# -nox Unset the DISPLAY variable to disable us of X Windows +# +# FIXME For GDB you can also set the break point using "-break FUNCTION". +# FIXME For GDB you can also point out your own .gdbini...... + +# These are marked for export +export ROOTDIR +export PROGNAME +export EMU +export BINDIR +export PATH + +cargs= +xargs= +cxargs_add() { + while [ $# -gt 0 ]; do + cargs="$cargs $1" + xargs="$xargs $1" + shift + done +} + +core= + +GDB= +GDBBP= +TYPE= +EMU_TYPE= +debug= +run_valgrind=no + +# Default rootdir +ROOTDIR=%SRC_ROOTDIR% +BINDIR="$ROOTDIR/bin/`$ROOTDIR/erts/autoconf/config.guess`" +#BINDIR="$ROOTDIR/bin/%TARGET%" +PROGNAME=$ROOTDIR/bin/cerl +EMU=beam + +PRELOADED=$ROOTDIR/erts/preloaded/ebin + + +while [ $# -gt 0 ]; do + case "$1" in + +*) + # A system parameter! + cxargs_add $1 + shift + # If next argument does not begin with a hyphen or a plus, + # it is used as the value of the system parameter. + if [ $# -gt 0 ]; then + case $1 in + -*|+*) + ;; + *) + cxargs_add $1 + shift;; + esac + fi;; + "-instr") + cxargs_add $1 + shift + ;; + "-target") + shift + BINDIR="$ROOTDIR/bin/$1" + shift + ;; + "-rootdir") + shift + cargs="$cargs -rootdir $1" + ROOTDIR="$1" + BINDIR=$ROOTDIR/erts-%VSN%/bin + shift + ;; + "-display") + shift + DISPLAY="$1" + export DISPLAY + shift + ;; + "-nox") + shift + unset DISPLAY + ;; + "-smp") + shift + cargs="$cargs -smp" + EMU_TYPE=.smp + ;; + "-lcnt") + shift + cargs="$cargs -lcnt" + TYPE=.lcnt + ;; + "-frag") + shift + cargs="$cargs -frag" + EMU_TYPE=.frag + ;; + "-smp_frag") + shift + cargs="$cargs -smp_frag" + EMU_TYPE=.smp_frag + ;; + "-gprof") + shift + cargs="$cargs -gprof" + TYPE=.gprof + ;; + "-hybrid") + shift + cargs="$cargs -hybrid" + EMU_TYPE=.hybrid + ;; + "-debug") + shift + cargs="$cargs -debug" + TYPE=.debug + ;; + "-gdb") + shift + GDB=gdb + ;; + "-break") + shift + GDB=gdb + GDBBP="$GDBBP (insert-string \"break $1\") (comint-send-input)" + shift + ;; + "-core") + shift + GDB=gdb + core="$1" + shift + ;; +# "-xxgdb") +# shift +# GDB=xxgdb +# ;; + "-shared") + shift + cargs="$cargs -shared" + TYPE=.shared + ;; + "-purify") + shift + cargs="$cargs -purify" + TYPE=.purify + ;; + "-quantify") + shift + cargs="$cargs -quantify" + TYPE=.quantify + ;; + "-purecov") + shift + cargs="$cargs -purecov" + TYPE=.purecov + ;; + "-gcov") + shift + cargs="$cargs -gcov" + TYPE=.gcov + ;; + "-valgrind") + shift + cargs="$cargs -valgrind" + TYPE=.valgrind + run_valgrind=yes + ;; + *) + break + ;; + esac +done + + +PATH=$BINDIR:$ROOTDIR/bin:$PATH +EXEC=$BINDIR/erlexec + +PROGNAME="$PROGNAME $cargs" +EMU=$EMU$TYPE$EMU_TYPE +if [ $run_valgrind != yes ]; then + xargs="$xargs -pz $PRELOADED --" +fi +if [ "x$GDB" = "x" ]; then + if [ $run_valgrind = yes ]; then + emu_xargs=`echo $xargs | sed "s|+|-|g"` + if [ "x$VALGRIND_LOG_DIR" = "x" ]; then + valgrind_log= + else + valgrind_log="--log-file=$VALGRIND_LOG_DIR/$VALGRIND_LOGFILE_PREFIX$VALGRIND_LOGFILE_INFIX$EMU.log" + fi + if [ "x$VALGRIND_LOG_XML" = "x" ]; then + valgrind_xml= + else + export VALGRIND_LOG_XML + valgrind_xml="--xml=yes" + fi + if [ "x$VALGRIND_MISC_FLAGS" = "x" ]; then + valgrind_misc_flags= + else + valgrind_misc_flags="$VALGRIND_MISC_FLAGS" + fi + beam_args=`$EXEC -emu_args_exit ${1+"$@"}` + # Ahhhh... Need to quote $PROGNAME... + early_beam_args=`echo $beam_args | sed "s|^\(.*-progname\).*$|\1|g"` + late_beam_args=`echo $beam_args | sed "s|^$pre_beam_args.*\(-- -home.*\)$|\1|g"` + + exec valgrind $valgrind_xml $valgrind_log $valgrind_misc_flags $BINDIR/$EMU $emu_xargs $early_beam_args "$PROGNAME" $late_beam_args -pz $PRELOADED + else + exec $EXEC $xargs ${1+"$@"} + fi +else + if [ "x$EMACS" = "x" ]; then + EMACS=emacs + fi + + case "x$core" in + x) + # Get emu args to use from erlexec... + beam_args=`$EXEC -emu_args_exit ${1+"$@"}` + gdbcmd="(insert-string \"set args $beam_args\") \ + (comint-send-input)" + ;; + x/*) + gdbcmd="(insert-string \"core ${core}\") (comint-send-input)" + GDBBP= + ;; + *) + dir=`pwd` + gdbcmd="(insert-string \"core ${dir}/${core}\") \ + (comint-send-input)" + GDBBP= + ;; + esac + + gdbcmd="$gdbcmd $GDBBP \ + (insert-string \"source $ROOTDIR/erts/etc/unix/etp-commands\") \ + (comint-send-input)" + # Fire up gdb in emacs... + exec $EMACS --eval "(progn (gdb \"gdb $EMU\") $gdbcmd)" +fi diff --git a/erts/etc/unix/dyn_erl.c b/erts/etc/unix/dyn_erl.c new file mode 100644 index 0000000000..984935417e --- /dev/null +++ b/erts/etc/unix/dyn_erl.c @@ -0,0 +1,400 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This is a C version of the erl Bourne shell script + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include "sys.h" +#include +#include + +#define BOOL int +#define TRUE 1 +#define FALSE 0 +#define PATHSEP ":" +#define DIRSEP "/" +#define DIRSEPCHAR '/' + +static void +error(char* format, ...) +{ + char sbuf[1024]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + fprintf(stderr, "erl: %s\n", sbuf); + exit(1); +} + +/* + * Variables. + */ + +/* + * Manage memory + */ + +static void * +emalloc(size_t size) +{ + void *p = malloc(size); + if (p == NULL) + error("Insufficient memory"); + return p; +} + +/* +static void * +erealloc(void *p, size_t size) +{ + void *res = realloc(p, size); + if (res == NULL) + error("Insufficient memory"); + return res; +} +*/ + +static void +efree(void *p) +{ + free(p); +} + +static char* +strsave(char* string) +{ + char* p = emalloc(strlen(string)+1); + strcpy(p, string); + return p; +} + +/* + * Manage environment variables + */ + +static char * +get_env(char *key) +{ + return getenv(key); +} + +static void +set_env(char *key, char *value) +{ + size_t size = strlen(key) + 1 + strlen(value) + 1; + char *str = emalloc(size); + sprintf(str, "%s=%s", key, value); + if (putenv(str) != 0) + error("putenv(\"%s\") failed!", str); +#ifdef HAVE_COPYING_PUTENV + efree(str); +#endif +} + +// /* A realpath look alike */ +// static char * +// follow_symlinks(const char *path, char *resolved_path) +// { +// char tmp[PATH_MAX]; +// int len; +// +// strcpy(resolved_path, path); +// +// for (;;) { +// len = readlink(resolved_path, tmp, PATH_MAX); +// +// if (len == -1) { +// if (errno == EINVAL) { +// /* Not a symbolic link. use the original name */ +// break; +// } else { +// return NULL; +// } +// } else { +// tmp[len] = '\0'; +// strcpy(resolved_path, tmp); +// } +// } +// +// return resolved_path; +// } + +/* + * Find absolute path to this program + */ + +static char * +find_prog(char *origpath) +{ + char relpath[PATH_MAX]; + char abspath[PATH_MAX]; + + strcpy(relpath, origpath); + + if (strstr(relpath, DIRSEP) == NULL) { + /* Just a base name */ + char *envpath; + + envpath = get_env("PATH"); + if (envpath) { + /* Try to find the executable in the path */ + char dir[PATH_MAX]; + char *beg = envpath; + char *end; + int sz; + DIR *dp; /* Pointer to directory structure. */ + struct dirent* dirp; /* Pointer to directory entry. */ + BOOL look_for_sep = TRUE; + + while (look_for_sep) { + end = strstr(beg, PATHSEP); + if (end != NULL) { + sz = end - beg; + strncpy(dir, beg, sz); + dir[sz] = '\0'; + } else { + sz = strlen(beg); + strcpy(dir, beg); + look_for_sep = FALSE; + } + beg = end + 1; + + dp = opendir(dir); + if (dp != NULL) { + while (TRUE) { + dirp = readdir(dp); + if (dirp == NULL) { + closedir(dp); + /* Try next directory in path */ + break; + } + + if (strcmp(origpath, dirp->d_name) == 0) { + /* Wow. We found the executable. */ + strcpy(relpath, dir); + strcat(relpath, DIRSEP); + strcat(relpath, dirp->d_name); + closedir(dp); + look_for_sep = FALSE; + break; + } + } + } + } + } + } + + if (!realpath(relpath, abspath)) { + error("Cannot determine real path to erl"); + } + + return strdup(abspath); +} + +/* + * Find bindir + */ + +static void +copy_latest_vsn(char *latest_vsn, char *next_vsn) +{ + char *lp; + char *np; + BOOL greater; + + /* Find vsn */ + for (lp = latest_vsn+strlen(latest_vsn)-1 ;lp > latest_vsn && *lp != DIRSEPCHAR; --lp) + ; + + /* lp =+ length("erts-"); */ + for (np = next_vsn+strlen(next_vsn)-1 ;np > next_vsn && *np != DIRSEPCHAR; --np) + ; + + /* np =+ length("erts-"); */ + while (TRUE) { + if (*lp != *np) { + if (*np > *lp) { + greater = TRUE; + } else { + greater = FALSE; + } + + /* Find next dot or eos */ + while (*lp != '\0' && *np != '\0') { + lp++; + np++; + if (*np == '.' && *lp == '.') { + break; + } + if (*np == '\0' && *lp == '\0') { + break; + } + if (*lp == '.' || *lp == '\0') { + greater = TRUE; + } + if (*np == '.' || *np == '\0') { + greater = FALSE; + } + } + if (greater) { + strcpy(latest_vsn, next_vsn); + } + return; + } + ++lp; + ++np; + } +} + +static char * +find_erts_vsn(char *erl_top) +{ + /* List install dir and look for latest erts-vsn */ + DIR *dp; /* Pointer to directory structure. */ + struct dirent* dirp; /* Pointer to directory entry. */ + char latest_vsn[PATH_MAX]; /* Latest erts-vsn directory name. */ + + dp = opendir(erl_top); + if (dp == NULL) { + return NULL; + } + + latest_vsn[0] = '\0'; + for (;;) { + dirp = readdir(dp); + if (dirp == NULL) { + closedir(dp); + break; + } + if (strncmp("erts-", dirp->d_name, 5) == 0) { + copy_latest_vsn(latest_vsn, dirp->d_name); + } + } + + if (latest_vsn[0] == '\0') { + return NULL; + } else { + char *p = malloc((strlen(erl_top)+1+strlen(latest_vsn)+4+1)*sizeof(char)); + strcpy(p,erl_top); + strcat(p,DIRSEP); + strcat(p,latest_vsn); + strcat(p,DIRSEP); + strcat(p,"bin"); + return p; + } +} + +static char * +find_bindir(char *erlpath) +{ + /* Assume that the path to erl is absolute and + * that it is not a symbolic link*/ + + char *p; + char *p2; + char buffer[PATH_MAX]; + + strcpy(buffer, erlpath); + + /* Chop of base name*/ + for (p = buffer+strlen(buffer)-1 ;p >= buffer && *p != DIRSEPCHAR; --p) + ; + *p = '\0'; + p--; + + /* Check if dir path is like ...\buffer\erts-vsn\bin */ + for (;p >= buffer && *p != DIRSEPCHAR; --p) + ; + p--; + for (p2 = p;p2 >= buffer && *p2 != DIRSEPCHAR; --p2) + ; + p2++; + if (strncmp(p2, "erts-", 5) == 0) { + p = strsave(buffer); + return p; + } + + /* Assume that dir path is like ...\buffer\bin */ + *++p ='\0'; /* chop off bin dir */ + + p = find_erts_vsn(buffer); + if (p == NULL) { + return strsave(buffer); + } else { + return p; + } +} + +/* + * main + */ + +int +main(int argc, char **argv) +{ + char *p; + char *abspath; + char *bindir; /* Location of executables. */ + char rootdir[PATH_MAX]; /* Root location of Erlang installation. */ + char progname[PATH_MAX]; /* Name of this program. */ + char erlexec[PATH_MAX]; /* Path to erlexec */ + + /* Determine progname */ + abspath = find_prog(argv[0]); + strcpy(progname, abspath); + for (p = progname+strlen(progname)-1;p >= progname && *p != '/'; --p) + ; + + /* Determine bindir */ + bindir = find_bindir(abspath); + + /* Determine rootdir */ + strcpy(rootdir, bindir); + for (p = rootdir+strlen(rootdir)-1;p >= rootdir && *p != '/'; --p) + ; + p--; + for (;p >= rootdir && *p != '/'; --p) + ; + *p ='\0'; + + /* Update environment */ + set_env("EMU", "beam"); + set_env("PROGNAME", progname); + set_env("BINDIR", bindir); + set_env("ROOTDIR", rootdir); + + /* Invoke erlexec */ + strcpy(erlexec, bindir); + strcat(erlexec, DIRSEP); + strcat(erlexec, "erlexec"); + + efree(abspath); + efree(bindir); + + execvp(erlexec, argv); + error("Error %d executing \'%s\'.", errno, erlexec); + return 2; +} diff --git a/erts/etc/unix/erl.src.src b/erts/etc/unix/erl.src.src new file mode 100644 index 0000000000..50603f12f4 --- /dev/null +++ b/erts/etc/unix/erl.src.src @@ -0,0 +1,28 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +ROOTDIR=%FINAL_ROOTDIR% +BINDIR=$ROOTDIR/erts-%VSN%/bin +EMU=%EMULATOR%%EMULATOR_NUMBER% +PROGNAME=`echo $0 | sed 's/.*\///'` +export EMU +export ROOTDIR +export BINDIR +export PROGNAME +exec $BINDIR/erlexec ${1+"$@"} diff --git a/erts/etc/unix/etp-commands b/erts/etc/unix/etp-commands new file mode 100644 index 0000000000..6a01e0b7e0 --- /dev/null +++ b/erts/etc/unix/etp-commands @@ -0,0 +1,2054 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +############################################################################ +# Help commands +# + +define etp-help + help etp-help +end + +document etp-help +%--------------------------------------------------------------------------- +% etp-help +% +% Same as "help etp-help" +% +% Emulator Toolbox for Pathologists +% - GDB command toolbox for analyzing core dumps from the +% Erlang emulator (BEAM). +% +% Should work for 32-bit erts-5.2/R9B, ... +% +% The commands are prefixed with: +% etp: Acronym for erts-term-print +% etpf: Acronym for erts-term-print-flat +% +% User commands (these have help themselves): +% +% Most useful: +% etp, etpf +% +% Useful for doing step-by-step traversal of lists and tuples after +% calling the toplevel command etpf: +% etpf-cons, etpf-boxed, +% +% Special commands for not really terms: +% etp-mfa, etp-cp, +% etp-msgq, etpf-msgq, +% etp-stacktrace, etp-stackdump, etpf-stackdump, etp-dictdump +% etp-offheapdump, etpf-offheapdump, +% etp-print-procs, etp-search-heaps, etp-search-alloc, +% etp-ets-tables, etp-ets-tabledump +% +% Complex commands that use the Erlang support module. +% etp-overlapped-heaps, etp-chart, etp-chart-start, etp-chart-end +% +% Erlang support module handling commands: +% etp-run +% +% Parameter handling commands: +% etp-show, etp-set-max-depth, etp-set-max-string-length +% +% Other commands you may find in this toolbox are suffixed -1, -2, ... +% and are internal; not for the console user. +% +% The Erlang support module requires `erl' and `erlc' in the path. +% The compiled "erl_commands.beam" file is stored in the current +% working directory, so it is thereby in the search path of `erl'. +% +% These are just helpful commands when analyzing core dumps, but +% you will not get away without knowing the gory details of the +% tag bits. Do not forget about the e.g p, p/x, x and x/4x commands. +% +% Execution speed of user defined gdb commands is not lightning fast. +% It may well take half a minute to dump a complex term with the default +% max depth values on our old Sparc Ultra-10's. +% +% To use the Erlang support module, the environment variable ROOTDIR +% must be set to the toplevel installation directory of Erlang/OTP, +% so the etp-commands file becomes: +% $ROOTDIR/erts/etc/unix/etp-commands +% Also, erl and erlc must be in the path. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Toplevel commands +# + +define etp +# Args: Eterm +# +# Reentrant +# + etp-1 ((Eterm)($arg0)) 0 + printf ".\n" +end + +document etp +%--------------------------------------------------------------------------- +% etp Eterm +% +% Takes a toplevel Erlang term and prints the whole deep term +% very much as in Erlang itself. Up to a max depth. See etp-show. +%--------------------------------------------------------------------------- +end + +define etp-1 +# Args: Eterm, int depth +# +# Reentrant +# + if (($arg0) & 0x3) == 1 + # Cons pointer + if $etp_flat + printf "", ($arg0) + else + etp-list-1 ($arg0) ($arg1) + end + else + if (($arg0) & 0x3) == 2 + if $etp_flat + printf "", ($arg0) + else + etp-boxed-1 ($arg0) ($arg1) + end + else + if (($arg0) & 0x3) == 3 + etp-immediate-1 ($arg0) + else + # (($arg0) & 0x3) == 0 + if (($arg0) == 0x0) + printf "" + else + if (($arg0) == 0x4) + printf "" + else + etp-cp-1 ($arg0) + end + end + end + end + end +end + +define etpf +# Args: Eterm +# +# Non-reentrant + set $etp_flat = 1 + etp-1 ((Eterm)($arg0)) + set $etp_flat = 0 + printf ".\n" +end + +document etpf +%--------------------------------------------------------------------------- +% etpf Eterm +% +% Takes a toplevel Erlang term and prints it is. If it is a deep term +% print which command to use to traverse down one level. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Commands for nested terms. Some are recursive. +# + +define etp-list-1 +# Args: Eterm cons_cell, int depth +# +# Reentrant +# + if (($arg0) & 0x3) != 0x1 + printf "#NotCons<%#x>", ($arg0) + else + # Cons pointer + if $etp_chart + etp-chart-entry-1 ($arg0) ($arg1) 2 + end + etp-list-printable-1 ($arg0) ($arg1) + if !$etp_list_printable + # Print normal list + printf "[" + etp-list-2 ($arg0) (($arg1)+1) + end + end +end + +define etp-list-printable-1 +# Args: Eterm list, int depth +# +# Non-reentrant +# +# Returns: $etp_list_printable +# + if (($arg0) & 0x3) != 0x1 + printf "#NotCons<%#x>", ($arg0) + else + # Loop to check if it is a printable string + set $etp_list_p = ($arg0) + set $etp_list_printable = ($etp_list_p != $etp_nil) + set $etp_list_i = 0 + while ($etp_list_p != $etp_nil) && \ + ($etp_list_i < $etp_max_string_length) && \ + $etp_list_printable + if ($etp_list_p & 0x3) == 0x1 + # Cons pointer + set $etp_list_n = ((Eterm*)($etp_list_p & ~0x3))[0] + if ($etp_list_n & 0xF) == 0xF + etp-ct-printable-1 ($etp_list_n>>4) + if $etp_ct_printable + # Printable + set $etp_list_p = ((Eterm*)($etp_list_p & ~0x3))[1] + set $etp_list_i++ + else + set $etp_list_printable = 0 + end + else + set $etp_list_printable = 0 + end + else + set $etp_list_printable = 0 + end + end + # + if $etp_list_printable + # Print printable string + printf "\"" + set $etp_list_p = ($arg0) + set $etp_list_i = 0 + while $etp_list_p != $etp_nil + set $etp_list_n = ((Eterm*)($etp_list_p & ~0x3))[0] + etp-char-1 ($etp_list_n>>4) '"' + set $etp_list_p = ((Eterm*)($etp_list_p & ~0x3))[1] + set $etp_list_i++ + if $etp_list_p == $etp_nil + printf "\"" + else + if $etp_list_i >= $etp_max_string_length + set $etp_list_p = $etp_nil + printf "\"++[...]" + else + if $etp_chart + etp-chart-entry-1 ($arg0) (($arg1)+$etp_list_i) 2 + end + end + end + end + end + end +end + +define etp-list-2 +# Args: Eterm cons_cell, int depth +# +# Reentrant +# + if (($arg0) & 0x3) != 0x1 + printf "#NotCons<%#x>", ($arg0) + else + # Cons pointer + if ($arg1) >= $etp_max_depth + printf "...]" + else + etp-1 (((Eterm*)(($arg0)&~0x3))[0]) (($arg1)+1) + if ((Eterm*)(($arg0) & ~0x3))[1] == $etp_nil + # Tail is [] + printf "]" + else + if $etp_chart + etp-chart-entry-1 ($arg0) ($arg1) 2 + end + if (((Eterm*)(($arg0)&~0x3))[1]&0x3) == 0x1 + # Tail is cons cell + printf "," + etp-list-2 (((Eterm*)(($arg0)&~0x3))[1]) (($arg1)+1) + else + # Tail is other term + printf "|" + etp-1 (((Eterm*)(($arg0)&~0x3))[1]) (($arg1)+1) + printf "]" + end + end + end + end +end + +define etpf-cons +# Args: Eterm +# +# Reentrant capable +# + if ((Eterm)($arg0) & 0x3) != 0x1 + printf "#NotCons<%#x>", ($arg0) + else + # Cons pointer + set $etp_flat = 1 + printf "[" + etp-1 (((Eterm*)((Eterm)($arg0)&~0x3))[0]) + printf "|" + etp-1 (((Eterm*)((Eterm)($arg0)&~0x3))[1]) + printf "]\n" + set $etp_flat = 0 + end +end + +document etpf-cons +%--------------------------------------------------------------------------- +% etpf-cons Eterm +% +% Takes a Cons ptr and prints the Car and Cdr cells with etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-boxed-1 +# Args: Eterm, int depth +# +# Reentrant +# + if (($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", ($arg0) + else + if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3) != 0x0 + if $etp_chart + etp-chart-entry-1 (($arg0)&~0x3) ($arg1) 1 + end + printf "#BoxedError<%#x>", ($arg0) + else + if $etp_chart + etp-chart-entry-1 (($arg0)&~0x3) ($arg1) \ + ((((Eterm*)(($arg0)&~0x3))[0]>>6)+1) + end + if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3f) == 0x0 + printf "{" + etp-array-1 ((Eterm*)(($arg0)&~0x3)) ($arg1) ($arg1) \ + 1 ((((Eterm*)(($arg0)&~0x3))[0]>>6)+1) '}' + else + etp-boxed-immediate-1 ($arg0) + end + end + end +end + +define etp-boxed-immediate-1 +# Args: Eterm, int depth +# +# Non-reentrant +# + if (($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", ($arg0) + else + if (((Eterm*)(($arg0) & ~0x3))[0] & 0x3) != 0x0 + printf "#BoxedError<%#x>", ($arg0) + else + set $etp_boxed_immediate_p = (Eterm*)(($arg0) & ~0x3) + set $etp_boxed_immediate_h = ($etp_boxed_immediate_p[0] >> 2) & 0xF + if $etp_boxed_immediate_h == 0xC + etp-extpid-1 ($arg0) + else + if $etp_boxed_immediate_h == 0xD + etp-extport-1 ($arg0) + else + if ($etp_boxed_immediate_h == 0x2) || \ + ($etp_boxed_immediate_h == 0x3) + etp-bignum-1 ($arg0) + else + if ($etp_boxed_immediate_h == 0x6) + etp-float-1 ($arg0) + else + if ($etp_boxed_immediate_h == 0x4) + etp-ref-1 ($arg0) + else + if ($etp_boxed_immediate_h == 0xE) + etp-extref-1 ($arg0) + else + # Hexdump the rest + if ($etp_boxed_immediate_h == 0x5) + printf "#Fun<" + else + if ($etp_boxed_immediate_h == 0x8) + printf "#RefcBinary<" + else + if ($etp_boxed_immediate_h == 0x9) + printf "#HeapBinary<" + else + if ($etp_boxed_immediate_h == 0xA) + printf "#SubBinary<" + else + printf "#Header%X<", $etp_boxed_immediate_h + end + end + end + end + set $etp_boxed_immediate_arity = $etp_boxed_immediate_p[0]>>6 + while $etp_boxed_immediate_arity > 0 + set $etp_boxed_immediate_p++ + if $etp_boxed_immediate_arity > 1 + printf "%#x,", *$etp_boxed_immediate_p + else + printf "%#x", *$etp_boxed_immediate_p + if ($etp_boxed_immediate_h == 0xA) + set $etp_boxed_immediate_p++ + printf ":%#x", *$etp_boxed_immediate_p + end + printf ">" + end + set $etp_boxed_immediate_arity-- + end + # End of hexdump + end + end + end + end + end + end + end + end +end + +define etpf-boxed +# Args: Eterm +# +# Non-reentrant +# + set $etp_flat = 1 + etp-boxed-1 ((Eterm)($arg0)) 0 + set $etp_flat = 0 + printf ".\n" +end + +document etpf-boxed +%--------------------------------------------------------------------------- +% etpf-boxed Eterm +% +% Take a Boxed ptr and print the contents in one level using etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-array-1 +# Args: Eterm* p, int depth, int width, int pos, int size, int end_char +# +# Reentrant +# + if ($arg3) < ($arg4) + if (($arg1) < $etp_max_depth) && (($arg2) < $etp_max_depth) + etp-1 (($arg0)[($arg3)]) (($arg1)+1) + if (($arg3) + 1) != ($arg4) + printf "," + end + etp-array-1 ($arg0) ($arg1) (($arg2)+1) (($arg3)+1) ($arg4) ($arg5) + else + printf "...%c", ($arg5) + end + else + printf "%c", ($arg5) + end +end + + + +#define etpa-1 +## Args: Eterm, int depth, int index, int arity +## +## Reentrant +## +# if ($arg1) >= $etp_max_depth+$etp_max_string_length +# printf "%% Max depth for term %d\n", $etp_chart_id +# else +# if ($arg2) < ($arg3) +# etp-1 (((Eterm*)(($arg0)&~0x3))[$arg2]) (($arg1)+1) +# etpa-1 ($arg0) (($arg1)+1) (($arg2)+1) ($arg3) +# end +# end +#end + +############################################################################ +# Commands for non-nested terms. Recursion leaves. Some call other leaves. +# + +define etp-immediate-1 +# Args: Eterm +# +# Reentrant capable +# + if (($arg0) & 0x3) != 0x3 + printf "#NotImmediate<%#x>", ($arg0) + else + if (($arg0) & 0xF) == 0x3 + etp-pid-1 ($arg0) + else + if (($arg0) & 0xF) == 0x7 + etp-port-1 ($arg0) + else + if (($arg0) & 0xF) == 0xf + # Fixnum + printf "%ld", (long)((Sint)($arg0)>>4) + else + # Immediate2 - 0xB + if (($arg0) & 0x3f) == 0x0b + etp-atom-1 ($arg0) + else + if (($arg0) & 0x3f) == 0x1b + printf "#Catch<%d>", ($arg0)>>6 + else + if (($arg0) == $etp_nil) + printf "[]" + else + printf "#UnknownImmediate<%#x>", ($arg0) + end + end + end + end + end + end + end +end + + + +define etp-atom-1 +# Args: Eterm atom +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3f) != 0xb + printf "#NotAtom<%#x>", ($arg0) + else + set $etp_atom_1_ap = (Atom*)erts_atom_table.seg_table[(Eterm)($arg0)>>16][((Eterm)($arg0)>>6)&0x3FF] + set $etp_atom_1_i = ($etp_atom_1_ap)->len + set $etp_atom_1_p = ($etp_atom_1_ap)->name + set $etp_atom_1_quote = 1 + # Check if atom has to be quoted + if ($etp_atom_1_i > 0) + etp-ct-atom-1 (*$etp_atom_1_p) + if $etp_ct_atom + # Atom start character + set $etp_atom_1_p++ + set $etp_atom_1_i-- + set $etp_atom_1_quote = 0 + else + set $etp_atom_1_i = 0 + end + end + while $etp_atom_1_i > 0 + etp-ct-name-1 (*$etp_atom_1_p) + if $etp_ct_name + # Name character + set $etp_atom_1_p++ + set $etp_atom_1_i-- + else + set $etp_atom_1_quote = 1 + set $etp_atom_1_i = 0 + end + end + # Print the atom + if $etp_atom_1_quote + printf "'" + end + set $etp_atom_1_i = ($etp_atom_1_ap)->len + set $etp_atom_1_p = ($etp_atom_1_ap)->name + while $etp_atom_1_i > 0 + etp-char-1 (*$etp_atom_1_p) '\'' + set $etp_atom_1_p++ + set $etp_atom_1_i-- + end + if $etp_atom_1_quote + printf "'" + end + end +end + + + +define etp-char-1 +# Args: int char, int quote_char +# +# Non-reentrant +# + if (($arg0) < 0) || (0377 < ($arg0)) + printf "#NotChar<%#x>", ($arg0) + else + if ($arg0) == ($arg1) + printf "\\%c", ($arg0) + else + etp-ct-printable-1 ($arg0) + if $etp_ct_printable + if $etp_ct_printable < 0 + printf "%c", ($arg0) + else + printf "\\%c", $etp_ct_printable + end + else + printf "\\%03o", ($arg0) + end + end + end +end + +define etp-ct-printable-1 +# Args: int +# +# Determines if integer is a printable character +# +# Non-reentrant +# Returns: $etp_ct_printable +# escape alias char, or -1 if no escape alias + if ($arg0) == 010 + set $etp_ct_printable = 'b' + else + if ($arg0) == 011 + set $etp_ct_printable = 't' + else + if ($arg0) == 012 + set $etp_ct_printable = 'n' + else + if ($arg0) == 013 + set $etp_ct_printable = 'v' + else + if ($arg0) == 014 + set $etp_ct_printable = 'f' + else + if ($arg0) == 033 + set $etp_ct_printable = 'e' + else + if ((040 <= ($arg0)) && (($arg0) <= 0176)) || \ + ((0240 <= ($arg0)) && (($arg0) <= 0377)) + # Other printable character + set $etp_ct_printable = -1 + else + set $etp_ct_printable = 0 + end + end + end + end + end + end + end +end + +define etp-ct-atom-1 +# Args: int +# +# Determines if integer is a atom first character +# +# Non-reentrant +# Returns: $etp_ct_atom + if ((0141 <= ($arg0)) && (($arg0) <= 0172)) || \ + ((0337 <= ($arg0)) && (($arg0) != 0367) && (($arg0) <= 0377)) + # Atom start character + set $etp_ct_atom = 1 + else + set $etp_ct_atom = 0 + end +end + +define etp-ct-variable-1 +# Args: int +# +# Determines if integer is a variable first character +# +# Non-reentrant +# Returns: $etp_ct_variable + if ((056 == ($arg0)) || \ + (0101 <= ($arg0)) && (($arg0) <= 0132)) || \ + (0137 == ($arg0)) || \ + ((0300 <= ($arg0)) && (($arg0) != 0327) && (($arg0) <= 0336)) + # Variable start character + set $etp_ct_variable = 1 + else + set $etp_ct_variable = 0 + end +end + +define etp-ct-name-1 +# Args: int +# +# Determines if integer is a name character, +# i.e non-first atom or variable character. +# +# Non-reentrant +# Returns: $etp_ct_variable + if (($arg0) == 0100 || \ + (060 <= ($arg0)) && (($arg0) <= 071)) + set $etp_ct_name = 1 + else + etp-ct-atom-1 ($arg0) + if $etp_ct_atom + set $etp_ct_name = 1 + else + etp-ct-variable-1 ($arg0) + set $etp_ct_name = $etp_ct_variable + end + end +end + + + +define etp-pid-1 +# Args: Eterm pid +# +# Non-reentrant +# + set $etp_pid_1 = (Eterm)($arg0) + if ($etp_pid_1 & 0xF) == 0x3 + # Internal pid + printf "<0.%u.%u>", (unsigned) ($etp_pid_1>>4)&0x7fff, \ + (unsigned) ($etp_pid_1>>19)&0x1fff + else + printf "#NotPid<%#x>", ($arg0) + end +end + +define etp-extpid-1 +# Args: Eterm extpid +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_extpid_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3) + if ($etp_extpid_1_p->header & 0x3f) != 0x30 + printf "#NotExternalPid<%#x>", $etp_extpid_1_p->header + else + ## External pid + set $etp_extpid_1_number = $etp_extpid_1_p->data.ui[0]&0x7fff + set $etp_extpid_1_serial = ($etp_extpid_1_p->data.ui[0]>>15)&0x1fff + set $etp_extpid_1_np = $etp_extpid_1_p->node + set $etp_extpid_1_creation = $etp_extpid_1_np->creation + set $etp_extpid_1_dep = $etp_extpid_1_np->dist_entry + set $etp_extpid_1_node = $etp_extpid_1_np->sysname + if ($etp_extpid_1_node & 0x3f) != 0xb + # Should be an atom + printf "#ExternalPidError<%#x>", ($arg0) + else + if $etp_extpid_1_dep == erts_this_dist_entry + printf "<0:" + else + printf "<%u:", $etp_extpid_1_node>>6 + end + etp-atom-1 ($etp_extpid_1_node) + printf "/%u.%u.%u>", $etp_extpid_1_creation, \ + $etp_extpid_1_number, $etp_extpid_1_serial + end + end + end +end + + + +define etp-port-1 +# Args: Eterm port +# +# Non-reentrant +# + set $etp_port_1 = (Eterm)($arg0) + if ($etp_port_1 & 0xF) == 0x7 + # Internal port + printf "#Port<0.%u>", (unsigned) ($etp_port_1>>4)&0x3ffff + else + printf "#NotPort<%#x>", ($arg0) + end +end + +define etp-extport-1 +# Args: Eterm extport +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_extport_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3) + if ($etp_extport_1_p->header & 0x3F) != 0x34 + printf "#NotExternalPort<%#x>", $etp_extport_1->header + else + ## External port + set $etp_extport_1_number = $etp_extport_1_p->data.ui[0]&0x3ffff + set $etp_extport_1_np = $etp_extport_1_p->node + set $etp_extport_1_creation = $etp_extport_1_np->creation + set $etp_extport_1_dep = $etp_extport_1_np->dist_entry + set $etp_extport_1_node = $etp_extport_1_np->sysname + if ($etp_extport_1_node & 0x3f) != 0xb + # Should be an atom + printf "#ExternalPortError<%#x>", ($arg0) + else + if $etp_extport_1_dep == erts_this_dist_entry + printf "#Port<0:" + else + printf "#Port<%u:", $etp_extport_1_node>>6 + end + etp-atom-1 ($etp_extport_1_node) + printf "/%u.%u>", $etp_extport_1_creation, $etp_extport_1_number + end + end + end +end + + + +define etp-bignum-1 +# Args: Eterm bignum +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_bignum_1_p = (Eterm*)((Eterm)($arg0) & ~0x3) + if ($etp_bignum_1_p[0] & 0x3b) != 0x08 + printf "#NotBignum<%#x>", $etp_bignum_1_p[0] + else + set $etp_bignum_1_i = ($etp_bignum_1_p[0] >> 6) + if $etp_bignum_1_i < 1 + printf "#BignumError<%#x>", (Eterm)($arg0) + else + if $etp_bignum_1_p[0] & 0x04 + printf "-" + end + set $etp_bignum_1_p = (ErtsDigit *)($etp_bignum_1_p + 1) + printf "16#" + if $etp_arch64 + while $etp_bignum_1_i > 0 + set $etp_bignum_1_i-- + printf "%016lx", $etp_bignum_1_p[$etp_bignum_1_i] + end + else + while $etp_bignum_1_i > 0 + set $etp_bignum_1_i-- + printf "%08x", $etp_bignum_1_p[$etp_bignum_1_i] + end + end + end + end + end +end + + + +define etp-float-1 +# Args: Eterm float +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_float_1_p = (Eterm*)((Eterm)($arg0) & ~0x3) + if ($etp_float_1_p[0] & 0x3f) != 0x18 + printf "#NotFloat<%#x>", $etp_float_1_p[0] + else + printf "%f", *(double*)($etp_float_1_p+1) + end + end +end + + + +define etp-ref-1 +# Args: Eterm ref +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_ref_1_p = (RefThing *)((Eterm)($arg0) & ~0x3) + if ($etp_ref_1_p->header & 0x3b) != 0x10 + printf "#NotRef<%#x>", $etp_ref_1_p->header + else + set $etp_ref_1_nump = (Uint32 *) 0 + set $etp_ref_1_error = 0 + if ($etp_ref_1_p->header >> 6) == 0 + set $etp_ref_1_error = 1 + else + if $etp_arch64 + set $etp_ref_1_i = (int) $etp_ref_1_p->data.ui32[0] + if (($etp_ref_1_i + 1) > (2 * ($etp_ref_1_p->header >> 6))) + set $etp_ref_1_error = 1 + else + set $etp_ref_1_nump = &$etp_ref_1_p->data.ui32[1] + end + else + set $etp_ref_1_i = (int) ($etp_ref_1_p->header >> 6) + set $etp_ref_1_nump = &$etp_ref_1_p->data.ui32[0] + end + end + if $etp_ref_1_error + printf "#InternalRefError<%#x>", ($arg0) + else + printf "#Ref<0" + set $etp_ref_1_i-- + while $etp_ref_1_i >= 0 + printf ".%u", (unsigned) $etp_ref_1_nump[$etp_ref_1_i] + set $etp_ref_1_i-- + end + printf ">" + end + end + end +end + + + +define etp-extref-1 +# Args: Eterm extref +# +# Non-reentrant +# + if ((Eterm)($arg0) & 0x3) != 0x2 + printf "#NotBoxed<%#x>", (Eterm)($arg0) + else + set $etp_extref_1_p = (ExternalThing*)((Eterm)($arg0) & ~0x3) + if ($etp_extref_1_p->header & 0x3F) != 0x38 + printf "#NotExternalRef<%#x>", $etp_extref_1->header + else + ## External ref + set $etp_extref_1_nump = (Uint32 *) 0 + set $etp_extref_1_error = 0 + set $etp_extref_1_i = (int) ($etp_extref_1_p->header >> 6) + set $etp_extref_1_np = $etp_extref_1_p->node + set $etp_extref_1_creation = $etp_extref_1_np->creation + set $etp_extref_1_dep = $etp_extref_1_np->dist_entry + set $etp_extref_1_node = $etp_extref_1_np->sysname + if ($etp_extref_1_node & 0x3f) != 0xb || $etp_extref_1_i < 3 + # Node should be an atom + set $etp_extref_1_error = 1 + else + ## $etp_extref_1_i now equals data (Uint) words + set $etp_extref_1_i -= 2 + if $etp_arch64 + if ((((int) $etp_extref_1_p->data.ui32[0]) + 1) \ + > (2 * $etp_extref_1_i)) + set $etp_extref_1_error = 1 + else + set $etp_extref_1_nump = &$etp_extref_1_p->data.ui32[1] + set $etp_extref_1_i = (int) $etp_extref_1_p->data.ui32[0] + end + else + set $etp_extref_1_nump = &$etp_extref_1_p->data.ui32[0] + end + ## $etp_extref_1_i now equals no of ref num (Uint32) words + if !$etp_extref_1_error + if $etp_extref_1_dep == erts_this_dist_entry + printf "#Ref<0:" + else + printf "#Ref<%u:", $etp_extref_1_node>>6 + end + etp-atom-1 ($etp_extref_1_node) + printf "/%u", $etp_extref_1_creation + end + end + if $etp_extref_1_error + printf "#ExternalRefError<%#x>", ($arg0) + else + set $etp_extref_1_i-- + while $etp_extref_1_i >= 0 + printf ".%u", (unsigned) $etp_extref_1_nump[$etp_extref_1_i] + set $etp_extref_1_i-- + end + printf ">" + end + end + end +end + + + +define etp-mfa-1 +# Args: Eterm*, int offset +# +# Reentrant +# + printf "<" + etp-atom-1 (((Eterm*)($arg0))[0]) + printf ":" + etp-atom-1 (((Eterm*)($arg0))[1]) + printf "/%d", ((Eterm*)($arg0))[2] + if ($arg1) > 0 + printf "+%#x>", ($arg1) + else + printf ">" + end +end + +define etp-mfa +# Args: Eterm* +# +# Reentrant capable +# + etp-mfa-1 ($arg0) 0 + printf ".\n" +end + +document etp-mfa +%--------------------------------------------------------------------------- +% etp-mfa Eterm* +% +% Take an Eterm* to an MFA function name entry and print it. +% These can be found e.g in the process structure; +% process_tab[i]->current and process_tab[i]->initial. +%--------------------------------------------------------------------------- +end + + + +define etp-cp-1 +# Args: Eterm cp +# +# Non-reentrant +# + set $etp_cp = (Eterm)($arg0) + set $etp_cp_low = modules + set $etp_cp_high = $etp_cp_low + num_loaded_modules + set $etp_cp_mid = mid_module + set $etp_cp_p = 0 + # + while $etp_cp_low < $etp_cp_high + if $etp_cp < $etp_cp_mid->start + set $etp_cp_high = $etp_cp_mid + else + if $etp_cp > $etp_cp_mid->end + set $etp_cp_low = $etp_cp_mid + 1 + else + set $etp_cp_p = $etp_cp_low = $etp_cp_high = $etp_cp_mid + end + end + set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 + end + if $etp_cp_p + set $etp_cp_low = (Eterm**)($etp_cp_p->start + 8) + set $etp_cp_high = $etp_cp_low +$etp_cp_p->start[0] + set $etp_cp_p = 0 + while $etp_cp_low < $etp_cp_high + set $etp_cp_mid = $etp_cp_low + ($etp_cp_high-$etp_cp_low)/2 + if $etp_cp < $etp_cp_mid[0] + set $etp_cp_high = $etp_cp_mid + else + if $etp_cp < $etp_cp_mid[1] + set $etp_cp_p = $etp_cp_mid[0]+2 + set $etp_cp_low = $etp_cp_high = $etp_cp_mid + else + set $etp_cp_low = $etp_cp_mid + 1 + end + end + end + end + if $etp_cp_p + printf "#Cp" + etp-mfa-1 ($etp_cp_p) ($etp_cp-((Eterm)($etp_cp_p-2))) + else + if $etp_cp == beam_apply+1 + printf "#Cp" + else + if *(Eterm*)($etp_cp) == beam_return_trace[0] + if ($etp_cp) == beam_exception_trace + printf "#Cp" + else + printf "#Cp" + end + else + if *(Eterm*)($etp_cp) == beam_return_to_trace[0] + printf "#Cp" + else + printf "#Cp<%#x>", $etp_cp + end + end + end + end +end + +define etp-cp +# Args: Eterm cp +# +# Reentrant capable +# + etp-cp-1 ($arg0) + printf ".\n" +end + +document etp-cp +%--------------------------------------------------------------------------- +% etp-cp Eterm +% +% Take a code continuation pointer and print +% module, function, arity and offset. +% +% Code continuation pointers can be found in the process structure e.g +% process_tab[i]->cp and process_tab[i]->i, the second is the +% program counter, which is the same thing as a continuation pointer. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Commands for special term bunches. +# + +define etp-msgq +# Args: ErlMessageQueue* +# +# Non-reentrant +# + set $etp_msgq = ($arg0) + set $etp_msgq_p = $etp_msgq->first + set $etp_msgq_i = $etp_msgq->len + set $etp_msgq_prev = $etp_msgq->last + printf "%% Message queue (%d):", $etp_msgq_i + if ($etp_msgq_i > 0) && $etp_msgq_p + printf "\n[" + else + printf "\n" + end + while ($etp_msgq_i > 0) && $etp_msgq_p + set $etp_msgq_i-- + set $etp_msgq_next = $etp_msgq_p->next + # Msg + etp-1 ($etp_msgq_p->m[0]) 0 + if ($etp_msgq_i > 0) && $etp_msgq_next + printf ", %% " + else + printf "]. %% " + end + # Seq_trace token + etp-1 ($etp_msgq_p->m[1]) 0 + if $etp_msgq_p == $etp_msgq->save + printf ", <=\n" + else + printf "\n" + end + if ($etp_msgq_i > 0) && $etp_msgq_next + printf " " + end + # + set $etp_msgq_prev = $etp_msgq_p + set $etp_msgq_p = $etp_msgq_next + end + if $etp_msgq_i != 0 + printf "#MsgQShort<%d>\n", $etp_msgq_i + end + if $etp_msgq_p != 0 + printf "#MsgQLong<%#lx%p>\n", (unsigned long)$etp_msgq_p + end + if $etp_msgq_prev != $etp_msgq->last + printf "#MsgQEndError<%#lx%p>\n", (unsigned long)$etp_msgq_prev + end +end + +document etp-msgq +%--------------------------------------------------------------------------- +% etp-msgq ErlMessageQueue* +% +% Take an ErlMessageQueue* and print the contents of the message queue. +% Sequential trace tokens are included in comments and +% the current match position in the queue is marked '<='. +% +% A process's message queue is process_tab[i]->msg. +%--------------------------------------------------------------------------- +end + + + +define etpf-msgq +# Args: Process* +# +# Non-reentrant +# + set $etp_flat = 1 + etp-msgq ($arg0) + set $etp_flat = 0 +end + +document etpf-msgq +%--------------------------------------------------------------------------- +% etpf-msgq ErlMessageQueue* +% +% Same as 'etp-msgq' but print the messages using etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-stacktrace +# Args: Process* +# +# Non-reentrant +# + set $etp_stacktrace_p = ($arg0)->stop + set $etp_stacktrace_end = ($arg0)->hend + printf "%% Stacktrace (%u): ", $etp_stacktrace_end-$etp_stacktrace_p + etp ($arg0)->cp + while $etp_stacktrace_p < $etp_stacktrace_end + if ($etp_stacktrace_p[0] & 0x3) == 0x0 + # Continuation pointer + etp $etp_stacktrace_p[0] + end + set $etp_stacktrace_p++ + end +end + +document etp-stacktrace +%--------------------------------------------------------------------------- +% etp-stacktrace Process* +% +% Take an Process* and print a stactrace for the process. +% The stacktrace consists just of the pushed code continuation +% pointers on the stack, the most recently pushed first. +%--------------------------------------------------------------------------- +end + +define etp-stackdump +# Args: Process* +# +# Non-reentrant +# + set $etp_stackdump_p = ($arg0)->stop + set $etp_stackdump_end = ($arg0)->hend + printf "%% Stackdump (%u): ", $etp_stackdump_end-$etp_stackdump_p + etp ($arg0)->cp + while $etp_stackdump_p < $etp_stackdump_end + etp $etp_stackdump_p[0] + set $etp_stackdump_p++ + end +end + +document etp-stackdump +%--------------------------------------------------------------------------- +% etp-stackdump Process* +% +% Take an Process* and print a stackdump for the process. +% The stackdump consists of all pushed values on the stack. +% All code continuation pointers are preceeded with a line +% of dashes to make the stack frames more visible. +%--------------------------------------------------------------------------- +end + +define etpf-stackdump +# Args: Process* +# +# Non-reentrant +# + set $etp_flat = 1 + etp-stackdump ($arg0) + set $etp_flat = 0 +end + +document etpf-stackdump +%--------------------------------------------------------------------------- +% etpf-stackdump Process* +% +% Same as etp-stackdump but print the values using etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-dictdump +# Args: ProcDict* +# +# Non-reentrant +# + set $etp_dictdump = ($arg0) + if $etp_dictdump + set $etp_dictdump_n = \ + $etp_dictdump->homeSize + $etp_dictdump->splitPosition + set $etp_dictdump_i = 0 + set $etp_dictdump_written = 0 + if $etp_dictdump_n > $etp_dictdump->size + set $etp_dictdump_n = $etp_dictdump->size + end + set $etp_dictdump_cnt = $etp_dictdump->numElements + printf "%% Dictionary (%d):\n[", $etp_dictdump_cnt + while $etp_dictdump_i < $etp_dictdump_n && \ + $etp_dictdump_cnt > 0 + set $etp_dictdump_p = $etp_dictdump->data[$etp_dictdump_i] + if $etp_dictdump_p != $etp_nil + if ((Eterm)$etp_dictdump_p & 0x3) == 0x2 + # Boxed + if $etp_dictdump_written + printf ",\n " + else + set $etp_dictdump_written = 1 + end + etp-1 $etp_dictdump_p 0 + set $etp_dictdump_cnt-- + else + while ((Eterm)$etp_dictdump_p & 0x3) == 0x1 && \ + $etp_dictdump_cnt > 0 + # Cons ptr + if $etp_dictdump_written + printf ",\n " + else + set $etp_dictdump_written = 1 + end + etp-1 (((Eterm*)((Eterm)$etp_dictdump_p&~0x3))[0]) 0 + set $etp_dictdump_cnt-- + set $etp_dictdump_p = ((Eterm*)((Eterm)$etp_dictdump_p & ~0x3))[1] + end + if $etp_dictdump_p != $etp_nil + printf "#DictSlotError<%d>:", $etp_dictdump_i + set $etp_dictdump_flat = $etp_flat + set $etp_flat = 1 + etp-1 ((Eterm)$etp_dictdump_p) 0 + set $etp_flat = $etp_dictdump_flat + end + end + end + set $etp_dictdump_i++ + end + if $etp_dictdump_cnt != 0 + printf "#DictCntError<%d>, ", $etp_dictdump_cnt + end + else + printf "%% Dictionary (0):\n[" + end + printf "].\n" +end + +document etp-dictdump +%--------------------------------------------------------------------------- +% etp-dictdump ErlProcDict* +% +% Take an ErlProcDict* and print all entries in the process dictionary. +%--------------------------------------------------------------------------- +end + +define etpf-dictdump +# Args: ErlProcDict* +# +# Non-reentrant +# + set $etp_flat = 1 + etp-dictdump ($arg0) + set $etp_flat = 0 +end + +document etpf-dictdump +%--------------------------------------------------------------------------- +% etpf-dictdump ErlProcDict* +% +% Same as etp-dictdump but print the values using etpf (flat). +%--------------------------------------------------------------------------- +end + + + +define etp-offheapdump +# Args: ( ExternalThing* | ProcBin* | ErlFunThing* ) +# +# Non-reentrant +# + set $etp_offheapdump_p = ($arg0) + set $etp_offheapdump_i = 0 + set $etp_offheapdump_ + printf "%% Offheap dump:\n[" + while ($etp_offheapdump_p != 0) && ($etp_offheapdump_i < $etp_max_depth) + if ((Eterm)$etp_offheapdump_p & 0x3) == 0x0 + if $etp_offheapdump_i > 0 + printf ",\n " + end + etp-1 ((Eterm)$etp_offheapdump_p|0x2) 0 + set $etp_offheapdump_p = $etp_offheapdump_p->next + set $etp_offheapdump_i++ + else + printf "#TaggedPtr<%#x>", $etp_offheapdump_p + set $etp_offheapdump_p = 0 + end + end + printf "].\n" +end + +document etp-offheapdump +%--------------------------------------------------------------------------- +% etp-offheapdump ( ExternalThing* | ProcBin* | ErlFunThing* ) +% +% Take an pointer to a linked list and print the terms in the list +% up to the max depth. +%--------------------------------------------------------------------------- +end + +define etpf-offheapdump +# Args: ( ExternalThing* | ProcBin* | ErlFunThing* ) +# +# Non-reentrant +# + set $etp_flat = 1 + etp-offheapdump ($arg0) + set $etp_flat = 0 +end + +document etpf-offheapdump +%--------------------------------------------------------------------------- +% etpf-offheapdump ( ExternalThing* | ProcBin* | ErlFunThing* ) +% +% Same as etp-offheapdump but print the values using etpf (flat). +%--------------------------------------------------------------------------- +end + +define etp-print-procs +# Args: Eterm +# +# Non-reentrant +# + etp-print-procs-1 +end + +define etp-print-procs-1 +# Args: Eterm* +# +# Non-reentrant +# + set $etp_print_procs_q = erts_max_processes / 10 + set $etp_print_procs_r = erts_max_processes % 10 + set $etp_print_procs_t = 10 + set $etp_print_procs_m = $etp_print_procs_q + if $etp_print_procs_r > 0 + set $etp_print_procs_m++ + set $etp_print_procs_r-- + end + set $etp_print_procs_i = 0 + set $etp_print_procs_found = 0 + while $etp_print_procs_i < erts_max_processes + if process_tab[$etp_print_procs_i] + printf "%d: ", $etp_print_procs_i + etp-1 process_tab[$etp_print_procs_i]->id + printf " " + etp-1 ((Eterm)(process_tab[$etp_print_procs_i]->i)) + printf " heap=%d/%d(%d)", process_tab[$etp_print_procs_i]->htop - process_tab[$etp_print_procs_i]->heap, \ + process_tab[$etp_print_procs_i]->hend - process_tab[$etp_print_procs_i]->heap, \ + process_tab[$etp_print_procs_i]->hend - process_tab[$etp_print_procs_i]->stop + printf " old=%d/%d ", process_tab[$etp_print_procs_i]->old_htop - process_tab[$etp_print_procs_i]->old_heap, \ + process_tab[$etp_print_procs_i]->old_hend - process_tab[$etp_print_procs_i]->old_heap + printf " mbuf_sz=%d ", process_tab[$etp_print_procs_i]->mbuf_sz + printf " min=%d ", process_tab[$etp_print_procs_i]->min_heap_size + printf " flags=%x ", process_tab[$etp_print_procs_i]->flags + printf " msgs=%d ", process_tab[$etp_print_procs_i]->msg.len + printf "\n" + end + set $etp_print_procs_i++ + if $etp_print_procs_i > $etp_print_procs_m + printf "%% %d%%...\n", $etp_print_procs_t + set $etp_print_procs_t += 10 + set $etp_print_procs_m += $etp_print_procs_q + if $etp_print_procs_r > 0 + set $etp_print_procs_m++ + set $etp_print_procs_r-- + end + end + end + printf "%% 100%%.\n" +end + +document etp-print-procs +%--------------------------------------------------------------------------- +% etp-print-procs Eterm +% +% Print some information about ALL processes. +%--------------------------------------------------------------------------- +end + + +define etp-search-heaps +# Args: Eterm +# +# Non-reentrant +# + printf "%% Search all (<%u) process heaps for ", erts_max_processes + set $etp_flat = 1 + etp-1 ($arg0) 0 + set $etp_flat = 0 + printf ":...\n" + etp-search-heaps-1 ((Eterm*)((Eterm)($arg0)&~3)) +end + +define etp-search-heaps-1 +# Args: Eterm* +# +# Non-reentrant +# + set $etp_search_heaps_q = erts_max_processes / 10 + set $etp_search_heaps_r = erts_max_processes % 10 + set $etp_search_heaps_t = 10 + set $etp_search_heaps_m = $etp_search_heaps_q + if $etp_search_heaps_r > 0 + set $etp_search_heaps_m++ + set $etp_search_heaps_r-- + end + set $etp_search_heaps_i = 0 + set $etp_search_heaps_found = 0 + while $etp_search_heaps_i < erts_max_processes + if process_tab[$etp_search_heaps_i] + if (process_tab[$etp_search_heaps_i]->heap <= ($arg0)) && \ + (($arg0) < process_tab[$etp_search_heaps_i]->hend) + printf "process_tab[%d]->heap+%d\n", $etp_search_heaps_i, \ + ($arg0)-process_tab[$etp_search_heaps_i]->heap + end + if (process_tab[$etp_search_heaps_i]->old_heap <= ($arg0)) && \ + (($arg0) <= process_tab[$etp_search_heaps_i]->old_hend) + printf "process_tab[%d]->old_heap+%d\n", $etp_search_heaps_i, \ + ($arg0)-process_tab[$etp_search_heaps_i]->old_heap + end + set $etp_search_heaps_cnt = 0 + set $etp_search_heaps_p = process_tab[$etp_search_heaps_i]->mbuf + while $etp_search_heaps_p && ($etp_search_heaps_cnt < $etp_max_depth) + set $etp_search_heaps_cnt++ + if (&($etp_search_heaps_p->mem) <= ($arg0)) && \ + (($arg0) < &($etp_search_heaps_p->mem)+$etp_search_heaps_p->size) + printf "process_tab[%d]->mbuf(%d)+%d\n", \ + $etp_search_heaps_i, $etp_search_heaps_cnt, \ + ($arg0)-&($etp_search_heaps_p->mem) + end + set $etp_search_heaps_p = $etp_search_heaps_p->next + end + if $etp_search_heaps_p + printf "process_tab[%d] %% Too many HeapFragments\n", \ + $etp_search_heaps_i + end + end + set $etp_search_heaps_i++ + if $etp_search_heaps_i > $etp_search_heaps_m + printf "%% %d%%...\n", $etp_search_heaps_t + set $etp_search_heaps_t += 10 + set $etp_search_heaps_m += $etp_search_heaps_q + if $etp_search_heaps_r > 0 + set $etp_search_heaps_m++ + set $etp_search_heaps_r-- + end + end + end + printf "%% 100%%.\n" +end + +document etp-search-heaps +%--------------------------------------------------------------------------- +% etp-search-heaps Eterm +% +% Search all process heaps in process_tab[], including the heap fragments +% (process_tab[]->mbuf) for the specified Eterm. +%--------------------------------------------------------------------------- +end + + + +define etp-search-alloc +# Args: Eterm +# +# Non-reentrant +# + printf "%% Search allocated memory blocks for " + set $etp_flat = 1 + etp-1 ($arg0) 0 + set $etp_flat = 0 + printf ":...\n" + set $etp_search_alloc_n = sizeof(erts_allctrs) / sizeof(*erts_allctrs) + set $etp_search_alloc_i = 0 + while $etp_search_alloc_i < $etp_search_alloc_n + if erts_allctrs[$etp_search_alloc_i].alloc + set $etp_search_alloc_f = (erts_allctrs+$etp_search_alloc_i) + while ($etp_search_alloc_f->alloc == debug_alloc) || \ + ($etp_search_alloc_f->alloc == stat_alloc) || \ + ($etp_search_alloc_f->alloc == map_stat_alloc) + set $etp_search_alloc_f = \ + (ErtsAllocatorFunctions_t*)$etp_search_alloc_f->extra + end + if ($etp_search_alloc_f->alloc != erts_sys_alloc) && \ + ($etp_search_alloc_f->alloc != erts_fix_alloc) + if ($etp_search_alloc_f->alloc == erts_alcu_alloc) || \ + ($etp_search_alloc_f->alloc == erts_alcu_alloc_ts) + # alcu alloc + set $etp_search_alloc_e = (Allctr_t*)$etp_search_alloc_f->extra + # mbc_list + set $etp_search_alloc_p = $etp_search_alloc_e->mbc_list.first + set $etp_search_alloc_cnt = 0 + while $etp_search_alloc_p && \ + ($etp_search_alloc_cnt < $etp_max_depth) + set $etp_search_alloc_cnt++ + if $etp_search_alloc_p <= ($arg0) && \ + ($arg0) < (char*)$etp_search_alloc_p + \ + ($etp_search_alloc_p->chdr & (Uint)~7) + printf "erts_allctrs[%d] %% %salloc: mbc_list: %d\n", \ + $etp_search_alloc_i, $etp_search_alloc_e->name_prefix, \ + $etp_search_alloc_cnt + end + if $etp_search_alloc_p == $etp_search_alloc_e->mbc_list.last + if $etp_search_alloc_p->next + printf \ + "erts_allctrs[%d] %% %salloc: mbc_list.last error %p\n",\ + $etp_search_alloc_i, $etp_search_alloc_e->name_prefix,\ + $etp_search_alloc_p + end + set $etp_search_alloc_p = 0 + else + set $etp_search_alloc_p = $etp_search_alloc_p->next + end + end + if $etp_search_alloc_p + printf "erts_allctrs[%d] %% %salloc: too large mbc_list %p\n", \ + $ept_search_alloc_i, $etp_search_alloc_e->name_prefix, + $ept_search_alloc_p + end + # sbc_list + set $etp_search_alloc_p = $etp_search_alloc_e->sbc_list.first + set $etp_search_alloc_cnt = 0 + while $etp_search_alloc_p && \ + ($etp_search_alloc_cnt < $etp_max_depth) + set $etp_search_alloc_cnt++ + if $etp_search_alloc_p <= ($arg0) && \ + ($arg0) < (char*)$etp_search_alloc_p + \ + ($etp_search_alloc_p->chdr & (Uint)~7) + printf "erts_allctrs[%d] %% %salloc: sbc_list: %d\n", \ + $etp_search_alloc_i, $etp_search_alloc_e->name_prefix, \ + $etp_search_alloc_cnt + end + if $etp_search_alloc_p == $etp_search_alloc_e->sbc_list.last + if $etp_search_alloc_p->next + printf \ + "erts_allctrs[%d] %% %salloc: sbc_list.last error %p",\ + $etp_search_alloc_i, $etp_search_alloc_e->name_prefix,\ + $etp_search_alloc_p + end + set $etp_search_alloc_p = 0 + else + set $etp_search_alloc_p = $etp_search_alloc_p->next + end + end + if $etp_search_alloc_p + printf "erts_allctrs[%d] %% %salloc: too large sbc_list %p\n", \ + $ept_search_alloc_i, $etp_search_alloc_e->name_prefix, + $ept_search_alloc_p + end + else + printf "erts_allctrs[%d] %% %s: unknown allocator\n", \ + $etp_search_alloc_i, erts_alc_a2ad[$etp_search_alloc_i] + end + end + end + set $etp_search_alloc_i++ + end +end + +document etp-search-alloc +%--------------------------------------------------------------------------- +% etp-search-heaps Eterm +% +% Search all internal allocator memory blocks for for the specified Eterm. +%--------------------------------------------------------------------------- +end + + + +define etp-overlapped-heaps +# Args: +# +# Non-reentrant +# + printf "%% Dumping heap addresses to \"etp-commands.bin\"\n" + set $etp_overlapped_heaps_q = erts_max_processes / 10 + set $etp_overlapped_heaps_r = erts_max_processes % 10 + set $etp_overlapped_heaps_t = 10 + set $etp_overlapped_heaps_m = $etp_overlapped_heaps_q + if $etp_overlapped_heaps_r > 0 + set $etp_overlapped_heaps_m++ + set $etp_overlapped_heaps_r-- + end + set $etp_overlapped_heaps_i = 0 + set $etp_overlapped_heaps_found = 0 + dump binary value etp-commands.bin 'o' + append binary value etp-commands.bin 'v' + append binary value etp-commands.bin 'e' + append binary value etp-commands.bin 'r' + append binary value etp-commands.bin 'l' + append binary value etp-commands.bin 'a' + append binary value etp-commands.bin 'p' + append binary value etp-commands.bin 'p' + append binary value etp-commands.bin 'e' + append binary value etp-commands.bin 'd' + append binary value etp-commands.bin '-' + append binary value etp-commands.bin 'h' + append binary value etp-commands.bin 'e' + append binary value etp-commands.bin 'a' + append binary value etp-commands.bin 'p' + append binary value etp-commands.bin 's' + append binary value etp-commands.bin '\0' + while $etp_overlapped_heaps_i < erts_max_processes + if process_tab[$etp_overlapped_heaps_i] + append binary value etp-commands.bin \ + (Eterm)$etp_overlapped_heaps_i + append binary value etp-commands.bin \ + (Eterm)process_tab[$etp_overlapped_heaps_i]->heap + append binary value etp-commands.bin \ + (Eterm)process_tab[$etp_overlapped_heaps_i]->hend + append binary value etp-commands.bin \ + (Eterm)process_tab[$etp_overlapped_heaps_i]->old_heap + append binary value etp-commands.bin \ + (Eterm)process_tab[$etp_overlapped_heaps_i]->old_hend + set $etp_overlapped_heaps_p = process_tab[$etp_overlapped_heaps_i]->mbuf + set $etp_overlapped_heaps_cnt = 0 + while $etp_overlapped_heaps_p && \ + ($etp_overlapped_heaps_cnt < $etp_max_depth) + set $etp_overlapped_heaps_cnt++ + append binary value etp-commands.bin \ + (Eterm)$etp_overlapped_heaps_p + append binary value etp-commands.bin \ +(Eterm)(&($etp_overlapped_heaps_p->mem)+$etp_overlapped_heaps_p->size) + set $etp_overlapped_heaps_p = $etp_overlapped_heaps_p->next + end + if $etp_overlapped_heaps_p + printf "process_tab[%d] %% Too many HeapFragments\n", \ + $etp_overlapped_heaps_i + end + append binary value etp-commands.bin (Eterm)0x0 + append binary value etp-commands.bin (Eterm)0x0 + end + set $etp_overlapped_heaps_i++ + if $etp_overlapped_heaps_i > $etp_overlapped_heaps_m + printf "%% %d%%...\n", $etp_overlapped_heaps_t + set $etp_overlapped_heaps_t += 10 + set $etp_overlapped_heaps_m += $etp_overlapped_heaps_q + if $etp_overlapped_heaps_r > 0 + set $etp_overlapped_heaps_m++ + set $etp_overlapped_heaps_r-- + end + end + end + etp-run +end + +document etp-overlapped-heaps +%--------------------------------------------------------------------------- +% etp-overlapped-heaps +% +% Dump all process heap addresses in process_tab[], including +% the heap fragments in binary format on the file etp-commands.bin. +% Then call etp_commands:file/1 to analyze if any heaps overlap. +% +% Requires 'erl' in the path and 'etp_commands.beam' in 'erl's search path. +%--------------------------------------------------------------------------- +end + + + +define etp-chart +# Args: Process* +# +# Non-reentrant + etp-chart-start ($arg0) + set ($arg0) = ($arg0) + etp-msgq (($arg0)->msg) + etp-stackdump ($arg0) + etp-dictdump (($arg0)->dictionary) + etp-dictdump (($arg0)->debug_dictionary) + printf "%% Dumping other process data...\n" + etp ($arg0)->seq_trace_token + etp ($arg0)->fvalue + printf "%% Dumping done.\n" + etp-chart-print +end + +document etp-chart +%--------------------------------------------------------------------------- +% etp-chart Process* +% +% Dump all process data to the file "etp-commands.bin" and then use +% the Erlang support module to print a memory chart of all terms. +%--------------------------------------------------------------------------- +end + + + +define etp-chart-start +# Args: Process* +# +# Non-reentrant + set $etp_chart = 1 + set $etp_chart_id = 0 + set $etp_chart_start_p = ($arg0) + dump binary value etp-commands.bin 'c' + append binary value etp-commands.bin 'h' + append binary value etp-commands.bin 'a' + append binary value etp-commands.bin 'r' + append binary value etp-commands.bin 't' + append binary value etp-commands.bin '\0' + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->heap) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->high_water) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->hend) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->old_heap) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->old_hend) + set $etp_chart_start_cnt = 0 + set $etp_chart_start_p = $etp_chart_start_p->mbuf + while $etp_chart_start_p && ($etp_chart_start_cnt < $etp_max_depth) + set $etp_chart_start_cnt++ + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->mem) + append binary value etp-commands.bin (Eterm)($etp_chart_start_p->size) + set $etp_chart_start_p = $etp_chart_start_p->next + end + append binary value etp-commands.bin (Eterm)(0) + append binary value etp-commands.bin (Eterm)(0) + if $etp_chart_start_p + printf "%% Too many HeapFragments\n" + end +end + +document etp-chart-start +%--------------------------------------------------------------------------- +% etp-chart-start Process* +% +% Dump a chart head to the file "etp-commands.bin". +%--------------------------------------------------------------------------- +end + + + +define etp-chart-entry-1 +# Args: Eterm, int depth, int words +# +# Reentrant capable + if ($arg1) == 0 + set $etp_chart_id++ + printf "#%d:", $etp_chart_id + end + append binary value etp-commands.bin ($arg0)&~0x3 + append binary value etp-commands.bin (Eterm)(($arg2)*sizeof(Eterm)) + append binary value etp-commands.bin (Eterm)$etp_chart_id + append binary value etp-commands.bin (Eterm)($arg1) +# printf "", ($arg0)&~0x3, \ +# (Eterm)(($arg2)*sizeof(Eterm)), (Eterm)$etp_chart_id, (Eterm)($arg1) +end + + + +define etp-chart-print + set $etp_chart = 0 + etp-run +end + +document etp-chart-print +%--------------------------------------------------------------------------- +% etp-chart-print Process* +% +% Print a memory chart of the dumped data in "etp-commands.bin", and stop +% chart recording. +%--------------------------------------------------------------------------- +end + +############################################################################ +# ETS table debug +# + +define etp-ets-tables +# Args: +# +# Non-reentrant + printf "%% Dumping < %lu ETS tables\n", (unsigned long)db_max_tabs + while $etp_ets_tables_i < db_max_tabs + if (meta_main_tab[$etp_ets_tables_i].u.next_free & 3) == 0 + printf "%% %d:", $etp_ets_tables_i + etp-1 ((Eterm)(meta_main_tab[$etp_ets_tables_i].u.tb->common.id)) 0 + printf " " + etp-1 ((Eterm)(meta_main_tab[$etp_ets_tables_i].u.tb->common.owner)) 0 + printf "\n" + end + set $etp_ets_tables_i++ + end + set $etp_ets_tables_i = 0 +end + +document etp-ets-tables +%--------------------------------------------------------------------------- +% etp-ets-tables +% +% Dump all ETS table names and their indexies. +%--------------------------------------------------------------------------- +end + +define etp-ets-tabledump +# Args: int tableindex +# +# Non-reentrant + printf "%% Dumping ETS table %d:", ($arg0) + set $etp_ets_tabledump_n = 0 + set $etp_ets_tabledump_t = meta_main_tab[($arg0)].u.tb + set $etp_ets_tabledump_i = 0 + etp-1 ($etp_ets_tabledump_t->common.the_name) 0 + printf " status=%#x\n", $etp_ets_tabledump_t->common.status + if $etp_ets_tabledump_t->common.status & 0x130 + # Hash table + set $etp_ets_tabledump_h = $etp_ets_tabledump_t->hash + printf "%% nitems=%d\n", $etp_ets_tabledump_t->common.nitems + while $etp_ets_tabledump_i < $etp_ets_tabledump_h->nactive + set $etp_ets_tabledump_l = $etp_ets_tabledump_h->seg \ + [$etp_ets_tabledump_i>>8][$etp_ets_tabledump_i&0xFF] + if $etp_ets_tabledump_l + printf "%% Slot %d:\n", $etp_ets_tabledump_i + while $etp_ets_tabledump_l + if $etp_ets_tabledump_n + printf "," + else + printf "[" + end + set $etp_ets_tabledump_n++ + etp-1 ((Eterm)($etp_ets_tabledump_l->dbterm.tpl)|0x2) 0 + if $etp_ets_tabledump_l->hvalue == ((unsigned long)-1) + printf "% *\n" + else + printf "\n" + end + set $etp_ets_tabledump_l = $etp_ets_tabledump_l->next + if $etp_ets_tabledump_n >= $etp_max_depth + set $etp_ets_tabledump_l = 0 + end + end + end + set $etp_ets_tabledump_i++ + end + if $etp_ets_tabledump_n + printf "].\n" + end + else + printf "%% Not a hash table\n" + end +end + +document etp-ets-tabledump +%--------------------------------------------------------------------------- +% etp-ets-tabledump Slot +% +% Dump an ETS table with a specified slot index. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Erlang support module handling +# + +define etp-run + shell make -f "${ROOTDIR:?}/erts/etc/unix/etp_commands.mk" \ + ROOTDIR="${ROOTDIR:?}" ETP_DATA="etp-commands.bin" +end + +document etp-run +%--------------------------------------------------------------------------- +% etp-run +% +% Make and run the Erlang support module on the input file +% "erl-commands.bin". The environment variable ROOTDIR must +% be set to find $ROOTDIR/erts/etc/unix/etp_commands.mk. +% +% Also, erl and erlc must be in the path. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Toolbox parameter handling +# + +define etp-set-max-depth + if ($arg0) > 0 + set $etp_max_depth = ($arg0) + else + echo %%%Error: max-depth <= 0 %%%\n + end +end + +document etp-set-max-depth +%--------------------------------------------------------------------------- +% etp-set-max-depth Depth +% +% Set the max term depth to use for etp. The term dept limit +% works in both depth and width, so if you set the max depth to 10, +% an 11 element flat tuple will be truncated. +%--------------------------------------------------------------------------- +end + +define etp-set-max-string-length + if ($arg0) > 0 + set $etp_max_string_length = ($arg0) + else + echo %%%Error: max-string-length <= 0 %%%\n + end +end + +document etp-set-max-string-length +%--------------------------------------------------------------------------- +% etp-set-max-strint-length Length +% +% Set the max string length to use for ept when printing lists +% that can be shown as printable strings. Printable strings +% that are longer will be truncated, and not even checked if +% they really are printable all the way to the end. +%--------------------------------------------------------------------------- +end + +define etp-show + printf "etp-set-max-depth %d\n", $etp_max_depth + printf "etp-set-max-string-length %d\n", $etp_max_string_length +end + +document etp-show +%--------------------------------------------------------------------------- +% etp-show +% +% Show the commands needed to set all etp parameters +% to their current value. +%--------------------------------------------------------------------------- +end + +############################################################################ +# Init +# + +define etp-init + set $etp_arch64 = (sizeof(void *) == 8) + if $etp_arch64 + set $etp_nil = 0xfffffffffffffffb + else + set $etp_nil = 0xfffffffb + end + set $etp_flat = 0 + set $etp_chart_id = 0 + set $etp_chart = 0 + + set $etp_max_depth = 20 + set $etp_max_string_length = 100 + + set $etp_ets_tables_i = 0 +end + +document etp-init +%--------------------------------------------------------------------------- +% Use etp-help for a command overview and general help. +% +% To use the Erlang support module, the environment variable ROOTDIR +% must be set to the toplevel installation directory of Erlang/OTP, +% so the etp-commands file becomes: +% $ROOTDIR/erts/etc/unix/etp-commands +% Also, erl and erlc must be in the path. +%--------------------------------------------------------------------------- +end + + +etp-init +help etp-init +etp-show diff --git a/erts/etc/unix/etp_commands.erl b/erts/etc/unix/etp_commands.erl new file mode 100644 index 0000000000..66cb76edbc --- /dev/null +++ b/erts/etc/unix/etp_commands.erl @@ -0,0 +1,173 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(etp_commands). + +-export([file/1]). + +file([Fname]) -> + Result = (catch file_1(Fname)), + io:format("% ~p~n", [Result]), + init:stop(). + +file_1(Fname) -> + io:format("% Reading ~p...~n", [Fname]), + {ok,Fd} = file:open(Fname, [read,binary]), + case read_op(Fd, 128) of + "chart" -> + io:format("% Reading heap chart data...~n"), + chart_scan(Fd); + "overlapped-heaps" -> + io:format("% Reading overlapped-heaps data...~n"), + overlapped_scan(Fd) + end. + +read_op(_Fd, 0) -> + []; +read_op(Fd, N) -> + case file:read(Fd, 1) of + {ok,<<0>>} -> []; + {ok,<>} -> [C|read_op(Fd, N-1)] + end. + + + +overlapped_scan(Fd) -> + overlapped_scan_1(Fd, []). + +overlapped_scan_1(Fd, R) -> + case file:read(Fd, 4*5) of + eof -> + io:format("% Analyzing overlaps...~n"), + overlapped_analyze(lists:sort(R)); + {ok,<>} + when Heap < Hend -> + overlapped_scan_to_0(Fd, [{{Heap,Hend},{Id,heap}}|R], Id, 1); + {ok,<>} + when Heap < Hend, OldHeap < OldHend-> + overlapped_scan_to_0(Fd, [{{Heap,Hend},{Id,heap}}, + {{OldHeap,OldHend},{Id,old_heap}}|R], + Id, 1) + end. + +overlapped_scan_to_0(Fd, R, Id, Cnt) -> + case file:read(Fd, 4*2) of + {ok,<<0:32/native,0:32/native>>} -> + overlapped_scan_1(Fd, R); + {ok,<>} + when Heap < Hend -> + overlapped_scan_to_0(Fd, + [{{Heap,Hend},{Id,{heap_fragment,Cnt}}}|R], + Id, Cnt+1); + eof -> + io:format("% Premature end of dump: ~p~n", [Id,Cnt|R]) + end. + +overlapped_analyze([]) -> + io:format("% Oops! was that file empty?~n"); +overlapped_analyze([{{_,Hend1},_}|[{{Heap2,_},_}|_]=R]) + when Hend1 =< Heap2 -> + overlapped_analyze(R); +overlapped_analyze([{Addrs1,Tag1}|[{Addrs2,Tag2}|_]=R]) -> + io:format("% ~p overlaps ~p (~p,~p)~n", [Tag1,Tag2,Addrs1,Addrs2]), + overlapped_analyze(R); +overlapped_analyze([_]) -> + io:format("% End of overlaps~n"). + + +chart_scan(Fd) -> + {ok,<>} = file:read(Fd, 4*5), + chart_scan_1(Fd, + [{Heap,Heap,heap,0}, + {HighWater,HighWater,high_water,0}, + {Hend,Hend,hend,0}, + {OldHeap,OldHeap,old_heap,0}, + {OldHend,OldHend,old_hend,0}|chart_scan_hdr(Fd)]). + +chart_scan_hdr(Fd) -> + chart_scan_hdr_2(0, chart_scan_hdr_1(Fd)). + +chart_scan_hdr_1(Fd) -> + case file:read(Fd, 4*2) of + eof -> []; + {ok,<<0:32/native,0:32/native>>} -> []; + {ok,<>} -> + [{Start,Size}|chart_scan_hdr_1(Fd)] + end. + +chart_scan_hdr_2(_N, []) -> []; +chart_scan_hdr_2(N, [{Start,End}|T]) when Start =< End -> + [{Start,Start,{heap_frag,N},0},{End,End,{heap_frag_end,N},0} + |chart_scan_hdr_2(N+1, T)]. + +chart_scan_1(Fd, R) -> + case file:read(Fd, 4*4) of + eof -> + io:format("% Analyzing heap chart...~n"), + chart_analyze(lists:sort(R)); + {ok, + <>} -> + chart_scan_1(Fd, [{Addr,Addr+Size,Id,Depth}|R]) + end. + +%-define(raw_chart_dump, 1). +-ifdef(raw_chart_dump). + +chart_analyze([]) -> + io:format("% End of chart~n"); +chart_analyze([{S,E,Id,D}|R]) -> + io:format("% ~.16x-~.16x: ~w[~w]~n", + [S,"0x",E,"0x",Id,D]), + chart_analyze(R). + +-else. + +chart_analyze([]) -> + io:format("% ***Oops, was chart empty?***~n"); +chart_analyze([{S,_,Id,D}=X|R]) -> + io:format("% ~.16x: ~w[~w", [S,"0x",Id,D]), + chart_analyze_1(R, X). + +chart_analyze_1([{S,E,Id,D}=X|R], {S,E,Id,_}) -> + io:format(",~w", [D]), + chart_analyze_1(R, X); +chart_analyze_1([{S,E,Id,D}=X|R], {S,E,_,_}) -> + io:format("],~w[~w", [Id,D]), + chart_analyze_1(R, X); +chart_analyze_1(R, X) -> + io:format("]~n"), + chart_analyze_2(R, X). + +chart_analyze_2([], {_,E,_,_}) -> + io:format("% ~.16x: End of chart~n", [E,"0x"]); +chart_analyze_2([{S,_,_,_}|_]=R, {_,E,_,_}) -> + if E == S -> + chart_analyze(R); + E < S -> + io:format("% ~.16x:~n", [E,"0x"]), + chart_analyze(R); + true -> + io:format("% ~.16x: ***Overlap***~n", [E,"0x"]), + chart_analyze(R) + end. + +-endif. diff --git a/erts/etc/unix/etp_commands.mk b/erts/etc/unix/etp_commands.mk new file mode 100644 index 0000000000..1d9a269b68 --- /dev/null +++ b/erts/etc/unix/etp_commands.mk @@ -0,0 +1,27 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +MAKE_AND_EXECUTE_ETP_COMMANDS : $(ETP_DATA) etp_commands.beam + erl -noshell -run etp_commands file "$(ETP_DATA)" + +.PHONY : MAKE_AND_EXECUTE_ETP_COMMANDS + +etp_commands.beam : $(ROOTDIR)/erts/etc/unix/etp_commands.erl $(ROOTDIR)/erts/etc/unix/etp_commands.mk + erlc $(ROOTDIR)/erts/etc/unix/etp_commands.erl + diff --git a/erts/etc/unix/format_man_pages b/erts/etc/unix/format_man_pages new file mode 100644 index 0000000000..2c4f6eee4f --- /dev/null +++ b/erts/etc/unix/format_man_pages @@ -0,0 +1,149 @@ +#!/bin/sh +# +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Format man_pages +# + +ERL_ROOT=$1 + +echo "Formatting manual pages (this may take a while...)" + +if [ -z "$ERL_ROOT" -o ! -d "$ERL_ROOT" ] +then + echo "Install: need ERL_ROOT directory as argument" + exit 1 +fi + +if [ `echo $ERL_ROOT | awk '{ print substr($1,1,1) }'` != "/" ] +then + echo "Install: need an absolute path to ERL_ROOT" + exit 1 +fi + +# +# Fetch target system. +# +SYS=`(uname -s) 2>/dev/null` || SYS=unknown +REL=`(uname -r) 2>/dev/null` || REL=unknown +case $SYS:$REL in + SunOS:5.*) + TARGET=sunos5 ;; + Linux:*) + TARGET=linux ;; + Darwin:9.*) + TARGET=darwin ;; + OpenBSD:3.*) + TARGET=openbsd ;; + *) + TARGET="" ;; +esac + +# +# Create the 'cat' directories (probably not needed) +# + +cd $ERL_ROOT + +if [ ! -d man/cat1 ] +then + mkdir man/cat1 +fi + +if [ ! -d man/cat3 ] +then + mkdir man/cat3 +fi + +if [ ! -d man/cat4 ] +then + mkdir man/cat4 +fi + +if [ ! -d man/cat6 ] +then + mkdir man/cat6 +fi + +# +# Cleanup old formatting +# + +cd $ERL_ROOT/man + +rm -f whatis windex + +# Remove old cat files +rm -f cat*/*.[0-9]* *.txt + +# +# Create new formatted pages +# + +case :"$TARGET" in +:linux|:darwin) + # Do not build whatis database, since makewhatis can only run by root + # echo "whatis database not created, since makewhatis can only be run by root." + ## We would have run + ## /usr/sbin/makewhatis -v $ERL_ROOT/man -c $ERL_ROOT/man > /dev/null 2>&1 + + if [ ! -x /usr/bin/groff ]; then + echo "Cannot find groff - no formating of manual pages" + exit + fi + + echo "Creating cat files ..." + + # Create cat files + for dir in man* + do + cd $dir + for file in *.[0-9]* + do + if [ -f $file ]; then + name=`echo $file | sed 's/\.[^.]*$//'` + sec=`echo $file | sed 's/.*\.//'` + /usr/bin/groff -Tascii -mandoc $ERL_ROOT/man/man$sec/$file \ + > $ERL_ROOT/man/cat$sec/$file + fi + done + cd .. + done + ;; +:*) + if [ -f "/vmunix" ]; then + CATMAN=/usr/etc/catman + elif [ "$TARGET" = "openbsd" ]; then + CATMAN=/usr/sbin/catman + else + CATMAN=/usr/bin/catman + fi + + if [ "$TARGET" = "sunos5" ] + then + # Special processing of footer + rm -f /tmp/erltmac_an + sed 's/Last change://g' /usr/share/lib/tmac/an > /tmp/erltmac_an + $CATMAN -M $ERL_ROOT/man -T /tmp/erltmac_an > /dev/null 2>&1 + rm -f /tmp/erltmac_an + fi + + $CATMAN -M $ERL_ROOT/man > /dev/null 2>&1 + ;; +esac diff --git a/erts/etc/unix/makewhatis b/erts/etc/unix/makewhatis new file mode 100644 index 0000000000..047c6efdfa --- /dev/null +++ b/erts/etc/unix/makewhatis @@ -0,0 +1,327 @@ +#!/bin/sh +# makewhatis: create the whatis database +# Created: Sun Jun 14 10:49:37 1992 +# Revised: Sat Jan 8 14:12:37 1994 by faith@cs.unc.edu +# Revised: Sat Mar 23 17:56:18 1996 by micheal@actrix.gen.nz +# Copyright 1992, 1993, 1994 Rickard E. Faith (faith@cs.unc.edu) +# May be freely distributed and modified as long as copyright is retained. +# +# Wed Dec 23 13:27:50 1992: Rik Faith (faith@cs.unc.edu) applied changes +# based on Mitchum DSouza (mitchum.dsouza@mrc-apu.cam.ac.uk) cat patches. +# Also, cleaned up code and make it work with NET-2 doc pages. +# +# makewhatis-1.4: aeb 940802, 941007, 950417 +# Fixed so that the -c option works correctly for the cat pages +# on my machine. Fix for -u by Nan Zou (nan@ksu.ksu.edu). +# Many minor changes. +# The -s option is undocumented, and may well disappear again. +# +# Sat Mar 23 1996: Michael Hamilton (michael@actrix.gen.nz). +# I changed the script to invoke gawk only once for each directory tree. +# This speeds things up considerably (from 30 minutes down to 1.5 minutes +# on my 486DX66). +# 960401 - aeb: slight adaptation to work correctly with cat pages. +# 960510 - added fixes by brennan@raven.ca.boeing.com, author of mawk. +# 971012 - replaced "test -z" - it doesnt work on SunOS 4.1.3_U1. +# 980710 - be more careful with TMPFILE +# +# Note for Slackware users: "makewhatis -v -w -c" will work. + +# %ExternalCopyright% +PATH=/usr/bin:/bin + +DEFMANPATH=/usr/man +DEFCATPATH=/usr/man/preformat:/usr/man + +# Find a place for our temporary files. If security is not a concern, use +# TMPFILE=/tmp/whatis$$; TMPFILEDIR=none +# Of course makewhatis should only have the required permissions +# (for reading and writing directories like /usr/man). +# We try here to be careful (and avoid preconstructed symlinks) +# in case makewhatis is run as root, by creating a subdirectory of /tmp. +# If that fails we use $HOME. +# The code below uses test -O which doesnt work on all systems. +TMPFILE=$HOME/whatis$$ +TMPFILEDIR=/tmp/whatis$$ +if [ ! -d $TMPFILEDIR ]; then + mkdir $TMPFILEDIR + chmod 0700 $TMPFILEDIR + if [ -O $TMPFILEDIR ]; then + TMPFILE=$TMPFILEDIR/w + fi +fi + +topath=manpath + +defmanpath=$DEFMANPATH +defcatpath= + +sections="1 2 3 4 5 6 7 8 9 n l" + +for name in $* +do +if [ -n "$setsections" ]; then + setsections= + sections=$name + continue +fi +case $name in + -c) topath=catpath + defmanpath= + defcatpath=$DEFCATPATH + continue;; + -s) setsections=1 + continue;; + -u) findarg="-ctime 0" + update=1 + continue;; + -v) verbose=1 + continue;; + -w) manpath=`man --path` + continue;; + -*) echo "Usage: makewhatis [-u] [-v] [-w] [manpath] [-c [catpath]]" + echo " This will build the whatis database for the man pages" + echo " found in manpath and the cat pages found in catpath." + echo " -u: update database with new pages" + echo " -v: verbose" + echo " -w: use manpath obtained from \`man --path\`" + echo " [manpath]: man directories (default: $DEFMANPATH)" + echo " [catpath]: cat directories (default: the first existing" + echo " directory in $DEFCATPATH)" + exit;; + *) if [ -d $name ] + then + eval $topath="\$$topath":$name + else + echo "No such directory $name" + exit + fi;; +esac +done + +manpath=`echo ${manpath-$defmanpath} | tr : ' '` +if [ x"$catpath" = x ]; then + for d in `echo $defcatpath | tr : ' '` + do + if [ -d $d ]; then catpath=$d; break; fi + done +fi +catpath=`echo ${catpath} | tr : ' '` + +# first truncate all the whatis files that will be created new, +# then only update - we might visit the same directory twice +if [ x$update = x ]; then + for pages in man cat + do + eval path="\$$pages"path + for mandir in $path + do + cp /dev/null $mandir/whatis + done + done +fi + +for pages in man cat +do + export pages + eval path="\$$pages"path + for mandir in $path + do + if [ x$verbose != x ]; then + echo "about to enter $mandir" > /dev/tty + fi + if [ -s ${mandir}/whatis -a $pages = man ]; then + if [ x$verbose != x ]; then + echo skipping $mandir - we did it already > /dev/tty + fi + else + here=`pwd` + cd $mandir + for i in $sections + do + if [ -d ${pages}$i ] + then + cd ${pages}$i + section=$i + export section verbose + find . -name '*' $findarg -print | /usr/bin/gawk ' + + function readline() { + if (use_zcat) { + result = (pipe_cmd | getline); + if (result < 0) { + print "Pipe error: " pipe_cmd " " ERRNO > "/dev/stderr"; + } + } else { + result = (getline < filename); + if (result < 0) { + print "Read file error: " filename " " ERRNO > "/dev/stderr"; + } + } + return result; + } + + function closeline() { + if (use_zcat) { + return close(pipe_cmd); + } else { + return close(filename); + } + } + + function do_one() { + after = 0; insh = 0; thisjoin = 1; charct = 0; + + if (verbose) { + print "adding " filename > "/dev/tty" + } + + use_zcat = (filename ~ /\.Z$/ || filename ~ /\.z$/ || + filename ~ /\.gz$/); + match(filename, "/[^/]+$"); + progname = substr(filename, RSTART + 1, RLENGTH - 1); + if (match(progname, "\\." section "[A-Za-z]+")) { + actual_section = substr(progname, RSTART + 1, RLENGTH - 1); + } else { + actual_section = section; + } + sub(/\..*/, "", progname); + if (use_zcat) { + pipe_cmd = "zcat " filename; + } + + while (readline() > 0) { + gsub(/.\b/, ""); + if (($1 ~ /^\.[Ss][Hh]/ && $2 ~ /[Nn][Aa][Mm][Ee]/) || + (pages == "cat" && $1 ~ /^NAME/)) { + if (!insh) + insh = 1; + else { + printf "\n"; + closeline(); + return; + } + } else if (insh) { + if ($1 ~ /^\.[Ss][HhYS]/ || + (pages == "cat" && + ($1 ~ /^S[yYeE]/ || $1 ~ /^DESCRIPTION/ || + $1 ~ /^COMMAND/ || $1 ~ /^OVERVIEW/ || + $1 ~ /^STRUCTURES/ || $1 ~ /^INTRODUCTION/))) { + # end insh for Synopsis, Syntax, but also for + # DESCRIPTION (e.g., XFree86.1x), + # COMMAND (e.g., xspread.1) + # OVERVIEW (e.g., TclCommandWriting.3) + # STRUCTURES (e.g., XEvent.3x) + # INTRODUCTION (e.g., TclX.n) + printf "\n"; + closeline(); + return; + } else { # derived from Tom Christiansen perl script + if (!after && $0 ~ progname"-") { # Fix old cat pages + sub(progname"-", progname" - "); + } + gsub(/ /, " "); # Translate tabs to spaces + gsub(/ +/, " "); # Collapse spaces + gsub(/ *, */, ", "); # Fix comma spacings + sub(/^ /, ""); # Kill initial spaces + sub(/ $/, ""); # Kill trailing spaces + sub(/__+/, "_"); # Collapse underscores + if ($0 ~ /[^ ]-$/) { + sub(/-$/, ""); # Handle Hyphenations + nextjoin = 1; + } else + nextjoin = 0; + sub(/^.[IB] /, ""); # Kill bold and italics + sub(/^.Nm /, ""); # Kill bold + sub(/^.Tn /, ""); # Kill normal + sub(/^.Li /, ""); # Kill .Li + sub(/^.Dq /, ""); # Kill .Dq + sub(/^.Nd */, "- "); # Convert .Nd to dash + gsub(/\\f[PRIB0123]/, ""); # Kill font changes + gsub(/\\s[-+0-9]*/, ""); # Kill size changes + gsub(/\\&/, ""); # Kill \& + gsub(/\\\((ru|ul)/, "_"); # Translate + gsub(/\\\((mi|hy|em)/, "-"); # Translate + gsub(/\\\*\(../, ""); # Kill troff strings + sub(/^\.\\\".*/, ""); # Kill comments + gsub(/\\/, ""); # Kill all backslashes + if ($1 ~ /^\.../ || $1 == "") { + if (after && !needmore) { + printf "\n"; + thisjoin = 1; + charct = 0; + after = 0; + } + } else { + if ($0 ~ /^- /) { + sub("- ", " - "); + } else if (!thisjoin && $0 !~ /^- /) { + printf " "; + charct += 1; + } + thisjoin = nextjoin; + if ($0 !~ / - / && $0 !~ / -$/ && $0 !~ /^- /) { + printf "%s", $0; + charct += length(); + needmore = 0; + } else { + after = 1 + if ($0 ~ / - /) { + where = match( $0 , / - /); + } else if ($0 ~ / -$/) { + where = match( $0, / -$/); + } else { + where = 1; + } + if ((width = 20-charct) < 0) width=0 + printf "%-*s", width, sprintf( "%s (%s)", + substr( $0, 1, where-1 ), actual_section ); + printf "%s", substr( $0, where ) + if ($0 ~ /- *$/) { + needmore = 1; + } else { + needmore = 0; + } + } + } + } + } + } + closeline(); + } + + { # Main action - process each filename read in. + filename = $0; + do_one(); + } + ' pages=$pages section=$section verbose=$verbose + cd .. + fi + done > $TMPFILE + + cd $here + + # kludge for Slackware's /usr/man/preformat + if [ $mandir = /usr/man/preformat ] + then + mandir1=/usr/man + else + mandir1=$mandir + fi + + if [ -f ${mandir1}/whatis ] + then + cat ${mandir1}/whatis >> $TMPFILE + fi + sed '/^$/d' < $TMPFILE | sort | uniq > ${mandir1}/whatis + + chmod 644 ${mandir1}/whatis + rm $TMPFILE + fi + done +done + +# remove the dir if we created it +if [ $TMPFILE = $TMPFILEDIR/w ]; then + rmdir $TMPFILEDIR +fi diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c new file mode 100644 index 0000000000..4bb148df98 --- /dev/null +++ b/erts/etc/unix/run_erl.c @@ -0,0 +1,1298 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Module: run_erl.c + * + * This module implements a reader/writer process that opens two specified + * FIFOs, one for reading and one for writing; reads from the read FIFO + * and writes to stdout and the write FIFO. + * + ________ _________ + | |--<-- pipe.r (fifo1) --<--| | + | to_erl | | run_erl | (parent) + |________|-->-- pipe.w (fifo2) -->--|_________| + ^ master pty + | + | slave pty + ____V____ + | | + | "erl" | (child) + |_________| +*/ + + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#ifdef HAVE_WORKING_POSIX_OPENPT +#define _XOPEN_SOURCE 600 +#endif +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#ifndef NO_SYSLOG +# include +#endif +#ifdef HAVE_PTY_H +# include +#endif +#ifdef HAVE_UTMP_H +# include +#endif +#ifdef HAVE_UTIL_H +# include +#endif +#ifdef HAVE_SYS_IOCTL_H +# include +#endif + +#include "run_erl.h" +#include "safe_string.h" /* sn_printf, strn_cpy, strn_cat, etc */ + +#ifdef O_NONBLOCK +# define DONT_BLOCK_PLEASE O_NONBLOCK +#else +# define DONT_BLOCK_PLEASE O_NDELAY +# ifndef EAGAIN +# define EAGAIN -3898734 +# endif +#endif + +#define noDEBUG + +#define DEFAULT_LOG_GENERATIONS 5 +#define LOG_MAX_GENERATIONS 1000 /* No more than 1000 log files */ +#define LOG_MIN_GENERATIONS 2 /* At least two to switch between */ +#define DEFAULT_LOG_MAXSIZE 100000 +#define LOG_MIN_MAXSIZE 1000 /* Smallast value for changing log file */ +#define LOG_STUBNAME "erlang.log." +#define LOG_PERM 0664 +#define DEFAULT_LOG_ACTIVITY_MINUTES 5 +#define DEFAULT_LOG_ALIVE_MINUTES 15 +#define DEFAULT_LOG_ALIVE_FORMAT "%a %b %e %T %Z %Y" +#define ALIVE_BUFFSIZ 256 + +#define PERM 0600 +#define STATUSFILENAME "/run_erl.log" +#define PIPE_STUBNAME "erlang.pipe" +#define PIPE_STUBLEN strlen(PIPE_STUBNAME) + +#ifndef FILENAME_MAX +#define FILENAME_MAX 250 +#endif + +#ifndef O_SYNC +#define O_SYNC 0 +#define USE_FSYNC 1 +#endif + +#define MAX(x,y) ((x) > (y) ? (x) : (y)) + +#define FILENAME_BUFSIZ FILENAME_MAX + +/* prototypes */ +static void usage(char *); +static int create_fifo(char *name, int perm); +static int open_pty_master(char **name); +static int open_pty_slave(char *name); +static void pass_on(pid_t); +static void exec_shell(char **); +static void status(const char *format,...); +static void error_logf(int priority, int line, const char *format,...); +static void catch_sigchild(int); +static int next_log(int log_num); +static int prev_log(int log_num); +static int find_next_log_num(void); +static int open_log(int log_num, int flags); +static void write_to_log(int* lfd, int* log_num, char* buf, int len); +static void daemon_init(void); +static char *simple_basename(char *path); +static void init_outbuf(void); +static int outbuf_size(void); +static void clear_outbuf(void); +static char* outbuf_first(void); +static void outbuf_delete(int bytes); +static void outbuf_append(const char* bytes, int n); +static int write_all(int fd, const char* buf, int len); +static int extract_ctrl_seq(char* buf, int len); +static void set_window_size(unsigned col, unsigned row); + + +#ifdef DEBUG +static void show_terminal_settings(struct termios *t); +#endif + +/* static data */ +static char fifo1[FILENAME_BUFSIZ], fifo2[FILENAME_BUFSIZ]; +static char statusfile[FILENAME_BUFSIZ]; +static char log_dir[FILENAME_BUFSIZ]; +static char pipename[FILENAME_BUFSIZ]; +static FILE *stdstatus = NULL; +static int log_generations = DEFAULT_LOG_GENERATIONS; +static int log_maxsize = DEFAULT_LOG_MAXSIZE; +static int log_alive_minutes = DEFAULT_LOG_ALIVE_MINUTES; +static int log_activity_minutes = DEFAULT_LOG_ACTIVITY_MINUTES; +static int log_alive_in_gmt = 0; +static char log_alive_format[ALIVE_BUFFSIZ+1]; +static int run_daemon = 0; +static char *program_name; +static int mfd; /* master pty fd */ +static unsigned protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ + +/* + * Output buffer. + * + * outbuf_base <= outbuf_out <= outbuf_in <= outbuf_base+outbuf_total + */ +static char* outbuf_base; +static int outbuf_total; +static char* outbuf_out; +static char* outbuf_in; + +#if defined(NO_SYSCONF) || !defined(_SC_OPEN_MAX) +# if defined(OPEN_MAX) +# define HIGHEST_FILENO() OPEN_MAX +# else +# define HIGHEST_FILENO() 64 /* arbitrary value */ +# endif +#else +# define HIGHEST_FILENO() sysconf(_SC_OPEN_MAX) +#endif + + +#ifdef NO_SYSLOG +# define OPEN_SYSLOG() ((void) 0) +#else +# define OPEN_SYSLOG() openlog(simple_basename(program_name), \ + LOG_PID|LOG_CONS|LOG_NOWAIT,LOG_USER) +#endif + +#define ERROR0(Prio,Format) error_logf(Prio,__LINE__,Format"\n") +#define ERROR1(Prio,Format,A1) error_logf(Prio,__LINE__,Format"\n",A1) +#define ERROR2(Prio,Format,A1,A2) error_logf(Prio,__LINE__,Format"\n",A1,A2) + +#ifdef HAVE_STRERROR +# define ADD_ERRNO(Format) "errno=%d '%s'\n"Format"\n",errno,strerror(errno) +#else +# define ADD_ERRNO(Format) "errno=%d\n"Format"\n",errno +#endif +#define ERRNO_ERR0(Prio,Format) error_logf(Prio,__LINE__,ADD_ERRNO(Format)) +#define ERRNO_ERR1(Prio,Format,A1) error_logf(Prio,__LINE__,ADD_ERRNO(Format),A1) + + +int main(int argc, char **argv) +{ + int childpid; + int sfd; + int fd; + char *p, *ptyslave=NULL; + int i = 1; + int off_argv; + + program_name = argv[0]; + + if(argc<4) { + usage(argv[0]); + exit(1); + } + + init_outbuf(); + + if (!strcmp(argv[1],"-daemon")) { + daemon_init(); + ++i; + } + + off_argv = i; + strn_cpy(pipename, sizeof(pipename), argv[i++]); + strn_cpy(log_dir, sizeof(log_dir), argv[i]); + strn_cpy(statusfile, sizeof(statusfile), log_dir); + strn_cat(statusfile, sizeof(statusfile), STATUSFILENAME); + +#ifdef DEBUG + status("%s: pid is : %d\n", argv[0], getpid()); +#endif + + /* Get values for LOG file handling from the environment */ + if ((p = getenv("RUN_ERL_LOG_ALIVE_MINUTES"))) { + log_alive_minutes = atoi(p); + if (!log_alive_minutes) { + ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ALIVE_MINUTES is 1 " + "(current value is %s)",p); + } + log_activity_minutes = log_alive_minutes / 3; + if (!log_activity_minutes) { + ++log_activity_minutes; + } + } + if ((p = getenv("RUN_ERL_LOG_ACTIVITY_MINUTES"))) { + log_activity_minutes = atoi(p); + if (!log_activity_minutes) { + ERROR1(LOG_ERR,"Minimum value for RUN_ERL_LOG_ACTIVITY_MINUTES is 1 " + "(current value is %s)",p); + } + } + if ((p = getenv("RUN_ERL_LOG_ALIVE_FORMAT"))) { + if (strlen(p) > ALIVE_BUFFSIZ) { + ERROR1(LOG_ERR, "RUN_ERL_LOG_ALIVE_FORMAT can contain a maximum of " + "%d characters", ALIVE_BUFFSIZ); + } + strn_cpy(log_alive_format, sizeof(log_alive_format), p); + } else { + strn_cpy(log_alive_format, sizeof(log_alive_format), DEFAULT_LOG_ALIVE_FORMAT); + } + if ((p = getenv("RUN_ERL_LOG_ALIVE_IN_UTC")) && strcmp(p,"0")) { + ++log_alive_in_gmt; + } + if ((p = getenv("RUN_ERL_LOG_GENERATIONS"))) { + log_generations = atoi(p); + if (log_generations < LOG_MIN_GENERATIONS) + ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_GENERATIONS is %d", LOG_MIN_GENERATIONS); + if (log_generations > LOG_MAX_GENERATIONS) + ERROR1(LOG_ERR,"Maximum RUN_ERL_LOG_GENERATIONS is %d", LOG_MAX_GENERATIONS); + } + + if ((p = getenv("RUN_ERL_LOG_MAXSIZE"))) { + log_maxsize = atoi(p); + if (log_maxsize < LOG_MIN_MAXSIZE) + ERROR1(LOG_ERR,"Minimum RUN_ERL_LOG_MAXSIZE is %d", LOG_MIN_MAXSIZE); + } + + /* + * Create FIFOs and open them + */ + + if(*pipename && pipename[strlen(pipename)-1] == '/') { + /* The user wishes us to find a unique pipe name in the specified */ + /* directory */ + int highest_pipe_num = 0; + DIR *dirp; + struct dirent *direntp; + + dirp = opendir(pipename); + if(!dirp) { + ERRNO_ERR1(LOG_ERR,"Can't access pipe directory '%s'.", pipename); + exit(1); + } + + /* Check the directory for existing pipes */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { + int num = atoi(direntp->d_name+PIPE_STUBLEN+1); + if(num > highest_pipe_num) + highest_pipe_num = num; + } + } + closedir(dirp); + strn_catf(pipename, sizeof(pipename), "%s.%d", + PIPE_STUBNAME, highest_pipe_num+1); + } /* if */ + + /* write FIFO - is read FIFO for `to_erl' program */ + strn_cpy(fifo1, sizeof(fifo1), pipename); + strn_cat(fifo1, sizeof(fifo1), ".r"); + if (create_fifo(fifo1, PERM) < 0) { + ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for writing.", fifo1); + exit(1); + } + + /* read FIFO - is write FIFO for `to_erl' program */ + strn_cpy(fifo2, sizeof(fifo2), pipename); + strn_cat(fifo2, sizeof(fifo2), ".w"); + + /* Check that nobody is running run_erl already */ + if ((fd = open (fifo2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + /* Open as client succeeded -- run_erl is already running! */ + fprintf(stderr, "Erlang already running on pipe %s.\n", pipename); + close(fd); + exit(1); + } + if (create_fifo(fifo2, PERM) < 0) { + ERRNO_ERR1(LOG_ERR,"Cannot create FIFO %s for reading.", fifo2); + exit(1); + } + + /* + * Open master pseudo-terminal + */ + + if ((mfd = open_pty_master(&ptyslave)) < 0) { + ERRNO_ERR0(LOG_ERR,"Could not open pty master"); + exit(1); + } + + /* + * Now create a child process + */ + + if ((childpid = fork()) < 0) { + ERRNO_ERR0(LOG_ERR,"Cannot fork"); + exit(1); + } + if (childpid == 0) { + /* Child */ + close(mfd); + /* disassociate from control terminal */ +#ifdef USE_SETPGRP_NOARGS /* SysV */ + setpgrp(); +#elif defined(USE_SETPGRP) /* BSD */ + setpgrp(0,getpid()); +#else /* POSIX */ + setsid(); +#endif + /* Open the slave pty */ + if ((sfd = open_pty_slave(ptyslave)) < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open pty slave '%s'", ptyslave); + exit(1); + } + /* But sfd may be one of the stdio fd's now, and we should be unmodern and not use dup2... */ + /* easiest to dup it up... */ + while (sfd < 3) { + sfd = dup(sfd); + } + +#ifndef NO_SYSLOG + /* Before fiddling with file descriptors we make sure syslog is turned off + or "closed". In the single case where we might want it again, + we will open it again instead. Would not want syslog to + go to some other fd... */ + if (run_daemon) { + closelog(); + } +#endif + + /* Close stdio */ + close(0); + close(1); + close(2); + + if (dup(sfd) != 0 || dup(sfd) != 1 || dup(sfd) != 2) { + status("Cannot dup\n"); + } + close(sfd); + exec_shell(argv+off_argv); /* exec_shell expects argv[2] to be */ + /* the command name, so we have to */ + /* adjust. */ + } else { + /* Parent */ + /* Ignore the SIGPIPE signal, write() will return errno=EPIPE */ + struct sigaction sig_act; + sigemptyset(&sig_act.sa_mask); + sig_act.sa_flags = 0; + sig_act.sa_handler = SIG_IGN; + sigaction(SIGPIPE, &sig_act, (struct sigaction *)NULL); + + sigemptyset(&sig_act.sa_mask); + sig_act.sa_flags = SA_NOCLDSTOP; + sig_act.sa_handler = catch_sigchild; + sigaction(SIGCHLD, &sig_act, (struct sigaction *)NULL); + + /* + * read and write: enter the workloop + */ + + pass_on(childpid); + } + return 0; +} /* main() */ + +/* pass_on() + * Is the work loop of the logger. Selects on the pipe to the to_erl + * program erlang. If input arrives from to_erl it is passed on to + * erlang. + */ +static void pass_on(pid_t childpid) +{ + int len; + fd_set readfds; + fd_set writefds; + fd_set* writefds_ptr; + struct timeval timeout; + time_t last_activity; + char buf[BUFSIZ]; + char log_alive_buffer[ALIVE_BUFFSIZ+1]; + int lognum; + int rfd, wfd=0, lfd=0; + int maxfd; + int ready; + int got_some = 0; /* from to_erl */ + + /* Open the to_erl pipe for reading. + * We can't open the writing side because nobody is reading and + * we'd either hang or get an error. + */ + if ((rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); + exit(1); + } + +#ifdef DEBUG + status("run_erl: %s opened for reading\n", fifo2); +#endif + + /* Open the log file */ + + lognum = find_next_log_num(); + lfd = open_log(lognum, O_RDWR|O_APPEND|O_CREAT|O_SYNC); + + /* Enter the work loop */ + + while (1) { + int exit_status; + maxfd = MAX(rfd, mfd); + maxfd = MAX(wfd, maxfd); + FD_ZERO(&readfds); + FD_SET(rfd, &readfds); + FD_SET(mfd, &readfds); + FD_ZERO(&writefds); + if (outbuf_size() == 0) { + writefds_ptr = NULL; + } else { + FD_SET(wfd, &writefds); + writefds_ptr = &writefds; + } + time(&last_activity); + timeout.tv_sec = log_alive_minutes*60; /* don't assume old BSD bug */ + timeout.tv_usec = 0; + ready = select(maxfd + 1, &readfds, writefds_ptr, NULL, &timeout); + if (ready < 0) { + if (errno == EINTR) { + if (waitpid(childpid, &exit_status, WNOHANG) == childpid) { + /* + * The Erlang emulator has terminated. Give us some more + * time to write out any pending data before we terminate too. + */ + alarm(5); + } + FD_ZERO(&readfds); + FD_ZERO(&writefds); + } else { + /* Some error occured */ + ERRNO_ERR0(LOG_ERR,"Error in select."); + exit(1); + } + } else { + time_t now; + + if (waitpid(childpid, &exit_status, WNOHANG) == childpid) { + alarm(5); + FD_ZERO(&readfds); + FD_ZERO(&writefds); + } + + /* Check how long time we've been inactive */ + time(&now); + if(!ready || now - last_activity > log_activity_minutes*60) { + /* Either a time out: 15 minutes without action, */ + /* or something is coming in right now, but it's a long time */ + /* since last time, so let's write a time stamp this message */ + struct tm *tmptr; + if (log_alive_in_gmt) { + tmptr = gmtime(&now); + } else { + tmptr = localtime(&now); + } + if (!strftime(log_alive_buffer, ALIVE_BUFFSIZ, log_alive_format, + tmptr)) { + strn_cpy(log_alive_buffer, sizeof(log_alive_buffer), + "(could not format time in 256 positions " + "with current format string.)"); + } + log_alive_buffer[ALIVE_BUFFSIZ] = '\0'; + + sn_printf(buf, sizeof(buf), "\n===== %s%s\n", + ready?"":"ALIVE ", log_alive_buffer); + write_to_log(&lfd, &lognum, buf, strlen(buf)); + } + } + + /* + * Write any pending output first. + */ + if (FD_ISSET(wfd, &writefds)) { + int written; + char* buf = outbuf_first(); + + len = outbuf_size(); + written = write(wfd, buf, len); + if (written < 0 && errno == EAGAIN) { + /* + * Nothing was written - this is really strange because + * select() told us we could write. Ignore. + */ + } else if (written < 0) { + /* + * A write error. Assume that to_erl has terminated. + */ + clear_outbuf(); + close(wfd); + wfd = 0; + } else { + /* Delete the written part (or all) from the buffer. */ + outbuf_delete(written); + } + } + + /* + * Read master pty and write to FIFO. + */ + if (FD_ISSET(mfd, &readfds)) { +#ifdef DEBUG + status("Pty master read; "); +#endif + if ((len = read(mfd, buf, BUFSIZ)) <= 0) { + close(rfd); + if(wfd) close(wfd); + close(mfd); + unlink(fifo1); + unlink(fifo2); + if (len < 0) { + if(errno == EIO) + ERROR0(LOG_ERR,"Erlang closed the connection."); + else + ERRNO_ERR0(LOG_ERR,"Error in reading from terminal"); + exit(1); + } + exit(0); + } + + write_to_log(&lfd, &lognum, buf, len); + + /* + * Save in the output queue. + */ + + if (wfd) { + outbuf_append(buf, len); + } + } + + /* + * Read from FIFO, write to master pty + */ + if (FD_ISSET(rfd, &readfds)) { +#ifdef DEBUG + status("FIFO read; "); +#endif + if ((len = read(rfd, buf, BUFSIZ)) < 0) { + close(rfd); + if(wfd) close(wfd); + close(mfd); + unlink(fifo1); + unlink(fifo2); + ERRNO_ERR0(LOG_ERR,"Error in reading from FIFO."); + exit(1); + } + + if(!len) { + /* to_erl closed its end of the pipe */ + close(rfd); + rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); + if (rfd < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); + exit(1); + } + got_some = 0; /* reset for next session */ + } + else { + if(!wfd) { + /* Try to open the write pipe to to_erl. Now that we got some data + * from to_erl, to_erl should already be reading this pipe - open + * should succeed. But in case of error, we just ignore it. + */ + if ((wfd = open(fifo1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { + status("Client expected on FIFO %s, but can't open (len=%d)\n", + fifo1, len); + close(rfd); + rfd = open(fifo2, O_RDONLY|DONT_BLOCK_PLEASE, 0); + if (rfd < 0) { + ERRNO_ERR1(LOG_ERR,"Could not open FIFO '%s' for reading.", fifo2); + exit(1); + } + wfd = 0; + } + else { +#ifdef DEBUG + status("run_erl: %s opened for writing\n", fifo1); +#endif + } + } + + if (!got_some && wfd && buf[0] == '\022') { + char wbuf[30]; + int wlen = sn_printf(wbuf,sizeof(wbuf),"[run_erl v%u-%u]\n", + RUN_ERL_HI_VER, RUN_ERL_LO_VER); + outbuf_append(wbuf,wlen); + } + got_some = 1; + + + /* Write the message */ +#ifdef DEBUG + status("Pty master write; "); +#endif + len = extract_ctrl_seq(buf, len); + + if(len==1 && buf[0] == '\003') { + kill(childpid,SIGINT); + } + else if (len>0 && write_all(mfd, buf, len) != len) { + ERRNO_ERR0(LOG_ERR,"Error in writing to terminal."); + close(rfd); + if(wfd) close(wfd); + close(mfd); + exit(1); + } + } +#ifdef DEBUG + status("OK\n"); +#endif + } + } +} /* pass_on() */ + +static void catch_sigchild(int sig) +{ +} + +/* + * next_log: + * Returns the index number that follows the given index number. + * (Wrapping after log_generations) + */ +static int next_log(int log_num) { + return log_num>=log_generations?1:log_num+1; +} + +/* + * prev_log: + * Returns the index number that precedes the given index number. + * (Wrapping after log_generations) + */ +static int prev_log(int log_num) { + return log_num<=1?log_generations:log_num-1; +} + +/* + * find_next_log_num() + * Searches through the log directory to check which logs that already + * exist. It finds the "hole" in the sequence, and returns the index + * number for the last log in the log sequence. If there is no hole, index + * 1 is returned. + */ +static int find_next_log_num(void) { + int i, next_gen, log_gen; + DIR *dirp; + struct dirent *direntp; + int log_exists[LOG_MAX_GENERATIONS+1]; + int stub_len = strlen(LOG_STUBNAME); + + /* Initialize exiting log table */ + + for(i=log_generations; i>=0; i--) + log_exists[i] = 0; + dirp = opendir(log_dir); + if(!dirp) { + ERRNO_ERR1(LOG_ERR,"Can't access log directory '%s'", log_dir); + exit(1); + } + + /* Check the directory for existing logs */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,LOG_STUBNAME,stub_len)==0) { + int num = atoi(direntp->d_name+stub_len); + if(num < 1 || num > log_generations) + continue; + log_exists[num] = 1; + } + } + closedir(dirp); + + /* Find out the next available log file number */ + + next_gen = 0; + for(i=log_generations; i>=0; i--) { + if(log_exists[i]) + if(next_gen) + break; + else + ; + else + next_gen = i; + } + + /* Find out the current log file number */ + + if(next_gen) + log_gen = prev_log(next_gen); + else + log_gen = 1; + + return log_gen; +} /* find_next_log_num() */ + +/* open_log() + * Opens a log file (with given index) for writing. Writing may be + * at the end or a trucnating write, according to flags. + * A LOGGING STARTED and time stamp message is inserted into the log file + */ +static int open_log(int log_num, int flags) +{ + char buf[FILENAME_MAX]; + time_t now; + struct tm *tmptr; + char log_buffer[ALIVE_BUFFSIZ+1]; + int lfd; + + /* Remove the next log (to keep a "hole" in the log sequence) */ + sn_printf(buf, sizeof(buf), "%s/%s%d", + log_dir, LOG_STUBNAME, next_log(log_num)); + unlink(buf); + + /* Create or continue on the current log file */ + sn_printf(buf, sizeof(buf), "%s/%s%d", log_dir, LOG_STUBNAME, log_num); + if((lfd = open(buf, flags, LOG_PERM))<0){ + ERRNO_ERR1(LOG_ERR,"Can't open log file '%s'.", buf); + exit(1); + } + + /* Write a LOGGING STARTED and time stamp into the log file */ + time(&now); + if (log_alive_in_gmt) { + tmptr = gmtime(&now); + } else { + tmptr = localtime(&now); + } + if (!strftime(log_buffer, ALIVE_BUFFSIZ, log_alive_format, + tmptr)) { + strn_cpy(log_buffer, sizeof(log_buffer), + "(could not format time in 256 positions " + "with current format string.)"); + } + log_buffer[ALIVE_BUFFSIZ] = '\0'; + + sn_printf(buf, sizeof(buf), "\n=====\n===== LOGGING STARTED %s\n=====\n", + log_buffer); + if (write_all(lfd, buf, strlen(buf)) < 0) + status("Error in writing to log.\n"); + +#if USE_FSYNC + fsync(lfd); +#endif + + return lfd; +} + +/* write_to_log() + * Writes a message to a log file. If the current log file is full, + * a new log file is opened. + */ +static void write_to_log(int* lfd, int* log_num, char* buf, int len) +{ + int size; + + /* Decide if new logfile needed, and open if so */ + + size = lseek(*lfd,0,SEEK_END); + if(size+len > log_maxsize) { + close(*lfd); + *log_num = next_log(*log_num); + *lfd = open_log(*log_num, O_RDWR|O_CREAT|O_TRUNC|O_SYNC); + } + + /* Write to log file */ + + if (write_all(*lfd, buf, len) < 0) { + status("Error in writing to log.\n"); + } + +#if USE_FSYNC + fsync(*lfd); +#endif +} + +/* create_fifo() + * Creates a new fifo with the given name and permission. + */ +static int create_fifo(char *name, int perm) +{ + if ((mkfifo(name, perm) < 0) && (errno != EEXIST)) + return -1; + return 0; +} + + +/* open_pty_master() + * Find a master device, open and return fd and slave device name. + */ + +static int open_pty_master(char **ptyslave) +{ + int mfd; + +/* Use the posix_openpt if working, as this guarantees creation of the + slave device properly. */ +#ifdef HAVE_WORKING_POSIX_OPENPT + if ((mfd = posix_openpt(O_RDWR)) >= 0) { + if ((*ptyslave = ptsname(mfd)) != NULL && + grantpt(mfd) == 0 && + unlockpt(mfd) == 0) { + + return mfd; + } + close(mfd); + } + /* fallback to openpty if it exist */ +#endif + +#ifdef HAVE_OPENPTY +# ifdef PATH_MAX +# define SLAVE_SIZE PATH_MAX +# else +# define SLAVE_SIZE 1024 +# endif + { + static char slave[SLAVE_SIZE]; + int sfd; +# undef SLAVE_SIZE + + if (openpty(&mfd, &sfd, slave, NULL, NULL) == 0) { + close(sfd); + *ptyslave = slave; + return mfd; + } + } + +#elif !defined(HAVE_WORKING_POSIX_OPENPT) + /* + * The traditional way to find ptys. We only try it if neither + * posix_openpt or openpty() are available. + */ + char *major, *minor; + + static char majorchars[] = "pqrstuvwxyzabcdePQRSTUVWXYZABCDE"; + static char minorchars[] = "0123456789abcdefghijklmnopqrstuv" + "wxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_+"; + + /* In the old time the names where /dex/ptyXY where */ + /* X is in "pqrs" and Y in "0123456789abcdef" but FreeBSD */ + /* and some Linux version has extended this. */ + + /* This code could probebly be improved alot. For example look at */ + /* http://www.xcf.berkeley.edu/~ali/K0D/UNIX/PTY/code/pty.c.html */ + /* http://www.xcf.berkeley.edu/~ali/K0D/UNIX/PTY/code/upty.h.html */ + + { + /* New style devpts or devfs /dev/pty/{m,s}{0,1....} */ + + static char ptyname[] = "/dev/pty/mX"; + + for (minor = minorchars; *minor; minor++) { + ptyname[10] = *minor; + if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + ptyname[9] = 's'; + *ptyslave = ptyname; + return mfd; + } + } + } + + { + /* Unix98 style /dev/ptym/ptyXY and /dev/pty/ttyXY */ + + static char ptyname[] = "/dev/ptym/ptyXY"; + static char ttyname[] = "/dev/pty/ttyXY"; + + for (major = majorchars; *major; major++) { + ptyname[13] = *major; + for (minor = minorchars; *minor; minor++) { + ptyname[14] = *minor; + if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + ttyname[12] = *major; + ttyname[13] = *minor; + *ptyslave = ttyname; + return mfd; + } + } + } + } + + { + /* Old style /dev/ptyXY */ + + static char ptyname[] = "/dev/ptyXY"; + + for (major = majorchars; *major; major++) { + ptyname[8] = *major; + for (minor = minorchars; *minor; minor++) { + ptyname[9] = *minor; + if ((mfd = open(ptyname, O_RDWR, 0)) >= 0) { + ptyname[5] = 't'; + *ptyslave = ptyname; + return mfd; + } + } + } + } +#endif /* !HAVE_OPENPTY */ + return -1; +} + +static int open_pty_slave(char *name) +{ + int sfd; +#ifdef DEBUG + struct termios tty_rmode; +#endif + + if ((sfd = open(name, O_RDWR, 0)) < 0) { + return -1; + } + +#ifdef DEBUG + if (tcgetattr(sfd, &tty_rmode) , 0) { + fprintf(stderr, "Cannot get terminals current mode\n"); + exit(-1); + } + show_terminal_settings(&tty_rmode); +#endif + + return sfd; +} + +/* exec_shell() + * Executes the named command (in argv format) in a /bin/sh. IO redirection + * should already have been taken care of, and this process should be the + * child of a fork. + */ +static void exec_shell(char **argv) +{ + char *sh, **vp; + int i; + + sh = "/bin/sh"; + if ((argv[0] = strrchr(sh, '/')) != NULL) + argv[0]++; + else + argv[0] = sh; + argv[1] = "-c"; + status("Args before exec of shell:\n"); + for (vp = argv, i = 0; *vp; vp++, i++) + status("argv[%d] = %s\n", i, *vp); + if (stdstatus) { + fclose(stdstatus); + } + execv(sh, argv); + if (run_daemon) { + OPEN_SYSLOG(); + } + ERRNO_ERR0(LOG_ERR,"Could not execv"); +} + +/* status() + * Prints the arguments to a status file + * Works like printf (see vfrpintf) + */ +static void status(const char *format,...) +{ + va_list args; + time_t now; + + if (stdstatus == NULL) + stdstatus = fopen(statusfile, "w"); + if (stdstatus == NULL) + return; + now = time(NULL); + fprintf(stdstatus, "run_erl [%d] %s", (int)getpid(), ctime(&now)); + va_start(args, format); + vfprintf(stdstatus, format, args); + va_end(args); + fflush(stdstatus); +} + +static void daemon_init(void) + /* As R Stevens wants it, to a certain extent anyway... */ +{ + pid_t pid; + int i, maxfd = HIGHEST_FILENO(); + + if ((pid = fork()) != 0) + exit(0); +#if defined(USE_SETPGRP_NOARGS) + setpgrp(); +#elif defined(USE_SETPGRP) + setpgrp(0,getpid()); +#else + setsid(); /* Seems to be the case on all current platforms */ +#endif + signal(SIGHUP, SIG_IGN); + if ((pid = fork()) != 0) + exit(0); + + /* Should change working directory to "/" and change umask now, but that + would be backward incompatible */ + + for (i = 0; i < maxfd; ++i ) { + close(i); + } + + OPEN_SYSLOG(); + run_daemon = 1; +} + +/* error_logf() + * Prints the arguments to stderr or syslog + * Works like printf (see vfprintf) + */ +static void error_logf(int priority, int line, const char *format, ...) +{ + va_list args; + va_start(args, format); + +#ifndef NO_SYSLOG + if (run_daemon) { + vsyslog(priority,format,args); + } + else +#endif + { + time_t now = time(NULL); + fprintf(stderr, "run_erl:%d [%d] %s", line, (int)getpid(), ctime(&now)); + vfprintf(stderr, format, args); + } + va_end(args); +} + +static void usage(char *pname) +{ + fprintf(stderr, "Usage: %s (pipe_name|pipe_dir/) log_dir \"command [parameters ...]\"\n", pname); + fprintf(stderr, "\nYou may also set the environment variables RUN_ERL_LOG_GENERATIONS\n"); + fprintf(stderr, "and RUN_ERL_LOG_MAXSIZE to the number of log files to use and the\n"); + fprintf(stderr, "size of the log file when to switch to the next log file\n"); +} + +/* Instead of making sure basename exists, we do our own */ +static char *simple_basename(char *path) +{ + char *ptr; + for (ptr = path; *ptr != '\0'; ++ptr) { + if (*ptr == '/') { + path = ptr + 1; + } + } + return path; +} + +static void init_outbuf(void) +{ + outbuf_total = 1; + outbuf_base = malloc(BUFSIZ); + clear_outbuf(); +} + +static void clear_outbuf(void) +{ + outbuf_in = outbuf_out = outbuf_base; +} + +static int outbuf_size(void) +{ + return outbuf_in - outbuf_out; +} + +static char* outbuf_first(void) +{ + return outbuf_out; +} + +static void outbuf_delete(int bytes) +{ + outbuf_out += bytes; + if (outbuf_out >= outbuf_in) { + outbuf_in = outbuf_out = outbuf_base; + } +} + +static void outbuf_append(const char* buf, int n) +{ + if (outbuf_base+outbuf_total < outbuf_in+n) { + /* + * The new data does not fit at the end of the buffer. + * Slide down the data to the beginning of the buffer. + */ + if (outbuf_out > outbuf_base) { + int size = outbuf_in - outbuf_out; + char* p; + + outbuf_in -= outbuf_out - outbuf_base; + p = outbuf_base; + while (size-- > 0) { + *p++ = *outbuf_out++; + } + outbuf_out = outbuf_base; + } + + /* + * Allocate a larger buffer if we still cannot fit the data. + */ + if (outbuf_base+outbuf_total < outbuf_in+n) { + int size = outbuf_in - outbuf_out; + outbuf_total = size+n; + outbuf_base = realloc(outbuf_base, outbuf_total); + outbuf_out = outbuf_base; + outbuf_in = outbuf_base + size; + } + } + + /* + * Copy data to the end of the buffer. + */ + memcpy(outbuf_in, buf, n); + outbuf_in += n; +} + +/* Call write() until entire buffer has been written or error. + * Return len or -1. + */ +static int write_all(int fd, const char* buf, int len) +{ + int left = len; + int written; + for (;;) { + written = write(fd,buf,left); + if (written == left) { + return len; + } + if (written < 0) { + return -1; + } + left -= written; + buf += written; + } +} + +/* Extract any control sequences that are ment only for run_erl + * and should not be forwarded to the pty. + */ +static int extract_ctrl_seq(char* buf, int len) +{ + static const char prefix[] = "\033_"; + static const char suffix[] = "\033\\"; + char* bufend = buf + len; + char* start = buf; + char* command; + char* end; + + for (;;) { + start = find_str(start, bufend-start, prefix); + if (!start) break; + + command = start + strlen(prefix); + end = find_str(command, bufend-command, suffix); + if (end) { + unsigned col, row; + if (sscanf(command,"version=%u", &protocol_ver)==1) { + /*fprintf(stderr,"to_erl v%u\n", protocol_ver);*/ + } + else if (sscanf(command,"winsize=%u,%u", &col, &row)==2) { + set_window_size(col,row); + } + else { + ERROR2(LOG_ERR, "Ignoring unknown ctrl command '%.*s'\n", + (int)(end-command), command); + } + + /* Remove ctrl sequence from buf */ + end += strlen(suffix); + memmove(start, end, bufend-end); + bufend -= end - start; + } + else { + ERROR2(LOG_ERR, "Missing suffix in ctrl sequence '%.*s'\n", + (int)(bufend-start), start); + break; + } + } + return bufend - buf; +} + +static void set_window_size(unsigned col, unsigned row) +{ +#ifdef TIOCSWINSZ + struct winsize ws; + ws.ws_col = col; + ws.ws_row = row; + if (ioctl(mfd, TIOCSWINSZ, &ws) < 0) { + ERRNO_ERR0(LOG_ERR,"Failed to set window size"); + } +#endif +} + + +#ifdef DEBUG + +#define S(x) ((x) > 0 ? 1 : 0) + +static void show_terminal_settings(struct termios *t) +{ + printf("c_iflag:\n"); + printf("Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT)); + printf("Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL)); + printf("Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK)); + printf("Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR)); + printf("Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR)); + printf("Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR)); + printf("Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK)); + printf("Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP)); + printf("Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF)); + printf("ditto output ctrl IXON %d\n", S(t->c_iflag & IXON)); + printf("Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK)); + printf("\n"); + printf("c_oflag:\n"); + printf("Perform output processing OPOST %d\n", S(t->c_oflag & OPOST)); + printf("\n"); + printf("c_cflag:\n"); + printf("Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL)); + printf("\n"); + printf("c_local:\n"); + printf("Enable echo ECHO %d\n", S(t->c_lflag & ECHO)); + printf("\n"); + printf("c_cc:\n"); + printf("c_cc[VEOF] %d\n", t->c_cc[VEOF]); +} + +#endif /* DEBUG */ + + diff --git a/erts/etc/unix/run_erl.h b/erts/etc/unix/run_erl.h new file mode 100644 index 0000000000..843cda680c --- /dev/null +++ b/erts/etc/unix/run_erl.h @@ -0,0 +1,30 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * The protocol version number used between to_erl and run_erl. + */ +#define RUN_ERL_HI_VER 1 /* My preferred protocol version */ +#define RUN_ERL_LO_VER 0 /* The lowest version I accept to talk with */ + +/* Version history: + * 0: Older, without version handshake + * 1: R12B-3, version handshake + window size ctrl + */ + diff --git a/erts/etc/unix/safe_string.c b/erts/etc/unix/safe_string.c new file mode 100644 index 0000000000..a77d9c5456 --- /dev/null +++ b/erts/etc/unix/safe_string.c @@ -0,0 +1,123 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Module: safe_string.c + * + * This is a bunch of generic string operation + * that are safe regarding buffer overflow. + * + * All string functions terminate the process with an error message + * on buffer overflow. + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include "safe_string.h" +#include +#include +#include +#include + + +static void string_overflow_handler(const char* format, ...) +{ + va_list args; + va_start(args, format); + vfprintf(stderr,format,args); + va_end(args); + exit(1); +} + +int vsn_printf(char* dst, size_t size, const char* format, va_list args) +{ + int ret = vsnprintf(dst, size, format, args); + if (ret >= size || ret < 0) { + string_overflow_handler("Buffer truncated '%s'\n",dst); + } + return ret; +} + +int sn_printf(char* dst, size_t size, const char* format, ...) +{ + va_list args; + int ret; + va_start(args, format); + ret = vsn_printf(dst,size,format,args); + va_end(args); + return ret; +} + +int strn_cpy(char* dst, size_t size, const char* src) +{ + return sn_printf(dst,size,"%s",src); +} + +int strn_cat(char* dst, size_t size, const char* src) +{ + return strn_catf(dst,size,"%s",src); +} + +int strn_catf(char* dst, size_t size, const char* format, ...) +{ + int ret; + va_list args; +#ifdef _GNU_SOURCE + int len = strnlen(dst,size); +#else + int len = strlen(dst); +#endif + + if (len >= size) { + string_overflow_handler("Buffer already overflowed '%.*s'\n", + size, dst); + } + va_start(args, format); + ret = vsn_printf(dst+len, size-len, format, args); + va_end(args); + return len+ret; +} + +char* find_str(const char* haystack, int hsize, const char* needle) +{ + int i = 0; + int nsize = strlen(needle); + hsize -= nsize - 1; + for (i=0; i dest) { + for (i=0; i=0; i--) ((char*)dest)[i] = ((char*)src)[i]; + } + return dest; +} +#endif /* HAVE_MEMMOVE */ + diff --git a/erts/etc/unix/safe_string.h b/erts/etc/unix/safe_string.h new file mode 100644 index 0000000000..c70e528814 --- /dev/null +++ b/erts/etc/unix/safe_string.h @@ -0,0 +1,65 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Module: safe_string.h + * + * This is an interface to a bunch of generic string operation + * that are safe regarding buffer overflow. + * + * All string functions terminate the process with an error message + * on buffer overflow. + */ + +#include +#include + +/* Like vsnprintf() + */ +int vsn_printf(char* dst, size_t size, const char* format, va_list args); + +/* Like snprintf() + */ +int sn_printf(char* dst, size_t size, const char* format, ...); + +/* Like strncpy() + * Returns length of copied string. + */ +int strn_cpy(char* dst, size_t size, const char* src); + +/* Almost like strncat() + * size is sizeof entire dst buffer. + * Returns length of resulting string. + */ +int strn_cat(char* dst, size_t size, const char* src); + +/* Combination of strncat() and snprintf() + * size is sizeof entire dst buffer. + * Returns length of resulting string. + */ +int strn_catf(char* dst, size_t size, const char* format, ...); + +/* Simular to strstr() but search size bytes of haystack + * without regard to '\0' characters. + */ +char* find_str(const char* haystack, int size, const char* needle); + +#ifndef HAVE_MEMMOVE +void* memmove(void *dest, const void *src, size_t n); +#endif + diff --git a/erts/etc/unix/setuid_socket_wrap.c b/erts/etc/unix/setuid_socket_wrap.c new file mode 100644 index 0000000000..3f0657770c --- /dev/null +++ b/erts/etc/unix/setuid_socket_wrap.c @@ -0,0 +1,259 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * setuid_socket_wrap.c + * + * ./a.out [-s [tag,][addr]:[port]]* [-d [tag,][addr]:[port]]* + * [-r [tag,]proto]* -- program args + * + * Where: -s = stream socket, -d datagram socket and -r means raw socket. + * + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#ifndef EXEC_PROGRAM +# define EXEC_PROGRAM "/bin/echo" +#endif + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#ifndef INADDR_NONE +#define INADDR_NONE 0xffffffff +#endif + +struct sock_list { + struct sock_list *next; + int fd; + int type; + int protocol; + struct sockaddr_in addr; + char *arg; +}; + +int parse_addr(addr, str) + struct sockaddr_in *addr; + char *str; +{ + int port = 0; + char *cp; + struct hostent *hp; + struct servent *se; + + if ((cp = strrchr(str, (int)':')) != NULL) + *cp++ = '\0'; + if (cp) { + if (!isdigit((int)cp[0])) { + if ((se = getservbyname(cp, "tcp")) != NULL) { + port = ntohs(se->s_port); + } else { + fprintf(stderr, "unknown port %s\n", cp); + return -1; + } + } else { + port = atoi(cp); + } + } + if (port < 0 || port > 0xffff) { + fprintf(stderr, "bad port number %d\n", port); + return -1; + } + + bzero(addr, sizeof(*addr)); + addr->sin_family = AF_INET; + addr->sin_port = htons(port); + if (*str == '\000') { + addr->sin_addr.s_addr = INADDR_ANY; + } else { + if ((addr->sin_addr.s_addr = inet_addr(str)) == INADDR_NONE) { + if ((hp = gethostbyname(str)) == NULL) { + fprintf(stderr, "\"%s\" unknown host or address!\n", str); + return -1; + } else { + bcopy(hp->h_addr_list[0], &addr->sin_addr.s_addr,hp->h_length); + } + } + } + return 0; +} + +struct sock_list *new_entry(type, argstr) + int type; + char *argstr; +{ + struct sock_list *sle; + char *cp; + + sle = (struct sock_list *)malloc(sizeof(struct sock_list)); + if (!sle) + return NULL; + sle->next = NULL; + sle->fd = -1; + + if ((cp = strchr(argstr, (int)',')) != NULL) { + *cp++ = '\0'; + sle->arg = argstr; + argstr = cp; + } else { + sle->arg = "-fd"; + } + sle->type = type; + switch (type) { + case SOCK_RAW: { + struct protoent *pe; + pe = getprotobyname(argstr); + if (!pe) { + fprintf(stderr, "Unknown protocol: %s\n", argstr); + free(sle); + return NULL; + } + sle->protocol = pe->p_proto; + break; + } + case SOCK_STREAM: + case SOCK_DGRAM: + sle->protocol = 0; + if (parse_addr(&sle->addr, argstr) < 0) { + free(sle); + return NULL; + } + break; + } + return sle; +} + +int open_socket(sle) + struct sock_list *sle; +{ + sle->fd = socket(AF_INET, sle->type, sle->protocol); + if (sle->fd < 0) { + perror("socket"); + return -1; + } + if (sle->type != SOCK_RAW) { +#if 0 + printf("binding fd %d to %s:%d\n", sle->fd, + inet_ntoa(sle->addr.sin_addr), ntohs(sle->addr.sin_port)); +#endif + if (bind(sle->fd, (struct sockaddr *)&sle->addr, sizeof(sle->addr))<0){ + perror("bind"); + close(sle->fd); + return -1; + } + } + return sle->fd; +} + +int main(argc, argv) + int argc; + char *argv[]; +{ + struct sock_list *sl = NULL, *sltmp = NULL; + int count = 0; + int c; + + while ((c = getopt(argc, argv, "s:d:r:")) != EOF) + switch (c) { + case 's': + sltmp = new_entry(SOCK_STREAM, optarg); + if (!sltmp) { + exit(1); + } + sltmp->next = sl; + sl = sltmp; + count++; + break; + case 'd': + sltmp = new_entry(SOCK_DGRAM, optarg); + if (!sltmp) { + exit(1); + } + sltmp->next = sl; + sl = sltmp; + count++; + break; + case 'r': + sltmp = new_entry(SOCK_RAW, optarg); + if (!sltmp) { + exit(1); + } + sltmp->next = sl; + sl = sltmp; + count++; + break; + default: + exit(1); + } + argc -= optind; + argv += optind; + + for(sltmp = sl; sltmp != NULL; sltmp = sltmp->next) + if (open_socket(sltmp) < 0) { + fprintf(stderr, "failed to create socket!\n"); + exit(1); + } + + setuid(getuid()); + + { + int i; + char **newargv; + char *run_prog = EXEC_PROGRAM; + char *run_prog_name; + + newargv = (char **)malloc((1 + 2*count + argc + 1) * sizeof(char*)); + + if ((run_prog_name = strrchr(run_prog, (int)'/')) == NULL) + run_prog_name = run_prog; + else + run_prog_name++; + + i = 0; + newargv[i++] = run_prog_name; + + for (; argc; argc--, argv++, i++) + newargv[i] = *argv; + for(sltmp = sl; sltmp != NULL; ) { + char *fd_str = (char *)malloc(8); + if (!fd_str) exit(1); + sprintf(fd_str, "%d", sltmp->fd); + if (sltmp->arg && *(sltmp->arg)) + newargv[i++] = sltmp->arg; + newargv[i++] = fd_str; + sl = sltmp; + sltmp = sltmp->next; + free(sl); + } + newargv[i] = (char *)NULL; + execv(run_prog, newargv); + perror("exec"); + exit(1); + } + exit(0); +} diff --git a/erts/etc/unix/start.src b/erts/etc/unix/start.src new file mode 100644 index 0000000000..8479be0987 --- /dev/null +++ b/erts/etc/unix/start.src @@ -0,0 +1,36 @@ +#!/bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# This program invokes the erlang emulator by calling run_erl. +# It should only be used at an embedded target system. +# It should be modified to give the correct flags to erl (via start_erl), +# e.g -mode embedded -sname XXX +# +# Usage: start [Data] +# +ROOTDIR=%FINAL_ROOTDIR% + +if [ -z "$RELDIR" ] +then + RELDIR=$ROOTDIR/releases +fi + +START_ERL_DATA=${1:-$RELDIR/start_erl.data} + +$ROOTDIR/bin/run_erl -daemon /tmp/ $ROOTDIR/log "exec $ROOTDIR/bin/start_erl $ROOTDIR $RELDIR $START_ERL_DATA" diff --git a/erts/etc/unix/start_erl.src b/erts/etc/unix/start_erl.src new file mode 100644 index 0000000000..ea8022c449 --- /dev/null +++ b/erts/etc/unix/start_erl.src @@ -0,0 +1,47 @@ +#!/bin/sh +# +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# This program is called by run_erl. It starts +# the erlang emulator and sets -boot and -config parameters. +# It should only be used at an embedded target system. +# +# Usage: start_erl RootDir RelDir DataFile [ErlFlags ...] +# +ROOTDIR=$1 +shift +RELDIR=$1 +shift +DataFile=$1 +shift + +ERTS_VSN=`awk '{print $1}' $DataFile` +VSN=`awk '{print $2}' $DataFile` + +BINDIR=$ROOTDIR/erts-$ERTS_VSN/bin +EMU=beam +PROGNAME=`echo $0 | sed 's/.*\///'` +export EMU +export ROOTDIR +export BINDIR +export PROGNAME +export RELDIR + +exec $BINDIR/erlexec -boot $RELDIR/$VSN/start -config $RELDIR/$VSN/sys ${1+"$@"} + diff --git a/erts/etc/unix/to_erl.c b/erts/etc/unix/to_erl.c new file mode 100644 index 0000000000..588d127445 --- /dev/null +++ b/erts/etc/unix/to_erl.c @@ -0,0 +1,610 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Module: to_erl.c + * + * This module implements a process that opens two specified FIFOs, one + * for reading and one for writing; reads from its stdin, and writes what + * it has read to the write FIF0; reads from the read FIFO, and writes to + * its stdout. + * + ________ _________ + | |--<-- pipe.r (fifo1) --<--| | + | to_erl | | run_erl | (parent) + |________|-->-- pipe.w (fifo2) -->--|_________| + ^ master pty + | + | slave pty + ____V____ + | | + | "erl" | (child) + |_________| + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#ifdef HAVE_SYS_IOCTL_H +# include +#endif + +#include "run_erl.h" +#include "safe_string.h" /* strn_cpy, strn_catf, sn_printf, etc. */ + +#if defined(O_NONBLOCK) +# define DONT_BLOCK_PLEASE O_NONBLOCK +#else +# define DONT_BLOCK_PLEASE O_NDELAY +# if !defined(EAGAIN) +# define EAGAIN -3898734 +# endif +#endif + +#ifdef HAVE_STRERROR +# define STRERROR(x) strerror(x) +#else +# define STRERROR(x) "" +#endif + +#define noDEBUG + +#define PIPE_DIR "/tmp/" +#define PIPE_STUBNAME "erlang.pipe" +#define PIPE_STUBLEN strlen(PIPE_STUBNAME) + +#ifdef DEBUG +#define STATUS(s) { fprintf(stderr, (s)); fflush(stderr); } +#else +#define STATUS(s) +#endif + +#ifndef FILENAME_MAX +#define FILENAME_MAX 250 +#endif + +static struct termios tty_smode, tty_rmode; +static int tty_eof = 0; +static int recv_sig = 0; +static int protocol_ver = RUN_ERL_LO_VER; /* assume lowest to begin with */ + +static int write_all(int fd, const char* buf, int len); +static int window_size_seq(char* buf, size_t bufsz); +static int version_handshake(char* buf, int len, int wfd); +#ifdef DEBUG +static void show_terminal_settings(struct termios *); +#endif + +static void handle_ctrlc(int sig) +{ + /* Reinstall the handler, and signal break flag */ + signal(SIGINT,handle_ctrlc); + recv_sig = SIGINT; +} + +static void handle_sigwinch(int sig) +{ + recv_sig = SIGWINCH; +} + +static void usage(char *pname) +{ + fprintf(stderr, "Usage: %s [-h|-F] [pipe_name|pipe_dir/]\n", pname); + fprintf(stderr, "\t-h\tThis help text.\n"); + fprintf(stderr, "\t-F\tForce connection even though pipe is locked by other to_erl process.\n"); +} + +int main(int argc, char **argv) +{ + char FIFO1[FILENAME_MAX], FIFO2[FILENAME_MAX]; + int i, len, wfd, rfd, result = 0; + fd_set readfds; + char buf[BUFSIZ]; + char pipename[FILENAME_MAX]; + int pipeIx = 1; + int force_lock = 0; + int got_some = 0; + + if (argc >= 2 && argv[1][0]=='-') { + switch (argv[1][1]) { + case 'h': + usage(argv[0]); + exit(1); + case 'F': + force_lock = 1; + break; + default: + fprintf(stderr,"Invalid option '%s'\n",argv[1]); + exit(1); + } + pipeIx = 2; + } + +#ifdef DEBUG + fprintf(stderr, "%s: pid is : %d\n", argv[0], (int)getpid()); +#endif + + strn_cpy(pipename, sizeof(pipename), + (argv[pipeIx] ? argv[pipeIx] : PIPE_DIR)); + + if(*pipename && pipename[strlen(pipename)-1] == '/') { + /* The user wishes us to find a pipe name in the specified */ + /* directory */ + int highest_pipe_num = 0; + DIR *dirp; + struct dirent *direntp; + + dirp = opendir(pipename); + if(!dirp) { + fprintf(stderr, "Can't access pipe directory %s.\n", pipename); + exit(1); + } + + /* Check the directory for existing pipes */ + + while((direntp=readdir(dirp)) != NULL) { + if(strncmp(direntp->d_name,PIPE_STUBNAME,PIPE_STUBLEN)==0) { + int num = atoi(direntp->d_name+PIPE_STUBLEN+1); + if(num > highest_pipe_num) + highest_pipe_num = num; + } + } + closedir(dirp); + strn_catf(pipename, sizeof(pipename), (highest_pipe_num?"%s.%d":"%s"), + PIPE_STUBNAME, highest_pipe_num); + } /* if */ + + /* read FIFO */ + sn_printf(FIFO1,sizeof(FIFO1),"%s.r",pipename); + /* write FIFO */ + sn_printf(FIFO2,sizeof(FIFO2),"%s.w",pipename); + + /* Check that nobody is running to_erl on this pipe already */ + if ((wfd = open (FIFO1, O_WRONLY|DONT_BLOCK_PLEASE, 0)) >= 0) { + /* Open as server succeeded -- to_erl is already running! */ + close(wfd); + fprintf(stderr, "Another to_erl process already attached to pipe " + "%s.\n", pipename); + if (force_lock) { + fprintf(stderr, "But we proceed anyway by force (-F).\n"); + } + else { + exit(1); + } + } + + if ((rfd = open (FIFO1, O_RDONLY|DONT_BLOCK_PLEASE, 0)) < 0) { +#ifdef DEBUG + fprintf(stderr, "Could not open FIFO %s for reading.\n", FIFO1); +#endif + fprintf(stderr, "No running Erlang on pipe %s.\n", pipename); + exit(1); + } +#ifdef DEBUG + fprintf(stderr, "to_erl: %s opened for reading\n", FIFO1); +#endif + + if ((wfd = open (FIFO2, O_WRONLY|DONT_BLOCK_PLEASE, 0)) < 0) { +#ifdef DEBUG + fprintf(stderr, "Could not open FIFO %s for writing.\n", FIFO2); +#endif + fprintf(stderr, "No running Erlang on pipe %s.\n", pipename); + close(rfd); + exit(1); + } +#ifdef DEBUG + fprintf(stderr, "to_erl: %s opened for writing\n", FIFO2); +#endif + + fprintf(stderr, "Attaching to %s (^D to exit)\n\n", pipename); + + /* Set break handler to our handler */ + signal(SIGINT,handle_ctrlc); + + /* + * Save the current state of the terminal, and set raw mode. + */ + if (tcgetattr(0, &tty_rmode) , 0) { + fprintf(stderr, "Cannot get terminals current mode\n"); + exit(-1); + } + tty_smode = tty_rmode; + tty_eof = '\004'; /* Ctrl+D to exit */ +#ifdef DEBUG + show_terminal_settings(&tty_rmode); +#endif + tty_smode.c_iflag = + 1*BRKINT |/*Signal interrupt on break.*/ + 1*IGNPAR |/*Ignore characters with parity errors.*/ + 1*ISTRIP |/*Strip character.*/ + 0; + +#if 0 +0*IGNBRK |/*Ignore break condition.*/ +0*PARMRK |/*Mark parity errors.*/ +0*INPCK |/*Enable input parity check.*/ +0*INLCR |/*Map NL to CR on input.*/ +0*IGNCR |/*Ignore CR.*/ +0*ICRNL |/*Map CR to NL on input.*/ +0*IUCLC |/*Map upper-case to lower-case on input.*/ +0*IXON |/*Enable start/stop output control.*/ +0*IXANY |/*Enable any character to restart output.*/ +0*IXOFF |/*Enable start/stop input control.*/ +0*IMAXBEL|/*Echo BEL on input line too long.*/ +#endif + + tty_smode.c_oflag = + 1*OPOST |/*Post-process output.*/ + 1*ONLCR |/*Map NL to CR-NL on output.*/ +#ifdef XTABS + 1*XTABS |/*Expand tabs to spaces. (Linux)*/ +#endif +#ifdef OXTABS + 1*OXTABS |/*Expand tabs to spaces. (FreeBSD)*/ +#endif +#ifdef NL0 + 1*NL0 |/*Select newline delays*/ +#endif +#ifdef CR0 + 1*CR0 |/*Select carriage-return delays*/ +#endif +#ifdef TAB0 + 1*TAB0 |/*Select horizontal tab delays*/ +#endif +#ifdef BS0 + 1*BS0 |/*Select backspace delays*/ +#endif +#ifdef VT0 + 1*VT0 |/*Select vertical tab delays*/ +#endif +#ifdef FF0 + 1*FF0 |/*Select form feed delays*/ +#endif + 0; + +#if 0 +0*OLCUC |/*Map lower case to upper on output.*/ +0*OCRNL |/*Map CR to NL on output.*/ +0*ONOCR |/*No CR output at column 0.*/ +0*ONLRET |/*NL performs CR function.*/ +0*OFILL |/*Use fill characters for delay.*/ +0*OFDEL |/*Fill is DEL, else NULL.*/ +0*NL1 | +0*CR1 | +0*CR2 | +0*CR3 | +0*TAB1 | +0*TAB2 | +0*TAB3 |/*Expand tabs to spaces.*/ +0*BS1 | +0*VT1 | +0*FF1 | +#endif + + /* JALI: removed setting the tty_smode.c_cflag flags, since this is not */ + /* advisable if this is a *real* terminal, such as the console. In fact */ + /* this may hang the entire machine, deep, deep down (signalling break */ + /* or toggling the abort switch doesn't help) */ + + tty_smode.c_lflag = + 0; + +#if 0 +0*ISIG |/*Enable signals.*/ +0*ICANON |/*Canonical input (erase and kill processing).*/ +0*XCASE |/*Canonical upper/lower presentation.*/ +0*ECHO |/*Enable echo.*/ +0*ECHOE |/*Echo erase character as BS-SP-BS.*/ +0*ECHOK |/*Echo NL after kill character.*/ +0*ECHONL |/*Echo NL.*/ +0*NOFLSH |/*Disable flush after interrupt or quit.*/ +0*TOSTOP |/*Send SIGTTOU for background output.*/ +0*ECHOCTL|/*Echo control characters as ^char, delete as ^?.*/ +0*ECHOPRT|/*Echo erase character as character erased.*/ +0*ECHOKE |/*BS-SP-BS erase entire line on line kill.*/ +0*FLUSHO |/*Output is being flushed.*/ +0*PENDIN |/*Retype pending input at next read or input character.*/ +0*IEXTEN |/*Enable extended (implementation-defined) functions.*/ +#endif + + tty_smode.c_cc[VMIN] =0;/* Note that VMIN is the same as VEOF! */ + tty_smode.c_cc[VTIME] =0;/* Note that VTIME is the same as VEOL! */ + tty_smode.c_cc[VINTR] =3; + + tcsetattr(0, TCSANOW, &tty_smode); + +#ifdef DEBUG + show_terminal_settings(&tty_smode); +#endif + /* + * "Write a ^R to the FIFO which causes the other end to redisplay + * the input line." + * This does not seem to work as was intended in old comment above. + * However, this control character is now (R12B-3) used by run_erl + * to trigger the version handshaking between to_erl and run_erl + * at the start of every new to_erl-session. + */ + write(wfd, "\022", 1); + + /* + * read and write + */ + while (1) { + FD_ZERO(&readfds); + FD_SET(0, &readfds); + FD_SET(rfd, &readfds); + if (select(rfd + 1, &readfds, NULL, NULL, NULL) < 0) { + if (recv_sig) { + FD_ZERO(&readfds); + } + else { + fprintf(stderr, "Error in select.\n"); + result = -1; + break; + } + } + len = 0; + + /* + * Read from terminal and write to FIFO + */ + if (recv_sig) { + switch (recv_sig) { + case SIGINT: + fprintf(stderr, "[Break]\n\r"); + buf[0] = '\003'; + len = 1; + break; + case SIGWINCH: + len = window_size_seq(buf,sizeof(buf)); + break; + default: + fprintf(stderr,"Unexpected signal: %u\n",recv_sig); + } + recv_sig = 0; + } + else if (FD_ISSET(0, &readfds)) { + len = read(0, buf, sizeof(buf)); + if (len <= 0) { + close(rfd); + close(wfd); + if (len < 0) { + fprintf(stderr, "Error in reading from stdin.\n"); + result = -1; + } else { + fprintf(stderr, "[EOF]\n\r"); + } + break; + } + /* check if there is an eof character in input */ + for (i = 0; i < len && buf[i] != tty_eof; i++); + if (buf[i] == tty_eof) { + fprintf(stderr, "[Quit]\n\r"); + break; + } + } + + if (len) { +#ifdef DEBUG + write(1, buf, len); +#endif + if (write_all(wfd, buf, len) != len) { + fprintf(stderr, "Error in writing to FIFO.\n"); + close(rfd); + close(wfd); + result = -1; + break; + } + STATUS("\" OK\r\n"); + } + + /* + * Read from FIFO, write to terminal. + */ + if (FD_ISSET(rfd, &readfds)) { + STATUS("FIFO read: "); + len = read(rfd, buf, BUFSIZ); + if (len < 0 && errno == EAGAIN) { + /* + * No data this time, but the writing end of the FIFO is still open. + * Do nothing. + */ + ; + } else if (len <= 0) { + /* + * Either an error or end of file. In either case, break out + * of the loop. + */ + close(rfd); + close(wfd); + if (len < 0) { + fprintf(stderr, "Error in reading from FIFO.\n"); + result = -1; + } else + fprintf(stderr, "[End]\n\r"); + break; + } else { + if (!got_some) { + if ((len=version_handshake(buf,len,wfd)) < 0) { + close(rfd); + close(wfd); + result = -1; + break; + } + if (protocol_ver >= 1) { + /* Tell run_erl size of terminal window */ + signal(SIGWINCH, handle_sigwinch); + raise(SIGWINCH); + } + got_some = 1; + } + + /* + * We successfully read at least one character. Write what we got. + */ + STATUS("Terminal write: \""); + if (write_all(1, buf, len) != len) { + fprintf(stderr, "Error in writing to terminal.\n"); + close(rfd); + close(wfd); + result = -1; + break; + } + STATUS("\" OK\r\n"); + } + } + } + + /* + * Reset terminal characterstics + * XXX + */ + tcsetattr(0, TCSANOW, &tty_rmode); + return 0; +} + +/* Call write() until entire buffer has been written or error. + * Return len or -1. + */ +static int write_all(int fd, const char* buf, int len) +{ + int left = len; + int written; + while (left) { + written = write(fd,buf,left); + if (written < 0) { + return -1; + } + left -= written; + buf += written; + } + return len; +} + +static int window_size_seq(char* buf, size_t bufsz) +{ +#ifdef TIOCGWINSZ + struct winsize ws; + static const char prefix[] = "\033_"; + static const char suffix[] = "\033\\"; + /* This Esc sequence is called "Application Program Command" + and seems suitable to use for our own customized stuff. */ + + if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) { + int len = sn_printf(buf, bufsz, "%swinsize=%u,%u%s", + prefix, ws.ws_col, ws.ws_row, suffix); + return len; + } +#endif /* TIOCGWINSZ */ + return 0; +} + +/* to_erl run_erl + * | | + * |---------- '\022' -------->| (session start) + * | | + * |<---- "[run_erl v1-0]" ----| (version interval) + * | | + * |--- Esc_"version=1"Esc\ -->| (common version) + * | | + */ +static int version_handshake(char* buf, int len, int wfd) +{ + unsigned re_high=0, re_low; + char *end = find_str(buf,len,"]\n"); + + if (end && sscanf(buf,"[run_erl v%u-%u",&re_high,&re_low)==2) { + char wbuf[30]; + int wlen; + + if (re_low > RUN_ERL_HI_VER || re_high < RUN_ERL_LO_VER) { + fprintf(stderr,"Incompatible versions: to_erl=v%u-%u run_erl=v%u-%u\n", + RUN_ERL_HI_VER, RUN_ERL_LO_VER, re_high, re_low); + return -1; + } + /* Choose highest common version */ + protocol_ver = re_high < RUN_ERL_HI_VER ? re_high : RUN_ERL_HI_VER; + + wlen = sn_printf(wbuf, sizeof(wbuf), "\033_version=%u\033\\", + protocol_ver); + if (write_all(wfd, wbuf, wlen) < 0) { + fprintf(stderr,"Failed to send version handshake\n"); + return -1; + } + end += 2; + len -= (end-buf); + memmove(buf,end,len); + + } + else { /* we assume old run_erl without version handshake */ + protocol_ver = 0; + } + + if (re_high != RUN_ERL_HI_VER) { + fprintf(stderr,"run_erl has different version, " + "using common protocol level %u\n", protocol_ver); + } + + return len; +} + + +#ifdef DEBUG +#define S(x) ((x) > 0 ? 1 : 0) + +static void show_terminal_settings(struct termios *t) +{ + fprintf(stderr,"c_iflag:\n"); + fprintf(stderr,"Signal interrupt on break: BRKINT %d\n", S(t->c_iflag & BRKINT)); + fprintf(stderr,"Map CR to NL on input: ICRNL %d\n", S(t->c_iflag & ICRNL)); + fprintf(stderr,"Ignore break condition: IGNBRK %d\n", S(t->c_iflag & IGNBRK)); + fprintf(stderr,"Ignore CR: IGNCR %d\n", S(t->c_iflag & IGNCR)); + fprintf(stderr,"Ignore char with par. err's: IGNPAR %d\n", S(t->c_iflag & IGNPAR)); + fprintf(stderr,"Map NL to CR on input: INLCR %d\n", S(t->c_iflag & INLCR)); + fprintf(stderr,"Enable input parity check: INPCK %d\n", S(t->c_iflag & INPCK)); + fprintf(stderr,"Strip character ISTRIP %d\n", S(t->c_iflag & ISTRIP)); + fprintf(stderr,"Enable start/stop input ctrl IXOFF %d\n", S(t->c_iflag & IXOFF)); + fprintf(stderr,"ditto output ctrl IXON %d\n", S(t->c_iflag & IXON)); + fprintf(stderr,"Mark parity errors PARMRK %d\n", S(t->c_iflag & PARMRK)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_oflag:\n"); + fprintf(stderr,"Perform output processing OPOST %d\n", S(t->c_oflag & OPOST)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_cflag:\n"); + fprintf(stderr,"Ignore modem status lines CLOCAL %d\n", S(t->c_cflag & CLOCAL)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_local:\n"); + fprintf(stderr,"Enable echo ECHO %d\n", S(t->c_lflag & ECHO)); + fprintf(stderr,"\n"); + fprintf(stderr,"c_cc:\n"); + fprintf(stderr,"c_cc[VEOF] %d\n", t->c_cc[VEOF]); +} +#endif diff --git a/erts/etc/vxworks/README.VxWorks b/erts/etc/vxworks/README.VxWorks new file mode 100644 index 0000000000..299e35b513 --- /dev/null +++ b/erts/etc/vxworks/README.VxWorks @@ -0,0 +1,350 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 1997-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +----------------------------------------------------------------------- +README, Erlang/OTP R11B for VxWorks on PPC860 and PPC603 +----------------------------------------------------------------------- +20060515 -- Patrik Nyblom, support@erlang.ericsson.se + +R11B is a libraries only release for VxWorks. Only the libraries of +erl_interface (ei+erl_inteface) and ic are expected to be used. Still +the whole erlang system is distributed, although no support will be +given for anything else but the libraries. The information in this +file still applies to the full erlang distribution and parts of it are +therefore somewhat irrelevant to commercial users. + + +Included OTP applications +------------------------- + +appmon +asn1 +compiler +cosEvent +cosNotification +cosTime +cosTransaction +debugger +erl_interface +erts +eva [1] +ic +inets [2] +jinterface +kernel +mesh +mnemosyne +mnesia [1] +mnesia_session +orber +os_mon +pman +runtime_tools +sasl +snmp +stdlib +tools +tv + +[1] Only ram_copies work, The VxWorks filesystems are not + reliable enough for disk_copies to be fully supported. +[2] CGI scripts do not work on VxWorks. + +Omitted applications +-------------------- + +crypto +emacs +etk +gs +odbc +parsetools +toolbar +ssl +megaco +webtools + +As `crypto' and `ssl' provides cryptographic functionality to `inets' +and `snmp', the latter applications will not handle cryptography on +VxWorks. + +Graphical interfaces +-------------------- + +For applications using graphical interfaces, only the backend part works. + +Compilers +--------- + +All compilers are expected to be run on a cross host. The VxWorks +systems memory capabilities are too restricting to allow native +compiling. The expected host system is a Sun Solaris machine, although +Erlang compilation may be done on most platforms. + +Supported boards and configuration (only libraries supported) +---------------------------------- +The following boards and configurations are supported: + +* Force PowerCore 603 with Force pcore603 BSP and VxWorks 3.5.1 (no + SENS or SENS 1.1 + SPR23938) and a minimum of 32 Mb memory. + +* Force Powercore 750 with Force pcore750 BSP and VxWorks 3.5.1 (no + SENS or SENS 1.1 + SPR23938) and a minimum of 32 Mb memory. + +* PSS Core PPC860 processors, only erl_interface (too small main memory). + +Most PowerPC boards with FPU are expected to work, but will need to be +tested by OTP to be fully supported. + +The PPC603 build has been compiled with Wind River's `-mlongcall' +flag (SPR25893) to support arbitrary function calls across more +than 32 MB of memory. + +The PPC860 (PowerQuicc) has no FPU and requires a separate build. + +For Erlang to run, the Wind kernel has to be configured with a minimum +of these variables defined in config.h (or by the Tornado +configuration tool): + + INCLUDE_ANSI_ALL + INCLUDE_ENV_VARS + INCLUDE_EXC_HANDLING + INCLUDE_EXC_TASK + INCLUDE_FLOATING_POINT + INCLUDE_FORMATTED_IO + INCLUDE_IO_SYSTEM + INCLUDE_LOADER + INCLUDE_NETWORK + INCLUDE_NET_INIT + INCLUDE_NET_SHOW + INCLUDE_NET_SYM_TBL or INCLUDE_STANDALONE_SYM_TBL + INCLUDE_PIPES + INCLUDE_POSIX_FTRUNC + INCLUDE_RLOGIN or INCLUDE_TELNET (for pty's only) + INCLUDE_SELECT + INCLUDE_SEM_BINARY + INCLUDE_SEM_COUNTING + INCLUDE_SEM_MUTEX + INCLUDE_SHELL (*) + INCLUDE_SHOW_ROUTINES + INCLUDE_SIGNALS + INCLUDE_STARTUP_SCRIPT (*) + INCLUDE_STDIO + INCLUDE_SYM_TBL + INCLUDE_TASK_HOOKS + INCLUDE_TASK_VARS + INCLUDE_TTY_DEV + INCLUDE_UNLOADER + INCLUDE_NFS or INCLUDE_RAMDRV or INCLUDE_DOSFS (i.e. a file system, + possibly read-only) (**) + +(*) Needed for the example startup script, not actually needed in production if + erlang is set up by a c routine called from usrConfig.c. +(**) INCLUDE_NFS usually requires the NFS_USER_ID and NFS_GROUP_ID variables + to be set in config.h + +As an erlang system may open a lot of files, it is recommended to raise the +default NUM_FILES variable to something like 256 in config.h like this: + #ifdef NUM_FILES + #undef NUM_FILES + #endif + #define NUM_FILES 256 + +The SENS stack *has* to be of version 1.1 or higher, 1.0 is *not* +supported and will not work reliably. Upgrades as well as the patch +for SPR23938 can be found at www.wrs.com (i.e. WindSurf). Also, the +following constants in $WIND_BASE/target/h/netBufLib.h has to be +raised to a value of at least four times the default: + + NUM_NET_MBLKS + NUM_64 + NUM_128 + NUM_256 + NUM_512 + NUM_1024 + NUM_2048 + + NUM_SYS_64 + NUM_SYS_128 + NUM_SYS_256 + NUM_SYS_512 + +Use the show routines mbufShow and netStackSysPoolShow to verify that +these pools are not exhausted. + +Installation +------------ + +To install Erlang on a VxWorks card, the following knowledge is +expected: + +* VxWorks installation and configuration. + +* Network (TCP/IP) configuration. + +* Erlang basic operation and configuration. + +There is no specific install script for erlang on the VxWorks +platform. There is however an example VxWorks startup file named +erts-5.0.1/bin/erl_script.sam under the root of an unpacked +release. There may of course be other things to do in the start +script, like using the rdate program in the erlang distribution to get +a correct date and set the TIMEZONE variable. + +Please consult the "Embedded System" documentation for further +information on installation. + +Known Bugs and problems +----------------------- + +We have found the VxWorks/NFS client file system to be unreliable. +Important file operations like rename, ftruncate, cd and unlink +doesn't always work as expected. Therefore more complex file using +parts of OTP, like DETS and disk based mnesia tables cannot be used +reliably with NFS. Lowering the NFS cache size (global variable +nfsCacheSize) to 512 gives a more reliable NFS client, but to disk +base the mnesia tables over NFS is still not a good idea, especially +as disk based mnesia tables are not supported on VxWorks. Another +problem with VxWorks file systems is that the error codes they produce +are not consistent. We have worked around this problem by mapping the +codes to POSIX ones, by doing this we make the VxWorks Erlang platform +behave similarly to the UNIX and Windows implementations. + +The rename and ftruncate operations over NFS are emulated using +copying of files. This is mainly for our own test suites and it is not +recommended to use file:rename and/or file:ftruncate on NFS file +systems in production. + +Floating point operations is somewhat faulty. For instance, testing +floating point numbers for equality should be done with care. This is +actually not a bug, IEEE specifies no equality among floating point +numbers. + +Memory handling +--------------- + +Please read the erl_set_memory_block(3) manual page in the ERTS +documentation for information concerning memory handling in the erlang +emulator. Also please observe that reclaim.o has to be loaded and +reclaim_init() called before any other erlang routines are loaded and +started. If one wish to use the resource reclamation routines in other +programs, refer to the header file in `erts-5.0.1/include/reclaim.h'. +Including that file in your C source makes malloc/realloc/free and +open/fopen/socket/close etc be redefined to routines that makes the +memory and files be free'd/closed when the task exits. Still, +reclaim_init() *has* to be called before any program that uses this is +started. + +Using heart +----------- + +The default behavior of the heart object file that is part of the +distribution is that it reboots the target when the Erlang process +hasn't given it a heart beat in 60 seconds. The normal heart beat rate +is one beat per five seconds. This makes an effective "software +watchdog" but there is really no substitute for the real thing --- a +hardware watchdog. If you want to add a hardware watchdog to the +system please contact us for directions. If you want to disable the +reboot you may set the environment variable HEART_DONT_REBOOT (see the +example erlang start script, erl). Please note that if you DO want the +card to reboot you mustn't define HEART_DONT_REBOOT at all. E.g. to +disable heart reboot you may include the following line in the start +script (as is indeed the case with the example start script). + + putenv "HEART_DONT_REBOOT=1" + +A few words on writing port program and dynamically loaded drivers for VxWorks +------------------------------------------------------------------------------ + +VxWorks has one name-space for all symbols. This makes it harder to +write C programs whose global symbols doesn't interfere with each +other. It is a good rule to avoid all globally visible symbols that +are not absolutely necessary. Due to these facts we use the following +naming rules that are crucial to follow. (there are more issues +involved but the issues described here is a good beginning). + +Port programs must have a function with the same name as the object +file. E.g. if you have an object file named `port_test.o' it must +contain a globally visible function named `port_test'. This is the +function that will be called when you output data from Erlang to the +port. (The object file, in this example, should be named +`port_test.o', but `port_test' will also do). + +Also, in an embedded system, it is recommended to load the port +program into the system before the port program is used. This is to +avoid the real time degradation dynamical linking in runtime would +introduce. Use VxWorks command ld < "port_prg" to accomplish this. + +Dynamically linked drivers must have a function with the same name as +the object file with the added suffix `_init'. We recommend the use of +the macro DRIVER_INIT in `driver.h'. E.g. if you have an object file +named `echo_drv.eld' it must contain a globally visible function +`echo_drv_init'. (The object file, in this example, should be named +`echo_drv.eld' (`eld' is short for Erlang Loadable Driver), but +`echo_drv.o' and `echo_drv' will both also do). It is also very +important to initialize all unused function pointer in the +`driver_entry' struct to NULL (see example below). + +Example of dynamically linked driver +------------------------------------ + +#include +#include "driver.h" + +static int erlang_port; +static long echo_start(); +static int echo_stop(), echo_read(); + +static struct driver_entry echo_driver_entry = { + null_func, + echo_start, + echo_stop, + echo_read, + null_func, + null_func, + "echo_drv", + null_func +}; + +int DRIVER_INIT(echo_drv)(void *handle) +{ + erlang_port = -1; + + echo_driver_entry.handle = handle; + return (int) &echo_driver_entry; +} + +static long echo_start(long port,char *buf) +{ + if (erlang_port != -1) { + return -1; + } + + erlang_port = port; + return port; +} + +static int echo_read(long port, char *buf, int count) +{ + return driver_output(erlang_port, buf, count); +} + +static int echo_stop() +{ + return erlang_port = -1; +} diff --git a/erts/etc/vxworks/erl.exec.c b/erts/etc/vxworks/erl.exec.c new file mode 100644 index 0000000000..6b45ebaa39 --- /dev/null +++ b/erts/etc/vxworks/erl.exec.c @@ -0,0 +1,129 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + A simpified version of the 'erl.exec' "startup script". + Called (e.g. from VxWorks shell) with all arguments in a + single string, e.g.: erl "-name thisnode -s mymod myfunc". + These arguments are handled as in 'erl.exec': + -name + -sname + -noshell + -noinput + anything else is just passed on to the emulator. Note that there + is no automatic start of epmd, that -oldshell is implicit, and + that you need to set current directory appropriately if you want + auto-load of port programs +*/ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include +#include +#include + +#ifndef DEFAULT_HOMEDIR /* used if environment HOME isn't set */ +#define DEFAULT_HOMEDIR "/" +#endif + +#define ARGLEN 2048 /* Total length of args passed to erl_main */ +#define ARGMAX 64 /* Max no of "extra" args */ + +static char *erl_cmd = "erl_main -n "; + +static toomuch() +{ + fprintf(stderr, "erl: Too many arguments\n"); + return(-1); +} + +static toolittle(arg) +char *arg; +{ + fprintf(stderr, "erl.exec: Missing argument for %s\n", arg); + return(-1); +} + +erl_exec(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10) +int arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10; +{ + char *shell = "-oldshell ", *noshell = "", + *home, *rootdir, *bindir, *progname; + char cmd[ARGLEN], eargs[ARGLEN], iargs[ARGLEN]; + char *args[ARGMAX], *arglast = NULL, *argp; + int nargs = 0, len, i; + + if ((rootdir = getenv("ROOTDIR")) == NULL || + (bindir = getenv("BINDIR")) == NULL || + (progname = getenv("PROGNAME")) == NULL) { + fprintf(stderr, "erl.exec: ROOTDIR, BINDIR, and PROGNAME must be set."); + return -1; + } + eargs[0] = '\0'; + iargs[0] = '\0'; + if ((home = getenv("HOME")) == NULL) + home = DEFAULT_HOMEDIR; + argp = strtok_r((char *)arg1, " \t", &arglast); + while (argp != NULL) { + if (strcmp(argp, "-name") == 0) { + if ((argp = strtok_r((char *)NULL, " \t", &arglast)) == NULL) + return(toolittle("-name")); + strcat(iargs, "-name "); + strcat(iargs, argp); + strcat(iargs, " "); + } else if (strcmp(argp, "-sname") == 0) { + if ((argp = strtok_r((char *)NULL, " \t", &arglast)) == NULL) + return(toolittle("-sname")); + strcat(iargs, "-sname "); + strcat(iargs, argp); + strcat(iargs, " "); + } else if (strcmp(argp, "-noshell") == 0) { + strcat(iargs, "-noshell -noinp_shell "); + } else if (strcmp(argp, "-noinput") == 0) { + strcat(iargs, "-noshell -noinput "); + } else { + if (nargs > ARGMAX - 1) + return(toomuch()); + args[nargs++] = argp; + } + argp = strtok_r((char *)NULL, " \t", &arglast); + } + strcpy(cmd, erl_cmd); + strcat(cmd, eargs); + strcat(cmd, " -- -root "); + strcat(cmd, rootdir); + strcat(cmd, " -progname "); + strcat(cmd, progname); + strcat(cmd, " -- "); + strcat(cmd, "-home "); + strcat(cmd, home); + strcat(cmd, " "); + strcat(cmd, iargs); + + len = strlen(cmd); + for (i = 0; i < nargs; i++) { + if (len + strlen(args[i]) + 2 >= ARGLEN) + return(toomuch()); + cmd[len++] = ' '; + strcpy(&cmd[len], args[i]); + len += strlen(args[i]); + } + argcall(cmd); +} + diff --git a/erts/etc/vxworks/erl_io.c b/erts/etc/vxworks/erl_io.c new file mode 100644 index 0000000000..0032b77079 --- /dev/null +++ b/erts/etc/vxworks/erl_io.c @@ -0,0 +1,108 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* Some stuff to let the Erlang and VxWorks shells coexist peacefully. + Basically, run Erlang as a spawned task with input redirected to + the slave side of a pseudo-tty, and connect explicitly to the master + side of the pseudo-tty to send input to Erlang when desired. */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include +#include +#include +#include + +extern int spTaskPriority, spTaskOptions; + +#define TBUFSIZ 512 + +#define DEFAULT_STACK_SIZE 100000 + +static int slavefd = -1, masterfd = -1; +static run_erl(); + +/* Frontend to the Erlang startup function - callable from VxWorks shell + or script. 'arg' is actually a string passed to the real startup. */ +start_erl(arg) +int arg; +{ + int stacksize; + char *stackenv; + + /* create and open the pty - we want the master side to be open + all the time, since closing it probably generates EOF on the + slave side */ + (void)ptyDevCreate("/pty/erlang.", TBUFSIZ, TBUFSIZ); + if (slavefd != -1) + (void)close(slavefd); + slavefd = open("/pty/erlang.S", O_RDONLY, 0); + if (masterfd != -1) + (void)close(masterfd); + masterfd = open("/pty/erlang.M", O_WRONLY, 0); + + /* flush any old leftover garbage */ + (void) ioctl(masterfd, FIOFLUSH, 0); + if ((stackenv = getenv("ERLSTACKSIZE")) == NULL) + stacksize = DEFAULT_STACK_SIZE; + else + stacksize = atoi(stackenv); + /* spawn Erlang, via stub below */ + return(taskSpawn("erlang", spTaskPriority, spTaskOptions, stacksize, + run_erl, arg, 0,0,0,0,0,0,0,0,0)); +} + +/* Little stub that runs in the spawned task - we need this to redirect + stdin reliably (redirections aren't "inherited" in VxWorks) */ +static +run_erl(arg) +int arg; +{ + ioTaskStdSet(0, 0, slavefd); /* redirect stdin to slave side of pty */ + + /* We don't want to redirect stdout/err since no one will be reading + from the master side (to_erl - and the open()s above - could be + made bidirectional, but still the master side would only be read + when to_erl was running), and output can eventually fill the pty + buffer and cause the Erlang system to block. Not redirecting + stdout/err will have the effect that output from Erlang, e.g. the + shell prompt, will appear on console/rlogin/whatever even when + to_erl isn't running, which may be confusing - can't win 'em all... */ + + erl_exec(arg, 0,0,0,0,0,0,0,0); /* call the real startup */ +} + +/* Function callable from VxWorks shell to talk to Erlang - stop talking + and return to VxWorks shell through ^D (EOF) */ +to_erl() +{ + char buf[TBUFSIZ]; + int cc; + + if (masterfd == -1) { /* sanity check */ + fprintf(stderr, "Must start_erl first!\n"); + return(-1); + } + while ((cc = read(0, buf, TBUFSIZ)) > 0) /* just pass everything through */ + if (write(masterfd, buf, cc) != cc) { + fprintf(stderr, "Write to Erlang failed!\n"); + return(-1); + } + return(cc); +} diff --git a/erts/etc/vxworks/erl_script.sam.in b/erts/etc/vxworks/erl_script.sam.in new file mode 100644 index 0000000000..81c2b0128d --- /dev/null +++ b/erts/etc/vxworks/erl_script.sam.in @@ -0,0 +1,100 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# +# erl_script.sam +# Sample VxWorks script to start Erlang +# +# Note! This is not a complete or ready to use VxWorks startup script, +# rather an example of what You should add to Your existing startupscript +# to execute the erlang emulator at boot. +# +# When writing Your own script to start erlang, the paths to +# the binaries have to be changed to reflect your system. +# +# The ROOTDIR variable should not point to a ftp or rcp filesystem unless +# the erlang machine is run in embedded mode. Loading of modules +# is far to slow if the erlang binaries are not placed on a real filesystem +# like NFS or any type of local filesystem. +# + +# +# Load modules +# + +# +# First load and initiate the reclaim facility +# +ld +#include +#include +#include +#include + +/* wd_init is executed to initialize a watchdog (if one is used). */ +int wd_init(timeout, prio) + int timeout, prio; +{ + +} + +/* wd_reset should be called every 5th second from heart */ +void wd_reset() +{ + +} + +/* This routine is called when erlang has closed */ +void heart_reboot() +{ + if (getenv("HEART_DONT_REBOOT") != NULL) { + fprintf(stderr, "heart_config: HEART_DONT_REBOOT set, no reboot ...\n"); + } else { + fprintf(stderr, "heart_config: rebooting ...\n"); + taskDelay(sysClkRateGet() * 5); + reboot(BOOT_CLEAR); + } +} + + + + diff --git a/erts/etc/vxworks/heart_config.h b/erts/etc/vxworks/heart_config.h new file mode 100644 index 0000000000..5ffaaa8c3f --- /dev/null +++ b/erts/etc/vxworks/heart_config.h @@ -0,0 +1,35 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * This is heart's watchdog interface for VxWorks. + */ + +#ifndef _HW_WATCHDOG_H +#define _HW_WATCHDOG_H + +extern void wd_init(int timeout, int prio); /* wd_init initializes the + watchdog, if one is used. */ +extern void wd_reset(void); /* wd_reset is used by heart to kick + the watchdog, if one is used. */ +extern void heart_reboot(void); /* reboot is called if heart discovers + that the Erlang task has stopped sending + heart beats. It can log system status + and should reboot VxWorks. */ + +#endif diff --git a/erts/etc/vxworks/rdate.c b/erts/etc/vxworks/rdate.c new file mode 100644 index 0000000000..3e8cc644d0 --- /dev/null +++ b/erts/etc/vxworks/rdate.c @@ -0,0 +1,87 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include +#include +#ifdef NETDB +#include +#endif +#include +#include + +/* + rdate("host") - Set the time from "host". +*/ + +/* No getservbyname() available... */ +#define TIME_PORT 37 + +rdate(host) +char *host; +{ + u_long haddr; +#ifdef NETDB + struct hostent *hp; +#endif + struct sockaddr_in saddr; + int sock; + u_long net_time; + struct timespec t; + + if ((haddr = inet_addr(host)) == ERROR) { +#ifdef NETDB + if ((hp = gethostbyname(host)) == NULL) { +#else + if ((haddr = hostGetByName(host)) == ERROR) { +#endif + printf("Host not found.\n"); + return(-1); + } +#ifdef NETDB + memcpy(&haddr, hp->h_addr, sizeof(haddr)); +#endif + } + memset(&saddr, 0, sizeof(saddr)); + saddr.sin_family = AF_INET; + memcpy(&saddr.sin_addr, &haddr, sizeof(haddr)); + saddr.sin_port = htons(TIME_PORT); + if ((sock = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)) < 0) { + perror("socket"); + return(-1); + } + if (connect(sock, (struct sockaddr *)&saddr, sizeof(saddr)) < 0) { + perror("connect"); + close(sock); + return(-1); + } + if (read(sock, &net_time, 4) != 4) { + perror("read"); + close(sock); + return(-1); + } + t.tv_sec = ntohl(net_time); + t.tv_sec -= 2208988800; /* seconds 1900-01-01 -- 1970-01-01 */ + t.tv_nsec = 0; + clock_settime(CLOCK_REALTIME, &t); + close(sock); + return(0); +} diff --git a/erts/etc/vxworks/reclaim.c b/erts/etc/vxworks/reclaim.c new file mode 100644 index 0000000000..d8676b3750 --- /dev/null +++ b/erts/etc/vxworks/reclaim.c @@ -0,0 +1,551 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include +#include +#include +#include +#include + + + +#define RECLAIM_NO_ALIAS /* No #defines for open/malloc/fopen etc */ +#include "reclaim.h" +#include "reclaim_private.h" + +#undef open +#undef creat +#undef socket +#undef accept +#undef close +#undef fopen +#undef fdopen +#undef freopen +#undef fclose +/* XXX Should do opendir/closedir too... */ +#undef malloc +#undef calloc +#undef realloc +#undef free +#undef cfree + +#ifdef _ARCH_PPC +#define MAX_FILES_SYM_NAME "maxFiles" +#else +#define MAX_FILES_SYM_NAME "_maxFiles" +#endif + + +/* + * Use another free() function upon task deletion? + * Note! When changing free function, the new free function will have to + * be able to cope with ALL previously used malloced areas, that is + * it has to be able to find out how things are malloced + * to free them in the right way! + */ +static FreeFunction reclaim_free_function = NULL; + +/* delete hook handling (see below) */ +static int hook_added = 0; /* Initated at first reclaim_init, an extra + non MT-safe check that we only get + initialized once */ + +/* Forward... */ +static void save_reclaim(WIND_TCB *tcbp); + +struct mall_data { + struct mall_data *next; + char *self; +}; + +struct task_data { + FUNCPTR version; /* To recognize when we have reloaded */ + int max_files; /* It may change... */ + struct fd_set open_fds; + struct mall_data *mall_data; + FUNCPTR delete_hook; + caddr_t hook_data; + FILE *open_fps[1]; /* Will be max_files long */ +} *task_data = NULL; + +static int max_files = 50; /* default configAll.h */ + +int reclaim_max_files(void) +{ + return max_files; +} + +#ifdef DEBUG +#define check_hook() \ +((task_data != NULL || \ + fdprintf(2,"check_hook() TID = 0x%08x, Called from line %d\n", \ + (unsigned int)taskIdSelf(),\ + __LINE__)) && \ +(task_data != NULL || \ + (taskVarAdd(0, (int *)&task_data) == OK && \ + (task_data = (struct task_data *)\ + calloc(1, sizeof(struct task_data) + max_files*sizeof(FILE *))) != NULL && \ + (task_data->version = (FUNCPTR)save_reclaim) != NULL && \ + (task_data->max_files = max_files) != 0 && \ + fdprintf(2,"taskVar Added for 0x%08x\n",(unsigned int)taskIdSelf())))) +#else +#define check_hook() \ +(task_data != NULL || \ + (taskVarAdd(0, (int *)&task_data) == OK && \ + (task_data = (struct task_data *)\ + calloc(1, sizeof(struct task_data) + max_files*sizeof(FILE *))) != NULL && \ + (task_data->version = (FUNCPTR)save_reclaim) != NULL && \ + (task_data->max_files = max_files) != 0)) +#endif + +/* + * Global initialization of the reclaim data structures, mainly + * the max_files variable. This HAS to be called by some task before + * the first task that utilizes this exit's, preferrably before any + * task makes the first use of this library. + */ +STATUS reclaim_init(void) +{ + int *mp; + SYM_TYPE type; + struct task_data *tdp; + int i; + + if (!hook_added) { + /* race condition */ + ++hook_added; + /* Try to find the maxFiles value */ + if (symFindByNameAndType(sysSymTbl, MAX_FILES_SYM_NAME, (char **)&mp, + &type, + N_EXT | N_BSS, N_EXT | N_BSS) == OK || + symFindByNameAndType(sysSymTbl, MAX_FILES_SYM_NAME, (char **)&mp, + &type, + N_EXT | N_DATA, N_EXT | N_DATA) == OK) { + +#ifdef DEBUG + fdprintf(2, "Found maxFiles=%d\n", *mp); +#endif + if (*mp <= FD_SETSIZE) + max_files = *mp; + else + max_files = FD_SETSIZE; + } + if (task_data != NULL && task_data->max_files != max_files) { + /* fix our own iff we have one */ + if ((tdp = (struct task_data *) + realloc(task_data, sizeof(struct task_data) + + max_files*sizeof(FILE *))) != NULL) { + task_data = tdp; + for (i = task_data->max_files; i < max_files; i++) + task_data->open_fps[i] = NULL; + task_data->max_files = max_files; + } + } + /* Make sure taskVariables are deleted AFTER our hook is run. */ + taskVarInit(); + if(taskDeleteHookAdd((FUNCPTR)save_reclaim) != OK) { + fprintf(stderr, + "Panic: taskDeleteHook cannot be added for reclaim.\n"); + return ERROR; + } + return OK; + } else + return ERROR; +} + +/* N.B.!! We do *not* execute in the context of the dying task here, + but rather that of tExcTask - we do get a pointer to the task's + TCB though - this pointer is in fact also the task's ID. */ +static void save_reclaim(WIND_TCB *tcbp) +{ + int i, var, oldfd; + struct task_data *tdp; + struct mall_data *mdp, *mdnextp; + + if ((var = taskVarGet((int)tcbp, (int *)&task_data)) != ERROR && + var != 0) { + tdp = (struct task_data *)var; + if (tdp->version == (FUNCPTR)save_reclaim) { /* Only handle our own */ +#ifdef DEBUG + fdprintf(2, "Reclaiming for task id 0x%x:\nFiles: ", (int)tcbp); +#endif + /* Ugh! VxWorks doesn't even flush stdout/err - we need to + get at those (which are task-private of course, i.e. we + can't just do fflush(stdout) here) - we could be really + pedantic and try to redefine stdout/err (which "are" + function calls) too, snarfing the values when they are + used - but besides the overhead this is problematic since + they are actually #defines already... We'll peek in the + TCB instead (no documentation of course). And of course, + we must also meddle with the *file descriptor* indirections, + or we'll just flush out on tExcTask's descriptors... */ + for (i = 1; i <= 2; i++) { + if (tcbp->taskStdFp[i] != NULL) { +#ifdef DEBUG + fdprintf(2, "fflush(%s) ", i == 1 ? "stdout" : "stderr"); +#endif + oldfd = ioTaskStdGet(0, i); + ioTaskStdSet(0, i, tcbp->taskStd[i]); + fflush(tcbp->taskStdFp[i]); + ioTaskStdSet(0, i, oldfd); + } + } + for (i = 3; i < tdp->max_files; i++) { + if (FD_ISSET(i, &tdp->open_fds)) { +#ifdef DEBUG + fdprintf(2, "close(%d) ", i); +#endif + (void) close(i); + } + if (tdp->open_fps[i] != NULL) { +#ifdef DEBUG + fdprintf(2, "fclose(%0x%x) ", (int)tdp->open_fps[i]); +#endif + (void) fclose(tdp->open_fps[i]); + } + } + i = 0; + mdp = tdp->mall_data; + while (mdp != NULL) { + mdnextp = mdp->next; + if(reclaim_free_function != NULL) + (*reclaim_free_function)(mdp->self); + else + free(mdp->self); + i++; + mdp = mdnextp; + } +#ifdef DEBUG + fdprintf(2, "\nFreeing memory: total %d mallocs\n", i); +#endif + + if (tdp->delete_hook != NULL) { +#ifdef DEBUG + fdprintf(2, "Calling delete hook at 0x%08x\n", tdp->delete_hook); +#endif + (*tdp->delete_hook)(tdp->hook_data); +#ifdef DEBUG + fdprintf(2, "Called delete hook at 0x%08x\n", tdp->delete_hook); +#endif + } +#ifdef DEBUG + fdprintf(2, "Freeing own mem at 0x%08x\n", tdp); +#endif + (void) free((char *)tdp); +#ifdef DEBUG + fdprintf(2, "Freed own mem at 0x%08x, done (0x%08x)\n**********\n", tdp, + taskIdSelf()); + checkStack(0); +#endif + } + } +#ifdef DEBUG + else + fdprintf(2, "No task data found for id 0x%x, var = %d\n", (int)tcbp, var); +#endif +} + +/* + * This sets another free function to be used by the task deletion hook. + * The free function HAS to be able to free ANY type of dynamically allocated + * memory that can be in the task data list of allocated memory, that is + * also memory that's allocated before the free function was set. + * A "user-supplied" free function is GLOBAL to the system!!! + * A race condition is present, a task delete hook may be running when this + * function is called, that may not be especially funny... + */ +void set_reclaim_free_function(FreeFunction f){ + reclaim_free_function = f; +} + +void save_delete_hook(FUNCPTR func, caddr_t parm) +{ + if (check_hook()) { + task_data->delete_hook = func; + task_data->hook_data = parm; + } +} + +/* + * plain_malloc is only used by spawn_start; plain_free by call_proc; + * save_fd is used by both. + */ +void *plain_malloc(size_t size){ + return(malloc(size)); +} + +void *plain_realloc(void *ptr, size_t size){ + return(realloc(ptr, size)); +} + +void plain_free(void *ptr){ + free(ptr); +} + +void save_fd(int fd){ + if (fd >= 0 && check_hook() && fd < task_data->max_files) + FD_SET(fd, &task_data->open_fds); +} + +int save_open(char *path, int flags, /*mode_t mode*/ ...){ + int fd; + mode_t mode = 0; + if(flags & O_CREAT){ + va_list pvar; + va_start(pvar,flags); +#ifdef __GNUC__ +#warning save_open() gives three known alignment warnings. +#endif + mode = va_arg(pvar, mode_t); + va_end(pvar); + } + if ((fd = open(path, flags, mode)) >= 0 && check_hook()) + FD_SET(fd, &task_data->open_fds); + return(fd); +} + +int save_creat(char *path, int mode){ + int fd; + if ((fd = creat(path, mode)) >= 0 && check_hook()) + FD_SET(fd, &task_data->open_fds); + return(fd); +} + +int save_socket(int domain, int type, int protocol){ + int fd; + if ((fd = socket(domain, type, protocol)) >= 0 && check_hook()) + FD_SET(fd, &task_data->open_fds); + return(fd); +} + +int save_accept(int s, struct sockaddr *addr, int *addrlen){ + int fd; + if ((fd = accept(s, addr, addrlen)) >= 0 && check_hook()) + FD_SET(fd, &task_data->open_fds); + return(fd); +} + +int save_close(int fd){ + if (fd >= 0 && fd <= FD_SETSIZE && check_hook()) + FD_CLR(fd, &task_data->open_fds); + return(close(fd)); +} + +/* The dealing with FILE *'s below isn't strictly correct, we assume + that one never has several pointing to the same fd - in the unlikely + event that one does, all but the last one opened is forgotten */ +FILE *save_fopen(const char *filename, char *type){ + FILE *fp; + + if ((fp = fopen(filename, type)) != NULL && + check_hook() && fileno(fp) < task_data->max_files) + task_data->open_fps[fileno(fp)] = fp; + return(fp); +} + +FILE *save_fdopen(int fd, char *type){ + FILE *fp; + + if ((fp = fdopen(fd, type)) != NULL && + check_hook() && fileno(fp) < task_data->max_files) { + task_data->open_fps[fileno(fp)] = fp; + FD_CLR(fd, &task_data->open_fds); + } + return(fp); +} + +FILE *save_freopen(char *filename, char *type, FILE *stream){ + FILE *fp; + + if (check_hook()) { + if(fileno(stream) < task_data->max_files && + task_data->open_fps[fileno(stream)] == stream) + task_data->open_fps[fileno(stream)] = NULL; + if ((fp = freopen(filename, type, stream)) != NULL && + fileno(fp) < task_data->max_files) + task_data->open_fps[fileno(fp)] = fp; + } else + fp = freopen(filename, type, stream); + return(fp); +} + +int save_fclose(FILE *stream){ + if (check_hook() && fileno(stream) < task_data->max_files && + task_data->open_fps[fileno(stream)] == stream) + task_data->open_fps[fileno(stream)] = NULL; + return(fclose(stream)); +} + +/* We link all malloc'ed segments by adding a couple of pointers + at the *end* - that way we can return the address malloc gave + (need to make sure we align those pointers) */ + +/* + #define MALL_MARGIN 32 + #define save_mall_size(size) save_mall_size1((size) + 2 * MALL_MARGIN) + #define save_mall_size1(size) \ + (((size) + sizeof(char *) - 1) & (unsigned long)(-sizeof(char*))) + + #define save_mall_enq(ptr, mdp) save_mall_enq1((ptr), (mdp) - MALL_MARGIN) + #define save_mall_enq1(ptr, mdp) \ + (((struct mall_data *)(mdp))->self = (ptr), \ + ((struct mall_data *)(mdp))->next = task_data->mall_data, \ + task_data->mall_data = (struct mall_data *)(mdp)) +*/ +#define save_mall_size(size) \ +(((size) + sizeof(char *) - 1) & (unsigned long)(-sizeof(char*))) +#define save_mall_enq(ptr, mdp) \ +(((struct mall_data *)(mdp))->self = (ptr), \ + ((struct mall_data *)(mdp))->next = task_data->mall_data, \ + task_data->mall_data = (struct mall_data *)(mdp)) + + +#define save_mall_deq(ptr) { \ + struct mall_data *mdp = task_data->mall_data, \ + **prevnext = &task_data->mall_data; \ + while (mdp != NULL && mdp->self != (ptr)) { \ + prevnext = &mdp->next; \ + mdp = mdp->next; \ + } \ + if (mdp != NULL) *prevnext = mdp->next; \ +} + +void *save_malloc2(size_t size, MallocFunction mf){ + unsigned msize = save_mall_size(size); + char *ptr; + + if ((ptr = (*mf)(msize + sizeof(struct mall_data))) != NULL && + check_hook()) + save_mall_enq((void *) ptr, (void *) (ptr + msize)); + return((void *) ptr); +} + +void *save_malloc(size_t size){ + return save_malloc2(size, &malloc); +} + +void *save_calloc2(size_t nelem, size_t elsize, CallocFunction cf){ + unsigned msize = save_mall_size(nelem * elsize); + char *ptr; + + if ((ptr = (*cf)(1, msize + sizeof(struct mall_data))) != NULL && + check_hook()) + save_mall_enq((void *) ptr, (void *) (ptr + msize)); + return((void *) ptr); +} + +void *save_calloc(size_t nelem, size_t elsize){ + return save_calloc2(nelem,elsize,&calloc); +} + +void *save_realloc2(void *optr, size_t size, ReallocFunction rf){ + unsigned msize = save_mall_size(size); + char *ptr; + + /* First we must dequeue the old save block, after that + we try to realloc, if that succeeds we enqueue the new + block, if it fails we have to enqueue the old one anew + so we must deduce the size of that old block first. */ + + struct mall_data *mdp0 = task_data->mall_data, + **prevnext0 = &task_data->mall_data; + while (mdp0 != NULL && mdp0->self != (((char *) optr))) { + prevnext0 = &mdp0->next; + mdp0 = mdp0->next; + } + /* mdp0 == NULL (can) mean that the block that is realloced + have been malloced with an (for example) ordinary malloc + (that is not a save_malloc). This is handled like: no dequeing + is done of that block, the new block is enqueued */ + if (mdp0 != NULL) + save_mall_deq(((char *) optr)); + + if ((ptr = (*rf)(optr, msize + sizeof(struct mall_data))) != NULL && + check_hook()) + save_mall_enq((void *) ptr, (void *) (ptr + msize)); + else if (mdp0 != NULL) + /* re-enqueue the old block that has just been dequeued */ + save_mall_enq(((char *) optr), mdp0); + + return((void *) ptr); +} + +void *save_realloc(void *optr, size_t size){ + return save_realloc2(optr,size,&realloc); +} + +void save_free2(void *ptr, FreeFunction ff) +{ + if (check_hook()) + save_mall_deq(((char *) ptr)); + (*ff)(ptr); +} + +void save_free(void *ptr){ + save_free2(ptr,&free); +} + +void save_cfree2(void *ptr, CfreeFunction cf) +{ + if (check_hook()) + save_mall_deq(((char *)ptr)); + (*cf)(ptr); +} + +void save_cfree(void *ptr){ + save_cfree2(ptr,&cfree); +} + diff --git a/erts/etc/vxworks/reclaim.h b/erts/etc/vxworks/reclaim.h new file mode 100644 index 0000000000..ca9aa8f6be --- /dev/null +++ b/erts/etc/vxworks/reclaim.h @@ -0,0 +1,150 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef _RECLAIM_H +#define _RECLAIM_H + + +/* The Erlang release for VxWorks includes a simple mechanism for + "resource reclamation" at task exit - it allows replacement of the + functions that open/close "files" and malloc/free memory with versions + that keep track, to be able to "reclaim" file descriptors and memory + when a task exits (regardless of *how* it exits). + + The interface to this mechanism is made available via this file, + with the following caveats: + + - The interface may change (or perhaps even be removed, though that + isn't likely until VxWorks itself provides similar functionality) + in future releases - i.e. you must always use the version of this + file that comes with the Erlang release you are using. + + - Disaster is guaranteed if you use the mechanism incorrectly (see + below for the correct way), e.g. allocate memory with the "tracking" + version of malloc() and free it with the "standard" version of free(). + + - The mechanism (of course) incurs some performance penalty - thus + for a simple program you may be better off with careful programming, + making sure that you do whatever close()/free()/etc calls that are + appropriate at all exit points (though if you need to guard against + taskDelete() etc, things get messy...). + + To use the mechanism, simply program your application normally, i.e. + use open()/close()/malloc()/free() etc as usual, but #include this + file before any usage of the relevant functions. NOTE: To avoid the + "disaster" mentioned above, you *must* #include it in *all* (or none) + of the files that manipulate a particular file descriptor, allocated + memory area, etc. + + Before any task that uses this utility is loaded (which includes the + erlang emulator), the reclaim.o object file has to be loaded and + the function reclaim_init() has to be called. reclaim_init should be called + only _ONCE_ in a systems lifetime and has only a primitive guard + against multiple calls (i.e. a global variable is checked). Therefore + the initialization should occur either in the start script of the system + or (even better) in the usrInit() part of system initialization. The + object file itself should be loaded only once, so linking it with the + kernel is a good idea, linking with each application is an extremely bad + dito. Make really sure that it's loaded _before_ any application that + uses it if You want to load it in the startup script. + + If You dont want to have #define's for the posix/stdio names + of the file/memory operations (i.e. no #define malloc save_malloc etc), + #define RECLAIM_NO_ALIAS in Your source before reclaim.h is included. +*/ + +#include /* STATUS, size_t */ +#include /* struct sockaddr */ +#include +#include /* FILE */ + +#if defined(__STDC__) +#define _RECLAIM_DECL_FUN(RetType, FunName, ParamList) \ +extern RetType FunName ParamList +#define _RECLAIM_VOID_PTR void * +#define _RECLAIM_VOID_PARAM void +#define _RECLAIM_VOID_RETURN void +#elif defined(__cplusplus) +#define _RECLAIM_DECL_FUN(RetType, FunName, ParamList) \ +extern "C" RetType FunName ParamList +#define _RECLAIM_VOID_PTR void * +#define _RECLAIM_VOID_PARAM +#define _RECLAIM_VOID_RETURN void +#else +#define _RECLAIM_DECL_FUN(RetType, FunName, Ignore) extern RetType FunName() +#define DECLARE_FUNCTION_TYPE(RetType, Type, PList) typedef RetType (* Type)() +#define _RECLAIM_VOID_PTR char * +#define _RECLAIM_VOID_PARAM +#define _RECLAIM_VOID_RETURN +#endif /* __STDC__ / __cplusplus */ + +/* Initialize the facility, on a per system basis. */ +_RECLAIM_DECL_FUN(STATUS, reclaim_init, (_RECLAIM_VOID_PARAM)); + +/* File descriptor operations */ +_RECLAIM_DECL_FUN(int,save_open,(char *, int, ...)); +_RECLAIM_DECL_FUN(int,save_creat,(char *, int)); +_RECLAIM_DECL_FUN(int,save_socket,(int, int, int)); +_RECLAIM_DECL_FUN(int,save_accept,(int, struct sockaddr *, int *)); +_RECLAIM_DECL_FUN(int,save_close,(int)); +/* Interface to add an fd to what's reclaimed even though it's not open with + one of the above functions */ +_RECLAIM_DECL_FUN(_RECLAIM_VOID_RETURN, save_fd, (int fd)); +#ifndef RECLAIM_NO_ALIAS +#define open save_open +#define creat save_creat +#define socket save_socket +#define accept save_accept +#define close save_close +#endif +/* Stdio file operations */ +_RECLAIM_DECL_FUN(FILE *, save_fopen, (const char *, char *)); +_RECLAIM_DECL_FUN(FILE *, save_fdopen, (int, char *)); +_RECLAIM_DECL_FUN(FILE *, save_freopen, (char *, char *, FILE *)); +_RECLAIM_DECL_FUN(int, save_fclose, (FILE *)); +/* XXX Should do opendir/closedir too... */ +#ifndef RECLAIM_NO_ALIAS +#define fopen save_fopen +#define fdopen save_fdopen +#define freopen save_freopen +#define fclose save_fclose +#endif +/* Memory allocation */ +_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, save_malloc, (size_t)); +_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, save_calloc, (size_t, size_t)); +_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, save_realloc, + (_RECLAIM_VOID_PTR, size_t)); +_RECLAIM_DECL_FUN(void, save_free, (_RECLAIM_VOID_PTR)); +_RECLAIM_DECL_FUN(void, save_cfree, (_RECLAIM_VOID_PTR)); +#ifndef RECLAIM_NO_ALIAS +#define malloc save_malloc +#define calloc save_calloc +#define realloc save_realloc +#define free save_free +#define cfree save_cfree +#endif +/* Generic interfaces to malloc etc... */ +_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, plain_malloc, (size_t)); +_RECLAIM_DECL_FUN(_RECLAIM_VOID_PTR, plain_realloc, + (_RECLAIM_VOID_PTR, size_t)); +_RECLAIM_DECL_FUN(void, plain_free, (_RECLAIM_VOID_PTR)); +#endif /* _RECLAIM_H */ + + + + diff --git a/erts/etc/vxworks/reclaim_private.h b/erts/etc/vxworks/reclaim_private.h new file mode 100644 index 0000000000..4ed935bee2 --- /dev/null +++ b/erts/etc/vxworks/reclaim_private.h @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef _RECLAIM_PRIVATE_H +#define _RECLAIM_PRIVATE_H +/* + * Private header for the reclaim facility, also included in the emulator. + */ + +#include "reclaim.h" + +/* Typedefs for ANSI memory allocation function pointers */ +typedef void *(*MallocFunction)(size_t); +typedef void *(*ReallocFunction)(void *, size_t); +typedef void *(*CallocFunction)(size_t, size_t); +typedef void (*FreeFunction)(void *); +typedef STATUS (*CfreeFunction)(char *); + +/* Functions for internal use and use by the emulator */ +extern int reclaim_max_files(void); +extern void set_reclaim_free_function(FreeFunction f); +extern void save_delete_hook(FUNCPTR func, caddr_t parm); +extern void *save_malloc2(size_t size, MallocFunction mf); +extern void *save_calloc2(size_t nelem, size_t elsize, CallocFunction cf); +extern void *save_realloc2(void *optr, size_t size, ReallocFunction rf); +extern void save_free2(void *ptr, FreeFunction ff); +extern void save_cfree2(void *ptr, CfreeFunction ff); + +#endif /* _RECLAIM_PRIVATE_H */ diff --git a/erts/etc/vxworks/resolv.conf b/erts/etc/vxworks/resolv.conf new file mode 100644 index 0000000000..85c89d64c4 --- /dev/null +++ b/erts/etc/vxworks/resolv.conf @@ -0,0 +1,6 @@ +domain du.uab.ericsson.se +nameserver 134.138.176.16 +nameserver 136.225.254.224 +nameserver 134.138.128.25 +search du.uab.ericsson.se uab.ericsson.se ericsson.se +lookup bind file diff --git a/erts/etc/vxworks/vxcall.c b/erts/etc/vxworks/vxcall.c new file mode 100644 index 0000000000..3362d05fc5 --- /dev/null +++ b/erts/etc/vxworks/vxcall.c @@ -0,0 +1,145 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif + +#include +#include +#include +#include + +extern char *malloc(); +static STATUS lookup(); + +/* + Little utility to convert from Unix' argv,argv calling conventions to + VxWorks' arg0,arg1,arg2,... + Will do limited argument parsing - no parenthesis around nor commas + between the args, which may be "-enclosed strings (without \ escapes), + '-enclosed characters (also no \ escapes), integers, or symbols. +*/ + +int vxcall(argc, argv) +int argc; +char **argv; +{ + int vxarg[10]; /* Max 10 args can be passed */ + FUNCPTR entry; + SYM_TYPE type; + int i, l; + +#ifdef DEBUG + fdprintf(2, "vxcall:"); + for (i = 1; i < argc; i++) + fdprintf(2, " %s", argv[i]); + fdprintf(2, "\n"); +#endif + if (lookup(argv[1], N_EXT | N_TEXT, (char **)&entry) != OK) + return(ERROR); + /* Do limited "C" parsing of the args */ + for (i = 0; i < 10; i++) { + if (i < argc - 2) { + switch (argv[i+2][0]) { + case '"': + l = strlen(argv[i+2]) - 1; + if (argv[i+2][l] != '"') + return(ERROR); + /* just strip the quotes - should do \escapes within... */ + vxarg[i] = (int)&argv[i+2][1]; + argv[i+2][l] = '\0'; + break; + case '\'': + if (argv[i+2][2] != '\'') + return(ERROR); + vxarg[i] = argv[i+2][1]; /* should do \escapes... */ + break; + case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + vxarg[i] = atoi(argv[i+2]); /* should do octal, hex, float.. */ + break; + default: + if (lookup(argv[i+2], 0, (char **)&vxarg[i]) != OK) + return(ERROR); + } + } else + vxarg[i] = 0; + } +#ifdef DEBUG + fdprintf(2, "calling 0x%x(0x%x,0x%x,0x%x,0x%x,0x%x,0x%x,0x%x,0x%x,0x%x,0x%x)\n", + entry, vxarg[0], vxarg[1], vxarg[2], vxarg[3], vxarg[4], + vxarg[5], vxarg[6], vxarg[7], vxarg[8], vxarg[9]); +#endif + return((*entry)(vxarg[0], vxarg[1], vxarg[2], vxarg[3], vxarg[4], + vxarg[5], vxarg[6], vxarg[7], vxarg[8], vxarg[9])); +} + +/* Entry point for unix:cmd in post-4.1 erlang - uses "sh -c 'cmd...'" */ +int sh(argc, argv) +int argc; +char **argv; +{ + int ll = strlen(argv[argc-1]) - 1; + +#ifdef DEBUG + int i; + fdprintf(2, "sh:"); + for (i = 1; i < argc; i++) + fdprintf(2, " %s", argv[i]); + fdprintf(2, "\n"); +#endif + if (strcmp(argv[1], "-c") != 0 || + argv[2][0] != '\'' || argv[argc-1][ll] != '\'') + return(ERROR); + argv[argc-1][ll] = '\0'; /* delete trailing ' */ + argv[2]++; /* skip leading ' (*after* the above!) */ + return(vxcall(argc-1, argv+1)); +} + +/* Lookup symbol; get address for text symbols, value (assuming int) + otherwise; return OK or ERROR on failure + Symbol name is null-terminated and without the leading '_' */ +STATUS +lookup(sym, stype, value) +char *sym, **value; +int stype; +{ + char buf[256]; + char *symname = buf; + int len, ret; + SYM_TYPE type; + + len = strlen(sym); + if (len > 254 && (symname = malloc(len+2)) == NULL) + return(ERROR); +#if defined _ARCH_PPC || defined SIMSPARCSOLARIS + /* GCC for PPC or SIMSPARC doesn't add a leading _ to symbols */ + strcpy(symname, sym); +#else + sprintf(symname, "_%s", sym); +#endif + ret = (stype != 0) ? + symFindByNameAndType(sysSymTbl, symname, value, &type, stype, stype) : + symFindByName(sysSymTbl, symname, value, &type); + if (symname != buf) + free(symname); + if (ret == OK && (type & N_TEXT) == 0) /* get value */ + *value = (char *)*((int *)*value); + return(ret); +} diff --git a/erts/etc/vxworks/wd_example.c b/erts/etc/vxworks/wd_example.c new file mode 100644 index 0000000000..0e3a6a1cb2 --- /dev/null +++ b/erts/etc/vxworks/wd_example.c @@ -0,0 +1,141 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * File: frc5te_wd.c + * Purpose: Watchdog NMI handling for FORCE 5TE + * + * Description: + * The watchdog handler routines are system specific. A program that + * wants to utilize a hardware watchdog should call wd_init and test + * the return value. If wd_init returns true (!0); there is a hardware + * watchdog, and that watchdog has been activated. If no watchdog exists, + * wd_init returns false (0). + * + * To keep the watchdog happy, call wd_reset at least every X seconds, + * where X is the number of seconds specified in the call to wd_init. + * + * The watchdog can be disarmed by setting the variable wd_disarmed to 1, + * and armed again by setting the same variable to 0. Watchdog status + * information can be retrieved using the function wd_status. + * + */ + +#ifdef HAVE_CONFIG_H +# include "config.h" +#endif +#include +#include +#include +#include +#include +#include "hw_watchdog.h" + +/* prototypes */ +extern sysNMIConnect(); +#ifdef __STDC__ +void wd_keeper(int); +void wd_nmi_int(UINT8); +void wd_status(void); +#else +void wd_keeper(); +void wd_nmi_int(); +void wd_status(); +#endif + +#define WD_NMI_MIN_DELAY 0.830 /* Min time before watchdog NMI (in seconds) */ +#define WD_RESET_FREQUENCY (WD_NMI_MIN_DELAY / 2) /* how often the timer is reset */ + +#define WD_KEEPER_STACK_SIZE 10000 + +/* global variables */ +extern int spTaskOptions; +static volatile int wd_count_startval; /* start value set by wd_init */ +static volatile int wd_count; /* counter for wd_keeper */ +volatile int wd_disarmed = 0; /* debug feature */ + +/* wd_init is executed to initialize the watchdog. It spawns the task */ +/* wd_keeper and returns true (non-zero) if a hardware watchdog exists, */ +/* or returns false (zero) otherwise. */ +int wd_init(timeout, prio) + int timeout, prio; +{ + taskSpawn("wd_keeper", prio, spTaskOptions, WD_KEEPER_STACK_SIZE, + (FUNCPTR)wd_keeper, timeout,0,0,0,0,0,0,0,0,0); + return !0; /* watchdog exists */ +} + + +/* wd_reset is called as an alive-signal from the supervisor process. */ +/* If there is no call to this function within a certain time, the */ +/* watchdog will reboot the system. */ +void wd_reset() +{ + wd_count = wd_count_startval; +} + + +/* wd_keeper runs as a separate task and resets the watchdog timer */ +/* before an NMI is generated. This task uses the counter wd_count to */ +/* decide if it should exit or keep resetting the timer. */ +/* Note! This task must run with higher priority than the application! */ +void wd_keeper(timeout) + int timeout; +{ + int wd_delay = sysClkRateGet() * WD_RESET_FREQUENCY; + wd_count_startval = (int)(timeout / WD_RESET_FREQUENCY); + wd_count = wd_count_startval; + + /* Connect and enable level 15 interrupts */ + sysNMIConnect((VOIDFUNCPTR) wd_nmi_int, WD_NMI, WD_NMI); + *(char *)FRC5CE_GEN_PURPOSE2_REG |= FRC5CE_NMI_ENABLE; + + while ((wd_count > 0) || wd_disarmed) { + *(char *)FRC5CE_VME_A32MAP_REG |= FRC5CE_WATCHDOG_ENABLE; + taskDelay(wd_delay); + if (!wd_disarmed) wd_count--; + else wd_count = wd_count_startval; + } + logMsg("Watchdog keeper exits. No alive signal from application in %d seconds.\n",wd_count_startval * WD_RESET_FREQUENCY,0,0,0,0,0); +} + + +/* wd_nmi_int is the function connected to the watchdog interrupt. */ +/* It will report the failure to reset the watchdog timer. */ +void wd_nmi_int(type) + UINT8 type; +{ + switch(type) { + case WD_NMI: + logMsg("Watchdog interrupt! System will reboot.\n",0,0,0,0,0,0); + break; + default: + logMsg("Bad type (%d) in call to watchdog interrupt handler.\n",type,0,0,0,0,0); + break; + } +} + + +/* wd_status displays the current value of the counter. */ +void wd_status() +{ + fprintf(stderr, "Watchdog is %sarmed.\n", wd_disarmed ? "dis" : ""); + fprintf(stderr, "Counter value: %d\n", wd_count); + fprintf(stderr, "Start value is: %d (%d seconds)\n", + wd_count_startval, (int)(wd_count_startval * WD_RESET_FREQUENCY)); +} diff --git a/erts/etc/win32/Install.c b/erts/etc/win32/Install.c new file mode 100644 index 0000000000..4a559cd8a2 --- /dev/null +++ b/erts/etc/win32/Install.c @@ -0,0 +1,229 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Some code just simply does not deserve functions :-) + * Dead simple installation program to set up init files etc after erlang is + * copied to its destination. Also to be used after a patch is applied. + */ +#include +#include +#include +#include "init_file.h" + +int main(int argc, char **argv) +{ + int silent = 0; + int start_sasl = 0; + char *root = NULL; + int i; + char buffer[MAX_PATH]; + char erts_dir[MAX_PATH]; + char release_dir[MAX_PATH]; + char bin_dir[MAX_PATH]; + char *tmp; + char my_ini_filename[MAX_PATH]; + InitFile *my_ini_file; + InitSection *my_ini_section; + char version_string[MAX_PATH]; + InitFile *ini_file; + InitSection *ini_section; + HANDLE module = GetModuleHandle(NULL); + char *binaries[] = { "erl.exe", "werl.exe", "erlc.exe", + "dialyzer.exe", "typer.exe", + "escript.exe", NULL }; + char *scripts[] = { "start_clean.boot", "start_sasl.boot", NULL }; + char fromname[MAX_PATH]; + char toname[MAX_PATH]; + + + for (i = 1; i < argc; ++i) { + switch(argv[i][0]) { + case '-' : + switch(argv[i][1]) { + case 's' : + silent = 1; + break; + default: + fprintf(stderr, "Unknown command switch %s\n", + argv[i]); + exit(1); + } + break; + default: + if (root != NULL) { + fprintf(stderr, "Only one root directory can be specified, " + "parameter %s is illegal\n", + argv[i]); + exit(1); + } + root = argv[i]; + break; + } + } + if (root == NULL) { + if (module = NULL) { + fprintf(stderr, "Cannot GetModuleHandle()\n"); + exit(1); + } + + if (GetModuleFileName(module,buffer,MAX_PATH) == 0) { + fprintf(stderr,"Could not GetModuleFileName()\n"); + exit(1); + } + i = strlen(buffer) - 1; + while ( i >= 0 && buffer[i] != '\\') { + --i; + } + if (i < 0) { + fprintf(stderr,"GetModuleFileName returned broken path\n"); + exit(1); + } + buffer[i] = '\0'; + root = buffer; + } + + if (!silent) { + char answer[100]; + char *eol; + start_sasl = 1; + printf("Do you want a minimal startup instead of sasl [No]: "); + fflush(stdout); + if (fgets(answer,100,stdin) == NULL) { + fprintf(stderr, "Could not read answer from user.\n"); + exit(1); + } + eol = strchr(answer,'\n'); + if (eol == NULL) { + while (getchar() != '\n') + ; + } else { + *eol = '\0'; + } + if ((eol = strchr(answer, '\r')) != NULL) { + *eol = '\0'; + } + if (_stricmp(answer,"yes") == 0 || _stricmp(answer,"y") == 0) { + start_sasl = 0; + } + } + sprintf(my_ini_filename,"%s\\Install.ini",root); + my_ini_file = load_init_file(my_ini_filename); + if (my_ini_file == NULL) { + fprintf(stderr,"Cannot open init file %s\n",my_ini_filename); + exit(1); + } + + if ((my_ini_section = lookup_init_section(my_ini_file,"Install")) + == NULL) { + fprintf(stderr,"No [Install] section in init file %s\n", + my_ini_filename); + exit(1); + } + + if ((tmp = lookup_init_entry(my_ini_section, "VSN")) == NULL) { + fprintf(stderr,"No key VSN in init file %s\n", + my_ini_filename); + exit(1); + } + + strcpy(version_string,tmp); + + sprintf(erts_dir,"%s\\erts-%s\\bin",root,tmp); + if ((tmp = lookup_init_entry(my_ini_section, "SYSTEM_VSN")) == NULL) { + fprintf(stderr,"No key SYSTEM_VSN in init file %s\n", + my_ini_filename); + exit(1); + } + sprintf(release_dir,"%s\\releases\\%s",root,tmp); + + sprintf(bin_dir,"%s\\bin",root); + CreateDirectory(bin_dir,NULL); + + free_init_file(my_ini_file); + + for (i = 0; binaries[i] != NULL; ++i) { + sprintf(fromname,"%s\\%s",erts_dir,binaries[i]); + sprintf(toname,"%s\\%s",bin_dir,binaries[i]); + if (GetFileAttributes(fromname) == 0xFFFFFFFF) { + fprintf(stderr,"Could not find file %s\n", + fromname); + exit(1); + } + if (!CopyFile(fromname,toname,FALSE)) { + fprintf(stderr,"Could not copy file %s to %s\n", + fromname,toname); + fprintf(stderr,"Continuing installation anyway...\n"); + } + } + + for (i = 0; scripts[i] != NULL; ++i) { + sprintf(fromname,"%s\\%s",release_dir,scripts[i]); + sprintf(toname,"%s\\%s",bin_dir,scripts[i]); + if (GetFileAttributes(fromname) == 0xFFFFFFFF) { + fprintf(stderr,"Could not find file %s\n", + fromname); + exit(1); + } + if (!CopyFile(fromname,toname,FALSE)) { + fprintf(stderr,"Could not copy file %s to %s\n", + fromname,toname); + fprintf(stderr,"Cannot continue installation, bailing out.\n"); + exit(1); + } + } + if (start_sasl) { + sprintf(fromname,"%s\\start_sasl.boot",bin_dir); + } else { + sprintf(fromname,"%s\\start_clean.boot",bin_dir); + } + sprintf(toname,"%s\\start.boot",bin_dir); + if (!CopyFile(fromname,toname,FALSE)) { + fprintf(stderr,"Could not copy file %s to %s\n", + fromname,toname); + fprintf(stderr,"Cannot continue installation, bailing out.\n"); + exit(1); + } + ini_file = create_init_file(); + ini_section = create_init_section("erlang"); + add_init_section(ini_file,ini_section); + add_init_entry(ini_section,"Bindir",erts_dir); + add_init_entry(ini_section,"Progname","erl"); + add_init_entry(ini_section,"Rootdir",root); + sprintf(fromname,"%s\\erl.ini",erts_dir); + sprintf(toname,"%s\\erl.ini",bin_dir); + if (store_init_file(ini_file,fromname) != 0) { + fprintf(stderr,"Could not create file %s\n", + fromname); + fprintf(stderr,"Cannot continue installation, bailing out.\n"); + exit(1); + } + if (!CopyFile(fromname,toname,FALSE)) { + fprintf(stderr,"Could not copy file %s to %s\n", + fromname,toname); + fprintf(stderr,"Cannot continue installation, bailing out.\n"); + exit(1); + } + if (!silent) { + printf("Erlang %s installed successfully\n", version_string); + } + return 0; +} + + + diff --git a/erts/etc/win32/Install.src b/erts/etc/win32/Install.src new file mode 100644 index 0000000000..4aaa171ce0 --- /dev/null +++ b/erts/etc/win32/Install.src @@ -0,0 +1,4 @@ +[Install] +VSN=%I_VSN% +SYSTEM_VSN=%I_SYSTEM_VSN% + diff --git a/erts/etc/win32/Makefile b/erts/etc/win32/Makefile new file mode 100644 index 0000000000..400e5c5bba --- /dev/null +++ b/erts/etc/win32/Makefile @@ -0,0 +1,72 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1996-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +include ../../vsn.mk + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELEASE_PATH= ../../release/$(TARGET) +RELSYSDIR = $(RELEASE_PATH)/erts-$(VSN) +ROOTSYSDIR = $(RELEASE_PATH) + +BINDIR = $(ERL_TOP)/bin/$(TARGET) +RUNTIME = $(ERL_TOP)/erts/emulator/beam +SYS = $(ERL_TOP)/erts/emulator/sys/win32 +OBJ = $(ERL_TOP)/erts/obj/$(TARGET) +ROOTDIR = $(ERL_TOP)/erts + +INSTALL_PROGS = \ + $(BINDIR)/inet_gethost.exe \ + $(BINDIR)/erl.exe \ + $(BINDIR)/werl.exe \ + $(BINDIR)/heart.exe \ + $(BINDIR)/erlc.exe \ + $(BINDIR)/erlsrv.exe \ + $(BINDIR)/start_erl.exe + +INSTALL_SRC = ./start_erl.c ./Nmakefile.start_erl + +INSTALL_LIBS = $(BINDIR)/erl_dll.lib + +INSTALL_ICONS = ./beam_icon.ico ./erl_icon.ico ./hrl_icon.ico + +opt debug all clean depend: + @echo Nothing to do for "'"$@"'" on $(TARGET) + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: + $(INSTALL_DIR) $(RELSYSDIR)/bin + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) $(ROOTSYSDIR)/usr/include + $(INSTALL_DIR) $(ROOTSYSDIR)/usr/lib + $(INSTALL_DIR) $(ROOTSYSDIR)/usr/lib/icons + $(INSTALL_PROGRAM) $(INSTALL_PROGS) $(RELSYSDIR)/bin + $(INSTALL_DATA) $(INSTALL_SRC) $(RELSYSDIR)/src + $(INSTALL_DATA) $(INSTALL_ICONS) $(ROOTSYSDIR)/usr/lib/icons + +release_docs release_docs_spec docs: + diff --git a/erts/etc/win32/Nmakefile.start_erl b/erts/etc/win32/Nmakefile.start_erl new file mode 100644 index 0000000000..5bf9fd78d5 --- /dev/null +++ b/erts/etc/win32/Nmakefile.start_erl @@ -0,0 +1,33 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Example nmakefile to build start_erl.exe from start_erl.c +# Microsoft Visual C++ is expected to be installed +# and the PATH, INCLUDE and LIB environment valiables set up correctly. +# Invoke with nmake -f NMakefile.start_erl. + +CC=cl +CFLAGS=-W3 +LDFLAGS=user32.lib advapi32.lib + +start_erl.exe: start_erl.c + $(CC) $(CFLAGS) $? -Festart_erl.exe $(LDFLAGS) + +clean: + -del start_erl.obj start_erl.exe + diff --git a/erts/etc/win32/beam.rc b/erts/etc/win32/beam.rc new file mode 100644 index 0000000000..cd7db67d4d --- /dev/null +++ b/erts/etc/win32/beam.rc @@ -0,0 +1,102 @@ +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 1997-2009. All Rights Reserved. +// +// The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved online at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// %CopyrightEnd% +// +#include +#include "resource.h" + +1 ICON DISCARDABLE "erlang.ico" +2 ICON DISCARDABLE "erl_icon.ico" +3 ICON DISCARDABLE "hrl_icon.ico" +4 ICON DISCARDABLE "beam_icon.ico" +1 BITMAP MOVEABLE PURE "toolbar.bmp" + +///////////////////////////////////////////////////////////////////////////// +// +// Menu +// +1 MENU DISCARDABLE +BEGIN + POPUP "&File" + BEGIN + MENUITEM "&Open Logfile...", IDMENU_STARTLOG + MENUITEM "&Close Logfile", IDMENU_STOPLOG + MENUITEM SEPARATOR + MENUITEM "&Exit\tAlt+F4", IDMENU_EXIT + END + POPUP "&Edit" + BEGIN + MENUITEM "&Copy\tCtrl+C", IDMENU_COPY + MENUITEM "&Paste\tCtrl+V", IDMENU_PASTE + MENUITEM SEPARATOR + MENUITEM "Select A&ll", IDMENU_SELALL + END + POPUP "&Options" + BEGIN + MENUITEM "&Select Font...", IDMENU_FONT + MENUITEM "Select &Background...", IDMENU_SELECTBKG + END + POPUP "&View" + BEGIN + MENUITEM "&Toolbar", IDMENU_TOOLBAR + END + POPUP "&Help" + BEGIN + MENUITEM "&About", IDMENU_ABOUT + END +END + +///////////////////////////////////////////////////////////////////////////// +// +// Dialog +// +AboutBox DIALOG DISCARDABLE 0, 0, 217, 55 +STYLE DS_MODALFRAME | WS_POPUP | WS_CAPTION | WS_SYSMENU +CAPTION "About Erlang Shell" +FONT 8, "MS Sans Serif" +BEGIN + ICON 1,-1,11,17,18,20 + LTEXT "Erlang Shell Version 1.0",ID_VERSIONSTRING,40,10,119,8, + SS_NOPREFIX + LTEXT "Copyright © Ericsson Telecom AB",-1,40,25, + 119,8 + DEFPUSHBUTTON "OK",IDOK,178,7,32,14,WS_GROUP +END + +///////////////////////////////////////////////////////////////////////////// +// +// Accelerators +// + +1 ACCELERATORS +{ + VK_CANCEL, ID_BREAK, VIRTKEY, CONTROL + "^C", IDMENU_COPY + VK_INSERT, IDMENU_COPY, VIRTKEY, CONTROL + "^V", IDMENU_PASTE + VK_INSERT, IDMENU_PASTE, VIRTKEY, SHIFT + VK_F1, IDMENU_ABOUT, VIRTKEY +} + + + + + + + + + diff --git a/erts/etc/win32/beam_icon.ico b/erts/etc/win32/beam_icon.ico new file mode 100644 index 0000000000..fb22afda62 Binary files /dev/null and b/erts/etc/win32/beam_icon.ico differ diff --git a/erts/etc/win32/cygwin_tools/erl b/erts/etc/win32/cygwin_tools/erl new file mode 100755 index 0000000000..576825c4be --- /dev/null +++ b/erts/etc/win32/cygwin_tools/erl @@ -0,0 +1,48 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Note! This shellscript expects to be run in a cygwin environment, +# it converts erlc command lines to native windows erlc commands, which +# basically means running the command cygpath on whatever is a path... + +CMD="" +for x in "$@"; do + case "$x" in + -I/*|-o/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + z=`echo $x | sed 's,^-\([Io]\)\(/.*\),\1,g'`; + #echo "Foooo:$z" + MPATH=`cygpath -m $y`; + CMD="$CMD -$z\"$MPATH\"";; + /*) + #echo "absolute:"$x; + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; +# +{*);; + *) +# y=`echo $x | sed 's,",\\\\\\\\\\\",g'`; + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac +done +#echo "$@" +#eval echo erlc.exe $CMD +ERL_TOP=`cygpath -m $ERL_TOP` +export ERL_TOP +eval erl.exe $CMD diff --git a/erts/etc/win32/cygwin_tools/erlc b/erts/etc/win32/cygwin_tools/erlc new file mode 100755 index 0000000000..a18ec27bf4 --- /dev/null +++ b/erts/etc/win32/cygwin_tools/erlc @@ -0,0 +1,61 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Note! This shellscript expects to be run in a cygwin environment, +# it converts erlc command lines to native windows erlc commands, which +# basically means running the command cygpath on whatever is a path... + +CMD="" +ECHO_ONLY=false +for x in "$@"; do + case "$x" in + --echo_only) + ECHO_ONLY=true;; + -I/*|-o/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + z=`echo $x | sed 's,^-\([Io]\)\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -$z$MPATH";; + -pa/*) + y=`echo $x | sed 's,^-pa\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -pa $MPATH";; + /*) + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; +# Needed for +'{preproc_flags,whatever}' + +{preproc_flags,*}) + y=`echo $x | sed 's,^+{preproc_flags\,"\(.*\)"},\1,g'`; + z=`eval $0 --echo_only $y`; + case "$z" in # Dont "doubledoublequote" + \"*\") + CMD="$CMD +'{preproc_flags,$z}'";; + *) + CMD="$CMD +'{preproc_flags,\"$z\"}'";; + esac;; + *) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac +done +if [ $ECHO_ONLY = true ]; then + echo $CMD +else + eval erlc.exe $CMD +fi diff --git a/erts/etc/win32/cygwin_tools/javac.sh b/erts/etc/win32/cygwin_tools/javac.sh new file mode 100755 index 0000000000..f9ee24593f --- /dev/null +++ b/erts/etc/win32/cygwin_tools/javac.sh @@ -0,0 +1,53 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Note! This shellscript expects to be run in a cygwin environment, +# it converts erlc command lines to native windows erlc commands, which +# basically means running the command cygpath on whatever is a path... + +CMD="" +CLASSPATH=`cygpath -m -p $CLASSPATH` +export CLASSPATH +#echo "CLASSPATH=$CLASSPATH" +SAVE="$@" +while test -n "$1" ; do + x="$1" + case "$x" in + -I/*|-o/*|-d/*) + y=`echo $x | sed 's,^-[Iod]\(/.*\),\1,g'`; + z=`echo $x | sed 's,^-\([Iod]\)\(/.*\),\1,g'`; + #echo "Foooo:$z" + MPATH=`cygpath -m $y`; + CMD="$CMD -$z\"$MPATH\"";; + -d|-I|-o) + shift; + MPATH=`cygpath -m $1`; + CMD="$CMD $x $MPATH";; + /*) + #echo "absolute:"$x; + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; + *) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac + shift +done +#echo javac.exe $CMD +eval javac.exe $CMD diff --git a/erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh b/erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh new file mode 100755 index 0000000000..20fe143890 --- /dev/null +++ b/erts/etc/win32/cygwin_tools/make_bootstrap_ini.sh @@ -0,0 +1,44 @@ +#! /bin/bash +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Create a local init-file for erlang in the build environment. +if [ -z "$1" ]; then + echo "error: $0: No rootdir given" + exit 1 +else + RDIR=$1 +fi +if [ -z "$2" ]; then + echo "error: $0: No bindir given" + exit 1 +else + BDIR=$2 +fi + +DRDIR=`(cygpath -d $RDIR 2>/dev/null || cygpath -w $RDIR) | sed 's,\\\,\\\\\\\\,g'` +DBDIR=`(cygpath -d $BDIR 2>/dev/null || cygpath -w $BDIR) | sed 's,\\\,\\\\\\\\,g'` + + +cat > $RDIR/bin/erl.ini </dev/null || cygpath -w $RDIR) | sed 's,\\\,\\\\\\\\,g'` + + +cat > $RDIR/bin/erl.ini <&2 + exit 1 +fi +while test -n "$1" ; do + x="$1" + case "$x" in + -o|-out:) + shift + case "$1" in + /*) + MPATH=`cygpath -m $1`;; + *) + MPATH=$1;; + esac + CMD="rcv \"$MPATH\" $CMD";; + -out:*) + y=`echo $x | sed 's,^-out:\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="rcv \"$MPATH\" $CMD";; + -o*) + y=`echo $x | sed 's,^-o\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="rcv \"$MPATH\" $CMD";; + /*) + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; + *) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac + shift +done + +eval $MINGW_EXE_PATH/ar.exe $CMD diff --git a/erts/etc/win32/cygwin_tools/mingw/cc.sh b/erts/etc/win32/cygwin_tools/mingw/cc.sh new file mode 100755 index 0000000000..ae284893fa --- /dev/null +++ b/erts/etc/win32/cygwin_tools/mingw/cc.sh @@ -0,0 +1,293 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Icky cl wrapper that does it's best to behave like a Unixish cc. +# Made to work for Erlang builds and to make configure happy, not really +# general I suspect. +# set -x +# Save the command line for debug outputs +SAVE="$@" + +# Constants +COMMON_CFLAGS="-mwindows -D__WIN32__ -DWIN32 -DWINDOWS -D_WIN32 -DNT -DWIN32_MINGW" + +# Variables +# The stdout and stderr for the compiler +MSG_FILE=/tmp/gcc.exe.$$.1 +ERR_FILE=/tmp/gcc.exe.$$.2 + +# "Booleans" determined during "command line parsing" +# If the stdlib option is explicitly passed to this program +MD_FORCED=false +# If we're preprocession (only) i.e. -E +PREPROCESSING=false +# If this is supposed to be a debug build +DEBUG_BUILD=false +# If this is supposed to be an optimized build (there can only be one...) +OPTIMIZED_BUILD=false +# If we're linking or only compiling +LINKING=true + +# This data is accumulated during command line "parsing" +# The stdlibrary option, default multithreaded dynamic +# NOTE! The standard library options are actually ignored by the linker later +# on, I've retained parsing of them from the VC++ version as they may be +# needed in the future... +MD=-MD +# Flags for debug compilation +DEBUG_FLAGS="" +# Flags for optimization +OPTIMIZE_FLAGS="" +# The specified output filename (if any), may be either object or exe. +OUTFILE="" +# Unspe3cified command line options for the compiler +CMD="" +# All the c source files, in unix style +SOURCES="" +# All the options to pass to the linker, kept in Unix style +LINKCMD="" +LINKSOURCES="" +DEPENDING=false + +if [ -z "$MINGW_EXE_PATH" ]; then + echo "You have to set MINGW_EXE_PATH to run cc.sh" >&2 + exit 1 +fi + + +# Loop through the parameters and set the above variables accordingly +# Also convert some cygwin filenames to "mixed style" dito (understood by the +# compiler very well), except for anything passed to the linker, that script +# handles those and the sources, which are also kept unixish for now + +while test -n "$1" ; do + x="$1" + case "$x" in + -Wall) + ;; + -c) + LINKING=false;; + -E) + PREPROCESSING=true; + LINKING=false;; # Obviously... + -MM|-M) + DEPENDING=true; + LINKING=false;; # Obviously... + -O*) + # Optimization hardcoded + OPTIMIZE_FLAGS="$x"; + DEBUG_FLAGS="-ggdb"; + DEBUG_BUILD=false; + if [ $MD_FORCED = false ]; then + MD=-MD; + fi + OPTIMIZED_BUILD=true;; + -g|-ggdb) + if [ $OPTIMIZED_BUILD = false ];then + # Hardcoded windows debug flags + DEBUG_FLAGS="-ggdb"; + if [ $MD_FORCED = false ]; then + MD=-MDd; + fi + DEBUG_BUILD=true; + fi;; + # Allow forcing of stdlib + -mt|-MT) + MD="-MT"; + MD_FORCED=true;; + -md|-MD) + MD="-MD"; + MD_FORCED=true;; + -ml|-ML) + MD="-ML"; + MD_FORCED=true;; + -mdd|-MDD|-MDd) + MD="-MDd"; + MD_FORCED=true;; + -mtd|-MTD|-MTd) + MD="-MTd"; + MD_FORCED=true;; + -mld|-MLD|-MLd) + MD="-MLd"; + MD_FORCED=true;; + -o) + shift; + OUTFILE="$1";; + -o*) + y=`echo $x | sed 's,^-[Io]\(.*\),\1,g'`; + OUTFILE="$y";; + -I/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + z=`echo $x | sed 's,^-\([Io]\)\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -$z\"$MPATH\"";; + -I*) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD $y";; + -D*) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD $y";; + -l*) + y=`echo $x | sed 's,^-l\(.*\),\1,g'`; + LINKCMD="$LINKCMD $x";; + /*.c) + SOURCES="$SOURCES $x";; + *.c) + SOURCES="$SOURCES $x";; + /*.o) + LINKCMD="$LINKCMD $x";; + *.o) + LINKCMD="$LINKCMD $x";; + *) + # Try to quote uninterpreted options + y=`echo $x | sed 's,",\\\",g'`; + LINKCMD="$LINKCMD $y";; + esac + shift +done + +#Return code from compiler, linker.sh and finally this script... +RES=0 + +# Accumulated object names +ACCUM_OBJECTS="" + +# A temporary object file location +TMPOBJDIR=/tmp/tmpobj$$ +rm -rf $TMPOBJDIR +mkdir $TMPOBJDIR + + +for x in $SOURCES; do + # Compile each source + if [ $LINKING = false ]; then + # We should have an output defined, which is a directory + # or an object file + case $OUTFILE in + /*.o) + # Simple output, SOURCES should be one single + n=`echo $SOURCES | wc -w`; + if [ $n -gt 1 ]; then + echo "cc.sh:Error, multiple sources, one object output."; + exit 1; + else + output_filename=`cygpath -m $OUTFILE`; + fi;; + *.o) + # Relative path needs no translation + n=`echo $SOURCES | wc -w` + if [ $n -gt 1 ]; then + echo "cc.sh:Error, multiple sources, one object output." + exit 1 + else + output_filename=$OUTFILE + fi;; + /*) + # Absolute directory + o=`echo $x | sed 's,.*/,,' | sed 's,\.c$,.o,'` + output_filename=`cygpath -m $OUTFILE` + output_filename="$output_filename/${o}";; + *) + # Relative_directory or empty string (.//x.o is valid) + o=`echo $x | sed 's,.*/,,' | sed 's,\.c$,.o,'` + output_filename="./${OUTFILE}/${o}";; + esac + else + # We are linking, which means we build objects in a temporary + # directory and link from there. We should retain the basename + # of each source to make examining the exe easier... + o=`echo $x | sed 's,.*/,,' | sed 's,\.c$,.o,'` + output_filename=$TMPOBJDIR/$o + ACCUM_OBJECTS="$ACCUM_OBJECTS $output_filename" + fi + # Now we know enough, lets try a compilation... + MPATH=`cygpath -m $x` + if [ $DEPENDING = true ]; then + output_flag="-MM" + elif [ $PREPROCESSING = true ]; then + output_flag="-E" + else + output_flag="-c -o `cygpath -m ${output_filename}`" + fi + params="$COMMON_CFLAGS $DEBUG_FLAGS $OPTIMIZE_FLAGS \ + $CMD ${output_flag} $MPATH" + if [ "X$CC_SH_DEBUG_LOG" != "X" ]; then + echo cc.sh "$SAVE" >>$CC_SH_DEBUG_LOG + echo $MINGW_EXE_PATH/gcc $params >>$CC_SH_DEBUG_LOG + fi + eval $MINGW_EXE_PATH/gcc $params >$MSG_FILE 2>$ERR_FILE + RES=$? + if [ $PREPROCESSING = false -a $DEPENDING = false ]; then + cat $ERR_FILE >&2 + cat $MSG_FILE + else + cat $ERR_FILE >&2 + if [ $DEPENDING = true ]; then + cat $MSG_FILE | sed 's|\([a-z]\):/|/cygdrive/\1/|g' + else + cat $MSG_FILE + fi + fi + rm -f $ERR_FILE $MSG_FILE + if [ $RES != 0 ]; then + rm -rf $TMPOBJDIR + exit $RES + fi +done + +#If we got here, we succeeded in compiling (if there were anything to compile) +#The output filename should name an executable if we're linking +if [ $LINKING = true ]; then + case $OUTFILE in + "") + # Use the first source name to name the executable + first_source="" + for x in $SOURCES; do first_source=$x; break; done; + if [ -n "$first_source" ]; then + e=`echo $x | sed 's,.*/,,' | sed 's,\.c$,.exe,'`; + out_spec="-o $e"; + else + out_spec=""; + fi;; + *) + out_spec="-o $OUTFILE";; + esac + # Descide which standard library to link against + case $MD in + -ML) + stdlib="-lLIBC";; + -MLd) + stdlib="-lLIBCD";; + -MD) + stdlib="-lMSVCRT";; + -MDd) + stdlib="-lMSVCRTD";; + -MT) + stdlib="-lLIBCMT";; + -MTd) + stdlib="-lLIBMTD";; + esac + # And finally call the next script to do the linking... + params="$out_spec $LINKCMD $stdlib" + eval ld.sh $ACCUM_OBJECTS $params + RES=$? +fi +rm -rf $TMPOBJDIR + +exit $RES diff --git a/erts/etc/win32/cygwin_tools/mingw/coffix.c b/erts/etc/win32/cygwin_tools/mingw/coffix.c new file mode 100644 index 0000000000..5dff030a69 --- /dev/null +++ b/erts/etc/win32/cygwin_tools/mingw/coffix.c @@ -0,0 +1,161 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* +** This mini tool fixes an incompatibility between +** Microsoft's tools, who dont like the virtual size being put in +** the physical address field, but rely on the raw size field for +** sizing the ".bss" section. +** This fixes some of the problems with linking gcc compiled objects +** together with MSVC dito. +** +** Courtesy DJ Delorie for describing the COFF file format on +** http://www.delorie.com/djgpp/doc/coff/ +** The coff structures are fetched from Microsofts headers though. +*/ + +#include +#include +#include +#include + +#include +#include /* Structure definitions for PE (COFF) */ + +static int dump_edit(char *filename, int edit); +static int v_printf(char *format, ...); + + +char *progname; +int verbouse = 0; + +int main(int argc, char **argv) +{ + int findex = 1; + int edit = 0; + int ret; + + progname = argv[0]; + if (argc == 1) { + fprintf(stderr,"Format : %s [-e] [-v] \n", progname); + return 1; + } + for (findex = 1; + findex < argc && (*argv[findex] == '-' || *argv[findex] == '/'); + ++findex) + switch (argv[findex][1]) { + case 'e': + case 'E': + edit = 1; + break; + case 'v': + case 'V': + verbouse = 1; + default: + fprintf(stderr, "%s: unknown option %s\n", progname, argv[findex]); + break; + } + if (findex == argc) { + fprintf(stderr,"%s: No filenames given.\n", progname); + return 1; + } + for(; findex < argc; ++findex) + if ((ret = dump_edit(argv[findex],edit)) != 0) + return ret; + return 0; +} + +int dump_edit(char *filename, int edit) +{ + FILE *f = fopen(filename, (edit) ? "r+b" : "rb"); + IMAGE_FILE_HEADER filhdr; + IMAGE_SECTION_HEADER scnhdr; + int i; + + if (f == NULL) { + fprintf(stderr, "%s: cannot open %s.\n", progname, filename); + return 1; + } + + if (fread(&filhdr, sizeof(filhdr), 1, f) == 0) { + fprintf(stderr,"%s: Could not read COFF header from %s," + " is this a PE (COFF) file?\n", progname, filename); + fclose(f); + return 1; + } + v_printf("File: %s\n", filename); + v_printf("Magic number: 0x%08x\n", filhdr.Machine); + v_printf("Number of sections: %d\n",filhdr.NumberOfSections); + + if (fseek(f, (long) filhdr.SizeOfOptionalHeader, SEEK_CUR) != 0) { + fprintf(stderr,"%s: Could not read COFF optional header from %s," + " is this a PE (COFF) file?\n", progname, filename); + fclose(f); + return 1; + } + + for (i = 0; i < filhdr.NumberOfSections; ++i) { + if (fread(&scnhdr, sizeof(scnhdr), 1, f) == 0) { + fprintf(stderr,"%s: Could not read section header from %s," + " is this a PE (COFF) file?\n", progname, filename); + fclose(f); + return 1; + } + v_printf("Section %s:\n", scnhdr.Name); + v_printf("Physical address: 0x%08x\n", scnhdr.Misc.PhysicalAddress); + v_printf("Size: 0x%08x\n", scnhdr.SizeOfRawData); + if (scnhdr.Misc.PhysicalAddress != 0 && + scnhdr.SizeOfRawData == 0) { + printf("Section header %s in file %s will confuse MSC linker, " + "virtual size is 0x%08x and raw size is 0\n", + scnhdr.Name, filename, scnhdr.Misc.PhysicalAddress, + scnhdr.SizeOfRawData); + if (edit) { + scnhdr.SizeOfRawData = scnhdr.Misc.PhysicalAddress; + scnhdr.Misc.PhysicalAddress = 0; + if (fseek(f, (long) -((long)sizeof(scnhdr)), SEEK_CUR) != 0 || + fwrite(&scnhdr, sizeof(scnhdr), 1, f) == 0) { + fprintf(stderr,"%s: could not edit file %s.\n", + progname, filename); + fclose(f); + return 1; + } + printf("Edited object, virtual size is now 0, and " + "raw size is 0x%08x.\n", scnhdr.SizeOfRawData); + } else { + printf("Specify option '-e' to correct the problem.\n"); + } + } + } + fclose(f); + return 0; +} + + +static int v_printf(char *format, ...) +{ + va_list ap; + int ret = 0; + if (verbouse) { + va_start(ap, format); + ret = vfprintf(stdout, format, ap); + va_end(ap); + } + return ret; +} + diff --git a/erts/etc/win32/cygwin_tools/mingw/emu_cc.sh b/erts/etc/win32/cygwin_tools/mingw/emu_cc.sh new file mode 100755 index 0000000000..f3865c8cae --- /dev/null +++ b/erts/etc/win32/cygwin_tools/mingw/emu_cc.sh @@ -0,0 +1,90 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +TOOLDIR=$ERL_TOP/erts/etc/win32/cygwin_tools/mingw +COFFIX=$TOOLDIR/coffix +WTOOLDIR=`(cygpath -d $TOOLDIR 2>/dev/null || cygpath -w $TOOLDIR)` + +# Do primitive 'make' +newer_exe=`find $TOOLDIR -newer $COFFIX.c -name coffix.exe -print` +if [ -z $newer_exe ]; then + echo recompiling $COFFIX.exe + cl.exe -Fe${WTOOLDIR}\\coffix.exe ${WTOOLDIR}\\coffix.c + rm -f $COFFIX.obj coffix.obj $COFFIX.pdb coffix.pdb +fi + +# Try to find out the output filename and remove it from command line +CMD="" +OUTFILE="" +INFILE="" +SKIP_COFFIX=false +while test -n "$1" ; do + x="$1" + case "$x" in + -o/*) + OUTFILE=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`;; + -o) + shift + OUTFILE=$1;; + -MM) + SKIP_COFFIX=true + CMD="$CMD \"$x\"";; + *.c) + INFILE="$INFILE $x"; + CMD="$CMD \"$x\"";; + *) + CMD="$CMD \"$x\"";; + esac + shift +done +if [ -z "$INFILE" ]; then + echo 'emu_cc.sh: please give an input filename for the compiler' >&2 + exit 1 +fi +if [ -z "$OUTFILE" ]; then + OUTFILE=`echo $INFILE | sed 's,\.c$,.o,'` +fi + +if [ $SKIP_COFFIX = false ]; then + n=`echo $INFILE | wc -w`; + if [ $n -gt 1 ]; then + echo "emu_cc.sh:Error, multiple sources, one object output."; + exit 1; + fi + TEMPFILE=/tmp/tmp_emu_cc$$.o + if [ "X$EMU_CC_SH_DEBUG_LOG" != "X" ]; then + echo "gcc -o $TEMPFILE -D__WIN32__ -DWIN32 -DWINDOWS -fomit-frame-pointer $CMD" >> $EMU_CC_SH_DEBUG_LOG 2>&1 + fi + eval gcc -o $TEMPFILE -D__WIN32__ -DWIN32 -DWINDOWS -fomit-frame-pointer $CMD + RES=$? + if [ $RES = 0 ]; then + $COFFIX.exe -e `(cygpath -d $TEMPFILE 2>/dev/null || cygpath -w $TEMPFILE)` + RES=$? + if [ $RES = 0 ]; then + cp $TEMPFILE $OUTFILE + else + echo "emu_cc.sh: fatal: coffix failed!" >&2 + fi + fi + rm -f $TEMPFILE + exit $RES +else + eval gcc -D__WIN32__ -DWIN32 -DWINDOWS -fomit-frame-pointer $CMD 2>/dev/null + exit $? +fi diff --git a/erts/etc/win32/cygwin_tools/mingw/ld.sh b/erts/etc/win32/cygwin_tools/mingw/ld.sh new file mode 100755 index 0000000000..145bd2fad9 --- /dev/null +++ b/erts/etc/win32/cygwin_tools/mingw/ld.sh @@ -0,0 +1,147 @@ +#! /bin/sh +# set -x +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Save the command line for debug outputs +SAVE="$@" +kernel_libs="-lkernel32 -ladvapi32" +gdi_libs="-lgdi32 -luser32 -lcomctl32 -lcomdlg32 -lshell32" +DEFAULT_LIBRARIES="$kernel_libs $gdi_libs" + +CMD="" +STDLIB=-lmsvcrt +DEBUG_BUILD=false +STDLIB_FORCED=false +BUILD_DLL=false +OUTPUT_FILENAME="" + +if [ -z "$MINGW_EXE_PATH" ]; then + echo "You have to set MINGW_EXE_PATH to run cc.sh" >&2 + exit 1 +fi + +while test -n "$1" ; do + x="$1" + case "$x" in + -dll| -DLL | -shared) + BUILD_DLL=true;; + -L/*|-L.*) + y=`echo $x | sed 's,^-L\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -L \"$MPATH\"";; + -lMSVCRT|-lmsvcrt) + STDLIB_FORCED=true; + STDLIB=-lmsvcrt;; + -lMSVCRTD|-lmsvcrtd) + STDLIB_FORCED=true; + STDLIB=-lmsvcrtd;; + -lLIBCMT|-llibcmt) + STDLIB_FORCED=true; + STDLIB=-llibcmt;; + -lLIBCMTD|-llibcmtd) + STDLIB_FORCED=true; + STDLIB=-llibcmtd;; + -lsocket) + DEFAULT_LIBRARIES="$DEFAULT_LIBRARIES -lws2_32";; + -l*) + y=`echo $x | sed 's,^-l\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -l\"${MPATH}\"";; + -g) + DEBUG_BUILD=true;; + -pdb:none|-incremental:no) + ;; + -implib:*) + y=`echo $x | sed 's,^-implib:\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -Xlinker --out-implib -Xlinker \"${MPATH}\"";; + -entry:*) + y=`echo $x | sed 's,^-entry:\(.*\),\1,g'`; + CMD="$CMD -Xlinker --entry -Xlinker _$y";; + -def:*) + ;; + ## Ignore -def: for now as ld.sh core dumps... + # y=`echo $x | sed 's,^-def:\(.*\),\1,g'`; + # MPATH=`cygpath -m $y`; + # CMD="$CMD -Xlinker --output-def -Xlinker \"${MPATH}\"";; + -o) + shift + MPATH=`cygpath -m $1`; + OUTPUT_FILENAME="$MPATH";; + -o/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + OUTPUT_FILENAME="$MPATH";; + /*) + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; + *) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac + shift +done +if [ $DEBUG_BUILD = true ]; then + linktype="-g" + if [ $STDLIB_FORCED = false ]; then + STDLIB=-lmsvcrt #d? + fi +else + linktype= +fi + +if [ $BUILD_DLL = true ];then + case "$OUTPUT_FILENAME" in + *.exe|*.EXE) + echo "Warning, output set to .exe when building DLL" >&2 + CMD="-shared -o \"$OUTPUT_FILENAME\" $CMD";; + *.dll|*.DLL) + CMD="-shared -o \"$OUTPUT_FILENAME\" $CMD";; + "") + CMD="-shared -o \"a.dll\" $CMD";; + *) + CMD="-shared -o \"${OUTPUT_FILENAME}.dll\" $CMD";; + esac +else + case "$OUTPUT_FILENAME" in + *.exe|*.EXE) + CMD="-o \"$OUTPUT_FILENAME\" $CMD";; + *.dll|*.DLL) + echo "Warning, output set to .dll when building EXE" >&2 + CMD="-o \"$OUTPUT_FILENAME\" $CMD";; + "") + CMD="-o \"a.exe\" $CMD";; + *) + CMD="-o \"${OUTPUT_FILENAME}.exe\" $CMD";; + esac +fi + +p=$$ +CMD="$linktype $CMD $STDLIB $DEFAULT_LIBRARIES" +if [ "X$LD_SH_DEBUG_LOG" != "X" ]; then + echo ld.sh "$SAVE" >>$LD_SH_DEBUG_LOG + echo $MINGW_EXE_PATH/gcc.exe $CMD >>$LD_SH_DEBUG_LOG +fi +eval $MINGW_EXE_PATH/gcc "$CMD" >/tmp/link.exe.${p}.1 2>/tmp/link.exe.${p}.2 +RES=$? +#tail +2 /tmp/link.exe.${p}.2 >&2 +cat /tmp/link.exe.${p}.2 >&2 +cat /tmp/link.exe.${p}.1 +rm -f /tmp/link.exe.${p}.2 /tmp/link.exe.${p}.1 +exit $RES diff --git a/erts/etc/win32/cygwin_tools/mingw/mc.sh b/erts/etc/win32/cygwin_tools/mingw/mc.sh new file mode 100755 index 0000000000..873149172a --- /dev/null +++ b/erts/etc/win32/cygwin_tools/mingw/mc.sh @@ -0,0 +1,89 @@ +#! /bin/sh +# set -x +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Save the command line for debug outputs +SAVE="$@" +CMD="" +OUTPUT_DIRNAME="" + +# Find the correct mc.exe. This could be done by the configure script, +# But as we seldom use the resource compiler, it might as well be done here... +if [ -z "$WINE_EXE_PATH" ]; then + echo "You have to set MINGW_EXE_PATH to run cc.sh" >&2 + exit 1 +fi + +MCC="$WINE_EXE_PATH/wmc.exe -i" +RCC="$WINE_EXE_PATH/wrc.exe -i" + +while test -n "$1" ; do + x="$1" + case "$x" in + -o) + shift + OUTPUT_DIRNAME="$1";; + -o/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + OUTPUT_DIRNAME="$y";; + -I) + shift + MPATH=`cygpath -m $1`; + CMD="$CMD -I\"$MPATH\"";; + -I/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -I\"$MPATH\"";; + *) + MPATH=`cygpath -m -a $x`; + INFILE=$MPATH;; + #CMD="$CMD \"$MPATH\"";; + esac + shift +done +p=$$ +if [ "X$MC_SH_DEBUG_LOG" != "X" ]; then + echo mc.sh "$SAVE" >>$MC_SH_DEBUG_LOG + echo $MCC $INFILE $CMD >>$MC_SH_DEBUG_LOG +fi +if [ -n "$OUTPUT_DIRNAME" ]; then + cd $OUTPUT_DIRNAME + RES=$? + if [ "$RES" != "0" ]; then + echo "mc.sh: Error: could not cd to $OUTPUT_DIRNAME">&2 + exit $RES + fi +fi +eval $MCC "$INFILE" "$CMD" >/tmp/mc.exe.${p}.1 2>/tmp/mc.exe.${p}.2 +RES=$? +cat /tmp/mc.exe.${p}.2 >&2 +cat /tmp/mc.exe.${p}.1 +rm -f /tmp/mc.exe.${p}.2 /tmp/mc.exe.${p}.1 +if [ $RES -eq 0 ]; then + XINFILE=`echo $INFILE | sed 's,.*/\([^/]*\),\1,' | sed 's,.mc$,.rc,'` + if [ "X$MC_SH_DEBUG_LOG" != "X" ]; then + echo $RCC $XINFILE $CMD >>$MC_SH_DEBUG_LOG + fi + eval $RCC $XINFILE "$CMD" >/tmp/rc.exe.${p}.1 2>/tmp/rc.exe.${p}.2 + RES=$? + cat /tmp/rc.exe.${p}.2 >&2 + cat /tmp/rc.exe.${p}.1 + rm -f /tmp/rc.exe.${p}.2 /tmp/rc.exe.${p}.1 +fi +exit $RES diff --git a/erts/etc/win32/cygwin_tools/mingw/rc.sh b/erts/etc/win32/cygwin_tools/mingw/rc.sh new file mode 100755 index 0000000000..37296f9e9f --- /dev/null +++ b/erts/etc/win32/cygwin_tools/mingw/rc.sh @@ -0,0 +1,94 @@ +#! /bin/sh +# set -x +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Save the command line for debug outputs +SAVE="$@" +CMD="" +OUTPUT_FILENAME="" + +if [ -z "$MINGW_EXE_PATH" ]; then + echo "You have to set MINGW_EXE_PATH to run rc.sh" >&2 + exit 1 +fi + + +# # Find the correct rc.exe. This could be done by the configure script, +# # But as we seldom use the resource compiler, it might as well be done here... +# RCC="" +# save_ifs=$IFS +# IFS=: +# for p in $PATH; do +# if [ -f $p/windres.exe ]; then +# if [ -n "`$p/windres.exe --version 2>&1 | grep -i "GNU windres"`" ]; then +# RCC=$p/windres.exe +# fi +# fi +# done +# IFS=$save_ifs + +RCC=$MINGW_EXE_PATH/windres.exe + +if [ -z "$RCC" ]; then + echo 'windres.exe not found!' >&2 + exit 1 +fi + +while test -n "$1" ; do + x="$1" + case "$x" in + -o) + shift + MPATH=`cygpath -m $1`; + OUTPUT_FILENAME="$MPATH";; + -o/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + OUTPUT_FILENAME="$MPATH";; + -I) + shift + MPATH=`cygpath -m $1`; + CMD="$CMD -I\"$MPATH\"";; + -I/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -I\"$MPATH\"";; + /*) + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; + *) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac + shift +done +p=$$ +if [ -n "$OUTPUT_FILENAME" ]; then + CMD="-o $OUTPUT_FILENAME $CMD" +fi +if [ "X$RC_SH_DEBUG_LOG" != "X" ]; then + echo rc.sh "$SAVE" >>$RC_SH_DEBUG_LOG + echo windres.exe $CMD >>$RC_SH_DEBUG_LOG +fi +eval $RCC "$CMD" >/tmp/rc.exe.${p}.1 2>/tmp/rc.exe.${p}.2 +RES=$? +cat /tmp/rc.exe.${p}.2 >&2 +cat /tmp/rc.exe.${p}.1 +rm -f /tmp/rc.exe.${p}.2 /tmp/rc.exe.${p}.1 +exit $RES diff --git a/erts/etc/win32/cygwin_tools/vc/ar.sh b/erts/etc/win32/cygwin_tools/vc/ar.sh new file mode 100755 index 0000000000..24d275b01a --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/ar.sh @@ -0,0 +1,47 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +CMD="" +while test -n "$1" ; do + x="$1" + case "$x" in + -out:) + shift + case "$1" in + /*) + MPATH=`cygpath -m $1`;; + *) + MPATH=$1;; + esac + CMD="$CMD -out:\"$MPATH\"";; + -out:/*) + y=`echo $x | sed 's,^-out:\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -out:\"$MPATH\"";; + /*) + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; + *) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac + shift +done + +eval lib.exe $CMD diff --git a/erts/etc/win32/cygwin_tools/vc/cc.sh b/erts/etc/win32/cygwin_tools/vc/cc.sh new file mode 100755 index 0000000000..4939465d08 --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/cc.sh @@ -0,0 +1,321 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Icky cl wrapper that does it's best to behave like a Unixish cc. +# Made to work for Erlang builds and to make configure happy, not really +# general I suspect. +# set -x +# Save the command line for debug outputs +SAVE="$@" + +# Constants +COMMON_CFLAGS="-nologo -D__WIN32__ -DWIN32 -DWINDOWS -D_WIN32 -DNT -D_CRT_SECURE_NO_DEPRECATE" + +# Variables +# The stdout and stderr for the compiler +MSG_FILE=/tmp/cl.exe.$$.1 +ERR_FILE=/tmp/cl.exe.$$.2 + +# "Booleans" determined during "command line parsing" +# If the stdlib option is explicitly passed to this program +MD_FORCED=false +# If we're preprocession (only) i.e. -E +PREPROCESSING=false +# If we're generating dependencies (implies preprocesing) +DEPENDENCIES=false +# If this is supposed to be a debug build +DEBUG_BUILD=false +# If this is supposed to be an optimized build (there can only be one...) +OPTIMIZED_BUILD=false +# If we're linking or only compiling +LINKING=true + +# This data is accumulated during command line "parsing" +# The stdlibrary option, default multithreaded dynamic +MD=-MD +# Flags for debug compilation +DEBUG_FLAGS="" +# Flags for optimization +OPTIMIZE_FLAGS="" +# The specified output filename (if any), may be either object or exe. +OUTFILE="" +# Unspecified command line options for the compiler +CMD="" +# All the c source files, in unix style +SOURCES="" +# All the options to pass to the linker, kept in Unix style +LINKCMD="" + + +# Loop through the parameters and set the above variables accordingly +# Also convert some cygwin filenames to "mixed style" dito (understood by the +# compiler very well), except for anything passed to the linker, that script +# handles those and the sources, which are also kept unixish for now + +while test -n "$1" ; do + x="$1" + case "$x" in + -Wall) + ;; + -c) + LINKING=false;; + #CMD="$CMD -c";; + -MM) + PREPROCESSING=true; + LINKING=false; + DEPENDENCIES=true;; + -E) + PREPROCESSING=true; + LINKING=false;; # Obviously... + #CMD="$CMD -E";; + -Owx) + # Optimization hardcoded of wxErlang, needs to disable debugging too + OPTIMIZE_FLAGS="-Ob2ity -Gs -Zi"; + DEBUG_FLAGS=""; + DEBUG_BUILD=false; + if [ $MD_FORCED = false ]; then + MD=-MD; + fi + OPTIMIZED_BUILD=true;; + -O*) + # Optimization hardcoded, needs to disable debugging too + OPTIMIZE_FLAGS="-Ox -Zi"; + DEBUG_FLAGS=""; + DEBUG_BUILD=false; + if [ $MD_FORCED = false ]; then + MD=-MD; + fi + OPTIMIZED_BUILD=true;; + -g|-ggdb) + if [ $OPTIMIZED_BUILD = false ];then + # Hardcoded windows debug flags + DEBUG_FLAGS="-Z7"; + if [ $MD_FORCED = false ]; then + MD=-MDd; + fi + LINKCMD="$LINKCMD -g"; + DEBUG_BUILD=true; + fi;; + # Allow forcing of stdlib + -mt|-MT) + MD="-MT"; + MD_FORCED=true;; + -md|-MD) + MD="-MD"; + MD_FORCED=true;; + -ml|-ML) + MD="-ML"; + MD_FORCED=true;; + -mdd|-MDD|-MDd) + MD="-MDd"; + MD_FORCED=true;; + -mtd|-MTD|-MTd) + MD="-MTd"; + MD_FORCED=true;; + -mld|-MLD|-MLd) + MD="-MLd"; + MD_FORCED=true;; + -o) + shift; + OUTFILE="$1";; + -o*) + y=`echo $x | sed 's,^-[Io]\(.*\),\1,g'`; + OUTFILE="$y";; + -I/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + z=`echo $x | sed 's,^-\([Io]\)\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -$z\"$MPATH\"";; + -I*) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD $y";; + -D*) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD $y";; + -EH*) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD $y";; + -l*) + y=`echo $x | sed 's,^-l\(.*\),\1,g'`; + LINKCMD="$LINKCMD $x";; + /*.c) + SOURCES="$SOURCES $x";; + *.c) + SOURCES="$SOURCES $x";; + /*.cc) + SOURCES="$SOURCES $x";; + *.cc) + SOURCES="$SOURCES $x";; + /*.cpp) + SOURCES="$SOURCES $x";; + *.cpp) + SOURCES="$SOURCES $x";; + /*.o) + LINKCMD="$LINKCMD $x";; + *.o) + LINKCMD="$LINKCMD $x";; + *) + # Try to quote uninterpreted options + y=`echo $x | sed 's,",\\\",g'`; + LINKCMD="$LINKCMD $y";; + esac + shift +done + +#Return code from compiler, linker.sh and finally this script... +RES=0 + +# Accumulated object names +ACCUM_OBJECTS="" + +# A temporary object file location +TMPOBJDIR=/tmp/tmpobj$$ +mkdir $TMPOBJDIR + +# Compile +for x in $SOURCES; do + start_time=`date '+%s'` + # Compile each source + if [ $LINKING = false ]; then + # We should have an output defined, which is a directory + # or an object file + case $OUTFILE in + /*.o) + # Simple output, SOURCES should be one single + n=`echo $SOURCES | wc -w`; + if [ $n -gt 1 ]; then + echo "cc.sh:Error, multiple sources, one object output."; + exit 1; + else + output_filename=`cygpath -m $OUTFILE`; + fi;; + *.o) + # Relative path needs no translation + n=`echo $SOURCES | wc -w` + if [ $n -gt 1 ]; then + echo "cc.sh:Error, multiple sources, one object output." + exit 1 + else + output_filename=$OUTFILE + fi;; + /*) + # Absolute directory + o=`echo $x | sed 's,.*/,,' | sed 's,\.c$,.o,'` + output_filename=`cygpath -m $OUTFILE` + output_filename="$output_filename/${o}";; + *) + # Relative_directory or empty string (.//x.o is valid) + o=`echo $x | sed 's,.*/,,' | sed 's,\.cp*$,.o,'` + output_filename="./${OUTFILE}/${o}";; + esac + else + # We are linking, which means we build objects in a temporary + # directory and link from there. We should retain the basename + # of each source to make examining the exe easier... + o=`echo $x | sed 's,.*/,,' | sed 's,\.c$,.o,'` + output_filename=$TMPOBJDIR/$o + ACCUM_OBJECTS="$ACCUM_OBJECTS $output_filename" + fi + # Now we know enough, lets try a compilation... + MPATH=`cygpath -m $x` + if [ $PREPROCESSING = true ]; then + output_flag="-E" + else + output_flag="-c -Fo`cygpath -m ${output_filename}`" + fi + params="$COMMON_CFLAGS $MD $DEBUG_FLAGS $OPTIMIZE_FLAGS \ + $CMD ${output_flag} $MPATH" + if [ "X$CC_SH_DEBUG_LOG" != "X" ]; then + echo cc.sh "$SAVE" >>$CC_SH_DEBUG_LOG + echo cl.exe $params >>$CC_SH_DEBUG_LOG + fi + eval cl.exe $params >$MSG_FILE 2>$ERR_FILE + RES=$? + if test $PREPROCESSING = false; then + cat $ERR_FILE >&2 + tail -n +2 $MSG_FILE + else + tail -n +2 $ERR_FILE >&2 + if test $DEPENDENCIES = true; then + if test `grep -v $x $MSG_FILE | grep -c '#line'` != "0"; then + o=`echo $x | sed 's,.*/,,' | sed 's,\.cp*$,.o,'` + echo -n $o':' + # Some versions of cygpath does not read paths linewise + # but uses space as separator, why pathnames containing + # spaces need to be removed. To avoid different + # behaviours in different versions of cygwin, we would need to + # write our own cygpath replacement, but this will have to do + # for now... + cat $MSG_FILE | grep '#line' | grep -v $x | awk -F\" '{printf("%s\n",$2)}' | sort -u | grep -v " " | cygpath -f - -m -s | cygpath -f - | awk '{printf("\\\n %s ",$0)}' + echo + echo + after_sed=`date '+%s'` + echo Made dependencises for $x':' `expr $after_sed '-' $start_time` 's' >&2 + fi + else + cat $MSG_FILE + fi + fi + rm -f $ERR_FILE $MSG_FILE + if [ $RES != 0 ]; then + rm -rf $TMPOBJDIR + exit $RES + fi +done + +# If we got here, we succeeded in compiling (if there were anything to compile) +# The output filename should name an executable if we're linking +if [ $LINKING = true ]; then + case $OUTFILE in + "") + # Use the first source name to name the executable + first_source="" + for x in $SOURCES; do first_source=$x; break; done; + if [ -n "$first_source" ]; then + e=`echo $x | sed 's,.*/,,' | sed 's,\.c$,.exe,'`; + out_spec="-o $e"; + else + out_spec=""; + fi;; + *) + out_spec="-o $OUTFILE";; + esac + # Descide which standard library to link against + case $MD in + -ML) + stdlib="-lLIBC";; + -MLd) + stdlib="-lLIBCD";; + -MD) + stdlib="-lMSVCRT";; + -MDd) + stdlib="-lMSVCRTD";; + -MT) + stdlib="-lLIBCMT";; + -MTd) + stdlib="-lLIBMTD";; + esac + # And finally call the next script to do the linking... + params="$out_spec $LINKCMD $stdlib" + eval ld.sh $ACCUM_OBJECTS $params + RES=$? +fi +rm -rf $TMPOBJDIR + +exit $RES diff --git a/erts/etc/win32/cygwin_tools/vc/cc_wrap.c b/erts/etc/win32/cygwin_tools/vc/cc_wrap.c new file mode 100644 index 0000000000..18ecc31c17 --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/cc_wrap.c @@ -0,0 +1,864 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#include +#include +#include +#include +#include +#include +#include +#include + + + +#ifdef CCP_POSIX_TO_WIN_A +#define NEW_CYGPATH_INTERFACE +#endif + +#ifdef NEW_CYGPATH_INTERFACE +#define GET_WIN32_SIZE(Posix) \ +cygwin_conv_path (CCP_POSIX_TO_WIN_A | CCP_ABSOLUTE, (Posix), NULL, 0) +#define CONVERT_TO_WIN32(Posix,Win32,Size) \ +cygwin_conv_path (CCP_POSIX_TO_WIN_A | CCP_ABSOLUTE, (Posix), \ + (Win32), (Size)) +#else +#define GET_WIN32_SIZE(Posix) PATH_MAX +#define CONVERT_TO_WIN32(Posix,Win32,Size) \ +((cygwin32_conv_to_full_win32_path((Posix),(Win32)) >= 0) ? 0 : -1) +#endif + +/*#define HARDDEBUG 1*/ + +#ifdef HARDDEBUG +#define DEBUGF(X) printf X +#else +#define DEBUGF(X) /* noop */ +#endif +char *tmpobjdir = ""; + +char *add_to(char *src,char *add) { + int len = strlen(src)+strlen(add)+1; + char *n; + + if (strlen(src) == 0) { + n = malloc(len); + strcpy(n,add); + return n; + } + n = realloc(src,len); + strcat(n,add); + return n; +} + +void maybe_cleanup(void) +{ + DIR *dir; + struct dirent *dent; + if (*tmpobjdir == '\0') { + return; + } + if (!(dir = opendir(tmpobjdir))) { + return; + } + while((dent = readdir(dir)) != NULL) { + char *fullname = add_to("",tmpobjdir); + fullname = add_to(fullname,"/"); + fullname = add_to(fullname,dent->d_name); + unlink(fullname); + free(fullname); + } + closedir(dir); + rmdir(tmpobjdir); +} + + + + +void error(char *str) +{ + fprintf(stderr,"%s\n",str); + maybe_cleanup(); + exit(1); +} + + +char **add_to_src(char **srcarr, char *add) +{ + int num; + if (srcarr == NULL) { + srcarr = malloc(sizeof(char *)*2); + srcarr[0]=malloc(strlen(add)+1); + strcpy(srcarr[0],add); + srcarr[1] = NULL; + } else { + for(num = 0; srcarr[num] != NULL; ++num) + ; + num +=1; + srcarr = realloc(srcarr,sizeof(char *)*(num+1)); + srcarr[num-1] = malloc(strlen(add)+1); + strcpy(srcarr[num-1],add); + srcarr[num] = NULL; + } + return srcarr; +} + + + +char *object_name(char *source) { + char *tmp = add_to("",source); + int j = strlen(tmp)-2; + if (j < 0) { + j = 0; + } + while(j>0 && tmp[j] != '.') { + --j; + } + if (tmp[j] == '.') { + ++j; + } + tmp[j++] = 'o'; + tmp[j] = '\0'; + return tmp; +} + +char *exe_name(char *source) { + char *tmp = add_to("",source); + int j = strlen(tmp)-2; + if (j < 0) { + j = 0; + } + while(j>0 && tmp[j] != '.') { + --j; + } + if (tmp[j] == '.') { + ++j; + } + tmp[j] = '\0'; + return add_to(tmp,"exe"); +} + +char *dyn_get_short(char *longp) +{ + int size; + char *shortp; + size = GetShortPathName(longp,NULL,0); + if (size <= 0) { + return NULL; + } + shortp = malloc(size); + if (GetShortPathName(longp,shortp,size) != size - 1) { + free(shortp); + return NULL; + } + return shortp; +} + +char *do_cyp(char *posix) +{ + ssize_t size; + char *win32; + size = GET_WIN32_SIZE(posix); + char *ret = NULL; + if (size < 0) { + fprintf(stderr,"Could not cygpath %s, errno = %d\n", + posix,errno); + } else { + win32 = (char *) malloc (size); + if (CONVERT_TO_WIN32(posix, + win32, size)) { + fprintf(stderr,"Could not cygpath %s, errno = %d\n", + posix,errno); + } else { + char *w32_short = dyn_get_short(win32); + DEBUGF(("win32 = %s, w32_short = %s\n",win32, (w32_short == NULL) ? "NULL" : w32_short)); + if (w32_short == NULL) { + char *rest = malloc(size); + char *first = malloc(size); + int x = 0; + int y = strlen(win32) - 1; + strcpy(first,win32); + while (w32_short == NULL) { + while ( y > 0 && first[y] != '\\') { + rest[x++] = first[y--]; + } + if (y > 0) { + rest[x++] = first[y]; + first[y--] = '\0'; + } else { + break; + } + w32_short = dyn_get_short(first); + DEBUGF(("first = %s, w32_short = %s\n",first, (w32_short == NULL) ? "NULL" : w32_short)); + } + if (w32_short != NULL) { + y = strlen(w32_short); + w32_short = realloc(w32_short,y+1+x); + /* spool back */ + while ( x > 0) { + w32_short[y++] = rest[--x]; + } + w32_short[y] = '\0'; + } else { + w32_short = malloc(strlen(win32)+1); + strcpy(w32_short,win32); /* last resort */ + } + free(first); + free(rest); + } + ret = w32_short; + while (*ret) { + if (*ret == '\\') { + *ret = '/'; + } + ++ret; + } + ret = w32_short; + } + free(win32); + } + return ret; +} + + + +char *save = ""; + +void save_args(int argc, char **argv) +{ + int i; + for(i = 0; i < argc; ++i) { + save = add_to(save,argv[i]); + save = add_to(save," "); + } +} + +char *progname="cc_wrap"; + +int my_create_pipe(HANDLE *read_p, HANDLE *write_p) +{ + char name_buff[1000]; + SECURITY_ATTRIBUTES sa = {sizeof(SECURITY_ATTRIBUTES), NULL, TRUE}; + static int counter = 0; + + ++counter; + + sprintf(name_buff,"\\\\.\\pipe\\%s_%d_%d",progname,getpid(),counter); + sa.bInheritHandle = FALSE; + if ((*read_p = CreateNamedPipe(name_buff, + PIPE_ACCESS_INBOUND | FILE_FLAG_OVERLAPPED, + PIPE_TYPE_BYTE | PIPE_READMODE_BYTE, + 1, + 0, + 0, + 2000, + &sa)) == INVALID_HANDLE_VALUE || + *read_p == NULL) { + return 0; + } + sa.bInheritHandle = TRUE; + if ((*write_p = CreateFile(name_buff, + GENERIC_WRITE, + 0, /* No sharing */ + &sa, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, + NULL)) == INVALID_HANDLE_VALUE || + *write_p == NULL) { + CloseHandle(*read_p); + return 0; + } + return 1; +} + +void forwardenv(void) +{ + char *(envs[]) = {"LIB","INCLUDE","LIBPATH", "LD_SH_DEBUG_LOG", NULL}; + char **p = envs; + while (*p != NULL) { + char *val = getenv(*p); + if (val != NULL) { + SetEnvironmentVariable(*p,val); + } + ++p; + } +} + +HANDLE do_run(char *commandline, HANDLE *out, HANDLE *err) +{ + STARTUPINFO start; + HANDLE write_pipe_stdout = NULL, read_pipe_stdout = NULL; + HANDLE write_pipe_stderr = NULL, read_pipe_stderr = NULL; + SECURITY_ATTRIBUTES pipe_security; + SECURITY_ATTRIBUTES attr; + PROCESS_INFORMATION info; + + memset(&start,0,sizeof(start)); + memset(&pipe_security,0,sizeof(pipe_security)); + memset(&attr,0,sizeof(attr)); + memset(&info,0,sizeof(info)); + + pipe_security.nLength = sizeof(pipe_security); + pipe_security.lpSecurityDescriptor = NULL; + pipe_security.bInheritHandle = TRUE; + + if(!my_create_pipe(&read_pipe_stdout,&write_pipe_stdout)){ + error("Could not create stdout pipes!"); + } + if(!my_create_pipe(&read_pipe_stderr,&write_pipe_stderr)){ + error("Could not create stderr pipes!"); + } + start.cb = sizeof (start); + start.dwFlags = STARTF_USESHOWWINDOW; + start.wShowWindow = SW_HIDE; + start.hStdOutput = write_pipe_stdout; + start.hStdError = write_pipe_stderr; + start.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + start.dwFlags |= STARTF_USESTDHANDLES; + + attr.nLength = sizeof(attr); + attr.lpSecurityDescriptor = NULL; + attr.bInheritHandle = TRUE; + forwardenv(); /* Cygwin and windows environment variables... sigh... */ + if(!CreateProcess(NULL, + commandline, + &attr, + NULL, + TRUE, + CREATE_DEFAULT_ERROR_MODE, + NULL, + NULL, + &start, + &info)){ + fprintf(stderr,"Could not run %s, last error: %d\n",commandline,GetLastError()); + error("Could not create process"); + } + *out = read_pipe_stdout; + *err = read_pipe_stderr; + CloseHandle(write_pipe_stdout); + CloseHandle(write_pipe_stderr); + return info.hProcess; +} +#define HANDLE_STDOUT 0 +#define HANDLE_STDERR 1 +#define HANDLE_PROC 2 + +#ifdef HARDDEBUG +char *prefix = ""; +#endif + +int handle_overlapped(HANDLE fd, OVERLAPPED *ovp, char *buffer, + int bufflen, int get_old, FILE *whereto, int *skip) +{ + DWORD res,read,err; + char *ptr; + + DEBUGF(("In handle_overlapped(%d,0x%08x,0x%08x,%d,%d), prefix = %s\n", + fd,ovp,buffer,bufflen,get_old,prefix)); + /* hämta resultat av gamla först */ + if (get_old) { + res = GetOverlappedResult(fd,ovp,&read,TRUE); + DEBUGF(("read = %d, res = %d, GetLastError() = %d\n",read,res,GetLastError())); + if (!res) { + return 0; + } + buffer[read] = '\0'; + ptr = buffer; + while(*skip && *ptr != '\0') { + if (*ptr == '\n') { + --(*skip); + } + ++ptr; + } + if(*ptr != '\0') { + fprintf(whereto,"%s",ptr); + } + } + + ResetEvent(ovp->hEvent); + + for(;;) { + res = ReadFile(fd,buffer,bufflen-1,&read,ovp); + + if (!res) { + err = GetLastError(); + if (err == ERROR_IO_PENDING) { + DEBUGF(("Error I/O Pending\n")); + return 1; + } + DEBUGF(("ReadFileFailed for %s, %d\n",prefix,err)); + return 0; + } + buffer[read] = '\0'; + ptr = buffer; + while(*skip && *ptr != '\0') { + if (*ptr == '\n') { + --(*skip); + } + ++ptr; + } + if(*ptr != '\0') { + fprintf(whereto,"%s",ptr); + } + } +} + + +int run(char *commandline,int skipout,int skiperr) +{ + HANDLE harr[3]; + HANDLE real_stdout,real_stderr; + OVERLAPPED ov_out,ov_err; + char outbuff[1024],errbuff[1024]; + DWORD ret,exitcode; + HANDLE wait[3]; + int map[3]; + DWORD nwait = 3; + int i,j; + unsigned living_handles = 0x7; + + harr[HANDLE_STDOUT] = CreateEvent(NULL, + TRUE, + FALSE, /*not signalled */ + NULL); + harr[HANDLE_STDERR] = CreateEvent(NULL, + TRUE, + FALSE,/*not signalled */ + NULL); + + memset(&ov_out,0,sizeof(ov_out)); + memset(&ov_err,0,sizeof(ov_err)); + + ov_out.hEvent = harr[HANDLE_STDOUT]; + ov_err.hEvent = harr[HANDLE_STDERR]; + + harr[HANDLE_PROC] = do_run(commandline,&real_stdout,&real_stderr); + +#ifdef HARDDEBUG + prefix = "STDOUT"; +#endif + handle_overlapped(real_stdout,&ov_out,outbuff,1024,0,stdout,&skipout); +#ifdef HARDDEBUG + prefix = "STDERR"; +#endif + handle_overlapped(real_stderr,&ov_err,errbuff,1024,0,stderr,&skiperr); + + for(;;) { + nwait = 0; + for(i=0;i<3;++i) { + if ((living_handles & (1U << i))) { + map[nwait] = i; + wait[nwait++] = harr[i]; + } + } + + ret = WaitForMultipleObjects(nwait, + wait, + FALSE, + INFINITE); + DEBUGF(("Wait returned %d\n",ret)); + + if (ret == WAIT_FAILED) { + error("Wait failed"); + } + + ret -= WAIT_OBJECT_0; + + switch (map[ret]) { + case HANDLE_PROC: + + DEBUGF(("Process died!\n")); + GetExitCodeProcess(harr[HANDLE_PROC],&exitcode); + if ((living_handles &= (~(1U< 1) { + goto filename; + } + linking = 0; + break; + case 'E': + if(strlen(opt) > 1) { + if (opt[1] == 'H') { + cmd = add_to(cmd," "); + cmd = add_to(cmd,opt); + } else { + goto filename; + } + } + preprocessing = 1; + linking = 0; + break; + case 'O': + /* ignore what opt is requested, set hard */ + optimize_flags = "-Ox -Zi"; + debug_flags = ""; + debug_build = 0; + if (!md_forced) { + md = "-MD"; + } + optimized_build = 1; + break; + case 'g': + if (strcmp(opt,"g") && strcmp(opt,"ggdb")) { + goto filename; + } + if (!optimized_build) { + debug_flags = "-Z7"; + if (!md_forced) { + md = "-MDd"; + } + linkcmd = add_to(linkcmd," -g"); + debug_build = 1; + } + break; + case 'm': + case 'M': + if(!strcmp(opt,"mt") || !strcmp(opt,"MT")) { + md = "-MT"; + } else if (!strcmp(opt,"md") || !strcmp(opt,"MD")) { + md = "-MD"; + } else if (!strcmp(opt,"ml") || !strcmp(opt,"ML")) { + md = "-ML"; + } else if (!strcmp(opt,"mdd") || !strcmp(opt,"MDd") || + !strcmp(opt,"MDD")) { + md = "-MDd"; + } else if (!strcmp(opt,"mtd") || !strcmp(opt,"MTd") || + !strcmp(opt,"MTD")) { + md = "-MTd"; + } else if (!strcmp(opt,"mld") || !strcmp(opt,"MLd") || + !strcmp(opt,"MLD")) { + md = "-MLd"; + } else { + goto filename; + } + md_forced = 1; + break; + case 'o': + if (!strcmp(opt,"o")) { + ++i; + if (i >= argc) { + error("-o without filename"); + } + outfile = argv[i]; + } else { + outfile = opt+1; + } + break; + case 'I': + if(opt[1] == '/') { + mpath = do_cyp(opt+1); + cmd = add_to(cmd," -I\""); + cmd = add_to(cmd,mpath); + cmd = add_to(cmd,"\""); + free(mpath); + } else { + cmd = add_to(cmd," "); + cmd = add_to(cmd,opt); + } + break; + case 'D': + cmd = add_to(cmd," -"); + cmd = add_to(cmd,opt); + case 'l': + linkcmd = add_to(linkcmd," -"); + linkcmd = add_to(linkcmd,opt); + break; + default: + goto filename; + } + continue; + } + filename: + s = argv[i]; + x = strlen(s); + if (x > 1 && s[x-1] == 'c' && s[x-2] == '.') { + /* C source */ + sources = add_to_src(sources,s); + } else if (x > 3 && !strcmp(s + (x - 4),".cpp")) { + /* C++ */ + sources = add_to_src(sources,s); + } else if (x > 1 && s[x-1] == 'o' && s[x-2] == '.') { + linkcmd = add_to(linkcmd," "); + linkcmd = add_to(linkcmd,s); + } else { + /* Pass rest to linker */ + linkcmd = add_to(linkcmd," "); + linkcmd = add_to(linkcmd,s); + } + } + if ((debuglog = getenv("CC_SH_DEBUG_LOG")) != NULL) { + debugfile = fopen(debuglog,"wb+"); + if (debugfile) { + fprintf(debugfile,"----------------\n"); + } + } else { + debugfile = NULL; + } + + tmpobjdir = add_to("","/tmp/tmpobj"); + { + char pidstr[100]; + pid_t pid = getpid(); + sprintf(pidstr,"%d",pid); + tmpobjdir = add_to(tmpobjdir,pidstr); + } + mkdir(tmpobjdir,0777); + if (sources != NULL) { + char *output_filename; + char *output_flag; + char *params; + for (i=0;sources[i] != NULL; ++i) { + if (!linking) { + int x = strlen(outfile); + if (x > 1 && outfile[x-1] == 'o' && outfile[x-2] == '.') { + if (*outfile != '/') { + /* non absolute object */ + if (i > 0) { + error("Single object multiple sources"); + } + output_filename = add_to("",outfile); + } else { + if (i > 0) { + error("Single object multiple sources"); + } + output_filename = do_cyp(outfile); + } + } else { + char *tmp = object_name(sources[i]); + + /*fprintf(stderr,"sources[i] = %s\ntmp = %s\n", + sources[i],tmp);*/ + + if (!x || outfile[0] != '/') { + /* non absolute directory */ + output_filename = add_to("",outfile); + } else { + output_filename = do_cyp(outfile); + } + /*fprintf(stderr,"output_filename = %s\n",output_filename);*/ + if (*output_filename != '\0') { + output_filename = add_to(output_filename,"/"); + } + output_filename = add_to(output_filename,tmp); + free(tmp); + } + } else { + char *tmp = object_name(sources[i]); + output_filename = add_to("",tmpobjdir); + output_filename = add_to(output_filename,"/"); + output_filename = add_to(output_filename,tmp); + accum_objects = add_to(accum_objects," "); + accum_objects = add_to(accum_objects,output_filename); + /* reform to dos path */ + free(output_filename); + output_filename = do_cyp(tmpobjdir); + output_filename = add_to(output_filename,"/"); + output_filename = add_to(output_filename,tmp); + } + mpath = do_cyp(sources[i]); + if (preprocessing) { + output_flag = add_to("","-E"); + } else { + output_flag = add_to("","-c -Fo"); + output_flag = add_to(output_flag,output_filename); + } + params = add_to("","cl.exe "); + params = add_to(params,common_cflags); + params = add_to(params," "); + params = add_to(params,md); + params = add_to(params," "); + params = add_to(params,debug_flags); + params = add_to(params," "); + params = add_to(params,optimize_flags); + params = add_to(params," "); + params = add_to(params,cmd); + params = add_to(params," "); + params = add_to(params,output_flag); + params = add_to(params," "); + params = add_to(params,mpath); + free(output_filename); + free(output_flag); + free(mpath); + + if (debugfile) { + fprintf(debugfile,"%s\n",save); + fprintf(debugfile,"%s\n",params); + } + if (preprocessing) { + retval = run(params,0,1); + } else { + retval = run(params,1,0); + } + if (retval != 0) { + maybe_cleanup(); + return retval; + } + free(params); + } + } + if (linking) { + char *out_spec; + char *stdlib; + char *params; + if (strlen(outfile) == 0) { + if (sources != NULL && sources[0] != NULL) { + char *tmp = exe_name(sources[0]); + out_spec = add_to("","-o "); + out_spec = add_to(out_spec,tmp); + free(tmp); + } else { + out_spec = add_to("",""); + } + } else { + out_spec = add_to("","-o "); + out_spec = add_to(out_spec,outfile); + } + if (!strcmp(md,"-ML")) { + stdlib="-lLIBC"; + } else if (!strcmp(md,"-MLd")) { + stdlib="-lLIBCD"; + } else if (!strcmp(md,"-MD")) { + stdlib="-lMSVCRT"; + } else if (!strcmp(md,"-MDd")) { + stdlib="-lMSVCRTD"; + } else if (!strcmp(md,"-MT")) { + stdlib="-lLIBCMT"; + } else if (!strcmp(md,"-MTd")) { + stdlib="-lLIBMTD"; + } else { + stdlib = ""; + } +#if 0 + params = add_to("","bash ld.sh "); +#else + params = add_to("","ld_wrap.exe "); +#endif + params = add_to(params,accum_objects); + params = add_to(params," "); + params = add_to(params,out_spec); + params = add_to(params," "); + params = add_to(params,linkcmd); + params = add_to(params," "); + params = add_to(params,stdlib); + free(out_spec); + free(accum_objects); + if (debugfile) { + fprintf(debugfile,"%s\n",params); + } + if (retval = run(params,0,0) != 0) { + maybe_cleanup(); + return retval; + } + free(params); + } + maybe_cleanup(); + return 0; +} + + + + + + + + + + + + + + + + + + diff --git a/erts/etc/win32/cygwin_tools/vc/coffix.c b/erts/etc/win32/cygwin_tools/vc/coffix.c new file mode 100644 index 0000000000..dee0132a61 --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/coffix.c @@ -0,0 +1,161 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1999-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* +** This mini tool fixes an incompatibility between +** Microsoft's tools, who dont like the virtual size being put in +** the physical address field, but rely on the raw size field for +** sizing the ".bss" section. +** This fixes some of the problems with linking gcc compiled objects +** together with MSVC dito. +** +** Courtesy DJ Delorie for describing the COFF file format on +** http://www.delorie.com/djgpp/doc/coff/ +** The coff structures are fetched from Microsofts headers though. +*/ + +#include +#include +#include +#include + +#include +#include /* Structure definitions for PE (COFF) */ + +static int dump_edit(char *filename, int edit); +static int v_printf(char *format, ...); + + +char *progname; +int verbouse = 0; + +int main(int argc, char **argv) +{ + int findex = 1; + int edit = 0; + int ret; + + progname = argv[0]; + if (argc == 1) { + fprintf(stderr,"Format : %s [-e] [-v] \n", progname); + return 1; + } + for (findex = 1; + findex < argc && (*argv[findex] == '-' || *argv[findex] == '/'); + ++findex) + switch (argv[findex][1]) { + case 'e': + case 'E': + edit = 1; + break; + case 'v': + case 'V': + verbouse = 1; + default: + fprintf(stderr, "%s: unknown option %s\n", progname, argv[findex]); + break; + } + if (findex == argc) { + fprintf(stderr,"%s: No filenames given.\n", progname); + return 1; + } + for(; findex < argc; ++findex) + if ((ret = dump_edit(argv[findex],edit)) != 0) + return ret; + return 0; +} + +int dump_edit(char *filename, int edit) +{ + FILE *f = fopen(filename, (edit) ? "r+b" : "rb"); + IMAGE_FILE_HEADER filhdr; + IMAGE_SECTION_HEADER scnhdr; + int i; + + if (f == NULL) { + fprintf(stderr, "%s: cannot open %s.\n", progname, filename); + return 1; + } + + if (fread(&filhdr, sizeof(filhdr), 1, f) == 0) { + fprintf(stderr,"%s: Could not read COFF header from %s," + " is this a PE (COFF) file?\n", progname, filename); + fclose(f); + return 1; + } + v_printf("File: %s\n", filename); + v_printf("Magic number: 0x%08x\n", filhdr.Machine); + v_printf("Number of sections: %d\n",filhdr.NumberOfSections); + + if (fseek(f, (long) filhdr.SizeOfOptionalHeader, SEEK_CUR) != 0) { + fprintf(stderr,"%s: Could not read COFF optional header from %s," + " is this a PE (COFF) file?\n", progname, filename); + fclose(f); + return 1; + } + + for (i = 0; i < filhdr.NumberOfSections; ++i) { + if (fread(&scnhdr, sizeof(scnhdr), 1, f) == 0) { + fprintf(stderr,"%s: Could not read section header from %s," + " is this a PE (COFF) file?\n", progname, filename); + fclose(f); + return 1; + } + v_printf("Section %s:\n", scnhdr.Name); + v_printf("Physical address: 0x%08x\n", scnhdr.Misc.PhysicalAddress); + v_printf("Size: 0x%08x\n", scnhdr.SizeOfRawData); + if (scnhdr.Misc.PhysicalAddress != 0 && + scnhdr.SizeOfRawData == 0) { + printf("Section header %s in file %s will confuse MSC linker, " + "virtual size is 0x%08x and raw size is 0\n", + scnhdr.Name, filename, scnhdr.Misc.PhysicalAddress, + scnhdr.SizeOfRawData); + if (edit) { + scnhdr.SizeOfRawData = scnhdr.Misc.PhysicalAddress; + scnhdr.Misc.PhysicalAddress = 0; + if (fseek(f, (long) -((long)sizeof(scnhdr)), SEEK_CUR) != 0 || + fwrite(&scnhdr, sizeof(scnhdr), 1, f) == 0) { + fprintf(stderr,"%s: could not edit file %s.\n", + progname, filename); + fclose(f); + return 1; + } + printf("Edited object, virtual size is now 0, and " + "raw size is 0x%08x.\n", scnhdr.SizeOfRawData); + } else { + printf("Specify option '-e' to correct the problem.\n"); + } + } + } + fclose(f); + return 0; +} + + +static int v_printf(char *format, ...) +{ + va_list ap; + int ret = 0; + if (verbouse) { + va_start(ap, format); + ret = vfprintf(stdout, format, ap); + va_end(ap); + } + return ret; +} + diff --git a/erts/etc/win32/cygwin_tools/vc/emu_cc.sh b/erts/etc/win32/cygwin_tools/vc/emu_cc.sh new file mode 100755 index 0000000000..c74c35111b --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/emu_cc.sh @@ -0,0 +1,90 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +TOOLDIR=$ERL_TOP/erts/etc/win32/cygwin_tools/vc +COFFIX=$TOOLDIR/coffix +WTOOLDIR=`(cygpath -d $TOOLDIR 2>/dev/null || cygpath -w $TOOLDIR)` + +# Do primitive 'make' +newer_exe=`find $TOOLDIR -newer $COFFIX.c -name coffix.exe -print` +if [ -z $newer_exe ]; then + echo recompiling $COFFIX.exe + cl.exe -Fe${WTOOLDIR}\\coffix.exe ${WTOOLDIR}\\coffix.c + rm -f $COFFIX.obj coffix.obj $COFFIX.pdb coffix.pdb +fi + +# Try to find out the output filename and remove it from command line +CMD="" +OUTFILE="" +INFILE="" +SKIP_COFFIX=false +while test -n "$1" ; do + x="$1" + case "$x" in + -o/*) + OUTFILE=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`;; + -o) + shift + OUTFILE=$1;; + -MM) + SKIP_COFFIX=true + CMD="$CMD \"$x\"";; + *.c) + INFILE="$INFILE $x"; + CMD="$CMD \"$x\"";; + *) + CMD="$CMD \"$x\"";; + esac + shift +done +if [ -z "$INFILE" ]; then + echo 'emu_cc.sh: please give an input filename for the compiler' >&2 + exit 1 +fi +if [ -z "$OUTFILE" ]; then + OUTFILE=`echo $INFILE | sed 's,\.c$,.o,'` +fi + +if [ $SKIP_COFFIX = false ]; then + n=`echo $INFILE | wc -w`; + if [ $n -gt 1 ]; then + echo "emu_cc.sh:Error, multiple sources, one object output."; + exit 1; + fi + TEMPFILE=/tmp/tmp_emu_cc$$.o + if [ "X$EMU_CC_SH_DEBUG_LOG" != "X" ]; then + echo "gcc -o $TEMPFILE -D__WIN32__ -DWIN32 -DWINDOWS -fomit-frame-pointer $CMD" >> $EMU_CC_SH_DEBUG_LOG 2>&1 + fi + eval gcc -o $TEMPFILE -D__WIN32__ -DWIN32 -DWINDOWS -fomit-frame-pointer $CMD + RES=$? + if [ $RES = 0 ]; then + $COFFIX.exe -e `(cygpath -d $TEMPFILE 2>/dev/null || cygpath -w $TEMPFILE)` + RES=$? + if [ $RES = 0 ]; then + cp $TEMPFILE $OUTFILE + else + echo "emu_cc.sh: fatal: coffix failed!" >&2 + fi + fi + rm -f $TEMPFILE + exit $RES +else + eval gcc -D__WIN32__ -DWIN32 -DWINDOWS -fomit-frame-pointer -fno-tree-copyrename $CMD 2>/dev/null + exit $? +fi diff --git a/erts/etc/win32/cygwin_tools/vc/ld.sh b/erts/etc/win32/cygwin_tools/vc/ld.sh new file mode 100755 index 0000000000..ac39bf871c --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/ld.sh @@ -0,0 +1,192 @@ +#! /bin/sh +# set -x +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Save the command line for debug outputs +SAVE="$@" +kernel_libs="kernel32.lib advapi32.lib" +gdi_libs="gdi32.lib user32.lib comctl32.lib comdlg32.lib shell32.lib" +DEFAULT_LIBRARIES="$kernel_libs $gdi_libs" + +CMD="" +STDLIB=MSVCRT.LIB +DEBUG_BUILD=false +STDLIB_FORCED=false +BUILD_DLL=false +OUTPUT_FILENAME="" + +while test -n "$1" ; do + x="$1" + case "$x" in + -dll| -DLL) + BUILD_DLL=true;; + -L/*|-L.*) + y=`echo $x | sed 's,^-L\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -libpath:\"$MPATH\"";; + -lMSVCRT|-lmsvcrt) + STDLIB_FORCED=true; + STDLIB=MSVCRT.LIB;; + -lMSVCRTD|-lmsvcrtd) + STDLIB_FORCED=true; + STDLIB=MSVCRTD.LIB;; + -lLIBCMT|-llibcmt) + STDLIB_FORCED=true; + STDLIB=LIBCMT.LIB;; + -lLIBCMTD|-llibcmtd) + STDLIB_FORCED=true; + STDLIB=LIBCMTD.LIB;; + -lsocket) + DEFAULT_LIBRARIES="$DEFAULT_LIBRARIES WS2_32.LIB";; + -l*) + y=`echo $x | sed 's,^-l\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD \"${MPATH}.lib\"";; + -g) + DEBUG_BUILD=true;; + -pdb:none|-incremental:no) + ;; + -implib:*) + y=`echo $x | sed 's,^-implib:\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -implib:\"${MPATH}\"";; + -def:*) + y=`echo $x | sed 's,^-def:\(.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -def:\"${MPATH}\"";; + -o) + shift + MPATH=`cygpath -m $1`; + OUTPUT_FILENAME="$MPATH";; + -o/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + OUTPUT_FILENAME="$MPATH";; + /*) + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; + *) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac + shift +done +if [ $DEBUG_BUILD = true ]; then + linktype="-debug -pdb:none" + if [ $STDLIB_FORCED = false ]; then + STDLIB=MSVCRTD.LIB + fi +fi +# Generate a PDB +linkadd_pdb="" +case "$OUTPUT_FILENAME" in + *.exe|*.EXE) + fn=`echo "$OUTPUT_FILENAME" | sed 's,[eE][xX][eE]$,,g'`; + linkadd_pdb="-pdb:\"${fn}pdb\"";; + *.dll|*.DLL) + fn=`echo "$OUTPUT_FILENAME" | sed 's,[dD][lL][lL]$,,g'`; + linkadd_pdb="-pdb:\"${fn}pdb\"";; + "") + linkadd_pdb="-pdb:\"a.pdb\"";; + *) + linkadd_pdb="-pdb:\"${OUTPUT_FILENAME}.pdb\"";; +esac + + linktype="-debug $linkadd_pdb" + +CHMOD_FILE="" + +if [ $BUILD_DLL = true ];then + case "$OUTPUT_FILENAME" in + *.exe|*.EXE) + echo "Warning, output set to .exe when building DLL" >&2 + CHMOD_FILE="$OUTPUT_FILENAME"; + CMD="-dll -out:\"$OUTPUT_FILENAME\" $CMD"; + OUTPUTRES="${OUTPUT_FILENAME}\;2"; + MANIFEST="${OUTPUT_FILENAME}.manifest";; + *.dll|*.DLL) + CMD="-dll -out:\"$OUTPUT_FILENAME\" $CMD"; + OUTPUTRES="${OUTPUT_FILENAME}\;2"; + MANIFEST="${OUTPUT_FILENAME}.manifest";; + "") + CMD="-dll -out:\"a.dll\" $CMD"; + OUTPUTRES="a.dll\;2"; + MANIFEST="a.dll.manifest";; + *) + CMD="-dll -out:\"${OUTPUT_FILENAME}.dll\" $CMD"; + OUTPUTRES="${OUTPUT_FILENAME}.dll\;2"; + MANIFEST="${OUTPUT_FILENAME}.dll.manifest";; + esac +else + case "$OUTPUT_FILENAME" in + *.exe|*.EXE) + CHMOD_FILE="$OUTPUT_FILENAME"; + CMD="-out:\"$OUTPUT_FILENAME\" $CMD"; + OUTPUTRES="${OUTPUT_FILENAME}\;1" + MANIFEST="${OUTPUT_FILENAME}.manifest";; + *.dll|*.DLL) + echo "Warning, output set to .dll when building EXE" >&2 + CMD="-out:\"$OUTPUT_FILENAME\" $CMD"; + OUTPUTRES="${OUTPUT_FILENAME}\;1"; + MANIFEST="${OUTPUT_FILENAME}.manifest";; + "") + CHMOD_FILE="a.exe"; + CMD="-out:\"a.exe\" $CMD"; + OUTPUTRES="a.exe\;1"; + MANIFEST="a.exe.manifest";; + *) + CMD="-out:\"${OUTPUT_FILENAME}.exe\" $CMD"; + OUTPUTRES="${OUTPUT_FILENAME}.exe\;1"; + MANIFEST="${OUTPUT_FILENAME}.exe.manifest";; + esac +fi + +p=$$ +CMD="$linktype -nologo -incremental:no $CMD $STDLIB $DEFAULT_LIBRARIES" +if [ "X$LD_SH_DEBUG_LOG" != "X" ]; then + echo ld.sh "$SAVE" >>$LD_SH_DEBUG_LOG + echo link.exe $CMD >>$LD_SH_DEBUG_LOG +fi +eval link.exe "$CMD" >/tmp/link.exe.${p}.1 2>/tmp/link.exe.${p}.2 +RES=$? +CMANIFEST=`cygpath $MANIFEST` +if [ "$RES" = "0" -a -f "$CMANIFEST" ]; then + eval mt.exe -nologo -manifest "$MANIFEST" -outputresource:"$OUTPUTRES" >>/tmp/link.exe.${p}.1 2>>/tmp/link.exe.${p}.2 + RES=$? + if [ "$RES" != "0" ]; then + REMOVE=`echo "$OUTPUTRES" | sed 's,\\\;[12]$,,g'` + CREMOVE=`cygpath $REMOVE` + rm -f "$CREMOVE" + fi + rm -f "$CMANIFEST" +fi + +# This works around some strange behaviour +# in cygwin 1.7 Beta on Windows 7 with samba drive. +# Configure will think the compiler failed if test -x fails, +# which it might do as we might not be the owner of the +# file. +if [ '!' -z "$CHMOD_FILE" -a -s "$CHMOD_FILE" -a '!' -x "$CHMOD_FILE" ]; then + chmod +x $CHMOD_FILE +fi + +tail -n +2 /tmp/link.exe.${p}.2 >&2 +cat /tmp/link.exe.${p}.1 +rm -f /tmp/link.exe.${p}.2 /tmp/link.exe.${p}.1 +exit $RES diff --git a/erts/etc/win32/cygwin_tools/vc/ld_wrap.c b/erts/etc/win32/cygwin_tools/vc/ld_wrap.c new file mode 100644 index 0000000000..7fb3c145ee --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/ld_wrap.c @@ -0,0 +1,796 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#include +#include +#include +#include +#include +#include +#include +#include + + + +#ifdef CCP_POSIX_TO_WIN_A +#define NEW_CYGPATH_INTERFACE +#endif + +#ifdef NEW_CYGPATH_INTERFACE +#define GET_WIN32_SIZE(Posix) \ +cygwin_conv_path (CCP_POSIX_TO_WIN_A | CCP_ABSOLUTE, (Posix), NULL, 0) +#define CONVERT_TO_WIN32(Posix,Win32,Size) \ +cygwin_conv_path (CCP_POSIX_TO_WIN_A | CCP_ABSOLUTE, (Posix), \ + (Win32), (Size)) +#else +#define GET_WIN32_SIZE(Posix) PATH_MAX +#define CONVERT_TO_WIN32(Posix,Win32,Size) \ +((cygwin32_conv_to_full_win32_path((Posix),(Win32)) >= 0) ? 0 : -1) +#endif + +/*#define HARDDEBUG 1*/ + +#ifdef HARDDEBUG +#define DEBUGF(X) printf X +#else +#define DEBUGF(X) /* noop */ +#endif +char *tmpobjdir = ""; + +char *add_to(char *src,char *add) { + int len = strlen(src)+strlen(add)+1; + char *n; + + if (strlen(src) == 0) { + n = malloc(len); + strcpy(n,add); + return n; + } + n = realloc(src,len); + strcat(n,add); + return n; +} + +void error(char *str) +{ + fprintf(stderr,"%s\n",str); + exit(1); +} + + +char *dyn_get_short(char *longp) +{ + int size; + char *shortp; + size = GetShortPathName(longp,NULL,0); + if (size <= 0) { + return NULL; + } + shortp = malloc(size); + if (GetShortPathName(longp,shortp,size) != size - 1) { + free(shortp); + return NULL; + } + return shortp; +} + +char *do_cyp(char *posix) +{ + ssize_t size; + char *win32; + size = GET_WIN32_SIZE(posix); + char *ret = NULL; + if (size < 0) { + fprintf(stderr,"Could not cygpath %s, errno = %d\n", + posix,errno); + } else { + win32 = (char *) malloc (size); + if (CONVERT_TO_WIN32(posix, + win32, size)) { + fprintf(stderr,"Could not cygpath %s, errno = %d\n", + posix,errno); + } else { + char *w32_short = dyn_get_short(win32); + DEBUGF(("win32 = %s, w32_short = %s\n",win32, (w32_short == NULL) ? "NULL" : w32_short)); + if (w32_short == NULL) { + char *rest = malloc(size); + char *first = malloc(size); + int x = 0; + int y = strlen(win32) - 1; + strcpy(first,win32); + while (w32_short == NULL) { + while ( y > 0 && first[y] != '\\') { + rest[x++] = first[y--]; + } + if (y > 0) { + rest[x++] = first[y]; + first[y--] = '\0'; + } else { + break; + } + w32_short = dyn_get_short(first); + DEBUGF(("first = %s, w32_short = %s\n",first, (w32_short == NULL) ? "NULL" : w32_short)); + } + if (w32_short != NULL) { + y = strlen(w32_short); + w32_short = realloc(w32_short,y+1+x); + /* spool back */ + while ( x > 0) { + w32_short[y++] = rest[--x]; + } + w32_short[y] = '\0'; + } else { + w32_short = malloc(strlen(win32)+1); + strcpy(w32_short,win32); /* last resort */ + } + free(first); + free(rest); + } + ret = w32_short; + while (*ret) { + if (*ret == '\\') { + *ret = '/'; + } + ++ret; + } + ret = w32_short; + } + free(win32); + } + return ret; +} + + + +char *save = ""; + +void save_args(int argc, char **argv) +{ + int i; + for(i = 0; i < argc; ++i) { + save = add_to(save,argv[i]); + save = add_to(save," "); + } +} + +char *progname="ld_wrap"; + +int my_create_pipe(HANDLE *read_p, HANDLE *write_p) +{ + char name_buff[1000]; + SECURITY_ATTRIBUTES sa = {sizeof(SECURITY_ATTRIBUTES), NULL, TRUE}; + static int counter = 0; + + ++counter; + + sprintf(name_buff,"\\\\.\\pipe\\%s_%d_%d",progname,getpid(),counter); + sa.bInheritHandle = FALSE; + if ((*read_p = CreateNamedPipe(name_buff, + PIPE_ACCESS_INBOUND | FILE_FLAG_OVERLAPPED, + PIPE_TYPE_BYTE | PIPE_READMODE_BYTE, + 1, + 0, + 0, + 2000, + &sa)) == INVALID_HANDLE_VALUE || + *read_p == NULL) { + return 0; + } + sa.bInheritHandle = TRUE; + if ((*write_p = CreateFile(name_buff, + GENERIC_WRITE, + 0, /* No sharing */ + &sa, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, + NULL)) == INVALID_HANDLE_VALUE || + *write_p == NULL) { + CloseHandle(*read_p); + return 0; + } + return 1; +} + +void forwardenv(void) +{ + char *(envs[]) = {"LIB","INCLUDE","LIBPATH", NULL}; + char **p = envs; + while (*p != NULL) { + char *val = getenv(*p); + if (val != NULL) { + SetEnvironmentVariable(*p,val); + } + ++p; + } +} + +HANDLE do_run(char *commandline, HANDLE *out, HANDLE *err) +{ + STARTUPINFO start; + HANDLE write_pipe_stdout = NULL, read_pipe_stdout = NULL; + HANDLE write_pipe_stderr = NULL, read_pipe_stderr = NULL; + SECURITY_ATTRIBUTES pipe_security; + SECURITY_ATTRIBUTES attr; + PROCESS_INFORMATION info; + + + memset(&start,0,sizeof(start)); + memset(&pipe_security,0,sizeof(pipe_security)); + memset(&attr,0,sizeof(attr)); + memset(&info,0,sizeof(info)); + + + pipe_security.nLength = sizeof(pipe_security); + pipe_security.lpSecurityDescriptor = NULL; + pipe_security.bInheritHandle = TRUE; + + if(!my_create_pipe(&read_pipe_stdout,&write_pipe_stdout)){ + error("Could not create stdout pipes!"); + } + if(!my_create_pipe(&read_pipe_stderr,&write_pipe_stderr)){ + error("Could not create stderr pipes!"); + } + start.cb = sizeof (start); + start.dwFlags = STARTF_USESHOWWINDOW; + start.wShowWindow = SW_HIDE; + start.hStdOutput = write_pipe_stdout; + start.hStdError = write_pipe_stderr; + start.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + start.dwFlags |= STARTF_USESTDHANDLES; + + attr.nLength = sizeof(attr); + attr.lpSecurityDescriptor = NULL; + attr.bInheritHandle = TRUE; + forwardenv(); /* Cygwin and windows environment variables... sigh... */ + if(!CreateProcess(NULL, + commandline, + &attr, + NULL, + TRUE, + CREATE_DEFAULT_ERROR_MODE, + NULL, + NULL, + &start, + &info)){ + error("Could not create process"); + } + *out = read_pipe_stdout; + *err = read_pipe_stderr; + CloseHandle(write_pipe_stdout); + CloseHandle(write_pipe_stderr); + return info.hProcess; +} +#define HANDLE_STDOUT 0 +#define HANDLE_STDERR 1 +#define HANDLE_PROC 2 + +#ifdef HARDDEBUG +char *prefix = ""; +#endif + +int handle_overlapped(HANDLE fd, OVERLAPPED *ovp, char *buffer, + int bufflen, int get_old, FILE *whereto, int *skip) +{ + DWORD res,read,err; + char *ptr; + + DEBUGF(("In handle_overlapped(%d,0x%08x,0x%08x,%d,%d), prefix = %s\n", + fd,ovp,buffer,bufflen,get_old,prefix)); + /* hämta resultat av gamla först */ + if (get_old) { + res = GetOverlappedResult(fd,ovp,&read,TRUE); + DEBUGF(("read = %d, res = %d, GetLastError() = %d\n",read,res,GetLastError())); + if (!res) { + return 0; + } + buffer[read] = '\0'; + ptr = buffer; + while(*skip && *ptr != '\0') { + if (*ptr == '\n') { + --(*skip); + } + ++ptr; + } + if(*ptr != '\0') { + fprintf(whereto,"%s",ptr); + } + } + + ResetEvent(ovp->hEvent); + + for(;;) { + res = ReadFile(fd,buffer,bufflen-1,&read,ovp); + + if (!res) { + err = GetLastError(); + if (err == ERROR_IO_PENDING) { + DEBUGF(("Error I/O Pending\n")); + return 1; + } + DEBUGF(("ReadFileFailed for %s, %d\n",prefix,err)); + return 0; + } + buffer[read] = '\0'; + ptr = buffer; + while(*skip && *ptr != '\0') { + if (*ptr == '\n') { + --(*skip); + } + ++ptr; + } + if(*ptr != '\0') { + fprintf(whereto,"%s",ptr); + } + } +} + + +int run(char *commandline,int skipout,int skiperr) +{ + HANDLE harr[3]; + HANDLE real_stdout,real_stderr; + OVERLAPPED ov_out,ov_err; + char outbuff[1024],errbuff[1024]; + DWORD ret,exitcode; + HANDLE wait[3]; + int map[3]; + DWORD nwait = 3; + int i,j; + unsigned living_handles = 0x7; + + harr[HANDLE_STDOUT] = CreateEvent(NULL, + TRUE, + FALSE, /*not signalled */ + NULL); + harr[HANDLE_STDERR] = CreateEvent(NULL, + TRUE, + FALSE,/*not signalled */ + NULL); + + memset(&ov_out,0,sizeof(ov_out)); + memset(&ov_err,0,sizeof(ov_err)); + + ov_out.hEvent = harr[HANDLE_STDOUT]; + ov_err.hEvent = harr[HANDLE_STDERR]; + + harr[HANDLE_PROC] = do_run(commandline,&real_stdout,&real_stderr); + +#ifdef HARDDEBUG + prefix = "STDOUT"; +#endif + handle_overlapped(real_stdout,&ov_out,outbuff,1024,0,stdout,&skipout); +#ifdef HARDDEBUG + prefix = "STDERR"; +#endif + handle_overlapped(real_stderr,&ov_err,errbuff,1024,0,stderr,&skiperr); + + for(;;) { + nwait = 0; + for(i=0;i<3;++i) { + if ((living_handles & (1U << i))) { + map[nwait] = i; + wait[nwait++] = harr[i]; + } + } + + ret = WaitForMultipleObjects(nwait, + wait, + FALSE, + INFINITE); + DEBUGF(("Wait returned %d\n",ret)); + + if (ret == WAIT_FAILED) { + error("Wait failed"); + } + + ret -= WAIT_OBJECT_0; + + switch (map[ret]) { + case HANDLE_PROC: + + DEBUGF(("Process died!\n")); + GetExitCodeProcess(harr[HANDLE_PROC],&exitcode); + if ((living_handles &= (~(1U<= argc) { + error("-o without filename"); + } + output_filename = do_cyp(argv[i]); + } else { + output_filename = do_cyp(opt+1); + } + break; + default: + goto filename; + } + continue; + } + filename: + s = argv[i]; + if (*s == '/') { + mpath = do_cyp(s); + cmd = add_to(cmd," \""); + cmd = add_to(cmd,mpath); + cmd = add_to(cmd,"\""); + free(mpath); + } else { + cmd = add_to(cmd," \""); + cmd = add_to(cmd,s); + cmd = add_to(cmd,"\""); + } + } + if ((debuglog = getenv("LD_SH_DEBUG_LOG")) != NULL) { + debugfile = fopen(debuglog,"wb+"); + if (debugfile) { + fprintf(debugfile,"----------------\n"); + } + } else { + debugfile = NULL; + } + + if (debug_build) { + if (!stdlib_forced) { + stdlib = "MSVCRTD.LIB"; + } + } + + s = add_to("",output_filename); + x = strlen(s); + + if (x >= 4 && (!strcmp(s+x-4,".exe") || !strcmp(s+x-4,".EXE") || + !strcmp(s+x-4,".dll") || !strcmp(s+x-4,".DLL"))) { + *(s+x-3) = '\0'; + linkadd_pdb = add_to(linkadd_pdb,"-pdb:\""); + linkadd_pdb = add_to(linkadd_pdb,s); + linkadd_pdb = add_to(linkadd_pdb,"pdb\""); + } else if (!x) { + linkadd_pdb = add_to(linkadd_pdb,"-pdb:\"a.pdb\""); + } else { + linkadd_pdb = add_to(linkadd_pdb,"-pdb:\""); + linkadd_pdb = add_to(linkadd_pdb,s); + linkadd_pdb = add_to(linkadd_pdb,".pdb\""); + } + free(s); + + + linktype = add_to(linktype,"-debug "); + linktype = add_to(linktype,linkadd_pdb); + + free(linkadd_pdb); + + s = add_to("",output_filename); + x = strlen(s); + + if (build_dll) { + if (x >= 4 && (!strcmp(s+x-4,".exe") || !strcmp(s+x-4,".EXE") || + !strcmp(s+x-4,".dll") || !strcmp(s+x-4,".DLL"))) { + + if (!strcmp(s+x-4,".exe") || !strcmp(s+x-4,".EXE")) { + fprintf(stderr,"Warning, output set to .exe when building DLL"); + } + mpath = cmd; + cmd = add_to("","-dll -out:\""); + cmd = add_to(cmd,s); + cmd = add_to(cmd,"\" "); + cmd = add_to(cmd,mpath); + if (*mpath) { + free(mpath); + } + + outputres = add_to(outputres,output_filename); + outputres = add_to(outputres,";2"); + manifest = add_to(manifest,output_filename); + manifest = add_to(manifest,".manifest"); + } else if (x == 0) { + mpath = cmd; + cmd = add_to("","-dll -out:\"a.dll\" "); + cmd = add_to(cmd,mpath); + if (*mpath) { + free(mpath); + } + + outputres = add_to(outputres,"a.dll;2"); + manifest = add_to(manifest,"a.dll.manifest"); + } else { + mpath = cmd; + cmd = add_to("","-dll -out:\""); + cmd = add_to(cmd,s); + cmd = add_to(cmd,".dll\" "); + cmd = add_to(cmd,mpath); + if (*mpath) { + free(mpath); + } + + outputres = add_to(outputres,output_filename); + outputres = add_to(outputres,".dll;2"); + manifest = add_to(manifest,output_filename); + manifest = add_to(manifest,".dll.manifest"); + } + } else { + if (x >= 4 && (!strcmp(s+x-4,".exe") || !strcmp(s+x-4,".EXE") || + !strcmp(s+x-4,".dll") || !strcmp(s+x-4,".DLL"))) { + + if (!strcmp(s+x-4,".dll") || !strcmp(s+x-4,".DLL")) { + fprintf(stderr,"Warning, output set to .exe when building DLL"); + } + mpath = cmd; + cmd = add_to("","-out:\""); + cmd = add_to(cmd,s); + cmd = add_to(cmd,"\" "); + cmd = add_to(cmd,mpath); + if (*mpath) { + free(mpath); + } + + outputres = add_to(outputres,output_filename); + outputres = add_to(outputres,";1"); + manifest = add_to(manifest,output_filename); + manifest = add_to(manifest,".manifest"); + } else if (x == 0) { + mpath = cmd; + cmd = add_to("","-out:\"a.exe\" "); + cmd = add_to(cmd,mpath); + if (*mpath) { + free(mpath); + } + + outputres = add_to(outputres,"a.exe;1"); + manifest = add_to(manifest,"a.exe.manifest"); + } else { + mpath = cmd; + cmd = add_to("","-out:\""); + cmd = add_to(cmd,s); + cmd = add_to(cmd,".exe\" "); + cmd = add_to(cmd,mpath); + if (*mpath) { + free(mpath); + } + + outputres = add_to(outputres,output_filename); + outputres = add_to(outputres,".exe;1"); + manifest = add_to(manifest,output_filename); + manifest = add_to(manifest,".exe.manifest"); + } + } + + s = cmd; + cmd = add_to("","link.exe "); + cmd = add_to(cmd,linktype); + cmd = add_to(cmd," -nologo -incremental:no "); + cmd = add_to(cmd,s); + cmd = add_to(cmd," "); + cmd = add_to(cmd,stdlib); + cmd = add_to(cmd," "); + cmd = add_to(cmd,default_libraries); + + if (*s) { + free(s); + } + + + if (debugfile) { + fprintf(debugfile,"%s\n",save); + fprintf(debugfile,"%s\n",cmd); + } + + retval = run(cmd,0,0); + + + mpath = do_cyp(manifest); + filefound = 0; + tmpfile = fopen(mpath,"rb"); + if (tmpfile != NULL) { + filefound = 1; + fclose(tmpfile); + } + if (retval == 0 && filefound) { + s = add_to("","mt.exe -nologo -manifest \""); + s = add_to(s,manifest); + s = add_to(s,"\" -outputresource:\""); + s = add_to(s,outputres); + s = add_to(s,"\""); + if (debugfile) { + fprintf(debugfile,"%s\n",s); + } + retval = run(s,0,0); + if (*s) { + free(s); + } + if (retval) { + /* cleanup needed */ + remove = add_to("",outputres); + x = strlen(remove); + remove[x-2] = '\0'; + if (debugfile) { + fprintf(debugfile,"remove %s\n",remove); + } + DeleteFile(remove); + free(remove); + } + if (debugfile) { + fprintf(debugfile,"remove %s\n",manifest); + } + DeleteFile(manifest); + } + return retval; +} + + + + + + + + + + + + + + + + + + diff --git a/erts/etc/win32/cygwin_tools/vc/mc.sh b/erts/etc/win32/cygwin_tools/vc/mc.sh new file mode 100755 index 0000000000..813b59947b --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/mc.sh @@ -0,0 +1,87 @@ +#! /bin/sh +# set -x +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Save the command line for debug outputs +SAVE="$@" +CMD="" +OUTPUT_DIRNAME="" + +# Find the correct mc.exe. This could be done by the configure script, +# But as we seldom use the resource compiler, it might as well be done here... +MCC="" +save_ifs=$IFS +IFS=: +for p in $PATH; do + if [ -f $p/mc.exe ]; then + if [ -n "`$p/mc.exe -? 2>&1 >/dev/null &2 + exit 1 +fi + +while test -n "$1" ; do + x="$1" + case "$x" in + -o) + shift + OUTPUT_DIRNAME="$1";; + -o/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + OUTPUT_DIRNAME="$y";; + -I) + shift + MPATH=`cygpath -m $1`; + CMD="$CMD -I\"$MPATH\"";; + -I/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -I\"$MPATH\"";; + *) + MPATH=`cygpath -m -a $x`; + CMD="$CMD \"$MPATH\"";; + esac + shift +done +p=$$ +if [ "X$MC_SH_DEBUG_LOG" != "X" ]; then + echo rc.sh "$SAVE" >>$MC_SH_DEBUG_LOG + echo rc.exe $CMD >>$MC_SH_DEBUG_LOG +fi +if [ -n "$OUTPUT_DIRNAME" ]; then + cd $OUTPUT_DIRNAME + RES=$? + if [ "$RES" != "0" ]; then + echo "mc.sh: Error: could not cd to $OUTPUT_DIRNAME">&2 + exit $RES + fi +fi +eval $MCC "$CMD" >/tmp/mc.exe.${p}.1 2>/tmp/mc.exe.${p}.2 +RES=$? +tail +2 /tmp/mc.exe.${p}.2 >&2 +cat /tmp/mc.exe.${p}.1 +rm -f /tmp/mc.exe.${p}.2 /tmp/mc.exe.${p}.1 +exit $RES diff --git a/erts/etc/win32/cygwin_tools/vc/rc.sh b/erts/etc/win32/cygwin_tools/vc/rc.sh new file mode 100755 index 0000000000..748de48890 --- /dev/null +++ b/erts/etc/win32/cygwin_tools/vc/rc.sh @@ -0,0 +1,86 @@ +#! /bin/sh +# set -x +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2002-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Save the command line for debug outputs +SAVE="$@" +CMD="" +OUTPUT_FILENAME="" + +# Find the correct rc.exe. This could be done by the configure script, +# But as we seldom use the resource compiler, it might as well be done here... +RCC="" +save_ifs=$IFS +IFS=: +for p in $PATH; do + if [ -f $p/rc.exe ]; then + if [ -n "`$p/rc.exe -? 2>&1 | grep -i "resource compiler"`" ]; then + RCC=$p/rc.exe + fi + fi +done +IFS=$save_ifs + +if [ -z "$RCC" ]; then + echo 'rc.exe not found!' >&2 + exit 1 +fi + +while test -n "$1" ; do + x="$1" + case "$x" in + -o) + shift + MPATH=`cygpath -m $1`; + OUTPUT_FILENAME="$MPATH";; + -o/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + OUTPUT_FILENAME="$MPATH";; + -I) + shift + MPATH=`cygpath -m $1`; + CMD="$CMD -I\"$MPATH\"";; + -I/*) + y=`echo $x | sed 's,^-[Io]\(/.*\),\1,g'`; + MPATH=`cygpath -m $y`; + CMD="$CMD -I\"$MPATH\"";; + /*) + MPATH=`cygpath -m $x`; + CMD="$CMD \"$MPATH\"";; + *) + y=`echo $x | sed 's,",\\\",g'`; + CMD="$CMD \"$y\"";; + esac + shift +done +p=$$ +if [ -n "$OUTPUT_FILENAME" ]; then + CMD="-Fo$OUTPUT_FILENAME $CMD" +fi +if [ "X$RC_SH_DEBUG_LOG" != "X" ]; then + echo rc.sh "$SAVE" >>$RC_SH_DEBUG_LOG + echo rc.exe $CMD >>$RC_SH_DEBUG_LOG +fi +eval $RCC "$CMD" >/tmp/rc.exe.${p}.1 2>/tmp/rc.exe.${p}.2 +RES=$? +tail +2 /tmp/rc.exe.${p}.2 >&2 +cat /tmp/rc.exe.${p}.1 +rm -f /tmp/rc.exe.${p}.2 /tmp/rc.exe.${p}.1 +exit $RES diff --git a/erts/etc/win32/erl.c b/erts/etc/win32/erl.c new file mode 100644 index 0000000000..d341153966 --- /dev/null +++ b/erts/etc/win32/erl.c @@ -0,0 +1,283 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#pragma comment(linker,"/manifestdependency:\"type='win32' "\ + "name='Microsoft.Windows.Common-Controls' "\ + "version='6.0.0.0' processorArchitecture='*' "\ + "publicKeyToken='6595b64144ccf1df' language='*'\"") +#include +#include +#include +#include "init_file.h" + +typedef int ErlexecFunction(int, char **, HANDLE, int); + +#define INI_FILENAME "erl.ini" +#define INI_SECTION "erlang" +#define ERLEXEC_BASENAME "erlexec.dll" + +static void get_parameters(void); +static void error(char* format, ...); + +static char *erlexec_name; +static char *erlexec_dir; + +#ifdef WIN32_WERL +#define WERL 1 +int WINAPI WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, + PSTR szCmdLine, int iCmdShow) +{ + int argc = __argc; + char **argv = __argv; +#else +#define WERL 0 +int main(int argc, char **argv) +{ +#endif + HANDLE erlexec_handle; /* Instance */ + ErlexecFunction *win_erlexec; + char *path = malloc(100); + char *npath; + int pathlen; + + get_parameters(); + + if ((pathlen = GetEnvironmentVariable("PATH",path,100)) == 0) { + error("No PATH variable (!)"); + } else if (pathlen > 100) { + path = realloc(path,pathlen); + GetEnvironmentVariable("PATH",path,pathlen); + } + npath = malloc(strlen(path) + strlen(erlexec_dir) + 2); + sprintf(npath,"%s;%s",erlexec_dir,path); + SetEnvironmentVariable("PATH",npath); + + if ((erlexec_handle = LoadLibrary(erlexec_name)) == NULL) { + error("Could not load module %s.",erlexec_name); + } + + if ((win_erlexec = (ErlexecFunction *) + GetProcAddress(erlexec_handle,"win_erlexec")) == NULL) { + error("Could not find entry point \"win_erlexec\" in %s.", erlexec_name); + } + + return (*win_erlexec)(argc,argv,erlexec_handle,WERL); + +} + + +static char *replace_filename(char *path, char *new_base) +{ + int plen = strlen(path); + char *res = malloc((plen+strlen(new_base)+1)*sizeof(char)); + char *p; + + strcpy(res,path); + for (p = res+plen-1 ;p >= res && *p != '\\'; --p) + ; + *(p+1) ='\0'; + strcat(res,new_base); + return res; +} + +static char *do_lookup_in_section(InitSection *inis, char *name, + char *section, char *filename) +{ + char *p = lookup_init_entry(inis, name); + + if (p == NULL) { + error("Could not find key %s in section %s of file %s", + name,section,filename); + } + return _strdup(p); +} + +static void copy_latest_vsn(char *latest_vsn, char *next_vsn) +{ + /* Copy */ + char *lp; + char *np; + /* Find vsn */ + for (lp = next_vsn+strlen(next_vsn)-1 ;lp >= next_vsn && *lp != '\\'; --lp) + ; + /* lp =+ length("erts-"); */ + for (np = next_vsn+strlen(next_vsn)-1 ;np >= next_vsn && *np != '\\'; --np) + ; + /* np =+ length("erts-"); */ + + for (; lp && np; ++lp, ++np) { + if (*lp == *np) { + continue; + } + if (*np == '.' || *np == '\0' || *np <= *lp) { + /* */ + return; + } + if (*lp == '.' || *lp == '\0') { + strcpy(latest_vsn, next_vsn); + return; + } + } + return; +} + +static char *find_erlexec_dir2(char *install_dir) +{ + /* List install dir and look for latest erts-vsn */ + + HANDLE dir_handle; /* Handle to directory. */ + char wildcard[MAX_PATH]; /* Wildcard to search for. */ + WIN32_FIND_DATA find_data; /* Data found by FindFirstFile() or FindNext(). */ + char latest_vsn[MAX_PATH]; + + /* Setup wildcard */ + int length = strlen(install_dir); + char *p; + + if (length+3 >= MAX_PATH) { + error("Cannot find erlexec.exe"); + } + + strcpy(wildcard, install_dir); + p = wildcard+length-1; + if (*p != '/' && *p != '\\') + *++p = '\\'; + strcpy(++p, "erts-*"); + + /* Find first dir */ + dir_handle = FindFirstFile(wildcard, &find_data); + if (dir_handle == INVALID_HANDLE_VALUE) { + /* No erts-vsn found*/ + return NULL; + } + strcpy(latest_vsn, find_data.cFileName); + + /* Find the rest */ + while(FindNextFile(dir_handle, &find_data)) { + copy_latest_vsn(latest_vsn, find_data.cFileName); + } + + FindClose(dir_handle); + + p = malloc((strlen(install_dir)+1+strlen(latest_vsn)+4+1)*sizeof(char)); + + strcpy(p,install_dir); + strcat(p,"\\"); + strcat(p,latest_vsn); + strcat(p,"\\bin"); + return p; +} + +static char *find_erlexec_dir(char *erlpath) +{ + /* Assume that the path to erl is absolute and + * that it is not a symbolic link*/ + + char *dir =_strdup(erlpath); + char *p; + char *p2; + + /* Chop of base name*/ + for (p = dir+strlen(dir)-1 ;p >= dir && *p != '\\'; --p) + ; + *p ='\0'; + p--; + + /* Check if dir path is like ...\install_dir\erts-vsn\bin */ + for (;p >= dir && *p != '\\'; --p) + ; + p--; + for (p2 = p;p2 >= dir && *p2 != '\\'; --p2) + ; + p2++; + if (strncmp(p2, "erts-", strlen("erts-")) == 0) { + p = _strdup(dir); + free(dir); + return p; + } + + /* Assume that dir path is like ...\install_dir\bin */ + *++p ='\0'; /* chop off bin dir */ + + p = find_erlexec_dir2(dir); + free(dir); + if (p == NULL) { + error("Cannot find erlexec.exe"); + } else { + return p; + } +} + +static void get_parameters(void) +{ + char buffer[MAX_PATH]; + char *ini_filename; + HANDLE module = GetModuleHandle(NULL); + InitFile *inif; + InitSection *inis; + char *bindir; + + if (module = NULL) { + error("Cannot GetModuleHandle()"); + } + + if (GetModuleFileName(module,buffer,MAX_PATH) == 0) { + error("Could not GetModuleFileName"); + } + + ini_filename = replace_filename(buffer,INI_FILENAME); + + if ((inif = load_init_file(ini_filename)) == NULL) { + erlexec_dir = find_erlexec_dir(ini_filename); + SetEnvironmentVariable("ERLEXEC_DIR", erlexec_dir); + } else { + + if ((inis = lookup_init_section(inif,INI_SECTION)) == NULL) { + error("Could not find section %s in init file %s", + INI_SECTION, ini_filename); + } + + erlexec_dir = do_lookup_in_section(inis, "Bindir", INI_SECTION, ini_filename); + free_init_file(inif); + } + + erlexec_name = malloc(strlen(erlexec_dir) + strlen(ERLEXEC_BASENAME) + 2); + strcpy(erlexec_name,erlexec_dir); + strcat(erlexec_name, "\\" ERLEXEC_BASENAME); + + free(ini_filename); +} + + +static void error(char* format, ...) +{ + char sbuf[2048]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + +#ifndef WIN32_WERL + fprintf(stderr, "%s\n", sbuf); +#else + MessageBox(NULL, sbuf, "Werl", MB_OK|MB_ICONERROR); +#endif + exit(1); +} + diff --git a/erts/etc/win32/erl.rc b/erts/etc/win32/erl.rc new file mode 100644 index 0000000000..88213d48f2 --- /dev/null +++ b/erts/etc/win32/erl.rc @@ -0,0 +1,31 @@ +// +// %CopyrightBegin% +// +// Copyright Ericsson AB 1998-2009. All Rights Reserved. +// +// The contents of this file are subject to the Erlang Public License, +// Version 1.1, (the "License"); you may not use this file except in +// compliance with the License. You should have received a copy of the +// Erlang Public License along with this software. If not, it can be +// retrieved online at http://www.erlang.org/. +// +// Software distributed under the License is distributed on an "AS IS" +// basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +// the License for the specific language governing rights and limitations +// under the License. +// +// %CopyrightEnd% +// +#include +#include "resource.h" + +1 ICON DISCARDABLE "erlang.ico" + + + + + + + + + diff --git a/erts/etc/win32/erl_icon.ico b/erts/etc/win32/erl_icon.ico new file mode 100644 index 0000000000..3e228317cd Binary files /dev/null and b/erts/etc/win32/erl_icon.ico differ diff --git a/erts/etc/win32/erl_log.c b/erts/etc/win32/erl_log.c new file mode 100644 index 0000000000..85cc49e0e3 --- /dev/null +++ b/erts/etc/win32/erl_log.c @@ -0,0 +1,73 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1996-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* ----------------------------------------------------------------- + * erl_log: + * + * Provides a simple debug log for the Erlang emulator. + * It simples echoes its standard intput to the console. + * + * Author: Bjorn Gustavsson + * Created: 1996-12-06 + * ----------------------------------------------------------------- + */ + +#include +#include + +static void print_last_error(char* message); + +main() +{ + HANDLE in; + HANDLE out; + char sbuf[256]; + DWORD written; + DWORD numChars; + + in = GetStdHandle(STD_INPUT_HANDLE); + out = CreateFile("CONOUT$", GENERIC_WRITE, 0, NULL, OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, NULL); + if (out == INVALID_HANDLE_VALUE) { + print_last_error("CreateFile"); + exit(1); + } + + while (ReadFile(in, sbuf, sizeof(sbuf), &numChars, NULL) && numChars) { + WriteFile(out, sbuf, numChars, &written, NULL); + } + return 0; +} + +static void print_last_error(char* message) +{ + LPTSTR* lpBufPtr; + + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &lpBufPtr, + 0, + NULL); + if (message == NULL) + printf("%s", lpBufPtr); + else + printf("%s: %s\n", message, lpBufPtr); +} diff --git a/erts/etc/win32/erlang.ico b/erts/etc/win32/erlang.ico new file mode 100644 index 0000000000..cee8b58af9 Binary files /dev/null and b/erts/etc/win32/erlang.ico differ diff --git a/erts/etc/win32/erlsrv/erlsrv_global.h b/erts/etc/win32/erlsrv/erlsrv_global.h new file mode 100644 index 0000000000..d3922dc1e3 --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_global.h @@ -0,0 +1,37 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef _ERLSRV_GLOBAL_H +#define _ERLSRV_GLOBAL_H + +#define APP_NAME "ErlSrv" + +#define ERLANG_MACHINE "erl.exe" + +#define SERVICE_ENV "ERLSRV_SERVICE_NAME" +#define EXECUTABLE_ENV "ERLSRV_EXECUTABLE" +#define DEBUG_ENV "ERLSRV_DEBUG" + +#ifdef _DEBUG +#define HARDDEBUG 1 +#define DEBUG 1 +#else +#define NDEBUG 1 +#endif + +#endif /* _ERLSRV_GLOBAL_H */ diff --git a/erts/etc/win32/erlsrv/erlsrv_interactive.c b/erts/etc/win32/erlsrv/erlsrv_interactive.c new file mode 100644 index 0000000000..13e029b364 --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_interactive.c @@ -0,0 +1,1163 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include +#include +#include +#include +#include +#include +#include "erlsrv_global.h" +#include "erlsrv_registry.h" +#include "erlsrv_interactive.h" +#include "erlsrv_util.h" /* service_name */ + +#define DBG fprintf(stderr,"argv[0]:%s line %d\n",argv[0],__LINE__) + +/* Really HAS to correcpond to the enum in erlsrv_registry.h */ +static char *arg_tab[] = { + "stopaction", "st", + "onfail", "on", + "machine", "m", + "env", "e", + "workdir", "w", + "priority", "p", + "sname", "sn", + "name", "n", + "args", "ar", + "debugtype", "d", + "internalservicename","i", + "comment","c", + NULL, NULL +}; + +static char *generate_real_service_name(char *display_name){ + SYSTEMTIME systime; + FILETIME ftime; + char *buff = malloc(strlen(display_name)+ + (8*2)+1); + char *tmp = _strdup(display_name); + int i; + /* 2 Hex chars for each byte in a DWORD */ + GetSystemTime(&systime); + SystemTimeToFileTime(&systime,&ftime); + /* Remove trailing version info to avoid user confusion */ + for(i = (strlen(tmp)-1);i > 0; --i) + if(tmp[i] == '_'){ + tmp[i] = '\0'; + break; + } + sprintf(buff,"%s%08x%08x",tmp,ftime.dwHighDateTime, + ftime.dwLowDateTime); + free(tmp); + return buff; +} + +static int lookup_arg(char *arg){ + int i; + if(*arg != '-' && *arg != '/') + return -1; + for(i=0; arg_tab[i] != NULL; i += 2){ + if(!_strnicmp(arg_tab[i],arg+1,strlen(arg+1)) && + !_strnicmp(arg_tab[i+1],arg+1,strlen(arg_tab[i+1]))) + return (i / 2); + } + return -1; +} + + + +char *edit_env(char *edit, char *oldenv){ + char **arg; + char *value; + char *name = strdup(edit); + int i; + char *tmp; + arg = env_to_arg(oldenv); + value = strchr(name,'='); + if(value){ + *(value++) = '\0'; + if(*value == '\0') + value = NULL; + } + for(i=0;arg[i] != NULL; ++i){ + tmp = strchr(arg[i],'='); + if(((int) strlen(name)) == (tmp - arg[i]) && + !_strnicmp(name,arg[i], tmp - arg[i])) + break; + } + if(arg[i] != NULL){ + free(arg[i]); + if(value){ + arg[i] = strdup(edit); + } else { + do { + arg[i] = arg[i+1]; + ++i; + } while(arg[i] != NULL); + } + } else if(value){ /* add to arg, which is always allocated + to hold one extra environment variable*/ + arg[i] = strdup(edit); + arg[i+1] = NULL; + } + free(name); + return arg_to_env(arg); +} + +int last_error = 0; + +void print_last_error(void){ + char *mes; + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + (last_error) ? last_error : GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &mes, + 0, + NULL ); + fprintf(stderr,"Error: %s",mes); + LocalFree(mes); +} + +static BOOL install_service(void){ + SC_HANDLE scm; + SC_HANDLE service; + char filename[MAX_PATH + 3]; + DWORD fnsiz=MAX_PATH; + char dependant[] = { 'L','a','n','m','a','n', + 'W','o','r','k','s','t', + 'a','t','i','o','n','\0','\0'}; + + if(!(fnsiz = GetModuleFileName(NULL, filename, fnsiz))) + return FALSE; + if(strchr(filename,' ')){ + memmove(filename+1,filename,fnsiz); + filename[0] ='\"'; /* " */ + filename[fnsiz+1] = '\"'; /* " */ + filename[fnsiz+2] = '\0'; + } + if((scm = OpenSCManager(NULL, + NULL, + SC_MANAGER_CONNECT | + SC_MANAGER_CREATE_SERVICE)) + == NULL){ + last_error = GetLastError(); + return FALSE; + } + service = CreateService(scm, + real_service_name, + service_name, + SERVICE_ALL_ACCESS & + ~(SERVICE_PAUSE_CONTINUE), + SERVICE_WIN32_OWN_PROCESS, + SERVICE_AUTO_START, + SERVICE_ERROR_NORMAL, + filename, + NULL, + NULL, + dependant, + NULL, + NULL); + if(service == NULL){ + CloseServiceHandle(scm); + last_error = GetLastError(); + return FALSE; + } + CloseServiceHandle(service); + CloseServiceHandle(scm); + return TRUE; +} + +static BOOL remove_service(void){ + SC_HANDLE scm; + SC_HANDLE service; + if((scm = OpenSCManager(NULL, + NULL, + GENERIC_WRITE)) + == NULL) + return FALSE; + service = OpenService(scm, + real_service_name, + SERVICE_ALL_ACCESS); + if(service == NULL){ + CloseServiceHandle(scm); + return FALSE; + } + if(!DeleteService(service)){ + last_error = GetLastError(); + return FALSE; + } + CloseServiceHandle(service); + CloseServiceHandle(scm); + return TRUE; +} + +static BOOL open_service_control(SC_HANDLE *scm, SC_HANDLE *service){ + if((*scm = OpenSCManager(NULL, + NULL, + SC_MANAGER_ALL_ACCESS)) + == NULL) + return FALSE; + *service = OpenService(*scm, + real_service_name, + SERVICE_ALL_ACCESS); + if(service == NULL){ + CloseServiceHandle(*scm); + return FALSE; + } + return TRUE; +} + +static BOOL open_service_config(SC_HANDLE *scm, SC_HANDLE *service){ + if((*scm = OpenSCManager(NULL, + NULL, + /*GENERIC_WRITE | GENERIC_EXECUTE*/ + SC_MANAGER_ALL_ACCESS)) + == NULL){ + last_error = GetLastError(); + return FALSE; + } + *service = OpenService(*scm, + real_service_name, + /*GENERIC_WRITE*/ + SERVICE_ALL_ACCESS); + if(service == NULL){ + last_error = GetLastError(); + CloseServiceHandle(*scm); + return FALSE; + } + return TRUE; +} + +static BOOL set_service_comment(char *comment) { + SC_HANDLE scm; + SC_HANDLE service; + SERVICE_DESCRIPTION sd; + BOOL ret = TRUE; + sd.lpDescription = comment; + if (!open_service_config(&scm,&service)) { + return FALSE; + } + if (!ChangeServiceConfig2(service,SERVICE_CONFIG_DESCRIPTION,&sd)) { + last_error = GetLastError(); + ret = FALSE; + } + CloseServiceHandle(service); + CloseServiceHandle(scm); + return ret; +} + +static BOOL wait_service_trans(DWORD initial, DWORD passes, DWORD goal, + int timeout) +{ + SC_HANDLE scm; + SC_HANDLE service; + int moved = 0; + BOOL ret; + int i; + SERVICE_STATUS stat; + + if(! open_service_config(&scm,&service)) + return FALSE; + for(i = 0; i < timeout; ++i){ + if(!QueryServiceStatus(service,&stat)){ + last_error = GetLastError(); + ret = FALSE; + goto out; + } + if(stat.dwCurrentState == initial){ + if(moved){ + ret = FALSE; + + /* + * The exitcode is usually strange when we tried to stop and failed, + * to report a timeout is more appropriate. + */ + if(goal == SERVICE_STOPPED) + last_error = ERROR_SERVICE_REQUEST_TIMEOUT; + else + last_error = stat.dwWin32ExitCode; + goto out; + } + } else if(stat.dwCurrentState == passes){ + moved = 1; + } else if(stat.dwCurrentState == goal){ + ret = TRUE; + goto out; + } + Sleep(1000); + } + ret = FALSE; + last_error = ERROR_SERVICE_REQUEST_TIMEOUT; +out: + CloseServiceHandle(scm); + CloseServiceHandle(service); + return ret; +} + +static BOOL stop_service(void){ + SC_HANDLE scm; + SC_HANDLE service; + BOOL ret; + SERVICE_STATUS ss; + + if(!open_service_control(&scm,&service)){ +#ifdef HARDDEBUG + fprintf(stderr,"Failed to open service.\n"); +#endif + return FALSE; + } + ret = ControlService(service,SERVICE_CONTROL_STOP,&ss); + if(!ret){ + last_error = GetLastError(); + } + CloseServiceHandle(service); + CloseServiceHandle(scm); +#ifdef HARDDEBUG + if(!ret) + { + fprintf(stderr,"Failed to control service.\n"); + print_last_error(); + } +#endif + return ret; +} + +static BOOL start_service(void){ + SC_HANDLE scm; + SC_HANDLE service; + BOOL ret; + + if(!open_service_control(&scm,&service)) + return FALSE; + + ret = StartService(service,0,NULL); + if(!ret){ + last_error = GetLastError(); + } + CloseServiceHandle(service); + CloseServiceHandle(scm); + return ret; +} + +static BOOL disable_service(void){ + SC_HANDLE scm; + SC_HANDLE service; + BOOL ret; + + if(!open_service_config(&scm,&service)) + return FALSE; + + ret = ChangeServiceConfig(service, + SERVICE_NO_CHANGE, + SERVICE_DISABLED, + SERVICE_NO_CHANGE, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL); + if(!ret){ + last_error = GetLastError(); + } + + CloseServiceHandle(service); + CloseServiceHandle(scm); + return ret; +} + +static BOOL enable_service(void){ + SC_HANDLE scm; + SC_HANDLE service; + BOOL ret; + +if(!open_service_config(&scm,&service)) + return FALSE; + + ret = ChangeServiceConfig(service, + SERVICE_NO_CHANGE, + SERVICE_AUTO_START, + SERVICE_NO_CHANGE, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL); + + if(!ret){ + last_error = GetLastError(); + } + CloseServiceHandle(service); + CloseServiceHandle(scm); + return ret; +} + +static BOOL set_interactive(BOOL interactive){ + SC_HANDLE scm; + SC_HANDLE service; + BOOL ret; + + if(!open_service_config(&scm,&service)) + return FALSE; + + ret = ChangeServiceConfig(service, + SERVICE_WIN32_OWN_PROCESS | ((interactive) ? + SERVICE_INTERACTIVE_PROCESS : 0), + SERVICE_NO_CHANGE, + SERVICE_NO_CHANGE, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL); + + if(!ret){ + last_error = GetLastError(); + } + CloseServiceHandle(service); + CloseServiceHandle(scm); + return ret; +} + + +RegEntry *old_entries = NULL; + +BOOL fetch_current(RegEntry *new){ + int i; + + if(!(old_entries = get_keys(service_name))) + return FALSE; + for(i=0;i filename && *ptr != '\\'; + --ptr) + ; + if(*ptr == '\\') + ++ptr; + *ptr = '\0'; + + ptr = malloc(strlen(filename)+strlen(ERLANG_MACHINE)+1); + strcpy(ptr,filename); + strcat(ptr,ERLANG_MACHINE); + + new[StopAction].data.bytes = ""; + new[OnFail].data.value = ON_FAIL_IGNORE; + new[Machine].data.bytes = ptr; + new[Machine].data.expand.unexpanded = ptr; + new[Env].data.bytes = "\0"; + new[WorkDir].data.bytes = new[WorkDir].data.expand.unexpanded = + ""; + new[Priority].data.value = NORMAL_PRIORITY_CLASS; + new[SName].data.bytes = service_name; + new[Name].data.bytes = ""; + new[Args].data.bytes = new[Args].data.expand.unexpanded = ""; + new[DebugType].data.value = DEBUG_TYPE_NO_DEBUG; + new[InternalServiceName].data.bytes = real_service_name; + new[Comment].data.bytes = ""; + return TRUE; +} + +int do_usage(char *arg0){ + printf("Usage:\n"); + printf("%s {set | add} \n" + "\t[-st[opaction] []]\n" + "\t[-on[fail] [{reboot | restart | restart_always}]]\n" + "\t[-m[achine] []]\n" + "\t[-e[nv] [[=]]]\n" + "\t[-w[orkdir] []]\n" + "\t[-p[riority] [{low|high|realtime}]]\n" + "\t[{-sn[ame] | -n[ame]} []]\n" + "\t[-d[ebugtype] [{new|reuse|console}]]\n" + "\t[-ar[gs] []]\n\n" + "%s {start | stop | disable | enable} \n\n" + "%s remove \n\n" + "%s rename \n\n" + "%s list []\n\n" + "%s help\n\n", + arg0,arg0,arg0,arg0,arg0,arg0); + printf("Manipulates Erlang system services on Windows NT.\n\n"); + printf("When no parameter to an option is specified, the option\n" + "is reset to it's default value. To set an empty argument\n" + "list, give option -args as last option on command line " + "with\n" + "no arguments.\n\n"); + printf("Se Erlang documentation for full description.\n"); + return 0; +} + +int do_manage(int argc,char **argv){ + char *action = argv[1]; + RegEntry *current = empty_reg_tab(); + + if(argc < 3){ + fprintf(stderr,"%s: No servicename given!\n",argv[0]); + do_usage(argv[0]); + return 1; + } + service_name = argv[2]; + if(!fetch_current(current)){ + fprintf(stderr,"%s: The service %s is not an erlsrv controlled service.\n", + argv[0],service_name); + return 1; + } + real_service_name = _strdup(current[InternalServiceName].data.bytes); + free_keys(current); + + if(!_stricmp(action,"start")){ + if(!start_service()){ + fprintf(stderr,"%s: Failed to start service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } else { + if(!wait_service_trans(SERVICE_STOPPED, SERVICE_START_PENDING, + SERVICE_RUNNING, 60)){ + fprintf(stderr,"%s: Failed to start service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } + printf("%s: Service %s started.\n", + argv[0],service_name); + return 0; + } + } + if(!_stricmp(action,"stop")){ + if(!stop_service()){ + fprintf(stderr,"%s: Failed to stop service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } else { + if(!wait_service_trans(SERVICE_RUNNING, SERVICE_STOP_PENDING, + SERVICE_STOPPED, 60)){ + fprintf(stderr,"%s: Failed to stop service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } + printf("%s: Service %s stopped.\n", + argv[0],service_name); + return 0; + } + } + if(!_stricmp(action,"disable")){ +#if 0 + if(stop_service()){ + printf("%s: Service %s stopped.\n", + argv[0],service_name); + } +#endif + if(!disable_service()){ + fprintf(stderr,"%s: Failed to disable service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } else { + printf("%s: Service %s disabled.\n", + argv[0],service_name); + return 0; + } + } + if(!_stricmp(action,"enable")){ + if(!enable_service()){ + fprintf(stderr,"%s: Failed to enable service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } else { + printf("%s: Service %s enabled.\n", + argv[0],service_name); + return 0; + } + } + fprintf(stderr,"%s: Unrecignized argument %s.\n", + argv[0],action); + return 1; +} + +int do_add_or_set(int argc, char **argv){ + RegEntry *new_entries; + RegEntry *default_entries; + int add = 0; + int i; + int current; + int set_comment = 0; + new_entries = empty_reg_tab(); + default_entries = empty_reg_tab(); + if(argc < 3){ + fprintf(stderr,"%s: No servicename given!\n",argv[0]); + do_usage(argv[0]); + return 1; + } + service_name = argv[2]; + if(!_stricmp(argv[1],"add")){ + if(fetch_current(default_entries)){ + fprintf(stderr,"%s: A service with the name %s already " + "exists.\n", + argv[0],service_name); + return 1; + } + real_service_name = generate_real_service_name(service_name); + if(!fill_in_defaults(new_entries)){ + fprintf(stderr,"%s: Internal error.\n", argv[0]); + return 1; + } + add = 1; + } else { + if(!fetch_current(new_entries)){ + fprintf(stderr,"%s: No service with the name %s exists.\n", + argv[0], service_name); + return 1; + } + real_service_name = new_entries[InternalServiceName].data.bytes; + } + + if(!fill_in_defaults(default_entries)){ + fprintf(stderr,"%s: Internal error.\n", argv[0]); + return 1; + } + + /* make sure env is malloced... */ + new_entries[Env].data.bytes = envdup(new_entries[Env].data.bytes); + + for(i = 3; i < argc; ++i){ + switch((current = lookup_arg(argv[i]))){ + case Comment: + set_comment = 1; + case Machine: + case WorkDir: + case Args: + if(i+1 >= argc){ + new_entries[current].data.bytes = + default_entries[current].data.bytes; + new_entries[current].data.expand.unexpanded = + default_entries[current].data.expand.unexpanded; + } else { + new_entries[current].data.expand.unexpanded = + new_entries[current].data.bytes = argv[i+1]; + ++i; + } + break; + case SName: + new_entries[Name].data.bytes = ""; + case StopAction: + case Name: + if(i+1 >= argc || + *argv[i+1] == '-' || *argv[i+1] == '/'){ + new_entries[current].data.bytes = + default_entries[current].data.bytes; + } else { + new_entries[current].data.bytes = argv[i+1]; + ++i; + } + break; + case OnFail: + if(i+1 >= argc || + *argv[i+1] == '-' || *argv[i+1] == '/'){ + new_entries[current].data.value = + default_entries[current].data.value; + } else { + if(!_stricmp(argv[i+1],"reboot")) + new_entries[current].data.value = ON_FAIL_REBOOT; + else if(!_stricmp(argv[i+1],"restart")) + new_entries[current].data.value = ON_FAIL_RESTART; + else if(!_stricmp(argv[i+1],"restart_always")) + new_entries[current].data.value = ON_FAIL_RESTART_ALWAYS; + else { + fprintf(stderr,"%s: Unrecognized keyword value %s.\n", + argv[0],argv[i+1]); + return 1; + } + ++i; + } + break; + case DebugType: + if(i+1 >= argc || + *argv[i+1] == '-' || *argv[i+1] == '/'){ + new_entries[current].data.value = + default_entries[current].data.value; + } else { + if(!_stricmp(argv[i+1],"new")) + new_entries[current].data.value = DEBUG_TYPE_NEW; + else if(!_stricmp(argv[i+1],"reuse")) + new_entries[current].data.value = DEBUG_TYPE_REUSE; + else if(!_stricmp(argv[i+1],"console")) + new_entries[current].data.value = DEBUG_TYPE_CONSOLE; + else { + fprintf(stderr,"%s: Unrecognized keyword value %s.\n", + argv[0],argv[i+1]); + return 1; + } + ++i; + } + break; + case Priority: + if(i+1 >= argc || + *argv[i+1] == '-' || *argv[i+1] == '/'){ + new_entries[current].data.value = + default_entries[current].data.value; + } else { + if(!_stricmp(argv[i+1],"high")) + new_entries[current].data.value = HIGH_PRIORITY_CLASS; + else if(!_stricmp(argv[i+1],"low")) + new_entries[current].data.value = IDLE_PRIORITY_CLASS; + else if(!_stricmp(argv[i+1],"realtime")) + new_entries[current].data.value = REALTIME_PRIORITY_CLASS; + else { + fprintf(stderr,"%s: Unrecognized keyword value %s.\n", + argv[0],argv[i+1]); + return 1; + } + ++i; + } + break; + + case Env: + if(i+1 >= argc || + *argv[i+1] == '-' || *argv[i+1] == '/'){ + fprintf(stderr,"%s: %s requires a parameter.\n", + argv[0],argv[i]); + return 1; + } + new_entries[current].data.bytes = + edit_env(argv[i+1], + new_entries[current].data.bytes); + ++i; + break; + case InternalServiceName: + if (!add) { + fprintf(stderr,"%s: %s only allowed when adding a new service.\n", + argv[0],argv[i]); + return 1; + } + if(i+1 >= argc){ + fprintf(stderr,"%s: %s requires a parameter.\n", + argv[0],argv[i]); + return 1; + } + new_entries[InternalServiceName].data.expand.unexpanded = + new_entries[InternalServiceName].data.bytes = argv[i+1]; + ++i; + /* Discard old, should maybe be fred' but we'll exit anyway */ + real_service_name = new_entries[InternalServiceName].data.bytes; + break; + default: + fprintf(stderr,"%s: Unrecognized option %s.\n", argv[0], + argv[i]); + return 1; + } + } + if(*new_entries[SName].data.bytes && + *new_entries[Name].data.bytes){ +#if 0 + fprintf(stderr,"%s: Both -sname and -name specified.\n", + argv[0]); + return 1; +#else + new_entries[SName].data.bytes = ""; +#endif + } + if(add && !(*new_entries[SName].data.bytes) && + !(*new_entries[Name].data.bytes)){ + fprintf(stderr,"%s: Neither -sname nor -name specified.\n", + argv[0]); + return 1; + } + if(add && !install_service()){ + fprintf(stderr,"%s: Unable to register service with service manager.\n", + argv[0], service_name); + print_last_error(); + return 1; + } + if(!set_interactive(new_entries[DebugType].data.value == + DEBUG_TYPE_CONSOLE)){ + fprintf(stderr,"%s: Warning, could not set correct interactive mode.\n", + argv[0], service_name); + print_last_error(); + /* Not severe or??? */ + } + /* Update registry */ + register_logkeys(); + set_keys(service_name, new_entries); + /* Update service comment if needed */ + if(set_comment) { + if (!set_service_comment(new_entries[Comment].data.bytes)) { + fprintf(stderr,"%s: Warning, could not set correct " + "service description (comment)", + argv[0], service_name); + print_last_error(); + } + } + + /* As I do this, I should also clean up the new entries, which is + somewhat harder as I really dont know what is and what is not + malloced, but we'll exit anyway, so... */ + cleanup_old(); + if(add) + printf("%s: Service %s added to system.\n", + argv[0], service_name); + else + printf("%s: Service %s updated.\n", + argv[0], service_name); + return 0; +} +int do_rename(int argc, char **argv){ + RegEntry *current = empty_reg_tab(); + RegEntry *dummy = empty_reg_tab(); + SC_HANDLE scm; + SC_HANDLE service; + if(argc < 3){ + fprintf(stderr,"%s: No old servicename given!\n",argv[0]); + do_usage(argv[0]); + return 1; + } + if(argc < 4){ + fprintf(stderr,"%s: No new servicename given!\n",argv[0]); + do_usage(argv[0]); + return 1; + } + service_name = argv[3]; + if(fetch_current(dummy)){ + fprintf(stderr,"%s: A service with the name %s already " + "exists.\n", + argv[0],service_name); + return 1; + } + service_name = argv[2]; + + if(!fetch_current(current)){ + fprintf(stderr,"%s: Error, old service name %s does not exist.\n", + argv[0],service_name); + return 1; + } + real_service_name = _strdup(current[InternalServiceName].data.bytes); + if(!open_service_config(&scm,&service)){ + fprintf(stderr,"%s: Error, unable to communicate with service control" + " manager.\n", + argv[0]); + print_last_error(); + return 1; + } + if(!ChangeServiceConfig(service, + SERVICE_NO_CHANGE, + SERVICE_NO_CHANGE, + SERVICE_NO_CHANGE, + NULL, + NULL, + NULL, + NULL, + NULL, + NULL, + argv[3])){ + fprintf(stderr,"%s: Error, unable to communicate with service control" + " manager.\n", + argv[0]); + print_last_error(); + CloseServiceHandle(scm); + CloseServiceHandle(service); + return 1; + } + CloseServiceHandle(scm); + CloseServiceHandle(service); + + if(remove_keys(service_name) != 0) + fprintf(stderr,"%s: Warning, old service parameter keys could not " + "be removed, continuing.\n", argv[0]); + /* Update registry */ + register_logkeys(); + set_keys(argv[3], current); + + printf("%s: Service %s renamed to %s.\n", + argv[0], service_name, argv[3]); + return 0; +} + +int do_remove(int argc, char **argv){ + RegEntry *current = empty_reg_tab(); + int rem_res; + BOOL found; + + if(argc < 3){ + fprintf(stderr,"%s: No servicename given!\n",argv[0]); + do_usage(argv[0]); + return 1; + } + service_name = argv[2]; + found = fetch_current(current); + if(found){ + real_service_name = _strdup(current[InternalServiceName].data.bytes); + } else { + real_service_name = _strdup(service_name); + } + if(found) + free_keys(current); + if(stop_service() && !wait_service_trans(SERVICE_RUNNING, + SERVICE_STOP_PENDING, + SERVICE_STOPPED, 60)){ + fprintf(stderr,"%s: Failed to stop running service %s.\n", + argv[0],service_name); + print_last_error(); + return 1; + } + if(!remove_service()){ + fprintf(stderr,"%s: Unable to remove service (not enough " + "privileges?)\n",argv[0]); + print_last_error(); + return 1; + } + + if((rem_res = remove_keys(service_name)) > 0){ + fprintf(stderr,"%s: Warning, service parameter keys belonged to old " + "erlsrv version.\n", argv[0]); + /* Backward compatibility... */ + } else if(rem_res < 0) { + fprintf(stderr,"%s: Error, service parameter keys nonexistent.\n", + argv[0]); + return 1; + } + printf("%s: Service %s removed from system.\n", + argv[0], service_name); + return 0; +} + +BOOL list_one(char *servicename, RegEntry *keys, BOOL longlist){ + char *onfail; + char *prio; + char *debugtype; + switch(keys[OnFail].data.value){ + case ON_FAIL_RESTART: + onfail = "restart"; + break; + case ON_FAIL_RESTART_ALWAYS: + onfail = "restart_always"; + break; + case ON_FAIL_REBOOT: + onfail = "reboot"; + break; + default: + onfail = "ignore"; + } + switch(keys[DebugType].data.value){ + case DEBUG_TYPE_NEW: + debugtype = "new"; + break; + case DEBUG_TYPE_REUSE: + debugtype = "reuse"; + break; + case DEBUG_TYPE_CONSOLE: + debugtype = "console"; + break; + default: + debugtype = "none"; + } + switch(keys[Priority].data.value){ + case HIGH_PRIORITY_CLASS: + prio = "high"; + break; + case IDLE_PRIORITY_CLASS: + prio = "low"; + break; + case REALTIME_PRIORITY_CLASS: + prio = "realtime"; + break; + case NORMAL_PRIORITY_CLASS: + prio = "default"; + break; + default: + prio = "unknown/faulty"; + } + + + if(longlist){ + char *env = envdup(keys[Env].data.bytes); + char **arg = env_to_arg(env); + char **pek = arg; + printf("Service name: %s\n", + servicename); + printf("StopAction: %s\n", + keys[StopAction].data.bytes); + printf("OnFail: %s\n",onfail); + printf("Machine: %s\n", + keys[Machine].data.expand.unexpanded); + printf("WorkDir: %s\n", + keys[WorkDir].data.expand.unexpanded); + if(*keys[SName].data.bytes) + printf("SName: %s\n", + keys[SName].data.bytes); + else + printf("Name: %s\n", + keys[Name].data.bytes); + printf("Priority: %s\n",prio); + printf("DebugType: %s\n",debugtype); + printf("Args: %s\n", + keys[Args].data.expand.unexpanded); + printf("InternalServiceName: %s\n", + keys[InternalServiceName].data.bytes); + printf("Comment: %s\n", + keys[Comment].data.bytes); + printf("Env:\n"); + while(*pek){ + printf("\t%s\n",*pek); + ++pek; + } + /* env is easier to free...*/ + env = arg_to_env(arg); + free(env); + } else { + printf("%s\t%s\t%s\t%s\t%s\n", + servicename, + (*keys[Name].data.bytes) ? + keys[Name].data.bytes : + keys[SName].data.bytes, + prio, + onfail, + keys[Args].data.expand.unexpanded); + } + return TRUE; +} + + +int do_list(int argc, char **argv){ + if(argc < 3){ + RegEntryDesc *all_keys = get_all_keys(); + if(!all_keys){ + fprintf(stderr,"%s: No services found in registry.\n", + argv[0]); + return 0; + } + printf("Service\t(S)Name\tPrio\tOnFail\tArgs\n"); + while(all_keys->servicename){ + list_one(all_keys->servicename,all_keys->entries,FALSE); + ++all_keys; + } + return 0; + } else { + RegEntry *keys; + service_name = argv[2]; + keys = get_keys(service_name); + if(!keys){ + fprintf(stderr,"%s: Could not retrieve any " + "registered data for %s.\n",argv[0],service_name); + return 1; + } + list_one(service_name, keys, TRUE); + } + return 0; +} + +#define READ_CHUNK 100 +#define ARGV_CHUNK 20 + +char *safe_get_line(void){ + int lsize = READ_CHUNK; + char *line = malloc(READ_CHUNK); + int pos = 0; + int ch; + + while((ch = getchar()) != EOF && ch != '\n'){ + if(pos + 1 >= lsize){ + line = realloc(line,(lsize += READ_CHUNK)); + assert(line); + } + line[pos++] = ch; + } + if(ch == EOF || !pos){ + free(line); + return NULL; + } + line[pos] = '\0'; + return line; +} + + +void read_arguments(int *pargc, char ***pargv){ + int argc = 0; + int asize = ARGV_CHUNK; + char **argv = malloc(ARGV_CHUNK*sizeof(char *)); + char *tmp; + + argv[0] = (*pargv)[0]; + argc = 1; + while((tmp = safe_get_line()) != NULL){ + if(argc + 1 >= asize){ + argv = realloc(argv,(asize += ARGV_CHUNK)*sizeof(char *)); + assert(argv); + } + argv[argc++] = tmp; + } + argv[argc] = NULL; + *pargc = argc; + *pargv = argv; +} + + +int interactive_main(int argc, char **argv){ + char *action = argv[1]; + + if(!_stricmp(action,"readargs")){ + read_arguments(&argc,&argv); + action = argv[1]; + } + if(!_stricmp(action,"set") || !_stricmp(action,"add")) + return do_add_or_set(argc,argv); + if(!_stricmp(action,"rename")) + return do_rename(argc,argv); + if(!_stricmp(action,"remove")) + return do_remove(argc,argv); + if(!_stricmp(action,"list")) + return do_list(argc,argv); + if(!_stricmp(action,"start") || + !_stricmp(action,"stop") || + !_stricmp(action,"enable") || + !_stricmp(action,"disable")) + return do_manage(argc,argv); + if(_stricmp(action,"?") && + _stricmp(action,"/?") && + _stricmp(action,"-?") && + *action != 'h' && + *action != 'H') + fprintf(stderr,"%s: action %s not implemented.\n",argv[0],action); + do_usage(argv[0]); + return 1; +} + diff --git a/erts/etc/win32/erlsrv/erlsrv_interactive.h b/erts/etc/win32/erlsrv/erlsrv_interactive.h new file mode 100644 index 0000000000..deacf81899 --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_interactive.h @@ -0,0 +1,24 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef _ERLSRV_INTERACTIVE_H +#define _ERLSRV_INTERACTIVE_H + +int interactive_main(int argc, char **argv); + +#endif /* _ERLSRV_INTERACTIVE_H */ diff --git a/erts/etc/win32/erlsrv/erlsrv_logmess.mc b/erts/etc/win32/erlsrv/erlsrv_logmess.mc new file mode 100644 index 0000000000..354ac14c9f --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_logmess.mc @@ -0,0 +1,33 @@ +;/*MessageIDTypedef=WORD*/ +; +;/*MessageID=0x1*/ +;/*SymbolicName=CAT_GENERIC*/ +;/*Language=English*/ +;/*Generic Category*/ +;/*.*/ +; +MessageIDTypedef=DWORD + +MessageID=0x10 +Severity=Warning +Facility=Application +SymbolicName=MSG_WARNING +Language=English +%1: %2 +. +MessageID=0x11 +Severity=Error +Facility=Application +SymbolicName=MSG_ERROR +Language=English +%1: %2 +. +MessageID=0x12 +Severity=Informational +Facility=Application +SymbolicName=MSG_INFO +Language=English +%1: %2 +. + + diff --git a/erts/etc/win32/erlsrv/erlsrv_main.c b/erts/etc/win32/erlsrv/erlsrv_main.c new file mode 100644 index 0000000000..920a4a1827 --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_main.c @@ -0,0 +1,44 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include +#include +#include +#include +#include +#include "erlsrv_global.h" +#include "erlsrv_interactive.h" +#include "erlsrv_service.h" + +int main(int argc, char **argv){ + if(argc > 1) + return interactive_main(argc,argv); + else + return service_main(argc,argv); +} + + + + + + + + + + + diff --git a/erts/etc/win32/erlsrv/erlsrv_registry.c b/erts/etc/win32/erlsrv/erlsrv_registry.c new file mode 100644 index 0000000000..c1aa9f2b67 --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_registry.c @@ -0,0 +1,404 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include +#include +#include +#include +#include +#include "erlsrv_global.h" +#include "erlsrv_registry.h" + +#define LOG_TYPE "System" +#define LOG_ROOT \ +"SYSTEM\\CurrentControlSet\\Services\\EventLog\\" LOG_TYPE "\\" +#define LOG_APP_KEY APP_NAME + + +#define BASE_KEY HKEY_LOCAL_MACHINE +#define PRODUCT_NAME APP_NAME +#define OLD_PRODUCT_VERSION "1.0" +#define PRODUCT_VERSION "1.1" +#define PROG_KEY "SOFTWARE\\Ericsson\\Erlang\\" PRODUCT_NAME "\\" PRODUCT_VERSION +#define OLD_PROG_KEY "SOFTWARE\\Ericsson\\Erlang\\" PRODUCT_NAME "\\" OLD_PRODUCT_VERSION + +#define MAX_KEY_LEN MAX_PATH + +static const char * const noString = "\0"; + +#define MAX_MANDATORY_REG_ENTRY 10 /* InternalServiceName == reg_entries[10] */ +static RegEntry reg_entries[] = { + {"StopAction",REG_SZ,NULL}, + {"OnFail",REG_DWORD,NULL}, + {"Machine",REG_EXPAND_SZ,NULL}, + {"Env", REG_MULTI_SZ,NULL}, + {"WorkDir", REG_EXPAND_SZ,NULL}, + {"Priority",REG_DWORD,NULL}, + {"SName",REG_SZ,NULL}, + {"Name",REG_SZ,NULL}, + {"Args",REG_EXPAND_SZ,NULL}, + {"DebugType",REG_DWORD,NULL}, + {"InternalServiceName",REG_SZ,NULL}, + /* Non mandatory follows */ + {"Comment",REG_SZ,NULL} +}; + + +int num_reg_entries = sizeof(reg_entries)/sizeof(RegEntry); + +RegEntry *empty_reg_tab(void){ + RegEntry *ret = malloc(num_reg_entries * sizeof(RegEntry)); + memcpy(ret,reg_entries,num_reg_entries * sizeof(RegEntry)); + return ret; +} + +void free_keys(RegEntry *keys){ + int i; + + for(i=0;iservicename != NULL; ++tmp){ + free_keys(tmp->entries); + free(tmp->servicename); + } + free(descs); +} + +RegEntry *get_keys(char *servicename){ + RegEntry *res = NULL; + HKEY prog_key; + int key_opened = 0; + int i; + DWORD ret; + char *copy; + char *tmpbuf; + DWORD tmpbuflen; + + char key_to_open[MAX_KEY_LEN]; + + DWORD val_type; + char *val_data = malloc(MAX_KEY_LEN); + DWORD val_datalen; + DWORD val_datasiz = MAX_KEY_LEN; + + if(strlen(PROG_KEY) + strlen(servicename) + 2 > MAX_KEY_LEN) + goto error; + sprintf(key_to_open,"%s\\%s",PROG_KEY,servicename); + + if(RegOpenKeyEx(BASE_KEY, + key_to_open, + 0, + KEY_QUERY_VALUE, + &prog_key) != ERROR_SUCCESS) + goto error; + key_opened = 1; + + res = malloc(num_reg_entries*sizeof(RegEntry)); + for(i=0;i MAX_MANDATORY_REG_ENTRY && ret == ERROR_FILE_NOT_FOUND) { + /* Non mandatory entries, look at the type... */ + switch (reg_entries[i].type){ + case REG_EXPAND_SZ: + case REG_SZ: + case REG_MULTI_SZ: + val_datalen = 0; + break; + case REG_DWORD: + { + DWORD dummy = 0; + memcpy(val_data,&dummy,(val_datalen = sizeof(DWORD))); + } + break; + default: + goto error; + } + break; /* for(;;) */ + } else { + goto error; + } + } + res[i] = reg_entries[i]; + copy = NULL; + switch(reg_entries[i].type){ + case REG_EXPAND_SZ: + if(!val_datalen || val_data[0] == '\0'){ + copy = (char *) noString; + res[i].data.expand.unexpanded = (char *) noString; + } else { + tmpbuf = malloc(MAX_KEY_LEN); + tmpbuflen = (DWORD) MAX_KEY_LEN; + for(;;){ + ret = ExpandEnvironmentStrings(val_data,tmpbuf,tmpbuflen); + if(!ret){ + free(tmpbuf); + goto error; + }else if(ret > tmpbuflen){ + tmpbuf=realloc(tmpbuf,tmpbuflen=ret); + } else { + copy = strdup(tmpbuf); + free(tmpbuf); + break; + } + } + res[i].data.expand.unexpanded = strdup(val_data); + } + case REG_MULTI_SZ: + case REG_SZ: + if(!copy){ + if(!val_datalen || + ((val_datalen == 1 && val_data[0] == '\0') || + (val_datalen == 2 && val_data[0] == '\0' && + val_data[1] == '\0'))){ + copy = (char *) noString; + } else { + copy = malloc(val_datalen); + memcpy(copy,val_data,val_datalen); + } + } + res[i].data.bytes = copy; + break; + case REG_DWORD: + memcpy(&res[i].data.value,val_data,sizeof(DWORD)); + break; + default: + goto error; + } + } + RegCloseKey(prog_key); + free(val_data); + return res; +error: + free(val_data); + if(res != NULL) + free_keys(res); + if(key_opened) + RegCloseKey(prog_key); + return NULL; +} + +int set_keys(char *servicename, RegEntry *keys){ + HKEY prog_key; + int key_opened = 0; + int i; + char key_to_open[MAX_KEY_LEN]; + DWORD disposition; + + if(strlen(PROG_KEY) + strlen(servicename) + 2 > MAX_KEY_LEN) + goto error; + sprintf(key_to_open,"%s\\%s",PROG_KEY,servicename); + + if(RegOpenKeyEx(BASE_KEY, + key_to_open, + 0, + KEY_SET_VALUE, + &prog_key) != ERROR_SUCCESS){ + if(RegCreateKeyEx(BASE_KEY, + key_to_open, + 0, + NULL, + REG_OPTION_NON_VOLATILE, + KEY_SET_VALUE, + NULL, + &prog_key, + &disposition) != ERROR_SUCCESS) + goto error; + } + key_opened = 1; + + + for(i=0;i= res_siz - 1) + res = realloc(res, (res_siz += 10)*sizeof(RegEntryDesc)); + if(!(res[ndx].entries = get_keys(name))) + goto error; + res[ndx].servicename = strdup(name); + res[++ndx].servicename = NULL; + } + RegCloseKey(prog_key); + return res; +error: + if(key_opened) + RegCloseKey(prog_key); + free_all_keys(res); + return NULL; +} + +int register_logkeys(void){ + HKEY key; + DWORD disposition; + DWORD types = EVENTLOG_ERROR_TYPE | + EVENTLOG_WARNING_TYPE | + EVENTLOG_INFORMATION_TYPE; + DWORD catcount=1; + char filename[2048]; + DWORD fnsiz=2048; + + if(RegCreateKeyEx(HKEY_LOCAL_MACHINE, + LOG_ROOT LOG_APP_KEY, 0, + NULL, REG_OPTION_NON_VOLATILE, + KEY_SET_VALUE, NULL, + &key, &disposition) != ERROR_SUCCESS) + return -1; + if(!GetModuleFileName(NULL, filename, fnsiz)) + return -1; + if(RegSetValueEx(key, "EventMessageFile", + 0, REG_EXPAND_SZ, (LPBYTE) filename, + strlen(filename)+1) != ERROR_SUCCESS) + return -1; + if(RegSetValueEx(key, "TypesSupported", + 0, REG_DWORD, (LPBYTE) &types, + sizeof(DWORD)) != ERROR_SUCCESS) + return -1; + return 0; +} + diff --git a/erts/etc/win32/erlsrv/erlsrv_registry.h b/erts/etc/win32/erlsrv/erlsrv_registry.h new file mode 100644 index 0000000000..fbccc5416a --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_registry.h @@ -0,0 +1,76 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef _ERLSRV_REGISTRY_H +#define _ERLSRV_REGISTRY_H + +typedef struct _reg_entry { + char *name; + DWORD type; + union { + char *bytes; + DWORD value; + struct { + char *bytes; + char *unexpanded; + } expand; + } data; +} RegEntry; + +typedef struct _reg_entry_desc { + char *servicename; + RegEntry *entries; +} RegEntryDesc; + +enum { + StopAction, + OnFail, + Machine, + Env, + WorkDir, + Priority, + SName, + Name, + Args, + DebugType, + InternalServiceName, + Comment +}; + +#define ON_FAIL_IGNORE 0 +#define ON_FAIL_RESTART 1 +#define ON_FAIL_REBOOT 2 +#define ON_FAIL_RESTART_ALWAYS 3 + +#define DEBUG_TYPE_NO_DEBUG 0 +#define DEBUG_TYPE_NEW 1 +#define DEBUG_TYPE_REUSE 2 +#define DEBUG_TYPE_CONSOLE 3 + +extern int num_reg_entries; + +RegEntry *empty_reg_tab(void); +void free_keys(RegEntry *keys); +void free_all_keys(RegEntryDesc *descs); +RegEntry *get_keys(char *servicename); +int set_keys(char *servicename, RegEntry *keys); +RegEntryDesc *get_all_keys(void); +int remove_keys(char *servicename); +int register_logkeys(void); +#endif /* _ERLSRV_REGISTRY_H */ + diff --git a/erts/etc/win32/erlsrv/erlsrv_service.c b/erts/etc/win32/erlsrv/erlsrv_service.c new file mode 100644 index 0000000000..a58ee862c5 --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_service.c @@ -0,0 +1,966 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include +#include +#include +#include +#include +#include "erlsrv_global.h" +#include "erlsrv_registry.h" +#include "erlsrv_util.h" +#include "erlsrv_service.h" + +static HANDLE eventStop; + +static HANDLE eventKillErlang; + +static CRITICAL_SECTION crit; + +static SERVICE_STATUS_HANDLE statusHandle; + +static DWORD currentState; + +static void fill_status(SERVICE_STATUS *status){ + status->dwServiceType = SERVICE_WIN32_OWN_PROCESS; + status->dwCurrentState = 0; + status->dwControlsAccepted = SERVICE_ACCEPT_STOP | SERVICE_ACCEPT_SHUTDOWN; + status->dwWin32ExitCode = NO_ERROR; + status->dwServiceSpecificExitCode = 0; + status->dwCheckPoint = 0; + status->dwWaitHint = 0; +} + +static BOOL set_start_pending(int waithint, int checkpoint){ + SERVICE_STATUS stat; + fill_status(&stat); + EnterCriticalSection(&crit); + currentState = stat.dwCurrentState = SERVICE_START_PENDING; + LeaveCriticalSection(&crit); + stat.dwControlsAccepted = 0; + stat.dwCheckPoint = checkpoint; + stat.dwWaitHint = waithint; + return SetServiceStatus(statusHandle, &stat); +} + +static BOOL set_stop_pending(int waithint, int checkpoint){ + SERVICE_STATUS stat; + fill_status(&stat); + EnterCriticalSection(&crit); + currentState = stat.dwCurrentState = SERVICE_STOP_PENDING; + LeaveCriticalSection(&crit); + stat.dwControlsAccepted = 0; + stat.dwCheckPoint = checkpoint; + stat.dwWaitHint = waithint; + return SetServiceStatus(statusHandle, &stat); +} + +static BOOL set_running(){ + SERVICE_STATUS stat; + fill_status(&stat); + EnterCriticalSection(&crit); + currentState = stat.dwCurrentState = SERVICE_RUNNING; + LeaveCriticalSection(&crit); + return SetServiceStatus(statusHandle, &stat); +} + +static BOOL set_stopped(int error){ + SERVICE_STATUS stat; + fill_status(&stat); + EnterCriticalSection(&crit); + currentState = stat.dwCurrentState = SERVICE_STOPPED; + LeaveCriticalSection(&crit); + stat.dwWin32ExitCode = error; + return SetServiceStatus(statusHandle, &stat); +} + +static BOOL reset_current(){ + SERVICE_STATUS stat; + fill_status(&stat); + EnterCriticalSection(&crit); + stat.dwCurrentState = currentState; + LeaveCriticalSection(&crit); + return SetServiceStatus(statusHandle, &stat); +} + +static VOID WINAPI handler(DWORD control){ + char buffer[1024]; + sprintf(buffer,"handler called with control = %d.",(int) control); + log_debug(buffer); + switch(control){ + case SERVICE_CONTROL_STOP: + set_stop_pending(30000,1); + SetEvent(eventStop); + return; + case SERVICE_CONTROL_SHUTDOWN: + return; + default: + reset_current(); + break; + } + return; +} + +typedef struct _server_info { + RegEntry *keys; + PROCESS_INFORMATION info; + HANDLE erl_stdin; + char *event_name; +} ServerInfo; + + +typedef struct { + BOOL initialized; + TOKEN_DEFAULT_DACL *defdacl; + PACL newacl; + PSID adminsid; +} SaveAclStruct; + + +static BOOL reset_acl(SaveAclStruct *save_acl){ + HANDLE tokenh; + + if(!save_acl->initialized) + return FALSE; + if(!OpenProcessToken(GetCurrentProcess(), + TOKEN_READ|TOKEN_WRITE,&tokenh)){ + log_warning("Failed to open access token."); + return FALSE; + } + save_acl->initialized = FALSE; + if(!SetTokenInformation(tokenh, + TokenDefaultDacl, + save_acl->defdacl, + sizeof(TOKEN_DEFAULT_DACL))){ + log_warning("Failed to get default ACL from token."); + CloseHandle(tokenh); + LocalFree(save_acl->defdacl); + LocalFree(save_acl->newacl); + FreeSid(save_acl->adminsid); + return FALSE; + } + CloseHandle(tokenh); + LocalFree(save_acl->defdacl); + LocalFree(save_acl->newacl); + FreeSid(save_acl->adminsid); + return TRUE; +} + + +static BOOL new_acl(SaveAclStruct *save_acl){ + HANDLE tokenh; + TOKEN_DEFAULT_DACL newdacl; + DWORD required; + PACL oldacl; + PACL newacl; + int i; + ACL_SIZE_INFORMATION si; + size_t newsize; + PSID extra_sid; + SID_IDENTIFIER_AUTHORITY nt_auth = SECURITY_NT_AUTHORITY; + TOKEN_DEFAULT_DACL dummy; + + save_acl->initialized = FALSE; + if(!OpenProcessToken(GetCurrentProcess(), + TOKEN_READ|TOKEN_WRITE,&tokenh)){ + log_warning("Failed to open access token."); + return FALSE; + } + save_acl->defdacl = &dummy; + required = sizeof(TOKEN_DEFAULT_DACL); + GetTokenInformation(tokenh, + TokenDefaultDacl, + &(save_acl->defdacl), + sizeof(TOKEN_DEFAULT_DACL), + &required); + if(required == 0){ + log_warning("Failed to get any ACL info from token."); + CloseHandle(tokenh); + return FALSE; + } + save_acl->defdacl = LocalAlloc(LPTR,required); + if(!GetTokenInformation(tokenh, + TokenDefaultDacl, + save_acl->defdacl, + required, + &required)){ +#ifdef HARDDEBUG + { + char *mes; + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &mes, + 0, + NULL ); + log_info(mes); + LocalFree(mes); + } +#endif + log_warning("Failed to get default ACL from token."); + CloseHandle(tokenh); + return FALSE; + } + + oldacl = save_acl->defdacl->DefaultDacl; + if(!GetAclInformation(oldacl, &si, sizeof(si), + AclSizeInformation)){ + log_warning("Failed to get size information for ACL"); + CloseHandle(tokenh); + return FALSE; + } + + if(!AllocateAndInitializeSid(&nt_auth, + 2, + SECURITY_BUILTIN_DOMAIN_RID, + DOMAIN_ALIAS_RID_ADMINS, + 0, + 0, + 0, + 0, + 0, + 0, + &extra_sid)){ + log_warning("Failed to initialize administrator SID."); + CloseHandle(tokenh); + return FALSE; + } + + newsize = si.AclBytesInUse + sizeof(ACL) + + sizeof(ACCESS_ALLOWED_ACE) + GetLengthSid(extra_sid); + + newacl = LocalAlloc(LPTR,newsize); + + if(!InitializeAcl(newacl, newsize, ACL_REVISION)){ + log_warning("Failed to initialize new ACL."); + LocalFree(newacl); + FreeSid(extra_sid); + CloseHandle(tokenh); + return FALSE; + } + + for(i=0;i<((int)si.AceCount);++i){ + ACE_HEADER *ace_header; + if (!GetAce (oldacl, i, &ace_header)){ + log_warning("Failed to get ACE from old ACL."); + LocalFree(newacl); + FreeSid(extra_sid); + CloseHandle(tokenh); + return FALSE; + } + if(!AddAce(newacl,ACL_REVISION,0xffffffff,ace_header, + ace_header->AceSize)){ + log_warning("Failed to set ACE in new ACL."); + LocalFree(newacl); + FreeSid(extra_sid); + CloseHandle(tokenh); + return FALSE; + } + } + if(!AddAccessAllowedAce(newacl, + ACL_REVISION2, + PROCESS_ALL_ACCESS, + extra_sid)){ + log_warning("Failed to add system ACE to new ACL."); + LocalFree(newacl); + FreeSid(extra_sid); + return FALSE; + } + + newdacl.DefaultDacl = newacl; + if(!SetTokenInformation(tokenh, + TokenDefaultDacl, + &newdacl, + sizeof(newdacl))){ + log_warning("Failed to set token information"); + LocalFree(newacl); + FreeSid(extra_sid); + CloseHandle(tokenh); + return FALSE; + } + save_acl->initialized = TRUE; + save_acl->newacl = newacl; + save_acl->adminsid = extra_sid; + CloseHandle(tokenh); + + return TRUE; +} + +static char **find_arg(char **arg, char *str){ + char *tmp; + int len; + + str = strdup(str); + if((tmp = strchr(str,'=')) == NULL) + goto fail; + tmp++; + *tmp = '\0'; + len = tmp - str; + while(*arg != NULL){ + if(!_strnicmp(*arg,str,len)){ + free(str); + return arg; + } + ++arg; + } +fail: + free(str); + return NULL; +} + +static char **merge_environment(char *current, char *add){ + char **c_arg = env_to_arg(envdup(current)); + char **a_arg = env_to_arg(envdup(add)); + char **new; + char **tmp; + int i,j; + + for(i=0;c_arg[i] != NULL;++i) + ; + for(j=0;a_arg[j] != NULL;++j) + ; + + new = malloc(sizeof(char *)*(i + j + 3)); + + for(i = 0; c_arg[i] != NULL; ++i) + new[i] = strdup(c_arg[i]); + + new[i] = NULL; + + for(j = 0; a_arg[j] != NULL; ++j){ + if((tmp = find_arg(new,a_arg[j])) != NULL){ + free(*tmp); + *tmp = strdup(a_arg[j]); + } else { + new[i++] = strdup(a_arg[j]); + new[i] = NULL; + } + } + free(arg_to_env(c_arg)); + free(arg_to_env(a_arg)); + return new; +} + + +static char *get_next_debug_file(char *prefix){ + char *buffer = malloc(strlen(prefix)+12); + int i; + for(i=1;i<100;++i){ + sprintf(buffer,"%s.%d",prefix,i); + if(GetFileAttributes(buffer) == 0xFFFFFFFF) + return buffer; + } + return NULL; +} + + + +static BOOL start_a_service(ServerInfo *srvi){ + STARTUPINFO start; + char execbuff[MAX_PATH*4]; /* FIXME: Can get overflow! */ + char namebuff[MAX_PATH]; + char errbuff[MAX_PATH*4]; /* hmmm.... */ + HANDLE write_pipe = NULL, read_pipe = NULL; + SECURITY_ATTRIBUTES pipe_security; + SECURITY_ATTRIBUTES attr; + HANDLE nul; + SaveAclStruct save_acl; + char *my_environ; + BOOL console_allocated = FALSE; + + if(!(*(srvi->keys[Env].data.bytes))){ + my_environ = NULL; + } else { + char *tmp; + char **merged = merge_environment((tmp = GetEnvironmentStrings()), + srvi->keys[Env].data.bytes); + FreeEnvironmentStrings(tmp); + my_environ = arg_to_env(merged); + } + + if(!*(srvi->keys[Machine].data.bytes) || + (!*(srvi->keys[SName].data.bytes) && + !*(srvi->keys[Name].data.bytes))){ + log_error("Not enough parameters for erlang service."); + if(my_environ) + free(my_environ); + return FALSE; + } + + if(*(srvi->keys[SName].data.bytes)) + sprintf(namebuff,"-nohup -sname %s",srvi->keys[SName].data.bytes); + else + sprintf(namebuff,"-nohup -name %s",srvi->keys[Name].data.bytes); + + if(srvi->keys[DebugType].data.value == DEBUG_TYPE_CONSOLE) + strcat(namebuff," -keep_window"); + + if (srvi->event_name != NULL) { + sprintf(execbuff,"\"%s\" -service_event %s %s %s", + srvi->keys[Machine].data.bytes, + srvi->event_name, + namebuff, + srvi->keys[Args].data.bytes); + } else { + sprintf(execbuff,"\"%s\" %s %s", + srvi->keys[Machine].data.bytes, + namebuff, + srvi->keys[Args].data.bytes); + } + + memset (&start, 0, sizeof (start)); + start.cb = sizeof (start); + start.dwFlags = STARTF_USESHOWWINDOW; + start.wShowWindow = SW_HIDE; + + /* Console debugging implies no working StopAction */ + if(srvi->keys[DebugType].data.value == DEBUG_TYPE_CONSOLE) { + COORD coord = {80,999}; + if(console_allocated = AllocConsole()) + SetConsoleScreenBufferSize(GetStdHandle(STD_OUTPUT_HANDLE),coord); + else + log_warning("Unable to allocate debugging console!"); + } else if(*(srvi->keys[StopAction].data.bytes) || + srvi->keys[DebugType].data.value != DEBUG_TYPE_NO_DEBUG){ + pipe_security.nLength = sizeof(pipe_security); + pipe_security.lpSecurityDescriptor = NULL; + pipe_security.bInheritHandle = TRUE; + if(!CreatePipe(&read_pipe,&write_pipe,&pipe_security,0)){ + log_error("Could not create pipe for erlang service."); + if(my_environ) + free(my_environ); + return FALSE; + } + if(srvi->keys[DebugType].data.value != DEBUG_TYPE_NO_DEBUG){ + char *filename; + if(*(srvi->keys[WorkDir].data.bytes)){ + filename = malloc(strlen(srvi->keys[WorkDir].data.bytes) + 1 + + strlen(service_name)+strlen(".debug")+1); + sprintf(filename,"%s\\%s.debug", + srvi->keys[WorkDir].data.bytes, + service_name); + } else { + filename = malloc(strlen(service_name)+strlen(".debug")+1); + sprintf(filename,"%s.debug",service_name); + } + log_debug(filename); + + if(srvi->keys[DebugType].data.value == DEBUG_TYPE_NEW){ + char *tmpfn = get_next_debug_file(filename); + if(tmpfn){ + free(filename); + filename = tmpfn; + } else { + log_warning("Number of debug files exceeds system defined " + "limit, reverting to DebugType: reuse. "); + } + } + + + nul = CreateFile(filename, + GENERIC_READ | GENERIC_WRITE, + FILE_SHARE_READ | FILE_SHARE_WRITE, + &pipe_security, + CREATE_ALWAYS, + FILE_ATTRIBUTE_NORMAL, + NULL); + free(filename); + } else { /* Not debugging */ + nul = CreateFile("NUL", + GENERIC_READ | GENERIC_WRITE, + FILE_SHARE_READ | FILE_SHARE_WRITE, + &pipe_security, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, + NULL); + } + if(nul == NULL){ + log_error((srvi->keys[DebugType].data.value != DEBUG_TYPE_NO_DEBUG) + ? "Could not create debug file. " + "(Working directory not valid?)" + : "Cold not open NUL!"); + start.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + start.hStdError = GetStdHandle(STD_ERROR_HANDLE); + } + start.hStdOutput = nul; + start.hStdError = nul; + start.hStdInput = read_pipe; + start.dwFlags |= STARTF_USESTDHANDLES; + } + + attr.nLength = sizeof(attr); + attr.lpSecurityDescriptor = NULL; + attr.bInheritHandle = TRUE; + + new_acl(&save_acl); + + if(!CreateProcess(NULL, + execbuff, + &attr, + NULL, + (read_pipe != NULL), + CREATE_DEFAULT_ERROR_MODE | + (srvi->keys[Priority].data.value), + my_environ, + (*(srvi->keys[WorkDir].data.bytes)) ? + srvi->keys[WorkDir].data.bytes : NULL, + &start, + &(srvi->info))){ + sprintf(errbuff,"Could not start erlang service" + "with commandline \"%s\".", + service_name, + execbuff + ); + log_error(errbuff); + if(read_pipe != NULL){ + CloseHandle(read_pipe); + CloseHandle(write_pipe); + if(nul != NULL) + CloseHandle(nul); + } + if(console_allocated) + FreeConsole(); + reset_acl(&save_acl); + if(my_environ) + free(my_environ); + return FALSE; + } + if(console_allocated) + FreeConsole(); +#ifdef HARDDEBUG + sprintf(errbuff, + "Started %s with the following commandline: " + "%s",service_name,execbuff); + log_debug(errbuff); +#endif + if(read_pipe != NULL){ + CloseHandle(read_pipe); + if(nul != NULL) + CloseHandle(nul); + srvi->erl_stdin = write_pipe; + } + + reset_acl(&save_acl); + if(my_environ) + free(my_environ); + return TRUE; +} + +static HANDLE create_erlang_event(char *event_name) +{ + HANDLE e; + if ((e = OpenEvent(EVENT_ALL_ACCESS,FALSE,event_name)) == NULL) { + if ((e = CreateEvent(NULL, TRUE, FALSE, event_name)) == NULL) { + log_warning("Could not create or access erlang termination event"); + } + } else { + if (!ResetEvent(e)) { + log_warning("Could not reset erlang termination event."); + } + } + return e; +} + +static BOOL stop_erlang(ServerInfo *srvi, int waithint, + int *checkpoint){ + DWORD written = 0; + char *action = srvi->keys[StopAction].data.bytes; + DWORD towrite = strlen(action)+1; + char *toerl; + DWORD exitcode; + int i; + int kill; + + if(towrite > 2 && srvi->erl_stdin != NULL){ + toerl = malloc(towrite+1); + strcpy(toerl,action); + strcat(toerl,"\n"); + WriteFile(srvi->erl_stdin, toerl, towrite, &written,0); + free(toerl); + /* Give it 45 seconds to terminate */ + for(i=0;i<45;++i){ + if(WaitForSingleObject(srvi->info.hProcess, 1000) == + WAIT_OBJECT_0){ + GetExitCodeProcess(srvi->info.hProcess,&exitcode); + CloseHandle(srvi->info.hProcess); + CloseHandle(srvi->info.hThread); + return TRUE; + } + ++(*checkpoint); + set_stop_pending(waithint,*checkpoint); + } + log_warning("StopAction did not terminate erlang. Trying forced kill."); + } + log_debug("Terminating erlang..."); + kill = 1; + if(eventKillErlang != NULL && SetEvent(eventKillErlang) != 0){ + for(i=0;i<10;++i){ + if(WaitForSingleObject(srvi->info.hProcess, 1000) == WAIT_OBJECT_0){ + kill = 0; + break; + } + ++(*checkpoint); + set_stop_pending(waithint,*checkpoint); + } + } else { +#ifdef HARDDEBUG + { + char *mes; + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &mes, + 0, + NULL ); + log_info(mes); + LocalFree(mes); + } +#endif + log_debug("Could not send control event to Erlang process"); + } + if(kill){ + log_warning("Using TerminateProcess to kill erlang."); + if(!TerminateProcess(srvi->info.hProcess,NO_ERROR)) + log_error("TerminateProcess failed"); + } + GetExitCodeProcess(srvi->info.hProcess,&exitcode); + CloseHandle(srvi->info.hProcess); + CloseHandle(srvi->info.hThread); + if (eventKillErlang != NULL) { + ResetEvent(eventKillErlang); + } + return TRUE; +} + +static BOOL enable_privilege(void) { + HANDLE ProcessHandle; + DWORD DesiredAccess = TOKEN_ADJUST_PRIVILEGES; + HANDLE TokenHandle; + TOKEN_PRIVILEGES Tpriv; + LUID luid; + ProcessHandle = GetCurrentProcess(); + OpenProcessToken(ProcessHandle, DesiredAccess, &TokenHandle); + LookupPrivilegeValue(0,SE_SHUTDOWN_NAME,&luid); + Tpriv.PrivilegeCount = 1; + Tpriv.Privileges[0].Luid = luid; + Tpriv.Privileges[0].Attributes = SE_PRIVILEGE_ENABLED; + return AdjustTokenPrivileges(TokenHandle,FALSE,&Tpriv,0,0,0); +} + +static BOOL pull_service_name(void){ + SC_HANDLE scm; + DWORD sz = 1024; + static char service_name_buff[1024]; + if((scm = OpenSCManager(NULL, + NULL, + GENERIC_READ)) + == NULL){ + return FALSE; + } + if(!GetServiceDisplayName(scm,real_service_name,service_name_buff,&sz)) + return FALSE; + CloseServiceHandle(scm); + service_name = service_name_buff; + return TRUE; +} + + +static VOID WINAPI service_main_loop(DWORD argc, char **argv){ + int waithint = 30000; + int checkpoint = 1; + RegEntry *keys; + RegEntry *save_keys; + ServerInfo srvi; + HANDLE harr[2]; + FILETIME creationt,exitt,kernelt,usert; + LONGLONG creationl,exitl,diffl; + char event_name[MAX_PATH] = "ErlSrv_"; + char executable_name[MAX_PATH]; +#ifdef DEBUG + char errorbuff[2048]; /* FIXME... */ +#endif + int success_wait = NO_SUCCESS_WAIT; + + real_service_name = argv[0]; + if(!pull_service_name()){ + log_error("Could not get Display name of erlang service."); + set_stopped(ERROR_CANTREAD); + return; + } + + SetEnvironmentVariable((LPCTSTR) SERVICE_ENV, (LPCTSTR) service_name); + + strncat(event_name, service_name, MAX_PATH - strlen(event_name)); + event_name[MAX_PATH - 1] = '\0'; + + if(!GetModuleFileName(NULL, executable_name, MAX_PATH)){ + log_error("Unable to retrieve module file name, " EXECUTABLE_ENV + " will not be set."); + } else { + char quoted_exe_name[MAX_PATH+4]; + sprintf(quoted_exe_name, "\"%s\"", executable_name); + SetEnvironmentVariable((LPCTSTR) EXECUTABLE_ENV, + (LPCTSTR) quoted_exe_name); + } + + log_debug("Here we go, service_main_loop..."); + currentState = SERVICE_START_PENDING; + InitializeCriticalSection(&crit); + eventStop = CreateEvent(NULL,FALSE,FALSE,NULL); + if ((eventKillErlang = create_erlang_event(event_name)) != NULL) { + srvi.event_name = event_name; + } else { + srvi.event_name = NULL; + } + statusHandle = RegisterServiceCtrlHandler(real_service_name, &handler); + if(!statusHandle) + return; + set_start_pending(waithint,checkpoint); + keys = get_keys(service_name); + if(!keys){ + log_error("Could not get registry keys for erlang service."); + set_stopped(ERROR_CANTREAD); + return; + } + srvi.keys = keys; + srvi.erl_stdin = NULL; + + ++checkpoint; + if(!start_a_service(&srvi)){ + log_error("Could not start erlang machine"); + set_stopped(ERROR_PROCESS_ABORTED); + if (eventKillErlang != NULL) { + CloseHandle(eventKillErlang); + } + free_keys(keys); + return; + } + set_start_pending(waithint,checkpoint); + set_running(); + success_wait = INITIAL_SUCCESS_WAIT; + harr[0] = srvi.info.hProcess; + harr[1] = eventStop; + for(;;){ + DWORD ret; + ret = WaitForMultipleObjects((DWORD) 2, + harr, + FALSE, + (success_wait == NO_SUCCESS_WAIT) ? + INFINITE : + SUCCESS_WAIT_TIME); + if(ret == WAIT_TIMEOUT){ + /* Just do the "success reporting" and continue */ + if(success_wait == INITIAL_SUCCESS_WAIT){ + log_info("Erlang service started successfully."); + } else { + log_warning("Erlang service restarted"); + } + success_wait = NO_SUCCESS_WAIT; + continue; + } + if(ret == WAIT_FAILED || (int)(ret-WAIT_OBJECT_0) >= 2){ + set_stopped(WAIT_FAILED); + log_error("Internal error, could not wait for objects."); + if (eventKillErlang != NULL) { + CloseHandle(eventKillErlang); + } + free_keys(keys); + return; + } + ret -= WAIT_OBJECT_0; + if(((int) ret) == 1){ + /* Stop service... */ + checkpoint = 2; /* 1 is taken by the handler */ + set_stop_pending(waithint,checkpoint); + if(stop_erlang(&srvi,waithint,&checkpoint)){ + log_debug("Erlang machine is stopped"); + CloseHandle(eventStop); + if (eventKillErlang != NULL) { + CloseHandle(eventKillErlang); + } + set_stopped(NO_ERROR); + if(srvi.erl_stdin) + CloseHandle(srvi.erl_stdin); + free_keys(keys); + return; + } else { + log_warning("Unable to stop erlang service."); + set_running(); + continue; + } + } + /* Reload the registry keys, they may have changed. */ + save_keys = keys; + keys = get_keys(service_name); + if(!keys){ + log_error("Could not reload registry keys."); + keys = srvi.keys = save_keys; + } else { +#ifdef HARDDEBUG + sprintf(errorbuff,"Reloaded the registry keys because %s stopped.", + service_name); + log_debug(errorbuff); +#endif /* HARDDEBUG */ + free_keys(save_keys); + srvi.keys = keys; + } + if(srvi.keys[OnFail].data.value == ON_FAIL_RESTART || + srvi.keys[OnFail].data.value == ON_FAIL_RESTART_ALWAYS){ + if(!GetProcessTimes(srvi.info.hProcess,&creationt, + &exitt,&kernelt,&usert)){ + DWORD rcode = GetLastError(); + log_error("Could not get process time of terminated process."); + CloseHandle(srvi.info.hProcess); + CloseHandle(srvi.info.hThread); + CloseHandle(eventStop); + if(srvi.erl_stdin) + CloseHandle(srvi.erl_stdin); + set_stopped(rcode); + if (eventKillErlang != NULL) { + CloseHandle(eventKillErlang); + } + free_keys(keys); + return; + } + CloseHandle(srvi.info.hProcess); + CloseHandle(srvi.info.hThread); + if(srvi.erl_stdin) + CloseHandle(srvi.erl_stdin); + srvi.erl_stdin = NULL; + memcpy(&creationl,&creationt,sizeof(FILETIME)); + memcpy(&exitl,&exitt,sizeof(FILETIME)); + diffl = exitl - creationl; + diffl /= 10000000; +#ifdef DEBUG + sprintf(errorbuff,"Process lived for %d seconds", (int) diffl); + log_debug(errorbuff); +#endif + + if(diffl > CYCLIC_RESTART_LIMIT || + srvi.keys[OnFail].data.value == ON_FAIL_RESTART_ALWAYS){ + if(!start_a_service(&srvi)){ + log_error("Unable to restart failed erlang service, " + "aborting."); + CloseHandle(eventStop); + set_stopped(ERROR_PROCESS_ABORTED); + if (eventKillErlang != NULL) { + CloseHandle(eventKillErlang); + } + free_keys(keys); + return; + } + log_warning("Restarted erlang machine."); + if(diffl <= CYCLIC_RESTART_LIMIT) + log_warning("Possible cyclic restarting of erlang machine."); + success_wait = RESTART_SUCCESS_WAIT; + harr[0] = srvi.info.hProcess; + } else { + if(success_wait == INITIAL_SUCCESS_WAIT){ + log_error("Erlang machine stopped instantly " + "(distribution name conflict?). " + "The service is not restarted, ignoring OnFail option."); + } else { + log_error("Erlang machine seems to die " + "continously, not restarted."); + } + CloseHandle(eventStop); + set_stopped(ERROR_PROCESS_ABORTED); + if (eventKillErlang != NULL) { + CloseHandle(eventKillErlang); + } + free_keys(keys); + return; + } + } else if(srvi.keys[OnFail].data.value == ON_FAIL_REBOOT){ + log_error("Rebooting because erlang machine stopped."); + enable_privilege(); + if(!InitiateSystemShutdown("",NULL,0,TRUE,TRUE)){ + log_error("Failed to reboot!"); +#ifdef HARDDEBUG + { + char *mes; + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &mes, + 0, + NULL ); + log_debug(mes); + LocalFree(mes); + } +#endif + CloseHandle(srvi.info.hProcess); + CloseHandle(eventStop); + if(srvi.erl_stdin != NULL) + CloseHandle(srvi.erl_stdin); + set_stopped(NO_ERROR); + if (eventKillErlang != NULL) { + CloseHandle(eventKillErlang); + } + free_keys(keys); + return; + } + } else { + DWORD ecode = NO_ERROR; + if(success_wait == NO_SUCCESS_WAIT){ + log_warning("Erlang machine volountarily stopped. " + "The service is not restarted as OnFail " + "is set to ignore."); + } else { + log_error("Erlang machine stopped instantly " + "(distribution name conflict?). " + "The service is not restarted as OnFail is set to ignore."); + ecode = ERROR_PROCESS_ABORTED; + } + CloseHandle(srvi.info.hProcess); + CloseHandle(eventStop); + if(srvi.erl_stdin != NULL) + CloseHandle(srvi.erl_stdin); + set_stopped(ecode); + if (eventKillErlang != NULL) { + CloseHandle(eventKillErlang); + } + free_keys(keys); + return; + } + } +} + +int service_main(int argc, char **argv){ + char dummy_name[] = ""; + SERVICE_TABLE_ENTRY serviceTable[] = + { + { dummy_name, + (LPSERVICE_MAIN_FUNCTION) service_main_loop}, + { NULL, NULL } + }; + BOOL success; + success = + StartServiceCtrlDispatcher(serviceTable); + if (!success) + log_error("Could not initiate service"); + log_debug("service_main done its job"); + return 0; +} + diff --git a/erts/etc/win32/erlsrv/erlsrv_service.h b/erts/etc/win32/erlsrv/erlsrv_service.h new file mode 100644 index 0000000000..3eab275836 --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_service.h @@ -0,0 +1,32 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef _ERLSRV_SERVICE_H +#define _ERLSRV_SERVICE_H + +#define CYCLIC_RESTART_LIMIT 10 /* Seconds */ +#define SUCCESS_WAIT_TIME (10*1000) /* Wait 5 s before reporting a service + as really started */ +#define NO_SUCCESS_WAIT 0 +#define INITIAL_SUCCESS_WAIT 1 +#define RESTART_SUCCESS_WAIT 2 + + +int service_main(int argc, char **argv); + +#endif /* _ERLSRV_SERVICE_H */ diff --git a/erts/etc/win32/erlsrv/erlsrv_util.c b/erts/etc/win32/erlsrv/erlsrv_util.c new file mode 100644 index 0000000000..da3c6f5ef7 --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_util.c @@ -0,0 +1,154 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include +#include +#include +#include +#include +#include "erlsrv_global.h" +#include "erlsrv_util.h" +#include "erlsrv_logmess.h" + +char *service_name = ""; +char *real_service_name = ""; + +void log_warning(char *mess){ + HANDLE logh; + char *strings[] = {service_name, mess , NULL}; + + if(!(logh = RegisterEventSource(NULL,APP_NAME))) + return; + ReportEvent(logh, EVENTLOG_WARNING_TYPE, 0, MSG_WARNING, + NULL, 2, 0, strings, NULL); + DeregisterEventSource(logh); +} + +void log_error(char *mess){ + HANDLE logh; + char *strings[] = {service_name, mess , NULL}; + + if(!(logh = RegisterEventSource(NULL,APP_NAME))) + return; + ReportEvent(logh, EVENTLOG_ERROR_TYPE, 0, MSG_ERROR, + NULL, 2, 0, strings, NULL); + DeregisterEventSource(logh); +} + +void log_info(char *mess){ + HANDLE logh; + char *strings[] = {service_name, mess , NULL}; + + if(!(logh = RegisterEventSource(NULL,APP_NAME))) + return; + ReportEvent(logh, EVENTLOG_INFORMATION_TYPE, 0, MSG_INFO, + NULL, 2, 0, strings, NULL); + DeregisterEventSource(logh); +} + +#ifndef NDEBUG +void log_debug(char *mess){ + char *buff=malloc(strlen(mess)+100); + sprintf(buff,"DEBUG! %s",mess); + log_info(buff); + free(buff); +} +#endif + +char *envdup(char *env){ + char *tmp; + int len; + for(tmp = env; *tmp != '\0'; tmp += strlen(tmp)+1) + ; + len = (tmp - env) + 1; + if(len == 1) + ++len; + tmp = malloc(len); + memcpy(tmp,env,len); + return tmp; +} + +char **env_to_arg(char *env){ + char **ret; + char *tmp; + int i; + int num_strings = 0; + for(tmp = env; *tmp != '\0'; tmp += strlen(tmp)+1) + ++num_strings; + /* malloc enough to insert ONE string */ + ret = malloc(sizeof(char *) * (num_strings + 2)); + i = 0; + for(tmp = env; *tmp != '\0'; tmp += strlen(tmp)+1){ + ret[i++] = strdup(tmp); + } + ret[i] = NULL; + free(env); + return ret; +} + +static int compare(const void *a, const void *b){ + char *s1 = *((char **) a); + char *s2 = *((char **) b); + char *e1 = strchr(s1,'='); + char *e2 = strchr(s2,'='); + int ret; + int len; + + if(!e1) + e1 = s1 + strlen(s1); + if(!e2) + e2 = s2 + strlen(s2); + + if((e1 - s1) > (e2 - s2)) + len = (e2 - s2); + else + len = (e1 - s1); + + ret = _strnicmp(s1,s2,len); + if(ret == 0) + return ((e1 - s1) - (e2 - s2)); + else + return ret; +} + +char *arg_to_env(char **arg){ + char *block; + char *pek; + int i; + int totlen = 1; /* extra '\0' */ + + for(i=0;arg[i] != NULL;++i) + totlen += strlen(arg[i])+1; + /* sort the environment vector */ + qsort(arg,i,sizeof(char *),&compare); + if(totlen == 1){ + block = malloc(2); + block[0] = block[1] = '\0'; + } else { + block = malloc(totlen); + pek = block; + for(i=0; arg[i] != NULL; ++i){ + strcpy(pek, arg[i]); + free(arg[i]); + pek += strlen(pek)+1; + } + *pek = '\0'; + } + free(arg); + return block; +} diff --git a/erts/etc/win32/erlsrv/erlsrv_util.h b/erts/etc/win32/erlsrv/erlsrv_util.h new file mode 100644 index 0000000000..b98a6cd3ef --- /dev/null +++ b/erts/etc/win32/erlsrv/erlsrv_util.h @@ -0,0 +1,50 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#ifndef _ERLSRV_UTIL_H +#define _ERLSRV_UTIL_H + +extern char *service_name; +extern char *real_service_name; +void log_warning(char *mess); +void log_error(char *mess); +void log_info(char *mess); + +char *envdup(char *env); +/* +** Call before env_to_arg to get a 'freeable' environment block. +*/ + +char *arg_to_env(char **arg); +/* +** Frees the argument list before returning! +*/ + +char **env_to_arg(char *env); +/* +** Frees the environment block before returning! +*/ + + +#ifndef NDEBUG +void log_debug(char *mess); +#else +#define log_debug(mess) /* Debug removed */ +#endif + +#endif /* _ERLSRV_UTIL_H */ diff --git a/erts/etc/win32/hrl_icon.ico b/erts/etc/win32/hrl_icon.ico new file mode 100644 index 0000000000..d22abb396b Binary files /dev/null and b/erts/etc/win32/hrl_icon.ico differ diff --git a/erts/etc/win32/init_file.c b/erts/etc/win32/init_file.c new file mode 100644 index 0000000000..52f6c41d1d --- /dev/null +++ b/erts/etc/win32/init_file.c @@ -0,0 +1,565 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include +#include +#include +#include "init_file.h" + +#define ALLOC malloc +#define REALLOC realloc +#define FREE free + +#define CONTEXT_BUFFER_SIZE 1024 + +typedef struct { + HANDLE fd; + int eof; + int num; + int pos; + char buff[CONTEXT_BUFFER_SIZE]; +} FileContext; + +static char *read_one_line(FileContext *fc) +{ + char *buff = ALLOC(10); + int size = 10; + int num = 0; + int skipping; + int escaped; + +#define PUSH(Char) \ + do { \ + if (num == size) { \ + size += 10; \ + buff = REALLOC(buff,size); \ + } \ + buff[num++] = (Char); \ + } while(0) + +#define POP() (buff[--num]) +#define TOP() (buff[(num-1)]) + + skipping = 0; + escaped = 0; + for(;;) { + char current; + if (fc->eof) { + break; + } + if (fc->pos == fc->num) { + if (!ReadFile(fc->fd, fc->buff, CONTEXT_BUFFER_SIZE, + &(fc->num), NULL) || !(fc->num)) { + fc->eof = 1; + break; + } + fc->pos = 0; + } + current = fc->buff[fc->pos]; + ++(fc->pos); + switch (current) { + case ' ': + if (!skipping && num) { + PUSH(current); + } + escaped = 0; + break; + case ';': + if (!skipping) { + if (!escaped) { + skipping = 1; + } else { + PUSH(current); + } + } + escaped = 0; + break; + case '\\': + if (!skipping) { + if (!escaped) { + escaped = 1; + } else { + PUSH(current); + escaped = 0; + } + } + break; + case '\r': + break; + case '\n': + if (!escaped) { + while (num && TOP() == ' ') { + POP(); + } + if (num) { + goto done; + } + } + skipping = 0; + escaped = 0; + break; + default: + if (!skipping) { + PUSH(current); + } + escaped = 0; + break; + } + } + /* EOF comes here */ + while (num && TOP() == ' ') { + POP(); + } + if (!num) { + FREE(buff); + return NULL; + } + done: + PUSH('\0'); + return buff; +#undef PUSH +#undef POP +#undef TOP +} + +static int is_section_header(char *line) +{ + int x = strlen(line); + return (x > 2 && *line == '[' && line[x-1] == ']'); +} + +static int is_key_value(char *line) +{ + char *p = strchr(line,'='); + + return (p != NULL && p > line); +} + +static char *digout_section_name(char *line) + /* Moving it because it shall later be freed. */ +{ + int x = strlen(line); + memmove(line,line+1,x-1); + line[x-2] = '\0'; + return line; +} + +static void digout_key_value(char *line, char **key, char **value) +{ + char *e = strchr(line,'='); + *key = line; + *value = (e+1); + *e = '\0'; + while (*(--e) == ' ') { + *e = '\0'; + } + while (**value == ' ') { + ++(*value); + } +} + +InitFile *load_init_file(char *filename) +{ + HANDLE infile; + InitFile *inif; + InitSection *inis; + InitEntry *inie; + FileContext fc; + char *line; + char **lines; + int size_lines; + int num_lines; + + int i; + + if ( (infile = CreateFile(filename, + GENERIC_READ, + FILE_SHARE_READ, + NULL, + OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, + NULL)) == INVALID_HANDLE_VALUE) { + return NULL; + } + + size_lines = 10; + num_lines = 0; + lines = ALLOC(size_lines * sizeof(char *)); + + fc.fd = infile; + fc.eof = 0; + fc.num = 0; + fc.pos = 0; + while ((line = read_one_line(&fc)) != NULL) { + if (num_lines == size_lines) { + size_lines += 10; + lines = REALLOC(lines,size_lines * sizeof(char *)); + } + lines[num_lines] = line; + ++num_lines; + } + CloseHandle(infile); + /* Now check the lines before doing anything else, so that + we don't need any error handling while creating the data + structures */ + /* + The file should contain: + [section] + Key=Value + ... + [section] + ... + */ + i = 0; + while (i < num_lines && is_section_header(lines[i])) { + ++i; + while (i < num_lines && is_key_value(lines[i])) { + ++i; + } + } + if (i < num_lines) { + for (i = 0; i < num_lines; ++i) { + FREE(lines[i]); + } + FREE(lines); + return NULL; + } + + /* So, now we know it's consistent... */ + i = 0; + inif = ALLOC(sizeof(InitFile)); + inif->num_sections = 0; + inif->size_sections = 10; + inif->sections = ALLOC(sizeof(InitSection *) * 10); + while (i < num_lines) { + inis = ALLOC(sizeof(InitSection)); + inis->num_entries = 0; + inis->size_entries = 10; + inis->section_name = digout_section_name(lines[i]); + inis->entries = ALLOC(sizeof(InitEntry *) * 10); + ++i; + while (i < num_lines && is_key_value(lines[i])) { + inie = ALLOC(sizeof(InitEntry)); + digout_key_value(lines[i], &(inie->key), &(inie->value)); + if (inis->num_entries == inis->size_entries) { + inis->size_entries += 10; + inis->entries = + REALLOC(inis->entries, + sizeof(InitEntry *) * inis->size_entries); + } + inis->entries[inis->num_entries] = inie; + ++(inis->num_entries); + ++i; + } + if (inif->num_sections == inif->size_sections) { + inif->size_sections += 10; + inif->sections = + REALLOC(inif->sections, + sizeof(InitSection *) * inif->size_sections); + } + inif->sections[inif->num_sections] = inis; + ++(inif->num_sections); + } + FREE(lines); /* Only the array of strings, not the actual strings, they + are kept in the data structures. */ + return inif; +} + +int store_init_file(InitFile *inif, char *filename) +{ + char *buff; + int size = 10; + int num = 0; + int i,j; + HANDLE outfile; + +#define PUSH(Char) \ + do { \ + if (num == size) { \ + size += 10; \ + buff = REALLOC(buff,size); \ + } \ + buff[num++] = (Char); \ + } while(0) + + if ( (outfile = CreateFile(filename, + GENERIC_WRITE, + FILE_SHARE_WRITE, + NULL, + CREATE_ALWAYS, + FILE_ATTRIBUTE_NORMAL, + NULL)) == INVALID_HANDLE_VALUE) { + return INIT_FILE_OPEN_ERROR; + } + buff = ALLOC(size); + + for(i = 0; i < inif->num_sections; ++i) { + int len; + int written; + InitSection *inis = inif->sections[i]; + + if (!WriteFile(outfile,"[",1,&written,NULL) || written != 1) { + goto write_error; + } + len = strlen(inis->section_name); + if (!WriteFile(outfile,inis->section_name,len,&written,NULL) || + written != len) { + goto write_error; + } + if (!WriteFile(outfile,"]\n",2,&written,NULL) || written != 2) { + goto write_error; + } + for (j = 0; j < inis->num_entries; ++j) { + InitEntry *inie = inis->entries[j]; + char *p = inie->key; + num = 0; + for (;*p != '\0';++p) { + switch (*p) { + case '\\': + case ';': + PUSH('\\'); + default: + PUSH(*p); + break; + } + } + PUSH('='); + p = inie->value; + for (;*p != '\0';++p) { + switch (*p) { + case '\\': + case ';': + PUSH('\\'); + default: + PUSH(*p); + break; + } + } + PUSH('\n'); + if (!WriteFile(outfile,buff,num,&written,NULL) || written != num) { + goto write_error; + } + } + } + FREE(buff); + CloseHandle(outfile); + return INIT_FILE_NO_ERROR; + write_error: + FREE(buff); + CloseHandle(outfile); + return INIT_FILE_WRITE_ERROR; +#undef PUSH +} + +InitFile *create_init_file(void) +{ + InitFile *inif = ALLOC(sizeof(InitFile)); + inif->num_sections = 0; + inif->size_sections = 10; + inif->sections = ALLOC(sizeof(InitSection *) * 10); + return inif; +} + +InitSection *create_init_section(char *section_name) +{ + InitSection *inis = ALLOC(sizeof(InitSection)); + inis->num_entries = 0; + inis->section_name = ALLOC(sizeof(char) * (strlen(section_name) + 1)); + strcpy(inis->section_name, section_name); + inis->size_entries = 10; + inis->entries = ALLOC(sizeof(InitEntry *) * 10); + return inis; +} + +static void free_init_entry(InitEntry *inie) +{ + FREE(inie->key); + /* Value is part of the same buffer */ + FREE(inie); +} + +void free_init_section(InitSection *inis) +{ + int i; + for (i = 0;i < inis->num_entries; ++i) { + free_init_entry(inis->entries[i]); + } + FREE(inis->entries); + FREE(inis->section_name); + FREE(inis); +} + +void free_init_file(InitFile *inif) +{ + int i; + for (i = 0; i < inif->num_sections; ++i) { + free_init_section(inif->sections[i]); + } + FREE(inif->sections); + FREE(inif); +} + +static int find_init_section(InitFile *inif, char *section_name) +{ + int i; + for (i = 0; i < inif->num_sections; ++i) { + if (!strcmp(inif->sections[i]->section_name, section_name)) { + return i; + } + } + return -1; +} + +int delete_init_section(InitFile *inif, char *section_name) +{ + int i; + + if ((i = find_init_section(inif, section_name)) < 0) { + return INIT_FILE_NOT_PRESENT; + } + + free_init_section(inif->sections[i]); + --(inif->num_sections); + inif->sections[i] = inif->sections[inif->num_sections]; + + return INIT_FILE_PRESENT; +} + +int add_init_section(InitFile *inif, InitSection *inis) +{ + int i; + InitSection *oinis; + if ((i = find_init_section(inif, inis->section_name)) >= 0) { + oinis = inif->sections[i]; + inif->sections[i] = inis; + free_init_section(oinis); + return INIT_FILE_PRESENT; + } + if (inif->num_sections == inif->size_sections) { + inif->size_sections += 10; + inif->sections = REALLOC(inif->sections, + sizeof(InitSection *) * inif->size_sections); + } + inif->sections[inif->num_sections] = inis; + ++(inif->num_sections); + return INIT_FILE_NOT_PRESENT; +} + +InitSection *lookup_init_section(InitFile *inif, char *section_name) +{ + int i; + if ((i = find_init_section(inif,section_name)) < 0) { + return NULL; + } + return inif->sections[i]; +} + +char *nth_init_section_name(InitFile *inif, int n) +{ + if (n >= inif->num_sections) { + return NULL; + } + return inif->sections[n]->section_name; +} + +/* Inefficient... */ +InitSection *copy_init_section(InitSection *inis, char *new_name) +{ + int i; + char *key; + InitSection *ninis = create_init_section(new_name); + i = 0; + while ((key = nth_init_entry_key(inis,i)) != NULL) { + add_init_entry(ninis, key, lookup_init_entry(inis, key)); + ++i; + } + return ninis; +} + +static int find_init_entry(InitSection *inis, char *key) +{ + int i; + for (i = 0; i < inis->num_entries; ++i) { + if (!strcmp(inis->entries[i]->key,key)) { + return i; + } + } + return -1; +} + +int add_init_entry(InitSection *inis, char *key, char *value) +{ + int keylen = strlen(key); + char *buff = ALLOC(sizeof(char) * (keylen + strlen(value) + 2)); + InitEntry *inie; + char *obuff; + int i; + + strcpy(buff,key); + strcpy(buff+keylen+1,value); + + if ((i = find_init_entry(inis,key)) >= 0) { + inie = inis->entries[i]; + FREE(inie->key); + inie->key = buff; + inie->value = buff+keylen+1; + return INIT_FILE_PRESENT; + } + inie = ALLOC(sizeof(InitEntry)); + inie->key = buff; + inie->value = buff+keylen+1; + if (inis->num_entries == inis->size_entries) { + inis->size_entries += 10; + inis->entries = REALLOC(inis->entries, + sizeof(InitEntry *) * inis->size_entries); + } + inis->entries[inis->num_entries] = inie; + ++(inis->num_entries); + return INIT_FILE_NOT_PRESENT; +} + +char *lookup_init_entry(InitSection *inis, char *key) +{ + int i; + if ((i = find_init_entry(inis,key)) < 0) { + return NULL; + } + return inis->entries[i]->value; +} + +char *nth_init_entry_key(InitSection *inis, int n) +{ + if (n >= inis->num_entries) { + return NULL; + } + return inis->entries[n]->key; +} + +int delete_init_entry(InitSection *inis, char *key) +{ + int i; + InitEntry *inie; + if ((i = find_init_entry(inis, key)) < 0) { + return INIT_FILE_NOT_PRESENT; + } + free_init_entry(inis->entries[i]); + --(inis->num_entries); + inis->entries[i] = inis->entries[inis->num_entries]; + return INIT_FILE_PRESENT; +} + diff --git a/erts/etc/win32/init_file.h b/erts/etc/win32/init_file.h new file mode 100644 index 0000000000..48d2d2df62 --- /dev/null +++ b/erts/etc/win32/init_file.h @@ -0,0 +1,93 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2003-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +typedef struct { + char *key; + char *value; /* Key and value points into same buffer */ +} InitEntry; + +typedef struct { + int num_entries; + int size_entries; + char *section_name; + InitEntry **entries; +} InitSection; + +typedef struct { + int num_sections; + int size_sections; + InitSection **sections; +} InitFile; + +/* Load a file structure from a disk file */ +InitFile *load_init_file(char *filename); + +/* Stores a file structure into a disk file */ +int store_init_file(InitFile *inif, char *filename); + +/* Create an empty file structure */ +InitFile *create_init_file(void); + +/* Free a file structure and everything associateed (including sections,keys + and values and anything looked up but not copied) */ +void free_init_file(InitFile *inif); + +/* Create empty section */ +InitSection *create_init_section(char *section_name); + +/* Add section to file Overwrites and destroys old sections with same key */ +int add_init_section(InitFile *inif, InitSection *inis); + +/* Kills a named section from a file. Destroys so that previously looked up + sections (with this key) need to be copied before the delete */ +int delete_init_section(InitFile *inif, char *section_name); + +/* lookup returns pointer into existing data. If data is to be preserved + across deletes or overwrites, it has to be copied */ +InitSection *lookup_init_section(InitFile *inif, char *section_name); + +/* Returns the name of the nth init section, n is >= 0, ret NULL when done */ +char *nth_init_section_name(InitFile *inif, int n); + +/* To save an init section so that delete or overwrite does not destroy it, + one needs to copy it */ +InitSection *copy_init_section(InitSection *inis, char *new_name); + +/* Frees up everything in the section, keys and values as well. */ +void free_init_section(InitSection *inis); + +/* Key and value are copied in add_entry */ +int add_init_entry(InitSection *inis, char *key, char *value); + +/* Returns pointer into internal string, use strcpy to save across + updates/deletes */ +char *lookup_init_entry(InitSection *inis, char *key); + +/* Returns the name of the nth entry key, n is >= 0, ret NULL when done */ +char *nth_init_entry_key(InitSection *inis, int n); + +/* Destroys entry, prevoiusly looked up entries need be + copied before deleted */ +int delete_init_entry(InitSection *inis, char *key); + +#define INIT_FILE_NO_ERROR 0 +#define INIT_FILE_OPEN_ERROR -1 +#define INIT_FILE_WRITE_ERROR -2 +#define INIT_FILE_PRESENT 0 +#define INIT_FILE_NOT_PRESENT 1 diff --git a/erts/etc/win32/nsis/Makefile b/erts/etc/win32/nsis/Makefile new file mode 100644 index 0000000000..ebb3ad9a96 --- /dev/null +++ b/erts/etc/win32/nsis/Makefile @@ -0,0 +1,88 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2003-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk +include $(ERL_TOP)/erts/vsn.mk + +VERSION_HEADER = erlang.nsh +MAKENSIS = makensis +MAKENSISFLAGS = /V2 +CUSTOM_MODERN=custom_modern.exe + +# This is not the way we usually do in our makefiles, +# but making release is the ONLY thing we do with this one, +# Its not called during ordinary recursive make. +all: release + +opt debug depend: + @echo Nothing to do for "'"$@"'" on $(TARGET) + +clean: + rm -f $(VERSION_HEADER) + +include $(ERL_TOP)/make/otp_release_targets.mk + +TARGET_DIR = $(RELEASE_PATH) +WTESTROOT=$(shell (cygpath -d $(RELEASE_PATH) 2>/dev/null || cygpath -w $(RELEASE_PATH))) +WTARGET_DIR=$(shell (cygpath -d $(TARGET_DIR) 2>/dev/null || cygpath -d $(TARGET_DIR))) + +REDIST_FILE=$(shell (sh ./find_redist.sh || echo "")) +REDIST_DLL_VERSION=$(shell (sh ./dll_version_helper.sh || echo "")) + +release_spec: + @NSIS_VER=`makensis /hdrinfo | head -1 | awk '{print $$2}'`; \ + case $$NSIS_VER in \ + v2.0b*) \ + echo '!define MUI_VERSION "$(SYSTEM_VSN)"' > $(VERSION_HEADER);\ + echo '!define ERTS_VERSION "$(VSN)"' >> $(VERSION_HEADER);\ + echo '!define TESTROOT "$(WTESTROOT)"' >> $(VERSION_HEADER);\ + echo '!define OUTFILEDIR "$(WTARGET_DIR)"' >> $(VERSION_HEADER);\ + if [ -f $(RELEASE_PATH)/docs/doc/index.html ];\ + then\ + echo '!define HAVE_DOCS 1' >> $(VERSION_HEADER); \ + fi;\ + $(MAKENSIS) erlang.nsi;;\ + v2.*) \ + echo '!define OTP_VERSION "$(SYSTEM_VSN)"' > $(VERSION_HEADER);\ + echo '!define ERTS_VERSION "$(VSN)"' >> $(VERSION_HEADER);\ + echo '!define TESTROOT "$(WTESTROOT)"' >> $(VERSION_HEADER);\ + echo '!define OUTFILEDIR "$(WTARGET_DIR)"' >> $(VERSION_HEADER);\ + if [ -f $(CUSTOM_MODERN) ];\ + then \ + echo '!define HAVE_CUSTOM_MODERN 1' >> $(VERSION_HEADER); \ + fi;\ + if [ '!' -z "$(REDIST_FILE)" -a '!' -z "$(REDIST_DLL_VERSION)" ];\ + then \ + cp $(REDIST_FILE) $(RELEASE_PATH)/vcredist_x86.exe;\ + echo '!define HAVE_REDIST_FILE 1' >> $(VERSION_HEADER); \ + echo '!define REDIST_DLL_VERSION "$(REDIST_DLL_VERSION)"' >> $(VERSION_HEADER);\ + fi;\ + if [ -f $(RELEASE_PATH)/docs/doc/index.html ];\ + then \ + echo '!define HAVE_DOCS 1' >> $(VERSION_HEADER); \ + fi;\ + echo "Running $(MAKENSIS) $(MAKENSISFLAGS) erlang20.nsi";\ + $(MAKENSIS) $(MAKENSISFLAGS) erlang20.nsi;;\ + *) \ + echo 'Unsupported NSIS version';;\ + esac + +release_docs release_docs_spec docs: + diff --git a/erts/etc/win32/nsis/custom_modern.exe b/erts/etc/win32/nsis/custom_modern.exe new file mode 100755 index 0000000000..0f56b8b239 Binary files /dev/null and b/erts/etc/win32/nsis/custom_modern.exe differ diff --git a/erts/etc/win32/nsis/dll_version_helper.sh b/erts/etc/win32/nsis/dll_version_helper.sh new file mode 100755 index 0000000000..e0047dea8b --- /dev/null +++ b/erts/etc/win32/nsis/dll_version_helper.sh @@ -0,0 +1,49 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2007-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# This little helper digs out the current version of microsoft CRT +# by compiling hello world and "parsing" the manifest file... + +# To debug using a fake version: + +# echo "8.0.50727.763" +# exit 0 + +cat > hello.c < + +int main(void) +{ + printf("Hello world\n"); + return 0; +} + +EOF +cl /MD hello.c > /dev/null 2>&1 +if [ '!' -f hello.exe.manifest ]; then + echo "This compiler does not generate manifest files - OK if using mingw" >&2 + exit 0 +fi +VERSION=`grep '> 16 + Goto continue0 + negative0: + IntOp $R2 $R0 & 0x7FFF0000 + IntOp $R2 $R2 >> 16 + IntOp $R2 $R2 | 0x8000 + continue0: + IntOp $R3 $R0 & 0x0000FFFF + IntCmp 0 $R1 normal1 normal1 negative1 + normal1: + IntOp $R4 $R1 >> 16 + Goto continue1 + negative1: + IntOp $R4 $R1 & 0x7FFF0000 + IntOp $R4 $R4 >> 16 + IntOp $R4 $R4 | 0x8000 + continue1: + IntOp $R5 $R1 & 0x0000FFFF + StrCpy $2 "$R2.$R3.$R4.$R5" + ${VersionCompare} $2 ${REDIST_DLL_VERSION} $R0 + Return +FunctionEnd + +Function .onInit + SectionGetFlags 0 $MYTEMP +; MessageBox MB_YESNO "Found $SYSDIR\msvcr80.dll" IDYES FoundLbl + IfFileExists $SYSDIR\msvcr80.dll MaybeFoundInSystemLbl + SearchSxsLbl: + FindFirst $0 $1 $WINDIR\WinSxS\x86* + LoopLbl: + StrCmp $1 "" NotFoundLbl + IfFileExists $WINDIR\WinSxS\$1\msvcr80.dll MaybeFoundInSxsLbl + FindNext $0 $1 + Goto LoopLbl + MaybeFoundInSxsLbl: + GetDllVersion $WINDIR\WinSxS\$1\msvcr80.dll $R0 $R1 + Call DllVersionGoodEnough + FindNext $0 $1 + IntCmp 2 $R0 LoopLbl + Goto FoundLbl + MaybeFoundInSystemLbl: + GetDllVersion $SYSDIR\msvcr80.dll $R0 $R1 + Call DllVersionGoodEnough + IntCmp 2 $R0 SearchSxSLbl + FoundLbl: + IntOp $MYTEMP $MYTEMP & 4294967294 + SectionSetFlags 0 $MYTEMP + SectionSetText 0 "Microsoft DLL's (present)" + Return + NotFoundLbl: + IntOp $MYTEMP $MYTEMP | 16 + SectionSetFlags 0 $MYTEMP + SectionSetText 0 "Microsoft DLL's (needed)" + Return +FunctionEnd +!endif + + +;Display the Finish header +;Insert this macro after the sections if you are not using a finish page +; !insertmacro MUI_SECTIONS_FINISHHEADER + +;-------------------------------- +;Descriptions + + !insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN + !insertmacro MUI_DESCRIPTION_TEXT ${SecErlang} $(DESC_SecErlang) + !insertmacro MUI_DESCRIPTION_TEXT ${SecErlangDev} $(DESC_SecErlangDev) + !insertmacro MUI_DESCRIPTION_TEXT ${SecErlangAssoc} \ + $(DESC_SecErlangAssoc) +!ifdef HAVE_DOCS + !insertmacro MUI_DESCRIPTION_TEXT ${SecErlangDoc} $(DESC_SecErlangDoc) +!endif +!ifdef HAVE_REDIST_FILE + !insertmacro MUI_DESCRIPTION_TEXT ${SecMSRedist} $(DESC_SecMSRedist) +!endif + !insertmacro MUI_FUNCTION_DESCRIPTION_END + +;-------------------------------- +;Uninstaller Section + +Section "Uninstall" + + RMDir /r "$INSTDIR" + +;Remove shortcut + ReadRegStr $MYTEMP "${MY_STARTMENUPAGE_REGISTRY_ROOT}" \ + "${MY_STARTMENUPAGE_REGISTRY_KEY}" \ + "${MY_STARTMENUPAGE_REGISTRY_VALUENAME}" + StrCmp $MYTEMP "" 0 end_try +; Try HKCU instead... + ReadRegStr $MYTEMP "${MY_STARTMENUPAGE_REGISTRY_ROOT}" \ + "${MY_STARTMENUPAGE_REGISTRY_KEY}" \ + "${MY_STARTMENUPAGE_REGISTRY_VALUENAME}" +; If this failed to, we have no shortcuts (eh?) + StrCmp $MYTEMP "" noshortcuts +end_try: + SetShellVarContext All + ClearErrors +; If we cannot find the shortcut, switch to current user context + GetFileTime "$SMPROGRAMS\$MYTEMP\Erlang.lnk" $R1 $R2 + IfErrors 0 continue_delete + ;MessageBox MB_OK "Error removing file" + SetShellVarContext current +continue_delete: + Delete "$SMPROGRAMS\$MYTEMP\Erlang.lnk" + Delete "$SMPROGRAMS\$MYTEMP\Uninstall.lnk" + Delete "$SMPROGRAMS\$MYTEMP\Erlang Documentation.lnk" + RMDir "$SMPROGRAMS\$MYTEMP" ;Only if empty + +noshortcuts: +; We delete both in HKCU and HKLM, we don't really know were they might be... + DeleteRegKey /ifempty HKLM "SOFTWARE\Ericsson\Erlang\${ERTS_VERSION}" + DeleteRegKey /ifempty HKCU "SOFTWARE\Ericsson\Erlang\${ERTS_VERSION}" + DeleteRegKey HKLM \ + "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" + DeleteRegKey HKCU \ + "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\Erlang OTP ${OTP_VERSION} (${ERTS_VERSION})" + + +; Now remove shell/file associations we'we made... +; .erl + ReadRegStr $1 HKCR ".erl" "" + StrCmp $1 "ErlangSource" 0 NoOwnSource + ReadRegStr $1 HKCR "ErlangSource\DefaultIcon" "" + StrCmp $1 "$INSTDIR\usr\lib\icons\erl_icon.ico" 0 NoOwnSource + DeleteRegKey HKCR ".erl" + DeleteRegKey HKCR "ErlangSource" +NoOwnSource: +; .hrl + ReadRegStr $1 HKCR ".hrl" "" + StrCmp $1 "ErlangHeader" 0 NoOwnHeader + ReadRegStr $1 HKCR "ErlangHeader\DefaultIcon" "" + StrCmp $1 "$INSTDIR\usr\lib\icons\hrl_icon.ico" 0 NoOwnHeader + DeleteRegKey HKCR ".hrl" + DeleteRegKey HKCR "ErlangHeader" +NoOwnHeader: + +; .beam + ReadRegStr $1 HKCR ".beam" "" + StrCmp $1 "ErlangBeam" 0 NoOwnBeam + ReadRegStr $1 HKCR "ErlangBeam\DefaultIcon" "" + StrCmp $1 "$INSTDIR\usr\lib\icons\beam_icon.ico" 0 NoOwnBeam + DeleteRegKey HKCR ".beam" + DeleteRegKey HKCR "ErlangBeam" +NoOwnBeam: + +;Display the Finish header +; !insertmacro MUI_UNFINISHHEADER + +SectionEnd + !verbose 3 diff --git a/erts/etc/win32/nsis/erlang_inst.ico b/erts/etc/win32/nsis/erlang_inst.ico new file mode 100644 index 0000000000..edbd8a6f2c Binary files /dev/null and b/erts/etc/win32/nsis/erlang_inst.ico differ diff --git a/erts/etc/win32/nsis/erlang_uninst.ico b/erts/etc/win32/nsis/erlang_uninst.ico new file mode 100755 index 0000000000..edbd8a6f2c Binary files /dev/null and b/erts/etc/win32/nsis/erlang_uninst.ico differ diff --git a/erts/etc/win32/nsis/find_redist.sh b/erts/etc/win32/nsis/find_redist.sh new file mode 100755 index 0000000000..c5572839c5 --- /dev/null +++ b/erts/etc/win32/nsis/find_redist.sh @@ -0,0 +1,122 @@ +#! /bin/sh +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2007-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# first find some tool we know exists, i.e. cl.exe +lookup_prog_in_path () +{ + PROG=$1 + save_ifs=$IFS + IFS=: + for p in $PATH; do + # In cygwin the programs are not always executable and have .exe suffix... + if [ "X$TARGET" = "Xwin32" ]; then + if [ -f $p/$PROG.exe ]; then + echo $p/$PROG + break; + fi + else + if [ -x $p/$PROG ]; then + echo $p/$PROG + break; + fi + fi + done + IFS=$save_ifs +} + +remove_path_element() +{ + EL=$1 + PA=$2 + ACC="" + save_ifs=$IFS + IFS=/ + set $PA + N=$# + while [ $N -gt 1 ]; do + if [ '!' -z "$1" ]; then + ACC="${ACC}/$1" + fi + N=`expr $N - 1` + shift + done + UP=`echo $1 | tr [:lower:] [:upper:]` + ELUP=`echo $EL | tr [:lower:] [:upper:]` + IFS=$save_ifs + if [ "$UP" = "$ELUP" ]; then + echo "$ACC" + else + echo "${ACC}/$1" + fi + + #echo "ACC=$ACC" >&2 + #echo "1=$1" >&2 +} + +add_path_element() +{ + EL=$1 + PA=$2 + + ELUP=`echo $EL | tr [:lower:] [:upper:]` + #echo "PA=$PA" >&2 + for x in ${PA}/*; do + #echo "X=$x" >&2 + UP=`basename "$x" | tr [:lower:] [:upper:]` + #echo "UP=$UP" >&2 + if [ "$UP" = "$ELUP" ]; then + echo "$x" + return 0; + fi + done + echo "$PA" +} + +CLPATH=`lookup_prog_in_path cl` + +if [ -z "$CLPATH" ]; then + echo "Can not locate cl.exe and vcredist_x86.exe - OK if using mingw" >&2 + exit 1 +fi + +#echo $CLPATH +BPATH=$CLPATH +for x in cl bin vc; do + #echo $x + NBPATH=`remove_path_element $x "$BPATH"` + if [ "$NBPATH" = "$BPATH" ]; then + echo "Failed to locate vcredist_x86.exe because cl.exe was in an unexpected location" >&2 + exit 2 + fi + BPATH="$NBPATH" +done +#echo $BPATH +for x in sdk v2.0 bootstrapper packages vcredist_x86 vcredist_x86.exe; do + #echo "x=$x" + #echo "BPATH=$BPATH" + NBPATH=`add_path_element $x "$BPATH"` + if [ "$NBPATH" = "$BPATH" ]; then + echo "Failed to locate vcredist_x86.exe because directory structure was unexpected" >&2 + exit 3 + fi + BPATH="$NBPATH" +done +echo $BPATH +exit 0 \ No newline at end of file diff --git a/erts/etc/win32/port_entry.c b/erts/etc/win32/port_entry.c new file mode 100644 index 0000000000..49b5ad2f34 --- /dev/null +++ b/erts/etc/win32/port_entry.c @@ -0,0 +1,75 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* +** This is an entry point for port programs, +** it is used to set the console control handler of the process when +** erlang process is run as a service. +** Note that this entry point is only for +** Console programs, Windowing programs can just route the WM_QUERYENDSESSION +** and WM_ENDSESSION to the default window procedure to aquire the same +** functionality. +** +** Creator Patrik Nyblom +** +** Notes: +** You would really not want to use ANY of the standard library in this +** routine, the standard library is not yet initiated... +*/ +#include + +/* +** The runtime libraries startup routine in the Microsoft Visual C CRT +*/ +extern void mainCRTStartup(void); + +/* +** A Console control handler that ignores the logoff events, +** and lets the default handler take care of other events. +*/ +BOOL WINAPI erl_port_default_handler(DWORD ctrl){ + if(ctrl == CTRL_LOGOFF_EVENT) + return TRUE; + return FALSE; +} + +/* +** This is the entry point, it takes no parameters and never returns. +*/ +void erl_port_entry(void){ + char buffer[2]; + /* + * We assume we're running as a service if this environment variable + * is defined + */ + if(GetEnvironmentVariable("ERLSRV_SERVICE_NAME",buffer,(DWORD) 2)){ +#ifdef HARDDEBUG + DWORD dummy; + WriteFile(GetStdHandle(STD_OUTPUT_HANDLE), + "Setting handler\r\n",17,&dummy, NULL); +#endif /* HARDDEBUG */ + /* + ** Actually set the control handler + */ + SetConsoleCtrlHandler(&erl_port_default_handler, TRUE); + } + /* + ** Call the CRT's real startup routine. + */ + mainCRTStartup(); +} diff --git a/erts/etc/win32/resource.h b/erts/etc/win32/resource.h new file mode 100644 index 0000000000..697931952a --- /dev/null +++ b/erts/etc/win32/resource.h @@ -0,0 +1,33 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#define IDR_CONMENU 101 +#define IDMENU_STARTLOG 40001 +#define IDMENU_STOPLOG 40002 +#define IDMENU_EXIT 40003 +#define IDMENU_COPY 40004 +#define IDMENU_PASTE 40005 +#define IDMENU_FONT 40006 +#define IDMENU_TOOLBAR 40007 +#define IDMENU_ABOUT 40008 +#define IDMENU_SELALL 40009 +#define IDMENU_SELECTBKG 40010 +#define ID_BREAK 40011 +#define ID_VERSIONSTRING 40000 +#define ID_COMBOBOX 3 + diff --git a/erts/etc/win32/start_erl.c b/erts/etc/win32/start_erl.c new file mode 100644 index 0000000000..dcf8c8b281 --- /dev/null +++ b/erts/etc/win32/start_erl.c @@ -0,0 +1,677 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * start_erl.c - Windows NT start_erl + * + * Author: Mattias Nilsson + */ + +#define WIN32_LEAN_AND_MEAN +#define STRICT +#include +#include +#include +#include +#include + +char *progname; + +/* + * If CASE_SENSITIVE_OPTIONS is specified, options are case sensitive + * (lower case). + * The reason for this switch is that _strnicmp is Microsoft specific. + */ +#ifndef CASE_SENSITIVE_OPTIONS +#define strnicmp strncmp +#else +#define strnicmp _strnicmp +#endif + +#define RELEASE_SUBDIR "\\releases" +#define REGISTRY_BASE "Software\\Ericsson\\Erlang\\" +#define DEFAULT_DATAFILE "start_erl.data" + +/* Global variables holding option values and command lines */ +char *CommandLineStart = NULL; +char *ErlCommandLine = NULL; +char *MyCommandLine = NULL; +char *DataFileName = NULL; +char *RelDir = NULL; +char *BootFlagsFile = NULL; +char *BootFlags = NULL; +char *RegistryKey = NULL; +char *BinDir = NULL; +char *RootDir = NULL; +char *VsnDir = NULL; +char *Version = NULL; +char *Release = NULL; +BOOL NoConfig=FALSE; +PROCESS_INFORMATION ErlProcessInfo; + +/* + * Error reason printout 'the microsoft way' + */ +void ShowLastError(void) +{ + LPVOID lpMsgBuf; + DWORD dwErr; + + dwErr = GetLastError(); + if( dwErr == ERROR_SUCCESS ) + return; + + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + dwErr, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &lpMsgBuf, + 0, + NULL + ); + fprintf(stderr, lpMsgBuf); + LocalFree( lpMsgBuf ); +} + +/* + * Exit the program and give a nice and firm explanation of why + * and how you can avoid it. + */ +void exit_help(char *err) +{ + ShowLastError(); + fprintf(stderr, "** Error: %s\n", err); + + printf("Usage:\n%s\n" + " [] ++\n" + " [-data ]\n" + " [-reldir ]\n" + " [-bootflags ]\n" + " [-noconfig]\n", progname); + + exit(0); +} + + +/* + * Splits the command line into two strings: + * 1. Options to the Erlang node (ErlCommandLine) + * 2. Options to this program (MyCommandLine) + */ +void split_commandline(void) +{ + char *cmdline = CommandLineStart; + + progname=cmdline; + + /* Remove the first (quoted) string (our program name) */ + if(*cmdline == '"') { + cmdline++; /* Skip " */ + while( (*cmdline != '\0') && (*cmdline++) != '"' ) + ; + } else { + while( (*cmdline != '\0') && (*cmdline++) != ' ' ) + ; + } + + while( (*cmdline) == ' ' ) + cmdline++; + + if( *cmdline == '\0') { + ErlCommandLine = ""; + MyCommandLine = ""; + return; + } + + cmdline[-1] = '\0'; + + /* Start from the end of the string and search for "++ " + (PLUS PLUS SPACE) */ + ErlCommandLine = cmdline; + if(strncmp(cmdline,"++ ",3)) + cmdline = strstr(cmdline," ++ "); + if( cmdline == NULL ) { + MyCommandLine = ""; + return; + } + /* Terminate the ErlCommandLine where MyCommandLine starts */ + *cmdline++ = '\0'; + + /* Skip 'whitespace--whitespace' (WHITESPACE MINUS MINUS WHITESPACE) */ + while( (*cmdline) == ' ' ) + cmdline++; + while( (*cmdline) == '+' ) + cmdline++; + while( (*cmdline) == ' ' ) + cmdline++; + + MyCommandLine = cmdline; + +#ifdef _DEBUG + fprintf(stderr, "ErlCommandLine: '%s'\n", ErlCommandLine); + fprintf(stderr, "MyCommandLine: '%s'\n", MyCommandLine); +#endif +} + + +/* + * 'Smart' unquoting of a string: \" becomes " and " becomes (nothing) + * Skips any leading spaces and parses up to NULL or end of quoted string. + * Calls exit_help() if an unterminated quote is detected. + */ +char * unquote_optionarg(char *str, char **strp) +{ + char *newstr = (char *)malloc(strlen(str)+1); /* This one is realloc:ed later */ + int i=0, inquote=0; + + assert(newstr); + assert(str); + + /* Skip leading spaces */ + while( *str == ' ' ) + str++; + + /* Loop while in quote or until EOS or unquoted space + */ + while( (inquote==1) || ( (*str!=0) && (*str!=' ') ) ) { + switch( *str ) { + case '\\': + /* If we are inside a quoted string we should convert \c to c */ + if( inquote && str[1] == '"' ) + str++; + newstr[i++]=*str++; + break; + case '"': + inquote = 1-inquote; + *str++; + break; + default: + newstr[i++]=*str++; + break; + } + + if( (*str == 0) && (inquote==1) ) { + exit_help("Unterminated quote."); + } + } + newstr[i++] = 0x00; + + /* Update the supplied pointer (used for continued parsing of options) */ + *strp = str; + + /* Adjust memblock of newstr */ + newstr = (char *)realloc(newstr, i); + assert(newstr); + return(newstr); +} + + +/* + * Parses MyCommandLine and tries to fill in all the required option variables + * (one way or another). + */ +void parse_commandline(void) +{ + char *cmdline = MyCommandLine; + + while( *cmdline != '\0' ) { + switch( *cmdline ) { + case '-': /* Handle both -arg and /arg */ + case '/': + *cmdline++; + if( strnicmp(cmdline, "data", 4) == 0) { + DataFileName = unquote_optionarg(cmdline+4, &cmdline); + } else if( strnicmp(cmdline, "reldir", 6) == 0) { + RelDir = unquote_optionarg(cmdline+6, &cmdline); +#ifdef _DEBUG + fprintf(stderr, "RelDir: '%s'\n", RelDir); +#endif + } else if( strnicmp(cmdline, "bootflags", 9) == 0) { + BootFlagsFile = unquote_optionarg(cmdline+9, &cmdline); + } else if( strnicmp(cmdline, "noconfig", 8) == 0) { + NoConfig=TRUE; +#ifdef _DEBUG + fprintf(stderr, "NoConfig=TRUE\n"); +#endif + } else { + fprintf(stderr, "Unkown option: '%s'\n", cmdline); + exit_help("Unknown command line option"); + } + break; + default: + cmdline++; + break; + } + } +} + + +/* + * Read the data file specified and get the version and release number + * from it. + * + * This function also construct the correct RegistryKey from the version information + * retrieved. + */ +void read_datafile(void) +{ + FILE *fp; + char *newname; + long size; + + if(!DataFileName){ + DataFileName = malloc(strlen(DEFAULT_DATAFILE) + 1); + strcpy(DataFileName,DEFAULT_DATAFILE); + } + /* Is DataFileName relative or absolute ? */ + if( (DataFileName[0] != '\\') && (strncmp(DataFileName+1, ":\\", 2)!=0) ) { + /* Relative name, we have to prepend RelDir to it. */ + if( !RelDir ) { + exit_help("Need -reldir when -data filename has relative path."); + } else { + newname = (char *)malloc(strlen(DataFileName)+strlen(RelDir)+2); + assert(newname); + sprintf(newname, "%s\\%s", RelDir, DataFileName); + free(DataFileName); + DataFileName=newname; + } + } + +#ifdef _DEBUG + fprintf(stderr, "DataFileName: '%s'\n", DataFileName); +#endif + + if( (fp=fopen(DataFileName, "rb")) == NULL) { + exit_help("Cannot find the datafile."); + } + + fseek(fp, 0, SEEK_END); + size=ftell(fp); + fseek(fp, 0, SEEK_SET); + + Version = (char *)malloc(size+1); + Release = (char *)malloc(size+1); + assert(Version); + assert(Release); + + if( (fscanf(fp, "%s %s", Version, Release)) == 0) { + fclose(fp); + exit_help("Format error in datafile."); + } + + fclose(fp); + +#ifdef _DEBUG + fprintf(stderr, "DataFile version: '%s'\n", Version); + fprintf(stderr, "DataFile release: '%s'\n", Release); +#endif +} + + +/* + * Read the registry keys we need + */ +void read_registry_keys(void) +{ + HKEY hReg; + ULONG lLen; + + /* Create the RegistryKey name */ + RegistryKey = (char *) malloc(strlen(REGISTRY_BASE) + + strlen(Version) + 1); + assert(RegistryKey); + sprintf(RegistryKey, REGISTRY_BASE "%s", Version); + + /* We always need to find BinDir */ + if( (RegOpenKeyEx(HKEY_LOCAL_MACHINE, + RegistryKey, + 0, + KEY_READ, + &hReg)) != ERROR_SUCCESS ) { + exit_help("Could not open registry key."); + } + + /* First query size of data */ + if( (RegQueryValueEx(hReg, + "Bindir", + NULL, + NULL, + NULL, + &lLen)) != ERROR_SUCCESS) { + exit_help("Failed to query BinDir of release.\n"); + } + + /* Allocate enough space */ + BinDir = (char *)malloc(lLen+1); + assert(BinDir); + /* Retrieve the value */ + if( (RegQueryValueEx(hReg, + "Bindir", + NULL, + NULL, + (unsigned char *) BinDir, + &lLen)) != ERROR_SUCCESS) { + exit_help("Failed to query BinDir of release (2).\n"); + } + +#ifdef _DEBUG + fprintf(stderr, "Bindir: '%s'\n", BinDir); +#endif + + /* We also need the rootdir, in case we need to build RelDir later */ + + /* First query size of data */ + if( (RegQueryValueEx(hReg, + "Rootdir", + NULL, + NULL, + NULL, + &lLen)) != ERROR_SUCCESS) { + exit_help("Failed to query RootDir of release.\n"); + } + + /* Allocate enough space */ + RootDir = (char *) malloc(lLen+1); + assert(RootDir); + /* Retrieve the value */ + if( (RegQueryValueEx(hReg, + "Rootdir", + NULL, + NULL, + (unsigned char *) RootDir, + &lLen)) != ERROR_SUCCESS) { + exit_help("Failed to query RootDir of release (2).\n"); + } + +#ifdef _DEBUG + fprintf(stderr, "Rootdir: '%s'\n", RootDir); +#endif + + RegCloseKey(hReg); +} + +/* + * Read the bootflags. This file contains extra command line options to erl.exe + */ +void read_bootflags(void) +{ + FILE *fp; + long fsize; + char *newname; + + if(BootFlagsFile) { + /* Is BootFlagsFile relative or absolute ? */ + if( (BootFlagsFile[0] != '\\') && + (strncmp(BootFlagsFile+1, ":\\", 2)!=0) ) { + /* Relative name, we have to prepend RelDir\\Version to it. */ + if( !RelDir ) { + exit_help("Need -reldir when -bootflags " + "filename has relative path."); + } else { + newname = (char *)malloc(strlen(BootFlagsFile)+strlen(RelDir)+strlen(Release)+3); + assert(newname); + sprintf(newname, "%s\\%s\\%s", RelDir, Release, BootFlagsFile); + free(BootFlagsFile); + BootFlagsFile=newname; + } + } + +#ifdef _DEBUG + fprintf(stderr, "BootFlagsFile: '%s'\n", BootFlagsFile); +#endif + + + + if( (fp=fopen(BootFlagsFile, "rb")) == NULL) { + exit_help("Could not open BootFlags file."); + } + + fseek(fp, 0, SEEK_END); + fsize=ftell(fp); + fseek(fp, 0, SEEK_SET); + + BootFlags = (char *)malloc(fsize+1); + assert(BootFlags); + if( (fgets(BootFlags, fsize+1, fp)) == NULL) { + exit_help("Error while reading BootFlags file"); + } + fclose(fp); + + /* Adjust buffer size */ + BootFlags = (char *)realloc(BootFlags, strlen(BootFlags)+1); + assert(BootFlags); + + /* Strip \r\n from BootFlags */ + fsize = strlen(BootFlags); + while( fsize > 0 && + ( (BootFlags[fsize-1] == '\r') || + (BootFlags[fsize-1] == '\n') ) ) { + BootFlags[--fsize]=0; + } + + } else { + /* Set empty BootFlags */ + BootFlags = ""; + } + +#ifdef _DEBUG + fprintf(stderr, "BootFlags: '%s'\n", BootFlags); +#endif +} + + +long start_new_node(void) +{ + char *CommandLine; + unsigned long i; + STARTUPINFO si; + DWORD dwExitCode; + + i = strlen(RelDir) + strlen(Release) + 4; + VsnDir = (char *)malloc(i); + assert(VsnDir); + sprintf(VsnDir, "%s\\%s", RelDir, Release); + + if( NoConfig ) { + i = strlen(BinDir) + strlen(ErlCommandLine) + + strlen(BootFlags) + 64; + CommandLine = (char *)malloc(i); + assert(CommandLine); + sprintf(CommandLine, + "\"%s\\erl.exe\" -boot \"%s\\start\" %s %s", + BinDir, + VsnDir, + ErlCommandLine, + BootFlags); + } else { + i = strlen(BinDir) + strlen(ErlCommandLine) + + strlen(BootFlags) + strlen(VsnDir)*2 + 64; + CommandLine = (char *)malloc(i); + assert(CommandLine); + sprintf(CommandLine, + "\"%s\\erl.exe\" -boot \"%s\\start\" -config \"%s\\sys\" %s %s", + BinDir, + VsnDir, + VsnDir, + ErlCommandLine, + BootFlags); + } + +#ifdef _DEBUG + fprintf(stderr, "CommandLine: '%s'\n", CommandLine); +#endif + + /* Initialize the STARTUPINFO structure. */ + memset(&si, 0, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + si.lpTitle = NULL; + si.dwFlags = STARTF_USESTDHANDLES; + si.hStdInput = GetStdHandle(STD_INPUT_HANDLE); + si.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE); + si.hStdError = GetStdHandle(STD_ERROR_HANDLE); + + /* Create the new Erlang process */ + if( (CreateProcess( + NULL, /* pointer to name of executable module */ + CommandLine, /* pointer to command line string */ + NULL, /* pointer to process security attributes */ + NULL, /* pointer to thread security attributes */ + TRUE, /* handle inheritance flag */ + GetPriorityClass(GetCurrentProcess()), + /* creation flags */ + NULL, /* pointer to new environment block */ + BinDir,/* pointer to current directory name */ + &si, /* pointer to STARTUPINFO */ + &ErlProcessInfo /* pointer to PROCESS_INFORMATION */ + )) == FALSE) { + ShowLastError(); + exit_help("Failed to start new node"); + } + +#ifdef _DEBUG + fprintf(stderr, "Waiting for Erlang to terminate.\n"); +#endif + if(MsgWaitForMultipleObjects(1,&ErlProcessInfo.hProcess, FALSE, + INFINITE, QS_POSTMESSAGE) == WAIT_OBJECT_0+1){ + if(PostThreadMessage(ErlProcessInfo.dwThreadId, + WM_USER, + (WPARAM) 0, + (LPARAM) 0)){ + /* Wait 10 seconds for erl process to die, elsee terminate it. */ + if(WaitForSingleObject(ErlProcessInfo.hProcess, 10000) + != WAIT_OBJECT_0){ + TerminateProcess(ErlProcessInfo.hProcess,0); + } + } else { + TerminateProcess(ErlProcessInfo.hProcess,0); + } + } + GetExitCodeProcess(ErlProcessInfo.hProcess, &dwExitCode); +#ifdef _DEBUG + fprintf(stderr, "Erlang terminated.\n"); +#endif + + free(CommandLine); + return(dwExitCode); +} + + +/* + * Try to make the needed options complete by looking through the data file, + * environment variables and registry entries. + */ +void complete_options(void) +{ + /* Try to find a descent RelDir */ + if( !RelDir ) { + DWORD sz = 32; + while (1) { + DWORD nsz; + if (RelDir) + free(RelDir); + RelDir = malloc(sz); + if (!RelDir) { + fprintf(stderr, "** Error : failed to allocate memory\n"); + exit(1); + } + SetLastError(0); + nsz = GetEnvironmentVariable((LPCTSTR) "RELDIR", + (LPTSTR) RelDir, + sz); + if (nsz == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) { + free(RelDir); + RelDir = NULL; + break; + } + else if (nsz <= sz) + break; + else + sz = nsz; + } + if (RelDir == NULL) { + if(DataFileName){ + /* Needs to be absolute for this to work, but we + can try... */ + read_datafile(); + read_registry_keys(); + } else { + /* Impossible to find all data... */ + exit_help("Need either Release directory or an absolute " + "datafile name."); + } + /* Ok, construct our own RelDir from RootDir */ + RelDir = (char *) malloc(strlen(RootDir)+strlen(RELEASE_SUBDIR)+1); + assert(RelDir); + sprintf(RelDir, "%s" RELEASE_SUBDIR, RootDir); + } else { + read_datafile(); + read_registry_keys(); + } + } else { + read_datafile(); + read_registry_keys(); + } + read_bootflags(); + +#ifdef _DEBUG + fprintf(stderr, "RelDir: '%s'\n", RelDir); +#endif +} + + + + +BOOL WINAPI LogoffHandlerRoutine( DWORD dwCtrlType ) +{ + if(dwCtrlType == CTRL_LOGOFF_EVENT) { + return TRUE; + } + + return FALSE; +} + + + + +int main(void) +{ + DWORD dwExitCode; + char *cmdline; + + /* Make sure a logoff does not distrurb us. */ + SetConsoleCtrlHandler(LogoffHandlerRoutine, TRUE); + + cmdline = GetCommandLine(); + assert(cmdline); + + CommandLineStart = (char *) malloc(strlen(cmdline) + 1); + assert(CommandLineStart); + strcpy(CommandLineStart,cmdline); + + split_commandline(); + parse_commandline(); + complete_options(); + + /* We now have all the options we need in order to fire up a new node.. */ + dwExitCode = start_new_node(); + + return( (int) dwExitCode ); +} + + diff --git a/erts/etc/win32/toolbar.bmp b/erts/etc/win32/toolbar.bmp new file mode 100644 index 0000000000..e0df8454fd Binary files /dev/null and b/erts/etc/win32/toolbar.bmp differ diff --git a/erts/etc/win32/win_erlexec.c b/erts/etc/win32/win_erlexec.c new file mode 100644 index 0000000000..0eed8e28b9 --- /dev/null +++ b/erts/etc/win32/win_erlexec.c @@ -0,0 +1,405 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1997-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Extra support for running the emulator on Windows. + * Most of this only used when beam is run as a separate process. + */ + +#pragma comment(linker,"/manifestdependency:\"type='win32' "\ + "name='Microsoft.Windows.Common-Controls' "\ + "version='6.0.0.0' processorArchitecture='*' "\ + "publicKeyToken='6595b64144ccf1df' language='*'\"") + +#include +#include +#include +#include +#include "sys.h" +#include "erl_driver.h" + +extern int nohup; +extern int keep_window; +void error(char* format, ...); + +/* + * Local functions. + */ +#define LOAD_BEAM_DYNAMICALLY 1 +static int start(char* emu, char** argv); +static void start_winsock(void); +static char* last_error(void); +static char* last_wsa_error(void); +static char* win32_errorstr(int error); +static int has_console(void); +static char** fnuttify_argv(char **argv); +static void free_fnuttified(char **v); +static int windowed = 0; + +#ifdef LOAD_BEAM_DYNAMICALLY +typedef int SysGetKeyFunction(int); +typedef void ErlStartFunction(int, char **); +typedef void SysPrimitiveInitFunction(HMODULE); +static SysGetKeyFunction *sys_get_key_p; +static ErlStartFunction *erl_start_p; +static SysPrimitiveInitFunction *sys_primitive_init_p; + +static HMODULE load_win_beam_dll(char *name) +{ + HMODULE beam_module; + beam_module=LoadLibrary(name); + if (beam_module == INVALID_HANDLE_VALUE || beam_module == NULL) { + error("Unable to load emulator DLL\n(%s)",name); + return NULL; + } + sys_get_key_p = (SysGetKeyFunction *) + GetProcAddress(beam_module, "sys_get_key"); + erl_start_p = (ErlStartFunction *) + GetProcAddress(beam_module, "erl_start"); + sys_primitive_init_p = (SysPrimitiveInitFunction *) + GetProcAddress(beam_module, "sys_primitive_init"); + return beam_module; +} +#endif + +#define DLL_ENV "ERL_EMULATOR_DLL" + +static void +set_env(char *key, char *value) +{ + if (!SetEnvironmentVariable((LPCTSTR) key, (LPCTSTR) value)) + error("SetEnvironmentVariable(\"%s\", \"%s\") failed!", key, value); +} + +static char * +get_env(char *key) +{ + DWORD size = 32; + char *value = NULL; + while (1) { + DWORD nsz; + if (value) + free(value); + value = malloc(size); + if (!value) + error("GetEnvironmentVariable(\"%s\") failed", key); + SetLastError(0); + nsz = GetEnvironmentVariable((LPCTSTR) key, (LPTSTR) value, size); + if (nsz == 0 && GetLastError() == ERROR_ENVVAR_NOT_FOUND) { + free(value); + return NULL; + } + if (nsz <= size) + return value; + size = nsz; + } +} + +free_env_val(char *value) +{ + if (value) + free(value); +} + + +int +start_win_emulator(char* emu, char *start_prog, char** argv, int start_detached) +{ + int result; + + windowed = 1; + if (start_detached) { + char *buff; + close(0); + close(1); + close(2); + + set_env("ERL_CONSOLE_MODE", "detached"); + set_env(DLL_ENV, emu); + + argv[0] = start_prog; + argv = fnuttify_argv(argv); + result = spawnv(_P_DETACH, start_prog, argv); + free_fnuttified(argv); + } else { + int argc = 0; +#ifdef LOAD_BEAM_DYNAMICALLY + HMODULE beam_module = load_win_beam_dll(emu); +#endif + set_env("ERL_CONSOLE_MODE", "window"); + while (argv[argc] != NULL) { + ++argc; + } +#ifdef ARGS_HARDDEBUG + { + char sbuf[2048] = ""; + int i; + for (i = 0; i < argc; ++i) { + strcat(sbuf,"|"); + strcat(sbuf, argv[i]); + strcat(sbuf,"| "); + } + MessageBox(NULL, sbuf, "Werl", MB_OK|MB_ICONERROR); + } +#endif +#ifdef LOAD_BEAM_DYNAMICALLY + (*sys_primitive_init_p)(beam_module); + (*erl_start_p)(argc,argv); +#else + erl_start(argc, argv); +#endif + result = 0; + } + if (result == -1) { + error("Failed to execute %s: %s", emu, win32_errorstr(_doserrno)); + } + return 0; +} + +void __cdecl +do_keep_window(void) +{ + printf("\nPress any key to close window.\n"); +#ifdef LOAD_BEAM_DYNAMICALLY + (*sys_get_key_p)(0); +#else + sys_get_key(0); +#endif +} + +int +start_emulator(char* emu, char *start_prog, char** argv, int start_detached) +{ + int result; + static char console_mode[] = "tty:ccc"; + char* fd_type; + char* title; + +#ifdef HARDDEBUG + fprintf(stderr,"emu = %s, start_prog = %s\n",emu, start_prog); +#endif + + fd_type = strchr(console_mode, ':'); + fd_type++; + _flushall(); + + /* + * If no console, we will spawn the emulator detached. + */ + + if (start_detached) { + char *buff; + close(0); + close(1); + close(2); + set_env("ERL_CONSOLE_MODE", "detached"); + set_env(DLL_ENV, emu); + + argv[0] = start_prog; + argv = fnuttify_argv(argv); +#ifdef ARGS_HARDDEBUG + { + char buffer[2048]; + int i; + sprintf(buffer,"Start detached [%s]\n",start_prog); + for(i=0;argv[i] != NULL;++i) { + strcat(buffer,"|"); + strcat(buffer,argv[i]); + strcat(buffer,"|\n"); + } + MessageBox(NULL, buffer,"Start detached",MB_OK); + } +#endif + result = spawnv(_P_DETACH, start_prog, argv); + free_fnuttified(argv); + if (result == -1) { +#ifdef ARGS_HARDDEBUG + MessageBox(NULL, "_spawnv failed","Start detached",MB_OK); +#endif + return 1; + } + SetPriorityClass((HANDLE) result, GetPriorityClass(GetCurrentProcess())); + } else { + int argc = 0; +#ifdef LOAD_BEAM_DYNAMICALLY + HMODULE beam_module = load_win_beam_dll(emu); +#endif + + /* + * Start the emulator. + */ + + title = get_env("ERL_WINDOW_TITLE"); + if (title) { + SetConsoleTitle(title); + } + free_env_val(title); + + set_env("ERL_CONSOLE_MODE", console_mode); + while (argv[argc] != NULL) { + ++argc; + } + if (keep_window) { + atexit(do_keep_window); + } +#ifdef ARGS_HARDDEBUG + { + char sbuf[2048] = ""; + int i; + for (i = 0; i < argc; ++i) { + strcat(sbuf,"|"); + strcat(sbuf, argv[i]); + strcat(sbuf,"|\n"); + } + MessageBox(NULL, sbuf, "erl", MB_OK); + } +#endif +#ifdef LOAD_BEAM_DYNAMICALLY + (*sys_primitive_init_p)(beam_module); + (*erl_start_p)(argc,argv); +#else + erl_start(argc, argv); +#endif + } + return 0; +} + +void +error(char* format, ...) +{ + char sbuf[2048]; + va_list ap; + + va_start(ap, format); + vsprintf(sbuf, format, ap); + va_end(ap); + + if (!windowed && has_console()) { + fprintf(stderr, "%s\n", sbuf); + } else { + MessageBox(NULL, sbuf, "Werl", MB_OK|MB_ICONERROR); + } + exit(1); +} + +static char* +last_error(void) +{ + return win32_errorstr(GetLastError()); +} + +/* + * Returns a human-readable description of the last error. + * The returned pointer will be valid only as long as last-error() + * isn't called again. + */ + +static char* +win32_errorstr(int error) +{ + static LPTSTR lpBufPtr = NULL; + + if (lpBufPtr) + LocalFree(lpBufPtr); + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + error, + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &lpBufPtr, + 0, + NULL); + SetLastError(error); + return lpBufPtr; +} + +static int +has_console(void) +{ + HANDLE handle = CreateFile("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, + NULL, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + + if (handle != INVALID_HANDLE_VALUE) { + CloseHandle(handle); + return 1; + } else { + return 0; + } +} + +static char** fnuttify_argv(char **argv) +{ + char **v; + char *p; + char *q; + int c; + int i; + int n; + int m; + + for (c = 0; argv[c]; ++c) + ; + + v = malloc(sizeof(char *) * (c+1)); + v[c] = NULL; + for (i = 0; i < c; ++i) { + p = argv[i]; + n = m = 0; + while (*p) { + if (*p == ' ') { + m = 2; + } else if (*p == '"') { + m = 2; + ++n; + } + ++p; + } + v[i] = malloc((p - argv[i]) + 1 + n + m); + p = argv[i]; + q = v[i]; + if (n || m) { + if (m) { + *q++ = '"'; + } + while (*p) { + if (*p == '"') { + *q++ = '\\'; + } + *q++ = *p++; + } + if (m) { + *q++ = '"'; + } + *q = '\0'; + } else { + strcpy(q,p); + } + } + return v; +} + +static void free_fnuttified(char **v) +{ + char **t = v; + + while(*t) { + free(*t); + ++t; + } + free(v); +} diff --git a/erts/example/Makefile b/erts/example/Makefile new file mode 100644 index 0000000000..6e1a88b4da --- /dev/null +++ b/erts/example/Makefile @@ -0,0 +1,62 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +EI_ROOT = $(ERL_TOP)/lib/erl_interface +EI_INCLUDE = -I$(EI_ROOT)/include -I$(ERL_TOP)/erts/emulator/beam +EI_LIB = -L$(EI_ROOT)/obj/$(TARGET) -lei + +PQ_LIB = -lpq + +OUR_C_FLAGS = -g -Wall -fpic $(EI_INCLUDE) +CFLAGS += $(OUR_C_FLAGS) +CXXFLAGS += $(OUR_C_FLAGS) + +TARGETS = pg_sync.beam pg_async.beam pg_sync.so pg_async.so \ +next_perm.so next_perm.beam + +all: $(TARGETS) + +clean: + rm -f $(TARGETS) *.o + rm -f pg_async2.so pg_encode2.beam pg_async2.beam + rm -f core erl_crash.dump + rm -f *~ + +pg_async2.o pg_encode2.o: pg_encode2.h + +pg_sync.o pg_async.o pg_encode.o: pg_encode.h + + +pg_async2.so: pg_encode2.o + +pg_sync.so pg_async.so: pg_encode.o + +pg_async2.so: pg_async2.o + $(CC) $(CFLAGS) pg_encode2.o -shared $< $(EI_LIB) $(PQ_LIB) -o $@ + +%.so: %.cc + $(CXX) $(CXXFLAGS) $< -shared -o $@ + +%.so: %.o + $(CC) $(CFLAGS) pg_encode.o -shared $< $(EI_LIB) $(PQ_LIB) -o $@ + +%: %.cc + $(CXX) $(CXXFLAGS) $< -o $@ diff --git a/erts/example/next_perm.cc b/erts/example/next_perm.cc new file mode 100644 index 0000000000..ee81cb0404 --- /dev/null +++ b/erts/example/next_perm.cc @@ -0,0 +1,137 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: A driver using libpq to connect to Postgres + * from erlang, a sample for the driver documentation + */ + +#include + +#include +#include + +using namespace std; + +#include +#define L cerr << __LINE__ << "\r\n"; + +/* Driver interface declarations */ +static ErlDrvData start(ErlDrvPort port, char*); +static void output(ErlDrvData drv_data, char *buf, int len); +static void ready_async(ErlDrvData, ErlDrvThreadData); + +static ErlDrvEntry next_perm_driver_entry = { + NULL, /* init */ + start, + NULL, /* stop */ + output, + NULL, /* ready_input */ + NULL, /* ready_output */ + "next_perm", /* the name of the driver */ + NULL, /* finish */ + NULL, /* handle */ + NULL, /* control */ + NULL, /* timeout */ + NULL, /* outputv */ + ready_async, + NULL, /* flush */ + NULL, /* call */ + NULL /* event */ +}; + +/* INITIALIZATION AFTER LOADING */ + +/* + * This is the init function called after this driver has been loaded. + * It must *not* be declared static. Must return the address to + * the driver entry. + */ + +#ifdef __cplusplus +extern "C" { // shouldn't this be in the DRIVER_INIT macro? +#endif +DRIVER_INIT(next_perm) +{ + return &next_perm_driver_entry; +} +#ifdef __cplusplus +} +#endif + +/* DRIVER INTERFACE */ +static ErlDrvData start(ErlDrvPort port, char *) +{ + if (port == NULL) + return ERL_DRV_ERROR_GENERAL; + return (ErlDrvData)port; +} + + +struct our_async_data { + bool prev; + vector data; + our_async_data(ErlDrvPort p, int command, const char* buf, int len); +}; + +our_async_data::our_async_data(ErlDrvPort p, int command, + const char* buf, int len) + : prev(command == 2), + data((int*)buf, (int*)buf + len / sizeof(int)) +{ +} + +static void do_perm(void* async_data); + +static void output(ErlDrvData drv_data, char *buf, int len) +{ + if (*buf < 1 || *buf > 2) return; + ErlDrvPort port = reinterpret_cast(drv_data); + void* async_data = new our_async_data(port, *buf, buf+1, len); + driver_async(port, NULL, do_perm, async_data, NULL); +} + +static void do_perm(void* async_data) +{ + our_async_data* d = reinterpret_cast(async_data); + if (d->prev) + prev_permutation(d->data.begin(), d->data.end()); + else + next_permutation(d->data.begin(), d->data.end()); +} + +static void ready_async(ErlDrvData drv_data, ErlDrvThreadData async_data) +{ + ErlDrvPort port = reinterpret_cast(drv_data); + our_async_data* d = reinterpret_cast(async_data); + int n = d->data.size(), result_n = n*2 + 5; + ErlDrvTermData* result = new ErlDrvTermData[result_n], * rp = result; + *rp++ = ERL_DRV_PORT; + *rp++ = driver_mk_port(port); + for (vector::iterator i = d->data.begin(); + i != d->data.end(); ++i) { + *rp++ = ERL_DRV_INT; + *rp++ = *i; + } + *rp++ = ERL_DRV_NIL; + *rp++ = ERL_DRV_LIST; + *rp++ = n+2; + driver_output_term(port, result, result_n); + delete[] result; + delete d; +} diff --git a/erts/example/next_perm.erl b/erts/example/next_perm.erl new file mode 100644 index 0000000000..40a5c24d35 --- /dev/null +++ b/erts/example/next_perm.erl @@ -0,0 +1,66 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(next_perm). + +-export([next_perm/1, prev_perm/1, load/0, all_perm/1]). + +load() -> + case whereis(next_perm) of + undefined -> + case erl_ddll:load_driver(".", "next_perm") of + ok -> ok; + {error, already_loaded} -> ok; + E -> exit(E) + end, + Port = open_port({spawn, "next_perm"}, []), + register(next_perm, Port); + _ -> + ok + end. + +list_to_integer_binaries(L) -> + [<> || I <- L]. + +next_perm(L) -> + next_perm(L, 1). + +prev_perm(L) -> + next_perm(L, 2). + +next_perm(L, Nxt) -> + load(), + B = list_to_integer_binaries(L), + Port = whereis(next_perm), + port_command(Port, [Nxt, B]), + receive + [Port | Result] -> + Result + end. + +all_perm(L) -> + New = prev_perm(L), + all_perm(New, L, [New]). + +all_perm(L, L, Acc) -> + Acc; +all_perm(L, Orig, Acc) -> + New = prev_perm(L), + all_perm(New, Orig, [New | Acc]). + + diff --git a/erts/example/pg_async.c b/erts/example/pg_async.c new file mode 100644 index 0000000000..7ffb4bb1f3 --- /dev/null +++ b/erts/example/pg_async.c @@ -0,0 +1,224 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: A driver using libpq to connect to Postgres + * from erlang, a sample for the driver documentation + */ + +#include + +#include + +#include + +#include +#include +#include + +#include "pg_encode.h" + +/* Driver interface declarations */ +static ErlDrvData start(ErlDrvPort port, char *command); +static void stop(ErlDrvData drv_data); +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); +static void ready_io(ErlDrvData drv_data, ErlDrvEvent event); + +static ErlDrvEntry pq_driver_entry = { + NULL, /* init */ + start, + stop, + NULL, /* output */ + ready_io, /* ready_input */ + ready_io, /* ready_output */ + "pg_async", /* the name of the driver */ + NULL, /* finish */ + NULL, /* handle */ + control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL /* event */ +}; + +typedef struct our_data_t { + PGconn* conn; + ErlDrvPort port; + int socket; + int connecting; +} our_data_t; + +/* Keep the following definitions in alignment with the FUNC_LIST + * in erl_pq_sync.erl + */ + +#define DRV_CONNECT 'C' +#define DRV_DISCONNECT 'D' +#define DRV_SELECT 'S' + +/* #define L fprintf(stderr, "%d\r\n", __LINE__) */ + +/* INITIALIZATION AFTER LOADING */ + +/* + * This is the init function called after this driver has been loaded. + * It must *not* be declared static. Must return the address to + * the driver entry. + */ +DRIVER_INIT(pq_drv) +{ + return &pq_driver_entry; +} + +static char* get_s(const char* buf, int len); +static int do_connect(const char *s, our_data_t* data); +static int do_disconnect(our_data_t* data); +static int do_select(const char* s, our_data_t* data); + +/* DRIVER INTERFACE */ +static ErlDrvData start(ErlDrvPort port, char *command) +{ + our_data_t* data = driver_alloc(sizeof(our_data_t)); + data->port = port; + data->conn = NULL; + return (ErlDrvData)data; +} + +static void stop(ErlDrvData drv_data) +{ + do_disconnect((our_data_t*)drv_data); +} + +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + int r; + char* s = get_s(buf, len); + our_data_t* data = (our_data_t*)drv_data; + switch (command) { + case DRV_CONNECT: r = do_connect(s, data); break; + case DRV_DISCONNECT: r = do_disconnect(data); break; + case DRV_SELECT: r = do_select(s, data); break; + default: r = -1; break; + } + driver_free(s); + return r; +} + +static int do_connect(const char *s, our_data_t* data) +{ + PGconn* conn = PQconnectStart(s); + if (PQstatus(conn) == CONNECTION_BAD) { + ei_x_buff x; + ei_x_new_with_version(&x); + encode_error(&x, conn); + PQfinish(conn); + conn = NULL; + driver_output(data->port, x.buff, x.index); + ei_x_free(&x); + } + PQconnectPoll(conn); + int socket = PQsocket(conn); + data->socket = socket; + driver_select(data->port, (ErlDrvEvent)socket, DO_READ, 1); + driver_select(data->port, (ErlDrvEvent)socket, DO_WRITE, 1); + data->conn = conn; + data->connecting = 1; + return 0; +} + +static int do_disconnect(our_data_t* data) +{ + ei_x_buff x; + driver_select(data->port, (ErlDrvEvent)data->socket, DO_READ, 0); + driver_select(data->port, (ErlDrvEvent)data->socket, DO_WRITE, 0); + PQfinish(data->conn); + data->conn = NULL; + ei_x_new_with_version(&x); + encode_ok(&x); + driver_output(data->port, x.buff, x.index); + ei_x_free(&x); + return 0; +} + +static int do_select(const char* s, our_data_t* data) +{ + data->connecting = 0; + PGconn* conn = data->conn; + /* if there's an error return it now */ + if (PQsendQuery(conn, s) == 0) { + ei_x_buff x; + ei_x_new_with_version(&x); + encode_error(&x, conn); + driver_output(data->port, x.buff, x.index); + ei_x_free(&x); + } + /* else wait for ready_output to get results */ + return 0; +} + +static void ready_io(ErlDrvData drv_data, ErlDrvEvent event) +{ + PGresult* res = NULL; + our_data_t* data = (our_data_t*)drv_data; + PGconn* conn = data->conn; + ei_x_buff x; + ei_x_new_with_version(&x); + if (data->connecting) { + ConnStatusType status; + PQconnectPoll(conn); + status = PQstatus(conn); + if (status == CONNECTION_OK) + encode_ok(&x); + else if (status == CONNECTION_BAD) + encode_error(&x, conn); + } else { + PQconsumeInput(conn); + if (PQisBusy(conn)) + return; + res = PQgetResult(conn); + encode_result(&x, res, conn); + PQclear(res); + for (;;) { + res = PQgetResult(conn); + if (res == NULL) + break; + PQclear(res); + } + } + if (x.index > 1) { + driver_output(data->port, x.buff, x.index); + if (data->connecting) + driver_select(data->port, (ErlDrvEvent)data->socket, DO_WRITE, 0); + } + ei_x_free(&x); +} + +/* utilities */ +static char* get_s(const char* buf, int len) +{ + char* result; + if (len < 1 || len > 1000) return NULL; + result = driver_alloc(len+1); + memcpy(result, buf, len); + result[len] = '\0'; + return result; +} diff --git a/erts/example/pg_async.erl b/erts/example/pg_async.erl new file mode 100644 index 0000000000..10506bfe9f --- /dev/null +++ b/erts/example/pg_async.erl @@ -0,0 +1,57 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(pg_async). + +-define(DRV_CONNECT, $C). +-define(DRV_DISCONNECT, $D). +-define(DRV_SELECT, $S). + +-export([connect/1, disconnect/1, select/2]). + +connect(ConnectStr) -> + case erl_ddll:load_driver(".", "pg_async") of + ok -> ok; + {error, already_loaded} -> ok; + E -> exit(E) + end, + Port = open_port({spawn, ?MODULE}, [binary]), + port_control(Port, ?DRV_CONNECT, ConnectStr), + case return_port_data(Port) of + ok -> + {ok, Port}; + Error -> + Error + end. + +disconnect(Port) -> + port_control(Port, ?DRV_DISCONNECT, ""), + R = return_port_data(Port), + port_close(Port), + R. + +select(Port, Query) -> + port_control(Port, ?DRV_SELECT, Query), + return_port_data(Port). + +return_port_data(Port) -> + receive + {Port, {data, Data}} -> + binary_to_term(Data) + end. + diff --git a/erts/example/pg_async2.c b/erts/example/pg_async2.c new file mode 100644 index 0000000000..368f9d32d0 --- /dev/null +++ b/erts/example/pg_async2.c @@ -0,0 +1,244 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: A driver using libpq to connect to Postgres + * from erlang, a sample for the driver documentation + */ + +#include + +#include + +#include + +#include +#include +#include + +#include "pg_encode2.h" + +#define L fprintf(stderr, "%d\r\n", __LINE__) + +/* Driver interface declarations */ +static ErlDrvData start(ErlDrvPort port, char *command); +static void stop(ErlDrvData drv_data); +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); +static void ready_input(ErlDrvData drv_data, ErlDrvEvent event); + +static ErlDrvEntry pq_driver_entry = { + NULL, /* init */ + start, + stop, + NULL, /* output */ + ready_input, /* ready_input */ + NULL, /* ready_output */ + "pg_async2", + NULL, /* finish */ + NULL, /* handle */ + control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL, + NULL, + NULL, + NULL +}; + +typedef struct our_data_t { + PGconn* conn; + ErlDrvPort port; + int socket; + char* s; +} our_data_t; + +our_data_t our_data; + +/* Keep the following definitions in alignment with the FUNC_LIST + * in erl_pq_sync.erl + */ + +#define DRV_CONNECT 1 +#define DRV_DISCONNECT 2 +#define DRV_SELECT 3 + +/* INITIALIZATION AFTER LOADING */ + +/* + * This is the init function called after this driver has been loaded. + * It must *not* be declared static. Must return the address to + * the driver entry. + */ + +#ifdef __cplusplus +extern "C" { /* this should be in the DRIVER_INIT macro! */ +#endif +DRIVER_INIT(pq_drv) +{ + return &pq_driver_entry; +} +#ifdef __cplusplus +} +#endif + +/* DRIVER INTERFACE */ +static ErlDrvData start(ErlDrvPort port, char *command) +{ + our_data_t* data = driver_alloc(sizeof(our_data_t)); + data->port = port; + data->conn = NULL; + return (ErlDrvData)data; +} + + +static char* get_s(const char* buf, int len); +static void free_s(char* s); + +static int do_connect(const char *s, our_data_t* data); +static int do_disconnect(our_data_t* data); +static int do_select(const char* s, our_data_t* data); + +static void stop(ErlDrvData drv_data) +{ + do_disconnect((our_data_t*)drv_data); +} + + +/* Since we are operating in binary mode, the return value from control + * is irrelevant, as long as it is not negative. + */ +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + int r; + char* s; + + s = get_s(buf, len); + switch (command) { + case DRV_CONNECT: + r = do_connect(s, (our_data_t*)drv_data); + break; + case DRV_DISCONNECT: + r = do_disconnect((our_data_t*)drv_data); + break; + case DRV_SELECT: + r = do_select(s, (our_data_t*)drv_data); + break; + default: + r = -1; + break; + } + free_s(s); + return r; +} + +static int do_connect(const char *s, our_data_t* data) +{ + ei_x_buff x; + PGconn* conn = PQconnectdb(s); + + ei_x_new_with_version(&x); + if (PQstatus(conn) != CONNECTION_OK) { + encode_error(&x, conn); + PQfinish(conn); + conn = NULL; + } else { + encode_ok(&x); + data->socket = PQsocket(conn); + driver_select(data->port, (ErlDrvEvent)data->socket, DO_READ, 1); + } + driver_output(data->port, x.buff, x.index); + ei_x_free(&x); + data->conn = conn; + return 0; +} + +static int do_disconnect(our_data_t* data) +{ + ei_x_buff x; + + if (data->socket == 0) + return 0; + driver_select(data->port, (ErlDrvEvent)data->socket, DO_READ, 0); + data->socket = 0; + PQfinish(data->conn); + data->conn = NULL; + ei_x_new_with_version(&x); + encode_ok(&x); + driver_output(data->port, x.buff, x.index); + ei_x_free(&x); + return 0; +} + +static int do_select(const char* s, our_data_t* data) +{ + PGconn* conn = data->conn; + + /* if there's an error return it now */ + if (PQsendQueryParams(conn, s, 0, NULL, NULL, NULL, NULL, 1) == 0) { + ei_x_buff x; + ei_x_new_with_version(&x); + encode_error(&x, conn); + driver_output(data->port, x.buff, x.index); + ei_x_free(&x); + } + /* else wait for ready_output to get results */ + return 0; +} + +static void ready_input(ErlDrvData drv_data, ErlDrvEvent event) +{ + our_data_t* data = (our_data_t*)drv_data; + PGconn* conn = data->conn; + ei_x_buff x; + PGresult* res; + + PQconsumeInput(conn); + if (PQisBusy(conn)) + return; + ei_x_new_with_version(&x); + res = PQgetResult(conn); + encode_result(&x, res, conn); + driver_output(data->port, x.buff, x.index); + ei_x_free(&x); + PQclear(res); + for (;;) { + res = PQgetResult(conn); + if (res == NULL) + break; + PQclear(res); + } +} + +/* utilities */ + +static char* get_s(const char* buf, int len) +{ + char* result; + if (len < 1 || len > 1000) return NULL; + result = driver_alloc(len+1); + memcpy(result, buf, len); + result[len] = '\0'; + return result; +} + +static void free_s(char* s) +{ + driver_free(s); +} diff --git a/erts/example/pg_async2.erl b/erts/example/pg_async2.erl new file mode 100644 index 0000000000..4803abf508 --- /dev/null +++ b/erts/example/pg_async2.erl @@ -0,0 +1,53 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(pg_async2). + +-define(DRV_CONNECT, 1). +-define(DRV_DISCONNECT, 2). +-define(DRV_SELECT, 3). + +-export([connect/1, disconnect/1, select/2]). + +connect(ConnectStr) -> + case erl_ddll:load_driver(".", "pg_async2") of + ok -> ok; + {error, already_loaded} -> ok; + _ -> exit({error, could_not_load_driver}) + end, + Port = open_port({spawn, ?MODULE}, [binary]), + port_control(Port, ?DRV_CONNECT, ConnectStr), + case return_port_data(Port) of + ok -> {ok, Port}; + Error -> Error + end. + +disconnect(Port) -> + port_control(Port, ?DRV_DISCONNECT, ""), + return_port_data(Port). + +select(Port, Query) -> + port_control(Port, ?DRV_SELECT, Query), + return_port_data(Port). + +return_port_data(Port) -> + receive + {Port, {data, Data}} -> + binary_to_term(Data) + end. + diff --git a/erts/example/pg_encode.c b/erts/example/pg_encode.c new file mode 100644 index 0000000000..34ca1fe46c --- /dev/null +++ b/erts/example/pg_encode.c @@ -0,0 +1,79 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include + +#include + +#include + +#include +#include +#include + +#include "pg_encode.h" + +void encode_ok(ei_x_buff* x) +{ + const char* k_ok = "ok"; + ei_x_encode_atom(x, k_ok); +} + +void encode_error(ei_x_buff* x, PGconn* conn) +{ + const char* k_error = "error"; + ei_x_encode_tuple_header(x, 2); + ei_x_encode_atom(x, k_error); + ei_x_encode_string(x, PQerrorMessage(conn)); +} + +void encode_result(ei_x_buff* x, PGresult* res, PGconn* conn) +{ + int row, n_rows, col, n_cols; + switch (PQresultStatus(res)) { + case PGRES_TUPLES_OK: + n_rows = PQntuples(res); + n_cols = PQnfields(res); + ei_x_encode_tuple_header(x, 2); + encode_ok(x); + ei_x_encode_list_header(x, n_rows+1); + ei_x_encode_list_header(x, n_cols); + for (col = 0; col < n_cols; ++col) { + ei_x_encode_string(x, PQfname(res, col)); + } + ei_x_encode_empty_list(x); + for (row = 0; row < n_rows; ++row) { + ei_x_encode_list_header(x, n_cols); + for (col = 0; col < n_cols; ++col) { + ei_x_encode_string(x, PQgetvalue(res, row, col)); + } + ei_x_encode_empty_list(x); + } + ei_x_encode_empty_list(x); + break; + case PGRES_COMMAND_OK: + ei_x_encode_tuple_header(x, 2); + encode_ok(x); + ei_x_encode_string(x, PQcmdTuples(res)); + break; + default: + encode_error(x, conn); + break; + } +} + diff --git a/erts/example/pg_encode.h b/erts/example/pg_encode.h new file mode 100644 index 0000000000..4477c0c079 --- /dev/null +++ b/erts/example/pg_encode.h @@ -0,0 +1,21 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +void encode_ok(ei_x_buff* x); +void encode_error(ei_x_buff* x, PGconn* conn); +void encode_result(ei_x_buff* x, PGresult* res, PGconn* conn); diff --git a/erts/example/pg_encode2.c b/erts/example/pg_encode2.c new file mode 100644 index 0000000000..a0e99ba3b3 --- /dev/null +++ b/erts/example/pg_encode2.c @@ -0,0 +1,82 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +#include + +#include + +#include + +#include +#include +#include + +#include "pg_encode2.h" + +void encode_ok(ei_x_buff* x) +{ + const char* k_ok = "ok"; + ei_x_encode_atom(x, k_ok); +} + +void encode_error(ei_x_buff* x, PGconn* conn) +{ + const char* k_error = "error"; + ei_x_encode_tuple_header(x, 2); + ei_x_encode_atom(x, k_error); + ei_x_encode_string(x, PQerrorMessage(conn)); +} + +void encode_result(ei_x_buff* x, PGresult* res, PGconn* conn) +{ + int row, n_rows, col, n_cols, fsize; + + switch (PQresultStatus(res)) { + case PGRES_TUPLES_OK: + n_rows = PQntuples(res); + n_cols = PQnfields(res); + ei_x_encode_tuple_header(x, 2); + encode_ok(x); + ei_x_encode_list_header(x, 1); + for (col = 0; col < n_cols; ++col) { + ei_x_encode_list_header(x, 1); + ei_x_encode_string(x, PQfname(res, col)); + } + ei_x_encode_empty_list(x); + for (row = 0; row < n_rows; ++row) { + ei_x_encode_list_header(x, 1); + for (col = 0; col < n_cols; ++col) { + ei_x_encode_list_header(x, 1); + fsize = PQgetlength(res, row, col); + ei_x_encode_binary(x, PQgetvalue(res, row, col), fsize); + } + ei_x_encode_empty_list(x); + } + ei_x_encode_empty_list(x); + break; + case PGRES_COMMAND_OK: + ei_x_encode_tuple_header(x, 2); + encode_ok(x); + ei_x_encode_string(x, PQcmdTuples(res)); + break; + default: + encode_error(x, conn); + break; + } +} + diff --git a/erts/example/pg_encode2.h b/erts/example/pg_encode2.h new file mode 100644 index 0000000000..4477c0c079 --- /dev/null +++ b/erts/example/pg_encode2.h @@ -0,0 +1,21 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +void encode_ok(ei_x_buff* x); +void encode_error(ei_x_buff* x, PGconn* conn); +void encode_result(ei_x_buff* x, PGresult* res, PGconn* conn); diff --git a/erts/example/pg_sync.c b/erts/example/pg_sync.c new file mode 100644 index 0000000000..6eaa6138e6 --- /dev/null +++ b/erts/example/pg_sync.c @@ -0,0 +1,180 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * Purpose: A driver using libpq to connect to Postgres + * from erlang, a sample for the driver documentation + */ + +#include +#include +#include + +#include + +#include +#include + +#include "pg_encode.h" + +/* Driver interface declarations */ +static ErlDrvData start(ErlDrvPort port, char *command); +static void stop(ErlDrvData drv_data); +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen); + +static ErlDrvEntry pq_driver_entry = { + NULL, /* init */ + start, + stop, + NULL, /* output */ + NULL, /* ready_input */ + NULL, /* ready_output */ + "pg_sync", /* the name of the driver */ + NULL, /* finish */ + NULL, /* handle */ + control, + NULL, /* timeout */ + NULL, /* outputv */ + NULL, /* ready_async */ + NULL, /* flush */ + NULL, /* call */ + NULL /* event */ +}; + +typedef struct our_data_t { + PGconn* conn; +} our_data_t; + +/* Keep the following definitions in alignment with the + * defines in erl_pq_sync.erl + */ + +#define DRV_CONNECT 'C' +#define DRV_DISCONNECT 'D' +#define DRV_SELECT 'S' + +/* INITIALIZATION AFTER LOADING */ + +/* + * This is the init function called after this driver has been loaded. + * It must *not* be declared static. Must return the address to + * the driver entry. + */ + +DRIVER_INIT(pq_drv) +{ + return &pq_driver_entry; +} + +/* DRIVER INTERFACE */ +static ErlDrvData start(ErlDrvPort port, char *command) +{ + our_data_t* data; + + data = (our_data_t*)driver_alloc(sizeof(our_data_t)); + data->conn = NULL; + set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); + return (ErlDrvData)data; +} + +static int do_disconnect(our_data_t* data, ei_x_buff* x); + +static void stop(ErlDrvData drv_data) +{ + do_disconnect((our_data_t*)drv_data, NULL); +} + +static ErlDrvBinary* ei_x_to_new_binary(ei_x_buff* x) +{ + ErlDrvBinary* bin = driver_alloc_binary(x->index); + if (bin != NULL) + memcpy(&bin->orig_bytes[0], x->buff, x->index); + return bin; +} + +static char* get_s(const char* buf, int len); +static int do_connect(const char *s, our_data_t* data, ei_x_buff* x); +static int do_select(const char* s, our_data_t* data, ei_x_buff* x); + +/* Since we are operating in binary mode, the return value from control + * is irrelevant, as long as it is not negative. + */ +static int control(ErlDrvData drv_data, unsigned int command, char *buf, + int len, char **rbuf, int rlen) +{ + int r; + ei_x_buff x; + our_data_t* data = (our_data_t*)drv_data; + char* s = get_s(buf, len); + ei_x_new_with_version(&x); + switch (command) { + case DRV_CONNECT: r = do_connect(s, data, &x); break; + case DRV_DISCONNECT: r = do_disconnect(data, &x); break; + case DRV_SELECT: r = do_select(s, data, &x); break; + default: r = -1; break; + } + *rbuf = (char*)ei_x_to_new_binary(&x); + ei_x_free(&x); + driver_free(s); + return r; +} + +static int do_connect(const char *s, our_data_t* data, ei_x_buff* x) +{ + PGconn* conn = PQconnectdb(s); + if (PQstatus(conn) != CONNECTION_OK) { + encode_error(x, conn); + PQfinish(conn); + conn = NULL; + } else { + encode_ok(x); + } + data->conn = conn; + return 0; +} + +static int do_disconnect(our_data_t* data, ei_x_buff* x) +{ + if (data->conn == NULL) + return 0; + PQfinish(data->conn); + data->conn = NULL; + if (x != NULL) + encode_ok(x); + return 0; +} + +static int do_select(const char* s, our_data_t* data, ei_x_buff* x) +{ + PGresult* res = PQexec(data->conn, s); + encode_result(x, res, data->conn); + PQclear(res); + return 0; +} + +/* utilities */ +static char* get_s(const char* buf, int len) +{ + char* result; + if (len < 1 || len > 10000) return NULL; + result = driver_alloc(len+1); + memcpy(result, buf, len); + result[len] = '\0'; + return result; +} diff --git a/erts/example/pg_sync.erl b/erts/example/pg_sync.erl new file mode 100644 index 0000000000..58cc149e12 --- /dev/null +++ b/erts/example/pg_sync.erl @@ -0,0 +1,46 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(pg_sync). + +-define(DRV_CONNECT, $C). +-define(DRV_DISCONNECT, $D). +-define(DRV_SELECT, $S). + +-export([connect/1, disconnect/1, select/2]). + +connect(ConnectStr) -> + case erl_ddll:load_driver(".", "pg_sync") of + ok -> ok; + {error, already_loaded} -> ok; + E -> exit(E) + end, + Port = open_port({spawn, ?MODULE}, []), + case binary_to_term(port_control(Port, ?DRV_CONNECT, ConnectStr)) of + ok -> {ok, Port}; + Error -> Error + end. + +disconnect(Port) -> + R = binary_to_term(port_control(Port, ?DRV_DISCONNECT, "")), + port_close(Port), + R. + +select(Port, Query) -> + binary_to_term(port_control(Port, ?DRV_SELECT, Query)). + diff --git a/erts/include/erl_fixed_size_int_types.h b/erts/include/erl_fixed_size_int_types.h new file mode 100644 index 0000000000..3bbc37aea7 --- /dev/null +++ b/erts/include/erl_fixed_size_int_types.h @@ -0,0 +1,160 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: + * + * Author: Rickard Green + */ + +#ifndef FIXED_SIZE_INT_TYPES_H__ +#define FIXED_SIZE_INT_TYPES_H__ + +#ifdef SIZEOF_CHAR +# define SIZEOF_CHAR_SAVED__ SIZEOF_CHAR +# undef SIZEOF_CHAR +#endif + +#ifdef SIZEOF_SHORT +# define SIZEOF_SHORT_SAVED__ SIZEOF_SHORT +# undef SIZEOF_SHORT +#endif + +#ifdef SIZEOF_INT +# define SIZEOF_INT_SAVED__ SIZEOF_INT +# undef SIZEOF_INT +#endif + +#ifdef SIZEOF_LONG +# define SIZEOF_LONG_SAVED__ SIZEOF_LONG +# undef SIZEOF_LONG +#endif + +#ifdef SIZEOF_LONG_LONG +# define SIZEOF_LONG_LONG_SAVED__ SIZEOF_LONG_LONG +# undef SIZEOF_LONG_LONG +#endif + +#include "erl_int_sizes_config.h" + +#ifdef SIZEOF_CHAR_SAVED__ +# if SIZEOF_CHAR != SIZEOF_CHAR_SAVED__ +# error char type size mismatch +# endif +# undef SIZEOF_CHAR_SAVED__ +#endif + +#ifdef SIZEOF_SHORT_SAVED__ +# if SIZEOF_SHORT != SIZEOF_SHORT_SAVED__ +# error short type size mismatch +# endif +# undef SIZEOF_SHORT_SAVED__ +#endif + +#ifdef SIZEOF_INT_SAVED__ +# if SIZEOF_INT != SIZEOF_INT_SAVED__ +# error int type size mismatch +# endif +# undef SIZEOF_INT_SAVED__ +#endif + +#ifdef SIZEOF_LONG_SAVED__ +# if SIZEOF_LONG != SIZEOF_LONG_SAVED__ +# error long type size mismatch +# endif +# undef SIZEOF_LONG_SAVED__ +#endif + +#ifdef SIZEOF_LONG_LONG_SAVED__ +# if SIZEOF_LONG_LONG != SIZEOF_LONG_LONG_SAVED__ +# error long long type size mismatch +# endif +# undef SIZEOF_LONG_LONG_SAVED__ +#endif + + +#if SIZEOF_LONG == 8 +#define HAVE_INT_64 1 +typedef unsigned long usgnd_int_64; +typedef signed long sgnd_int_64; +#define USGND_INT_64_FSTR "lu" +#define SGND_INT_64_FSTR "ld" +#elif SIZEOF_LONG_LONG == 8 +#define HAVE_INT_64 1 +typedef unsigned long long usgnd_int_64; +typedef signed long long sgnd_int_64; +#define USGND_INT_64_FSTR "llu" +#define SGND_INT_64_FSTR "lld" +#else +#define HAVE_INT_64 0 +#endif + +#if SIZEOF_LONG == 4 +typedef unsigned long usgnd_int_32; +typedef signed long sgnd_int_32; +#define USGND_INT_32_FSTR "lu" +#define SGND_INT_32_FSTR "ld" +#elif SIZEOF_INT == 4 +typedef unsigned int usgnd_int_32; +typedef signed int sgnd_int_32; +#define USGND_INT_32_FSTR "u" +#define SGND_INT_32_FSTR "d" +#else +#error Found no appropriate type to use for 'usgnd_int_32' and 'sgnd_int_32' +#endif + +#if SIZEOF_INT == 2 +typedef unsigned int usgnd_int_16; +typedef signed int sgnd_int_16; +#define USGND_INT_16_FSTR "u" +#define SI_16_FSTR "d" +#elif SIZEOF_SHORT == 2 +typedef unsigned short usgnd_int_16; +typedef signed short sgnd_int_16; +#define USGND_INT_16_FSTR "u" +#define SGND_INT_16_FSTR "d" +#else +#error Found no appropriate type to use for 'usgnd_int_16' and 'sgnd_int_16' +#endif + +#if SIZEOF_CHAR == 1 +typedef unsigned char usgnd_int_8; +typedef signed char sgnd_int_8; +#define USGND_INT_8_FSTR "u" +#define SGND_INT_8_FSTR "d" +#else +/* This should *never* happen! */ +#error Found no appropriate type to use for 'usgnd_int_8' and 'sgnd_int_8' +#endif + + +#if HAVE_INT_64 +typedef usgnd_int_64 usgnd_int_max; +typedef sgnd_int_64 sgnd_int_max; +#define USGND_INT_MAX_FSTR USGND_INT_64_FSTR +#define SGND_INT_MAX_FSTR SGND_INT_64_FSTR +#else +typedef usgnd_int_32 usgnd_int_max; +typedef sgnd_int_32 sgnd_int_max; +#define USGND_INT_MAX_FSTR USGND_INT_32_FSTR +#define SGND_INT_MAX_FSTR SGND_INT_32_FSTR +#endif + +#endif /* #ifndef FIXED_SIZE_INT_TYPES_H__ */ diff --git a/erts/include/erl_int_sizes_config.h.in b/erts/include/erl_int_sizes_config.h.in new file mode 100644 index 0000000000..ef49995732 --- /dev/null +++ b/erts/include/erl_int_sizes_config.h.in @@ -0,0 +1,33 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* The number of bytes in a char. */ +#undef SIZEOF_CHAR + +/* The number of bytes in a short. */ +#undef SIZEOF_SHORT + +/* The number of bytes in a int. */ +#undef SIZEOF_INT + +/* The number of bytes in a long. */ +#undef SIZEOF_LONG + +/* The number of bytes in a long long. */ +#undef SIZEOF_LONG_LONG diff --git a/erts/include/erl_memory_trace_parser.h b/erts/include/erl_memory_trace_parser.h new file mode 100644 index 0000000000..3b6f76d2fd --- /dev/null +++ b/erts/include/erl_memory_trace_parser.h @@ -0,0 +1,156 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: + * + * Author: Rickard Green + */ + +#ifndef ERL_MTRACE_PARSER_H__ +#define ERL_MTRACE_PARSER_H__ + +#include +#include "erl_fixed_size_int_types.h" + +/* emtp_parse() return values */ +#define EMTP_MIN_ERROR EMTP_NO_TRACE_ERROR + +#define EMTP_NO_TRACE_ERROR (-11) +#define EMTP_HEADER_TAG_IN_BODY_ERROR (-10) +#define EMTP_BODY_TAG_IN_HEADER_ERROR ( -9) +#define EMTP_NOT_SUPPORTED_MTRACE_VERSION_ERROR ( -8) +#define EMTP_NOT_AN_ERL_MTRACE_ERROR ( -7) +#define EMTP_NO_MEMORY_ERROR ( -6) +#define EMTP_BAD_OP_SIZE_ERROR ( -5) +#define EMTP_NO_OPERATIONS_ERROR ( -4) +#define EMTP_NOT_SUPPORTED_64_BITS_TRACE_ERROR ( -3) +#define EMTP_PARSE_ERROR ( -2) +#define EMTP_UNKNOWN_TAG_ERROR ( -1) +#define EMTP_END_OF_TRACE ( 0) +#define EMTP_END_OF_TRACE_GARBAGE_FOLLOWS ( 1) +#define EMTP_ALL_OPS_FILLED ( 2) +#define EMTP_NEED_MORE_TRACE ( 3) +#define EMTP_HEADER_PARSED ( 4) + +/* Allocator flags */ +#define EMTP_ALLOCATOR_FLAG_HAVE_USED_CARRIERS_INFO (1 << 0) + +/* Block type flags */ +/* #define EMTP_BLOCK_TYPE_FLAG_X */ + + +typedef struct { + usgnd_int_32 major; + usgnd_int_32 minor; +} emtp_version; + +typedef struct { + emtp_version parser; + emtp_version trace; +} emtp_versions; + +typedef struct { + int valid; + usgnd_int_32 flags; + char * name; + struct { + usgnd_int_16 no_providers; + usgnd_int_16 * provider; + } carrier; +} emtp_allocator; + +typedef struct { + int valid; + usgnd_int_32 flags; + char * name; + sgnd_int_32 allocator; +} emtp_block_type; + +typedef struct { + emtp_versions version; + int bits; + char * nodename; + char * hostname; + char * pid; + struct { + usgnd_int_32 year; + usgnd_int_32 month; + usgnd_int_32 day; + usgnd_int_32 hour; + usgnd_int_32 minute; + usgnd_int_32 second; + usgnd_int_32 micro_second; + } start_time; + usgnd_int_16 segment_ix; + usgnd_int_16 max_allocator_ix; + emtp_allocator ** allocator; + usgnd_int_16 max_block_type_ix; + emtp_block_type ** block_type; + int have_carrier_info; + int have_segment_carrier_info; +} emtp_info; + +typedef struct emtp_state_ emtp_state; + +enum emtp_op_type_ { + EMTP_UNDEF = 0, + EMTP_ALLOC = 1, + EMTP_REALLOC = 2, + EMTP_FREE = 3, + EMTP_CARRIER_ALLOC = 4, + EMTP_CARRIER_REALLOC = 5, + EMTP_CARRIER_FREE = 6, + EMTP_STOP = 7, + EMTP_EXIT = 8 +}; + +typedef enum emtp_op_type_ emtp_op_type; + +typedef struct { + usgnd_int_16 type; + usgnd_int_16 carrier_type; + usgnd_int_max new_ptr; + usgnd_int_max prev_ptr; + usgnd_int_max new_size; +} emtp_block_op; + +typedef struct { + emtp_op_type type; + struct { + usgnd_int_32 secs; + usgnd_int_32 usecs; + } time; + union { + emtp_block_op block; + usgnd_int_32 exit_status; + } u; +} emtp_operation; + +const char *emtp_error_string(int); +int emtp_get_info(emtp_info *ip, size_t *isz, emtp_state *sp); +emtp_state *emtp_state_new(void * (*alloc)(size_t), + void * (*realloc)(void *, size_t), + void (*free)(void *)); +void emtp_state_destroy(emtp_state *sp); +int emtp_parse(emtp_state *sp, + usgnd_int_8 **tracepp, size_t *trace_lenp, + emtp_operation *op_start, size_t op_size, size_t *op_lenp); +#endif diff --git a/erts/include/internal/README b/erts/include/internal/README new file mode 100644 index 0000000000..f7b78a3468 --- /dev/null +++ b/erts/include/internal/README @@ -0,0 +1,28 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 2004-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +------------------------------------------------------------------------ +------------------------------------------------------------------------ + + Files in this directory are *not* for public use and should *only* + be used by Erlang/OTP applications. The content of this directory + and the interfaces present in this directory may be changed at any + time without prior notice. + +------------------------------------------------------------------------ +------------------------------------------------------------------------ diff --git a/erts/include/internal/erl_errno.h b/erts/include/internal/erl_errno.h new file mode 100644 index 0000000000..2e095e9f64 --- /dev/null +++ b/erts/include/internal/erl_errno.h @@ -0,0 +1,51 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_ERRNO_H__ +#define ERL_ERRNO_H__ + +#include +/* + * Make sure that ENOTSUP is defined. + */ +#ifndef ENOTSUP +# ifdef EOPNOTSUPP +# define ENOTSUP EOPNOTSUPP +#else +# define ENOTSUP INT_MAX +# endif +#endif + +#ifdef __WIN32__ +# ifndef EWOULDBLOCK +# define EWOULDBLOCK (10035) /* WSAEWOULDBLOCK */ +# endif +# ifndef ETIMEDOUT +# define ETIMEDOUT (10060) /* WSAETIMEDOUT */ +# endif +#else +# ifndef EWOULDBLOCK +# define EWOULDBLOCK EAGAIN +# endif +# ifndef ETIMEDOUT +# define ETIMEDOUT EAGAIN +# endif +#endif + +#endif diff --git a/erts/include/internal/erl_memory_trace_protocol.h b/erts/include/internal/erl_memory_trace_protocol.h new file mode 100644 index 0000000000..bda1f65c87 --- /dev/null +++ b/erts/include/internal/erl_memory_trace_protocol.h @@ -0,0 +1,245 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: + * + * Author: Rickard Green + */ + +#ifndef ERL_MEMORY_TRACE_PROTOCOL_H__ +#define ERL_MEMORY_TRACE_PROTOCOL_H__ + +/* + * Increase ERTS_MT_MAJOR_VSN and set ERTS_MT_MINOR_VSN to 0 + * when backward incompatible changes are made in the protocol. + * + * Increase ERTS_MT_MINOR_VSN when backward compatible changes are + * made in the protocol. + */ +#define ERTS_MT_MAJOR_VSN (2) +#define ERTS_MT_MINOR_VSN (0) + +/* Trace flags */ + +#define ERTS_MT_64_BIT_FLAG (1 << 0) +#define ERTS_MT_CRR_INFO (1 << 1) +#define ERTS_MT_SEG_CRR_INFO (1 << 2) + +/* Header flags */ +/* Allocator flags */ + +#define ERTS_MT_ALLCTR_USD_CRR_INFO (1 << 0) + +/* Block type flags */ + + + +/* Entry tags */ + +#define ERTS_MT_V1_ALLOCATOR_TAG (1) +#define ERTS_MT_V1_BLOCK_TYPE_TAG (2) +#define ERTS_MT_V1_ALLOC_TAG (3) +#define ERTS_MT_V1_REALLOC_NPB_TAG (4) +#define ERTS_MT_V1_REALLOC_MV_TAG (5) +#define ERTS_MT_V1_REALLOC_NMV_TAG (6) +#define ERTS_MT_V1_FREE_TAG (7) +#define ERTS_MT_V1_TIME_INC_TAG (8) +#define ERTS_MT_V1_STOP_TAG (9) +#define ERTS_MT_V1_EXIT_TAG (10) + +#define ERTS_MT_END_OF_HDR_TAG (0) +#define ERTS_MT_ALLOCATOR_HDR_TAG (1) +#define ERTS_MT_BLOCK_TYPE_HDR_TAG (2) + +#define ERTS_MT_EXIT_BDY_TAG (0) +#define ERTS_MT_STOP_BDY_TAG (1) +#define ERTS_MT_ALLOC_BDY_TAG (2) +#define ERTS_MT_REALLOC_BDY_TAG (3) +#define ERTS_MT_FREE_BDY_TAG (4) +#define ERTS_MT_CRR_ALLOC_BDY_TAG (5) +#define ERTS_MT_CRR_REALLOC_BDY_TAG (6) +#define ERTS_MT_CRR_FREE_BDY_TAG (7) +#define ERTS_MT_TIME_INC_BDY_TAG (8) +#define ERTS_MT_X_BDY_TAG (9) + +/* X subtags */ +#if 0 +#define ERTS_MT_X_ _BDY_TAG (0) +#endif + +#define ERTS_MT_START_WORD (0xfff04711) +/* Entry header fields */ + +#define ERTS_MT_UI8_MSB_EHDR_FLD_SZ (0) +#define ERTS_MT_UI16_MSB_EHDR_FLD_SZ (1) +#define ERTS_MT_UI32_MSB_EHDR_FLD_SZ (2) +#define ERTS_MT_UI64_MSB_EHDR_FLD_SZ (3) +#define ERTS_MT_UI_MSB_EHDR_FLD_SZ ERTS_MT_UI64_MSB_EHDR_FLD_SZ +#define ERTS_MT_TAG_EHDR_FLD_SZ (4) + +#define ERTS_MT_UI8_MSB_EHDR_FLD_MSK ((1 << ERTS_MT_UI8_MSB_EHDR_FLD_SZ)-1) +#define ERTS_MT_UI16_MSB_EHDR_FLD_MSK ((1 << ERTS_MT_UI16_MSB_EHDR_FLD_SZ)-1) +#define ERTS_MT_UI32_MSB_EHDR_FLD_MSK ((1 << ERTS_MT_UI32_MSB_EHDR_FLD_SZ)-1) +#define ERTS_MT_UI64_MSB_EHDR_FLD_MSK ((1 << ERTS_MT_UI64_MSB_EHDR_FLD_SZ)-1) +#define ERTS_MT_UI_MSB_EHDR_FLD_MSK ERTS_MT_UI64_MSB_EHDR_FLD_MSK +#define ERTS_MT_TAG_EHDR_FLD_MSK ((1 << ERTS_MT_TAG_EHDR_FLD_SZ)-1) + +/* Time increment word */ +#define ERTS_MT_TIME_INC_SECS_SHIFT 20 +#define ERTS_MT_TIME_INC_USECS_SHIFT 0 + +#define ERTS_MT_TIME_INC_SECS_MASK ((1 << 12) - 1) +#define ERTS_MT_TIME_INC_USECS_MASK ((1 << 20) - 1) + + +#define ERTS_MT_MAX_V1_HEADER_ENTRY_SIZE (2 + 2 + 1 + 255 + 2) +/* Largest v1 header entry is block type entry (ERTS_MT_V1_BLOCK_TYPE_TAG) */ +#define ERTS_MT_MAX_V1_BODY_ENTRY_SIZE (2 + 8 + 8 + 8 + 4) +/* Largest body entry is realloc moved entry (ERTS_MT_V1_REALLOC_MV_TAG) */ + + +#define ERTS_MT_MAX_HEADER_ENTRY_SIZE (1 + 2 + 2 + 1 + 255 + 2) +/* Largest header entry is block type entry (ERTS_MT_BLOCK_TYPE_TAG) */ +#define ERTS_MT_MAX_BODY_ENTRY_SIZE ERTS_MT_MAX_CRR_REALLOC_SIZE +/* Largest body entry is carrier realloc entry (ERTS_MT_CRR_REALLOC_BDY_TAG) */ + +/* + * + * Entry header: + * + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * | ... |MSB2|MSB1| + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * + * Time inc entry field: + * + * 31 23 0 + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + * | Seconds | Micro Seconds | + * +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+ + */ + +#define ERTS_MT_MAX_CRR_ALLOC_SIZE (1 + 2 + 2 + 2 + 8 + 8 + 4) + +/* + * ERTS_MT_CRR_ALLOC_BDY_TAG: + * N 1 2 3 4 5 + * MSB 1-0 1-0 7|3-0 7|3-0 3-0 + * SZ 1 2 2-1 2-1 8|4-1 8|4-1 4-1 + * UIT UI8 UI16 UI16 UI16 UI64|UI32 UI64|UI32 UI32 + * +---+----+...--+...--+...-------+...-------+...-------+ + * |Tag| Hdr|CType| Type| Out ptr | In size | Time inc | + * +---+----+...--+...--+...-------+...-------+...-------+ + * + */ + +#define ERTS_MT_MAX_ALLOC_SIZE (1 + 2 + 2 + 8 + 8 + 4) +/* + * ERTS_MT_ALLOC_BDY_TAG: + * N 1 2 3 4 + * MSB 1-0 7|3-0 7|3-0 3-0 + * SZ 1 2 2-1 8|4-1 8|4-1 4-1 + * UIT UI8 UI16 UI16 UI64|UI32 UI64|UI32 UI32 + * +---+----+...--+...-------+...-------+...-------+ + * |Tag| Hdr| Type| Out ptr | In size | Time inc | + * +---+----+...--+...-------+...-------+...-------+ + * + */ + +#define ERTS_MT_MAX_CRR_REALLOC_SIZE (1 + 2 + 2 + 2 + 8 + 8 + 8 + 4) +/* + * ERTS_MT_CRR_REALLOC_BDY_TAG: + * N 1 2 3 4 5 6 + * MSB 1-0 1-0 7|3-0 7|3-0 7|3-0 3-0 + * SZ 1 2 2-1 2-1 8|4-1 8|4-1 8|4-1 4-1 + * UIT UI8 UI16 UI16 UI16 UI64|UI32 UI64|UI32 UI64|UI32 UI32 + * +---+----+...--+...--+...-------+...-------+...-------+...-------+ + * |Tag| Hdr|CType| Type| Out ptr | In ptr | In size | Time inc | + * +---+----+...--+...--+...-------+...-------+...-------+...-------+ + * + */ + +#define ERTS_MT_MAX_REALLOC_SIZE (1 + 2 + 2 + 8 + 8 + 8 + 4) +/* + * ERTS_MT_REALLOC_BDY_TAG: + * N 1 2 3 4 5 + * MSB 1-0 7|3-0 7|3-0 7|3-0 3-0 + * SZ 1 2 2-1 8|4-1 8|4-1 8|4-1 4-1 + * UIT UI8 UI16 UI16 UI64|UI32 UI64|UI32 UI64|UI32 UI32 + * +---+----+...--+...-------+...-------+...-------+...-------+ + * |Tag| Hdr| Type| Out ptr | In ptr | In size | Time inc | + * +---+----+...--+...-------+...-------+...-------+...-------+ + * + */ + +#define ERTS_MT_MAX_CRR_FREE_SIZE (1 + 2 + 2 + 2 + 8 + 4) +/* + * ERTS_MT_CRR_FREE_BDY_TAG: + * N 1 2 3 4 + * MSB 1-0 1-0 7|3-0 3-0 + * SZ 1 2 2-1 2-1 8|4-1 4-1 + * UIT UI8 UI16 UI16 UI16 UI64|UI32 UI32 + * +---+----+...--+...--+...-------+...-------+ + * |Tag| Hdr|CType| Type| In ptr | Time inc | + * +---+----+...--+...--+...-------+...-------+ + * + */ + +#define ERTS_MT_MAX_FREE_SIZE (1 + 2 + 2 + 8 + 4) +/* + * ERTS_MT_FREE_BDY_TAG: + * N 1 2 3 + * MSB 1-0 7|3-0 3-0 + * SZ 1 2 2-1 8|4-1 4-1 + * UIT UI8 UI16 UI16 UI64|UI32 UI32 + * +---+----+...--+...-------+...-------+ + * |Tag| Hdr| Type| In ptr | Time inc | + * +---+----+...--+...-------+...-------+ + * + */ + +/* + * ERTS_MT_X_BDY_TAG: + * N + * MSB + * SZ 1 2 1 + * UIT UI8 UI16 UI8 + * +---+-----+------+... ...+ + * |Tag|TotSz|SubTag| | + * +---+-----+------+... ...+ + * + * ^ ^ + * | | + * +------ TotSz bytes -----+ + * + * X for extension + * + * * Tag equals ERTS_MT_X_BDY_TAG. + * * TotSz contains the total size of the entry. + * * SubTag is used to distinguish between different sub entries + * passed in X entries. + * + */ + + + +#endif /* #ifndef ERL_MEMORY_TRACE_PROTOCOL_H__ */ + diff --git a/erts/include/internal/erl_misc_utils.h b/erts/include/internal/erl_misc_utils.h new file mode 100644 index 0000000000..82e9ba3798 --- /dev/null +++ b/erts/include/internal/erl_misc_utils.h @@ -0,0 +1,53 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_MISC_UTILS_H_ +#define ERL_MISC_UTILS_H_ + +#include "erl_errno.h" + +typedef struct erts_cpu_info_t_ erts_cpu_info_t; +typedef struct { + int node; + int processor; + int processor_node; + int core; + int thread; + int logical; +} erts_cpu_topology_t; + +erts_cpu_info_t *erts_cpu_info_create(void); +void erts_cpu_info_destroy(erts_cpu_info_t *cpuinfo); +void erts_cpu_info_update(erts_cpu_info_t *cpuinfo); +int erts_get_cpu_configured(erts_cpu_info_t *cpuinfo); +int erts_get_cpu_online(erts_cpu_info_t *cpuinfo); +int erts_get_cpu_available(erts_cpu_info_t *cpuinfo); +char *erts_get_unbind_from_cpu_str(erts_cpu_info_t *cpuinfo); +int erts_get_available_cpu(erts_cpu_info_t *cpuinfo, int no); +int erts_get_cpu_topology_size(erts_cpu_info_t *cpuinfo); +int erts_get_cpu_topology(erts_cpu_info_t *cpuinfo, + erts_cpu_topology_t *topology); +int erts_is_cpu_available(erts_cpu_info_t *cpuinfo, int id); +int erts_bind_to_cpu(erts_cpu_info_t *cpuinfo, int cpu); +int erts_unbind_from_cpu(erts_cpu_info_t *cpuinfo); +int erts_unbind_from_cpu_str(char *str); + +int erts_milli_sleep(long); + +#endif /* #ifndef ERL_MISC_UTILS_H_ */ diff --git a/erts/include/internal/erl_printf.h b/erts/include/internal/erl_printf.h new file mode 100644 index 0000000000..5bc93a979b --- /dev/null +++ b/erts/include/internal/erl_printf.h @@ -0,0 +1,57 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_PRINTF_H_ +#define ERL_PRINTF_H_ +#include +#include + +extern int (*erts_printf_stdout_func)(char *, va_list); +extern int (*erts_printf_stderr_func)(char *, va_list); +extern int erts_printf_add_cr_to_stdout; +extern int erts_printf_add_cr_to_stderr; +extern int (*erts_printf_block_fpe)(void); +extern void (*erts_printf_unblock_fpe)(int); + +typedef struct erts_dsprintf_buf_t_ erts_dsprintf_buf_t; + +struct erts_dsprintf_buf_t_ { + char *str; + size_t str_len; + size_t size; + erts_dsprintf_buf_t *(*grow)(erts_dsprintf_buf_t *, size_t); +}; + +#define ERTS_DSPRINTF_BUF_INITER(GFUNC) {NULL, 0, 0, (GFUNC)} + +int erts_printf(const char *, ...); +int erts_fprintf(FILE *, const char *, ...); +int erts_fdprintf(int, const char *, ...); +int erts_sprintf(char *, const char *, ...); +int erts_snprintf(char *, size_t, const char *, ...); +int erts_dsprintf(erts_dsprintf_buf_t *, const char *, ...); + +int erts_vprintf(const char *, va_list); +int erts_vfprintf(FILE *, const char *, va_list); +int erts_vfdprintf(int, const char *, va_list); +int erts_vsprintf(char *, const char *, va_list); +int erts_vsnprintf(char *, size_t, const char *, va_list); +int erts_vdsprintf(erts_dsprintf_buf_t *, const char *, va_list); + +#endif /* #ifndef ERL_PRINTF_H_ */ diff --git a/erts/include/internal/erl_printf_format.h b/erts/include/internal/erl_printf_format.h new file mode 100644 index 0000000000..45818079ea --- /dev/null +++ b/erts/include/internal/erl_printf_format.h @@ -0,0 +1,46 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifndef ERL_PRINTF_FORMAT_H__ +#define ERL_PRINTF_FORMAT_H__ + +#ifdef VXWORKS +#include +#endif + +#include +#include +#include + +typedef int (*fmtfn_t)(void*, char*, size_t); + +extern int erts_printf_format(fmtfn_t, void*, char*, va_list); + +extern int erts_printf_char(fmtfn_t, void*, char); +extern int erts_printf_string(fmtfn_t, void*, char *); +extern int erts_printf_buf(fmtfn_t, void*, char *, size_t); +extern int erts_printf_pointer(fmtfn_t, void*, void *); +extern int erts_printf_ulong(fmtfn_t, void*, char, int, int, unsigned long); +extern int erts_printf_slong(fmtfn_t, void*, char, int, int, signed long); +extern int erts_printf_double(fmtfn_t, void *, char, int, int, double); + +extern int (*erts_printf_eterm_func)(fmtfn_t, void*, unsigned long, long); + +#endif + diff --git a/erts/include/internal/erts_internal.mk.in b/erts/include/internal/erts_internal.mk.in new file mode 100644 index 0000000000..489531372c --- /dev/null +++ b/erts/include/internal/erts_internal.mk.in @@ -0,0 +1,24 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# ---------------------------------------------------------------------- + +ERTS_INTERNAL_X_LIBS=@ERTS_INTERNAL_X_LIBS@ + +# ---------------------------------------------------------------------- diff --git a/erts/include/internal/ethread.h b/erts/include/internal/ethread.h new file mode 100644 index 0000000000..934a79c6f9 --- /dev/null +++ b/erts/include/internal/ethread.h @@ -0,0 +1,1448 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Thread library for use in the ERTS and other OTP + * applications. + * Author: Rickard Green + */ + +#ifndef ETHREAD_H__ +#define ETHREAD_H__ + +#ifndef ETHR_HAVE_ETHREAD_DEFINES +# include "ethread_header_config.h" +#endif + +#include +#include "erl_errno.h" + +/* + * Extra memory barrier requirements: + * - ethr_atomic_or_old() needs to enforce a memory barrier sufficient + * for a lock operation. + * - ethr_atomic_and_old() needs to enforce a memory barrier sufficient + * for an unlock operation. + * - ethr_atomic_cmpxchg() needs to enforce a memory barrier sufficient + * for a lock and unlock operation. + */ + + +#undef ETHR_USE_RWMTX_FALLBACK +#undef ETHR_HAVE_OPTIMIZED_ATOMIC_OPS +#undef ETHR_HAVE_OPTIMIZED_LOCKS + +typedef struct { + long tv_sec; + long tv_nsec; +} ethr_timeval; + +#if defined(DEBUG) +# undef ETHR_XCHK +# define ETHR_XCHK 1 +#else +# ifndef ETHR_XCHK +# define ETHR_XCHK 0 +# endif +#endif + +#undef ETHR_INLINE +#if defined(__GNUC__) +# define ETHR_INLINE __inline__ +#elif defined(__WIN32__) +# define ETHR_INLINE __forceinline +#endif +#if defined(DEBUG) || !defined(ETHR_INLINE) || ETHR_XCHK \ + || (defined(__GNUC__) && defined(ERTS_MIXED_CYGWIN_VC)) +# undef ETHR_INLINE +# define ETHR_INLINE +# undef ETHR_TRY_INLINE_FUNCS +#endif +#ifdef ETHR_FORCE_INLINE_FUNCS +# define ETHR_TRY_INLINE_FUNCS +#endif + +#if !defined(ETHR_DISABLE_NATIVE_IMPLS) \ + && (defined(PURIFY) || defined(VALGRIND) || defined(ERTS_MIXED_CYGWIN_VC)) +# define ETHR_DISABLE_NATIVE_IMPLS +#endif + +#define ETHR_RWMUTEX_INITIALIZED 0x99999999 +#define ETHR_MUTEX_INITIALIZED 0x77777777 +#define ETHR_COND_INITIALIZED 0x55555555 + +#define ETHR_CACHE_LINE_SIZE 64 + +#ifdef ETHR_INLINE_FUNC_NAME_ +# define ETHR_CUSTOM_INLINE_FUNC_NAME_ +#else +# define ETHR_INLINE_FUNC_NAME_(X) X +#endif + +#define ETHR_COMPILER_BARRIER ethr_compiler_barrier() +#ifdef __GNUC__ +# undef ETHR_COMPILER_BARRIER +# define ETHR_COMPILER_BARRIER __asm__ __volatile__("":::"memory") +#endif + +#ifdef DEBUG +#define ETHR_ASSERT(A) \ + ((void) ((A) ? 1 : ethr_assert_failed(__FILE__, __LINE__, #A))) +int ethr_assert_failed(char *f, int l, char *a); +#else +#define ETHR_ASSERT(A) ((void) 1) +#endif + +#if defined(ETHR_PTHREADS) +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * The pthread implementation * +\* */ + +#if defined(__linux__) && !defined(_GNU_SOURCE) +#error "_GNU_SOURCE not defined. Please, compile all files with -D_GNU_SOURCE." +#endif + +#if defined(ETHR_HAVE_MIT_PTHREAD_H) +#include +#elif defined(ETHR_HAVE_PTHREAD_H) +#include +#endif + +/* Types */ + +typedef pthread_t ethr_tid; + +typedef struct ethr_mutex_ ethr_mutex; +struct ethr_mutex_ { + pthread_mutex_t pt_mtx; + int is_rec_mtx; + ethr_mutex *prev; + ethr_mutex *next; +#if ETHR_XCHK + int initialized; +#endif +}; + +typedef struct ethr_cond_ ethr_cond; +struct ethr_cond_ { + pthread_cond_t pt_cnd; +#if ETHR_XCHK + int initialized; +#endif +}; + +#ifndef ETHR_HAVE_PTHREAD_RWLOCK_INIT +#define ETHR_USE_RWMTX_FALLBACK +#else +typedef struct ethr_rwmutex_ ethr_rwmutex; +struct ethr_rwmutex_ { + pthread_rwlock_t pt_rwlock; +#if ETHR_XCHK + int initialized; +#endif +}; +#endif + +/* Static initializers */ +#if ETHR_XCHK +#define ETHR_MUTEX_XCHK_INITER , ETHR_MUTEX_INITIALIZED +#define ETHR_COND_XCHK_INITER , ETHR_COND_INITIALIZED +#else +#define ETHR_MUTEX_XCHK_INITER +#define ETHR_COND_XCHK_INITER +#endif + +#define ETHR_MUTEX_INITER {PTHREAD_MUTEX_INITIALIZER, 0, NULL, NULL ETHR_MUTEX_XCHK_INITER} +#define ETHR_COND_INITER {PTHREAD_COND_INITIALIZER ETHR_COND_XCHK_INITER} + +#if defined(ETHR_HAVE_PTHREAD_MUTEXATTR_SETTYPE) \ + || defined(ETHR_HAVE_PTHREAD_MUTEXATTR_SETKIND_NP) +# define ETHR_HAVE_ETHR_REC_MUTEX_INIT 1 +# ifdef PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP +# define ETHR_REC_MUTEX_INITER \ + {PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP, 1, NULL, NULL ETHR_MUTEX_XCHK_INITER} +# endif +#else +# undef ETHR_HAVE_ETHR_REC_MUTEX_INIT +#endif + +#ifndef ETHR_HAVE_PTHREAD_ATFORK +# define ETHR_NO_FORKSAFETY 1 +#endif + +typedef pthread_key_t ethr_tsd_key; + +#define ETHR_HAVE_ETHR_SIG_FUNCS 1 + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_mutex_trylock)(ethr_mutex *mtx) +{ + return pthread_mutex_trylock(&mtx->pt_mtx); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_mutex_lock)(ethr_mutex *mtx) +{ + return pthread_mutex_lock(&mtx->pt_mtx); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx) +{ + return pthread_mutex_unlock(&mtx->pt_mtx); +} + +#ifdef ETHR_HAVE_PTHREAD_RWLOCK_INIT + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwmutex_tryrlock)(ethr_rwmutex *rwmtx) +{ + return pthread_rwlock_tryrdlock(&rwmtx->pt_rwlock); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwmutex_rlock)(ethr_rwmutex *rwmtx) +{ + return pthread_rwlock_rdlock(&rwmtx->pt_rwlock); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwmutex_runlock)(ethr_rwmutex *rwmtx) +{ + return pthread_rwlock_unlock(&rwmtx->pt_rwlock); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwmutex_tryrwlock)(ethr_rwmutex *rwmtx) +{ + return pthread_rwlock_trywrlock(&rwmtx->pt_rwlock); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwmutex_rwlock)(ethr_rwmutex *rwmtx) +{ + return pthread_rwlock_wrlock(&rwmtx->pt_rwlock); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwmutex_rwunlock)(ethr_rwmutex *rwmtx) +{ + return pthread_rwlock_unlock(&rwmtx->pt_rwlock); +} + +#endif /* ETHR_HAVE_PTHREAD_RWLOCK_INIT */ + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#elif defined(ETHR_WIN32_THREADS) +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * The native win32 threads implementation * +\* */ + +#if !defined(_WIN32_WINNT) +#error "_WIN32_WINNT not defined. Please, compile all files with -D_WIN32_WINNT=0x0403" +#elif _WIN32_WINNT < 0x0403 +#error "_WIN32_WINNT defined to a value less than 0x0403. Please, compile all files with -D_WIN32_WINNT=0x0403" +#endif + +#ifdef WIN32_LEAN_AND_MEAN +# define ETHR_WIN32_LEAN_AND_MEAN_ALREADY_DEFINED +#else +# define WIN32_LEAN_AND_MEAN +#endif +#include +#ifndef ETHR_WIN32_LEAN_AND_MEAN_ALREADY_DEFINED +# undef WIN32_LEAN_AND_MEAN +#endif + +/* Types */ +typedef long ethr_tid; /* thread id type */ +typedef struct { + volatile int initialized; + CRITICAL_SECTION cs; +#if ETHR_XCHK + int is_rec_mtx; +#endif +} ethr_mutex; + +typedef struct cnd_wait_event__ cnd_wait_event_; + +typedef struct { + volatile int initialized; + CRITICAL_SECTION cs; + cnd_wait_event_ *queue; + cnd_wait_event_ *queue_end; +} ethr_cond; + +#define ETHR_USE_RWMTX_FALLBACK + +/* Static initializers */ + +#define ETHR_MUTEX_INITER {0} +#define ETHR_COND_INITER {0} + +#define ETHR_REC_MUTEX_INITER ETHR_MUTEX_INITER + +#define ETHR_HAVE_ETHR_REC_MUTEX_INIT 1 + +typedef DWORD ethr_tsd_key; + +#undef ETHR_HAVE_ETHR_SIG_FUNCS + +#ifdef ETHR_TRY_INLINE_FUNCS +int ethr_fake_static_mutex_init(ethr_mutex *mtx); + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_mutex_trylock)(ethr_mutex *mtx) +{ + if (!mtx->initialized) { + int res = ethr_fake_static_mutex_init(mtx); + if (res != 0) + return res; + } + return TryEnterCriticalSection(&mtx->cs) ? 0 : EBUSY; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_mutex_lock)(ethr_mutex *mtx) +{ + if (!mtx->initialized) { + int res = ethr_fake_static_mutex_init(mtx); + if (res != 0) + return res; + } + EnterCriticalSection(&mtx->cs); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_mutex_unlock)(ethr_mutex *mtx) +{ + LeaveCriticalSection(&mtx->cs); + return 0; +} + +#endif /* #ifdef ETHR_TRY_INLINE_FUNCS */ + +#ifdef ERTS_MIXED_CYGWIN_VC + +/* atomics */ + +#ifdef _MSC_VER +# if _MSC_VER < 1300 +# define ETHR_IMMED_ATOMIC_SET_GET_SAFE__ 0 /* Dont trust really old compilers */ +# else +# if defined(_M_IX86) +# define ETHR_IMMED_ATOMIC_SET_GET_SAFE__ 1 +# else /* I.e. IA64 */ +# if _MSC_VER >= 1400 +# define ETHR_IMMED_ATOMIC_SET_GET_SAFE__ 1 +# else +# define ETHR_IMMED_ATOMIC_SET_GET_SAFE__ 0 +# endif +# endif +# endif +# if _MSC_VER >= 1400 +# include +# undef ETHR_COMPILER_BARRIER +# define ETHR_COMPILER_BARRIER _ReadWriteBarrier() +# endif +#pragma intrinsic(_ReadWriteBarrier) +#pragma intrinsic(_InterlockedAnd) +#pragma intrinsic(_InterlockedOr) +#else +# define ETHR_IMMED_ATOMIC_SET_GET_SAFE__ 0 +#endif + +#define ETHR_HAVE_OPTIMIZED_ATOMIC_OPS 1 +#define ETHR_HAVE_OPTIMIZED_LOCKS 1 + +typedef struct { + volatile LONG value; +} ethr_atomic_t; + +typedef struct { + volatile LONG locked; +} ethr_spinlock_t; + +typedef struct { + volatile LONG counter; +} ethr_rwlock_t; +#define ETHR_WLOCK_FLAG__ (((LONG) 1) << 30) + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_init)(ethr_atomic_t *var, long i) +{ +#if ETHR_IMMED_ATOMIC_SET_GET_SAFE__ + var->value = (LONG) i; +#else + (void) InterlockedExchange(&var->value, (LONG) i); +#endif + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_set)(ethr_atomic_t *var, long i) +{ +#if ETHR_IMMED_ATOMIC_SET_GET_SAFE__ + var->value = (LONG) i; +#else + (void) InterlockedExchange(&var->value, (LONG) i); +#endif + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_read)(ethr_atomic_t *var, long *i) +{ +#if ETHR_IMMED_ATOMIC_SET_GET_SAFE__ + *i = var->value; +#else + *i = InterlockedExchangeAdd(&var->value, (LONG) 0); +#endif + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_add)(ethr_atomic_t *var, long incr) +{ + (void) InterlockedExchangeAdd(&var->value, (LONG) incr); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_addtest)(ethr_atomic_t *var, + long i, + long *testp) +{ + *testp = InterlockedExchangeAdd(&var->value, (LONG) i); + *testp += i; + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_inc)(ethr_atomic_t *var) +{ + (void) InterlockedIncrement(&var->value); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_dec)(ethr_atomic_t *var) +{ + (void) InterlockedDecrement(&var->value); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_inctest)(ethr_atomic_t *var, long *testp) +{ + *testp = (long) InterlockedIncrement(&var->value); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_dectest)(ethr_atomic_t *var, long *testp) +{ + *testp = (long) InterlockedDecrement(&var->value); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_and_old)(ethr_atomic_t *var, + long mask, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + * + * According to msdn _InterlockedAnd() provides a full + * memory barrier. + */ + *old = (long) _InterlockedAnd(&var->value, mask); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_or_old)(ethr_atomic_t *var, + long mask, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + * + * According to msdn _InterlockedOr() provides a full + * memory barrier. + */ + *old = (long) _InterlockedOr(&var->value, mask); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_cmpxchg)(ethr_atomic_t *var, + long new, + long expected, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + * + * According to msdn _InterlockedCompareExchange() provides a full + * memory barrier. + */ + *old = _InterlockedCompareExchange(&var->value, (LONG) new, (LONG) expected); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_xchg)(ethr_atomic_t *var, + long new, + long *old) +{ + *old = (long) InterlockedExchange(&var->value, (LONG) new); + return 0; +} + +/* + * According to msdn InterlockedExchange() provides a full + * memory barrier. + */ + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spinlock_init)(ethr_spinlock_t *lock) +{ +#if ETHR_IMMED_ATOMIC_SET_GET_SAFE__ + lock->locked = (LONG) 0; +#else + (void) InterlockedExchange(&lock->locked, (LONG) 0); +#endif + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spinlock_destroy)(ethr_spinlock_t *lock) +{ + return 0; +} + + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spin_unlock)(ethr_spinlock_t *lock) +{ + ETHR_COMPILER_BARRIER; + { +#ifdef DEBUG + LONG old = +#endif + InterlockedExchange(&lock->locked, (LONG) 0); +#ifdef DEBUG + ETHR_ASSERT(old == 1); +#endif + } + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spin_lock)(ethr_spinlock_t *lock) +{ + LONG old; + do { + old = InterlockedExchange(&lock->locked, (LONG) 1); + } while (old != (LONG) 0); + ETHR_COMPILER_BARRIER; + return 0; +} + +/* + * According to msdn InterlockedIncrement, InterlockedDecrement, + * and InterlockedExchangeAdd(), _InterlockedAnd, and _InterlockedOr + * provides full memory barriers. + */ +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwlock_init)(ethr_rwlock_t *lock) +{ +#if ETHR_IMMED_ATOMIC_SET_GET_SAFE__ + lock->counter = (LONG) 0; +#else + (void) InterlockedExchange(&lock->counter, (LONG) 0); +#endif + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwlock_destroy)(ethr_rwlock_t *lock) +{ + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_read_unlock)(ethr_rwlock_t *lock) +{ + ETHR_COMPILER_BARRIER; + { +#ifdef DEBUG + LONG old = +#endif + InterlockedDecrement(&lock->counter); + ETHR_ASSERT(old != 0); + } + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_read_lock)(ethr_rwlock_t *lock) +{ + while (1) { + LONG old = InterlockedIncrement(&lock->counter); + if ((old & ETHR_WLOCK_FLAG__) == 0) + break; /* Got read lock */ + /* Restore and wait for writers to unlock */ + old = InterlockedDecrement(&lock->counter); + while (old & ETHR_WLOCK_FLAG__) { +#if ETHR_IMMED_ATOMIC_SET_GET_SAFE__ + old = lock->counter; +#else + old = InterlockedExchangeAdd(&lock->counter, (LONG) 0); +#endif + } + } + ETHR_COMPILER_BARRIER; + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_write_unlock)(ethr_rwlock_t *lock) +{ + ETHR_COMPILER_BARRIER; + { +#ifdef DEBUG + LONG old = +#endif + _InterlockedAnd(&lock->counter, ~ETHR_WLOCK_FLAG__); + ETHR_ASSERT(old & ETHR_WLOCK_FLAG__); + } + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_write_lock)(ethr_rwlock_t *lock) +{ + LONG old; + do { + old = _InterlockedOr(&lock->counter, ETHR_WLOCK_FLAG__); + } while (old & ETHR_WLOCK_FLAG__); + /* We got the write part of the lock; wait for readers to unlock */ + while ((old & ~ETHR_WLOCK_FLAG__) != 0) { +#if ETHR_IMMED_ATOMIC_SET_GET_SAFE__ + old = lock->counter; +#else + old = InterlockedExchangeAdd(&lock->counter, (LONG) 0); +#endif + ETHR_ASSERT(old & ETHR_WLOCK_FLAG__); + } + ETHR_COMPILER_BARRIER; + return 0; +} + +#endif /* #ifdef ETHR_TRY_INLINE_FUNCS */ + +#endif /* #ifdef ERTS_MIXED_CYGWIN_VC */ + +#else /* No supported thread lib found */ + +#ifdef ETHR_NO_SUPP_THR_LIB_NOT_FATAL +#define ETHR_NO_THREAD_LIB +#else +#error "No supported thread lib found" +#endif + +#endif + +/* __builtin_expect() is needed by both native atomics code + * and the fallback code */ +#if !defined(__GNUC__) || (__GNUC__ < 2) || (__GNUC__ == 2 && __GNUC_MINOR__ < 96) +#define __builtin_expect(X, Y) (X) +#endif + +/* For CPU-optimised atomics, spinlocks, and rwlocks. */ +#if !defined(ETHR_DISABLE_NATIVE_IMPLS) && defined(__GNUC__) +# if ETHR_SIZEOF_PTR == 4 +# if defined(__i386__) +# include "i386/ethread.h" +# elif (defined(__powerpc__) || defined(__ppc__)) && !defined(__powerpc64__) +# include "ppc32/ethread.h" +# elif defined(__sparc__) +# include "sparc32/ethread.h" +# elif defined(__tile__) +# include "tile/ethread.h" +# endif +# elif ETHR_SIZEOF_PTR == 8 +# if defined(__x86_64__) +# include "x86_64/ethread.h" +# elif defined(__sparc__) && defined(__arch64__) +# include "sparc64/ethread.h" +# endif +# endif +#endif /* !defined(ETHR_DISABLE_NATIVE_IMPLS) && defined(__GNUC__) */ + +#ifdef ETHR_HAVE_OPTIMIZED_ATOMIC_OPS +# undef ETHR_HAVE_NATIVE_ATOMICS +#endif +#ifdef ETHR_HAVE_OPTIMIZED_LOCKS +# undef ETHR_HAVE_NATIVE_LOCKS +#endif + +#ifdef ETHR_HAVE_NATIVE_ATOMICS +#define ETHR_HAVE_OPTIMIZED_ATOMIC_OPS 1 +#endif +#ifdef ETHR_HAVE_NATIVE_LOCKS +#define ETHR_HAVE_OPTIMIZED_LOCKS 1 +#endif + +typedef struct { + unsigned open; + ethr_mutex mtx; + ethr_cond cnd; +} ethr_gate; + +#ifdef ETHR_HAVE_NATIVE_ATOMICS +/* + * Map ethread native atomics to ethread API atomics. + */ +typedef ethr_native_atomic_t ethr_atomic_t; +#endif + +#ifdef ETHR_HAVE_NATIVE_LOCKS +/* + * Map ethread native spinlocks to ethread API spinlocks. + */ +typedef ethr_native_spinlock_t ethr_spinlock_t; +/* + * Map ethread native rwlocks to ethread API rwlocks. + */ +typedef ethr_native_rwlock_t ethr_rwlock_t; +#endif + +#ifdef ETHR_USE_RWMTX_FALLBACK +typedef struct { + ethr_mutex mtx; + ethr_cond rcnd; + ethr_cond wcnd; + unsigned readers; + unsigned waiting_readers; + unsigned waiting_writers; +#if ETHR_XCHK + int initialized; +#endif +} ethr_rwmutex; +#endif + +#ifndef ETHR_HAVE_OPTIMIZED_ATOMIC_OPS +typedef long ethr_atomic_t; +#endif + +#ifndef ETHR_HAVE_OPTIMIZED_LOCKS + +#if defined(ETHR_WIN32_THREADS) +typedef struct { + CRITICAL_SECTION cs; +} ethr_spinlock_t; +typedef struct { + CRITICAL_SECTION cs; + unsigned counter; +} ethr_rwlock_t; + +int ethr_do_spinlock_init(ethr_spinlock_t *lock); +int ethr_do_rwlock_init(ethr_rwlock_t *lock); + +#define ETHR_RWLOCK_WRITERS (((unsigned) 1) << 31) + +#elif defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) +typedef struct { + pthread_spinlock_t spnlck; +} ethr_spinlock_t; +typedef struct { + pthread_spinlock_t spnlck; + unsigned counter; +} ethr_rwlock_t; +#define ETHR_RWLOCK_WRITERS (((unsigned) 1) << 31) + +#else /* ethr mutex/rwmutex */ + +typedef struct { + ethr_mutex mtx; +} ethr_spinlock_t; + +typedef struct { + ethr_rwmutex rwmtx; +} ethr_rwlock_t; + +#endif /* end mutex/rwmutex */ +#endif /* ETHR_HAVE_OPTIMIZED_LOCKS */ + +typedef struct { + void *(*alloc)(size_t); + void *(*realloc)(void *, size_t); + void (*free)(void *); + void *(*thread_create_prepare_func)(void); + void (*thread_create_parent_func)(void *); + void (*thread_create_child_func)(void *); +} ethr_init_data; + +#define ETHR_INIT_DATA_DEFAULT_INITER {malloc, realloc, free, NULL, NULL, NULL} + +typedef struct { + int detached; /* boolean (default false) */ + int suggested_stack_size; /* kilo words (default sys dependent) */ +} ethr_thr_opts; + +#define ETHR_THR_OPTS_DEFAULT_INITER {0, -1} + +#if defined(ETHR_CUSTOM_INLINE_FUNC_NAME_) || !defined(ETHR_TRY_INLINE_FUNCS) +# define ETHR_NEED_MTX_PROTOTYPES__ +# define ETHR_NEED_RWMTX_PROTOTYPES__ +# define ETHR_NEED_SPINLOCK_PROTOTYPES__ +# define ETHR_NEED_ATOMIC_PROTOTYPES__ +#endif + +#if !defined(ETHR_NEED_RWMTX_PROTOTYPES__) && defined(ETHR_USE_RWMTX_FALLBACK) +# define ETHR_NEED_RWMTX_PROTOTYPES__ +#endif + +int ethr_init(ethr_init_data *); +int ethr_install_exit_handler(void (*funcp)(void)); +int ethr_thr_create(ethr_tid *, void * (*)(void *), void *, ethr_thr_opts *); +int ethr_thr_join(ethr_tid, void **); +int ethr_thr_detach(ethr_tid); +void ethr_thr_exit(void *); +ethr_tid ethr_self(void); +int ethr_equal_tids(ethr_tid, ethr_tid); +int ethr_mutex_init(ethr_mutex *); +#ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT +int ethr_rec_mutex_init(ethr_mutex *); +#endif +int ethr_mutex_destroy(ethr_mutex *); +int ethr_mutex_set_forksafe(ethr_mutex *); +int ethr_mutex_unset_forksafe(ethr_mutex *); +#ifdef ETHR_NEED_MTX_PROTOTYPES__ +int ethr_mutex_trylock(ethr_mutex *); +int ethr_mutex_lock(ethr_mutex *); +int ethr_mutex_unlock(ethr_mutex *); +#endif +int ethr_cond_init(ethr_cond *); +int ethr_cond_destroy(ethr_cond *); +int ethr_cond_signal(ethr_cond *); +int ethr_cond_broadcast(ethr_cond *); +int ethr_cond_wait(ethr_cond *, ethr_mutex *); +int ethr_cond_timedwait(ethr_cond *, ethr_mutex *, ethr_timeval *); + +int ethr_rwmutex_init(ethr_rwmutex *); +int ethr_rwmutex_destroy(ethr_rwmutex *); +#ifdef ETHR_NEED_RWMTX_PROTOTYPES__ +int ethr_rwmutex_tryrlock(ethr_rwmutex *); +int ethr_rwmutex_rlock(ethr_rwmutex *); +int ethr_rwmutex_runlock(ethr_rwmutex *); +int ethr_rwmutex_tryrwlock(ethr_rwmutex *); +int ethr_rwmutex_rwlock(ethr_rwmutex *); +int ethr_rwmutex_rwunlock(ethr_rwmutex *); +#endif + +#ifdef ETHR_NEED_ATOMIC_PROTOTYPES__ +int ethr_atomic_init(ethr_atomic_t *, long); +int ethr_atomic_set(ethr_atomic_t *, long); +int ethr_atomic_read(ethr_atomic_t *, long *); +int ethr_atomic_inctest(ethr_atomic_t *, long *); +int ethr_atomic_dectest(ethr_atomic_t *, long *); +int ethr_atomic_inc(ethr_atomic_t *); +int ethr_atomic_dec(ethr_atomic_t *); +int ethr_atomic_addtest(ethr_atomic_t *, long, long *); +int ethr_atomic_add(ethr_atomic_t *, long); +int ethr_atomic_and_old(ethr_atomic_t *, long, long *); +int ethr_atomic_or_old(ethr_atomic_t *, long, long *); +int ethr_atomic_xchg(ethr_atomic_t *, long, long *); +int ethr_atomic_cmpxchg(ethr_atomic_t *, long, long, long *); +#endif + +#ifdef ETHR_NEED_SPINLOCK_PROTOTYPES__ +int ethr_spinlock_init(ethr_spinlock_t *); +int ethr_spinlock_destroy(ethr_spinlock_t *); +int ethr_spin_unlock(ethr_spinlock_t *); +int ethr_spin_lock(ethr_spinlock_t *); + +int ethr_rwlock_init(ethr_rwlock_t *); +int ethr_rwlock_destroy(ethr_rwlock_t *); +int ethr_read_unlock(ethr_rwlock_t *); +int ethr_read_lock(ethr_rwlock_t *); +int ethr_write_unlock(ethr_rwlock_t *); +int ethr_write_lock(ethr_rwlock_t *); +#endif + +int ethr_time_now(ethr_timeval *); +int ethr_tsd_key_create(ethr_tsd_key *); +int ethr_tsd_key_delete(ethr_tsd_key); +int ethr_tsd_set(ethr_tsd_key, void *); +void *ethr_tsd_get(ethr_tsd_key); + +int ethr_gate_init(ethr_gate *); +int ethr_gate_destroy(ethr_gate *); +int ethr_gate_close(ethr_gate *); +int ethr_gate_let_through(ethr_gate *, unsigned); +int ethr_gate_wait(ethr_gate *); +int ethr_gate_swait(ethr_gate *, int); + +#ifdef ETHR_HAVE_ETHR_SIG_FUNCS +#include +int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset); +int ethr_sigwait(const sigset_t *set, int *sig); +#endif + +void ethr_compiler_barrier(void); + +#ifdef ETHR_TRY_INLINE_FUNCS + +#ifdef ETHR_HAVE_NATIVE_ATOMICS + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_init)(ethr_atomic_t *var, long i) +{ + ethr_native_atomic_init(var, i); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_set)(ethr_atomic_t *var, long i) +{ + ethr_native_atomic_set(var, i); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_read)(ethr_atomic_t *var, long *i) +{ + *i = ethr_native_atomic_read(var); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_add)(ethr_atomic_t *var, long incr) +{ + ethr_native_atomic_add(var, incr); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_addtest)(ethr_atomic_t *var, + long i, + long *testp) +{ + *testp = ethr_native_atomic_add_return(var, i); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_inc)(ethr_atomic_t *var) +{ + ethr_native_atomic_inc(var); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_dec)(ethr_atomic_t *var) +{ + ethr_native_atomic_dec(var); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_inctest)(ethr_atomic_t *var, long *testp) +{ + *testp = ethr_native_atomic_inc_return(var); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_dectest)(ethr_atomic_t *var, long *testp) +{ + *testp = ethr_native_atomic_dec_return(var); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_and_old)(ethr_atomic_t *var, + long mask, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + */ + *old = ethr_native_atomic_and_retold(var, mask); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_or_old)(ethr_atomic_t *var, + long mask, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + */ + *old = ethr_native_atomic_or_retold(var, mask); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_xchg)(ethr_atomic_t *var, + long new, + long *old) +{ + *old = ethr_native_atomic_xchg(var, new); + return 0; +} + +/* + * If *var == *old, replace *old with new, else do nothing. + * In any case return the original value of *var in *old. + */ +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_cmpxchg)(ethr_atomic_t *var, + long new, + long expected, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + */ + *old = ethr_native_atomic_cmpxchg(var, new, expected); + return 0; +} + +#endif /* ETHR_HAVE_NATIVE_ATOMICS */ + +#ifdef ETHR_HAVE_NATIVE_LOCKS + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spinlock_init)(ethr_spinlock_t *lock) +{ + ethr_native_spinlock_init(lock); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spinlock_destroy)(ethr_spinlock_t *lock) +{ + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spin_unlock)(ethr_spinlock_t *lock) +{ + ethr_native_spin_unlock(lock); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spin_lock)(ethr_spinlock_t *lock) +{ + ethr_native_spin_lock(lock); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwlock_init)(ethr_rwlock_t *lock) +{ + ethr_native_rwlock_init(lock); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwlock_destroy)(ethr_rwlock_t *lock) +{ + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_read_unlock)(ethr_rwlock_t *lock) +{ + ethr_native_read_unlock(lock); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_read_lock)(ethr_rwlock_t *lock) +{ + ethr_native_read_lock(lock); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_write_unlock)(ethr_rwlock_t *lock) +{ + ethr_native_write_unlock(lock); + return 0; +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_write_lock)(ethr_rwlock_t *lock) +{ + ethr_native_write_lock(lock); + return 0; +} + +#endif /* ETHR_HAVE_NATIVE_LOCKS */ + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +/* + * Fallbacks for atomics used in absence of optimized implementation. + */ +#ifndef ETHR_HAVE_OPTIMIZED_ATOMIC_OPS + +#define ETHR_ATOMIC_ADDR_BITS 4 +#define ETHR_ATOMIC_ADDR_SHIFT 3 + +typedef struct { + union { +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + pthread_spinlock_t spnlck; +#else + ethr_mutex mtx; +#endif + char buf[ETHR_CACHE_LINE_SIZE]; + } u; +} ethr_atomic_protection_t; + +extern ethr_atomic_protection_t ethr_atomic_protection__[1 << ETHR_ATOMIC_ADDR_BITS]; + + +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + +#define ETHR_ATOMIC_PTR2LCK__(PTR) \ +(ðr_atomic_protection__[((((unsigned long) (PTR)) >> ETHR_ATOMIC_ADDR_SHIFT) \ + & ((1 << ETHR_ATOMIC_ADDR_BITS) - 1))].u.spnlck) + + +#define ETHR_ATOMIC_OP_FALLBACK_IMPL__(AP, EXPS) \ +do { \ + pthread_spinlock_t *slp__ = ETHR_ATOMIC_PTR2LCK__((AP)); \ + int res__ = pthread_spin_lock(slp__); \ + if (res__ != 0) \ + return res__; \ + { EXPS; } \ + return pthread_spin_unlock(slp__); \ +} while (0) + +#else /* ethread mutex */ + +#define ETHR_ATOMIC_PTR2LCK__(PTR) \ +(ðr_atomic_protection__[((((unsigned long) (PTR)) >> ETHR_ATOMIC_ADDR_SHIFT) \ + & ((1 << ETHR_ATOMIC_ADDR_BITS) - 1))].u.mtx) + +#define ETHR_ATOMIC_OP_FALLBACK_IMPL__(AP, EXPS) \ +do { \ + ethr_mutex *mtxp__ = ETHR_ATOMIC_PTR2LCK__((AP)); \ + int res__ = ETHR_INLINE_FUNC_NAME_(ethr_mutex_lock)(mtxp__); \ + if (res__ != 0) \ + return res__; \ + { EXPS; } \ + return ETHR_INLINE_FUNC_NAME_(ethr_mutex_unlock)(mtxp__); \ +} while (0) + +#endif /* end ethread mutex */ + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_init)(ethr_atomic_t *var, long i) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(var, *var = (ethr_atomic_t) i); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_set)(ethr_atomic_t *var, long i) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(var, *var = (ethr_atomic_t) i); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_read)(ethr_atomic_t *var, long *i) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(var, *i = (long) *var); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_inctest)(ethr_atomic_t *incp, long *testp) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(incp, *testp = (long) ++(*incp)); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_dectest)(ethr_atomic_t *decp, long *testp) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(decp, *testp = (long) --(*decp)); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_add)(ethr_atomic_t *var, long incr) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(var, *var += incr); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_addtest)(ethr_atomic_t *incp, + long i, + long *testp) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(incp, *incp += i; *testp = *incp); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_inc)(ethr_atomic_t *incp) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(incp, ++(*incp)); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_dec)(ethr_atomic_t *decp) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(decp, --(*decp)); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_and_old)(ethr_atomic_t *var, + long mask, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + */ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(var, *old = *var; *var &= mask); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_or_old)(ethr_atomic_t *var, + long mask, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + */ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(var, *old = *var; *var |= mask); +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_xchg)(ethr_atomic_t *var, + long new, + long *old) +{ + ETHR_ATOMIC_OP_FALLBACK_IMPL__(var, *old = *var; *var = new); +} + +/* + * If *var == *old, replace *old with new, else do nothing. + * In any case return the original value of *var in *old. + */ +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_atomic_cmpxchg)(ethr_atomic_t *var, + long new, + long expected, + long *old) +{ + /* + * See "Extra memory barrier requirements" note at the top + * of the file. + */ + ETHR_ATOMIC_OP_FALLBACK_IMPL__( + var, + long old_val = *var; + *old = old_val; + if (__builtin_expect(old_val == expected, 1)) + *var = new; + ); + return 0; +} + +#endif /* #ifdef ETHR_TRY_INLINE_FUNCS */ +#endif /* #ifndef ETHR_HAVE_OPTIMIZED_ATOMIC_OPS */ + +/* + * Fallbacks for spin locks, and rw spin locks used in absence of + * optimized implementation. + */ +#ifndef ETHR_HAVE_OPTIMIZED_LOCKS + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spinlock_init)(ethr_spinlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + return pthread_spin_init(&lock->spnlck, 0); +#else + return ethr_mutex_init(&lock->mtx); +#endif +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spinlock_destroy)(ethr_spinlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + return pthread_spin_destroy(&lock->spnlck); +#else + return ethr_mutex_destroy(&lock->mtx); +#endif +} + + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spin_unlock)(ethr_spinlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + return pthread_spin_unlock(&lock->spnlck); +#else + return ETHR_INLINE_FUNC_NAME_(ethr_mutex_unlock)(&lock->mtx); +#endif +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_spin_lock)(ethr_spinlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + return pthread_spin_lock(&lock->spnlck); +#else + return ETHR_INLINE_FUNC_NAME_(ethr_mutex_lock)(&lock->mtx); +#endif +} + +#ifdef ETHR_USE_RWMTX_FALLBACK +#define ETHR_RWLOCK_RWMTX_FALLBACK_NAME_(X) X +#else +#define ETHR_RWLOCK_RWMTX_FALLBACK_NAME_(X) ETHR_INLINE_FUNC_NAME_(X) +#endif + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwlock_init)(ethr_rwlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + lock->counter = 0; + return pthread_spin_init(&lock->spnlck, 0); +#else + return ethr_rwmutex_init(&lock->rwmtx); +#endif +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_rwlock_destroy)(ethr_rwlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + return pthread_spin_destroy(&lock->spnlck); +#else + return ethr_rwmutex_destroy(&lock->rwmtx); +#endif +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_read_unlock)(ethr_rwlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + int res = pthread_spin_lock(&lock->spnlck); + if (res != 0) + return res; + lock->counter--; + return pthread_spin_unlock(&lock->spnlck); +#else + return ETHR_RWLOCK_RWMTX_FALLBACK_NAME_(ethr_rwmutex_runlock)(&lock->rwmtx); +#endif +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_read_lock)(ethr_rwlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + int locked = 0; + do { + int res = pthread_spin_lock(&lock->spnlck); + if (res != 0) + return res; + if ((lock->counter & ETHR_RWLOCK_WRITERS) == 0) { + lock->counter++; + locked = 1; + } + res = pthread_spin_unlock(&lock->spnlck); + if (res != 0) + return res; + } while (!locked); + return 0; +#else + return ETHR_RWLOCK_RWMTX_FALLBACK_NAME_(ethr_rwmutex_rlock)(&lock->rwmtx); +#endif +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_write_unlock)(ethr_rwlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + lock->counter = 0; + return pthread_spin_unlock(&lock->spnlck); +#else + return ETHR_RWLOCK_RWMTX_FALLBACK_NAME_(ethr_rwmutex_rwunlock)(&lock->rwmtx); +#endif +} + +static ETHR_INLINE int +ETHR_INLINE_FUNC_NAME_(ethr_write_lock)(ethr_rwlock_t *lock) +{ +#if defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) + while (1) { + int res = pthread_spin_lock(&lock->spnlck); + if (res != 0) + return res; + lock->counter |= ETHR_RWLOCK_WRITERS; + if (lock->counter == ETHR_RWLOCK_WRITERS) + return 0; + res = pthread_spin_unlock(&lock->spnlck); + if (res != 0) + return res; + } +#else + return ETHR_RWLOCK_RWMTX_FALLBACK_NAME_(ethr_rwmutex_rwlock)(&lock->rwmtx); +#endif +} + +#endif /* #ifdef ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHR_HAVE_OPTIMIZED_LOCKS */ + +#if defined(ETHR_HAVE_OPTIMIZED_LOCKS) || defined(ETHR_HAVE_PTHREAD_SPIN_LOCK) +# define ETHR_HAVE_OPTIMIZED_SPINLOCK +#endif + +#endif /* #ifndef ETHREAD_H__ */ diff --git a/erts/include/internal/ethread.mk.in b/erts/include/internal/ethread.mk.in new file mode 100644 index 0000000000..13071711e1 --- /dev/null +++ b/erts/include/internal/ethread.mk.in @@ -0,0 +1,39 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +# ---------------------------------------------------------------------- + + +# Name of the library where the ethread implementation is located +ETHR_LIB_NAME=@ETHR_LIB_NAME@ + +# Command-line defines to use when compiling +ETHR_DEFS=@ETHR_DEFS@ + +# Libraries to link with when linking +ETHR_LIBS=@ETHR_LIBS@ + +# Extra libraries to link with. The same as ETHR_LIBS except that the +# ethread library itself is not included. +ETHR_X_LIBS=@ETHR_X_LIBS@ + +# The name of the thread library which the ethread library is based on. +ETHR_THR_LIB_BASE=@ETHR_THR_LIB_BASE@ + +# ---------------------------------------------------------------------- diff --git a/erts/include/internal/ethread_header_config.h.in b/erts/include/internal/ethread_header_config.h.in new file mode 100644 index 0000000000..e5b4946a53 --- /dev/null +++ b/erts/include/internal/ethread_header_config.h.in @@ -0,0 +1,55 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Define to the size of pointers */ +#undef ETHR_SIZEOF_PTR + +/* Define if you want to disable native ethread implementations */ +#undef ETHR_DISABLE_NATIVE_IMPLS + +/* Define if you have win32 threads */ +#undef ETHR_WIN32_THREADS + +/* Define if you have pthreads */ +#undef ETHR_PTHREADS + +/* Define if you have the header file. */ +#undef ETHR_HAVE_PTHREAD_H + +/* Define if the pthread.h header file is in pthread/mit directory. */ +#undef ETHR_HAVE_MIT_PTHREAD_H + +/* Define if you have the pthread_mutexattr_settype function. */ +#undef ETHR_HAVE_PTHREAD_MUTEXATTR_SETTYPE + +/* Define if you have the pthread_mutexattr_setkind_np function. */ +#undef ETHR_HAVE_PTHREAD_MUTEXATTR_SETKIND_NP + +/* Define if you have the pthread_atfork function. */ +#undef ETHR_HAVE_PTHREAD_ATFORK + +/* Define if you have the pthread_spin_lock function. */ +#undef ETHR_HAVE_PTHREAD_SPIN_LOCK + +/* Define if you have a pthread_rwlock implementation that can be used */ +#undef ETHR_HAVE_PTHREAD_RWLOCK_INIT + +/* Define if you want to turn on extra sanity checking in the ethread library */ +#undef ETHR_XCHK + diff --git a/erts/include/internal/i386/atomic.h b/erts/include/internal/i386/atomic.h new file mode 100644 index 0000000000..3291ad38e5 --- /dev/null +++ b/erts/include/internal/i386/atomic.h @@ -0,0 +1,155 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread atomics on x86/x86-64. + * Author: Mikael Pettersson. + * + * This code requires a 486 or newer processor. + */ +#ifndef ETHREAD_I386_ATOMIC_H +#define ETHREAD_I386_ATOMIC_H + +/* An atomic is an aligned long accessed via locked operations. + */ +typedef struct { + volatile long counter; +} ethr_native_atomic_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +#ifdef __x86_64__ +#define LONG_SUFFIX "q" +#else +#define LONG_SUFFIX "l" +#endif + +static ETHR_INLINE void +ethr_native_atomic_init(ethr_native_atomic_t *var, long i) +{ + var->counter = i; +} +#define ethr_native_atomic_set(v, i) ethr_native_atomic_init((v), (i)) + +static ETHR_INLINE long +ethr_native_atomic_read(ethr_native_atomic_t *var) +{ + return var->counter; +} + +static ETHR_INLINE void +ethr_native_atomic_add(ethr_native_atomic_t *var, long incr) +{ + __asm__ __volatile__( + "lock; add" LONG_SUFFIX " %1, %0" + : "=m"(var->counter) + : "ir"(incr), "m"(var->counter)); +} + +static ETHR_INLINE void +ethr_native_atomic_inc(ethr_native_atomic_t *var) +{ + __asm__ __volatile__( + "lock; inc" LONG_SUFFIX " %0" + : "=m"(var->counter) + : "m"(var->counter)); +} + +static ETHR_INLINE void +ethr_native_atomic_dec(ethr_native_atomic_t *var) +{ + __asm__ __volatile__( + "lock; dec" LONG_SUFFIX " %0" + : "=m"(var->counter) + : "m"(var->counter)); +} + +static ETHR_INLINE long +ethr_native_atomic_add_return(ethr_native_atomic_t *var, long incr) +{ + long tmp; + + tmp = incr; + __asm__ __volatile__( + "lock; xadd" LONG_SUFFIX " %0, %1" /* xadd didn't exist prior to the 486 */ + : "=r"(tmp) + : "m"(var->counter), "0"(tmp)); + /* now tmp is the atomic's previous value */ + return tmp + incr; +} + +#define ethr_native_atomic_inc_return(var) ethr_native_atomic_add_return((var), 1) +#define ethr_native_atomic_dec_return(var) ethr_native_atomic_add_return((var), -1) + +static ETHR_INLINE long +ethr_native_atomic_cmpxchg(ethr_native_atomic_t *var, long new, long old) +{ + __asm__ __volatile__( + "lock; cmpxchg" LONG_SUFFIX " %2, %3" + : "=a"(old), "=m"(var->counter) + : "r"(new), "m"(var->counter), "0"(old) + : "cc", "memory"); /* full memory clobber to make this a compiler barrier */ + return old; +} + +static ETHR_INLINE long +ethr_native_atomic_and_retold(ethr_native_atomic_t *var, long mask) +{ + long tmp, old; + + tmp = var->counter; + do { + old = tmp; + tmp = ethr_native_atomic_cmpxchg(var, tmp & mask, tmp); + } while (__builtin_expect(tmp != old, 0)); + /* now tmp is the atomic's previous value */ + return tmp; +} + +static ETHR_INLINE long +ethr_native_atomic_or_retold(ethr_native_atomic_t *var, long mask) +{ + long tmp, old; + + tmp = var->counter; + do { + old = tmp; + tmp = ethr_native_atomic_cmpxchg(var, tmp | mask, tmp); + } while (__builtin_expect(tmp != old, 0)); + /* now tmp is the atomic's previous value */ + return tmp; +} + +static ETHR_INLINE long +ethr_native_atomic_xchg(ethr_native_atomic_t *var, long val) +{ + long tmp = val; + __asm__ __volatile__( + "xchg" LONG_SUFFIX " %0, %1" + : "=r"(tmp) + : "m"(var->counter), "0"(tmp)); + /* now tmp is the atomic's previous value */ + return tmp; +} + +#undef LONG_SUFFIX + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHREAD_I386_ATOMIC_H */ diff --git a/erts/include/internal/i386/ethread.h b/erts/include/internal/i386/ethread.h new file mode 100644 index 0000000000..fad8b108fa --- /dev/null +++ b/erts/include/internal/i386/ethread.h @@ -0,0 +1,34 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Low-level ethread support on x86/x86-64. + * Author: Mikael Pettersson. + */ +#ifndef ETHREAD_I386_ETHREAD_H +#define ETHREAD_I386_ETHREAD_H + +#include "atomic.h" +#include "spinlock.h" +#include "rwlock.h" + +#define ETHR_HAVE_NATIVE_ATOMICS 1 +#define ETHR_HAVE_NATIVE_LOCKS 1 + +#endif /* ETHREAD_I386_ETHREAD_H */ diff --git a/erts/include/internal/i386/rwlock.h b/erts/include/internal/i386/rwlock.h new file mode 100644 index 0000000000..c009be8ef1 --- /dev/null +++ b/erts/include/internal/i386/rwlock.h @@ -0,0 +1,134 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread rwlocks on x86/x86-64. + * Author: Mikael Pettersson. + * + * This code requires a 486 or newer processor. + */ +#ifndef ETHREAD_I386_RWLOCK_H +#define ETHREAD_I386_RWLOCK_H + +/* XXX: describe the algorithm */ +typedef struct { + volatile int lock; +} ethr_native_rwlock_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +#define ETHR_RWLOCK_OFFSET (1<<24) + +static ETHR_INLINE void +ethr_native_rwlock_init(ethr_native_rwlock_t *lock) +{ + lock->lock = 0; +} + +static ETHR_INLINE void +ethr_native_read_unlock(ethr_native_rwlock_t *lock) +{ + __asm__ __volatile__( + "lock; decl %0" + : "=m"(lock->lock) + : "m"(lock->lock)); +} + +static ETHR_INLINE int +ethr_native_read_trylock(ethr_native_rwlock_t *lock) +{ + int tmp; + + tmp = 1; + __asm__ __volatile__( + "lock; xaddl %0, %1" + : "=r"(tmp) + : "m"(lock->lock), "0"(tmp)); + /* tmp is now the lock's previous value */ + if (__builtin_expect(tmp >= 0, 1)) + return 1; + ethr_native_read_unlock(lock); + return 0; +} + +static ETHR_INLINE int +ethr_native_read_is_locked(ethr_native_rwlock_t *lock) +{ + return lock->lock < 0; +} + +static ETHR_INLINE void +ethr_native_read_lock(ethr_native_rwlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_read_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("rep;nop" : "=m"(lock->lock) : : "memory"); + } while (ethr_native_read_is_locked(lock)); + } +} + +static ETHR_INLINE void +ethr_native_write_unlock(ethr_native_rwlock_t *lock) +{ + __asm__ __volatile__( + "lock; addl %2,%0" + : "=m"(lock->lock) + : "m"(lock->lock), "i"(ETHR_RWLOCK_OFFSET)); +} + +static ETHR_INLINE int +ethr_native_write_trylock(ethr_native_rwlock_t *lock) +{ + int tmp; + + tmp = -ETHR_RWLOCK_OFFSET; + __asm__ __volatile__( + "lock; xaddl %0, %1" + : "=r"(tmp) + : "m"(lock->lock), "0"(tmp)); + /* tmp is now the lock's previous value */ + if (__builtin_expect(tmp == 0, 1)) + return 1; + ethr_native_write_unlock(lock); + return 0; +} + +static ETHR_INLINE int +ethr_native_write_is_locked(ethr_native_rwlock_t *lock) +{ + return lock->lock != 0; +} + +static ETHR_INLINE void +ethr_native_write_lock(ethr_native_rwlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_write_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("rep;nop" : "=m"(lock->lock) : : "memory"); + } while (ethr_native_write_is_locked(lock)); + } +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHREAD_I386_RWLOCK_H */ diff --git a/erts/include/internal/i386/spinlock.h b/erts/include/internal/i386/spinlock.h new file mode 100644 index 0000000000..2b4832e26a --- /dev/null +++ b/erts/include/internal/i386/spinlock.h @@ -0,0 +1,92 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread spinlocks on x86/x86-64. + * Author: Mikael Pettersson. + */ +#ifndef ETHREAD_I386_SPINLOCK_H +#define ETHREAD_I386_SPINLOCK_H + +/* A spinlock is the low byte of an aligned 32-bit integer. + * A non-zero value means that the lock is locked. + */ +typedef struct { + volatile unsigned int lock; +} ethr_native_spinlock_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE void +ethr_native_spinlock_init(ethr_native_spinlock_t *lock) +{ + lock->lock = 0; +} + +static ETHR_INLINE void +ethr_native_spin_unlock(ethr_native_spinlock_t *lock) +{ + /* To unlock we move 0 to the lock. + * On i386 this needs to be a locked operation + * to avoid Pentium Pro errata 66 and 92. + */ +#if defined(__x86_64__) + __asm__ __volatile__("" : : : "memory"); + *(unsigned char*)&lock->lock = 0; +#else + char tmp = 0; + __asm__ __volatile__( + "xchgb %b0, %1" + : "=q"(tmp), "=m"(lock->lock) + : "0"(tmp) : "memory"); +#endif +} + +static ETHR_INLINE int +ethr_native_spin_trylock(ethr_native_spinlock_t *lock) +{ + char tmp = 1; + __asm__ __volatile__( + "xchgb %b0, %1" + : "=q"(tmp), "=m"(lock->lock) + : "0"(tmp) : "memory"); + return tmp == 0; +} + +static ETHR_INLINE int +ethr_native_spin_is_locked(ethr_native_spinlock_t *lock) +{ + return *(volatile unsigned char*)&lock->lock != 0; +} + +static ETHR_INLINE void +ethr_native_spin_lock(ethr_native_spinlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_spin_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("rep;nop" : "=m"(lock->lock) : : "memory"); + } while (ethr_native_spin_is_locked(lock)); + } +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHREAD_I386_SPINLOCK_H */ diff --git a/erts/include/internal/ppc32/atomic.h b/erts/include/internal/ppc32/atomic.h new file mode 100644 index 0000000000..fa701c6a92 --- /dev/null +++ b/erts/include/internal/ppc32/atomic.h @@ -0,0 +1,209 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread atomics on PowerPC. + * Author: Mikael Pettersson. + * + * Based on the examples in Appendix E of Motorola's + * "Programming Environments Manual For 32-Bit Implementations + * of the PowerPC Architecture". + */ +#ifndef ETHREAD_PPC_ATOMIC_H +#define ETHREAD_PPC_ATOMIC_H + +typedef struct { + volatile int counter; +} ethr_native_atomic_t; + + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE void +ethr_native_atomic_init(ethr_native_atomic_t *var, int i) +{ + var->counter = i; +} +#define ethr_native_atomic_set(v, i) ethr_native_atomic_init((v), (i)) + +static ETHR_INLINE int +ethr_native_atomic_read(ethr_native_atomic_t *var) +{ + return var->counter; +} + +static ETHR_INLINE int +ethr_native_atomic_add_return(ethr_native_atomic_t *var, int incr) +{ + int tmp; + + __asm__ __volatile__( + "eieio\n\t" + "1:\t" + "lwarx %0,0,%1\n\t" + "add %0,%2,%0\n\t" + "stwcx. %0,0,%1\n\t" + "bne- 1b\n\t" + "isync" + : "=&r"(tmp) + : "r"(&var->counter), "r"(incr) + : "cc", "memory"); + return tmp; +} + +static ETHR_INLINE void +ethr_native_atomic_add(ethr_native_atomic_t *var, int incr) +{ + /* XXX: could use weaker version here w/o eieio+isync */ + (void)ethr_native_atomic_add_return(var, incr); +} + +static ETHR_INLINE int +ethr_native_atomic_inc_return(ethr_native_atomic_t *var) +{ + int tmp; + + __asm__ __volatile__( + "eieio\n\t" + "1:\t" + "lwarx %0,0,%1\n\t" + "addic %0,%0,1\n\t" /* due to addi's (rA|0) behaviour */ + "stwcx. %0,0,%1\n\t" + "bne- 1b\n\t" + "isync" + : "=&r"(tmp) + : "r"(&var->counter) + : "cc", "memory"); + return tmp; +} + +static ETHR_INLINE void +ethr_native_atomic_inc(ethr_native_atomic_t *var) +{ + /* XXX: could use weaker version here w/o eieio+isync */ + (void)ethr_native_atomic_inc_return(var); +} + +static ETHR_INLINE int +ethr_native_atomic_dec_return(ethr_native_atomic_t *var) +{ + int tmp; + + __asm__ __volatile__( + "eieio\n\t" + "1:\t" + "lwarx %0,0,%1\n\t" + "addic %0,%0,-1\n\t" + "stwcx. %0,0,%1\n\t" + "bne- 1b\n\t" + "isync" + : "=&r"(tmp) + : "r"(&var->counter) + : "cc", "memory"); + return tmp; +} + +static ETHR_INLINE void +ethr_native_atomic_dec(ethr_native_atomic_t *var) +{ + /* XXX: could use weaker version here w/o eieio+isync */ + (void)ethr_native_atomic_dec_return(var); +} + +static ETHR_INLINE int +ethr_native_atomic_and_retold(ethr_native_atomic_t *var, int mask) +{ + int old, new; + + __asm__ __volatile__( + "eieio\n\t" + "1:\t" + "lwarx %0,0,%2\n\t" + "and %1,%0,%3\n\t" + "stwcx. %1,0,%2\n\t" + "bne- 1b\n\t" + "isync" + : "=&r"(old), "=&r"(new) + : "r"(&var->counter), "r"(mask) + : "cc", "memory"); + return old; +} + +static ETHR_INLINE int +ethr_native_atomic_or_retold(ethr_native_atomic_t *var, int mask) +{ + int old, new; + + __asm__ __volatile__( + "eieio\n\t" + "1:\t" + "lwarx %0,0,%2\n\t" + "or %1,%0,%3\n\t" + "stwcx. %1,0,%2\n\t" + "bne- 1b\n\t" + "isync" + : "=&r"(old), "=&r"(new) + : "r"(&var->counter), "r"(mask) + : "cc", "memory"); + return old; +} + +static ETHR_INLINE int +ethr_native_atomic_xchg(ethr_native_atomic_t *var, int val) +{ + int tmp; + + __asm__ __volatile__( + "eieio\n\t" + "1:\t" + "lwarx %0,0,%1\n\t" + "stwcx. %2,0,%1\n\t" + "bne- 1b\n\t" + "isync" + : "=&r"(tmp) + : "r"(&var->counter), "r"(val) + : "cc", "memory"); + return tmp; +} + +static ETHR_INLINE int +ethr_native_atomic_cmpxchg(ethr_native_atomic_t *var, int new, int expected) +{ + int old; + + __asm__ __volatile__( + "eieio\n\t" + "1:\t" + "lwarx %0,0,%2\n\t" + "cmpw 0,%0,%3\n\t" + "bne 2f\n\t" + "stwcx. %1,0,%2\n\t" + "bne- 1b\n\t" + "isync\n" + "2:" + : "=&r"(old) + : "r"(new), "r"(&var->counter), "r"(expected) + : "cc", "memory"); + + return old; +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHREAD_PPC_ATOMIC_H */ diff --git a/erts/include/internal/ppc32/ethread.h b/erts/include/internal/ppc32/ethread.h new file mode 100644 index 0000000000..d2a72c3dc1 --- /dev/null +++ b/erts/include/internal/ppc32/ethread.h @@ -0,0 +1,34 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Low-level ethread support on PowerPC. + * Author: Mikael Pettersson. + */ +#ifndef ETHREAD_PPC32_ETHREAD_H +#define ETHREAD_PPC32_ETHREAD_H + +#include "atomic.h" +#include "spinlock.h" +#include "rwlock.h" + +#define ETHR_HAVE_NATIVE_ATOMICS 1 +#define ETHR_HAVE_NATIVE_LOCKS 1 + +#endif /* ETHREAD_PPC32_ETHREAD_H */ diff --git a/erts/include/internal/ppc32/rwlock.h b/erts/include/internal/ppc32/rwlock.h new file mode 100644 index 0000000000..9bdab12826 --- /dev/null +++ b/erts/include/internal/ppc32/rwlock.h @@ -0,0 +1,153 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread rwlocks on PowerPC. + * Author: Mikael Pettersson. + * + * Based on the examples in Appendix E of Motorola's + * "Programming Environments Manual For 32-Bit Implementations + * of the PowerPC Architecture". Uses eieio instead of sync + * in the unlock sequence, as suggested in the manual. + */ +#ifndef ETHREAD_PPC_RWLOCK_H +#define ETHREAD_PPC_RWLOCK_H + +/* Unlocked if zero, read-locked if negative, write-locked if +1. */ +typedef struct { + volatile int lock; +} ethr_native_rwlock_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE void +ethr_native_rwlock_init(ethr_native_rwlock_t *lock) +{ + lock->lock = 0; +} + +static ETHR_INLINE void +ethr_native_read_unlock(ethr_native_rwlock_t *lock) +{ + int tmp; + + /* this is eieio + ethr_native_atomic_inc() - isync */ + __asm__ __volatile__( + "eieio\n\t" + "1:\t" + "lwarx %0,0,%1\n\t" + "addic %0,%0,1\n\t" + "stwcx. %0,0,%1\n\t" + "bne- 1b" + : "=&r"(tmp) + : "r"(&lock->lock) + : "cr0", "memory"); +} + +static ETHR_INLINE int +ethr_native_read_trylock(ethr_native_rwlock_t *lock) +{ + int counter; + + __asm__ __volatile__( + "1:\t" + "lwarx %0,0,%1\n\t" /* read lock to counter */ + "addic. %0,%0,-1\n\t" /* decrement counter */ + "bge- 2f\n\t" /* bail if >= 0 (write-locked) */ + "stwcx. %0,0,%1\n\t" /* try to store decremented counter */ + "bne- 1b\n\t" /* loop if lost reservation */ + "isync\n\t" /* wait for previous insns to complete */ + "2:" + : "=&r"(counter) + : "r"(&lock->lock) + : "cr0", "memory" +#if __GNUC__ > 2 + ,"xer" +#endif + ); + return counter < 0; +} + +static ETHR_INLINE int +ethr_native_read_is_locked(ethr_native_rwlock_t *lock) +{ + return lock->lock > 0; +} + +static ETHR_INLINE void +ethr_native_read_lock(ethr_native_rwlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_read_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("":::"memory"); + } while (ethr_native_read_is_locked(lock)); + } +} + +static ETHR_INLINE void +ethr_native_write_unlock(ethr_native_rwlock_t *lock) +{ + __asm__ __volatile__("eieio" : : : "memory"); + lock->lock = 0; +} + +static ETHR_INLINE int +ethr_native_write_trylock(ethr_native_rwlock_t *lock) +{ + int prev; + + /* identical to ethr_native_spin_trylock() */ + __asm__ __volatile__( + "1:\t" + "lwarx %0,0,%1\n\t" /* read lock to prev */ + "cmpwi 0,%0,0\n\t" + "bne- 2f\n\t" /* bail if non-zero (any lock) */ + "stwcx. %2,0,%1\n\t" /* try to make the lock positive */ + "bne- 1b\n\t" /* loop if lost reservation */ + "isync\n\t" /* wait for previous insns to complete */ + "2:" + : "=&r"(prev) + : "r"(&lock->lock), "r"(1) + : "cr0", "memory"); + return prev == 0; +} + +static ETHR_INLINE int +ethr_native_write_is_locked(ethr_native_rwlock_t *lock) +{ + return lock->lock != 0; +} + +static ETHR_INLINE void +ethr_native_write_lock(ethr_native_rwlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_write_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("":::"memory"); + } while (ethr_native_write_is_locked(lock)); + } +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHREAD_PPC_RWLOCK_H */ diff --git a/erts/include/internal/ppc32/spinlock.h b/erts/include/internal/ppc32/spinlock.h new file mode 100644 index 0000000000..034c20c143 --- /dev/null +++ b/erts/include/internal/ppc32/spinlock.h @@ -0,0 +1,93 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread spinlocks on PowerPC. + * Author: Mikael Pettersson. + * + * Based on the examples in Appendix E of Motorola's + * "Programming Environments Manual For 32-Bit Implementations + * of the PowerPC Architecture". Uses eieio instead of sync + * in the unlock sequence, as suggested in the manual. + */ +#ifndef ETHREAD_PPC_SPINLOCK_H +#define ETHREAD_PPC_SPINLOCK_H + +/* Unlocked if zero, locked if non-zero. */ +typedef struct { + volatile unsigned int lock; +} ethr_native_spinlock_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE void +ethr_native_spinlock_init(ethr_native_spinlock_t *lock) +{ + lock->lock = 0; +} + +static ETHR_INLINE void +ethr_native_spin_unlock(ethr_native_spinlock_t *lock) +{ + __asm__ __volatile__("eieio" : : : "memory"); + lock->lock = 0; +} + +static ETHR_INLINE int +ethr_native_spin_trylock(ethr_native_spinlock_t *lock) +{ + unsigned int prev; + + __asm__ __volatile__( + "1:\t" + "lwarx %0,0,%1\n\t" /* read lock to prev */ + "cmpwi 0,%0,0\n\t" + "bne- 2f\n\t" /* bail if non-zero/locked */ + "stwcx. %2,0,%1\n\t" /* try to make the lock non-zero */ + "bne- 1b\n\t" /* loop if lost reservation */ + "isync\n\t" /* wait for previous insns to complete */ + "2:" + : "=&r"(prev) + : "r"(&lock->lock), "r"(1) + : "cr0", "memory"); + return prev == 0; +} + +static ETHR_INLINE int +ethr_native_spin_is_locked(ethr_native_spinlock_t *lock) +{ + + return lock->lock != 0; +} + +static ETHR_INLINE void +ethr_native_spin_lock(ethr_native_spinlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_spin_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("":::"memory"); + } while (ethr_native_spin_is_locked(lock)); + } +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHREAD_PPC_SPINLOCK_H */ diff --git a/erts/include/internal/sparc32/atomic.h b/erts/include/internal/sparc32/atomic.h new file mode 100644 index 0000000000..d6fdc6b2a4 --- /dev/null +++ b/erts/include/internal/sparc32/atomic.h @@ -0,0 +1,173 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread atomics on SPARC V9. + * Author: Mikael Pettersson. + */ +#ifndef ETHR_SPARC32_ATOMIC_H +#define ETHR_SPARC32_ATOMIC_H + +typedef struct { + volatile long counter; +} ethr_native_atomic_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +#if defined(__arch64__) +#define CASX "casx" +#else +#define CASX "cas" +#endif + +static ETHR_INLINE void +ethr_native_atomic_init(ethr_native_atomic_t *var, long i) +{ + var->counter = i; +} +#define ethr_native_atomic_set(v, i) ethr_native_atomic_init((v), (i)) + +static ETHR_INLINE long +ethr_native_atomic_read(ethr_native_atomic_t *var) +{ + return var->counter; +} + +static ETHR_INLINE long +ethr_native_atomic_add_return(ethr_native_atomic_t *var, long incr) +{ + long old, tmp; + + __asm__ __volatile__("membar #LoadLoad|#StoreLoad\n"); + do { + old = var->counter; + tmp = old+incr; + __asm__ __volatile__( + CASX " [%2], %1, %0" + : "=&r"(tmp) + : "r"(old), "r"(&var->counter), "0"(tmp) + : "memory"); + } while (__builtin_expect(old != tmp, 0)); + __asm__ __volatile__("membar #StoreLoad|#StoreStore"); + return old+incr; +} + +static ETHR_INLINE void +ethr_native_atomic_add(ethr_native_atomic_t *var, long incr) +{ + (void)ethr_native_atomic_add_return(var, incr); +} + +static ETHR_INLINE long +ethr_native_atomic_inc_return(ethr_native_atomic_t *var) +{ + return ethr_native_atomic_add_return(var, 1); +} + +static ETHR_INLINE void +ethr_native_atomic_inc(ethr_native_atomic_t *var) +{ + (void)ethr_native_atomic_add_return(var, 1); +} + +static ETHR_INLINE long +ethr_native_atomic_dec_return(ethr_native_atomic_t *var) +{ + return ethr_native_atomic_add_return(var, -1); +} + +static ETHR_INLINE void +ethr_native_atomic_dec(ethr_native_atomic_t *var) +{ + (void)ethr_native_atomic_add_return(var, -1); +} + +static ETHR_INLINE long +ethr_native_atomic_and_retold(ethr_native_atomic_t *var, long mask) +{ + long old, tmp; + + __asm__ __volatile__("membar #LoadLoad|#StoreLoad\n"); + do { + old = var->counter; + tmp = old & mask; + __asm__ __volatile__( + CASX " [%2], %1, %0" + : "=&r"(tmp) + : "r"(old), "r"(&var->counter), "0"(tmp) + : "memory"); + } while (__builtin_expect(old != tmp, 0)); + __asm__ __volatile__("membar #StoreLoad|#StoreStore"); + return old; +} + +static ETHR_INLINE long +ethr_native_atomic_or_retold(ethr_native_atomic_t *var, long mask) +{ + long old, tmp; + + __asm__ __volatile__("membar #LoadLoad|#StoreLoad\n"); + do { + old = var->counter; + tmp = old | mask; + __asm__ __volatile__( + CASX " [%2], %1, %0" + : "=&r"(tmp) + : "r"(old), "r"(&var->counter), "0"(tmp) + : "memory"); + } while (__builtin_expect(old != tmp, 0)); + __asm__ __volatile__("membar #StoreLoad|#StoreStore"); + return old; +} + +static ETHR_INLINE long +ethr_native_atomic_xchg(ethr_native_atomic_t *var, long val) +{ + long old, new; + + __asm__ __volatile__("membar #LoadLoad|#StoreLoad"); + do { + old = var->counter; + new = val; + __asm__ __volatile__( + CASX " [%2], %1, %0" + : "=&r"(new) + : "r"(old), "r"(&var->counter), "0"(new) + : "memory"); + } while (__builtin_expect(old != new, 0)); + __asm__ __volatile__("membar #StoreLoad|#StoreStore"); + return old; +} + +static ETHR_INLINE long +ethr_native_atomic_cmpxchg(ethr_native_atomic_t *var, long new, long old) +{ + __asm__ __volatile__("membar #LoadLoad|#StoreLoad\n"); + __asm__ __volatile__( + CASX " [%2], %1, %0" + : "=&r"(new) + : "r"(old), "r"(&var->counter), "0"(new) + : "memory"); + __asm__ __volatile__("membar #StoreLoad|#StoreStore"); + return new; +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHR_SPARC32_ATOMIC_H */ diff --git a/erts/include/internal/sparc32/ethread.h b/erts/include/internal/sparc32/ethread.h new file mode 100644 index 0000000000..1d55399640 --- /dev/null +++ b/erts/include/internal/sparc32/ethread.h @@ -0,0 +1,34 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Low-level ethread support on SPARC V9. + * Author: Mikael Pettersson. + */ +#ifndef ETHREAD_SPARC32_ETHREAD_H +#define ETHREAD_SPARC32_ETHREAD_H + +#include "atomic.h" +#include "spinlock.h" +#include "rwlock.h" + +#define ETHR_HAVE_NATIVE_ATOMICS 1 +#define ETHR_HAVE_NATIVE_LOCKS 1 + +#endif /* ETHREAD_SPARC32_ETHREAD_H */ diff --git a/erts/include/internal/sparc32/rwlock.h b/erts/include/internal/sparc32/rwlock.h new file mode 100644 index 0000000000..12448e0b06 --- /dev/null +++ b/erts/include/internal/sparc32/rwlock.h @@ -0,0 +1,142 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread rwlocks on SPARC V9. + * Author: Mikael Pettersson. + */ +#ifndef ETHREAD_SPARC32_RWLOCK_H +#define ETHREAD_SPARC32_RWLOCK_H + +/* Unlocked if zero, read-locked if positive, write-locked if -1. */ +typedef struct { + volatile int lock; +} ethr_native_rwlock_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE void +ethr_native_rwlock_init(ethr_native_rwlock_t *lock) +{ + lock->lock = 0; +} + +static ETHR_INLINE void +ethr_native_read_unlock(ethr_native_rwlock_t *lock) +{ + unsigned int old, new; + + __asm__ __volatile__("membar #LoadLoad|#StoreLoad"); + do { + old = lock->lock; + new = old-1; + __asm__ __volatile__( + "cas [%2], %1, %0" + : "=&r"(new) + : "r"(old), "r"(&lock->lock), "0"(new) + : "memory"); + } while (__builtin_expect(old != new, 0)); +} + +static ETHR_INLINE int +ethr_native_read_trylock(ethr_native_rwlock_t *lock) +{ + int old, new; + + do { + old = lock->lock; + if (__builtin_expect(old < 0, 0)) + return 0; + new = old+1; + __asm__ __volatile__( + "cas [%2], %1, %0" + : "=&r"(new) + : "r"(old), "r"(&lock->lock), "0"(new) + : "memory"); + } while (__builtin_expect(old != new, 0)); + __asm__ __volatile__("membar #StoreLoad|#StoreStore"); + return 1; +} + +static ETHR_INLINE int +ethr_native_read_is_locked(ethr_native_rwlock_t *lock) +{ + return lock->lock < 0; +} + +static ETHR_INLINE void +ethr_native_read_lock(ethr_native_rwlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_read_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("membar #LoadLoad"); + } while (ethr_native_read_is_locked(lock)); + } +} + +static ETHR_INLINE void +ethr_native_write_unlock(ethr_native_rwlock_t *lock) +{ + __asm__ __volatile__("membar #LoadStore|#StoreStore"); + lock->lock = 0; +} + +static ETHR_INLINE int +ethr_native_write_trylock(ethr_native_rwlock_t *lock) +{ + unsigned int old, new; + + do { + old = lock->lock; + if (__builtin_expect(old != 0, 0)) + return 0; + new = -1; + __asm__ __volatile__( + "cas [%2], %1, %0" + : "=&r"(new) + : "r"(old), "r"(&lock->lock), "0"(new) + : "memory"); + } while (__builtin_expect(old != new, 0)); + __asm__ __volatile__("membar #StoreLoad|#StoreStore"); + return 1; +} + +static ETHR_INLINE int +ethr_native_write_is_locked(ethr_native_rwlock_t *lock) +{ + return lock->lock != 0; +} + +static ETHR_INLINE void +ethr_native_write_lock(ethr_native_rwlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_write_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("membar #LoadLoad"); + } while (ethr_native_write_is_locked(lock)); + } +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHREAD_SPARC32_RWLOCK_H */ diff --git a/erts/include/internal/sparc32/spinlock.h b/erts/include/internal/sparc32/spinlock.h new file mode 100644 index 0000000000..b4fe48b714 --- /dev/null +++ b/erts/include/internal/sparc32/spinlock.h @@ -0,0 +1,81 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread spinlocks on SPARC V9. + * Author: Mikael Pettersson. + */ +#ifndef ETHR_SPARC32_SPINLOCK_H +#define ETHR_SPARC32_SPINLOCK_H + +/* Locked with ldstub, so unlocked when 0 and locked when non-zero. */ +typedef struct { + volatile unsigned char lock; +} ethr_native_spinlock_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE void +ethr_native_spinlock_init(ethr_native_spinlock_t *lock) +{ + lock->lock = 0; +} + +static ETHR_INLINE void +ethr_native_spin_unlock(ethr_native_spinlock_t *lock) +{ + __asm__ __volatile__("membar #LoadStore|#StoreStore"); + lock->lock = 0; +} + +static ETHR_INLINE int +ethr_native_spin_trylock(ethr_native_spinlock_t *lock) +{ + unsigned int prev; + + __asm__ __volatile__( + "ldstub [%1], %0\n\t" + "membar #StoreLoad|#StoreStore" + : "=r"(prev) + : "r"(&lock->lock) + : "memory"); + return prev == 0; +} + +static ETHR_INLINE int +ethr_native_spin_is_locked(ethr_native_spinlock_t *lock) +{ + return lock->lock != 0; +} + +static ETHR_INLINE void +ethr_native_spin_lock(ethr_native_spinlock_t *lock) +{ + for(;;) { + if (__builtin_expect(ethr_native_spin_trylock(lock) != 0, 1)) + break; + do { + __asm__ __volatile__("membar #LoadLoad"); + } while (ethr_native_spin_is_locked(lock)); + } +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHR_SPARC32_SPINLOCK_H */ diff --git a/erts/include/internal/sparc64/ethread.h b/erts/include/internal/sparc64/ethread.h new file mode 100644 index 0000000000..65fd58d492 --- /dev/null +++ b/erts/include/internal/sparc64/ethread.h @@ -0,0 +1,20 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2007-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#include "../sparc32/ethread.h" diff --git a/erts/include/internal/tile/atomic.h b/erts/include/internal/tile/atomic.h new file mode 100644 index 0000000000..0622b53729 --- /dev/null +++ b/erts/include/internal/tile/atomic.h @@ -0,0 +1,128 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Native ethread atomics on TILE64/TILEPro. + * + */ +#ifndef ETHREAD_TILE_ATOMIC_H +#define ETHREAD_TILE_ATOMIC_H + +#include + +/* An atomic is an aligned int accessed via locked operations. + */ +typedef struct { + volatile long counter; +} ethr_native_atomic_t; + +#ifdef ETHR_TRY_INLINE_FUNCS + +static ETHR_INLINE void +ethr_native_atomic_init(ethr_native_atomic_t *var, long i) +{ + var->counter = i; +} + +static ETHR_INLINE void +ethr_native_atomic_set(ethr_native_atomic_t *var, long i) +{ + __insn_mf(); + atomic_exchange_acq(&var->counter, i); +} + +static ETHR_INLINE long +ethr_native_atomic_read(ethr_native_atomic_t *var) +{ + return var->counter; +} + +static ETHR_INLINE void +ethr_native_atomic_add(ethr_native_atomic_t *var, long incr) +{ + __insn_mf(); + atomic_add(&var->counter, incr); +} + +static ETHR_INLINE void +ethr_native_atomic_inc(ethr_native_atomic_t *var) +{ + __insn_mf(); + atomic_increment(&var->counter); +} + +static ETHR_INLINE void +ethr_native_atomic_dec(ethr_native_atomic_t *var) +{ + __insn_mf(); + atomic_decrement(&var->counter); +} + +static ETHR_INLINE long +ethr_native_atomic_add_return(ethr_native_atomic_t *var, long incr) +{ + __insn_mf(); + return atomic_exchange_and_add(&var->counter, incr) + incr; +} + +static ETHR_INLINE long +ethr_native_atomic_inc_return(ethr_native_atomic_t *var) +{ + return ethr_native_atomic_add_return(&var->counter, 1); +} + +static ETHR_INLINE long +ethr_native_atomic_dec_return(ethr_native_atomic_t *var) +{ + return ethr_native_atomic_add_return(&var->counter, -1); +} + +static ETHR_INLINE long +ethr_native_atomic_and_retold(ethr_native_atomic_t *var, long mask) +{ + /* Implement a barrier suitable for a mutex unlock. */ + __insn_mf(); + return atomic_and_val(&var->counter, mask); +} + +static ETHR_INLINE long +ethr_native_atomic_or_retold(ethr_native_atomic_t *var, long mask) +{ + __insn_mf(); + return atomic_or_val(&var->counter, mask); +} + +static ETHR_INLINE long +ethr_native_atomic_xchg(ethr_native_atomic_t *var, long val) +{ + __insn_mf(); + return atomic_exchange_acq(&var->counter, val); +} + +static ETHR_INLINE long +ethr_native_atomic_cmpxchg(ethr_native_atomic_t *var, long new, long expected) +{ + /* Implement a barrier suitable for a mutex unlock. */ + __insn_mf(); + return atomic_compare_and_exchange_val_acq(&var->counter, new, expected); +} + +#endif /* ETHR_TRY_INLINE_FUNCS */ + +#endif /* ETHREAD_TILE_ATOMIC_H */ diff --git a/erts/include/internal/tile/ethread.h b/erts/include/internal/tile/ethread.h new file mode 100644 index 0000000000..2de4d42bc6 --- /dev/null +++ b/erts/include/internal/tile/ethread.h @@ -0,0 +1,30 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Low-level ethread support on TILE64/TILEPro. + */ +#ifndef ETHREAD_TILE_ETHREAD_H +#define ETHREAD_TILE_ETHREAD_H + +#include "atomic.h" + +#define ETHR_HAVE_NATIVE_ATOMICS 1 + +#endif /* ETHREAD_TILE_ETHREAD_H */ diff --git a/erts/include/internal/x86_64/ethread.h b/erts/include/internal/x86_64/ethread.h new file mode 100644 index 0000000000..59c3980535 --- /dev/null +++ b/erts/include/internal/x86_64/ethread.h @@ -0,0 +1,20 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#include "../i386/ethread.h" diff --git a/erts/info.src b/erts/info.src new file mode 100644 index 0000000000..6e295a6828 --- /dev/null +++ b/erts/info.src @@ -0,0 +1,3 @@ +group: basic +short: Functionality necessary to run the Erlang System itself +release: %RELEASE% diff --git a/erts/internal_doc/.gitignore b/erts/internal_doc/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/lib/internal/README b/erts/lib/internal/README new file mode 100644 index 0000000000..f5b7ac27ab --- /dev/null +++ b/erts/lib/internal/README @@ -0,0 +1,28 @@ + + %CopyrightBegin% + + Copyright Ericsson AB 2004-2009. All Rights Reserved. + + The contents of this file are subject to the Erlang Public License, + Version 1.1, (the "License"); you may not use this file except in + compliance with the License. You should have received a copy of the + Erlang Public License along with this software. If not, it can be + retrieved online at http://www.erlang.org/. + + Software distributed under the License is distributed on an "AS IS" + basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + the License for the specific language governing rights and limitations + under the License. + + %CopyrightEnd% + +------------------------------------------------------------------------ +------------------------------------------------------------------------ + + Files in this directory are *not* for public use and should *only* + be used by Erlang/OTP applications. The content of this directory + and the libraries present in this directory may be changed at any + time without prior notice. + +------------------------------------------------------------------------ +------------------------------------------------------------------------ diff --git a/erts/lib_src/Makefile b/erts/lib_src/Makefile new file mode 100644 index 0000000000..f94e47a856 --- /dev/null +++ b/erts/lib_src/Makefile @@ -0,0 +1,22 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Invoke with GNU make or clearmake -C gnu. +# + +include $(ERL_TOP)/make/run_make.mk diff --git a/erts/lib_src/Makefile.in b/erts/lib_src/Makefile.in new file mode 100644 index 0000000000..ce5c846677 --- /dev/null +++ b/erts/lib_src/Makefile.in @@ -0,0 +1,615 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include $(ERL_TOP)/make/target.mk +include ../include/internal/$(TARGET)/ethread.mk + +OMIT_OMIT_FP=no + + +CC=@CC@ +LD=@LD@ +AR=@AR@ +RANLIB=@RANLIB@ +RM=@RM@ +MKDIR=@MKDIR@ +INSTALL=@INSTALL@ +INSTALL_DIR=@INSTALL_DIR@ +INSTALL_DATA=@INSTALL_DATA@ +INSTALL_PROGRAM=@INSTALL_PROGRAM@ + +ERLANG_OSTYPE=@ERLANG_OSTYPE@ + +OMIT_FP=false +CFLAGS=$(subst O2,O3, @CFLAGS@) + +ifeq ($(TYPE),debug) +CFLAGS=@DEBUG_CFLAGS@ -DDEBUG +TYPE_SUFFIX=.debug +ifeq ($(USING_VC),yes) +LD_FLAGS += -g +endif +PRE_LD= + +else + +ifeq ($(TYPE),purify) +CFLAGS=@DEBUG_CFLAGS@ -DPURIFY +TYPE_SUFFIX=.purify +PRE_LD=purify $(PURIFY_BUILD_OPTIONS) +else +ifeq ($(TYPE),quantify) +CFLAGS += -DQUANTIFY +TYPE_SUFFIX=.quantify +PRE_LD=quantify $(QUANTIFY_BUILD_OPTIONS) +else +ifeq ($(TYPE),purecov) +CFLAGS=@DEBUG_CFLAGS@ -DPURECOV +TYPE_SUFFIX=.purecov +PRE_LD=purecov $(PURECOV_BUILD_OPTIONS) +else +ifeq ($(TYPE),gcov) +CFLAGS=@DEBUG_CFLAGS@ -fprofile-arcs -ftest-coverage -O0 +TYPE_SUFFIX=.gcov +PRE_LD= +else +ifeq ($(TYPE),valgrind) +CFLAGS=@DEBUG_CFLAGS@ -DVALGRIND +TYPE_SUFFIX=.valgrind +PRE_LD= +else +ifeq ($(TYPE),gprof) +CFLAGS += -DGPROF -pg +TYPE_SUFFIX=.gprof +PRE_LD= +else +ifeq ($(TYPE),lcnt) +TYPE_SUFFIX = .lcnt +CFLAGS += -DERTS_ENABLE_LOCK_COUNT +OMIT_FP=true +PRE_LD= +else +override TYPE=opt +OMIT_FP=true +TYPE_SUFFIX= +PRE_LD= +endif +endif +endif +endif +endif +endif +endif +endif + +OPSYS=@OPSYS@ +sol2CFLAGS= +linuxCFLAGS= +darwinCFLAGS=-DDARWIN +noopsysCFLAGS= +OPSYSCFLAGS=$($(OPSYS)CFLAGS) +ARCH=@ARCH@ +ultrasparcCFLAGS=-Wa,-xarch=v8plusa +ARCHCFLAGS=$($(ARCH)CFLAGS) + +ifeq ($(OMIT_OMIT_FP),yes) +OMIT_FP=false +endif + +CREATE_DIRS= + +ifeq ($(CC)-$(OMIT_FP), gcc-true) +CFLAGS += -fomit-frame-pointer +endif + +CFLAGS += @WFLAGS@ @DEFS@ $(ARCHCFLAGS) + +ifeq ($(findstring -D_GNU_SOURCE,$(CFLAGS)),) +THR_DEFS = $(ETHR_DEFS) +else +# Remove duplicate -D_GNU_SOURCE +THR_DEFS = $(filter-out -D_GNU_SOURCE%, $(ETHR_DEFS)) +endif + +LIBS=@LIBS@ + +TT_DIR=$(TARGET)/$(TYPE) + +ERTS_INCL=../include +ERTS_INCL_INT=../include/internal + +INCLUDES=-I$(ERTS_INCL) -I$(ERTS_INCL)/$(TARGET) -I$(ERTS_INCL_INT) -I$(ERTS_INCL_INT)/$(TARGET) +INCLUDES += -I../emulator/beam -I../emulator/sys/$(ERLANG_OSTYPE) + +USING_MINGW=@MIXED_CYGWIN_MINGW@ +USING_VC=@MIXED_CYGWIN_VC@ + +ifeq ($(USING_VC),yes) +LIB_SUFFIX=.lib +LIB_PREFIX= +else +LIB_SUFFIX=.a +LIB_PREFIX=lib +endif + +OBJS_ROOT_DIR=obj +OBJ_DIR=$(OBJS_ROOT_DIR)/$(TT_DIR) + +CREATE_DIRS += $(OBJ_DIR) + +ERTS_LIBS= + +ifeq ($(findstring -D_GNU_SOURCE,$(CFLAGS)),) +THR_DEFS = $(ETHR_DEFS) +else +# Remove duplicate -D_GNU_SOURCE +THR_DEFS = $(filter-out -D_GNU_SOURCE%, $(ETHR_DEFS)) +endif + +# +# erts (public) library +# + +ERTS_LIB_SRCS = common/erl_memory_trace_parser.c + +ERTS_LIB_DIR=../lib/$(TARGET) +CREATE_DIRS += $(ERTS_LIB_DIR) + +ifeq ($(USING_VC),yes) +# Windows obj dir +MD_OBJ_DIR=$(OBJ_DIR)/MD +MDd_OBJ_DIR=$(OBJ_DIR)/MDd +MT_OBJ_DIR=$(OBJ_DIR)/MT +MTd_OBJ_DIR=$(OBJ_DIR)/MTd + +CREATE_DIRS += $(MD_OBJ_DIR) \ + $(MDd_OBJ_DIR) \ + $(MT_OBJ_DIR) \ + $(MTd_OBJ_DIR) + +ERTS_MD_LIB_OBJS=$(addprefix $(MD_OBJ_DIR)/,$(notdir $(ERTS_LIB_SRCS:.c=.o))) +ERTS_MDd_LIB_OBJS=$(addprefix $(MDd_OBJ_DIR)/,$(notdir $(ERTS_LIB_SRCS:.c=.o))) +ERTS_MT_LIB_OBJS=$(addprefix $(MT_OBJ_DIR)/,$(notdir $(ERTS_LIB_SRCS:.c=.o))) +ERTS_MTd_LIB_OBJS=$(addprefix $(MTd_OBJ_DIR)/,$(notdir $(ERTS_LIB_SRCS:.c=.o))) + +else # --- Not windows --- + +# Reentrant obj dir +ifneq ($(strip $(ETHR_LIB_NAME)),) +r_OBJ_DIR = $(OBJ_DIR)/r +CREATE_DIRS += $(r_OBJ_DIR) +ERTS_r_LIB_OBJS=$(addprefix $(r_OBJ_DIR)/,$(notdir $(ERTS_LIB_SRCS:.c=.o))) +endif +ERTS_LIB_OBJS=$(addprefix $(OBJ_DIR)/,$(notdir $(ERTS_LIB_SRCS:.c=.o))) + +endif + +ifeq ($(USING_VC),yes) +ERTS_MD_LIB=$(ERTS_LIB_DIR)/$(LIB_PREFIX)erts_MD$(TYPE_SUFFIX)$(LIB_SUFFIX) +ERTS_MDd_LIB=$(ERTS_LIB_DIR)/$(LIB_PREFIX)erts_MDd$(TYPE_SUFFIX)$(LIB_SUFFIX) +ERTS_MT_LIB=$(ERTS_LIB_DIR)/$(LIB_PREFIX)erts_MT$(TYPE_SUFFIX)$(LIB_SUFFIX) +ERTS_MTd_LIB=$(ERTS_LIB_DIR)/$(LIB_PREFIX)erts_MTd$(TYPE_SUFFIX)$(LIB_SUFFIX) +ERTS_LIBS += \ + $(ERTS_MD_LIB) \ + $(ERTS_MDd_LIB) \ + $(ERTS_MT_LIB) \ + $(ERTS_MTd_LIB) +else + +ERTS_LIB = $(ERTS_LIB_DIR)/$(LIB_PREFIX)erts$(TYPE_SUFFIX)$(LIB_SUFFIX) +ERTS_LIBS += $(ERTS_LIB) + +ifneq ($(strip $(ETHR_LIB_NAME)),) +ERTS_r_LIB = $(ERTS_LIB_DIR)/$(LIB_PREFIX)erts_r$(TYPE_SUFFIX)$(LIB_SUFFIX) +ERTS_LIBS += $(ERTS_r_LIB) +endif + +endif + +# +# erts_internal library +# + +ERTS_LIB_INTERNAL_DIR=../lib/internal/$(TARGET) +CREATE_DIRS += $(ERTS_LIB_INTERNAL_DIR) + +ERTS_INTERNAL_LIBS= + +ERTS_INTERNAL_LIB_SRCS = \ + common/erl_printf_format.c \ + common/erl_printf.c \ + common/erl_misc_utils.c + +ERTS_INTERNAL_LIB_NAME=erts_internal$(TYPE_SUFFIX) + +ifeq ($(USING_VC),yes) +ifeq ($(TYPE),debug) +ERTS_INTERNAL_LIB_OBJS = \ + $(addprefix $(MTd_OBJ_DIR)/,$(notdir $(ERTS_INTERNAL_LIB_SRCS:.c=.o))) +else +ERTS_INTERNAL_LIB_OBJS = \ + $(addprefix $(MT_OBJ_DIR)/,$(notdir $(ERTS_INTERNAL_LIB_SRCS:.c=.o))) +endif +else +ERTS_INTERNAL_LIB_OBJS = \ + $(addprefix $(OBJ_DIR)/,$(notdir $(ERTS_INTERNAL_LIB_SRCS:.c=.o))) +endif + +ERTS_INTERNAL_LIB=$(ERTS_LIB_INTERNAL_DIR)/$(LIB_PREFIX)$(ERTS_INTERNAL_LIB_NAME)$(LIB_SUFFIX) + +ERTS_INTERNAL_LIBS += $(ERTS_INTERNAL_LIB) + +ifneq ($(strip $(ETHR_LIB_NAME)),) +ERTS_INTERNAL_r_LIB_NAME=erts_internal_r$(TYPE_SUFFIX) + +ifeq ($(USING_VC),yes) +ifeq ($(TYPE),debug) +ERTS_INTERNAL_r_LIB_OBJS = \ + $(addprefix $(MDd_OBJ_DIR)/,$(notdir $(ERTS_INTERNAL_LIB_SRCS:.c=.o))) +else +ERTS_INTERNAL_r_LIB_OBJS = \ + $(addprefix $(MD_OBJ_DIR)/,$(notdir $(ERTS_INTERNAL_LIB_SRCS:.c=.o))) +endif +else +ERTS_INTERNAL_r_LIB_OBJS = \ + $(addprefix $(r_OBJ_DIR)/,$(notdir $(ERTS_INTERNAL_LIB_SRCS:.c=.o))) +endif + +ERTS_INTERNAL_r_LIB=$(ERTS_LIB_INTERNAL_DIR)/$(LIB_PREFIX)$(ERTS_INTERNAL_r_LIB_NAME)$(LIB_SUFFIX) + +ERTS_INTERNAL_LIBS += $(ERTS_INTERNAL_r_LIB) + +endif + +# +# ethread library +# +ifneq ($(strip $(ETHR_LIB_NAME)),) +ETHREAD_LIB_SRC=common/ethread.c +ETHREAD_LIB_NAME=ethread$(TYPE_SUFFIX) + +ifeq ($(USING_VC),yes) +ifeq ($(TYPE),debug) +ETHREAD_LIB_OBJS = \ + $(addprefix $(MDd_OBJ_DIR)/,$(notdir $(ETHREAD_LIB_SRC:.c=.o))) +else +ETHREAD_LIB_OBJS = \ + $(addprefix $(MD_OBJ_DIR)/,$(notdir $(ETHREAD_LIB_SRC:.c=.o))) +endif +else +ETHREAD_LIB_OBJS = \ + $(addprefix $(r_OBJ_DIR)/,$(notdir $(ETHREAD_LIB_SRC:.c=.o))) +endif + +ETHREAD_LIB=$(ERTS_LIB_INTERNAL_DIR)/$(LIB_PREFIX)$(ETHREAD_LIB_NAME)$(LIB_SUFFIX) + +else + +ETHREAD_LIB_SRC= +ETHREAD_LIB_NAME= +ETHREAD_LIB_OBJS= +ETHREAD_LIB= + +endif + +# +# Everything to build +# +all: $(CREATE_DIRS) $(ETHREAD_LIB) $(ERTS_LIBS) $(ERTS_INTERNAL_LIBS) +ifeq ($(OMIT_OMIT_FP),yes) + @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' + @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' + @echo '* * * *' + @echo '* * NOTE: Omit frame pointer optimization has been omitted * *' + @echo '* * * *' + @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' + @echo '* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *' +endif +# +# The libs ... +# +ifeq ($(USING_VC),yes) +AR_OUT=-out: +AR_FLAGS= +else +AR_OUT= +AR_FLAGS=rcv +endif + +ifndef RANLIB +RANLIB=true +endif + +$(ETHREAD_LIB): $(ETHREAD_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ETHREAD_LIB_OBJS) + $(RANLIB) $@ + +$(ERTS_INTERNAL_LIB): $(ERTS_INTERNAL_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ERTS_INTERNAL_LIB_OBJS) + $(RANLIB) $@ + +$(ERTS_INTERNAL_r_LIB): $(ERTS_INTERNAL_r_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ERTS_INTERNAL_r_LIB_OBJS) + $(RANLIB) $@ + +$(ERTS_MD_LIB): $(ERTS_MD_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ERTS_MD_LIB_OBJS) + $(RANLIB) $@ + +$(ERTS_MDd_LIB): $(ERTS_MDd_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ERTS_MDd_LIB_OBJS) + $(RANLIB) $@ + +$(ERTS_MT_LIB): $(ERTS_MT_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ERTS_MT_LIB_OBJS) + $(RANLIB) $@ + +$(ERTS_MTd_LIB): $(ERTS_MTd_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ERTS_MTd_LIB_OBJS) + $(RANLIB) $@ + +$(ERTS_r_LIB): $(ERTS_r_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ERTS_r_LIB_OBJS) + $(RANLIB) $@ + +$(ERTS_LIB): $(ERTS_LIB_OBJS) + $(AR) $(AR_FLAGS) $(AR_OUT)$@ $(ERTS_LIB_OBJS) + $(RANLIB) $@ + +# +# Object files +# + +$(r_OBJ_DIR)/%.o: common/%.c + $(CC) $(THR_DEFS) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(r_OBJ_DIR)/%.o: $(ERLANG_OSTYPE)/%.c + $(CC) $(THR_DEFS) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJ_DIR)/%.o: common/%.c + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +$(OBJ_DIR)/%.o: $(ERLANG_OSTYPE)/%.c + $(CC) $(CFLAGS) $(INCLUDES) -c $< -o $@ + +# Win32 specific + +$(MD_OBJ_DIR)/%.o: common/%.c + $(CC) $(THR_DEFS) $(CFLAGS) -MD $(INCLUDES) -c $< -o $@ + +$(MD_OBJ_DIR)/%.o: $(ERLANG_OSTYPE)/%.c + $(CC) $(THR_DEFS) $(CFLAGS) -MD $(INCLUDES) -c $< -o $@ + +$(MDd_OBJ_DIR)/%.o: common/%.c + $(CC) $(THR_DEFS) $(CFLAGS) -MDd $(INCLUDES) -c $< -o $@ + +$(MDd_OBJ_DIR)/%.o: $(ERLANG_OSTYPE)/%.c + $(CC) $(THR_DEFS) $(CFLAGS) -MDd $(INCLUDES) -c $< -o $@ + +$(MT_OBJ_DIR)/%.o: common/%.c + $(CC) $(THR_DEFS) $(CFLAGS) -MT $(INCLUDES) -c $< -o $@ + +$(MT_OBJ_DIR)/%.o: $(ERLANG_OSTYPE)/%.c + $(CC) $(THR_DEFS) $(CFLAGS) -MT $(INCLUDES) -c $< -o $@ + +$(MTd_OBJ_DIR)/%.o: common/%.c + $(CC) $(THR_DEFS) $(CFLAGS) -MTd $(INCLUDES) -c $< -o $@ + +$(MTd_OBJ_DIR)/%.o: $(ERLANG_OSTYPE)/%.c + $(CC) $(THR_DEFS) $(CFLAGS) -MTd $(INCLUDES) -c $< -o $@ + +# +# Create directories +# + +$(CREATE_DIRS): + $(MKDIR) -p $@ + +# +# Install +# + +include $(ERL_TOP)/make/otp_release_targets.mk +include ../vsn.mk +RELSYSDIR = $(RELEASE_PATH)/erts-$(VSN) + +RELEASE_INCLUDES= \ + $(ERTS_INCL)/erl_memory_trace_parser.h \ + $(ERTS_INCL)/$(TARGET)/erl_int_sizes_config.h \ + $(ERTS_INCL)/erl_fixed_size_int_types.h +RELEASE_LIBS=$(ERTS_LIBS) + +INTERNAL_RELEASE_INCLUDES= \ + $(ERTS_INCL_INT)/README \ + $(ERTS_INCL_INT)/ethread.h \ + $(ERTS_INCL_INT)/$(TARGET)/ethread.mk \ + $(ERTS_INCL_INT)/$(TARGET)/erts_internal.mk \ + $(ERTS_INCL_INT)/$(TARGET)/ethread_header_config.h \ + $(ERTS_INCL_INT)/erl_printf.h \ + $(ERTS_INCL_INT)/erl_printf_format.h \ + $(ERTS_INCL_INT)/erl_memory_trace_protocol.h \ + $(ERTS_INCL_INT)/erl_misc_utils.h \ + $(ERTS_INCL_INT)/erl_errno.h + +INTERNAL_X_RELEASE_INCLUDE_DIRS= i386 x86_64 ppc32 sparc32 sparc64 tile + +INTERNAL_RELEASE_LIBS= \ + ../lib/internal/README \ + $(ETHREAD_LIB) \ + $(ERTS_INTERNAL_LIBS) + +release_spec: all +ifneq ($(strip $(RELEASE_INCLUDES)),) + $(INSTALL_DIR) $(RELSYSDIR)/include + $(INSTALL_DIR) $(RELEASE_PATH)/usr/include + $(INSTALL_DATA) $(RELEASE_INCLUDES) $(RELSYSDIR)/include + $(INSTALL_DATA) $(RELEASE_INCLUDES) $(RELEASE_PATH)/usr/include +endif +ifneq ($(strip $(INTERNAL_RELEASE_INCLUDES)),) + $(INSTALL_DIR) $(RELSYSDIR)/include/internal + $(INSTALL_DATA) $(INTERNAL_RELEASE_INCLUDES) $(RELSYSDIR)/include/internal +endif +ifneq ($(strip $(INTERNAL_X_RELEASE_INCLUDE_DIRS)),) + for xdir in $(INTERNAL_X_RELEASE_INCLUDE_DIRS); do \ + $(INSTALL_DIR) $(RELSYSDIR)/include/internal/$$xdir; \ + $(INSTALL_DATA) $(ERTS_INCL_INT)/$$xdir/*.h \ + $(RELSYSDIR)/include/internal/$$xdir; \ + done +endif +ifneq ($(strip $(RELEASE_LIBS)),) + $(INSTALL_DIR) $(RELSYSDIR)/lib + $(INSTALL_DIR) $(RELEASE_PATH)/usr/lib + $(INSTALL_DATA) $(RELEASE_LIBS) $(RELSYSDIR)/lib + $(INSTALL_DATA) $(RELEASE_LIBS) $(RELEASE_PATH)/usr/lib +endif +ifneq ($(strip $(INTERNAL_RELEASE_LIBS)),) + $(INSTALL_DIR) $(RELSYSDIR)/lib/internal + $(INSTALL_DATA) $(INTERNAL_RELEASE_LIBS) $(RELSYSDIR)/lib/internal +endif + +release_docs_spec: + + +# +# Cleanup +# +clean: + $(RM) -rf ../lib/internal/$(TARGET)/* + $(RM) -rf ../lib/$(TARGET)/* + $(RM) -rf obj/$(TARGET)/* + $(RM) -f $(TARGET)/depend.mk + +# +# Make dependencies +# + +ifeq ($(USING_VC),yes) +# VC++ used for compiling. We undef __GNUC__ since if __GNUC__ is defined +# we will include other headers than when compiling which will result in +# faulty dependencies. +#DEP_CC=@EMU_CC@ -U__GNUC__ +DEP_CC=$(CC) +else +DEP_CC=$(CC) +endif + +#SED_REPL_WIN_DRIVE=s|\([ ]\)\([A-Za-z]\):|\1/cygdrive/\2|g;s|^\([A-Za-z]\):|/cygdrive/\1|g +SED_REPL_O=s|^\([^:]*\)\.o:|$$(OBJ_DIR)/\1.o:|g +SED_REPL_r_O=s|^\([^:]*\)\.o:|$$(r_OBJ_DIR)/\1.o:|g +SED_REPL_MD_O=s|^\([^:]*\)\.o:|$$(MD_OBJ_DIR)/\1.o:|g +SED_REPL_MDd_O=s|^\([^:]*\)\.o:|$$(MDd_OBJ_DIR)/\1.o:|g +SED_REPL_MT_O=s|^\([^:]*\)\.o:|$$(MT_OBJ_DIR)/\1.o:|g +SED_REPL_MTd_O=s|^\([^:]*\)\.o:|$$(MTd_OBJ_DIR)/\1.o:|g +SED_REPL_TT_DIR=s|$(TT_DIR)/|$$(TT_DIR)/|g +SED_REPL_TARGET=s|$(TARGET)/|$$(TARGET)/|g + +ifeq ($(TARGET),win32) +#SED_PREFIX=$(SED_REPL_WIN_DRIVE); +SED_PREFIX= +DEP_FLAGS=$(subst -O3,,$(subst -O2,,$(CFLAGS))) $(INCLUDES) +else +SED_PREFIX= +DEP_FLAGS=$(CFLAGS) $(INCLUDES) +endif + +SED_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_O);$(SED_REPL_TT_DIR);$(SED_REPL_TARGET)' +SED_r_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_r_O);$(SED_REPL_TT_DIR);$(SED_REPL_TARGET)' +SED_MD_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_MD_O);$(SED_REPL_TT_DIR);$(SED_REPL_TARGET)' +SED_MDd_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_MDd_O);$(SED_REPL_TT_DIR);$(SED_REPL_TARGET)' +SED_MT_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_MT_O);$(SED_REPL_TT_DIR);$(SED_REPL_TARGET)' +SED_MTd_DEPEND=sed '$(SED_PREFIX)$(SED_REPL_MTd_O);$(SED_REPL_TT_DIR);$(SED_REPL_TARGET)' + +DEPEND_MK=$(TARGET)/depend.mk + +depend: + @echo "Generating dependency file $(DEPEND_MK)..." + @echo "# Generated dependency rules" > $(DEPEND_MK); + @echo "# " >> $(DEPEND_MK); +ifneq ($(strip $(ETHREAD_LIB_SRC)),) + @echo "# ethread lib objects..." >> $(DEPEND_MK); +ifeq ($(USING_VC),yes) + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ETHREAD_LIB_SRC) \ + | $(SED_MD_DEPEND) >> $(DEPEND_MK) + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ETHREAD_LIB_SRC) \ + | $(SED_MDd_DEPEND) >> $(DEPEND_MK) +else + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ETHREAD_LIB_SRC) \ + | $(SED_r_DEPEND) >> $(DEPEND_MK) +endif +endif +ifneq ($(strip $(ERTS_INTERNAL_LIB_SRCS)),) +ifneq ($(strip $(ETHREAD_LIB_SRC)),) + @echo "# erts_internal_r lib objects..." >> $(DEPEND_MK); +ifeq ($(USING_VC),yes) + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_INTERNAL_LIB_SRCS) \ + | $(SED_MD_DEPEND) >> $(DEPEND_MK) + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_INTERNAL_LIB_SRCS) \ + | $(SED_MDd_DEPEND) >> $(DEPEND_MK) +else + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_INTERNAL_LIB_SRCS) \ + | $(SED_r_DEPEND) >> $(DEPEND_MK) +endif +endif + @echo "# erts_internal lib objects..." >> $(DEPEND_MK); +ifeq ($(USING_VC),yes) + $(DEP_CC) -MM $(DEP_FLAGS) $(ERTS_INTERNAL_LIB_SRCS) \ + | $(SED_MD_DEPEND) >> $(DEPEND_MK) + $(DEP_CC) -MM $(DEP_FLAGS) $(ERTS_INTERNAL_LIB_SRCS) \ + | $(SED_MDd_DEPEND) >> $(DEPEND_MK) +else + $(DEP_CC) -MM $(DEP_FLAGS) $(ERTS_INTERNAL_LIB_SRCS) \ + | $(SED_DEPEND) >> $(DEPEND_MK) +endif +endif +ifneq ($(strip $(ERTS_LIB_SRCS)),) +ifeq ($(USING_VC),yes) + @echo "# erts_MD lib objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_LIB_SRCS) \ + | $(SED_MD_DEPEND) >> $(DEPEND_MK) + @echo "# erts_MDd lib objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_LIB_SRCS) \ + | $(SED_MDd_DEPEND) >> $(DEPEND_MK) + @echo "# erts_MT lib objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_LIB_SRCS) \ + | $(SED_MT_DEPEND) >> $(DEPEND_MK) + @echo "# erts_MTd lib objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_LIB_SRCS) \ + | $(SED_MTd_DEPEND) >> $(DEPEND_MK) + @echo "# erts_internal_r lib objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_INTERNAL_LIB_SRCS) \ + | $(SED_MD_DEPEND) >> $(DEPEND_MK) + @echo "# erts_internal_r.debug lib objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_INTERNAL_LIB_SRCS) \ + | $(SED_MDd_DEPEND) >> $(DEPEND_MK) +else +ifneq ($(strip $(ETHREAD_LIB_SRC)),) + @echo "# erts_r lib objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(THR_DEFS) $(DEP_FLAGS) $(ERTS_LIB_SRCS) \ + | $(SED_r_DEPEND) >> $(DEPEND_MK) +endif + @echo "# erts lib objects..." >> $(DEPEND_MK); + $(DEP_CC) -MM $(DEP_FLAGS) $(ERTS_LIB_SRCS) \ + | $(SED_DEPEND) >> $(DEPEND_MK) +endif +endif + @echo "# EOF" >> $(DEPEND_MK); + +-include $(DEPEND_MK) + +# eof diff --git a/erts/lib_src/common/erl_memory_trace_parser.c b/erts/lib_src/common/erl_memory_trace_parser.c new file mode 100644 index 0000000000..54c3dfadec --- /dev/null +++ b/erts/lib_src/common/erl_memory_trace_parser.c @@ -0,0 +1,1956 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + + +/* + * Description: + * + * Author: Rickard Green + */ + +#include "erl_memory_trace_parser.h" +#include "erl_memory_trace_protocol.h" +#include /* For memcpy */ + +#ifdef DEBUG +#include +#define ASSERT assert +#define PRINT_ERROR_ORIGIN 1 +#if PRINT_ERROR_ORIGIN +#include +#endif +#define PRINT_PARSED_OP 0 +#if PRINT_PARSED_OP +#include +static void print_op(emtp_operation *op_p); +#endif +static void hexdump(void *start, void *end); +#else +#define PRINT_ERROR_ORIGIN 0 +#define PRINT_PARSED_OP 0 +#define ASSERT(B) +#endif + + +#if ERTS_MT_MAJOR_VSN != 2 || ERTS_MT_MINOR_VSN != 0 +#error trace version mismatch (expected version 2.0) +/* Make sure that older versions are supported when implementing + support for newer versions! */ +#endif + + +#if defined(__GNUC__) +# define EMTP_CAN_INLINE 1 +# define EMTP_INLINE __inline__ +#elif defined(__WIN32__) +# define EMTP_CAN_INLINE 1 +# define EMTP_INLINE __forceinline +#else +# define EMTP_CAN_INLINE 0 +# define EMTP_INLINE +#endif + + +#define UI8_SZ 1 +#define UI16_SZ 2 +#define UI32_SZ 4 +#define UI64_SZ 8 + +#define MAX(X, Y) ((X) > (Y) ? (X) : (Y)) +#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) + +#define DEFAULT_OVERFLOW_BUF_SZ 128 + +#define UNKNOWN_BLOCK_TYPE_IX (-1) +#define UNKNOWN_ALLOCATOR_IX (-1) + +#define INVALID_SIZE (((sgnd_int_32) 1) << 31) +#define INVALID_RESULT ((int) INVALID_SIZE) + +typedef enum { + EMTP_PROGRESS_PARSE_HDR_VSN, + EMTP_PROGRESS_PARSE_HDR_PROLOG, + EMTP_PROGRESS_ALLOC_HDR_INFO, + EMTP_PROGRESS_PARSE_TAGGED_HDR, + EMTP_PROGRESS_PARSE_BODY, + EMTP_PROGRESS_ENDED +} emtp_progress; + +struct emtp_state_ { + + /* Trace version */ + emtp_version version; + + /* Flags */ + usgnd_int_32 flags; + + /* Progress */ + emtp_progress progress; + + /* Name, host, and pid as strings */ + char nodename[256]; + char hostname[256]; + char pid[256]; + + /* Local time on the traced node when the node started */ + struct { + usgnd_int_32 year; + usgnd_int_32 month; + usgnd_int_32 day; + usgnd_int_32 hour; + usgnd_int_32 minute; + usgnd_int_32 second; + usgnd_int_32 micro_second; + } start_time; + + /* Function to parse body with */ + int (*parse_body_func)(emtp_state *, + usgnd_int_8 **, + usgnd_int_8 *, + emtp_operation **, + emtp_operation *, + size_t); + /* Current time elapsed */ + struct { + usgnd_int_32 secs; + usgnd_int_32 usecs; + } time; + + /* */ + + int force_return; + + /* Overflow buffer */ + size_t overflow_size; + size_t overflow_buf_size; + usgnd_int_8 * overflow; + sgnd_int_32 fetch_size; + int known_need; + + usgnd_int_16 segment_ix; + usgnd_int_16 max_allocator_ix; + emtp_allocator ** allocator; + usgnd_int_16 max_block_type_ix; + emtp_block_type ** block_type; + + /* Memory allocation functions */ + void * (*alloc)(size_t); + void * (*realloc)(void *, size_t); + void (*free)(void *); + +}; + +static char unknown_allocator[] = "unknown_allocator"; +static char unknown_block_type[] = "unknown_block_type"; + +const char * +emtp_error_string(int res) +{ + switch (res) { + case EMTP_NO_TRACE_ERROR: + return "no trace error"; + case EMTP_HEADER_TAG_IN_BODY_ERROR: + return "header tag in body error"; + case EMTP_BODY_TAG_IN_HEADER_ERROR: + return "body tag in header error"; + case EMTP_NOT_SUPPORTED_MTRACE_VERSION_ERROR: + return "not supported mtrace version error"; + case EMTP_NOT_AN_ERL_MTRACE_ERROR: + return "not an erl mtrace error"; + case EMTP_NO_MEMORY_ERROR: + return "no memory error"; + case EMTP_BAD_OP_SIZE_ERROR: + return "bad op size error"; + case EMTP_NO_OPERATIONS_ERROR: + return "no operations error"; + case EMTP_NOT_SUPPORTED_64_BITS_TRACE_ERROR: + return "not supported 64 bits trace error"; + case EMTP_PARSE_ERROR: + return "parse error"; + case EMTP_UNKNOWN_TAG_ERROR: + return "unknown tag error"; + case EMTP_END_OF_TRACE: + return "end of trace"; + case EMTP_END_OF_TRACE_GARBAGE_FOLLOWS: + return "end of trace; garbage follows"; + case EMTP_ALL_OPS_FILLED: + return "all operations filled"; + case EMTP_NEED_MORE_TRACE: + return "need more trace"; + case EMTP_HEADER_PARSED: + return "header parsed"; + default: + return NULL; + } + +} + +int +emtp_get_info(emtp_info *infop, size_t *info_szp, emtp_state *statep) +{ + if (!infop || !info_szp || *info_szp < sizeof(emtp_info)) + return 0; + + infop->version.parser.major = ERTS_MT_MAJOR_VSN; + infop->version.parser.minor = ERTS_MT_MINOR_VSN; + + *info_szp = sizeof(emtp_version); + + if (!statep || statep->version.major == 0) + return 1; + + infop->version.trace.major = statep->version.major; + infop->version.trace.minor = statep->version.minor; + + *info_szp = sizeof(emtp_versions); + + if (statep->progress != EMTP_PROGRESS_PARSE_BODY + && statep->progress != EMTP_PROGRESS_ENDED) + return 1; + + infop->bits = (statep->flags & ERTS_MT_64_BIT_FLAG + ? 64 + : 32); + + infop->nodename = statep->nodename; + infop->hostname = statep->hostname; + infop->pid = statep->pid; + + infop->start_time.year = statep->start_time.year; + infop->start_time.month = statep->start_time.month; + infop->start_time.day = statep->start_time.day; + infop->start_time.hour = statep->start_time.hour; + infop->start_time.minute = statep->start_time.minute; + infop->start_time.second = statep->start_time.second; + infop->start_time.micro_second = statep->start_time.micro_second; + + infop->have_carrier_info = statep->flags & ERTS_MT_CRR_INFO; + infop->have_segment_carrier_info = statep->flags & ERTS_MT_SEG_CRR_INFO; + infop->segment_ix = statep->segment_ix; + infop->max_allocator_ix = statep->max_allocator_ix; + infop->allocator = statep->allocator; + infop->max_block_type_ix = statep->max_block_type_ix; + infop->block_type = statep->block_type; + + *info_szp = sizeof(emtp_info); + + return 1; +} + +emtp_state * +emtp_state_new(void * (*alloc)(size_t), + void * (*realloc)(void *, size_t), + void (*free)(void *)) +{ + emtp_state *statep; + + if (!alloc || !realloc || !free) + return NULL; + + statep = (emtp_state *) (*alloc)(sizeof(emtp_state)); + if (!statep) + return NULL; + + statep->version.major = 0; + statep->version.minor = 0; + statep->flags = 0; + statep->progress = EMTP_PROGRESS_PARSE_HDR_VSN; + + statep->nodename[0] = '\0'; + statep->hostname[0] = '\0'; + statep->pid[0] = '\0'; + + statep->start_time.year = 0; + statep->start_time.month = 0; + statep->start_time.day = 0; + statep->start_time.hour = 0; + statep->start_time.minute = 0; + statep->start_time.second = 0; + statep->start_time.micro_second = 0; + + statep->parse_body_func = NULL; + statep->time.secs = 0; + statep->time.usecs = 0; + statep->force_return = 0; + statep->overflow_size = 0; + statep->overflow_buf_size = DEFAULT_OVERFLOW_BUF_SZ; + statep->overflow = + (usgnd_int_8 *) (*alloc)(DEFAULT_OVERFLOW_BUF_SZ*sizeof(usgnd_int_8)); + statep->fetch_size = 0; + statep->known_need = 0; + statep->segment_ix = 0; + statep->max_allocator_ix = 0; + statep->allocator = NULL; + statep->max_block_type_ix = 0; + statep->block_type = NULL; + statep->alloc = alloc; + statep->realloc = realloc; + statep->free = free; + + return statep; +} + +void +emtp_state_destroy(emtp_state *statep) +{ + void (*freep)(void *); + int i; + + if (!statep) + return; + + freep = statep->free; + + if (statep->overflow) + (*freep)((void *) statep->overflow); + + if (statep->allocator) { + for (i = -1; i <= statep->max_allocator_ix; i++) { + if (statep->allocator[i]) { + if (statep->allocator[i]->name + && statep->allocator[i]->name != unknown_allocator) + (*freep)((void *) statep->allocator[i]->name); + if (statep->allocator[i]->carrier.provider) + (*freep)((void *) statep->allocator[i]->carrier.provider); + (*freep)((void *) statep->allocator[i]); + } + } + statep->allocator--; + (*freep)((void *) statep->allocator); + } + + if (statep->block_type) { + for (i = -1; i <= statep->max_block_type_ix; i++) { + if (statep->block_type[i]) { + if (statep->block_type[i]->name + && statep->block_type[i]->name != unknown_block_type) + (*freep)((void *) statep->block_type[i]->name); + (*freep)((void *) statep->block_type[i]); + } + } + statep->block_type--; + (*freep)((void *) statep->block_type); + } + + (*freep)((void *) statep); +} + +/* + * The following macros are for use in emtp_parse(), parse_vX_body, + * and parse_header. + * + * Note that some of them depend on function local variable names + * and lables: + * + * Variables: + * * result -> the result to return + * * statep -> pointer to the state + * + * Lables: + * * restore_return -> restore then return result + */ + + +#define GET_UI8(UI, BP) ((UI) = *((BP)++)) +#define GET_UI16(UI, BP) \ + do { \ + (UI) = ((( (usgnd_int_16) (BP)[0]) << 8) \ + | ((usgnd_int_16) (BP)[1])); \ + (BP) += UI16_SZ; \ +} while(0) + +#define GET_UI32(UI, BP) \ + do { \ + (UI) = ((( (usgnd_int_32) (BP)[0]) << 24) \ + | (((usgnd_int_32) (BP)[1]) << 16) \ + | (((usgnd_int_32) (BP)[2]) << 8) \ + | ( (usgnd_int_32) (BP)[3])); \ + (BP) += UI32_SZ; \ +} while(0) + +#define GET_UI64(UI, BP) \ + do { \ + (UI) = ((( (usgnd_int_64) (BP)[0]) << 56) \ + | (((usgnd_int_64) (BP)[1]) << 48) \ + | (((usgnd_int_64) (BP)[2]) << 40) \ + | (((usgnd_int_64) (BP)[3]) << 32) \ + | (((usgnd_int_64) (BP)[4]) << 24) \ + | (((usgnd_int_64) (BP)[5]) << 16) \ + | (((usgnd_int_64) (BP)[6]) << 8) \ + | ( (usgnd_int_64) (BP)[7])); \ + (BP) += UI64_SZ; \ +} while(0) + +#define GET_VSZ_UI16(UI, BP, MSB) \ +do { \ + usgnd_int_16 ui_ = 0; \ + switch ((MSB)) { \ + case 1: ui_ |= (usgnd_int_16) *((BP)++); ui_ <<= 8; \ + case 0: ui_ |= (usgnd_int_16) *((BP)++); break; \ + default: ERROR(EMTP_PARSE_ERROR); \ + } \ + (UI) = ui_; \ +} while (0) + +#define GET_VSZ_UI32(UI, BP, MSB) \ +do { \ + usgnd_int_32 ui_ = 0; \ + switch ((MSB)) { \ + case 3: ui_ |= (usgnd_int_32) *((BP)++); ui_ <<= 8; \ + case 2: ui_ |= (usgnd_int_32) *((BP)++); ui_ <<= 8; \ + case 1: ui_ |= (usgnd_int_32) *((BP)++); ui_ <<= 8; \ + case 0: ui_ |= (usgnd_int_32) *((BP)++); break; \ + default: ERROR(EMTP_PARSE_ERROR); \ + } \ + (UI) = ui_; \ +} while (0) + +#define GET_VSZ_UI64(UI, BP, MSB) \ +do { \ + usgnd_int_64 ui_ = 0; \ + switch ((MSB)) { \ + case 7: ui_ |= (usgnd_int_64) *((BP)++); ui_ <<= 8; \ + case 6: ui_ |= (usgnd_int_64) *((BP)++); ui_ <<= 8; \ + case 5: ui_ |= (usgnd_int_64) *((BP)++); ui_ <<= 8; \ + case 4: ui_ |= (usgnd_int_64) *((BP)++); ui_ <<= 8; \ + case 3: ui_ |= (usgnd_int_64) *((BP)++); ui_ <<= 8; \ + case 2: ui_ |= (usgnd_int_64) *((BP)++); ui_ <<= 8; \ + case 1: ui_ |= (usgnd_int_64) *((BP)++); ui_ <<= 8; \ + case 0: ui_ |= (usgnd_int_64) *((BP)++); break; \ + default: ERROR(EMTP_PARSE_ERROR); \ + } \ + (UI) = ui_; \ +} while (0) + + +#if HAVE_INT_64 +#define GET_VSZ_UIMAX(UI, BP, MSB) \ +do { \ + usgnd_int_64 ui64_; \ + GET_VSZ_UI64(ui64_, (BP), (MSB)); \ + (UI) = (usgnd_int_max) ui64_; \ +} while (0) +#else +#define GET_VSZ_UIMAX(UI, BP, MSB) \ +do { \ + usgnd_int_32 ui32_; \ + GET_VSZ_UI32(ui32_, (BP), (MSB)); \ + (UI) = (usgnd_int_max) ui32_; \ +} while (0) +#endif + + + +#define INC_TIME(C_SECS, C_USECS, SECS, USECS) \ +do { \ + if ((USECS) >= 1000000) \ + ERROR(EMTP_PARSE_ERROR); \ + (C_SECS) += (SECS); \ + (C_USECS) += (USECS); \ + if ((C_USECS) >= 1000000) { \ + (C_USECS) -= 1000000; \ + (C_SECS)++; \ + } \ +} while (0) + +#if PRINT_ERROR_ORIGIN +#include +#define ERROR(E) \ +do { \ + result = (E); \ + fprintf(stderr,"ERROR:%s:%d: result=%d\n",__FILE__,__LINE__,result);\ + statep->force_return = 1; abort(); \ + goto restore_return; \ +} while (0) +#else +#define ERROR(E) do { \ + result = (E); \ + statep->force_return = 1; \ + goto restore_return; \ +} while (0) +#endif + +#define NEED(NSZ, TSZ) \ +do { \ + sgnd_int_32 need_ = (NSZ); \ + if (need_ > (TSZ)) { \ + statep->known_need = 1; \ + statep->fetch_size = need_; \ + result = EMTP_NEED_MORE_TRACE; \ + goto restore_return; \ + } \ +} while (0) + +#define NEED_AT_LEAST(NSZ, FSZ, TSZ) \ +do { \ + sgnd_int_32 need_ = (NSZ); \ + ASSERT(need_ <= (FSZ)); \ + if (need_ > (TSZ)) { \ + statep->known_need = 0; \ + statep->fetch_size = (FSZ); \ + result = EMTP_NEED_MORE_TRACE; \ + goto restore_return; \ + } \ +} while (0) + + +#define SECS_PER_DAY (60*60*24) +#define IS_LEAP_YEAR(X) (((X) % 4 == 0 && (X) % 100 != 0) || (X) % 400 == 0) + +static void +set_start_time(emtp_state *state, + usgnd_int_32 giga_seconds, + usgnd_int_32 seconds, + usgnd_int_32 micro_seconds) +{ + /* Input is elapsed time since 1970-01-01 00:00.000000 (UTC) */ + + usgnd_int_32 year, days_of_this_year, days, secs, month; + usgnd_int_32 days_of_month[] = {0,31,28,31,30,31,30,31,31,30,31,30,31}; + + days = 1000000000 / SECS_PER_DAY; + secs = 1000000000 % SECS_PER_DAY; + days *= giga_seconds; + secs *= giga_seconds; + secs += seconds; + days += secs / SECS_PER_DAY; + secs %= SECS_PER_DAY; + days++; + + year = 1969; + days_of_this_year = 0; + while (days > days_of_this_year) { + days -= days_of_this_year; + year++; + days_of_this_year = 365 + (IS_LEAP_YEAR(year) ? 1 : 0); + } + + for (month = 1; month <= 12; month++) { + usgnd_int_32 days_of_this_month = days_of_month[month]; + if (month == 2 && IS_LEAP_YEAR(year)) + days_of_this_month++; + if (days <= days_of_this_month) + break; + days -= days_of_this_month; + } + + state->start_time.year = year; + state->start_time.month = month; + state->start_time.day = days; + state->start_time.hour = secs / (60*60); + secs %= 60*60; + state->start_time.minute = secs / 60; + state->start_time.second = secs % 60; + state->start_time.micro_second = micro_seconds; +} + +static int +parse_v1_body(emtp_state *statep, + usgnd_int_8 **tracepp, usgnd_int_8 *trace_endp, + emtp_operation **op_pp, emtp_operation *op_endp, size_t op_size) +{ + /* "cache" some frequently used values */ + register usgnd_int_8 *c_p = *tracepp; + register emtp_operation *op_p = *op_pp; + register usgnd_int_32 current_secs = statep->time.secs; + register usgnd_int_32 current_usecs = statep->time.usecs; + + sgnd_int_32 trace_size = trace_endp - c_p; + usgnd_int_8 *tracep = c_p; + int result = 0; + + usgnd_int_16 max_block_type = statep->max_block_type_ix; + + while (trace_size >= UI16_SZ) { + usgnd_int_16 ehdr, tag; + unsigned time_inc_msb; + + GET_UI16(ehdr, c_p); + tag = ehdr & ERTS_MT_TAG_EHDR_FLD_MSK; + switch (tag) { + case ERTS_MT_V1_ALLOC_TAG: + + op_p->type = EMTP_ALLOC; + + alloc_common: { + usgnd_int_16 block_type; + unsigned block_type_msb, new_ptr_msb, new_size_msb; + + ehdr >>= ERTS_MT_TAG_EHDR_FLD_SZ; + block_type_msb = ehdr & ERTS_MT_UI16_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI16_MSB_EHDR_FLD_SZ; + new_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + new_size_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + + 4 + + block_type_msb + + new_ptr_msb + + new_size_msb + + time_inc_msb, + trace_size); + + GET_VSZ_UI16(block_type, c_p, block_type_msb); + if (block_type > max_block_type) + ERROR(EMTP_PARSE_ERROR); + op_p->u.block.type = (int) block_type; + + GET_VSZ_UIMAX(op_p->u.block.new_ptr, c_p, new_ptr_msb); + GET_VSZ_UIMAX(op_p->u.block.new_size, c_p, new_size_msb); + + op_p->u.block.prev_ptr = 0; + } + + read_time_inc: { + usgnd_int_32 secs, usecs, time_inc; + + GET_VSZ_UI32(time_inc, c_p, time_inc_msb); + + secs = ((time_inc >> ERTS_MT_TIME_INC_SECS_SHIFT) + & ERTS_MT_TIME_INC_SECS_MASK); + usecs = ((time_inc >> ERTS_MT_TIME_INC_USECS_SHIFT) + & ERTS_MT_TIME_INC_USECS_MASK); + + INC_TIME(current_secs, current_usecs, secs, usecs); + + op_p->time.secs = current_secs; + op_p->time.usecs = current_usecs; + +#if PRINT_PARSED_OP + print_op(op_p); +#endif + + op_p = (emtp_operation *) (((char *) op_p) + op_size); + break; + } + + case ERTS_MT_V1_REALLOC_NPB_TAG: + op_p->type = EMTP_REALLOC; + goto alloc_common; + + case ERTS_MT_V1_REALLOC_MV_TAG: { + unsigned new_ptr_msb, prev_ptr_msb, new_size_msb; + + op_p->type = EMTP_REALLOC; + + ehdr >>= ERTS_MT_TAG_EHDR_FLD_SZ; + new_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + prev_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + new_size_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + + 4 + + new_ptr_msb + + prev_ptr_msb + + new_size_msb + + time_inc_msb, + trace_size); + + GET_VSZ_UIMAX(op_p->u.block.new_ptr, c_p, new_ptr_msb); + GET_VSZ_UIMAX(op_p->u.block.prev_ptr, c_p, prev_ptr_msb); + GET_VSZ_UIMAX(op_p->u.block.new_size, c_p, new_size_msb); + + op_p->u.block.type = UNKNOWN_BLOCK_TYPE_IX; + goto read_time_inc; + } + + case ERTS_MT_V1_REALLOC_NMV_TAG: { + usgnd_int_max new_ptr; + unsigned new_ptr_msb, new_size_msb; + + op_p->type = EMTP_REALLOC; + + ehdr >>= ERTS_MT_TAG_EHDR_FLD_SZ; + new_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + new_size_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + + 3 + + new_ptr_msb + + new_size_msb + + time_inc_msb, + trace_size); + + GET_VSZ_UIMAX(new_ptr, c_p, new_ptr_msb); + GET_VSZ_UIMAX(op_p->u.block.new_size, c_p, new_size_msb); + + op_p->u.block.new_ptr = new_ptr; + op_p->u.block.prev_ptr = new_ptr; + + op_p->u.block.type = UNKNOWN_BLOCK_TYPE_IX; + goto read_time_inc; + } + + case ERTS_MT_V1_FREE_TAG: { + unsigned prev_ptr_msb; + + op_p->type = EMTP_FREE; + + ehdr >>= ERTS_MT_TAG_EHDR_FLD_SZ; + prev_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + + 2 + + prev_ptr_msb + + time_inc_msb, + trace_size); + + GET_VSZ_UIMAX(op_p->u.block.prev_ptr, c_p, prev_ptr_msb); + + op_p->u.block.new_ptr = 0; + op_p->u.block.new_size = 0; + + op_p->u.block.type = UNKNOWN_BLOCK_TYPE_IX; + goto read_time_inc; + } + + case ERTS_MT_V1_TIME_INC_TAG: { + unsigned secs_msb, usecs_msb; + usgnd_int_32 secs, usecs; + + ehdr >>= ERTS_MT_TAG_EHDR_FLD_SZ; + + secs_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI32_MSB_EHDR_FLD_SZ; + + usecs_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + 2 + secs_msb + usecs_msb, trace_size); + + GET_VSZ_UI32(secs, c_p, secs_msb); + GET_VSZ_UI32(usecs, c_p, usecs_msb); + + INC_TIME(current_secs, current_usecs, secs, usecs); + + break; + } + + case ERTS_MT_V1_STOP_TAG: + + op_p->type = EMTP_STOP; + + ehdr >>= ERTS_MT_TAG_EHDR_FLD_SZ; + + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + 1 + time_inc_msb, trace_size); + + goto read_ending_time_inc; + + case ERTS_MT_V1_EXIT_TAG: { + unsigned exit_status_msb; + + op_p->type = EMTP_EXIT; + + ehdr >>= ERTS_MT_TAG_EHDR_FLD_SZ; + exit_status_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI32_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + 2 + exit_status_msb + time_inc_msb, + trace_size); + + GET_VSZ_UI32(op_p->u.exit_status, c_p, exit_status_msb); + + read_ending_time_inc: { + usgnd_int_32 secs, usecs, time_inc; + + GET_VSZ_UI32(time_inc, c_p, time_inc_msb); + + secs = ((time_inc >> ERTS_MT_TIME_INC_SECS_SHIFT) + & ERTS_MT_TIME_INC_SECS_MASK); + usecs = ((time_inc >> ERTS_MT_TIME_INC_USECS_SHIFT) + & ERTS_MT_TIME_INC_USECS_MASK); + + INC_TIME(current_secs, current_usecs, secs, usecs); + + op_p->time.secs = current_secs; + op_p->time.usecs = current_usecs; + +#if PRINT_PARSED_OP + print_op(op_p); +#endif + + op_p = (emtp_operation *) (((char *) op_p) + op_size); + statep->force_return = 1; + statep->progress = EMTP_PROGRESS_ENDED; + + tracep = c_p; + trace_size = trace_endp - tracep; + result = (trace_size + ? EMTP_END_OF_TRACE_GARBAGE_FOLLOWS + : EMTP_END_OF_TRACE); + goto restore_return; + } + } + + case ERTS_MT_V1_ALLOCATOR_TAG: + case ERTS_MT_V1_BLOCK_TYPE_TAG: + +#ifdef DEBUG + hexdump(tracep, trace_endp); +#endif + ERROR(EMTP_HEADER_TAG_IN_BODY_ERROR); + + default: + +#ifdef DEBUG + hexdump(tracep, trace_endp); +#endif + ERROR(EMTP_UNKNOWN_TAG_ERROR); + } + + tracep = c_p; + trace_size = trace_endp - tracep; + + if (op_p >= op_endp) { + statep->force_return = 1; + result = EMTP_ALL_OPS_FILLED; + goto restore_return; + } + } + + statep->known_need = 0; + statep->fetch_size = ERTS_MT_MAX_V1_BODY_ENTRY_SIZE; + + result = EMTP_NEED_MORE_TRACE; + + restore_return: + *tracepp = tracep; + *op_pp = op_p; + statep->time.secs = current_secs; + statep->time.usecs = current_usecs; + + return result; +} + +#define GET_ALLOC_MSBS(EHDR, BT, NP, NS, TI) \ +do { \ + (BT) = (EHDR) & ERTS_MT_UI16_MSB_EHDR_FLD_MSK; \ + (EHDR) >>= ERTS_MT_UI16_MSB_EHDR_FLD_SZ; \ + (NP) = (EHDR) & ERTS_MT_UI_MSB_EHDR_FLD_MSK; \ + (EHDR) >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; \ + (NS) = (EHDR) & ERTS_MT_UI_MSB_EHDR_FLD_MSK; \ + (EHDR) >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; \ + (TI) = (EHDR) & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; \ +} while (0) + + +static EMTP_INLINE int +parse_v2_body(emtp_state *statep, + usgnd_int_8 **tracepp, usgnd_int_8 *trace_endp, + emtp_operation **op_pp, emtp_operation *op_endp, size_t op_size) +{ + /* "cache" some frequently used values */ + register usgnd_int_8 *c_p = *tracepp; + register emtp_operation *op_p = *op_pp; + register usgnd_int_32 current_secs = statep->time.secs; + register usgnd_int_32 current_usecs = statep->time.usecs; + + sgnd_int_32 trace_size = trace_endp - c_p; + usgnd_int_8 *tracep = c_p; + int result = 0; + + while (trace_size >= UI8_SZ + UI16_SZ) { + usgnd_int_8 tag; + usgnd_int_16 ehdr; + unsigned time_inc_msb; + + tag = *(c_p++); + + GET_UI16(ehdr, c_p); + + switch (tag) { + + case ERTS_MT_CRR_ALLOC_BDY_TAG: { + usgnd_int_16 type; + unsigned carrier_bytes, carrier_type_msb, block_type_msb, + new_ptr_msb, new_size_msb; + + op_p->type = EMTP_CARRIER_ALLOC; + + carrier_type_msb = ehdr & ERTS_MT_UI16_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI16_MSB_EHDR_FLD_SZ; + + if (trace_size < ERTS_MT_MAX_CRR_ALLOC_SIZE) + NEED_AT_LEAST(UI8_SZ + UI16_SZ + 1 + carrier_type_msb, + ERTS_MT_MAX_CRR_ALLOC_SIZE, + trace_size); + + GET_VSZ_UI16(type, c_p, carrier_type_msb); + op_p->u.block.carrier_type = (int) type; + + carrier_bytes = carrier_type_msb + 1; + goto alloc_common; + + case ERTS_MT_ALLOC_BDY_TAG: + + op_p->type = EMTP_ALLOC; + carrier_bytes = 0; + + alloc_common: + block_type_msb = ehdr & ERTS_MT_UI16_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI16_MSB_EHDR_FLD_SZ; + new_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + new_size_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + if (trace_size < ERTS_MT_MAX_CRR_ALLOC_SIZE) + NEED(UI8_SZ + + UI16_SZ + + 4 + + carrier_bytes + + block_type_msb + + new_ptr_msb + + new_size_msb + + time_inc_msb, + trace_size); + + GET_VSZ_UI16(type, c_p, block_type_msb); + op_p->u.block.type = (int) type; + + GET_VSZ_UIMAX(op_p->u.block.new_ptr, c_p, new_ptr_msb); + GET_VSZ_UIMAX(op_p->u.block.new_size, c_p, new_size_msb); + + op_p->u.block.prev_ptr = 0; + } + + read_time_inc: { + usgnd_int_32 secs, usecs, time_inc; + + GET_VSZ_UI32(time_inc, c_p, time_inc_msb); + + secs = ((time_inc >> ERTS_MT_TIME_INC_SECS_SHIFT) + & ERTS_MT_TIME_INC_SECS_MASK); + usecs = ((time_inc >> ERTS_MT_TIME_INC_USECS_SHIFT) + & ERTS_MT_TIME_INC_USECS_MASK); + + INC_TIME(current_secs, current_usecs, secs, usecs); + + op_p->time.secs = current_secs; + op_p->time.usecs = current_usecs; + +#if PRINT_PARSED_OP + print_op(op_p); +#endif + + op_p = (emtp_operation *) (((char *) op_p) + op_size); + break; + } + + case ERTS_MT_CRR_REALLOC_BDY_TAG: { + usgnd_int_16 type; + unsigned carrier_bytes, carrier_type_msb, block_type_msb, + new_ptr_msb, prev_ptr_msb, new_size_msb; + + op_p->type = EMTP_CARRIER_REALLOC; + + carrier_type_msb = ehdr & ERTS_MT_UI16_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI16_MSB_EHDR_FLD_SZ; + + if (trace_size < ERTS_MT_MAX_CRR_REALLOC_SIZE) + NEED_AT_LEAST(UI8_SZ + UI16_SZ + 1 + carrier_type_msb, + ERTS_MT_MAX_CRR_REALLOC_SIZE, + trace_size); + + GET_VSZ_UI16(type, c_p, carrier_type_msb); + op_p->u.block.carrier_type = (int) type; + + carrier_bytes = carrier_type_msb + 1; + goto realloc_common; + + case ERTS_MT_REALLOC_BDY_TAG: + + op_p->type = EMTP_REALLOC; + carrier_bytes = 0; + + realloc_common: + + block_type_msb = ehdr & ERTS_MT_UI16_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI16_MSB_EHDR_FLD_SZ; + new_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + prev_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + new_size_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + if (trace_size < ERTS_MT_MAX_CRR_REALLOC_SIZE) + NEED(UI8_SZ + + UI16_SZ + + 5 + + carrier_bytes + + block_type_msb + + new_ptr_msb + + prev_ptr_msb + + new_size_msb + + time_inc_msb, + trace_size); + + GET_VSZ_UI16(op_p->u.block.type, c_p, block_type_msb); + GET_VSZ_UIMAX(op_p->u.block.new_ptr, c_p, new_ptr_msb); + GET_VSZ_UIMAX(op_p->u.block.prev_ptr, c_p, prev_ptr_msb); + GET_VSZ_UIMAX(op_p->u.block.new_size, c_p, new_size_msb); + + goto read_time_inc; + } + + case ERTS_MT_CRR_FREE_BDY_TAG: { + usgnd_int_16 type; + unsigned carrier_bytes, carrier_type_msb, block_type_msb, + prev_ptr_msb; + + op_p->type = EMTP_CARRIER_FREE; + + carrier_type_msb = ehdr & ERTS_MT_UI16_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI16_MSB_EHDR_FLD_SZ; + + if (trace_size < ERTS_MT_MAX_CRR_FREE_SIZE) + NEED_AT_LEAST(UI8_SZ + UI16_SZ + 1 + carrier_type_msb, + ERTS_MT_MAX_CRR_FREE_SIZE, + trace_size); + + GET_VSZ_UI16(type, c_p, carrier_type_msb); + op_p->u.block.carrier_type = (int) type; + + carrier_bytes = carrier_type_msb + 1; + goto free_common; + + case ERTS_MT_FREE_BDY_TAG: + + op_p->type = EMTP_FREE; + carrier_bytes = 0; + + free_common: + + block_type_msb = ehdr & ERTS_MT_UI16_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI16_MSB_EHDR_FLD_SZ; + prev_ptr_msb = ehdr & ERTS_MT_UI_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + if (trace_size < ERTS_MT_MAX_CRR_FREE_SIZE) + NEED(UI8_SZ + + UI16_SZ + + 3 + + carrier_bytes + + block_type_msb + + prev_ptr_msb + + time_inc_msb, + trace_size); + + GET_VSZ_UI16(op_p->u.block.type, c_p, block_type_msb); + GET_VSZ_UIMAX(op_p->u.block.prev_ptr, c_p, prev_ptr_msb); + + op_p->u.block.new_ptr = 0; + op_p->u.block.new_size = 0; + + goto read_time_inc; + } + + case ERTS_MT_TIME_INC_BDY_TAG: { + unsigned secs_msb, usecs_msb; + usgnd_int_32 secs, usecs; + + secs_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI32_MSB_EHDR_FLD_SZ; + usecs_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI8_SZ + UI16_SZ + 2 + secs_msb + usecs_msb, trace_size); + + GET_VSZ_UI32(secs, c_p, secs_msb); + GET_VSZ_UI32(usecs, c_p, usecs_msb); + + INC_TIME(current_secs, current_usecs, secs, usecs); + + break; + } + + case ERTS_MT_STOP_BDY_TAG: + + op_p->type = EMTP_STOP; + + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + 1 + time_inc_msb, trace_size); + + goto read_ending_time_inc; + + case ERTS_MT_EXIT_BDY_TAG: { + unsigned exit_status_msb; + + op_p->type = EMTP_EXIT; + + exit_status_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + ehdr >>= ERTS_MT_UI32_MSB_EHDR_FLD_SZ; + time_inc_msb = ehdr & ERTS_MT_UI32_MSB_EHDR_FLD_MSK; + + NEED(UI16_SZ + 2 + exit_status_msb + time_inc_msb, trace_size); + + GET_VSZ_UI32(op_p->u.exit_status, c_p, exit_status_msb); + + read_ending_time_inc: { + usgnd_int_32 secs, usecs, time_inc; + + GET_VSZ_UI32(time_inc, c_p, time_inc_msb); + + secs = ((time_inc >> ERTS_MT_TIME_INC_SECS_SHIFT) + & ERTS_MT_TIME_INC_SECS_MASK); + usecs = ((time_inc >> ERTS_MT_TIME_INC_USECS_SHIFT) + & ERTS_MT_TIME_INC_USECS_MASK); + + INC_TIME(current_secs, current_usecs, secs, usecs); + + op_p->time.secs = current_secs; + op_p->time.usecs = current_usecs; + +#if PRINT_PARSED_OP + print_op(op_p); +#endif + + op_p = (emtp_operation *) (((char *) op_p) + op_size); + statep->force_return = 1; + statep->progress = EMTP_PROGRESS_ENDED; + + tracep = c_p; + trace_size = trace_endp - tracep; + result = (trace_size + ? EMTP_END_OF_TRACE_GARBAGE_FOLLOWS + : EMTP_END_OF_TRACE); + goto restore_return; + } + } + + case ERTS_MT_X_BDY_TAG: { + /* X for extension + * ehdr contains total size of entry + * + * Entry should at least consist of tag (1 byte), + * total size (2 bytes) and subtag (1 byte). + */ + if (ehdr < UI8_SZ + UI16_SZ + UI8_SZ) + ERROR(EMTP_PARSE_ERROR); + NEED(ehdr, trace_size); + c_p = tracep + ehdr; /* No subtags known yet skip entry... */ + break; + } + + default: +#ifdef DEBUG + hexdump(c_p-2, trace_endp); +#endif + ERROR(EMTP_UNKNOWN_TAG_ERROR); + } + + tracep = c_p; + trace_size = trace_endp - tracep; + + if (op_p >= op_endp) { + statep->force_return = 1; + result = EMTP_ALL_OPS_FILLED; + goto restore_return; + } + } + + statep->known_need = 0; + statep->fetch_size = ERTS_MT_MAX_BODY_ENTRY_SIZE; + + result = EMTP_NEED_MORE_TRACE; + + restore_return: + *tracepp = tracep; + *op_pp = op_p; + statep->time.secs = current_secs; + statep->time.usecs = current_usecs; + + return result; +} + +static void +remove_unused_allocators(emtp_state *statep) +{ + emtp_allocator *allctr; + sgnd_int_32 i, j, k; + for (i = -1; i <= statep->max_block_type_ix; i++) { + if (statep->block_type[i]->valid) { + allctr = statep->allocator[statep->block_type[i]->allocator]; + if (allctr->name != unknown_allocator) + allctr->valid = 1; + } + } + for (i = -1; i <= statep->max_allocator_ix; i++) { + allctr = statep->allocator[i]; + if (allctr->valid && allctr->carrier.provider) { + for (j = 0; j < allctr->carrier.no_providers; j++) { + k = allctr->carrier.provider[j]; + if (statep->allocator[k]->name != unknown_allocator) + statep->allocator[k]->valid = 1; + } + } + } + for (i = -1; i <= statep->max_allocator_ix; i++) { + allctr = statep->allocator[i]; + if (!allctr->valid) { + allctr->flags = 0; + if (allctr->name != unknown_allocator) { + (*statep->free)((void *) allctr->name); + allctr->name = unknown_allocator; + } + allctr->carrier.no_providers = 0; + if (allctr->carrier.provider) { + (*statep->free)((void *) allctr->carrier.provider); + } + } + } +} + +static int +parse_header(emtp_state *statep, + usgnd_int_8 **tracepp, usgnd_int_8 *trace_endp) +{ + sgnd_int_32 trace_size; + usgnd_int_8 *tracep; + int i, result; + + tracep = *tracepp; + + switch (statep->progress) { + case EMTP_PROGRESS_PARSE_HDR_VSN: { + usgnd_int_32 start_word; + + trace_size = trace_endp - tracep; + NEED(3*UI32_SZ, trace_size); + + GET_UI32(start_word, tracep); + if (start_word != ERTS_MT_START_WORD) + return EMTP_NOT_AN_ERL_MTRACE_ERROR; + + GET_UI32(statep->version.major, tracep); + GET_UI32(statep->version.minor, tracep); + + statep->progress = EMTP_PROGRESS_PARSE_HDR_PROLOG; + } + case EMTP_PROGRESS_PARSE_HDR_PROLOG: + + trace_size = trace_endp - tracep; + + switch (statep->version.major) { + case 1: { + usgnd_int_32 hdr_sz; + NEED(2*UI32_SZ + 2*UI16_SZ, trace_size); + + GET_UI32(statep->flags, tracep); + GET_UI32(hdr_sz, tracep); /* ignore this; may contain garbage! */ + GET_UI16(statep->max_allocator_ix, tracep); + GET_UI16(statep->max_block_type_ix, tracep); + + statep->parse_body_func = parse_v1_body; + + break; + } + case 2: { + usgnd_int_32 giga_seconds; + usgnd_int_32 seconds; + usgnd_int_32 micro_seconds; + usgnd_int_8 len; + usgnd_int_8 *hdr_prolog_start; + usgnd_int_32 hdr_prolog_sz; + NEED(UI32_SZ, trace_size); + hdr_prolog_start = tracep; + GET_UI32(hdr_prolog_sz, tracep); + NEED(hdr_prolog_sz - UI32_SZ, trace_size); + + GET_UI32(statep->flags, tracep); + GET_UI16(statep->segment_ix, tracep); + GET_UI16(statep->max_allocator_ix, tracep); + GET_UI16(statep->max_block_type_ix, tracep); + + GET_UI32(giga_seconds, tracep); + GET_UI32(seconds, tracep); + GET_UI32(micro_seconds, tracep); + + set_start_time(statep, giga_seconds, seconds, micro_seconds); + + GET_UI8(len, tracep); + memcpy((void *) statep->nodename, (void *) tracep, (size_t) len); + statep->nodename[len] = '\0'; + tracep += len; + + GET_UI8(len, tracep); + memcpy((void *) statep->hostname, (void *) tracep, (size_t) len); + statep->hostname[len] = '\0'; + tracep += len; + + GET_UI8(len, tracep); + memcpy((void *) statep->pid, (void *) tracep, (size_t) len); + statep->pid[len] = '\0'; + tracep += len; + + + + /* Skip things in header prolog we dont know about */ + tracep = hdr_prolog_start + hdr_prolog_sz; + +#if EMTP_CAN_INLINE + statep->parse_body_func = NULL; +#else + statep->parse_body_func = parse_v2_body; +#endif + + break; + } + default: + return EMTP_NOT_SUPPORTED_MTRACE_VERSION_ERROR; + } + + statep->progress = EMTP_PROGRESS_ALLOC_HDR_INFO; + + case EMTP_PROGRESS_ALLOC_HDR_INFO: + + /* Allocator info */ + if (!statep->allocator) { + statep->allocator = (emtp_allocator **) + (*statep->alloc)((statep->max_allocator_ix + 2) + * sizeof(emtp_allocator *)); + if (!statep->allocator) + ERROR(EMTP_NO_MEMORY_ERROR); + statep->allocator++; + for (i = -1; i <= statep->max_allocator_ix; i++) + statep->allocator[i] = NULL; + for (i = -1; i <= statep->max_allocator_ix; i++) { + statep->allocator[i] = (emtp_allocator *) + (*statep->alloc)(sizeof(emtp_allocator)); + if (!statep->allocator[i]) + ERROR(EMTP_NO_MEMORY_ERROR); + statep->allocator[i]->valid = 0; + statep->allocator[i]->flags = 0; + statep->allocator[i]->name = unknown_allocator; + statep->allocator[i]->carrier.no_providers = 0; + statep->allocator[i]->carrier.provider = NULL; + } + + } + + /* Block type info */ + if (!statep->block_type) { + statep->block_type = (emtp_block_type **) + (*statep->alloc)((statep->max_block_type_ix + 2) + * sizeof(emtp_block_type *)); + if (!statep->block_type) + ERROR(EMTP_NO_MEMORY_ERROR); + statep->block_type++; + for (i = -1; i <= statep->max_block_type_ix; i++) + statep->block_type[i] = NULL; + for (i = -1; i <= statep->max_block_type_ix; i++) { + statep->block_type[i] = (emtp_block_type *) + (*statep->alloc)(sizeof(emtp_block_type)); + if (!statep->block_type[i]) + ERROR(EMTP_NO_MEMORY_ERROR); + statep->block_type[i]->valid = 0; + statep->block_type[i]->flags = 0; + statep->block_type[i]->name = unknown_block_type; + statep->block_type[i]->allocator = UNKNOWN_ALLOCATOR_IX; + } + + } + + statep->progress = EMTP_PROGRESS_PARSE_TAGGED_HDR; + + case EMTP_PROGRESS_PARSE_TAGGED_HDR: { + usgnd_int_8 *c_p = tracep; + trace_size = trace_endp - tracep; + + switch (statep->version.major) { + case 1: /* Version 1.X ---------------------------------------------- */ + + while (trace_size >= UI16_SZ) { + size_t str_len; + usgnd_int_16 ehdr; + + GET_UI16(ehdr, c_p); + + switch (ehdr & ERTS_MT_TAG_EHDR_FLD_MSK) { + case ERTS_MT_V1_ALLOCATOR_TAG: { + usgnd_int_16 a_ix; + + NEED_AT_LEAST(2*UI16_SZ + UI8_SZ, + ERTS_MT_MAX_HEADER_ENTRY_SIZE, + trace_size); + + GET_UI16(a_ix, c_p); + if (a_ix > statep->max_allocator_ix) + ERROR(EMTP_PARSE_ERROR); + + GET_UI8(str_len, c_p); + + NEED(2*UI16_SZ + UI8_SZ + str_len, trace_size); + + statep->allocator[a_ix]->name + = (char *) (*statep->alloc)(str_len + 1); + if (!statep->allocator[a_ix]->name) + ERROR(EMTP_NO_MEMORY_ERROR); + + memcpy((void *) statep->allocator[a_ix]->name, + (void *) c_p, + str_len); + c_p += str_len; + + statep->allocator[a_ix]->name[str_len] = '\0'; + break; + } + case ERTS_MT_V1_BLOCK_TYPE_TAG: { + usgnd_int_16 bt_ix, a_ix; + + NEED_AT_LEAST(2*UI16_SZ + UI8_SZ, + ERTS_MT_MAX_HEADER_ENTRY_SIZE, + trace_size); + + GET_UI16(bt_ix, c_p); + if (bt_ix > statep->max_block_type_ix) + ERROR(EMTP_PARSE_ERROR); + + GET_UI8(str_len, c_p); + + NEED(2*UI16_SZ + UI8_SZ + str_len + UI16_SZ, trace_size); + + statep->block_type[bt_ix]->name + = (char *) (*statep->alloc)(str_len + 1); + + if (!statep->block_type[bt_ix]->name) + ERROR(EMTP_NO_MEMORY_ERROR); + + memcpy((void *) statep->block_type[bt_ix]->name, + (void *) c_p, + str_len); + c_p += str_len; + + statep->block_type[bt_ix]->name[str_len] = '\0'; + + GET_UI16(a_ix, c_p); + + if (a_ix > statep->max_allocator_ix) + ERROR(EMTP_PARSE_ERROR); + + statep->block_type[bt_ix]->allocator = (sgnd_int_32) a_ix; + statep->block_type[bt_ix]->valid = 1; + break; + } + + case ERTS_MT_V1_ALLOC_TAG: + case ERTS_MT_V1_REALLOC_NPB_TAG: + case ERTS_MT_V1_REALLOC_MV_TAG: + case ERTS_MT_V1_REALLOC_NMV_TAG: + case ERTS_MT_V1_FREE_TAG: + case ERTS_MT_V1_TIME_INC_TAG: + case ERTS_MT_V1_STOP_TAG: + case ERTS_MT_V1_EXIT_TAG: + remove_unused_allocators(statep); + statep->progress = EMTP_PROGRESS_PARSE_BODY; + result = EMTP_HEADER_PARSED; + statep->force_return = 1; + goto restore_return; + default: + ERROR(EMTP_UNKNOWN_TAG_ERROR); + } + + tracep = c_p; + trace_size = trace_endp - tracep; + } + + statep->fetch_size = ERTS_MT_MAX_V1_HEADER_ENTRY_SIZE; + break; + + case 2: /* Version 2.X ---------------------------------------------- */ + + while (trace_size >= UI8_SZ + UI16_SZ) { + usgnd_int_16 entry_sz; + size_t str_len; + usgnd_int_8 tag; + + GET_UI8(tag, c_p); + GET_UI16(entry_sz, c_p); + NEED(entry_sz, trace_size); + + switch (tag) { + case ERTS_MT_ALLOCATOR_HDR_TAG: { + usgnd_int_8 crr_prvds; + usgnd_int_16 a_ix, aflgs; + + if (entry_sz + < UI8_SZ + 3*UI16_SZ + UI8_SZ + 0 + UI8_SZ) + ERROR(EMTP_PARSE_ERROR); + + GET_UI16(aflgs, c_p); + GET_UI16(a_ix, c_p); + if (a_ix > statep->max_allocator_ix) + ERROR(EMTP_PARSE_ERROR); + + if (aflgs & ERTS_MT_ALLCTR_USD_CRR_INFO) + statep->allocator[a_ix]->flags + |= EMTP_ALLOCATOR_FLAG_HAVE_USED_CARRIERS_INFO; + + GET_UI8(str_len, c_p); + + if (entry_sz + < UI8_SZ + 3*UI16_SZ + UI8_SZ + str_len + UI8_SZ) + ERROR(EMTP_PARSE_ERROR); + + statep->allocator[a_ix]->name + = (char *) (*statep->alloc)(str_len + 1); + if (!statep->allocator[a_ix]->name) + ERROR(EMTP_NO_MEMORY_ERROR); + + memcpy((void *) statep->allocator[a_ix]->name, + (void *) c_p, + str_len); + c_p += str_len; + + statep->allocator[a_ix]->name[str_len] = '\0'; + + GET_UI8(crr_prvds, c_p); + if (entry_sz < (UI8_SZ + + 3*UI16_SZ + + UI8_SZ + + str_len + + UI8_SZ + + crr_prvds*UI16_SZ)) + ERROR(EMTP_PARSE_ERROR); + statep->allocator[a_ix]->carrier.no_providers + = (usgnd_int_16) crr_prvds; + statep->allocator[a_ix]->carrier.provider = (usgnd_int_16 *) + (*statep->alloc)(crr_prvds*sizeof(usgnd_int_16)); + if (!statep->allocator[a_ix]->carrier.provider) + ERROR(EMTP_NO_MEMORY_ERROR); + for (i = 0; i < crr_prvds; i++) { + usgnd_int_16 cp_ix; + GET_UI16(cp_ix, c_p); + if (cp_ix > statep->max_allocator_ix) + ERROR(EMTP_PARSE_ERROR); + statep->allocator[a_ix]->carrier.provider[i] = cp_ix; + } + + break; + } + + case ERTS_MT_BLOCK_TYPE_HDR_TAG: { + usgnd_int_16 bt_ix, a_ix, btflgs; + + if (entry_sz + < UI8_SZ + 3*UI16_SZ + UI8_SZ + 0 + UI16_SZ) + ERROR(EMTP_PARSE_ERROR); + + GET_UI16(btflgs, c_p); + GET_UI16(bt_ix, c_p); + if (bt_ix > statep->max_block_type_ix) + ERROR(EMTP_PARSE_ERROR); + + GET_UI8(str_len, c_p); + + if (entry_sz + < UI8_SZ + 3*UI16_SZ + UI8_SZ + str_len + UI16_SZ) + ERROR(EMTP_PARSE_ERROR); + + statep->block_type[bt_ix]->name + = (char *) (*statep->alloc)(str_len + 1); + + if (!statep->block_type[bt_ix]->name) + ERROR(EMTP_NO_MEMORY_ERROR); + + memcpy((void *) statep->block_type[bt_ix]->name, + (void *) c_p, + str_len); + c_p += str_len; + + statep->block_type[bt_ix]->name[str_len] = '\0'; + + GET_UI16(a_ix, c_p); + + if (a_ix > statep->max_allocator_ix) + ERROR(EMTP_PARSE_ERROR); + + statep->block_type[bt_ix]->allocator = (sgnd_int_32) a_ix; + statep->block_type[bt_ix]->valid = 1; + break; + } + + case ERTS_MT_END_OF_HDR_TAG: + tracep = tracep + ((size_t) entry_sz); + remove_unused_allocators(statep); + statep->progress = EMTP_PROGRESS_PARSE_BODY; + result = EMTP_HEADER_PARSED; + statep->force_return = 1; + goto restore_return; + + default: + /* Skip tags that we do not understand. */ + break; + } + + tracep = tracep + ((size_t) entry_sz); + ASSERT(c_p <= tracep); + c_p = tracep; + trace_size = trace_endp - tracep; + } + + statep->fetch_size = UI8_SZ + UI16_SZ; + break; + default: /* Not supported version --------------------------------- */ + ASSERT(0); + } + + break; + } + default: + ASSERT(0); + } + + statep->known_need = 0; + result = EMTP_NEED_MORE_TRACE; + + restore_return: + + *tracepp = tracep; + + return result; + +} + + +int +emtp_parse(emtp_state *statep, + usgnd_int_8 **tracepp, size_t *trace_lenp, + emtp_operation *op_start, size_t op_size, size_t *op_lenp) +{ + int result, have_all_in_overflow; + usgnd_int_8 *tracep, *trace_endp; + emtp_operation *op_p, *op_endp; + + + have_all_in_overflow = 0; + + op_p = op_start; + + if (!statep) + return EMTP_NO_MEMORY_ERROR; + + if (!tracepp || !trace_lenp) + return EMTP_NO_TRACE_ERROR; + + if (*trace_lenp <= 0) { + if (op_lenp) + *op_lenp = 0; + return EMTP_NEED_MORE_TRACE; + } + + statep->force_return = 0; + + if (statep->overflow_size) { /* Overflow from prevoius parse */ + sgnd_int_32 tsz; + sgnd_int_32 sz; + + fetch_for_overflow: + sz = statep->fetch_size - statep->overflow_size; + ASSERT(sz > 0); + + if (*trace_lenp <= sz) { + have_all_in_overflow = 1; + sz = *trace_lenp; + } + + if (sz > statep->overflow_buf_size) { + size_t buf_sz = statep->overflow_size + sz; + void *buf = (*statep->realloc)((void *) statep->overflow, buf_sz); + if (!buf) + return EMTP_NO_MEMORY_ERROR; + statep->overflow_buf_size = buf_sz; + statep->overflow = (usgnd_int_8 *) buf; + } + + memcpy((void *) (statep->overflow + statep->overflow_size), + (void *) *tracepp, + sz); + + tsz = statep->overflow_size + sz; + + tracep = statep->overflow; + trace_endp = statep->overflow + tsz; + + if (tsz < statep->fetch_size && statep->known_need) { + ASSERT(have_all_in_overflow); + statep->overflow_size = tsz; + op_endp = NULL; + result = EMTP_NEED_MORE_TRACE; + goto restore_return; + } + } + else { + tracep = *tracepp; + trace_endp = tracep + *trace_lenp; + } + + if (statep->progress == EMTP_PROGRESS_PARSE_BODY) { + +#if !HAVE_INT_64 + if (statep->flags & ERTS_MT_64_BIT_FLAG) + return EMTP_NOT_SUPPORTED_64_BITS_TRACE_ERROR; +#endif + + if (op_size < sizeof(emtp_operation)) + return EMTP_BAD_OP_SIZE_ERROR; + if (!op_start || !op_lenp || *op_lenp < 1) + return EMTP_NO_OPERATIONS_ERROR; + op_endp = (emtp_operation *) (((char *) op_start) + (*op_lenp)*op_size); + + restart_parse_body: +#if EMTP_CAN_INLINE + if (statep->parse_body_func) +#endif + result = (*statep->parse_body_func)(statep, + &tracep, trace_endp, + &op_p, op_endp, op_size); +#if EMTP_CAN_INLINE + else + result = parse_v2_body(statep, + &tracep, trace_endp, + &op_p, op_endp, op_size); +#endif + } + else { + restart_parse_header: + op_endp = NULL; + if (statep->progress == EMTP_PROGRESS_ENDED) { + result = EMTP_END_OF_TRACE; + goto restore_return; + } + result = parse_header(statep, &tracep, trace_endp); + } + + /* Check overflow */ + if (statep->overflow_size) { + if (tracep == statep->overflow) { + /* Nothing parsed, i.e. less new input than 1 entry :( */ + if (!have_all_in_overflow) + goto fetch_for_overflow; + statep->overflow_size = trace_endp - tracep; + trace_endp = tracep = *tracepp + *trace_lenp; + } + else { + size_t sz = tracep - (statep->overflow + statep->overflow_size); + + ASSERT(sz > 0); + + statep->overflow_size = 0; + + tracep = *tracepp + sz; + trace_endp = *tracepp + *trace_lenp; + ASSERT(trace_endp >= tracep); + if (!statep->force_return && (trace_endp - tracep)) { + if (statep->progress == EMTP_PROGRESS_PARSE_BODY) + goto restart_parse_body; + else + goto restart_parse_header; + } + /* else: got it all in the overflow buffer */ + } + } + else { + size_t sz = trace_endp - tracep; + if (!statep->force_return && sz) { + if (sz >= statep->fetch_size) { + ASSERT(0); + ERROR(EMTP_PARSE_ERROR); + } + if (sz > statep->overflow_buf_size) { + (*statep->free)((void *) statep->overflow); + statep->overflow = (usgnd_int_8 *) (*statep->alloc)(sz); + if (!statep->overflow) { + statep->overflow_buf_size = 0; + return EMTP_NO_MEMORY_ERROR; + } + statep->overflow_buf_size = sz; + } + memcpy((void *) statep->overflow, tracep, sz); + statep->overflow_size = sz; + ASSERT(tracep + sz == trace_endp); + tracep = trace_endp; + } + } + + restore_return: + ASSERT(trace_endp >= tracep); + + *tracepp = tracep; + *trace_lenp = trace_endp - tracep; + + if (op_lenp && op_size > 0) + *op_lenp = (int) (((char *) op_p) - ((char *) op_start))/op_size; + + return result; +} + +#ifdef DEBUG +static void +hexdump(void *start, void *end) +{ + unsigned char *p = (unsigned char *) start; + + fprintf(stderr, "hexdump: "); + while ((void *) p < end) { + fprintf(stderr, "%x", (unsigned) *p); + p++; + } + fprintf(stderr, "\n"); +} + +#if PRINT_PARSED_OP +static void +print_op(emtp_operation *op_p) +{ + switch (op_p->type) { + case EMTP_ALLOC: + fprintf(stderr, + "alloc: " + "type=%" USGND_INT_16_FSTR ", " + "ptr=%" USGND_INT_MAX_FSTR ", " + "sz=%" USGND_INT_MAX_FSTR ", " + "(secs=%" USGND_INT_32_FSTR ", usecs=%" USGND_INT_32_FSTR ")" + "\n", + op_p->u.block.type, + op_p->u.block.new_ptr, + op_p->u.block.new_size, + op_p->time.secs, + op_p->time.usecs); + break; + case EMTP_REALLOC: + fprintf(stderr, + "realloc: " + "type=%" USGND_INT_16_FSTR ", " + "ptr=%" USGND_INT_MAX_FSTR ", " + "prev_ptr=%" USGND_INT_MAX_FSTR ", " + "sz=%" USGND_INT_MAX_FSTR ", " + "(secs=%" USGND_INT_32_FSTR ", usecs=%" USGND_INT_32_FSTR ")" + "\n", + op_p->u.block.type, + op_p->u.block.new_ptr, + op_p->u.block.prev_ptr, + op_p->u.block.new_size, + op_p->time.secs, + op_p->time.usecs); + break; + case EMTP_FREE: + fprintf(stderr, + "free: " + "type=%" USGND_INT_16_FSTR ", " + "ptr=%" USGND_INT_MAX_FSTR ", " + "(secs=%" USGND_INT_32_FSTR ", usecs=%" USGND_INT_32_FSTR ")" + "\n", + op_p->u.block.type, + op_p->u.block.prev_ptr, + op_p->time.secs, + op_p->time.usecs); + break; + case EMTP_CARRIER_ALLOC: + fprintf(stderr, + "carrier_alloc: " + "type=%" USGND_INT_16_FSTR ", " + "carrier_type=%" USGND_INT_16_FSTR ", " + "ptr=%" USGND_INT_MAX_FSTR ", " + "sz=%" USGND_INT_MAX_FSTR ", " + "(secs=%" USGND_INT_32_FSTR ", usecs=%" USGND_INT_32_FSTR ")" + "\n", + op_p->u.block.type, + op_p->u.block.carrier_type, + op_p->u.block.new_ptr, + op_p->u.block.new_size, + op_p->time.secs, + op_p->time.usecs); + break; + case EMTP_CARRIER_REALLOC: + fprintf(stderr, + "carrier_realloc: " + "type=%" USGND_INT_16_FSTR ", " + "carrier_type=%" USGND_INT_16_FSTR ", " + "ptr=%" USGND_INT_MAX_FSTR ", " + "prev_ptr=%" USGND_INT_MAX_FSTR ", " + "sz=%" USGND_INT_MAX_FSTR ", " + "(secs=%" USGND_INT_32_FSTR ", usecs=%" USGND_INT_32_FSTR ")" + "\n", + op_p->u.block.type, + op_p->u.block.carrier_type, + op_p->u.block.new_ptr, + op_p->u.block.prev_ptr, + op_p->u.block.new_size, + op_p->time.secs, + op_p->time.usecs); + break; + case EMTP_CARRIER_FREE: + fprintf(stderr, + "carrier_free: " + "type=%" USGND_INT_16_FSTR ", " + "carrier_type=%" USGND_INT_16_FSTR ", " + "ptr=%" USGND_INT_MAX_FSTR ", " + "(secs=%" USGND_INT_32_FSTR ", usecs=%" USGND_INT_32_FSTR ")" + "\n", + op_p->u.block.type, + op_p->u.block.carrier_type, + op_p->u.block.prev_ptr, + op_p->time.secs, + op_p->time.usecs); + break; + case EMTP_STOP: + fprintf(stderr, + "stop: " + "(secs=%" USGND_INT_32_FSTR ", usecs=%" USGND_INT_32_FSTR ")" + "\n", + op_p->time.secs, + op_p->time.usecs); + break; + case EMTP_EXIT: + fprintf(stderr, + "exit: " + "status=%" USGND_INT_32_FSTR ", " + "(secs=%" USGND_INT_32_FSTR ", usecs=%" USGND_INT_32_FSTR ")" + "\n", + op_p->u.exit_status, + op_p->time.secs, + op_p->time.usecs); + break; + default: + fprintf(stderr, "Unknown op type: %d\n", op_p->type); + break; + } +} + +#endif +#endif diff --git a/erts/lib_src/common/erl_misc_utils.c b/erts/lib_src/common/erl_misc_utils.c new file mode 100644 index 0000000000..9c25d33a3c --- /dev/null +++ b/erts/lib_src/common/erl_misc_utils.c @@ -0,0 +1,967 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2006-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include "erl_misc_utils.h" + +#if defined(__WIN32__) +# include +#elif defined(VXWORKS) +# include +#else /* UNIX */ +# include +# include +# include +# include +# include +# include +# include +# ifdef SYS_SELECT_H +# include +# endif +# if TIME_WITH_SYS_TIME +# include +# include +# else +# if HAVE_SYS_TIME_H +# include +# else +# include +# endif +# endif +# include +# ifdef HAVE_UNISTD_H +# include +# endif +# if (defined(NO_SYSCONF) || !defined(_SC_NPROCESSORS_CONF)) +# ifdef HAVE_SYS_SYSCTL_H +# include +# endif +# endif +#endif + +#ifdef HAVE_SCHED_xETAFFINITY +# include +#endif +#ifdef HAVE_PSET_INFO +# include +#endif +#ifdef HAVE_PROCESSOR_BIND +# include +# include +#endif + +#include +#ifdef HAVE_LIMITS_H +#include +#endif + +#ifdef __linux__ +# define ERTS_SYS_NODE_PATH "/sys/devices/system/node" +# define ERTS_SYS_CPU_PATH "/sys/devices/system/cpu" +#endif + +static int read_topology(erts_cpu_info_t *cpuinfo); + +int +erts_milli_sleep(long ms) +{ + if (ms > 0) { +#ifdef __WIN32__ + Sleep((DWORD) ms); +#else + struct timeval tv; + tv.tv_sec = ms / 1000; + tv.tv_usec = (ms % 1000) * 1000; + if (select(0, NULL, NULL, NULL, &tv) < 0) + return errno == EINTR ? 1 : -1; +#endif + } + return 0; +} + +struct erts_cpu_info_t_ { + int configured; + int online; + int available; + int topology_size; + erts_cpu_topology_t *topology; +#if defined(HAVE_SCHED_xETAFFINITY) + char *affinity_str; + char affinity_str_buf[CPU_SETSIZE/4+2]; + cpu_set_t cpuset; + pid_t pid; +#elif defined(HAVE_PSET_INFO) + processorid_t *cpuids; +#endif +}; + +erts_cpu_info_t * +erts_cpu_info_create(void) +{ + erts_cpu_info_t *cpuinfo = malloc(sizeof(erts_cpu_info_t)); + if (!cpuinfo) + return NULL; +#if defined(HAVE_SCHED_xETAFFINITY) + cpuinfo->affinity_str = NULL; + cpuinfo->pid = getpid(); +#elif defined(HAVE_PSET_INFO) + cpuinfo->cpuids = NULL; +#endif + cpuinfo->topology_size = 0; + cpuinfo->topology = NULL; + erts_cpu_info_update(cpuinfo); + return cpuinfo; +} + +void +erts_cpu_info_destroy(erts_cpu_info_t *cpuinfo) +{ + if (cpuinfo) { + cpuinfo->configured = 0; + cpuinfo->online = 0; + cpuinfo->available = 0; +#ifdef HAVE_PSET_INFO + if (cpuinfo->cpuids) + free(cpuinfo->cpuids); +#endif + cpuinfo->topology_size = 0; + if (cpuinfo->topology) { + cpuinfo->topology = NULL; + free(cpuinfo->topology); + } + free(cpuinfo); + } +} + +void +erts_cpu_info_update(erts_cpu_info_t *cpuinfo) +{ + cpuinfo->configured = 0; + cpuinfo->online = 0; + cpuinfo->available = 0; + +#ifdef __WIN32__ + { + SYSTEM_INFO sys_info; + GetSystemInfo(&sys_info); + cpuinfo->configured = (int) sys_info.dwNumberOfProcessors; + + } +#elif !defined(NO_SYSCONF) && (defined(_SC_NPROCESSORS_CONF) \ + || defined(_SC_NPROCESSORS_ONLN)) +#ifdef _SC_NPROCESSORS_CONF + cpuinfo->configured = (int) sysconf(_SC_NPROCESSORS_CONF); + if (cpuinfo->configured < 0) + cpuinfo->configured = 0; +#endif +#ifdef _SC_NPROCESSORS_ONLN + cpuinfo->online = (int) sysconf(_SC_NPROCESSORS_ONLN); + if (cpuinfo->online < 0) + cpuinfo->online = 0; +#endif +#elif defined(HAVE_SYS_SYSCTL_H) && defined(CTL_HW) && (defined(HW_NCPU) \ + || defined(HW_AVAILCPU)) + { + int mib[2]; + size_t len; + +#ifdef HW_NCPU + len = sizeof(int); + mib[0] = CTL_HW; + mib[1] = HW_NCPU; + if (sysctl(&mib[0], 2, &cpuinfo->configured, &len, NULL, 0) < 0) + cpuinfo->configured = 0; +#endif +#ifdef HW_AVAILCPU + len = sizeof(int); + mib[0] = CTL_HW; + mib[1] = HW_AVAILCPU; + if (sysctl(&mib[0], 2, &cpuinfo->online, &len, NULL, 0) < 0) + cpuinfo->online = 0; +#endif + } +#endif + + if (cpuinfo->online > cpuinfo->configured) + cpuinfo->online = cpuinfo->configured; + +#ifdef HAVE_SCHED_xETAFFINITY + if (sched_getaffinity(cpuinfo->pid, sizeof(cpu_set_t), &cpuinfo->cpuset) == 0) { + int i, c, cn, si; + c = cn = 0; + si = sizeof(cpuinfo->affinity_str_buf) - 1; + cpuinfo->affinity_str_buf[si] = '\0'; + for (i = 0; i < CPU_SETSIZE; i++) { + if (CPU_ISSET(i, &cpuinfo->cpuset)) { + c |= 1 << cn; + cpuinfo->available++; + } + cn++; + if (cn == 4) { + cpuinfo->affinity_str_buf[--si] = (c < 10 + ? '0' + c + : 'A' + c - 10); + c = cn = 0; + } + } + if (c) + cpuinfo->affinity_str_buf[--si] = (c < 10 + ? '0' + c + : 'A' + c - 10); + while (cpuinfo->affinity_str_buf[si] == '0') + si++; + cpuinfo->affinity_str = &cpuinfo->affinity_str_buf[si]; + } +#elif defined(HAVE_PSET_INFO) + { + uint_t numcpus = cpuinfo->configured; + if (cpuinfo->cpuids) + free(cpuinfo->cpuids); + cpuinfo->cpuids = malloc(sizeof(processorid_t)*numcpus); + if (cpuinfo->cpuids) { + if (pset_info(PS_MYID, NULL, &numcpus, &cpuinfo->cpuids) == 0) + cpuinfo->available = (int) numcpus; + if (cpuinfo->available < 0) { + free(cpuinfo->cpuid); + cpuinfo->available = 0; + } + } + } +#endif + + if (cpuinfo->available > cpuinfo->online) + cpuinfo->available = cpuinfo->online; + + read_topology(cpuinfo); + +} + +int +erts_get_cpu_configured(erts_cpu_info_t *cpuinfo) +{ + if (!cpuinfo) + return -EINVAL; + if (cpuinfo->configured <= 0) + return -ENOTSUP; + return cpuinfo->configured; +} + +int +erts_get_cpu_online(erts_cpu_info_t *cpuinfo) +{ + if (!cpuinfo) + return -EINVAL; + if (cpuinfo->online <= 0) + return -ENOTSUP; + return cpuinfo->online; +} + +int +erts_get_cpu_available(erts_cpu_info_t *cpuinfo) +{ + if (!cpuinfo) + return -EINVAL; + if (cpuinfo->available <= 0) + return -ENOTSUP; + return cpuinfo->available; +} + +char * +erts_get_unbind_from_cpu_str(erts_cpu_info_t *cpuinfo) +{ +#if defined(HAVE_SCHED_xETAFFINITY) + if (!cpuinfo) + return "false"; + return cpuinfo->affinity_str; +#else + return "true"; +#endif +} + +int +erts_get_available_cpu(erts_cpu_info_t *cpuinfo, int no) +{ + if (!cpuinfo || no < 1 || cpuinfo->available < no) + return -EINVAL; +#ifdef HAVE_SCHED_xETAFFINITY + { + cpu_set_t *allowed = &cpuinfo->cpuset; + int ix, n; + for (ix = 0, n = 1; ix < CPU_SETSIZE; ix++) { + if (CPU_ISSET(ix, allowed)) { + if (no == n) + return ix; + n++; + } + } + } + return -EINVAL; +#elif defined(HAVE_PROCESSOR_BIND) +#if defined(HAVE_PSET_INFO) + return (int) cpuinfo->cpuids[no-1]; +#elif defined(HAVE_KSTAT) + if (cpuinfo->topology && cpuinfo->online <= no) { + /* May not be available, but this is the best we can do */ + return cpuinfo->topology[no-1].logical; + } + return -EINVAL; +#endif +#else + return -ENOTSUP; +#endif +} + +int +erts_is_cpu_available(erts_cpu_info_t *cpuinfo, int id) +{ + if (cpuinfo && 0 <= id) { +#ifdef HAVE_SCHED_xETAFFINITY + if (id <= CPU_SETSIZE) + return CPU_ISSET(id, &cpuinfo->cpuset); +#elif defined(HAVE_PROCESSOR_BIND) + int no; +#if defined(HAVE_PSET_INFO) + for (no = 0; no < cpuinfo->available; no++) + if (id == (int) cpuinfo->cpuids[no]) + return 1; +#elif defined(HAVE_KSTAT) + if (cpuinfo->topology) { + for (no = 0; no < cpuinfo->online; no++) { + if (id == (int) cpuinfo->topology[no].logical) { + /* May not be available, but this is the best we can do... */ + return 1; + } + } + } +#endif +#endif + } + return 0; +} + +int +erts_get_cpu_topology_size(erts_cpu_info_t *cpuinfo) +{ + return cpuinfo->topology_size; +} + +int +erts_get_cpu_topology(erts_cpu_info_t *cpuinfo, + erts_cpu_topology_t *topology) +{ + if (!cpuinfo->topology) + return 0; + memcpy((void *) topology, + (void *) cpuinfo->topology, + cpuinfo->configured*sizeof(erts_cpu_topology_t)); + return cpuinfo->configured; +} + +int +erts_bind_to_cpu(erts_cpu_info_t *cpuinfo, int cpu) +{ + /* + * Caller can test for available functionality by + * passing a negative cpu id. If functionality is + * available -EINVAL is returned; otherwise, + * -ENOTSUP. + */ + if (!cpuinfo) + return -EINVAL; +#ifdef HAVE_SCHED_xETAFFINITY + { + cpu_set_t bind_set; + if (cpu < 0) + return -EINVAL; + if (!CPU_ISSET(cpu, &cpuinfo->cpuset)) + return -EINVAL; + + CPU_ZERO(&bind_set); + CPU_SET(cpu, &bind_set); + if (sched_setaffinity(0, sizeof(cpu_set_t), &bind_set) != 0) + return -errno; + return 0; + } +#elif defined(HAVE_PROCESSOR_BIND) + if (cpu < 0) + return -EINVAL; + if (processor_bind(P_LWPID, P_MYID, (processorid_t) cpu, NULL) != 0) + return -errno; + return 0; +#else + return -ENOTSUP; +#endif +} + +int +erts_unbind_from_cpu(erts_cpu_info_t *cpuinfo) +{ + if (!cpuinfo) + return -EINVAL; +#if defined(HAVE_SCHED_xETAFFINITY) + if (sched_setaffinity(0, sizeof(cpu_set_t), &cpuinfo->cpuset) != 0) + return -errno; + return 0; +#elif defined(HAVE_PROCESSOR_BIND) + if (processor_bind(P_LWPID, P_MYID, PBIND_NONE, NULL) != 0) + return -errno; + return 0; +#else + return -ENOTSUP; +#endif +} + +int +erts_unbind_from_cpu_str(char *str) +{ +#if defined(HAVE_SCHED_xETAFFINITY) + char *c = str; + int cpus = 0; + int shft = 0; + cpu_set_t cpuset; + + CPU_ZERO(&cpuset); + + if (!c) + return -EINVAL; + + while (*c) + c++; + + while (c != str) { + int shft2; + int mask = 0; + c--; + switch (*c) { + case '0': mask = 0; break; + case '1': mask = 1; break; + case '2': mask = 2; break; + case '3': mask = 3; break; + case '4': mask = 4; break; + case '5': mask = 5; break; + case '6': mask = 6; break; + case '7': mask = 7; break; + case '8': mask = 8; break; + case '9': mask = 9; break; + case 'A': case 'a': mask = 10; break; + case 'B': case 'b': mask = 11; break; + case 'C': case 'c': mask = 12; break; + case 'D': case 'd': mask = 13; break; + case 'E': case 'e': mask = 14; break; + case 'F': case 'f': mask = 15; break; + default: return -EINVAL; + } + for (shft2 = 0; shft2 < 4; shft2++) { + if (mask & (1 << shft2)) { + int cpu = shft + shft2; + if (cpu >= CPU_SETSIZE) + return -EINVAL; + cpus++; + CPU_SET(cpu, &cpuset); + } + } + shft += 4; + } + + if (!cpus) + return -EINVAL; + + if (sched_setaffinity(0, sizeof(cpu_set_t), &cpuset) != 0) + return -errno; + return 0; +#elif defined(HAVE_PROCESSOR_BIND) + if (processor_bind(P_LWPID, P_MYID, PBIND_NONE, NULL) != 0) + return -errno; + return 0; +#else + return -ENOTSUP; +#endif +} + + +static int +pn_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->processor != y->processor) + return x->processor - y->processor; + if (x->node != y->node) + return x->node - y->node; + if (x->processor_node != y->processor_node) + return x->processor_node - y->processor_node; + if (x->core != y->core) + return x->core - y->core; + if (x->thread != y->thread) + return x->thread - y->thread; + if (x->logical != y->logical) + return x->logical - y->logical; + return 0; +} + +static int +cpu_cmp(const void *vx, const void *vy) +{ + erts_cpu_topology_t *x = (erts_cpu_topology_t *) vx; + erts_cpu_topology_t *y = (erts_cpu_topology_t *) vy; + + if (x->node != y->node) + return x->node - y->node; + if (x->processor != y->processor) + return x->processor - y->processor; + if (x->processor_node != y->processor_node) + return x->processor_node - y->processor_node; + if (x->core != y->core) + return x->core - y->core; + if (x->thread != y->thread) + return x->thread - y->thread; + if (x->logical != y->logical) + return x->logical - y->logical; + return 0; +} + +#ifdef __linux__ + +static int +read_file(char *path, char *buf, int size) +{ + int ix = 0; + ssize_t sz = size-1; + int fd = open(path, O_RDONLY); + if (fd < 0) + goto error; + while (size > ix) { + sz = read(fd, &buf[ix], size - ix); + if (sz <= 0) { + if (sz == 0) + break; + if (errno == EINTR) + continue; + goto error; + } + ix += sz; + } + buf[ix] = '\0'; + close(fd); + return ix; + + error: { + int saved_errno = errno; + if (fd >= 0) + close(fd); + if (saved_errno) + return -saved_errno; + else + return -EINVAL; + } +} + +static int +read_topology(erts_cpu_info_t *cpuinfo) +{ + char npath[MAXPATHLEN]; + char cpath[MAXPATHLEN]; + char tpath[MAXPATHLEN]; + char fpath[MAXPATHLEN]; + DIR *ndir = NULL; + DIR *cdir = NULL; + struct dirent *nde; + int ix; + int res = 0; + int got_nodes = 0; + int no_nodes = 0; + + errno = 0; + + if (cpuinfo->topology) + free(cpuinfo->topology); + + if (cpuinfo->configured < 1) + goto error; + + cpuinfo->topology = malloc(sizeof(erts_cpu_topology_t) + * cpuinfo->configured); + if (!cpuinfo) + goto error; + + for (ix = 0; ix < cpuinfo->configured; ix++) { + cpuinfo->topology[ix].node = -1; + cpuinfo->topology[ix].processor = -1; + cpuinfo->topology[ix].processor_node = -1; + cpuinfo->topology[ix].core = -1; + cpuinfo->topology[ix].thread = -1; + cpuinfo->topology[ix].logical = -1; + } + + ix = -1; + + if (realpath(ERTS_SYS_NODE_PATH, npath)) { + got_nodes = 1; + ndir = opendir(npath); + } + + do { + int node_id = -1; + + if (!got_nodes) { + if (!realpath(ERTS_SYS_CPU_PATH, cpath)) + goto error; + } + else { + + nde = readdir(ndir); + + if (!nde) + break; + + if (sscanf(nde->d_name, "node%d", &node_id) != 1) + continue; + + no_nodes++; + + sprintf(tpath, "%s/node%d", npath, node_id); + + if (!realpath(tpath, cpath)) + goto error; + } + + cdir = opendir(cpath); + if (!cdir) + goto error; + + while (1) { + int cpu_id; + struct dirent *cde = readdir(cdir); + if (!cde) { + closedir(cdir); + cdir = NULL; + break; + } + if (sscanf(cde->d_name, "cpu%d", &cpu_id) == 1) { + char buf[50]; /* Much more than enough for an integer */ + int processor_id, core_id; + sprintf(tpath, "%s/cpu%d/topology/physical_package_id", + cpath, cpu_id); + if (!realpath(tpath, fpath)) + continue; + if (read_file(fpath, buf, sizeof(buf)) <= 0) + continue; + if (sscanf(buf, "%d", &processor_id) != 1) + continue; + sprintf(tpath, "%s/cpu%d/topology/core_id", + cpath, cpu_id); + if (!realpath(tpath, fpath)) + continue; + if (read_file(fpath, buf, sizeof(buf)) <= 0) + continue; + if (sscanf(buf, "%d", &core_id) != 1) + continue; + + /* + * We now know node id, processor id, and + * core id of the logical processor with + * the cpu id 'cpu_id'. + */ + ix++; + cpuinfo->topology[ix].node = node_id; + cpuinfo->topology[ix].processor = processor_id; + cpuinfo->topology[ix].processor_node = -1; /* Fixed later */ + cpuinfo->topology[ix].core = core_id; + cpuinfo->topology[ix].thread = 0; /* we'll numerate later */ + cpuinfo->topology[ix].logical = cpu_id; + } + } + } while (got_nodes); + + res = ix+1; + + if (!res || res < cpuinfo->online) + res = 0; + else { + erts_cpu_topology_t *prev, *this, *last; + + cpuinfo->topology_size = res; + + if (cpuinfo->topology_size != cpuinfo->configured) { + void *t = realloc(cpuinfo->topology, (sizeof(erts_cpu_topology_t) + * cpuinfo->topology_size)); + if (t) + cpuinfo->topology = t; + } + + if (no_nodes > 1) { + int processor = -1; + int processor_node = 0; + int node = -1; + + qsort(cpuinfo->topology, + cpuinfo->topology_size, + sizeof(erts_cpu_topology_t), + pn_cmp); + + prev = NULL; + this = &cpuinfo->topology[0]; + last = &cpuinfo->topology[cpuinfo->configured-1]; + while (1) { + if (processor == this->processor) { + if (node != this->node) + processor_node = 1; + } + else { + if (processor_node) { + make_processor_node: + while (prev->processor == processor) { + prev->processor_node = prev->node; + prev->node = -1; + if (prev == &cpuinfo->topology[0]) + break; + prev--; + } + processor_node = 0; + } + processor = this->processor; + node = this->node; + } + if (this == last) { + if (processor_node) { + prev = this; + goto make_processor_node; + } + break; + } + prev = this++; + } + } + + qsort(cpuinfo->topology, + cpuinfo->topology_size, + sizeof(erts_cpu_topology_t), + cpu_cmp); + + this = &cpuinfo->topology[0]; + this->thread = 0; + + if (res > 1) { + prev = this++; + last = &cpuinfo->topology[cpuinfo->configured-1]; + + while (1) { + this->thread = ((this->node == prev->node + && this->processor == prev->processor + && this->processor_node == prev->processor_node + && this->core == prev->core) + ? prev->thread + 1 + : 0); + if (this == last) + break; + prev = this++; + } + } + } + + error: + + if (res == 0) { + cpuinfo->topology_size = 0; + if (cpuinfo->topology) { + free(cpuinfo->topology); + cpuinfo->topology = NULL; + } + if (errno) + res = -errno; + else + res = -EINVAL; + } + + if (ndir) + closedir(ndir); + if (cdir) + closedir(cdir); + + return res; +} + +#elif defined(HAVE_KSTAT) /* SunOS kstat */ + +#include + +static int +data_lookup_int(kstat_t *ks, char *what) +{ + int res; + kstat_named_t *ks_n; + + ks_n = kstat_data_lookup(ks, what); + if (!ks_n) + return 0; + + switch (ks_n->data_type) { + case KSTAT_DATA_CHAR: + res = atoi(ks_n->value.c); + break; + case KSTAT_DATA_INT32: + res = (int) ks_n->value.i32; + break; + case KSTAT_DATA_UINT32: + res = (int) ks_n->value.ui32; + break; + case KSTAT_DATA_INT64: + res = (int) ks_n->value.i64; + break; + case KSTAT_DATA_UINT64: + res = (int) ks_n->value.ui64; + break; + default: + res = 0; + break; + } + return res; +} + +static int +read_topology(erts_cpu_info_t *cpuinfo) +{ + int res = 0; + int ix; + kstat_ctl_t *ks_ctl; + kstat_t *ks; + + errno = 0; + + if (cpuinfo->topology) + free(cpuinfo->topology); + + if (cpuinfo->configured < 1) + goto error; + + cpuinfo->topology = malloc(sizeof(erts_cpu_topology_t) + * cpuinfo->configured); + if (!cpuinfo) + goto error; + + for (ix = 0; ix < cpuinfo->configured; ix++) { + cpuinfo->topology[ix].node = -1; + cpuinfo->topology[ix].processor = -1; + cpuinfo->topology[ix].processor_node = -1; + cpuinfo->topology[ix].core = -1; + cpuinfo->topology[ix].thread = -1; + cpuinfo->topology[ix].logical = -1; + } + + ks_ctl = kstat_open(); + if (!ks_ctl) + goto error; + + ix = 0; + for (ks = ks_ctl->kc_chain; ks; ks = ks->ks_next) { + if (strcmp("cpu_info", ks->ks_module) == 0) { + kstat_read(ks_ctl, ks, NULL); + if (ks->ks_type == KSTAT_TYPE_NAMED) { + /* + * Don't know how to figure numa nodes out; + * hope there is none... + */ + cpuinfo->topology[ix].node = -1; + cpuinfo->topology[ix].processor = data_lookup_int(ks,"chip_id"); + cpuinfo->topology[ix].processor_node = -1; + cpuinfo->topology[ix].core = data_lookup_int(ks, "core_id"); + cpuinfo->topology[ix].thread = 0; /* we'll numerate later */ + cpuinfo->topology[ix].logical = ks->ks_instance; + if (++ix == cpuinfo->configured) + break; + } + } + } + + kstat_close(ks_ctl); + + res = ix; + + if (!res || res < cpuinfo->online) + res = 0; + else { + erts_cpu_topology_t *prev, *this, *last; + + cpuinfo->topology_size = res; + + if (cpuinfo->topology_size != cpuinfo->configured) { + void *t = realloc(cpuinfo->topology, (sizeof(erts_cpu_topology_t) + * cpuinfo->topology_size)); + if (t) + cpuinfo->topology = t; + } + + qsort(cpuinfo->topology, + cpuinfo->topology_size, + sizeof(erts_cpu_topology_t), + cpu_cmp); + + this = &cpuinfo->topology[0]; + this->thread = 0; + + if (res > 1) { + prev = this++; + last = &cpuinfo->topology[cpuinfo->configured-1]; + + while (1) { + this->thread = ((this->node == prev->node + && this->processor == prev->processor + && this->processor_node == prev->processor_node + && this->core == prev->core) + ? prev->thread + 1 + : 0); + if (this == last) + break; + prev = this++; + } + } + } + + error: + + if (res == 0) { + cpuinfo->topology_size = 0; + if (cpuinfo->topology) { + free(cpuinfo->topology); + cpuinfo->topology = NULL; + } + if (errno) + res = -errno; + else + res = -EINVAL; + } + + return res; + +} + +#else + +static int +read_topology(erts_cpu_info_t *cpuinfo) +{ + return -ENOTSUP; +} + +#endif diff --git a/erts/lib_src/common/erl_printf.c b/erts/lib_src/common/erl_printf.c new file mode 100644 index 0000000000..72d18ab6f1 --- /dev/null +++ b/erts/lib_src/common/erl_printf.c @@ -0,0 +1,427 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* Without this, variable argument lists break on VxWorks */ +#ifdef VXWORKS +#include +#endif + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#include +#include "erl_errno.h" +#ifdef __WIN32__ +# include +#else +# include +#endif +#include "erl_printf.h" +#include "erl_printf_format.h" + +#ifdef DEBUG +#include +#define ASSERT(X) assert(X) +#else +#define ASSERT(X) +#endif + +#if defined(__WIN32__) && !defined(__GNUC__) +typedef int ssize_t; +#endif + +int (*erts_printf_stdout_func)(char *, va_list) = NULL; +int (*erts_printf_stderr_func)(char *, va_list) = NULL; + +int erts_printf_add_cr_to_stdout = 0; +int erts_printf_add_cr_to_stderr = 0; + +int (*erts_printf_block_fpe)(void) = NULL; +void (*erts_printf_unblock_fpe)(int) = NULL; + +#undef FLOCKFILE +#undef FUNLOCKFILE +#undef PUTC +#undef FWRITE +#undef PUTC_ON_SMALL_WRITES + +#if defined(USE_THREADS) && defined(HAVE_FLOCKFILE) +# define FLOCKFILE(FP) flockfile(FP) +# define FUNLOCKFILE(FP) funlockfile(FP) +# ifdef HAVE_PUTC_UNLOCKED +# define PUTC putc_unlocked +# define PUTC_ON_SMALL_WRITES +# endif +# ifdef HAVE_FWRITE_UNLOCKED +# define FWRITE fwrite_unlocked +# endif +#endif +#if !defined(USE_THREADS) && defined(putc) && !defined(fwrite) +# define PUTC_ON_SMALL_WRITES +#endif +#if !defined(FLOCKFILE) || !defined(FUNLOCKFILE) +# define FLOCKFILE(FP) +# define FUNLOCKFILE(FP) +#endif +#ifndef PUTC +# define PUTC putc +#endif +#ifndef FWRITE +# define FWRITE fwrite +#endif + +static int +get_error_result(void) +{ + int res = errno; + if (res <= 0) + res = EIO; + return -res; +} + + +static int +write_f_add_cr(void *vfp, char* buf, size_t len) +{ + size_t i; + ASSERT(vfp); + for (i = 0; i < len; i++) { + if (buf[i] == '\n' && PUTC('\r', (FILE *) vfp) == EOF) + return get_error_result(); + if (PUTC(buf[i], (FILE *) vfp) == EOF) + return get_error_result(); + } + return 0; +} + +static int +write_f(void *vfp, char* buf, size_t len) +{ + ASSERT(vfp); +#ifdef PUTC_ON_SMALL_WRITES + if (len <= 64) { /* Try to optimize writes of small bufs. */ + int i; + for (i = 0; i < len; i++) + if (PUTC(buf[i], (FILE *) vfp) == EOF) + return get_error_result(); + } + else +#endif + if (FWRITE((void *) buf, sizeof(char), len, (FILE *) vfp) != len) + return get_error_result(); + return 0; +} + +static int +write_fd(void *vfdp, char* buf, size_t len) +{ + ssize_t size; + ASSERT(vfdp); + + while (len) { + size = write(*((int *) vfdp), (void *) buf, len); + if (size < 0) { +#ifdef EINTR + if (errno == EINTR) + continue; +#endif + return get_error_result(); + } + if (size > len) + return -EIO; + len -= size; + } + + return 0; +} + +static int +write_s(void *vwbufpp, char* bufp, size_t len) +{ + char **wbufpp = (char **) vwbufpp; + ASSERT(wbufpp && *wbufpp); + ASSERT(len > 0); + memcpy((void *) *wbufpp, (void *) bufp, len); + *wbufpp += len; + return 0; +} + + +typedef struct { + char *buf; + size_t len; +} write_sn_arg_t; + +static int +write_sn(void *vwsnap, char* buf, size_t len) +{ + write_sn_arg_t *wsnap = (write_sn_arg_t *) vwsnap; + ASSERT(wsnap); + ASSERT(len > 0); + if (wsnap->len > 0) { + size_t sz = len; + if (sz >= wsnap->len) + sz = wsnap->len; + memcpy((void *) wsnap->buf, (void *) buf, sz); + wsnap->buf += sz; + wsnap->len -= sz; + } + return 0; +} + +static int +write_ds(void *vdsbufp, char* buf, size_t len) +{ + erts_dsprintf_buf_t *dsbufp = (erts_dsprintf_buf_t *) vdsbufp; + size_t need_len = len + 1; /* Also trailing '\0' */ + ASSERT(dsbufp); + ASSERT(len > 0); + ASSERT(dsbufp->str_len <= dsbufp->size); + if (need_len > dsbufp->size - dsbufp->str_len) { + dsbufp = (*dsbufp->grow)(dsbufp, need_len); + if (!dsbufp) + return -ENOMEM; + } + memcpy((void *) (dsbufp->str + dsbufp->str_len), (void *) buf, len); + dsbufp->str_len += len; + return 0; +} + +int +erts_printf(const char *format, ...) +{ + int res; + va_list arglist; + va_start(arglist, format); + errno = 0; + if (erts_printf_stdout_func) + res = (*erts_printf_stdout_func)((char *) format, arglist); + else { + FLOCKFILE(stdout); + res = erts_printf_format(erts_printf_add_cr_to_stdout + ? write_f_add_cr + : write_f, + (void *) stdout, + (char *) format, + arglist); + FUNLOCKFILE(stdout); + } + va_end(arglist); + return res; +} + +int +erts_fprintf(FILE *filep, const char *format, ...) +{ + int res; + va_list arglist; + va_start(arglist, format); + errno = 0; + if (erts_printf_stdout_func && filep == stdout) + res = (*erts_printf_stdout_func)((char *) format, arglist); + else if (erts_printf_stderr_func && filep == stderr) + res = (*erts_printf_stderr_func)((char *) format, arglist); + else { + int (*fmt_f)(void*, char*, size_t); + if (erts_printf_add_cr_to_stdout && filep == stdout) + fmt_f = write_f_add_cr; + else if (erts_printf_add_cr_to_stderr && filep == stderr) + fmt_f = write_f_add_cr; + else + fmt_f = write_f; + FLOCKFILE(filep); + res = erts_printf_format(fmt_f,(void *)filep,(char *)format,arglist); + FUNLOCKFILE(filep); + } + va_end(arglist); + return res; +} + +int +erts_fdprintf(int fd, const char *format, ...) +{ + int res; + va_list arglist; + va_start(arglist, format); + errno = 0; + res = erts_printf_format(write_fd,(void *)&fd,(char *)format,arglist); + va_end(arglist); + return res; +} + +int +erts_sprintf(char *buf, const char *format, ...) +{ + int res; + char *p = buf; + va_list arglist; + va_start(arglist, format); + errno = 0; + res = erts_printf_format(write_s, (void *) &p, (char *) format, arglist); + if (res < 0) + buf[0] = '\0'; + else + buf[res] = '\0'; + va_end(arglist); + return res; +} + +int +erts_snprintf(char *buf, size_t size, const char *format, ...) +{ + write_sn_arg_t wsnap; + int res; + va_list arglist; + if (size < 1) + return -EINVAL; + wsnap.buf = buf; + wsnap.len = size-1; /* Always need room for trailing '\0' */ + va_start(arglist, format); + errno = 0; + res = erts_printf_format(write_sn, (void *)&wsnap, (char *)format, arglist); + if (res < 0) + buf[0] = '\0'; + else if (res < size) + buf[res] = '\0'; + else + buf[size-1] = '\0'; + va_end(arglist); + return res; +} + +int +erts_dsprintf(erts_dsprintf_buf_t *dsbufp, const char *format, ...) +{ + int res; + va_list arglist; + if (!dsbufp) + return -EINVAL; + va_start(arglist, format); + errno = 0; + res = erts_printf_format(write_ds, (void *)dsbufp, (char *)format, arglist); + if (dsbufp->str) { + if (res < 0) + dsbufp->str[0] = '\0'; + else + dsbufp->str[dsbufp->str_len] = '\0'; + } + va_end(arglist); + return res; +} + +int +erts_vprintf(const char *format, va_list arglist) +{ + int res; + if (erts_printf_stdout_func) + res = (*erts_printf_stdout_func)((char *) format, arglist); + else { + errno = 0; + res = erts_printf_format(erts_printf_add_cr_to_stdout + ? write_f_add_cr + : write_f, + (void *) stdout, + (char *) format, + arglist); + } + return res; +} + +int +erts_vfprintf(FILE *filep, const char *format, va_list arglist) +{ + int res; + if (erts_printf_stdout_func && filep == stdout) + res = (*erts_printf_stdout_func)((char *) format, arglist); + else if (erts_printf_stderr_func && filep == stderr) + res = (*erts_printf_stderr_func)((char *) format, arglist); + else { + int (*fmt_f)(void*, char*, size_t); + errno = 0; + if (erts_printf_add_cr_to_stdout && filep == stdout) + fmt_f = write_f_add_cr; + else if (erts_printf_add_cr_to_stderr && filep == stderr) + fmt_f = write_f_add_cr; + else + fmt_f = write_f; + res = erts_printf_format(fmt_f,(void *)filep,(char *)format,arglist); + } + return res; +} + +int +erts_vfdprintf(int fd, const char *format, va_list arglist) +{ + int res; + errno = 0; + res = erts_printf_format(write_fd,(void *)&fd,(char *)format,arglist); + return res; +} + +int +erts_vsprintf(char *buf, const char *format, va_list arglist) +{ + int res; + char *p = buf; + errno = 0; + res = erts_printf_format(write_s, (void *) &p, (char *) format, arglist); + if (res < 0) + buf[0] = '\0'; + else + buf[res] = '\0'; + return res; +} + +int +erts_vsnprintf(char *buf, size_t size, const char *format, va_list arglist) +{ + write_sn_arg_t wsnap; + int res; + if (size < 1) + return -EINVAL; + wsnap.buf = buf; + wsnap.len = size-1; /* Always need room for trailing '\0' */ + errno = 0; + res = erts_printf_format(write_sn, (void *)&wsnap, (char *)format, arglist); + if (res < 0) + buf[0] = '\0'; + else if (res < size) + buf[res] = '\0'; + else + buf[size-1] = '\0'; + return res; +} + +int +erts_vdsprintf(erts_dsprintf_buf_t *dsbufp, const char *format, va_list arglist) +{ + int res; + if (!dsbufp) + return -EINVAL; + errno = 0; + res = erts_printf_format(write_ds, (void *)dsbufp, (char *)format, arglist); + if (dsbufp->str) { + if (res < 0) + dsbufp->str[0] = '\0'; + else + dsbufp->str[dsbufp->str_len] = '\0'; + } + return res; +} diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c new file mode 100644 index 0000000000..bd3d38e649 --- /dev/null +++ b/erts/lib_src/common/erl_printf_format.c @@ -0,0 +1,940 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * fmt: + * '%' * [ [.]][] + * + * flag: # | O | - | | + | ' | I + * width: [0-9]+ | '*' + * precision: [0-9]+ | '*' + * length: hh | h | l | ll | L | j | t | b + * conversion: d,i | o,u,x,X | e,E | f,F | g,G | a,A | c | s | T | + * p | n | % + * sz: 8 | 16 | 32 | 64 | p + */ + +/* Without this, variable argument lists break on VxWorks */ +#ifdef VXWORKS +#include +#endif + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#ifdef __WIN32__ +#undef WIN32_LEAN_AND_MEAN +#define WIN32_LEAN_AND_MEAN +#include +#endif + +#include +#include +#include +#include +#include +#include "erl_errno.h" +#include +#include "erl_printf.h" +#include "erl_printf_format.h" + +#ifdef DEBUG +#include +#define ASSERT(X) assert(X) +#else +#define ASSERT(X) +#endif + +#ifdef __WIN32__ +#define long_long LONGLONG +#define signed_long_long LONGLONG +#define unsigned_long_long ULONGLONG +#undef SIZEOF_LONG_LONG +#define SIZEOF_LONG_LONG 8 +#else +#if SIZEOF_LONG_LONG +#define long_long long long +#define signed_long_long signed long long +#define unsigned_long_long unsigned long long +#endif +#endif + +#if defined(__GNUC__) +# undef inline +# define inline __inline__ +#elif defined(__WIN32__) +# undef inline +# define inline __forceinline +#else +# ifndef inline +# define inline +# endif +#endif + +#define FMTC_d 0x0000 +#define FMTC_i 0x0001 +#define FMTC_o 0x0002 +#define FMTC_u 0x0003 +#define FMTC_x 0x0004 +#define FMTC_X 0x0005 +#define FMTC_e 0x0006 +#define FMTC_E 0x0007 +#define FMTC_f 0x0008 +#define FMTC_T 0x0009 +#define FMTC_g 0x000a +#define FMTC_G 0x000b +#define FMTC_c 0x000c +#define FMTC_s 0x000d +#define FMTC_p 0x000e +#define FMTC_n 0x000f +#define FMTC_MASK 0x000f + +#define FMTL_no 0x0000 +#define FMTL_hh 0x0010 +#define FMTL_h 0x0020 +#define FMTL_l 0x0030 +#define FMTL_ll 0x0040 +#define FMTL_L 0x0050 +#define FMTL_j 0x0060 +#define FMTL_t 0x0070 +#define FMTL_MASK 0x00f0 + +#define FMTF_alt 0x0100 /* # alterlate form ie 0x */ +#define FMTF_pad 0x0200 /* 0 zero pad */ +#define FMTF_adj 0x0400 /* left adjust */ +#define FMTF_blk 0x0800 /* add blank */ +#define FMTF_sgn 0x1000 /* add sign */ +#define FMTF_cnv 0x2000 /* decimal conversion */ +#define FMTF_cnV 0x4000 /* alternate decimal conversion */ +#define FMTF_MASK 0x7f00 + + +static char zeros[] = "00000000000000000000000000000000"; +static char blanks[] = " "; +static char hex[] = "0123456789abcdef"; +static char heX[] = "0123456789ABCDEF"; + +#define FMT(fn,arg,buf,len,count) do { \ + int res__ = (fn)((arg),(buf),(len)); \ + if (res__ < 0) \ + return res__; \ + (count) += (len); \ + } while(0) + +#define FILL(fn,arg,cs,len, count) do { \ + int __i = (len); \ + while(__i >= sizeof(cs)-1) { \ + FMT((fn),(arg),(cs),sizeof(cs)-1,(count)); \ + __i -= sizeof(cs)-1; \ + } \ + if (__i) FMT((fn),(arg),(cs),__i,(count)); \ + } while(0) + +#define BLANKS(fn,arg,n,count) FILL((fn),(arg),blanks,(n),count) +#define ZEROS(fn,arg,n,count) FILL((fn),(arg),zeros,(n),count) + +#define SIGN(X) ((X) > 0 ? 1 : ((X) < 0 ? -1 : 0)) +#define USIGN(X) ((X) == 0 ? 0 : 1) + +int (*erts_printf_eterm_func)(fmtfn_t, void*, unsigned long, long) = NULL; + +static int +noop_fn(void *vfp, char* buf, size_t len) +{ + return 0; +} + +static int fmt_fld(fmtfn_t fn,void* arg, + char* wbuf, int w, int sign, + int width,int precision,int fmt,int* count) +{ + char prefix[8]; + char* pp = prefix; + int pw = 0; + int len; + + /* format the prefix */ + if ((sign || (fmt & (FMTF_sgn|FMTF_blk))) && + (((fmt & FMTC_MASK) == FMTC_d) || ((fmt & FMTC_MASK) == FMTC_i))) { + if (sign < 0) + *pp++ = '-'; + else if ((fmt & FMTF_sgn)) + *pp++ = '+'; + else if (fmt & FMTF_blk) + *pp++ = ' '; + } + + if ((fmt & FMTF_alt)) { + switch((fmt & FMTC_MASK)) { + case FMTC_X: *pp++ = '0'; *pp++ = 'X'; break; + case FMTC_x: *pp++ = '0'; *pp++ = 'x'; break; + case FMTC_o: *pp++ = '0'; if (precision>1) precision--; break; + } + } + + pw = pp-prefix; + len = ((w < precision) ? precision : w) + pw; + + if (fmt & FMTF_adj) { /* left adjust */ + if (pw) + FMT(fn,arg,prefix,pw,*count); + if (w < precision) + ZEROS(fn,arg,precision-w,*count); + FMT(fn,arg, wbuf, w, *count); + if (len < width) + BLANKS(fn,arg,width-len,*count); + } + else if ((fmt & FMTF_pad) && (precision<0)) { /* pad zeros */ + if (pw) + FMT(fn,arg, prefix, pw, *count); + if (w < precision) + ZEROS(fn, arg, precision-w, *count); + if (len < width) + ZEROS(fn,arg,width-len,*count); + FMT(fn,arg,wbuf,w,*count); + } + else { + if (len < width) + BLANKS(fn,arg,width-len,*count); + if (pw) + FMT(fn,arg,prefix,pw,*count); + if (w < precision) + ZEROS(fn,arg,precision-w,*count); + FMT(fn,arg,wbuf,w,*count); + } + return 0; +} + +static int fmt_long(fmtfn_t fn,void* arg,int sign,unsigned long uval, + int width,int precision,int fmt,int* count) +{ + char buf[32]; + int base = 10; + int w = 0; + char* dc = hex; + char* p = buf+sizeof(buf); + + switch(fmt & FMTC_MASK) { + case FMTC_d: + case FMTC_i: + case FMTC_u: + break; + case FMTC_o: + base = 8; + break; + case FMTC_X: + dc = heX; + case FMTC_x: + base = 16; + break; + default: + return -EINVAL; + } + + /* format the unsigned value */ + if (!sign && precision) { + *--p = '0'; + w++; + } + else { + while(uval) { + *--p = dc[(uval % base)]; + uval /= base; + w++; + } + } + return fmt_fld(fn, arg, p, w, sign, width, precision, fmt, count); +} + +#if SIZEOF_LONG_LONG + +static inline int +do_div(unsigned_long_long *n, unsigned_long_long base) +{ + unsigned_long_long q = *n/base; + int mod = (int) (*n - q*base); + *n = q; + return mod; +} + +static int fmt_long_long(fmtfn_t fn,void* arg,int sign, + unsigned_long_long uval, + int width,int precision,int fmt,int* count) +{ + char buf[32]; + int base = 10; + int w = 0; + char* dc = hex; + char* p = buf+sizeof(buf); + + switch(fmt & FMTC_MASK) { + case FMTC_d: + case FMTC_i: + case FMTC_u: + break; + case FMTC_o: + base = 8; + break; + case FMTC_X: + dc = heX; + case FMTC_x: + base = 16; + break; + default: + return -EINVAL; + } + + /* format the unsigned value */ + if (!sign && precision) { + *--p = '0'; + w++; + } + else { + while(uval) { + int m = do_div(&uval,base); + *--p = dc[m]; + w++; + } + } + return fmt_fld(fn, arg, p, w, sign, width, precision, fmt, count); +} + +#endif /* #if SIZEOF_LONG_LONG */ + +static int fmt_double(fmtfn_t fn,void*arg,double val, + int width, int precision, int fmt,int* count) +{ + int res; + int fi = 0; + char format_str[7]; + char sbuf[32]; + char *bufp; + double dexp; + int exp; + size_t max_size = 1; + size_t size; + int new_fmt = fmt; + int fpe_was_unmasked; + + fpe_was_unmasked = erts_printf_block_fpe ? (*erts_printf_block_fpe)() : 0; + + if (val < 0.0) + dexp = log10(-val); + else if (val == 0.0) + dexp = 0.0; + else + dexp = log10(val); + exp = (int) dexp; + + new_fmt &= ~FMTF_sgn; + new_fmt &= ~FMTF_blk; + + format_str[fi++] = '%'; + if (fmt & FMTF_alt) + format_str[fi++] = '#'; + if (fmt & FMTF_sgn) + format_str[fi++] = '+'; + else if (fmt & FMTF_blk) + format_str[fi++] = ' '; + format_str[fi++] = '0'; + format_str[fi++] = '.'; + format_str[fi++] = '*'; + + switch(fmt & FMTC_MASK) { + case FMTC_G: + format_str[fi] = 'E'; + goto gG_common; + case FMTC_g: + format_str[fi] = 'e'; + gG_common: + if (dexp < -4.0 || exp >= precision) { + fi++; + precision--; + if (precision < 1) + precision = 1; + goto eE_common; + } + /* fall through ... */ + case FMTC_f: + format_str[fi++] = 'f'; + max_size += exp > 0 ? exp : 1; + max_size++; + if (precision) + max_size += precision; + else if (fmt && FMTF_alt) + max_size++; + break; + case FMTC_E: + format_str[fi++] = 'E'; + goto eE_common; + case FMTC_e: + format_str[fi++] = 'e'; + eE_common: { + int aexp; + + max_size += 4; + if (precision) + max_size += precision; + else if (fmt && FMTF_alt) + max_size++; + aexp = exp >= 0 ? exp : -exp; + if (aexp < 100) + max_size += 2; + else { + while (aexp) { + max_size++; + aexp /= 10; + } + } + break; + } + default: + res = -EINVAL; + goto out; + } + + format_str[fi++] = '\0'; + ASSERT(fi <= sizeof(format_str)); + + max_size++; /* '\0' */ + + if (max_size < sizeof(sbuf)) + bufp = sbuf; + else { + bufp = (char *) malloc(sizeof(char)*max_size); + if (!bufp) { + res = -ENOMEM; + goto out; + } + } + + size = sprintf(bufp, format_str, precision, val); + if (size < 0) { + if (errno > 0) + res = -errno; + else + res = -EIO; + goto out; + } + + ASSERT(max_size >= size); + + res = fmt_fld(fn, arg, bufp, size, 0, width, 0, new_fmt, count); + + if (bufp != sbuf) + free((void *) bufp); + + out: + if (erts_printf_unblock_fpe) + (*erts_printf_unblock_fpe)(fpe_was_unmasked); + return res; +} + +int erts_printf_format(fmtfn_t fn, void* arg, char* fmt, va_list ap) +{ + char* ptr0 = fmt; + char* ptr = ptr0; + int count = 0; + int n; + int res = 0; + + while(*ptr) { + unsigned long ul_val; + int fmt = 0; + int width = -1; + int precision = -1; + + if (res < 0) + return res; + + if (*ptr == '%') { + if ((n=ptr-ptr0)) + FMT(fn,arg,ptr0,n,count); + ptr++; + + do_flag: + switch(*ptr) { + case '#': fmt |= FMTF_alt; ptr++; goto do_flag; + case '0': fmt |= FMTF_pad; ptr++; goto do_flag; + case '-': fmt |= FMTF_adj; ptr++; goto do_flag; + case ' ': fmt |= FMTF_blk; ptr++; goto do_flag; + case '+': fmt |= FMTF_sgn; ptr++; goto do_flag; + case '\'': fmt |= FMTF_cnv; ptr++; goto do_flag; + case 'I': fmt |= FMTF_cnV; ptr++; goto do_flag; + } + + /* width */ + if (*ptr == '*') { + width = va_arg(ap, int); + ptr++; + } + else if (isdigit((int) *ptr)) { + width = *ptr++ - '0'; + while(isdigit((int) *ptr)) + width = 10*width + (*ptr++ - '0'); + } + + /* precision */ + if (*ptr == '.') { + ptr++; + if (*ptr == '*') { + precision = va_arg(ap, int); + ptr++; + } + else if (isdigit((int) *ptr)) { + precision = *ptr++ - '0'; + while(isdigit((int) *ptr)) + precision = 10*precision + (*ptr++ - '0'); + } + } + + /* length modifier */ + switch(*ptr) { + case 'b': { + ptr++; + if (*ptr == 'p') { + ptr++; +#if SIZEOF_INT == SIZEOF_VOID_P +#elif SIZEOF_LONG == SIZEOF_VOID_P + fmt |= FMTL_l; +#elif SIZEOF_LONG_LONG == SIZEOF_VOID_P + fmt |= FMTL_ll; +#else +#error No integer datatype with the same size as 'void *' found +#endif + } + else { + int bits = 0; + while(isdigit((int) *ptr)) + bits = 10*bits + (*ptr++ - '0'); + switch (bits) { + case 64: +#if SIZEOF_INT == 8 +#elif SIZEOF_LONG == 8 + fmt |= FMTL_l; +#elif SIZEOF_LONG_LONG == 8 + fmt |= FMTL_ll; +#else +#error No 64-bit integer datatype found +#endif + break; + case 32: +#if SIZEOF_INT == 4 +#elif SIZEOF_SHORT == 4 + fmt |= FMTL_h; +#elif SIZEOF_LONG == 4 + fmt |= FMTL_l; +#elif SIZEOF_LONG_LONG == 4 + fmt |= FMTL_ll; +#else +#error No 32-bit integer datatype found +#endif + break; + case 16: +#if SIZEOF_INT == 2 +#elif SIZEOF_SHORT == 2 + fmt |= FMTL_h; +#elif SIZEOF_LONG == 2 + fmt |= FMTL_l; +#else +#error No 16-bit integer datatype found +#endif + case 8: +#if SIZEOF_CHAR == 1 + fmt |= FMTL_hh; +#else +#error Unexpected size of char +#endif + break; + default: + return -EINVAL; + } + } + break; + } + case 'h': + ptr++; + if (*ptr == 'h') { + ptr++; + fmt |= FMTL_hh; + } + else + fmt |= FMTL_h; + break; + case 'l': + ptr++; + if (*ptr == 'l') { + ptr++; +#if SIZEOF_LONG_LONG + fmt |= FMTL_ll; +#else + fmt |= FMTL_l; +#endif + } + else + fmt |= FMTL_l; + break; + case 'L': ptr++; fmt |= FMTL_L; break; + case 'j': ptr++; fmt |= FMTL_j; break; + case 't': ptr++; fmt |= FMTL_t; break; + } + + /* specifier */ + switch(*ptr) { + case 'd': ptr++; fmt |= FMTC_d; break; + case 'i': ptr++; fmt |= FMTC_i; break; + case 'o': ptr++; fmt |= FMTC_o; break; + case 'u': ptr++; fmt |= FMTC_u; break; + case 'x': ptr++; fmt |= FMTC_x; break; + case 'X': ptr++; fmt |= FMTC_X; break; + case 'e': ptr++; fmt |= FMTC_e; break; + case 'E': ptr++; fmt |= FMTC_E; break; + case 'f': ptr++; fmt |= FMTC_f; break; + case 'g': ptr++; fmt |= FMTC_g; break; + case 'G': ptr++; fmt |= FMTC_G; break; + case 'c': ptr++; fmt |= FMTC_c; break; + case 's': ptr++; fmt |= FMTC_s; break; + case 'p': ptr++; fmt |= FMTC_p; break; + case 'n': ptr++; fmt |= FMTC_n; break; + case 'T': ptr++; fmt |= FMTC_T; break; + case '%': + FMT(fn,arg,ptr,1,count); + ptr++; + ptr0 = ptr; + continue; + default: + /* ignore */ + ptr0 = ptr; + continue; + } + + switch(fmt & FMTC_MASK) { + case FMTC_d: + case FMTC_i: + switch(fmt & FMTL_MASK) { + case FMTL_hh: { + signed char tval = (signed char) va_arg(ap,int); + ul_val = (unsigned long) (tval < 0 ? (-tval) : tval); + res = fmt_long(fn,arg,SIGN(tval),ul_val, + width,precision,fmt,&count); + break; + } + case FMTL_h: { + signed short tval = (signed short) va_arg(ap,int); + ul_val = (unsigned long) (tval < 0 ? (-tval) : tval); + res = fmt_long(fn,arg,SIGN(tval),ul_val, + width,precision,fmt,&count); + break; + } + case FMTL_l: { + signed long tval = (signed long) va_arg(ap,long); + ul_val = (unsigned long) (tval < 0 ? (-tval) : tval); + res = fmt_long(fn,arg,SIGN(tval),ul_val, + width,precision,fmt,&count); + break; + } +#if SIZEOF_LONG_LONG + case FMTL_ll: { + unsigned_long_long ull_val; + signed_long_long tval; + tval = (signed_long_long) va_arg(ap,long_long); + ull_val = (unsigned_long_long) (tval < 0 ? (-tval) : tval); + res = fmt_long_long(fn,arg,SIGN(tval),ull_val, + width,precision,fmt,&count); + break; + } +#endif + default: { + signed int tval = (signed int) va_arg(ap,int); + ul_val = (unsigned long) (tval < 0 ? (-tval) : tval); + res = fmt_long(fn,arg,SIGN(tval),ul_val, + width,precision,fmt,&count); + break; + } + } + break; + case FMTC_o: + case FMTC_u: + case FMTC_x: + case FMTC_X: + switch(fmt & FMTL_MASK) { + case FMTL_hh: { + unsigned char tval = (unsigned char) va_arg(ap,int); + ul_val = (unsigned long) tval; + res = fmt_long(fn,arg,USIGN(tval),ul_val, + width,precision,fmt,&count); + break; + } + case FMTL_h: { + unsigned short tval = (unsigned short) va_arg(ap,int); + ul_val = (unsigned long) tval; + res = fmt_long(fn,arg,USIGN(tval),ul_val, + width,precision,fmt,&count); + break; + } + case FMTL_l: { + ul_val = (unsigned long) va_arg(ap,long); + res = fmt_long(fn,arg,USIGN(ul_val),ul_val, + width,precision,fmt,&count); + break; + } +#if SIZEOF_LONG_LONG + case FMTL_ll: { + unsigned_long_long ull_val; + ull_val = (signed_long_long) va_arg(ap,long_long); + res = fmt_long_long(fn,arg,USIGN(ull_val),ull_val, + width,precision,fmt,&count); + break; + } +#endif + default: { + unsigned int tval = (unsigned int) va_arg(ap,int); + ul_val = (unsigned long) tval; + res = fmt_long(fn,arg,USIGN(tval),ul_val, + width,precision,fmt,&count); + break; + } + } + break; + case FMTC_e: + case FMTC_E: + case FMTC_f: + case FMTC_g: + case FMTC_G: + if (precision < 0) + precision = 6; + switch(fmt & FMTL_MASK) { + case FMTL_L: + return -EINVAL; + break; + default: + res = fmt_double(fn,arg,va_arg(ap,double), + width,precision,fmt,&count); + break; + } + break; + + case FMTC_c: { + /* fixme: add wide char support l-modifier */ + char c = va_arg(ap,int); + int len = 1; + if (precision == 0) + len = 0; + if (width > 0 && !(fmt & FMTF_adj)) { + if (width > len) + BLANKS(fn, arg, width - len, count); + } + if (len) + FMT(fn,arg,&c,len,count); + if (width > len && fmt & FMTF_adj) + BLANKS(fn, arg, width - len, count); + break; + } + + case FMTC_s: { + char* str = va_arg(ap,char*); + int len = strlen(str); + if (precision >= 0 && precision < len) + len = precision; + if (width > 0 && !(fmt & FMTF_adj)) { + if (width > len) + BLANKS(fn, arg, width - len, count); + } + if (len) + FMT(fn,arg,str,len,count); + if (width > len && fmt & FMTF_adj) + BLANKS(fn, arg, width - len, count); + break; + } + + case FMTC_p: { + void* addr = va_arg(ap, void*); + + res = fmt_long(fn, + arg, + USIGN((unsigned long) addr), + (unsigned long) addr, + width < 0 ? ((int) 2*sizeof(void *)) : width, + (precision < 0 + ? ((int) 2*sizeof(void *)) + : precision), + FMTC_x|FMTF_pad|FMTF_alt, + &count); + break; + } + + case FMTC_n: + switch(fmt & FMTL_MASK) { + case FMTL_hh: *va_arg(ap,char*) = count; break; + case FMTL_h: *va_arg(ap,short*) = count; break; + case FMTL_l: *va_arg(ap,long*) = count; break; +#if SIZEOF_LONG_LONG + case FMTL_ll: *va_arg(ap,long_long*) = count; break; +#endif + default: *va_arg(ap,int*) = count; break; + } + break; + case FMTC_T: { + long prec; + unsigned long eterm; + if (!erts_printf_eterm_func) + return -EINVAL; + if (precision < 0) + prec = 100000; + else if (precision == INT_MAX) + prec = LONG_MAX; + else + prec = (long) precision; + eterm = va_arg(ap, unsigned long); + if (width > 0 && !(fmt & FMTF_adj)) { + res = (*erts_printf_eterm_func)(noop_fn, NULL, eterm, prec); + if (res < 0) + return res; + if (width > res) + BLANKS(fn, arg, width - res, count); + } + res = (*erts_printf_eterm_func)(fn, arg, eterm, prec); + if (res < 0) + return res; + count += res; + if (width > res && fmt & FMTF_adj) + BLANKS(fn, arg, width - res, count); + break; + } + default: + if ((n=ptr-ptr0)) + FMT(fn,arg,ptr0,n,count); + } + ptr0 = ptr; + } + else + ptr++; + } + + if ((n=ptr-ptr0)) + FMT(fn,arg,ptr0,n,count); + return count; +} + + +int +erts_printf_char(fmtfn_t fn, void *arg, char c) +{ + return (*fn)(arg, &c, 1); +} + +int +erts_printf_string(fmtfn_t fn, void *arg, char *str) +{ + size_t sz = strlen(str); + return (*fn)(arg, str, sz); +} + +int +erts_printf_buf(fmtfn_t fn, void *arg, char *buf, size_t sz) +{ + return (*fn)(arg, buf, sz); +} + +int +erts_printf_pointer(fmtfn_t fn, void *arg, void *ptr) +{ + int count = 0; + int res = fmt_long(fn, arg, USIGN((unsigned long) ptr), + (unsigned long) ptr, 2*sizeof(void *), + 2*sizeof(void *), FMTC_x|FMTF_pad|FMTF_alt, &count); + if (res < 0) + return res; + return count; +} + +int +erts_printf_ulong(fmtfn_t fn, void *arg, char conv, int pad, int width, + unsigned long val) +{ + int count = 0; + int res; + int fmt = 0; + int prec = -1; + switch (conv) { + case 'o': fmt |= FMTC_o; break; + case 'u': fmt |= FMTC_u; break; + case 'x': fmt |= FMTC_x; break; + case 'X': fmt |= FMTC_X; break; + case 'p': fmt |= FMTC_p; break; + default: + return -EINVAL; + } + if (pad) + prec = width; + res = fmt_long(fn, arg, USIGN(val), val, width, prec, fmt, &count); + if (res < 0) + return res; + return count; +} + +extern int +erts_printf_slong(fmtfn_t fn, void *arg, char conv, int pad, int width, + signed long val) +{ + int count = 0; + int res; + int fmt = 0; + int prec = -1; + unsigned long ul_val; + switch (conv) { + case 'd': fmt |= FMTC_d; break; + case 'i': fmt |= FMTC_i; break; + case 'o': fmt |= FMTC_o; break; + case 'x': fmt |= FMTC_x; break; + case 'X': fmt |= FMTC_X; break; + default: + return -EINVAL; + } + if (pad) + prec = width; + ul_val = (unsigned long) (val < 0 ? -val : val); + res = fmt_long(fn, arg, SIGN(val), ul_val, width, prec, fmt, &count); + if (res < 0) + return res; + return count; +} + +int +erts_printf_double(fmtfn_t fn, void *arg, char conv, int precision, int width, + double val) +{ + int count = 0; + int res; + int fmt = 0; + switch (conv) { + case 'e': fmt |= FMTC_e; break; + case 'E': fmt |= FMTC_E; break; + case 'f': fmt |= FMTC_f; break; + case 'g': fmt |= FMTC_g; break; + case 'G': fmt |= FMTC_G; break; + default: + return -EINVAL; + } + res = fmt_double(fn, arg, val, width, precision, fmt, &count); + if (res < 0) + return res; + return count; +} diff --git a/erts/lib_src/common/ethread.c b/erts/lib_src/common/ethread.c new file mode 100644 index 0000000000..eb4d0cad20 --- /dev/null +++ b/erts/lib_src/common/ethread.c @@ -0,0 +1,3346 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: A Thread library for use in the ERTS and other OTP + * applications. + * Author: Rickard Green + */ + +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + +#undef ETHR_STACK_GUARD_SIZE + +#if defined(ETHR_PTHREADS) + +#ifdef ETHR_TIME_WITH_SYS_TIME +# include +# include +#else +# ifdef ETHR_HAVE_SYS_TIME_H +# include +# else +# include +# endif +#endif +#include +#include +#include + +#ifdef ETHR_HAVE_PTHREAD_ATTR_SETGUARDSIZE +# define ETHR_STACK_GUARD_SIZE (pagesize) +#endif + +#elif defined(ETHR_WIN32_THREADS) + +#undef WIN32_LEAN_AND_MEAN +#define WIN32_LEAN_AND_MEAN +#include +#include +#include + +#else +#error "Missing thread implementation" +#endif + +#include + +#define ETHR_FORCE_INLINE_FUNCS +#define ETHR_INLINE_FUNC_NAME_(X) X ## __ +#include "ethread.h" + +#ifndef ETHR_HAVE_ETHREAD_DEFINES +#error Missing configure defines +#endif + +/* + * ---------------------------------------------------------------------------- + * Common stuff + * ---------------------------------------------------------------------------- + */ + +#define ETHR_MAX_THREADS 2048 /* Has to be an even power of 2 */ + +static int ethr_not_inited = 1; + +#define ASSERT(A) ETHR_ASSERT((A)) + +static void *(*allocp)(size_t) = malloc; +static void *(*reallocp)(void *, size_t) = realloc; +static void (*freep)(void *) = free; + +#ifndef ETHR_HAVE_OPTIMIZED_ATOMIC_OPS +ethr_atomic_protection_t ethr_atomic_protection__[1 << ETHR_ATOMIC_ADDR_BITS]; +#endif + +void *(*thread_create_prepare_func)(void) = NULL; +void (*thread_create_parent_func)(void *) = NULL; +void (*thread_create_child_func)(void *) = NULL; + +typedef struct ethr_xhndl_list_ ethr_xhndl_list; +struct ethr_xhndl_list_ { + ethr_xhndl_list *next; + void (*funcp)(void); +}; + +static size_t pagesize; +#define ETHR_PAGE_ALIGN(SZ) (((((size_t) (SZ)) - 1)/pagesize + 1)*pagesize) +static size_t min_stack_size; /* kilo words */ +static size_t max_stack_size; /* kilo words */ +#define ETHR_B2KW(B) ((((size_t) (B)) - 1)/(sizeof(void *)*1024) + 1) +#define ETHR_KW2B(KW) (((size_t) (KW))*sizeof(void *)*1024) + +ethr_mutex xhndl_mtx; +ethr_xhndl_list *xhndl_list; + +static int +init_common(ethr_init_data *id) +{ + int res; + if (id) { + allocp = id->alloc; + reallocp = id->realloc; + freep = id->free; + thread_create_prepare_func = id->thread_create_prepare_func; + thread_create_parent_func = id->thread_create_parent_func; + thread_create_child_func = id->thread_create_child_func; + } + if (!allocp || !reallocp || !freep) + return EINVAL; + +#ifdef _SC_PAGESIZE + pagesize = (size_t) sysconf(_SC_PAGESIZE); +#elif defined(HAVE_GETPAGESIZE) + pagesize = (size_t) getpagesize(); +#else + pagesize = (size_t) 4*1024; /* Guess 4 KB */ +#endif + + /* User needs at least 4 KB */ + min_stack_size = 4*1024; +#if SIZEOF_VOID_P == 8 + /* Double that on 64-bit archs */ + min_stack_size *= 2; +#endif + /* On some systems as much as about 4 KB is used by the system */ + min_stack_size += 4*1024; + /* There should be room for signal handlers */ +#ifdef SIGSTKSZ + min_stack_size += SIGSTKSZ; +#else + min_stack_size += pagesize; +#endif + /* The system may think that we need more stack */ +#if defined(PTHREAD_STACK_MIN) + if (min_stack_size < PTHREAD_STACK_MIN) + min_stack_size = PTHREAD_STACK_MIN; +#elif defined(_SC_THREAD_STACK_MIN) + { + size_t thr_min_stk_sz = (size_t) sysconf(_SC_THREAD_STACK_MIN); + if (min_stack_size < thr_min_stk_sz) + min_stack_size = thr_min_stk_sz; + } +#endif + /* The guard is at least on some platforms included in the stack size + passed when creating threads */ +#ifdef ETHR_STACK_GUARD_SIZE + min_stack_size += ETHR_STACK_GUARD_SIZE; +#endif + min_stack_size = ETHR_PAGE_ALIGN(min_stack_size); + + min_stack_size = ETHR_B2KW(min_stack_size); + + max_stack_size = 32*1024*1024; +#if SIZEOF_VOID_P == 8 + max_stack_size *= 2; +#endif + max_stack_size = ETHR_B2KW(max_stack_size); + + xhndl_list = NULL; + + res = ethr_mutex_init(&xhndl_mtx); + if (res != 0) + return res; + + res = ethr_mutex_set_forksafe(&xhndl_mtx); + if (res != 0 && res != ENOTSUP) + return res; + + return 0; +} + +int +ethr_install_exit_handler(void (*funcp)(void)) +{ + ethr_xhndl_list *xhp; + int res; + +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + + if (!funcp) + return EINVAL; + + xhp = (ethr_xhndl_list *) (*allocp)(sizeof(ethr_xhndl_list)); + if (!xhp) + return ENOMEM; + + res = ethr_mutex_lock__(&xhndl_mtx); + if (res != 0) { + (*freep)((void *) xhp); + return res; + } + + xhp->funcp = funcp; + xhp->next = xhndl_list; + xhndl_list = xhp; + + res = ethr_mutex_unlock__(&xhndl_mtx); + if (res != 0) + abort(); + + return res; +} + +static void +run_exit_handlers(void) +{ + int res; + ethr_xhndl_list *xhp; + + res = ethr_mutex_lock__(&xhndl_mtx); + if (res != 0) + abort(); + + xhp = xhndl_list; + + res = ethr_mutex_unlock__(&xhndl_mtx); + if (res != 0) + abort(); + + for (; xhp; xhp = xhp->next) + (*xhp->funcp)(); +} + +#if defined(ETHR_PTHREADS) +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * pthread implementation * +\* */ + +typedef struct { + pthread_mutex_t mtx; + pthread_cond_t cnd; + int initialized; + void *(*thr_func)(void *); + void *arg; + void *prep_func_res; +} thr_wrap_data_; + +static int no_ethreads; +static ethr_mutex no_ethrs_mtx; + +#ifndef ETHR_HAVE_PTHREAD_ATFORK +#define ETHR_HAVE_PTHREAD_ATFORK 0 +#endif + +#if !ETHR_HAVE_PTHREAD_ATFORK +#warning "Cannot enforce fork-safety" +#endif + +/* + * ---------------------------------------------------------------------------- + * Static functions + * ---------------------------------------------------------------------------- + */ + +/* + * Functions with safe_ prefix aborts on failure. To be used when + * we cannot recover after failure. + */ + +static ETHR_INLINE void +safe_mutex_lock(pthread_mutex_t *mtxp) +{ + int res = pthread_mutex_lock(mtxp); + if (res != 0) + abort(); +} + +static ETHR_INLINE void +safe_mutex_unlock(pthread_mutex_t *mtxp) +{ + int res = pthread_mutex_unlock(mtxp); + if (res != 0) + abort(); +} + +static ETHR_INLINE void +safe_cond_signal(pthread_cond_t *cndp) +{ + int res = pthread_cond_signal(cndp); + if (res != 0) + abort(); +} + +#ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT + +static volatile int rec_mtx_attr_need_init = 1; +static pthread_mutexattr_t rec_mtx_attr; + +static int init_rec_mtx_attr(void); + +#endif + +#if ETHR_HAVE_PTHREAD_ATFORK + +static ethr_mutex forksafe_mtx = ETHR_MUTEX_INITER; + +static void lock_mutexes(void) +{ + ethr_mutex *m = &forksafe_mtx; + do { + + safe_mutex_lock(&m->pt_mtx); + + m = m->next; + + } while (m != &forksafe_mtx); +} + +static void unlock_mutexes(void) +{ + ethr_mutex *m = forksafe_mtx.prev; + do { + + safe_mutex_unlock(&m->pt_mtx); + + m = m->prev; + + } while (m->next != &forksafe_mtx); +} + +#if ETHR_INIT_MUTEX_IN_CHILD_AT_FORK + +static void reinit_mutexes(void) +{ + ethr_mutex *m = forksafe_mtx.prev; + do { + pthread_mutexattr_t *attrp = NULL; + +#ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT + if (m->is_rec_mtx) { + if (rec_mtx_attr_need_init) { + int res = init_rec_mtx_attr(); + if (res != 0) + abort(); + } + attrp = &rec_mtx_attr; + } +#endif + if (pthread_mutex_init(&m->pt_mtx, attrp) != 0) + abort(); + + m = m->prev; + + } while (m->next != &forksafe_mtx); +} + +#endif + +static int +init_forksafe(void) +{ + static int init_done = 0; + int res = 0; + + if (init_done) + return res; + + forksafe_mtx.prev = &forksafe_mtx; + forksafe_mtx.next = &forksafe_mtx; + + res = pthread_atfork(lock_mutexes, + unlock_mutexes, +#if ETHR_INIT_MUTEX_IN_CHILD_AT_FORK + reinit_mutexes +#else + unlock_mutexes +#endif + ); + + init_done = 1; + return res; +} + +#endif + + +#ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT + +#if defined(ETHR_HAVE_PTHREAD_MUTEXATTR_SETTYPE) + +#define SET_REC_MUTEX_ATTR(AP) \ + pthread_mutexattr_settype((AP), PTHREAD_MUTEX_RECURSIVE); + +#elif defined(ETHR_HAVE_PTHREAD_MUTEXATTR_SETKIND_NP) + +#define SET_REC_MUTEX_ATTR(AP) \ + pthread_mutexattr_setkind_np((AP), PTHREAD_MUTEX_RECURSIVE_NP); + +#else + +#error "Don't know how to set recursive mutex attributes" + +#endif + +static int +init_rec_mtx_attr(void) +{ + int res, mres; + static pthread_mutex_t attrinit_mtx = PTHREAD_MUTEX_INITIALIZER; + + mres = pthread_mutex_lock(&attrinit_mtx); + if (mres != 0) + return mres; + /* Got here under race conditions; check again ... */ + if (!rec_mtx_attr_need_init) + res = 0; + else { + res = pthread_mutexattr_init(&rec_mtx_attr); + if (res == 0) { + res = SET_REC_MUTEX_ATTR(&rec_mtx_attr); + if (res == 0) + rec_mtx_attr_need_init = 0; + else + (void) pthread_mutexattr_destroy(&rec_mtx_attr); + } + } + + mres = pthread_mutex_unlock(&attrinit_mtx); + if (mres != 0) + return mres; + return res; +} + +#endif /* #if ETHR_HAVE_ETHR_REC_MUTEX_INIT */ + +static ETHR_INLINE void thr_exit_cleanup(void) +{ + run_exit_handlers(); + safe_mutex_lock(&no_ethrs_mtx.pt_mtx); + ASSERT(no_ethreads > 0); + no_ethreads--; + safe_mutex_unlock(&no_ethrs_mtx.pt_mtx); +} + +static void *thr_wrapper(void *vtwd) +{ + void *res; + thr_wrap_data_ *twd = (thr_wrap_data_ *) vtwd; + void *(*thr_func)(void *) = twd->thr_func; + void *arg = twd->arg; + + safe_mutex_lock(&twd->mtx); + + if (thread_create_child_func) + (*thread_create_child_func)(twd->prep_func_res); + + twd->initialized = 1; + + safe_cond_signal(&twd->cnd); + safe_mutex_unlock(&twd->mtx); + + res = (*thr_func)(arg); + thr_exit_cleanup(); + return res; +} + + +/* + * ---------------------------------------------------------------------------- + * Exported functions + * ---------------------------------------------------------------------------- + */ + +int +ethr_init(ethr_init_data *id) +{ + int res; + + if (!ethr_not_inited) + return EINVAL; + + ethr_not_inited = 0; + + res = init_common(id); + if (res != 0) + goto error; + +#if ETHR_HAVE_PTHREAD_ATFORK + init_forksafe(); +#endif + + no_ethreads = 1; + res = ethr_mutex_init(&no_ethrs_mtx); + if (res != 0) + goto error; + res = ethr_mutex_set_forksafe(&no_ethrs_mtx); + if (res != 0 && res != ENOTSUP) + goto error; + +#ifndef ETHR_HAVE_OPTIMIZED_ATOMIC_OPS + { + int i; + for (i = 0; i < (1 << ETHR_ATOMIC_ADDR_BITS); i++) { +#ifdef ETHR_HAVE_PTHREAD_SPIN_LOCK + res = pthread_spin_init(ðr_atomic_protection__[i].u.spnlck, 0); +#else + res = ethr_mutex_init(ðr_atomic_protection__[i].u.mtx); +#endif + if (res != 0) + goto error; + } + } +#endif + + return 0; + + error: + ethr_not_inited = 1; + return res; + +} + +int +ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg, + ethr_thr_opts *opts) +{ + thr_wrap_data_ twd; + pthread_attr_t attr; + int res, dres; + int use_stack_size = (opts && opts->suggested_stack_size >= 0 + ? opts->suggested_stack_size + : -1 /* Use system default */); + +#ifdef ETHR_MODIFIED_DEFAULT_STACK_SIZE + if (use_stack_size < 0) + use_stack_size = ETHR_MODIFIED_DEFAULT_STACK_SIZE; +#endif + + twd.initialized = 0; + twd.thr_func = func; + twd.arg = arg; + +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!tid || !func) { + ASSERT(0); + return EINVAL; + } +#endif + + /* Call prepare func if it exist */ + if (thread_create_prepare_func) + twd.prep_func_res = (*thread_create_prepare_func)(); + else + twd.prep_func_res = NULL; + + /* Set som thread attributes */ + res = pthread_attr_init(&attr); + if (res != 0) + goto cleanup_parent_func; + res = pthread_mutex_init(&twd.mtx, NULL); + if (res != 0) + goto cleanup_attr_destroy; + res = pthread_cond_init(&twd.cnd, NULL); + if (res != 0) + goto cleanup_mutex_destroy; + + /* Schedule child thread in system scope (if possible) ... */ + res = pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM); + if (res != 0 && res != ENOTSUP) + goto cleanup_cond_destroy; + + if (use_stack_size >= 0) { + size_t suggested_stack_size = (size_t) use_stack_size; + size_t stack_size; +#ifdef DEBUG + suggested_stack_size /= 2; /* Make sure we got margin */ +#endif +#ifdef ETHR_STACK_GUARD_SIZE + /* The guard is at least on some platforms included in the stack size + passed when creating threads */ + suggested_stack_size += ETHR_B2KW(ETHR_STACK_GUARD_SIZE); +#endif + if (suggested_stack_size < min_stack_size) + stack_size = ETHR_KW2B(min_stack_size); + else if (suggested_stack_size > max_stack_size) + stack_size = ETHR_KW2B(max_stack_size); + else + stack_size = ETHR_PAGE_ALIGN(ETHR_KW2B(suggested_stack_size)); + (void) pthread_attr_setstacksize(&attr, stack_size); + } + +#ifdef ETHR_STACK_GUARD_SIZE + (void) pthread_attr_setguardsize(&attr, ETHR_STACK_GUARD_SIZE); +#endif + + /* Detached or joinable... */ + res = pthread_attr_setdetachstate(&attr, + (opts && opts->detached + ? PTHREAD_CREATE_DETACHED + : PTHREAD_CREATE_JOINABLE)); + if (res != 0) + goto cleanup_cond_destroy; + + res = pthread_mutex_lock(&twd.mtx); + + if (res != 0) + goto cleanup_cond_destroy; + + safe_mutex_lock(&no_ethrs_mtx.pt_mtx); + if (no_ethreads < ETHR_MAX_THREADS) { + no_ethreads++; + safe_mutex_unlock(&no_ethrs_mtx.pt_mtx); + } + else { + res = EAGAIN; + safe_mutex_unlock(&no_ethrs_mtx.pt_mtx); + goto cleanup_mutex_unlock; + } + + res = pthread_create((pthread_t *) tid, &attr, thr_wrapper, (void *) &twd); + + if (res != 0) { + safe_mutex_lock(&no_ethrs_mtx.pt_mtx); + ASSERT(no_ethreads > 0); + no_ethreads--; + safe_mutex_unlock(&no_ethrs_mtx.pt_mtx); + } + else { + + /* Wait for child to initialize... */ + while (!twd.initialized) { + res = pthread_cond_wait(&twd.cnd, &twd.mtx); + if (res != 0 && res != EINTR) + break; + } + + } + + /* Cleanup... */ + cleanup_mutex_unlock: + dres = pthread_mutex_unlock(&twd.mtx); + if (res == 0) + res = dres; + cleanup_cond_destroy: + dres = pthread_cond_destroy(&twd.cnd); + if (res == 0) + res = dres; + cleanup_mutex_destroy: + dres = pthread_mutex_destroy(&twd.mtx); + if (res == 0) + res = dres; + cleanup_attr_destroy: + dres = pthread_attr_destroy(&attr); + if (res == 0) + res = dres; + cleanup_parent_func: + if (thread_create_parent_func) + (*thread_create_parent_func)(twd.prep_func_res); + + return res; +} + +int +ethr_thr_join(ethr_tid tid, void **res) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + return pthread_join((pthread_t) tid, res); +} + +int +ethr_thr_detach(ethr_tid tid) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + return pthread_detach((pthread_t) tid); +} + +void +ethr_thr_exit(void *res) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return; + } +#endif + thr_exit_cleanup(); + pthread_exit(res); +} + +ethr_tid +ethr_self(void) +{ + return (ethr_tid) pthread_self(); +} + +int +ethr_equal_tids(ethr_tid tid1, ethr_tid tid2) +{ + return pthread_equal((pthread_t) tid1, (pthread_t) tid2); +} + + +/* + * Mutex functions + */ + + +int +ethr_mutex_init(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx) { + ASSERT(0); + return EINVAL; + } + mtx->initialized = ETHR_MUTEX_INITIALIZED; +#endif + mtx->prev = NULL; + mtx->next = NULL; + mtx->is_rec_mtx = 0; + return pthread_mutex_init(&mtx->pt_mtx, NULL); +} + +#ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT + +int +ethr_rec_mutex_init(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx) { + ASSERT(0); + return EINVAL; + } + mtx->initialized = ETHR_MUTEX_INITIALIZED; +#endif + if (rec_mtx_attr_need_init) + init_rec_mtx_attr(); + + mtx->prev = NULL; + mtx->next = NULL; + mtx->is_rec_mtx = 1; + return pthread_mutex_init(&mtx->pt_mtx, &rec_mtx_attr); +} + +#endif /* #if ETHR_HAVE_ETHR_REC_MUTEX_INIT */ + +int +ethr_mutex_destroy(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + if (mtx->next) { + ASSERT(mtx->prev); + ethr_mutex_unset_forksafe(mtx); + } +#if ETHR_XCHK + mtx->initialized = 0; +#endif + return pthread_mutex_destroy(&mtx->pt_mtx); +} + +int ethr_mutex_set_forksafe(ethr_mutex *mtx) +{ + int res; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif +#if ETHR_HAVE_PTHREAD_ATFORK + res = pthread_mutex_lock(&forksafe_mtx.pt_mtx); + if (res != 0) + return res; + if (!forksafe_mtx.next) { + ASSERT(!forksafe_mtx.prev); + init_forksafe(); + } + if (mtx->next) { + /* forksafe already set for this mutex */ + ASSERT(mtx->prev); + } + else { + mtx->next = forksafe_mtx.next; + mtx->prev = &forksafe_mtx; + forksafe_mtx.next->prev = mtx; + forksafe_mtx.next = mtx; + } + + res = pthread_mutex_unlock(&forksafe_mtx.pt_mtx); + +#else /* #if ETHR_HAVE_PTHREAD_ATFORK */ + res = ENOTSUP; +#endif /* #if ETHR_HAVE_PTHREAD_ATFORK */ + return res; +} + +int ethr_mutex_unset_forksafe(ethr_mutex *mtx) +{ + int res; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif +#if ETHR_HAVE_PTHREAD_ATFORK + res = pthread_mutex_lock(&forksafe_mtx.pt_mtx); + if (res != 0) + return res; + if (!forksafe_mtx.next) { + ASSERT(!forksafe_mtx.prev); + init_forksafe(); + } + if (!mtx->next) { + /* forksafe already unset for this mutex */ + ASSERT(!mtx->prev); + } + else { + mtx->prev->next = mtx->next; + mtx->next->prev = mtx->prev; + mtx->next = NULL; + mtx->prev = NULL; + } + res = pthread_mutex_unlock(&forksafe_mtx.pt_mtx); + +#else /* #if ETHR_HAVE_PTHREAD_ATFORK */ + res = ENOTSUP; +#endif /* #if ETHR_HAVE_PTHREAD_ATFORK */ + return res; +} + +int +ethr_mutex_trylock(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_mutex_trylock__(mtx); +} + +int +ethr_mutex_lock(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_mutex_lock__(mtx); +} + +int +ethr_mutex_unlock(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_mutex_unlock__(mtx); +} + +/* + * Condition variable functions + */ + +int +ethr_cond_init(ethr_cond *cnd) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd) { + ASSERT(0); + return EINVAL; + } + cnd->initialized = ETHR_COND_INITIALIZED; +#endif + return pthread_cond_init(&cnd->pt_cnd, NULL); +} + +int +ethr_cond_destroy(ethr_cond *cnd) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd || cnd->initialized != ETHR_COND_INITIALIZED) { + ASSERT(0); + return EINVAL; + } + cnd->initialized = 0; +#endif + return pthread_cond_destroy(&cnd->pt_cnd); +} + +int +ethr_cond_signal(ethr_cond *cnd) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd || cnd->initialized != ETHR_COND_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return pthread_cond_signal(&cnd->pt_cnd); +} + +int +ethr_cond_broadcast(ethr_cond *cnd) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd || cnd->initialized != ETHR_COND_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return pthread_cond_broadcast(&cnd->pt_cnd); +} + +int +ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd + || cnd->initialized != ETHR_COND_INITIALIZED + || !mtx + || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return pthread_cond_wait(&cnd->pt_cnd, &mtx->pt_mtx); +} + +int +ethr_cond_timedwait(ethr_cond *cnd, ethr_mutex *mtx, ethr_timeval *timeout) +{ + struct timespec to; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd + || cnd->initialized != ETHR_COND_INITIALIZED + || !mtx + || mtx->initialized != ETHR_MUTEX_INITIALIZED + || !timeout) { + ASSERT(0); + return EINVAL; + } +#endif + + to.tv_sec = timeout->tv_sec; + to.tv_nsec = timeout->tv_nsec; + + return pthread_cond_timedwait(&cnd->pt_cnd, &mtx->pt_mtx, &to); +} + + +#ifdef ETHR_HAVE_PTHREAD_RWLOCK_INIT + +int +ethr_rwmutex_init(ethr_rwmutex *rwmtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!rwmtx) { + ASSERT(0); + return EINVAL; + } + rwmtx->initialized = ETHR_RWMUTEX_INITIALIZED; +#endif + return pthread_rwlock_init(&rwmtx->pt_rwlock, NULL); +} + +int +ethr_rwmutex_destroy(ethr_rwmutex *rwmtx) +{ + int res; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + res = pthread_rwlock_destroy(&rwmtx->pt_rwlock); +#if ETHR_XCHK + rwmtx->initialized = 0; +#endif + return res; +} + +int +ethr_rwmutex_tryrlock(ethr_rwmutex *rwmtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_rwmutex_tryrlock__(rwmtx); +} + +int +ethr_rwmutex_rlock(ethr_rwmutex *rwmtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_rwmutex_rlock__(rwmtx); +} + +int +ethr_rwmutex_runlock(ethr_rwmutex *rwmtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_rwmutex_runlock__(rwmtx); +} + +int +ethr_rwmutex_tryrwlock(ethr_rwmutex *rwmtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_rwmutex_tryrwlock__(rwmtx); +} + +int +ethr_rwmutex_rwlock(ethr_rwmutex *rwmtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_rwmutex_rwlock__(rwmtx); +} + +int +ethr_rwmutex_rwunlock(ethr_rwmutex *rwmtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_rwmutex_rwunlock__(rwmtx); +} + +#endif /* #ifdef ETHR_HAVE_PTHREAD_RWLOCK_INIT */ + +/* + * Current time + */ + +int +ethr_time_now(ethr_timeval *time) +{ + int res; + struct timeval tv; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!time) { + ASSERT(0); + return EINVAL; + } +#endif + + res = gettimeofday(&tv, NULL); + time->tv_sec = (long) tv.tv_sec; + time->tv_nsec = ((long) tv.tv_usec)*1000; + return res; +} + +/* + * Thread specific data + */ + +int +ethr_tsd_key_create(ethr_tsd_key *keyp) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!keyp) { + ASSERT(0); + return EINVAL; + } +#endif + return pthread_key_create((pthread_key_t *) keyp, NULL); +} + +int +ethr_tsd_key_delete(ethr_tsd_key key) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + return pthread_key_delete((pthread_key_t) key); +} + +int +ethr_tsd_set(ethr_tsd_key key, void *value) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + return pthread_setspecific((pthread_key_t) key, value); +} + +void * +ethr_tsd_get(ethr_tsd_key key) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return NULL; + } +#endif + return pthread_getspecific((pthread_key_t) key); +} + +/* + * Signal functions + */ + +#if ETHR_HAVE_ETHR_SIG_FUNCS + +int ethr_sigmask(int how, const sigset_t *set, sigset_t *oset) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!set && !oset) { + ASSERT(0); + return EINVAL; + } +#endif + return pthread_sigmask(how, set, oset); +} + +int ethr_sigwait(const sigset_t *set, int *sig) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!set || !sig) { + ASSERT(0); + return EINVAL; + } +#endif + if (sigwait(set, sig) < 0) + return errno; + return 0; +} + +#endif /* #if ETHR_HAVE_ETHR_SIG_FUNCS */ + +#elif defined(ETHR_WIN32_THREADS) +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *\ + * Native win32 threads implementation * +\* */ + +#define INVALID_TID -1 + +/* The spin count values are more or less taken out of the blue */ +#define ETHR_MUTEX_SPIN_COUNT 5000 +#define ETHR_COND_SPIN_COUNT 1000 + +ethr_tid serial_shift; /* Bits to shift serial when constructing a tid */ +ethr_tid last_serial; /* Last thread table serial used */ +ethr_tid last_ix; /* Last thread table index used */ +ethr_tid thr_ix_mask; /* Mask used to mask out thread table index from a tid */ + +/* Event used for conditional variables. On per thread. */ +/*typedef struct cnd_wait_event__ cnd_wait_event_;*/ +struct cnd_wait_event__ { + HANDLE handle; + cnd_wait_event_ *prev; + cnd_wait_event_ *next; + int in_queue; +}; + +/* Thread specific data. Stored in the thread table */ +typedef struct { + ethr_tid thr_id; + HANDLE thr_handle; + ethr_tid joiner; + void *result; + cnd_wait_event_ wait_event; +} thr_data_; + +/* Argument passed to thr_wrapper() */ +typedef struct { + void * (*func)(void *); + void * arg; + thr_data_ *ptd; + thr_data_ *td; + int res; + void *prep_func_res; +} thr_wrap_data_; + + +static CRITICAL_SECTION thr_table_cs; /* Critical section used to protect + the thread table from concurrent + accesses. */ +static CRITICAL_SECTION fake_static_init_cs; /* Critical section used to protect + initialazition of 'statically + initialized' mutexes */ +static thr_data_ * thr_table[ETHR_MAX_THREADS]; /* The thread table */ + +static DWORD tls_own_thr_data; + +static thr_data_ main_thr_data; + +#define THR_IX(TID) ((TID) & thr_ix_mask) +#define OWN_THR_DATA ((thr_data_ *) TlsGetValue(tls_own_thr_data)) + +/* + * ---------------------------------------------------------------------------- + * Static functions + * ---------------------------------------------------------------------------- + */ + +static int +get_errno(void) +{ + switch (GetLastError()) { + case ERROR_INVALID_FUNCTION: return EINVAL; /* 1 */ + case ERROR_FILE_NOT_FOUND: return ENOENT; /* 2 */ + case ERROR_PATH_NOT_FOUND: return ENOENT; /* 3 */ + case ERROR_TOO_MANY_OPEN_FILES: return EMFILE; /* 4 */ + case ERROR_ACCESS_DENIED: return EACCES; /* 5 */ + case ERROR_INVALID_HANDLE: return EBADF; /* 6 */ + case ERROR_ARENA_TRASHED: return ENOMEM; /* 7 */ + case ERROR_NOT_ENOUGH_MEMORY: return ENOMEM; /* 8 */ + case ERROR_INVALID_BLOCK: return ENOMEM; /* 9 */ + case ERROR_BAD_ENVIRONMENT: return E2BIG; /* 10 */ + case ERROR_BAD_FORMAT: return ENOEXEC; /* 11 */ + case ERROR_INVALID_ACCESS: return EINVAL; /* 12 */ + case ERROR_INVALID_DATA: return EINVAL; /* 13 */ + case ERROR_OUTOFMEMORY: return ENOMEM; /* 14 */ + case ERROR_INVALID_DRIVE: return ENOENT; /* 15 */ + case ERROR_CURRENT_DIRECTORY: return EACCES; /* 16 */ + case ERROR_NOT_SAME_DEVICE: return EXDEV; /* 17 */ + case ERROR_NO_MORE_FILES: return ENOENT; /* 18 */ + case ERROR_WRITE_PROTECT: return EACCES; /* 19 */ + case ERROR_BAD_UNIT: return EACCES; /* 20 */ + case ERROR_NOT_READY: return EACCES; /* 21 */ + case ERROR_BAD_COMMAND: return EACCES; /* 22 */ + case ERROR_CRC: return EACCES; /* 23 */ + case ERROR_BAD_LENGTH: return EACCES; /* 24 */ + case ERROR_SEEK: return EACCES; /* 25 */ + case ERROR_NOT_DOS_DISK: return EACCES; /* 26 */ + case ERROR_SECTOR_NOT_FOUND: return EACCES; /* 27 */ + case ERROR_OUT_OF_PAPER: return EACCES; /* 28 */ + case ERROR_WRITE_FAULT: return EACCES; /* 29 */ + case ERROR_READ_FAULT: return EACCES; /* 30 */ + case ERROR_GEN_FAILURE: return EACCES; /* 31 */ + case ERROR_SHARING_VIOLATION: return EACCES; /* 32 */ + case ERROR_LOCK_VIOLATION: return EACCES; /* 33 */ + case ERROR_WRONG_DISK: return EACCES; /* 34 */ + case ERROR_SHARING_BUFFER_EXCEEDED: return EACCES; /* 36 */ + case ERROR_BAD_NETPATH: return ENOENT; /* 53 */ + case ERROR_NETWORK_ACCESS_DENIED: return EACCES; /* 65 */ + case ERROR_BAD_NET_NAME: return ENOENT; /* 67 */ + case ERROR_FILE_EXISTS: return EEXIST; /* 80 */ + case ERROR_CANNOT_MAKE: return EACCES; /* 82 */ + case ERROR_FAIL_I24: return EACCES; /* 83 */ + case ERROR_INVALID_PARAMETER: return EINVAL; /* 87 */ + case ERROR_NO_PROC_SLOTS: return EAGAIN; /* 89 */ + case ERROR_DRIVE_LOCKED: return EACCES; /* 108 */ + case ERROR_BROKEN_PIPE: return EPIPE; /* 109 */ + case ERROR_DISK_FULL: return ENOSPC; /* 112 */ + case ERROR_INVALID_TARGET_HANDLE: return EBADF; /* 114 */ + case ERROR_WAIT_NO_CHILDREN: return ECHILD; /* 128 */ + case ERROR_CHILD_NOT_COMPLETE: return ECHILD; /* 129 */ + case ERROR_DIRECT_ACCESS_HANDLE: return EBADF; /* 130 */ + case ERROR_NEGATIVE_SEEK: return EINVAL; /* 131 */ + case ERROR_SEEK_ON_DEVICE: return EACCES; /* 132 */ + case ERROR_DIR_NOT_EMPTY: return ENOTEMPTY;/* 145 */ + case ERROR_NOT_LOCKED: return EACCES; /* 158 */ + case ERROR_BAD_PATHNAME: return ENOENT; /* 161 */ + case ERROR_MAX_THRDS_REACHED: return EAGAIN; /* 164 */ + case ERROR_LOCK_FAILED: return EACCES; /* 167 */ + case ERROR_ALREADY_EXISTS: return EEXIST; /* 183 */ + case ERROR_INVALID_STARTING_CODESEG: return ENOEXEC; /* 188 */ + case ERROR_INVALID_STACKSEG: return ENOEXEC; /* 189 */ + case ERROR_INVALID_MODULETYPE: return ENOEXEC; /* 190 */ + case ERROR_INVALID_EXE_SIGNATURE: return ENOEXEC; /* 191 */ + case ERROR_EXE_MARKED_INVALID: return ENOEXEC; /* 192 */ + case ERROR_BAD_EXE_FORMAT: return ENOEXEC; /* 193 */ + case ERROR_ITERATED_DATA_EXCEEDS_64k: return ENOEXEC; /* 194 */ + case ERROR_INVALID_MINALLOCSIZE: return ENOEXEC; /* 195 */ + case ERROR_DYNLINK_FROM_INVALID_RING: return ENOEXEC; /* 196 */ + case ERROR_IOPL_NOT_ENABLED: return ENOEXEC; /* 197 */ + case ERROR_INVALID_SEGDPL: return ENOEXEC; /* 198 */ + case ERROR_AUTODATASEG_EXCEEDS_64k: return ENOEXEC; /* 199 */ + case ERROR_RING2SEG_MUST_BE_MOVABLE: return ENOEXEC; /* 200 */ + case ERROR_RELOC_CHAIN_XEEDS_SEGLIM: return ENOEXEC; /* 201 */ + case ERROR_INFLOOP_IN_RELOC_CHAIN: return ENOEXEC; /* 202 */ + case ERROR_FILENAME_EXCED_RANGE: return ENOENT; /* 206 */ + case ERROR_NESTING_NOT_ALLOWED: return EAGAIN; /* 215 */ + case ERROR_NOT_ENOUGH_QUOTA: return ENOMEM; /* 1816 */ + default: return EINVAL; + } +} + +static ETHR_INLINE thr_data_ * +tid2thr(ethr_tid tid) +{ + ethr_tid ix; + thr_data_ *td; + + if (tid < 0) + return NULL; + ix = THR_IX(tid); + if (ix >= ETHR_MAX_THREADS) + return NULL; + td = thr_table[ix]; + if (!td) + return NULL; + if (td->thr_id != tid) + return NULL; + return td; +} + +static ETHR_INLINE void +new_tid(ethr_tid *new_tid, ethr_tid *new_serial, ethr_tid *new_ix) +{ + ethr_tid tmp_serial = last_serial; + ethr_tid tmp_ix = last_ix + 1; + ethr_tid start_ix = tmp_ix; + + + do { + if (tmp_ix >= ETHR_MAX_THREADS) { + tmp_serial++; + if ((tmp_serial << serial_shift) < 0) + tmp_serial = 0; + tmp_ix = 0; + } + if (!thr_table[tmp_ix]) { + *new_tid = (tmp_serial << serial_shift) | tmp_ix; + *new_serial = tmp_serial; + *new_ix = tmp_ix; + return; + } + tmp_ix++; + } while (tmp_ix != start_ix); + + *new_tid = INVALID_TID; + *new_serial = INVALID_TID; + *new_ix = INVALID_TID; + +} + + +static void thr_exit_cleanup(thr_data_ *td, void *res) +{ + + ASSERT(td == OWN_THR_DATA); + + run_exit_handlers(); + + EnterCriticalSection(&thr_table_cs); + CloseHandle(td->wait_event.handle); + if (td->thr_handle == INVALID_HANDLE_VALUE) { + /* We are detached; cleanup thread table */ + ASSERT(td->joiner == INVALID_TID); + ASSERT(td == thr_table[THR_IX(td->thr_id)]); + thr_table[THR_IX(td->thr_id)] = NULL; + if (td != &main_thr_data) + (*freep)((void *) td); + } + else { + /* Save result and let joining thread cleanup */ + td->result = res; + } + LeaveCriticalSection(&thr_table_cs); +} + +static unsigned __stdcall thr_wrapper(LPVOID args) +{ + void *(*func)(void*) = ((thr_wrap_data_ *) args)->func; + void *arg = ((thr_wrap_data_ *) args)->arg; + thr_data_ *td = ((thr_wrap_data_ *) args)->td; + + td->wait_event.handle = CreateEvent(NULL, FALSE, FALSE, NULL); + if (td->wait_event.handle == INVALID_HANDLE_VALUE + || !TlsSetValue(tls_own_thr_data, (LPVOID) td)) { + ((thr_wrap_data_ *) args)->res = get_errno(); + if (td->wait_event.handle != INVALID_HANDLE_VALUE) + CloseHandle(td->wait_event.handle); + SetEvent(((thr_wrap_data_ *) args)->ptd->wait_event.handle); + _endthreadex((unsigned) 0); + ASSERT(0); + } + + td->wait_event.prev = NULL; + td->wait_event.next = NULL; + td->wait_event.in_queue = 0; + + if (thread_create_child_func) + (*thread_create_child_func)(((thr_wrap_data_ *) args)->prep_func_res); + + ASSERT(td == OWN_THR_DATA); + + ((thr_wrap_data_ *) args)->res = 0; + SetEvent(((thr_wrap_data_ *) args)->ptd->wait_event.handle); + + thr_exit_cleanup(td, (*func)(arg)); + return 0; +} + +int +ethr_fake_static_mutex_init(ethr_mutex *mtx) +{ + EnterCriticalSection((CRITICAL_SECTION *) &fake_static_init_cs); + /* Got here under race conditions; check again... */ + if (!mtx->initialized) { + if (!InitializeCriticalSectionAndSpinCount(&mtx->cs, + ETHR_MUTEX_SPIN_COUNT)) + return get_errno(); + mtx->initialized = ETHR_MUTEX_INITIALIZED; + } + LeaveCriticalSection((CRITICAL_SECTION *) &fake_static_init_cs); + return 0; +} + +static int +fake_static_cond_init(ethr_cond *cnd) +{ + EnterCriticalSection((CRITICAL_SECTION *) &fake_static_init_cs); + /* Got here under race conditions; check again... */ + if (!cnd->initialized) { + if (!InitializeCriticalSectionAndSpinCount(&cnd->cs, + ETHR_COND_SPIN_COUNT)) + return get_errno(); + cnd->queue = NULL; + cnd->queue_end = NULL; + cnd->initialized = ETHR_COND_INITIALIZED; + } + LeaveCriticalSection((CRITICAL_SECTION *) &fake_static_init_cs); + return 0; +} + +#ifdef __GNUC__ +#define LL_LITERAL(X) X##LL +#else +#define LL_LITERAL(X) X##i64 +#endif + +#define EPOCH_JULIAN_DIFF LL_LITERAL(11644473600) + +static ETHR_INLINE void +get_curr_time(long *sec, long *nsec) +{ + SYSTEMTIME t; + FILETIME ft; + LONGLONG lft; + + GetSystemTime(&t); + SystemTimeToFileTime(&t, &ft); + memcpy(&lft, &ft, sizeof(lft)); + *nsec = ((long) (lft % LL_LITERAL(10000000)))*100; + *sec = (long) ((lft / LL_LITERAL(10000000)) - EPOCH_JULIAN_DIFF); +} + +static cnd_wait_event_ *cwe_freelist; +static CRITICAL_SECTION cwe_cs; + +static int +alloc_cwe(cnd_wait_event_ **cwe_res) +{ + cnd_wait_event_ *cwe; + EnterCriticalSection(&cwe_cs); + cwe = cwe_freelist; + if (cwe) { + cwe_freelist = cwe->next; + LeaveCriticalSection(&cwe_cs); + } + else { + LeaveCriticalSection(&cwe_cs); + cwe = (*allocp)(sizeof(cnd_wait_event_)); + if (!cwe) + return ENOMEM; + cwe->handle = CreateEvent(NULL, FALSE, FALSE, NULL); + if (cwe->handle == INVALID_HANDLE_VALUE) { + int res = get_errno(); + (*freep)(cwe); + return res; + } + } + *cwe_res = cwe; + return 0; +} + +static +free_cwe(cnd_wait_event_ *cwe) +{ + EnterCriticalSection(&cwe_cs); + cwe->next = cwe_freelist; + cwe_freelist = cwe; + LeaveCriticalSection(&cwe_cs); +} + +static ETHR_INLINE int +condwait(ethr_cond *cnd, + ethr_mutex *mtx, + int with_timeout, + ethr_timeval *timeout) +{ + int res; + thr_data_ *td; + cnd_wait_event_ *cwe; + DWORD code; + long time; /* time until timeout in milli seconds */ + +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + + if (!mtx + || mtx->initialized != ETHR_MUTEX_INITIALIZED + || !cnd + || (cnd->initialized && cnd->initialized != ETHR_COND_INITIALIZED) + || (with_timeout && !timeout)) { + ASSERT(0); + return EINVAL; + } +#endif + + td = OWN_THR_DATA; + if (td) + cwe = &td->wait_event; + else { /* A non-ethread thread */ + res = alloc_cwe(&cwe); + if (res != 0) + return res; + } + + if (!cnd->initialized) + fake_static_cond_init(cnd); + EnterCriticalSection(&cnd->cs); + + ASSERT(!cwe->in_queue); + if (cnd->queue_end) { + ASSERT(cnd->queue); + cwe->prev = cnd->queue_end; + cwe->next = NULL; + cnd->queue_end->next = cwe; + cnd->queue_end = cwe; + } + else { + ASSERT(!cnd->queue); + cwe->prev = NULL; + cwe->next = NULL; + cnd->queue = cwe; + cnd->queue_end = cwe; + } + cwe->in_queue = 1; + + LeaveCriticalSection(&cnd->cs); + + LeaveCriticalSection(&mtx->cs); + + if (!with_timeout) + time = INFINITE; + else { + long sec, nsec; + ASSERT(timeout); + get_curr_time(&sec, &nsec); + time = (timeout->tv_sec - sec)*1000; + time += (timeout->tv_nsec - nsec + 500)/1000000; + if (time < 0) + time = 0; + } + + /* wait for event to signal */ + code = WaitForSingleObject(cwe->handle, time); + + EnterCriticalSection(&mtx->cs); + + if (code == WAIT_OBJECT_0) { + /* We were woken by a signal or a broadcast ... */ + res = 0; + + /* ... no need to remove event from wait queue since this was + taken care of by the signal or broadcast */ +#ifdef DEBUG + EnterCriticalSection(&cnd->cs); + ASSERT(!cwe->in_queue); + LeaveCriticalSection(&cnd->cs); +#endif + + } + else { + /* We timed out... */ + res = ETIMEDOUT; + + /* ... probably have to remove event from wait queue ... */ + EnterCriticalSection(&cnd->cs); + + if (cwe->in_queue) { /* ... but we must check that we are in queue + since a signal or broadcast after timeout + may have removed us from the queue */ + if (cwe->prev) { + cwe->prev->next = cwe->next; + } + else { + ASSERT(cnd->queue == cwe); + cnd->queue = cwe->next; + } + + if (cwe->next) { + cwe->next->prev = cwe->prev; + } + else { + ASSERT(cnd->queue_end == cwe); + cnd->queue_end = cwe->prev; + } + cwe->in_queue = 0; + } + + LeaveCriticalSection(&cnd->cs); + + } + + if (!td) + free_cwe(cwe); + + return res; + +} + + +/* + * ---------------------------------------------------------------------------- + * Exported functions + * ---------------------------------------------------------------------------- + */ + +int +ethr_init(ethr_init_data *id) +{ +#ifdef _WIN32_WINNT + DWORD major = (_WIN32_WINNT >> 8) & 0xff; + DWORD minor = _WIN32_WINNT & 0xff; + OSVERSIONINFO os_version; +#endif + int err = 0; + thr_data_ *td = &main_thr_data; + unsigned long i; + + if (!ethr_not_inited) + return EINVAL; + +#ifdef _WIN32_WINNT + os_version.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); + GetVersionEx(&os_version); + if (os_version.dwPlatformId != VER_PLATFORM_WIN32_NT + || os_version.dwMajorVersion < major + || (os_version.dwMajorVersion == major + && os_version.dwMinorVersion < minor)) + return ENOTSUP; +#endif + + ASSERT(ETHR_MAX_THREADS > 0); + for (i = ETHR_MAX_THREADS - 1, serial_shift = 0; + i; + serial_shift++, i >>= 1); + thr_ix_mask = ~(~((ethr_tid) 0) << serial_shift); + + tls_own_thr_data = TlsAlloc(); + if (tls_own_thr_data == TLS_OUT_OF_INDEXES) + goto error; + + last_serial = 0; + last_ix = 0; + + td->thr_id = 0; + td->thr_handle = GetCurrentThread(); + td->joiner = INVALID_TID; + td->result = NULL; + td->wait_event.handle = CreateEvent(NULL, FALSE, FALSE, NULL); + if (td->wait_event.handle == INVALID_HANDLE_VALUE) + goto error; + td->wait_event.prev = NULL; + td->wait_event.next = NULL; + td->wait_event.in_queue = 0; + thr_table[0] = td; + + if (!TlsSetValue(tls_own_thr_data, (LPVOID) td)) + goto error; + + ASSERT(td == OWN_THR_DATA); + + + cwe_freelist = NULL; + if (!InitializeCriticalSectionAndSpinCount(&cwe_cs, + ETHR_MUTEX_SPIN_COUNT)) + goto error; + + for (i = 1; i < ETHR_MAX_THREADS; i++) + thr_table[i] = NULL; + + if (!InitializeCriticalSectionAndSpinCount(&thr_table_cs, + ETHR_MUTEX_SPIN_COUNT)) + goto error; + if (!InitializeCriticalSectionAndSpinCount(&fake_static_init_cs, + ETHR_MUTEX_SPIN_COUNT)) + goto error; + ethr_not_inited = 0; + + err = init_common(id); + if (err) + goto error; + + return 0; + + error: + ethr_not_inited = 1; + if (err == 0) + err = get_errno(); + ASSERT(err != 0); + if (td->thr_handle != INVALID_HANDLE_VALUE) + CloseHandle(td->thr_handle); + if (td->wait_event.handle != INVALID_HANDLE_VALUE) + CloseHandle(td->wait_event.handle); + return err; +} + +/* + * Thread functions. + */ + +int +ethr_thr_create(ethr_tid *tid, void * (*func)(void *), void *arg, + ethr_thr_opts *opts) +{ + int err = 0; + thr_wrap_data_ twd; + thr_data_ *my_td, *child_td = NULL; + ethr_tid child_tid, child_serial, child_ix; + DWORD code; + unsigned ID; + unsigned stack_size = 0; /* 0 = system default */ + int use_stack_size = (opts && opts->suggested_stack_size >= 0 + ? opts->suggested_stack_size + : -1 /* Use system default */); + +#ifdef ETHR_MODIFIED_DEFAULT_STACK_SIZE + if (use_stack_size < 0) + use_stack_size = ETHR_MODIFIED_DEFAULT_STACK_SIZE; +#endif + +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!tid || !func) { + ASSERT(0); + return EINVAL; + } +#endif + + my_td = OWN_THR_DATA; + if (!my_td) { + /* Only ethreads are allowed to call this function */ + ASSERT(0); + return EACCES; + } + + if (use_stack_size >= 0) { + size_t suggested_stack_size = (size_t) use_stack_size; +#ifdef DEBUG + suggested_stack_size /= 2; /* Make sure we got margin */ +#endif + if (suggested_stack_size < min_stack_size) + stack_size = (unsigned) ETHR_KW2B(min_stack_size); + else if (suggested_stack_size > max_stack_size) + stack_size = (unsigned) ETHR_KW2B(max_stack_size); + else + stack_size = + (unsigned) ETHR_PAGE_ALIGN(ETHR_KW2B(suggested_stack_size)); + } + + EnterCriticalSection(&thr_table_cs); + + /* Call prepare func if it exist */ + if (thread_create_prepare_func) + twd.prep_func_res = (*thread_create_prepare_func)(); + else + twd.prep_func_res = NULL; + + /* Find a new thread id to use */ + new_tid(&child_tid, &child_serial, &child_ix); + if (child_tid == INVALID_TID) { + err = EAGAIN; + goto error; + } + + ASSERT(child_ix == THR_IX(child_tid)); + + *tid = child_tid; + + ASSERT(!thr_table[child_ix]); + + /* Alloc thread data */ + thr_table[child_ix] = child_td = (thr_data_ *) (*allocp)(sizeof(thr_data_)); + if (!child_td) { + err = ENOMEM; + goto error; + } + + /* Init thread data */ + + child_td->thr_id = child_tid; + child_td->thr_handle = INVALID_HANDLE_VALUE; + child_td->joiner = INVALID_TID; + child_td->result = NULL; + /* 'child_td->wait_event' is initialized by child thread */ + + + /* Init thread wrapper data */ + + twd.func = func; + twd.arg = arg; + twd.ptd = my_td; + twd.td = child_td; + twd.res = 0; + + ASSERT(!my_td->wait_event.in_queue); + + /* spawn the thr_wrapper function */ + child_td->thr_handle = (HANDLE) _beginthreadex(NULL, + stack_size, + thr_wrapper, + (LPVOID) &twd, + 0, + &ID); + if (child_td->thr_handle == (HANDLE) 0) { + child_td->thr_handle = INVALID_HANDLE_VALUE; + goto error; + } + + ASSERT(child_td->thr_handle != INVALID_HANDLE_VALUE); + + /* Wait for child to finish initialization */ + code = WaitForSingleObject(my_td->wait_event.handle, INFINITE); + if (twd.res || code != WAIT_OBJECT_0) { + err = twd.res; + goto error; + } + + if (opts && opts->detached) { + CloseHandle(child_td->thr_handle); + child_td->thr_handle = INVALID_HANDLE_VALUE; + } + + last_serial = child_serial; + last_ix = child_ix; + + ASSERT(thr_table[child_ix] == child_td); + + if (thread_create_parent_func) + (*thread_create_parent_func)(twd.prep_func_res); + + LeaveCriticalSection(&thr_table_cs); + + return 0; + + error: + + if (err == 0) + err = get_errno(); + ASSERT(err != 0); + + if (thread_create_parent_func) + (*thread_create_parent_func)(twd.prep_func_res); + + if (child_ix != INVALID_TID) { + + if (child_td) { + ASSERT(thr_table[child_ix] == child_td); + + if (child_td->thr_handle != INVALID_HANDLE_VALUE) { + WaitForSingleObject(child_td->thr_handle, INFINITE); + CloseHandle(child_td->thr_handle); + } + + (*freep)((void *) child_td); + thr_table[child_ix] = NULL; + } + } + + *tid = INVALID_TID; + + LeaveCriticalSection(&thr_table_cs); + return err; +} + +int ethr_thr_join(ethr_tid tid, void **res) +{ + int err = 0; + DWORD code; + thr_data_ *td; + thr_data_ *my_td; + +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + + my_td = OWN_THR_DATA; + + if (!my_td) { + /* Only ethreads are allowed to call this function */ + ASSERT(0); + return EACCES; + } + + EnterCriticalSection(&thr_table_cs); + + td = tid2thr(tid); + if (!td) + err = ESRCH; + else if (td->thr_handle == INVALID_HANDLE_VALUE /* i.e. detached */ + || td->joiner != INVALID_TID) /* i.e. someone else is joining */ + err = EINVAL; + else if (my_td == td) + err = EDEADLK; + else + td->joiner = my_td->thr_id; + + LeaveCriticalSection(&thr_table_cs); + + if (err) + goto error; + + /* Wait for thread to terminate */ + code = WaitForSingleObject(td->thr_handle, INFINITE); + if (code != WAIT_OBJECT_0) + goto error; + + EnterCriticalSection(&thr_table_cs); + + ASSERT(td == tid2thr(tid)); + ASSERT(td->thr_handle != INVALID_HANDLE_VALUE); + ASSERT(td->joiner == my_td->thr_id); + + if (res) + *res = td->result; + + CloseHandle(td->thr_handle); + ASSERT(td == thr_table[THR_IX(td->thr_id)]); + thr_table[THR_IX(td->thr_id)] = NULL; + if (td != &main_thr_data) + (*freep)((void *) td); + + LeaveCriticalSection(&thr_table_cs); + + return 0; + + error: + if (err == 0) + err = get_errno(); + ASSERT(err != 0); + return err; +} + + +int +ethr_thr_detach(ethr_tid tid) +{ + int res; + DWORD code; + thr_data_ *td; + +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + + if (!OWN_THR_DATA) { + /* Only ethreads are allowed to call this function */ + ASSERT(0); + return EACCES; + } + + EnterCriticalSection(&thr_table_cs); + + td = tid2thr(tid); + if (!td) + res = ESRCH; + if (td->thr_handle == INVALID_HANDLE_VALUE /* i.e. detached */ + || td->joiner != INVALID_TID) /* i.e. someone is joining */ + res = EINVAL; + else { + res = 0; + CloseHandle(td->thr_handle); + td->thr_handle = INVALID_HANDLE_VALUE; + } + + LeaveCriticalSection(&thr_table_cs); + + return res; +} + + +void +ethr_thr_exit(void *res) +{ + thr_data_ *td; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return; + } +#endif + td = OWN_THR_DATA; + if (!td) { + /* Only ethreads are allowed to call this function */ + ASSERT(0); + return; + } + thr_exit_cleanup(td, res); + _endthreadex((unsigned) 0); +} + +ethr_tid +ethr_self(void) +{ + thr_data_ *td; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return INVALID_TID; + } +#endif + /* It is okay for non-ethreads (i.e. native win32 threads) to call + ethr_self(). They will however be returned the INVALID_TID. */ + td = OWN_THR_DATA; + if (!td) + return INVALID_TID; + return td->thr_id; +} + +int +ethr_equal_tids(ethr_tid tid1, ethr_tid tid2) +{ + /* INVALID_TID does not equal any tid, not even the INVALID_TID */ + return tid1 == tid2 && tid1 != INVALID_TID; +} + +/* + * Mutex functions. + */ + +int +ethr_mutex_init(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx) { + ASSERT(0); + return EINVAL; + } +#endif + if (!InitializeCriticalSectionAndSpinCount(&mtx->cs, ETHR_MUTEX_SPIN_COUNT)) + return get_errno(); + mtx->initialized = ETHR_MUTEX_INITIALIZED; +#if ETHR_XCHK + mtx->is_rec_mtx = 0; +#endif + return 0; +} + +int +ethr_rec_mutex_init(ethr_mutex *mtx) +{ + int res; + res = ethr_mutex_init(mtx); +#if ETHR_XCHK + mtx->is_rec_mtx = 1; +#endif + return res; +} + +int +ethr_mutex_destroy(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + DeleteCriticalSection(&mtx->cs); + mtx->initialized = 0; + return 0; +} + +int ethr_mutex_set_forksafe(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + return 0; /* No fork() */ +} + +int ethr_mutex_unset_forksafe(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + return 0; /* No fork() */ +} + +int +ethr_mutex_trylock(ethr_mutex *mtx) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx + || (mtx->initialized && mtx->initialized != ETHR_MUTEX_INITIALIZED)) { + ASSERT(0); + return EINVAL; + } +#endif + if (!mtx->initialized) { + int res = ethr_fake_static_mutex_init(mtx); + if (res != 0) + return res; + } + return ethr_mutex_trylock__(mtx); +} + +int +ethr_mutex_lock(ethr_mutex *mtx) +{ + int res; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx + || (mtx->initialized && mtx->initialized != ETHR_MUTEX_INITIALIZED)) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_mutex_lock__(mtx); +} + +int +ethr_mutex_unlock(ethr_mutex *mtx) +{ +#if ETHR_XCHK + int res; + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!mtx || mtx->initialized != ETHR_MUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_mutex_unlock__(mtx); +} + +/* + * Condition variable functions. + */ + +int +ethr_cond_init(ethr_cond *cnd) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd) { + ASSERT(0); + return EINVAL; + } +#endif + if (!InitializeCriticalSectionAndSpinCount(&cnd->cs, ETHR_COND_SPIN_COUNT)) + return get_errno(); + cnd->queue = NULL; + cnd->queue_end = NULL; + cnd->initialized = ETHR_COND_INITIALIZED; + return 0; +} + +int +ethr_cond_destroy(ethr_cond *cnd) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd + || (cnd->initialized && cnd->initialized != ETHR_COND_INITIALIZED) + || cnd->queue) { + ASSERT(0); + return EINVAL; + } +#endif + DeleteCriticalSection(&cnd->cs); + cnd->initialized = 0; + return 0; +} + +int +ethr_cond_signal(ethr_cond *cnd) +{ + cnd_wait_event_ *cwe; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd + || (cnd->initialized && cnd->initialized != ETHR_COND_INITIALIZED)) { + ASSERT(0); + return EINVAL; + } +#endif + if (!cnd->initialized) { + int res = fake_static_cond_init(cnd); + if (res != 0) + return res; + } + EnterCriticalSection(&cnd->cs); + cwe = cnd->queue; + if (cwe) { + ASSERT(cwe->in_queue); + SetEvent(cnd->queue->handle); + if (cwe->next) + cwe->next->prev = NULL; + else { + ASSERT(cnd->queue_end == cnd->queue); + cnd->queue_end = NULL; + } + cnd->queue = cwe->next; + cwe->in_queue = 0; + } + LeaveCriticalSection(&cnd->cs); + return 0; +} + +int +ethr_cond_broadcast(ethr_cond *cnd) +{ + cnd_wait_event_ *cwe; + +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!cnd + || (cnd->initialized && cnd->initialized != ETHR_COND_INITIALIZED)) { + ASSERT(0); + return EINVAL; + } +#endif + if (!cnd->initialized) { + int res = fake_static_cond_init(cnd); + if (res != 0) + return res; + } + EnterCriticalSection(&cnd->cs); + for (cwe = cnd->queue; cwe; cwe = cwe->next) { + ASSERT(cwe->in_queue); + SetEvent(cwe->handle); + cwe->in_queue = 0; + } + cnd->queue = NULL; + cnd->queue_end = NULL; + LeaveCriticalSection(&cnd->cs); + return 0; + +} + +int +ethr_cond_wait(ethr_cond *cnd, ethr_mutex *mtx) +{ + return condwait(cnd, mtx, 0, NULL); +} + +int +ethr_cond_timedwait(ethr_cond *cnd, ethr_mutex *mtx, ethr_timeval *timeout) +{ + return condwait(cnd, mtx, 1, timeout); +} + +int +ethr_time_now(ethr_timeval *time) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!time) { + ASSERT(0); + return EINVAL; + } +#endif + get_curr_time(&time->tv_sec, &time->tv_nsec); + return 0; +} + +/* + * Thread specific data + */ + +int +ethr_tsd_key_create(ethr_tsd_key *keyp) +{ + DWORD key; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!keyp) { + ASSERT(0); + return EINVAL; + } +#endif + key = TlsAlloc(); + if (key == TLS_OUT_OF_INDEXES) + return get_errno(); + *keyp = (ethr_tsd_key) key; + return 0; +} + +int +ethr_tsd_key_delete(ethr_tsd_key key) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + if (!TlsFree((DWORD) key)) + return get_errno(); + return 0; +} + +int +ethr_tsd_set(ethr_tsd_key key, void *value) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } +#endif + if (!TlsSetValue((DWORD) key, (LPVOID) value)) + return get_errno(); + return 0; +} + +void * +ethr_tsd_get(ethr_tsd_key key) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return NULL; + } +#endif + return (void *) TlsGetValue((DWORD) key); +} + +/* Misc */ + +#ifndef ETHR_HAVE_OPTIMIZED_LOCKS + +int +ethr_do_spinlock_init(ethr_spinlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + if (InitializeCriticalSectionAndSpinCount(&lock->cs, INT_MAX)) + return 0; + else + return get_errno(); +} + +int +ethr_do_rwlock_init(ethr_rwlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + lock->counter = 0; + if (InitializeCriticalSectionAndSpinCount(&lock->cs, INT_MAX)) + return 0; + else + return get_errno(); +} + +#endif /* #ifndef ETHR_HAVE_OPTIMIZED_ATOMIC_OPS */ + +#else +#error "Missing thread implementation" +#endif + +/* Atomics */ + +int +ethr_atomic_init(ethr_atomic_t *var, long i) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_init__(var, i); +} + +int +ethr_atomic_set(ethr_atomic_t *var, long i) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_set__(var, i); +} + +int +ethr_atomic_read(ethr_atomic_t *var, long *i) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var || !i) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_read__(var, i); +} + + +int +ethr_atomic_addtest(ethr_atomic_t *var, long incr, long *testp) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var || !testp) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_addtest__(var, incr, testp); +} + +int +ethr_atomic_inctest(ethr_atomic_t *incp, long *testp) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!incp || !testp) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_inctest__(incp, testp); +} + +int +ethr_atomic_dectest(ethr_atomic_t *decp, long *testp) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!decp || !testp) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_dectest__(decp, testp); +} + +int +ethr_atomic_add(ethr_atomic_t *var, long incr) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_add__(var, incr); +} + +int +ethr_atomic_inc(ethr_atomic_t *incp) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!incp) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_inc__(incp); +} + +int +ethr_atomic_dec(ethr_atomic_t *decp) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!decp) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_dec__(decp); +} + +int +ethr_atomic_and_old(ethr_atomic_t *var, long mask, long *old) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var || !old) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_and_old__(var, mask, old); +} + +int +ethr_atomic_or_old(ethr_atomic_t *var, long mask, long *old) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var || !old) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_or_old__(var, mask, old); +} + +int +ethr_atomic_xchg(ethr_atomic_t *var, long new, long *old) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var || !old) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_xchg__(var, new, old); +} + +int +ethr_atomic_cmpxchg(ethr_atomic_t *var, long new, long expected, long *old) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!var || !old) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_atomic_cmpxchg__(var, new, expected, old); +} + +/* Spinlocks and rwspinlocks */ + +int +ethr_spinlock_init(ethr_spinlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_spinlock_init__(lock); +} + +int +ethr_spinlock_destroy(ethr_spinlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_spinlock_destroy__(lock); +} + + +int +ethr_spin_unlock(ethr_spinlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_spin_unlock__(lock); +} + +int +ethr_spin_lock(ethr_spinlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_spin_lock__(lock); +} + +int +ethr_rwlock_init(ethr_rwlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_rwlock_init__(lock); +} + +int +ethr_rwlock_destroy(ethr_rwlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_rwlock_destroy__(lock); +} + +int +ethr_read_unlock(ethr_rwlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_read_unlock__(lock); +} + +int +ethr_read_lock(ethr_rwlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_read_lock__(lock); +} + +int +ethr_write_unlock(ethr_rwlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_write_unlock__(lock); +} + +int +ethr_write_lock(ethr_rwlock_t *lock) +{ +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!lock) { + ASSERT(0); + return EINVAL; + } +#endif + return ethr_write_lock__(lock); +} + + +int +ethr_gate_init(ethr_gate *gp) +{ + int res; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!gp) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_init(&gp->mtx); + if (res != 0) + return res; + res = ethr_cond_init(&gp->cnd); + if (res != 0) { + ethr_mutex_destroy(&gp->mtx); + return res; + } + gp->open = 0; + return 0; +} + +int +ethr_gate_destroy(ethr_gate *gp) +{ + int res, dres; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!gp) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_destroy(&gp->mtx); + dres = ethr_cond_destroy(&gp->cnd); + if (res == 0) + res = dres; + gp->open = 0; + return res; +} + +int +ethr_gate_close(ethr_gate *gp) +{ + int res; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!gp) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_lock__(&gp->mtx); + if (res != 0) + return res; + gp->open = 0; + res = ethr_mutex_unlock__(&gp->mtx); + return res; +} + +int +ethr_gate_let_through(ethr_gate *gp, unsigned no) +{ + int res, ures; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!gp) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_lock__(&gp->mtx); + if (res != 0) + return res; + gp->open += no; + res = (gp->open == 1 + ? ethr_cond_signal(&gp->cnd) + : ethr_cond_broadcast(&gp->cnd)); + ures = ethr_mutex_unlock__(&gp->mtx); + if (res != 0) + res = ures; + return res; +} + +int +ethr_gate_swait(ethr_gate *gp, int spincount) +{ + int res, ures, n; +#if ETHR_XCHK + if (ethr_not_inited) { + ASSERT(0); + return EACCES; + } + if (!gp) { + ASSERT(0); + return EINVAL; + } +#endif + n = spincount; + res = ethr_mutex_lock__(&gp->mtx); + if (res != 0) + return res; + while (n >= 0 && !gp->open) { + res = ethr_mutex_unlock__(&gp->mtx); + if (res != 0) + return res; + res = ethr_mutex_lock__(&gp->mtx); + if (res != 0) + return res; + n--; + } + while (!gp->open) { + res = ethr_cond_wait(&gp->cnd, &gp->mtx); + if (res != 0 && res != EINTR) + goto done; + } + gp->open--; + done: + ures = ethr_mutex_unlock__(&gp->mtx); + if (res == 0) + res = ures; + return res; +} + + +int +ethr_gate_wait(ethr_gate *gp) +{ + return ethr_gate_swait(gp, 0); +} + + +/* rwmutex fallback */ +#ifdef ETHR_USE_RWMTX_FALLBACK + +int +ethr_rwmutex_init(ethr_rwmutex *rwmtx) +{ + int res; +#if ETHR_XCHK + if (!rwmtx) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_init(&rwmtx->mtx); + if (res != 0) + return res; + ethr_cond_init(&rwmtx->rcnd); + if (res != 0) + goto error_cleanup1; + res = ethr_cond_init(&rwmtx->wcnd); + if (res != 0) + goto error_cleanup2; + rwmtx->readers = 0; + rwmtx->waiting_readers = 0; + rwmtx->waiting_writers = 0; +#if ETHR_XCHK + rwmtx->initialized = ETHR_RWMUTEX_INITIALIZED; +#endif + return 0; + error_cleanup2: + ethr_cond_destroy(&rwmtx->rcnd); + error_cleanup1: + ethr_mutex_destroy(&rwmtx->mtx); + return res; +} + +int +ethr_rwmutex_destroy(ethr_rwmutex *rwmtx) +{ + int res, pres; +#if ETHR_XCHK + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } + rwmtx->initialized = 0; +#endif + res = ethr_mutex_destroy(&rwmtx->mtx); + pres = ethr_cond_destroy(&rwmtx->rcnd); + if (res == 0) + res = pres; + pres = ethr_cond_destroy(&rwmtx->wcnd); + if (res == 0) + res = pres; + return res; +} + +int +ethr_rwmutex_tryrlock(ethr_rwmutex *rwmtx) +{ + int res; +#if ETHR_XCHK + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_trylock__(&rwmtx->mtx); + if (res != 0) + return res; + if (!rwmtx->waiting_writers) { + res = ethr_mutex_unlock__(&rwmtx->mtx); + if (res == 0) + return EBUSY; + return res; + } + rwmtx->readers++; + return ethr_mutex_unlock__(&rwmtx->mtx); +} + +int +ethr_rwmutex_rlock(ethr_rwmutex *rwmtx) +{ + int res; +#if ETHR_XCHK + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_lock__(&rwmtx->mtx); + if (res != 0) + return res; + while (rwmtx->waiting_writers) { + rwmtx->waiting_readers++; + res = ethr_cond_wait(&rwmtx->rcnd, &rwmtx->mtx); + rwmtx->waiting_readers--; + if (res != 0 && res != EINTR) { + (void) ethr_mutex_unlock__(&rwmtx->mtx); + return res; + } + } + rwmtx->readers++; + return ethr_mutex_unlock__(&rwmtx->mtx); +} + +int +ethr_rwmutex_runlock(ethr_rwmutex *rwmtx) +{ + int res, ures; +#if ETHR_XCHK + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_lock__(&rwmtx->mtx); + if (res != 0) + return res; + rwmtx->readers--; + if (!rwmtx->readers && rwmtx->waiting_writers) + res = ethr_cond_signal(&rwmtx->wcnd); + ures = ethr_mutex_unlock__(&rwmtx->mtx); + if (res == 0) + res = ures; + return res; +} + +int +ethr_rwmutex_tryrwlock(ethr_rwmutex *rwmtx) +{ + int res; +#if ETHR_XCHK + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_trylock__(&rwmtx->mtx); + if (res != 0) + return res; + if (!rwmtx->readers && !rwmtx->waiting_writers) + return 0; + else { + res = ethr_mutex_unlock__(&rwmtx->mtx); + if (res == 0) + return EBUSY; + return res; + } +} + +int +ethr_rwmutex_rwlock(ethr_rwmutex *rwmtx) +{ + int res; +#if ETHR_XCHK + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + res = ethr_mutex_lock__(&rwmtx->mtx); + if (res != 0) + return res; + if (!rwmtx->readers && !rwmtx->waiting_writers) + return 0; + + while (rwmtx->readers) { + rwmtx->waiting_writers++; + res = ethr_cond_wait(&rwmtx->wcnd, &rwmtx->mtx); + rwmtx->waiting_writers--; + if (res != 0 && res != EINTR) { + (void) ethr_rwmutex_rwunlock(rwmtx); + return res; + } + } + return 0; +} + +int +ethr_rwmutex_rwunlock(ethr_rwmutex *rwmtx) +{ + int res, ures; +#if ETHR_XCHK + if (!rwmtx || rwmtx->initialized != ETHR_RWMUTEX_INITIALIZED) { + ASSERT(0); + return EINVAL; + } +#endif + res = 0; + if (rwmtx->waiting_writers) + res = ethr_cond_signal(&rwmtx->wcnd); + else if (rwmtx->waiting_readers) + res = ethr_cond_broadcast(&rwmtx->rcnd); + ures = ethr_mutex_unlock__(&rwmtx->mtx); + if (res == 0) + res = ures; + return res; +} + +#endif /* #ifdef ETHR_USE_RWMTX_FALLBACK */ + +void +ethr_compiler_barrier(void) +{ + +} + +#ifdef DEBUG + +#include +int ethr_assert_failed(char *f, int l, char *a) +{ + fprintf(stderr, "%s:%d: Assertion failed: %s\n", f, l, a); + abort(); + return 0; +} + +#endif + + diff --git a/erts/man/.gitignore b/erts/man/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/ntbuild.erl b/erts/ntbuild.erl new file mode 100644 index 0000000000..e48be58c17 --- /dev/null +++ b/erts/ntbuild.erl @@ -0,0 +1,332 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% To be used from makefiles on the unix side executing things on the NT-side +-module(ntbuild). + +-export([nmake/1, omake/1, waitnode/1, restart/1, + setdir/1, run_tests/1, run_command/1]). +-export([serv_nmake/2, serv_omake/2, serv_restart/0, serv_run_tests/2, + serv_run_command/1]). + +waitnode([NtNode]) -> + % First, wait for node to disappear. + case wait_disappear(NtNode, 0) of + ok -> + case wait_appear(NtNode, 0) of + ok -> + halt(0); + fail -> + halt(1) + end; + fail -> + halt(1) + end. + +% Wait for nt node to appear within 5 minutes. +wait_appear(_NtNode, 300) -> + fail; +wait_appear(NtNode, N) -> + receive after 1000 -> ok end, + case nt_node_alive(NtNode, quiet) of + no -> + wait_appear(NtNode, N+1); + yes -> + ok + end. + + + +% Waits for nt node to disappear within 3 minutes. +wait_disappear(NtNode, 300) -> + fail; +wait_disappear(NtNode, N) -> + receive after 1000 -> ok end, + case nt_node_alive(NtNode, quiet) of + yes -> + wait_disappear(NtNode, N+1); + no -> + ok + end. + +restart([NtNode]) -> + case nt_node_alive(NtNode) of + yes -> + case rpc:call(NtNode, ntbuild, serv_restart, []) of + ok -> + io:format("halt(0)~n"), + halt(); + Error -> + io:format("halt(1)~n"), + halt(1) + end; + no -> + halt(1) + end. + + +setdir([NtNode, Dir0]) -> + Dir = atom_to_list(Dir0), + case nt_node_alive(NtNode) of + yes -> + case rpc:call(NtNode, file, set_cwd, [Dir]) of + ok -> + io:format("halt(0)~n"), + halt(); + Error -> + io:format("halt(1) (Error: ~p) (~p not found) ~n", [Error, Dir]), + halt(1) + end; + no -> + halt(1) + end. + +run_tests([NtNode, Vsn0, Logdir]) -> + Vsn = atom_to_list(Vsn0), + case nt_node_alive(NtNode) of + yes -> + case rpc:call(NtNode, ntbuild, serv_run_tests, [Vsn, Logdir]) of + ok -> + io:format("halt(0)~n"), + halt(); + Error -> + io:format("RPC To Windows Node Failed: ~p~n", [Error]), + io:format("halt(1)~n"), + halt(1) + end; + no -> + halt(1) + end. + +run_command([NtNode, Cmd]) -> + case nt_node_alive(NtNode) of + yes -> + case rpc:call(NtNode, ntbuild, serv_run_command, [Cmd]) of + ok -> + io:format("halt(0)~n"), + halt(); + Error -> + io:format("RPC To Windows Node Failed: ~p~n", [Error]), + io:format("halt(1)~n"), + halt(1) + end; + no -> + halt(1) + end. + +nmake([NtNode, Path, Options]) -> +% io:format("nmake2(~w,~w)~n",[Path, Options]), + Dir=atom_to_list(Path), + Opt=atom_to_list(Options), + case nt_node_alive(NtNode) of + yes -> + case rpc:call(NtNode, ntbuild, serv_nmake, [Dir, Opt]) of + ok -> + io:format("halt(0)~n"), + halt(); + Error -> + io:format("Error: ~n", [Error]), + halt(1) + end; + no -> + halt(1) + end. + +omake([NtNode, Path, Options]) -> + Dir=atom_to_list(Path), + Opt=atom_to_list(Options), + case nt_node_alive(NtNode) of + yes -> + case rpc:call(NtNode, ntbuild, serv_omake, [Dir, Opt]) of + ok -> + io:format("halt(0)~n"), + halt(); + Error -> + io:format("RPC To Windows Node Failed: ~p~n", [Error]), + io:format("~p ~p~n", [Dir, Opt]), + io:format("halt(1)~n"), + halt(1) + end; + no -> + halt(1) + end. + + + + + +nt_node_alive(NtNode) -> + case net:ping(NtNode) of + pong -> + yes; + pang -> + io:format("The NT node (~p) is not up. ~n",[NtNode]), + no + end. + +nt_node_alive(NtNode, quiet) -> + case net:ping(NtNode) of + pong -> + yes; + pang -> + no + end. + + + +%%% +%%% The 'serv_' functions. Theese are the routines run on the WinNT node. +%%% + +%%----------------------- +%% serv_run_tests() +%% Runs the tests. +serv_run_tests(Vsn, Logdir) -> + {ok, Cwd}=file:get_cwd(), + io:format("serv_run_tests ~p ~p ~n", [Vsn, Logdir]), + Cmd0= "set central_log_dir=" ++ Logdir, + Erl = "C:/progra~1/erl"++Vsn++"/bin/erl", + Cmd1 = Erl++" -sname a -setcookie a -noshell -noinput -s ts install -s ts run -s ts save -s erlang halt", +%% Dir = "C:/temp/test_suite/test_server", + Cmd= Cmd0 ++ "/r/n" ++ Cmd1, + Dir = "C:/temp/test_server/p7a/test_server", + file:set_cwd(Dir), + Res=run_make_bat(Dir, Cmd), + file:set_cwd(Cwd), + Res. + +%%----------------------- +%% serv_run_command() +%% Runs a command. +serv_run_command(Cmd) -> + {ok, Cwd}=file:get_cwd(), + Res=run_make_bat("", Cmd), + file:set_cwd(Cwd), + Res. + +%%----------------------- +%% serv_restart() +%% Reboots the NT machine. +serv_restart() -> + Exe="\\erts\\install_nt\\reboot.exe", + open_port({spawn, Exe}, [stream, eof, in]), + ok. + + +%%----------------------- +%% serv_nmake(Path, Options) +%% Runs `nmake' in the given directory. +%% Result: ok | error +serv_nmake(Path, Options) -> + {ok, Cwd}=file:get_cwd(), + Command="nmake -e -f Makefile.win32 " ++ Options ++ " 2>&1", + Res=run_make_bat(Path, Command), + file:set_cwd(Cwd), + Res. + +%%----------------------- +%% serv_omake(Path, Options) +%% Runs `omake' in the given directory. +%% Result: ok | error +serv_omake(Path, Options) -> + {ok, Cwd}=file:get_cwd(), + Command="omake -W -E -EN -f Makefile.win32 " ++ Options ++ " 2>&1", + Res=run_make_bat(Path, Command), + file:set_cwd(Cwd), + Res. + + +read_output(Port, SoFar) -> +% io:format("(read_output)~n"), + case get_data_from_port(Port) of + eof -> + io:format("*** eof ***~n"), + io:format("Never reached a real message"), + halt(1); + {ok, Data} -> + case print_line([SoFar|Data]) of + {ok, Rest} -> + read_output(Port, Rest); + {done, Res} -> + Res + end + end. + +print_line(Data) -> + print_line(Data, []). + +print_line([], Acc) -> + {ok, lists:reverse(Acc)}; +print_line([$*,$o,$k,$*|Rest], _Acc) -> + io:format("*ok*~n"), + {done, ok}; +print_line([$*,$e,$r,$r,$o,$r|Rest], _Acc) -> + io:format("*error*~n"), + {done, error}; +print_line([$\r,$\n|Rest], Acc) -> + io:format("~s~n", [lists:reverse(Acc)]), + print_line(Rest, []); +print_line([Chr|Rest], Acc) -> + print_line(Rest, [Chr|Acc]). + +get_data_from_port(Port) -> + receive + {Port, {data, Bytes}} -> + {ok, Bytes}; + {Port, eof} -> + unlink(Port), + exit(Port, die), + eof; + Other -> + io:format("Strange message received: ~p~n", [Other]), + get_data_from_port(Port) + end. + + +run_make_bat(Dir, Make) -> + {Name, Exe, Script}=create_make_script(Dir, Make), + io:format("Exe:~p Cwd:~p Script:~p ~n",[Exe, Dir, Script]), + case file:write_file(Name, Script) of + ok -> + case catch open_port({spawn, Exe}, [stderr_to_stdout, stream, hide, + eof, in]) of + Port when port(Port) -> + read_output(Port, []); + Other -> + io:format("Error, open_port failed: ~p~n", [Other]), + {open_port, Other, Exe} + end; + Error -> + {write_file, Error, Name} + end. + +create_make_script(Dir, Make) when atom(Make) -> + create_make_script(Dir, atom_to_list(Make)); +create_make_script(Dir, Make) -> + {"run_make_bs.bat", + "run_make_bs 2>&1", + ["@echo off\r\n", + "@cd ", Dir, "\r\n", + Make++"\r\n", + "if errorlevel 1 echo *run_make_bs error*\r\n", + "if not errorlevel 1 echo *ok*\r\n"]}. + + + + + diff --git a/erts/obj.debug/.gitignore b/erts/obj.debug/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/obj/.gitignore b/erts/obj/.gitignore new file mode 100644 index 0000000000..e69de29bb2 diff --git a/erts/prebuild.skip b/erts/prebuild.skip new file mode 100644 index 0000000000..9c558e357c --- /dev/null +++ b/erts/prebuild.skip @@ -0,0 +1 @@ +. diff --git a/erts/preloaded/Makefile b/erts/preloaded/Makefile new file mode 100644 index 0000000000..4235a7fe57 --- /dev/null +++ b/erts/preloaded/Makefile @@ -0,0 +1,25 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2008-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk + + +SUB_DIRECTORIES = src + +include $(ERL_TOP)/make/otp_subdir.mk + diff --git a/erts/preloaded/ebin/erl_prim_loader.beam b/erts/preloaded/ebin/erl_prim_loader.beam new file mode 100644 index 0000000000..a031c90188 Binary files /dev/null and b/erts/preloaded/ebin/erl_prim_loader.beam differ diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam new file mode 100644 index 0000000000..39452f53d6 Binary files /dev/null and b/erts/preloaded/ebin/erlang.beam differ diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam new file mode 100644 index 0000000000..7b6bafd1af Binary files /dev/null and b/erts/preloaded/ebin/init.beam differ diff --git a/erts/preloaded/ebin/otp_ring0.beam b/erts/preloaded/ebin/otp_ring0.beam new file mode 100644 index 0000000000..af44a8c9b9 Binary files /dev/null and b/erts/preloaded/ebin/otp_ring0.beam differ diff --git a/erts/preloaded/ebin/prim_file.beam b/erts/preloaded/ebin/prim_file.beam new file mode 100644 index 0000000000..9391aa45cd Binary files /dev/null and b/erts/preloaded/ebin/prim_file.beam differ diff --git a/erts/preloaded/ebin/prim_inet.beam b/erts/preloaded/ebin/prim_inet.beam new file mode 100644 index 0000000000..b7be06e6bc Binary files /dev/null and b/erts/preloaded/ebin/prim_inet.beam differ diff --git a/erts/preloaded/ebin/prim_zip.beam b/erts/preloaded/ebin/prim_zip.beam new file mode 100644 index 0000000000..6e1230d649 Binary files /dev/null and b/erts/preloaded/ebin/prim_zip.beam differ diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam new file mode 100644 index 0000000000..4d9996cc74 Binary files /dev/null and b/erts/preloaded/ebin/zlib.beam differ diff --git a/erts/preloaded/src/Makefile b/erts/preloaded/src/Makefile new file mode 100644 index 0000000000..785ad531f3 --- /dev/null +++ b/erts/preloaded/src/Makefile @@ -0,0 +1,105 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2008-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +# Note, this makefile is not called during normal build process, it should +# be used when the preloaded modules actually are to be updated (i.e. the +# beam files are to be recompiled, which is normally not done). +# The beam files are placed in the current directory and should be copied +# to the ../ebin directory by using the commit target (only works in +# clearcase). + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +EBIN=. + +STATIC_EBIN=../ebin + +include $(ERL_TOP)/erts/vsn.mk +include $(ERL_TOP)/lib/kernel/vsn.mk + +PRE_LOADED_MODULES = \ + erl_prim_loader \ + init \ + prim_file \ + prim_inet \ + zlib \ + prim_zip \ + otp_ring0 \ + erlang + +RELSYSDIR = $(RELEASE_PATH)/lib/erts-$(VSN) +# not $(RELEASE_PATH)/erts-$(VSN)/preloaded + +ERL_FILES= $(PRE_LOADED_MODULES:%=%.erl) + +TARGET_FILES = $(PRE_LOADED_MODULES:%=$(EBIN)/%.$(EMULATOR)) +STATIC_TARGET_FILES = $(PRE_LOADED_MODULES:%=$(STATIC_EBIN)/%.$(EMULATOR)) + +KERNEL_SRC=$(ERL_TOP)/lib/kernel/src +KERNEL_INCLUDE=$(ERL_TOP)/lib/kernel/include +STDLIB_INCLUDE=$(ERL_TOP)/lib/stdlib/include + +ERL_COMPILE_FLAGS += +warn_obsolete_guard -I$(KERNEL_SRC) -I$(KERNEL_INCLUDE) + +debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + +prepare: + cleartool co -nc $(STATIC_EBIN)/* + cleartool co -nc $(STATIC_EBIN) + +copy: + for x in *.beam; do\ + if test '!' -f $(STATIC_EBIN)/$$x; then\ + cleartool mkelem -nc $$x;\ + fi;\ + done + cp *.beam $(STATIC_EBIN) + +commit: + cleartool ci -ident -nc $(STATIC_EBIN)/*.beam + cleartool ci -ident -nc $(STATIC_EBIN) + +cancel: + -cleartool unco -rm $(STATIC_EBIN) + -cleartool unco -rm $(STATIC_EBIN)/*.beam + + +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(STATIC_TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: + + +list_preloaded: + @echo $(PRE_LOADED_MODULES) + +# Include dependencies -- list below added by PaN +$(EBIN)/erl_prim_loader.beam: $(KERNEL_SRC)/inet_boot.hrl $(KERNEL_INCLUDE)/file.hrl +$(EBIN)/prim_file.beam: $(KERNEL_INCLUDE)/file.hrl +$(EBIN)/prim_inet.beam: $(KERNEL_SRC)/inet_int.hrl $(KERNEL_INCLUDE)/inet_sctp.hrl +$(EBIN)/prim_zip.beam: zip_internal.hrl $(KERNEL_INCLUDE)/file.hrl $(STDLIB_INCLUDE)/zip.hrl +$(EBIN)/init.erl: $(KERNEL_INCLUDE)/file.hrl diff --git a/erts/preloaded/src/erl_prim_loader.erl b/erts/preloaded/src/erl_prim_loader.erl new file mode 100644 index 0000000000..399c2bb55d --- /dev/null +++ b/erts/preloaded/src/erl_prim_loader.erl @@ -0,0 +1,1406 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% A primary loader, provides two different methods to fetch a file: +%% efile and inet. The efile method is simple communication with a +%% port program. +%% +%% The distribution loading was removed and replaced with +%% inet loading +%% +%% The start_it/4 function initializes a record with callback +%% functions used to handle the interface functions. +%% + +-module(erl_prim_loader). + +%% If the macro DEBUG is defined during compilation, +%% debug printouts are done through erlang:display/1. +%% Activate this feature by starting the compiler +%% with> erlc -DDEBUG ... +%% or by> setenv ERL_COMPILER_FLAGS DEBUG +%% before running make (in the OTP make system) +%% (the example is for tcsh) + +-include("inet_boot.hrl"). + +%% Public +-export([start/3, set_path/1, get_path/0, get_file/1, get_files/2, + list_dir/1, read_file_info/1, get_cwd/0, get_cwd/1]). + +%% Used by erl_boot_server +-export([prim_init/0, prim_get_file/2, prim_list_dir/2, + prim_read_file_info/2, prim_get_cwd/2]). + +%% Used by escript and code +-export([set_primary_archive/2, release_archives/0]). + +%% Internal function. Exported to avoid dialyzer warnings +-export([concat/1]). + +-include_lib("kernel/include/file.hrl"). + +-type host() :: atom(). + +-record(state, + {loader :: 'efile' | 'inet', + hosts = [] :: [host()], % hosts list (to boot from) + id, % not used any more? + data, % data port etc + timeout, % idle timeout + n_timeouts, % Number of timeouts before archives are released + multi_get = false :: boolean(), + prim_state}). % state for efile code loader + +-define(IDLE_TIMEOUT, 60000). %% tear inet connection after 1 minutes +-define(N_TIMEOUTS, 6). %% release efile archive after 6 minutes + +%% Defines for inet as prim_loader +-define(INET_FAMILY, inet). +-define(INET_ADDRESS, {0,0,0,0}). + +-ifdef(DEBUG). +-define(dbg(Tag, Data), erlang:display({Tag,Data})). +-else. +-define(dbg(Tag, Data), true). +-endif. + +-define(SAFE2(Expr, State), + fun() -> + case catch Expr of + {'EXIT',XXXReason} -> {{error,XXXReason}, State}; + XXXRes -> XXXRes + end + end()). + +-record(prim_state, {debug, cache, primary_archive}). + +debug(#prim_state{debug = Deb}, Term) -> + case Deb of + false -> ok; + true -> erlang:display(Term) + end. + +%%% -------------------------------------------------------- +%%% Interface Functions. +%%% -------------------------------------------------------- + +-spec start(term(), atom() | string(), host() | [host()]) -> + {'ok', pid()} | {'error', term()}. +start(Id, Pgm, Hosts) when is_atom(Hosts) -> + start(Id, Pgm, [Hosts]); +start(Id, Pgm0, Hosts) -> + Pgm = if + is_atom(Pgm0) -> + atom_to_list(Pgm0); + true -> + Pgm0 + end, + Self = self(), + Pid = spawn_link(fun() -> start_it(Pgm, Id, Self, Hosts) end), + register(erl_prim_loader, Pid), + receive + {Pid,ok} -> + {ok,Pid}; + {'EXIT',Pid,Reason} -> + {error,Reason} + end. + +start_it("ose_inet"=Cmd, Id, Pid, Hosts) -> + %% Setup reserved port for ose_inet driver (only OSE) + case catch erlang:open_port({spawn,Cmd},[binary]) of + {'EXIT',Why} -> + ?dbg(ose_inet_port_open_fail, Why), + Why; + OseInetPort -> + ?dbg(ose_inet_port, OseInetPort), + OseInetPort + end, + start_it("inet", Id, Pid, Hosts); + +%% Hosts must be a list on form ['1.2.3.4' ...] +start_it("inet", Id, Pid, Hosts) -> + process_flag(trap_exit, true), + ?dbg(inet, {Id,Pid,Hosts}), + AL = ipv4_list(Hosts), + ?dbg(addresses, AL), + {ok,Tcp} = find_master(AL), + init_ack(Pid), + PS = prim_init(), + State = #state {loader = inet, + hosts = AL, + id = Id, + data = Tcp, + timeout = ?IDLE_TIMEOUT, + n_timeouts = ?N_TIMEOUTS, + prim_state = PS}, + loop(State, Pid, []); + +start_it("efile", Id, Pid, _Hosts) -> + process_flag(trap_exit, true), + {ok, Port} = prim_file:open([binary]), + init_ack(Pid), + MultiGet = case erlang:system_info(thread_pool_size) of + 0 -> false; + _ -> true + end, + PS = prim_init(), + State = #state {loader = efile, + id = Id, + data = Port, + timeout = infinity, + multi_get = MultiGet, + prim_state = PS}, + loop(State, Pid, []). + +init_ack(Pid) -> + Pid ! {self(),ok}, + ok. + +-spec set_path([string()]) -> 'ok'. +set_path(Paths) when is_list(Paths) -> + request({set_path,Paths}). + +-spec get_path() -> {'ok', [string()]}. +get_path() -> + request({get_path,[]}). + +-spec get_file(atom() | string()) -> {'ok', binary(), string()} | 'error'. +get_file(File) when is_atom(File) -> + get_file(atom_to_list(File)); +get_file(File) -> + check_file_result(get_file, File, request({get_file,File})). + +-spec get_files([{atom(), string()}], + fun((atom(),binary(),string()) -> 'ok' | {'error', atom()})) -> + 'ok' | {'error', atom()}. +get_files(ModFiles, Fun) -> + case request({get_files,{ModFiles,Fun}}) of + E = {error,_M} -> + E; + {error,Reason,M} -> + check_file_result(get_files, M, {error,Reason}), + {error,M}; + ok -> + ok + end. + +-spec list_dir(string()) -> {'ok', [string()]} | 'error'. +list_dir(Dir) -> + check_file_result(list_dir, Dir, request({list_dir,Dir})). + +%% -> {ok,Info} | error +-spec read_file_info(string()) -> {'ok', tuple()} | 'error'. + +read_file_info(File) -> + check_file_result(read_file_info, File, request({read_file_info,File})). + +-spec get_cwd() -> {'ok', string()} | 'error'. +get_cwd() -> + check_file_result(get_cwd, [], request({get_cwd,[]})). + +-spec get_cwd(string()) -> {'ok', string()} | 'error'. +get_cwd(Drive) -> + check_file_result(get_cwd, Drive, request({get_cwd,[Drive]})). + +-spec set_primary_archive(File :: string() | 'undefined', + ArchiveBin :: binary() | 'undefined') + -> {ok, [string()]} | {error,_}. + +set_primary_archive(undefined, undefined) -> + request({set_primary_archive, undefined, undefined}); +set_primary_archive(File, ArchiveBin) + when is_list(File), is_binary(ArchiveBin) -> + request({set_primary_archive, File, ArchiveBin}). + +-spec release_archives() -> 'ok' | {'error', _}. + +release_archives() -> + request(release_archives). + +request(Req) -> + Loader = whereis(erl_prim_loader), + Loader ! {self(),Req}, + receive + {Loader,Res} -> + Res; + {'EXIT',Loader,_What} -> + error + end. + +check_file_result(_, _, {error,enoent}) -> + error; +check_file_result(_, _, {error,enotdir}) -> + error; +check_file_result(Func, Target, {error,Reason}) -> + case (catch atom_to_list(Reason)) of + {'EXIT',_} -> % exit trapped + error; + Errno -> % errno + Process = case process_info(self(), registered_name) of + {registered_name,R} -> + "Process: " ++ atom_to_list(R) ++ "."; + _ -> + "" + end, + TargetStr = + if is_atom(Target) -> atom_to_list(Target); + is_list(Target) -> Target; + true -> [] + end, + Report = + case TargetStr of + [] -> + "File operation error: " ++ Errno ++ ". " ++ + "Function: " ++ atom_to_list(Func) ++ ". " ++ Process; + _ -> + "File operation error: " ++ Errno ++ ". " ++ + "Target: " ++ TargetStr ++ ". " ++ + "Function: " ++ atom_to_list(Func) ++ ". " ++ Process + end, + %% this is equal to calling error_logger:error_report/1 which + %% we don't want to do from code_server during system boot + error_logger ! {notify,{error_report,group_leader(), + {self(),std_error,Report}}}, + error + end; +check_file_result(_, _, Other) -> + Other. + +%%% -------------------------------------------------------- +%%% The main loop. +%%% -------------------------------------------------------- + +loop(State, Parent, Paths) -> + receive + {Pid,Req} when is_pid(Pid) -> + %% erlang:display(Req), + {Resp,State2,Paths2} = + case Req of + {set_path,NewPaths} -> + {ok,State,to_strs(NewPaths)}; + {get_path,_} -> + {{ok,Paths},State,Paths}; + {get_file,File} -> + {Res,State1} = handle_get_file(State, Paths, File), + {Res,State1,Paths}; + {get_files,{ModFiles,Fun}} -> + {Res,State1} = handle_get_files(State, ModFiles, Paths, Fun), + {Res,State1,Paths}; + {list_dir,Dir} -> + {Res,State1} = handle_list_dir(State, Dir), + {Res,State1,Paths}; + {read_file_info,File} -> + {Res,State1} = handle_read_file_info(State, File), + {Res,State1,Paths}; + {get_cwd,[]} -> + {Res,State1} = handle_get_cwd(State, []), + {Res,State1,Paths}; + {get_cwd,[_]=Args} -> + {Res,State1} = handle_get_cwd(State, Args), + {Res,State1,Paths}; + {set_primary_archive,File,Bin} -> + {Res,State1} = handle_set_primary_archive(State, File, Bin), + {Res,State1,Paths}; + release_archives -> + {Res,State1} = handle_release_archives(State), + {Res,State1,Paths}; + _Other -> + {ignore,State,Paths} + end, + if Resp =:= ignore -> ok; + true -> Pid ! {self(),Resp} + end, + if + is_record(State2, state) -> + loop(State2, Parent, Paths2); + true -> + exit({bad_state, Req, State2}) + end; + {'EXIT',Parent,W} -> + handle_stop(State), + exit(W); + {'EXIT',P,W} -> + State1 = handle_exit(State, P, W), + loop(State1, Parent, Paths); + _Message -> + loop(State, Parent, Paths) + after State#state.timeout -> + State1 = handle_timeout(State, Parent), + loop(State1, Parent, Paths) + end. + +handle_get_files(State = #state{multi_get = true}, ModFiles, Paths, Fun) -> + ?SAFE2(efile_multi_get_file_from_port(State, ModFiles, Paths, Fun), State); +handle_get_files(State, _ModFiles, _Paths, _Fun) -> % no multi get + {{error,no_multi_get},State}. + +handle_get_file(State = #state{loader = efile}, Paths, File) -> + ?SAFE2(efile_get_file_from_port(State, File, Paths), State); +handle_get_file(State = #state{loader = inet}, Paths, File) -> + ?SAFE2(inet_get_file_from_port(State, File, Paths), State). + +handle_set_primary_archive(State= #state{loader = efile}, File, Bin) -> + ?SAFE2(efile_set_primary_archive(State, File, Bin), State). + +handle_release_archives(State= #state{loader = efile}) -> + ?SAFE2(efile_release_archives(State), State). + +handle_list_dir(State = #state{loader = efile}, Dir) -> + ?SAFE2(efile_list_dir(State, Dir), State); +handle_list_dir(State = #state{loader = inet}, Dir) -> + ?SAFE2(inet_list_dir(State, Dir), State). + +handle_read_file_info(State = #state{loader = efile}, File) -> + ?SAFE2(efile_read_file_info(State, File), State); +handle_read_file_info(State = #state{loader = inet}, File) -> + ?SAFE2(inet_read_file_info(State, File), State). + +handle_get_cwd(State = #state{loader = efile}, Drive) -> + ?SAFE2(efile_get_cwd(State, Drive), State); +handle_get_cwd(State = #state{loader = inet}, Drive) -> + ?SAFE2(inet_get_cwd(State, Drive), State). + +handle_stop(State = #state{loader = efile}) -> + efile_stop_port(State); +handle_stop(State = #state{loader = inet}) -> + inet_stop_port(State). + +handle_exit(State = #state{loader = efile}, Who, Reason) -> + efile_exit_port(State, Who, Reason); +handle_exit(State = #state{loader = inet}, Who, Reason) -> + inet_exit_port(State, Who, Reason). + +handle_timeout(State = #state{loader = efile}, Parent) -> + efile_timeout_handler(State, Parent); +handle_timeout(State = #state{loader = inet}, Parent) -> + inet_timeout_handler(State, Parent). + +%%% -------------------------------------------------------- +%%% Functions which handles efile as prim_loader (default). +%%% -------------------------------------------------------- + +%%% Reading many files in parallel is an optimization. +%%% See also comment in init.erl. + +%% -> {ok,State} | {{error,Module},State} | {{error,Reason,Module},State} +efile_multi_get_file_from_port(State, ModFiles, Paths, Fun) -> + Ref = make_ref(), + %% More than 200 processes is no gain. + Max = min(200, erlang:system_info(thread_pool_size)), + efile_multi_get_file_from_port2(ModFiles, 0, Max, State, Paths, Fun, Ref, ok). + +efile_multi_get_file_from_port2([MF | MFs], Out, Max, State, Paths, Fun, Ref, Ret) when Out < Max -> + Self = self(), + _Pid = spawn(fun() -> efile_par_get_file(Ref, State, MF, Paths, Self, Fun) end), + efile_multi_get_file_from_port2(MFs, Out+1, Max, State, Paths, Fun, Ref, Ret); +efile_multi_get_file_from_port2(MFs, Out, Max, _State, Paths, Fun, Ref, Ret) when Out > 0 -> + receive + {Ref, ok, State1} -> + efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Ret); + {Ref, {error,_Mod} = Error, State1} -> + efile_multi_get_file_from_port2(MFs, Out-1, Max, State1, Paths, Fun, Ref, Error); + {Ref, MF, {error,emfile,State1}} -> + %% Max can take negative values. Out cannot. + efile_multi_get_file_from_port2([MF | MFs], Out-1, Max-1, State1, Paths, Fun, Ref, Ret); + {Ref, {M,_F}, {error,Error,State1}} -> + efile_multi_get_file_from_port2(MFs, Out-1, 0, State1, Paths, Fun, Ref, {error,Error,M}) + end; +efile_multi_get_file_from_port2(_MFs, 0, _Max, State, _Paths, _Fun, _Ref, Ret) -> + {Ret,State}. + +efile_par_get_file(Ref, State, {Mod,File} = MF, Paths, Pid, Fun) -> + %% One port for each file read in "parallel": + case prim_file:open([binary]) of + {ok, Port} -> + Port0 = State#state.data, + State1 = State#state{data = Port}, + R = case efile_get_file_from_port(State1, File, Paths) of + {{error,Reason},State2} -> + {Ref,MF,{error,Reason,State2}}; + {{ok,BinFile,Full},State2} -> + %% Fun(...) -> ok | {error,Mod} + {Ref,Fun(Mod, BinFile, Full),State2#state{data=Port0}} + end, + prim_file:close(Port), + Pid ! R; + {error, Error} -> + Pid ! {Ref,MF,{error,Error,State}} + end. + +%% -> {{ok,BinFile,File},State} | {{error,Reason},State} +efile_get_file_from_port(State, File, Paths) -> + case is_basename(File) of + false -> % get absolute file name. + efile_get_file_from_port2(State, File); + true when Paths =:= [] -> % get plain file name. + efile_get_file_from_port2(State, File); + true -> % use paths. + efile_get_file_from_port3(State, File, Paths) + end. + +efile_get_file_from_port2(#state{prim_state = PS} = State, File) -> + {Res, PS2} = prim_get_file(PS, File), + case Res of + {error,port_died} -> + exit('prim_load port died'); + {error,Reason} -> + {{error,Reason},State#state{prim_state = PS2}}; + {ok,BinFile} -> + {{ok,BinFile,File},State#state{prim_state = PS2}} + end. + +efile_get_file_from_port3(State, File, [P | Paths]) -> + case efile_get_file_from_port2(State, concat([P,"/",File])) of + {{error,Reason},State1} when Reason =/= emfile -> + case Paths of + [] -> % return last error + {{error,Reason},State1}; + _ -> % try more paths + efile_get_file_from_port3(State1, File, Paths) + end; + Result -> + Result + end; +efile_get_file_from_port3(State, _File, []) -> + {{error,enoent},State}. + +efile_set_primary_archive(#state{prim_state = PS} = State, File, Bin) -> + {Res, PS2} = prim_set_primary_archive(PS, File, Bin), + {Res,State#state{prim_state = PS2}}. + +efile_release_archives(#state{prim_state = PS} = State) -> + {Res, PS2} = prim_release_archives(PS), + {Res,State#state{prim_state = PS2}}. + +efile_list_dir(#state{prim_state = PS} = State, Dir) -> + {Res, PS2} = prim_list_dir(PS, Dir), + {Res, State#state{prim_state = PS2}}. + +efile_read_file_info(#state{prim_state = PS} = State, File) -> + {Res, PS2} = prim_read_file_info(PS, File), + {Res, State#state{prim_state = PS2}}. + +efile_get_cwd(#state{prim_state = PS} = State, Drive) -> + {Res, PS2} = prim_get_cwd(PS, Drive), + {Res, State#state{prim_state = PS2}}. + +efile_stop_port(#state{data=Port}=State) -> + prim_file:close(Port), + State#state{data=noport}. + +efile_exit_port(State, Port, Reason) when State#state.data =:= Port -> + exit({port_died,Reason}); +efile_exit_port(State, _Port, _Reason) -> + State. + +efile_timeout_handler(#state{n_timeouts = N} = State, _Parent) -> + if + N =< 0 -> + {_Res, State2} = efile_release_archives(State), + State2#state{n_timeouts = ?N_TIMEOUTS}; + true -> + State#state{n_timeouts = N - 1} + end. + +%%% -------------------------------------------------------- +%%% Functions which handles inet prim_loader +%%% -------------------------------------------------------- + +%% +%% Connect to a boot master +%% return {ok, Socket} TCP +%% AL is a list of boot servers (including broadcast addresses) +%% +find_master(AL) -> + find_master(AL, ?EBOOT_RETRY, ?EBOOT_REQUEST_DELAY, ?EBOOT_SHORT_RETRY_SLEEP, + ?EBOOT_UNSUCCESSFUL_TRIES, ?EBOOT_LONG_RETRY_SLEEP). + +find_master(AL, Retry, ReqDelay, SReSleep, Tries, LReSleep) -> + {ok,U} = ll_udp_open(0), + find_master(U, Retry, AL, ReqDelay, SReSleep, [], Tries, LReSleep). + +%% +%% Master connect loop +%% +find_master(U, Retry, AddrL, ReqDelay, SReSleep, Ignore, Tries, LReSleep) -> + case find_loop(U, Retry, AddrL, ReqDelay, SReSleep, Ignore, + Tries, LReSleep) of + [] -> + find_master(U, Retry, AddrL, ReqDelay, SReSleep, Ignore, + Tries, LReSleep); + Servers -> + ?dbg(servers, Servers), + case connect_master(Servers) of + {ok, Socket} -> + ll_close(U), + {ok, Socket}; + _Error -> + find_master(U, Retry, AddrL, ReqDelay, SReSleep, + Servers ++ Ignore, Tries, LReSleep) + end + end. + +connect_master([{_Prio,IP,Port} | Servers]) -> + case ll_tcp_connect(0, IP, Port) of + {ok, S} -> {ok, S}; + _Error -> connect_master(Servers) + end; +connect_master([]) -> + {error, ebusy}. + +%% +%% Always return a list of boot servers or hang. +%% +find_loop(U, Retry, AL, ReqDelay, SReSleep, Ignore, Tries, LReSleep) -> + case find_loop(U, Retry, AL, ReqDelay, []) of + [] -> % no response from any server + erlang:display({erl_prim_loader,'no server found'}), % lifesign + Tries1 = if Tries > 0 -> + sleep(SReSleep), + Tries - 1; + true -> + sleep(LReSleep), + 0 + end, + find_loop(U, Retry, AL, ReqDelay, SReSleep, Ignore, Tries1, LReSleep); + Servers -> + keysort(1, Servers -- Ignore) + end. + +%% broadcast or send +find_loop(_U, 0, _AL, _Delay, Acc) -> + Acc; +find_loop(U, Retry, AL, Delay, Acc) -> + send_all(U, AL, [?EBOOT_REQUEST, erlang:system_info(version)]), + find_collect(U, Retry-1, AL, Delay, Acc). + +find_collect(U,Retry,AL,Delay,Acc) -> + receive + {udp, U, IP, _Port, [$E,$B,$O,$O,$T,$R,Priority,T1,T0 | _Version]} -> + Elem = {Priority,IP,T1*256+T0}, + ?dbg(got, Elem), + case member(Elem, Acc) of + false -> find_collect(U, Retry, AL, Delay, [Elem | Acc]); + true -> find_collect(U, Retry, AL, Delay, Acc) + end; + _Garbage -> + ?dbg(collect_garbage, _Garbage), + find_collect(U, Retry, AL, Delay, Acc) + + after Delay -> + ?dbg(collected, Acc), + case keymember(0, 1, Acc) of %% got high priority server? + true -> Acc; + false -> find_loop(U, Retry, AL, Delay, Acc) + end + end. + + +sleep(Time) -> + receive after Time -> ok end. + +inet_exit_port(State, Port, _Reason) when State#state.data =:= Port -> + State#state { data = noport, timeout = infinity }; +inet_exit_port(State, _, _) -> + State. + + +inet_timeout_handler(State, _Parent) -> + Tcp = State#state.data, + if is_port(Tcp) -> ll_close(Tcp); + true -> ok + end, + State#state { timeout = infinity, data = noport }. + +%% -> {{ok,BinFile,Tag},State} | {{error,Reason},State} +inet_get_file_from_port(State, File, Paths) -> + case is_basename(File) of + false -> % get absolute file name. + inet_send_and_rcv({get,File}, File, State); + true when Paths =:= [] -> % get plain file name. + inet_send_and_rcv({get,File}, File, State); + true -> % use paths. + inet_get_file_from_port1(File, Paths, State) + end. + +inet_get_file_from_port1(File, [P | Paths], State) -> + File1 = concat([P,"/",File]), + case inet_send_and_rcv({get,File1}, File1, State) of + {{error,Reason},State1} -> + case Paths of + [] -> % return last error + {{error,Reason},State1}; + _ -> % try more paths + inet_get_file_from_port1(File, Paths, State1) + end; + Result -> Result + end; +inet_get_file_from_port1(_File, [], State) -> + {{error,file_not_found},State}. + +inet_send_and_rcv(Msg, Tag, State) when State#state.data =:= noport -> + {ok,Tcp} = find_master(State#state.hosts), %% reconnect + inet_send_and_rcv(Msg, Tag, State#state { data = Tcp, + timeout = ?IDLE_TIMEOUT }); +inet_send_and_rcv(Msg, Tag, #state{data=Tcp,timeout=Timeout}=State) -> + prim_inet:send(Tcp, term_to_binary(Msg)), + receive + {tcp,Tcp,BinMsg} -> + case catch binary_to_term(BinMsg) of + {get,{ok,BinFile}} -> + {{ok,BinFile,Tag},State}; + {_Cmd,Res={ok,_}} -> + {Res,State}; + {_Cmd,{error,Error}} -> + {{error,Error},State}; + {error,Error} -> + {{error,Error},State}; + {'EXIT',Error} -> + {{error,Error},State} + end; + {tcp_closed,Tcp} -> + %% Ok we must reconnect + inet_send_and_rcv(Msg, Tag, State#state { data = noport }); + {tcp_error,Tcp,_Reason} -> + %% Ok we must reconnect + inet_send_and_rcv(Msg, Tag, inet_stop_port(State)); + {'EXIT', Tcp, _} -> + %% Ok we must reconnect + inet_send_and_rcv(Msg, Tag, State#state { data = noport }) + after Timeout -> + %% Ok we must reconnect + inet_send_and_rcv(Msg, Tag, inet_stop_port(State)) + end. + +%% -> {{ok,List},State} | {{error,Reason},State} +inet_list_dir(State, Dir) -> + inet_send_and_rcv({list_dir,Dir}, list_dir, State). + +%% -> {{ok,Info},State} | {{error,Reason},State} +inet_read_file_info(State, File) -> + inet_send_and_rcv({read_file_info,File}, read_file_info, State). + +%% -> {{ok,Cwd},State} | {{error,Reason},State} +inet_get_cwd(State, []) -> + inet_send_and_rcv(get_cwd, get_cwd, State); +inet_get_cwd(State, [Drive]) -> + inet_send_and_rcv({get_cwd,Drive}, get_cwd, State). + +inet_stop_port(#state{data=Tcp}=State) -> + prim_inet:close(Tcp), + State#state{data=noport}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Direct inet_drv access +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +tcp_options() -> + [{mode,binary}, {packet,4}, {active, true}, {deliver,term}]. + +tcp_timeout() -> + 15000. + +%% options for udp [list, {broadcast, true}, {active,true}] +udp_options() -> + [{mode,list}, {active, true}, {deliver,term}, {broadcast,true}]. +%% +%% INET version IPv4 addresses +%% +ll_tcp_connect(LocalPort, IP, RemotePort) -> + case ll_open_set_bind(tcp, ?INET_FAMILY, tcp_options(), + ?INET_ADDRESS, LocalPort) of + {ok,S} -> + case prim_inet:connect(S, IP, RemotePort, tcp_timeout()) of + ok -> {ok, S}; + Error -> port_error(S, Error) + end; + Error -> Error + end. + +%% +%% Open and initialize an udp port for broadcast +%% +ll_udp_open(P) -> + ll_open_set_bind(udp, ?INET_FAMILY, udp_options(), ?INET_ADDRESS, P). + + +ll_open_set_bind(Protocol, Family, SOpts, IP, Port) -> + case prim_inet:open(Protocol, Family) of + {ok, S} -> + case prim_inet:setopts(S, SOpts) of + ok -> + case prim_inet:bind(S, IP, Port) of + {ok,_} -> + {ok, S}; + Error -> port_error(S, Error) + end; + Error -> port_error(S, Error) + end; + Error -> Error + end. + + +ll_close(S) -> + unlink(S), + exit(S, kill). + +port_error(S, Error) -> + unlink(S), + prim_inet:close(S), + Error. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +prim_init() -> + Deb = + case init:get_argument(loader_debug) of + {ok, _} -> true; + error -> false + end, + cache_new(#prim_state{debug = Deb}). + +prim_release_archives(PS) -> + debug(PS, release_archives), + {Res, PS2}= prim_do_release_archives(PS, get(), []), + debug(PS2, {return, Res}), + {Res, PS2}. + +prim_do_release_archives(PS, [{ArchiveFile, DictVal} | KeyVals], Acc) -> + Res = + case DictVal of + {primary, _PrimZip} -> + ok; % Keep primary archive + {_Mtime, Cache} -> + debug(PS, {release, cache, ArchiveFile}), + erase(ArchiveFile), + clear_cache(ArchiveFile, Cache) + end, + case Res of + ok -> + prim_do_release_archives(PS, KeyVals, Acc); + {error, Reason} -> + prim_do_release_archives(PS, KeyVals, [{ArchiveFile, Reason} | Acc]) + end; +prim_do_release_archives(PS, [], []) -> + {ok, PS#prim_state{primary_archive = undefined}}; +prim_do_release_archives(PS, [], Errors) -> + {{error, Errors}, PS#prim_state{primary_archive = undefined}}. + +prim_set_primary_archive(PS, undefined, undefined) -> + debug(PS, {set_primary_archive, clean}), + case PS#prim_state.primary_archive of + undefined -> + Res = {error, enoent}, + debug(PS, {return, Res}), + {Res, PS}; + ArchiveFile -> + {primary, PrimZip} = erase(ArchiveFile), + ok = prim_zip:close(PrimZip), + PS2 = PS#prim_state{primary_archive = undefined}, + Res = {ok, []}, + debug(PS2, {return, Res}), + {Res, PS2} + end; +prim_set_primary_archive(PS, ArchiveFile, ArchiveBin) + when is_list(ArchiveFile), is_binary(ArchiveBin) -> + %% Try the archive file + debug(PS, {set_primary_archive, ArchiveFile, byte_size(ArchiveBin)}), + {Res3, PS3} = + case PS#prim_state.primary_archive of + undefined -> + Fun = + fun({Funny, _GI, _GB}, A) -> + case Funny of + ["", "nibe", RevApp] -> % Reverse ebin + %% Collect ebin directories in archive + Ebin = reverse(RevApp) ++ "/ebin", + {true, [Ebin | A]}; + _ -> + {true, A} + end + end, + Ebins0 = [ArchiveFile], + case open_archive({ArchiveFile, ArchiveBin}, Ebins0, Fun) of + {ok, PrimZip, RevEbins} -> + Ebins = reverse(RevEbins), + debug(PS, {set_primary_archive, Ebins}), + put(ArchiveFile, {primary, PrimZip}), + {{ok, Ebins}, PS#prim_state{primary_archive = ArchiveFile}}; + Error -> + debug(PS, {set_primary_archive, Error}), + {Error, PS} + end; + OldArchiveFile -> + debug(PS, {set_primary_archive, clean}), + PrimZip = erase(OldArchiveFile), + ok = prim_zip:close(PrimZip), + PS2 = PS#prim_state{primary_archive = undefined}, + prim_set_primary_archive(PS2, ArchiveFile, ArchiveBin) + end, + debug(PS3, {return, Res3}), + {Res3, PS3}. + +prim_get_file(PS, File) -> + debug(PS, {get_file, File}), + {Res2, PS2} = + case name_split(PS#prim_state.primary_archive, File) of + {file, PrimFile} -> + Res = prim_file:read_file(PrimFile), + {Res, PS}; + {archive, ArchiveFile, FileInArchive} -> + debug(PS, {archive_get_file, ArchiveFile, FileInArchive}), + FunnyFile = funny_split(FileInArchive, $/), + Fun = + fun({Funny, _GetInfo, GetBin}, Acc) -> + if + Funny =:= FunnyFile -> + {false, {ok, GetBin()}}; + true -> + {true, Acc} + end + end, + apply_archive(PS, Fun, {error, enoent}, ArchiveFile) + end, + debug(PS, {return, Res2}), + {Res2, PS2}. + +%% -> {{ok,List},State} | {{error,Reason},State} +prim_list_dir(PS, Dir) -> + debug(PS, {list_dir, Dir}), + {Res2, PS3} = + case name_split(PS#prim_state.primary_archive, Dir) of + {file, PrimDir} -> + Res = prim_file:list_dir(PrimDir), + {Res, PS}; + {archive, ArchiveFile, FileInArchive} -> + debug(PS, {archive_list_dir, ArchiveFile, FileInArchive}), + FunnyDir = funny_split(FileInArchive, $/), + Fun = + fun({Funny, _GetInfo, _GetBin}, {Status, Names} = Acc) -> + case Funny of + [RevName | FD] when FD =:= FunnyDir -> + case RevName of + "" -> + %% The listed directory + {true, {ok, Names}}; + _ -> + %% Plain file + Name = reverse(RevName), + {true, {Status, [Name | Names]}} + end; + ["", RevName | FD] when FD =:= FunnyDir -> + %% Directory + Name = reverse(RevName), + {true, {Status, [Name | Names]}}; + [RevName] when FunnyDir =:= [""] -> + %% Top file + Name = reverse(RevName), + {true, {ok, [Name | Names]}}; + ["", RevName] when FunnyDir =:= [""] -> + %% Top file + Name = reverse(RevName), + {true, {ok, [Name | Names]}}; + _ -> + %% No match + {true, Acc} + end + end, + {{Status, Names}, PS2} = + apply_archive(PS, Fun, {error, []}, ArchiveFile), + case Status of + ok -> {{ok, Names}, PS2}; + error -> {{error, enotdir}, PS2} + end + end, + debug(PS, {return, Res2}), + {Res2, PS3}. + +%% -> {{ok,Info},State} | {{error,Reason},State} +prim_read_file_info(PS, File) -> + debug(PS, {read_file_info, File}), + {Res2, PS2} = + case name_split(PS#prim_state.primary_archive, File) of + {file, PrimFile} -> + Res = prim_file:read_file_info(PrimFile), + {Res, PS}; + {archive, ArchiveFile, []} -> + %% Fake top directory + debug(PS, {archive_read_file_info, ArchiveFile}), + case prim_file:read_file_info(ArchiveFile) of + {ok, FI} -> + {{ok, FI#file_info{type = directory}}, PS}; + Other -> + {Other, PS} + end; + {archive, ArchiveFile, FileInArchive} -> + debug(PS, {archive_read_file_info, File}), + FunnyFile = funny_split(FileInArchive, $/), + Fun = + fun({Funny, GetInfo, _GetBin}, Acc) -> + if + hd(Funny) =:= "", + tl(Funny) =:= FunnyFile -> + %% Directory + {false, {ok, GetInfo()}}; + Funny =:= FunnyFile -> + %% Plain file + {false, {ok, GetInfo()}}; + true -> + %% No match + {true, Acc} + end + end, + apply_archive(PS, Fun, {error, enoent}, ArchiveFile) + end, + debug(PS2, {return, Res2}), + {Res2, PS2}. + +prim_get_cwd(PS, []) -> + debug(PS, {get_cwd, []}), + Res = prim_file:get_cwd(), + debug(PS, {return, Res}), + {Res, PS}; +prim_get_cwd(PS, [Drive]) -> + debug(PS, {get_cwd, Drive}), + Res = prim_file:get_cwd(Drive), + debug(PS, {return, Res}), + {Res, PS}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +apply_archive(PS, Fun, Acc, Archive) -> + case get(Archive) of + undefined -> + case prim_file:read_file_info(Archive) of + {ok, #file_info{mtime = Mtime}} -> + case open_archive(Archive, Acc, Fun) of + {ok, PrimZip, Acc2} -> + debug(PS, {cache, ok}), + put(Archive, {Mtime, {ok, PrimZip}}), + {Acc2, PS}; + Error -> + debug(PS, {cache, Error}), + put(Archive, {Mtime, Error}), + {Error, PS} + end; + Error -> + debug(PS, {cache, Error}), + {Error, PS} + end; + {primary, PrimZip} -> + case foldl_archive(PrimZip, Acc, Fun) of + {ok, _PrimZip2, Acc2} -> + {Acc2, PS}; + Error -> + debug(PS, {primary, Error}), + {Error, PS} + end; + {Mtime, Cache} -> + case prim_file:read_file_info(Archive) of + {ok, #file_info{mtime = Mtime2}} when Mtime2 =:= Mtime -> + case Cache of + {ok, PrimZip} -> + case foldl_archive(PrimZip, Acc, Fun) of + {ok, _PrimZip2, Acc2} -> + {Acc2, PS}; + Error -> + debug(PS, {cache, {clear, Error}}), + clear_cache(Archive, Cache), + debug(PS, {cache, Error}), + put(Archive, {Mtime, Error}), + {Error, PS} + end; + Error -> + debug(PS, {cache, Error}), + {Error, PS} + end; + Error -> + debug(PS, {cache, {clear, Error}}), + clear_cache(Archive, Cache), + apply_archive(PS, Fun, Acc, Archive) + end + end. + +open_archive(Archive, Acc, Fun) -> + Wrapper = + fun({N, GI, GB}, A) -> + %% Ensure full iteration at open + Funny = funny_split(N, $/), + {_Continue, A2} = Fun({Funny, GI, GB}, A), + {true, {true, Funny}, A2} + end, + prim_zip:open(Wrapper, Acc, Archive). + +foldl_archive(PrimZip, Acc, Fun) -> + Wrapper = + fun({N, GI, GB}, A) -> + %% Allow partial iteration at foldl + {Continue, A2} = Fun({N, GI, GB}, A), + {Continue, true, A2} + end, + prim_zip:foldl(Wrapper, Acc, PrimZip). + +cache_new(PS) -> + PS. + +clear_cache(Archive, Cache) -> + erase(Archive), + case Cache of + {ok, PrimZip} -> + prim_zip:close(PrimZip); + {error, _} -> + ok + end. + +%%% -------------------------------------------------------- +%%% Misc. functions. +%%% -------------------------------------------------------- + +%%% Look for directory separators +is_basename(File) -> + case deep_member($/, File) of + true -> + false; + false -> + case erlang:system_info(os_type) of + {win32, _} -> + case File of + [_,$: | _] -> + false; + _ -> + not deep_member($\\, File) + end; + _ -> + true + end + end. + +send_all(U, [IP | AL], Cmd) -> + ?dbg(sendto, {U, IP, ?EBOOT_PORT, Cmd}), + prim_inet:sendto(U, IP, ?EBOOT_PORT, Cmd), + send_all(U, AL, Cmd); +send_all(_U, [], _) -> ok. + +concat([A|T]) when is_atom(A) -> %Atom + atom_to_list(A) ++ concat(T); +concat([C|T]) when C >= 0, C =< 255 -> + [C|concat(T)]; +concat([S|T]) -> %String + S ++ concat(T); +concat([]) -> + []. + +member(X, [X|_]) -> true; +member(X, [_|Y]) -> member(X, Y); +member(_X, []) -> false. + +deep_member(X, [X|_]) -> + true; +deep_member(X, [List | Y]) when is_list(List) -> + deep_member(X, List) orelse deep_member(X, Y); +deep_member(X, [Atom | Y]) when is_atom(Atom) -> + deep_member(X, atom_to_list(Atom)) orelse deep_member(X, Y); +deep_member(X, [_ | Y]) -> + deep_member(X, Y); +deep_member(_X, []) -> + false. + +keymember(X, I, [Y | _]) when element(I,Y) =:= X -> true; +keymember(X, I, [_ | T]) -> keymember(X, I, T); +keymember(_X, _I, []) -> false. + +keysort(I, L) -> keysort(I, L, []). + +keysort(I, [X | L], Ls) -> + keysort(I, L, keyins(X, I, Ls)); +keysort(_I, [], Ls) -> Ls. + +keyins(X, I, [Y | T]) when X < element(I,Y) -> [X,Y|T]; +keyins(X, I, [Y | T]) -> [Y | keyins(X, I, T)]; +keyins(X, _I, []) -> [X]. + +min(X, Y) when X < Y -> X; +min(_X, Y) -> Y. + +to_strs([P|Paths]) when is_atom(P) -> + [atom_to_list(P)|to_strs(Paths)]; +to_strs([P|Paths]) when is_list(P) -> + [P|to_strs(Paths)]; +to_strs([_|Paths]) -> + to_strs(Paths); +to_strs([]) -> + []. + +reverse([] = L) -> + L; +reverse([_] = L) -> + L; +reverse([A, B]) -> + [B, A]; +reverse([A, B | L]) -> + lists:reverse(L, [B, A]). % BIF + +%% Returns all lists in reverse order +funny_split(List, Sep) -> + funny_split(List, Sep, [], []). + +funny_split([Sep | Tail], Sep, Path, Paths) -> + funny_split(Tail, Sep, [], [Path | Paths]); +funny_split([Head | Tail], Sep, Path, Paths) -> + funny_split(Tail, Sep, [Head | Path], Paths); +funny_split([], _Sep, Path, Paths) -> + [Path | Paths]. + +name_split(ArchiveFile, File0) -> + File = absname(File0), + do_name_split(ArchiveFile, File). + +do_name_split(undefined, File) -> + %% Ignore primary archive + case string_split(File, init:archive_extension(), []) of + no_split -> + %% Plain file + {file, File}; + {split, _RevArchiveBase, RevArchiveFile, []} -> + %% Top dir in archive + ArchiveFile = reverse(RevArchiveFile), + {archive, ArchiveFile, []}; + {split, _RevArchiveBase, RevArchiveFile, [$/ | FileInArchive]} -> + %% File in archive + ArchiveFile = reverse(RevArchiveFile), + {archive, ArchiveFile, FileInArchive}; + {split, _RevArchiveBase, _RevArchiveFile, _FileInArchive} -> + %% False match. Assume plain file + {file, File} + end; +do_name_split(ArchiveFile0, File) -> + %% Look first in primary archive + ArchiveFile = absname(ArchiveFile0), + case string_match(File, ArchiveFile, []) of + no_match -> + %% Archive or plain file + do_name_split(undefined, File); + {match, _RevPrimArchiveFile, FileInArchive} -> + %% Primary archive + case FileInArchive of + [$/ | FileInArchive2] -> + {archive, ArchiveFile, FileInArchive2}; + _ -> + {archive, ArchiveFile, FileInArchive} + end + end. + +string_match([Char | File], [Char | Archive], RevTop) -> + string_match(File, Archive, [Char | RevTop]); +string_match(File, [], RevTop) -> + {match, RevTop, File}; +string_match(_File, _Archive, _RevTop) -> + no_match. + +string_split([Char | File], [Char | Ext] = FullExt, RevTop) -> + RevTop2 = [Char | RevTop], + string_split2(File, Ext, RevTop, RevTop2, File, FullExt, RevTop2); +string_split([Char | File], Ext, RevTop) -> + string_split(File, Ext, [Char | RevTop]); +string_split([], _Ext, _RevTop) -> + no_split. + +string_split2([Char | File], [Char | Ext], RevBase, RevTop, SaveFile, SaveExt, SaveTop) -> + string_split2(File, Ext, RevBase, [Char | RevTop], SaveFile, SaveExt, SaveTop); +string_split2(File, [], RevBase, RevTop, _SaveFile, _SaveExt, _SaveTop) -> + {split, RevBase, RevTop, File}; +string_split2(_, _Ext, _RevBase, _RevTop, SaveFile, SaveExt, SaveTop) -> + string_split(SaveFile, SaveExt, SaveTop). + +%% Parse list of ipv4 addresses +ipv4_list([H | T]) -> + IPV = if is_atom(H) -> ipv4_address(atom_to_list(H)); + is_list(H) -> ipv4_address(H); + true -> {error,einal} + end, + case IPV of + {ok,IP} -> [IP | ipv4_list(T)]; + _ -> ipv4_list(T) + end; +ipv4_list([]) -> []. + +%% +%% Parse Ipv4 address: d1.d2.d3.d4 (from inet_parse) +%% +%% Return {ok, IP} | {error, einval} +%% +ipv4_address(Cs) -> + case catch ipv4_addr(Cs, []) of + {'EXIT',_} -> {error,einval}; + Addr -> {ok,Addr} + end. + +ipv4_addr([C | Cs], IP) when C >= $0, C =< $9 -> ipv4_addr(Cs, C-$0, IP). + +ipv4_addr([$.|Cs], N, IP) when N < 256 -> ipv4_addr(Cs, [N|IP]); +ipv4_addr([C|Cs], N, IP) when C >= $0, C =< $9 -> + ipv4_addr(Cs, N*10 + (C-$0), IP); +ipv4_addr([], D, [C,B,A]) when D < 256 -> {A,B,C,D}. + +%% A simplified version of filename:absname/1 +absname(Name) -> + Name2 = normalize(Name, []), + case pathtype(Name2) of + absolute -> + Name2; + relative -> + case prim_file:get_cwd() of + {ok, Cwd} -> + Cwd ++ "/" ++ Name2; + {error, _} -> + Name2 + end; + volumerelative -> + case prim_file:get_cwd() of + {ok, Cwd} -> + absname_vr(Name2, Cwd); + {error, _} -> + Name2 + end + end. + +%% Assumes normalized name +absname_vr([$/ | NameRest], [Drive, $\: | _]) -> + %% Absolute path on current drive. + [Drive, $\: | NameRest]; +absname_vr([Drive, $\: | NameRest], [Drive, $\: | _] = Cwd) -> + %% Relative to current directory on current drive. + Cwd ++ "/" ++ NameRest; +absname_vr([Drive, $\: | NameRest], _) -> + %% Relative to current directory on another drive. + case prim_file:get_cwd([Drive, $\:]) of + {ok, DriveCwd} -> + DriveCwd ++ "/" ++ NameRest; + {error, _} -> + [Drive, $\:, $/] ++ NameRest + end. + +%% Assumes normalized name +pathtype(Name) when is_list(Name) -> + case erlang:system_info(os_type) of + {unix, _} -> + unix_pathtype(Name); + {win32, _} -> + win32_pathtype(Name); + {vxworks, _} -> + case vxworks_first(Name) of + {device, _Rest, _Dev} -> + absolute; + _ -> + relative + end; + {ose,_} -> + unix_pathtype(Name) + end. + +unix_pathtype(Name) -> + case Name of + [$/|_] -> + absolute; + [List|Rest] when is_list(List) -> + unix_pathtype(List++Rest); + [Atom|Rest] when is_atom(Atom) -> + atom_to_list(Atom)++Rest; + _ -> + relative + end. + +win32_pathtype(Name) -> + case Name of + [List|Rest] when is_list(List) -> + win32_pathtype(List++Rest); + [Atom|Rest] when is_atom(Atom) -> + win32_pathtype(atom_to_list(Atom)++Rest); + [Char, List | Rest] when is_list(List) -> + win32_pathtype([Char | List++Rest]); + [$/, $/|_] -> + absolute; + [$\\, $/|_] -> + absolute; + [$/, $\\|_] -> + absolute; + [$\\, $\\|_] -> + absolute; + [$/|_] -> + volumerelative; + [$\\|_] -> + volumerelative; + [C1, C2, List | Rest] when is_list(List) -> + pathtype([C1, C2|List ++ Rest]); + [_Letter, $:, $/|_] -> + absolute; + [_Letter, $:, $\\|_] -> + absolute; + [_Letter, $:|_] -> + volumerelative; + _ -> + relative + end. + +vxworks_first(Name) -> + case Name of + [] -> + {not_device, [], []}; + [$/ | T] -> + vxworks_first2(device, T, [$/]); + [$\\ | T] -> + vxworks_first2(device, T, [$/]); + [H | T] when is_list(H) -> + vxworks_first(H ++ T); + [H | T] -> + vxworks_first2(not_device, T, [H]) + end. + +vxworks_first2(Devicep, Name, FirstComp) -> + case Name of + [] -> + {Devicep, [], FirstComp}; + [$/ |T ] -> + {Devicep, [$/ | T], FirstComp}; + [$\\ | T] -> + {Devicep, [$/ | T], FirstComp}; + [$: | T]-> + {device, T, [$: | FirstComp]}; + [H | T] when is_list(H) -> + vxworks_first2(Devicep, H ++ T, FirstComp); + [H | T] -> + vxworks_first2(Devicep, T, [H | FirstComp]) + end. + +normalize(Name, Acc) -> + case Name of + [List | Rest] when is_list(List) -> + normalize(List ++ Rest, Acc); + [Atom | Rest] when is_atom(Atom) -> + normalize(atom_to_list(Atom) ++ Rest, Acc); + [$\\ | Chars] -> + normalize(Chars, [$/ | Acc]); + [Char | Chars] -> + normalize(Chars, [Char | Acc]); + [] -> + reverse(Acc) + end. diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl new file mode 100644 index 0000000000..6f92b319b7 --- /dev/null +++ b/erts/preloaded/src/erlang.erl @@ -0,0 +1,683 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(erlang). + +-export([apply/2,apply/3,spawn/4,spawn_link/4, + spawn_monitor/1,spawn_monitor/3, + spawn_opt/2,spawn_opt/3,spawn_opt/4,spawn_opt/5, + disconnect_node/1]). +-export([spawn/1, spawn_link/1, spawn/2, spawn_link/2]). +-export([yield/0]). +-export([crasher/6]). +-export([fun_info/1]). +-export([send_nosuspend/2, send_nosuspend/3]). +-export([localtime_to_universaltime/1]). +-export([suspend_process/1]). +-export([min/2,max/2]). + +-export([dlink/1, dunlink/1, dsend/2, dsend/3, dgroup_leader/2, + dexit/2, dmonitor_node/3, dmonitor_p/2]). + +-export([delay_trap/2]). + +-export([set_cookie/2, get_cookie/0]). + +-export([nodes/0]). + +-export([concat_binary/1]). + +-export([list_to_integer/2,integer_to_list/2]). + +-export([flush_monitor_message/2]). + +-export([set_cpu_topology/1, format_cpu_topology/1]). + +-export([await_proc_exit/3]). + +-deprecated([hash/2]). + +-compile(nowarn_bif_clash). + +apply(Fun, Args) -> + apply(Fun, Args). + +apply(Mod, Name, Args) -> + apply(Mod, Name, Args). + + +% Spawns with a fun +spawn(F) when is_function(F) -> + spawn(erlang, apply, [F, []]); +spawn({M,F}=MF) when is_atom(M), is_atom(F) -> + spawn(erlang, apply, [MF, []]); +spawn(F) -> + erlang:error(badarg, [F]). + +spawn(N, F) when N =:= node() -> + spawn(F); +spawn(N, F) when is_function(F) -> + spawn(N, erlang, apply, [F, []]); +spawn(N, {M,F}=MF) when is_atom(M), is_atom(F) -> + spawn(N, erlang, apply, [MF, []]); +spawn(N, F) -> + erlang:error(badarg, [N, F]). + +spawn_link(F) when is_function(F) -> + spawn_link(erlang, apply, [F, []]); +spawn_link({M,F}=MF) when is_atom(M), is_atom(F) -> + spawn_link(erlang, apply, [MF, []]); +spawn_link(F) -> + erlang:error(badarg, [F]). + +spawn_link(N, F) when N =:= node() -> + spawn_link(F); +spawn_link(N, F) when is_function(F) -> + spawn_link(N, erlang, apply, [F, []]); +spawn_link(N, {M,F}=MF) when is_atom(M), is_atom(F) -> + spawn_link(N, erlang, apply, [MF, []]); +spawn_link(N, F) -> + erlang:error(badarg, [N, F]). + +%% Spawn and atomically set up a monitor. + +spawn_monitor(F) when is_function(F, 0) -> + erlang:spawn_opt({erlang,apply,[F,[]],[monitor]}); +spawn_monitor(F) -> + erlang:error(badarg, [F]). + +spawn_monitor(M, F, A) when is_atom(M), is_atom(F), is_list(A) -> + erlang:spawn_opt({M,F,A,[monitor]}); +spawn_monitor(M, F, A) -> + erlang:error(badarg, [M,F,A]). + +spawn_opt(F, O) when is_function(F) -> + spawn_opt(erlang, apply, [F, []], O); +spawn_opt({M,F}=MF, O) when is_atom(M), is_atom(F) -> + spawn_opt(erlang, apply, [MF, []], O); +spawn_opt({M,F,A}, O) -> % For (undocumented) backward compatibility + spawn_opt(M, F, A, O); +spawn_opt(F, O) -> + erlang:error(badarg, [F, O]). + +spawn_opt(N, F, O) when N =:= node() -> + spawn_opt(F, O); +spawn_opt(N, F, O) when is_function(F) -> + spawn_opt(N, erlang, apply, [F, []], O); +spawn_opt(N, {M,F}=MF, O) when is_atom(M), is_atom(F) -> + spawn_opt(N, erlang, apply, [MF, []], O); +spawn_opt(N, F, O) -> + erlang:error(badarg, [N, F, O]). + +% Spawns with MFA + +spawn(N,M,F,A) when N =:= node(), is_atom(M), is_atom(F), is_list(A) -> + spawn(M,F,A); +spawn(N,M,F,A) when is_atom(N), is_atom(M), is_atom(F) -> + case is_well_formed_list(A) of + true -> + ok; + false -> + erlang:error(badarg, [N, M, F, A]) + end, + case catch gen_server:call({net_kernel,N}, + {spawn,M,F,A,group_leader()}, + infinity) of + Pid when is_pid(Pid) -> + Pid; + Error -> + case remote_spawn_error(Error, {no_link, N, M, F, A, []}) of + {fault, Fault} -> + erlang:error(Fault, [N, M, F, A]); + Pid -> + Pid + end + end; +spawn(N,M,F,A) -> + erlang:error(badarg, [N, M, F, A]). + +spawn_link(N,M,F,A) when N =:= node(), is_atom(M), is_atom(F), is_list(A) -> + spawn_link(M,F,A); +spawn_link(N,M,F,A) when is_atom(N), is_atom(M), is_atom(F) -> + case is_well_formed_list(A) of + true -> + ok; + _ -> + erlang:error(badarg, [N, M, F, A]) + end, + case catch gen_server:call({net_kernel,N}, + {spawn_link,M,F,A,group_leader()}, + infinity) of + Pid when is_pid(Pid) -> + Pid; + Error -> + case remote_spawn_error(Error, {link, N, M, F, A, []}) of + {fault, Fault} -> + erlang:error(Fault, [N, M, F, A]); + Pid -> + Pid + end + end; +spawn_link(N,M,F,A) -> + erlang:error(badarg, [N, M, F, A]). + +spawn_opt(M, F, A, Opts) -> + case catch erlang:spawn_opt({M,F,A,Opts}) of + {'EXIT',{Reason,_}} -> + erlang:error(Reason, [M,F,A,Opts]); + Res -> + Res + end. + +spawn_opt(N, M, F, A, O) when N =:= node(), + is_atom(M), is_atom(F), is_list(A), + is_list(O) -> + spawn_opt(M, F, A, O); +spawn_opt(N, M, F, A, O) when is_atom(N), is_atom(M), is_atom(F) -> + case {is_well_formed_list(A), is_well_formed_list(O)} of + {true, true} -> + ok; + _ -> + erlang:error(badarg, [N, M, F, A, O]) + end, + case lists:member(monitor, O) of + false -> ok; + true -> erlang:error(badarg, [N, M, F, A, O]) + end, + {L,NO} = lists:foldl(fun (link, {_, NewOpts}) -> + {link, NewOpts}; + (Opt, {LO, NewOpts}) -> + {LO, [Opt|NewOpts]} + end, + {no_link,[]}, + O), + case catch gen_server:call({net_kernel,N}, + {spawn_opt,M,F,A,NO,L,group_leader()}, + infinity) of + Pid when is_pid(Pid) -> + Pid; + Error -> + case remote_spawn_error(Error, {L, N, M, F, A, NO}) of + {fault, Fault} -> + erlang:error(Fault, [N, M, F, A, O]); + Pid -> + Pid + end + end; +spawn_opt(N,M,F,A,O) -> + erlang:error(badarg, [N,M,F,A,O]). + +remote_spawn_error({'EXIT', {{nodedown,N}, _}}, {L, N, M, F, A, O}) -> + {Opts, LL} = case L =:= link of + true -> + {[link|O], [link]}; + false -> + {O, []} + end, + spawn_opt(erlang,crasher,[N,M,F,A,Opts,noconnection], LL); +remote_spawn_error({'EXIT', {Reason, _}}, _) -> + {fault, Reason}; +remote_spawn_error({'EXIT', Reason}, _) -> + {fault, Reason}; +remote_spawn_error(Other, _) -> + {fault, Other}. + +is_well_formed_list([]) -> + true; +is_well_formed_list([_|Rest]) -> + is_well_formed_list(Rest); +is_well_formed_list(_) -> + false. + +crasher(Node,Mod,Fun,Args,[],Reason) -> + error_logger:warning_msg("** Can not start ~w:~w,~w on ~w **~n", + [Mod,Fun,Args,Node]), + exit(Reason); +crasher(Node,Mod,Fun,Args,Opts,Reason) -> + error_logger:warning_msg("** Can not start ~w:~w,~w (~w) on ~w **~n", + [Mod,Fun,Args,Opts,Node]), + exit(Reason). + +yield() -> + erlang:yield(). + +nodes() -> erlang:nodes(visible). + +disconnect_node(Node) -> net_kernel:disconnect(Node). + +fun_info(Fun) when is_function(Fun) -> + Keys = [type,env,arity,name,uniq,index,new_uniq,new_index,module,pid], + fun_info_1(Keys, Fun, []). + +fun_info_1([K|Ks], Fun, A) -> + case erlang:fun_info(Fun, K) of + {K,undefined} -> fun_info_1(Ks, Fun, A); + {K,_}=P -> fun_info_1(Ks, Fun, [P|A]) + end; +fun_info_1([], _, A) -> A. + +-type dst() :: pid() | port() | atom() | {atom(), node()}. + +-spec send_nosuspend(dst(), term()) -> boolean(). +send_nosuspend(Pid, Msg) -> + send_nosuspend(Pid, Msg, []). + +-spec send_nosuspend(dst(), term(), ['noconnect' | 'nosuspend']) -> boolean(). +send_nosuspend(Pid, Msg, Opts) -> + case erlang:send(Pid, Msg, [nosuspend|Opts]) of + ok -> true; + _ -> false + end. + +localtime_to_universaltime(Localtime) -> + erlang:localtime_to_universaltime(Localtime, undefined). + +suspend_process(P) -> + case catch erlang:suspend_process(P, []) of + {'EXIT', {Reason, _}} -> erlang:error(Reason, [P]); + {'EXIT', Reason} -> erlang:error(Reason, [P]); + Res -> Res + end. + +%% +%% If the emulator wants to perform a distributed command and +%% a connection is not established to the actual node the following +%% functions is called in order to set up the connection and then +%% reactivate the command. +%% + +dlink(Pid) -> + case net_kernel:connect(node(Pid)) of + true -> link(Pid); + false -> erlang:dist_exit(self(), noconnection, Pid), true + end. + +%% Can this ever happen? +dunlink(Pid) -> + case net_kernel:connect(node(Pid)) of + true -> unlink(Pid); + false -> true + end. + +dmonitor_node(Node, Flag, []) -> + case net_kernel:connect(Node) of + true -> erlang:monitor_node(Node, Flag, []); + false -> self() ! {nodedown, Node}, true + end; + +dmonitor_node(Node, Flag, Opts) -> + case lists:member(allow_passive_connect,Opts) of + true -> + case net_kernel:passive_cnct(Node) of + true -> erlang:monitor_node(Node, Flag, Opts); + false -> self() ! {nodedown, Node}, true + end; + _ -> + dmonitor_node(Node,Flag,[]) + end. + +dgroup_leader(Leader, Pid) -> + case net_kernel:connect(node(Pid)) of + true -> group_leader(Leader, Pid); + false -> true %% bad arg ? + end. + +dexit(Pid, Reason) -> + case net_kernel:connect(node(Pid)) of + true -> exit(Pid, Reason); + false -> true + end. + +dsend(Pid, Msg) when is_pid(Pid) -> + case net_kernel:connect(node(Pid)) of + true -> erlang:send(Pid, Msg); + false -> Msg + end; +dsend(Port, Msg) when is_port(Port) -> + case net_kernel:connect(node(Port)) of + true -> erlang:send(Port, Msg); + false -> Msg + end; +dsend({Name, Node}, Msg) -> + case net_kernel:connect(Node) of + true -> erlang:send({Name,Node}, Msg); + false -> Msg; + ignored -> Msg % Not distributed. + end. + +dsend(Pid, Msg, Opts) when is_pid(Pid) -> + case net_kernel:connect(node(Pid)) of + true -> erlang:send(Pid, Msg, Opts); + false -> ok + end; +dsend(Port, Msg, Opts) when is_port(Port) -> + case net_kernel:connect(node(Port)) of + true -> erlang:send(Port, Msg, Opts); + false -> ok + end; +dsend({Name, Node}, Msg, Opts) -> + case net_kernel:connect(Node) of + true -> erlang:send({Name,Node}, Msg, Opts); + false -> ok; + ignored -> ok % Not distributed. + end. + +dmonitor_p(process, ProcSpec) -> + %% ProcSpec = pid() | {atom(),atom()} + %% ProcSpec CANNOT be an atom because a locally registered process + %% is never handled here. + + Node = case ProcSpec of + {S,N} when is_atom(S), is_atom(N), N =/= node() -> N; + _ when is_pid(ProcSpec) -> node(ProcSpec) + end, + case net_kernel:connect(Node) of + true -> + erlang:monitor(process, ProcSpec); + false -> + Ref = make_ref(), + self() ! {'DOWN', Ref, process, ProcSpec, noconnection}, + Ref + end. + +%% +%% Trap function used when modified timing has been enabled. +%% + +delay_trap(Result, 0) -> erlang:yield(), Result; +delay_trap(Result, Timeout) -> receive after Timeout -> Result end. + +%% +%% The business with different in and out cookies represented +%% everywhere is discarded. +%% A node has a cookie, connections/messages to that node use that cookie. +%% Messages to us use our cookie. IF we change our cookie, other nodes +%% have to reflect that, which we cannot forsee. +%% +set_cookie(Node, C) when Node =/= nonode@nohost, is_atom(Node) -> + Res = case C of + _ when is_atom(C) -> + auth:set_cookie(Node, C); + {CI,CO} when is_atom(CI), is_atom(CO) -> + auth:set_cookie(Node, {CI, CO}); + _ -> + error + end, + case Res of + error -> exit(badarg); + Other -> Other + end. + +get_cookie() -> + auth:get_cookie(). + +concat_binary(List) -> + list_to_binary(List). + +integer_to_list(I, 10) -> + erlang:integer_to_list(I); +integer_to_list(I, Base) + when is_integer(I), is_integer(Base), Base >= 2, Base =< 1+$Z-$A+10 -> + if I < 0 -> + [$-|integer_to_list(-I, Base, [])]; + true -> + integer_to_list(I, Base, []) + end; +integer_to_list(I, Base) -> + erlang:error(badarg, [I, Base]). + +integer_to_list(I0, Base, R0) -> + D = I0 rem Base, + I1 = I0 div Base, + R1 = if D >= 10 -> + [D-10+$A|R0]; + true -> + [D+$0|R0] + end, + if I1 =:= 0 -> + R1; + true -> + integer_to_list(I1, Base, R1) + end. + + + +list_to_integer(L, 10) -> + erlang:list_to_integer(L); +list_to_integer(L, Base) + when is_list(L), is_integer(Base), Base >= 2, Base =< 1+$Z-$A+10 -> + case list_to_integer_sign(L, Base) of + I when is_integer(I) -> + I; + Fault -> + erlang:error(Fault, [L,Base]) + end; +list_to_integer(L, Base) -> + erlang:error(badarg, [L,Base]). + +list_to_integer_sign([$-|[_|_]=L], Base) -> + case list_to_integer(L, Base, 0) of + I when is_integer(I) -> + -I; + I -> + I + end; +list_to_integer_sign([$+|[_|_]=L], Base) -> + list_to_integer(L, Base, 0); +list_to_integer_sign([_|_]=L, Base) -> + list_to_integer(L, Base, 0); +list_to_integer_sign(_, _) -> + badarg. + +list_to_integer([D|L], Base, I) + when is_integer(D), D >= $0, D =< $9, D < Base+$0 -> + list_to_integer(L, Base, I*Base + D-$0); +list_to_integer([D|L], Base, I) + when is_integer(D), D >= $A, D < Base+$A-10 -> + list_to_integer(L, Base, I*Base + D-$A+10); +list_to_integer([D|L], Base, I) + when is_integer(D), D >= $a, D < Base+$a-10 -> + list_to_integer(L, Base, I*Base + D-$a+10); +list_to_integer([], _, I) -> + I; +list_to_integer(_, _, _) -> + badarg. + +%% erlang:flush_monitor_message/2 is for internal use only! +%% +%% erlang:demonitor(Ref, [flush]) traps to +%% erlang:flush_monitor_message(Ref, Res) when +%% it needs to flush a monitor message. +flush_monitor_message(Ref, Res) when is_reference(Ref), is_atom(Res) -> + receive {_, Ref, _, _, _} -> ok after 0 -> ok end, + Res. + +-record(cpu, {node = -1, + processor = -1, + processor_node = -1, + core = -1, + thread = -1, + logical = -1}). + +%% erlang:set_cpu_topology/1 is for internal use only! +%% +%% erlang:system_flag(cpu_topology, CpuTopology) traps to +%% erlang:set_cpu_topology(CpuTopology). +set_cpu_topology(CpuTopology) -> + try format_cpu_topology(erlang:system_flag(internal_cpu_topology, + cput_e2i(CpuTopology))) + catch + Class:Exception when Class =/= error; Exception =/= internal_error -> + erlang:error(badarg, [CpuTopology]) + end. + +cput_e2i_clvl({logical, _}, _PLvl) -> + #cpu.logical; +cput_e2i_clvl([E | _], PLvl) -> + case element(1, E) of + node -> case PLvl of + 0 -> #cpu.node; + #cpu.processor -> #cpu.processor_node + end; + processor -> case PLvl of + 0 -> #cpu.node; + #cpu.node -> #cpu.processor + end; + core -> #cpu.core; + thread -> #cpu.thread + end. + +cput_e2i(undefined) -> + undefined; +cput_e2i(E) -> + rvrs(cput_e2i(E, -1, -1, #cpu{}, 0, cput_e2i_clvl(E, 0), [])). + +cput_e2i([], _NId, _PId, _IS, _PLvl, _Lvl, Res) -> + Res; +cput_e2i([E|Es], NId0, PId, IS, PLvl, Lvl, Res0) -> + case cput_e2i(E, NId0, PId, IS, PLvl, Lvl, Res0) of + [] -> + cput_e2i(Es, NId0, PId, IS, PLvl, Lvl, Res0); + [#cpu{node = N, + processor = P, + processor_node = PN} = CPU|_] = Res1 -> + NId1 = case N > PN of + true -> N; + false -> PN + end, + cput_e2i(Es, NId1, P, CPU, PLvl, Lvl, Res1) + end; +cput_e2i({Tag, [], TagList}, Nid, PId, CPU, PLvl, Lvl, Res) -> + %% Currently [] is the only valid InfoList + cput_e2i({Tag, TagList}, Nid, PId, CPU, PLvl, Lvl, Res); +cput_e2i({node, NL}, Nid0, PId, _CPU, 0, #cpu.node, Res) -> + Nid1 = Nid0+1, + Lvl = cput_e2i_clvl(NL, #cpu.node), + cput_e2i(NL, Nid1, PId, #cpu{node = Nid1}, #cpu.node, Lvl, Res); +cput_e2i({processor, PL}, Nid, PId0, _CPU, 0, #cpu.node, Res) -> + PId1 = PId0+1, + Lvl = cput_e2i_clvl(PL, #cpu.processor), + cput_e2i(PL, Nid, PId1, #cpu{processor = PId1}, #cpu.processor, Lvl, Res); +cput_e2i({processor, PL}, Nid, PId0, CPU, PLvl, CLvl, Res) + when PLvl < #cpu.processor, CLvl =< #cpu.processor -> + PId1 = PId0+1, + Lvl = cput_e2i_clvl(PL, #cpu.processor), + cput_e2i(PL, Nid, PId1, CPU#cpu{processor = PId1, + processor_node = -1, + core = -1, + thread = -1}, #cpu.processor, Lvl, Res); +cput_e2i({node, NL}, Nid0, PId, CPU, #cpu.processor, #cpu.processor_node, + Res) -> + Nid1 = Nid0+1, + Lvl = cput_e2i_clvl(NL, #cpu.processor_node), + cput_e2i(NL, Nid1, PId, CPU#cpu{processor_node = Nid1}, + #cpu.processor_node, Lvl, Res); +cput_e2i({core, CL}, Nid, PId, #cpu{core = C0} = CPU, PLvl, #cpu.core, Res) + when PLvl < #cpu.core -> + Lvl = cput_e2i_clvl(CL, #cpu.core), + cput_e2i(CL, Nid, PId, CPU#cpu{core = C0+1, thread = -1}, #cpu.core, Lvl, + Res); +cput_e2i({thread, TL}, Nid, PId, #cpu{thread = T0} = CPU, PLvl, #cpu.thread, + Res) when PLvl < #cpu.thread -> + Lvl = cput_e2i_clvl(TL, #cpu.thread), + cput_e2i(TL, Nid, PId, CPU#cpu{thread = T0+1}, #cpu.thread, Lvl, Res); +cput_e2i({logical, ID}, _Nid, PId, #cpu{processor=P, core=C, thread=T} = CPU, + PLvl, #cpu.logical, Res) + when PLvl < #cpu.logical, is_integer(ID), 0 =< ID, ID < 65536 -> + [CPU#cpu{processor = case P of -1 -> PId+1; _ -> P end, + core = case C of -1 -> 0; _ -> C end, + thread = case T of -1 -> 0; _ -> T end, + logical = ID} | Res]. + +%% erlang:format_cpu_topology/1 is for internal use only! +%% +%% erlang:system_info(cpu_topology), +%% and erlang:system_info({cpu_topology, Which}) traps to +%% erlang:format_cpu_topology(InternalCpuTopology). +format_cpu_topology(InternalCpuTopology) -> + try cput_i2e(InternalCpuTopology) + catch _ : _ -> erlang:error(internal_error, [InternalCpuTopology]) + end. + + +cput_i2e(undefined) -> undefined; +cput_i2e(Is) -> cput_i2e(Is, true, #cpu.node, cput_i2e_tag_map()). + +cput_i2e([], _Frst, _Lvl, _TM) -> + []; +cput_i2e([#cpu{logical = LID}| _], _Frst, Lvl, _TM) when Lvl == #cpu.logical -> + {logical, LID}; +cput_i2e([#cpu{} = I | Is], Frst, Lvl, TM) -> + cput_i2e(element(Lvl, I), Frst, Is, [I], Lvl, TM). + +cput_i2e(V, Frst, [I | Is], SameV, Lvl, TM) when V =:= element(Lvl, I) -> + cput_i2e(V, Frst, Is, [I | SameV], Lvl, TM); +cput_i2e(-1, true, [], SameV, Lvl, TM) -> + cput_i2e(rvrs(SameV), true, Lvl+1, TM); +cput_i2e(_V, true, [], SameV, Lvl, TM) when Lvl =/= #cpu.processor, + Lvl =/= #cpu.processor_node -> + cput_i2e(rvrs(SameV), true, Lvl+1, TM); +cput_i2e(-1, _Frst, Is, SameV, #cpu.node, TM) -> + cput_i2e(rvrs(SameV), true, #cpu.processor, TM) + ++ cput_i2e(Is, false, #cpu.node, TM); +cput_i2e(_V, _Frst, Is, SameV, Lvl, TM) -> + [{cput_i2e_tag(Lvl, TM), cput_i2e(rvrs(SameV), true, Lvl+1, TM)} + | cput_i2e(Is, false, Lvl, TM)]. + +cput_i2e_tag_map() -> list_to_tuple([cpu | record_info(fields, cpu)]). + +cput_i2e_tag(Lvl, TM) -> + case element(Lvl, TM) of processor_node -> node; Other -> Other end. + +rvrs([_] = L) -> L; +rvrs(Xs) -> rvrs(Xs, []). + +rvrs([],Ys) -> Ys; +rvrs([X|Xs],Ys) -> rvrs(Xs, [X|Ys]). + +%% erlang:await_proc_exit/3 is for internal use only! +%% +%% BIFs that need to await a specific process exit before +%% returning traps to erlang:await_proc_exit/3. +%% +%% NOTE: This function is tightly coupled to +%% the implementation of the +%% erts_bif_prep_await_proc_exit_*() +%% functions in bif.c. Do not make +%% any changes to it without reading +%% the comment about them in bif.c! +await_proc_exit(Proc, Op, Data) -> + Mon = erlang:monitor(process, Proc), + receive + {'DOWN', Mon, process, _Proc, Reason} -> + case Op of + apply -> + {M, F, A} = Data, + erlang:apply(M, F, A); + data -> + Data; + reason -> + Reason + end + end. + +min(A, B) when A > B -> B; +min(A, _) -> A. + +max(A, B) when A < B -> B; +max(A, _) -> A. diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl new file mode 100644 index 0000000000..c6f4c62f63 --- /dev/null +++ b/erts/preloaded/src/init.erl @@ -0,0 +1,1372 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +%% New initial version of init. +%% Booting from a script. The script is fetched either from +%% a local file or distributed from another erlang node. +%% +%% Flags: +%% -id Identity : identity of the system. +%% -boot File : Absolute file name of the boot script. +%% -boot_var Var Value +%% : $Var in the boot script is expanded to +%% Value. +%% -loader LoaderMethod +%% : efile, inet, ose_inet +%% (Optional - default efile) +%% -hosts [Node] : List of hosts from which we can boot. +%% (Mandatory if -loader inet or ose_inet) +%% -mode embedded : Load all modules at startup, no automatic loading +%% -mode interactive : Auto load modules (default system behaviour). +%% -path : Override path in bootfile. +%% -pa Path+ : Add my own paths first. +%% -pz Path+ : Add my own paths last. +%% -run : Start own processes. +%% -s : Start own processes. +%% +%% Experimental flags: +%% -init_debug : Activate debug printouts in init +%% -loader_debug : Activate debug printouts in erl_prim_loader +%% -code_path_choice : strict | relaxed + +-module(init). + +-export([restart/0,reboot/0,stop/0,stop/1, + get_status/0,boot/1,get_arguments/0,get_plain_arguments/0, + get_argument/1,script_id/0]). + +% internal exports +-export([fetch_loaded/0,ensure_loaded/1,make_permanent/2, + notify_when_started/1,wait_until_started/0, + objfile_extension/0, archive_extension/0,code_path_choice/0]). + +-include_lib("kernel/include/file.hrl"). + +-type internal_status() :: 'starting' | 'started' | 'stopping'. + +-record(state, {flags = [], + args = [], + start = [], + kernel = [] :: [{atom(), pid()}], + bootpid :: pid(), + status = {starting, starting} :: {internal_status(), term()}, + script_id = [], + loaded = [], + subscribed = []}). + +-define(ON_LOAD_HANDLER, init__boot__on_load_handler). + +debug(false, _) -> ok; +debug(_, T) -> erlang:display(T). + +-spec get_arguments() -> [{atom(), [string()]}]. +get_arguments() -> + request(get_arguments). + +-spec get_plain_arguments() -> [string()]. +get_plain_arguments() -> + bs2ss(request(get_plain_arguments)). + +-spec get_argument(atom()) -> 'error' | {'ok', [[string()]]}. +get_argument(Arg) -> + request({get_argument, Arg}). + +-spec script_id() -> term(). +script_id() -> + request(script_id). + +bs2as(L0) when is_list(L0) -> + map(fun b2a/1, L0); +bs2as(L) -> + L. + +bs2ss(L0) when is_list(L0) -> + map(fun b2s/1, L0); +bs2ss(L) -> + L. + +-spec get_status() -> {internal_status(), term()}. +get_status() -> + request(get_status). + +-spec fetch_loaded() -> [atom()]. +fetch_loaded() -> + request(fetch_loaded). + +%% Handle dynamic code loading until the +%% real code_server has been started. +-spec ensure_loaded(atom()) -> 'not_allowed' | {'module', atom()}. +ensure_loaded(Module) -> + request({ensure_loaded, Module}). + +make_permanent(Boot,Config) -> + request({make_permanent,Boot,Config}). + +-spec notify_when_started(pid()) -> 'ok' | 'started'. +notify_when_started(Pid) -> + request({notify_when_started,Pid}). + +-spec wait_until_started() -> 'ok'. +wait_until_started() -> + receive + {init,started} -> ok + end. + +request(Req) -> + init ! {self(),Req}, + receive + {init,Rep} -> + Rep + end. + +-spec restart() -> 'ok'. +restart() -> init ! {stop,restart}, ok. + +-spec reboot() -> 'ok'. +reboot() -> init ! {stop,reboot}, ok. + +-spec stop() -> no_return(). +stop() -> init ! {stop,stop}, ok. + +-spec stop(non_neg_integer() | string()) -> no_return(). +stop(Status) -> init ! {stop,{stop,Status}}, ok. + +-spec boot([binary()]) -> no_return(). +boot(BootArgs) -> + register(init, self()), + process_flag(trap_exit, true), + start_on_load_handler_process(), + {Start0,Flags,Args} = parse_boot_args(BootArgs), + Start = map(fun prepare_run_args/1, Start0), + Flags0 = flags_to_atoms_again(Flags), + boot(Start,Flags0,Args). + +prepare_run_args({eval, [Expr]}) -> + {eval,Expr}; +prepare_run_args({_, L=[]}) -> + bs2as(L); +prepare_run_args({_, L=[_]}) -> + bs2as(L); +prepare_run_args({s, [M,F|Args]}) -> + [b2a(M), b2a(F) | bs2as(Args)]; +prepare_run_args({run, [M,F|Args]}) -> + [b2a(M), b2a(F) | bs2ss(Args)]. + +b2a(Bin) when is_binary(Bin) -> + list_to_atom(binary_to_list(Bin)); +b2a(A) when is_atom(A) -> + A. + +b2s(Bin) when is_binary(Bin) -> + binary_to_list(Bin); +b2s(L) when is_list(L) -> + L. + +map(_F, []) -> + []; +map(F, [X|Rest]) -> + [F(X) | map(F, Rest)]. + +flags_to_atoms_again([]) -> + []; +flags_to_atoms_again([{F0,L0}|Rest]) -> + L = L0, + F = b2a(F0), + [{F,L}|flags_to_atoms_again(Rest)]; +flags_to_atoms_again([{F0}|Rest]) -> + F = b2a(F0), + [{F}|flags_to_atoms_again(Rest)]. + +-spec code_path_choice() -> 'relaxed' | 'strict'. +code_path_choice() -> + case get_argument(code_path_choice) of + {ok,[["strict"]]} -> + strict; + {ok,[["relaxed"]]} -> + relaxed; + _Else -> + relaxed + end. + +boot(Start,Flags,Args) -> + BootPid = do_boot(Flags,Start), + State = #state{flags = Flags, + args = Args, + start = Start, + bootpid = BootPid}, + boot_loop(BootPid,State). + +%%% Convert a term to a printable string, if possible. +to_string(X) when is_list(X) -> % assume string + F = flatten(X, []), + case printable_list(F) of + true -> F; + false -> "" + end; +to_string(X) when is_atom(X) -> + atom_to_list(X); +to_string(X) when is_pid(X) -> + pid_to_list(X); +to_string(X) when is_float(X) -> + float_to_list(X); +to_string(X) when is_integer(X) -> + integer_to_list(X); +to_string(_X) -> + "". % can't do anything with it + +%% This is an incorrect and narrow definition of printable characters. +%% The correct one is in io_lib:printable_list/1 +%% +printable_list([H|T]) when is_integer(H), H >= 32, H =< 126 -> + printable_list(T); +printable_list([$\n|T]) -> printable_list(T); +printable_list([$\r|T]) -> printable_list(T); +printable_list([$\t|T]) -> printable_list(T); +printable_list([]) -> true; +printable_list(_) -> false. + +flatten([H|T], Tail) when is_list(H) -> + flatten(H, flatten(T, Tail)); +flatten([H|T], Tail) -> + [H|flatten(T, Tail)]; +flatten([], Tail) -> + Tail. + +things_to_string([X|Rest]) -> + " (" ++ to_string(X) ++ ")" ++ things_to_string(Rest); +things_to_string([]) -> + "". + +halt_string(String, List) -> + HaltString = String ++ things_to_string(List), + if + length(HaltString)<199 -> HaltString; + true -> first198(HaltString, 198) + end. + +first198([H|T], N) when N>0 -> + [H|first198(T, N-1)]; +first198(_, 0) -> + []. + +%% String = string() +%% List = [string() | atom() | pid() | number()] +%% Any other items in List, such as tuples, are ignored when creating +%% the string used as argument to erlang:halt/1. +crash(String, List) -> + halt(halt_string(String, List)). + +%% Status is {InternalStatus,ProvidedStatus} +-spec boot_loop(pid(), #state{}) -> no_return(). +boot_loop(BootPid, State) -> + receive + {BootPid,loaded,ModLoaded} -> + Loaded = State#state.loaded, + boot_loop(BootPid,State#state{loaded = [ModLoaded|Loaded]}); + {BootPid,started,KernelPid} -> + boot_loop(BootPid, new_kernelpid(KernelPid, BootPid, State)); + {BootPid,progress,started} -> + {InS,_} = State#state.status, + notify(State#state.subscribed), + boot_loop(BootPid,State#state{status = {InS,started}, + subscribed = []}); + {BootPid,progress,NewStatus} -> + {InS,_} = State#state.status, + boot_loop(BootPid,State#state{status = {InS,NewStatus}}); + {BootPid,{script_id,Id}} -> + boot_loop(BootPid,State#state{script_id = Id}); + {'EXIT',BootPid,normal} -> + {_,PS} = State#state.status, + notify(State#state.subscribed), + loop(State#state{status = {started,PS}, + subscribed = []}); + {'EXIT',BootPid,Reason} -> + erlang:display({"init terminating in do_boot",Reason}), + crash("init terminating in do_boot", [Reason]); + {'EXIT',Pid,Reason} -> + Kernel = State#state.kernel, + terminate(Pid,Kernel,Reason), %% If Pid is a Kernel pid, halt()! + boot_loop(BootPid,State); + {stop,Reason} -> + stop(Reason,State); + {From,fetch_loaded} -> %% Fetch and reset initially loaded modules. + case whereis(?ON_LOAD_HANDLER) of + undefined -> + %% There is no on_load handler process, + %% probably because init:restart/0 has been + %% called and it is not the first time we + %% pass through here. + ok; + Pid when is_pid(Pid) -> + Pid ! run_on_load, + receive + {'EXIT',Pid,on_load_done} -> + ok; + {'EXIT',Pid,Res} -> + %% Failure to run an on_load handler. + %% This is fatal during start-up. + exit(Res) + end + end, + From ! {init,State#state.loaded}, + garb_boot_loop(BootPid,State#state{loaded = []}); + {From,{ensure_loaded,Module}} -> + {Res, Loaded} = ensure_loaded(Module, State#state.loaded), + From ! {init,Res}, + boot_loop(BootPid,State#state{loaded = Loaded}); + Msg -> + boot_loop(BootPid,handle_msg(Msg,State)) + end. + +ensure_loaded(Module, Loaded) -> + File = concat([Module,objfile_extension()]), + case catch load_mod(Module,File) of + {ok, FullName} -> + {{module, Module}, [{Module, FullName}|Loaded]}; + Res -> + {Res, Loaded} + end. + +%% Tell subscribed processes the system has started. +notify(Pids) -> + lists:foreach(fun(Pid) -> Pid ! {init,started} end, Pids). + +%% Garbage collect all info about initially loaded modules. +%% This information is temporary stored until the code_server +%% is started. +%% We force the garbage collection as the init process holds +%% this information during the initialisation of the system and +%% it will be automatically garbed much later (perhaps not at all +%% if it is not accessed much). + +garb_boot_loop(BootPid,State) -> + garbage_collect(), + boot_loop(BootPid,State). + +new_kernelpid({Name,{ok,Pid}},BootPid,State) when is_pid(Pid) -> + link(Pid), + BootPid ! {self(),ok,Pid}, + Kernel = State#state.kernel, + State#state{kernel = [{Name,Pid}|Kernel]}; +new_kernelpid({_Name,ignore},BootPid,State) -> + BootPid ! {self(),ignore}, + State; +new_kernelpid({Name,What},BootPid,State) -> + erlang:display({"could not start kernel pid",Name,What}), + clear_system(BootPid,State), + crash("could not start kernel pid", [Name, What]). + +%% Here is the main loop after the system has booted. + +loop(State) -> + receive + {'EXIT',Pid,Reason} -> + Kernel = State#state.kernel, + terminate(Pid,Kernel,Reason), %% If Pid is a Kernel pid, halt()! + loop(State); + {stop,Reason} -> + stop(Reason,State); + {From,fetch_loaded} -> %% The Loaded info is cleared in + Loaded = State#state.loaded, %% boot_loop but is handled here + From ! {init,Loaded}, %% anyway. + loop(State); + {From, {ensure_loaded, _}} -> + From ! {init, not_allowed}, + loop(State); + Msg -> + loop(handle_msg(Msg,State)) + end. + +handle_msg(Msg,State0) -> + case catch do_handle_msg(Msg,State0) of + {new_state,State} -> State; + _ -> State0 + end. + +do_handle_msg(Msg,State) -> + #state{flags = Flags, + status = Status, + script_id = Sid, + args = Args, + subscribed = Subscribed} = State, + case Msg of + {From,get_plain_arguments} -> + From ! {init,Args}; + {From,get_arguments} -> + From ! {init,get_arguments(Flags)}; + {From,{get_argument,Arg}} -> + From ! {init,get_argument(Arg,Flags)}; + {From,get_status} -> + From ! {init,Status}; + {From,script_id} -> + From ! {init,Sid}; + {From,{make_permanent,Boot,Config}} -> + {Res,State1} = make_permanent(Boot,Config,Flags,State), + From ! {init,Res}, + {new_state,State1}; + {From,{notify_when_started,Pid}} -> + case Status of + {InS,PS} when InS =:= started ; PS =:= started -> + From ! {init,started}; + _ -> + From ! {init,ok}, + {new_state,State#state{subscribed = [Pid|Subscribed]}} + end; + X -> + case whereis(user) of + undefined -> + catch error_logger ! {info, self(), {self(), X, []}}; + User -> + User ! X, + ok + end + end. + +%%% ------------------------------------------------- +%%% A new release has been installed and made +%%% permanent. +%%% Both restart/0 and reboot/0 shall startup using +%%% the new release. reboot/0 uses new boot script +%%% and configuration file pointed out externally. +%%% In the restart case we have to set new -boot and +%%% -config arguments. +%%% ------------------------------------------------- + +make_permanent(Boot,Config,Flags0,State) -> + case set_flag('-boot',Boot,Flags0) of + {ok,Flags1} -> + case set_flag('-config',Config,Flags1) of + {ok,Flags} -> + {ok,State#state{flags = Flags}}; + Error -> + {Error,State} + end; + Error -> + {Error,State} + end. + +set_flag(_Flag,false,Flags) -> + {ok,Flags}; +set_flag(Flag,Value,Flags) when is_list(Value) -> + case catch list_to_binary(Value) of + {'EXIT',_} -> + {error,badarg}; + AValue -> + {ok,set_argument(Flags,Flag,AValue)} + end; +set_flag(_,_,_) -> + {error,badarg}. + +%%% ------------------------------------------------- +%%% Stop the system. +%%% Reason is: restart | reboot | stop +%%% According to reason terminate emulator or restart +%%% system using the same init process again. +%%% ------------------------------------------------- + +stop(Reason,State) -> + BootPid = State#state.bootpid, + {_,Progress} = State#state.status, + State1 = State#state{status = {stopping, Progress}}, + clear_system(BootPid,State1), + do_stop(Reason,State1). + +do_stop(restart,#state{start = Start, flags = Flags, args = Args}) -> + boot(Start,Flags,Args); +do_stop(reboot,_) -> + halt(); +do_stop(stop,State) -> + stop_heart(State), + halt(); +do_stop({stop,Status},State) -> + stop_heart(State), + halt(Status). + +clear_system(BootPid,State) -> + Heart = get_heart(State#state.kernel), + shutdown_pids(Heart,BootPid,State), + unload(Heart). + +stop_heart(State) -> + case get_heart(State#state.kernel) of + false -> + ok; + Pid -> + %% As heart survives a restart the Parent of heart is init. + BootPid = self(), + %% ignore timeout + shutdown_kernel_pid(Pid, BootPid, self(), State) + end. + +shutdown_pids(Heart,BootPid,State) -> + Timer = shutdown_timer(State#state.flags), + catch shutdown(State#state.kernel,BootPid,Timer,State), + kill_all_pids(Heart), % Even the shutdown timer. + kill_all_ports(Heart), + flush_timout(Timer). + +get_heart([{heart,Pid}|_Kernel]) -> Pid; +get_heart([_|Kernel]) -> get_heart(Kernel); +get_heart(_) -> false. + + +shutdown([{heart,_Pid}|Kernel],BootPid,Timer,State) -> + shutdown(Kernel, BootPid, Timer, State); +shutdown([{_Name,Pid}|Kernel],BootPid,Timer,State) -> + shutdown_kernel_pid(Pid, BootPid, Timer, State), + shutdown(Kernel,BootPid,Timer,State); +shutdown(_,_,_,_) -> + true. + + +%% +%% A kernel pid must handle the special case message +%% {'EXIT',Parent,Reason} and terminate upon it! +%% +shutdown_kernel_pid(Pid, BootPid, Timer, State) -> + Pid ! {'EXIT',BootPid,shutdown}, + shutdown_loop(Pid, Timer, State, []). + +%% +%% We have to handle init requests here in case a process +%% performs such a request and cannot shutdown (deadlock). +%% Keep all other EXIT messages in case it was another +%% kernel process. Resend these messages and handle later. +%% +shutdown_loop(Pid,Timer,State,Exits) -> + receive + {'EXIT',Pid,_} -> + resend(reverse(Exits)), + ok; + {Timer,timeout} -> + erlang:display({init,shutdown_timeout}), + throw(timeout); + {stop,_} -> + shutdown_loop(Pid,Timer,State,Exits); + {From,fetch_loaded} -> + From ! {init,State#state.loaded}, + shutdown_loop(Pid,Timer,State,Exits); + {'EXIT',OtherP,Reason} -> + shutdown_loop(Pid,Timer,State, + [{'EXIT',OtherP,Reason}|Exits]); + Msg -> + State1 = handle_msg(Msg,State), + shutdown_loop(Pid,Timer,State1,Exits) + end. + +resend([ExitMsg|Exits]) -> + self() ! ExitMsg, + resend(Exits); +resend(_) -> + ok. + +%% +%% Kill all existing pids in the system (except init and heart). +kill_all_pids(Heart) -> + case get_pids(Heart) of + [] -> + ok; + Pids -> + kill_em(Pids), + kill_all_pids(Heart) % Continue until all are really killed. + end. + +%% All except zombies. +alive_processes() -> + [P || P <- processes(), erlang:is_process_alive(P)]. + +get_pids(Heart) -> + Pids = alive_processes(), + delete(Heart,self(),Pids). + +delete(Heart,Init,[Heart|Pids]) -> delete(Heart,Init,Pids); +delete(Heart,Init,[Init|Pids]) -> delete(Heart,Init,Pids); +delete(Heart,Init,[Pid|Pids]) -> [Pid|delete(Heart,Init,Pids)]; +delete(_,_,[]) -> []. + +kill_em([Pid|Pids]) -> + exit(Pid,kill), + kill_em(Pids); +kill_em([]) -> + ok. + +%% +%% Kill all existing ports in the system (except the heart port), +%% i.e. ports still existing after all processes have been killed. +%% +%% System ports like the async driver port will nowadays be immortal; +%% therefore, it is ok to send them exit signals... +%% +kill_all_ports(Heart) -> + kill_all_ports(Heart,erlang:ports()). + +kill_all_ports(Heart,[P|Ps]) -> + case erlang:port_info(P,connected) of + {connected,Heart} -> + kill_all_ports(Heart,Ps); + _ -> + exit(P,kill), + kill_all_ports(Heart,Ps) + end; +kill_all_ports(_,_) -> + ok. + +unload(false) -> + do_unload(sub(erlang:pre_loaded(),erlang:loaded())); +unload(_) -> + do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())). + +do_unload([M|Mods]) -> + catch erlang:purge_module(M), + catch erlang:delete_module(M), + catch erlang:purge_module(M), + do_unload(Mods); +do_unload([]) -> + ok. + +sub([H|T],L) -> sub(T,del(H,L)); +sub([],L) -> L. + +del(Item, [Item|T]) -> T; +del(Item, [H|T]) -> [H|del(Item, T)]; +del(_Item, []) -> []. + +%%% ------------------------------------------------- +%%% If the terminated Pid is one of the processes +%%% added to the Kernel, take down the system brutally. +%%% We are not sure that ANYTHING can work anymore, +%%% i.e. halt the system. +%%% Sleep awhile, it is thus possible for the +%%% error_logger (if it is still alive) to write errors +%%% using the simplest method. +%%% ------------------------------------------------- + +terminate(Pid,Kernel,Reason) -> + case kernel_pid(Pid,Kernel) of + {ok,Name} -> + sleep(500), %% Flush error printouts! + erlang:display({"Kernel pid terminated",Name,Reason}), + crash("Kernel pid terminated", [Name, Reason]); + _ -> + false + end. + +kernel_pid(Pid,[{Name,Pid}|_]) -> + {ok,Name}; +kernel_pid(Pid,[_|T]) -> + kernel_pid(Pid,T); +kernel_pid(_,_) -> + false. + +sleep(T) -> receive after T -> ok end. + +%%% ------------------------------------------------- +%%% Start the loader. +%%% The loader shall run for ever! +%%% ------------------------------------------------- + +start_prim_loader(Init,Id,Pgm,Nodes,Path,{Pa,Pz}) -> + case erl_prim_loader:start(Id,Pgm,Nodes) of + {ok,Pid} when Path =:= false -> + InitPath = append(Pa,["."|Pz]), + erl_prim_loader:set_path(InitPath), + add_to_kernel(Init,Pid), + Pid; + {ok,Pid} -> + erl_prim_loader:set_path(Path), + add_to_kernel(Init,Pid), + Pid; + {error,Reason} -> + erlang:display({"cannot start loader",Reason}), + exit(Reason) + end. + +add_to_kernel(Init,Pid) -> + Init ! {self(),started,{erl_prim_loader,{ok,Pid}}}, + receive + {Init,ok,Pid} -> + unlink(Pid), + ok + end. + +prim_load_flags(Flags) -> + PortPgm = get_flag('-loader',Flags,<<"efile">>), + Hosts = get_flag_list('-hosts', Flags, []), + Id = get_flag('-id',Flags,none), + Path = get_flag_list('-path',Flags,false), + {PortPgm, Hosts, Id, Path}. + +%%% ------------------------------------------------- +%%% The boot process fetches a boot script and loads +%%% all modules specified and starts spec. processes. +%%% Processes specified with -s or -run are finally started. +%%% ------------------------------------------------- + +do_boot(Flags,Start) -> + Self = self(), + spawn_link(fun() -> do_boot(Self,Flags,Start) end). + +do_boot(Init,Flags,Start) -> + process_flag(trap_exit,true), + {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags), + Root = b2s(get_flag('-root',Flags)), + PathFls = path_flags(Flags), + Pgm = b2s(Pgm0), + _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes), + bs2ss(Path),PathFls), + BootFile = bootfile(Flags,Root), + BootList = get_boot(BootFile,Root), + LoadMode = b2a(get_flag('-mode',Flags,false)), + Deb = b2a(get_flag('-init_debug',Flags,false)), + BootVars = get_flag_args('-boot_var',Flags), + ParallelLoad = + (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0), + + PathChoice = code_path_choice(), + eval_script(BootList,Init,PathFls,{Root,BootVars},Path, + {true,LoadMode,ParallelLoad},Deb,PathChoice), + + %% To help identifying Purify windows that pop up, + %% print the node name into the Purify log. + (catch erlang:system_info({purify, "Node: " ++ atom_to_list(node())})), + + start_em(Start). + +bootfile(Flags,Root) -> + b2s(get_flag('-boot',Flags,concat([Root,"/bin/start"]))). + +path_flags(Flags) -> + Pa = append(reverse(get_flag_args('-pa',Flags))), + Pz = append(get_flag_args('-pz',Flags)), + {bs2ss(Pa),bs2ss(Pz)}. + +get_boot(BootFile0,Root) -> + BootFile = concat([BootFile0,".boot"]), + case get_boot(BootFile) of + {ok, CmdList} -> + CmdList; + not_found -> %% Check for default. + BootF = concat([Root,"/bin/",BootFile]), + case get_boot(BootF) of + {ok, CmdList} -> + CmdList; + not_found -> + exit({'cannot get bootfile',list_to_atom(BootFile)}); + _ -> + exit({'bootfile format error',list_to_atom(BootF)}) + end; + _ -> + exit({'bootfile format error',list_to_atom(BootFile)}) + end. + +get_boot(BootFile) -> + case erl_prim_loader:get_file(BootFile) of + {ok,Bin,_} -> + case binary_to_term(Bin) of + {script,Id,CmdList} when is_list(CmdList) -> + init ! {self(),{script_id,Id}}, % ;-) + {ok, CmdList}; + _ -> + error + end; + _ -> + not_found + end. + +%% +%% Eval a boot script. +%% Load modules and start processes. +%% If a start command does not spawn a new process the +%% boot process hangs (we want to ensure syncronicity). +%% + +eval_script([{progress,Info}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + debug(Deb,{progress,Info}), + init ! {self(),progress,Info}, + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([{preLoaded,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([{path,Path}|CfgL],Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice) -> + RealPath0 = make_path(Pa, Pz, Path, Vars), + RealPath = patch_path(RealPath0, PathChoice), + erl_prim_loader:set_path(RealPath), + eval_script(CfgL,Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice); +eval_script([{path,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + %% Ignore, use the command line -path flag. + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,embedded,Par},Deb,PathChoice) -> + eval_script(CfgL,Init,PathFs,Vars,P,{true,embedded,Par},Deb,PathChoice); +eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,E,Par},Deb,PathChoice) -> + eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice); +eval_script([{primLoad,Mods}|CfgL],Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice) + when is_list(Mods) -> + if + Par =:= true -> + par_load_modules(Mods,Init); + true -> + load_modules(Mods) + end, + eval_script(CfgL,Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice); +eval_script([{primLoad,_Mods}|CfgL],Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice) -> + %% Do not load now, code_server does that dynamically! + eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice); +eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|CfgL],Init, + PathFs,Vars,P,Ph,Deb,PathChoice) -> + debug(Deb,{start,Server}), + start_in_kernel(Server,Mod,Fun,Args,Init), + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([{apply,{Mod,Fun,Args}}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + debug(Deb,{apply,{Mod,Fun,Args}}), + apply(Mod,Fun,Args), + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([],_,_,_,_,_,_,_) -> + ok; +eval_script(What,_,_,_,_,_,_,_) -> + exit({'unexpected command in bootfile',What}). + +load_modules([Mod|Mods]) -> + File = concat([Mod,objfile_extension()]), + {ok,Full} = load_mod(Mod,File), + init ! {self(),loaded,{Mod,Full}}, %% Tell init about loaded module + load_modules(Mods); +load_modules([]) -> + ok. + +%%% An optimization: erl_prim_loader gets the chance of loading many +%%% files in parallel, using threads. This will reduce the seek times, +%%% and loaded code can be processed while other threads are waiting +%%% for the disk. The optimization is not tried unless the loader is +%%% "efile" and there is a non-empty pool of threads. +%%% +%%% Many threads are needed to get a good result, so it would be +%%% beneficial to load several applications in parallel. However, +%%% measurements show that the file system handles one directory at a +%%% time, regardless if parallel threads are created for files on +%%% several directories (a guess: writing the meta information when +%%% the file was last read ('mtime'), forces the file system to sync +%%% between directories). + +par_load_modules(Mods,Init) -> + Ext = objfile_extension(), + ModFiles = [{Mod,concat([Mod,Ext])} || Mod <- Mods, + not erlang:module_loaded(Mod)], + Self = self(), + Fun = fun(Mod, BinCode, FullName) -> + case catch load_mod_code(Mod, BinCode, FullName) of + {ok, _} -> + Init ! {Self,loaded,{Mod,FullName}}, + ok; + _EXIT -> + {error, Mod} + end + end, + case erl_prim_loader:get_files(ModFiles, Fun) of + ok -> + ok; + {error,Mod} -> + exit({'cannot load',Mod,get_files}) + end. + +make_path(Pa, Pz, Path, Vars) -> + append([Pa,append([fix_path(Path,Vars),Pz])]). + +%% For all Paths starting with $ROOT add rootdir and for those +%% starting with $xxx/, expand $xxx to the value supplied with -boot_var! +%% If $xxx cannot be expanded this process terminates. + +fix_path([Path|Ps], Vars) when is_atom(Path) -> + [add_var(atom_to_list(Path), Vars)|fix_path(Ps, Vars)]; +fix_path([Path|Ps], Vars) -> + [add_var(Path, Vars)|fix_path(Ps, Vars)]; +fix_path(_, _) -> + []. + +add_var("$ROOT/" ++ Path, {Root,_}) -> + concat([Root, "/", Path]); +add_var([$$|Path0], {_,VarList}) -> + {Var,Path} = extract_var(Path0,[]), + Value = b2s(get_var_value(list_to_binary(Var),VarList)), + concat([Value, "/", Path]); +add_var(Path, _) -> + Path. + +extract_var([$/|Path],Var) -> {reverse(Var),Path}; +extract_var([H|T],Var) -> extract_var(T,[H|Var]); +extract_var([],Var) -> {reverse(Var),[]}. + +%% get_var_value(Var, [Vars]) where Vars == [atom()] +get_var_value(Var,[Vars|VarList]) -> + case get_var_val(Var,Vars) of + {ok, Value} -> + Value; + _ -> + get_var_value(Var,VarList) + end; +get_var_value(Var,[]) -> + exit(list_to_atom(concat(["cannot expand \$", Var, " in bootfile"]))). + +get_var_val(Var,[Var,Value|_]) -> {ok, Value}; +get_var_val(Var,[_,_|Vars]) -> get_var_val(Var,Vars); +get_var_val(_,_) -> false. + +patch_path(Dirs, strict) -> + Dirs; +patch_path(Dirs, relaxed) -> + ArchiveExt = archive_extension(), + [patch_dir(Dir, ArchiveExt) || Dir <- Dirs]. + +patch_dir(Orig, ArchiveExt) -> + case funny_split(Orig, $/) of + ["nibe", RevApp, RevArchive | RevTop] -> + App = reverse(RevApp), + case funny_splitwith(RevArchive, $.) of + {Ext, Base} when Ext =:= ArchiveExt, Base =:= App -> + %% Orig archive + Top = reverse([reverse(C) || C <- RevTop]), + Dir = join(Top ++ [App, "ebin"], "/"), + Archive = Orig; + _ -> + %% Orig directory + Top = reverse([reverse(C) || C <- [RevArchive | RevTop]]), + Archive = join(Top ++ [App ++ ArchiveExt, App, "ebin"], "/"), + Dir = Orig + end, + %% First try dir, second try archive and at last use orig if both fails + case erl_prim_loader:read_file_info(Dir) of + {ok, #file_info{type = directory}} -> + Dir; + _ -> + case erl_prim_loader:read_file_info(Archive) of + {ok, #file_info{type = directory}} -> + Archive; + _ -> + Orig + end + end; + _ -> + Orig + end. + +%% Returns all lists in reverse order +funny_split(List, Sep) -> + funny_split(List, Sep, [], []). + +funny_split([Sep | Tail], Sep, Path, Paths) -> + funny_split(Tail, Sep, [], [Path | Paths]); +funny_split([Head | Tail], Sep, Path, Paths) -> + funny_split(Tail, Sep, [Head | Path], Paths); +funny_split([], _Sep, Path, Paths) -> + [Path | Paths]. + +%% Returns {BeforeSep, AfterSep} where BeforeSep is in reverse order +funny_splitwith(List, Sep) -> + funny_splitwith(List, Sep, [], List). + +funny_splitwith([Sep | Tail], Sep, Acc, _Orig) -> + {Acc, Tail}; +funny_splitwith([Head | Tail], Sep, Acc, Orig) -> + funny_splitwith(Tail, Sep, [Head | Acc], Orig); +funny_splitwith([], _Sep, _Acc, Orig) -> + {[], Orig}. + +-spec join([string()], string()) -> string(). +join([H1, H2 | T], S) -> + H1 ++ S ++ join([H2 | T], S); +join([H], _) -> + H. + +%% Servers that are located in the init kernel are linked +%% and supervised by init. + +start_in_kernel(Server,Mod,Fun,Args,Init) -> + Res = apply(Mod,Fun,Args), + Init ! {self(),started,{Server,Res}}, + receive + {Init,ok,Pid} -> + unlink(Pid), %% Just for sure... + ok; + {Init,ignore} -> + ignore + end. + +%% Do start all processes specified at command line using -s! +%% Use apply here instead of spawn to ensure syncronicity for +%% those servers that wish to have it so. +%% Disadvantage: anything started with -s that does not +%% eventually spawn will hang the startup routine. + +%% We also handle -eval here. The argument is an arbitrary +%% expression that should be parsed and evaluated. + +start_em([S|Tail]) -> + case whereis(user) of + undefined -> + ok; + P when is_pid(P) -> %Let's set the group_leader() + erlang:group_leader(P, self()) + end, + start_it(S), + start_em(Tail); +start_em([]) -> ok. + +start_it([]) -> + ok; +start_it({eval,Bin}) -> + Str = binary_to_list(Bin), + {ok,Ts,_} = erl_scan:string(Str), + Ts1 = case reverse(Ts) of + [{dot,_}|_] -> Ts; + TsR -> reverse([{dot,1} | TsR]) + end, + {ok,Expr} = erl_parse:parse_exprs(Ts1), + erl_eval:exprs(Expr, []), + ok; +start_it([_|_]=MFA) -> + Ref = make_ref(), + case catch {Ref,case MFA of + [M] -> M:start(); + [M,F] -> M:F(); + [M,F|Args] -> M:F(Args) % Args is a list + end} of + {Ref,R} -> + R; + {'EXIT',Reason} -> + exit(Reason); + Other -> + throw(Other) + end. + +%% +%% Fetch a module and load it into the system. +%% +load_mod(Mod, File) -> + case erlang:module_loaded(Mod) of + false -> + case erl_prim_loader:get_file(File) of + {ok,BinCode,FullName} -> + load_mod_code(Mod, BinCode, FullName); + _ -> + exit({'cannot load',Mod,get_file}) + end; + _ -> % Already loaded. + {ok,File} + end. + +load_mod_code(Mod, BinCode, FullName) -> + case erlang:module_loaded(Mod) of + false -> + case erlang:load_module(Mod, BinCode) of + {module,Mod} -> {ok,FullName}; + {error,on_load} -> + ?ON_LOAD_HANDLER ! {loaded,Mod}, + {ok,FullName}; + Other -> + exit({'cannot load',Mod,Other}) + end; + _ -> % Already loaded. + {ok,FullName} + end. + +%% -------------------------------------------------------- +%% If -shutdown_time is specified at the command line +%% this timer will inform the init process that it has to +%% force processes to terminate. It cannot be handled +%% softly any longer. +%% -------------------------------------------------------- + +shutdown_timer(Flags) -> + case get_flag('-shutdown_time',Flags,infinity) of + infinity -> + self(); + Time -> + case catch list_to_integer(binary_to_list(Time)) of + T when is_integer(T) -> + Pid = spawn(fun() -> timer(T) end), + receive + {Pid, started} -> + Pid + end; + _ -> + self() + end + end. + +flush_timout(Pid) -> + receive + {Pid, timeout} -> true + after 0 -> true + end. + +timer(T) -> + init ! {self(), started}, + receive + after T -> + init ! {self(), timeout} + end. + +%% -------------------------------------------------------- +%% Parse the command line arguments and extract things to start, flags +%% and other arguments. We keep the relative of the groups. +%% -------------------------------------------------------- + +parse_boot_args(Args) -> + parse_boot_args(Args, [], [], []). + +parse_boot_args([B|Bs], Ss, Fs, As) -> + case check(B) of + start_extra_arg -> + {reverse(Ss),reverse(Fs),lists:reverse(As, Bs)}; % BIF + start_arg -> + {S,Rest} = get_args(Bs, []), + parse_boot_args(Rest, [{s, S}|Ss], Fs, As); + start_arg2 -> + {S,Rest} = get_args(Bs, []), + parse_boot_args(Rest, [{run, S}|Ss], Fs, As); + eval_arg -> + {Expr,Rest} = get_args(Bs, []), + parse_boot_args(Rest, [{eval, Expr}|Ss], Fs, As); + flag -> + {F,Rest} = get_args(Bs, []), + Fl = case F of + [] -> [B]; + FF -> [B,FF] + end, + parse_boot_args(Rest, Ss, + [list_to_tuple(Fl)|Fs], As); + arg -> + parse_boot_args(Bs, Ss, Fs, [B|As]); + end_args -> + parse_boot_args(Bs, Ss, Fs, As) + end; +parse_boot_args([], Start, Flags, Args) -> + {reverse(Start),reverse(Flags),reverse(Args)}. + +check(<<"-extra">>) -> start_extra_arg; +check(<<"-s">>) -> start_arg; +check(<<"-run">>) -> start_arg2; +check(<<"-eval">>) -> eval_arg; +check(<<"--">>) -> end_args; +check(X) when is_binary(X) -> + case binary_to_list(X) of + [$-|_Rest] -> flag; + _Chars -> arg %Even empty atoms + end; +check(_X) -> arg. %This should never occur + +get_args([B|Bs], As) -> + case check(B) of + start_extra_arg -> {reverse(As), [B|Bs]}; + start_arg -> {reverse(As), [B|Bs]}; + start_arg2 -> {reverse(As), [B|Bs]}; + eval_arg -> {reverse(As), [B|Bs]}; + end_args -> {reverse(As), Bs}; + flag -> {reverse(As), [B|Bs]}; + arg -> + get_args(Bs, [B|As]) + end; +get_args([], As) -> {reverse(As),[]}. + +%% +%% Internal get_flag function, with default value. +%% Return: true if flag given without args +%% atom() if a single arg was given. +%% list(atom()) if several args were given. +%% +get_flag(F,Flags,Default) -> + case catch get_flag(F,Flags) of + {'EXIT',_} -> + Default; + Value -> + Value + end. + +get_flag(F,Flags) -> + case search(F,Flags) of + {value,{F,[V]}} -> + V; + {value,{F,V}} -> + V; + {value,{F}} -> % Flag given! + true; + _ -> + exit(list_to_atom(concat(["no ",F," flag"]))) + end. + +%% +%% Internal get_flag function, with default value. +%% Return: list(atom()) +%% +get_flag_list(F,Flags,Default) -> + case catch get_flag_list(F,Flags) of + {'EXIT',_} -> + Default; + Value -> + Value + end. + +get_flag_list(F,Flags) -> + case search(F,Flags) of + {value,{F,V}} -> + V; + _ -> + exit(list_to_atom(concat(["no ",F," flag"]))) + end. + +%% +%% Internal get_flag function. +%% Fetch all occurrences of flag. +%% Return: [Args,Args,...] where Args ::= list(atom()) +%% +get_flag_args(F,Flags) -> get_flag_args(F,Flags,[]). + +get_flag_args(F,[{F,V}|Flags],Acc) when is_list(V) -> + get_flag_args(F,Flags,[V|Acc]); +get_flag_args(F,[{F,V}|Flags],Acc) -> + get_flag_args(F,Flags,[[V]|Acc]); +get_flag_args(F,[_|Flags],Acc) -> + get_flag_args(F,Flags,Acc); +get_flag_args(_,[],Acc) -> + reverse(Acc). + +get_arguments([{F,V}|Flags]) -> + [$-|Fl] = atom_to_list(F), + [{list_to_atom(Fl),to_strings(V)}|get_arguments(Flags)]; +get_arguments([{F}|Flags]) -> + [$-|Fl] = atom_to_list(F), + [{list_to_atom(Fl),[]}|get_arguments(Flags)]; +get_arguments([]) -> + []. + +to_strings([H|T]) when is_atom(H) -> [atom_to_list(H)|to_strings(T)]; +to_strings([H|T]) when is_binary(H) -> [binary_to_list(H)|to_strings(T)]; +to_strings([]) -> []. + +get_argument(Arg,Flags) -> + Args = get_arguments(Flags), + case get_argument1(Arg,Args) of + [] -> + error; + Value -> + {ok,Value} + end. + +get_argument1(Arg,[{Arg,V}|Args]) -> + [V|get_argument1(Arg,Args)]; +get_argument1(Arg,[_|Args]) -> + get_argument1(Arg,Args); +get_argument1(_,[]) -> + []. + +set_argument([{Flag,_}|Flags],Flag,Value) -> + [{Flag,[Value]}|Flags]; +set_argument([{Flag}|Flags],Flag,Value) -> + [{Flag,[Value]}|Flags]; +set_argument([Item|Flags],Flag,Value) -> + [Item|set_argument(Flags,Flag,Value)]; +set_argument([],Flag,Value) -> + [{Flag,[Value]}]. + +concat([A|T]) when is_atom(A) -> + atom_to_list(A) ++ concat(T); +concat([C|T]) when is_integer(C), 0 =< C, C =< 255 -> + [C|concat(T)]; +concat([Bin|T]) when is_binary(Bin) -> + binary_to_list(Bin) ++ concat(T); +concat([S|T]) -> + S ++ concat(T); +concat([]) -> + []. + +append(L, Z) -> L ++ Z. + +append([E]) -> E; +append([H|T]) -> + H ++ append(T); +append([]) -> []. + +reverse([] = L) -> + L; +reverse([_] = L) -> + L; +reverse([A, B]) -> + [B, A]; +reverse([A, B | L]) -> + lists:reverse(L, [B, A]). % BIF + +search(Key, [H|_T]) when is_tuple(H), element(1, H) =:= Key -> + {value, H}; +search(Key, [_|T]) -> + search(Key, T); +search(_Key, []) -> + false. + +-spec objfile_extension() -> nonempty_string(). +objfile_extension() -> + ".beam". +%% case erlang:system_info(machine) of +%% "JAM" -> ".jam"; +%% "VEE" -> ".vee"; +%% "BEAM" -> ".beam" +%% end. + +-spec archive_extension() -> nonempty_string(). +archive_extension() -> + ".ez". + +%%% +%%% Support for handling of on_load functions. +%%% + +start_on_load_handler_process() -> + register(?ON_LOAD_HANDLER, + spawn_link(fun on_load_handler_init/0)). + +on_load_handler_init() -> + on_load_loop([]). + +on_load_loop(Mods) -> + receive + {loaded,Mod} -> + on_load_loop([Mod|Mods]); + run_on_load -> + run_on_load_handlers(Mods), + exit(on_load_done) + end. + +run_on_load_handlers([M|Ms]) -> + Fun = fun() -> + Res = erlang:call_on_load_function(M), + exit(Res) + end, + {Pid,Ref} = spawn_monitor(Fun), + receive + {'DOWN',Ref,process,Pid,OnLoadRes} -> + Keep = if + is_boolean(OnLoadRes) -> OnLoadRes; + true -> false + end, + erlang:finish_after_on_load(M, Keep), + case Keep of + false -> + exit({on_load_function_failed,M}); + true -> + run_on_load_handlers(Ms) + end + end; +run_on_load_handlers([]) -> ok. diff --git a/erts/preloaded/src/otp_ring0.erl b/erts/preloaded/src/otp_ring0.erl new file mode 100644 index 0000000000..3b0d562d1f --- /dev/null +++ b/erts/preloaded/src/otp_ring0.erl @@ -0,0 +1,35 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(otp_ring0). + +%% Purpose : Start up of erlang system. + +-export([start/2]). + +start(_Env, Argv) -> + run(init, boot, Argv). + +run(M, F, A) -> + case erlang:function_exported(M, F, 1) of + false -> + erlang:display({fatal,error,module,M,"does not export",F,"/1"}), + halt(1); + true -> + M:F(A) + end. diff --git a/erts/preloaded/src/prim_file.erl b/erts/preloaded/src/prim_file.erl new file mode 100644 index 0000000000..43e6f6cd88 --- /dev/null +++ b/erts/preloaded/src/prim_file.erl @@ -0,0 +1,1168 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(prim_file). + +%% Interface module to the file driver. + + + +%%% Interface towards a single file's contents. Uses ?FD_DRV. + +%% Generic file contents operations +-export([open/2, close/1, sync/1, position/2, truncate/1, + write/2, pwrite/2, pwrite/3, read/2, read_line/1, pread/2, pread/3, copy/3]). + +%% Specialized file operations +-export([open/1, open/3]). +-export([read_file/1, read_file/2, write_file/2]). +-export([ipread_s32bu_p32bu/3]). + + + +%%% Interface towards file system and metadata. Uses ?DRV. + +%% Takes an optional port (opens a ?DRV port per default) as first argument. +-export([get_cwd/0, get_cwd/1, get_cwd/2, + set_cwd/1, set_cwd/2, + delete/1, delete/2, + rename/2, rename/3, + make_dir/1, make_dir/2, + del_dir/1, del_dir/2, + read_file_info/1, read_file_info/2, + altname/1, altname/2, + write_file_info/2, write_file_info/3, + make_link/2, make_link/3, + make_symlink/2, make_symlink/3, + read_link/1, read_link/2, + read_link_info/1, read_link_info/2, + list_dir/1, list_dir/2]). +%% How to start and stop the ?DRV port. +-export([start/0, stop/1]). + +%% Debug exports +-export([open_int/4, open_mode/1, open_mode/4]). + +%%%----------------------------------------------------------------- +%%% Includes and defines + +-include("file.hrl"). + +-define(DRV, efile). +-define(FD_DRV, efile). + +-define(LARGEFILESIZE, (1 bsl 63)). + +%% Driver commands +-define(FILE_OPEN, 1). +-define(FILE_READ, 2). +-define(FILE_LSEEK, 3). +-define(FILE_WRITE, 4). +-define(FILE_FSTAT, 5). +-define(FILE_PWD, 6). +-define(FILE_READDIR, 7). +-define(FILE_CHDIR, 8). +-define(FILE_FSYNC, 9). +-define(FILE_MKDIR, 10). +-define(FILE_DELETE, 11). +-define(FILE_RENAME, 12). +-define(FILE_RMDIR, 13). +-define(FILE_TRUNCATE, 14). +-define(FILE_READ_FILE, 15). +-define(FILE_WRITE_INFO, 16). +-define(FILE_LSTAT, 19). +-define(FILE_READLINK, 20). +-define(FILE_LINK, 21). +-define(FILE_SYMLINK, 22). +-define(FILE_CLOSE, 23). +-define(FILE_PWRITEV, 24). +-define(FILE_PREADV, 25). +-define(FILE_SETOPT, 26). +-define(FILE_IPREAD, 27). +-define(FILE_ALTNAME, 28). +-define(FILE_READ_LINE, 29). + +%% Driver responses +-define(FILE_RESP_OK, 0). +-define(FILE_RESP_ERROR, 1). +-define(FILE_RESP_DATA, 2). +-define(FILE_RESP_NUMBER, 3). +-define(FILE_RESP_INFO, 4). +-define(FILE_RESP_NUMERR, 5). +-define(FILE_RESP_LDATA, 6). +-define(FILE_RESP_N2DATA, 7). +-define(FILE_RESP_EOF, 8). + +%% Open modes for the driver's open function. +-define(EFILE_MODE_READ, 1). +-define(EFILE_MODE_WRITE, 2). +-define(EFILE_MODE_READ_WRITE, 3). +-define(EFILE_MODE_APPEND, 4). +-define(EFILE_COMPRESSED, 8). + +%% Use this mask to get just the mode bits to be passed to the driver. +-define(EFILE_MODE_MASK, 15). + +%% Seek modes for the driver's seek function. +-define(EFILE_SEEK_SET, 0). +-define(EFILE_SEEK_CUR, 1). +-define(EFILE_SEEK_END, 2). + +%% Options +-define(FILE_OPT_DELAYED_WRITE, 0). +-define(FILE_OPT_READ_AHEAD, 1). + +%% IPREAD variants +-define(IPREAD_S32BU_P32BU, 0). + + + +%%%----------------------------------------------------------------- +%%% Functions operating on a file through a handle. ?FD_DRV. +%%% +%%% Generic file contents operations. +%%% +%%% Supposed to be called by applications through module file. + + +%% Opens a file using the driver port Port. Returns {error, Reason} +%% | {ok, FileDescriptor} +open(Port, File, ModeList) when is_port(Port), + is_list(File), + is_list(ModeList) -> + case open_mode(ModeList) of + {Mode, _Portopts, _Setopts} -> + open_int(Port, File, Mode, []); + Reason -> + {error, Reason} + end; +open(_,_,_) -> + {error, badarg}. + +%% Opens a file. Returns {error, Reason} | {ok, FileDescriptor}. +open(File, ModeList) when is_list(File), is_list(ModeList) -> + case open_mode(ModeList) of + {Mode, Portopts, Setopts} -> + open_int({?FD_DRV, Portopts}, File, Mode, Setopts); + Reason -> + {error, Reason} + end; +open(_, _) -> + {error, badarg}. + +%% Opens a port that can be used for open/3 or read_file/2. +%% Returns {ok, Port} | {error, Reason}. +open(Portopts) when is_list(Portopts) -> + case drv_open(?FD_DRV, Portopts) of + {error, _} = Error -> + Error; + Other -> + Other + end; +open(_) -> + {error, badarg}. + +open_int({Driver, Portopts}, File, Mode, Setopts) -> + case drv_open(Driver, Portopts) of + {ok, Port} -> + open_int(Port, File, Mode, Setopts); + {error, _} = Error -> + Error + end; +open_int(Port, File, Mode, Setopts) -> + M = Mode band ?EFILE_MODE_MASK, + case drv_command(Port, [<>, File, 0]) of + {ok, Number} -> + open_int_setopts(Port, Number, Setopts); + Error -> + drv_close(Port), + Error + end. + +open_int_setopts(Port, Number, []) -> + {ok, #file_descriptor{module = ?MODULE, data = {Port, Number}}}; +open_int_setopts(Port, Number, [Cmd | Tail]) -> + case drv_command(Port, Cmd) of + ok -> + open_int_setopts(Port, Number, Tail); + Error -> + drv_close(Port), + Error + end. + + + +%% Returns ok. + +close(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> + case drv_command(Port, <>) of + ok -> + drv_close(Port); + Error -> + Error + end; +%% Closes a port opened with open/1. +close(Port) when is_port(Port) -> + drv_close(Port). + + + +%% Returns {error, Reason} | ok. +write(#file_descriptor{module = ?MODULE, data = {Port, _}}, Bytes) -> + case drv_command(Port, [?FILE_WRITE,Bytes]) of + {ok, _Size} -> + ok; + Error -> + Error + end. + +%% Returns ok | {error, {WrittenCount, Reason}} +pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, L) + when is_list(L) -> + pwrite_int(Port, L, 0, [], []). + +pwrite_int(_, [], 0, [], []) -> + ok; +pwrite_int(Port, [], N, Spec, Data) -> + Header = list_to_binary([<> | reverse(Spec)]), + case drv_command_raw(Port, [Header | reverse(Data)]) of + {ok, _Size} -> + ok; + Error -> + Error + end; +pwrite_int(Port, [{Offs, Bytes} | T], N, Spec, Data) + when is_integer(Offs) -> + if + -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE -> + pwrite_int(Port, T, N, Spec, Data, Offs, Bytes); + true -> + {error, einval} + end; +pwrite_int(_, [_|_], _N, _Spec, _Data) -> + {error, badarg}. + +pwrite_int(Port, T, N, Spec, Data, Offs, Bin) + when is_binary(Bin) -> + Size = byte_size(Bin), + pwrite_int(Port, T, N+1, + [<> | Spec], + [Bin | Data]); +pwrite_int(Port, T, N, Spec, Data, Offs, Bytes) -> + try list_to_binary(Bytes) of + Bin -> + pwrite_int(Port, T, N, Spec, Data, Offs, Bin) + catch + error:Reason -> + {error, Reason} + end. + + + +%% Returns {error, Reason} | ok. +pwrite(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Bytes) + when is_integer(Offs) -> + if + -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE -> + case pwrite_int(Port, [], 0, [], [], Offs, Bytes) of + {error, {_, Reason}} -> + {error, Reason}; + Result -> + Result + end; + true -> + {error, einval} + end; +pwrite(#file_descriptor{module = ?MODULE}, _, _) -> + {error, badarg}. + + + +%% Returns {error, Reason} | ok. +sync(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> + drv_command(Port, [?FILE_FSYNC]). + +%% Returns {ok, Data} | eof | {error, Reason}. +read_line(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> + case drv_command(Port, <>) of + {ok, {0, _Data}} -> + eof; + {ok, {_Size, Data}} -> + {ok, Data}; + {error, enomem} -> + erlang:garbage_collect(), + case drv_command(Port, <>) of + {ok, {0, _Data}} -> + eof; + {ok, {_Size, Data}} -> + {ok, Data}; + Other -> + Other + end; + Error -> + Error + end. + +%% Returns {ok, Data} | eof | {error, Reason}. +read(#file_descriptor{module = ?MODULE, data = {Port, _}}, Size) + when is_integer(Size), 0 =< Size -> + if + Size < ?LARGEFILESIZE -> + case drv_command(Port, <>) of + {ok, {0, _Data}} when Size =/= 0 -> + eof; + {ok, {_Size, Data}} -> + {ok, Data}; + {error, enomem} -> + %% Garbage collecting here might help if + %% the current processes has some old binaries left. + erlang:garbage_collect(), + case drv_command(Port, <>) of + {ok, {0, _Data}} when Size =/= 0 -> + eof; + {ok, {_Size, Data}} -> + {ok, Data}; + Other -> + Other + end; + Error -> + Error + end; + true -> + {error, einval} + end. + +%% Returns {ok, [Data|eof, ...]} | {error, Reason} +pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, L) + when is_list(L) -> + pread_int(Port, L, 0, []). + +pread_int(_, [], 0, []) -> + {ok, []}; +pread_int(Port, [], N, Spec) -> + drv_command(Port, [<> | reverse(Spec)]); +pread_int(Port, [{Offs, Size} | T], N, Spec) + when is_integer(Offs), is_integer(Size), 0 =< Size -> + if + -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE, + Size < ?LARGEFILESIZE -> + pread_int(Port, T, N+1, [<> | Spec]); + true -> + {error, einval} + end; +pread_int(_, [_|_], _N, _Spec) -> + {error, badarg}. + + + +%% Returns {ok, Data} | eof | {error, Reason}. +pread(#file_descriptor{module = ?MODULE, data = {Port, _}}, Offs, Size) + when is_integer(Offs), is_integer(Size), 0 =< Size -> + if + -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE, + Size < ?LARGEFILESIZE -> + case drv_command(Port, + <>) of + {ok, [eof]} -> + eof; + {ok, [Data]} -> + {ok, Data}; + Error -> + Error + end; + true -> + {error, einval} + end; +pread(#file_descriptor{module = ?MODULE, data = {_, _}}, _, _) -> + {error, badarg}. + + + +%% Returns {ok, Position} | {error, Reason}. +position(#file_descriptor{module = ?MODULE, data = {Port, _}}, At) -> + case lseek_position(At) of + {Offs, Whence} + when -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE -> + drv_command(Port, <>); + {_, _} -> + {error, einval}; + Reason -> + {error, Reason} + end. + +%% Returns {error, Reaseon} | ok. +truncate(#file_descriptor{module = ?MODULE, data = {Port, _}}) -> + drv_command(Port, <>). + + + +%% Returns {error, Reason} | {ok, BytesCopied} +copy(#file_descriptor{module = ?MODULE} = Source, + #file_descriptor{module = ?MODULE} = Dest, + Length) + when is_integer(Length), Length >= 0; + is_atom(Length) -> + %% XXX Should be moved down to the driver for optimization. + file:copy_opened(Source, Dest, Length). + + + +ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, + data = {_, _}} = Handle, + Offs, + Infinity) when is_atom(Infinity) -> + ipread_s32bu_p32bu(Handle, Offs, (1 bsl 31)-1); +ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {Port, _}}, + Offs, + MaxSize) + when is_integer(Offs), is_integer(MaxSize) -> + if + -(?LARGEFILESIZE) =< Offs, Offs < ?LARGEFILESIZE, + 0 =< MaxSize, MaxSize < (1 bsl 31) -> + drv_command(Port, <>); + true -> + {error, einval} + end; +ipread_s32bu_p32bu(#file_descriptor{module = ?MODULE, data = {_, _}}, + _Offs, + _MaxSize) -> + {error, badarg}. + + + +%% Returns {ok, Contents} | {error, Reason} +read_file(File) -> + case drv_open(?FD_DRV, [binary]) of + {ok, Port} -> + Result = read_file(Port, File), + close(Port), + Result; + {error, _} = Error -> + Error + end. + +%% Takes a Port opened with open/1. +read_file(Port, File) when is_port(Port) -> + Cmd = [?FILE_READ_FILE | File], + case drv_command(Port, Cmd) of + {error, enomem} -> + %% It could possibly help to do a + %% garbage collection here, + %% if the file server has some references + %% to binaries read earlier. + erlang:garbage_collect(), + drv_command(Port, Cmd); + Result -> + Result + end. + + + +%% Returns {error, Reason} | ok. +write_file(File, Bin) -> + case open(File, [binary, write]) of + {ok, Handle} -> + Result = write(Handle, Bin), + close(Handle), + Result; + Error -> + Error + end. + + + +%%%----------------------------------------------------------------- +%%% Functions operating on files without handle to the file. ?DRV. +%%% +%%% Supposed to be called by applications through module file. + + + +%% Returns {ok, Port}, the Port should be used as first argument in all +%% the following functions. Returns {error, Reason} upon failure. +start() -> + try erlang:open_port({spawn, atom_to_list(?DRV)}, []) of + Port -> + {ok, Port} + catch + error:Reason -> + {error, Reason} + end. + +stop(Port) when is_port(Port) -> + try erlang:port_close(Port) of + _ -> + ok + catch + _:_ -> + ok + end. + + + +%%% The following functions take an optional Port as first argument. +%%% If the port is not supplied, a temporary one is opened and then +%%% closed after the request has been performed. + + + +%% get_cwd/{0,1,2} + +get_cwd() -> + get_cwd_int(0). + +get_cwd(Port) when is_port(Port) -> + get_cwd_int(Port, 0); +get_cwd([]) -> + get_cwd_int(0); +get_cwd([Letter, $: | _]) when $a =< Letter, Letter =< $z -> + get_cwd_int(Letter - $a + 1); +get_cwd([Letter, $: | _]) when $A =< Letter, Letter =< $Z -> + get_cwd_int(Letter - $A + 1); +get_cwd([_|_]) -> + {error, einval}; +get_cwd(_) -> + {error, badarg}. + +get_cwd(Port, []) when is_port(Port) -> + get_cwd_int(Port, 0); +get_cwd(Port, [Letter, $: | _]) + when is_port(Port), $a =< Letter, Letter =< $z -> + get_cwd_int(Port, Letter - $a + 1); +get_cwd(Port, [Letter, $: | _]) + when is_port(Port), $A =< Letter, Letter =< $Z -> + get_cwd_int(Port, Letter - $A + 1); +get_cwd(Port, [_|_]) when is_port(Port) -> + {error, einval}; +get_cwd(_, _) -> + {error, badarg}. + +get_cwd_int(Drive) -> + get_cwd_int({?DRV, []}, Drive). + +get_cwd_int(Port, Drive) -> + drv_command(Port, <>). + + + +%% set_cwd/{1,2} + +set_cwd(Dir) -> + set_cwd_int({?DRV, []}, Dir). + +set_cwd(Port, Dir) when is_port(Port) -> + set_cwd_int(Port, Dir). + +set_cwd_int(Port, Dir0) -> + Dir = + (catch + case os:type() of + vxworks -> + %% chdir on vxworks doesn't support + %% relative paths + %% must call get_cwd from here and use + %% absname/2, since + %% absname/1 uses file:get_cwd ... + case get_cwd_int(Port, 0) of + {ok, AbsPath} -> + filename:absname(Dir0, AbsPath); + _Badcwd -> + Dir0 + end; + _Else -> + Dir0 + end), + %% Dir is now either a string or an EXIT tuple. + %% An EXIT tuple will fail in the following catch. + drv_command(Port, [?FILE_CHDIR, Dir, 0]). + + + +%% delete/{1,2} + +delete(File) -> + delete_int({?DRV, []}, File). + +delete(Port, File) when is_port(Port) -> + delete_int(Port, File). + +delete_int(Port, File) -> + drv_command(Port, [?FILE_DELETE, File, 0]). + + + +%% rename/{2,3} + +rename(From, To) -> + rename_int({?DRV, []}, From, To). + +rename(Port, From, To) when is_port(Port) -> + rename_int(Port, From, To). + +rename_int(Port, From, To) -> + drv_command(Port, [?FILE_RENAME, From, 0, To, 0]). + + + +%% make_dir/{1,2} + +make_dir(Dir) -> + make_dir_int({?DRV, []}, Dir). + +make_dir(Port, Dir) when is_port(Port) -> + make_dir_int(Port, Dir). + +make_dir_int(Port, Dir) -> + drv_command(Port, [?FILE_MKDIR, Dir, 0]). + + + +%% del_dir/{1,2} + +del_dir(Dir) -> + del_dir_int({?DRV, []}, Dir). + +del_dir(Port, Dir) when is_port(Port) -> + del_dir_int(Port, Dir). + +del_dir_int(Port, Dir) -> + drv_command(Port, [?FILE_RMDIR, Dir, 0]). + + + +%% read_file_info/{1,2} + +read_file_info(File) -> + read_file_info_int({?DRV, []}, File). + +read_file_info(Port, File) when is_port(Port) -> + read_file_info_int(Port, File). + +read_file_info_int(Port, File) -> + drv_command(Port, [?FILE_FSTAT, File, 0]). + +%% altname/{1,2} + +altname(File) -> + altname_int({?DRV, []}, File). + +altname(Port, File) when is_port(Port) -> + altname_int(Port, File). + +altname_int(Port, File) -> + drv_command(Port, [?FILE_ALTNAME, File, 0]). + + +%% write_file_info/{2,3} + +write_file_info(File, Info) -> + write_file_info_int({?DRV, []}, File, Info). + +write_file_info(Port, File, Info) when is_port(Port) -> + write_file_info_int(Port, File, Info). + +write_file_info_int(Port, + File, + #file_info{mode=Mode, + uid=Uid, + gid=Gid, + atime=Atime0, + mtime=Mtime0, + ctime=Ctime}) -> + {Atime, Mtime} = + case {Atime0, Mtime0} of + {undefined, Mtime0} -> {erlang:localtime(), Mtime0}; + {Atime0, undefined} -> {Atime0, Atime0}; + Complete -> Complete + end, + drv_command(Port, [?FILE_WRITE_INFO, + int_to_bytes(Mode), + int_to_bytes(Uid), + int_to_bytes(Gid), + date_to_bytes(Atime), + date_to_bytes(Mtime), + date_to_bytes(Ctime), + File, 0]). + + + +%% make_link/{2,3} + +make_link(Old, New) -> + make_link_int({?DRV, []}, Old, New). + +make_link(Port, Old, New) when is_port(Port) -> + make_link_int(Port, Old, New). + +make_link_int(Port, Old, New) -> + drv_command(Port, [?FILE_LINK, Old, 0, New, 0]). + + + +%% make_symlink/{2,3} + +make_symlink(Old, New) -> + make_symlink_int({?DRV, []}, Old, New). + +make_symlink(Port, Old, New) when is_port(Port) -> + make_symlink_int(Port, Old, New). + +make_symlink_int(Port, Old, New) -> + drv_command(Port, [?FILE_SYMLINK, Old, 0, New, 0]). + + + +%% read_link/{2,3} + +read_link(Link) -> + read_link_int({?DRV, []}, Link). + +read_link(Port, Link) when is_port(Port) -> + read_link_int(Port, Link). + +read_link_int(Port, Link) -> + drv_command(Port, [?FILE_READLINK, Link, 0]). + + + +%% read_link_info/{2,3} + +read_link_info(Link) -> + read_link_info_int({?DRV, []}, Link). + +read_link_info(Port, Link) when is_port(Port) -> + read_link_info_int(Port, Link). + +read_link_info_int(Port, Link) -> + drv_command(Port, [?FILE_LSTAT, Link, 0]). + + + +%% list_dir/{1,2} + +list_dir(Dir) -> + list_dir_int({?DRV, []}, Dir). + +list_dir(Port, Dir) when is_port(Port) -> + list_dir_int(Port, Dir). + +list_dir_int(Port, Dir) -> + drv_command(Port, [?FILE_READDIR, Dir, 0], []). + + + +%%%----------------------------------------------------------------- +%%% Functions to communicate with the driver + + + +%% Opens a driver port and converts any problems into {error, emfile}. +%% Returns {ok, Port} when succesful. + +drv_open(Driver, Portopts) -> + try erlang:open_port({spawn, Driver}, Portopts) of + Port -> + {ok, Port} + catch + error:Reason -> + {error,Reason} + end. + + + +%% Closes a port in a safe way. Returns ok. + +drv_close(Port) -> + try erlang:port_close(Port) catch error:_ -> ok end, + receive %% Ugly workaround in case the caller==owner traps exits + {'EXIT', Port, _Reason} -> + ok + after 0 -> + ok + end. + + + +%% Issues a command to a port and gets the response. +%% If Port is {Driver, Portopts} a port is first opened and +%% then closed after the result has been received. +%% Returns {ok, Result} or {error, Reason}. + +drv_command_raw(Port, Command) -> + drv_command(Port, Command, false, undefined). + +drv_command(Port, Command) -> + drv_command(Port, Command, undefined). + +drv_command(Port, Command, R) when is_binary(Command) -> + drv_command(Port, Command, true, R); +drv_command(Port, Command, R) -> + try erlang:iolist_to_binary(Command) of + Bin -> + drv_command(Port, Bin, true, R) + catch + error:Reason -> + {error, Reason} + end. + +drv_command(Port, Command, Validated, R) when is_port(Port) -> + try erlang:port_command(Port, Command) of + true -> + drv_get_response(Port, R) + catch + %% If the Command is valid, knowing that the port is a port, + %% a badarg error must mean it is a dead port, that is: + %% a currently invalid filehandle, -> einval, not badarg. + error:badarg when Validated -> + {error, einval}; + error:badarg -> + try erlang:iolist_size(Command) of + _ -> % Valid + {error, einval} + catch + error:_ -> + {error, badarg} + end; + error:Reason -> + {error, Reason} + end; +drv_command({Driver, Portopts}, Command, Validated, R) -> + case drv_open(Driver, Portopts) of + {ok, Port} -> + Result = drv_command(Port, Command, Validated, R), + drv_close(Port), + Result; + Error -> + Error + end. + + + +%% Receives the response from a driver port. +%% Returns: {ok, ListOrBinary}|{error, Reason} + +drv_get_response(Port, R) when is_list(R) -> + case drv_get_response(Port) of + ok -> + {ok, R}; + {ok, Name} -> + drv_get_response(Port, [Name|R]); + Error -> + Error + end; +drv_get_response(Port, _) -> + drv_get_response(Port). + +drv_get_response(Port) -> + erlang:bump_reductions(100), + receive + {Port, {data, [Response|Rest] = Data}} -> + try translate_response(Response, Rest) + catch + error:Reason -> + {error, {bad_response_from_port, Data, + {Reason, erlang:get_stacktrace()}}} + end; + {'EXIT', Port, Reason} -> + {error, {port_died, Reason}} + end. + + +%%%----------------------------------------------------------------- +%%% Utility functions. + + + +%% Converts a list of mode atoms into an mode word for the driver. +%% Returns {Mode, Portopts, Setopts} where Portopts is a list of +%% options for erlang:open_port/2 and Setopts is a list of +%% setopt commands to send to the port, or error Reason upon failure. + +open_mode(List) when is_list(List) -> + case open_mode(List, 0, [], []) of + {Mode, Portopts, Setopts} when Mode band + (?EFILE_MODE_READ bor ?EFILE_MODE_WRITE) + =:= 0 -> + {Mode bor ?EFILE_MODE_READ, Portopts, Setopts}; + Other -> + Other + end. + +open_mode([raw|Rest], Mode, Portopts, Setopts) -> + open_mode(Rest, Mode, Portopts, Setopts); +open_mode([read|Rest], Mode, Portopts, Setopts) -> + open_mode(Rest, Mode bor ?EFILE_MODE_READ, Portopts, Setopts); +open_mode([write|Rest], Mode, Portopts, Setopts) -> + open_mode(Rest, Mode bor ?EFILE_MODE_WRITE, Portopts, Setopts); +open_mode([binary|Rest], Mode, Portopts, Setopts) -> + open_mode(Rest, Mode, [binary | Portopts], Setopts); +open_mode([compressed|Rest], Mode, Portopts, Setopts) -> + open_mode(Rest, Mode bor ?EFILE_COMPRESSED, Portopts, Setopts); +open_mode([append|Rest], Mode, Portopts, Setopts) -> + open_mode(Rest, Mode bor ?EFILE_MODE_APPEND bor ?EFILE_MODE_WRITE, + Portopts, Setopts); +open_mode([delayed_write|Rest], Mode, Portopts, Setopts) -> + open_mode([{delayed_write, 64*1024, 2000}|Rest], Mode, + Portopts, Setopts); +open_mode([{delayed_write, Size, Delay}|Rest], Mode, Portopts, Setopts) + when is_integer(Size), 0 =< Size, is_integer(Delay), 0 =< Delay -> + if + Size < ?LARGEFILESIZE, Delay < 1 bsl 64 -> + open_mode(Rest, Mode, Portopts, + [<> + | Setopts]); + true -> + einval + end; +open_mode([read_ahead|Rest], Mode, Portopts, Setopts) -> + open_mode([{read_ahead, 64*1024}|Rest], Mode, Portopts, Setopts); +open_mode([{read_ahead, Size}|Rest], Mode, Portopts, Setopts) + when is_integer(Size), 0 =< Size -> + if + Size < ?LARGEFILESIZE -> + open_mode(Rest, Mode, Portopts, + [<> | Setopts]); + true -> + einval + end; +open_mode([], Mode, Portopts, Setopts) -> + {Mode, reverse(Portopts), reverse(Setopts)}; +open_mode(_, _Mode, _Portopts, _Setopts) -> + badarg. + + + +%% Converts a position tuple {bof, X} | {cur, X} | {eof, X} into +%% {Offset, OriginCode} for the driver. +%% Returns badarg upon failure. + +lseek_position(Pos) + when is_integer(Pos) -> + lseek_position({bof, Pos}); +lseek_position(bof) -> + lseek_position({bof, 0}); +lseek_position(cur) -> + lseek_position({cur, 0}); +lseek_position(eof) -> + lseek_position({eof, 0}); +lseek_position({bof, Offset}) + when is_integer(Offset) -> + {Offset, ?EFILE_SEEK_SET}; +lseek_position({cur, Offset}) + when is_integer(Offset) -> + {Offset, ?EFILE_SEEK_CUR}; +lseek_position({eof, Offset}) + when is_integer(Offset) -> + {Offset, ?EFILE_SEEK_END}; +lseek_position(_) -> + badarg. + + + +%% Translates the response from the driver into +%% {ok, Result} or {error, Reason}. + +translate_response(?FILE_RESP_OK, []) -> + ok; +translate_response(?FILE_RESP_OK, Data) -> + {ok, Data}; +translate_response(?FILE_RESP_ERROR, List) when is_list(List) -> + {error, list_to_atom(List)}; +translate_response(?FILE_RESP_NUMBER, List) -> + {N, []} = get_uint64(List), + {ok, N}; +translate_response(?FILE_RESP_DATA, List) -> + {N, Data} = get_uint64(List), + {ok, {N, Data}}; +translate_response(?FILE_RESP_INFO, List) when is_list(List) -> + {ok, transform_info_ints(get_uint32s(List))}; +translate_response(?FILE_RESP_NUMERR, L0) -> + {N, L1} = get_uint64(L0), + {error, {N, list_to_atom(L1)}}; +translate_response(?FILE_RESP_LDATA, List) -> + {ok, transform_ldata(List)}; +translate_response(?FILE_RESP_N2DATA, + <>) -> + {ok, {Size, Offset, eof}}; +translate_response(?FILE_RESP_N2DATA, + [<> | <<>>]) -> + {ok, {Size, Offset, eof}}; +translate_response(?FILE_RESP_N2DATA = X, + [<<_:64, 0:64, _:64>> | _] = Data) -> + {error, {bad_response_from_port, [X | Data]}}; +translate_response(?FILE_RESP_N2DATA = X, + [<<_:64, _:64, _:64>> | <<>>] = Data) -> + {error, {bad_response_from_port, [X | Data]}}; +translate_response(?FILE_RESP_N2DATA, + [<> | D]) -> + {ok, {Size, Offset, D}}; +translate_response(?FILE_RESP_N2DATA = X, L0) when is_list(L0) -> + {Offset, L1} = get_uint64(L0), + {ReadSize, L2} = get_uint64(L1), + {Size, L3} = get_uint64(L2), + case {ReadSize, L3} of + {0, []} -> + {ok, {Size, Offset, eof}}; + {0, _} -> + {error, {bad_response_from_port, [X | L0]}}; + {_, []} -> + {error, {bad_response_from_port, [X | L0]}}; + _ -> + {ok, {Size, Offset, L3}} + end; +translate_response(?FILE_RESP_EOF, []) -> + eof; +translate_response(X, Data) -> + {error, {bad_response_from_port, [X | Data]}}. + +transform_info_ints(Ints) -> + [HighSize, LowSize, Type|Tail0] = Ints, + Size = HighSize * 16#100000000 + LowSize, + [Ay, Am, Ad, Ah, Ami, As|Tail1] = Tail0, + [My, Mm, Md, Mh, Mmi, Ms|Tail2] = Tail1, + [Cy, Cm, Cd, Ch, Cmi, Cs|Tail3] = Tail2, + [Mode, Links, Major, Minor, Inode, Uid, Gid, Access] = Tail3, + #file_info { + size = Size, + type = file_type(Type), + access = file_access(Access), + atime = {{Ay, Am, Ad}, {Ah, Ami, As}}, + mtime = {{My, Mm, Md}, {Mh, Mmi, Ms}}, + ctime = {{Cy, Cm, Cd}, {Ch, Cmi, Cs}}, + mode = Mode, + links = Links, + major_device = Major, + minor_device = Minor, + inode = Inode, + uid = Uid, + gid = Gid}. + +file_type(1) -> device; +file_type(2) -> directory; +file_type(3) -> regular; +file_type(4) -> symlink; +file_type(_) -> other. + +file_access(0) -> none; +file_access(1) -> write; +file_access(2) -> read; +file_access(3) -> read_write. + +int_to_bytes(Int) when is_integer(Int) -> + <>; +int_to_bytes(undefined) -> + <<-1:32>>. + +date_to_bytes(undefined) -> + <<-1:32, -1:32, -1:32, -1:32, -1:32, -1:32>>; +date_to_bytes({{Y, Mon, D}, {H, Min, S}}) -> + <>. + +% uint64([[X1, X2, X3, X4] = Y1 | [X5, X6, X7, X8] = Y2]) -> +% (uint32(Y1) bsl 32) bor uint32(Y2). + +% uint64(X1, X2, X3, X4, X5, X6, X7, X8) -> +% (uint32(X1, X2, X3, X4) bsl 32) bor uint32(X5, X6, X7, X8). + +% uint32([X1,X2,X3,X4]) -> +% (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. + +uint32(X1,X2,X3,X4) -> + (X1 bsl 24) bor (X2 bsl 16) bor (X3 bsl 8) bor X4. + +get_uint64(L0) -> + {X1, L1} = get_uint32(L0), + {X2, L2} = get_uint32(L1), + {(X1 bsl 32) bor X2, L2}. + +get_uint32([X1,X2,X3,X4|List]) -> + {(((((X1 bsl 8) bor X2) bsl 8) bor X3) bsl 8) bor X4, List}. + +get_uint32s([X1,X2,X3,X4|Tail]) -> + [uint32(X1,X2,X3,X4) | get_uint32s(Tail)]; +get_uint32s([]) -> []. + + + +%% Binary mode +transform_ldata(<<0:32, 0:32>>) -> + []; +transform_ldata([<<0:32, N:32, Sizes/binary>> | Datas]) -> + transform_ldata(N, Sizes, Datas, []); +%% List mode +transform_ldata([_,_,_,_,_,_,_,_|_] = L0) -> + {0, L1} = get_uint32(L0), + {N, L2} = get_uint32(L1), + transform_ldata(N, L2, []). + +%% List mode +transform_ldata(0, List, Sizes) -> + transform_ldata(0, List, reverse(Sizes), []); +transform_ldata(N, L0, Sizes) -> + {Size, L1} = get_uint64(L0), + transform_ldata(N-1, L1, [Size | Sizes]). + +%% Binary mode +transform_ldata(1, <<0:64>>, <<>>, R) -> + reverse(R, [eof]); +transform_ldata(1, <>, Data, R) + when byte_size(Data) =:= Size -> + reverse(R, [Data]); +transform_ldata(N, <<0:64, Sizes/binary>>, [<<>> | Datas], R) -> + transform_ldata(N-1, Sizes, Datas, [eof | R]); +transform_ldata(N, <>, [Data | Datas], R) + when byte_size(Data) =:= Size -> + transform_ldata(N-1, Sizes, Datas, [Data | R]); +%% List mode +transform_ldata(0, [], [], R) -> + reverse(R); +transform_ldata(0, List, [0 | Sizes], R) -> + transform_ldata(0, List, Sizes, [eof | R]); +transform_ldata(0, List, [Size | Sizes], R) -> + {Front, Rear} = lists_split(List, Size), + transform_ldata(0, Rear, Sizes, [Front | R]). + + + +lists_split(List, 0) when is_list(List) -> + {[], List}; +lists_split(List, N) when is_list(List), is_integer(N), N < 0 -> + erlang:error(badarg, [List, N]); +lists_split(List, N) when is_list(List), is_integer(N) -> + case lists_split(List, N, []) of + premature_end_of_list -> + erlang:error(badarg, [List, N]); + Result -> + Result + end. + +lists_split(List, 0, Rev) -> + {reverse(Rev), List}; +lists_split([], _, _) -> + premature_end_of_list; +lists_split([Hd | Tl], N, Rev) -> + lists_split(Tl, N-1, [Hd | Rev]). + +%% We KNOW that lists:reverse/2 is a BIF. + +reverse(X) -> lists:reverse(X, []). +reverse(L, T) -> lists:reverse(L, T). diff --git a/erts/preloaded/src/prim_inet.erl b/erts/preloaded/src/prim_inet.erl new file mode 100644 index 0000000000..0feb591efb --- /dev/null +++ b/erts/preloaded/src/prim_inet.erl @@ -0,0 +1,1962 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% The SCTP protocol was added 2006 +%% by Leonid Timochouk +%% and Serge Aleynikov +%% at IDT Corp. Adapted by the OTP team at Ericsson AB. +%% +-module(prim_inet). + +%% Primitive inet_drv interface + +-export([open/1, open/2, fdopen/2, fdopen/3, close/1]). +-export([bind/3, listen/1, listen/2]). +-export([connect/3, connect/4, async_connect/4]). +-export([accept/1, accept/2, async_accept/2]). +-export([shutdown/2]). +-export([send/2, send/3, sendto/4, sendmsg/3]). +-export([recv/2, recv/3, async_recv/3]). +-export([unrecv/2]). +-export([recvfrom/2, recvfrom/3]). +-export([setopt/3, setopts/2, getopt/2, getopts/2, is_sockopt_val/2]). +-export([chgopt/3, chgopts/2]). +-export([getstat/2, getfd/1, getindex/1, getstatus/1, gettype/1, + getiflist/1, ifget/3, ifset/3, + gethostname/1]). +-export([getservbyname/3, getservbyport/3]). +-export([peername/1, setpeername/2]). +-export([sockname/1, setsockname/2]). +-export([attach/1, detach/1]). + +-include("inet_sctp.hrl"). +-include("inet_int.hrl"). + +%-define(DEBUG, 1). +-ifdef(DEBUG). +-define(DBG_FORMAT(Format, Args), (io:format((Format), (Args)))). +-else. +-define(DBG_FORMAT(Format, Args), ok). +-endif. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% OPEN(tcp | udp | sctp, inet | inet6) -> +%% {ok, insock()} | +%% {error, Reason} +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +open(Protocol) -> open1(Protocol, ?INET_AF_INET). + +open(Protocol, inet) -> open1(Protocol, ?INET_AF_INET); +open(Protocol, inet6) -> open1(Protocol, ?INET_AF_INET6); +open(_, _) -> {error, einval}. + +fdopen(Protocol, Fd) -> fdopen1(Protocol, ?INET_AF_INET, Fd). + +fdopen(Protocol, Fd, inet) -> fdopen1(Protocol, ?INET_AF_INET, Fd); +fdopen(Protocol, Fd, inet6) -> fdopen1(Protocol, ?INET_AF_INET6, Fd); +fdopen(_, _, _) -> {error, einval}. + +open1(Protocol, Family) -> + case open0(Protocol) of + {ok, S} -> + case ctl_cmd(S, ?INET_REQ_OPEN, [Family]) of + {ok, _} -> + {ok,S}; + Error -> + close(S), Error + end; + Error -> Error + end. + +fdopen1(Protocol, Family, Fd) when is_integer(Fd) -> + case open0(Protocol) of + {ok, S} -> + case ctl_cmd(S,?INET_REQ_FDOPEN,[Family,?int32(Fd)]) of + {ok, _} -> {ok,S}; + Error -> close(S), Error + end; + Error -> Error + end. + +open0(Protocol) -> + try erlang:open_port({spawn_driver,protocol2drv(Protocol)}, [binary]) of + Port -> {ok,Port} + catch + error:Reason -> {error,Reason} + end. + +protocol2drv(tcp) -> "tcp_inet"; +protocol2drv(udp) -> "udp_inet"; +protocol2drv(sctp) -> "sctp_inet"; +protocol2drv(_) -> + erlang:error(eprotonosupport). + +drv2protocol("tcp_inet") -> tcp; +drv2protocol("udp_inet") -> udp; +drv2protocol("sctp_inet") -> sctp; +drv2protocol(_) -> undefined. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Shutdown(insock(), atom()) -> ok +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% TODO: shutdown equivalent for SCTP +%% +shutdown(S, read) when is_port(S) -> + shutdown_2(S, 0); +shutdown(S, write) when is_port(S) -> + shutdown_1(S, 1); +shutdown(S, read_write) when is_port(S) -> + shutdown_1(S, 2). + +shutdown_1(S, How) -> + case subscribe(S, [subs_empty_out_q]) of + {ok,[{subs_empty_out_q,N}]} when N > 0 -> + shutdown_pend_loop(S, N); %% wait for pending output to be sent + _Other -> ok + end, + shutdown_2(S, How). + +shutdown_2(S, How) -> + case ctl_cmd(S, ?TCP_REQ_SHUTDOWN, [How]) of + {ok, []} -> ok; + Error -> Error + end. + +shutdown_pend_loop(S, N0) -> + receive + {empty_out_q,S} -> ok + after ?INET_CLOSE_TIMEOUT -> + case getstat(S, [send_pend]) of + {ok,[{send_pend,N0}]} -> ok; + {ok,[{send_pend,N}]} -> shutdown_pend_loop(S, N); + _ -> ok + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% CLOSE(insock()) -> ok +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +close(S) when is_port(S) -> + unlink(S), %% avoid getting {'EXIT', S, Reason} + case subscribe(S, [subs_empty_out_q]) of + {ok, [{subs_empty_out_q,N}]} when N > 0 -> + close_pend_loop(S, N); %% wait for pending output to be sent + _ -> + catch erlang:port_close(S), + ok + end. + +close_pend_loop(S, N) -> + receive + {empty_out_q,S} -> + catch erlang:port_close(S), ok + after ?INET_CLOSE_TIMEOUT -> + case getstat(S, [send_pend]) of + {ok, [{send_pend,N1}]} -> + if N1 =:= N -> catch erlang:port_close(S), ok; + true -> close_pend_loop(S, N1) + end; + _ -> + catch erlang:port_close(S), ok + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% BIND(insock(), IP, Port) -> {ok, integer()} | {error, Reason} +%% +%% bind the insock() to the interface address given by IP and Port +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +bind(S,IP,Port) when is_port(S), is_integer(Port), Port >= 0, Port =< 65535 -> + case ctl_cmd(S,?INET_REQ_BIND,[?int16(Port),ip_to_bytes(IP)]) of + {ok, [P1,P0]} -> {ok, ?u16(P1, P0)}; + Error -> Error + end; + +%% Multi-homed "bind": sctp_bindx(). The Op is 'add' or 'remove'. +%% If no addrs are specified, it just does nothing. +%% Function returns {ok, S} on success, unlike TCP/UDP "bind": +bind(S, Op, Addrs) when is_port(S), is_list(Addrs) -> + case Op of + add -> + bindx(S, 1, Addrs); + remove -> + bindx(S, 0, Addrs); + _ -> {error, einval} + end; +bind(_, _, _) -> {error, einval}. + +bindx(S, AddFlag, Addrs) -> + case getprotocol(S) of + sctp -> + %% Really multi-homed "bindx". Stringified args: + %% [AddFlag, (Port, IP)+]: + Args = ?int8(AddFlag) ++ + lists:concat([?int16(Port)++ip_to_bytes(IP) || + {IP, Port} <- Addrs]), + case ctl_cmd(S, ?SCTP_REQ_BINDX, Args) of + {ok,_} -> {ok, S}; + Error -> Error + end; + _ -> {error, einval} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% CONNECT(insock(), IP, Port [,Timeout]) -> ok | {error, Reason} +%% +%% connect the insock() to the address given by IP and Port +%% if timeout is given: +%% timeout < 0 -> infinity +%% 0 -> immediate connect (mostly works for loopback) +%% > 0 -> wait for timout ms if not connected then +%% return {error, timeout} +%% +%% ASYNC_CONNECT(insock(), IP, Port, Timeout) -> {ok, S, Ref} | {error, Reason} +%% +%% a {inet_async,S,Ref,Status} will be sent on socket condition +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% For TCP, UDP or SCTP sockets. +%% +connect(S, IP, Port) -> connect0(S, IP, Port, -1). + +connect(S, IP, Port, infinity) -> connect0(S, IP, Port, -1); +connect(S, IP, Port, Time) -> connect0(S, IP, Port, Time). + +connect0(S, IP, Port, Time) when is_port(S), Port > 0, Port =< 65535, + is_integer(Time) -> + case async_connect(S, IP, Port, Time) of + {ok, S, Ref} -> + receive + {inet_async, S, Ref, Status} -> + Status + end; + Error -> Error + end. + +async_connect(S, IP, Port, Time) -> + case ctl_cmd(S, ?INET_REQ_CONNECT, + [enc_time(Time),?int16(Port),ip_to_bytes(IP)]) of + {ok, [R1,R0]} -> {ok, S, ?u16(R1,R0)}; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% ACCEPT(insock() [,Timeout] ) -> {ok,insock()} | {error, Reason} +%% +%% accept incoming connection on listen socket +%% if timeout is given: +%% timeout < 0 -> infinity +%% 0 -> immediate accept (poll) +%% > 0 -> wait for timout ms for accept if no accept then +%% return {error, timeout} +%% +%% ASYNC_ACCEPT(insock(), Timeout) +%% +%% async accept. return {ok,S,Ref} or {error, Reason} +%% the owner of socket S will receive an {inet_async,S,Ref,Status} on +%% socket condition +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% For TCP sockets only. +%% +accept(L) -> accept0(L, -1). + +accept(L, infinity) -> accept0(L, -1); +accept(L, Time) -> accept0(L, Time). + +accept0(L, Time) when is_port(L), is_integer(Time) -> + case async_accept(L, Time) of + {ok, Ref} -> + receive + {inet_async, L, Ref, {ok,S}} -> + accept_opts(L, S); + {inet_async, L, Ref, Error} -> + Error + end; + Error -> Error + end. + +%% setup options from listen socket on the connected socket +accept_opts(L, S) -> + case getopts(L, [active, nodelay, keepalive, delay_send, priority, tos]) of + {ok, Opts} -> + case setopts(S, Opts) of + ok -> {ok, S}; + Error -> close(S), Error + end; + Error -> + close(S), Error + end. + +async_accept(L, Time) -> + case ctl_cmd(L,?TCP_REQ_ACCEPT, [enc_time(Time)]) of + {ok, [R1,R0]} -> {ok, ?u16(R1,R0)}; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% LISTEN(insock() [,Backlog]) -> ok | {error, Reason} +%% +%% set listen mode on socket +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% For TCP or SCTP sockets. For SCTP, Boolean backlog value (enable/disable +%% listening) is also accepted: + +listen(S) -> listen(S, ?LISTEN_BACKLOG). + +listen(S, BackLog) when is_port(S), is_integer(BackLog) -> + case ctl_cmd(S, ?TCP_REQ_LISTEN, [?int16(BackLog)]) of + {ok, _} -> ok; + Error -> Error + end; +listen(S, Flag) when is_port(S), is_boolean(Flag) -> + case ctl_cmd(S, ?SCTP_REQ_LISTEN, enc_value(set, bool8, Flag)) of + {ok,_} -> ok; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% SEND(insock(), Data) -> ok | {error, Reason} +%% +%% send Data on the socket (io-list) +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% This is a generic "port_command" interface used by TCP, UDP, SCTP, depending +%% on the driver it is mapped to, and the "Data". It actually sends out data,-- +%% NOT delegating this task to any back-end. For SCTP, this function MUST NOT +%% be called directly -- use "sendmsg" instead: +%% +send(S, Data, OptList) when is_port(S), is_list(OptList) -> + ?DBG_FORMAT("prim_inet:send(~p, ~p)~n", [S,Data]), + try erlang:port_command(S, Data, OptList) of + false -> % Port busy and nosuspend option passed + ?DBG_FORMAT("prim_inet:send() -> {error,busy}~n", []), + {error,busy}; + true -> + receive + {inet_reply,S,Status} -> + ?DBG_FORMAT("prim_inet:send() -> ~p~n", [Status]), + Status + end + catch + error:_Error -> + ?DBG_FORMAT("prim_inet:send() -> {error,einval}~n", []), + {error,einval} + end. + +send(S, Data) -> + send(S, Data, []). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% SENDTO(insock(), IP, Port, Data) -> ok | {error, Reason} +%% +%% send Datagram to the IP at port (Should add sync send!) +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% "sendto" is for UDP. IP and Port are set by the caller to 0 if the socket +%% is known to be connected. + +sendto(S, IP, Port, Data) when is_port(S), Port >= 0, Port =< 65535 -> + ?DBG_FORMAT("prim_inet:sendto(~p, ~p, ~p, ~p)~n", [S,IP,Port,Data]), + try erlang:port_command(S, [?int16(Port),ip_to_bytes(IP),Data]) of + true -> + receive + {inet_reply,S,Reply} -> + ?DBG_FORMAT("prim_inet:send() -> ~p~n", [Reply]), + Reply + end + catch + error:_ -> + ?DBG_FORMAT("prim_inet:send() -> {error,einval}~n", []), + {error,einval} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% SENDMSG(insock(), IP, Port, InitMsg, Data) or +%% SENDMSG(insock(), SndRcvInfo, Data) -> ok | {error, Reason} +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% SCTP: Sending data over an existing association: no need for a destination +%% addr; uses SndRcvInfo: +%% +sendmsg(S, #sctp_sndrcvinfo{}=SRI, Data) when is_port(S) -> + Type = type_opt(set, sctp_default_send_param), + try type_value(set, Type, SRI) of + true -> + send(S, [enc_value(set, Type, SRI)|Data]); + false -> {error,einval} + catch + Reason -> {error,Reason} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% RECV(insock(), Length, [Timeout]) -> {ok,Data} | {error, Reason} +%% +%% receive Length data bytes from a socket +%% if 0 is given then a Data packet is requested (see setopt (packet)) +%% N read N bytes +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% "recv" is for TCP: + +recv(S, Length) -> recv0(S, Length, -1). + +recv(S, Length, infinity) -> recv0(S, Length,-1); + +recv(S, Length, Time) when is_integer(Time) -> recv0(S, Length, Time). + +recv0(S, Length, Time) when is_port(S), is_integer(Length), Length >= 0 -> + case async_recv(S, Length, Time) of + {ok, Ref} -> + receive + {inet_async, S, Ref, Status} -> Status; + {'EXIT', S, _Reason} -> + {error, closed} + end; + Error -> Error + end. + + +async_recv(S, Length, Time) -> + case ctl_cmd(S, ?TCP_REQ_RECV, [enc_time(Time), ?int32(Length)]) of + {ok,[R1,R0]} -> {ok, ?u16(R1,R0)}; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% RECVFROM(insock(), Lenth [Timeout]) -> {ok,{IP,Port,Data}} | {error, Reason} +%% For SCTP: -> {ok,{IP,Port,[AncData],Data}} +%% | {error, Reason} +%% receive Length data bytes from a datagram socket sent from IP at Port +%% if 0 is given then a Data packet is requested (see setopt (packet)) +%% N read N bytes +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% "recvfrom" is for both UDP and SCTP. +%% NB: "Length" is actually ignored for these protocols, since they are msg- +%% oriented: preserved here only for API compatibility. +%% +recvfrom(S, Length) -> + recvfrom0(S, Length, -1). + +recvfrom(S, Length, infinity) -> + recvfrom0(S, Length, -1); +recvfrom(S, Length, Time) when is_integer(Time), Time < 16#ffffffff -> + recvfrom0(S, Length, Time); +recvfrom(_, _, _) -> {error,einval}. + +recvfrom0(S, Length, Time) + when is_port(S), is_integer(Length), Length >= 0, Length =< 16#ffffffff -> + case ctl_cmd(S, ?PACKET_REQ_RECV,[enc_time(Time),?int32(Length)]) of + {ok,[R1,R0]} -> + Ref = ?u16(R1,R0), + receive + % Success, UDP: + {inet_async, S, Ref, {ok, [F,P1,P0 | AddrData]}} -> + {IP,Data} = get_ip(F, AddrData), + {ok, {IP, ?u16(P1,P0), Data}}; + + % Success, SCTP: + {inet_async, S, Ref, {ok, {[F,P1,P0 | Addr], AncData, DE}}} -> + {IP, _} = get_ip(F, Addr), + {ok, {IP, ?u16(P1,P0), AncData, DE}}; + + % Back-end error: + {inet_async, S, Ref, Error={error, _}} -> + Error + end; + Error -> + Error % Front-end error + end; +recvfrom0(_, _, _) -> {error,einval}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% PEERNAME(insock()) -> {ok, {IP, Port}} | {error, Reason} +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +peername(S) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_PEER, []) of + {ok, [F, P1,P0 | Addr]} -> + {IP, _} = get_ip(F, Addr), + {ok, { IP, ?u16(P1, P0) }}; + Error -> Error + end. + +setpeername(S, {IP,Port}) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_SETPEER, [?int16(Port),ip_to_bytes(IP)]) of + {ok,[]} -> ok; + Error -> Error + end; +setpeername(S, undefined) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_SETPEER, []) of + {ok,[]} -> ok; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% SOCKNAME(insock()) -> {ok, {IP, Port}} | {error, Reason} +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +sockname(S) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_NAME, []) of + {ok, [F, P1, P0 | Addr]} -> + {IP, _} = get_ip(F, Addr), + {ok, { IP, ?u16(P1, P0) }}; + Error -> Error + end. + +setsockname(S, {IP,Port}) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_SETNAME, [?int16(Port),ip_to_bytes(IP)]) of + {ok,[]} -> ok; + Error -> Error + end; +setsockname(S, undefined) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_SETNAME, []) of + {ok,[]} -> ok; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% SETOPT(insock(), Opt, Value) -> ok | {error, Reason} +%% SETOPTS(insock(), [{Opt,Value}]) -> ok | {error, Reason} +%% +%% set socket, ip and driver option +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +setopt(S, Opt, Value) when is_port(S) -> + setopts(S, [{Opt,Value}]). + +setopts(S, Opts) when is_port(S) -> + case encode_opt_val(Opts) of + {ok, Buf} -> + case ctl_cmd(S, ?INET_REQ_SETOPTS, Buf) of + {ok, _} -> ok; + Error -> Error + end; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETOPT(insock(), Opt) -> {ok,Value} | {error, Reason} +%% GETOPTS(insock(), [Opt]) -> {ok, [{Opt,Value}]} | {error, Reason} +%% get socket, ip and driver option +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +getopt(S, Opt) when is_port(S), is_atom(Opt) -> + case getopts(S, [Opt]) of + {ok,[{_,Value}]} -> {ok, Value}; + Error -> Error + end. + +getopts(S, Opts) when is_port(S), is_list(Opts) -> + case encode_opts(Opts) of + {ok,Buf} -> + case ctl_cmd(S, ?INET_REQ_GETOPTS, Buf) of + {ok,Rep} -> + %% Non-SCTP: "Rep" contains the encoded option vals: + decode_opt_val(Rep); + {error,sctp_reply} -> + %% SCTP: Need to receive the full value: + receive + {inet_reply,S,Res} -> Res + end; + Error -> Error + end; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% CHGOPT(insock(), Opt) -> {ok,Value} | {error, Reason} +%% CHGOPTS(insock(), [Opt]) -> {ok, [{Opt,Value}]} | {error, Reason} +%% change socket, ip and driver option +%% +%% Same as setopts except for record value options where undefined +%% fields are read with getopts before setting. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +chgopt(S, Opt, Value) when is_port(S) -> + chgopts(S, [{Opt,Value}]). + +chgopts(S, Opts) when is_port(S), is_list(Opts) -> + case inet:getopts(S, need_template(Opts)) of + {ok,Templates} -> + try merge_options(Opts, Templates) of + NewOpts -> + setopts(S, NewOpts) + catch + Reason -> {error,Reason} + end; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% IFLIST(insock()) -> {ok,IfNameList} | {error, Reason} +%% +%% get interface name list +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +getiflist(S) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_GETIFLIST, []) of + {ok, Data} -> {ok, build_iflist(Data)}; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% ifget(insock(), IFOpts) -> {ok,IfNameList} | {error, Reason} +%% +%% get interface name list +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +ifget(S, Name, Opts) -> + case encode_ifname(Name) of + {ok, Buf1} -> + case encode_ifopts(Opts,[]) of + {ok, Buf2} -> + case ctl_cmd(S, ?INET_REQ_IFGET, [Buf1,Buf2]) of + {ok, Data} -> decode_ifopts(Data,[]); + Error -> Error + end; + Error -> Error + end; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% ifset(insock(), Name, IFOptVals) -> {ok,IfNameList} | {error, Reason} +%% +%% set interface parameters +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +ifset(S, Name, Opts) -> + case encode_ifname(Name) of + {ok, Buf1} -> + case encode_ifopt_val(Opts,[]) of + {ok, Buf2} -> + case ctl_cmd(S, ?INET_REQ_IFSET, [Buf1,Buf2]) of + {ok, _} -> ok; + Error -> Error + end; + Error -> Error + end; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% subscribe(insock(), SubsList) -> {ok,StatReply} | {error, Reason} +%% +%% Subscribe on socket events (from driver) +%% +%% Available event subscriptions: +%% subs_empty_out_q: StatReply = [{subs_empty_out_q, N}], where N +%% is current queue length. When the queue becomes empty +%% a {empty_out_q, insock()} message will be sent to +%% subscribing process and the subscription will be +%% removed. If N = 0, the queue is empty and no +%% subscription is made. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +subscribe(S, Sub) when is_port(S), is_list(Sub) -> + case encode_subs(Sub) of + {ok, Bytes} -> + case ctl_cmd(S, ?INET_REQ_SUBSCRIBE, Bytes) of + {ok, Data} -> decode_subs(Data); + Error -> Error + end; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETSTAT(insock(), StatList) -> {ok,StatReply} | {error, Reason} +%% +%% get socket statistics (from driver) +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +getstat(S, Stats) when is_port(S), is_list(Stats) -> + case encode_stats(Stats) of + {ok, Bytes} -> + case ctl_cmd(S, ?INET_REQ_GETSTAT, Bytes) of + {ok, Data} -> decode_stats(Data); + Error -> Error + end; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETFD(insock()) -> {ok,integer()} | {error, Reason} +%% +%% get internal file descriptor +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +getfd(S) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_GETFD, []) of + {ok, [S3,S2,S1,S0]} -> {ok, ?u32(S3,S2,S1,S0)}; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETIX(insock()) -> {ok,integer()} | {error, Reason} +%% +%% get internal socket index +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +getindex(S) when is_port(S) -> + %% NOT USED ANY MORE + {error, einval}. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETTYPE(insock()) -> {ok,{Family,Type}} | {error, Reason} +%% +%% get family/type of a socket +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gettype(S) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_GETTYPE, []) of + {ok, [F3,F2,F1,F0,T3,T2,T1,T0]} -> + Family = case ?u32(F3,F2,F1,F0) of + ?INET_AF_INET -> inet; + ?INET_AF_INET6 -> inet6; + _ -> undefined + end, + Type = case ?u32(T3,T2,T1,T0) of + ?INET_TYPE_STREAM -> stream; + ?INET_TYPE_DGRAM -> dgram; + ?INET_TYPE_SEQPACKET -> seqpacket; + _ -> undefined + end, + {ok, {Family, Type}}; + Error -> Error + end. + +getprotocol(S) when is_port(S) -> + {name,Drv} = erlang:port_info(S, name), + drv2protocol(Drv). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% IS_SCTP(insock()) -> true | false +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% is_sctp(S) when is_port(S) -> +%% case gettype(S) of +%% {ok, {_, seqpacket}} -> true; +%% _ -> false +%% end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETSTATUS(insock()) -> {ok,Status} | {error, Reason} +%% +%% get socket status +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +getstatus(S) when is_port(S) -> + case ctl_cmd(S, ?INET_REQ_GETSTATUS, []) of + {ok, [S3,S2,S1,S0]} -> + {ok, dec_status(?u32(S3,S2,S1,S0))}; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETHOSTNAME(insock()) -> {ok,HostName} | {error, Reason} +%% +%% get host name +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +gethostname(S) when is_port(S) -> + ctl_cmd(S, ?INET_REQ_GETHOSTNAME, []). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETSERVBYNAME(insock(),Name,Proto) -> {ok,Port} | {error, Reason} +%% +%% get service port +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +getservbyname(S,Name,Proto) when is_port(S), is_atom(Name), is_atom(Proto) -> + getservbyname1(S, atom_to_list(Name), atom_to_list(Proto)); +getservbyname(S,Name,Proto) when is_port(S), is_atom(Name), is_list(Proto) -> + getservbyname1(S, atom_to_list(Name), Proto); +getservbyname(S,Name,Proto) when is_port(S), is_list(Name), is_atom(Proto) -> + getservbyname1(S, Name, atom_to_list(Proto)); +getservbyname(S,Name,Proto) when is_port(S), is_list(Name), is_list(Proto) -> + getservbyname1(S, Name, Proto); +getservbyname(_,_, _) -> + {error, einval}. + +getservbyname1(S,Name,Proto) -> + L1 = length(Name), + L2 = length(Proto), + if L1 > 255 -> {error, einval}; + L2 > 255 -> {error, einval}; + true -> + case ctl_cmd(S, ?INET_REQ_GETSERVBYNAME, [L1,Name,L2,Proto]) of + {ok, [P1,P0]} -> + {ok, ?u16(P1,P0)}; + Error -> + Error + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% GETSERVBYPORT(insock(),Port,Proto) -> {ok,Port} | {error, Reason} +%% +%% get service port from portnumber and protocol +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +getservbyport(S,Port,Proto) when is_port(S), is_atom(Proto) -> + getservbyport1(S, Port, atom_to_list(Proto)); +getservbyport(S,Port,Proto) when is_port(S), is_list(Proto) -> + getservbyport1(S, Port, Proto); +getservbyport(_, _, _) -> + {error, einval}. + +getservbyport1(S,Port,Proto) -> + L = length(Proto), + if Port < 0 -> {error, einval}; + Port > 16#ffff -> {error, einval}; + L > 255 -> {error, einval}; + true -> + case ctl_cmd(S, ?INET_REQ_GETSERVBYPORT, [?int16(Port),L,Proto]) of + {ok, Name} -> {ok, Name}; + Error -> Error + end + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% UNRECV(insock(), data) -> ok | {error, Reason} +%% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +unrecv(S, Data) -> + case ctl_cmd(S, ?TCP_REQ_UNRECV, Data) of + {ok, _} -> ok; + Error -> Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% DETACH(insock()) -> ok +%% +%% unlink from a socket +%% +%% ATTACH(insock()) -> ok | {error, Reason} +%% +%% link and connect to a socket +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +detach(S) when is_port(S) -> + unlink(S), + ok. + +attach(S) when is_port(S) -> + try erlang:port_connect(S, self()) of + true -> link(S), ok + catch + error:Reason -> {error,Reason} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% INTERNAL FUNCTIONS +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +is_sockopt_val(Opt, Val) -> + Type = type_opt(set, Opt), + try type_value(set, Type, Val) + catch + _ -> false + end. + +%% +%% Socket options processing: Encoding option NAMES: +%% +enc_opt(reuseaddr) -> ?INET_OPT_REUSEADDR; +enc_opt(keepalive) -> ?INET_OPT_KEEPALIVE; +enc_opt(dontroute) -> ?INET_OPT_DONTROUTE; +enc_opt(linger) -> ?INET_OPT_LINGER; +enc_opt(broadcast) -> ?INET_OPT_BROADCAST; +enc_opt(sndbuf) -> ?INET_OPT_SNDBUF; +enc_opt(recbuf) -> ?INET_OPT_RCVBUF; +enc_opt(priority) -> ?INET_OPT_PRIORITY; +enc_opt(tos) -> ?INET_OPT_TOS; +enc_opt(nodelay) -> ?TCP_OPT_NODELAY; +enc_opt(multicast_if) -> ?UDP_OPT_MULTICAST_IF; +enc_opt(multicast_ttl) -> ?UDP_OPT_MULTICAST_TTL; +enc_opt(multicast_loop) -> ?UDP_OPT_MULTICAST_LOOP; +enc_opt(add_membership) -> ?UDP_OPT_ADD_MEMBERSHIP; +enc_opt(drop_membership) -> ?UDP_OPT_DROP_MEMBERSHIP; +enc_opt(buffer) -> ?INET_LOPT_BUFFER; +enc_opt(header) -> ?INET_LOPT_HEADER; +enc_opt(active) -> ?INET_LOPT_ACTIVE; +enc_opt(packet) -> ?INET_LOPT_PACKET; +enc_opt(mode) -> ?INET_LOPT_MODE; +enc_opt(deliver) -> ?INET_LOPT_DELIVER; +enc_opt(exit_on_close) -> ?INET_LOPT_EXITONCLOSE; +enc_opt(high_watermark) -> ?INET_LOPT_TCP_HIWTRMRK; +enc_opt(low_watermark) -> ?INET_LOPT_TCP_LOWTRMRK; +enc_opt(bit8) -> ?INET_LOPT_BIT8; +enc_opt(send_timeout) -> ?INET_LOPT_TCP_SEND_TIMEOUT; +enc_opt(send_timeout_close) -> ?INET_LOPT_TCP_SEND_TIMEOUT_CLOSE; +enc_opt(delay_send) -> ?INET_LOPT_TCP_DELAY_SEND; +enc_opt(packet_size) -> ?INET_LOPT_PACKET_SIZE; +enc_opt(read_packets) -> ?INET_LOPT_READ_PACKETS; +enc_opt(raw) -> ?INET_OPT_RAW; +% Names of SCTP opts: +enc_opt(sctp_rtoinfo) -> ?SCTP_OPT_RTOINFO; +enc_opt(sctp_associnfo) -> ?SCTP_OPT_ASSOCINFO; +enc_opt(sctp_initmsg) -> ?SCTP_OPT_INITMSG; +enc_opt(sctp_autoclose) -> ?SCTP_OPT_AUTOCLOSE; +enc_opt(sctp_nodelay) -> ?SCTP_OPT_NODELAY; +enc_opt(sctp_disable_fragments) -> ?SCTP_OPT_DISABLE_FRAGMENTS; +enc_opt(sctp_i_want_mapped_v4_addr)-> ?SCTP_OPT_I_WANT_MAPPED_V4_ADDR; +enc_opt(sctp_maxseg) -> ?SCTP_OPT_MAXSEG; +enc_opt(sctp_set_peer_primary_addr)-> ?SCTP_OPT_SET_PEER_PRIMARY_ADDR; +enc_opt(sctp_primary_addr) -> ?SCTP_OPT_PRIMARY_ADDR; +enc_opt(sctp_adaptation_layer) -> ?SCTP_OPT_ADAPTATION_LAYER; +enc_opt(sctp_peer_addr_params) -> ?SCTP_OPT_PEER_ADDR_PARAMS; +enc_opt(sctp_default_send_param) -> ?SCTP_OPT_DEFAULT_SEND_PARAM; +enc_opt(sctp_events) -> ?SCTP_OPT_EVENTS; +enc_opt(sctp_delayed_ack_time) -> ?SCTP_OPT_DELAYED_ACK_TIME; +enc_opt(sctp_status) -> ?SCTP_OPT_STATUS; +enc_opt(sctp_get_peer_addr_info) -> ?SCTP_OPT_GET_PEER_ADDR_INFO. +%% + +%% +%% Decoding option NAMES: +%% +dec_opt(?INET_OPT_REUSEADDR) -> reuseaddr; +dec_opt(?INET_OPT_KEEPALIVE) -> keepalive; +dec_opt(?INET_OPT_DONTROUTE) -> dontroute; +dec_opt(?INET_OPT_LINGER) -> linger; +dec_opt(?INET_OPT_BROADCAST) -> broadcast; +dec_opt(?INET_OPT_SNDBUF) -> sndbuf; +dec_opt(?INET_OPT_RCVBUF) -> recbuf; +dec_opt(?INET_OPT_PRIORITY) -> priority; +dec_opt(?INET_OPT_TOS) -> tos; +dec_opt(?TCP_OPT_NODELAY) -> nodelay; +dec_opt(?UDP_OPT_MULTICAST_IF) -> multicast_if; +dec_opt(?UDP_OPT_MULTICAST_TTL) -> multicast_ttl; +dec_opt(?UDP_OPT_MULTICAST_LOOP) -> multicast_loop; +dec_opt(?UDP_OPT_ADD_MEMBERSHIP) -> add_membership; +dec_opt(?UDP_OPT_DROP_MEMBERSHIP) -> drop_membership; +dec_opt(?INET_LOPT_BUFFER) -> buffer; +dec_opt(?INET_LOPT_HEADER) -> header; +dec_opt(?INET_LOPT_ACTIVE) -> active; +dec_opt(?INET_LOPT_PACKET) -> packet; +dec_opt(?INET_LOPT_MODE) -> mode; +dec_opt(?INET_LOPT_DELIVER) -> deliver; +dec_opt(?INET_LOPT_EXITONCLOSE) -> exit_on_close; +dec_opt(?INET_LOPT_TCP_HIWTRMRK) -> high_watermark; +dec_opt(?INET_LOPT_TCP_LOWTRMRK) -> low_watermark; +dec_opt(?INET_LOPT_BIT8) -> bit8; +dec_opt(?INET_LOPT_TCP_SEND_TIMEOUT) -> send_timeout; +dec_opt(?INET_LOPT_TCP_SEND_TIMEOUT_CLOSE) -> send_timeout_close; +dec_opt(?INET_LOPT_TCP_DELAY_SEND) -> delay_send; +dec_opt(?INET_LOPT_PACKET_SIZE) -> packet_size; +dec_opt(?INET_LOPT_READ_PACKETS) -> read_packets; +dec_opt(?INET_OPT_RAW) -> raw; +dec_opt(I) when is_integer(I) -> undefined. + + + +%% Metatypes: +%% [] Value must be 'undefined' or nonexistent +%% for setopts and getopts. +%% [Type] Value required for setopts and getopts, +%% will be encoded for both. +%% [Type,Default] Default used if value is 'undefined'. +%% [[Type,Default]] A combination of the two above. +%% Type Value must be 'undefined' or nonexistent for getops, +%% required for setopts. +%% +%% The use of [] and [[Type,Default]] is commented out in enc_value/2 +%% and type_value/2 below since they are only used in record fields. +%% And record fields does not call enc_value/2 nor type_value/2. +%% Anyone introducing these metatypes otherwhere will have to activate +%% those clauses in enc_value/2 and type_value/2. You have been warned! + +type_opt(get, raw) -> [{[int],[int],[binary_or_uint]}]; +type_opt(_, raw) -> {int,int,binary}; +%% NB: "sctp_status" and "sctp_get_peer_addr_info" are read-only options, +%% so they should not be NOT encoded for use with "setopt". +type_opt(get, sctp_status) -> + [{record,#sctp_status{ + assoc_id = [sctp_assoc_id], + _ = []}}]; +type_opt(get, sctp_get_peer_addr_info) -> + [{record,#sctp_paddrinfo{ + assoc_id = [[sctp_assoc_id,0]], + address = [[addr,{any,0}]], + _ = []}}]; +type_opt(_, Opt) -> + type_opt_1(Opt). + +%% Types of option values, by option name: +%% +type_opt_1(reuseaddr) -> bool; +type_opt_1(keepalive) -> bool; +type_opt_1(dontroute) -> bool; +type_opt_1(linger) -> {bool,int}; +type_opt_1(broadcast) -> bool; +type_opt_1(sndbuf) -> int; +type_opt_1(recbuf) -> int; +type_opt_1(priority) -> int; +type_opt_1(tos) -> int; +type_opt_1(nodelay) -> bool; +%% multicast +type_opt_1(multicast_ttl) -> int; +type_opt_1(multicast_loop) -> bool; +type_opt_1(multicast_if) -> ip; +type_opt_1(add_membership) -> {ip,ip}; +type_opt_1(drop_membership) -> {ip,ip}; +%% driver options +type_opt_1(header) -> uint; +type_opt_1(buffer) -> int; +type_opt_1(active) -> + {enum,[{false, ?INET_PASSIVE}, + {true, ?INET_ACTIVE}, + {once, ?INET_ONCE}]}; +type_opt_1(packet) -> + {enum,[{0, ?TCP_PB_RAW}, + {1, ?TCP_PB_1}, + {2, ?TCP_PB_2}, + {4, ?TCP_PB_4}, + {raw,?TCP_PB_RAW}, + {sunrm, ?TCP_PB_RM}, + {asn1, ?TCP_PB_ASN1}, + {cdr, ?TCP_PB_CDR}, + {fcgi, ?TCP_PB_FCGI}, + {line, ?TCP_PB_LINE_LF}, + {tpkt, ?TCP_PB_TPKT}, + {http, ?TCP_PB_HTTP}, + {httph,?TCP_PB_HTTPH}, + {http_bin, ?TCP_PB_HTTP_BIN}, + {httph_bin,?TCP_PB_HTTPH_BIN}, + {ssl, ?TCP_PB_SSL_TLS}, % obsolete + {ssl_tls, ?TCP_PB_SSL_TLS}]}; +type_opt_1(mode) -> + {enum,[{list, ?INET_MODE_LIST}, + {binary, ?INET_MODE_BINARY}]}; +type_opt_1(deliver) -> + {enum,[{port, ?INET_DELIVER_PORT}, + {term, ?INET_DELIVER_TERM}]}; +type_opt_1(exit_on_close) -> bool; +type_opt_1(low_watermark) -> int; +type_opt_1(high_watermark) -> int; +type_opt_1(bit8) -> + {enum,[{clear, ?INET_BIT8_CLEAR}, + {set, ?INET_BIT8_SET}, + {on, ?INET_BIT8_ON}, + {off, ?INET_BIT8_OFF}]}; +type_opt_1(send_timeout) -> time; +type_opt_1(send_timeout_close) -> bool; +type_opt_1(delay_send) -> bool; +type_opt_1(packet_size) -> uint; +type_opt_1(read_packets) -> uint; +%% +%% SCTP options (to be set). If the type is a record type, the corresponding +%% record signature is returned, otherwise, an "elementary" type tag +%% is returned: +%% +%% for SCTP_OPT_RTOINFO +type_opt_1(sctp_rtoinfo) -> + [{record,#sctp_rtoinfo{ + assoc_id = [[sctp_assoc_id,0]], + initial = [uint32,0], + max = [uint32,0], + min = [uint32,0]}}]; +%% for SCTP_OPT_ASSOCINFO +type_opt_1(sctp_associnfo) -> + [{record,#sctp_assocparams{ + assoc_id = [[sctp_assoc_id,0]], + asocmaxrxt = [uint16,0], + number_peer_destinations = [uint16,0], + peer_rwnd = [uint32,0], + local_rwnd = [uint32,0], + cookie_life = [uint32,0]}}]; +%% for SCTP_OPT_INITMSG and SCTP_TAG_SEND_ANC_INITMSG (send*) +type_opt_1(sctp_initmsg) -> + [{record,#sctp_initmsg{ + num_ostreams = [uint16,0], + max_instreams = [uint16,0], + max_attempts = [uint16,0], + max_init_timeo = [uint16,0]}}]; +%% +type_opt_1(sctp_nodelay) -> bool; +type_opt_1(sctp_autoclose) -> uint; +type_opt_1(sctp_disable_fragments) -> bool; +type_opt_1(sctp_i_want_mapped_v4_addr) -> bool; +type_opt_1(sctp_maxseg) -> uint; +%% for SCTP_OPT_PRIMARY_ADDR +type_opt_1(sctp_primary_addr) -> + [{record,#sctp_prim{ + assoc_id = [sctp_assoc_id], + addr = addr}}]; +%% for SCTP_OPT_SET_PEER_PRIMARY_ADDR +type_opt_1(sctp_set_peer_primary_addr) -> + [{record,#sctp_setpeerprim{ + assoc_id = [sctp_assoc_id], + addr = addr}}]; +%% for SCTP_OPT_ADAPTATION_LAYER +type_opt_1(sctp_adaptation_layer) -> + [{record,#sctp_setadaptation{ + adaptation_ind = [uint32,0]}}]; +%% for SCTP_OPT_PEER_ADDR_PARAMS +type_opt_1(sctp_peer_addr_params) -> + [{record,#sctp_paddrparams{ + assoc_id = [[sctp_assoc_id,0]], + address = [[addr,{any,0}]], + hbinterval = [uint32,0], + pathmaxrxt = [uint16,0], + pathmtu = [uint32,0], + sackdelay = [uint32,0], + flags = + [{bitenumlist, + [{hb_enable, ?SCTP_FLAG_HB_ENABLE}, + {hb_disable, ?SCTP_FLAG_HB_DISABLE}, + {hb_demand, ?SCTP_FLAG_HB_DEMAND}, + {pmtud_enable, ?SCTP_FLAG_PMTUD_ENABLE}, + {pmtud_disable, ?SCTP_FLAG_PMTUD_DISABLE}, + {sackdelay_enable, ?SCTP_FLAG_SACKDELAY_ENABLE}, + {sackdelay_disable, ?SCTP_FLAG_SACKDELAY_DISABLE}], + uint32},[]]}}]; +%% for SCTP_OPT_DEFAULT_SEND_PARAM and SCTP_TAG_SEND_ANC_PARAMS (on send*) +type_opt_1(sctp_default_send_param) -> + [{record,#sctp_sndrcvinfo{ + stream = [uint16,0], + ssn = [], + flags = + [{bitenumlist, + [{unordered, ?SCTP_FLAG_UNORDERED}, + {addr_over, ?SCTP_FLAG_ADDR_OVER}, + {abort, ?SCTP_FLAG_ABORT}, + {eof, ?SCTP_FLAG_EOF}], + uint16},[]], + ppid = [uint32,0], + context = [uint32,0], + timetolive = [uint32,0], + tsn = [], + cumtsn = [], + assoc_id = [sctp_assoc_id,0]}}]; +%% for SCTP_OPT_EVENTS +type_opt_1(sctp_events) -> + [{record,#sctp_event_subscribe{ + data_io_event = [bool8,true], + association_event = [bool8,true], + address_event = [bool8,true], + send_failure_event = [bool8,true], + peer_error_event = [bool8,true], + shutdown_event = [bool8,true], + partial_delivery_event = [bool8,true], + adaptation_layer_event = [bool8,false], + authentication_event = [bool8,false]}}]; +%% for SCTP_OPT_DELAYED_ACK_TIME +type_opt_1(sctp_delayed_ack_time) -> + [{record,#sctp_assoc_value{ + assoc_id = [[sctp_assoc_id,0]], + assoc_value = [uint32,0]}}]; +%% +type_opt_1(undefined) -> undefined; +type_opt_1(O) when is_atom(O) -> undefined. + + + +%% Get. No supplied value. +type_value(get, undefined) -> false; % Undefined type +%% These two clauses can not happen since they are only used +%% in record fields - from record fields they must have a +%% value though it might be 'undefined', so record fields +%% calls type_value/3, not type_value/2. +%% type_value(get, []) -> true; % Ignored +%% type_value(get, [[Type,Default]]) -> % Required field, default value +%% type_value(get, Type, Default); +type_value(get, [{record,Types}]) -> % Implied default value for record + type_value_record(get, Types, + erlang:make_tuple(tuple_size(Types), undefined), 2); +type_value(get, [_]) -> false; % Required value missing +type_value(get, _) -> true. % Field is supposed to be undefined + +%% Get and set. Value supplied. +type_value(_, undefined, _) -> false; % Undefined type +type_value(_, [], undefined) -> true; % Ignored +type_value(_, [], _) -> false; % Value should not be supplied +type_value(Q, [Type], Value) -> % Required field, proceed + type_value_default(Q, Type, Value); +type_value(set, Type, Value) -> % Required for setopts + type_value_default(set, Type, Value); +type_value(_, _, undefined) -> true; % Value should be undefined for +type_value(_, _, _) -> false. % other than setopts. + +type_value_default(Q, [Type,Default], undefined) -> + type_value_1(Q, Type, Default); +type_value_default(Q, [Type,_], Value) -> + type_value_1(Q, Type, Value); +type_value_default(Q, Type, Value) -> + type_value_1(Q, Type, Value). + +type_value_1(Q, {record,Types}, undefined) -> + type_value_record(Q, Types, + erlang:make_tuple(tuple_size(Types), undefined), 2); +type_value_1(Q, {record,Types}, Values) + when tuple_size(Types) =:= tuple_size(Values) -> + type_value_record(Q, Types, Values, 2); +type_value_1(Q, Types, Values) + when tuple_size(Types) =:= tuple_size(Values) -> + type_value_tuple(Q, Types, Values, 1); +type_value_1(_, Type, Value) -> + type_value_2(Type, Value). + +type_value_tuple(Q, Types, Values, N) + when is_integer(N), N =< tuple_size(Types) -> + type_value(Q, element(N, Types), element(N, Values)) + andalso type_value_tuple(Q, Types, Values, N+1); +type_value_tuple(_, _, _, _) -> true. + +type_value_record(Q, Types, Values, N) + when is_integer(N), N =< tuple_size(Types) -> + case type_value(Q, element(N, Types), element(N, Values)) of + true -> type_value_record(Q, Types, Values, N+1); + false -> + erlang:throw({type,{record,Q,Types,Values,N}}) + end; +type_value_record(_, _, _, _) -> true. + +%% Simple run-time type-checking of (option) values: type -vs- value: +%% NB: the LHS is the TYPE, not the option name! +%% +%% Returns true | false | throw(ErrorReason) only for record types +%% +type_value_2(undefined, _) -> false; +%% +type_value_2(bool, true) -> true; +type_value_2(bool, false) -> true; +type_value_2(bool8, true) -> true; +type_value_2(bool8, false) -> true; +type_value_2(int, X) when is_integer(X) -> true; +type_value_2(uint, X) when is_integer(X), X >= 0 -> true; +type_value_2(uint32, X) when X band 16#ffffffff =:= X -> true; +type_value_2(uint24, X) when X band 16#ffffff =:= X -> true; +type_value_2(uint16, X) when X band 16#ffff =:= X -> true; +type_value_2(uint8, X) when X band 16#ff =:= X -> true; +type_value_2(time, infinity) -> true; +type_value_2(time, X) when is_integer(X), X >= 0 -> true; +type_value_2(ip,{A,B,C,D}) when ?ip(A,B,C,D) -> true; +type_value_2(addr, {any,Port}) -> + type_value_2(uint16, Port); +type_value_2(addr, {loopback,Port}) -> + type_value_2(uint16, Port); +type_value_2(addr, {{A,B,C,D},Port}) when ?ip(A,B,C,D) -> + type_value_2(uint16, Port); +type_value_2(addr, {{A,B,C,D,E,F,G,H},Port}) when ?ip6(A,B,C,D,E,F,G,H) -> + type_value_2(uint16, Port); +type_value_2(ether,[X1,X2,X3,X4,X5,X6]) + when ?ether(X1,X2,X3,X4,X5,X6) -> true; +type_value_2({enum,List}, Enum) -> + case enum_val(Enum, List) of + {value,_} -> true; + false -> false + end; +type_value_2({bitenumlist,List}, EnumList) -> + case enum_vals(EnumList, List) of + Ls when is_list(Ls) -> true; + false -> false + end; +type_value_2({bitenumlist,List,_}, EnumList) -> + case enum_vals(EnumList, List) of + Ls when is_list(Ls) -> true; + false -> false + end; +type_value_2(binary,Bin) when is_binary(Bin) -> true; +type_value_2(binary_or_uint,Bin) when is_binary(Bin) -> true; +type_value_2(binary_or_uint,Int) when is_integer(Int), Int >= 0 -> true; +%% Type-checking of SCTP options +type_value_2(sctp_assoc_id, X) + when X band 16#ffffffff =:= X -> true; +type_value_2(_, _) -> false. + + + +%% Get. No supplied value. +%% +%% These two clauses can not happen since they are only used +%% in record fields - from record fields they must have a +%% value though it might be 'undefined', so record fields +%% calls enc_value/3, not enc_value/2. +%% enc_value(get, []) -> []; % Ignored +%% enc_value(get, [[Type,Default]]) -> % Required field, default value +%% enc_value(get, Type, Default); +enc_value(get, [{record,Types}]) -> % Implied default value for record + enc_value_tuple(get, Types, + erlang:make_tuple(tuple_size(Types), undefined), 2); +enc_value(get, _) -> []. + +%% Get and set +enc_value(_, [], _) -> []; % Ignored +enc_value(Q, [Type], Value) -> % Required field, proceed + enc_value_default(Q, Type, Value); +enc_value(set, Type, Value) -> % Required for setopts + enc_value_default(set, Type, Value); +enc_value(_, _, _) -> []. % Not encoded for other than setopts + +enc_value_default(Q, [Type,Default], undefined) -> + enc_value_1(Q, Type, Default); +enc_value_default(Q, [Type,_], Value) -> + enc_value_1(Q, Type, Value); +enc_value_default(Q, Type, Value) -> + enc_value_1(Q, Type, Value). + +enc_value_1(Q, {record,Types}, undefined) -> + enc_value_tuple(Q, Types, + erlang:make_tuple(tuple_size(Types), undefined), 2); +enc_value_1(Q, {record,Types}, Values) + when tuple_size(Types) =:= tuple_size(Values) -> + enc_value_tuple(Q, Types, Values, 2); +enc_value_1(Q, Types, Values) when tuple_size(Types) =:= tuple_size(Values) -> + enc_value_tuple(Q, Types, Values, 1); +enc_value_1(_, Type, Value) -> + enc_value_2(Type, Value). + +enc_value_tuple(Q, Types, Values, N) + when is_integer(N), N =< tuple_size(Types) -> + [enc_value(Q, element(N, Types), element(N, Values)) + |enc_value_tuple(Q, Types, Values, N+1)]; +enc_value_tuple(_, _, _, _) -> []. + +%% +%% Encoding of option VALUES: +%% +enc_value_2(bool, true) -> [0,0,0,1]; +enc_value_2(bool, false) -> [0,0,0,0]; +enc_value_2(bool8, true) -> [1]; +enc_value_2(bool8, false) -> [0]; +enc_value_2(int, Val) -> ?int32(Val); +enc_value_2(uint, Val) -> ?int32(Val); +enc_value_2(uint32, Val) -> ?int32(Val); +enc_value_2(uint24, Val) -> ?int24(Val); +enc_value_2(uint16, Val) -> ?int16(Val); +enc_value_2(uint8, Val) -> ?int8(Val); +enc_value_2(time, infinity) -> ?int32(-1); +enc_value_2(time, Val) -> ?int32(Val); +enc_value_2(ip,{A,B,C,D}) -> [A,B,C,D]; +enc_value_2(ip, any) -> [0,0,0,0]; +enc_value_2(ip, loopback) -> [127,0,0,1]; +enc_value_2(addr, {any,Port}) -> + [?INET_AF_ANY|?int16(Port)]; +enc_value_2(addr, {loopback,Port}) -> + [?INET_AF_LOOPBACK|?int16(Port)]; +enc_value_2(addr, {IP,Port}) -> + case tuple_size(IP) of + 4 -> + [?INET_AF_INET,?int16(Port)|ip4_to_bytes(IP)]; + 8 -> + [?INET_AF_INET6,?int16(Port)|ip6_to_bytes(IP)] + end; +enc_value_2(ether, [X1,X2,X3,X4,X5,X6]) -> [X1,X2,X3,X4,X5,X6]; +enc_value_2(sctp_assoc_id, Val) -> ?int32(Val); +%% enc_value_2(sctp_assoc_id, Bin) -> [byte_size(Bin),Bin]; +enc_value_2({enum,List}, Enum) -> + {value,Val} = enum_val(Enum, List), + ?int32(Val); +enc_value_2({bitenumlist,List}, EnumList) -> + Vs = enum_vals(EnumList, List), + Val = borlist(Vs, 0), + ?int32(Val); +enc_value_2({bitenumlist,List,Type}, EnumList) -> + Vs = enum_vals(EnumList, List), + Value = borlist(Vs, 0), + enc_value_2(Type, Value); +enc_value_2(binary,Bin) -> [?int32(byte_size(Bin)),Bin]; +enc_value_2(binary_or_uint,Datum) when is_binary(Datum) -> + [1,enc_value_2(binary, Datum)]; +enc_value_2(binary_or_uint,Datum) when is_integer(Datum) -> + [0,enc_value_2(uint, Datum)]. + + + +%% +%% Decoding of option VALUES receved from "getopt": +%% NOT required for SCTP, as it always returns ready terms, not lists: +%% +dec_value(bool, [0,0,0,0|T]) -> {false,T}; +dec_value(bool, [_,_,_,_|T]) -> {true,T}; +%% Currently not used i.e only used by SCTP that does not dec_value/2 +%% dec_value(bool8, [0|T]) -> {false,T}; +%% dec_value(bool8, [_|T]) -> {true,T}; +dec_value(int, [X3,X2,X1,X0|T]) -> {?i32(X3,X2,X1,X0),T}; +dec_value(uint, [X3,X2,X1,X0|T]) -> {?u32(X3,X2,X1,X0),T}; +%% Currently not used i.e only used by SCTP that does not dec_value/2 +%% dec_value(uint32, [X3,X2,X1,X0|T]) -> {?u32(X3,X2,X1,X0),T}; +%% dec_value(uint24, [X2,X1,X0|T]) -> {?u24(X2,X1,X0),T}; +%% dec_value(uint16, [X1,X0|T]) -> {?u16(X1,X0),T}; +%% dec_value(uint8, [X0|T]) -> {?u8(X0),T}; +dec_value(time, [X3,X2,X1,X0|T]) -> + case ?i32(X3,X2,X1,X0) of + -1 -> {infinity, T}; + Val -> {Val, T} + end; +dec_value(ip, [A,B,C,D|T]) -> {{A,B,C,D}, T}; +dec_value(ether,[X1,X2,X3,X4,X5,X6|T]) -> {[X1,X2,X3,X4,X5,X6],T}; +dec_value({enum,List}, [X3,X2,X1,X0|T]) -> + Val = ?i32(X3,X2,X1,X0), + case enum_name(Val, List) of + {name, Enum} -> {Enum, T}; + _ -> {undefined, T} + end; +dec_value({bitenumlist,List}, [X3,X2,X1,X0|T]) -> + Val = ?i32(X3,X2,X1,X0), + {enum_names(Val, List), T}; +%% Currently not used i.e only used by SCTP that does not dec_value/2 +%% dec_value({bitenumlist,List,Type}, T0) -> +%% {Val,T} = dec_value(Type, T0), +%% {enum_names(Val, List), T}; +dec_value(binary,[L0,L1,L2,L3|List]) -> + Len = ?i32(L0,L1,L2,L3), + {X,T}=lists:split(Len,List), + {list_to_binary(X),T}; +dec_value(Types, List) when is_tuple(Types) -> + {L,T} = dec_value_tuple(Types, List, 1, []), + {list_to_tuple(L),T}; +dec_value(Type, Val) -> + erlang:error({decode,Type,Val}). +%% dec_value(_, B) -> +%% {undefined, B}. + +dec_value_tuple(Types, List, N, Acc) + when is_integer(N), N =< tuple_size(Types) -> + {Term,Tail} = dec_value(element(N, Types), List), + dec_value_tuple(Types, Tail, N+1, [Term|Acc]); +dec_value_tuple(_, List, _, Acc) -> + {lists:reverse(Acc),List}. + +borlist([V|Vs], Value) -> + borlist(Vs, V bor Value); +borlist([], Value) -> Value. + + +enum_vals([Enum|Es], List) -> + case enum_val(Enum, List) of + false -> false; + {value,Value} -> [Value | enum_vals(Es, List)] + end; +enum_vals([], _) -> []. + +enum_names(Val, [{Enum,BitVal} |List]) -> + if Val band BitVal =:= BitVal -> + [Enum | enum_names(Val, List)]; + true -> + enum_names(Val, List) + end; +enum_names(_, []) -> []. + +enum_val(Enum, [{Enum,Value}|_]) -> {value,Value}; +enum_val(Enum, [_|List]) -> enum_val(Enum, List); +enum_val(_, []) -> false. + +enum_name(Val, [{Enum,Val}|_]) -> {name,Enum}; +enum_name(Val, [_|List]) -> enum_name(Val, List); +enum_name(_, []) -> false. + + + +%% Encoding for setopts +%% +%% encode opt/val REVERSED since options are stored in reverse order +%% i.e. the recent options first (we must process old -> new) +encode_opt_val(Opts) -> + try + enc_opt_val(Opts, []) + catch + Reason -> {error,Reason} + end. + +enc_opt_val([{active,once}|Opts], Acc) -> + %% Specially optimized because {active,once} will be used for + %% every packet, not only once when initializing the socket. + %% Measurements show that this optimization is worthwhile. + enc_opt_val(Opts, [<>|Acc]); +enc_opt_val([{raw,P,O,B}|Opts], Acc) -> + enc_opt_val(Opts, Acc, raw, {P,O,B}); +enc_opt_val([{Opt,Val}|Opts], Acc) -> + enc_opt_val(Opts, Acc, Opt, Val); +enc_opt_val([binary|Opts], Acc) -> + enc_opt_val(Opts, Acc, mode, binary); +enc_opt_val([list|Opts], Acc) -> + enc_opt_val(Opts, Acc, mode, list); +enc_opt_val([_|_], _) -> {error,einval}; +enc_opt_val([], Acc) -> {ok,Acc}. + +enc_opt_val(Opts, Acc, Opt, Val) when is_atom(Opt) -> + Type = type_opt(set, Opt), + case type_value(set, Type, Val) of + true -> + enc_opt_val(Opts, [enc_opt(Opt),enc_value(set, Type, Val)|Acc]); + false -> {error,einval} + end; +enc_opt_val(_, _, _, _) -> {error,einval}. + + + +%% Encoding for getopts +%% +%% "encode_opts" is for "getopt" only, not setopt". But it uses "enc_opt" which +%% is common for "getopt" and "setopt": +encode_opts(Opts) -> + try enc_opts(Opts) of + Buf -> {ok,Buf} + catch + Error -> {error,Error} + end. + +% Raw options are a special case, they need to be rewritten to be properly +% handled and the types need checking even when querying. +enc_opts([{raw,P,O,S}|Opts]) -> + enc_opts(Opts, raw, {P,O,S}); +enc_opts([{Opt,Val}|Opts]) -> + enc_opts(Opts, Opt, Val); +enc_opts([Opt|Opts]) -> + enc_opts(Opts, Opt); +enc_opts([]) -> []. + +enc_opts(Opts, Opt) when is_atom(Opt) -> + Type = type_opt(get, Opt), + case type_value(get, Type) of + true -> + [enc_opt(Opt),enc_value(get, Type)|enc_opts(Opts)]; + false -> + throw(einval) + end; +enc_opts(_, _) -> + throw(einval). + +enc_opts(Opts, Opt, Val) when is_atom(Opt) -> + Type = type_opt(get, Opt), + case type_value(get, Type, Val) of + true -> + [enc_opt(Opt),enc_value(get, Type, Val)|enc_opts(Opts)]; + false -> + throw(einval) + end; +enc_opts(_, _, _) -> + throw(einval). + + + +%% Decoding of raw list data options +%% +decode_opt_val(Buf) -> + try dec_opt_val(Buf) of + Result -> {ok,Result} + catch + Error -> {error,Error} + end. + +dec_opt_val([B|Buf]=BBuf) -> + case dec_opt(B) of + undefined -> + erlang:error({decode,BBuf}); + Opt -> + Type = type_opt(dec, Opt), + dec_opt_val(Buf, Opt, Type) + end; +dec_opt_val([]) -> []. + +dec_opt_val(Buf, raw, Type) -> + {{P,O,B},T} = dec_value(Type, Buf), + [{raw,P,O,B}|dec_opt_val(T)]; +dec_opt_val(Buf, Opt, Type) -> + {Val,T} = dec_value(Type, Buf), + [{Opt,Val}|dec_opt_val(T)]. + + + +%% Pre-processing of options for chgopts +%% +%% Return list of option requests for getopts +%% for all options that containing 'undefined' record fields. +%% +need_template([{Opt,undefined}=OV|Opts]) when is_atom(Opt) -> + [OV|need_template(Opts)]; +need_template([{Opt,Val}|Opts]) when is_atom(Opt) -> + case need_template(Val, 2) of + true -> + [{Opt,undefined}|need_template(Opts)]; + false -> + need_template(Opts) + end; +need_template([_|Opts]) -> + need_template(Opts); +need_template([]) -> []. +%% +need_template(T, N) when is_integer(N), N =< tuple_size(T) -> + case element(N, T) of + undefined -> true; + _ -> + need_template(T, N+1) + end; +need_template(_, _) -> false. + +%% Replace 'undefined' record fields in option values with values +%% from template records. +%% +merge_options([{Opt,undefined}|Opts], [{Opt,_}=T|Templates]) -> + [T|merge_options(Opts, Templates)]; +merge_options([{Opt,Val}|Opts], [{Opt,Template}|Templates]) + when is_atom(Opt), tuple_size(Val) >= 2 -> + Key = element(1, Val), + Size = tuple_size(Val), + if Size =:= tuple_size(Template), Key =:= element(1, Template) -> + %% is_record(Template, Key) + [{Opt,list_to_tuple([Key|merge_fields(Val, Template, 2)])} + |merge_options(Opts, Templates)]; + true -> + throw({merge,Val,Template}) + end; +merge_options([OptVal|Opts], Templates) -> + [OptVal|merge_options(Opts, Templates)]; +merge_options([], []) -> []; +merge_options(Opts, Templates) -> + throw({merge,Opts,Templates}). + +merge_fields(Opt, Template, N) when is_integer(N), N =< tuple_size(Opt) -> + case element(N, Opt) of + undefined -> + [element(N, Template)|merge_fields(Opt, Template, N+1)]; + Val -> + [Val|merge_fields(Opt, Template, N+1)] + end; +merge_fields(_, _, _) -> []. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% handle interface options +%% +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +type_ifopt(addr) -> ip; +type_ifopt(broadaddr) -> ip; +type_ifopt(dstaddr) -> ip; +type_ifopt(mtu) -> int; +type_ifopt(netmask) -> ip; +type_ifopt(flags) -> + {bitenumlist, + [{up, ?INET_IFF_UP}, + {down, ?INET_IFF_DOWN}, + {broadcast, ?INET_IFF_BROADCAST}, + {no_broadcast, ?INET_IFF_NBROADCAST}, + {loopback, ?INET_IFF_LOOPBACK}, + {pointtopoint, ?INET_IFF_POINTTOPOINT}, + {no_pointtopoint, ?INET_IFF_NPOINTTOPOINT}, + {running, ?INET_IFF_RUNNING}, + {multicast, ?INET_IFF_MULTICAST}]}; +type_ifopt(hwaddr) -> ether; +type_ifopt(Opt) when is_atom(Opt) -> undefined. + +enc_ifopt(addr) -> ?INET_IFOPT_ADDR; +enc_ifopt(broadaddr) -> ?INET_IFOPT_BROADADDR; +enc_ifopt(dstaddr) -> ?INET_IFOPT_DSTADDR; +enc_ifopt(mtu) -> ?INET_IFOPT_MTU; +enc_ifopt(netmask) -> ?INET_IFOPT_NETMASK; +enc_ifopt(flags) -> ?INET_IFOPT_FLAGS; +enc_ifopt(hwaddr) -> ?INET_IFOPT_HWADDR; +enc_ifopt(Opt) when is_atom(Opt) -> -1. + +dec_ifopt(?INET_IFOPT_ADDR) -> addr; +dec_ifopt(?INET_IFOPT_BROADADDR) -> broadaddr; +dec_ifopt(?INET_IFOPT_DSTADDR) -> dstaddr; +dec_ifopt(?INET_IFOPT_MTU) -> mtu; +dec_ifopt(?INET_IFOPT_NETMASK) -> netmask; +dec_ifopt(?INET_IFOPT_FLAGS) -> flags; +dec_ifopt(?INET_IFOPT_HWADDR) -> hwaddr; +dec_ifopt(I) when is_integer(I) -> undefined. + +%% decode if options returns a reversed list +decode_ifopts([B | Buf], Acc) -> + case dec_ifopt(B) of + undefined -> + {error, einval}; + Opt -> + {Val,T} = dec_value(type_ifopt(Opt), Buf), + decode_ifopts(T, [{Opt,Val} | Acc]) + end; +decode_ifopts(_,Acc) -> {ok,Acc}. + + +%% encode if options return a reverse list +encode_ifopts([Opt|Opts], Acc) -> + case enc_ifopt(Opt) of + -1 -> {error,einval}; + B -> encode_ifopts(Opts,[B|Acc]) + end; +encode_ifopts([],Acc) -> {ok,Acc}. + + +%% encode if options return a reverse list +encode_ifopt_val([{Opt,Val}|Opts], Buf) -> + Type = type_ifopt(Opt), + try type_value(set, Type, Val) of + true -> + encode_ifopt_val(Opts, + [Buf,enc_ifopt(Opt),enc_value(set, Type, Val)]); + false -> {error,einval} + catch + Reason -> {error,Reason} + end; +encode_ifopt_val([], Buf) -> {ok,Buf}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% handle subscribe options +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +encode_subs(L) -> + try enc_subs(L) of + Result -> {ok,Result} + catch + Error -> {error,Error} + end. + +enc_subs([H|T]) -> + case H of + subs_empty_out_q -> [?INET_SUBS_EMPTY_OUT_Q|enc_subs(T)]%; + %%Dialyzer _ -> throw(einval) + end; +enc_subs([]) -> []. + + +decode_subs(Bytes) -> + try dec_subs(Bytes) of + Result -> {ok,Result} + catch + Error -> {error,Error} + end. + +dec_subs([X,X3,X2,X1,X0|R]) -> + Val = ?u32(X3,X2,X1,X0), + case X of + ?INET_SUBS_EMPTY_OUT_Q -> [{subs_empty_out_q,Val}|dec_subs(R)]; + _ -> throw(einval) + end; +dec_subs([]) -> []. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% handle statictics options +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +encode_stats(L) -> + try enc_stats(L) of + Result -> {ok,Result} + catch + Error -> {error,Error} + end. + +enc_stats([H|T]) -> + case H of + recv_cnt -> [?INET_STAT_RECV_CNT |enc_stats(T)]; + recv_max -> [?INET_STAT_RECV_MAX |enc_stats(T)]; + recv_avg -> [?INET_STAT_RECV_AVG |enc_stats(T)]; + recv_dvi -> [?INET_STAT_RECV_DVI |enc_stats(T)]; + send_cnt -> [?INET_STAT_SEND_CNT |enc_stats(T)]; + send_max -> [?INET_STAT_SEND_MAX |enc_stats(T)]; + send_avg -> [?INET_STAT_SEND_AVG |enc_stats(T)]; + send_pend -> [?INET_STAT_SEND_PEND|enc_stats(T)]; + send_oct -> [?INET_STAT_SEND_OCT |enc_stats(T)]; + recv_oct -> [?INET_STAT_RECV_OCT |enc_stats(T)]; + _ -> throw(einval) + end; +enc_stats([]) -> []. + + +decode_stats(Bytes) -> + try dec_stats(Bytes) of + Result -> {ok,Result} + catch + Error -> {error,Error} + end. + + +dec_stats([?INET_STAT_SEND_OCT,X7,X6,X5,X4,X3,X2,X1,X0|R]) -> + Val = ?u64(X7,X6,X5,X4,X3,X2,X1,X0), + [{send_oct, Val}|dec_stats(R)]; +dec_stats([?INET_STAT_RECV_OCT,X7,X6,X5,X4,X3,X2,X1,X0|R]) -> + Val = ?u64(X7,X6,X5,X4,X3,X2,X1,X0), + [{recv_oct, Val}|dec_stats(R)]; +dec_stats([X,X3,X2,X1,X0|R]) -> + Val = ?u32(X3,X2,X1,X0), + case X of + ?INET_STAT_RECV_CNT -> [{recv_cnt,Val} |dec_stats(R)]; + ?INET_STAT_RECV_MAX -> [{recv_max,Val} |dec_stats(R)]; + ?INET_STAT_RECV_AVG -> [{recv_avg,Val} |dec_stats(R)]; + ?INET_STAT_RECV_DVI -> [{recv_dvi,Val} |dec_stats(R)]; + ?INET_STAT_SEND_CNT -> [{send_cnt,Val} |dec_stats(R)]; + ?INET_STAT_SEND_MAX -> [{send_max,Val} |dec_stats(R)]; + ?INET_STAT_SEND_AVG -> [{send_avg,Val} |dec_stats(R)]; + ?INET_STAT_SEND_PEND -> [{send_pend,Val}|dec_stats(R)]; + _ -> throw(einval) + end; +dec_stats([]) -> []. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% handle status options +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +dec_status(Flags) -> + enum_names(Flags, + [ + {busy, ?INET_F_BUSY}, + %% {listening, ?INET_F_LST}, NOT USED ANY MORE + {accepting, ?INET_F_ACC}, + {connecting, ?INET_F_CON}, + {listen, ?INET_F_LISTEN}, + {connected, ?INET_F_ACTIVE}, + {bound, ?INET_F_BOUND}, + {open, ?INET_F_OPEN} + ]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% UTILS +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +enc_time(Time) when Time < 0 -> [255,255,255,255]; +enc_time(Time) -> ?int32(Time). + +encode_ifname(Name) when is_atom(Name) -> encode_ifname(atom_to_list(Name)); +encode_ifname(Name) -> + N = length(Name), + if N > 255 -> {error, einval}; + true -> {ok,[N | Name]} + end. + +build_iflist(Cs) -> + build_iflist(Cs, [], []). + +%% Turn a NULL separated list of chars into a list of strings, removing +%% duplicates. +build_iflist([0|L], Acc, [H|T]) -> + case rev(Acc) of + H -> build_iflist(L, [], [H|T]); + N -> build_iflist(L, [], [N,H|T]) + end; +build_iflist([0|L], Acc, []) -> + build_iflist(L, [], [rev(Acc)]); +build_iflist([C|L], Acc, List) -> + build_iflist(L, [C|Acc], List); +build_iflist([], [], List) -> + rev(List); +build_iflist([], Acc, List) -> + build_iflist([0], Acc, List). + +rev(L) -> rev(L,[]). +rev([C|L],Acc) -> rev(L,[C|Acc]); +rev([],Acc) -> Acc. + +ip_to_bytes(IP) when tuple_size(IP) =:= 4 -> ip4_to_bytes(IP); +ip_to_bytes(IP) when tuple_size(IP) =:= 8 -> ip6_to_bytes(IP). + +ip4_to_bytes({A,B,C,D}) -> + [A band 16#ff, B band 16#ff, C band 16#ff, D band 16#ff]. + +ip6_to_bytes({A,B,C,D,E,F,G,H}) -> + [?int16(A), ?int16(B), ?int16(C), ?int16(D), + ?int16(E), ?int16(F), ?int16(G), ?int16(H)]. + +get_ip(?INET_AF_INET, Addr) -> get_ip4(Addr); +get_ip(?INET_AF_INET6, Addr) -> get_ip6(Addr). + +get_ip4([A,B,C,D | T]) -> {{A,B,C,D},T}. + +get_ip6([X1,X2,X3,X4,X5,X6,X7,X8,X9,X10,X11,X12,X13,X14,X15,X16 | T]) -> + { { ?u16(X1,X2),?u16(X3,X4),?u16(X5,X6),?u16(X7,X8), + ?u16(X9,X10),?u16(X11,X12),?u16(X13,X14),?u16(X15,X16)}, T}. + + +%% Control command +ctl_cmd(Port, Cmd, Args) -> + ?DBG_FORMAT("prim_inet:ctl_cmd(~p, ~p, ~p)~n", [Port,Cmd,Args]), + Result = + try erlang:port_control(Port, Cmd, Args) of + [?INET_REP_OK|Reply] -> {ok,Reply}; + [?INET_REP_SCTP] -> {error,sctp_reply}; + [?INET_REP_ERROR|Err] -> {error,list_to_atom(Err)} + catch + error:_ -> {error,einval} + end, + ?DBG_FORMAT("prim_inet:ctl_cmd() -> ~p~n", [Result]), + Result. diff --git a/erts/preloaded/src/prim_zip.erl b/erts/preloaded/src/prim_zip.erl new file mode 100644 index 0000000000..17ef8c6c43 --- /dev/null +++ b/erts/preloaded/src/prim_zip.erl @@ -0,0 +1,604 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% zip functions that are used by code_server + +-module(prim_zip). + +%% unzipping piecemal +-export([ + open/1, + open/3, + foldl/3, + close/1 + ]). + +%% Internal function. Exported to avoid dialyzer warnings +-export([splitter/3]). + +%% includes +-include_lib("kernel/include/file.hrl"). % #file_info +-include_lib("stdlib/include/zip.hrl"). % #zip_file, #zip_comment +-include("zip_internal.hrl"). % #cd_file_header etc + +%% max bytes read from files and archives (and fed to zlib) +-define(READ_BLOCK_SIZE, 16*1024). + +%% for debugging, to turn off catch +-define(CATCH, catch). + +-record(primzip_file, + {name, + get_info, + get_bin}). + +-record(primzip, + {files = [] :: [#primzip_file{}], + zlib, % handle to the zlib port from zlib:open + input, % fun/2 for file/memory input + in}). % input (file handle or binary) + +filter_fun() -> + Continue = true, + Include = true, + fun({_Name, _GetInfoFun, _GetBinFun}, Acc) -> + {Continue, Include, Acc} + end. + +%% Open a zip archive +open(F) -> + open(filter_fun(), undefined, F). + +open(FilterFun, FilterAcc, F) -> + case ?CATCH do_open(FilterFun, FilterAcc, F) of + {ok, PrimZip, Acc} -> + {ok, PrimZip, Acc}; + Error -> + {error, Error} + end. + +do_open(FilterFun, FilterAcc, F) -> + Input = get_zip_input(F), + In0 = Input({open, F, [read, binary, raw]}, []), + Z = zlib:open(), + PrimZip = #primzip{files = [], zlib = Z, in = In0, input = Input}, + {PrimZip2, FilterAcc2} = get_central_dir(PrimZip, FilterFun, FilterAcc), + {ok, PrimZip2, FilterAcc2}. + +%% iterate over all files in a zip archive +foldl(FilterFun, FilterAcc, #primzip{files = Files} = PrimZip) -> + case ?CATCH do_foldl(FilterFun, FilterAcc, Files, [], PrimZip, PrimZip) of + {ok, FilterAcc2, PrimZip2} -> {ok, PrimZip2, FilterAcc2}; + Error -> {error, Error} + end; +foldl(_, _, _) -> + {error, einval}. + +do_foldl(FilterFun, FilterAcc, [PF | Tail], Acc0, PrimZip, PrimZipOrig) -> + #primzip_file{name = F, get_info = GetInfo, get_bin = GetBin} = PF, + case FilterFun({F, GetInfo, GetBin}, FilterAcc) of + {Continue, Include, FilterAcc2} -> + Acc1 = + case Include of + false -> Acc0; + true -> [PF | Acc0]; + {true, Nick} -> [PF#primzip_file{name = Nick} | Acc0] + end, + case Continue of + true -> + do_foldl(FilterFun, FilterAcc2, Tail, Acc1, PrimZip, PrimZipOrig); + false -> + {ok, FilterAcc2, PrimZipOrig} + end; + FilterRes -> + throw({illegal_filter, FilterRes}) + end; +do_foldl(_FilterFun, FilterAcc, [], Acc, PrimZip, _PrimZipOrig) -> + {ok, FilterAcc, PrimZip#primzip{files = reverse(Acc)}}. + +%% close a zip archive +close(#primzip{in = In0, input = Input, zlib = Z}) -> + Input(close, In0), + zlib:close(Z); +close(_) -> + {error, einval}. + +get_zip_input({F, B}) when is_binary(B), is_list(F) -> + fun binary_io/2; +get_zip_input(F) when is_list(F) -> + fun prim_file_io/2. + +%% get a file from the archive +get_z_file(F, Offset, ChunkSize, #primzip{zlib = Z, in = In0, input = Input}) -> + case Input({pread, Offset, ChunkSize}, In0) of + {<> = B, _In1} -> + #local_file_header{gp_flag = GPFlag, + file_name_length = FNLen, + extra_field_length = EFLen, + comp_method = CompMethod} = + local_file_header_from_bin(BLH, F), + DataOffs = ?LOCAL_FILE_HEADER_SZ + FNLen + EFLen + + offset_over_z_data_descriptor(GPFlag), + case B of + <<_:DataOffs/binary, Data/binary>> -> + Out = get_z_all(CompMethod, Data, Z, F), + %%{Out, CRC} = get_z_all(CompMethod, Data, Z, F), + %%CRC == CRC32 orelse throw({bad_crc, F}), + Out; + _ -> + throw({bad_local_file_offset, F}) + end; + _ -> + throw({bad_local_file_header, F}) + end. + +%% flag for zlib +-define(MAX_WBITS, 15). + +%% get compressed or stored data +get_z_all(?DEFLATED, Compressed, Z, _F) -> + ok = zlib:inflateInit(Z, -?MAX_WBITS), + Uncompressed = zlib:inflate(Z, Compressed), + %%_CRC = zlib:crc32(Z), + ?CATCH zlib:inflateEnd(Z), + erlang:iolist_to_binary(Uncompressed); % {erlang:iolist_to_binary(Uncompressed), CRC} +get_z_all(?STORED, Stored, _Z, _F) -> + %%CRC0 = zlib:crc32(Z, <<>>), + %%CRC1 = zlib:crc32(Z, CRC0, Stored), + Stored; % {Stored, CRC1}; +get_z_all(CompMethod, _, _, F) -> + throw({unsupported_compression, F, CompMethod}). + +%% skip data descriptor if any +offset_over_z_data_descriptor(GPFlag) when GPFlag band 8 =:= 8 -> + 12; +offset_over_z_data_descriptor(_GPFlag) -> + 0. + +%% get the central directory from the archive +get_central_dir(#primzip{in = In0, input = Input} = PrimZip, FilterFun, FilterAcc) -> + {B, In1} = get_end_of_central_dir(In0, ?END_OF_CENTRAL_DIR_SZ, Input), + {EOCD, _BComment} = eocd_and_comment_from_bin(B), + {BCD, In2} = Input({pread, EOCD#eocd.offset, EOCD#eocd.size}, In1), + N = EOCD#eocd.entries, + EndOffset = EOCD#eocd.offset, + PrimZip2 = PrimZip#primzip{in = In2}, + if + N =:= 0 -> + {PrimZip2, FilterAcc}; + true -> + {F, Offset, CFH, BCDRest} = get_file_header(BCD), + get_cd_loop(N, BCDRest, [], PrimZip2, F, Offset, CFH, EndOffset, FilterFun, FilterAcc, PrimZip) + end. + +get_cd_loop(N, BCD, Acc0, PrimZip, FileName, Offset, CFH, EndOffset, FilterFun, FilterAcc, PrimZipOrig) -> + {NextF, NextOffset, NextCFH, BCDRest, Size} = + if + N =:= 1 -> + {undefined, undefined, undefined, undefined, EndOffset - Offset}; + true -> + {NextF0, NextOffset0, NextCFH0, BCDRest0} = get_file_header(BCD), + {NextF0, NextOffset0, NextCFH0, BCDRest0, NextOffset0 - Offset} + end, + %% erlang:display({FileName, N, Offset, Size, NextPF}), + GetInfo = fun() -> cd_file_header_to_file_info(FileName, CFH, <<>>) end, + GetBin = fun() -> get_z_file(FileName, Offset, Size, PrimZip) end, + PF = #primzip_file{name = FileName, get_info = GetInfo, get_bin = GetBin}, + case FilterFun({FileName, GetInfo, GetBin}, FilterAcc) of + {Continue, Include, FilterAcc2} -> + Acc1 = + case Include of + false -> Acc0; + true -> [PF | Acc0]; + {true, Nick} -> [PF#primzip_file{name = Nick} | Acc0] + end, + case Continue of + true when N > 1 -> + get_cd_loop(N-1, BCDRest, Acc1, PrimZip, NextF, NextOffset, NextCFH, EndOffset, FilterFun, FilterAcc2, PrimZipOrig); + true -> + PrimZip2 = PrimZip#primzip{files = reverse(Acc1)}, + {PrimZip2, FilterAcc2}; + false -> + {PrimZipOrig, FilterAcc2} + end; + FilterRes -> + throw({illegal_filter, FilterRes}) + end. + +get_file_header(BCD) -> + BCFH = + case BCD of + <> -> + B; + _ -> + throw(bad_central_directory) + end, + CFH = cd_file_header_from_bin(BCFH), + FileNameLen = CFH#cd_file_header.file_name_length, + ExtraLen = CFH#cd_file_header.extra_field_length, + CommentLen = CFH#cd_file_header.file_comment_length, + ToGet = FileNameLen + ExtraLen + CommentLen, + {B2, BCDRest} = + case BCD of + <<_:?CENTRAL_FILE_HEADER_SZ/binary, + G:ToGet/binary, + Rest/binary>> -> + {G, Rest}; + _ -> + throw(bad_central_directory) + end, + FileName = get_filename_from_b2(B2, FileNameLen, ExtraLen, CommentLen), + Offset = CFH#cd_file_header.local_header_offset, + {FileName, Offset, CFH, BCDRest}. + +get_filename_from_b2(B, FileNameLen, ExtraLen, CommentLen) -> + case B of + <> -> + binary_to_list(BFileName); + _ -> + throw(bad_central_directory) + end. + +%% get end record, containing the offset to the central directory +%% the end record is always at the end of the file BUT alas it is +%% of variable size (yes that's dumb!) +get_end_of_central_dir(_In, Sz, _Input) when Sz > 16#ffff -> + throw(bad_eocd); +get_end_of_central_dir(In0, Sz, Input) -> + In1 = Input({seek, eof, -Sz}, In0), + {B, In2} = Input({read, Sz}, In1), + case find_eocd_header(B) of + none -> + get_end_of_central_dir(In2, Sz+Sz, Input); + Header -> + {Header, In2} + end. + +%% find the end record by matching for it +find_eocd_header(<>) -> + Rest; +find_eocd_header(<<_:8, Rest/binary>>) + when byte_size(Rest) > ?END_OF_CENTRAL_DIR_SZ-4 -> + find_eocd_header(Rest); +find_eocd_header(_) -> + none. + +%% io objects +prim_file_io({file_info, F}, _) -> + case prim_file:read_file_info(F) of + {ok, Info} -> Info; + {error, E} -> throw(E) + end; +prim_file_io({open, FN, Opts}, _) -> + case ?CATCH prim_file:open(FN, Opts++[binary]) of + {ok, H} -> + H; + {error, E} -> + throw(E) + end; +prim_file_io({read, N}, H) -> + case prim_file:read(H, N) of + {ok, B} -> {B, H}; + eof -> {eof, H}; + {error, E} -> throw(E) + end; +prim_file_io({pread, Pos, N}, H) -> + case prim_file:pread(H, Pos, N) of + {ok, B} -> {B, H}; + eof -> {eof, H}; + {error, E} -> throw(E) + end; +prim_file_io({seek, S, Pos}, H) -> + case prim_file:position(H, {S, Pos}) of + {ok, _NewPos} -> H; + {error, Error} -> throw(Error) + end; +prim_file_io({write, Data}, H) -> + case prim_file:write(H, Data) of + ok -> H; + {error, Error} -> throw(Error) + end; +prim_file_io({pwrite, Pos, Data}, H) -> + case prim_file:pwrite(H, Pos, Data) of + ok -> H; + {error, Error} -> throw(Error) + end; +prim_file_io({close, FN}, H) -> + case prim_file:close(H) of + ok -> FN; + {error, Error} -> throw(Error) + end; +prim_file_io(close, H) -> + prim_file_io({close, ok}, H); +prim_file_io({set_file_info, F, FI}, H) -> + case prim_file:write_file_info(F, FI) of + ok -> H; + {error, Error} -> throw(Error) + end. + +binary_io({pread, NewPos, N}, {OldPos, B}) -> + case B of + <<_:NewPos/binary, Read:N/binary, _Rest/binary>> -> + {Read, {NewPos+N, B}}; + _ -> + {eof, {OldPos, B}} + end; +binary_io({read, N}, {Pos, B}) when Pos >= byte_size(B) -> + {eof, {Pos+N, B}}; +binary_io({read, N}, {Pos, B}) when Pos + N > byte_size(B) -> + case B of + <<_:Pos/binary, Read/binary>> -> + {Read, {byte_size(B), B}}; + _ -> + {eof, {Pos, B}} + end; +binary_io({read, N}, {Pos, B}) -> + case B of + <<_:Pos/binary, Read:N/binary, _/binary>> -> + {Read, {Pos+N, B}}; + _ -> + {eof, {Pos, B}} + end; +binary_io({seek, bof, Pos}, {_OldPos, B}) -> + {Pos, B}; +binary_io({seek, cur, Pos}, {OldPos, B}) -> + {OldPos + Pos, B}; +binary_io({seek, eof, Pos}, {_OldPos, B}) -> + {byte_size(B) + Pos, B}; +binary_io({file_info, {_Filename, B}}, A) -> + binary_io({file_info, B}, A); +binary_io({file_info, B}, _) -> + {Type, Size} = + if + is_binary(B) -> {regular, byte_size(B)}; + B =:= directory -> {directory, 0} + end, + Now = calendar:local_time(), + #file_info{size = Size, type = Type, access = read_write, + atime = Now, mtime = Now, ctime = Now, + mode = 0, links = 1, major_device = 0, + minor_device = 0, inode = 0, uid = 0, gid = 0}; +binary_io({pwrite, Pos, Data}, {OldPos, B}) -> + {OldPos, pwrite_binary(B, Pos, Data)}; +binary_io({write, Data}, {Pos, B}) -> + {Pos + erlang:iolist_size(Data), pwrite_binary(B, Pos, Data)}; +binary_io({open, {_Filename, B}, _Opts}, _) -> + {0, B}; +binary_io({open, B, _Opts}, _) when is_binary(B) -> + {0, B}; +binary_io({open, Filename, _Opts}, _) when is_list(Filename) -> + {0, <<>>}; +binary_io(close, {_Pos, B}) -> + B; +binary_io({close, FN}, {_Pos, B}) -> + {FN, B}. + +%% ZIP header manipulations +eocd_and_comment_from_bin(<>) -> + {#eocd{disk_num = DiskNum, + start_disk_num = StartDiskNum, + entries_on_disk = EntriesOnDisk, + entries = Entries, + size = Size, + offset = Offset, + zip_comment_length = ZipCommentLength}, + Comment}; +eocd_and_comment_from_bin(_) -> + throw(bad_eocd). + +%% make a file_info from a central directory header +cd_file_header_to_file_info(FileName, + #cd_file_header{uncomp_size = UncompSize, + last_mod_time = ModTime, + last_mod_date = ModDate}, + ExtraField) when is_binary(ExtraField) -> + T = dos_date_time_to_datetime(ModDate, ModTime), + Type = + case last(FileName) of + $/ -> directory; + _ -> regular + end, + FI = #file_info{size = UncompSize, + type = Type, + access = read_write, + atime = T, + mtime = T, + ctime = T, + mode = 8#066, + links = 1, + major_device = 0, + minor_device = 0, + inode = 0, + uid = 0, + gid = 0}, + add_extra_info(FI, ExtraField). + +%% add extra info to file (some day when we implement it) +%% add_extra_info(FI, <>) -> +%% FI; % not yet supported, some other day... +%% add_extra_info(FI, <>) -> +%% _UnixExtra = unix_extra_field_and_var_from_bin(Rest), +%% FI; % not yet supported, and not widely used +add_extra_info(FI, _) -> + FI. +%% +%% unix_extra_field_and_var_from_bin(<>) -> +%% {#unix_extra_field{atime = ATime, +%% mtime = MTime, +%% uid = UID, +%% gid = GID}, +%% Var}; +%% unix_extra_field_and_var_from_bin(_) -> +%% throw(bad_unix_extra_field). + +%% convert between erlang datetime and the MSDOS date and time +%% that's stored in the zip archive +%% MSDOS Time MSDOS Date +%% bit 0 - 4 5 - 10 11 - 15 16 - 20 21 - 24 25 - 31 +%% value second minute hour day (1 - 31) month (1 - 12) years from 1980 +dos_date_time_to_datetime(DosDate, DosTime) -> + <> = <>, + <> = <>, + {{YearFrom1980+1980, Month, Day}, + {Hour, Min, Sec}}. + +cd_file_header_from_bin(<>) -> + #cd_file_header{version_made_by = VersionMadeBy, + version_needed = VersionNeeded, + gp_flag = GPFlag, + comp_method = CompMethod, + last_mod_time = LastModTime, + last_mod_date = LastModDate, + crc32 = CRC32, + comp_size = CompSize, + uncomp_size = UncompSize, + file_name_length = FileNameLength, + extra_field_length = ExtraFieldLength, + file_comment_length = FileCommentLength, + disk_num_start = DiskNumStart, + internal_attr = InternalAttr, + external_attr = ExternalAttr, + local_header_offset = LocalHeaderOffset}; +cd_file_header_from_bin(_) -> + throw(bad_cd_file_header). + +local_file_header_from_bin(<>, + _F) -> + #local_file_header{version_needed = VersionNeeded, + gp_flag = GPFlag, + comp_method = CompMethod, + last_mod_time = LastModTime, + last_mod_date = LastModDate, + crc32 = CRC32, + comp_size = CompSize, + uncomp_size = UncompSize, + file_name_length = FileNameLength, + extra_field_length = ExtraFieldLength}; +local_file_header_from_bin(_, F) -> + throw({bad_local_file_header, F}). + +%% A pwrite-like function for iolists (used by memory-option) + +split_iolist(B, Pos) when is_binary(B) -> + split_binary(B, Pos); +split_iolist(L, Pos) when is_list(L) -> + splitter([], L, Pos). + +splitter(Left, Right, 0) -> + {Left, Right}; +splitter(<<>>, Right, RelPos) -> + split_iolist(Right, RelPos); +splitter(Left, [A | Right], RelPos) when is_list(A) or is_binary(A) -> + Sz = erlang:iolist_size(A), + case Sz > RelPos of + true -> + {Leftx, Rightx} = split_iolist(A, RelPos), + {[Left | Leftx], [Rightx, Right]}; + _ -> + splitter([Left | A], Right, RelPos - Sz) + end; +splitter(Left, [A | Right], RelPos) when is_integer(A) -> + splitter([Left, A], Right, RelPos - 1); +splitter(Left, Right, RelPos) when is_binary(Right) -> + splitter(Left, [Right], RelPos). + +skip_iolist(B, Pos) when is_binary(B) -> + case B of + <<_:Pos/binary, Bin/binary>> -> Bin; + _ -> <<>> + end; +skip_iolist(L, Pos) when is_list(L) -> + skipper(L, Pos). + +skipper(Right, 0) -> + Right; +skipper([A | Right], RelPos) when is_list(A) or is_binary(A) -> + Sz = erlang:iolist_size(A), + case Sz > RelPos of + true -> + Rightx = skip_iolist(A, RelPos), + [Rightx, Right]; + _ -> + skip_iolist(Right, RelPos - Sz) + end; +skipper([A | Right], RelPos) when is_integer(A) -> + skip_iolist(Right, RelPos - 1). + +pwrite_iolist(Iolist, Pos, Bin) -> + {Left, Right} = split_iolist(Iolist, Pos), + Sz = erlang:iolist_size(Bin), + R = skip_iolist(Right, Sz), + [Left, Bin | R]. + +pwrite_binary(B, Pos, Bin) -> + erlang:iolist_to_binary(pwrite_iolist(B, Pos, Bin)). + +reverse(X) -> + reverse(X, []). + +reverse([H|T], Y) -> + reverse(T, [H|Y]); +reverse([], X) -> + X. + +last([E|Es]) -> last(E, Es). + +last(_, [E|Es]) -> last(E, Es); +last(E, []) -> E. diff --git a/erts/preloaded/src/zip_internal.hrl b/erts/preloaded/src/zip_internal.hrl new file mode 100644 index 0000000000..a8f7b1f1b7 --- /dev/null +++ b/erts/preloaded/src/zip_internal.hrl @@ -0,0 +1,103 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% ZIP-file format records and defines + +%% compression methods +-define(STORED, 0). +-define(UNCOMPRESSED, 0). +-define(SHRUNK, 1). +-define(REDUCED_1, 2). +-define(REDUCED_2, 3). +-define(REDUCED_3, 4). +-define(REDUCED_4, 5). +-define(IMPLODED, 6). +-define(TOKENIZED, 7). +-define(DEFLATED, 8). +-define(DEFLATED_64, 9). +-define(PKWARE_IMPLODED, 10). +-define(PKWARE_RESERVED, 11). +-define(BZIP2_COMPRESSED, 12). + +%% zip-file records +-define(LOCAL_FILE_MAGIC,16#04034b50). +-define(LOCAL_FILE_HEADER_SZ,(4+2+2+2+2+2+4+4+4+2+2)). +-define(LOCAL_FILE_HEADER_CRC32_OFFSET, 4+2+2+2+2+2). +-record(local_file_header, {version_needed, + gp_flag, + comp_method, + last_mod_time, + last_mod_date, + crc32, + comp_size, + uncomp_size, + file_name_length, + extra_field_length}). + +-define(CENTRAL_FILE_HEADER_SZ,(4+2+2+2+2+2+2+4+4+4+2+2+2+2+2+4+4)). + +-define(CENTRAL_DIR_MAGIC, 16#06054b50). +-define(CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)). +-define(CENTRAL_DIR_DIGITAL_SIG_MAGIC, 16#05054b50). +-define(CENTRAL_DIR_DIGITAL_SIG_SZ, (4+2)). + +-define(CENTRAL_FILE_MAGIC, 16#02014b50). + +-record(cd_file_header, {version_made_by, + version_needed, + gp_flag, + comp_method, + last_mod_time, + last_mod_date, + crc32, + comp_size, + uncomp_size, + file_name_length, + extra_field_length, + file_comment_length, + disk_num_start, + internal_attr, + external_attr, + local_header_offset}). + +%% Unix extra fields (not yet supported) +-define(UNIX_EXTRA_FIELD_TAG, 16#000d). +-record(unix_extra_field, {atime, + mtime, + uid, + gid}). + +%% extended timestamps (not yet supported) +-define(EXTENDED_TIMESTAMP_TAG, 16#5455). +-record(extended_timestamp, {mtime, + atime, + ctime}). + +-define(END_OF_CENTRAL_DIR_MAGIC, 16#06054b50). +-define(END_OF_CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)). + +-record(eocd, {disk_num, + start_disk_num, + entries_on_disk, + entries, + size, + offset, + zip_comment_length}). + + diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl new file mode 100644 index 0000000000..21971a75cf --- /dev/null +++ b/erts/preloaded/src/zlib.erl @@ -0,0 +1,421 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(zlib). + +-export([open/0,close/1,deflateInit/1,deflateInit/2,deflateInit/6, + deflateSetDictionary/2,deflateReset/1,deflateParams/3, + deflate/2,deflate/3,deflateEnd/1, + inflateInit/1,inflateInit/2,inflateSetDictionary/2, + inflateSync/1,inflateReset/1,inflate/2,inflateEnd/1, + setBufSize/2,getBufSize/1, + crc32/1,crc32/2,crc32/3,adler32/2,adler32/3,getQSize/1, + crc32_combine/4,adler32_combine/4, + compress/1,uncompress/1,zip/1,unzip/1, + gzip/1,gunzip/1]). + +%% flush argument encoding +-define(Z_NO_FLUSH, 0). +-define(Z_SYNC_FLUSH, 2). +-define(Z_FULL_FLUSH, 3). +-define(Z_FINISH, 4). + +%% compression level +-define(Z_NO_COMPRESSION, 0). +-define(Z_BEST_SPEED, 1). +-define(Z_BEST_COMPRESSION, 9). +-define(Z_DEFAULT_COMPRESSION, (-1)). + +%% compresssion strategy +-define(Z_FILTERED, 1). +-define(Z_HUFFMAN_ONLY, 2). +-define(Z_DEFAULT_STRATEGY, 0). + +%% deflate compression method +-define(Z_DEFLATED, 8). + +-define(Z_NULL, 0). + +-define(MAX_WBITS, 15). + +%% gzip defs (rfc 1952) + +-define(ID1, 16#1f). +-define(ID2, 16#8b). + +-define(FTEXT, 16#01). +-define(FHCRC, 16#02). +-define(FEXTRA, 16#04). +-define(FNAME, 16#08). +-define(FCOMMENT, 16#10). +-define(RESERVED, 16#E0). + +-define(OS_MDDOS, 0). +-define(OS_AMIGA, 1). +-define(OS_OPENVMS, 2). +-define(OS_UNIX, 3). +-define(OS_VMCMS, 4). +-define(OS_ATARI, 5). +-define(OS_OS2, 6). +-define(OS_MAC, 7). +-define(OS_ZSYS, 8). +-define(OS_CPM, 9). +-define(OS_TOP20, 10). +-define(OS_NTFS, 11). +-define(OS_QDOS, 12). +-define(OS_ACORN, 13). +-define(OS_UNKNOWN,255). + +-define(DEFLATE_INIT, 1). +-define(DEFLATE_INIT2, 2). +-define(DEFLATE_SETDICT, 3). +-define(DEFLATE_RESET, 4). +-define(DEFLATE_END, 5). +-define(DEFLATE_PARAMS, 6). +-define(DEFLATE, 7). + +-define(INFLATE_INIT, 8). +-define(INFLATE_INIT2, 9). +-define(INFLATE_SETDICT, 10). +-define(INFLATE_SYNC, 11). +-define(INFLATE_RESET, 12). +-define(INFLATE_END, 13). +-define(INFLATE, 14). + +-define(CRC32_0, 15). +-define(CRC32_1, 16). +-define(CRC32_2, 17). + +-define(SET_BUFSZ, 18). +-define(GET_BUFSZ, 19). +-define(GET_QSIZE, 20). + +-define(ADLER32_1, 21). +-define(ADLER32_2, 22). + +-define(CRC32_COMBINE, 23). +-define(ADLER32_COMBINE, 24). + +%%------------------------------------------------------------------------ + +%% Main data types of the file +-type(iodata() :: iolist() | binary()). %XXX To be removed in R13B. +-type zstream() :: port(). + +%% Auxiliary data types of the file +-type zlevel() :: 'none' | 'default' | 'best_compression' | 'best_speed' + | 0..9. +-type zmethod() :: 'deflated'. +-type zwindowbits() :: -15..-9 | 9..47. +-type zmemlevel() :: 1..9. +-type zstrategy() :: 'default' | 'filtered' | 'huffman_only'. +-type zflush() :: 'none' | 'sync' | 'full' | 'finish'. + +%%------------------------------------------------------------------------ + +%% open a z_stream +-spec open() -> zstream(). +open() -> + open_port({spawn, "zlib_drv"}, [binary]). + +%% close and release z_stream +-spec close(zstream()) -> 'ok'. +close(Z) -> + try + true = port_close(Z), + receive %In case the caller is the owner and traps exits + {'EXIT',Z,_} -> ok + after 0 -> ok + end + catch _:_ -> erlang:error(badarg) + end. + +-spec deflateInit(zstream()) -> 'ok'. +deflateInit(Z) -> + call(Z, ?DEFLATE_INIT, <>). + +-spec deflateInit(zstream(), zlevel()) -> 'ok'. +deflateInit(Z, Level) -> + call(Z, ?DEFLATE_INIT, <<(arg_level(Level)):32>>). + +-spec deflateInit(zstream(), zlevel(), zmethod(), + zwindowbits(), zmemlevel(), zstrategy()) -> 'ok'. +deflateInit(Z, Level, Method, WindowBits, MemLevel, Strategy) -> + call(Z, ?DEFLATE_INIT2, <<(arg_level(Level)):32, + (arg_method(Method)):32, + (arg_bitsz(WindowBits)):32, + (arg_mem(MemLevel)):32, + (arg_strategy(Strategy)):32>>). + +-spec deflateSetDictionary(zstream(), binary()) -> integer(). +deflateSetDictionary(Z, Dictionary) -> + call(Z, ?DEFLATE_SETDICT, Dictionary). + +-spec deflateReset(zstream()) -> 'ok'. +deflateReset(Z) -> + call(Z, ?DEFLATE_RESET, []). + +-spec deflateParams(zstream(), zlevel(), zstrategy()) -> 'ok'. +deflateParams(Z, Level, Strategy) -> + call(Z, ?DEFLATE_PARAMS, <<(arg_level(Level)):32, + (arg_strategy(Strategy)):32>>). + +-spec deflate(zstream(), iodata()) -> iolist(). +deflate(Z, Data) -> + deflate(Z, Data, none). + +-spec deflate(zstream(), iodata(), zflush()) -> iolist(). +deflate(Z, Data, Flush) -> + try port_command(Z, Data) of + true -> + call(Z, ?DEFLATE, <<(arg_flush(Flush)):32>>), + collect(Z) + catch + error:_Err -> + flush(Z), + erlang:error(badarg) + end. + +-spec deflateEnd(zstream()) -> 'ok'. +deflateEnd(Z) -> + call(Z, ?DEFLATE_END, []). + +-spec inflateInit(zstream()) -> 'ok'. +inflateInit(Z) -> + call(Z, ?INFLATE_INIT, []). + +-spec inflateInit(zstream(), zwindowbits()) -> 'ok'. +inflateInit(Z, WindowBits) -> + call(Z, ?INFLATE_INIT2, <<(arg_bitsz(WindowBits)):32>>). + +-spec inflateSetDictionary(zstream(), binary()) -> 'ok'. +inflateSetDictionary(Z, Dictionary) -> + call(Z, ?INFLATE_SETDICT, Dictionary). + +-spec inflateSync(zstream()) -> 'ok'. +inflateSync(Z) -> + call(Z, ?INFLATE_SYNC, []). + +-spec inflateReset(zstream()) -> 'ok'. +inflateReset(Z) -> + call(Z, ?INFLATE_RESET, []). + +-spec inflate(zstream(), iodata()) -> iolist(). +inflate(Z, Data) -> + try port_command(Z, Data) of + true -> + call(Z, ?INFLATE, <>), + collect(Z) + catch + error:_Err -> + flush(Z), + erlang:error(badarg) + end. + +-spec inflateEnd(zstream()) -> 'ok'. +inflateEnd(Z) -> + call(Z, ?INFLATE_END, []). + +-spec setBufSize(zstream(), non_neg_integer()) -> 'ok'. +setBufSize(Z, Size) -> + call(Z, ?SET_BUFSZ, <>). + +-spec getBufSize(zstream()) -> non_neg_integer(). +getBufSize(Z) -> + call(Z, ?GET_BUFSZ, []). + +-spec crc32(zstream()) -> integer(). +crc32(Z) -> + call(Z, ?CRC32_0, []). + +-spec crc32(zstream(), binary()) -> integer(). +crc32(Z, Binary) -> + call(Z, ?CRC32_1, Binary). + +-spec crc32(zstream(), integer(), binary()) -> integer(). +crc32(Z, CRC, Binary) when is_binary(Binary), is_integer(CRC) -> + call(Z, ?CRC32_2, <>); +crc32(_Z, _CRC, _Binary) -> + erlang:error(badarg). + +-spec adler32(zstream(), binary()) -> integer(). +adler32(Z, Binary) -> + call(Z, ?ADLER32_1, Binary). + +-spec adler32(zstream(), integer(), binary()) -> integer(). +adler32(Z, Adler, Binary) when is_binary(Binary), is_integer(Adler) -> + call(Z, ?ADLER32_2, <>); +adler32(_Z, _Adler, _Binary) -> + erlang:error(badarg). + +-spec crc32_combine(zstream(), integer(), integer(), integer()) -> integer(). +crc32_combine(Z, CRC1, CRC2, Len2) + when is_integer(CRC1), is_integer(CRC2), is_integer(Len2) -> + call(Z, ?CRC32_COMBINE, <>); +crc32_combine(_Z, _CRC1, _CRC2, _Len2) -> + erlang:error(badarg). + +-spec adler32_combine(zstream(), integer(), integer(), integer()) -> integer(). +adler32_combine(Z, Adler1, Adler2, Len2) + when is_integer(Adler1), is_integer(Adler2), is_integer(Len2) -> + call(Z, ?ADLER32_COMBINE, <>); +adler32_combine(_Z, _Adler1, _Adler2, _Len2) -> + erlang:error(badarg). + +-spec getQSize(zstream()) -> non_neg_integer(). +getQSize(Z) -> + call(Z, ?GET_QSIZE, []). + +%% compress/uncompress zlib with header +-spec compress(binary()) -> binary(). +compress(Binary) -> + Z = open(), + deflateInit(Z, default), + Bs = deflate(Z, Binary,finish), + deflateEnd(Z), + close(Z), + list_to_binary(Bs). + +-spec uncompress(binary()) -> binary(). +uncompress(Binary) when byte_size(Binary) >= 8 -> + Z = open(), + inflateInit(Z), + Bs = inflate(Z, Binary), + inflateEnd(Z), + close(Z), + list_to_binary(Bs); +uncompress(Binary) when is_binary(Binary) -> erlang:error(data_error); +uncompress(_) -> erlang:error(badarg). + +%% unzip/zip zlib without header (zip members) +-spec zip(binary()) -> binary(). +zip(Binary) -> + Z = open(), + deflateInit(Z, default, deflated, -?MAX_WBITS, 8, default), + Bs = deflate(Z, Binary, finish), + deflateEnd(Z), + close(Z), + list_to_binary(Bs). + +-spec unzip(binary()) -> binary(). +unzip(Binary) -> + Z = open(), + inflateInit(Z, -?MAX_WBITS), + Bs = inflate(Z, Binary), + inflateEnd(Z), + close(Z), + list_to_binary(Bs). + +-spec gzip(iodata()) -> binary(). +gzip(Data) when is_binary(Data); is_list(Data) -> + Z = open(), + deflateInit(Z, default, deflated, 16+?MAX_WBITS, 8, default), + Bs = deflate(Z, Data, finish), + deflateEnd(Z), + close(Z), + iolist_to_binary(Bs); +gzip(_) -> erlang:error(badarg). + +-spec gunzip(iodata()) -> binary(). +gunzip(Data) when is_binary(Data); is_list(Data) -> + Z = open(), + inflateInit(Z, 16+?MAX_WBITS), + Bs = inflate(Z, Data), + inflateEnd(Z), + close(Z), + iolist_to_binary(Bs); +gunzip(_) -> erlang:error(badarg). + +-spec collect(zstream()) -> iolist(). +collect(Z) -> + collect(Z, []). + +-spec collect(zstream(), iolist()) -> iolist(). +collect(Z, Acc) -> + receive + {Z, {data, Bin}} -> + collect(Z, [Bin|Acc]) + after 0 -> + reverse(Acc) + end. + +-spec flush(zstream()) -> 'ok'. +flush(Z) -> + receive + {Z, {data,_}} -> + flush(Z) + after 0 -> + ok + end. + +arg_flush(none) -> ?Z_NO_FLUSH; +%% ?Z_PARTIAL_FLUSH is deprecated in zlib -- deliberately not included. +arg_flush(sync) -> ?Z_SYNC_FLUSH; +arg_flush(full) -> ?Z_FULL_FLUSH; +arg_flush(finish) -> ?Z_FINISH; +arg_flush(_) -> erlang:error(badarg). + +arg_level(none) -> ?Z_NO_COMPRESSION; +arg_level(best_speed) -> ?Z_BEST_SPEED; +arg_level(best_compression) -> ?Z_BEST_COMPRESSION; +arg_level(default) -> ?Z_DEFAULT_COMPRESSION; +arg_level(Level) when is_integer(Level), Level >= 0, Level =< 9 -> Level; +arg_level(_) -> erlang:error(badarg). + +arg_strategy(filtered) -> ?Z_FILTERED; +arg_strategy(huffman_only) -> ?Z_HUFFMAN_ONLY; +arg_strategy(default) -> ?Z_DEFAULT_STRATEGY; +arg_strategy(_) -> erlang:error(badarg). + +arg_method(deflated) -> ?Z_DEFLATED; +arg_method(_) -> erlang:error(badarg). + +-spec arg_bitsz(zwindowbits()) -> zwindowbits(). +arg_bitsz(Bits) when is_integer(Bits) andalso + ((8 < Bits andalso Bits < 48) orelse + (-15 =< Bits andalso Bits < -8)) -> + Bits; +arg_bitsz(_) -> erlang:error(badarg). + +-spec arg_mem(zmemlevel()) -> zmemlevel(). +arg_mem(Level) when is_integer(Level), 1 =< Level, Level =< 9 -> Level; +arg_mem(_) -> erlang:error(badarg). + +call(Z, Cmd, Arg) -> + try port_control(Z, Cmd, Arg) of + [0|Res] -> list_to_atom(Res); + [1|Res] -> + flush(Z), + erlang:error(list_to_atom(Res)); + [2,A,B,C,D] -> + (A bsl 24)+(B bsl 16)+(C bsl 8)+D; + [3,A,B,C,D] -> + erlang:error({need_dictionary,(A bsl 24)+(B bsl 16)+(C bsl 8)+D}) + catch + error:badarg -> %% Rethrow loses port_control from stacktrace. + erlang:error(badarg) + end. + +reverse(X) -> + reverse(X, []). + +reverse([H|T], Y) -> + reverse(T, [H|Y]); +reverse([], X) -> + X. diff --git a/erts/start_scripts/Makefile b/erts/start_scripts/Makefile new file mode 100644 index 0000000000..862f7285bc --- /dev/null +++ b/erts/start_scripts/Makefile @@ -0,0 +1,179 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- + +SS_ROOT = $(ERL_TOP)/erts/start_scripts +SS_TMP = $(SS_ROOT)/tmp +LIBPATH= $(ERL_TOP)/lib +SCRIPT_PATH = -I$(LIBPATH)/kernel/ebin -I$(LIBPATH)/stdlib/ebin -I$(LIBPATH)/sasl/ebin +BOOTSTRAP_LIBPATH=$(BOOTSTRAP_TOP)/lib +BOOTSTRAP_SCRIPT_PATH = -I$(BOOTSTRAP_LIBPATH)/kernel/ebin -I$(BOOTSTRAP_LIBPATH)/stdlib/ebin + +INSTALL_SCRIPTS = \ + $(SS_ROOT)/start_clean.script \ + $(SS_ROOT)/start_clean.boot \ + $(SS_ROOT)/start_sasl.boot \ + $(SS_ROOT)/start_sasl.script + +REL_SCRIPTS = \ + $(SS_ROOT)/start_clean.rel \ + $(SS_ROOT)/start_sasl.rel \ + $(SS_ROOT)/start_all_example.rel + +ifneq ($(findstring win32,$(TARGET)),win32) +RELEASES_SRC = RELEASES.src +endif + +############################################################################## +# Get version numbers from the VSN files + +# VSN & SYSTEM_VSN +include ../vsn.mk +include $(LIBPATH)/kernel/vsn.mk +include $(LIBPATH)/stdlib/vsn.mk +-include $(LIBPATH)/sasl/vsn.mk +-include $(LIBPATH)/os_mon/vsn.mk +-include $(LIBPATH)/mnesia/vsn.mk +-include $(LIBPATH)/snmp/vsn.mk +-include $(LIBPATH)/inets/vsn.mk + +############################################################################## + +debug opt script: rel $(INSTALL_SCRIPTS) $(RELEASES_SRC) + +rel: $(REL_SCRIPTS) + +RELEASES.src: + $(INSTALL_DIR) $(SS_TMP) + ( cd $(SS_TMP) && \ + $(ERL) -noinput +B -eval 'release_handler:create_RELEASES("%ERL_ROOT%", "$(SS_ROOT)", "$(SS_ROOT)/start_sasl.rel", []), halt()') + mv RELEASES RELEASES.src + +$(SS_ROOT)/start_clean.script \ +$(SS_ROOT)/start_clean.boot: $(SS_ROOT)/start_clean.rel + $(INSTALL_DIR) $(SS_TMP) + ( cd $(SS_TMP) && \ + $(ERLC) $(SASL_FLAGS) $(SCRIPT_PATH) -o $@ $< ) + +$(SS_ROOT)/start_sasl.script \ +$(SS_ROOT)/start_sasl.boot: $(SS_ROOT)/start_sasl.rel + $(INSTALL_DIR) $(SS_TMP) + ( cd $(SS_TMP) && \ + $(ERLC) $(SASL_FLAGS) $(SCRIPT_PATH) -o $@ $< ) + +$(SS_ROOT)/start_clean.rel: $(SS_ROOT)/start_clean.rel.src \ + ../vsn.mk \ + $(LIBPATH)/kernel/vsn.mk \ + $(LIBPATH)/stdlib/vsn.mk + sed -e 's;%SYS_VSN%;$(SYSTEM_VSN);' \ + -e 's;%ERTS_VSN%;$(VSN);' \ + -e 's;%KERNEL_VSN%;$(KERNEL_VSN);' \ + -e 's;%STDLIB_VSN%;$(STDLIB_VSN);' \ + $(SS_ROOT)/start_clean.rel.src > $(SS_ROOT)/start_clean.rel + +$(SS_ROOT)/start_sasl.rel: $(SS_ROOT)/start_sasl.rel.src \ + ../vsn.mk \ + $(LIBPATH)/kernel/vsn.mk \ + $(LIBPATH)/stdlib/vsn.mk \ + $(LIBPATH)/sasl/vsn.mk + sed -e 's;%SYS_VSN%;$(SYSTEM_VSN);' \ + -e 's;%ERTS_VSN%;$(VSN);' \ + -e 's;%KERNEL_VSN%;$(KERNEL_VSN);' \ + -e 's;%STDLIB_VSN%;$(STDLIB_VSN);' \ + -e 's;%SASL_VSN%;$(SASL_VSN);' \ + $(SS_ROOT)/start_sasl.rel.src > $(SS_ROOT)/start_sasl.rel + +$(SS_ROOT)/start_all_example.rel: $(SS_ROOT)/start_all_example.rel.src \ + ../vsn.mk \ + $(LIBPATH)/kernel/vsn.mk \ + $(LIBPATH)/stdlib/vsn.mk \ + $(LIBPATH)/sasl/vsn.mk \ + $(LIBPATH)/os_mon/vsn.mk \ + $(LIBPATH)/mnesia/vsn.mk \ + $(LIBPATH)/snmp/vsn.mk \ + $(LIBPATH)/inets/vsn.mk + sed -e 's;%SYS_VSN%;$(SYSTEM_VSN);' \ + -e 's;%ERTS_VSN%;$(VSN);' \ + -e 's;%KERNEL_VSN%;$(KERNEL_VSN);' \ + -e 's;%STDLIB_VSN%;$(STDLIB_VSN);' \ + -e 's;%SASL_VSN%;$(SASL_VSN);' \ + -e 's;%OS_MON_VSN%;$(OS_MON_VSN);' \ + -e 's;%MNESIA_VSN%;$(MNESIA_VSN);' \ + -e 's;%SNMP_VSN%;$(SNMPEA_VSN);' \ + -e 's;%INETS_VSN%;$(INETS_VSN);' \ + $(SS_ROOT)/start_all_example.rel.src > $(SS_ROOT)/start_all_example.rel + +## Special target used from $(ERL_TOP)/erts/Makefile. +$(ERL_TOP)/bin/start.script: + $(INSTALL_DIR) $(SS_TMP) + ( cd $(SS_TMP) && \ + $(ERLC) $(SCRIPT_PATH) +otp_build -o $@ $(SS_ROOT)/start_clean.rel ) + +$(ERL_TOP)/bin/start_sasl.script: + $(INSTALL_DIR) $(SS_TMP) + ( cd $(SS_TMP) && \ + $(ERLC) $(SCRIPT_PATH) +otp_build -o $@ $(SS_ROOT)/start_sasl.rel ) + +$(ERL_TOP)/bin/start_clean.script: + $(INSTALL_DIR) $(SS_TMP) + ( cd $(SS_TMP) && \ + $(ERLC) $(SCRIPT_PATH) +otp_build -o $@ $(SS_ROOT)/start_clean.rel ) + +## Special target used from system/build/Makefile for source code release bootstrap. +bootstrap_scripts: $(SS_ROOT)/start_clean.rel + $(INSTALL_DIR) $(TESTROOT)/bin + $(INSTALL_DIR) $(SS_TMP) + ( cd $(SS_TMP) && \ + $(ERLC) $(BOOTSTRAP_SCRIPT_PATH) +otp_build +no_module_tests \ + -o $(TESTROOT)/bin/start.script $(SS_ROOT)/start_clean.rel ) + ( cd $(SS_TMP) && \ + $(ERLC) $(BOOTSTRAP_SCRIPT_PATH) +otp_build +no_module_tests \ + -o $(TESTROOT)/bin/start_clean.script $(SS_ROOT)/start_clean.rel ) + +clean: + $(RM) $(REL_SCRIPTS) $(INSTALL_SCRIPTS) + +docs: + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: script + $(INSTALL_DIR) $(RELEASE_PATH)/releases/$(SYSTEM_VSN) +ifneq ($(findstring win32,$(TARGET)),win32) + $(INSTALL_DATA) RELEASES.src $(RELEASE_PATH)/releases +endif + $(INSTALL_DATA) $(INSTALL_SCRIPTS) $(REL_SCRIPTS) \ + $(RELEASE_PATH)/releases/$(SYSTEM_VSN) + $(INSTALL_DATA) start_clean.script $(RELEASE_PATH)/releases/$(SYSTEM_VSN)/start.script + $(INSTALL_DATA) start_clean.boot $(RELEASE_PATH)/releases/$(SYSTEM_VSN)/start.boot + + +release_docs_spec: + +TRUE: + diff --git a/erts/start_scripts/start_all_example.rel.src b/erts/start_scripts/start_all_example.rel.src new file mode 100644 index 0000000000..581eb2eb0b --- /dev/null +++ b/erts/start_scripts/start_all_example.rel.src @@ -0,0 +1,26 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +{release, {"OTP APN 181 01","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, + [{kernel,"%KERNEL_VSN%"}, + {stdlib,"%STDLIB_VSN%"}, + {sasl, "%SASL_VSN%"}, + {os_mon, "%OS_MON_VSN%"}, + {inets, "%INETS_VSN%"}, + {snmp, "%SNMP_VSN%"}, + {mnesia, "%MNESIA_VSN%"}]}. diff --git a/erts/start_scripts/start_clean.rel.src b/erts/start_scripts/start_clean.rel.src new file mode 100644 index 0000000000..d2df422c51 --- /dev/null +++ b/erts/start_scripts/start_clean.rel.src @@ -0,0 +1,21 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +{release, {"OTP APN 181 01","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, + [{kernel,"%KERNEL_VSN%"}, + {stdlib,"%STDLIB_VSN%"}]}. diff --git a/erts/start_scripts/start_sasl.rel.src b/erts/start_scripts/start_sasl.rel.src new file mode 100644 index 0000000000..e521e8df91 --- /dev/null +++ b/erts/start_scripts/start_sasl.rel.src @@ -0,0 +1,22 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +{release, {"OTP APN 181 01","%SYS_VSN%"}, {erts, "%ERTS_VSN%"}, + [{kernel,"%KERNEL_VSN%"}, + {stdlib,"%STDLIB_VSN%"}, + {sasl, "%SASL_VSN%"}]}. diff --git a/erts/test/Makefile b/erts/test/Makefile new file mode 100644 index 0000000000..47e41a3625 --- /dev/null +++ b/erts/test/Makefile @@ -0,0 +1,81 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include $(ERL_TOP)/make/target.mk + +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +EBIN = . + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES= \ + erlc_SUITE \ + nt_SUITE \ + otp_SUITE \ + ethread_SUITE \ + erl_print_SUITE \ + run_erl_SUITE \ + erlexec_SUITE \ + z_SUITE + + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/system_test + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +tests debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f core *~ + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: + +release_tests_spec: opt + $(INSTALL_DIR) $(RELSYSDIR) + $(INSTALL_DATA) system.spec system.dynspec system.spec.vxworks \ + $(ERL_FILES) $(TARGET_FILES) $(RELSYSDIR) + chmod -f -R u+w $(RELSYSDIR) + tar cf - *_SUITE_data utils | (cd $(RELSYSDIR); tar xf -) + +release_docs_spec: diff --git a/erts/test/erl_print_SUITE.erl b/erts/test/erl_print_SUITE.erl new file mode 100644 index 0000000000..b1458d84d0 --- /dev/null +++ b/erts/test/erl_print_SUITE.erl @@ -0,0 +1,453 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : erl_print_SUITE.erl +%%% Author : Rickard Green +%%% Description : +%%% +%%% Created : 10 Mar 2005 by Rickard Green +%%%------------------------------------------------------------------- +-module(erl_print_SUITE). +-author('rickard.s.green@ericsson.com'). + + +%-define(line_trace, 1). + +-define(DEFAULT_TIMEOUT, ?t:minutes(10)). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([erlang_display/1, integer/1, float/1, string/1, character/1, snprintf/1, quote/1]). + +-include("test_server.hrl"). + +all(doc) -> []; +all(suite) -> test_cases(). + +%% +%% +%% Test cases +%% +%% + +test_cases() -> + [erlang_display, + integer, + float, + string, + character, + snprintf, + quote]. + +erlang_display(doc) -> []; +erlang_display(suite) -> []; +erlang_display(Config) when is_list(Config) -> + ?line put(erlang_display_test, ok), + OAIS = erts_debug:set_internal_state(available_internal_state, true), + + %% atoms + ?line chk_display(atom, "atom"), + ?line chk_display(true, "true"), + ?line chk_display(false, "false"), + ?line chk_display('DOWN', "'DOWN'"), + ?line chk_display('EXIT', "'EXIT'"), + ?line chk_display('asdDofw $@{}][', "'asdDofw $@{}]['"), + + %% integers + ?line chk_display(0, "0"), + ?line chk_display(1, "1"), + ?line chk_display(4711, "4711"), + ?line chk_display(((1 bsl 27) - 1), "134217727"), + ?line chk_display((1 bsl 27), "134217728"), + ?line chk_display((1 bsl 32), "4294967296"), + ?line chk_display(11111111111, "11111111111"), + ?line chk_display((1 bsl 59) - 1, "576460752303423487"), + ?line chk_display(1 bsl 59, "576460752303423488"), + ?line chk_display(111111111111111111111, "111111111111111111111"), + ?line chk_display(123456789012345678901234567890, + "123456789012345678901234567890"), + ?line chk_display(1 bsl 10000, str_1_bsl_10000()), + ?line chk_display(-1, "-1"), + ?line chk_display(-4711, "-4711"), + ?line chk_display(-(1 bsl 27), "-134217728"), + ?line chk_display(-((1 bsl 27) + 1), "-134217729"), + ?line chk_display(-(1 bsl 32), "-4294967296"), + ?line chk_display(-11111111111, "-11111111111"), + ?line chk_display(-(1 bsl 59), "-576460752303423488"), + ?line chk_display(-((1 bsl 59) + 1), "-576460752303423489"), + ?line chk_display(-111111111111111111111, "-111111111111111111111"), + ?line chk_display(-123456789012345678901234567890, + "-123456789012345678901234567890"), + ?line chk_display(-(1 bsl 10000), [$- | str_1_bsl_10000()]), + + ?line MyCre = my_cre(), + + %% pids + ?line chk_display(mk_pid_xstr({node(), MyCre}, 4711, 42)), + ?line chk_display(mk_pid_xstr({node(), oth_cre(MyCre)}, 4711, 42)), + ?line chk_display(mk_pid_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711, 42)), + + ?line chk_display(mk_pid_xstr({a@b, MyCre}, 4711, 42)), + ?line chk_display(mk_pid_xstr({a@b, oth_cre(MyCre)}, 4711, 42)), + ?line chk_display(mk_pid_xstr({a@b, oth_cre(oth_cre(MyCre))}, 4711, 42)), + + %% ports + ?line chk_display(mk_port_xstr({node(), MyCre}, 4711)), + ?line chk_display(mk_port_xstr({node(), oth_cre(MyCre)}, 4711)), + ?line chk_display(mk_port_xstr({node(), oth_cre(oth_cre(MyCre))}, 4711)), + + ?line chk_display(mk_port_xstr({c@d, MyCre}, 4711)), + ?line chk_display(mk_port_xstr({c@d, oth_cre(MyCre)}, 4711)), + ?line chk_display(mk_port_xstr({c@d, oth_cre(oth_cre(MyCre))}, 4711)), + + %% refs + ?line chk_display(mk_ref_xstr({node(), MyCre}, [1,2,3])), + ?line chk_display(mk_ref_xstr({node(), oth_cre(MyCre)}, [1,2,3])), + ?line chk_display(mk_ref_xstr({node(), oth_cre(oth_cre(MyCre))}, [1,2,3])), + + ?line chk_display(mk_ref_xstr({e@f, MyCre},[1,2,3] )), + ?line chk_display(mk_ref_xstr({e@f, oth_cre(MyCre)}, [1,2,3])), + ?line chk_display(mk_ref_xstr({e@f, oth_cre(oth_cre(MyCre))}, [1,2,3])), + + %% Compund terms + ?line {Pid, PidStr} = mk_pid_xstr({x@y, oth_cre(MyCre)}, 4712, 41), + ?line {Port, PortStr} = mk_port_xstr({x@y, oth_cre(MyCre)}, 4712), + ?line {Ref, RefStr} = mk_ref_xstr({e@f, oth_cre(MyCre)}, [11,12,13]), + + ?line chk_display({atom,-4711,Ref,{"hej",[Pid,222222222222222222222222,Port,4711]}}, + "{atom,-4711,"++RefStr++",{\"hej\",["++PidStr++",222222222222222222222222,"++PortStr++",4711]}}"), + ?line chk_display({{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}, + "{{{{{{{{{{{{{{{{{{{{{{{hi}}}}}}}}}}}}}}}}}}}}}}}"), + ?line chk_display([[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]], + "[[[[[[[[[[[[[[[[[[[[[[[yo]]]]]]]]]]]]]]]]]]]]]]]"), + ?line chk_display({[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}, + "{[{[{[{[{[{[{[{[{[{[{[{[ii]}]}]}]}]}]}]}]}]}]}]}]}"), + ?line chk_display([], "[]"), % Not really a compound term :) + ?line chk_display([a|b], "[a|b]"), + ?line chk_display([a,b,c|z], "[a,b,c|z]"), + ?line chk_display([a,b,c], "[a,b,c]"), + ?line chk_display([Pid,Port,Ref], + "["++PidStr++","++PortStr++","++RefStr++"]"), + ?line chk_display("abcdefghijklmnopqrstuvwxyz", + "\"abcdefghijklmnopqrstuvwxyz\""), + ?line chk_display("ABCDEFGHIJKLMNOPQRSTUVWXYZ", + "\"ABCDEFGHIJKLMNOPQRSTUVWXYZ\""), + ?line chk_display("H E J", "\"H E J\""), + ?line chk_display("asdDofw $@{}][", "\"asdDofw $@{}][\""), + + %% + %% TODO: Check binaries, fun and floats... + %% + + erts_debug:set_internal_state(available_internal_state, OAIS), + ?line ok = get(erlang_display_test). + +get_chnl_no(NodeName) when is_atom(NodeName) -> + erts_debug:get_internal_state({channel_number, NodeName}). + +chk_display(Term, Expect) when is_list(Expect) -> + Dstr = erts_debug:display(Term), + case Expect ++ io_lib:nl() of + Dstr -> + ?t:format("Test of \"~p\" succeeded.~n" + " Expected and got: ~s~n", + [Term, io_lib:write_string(Dstr)]); + DoExpect -> + ?t:format("***~n" + "*** Test of \"~p\" failed!~n" + "*** Expected: ~s~n" + "*** Got: ~s~n" + "***~n", + [Term, + io_lib:write_string(DoExpect), + io_lib:write_string(Dstr)]), + put(erlang_display_test, failed) + end. + +chk_display({Term, Expect}) -> + chk_display(Term, Expect). + +mk_pid_xstr({NodeName, Creation}, Number, Serial) -> + Pid = mk_pid({NodeName, Creation}, Number, Serial), + XStr = "<" ++ integer_to_list(get_chnl_no(NodeName)) + ++ "." ++ integer_to_list(Number) + ++ "." ++ integer_to_list(Serial) ++ ">", + {Pid, XStr}. + +mk_port_xstr({NodeName, Creation}, Number) -> + Port = mk_port({NodeName, Creation}, Number), + XStr = "#Port<" ++ integer_to_list(get_chnl_no(NodeName)) + ++ "." ++ integer_to_list(Number) ++ ">", + {Port, XStr}. + +mk_ref_xstr({NodeName, Creation}, Numbers) -> + Ref = mk_ref({NodeName, Creation}, Numbers), + XStr = "#Ref<" ++ integer_to_list(get_chnl_no(NodeName)) + ++ ref_numbers_xstr(Numbers) ++ ">", + {Ref, XStr}. + +ref_numbers_xstr([]) -> + []; +ref_numbers_xstr([N | Ns]) -> + ref_numbers_xstr(Ns) ++ "." ++ integer_to_list(N). + +-define(TESTCASE_IMPL(T), T(A) -> default_testcase_impl(A)). + +?TESTCASE_IMPL(integer). +?TESTCASE_IMPL(float). +?TESTCASE_IMPL(string). +?TESTCASE_IMPL(character). +?TESTCASE_IMPL(snprintf). +?TESTCASE_IMPL(quote). + +%% +%% +%% Auxiliary functions +%% +%% + +default_testcase_impl(doc) -> []; +default_testcase_impl(suite) -> []; +default_testcase_impl(Config) when is_list(Config) -> ?line run_case(Config). + +init_per_testcase(Case, Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + [{testcase, Case}, {watchdog, Dog} |Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +-define(TESTPROG, "erl_print_tests"). +-define(FAILED_MARKER, $E,$P,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E). +-define(SKIPPED_MARKER, $E,$P,$-,$T,$E,$S,$T,$-,$S,$K,$I,$P). +-define(SUCCESS_MARKER, $E,$P,$-,$T,$E,$S,$T,$-,$S,$U,$C,$C,$E,$S,$S). +-define(PID_MARKER, $E,$P,$-,$T,$E,$S,$T,$-,$P,$I,$D). + +port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) -> + ?line process_flag(trap_exit, true), + ?line Ref = erlang:monitor(process, EProc), + ?line receive + {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), + element(1, Reason) + == timetrap_timeout -> + ?line Cmd = "kill -9 " ++ OSProc, + ?line ?t:format("Test case timed out. " + "Trying to kill port program.~n" + " Executing: ~p~n", [Cmd]), + ?line case os:cmd(Cmd) of + [] -> + ok; + OsCmdRes -> + ?line ?t:format(" ~s", [OsCmdRes]) + end; + {'DOWN', Ref, _, _, _} -> + %% OSProc is assumed to have terminated by itself + ?line ok + end. + +get_line(_Port, eol, Data) -> + ?line Data; +get_line(Port, noeol, Data) -> + ?line receive + {Port, {data, {Flag, NextData}}} -> + ?line get_line(Port, Flag, Data ++ NextData); + {Port, eof} -> + ?line ?t:fail(port_prog_unexpectedly_closed) + end. + +read_case_data(Port, TestCase) -> + ?line receive + {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> + ?line ok; + {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> + ?line {comment, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> + ?line {skipped, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> + ?line ?t:fail(get_line(Port, Flag, ReasonStart)); + {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> + ?line ?t:format("Port program pid: ~s~n", [PidStr]), + ?line CaseProc = self(), + ?line list_to_integer(PidStr), % Sanity check + spawn_opt(fun () -> + port_prog_killer(CaseProc, PidStr) + end, + [{priority, max}, link]), + read_case_data(Port, TestCase); + {Port, {data, {Flag, LineStart}}} -> + ?line ?t:format("~s~n", [get_line(Port, Flag, LineStart)]), + read_case_data(Port, TestCase); + {Port, eof} -> + ?line ?t:fail(port_prog_unexpectedly_closed) + end. + +run_case(Config) -> + run_case(Config, ""). + +run_case(Config, TestArgs) -> + run_case(Config, TestArgs, fun (_Port) -> ok end). + +run_case(Config, TestArgs, Fun) -> + Test = atom_to_list(?config(testcase, Config)), + TestProg = filename:join([?config(data_dir, Config), + ?TESTPROG + ++ "." + ++ atom_to_list(erlang:system_info(threads))]), + Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs, + case catch open_port({spawn, Cmd}, [stream, + use_stdio, + stderr_to_stdout, + eof, + {line, 1024}]) of + Port when is_port(Port) -> + ?line Fun(Port), + ?line CaseResult = read_case_data(Port, Test), + ?line receive + {Port, eof} -> + ?line ok + end, + ?line CaseResult; + Error -> + ?line ?t:fail({open_port_failed, Error}) + end. + + +-define(VERSION_MAGIC, 131). + +-define(ATOM_EXT, 100). +-define(REFERENCE_EXT, 101). +-define(PORT_EXT, 102). +-define(PID_EXT, 103). +-define(NEW_REFERENCE_EXT, 114). + +uint32_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 32 -> + [(Uint bsr 24) band 16#ff, + (Uint bsr 16) band 16#ff, + (Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint32_be(Uint) -> + exit({badarg, uint32_be, [Uint]}). + + +uint16_be(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 16 -> + [(Uint bsr 8) band 16#ff, + Uint band 16#ff]; +uint16_be(Uint) -> + exit({badarg, uint16_be, [Uint]}). + +uint8(Uint) when is_integer(Uint), 0 =< Uint, Uint < 1 bsl 8 -> + Uint band 16#ff; +uint8(Uint) -> + exit({badarg, uint8, [Uint]}). + + + +mk_pid({NodeName, Creation}, Number, Serial) when is_atom(NodeName) -> + mk_pid({atom_to_list(NodeName), Creation}, Number, Serial); +mk_pid({NodeName, Creation}, Number, Serial) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PID_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint32_be(Serial), + uint8(Creation)])) of + Pid when is_pid(Pid) -> + Pid; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_pid, [{NodeName, Creation}, Number, Serial]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_port({NodeName, Creation}, Number) when is_atom(NodeName) -> + mk_port({atom_to_list(NodeName), Creation}, Number); +mk_port({NodeName, Creation}, Number) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?PORT_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Port when is_port(Port) -> + Port; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_port, [{NodeName, Creation}, Number]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +mk_ref({NodeName, Creation}, Numbers) when is_atom(NodeName), + is_integer(Creation), + is_list(Numbers) -> + mk_ref({atom_to_list(NodeName), Creation}, Numbers); +mk_ref({NodeName, Creation}, [Number]) when is_list(NodeName), + is_integer(Creation), + is_integer(Number) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?REFERENCE_EXT, + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint32_be(Number), + uint8(Creation)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, [Number]]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end; +mk_ref({NodeName, Creation}, Numbers) when is_list(NodeName), + is_integer(Creation), + is_list(Numbers) -> + case catch binary_to_term(list_to_binary([?VERSION_MAGIC, + ?NEW_REFERENCE_EXT, + uint16_be(length(Numbers)), + ?ATOM_EXT, + uint16_be(length(NodeName)), + NodeName, + uint8(Creation), + lists:map(fun (N) -> + uint32_be(N) + end, + Numbers)])) of + Ref when is_reference(Ref) -> + Ref; + {'EXIT', {badarg, _}} -> + exit({badarg, mk_ref, [{NodeName, Creation}, Numbers]}); + Other -> + exit({unexpected_binary_to_term_result, Other}) + end. + +my_cre() -> erlang:system_info(creation). + +oth_cre(0) -> 1; +oth_cre(1) -> 2; +oth_cre(2) -> 3; +oth_cre(3) -> 1; +oth_cre(N) -> exit({invalid_creation, N}). + +str_1_bsl_10000() -> + "19950631168807583848837421626835850838234968318861924548520089498529438830221946631919961684036194597899331129423209124271556491349413781117593785932096323957855730046793794526765246551266059895520550086918193311542508608460618104685509074866089624888090489894838009253941633257850621568309473902556912388065225096643874441046759871626985453222868538161694315775629640762836880760732228535091641476183956381458969463899410840960536267821064621427333394036525565649530603142680234969400335934316651459297773279665775606172582031407994198179607378245683762280037302885487251900834464581454650557929601414833921615734588139257095379769119277800826957735674444123062018757836325502728323789270710373802866393031428133241401624195671690574061419654342324638801248856147305207431992259611796250130992860241708340807605932320161268492288496255841312844061536738951487114256315111089745514203313820202931640957596464756010405845841566072044962867016515061920631004186422275908670900574606417856951911456055068251250406007519842261898059237118054444788072906395242548339221982707404473162376760846613033778706039803413197133493654622700563169937455508241780972810983291314403571877524768509857276937926433221599399876886660808368837838027643282775172273657572744784112294389733810861607423253291974813120197604178281965697475898164531258434135959862784130128185406283476649088690521047580882615823961985770122407044330583075869039319604603404973156583208672105913300903752823415539745394397715257455290510212310947321610753474825740775273986348298498340756937955646638621874569499279016572103701364433135817214311791398222983845847334440270964182851005072927748364550578634501100852987812389473928699540834346158807043959118985815145779177143619698728131459483783202081474982171858011389071228250905826817436220577475921417653715687725614904582904992461028630081535583308130101987675856234343538955409175623400844887526162643568648833519463720377293240094456246923254350400678027273837755376406726898636241037491410966718557050759098100246789880178271925953381282421954028302759408448955014676668389697996886241636313376393903373455801407636741877711055384225739499110186468219696581651485130494222369947714763069155468217682876200362777257723781365331611196811280792669481887201298643660768551639860534602297871557517947385246369446923087894265948217008051120322365496288169035739121368338393591756418733850510970271613915439590991598154654417336311656936031122249937969999226781732358023111862644575299135758175008199839236284615249881088960232244362173771618086357015468484058622329792853875623486556440536962622018963571028812361567512543338303270029097668650568557157505516727518899194129711337690149916181315171544007728650573189557450920330185304847113818315407324053319038462084036421763703911550639789000742853672196280903477974533320468368795868580237952218629120080742819551317948157624448298518461509704888027274721574688131594750409732115080498190455803416826949787141316063210686391511681774304792596709376". diff --git a/erts/test/erl_print_SUITE_data/Makefile.src b/erts/test/erl_print_SUITE_data/Makefile.src new file mode 100644 index 0000000000..109d55e572 --- /dev/null +++ b/erts/test/erl_print_SUITE_data/Makefile.src @@ -0,0 +1,45 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2005-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include @erts_lib_include_internal_generated@@DS@ethread.mk + +CC = @CC@ +CFLAGS = @ERTS_CFLAGS@ +LIBS = @ERTS_LIBS@ + +EPTF_CFLAGS = -Wall $(CFLAGS) @DEFS@ -I@erts_lib_include_internal@ -I@erts_lib_include_internal_generated@ +EPTF_LIBS = $(LIBS) -L@erts_lib_internal_path@ -lerts_internal@type_marker@ + +EPTT_CFLAGS = -DTHREAD_SAFE $(ETHR_DEFS) $(EPTF_CFLAGS) +EPTT_LIBS = $(LIBS) -L@erts_lib_internal_path@ -lerts_internal_r@type_marker@ $(ETHR_LIBS) + +GCC = .@DS@gccifier -CC"$(CC)" + +PROGS = erl_print_tests.@emu_threads@@exe@ + +all: $(PROGS) + +gccifier@exe@: ..@DS@utils@DS@gccifier.c + $(CC) $(CFLAGS) -o gccifier@exe@ ..@DS@utils@DS@gccifier.c $(LIBS) + +erl_print_tests.false@exe@: gccifier@exe@ erl_print_tests.c + $(GCC) $(EPTF_CFLAGS) -o erl_print_tests.false@exe@ erl_print_tests.c $(EPTF_LIBS) + +erl_print_tests.true@exe@: gccifier@exe@ erl_print_tests.c + $(GCC) $(EPTT_CFLAGS) -o erl_print_tests.true@exe@ erl_print_tests.c $(EPTT_LIBS) diff --git a/erts/test/erl_print_SUITE_data/character_test.h b/erts/test/erl_print_SUITE_data/character_test.h new file mode 100644 index 0000000000..9c66618a71 --- /dev/null +++ b/erts/test/erl_print_SUITE_data/character_test.h @@ -0,0 +1,586 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This file has been automatically generated. Do NOT edit it; instead, + * run 'erl_print_tests.false character save_expected_result' + */ + +char *character_expected_result[] = { + "a", + "a ", + " a", + "a ", + " a", + "b", + "b ", + " b", + "b ", + " b", + "c", + "c ", + " c", + "c ", + " c", + "d", + "d ", + " d", + "d ", + " d", + "e", + "e ", + " e", + "e ", + " e", + "f", + "f ", + " f", + "f ", + " f", + "g", + "g ", + " g", + "g ", + " g", + "h", + "h ", + " h", + "h ", + " h", + "i", + "i ", + " i", + "i ", + " i", + "j", + "j ", + " j", + "j ", + " j", + "k", + "k ", + " k", + "k ", + " k", + "l", + "l ", + " l", + "l ", + " l", + "m", + "m ", + " m", + "m ", + " m", + "n", + "n ", + " n", + "n ", + " n", + "o", + "o ", + " o", + "o ", + " o", + "p", + "p ", + " p", + "p ", + " p", + "q", + "q ", + " q", + "q ", + " q", + "r", + "r ", + " r", + "r ", + " r", + "s", + "s ", + " s", + "s ", + " s", + "t", + "t ", + " t", + "t ", + " t", + "u", + "u ", + " u", + "u ", + " u", + "v", + "v ", + " v", + "v ", + " v", + "w", + "w ", + " w", + "w ", + " w", + "x", + "x ", + " x", + "x ", + " x", + "y", + "y ", + " y", + "y ", + " y", + "z", + "z ", + " z", + "z ", + " z", + "å", + "å ", + " å", + "å ", + " å", + "ä", + "ä ", + " ä", + "ä ", + " ä", + "ö", + "ö ", + " ö", + "ö ", + " ö", + "A", + "A ", + " A", + "A ", + " A", + "B", + "B ", + " B", + "B ", + " B", + "C", + "C ", + " C", + "C ", + " C", + "D", + "D ", + " D", + "D ", + " D", + "E", + "E ", + " E", + "E ", + " E", + "F", + "F ", + " F", + "F ", + " F", + "G", + "G ", + " G", + "G ", + " G", + "H", + "H ", + " H", + "H ", + " H", + "I", + "I ", + " I", + "I ", + " I", + "J", + "J ", + " J", + "J ", + " J", + "K", + "K ", + " K", + "K ", + " K", + "L", + "L ", + " L", + "L ", + " L", + "M", + "M ", + " M", + "M ", + " M", + "N", + "N ", + " N", + "N ", + " N", + "O", + "O ", + " O", + "O ", + " O", + "P", + "P ", + " P", + "P ", + " P", + "Q", + "Q ", + " Q", + "Q ", + " Q", + "R", + "R ", + " R", + "R ", + " R", + "S", + "S ", + " S", + "S ", + " S", + "T", + "T ", + " T", + "T ", + " T", + "U", + "U ", + " U", + "U ", + " U", + "V", + "V ", + " V", + "V ", + " V", + "X", + "X ", + " X", + "X ", + " X", + "Y", + "Y ", + " Y", + "Y ", + " Y", + "Z", + "Z ", + " Z", + "Z ", + " Z", + "Å", + "Å ", + " Å", + "Å ", + " Å", + "Ä", + "Ä ", + " Ä", + "Ä ", + " Ä", + "Ö", + "Ö ", + " Ö", + "Ö ", + " Ö", + "1", + "1 ", + " 1", + "1 ", + " 1", + "2", + "2 ", + " 2", + "2 ", + " 2", + "3", + "3 ", + " 3", + "3 ", + " 3", + "4", + "4 ", + " 4", + "4 ", + " 4", + "5", + "5 ", + " 5", + "5 ", + " 5", + "6", + "6 ", + " 6", + "6 ", + " 6", + "7", + "7 ", + " 7", + "7 ", + " 7", + "8", + "8 ", + " 8", + "8 ", + " 8", + "9", + "9 ", + " 9", + "9 ", + " 9", + "0", + "0 ", + " 0", + "0 ", + " 0", + "(", + "( ", + " (", + "( ", + " (", + ")", + ") ", + " )", + ") ", + " )", + "[", + "[ ", + " [", + "[ ", + " [", + "]", + "] ", + " ]", + "] ", + " ]", + "{", + "{ ", + " {", + "{ ", + " {", + "}", + "} ", + " }", + "} ", + " }", + "+", + "+ ", + " +", + "+ ", + " +", + "-", + "- ", + " -", + "- ", + " -", + ";", + "; ", + " ;", + "; ", + " ;", + ",", + ", ", + " ,", + ", ", + " ,", + ":", + ": ", + " :", + ": ", + " :", + ".", + ". ", + " .", + ". ", + " .", + "@", + "@ ", + " @", + "@ ", + " @", + "£", + "£ ", + " £", + "£ ", + " £", + "$", + "$ ", + " $", + "$ ", + " $", + "!", + "! ", + " !", + "! ", + " !", + "\"", + "\" ", + " \"", + "\" ", + " \"", + "#", + "# ", + " #", + "# ", + " #", + "¤", + "¤ ", + " ¤", + "¤ ", + " ¤", + "%", + "% ", + " %", + "% ", + " %", + "&", + "& ", + " &", + "& ", + " &", + "/", + "/ ", + " /", + "/ ", + " /", + "\\", + "\\ ", + " \\", + "\\ ", + " \\", + "=", + "= ", + " =", + "= ", + " =", + "?", + "? ", + " ?", + "? ", + " ?", + "'", + "' ", + " '", + "' ", + " '", + "`", + "` ", + " `", + "` ", + " `", + "´", + "´ ", + " ´", + "´ ", + " ´", + "^", + "^ ", + " ^", + "^ ", + " ^", + "~", + "~ ", + " ~", + "~ ", + " ~", + "§", + "§ ", + " §", + "§ ", + " §", + "½", + "½ ", + " ½", + "½ ", + " ½", + "|", + "| ", + " |", + "| ", + " |", + "<", + "< ", + " <", + "< ", + " <", + ">", + "> ", + " >", + "> ", + " >", + "¨", + "¨ ", + " ¨", + "¨ ", + " ¨", + "*", + "* ", + " *", + "* ", + " *", + "_", + "_ ", + " _", + "_ ", + " _", + "\a", + "\a ", + " \a", + "\a ", + " \a", + "\b", + "\b ", + " \b", + "\b ", + " \b", + "\f", + "\f ", + " \f", + "\f ", + " \f", + "\n", + "\n ", + " \n", + "\n ", + " \n", + "\r", + "\r ", + " \r", + "\r ", + " \r", + "\t", + "\t ", + " \t", + "\t ", + " \t", + "\v", + "\v ", + " \v", + "\v ", + " \v", + NULL}; diff --git a/erts/test/erl_print_SUITE_data/erl_print_tests.c b/erts/test/erl_print_SUITE_data/erl_print_tests.c new file mode 100644 index 0000000000..28ce78f4e1 --- /dev/null +++ b/erts/test/erl_print_SUITE_data/erl_print_tests.c @@ -0,0 +1,560 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Test suite for the ethread thread library. + * Author: Rickard Green + */ + +#include +#include +#include +#include +#include +#include +#ifndef __WIN32__ +#include +#endif + +#include "erl_printf.h" +#ifdef THREAD_SAFE +#include "ethread.h" +#endif + +#ifdef __WIN32__ +#undef HAVE_VSNPRINTF +#define HAVE_VSNPRINTF 1 +#define vsnprintf _vsnprintf +#endif + +#ifdef __WIN32__ +#define signed_long_long LONGLONG +#define unsigned_long_long ULONGLONG +#else +#define signed_long_long signed long long +#define unsigned_long_long unsigned long long +#endif + +/* + * Auxiliary functions + */ + +#define PRINT_VA_LIST(FRMT) \ +do { \ + if (FRMT && FRMT != '\0') { \ + va_list args; \ + va_start(args, FRMT); \ + vfprintf(stderr, FRMT, args); \ + va_end(args); \ + } \ +} while (0) + +#define ASSERT(B) \ +do { \ + if (!(B)) \ + fail("%s:%d: Assertion \"%s\" failed!",__FILE__,__LINE__,#B); \ +} while (0) + +static void +print_eol(void) +{ + fprintf(stderr, "\n"); +} + +static void print_line(char *frmt,...) +{ + PRINT_VA_LIST(frmt); + print_eol(); +} + +static void print(char *frmt,...) +{ + PRINT_VA_LIST(frmt); +} + +static void fail(char *frmt,...) +{ + char *abrt_env; + print_eol(); + fprintf(stderr, "EP-TEST-FAILURE"); + PRINT_VA_LIST(frmt); + print_eol(); + abrt_env = getenv("ERL_ABORT_ON_FAILURE"); + if (abrt_env && strcmp("true", abrt_env) == 0) + abort(); + else + exit(1); +} + +static void skip(char *frmt,...) +{ + print_eol(); + fprintf(stderr, "EP-TEST-SKIP"); + PRINT_VA_LIST(frmt); + print_eol(); + exit(0); +} + +static void succeed(char *frmt,...) +{ + print_eol(); + fprintf(stderr, "EP-TEST-SUCCESS"); + PRINT_VA_LIST(frmt); + print_eol(); + exit(0); +} + +#if 0 /* Not used */ + +static void +do_sleep(unsigned secs) +{ +#ifdef __WIN32__ + Sleep((DWORD) secs*1000); +#else + sleep(secs); +#endif +} + +#endif + +static void +send_my_pid(void) +{ +#ifndef __WIN32__ + int pid = (int) getpid(); + fprintf(stderr, "\nEP-TEST-PID%d\n", pid); +#endif +} + +#define BUF_SIZE (1024*1024) + +FILE *outfile = NULL; +char **expected_result; + +#define FENCE_SIZE 512 +static void +print_cmp_test(int n, char *frmt, ...) +{ + int res = -1; + static char clib_buf[BUF_SIZE]; + static unsigned char the_erts_buf[BUF_SIZE]; + char *erts_buf = (char *) &the_erts_buf[FENCE_SIZE]; + va_list args; + + if (outfile) { + char *fp, *tp; + va_start(args, frmt); + if (n < 0) + res = vsprintf(erts_buf, frmt, args); + else { +#ifdef HAVE_VSNPRINTF + res = vsnprintf(erts_buf, (size_t) n, frmt, args); +#else + fail("No vsnprintf()"); +#endif + } + va_end(args); + ASSERT(res >= 0); + fp = erts_buf; + tp = clib_buf; + while (*fp) { + switch (*fp) { + case '\a': *(tp++) = '\\'; *(tp++) = 'a'; break; + case '\b': *(tp++) = '\\'; *(tp++) = 'b'; break; + case '\f': *(tp++) = '\\'; *(tp++) = 'f'; break; + case '\n': *(tp++) = '\\'; *(tp++) = 'n'; break; + case '\r': *(tp++) = '\\'; *(tp++) = 'r'; break; + case '\t': *(tp++) = '\\'; *(tp++) = 't'; break; + case '\v': *(tp++) = '\\'; *(tp++) = 'v'; break; + case '\"': *(tp++) = '\\'; *(tp++) = '\"'; break; + case '\\': *(tp++) = '\\'; *(tp++) = '\\'; break; + default: *(tp++) = *fp; break; + } + fp++; + } + *tp = '\0'; + res = fprintf(outfile, "\t\"%s\",\n", clib_buf); + ASSERT(res >= 0); + } + else { + char *xres; + va_start(args, frmt); + if (n < 0) + res = erts_vsprintf(erts_buf, frmt, args); + else { + int i; + int chk_sz = 2*FENCE_SIZE + n; + for (i = 0; i < chk_sz; i++) + the_erts_buf[i] = 0xeb; + res = erts_vsnprintf(erts_buf, (size_t) n, frmt, args); + for (i = 0; i < chk_sz; i++) + if ((((char *) &the_erts_buf[i]) < erts_buf + || erts_buf + n <= ((char *) &the_erts_buf[i])) + && the_erts_buf[i] != 0xeb) { + int j; + for (j = 0; j < chk_sz; j++) + print(j ? ",%x(%d)" : "%x(%d)", + (unsigned) the_erts_buf[j], j - FENCE_SIZE); + print_eol(); + fail("Garbage written out of bounds (%d,%d)", + i - FENCE_SIZE, n); + } + } + va_end(args); + ASSERT(res >= 0); + + if (expected_result) { + ASSERT(*expected_result); + xres = *expected_result; + expected_result++; + } + else { + va_start(args, frmt); + if (n < 0) + res = vsprintf(clib_buf, frmt, args); + else { +#ifdef HAVE_VSNPRINTF + res = vsnprintf(clib_buf, (size_t) n, frmt, args); +#else + fail("No vsnprintf()"); +#endif + } + va_end(args); + ASSERT(res >= 0); + xres = clib_buf; + } + + if (strcmp(xres, erts_buf) != 0) { + print_line("expected result : \"%s\"", xres); + print_line("erts_buf : \"%s\"", erts_buf); + fail("\"%s\" != \"%s\" (format=\"%s\")", xres, erts_buf, frmt); + } + + print_line("Checked format \"%s\" with result: \"%s\"", frmt, erts_buf); + } +} + +/* + * The test-cases + */ + +#include "integer_64_test.h" +#include "integer_test.h" + +#define INT_SUB_BATCH_TEST(FRMT, TYPE) \ + print_cmp_test(-1, FRMT, ((TYPE) 4711)); \ + print_cmp_test(-1, FRMT, ~((TYPE) 4711)); \ + print_cmp_test(-1, FRMT, (~((TYPE) 0))/2 + (~((TYPE) 0))/4);\ + print_cmp_test(-1, FRMT, ((TYPE) - 1)); \ + print_cmp_test(-1, FRMT, ((TYPE) 1)); \ + print_cmp_test(-1, FRMT, ((TYPE) ((long) 0xabcdef01))); \ + +#define INT_BATCH_TEST(P, X, S) \ + print_line("%s:%d",__FILE__,__LINE__); \ + INT_SUB_BATCH_TEST("%" P "h" X, S char); \ + INT_SUB_BATCH_TEST("%" P "h" X, S short); \ + INT_SUB_BATCH_TEST("%" P X, S int); \ + INT_SUB_BATCH_TEST("%" P "l" X, S long); \ + INT_SUB_BATCH_TEST("%" P "ll" X, S ## _long_long); \ + +static void +integer_test(void) +{ + /* This testcase should be rewritten. It assumes the following + sizes of types... */ + if (sizeof(char) != 1 + || sizeof(short) != 2 + || sizeof(int) != 4 + || sizeof(long) != (sizeof(void *) == 8 ? 8 : 4) + || sizeof(signed_long_long) != 8) + skip("Unexpected size of primitive datatype:" + " sizeof(char) == %d (expected 1);" + " sizeof(short) == %d (expected 2);" + " sizeof(int) == %d (expected 4);" + " sizeof(long) == %d (expected %d);" + " sizeof(signed_long_long) == %d (expected 8)", + sizeof(char), + sizeof(short), + sizeof(int), + sizeof(long), sizeof(void *) == 8 ? 8 : 4, + sizeof(signed_long_long)); + + expected_result = (sizeof(void *) == 8 + ? integer_64_expected_result + : integer_expected_result); + + INT_BATCH_TEST("", "i", signed); + INT_BATCH_TEST("", "d", signed); + INT_BATCH_TEST("", "u", unsigned); + INT_BATCH_TEST("", "o", unsigned); + INT_BATCH_TEST("", "x", unsigned); + INT_BATCH_TEST("", "X", unsigned); + INT_BATCH_TEST("010.5", "i", signed); + INT_BATCH_TEST("010.5", "d", signed); + INT_BATCH_TEST("010.5", "u", unsigned); + INT_BATCH_TEST("010.5", "o", unsigned); + INT_BATCH_TEST("010.5", "x", unsigned); + INT_BATCH_TEST("010.5", "X", unsigned); + INT_BATCH_TEST("-+29", "i", signed); + INT_BATCH_TEST("-+29", "d", signed); + INT_BATCH_TEST("-29", "u", unsigned); + INT_BATCH_TEST("-29", "o", unsigned); + INT_BATCH_TEST("-29", "x", unsigned); + INT_BATCH_TEST("-29", "X", unsigned); + INT_BATCH_TEST("22.8", "i", signed); + INT_BATCH_TEST("22.8", "d", signed); + INT_BATCH_TEST("22.8", "u", unsigned); + INT_BATCH_TEST("22.8", "o", unsigned); + INT_BATCH_TEST("22.8", "x", unsigned); + INT_BATCH_TEST("22.8", "X", unsigned); + INT_BATCH_TEST("-22.8", "i", signed); + INT_BATCH_TEST("-22.8", "d", signed); + INT_BATCH_TEST("-22.8", "u", unsigned); + INT_BATCH_TEST("-22.8", "o", unsigned); + INT_BATCH_TEST("-22.8", "x", unsigned); + INT_BATCH_TEST("-22.8", "X", unsigned); + INT_BATCH_TEST("-823.193", "i", signed); + INT_BATCH_TEST("-823.193", "d", signed); + INT_BATCH_TEST("-823.193", "u", unsigned); + INT_BATCH_TEST("-823.193", "o", unsigned); + INT_BATCH_TEST("-823.193", "x", unsigned); + INT_BATCH_TEST("-823.193", "X", unsigned); + +} + +static void +float_test(void) +{ + expected_result = NULL; + print_cmp_test(-1, "%70.10f", DBL_MAX); + print_cmp_test(-1, "%500.10f", DBL_MAX); + print_cmp_test(-1, "%-500.10f", DBL_MAX); + print_cmp_test(-1, "%500.10e", DBL_MAX); + print_cmp_test(-1, "%-500.10e", DBL_MAX); + print_cmp_test(-1, "%500.10E", DBL_MAX); + print_cmp_test(-1, "%-500.10E", DBL_MAX); + print_cmp_test(-1, "%500.10g", DBL_MAX); + print_cmp_test(-1, "%-500.10g", DBL_MAX); + print_cmp_test(-1, "%500.10G", DBL_MAX); + print_cmp_test(-1, "%-500.10G", DBL_MAX); +} + +char some_characters[] = +"abcdefghijklmnopqrstuvwxyzåäö" +"ABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ" +"1234567890" +"()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_" +"\a\b\f\n\r\t\v"; + +#include "string_test.h" + +static void +string_test(void) +{ + expected_result = string_expected_result; + print_cmp_test(-1, "%s", "hej"); + print_cmp_test(-1, "%-10.5s", "hopp"); + print_cmp_test(-1, "%10.5s", "hopp"); + print_cmp_test(-1, "%-500.500s", "hopp"); + print_cmp_test(-1, "%500.500s", "hopp"); + print_cmp_test(-1, "\t%10.4s", some_characters); + print_cmp_test(-1, "\t%500.500s", some_characters); +} + +#include "character_test.h" + +static void +character_test(void) +{ + char *cp; + expected_result = character_expected_result; + for (cp = some_characters; *cp; cp++) { + print_cmp_test(-1, "%c", *cp); + print_cmp_test(-1, "%-10.5c", *cp); + print_cmp_test(-1, "%10.5c", *cp); + print_cmp_test(-1, "%-500.500c", *cp); + print_cmp_test(-1, "%500.500c", *cp); + } +} + +#include "snprintf_test.h" + +static void +snprintf_test(void) +{ + expected_result = snprintf_expected_result; + print_cmp_test(6, "hej hopp"); + print_cmp_test(7, "hej hopp"); + print_cmp_test(8, "hej hopp"); + print_cmp_test(9, "hej hopp"); + print_cmp_test(10, "hej hopp"); + print_cmp_test(6, "hej %d", 4711); + print_cmp_test(7, "hej %d", 4711); + print_cmp_test(8, "hej %d", 4711); + print_cmp_test(9, "hej %d", 4711); + print_cmp_test(10, "hej %d", 4711); + print_cmp_test(sizeof(some_characters)-2, "%s", some_characters); + print_cmp_test(sizeof(some_characters)-1, "%s", some_characters); + print_cmp_test(sizeof(some_characters), "%s", some_characters); + print_cmp_test(sizeof(some_characters)+1, "%s", some_characters); + print_cmp_test(sizeof(some_characters)+2, "%s", some_characters); + print_cmp_test(sizeof(some_characters)/2, "%s%s", + some_characters, some_characters); + print_cmp_test(sizeof(some_characters)*3, "%s%s", + some_characters, some_characters); +} + +static void +quote_test(void) +{ + expected_result = NULL; + print_cmp_test(-1, "\n"); + print_cmp_test(-1, "\\n"); + print_cmp_test(-1, "\r"); + print_cmp_test(-1, "\\r"); + print_cmp_test(-1, "\t"); + print_cmp_test(-1, "\\t"); + print_cmp_test(-1, "\v"); + print_cmp_test(-1, "\\v"); + print_cmp_test(-1, "\b"); + print_cmp_test(-1, "\\b"); + print_cmp_test(-1, "\f"); + print_cmp_test(-1, "\\f"); + print_cmp_test(-1, "\x80"); + print_cmp_test(-1, "\\x80"); + print_cmp_test(-1, "\x14"); + print_cmp_test(-1, "\\x14"); + print_cmp_test(-1, "\xff"); + print_cmp_test(-1, "\\xff"); + print_cmp_test(-1, "\043"); + print_cmp_test(-1, "\\043"); + print_cmp_test(-1, "\053"); + print_cmp_test(-1, "\\053"); + print_cmp_test(-1, "\0143"); + print_cmp_test(-1, "\\0143"); + print_cmp_test(-1, "\\lf"); + print_cmp_test(-1, "\\msss"); + print_cmp_test(-1, "\\ss"); + +} + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * The dispatcher * +\* */ + +int +main(int argc, char *argv[]) +{ + if (argc < 2) + fail("To few arguments for test case"); + + { + char *testcase; + int save_xres = 0; + int i; + + send_my_pid(); + + testcase = argv[1]; +#ifdef THREAD_SAFE + { + int res = ethr_init(NULL); + if (res != 0) + fail("Failed to initialize the ethread library"); + } +#endif + + for (i = 2; i < argc; i++) { + if (strcmp(argv[i], "save_expected_result") == 0) { + save_xres = 1; + break; + } + } + + if (save_xres) { + char filename[100]; + sprintf(filename, + "%s%s_test.h", + testcase, + sizeof(void *) == 8 ? "_64" : ""); + printf("Saving expected result to %s\n", filename); + outfile = fopen(filename, "w"); + ASSERT(outfile); + fprintf(outfile, + "/*\n" + " * %%CopyrightBegin%%\n" + " * Copyright Ericsson AB 1996-2009. All Rights Reserved.\n" + " * \n" + " * The contents of this file are subject to the Erlang Public License,\n" + " * Version 1.1, (the \"License\"); you may not use this file except in\n" + " * compliance with the License. You should have received a copy of the\n" + " * Erlang Public License along with this software. If not, it can be\n" + " * retrieved online at http://www.erlang.org/.\n" + " * \n" + " * Software distributed under the License is distributed on an \"AS IS\"\n" + " * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See\n" + " * the License for the specific language governing rights and limitations\n" + " * under the License.\n" + " * %%CopyrightEnd%%\n" + " */\n" + "\n"); + fprintf(outfile, + "/* \n" + " * This file has been automatically generated. Do NOT edit it; instead,\n" + " * run '%s %s save_expected_result'%s.\n" + " */\n" + "\n", + argv[0], + testcase, + sizeof(void *) == 8 ? " on a 64-bit machine" : ""); + fprintf(outfile, + "char *%s%s_expected_result[] = {\n", + testcase, + sizeof(void *) == 8 ? "_64" : ""); + } + + if (strcmp("integer", testcase) == 0) + integer_test(); + else if (strcmp("float", testcase) == 0) + float_test(); + else if (strcmp("string", testcase) == 0) + string_test(); + else if (strcmp("character", testcase) == 0) + character_test(); + else if (strcmp("snprintf", testcase) == 0) + snprintf_test(); + else if (strcmp("quote", testcase) == 0) + quote_test(); + else if (!save_xres) + skip("Test case \"%s\" not implemented yet", testcase); + + if (save_xres) { + fprintf(outfile, "\tNULL};\n"); + fclose(outfile); + } + + succeed(NULL); + } + + return 0; +} + + + diff --git a/erts/test/erl_print_SUITE_data/integer_64_test.h b/erts/test/erl_print_SUITE_data/integer_64_test.h new file mode 100644 index 0000000000..0df09ded44 --- /dev/null +++ b/erts/test/erl_print_SUITE_data/integer_64_test.h @@ -0,0 +1,1106 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This file has been automatically generated. Do NOT edit it; instead, + * run 'erl_print_tests.true integer save_expected_result' on a 64-bit machine. + */ + +char *integer_64_expected_result[] = { + "103", + "-104", + "0", + "-1", + "1", + "1", + "4711", + "-4712", + "0", + "-1", + "1", + "-4351", + "4711", + "-4712", + "0", + "-1", + "1", + "-1412567295", + "4711", + "-4712", + "0", + "-1", + "1", + "2882400001", + "4711", + "-4712", + "0", + "-1", + "1", + "2882400001", + "103", + "-104", + "0", + "-1", + "1", + "1", + "4711", + "-4712", + "0", + "-1", + "1", + "-4351", + "4711", + "-4712", + "0", + "-1", + "1", + "-1412567295", + "4711", + "-4712", + "0", + "-1", + "1", + "2882400001", + "4711", + "-4712", + "0", + "-1", + "1", + "2882400001", + "103", + "65432", + "0", + "255", + "1", + "1", + "4711", + "60824", + "0", + "65535", + "1", + "61185", + "4711", + "4294962584", + "3221225470", + "4294967295", + "1", + "2882400001", + "4711", + "18446744073709546904", + "13835058055282163710", + "18446744073709551615", + "1", + "2882400001", + "4711", + "18446744073709546904", + "13835058055282163710", + "18446744073709551615", + "1", + "2882400001", + "147", + "177630", + "0", + "377", + "1", + "1", + "11147", + "166630", + "0", + "177777", + "1", + "167401", + "11147", + "37777766630", + "27777777776", + "37777777777", + "1", + "25363367401", + "11147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + "1", + "25363367401", + "11147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + "1", + "25363367401", + "67", + "ff98", + "0", + "ff", + "1", + "1", + "1267", + "ed98", + "0", + "ffff", + "1", + "ef01", + "1267", + "ffffed98", + "bffffffe", + "ffffffff", + "1", + "abcdef01", + "1267", + "ffffffffffffed98", + "bffffffffffffffe", + "ffffffffffffffff", + "1", + "abcdef01", + "1267", + "ffffffffffffed98", + "bffffffffffffffe", + "ffffffffffffffff", + "1", + "abcdef01", + "67", + "FF98", + "0", + "FF", + "1", + "1", + "1267", + "ED98", + "0", + "FFFF", + "1", + "EF01", + "1267", + "FFFFED98", + "BFFFFFFE", + "FFFFFFFF", + "1", + "ABCDEF01", + "1267", + "FFFFFFFFFFFFED98", + "BFFFFFFFFFFFFFFE", + "FFFFFFFFFFFFFFFF", + "1", + "ABCDEF01", + "1267", + "FFFFFFFFFFFFED98", + "BFFFFFFFFFFFFFFE", + "FFFFFFFFFFFFFFFF", + "1", + "ABCDEF01", + " 00103", + " -00104", + " 00000", + " -00001", + " 00001", + " 00001", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + " -04351", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "-1412567295", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "2882400001", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "2882400001", + " 00103", + " -00104", + " 00000", + " -00001", + " 00001", + " 00001", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + " -04351", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "-1412567295", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "2882400001", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "2882400001", + " 00103", + " 65432", + " 00000", + " 00255", + " 00001", + " 00001", + " 04711", + " 60824", + " 00000", + " 65535", + " 00001", + " 61185", + " 04711", + "4294962584", + "3221225470", + "4294967295", + " 00001", + "2882400001", + " 04711", + "18446744073709546904", + "13835058055282163710", + "18446744073709551615", + " 00001", + "2882400001", + " 04711", + "18446744073709546904", + "13835058055282163710", + "18446744073709551615", + " 00001", + "2882400001", + " 00147", + " 177630", + " 00000", + " 00377", + " 00001", + " 00001", + " 11147", + " 166630", + " 00000", + " 177777", + " 00001", + " 167401", + " 11147", + "37777766630", + "27777777776", + "37777777777", + " 00001", + "25363367401", + " 11147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + " 00001", + "25363367401", + " 11147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + " 00001", + "25363367401", + " 00067", + " 0ff98", + " 00000", + " 000ff", + " 00001", + " 00001", + " 01267", + " 0ed98", + " 00000", + " 0ffff", + " 00001", + " 0ef01", + " 01267", + " ffffed98", + " bffffffe", + " ffffffff", + " 00001", + " abcdef01", + " 01267", + "ffffffffffffed98", + "bffffffffffffffe", + "ffffffffffffffff", + " 00001", + " abcdef01", + " 01267", + "ffffffffffffed98", + "bffffffffffffffe", + "ffffffffffffffff", + " 00001", + " abcdef01", + " 00067", + " 0FF98", + " 00000", + " 000FF", + " 00001", + " 00001", + " 01267", + " 0ED98", + " 00000", + " 0FFFF", + " 00001", + " 0EF01", + " 01267", + " FFFFED98", + " BFFFFFFE", + " FFFFFFFF", + " 00001", + " ABCDEF01", + " 01267", + "FFFFFFFFFFFFED98", + "BFFFFFFFFFFFFFFE", + "FFFFFFFFFFFFFFFF", + " 00001", + " ABCDEF01", + " 01267", + "FFFFFFFFFFFFED98", + "BFFFFFFFFFFFFFFE", + "FFFFFFFFFFFFFFFF", + " 00001", + " ABCDEF01", + "+103 ", + "-104 ", + "+0 ", + "-1 ", + "+1 ", + "+1 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-4351 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-1412567295 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "+2882400001 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "+2882400001 ", + "+103 ", + "-104 ", + "+0 ", + "-1 ", + "+1 ", + "+1 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-4351 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-1412567295 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "+2882400001 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "+2882400001 ", + "103 ", + "65432 ", + "0 ", + "255 ", + "1 ", + "1 ", + "4711 ", + "60824 ", + "0 ", + "65535 ", + "1 ", + "61185 ", + "4711 ", + "4294962584 ", + "3221225470 ", + "4294967295 ", + "1 ", + "2882400001 ", + "4711 ", + "18446744073709546904 ", + "13835058055282163710 ", + "18446744073709551615 ", + "1 ", + "2882400001 ", + "4711 ", + "18446744073709546904 ", + "13835058055282163710 ", + "18446744073709551615 ", + "1 ", + "2882400001 ", + "147 ", + "177630 ", + "0 ", + "377 ", + "1 ", + "1 ", + "11147 ", + "166630 ", + "0 ", + "177777 ", + "1 ", + "167401 ", + "11147 ", + "37777766630 ", + "27777777776 ", + "37777777777 ", + "1 ", + "25363367401 ", + "11147 ", + "1777777777777777766630 ", + "1377777777777777777776 ", + "1777777777777777777777 ", + "1 ", + "25363367401 ", + "11147 ", + "1777777777777777766630 ", + "1377777777777777777776 ", + "1777777777777777777777 ", + "1 ", + "25363367401 ", + "67 ", + "ff98 ", + "0 ", + "ff ", + "1 ", + "1 ", + "1267 ", + "ed98 ", + "0 ", + "ffff ", + "1 ", + "ef01 ", + "1267 ", + "ffffed98 ", + "bffffffe ", + "ffffffff ", + "1 ", + "abcdef01 ", + "1267 ", + "ffffffffffffed98 ", + "bffffffffffffffe ", + "ffffffffffffffff ", + "1 ", + "abcdef01 ", + "1267 ", + "ffffffffffffed98 ", + "bffffffffffffffe ", + "ffffffffffffffff ", + "1 ", + "abcdef01 ", + "67 ", + "FF98 ", + "0 ", + "FF ", + "1 ", + "1 ", + "1267 ", + "ED98 ", + "0 ", + "FFFF ", + "1 ", + "EF01 ", + "1267 ", + "FFFFED98 ", + "BFFFFFFE ", + "FFFFFFFF ", + "1 ", + "ABCDEF01 ", + "1267 ", + "FFFFFFFFFFFFED98 ", + "BFFFFFFFFFFFFFFE ", + "FFFFFFFFFFFFFFFF ", + "1 ", + "ABCDEF01 ", + "1267 ", + "FFFFFFFFFFFFED98 ", + "BFFFFFFFFFFFFFFE ", + "FFFFFFFFFFFFFFFF ", + "1 ", + "ABCDEF01 ", + " 00000103", + " -00000104", + " 00000000", + " -00000001", + " 00000001", + " 00000001", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -00004351", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -1412567295", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " 2882400001", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " 2882400001", + " 00000103", + " -00000104", + " 00000000", + " -00000001", + " 00000001", + " 00000001", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -00004351", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -1412567295", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " 2882400001", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " 2882400001", + " 00000103", + " 00065432", + " 00000000", + " 00000255", + " 00000001", + " 00000001", + " 00004711", + " 00060824", + " 00000000", + " 00065535", + " 00000001", + " 00061185", + " 00004711", + " 4294962584", + " 3221225470", + " 4294967295", + " 00000001", + " 2882400001", + " 00004711", + " 18446744073709546904", + " 13835058055282163710", + " 18446744073709551615", + " 00000001", + " 2882400001", + " 00004711", + " 18446744073709546904", + " 13835058055282163710", + " 18446744073709551615", + " 00000001", + " 2882400001", + " 00000147", + " 00177630", + " 00000000", + " 00000377", + " 00000001", + " 00000001", + " 00011147", + " 00166630", + " 00000000", + " 00177777", + " 00000001", + " 00167401", + " 00011147", + " 37777766630", + " 27777777776", + " 37777777777", + " 00000001", + " 25363367401", + " 00011147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + " 00000001", + " 25363367401", + " 00011147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + " 00000001", + " 25363367401", + " 00000067", + " 0000ff98", + " 00000000", + " 000000ff", + " 00000001", + " 00000001", + " 00001267", + " 0000ed98", + " 00000000", + " 0000ffff", + " 00000001", + " 0000ef01", + " 00001267", + " ffffed98", + " bffffffe", + " ffffffff", + " 00000001", + " abcdef01", + " 00001267", + " ffffffffffffed98", + " bffffffffffffffe", + " ffffffffffffffff", + " 00000001", + " abcdef01", + " 00001267", + " ffffffffffffed98", + " bffffffffffffffe", + " ffffffffffffffff", + " 00000001", + " abcdef01", + " 00000067", + " 0000FF98", + " 00000000", + " 000000FF", + " 00000001", + " 00000001", + " 00001267", + " 0000ED98", + " 00000000", + " 0000FFFF", + " 00000001", + " 0000EF01", + " 00001267", + " FFFFED98", + " BFFFFFFE", + " FFFFFFFF", + " 00000001", + " ABCDEF01", + " 00001267", + " FFFFFFFFFFFFED98", + " BFFFFFFFFFFFFFFE", + " FFFFFFFFFFFFFFFF", + " 00000001", + " ABCDEF01", + " 00001267", + " FFFFFFFFFFFFED98", + " BFFFFFFFFFFFFFFE", + " FFFFFFFFFFFFFFFF", + " 00000001", + " ABCDEF01", + "00000103 ", + "-00000104 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "00000001 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-00004351 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-1412567295 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "2882400001 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "2882400001 ", + "00000103 ", + "-00000104 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "00000001 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-00004351 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-1412567295 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "2882400001 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "2882400001 ", + "00000103 ", + "00065432 ", + "00000000 ", + "00000255 ", + "00000001 ", + "00000001 ", + "00004711 ", + "00060824 ", + "00000000 ", + "00065535 ", + "00000001 ", + "00061185 ", + "00004711 ", + "4294962584 ", + "3221225470 ", + "4294967295 ", + "00000001 ", + "2882400001 ", + "00004711 ", + "18446744073709546904 ", + "13835058055282163710 ", + "18446744073709551615 ", + "00000001 ", + "2882400001 ", + "00004711 ", + "18446744073709546904 ", + "13835058055282163710 ", + "18446744073709551615 ", + "00000001 ", + "2882400001 ", + "00000147 ", + "00177630 ", + "00000000 ", + "00000377 ", + "00000001 ", + "00000001 ", + "00011147 ", + "00166630 ", + "00000000 ", + "00177777 ", + "00000001 ", + "00167401 ", + "00011147 ", + "37777766630 ", + "27777777776 ", + "37777777777 ", + "00000001 ", + "25363367401 ", + "00011147 ", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + "00000001 ", + "25363367401 ", + "00011147 ", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + "00000001 ", + "25363367401 ", + "00000067 ", + "0000ff98 ", + "00000000 ", + "000000ff ", + "00000001 ", + "00000001 ", + "00001267 ", + "0000ed98 ", + "00000000 ", + "0000ffff ", + "00000001 ", + "0000ef01 ", + "00001267 ", + "ffffed98 ", + "bffffffe ", + "ffffffff ", + "00000001 ", + "abcdef01 ", + "00001267 ", + "ffffffffffffed98 ", + "bffffffffffffffe ", + "ffffffffffffffff ", + "00000001 ", + "abcdef01 ", + "00001267 ", + "ffffffffffffed98 ", + "bffffffffffffffe ", + "ffffffffffffffff ", + "00000001 ", + "abcdef01 ", + "00000067 ", + "0000FF98 ", + "00000000 ", + "000000FF ", + "00000001 ", + "00000001 ", + "00001267 ", + "0000ED98 ", + "00000000 ", + "0000FFFF ", + "00000001 ", + "0000EF01 ", + "00001267 ", + "FFFFED98 ", + "BFFFFFFE ", + "FFFFFFFF ", + "00000001 ", + "ABCDEF01 ", + "00001267 ", + "FFFFFFFFFFFFED98 ", + "BFFFFFFFFFFFFFFE ", + "FFFFFFFFFFFFFFFF ", + "00000001 ", + "ABCDEF01 ", + "00001267 ", + "FFFFFFFFFFFFED98 ", + "BFFFFFFFFFFFFFFE ", + "FFFFFFFFFFFFFFFF ", + "00000001 ", + "ABCDEF01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000103 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000104 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004351 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001412567295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000103 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000104 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004351 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001412567295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000103 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000065432 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000255 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000060824 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000065535 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000061185 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004294962584 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003221225470 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004294967295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000018446744073709546904 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000013835058055282163710 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000018446744073709551615 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000018446744073709546904 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000013835058055282163710 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000018446744073709551615 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000177630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000377 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000166630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000177777 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000167401 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000037777766630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000027777777776 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000037777777777 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000025363367401 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001777777777777777766630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001377777777777777777776 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001777777777777777777777 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000025363367401 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001777777777777777766630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001377777777777777777776 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001777777777777777777777 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000025363367401 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000067 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ff98 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ed98 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ef01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffed98 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000bffffffe ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000abcdef01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffed98 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000bffffffffffffffe ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffffff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000abcdef01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffed98 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000bffffffffffffffe ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffffff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000abcdef01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000067 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FF98 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ED98 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000EF01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFED98 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000BFFFFFFE ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ABCDEF01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFFFFFFED98 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000BFFFFFFFFFFFFFFE ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFFFFFFFFFF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ABCDEF01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFFFFFFED98 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000BFFFFFFFFFFFFFFE ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFFFFFFFFFF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ABCDEF01 ", + NULL}; diff --git a/erts/test/erl_print_SUITE_data/integer_test.h b/erts/test/erl_print_SUITE_data/integer_test.h new file mode 100644 index 0000000000..94c8d59897 --- /dev/null +++ b/erts/test/erl_print_SUITE_data/integer_test.h @@ -0,0 +1,1106 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This file has been automatically generated. Do NOT edit it; instead, + * run 'erl_print_tests.true integer save_expected_result' + */ + +char *integer_expected_result[] = { + "103", + "-104", + "0", + "-1", + "1", + "1", + "4711", + "-4712", + "0", + "-1", + "1", + "-4351", + "4711", + "-4712", + "0", + "-1", + "1", + "-1412567295", + "4711", + "-4712", + "0", + "-1", + "1", + "-1412567295", + "4711", + "-4712", + "0", + "-1", + "1", + "-1412567295", + "103", + "-104", + "0", + "-1", + "1", + "1", + "4711", + "-4712", + "0", + "-1", + "1", + "-4351", + "4711", + "-4712", + "0", + "-1", + "1", + "-1412567295", + "4711", + "-4712", + "0", + "-1", + "1", + "-1412567295", + "4711", + "-4712", + "0", + "-1", + "1", + "-1412567295", + "103", + "65432", + "0", + "255", + "1", + "1", + "4711", + "60824", + "0", + "65535", + "1", + "61185", + "4711", + "4294962584", + "3221225470", + "4294967295", + "1", + "2882400001", + "4711", + "4294962584", + "3221225470", + "4294967295", + "1", + "2882400001", + "4711", + "18446744073709546904", + "13835058055282163710", + "18446744073709551615", + "1", + "18446744072296984321", + "147", + "177630", + "0", + "377", + "1", + "1", + "11147", + "166630", + "0", + "177777", + "1", + "167401", + "11147", + "37777766630", + "27777777776", + "37777777777", + "1", + "25363367401", + "11147", + "37777766630", + "27777777776", + "37777777777", + "1", + "25363367401", + "11147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + "1", + "1777777777765363367401", + "67", + "ff98", + "0", + "ff", + "1", + "1", + "1267", + "ed98", + "0", + "ffff", + "1", + "ef01", + "1267", + "ffffed98", + "bffffffe", + "ffffffff", + "1", + "abcdef01", + "1267", + "ffffed98", + "bffffffe", + "ffffffff", + "1", + "abcdef01", + "1267", + "ffffffffffffed98", + "bffffffffffffffe", + "ffffffffffffffff", + "1", + "ffffffffabcdef01", + "67", + "FF98", + "0", + "FF", + "1", + "1", + "1267", + "ED98", + "0", + "FFFF", + "1", + "EF01", + "1267", + "FFFFED98", + "BFFFFFFE", + "FFFFFFFF", + "1", + "ABCDEF01", + "1267", + "FFFFED98", + "BFFFFFFE", + "FFFFFFFF", + "1", + "ABCDEF01", + "1267", + "FFFFFFFFFFFFED98", + "BFFFFFFFFFFFFFFE", + "FFFFFFFFFFFFFFFF", + "1", + "FFFFFFFFABCDEF01", + " 00103", + " -00104", + " 00000", + " -00001", + " 00001", + " 00001", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + " -04351", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "-1412567295", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "-1412567295", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "-1412567295", + " 00103", + " -00104", + " 00000", + " -00001", + " 00001", + " 00001", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + " -04351", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "-1412567295", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "-1412567295", + " 04711", + " -04712", + " 00000", + " -00001", + " 00001", + "-1412567295", + " 00103", + " 65432", + " 00000", + " 00255", + " 00001", + " 00001", + " 04711", + " 60824", + " 00000", + " 65535", + " 00001", + " 61185", + " 04711", + "4294962584", + "3221225470", + "4294967295", + " 00001", + "2882400001", + " 04711", + "4294962584", + "3221225470", + "4294967295", + " 00001", + "2882400001", + " 04711", + "18446744073709546904", + "13835058055282163710", + "18446744073709551615", + " 00001", + "18446744072296984321", + " 00147", + " 177630", + " 00000", + " 00377", + " 00001", + " 00001", + " 11147", + " 166630", + " 00000", + " 177777", + " 00001", + " 167401", + " 11147", + "37777766630", + "27777777776", + "37777777777", + " 00001", + "25363367401", + " 11147", + "37777766630", + "27777777776", + "37777777777", + " 00001", + "25363367401", + " 11147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + " 00001", + "1777777777765363367401", + " 00067", + " 0ff98", + " 00000", + " 000ff", + " 00001", + " 00001", + " 01267", + " 0ed98", + " 00000", + " 0ffff", + " 00001", + " 0ef01", + " 01267", + " ffffed98", + " bffffffe", + " ffffffff", + " 00001", + " abcdef01", + " 01267", + " ffffed98", + " bffffffe", + " ffffffff", + " 00001", + " abcdef01", + " 01267", + "ffffffffffffed98", + "bffffffffffffffe", + "ffffffffffffffff", + " 00001", + "ffffffffabcdef01", + " 00067", + " 0FF98", + " 00000", + " 000FF", + " 00001", + " 00001", + " 01267", + " 0ED98", + " 00000", + " 0FFFF", + " 00001", + " 0EF01", + " 01267", + " FFFFED98", + " BFFFFFFE", + " FFFFFFFF", + " 00001", + " ABCDEF01", + " 01267", + " FFFFED98", + " BFFFFFFE", + " FFFFFFFF", + " 00001", + " ABCDEF01", + " 01267", + "FFFFFFFFFFFFED98", + "BFFFFFFFFFFFFFFE", + "FFFFFFFFFFFFFFFF", + " 00001", + "FFFFFFFFABCDEF01", + "+103 ", + "-104 ", + "+0 ", + "-1 ", + "+1 ", + "+1 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-4351 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-1412567295 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-1412567295 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-1412567295 ", + "+103 ", + "-104 ", + "+0 ", + "-1 ", + "+1 ", + "+1 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-4351 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-1412567295 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-1412567295 ", + "+4711 ", + "-4712 ", + "+0 ", + "-1 ", + "+1 ", + "-1412567295 ", + "103 ", + "65432 ", + "0 ", + "255 ", + "1 ", + "1 ", + "4711 ", + "60824 ", + "0 ", + "65535 ", + "1 ", + "61185 ", + "4711 ", + "4294962584 ", + "3221225470 ", + "4294967295 ", + "1 ", + "2882400001 ", + "4711 ", + "4294962584 ", + "3221225470 ", + "4294967295 ", + "1 ", + "2882400001 ", + "4711 ", + "18446744073709546904 ", + "13835058055282163710 ", + "18446744073709551615 ", + "1 ", + "18446744072296984321 ", + "147 ", + "177630 ", + "0 ", + "377 ", + "1 ", + "1 ", + "11147 ", + "166630 ", + "0 ", + "177777 ", + "1 ", + "167401 ", + "11147 ", + "37777766630 ", + "27777777776 ", + "37777777777 ", + "1 ", + "25363367401 ", + "11147 ", + "37777766630 ", + "27777777776 ", + "37777777777 ", + "1 ", + "25363367401 ", + "11147 ", + "1777777777777777766630 ", + "1377777777777777777776 ", + "1777777777777777777777 ", + "1 ", + "1777777777765363367401 ", + "67 ", + "ff98 ", + "0 ", + "ff ", + "1 ", + "1 ", + "1267 ", + "ed98 ", + "0 ", + "ffff ", + "1 ", + "ef01 ", + "1267 ", + "ffffed98 ", + "bffffffe ", + "ffffffff ", + "1 ", + "abcdef01 ", + "1267 ", + "ffffed98 ", + "bffffffe ", + "ffffffff ", + "1 ", + "abcdef01 ", + "1267 ", + "ffffffffffffed98 ", + "bffffffffffffffe ", + "ffffffffffffffff ", + "1 ", + "ffffffffabcdef01 ", + "67 ", + "FF98 ", + "0 ", + "FF ", + "1 ", + "1 ", + "1267 ", + "ED98 ", + "0 ", + "FFFF ", + "1 ", + "EF01 ", + "1267 ", + "FFFFED98 ", + "BFFFFFFE ", + "FFFFFFFF ", + "1 ", + "ABCDEF01 ", + "1267 ", + "FFFFED98 ", + "BFFFFFFE ", + "FFFFFFFF ", + "1 ", + "ABCDEF01 ", + "1267 ", + "FFFFFFFFFFFFED98 ", + "BFFFFFFFFFFFFFFE ", + "FFFFFFFFFFFFFFFF ", + "1 ", + "FFFFFFFFABCDEF01 ", + " 00000103", + " -00000104", + " 00000000", + " -00000001", + " 00000001", + " 00000001", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -00004351", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -1412567295", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -1412567295", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -1412567295", + " 00000103", + " -00000104", + " 00000000", + " -00000001", + " 00000001", + " 00000001", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -00004351", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -1412567295", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -1412567295", + " 00004711", + " -00004712", + " 00000000", + " -00000001", + " 00000001", + " -1412567295", + " 00000103", + " 00065432", + " 00000000", + " 00000255", + " 00000001", + " 00000001", + " 00004711", + " 00060824", + " 00000000", + " 00065535", + " 00000001", + " 00061185", + " 00004711", + " 4294962584", + " 3221225470", + " 4294967295", + " 00000001", + " 2882400001", + " 00004711", + " 4294962584", + " 3221225470", + " 4294967295", + " 00000001", + " 2882400001", + " 00004711", + " 18446744073709546904", + " 13835058055282163710", + " 18446744073709551615", + " 00000001", + " 18446744072296984321", + " 00000147", + " 00177630", + " 00000000", + " 00000377", + " 00000001", + " 00000001", + " 00011147", + " 00166630", + " 00000000", + " 00177777", + " 00000001", + " 00167401", + " 00011147", + " 37777766630", + " 27777777776", + " 37777777777", + " 00000001", + " 25363367401", + " 00011147", + " 37777766630", + " 27777777776", + " 37777777777", + " 00000001", + " 25363367401", + " 00011147", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + " 00000001", + "1777777777765363367401", + " 00000067", + " 0000ff98", + " 00000000", + " 000000ff", + " 00000001", + " 00000001", + " 00001267", + " 0000ed98", + " 00000000", + " 0000ffff", + " 00000001", + " 0000ef01", + " 00001267", + " ffffed98", + " bffffffe", + " ffffffff", + " 00000001", + " abcdef01", + " 00001267", + " ffffed98", + " bffffffe", + " ffffffff", + " 00000001", + " abcdef01", + " 00001267", + " ffffffffffffed98", + " bffffffffffffffe", + " ffffffffffffffff", + " 00000001", + " ffffffffabcdef01", + " 00000067", + " 0000FF98", + " 00000000", + " 000000FF", + " 00000001", + " 00000001", + " 00001267", + " 0000ED98", + " 00000000", + " 0000FFFF", + " 00000001", + " 0000EF01", + " 00001267", + " FFFFED98", + " BFFFFFFE", + " FFFFFFFF", + " 00000001", + " ABCDEF01", + " 00001267", + " FFFFED98", + " BFFFFFFE", + " FFFFFFFF", + " 00000001", + " ABCDEF01", + " 00001267", + " FFFFFFFFFFFFED98", + " BFFFFFFFFFFFFFFE", + " FFFFFFFFFFFFFFFF", + " 00000001", + " FFFFFFFFABCDEF01", + "00000103 ", + "-00000104 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "00000001 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-00004351 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-1412567295 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-1412567295 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-1412567295 ", + "00000103 ", + "-00000104 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "00000001 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-00004351 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-1412567295 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-1412567295 ", + "00004711 ", + "-00004712 ", + "00000000 ", + "-00000001 ", + "00000001 ", + "-1412567295 ", + "00000103 ", + "00065432 ", + "00000000 ", + "00000255 ", + "00000001 ", + "00000001 ", + "00004711 ", + "00060824 ", + "00000000 ", + "00065535 ", + "00000001 ", + "00061185 ", + "00004711 ", + "4294962584 ", + "3221225470 ", + "4294967295 ", + "00000001 ", + "2882400001 ", + "00004711 ", + "4294962584 ", + "3221225470 ", + "4294967295 ", + "00000001 ", + "2882400001 ", + "00004711 ", + "18446744073709546904 ", + "13835058055282163710 ", + "18446744073709551615 ", + "00000001 ", + "18446744072296984321 ", + "00000147 ", + "00177630 ", + "00000000 ", + "00000377 ", + "00000001 ", + "00000001 ", + "00011147 ", + "00166630 ", + "00000000 ", + "00177777 ", + "00000001 ", + "00167401 ", + "00011147 ", + "37777766630 ", + "27777777776 ", + "37777777777 ", + "00000001 ", + "25363367401 ", + "00011147 ", + "37777766630 ", + "27777777776 ", + "37777777777 ", + "00000001 ", + "25363367401 ", + "00011147 ", + "1777777777777777766630", + "1377777777777777777776", + "1777777777777777777777", + "00000001 ", + "1777777777765363367401", + "00000067 ", + "0000ff98 ", + "00000000 ", + "000000ff ", + "00000001 ", + "00000001 ", + "00001267 ", + "0000ed98 ", + "00000000 ", + "0000ffff ", + "00000001 ", + "0000ef01 ", + "00001267 ", + "ffffed98 ", + "bffffffe ", + "ffffffff ", + "00000001 ", + "abcdef01 ", + "00001267 ", + "ffffed98 ", + "bffffffe ", + "ffffffff ", + "00000001 ", + "abcdef01 ", + "00001267 ", + "ffffffffffffed98 ", + "bffffffffffffffe ", + "ffffffffffffffff ", + "00000001 ", + "ffffffffabcdef01 ", + "00000067 ", + "0000FF98 ", + "00000000 ", + "000000FF ", + "00000001 ", + "00000001 ", + "00001267 ", + "0000ED98 ", + "00000000 ", + "0000FFFF ", + "00000001 ", + "0000EF01 ", + "00001267 ", + "FFFFED98 ", + "BFFFFFFE ", + "FFFFFFFF ", + "00000001 ", + "ABCDEF01 ", + "00001267 ", + "FFFFED98 ", + "BFFFFFFE ", + "FFFFFFFF ", + "00000001 ", + "ABCDEF01 ", + "00001267 ", + "FFFFFFFFFFFFED98 ", + "BFFFFFFFFFFFFFFE ", + "FFFFFFFFFFFFFFFF ", + "00000001 ", + "FFFFFFFFABCDEF01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000103 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000104 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004351 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001412567295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001412567295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001412567295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000103 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000104 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004351 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001412567295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001412567295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004712 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "-0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001412567295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000103 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000065432 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000255 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000060824 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000065535 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000061185 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004294962584 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003221225470 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004294967295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004294962584 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003221225470 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004294967295 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000002882400001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004711 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000018446744073709546904 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000013835058055282163710 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000018446744073709551615 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000018446744072296984321 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000177630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000377 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000166630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000177777 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000167401 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000037777766630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000027777777776 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000037777777777 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000025363367401 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000037777766630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000027777777776 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000037777777777 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000025363367401 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000011147 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001777777777777777766630 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001377777777777777777776 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001777777777777777777777 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001777777777765363367401 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000067 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ff98 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ed98 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ef01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffed98 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000bffffffe ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000abcdef01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffed98 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000bffffffe ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000abcdef01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffed98 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000bffffffffffffffe ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffffffffff ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ffffffffabcdef01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000067 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FF98 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ED98 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000EF01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFED98 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000BFFFFFFE ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ABCDEF01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFED98 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000BFFFFFFE ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000ABCDEF01 ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001267 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFFFFFFED98 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000BFFFFFFFFFFFFFFE ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFFFFFFFFFF ", + "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001 ", + "000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000FFFFFFFFABCDEF01 ", + NULL}; diff --git a/erts/test/erl_print_SUITE_data/snprintf_test.h b/erts/test/erl_print_SUITE_data/snprintf_test.h new file mode 100644 index 0000000000..0849b60562 --- /dev/null +++ b/erts/test/erl_print_SUITE_data/snprintf_test.h @@ -0,0 +1,43 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This file has been automatically generated. Do NOT edit it; instead, + * run 'erl_print_tests.false snprintf save_expected_result' + */ + +char *snprintf_expected_result[] = { + "hej h", + "hej ho", + "hej hop", + "hej hopp", + "hej hopp", + "hej 4", + "hej 47", + "hej 471", + "hej 4711", + "hej 4711", + "abcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ1234567890()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_\a\b\f\n\r", + "abcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ1234567890()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_\a\b\f\n\r\t", + "abcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ1234567890()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_\a\b\f\n\r\t\v", + "abcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ1234567890()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_\a\b\f\n\r\t\v", + "abcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ1234567890()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_\a\b\f\n\r\t\v", + "abcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅ", + "abcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ1234567890()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_\a\b\f\n\r\t\vabcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ1234567890()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_\a\b\f\n\r\t\v", + NULL}; diff --git a/erts/test/erl_print_SUITE_data/string_test.h b/erts/test/erl_print_SUITE_data/string_test.h new file mode 100644 index 0000000000..32249ab6e9 --- /dev/null +++ b/erts/test/erl_print_SUITE_data/string_test.h @@ -0,0 +1,33 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2005-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * This file has been automatically generated. Do NOT edit it; instead, + * run 'erl_print_tests.false string save_expected_result' + */ + +char *string_expected_result[] = { + "hej", + "hopp ", + " hopp", + "hopp ", + " hopp", + "\t abcd", + "\t abcdefghijklmnopqrstuvwxyzåäöABCDEFGHIJKLMNOPQRSTUVXYZÅÄÖ1234567890()[]{}+-;,:.@£$!\"#¤%&/\\=?'`´^~§½|<>¨*_\a\b\f\n\r\t\v", + NULL}; diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl new file mode 100644 index 0000000000..ce64ef1a75 --- /dev/null +++ b/erts/test/erlc_SUITE.erl @@ -0,0 +1,286 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(erlc_SUITE). + +%% Tests the erlc command by compiling various types of files. + +-export([all/1, compile_erl/1, compile_yecc/1, compile_script/1, + compile_mib/1, good_citizen/1, deep_cwd/1]). + +-include("test_server.hrl"). + +all(suite) -> + [compile_erl, compile_yecc, compile_script, compile_mib, + good_citizen, deep_cwd]. + +%% Copy from erlc_SUITE_data/include/erl_test.hrl. + +-record(person, {name, shoe_size}). + +%% Tests that compiling Erlang source code works. + +compile_erl(Config) when is_list(Config) -> + ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), + ?line FileName = filename:join(SrcDir, "erl_test_ok.erl"), + + %% By default, warnings are now turned on. + ?line run(Config, Cmd, FileName, "", + ["Warning: function foo/0 is unused\$", + "_OK_"]), + + %% Test that the compiled file is where it should be, + %% and that it is runnable. + + ?line {module, erl_test_ok} = code:load_abs(filename:join(OutDir, + "erl_test_ok")), + ?line 42 = erl_test_ok:shoe_size(#person{shoe_size=42}), + ?line code:purge(erl_test_ok), + + %% Try disabling warnings. + + ?line run(Config, Cmd, FileName, "-W0", ["_OK_"]), + + %% Check a bad file. + + ?line BadFile = filename:join(SrcDir, "erl_test_bad.erl"), + ?line run(Config, Cmd, BadFile, "", ["function non_existing/1 undefined\$", + "_ERROR_"]), + + ok. + +%% Test that compiling yecc source code works. + +compile_yecc(Config) when is_list(Config) -> + ?line {SrcDir, _, OutDir} = get_dirs(Config), + ?line Cmd = erlc() ++ " -o" ++ OutDir ++ " ", + ?line FileName = filename:join(SrcDir, "yecc_test_ok.yrl"), + ?line run(Config, Cmd, FileName, "-W0", ["_OK_"]), + ?line true = exists(filename:join(OutDir, "yecc_test_ok.erl")), + + ?line BadFile = filename:join(SrcDir, "yecc_test_bad.yrl"), + ?line run(Config, Cmd, BadFile, "-W0", + ["rootsymbol form is not a nonterminal\$", + "undefined nonterminal: form\$", + "Nonterminals is missing\$", + "_ERROR_"]), + ?line exists(filename:join(OutDir, "yecc_test_ok.erl")), + + ok. + +%% Test that compiling start scripts works. + +compile_script(Config) when is_list(Config) -> + ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), + ?line FileName = filename:join(SrcDir, "start_ok.script"), + ?line run(Config, Cmd, FileName, "", ["_OK_"]), + ?line true = exists(filename:join(OutDir, "start_ok.boot")), + + ?line BadFile = filename:join(SrcDir, "start_bad.script"), + ?line run(Config, Cmd, BadFile, "", ["syntax error before:", "_ERROR_"]), + ok. + +%% Test that compiling SNMP mibs works. + +compile_mib(Config) when is_list(Config) -> + ?line {SrcDir, OutDir, Cmd} = get_cmd(Config), + ?line FileName = filename:join(SrcDir, "GOOD-MIB.mib"), + ?line run(Config, Cmd, FileName, "", ["_OK_"]), + ?line Output = filename:join(OutDir, "GOOD-MIB.bin"), + ?line true = exists(Output), + + %% Try -W option. + + ?line ok = file:delete(Output), + ?line run(Config, Cmd, FileName, "-W", + ["_OK_"]), + ?line true = exists(Output), + + %% Try -W option and more verbose. + + ?line ok = file:delete(Output), + ?line case test_server:os_type() of + {unix,_} -> + ?line run(Config, Cmd, FileName, "-W +'{verbosity,info}'", + ["GOOD-MIB.mib: Info. No accessfunction for 'sysDescr'", + "_OK_"]), + ?line true = exists(Output), + ?line ok = file:delete(Output); + _ -> ok %Don't bother -- too much work. + end, + + %% Try a bad file. + + ?line BadFile = filename:join(SrcDir, "BAD-MIB.mib"), + ?line run(Config, Cmd, BadFile, "", + ["Error: syntax error before: mibs\$", "compilation_failed_ERROR_"]), + + %% Make sure that no -I option works. + + ?line NewCmd = erlc() ++ " -o" ++ OutDir ++ " ", + ?line run(Config, NewCmd, FileName, "", ["_OK_"]), + ?line true = exists(Output), + + ok. + +%% Checks that 'erlc' doesn't eat any input (important when called from a +%% shell script with redirected input). +good_citizen(Config) when is_list(Config) -> + case os:type() of + {unix, _} -> + ?line PrivDir = ?config(priv_dir, Config), + ?line Answer = filename:join(PrivDir, "answer"), + ?line Script = filename:join(PrivDir, "test_script"), + ?line Test = filename:join(PrivDir, "test.erl"), + ?line S = ["#! /bin/sh\n", "erlc ", Test, "\n", + "read reply\n", "echo $reply\n"], + ?line ok = file:write_file(Script, S), + ?line ok = file:write_file(Test, "-module(test).\n"), + ?line Cmd = "echo y | sh " ++ Script ++ " > " ++ Answer, + ?line os:cmd(Cmd), + ?line {ok, Answer0} = file:read_file(Answer), + ?line [$y|_] = binary_to_list(Answer0), + ok; + _ -> + {skip, "Unix specific"} + end. + +%% Make sure that compiling an Erlang module deep down in +%% in a directory with more than 255 characters works. +deep_cwd(Config) when is_list(Config) -> + case os:type() of + {unix, _} -> + PrivDir = ?config(priv_dir, Config), + deep_cwd_1(PrivDir); + _ -> + {skip, "Only a problem on Unix"} + end. + +deep_cwd_1(PrivDir) -> + ?line DeepDir0 = filename:join(PrivDir, lists:duplicate(128, $a)), + ?line DeepDir = filename:join(DeepDir0, lists:duplicate(128, $b)), + ?line ok = file:make_dir(DeepDir0), + ?line ok = file:make_dir(DeepDir), + ?line ok = file:set_cwd(DeepDir), + ?line ok = file:write_file("test.erl", "-module(test).\n\n"), + ?line io:format("~s\n", [os:cmd("erlc test.erl")]), + ?line true = filelib:is_file("test.beam"), + ok. + +erlc() -> + case os:find_executable("erlc") of + false -> + test_server:fail("Can't find erlc"); + Erlc -> + Erlc + end. + +%% Runs a command. + +run(Config, Cmd0, Name, Options, Expect) -> + Cmd = Cmd0 ++ " " ++ Options ++ " " ++ Name, + io:format("~s", [Cmd]), + Result = run_command(Config, Cmd), + Messages = split(Result, [], []), + io:format("Result: ~p", [Messages]), + io:format("Expected: ~p", [Expect]), + match_messages(Messages, Expect). + +split([$\n|Rest], Current, Lines) -> + split(Rest, [], [lists:reverse(Current)|Lines]); +split([$\r|Rest], Current, Lines) -> + split(Rest, Current, Lines); +split([Char|Rest], Current, Lines) -> + split(Rest, [Char|Current], Lines); +split([], [], Lines) -> + lists:reverse(Lines); +split([], Current, Lines) -> + split([], [], [lists:reverse(Current)|Lines]). + +match_messages([Msg|Rest1], [Regexp|Rest2]) -> + case re:run(Msg, Regexp, [{capture,none}]) of + match -> + ok; + nomatch -> + io:format("Not matching: ~s\n", [Msg]), + io:format("Regexp : ~s\n", [Regexp]), + test_server:fail(message_mismatch) + end, + match_messages(Rest1, Rest2); +match_messages([], [Expect|Rest]) -> + test_server:fail({too_few_messages, [Expect|Rest]}); +match_messages([Msg|Rest], []) -> + test_server:fail({too_many_messages, [Msg|Rest]}); +match_messages([], []) -> + ok. + +get_cmd(Cfg) -> + ?line {SrcDir, IncDir, OutDir} = get_dirs(Cfg), + ?line Cmd = erlc() ++ " -I" ++ IncDir ++ " -o" ++ OutDir ++ " ", + {SrcDir, OutDir, Cmd}. + +get_dirs(Cfg) -> + ?line DataDir = ?config(data_dir, Cfg), + ?line PrivDir = ?config(priv_dir, Cfg), + ?line SrcDir = filename:join(DataDir, "src"), + ?line IncDir = filename:join(DataDir, "include"), + {SrcDir, IncDir, PrivDir}. + +exists(Name) -> + filelib:is_file(Name). + +%% Runs the command using os:cmd/1. +%% +%% Returns the output from the command (as a list of characters with +%% embedded newlines). The very last line will indicate the +%% exit status of the command, where _OK_ means zero, and _ERROR_ +%% a non-zero exit status. + +run_command(Config, Cmd) -> + TmpDir = filename:join(?config(priv_dir, Config), "tmp"), + file:make_dir(TmpDir), + {RunFile, Run, Script} = run_command(TmpDir, os:type(), Cmd), + ok = file:write_file(filename:join(TmpDir, RunFile), Script), + os:cmd(Run). + +run_command(Dir, {win32, _}, Cmd) -> + BatchFile = filename:join(Dir, "run.bat"), + Run = re:replace(filename:rootname(BatchFile), "/", "\\", + [global,{return,list}]), + {BatchFile, + Run, + ["@echo off\r\n", + "set ERLC_EMULATOR=", atom_to_list(lib:progname()), "\r\n", + Cmd, "\r\n", + "if errorlevel 1 echo _ERROR_\r\n", + "if not errorlevel 1 echo _OK_\r\n"]}; +run_command(Dir, {unix, _}, Cmd) -> + Name = filename:join(Dir, "run"), + {Name, + "/bin/sh " ++ Name, + ["#!/bin/sh\n", + "ERLC_EMULATOR='", atom_to_list(lib:progname()), "'\n", + "export ERLC_EMULATOR\n", + Cmd, "\n", + "case $? in\n", + " 0) echo '_OK_';;\n", + " *) echo '_ERROR_';;\n", + "esac\n"]}; +run_command(_Dir, Other, _Cmd) -> + M = io_lib:format("Don't know how to test exit code for ~p", [Other]), + test_server:fail(lists:flatten(M)). diff --git a/erts/test/erlc_SUITE_data/include/erl_test.hrl b/erts/test/erlc_SUITE_data/include/erl_test.hrl new file mode 100644 index 0000000000..fd89cb2f60 --- /dev/null +++ b/erts/test/erlc_SUITE_data/include/erl_test.hrl @@ -0,0 +1,19 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-record(person, {name, shoe_size}). diff --git a/erts/test/erlc_SUITE_data/src/BAD-MIB.mib b/erts/test/erlc_SUITE_data/src/BAD-MIB.mib new file mode 100644 index 0000000000..93bde356f4 --- /dev/null +++ b/erts/test/erlc_SUITE_data/src/BAD-MIB.mib @@ -0,0 +1 @@ +All mibs are bad! diff --git a/erts/test/erlc_SUITE_data/src/GOOD-MIB.mib b/erts/test/erlc_SUITE_data/src/GOOD-MIB.mib new file mode 100644 index 0000000000..af350ba891 --- /dev/null +++ b/erts/test/erlc_SUITE_data/src/GOOD-MIB.mib @@ -0,0 +1,39 @@ + GOOD-MIB DEFINITIONS ::= BEGIN + + IMPORTS + mgmt + FROM RFC1155-SMI + OBJECT-TYPE + FROM RFC-1212; + + + -- textual conventions + + DisplayString ::= + OCTET STRING + + -- This data type is used to model textual information taken + -- from the NVT ASCII character set. By convention, objects + -- with this syntax are declared as having + -- the System group + + -- Implementation of the System group is mandatory for all + -- systems. If an agent is not configured to have a value + -- for any of these variables, a string of length 0 is + -- returned. + + sysDescr OBJECT-TYPE + SYNTAX DisplayString (SIZE (0..255)) + ACCESS read-only + STATUS mandatory + + DESCRIPTION + "A textual description of the entity. This value + should include the full name and version + identification of the system's hardware type, + software operating-system, and networking + software. It is mandatory that this only contain + printable ASCII characters." + ::= { mgmt 1 } + + END diff --git a/erts/test/erlc_SUITE_data/src/erl_test_bad.erl b/erts/test/erlc_SUITE_data/src/erl_test_bad.erl new file mode 100644 index 0000000000..fb62f835ca --- /dev/null +++ b/erts/test/erlc_SUITE_data/src/erl_test_bad.erl @@ -0,0 +1,22 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(erl_test_bad). + +-export([non_existing/1]). diff --git a/erts/test/erlc_SUITE_data/src/erl_test_ok.erl b/erts/test/erlc_SUITE_data/src/erl_test_ok.erl new file mode 100644 index 0000000000..50fa063a94 --- /dev/null +++ b/erts/test/erlc_SUITE_data/src/erl_test_ok.erl @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(erl_test_ok). +-export([shoe_size/1]). + +-include("erl_test.hrl"). + +shoe_size(#person{shoe_size=Size}) -> + Size. + +foo() -> + ok. diff --git a/erts/test/erlc_SUITE_data/src/start_bad.script b/erts/test/erlc_SUITE_data/src/start_bad.script new file mode 100644 index 0000000000..0cb903fabd --- /dev/null +++ b/erts/test/erlc_SUITE_data/src/start_bad.script @@ -0,0 +1 @@ +script,{"OTP APN 181 01","NT"} diff --git a/erts/test/erlc_SUITE_data/src/start_ok.script b/erts/test/erlc_SUITE_data/src/start_ok.script new file mode 100644 index 0000000000..4cd89f0439 --- /dev/null +++ b/erts/test/erlc_SUITE_data/src/start_ok.script @@ -0,0 +1,207 @@ +{script,{"OTP APN 181 01","NT"}, + [{preLoaded,[init,erl_prim_loader]}, + {progress,preloaded}, + {path,["$ROOT/lib/kernel/ebin", + "$ROOT/lib/stdlib/ebin"]}, + {primLoad,[error_handler, + ets, + lib, + lists, + heart, + application_controller, + application_master, + application, + auth, + c, + calendar, + code, + erlang, + erl_distribution, + erl_parse, + erl_scan, + io_lib, + io_lib_format, + io_lib_fread, + io_lib_pretty, + error_logger, + file, + filename, + os, + gen, + gen_event, + gen_server, + global, + kernel, + net_kernel, + proc_lib, + rpc, + supervisor, + sys]}, + {kernel_load_completed}, + {progress,kernel_load_completed}, + {primLoad,[group, + user, + user_drv, + kernel_config, + net, + erl_boot_server, + net_adm]}, + {primLoad,[math, + random, + ordsets, + shell_default, + timer, + gen_fsm, + pg, + unix, + dict, + pool, + string, + digraph, + io, + epp, + queue, + erl_eval, + erl_id_trans, + shell, + erl_internal, + erl_lint, + edlin, + erl_pp, + error_logger_file_h, + error_logger_tty_h, + log_mf_h, + dets, + disk_log, + regexp, + slave, + supervisor_bridge]}, + {progress,modules_loaded}, + {kernelProcess,heart,{heart,start,[]}}, + {kernelProcess,error_logger,{error_logger,start_link,[]}}, + {kernelProcess,application_controller, + {application_controller, + start, + [{application, + kernel, + [{description,"ERTS CXC 138 10"}, + {vsn,"NT"}, + {modules, + [{application,1}, + {erlang,1}, + {group,1}, + {rpc,1}, + {application_controller,1}, + {error_handler,1}, + {heart,1}, + {application_master,1}, + {error_logger,1}, + {init,1}, + {user,1}, + {auth,1}, + {kernel,1}, + {user_drv,1}, + {code,1}, + {kernel_config,1}, + {net,1}, + {erl_boot_server,1}, + {erl_prim_loader,1}, + {file,1}, + {net_adm,1}, + {erl_distribution,1}, + {global,1}, + {net_kernel,1}]}, + {registered, + [init, + erl_prim_loader, + heart, + error_logger, + application_controller, + kernel_sup, + kernel_config, + net_sup, + net_kernel, + auth, + code_server, + file_server, + boot_server, + global_name_server, + rex, + user]}, + {applications,[]}, + {env, + [{error_logger,tty}, + {os, nt}]}, + {maxT,infinity}, + {maxP,infinity}, + {mod,{kernel,[]}}]}]}}, + {progress,init_kernel_started}, + {apply,{application,load, + [{application, + stdlib, + [{description,"ERTS CXC 138 10"}, + {vsn,"NT"}, + {modules, + [{c,1}, + {gen,1}, + {io_lib_format,1}, + {math,1}, + {random,1}, + {sys,1}, + {calendar,1}, + {gen_event,1}, + {io_lib_fread,1}, + {ordsets,1}, + {shell_default,1}, + {timer,1}, + {gen_fsm,1}, + {io_lib_pretty,1}, + {pg,1}, + {slave,1}, + {unix,1}, + {dict,1}, + {gen_server,1}, + {lib,1}, + {pool,1}, + {string,1}, + {digraph,1}, + {io,1}, + {lists,1}, + {proc_lib,1}, + {supervisor,1}, + {epp,1}, + {io_lib,1}, + {log_mf_h,1}, + {queue,1}, + {erl_eval,1}, + {erl_id_trans,1}, + {shell,1}, + {erl_internal,1}, + {erl_lint,1}, + {error_logger_file_h,1}, + {erl_parse,1}, + {error_logger_tty_h,1}, + {edlin,1}, + {erl_pp,1}, + {ets,1}, + {dets,1}, + {disk_log,1}, + {regexp,1}, + {erl_scan,1}, + {supervisor_bridge,1}]}, + {registered, + [timer_server, + rsh_starter, + take_over_monitor, + pool_master, + dets, + disk_log]}, + {applications,[kernel]}, + {env,[]}, + {maxT,infinity}, + {maxP,infinity}]}]}}, + {progress,applications_loaded}, + {apply,{application,start,[kernel,permanent]}}, + {apply,{application,start,[stdlib,permanent]}}, + {apply,{c,erlangrc,[]}}, + {progress,started}]}. diff --git a/erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl b/erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl new file mode 100644 index 0000000000..409718e24c --- /dev/null +++ b/erts/test/erlc_SUITE_data/src/yecc_test_bad.yrl @@ -0,0 +1,32 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +foo + +Nonterminals +form. + +Terminals +atom dot. + +Rootsymbol form. + +form -> atom dot : '$1'. + +Erlang code. diff --git a/erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl b/erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl new file mode 100644 index 0000000000..a96085ac2d --- /dev/null +++ b/erts/test/erlc_SUITE_data/src/yecc_test_ok.yrl @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +Nonterminals +form. + +Terminals +atom dot. + +Rootsymbol form. + +form -> atom dot : '$1'. + +Erlang code. diff --git a/erts/test/erlexec_SUITE.erl b/erts/test/erlexec_SUITE.erl new file mode 100644 index 0000000000..fcf1e67e9e --- /dev/null +++ b/erts/test/erlexec_SUITE.erl @@ -0,0 +1,437 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : erlexec_SUITE.erl +%%% Author : Rickard Green +%%% Description : Test erlexec's command line parsing +%%% +%%% Created : 22 May 2007 by Rickard Green +%%%------------------------------------------------------------------- +-module(erlexec_SUITE). + + +%-define(line_trace, 1). + +-define(DEFAULT_TIMEOUT, ?t:minutes(1)). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([args_file/1, evil_args_file/1, env/1, args_file_env/1, otp_7461/1, otp_7461_remote/1, otp_8209/1]). + +-include("test_server.hrl"). + + +init_per_testcase(Case, Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + SavedEnv = save_env(), + [{testcase, Case}, {watchdog, Dog}, {erl_flags_env, SavedEnv} |Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + SavedEnv = ?config(erl_flags_env, Config), + restore_env(SavedEnv), + cleanup_nodes(), + ?t:timetrap_cancel(Dog), + ok. + +all(doc) -> []; +all(suite) -> + [args_file, evil_args_file, env, args_file_env, otp_7461, otp_8209]. + + +otp_8209(doc) -> + ["Test that plain first argument does not " + "destroy -home switch [OTP-8209]"]; +otp_8209(suite) -> + []; +otp_8209(Config) when is_list(Config) -> + ?line {ok,[[PName]]} = init:get_argument(progname), + ?line SNameS = "erlexec_test_01", + ?line SName = list_to_atom(SNameS++"@"++ + hd(tl(string:tokens(atom_to_list(node()),"@")))), + ?line Cmd = PName ++ " dummy_param -sname "++SNameS++" -setcookie "++ + atom_to_list(erlang:get_cookie()), + ?line open_port({spawn,Cmd},[]), + ?line pong = loop_ping(SName,40), + ?line {ok,[[_]]} = rpc:call(SName,init,get_argument,[home]), + ?line ["dummy_param"] = rpc:call(SName,init,get_plain_arguments,[]), + ?line ok = cleanup_nodes(), + ok. + +cleanup_nodes() -> + cleanup_node("erlexec_test_01",20). +cleanup_node(SNameS,0) -> + {error, {would_not_die,list_to_atom(SNameS)}}; +cleanup_node(SNameS,N) -> + SName = list_to_atom(SNameS++"@"++ + hd(tl(string:tokens(atom_to_list(node()),"@")))), + case rpc:call(SName,init,stop,[]) of + {badrpc,_} -> + ok; + ok -> + receive after 500 -> ok end, + cleanup_node(SNameS,N-1) + end. + +loop_ping(_,0) -> + pang; +loop_ping(Node,N) -> + case net_adm:ping(Node) of + pang -> + receive + after 500 -> + ok + end, + loop_ping(Node, N-1); + pong -> + pong + end. + +args_file(doc) -> []; +args_file(suite) -> []; +args_file(Config) when is_list(Config) -> + ?line AFN1 = privfile("1", Config), + ?line AFN2 = privfile("2", Config), + ?line AFN3 = privfile("3", Config), + ?line AFN4 = privfile("4", Config), + ?line AFN5 = privfile("5", Config), + ?line AFN6 = privfile("6", Config), + ?line write_file(AFN1, + "-MiscArg2~n" + "# a comment +\\#1000~n" + "+\\#200 # another comment~n" + "~n" + "# another config file to read~n" + " -args_file ~s#acomment~n" + "~n" + "-MiscArg7~n" + "#~n" + "+\\#700~n" + "-extra +XtraArg6~n", + [AFN2]), + ?line write_file(AFN2, + "-MiscArg3~n" + "+\\#300~n" + "-args_file ~s~n" + "-MiscArg5~n" + "+\\#500#anothercomment -MiscArg10~n" + "-args_file ~s~n" + "-args_file ~s~n" + "-args_file ~s~n" + "-extra +XtraArg5~n", + [AFN3, AFN4, AFN5, AFN6]), + ?line write_file(AFN3, + "# comment again~n" + " -MiscArg4 +\\#400 -extra +XtraArg1"), + ?line write_file(AFN4, + " -MiscArg6 +\\#600 -extra +XtraArg2~n" + "+XtraArg3~n" + "+XtraArg4~n" + "# comment again~n"), + ?line write_file(AFN5, ""), + ?line write_file(AFN6, "-extra # +XtraArg10~n"), + ?line CmdLine = "+#100 -MiscArg1 " + ++ "-args_file " ++ AFN1 + ++ " +#800 -MiscArg8 -extra +XtraArg7 +XtraArg8", + ?line {Emu, Misc, Extra} = emu_args(CmdLine), + ?line verify_args(["-#100", "-#200", "-#300", "-#400", + "-#500", "-#600", "-#700", "-#800"], Emu), + ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", + "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8"], + Misc), + ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], + Extra), + ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + "-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", + "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8", + "+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], + Emu), + ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + "-#100", "-#200", "-#300", "-#400", + "-#500", "-#600", "-#700", "-#800", + "+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + "+XtraArg5", "+XtraArg6", "+XtraArg7", "+XtraArg8"], + Misc), + ?line verify_not_args(["-MiscArg10", "-#1000", "+XtraArg10", + "-#100", "-#200", "-#300", "-#400", + "-#500", "-#600", "-#700", "-#800", + "-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", + "-MiscArg5", "-MiscArg6", "-MiscArg7", "-MiscArg8"], + Extra), + ?line ok. + +evil_args_file(doc) -> []; +evil_args_file(suite) -> []; +evil_args_file(Config) when is_list(Config) -> + ?line Lim = 300, + ?line FNums = lists:seq(1, Lim), + lists:foreach(fun (End) when End == Lim -> + ?line AFN = privfile(integer_to_list(End), Config), + ?line write_file(AFN, + "-MiscArg~p ", + [End]); + (I) -> + ?line AFNX = privfile(integer_to_list(I), Config), + ?line AFNY = privfile(integer_to_list(I+1), Config), + {Frmt, Args} = + case I rem 2 of + 0 -> + {"-MiscArg~p -args_file ~s -MiscArg~p", + [I, AFNY, I]}; + _ -> + {"-MiscArg~p -args_file ~s", + [I, AFNY]} + end, + ?line write_file(AFNX, Frmt, Args) + end, + FNums), + ?line {_Emu, Misc, _Extra} = emu_args("-args_file " + ++ privfile("1", Config)), + ?line ANums = FNums + ++ lists:reverse(lists:filter(fun (I) when I == Lim -> false; + (I) when I rem 2 == 0 -> true; + (_) -> false + end, FNums)), + ?line verify_args(lists:map(fun (I) -> "-MiscArg"++integer_to_list(I) end, + ANums), + Misc), + ?line ok. + + + +env(doc) -> []; +env(suite) -> []; +env(Config) when is_list(Config) -> + ?line os:putenv("ERL_AFLAGS", "-MiscArg1 +#100 -extra +XtraArg1 +XtraArg2"), + ?line CmdLine = "+#200 -MiscArg2 -extra +XtraArg3 +XtraArg4", + ?line os:putenv("ERL_FLAGS", "-MiscArg3 +#300 -extra +XtraArg5"), + ?line os:putenv("ERL_ZFLAGS", "-MiscArg4 +#400 -extra +XtraArg6"), + ?line {Emu, Misc, Extra} = emu_args(CmdLine), + ?line verify_args(["-#100", "-#200", "-#300", "-#400"], Emu), + ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4"], + Misc), + ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + "+XtraArg5", "+XtraArg6"], + Extra), + ?line ok. + +args_file_env(doc) -> []; +args_file_env(suite) -> []; +args_file_env(Config) when is_list(Config) -> + ?line AFN1 = privfile("1", Config), + ?line AFN2 = privfile("2", Config), + ?line write_file(AFN1, "-MiscArg2 +\\#200 -extra +XtraArg1"), + ?line write_file(AFN2, "-MiscArg3 +\\#400 -extra +XtraArg3"), + ?line os:putenv("ERL_AFLAGS", + "-MiscArg1 +#100 -args_file "++AFN1++ " -extra +XtraArg2"), + ?line CmdLine = "+#300 -args_file "++AFN2++" -MiscArg4 -extra +XtraArg4", + ?line os:putenv("ERL_FLAGS", "-MiscArg5 +#500 -extra +XtraArg5"), + ?line os:putenv("ERL_ZFLAGS", "-MiscArg6 +#600 -extra +XtraArg6"), + ?line {Emu, Misc, Extra} = emu_args(CmdLine), + ?line verify_args(["-#100", "-#200", "-#300", "-#400", + "-#500", "-#600"], Emu), + ?line verify_args(["-MiscArg1", "-MiscArg2", "-MiscArg3", "-MiscArg4", + "-MiscArg5", "-MiscArg6"], + Misc), + ?line verify_args(["+XtraArg1", "+XtraArg2", "+XtraArg3", "+XtraArg4", + "+XtraArg5", "+XtraArg6"], + Extra), + ?line ok. + +%% Make sure "erl -detached" survives when parent process group gets killed +otp_7461(doc) -> []; +otp_7461(suite) -> []; +otp_7461(Config) when is_list(Config) -> + case os:type() of + {unix,_} -> + {NetStarted, _} = net_kernel:start([test_server, shortnames]), + try + net_kernel:monitor_nodes(true), + register(otp_7461, self()), + + otp_7461_do(Config) + after + catch unregister(otp_7461), + catch net_kernel:monitor_nodes(false), + case NetStarted of + ok -> net_kernel:stop(); + _ -> ok + end + end; + _ -> + {skip,"Only on Unix."} + end. + +otp_7461_do(Config) -> + io:format("alive=~p node=~p\n",[is_alive(), node()]), + TestProg = filename:join([?config(data_dir, Config), "erlexec_tests"]), + {ok, [[ErlProg]]} = init:get_argument(progname), + ?line Cmd = TestProg ++ " " ++ ErlProg ++ + " -detached -sname " ++ get_nodename(otp_7461) ++ + " -setcookie " ++ atom_to_list(erlang:get_cookie()) ++ + " -pa " ++ filename:dirname(code:which(?MODULE)) ++ + " -s erlexec_SUITE otp_7461_remote init " ++ atom_to_list(node()), + + %% otp_7461 --------> erlexec_tests.c --------> cerl -detached + %% open_port fork+exec + + io:format("spawn port prog ~p\n",[Cmd]), + ?line Port = open_port({spawn, Cmd}, [eof]), + + io:format("Wait for node to connect...\n",[]), + ?line {nodeup, Slave} = receive Msg -> Msg + after 20*1000 -> timeout end, + io:format("Node alive: ~p\n", [Slave]), + + ?line pong = net_adm:ping(Slave), + io:format("Ping ok towards ~p\n", [Slave]), + + ?line Port ! { self(), {command, "K"}}, % Kill child process group + ?line {Port, {data, "K"}} = receive Msg2 -> Msg2 end, + ?line port_close(Port), + + %% Now the actual test. Detached node should still be alive. + ?line pong = net_adm:ping(Slave), + io:format("Ping still ok towards ~p\n", [Slave]), + + %% Halt node + ?line rpc:cast(Slave, ?MODULE, otp_7461_remote, [[halt, self()]]), + + ?line {nodedown, Slave} = receive Msg3 -> Msg3 + after 20*1000 -> timeout end, + io:format("Node dead: ~p\n", [Slave]), + ok. + + +%% Executed on slave node +otp_7461_remote([init, Master]) -> + io:format("otp_7461_remote(init,~p) at ~p\n",[Master, node()]), + net_kernel:connect_node(Master); +otp_7461_remote([halt, Pid]) -> + io:format("halt order from ~p to node ~p\n",[Pid,node()]), + halt(). + + + +%% +%% Utils +%% + +save_env() -> + {erl_flags, + os:getenv("ERL_AFLAGS"), + os:getenv("ERL_FLAGS"), + os:getenv("ERL_"++erlang:system_info(otp_release)++"_FLAGS"), + os:getenv("ERL_ZFLAGS")}. + +restore_env(EVar, false) when is_list(EVar) -> + restore_env(EVar, ""); +restore_env(EVar, "") when is_list(EVar) -> + case os:getenv(EVar) of + false -> ok; + "" -> ok; + " " -> ok; + _ -> os:putenv(EVar, " ") + end; +restore_env(EVar, Value) when is_list(EVar), is_list(Value) -> + case os:getenv(EVar) of + Value -> ok; + _ -> os:putenv(EVar, Value) + end. + +restore_env({erl_flags, AFlgs, Flgs, RFlgs, ZFlgs}) -> + restore_env("ERL_AFLAGS", AFlgs), + restore_env("ERL_FLAGS", Flgs), + restore_env("ERL_"++erlang:system_info(otp_release)++"_FLAGS", RFlgs), + restore_env("ERL_ZFLAGS", ZFlgs), + ok. + +privfile(Name, Config) -> + filename:join([?config(priv_dir, Config), + atom_to_list(?config(testcase, Config)) ++ "." ++ Name]). + +write_file(FileName, Frmt) -> + write_file(FileName, Frmt, []). + +write_file(FileName, Frmt, Args) -> + {ok, File} = file:open(FileName, [write]), + io:format(File, Frmt, Args), + ok = file:close(File). + +verify_args([], _Ys) -> + ok; +verify_args(Xs, []) -> + exit({args_not_found_in_order, Xs}); +verify_args([X|Xs], [X|Ys]) -> + verify_args(Xs, Ys); +verify_args(Xs, [_Y|Ys]) -> + verify_args(Xs, Ys). + +verify_not_args(Xs, Ys) -> + lists:foreach(fun (X) -> + case lists:member(X, Ys) of + true -> exit({arg_present, X}); + false -> ok + end + end, + Xs). + +emu_args(CmdLineArgs) -> + io:format("CmdLineArgs = ~s~n", [CmdLineArgs]), + {ok,[[Erl]]} = init:get_argument(progname), + EmuCL = os:cmd(Erl ++ " -emu_args_exit " ++ CmdLineArgs), + io:format("EmuCL = ~s", [EmuCL]), + split_emu_clt(string:tokens(EmuCL, [$ ,$\t,$\n,$\r])). + +split_emu_clt(EmuCLT) -> + split_emu_clt(EmuCLT, [], [], [], emu). + +split_emu_clt([], _Emu, _Misc, _Extra, emu) -> + exit(bad_cmd_line); +split_emu_clt([], Emu, Misc, Extra, _Type) -> + {lists:reverse(Emu), lists:reverse(Misc), lists:reverse(Extra)}; + +split_emu_clt(["--"|As], Emu, Misc, Extra, emu) -> + split_emu_clt(As, Emu, Misc, Extra, misc); +split_emu_clt([A|As], Emu, Misc, Extra, emu = Type) -> + split_emu_clt(As, [A|Emu], Misc, Extra, Type); + +split_emu_clt(["-extra"|As], Emu, Misc, Extra, misc) -> + split_emu_clt(As, Emu, Misc, Extra, extra); +split_emu_clt([A|As], Emu, Misc, Extra, misc = Type) -> + split_emu_clt(As, Emu, [A|Misc], Extra, Type); + +split_emu_clt([A|As], Emu, Misc, Extra, extra = Type) -> + split_emu_clt(As, Emu, Misc, [A|Extra], Type). + + +get_nodename(T) -> + {A, B, C} = now(), + atom_to_list(T) + ++ "-" + ++ atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C). diff --git a/erts/test/erlexec_SUITE_data/Makefile.src b/erts/test/erlexec_SUITE_data/Makefile.src new file mode 100644 index 0000000000..b751547b8f --- /dev/null +++ b/erts/test/erlexec_SUITE_data/Makefile.src @@ -0,0 +1,37 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2008-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +CC = @CC@ +CFLAGS = @ERTS_CFLAGS@ +LIBS = @ERTS_LIBS@ + +ERLX_T_CFLAGS = -Wall $(ERLX_DEFS) $(CFLAGS) @DEFS@ + +GCC = .@DS@gccifier -CC"$(CC)" + +PROGS = erlexec_tests@exe@ + +all: $(PROGS) + +gccifier@exe@: ..@DS@utils@DS@gccifier.c + $(CC) $(CFLAGS) -o gccifier@exe@ ..@DS@utils@DS@gccifier.c $(LIBS) + +erlexec_tests@exe@: gccifier@exe@ erlexec_tests.c + $(GCC) $(ERLX_T_CFLAGS) -o erlexec_tests@exe@ erlexec_tests.c + diff --git a/erts/test/erlexec_SUITE_data/erlexec_tests.c b/erts/test/erlexec_SUITE_data/erlexec_tests.c new file mode 100644 index 0000000000..a49a0b21a8 --- /dev/null +++ b/erts/test/erlexec_SUITE_data/erlexec_tests.c @@ -0,0 +1,110 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2008-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* Used by test case otp_7461 to spawn a child process with a given + * command line. Child process group is killed by order received on stdin. + * + * Author: Sverker Eriksson + */ + +#if defined (__WIN32__) || defined(VXWORKS) || defined(_OSE_) +int main() {return 0;} + +#else /* UNIX only */ + +#include +#include +#include +#include +#include +#include +#include + +#define TRY(cmd) if ((cmd) < 0) bail_out(#cmd " failed") + +static void bail_out(const char* msg) +{ + perror(msg); + exit(-1); +} + +static void alarm_handler(int signo) +{ + fprintf(stderr, __FILE__" self terminating after timeout\n"); + exit(1); +} + +int main(int argc, char* argv[]) +{ + pid_t child; + int ret; + char cmd; + int child_exit; + + if (argc < 2) { + fprintf(stderr, "Must specify command to run in background\n"); + exit(-1); + } + TRY(child=fork()); + + if (child == 0) { /* child */ + pid_t gchild; + TRY(setpgid(getpid(), getpid())); /* create process group */ + + TRY(gchild=fork()); + if (gchild == 0) { /* grandchild */ + TRY(execvp(argv[1],&argv[1])); + } + exit(0); + } + /* parent */ + + signal(SIGALRM, alarm_handler); + alarm(10*60); /* suicide in case nothing happens */ + + TRY(wait(&child_exit)); + if (!WIFEXITED(child_exit) || WEXITSTATUS(child_exit)!=0) { + fprintf(stderr, "child did not exit normally (status=%d)\n", child_exit); + exit(-1); + } + + for (;;) + { + TRY(ret=read(STDIN_FILENO, &cmd, 1)); + if (ret == 0) break; /* eof -> exit */ + switch (cmd) + { + case 'K': + ret = kill(-child, SIGINT); /* child process _group_ */ + if (ret < 0 && errno != ESRCH) { + bail_out("kill failed"); + } + write(STDOUT_FILENO, &cmd, 1); /* echo ack */ + break; + case '\n': + break;/* ignore (for interactive testing) */ + default: + fprintf(stderr, "Unknown command '%c'\n", cmd); + exit(-1); + } + } + + return 0; +} + +#endif /* UNIX */ diff --git a/erts/test/ethread_SUITE.erl b/erts/test/ethread_SUITE.erl new file mode 100644 index 0000000000..a8f4f5e90c --- /dev/null +++ b/erts/test/ethread_SUITE.erl @@ -0,0 +1,365 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : ethread_SUITE.erl +%%% Author : Rickard Green +%%% Description : +%%% +%%% Created : 17 Jun 2004 by Rickard Green +%%%------------------------------------------------------------------- +-module(ethread_SUITE). +-author('rickard.s.green@ericsson.com'). + +%-define(line_trace, 1). + +-define(DEFAULT_TIMEOUT, ?t:minutes(10)). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([create_join_thread/1, + equal_tids/1, + mutex/1, + try_lock_mutex/1, + recursive_mutex/1, + time_now/1, + cond_wait/1, + cond_timedwait/1, + broadcast/1, + detached_thread/1, + max_threads/1, + forksafety/1, + vfork/1, + tsd/1, + spinlock/1, + rwspinlock/1, + rwmutex/1, + atomic/1, + gate/1]). + +-include("test_server.hrl"). + +tests() -> + [create_join_thread, + equal_tids, + mutex, + try_lock_mutex, + recursive_mutex, + time_now, + cond_wait, + cond_timedwait, + broadcast, + detached_thread, + max_threads, + forksafety, + vfork, + tsd, + spinlock, + rwspinlock, + rwmutex, + atomic, + gate]. + +all(doc) -> []; +all(suite) -> tests(). + + +%% +%% +%% The test-cases +%% +%% + +create_join_thread(doc) -> + ["Tests ethr_thr_create and ethr_thr_join."]; +create_join_thread(suite) -> + []; +create_join_thread(Config) -> + run_case(Config, "create_join_thread", ""). + +equal_tids(doc) -> + ["Tests ethr_equal_tids."]; +equal_tids(suite) -> + []; +equal_tids(Config) -> + run_case(Config, "equal_tids", ""). + +mutex(doc) -> + ["Tests mutexes."]; +mutex(suite) -> + []; +mutex(Config) -> + run_case(Config, "mutex", ""). + +try_lock_mutex(doc) -> + ["Tests try lock on mutex."]; +try_lock_mutex(suite) -> + []; +try_lock_mutex(Config) -> + run_case(Config, "try_lock_mutex", ""). + +recursive_mutex(doc) -> + ["Tests recursive mutexes."]; +recursive_mutex(suite) -> + []; +recursive_mutex(Config) -> + run_case(Config, "recursive_mutex", ""). + +time_now(doc) -> + ["Tests ethr_time_now by comparing time values with Erlang."]; +time_now(suite) -> + []; +time_now(Config) -> + run_case(Config, "time_now", "", fun (P) -> + spawn_link(fun () -> + watchdog(P) + end) + end). + +wd_dispatch(P) -> + receive + bye -> + ?line true = port_command(P, "-1 "), + ?line bye; + L when is_list(L) -> + ?line true = port_command(P, L), + ?line wd_dispatch(P) + end. + +watchdog(Port) -> + ?line process_flag(priority, max), + ?line receive after 500 -> ok end, + + ?line random:seed(), + ?line true = port_command(Port, "0 "), + ?line lists:foreach(fun (T) -> + erlang:send_after(T, + self(), + integer_to_list(T) + ++ " ") + end, + lists:usort(lists:map(fun (_) -> + random:uniform(4500)+500 + end, + lists:duplicate(50,0)))), + ?line erlang:send_after(5100, self(), bye), + + wd_dispatch(Port). + +cond_wait(doc) -> + ["Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast."]; +cond_wait(suite) -> + []; +cond_wait(Config) -> + run_case(Config, "cond_wait", ""). + +cond_timedwait(doc) -> + ["Tests ethr_cond_timedwait with ethr_cond_signal and ethr_cond_broadcast."]; +cond_timedwait(suite) -> + []; +cond_timedwait(Config) -> + run_case(Config, "cond_timedwait", ""). + +broadcast(doc) -> + ["Tests that a ethr_cond_broadcast really wakes up all waiting threads"]; +broadcast(suite) -> + []; +broadcast(Config) -> + run_case(Config, "broadcast", ""). + +detached_thread(doc) -> + ["Tests detached threads."]; +detached_thread(suite) -> + []; +detached_thread(Config) -> + run_case(Config, "detached_thread", ""). + +max_threads(doc) -> + ["Tests maximum number of threads."]; +max_threads(suite) -> + []; +max_threads(Config) -> + run_case(Config, "max_threads", ""). + +forksafety(doc) -> + ["Tests forksafety."]; +forksafety(suite) -> + []; +forksafety(Config) -> + run_case(Config, "forksafety", ""). + +vfork(doc) -> + ["Tests vfork with threads."]; +vfork(suite) -> + case ?t:os_type() of + {unix, osf1} -> + {skip, "vfork() known to hang multi-threaded applications on osf1"}; + _ -> + [] + end; +vfork(Config) -> + run_case(Config, "vfork", ""). + +tsd(doc) -> + ["Tests thread specific data."]; +tsd(suite) -> + []; +tsd(Config) -> + run_case(Config, "tsd", ""). + +spinlock(doc) -> + ["Tests spinlocks."]; +spinlock(suite) -> + []; +spinlock(Config) -> + run_case(Config, "spinlock", ""). + +rwspinlock(doc) -> + ["Tests rwspinlocks."]; +rwspinlock(suite) -> + []; +rwspinlock(Config) -> + run_case(Config, "rwspinlock", ""). + +rwmutex(doc) -> + ["Tests rwmutexes."]; +rwmutex(suite) -> + []; +rwmutex(Config) -> + run_case(Config, "rwmutex", ""). + +atomic(doc) -> + ["Tests atomics."]; +atomic(suite) -> + []; +atomic(Config) -> + run_case(Config, "atomic", ""). + +gate(doc) -> + ["Tests gates."]; +gate(suite) -> + []; +gate(Config) -> + run_case(Config, "gate", ""). + +%% +%% +%% Auxiliary functions +%% +%% + +init_per_testcase(_Case, Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +-define(TESTPROG, "ethread_tests"). +-define(FAILED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$F,$A,$I,$L,$U,$R,$E). +-define(SKIPPED_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$K,$I,$P). +-define(SUCCESS_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$S,$U,$C,$C,$E,$S,$S). +-define(PID_MARKER, $E,$T,$H,$R,$-,$T,$E,$S,$T,$-,$P,$I,$D). + +port_prog_killer(EProc, OSProc) when is_pid(EProc), is_list(OSProc) -> + ?line process_flag(trap_exit, true), + ?line Ref = erlang:monitor(process, EProc), + ?line receive + {'DOWN', Ref, _, _, Reason} when is_tuple(Reason), + element(1, Reason) + == timetrap_timeout -> + ?line Cmd = "kill -9 " ++ OSProc, + ?line ?t:format("Test case timed out. " + "Trying to kill port program.~n" + " Executing: ~p~n", [Cmd]), + ?line case os:cmd(Cmd) of + [] -> + ok; + OsCmdRes -> + ?line ?t:format(" ~s", [OsCmdRes]) + end; + {'DOWN', Ref, _, _, _} -> + %% OSProc is assumed to have terminated by itself + ?line ok + end. + +get_line(_Port, eol, Data) -> + ?line Data; +get_line(Port, noeol, Data) -> + ?line receive + {Port, {data, {Flag, NextData}}} -> + ?line get_line(Port, Flag, Data ++ NextData); + {Port, eof} -> + ?line ?t:fail(port_prog_unexpectedly_closed) + end. + +read_case_data(Port, TestCase) -> + ?line receive + {Port, {data, {eol, [?SUCCESS_MARKER]}}} -> + ?line ok; + {Port, {data, {Flag, [?SUCCESS_MARKER | CommentStart]}}} -> + ?line {comment, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?SKIPPED_MARKER | CommentStart]}}} -> + ?line {skipped, get_line(Port, Flag, CommentStart)}; + {Port, {data, {Flag, [?FAILED_MARKER | ReasonStart]}}} -> + ?line ?t:fail(get_line(Port, Flag, ReasonStart)); + {Port, {data, {eol, [?PID_MARKER | PidStr]}}} -> + ?line ?t:format("Port program pid: ~s~n", [PidStr]), + ?line CaseProc = self(), + ?line list_to_integer(PidStr), % Sanity check + spawn_opt(fun () -> + port_prog_killer(CaseProc, PidStr) + end, + [{priority, max}, link]), + read_case_data(Port, TestCase); + {Port, {data, {Flag, LineStart}}} -> + ?line ?t:format("~s~n", [get_line(Port, Flag, LineStart)]), + read_case_data(Port, TestCase); + {Port, eof} -> + ?line ?t:fail(port_prog_unexpectedly_closed) + end. + +run_case(Config, Test, TestArgs) -> + run_case(Config, Test, TestArgs, fun (_Port) -> ok end). + +run_case(Config, Test, TestArgs, Fun) -> + TestProg = filename:join([?config(data_dir, Config), ?TESTPROG]), + Cmd = TestProg ++ " " ++ Test ++ " " ++ TestArgs, + case catch open_port({spawn, Cmd}, [stream, + use_stdio, + stderr_to_stdout, + eof, + {line, 1024}]) of + Port when is_port(Port) -> + ?line Fun(Port), + ?line CaseResult = read_case_data(Port, Test), + ?line receive + {Port, eof} -> + ?line ok + end, + ?line CaseResult; + Error -> + ?line ?t:fail({open_port_failed, Error}) + end. + + + + diff --git a/erts/test/ethread_SUITE_data/Makefile.src b/erts/test/ethread_SUITE_data/Makefile.src new file mode 100644 index 0000000000..132b23344c --- /dev/null +++ b/erts/test/ethread_SUITE_data/Makefile.src @@ -0,0 +1,41 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2004-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +include @erts_lib_include_internal_generated@@DS@ethread.mk +include @erts_lib_include_internal_generated@@DS@erts_internal.mk + +CC = @CC@ +CFLAGS = @ERTS_CFLAGS@ +LIBS = @ERTS_LIBS@ + +ETHR_T_CFLAGS = -Wall $(ETHR_DEFS) $(CFLAGS) @DEFS@ -I@erts_lib_include_internal@ -I@erts_lib_include_internal_generated@ +ETHR_T_LIBS = $(LIBS) -L@erts_lib_internal_path@ $(ETHR_LIBS) $(ERTS_INTERNAL_X_LIBS) + +GCC = .@DS@gccifier -CC"$(CC)" + +PROGS = ethread_tests@exe@ + +all: $(PROGS) + +gccifier@exe@: ..@DS@utils@DS@gccifier.c + $(CC) $(CFLAGS) -o gccifier@exe@ ..@DS@utils@DS@gccifier.c $(LIBS) + +ethread_tests@exe@: gccifier@exe@ ethread_tests.c + $(GCC) $(ETHR_T_CFLAGS) -o ethread_tests@exe@ ethread_tests.c -lerts_internal_r $(ETHR_T_LIBS) + diff --git a/erts/test/ethread_SUITE_data/ethread_tests.c b/erts/test/ethread_SUITE_data/ethread_tests.c new file mode 100644 index 0000000000..f779f13c51 --- /dev/null +++ b/erts/test/ethread_SUITE_data/ethread_tests.c @@ -0,0 +1,2403 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ + +/* + * Description: Test suite for the ethread thread library. + * Author: Rickard Green + */ + +#define ETHR_NO_SUPP_THR_LIB_NOT_FATAL +#include "ethread.h" +#include "erl_misc_utils.h" + +#include +#include +#include +#ifndef __WIN32__ +#include +#endif +#include + +/* + * Auxiliary functions + */ + +#define PRINT_VA_LIST(FRMT) \ +do { \ + if (FRMT && FRMT != '\0') { \ + va_list args; \ + va_start(args, FRMT); \ + vfprintf(stderr, FRMT, args); \ + va_end(args); \ + } \ +} while (0) + +#define ASSERT(B) \ +do { \ + if (!(B)) \ + fail("%s:%d: Assertion \"%s\" failed!",__FILE__,__LINE__,#B); \ +} while (0) + + +#define ASSERT_PRINT(B, PRNT) \ +do { \ + if (!(B)) { \ + print PRNT; \ + fail("%s:%d: Assertion \"%s\" failed!",__FILE__,__LINE__,#B); \ + } \ +} while (0) + +#define ASSERT_EQ(VAR, VAL, FSTR) \ +do { \ + if ((VAR) != (VAL)) { \ + print("%s=" FSTR "\n", #VAR, (VAR)); \ + fail("%s:%d: Assertion \"%s == " FSTR "\" failed!", \ + __FILE__, __LINE__, #VAR, (VAL)); \ + } \ +} while (0) + +#ifdef __WIN32_ +#define EOL "\r\n" +#else +#define EOL "\n" +#endif + +static void +print_eol(void) +{ + fprintf(stderr, EOL); +} + +static void print_line(char *frmt,...) +{ + PRINT_VA_LIST(frmt); + print_eol(); +} + +static void print(char *frmt,...) +{ + PRINT_VA_LIST(frmt); +} + +static void fail(char *frmt,...) +{ + char *abrt_env; + print_eol(); + fprintf(stderr, "ETHR-TEST-FAILURE"); + PRINT_VA_LIST(frmt); + print_eol(); + abrt_env = getenv("ERL_ABORT_ON_FAILURE"); + if (abrt_env && strcmp("true", abrt_env) == 0) + abort(); + else + exit(1); +} + +static void skip(char *frmt,...) +{ + print_eol(); + fprintf(stderr, "ETHR-TEST-SKIP"); + PRINT_VA_LIST(frmt); + print_eol(); + exit(0); +} + +static void succeed(char *frmt,...) +{ + print_eol(); + fprintf(stderr, "ETHR-TEST-SUCCESS"); + PRINT_VA_LIST(frmt); + print_eol(); + exit(0); +} + +static void +do_sleep(unsigned secs) +{ + while (erts_milli_sleep(secs*1000) != 0); +} + +#define WAIT_UNTIL_INTERVAL 10 + +#define WAIT_UNTIL_LIM(TEST, LIM) \ +do { \ + int ms__ = (LIM)*1000; \ + while (!(TEST)) { \ + while (erts_milli_sleep(WAIT_UNTIL_INTERVAL) != 0); \ + ms__ -= WAIT_UNTIL_INTERVAL; \ + if (ms__ <= 0) \ + break; \ + } \ +} while (0) + +static void +send_my_pid(void) +{ +#ifndef __WIN32__ + int pid = (int) getpid(); + fprintf(stderr, EOL "ETHR-TEST-PID%d" EOL, pid); +#endif +} + +/* + * The test-cases + */ + +#ifndef ETHR_NO_THREAD_LIB + +/* + * The create join thread test case. + * + * Tests ethr_thr_create and ethr_thr_join. + */ + +#define CJTT_NO_THREADS 64 +ethr_tid cjtt_tids[CJTT_NO_THREADS + 1]; +int cjtt_ix[CJTT_NO_THREADS + 1]; +int cjtt_res[CJTT_NO_THREADS + 1]; +void *cjtt_thread(void *vpix) +{ + int ix = *((int *) vpix); + cjtt_res[ix] = ix; + return (void *) &cjtt_res[ix]; +} + +static void +create_join_thread_test(void) +{ + int i, res; + + for (i = 1; i <= CJTT_NO_THREADS; i++) { + cjtt_ix[i] = i; + cjtt_res[i] = 0; + } + + for (i = 1; i <= CJTT_NO_THREADS; i++) { + res = ethr_thr_create(&cjtt_tids[i], + cjtt_thread, + (void *) &cjtt_ix[i], + NULL); + ASSERT(res == 0); + } + + for (i = 1; i <= CJTT_NO_THREADS; i++) { + int *tres; + res = ethr_thr_join(cjtt_tids[i], (void **) &tres); + ASSERT(res == 0); + ASSERT(tres == &cjtt_res[i]); + ASSERT(cjtt_res[i] == i); + } + +} + + +/* + * The eq tid test case. + * + * Tests ethr_equal_tids. + */ + +#define ETT_THREADS 100000 + +static ethr_tid ett_tids[3]; +static ethr_mutex ett_mutex = ETHR_MUTEX_INITER; +static ethr_cond ett_cond = ETHR_COND_INITER; +static int ett_terminate; + +static void * +ett_thread(void *my_tid) +{ + + ASSERT(!ethr_equal_tids(ethr_self(), ett_tids[0])); + ASSERT(ethr_equal_tids(ethr_self(), *((ethr_tid *) my_tid))); + + return NULL; +} + +static void * +ett_thread2(void *unused) +{ + int res; + res = ethr_mutex_lock(&ett_mutex); + ASSERT(res == 0); + while (!ett_terminate) { + res = ethr_cond_wait(&ett_cond, &ett_mutex); + ASSERT(res == 0); + } + res = ethr_mutex_unlock(&ett_mutex); + ASSERT(res == 0); + return NULL; +} + +static void +equal_tids_test(void) +{ + int res, i; + + ett_tids[0] = ethr_self(); + + res = ethr_thr_create(&ett_tids[1], ett_thread, (void *) &ett_tids[1], NULL); + ASSERT(res == 0); + + ASSERT(ethr_equal_tids(ethr_self(), ett_tids[0])); + ASSERT(!ethr_equal_tids(ethr_self(), ett_tids[1])); + + res = ethr_thr_join(ett_tids[1], NULL); + + res = ethr_thr_create(&ett_tids[2], ett_thread, (void *) &ett_tids[2], NULL); + ASSERT(res == 0); + + ASSERT(ethr_equal_tids(ethr_self(), ett_tids[0])); + ASSERT(!ethr_equal_tids(ethr_self(), ett_tids[1])); + ASSERT(!ethr_equal_tids(ethr_self(), ett_tids[2])); + +#if 0 + /* This fails on some linux platforms. Until we decides if a tid + * is allowed to be reused right away or not, we disable the test. + */ + + ASSERT(!ethr_equal_tids(ett_tids[1], ett_tids[2])); +#endif + + res = ethr_thr_join(ett_tids[2], NULL); + ASSERT(res == 0); + + /* Second part of test */ + + ett_terminate = 0; + + res = ethr_thr_create(&ett_tids[1], ett_thread2, NULL, NULL); + ASSERT(res == 0); + + ASSERT(!ethr_equal_tids(ett_tids[0], ett_tids[1])); + + for (i = 0; i < ETT_THREADS; i++) { + res = ethr_thr_create(&ett_tids[2], ett_thread, (void*)&ett_tids[2], NULL); + ASSERT(res == 0); + + ASSERT(!ethr_equal_tids(ett_tids[0], ett_tids[2])); + ASSERT(!ethr_equal_tids(ett_tids[1], ett_tids[2])); + + res = ethr_thr_join(ett_tids[2], NULL); + ASSERT(res == 0); + } + + res = ethr_mutex_lock(&ett_mutex); + ASSERT(res == 0); + ett_terminate = 1; + res = ethr_cond_signal(&ett_cond); + ASSERT(res == 0); + res = ethr_mutex_unlock(&ett_mutex); + ASSERT(res == 0); + res = ethr_thr_join(ett_tids[1], NULL); + ASSERT(res == 0); + + res = ethr_cond_destroy(&ett_cond); + ASSERT(res == 0); + res = ethr_mutex_destroy(&ett_mutex); + ASSERT(res == 0); + +} + +/* + * The mutex test case. + * + * Tests mutexes. + */ + +static ethr_mutex mt_mutex = ETHR_MUTEX_INITER; +static int mt_data; + +void * +mt_thread(void *unused) +{ + int res; + + print_line("Aux thread tries to lock mutex"); + res = ethr_mutex_lock(&mt_mutex); + ASSERT(res == 0); + print_line("Aux thread locked mutex"); + + ASSERT(mt_data == 0); + + mt_data = 1; + print_line("Aux thread wrote"); + + print_line("Aux thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Aux thread woke up"); + + ASSERT(mt_data == 1); + + res = ethr_mutex_unlock(&mt_mutex); + ASSERT(res == 0); + print_line("Aux thread unlocked mutex"); + + return NULL; +} + + +static void +mutex_test(void) +{ + int do_restart = 1; + int res; + ethr_tid tid; + + print_line("Running test with statically initialized mutex"); + + restart: + mt_data = 0; + + print_line("Main thread tries to lock mutex"); + res = ethr_mutex_lock(&mt_mutex); + ASSERT(res == 0); + print_line("Main thread locked mutex"); + + ASSERT(mt_data == 0); + + print_line("Main thread about to create aux thread"); + res = ethr_thr_create(&tid, mt_thread, NULL, NULL); + ASSERT(res == 0); + print_line("Main thread created aux thread"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(mt_data == 0); + + res = ethr_mutex_unlock(&mt_mutex); + ASSERT(res == 0); + print_line("Main thread unlocked mutex"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + print_line("Main thread tries to lock mutex"); + res = ethr_mutex_lock(&mt_mutex); + ASSERT(res == 0); + print_line("Main thread locked mutex"); + + ASSERT(mt_data == 1); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(mt_data == 1); + + res = ethr_mutex_unlock(&mt_mutex); + ASSERT(res == 0); + print_line("Main thread unlocked mutex"); + + res = ethr_thr_join(tid, NULL); + ASSERT(res == 0); + print_line("Main thread joined aux thread"); + + res = ethr_mutex_destroy(&mt_mutex); + ASSERT(res == 0); + print_line("Main thread destroyed mutex"); + + if (do_restart) { + do_restart = 0; + + print_line("Running test with dynamically initialized mutex"); + + print_line("Trying to initialize mutex"); + res = ethr_mutex_init(&mt_mutex); + ASSERT(res == 0); + print_line("Initialized mutex"); + + goto restart; + + } + +} + +/* + * The try lock mutex test case. + * + * Tests try lock mutex operation. + */ + +static ethr_mutex tlmt_mtx1 = ETHR_MUTEX_INITER; +static ethr_mutex tlmt_mtx2 = ETHR_MUTEX_INITER; +static ethr_cond tlmt_cnd2 = ETHR_COND_INITER; + +static int tlmt_mtx1_locked; +static int tlmt_mtx1_do_unlock; + +static void * +tlmt_thread(void *unused) +{ + int res; + + res = ethr_mutex_lock(&tlmt_mtx1); + ASSERT(res == 0); + res = ethr_mutex_lock(&tlmt_mtx2); + ASSERT(res == 0); + + tlmt_mtx1_locked = 1; + res = ethr_cond_signal(&tlmt_cnd2); + ASSERT(res == 0); + + while (!tlmt_mtx1_do_unlock) { + res = ethr_cond_wait(&tlmt_cnd2, &tlmt_mtx2); + ASSERT(res == 0 || res == EINTR); + } + + res = ethr_mutex_unlock(&tlmt_mtx2); + ASSERT(res == 0); + res = ethr_mutex_unlock(&tlmt_mtx1); + ASSERT(res == 0); + + res = ethr_mutex_lock(&tlmt_mtx2); + ASSERT(res == 0); + tlmt_mtx1_locked = 0; + res = ethr_cond_signal(&tlmt_cnd2); + ASSERT(res == 0); + res = ethr_mutex_unlock(&tlmt_mtx2); + ASSERT(res == 0); + + return NULL; +} + +static void +try_lock_mutex_test(void) +{ + int i, res; + ethr_tid tid; + + tlmt_mtx1_locked = 0; + tlmt_mtx1_do_unlock = 0; + + res = ethr_thr_create(&tid, tlmt_thread, NULL, NULL); + ASSERT(res == 0); + + res = ethr_mutex_lock(&tlmt_mtx2); + ASSERT(res == 0); + + while (!tlmt_mtx1_locked) { + res = ethr_cond_wait(&tlmt_cnd2, &tlmt_mtx2); + ASSERT(res == 0 || res == EINTR); + } + + res = ethr_mutex_unlock(&tlmt_mtx2); + ASSERT(res == 0); + + for (i = 0; i < 10; i++) { + res = ethr_mutex_trylock(&tlmt_mtx1); + ASSERT(res == EBUSY); + } + + res = ethr_mutex_lock(&tlmt_mtx2); + ASSERT(res == 0); + + tlmt_mtx1_do_unlock = 1; + res = ethr_cond_signal(&tlmt_cnd2); + ASSERT(res == 0); + + while (tlmt_mtx1_locked) { + res = ethr_cond_wait(&tlmt_cnd2, &tlmt_mtx2); + ASSERT(res == 0 || res == EINTR); + } + + res = ethr_mutex_unlock(&tlmt_mtx2); + ASSERT(res == 0); + + res = ethr_mutex_trylock(&tlmt_mtx1); + ASSERT(res == 0); + + res = ethr_mutex_unlock(&tlmt_mtx1); + ASSERT(res == 0); + + res = ethr_thr_join(tid, NULL); + ASSERT(res == 0); + + res = ethr_mutex_destroy(&tlmt_mtx1); + ASSERT(res == 0); + res = ethr_mutex_destroy(&tlmt_mtx2); + ASSERT(res == 0); + res = ethr_cond_destroy(&tlmt_cnd2); + ASSERT(res == 0); +} + +/* + * The recursive mutex test case. + * + * Tests recursive mutexes. + */ + +#ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT + +static ethr_mutex rmt_mutex +#ifdef ETHR_REC_MUTEX_INITER + = ETHR_REC_MUTEX_INITER +#endif + ; +static int rmt_data; + +void * +rmt_thread(void *unused) +{ + int res; + + print_line("Aux thread tries to lock mutex"); + res = ethr_mutex_lock(&rmt_mutex); + ASSERT(res == 0); + print_line("Aux thread locked mutex"); + + ASSERT(rmt_data == 0); + + rmt_data = 1; + print_line("Aux thread wrote"); + + print_line("Aux thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Aux thread woke up"); + + ASSERT(rmt_data == 1); + + res = ethr_mutex_unlock(&rmt_mutex); + ASSERT(res == 0); + print_line("Aux thread unlocked mutex"); + + return NULL; +} + +#endif + +static void +recursive_mutex_test(void) +{ +#ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT + int do_restart = 1; + int res; + ethr_tid tid; + +#ifdef ETHR_REC_MUTEX_INITER + print_line("Running test with statically initialized mutex"); +#else + goto dynamic_init; +#endif + + restart: + rmt_data = 0; + + print_line("Main thread tries to lock mutex"); + res = ethr_mutex_lock(&rmt_mutex); + ASSERT(res == 0); + print_line("Main thread locked mutex"); + + print_line("Main thread tries to lock mutex again"); + res = ethr_mutex_lock(&rmt_mutex); + ASSERT(res == 0); + print_line("Main thread locked mutex again"); + + ASSERT(rmt_data == 0); + + print_line("Main thread about to create aux thread"); + res = ethr_thr_create(&tid, rmt_thread, NULL, NULL); + ASSERT(res == 0); + print_line("Main thread created aux thread"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(rmt_data == 0); + + res = ethr_mutex_unlock(&rmt_mutex); + ASSERT(res == 0); + print_line("Main thread unlocked mutex"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(rmt_data == 0); + + res = ethr_mutex_unlock(&rmt_mutex); + ASSERT(res == 0); + print_line("Main thread unlocked mutex again"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + print_line("Main thread tries to lock mutex"); + res = ethr_mutex_lock(&rmt_mutex); + ASSERT(res == 0); + print_line("Main thread locked mutex"); + + ASSERT(rmt_data == 1); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(rmt_data == 1); + + res = ethr_mutex_unlock(&rmt_mutex); + ASSERT(res == 0); + print_line("Main thread unlocked mutex"); + + res = ethr_thr_join(tid, NULL); + ASSERT(res == 0); + print_line("Main thread joined aux thread"); + + res = ethr_mutex_destroy(&rmt_mutex); + ASSERT(res == 0); + print_line("Main thread destroyed mutex"); + + if (do_restart) { +#ifndef ETHR_REC_MUTEX_INITER + dynamic_init: +#endif + do_restart = 0; + + print_line("Running test with dynamically initialized mutex"); + + print_line("Trying to initialize mutex"); + res = ethr_rec_mutex_init(&rmt_mutex); + ASSERT(res == 0); + print_line("Initialized mutex"); + + goto restart; + } + +#ifndef ETHR_REC_MUTEX_INITER + succeed("Static initializer for recursive mutexes not supported"); +#endif + +#else /* #ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT */ + skip("Recursive mutexes not supported"); +#endif /* #ifdef ETHR_HAVE_ETHR_REC_MUTEX_INIT */ +} + +/* + * The time now test. + * + * Tests ethr_time_now by comparing time values with Erlang. + */ +#define TNT_MAX_TIME_DIFF 200000 +#define TNT_MAX_TIME_VALUES 52 + +static void +time_now_test(void) +{ + int scanf_res, time_now_res, i, no_values, max_abs_diff; + static ethr_timeval tv[TNT_MAX_TIME_VALUES]; + static int ms[TNT_MAX_TIME_VALUES]; + + i = 0; + do { + ASSERT(i < TNT_MAX_TIME_VALUES); + scanf_res = scanf("%d", &ms[i]); + time_now_res = ethr_time_now(&tv[i]); + ASSERT(scanf_res == 1); + ASSERT(time_now_res == 0); +#if 0 + print_line("Got %d; %ld:%ld", ms[i], tv[i].tv_sec, tv[i].tv_nsec); +#endif + i++; + } while (ms[i-1] >= 0); + + no_values = i-1; + + ASSERT(ms[0] == 0); + + print_line("TNT_MAX_TIME_DIFF = %d (us)", TNT_MAX_TIME_DIFF); + + max_abs_diff = 0; + + for (i = 1; i < no_values; i++) { + long diff; + long tn_us; + long e_us; + + tn_us = (tv[i].tv_sec - tv[0].tv_sec) * 1000000; + tn_us += (tv[i].tv_nsec - tv[0].tv_nsec)/1000; + + e_us = ms[i]*1000; + + diff = e_us - tn_us; + + print_line("Erlang time = %ld us; ethr_time_now = %ld us; diff %ld us", + e_us, tn_us, diff); + + if (max_abs_diff < abs((int) diff)) { + max_abs_diff = abs((int) diff); + } + + ASSERT(e_us - TNT_MAX_TIME_DIFF <= tn_us); + ASSERT(tn_us <= e_us + TNT_MAX_TIME_DIFF); + } + + print_line("Max absolute diff = %d us", max_abs_diff); + succeed("Max absolute diff = %d us", max_abs_diff); +} + +/* + * The cond wait test case. + * + * Tests ethr_cond_wait with ethr_cond_signal and ethr_cond_broadcast. + */ + + +static ethr_mutex cwt_mutex = ETHR_MUTEX_INITER; +static ethr_cond cwt_cond = ETHR_COND_INITER; +static int cwt_counter; + +void * +cwt_thread(void *is_timedwait_test_ptr) +{ + int use_timedwait = *((int *) is_timedwait_test_ptr); + int res; + + res = ethr_mutex_lock(&cwt_mutex); + ASSERT(res == 0); + + if (use_timedwait) { + ethr_timeval tv; + res = ethr_time_now(&tv); + ASSERT(res == 0); + tv.tv_sec += 3600; /* Make sure we won't time out */ + + do { + res = ethr_cond_timedwait(&cwt_cond, &cwt_mutex, &tv); + } while (res == EINTR); + ASSERT(res == 0); + } + else { + do { + res = ethr_cond_wait(&cwt_cond, &cwt_mutex); + } while (res == EINTR); + ASSERT(res == 0); + } + + cwt_counter++; + + res = ethr_mutex_unlock(&cwt_mutex); + ASSERT(res == 0); + + return NULL; +} + +static void +cond_wait_test(int is_timedwait_test) +{ + int do_restart = !is_timedwait_test; + ethr_tid tid1, tid2; + int res; + + if (!is_timedwait_test) + print_line("Running test with statically initialized mutex and cond"); + + restart: + /* Wake with signal */ + + cwt_counter = 0; + + res = ethr_thr_create(&tid1, cwt_thread, (void *) &is_timedwait_test, NULL); + ASSERT(res == 0); + res = ethr_thr_create(&tid2, cwt_thread, (void *) &is_timedwait_test, NULL); + ASSERT(res == 0); + + do_sleep(1); /* Make sure threads waits on cond var */ + + res = ethr_mutex_lock(&cwt_mutex); + ASSERT(res == 0); + + res = ethr_cond_signal(&cwt_cond); /* Wake one thread */ + ASSERT(res == 0); + + do_sleep(1); /* Make sure awakened thread waits on mutex */ + + ASSERT(cwt_counter == 0); + + res = ethr_mutex_unlock(&cwt_mutex); + ASSERT(res == 0); + + do_sleep(1); /* Let awakened thread proceed */ + + res = ethr_mutex_lock(&cwt_mutex); + ASSERT(res == 0); + + ASSERT(cwt_counter == 1); + + res = ethr_cond_signal(&cwt_cond); /* Wake the other thread */ + ASSERT(res == 0); + + do_sleep(1); /* Make sure awakened thread waits on mutex */ + + ASSERT(cwt_counter == 1); + + res = ethr_mutex_unlock(&cwt_mutex); + ASSERT(res == 0); + + do_sleep(1); /* Let awakened thread proceed */ + + res = ethr_mutex_lock(&cwt_mutex); + ASSERT(res == 0); + + ASSERT(cwt_counter == 2); + + res = ethr_mutex_unlock(&cwt_mutex); + ASSERT(res == 0); + + res = ethr_thr_join(tid1, NULL); + ASSERT(res == 0); + + res = ethr_thr_join(tid2, NULL); + ASSERT(res == 0); + + + /* Wake with broadcast */ + + cwt_counter = 0; + + res = ethr_thr_create(&tid1, cwt_thread, (void *) &is_timedwait_test, NULL); + ASSERT(res == 0); + res = ethr_thr_create(&tid2, cwt_thread, (void *) &is_timedwait_test, NULL); + ASSERT(res == 0); + + do_sleep(1); /* Make sure threads waits on cond var */ + + res = ethr_mutex_lock(&cwt_mutex); + ASSERT(res == 0); + + res = ethr_cond_broadcast(&cwt_cond); /* Wake the threads */ + ASSERT(res == 0); + + do_sleep(1); /* Make sure awakened threads wait on mutex */ + + ASSERT(cwt_counter == 0); + + res = ethr_mutex_unlock(&cwt_mutex); + ASSERT(res == 0); + + do_sleep(1); /* Let awakened threads proceed */ + + res = ethr_mutex_lock(&cwt_mutex); + ASSERT(res == 0); + + ASSERT(cwt_counter == 2); + + res = ethr_mutex_unlock(&cwt_mutex); + ASSERT(res == 0); + + res = ethr_thr_join(tid1, NULL); + ASSERT(res == 0); + + res = ethr_thr_join(tid2, NULL); + ASSERT(res == 0); + + res = ethr_mutex_destroy(&cwt_mutex); + ASSERT(res == 0); + res = ethr_cond_destroy(&cwt_cond); + ASSERT(res == 0); + + if (do_restart) { + do_restart = 0; + res = ethr_mutex_init(&cwt_mutex); + ASSERT(res == 0); + res = ethr_cond_init(&cwt_cond); + ASSERT(res == 0); + print_line("Running test with dynamically initialized mutex and cond"); + goto restart; + } +} + +/* + * The cond timedwait test case. + * + * Tests ethr_cond_timedwait with ethr_cond_signal and ethr_cond_broadcast. + */ + +#define CTWT_MAX_TIME_DIFF 100000 + +static long +ctwt_check_timeout(long to) +{ + int res; + ethr_timeval tva, tvb; + long diff, abs_diff; + + res = ethr_time_now(&tva); + ASSERT(res == 0); + + tva.tv_sec += to / 1000; + tva.tv_nsec += (to % 1000) * 1000000; + if (tva.tv_nsec >= 1000000000) { + tva.tv_sec++; + tva.tv_nsec -= 1000000000; + ASSERT(tva.tv_nsec < 1000000000); + } + + do { + res = ethr_cond_timedwait(&cwt_cond, &cwt_mutex, &tva); + } while (res == EINTR); + ASSERT(res == ETIMEDOUT); + + res = ethr_time_now(&tvb); + ASSERT(res == 0); + + diff = (tvb.tv_sec - tva.tv_sec) * 1000000; + diff += (tvb.tv_nsec - tva.tv_nsec)/1000; + + print("Timeout=%ld; ", to); + print("tva.tv_sec=%ld tva.tv_nsec=%ld; ", tva.tv_sec, tva.tv_nsec); + print("tvb.tv_sec=%ld tvb.tv_nsec=%ld; ", tvb.tv_sec, tvb.tv_nsec); + print_line("diff (tvb - tva) = %ld us", diff); + + abs_diff = (long) abs((int) diff); + + ASSERT(CTWT_MAX_TIME_DIFF >= abs_diff); + return abs_diff; +} + +static void +cond_timedwait_test(void) +{ + int do_restart = 1; + long abs_diff, max_abs_diff = 0; + int res; + +#define CTWT_UPD_MAX_DIFF if (abs_diff > max_abs_diff) max_abs_diff = abs_diff; + + print_line("Running test with statically initialized mutex and cond"); + + print_line("CTWT_MAX_TIME_DIFF=%d", CTWT_MAX_TIME_DIFF); + + restart: + + res = ethr_mutex_lock(&cwt_mutex); + ASSERT(res == 0); + + abs_diff = ctwt_check_timeout(300); + CTWT_UPD_MAX_DIFF; + abs_diff = ctwt_check_timeout(700); + CTWT_UPD_MAX_DIFF; + abs_diff = ctwt_check_timeout(1000); + CTWT_UPD_MAX_DIFF; + abs_diff = ctwt_check_timeout(2300); + CTWT_UPD_MAX_DIFF; + abs_diff = ctwt_check_timeout(5100); + CTWT_UPD_MAX_DIFF; + + res = ethr_mutex_unlock(&cwt_mutex); + ASSERT(res == 0); + + cond_wait_test(1); + + if (do_restart) { + do_restart = 0; + res = ethr_mutex_init(&cwt_mutex); + ASSERT(res == 0); + res = ethr_cond_init(&cwt_cond); + ASSERT(res == 0); + print_line("Running test with dynamically initialized mutex and cond"); + goto restart; + } + + print_line("Max absolute diff = %d us", max_abs_diff); + succeed("Max absolute diff = %d us", max_abs_diff); + +#undef CTWT_UPD_MAX_DIFF +} + +/* + * The broadcast test case. + * + * Tests that a ethr_cond_broadcast really wakes up all waiting threads. + */ + +#define BCT_THREADS 64 +#define BCT_NO_OF_WAITS 100 + +static int bct_woken = 0; +static int bct_waiting = 0; +static int bct_done = 0; +static ethr_mutex bct_mutex = ETHR_MUTEX_INITER; +static ethr_cond bct_cond = ETHR_COND_INITER; +static ethr_cond bct_cntrl_cond = ETHR_COND_INITER; + + +static void * +bct_thread(void *unused) +{ + int res; + + res = ethr_mutex_lock(&bct_mutex); + ASSERT(res == 0); + + while (!bct_done) { + + bct_waiting++; + if (bct_waiting == BCT_THREADS) { + res = ethr_cond_signal(&bct_cntrl_cond); + ASSERT(res == 0); + } + do { + res = ethr_cond_wait(&bct_cond, &bct_mutex); + } while (res == EINTR); + ASSERT(res == 0); + bct_woken++; + if (bct_woken == BCT_THREADS) { + res = ethr_cond_signal(&bct_cntrl_cond); + ASSERT(res == 0); + } + + } + + res = ethr_mutex_unlock(&bct_mutex); + ASSERT(res == 0); + + return NULL; +} + +static void +broadcast_test(void) +{ + int res, i; + ethr_tid tid[BCT_THREADS]; + + for (i = 0; i < BCT_THREADS; i++) { + res = ethr_thr_create(&tid[i], bct_thread, NULL, NULL); + ASSERT(res == 0); + + } + + res = ethr_mutex_lock(&bct_mutex); + ASSERT(res == 0); + + for (i = 0; i < BCT_NO_OF_WAITS; i++) { + + while (bct_waiting != BCT_THREADS) { + res = ethr_cond_wait(&bct_cntrl_cond, &bct_mutex); + ASSERT(res == 0 || res == EINTR); + } + + bct_waiting = 0; + bct_woken = 0; + + /* Wake all threads */ + res = ethr_cond_broadcast(&bct_cond); + ASSERT(res == 0); + + while (bct_woken != BCT_THREADS) { + res = ethr_cond_wait(&bct_cntrl_cond, &bct_mutex); + ASSERT(res == 0 || res == EINTR); + } + + } + + bct_done = 1; + + /* Wake all threads */ + res = ethr_cond_broadcast(&bct_cond); + ASSERT(res == 0); + + res = ethr_mutex_unlock(&bct_mutex); + ASSERT(res == 0); + + for (i = 0; i < BCT_THREADS - 1; i++) { + res = ethr_thr_join(tid[i], NULL); + ASSERT(res == 0); + } + + res = ethr_mutex_destroy(&bct_mutex); + ASSERT(res == 0); + res = ethr_cond_destroy(&bct_cntrl_cond); + ASSERT(res == 0); + res = ethr_cond_destroy(&bct_cond); + ASSERT(res == 0); + +} + +/* + * The detached thread test case. + * + * Tests detached threads. + */ + +#define DT_THREADS (50*1024) +#define DT_BATCH_SIZE 64 + +static ethr_mutex dt_mutex = ETHR_MUTEX_INITER; +static ethr_cond dt_cond = ETHR_COND_INITER; +static int dt_count; +static int dt_limit; + +static void * +dt_thread(void *unused) +{ + int res; + + res = ethr_mutex_lock(&dt_mutex); + ASSERT(res == 0); + + dt_count++; + + if (dt_count >= dt_limit) + ethr_cond_signal(&dt_cond); + + res = ethr_mutex_unlock(&dt_mutex); + ASSERT(res == 0); + + return NULL; +} + +static void +detached_thread_test(void) +{ + ethr_thr_opts thr_opts = ETHR_THR_OPTS_DEFAULT_INITER; + ethr_tid tid[DT_BATCH_SIZE]; + int i, j, res; + + thr_opts.detached = 1; + dt_count = 0; + dt_limit = 0; + + for (i = 0; i < DT_THREADS/DT_BATCH_SIZE; i++) { + + dt_limit += DT_BATCH_SIZE; + + for (j = 0; j < DT_BATCH_SIZE; j++) { + res = ethr_thr_create(&tid[j], dt_thread, NULL, &thr_opts); + ASSERT(res == 0); + } + + res = ethr_mutex_lock(&dt_mutex); + ASSERT(res == 0); + while (dt_count < dt_limit) { + res = ethr_cond_wait(&dt_cond, &dt_mutex); + ASSERT(res == 0 || res == EINTR); + } + res = ethr_mutex_unlock(&dt_mutex); + ASSERT(res == 0); + + print_line("dt_count = %d", dt_count); + } + do_sleep(1); +} + + + +/* + * The max threads test case. + * + * Tests + */ +#define MTT_TIMES 10 + +static int mtt_terminate; +static ethr_mutex mtt_mutex = ETHR_MUTEX_INITER; +static ethr_cond mtt_cond = ETHR_COND_INITER; +static char mtt_string[22*MTT_TIMES]; /* 22 is enough for ", %d" */ + + +void *mtt_thread(void *unused) +{ + int res; + + res = ethr_mutex_lock(&mtt_mutex); + ASSERT(res == 0); + + while (!mtt_terminate) { + res = ethr_cond_wait(&mtt_cond, &mtt_mutex); + ASSERT(res == 0 || res == EINTR); + } + + res = ethr_mutex_unlock(&mtt_mutex); + ASSERT(res == 0); + + return NULL; +} + + +static int +mtt_create_join_threads(void) +{ + int no_tids = 100, ix = 0, res = 0, no_threads; + ethr_tid *tids; + + mtt_terminate = 0; + + tids = (ethr_tid *) malloc(sizeof(ethr_tid)*no_tids); + ASSERT(tids); + + print_line("Beginning to create threads"); + + while (1) { + if (ix >= no_tids) { + no_tids += 100; + tids = (ethr_tid *) realloc((void *)tids, sizeof(ethr_tid)*no_tids); + ASSERT(tids); + } + res = ethr_thr_create(&tids[ix], mtt_thread, NULL, NULL); + if (res != 0) + break; + ix++; + } while (res == 0); + + no_threads = ix; + + print_line("%d = ethr_thr_create()", res); + print_line("Number of created threads: %d", no_threads); + + res = ethr_mutex_lock(&mtt_mutex); + ASSERT(res == 0); + + mtt_terminate = 1; + + res = ethr_cond_broadcast(&mtt_cond); + ASSERT(res == 0); + + res = ethr_mutex_unlock(&mtt_mutex); + ASSERT(res == 0); + + while (ix) { + res = ethr_thr_join(tids[--ix], NULL); + ASSERT(res == 0); + } + + print_line("All created threads terminated"); + + free((void *) tids); + + return no_threads; + +} + +static void +max_threads_test(void) +{ + int no_threads[MTT_TIMES], i, up, down, eq; + char *str; + + for (i = 0; i < MTT_TIMES; i++) { + no_threads[i] = mtt_create_join_threads(); + } + + str = &mtt_string[0]; + eq = up = down = 0; + for (i = 0; i < MTT_TIMES; i++) { + if (i == 0) { + str += sprintf(str, "%d", no_threads[i]); + continue; + } + + str += sprintf(str, ", %d", no_threads[i]); + + if (no_threads[i] < no_threads[i-1]) + down++; + else if (no_threads[i] > no_threads[i-1]) + up++; + else + eq++; + } + + print_line("Max created threads: %s", mtt_string); + + /* We fail if the no of threads we are able to create constantly decrease */ + ASSERT(!down || up || eq); + + succeed("Max created threads: %s", mtt_string); + +} + + +/* + * The forksafety test case. + * + * Tests forksafety. + */ +#ifdef __WIN32__ +#define NO_FORK_PRESENT +#endif + +#ifndef NO_FORK_PRESENT + +static ethr_mutex ft_test_inner_mutex = ETHR_MUTEX_INITER; +static ethr_mutex ft_test_outer_mutex = ETHR_MUTEX_INITER; +static ethr_mutex ft_go_mutex = ETHR_MUTEX_INITER; +static ethr_cond ft_go_cond = ETHR_COND_INITER; +static int ft_go; +static int ft_have_forked; + +static void * +ft_thread(void *unused) +{ + int res; + + res = ethr_mutex_lock(&ft_test_outer_mutex); + ASSERT(res == 0); + + res = ethr_mutex_lock(&ft_go_mutex); + ASSERT(res == 0); + + ft_go = 1; + res = ethr_cond_signal(&ft_go_cond); + ASSERT(res == 0); + res = ethr_mutex_unlock(&ft_go_mutex); + ASSERT(res == 0); + + do_sleep(1); + ASSERT(!ft_have_forked); + + res = ethr_mutex_lock(&ft_test_inner_mutex); + ASSERT(res == 0); + + res = ethr_mutex_unlock(&ft_test_inner_mutex); + ASSERT(res == 0); + + do_sleep(1); + ASSERT(!ft_have_forked); + + res = ethr_mutex_unlock(&ft_test_outer_mutex); + ASSERT(res == 0); + + do_sleep(1); + ASSERT(ft_have_forked); + + + return NULL; +} + +#endif /* #ifndef NO_FORK_PRESENT */ + +static void +forksafety_test(void) +{ +#ifdef NO_FORK_PRESENT + skip("No fork() present; nothing to test"); +#elif defined(DEBUG) + skip("Doesn't work in debug build"); +#else + char snd_msg[] = "ok, bye!"; + char rec_msg[sizeof(snd_msg)*2]; + ethr_tid tid; + int res; + int fds[2]; + + + res = ethr_mutex_set_forksafe(&ft_test_inner_mutex); + if (res == ENOTSUP) { + skip("Forksafety not supported on this platform!"); + } + ASSERT(res == 0); + res = ethr_mutex_set_forksafe(&ft_test_outer_mutex); + ASSERT(res == 0); + + + res = pipe(fds); + ASSERT(res == 0); + + ft_go = 0; + ft_have_forked = 0; + + res = ethr_mutex_lock(&ft_go_mutex); + ASSERT(res == 0); + + res = ethr_thr_create(&tid, ft_thread, NULL, NULL); + ASSERT(res == 0); + + do { + res = ethr_cond_wait(&ft_go_cond, &ft_go_mutex); + } while (res == EINTR || !ft_go); + ASSERT(res == 0); + + res = ethr_mutex_unlock(&ft_go_mutex); + ASSERT(res == 0); + + res = fork(); + ft_have_forked = 1; + if (res == 0) { + close(fds[0]); + res = ethr_mutex_lock(&ft_test_outer_mutex); + if (res != 0) + _exit(1); + res = ethr_mutex_lock(&ft_test_inner_mutex); + if (res != 0) + _exit(1); + res = ethr_mutex_unlock(&ft_test_inner_mutex); + if (res != 0) + _exit(1); + res = ethr_mutex_unlock(&ft_test_outer_mutex); + if (res != 0) + _exit(1); + + res = ethr_mutex_destroy(&ft_test_inner_mutex); + if (res != 0) + _exit(1); + res = ethr_mutex_destroy(&ft_test_outer_mutex); + if (res != 0) + _exit(1); + + res = (int) write(fds[1], (void *) snd_msg, sizeof(snd_msg)); + if (res != sizeof(snd_msg)) + _exit(1); + close(fds[1]); + _exit(0); + } + ASSERT(res > 0); + close(fds[1]); + + res = (int) read(fds[0], (void *) rec_msg, sizeof(rec_msg)); + ASSERT(res == (int) sizeof(snd_msg)); + ASSERT(strcmp(snd_msg, rec_msg) == 0); + + close(fds[0]); +#endif +} + + +/* + * The vfork test case. + * + * Tests vfork with threads. + */ + +#ifdef __WIN32__ +#define NO_VFORK_PRESENT +#endif + +#ifndef NO_VFORK_PRESENT + +#undef vfork + +static ethr_mutex vt_mutex = ETHR_MUTEX_INITER; + +static void * +vt_thread(void *vprog) +{ + char *prog = (char *) vprog; + int res; + char snd_msg[] = "ok, bye!"; + char rec_msg[sizeof(snd_msg)*2]; + int fds[2]; + char closefd[20]; + char writefd[20]; + + res = pipe(fds); + ASSERT(res == 0); + + res = sprintf(closefd, "%d", fds[0]); + ASSERT(res <= 20); + res = sprintf(writefd, "%d", fds[1]); + ASSERT(res <= 20); + + print("parent: About to vfork and execute "); + print("execlp(\"%s\", \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", \"%s\", NULL)", + prog, prog, "vfork", "exec", snd_msg, closefd, writefd); + print_line(" in child"); + res = vfork(); + if (res == 0) { + execlp(prog, prog, "vfork", "exec", snd_msg, closefd, writefd, NULL); + _exit(1); + } + ASSERT(res > 0); + + print_line("parent: I'm back"); + + close(fds[1]); + + res = (int) read(fds[0], (void *) rec_msg, sizeof(rec_msg)); + print_line("parent: %d = read()", res); + print_line("parent: rec_msg=\"%s\"", rec_msg); + ASSERT(res == (int) sizeof(snd_msg)); + ASSERT(strcmp(snd_msg, rec_msg) == 0); + + close(fds[0]); + + return NULL; +} + +#endif /* #ifndef NO_VFORK_PRESENT */ + +static void +vfork_test(int argc, char *argv[]) +{ +#ifdef NO_VFORK_PRESENT + skip("No vfork() present; nothing to test"); +#else + int res; + ethr_tid tid; + + if (argc == 6 && strcmp("exec", argv[2]) == 0) { + /* We are child after vfork() and execlp() ... */ + + char *snd_msg; + int closefd; + int writefd; + + snd_msg = argv[3]; + closefd = atoi(argv[4]); + writefd = atoi(argv[5]); + + print_line("child: snd_msg=\"%s\"; closefd=%d writefd=%d", + snd_msg, closefd, writefd); + + close(closefd); + + res = (int) write(writefd, (void *) snd_msg, strlen(snd_msg)+1); + print_line("child: %d = write()", res); + if (res != strlen(snd_msg)+1) + exit(1); + close(writefd); + print_line("child: bye"); + exit(0); + } + ASSERT(argc == 2); + + res = ethr_mutex_set_forksafe(&vt_mutex); + ASSERT(res == 0 || res == ENOTSUP); + res = ethr_mutex_lock(&vt_mutex); + ASSERT(res == 0); + + res = ethr_thr_create(&tid, vt_thread, (void *) argv[0], NULL); + ASSERT(res == 0); + + do_sleep(1); + + res = ethr_mutex_unlock(&vt_mutex); + ASSERT(res == 0); + + res = ethr_thr_join(tid, NULL); + ASSERT(res == 0); + + res = ethr_mutex_destroy(&vt_mutex); + ASSERT(res == 0); +#endif +} + + +/* + * The tsd test case. + * + * Tests thread specific data. + */ + +#define TT_THREADS 10 +static ethr_tsd_key tt_key; + +static void * +tt_thread(void *arg) +{ + int res = ethr_tsd_set(tt_key, arg); + ASSERT(res == 0); + return ethr_tsd_get(tt_key); +} + +static void +tsd_test(void) +{ + void *tres; + int i, res; + ethr_tid tid[TT_THREADS]; + int values[TT_THREADS]; + + res = ethr_tsd_key_create(&tt_key); + ASSERT(res == 0); + + for (i = 1; i < TT_THREADS; i++) { + res = ethr_thr_create(&tid[i], tt_thread, (void *) &values[i], NULL); + ASSERT(res == 0); + } + + tres = tt_thread((void *) &values[0]); + ASSERT(tres == (void *) &values[0]); + + for (i = 1; i < TT_THREADS; i++) { + res = ethr_thr_join(tid[i], &tres); + ASSERT(res == 0); + ASSERT(tres == (void *) &values[i]); + } + + res = ethr_tsd_key_delete(tt_key); + ASSERT(res == 0); +} + + +/* + * The spinlock test case. + * + * Tests spinlocks. + */ + +static ethr_spinlock_t st_spinlock; +static int st_data; + +void * +st_thread(void *unused) +{ + int res; + + print_line("Aux thread tries to lock spinlock"); + res = ethr_spin_lock(&st_spinlock); + ASSERT(res == 0); + print_line("Aux thread locked spinlock"); + + ASSERT(st_data == 0); + + st_data = 1; + print_line("Aux thread wrote"); + + print_line("Aux thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Aux thread woke up"); + + ASSERT(st_data == 1); + + res = ethr_spin_unlock(&st_spinlock); + ASSERT(res == 0); + print_line("Aux thread unlocked spinlock"); + + return NULL; +} + + +static void +spinlock_test(void) +{ + int res; + ethr_tid tid; + + print_line("Trying to initialize spinlock"); + res = ethr_spinlock_init(&st_spinlock); + ASSERT(res == 0); + print_line("Initialized spinlock"); + + st_data = 0; + + print_line("Main thread tries to lock spinlock"); + res = ethr_spin_lock(&st_spinlock); + ASSERT(res == 0); + print_line("Main thread locked spinlock"); + + ASSERT(st_data == 0); + + print_line("Main thread about to create aux thread"); + res = ethr_thr_create(&tid, st_thread, NULL, NULL); + ASSERT(res == 0); + print_line("Main thread created aux thread"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(st_data == 0); + + res = ethr_spin_unlock(&st_spinlock); + ASSERT(res == 0); + print_line("Main thread unlocked spinlock"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + print_line("Main thread tries to lock spinlock"); + res = ethr_spin_lock(&st_spinlock); + ASSERT(res == 0); + print_line("Main thread locked spinlock"); + + ASSERT(st_data == 1); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(st_data == 1); + + res = ethr_spin_unlock(&st_spinlock); + ASSERT(res == 0); + print_line("Main thread unlocked spinlock"); + + res = ethr_thr_join(tid, NULL); + ASSERT(res == 0); + print_line("Main thread joined aux thread"); + + res = ethr_spinlock_destroy(&st_spinlock); + ASSERT(res == 0); + print_line("Main thread destroyed spinlock"); + +} + + +/* + * The rwspinlock test case. + * + * Tests rwspinlocks. + */ + +static ethr_rwlock_t rwst_rwspinlock; +static int rwst_data; + +void * +rwst_thread(void *unused) +{ + int data; + int res; + + print_line("Aux thread tries to read lock rwspinlock"); + res = ethr_read_lock(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Aux thread read locked rwspinlock"); + + ASSERT(rwst_data == 4711); + + print_line("Aux thread tries to read unlock rwspinlock"); + res = ethr_read_unlock(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Aux thread read unlocked rwspinlock"); + + print_line("Aux thread tries to write lock rwspinlock"); + res = ethr_write_lock(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Aux thread write locked rwspinlock"); + + data = ++rwst_data; + print_line("Aux thread wrote"); + + print_line("Aux thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Aux thread woke up"); + + ASSERT(rwst_data == data); + ++rwst_data; + + print_line("Aux thread tries to write unlock rwspinlock"); + res = ethr_write_unlock(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Aux thread write unlocked rwspinlock"); + + return NULL; +} + + +static void +rwspinlock_test(void) +{ + int data; + int res; + ethr_tid tid; + + print_line("Trying to initialize rwspinlock"); + res = ethr_rwlock_init(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Initialized rwspinlock"); + + rwst_data = 4711; + + print_line("Main thread tries to read lock rwspinlock"); + res = ethr_read_lock(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Main thread read locked rwspinlock"); + + ASSERT(rwst_data == 4711); + + print_line("Main thread about to create aux thread"); + res = ethr_thr_create(&tid, rwst_thread, NULL, NULL); + ASSERT(res == 0); + print_line("Main thread created aux thread"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(rwst_data == 4711); + + print_line("Main thread tries to read unlock rwspinlock"); + res = ethr_read_unlock(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Main thread read unlocked rwspinlock"); + + print_line("Main thread tries to write lock rwspinlock"); + res = ethr_write_lock(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Main thread write locked rwspinlock"); + + data = ++rwst_data; + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(rwst_data == data); + ++rwst_data; + + print_line("Main thread tries to write unlock rwspinlock"); + res = ethr_write_unlock(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Main thread write unlocked rwspinlock"); + + res = ethr_thr_join(tid, NULL); + ASSERT(res == 0); + print_line("Main thread joined aux thread"); + + res = ethr_rwlock_destroy(&rwst_rwspinlock); + ASSERT(res == 0); + print_line("Main thread destroyed rwspinlock"); + +} + + +/* + * The rwmutex test case. + * + * Tests rwmutexes. + */ + +static ethr_rwmutex rwmt_rwmutex; +static int rwmt_data; + +void * +rwmt_thread(void *unused) +{ + int data; + int res; + + print_line("Aux thread tries to read lock rwmutex"); + res = ethr_rwmutex_rlock(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Aux thread read locked rwmutex"); + + ASSERT(rwmt_data == 4711); + + print_line("Aux thread tries to read unlock rwmutex"); + res = ethr_rwmutex_runlock(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Aux thread read unlocked rwmutex"); + + print_line("Aux thread tries to write lock rwmutex"); + res = ethr_rwmutex_rwlock(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Aux thread write locked rwmutex"); + + data = ++rwmt_data; + print_line("Aux thread wrote"); + + print_line("Aux thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Aux thread woke up"); + + ASSERT(rwmt_data == data); + ++rwmt_data; + + print_line("Aux thread tries to write unlock rwmutex"); + res = ethr_rwmutex_rwunlock(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Aux thread write unlocked rwmutex"); + + return NULL; +} + + +static void +rwmutex_test(void) +{ + int data; + int res; + ethr_tid tid; + + print_line("Trying to initialize rwmutex"); + res = ethr_rwmutex_init(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Initialized rwmutex"); + + rwmt_data = 4711; + + print_line("Main thread tries to read lock rwmutex"); + res = ethr_rwmutex_rlock(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Main thread read locked rwmutex"); + + ASSERT(rwmt_data == 4711); + + print_line("Main thread about to create aux thread"); + res = ethr_thr_create(&tid, rwmt_thread, NULL, NULL); + ASSERT(res == 0); + print_line("Main thread created aux thread"); + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(rwmt_data == 4711); + + print_line("Main thread tries to read unlock rwmutex"); + res = ethr_rwmutex_runlock(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Main thread read unlocked rwmutex"); + + print_line("Main thread tries to write lock rwmutex"); + res = ethr_rwmutex_rwlock(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Main thread write locked rwmutex"); + + data = ++rwmt_data; + + print_line("Main thread goes to sleep for 1 second"); + do_sleep(1); + print_line("Main thread woke up"); + + ASSERT(rwmt_data == data); + ++rwmt_data; + + print_line("Main thread tries to write unlock rwmutex"); + res = ethr_rwmutex_rwunlock(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Main thread write unlocked rwmutex"); + + res = ethr_thr_join(tid, NULL); + ASSERT(res == 0); + print_line("Main thread joined aux thread"); + + res = ethr_rwmutex_destroy(&rwmt_rwmutex); + ASSERT(res == 0); + print_line("Main thread destroyed rwmutex"); + +} + +/* + * The atomic test case. + * + * Tests atomics. + */ + +#define AT_THREADS 4 +#define AT_ITER 10000 + +long at_set_val, at_rm_val, at_max_val; + +static ethr_atomic_t at_ready; +static ethr_atomic_t at_go; +static ethr_atomic_t at_done; +static ethr_atomic_t at_data; + +void * +at_thread(void *unused) +{ + int res, i; + long val, go; + + + res = ethr_atomic_inctest(&at_ready, &val); + ASSERT(res == 0); + ASSERT(val > 0); + ASSERT(val <= AT_THREADS); + + do { + res = ethr_atomic_read(&at_go, &go); + ASSERT(res == 0); + } while (!go); + + for (i = 0; i < AT_ITER; i++) { + res = ethr_atomic_or_old(&at_data, at_set_val, &val); + ASSERT(res == 0); + ASSERT(val >= (i == 0 ? 0 : at_set_val) + (long) 4711); + ASSERT(val <= at_max_val); + + res = ethr_atomic_and_old(&at_data, ~at_rm_val, &val); + ASSERT(res == 0); + ASSERT(val >= at_set_val + (long) 4711); + ASSERT(val <= at_max_val); + + res = ethr_atomic_read(&at_data, &val); + ASSERT(res == 0); + ASSERT(val >= at_set_val + (long) 4711); + ASSERT(val <= at_max_val); + + res = ethr_atomic_inctest(&at_data, &val); + ASSERT(res == 0); + ASSERT(val > at_set_val + (long) 4711); + ASSERT(val <= at_max_val); + + res = ethr_atomic_dectest(&at_data, &val); + ASSERT(res == 0); + ASSERT(val >= at_set_val + (long) 4711); + ASSERT(val <= at_max_val); + + res = ethr_atomic_inc(&at_data); + ASSERT(res == 0); + + res = ethr_atomic_dec(&at_data); + ASSERT(res == 0); + + res = ethr_atomic_addtest(&at_data, (long) 4711, &val); + ASSERT(res == 0); + ASSERT(val >= at_set_val + (long) 2*4711); + ASSERT(val <= at_max_val); + + res = ethr_atomic_add(&at_data, (long) -4711); + ASSERT(res == 0); + ASSERT(val >= at_set_val + (long) 4711); + ASSERT(val <= at_max_val); + } + + res = ethr_atomic_inc(&at_done); + ASSERT(res == 0); + return NULL; +} + + +static void +atomic_test(void) +{ + long data_init, data_final, val; + int res, i; + ethr_tid tid[AT_THREADS]; + ethr_thr_opts thr_opts = ETHR_THR_OPTS_DEFAULT_INITER; + + if (sizeof(long) > 4) { + at_rm_val = ((long) 1) << 57; + at_set_val = ((long) 1) << 60; + } + else { + at_rm_val = ((long) 1) << 27; + at_set_val = ((long) 1) << 30; + } + + at_max_val = at_set_val + at_rm_val + ((long) AT_THREADS + 1) * 4711; + data_init = at_rm_val + (long) 4711; + data_final = at_set_val + (long) 4711; + + thr_opts.detached = 1; + + print_line("Initializing"); + res = ethr_atomic_init(&at_ready, 0); + ASSERT(res == 0); + res = ethr_atomic_init(&at_go, 0); + ASSERT(res == 0); + res = ethr_atomic_init(&at_done, data_init); + ASSERT(res == 0); + res = ethr_atomic_init(&at_data, data_init); + ASSERT(res == 0); + + res = ethr_atomic_read(&at_data, &val); + ASSERT(res == 0); + ASSERT(val == data_init); + res = ethr_atomic_set(&at_done, 0); + ASSERT(res == 0); + res = ethr_atomic_read(&at_done, &val); + ASSERT(res == 0); + ASSERT(val == 0); + + print_line("Creating threads"); + for (i = 0; i < AT_THREADS; i++) { + res = ethr_thr_create(&tid[i], at_thread, NULL, &thr_opts); + ASSERT(res == 0); + } + + print_line("Waiting for threads to ready up"); + do { + res = ethr_atomic_read(&at_ready, &val); + ASSERT(res == 0); + ASSERT(val >= 0); + ASSERT(val <= AT_THREADS); + } while (val != AT_THREADS); + + print_line("Letting threads loose"); + res = ethr_atomic_xchg(&at_go, 17, &val); + ASSERT(res == 0); + ASSERT(val == 0); + res = ethr_atomic_read(&at_go, &val); + ASSERT(res == 0); + ASSERT(val == 17); + + + print_line("Waiting for threads to finish"); + do { + res = ethr_atomic_read(&at_done, &val); + ASSERT(res == 0); + ASSERT(val >= 0); + ASSERT(val <= AT_THREADS); + } while (val != AT_THREADS); + + print_line("Checking result"); + res = ethr_atomic_read(&at_data, &val); + ASSERT(res == 0); + ASSERT(val == data_final); + print_line("Result ok"); + +} + + +/* + * The gate test case. + * + * Tests gates. + */ + +#define GT_THREADS 10 + +static ethr_atomic_t gt_wait1; +static ethr_atomic_t gt_wait2; +static ethr_atomic_t gt_done; + +static ethr_gate gt_gate1; +static ethr_gate gt_gate2; + +void * +gt_thread(void *thr_no) +{ + int no = (int)(long) thr_no; + int swait = no % 2 == 0; + int res; + long done; + + + do { + + res = ethr_atomic_inc(>_wait1); + ASSERT(res == 0); + + if (swait) + res = ethr_gate_swait(>_gate1, INT_MAX); + else + res = ethr_gate_wait(>_gate1); + ASSERT(res == 0); + + res = ethr_atomic_dec(>_wait1); + ASSERT(res == 0); + + res = ethr_atomic_inc(>_wait2); + ASSERT(res == 0); + + if (swait) + res = ethr_gate_swait(>_gate2, INT_MAX); + else + res = ethr_gate_wait(>_gate2); + ASSERT(res == 0); + + res = ethr_atomic_dec(>_wait2); + ASSERT(res == 0); + + res = ethr_atomic_read(>_done, &done); + ASSERT(res == 0); + } while (!done); + return NULL; +} + + +static void +gate_test(void) +{ + long val; + int res, i; + ethr_tid tid[GT_THREADS]; + + print_line("Initializing"); + res = ethr_atomic_init(>_wait1, 0); + ASSERT_EQ(res, 0, "%d"); + res = ethr_atomic_init(>_wait2, 0); + ASSERT_EQ(res, 0, "%d"); + res = ethr_atomic_init(>_done, 0); + ASSERT_EQ(res, 0, "%d"); + res = ethr_gate_init(>_gate1); + ASSERT_EQ(res, 0, "%d"); + res = ethr_gate_init(>_gate2); + ASSERT_EQ(res, 0, "%d"); + + print_line("Creating threads"); + for (i = 0; i < GT_THREADS; i++) { + res = ethr_thr_create(&tid[i], gt_thread, (void *) i, NULL); + ASSERT_EQ(res, 0, "%d"); + } + + print_line("Waiting for threads to ready up"); + do { + res = ethr_atomic_read(>_wait1, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT(0 <= val && val <= GT_THREADS); + } while (val != GT_THREADS); + + print_line("Testing"); + + res = ethr_gate_let_through(>_gate1, 8); + ASSERT_EQ(res, 0, "%d"); + + WAIT_UNTIL_LIM((res = ethr_atomic_read(>_wait2, &val), + (res != 0 || val == 8)), + 60); + + res = ethr_atomic_read(>_wait1, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, GT_THREADS - 8, "%ld"); + + res = ethr_atomic_read(>_wait2, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, 8, "%ld"); + + res = ethr_gate_let_through(>_gate2, 4); + ASSERT_EQ(res, 0, "%d"); + + WAIT_UNTIL_LIM((res = ethr_atomic_read(>_wait2, &val), + (res != 0 || val == 4)), + 60); + + res = ethr_atomic_read(>_wait1, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, GT_THREADS - 4, "%ld"); + + res = ethr_atomic_read(>_wait2, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, 4, "%ld"); + + res = ethr_gate_let_through(>_gate1, GT_THREADS); + ASSERT_EQ(res, 0, "%d"); + + WAIT_UNTIL_LIM((res = ethr_atomic_read(>_wait2, &val), + (res != 0 || val == GT_THREADS)), + 60); + res = ethr_atomic_read(>_wait1, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, 0, "%ld"); + + res = ethr_atomic_read(>_wait2, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, GT_THREADS, "%ld"); + + res = ethr_gate_let_through(>_gate2, GT_THREADS); + ASSERT_EQ(res, 0, "%d"); + + WAIT_UNTIL_LIM((res = ethr_atomic_read(>_wait2, &val), + (res != 0 || val == 4)), + 60); + res = ethr_atomic_read(>_wait1, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, GT_THREADS - 4, "%ld"); + + res = ethr_atomic_read(>_wait2, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, 4, "%ld"); + + res = ethr_atomic_set(>_done, 1); + ASSERT_EQ(res, 0, "%d"); + + res = ethr_gate_let_through(>_gate2, GT_THREADS); + ASSERT_EQ(res, 0, "%d"); + res = ethr_gate_let_through(>_gate1, GT_THREADS - 4); + ASSERT_EQ(res, 0, "%d"); + + WAIT_UNTIL_LIM(((res = ethr_atomic_read(>_wait1, &val)) != 0 + || (val == 0 + && ((res = ethr_atomic_read(>_wait2, &val)) != 0 + || val == 0))), + 60); + + res = ethr_atomic_read(>_wait1, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, 0, "%ld"); + + res = ethr_atomic_read(>_wait2, &val); + ASSERT_EQ(res, 0, "%d"); + ASSERT_EQ(val, 0, "%ld"); + + print_line("Joining threads"); + for (i = 0; i < GT_THREADS; i++) { + res = ethr_thr_join(tid[i], NULL); + ASSERT_EQ(res, 0, "%d"); + } + + res = ethr_gate_destroy(>_gate1); + ASSERT_EQ(res, 0, "%d"); + res = ethr_gate_destroy(>_gate2); + ASSERT_EQ(res, 0, "%d"); + +} + +#endif /* #ifndef ETHR_NO_THREAD_LIB */ + +/* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * + * The dispatcher * +\* */ + +int +main(int argc, char *argv[]) +{ + if (argc < 2) + fail("To few arguments for test case"); + +#ifndef ETHR_NO_THREAD_LIB + { + char *testcase; + int res; + + send_my_pid(); + + testcase = argv[1]; + res = ethr_init(NULL); + + if (res != 0) + fail("Failed to initialize the ethread library"); + + if (strcmp(testcase, "create_join_thread") == 0) + create_join_thread_test(); + else if (strcmp(testcase, "equal_tids") == 0) + equal_tids_test(); + else if (strcmp(testcase, "mutex") == 0) + mutex_test(); + else if (strcmp(testcase, "try_lock_mutex") == 0) + try_lock_mutex_test(); + else if (strcmp(testcase, "recursive_mutex") == 0) + recursive_mutex_test(); + else if (strcmp(testcase, "time_now") == 0) + time_now_test(); + else if (strcmp(testcase, "cond_wait") == 0) + cond_wait_test(0); + else if (strcmp(testcase, "cond_timedwait") == 0) + cond_timedwait_test(); + else if (strcmp(testcase, "broadcast") == 0) + broadcast_test(); + else if (strcmp(testcase, "detached_thread") == 0) + detached_thread_test(); + else if (strcmp(testcase, "max_threads") == 0) + max_threads_test(); + else if (strcmp(testcase, "forksafety") == 0) + forksafety_test(); + else if (strcmp(testcase, "vfork") == 0) + vfork_test(argc, argv); + else if (strcmp(testcase, "tsd") == 0) + tsd_test(); + else if (strcmp(testcase, "spinlock") == 0) + spinlock_test(); + else if (strcmp(testcase, "rwspinlock") == 0) + rwspinlock_test(); + else if (strcmp(testcase, "rwmutex") == 0) + rwmutex_test(); + else if (strcmp(testcase, "atomic") == 0) + atomic_test(); + else if (strcmp(testcase, "gate") == 0) + gate_test(); + else + skip("Test case \"%s\" not implemented yet", testcase); + + succeed(NULL); + } +#else /* #ifndef ETHR_NO_THREAD_LIB */ + skip("No ethread library to test"); +#endif /* #ifndef ETHR_NO_THREAD_LIB */ + + return 0; +} diff --git a/erts/test/ignore_cores.erl b/erts/test/ignore_cores.erl new file mode 100644 index 0000000000..7ec2cac706 --- /dev/null +++ b/erts/test/ignore_cores.erl @@ -0,0 +1,158 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%%%------------------------------------------------------------------- +%%% File : ignore_cores.erl +%%% Author : Rickard Green +%%% Description : +%%% +%%% Created : 11 Feb 2008 by Rickard Green +%%%------------------------------------------------------------------- + +-module(ignore_cores). + +-include("test_server.hrl"). + +-export([init/1, fini/1, setup/3, setup/4, restore/1, dir/1]). + +-record(ignore_cores, {org_cwd, + org_path, + org_pwd_env, + ign_dir = false, + cores_dir = false}). + +%% +%% Takes a testcase config +%% + +init(Config) -> + {ok, OrgCWD} = file:get_cwd(), + [{ignore_cores, + #ignore_cores{org_cwd = OrgCWD, + org_path = code:get_path(), + org_pwd_env = os:getenv("PWD")}} + | lists:keydelete(ignore_cores, 1, Config)]. + +fini(Config) -> + #ignore_cores{org_cwd = OrgCWD, + org_path = OrgPath, + org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + ok = file:set_cwd(OrgCWD), + true = code:set_path(OrgPath), + case OrgPWD of + false -> ok; + _ -> true = os:putenv("PWD", OrgPWD) + end, + lists:keydelete(ignore_cores, 1, Config). + +setup(Suite, Testcase, Config) -> + setup(Suite, Testcase, Config, false). + +setup(Suite, Testcase, Config, SetCwd) when is_atom(Suite), + is_atom(Testcase), + is_list(Config) -> + #ignore_cores{org_cwd = OrgCWD, + org_path = OrgPath, + org_pwd_env = OrgPWD} = ?config(ignore_cores, Config), + Path = lists:map(fun (".") -> OrgCWD; (Dir) -> Dir end, OrgPath), + true = code:set_path(Path), + PrivDir = ?config(priv_dir, Config), + IgnDir = filename:join([PrivDir, + atom_to_list(Suite) + ++ "_" + ++ atom_to_list(Testcase) + ++ "_wd"]), + ok = file:make_dir(IgnDir), + case SetCwd of + false -> + ok; + _ -> + ok = file:set_cwd(IgnDir), + OrgPWD = case os:getenv("PWD") of + false -> false; + PWD -> + os:putenv("PWD", IgnDir), + PWD + end + end, + ok = file:write_file(filename:join([IgnDir, "ignore_core_files"]), <<>>), + %% cores are dumped in /cores on MacOS X + CoresDir = case {?t:os_type(), filelib:is_dir("/cores")} of + {{unix,darwin}, true} -> + filelib:fold_files("/cores", + "^core.*$", + false, + fun (C,Cs) -> [C|Cs] end, + []); + _ -> + false + end, + lists:keyreplace(ignore_cores, + 1, + Config, + {ignore_cores, + #ignore_cores{org_cwd = OrgCWD, + org_path = OrgPath, + org_pwd_env = OrgPWD, + ign_dir = IgnDir, + cores_dir = CoresDir}}). + +restore(Config) -> + #ignore_cores{org_cwd = OrgCWD, + org_path = OrgPath, + org_pwd_env = OrgPWD, + ign_dir = IgnDir, + cores_dir = CoresDir} = ?config(ignore_cores, Config), + try + case CoresDir of + false -> + ok; + _ -> + %% Move cores dumped by these testcases in /cores + %% to cwd. + lists:foreach(fun (C) -> + case lists:member(C, CoresDir) of + true -> ok; + _ -> + Dst = filename:join( + [IgnDir, + filename:basename(C)]), + {ok, _} = file:copy(C, Dst), + file:delete(C) + end + end, + filelib:fold_files("/cores", + "^core.*$", + false, + fun (C,Cs) -> [C|Cs] end, + [])) + end + after + catch file:set_cwd(OrgCWD), + catch code:set_path(OrgPath), + case OrgPWD of + false -> ok; + _ -> catch os:putenv("PWD", OrgPWD) + end + end. + + +dir(Config) -> + #ignore_cores{ign_dir = Dir} = ?config(ignore_cores, Config), + Dir. diff --git a/erts/test/nt_SUITE.erl b/erts/test/nt_SUITE.erl new file mode 100644 index 0000000000..7ff5c908e6 --- /dev/null +++ b/erts/test/nt_SUITE.erl @@ -0,0 +1,551 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%% Purpose: Test NT specific utilities +-module(nt_SUITE). +-include("test_server.hrl"). +-include_lib("kernel/include/file.hrl"). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2,nt/1,handle_eventlog/2, + middleman/1,service_basic/1, service_env/1, user_env/1, synced/1, + service_prio/1, + logout/1, debug/1, restart/1, restart_always/1,stopaction/1, + shutdown_io/0,do_shutdown_io/0]). +-define(TEST_TIMEOUT, ?t:seconds(180)). + +-define(TEST_SERVICES, [1,2,3,4,5,6,7,8,9,10,11]). + +all(suite) -> + case os:type() of + {win32,nt} -> + [nt, service_basic, service_env, user_env, synced, service_prio, + logout, debug, + restart, restart_always, stopaction]; + _ -> [nt] %%% Just to give a little hint why they are skipped... + end. + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(?TEST_TIMEOUT), + [{watchdog, Dog} | Config]. + +fin_per_testcase(_Func, Config) -> + lists:foreach(fun(X) -> + catch remove_service("test_service_" ++ + integer_to_list(X)) end, + ?TEST_SERVICES), + Dog = ?config(watchdog, Config), + catch test_server:timetrap_cancel(Dog), + ok. + +erlsrv() -> + os:find_executable(erlsrv). + + +recv_prog_output(Port) -> + receive + {Port, {data, {eol,Data}}} -> + %%io:format("Got data: ~s~n", [Data]), + [ Data | recv_prog_output(Port)]; + _X -> + %%io:format("Got data: ~p~n", [_X]), + Port ! {self(), close}, + receive + _ -> + [] + end + end. + + +%%% X == parameters to erlsrv +%%% returns command output without stderr +do_command(X) -> + %%io:format("Command: ~s~n", [erlsrv() ++ " " ++ X]), + Port = open_port({spawn, erlsrv() ++ " " ++ X}, [stream, {line, 100}, eof, in]), + Res = recv_prog_output(Port), + case Res of + [] -> + failed; + _Y -> + %%io:format("~p~n",[_Y]), + ok + end. + + +create_service(Name) -> + ok = do_command("add " ++ Name). + +start_service(Name) -> + ok = do_command("start " ++ Name). + +stop_service(Name) -> + ok = do_command("stop " ++ Name). + +remove_service(Name) -> + ok = do_command("remove " ++ Name). +do_wait_for_it(_,0) -> + false; +do_wait_for_it(FullName,N) -> + case net_adm:ping(FullName) of + pong -> + true; + _ -> + receive + after 1000 -> + do_wait_for_it(FullName,N-1) + end + end. + +wait_for_node(Name) -> + FullName = make_full_name(Name), + do_wait_for_it(FullName,30). + +make_full_name(Name) -> + [_,Suffix] = string:tokens(atom_to_list(node()),"@"), + list_to_atom(Name ++ "@" ++ Suffix). + + +%%% The following tests are only run on NT: + +service_basic(doc) -> + ["Check some basic (cosmetic) service parameters"]; +service_basic(suite) -> []; +service_basic(Config) when is_list(Config) -> + ?line Name = "test_service_20", + ?line IntName = Name++"_internal", + ?line Service = [{servicename,Name}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie())]}, + {internalservicename,IntName}, + {comment,"Epic comment"}], + ?line ok = erlsrv:store_service(Service), + ?line start_service(Name), + ?line true = wait_for_node(Name), + ?line S2 = erlsrv:get_service(Name), + ?line {value,{comment,"Epic comment"}} = lists:keysearch(comment,1,S2), + ?line {value,{internalservicename,IntName}} = + lists:keysearch(internalservicename,1,S2), + ?line S3 = lists:keyreplace(comment,1,S2,{comment,"Basic comment"}), + ?line S4 = lists:keyreplace(internalservicename,1,S3, + {internalservicename,"WillNotHappen"}), + ?line ok = erlsrv:store_service(S4), + ?line S5 = erlsrv:get_service(Name), + ?line {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S5), + ?line {value,{internalservicename,IntName}} = + lists:keysearch(internalservicename,1,S5), + ?line NewName = "test_service_21", + ?line S6 = erlsrv:new_service(NewName,S5,[]), % should remove + % internalservicename + ?line ok = erlsrv:store_service(S6), + ?line S7 = erlsrv:get_service(NewName), + ?line {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S7), + ?line {value,{internalservicename,[$t,$e,$s,$t | _]}} = + lists:keysearch(internalservicename,1,S7), + ?line remove_service(Name), + ?line remove_service(NewName), + ok. + +service_env(doc) -> + ["Check that service name and executable is in the environment of the " ++ + "erlang process created by erlsrv."]; +service_env(suite) -> []; +service_env(Config) when is_list(Config) -> + ?line Name = "test_service_2", + ?line Service = [{servicename,Name}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie())]}], + ?line ok = erlsrv:store_service(Service), + ?line start_service(Name), + ?line true = wait_for_node(Name), + ?line Name = rpc:call(make_full_name(Name),os,getenv, + ["ERLSRV_SERVICE_NAME"]), + ?line "erlsrv.exe" = filename:basename( + hd( + string:tokens( + rpc:call(make_full_name(Name), + os, + getenv, + ["ERLSRV_EXECUTABLE"]), + "\""))), + ?line remove_service(Name), + ok. +user_env(doc) -> + ["Check that the user defined environment is ADDED to the service's"++ + " normal dito."]; +user_env(suite) -> []; +user_env(Config) when is_list(Config) -> + ?line Name = "test_service_3", + ?line Service = [{servicename,Name},{env,[{"HUBBA","BUBBA"}]}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie())]}], + ?line ok = erlsrv:store_service(Service), + ?line start_service(Name), + ?line true = wait_for_node(Name), + ?line true = rpc:call(make_full_name(Name),os,getenv, + ["SystemDrive"]) =/= false, + ?line "BUBBA" = rpc:call(make_full_name(Name),os,getenv,["HUBBA"]), + ?line remove_service(Name), + ok. +synced(doc) -> + ["Check that services are stopped and started syncronous and that"++ + " failed stopactions kill the erlang machine anyway."]; +synced(suite) -> []; +synced(Config) when is_list(Config) -> + ?line Name0 = "test_service_4", + ?line Service0 = [{servicename,Name0}, + {machine, "N:\\nickeNyfikenPaSjukhus"}], + ?line ok = erlsrv:store_service(Service0), + ?line true = (catch start_service(Name0)) =/= ok, + ?line remove_service(Name0), + ?line Name = "test_service_5", + ?line Service = [{servicename,Name}, + {stopaction,"erlang:info(garbage_collection)."}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie())]}], + ?line ok = erlsrv:store_service(Service), + ?line start_service(Name), + ?line true = wait_for_node(Name), + ?line T1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + ?line stop_service(Name), + ?line Diff1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T1, + ?line true = Diff1 > 30, + ?line start_service(Name), + ?line true = wait_for_node(Name), + ?line T2 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + ?line remove_service(Name), + ?line Diff2 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T2, + ?line true = Diff2 > 30, + ok. +service_prio(doc) -> + ["Check that a service with higher prio create port programs with " + "higher prio."]; +service_prio(suite) -> []; +service_prio(Config) when is_list(Config) -> + ?line Name = "test_service_6", + ?line Service = [{servicename,Name},{prio,"high"}, + {env, [{"HEART_COMMAND","echo off"}]}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie()), + "-heart"]}], + ?line ok = erlsrv:store_service(Service), + ?line {ok, OldProcs} = get_current_procs(Config), + ?line start_service(Name), + ?line {ok, NewProcs} = get_current_procs(Config), + ?line remove_service(Name), + ?line Diff = arrived_procs(OldProcs,NewProcs), + %% Not really correct, could fail if another heart is + %% started at the same time... + ?line {value, {"heart.exe",_,"high"}} = + lists:keysearch("heart.exe",1,Diff), + ok. +logout(doc) -> + ["Check that logout does not kill services"]; +logout(suite) -> []; +logout(Config) when is_list(Config) -> + ?line {comment, "Have to be run manually by registering a service with " ++ + "heart, logout and log in again and then examine that the heart " ++ + "process id is not changed."}. +debug(doc) -> + ["Check the debug options to erlsrv."]; +debug(suite) -> []; +debug(Config) when is_list(Config) -> + ?line Name0 = "test_service_7", + + %% We used to set the privdir as temporary directory, but for some + %% reason we don't seem to have write access to that directory, + %% so we'll use the directory specified in the next line. + ?line TempDir = "C:/TEMP", + ?line Service0 = [{servicename,Name0}, + {workdir,filename:nativename(TempDir)}, + {debugtype,"reuse"}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie())]}], + ?line ok = erlsrv:store_service(Service0), + ?line T1 = calendar:datetime_to_gregorian_seconds( + calendar:local_time()), + %% sleep a little + ?line receive after 2000 -> ok end, + ?line start_service(Name0), + ?line true = wait_for_node(Name0), + ?line LF = filename:join(TempDir, Name0++".debug"), + ?line {ok,Info0} = file:read_file_info(LF), + ?line T2 = calendar:datetime_to_gregorian_seconds( + Info0#file_info.mtime), + ?line true = T2 > T1, + ?line remove_service(Name0), + ?line file:delete(LF), + ?line Name1 = "test_service_8", + ?line Service1 = [{servicename,Name1}, + {workdir, filename:nativename(TempDir)}, + {debugtype,"new"}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie())]}], + ?line ok = erlsrv:store_service(Service1), + ?line T3 = calendar:datetime_to_gregorian_seconds( + calendar:local_time()), + %% sleep a little + ?line receive after 2000 -> ok end, + ?line NF = next_logfile(TempDir, Name1), + ?line start_service(Name1), + ?line true = wait_for_node(Name1), + ?line {ok,Info1} = file:read_file_info(NF), + ?line T4 = calendar:datetime_to_gregorian_seconds( + Info1#file_info.mtime), + ?line true = T4 > T3, + ?line remove_service(Name1), + ?line file:delete(NF), + ok. + +restart(doc) -> + ["Check the restart options to erlsrv"]; +restart(suite) -> []; +restart(Config) when is_list(Config) -> + ?line Name = "test_service_9", + ?line Service = [{servicename,Name}, + {workdir, filename:nativename(logdir(Config))}, + {onfail,"restart"}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie())]}], + ?line ok = erlsrv:store_service(Service), + ?line start_service(Name), + ?line true = wait_for_node(Name), + ?line receive after 20000 -> ok end, + ?line rpc:call(make_full_name(Name),erlang,halt,[]), + ?line receive after 1000 -> ok end, + ?line true = wait_for_node(Name), + ?line rpc:call(make_full_name(Name),erlang,halt,[]), + ?line receive after 1000 -> ok end, + ?line false = wait_for_node(Name), + ?line remove_service(Name), + ok. + +restart_always(doc) -> + ["Check the restart options to erlsrv"]; +restart_always(suite) -> []; +restart_always(Config) when is_list(Config) -> + ?line Name = "test_service_10", + ?line Service = [{servicename,Name}, + {workdir, filename:nativename(logdir(Config))}, + {onfail,"restart_always"}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie())]}], + ?line ok = erlsrv:store_service(Service), + ?line start_service(Name), + ?line true = wait_for_node(Name), + ?line rpc:call(make_full_name(Name),erlang,halt,[]), + ?line receive after 1000 -> ok end, + ?line true = wait_for_node(Name), + ?line rpc:call(make_full_name(Name),erlang,halt,[]), + ?line receive after 1000 -> ok end, + ?line true = wait_for_node(Name), + ?line remove_service(Name), + ok. +stopaction(doc) -> + ["Check that stopaction does not hang output while shutting down"]; +stopaction(suite) -> []; +stopaction(Config) when is_list(Config) -> + ?line Name = "test_service_11", + %% Icky, I prepend the first element in the codepath, cause + %% I "suppose" it's the one to where I am. + ?line Service = [{servicename,Name}, + {stopaction,atom_to_list(?MODULE) ++ ":shutdown_io()."}, + {args, ["-setcookie", + atom_to_list(erlang:get_cookie()), + "-pa", hd(code:get_path())]}], + ?line ok = erlsrv:store_service(Service), + ?line start_service(Name), + ?line true = wait_for_node(Name), + ?line T1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()), + ?line stop_service(Name), + ?line Diff1 = calendar:datetime_to_gregorian_seconds( + calendar:universal_time()) - T1, + ?line true = Diff1 < 30, + ?line remove_service(Name), + ok. + + +%%% This test is run on all platforms, but just gives a comment on +%%% other platforms than NT. + +nt(doc) -> + ["Run NT specific tests."]; +nt(suite) -> + []; +nt(Config) when is_list(Config) -> + case os:type() of + {win32,nt} -> + nt_run(); + _ -> + {skipped, "This test case is intended for Win NT only."} + end. + + +nt_run() -> + ?line start_all(), + ?line create_service("test_service_1"), + ?line R = start_look_for_single("System","ErlSrv","Informational", + ".*test_service_1.*started.*"), + ?line start_service("test_service_1"), + ?line Res = look_for_single(R), + ?line io:format("Result from eventlog: ~p~n", + [Res]), + ?line remove_service("test_service_1"), + ?line stop_all(), + ok. + +start_all() -> + Pid1 = spawn_link(?MODULE,middleman,[[]]), + register(?MODULE,Pid1), + _Pid2 = nteventlog:start("log_testing", + {?MODULE,handle_eventlog,[Pid1]}). + +stop_all() -> + ?MODULE ! stop, + nteventlog:stop(). + +start_look_for_single(Cat,Fac,Sev,MessRE) -> + Ref = make_ref(), + ?MODULE ! {lookfor, {self(), Ref, {Cat,Fac,Sev,MessRE}}}, + Ref. + +look_for_single(Ref) -> + receive + {Ref,Time,Mes} -> + {Time,Mes} + after 60000 -> + timeout + end. + + +%%% Mes = {Time,Category,Facility,Severity,Message} +handle_eventlog(Mes,Pid) -> + Pid ! Mes. + +%%% Waitfor = [{Pid, Ref, {Category,Facility,Severity,MessageRE}} ...] +middleman(Waitfor) -> + receive + {Time,Category,Facility,Severity,Message} -> + io:format("Middleman got ~s...", [Message]), + case match_event({Time,Category,Facility,Severity,Message}, + Waitfor) of + {ok, {Pid,Ref,Time,Mes}, Rest} -> + io:format("matched~n"), + Pid ! {Ref,Time,Mes}, + middleman(Rest); + _ -> + io:format("no match~n"), + middleman(Waitfor) + end; + {lookfor, X} -> + io:format("Middleman told to look for ~p~n", [X]), + middleman([X|Waitfor]); + stop -> + stopped; + _ -> + middleman(Waitfor) + end. + + +%%% Matches events, not tail recursive. +match_event(_X, []) -> + nomatch; +match_event({Time,Cat,Fac,Sev,Mes},[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Tail]) -> + case regexp:match(Mes,MesRE) of + {match,_,_} -> + %%io:format("Match!~n"), + {ok,{Pid,Ref,Time,Mes},Tail}; + _Z -> + %%io:format("No match (~p)~n",[_Z]), + case match_event({Time,Cat,Fac,Sev,Mes},Tail) of + {ok,X,Rest} -> + {ok,X,[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Rest]}; + X -> + X + end + end; +match_event(X,[Y | T]) -> + %%io:format("X == ~p, Y == ~p~n",[X,Y]), + case match_event(X,T) of + {ok,Z,R} -> + {ok,Z,[Y|R]}; + XX -> + XX + end. + +arrived_procs(_,[]) -> + []; +arrived_procs(OldProcs,[{Executable, Pid, Priority} | TNewProcs]) -> + case lists:keysearch(Pid,2,OldProcs) of + {value, _} -> + arrived_procs(OldProcs, TNewProcs); + false -> + [{Executable, Pid, Priority} | arrived_procs(OldProcs, TNewProcs)] + end. + + +get_current_procs(Config) -> + ?line P = open_port({spawn,nt_info(Config) ++ " -E"}, + [{line,10000}]), + ?line L = receive + {P,{data,{eol,D}}} -> + D; + _ -> "error. " + end, + ?line P ! {self(), close}, + ?line receive + {P, closed} -> ok + end, + ?line {done,{ok,Tok,_},_} = erl_scan:tokens([],L,0), + ?line erl_parse:parse_term(Tok). + +nt_info(Config) when is_list(Config) -> + ?line filename:join(?config(data_dir, Config), "nt_info"). + + +logdir(Config) -> + ?line ?config(priv_dir, Config). + +look_for_next(Template,L,N) -> + ?line FN = Template ++ integer_to_list(N), + ?line case lists:member(FN,L) of + true -> + ?line look_for_next(Template,L,N+1); + false -> + ?line FN + end. + +next_logfile(LD, Servicename) -> + ?line {ok, Files} = file:list_dir(LD), + ?line Ftmpl = Servicename ++ ".debug.", + ?line filename:join(LD,look_for_next(Ftmpl,Files,1)). + +%%% Functions run by the service + +do_shutdown_io() -> + receive + after 2000 -> + io:format("IO in shutting down...~n"), + erlang:halt() + end. + +shutdown_io() -> + spawn(?MODULE,do_shutdown_io,[]). diff --git a/erts/test/nt_SUITE_data/Makefile.src b/erts/test/nt_SUITE_data/Makefile.src new file mode 100644 index 0000000000..b26666252e --- /dev/null +++ b/erts/test/nt_SUITE_data/Makefile.src @@ -0,0 +1,33 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1998-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = nt_info@exe@ + +all: $(PROGS) + +nt_info@exe@: nt_info@obj@ + $(LD) $(CROSSLDFLAGS) -o nt_info nt_info@obj@ @LIBS@ + +nt_info@obj@: nt_info.c + $(CC) -c -o nt_info@obj@ $(CFLAGS) nt_info.c diff --git a/erts/test/nt_SUITE_data/nt_info.c b/erts/test/nt_SUITE_data/nt_info.c new file mode 100644 index 0000000000..33cf046bb6 --- /dev/null +++ b/erts/test/nt_SUITE_data/nt_info.c @@ -0,0 +1,176 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 1998-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + */ +/* + * This is a simple command that gives some interesting + * system information on NT. + * It is run as a port program by the nt test suite to find out priorities + * of programs etc. + */ +#include +#include +#include + +#if defined(VXWORKS) +int nt_info(int argc, char **argv){ + printf("Hello Älvsjö!\n"); + return 0; +} +#elif !defined(__WIN32__) +int main(int argc, char **argv){ + printf("Hello Älvsjö!\n"); + return 0; +} +#else /* Windows NT, here we go... */ + +#include + + +int erlang_format = 0; + +#if 0 +int last_error = 0; + +void print_last_error(void){ + char *mes; + FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM, + NULL, + (last_error) ? last_error : GetLastError(), + MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), + (LPTSTR) &mes, + 0, + NULL ); + fprintf(stderr,"Error: %s",mes); + LocalFree(mes); +} +#endif + +typedef BOOL (WINAPI *tEnumProcesses)(DWORD *, DWORD, DWORD *); +typedef BOOL (WINAPI *tEnumProcessModules)(HANDLE, HMODULE *, DWORD, DWORD *); +typedef DWORD (WINAPI *tGetModuleBaseName)(HANDLE, HMODULE, char *, DWORD); + +static tGetModuleBaseName pGetModuleBaseName = NULL; +static tEnumProcessModules pEnumProcessModules = NULL; +static tEnumProcesses pEnumProcesses = NULL; + +static BOOL init_fpointers(void){ + HINSTANCE instance = LoadLibrary("PSAPI.DLL"); + if(instance == NULL){ + fprintf(stderr,"Failed to load PSAPI.DLL.\n"); + return FALSE; + } + if((pEnumProcesses = + (tEnumProcesses) GetProcAddress(instance,"EnumProcesses")) == + NULL){ + fprintf(stderr,"Failed to find EnumProcesses in DLL.\n"); + return FALSE; + } + if((pEnumProcessModules = + (tEnumProcessModules) GetProcAddress(instance,"EnumProcessModules")) == + NULL){ + fprintf(stderr,"Failed to find EnumProcessModules in DLL.\n"); + return FALSE; + } + if((pGetModuleBaseName = + (tGetModuleBaseName) GetProcAddress(instance,"GetModuleBaseNameA")) == + NULL){ + fprintf(stderr,"Failed to find GetModuleBaseName in DLL.\n"); + return FALSE; + } + return TRUE; +} + + +void one_line(DWORD pid){ + char pname[MAX_PATH] = "???"; + HMODULE hmod = NULL; + DWORD dummy; + DWORD priority = -1; + struct { + DWORD sym; + char *txt; + } tab[] = { + {HIGH_PRIORITY_CLASS,"high"}, + {IDLE_PRIORITY_CLASS, "idle"}, + {NORMAL_PRIORITY_CLASS,"normal"}, + {REALTIME_PRIORITY_CLASS, "realtime"} + }; + int tabsiz = sizeof(tab)/sizeof(*tab); + char *class = "???"; + int i; + + HANDLE hproc = OpenProcess(PROCESS_QUERY_INFORMATION | + PROCESS_VM_READ, + FALSE, pid ); + if(!hproc) + goto print; + if(!(*pEnumProcessModules)(hproc,&hmod,sizeof(hmod),&dummy)) + goto print; + if(!(*pGetModuleBaseName)(hproc,hmod,pname,sizeof(pname))) + goto print; + if(!(priority = GetPriorityClass(hproc))) + goto print; + for(i=0;i 1) ? "" : "\n"); + else + printf("%-32s %8lu %-9s\n", pname, pid, class); + if(hproc) + CloseHandle(hproc); + if(hmod) + CloseHandle(hmod); +} + +int do_simple_ps(void){ + DWORD procs[1024]; + DWORD num_procs; + DWORD needed; + int i; + + if(!(*pEnumProcesses)(procs,sizeof(procs),&needed)){ + fprintf(stderr,"Failed to EnumProcesses\n"); + return 1; + } + num_procs = needed / sizeof(DWORD); + if(erlang_format > 1) + printf("["); + for(i=0;i 1 && i < num_procs -1) + printf(", "); + } + if(erlang_format > 1) + printf("]. \n"); + return 0; +} + +int main(int argc, char **argv){ + if(argc>1 && !strcmp(argv[1],"-e")) + erlang_format = 1; + else if(argc>1 && !strcmp(argv[1],"-E")) + erlang_format = 2; + if(!init_fpointers()) + return 1; + return do_simple_ps(); +} +#endif diff --git a/erts/test/otp_SUITE.erl b/erts/test/otp_SUITE.erl new file mode 100644 index 0000000000..c6769743dd --- /dev/null +++ b/erts/test/otp_SUITE.erl @@ -0,0 +1,297 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(otp_SUITE). + +-export([all/1,init_per_suite/1,end_per_suite/1]). +-export([undefined_functions/1,deprecated_not_in_obsolete/1, + obsolete_but_not_deprecated/1,call_to_deprecated/1, + call_to_size_1/1,strong_components/1]). + +-include("test_server.hrl"). +-import(lists, [filter/2,foldl/3,foreach/2]). + +all(suite) -> + [undefined_functions,deprecated_not_in_obsolete, + obsolete_but_not_deprecated,call_to_deprecated, + call_to_size_1,strong_components]. + +init_per_suite(Config) -> + Dog = test_server:timetrap(?t:minutes(10)), + Root = code:root_dir(), + Server = daily_xref, + ?line xref:start(Server), + ?line xref:set_default(Server, [{verbose,false}, + {warnings,false}, + {builtins,true}]), + ?line {ok,_Relname} = xref:add_release(Server, Root, {name,otp}), + + %% If we are running the tests in the source tree, the ERTS application + %% is not in the code path. We must add it explicitly. + case code:lib_dir(erts) of + {error,bad_name} -> + Erts = filename:join([code:root_dir(),"erts","preloaded","ebin"]), + ?line {ok,_} = xref:add_directory(Server, Erts, []); + _ -> + ok + end, + + ?line ?t:timetrap_cancel(Dog), + [{xref_server,Server}|Config]. + +end_per_suite(Config) -> + Server = ?config(xref_server, Config), + catch xref:stop(Server), + Config. + +undefined_functions(Config) when is_list(Config) -> + Server = ?config(xref_server, Config), + + %% Exclude calls from generated modules in the SSL application. + ExcludeFrom = "SSL-PKIX|PKIX.*|ssl_pkix_oid", + ?line UndefS = xref_base:analysis(undefined_function_calls), + ?line Q = io_lib:format("Undef = ~s," + "ExcludedFrom = ~p:_/_," + "Undef - Undef | ExcludedFrom", + [UndefS,ExcludeFrom]), + ?line {ok,Undef0} = xref:q(Server, lists:flatten(Q)), + ?line Undef1 = hipe_filter(Undef0), + ?line Undef2 = ssl_crypto_filter(Undef1), + ?line Undef3 = edoc_filter(Undef2), + ?line Undef = eunit_filter(Undef3), + ?line Undef = megaco_filter(Undef), + + case Undef of + [] -> ok; + _ -> + foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls undefined ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, Undef), + ?line ?t:fail({length(Undef),undefined_functions_in_otp}) + + end, + + ok. + +hipe_filter(Undef) -> + case erlang:system_info(hipe_architecture) of + undefined -> + filter(fun ({_,{hipe_bifs,_,_}}) -> false; + ({_,{hipe,_,_}}) -> false; + ({_,{hipe_consttab,_,_}}) -> false; + ({_,{hipe_converters,_,_}}) -> false; + ({{code,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{code_server,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{compile,_,_},{Mod,_,_}}) -> + not is_hipe_module(Mod); + ({{hipe,_,_},{Mod,_,_}}) -> + %% See comment for the next clause. + not is_hipe_module(Mod); + ({{cerl_to_icode,translate_flags1,2}, + {hipe_rtl_arch,endianess,0}}) -> + false; + ({{Caller,_,_},{Callee,_,_}}) -> + %% Part of the hipe application is here + %% for the sake of Dialyzer. There are many + %% undefined calls within the hipe application. + not is_hipe_module(Caller) orelse + not is_hipe_module(Callee); + (_) -> true + end, Undef); + _Arch -> + filter(fun ({{Mod,_,_},{hipe_bifs,write_u64,2}}) -> + %% Unavailable except in 64 bit AMD. Ignore it. + not is_hipe_module(Mod); + (_) -> true + end, Undef) + end. + +is_hipe_module(Mod) -> + case atom_to_list(Mod) of + "hipe_"++_ -> true; + _ -> false + end. + +ssl_crypto_filter(Undef) -> + case {code:lib_dir(crypto),code:lib_dir(ssl)} of + {{error,bad_name},{error,bad_name}} -> + filter(fun({_,{ssl,_,_}}) -> false; + ({_,{crypto,_,_}}) -> false; + (_) -> true + end, Undef); + {_,_} -> Undef + end. + +edoc_filter(Undef) -> + %% Filter away function call that is catched. + filter(fun({{edoc_lib,uri_get_http,1},{http,request_sync,2}}) -> false; + (_) -> true + end, Undef). + +eunit_filter(Undef) -> + filter(fun({{eunit_test,wrapper_test_exported_,0}, + {eunit_test,nonexisting_function,0}}) -> false; + (_) -> true + end, Undef). + +megaco_filter(Undef) -> + %% Intentional calls to undefined functions. + filter(fun({{megaco_compact_text_encoder,encode_action_reply,3}, + {megaco_compact_text_encoder_v3,encode_action_reply,2}}) -> false; + ({{megaco_compact_text_encoder,encode_action_request,3}, + {megaco_compact_text_encoder_v3,encode_action_request,2}}) -> false; + ({{megaco_compact_text_encoder,encode_action_requests,3}, + {megaco_compact_text_encoder_v3,encode_action_requests,2}}) -> false; + ({{megaco_compact_text_encoder,encode_command_request,3}, + {megaco_compact_text_encoder_v3,encode_command_request,2}}) -> false; + ({{megaco_compact_text_encoder,encode_message,3}, + {megaco_compact_text_encoder_v3,encode_message,2}}) -> false; + ({{megaco_compact_text_encoder,encode_transaction,3}, + {megaco_compact_text_encoder_v3,encode_transaction,2}}) -> false; + ({{megaco_pretty_text_encoder,encode_action_reply,3}, + {megaco_pretty_text_encoder_v3,encode_action_reply,2}}) -> false; + ({{megaco_pretty_text_encoder,encode_action_request,3}, + {megaco_pretty_text_encoder_v3,encode_action_request,2}}) -> false; + ({{megaco_pretty_text_encoder,encode_action_requests,3}, + {megaco_pretty_text_encoder_v3,encode_action_requests,2}}) -> false; + ({{megaco_pretty_text_encoder,encode_command_request,3}, + {megaco_pretty_text_encoder_v3,encode_command_request,2}}) -> false; + ({{megaco_pretty_text_encoder,encode_message,3}, + {megaco_pretty_text_encoder_v3,encode_message,2}}) -> false; + ({{megaco_pretty_text_encoder,encode_transaction,3}, + {megaco_pretty_text_encoder_v3,encode_transaction,2}}) -> false; + (_) -> true + end, Undef). + +deprecated_not_in_obsolete(Config) when is_list(Config) -> + ?line Server = ?config(xref_server, Config), + ?line {ok,DeprecatedFunctions} = xref:q(Server, "DF"), + + ?line L = foldl(fun({M,F,A}=MFA, Acc) -> + case otp_internal:obsolete(M, F, A) of + no -> [MFA|Acc]; + _ -> Acc + end + end, [], DeprecatedFunctions), + case L of + [] -> ok; + _ -> + io:put_chars("The following functions have -deprecated() attributes,\n" + "but are not listed in otp_internal:obsolete/3.\n"), + ?line print_mfas(L), + ?line ?t:fail({length(L),deprecated_but_not_obsolete}) + end. + +obsolete_but_not_deprecated(Config) when is_list(Config) -> + ?line Server = ?config(xref_server, Config), + ?line {ok,NotDeprecated} = xref:q(Server, "X - DF"), + + ?line L = foldl(fun({M,F,A}=MFA, Acc) -> + case otp_internal:obsolete(M, F, A) of + no -> Acc; + _ -> [MFA|Acc] + end + end, [], NotDeprecated), + + case L of + [] -> ok; + _ -> + io:put_chars("The following functions are listed " + "in otp_internal:obsolete/3,\n" + "but don't have -deprecated() attributes.\n"), + ?line print_mfas(L), + ?line ?t:fail({length(L),obsolete_but_not_deprecated}) + end. + + +call_to_deprecated(Config) when is_list(Config) -> + Server = ?config(xref_server, Config), + ?line {ok,DeprecatedCalls} = xref:q(Server, "strict(E || DF)"), + foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls deprecated ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, DeprecatedCalls), + {comment,integer_to_list(length(DeprecatedCalls))++" calls to deprecated functions"}. + +call_to_size_1(Config) when is_list(Config) -> + Server = ?config(xref_server, Config), + + %% Applications that do not call erlang:size/1: + Apps = [compiler,debugger,kernel,observer,parsetools, + runtime_tools,stdlib,tools,webtool], + + Fs = [{erlang,size,1}], + + Q1 = io_lib:format("E || ~p : Fun", [Fs]), + ?line {ok,AllCallsToSize1} = xref:q(Server, lists:flatten(Q1)), + + Q2 = io_lib:format("E | ~p : App || ~p : Fun", [Apps,Fs]), + ?line {ok,CallsToSize1} = xref:q(Server, lists:flatten(Q2)), + + case CallsToSize1 of + [] -> + ok; + _ -> + io:format("These calls cause an error:~n"), + foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls soon to be deprecated ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, CallsToSize1) + end, + + %% Enumerate calls to erlang:size/1 from other applications than + %% the ones known not to call erlang:size/1: + case AllCallsToSize1--CallsToSize1 of + [] -> + ok; + Calls -> + io:format("~n~nThese calls do not cause an error (yet):~n"), + foreach(fun ({MFA1,MFA2}) -> + io:format("~s calls soon to be deprecated ~s", + [format_mfa(MFA1),format_mfa(MFA2)]) + end, Calls) + end, + case CallsToSize1 of + [] -> + ok; + _ -> + ?line ?t:fail({length(CallsToSize1),calls_to_size_1}) + end. + +strong_components(Config) when is_list(Config) -> + Server = ?config(xref_server, Config), + ?line {ok,Cs} = xref:q(Server, "components AE"), + io:format("\n\nStrong components:\n\n~p\n", [Cs]), + ok. + +%%% +%%% Common help functions. +%%% + + +print_mfas([MFA|T]) -> + io:format("~s\n", [format_mfa(MFA)]), + print_mfas(T); +print_mfas([]) -> ok. + +format_mfa({M,F,A}) -> + lists:flatten(io_lib:format("~s:~s/~p", [M,F,A])). diff --git a/erts/test/run_erl_SUITE.erl b/erts/test/run_erl_SUITE.erl new file mode 100644 index 0000000000..afff4120d4 --- /dev/null +++ b/erts/test/run_erl_SUITE.erl @@ -0,0 +1,270 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(run_erl_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + basic/1,heavy/1,heavier/1,defunct/1]). +-export([ping_me_back/1]). + +-include("test_server.hrl"). + +init_per_testcase(_Case, Config) -> + Dog = ?t:timetrap(?t:minutes(2)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +all(suite) -> + [basic,heavy,heavier,defunct]. + +basic(Config) when is_list(Config) -> + case os:type() of + {unix,_} -> basic_1(Config); + _ -> {skip,"Not Unix"} + end. + +basic_1(Config) -> + ?line {Node,Pipe} = do_run_erl(Config, "basic"), + + ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), + ?line erlang:port_command(ToErl, "halt().\r\n"), + + receive + {nodedown,Node} -> + ?line io:format("Down: ~p\n", [Node]) + after 10000 -> + ?line ?t:fail() + end, + + ok. + +heavy(Config) when is_list(Config) -> + case os:type() of + {unix,_} -> heavy_1(Config); + _ -> {skip,"Not Unix"} + end. + +heavy_1(Config) -> + ?line {Node,Pipe} = do_run_erl(Config, "heavy"), + + ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), + IoFormat = "io:format(\"~s\n\", [lists:duplicate(10000, 10)]).\r\n", + ?line erlang:port_command(ToErl, IoFormat), + ?line erlang:port_command(ToErl, IoFormat), + ?line erlang:port_command(ToErl, IoFormat), + ?line erlang:port_command(ToErl, "init:stop().\r\n"), + + receive + {nodedown,Node} -> + ?line io:format("Down: ~p\n", [Node]) + after 10000 -> + ?line ?t:fail() + end, + + ?line case count_new_lines(ToErl, 0) of + Nls when Nls > 30000 -> + ok; + Nls -> + ?line io:format("new_lines: ~p\n", [Nls]), + ?line ?t:fail() + end. + + +ping_me_back([Node]) when is_atom(Node) -> + net_adm:ping(Node); +ping_me_back([Node]) -> + net_adm:ping(list_to_atom(Node)). + +count_new_lines(P, N) -> + receive + {P,{data,S}} -> + count_new_lines(P, count_new_lines_1(S, N)) + after 0 -> + N + end. + +count_new_lines_1([$\n|T], N) -> + count_new_lines_1(T, N+1); +count_new_lines_1([_|T], N) -> + count_new_lines_1(T, N); +count_new_lines_1([], N) -> N. + +heavier(Config) when is_list(Config) -> + case os:type() of + {unix,_} -> heavier_1(Config); + _ -> {skip,"Not Unix"} + end. + +heavier_1(Config) -> + ?line {Node,Pipe} = do_run_erl(Config, "heavier"), + + ?line ToErl = open_port({spawn,"to_erl "++Pipe}, []), + io:format("ToErl = ~p\n", [ToErl]), + X = 1, + Y = 555, + Z = 42, + ?line random:seed(X, Y, Z), + SeedCmd = lists:flatten(io_lib:format("random:seed(~p, ~p, ~p). \r\n", + [X,Y,Z])), + ?line io:format("~p\n", [SeedCmd]), + ?line erlang:port_command(ToErl, SeedCmd), + + Iter = 1000, + MaxLen = 2048, + + Random = "f(F), "++ + "F = fun(F,0) -> ok; "++ + "(F,N) -> " ++ + "io:format(\"\\\"~s\\\"~n\","++ + "[[35|[random:uniform(25)+65 || " ++ + "_ <- lists:seq(1, "++ + "random:uniform("++ + integer_to_list(MaxLen)++ + "))]]]), "++ + "F(F,N-1) "++ + "end,"++ + "F(F,"++integer_to_list(Iter)++")."++" \r\n", + + + ?line io:format("~p\n", [Random]), + ?line erlang:port_command(ToErl, Random), + + %% Finish. + + ?line erlang:port_command(ToErl, "init:stop().\r\n"), + ?line receive_all(Iter, ToErl, MaxLen), + receive + {nodedown,Node} -> + ?line io:format("Down: ~p\n", [Node]) + after 10000 -> + ?line c:flush(), + ?line ?t:fail() + end, + + ok. + +receive_all(Iter, ToErl, MaxLen) -> + receive_all_1(Iter, [], ToErl, MaxLen). + +receive_all_1(0, _, _, _) -> ok; +receive_all_1(Iter, Line, ToErl, MaxLen) -> + NumChars = random:uniform(MaxLen), + Pattern = [random:uniform(25)+65 || _ <- lists:seq(1, NumChars)], + receive_all_2(Iter, {NumChars,Pattern}, Line, ToErl, MaxLen). + + +receive_all_2(Iter, {NumChars,Pattern}, Line0, ToErl, MaxLen) -> + case receive_match(Line0, {NumChars,Pattern}) of + {match,Line} -> + %%io:format("Match: ~p\n", [Line]), + receive_all_1(Iter-1, Line, ToErl, MaxLen); + {nomatch,Line} -> + %%io:format("NoMatch: ~p\n", [Line]), + receive + {ToErl,{data,S}} -> + %%io:format("Recv: ~p\n", [S]), + receive_all_2(Iter, {NumChars,Pattern}, Line++S, ToErl, MaxLen) + after 10000 -> + io:format("Timeout waiting for\n~p\ngot\n~p\n", + [Pattern, Line]), + ?line ?t:fail() + end + end. + + +receive_match("\"#"++T, {NumChars,Pattern}) when length(T) >= NumChars -> + Match = lists:sublist(T, NumChars), + io:format("match candidate: ~p\n", [Match]), + Match = Pattern, + {match,lists:nthtail(NumChars, T)}; +receive_match("\"#"++T, _) -> + {nomatch,"\"#"++T}; +receive_match("\""=Line, _) -> + {nomatch,Line}; +receive_match([_|T], Tpl) -> + receive_match(T, Tpl); +receive_match(Line, _) -> + {nomatch,Line}. + + +defunct(Config) when is_list(Config) -> + case os:type() of + {unix,_} -> defunct_1(Config); + _ -> {skip,"Not Unix"} + end. + +defunct_1(Config) -> + case os:find_executable(perl) of + false -> + {skip,"No perl found"}; + Perl -> + defunct_2(Config, Perl) + end. + +defunct_2(Config, Perl) -> + ?line Data = ?config(data_dir, Config), + ?line RunErlTest = filename:join(Data, "run_erl_test.pl"), + ?line Defuncter = filename:join(Data, "defuncter.pl"), + ?line Priv = ?config(priv_dir, Config), + ?line LogDir = filename:join(Priv, "defunct"), + ?line ok = file:make_dir(LogDir), + ?line Pipe = LogDir ++ "/", + ?line RunErl = os:find_executable(run_erl), + ?line Cmd = Perl ++ " " ++ RunErlTest ++ " " ++ RunErl ++ " " ++ + Defuncter ++ " " ++ Pipe ++ " " ++ LogDir, + ?line io:format("~p", [Cmd]), + ?line Res = os:cmd(Cmd), + ?line io:format("~p\n", [Res]), + "OK"++_ = Res, + ok. + +%%% Utilities. + +do_run_erl(Config, Case) -> + ?line Priv = ?config(priv_dir, Config), + ?line LogDir = filename:join(Priv, Case), + ?line ok = file:make_dir(LogDir), + ?line Pipe = LogDir ++ "/", + ?line NodeName = "run_erl_node_" ++ Case, + ?line Cmd = "run_erl "++Pipe++" "++LogDir++" \"erl -sname " ++ NodeName ++ + " -pa " ++ filename:dirname(code:which(?MODULE)) ++ + " -s " ++ ?MODULE_STRING ++ " ping_me_back " ++ + atom_to_list(node()) ++ "\"", + ?line io:format("~p\n", [Cmd]), + + ?line net_kernel:monitor_nodes(true), + ?line open_port({spawn,Cmd}, []), + ?line [_,Host] = string:tokens(atom_to_list(node()), "@"), + ?line Node = list_to_atom(NodeName++"@"++Host), + + receive + {nodeup,Node} -> + ?line io:format("Up: ~p\n", [Node]); + Other -> + ?line io:format("Unexpected: ~p\n", [Other]), + ?line ?t:fail() + after 10000 -> + ?line ?t:fail() + end, + + {Node,Pipe}. diff --git a/erts/test/run_erl_SUITE_data/defuncter.pl b/erts/test/run_erl_SUITE_data/defuncter.pl new file mode 100644 index 0000000000..261f1b8061 --- /dev/null +++ b/erts/test/run_erl_SUITE_data/defuncter.pl @@ -0,0 +1,31 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +$SIG{HUP} = 'IGNORE'; +if (fork() == 0) { + print "child\n"; + my $i = 0; + for (;;) { + sleep(5); + print $i++, "\n"; + } +} else { + print "hejsan\n"; + exit(1); +} diff --git a/erts/test/run_erl_SUITE_data/run_erl_test.pl b/erts/test/run_erl_SUITE_data/run_erl_test.pl new file mode 100644 index 0000000000..2155225e7f --- /dev/null +++ b/erts/test/run_erl_SUITE_data/run_erl_test.pl @@ -0,0 +1,41 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2006-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +my $run_erl = shift; +my $defuncter = shift; +my $pipe = shift; +my $log_dir = shift; +my $cmd = "run_erl $pipe $log_dir \"$^X $defuncter\""; +my $pid; + +if (($pid = fork()) == 0) { + #print join(" ", $run_erl, $pipe, $log_dir, "$^X $defuncter"); + exec($run_erl, $pipe, $log_dir, "$^X $defuncter"); + die "ERROR: exec failed: $!\n"; +} elsif ($pid > 0) { + sleep(1); + my $res = waitpid($pid, 0); + if ($res == $pid) { + print "OK\n"; + exit(0); + } + die "ERROR: waitpid($pid, 0) returned $res\n"; +} else { + die "ERROR: fork() failed: $!\n"; +} diff --git a/erts/test/system.dynspec b/erts/test/system.dynspec new file mode 100644 index 0000000000..799fd7611d --- /dev/null +++ b/erts/test/system.dynspec @@ -0,0 +1,18 @@ +%% -*- erlang -*- +%% You can test this file using this command. +%% file:script("system.dynspec", [{'TestCCompiler',{msc | gnuc, undefined}}]). + +case {TestCCompiler, erlang:system_info(c_compiler_used)} of + {{CC, _}, {CC, _}} -> + []; + {{CC1, _}, {CC2, _}} when CC1 == msc; CC2 == msc -> + Comment = + "OTP's static C libraries (compiled with " + ++ atom_to_list(CC2) ++ ") aren't compatible " + "with the C compiler (" ++ atom_to_list(CC1) + ++ ") used for testing.", + StaticLibSuites = [ethread_SUITE, erl_print_SUITE], + lists:map(fun (Suite) -> {skip,{Suite, Comment}} end, StaticLibSuites); + {{CC1, _}, {CC2, _}} -> + [] +end. diff --git a/erts/test/system.spec b/erts/test/system.spec new file mode 100644 index 0000000000..9bfe2dbcf8 --- /dev/null +++ b/erts/test/system.spec @@ -0,0 +1 @@ +{topcase, {dir, "../system_test"}}. diff --git a/erts/test/system.spec.vxworks b/erts/test/system.spec.vxworks new file mode 100644 index 0000000000..378adf56ac --- /dev/null +++ b/erts/test/system.spec.vxworks @@ -0,0 +1,2 @@ +{topcase, {dir, "../system_test"}}. +{skip,{erlc_SUITE, "Not on VxWorks, erlc is a HOST tool."}} diff --git a/erts/test/utils/gccifier.c b/erts/test/utils/gccifier.c new file mode 100644 index 0000000000..64de764260 --- /dev/null +++ b/erts/test/utils/gccifier.c @@ -0,0 +1,316 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2004-2009. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ + +/* + * A compiler wrapper that translate (some) gcc command line arguments + * to the Visual C++ compiler and (of course) the gcc compiler. It also + * makes some changes in the command line arguments when debug compiling. + */ + +#include +#include +#include +#include + + +#if !defined(__WIN32__) +#define USE_EXEC +#include +#endif + + +#ifdef __WIN32__ +#define EOL "\r\n" +#else +#define EOL "\n" +#endif + +#define ARGS_INCR 20 + +static char *prog; + +typedef struct { + char **vec; + int no; + int ix; + int chars; +} args_t; + +static void +enomem(void) +{ + fprintf(stderr, "%s: Out of memory%s", prog, EOL); + exit(1); +} + +static void +save_arg(args_t *args, char *arg1, ...) +{ + char *carg; + va_list argp; + + va_start(argp, arg1); + carg = arg1; + while (carg) { + if (args->no <= args->ix) { + args->vec = (char **) (args->no + ? realloc((void *) args->vec, + (sizeof(char *) + *(args->no + ARGS_INCR + 1))) + : malloc((sizeof(char *) + *(args->no + ARGS_INCR + 1)))); + if (!args->vec) + enomem(); + args->no += ARGS_INCR; + } + args->vec[args->ix++] = carg; + args->chars += strlen(carg); + carg = va_arg(argp, char *); + } + args->vec[args->ix++] = " "; + args->chars++; + va_end(argp); +} + +static int +is_prefix(char *prfx, char **str) +{ + int i; + for (i = 0; prfx[i] && (*str)[i]; i++) { + if (prfx[i] != (*str)[i]) + return 0; + } + if (!prfx[i]) { + *str = &(*str)[i]; + return 1; + } + return 0; +} + +static void +cpy(char **dst, char *src) +{ + int i; + for (i = 0; src[i]; i++) + (*dst)[i] = src[i]; + *dst = &(*dst)[i]; +} + +typedef enum { + STDLIB_NONE, + STDLIB_MD, + STDLIB_ML, + STDLIB_MT +} stdlib_t; + +int +main(int argc, char *argv[]) +{ + int res; + int i; + size_t cmd_len; + char *cmd; + char *cmd_end; + char *cc = NULL; + args_t args = {0}; + int is_debug = 0; + int is_purify = 0; + int is_quantify = 0; + int is_purecov = 0; +#ifdef __WIN32__ + int is_shared = 0; + stdlib_t stdlib = STDLIB_NONE; + char *shared_flag = ""; + char *stdlib_flag = ""; + int have_link_args = 0; + args_t link_args = {0}; + +#define CHECK_FIRST_LINK_ARG \ + if (!have_link_args) { \ + save_arg(&link_args, "-link", NULL); \ + have_link_args = 1; \ + } +#else /* #ifdef __WIN32__ */ +#define CHECK_FIRST_LINK_ARG +#endif /* #ifdef __WIN32__ */ + + prog = argv[0]; + + + for (i = 1; i < argc; i++) { + char *arg = argv[i]; + if (is_prefix("-CC", &arg)) { + cc = arg; + } + else if (is_prefix("-O", &arg)) { + if (!is_debug) + save_arg(&args, argv[i], NULL); + } + else if (strcmp("-DDEBUG", arg) == 0) { + save_arg(&args, arg, NULL); +#ifdef __WIN32__ + set_debug: +#endif + if (!is_debug) { + int j; + is_debug = 1; +#ifdef __WIN32__ + save_arg(&args, "-Z7", NULL); + CHECK_FIRST_LINK_ARG; + save_arg(&link_args, "-debug", NULL); + save_arg(&link_args, "-pdb:none", NULL); +#endif + for (j = 0; j < args.ix; j++) { + char *tmp_arg = args.vec[j]; + if (is_prefix("-O", &tmp_arg)) + args.vec[j] = ""; + } + } + } + else if (strcmp("-DPURIFY", arg) == 0) { + save_arg(&args, arg, NULL); + is_purify = 1; + } + else if (strcmp("-DQUANTIFY", arg) == 0) { + save_arg(&args, arg, NULL); + is_quantify = 1; + } + else if (strcmp("-DPURECOV", arg) == 0) { + save_arg(&args, arg, NULL); + is_purecov = 1; + } +#ifdef __WIN32__ + else if (strcmp("-g", arg) == 0) { + goto set_debug; + } + else if (strcmp("-MD", arg) == 0) + stdlib = STDLIB_MD; + else if (strcmp("-MDd", arg) == 0) { + stdlib = STDLIB_MD; + goto set_debug; + } + else if (strcmp("-ML", arg) == 0) + stdlib = STDLIB_ML; + else if (strcmp("-MLd", arg) == 0) { + stdlib = STDLIB_ML; + goto set_debug; + } + else if (strcmp("-MT", arg) == 0) + stdlib = STDLIB_MT; + else if (strcmp("-MTd", arg) == 0) { + stdlib = STDLIB_MT; + goto set_debug; + } + else if (strcmp("-shared", arg) == 0 || strcmp("-LD", arg) == 0) + is_shared = 1; + else if (strcmp("-LDd", arg) == 0) { + is_shared = 1; + goto set_debug; + } + else if (strcmp("-Wall", arg) == 0) { + save_arg(&args, "-W3", NULL); + } + else if (is_prefix("-L", &arg)) { + CHECK_FIRST_LINK_ARG; + save_arg(&link_args, "-libpath:", arg, NULL); + } +#endif /* #ifdef __WIN32__ */ + else if (is_prefix("-l", &arg)) { + CHECK_FIRST_LINK_ARG; + if (is_debug && strcmp("ethread", arg) == 0) + arg = "ethread.debug"; + else if (is_purify && strcmp("ethread", arg) == 0) + arg = "ethread.purify"; + else if (is_quantify && strcmp("ethread", arg) == 0) + arg = "ethread.quantify"; + else if (is_purecov && strcmp("ethread", arg) == 0) + arg = "ethread.purecov"; +#ifdef __WIN32__ + else if (strcmp("socket", arg) == 0) + arg = "ws2_32"; + save_arg(&link_args, arg, ".lib", NULL); +#else + save_arg(&args, "-l", arg, NULL); +#endif + } + else + save_arg(&args, argv[i], NULL); + } + + if (!cc || !cc[0]) { + fprintf(stderr, "%s: Missing compulsory -CC flag%s", prog, EOL); + exit(1); + } + + cmd_len = strlen(cc) + 1 + args.chars + 1; + +#ifdef __WIN32__ + if (is_shared) + shared_flag = is_debug ? "-LDd " : "-LD "; + switch (stdlib) { + case STDLIB_MD: stdlib_flag = is_debug ? "-MDd " : "-MD "; break; + case STDLIB_ML: stdlib_flag = is_debug ? "-MLd " : "-ML "; break; + case STDLIB_MT: stdlib_flag = is_debug ? "-MTd " : "-MT "; break; + case STDLIB_NONE: break; + } + + cmd_len += strlen(shared_flag) + strlen(stdlib_flag) + link_args.chars; +#endif + + cmd = (char *) malloc(sizeof(char) * cmd_len); + + if (!cmd) + enomem(); + cmd_end = cmd; + cpy(&cmd_end, cc); + cpy(&cmd_end, " "); +#ifdef __WIN32__ + cpy(&cmd_end, stdlib_flag); + cpy(&cmd_end, shared_flag); +#endif + for (i = 0; i < args.ix; i++) + cpy(&cmd_end, args.vec[i]); +#ifdef __WIN32__ + for (i = 0; i < link_args.ix; i++) + cpy(&cmd_end, link_args.vec[i]); +#endif + *cmd_end = '\0'; + + printf("==> %s%s", cmd, EOL); + fflush(stdout); + +#ifdef USE_EXEC + (void) execl("/bin/sh", "sh", "-c", cmd, (char *) NULL); + perror(NULL); + res = 1; +#else + res = system(cmd); +#endif + + free((void *) args.vec); +#ifdef __WIN32__ + free((void *) link_args.vec); +#endif + free((void *) cmd); + + if (res < 0) + res = 1; + return res; +} diff --git a/erts/test/z_SUITE.erl b/erts/test/z_SUITE.erl new file mode 100644 index 0000000000..0e37af1ca2 --- /dev/null +++ b/erts/test/z_SUITE.erl @@ -0,0 +1,315 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(z_SUITE). + +%% +%% This suite expects to be run as the last suite of all suites. +%% + +%-define(line_trace, 1). + +-include_lib("kernel/include/file.hrl"). + +-record(core_search_conf, {search_dir, + extra_search_dir, + cerl, + file, + run_by_ts}). + +-define(DEFAULT_TIMEOUT, ?t:minutes(5)). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([search_for_core_files/1, core_files/1]). + +-include("test_server.hrl"). + + +init_per_testcase(Case, Config) -> + Dog = ?t:timetrap(?DEFAULT_TIMEOUT), + [{testcase, Case}, {watchdog, Dog} |Config]. + +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +all(doc) -> []; +all(suite) -> + [core_files]. + + +core_files(doc) -> + []; +core_files(suite) -> + []; +core_files(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> + {skipped, "No idea searching for core-files on windows"}; + {unix, darwin} -> + core_file_search( + core_search_conf(true, + os:getenv("OTP_DAILY_BUILD_TOP_DIR"), + "/cores")); + _ -> + core_file_search( + core_search_conf(true, + os:getenv("OTP_DAILY_BUILD_TOP_DIR"))) + end. + +search_for_core_files(Dir) -> + case os:type() of + {win32, _} -> + io:format("No idea searching for core-files on windows"); + {unix, darwin} -> + core_file_search(core_search_conf(false, Dir, "/cores")); + _ -> + core_file_search(core_search_conf(false, Dir)) + end. + +find_cerl(false) -> + case os:getenv("ERL_TOP") of + false -> false; + ETop -> + Cerl = filename:join([ETop, "bin", "cerl"]), + case filelib:is_regular(Cerl) of + true -> Cerl; + _ -> false + end + end; +find_cerl(DBTop) -> + case catch filelib:wildcard(filename:join([DBTop, + "otp_src_R*", + "bin", + "cerl"])) of + [Cerl | _ ] -> + case filelib:is_regular(Cerl) of + true -> Cerl; + _ -> false + end; + _ -> + false + end. + +is_dir(false) -> + false; +is_dir(Dir) -> + filelib:is_dir(Dir). + +core_search_conf(RunByTS, DBTop) -> + core_search_conf(RunByTS, DBTop, false). + +core_search_conf(RunByTS, DBTop, XDir) -> + SearchDir = case is_dir(DBTop) of + false -> + case code:which(test_server) of + non_existing -> + {ok, CWD} = file:get_cwd(), + CWD; + TS -> + filename:dirname(filename:dirname(TS)) + end; + true -> + DBTop + end, + XSearchDir = case is_dir(XDir) of + false -> + false; + true -> + case SearchDir == XDir of + true -> false; + _ -> XDir + end + end, + #core_search_conf{search_dir = SearchDir, + extra_search_dir = XSearchDir, + cerl = find_cerl(DBTop), + file = os:find_executable("file"), + run_by_ts = RunByTS}. + +file_inspect(#core_search_conf{file = File}, Core) -> + FRes0 = os:cmd(File ++ " " ++ Core), + FRes = case regexp:match(FRes0, Core) of + {match, S, E} -> + L = length(FRes0), + case S of + 1 -> + lists:sublist(FRes0, E+1, L+1); + _ -> + lists:sublist(FRes0, 1, S-1) + ++ + " " + ++ + lists:sublist(FRes0, E+1, L+1) + end; + _ -> FRes0 + end, + case regexp:match(FRes, "[Tt][Ee][Xx][Tt]") of + nomatch -> + case regexp:match(FRes, "[Aa][Ss][Cc][Ii][Ii]") of + nomatch -> + probably_a_core; + _ -> + not_a_core + end; + _ -> + not_a_core + end. + +mk_readable(F) -> + catch file:write_file_info(F, #file_info{mode = 8#00444}). + +ignore_core(C) -> + filelib:is_regular(filename:join([filename:dirname(C), + "ignore_core_files"])). + +core_cand(#core_search_conf{file = false}, C, Cs) -> + %% Guess that it is a core file; make it readable by anyone and save it + mk_readable(C), + [C|Cs]; +core_cand(Conf, C, Cs) -> + case file_inspect(Conf, C) of + not_a_core -> Cs; + _ -> + %% Probably a core file; make it readable by anyone and save it + mk_readable(C), + case ignore_core(C) of + true -> [{ignore, C}|Cs]; + _ -> [C|Cs] + end + end. + +time_fstr() -> + "(~w-~.2.0w-~.2.0w ~w.~.2.0w:~.2.0w)". +mod_time_list(F) -> + case catch filelib:last_modified(F) of + {{Y,Mo,D},{H,Mi,S}} -> + [Y,Mo,D,H,Mi,S]; + _ -> + [0,0,0,0,0,0] + end. + +str_strip(S) -> + string:strip(string:strip(string:strip(S), both, $\n), both, $\r). + +format_core(Conf, {ignore, Core}) -> + format_core(Conf, Core, "[ignored] "); +format_core(Conf, Core) -> + format_core(Conf, Core, ""). + +format_core(#core_search_conf{file = false}, Core, Ignore) -> + io:format(" ~s~s " ++ time_fstr() ++ "~s~n", + [Ignore, Core] ++ mod_time_list(Core)); +format_core(#core_search_conf{file = File}, Core, Ignore) -> + FRes = str_strip(os:cmd(File ++ " " ++ Core)), + case catch regexp:match(FRes, Core) of + {match, _, _} -> + io:format(" ~s~s " ++ time_fstr() ++ "~n", + [Ignore, FRes] ++ mod_time_list(Core)); + _ -> + io:format(" ~s~s: ~s " ++ time_fstr() ++ "~n", + [Ignore, Core, FRes] ++ mod_time_list(Core)) + end. + +core_file_search(#core_search_conf{search_dir = Base, + extra_search_dir = XBase, + cerl = Cerl, + run_by_ts = RunByTS} = Conf) -> + case Cerl of + false -> ok; + _ -> catch io:format("A cerl script that probably can be used for " + "inspection of emulator cores:~n ~s~n", + [Cerl]) + end, + io:format("Searching for core-files in: ~s~s~n", + [case XBase of + false -> ""; + _ -> XBase ++ " and " + end, + Base]), + Filter = fun (Core, Cores) -> + case filelib:is_regular(Core) of + true -> + case filename:basename(Core) of + "core" -> + core_cand(Conf, Core, Cores); + "core." ++ _ -> + core_cand(Conf, Core, Cores); + BName -> + case lists:suffix(".core", BName) of + true -> core_cand(Conf, Core, Cores); + _ -> Cores + end + end; + _ -> + Cores + end + end, + case case XBase of + false -> []; + _ -> filelib:fold_files(XBase, "core", true, Filter, []) + end ++ filelib:fold_files(Base, "core", true, Filter, []) of + [] -> + io:format("No core-files found.~n", []), + ok; + Cores -> + io:format("Found core files:~n",[]), + lists:foreach(fun (C) -> format_core(Conf, C) end, Cores), + {ICores, FCores} = lists:foldl(fun ({ignore, IC}, {ICs, FCs}) -> + {[" "++IC|ICs], FCs}; + (FC, {ICs, FCs}) -> + {ICs, [" "++FC|FCs]} + end, + {[],[]}, + Cores), + ICoresComment = + "Core-files marked with [ignored] were found in directories~n" + "containing an ignore_core_files file, i.e., the testcase~n" + "writer has decided that core-files dumped there should be~n" + "ignored. This testcase won't fail on ignored core-files~n" + "found.~n", + Res = lists:flatten([case FCores of + [] -> + []; + _ -> + ["Core-files found:", + lists:reverse(FCores)] + end, + case {FCores, ICores} of + {[], []} -> []; + {_, []} -> []; + {[], _} -> []; + _ -> " " + end, + case ICores of + [] -> []; + _ -> + io:format(ICoresComment, []), + ["Ignored core-files found:", + lists:reverse(ICores)] + end]), + case {RunByTS, ICores, FCores} of + {true, [], []} -> ok; + {true, _, []} -> {comment, Res}; + {true, _, _} -> ?t:fail(Res); + _ -> Res + end + end. diff --git a/erts/vsn.mk b/erts/vsn.mk new file mode 100644 index 0000000000..199b1cbf22 --- /dev/null +++ b/erts/vsn.mk @@ -0,0 +1,28 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# +# The contents of this file are subject to the Erlang Public License, +# Version 1.1, (the "License"); you may not use this file except in +# compliance with the License. You should have received a copy of the +# Erlang Public License along with this software. If not, it can be +# retrieved online at http://www.erlang.org/. +# +# Software distributed under the License is distributed on an "AS IS" +# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +# the License for the specific language governing rights and limitations +# under the License. +# +# %CopyrightEnd% +# + +VSN = 5.7.4 +SYSTEM_VSN = R13B03 + +# Port number 4365 in 4.2 +# Port number 4366 in 4.3 +# Port number 4368 in 4.4.0 - 4.6.2 +# Port number 4369 in 4.6.3 - + +ERLANG_DAEMON_PORT = 4369 -- cgit v1.2.3